(* Author: Tobias Nipkow *)

subsubsection "\<open>nat\<close>-Indexed Invariant"

theory Hoare_Total_EX
imports Hoare
begin

text\<open>This is the standard set of rules that you find in many publications.
The While-rule is different from the one in Concrete Semantics in that the
invariant is indexed by natural numbers and goes down by 1 with
every iteration. The completeness proof is easier but the rule is harder
to apply in program proofs.\<close>

definition hoare_tvalid :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool"
  ("\<Turnstile>\<^sub>t {(1_)}/ (_)/ {(1_)}" 50) where
"\<Turnstile>\<^sub>t {P}c{Q}  \<longleftrightarrow>  (\<forall>s. P s \<longrightarrow> (\<exists>t. (c,s) \<Rightarrow> t \<and> Q t))"

inductive
  hoaret :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool" ("\<turnstile>\<^sub>t ({(1_)}/ (_)/ {(1_)})" 50)
where

Skip:  "\<turnstile>\<^sub>t {P} SKIP {P}"  |

Assign:  "\<turnstile>\<^sub>t {\<lambda>s. P(s[a/x])} x::=a {P}"  |

Seq: "\<lbrakk> \<turnstile>\<^sub>t {P\<^sub>1} c\<^sub>1 {P\<^sub>2}; \<turnstile>\<^sub>t {P\<^sub>2} c\<^sub>2 {P\<^sub>3} \<rbrakk> \<Longrightarrow> \<turnstile>\<^sub>t {P\<^sub>1} c\<^sub>1;;c\<^sub>2 {P\<^sub>3}"  |

If: "\<lbrakk> \<turnstile>\<^sub>t {\<lambda>s. P s \<and> bval b s} c\<^sub>1 {Q}; \<turnstile>\<^sub>t {\<lambda>s. P s \<and> \<not> bval b s} c\<^sub>2 {Q} \<rbrakk>
  \<Longrightarrow> \<turnstile>\<^sub>t {P} IF b THEN c\<^sub>1 ELSE c\<^sub>2 {Q}"  |

While:
  "\<lbrakk> \<And>n::nat. \<turnstile>\<^sub>t {P (Suc n)} c {P n};
     \<forall>n s. P (Suc n) s \<longrightarrow> bval b s;  \<forall>s. P 0 s \<longrightarrow> \<not> bval b s \<rbrakk>
   \<Longrightarrow> \<turnstile>\<^sub>t {\<lambda>s. \<exists>n. P n s} WHILE b DO c {P 0}"  |

conseq: "\<lbrakk> \<forall>s. P' s \<longrightarrow> P s; \<turnstile>\<^sub>t {P}c{Q}; \<forall>s. Q s \<longrightarrow> Q' s  \<rbrakk> \<Longrightarrow>
           \<turnstile>\<^sub>t {P'}c{Q'}"

text\<open>Building in the consequence rule:\<close>

lemma Assign': "\<forall>s. P s \<longrightarrow> Q(s[a/x]) \<Longrightarrow> \<turnstile>\<^sub>t {P} x ::= a {Q}"
by (simp add: strengthen_pre[OF _ Assign])

text\<open>The soundness theorem:\<close>

theorem hoaret_sound: "\<turnstile>\<^sub>t {P}c{Q}  \<Longrightarrow>  \<Turnstile>\<^sub>t {P}c{Q}"
proof(unfold hoare_tvalid_def, induction rule: hoaret.induct)
  case (While P c b)
  have "P n s \<Longrightarrow> \<exists>t. (WHILE b DO c, s) \<Rightarrow> t \<and> P 0 t" for n s
  proof(induction "n" arbitrary: s)
    case 0 thus ?case using While.hyps(3) WhileFalse by blast
  next
    case Suc
    thus ?case by (meson While.IH While.hyps(2) WhileTrue)
  qed
  thus ?case by auto
next
  case If thus ?case by auto blast
qed fastforce+

definition wpt :: "com \<Rightarrow> assn \<Rightarrow> assn" ("wp\<^sub>t") where
"wp\<^sub>t c Q  =  (\<lambda>s. \<exists>t. (c,s) \<Rightarrow> t \<and> Q t)"

lemma [simp]: "wp\<^sub>t (x ::= e) Q = (\<lambda>s. Q(s(x := aval e s)))"
by(auto intro!: ext simp: wpt_def)

lemma [simp]: "wp\<^sub>t (c\<^sub>1;;c\<^sub>2) Q = wp\<^sub>t c\<^sub>1 (wp\<^sub>t c\<^sub>2 Q)"
unfolding wpt_def
apply(rule ext)
apply auto
done

lemma [simp]:
 "wp\<^sub>t (IF b THEN c\<^sub>1 ELSE c\<^sub>2) Q = (\<lambda>s. wp\<^sub>t (if bval b s then c\<^sub>1 else c\<^sub>2) Q s)"
apply(unfold wpt_def)
apply(rule ext)
apply auto
done

text\<open>Function \<open>wpw\<close> computes the weakest precondition of a While-loop
that is unfolded a fixed number of times.\<close>

fun wpw :: "bexp \<Rightarrow> com \<Rightarrow> nat \<Rightarrow> assn \<Rightarrow> assn" where
"wpw b c 0 Q s = (\<not> bval b s \<and> Q s)" |
"wpw b c (Suc n) Q s = (bval b s \<and> (\<exists>s'. (c,s) \<Rightarrow> s' \<and>  wpw b c n Q s'))"

lemma WHILE_Its: "(WHILE b DO c,s) \<Rightarrow> t \<Longrightarrow> Q t \<Longrightarrow> \<exists>n. wpw b c n Q s"
proof(induction "WHILE b DO c" s t rule: big_step_induct)
  case WhileFalse thus ?case using wpw.simps(1) by blast
next
  case WhileTrue thus ?case using wpw.simps(2) by blast
qed

lemma wpt_is_pre: "\<turnstile>\<^sub>t {wp\<^sub>t c Q} c {Q}"
proof (induction c arbitrary: Q)
  case SKIP show ?case by (auto intro:hoaret.Skip)
next
  case Assign show ?case by (auto intro:hoaret.Assign)
next
  case Seq thus ?case by (auto intro:hoaret.Seq)
next
  case If thus ?case by (auto intro:hoaret.If hoaret.conseq)
next
  case (While b c)
  let ?w = "WHILE b DO c"
  have c1: "\<forall>s. wp\<^sub>t ?w Q s \<longrightarrow> (\<exists>n. wpw b c n Q s)"
    unfolding wpt_def by (metis WHILE_Its)
  have c3: "\<forall>s. wpw b c 0 Q s \<longrightarrow> Q s" by simp
  have w2: "\<forall>n s. wpw b c (Suc n) Q s \<longrightarrow> bval b s" by simp
  have w3: "\<forall>s. wpw b c 0 Q s \<longrightarrow> \<not> bval b s" by simp
  have "\<turnstile>\<^sub>t {wpw b c (Suc n) Q} c {wpw b c n Q}" for n
  proof -
    have *: "\<forall>s. wpw b c (Suc n) Q s \<longrightarrow> (\<exists>t. (c, s) \<Rightarrow> t \<and> wpw b c n Q t)" by simp
    show ?thesis by(rule strengthen_pre[OF * While.IH[of "wpw b c n Q", unfolded wpt_def]])
  qed
  from conseq[OF c1 hoaret.While[OF this w2 w3] c3]
  show ?case .
qed

theorem hoaret_complete: "\<Turnstile>\<^sub>t {P}c{Q} \<Longrightarrow> \<turnstile>\<^sub>t {P}c{Q}"
apply(rule strengthen_pre[OF _ wpt_is_pre])
apply(auto simp: hoare_tvalid_def wpt_def)
done

corollary hoaret_sound_complete: "\<turnstile>\<^sub>t {P}c{Q} \<longleftrightarrow> \<Turnstile>\<^sub>t {P}c{Q}"
by (metis hoaret_sound hoaret_complete)

text \<open>Two examples:\<close>

lemma "\<turnstile>\<^sub>t
{\<lambda>s. \<exists>n. n = nat(s ''x'')}
 WHILE Less (N 0) (V ''x'') DO ''x'' ::= Plus (V ''x'') (N (-1))
{\<lambda>s. s ''x'' \<le> 0}"
apply(rule weaken_post)
 apply(rule While)
   apply(rule Assign')
   apply auto
done

lemma "\<turnstile>\<^sub>t
{\<lambda>s. \<exists>n. n = nat(s ''x'')}
 WHILE Less (N 0) (V ''x'')
 DO (''x'' ::= Plus (V ''x'') (N (-1));;
    (''y'' ::= V ''x'';;
     WHILE Less (N 0) (V ''y'') DO ''y'' ::= Plus (V ''y'') (N (-1))))
{\<lambda>s. s ''x'' \<le> 0}"
apply(rule weaken_post)
 apply(rule While)
   defer
   apply auto[3]
apply(rule Seq)
 prefer 2
 apply(rule Seq)
  prefer 2
  apply(rule weaken_post)
   apply(rule_tac P = "\<lambda>m s. n = nat(s ''x'') \<and> m = nat(s ''y'')" in While)
     apply(rule Assign')
     apply auto[4]
 apply(rule Assign)
apply(rule Assign')
apply auto
done

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
paragraph \<open>Monotonicity\<close>
theory Transport_Compositions_Agree_Monotone
  imports
    Transport_Compositions_Agree_Base
begin

context transport_comp_agree
begin

lemma mono_wrt_rel_leftI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1" "((\<le>\<^bsub>L2\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R2\<^esub>)) l2"
  and "\<And>x y. x \<le>\<^bsub>L1\<^esub> y \<Longrightarrow> l1 x \<le>\<^bsub>R1\<^esub> l1 y \<Longrightarrow> l1 x \<le>\<^bsub>L2\<^esub> l1 y"
  shows "((\<le>\<^bsub>L\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R\<^esub>)) l"
  unfolding left_eq_comp using assms by (rule dep_mono_wrt_rel_compI)

end

context transport_comp_same
begin

lemma mono_wrt_rel_leftI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1" "((\<le>\<^bsub>R1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R2\<^esub>)) l2"
  shows "((\<le>\<^bsub>L\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R\<^esub>)) l"
  using assms by (rule mono_wrt_rel_leftI) auto

end

end


           (*-------------------------------------------*
            |                DFP package                |
            |                   June 2005               |
            |               December 2005  (modified)   |
            |                                           |
            |   DFP on CSP-Prover ver.3.0               |
            |              September 2006  (modified)   |
            |                  April 2007  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2016         |
            |                    May 2016  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory DFP_subseteqEX
imports CSP_F_Main
begin

datatype Event = left real | right "real * nat"
datatype Name = Empty nat | Full real nat
datatype DFName = DF

primrec
  Bufferfun :: "Name => (Name, Event) proc"
where
  "Bufferfun  (Empty n)  = left ? r -> $(Full r n)"
 |"Bufferfun  (Full r n) = right (r,n) -> $(Empty (Suc n))"

overloading Set_Bufferfun ==
  "PNfun :: (Name, Event) pnfun"
begin
  definition "PNfun == Bufferfun"
end

(*****************************************************************

  1. safe subsets of [[P]]F, used for deadlock-free verification.

 *****************************************************************)

(*********************************************************
                    safe cut of [[_]]F
        This is used for deadlock-free verification.
 *********************************************************)

definition
  restRefusal :: "'a setF => 'a event set => 'a failure set"
                                     ("(0_/ restRefusal /_)" [52,990] 52)
  where
  restRefusal_def :
    "F restRefusal A == {(s,Y)| s Y. (s,Y) :f F & Y <= A}"

definition
  subseteqEX   :: "'a failure set => 'a failure set => bool"
                                     ("(0_/ <=EX /_)" [50,50] 50)
  where
  subseteqEX_def :
    "F <=EX E == (F <= E) & (ALL s Y. (s,Y) : E --> (EX Z. (s,Z) : F & Y <= Z))"

(*********************************************************
                subseteqEX &  restRefusal
 *********************************************************)

lemma subseteqEX_reflex[simp]:  "F <=EX F"
apply (simp add: subseteqEX_def)
apply (auto)
done

lemma subseteqEX_Int:
   "F restRefusal A = {(s,Y Int A)|s Y. (s,Y) :f F}"
apply (simp add: restRefusal_def)
apply (auto)
apply (rule memF_F2)
apply (simp)
apply (fast)
done

lemma subseteqEX_restRefusal_iff:
  "(F <=EX E restRefusal A)
   = ((ALL s Y. (s, Y) : F --> (s, Y) :f E & Y <= A) &
      (ALL s Y. (s, Y) :f E --> (EX Z. (s, Z) : F & Y Int A <= Z)))"
apply (simp add: subseteqEX_def)
apply (simp add: restRefusal_def)
apply (rule iffI)

(* --> *)

 apply (rule conjI)

  apply (intro allI impI)
  apply (elim conjE)
  apply (erule subsetE)
  apply (drule_tac x="(s,Y)" in bspec, simp)
  apply (simp)

  apply (intro allI impI)
  apply (elim conjE)
  apply (drule_tac x="s" in spec)
  apply (drule_tac x="Y Int A" in spec)
  apply (drule mp)
   apply (rule conjI)
   apply (rule memF_F2, simp_all)
   apply (fast)

(* <-- *)
  apply (fast)
done

(*********************************************************
        How to prove F <=EX ([[P]]F restRefusal A)
 *********************************************************)

(*--------------------*
 |        DIV         |
 *--------------------*)

lemma subseteqEX_DIV[simp]: "{} <=EX failures (DIV) MF restRefusal A"
apply (simp add: subseteqEX_def)
apply (simp add: restRefusal_def)
apply (simp add: in_failures)
done

(*-----------*
 | csp rules |
 *-----------*)

lemma cspF_subseteqEX_DIV:
  "P =F DIV ==> {} <=EX failures (DIV) MF restRefusal A"
by (simp add: eqF_def)

(*--------------------*
 |     Int_choice     |
 *--------------------*)

(* eq *)

lemma subseteqEX_Int_choice:
  "[| F1 <=EX failures P1 MF restRefusal A ;
      F2 <=EX failures P2 MF restRefusal A |]
    ==> F1 Un F2 <=EX failures (P1 |~| P2) MF restRefusal A"
apply (simp add: subseteqEX_restRefusal_iff)
apply (simp add: in_failures)
apply (intro allI impI)
apply (elim conjE)
apply (rule conjI)

 apply (rotate_tac 1)
 apply (drule_tac x="s" in spec)
 apply (drule_tac x="Y" in spec)
 apply (fast)

 apply (rotate_tac 3)
 apply (drule_tac x="s" in spec)
 apply (drule_tac x="Y" in spec)
 apply (fast)
done

(*-----------*
 | csp rules |
 *-----------*)

lemma cspF_subseteqEX_Int_choice:
  "[| P =F P1 |~| P2 ;
      F = F1 Un F2 ;
      F1 <=EX failures P1 MF restRefusal A ;
      F2 <=EX failures P2 MF restRefusal A |]
   ==> F <=EX failures P  MF restRefusal A"
apply (simp add: eqF_def)
apply (simp add: eqF_decompo)
apply (simp add: subseteqEX_Int_choice)
done

(*------------------------*
 |   Rep_int_choice_nat   |
 *------------------------*)

(* eq *)

lemma subseteqEX_Rep_int_choice_nat:
  "[| ALL n : N. Ff n <=EX failures(Pf n) MF restRefusal A |]
    ==> Union {(Ff n)|n. n : N} <=EX failures (!nat :N .. Pf) MF restRefusal A"
apply (simp add: subseteqEX_restRefusal_iff)
apply (simp add: in_failures)
apply (rule conjI)

 (* 1 *)
 apply (force)

 (* 2 *)
 apply (intro allI impI)
 apply (elim conjE bexE)
 apply (drule_tac x="n" in bspec, simp)
 apply (elim conjE)
 apply (rotate_tac -1)
 apply (drule_tac x="s" in spec)
 apply (drule_tac x="Y" in spec)
 apply (auto)
done

(*-----------*
 | csp rules |
 *-----------*)

lemma cspF_subseteqEX_Rep_int_choice_nat:
  "[| P =F !nat :N .. Pf ;
      F = Union {(Ff n)|n. n : N} ;
      ALL n : N. Ff n <=EX failures(Pf n) MF restRefusal A |]
   ==> F <=EX failures (!nat :N .. Pf) MF restRefusal A"
by (simp add: subseteqEX_Rep_int_choice_nat)

(*------------------------*
 |   Rep_int_choice_set   |
 *------------------------*)

(* eq *)

lemma subseteqEX_Rep_int_choice_set:
  "[| ALL X : Xs. Ff X <=EX failures(Pf X) MF restRefusal A |]
    ==> Union {(Ff X)|X. X : Xs} <=EX failures (!set :Xs .. Pf) MF restRefusal A"
apply (simp add: subseteqEX_restRefusal_iff)
apply (simp add: in_failures)
apply (rule conjI)

 (* 1 *)
 apply (force)

 (* 2 *)
 apply (intro allI impI)
 apply (elim conjE bexE)
 apply (drule_tac x="X" in bspec, simp)
 apply (elim conjE)
 apply (rotate_tac -1)
 apply (drule_tac x="s" in spec)
 apply (drule_tac x="Y" in spec)
 apply (auto)
done

(*-----------*
 | csp rules |
 *-----------*)

lemma cspF_subseteqEX_Rep_int_choice_set:
  "[| P =F !set :Xs .. Pf ;
      F = Union {(Ff X)|X. X : Xs} ;
      ALL X : Xs. Ff X <=EX failures(Pf X) MF restRefusal A |]
   ==> F <=EX failures (!set :Xs .. Pf) MF restRefusal A"
