theory cache imports Main Finite_Set
begin

section{*Main defintions*}

text{*
According to the aforementioned discussion in section ?, firstly we define the variables used in the protocols.
There are two kinds of variables, global and parameterized (local)
variables. In hardware implemetations of the protocols,
the variables are implenteed as registers in global or local modules. *}

datatype varType=Global  string | Para string nat

text{*For instance, $\mathsf{Global}~ "x"$ and Para "n" 1 are used to formalize the global variable $x$ and the local variable $n[1]$ in the Murphi program listed in section ?*.

An expression used in this work is rather simple, which is a variable or constant. In our model,  a value of a variable is
 just a natural number.  A boolean variable is encodes as 0 or 1. A value is obtained from reading a variable or  being assigned directly by a natural number.
 *}

definition ex0P::"nat \<Rightarrow> (bool) \<Rightarrow>bool"
 where [simp]:  "ex0P N P \<equiv>P"

definition ex1P::"nat \<Rightarrow> (nat \<Rightarrow> bool) \<Rightarrow>bool"
 where [simp]:  "ex1P N P \<equiv> \<exists>i. ( i\<le> N \<and> P i )"

definition ex2P::"nat \<Rightarrow> (nat \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow>bool"
 where [simp]:  "ex2P N P \<equiv> \<exists>i j. ( i\<le> N  \<and>j\<le> N \<and> i\<noteq>j \<and> P i j )"

definition ex3P::"nat \<Rightarrow> (nat \<Rightarrow> nat \<Rightarrow>nat\<Rightarrow> bool) \<Rightarrow>bool"
 where [simp]: "ex3P N P \<equiv> \<exists>i j k. ( i\<le> N  \<and>j\<le> N \<and> k \<le>N \<and>  i\<noteq>j \<and>  i\<noteq>k \<and>  j\<noteq>k \<and> P i j k)"

primrec down ::"nat \<Rightarrow>nat list" where
"down 0=[0]" |
"down (Suc n)=Suc n #(down n)"

datatype expType= IVar varType   |
         Const nat |
         iteForm formula  expType  expType

and
 formula = eqn expType expType|
                andForm  formula formula |
                 neg formula|
                orForm formula formula |
                implyForm formula formula |
                chaos

type_synonym assignType=  "varType \<times>   expType"

text{*A statement is is just a lists of assignments, but these assignments are extecuted in parallel, \emph{not} in a sequential order*}
datatype statement=  assign assignType          |
                  parallel assignType  statement

text{*A parameterized statement is just a function from a parameter to a statement. For conveniece, we also define the concatation of statements, and use it to define the $\mathsf{forall}$ statement.*}
type_synonym paraStatement= "nat \<Rightarrow> statement"

primrec cat::"statement \<Rightarrow> statement \<Rightarrow>statement" where
cat1:"cat (assign a) S=parallel a S" |
cat2:"cat (parallel a S1) S=parallel a (cat S1 S)"

fun parallelList::"statement list \<Rightarrow> statement" where
"parallelList [S] = S"|
"parallelList (S1#S2#SL) = cat S1 (parallelList (S2#SL))"

fun  forallSent::"nat list\<Rightarrow>paraStatement \<Rightarrow> statement"  where
oneSent: "forallSent ([i])  paraS = paraS i"|
moreSent:" forallSent  (i#j#xs ) paraS=cat (paraS i) (forallSent (j#xs) paraS)  "

text{* The simplest formula is equivalence between expressions. Negation, conjunction, disjunction, and implicattion formulas are also defined. A parameterized formula is just a function from a natural number to a formula.*}

text{*Similarly, a parameterized formula is a function from a parameter to a formula. We also define
 the $\mathsf{forall}$ and $mathsf{exists}$ formulas$.*}
type_synonym paraFormula="nat \<Rightarrow> formula"

fun forallForm::"nat list \<Rightarrow>paraFormula \<Rightarrow> formula" where
oneAllForm: "forallForm [i] forms = forms i"|
moreAllForm: "forallForm (i#j#xs)  forms = andForm (forms i) (forallForm (j#xs)  forms)"

fun exitsForm::"nat list \<Rightarrow>paraFormula \<Rightarrow> formula" where
oneExForm: " exitsForm [i] forms = forms i"|
moreExForm: " exitsForm (i#j#xs)  forms = orForm (forms i) (forallForm (j#xs)  forms)"

text{*With the formalizatiion of formula and statement, it is natural to define a rule. A guard and
 statement of a rule are also defined for convenience. *}
datatype rule =  guard formula  statement

primrec pre::"rule \<Rightarrow> formula" where
"pre (guard f a)=f"

primrec act::"rule \<Rightarrow>statement" where
"act  (guard f a)=a"

text{*A parameterized rule is just from a natural number to a rule.*}
type_synonym paraRule=" nat \<Rightarrow> rule"

section{*semantics of a protocol*}
text{*A  state of a protocol  is an instantaneous snapshot of its  behaviour given by an assignment of  values to variables of
the circuit. Therefore, we define:*}

type_synonym state= "varType \<Rightarrow> nat "

text{*The formal semantics of an expression and a formula is formalized as follows:*}
primrec expEval :: "expType \<Rightarrow> state \<Rightarrow> nat" and
 formEval :: "formula \<Rightarrow> state \<Rightarrow>bool"  where

"expEval  (IVar ie) s =  ( s ie)" |
"expEval  (Const i) s =  i"  |
"expEval  (iteForm f e1 e2) s=
   ( if (formEval f s) then     (expEval e1 s)
   else (expEval e2 s))"  |

evalExp: "formEval (eqn e1 e2) s= ((expEval e1 s) = (expEval e2 s))" |
evalAnd: "formEval ( andForm f1 f2) s=( (formEval f1 s) \<and> (formEval f2 s))"|
evalNeg: "formEval (neg f1 ) s= ( \<not>(formEval f1 s))"|
evalOr: "formEval (orForm f1 f2) s=( (formEval f1 s) \<or>  (formEval f2 s))"|
evalImp:"formEval (implyForm f1 f2) s= ( (formEval f1 s) \<longrightarrow>  (formEval f2 s))" |
"formEval chaos s=True"

text{*A state transition from a state to another sate, which is caused by an execution of a statement, is
 defined as follows:*}

primrec statement2Assigns::"statement \<Rightarrow> assignType list" where
"statement2Assigns (assign asgn)=[asgn]" |
"statement2Assigns (parallel a S)=a#statement2Assigns S"

definition wellformedAssgnList::"assignType list => bool" where
" wellformedAssgnList asgns\<equiv>distinct (map fst asgns)"

primrec transAux:: "assignType list \<Rightarrow> state \<Rightarrow>state " where
"transAux [] s= s " |
"transAux (pair#asgns) s=( transAux asgns s) ((fst pair):= expEval  (snd pair) s) "

definition trans:: "statement \<Rightarrow> state \<Rightarrow>state " where [simp]:
"trans S s \<equiv> transAux (statement2Assigns S) s"

text{*Here we must point out the fact that the assignments in a parallel assignment is executed in parallel, therefore we always assign an evaluation of an expression in the state $s$ to the corresponding variable.*}

text{*The reachable sate set of a protocol, which is describled by a set of initiate formulas and a set of rules, can be formalized inductively as follows:*}

inductive_set reachableSet::" formula set\<Rightarrow> rule set \<Rightarrow>state set"
  for  inis::"formula set"  and rules::"rule set"   where

initState:  "\<lbrakk>formEval  ini s; ini \<in>  inis\<rbrakk>  \<Longrightarrow>(  s \<in>  ( reachableSet inis rules))" |

oneStep:    " \<lbrakk>s \<in>  reachableSet inis rules ;
               r \<in>   rules ;formEval (pre r ) s \<rbrakk> \<Longrightarrow>  trans  (act r ) s  \<in>  reachableSet inis rules"

text{*The rule $\mathsf{initState}$ says that a state $s$ is in $\mathsf{reachableSet}~inis~ rules$ if
 there exists a formula $ini$ that is true in state $s$. Next rule $\mathsf{oneStep}$ says that
$$\mathsf{ trans}~  ($\mathsf{act}~ r )~ s $ is also in
 $\mathsf{reachableSet}~inis~ rules$ if $s$ already is in
 $\mathsf{reachableSet}~inis~ rules$ and $r \<in> rules$.*}

definition formEquiv::"formula \<Rightarrow> formula \<Rightarrow> bool" where
"formEquiv f1 f2\<equiv> \<forall> s. formEval f1 s = formEval f2 s"

type_synonym permutationSet= " (nat \<Rightarrow> nat) set"

definition sentEquiv::"statement \<Rightarrow> statement \<Rightarrow> bool" where
"sentEquiv S1 S2\<equiv> \<forall> s . trans S1 s = trans S2 s"

definition ruleEquiv::"rule \<Rightarrow> rule \<Rightarrow> bool" where
"ruleEquiv r1 r2\<equiv> formEquiv (pre r1) (pre r2) \<and> sentEquiv (act r1) (act r2)"

primrec onParamVar::"nat \<Rightarrow> varType \<Rightarrow> bool"  where
" onParamVar i (Global v) = False" |
" onParamVar i (Para v j) = (if (i=j) then True else False)"

primrec onParamExp::"nat \<Rightarrow> expType \<Rightarrow> bool"  where
"onParamExp i (IVar v) = onParamVar i  v" |
"onParamExp i (Const j) =  False "

primrec  onParamCond::"nat\<Rightarrow> formula \<Rightarrow> bool"  where
"onParamCond i  (eqn e1 e2) = ( (onParamExp i e1 ) \<or>  (onParamExp i e2))" |
"onParamCond i  ( andForm f1 f2) =(  (onParamCond i  f1 ) \<or>  (onParamCond  i f2 ))"|
"onParamCond i  (neg f1 ) = (  (onParamCond i  f1 ))"|
"onParamCond i  (orForm f1 f2) =(  (onParamCond i f1 )  \<or>   (onParamCond i f2 ))"|
"onParamCond  i (implyForm f1 f2) = (  (onParamCond i f1 ) \<or>  (onParamCond i f2 ))"

primrec  onParamSent::"nat\<Rightarrow> statement \<Rightarrow> bool" where
" onParamSent i (assign a)=( onParamVar i (fst a)) "|
" onParamSent i ( parallel a sent2)= ((onParamVar i (fst a)) \<or>  (onParamSent i sent2))"

text{*Functions $\mathsf{varIsOnVar}~x~x'$, $\mathsf{varIsOnExp}~x~e$,  $\mathsf{varIsOnForm}~x~f$, and  $\mathsf{varIsOnSent}~x~S$
define whether a pattern variable $x$  occurs in a target variable $x'$, expression $e$, a formula $f$, and a statement $S$. Namely, $x$
occurs in the above targets.
For instance, for the statement   $S=\mathsf{assign}~  ((\mathsf{Para}~  ''n''~ i), (\mathsf{Const} ~1))$, variable  $x=\mathsf{Global}~''x''$ does not occur in it, hence $ \neg  $\mathsf{varIsOnSent}~x~S$.  *}

definition varIsOnVar::"varType \<Rightarrow> varType \<Rightarrow> bool"  where  [simp]:
" varIsOnVar pat  target = (pat =target)"

primrec varIsOnExp::"varType \<Rightarrow> expType \<Rightarrow> bool"  where
"varIsOnExp x (IVar v) = varIsOnVar x   v" |
"varIsOnExp x (Const j) =  False "

primrec  varIsOnForm::"varType\<Rightarrow> formula \<Rightarrow> bool"  where
"varIsOnForm x  (eqn e1 e2) = ( (varIsOnExp x  e1 ) \<or>  (varIsOnExp x e2))" |
"varIsOnForm x  ( andForm f1 f2) =(  (varIsOnForm x f1 ) \<or>  (varIsOnForm x f2 ))"|
"varIsOnForm x  (neg f1 ) = (  (varIsOnForm x  f1 ))"|
"varIsOnForm x  (orForm f1 f2) =(  (varIsOnForm x  f1 )  \<or>   (varIsOnForm x f2 ))"|
"varIsOnForm  x (implyForm f1 f2) = (  (varIsOnForm x f1 ) \<or>  (varIsOnForm x f2 ))"

primrec  varIsOnSent::"varType \<Rightarrow> statement \<Rightarrow> bool" where
" varIsOnSent x (assign a)=( varIsOnVar x (fst a)) "|
" varIsOnSent x ( parallel a sent2)= (( varIsOnVar x (fst a)) \<or>  (varIsOnSent x sent2))"

primrec assignsOf::"statement \<Rightarrow> assignType set" where
"assignsOf (assign a) ={a}" |
"assignsOf (parallel a S)= {a} \<union> assignsOf S"

primrec eqnOnRule::"formula \<Rightarrow> rule \<Rightarrow> bool"  where
"eqnOnRule (eqn e1 e2) r=( \<exists>x. (e1=IVar x) \<and>(x,e2) \<in> assignsOf (act r))"

primrec negEqnOnRule::"formula \<Rightarrow> rule \<Rightarrow> bool"  where
"negEqnOnRule (neg f) r=( \<exists>x e1 e2 e2'. f=  (eqn e1 e2) \<and> (e1=IVar x) \<and>(x,e2') \<in> assignsOf (act r)\<and> e2 \<noteq>e2')"

text{*Function $\mathsf{statementEnableForm}$ says that formula $f$ will be valid after statement $S$ is executed from any state $s$. On the other hand,  $\mathsf{statementDisableForm}$ says that formula $f$ must be invalid after statement $S$ is executed from any state $s$ For instance,  for the statement $S=\mathsf{assign}~  ((\mathsf{Para}~  ''n''~ 0), (\mathsf{Const} ~1))$, formula $f_1=  eqn (IVar (Para ''n'' 0)) (Const 1)) $, $f_2= eqn (IVar (Para ''n'' 0)) (Const 2))$, we have $\mathsf{statementEnableForm}~S~f_1$ and $\mathsf{statementDisableForm}~S~f_2$.*}
(*definition statementEnableForm::"statement \<Rightarrow> formula \<Rightarrow> bool" where  [simp]:
" statementEnableForm S f \<equiv>
  \<forall>s. ( formEval f (trans S s))"

definition statementDisableForm::"statement \<Rightarrow> formula \<Rightarrow> bool" where  [simp]:
" statementDisableForm S f \<equiv>
  \<forall>s.  (\<not> formEval f (trans S s))"
 *)

definition varsOfVar::" varType \<Rightarrow> varType set"  where  [simp]:
" varsOfVar x  = {x}"

primrec varOfExp::"expType \<Rightarrow> varType set"  and
  varOfForm::"formula \<Rightarrow> varType set"  where
"varOfExp  (IVar v) =   varsOfVar v" |
"varOfExp   (Const j) =  {}" |

"varOfExp   (iteForm f e1 e2) =(varOfForm f) \<union>  (varOfExp   e1 )  \<union>   (varOfExp  e2)" |

"varOfForm   (eqn e1 e2) = ( (varOfExp   e1 )  \<union>   (varOfExp  e2))" |
"varOfForm   ( andForm f1 f2) =(  (varOfForm  f1 )  \<union>  (varOfForm  f2 ))"|
"varOfForm   (neg f1 ) = (  (varOfForm   f1 ))"|
"varOfForm   (orForm f1 f2) =(  (varOfForm   f1 )   \<union>   (varOfForm  f2 ))"|
"varOfForm   (implyForm f1 f2) = (  (varOfForm  f1 )  \<union>  (varOfForm f2 ))"|
"varOfForm   (chaos) ={}"

primrec  varOfSent::"statement \<Rightarrow> varType set" where
" varOfSent  (assign a)=( varsOfVar  (fst a)) "|
" varOfSent  ( parallel a sent2)= (( varsOfVar  (fst a)) \<union>  (varOfSent  sent2))"

(*primrec  varOfSentL::"statement \<Rightarrow> varType set" where
" varOfSentL  (assign a)=( varsOfVar  (fst a)) "|
" varOfSentL  ( parallel a sent2)= (( varsOfVar  (fst a)) \<union>  (varOfSent  sent2))"*)

definition invHoldForRule2::" formula \<Rightarrow> rule \<Rightarrow> bool" where
"invHoldForRule2 f  r \<equiv>   (varOfSent (act r)) \<inter> (varOfForm f)={} "

primrec conjs::"formula \<Rightarrow> formula set" where
"conjs   (eqn e1 e2) = {(eqn e1 e2)}" |
"conjs   ( andForm f1 f2) =(   (conjs   f1 ) \<union>  (conjs   f2 ))"|
"conjs   (neg f1 ) = {( neg (   f1 ))}"|
"conjs   (orForm f1 f2) ={(orForm  (  f1 )   (  f2 ))}"|
"conjs   (implyForm f1 f2) ={ (implyForm  (  f1 )  (  f2 ))}"|
"conjs  chaos={}"

primrec conjsOnVars::"formula \<Rightarrow> varType set \<Rightarrow>formula" where

"conjsOnVars   (eqn e1 e2) vars= (if ((varOfExp e1) \<subseteq> vars) then  (eqn e1 e2) else chaos)" |
"conjsOnVars   ( andForm f1 f2) vars = (if (conjsOnVars f1 vars)=chaos then  (conjsOnVars   f2  vars)
                            else if (conjsOnVars f1 vars)=chaos then  (conjsOnVars f1 vars)
                            else  andForm (conjsOnVars f1 vars) (conjsOnVars f2 vars))"|
"conjsOnVars   (neg f1 ) vars=  (if ((varOfForm f1) \<subseteq> vars) then  (neg f1) else chaos)"|
"conjsOnVars   (orForm f1 f2) vars=(orForm  (  f1 )   (  f2 ))"|
"conjsOnVars   (implyForm f1 f2) vars= (implyForm  (  f1 )  (  f2 ))"|
"conjsOnVars   chaos vars= chaos"

definition preStateEnable::" statement \<Rightarrow> formula \<Rightarrow> formula\<Rightarrow>bool" where
"preStateEnable S post preCond \<equiv> \<forall> s. formEval post (trans S s) \<longrightarrow>  formEval preCond  s "

definition ofImplyForm::"formula \<Rightarrow> bool" where
"ofImplyForm f\<equiv> \<exists>ant cons. f= implyForm ant cons"

lemma lemmaOnConjsOnVars:
  " formEval f s \<longrightarrow>  formEval (conjsOnVars f S) s "
  apply(induct_tac f)
  apply force+
  done
lemma noEffectOnExpAux:
  shows "(\<forall>   s. (varOfExp E) \<inter>  set (map fst asgns) ={} \<longrightarrow>
  expEval E  s  =  expEval E (transAux asgns s))
  \<and>
  (\<forall>   s. (varOfForm f) \<inter>  set (map fst asgns) ={} \<longrightarrow>
  formEval f s  =  formEval f (transAux asgns s))"
  (is "(\<forall>  s. ?P asgns s E) \<and>( \<forall>  s. ?Q asgns s f)")
proof(induct_tac E and f)

  fix varType
  let ?E="IVar varType"
  show "(\<forall>  s. ?P asgns s ?E)" (is "\<forall>s. ?R s asgns")
  proof(rule allI)
  fix s
  show "?R s asgns"
  proof( induct_tac asgns)
    show "?R s []" by simp
    next
    fix a asgns
    assume  a1:"?R s asgns"
    show "?R s (a#asgns)"
    proof

    assume c1:" varOfExp (?E) \<inter> set (map fst (a # asgns)) = {}"

      have d1:"\<exists> v val0. a=(v,val0)"
            by auto
    then obtain var val0 where d2:"a=(var,val0)"
            by blast
    (*have b1':"(\<forall> f s. ?P asgns s f)"
          by(cut_tac b1,simp)*)
     have f1:"expEval ?E s = expEval ?E (transAux ( asgns) s)"

          apply(cut_tac a1  c1 )
          apply auto
          done
      have f2:" expEval ?E (transAux (a # asgns) s)= expEval ?E (transAux ( asgns) s)"
          apply(cut_tac a1 c1,simp)
          apply( auto)
         done
      show " expEval ?E s = expEval ?E (transAux (a # asgns) s)"
         apply(cut_tac f1 f2, simp)
         done
     qed
   qed
  qed
next
  fix n

  let ?E="Const n"
  show "(\<forall>  s. ?P asgns s ?E)" (is "\<forall>s. ?R s asgns")
  by auto
next
  fix frm e1 e2
   let ?E="iteForm frm e1 e2"
  assume a1:"( \<forall>  s. ?Q asgns s frm)" and a2:"(\<forall>  s. ?P asgns s e1)" and a3:"(\<forall>  s. ?P asgns s e2)"

  show "(\<forall>  s. ?P asgns s ?E)" (is "\<forall>s. ?R s asgns")
  proof(rule allI,rule impI)
  fix s
   assume c1:" varOfExp (?E) \<inter> set (map fst ( asgns)) = {}"
   show "expEval (iteForm frm e1 e2) s = expEval (iteForm frm e1 e2) (transAux asgns s)"
   apply(cut_tac a1 a2 a3 c1)
   apply auto
   done
   qed
next
  fix e1 e2
  let ?f="eqn e1 e2"
  assume a1:"(\<forall>  s. ?P asgns s e1)" and a2:"(\<forall>  s. ?P asgns s e2)"

  show "(\<forall>  s. ?Q asgns s ?f)" (is "\<forall>s. ?R s asgns")
  proof(rule allI,rule impI,cut_tac a1 a2,auto)
  qed
next
  fix f1 f2
  let ?f="andForm f1 f2"
  assume a1:"( \<forall>  s. ?Q asgns s f1)" and  a2:"( \<forall>  s. ?Q asgns s f2)"
  show "( \<forall>  s. ?Q asgns s ?f)"

  proof(rule allI,rule impI,cut_tac a1 a2,auto)
  qed
next
  fix f1
  let ?f="neg f1 "
  assume a1:"( \<forall>  s. ?Q asgns s f1)"
  show "( \<forall>  s. ?Q asgns s ?f)"

  proof(rule allI,rule impI,cut_tac a1 ,auto)
  qed
next
  fix f1 f2
  let ?f="orForm f1 f2"
  assume a1:"( \<forall>  s. ?Q asgns s f1)" and  a2:"( \<forall>  s. ?Q asgns s f2)"
  show "( \<forall>  s. ?Q asgns s ?f)"

  proof(rule allI,rule impI,cut_tac a1 a2,auto) qed
next
fix f1 f2
  let ?f="implyForm f1 f2"
  assume a1:"( \<forall>  s. ?Q asgns s f1)" and  a2:"( \<forall>  s. ?Q asgns s f2)"
  show "( \<forall>  s. ?Q asgns s ?f)"

  proof(rule allI,rule impI,cut_tac a1 a2,auto) qed
next
  show "( \<forall>  s. ?Q asgns s chaos)"
  by auto
qed
lemma varsOfSent1:
  " (varOfSent S) = set (map fst (statement2Assigns S))"
  proof(induct_tac S,auto) qed

lemma noEffect: shows "(\<forall>   s. (varOfExp E) \<inter>  (varOfSent S) ={} \<longrightarrow> expEval E s  =  expEval E (trans S s)) \<and>
(\<forall>s. varOfForm f \<inter>  (varOfSent S) ={}\<longrightarrow>
         formEval f s = formEval f (trans S s))"
apply(cut_tac  f="f" and E="E" and asgns="  ((statement2Assigns S))" in noEffectOnExpAux)
apply(unfold trans_def)
apply(cut_tac S="S" in varsOfSent1)
apply metis
done

lemma noEffectOnExp:
  assumes a1:"(varOfExp E) \<inter>  (varOfSent S) ={} "
    shows " expEval E s  =  expEval E (trans S s)"
by (metis assms noEffect)

lemma noEffectOnFormula:
  assumes a1:"(varOfForm f) \<inter>  (varOfSent S) ={} "
    shows " formEval f s  =  formEval f (trans S s)"
by (metis assms noEffect)

lemma conjsOfConj: "\<not> (andForm f1 f2)  \<in> conjs f"
  apply(induct_tac f)
  apply auto
  done