by (simp add: subseteqEX_Rep_int_choice_set)

(* com *)

lemma cspF_subseteqEX_Rep_int_choice_com:
  "[| P =F ! :X .. Pf ;
      F = Union {(Ff a)|a. a : X} ;
      ALL a : X. Ff a <=EX failures(Pf a) MF restRefusal A |]
   ==> F <=EX failures (! :X .. Pf) MF restRefusal A"
apply (unfold Rep_int_choice_com_def)
apply (rule cspF_subseteqEX_Rep_int_choice_set[of _ _ _ _ "(%X. Ff(the_elem X))"])
apply (auto)
apply (rule_tac x="Ff (the_elem {aa})" in exI)
apply (simp)
apply (rule_tac x="{aa}" in exI)
apply (simp)
done

(* f *)

lemma cspF_subseteqEX_Rep_int_choice_f:
  "[| inj f;  P =F !<f> :X .. Pf ;
      F = Union {(Ff a) |a. a : X} ;
      ALL a : X. Ff a <=EX failures(Pf a) MF restRefusal A |]
   ==> F <=EX failures (!<f> :X .. Pf) MF restRefusal A"
apply (unfold Rep_int_choice_f_def)
apply (rule cspF_subseteqEX_Rep_int_choice_com[of _ _ _ _ "(%x. Ff(inv f x))"])
apply (auto)

 apply (rule_tac x="Ff aa" in exI)
 apply (simp)
 apply (rule_tac x="f aa" in exI)
 apply (simp)
done

lemmas cspF_subseteqEX_Rep_int_choice =
       cspF_subseteqEX_Rep_int_choice_nat
       cspF_subseteqEX_Rep_int_choice_set
       cspF_subseteqEX_Rep_int_choice_com
       cspF_subseteqEX_Rep_int_choice_f

lemma cspF_subseteqEX_Rep_int_choice_nat_UNIV:
  "[| P =F !nat n .. Pf n ;
      F = Union {(Ff a) |a. True} ;
      ALL a. Ff a <=EX failures(Pf a) MF restRefusal A |]
   ==> F <=EX failures (!nat n .. Pf n) MF restRefusal A"
apply (insert cspF_subseteqEX_Rep_int_choice_nat[of P UNIV Pf F Ff A])
by (simp_all)

(*--------------------*
 |   Ext_pre_choice   |
 *--------------------*)

(* eq *)

lemma subseteqEX_Ext_pre_choice:
  "ALL a : X. Ff a <=EX failures (Pf a) MF restRefusal A
    ==> insert (<>, A - Ev ` X)
        {(<Ev a> ^^^ s, Y) |a s Y. (s,Y) : Ff a & a : X}
        <=EX failures (? :X -> Pf) MF restRefusal A"
apply (simp add: subseteqEX_restRefusal_iff)
apply (simp add: in_failures)
apply (intro conjI)

 (* 1 *)
 apply (fast)

 (* 2 *)
 apply (intro allI impI)
 apply (rule conjI)
  apply (fast)

  apply (intro impI)
  apply (elim conjE exE)
  apply (drule_tac x="a" in bspec, simp)
  apply (elim conjE)
  apply (rotate_tac -1)
  apply (drule_tac x="sa" in spec)
  apply (drule_tac x="Y" in spec)
  apply (simp)
done

(*-----------*
 | csp rules |
 *-----------*)

lemma cspF_subseteqEX_Ext_pre_choice:
  "[| P =F ? :X -> Pf ;
      F = insert (<>, A - Ev ` X)
          {(<Ev a> ^^^ s, Y) |a s Y. (s,Y) : Ff a & a : X} ;
      ALL a : X. Ff a <=EX failures (Pf a) MF restRefusal A |]
   ==> F <=EX failures P MF restRefusal A"
by (simp add: eqF_def eqF_decompo subseteqEX_Ext_pre_choice)

(*-----------*
 | csp rules |
 *-----------*)

lemma cspF_subseteqEX_eqF:
  "[| P =F Q ;
       FS <=EX failures Q MF restRefusal A |]
   ==> FS <=EX failures P MF restRefusal A"
by (simp add: eqF_def eqF_decompo)

(****************** to add them again ******************)

end


(*
  File: Mapping_Str.thy
  Author: Bohua Zhan
*)

section \<open>Mapping\<close>

theory Mapping_Str
  imports "Auto2_HOL.Auto2_Main"
begin

text \<open>
  Basic definitions of a mapping. Here, we enclose the mapping inside
  a structure, to make evaluation a first-order concept.
\<close>

datatype ('a, 'b) map = Map "'a \<Rightarrow> 'b option"

fun meval :: "('a, 'b) map \<Rightarrow> 'a \<Rightarrow> 'b option" ("_\<langle>_\<rangle>" [90]) where
  "(Map f) \<langle>h\<rangle> = f h"
setup \<open>add_rewrite_rule @{thm meval.simps}\<close>

lemma meval_ext: "\<forall>x. M\<langle>x\<rangle> = N\<langle>x\<rangle> \<Longrightarrow> M = N"
  apply (cases M) apply (cases N) by auto
setup \<open>add_backward_prfstep_cond @{thm meval_ext} [with_filt (order_filter "M" "N")]\<close>

definition empty_map :: "('a, 'b) map" where
  "empty_map = Map (\<lambda>x. None)"
setup \<open>add_rewrite_rule @{thm empty_map_def}\<close>

definition update_map :: "('a, 'b) map \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a ,'b) map" (" _ { _ \<rightarrow> _ }" [89,90,90] 90) where
  "M {k \<rightarrow> v} = Map (\<lambda>x. if x = k then Some v else M\<langle>x\<rangle>)"
setup \<open>add_rewrite_rule @{thm update_map_def}\<close>

definition delete_map :: "'a \<Rightarrow> ('a, 'b) map \<Rightarrow> ('a, 'b) map" where
  "delete_map k M = Map (\<lambda>x. if x = k then None else M\<langle>x\<rangle>)"
setup \<open>add_rewrite_rule @{thm delete_map_def}\<close>

subsection \<open>Map from an AList\<close>

fun map_of_alist :: "('a \<times> 'b) list \<Rightarrow> ('a, 'b) map" where
  "map_of_alist [] = empty_map"
| "map_of_alist (x # xs) = (map_of_alist xs) {fst x \<rightarrow> snd x}"
setup \<open>fold add_rewrite_rule @{thms map_of_alist.simps}\<close>

definition has_key_alist :: "('a \<times> 'b) list \<Rightarrow> 'a \<Rightarrow> bool" where [rewrite]:
  "has_key_alist xs a \<longleftrightarrow> (\<exists>p\<in>set xs. fst p = a)"

lemma map_of_alist_nil [rewrite_back]:
  "has_key_alist ys x \<longleftrightarrow> (map_of_alist ys)\<langle>x\<rangle> \<noteq> None"
@proof @induct ys @qed
setup \<open>add_rewrite_rule_cond @{thm map_of_alist_nil} [with_term "(map_of_alist ?ys)\<langle>?x\<rangle>"]\<close>

lemma map_of_alist_some [forward]:
  "(map_of_alist xs)\<langle>k\<rangle> = Some v \<Longrightarrow> (k, v) \<in> set xs"
@proof @induct xs @qed

lemma map_of_alist_nil':
  "x \<in> set (map fst ys) \<longleftrightarrow> (map_of_alist ys)\<langle>x\<rangle> \<noteq> None"
@proof @induct ys @qed
setup \<open>add_rewrite_rule_cond @{thm map_of_alist_nil'} [with_term "(map_of_alist ?ys)\<langle>?x\<rangle>"]\<close>

subsection \<open>Mapping defined by a set of key-value pairs\<close>

definition unique_keys_set :: "('a \<times> 'b) set \<Rightarrow> bool" where [rewrite]:
  "unique_keys_set S = (\<forall>i x y. (i, x) \<in> S \<longrightarrow> (i, y) \<in> S \<longrightarrow> x = y)"

lemma unique_keys_setD [forward]: "unique_keys_set S \<Longrightarrow> (i, x) \<in> S \<Longrightarrow> (i, y) \<in> S \<Longrightarrow> x = y" by auto2
setup \<open>del_prfstep_thm_eqforward @{thm unique_keys_set_def}\<close>

definition map_of_aset :: "('a \<times> 'b) set \<Rightarrow> ('a, 'b) map" where
  "map_of_aset S = Map (\<lambda>a. if \<exists>b. (a, b) \<in> S then Some (THE b. (a, b) \<in> S) else None)"
setup \<open>add_rewrite_rule @{thm map_of_aset_def}\<close>
setup \<open>add_prfstep_check_req ("map_of_aset S", "unique_keys_set S")\<close>

lemma map_of_asetI1 [rewrite]: "unique_keys_set S \<Longrightarrow> (a, b) \<in> S \<Longrightarrow> (map_of_aset S)\<langle>a\<rangle> = Some b"
@proof @have "\<exists>b. (a, b) \<in> S" @have "\<exists>!b. (a, b) \<in> S" @qed

lemma map_of_asetI2 [rewrite]: "\<forall>b. (a, b) \<notin> S \<Longrightarrow> (map_of_aset S)\<langle>a\<rangle> = None" by auto2

lemma map_of_asetD1 [forward]: "(map_of_aset S)\<langle>a\<rangle> = None \<Longrightarrow> \<forall>b. (a, b) \<notin> S" by auto2

lemma map_of_asetD2 [forward]:
  "unique_keys_set S \<Longrightarrow> (map_of_aset S)\<langle>a\<rangle> = Some b \<Longrightarrow> (a, b) \<in> S" by auto2
setup \<open>del_prfstep_thm @{thm map_of_aset_def}\<close>

lemma map_of_aset_insert [rewrite]:
  "unique_keys_set (S \<union> {(k, v)}) \<Longrightarrow> map_of_aset (S \<union> {(k, v)}) = (map_of_aset S) {k \<rightarrow> v}"
@proof
  @let "M = map_of_aset S" "N = map_of_aset (S \<union> {(k, v)})"
  @have (@rule) "\<forall>x. N\<langle>x\<rangle> = (M {k \<rightarrow> v}) \<langle>x\<rangle>" @with @case "M\<langle>x\<rangle> = None" @end
@qed

lemma map_of_alist_to_aset [rewrite]:
  "unique_keys_set (set xs) \<Longrightarrow> map_of_aset (set xs) = map_of_alist xs"
@proof @induct xs @with
  @subgoal "xs = x # xs'"
    @have "set (x # xs') = set xs' \<union> {x}"
  @endgoal @end
@qed

lemma map_of_aset_delete [rewrite]:
  "unique_keys_set S \<Longrightarrow> (k, v) \<in> S \<Longrightarrow> map_of_aset (S - {(k, v)}) = delete_map k (map_of_aset S)"
@proof
  @let "T = S - {(k, v)}"
  @let "M = map_of_aset S" "N = map_of_aset T"
  @have (@rule) "\<forall>x. N\<langle>x\<rangle> = (delete_map k M) \<langle>x\<rangle>" @with
    @case "M\<langle>x\<rangle> = None" @case "x = k"
    @obtain y where "M\<langle>x\<rangle> = Some y" @have "(x, y) \<in> T"
  @end
@qed

lemma map_of_aset_update [rewrite]:
  "unique_keys_set S \<Longrightarrow> (k, v) \<in> S \<Longrightarrow>
   map_of_aset (S - {(k, v)} \<union> {(k, v')}) = (map_of_aset S) {k \<rightarrow> v'}" by auto2

lemma map_of_alist_delete [rewrite]:
  "set xs' = set xs - {x} \<Longrightarrow> unique_keys_set (set xs) \<Longrightarrow> x \<in> set xs \<Longrightarrow>
   map_of_alist xs' = delete_map (fst x) (map_of_alist xs)"
@proof @have "map_of_alist xs' = map_of_aset (set xs')" @qed

lemma map_of_alist_insert [rewrite]:
  "set xs' = set xs \<union> {x} \<Longrightarrow> unique_keys_set (set xs') \<Longrightarrow>
   map_of_alist xs' = (map_of_alist xs) {fst x \<rightarrow> snd x}"
@proof @have "map_of_alist xs' = map_of_aset (set xs')" @qed

lemma map_of_alist_update [rewrite]:
  "set xs' = set xs - {(k, v)} \<union> {(k, v')} \<Longrightarrow> unique_keys_set (set xs) \<Longrightarrow> (k, v) \<in> set xs \<Longrightarrow>
   map_of_alist xs' = (map_of_alist xs) {k \<rightarrow> v'}"
@proof @have "map_of_alist xs' = map_of_aset (set xs')" @qed

subsection \<open>Set of keys of a mapping\<close>

definition keys_of :: "('a, 'b) map \<Rightarrow> 'a set" where [rewrite]:
  "keys_of M = {x. M\<langle>x\<rangle> \<noteq> None}"

lemma keys_of_iff [rewrite_bidir]: "x \<in> keys_of M \<longleftrightarrow> M\<langle>x\<rangle> \<noteq> None" by auto2
setup \<open>del_prfstep_thm @{thm keys_of_def}\<close>

lemma keys_of_empty [rewrite]: "keys_of empty_map = {}" by auto2

lemma keys_of_delete [rewrite]:
  "keys_of (delete_map x M) = keys_of M - {x}" by auto2

subsection \<open>Minimum of a mapping, relevant for heaps (priority queues)\<close>

definition is_heap_min :: "'a \<Rightarrow> ('a, 'b::linorder) map \<Rightarrow> bool" where [rewrite]:
  "is_heap_min x M \<longleftrightarrow> x \<in> keys_of M \<and> (\<forall>k\<in>keys_of M. the (M\<langle>x\<rangle>) \<le> the (M\<langle>k\<rangle>))"

subsection \<open>General construction and update of maps\<close>

fun map_constr :: "(nat \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> (nat, 'a) map" where
  "map_constr S f 0 = empty_map"
| "map_constr S f (Suc k) = (let M = map_constr S f k in if S k then M {k \<rightarrow> f k} else M)"
setup \<open>fold add_rewrite_rule @{thms map_constr.simps}\<close>

lemma map_constr_eval [rewrite]:
  "map_constr S f n = Map (\<lambda>i. if i < n then if S i then Some (f i) else None else None)"
@proof @induct n @qed

lemma keys_of_map_constr [rewrite]:
  "i \<in> keys_of (map_constr S f n) \<longleftrightarrow> (S i \<and> i < n)" by auto2

definition map_update_all :: "(nat \<Rightarrow> 'a) \<Rightarrow> (nat, 'a) map \<Rightarrow> (nat, 'a) map" where [rewrite]:
  "map_update_all f M = Map (\<lambda>i. if i \<in> keys_of M then Some (f i) else M\<langle>i\<rangle>)"

fun map_update_all_impl :: "(nat \<Rightarrow> 'a) \<Rightarrow> (nat, 'a) map \<Rightarrow> nat \<Rightarrow> (nat, 'a) map" where
  "map_update_all_impl f M 0 = M"
| "map_update_all_impl f M (Suc k) =
   (let M' = map_update_all_impl f M k in if k \<in> keys_of M then M' {k \<rightarrow> f k} else M')"
setup \<open>fold add_rewrite_rule @{thms map_update_all_impl.simps}\<close>

lemma map_update_all_impl_ind [rewrite]:
  "map_update_all_impl f M n = Map (\<lambda>i. if i < n then if i \<in> keys_of M then Some (f i) else None else M\<langle>i\<rangle>)"
@proof @induct n @qed

lemma map_update_all_impl_correct [rewrite]:
  "\<forall>i\<in>keys_of M. i < n \<Longrightarrow> map_update_all_impl f M n = map_update_all f M" by auto2

lemma keys_of_map_update_all [rewrite]:
  "keys_of (map_update_all f M) = keys_of M" by auto2

end


theory "InstructionPc"

imports
   "InstructionAux" "../../ProgramInAvl"

begin

(* declare cut_memory.simps [simp del] *)

fun is_inc_pc :: "inst option \<Rightarrow> bool" where
  "is_inc_pc (Some (Pc JUMP)) = False"
| "is_inc_pc (Some (Pc JUMPI)) = False"
| "is_inc_pc (Some (Stack (PUSH_N _))) = False"
| "is_inc_pc (Some (Unknown _)) = False"
| "is_inc_pc _ = True"

theorem inc_pc_one [simp] :
   "is_inc_pc (Some inst) \<Longrightarrow> inst_size inst = 1"
apply(induction "Some inst" rule:is_inc_pc.induct)
apply(auto)
done

declare vctx_advance_pc_def [simp del]
declare inst_size_def [simp del]

theorem lemma_advance [simp] :
  "is_inc_pc (vctx_next_instruction v c) \<Longrightarrow>
   vctx_pc (vctx_advance_pc c v) = vctx_pc v + 1"
apply(auto simp:vctx_advance_pc_def)
apply(cases " vctx_next_instruction v c")
apply(auto)
done

declare stack_1_1_op_def [simp del]

theorem lemma_stack_op_2_1 [simp] :
 "stack_2_1_op v c fn = InstructionContinue nv \<Longrightarrow>
  is_inc_pc (vctx_next_instruction v c) \<Longrightarrow>
  vctx_pc nv = vctx_pc v + 1"
apply(simp add:stack_2_1_op_def)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
done

theorem lemma_stack_op_1_1 [simp] :
 "stack_1_1_op v c fn = InstructionContinue nv \<Longrightarrow>
  is_inc_pc (vctx_next_instruction v c) \<Longrightarrow>
  vctx_pc nv = vctx_pc v + 1"
apply(simp add:stack_1_1_op_def)
apply(cases "vctx_stack v")
apply(auto)
done

theorem lemma_stack_op_3_1 [simp] :
 "stack_3_1_op v c fn = InstructionContinue nv \<Longrightarrow>
  is_inc_pc (vctx_next_instruction v c) \<Longrightarrow>
  vctx_pc nv = vctx_pc v + 1"
apply(simp add:stack_3_1_op_def)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto)
done

theorem lemma_pop_stack [simp] :
   "vctx_pc (vctx_pop_stack x v) = vctx_pc v"
apply auto
done

theorem lemma_log [simp] :
 "Evm.log x v c = InstructionContinue nv \<Longrightarrow>
  is_inc_pc (vctx_next_instruction v c) \<Longrightarrow>
  vctx_pc nv = vctx_pc v + 1"
apply(auto simp:log_def split:option.split)
done

declare vctx_next_instruction_def [simp del]

declare stack_2_1_op_def [simp del]
declare stack_3_1_op_def [simp del]

theorem no_jump_inc_pc_aux :
  "instruction_aux v c inst = InstructionContinue nv \<Longrightarrow>
   vctx_next_instruction v c = Some inst \<Longrightarrow>
   is_inc_pc (vctx_next_instruction v c) \<Longrightarrow>
   vctx_pc nv = vctx_pc v + 1"
apply(auto)
apply(cases "vctx_next_instruction v c")
apply(auto)

apply(cases "inst")
apply (auto simp:instruction_aux_def)
apply(cases "get_bits (Some inst)")
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(cases "get_sarith (Some inst)")
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(cases "get_arith (Some inst)")
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(simp)
apply(cases "vctx_stack v")
apply(simp add:sha3_def)
apply(cases "tl (vctx_stack v)")
apply(simp add:sha3_def)
apply(simp add:sha3_def)
apply(auto)

apply(cases "get_info (Some inst)")
apply(simp)
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply auto[1]
apply(cases "index (vctx_stack v)
              (nat (uint (get_dup (Some inst))))")
apply auto[1]
apply auto[1]
apply(cases "get_memory (Some inst)")
apply(simp)
apply(cases "vctx_stack v")
apply(simp)
apply auto[1]
apply simp
apply(cases "vctx_stack v")
apply(simp)
apply(cases "tl (vctx_stack v)")
apply auto[1]
apply auto[1]
apply(simp)
apply(cases "vctx_stack v")
apply(simp)
apply(cases "tl (vctx_stack v)")
apply(simp)
apply(auto)[1]
apply(simp)

apply(cases "vctx_stack v")
apply(simp)
apply(simp)
apply(cases "tl (vctx_stack v)")
apply(simp)
apply(simp)
apply(cases "tl (tl (vctx_stack v))")
apply(simp)
apply auto[1]
apply(simp)
(* apply(simp add:codecopy_def) *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(cases "tl (vctx_stack v)")
apply(auto)[1]
apply(cases "tl (tl (vctx_stack v))")
apply(auto)[1]
apply(auto)[1]
(* apply(simp add:extcodecopy_def) *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(cases "tl (vctx_stack v)")
apply(auto)[1]
apply(cases "tl (tl (vctx_stack v))")
apply(auto)[1]
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto)[1]
apply(auto)[1]
apply(auto)[1]
apply(cases "get_storage (Some inst)")
apply(auto)[1]
(* apply(simp add:sstore_def) *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(cases "tl (vctx_stack v)")
apply simp
using vctx_next_instruction_def
apply fastforce
defer
defer
apply(cases "index (vctx_stack v) (Suc (nat (uint (get_swap (Some inst)))))")
apply(auto)[1]
apply(auto)[1]
apply(cases "index (vctx_stack v) 0")
apply(auto)[1]
apply(auto)[1]
apply(cases "get_log (Some inst)")
apply(auto)[1]
using vctx_next_instruction_def apply fastforce
using vctx_next_instruction_def apply fastforce
using vctx_next_instruction_def apply fastforce
using vctx_next_instruction_def apply fastforce
apply(cases "get_misc (Some inst)")
apply(auto)[1]

(*apply(simp add:create_def) *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(cases "tl (vctx_stack v)")
apply(auto)[1]
apply(cases "tl (tl (vctx_stack v))")
apply(auto)[1]
apply(cases "vctx_balance v (cctx_this c) < hd (vctx_stack v)")
apply(auto)[1]
apply(auto)[1]

(* apply(simp add:call_def)  *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(cases "tl (vctx_stack v)")
apply(auto)[1]
apply(cases "tl (tl (vctx_stack v))")
apply(auto)[1]
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto)[1]
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(auto)[1]
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(auto)[1]
apply(cases "tl (tl (tl (tl (tl (tl (vctx_stack v))))))")
apply(auto)[1]
apply(auto)[1]
apply(cases "vctx_balance v (cctx_this c) <
    hd (tl (tl (vctx_stack v)))")
apply(auto)[1]
apply(auto)[1]
(* apply(simp add:callcode_def) *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(cases "tl (vctx_stack v)")
apply(auto)[1]
apply(cases "tl (tl (vctx_stack v))")
apply(auto)[1]
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto)[1]
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(auto)[1]
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(auto)[1]
apply(cases "tl (tl (tl (tl (tl (tl (vctx_stack v))))))")
apply(auto)[1]
apply(cases "vctx_balance v (cctx_this c) <
    hd (tl (tl (vctx_stack v)))")
apply(auto)[1]
apply(auto)[1]
(* apply(simp add:delegatecall_def) *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(cases "tl (vctx_stack v)")
apply(auto)[1]
apply(cases "tl (tl (vctx_stack v))")
apply(auto)[1]
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto)[1]
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(auto)[1]
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(auto)[1]
apply(cases "vctx_balance v (cctx_this c) <
    vctx_value_sent v")
apply(auto)[1]
apply(auto)[1]
(* apply(simp add:ret_def) *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(cases "tl (vctx_stack v)")
apply(auto)[1]
apply(auto)[1]
(* apply(simp add:suicide_def) *)
apply(cases "vctx_stack v")
apply(auto)[1]
apply(auto)[1]
apply(cases "get_pc (Some inst)")
apply(auto)[1]
apply(auto)[1]
apply(auto)[1]
apply(auto)[1]
(* apply(simp add:pc_def) *)

apply(cases "get_stack inst")
apply(auto)[1]

apply(cases "vctx_stack v")
apply(auto)[1]
apply(auto)[1]
apply(auto)[1]
apply(auto)[1]

done

lemma lemma_subtract :
  "subtract_gas x (InstructionContinue v) = InstructionContinue nv \<Longrightarrow>
   vctx_pc v = vctx_pc nv"
apply auto
done

theorem no_jump_inc_pc :
  "instruction_sem v c inst = InstructionContinue nv \<Longrightarrow>
   vctx_next_instruction v c = Some inst \<Longrightarrow>
   is_inc_pc (vctx_next_instruction v c) \<Longrightarrow>
   vctx_pc nv = vctx_pc v + 1"
apply(subst (asm) inst_gas)
apply(cases "instruction_aux v c inst")
defer
apply(simp)
apply(simp)
  by (metis lemma_subtract no_jump_inc_pc_aux)

theorem push_inc_pc_aux :
  "instruction_aux v c (Stack (PUSH_N lst)) = InstructionContinue nv \<Longrightarrow>
   vctx_next_instruction v c = Some (Stack (PUSH_N lst)) \<Longrightarrow>
   \<not>(lst = []) \<Longrightarrow>
   32 \<ge> length lst \<Longrightarrow>
   vctx_pc nv = vctx_pc v + length lst + 1"
apply(auto simp:instruction_aux_def)
apply(auto simp:vctx_advance_pc_def inst_size_def)
done

theorem push_inc_pc :
  "instruction_sem v c (Stack (PUSH_N lst)) = InstructionContinue nv \<Longrightarrow>
   vctx_next_instruction v c = Some (Stack (PUSH_N lst)) \<Longrightarrow>
   \<not>(lst = []) \<Longrightarrow>
   32 \<ge> length lst \<Longrightarrow>
   vctx_pc nv = vctx_pc v + length lst + 1"
apply(subst (asm) inst_gas)
apply(cases "instruction_aux v c (Stack (PUSH_N lst))")
defer
apply(simp)
apply(simp)
  by (metis lemma_subtract push_inc_pc_aux)

declare is_inc_pc.simps [simp del]
declare inc_pc_one [simp del]
declare lemma_log [simp del]
declare lemma_stack_op_2_1 [simp del]
declare lemma_stack_op_3_1 [simp del]
declare lemma_pop_stack [simp del]

end


theory Chunkvals
imports "../compcert/Memory"
begin

function length_to_quant :: "'a list \<Rightarrow> quantity option" where
  "length l = 4 \<Longrightarrow> length_to_quant l = Some Q32"
| "length l = 8 \<Longrightarrow> length_to_quant l = Some Q64"
| "length l \<notin> {4,8} \<Longrightarrow> length_to_quant l = None"
  by auto
termination
  apply standard
  by auto

lemma length_to_quant_inj_value[simp]: "length_to_quant (inj_value q v) = Some q"
  apply (cases q)
  by auto

datatype chunkval =
  CVword8 "8 word" | CVword16 "16 word" | CVword32 "32 word" | CVword64 "64 word"
| CVfragments val quantity | CVundef positive

fun size_chunkval_nat :: "chunkval \<Rightarrow> nat" where
  "size_chunkval_nat (CVword8 _) = 1"
| "size_chunkval_nat (CVword16 _) = 2"
| "size_chunkval_nat (CVword32 _) = 4"
| "size_chunkval_nat (CVword64 _) = 8"
| "size_chunkval_nat (CVfragments _ q) = size_quantity_nat q"
| "size_chunkval_nat (CVundef l) = nat_of_num l"

lemma size_chunkval_nat_g0[iff]:
  "0 < size_chunkval_nat cv"
  apply (cases cv)
  by (auto simp add: nat_of_num_pos)

inductive chunk_fits_chunkval where
  "chunk_fits_chunkval Mint8signed (CVword8 _)"
| "chunk_fits_chunkval Mint8unsigned (CVword8 _)"
| "chunk_fits_chunkval Mint16signed (CVword16 _)"
| "chunk_fits_chunkval Mint16unsigned (CVword16 _)"
| "chunk_fits_chunkval Mint32 (CVword32 _)"
| "chunk_fits_chunkval Mfloat32 (CVword32 _)"
| "chunk_fits_chunkval Many32 (CVword32 _)"
| "chunk_fits_chunkval Mint32 (CVfragments _ Q32)"
| "chunk_fits_chunkval Mfloat32 (CVfragments _ Q32)"
| "chunk_fits_chunkval Many32 (CVfragments _ Q32)"
| "chunk_fits_chunkval Mint64 (CVword64 _)"
| "chunk_fits_chunkval Mfloat64 (CVword64 _)"
| "chunk_fits_chunkval Many64 (CVword64 _)"
| "chunk_fits_chunkval Mint64 (CVfragments _ Q64)"
| "chunk_fits_chunkval Mfloat64 (CVfragments _ Q64)"
| "chunk_fits_chunkval Many64 (CVfragments _ Q64)"
| "size_chunk_nat chunk = nat_of_num l \<Longrightarrow> chunk_fits_chunkval chunk (CVundef l)"

lemma chunk_fits_chunkval_size:
  shows "chunk_fits_chunkval chunk cv \<longleftrightarrow> size_chunkval_nat cv = size_chunk_nat chunk"
  apply (cases chunk; cases cv)
  by (auto simp: size_chunk_nat.simps num_of_nat_inverse chunk_fits_chunkval.simps elim: size_quantity_nat.elims)

section \<open>Equivalence with memvals\<close>

fun chunkval_to_memvals :: "chunkval \<Rightarrow> memval list" where
  "chunkval_to_memvals (CVword8 w) = inj_bytes (encode_int 1 (uint w))"
| "chunkval_to_memvals (CVword16 w) = inj_bytes (encode_int 2 (uint w))"
| "chunkval_to_memvals (CVword32 w) = inj_bytes (encode_int 4 (uint w))"
| "chunkval_to_memvals (CVword64 w) = inj_bytes (encode_int 8 (uint w))"
| "chunkval_to_memvals (CVfragments v q) = inj_value q v"
| "chunkval_to_memvals (CVundef sz) = replicate (nat_of_num sz) Undef"

lemma length_chunkval_to_memvals[simp]:
  "length (chunkval_to_memvals cv) = size_chunkval_nat cv"
  apply (cases cv)
  by auto

section \<open>Encoding/Decoding\<close>

fun encode_chunkval :: "memory_chunk \<Rightarrow> val \<Rightarrow> chunkval" where
  "encode_chunkval Mint8signed (Vint n) = (CVword8 (ucast n))"
| "encode_chunkval Mint8unsigned (Vint n) = (CVword8 (ucast n))"
| "encode_chunkval Mint16signed (Vint n) = (CVword16 (ucast n))"
| "encode_chunkval Mint16unsigned (Vint n) = (CVword16 (ucast n))"
| "encode_chunkval Mint32 (Vint n) = (CVword32 n)"
| "encode_chunkval Mint64 (Vlong n) = (CVword64 n)"
| "encode_chunkval Mint64 (Vptr b ofs) = (CVfragments (Vptr b ofs) Q64)"
| "encode_chunkval Mfloat32 (Vsingle f) = (CVword32 (fp32_of_float f))"
| "encode_chunkval Mfloat64 (Vfloat f) = (CVword64 (fp64_of_float f))"
| "encode_chunkval Many32 v = (CVfragments v Q32)" (* done like this in encode_val *)
| "encode_chunkval Many64 v = (CVfragments v Q64)"
| "encode_chunkval chunk _ = CVundef (num_of_nat (size_chunk_nat chunk))"

lemma size_encode_chunkval[simp]:
  "size_chunkval_nat (encode_chunkval chunk v) = size_chunk_nat chunk"
  apply (rule encode_chunkval.cases[of "(chunk, v)"])
  apply (auto simp add: size_chunk_nat.simps)
  using nat_of_num_inverse nat_of_num_numeral by auto

lemma chunk_fits_chunkval_encode[iff]:
  shows "chunk_fits_chunkval chunk (encode_chunkval chunk v)"
  apply (cases chunk; cases v)
  by (auto intro!: chunk_fits_chunkval.intros simp: num_of_nat_inverse)

fun decode_chunkval :: "memory_chunk \<Rightarrow> chunkval \<Rightarrow> val" where
  "decode_chunkval Mint8signed cv     = (case cv of (CVword8 w) \<Rightarrow> Vint (scast w) | _ \<Rightarrow> Vundef)"
| "decode_chunkval Mint8unsigned cv   = (case cv of (CVword8 w) \<Rightarrow> Vint (ucast w) | _ \<Rightarrow> Vundef)"
| "decode_chunkval Mint16signed cv    = (case cv of (CVword16 w) \<Rightarrow> Vint (scast w) | _ \<Rightarrow> Vundef)"
| "decode_chunkval Mint16unsigned cv  = (case cv of (CVword16 w) \<Rightarrow> Vint (ucast w) | _ \<Rightarrow> Vundef)"
| "decode_chunkval Mint32 cv          = (case cv of (CVword32 w) \<Rightarrow> Vint w | _ \<Rightarrow> Vundef)"
| "decode_chunkval Mint64 cv          = (case cv of
    (CVword64 w) \<Rightarrow> Vlong w
  | (CVfragments (Vlong w) Q64) \<Rightarrow> (Vlong w)
  | (CVfragments (Vptr b ofs) Q64) \<Rightarrow> (Vptr b ofs)
  | _ \<Rightarrow> Vundef)"
| "decode_chunkval Mfloat32 cv        = (case cv of (CVword32 w) \<Rightarrow> (Vsingle (float_of_fp32 w))| _ \<Rightarrow> Vundef)"
| "decode_chunkval Mfloat64 cv        = (case cv of (CVword64 w) \<Rightarrow> (Vfloat (float_of_fp64 w))| _ \<Rightarrow> Vundef)"
| "decode_chunkval Many32 cv = (case cv of
    (CVfragments (Vint n) Q32) \<Rightarrow> (Vint n)
  | (CVfragments (Vsingle f) Q32) \<Rightarrow> (Vsingle f)
  | _ \<Rightarrow> Vundef)"
| "decode_chunkval Many64 cv = (case cv of
    (CVfragments v Q64) \<Rightarrow> v
  | _ \<Rightarrow> Vundef)"

lemma encode_chunkval_val[simp]: "chunkval_to_memvals (encode_chunkval chunk v) = encode_val chunk v"
  apply (cases chunk; cases v)
  apply (auto simp: mem_simps uint_word_of_int encode_int_truncate' encode_val.simps)
  using nat_of_num_inverse nat_of_num_numeral by auto

lemma decode_chunkval_val[simp]: "decode_val chunk (chunkval_to_memvals cv) = decode_chunkval chunk cv"
  if "chunk_fits_chunkval chunk cv" (* decode_val doesn't enforce this, but Mem.load does *)
  using that
  apply (auto elim!: chunk_fits_chunkval.cases)
  by (auto simp: mem_simps decode_val.simps split: val.split option.splits memory_chunk.splits)

(* if we encode a value as memvals and as a chunkval, the decoding will agree *)
lemma encode_decode_chunkval[simp]:
  shows "decode_chunkval chunk (encode_chunkval chunk v) = Val.load_result chunk v"
  apply (cases chunk; cases v)
  by (auto)

declare encode_chunkval.simps[simp del] decode_chunkval.simps[simp del]

section \<open>Memory accesses with Chunkvals\<close>

lemma load_chunkval:
  assumes [iff]: "chunk_fits_chunkval chunk cv"
  assumes [iff]: "Mem.valid_access m chunk b ofs Readable"
  assumes [simp]: "Mem.getN (size_chunk_nat chunk) ofs (mem_contents m b) = chunkval_to_memvals cv"
  shows "Mem.load chunk m b ofs = Some (decode_chunkval chunk cv)"
  by (auto simp: Mem.load.simps)

end


theory goal
	imports "processDef"
begin

(*The safety property to prove.*)
definition safeProp :: fform where
"safeProp == (plant_v1_1 [+](Con Real 2)) [<] (Con Real 0.05) [&] (plant_v1_1 [+] (Con Real 2)) [>] (Con Real -0.05)"

(*The system clock is always positive.*)
axiomatization where
Clock : "\<forall> s. (t [\<ge>] Con Real 0) s"

(*The following lists the constraints for solving the differential invariants for the
differential equations.*)
(*The invariant guarantees the postcondition.*)
definition cons1 :: fform where
"cons1 \<equiv> ((t [\<ge>]Con Real 0 [&] t [\<le>] Con Real 0.128 [&] Inv) [\<longrightarrow>]  safeProp)"
(*Initialization:the initial state guarantees the invariant;
and Computation: the computation guarantees the invariant.*)
definition cons2 :: fform where
"cons2 \<equiv> ((plant_v1_1[=](Con Real -2) [&] plant_m1_1[=](Con Real 1250)
    [&] control_1[=](Con Real 4055/2) [&] t[=](Con Real 0)) [\<longrightarrow>] Inv)"
(*The core parts: the discrete computation and differential equations garantee the invariants. *)
definition cons31 :: fform where
"cons31 == \<lambda> s. ((t [=]Con Real 16 / 125 [&] Inv) s \<longrightarrow> Inv (\<lambda>(y, i). if y = ''plant_t'' \<and> i = R then evalE (Con Real 0) s else s (y, i)))"

definition cons32 :: fform where
"cons32 == \<lambda> s. (Inv s \<longrightarrow>
               Inv (\<lambda>(y, i). if (y = ''control_1'' \<and> i = R)
                       then (evalE (plant_m1_1 [*]
                                   (Con Real 811 / 500 [-] Con Real 1 / 100 [*] (control_1 [**] plant_m1_1 [-] Con Real 811 / 500) [-]
                                    Con Real 3 / 5 [*] (plant_v1_1 [+] Con Real 2)))
                             s)
                       else s (y, i)))"
definition cons4 :: fform where
"cons4 \<equiv>  exeFlow(PC_Diff11) (Inv)  [\<longrightarrow>]  Inv"
definition cons5 :: fform where
"cons5 \<equiv>  exeFlow(PC_Diff22) (Inv)  [\<longrightarrow>]  Inv"

(*Put this whole constraint to the differential invariant generator.*)
lemma allCons: "\<forall> s. ( cons1 [&] cons2 [&] cons31 [&] cons32 [&] cons4 [&] cons5) s"
apply (simp add: cons1_def)
apply (simp add: cons2_def)
apply (simp add: cons4_def)
apply (simp add: cons5_def)
apply (simp add: safeProp_def)
(*
apply inv_oracle_SOS
done
*)
(**You can uncomment the above lines, if you have  Mathematica, Matlab, Yalmip and SDPT3 installed. "Sorry" will go away.**)
sorry

lemma constraint11: "\<forall> s. (t [\<ge>] Con Real 0 [&] t [\<le>] Con Real 16 / 125 [&] Inv) s \<longrightarrow> safeProp s"
apply (cut_tac allCons)
apply (simp add:cons1_def)
by (metis fAnd_def fImp_def)

lemma constraint1: "\<forall> s. (t [\<le>]Con Real 16 / 125 [&] Inv) s \<longrightarrow> safeProp s"
apply (cut_tac allCons)
apply (cut_tac Clock)
by (metis constraint11 fAnd_def)

lemma constraint2: "\<forall> s. (plant_v1_1[=](Con Real -2) [&] plant_m1_1[=](Con Real 1250)
    [&] control_1[=](Con Real 4055/2) [&] t[=](Con Real 0)) s \<longrightarrow> Inv s"
apply (cut_tac allCons)
apply (simp add:cons2_def)
by (metis fAnd_def fImp_def)

lemma constraint31: "\<forall> s. ((t [=]Con Real 16 / 125 [&] Inv) s \<longrightarrow> Inv (\<lambda>(y, i). if y = ''plant_t'' \<and> i = R then evalE (Con Real 0) s else s (y, i)))"
apply (cut_tac allCons)
apply (simp add:cons31_def)
by (metis (erased, lifting) fAnd_def)

lemma constraint32: "\<forall> s. (Inv s \<longrightarrow>
               Inv (\<lambda>(y, i). if (y = ''control_1'' \<and> i = R)
                       then (evalE (plant_m1_1 [*]
                                   (Con Real 811 / 500 [-] Con Real 1 / 100 [*] (control_1 [**] plant_m1_1 [-] Con Real 811 / 500) [-]
                                    Con Real 3 / 5 [*] (plant_v1_1 [+] Con Real 2)))
                             s)
                       else s (y, i)))"
apply (cut_tac allCons)
apply (simp add:cons32_def)
by (metis (no_types, lifting) fAnd_def)

lemma constraint4: "\<forall> s.  exeFlow(PC_Diff11) (Inv) s  \<longrightarrow>  Inv s"
apply (cut_tac allCons)
apply (simp add:cons4_def)
by (metis fAnd_def fImp_def)

lemma constraint5: "\<forall> s.  exeFlow(PC_Diff22) (Inv) s  \<longrightarrow>  Inv s"
apply (cut_tac allCons)
apply (simp add:cons5_def)
by (metis fAnd_def fImp_def)

declare elE_def [simp del]

(*Goal for the whole process.*)
lemma goal : "{fTrue} PP {safeProp; (elE 0 [[|]] (almost safeProp))}"
(*mono*)
apply (cut_tac px="fTrue" and qx="t [\<le>] Con Real 16 / 125 [&] Inv" and Hx="(elE 0 [[|]] (almost (t [\<le>] Con Real 16 / 125 [&] Inv)))" in ConsequenceRule, auto)
prefer 2
apply (cut_tac constraint1, auto)
prefer 2
apply (cut_tac constraint1, auto)
apply (simp add:dOr_def almost_def, auto)
apply metis
apply (simp add:PP_def PC_Init_def PD_Init_def)
(*separate into intialization and repetitive control*)
apply (cut_tac m = "((plant_v1_1[=](Con Real -2)) [&] (plant_m1_1[=](Con Real 1250)) [&] (control_1[=](Con Real 2027.5)) [&] (t[=](Con Real 0)))"
           and  H = "elE 0"  and  G="(elE 0 [[|]] (almost (t [\<le>] Con Real 16 / 125 [&] Inv)))"  in SequentialRule, auto)
(*Init*)
apply (cut_tac m = "((plant_v1_1[=]Con (Real -2)) [&] (plant_m1_1[=]Con (Real 1250)))"
     and  H = "elE 0"  and  G = "elE 0" in SequentialRule, auto)
apply (cut_tac m = "plant_v1_1[=]Con Real - 2"  and  H = "elE 0" and  G = "elE 0" in SequentialRule, auto)
apply (rule AssignRRule, auto) apply (simp add:fEqual_def)
apply (cut_tac m = "plant_v1_1[=]Con Real - 2 [&] plant_m1_1[=]Con Real 1250"
   and  H = "elE 0" and  G = "elE 0" in SequentialRule, auto)
apply (rule AssignRRule, auto) apply (simp add:fAnd_def fEqual_def)
apply (rule AssignRRule, auto) apply (simp add:fAnd_def fEqual_def)
apply (simp add:elE_def chop_def)+
apply (cut_tac m = "((plant_v1_1[=](Con Real -2)) [&] (plant_m1_1[=](Con Real 1250)) [&] (control_1[=](Con Real 2027.5)))"
           and  H = "elE 0" and  G = "elE 0" in SequentialRule, auto)
apply (rule AssignRRule, auto) apply (simp add:fAnd_def fEqual_def)
apply (rule AssignRRule, auto) apply (simp add:fAnd_def fEqual_def)
apply (simp add:elE_def chop_def)+
prefer 2
apply (simp add:elE_def dOr_def chop_def)
(*Rep Part*)
apply (cut_tac px="Inv [&] t[=](Con Real 0) [&] t [\<le>] Con Real 16 / 125" and qx="Inv [&] t[=](Con Real 0) [&] t [\<le>] Con Real 16 / 125" and Hx="(elE 0 [[|]] (almost (t [\<le>] Con Real 16 / 125 [&] Inv)))" in ConsequenceRule,auto)
prefer 2
apply (cut_tac constraint2, auto) apply (simp add:fAnd_def fLessEqual_def fOr_def fLess_def fEqual_def)
prefer 2
apply (simp add:fAnd_def fLessEqual_def fOr_def fLess_def)
prefer 2
apply (simp add:elE_def dOr_def)
apply (rule RepetitionRule, auto)
apply (cut_tac P = "(RVar ''plant_t''[\<le>]Con Real 16 / 125 [&] Inv)"
      and h = h and n = n and nd = m in chopfor, auto)
apply (simp add:Inv3_def)
apply (cut_tac m = "t [=] Con Real 16 / 125 [&] Inv" and
    H = "(elE 0 [[|]] (almost (t [\<le>] Con Real 16 / 125 [&] Inv)))" and
  G= "elE 0" in  SequentialRule, auto)
prefer 2
apply (simp add: PD_Rep_def)
apply (cut_tac m = "t [=] Con Real 0 [&] Inv" and
    H = "elE 0" and  G= "elE 0" in  SequentialRule, auto)
apply (rule AssignRRule, auto)
apply (cut_tac constraint31, auto)
 apply (simp add:fAnd_def fLessEqual_def fOr_def fLess_def fEqual_def)
apply (rule AssignRRule, auto)
apply (cut_tac constraint32)
 apply (simp add:fAnd_def fLessEqual_def fOr_def fLess_def fEqual_def)
using control_1_def plant_m1_1_def plant_v1_1_def
apply presburger
apply (simp add:elE_def chop_def)
prefer 2
apply (simp add:dOr_def elE_def)  apply (simp add:fAnd_def fLessEqual_def fOr_def fLess_def fEqual_def chop_def)
(*Plant Part*)
apply (simp add:PC_Difff_def)
apply (rule ConditionGRule, auto)
apply (simp add:PC_Diff11_def Inv1_def)
apply (rule ContinuousRuleGT, auto)
apply (simp add:fLess_def fAnd_def fEqual_def)
apply (simp add:fAnd_def)
apply (simp add:fAnd_def, auto)
apply (cut_tac e = "RVar ''plant_t''" and f = "Con Real 16 / 125" in Lessc)
apply (cut_tac e = "RVar ''plant_t''" and f = "Con Real 16 / 125" in notLess, auto)
apply (simp add:fGreaterEqual_def fLessEqual_def fOr_def fNot_def fAnd_def)
apply (cut_tac constraint4)
apply (simp add:PC_Diff11_def Inv1_def)
apply (simp add:elE_def dOr_def)
apply (simp add:dOr_def)
apply (simp add:fAnd_def almost_def)
apply metis
apply (simp add:PC_Diff22_def Inv2_def)
apply (rule ContinuousRuleGT, auto)
apply (simp add:fLess_def fAnd_def fEqual_def)
apply (simp add:fAnd_def)
apply (simp add:fAnd_def, auto)
apply (cut_tac e = "RVar ''plant_t''" and f = "Con Real 16 / 125" in Lessc)
apply (cut_tac e = "RVar ''plant_t''" and f = "Con Real 16 / 125" in notLess, auto)
apply (simp add:fGreaterEqual_def fLessEqual_def fOr_def fNot_def fAnd_def)
apply (cut_tac constraint5)
apply (simp add:PC_Diff22_def Inv2_def)
apply (simp add:elE_def dOr_def)
apply (simp add:dOr_def)
apply (simp add:fAnd_def almost_def)
apply metis
done

end


section \<open>Example 3.8\<close>

theory Ex2
imports "../LCF"
begin

axiomatization
  P     :: "'a \<Rightarrow> tr" and
  F     :: "'b \<Rightarrow> 'b" and
  G     :: "'a \<Rightarrow> 'a" and
  H     :: "'a \<Rightarrow> 'b \<Rightarrow> 'b" and
  K     :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'b)"
where
  F_strict:     "F(UU) = UU" and
  K:            "K = (\<lambda>h x y. P(x) \<Rightarrow> y | F(h(G(x),y)))" and
  H:            "H = FIX(K)"

declare F_strict [simp] K [simp]

lemma example: "\<forall>x. F(H(x::'a,y::'b)) = H(x,F(y))"
  apply (simplesubst H)
  apply (induct "K:: ('a\<Rightarrow>'b\<Rightarrow>'b) \<Rightarrow> ('a\<Rightarrow>'b\<Rightarrow>'b)")
  apply simp
  apply (simp split: COND_cases_iff)
  done

end


theory Scoring_Rules
  imports
          "Compositional_Structures/Basic_Modules/Scoring_Module"
          "Compositional_Structures/Elect_Composition"
          "Compositional_Structures/Basic_Modules/Condorcet_Module"

(*Electoral_Module Evaluation_Function Elect_Module Elimination_Module Condorcet_Rule*)
begin

(*******Lemmas*******)

lemma scoring_mod_A[simp]:
  shows "electoral_module (elector(max_eliminator
        ((scoring (v:: 'a Vector_A))::'a Evaluation_Function)))"
  by auto

lemma scoring4_mod_A[simp]:
  shows "electoral_module (elector(max_eliminator
      ((scoring4 (v:: 'a Vector_A))::'a Evaluation_Function)))"
  by auto

(****************Homogeneity ****************)

(*Addieren von Profilen für scoring*)
lemma add_scoring_profiles:
  shows "(scoring v x A (b@p) = (scoring v x A b) + (scoring v x A p))"
proof(induct b)
case Nil
then show ?case by auto
next
case (Cons a b)
  then show ?case by auto
qed

lemma times_profile:
  shows "times (Suc(n)) p = p @ (times n p)" by auto

lemma scoring_move_out:
  shows "scoring v x A (p @ (times n p)) = scoring v x A p + scoring v x A (times n p)"
  by (metis add_scoring_profiles)

lemma times_scoring:
  shows "(scoring v x A (times n p)) = scoring v x A  p * n"
proof(induct n)
case 0
  then show ?case by auto
next
  case (Suc n)
  then show ?case
    by (metis mult_Suc_right scoring_move_out times_profile)
qed

lemma max_split_scoring:
  shows
    "Max {scoring v x A (b@p) |x. x \<in> A} = Max {(scoring v x A b) + (scoring v x A p) |x. x \<in> A}"
  by (metis add_scoring_profiles)

lemma Max_homo_add:
  fixes k::nat
  assumes "finite A" and "A \<noteq> {}"
  shows "Max {scoring v x A p + k |x. x\<in>A} = Max {scoring v x A p|x. x\<in>A} + k"
proof -
  have m: "\<And>x y. max x y + k = max (x+k) (y+k)"
    by(simp add: max_def antisym add_right_mono)
  have "{scoring v x A p + k|x. x\<in>A} = (\<lambda>y. y + k) ` {scoring v x A p|x. x\<in>A}" by auto
  also have "Max \<dots> = Max {scoring v x A p|x. x\<in>A} + k"
    using assms hom_Max_commute [of "\<lambda>y. y+k" "{scoring v x A p|x. x\<in>A}", OF m, symmetric] by simp
  finally show ?thesis by simp
qed

lemma Max_homo_mult:
  fixes k::nat
  assumes "finite A" and "A \<noteq> {}"
  shows "Max {scoring v x A p * k |x. x\<in>A} = Max {scoring v x A p|x. x\<in>A} * k"
proof-
  have m: "\<And>x y. max x y * k = max (x*k) (y*k)"
    by(simp add: max_def antisym add_right_mono)
  have "{scoring v x A p * k|x. x\<in>A} = (\<lambda>y. y * k) ` {scoring v x A p|x. x\<in>A}" by auto
  also have "Max \<dots> = Max {scoring v x A p|x. x\<in>A} * k"
    using assms hom_Max_commute [of "\<lambda>y. y*k" "{scoring v x A p|x. x\<in>A}", OF m, symmetric] by simp
  finally show ?thesis by simp
qed

(** Homogeneity Beweis**)
(*scoring*)

lemma for_goal1:
  assumes "x \<in> A" and "xb \<in> A" and "finite A" and "profile A p" and "0 < n" and
    "scoring v xb A p < Max {scoring v x A p |x. x \<in> A}"
  shows "scoring v xb A (times n p) <
        Max {scoring v x A (times n p) |x. x \<in> A}"
proof-
    have 0 :"Max {scoring v x A (times n p) |x. x \<in> A} =
        Max {scoring v x A p * n |x. x \<in> A}"
      using times_scoring by metis
  then have 1:  "Max {scoring v x A (times n p) |x. x \<in> A} =
      n* Max {scoring v x A p |x. x \<in> A}"
  proof -
    have "\<And>A f rs n. infinite A \<or> A = Collect bot \<or>
        Max {scoring f (a::'a) A rs |a. a \<in> A} * n = Max {scoring f a A rs * n |a. a \<in> A}"
      using Max_homo_mult bot_set_def by fastforce
    then have f5: "\<And>f rs n. Max {scoring f a A rs |a. a \<in> A} * n =
              Max {scoring f a A rs * n |a. a \<in> A}"
      using assms(1) assms(3) by blast
    have
      "Max {scoring v a A (times n p) |a. a \<in> A} = Max {scoring v a A p * n |a. a \<in> A}"
      using assms 0 by clarify
    then show "Max {scoring v a A (times n p) |a. a \<in> A} =
          n * Max {scoring v a A p |a. a \<in> A}"
      using f5 by (simp add: mult.commute)
  qed
  have 2:"scoring v xb A p < Max {scoring v x A p |x. x \<in> A} \<Longrightarrow>
            n* scoring v xb A p < n* Max {scoring v x A p |x. x \<in> A}"
    using assms(5) mult_less_mono2 by blast
  then have 3: "n* scoring v xb A p < n* Max {scoring v x A p |x. x \<in> A} \<Longrightarrow>
    scoring v xb A (times n p) <
    Max {scoring v x A (times n p) |x. x \<in> A}"
    by (metis (no_types, lifting) 1 mult.commute times_scoring)
  then show "scoring v xb A (times n p) <
    Max {scoring v x A (times n p) |x. x \<in> A}"
    using 2 assms by auto
qed

lemma for_goal2:
  assumes "x \<in> A" and "finite A" and "profile A p" and "0 < n" and "xa \<in> A" and "xb \<in> A" and
  "scoring v xb A (times n p) < Max {scoring v x A (times n p) |x. x \<in> A}"
  shows " scoring v xb A p < Max {scoring v x A p |x. x \<in> A}"
proof-
  have 0 :"Max {scoring v x A (times n p) |x. x \<in> A} = Max {scoring v x A p * n |x. x \<in> A}"
      using times_scoring by metis
    then have 1:  "Max {scoring v x A (times n p) |x. x \<in> A} =
          n* Max {scoring v x A p |x. x \<in> A}"
proof -
  have "\<And>A f rs n. infinite A \<or> A = Collect bot \<or> Max {scoring f (a::'a) A rs |a. a \<in> A} * n =
          Max {scoring f a A rs * n |a. a \<in> A}"
    using Max_homo_mult bot_set_def by fastforce
    then have f5:
      "\<And>f rs n. Max {scoring f a A rs |a. a \<in> A} * n = Max {scoring f a A rs * n |a. a \<in> A}"
      using assms(1) assms(2) by blast
    have
      "Max {scoring v a A (times n p) |a. a \<in> A} = Max {scoring v a A p * n |a. a \<in> A}"
      using assms 0 by clarify
    then show "Max {scoring v a A (times n p) |a. a \<in> A} =
            n * Max {scoring v a A p |a. a \<in> A}"
      using f5 by (simp add: mult.commute)
  qed
  have 2:" n* scoring v xb A p < n* Max {scoring v x A p |x. x \<in> A} \<Longrightarrow>
            scoring v xb A p < Max {scoring v x A p |x. x \<in> A}"
    by simp
  then have 3: "n* scoring v xb A p < n* Max {scoring v x A p |x. x \<in> A} \<Longrightarrow>
     scoring v xb A (times n p) <
     Max {scoring v x A (times n p) |x. x \<in> A}" using assms(7) by auto
  then show "scoring v xb A p < Max {scoring v x A p |x. x \<in> A}"
    using 1 2 assms(7) times_scoring by (metis (no_types, lifting) mult.commute times_scoring)
qed

(***** Für Black's Rule bzw Condorcet *****)

lemma add_prefer_profiles_code:
  shows "(prefer_count_code (b@p) x y = (prefer_count_code b x y) + (prefer_count_code p x y))"
proof(induct b)
  case Nil
  then show ?case by auto
next
  case (Cons a b)
  then show ?case by auto
qed

lemma pref_count_test_code:
"(prefer_count_code p x y) * n = prefer_count_code (times n p) x y"
  proof(induct n)
    case 0
    then show ?case by auto
  next
    case (Suc n)
    then show ?case using times_profile mult_Suc_right add_prefer_profiles_code
      by metis
  qed

lemma times_prefer:
  shows "(prefer_count p x y) * n = prefer_count (times n p) x y"
    using pref_count_test_code pref_count_equiv by metis

(*********)

lemma lin_n_follows:
  assumes "finite A" and "(\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
      \<forall>n \<ge> 0. \<forall>i<length (times (n+1) p). linear_order_on A ((times (n+1) p) ! i))"
  shows "(\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>n > 0. \<forall>i<length (times n p). linear_order_on A ((times n p) ! i))"
proof-
  have "\<forall>n \<ge> 0. \<forall>i<length (times (Suc n) p). linear_order_on A ((times (Suc n) p) ! i) \<Longrightarrow>
        \<forall>n > 0. \<forall>i<length (times n p). linear_order_on A ((times n p) ! i)"
    by (metis gr0_implies_Suc less_Suc_eq_le)
  then have "\<forall>n \<ge> 0. \<forall>i<length (times (n + 1) p). linear_order_on A ((times (n + 1) p) ! i) \<Longrightarrow>
        \<forall>n > 0. \<forall>i<length (times n p). linear_order_on A ((times n p) ! i) " by auto
  then show "(\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>n > 0. \<forall>i<length (times n p). linear_order_on A ((times n p) ! i))" using assms
    by blast
qed

lemma lin_induct:
  assumes "finite A" and "n \<ge> 0" and "\<forall>i<length p. linear_order_on A (p ! i)"
  shows "\<forall>i<length (times (n+1) p). linear_order_on A ((times (n+1) p) ! i)"
        proof(induct n)
          case 0
          then show ?case using assms(3) by simp
        next
          case (Suc n)
          then show ?case proof-
            have f0:"(\<forall>i<length (Electoral_Module.times ((Suc n)+1) p).
            linear_order_on A (Electoral_Module.times ((Suc n)+1) p ! i)) =
            (\<forall>i<length (p@(Electoral_Module.times (n+1) p)).
            linear_order_on A ((p@(Electoral_Module.times (n+1) p)) ! i))"
              by simp
            have "\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
            (\<forall>i<length (p@(Electoral_Module.times (n+1) p)).
            linear_order_on A ((p@(Electoral_Module.times (n+1) p)) ! i)) =
            ((\<forall>i<length (Electoral_Module.times (n+1) p).
            linear_order_on A (Electoral_Module.times (n+1) p ! i)))"
              by (metis Suc.hyps add_diff_inverse_nat  length_append
                   nat_add_left_cancel_less nth_append)
            then show ?thesis using f0 Suc.hyps assms(1) assms(3) by blast
          qed
        qed

lemma n_times_lin:
  assumes "n > 0" and "finite A" and "\<forall>i<length p. linear_order_on A (p ! i)"
  shows "\<forall>i<length (times n p). linear_order_on A ((times n p) ! i)"
  using lin_n_follows lin_induct assms(1) assms(2) assms(3)
  by metis

lemma value_same_for_mult_profile:
  assumes "finite A" and  "profile A p" and "0 < n" and "x \<in> A"
  shows "condorcet_score xb A p  = condorcet_score xb A (times n p)"
    unfolding condorcet_score.simps condorcet_winner.simps
  proof-
    have 0: "\<forall>x y. (prefer_count p x y) * n = prefer_count (times n p) x y"
      by (metis times_prefer)
    have 1:"\<forall>x\<in>A - {xb}. (prefer_count p x xb < prefer_count p xb x) =
    (prefer_count (times n p) x xb < prefer_count (times n p) xb x)"
      by (metis assms(3) 0 mult_less_cancel2)
    have "finite_profile A p = finite_profile A (times n p)"
    proof(auto)
      show " profile A (concat (replicate n p))" using assms
      proof-
(*Linearität von n*p beweisen*)
(*induct bei 1 starten anstatt 0*)

        have "\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>i<length (times n p). linear_order_on A ((times n p) ! i)"
          by (metis n_times_lin assms(1) assms(3))

        then show "profile A (concat (replicate n p))" using assms
          by (simp add: profile_def)
      qed
      show "profile A (concat (replicate n p)) \<Longrightarrow> profile A p" using assms(1)
      proof-
        have"\<forall>i<length (concat (replicate n p)). linear_order_on A ((times n p) ! i)
        \<Longrightarrow> \<forall>i<length p. linear_order_on A (p ! i)"
          using assms(2) profile_def by blast
        then show "profile A (concat (replicate n p)) \<Longrightarrow> profile A p"
          unfolding profile_def by simp
      qed
    qed
    then show "(if finite_profile A p \<and> xb \<in> A \<and> (\<forall>x \<in> A - {xb} . wins xb p x) then 1 else 0) =
    (if finite_profile A (times n p) \<and> xb \<in> A \<and>
    (\<forall>x \<in> A - {xb} . wins xb (times n p) x) then 1 else 0)" using 1 by simp
  qed

lemma max_same_for_mult_profile:
  assumes "finite A" and  "profile A p" and "0 < n" and "x \<in> A"
  shows "Max {condorcet_score x A p |x. x \<in> A} = Max {condorcet_score x A (times n p) |x. x \<in> A}"
    by (metis (no_types, lifting) assms(1) assms(2) assms(3) value_same_for_mult_profile)

(*******************************************)

lemma seq_hom:
  shows "homogeneity m \<Longrightarrow> homogeneity n \<Longrightarrow> homogeneity (m \<triangleright> n)"
  unfolding homogeneity_def
proof(auto)
  show "\<And>A p na.
       electoral_module m \<Longrightarrow>
       \<forall>A p n. finite A \<and> profile A p \<and> 0 < n \<longrightarrow> m A p = m A (concat (replicate n p)) \<Longrightarrow>
       electoral_module n \<Longrightarrow>
       \<forall>A p na. finite A \<and> profile A p \<and> 0 < na \<longrightarrow> n A p = n A (concat (replicate na p)) \<Longrightarrow>
       finite A \<Longrightarrow>
       profile A p \<Longrightarrow>
       0 < na \<Longrightarrow>
       (let new_A = defer m A (concat (replicate na p)); new_p = map (limit new_A) p
        in (elect m A (concat (replicate na p)) \<union> elect n new_A new_p,
            reject m A (concat (replicate na p)) \<union> reject n new_A new_p, defer n new_A new_p)) =
       (let new_A = defer m A (concat (replicate na p)); new_p =
          map (limit new_A) (concat (replicate na p))
        in (elect m A (concat (replicate na p)) \<union> elect n new_A new_p,
            reject m A (concat (replicate na p)) \<union> reject n new_A new_p, defer n new_A new_p))"
    by (smt (z3) def_presv_fin_prof limit_profile.simps map_concat map_replicate)
qed

lemma elector_homogeneity:
  shows "homogeneity m \<Longrightarrow> homogeneity (elector m)"
proof(simp)
  have "homogeneity elect_module"
    by (simp add: homogeneity_def)
  then show "homogeneity m \<Longrightarrow> homogeneity (m \<triangleright> elect_module)" using seq_hom by auto
qed

lemma max_value_same:
  assumes "\<forall>A p n. finite_profile A p \<and> 0 < n \<longrightarrow>
       elimination_set eval_func (Max {eval_func x A p |x. x \<in> A}) (<) A p =
       elimination_set eval_func (Max {eval_func x A (Electoral_Module.times n p) |x. x \<in> A})
       (<) A (Electoral_Module.times n p)"
  shows"(\<forall>A p n. finite_profile A p \<and> 0 < n \<longrightarrow>
        max_eliminator eval_func A p = max_eliminator eval_func A (Electoral_Module.times n p))"
  unfolding max_eliminator.simps less_eliminator.simps elimination_module.simps using assms
  by fastforce

lemma eval_func_homogeneity:
  assumes "\<forall>A p n. finite_profile A p \<and> 0 < n \<longrightarrow>
       elimination_set eval_func (Max {eval_func x A p |x. x \<in> A}) (<) A p =
       elimination_set eval_func (Max {eval_func x A (Electoral_Module.times n p) |x. x \<in> A}) (<) A
      (Electoral_Module.times n p)"
  shows "homogeneity (max_eliminator eval_func)"
  unfolding homogeneity_def using assms
proof-
  show "electoral_module (max_eliminator eval_func) \<and>
    (\<forall>A p n. finite_profile A p \<and> 0 < n \<longrightarrow> max_eliminator eval_func A p =
    max_eliminator eval_func A (Electoral_Module.times n p))"
    proof-
    have 0:"electoral_module (max_eliminator eval_func)" by auto
    have "(\<forall>A p n.
        finite_profile A p \<and> 0 < n \<longrightarrow>
        max_eliminator eval_func A p =
        max_eliminator eval_func A (Electoral_Module.times n p))" using assms max_value_same
      by fastforce
    then show ?thesis
      using 0 by blast
  qed
qed

lemma scoring_homogeneity:
  shows "homogeneity (max_eliminator (scoring v))"
proof-
  have "\<forall>A p n. finite_profile A p \<and> 0 < n \<longrightarrow>
      elimination_set (scoring v) (Max {(scoring v) x A p |x. x \<in> A}) (<) A p =
       elimination_set (scoring v) (Max {(scoring v) x A (Electoral_Module.times n p) |x. x \<in> A})
      (<) A (Electoral_Module.times n p)"
    using for_goal1 for_goal2 by auto
   then show "homogeneity (max_eliminator (scoring v))"
     by (simp add: eval_func_homogeneity)
 qed

lemma scoring_rules_homogeneity:
  shows "homogeneity (elector (max_eliminator (scoring vec_A_borda)))"
  using scoring_homogeneity elector_homogeneity by auto

lemma condorcet_homogeneity:
  shows "homogeneity (max_eliminator condorcet_score)"
  using elimination_module.simps elimination_set.simps
proof-
  have "\<forall>A p n. finite_profile A p \<and> 0 < n \<longrightarrow>
      elimination_set condorcet_score (Max {condorcet_score x A p |x. x \<in> A}) (<) A p =
       elimination_set condorcet_score (Max {condorcet_score x A (Electoral_Module.times n p) |x. x \<in> A})
      (<) A (Electoral_Module.times n p)"
    using max_same_for_mult_profile value_same_for_mult_profile
    by (smt (z3) Collect_cong elimination_set.simps)
  then show ?thesis using eval_func_homogeneity by blast
 qed

(********************reinforcement proof**********************************)

lemma combined_eqless_single:
  assumes "finite A" and "A \<noteq> {}" and "x \<in> A" and "profile A p1" and "profile A p2"
  shows "scoring v x A p1 + scoring v x A p2 \<le> Max {scoring v x A p1 |x. x \<in> A} +
          Max {scoring v x A p2 |x. x \<in> A}"
proof-
  have "scoring v x A p1 \<in> {scoring v x A p1 |x. x \<in> A}" using assms(3) by blast
  then have 0:"scoring v x A p1 \<le> Max {scoring v x A p1 |x. x \<in> A}" by (simp add: assms(1))
  have "scoring v x A p2 \<in> {scoring v x A p2 |x. x \<in> A}" using assms(3) by blast
  then have 1:"scoring v x A p2 \<le> Max {scoring v x A p2 |x. x \<in> A}" by (simp add: assms(1))
  then show ?thesis using "0" "1" add_mono by blast
qed

lemma combined_max_eqless_single_all:
  assumes "finite A" and "A \<noteq> {}" and "x \<in> A" and "profile A p1" and "profile A p2"
  shows "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
    Max {scoring v x A p1 + scoring v x A p2 |x. x \<in> A} \<le>
    Max {scoring v x A p1 |x. x \<in> A} + Max {scoring v x A p2 |x. x \<in> A}"
proof-
  have fin: "finite {scoring v x A p1 + scoring v x A p2 |x. x \<in> A}" using assms(1) by simp
  have nonEmpty: "{scoring v x A p1 + scoring v x A p2 |x. x \<in> A}  \<noteq> {}" using assms(2) by simp
  then have maxInSet:"Max {scoring v x A p1 + scoring v x A p2 |x. x \<in> A}
        \<in> {scoring v x A p1 + scoring v x A p2 |x. x \<in> A}"
    using "fin" "nonEmpty" eq_Max_iff by blast
  have eqToMax:"\<exists>x \<in> A. scoring v x A p1 + scoring v x A p2 =
        Max {scoring v x A p1 + scoring v x A p2 |x. x \<in> A}" using "maxInSet" by auto
  have allSmaller:"\<forall>x\<in> A. scoring v x A p1 + scoring v x A p2 \<le>
        Max {scoring v x A p1 |x. x \<in> A} + Max {scoring v x A p2 |x. x \<in> A}"
    using combined_eqless_single all_not_in_conv assms(1) assms(3) assms(4) assms(5) by fastforce
  have following:"\<exists>x \<in> A. scoring v x A p1 + scoring v x A p2 =
        Max {scoring v x A p1 + scoring v x A p2 |x. x \<in> A}
  \<Longrightarrow> \<forall>x\<in> A. scoring v x A p1 + scoring v x A p2 \<le>
        Max {scoring v x A p1 |x. x \<in> A} + Max {scoring v x A p2 |x. x \<in> A}
  \<Longrightarrow> Max {scoring v x A p1 + scoring v x A p2 |x. x \<in> A} \<le>
        Max {scoring v x A p1 |x. x \<in> A} + Max {scoring v x A p2 |x. x \<in> A}"
    by fastforce
  then show ?thesis using following allSmaller eqToMax by simp
qed

lemma add_scoring_profiles_all:
  shows "\<forall>x \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
        (scoring v x A (b@p) = (scoring v x A b) + (scoring v x A p))"
proof(induct b)
case Nil
then show ?case by auto
next
case (Cons a b)
  then show ?case by auto
qed

lemma add_scoring_profiles_all2:
  shows "\<forall>x. (scoring v x A (b@p) =
(scoring v x A b) + (scoring v x A p))"
proof(induct b)
case Nil
then show ?case by auto
next
case (Cons a b)
  then show ?case by auto
qed

lemma max_is_defer_combined_than_in_both_all:
  assumes "finite A" and "A \<noteq> {}" and "a \<in> A" and "profile A p1" and "profile A p2" and
    "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
          scoring v a A p1 + scoring v a A p2 \<ge> Max {scoring v x A (p1@p2) |x. x \<in> A}"
  shows "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
    a \<in> defer (max_eliminator (scoring v)) A (p1@p2)"
proof -
   have 0:
    "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
    Max {scoring v a A (p1 @ p2) |a. a \<in> A} \<le> scoring v a A (p1 @ p2)"
    using assms by (metis (no_types, lifting) add_scoring_profiles_all)
  have
    "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2.
      Max {scoring v a A (p1 @ p2) |a. a \<in> A} \<le> scoring v a A (p1 @ p2) \<Longrightarrow>
     \<forall>a\<in>defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2.
    a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2)"
    (*by (smt (z3) Collect_cong add_scoring_profiles_all max_is_defer_combined)*)
proof -
  assume a1: "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2.
      Max {scoring v a A (p1 @ p2) |a. a \<in> A} \<le> scoring v a A (p1 @ p2)"
  { fix aa :: 'a
    { assume "Max {scoring v a A (p1 @ p2) |a. a \<in> A} \<le> scoring v aa A (p1 @ p2)"
      moreover
      { assume "aa \<notin> A"
        then have "aa \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) \<or>
      aa \<notin> defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2"
          by simp }
      ultimately have "aa \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) \<or>
      aa \<notin> defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2"
        by simp }
    then have "aa \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) \<or>
      aa \<notin> defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2"
      using a1 by meson }
  then show ?thesis
    by metis
qed
  then show "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2.
       a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2)"
    using 0 assms
    by linarith