lemma inConjsInply:
  shows "f \<in> conjs f'\<longrightarrow>formEval f' s \<longrightarrow> formEval f s"
  apply(induct_tac f')
  apply force+
  done

primrec mutualNeg::"formula \<Rightarrow>formula" where

"mutualNeg (eqn e1 e2) = neg (eqn e1 e2) " |
"mutualNeg ( andForm f1 f2) = neg  ( andForm f1 f2)"|
"mutualNeg (neg f1 ) = ( ( f1 ))"|
"mutualNeg (orForm f1 f2) = neg (orForm f1 f2 )"|
"mutualNeg (implyForm f1 f2) = neg  (implyForm f1 f2)" |
"mutualNeg chaos=chaos"

primrec dual::"formula \<Rightarrow> formula" where
"dual (implyForm f g)=  (implyForm (mutualNeg  g) (mutualNeg  f))"

definition logicImply::"formula \<Rightarrow> formula \<Rightarrow>bool" where [simp]:
"logicImply f1 f2\<equiv>  ( \<forall> s. formEval f1 s\<longrightarrow> formEval f2 s)"

primrec valOf::"assignType list \<Rightarrow> varType =>expType"  where
"valOf [] v=IVar v" |
"valOf (x#xs) v= (if ((fst x) =v) then (snd x) else valOf xs v)"

primrec substExp :: "expType\<Rightarrow> assignType list \<Rightarrow>expType"  and
substForm ::"formula \<Rightarrow> assignType list \<Rightarrow> formula" where
(*substExpVar: "substExp  (IVar v') asgns= (if ( \<not>wellformedAssgnList asgns ) then (IVar v')
                             else if (v' \<in> set (map fst asgns)) then  (valOf  asgns v') else (IVar v'))" |*)

substExpVar: "substExp  (IVar v') asgns=   (valOf  asgns v')  "|

substExpConst: "substExp  (Const i)  asgns= Const i" |

substExpite: "substExp  (iteForm f e1 e2)  asgns= (iteForm (substForm f asgns) (substExp e1  asgns) (substExp e2  asgns))"|
"substForm (eqn l r)  asgns=(eqn (substExp l  asgns) (substExp r  asgns))"  |
"substForm ( andForm f1 f2)  asgns =   ( andForm (substForm f1  asgns)  (substForm f2  asgns))"|
"substForm (neg f1 )   asgns= (neg ( substForm f1  asgns ))"|
"substForm (orForm f1 f2)   asgns= ( orForm (substForm f1  asgns )  (substForm f2  asgns))"|
"substForm (implyForm f1 f2)   asgns= (implyForm (substForm f1 asgns)  (substForm f2  asgns))" |
"substForm  chaos   asgns=chaos"

definition  substExpByStatement ::"expType \<Rightarrow>statement \<Rightarrow>expType"   where [simp]:
"substExpByStatement e S\<equiv>substExp e (statement2Assigns S)"

definition substFormByStatement ::"formula \<Rightarrow>statement \<Rightarrow>formula"   where [simp]:
"substFormByStatement f S\<equiv>substForm f (statement2Assigns S)"

definition statementEnableForm::"rule \<Rightarrow> formula\<Rightarrow>bool" where  [simp]:
" statementEnableForm  r f \<equiv>
  \<forall>s. formEval (pre r) s \<longrightarrow> formEval  (substFormByStatement f (act r)) s"

definition statementDisableForm::"rule  \<Rightarrow> formula \<Rightarrow> bool" where  [simp]:
" statementDisableForm r f \<equiv>
     \<forall>s. formEval (pre r) s \<longrightarrow> \<not> formEval  (substFormByStatement f (act r)) s "

(*primrec invHoldForRule1::" formula \<Rightarrow> rule \<Rightarrow> bool" where
"invHoldForRule1 (implyForm ant cons) r=
  ((statementEnableForm ( r) cons) \<or>  (statementDisableForm ( r) ant) ) "*)

primrec invHoldForRule1::" formula \<Rightarrow> rule \<Rightarrow> bool" where
"invHoldForRule1 (implyForm ant cons) r=
 ( \<forall>s. formEval (pre r) s \<longrightarrow>  formEval  (substFormByStatement  (implyForm ant cons) (act r)) s )"

primrec  invHoldForRule3::"formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where
" invHoldForRule3 (implyForm ant cons) r fs = (( (varOfSent (act r)) \<inter> varOfForm cons={})\<and>
  ( \<exists>f'  ant'. f' \<in> fs \<and> logicImply f'  (implyForm ant' cons ) \<and>
  (logicImply (andForm (pre r)  (substFormByStatement (ant) (act r)))  ant')))"

primrec  invHoldForRule4::"formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where
" invHoldForRule4 (implyForm ant cons) r fs = (

  ( \<exists>f'  ant'  ant''. f' \<in> fs \<and> logicImply f'  (implyForm ant' (neg ant'') ) \<and>  ( (varOfSent (act r)) \<inter> varOfForm ant''={})\<and> logicImply ant ant'' \<and>
              ( logicImply (andForm  (pre r)  (substFormByStatement (neg cons) (act r))) ant'))
)"

(*thm noEffect
lemma noEffect0:
  assumes a1:" (varOfSent S) \<inter> (varOfForm f)={} " and a2:"formEval f s"
  shows "formEval f (trans S s)"
  by (metis a1 a2 noEffect)*)

definition invHoldForRule5::"formula \<Rightarrow> rule \<Rightarrow>formula set  \<Rightarrow>bool" where  [simp]:
 "invHoldForRule5 inv0 r fs \<equiv>
 ( \<exists>f'.  f' \<in> fs \<and> logicImply f' (substFormByStatement inv0 (act r) ))"

abbreviation invHoldForRule::"formula \<Rightarrow> rule \<Rightarrow> (formula set) \<Rightarrow> bool" where
  "invHoldForRule inv0 r invs \<equiv>
  invHoldForRule1 inv0 r \<or>  invHoldForRule2 inv0 r \<or>
   invHoldForRule3 inv0 r invs \<or> invHoldForRule4 inv0 r invs \<or> invHoldForRule5 inv0 r invs"

definition consistent::"formula set \<Rightarrow> formula set \<Rightarrow> rule set \<Rightarrow>bool"  where
"consistent invs inis rs \<equiv>
(\<forall>inv ini s. (inv \<in> invs \<longrightarrow> ini\<in> inis\<longrightarrow> formEval ini s \<longrightarrow> formEval inv s)) \<and>
 (\<forall> inv r.  (inv \<in>invs  \<longrightarrow> r \<in> rs \<longrightarrow> invHoldForRule inv r invs  ))"

lemma  preCondOnExp:

  shows "( ( expEval (substExpByStatement e S) s =expEval e (trans S s)) \<and>
           ( formEval (substFormByStatement f S) s = formEval f (trans S s)))"

    (is "((  ?LHS e S=?RHS e S)\<and> ( ?LHS1 f S=?RHS1 f S))")
  proof(induct_tac e and f)
      fix v
      let ?e="(IVar v)"
      show  "?LHS ?e S=?RHS ?e S"
      proof(induct_tac S)
        fix prod
        let ?S="assign prod"
        show "?LHS ?e ?S=?RHS ?e ?S"

        apply(unfold  substExpByStatement_def trans_def,auto)
        done
    next
       fix prod S
       let ?S="parallel prod S"
       assume b1:"?LHS ?e S=?RHS ?e S"

       show "?LHS ?e ?S=?RHS ?e ?S"

       proof(unfold  substExpByStatement_def trans_def,
       case_tac "fst prod =v",force)
       assume d1:"fst prod \<noteq> v "
       show "expEval (substExp (IVar v) (statement2Assigns (parallel prod S))) s =
              expEval (IVar v) (transAux (statement2Assigns (parallel prod S)) s)"
       proof(cut_tac d1,simp,case_tac "(varOfExp ?e) \<inter>  set (map fst (statement2Assigns S) )={}")
        assume e1:"(varOfExp ?e) \<inter>  set (map fst (statement2Assigns S) )={}"
        have f1:"v \<notin> fst ` set (statement2Assigns S)"
        apply(cut_tac e1,simp)
        done
        have f2:" expEval ?e s  =  expEval ?e (transAux (statement2Assigns S) s)"
          apply(cut_tac e1)
          by (metis (no_types) noEffectOnExpAux)

        show " expEval (valOf (statement2Assigns S) v) s = transAux (statement2Assigns S) s v"
          by (metis b1 trans_def expEval_formEval.simps(1) substExpByStatement_def substExpVar)
        next
        assume  e1:"(varOfExp ?e) \<inter>  set (map fst (statement2Assigns S) )\<noteq>{}"
        have f1:"v \<in> fst ` set (statement2Assigns S)"
        apply(cut_tac e1,simp)
        done
      show " expEval (valOf (statement2Assigns S) v) s = transAux (statement2Assigns S) s v"
      by (metis b1 trans_def expEval_formEval.simps(1) substExpByStatement_def substExpVar)

      qed
    qed
  qed
next
  fix n
  let ?e="(Const n)"
      show  "?LHS ?e S=?RHS ?e S"
      apply( simp)
      done
next
  fix f e1 e2
  assume a1:" ( ?LHS1 f S=?RHS1 f S)" and
  a2:"?LHS e1 S=?RHS e1 S" and a3:"?LHS e2 S=?RHS e2 S"
  let ?e="iteForm f e1 e2"
  show "?LHS ?e S=?RHS ?e S"
  by (metis a1 a2 a3 expEval_formEval.simps(3) substExpByStatement_def substExpite substFormByStatement_def)
next
  fix e1 e2

  assume a1:"?LHS e1 S=?RHS e1 S" and a2:"?LHS e2 S=?RHS e2 S"
  let ?f="eqn e1 e2"
  show "( ?LHS1 ?f S=?RHS1 ?f S)"
   by (metis (full_types) a1 a2 empty_Collect_eq evalExp substExpByStatement_def substExp_substForm.simps(4) substFormByStatement_def)
next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" ( ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="andForm f1 f2"

  show "( ?LHS1 ?f S=?RHS1 ?f S)"
  by (metis a1 a2 evalAnd substExp_substForm.simps(5) substFormByStatement_def)
next
  fix f1
  assume a1:" ( ?LHS1 f1 S=?RHS1 f1 S)"
  let ?f="neg f1"
  show "( ?LHS1 ?f S=?RHS1 ?f S)"
  by (metis a1 evalNeg substExp_substForm.simps(6) substFormByStatement_def)
next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" ( ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="implyForm f1 f2"

  show "( ?LHS1 ?f S=?RHS1 ?f S)"
  by (metis a1 a2 evalImp substExp_substForm.simps(8) substFormByStatement_def)
next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" ( ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="orForm f1 f2"

  show "( ?LHS1 ?f S=?RHS1 ?f S)"
  by (metis a1 a2 evalOr substExp_substForm.simps(7) substFormByStatement_def)
next
  let ?f="chaos"
  show "( ?LHS1 ?f S=?RHS1 ?f S)"
  by auto
qed

lemma consistentLemma:
  assumes a1:"consistent invs inis rs" and a2:"s \<in> reachableSet inis rs" and
  a3:"\<forall>inv. inv \<in> invs \<longrightarrow> ofImplyForm inv"
  shows "\<forall> inv. inv \<in> invs \<longrightarrow>formEval inv s"  (is "?P s")
  using a2
  proof induct
    case (initState ini s)
    show "?P s"
      apply(cut_tac a1, unfold consistent_def)
      by (metis (lifting) initState(1) initState(2))
  next
    case (oneStep s r)
    show "?P  (trans (act r) s)"
    proof (rule allI, rule impI)
      fix inv
      assume b1:"inv \<in> invs"
      have b2:"invHoldForRule5 inv r invs \<or> invHoldForRule4 inv r invs \<or> invHoldForRule3 inv r invs \<or> invHoldForRule2 inv r \<or> invHoldForRule1 inv r"
        apply(cut_tac a1, unfold consistent_def)
        by (metis b1 oneStep(3))

       moreover
      {assume b1':"invHoldForRule5  inv r invs"

        have b2:"\<exists> ant cons. inv=implyForm ant cons"
          by(cut_tac b1 a3, unfold ofImplyForm_def,auto)

        then obtain ant cons where b2':"inv=implyForm ant cons"
          by auto

        have b3:" \<exists> f'. f' \<in> invs \<and> logicImply f' (substFormByStatement inv (act r) ) "  (is "\<exists> f'.  ?P f' ")
           apply (cut_tac b1' b2', unfold invHoldForRule5_def,auto)
          done

        then obtain f' ant' where b3':"?P f'  "
          by blast

        have b4:" formEval f' s"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

        have b5:"formEval  (substFormByStatement inv (act r))  s"
          by (metis (no_types) b3' b4 logicImply_def)

        then have "formEval inv (trans (act r) s)"
        by (metis preCondOnExp)

      }

      moreover
      {assume b1':"invHoldForRule3 inv r invs"

        have b2:"\<exists> ant cons. inv=implyForm ant cons"
          by(cut_tac b1 a3, unfold ofImplyForm_def,auto)

        then obtain ant cons where b2':"inv=implyForm ant cons"
          by auto

        have b3:"  ( \<exists>f'  ant'. f' \<in> invs \<and> logicImply f'  (implyForm ant' cons ) \<and>
          (logicImply (andForm (pre r)  (substFormByStatement (ant) (act r)))  ant'))"  (is "\<exists> f' ant'. ?P f' ant'")
           apply (cut_tac b1' b2', unfold invHoldForRule3_def,auto)
          done

        then obtain f' ant' where b3':"?P f' ant' "
          by blast

        have b4:" formEval f' s"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

        have b5:"formEval (pre r) s"
          by (metis (lifting) oneStep(4))

        have b6:"formEval (substFormByStatement (ant) (act r)) s \<or>
          \<not>formEval (substFormByStatement (ant) (act r)) s"
          by blast
        moreover
        {assume b7:"formEval (substFormByStatement (ant) (act r)) s"
          have b8:"formEval ant' s"
            apply(cut_tac b5 b7)
            apply(cut_tac b3',simp add:logicImply_def)
            done
          have b9:"formEval cons  s"
            by (metis (full_types) b3' b4 b8 evalImp logicImply_def)
          thm noEffect
          have b10:" formEval cons (trans (act r) s)"
          by (metis Int_commute b1' b2' b9 invHoldForRule3.simps noEffectOnFormula)

          have "formEval inv (trans (act r) s)"
            apply(cut_tac b10 b2',force)
            done
        }
        moreover
        {assume b4':"\<not>formEval (substFormByStatement (ant) (act r)) s"
          have b5:"\<not>formEval (ant) (trans (act r) s)"
            apply(cut_tac  b4')
            by (metis preCondOnExp)

          have "formEval inv (trans (act r) s)"
            by(cut_tac b5 b2', unfold trans_def, auto)
        }
        ultimately have "formEval inv (trans (act r) s)"
          by blast
      }
      moreover
      {assume b1':"invHoldForRule2 inv r "
        have b2:"formEval inv s"
        by (metis b1 oneStep.hyps(2))
        have "formEval inv (trans (act r) s)"
        by (metis b1' b2 inf_commute invHoldForRule2_def noEffect)
          (*  apply(rule noEffect0)
          apply(cut_tac b1')
          apply (metis invHoldForRule2_def)
          by(metis b2)*)
      }
      moreover
      {assume b1':"invHoldForRule1 inv r "

        have b2:"\<exists> ant cons. inv=implyForm ant cons"
          by(cut_tac b1 a3, unfold ofImplyForm_def,auto)
        have b3:"formEval (pre r) s"
          by (metis (lifting) oneStep(4))

        from b2 obtain ant cons where b2':"inv=implyForm ant cons"
           by auto
         have "formEval inv (trans (act r) s)"
           apply(subgoal_tac "formEval (substFormByStatement inv (act r)) s")
           apply (metis preCondOnExp)
           apply(cut_tac b1' b2')

           apply(cut_tac b3)
           by (metis evalImp invHoldForRule1.simps preCondOnExp statementDisableForm_def statementEnableForm_def)

       }
       moreover
       {assume b1':"invHoldForRule4 inv r invs"

         have b2:"\<exists> ant cons. inv=implyForm ant cons"
           by(cut_tac b1 a3, unfold ofImplyForm_def,auto)

         then obtain ant cons where b2':"inv=implyForm ant cons"
           by auto

         have b3:"
  ( \<exists>f'  ant'  ant''. f' \<in> invs \<and> logicImply f'  (implyForm ant' (neg ant'') ) \<and>  ( (varOfSent (act r)) \<inter> varOfForm ant''={})\<and> logicImply ant ant'' \<and>
              ( logicImply (andForm  (pre r)  (substFormByStatement (neg cons) (act r))) ant'))" (is " ( \<exists>f' ant' ant''. ?P f' ant' ant'')")
           apply(cut_tac b1' b2')

           apply (simp)
           done

         then obtain f' and ant' and ant''  where b3':"(?P f' ant' ant'')"
           by blast

         have b4':"formEval (substFormByStatement (neg cons) (act r)) s \<or>
             \<not>formEval (substFormByStatement (neg cons) (act r)) s"
           by blast
         moreover
         {assume b4':"formEval (substFormByStatement (neg cons) (act r)) s"
           have b5:"formEval ant' s"
             apply(cut_tac b3' b4')
             by (metis (no_types) evalAnd logicImply_def oneStep(4))
           have b6:"\<not>formEval ant'' s"

            by (smt b3' b5 evalImp evalNeg logicImply_def oneStep(2))

           have b8:"\<not> formEval ant'' (trans (act r) s)"
           by (metis Int_commute b3' b6 noEffectOnFormula)

            have b7:"\<not>formEval ant  (trans (act r) s)"
              by (metis b3' b8 logicImply_def)

           have "formEval inv (trans (act r) s)"
             apply(cut_tac b7 b2',force)
             done
         }
         moreover
         {assume b4':"\<not>formEval (substFormByStatement (neg cons) (act r)) s"
           have "\<not>formEval (neg cons) (trans (act r) s)"
             apply(cut_tac  b4')
             by (metis preCondOnExp)

           then have b5: "formEval ( cons) (trans (act r) s)"
             by auto
           have "formEval inv (trans (act r) s)"
             by(cut_tac b5 b2', unfold trans_def, auto)
         }
         ultimately have "formEval inv (trans (act r) s)"
           by blast
       }
       ultimately show "formEval inv (trans (act r) s)"
         by blast
     qed
   qed

definition invHoldForRule1'::" state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> bool" where [simp]:
"invHoldForRule1' s f  r \<equiv>
 (  formEval (pre r) s \<longrightarrow>  formEval  (substFormByStatement f  (act r)) s )"

 definition invHoldForRule2'::" state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> bool" where [simp]:
"invHoldForRule2' s f  r \<equiv>  (  formEval  (substFormByStatement f  (act r)) s  =  formEval f s)"

definition  invHoldForRule3'::"state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where [simp]:
" invHoldForRule3' s f r fs  \<equiv>
  (let pref=substFormByStatement f (act r) in
  ( \<exists>f'. f' \<in> fs \<and>  (formEval   (andForm (pre r)  f') s\<longrightarrow> formEval  pref s)))"

primrec andListForm::"formula list \<Rightarrow> formula " where
"andListForm [] = chaos" |
"andListForm  (f#fs) = andForm f (andListForm  fs)"

definition andSetForm::"formula set \<Rightarrow> formula " where
"andSetForm fs == Finite_Set.fold  andForm chaos  fs"

definition  invHoldForRule3''::"state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where [simp]:
" invHoldForRule3'' s f r fs  \<equiv>
  (let pref=substFormByStatement f (act r) in
  ( (\<forall> f'.  f' \<in>  fs\<longrightarrow>formEval f'  s) \<longrightarrow>formEval (pre r)  s\<longrightarrow> formEval  pref s))"

abbreviation invHoldForRule'::"state \<Rightarrow>formula \<Rightarrow> rule \<Rightarrow> (formula set) \<Rightarrow> bool" where
  "invHoldForRule' s inv0 r invs \<equiv>
    invHoldForRule1' s inv0 r \<or>  invHoldForRule2' s inv0 r \<or>
   invHoldForRule3' s inv0 r invs "

abbreviation invHoldForRule''::"state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> (formula set) \<Rightarrow> bool" where
  "invHoldForRule'' s inv0 r invs \<equiv>
    invHoldForRule1' s inv0 r \<or>  invHoldForRule2' s inv0 r \<or>
   invHoldForRule3'' s inv0 r invs "

lemma weak3:
 " invHoldForRule3' s f r fs \<Longrightarrow> invHoldForRule3'' s f r fs "
  by auto

lemma weak:
 " invHoldForRule' s f r fs \<Longrightarrow> invHoldForRule'' s f r fs "
  by( auto intro:weak3)

lemma strengthEn:
" invHoldForRule'' s f r fs \<Longrightarrow> invHoldForRule' s f r fs "
  by( auto )

definition newconsistent::"formula set \<Rightarrow> formula set \<Rightarrow> rule set \<Rightarrow>bool"  where
"newconsistent invs inis rs \<equiv>
(\<forall>inv ini s. (inv \<in> invs \<longrightarrow> ini\<in> inis\<longrightarrow> formEval ini s \<longrightarrow> formEval inv s)) \<and>
 (\<forall> inv r s.  (inv \<in>invs  \<longrightarrow> r \<in> rs \<longrightarrow> invHoldForRule' s inv r invs  ))"

 definition newconsistent'::"formula set \<Rightarrow> formula set \<Rightarrow> rule set \<Rightarrow>bool"  where
"newconsistent' invs inis rs \<equiv>
(\<forall>inv ini s. (inv \<in> invs \<longrightarrow> ini\<in> inis\<longrightarrow> formEval ini s \<longrightarrow> formEval inv s)) \<and>
 (\<forall> inv r s.  (inv \<in>invs  \<longrightarrow> r \<in> rs \<longrightarrow> invHoldForRule'' s inv r invs  ))"

lemma newconsistentLemma:
  assumes a1:"newconsistent invs inis rs" and a2:"s \<in> reachableSet inis rs"
  shows "\<forall> inv. inv \<in> invs \<longrightarrow>formEval inv s"  (is "?P s")
  using a2
  proof induct
    case (initState ini s)
    show "?P s"
      apply(cut_tac a1, unfold newconsistent_def)
      by (metis (lifting) initState(1) initState(2))
  next
    case (oneStep s r)
    show "?P  (trans (act r) s)"
    proof (rule allI, rule impI)
      fix inv
      assume b1:"inv \<in> invs"
      have b2:" invHoldForRule3' s inv r  invs \<or> invHoldForRule2' s inv r   \<or> invHoldForRule1' s inv r  "
        apply(cut_tac a1, unfold newconsistent_def)
        by (metis b1 oneStep(3))

     moreover
      {   assume c1:"invHoldForRule3' s inv r invs"

        let ?pref="substFormByStatement inv (act r)"
          have b3:"  ( (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval f'  s) \<longrightarrow>formEval (pre r)  s\<longrightarrow> formEval  ?pref s)  "  (is " ?P fs ")
           apply (cut_tac c1, unfold invHoldForRule3'_def,auto)
          done

        then have b3':"?P fs  "
          by blast

        have b4:" (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval f'  s)"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

        have b5:"formEval (pre r) s"
          by (metis (lifting) oneStep(4))

        have b6:"formEval ?pref s"
         by(cut_tac b4 b5 b3', auto simp add:logicImply_def)

          have "formEval inv (trans (act r) s)"
            apply(cut_tac b6,metis preCondOnExp)
            done
      }

     moreover
      {assume b1':"invHoldForRule2' s inv r "
        have b2:"formEval inv s"
        by (metis b1 oneStep.hyps(2))

        let ?pref="substFormByStatement inv (act r)"
        have b3:" (  formEval  ?pref s  =  formEval inv s)"
        by(cut_tac b1',unfold  invHoldForRule2'_def,simp)

        with b2 have b4:"formEval ?pref s"
          by auto

        have "formEval inv (trans (act r) s)"
        by (cut_tac b4,  metis preCondOnExp)
          (*  apply(rule noEffect0)
          apply(cut_tac b1')
          apply (metis invHoldForRule2_def)
          by(metis b2)*)
      }
      moreover
      {assume b1':"invHoldForRule1' s inv r "

         have b5:"formEval (pre r) s"
          by (metis (lifting) oneStep(4))

         have "formEval inv (trans (act r) s)"
           apply(subgoal_tac "formEval (substFormByStatement inv (act r)) s")
           apply (metis preCondOnExp)
           apply(cut_tac b1' b5)
           by(unfold invHoldForRule1'_def,auto)

       }
       ultimately show "formEval inv (trans (act r) s)"
         by blast
     qed
   qed
lemma andListFormAux1:

  shows "set fs \<subseteq>  fs' \<longrightarrow>( \<forall> inv. inv \<in> fs' \<longrightarrow>formEval inv s)\<longrightarrow> formEval (andListForm fs) s"
  proof(induct_tac fs,auto)qed

lemma andListForm1[simp,intro]:

  "\<lbrakk>set fs \<subseteq>  invs ; ( \<forall> inv. inv \<in>invs \<longrightarrow>formEval inv s)\<rbrakk>\<Longrightarrow> formEval (andListForm fs) s"
 by(metis  andListFormAux1)

(*lemma andListSetAux1:

  shows " fs \<subseteq>  fs' \<longrightarrow>( \<forall> inv. inv \<in> fs' \<longrightarrow>formEval inv s)\<longrightarrow> formEval (andSetForm fs) s"
  proof(induct_tac fs,auto)qed*)

lemma newconsistentLemma':
  assumes a1:"newconsistent' invs inis rs" and a2:"s \<in> reachableSet inis rs"
  shows "\<forall> inv. inv \<in> invs \<longrightarrow>formEval inv s"  (is "?P s")
  using a2
  proof induct
    case (initState ini s)
    show "?P s"
      apply(cut_tac a1, unfold newconsistent'_def)
      by (metis (lifting) initState(1) initState(2))
  next
    case (oneStep s r)
    show "?P  (trans (act r) s)"
    proof (rule allI, rule impI)
      fix inv
      assume b1:"inv \<in> invs"
      have b2:" invHoldForRule3'' s inv r  invs \<or> invHoldForRule2' s inv r   \<or> invHoldForRule1' s inv r  "
        apply(cut_tac a1, unfold newconsistent'_def)
        by (metis b1 oneStep(3))

     moreover
      {   assume c1:"invHoldForRule3'' s inv r invs"

        let ?pref="substFormByStatement inv (act r)"
           have b3:"  ( (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval f'  s) \<longrightarrow>formEval (pre r)  s\<longrightarrow> formEval  ?pref s)  "  (is " ?P fs ")
           apply (cut_tac c1, unfold invHoldForRule3''_def,auto)
          done

        then obtain fs'  where b3':"?P fs "
          by blast

        have b4:" (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval f'  s)"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

        have b5:"formEval (pre r) s"
          by (metis (lifting) oneStep(4))

        have b6:"formEval ?pref s"
         by(cut_tac b4 b5 b3', auto simp add:logicImply_def)

          have "formEval inv (trans (act r) s)"
            apply(cut_tac b6,metis preCondOnExp)
            done
      }

     moreover
      {assume b1':"invHoldForRule2' s inv r "
        have b2:"formEval inv s"
        by (metis b1 oneStep.hyps(2))

        let ?pref="substFormByStatement inv (act r)"
        have b3:" (  formEval  ?pref s  =  formEval inv s)"
        by(cut_tac b1',unfold  invHoldForRule2'_def,simp)

        with b2 have b4:"formEval ?pref s"
          by auto

        have "formEval inv (trans (act r) s)"
        by (cut_tac b4,  metis preCondOnExp)
          (*  apply(rule noEffect0)
          apply(cut_tac b1')
          apply (metis invHoldForRule2_def)
          by(metis b2)*)
      }
      moreover
      {assume b1':"invHoldForRule1' s inv r "

         have b5:"formEval (pre r) s"
          by (metis (lifting) oneStep(4))

         have "formEval inv (trans (act r) s)"
           apply(subgoal_tac "formEval (substFormByStatement inv (act r)) s")
           apply (metis preCondOnExp)
           apply(cut_tac b1' b5)
           by(unfold invHoldForRule1'_def,auto)

       }
       ultimately show "formEval inv (trans (act r) s)"
         by blast
     qed
   qed

lemma forall1:
  shows "\<forall> i. i \<le> N \<longrightarrow>formEval (forallForm (down N) pf ) s\<longrightarrow>formEval (pf i) s" (is "?P N")
proof(induct_tac N)
    show "?P  0"
      by simp
  next
    fix N
    assume b1:"?P N"
    show "?P  (Suc N)"
      proof(case_tac "N =0")
        assume c1:"N=0"
        show "?P  (Suc N)"
        proof(cut_tac c1, auto,case_tac "i=0", auto,case_tac "i=1",auto)qed
      next
        assume c1:"N\<noteq>0"
        have "0<N "
          by(cut_tac c1, arith)
       then have c2:"\<exists> N'. down (Suc N)=(Suc N)#N#down N'"
         by (metis down.simps(2) gr0_conv_Suc)
       then obtain N' where c2:"down (Suc N)=(Suc N)#N#down N'"
         by blast
       then have c3:"(N#down N')=down N"
         by simp
       show "?P  (Suc N)"
       proof(rule allI,(rule impI)+,cut_tac c2,simp)
         fix i
         assume d1:"i\<le> Suc N" and d2:" formEval (pf (Suc N)) s \<and> formEval (forallForm (N # down N') pf) s"
         have "i=Suc N \<or> i<Suc N"
           by (cut_tac d1, arith)
         moreover
         {assume e1:"i=Suc N"
           have " formEval (pf i) s"
             by (metis (lifting) d2 e1)
         }
         moreover
         {assume e1:"i<Suc N"
           have " formEval (pf i) s"
             by (metis b1 c3 d1 d2 le_Suc_eq)
         }
         ultimately show "formEval (pf i) s"
           by blast
       qed
     qed
   qed

lemma forallLemma [simp,dest]:
  assumes a1:"i \<le> N" and a2:"formEval (forallForm (down N) pf ) s"
  shows "formEval (pf i) s"
by (metis a1 a2 forall1)

primrec antOf ::"formula \<Rightarrow> formula" where [simp]:
"antOf (implyForm A B)=A"

primrec consOf::"formula \<Rightarrow> formula" where [simp] :
"consOf (implyForm A B)=B"

lemma varsOnCat:
  shows "varOfSent (cat S1 S2)=(varOfSent S1 ) \<union> (varOfSent S2 )"
  apply(induct_tac S1)
apply (metis (lifting) cat1 varOfSent.simps(1) varOfSent.simps(2))
by (metis Un_assoc cat2 varOfSent.simps(2))

lemma   forallVars:
  assumes a1:"\<forall> i.( varOfSent (paraForm i))\<inter> varSet ={}"
   shows  "(varOfSent (forallSent (down N) paraForm))\<inter> varSet ={}"
  proof(induct_tac N)
    show " varOfSent (forallSent (down 0) paraForm) \<inter> varSet = {}"
      apply(cut_tac a1,force)
      done
  next
    fix n
    assume b1:"varOfSent (forallSent (down n) paraForm) \<inter> varSet = {}"
    have " (varOfSent (forallSent (down (Suc n)) paraForm) )  =
      (varOfSent ( paraForm (Suc n)) ) \<union>
      (varOfSent (forallSent (down  n ) paraForm) )"
      by (metis (hide_lams, no_types) add_0_right moreSent down.simps(1) down.simps(2) nat.exhaust varsOnCat)
      then show "  varOfSent (forallSent (down (Suc n)) paraForm) \<inter> varSet = {}"
      apply(-,cut_tac a1,simp )
      by (metis (lifting) Int_Un_distrib2 Un_empty_left b1)
  qed

lemma   forallVars1[simp,intro!]:
  assumes a1:"\<forall>i. v \<notin>( varOfSent (paraForm i))"
   shows  "v \<notin>(varOfSent (forallSent (down N) paraForm))" (is "?P N")
  proof(induct_tac N)
    show "?P 0"
      apply(cut_tac a1,force)
      done
  next
    fix n
    assume b1:"?P n"
    have " (varOfSent (forallSent (down (Suc n)) paraForm) )  =
      (varOfSent ( paraForm (Suc n)) ) \<union>
      (varOfSent (forallSent (down  n ) paraForm) )"
      by (metis (hide_lams, no_types) add_0_right moreSent down.simps(1) down.simps(2) nat.exhaust varsOnCat)
      then show "?P (Suc n) "
      apply(-,cut_tac a1,simp )
      by (metis (lifting) b1)
  qed

lemma subByStatement1:
  assumes a1:"  x\<noteq> x' "
  shows "wellformedAssgnList (statement2Assigns ((parallel ( x', e) S)) ) \<longrightarrow>

  substFormByStatement (eqn (IVar  x) (Const n)) (parallel ( x', e) S)=  substFormByStatement  (eqn (IVar x) (Const n)) S"
  (is "?P S")
  (*proof( induct_tac S)
    fix prod
    let ?S="assign prod"
    show "?P ?S"*)

  apply(unfold substFormByStatement_def,simp)
  apply( induct_tac S)
  apply(cut_tac a1,unfold wellformedAssgnList_def, simp,auto)
  done

(*lemma subByStatement2[simp]:
  assumes a1:" x' \<notin> varOfForm f "
  shows "  substFormByStatement f (parallel ( x', e) S)=  substFormByStatement  f S"
  (is "?P S")
  sorry*)

lemma downNIsNotEmpty:
  "\<exists> j xs. down N= j#xs" (is "?P N")
  proof(induct_tac N,auto)
qed

lemma ForallSentForm [simp]:
  shows a1:" (statement2Assigns (forallSent (down N)
                                                              (\<lambda>i. assign
                                                                (Para n i, e' i))))=map (\<lambda>i. (Para n i, e' i)) (down N)" (is "?P N")
proof(induct_tac N)
  show "?P 0"
    apply simp
    done
next
  fix N
  assume b1:"?P N"
  show "?P (Suc N )"
  proof(cut_tac b1, simp)
    have b2:"\<exists> j xs. down N= j#xs"
      by (metis downNIsNotEmpty)
  then obtain j xs where b2:"down N=j#xs" by blast
    show"  statement2Assigns (forallSent (Suc N # down N) (\<lambda>i. assign (Para n i, e' i))) = (Para n (Suc N), e' (Suc N)) # map (\<lambda>i. (Para n i, e' i)) (down N)"
      apply(cut_tac b1 b2,simp)
      done
  qed
qed

lemma valOfLemma[simp]: "i \<le> N \<longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=e i"
  apply(induct_tac N)
  apply simp
  apply auto
done

lemma valOfLemma1Aux[simp]: "i > N \<longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=  IVar (Para v i)"
  apply(induct_tac N)
  apply simp
  apply auto
done

lemma valOfLemma1[simp,intro]: "i > N \<Longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=  IVar (Para v i)"
  by (metis (lifting) valOfLemma1Aux)

lemma valOfLemma2Aux[simp]: "(var' \<notin> set (map fst xs)) \<longrightarrow> (valOf xs (var'))=IVar var'"
  apply(induct_tac xs)
  apply simp
  apply auto
done

lemma valOfLemma2[simp,intro]: "(var' \<notin> set (map fst xs)) \<Longrightarrow> (valOf xs (var'))=IVar var'"
by (metis (lifting) valOfLemma2Aux)

lemma valOfLemma3 [simp]:"(\<forall> i.  var' \<noteq> Para v i) \<Longrightarrow>  (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) var')=IVar var'"
apply(rule valOfLemma2)
apply(induction N)
by auto

lemma valOfLemma4Aux :"v \<notin> set (map fst   (statement2Assigns S)) \<longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S')) v"
    proof(induct_tac S,auto)qed

lemma valOfLemma4 [simp,intro]:"v \<notin> set (map fst   (statement2Assigns S)) \<Longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S')) v"
by (metis valOfLemma4Aux)

lemma valOfLemma5Aux :"( valOf (statement2Assigns   S ) v=IVar v) \<and>    ( valOf (statement2Assigns S') v=IVar v)\<longrightarrow>( valOf (statement2Assigns  (cat S S')) v=IVar v) "
    proof(induct_tac S,auto)qed

lemma valOfLemma5 [simp,intro]:"( valOf (statement2Assigns   S ) v=IVar v) \<and>    ( valOf (statement2Assigns S') v=IVar v)  \<Longrightarrow> ( valOf (statement2Assigns  (cat S S')) v=IVar v) "
  by(metis  valOfLemma5Aux)

lemma valOfLemma6Aux :"( valOf (statement2Assigns   S ) v=IVar v) \<and>    ( valOf (statement2Assigns S') v=IVar v)\<longrightarrow>( valOf (statement2Assigns  (cat S S')) v=IVar v) "
    proof(induct_tac S,auto)qed

lemma varsOfNot [simp,dest!]:"v \<notin> set (map fst   (statement2Assigns S)) \<Longrightarrow>v \<in>set( map fst (statement2Assigns  (cat S S'))) = (v \<in> set (map fst   (statement2Assigns S'))) "
by (metis Un_iff varsOfSent1 varsOnCat)

(*lemma valOfLemma4 [simp]:"i\<noteq>j \<Longrightarrow>  (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) var')=IVar var'"
apply(rule valOfLemma2)
(statement2Assigns ((parallel ( x', e) S)) )
apply(induction N)
by auto*)
primrec andList::"formula list \<Rightarrow> formula" where
"andList [] = chaos" |
"andList (frm#frms) = andForm frm (andList frms)"

lemma andList2Aux:
   shows "formEval (neg frm) s \<longrightarrow> frm \<in>set frms \<longrightarrow> formEval (neg (andList frms)) s"
   proof(induct_tac frms,auto)qed

lemma andList2:
   shows "formEval (neg frm) s \<Longrightarrow> frm \<in>set frms \<Longrightarrow> formEval (neg (andList frms)) s"
   by (metis andList2Aux)

lemma andList1Aux:
   shows "formEval ( (andList frms)) s  \<longrightarrow> frm \<in>set frms \<longrightarrow> formEval ( frm) s "
   proof(induct_tac frms,auto)qed

lemma andList1:
   shows "formEval ( (andList frms)) s  \<Longrightarrow>  frm \<in>set frms \<Longrightarrow> formEval ( frm) s "
    by (metis andList1Aux)
lemma resAux1:
  assumes   b:"formEval frm s" and c:"formEval (neg (andList (frm#frms))) s"
  shows"formEval (neg (andList frms)) s"
  apply(cut_tac b c)
  apply auto
  done

lemma noEffectSubstAux:

  shows " (  (varOfExp e \<inter>  (varOfSent S) ={}) \<longrightarrow>(substExpByStatement e S)  =e) \<and>
           (  (varOfForm f \<inter>  (varOfSent S) ={} )\<longrightarrow> (substFormByStatement f S)  =  f )"

    (is "(( ?condOne e S\<longrightarrow> ?LHS e S=?RHS e S)\<and> (?condOnf f S\<longrightarrow> ?LHS1 f S=?RHS1 f S))")
  proof(induct_tac e and f)
      fix v
      let ?e="(IVar v)"
      show  "?condOne ?e S\<longrightarrow>?LHS ?e S=?RHS ?e S"
      proof(induct_tac S)
        fix prod
        let ?S="assign prod"
        show "?condOne ?e ?S \<longrightarrow>?LHS ?e ?S=?RHS ?e ?S"

        apply(unfold  substExpByStatement_def trans_def,auto)
        done
    next
       fix prod S
       let ?S="parallel prod S"
       assume b1:"?condOne ?e S \<longrightarrow>?LHS ?e S=?RHS ?e S"

       show "?condOne ?e ?S \<longrightarrow> ?LHS ?e ?S=?RHS ?e ?S"

       proof(unfold  substExpByStatement_def trans_def,
       case_tac "fst prod =v",force)
       assume d1:"fst prod \<noteq> v "
       show "varOfExp (IVar v) \<inter> varOfSent (parallel prod S) = {} \<longrightarrow> (substExp (IVar v) (statement2Assigns (parallel prod S))) =
               (IVar v)"
       proof(cut_tac d1,simp,case_tac "(varOfExp ?e) \<inter>  set (map fst (statement2Assigns S) )={}")
        assume e1:"(varOfExp ?e) \<inter>  set (map fst (statement2Assigns S) )={}"
        have f1:"v \<notin> fst ` set (statement2Assigns S)"
        apply(cut_tac e1,simp)
        done
        have f2:" expEval ?e s  =  expEval ?e (transAux (statement2Assigns S) s)"
          apply(cut_tac e1)
          by (metis (no_types) noEffectOnExpAux)

        show " v \<notin> varOfSent S \<longrightarrow> valOf (statement2Assigns S) v = IVar v"
          by (metis valOfLemma2 varsOfSent1)

        next
        assume  e1:"(varOfExp ?e) \<inter>  set (map fst (statement2Assigns S) )\<noteq>{}"
        have f1:"v \<in> fst ` set (statement2Assigns S)"
        apply(cut_tac e1,simp)
        done
      show " v \<notin> varOfSent S \<longrightarrow> valOf (statement2Assigns S) v = IVar v"
          by (metis valOfLemma2Aux varsOfSent1)

      qed
    qed
  qed
next
  fix n
  let ?e="(Const n)"
      show  "?condOne ?e S \<longrightarrow>?LHS ?e S=?RHS ?e S"
      apply( simp)
      done
next
  fix f e1 e2
  assume a1:" (?condOnf f S \<longrightarrow> ?LHS1 f S=?RHS1 f S)" and
  a2:"?condOne e1 S \<longrightarrow>?LHS e1 S=?RHS e1 S" and a3:"?condOne e2 S \<longrightarrow>?LHS e2 S=?RHS e2 S"
  let ?e="iteForm f e1 e2"
  show "?condOne ?e S \<longrightarrow>?LHS ?e S=?RHS ?e S"
  proof(rule impI)
  assume b1:"?condOne ?e S"
  have c1:"?condOnf f S "
  apply(cut_tac b1,simp)
  by (metis bot_eq_sup_iff inf_sup_distrib2)
  have c2:"?condOne e1 S "
   apply(cut_tac b1,simp)
   by (metis c1 inf_bot_right inf_sup_absorb inf_sup_distrib2 sup_bot.left_neutral)
  have c3:"?condOne e2 S "
   apply(cut_tac b1,simp)
   by (metis c1 inf_bot_right inf_sup_absorb inf_sup_distrib2 sup_bot.left_neutral)
 with c1 c2 c3 a1 a2 a3
 show "?LHS ?e S=?RHS ?e S"
 by (metis substExpByStatement_def substExpite substFormByStatement_def)
 qed

next
  fix e1 e2

  assume a1:"?condOne e1 S \<longrightarrow>?LHS e1 S=?RHS e1 S" and a2:"?condOne e2 S \<longrightarrow>?LHS e2 S=?RHS e2 S"
  let ?f="eqn e1 e2"

  show "(?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOne e1 S"
  apply(cut_tac b1,simp)
  by (metis Int_Un_distrib2 sup_eq_bot_iff)
  have c2:"?condOne e2 S"
  apply(cut_tac b1,simp)
   by (metis Int_Un_distrib2 sup_eq_bot_iff)
   with a1 a2 c1 c2
   show "?LHS1 ?f S=?RHS1 ?f S"
   by (metis substExpByStatement_def substExp_substForm.simps(4) substFormByStatement_def)
   qed
next
  fix f1 f2
  assume a1:" (?condOnf f1 S \<longrightarrow> ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" (?condOnf f2 S \<longrightarrow> ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="andForm f1 f2"

  show "(?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOnf f1 S"
  apply(cut_tac b1,simp)
  by (metis Int_assoc inf_bot_right inf_sup_absorb)
   have c2:"?condOnf f2  S"
  apply(cut_tac b1,simp)
  by (metis Int_Un_distrib2 c1 sup_bot_left)
  with a1 a2 c1 c2
   show "?LHS1 ?f S=?RHS1 ?f S"
   by (metis substExp_substForm.simps(5) substFormByStatement_def)
   qed
next
  fix f1
  assume a1:" (?condOnf f1 S \<longrightarrow> ?LHS1 f1 S=?RHS1 f1 S)"
  let ?f="neg f1"
  show "( ?condOnf ?f S \<longrightarrow>?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOnf f1 S"
  by(cut_tac b1,simp)

   with a1 c1
   show "?LHS1 ?f S=?RHS1 ?f S"
   by (metis substExp_substForm.simps(6) substFormByStatement_def)
   qed

next
  fix f1 f2
  assume a1:" (?condOnf f1 S \<longrightarrow> ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" (?condOnf f2 S \<longrightarrow> ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="implyForm f1 f2"

  show "(?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOnf f1 S"
  apply(cut_tac b1,simp)
  by (metis Int_assoc inf_bot_right inf_sup_absorb)
   have c2:"?condOnf f2  S"
  apply(cut_tac b1,simp)
  by (metis Int_Un_distrib2 c1 sup_bot_left)
  with a1 a2 c1 c2
   show "?LHS1 ?f S=?RHS1 ?f S"
   by (metis substExp_substForm.simps(8) substFormByStatement_def)

  qed

next
  let ?f="chaos"
  show "( ?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  by auto
next
  next
  fix f1 f2
  assume a1:" (?condOnf f1 S \<longrightarrow> ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" (?condOnf f2 S \<longrightarrow> ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="orForm f1 f2"

  show "(?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOnf f1 S"
  apply(cut_tac b1,simp)
  by (metis Int_assoc inf_bot_right inf_sup_absorb)
   have c2:"?condOnf f2  S"
  apply(cut_tac b1,simp)
  by (metis Int_Un_distrib2 c1 sup_bot_left)
  with a1 a2 c1 c2
   show "?LHS1 ?f S=?RHS1 ?f S"
   by (metis substExp_substForm.simps(7) substFormByStatement_def)

  qed
qed

lemma noEffectSubstExp [intro!]:

  shows " (  (varOfExp e \<inter>  (varOfSent S) ={}) \<Longrightarrow>(substExpByStatement e S)  =e) "
by (metis noEffectSubstAux)

lemma noEffectSubstForm [intro!]:

  shows "
             (varOfForm f \<inter>  (varOfSent S) ={}) \<Longrightarrow> (substFormByStatement f S)  =  f "
 by (metis noEffectSubstAux)

 lemma noEffectValOfStatementAux[intro]:
  shows "( v \<notin>  (varOfSent S) )\<longrightarrow> valOf (statement2Assigns  S)  v=IVar v" (is "?P N")
 proof(induct_tac S,auto)qed

  lemma noEffectValOfStatement[simp,intro]:
  assumes "( v \<notin>  (varOfSent S)) "
  shows   "valOf (statement2Assigns  S)  v=IVar v" (is "?P N")
by (metis assms valOfLemma2Aux varsOfSent1)

 lemma noEffectValOfForallStatementAux[intro]:
  shows "( \<forall>i. (i\<le>N \<longrightarrow>v \<notin>  (varOfSent (ps i)) ))\<longrightarrow> valOf (statement2Assigns  (forallSent (down N) ps)) v=IVar v" (is "?P N")
  proof(induct_tac N)
    show "?P 0"
      apply simp
      done
   next
    fix N
    assume b1:"?P N"
    show "?P (Suc N)"
     apply simp
      apply(cut_tac b1,rule impI)
      by (metis cache.moreSent downNIsNotEmpty le_Suc_eq valOfLemma4 varsOfSent1)

 qed
 lemma noEffectValOfForallStatement[simp,intro]:
  shows "( \<forall>i. (i\<le>N \<longrightarrow>v \<notin>  (varOfSent (ps i))) ) \<Longrightarrow>  valOf (statement2Assigns  (forallSent (down N) ps)) v=IVar v"
  by(metis noEffectValOfForallStatementAux)

 lemma noEffectValOfForallStatement1[simp,intro]:
  shows "( \<forall>i. (i\<le>N \<longrightarrow>v \<notin>  (varOfSent (ps i))) ) \<Longrightarrow>  expEval ( valOf (statement2Assigns  (forallSent (down N) ps)) v) s=s  v"
by (metis expEval_formEval.simps(1) noEffectValOfForallStatement)

lemma valOfLemma7Aux [simp,intro]:"v \<notin> varOfSent S \<longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S')) v"
proof(induct_tac S,auto)qed

lemma valOfLemma7 [simp,intro]:"v \<notin> varOfSent S \<Longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S')) v"
by(metis valOfLemma7Aux)

lemma valOf8Aux:
 "i \<le>N \<longrightarrow> (valOf (statement2Assigns  (forallSent (down N)  (\<lambda>i. assign (Para v i, e i)))) (Para v i)) =   (  e i) " (is "?P N")
proof(induct_tac N)
  show "?P 0"
  by(simp)
  next
    fix N
    assume b1:"?P N"
    show "?P (Suc N)"
    by (metis ForallSentForm valOfLemma)
 qed

 lemma valOf81[simp,intro]: "i \<le>N \<Longrightarrow> (valOf (statement2Assigns  (forallSent (down N)  (\<lambda>i. assign (Para v i, e i)))) (Para v i)) =  (  e i) "
 by (metis ForallSentForm valOfLemma)

 lemma valOfLemma10Aux [simp,intro]:"v \<in> set (map fst   (statement2Assigns S)) \<longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S)) v"
  proof(induct_tac S,auto)qed

 lemma valOfLemma10 [simp,intro]:"v \<in> set (map fst   (statement2Assigns S)) \<Longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S)) v"
by (metis valOfLemma10Aux)

lemma paraVarsAux:"  i \<le>N\<longrightarrow>Para v i \<in> set (map fst (statement2Assigns (forallSent (down N) (\<lambda>i. assign (Para v i, e i))))) " (is "?P N")
proof(induct_tac N)
  show "?P 0" by auto
next
  fix N
  assume a1:"?P N"
  show "?P (Suc N)"
  proof
    assume b1:"i \<le> Suc N"
    show "Para v i \<in> set (map fst (statement2Assigns (forallSent (down (Suc N)) (\<lambda>i. assign (Para v i, e i)))))"
    proof -
      have b2:"\<exists> j xs. down N= j#xs"
        by (metis downNIsNotEmpty)
        then obtain j xs where b2:"down N=j#xs" by blast

        show "Para v i \<in> set (map fst (statement2Assigns (forallSent (down (Suc N)) (\<lambda>i. assign (Para v i, e i)))))"
          apply(cut_tac a1 b1 b2 ,auto)

          done
      qed
    qed
qed

lemma paraVars[simp,intro]:"  i \<le>N\<Longrightarrow> Para v i \<in> set (map fst (statement2Assigns (forallSent (down N) (\<lambda>i. assign (Para v i, e i))))) "
by (metis paraVarsAux)

 lemma valOf9[simp,intro]:
 assumes a1:"i \<le>N"
 shows " expEval (valOf (statement2Assigns (cat (forallSent (down N)  (\<lambda>i. assign (Para v i, e i))) S)) (Para v i) ) s=  expEval (  e i) s"
 proof -
   have " valOf (statement2Assigns  (cat (forallSent (down N)  (\<lambda>i. assign (Para v i, e i))) S))  (Para v i) =
   ( valOf (statement2Assigns (forallSent (down N)  (\<lambda>i. assign (Para v i, e i)))))  (Para v i)"
   proof(rule valOfLemma10, rule paraVars,cut_tac a1,simp)qed
   then  show "expEval (valOf (statement2Assigns (cat (forallSent (down N)  (\<lambda>i. assign (Para v i, e i))) S)) (Para v i) ) s=  expEval (  e i) s"
   by (metis ForallSentForm assms valOfLemma)
 qed
  end


(*  File:       Pass_Module.thy
    Copyright   2021  Karlsruhe Institute of Technology (KIT)
*)
\<^marker>\<open>creator "Karsten Diekhoff, Karlsruhe Institute of Technology (KIT)"\<close>
\<^marker>\<open>contributor "Jonas Kraemer, Karlsruhe Institute of Technology (KIT)"\<close>
\<^marker>\<open>contributor "Michael Kirsten, Karlsruhe Institute of Technology (KIT)"\<close>

section \<open>Pass Module\<close>

theory Pass_Module
  imports "Component_Types/Electoral_Module"
begin

text
\<open>This is a family of electoral modules. For a natural number n and a
lexicon (linear order) r of all alternatives, the according pass module
defers the lexicographically first n alternatives (from A) and rejects
the rest. It is primarily used as counterpart to the drop module in a
parallel composition in order to segment the alternatives into two groups.\<close>

subsection \<open>Definition\<close>

fun pass_module :: "nat \<Rightarrow> 'a Preference_Relation \<Rightarrow> 'a Electoral_Module" where
  "pass_module n r A p vs =
    ({},
    {a \<in> A. card(above (limit A r) a) > n},
    {a \<in> A. card(above (limit A r) a) \<le> n})"

subsection \<open>Soundness\<close>

theorem pass_mod_sound[simp]:
  assumes order: "linear_order r"
  shows "electoral_module (pass_module n r)"
proof -
  let ?mod = "pass_module n r"
  have
    "\<forall> A p. finite_profile A p \<longrightarrow>
          (\<forall>a \<in> A. a \<in> {x \<in> A. card(above (limit A r) x) > n} \<or>
                   a \<in> {x \<in> A. card(above (limit A r) x) \<le> n})"
    using CollectI not_less
    by metis
  hence
    "\<forall> A p. finite_profile A p \<longrightarrow>
          {a \<in> A. card(above (limit A r) a) > n} \<union>
          {a \<in> A. card(above (limit A r) a) \<le> n} = A"
    by blast
  hence 0:
    "\<forall> A p vs. finite_profile A p \<and> finite_pair_vectors A vs \<longrightarrow>
    set_equals_partition A (pass_module n r A p vs)"
    by auto
  have
    "\<forall> A p. finite_profile A p \<longrightarrow>
      (\<forall>a \<in> A. \<not>(a \<in> {x \<in> A. card(above (limit A r) x) > n} \<and>
                 a \<in> {x \<in> A. card(above (limit A r) x) \<le> n}))"
    by auto
  hence
    "\<forall> A p. finite_profile A p \<longrightarrow>
      {a \<in> A. card(above (limit A r) a) > n} \<inter>
      {a \<in> A. card(above (limit A r) a) \<le> n} = {}"
    by blast
  hence 1:
    "\<forall> A p vs. finite_profile A p \<and> finite_pair_vectors A vs \<longrightarrow> disjoint3 (?mod A p vs)"
    by auto
  from 0 1
  have
    "\<forall> A p vs. finite_profile A p  \<and> finite_pair_vectors A vs \<longrightarrow> well_formed A (?mod A p vs)"
    by auto
  hence
    "\<forall> A p vs. finite_profile A p  \<and> finite_pair_vectors A vs \<longrightarrow> well_formed A (?mod A p vs)"
    by simp
  thus ?thesis
    using electoral_modI
    by metis
qed

subsection \<open>Non-Blocking\<close>

(*The pass module is non-blocking.*)
theorem pass_mod_non_blocking[simp]:
  assumes order: "linear_order r" and
          g0_n:  "n > 0"
        shows "non_blocking (pass_module n r)"
  unfolding non_blocking_def
proof (safe, simp_all)
  show "electoral_module (pass_module n r)"
    using pass_mod_sound order
    by simp
next
  fix
    A :: "'a set" and
    p :: "'a Profile" and
    vs :: "'a Pair_Vectors" and
    x :: "'a"
  assume
    fin_A: "finite A" and
    prof_A: "profile A p" and
    card_A:
    "{a \<in> A. n <
      card (above
        {(a, b). (a, b) \<in> r \<and>
          a \<in> A \<and> b \<in> A} a)} = A" and
    x_in_A: "x \<in> A"
  have lin_ord_A:
    "linear_order_on A (limit A r)"
    using limit_presv_lin_ord order top_greatest
    by metis
  have
    "\<exists>a\<in>A. above (limit A r) a = {a} \<and>
      (\<forall>x\<in>A. above (limit A r) x = {x} \<longrightarrow> x = a)"
    using above_one fin_A lin_ord_A x_in_A
    by blast
  hence not_all:
    "{a \<in> A. card(above (limit A r) a) > n} \<noteq> A"
    using One_nat_def Suc_leI assms(2) is_singletonI
          is_singleton_altdef leD mem_Collect_eq
    by (metis (no_types, lifting))
  hence "reject (pass_module n r) A p vs \<noteq> A"
    by simp
  thus "False"
    using order card_A
    by simp
qed

subsection \<open>Non-Electing\<close>

(*The pass module is non-electing.*)
theorem pass_mod_non_electing[simp]:
  assumes order: "linear_order r"
  shows "non_electing (pass_module n r)"
  by (simp add: non_electing_def order)

subsection \<open>Properties\<close>

(*The pass module is strictly defer-monotone.*)
theorem pass_mod_dl_inv[simp]:
  assumes order: "linear_order r"
  shows "defer_lift_invariance (pass_module n r)"
  by (simp add: order defer_lift_invariance_def)

theorem pass_zero_mod_def_zero[simp]:
  assumes order: "linear_order r"
  shows "defers 0 (pass_module 0 r )"
  unfolding defers_def
proof (safe)
  show "electoral_module (pass_module 0 r)"
    using pass_mod_sound order
    by simp
next
  fix
    A :: "'a set" and
    p :: "'a Profile" and
    vs :: "'a Pair_Vectors"
  assume
    card_pos: "0 \<le> card A" and
    finite_A: "finite A" and
    prof_A: "profile A p"
  show
    "card (defer (pass_module 0 r) A p vs) = 0"
  proof -
    have lin_ord_on_A:
      "linear_order_on A (limit A r)"
      using order limit_presv_lin_ord
      by blast
    have f1: "connex A (limit A r)"
      using lin_ord_imp_connex lin_ord_on_A
      by simp
    obtain aa :: "('a \<Rightarrow> bool) \<Rightarrow> 'a" where
      f2:
      "\<forall>p. (Collect p = {} \<longrightarrow> (\<forall>a. \<not> p a)) \<and>
            (Collect p \<noteq> {} \<longrightarrow> p (aa p))"
      by moura
    have "\<forall>n. \<not> (n::nat) \<le> 0 \<or> n = 0"
      by blast
    hence
      "\<forall>a Aa. \<not> connex Aa (limit A r) \<or> a \<notin> Aa \<or> a \<notin> A \<or>
                  \<not> card (above (limit A r) a) \<le> 0"
      using above_connex above_presv_limit card_eq_0_iff
            equals0D finite_A order rev_finite_subset
      by (metis (no_types))
    hence "{a \<in> A. card(above (limit A r) a) \<le> 0} = {}"
      using f1
      by auto
    hence "card {a \<in> A. card(above (limit A r) a) \<le> 0} = 0"
      using card.empty
      by metis
    thus "card (defer (pass_module 0 r) A p vs) = 0"
      by simp
  qed
qed

(*
   For any natural number n and any linear order, the according pass module
   defers n alternatives (if there are n alternatives).
   NOTE: The induction proof is still missing. Following are the proofs for
   n=1 and n=2.
*)
theorem pass_one_mod_def_one[simp]:
  assumes order: "linear_order r"
  shows "defers 1 (pass_module 1 r)"
  unfolding defers_def
proof (safe)
  show "electoral_module (pass_module 1 r)"
    using pass_mod_sound order
    by simp
next
  fix
    A :: "'a set" and
    p :: "'a Profile" and
    vs :: "'a Pair_Vectors"
  assume
    card_pos: "1 \<le> card A" and
    finite_A: "finite A" and
    prof_A: "profile A p"
  show
    "card (defer (pass_module 1 r) A p vs) = 1"
  proof -
    have "A \<noteq> {}"
      using card_pos
      by auto
    moreover have lin_ord_on_A:
      "linear_order_on A (limit A r)"
      using order limit_presv_lin_ord
      by blast
    ultimately have winner_exists:
      "\<exists>a\<in>A. above (limit A r) a = {a} \<and>
        (\<forall>x\<in>A. above (limit A r) x = {x} \<longrightarrow> x = a)"
      using finite_A
      by (simp add: above_one)
    then obtain w where w_unique_top:
      "above (limit A r) w = {w} \<and>
        (\<forall>x\<in>A. above (limit A r) x = {x} \<longrightarrow> x = w)"
      using above_one
      by auto
    hence "{a \<in> A. card(above (limit A r) a) \<le> 1} = {w}"
    proof
      assume
        w_top: "above (limit A r) w = {w}" and
        w_unique: "\<forall>x\<in>A. above (limit A r) x = {x} \<longrightarrow> x = w"
      have "card (above (limit A r) w) \<le> 1"
        using w_top
        by auto
      hence "{w} \<subseteq> {a \<in> A. card(above (limit A r) a) \<le> 1}"
        using winner_exists w_unique_top
        by blast
      moreover have
        "{a \<in> A. card(above (limit A r) a) \<le> 1} \<subseteq> {w}"
      proof
        fix
          x :: "'a"
        assume x_in_winner_set:
          "x \<in> {a \<in> A. card (above (limit A r) a) \<le> 1}"
        hence x_in_A: "x \<in> A"
          by auto
        hence connex_limit:
          "connex A (limit A r)"
          using lin_ord_imp_connex lin_ord_on_A
          by simp
        hence "let q = limit A r in x \<preceq>\<^sub>q x"
          using connex_limit above_connex
                pref_imp_in_above x_in_A
          by metis
        hence "(x,x) \<in> limit A r"
          by simp
        hence x_above_x: "x \<in> above (limit A r) x"
          by (simp add: above_def)
        have "above (limit A r) x \<subseteq> A"
          using above_presv_limit order
          by fastforce
        hence above_finite: "finite (above (limit A r) x)"
          by (simp add: finite_A finite_subset)
        have "card (above (limit A r) x) \<le> 1"
          using x_in_winner_set
          by simp
        moreover have
          "card (above (limit A r) x) \<ge> 1"
          using One_nat_def Suc_leI above_finite card_eq_0_iff
                equals0D neq0_conv x_above_x
          by metis
        ultimately have
          "card (above (limit A r) x) = 1"
          by simp
        hence "{x} = above (limit A r) x"
          using is_singletonE is_singleton_altdef singletonD x_above_x
          by metis
        hence "x = w"
          using w_unique
          by (simp add: x_in_A)
        thus "x \<in> {w}"
          by simp
      qed
      ultimately have
        "{w} = {a \<in> A. card (above (limit A r) a) \<le> 1}"
        by auto
      thus ?thesis
        by simp
    qed
    hence "defer (pass_module 1 r) A p vs = {w}"
      by simp
    thus "card (defer (pass_module 1 r) A p vs) = 1"
      by simp
  qed
qed

theorem pass_two_mod_def_two:
  assumes order: "linear_order r"
  shows "defers 2 (pass_module 2 r)"
  unfolding defers_def
proof (safe)
  show "electoral_module (pass_module 2 r)"
    using order
    by simp
next
  fix
    A :: "'a set" and
    p :: "'a Profile" and
    vs :: "'a Pair_Vectors"
  assume
    min_2_card: "2 \<le> card A" and
    finA: "finite A" and
    profA: "profile A p"
  from min_2_card
  have not_empty_A: "A \<noteq> {}"
    by auto
  moreover have limitA_order:
    "linear_order_on A (limit A r)"
    using limit_presv_lin_ord order
    by auto
  ultimately obtain a where
    a: "above (limit A r) a = {a}"
    using above_one min_2_card finA profA
    by blast
  hence "\<forall>b \<in> A. let q = limit A r in (b \<preceq>\<^sub>q a)"
    using limitA_order pref_imp_in_above empty_iff
          insert_iff insert_subset above_presv_limit
          order connex_def lin_ord_imp_connex
    by metis
  hence a_best: "\<forall>b \<in> A. (b, a) \<in> limit A r"
    by simp
  hence a_above: "\<forall>b \<in> A. a \<in> above (limit A r) b"
    by (simp add: above_def)
  from a have "a \<in> {a \<in> A. card(above (limit A r) a) \<le> 2}"
    using CollectI Suc_leI not_empty_A a_above card_UNIV_bool
          card_eq_0_iff card_insert_disjoint empty_iff finA
          finite.emptyI insert_iff limitA_order above_one
          UNIV_bool nat.simps(3) zero_less_Suc
    by (metis (no_types, lifting))
  hence a_in_defer: "a \<in> defer (pass_module 2 r) A p vs"
    by simp
  have "finite (A-{a})"
    by (simp add: finA)
  moreover have A_not_only_a: "A-{a} \<noteq> {}"
    using min_2_card Diff_empty Diff_idemp Diff_insert0
          One_nat_def not_empty_A card.insert_remove
          card_eq_0_iff finite.emptyI insert_Diff
          numeral_le_one_iff semiring_norm(69) card.empty
    by metis
  moreover have limitAa_order:
    "linear_order_on (A-{a}) (limit (A-{a}) r)"
    using limit_presv_lin_ord order top_greatest
    by blast
  ultimately obtain b where b: "above (limit (A-{a}) r) b = {b}"
    using above_one
    by metis
  hence "\<forall>c \<in> A-{a}. let q = limit (A-{a}) r in (c \<preceq>\<^sub>q b)"
    using limitAa_order pref_imp_in_above empty_iff insert_iff
          insert_subset above_presv_limit order connex_def
          lin_ord_imp_connex
    by metis
  hence b_in_limit: "\<forall>c \<in> A-{a}. (c, b) \<in> limit (A-{a}) r"
    by simp
  hence b_best: "\<forall>c \<in> A-{a}. (c, b) \<in> limit A r"
    by auto
  hence c_not_above_b: "\<forall>c \<in> A-{a, b}. c \<notin> above (limit A r) b"
    using b Diff_iff Diff_insert2 subset_UNIV above_presv_limit
          insert_subset order limit_presv_above limit_presv_above2
    by metis
  moreover have above_subset: "above (limit A r) b \<subseteq> A"
    using above_presv_limit order
    by metis
  moreover have b_above_b: "b \<in> above (limit A r) b"
    using above_def b b_best above_presv_limit
          mem_Collect_eq order insert_subset
    by metis
  ultimately have above_b_eq_ab: "above (limit A r) b = {a, b}"
    using a_above
    by auto
  hence card_above_b_eq_2: "card (above (limit A r) b) = 2"
    using A_not_only_a b_in_limit
    by auto
  hence b_in_defer: "b \<in> defer (pass_module 2 r) A p vs"
    using b_above_b above_subset
    by auto
  from b_best have b_above:
    "\<forall>c \<in> A-{a}. b \<in> above (limit A r) c"
    using above_def mem_Collect_eq
    by metis
  have "connex A (limit A r)"
    using limitA_order lin_ord_imp_connex
    by auto
  hence "\<forall>c \<in> A. c \<in> above (limit A r) c"
    by (simp add: above_connex)
  hence "\<forall>c \<in> A-{a, b}. {a, b, c} \<subseteq> above (limit A r) c"
    using a_above b_above
    by auto
  moreover have "\<forall>c \<in> A-{a, b}. card{a, b, c} = 3"
    using DiffE One_nat_def Suc_1 above_b_eq_ab card_above_b_eq_2
          above_subset card_insert_disjoint finA finite_subset
          insert_commute numeral_3_eq_3
    by metis
  ultimately have
    "\<forall>c \<in> A-{a, b}. card (above (limit A r) c) \<ge> 3"
    using card_mono finA finite_subset above_presv_limit order
    by metis
  hence "\<forall>c \<in> A-{a, b}. card (above (limit A r) c) > 2"
    using less_le_trans numeral_less_iff order_refl semiring_norm(79)
    by metis
  hence "\<forall>c \<in> A-{a, b}. c \<notin> defer (pass_module 2 r) A p vs"
    by (simp add: not_le)
  moreover have "defer (pass_module 2 r) A p vs \<subseteq> A"
    by auto
  ultimately have "defer (pass_module 2 r) A p vs \<subseteq> {a, b}"
    by blast
  with a_in_defer b_in_defer have
    "defer (pass_module 2 r) A p vs = {a, b}"
    by fastforce
  thus "card (defer (pass_module 2 r) A p vs) = 2"
    using above_b_eq_ab card_above_b_eq_2
    by presburger
qed

end


(*  Title:      ZF/AC/AC18_AC19.thy
    Author:     Krzysztof Grabczewski

The proof of AC1 ==> AC18 ==> AC19 ==> AC1
*)

theory AC18_AC19
imports AC_Equiv
begin

definition
  uu    :: "i => i" where
    "uu(a) == {c \<union> {0}. c \<in> a}"

(* ********************************************************************** *)
(* AC1 ==> AC18                                                           *)
(* ********************************************************************** *)

lemma PROD_subsets:
     "[| f \<in> (\<Pi> b \<in> {P(a). a \<in> A}. b);  \<forall>a \<in> A. P(a)<=Q(a) |]
      ==> (\<lambda>a \<in> A. f`P(a)) \<in> (\<Pi> a \<in> A. Q(a))"
by (rule lam_type, drule apply_type, auto)

lemma lemma_AC18:
     "[| \<forall>A. 0 \<notin> A \<longrightarrow> (\<exists>f. f \<in> (\<Pi> X \<in> A. X)); A \<noteq> 0 |]
      ==> (\<Inter>a \<in> A. \<Union>b \<in> B(a). X(a, b)) \<subseteq>
          (\<Union>f \<in> \<Pi> a \<in> A. B(a). \<Inter>a \<in> A. X(a, f`a))"
apply (rule subsetI)
apply (erule_tac x = "{{b \<in> B (a) . x \<in> X (a,b) }. a \<in> A}" in allE)
apply (erule impE, fast)
apply (erule exE)
apply (rule UN_I)
 apply (fast elim!: PROD_subsets)
apply (simp, fast elim!: not_emptyE dest: apply_type [OF _ RepFunI])
done

lemma AC1_AC18: "AC1 ==> PROP AC18"
apply (unfold AC1_def)
apply (rule AC18.intro)
apply (fast elim!: lemma_AC18 apply_type intro!: equalityI INT_I UN_I)
done

(* ********************************************************************** *)
(* AC18 ==> AC19                                                          *)
(* ********************************************************************** *)

theorem (in AC18) AC19
apply (unfold AC19_def)
apply (intro allI impI)
apply (rule AC18 [of _ "%x. x", THEN mp], blast)
done

(* ********************************************************************** *)
(* AC19 ==> AC1                                                           *)
(* ********************************************************************** *)

lemma RepRep_conj:
        "[| A \<noteq> 0; 0 \<notin> A |] ==> {uu(a). a \<in> A} \<noteq> 0 & 0 \<notin> {uu(a). a \<in> A}"
apply (unfold uu_def, auto)
apply (blast dest!: sym [THEN RepFun_eq_0_iff [THEN iffD1]])
done

lemma lemma1_1: "[|c \<in> a; x = c \<union> {0}; x \<notin> a |] ==> x - {0} \<in> a"
apply clarify
apply (rule subst_elem, assumption)
apply (fast elim: notE subst_elem)
done

lemma lemma1_2:
        "[| f`(uu(a)) \<notin> a; f \<in> (\<Pi> B \<in> {uu(a). a \<in> A}. B); a \<in> A |]
                ==> f`(uu(a))-{0} \<in> a"
apply (unfold uu_def, fast elim!: lemma1_1 dest!: apply_type)
done

lemma lemma1: "\<exists>f. f \<in> (\<Pi> B \<in> {uu(a). a \<in> A}. B) ==> \<exists>f. f \<in> (\<Pi> B \<in> A. B)"
apply (erule exE)
apply (rule_tac x = "\<lambda>a\<in>A. if (f` (uu(a)) \<in> a, f` (uu(a)), f` (uu(a))-{0})"
       in exI)
apply (rule lam_type)
apply (simp add: lemma1_2)
done

lemma lemma2_1: "a\<noteq>0 ==> 0 \<in> (\<Union>b \<in> uu(a). b)"
by (unfold uu_def, auto)

lemma lemma2: "[| A\<noteq>0; 0\<notin>A |] ==> (\<Inter>x \<in> {uu(a). a \<in> A}. \<Union>b \<in> x. b) \<noteq> 0"
apply (erule not_emptyE)
apply (rule_tac a = 0 in not_emptyI)
apply (fast intro!: lemma2_1)
done

lemma AC19_AC1: "AC19 ==> AC1"
apply (unfold AC19_def AC1_def, clarify)
apply (case_tac "A=0", force)
apply (erule_tac x = "{uu (a) . a \<in> A}" in allE)
apply (erule impE)
apply (erule RepRep_conj, assumption)
apply (rule lemma1)
apply (drule lemma2, assumption, auto)
done

end


(*  Title:       The Framework for competitive Analysis of randomized online algorithms
    Author:      Tobias Nipkow
                 Max Haslbeck
*)

section "Randomized Online and Offline Algorithms"

theory Competitive_Analysis
imports
  Prob_Theory
  On_Off
begin

subsection "Competitive Analysis Formalized"

type_synonym ('s,'is,'r,'a)alg_on_step = "('s * 'is  \<Rightarrow> 'r \<Rightarrow> ('a * 'is) pmf)"
type_synonym ('s,'is)alg_on_init = "('s \<Rightarrow> 'is pmf)"
type_synonym ('s,'is,'q,'a)alg_on_rand = "('s,'is)alg_on_init * ('s,'is,'q,'a)alg_on_step"

subsubsection "classes of algorithms"

definition deterministic_init :: "('s,'is)alg_on_init \<Rightarrow> bool" where
  "deterministic_init I \<longleftrightarrow> (\<forall>init. card( set_pmf (I init)) = 1)"

definition deterministic_step :: "('s,'is,'q,'a)alg_on_step \<Rightarrow> bool" where
  "deterministic_step S \<longleftrightarrow> (\<forall>i is q. card( set_pmf (S (i, is) q)) = 1)"

definition random_step :: "('s,'is,'q,'a)alg_on_step \<Rightarrow> bool" where
  "random_step S \<longleftrightarrow> ~ deterministic_step S"

subsubsection "Randomized Online and Offline Algorithms"

context On_Off
begin

fun steps where
  "steps s [] [] = s"
| "steps s (q#qs) (a#as) = steps (step s q a) qs as"

lemma steps_append: "length qs = length as \<Longrightarrow> steps s (qs@qs') (as@as') = steps (steps s qs as) qs' as'"
apply(induct qs as arbitrary: s rule: list_induct2)
   by simp_all

lemma T_append: "length qs = length as \<Longrightarrow> T s (qs@[q]) (as@[a]) = T s qs as + t (steps s qs as) q a"
apply(induct qs as arbitrary: s rule: list_induct2)
   by simp_all

lemma T_append2: "length qs = length as \<Longrightarrow> T s (qs@qs') (as@as') = T s qs as + T (steps s qs as) qs' as'"
apply(induct qs as arbitrary: s rule: list_induct2)
   by simp_all

abbreviation Step_rand :: "('state,'is,'request,'answer) alg_on_rand  \<Rightarrow> 'request \<Rightarrow> 'state * 'is \<Rightarrow> ('state * 'is) pmf" where
"Step_rand A r s \<equiv> bind_pmf ((snd A) s r) (\<lambda>(a,is'). return_pmf (step (fst s) r a, is'))"

fun config'_rand :: "('state,'is,'request,'answer) alg_on_rand  \<Rightarrow> ('state*'is) pmf \<Rightarrow> 'request list
    \<Rightarrow> ('state * 'is) pmf" where
"config'_rand A s []  = s" |
"config'_rand A s (r#rs) = config'_rand A (s \<bind> Step_rand A r) rs"

lemma config'_rand_snoc: "config'_rand A s (rs@[r]) = config'_rand A s rs \<bind> Step_rand A r"
apply(induct rs arbitrary: s) by(simp_all)

lemma config'_rand_append: "config'_rand A s (xs@ys) = config'_rand A (config'_rand A s xs) ys"
apply(induct xs arbitrary: s) by(simp_all)

abbreviation config_rand where
"config_rand A s0 rs == config'_rand A ((fst A s0) \<bind> (\<lambda>is. return_pmf (s0, is))) rs"

lemma config'_rand_induct: "(\<forall>x \<in> set_pmf init. P (fst x)) \<Longrightarrow> (\<And>s q a. P s \<Longrightarrow> P (step s q a))
     \<Longrightarrow> \<forall>x\<in>set_pmf (config'_rand A init qs). P (fst x)"
proof (induct qs arbitrary: init)
  case (Cons r rs)
  show ?case apply(simp)
    apply(rule Cons(1))
      apply(subst Set.ball_simps(9)[where P=P, symmetric])
      apply(subst set_map_pmf[symmetric])
      apply(simp only: map_bind_pmf)
      apply(simp add: bind_assoc_pmf bind_return_pmf split_def)
      using Cons(2,3) apply blast
      by fact
qed (simp)

lemma config_rand_induct: "P s0 \<Longrightarrow> (\<And>s q a. P s \<Longrightarrow> P (step s q a)) \<Longrightarrow> \<forall>x\<in>set_pmf (config_rand A s0 qs). P (fst x)"
using config'_rand_induct[of "((fst A s0) \<bind> (\<lambda>is. return_pmf (s0, is)))" P] by auto

fun T_on_rand' :: "('state,'is,'request,'answer) alg_on_rand \<Rightarrow> ('state*'is) pmf \<Rightarrow> 'request list \<Rightarrow>  real" where
"T_on_rand' A s [] = 0" |
"T_on_rand' A s (r#rs) = E ( s \<bind> (\<lambda>s. bind_pmf (snd A s r) (\<lambda>(a,is'). return_pmf (real (t (fst s) r a)))) )
                              + T_on_rand' A (s \<bind> Step_rand A r) rs"

lemma T_on_rand'_append: "T_on_rand' A s (xs@ys) = T_on_rand' A s xs + T_on_rand' A (config'_rand A s xs) ys"
apply(induct xs arbitrary: s) by simp_all

abbreviation T_on_rand :: "('state,'is,'request,'answer) alg_on_rand \<Rightarrow> 'state \<Rightarrow> 'request list \<Rightarrow> real" where
  "T_on_rand A s rs == T_on_rand' A (fst A s \<bind> (\<lambda>is. return_pmf (s,is))) rs"

lemma T_on_rand_append: "T_on_rand A s (xs@ys) = T_on_rand A s xs + T_on_rand' A (config_rand A s xs) ys"
by(rule T_on_rand'_append)

abbreviation "T_on_rand'_n A s0 xs n == T_on_rand' A (config'_rand A s0 (take n xs)) [xs!n]"

lemma T_on_rand'_as_sum: "T_on_rand' A s0 rs = sum (T_on_rand'_n A s0 rs) {..<length rs} "
apply(induct rs rule: rev_induct)
  by(simp_all add: T_on_rand'_append nth_append)

abbreviation "T_on_rand_n A s0 xs n == T_on_rand' A (config_rand A s0 (take n xs)) [xs!n]"

lemma T_on_rand_as_sum: "T_on_rand A s0 rs = sum (T_on_rand_n A s0 rs) {..<length rs} "
apply(induct rs rule: rev_induct)
  by(simp_all add: T_on_rand'_append  nth_append)

lemma T_on_rand'_nn: "T_on_rand' A s qs \<ge> 0"
apply(induct qs arbitrary: s)
  apply(simp_all add: bind_return_pmf)
  apply(rule add_nonneg_nonneg)
  apply(rule E_nonneg)
    by(simp_all add: split_def)

lemma T_on_rand_nn: "T_on_rand (I,S) s0 qs \<ge> 0"
by (rule T_on_rand'_nn)

definition compet_rand :: "('state,'is,'request,'answer) alg_on_rand \<Rightarrow> real \<Rightarrow> 'state set \<Rightarrow> bool" where
"compet_rand A c S0 = (\<forall>s\<in>S0. \<exists>b \<ge> 0. \<forall>rs. wf s rs \<longrightarrow> T_on_rand A s rs \<le> c * T_opt s rs + b)"

subsection "embeding of deterministic into randomized algorithms"

fun embed :: "('state,'is,'request,'answer) alg_on \<Rightarrow> ('state,'is,'request,'answer) alg_on_rand" where
"embed A = ( (\<lambda>s. return_pmf (fst A s))  ,
                  (\<lambda>s r. return_pmf (snd A s r)) )"

lemma T_deter_rand: "T_off (\<lambda>s0. (off2 A (s0, x))) s0 qs = T_on_rand' (embed A) (return_pmf (s0,x)) qs"
apply(induct qs arbitrary: s0 x)
  by(simp_all add: Step_def bind_return_pmf split: prod.split)

lemma config'_embed: "config'_rand (embed A) (return_pmf s0) qs = return_pmf (config' A s0 qs)"
apply(induct qs arbitrary: s0)
  apply(simp_all add: Step_def split_def bind_return_pmf) by metis

lemma config_embed: "config_rand (embed A) s0 qs = return_pmf (config A s0 qs)"
apply(simp add: bind_return_pmf)
  apply(subst config'_embed[unfolded embed.simps])
    by simp

lemma T_on_embed: "T_on A s0 qs = T_on_rand (embed A) s0 qs"
using T_deter_rand[where x="fst A s0", of s0 qs A] by(auto simp: bind_return_pmf)

lemma T_on'_embed: "T_on' A (s0,x) qs = T_on_rand' (embed A) (return_pmf (s0,x)) qs"
using T_deter_rand T_on_on' by metis

lemma compet_embed: "compet A c S0 = compet_rand (embed A) c S0"
unfolding compet_def compet_rand_def using T_on_embed by metis

end

end


theory Ex010
imports Main
begin

lemma "A \<or> \<not>False"
proof -
{
  assume False
}
hence "\<not>False" by (rule notI)
thus "A \<or> \<not>False" by (rule disjI2)
qed

(*prettified*)

lemma "A \<or> \<not>False"
proof -
{
  assume False
}
hence "\<not>False" ..
thus "A \<or> \<not>False" ..
qed


(*  Title:       Isabelle Collections Library
    Author:      Thomas Tuerk <tuerk@in.tum.de>
    Maintainer:  Thomas Tuerk <tuerk@in.tum.de>
*)
section \<open>\isaheader{Set Implementation by sorted Lists}\<close>
theory ListSetImpl_Sorted
imports
  "../spec/SetSpec"
  "../gen_algo/SetGA"
  "../../Lib/Sorted_List_Operations"
begin
text_raw \<open>\label{thy:ListSetImpl_Sorted}\<close>

(*@impl Set
  @type 'a::linorder lss
  @abbrv lss
  Sets implemented by sorted lists.
*)

type_synonym
  'a lss = "'a list"

subsection "Definitions"
definition lss_\<alpha> :: "'a lss \<Rightarrow> 'a set" where "lss_\<alpha> == set"
definition lss_invar :: "'a::{linorder} lss \<Rightarrow> bool" where "lss_invar l == distinct l \<and> sorted l"
definition lss_empty :: "unit \<Rightarrow> 'a lss" where "lss_empty == (\<lambda>_::unit. [])"
definition lss_memb :: "'a::{linorder} \<Rightarrow> 'a lss \<Rightarrow> bool" where "lss_memb x l == Sorted_List_Operations.memb_sorted l x"
definition lss_ins :: "'a::{linorder} \<Rightarrow> 'a lss \<Rightarrow> 'a lss" where "lss_ins x l == insertion_sort x l"
definition lss_ins_dj :: "'a::{linorder} \<Rightarrow> 'a lss \<Rightarrow> 'a lss" where "lss_ins_dj == lss_ins"

definition lss_delete :: "'a::{linorder} \<Rightarrow> 'a lss \<Rightarrow> 'a lss" where "lss_delete x l == delete_sorted x l"

definition lss_iterateoi :: "'a lss \<Rightarrow> ('a,'\<sigma>) set_iterator"
where "lss_iterateoi l = foldli l"

definition lss_reverse_iterateoi :: "'a lss \<Rightarrow> ('a,'\<sigma>) set_iterator"
where "lss_reverse_iterateoi l = foldli (rev l)"

definition lss_iteratei :: "'a lss \<Rightarrow> ('a,'\<sigma>) set_iterator"
where "lss_iteratei l = foldli l"

definition lss_isEmpty :: "'a lss \<Rightarrow> bool" where "lss_isEmpty s == s=[]"

definition lss_union :: "'a::{linorder} lss \<Rightarrow> 'a lss \<Rightarrow> 'a lss"
  where "lss_union s1 s2 == Misc.merge s1 s2"
definition lss_union_list :: "'a::{linorder} lss list \<Rightarrow> 'a lss"
  where "lss_union_list l == merge_list [] l"
definition lss_inter :: "'a::{linorder} lss \<Rightarrow> 'a lss \<Rightarrow> 'a lss"
  where "lss_inter == inter_sorted"
definition lss_union_dj :: "'a::{linorder} lss \<Rightarrow> 'a lss \<Rightarrow> 'a lss"
  where "lss_union_dj == lss_union" \<comment> \<open>Union of disjoint sets\<close>

definition lss_image_filter
  where "lss_image_filter f l =
         mergesort_remdups (List.map_filter f l)"

definition lss_filter where [code_unfold]: "lss_filter = List.filter"

definition lss_inj_image_filter
  where "lss_inj_image_filter == lss_image_filter"

definition "lss_image == iflt_image lss_image_filter"
definition "lss_inj_image == iflt_inj_image lss_inj_image_filter"

definition lss_to_list :: "'a lss \<Rightarrow> 'a list" where "lss_to_list == id"
definition list_to_lss :: "'a::{linorder} list \<Rightarrow> 'a lss" where "list_to_lss == mergesort_remdups"

subsection "Correctness"
lemmas lss_defs =
  lss_\<alpha>_def
  lss_invar_def
  lss_empty_def
  lss_memb_def
  lss_ins_def
  lss_ins_dj_def
  lss_delete_def
  lss_iteratei_def
  lss_isEmpty_def
  lss_union_def
  lss_union_list_def
  lss_inter_def
  lss_union_dj_def
  lss_image_filter_def
  lss_inj_image_filter_def
  lss_image_def
  lss_inj_image_def
  lss_to_list_def
  list_to_lss_def

lemma lss_empty_impl: "set_empty lss_\<alpha> lss_invar lss_empty"
by (unfold_locales) (auto simp add: lss_defs)

lemma lss_memb_impl: "set_memb lss_\<alpha> lss_invar lss_memb"
by (unfold_locales) (auto simp add: lss_defs memb_sorted_correct)

lemma lss_ins_impl: "set_ins lss_\<alpha> lss_invar lss_ins"
by (unfold_locales) (auto simp add: lss_defs insertion_sort_correct)

lemma lss_ins_dj_impl: "set_ins_dj lss_\<alpha> lss_invar lss_ins_dj"
by (unfold_locales) (auto simp add: lss_defs insertion_sort_correct)

lemma lss_\<alpha>_finite[simp, intro!]: "finite (lss_\<alpha> l)"
  by (auto simp add: lss_defs)

lemma lss_is_finite_set: "finite_set lss_\<alpha> lss_invar"
by (unfold_locales) (auto simp add: lss_defs)

lemma lss_iterateoi_impl: "poly_set_iterateoi lss_\<alpha> lss_invar lss_iterateoi"
proof
  fix l :: "'a::{linorder} list"
  assume invar_l: "lss_invar l"
  show "finite (lss_\<alpha> l)"
    unfolding lss_\<alpha>_def by simp

  from invar_l
  show "set_iterator_linord (lss_iterateoi l) (lss_\<alpha> l)"
    apply (rule_tac set_iterator_linord_I [of "l"])
    apply (simp_all add: lss_\<alpha>_def lss_invar_def lss_iterateoi_def)
  done
qed

lemma lss_reverse_iterateoi_impl: "poly_set_rev_iterateoi lss_\<alpha> lss_invar lss_reverse_iterateoi"
proof
  fix l :: "'a list"
  assume invar_l: "lss_invar l"
  show "finite (lss_\<alpha> l)"
    unfolding lss_\<alpha>_def by simp

  from invar_l
  show "set_iterator_rev_linord (lss_reverse_iterateoi l) (lss_\<alpha> l)"
    apply (rule_tac set_iterator_rev_linord_I [of "rev l"])
    apply (simp_all add: lss_\<alpha>_def lss_invar_def lss_reverse_iterateoi_def)
  done
qed

lemma lss_iteratei_impl: "poly_set_iteratei lss_\<alpha> lss_invar lss_iteratei"
proof
  fix l :: "'a list"
  assume invar_l: "lss_invar l"
  show "finite (lss_\<alpha> l)"
    unfolding lss_\<alpha>_def by simp

  from invar_l
  show "set_iterator (lss_iteratei l) (lss_\<alpha> l)"
    apply (rule_tac set_iterator_I [of "l"])
    apply (simp_all add: lss_\<alpha>_def lss_invar_def lss_iteratei_def)
  done
qed

lemma lss_isEmpty_impl: "set_isEmpty lss_\<alpha> lss_invar lss_isEmpty"
by(unfold_locales)(auto simp add: lss_defs)

lemma lss_inter_impl: "set_inter lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_inter"
by (unfold_locales) (auto simp add: lss_defs inter_sorted_correct)

lemma lss_union_impl: "set_union lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_union"
by (unfold_locales) (auto simp add: lss_defs merge_correct)

lemma lss_union_list_impl: "set_union_list lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_union_list"
proof
  fix l :: "'a::{linorder} lss list"
  assume "\<forall>s1\<in>set l. lss_invar s1"

  with merge_list_correct [of l "[]"]
  show "lss_\<alpha> (lss_union_list l) = \<Union>{lss_\<alpha> s1 |s1. s1 \<in> set l}"
       "lss_invar (lss_union_list l)"
    by (auto simp add: lss_defs)
qed

lemma lss_union_dj_impl: "set_union_dj lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_union_dj"
by (unfold_locales) (auto simp add: lss_defs merge_correct)

lemma lss_image_filter_impl : "set_image_filter lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_image_filter"
apply (unfold_locales)
apply (simp_all add:
  lss_invar_def lss_image_filter_def lss_\<alpha>_def mergesort_remdups_correct
  set_map_filter Bex_def)
done

lemma lss_inj_image_filter_impl : "set_inj_image_filter lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_inj_image_filter"
apply (unfold_locales)
apply (simp_all add: lss_invar_def lss_inj_image_filter_def lss_image_filter_def
                     mergesort_remdups_correct lss_\<alpha>_def
                     set_map_filter Bex_def)
done

lemma lss_filter_impl : "set_filter lss_\<alpha> lss_invar lss_\<alpha> lss_invar lss_filter"
apply (unfold_locales)
apply (simp_all add: lss_invar_def lss_filter_def sorted_filter lss_\<alpha>_def
                     set_map_filter Bex_def sorted_filter')
done

lemmas lss_image_impl = iflt_image_correct[OF lss_image_filter_impl, folded lss_image_def]
lemmas lss_inj_image_impl = iflt_inj_image_correct[OF lss_inj_image_filter_impl, folded lss_inj_image_def]

lemma lss_to_list_impl: "set_to_list lss_\<alpha> lss_invar lss_to_list"
by(unfold_locales)(auto simp add: lss_defs)

lemma list_to_lss_impl: "list_to_set lss_\<alpha> lss_invar list_to_lss"
  by (unfold_locales) (auto simp add: lss_defs mergesort_remdups_correct)

definition lss_basic_ops :: "('x::linorder,'x lss) oset_basic_ops"
  where [icf_rec_def]: "lss_basic_ops \<equiv> \<lparr>
    bset_op_\<alpha> = lss_\<alpha>,
    bset_op_invar = lss_invar,
    bset_op_empty = lss_empty,
    bset_op_memb = lss_memb,
    bset_op_ins = lss_ins,
    bset_op_ins_dj = lss_ins_dj,
    bset_op_delete = lss_delete,
    bset_op_list_it = lss_iteratei,
    bset_op_ordered_list_it = lss_iterateoi,
    bset_op_rev_list_it = lss_reverse_iterateoi
  \<rparr>"

setup Locale_Code.open_block
interpretation lss_basic: StdBasicOSet lss_basic_ops
  apply (rule StdBasicOSet.intro)
  apply (rule StdBasicSet.intro)
  apply (simp_all add: icf_rec_unf)
  apply (rule lss_empty_impl lss_memb_impl lss_ins_impl lss_ins_dj_impl
    lss_delete_impl lss_iteratei_impl lss_iterateoi_impl
    lss_reverse_iterateoi_impl)+
  done
setup Locale_Code.close_block

definition [icf_rec_def]: "lss_ops \<equiv> lss_basic.dflt_oops \<lparr>
  set_op_isEmpty := lss_isEmpty,
  set_op_union := lss_union,
  set_op_union_dj := lss_union_dj,
  set_op_filter := lss_filter,
  set_op_to_list := lss_to_list,
  set_op_from_list := list_to_lss
  \<rparr>"

setup Locale_Code.open_block
interpretation lss: StdOSetDefs lss_ops .
interpretation lss: StdOSet lss_ops
proof -
  interpret aux: StdOSet lss_basic.dflt_oops
    by (rule lss_basic.dflt_oops_impl)

  show "StdOSet lss_ops"
    unfolding lss_ops_def
    apply (rule StdOSet_intro)
    apply icf_locales
    apply (simp_all add: icf_rec_unf
      lss_isEmpty_impl lss_union_impl lss_union_dj_impl lss_to_list_impl
      lss_filter_impl
      list_to_lss_impl
    )
    done
qed
setup Locale_Code.close_block

setup \<open>ICF_Tools.revert_abbrevs "lss"\<close>

lemma pi_lss[proper_it]:
  "proper_it' lss_iteratei lss_iteratei"
  apply (rule proper_it'I)
  unfolding lss_iteratei_def
  by (intro icf_proper_iteratorI)

interpretation pi_lss: proper_it_loc lss_iteratei lss_iteratei
  apply unfold_locales by (rule pi_lss)

definition test_codegen where "test_codegen \<equiv> (
  lss.empty,
  lss.memb,
  lss.ins,
  lss.delete,
  lss.list_it,
  lss.sng,
  lss.isEmpty,
  lss.isSng,
  lss.ball,
  lss.bex,
  lss.size,
  lss.size_abort,
  lss.union,
  lss.union_dj,
  lss.diff,
  lss.filter,
  lss.inter,
  lss.subset,
  lss.equal,
  lss.disjoint,
  lss.disjoint_witness,
  lss.sel,
  lss.to_list,
  lss.from_list
)"

export_code test_codegen checking SML

end