qed

lemma max_alway_exists:
  assumes "finite A" and "A \<noteq> {}"
  shows "{a \<in> A. scoring v a A p < Max {scoring v x A p |x. x \<in> A}} = A \<Longrightarrow> False"
proof-
  have "\<exists>a \<in> A. scoring v a A p = Max {scoring v x A p |x. x \<in> A}" using assms
        proof-
          have fin: "finite {scoring v x A p |x. x \<in> A}" using assms(1) by simp
          have nonEmpty: "{scoring v x A p |x. x \<in> A}  \<noteq> {}" using assms(2) by simp
          then have maxInSet:"Max {scoring v x A p |x. x \<in> A} \<in> {scoring v x A p |x. x \<in> A}"
            using "fin" "nonEmpty" eq_Max_iff by blast
          have "Max {scoring v x A p |x. x \<in> A} \<in> {scoring v x A p |x. x \<in> A} \<Longrightarrow>
                \<exists>a \<in> A. scoring v a A p = Max {scoring v x A p |x. x \<in> A}" by auto
          then show ?thesis using maxInSet by simp
        qed
  then show "{a \<in> A. scoring v a A p < Max {scoring v x A p |x. x \<in> A}} = A \<Longrightarrow> False"
    using nat_neq_iff by auto
qed

lemma not_less_is_max:
  assumes "finite A" and
    "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p |x. x \<in> A}) (<) A p)"
  shows "scoring v a A p =  Max {scoring v x A p |x. x \<in> A}"
proof-
  have "a \<in> A" using assms(2) by clarify
  then have "scoring v a A p \<in> {scoring v x A p |x. x \<in> A}"
    using assms(2) by blast
      (*sc a p nicht größer als Max*)
  then have 0:"scoring v a A p \<le>  Max{scoring v x A p |x. x \<in> A}"
    using assms by auto
      (*sc a p nicht kleiner als Max*)
  have 1:"scoring v a A p \<ge>  Max{scoring v x A p |x. x \<in> A}"
    using assms(2) by auto
  have "a \<in> A \<Longrightarrow>\<not> scoring v a A p < Max {scoring v x A p |x. x \<in> A} \<Longrightarrow>
      scoring v a A p = Max {scoring v x A p |x. x \<in> A}" using "0" "1" by simp
  then show "scoring v a A p =  Max {scoring v x A p |x. x \<in> A}" using assms(2)
    by simp
qed

(** from defer follows Max value **)

lemma from_defer_follows_max:
  assumes "finite A" and "A \<noteq> {}"
  shows "a \<in> defer (max_eliminator (scoring v)) A p \<Longrightarrow>
            scoring v a A p = Max {scoring v x A p |x. x \<in> A}"
proof-
  have "({a \<in> A. scoring v a A p < Max {(scoring v) x A p |x. x \<in> A}} \<noteq> A) = True"
          using assms max_alway_exists by auto
        then have 0: "a \<in> defer (max_eliminator (scoring v)) A p \<Longrightarrow>
      a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p |x. x \<in> A}) (<) A p)"
    by simp
  have "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p |x. x \<in> A}) (<) A p) \<Longrightarrow>
      scoring v a A p =  Max {scoring v x A p |x. x \<in> A}"
    using assms(1) not_less_is_max by simp
  then have 1:"a \<in> defer (max_eliminator (scoring v)) A p \<Longrightarrow> scoring v a A p =
      Max {scoring v x A p |x. x \<in> A}" using "0" by simp
  then show "a \<in> defer (max_eliminator (scoring v)) A p \<Longrightarrow>
      scoring v a A p = Max {scoring v x A p |x. x \<in> A}"
     by simp
 qed

lemma from_defer_follows_max_all:
  assumes "finite A" and "A \<noteq> {}"
  shows "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      a \<in> defer (max_eliminator (scoring v)) A p \<Longrightarrow>
      \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      scoring v a A p = Max {scoring v x A p |x. x \<in> A}"
proof-

  have 0:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
        ({a \<in> A. scoring v a A p < Max {(scoring v) x A p |x. x \<in> A}} \<noteq> A) = True"
          using assms max_alway_exists by auto

        have "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p |x. x \<in> A}) (<) A p) \<Longrightarrow>
      scoring v a A p =  Max {scoring v x A p |x. x \<in> A}"
    using assms(1) not_less_is_max by simp
  then have 1:
        "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
                a \<in> defer (max_eliminator (scoring v)) A p \<Longrightarrow>
                \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter>
                defer (max_eliminator (scoring v)) A p2).
                scoring v a A p = Max {scoring v x A p |x. x \<in> A}" using "0"
    by (metis (mono_tags, lifting) assms(1) assms(2) from_defer_follows_max)
  then show
      "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      a \<in> defer (max_eliminator (scoring v)) A p \<Longrightarrow>
  \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      scoring v a A p = Max {scoring v x A p |x. x \<in> A}"
    by linarith
    (*by simp*)
qed

lemma from_defer_follows_max2_all:
  assumes "finite A"  and "A \<noteq> {}"
  shows "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      (scoring v a A p1 = Max {scoring v x A p1 |x. x \<in> A})"
  by (metis (mono_tags, lifting) IntD1 assms from_defer_follows_max_all)

lemma from_defer_follows_max3_for_all:
  assumes "finite A"  and "A \<noteq> {}"
  shows "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
   a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2) \<Longrightarrow>
   \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      (scoring v a A p1 = Max {scoring v x A p1 |x. x \<in> A}) \<and>
      (scoring v a A p2 = Max {scoring v x A p2 |x. x \<in> A})"
  using assms from_defer_follows_max2_all
  by blast

lemma max_in_both__than_in_combined_defer_all_test:
  assumes "finite_profile A p1" and "finite_profile A p2" and "a \<in> A" and "finite A" and "A \<noteq> {}"
  shows "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
          a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2)"
proof-
  have 00:
  "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
    Max {scoring v x A p1 |x. x \<in> A} + Max {scoring v x A p2 |x. x \<in> A} \<ge>
      Max {scoring v x A p1 + scoring v x A p2 |x. x \<in> A}"
    using assms combined_max_eqless_single_all
    by (metis (mono_tags, lifting) )

  have p1: "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      scoring v a A p1 =  Max {scoring v x A p1 |x. x \<in> A}"
    using assms from_defer_follows_max2_all by blast
  have p2: "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      scoring v a A p2 =  Max {scoring v x A p2 |x. x \<in> A}"
    using assms from_defer_follows_max2_all by blast

  have 11:
    "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      Max {scoring v x A p1 |x. x \<in> A} + Max {scoring v x A p2 |x. x \<in> A} = scoring v a A p1 +
          scoring v a A p2" using assms p1 p2
    by (metis (no_types, lifting))
  have 0:
  "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
    scoring v a A p1 + scoring v a A p2 \<ge> Max {scoring v x A p1 + scoring v x A p2 |x. x \<in> A}"
      using "00" "11" by (metis (no_types, lifting))
  have 1 :"\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
    Max {scoring v x A p1 + scoring v x A p2 |x. x \<in> A} = Max {scoring v x A (p1@p2) |x. x \<in> A}"
    using max_split_scoring by metis
  have 2:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
        scoring v a A p1 + scoring v a A p2 \<ge> Max {scoring v x A (p1@p2) |x. x \<in> A}"
    using assms 1 0  by (metis (no_types, lifting))
  moreover have 3:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      scoring v a A p1 + scoring v a A p2 \<ge> Max {scoring v x A (p1@p2)|x. x \<in> A} \<Longrightarrow>
      \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2)"
    using assms max_is_defer_combined_than_in_both_all by (metis (mono_tags, lifting))
  ultimately show "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
          a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2)"
    using assms "2" "3" by blast
qed
(*** ---------- ***)

lemma reinforcement_defer_scoring_helper:
  assumes "finite A" and "A \<noteq> {}" and "a \<in> A" and "profile A p1" and "profile A p2" and
    "defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2 \<noteq> {}"
  shows "defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2 =
      defer (max_eliminator (scoring v)) A (p1 @ p2)"
proof-

  have all:
      "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2).
      a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2)"
    using  max_in_both__than_in_combined_defer_all_test
      assms(1) assms(2) assms(3) assms(4) assms(5) assms(6)
    by metis

  then have d1:"(defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2)
      \<subseteq> defer (max_eliminator (scoring v)) A (p1 @ p2)"
    using assms by blast
(***********)

  have "defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2 \<noteq> {} \<Longrightarrow>
    \<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ).
    a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2)"
proof-

  have a_is_max_p1_p2:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ).
          scoring v a A (p1@p2) = Max {scoring v x A (p1@p2) |x. x \<in> A}"
    using assms
    by (smt (z3) Collect_cong from_defer_follows_max)

  have same_as_add:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ).
      (scoring v a A (p1@p2) = (scoring v a A p1) + (scoring v a A p2))"
      using add_scoring_profiles by fastforce

    have elem_A:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ). a \<in> A" by simp

    then have "\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ). scoring v a A p1 \<in>
      {scoring v x A p1 |x. x \<in> A}"
      using assms(3) by blast
    then have smaller_max:
          "\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ). scoring v a A p1 \<le>
      Max {scoring v x A p1 |x. x \<in> A}"
      using assms(1) by simp

    then have "\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ). scoring v a A p2 \<in>
      {scoring v x A p2 |x. x \<in> A}"
      using assms(3) "elem_A" by blast
    then have smaller_max2:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ).
      scoring v a A p2 \<le>  Max {scoring v x A p2 |x. x \<in> A}"
      using assms(1) by simp

     have comb_is_eq:
          "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2.
          Max {scoring v x A (p1@p2) |x. x \<in> A} = scoring v a A p1 + scoring v a A p2"
            using a_is_max_p1_p2 add_scoring_profiles all
      by (metis (no_types, lifting))

    have "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1  \<inter> defer (max_eliminator (scoring v)) A p2 .
          (scoring v a A p1  =  Max {scoring v x A p1 |x. x \<in> A}) \<and> (scoring v a A p2  =
      Max {scoring v x A p2 |x. x \<in> A})"
      using from_defer_follows_max2_all assms by blast

    then have eq:"
            \<forall>a\<in>defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2.
            Max {scoring v x A (p1@p2) |x. x \<in> A} = Max {scoring v x A p1 |x. x \<in> A} +
            Max {scoring v x A p2 |x. x \<in> A}"  using comb_is_eq
      by (metis (no_types, lifting))

     have from_single_follows_combined:
        "Max {scoring v x A (p1@p2) |x. x \<in> A} = Max {scoring v x A p1 |x. x \<in> A} +
        Max {scoring v x A p2 |x. x \<in> A}"
    using assms eq by blast

  have 1:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ).
        (scoring v a A p1 =  Max {scoring v x A p1 |x. x \<in> A}) \<and>
      (scoring v a A p2 =  Max {scoring v x A p2 |x. x \<in> A})"
    using assms "a_is_max_p1_p2" "from_single_follows_combined" "same_as_add"
          "smaller_max" "smaller_max2" by fastforce

    then have 3:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ).
          a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter>
          defer (max_eliminator (scoring v)) A p2)"
            using assms by simp

           show
            "\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) ).
          a \<in> (defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2)"
            using assms "3" by blast
  qed

  then show "defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2 =
      defer (max_eliminator (scoring v)) A (p1 @ p2)"
    using assms "d1" by blast
qed

lemma reinforcement_defer_scoring:
  shows "reinforcement_defer (max_eliminator (scoring v))"
  unfolding reinforcement_defer_def
proof-
  have 0:"electoral_module (max_eliminator (scoring v))" by simp
  have 1:"(\<forall>A p1 p2.
        finite_profile A p1 \<and> finite_profile A p2 \<longrightarrow>
        defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2 \<noteq> {} \<longrightarrow>
        defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2 =
      defer (max_eliminator (scoring v)) A (p1 @ p2))"
    by (smt (verit, best) "0" Int_emptyI defer_in_alts equals0D in_mono reinforcement_defer_scoring_helper)
  then show "electoral_module (max_eliminator (scoring v)) \<and>
    (\<forall>A p1 p2. finite_profile A p1 \<and> finite_profile A p2 \<longrightarrow>
        defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2 \<noteq> {} \<longrightarrow>
        defer (max_eliminator (scoring v)) A p1 \<inter> defer (max_eliminator (scoring v)) A p2 =
      defer (max_eliminator (scoring v)) A (p1 @ p2))"
    using "0" by clarify
qed

lemma reinforcement_scoring:
  shows "reinforcement_elect (max_eliminator (scoring v))"
  unfolding reinforcement_elect_def by simp

lemma complete_reinforcement_scoring:
  shows "reinforcement_complete (max_eliminator (scoring v))"
  by (simp add: from_elect_and_defer_follows_reinforcement
reinforcement_defer_scoring reinforcement_scoring)

(*********************************)

lemma elect_complete_reinforcement:
  shows "reinforcement_complete elect_module"
  by (simp add: reinforcement_defer_def reinforcement_elect_def
from_elect_and_defer_follows_reinforcement)

lemma module_with_elect_reinforcement_complete:
  shows "reinforcement (elector(max_eliminator (scoring v)))"
proof(simp)
  have def: "reinforcement_defer (max_eliminator (scoring v))"
    by (simp add: reinforcement_defer_scoring)
  then have 1:"electoral_module (max_eliminator (scoring v)) \<and>
    (\<forall> A p1 p2 vs1 vs2. (finite_profile A p1 \<and> finite_profile A p2 \<longrightarrow>
    (defer (max_eliminator (scoring v)) A p1) \<inter> (defer (max_eliminator (scoring v)) A p2) \<noteq> {} \<longrightarrow>
    ((defer (max_eliminator (scoring v)) A p1) \<inter> (defer (max_eliminator (scoring v)) A p2) =
    defer (max_eliminator (scoring v)) A (p1 @ p2))))"
    using reinforcement_defer_def by blast
  have emp: "\<forall>A p. elect (max_eliminator (scoring v)) A p = {}"
    using max_elim_non_electing by simp
   show "reinforcement ((max_eliminator (scoring v)) \<triangleright> elect_module)"
    unfolding reinforcement_elect_def reinforcement_def
    using 1 emp
    by  (simp add: reinforcement_def)
qed

lemma elector_reinforcement:
  shows "reinforcement_complete (elector(max_eliminator (scoring v)))"
proof(simp)
  have "\<forall> A p. defer (elector(max_eliminator (scoring v))) A p = {}"
    unfolding elector.simps by simp
  then have elect_defer:"reinforcement_defer (elector(max_eliminator (scoring v)))"
    by (simp add: reinforcement_defer_def)
  have def: "reinforcement_defer (max_eliminator (scoring v))"
    by (simp add: reinforcement_defer_scoring)
  then have 1:"electoral_module (max_eliminator (scoring v)) \<and>
    (\<forall> A p1 p2 vs1 vs2. (finite_profile A p1 \<and> finite_profile A p2 \<longrightarrow>
    (defer (max_eliminator (scoring v)) A p1) \<inter> (defer (max_eliminator (scoring v)) A p2) \<noteq> {} \<longrightarrow>
    ((defer (max_eliminator (scoring v)) A p1) \<inter> (defer (max_eliminator (scoring v)) A p2) =
    defer (max_eliminator (scoring v)) A (p1 @ p2))))"
    using reinforcement_defer_def by blast
  have emp: "\<forall>A p. elect (max_eliminator (scoring v)) A p = {}"
    using max_elim_non_electing by simp
  have "defer (max_eliminator (scoring v)) A p =
      elect (elector((max_eliminator (scoring v)))) A p"
    by (simp add: reinforcement_elect_def)
  then show "reinforcement_complete ((max_eliminator (scoring v)) \<triangleright> elect_module)"
    unfolding reinforcement_elect_def
    using elect_defer 1 emp
    by (simp add: reinforcement_complete_def)
  qed

lemma scoring_module_rein:
  shows "reinforcement_complete (elector(max_eliminator (scoring v)))"
proof-
  have 0:"\<forall>A p. elect (max_eliminator (scoring v)) A p = {}" by simp
  have "\<forall>A p. well_formed A ((max_eliminator (scoring v)) A p)" by auto
  then show ?thesis using elector_reinforcement 0 by blast
qed

end


(******************************************************************************)
(* Project: Isabelle/UTP: Unifying Theories of Programming in Isabelle/HOL    *)
(* File: Normalise.thy                                                        *)
(* Authors: Frank Zeyda and Simon Foster (University of York, UK)             *)
(* Emails: frank.zeyda@gmail.com and simon.foster@york.ac.uk                  *)
(******************************************************************************)
(* LAST REVIEWED: 09 Jun 2022 *)

section \<open>Normalisation\<close>

theory Normalise
imports Main
 "HOL-Eisbach.Eisbach"
begin

subsection \<open>Theorem Attribute\<close>

text \<open>Theorems and tactic used for normalisation.\<close>

named_theorems normalise "normalisation theorems"

subsection \<open>Normalisation Tactic\<close>

method normalise = (simp add: normalise)

subsection \<open>Type Class @{text normalise}\<close>

text \<open>
  Instantiation of the class @{text normalise} signals that normalisation can
  be performed on constructions that involve the underlying type. For now, we
  only consider chains of function updates. Importantly, the type must provide
  a linear order to ensure that normalisation does not loop.
\<close>

class normalise = linorder
begin
theorem fun_upd_normalise [normalise]:
fixes x :: "'a"
fixes y :: "'a"
shows "x < y \<Longrightarrow> f(y := a, x := b) = f(x := b, y := a)"
by (simp add: fun_upd_twist)
end

text \<open>
  The tactic below is not very efficient as using backtracking. In practice,
  it is slightly quicker to use plain simplification instead of substitution.
  Both approaches, however, suffer from the same drawback that dead ends may
  need to be explored. A better solution would implement some form of guarded
  rewriting.
\<close>

method fun_upd_normalise_tac =
  (subst fun_upd_normalise, (simp; fail))+

end


(*
   Title: The pi-calculus
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Bisim_Subst
  imports Strong_Late_Bisim
begin

abbreviation
  StrongEqJudge (infixr "\<sim>\<^sup>s" 65) where "P \<sim>\<^sup>s Q \<equiv> (P, Q) \<in> (substClosed bisim)"

lemma congBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P \<sim>\<^sup>s Q"

  shows "P \<sim> Q"
using assms substClosedSubset by blast

lemma eqvt:
  shows "eqvt (substClosed bisim)"
by(rule eqvtSubstClosed[OF Strong_Late_Bisim.bisimEqvt])

lemma eqClosed:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P \<sim>\<^sup>s Q"

  shows "(perm \<bullet> P) \<sim>\<^sup>s (perm \<bullet> Q)"
using assms
by(rule eqvtRelI[OF eqvt])

lemma reflexive:
  fixes P :: pi

  shows "P \<sim>\<^sup>s P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim.reflexive)

end