theory "Axioms"
imports
  Ordinary_Differential_Equations.ODE_Analysis
  "Ids"
  "Lib"
  "Syntax"
  "Denotational_Semantics"
begin
section \<open>Axioms\<close>
text \<open>
  The uniform substitution calculus is based on a finite list of concrete
  axioms, which are defined and proved valid (as in sound) in this section. When axioms apply
  to arbitrary programs or formulas, they mention concrete program or formula
  variables, which are then instantiated by uniform substitution, as opposed
  metavariables.

  This section contains axioms and rules for propositional connectives and programs other than
  ODE's. Differential axioms are handled separately because the proofs are significantly more involved.
  \<close>
named_theorems axiom_defs "Axiom definitions"
named_theorems axrule_defs "Axiomatic Rule definitions"

definition AllElimAxiom::"formula"
  where [axiom_defs]:"AllElimAxiom \<equiv> (Forall Ix (Pc Ix)) \<rightarrow> (Pc Ix)"

lemma AllElimAxiom_valid:"valid AllElimAxiom"
proof (unfold AllElimAxiom_def, unfold valid_def, simp, rule allI, rule impI, rule allI, rule allI, rule impI)
  fix I::"interp" and  a b
  assume good_interp:"is_interp I"
  assume all:"\<forall>r. (\<chi> y. if Ix = y then r else fst (a, b) $ y, b) \<in> Contexts I Ix UNIV"
  have eq:"(\<chi> y. if Ix = y then a $ Ix else fst (a, b) $ y, b) = (a,b)"
    by(auto, rule vec_extensionality,auto)
  show "(a, b) \<in> Contexts I Ix UNIV"
    using spec[OF all, of "a $ Ix"] eq by auto
qed

(* [a](p_(||)&q_(||)) <-> [a]p_(||)&[a]q_(||)" *)
definition BoxSplitAxiom::"formula"
  where [axiom_defs]:"BoxSplitAxiom \<equiv>
([[Pvar Ix]](And (Pc Ix) (Pc pid2)))
\<leftrightarrow>  (And ([[Pvar Ix]](Pc Ix))
         ([[Pvar Ix]](Pc pid2)))
"

definition ImpSelfAxiom::"formula"
  where [axiom_defs]:"ImpSelfAxiom \<equiv>
Equiv
 ((Prop Ix empty) \<rightarrow>(Prop Ix empty))
 TT"

(* s() = t() -> (ctxF_(s()) <-> ctxF_(t()))
 *)
definition constFcongAxiom::"formula"
  where [axiom_defs]:"constFcongAxiom \<equiv>
Implies
 (Equals (Function Ix empty) (Function fid2 empty))
 (Equiv
   (Prop Ix (singleton (Function Ix empty)))
   (Prop Ix (singleton (Function fid2 empty))))
"

lemma constFcong_valid:"valid constFcongAxiom"
proof (simp add: constFcongAxiom_def valid_def, rule allI, rule impI, rule allI, rule allI, rule impI, unfold empty_def)
  fix I::"interp" and a b
  assume good_interp:"is_interp I"
  assume fn:"Functions I Ix (\<chi> i. dterm_sem I \<^bold>0 (a, b)) = Functions I Iy (\<chi> i. dterm_sem I \<^bold>0 (a, b))"
  have vec_eq:"(\<chi> i. dterm_sem I (if i = Ix then $f Ix (\<lambda>i. \<^bold>0) else \<^bold>0) (a, b)) = (\<chi> i. dterm_sem I (if i = Ix then $f Iy (\<lambda>i. \<^bold>0) else \<^bold>0) (a, b))"
    apply(rule vec_extensionality)
    using fn by (auto simp add: empty_def)
  then show "Predicates I Ix (\<chi> i. dterm_sem I (if i = Ix then $f Ix (\<lambda>i. \<^bold>0)  else \<^bold>0) (a, b)) =
             Predicates I Ix (\<chi> i. dterm_sem I (if i = Ix then $f Iy (\<lambda>i. \<^bold>0)  else \<^bold>0) (a, b))"
    by auto
qed

definition assignAnyAxiom::"formula"
  where [axiom_defs]:"assignAnyAxiom \<equiv>
Equiv
 (Box (AssignAny Ix) (Pc Ix))
 (Forall Ix (Pc Ix))"

lemma assignAny_valid:"valid assignAnyAxiom"
  unfolding assignAnyAxiom_def valid_def Box_def Equiv_def Or_def by auto

definition equalCommuteAxiom::"formula"
  where [axiom_defs]:"equalCommuteAxiom \<equiv>
Equiv
(Equals (f0 Ix) (f0 fid2))
(Equals (f0 fid2) (f0 Ix))
"

lemma equalCommute_valid:"valid equalCommuteAxiom"
  unfolding equalCommuteAxiom_def by(auto simp add: f0_def Equiv_def Or_def empty_def Equals_def valid_def)

definition assignEqAxiom::"formula"
  where [axiom_defs]:"assignEqAxiom \<equiv>
Equiv
  ([[(Syntax.Assign Ix (Function Ix empty))::hp]](P Ix))
  (Forall Ix (Implies (Equals (Syntax.Var Ix) (Function Ix empty)) (P Ix)))"

lemma assignEq_valid:"valid assignEqAxiom"
proof (unfold assignEqAxiom_def, unfold valid_def, rule allI, rule allI, rule impI, simp)
  fix I::"interp" and \<nu>
  assume "is_interp I"
  have dir1:"((\<chi> y. if Ix = y then Functions I Ix (\<chi> i. dterm_sem I (empty i) \<nu>) else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix)) \<Longrightarrow>
           (\<forall>r. r = Functions I Ix (\<chi> i. dterm_sem I (empty i) (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>)) \<longrightarrow>
                (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix))"
  proof (auto)
    fix r
    assume f1:"(\<chi> y. if Ix = y then Functions I Ix (\<chi> i. dterm_sem I (empty i) \<nu>) else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix)"
    assume  f:"r = Functions I Ix (\<chi> i. dterm_sem I (empty i) (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>))"
    have eq:"(\<chi> y. if Ix = y then r else fst \<nu> $ y)
           = (\<chi> y. if Ix = y then Functions I Ix (\<chi> i. dterm_sem I (empty i) \<nu>) else fst \<nu> $ y)"
      apply(rule vec_extensionality)
      using f by (auto simp add: empty_def)
    show "(\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix)"
      using f1 eq by auto
  qed
  have dir2:"(\<forall>r. r = Functions I Ix (\<chi> i. dterm_sem I (empty i) (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>)) \<longrightarrow>
                (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix)) \<Longrightarrow>
    ((\<chi> y. if Ix = y then Functions I Ix (\<chi> i. dterm_sem I (empty i) \<nu>) else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix))"
  proof -
    assume f:"(\<forall>r. r = Functions I Ix (\<chi> i. dterm_sem I (empty i) (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>)) \<longrightarrow>
                (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix))"
    then have ff:"(\<And>r. r = Functions I Ix (\<chi> i. dterm_sem I (empty i) (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>)) \<Longrightarrow>
                (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix))"
      by auto
    show "((\<chi> y. if Ix = y then Functions I Ix (\<chi> i. dterm_sem I (empty i) \<nu>) else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix))"
      apply(rule ff)
      by(auto simp add: empty_def)
    qed
  show
"((\<chi> y. if Ix = y then Functions I Ix (\<chi> i. dterm_sem I (empty i) \<nu>) else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix)) =
           (\<forall>r. r = Functions I Ix (\<chi> i. dterm_sem I (empty i) (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>)) \<longrightarrow>
                (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>) \<in> fml_sem I (P Ix))"
  using dir1 dir2  unfolding Ix_def Ix_def Ix_def by blast
qed

definition allInstAxiom::"formula"
  where [axiom_defs]:"allInstAxiom \<equiv> Implies (Forall Ix (Prop Ix (singleton (Syntax.Var Ix)))) ( Prop Ix(singleton (Function Ix empty)))"

lemma allInst_valid:"valid allInstAxiom"
proof (unfold allInstAxiom_def, unfold valid_def, rule allI, rule allI, rule impI, simp, rule impI)
  fix I::"interp" and \<nu>
  let ?f = "$f Ix empty"
  let ?fs = "dterm_sem I ?f \<nu>"
  assume "is_interp I"
  assume pre:"(\<forall>r. Predicates I Ix
                 (\<chi> i. dterm_sem I (if i = Ix then trm.Var Ix else \<^bold>0) (\<chi> y. if Ix = y then r else fst \<nu> $ y, snd \<nu>)))"
  have arg_eq:"(\<chi> i. dterm_sem I (if i = Ix then trm.Var Ix else \<^bold>0) (\<chi> y. if Ix = y then ?fs else fst \<nu> $ y, snd \<nu>))
                  = (\<chi> i. dterm_sem I (if i = Ix then ?f else \<^bold>0) (fst \<nu> , snd \<nu>))"
    by(rule vec_extensionality,auto)
  show "Predicates I Ix (\<chi> i. dterm_sem I (if i = Ix then ?f else \<^bold>0) \<nu>)"
    using spec[OF pre, of ?fs] arg_eq by auto
qed

definition EquivReflexiveAxiom::"formula"
  where [axiom_defs]:"EquivReflexiveAxiom \<equiv> (Prop Ix empty) \<leftrightarrow> (Prop  Ix empty)"

definition assign_axiom :: "formula"
where [axiom_defs]:"assign_axiom \<equiv>
  ([[Ix := ($f Ix empty)]] (Prop Ix (singleton (Syntax.Var Ix))))
    \<leftrightarrow> Prop Ix (singleton ($f Ix empty))"

definition diff_assign_axiom :: "formula"
  where [axiom_defs]:"diff_assign_axiom \<equiv>
\<^cancel>\<open> [x_':=f();]p(x_') <-> p(f())\<close>
  ([[DiffAssign Ix  ($f Ix empty)]] (Prop Ix (singleton (DiffVar Ix))))
    \<leftrightarrow> Prop Ix (singleton ($f Ix empty))"

definition loop_iterate_axiom :: "formula"
where [axiom_defs]:"loop_iterate_axiom \<equiv> ([[$\<alpha> Ix**]]Predicational Ix)
  \<leftrightarrow> ((Predicational Ix) && ([[$\<alpha> Ix]][[$\<alpha> Ix**]]Predicational Ix))"

definition test_axiom :: "formula"
where [axiom_defs]:"test_axiom \<equiv>
  ([[?($\<phi> Ix empty)]]$\<phi> Ix empty) \<leftrightarrow> (($\<phi> Ix empty) \<rightarrow> ($\<phi> Ix empty))"

definition box_axiom :: "formula"
where [axiom_defs]:"box_axiom \<equiv> (\<langle>$\<alpha> Ix\<rangle>Predicational Ix) \<leftrightarrow> !([[$\<alpha> Ix]]!(Predicational Ix))"

definition choice_axiom :: "formula"
where [axiom_defs]:"choice_axiom \<equiv> ([[$\<alpha> Ix \<union>\<union> $\<alpha> vid2]]Predicational Ix)
  \<leftrightarrow> (([[$\<alpha> Ix]]Predicational Ix) && ([[$\<alpha> vid2]]Predicational Ix))"

definition compose_axiom :: "formula"
where [axiom_defs]:"compose_axiom \<equiv> ([[$\<alpha> Ix ;; $\<alpha> vid2]]Predicational Ix) \<leftrightarrow>
  ([[$\<alpha> Ix]][[ $\<alpha> vid2]]Predicational Ix)"

definition Kaxiom :: "formula"
where [axiom_defs]:"Kaxiom \<equiv> ([[$\<alpha> Ix]]((Predicational Ix) \<rightarrow> (Predicational pid2)))
  \<rightarrow> ([[$\<alpha> Ix]]Predicational Ix) \<rightarrow> ([[$\<alpha> Ix]]Predicational pid2)"

(* Here is an example of an old version of the induction axiom that was too weak
 * and thus very easy to prove: it used predicates when it should have used predicationals.
 * This serves as a reminder to be careful whether other axioms are also too weak. *)
(*
definition Ibroken :: "formula"
  where "Ibroken \<equiv> ([[$$a]]($P [] \<rightarrow> ([[$$a]]$P []))
    \<rightarrow> ($P [] \<rightarrow> ([[($$a)**]]$P [])))"*)

definition Iaxiom :: "formula"
  where [axiom_defs]:"Iaxiom \<equiv>
(Pc Ix  && ([[Loop(Pvar Ix)]](Pc Ix \<rightarrow> ([[Pvar Ix]] Pc Ix)))) \<rightarrow> ([[Loop(Pvar Ix)]]Pc Ix)"
(*([[($\<alpha> Ix)**]](Predicational Ix \<rightarrow> ([[$\<alpha> Ix]]Predicational Ix)))
  \<rightarrow>((Predicational Ix \<rightarrow> ([[($\<alpha> Ix)**]]Predicational Ix)))*)

definition Vaxiom :: "formula"
where [axiom_defs]:"Vaxiom \<equiv> ($\<phi> Ix empty) \<rightarrow> ([[$\<alpha> Ix]]($\<phi> Ix empty))"

definition TrueImplyAxiom :: "formula"
where [axiom_defs]:"TrueImplyAxiom \<equiv> Equiv (Implies TT (Prop Ix empty)) (Prop Ix empty)"

lemma TrueImply_valid: "valid TrueImplyAxiom"
  by(auto simp add: valid_def TrueImplyAxiom_def)

definition diamondAxiom :: "formula"
  where [axiom_defs]:"diamondAxiom \<equiv> Equiv (Not (Box ($\<alpha> Ix ) (Not (P Ix)))) (Diamond ($\<alpha> Ix) (P Ix))"

lemma diamond_valid: "valid diamondAxiom"
  by(auto simp add: valid_def diamondAxiom_def)

definition diamondModusPonensAxiom :: "formula"
  where [axiom_defs]:"diamondModusPonensAxiom \<equiv> Implies
   (Box ($\<alpha> Ix) (P Ix))
   (Implies
     (Diamond ($\<alpha> Ix) (P pid2))
     (Diamond ($\<alpha> Ix) (And (P Ix) (P pid2))))"

lemma diamondModusPonens_valid:"valid diamondModusPonensAxiom"
  by(auto simp add: diamondModusPonensAxiom_def valid_def)

definition equalReflAxiom :: "formula"
  where [axiom_defs]:"equalReflAxiom \<equiv>
Equiv
  (Equals (Function Ix empty) (Function Ix empty))
  TT
"

lemma equalRefl_valid:"valid equalReflAxiom"
  by(auto simp add: equalReflAxiom_def valid_def)

definition lessEqualReflAxiom :: "formula"
  where [axiom_defs]:"lessEqualReflAxiom \<equiv>
Equiv
  (Leq (Function Ix empty) (Function Ix empty))
  TT"

lemma lessEqualRefl_valid:"valid lessEqualReflAxiom"
  by(auto simp add: lessEqualReflAxiom_def valid_def Leq_def)

lemma assign_lem1:
"dterm_sem I (if i = Ix then Syntax.Var Ix else \<^bold>0)
                   (vec_lambda (\<lambda>y. if Ix = y then Functions I Ix
  (vec_lambda (\<lambda>i. dterm_sem I (empty i) \<nu>)) else  vec_nth (fst \<nu>) y), snd \<nu>)
=
 dterm_sem I (if i = Ix then $f Ix empty else \<^bold>0) \<nu>"
  by (cases "i = Ix") (auto simp: proj_sing1)

definition assigndAxiom :: "formula"
  where [axiom_defs]:"assigndAxiom \<equiv>
Equiv
  (Diamond (Syntax.Assign Ix (f0 Ix)) (Prop Ix (singleton (Syntax.Var Ix))))
  (Prop Ix (singleton (f0 Ix)))
"

lemma assignd_valid:"valid assigndAxiom"
  by(auto simp add: valid_def assigndAxiom_def assign_lem1 f0_def)

definition testdAxiom :: "formula"
  where [axiom_defs]:"testdAxiom \<equiv> Equiv
  (Diamond (Test (Prop vid2 empty)) (Prop Ix empty))
  (And (Prop vid2 empty) (Prop Ix empty))"

lemma testd_valid:"valid testdAxiom"
  by(auto simp add: valid_def testdAxiom_def)

definition choicedAxiom :: "formula"
  where [axiom_defs]:"choicedAxiom \<equiv>  Equiv
 (Diamond (Choice ($\<alpha> Ix) ($\<alpha> vid2)) (P Ix))
 (Or (Diamond ($\<alpha> Ix) (P Ix))
     (Diamond ($\<alpha> vid2) (P Ix)))"

lemma choiced_valid:"valid choicedAxiom"
  by(auto simp add: valid_def choicedAxiom_def)

definition composedAxiom :: "formula"
  where [axiom_defs]:"composedAxiom \<equiv> Equiv
(Diamond (Sequence ($\<alpha> Ix) ($\<alpha> vid2)) (P Ix))
(Diamond ($\<alpha> Ix) (Diamond ($\<alpha> vid2) (P Ix)))"

lemma composed_valid:"valid composedAxiom"
  by(auto simp add: valid_def composedAxiom_def)

definition randomdAxiom :: "formula"
  where [axiom_defs]:"randomdAxiom \<equiv> Equiv
(Diamond (Syntax.AssignAny Ix) (Prop Ix (singleton (Syntax.Var Ix))))
(Exists Ix (Prop Ix (singleton (Syntax.Var Ix))))
"

lemma randomd_valid:"valid randomdAxiom"
  by(auto simp add: randomdAxiom_def valid_def)

(*  Ix (singleton (f1 Ix Ix))) (Prop Ix (singleton (f1 fid2 Ix)))*)
definition CEaxrule :: "rule"
  where [axrule_defs]:"CEaxrule \<equiv> ([  ([],[Equiv(Pc Ix ) (Pc pid2)])  ],
([], [Equiv(InContext pid3 (Pc Ix)) (InContext pid3 (Pc pid2))]))"

lemma sound_CEaxrule: "sound CEaxrule"
proof (unfold CEaxrule_def,rule soundI)
  fix I::"interp"
  assume good_interp:"is_interp I"
  assume pres:"(\<And>i. 0 \<le> i \<Longrightarrow> i < length [([], [Pc Ix \<leftrightarrow> Pc pid2])] \<Longrightarrow> seq_sem I ([([], [Pc Ix \<leftrightarrow> Pc pid2])] ! i) = UNIV)"
  have pre:"fml_sem I (Pc Ix) = fml_sem I (Pc pid2)"
    using pres[of 0]
    by(auto simp add: Equiv_def Or_def TT_def FF_def POS_INF_def NEG_INF_def Abs_bword_inverse bword_zero_def bword_one_def)
  show "seq_sem I ([], [InContext pid3 (Pc Ix) \<leftrightarrow> InContext pid3 (Pc pid2)]) = UNIV"
    using pre by(auto simp add: pre)
qed

definition CTaxrule :: "rule"
  where [axrule_defs]:
"CTaxrule \<equiv> ([],([],[]))"

definition CQaxrule :: "rule"
  where [axrule_defs]:"CQaxrule \<equiv> ([   ([],[Equals ($$F Ix) ($$F Iy)])   ],
  ([],[Equiv(Prop Iz (singleton ($$F Ix)))(Prop Iz (singleton ($$F Iy)))]))"

lemma sound_CQaxrule: "sound CQaxrule"
proof (unfold CQaxrule_def,rule soundI)
  fix I::"interp"
  assume good_interp:"is_interp I"
  assume pres:"(\<And>i. 0 \<le> i \<Longrightarrow> i < length [([], [Equals ($$F Ix) ($$F Iy)])] \<Longrightarrow> seq_sem I ([([], [Equals ($$F Ix) ($$F Iy)])] ! i) = UNIV)"
  have pre:"fml_sem I (Equals ($$F Ix) ($$F Iy)) = UNIV"
    using pres[of 0]
    by(auto simp add: Equiv_def Or_def TT_def FF_def POS_INF_def NEG_INF_def Abs_bword_inverse bword_zero_def bword_one_def)
  then have pre2:"dterm_sem I ($$F Ix) = dterm_sem I ($$F Iy)"
    using pres[of 0] apply(auto simp add: Equiv_def Or_def TT_def FF_def pres[of 0])
    apply(rule ext)
    using pre by auto
  have vec_eq:"\<And>a b. (\<chi> i. dterm_sem I (if i = Ix then $$F Ix else \<^bold>0) (a, b)) = (\<chi> i. dterm_sem I (if i = Ix then $$F Iy else \<^bold>0) (a, b))"
    apply(rule vec_extensionality)
    using pre2 by(auto)
  show "seq_sem I ([], [Equiv(Prop Iz (singleton ($$F Ix)))(Prop Iz (singleton ($$F Iy)))]) = UNIV"
    using pre2 vec_eq by(auto simp add: pre2 vec_eq)
qed

definition Gaxrule :: "rule"
where [axrule_defs]:"Gaxrule \<equiv> ([   ([],[(P Ix)])   ],   ([],[ ([[Pvar Ix]](P Ix)) ]))"

lemma sound_Gaxrule: "sound Gaxrule"
proof (unfold Gaxrule_def,rule soundI)
  fix I::"interp"
  assume good_interp:"is_interp I"
  assume pres:"(\<And>i. 0 \<le> i \<Longrightarrow> i < length [([], [P Ix])] \<Longrightarrow> seq_sem I ([([], [P Ix])] ! i) = UNIV)"
  then have pre:"(\<And>\<nu>. \<nu> \<in> fml_sem I (P Ix))" using pres[of 0]
    by(auto simp add: Equiv_def Or_def TT_def FF_def Implies_def POS_INF_def NEG_INF_def Abs_bword_inverse bword_zero_def bword_one_def)
  show "seq_sem I ([], [([[$\<alpha> Ix]]P Ix)]) = UNIV"
    by(auto simp add: pre)
qed

definition monbrule :: "rule"
where [axrule_defs]:"monbrule \<equiv> ([   ([P Ix],[(P pid2)])   ],   ([([[Pvar Ix]](P Ix))],[ ([[Pvar Ix]](P pid2)) ]))"

lemma sound_monbrule: "sound monbrule"
proof (unfold monbrule_def,rule soundI)
  fix I::"interp"
  assume good_interp:"is_interp I"
  assume pres:"(\<And>i. 0 \<le> i \<Longrightarrow> i < length [([P Ix], [P pid2])] \<Longrightarrow> seq_sem I ([([P Ix], [P pid2])] ! i) = UNIV)"
  then have pre:"\<And>\<nu>. \<nu> \<in> fml_sem I (P Ix) \<Longrightarrow> \<nu> \<in> fml_sem I (P pid2)"
    using pres[of 0]
    by(auto simp add: Equiv_def Or_def TT_def FF_def POS_INF_def NEG_INF_def Abs_bword_inverse Implies_def bword_zero_def bword_one_def)
  then show "seq_sem I ([([[$\<alpha> Ix]]P Ix)], [([[$\<alpha> Ix]]P pid2)]) = UNIV"
    by(auto simp add: FF_def TT_def Implies_def Or_def)
qed

subsection \<open>Validity proofs for axioms\<close>
text \<open>Because an axiom in a uniform substitution calculus is an individual formula,
  proving the validity of that formula suffices to prove soundness\<close>
theorem test_valid: "valid test_axiom"
  by (auto simp add: valid_def test_axiom_def)

lemma diff_assign_lem1:
"dterm_sem I (if i = Ix then Syntax.DiffVar Ix else \<^bold>0)
                   (fst \<nu>, vec_lambda (\<lambda>y. if Ix = y then Functions I Ix (vec_lambda (\<lambda>i. dterm_sem I (empty i) \<nu>)) else  vec_nth (snd \<nu>) y))
=
 dterm_sem I (if i = Ix then $f Ix empty else \<^bold>0) \<nu>
"
  by (cases "i = Ix") (auto simp: proj_sing1)

theorem assign_valid: "valid assign_axiom"
  unfolding  valid_def assign_axiom_def
  by (simp add: assign_lem1)

theorem diff_assign_valid: "valid diff_assign_axiom"
  unfolding  valid_def diff_assign_axiom_def
  by (simp add: diff_assign_lem1)

lemma mem_to_nonempty: "\<omega> \<in> S \<Longrightarrow> (S \<noteq> {})"
  by (auto)

lemma loop_forward: "\<nu> \<in> fml_sem I ([[$\<alpha> id1**]]Predicational Ix)
  \<longrightarrow> \<nu> \<in> fml_sem I (Predicational Ix&&[[$\<alpha> id1]][[$\<alpha> id1**]]Predicational Ix)"
  by (cases \<nu>) (auto intro: converse_rtrancl_into_rtrancl simp add: box_sem)

lemma loop_backward:
 "\<nu> \<in> fml_sem I (Predicational Ix && [[$\<alpha> id1]][[$\<alpha> id1**]]Predicational Ix)
  \<longrightarrow> \<nu> \<in> fml_sem I ([[$\<alpha> id1**]]Predicational Ix)"
  by (auto elim: converse_rtranclE simp add: box_sem)

theorem loop_valid: "valid loop_iterate_axiom"
  apply(simp only: valid_def loop_iterate_axiom_def)
  apply(simp only: iff_sem)
  apply(simp only: HOL.iff_conv_conj_imp)
  apply(rule allI | rule impI)+
  apply(rule conjI)
  apply(rule loop_forward)
  apply(rule loop_backward)
done

theorem box_valid: "valid box_axiom"
  unfolding valid_def box_axiom_def by(auto)

theorem choice_valid: "valid choice_axiom"
  unfolding valid_def choice_axiom_def by (auto)

theorem compose_valid: "valid compose_axiom"
  unfolding valid_def compose_axiom_def by (auto)

theorem K_valid: "valid Kaxiom"
  unfolding valid_def Kaxiom_def by (auto)

lemma I_axiom_lemma:
  fixes I::"interp" and \<nu>
  assumes "is_interp I"
  assumes IS:"\<nu> \<in> fml_sem I ([[$\<alpha> Ix**]](Predicational Ix \<rightarrow>
                            [[$\<alpha> Ix]]Predicational Ix))"
  assumes BC:"\<nu> \<in> fml_sem I (Predicational Ix)"
  shows "\<nu> \<in> fml_sem I ([[$\<alpha> Ix**]](Predicational Ix))"
proof -
  have IS':"\<And>\<nu>2. (\<nu>, \<nu>2) \<in> (prog_sem I ($\<alpha> Ix))\<^sup>* \<Longrightarrow> \<nu>2 \<in> fml_sem I (Predicational Ix \<rightarrow> [[$\<alpha> Ix]](Predicational Ix))"
    using IS by (auto simp add: box_sem)
  have res:"\<And>\<nu>3. ((\<nu>, \<nu>3) \<in> (prog_sem I ($\<alpha> Ix))\<^sup>*) \<Longrightarrow> \<nu>3 \<in> fml_sem I (Predicational Ix)"
  proof -
    fix \<nu>3
    show "((\<nu>, \<nu>3) \<in> (prog_sem I ($\<alpha> Ix))\<^sup>*) \<Longrightarrow> \<nu>3 \<in> fml_sem I (Predicational Ix)"
      apply(induction rule:rtrancl_induct)
       apply(rule BC)
    proof -
      fix y z
      assume vy:"(\<nu>, y) \<in> (prog_sem I ($\<alpha> Ix))\<^sup>*"
      assume yz:"(y, z) \<in> prog_sem I ($\<alpha> Ix)"
      assume yPP:"y \<in> fml_sem I (Predicational Ix)"
      have imp3:"y \<in> fml_sem I (Predicational Ix \<rightarrow> [[$\<alpha> Ix ]](Predicational Ix))"
        using IS' vy by (simp)
      have imp4:"y \<in> fml_sem I (Predicational Ix) \<Longrightarrow> y \<in> fml_sem I  ([[$\<alpha> Ix]](Predicational Ix))"
        using imp3 impl_sem by (auto)
      have yaPP:"y \<in> fml_sem I ([[$\<alpha> Ix]]Predicational Ix)" using imp4 yPP by auto
      have zPP:"z \<in> fml_sem I (Predicational Ix)" using yaPP box_sem yz mem_Collect_eq by blast
      show "
        (\<nu>, y) \<in> (prog_sem I ($\<alpha> Ix))\<^sup>* \<Longrightarrow>
        (y, z) \<in> prog_sem I ($\<alpha> Ix) \<Longrightarrow>
        y \<in> fml_sem I (Predicational Ix) \<Longrightarrow>
        z \<in> fml_sem I (Predicational Ix)" using zPP by simp
    qed
  qed
  show "\<nu> \<in> fml_sem I ([[$\<alpha> Ix**]]Predicational Ix)"
    using res by (simp add: mem_Collect_eq box_sem loop_sem)
qed

theorem I_valid: "valid Iaxiom"
  apply(unfold Iaxiom_def valid_def)
  apply(rule impI | rule allI)+
  apply(auto simp add: impl_sem)
proof -
  fix I::"interp" and a b c d
  assume good_interp:"is_interp I"
  assume P1:"(a, b) \<in> Contexts I Ix UNIV"
  assume "\<forall>aa ba. ((a, b), aa, ba) \<in> (Programs I Ix)\<^sup>* \<longrightarrow>
               (aa, ba) \<in> Contexts I Ix UNIV \<longrightarrow> (\<forall>a b. ((aa, ba), a, b) \<in> Programs I Ix \<longrightarrow> (a, b) \<in> Contexts I Ix UNIV)"
  then have IS:"\<And> e f g h. ((a, b), (e, f)) \<in> (Programs I Ix)\<^sup>* \<Longrightarrow>
               (e, f) \<in> Contexts I Ix UNIV \<Longrightarrow> ((e, f), (g,h)) \<in> Programs I Ix \<Longrightarrow> (g,h) \<in> Contexts I Ix UNIV"
    by auto
  have res:"\<And>c d. ((a,b), (c,d)) \<in> (Programs I Ix)\<^sup>* \<Longrightarrow> (c,d) \<in> Contexts I Ix UNIV"
  proof -
    fix c d
    show "(((a,b), (c,d)) \<in> (Programs  I Ix)\<^sup>*) \<Longrightarrow> (c,d) \<in> Contexts I Ix UNIV"
      apply(induction rule:rtrancl_induct)
       apply(rule P1)
    proof -
      fix y z
      assume vy:"((a,b), y) \<in> (Programs I  Ix)\<^sup>*"
      assume yz:"(y, z) \<in> Programs I Ix"
      assume yPP:"y \<in> Contexts I Ix UNIV"
      have almost:"\<And>z.  ((fst y, snd y), z) \<in> Programs I Ix \<Longrightarrow> (fst z,snd z) \<in> Contexts I Ix UNIV"
        apply(rule IS[of "fst y" "snd y"] )
        using vy apply(cases y,auto)
        using yPP by auto
      then have imp3:"y \<in> Contexts I Ix UNIV \<Longrightarrow>  y \<in> fml_sem I ([[$\<alpha> Ix ]](Predicational Ix))"
        by(auto)
      have imp4:"y \<in> fml_sem I (Predicational Ix) \<Longrightarrow> y \<in> fml_sem I  ([[$\<alpha> Ix]](Predicational Ix))"
        using imp3 impl_sem by (auto)
      have yaPP:"y \<in> fml_sem I ([[$\<alpha> Ix]]Predicational Ix)" using imp4 yPP by auto
      have zPP:"z \<in> fml_sem I (Predicational Ix)" using yaPP box_sem yz mem_Collect_eq
        proof -
        have "(y, z) \<in> prog_sem I ($\<alpha> Ix)"
          by (simp add: yz)
        then show ?thesis
          using box_sem yaPP by blast
        qed
      show "z \<in> Contexts I Ix UNIV" using zPP by simp
    qed
  qed
  then show "((a, b), c, d) \<in> (Programs I Ix)\<^sup>* \<Longrightarrow> (c, d) \<in> Contexts I Ix UNIV" by auto
qed

theorem V_valid: "valid Vaxiom"
  apply(simp only: valid_def Vaxiom_def impl_sem box_sem)
  apply(rule allI | rule impI)+
  apply(auto simp add: empty_def)
done

definition G_holds :: "formula \<Rightarrow> hp \<Rightarrow> bool"
where "G_holds \<phi> \<alpha> \<equiv> valid \<phi> \<longrightarrow> valid ([[\<alpha>]]\<phi>)"

definition Skolem_holds :: "formula \<Rightarrow> ident \<Rightarrow> bool"
where "Skolem_holds \<phi> var \<equiv> valid \<phi> \<longrightarrow> valid (Forall var \<phi>)"

definition MP_holds :: "formula \<Rightarrow> formula \<Rightarrow> bool"
where "MP_holds \<phi> \<psi> \<equiv> valid (\<phi> \<rightarrow> \<psi>) \<longrightarrow> valid \<phi> \<longrightarrow> valid \<psi>"

definition CT_holds :: "ident \<Rightarrow> trm \<Rightarrow> trm \<Rightarrow> bool"
where "CT_holds g \<theta> \<theta>' \<equiv> valid (Equals \<theta> \<theta>')
  \<longrightarrow> valid (Equals (Function g (singleton \<theta>)) (Function g (singleton \<theta>')))"

definition CQ_holds :: "ident \<Rightarrow> trm \<Rightarrow> trm \<Rightarrow> bool"
where "CQ_holds p \<theta> \<theta>' \<equiv> valid (Equals \<theta> \<theta>')
  \<longrightarrow> valid ((Prop p (singleton \<theta>)) \<leftrightarrow> (Prop p (singleton \<theta>')))"

definition CE_holds :: "ident \<Rightarrow> formula \<Rightarrow> formula \<Rightarrow> bool"
where "CE_holds var \<phi> \<psi> \<equiv> valid (\<phi> \<leftrightarrow> \<psi>)
  \<longrightarrow> valid (InContext var \<phi> \<leftrightarrow> InContext var \<psi>)"

subsection \<open>Soundness proofs for rules\<close>
theorem G_sound: "G_holds \<phi> \<alpha>"
  by (simp add: G_holds_def valid_def box_sem)

theorem Skolem_sound: "Skolem_holds \<phi> var"
  by (simp add: Skolem_holds_def valid_def)

theorem MP_sound: "MP_holds \<phi> \<psi>"
  by (auto simp add: MP_holds_def valid_def)

lemma CT_lemma:"\<And>I::interp. \<And> a::(real, ident) vec. \<And> b::(real, ident) vec. \<forall>I::interp. is_interp I \<longrightarrow> (\<forall>a b. dterm_sem I \<theta> (a, b) = dterm_sem I \<theta>' (a, b)) \<Longrightarrow>
             is_interp I \<Longrightarrow>
             Functions I var (vec_lambda (\<lambda>i. dterm_sem I (if i = Ix then \<theta> else  \<^bold>0) (a, b))) =
             Functions I var (vec_lambda (\<lambda>i. dterm_sem I (if i = Ix then \<theta>' else \<^bold>0) (a, b)))"
proof -
  fix I :: "interp" and a :: "(real, ident) vec" and b :: "(real, ident) vec"
  assume a1: "is_interp I"
  assume "\<forall>I::interp. is_interp I \<longrightarrow> (\<forall>a b. dterm_sem I \<theta> (a, b) = dterm_sem I \<theta>' (a, b))"
  then have "\<forall>i. dterm_sem I (if i = Ix then \<theta>' else \<^bold>0) (a, b) = dterm_sem I (if i = Ix then \<theta> else \<^bold>0) (a, b)"
    using a1 by presburger
  then show "Functions I var (vec_lambda (\<lambda>i. dterm_sem I (if i = Ix then \<theta> else \<^bold>0) (a, b)))
           = Functions I var (vec_lambda (\<lambda>i. dterm_sem I (if i = Ix then \<theta>' else \<^bold>0) (a, b)))"
    by presburger
qed

theorem CT_sound: "CT_holds var \<theta> \<theta>'"
  apply(simp only: CT_holds_def valid_def equals_sem vec_extensionality vec_eq_iff)
  apply(simp)
  apply(rule allI | rule impI)+
  apply(simp add: CT_lemma)
done

theorem CQ_sound: "CQ_holds var \<theta> \<theta>'"
proof (auto simp only: CQ_holds_def valid_def equals_sem vec_extensionality vec_eq_iff singleton.simps mem_Collect_eq)
  fix I :: "interp" and a b
  assume sem:"\<forall>I::interp. \<forall> \<nu>. is_interp I \<longrightarrow> dterm_sem I \<theta> \<nu> = dterm_sem I \<theta>' \<nu>"
  assume good:"is_interp I"
  have sem_eq:"dterm_sem I \<theta> (a,b) = dterm_sem I \<theta>' (a,b)"
    using sem good by auto
  have feq:"(\<chi> i. dterm_sem I (if i = Ix then \<theta> else \<^bold>0) (a, b)) = (\<chi> i. dterm_sem I (if i = Ix then \<theta>' else \<^bold>0) (a, b))"
    apply(rule vec_extensionality)
    using sem_eq by auto
  then show "(a, b) \<in> fml_sem I ($\<phi> var (singleton \<theta>) \<leftrightarrow> $\<phi> var (singleton \<theta>'))"
    by auto
qed

theorem CE_sound: "CE_holds var \<phi> \<psi>"
  apply(simp only: CE_holds_def valid_def iff_sem)
  apply(rule allI | rule impI)+
  apply(simp)
  apply(metis subsetI subset_antisym surj_pair)
done
end


section \<open>Tail Bounds for Expander Walks\<close>

theory Distributed_Distinct_Elements_Tail_Bounds
  imports
    Distributed_Distinct_Elements_Preliminary
    Expander_Graphs.Expander_Graphs_Definition
    Expander_Graphs.Expander_Graphs_Walks
    "HOL-Decision_Procs.Approximation"
    Pseudorandom_Combinators
begin

text \<open>This section introduces tail estimates for random walks in expander graphs, specific to the
verification of this algorithm (in particular to two-stage expander graph sampling and obtained
tail bounds for subgaussian random variables). They follow from the more fundamental results
@{thm [source] regular_graph.kl_chernoff_property} and
@{thm [source] regular_graph.uniform_property} which are verified in the AFP entry for
expander graphs~\cite{Expander_Graphs-AFP}.\<close>

hide_fact Henstock_Kurzweil_Integration.integral_sum

unbundle intro_cong_syntax

lemma x_ln_x_min:
  assumes "x \<ge> (0::real)"
  shows  "x * ln x \<ge> -exp (-1)"
proof -
  define f where "f x = x * ln x" for x :: real
  define f' where "f' x = ln x + 1" for x :: real

  have 0:"(f has_real_derivative (f' x)) (at x)" if "x > 0" for x
    unfolding f_def f'_def using that
    by (auto intro!: derivative_eq_intros)

  have "f' x \<ge> 0" if "exp (-1) \<le> x" for x :: real
  proof -
    have "ln x \<ge> -1"
      using that order_less_le_trans[OF exp_gt_zero]
      by (intro iffD2[OF ln_ge_iff]) auto
    thus ?thesis
      unfolding f'_def by (simp)
  qed

  hence "\<exists>y. (f has_real_derivative y) (at x) \<and> 0 \<le> y" if "x \<ge> exp (-1)" for x :: real
    using that order_less_le_trans[OF exp_gt_zero]
    by (intro exI[where x="f' x"] conjI 0) auto
  hence "f (exp (-1)) \<le> f x" if "exp(-1) \<le> x"
    by (intro DERIV_nonneg_imp_nondecreasing[OF that]) auto
  hence 2:?thesis if  "exp(-1) \<le> x"
    unfolding f_def using that by simp

  have "f' x \<le> 0" if "x > 0" "x \<le> exp (-1)" for x :: real
  proof -
    have "ln x \<le> ln (exp (-1))"
      by (intro iffD2[OF ln_le_cancel_iff] that exp_gt_zero)
    also have "... = -1"
      by simp
    finally have "ln x \<le> -1" by simp
    thus ?thesis unfolding f'_def by simp
  qed

  hence "\<exists>y. (f has_real_derivative y) (at x) \<and> y \<le> 0" if "x > 0 " "x \<le> exp (-1)" for x :: real
    using that by (intro exI[where x="f' x"] conjI 0) auto
  hence "f (exp (-1)) \<le> f x" if "x > 0" "x \<le> exp(-1)"
    using that(1) by (intro DERIV_nonpos_imp_nonincreasing[OF that(2)]) auto
  hence 3:?thesis if "x > 0" "x \<le> exp(-1)"
    unfolding f_def using that by simp

  have ?thesis if "x = 0"
    using that by simp
  thus ?thesis
    using 2 3 assms by fastforce
qed

theorem (in regular_graph) walk_tail_bound:
  assumes "l > 0"
  assumes "S \<subseteq> verts G"
  defines "\<mu> \<equiv> real (card S) / card (verts G)"
  assumes "\<gamma> < 1" "\<mu> + \<Lambda>\<^sub>a \<le> \<gamma>"
  shows "measure (pmf_of_multiset (walks G l)) {w. real (card {i \<in> {..<l}. w ! i \<in> S}) \<ge> \<gamma>*l}
    \<le> exp (- real l * (\<gamma> * ln (1/(\<mu>+\<Lambda>\<^sub>a)) - 2 * exp(-1)))" (is "?L \<le> ?R")
proof (cases "\<mu> > 0")
  case True

  have "0 < \<mu> + \<Lambda>\<^sub>a"
    by (intro add_pos_nonneg \<Lambda>_ge_0 True)
  also have "... \<le> \<gamma>"
    using assms(5) by simp
  finally have \<gamma>_gt_0: "0 < \<gamma>" by simp

  hence \<gamma>_ge_0: "0 \<le> \<gamma>"
    by simp

  have "card S \<le> card (verts G)"
    by (intro card_mono assms(2)) auto
  hence \<mu>_le_1: "\<mu> \<le> 1"
    unfolding \<mu>_def by (simp add:divide_simps)

  have 2: "0 < \<mu> + \<Lambda>\<^sub>a * (1 - \<mu>)"
    using \<mu>_le_1 by (intro add_pos_nonneg True mult_nonneg_nonneg \<Lambda>_ge_0) auto

  have "\<mu> + \<Lambda>\<^sub>a * (1 - \<mu>) \<le> \<mu> +  \<Lambda>\<^sub>a * 1"
    using \<Lambda>_ge_0 True by (intro add_mono mult_left_mono) auto
  also have "... \<le> \<gamma>"
    using assms(5) by simp
  also have "... < 1"
    using assms(4) by simp
  finally have 4:"\<mu> + \<Lambda>\<^sub>a * (1 - \<mu>) < 1" by simp
  hence 3: "1 \<le> 1 / (1 - (\<mu> + \<Lambda>\<^sub>a * (1 - \<mu>)))"
    using 2 by (subst pos_le_divide_eq) simp_all

  have "card S \<le> n"
    unfolding n_def by (intro card_mono assms(2)) auto
  hence 0:"\<mu> \<le> 1"
    unfolding \<mu>_def n_def[symmetric] using n_gt_0 by simp

  have "\<gamma> * ln (1 / (\<mu> + \<Lambda>\<^sub>a)) - 2*exp (- 1) = \<gamma> * ln (1 / (\<mu> + \<Lambda>\<^sub>a*1))+0 -2*exp (- 1)"
    by simp
  also have "... \<le> \<gamma> * ln (1 / (\<mu> + \<Lambda>\<^sub>a*(1-\<mu>)))+0-2*exp(-1)"
    using True \<gamma>_ge_0 \<Lambda>_ge_0 0 2
    by (intro diff_right_mono mult_left_mono iffD2[OF ln_le_cancel_iff] divide_pos_pos
        divide_left_mono add_mono) auto
  also have "... \<le> \<gamma> * ln (1 / (\<mu> + \<Lambda>\<^sub>a*(1-\<mu>)))+(1-\<gamma>)*ln(1/(1-(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>))))-2* exp(-1)"
    using assms(4) 3 by (intro add_mono diff_mono mult_nonneg_nonneg ln_ge_zero) auto
  also have "... = (-exp(-1))+\<gamma>*ln(1/(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>)))+(-exp(-1))+(1-\<gamma>)*ln(1/(1-(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>))))"
    by simp
  also have "... \<le> \<gamma>*ln \<gamma>+\<gamma>*ln(1/(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>)))+(1-\<gamma>)*ln(1-\<gamma>)+(1-\<gamma>)*ln(1/(1-(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>))))"
    using assms(4) \<gamma>_ge_0 by (intro add_mono x_ln_x_min) auto
  also have "... = \<gamma>*(ln \<gamma>+ln(1/(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>))))+(1-\<gamma>)*(ln(1-\<gamma>)+ln(1/(1-(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>)))))"
    by (simp add:algebra_simps)
  also have "... = \<gamma> * ln (\<gamma>*(1/(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>))))+(1-\<gamma>)*ln((1-\<gamma>)*(1/(1-(\<mu>+\<Lambda>\<^sub>a*(1-\<mu>)))))"
    using 2 4 assms(4) \<gamma>_gt_0
    by (intro_cong "[\<sigma>\<^sub>2(+), \<sigma>\<^sub>2(*)]" more:ln_mult[symmetric] divide_pos_pos) auto
  also have "... = KL_div \<gamma> (\<mu>+\<Lambda>\<^sub>a*(1-\<mu>))"
    unfolding KL_div_def by simp
  finally have 1: "\<gamma> * ln (1 / (\<mu> + \<Lambda>\<^sub>a)) - 2 * exp (- 1) \<le> KL_div \<gamma> (\<mu> + \<Lambda>\<^sub>a * (1 - \<mu>))"
    by simp

  have "\<mu>+\<Lambda>\<^sub>a*(1-\<mu>) \<le> \<mu>+\<Lambda>\<^sub>a*1"
    using True
    by (intro add_mono mult_left_mono \<Lambda>_ge_0) auto
  also have "... \<le> \<gamma>"
    using assms(5) by simp
  finally have "\<mu>+\<Lambda>\<^sub>a*(1-\<mu>) \<le> \<gamma>"  by simp
  moreover have "\<mu>+\<Lambda>\<^sub>a*(1-\<mu>) > 0"
    using 0 by (intro add_pos_nonneg True mult_nonneg_nonneg \<Lambda>_ge_0) auto
  ultimately have "\<mu>+\<Lambda>\<^sub>a*(1-\<mu>) \<in> {0<..\<gamma>}" by simp
  hence "?L \<le> exp (- real l * KL_div \<gamma> (\<mu>+\<Lambda>\<^sub>a*(1-\<mu>)))"
    using assms(4) unfolding \<mu>_def by (intro kl_chernoff_property assms(1,2)) auto
  also have "... \<le> ?R"
    using assms(1) 1 by simp
  finally show ?thesis by simp
next
  case False
  hence "\<mu> \<le> 0" by simp
  hence "card S = 0"
    unfolding \<mu>_def n_def[symmetric] using n_gt_0 by (simp add:divide_simps)
  moreover have "finite S"
    using finite_subset[OF assms(2) finite_verts] by auto
  ultimately have 0:"S = {}" by auto
  have "\<mu> = 0"
    unfolding \<mu>_def 0 by simp
  hence "\<mu> + \<Lambda>\<^sub>a \<ge>0 "
    using \<Lambda>_ge_0 by simp
  hence "\<gamma> \<ge> 0"
    using assms(5) by simp
  hence "\<gamma> * real l \<ge> 0"
    by (intro mult_nonneg_nonneg) auto
  thus ?thesis using 0 by simp
qed

theorem (in regular_graph) walk_tail_bound_2:
  assumes "l > 0" "\<Lambda>\<^sub>a \<le> \<Lambda>" "\<Lambda> > 0"
  assumes "S \<subseteq> verts G"
  defines "\<mu> \<equiv> real (card S) / card (verts G)"
  assumes "\<gamma> < 1" "\<mu> + \<Lambda> \<le> \<gamma>"
  shows "measure (pmf_of_multiset (walks G l)) {w. real (card {i \<in> {..<l}. w ! i \<in> S}) \<ge> \<gamma>*l}
    \<le> exp (- real l * (\<gamma> * ln (1/(\<mu>+\<Lambda>)) - 2 * exp(-1)))" (is "?L \<le> ?R")
proof (cases "\<mu> > 0")
  case True

  have 0: "0 < \<mu> + \<Lambda>\<^sub>a"
    by (intro add_pos_nonneg \<Lambda>_ge_0 True)
  hence "0 < \<mu> + \<Lambda>"
    using assms(2) by simp
  hence 1: "0 < (\<mu> + \<Lambda>) * (\<mu> + \<Lambda>\<^sub>a)"
    using 0 by simp

  have 3:"\<mu> + \<Lambda>\<^sub>a \<le> \<gamma>"
    using assms(2,7) by simp
  have 2: "0 \<le> \<gamma>"
    using 3 True \<Lambda>_ge_0 by simp

  have "?L \<le> exp (- real l * (\<gamma> * ln (1/(\<mu>+\<Lambda>\<^sub>a)) - 2 * exp(-1)))"
    using 3 unfolding \<mu>_def by (intro walk_tail_bound assms(1,4,6))
  also have "... = exp (- (real l * (\<gamma> * ln (1/(\<mu>+\<Lambda>\<^sub>a)) - 2 * exp(-1))))"
    by simp
  also have "... \<le> exp (- (real l * (\<gamma> * ln (1/(\<mu>+\<Lambda>)) - 2 * exp(-1))))"
    using True assms(2,3) using 0 1 2
    by (intro iffD2[OF exp_le_cancel_iff] mult_left_mono diff_mono iffD2[OF ln_le_cancel_iff]
        divide_left_mono le_imp_neg_le) simp_all
  also have "... = ?R"
    by simp
  finally show ?thesis by simp
next
  case False
  hence "\<mu> \<le> 0" by simp
  hence "card S = 0"
    unfolding \<mu>_def n_def[symmetric] using n_gt_0 by (simp add:divide_simps)
  moreover have "finite S"
    using finite_subset[OF assms(4) finite_verts] by auto
  ultimately have 0:"S = {}" by auto
  have "\<mu> = 0"
    unfolding \<mu>_def 0 by simp
  hence "\<mu> + \<Lambda>\<^sub>a \<ge>0 "
    using \<Lambda>_ge_0 by simp
  hence "\<gamma> \<ge> 0"
    using assms by simp
  hence "\<gamma> * real l \<ge> 0"
    by (intro mult_nonneg_nonneg) auto
  thus ?thesis using 0 by simp
qed

lemma (in expander_sample_space) tail_bound:
  fixes T
  assumes "l > 0" "\<Lambda> > 0"
  defines "\<mu> \<equiv> measure (sample_pmf S) {w. T w}"
  assumes "\<gamma> < 1" "\<mu> + \<Lambda> \<le> \<gamma>"
  shows "measure (\<E> l \<Lambda> S) {w. real (card {i \<in> {..<l}. T (w i)}) \<ge> \<gamma>*l}
    \<le> exp (- real l * (\<gamma> * ln (1/(\<mu>+\<Lambda>)) - 2 * exp(-1)))" (is "?L \<le> ?R")
proof -
  let ?w = "pmf_of_multiset (walks (graph_of e) l)"
  define V where "V = {v\<in> verts (graph_of e). T (select S v)} "

  have 0: "card {i \<in> {..<l}. T (select S (w ! i))} = card {i \<in> {..<l}. w ! i \<in> V}"
    if "w  \<in> set_pmf (pmf_of_multiset (walks (graph_of e) l))" for w
  proof -
    have a0: "w \<in># walks (graph_of e) l" using that E.walks_nonempty by simp
    have "w ! i \<in> verts (graph_of e)" if "i < l" for i
      using that E.set_walks_3[OF a0] by auto
    thus ?thesis
      unfolding V_def
      by (intro arg_cong[where f="card"] restr_Collect_cong) auto
  qed

  have 1:"E.\<Lambda>\<^sub>a \<le> \<Lambda>"
    using see_standard(1) unfolding is_expander_def e_def by simp

  have 2: "V \<subseteq> verts (graph_of e)"
    unfolding V_def by simp

  have "\<mu> = measure (pmf_of_set {..<size S}) ({v. T (select S v)})"
    unfolding \<mu>_def sample_pmf_alt[OF sample_space_S]
    by simp
  also have "... = real (card ({v\<in>{..<size S}. T (select S v)})) / real (size S)"
    using size_S_gt_0 by (subst measure_pmf_of_set) (auto simp add:Int_def)
  also have "... = real (card V) / card (verts (graph_of e))"
    unfolding V_def graph_of_def e_def using see_standard by (simp add:Int_commute)
  finally have \<mu>_eq: "\<mu> = real (card V) / card (verts (graph_of e))"
    by simp

  have "?L = measure ?w {y. \<gamma> * real l \<le> real (card {i \<in> {..<l}. T (select S (y ! i))})}"
    unfolding walks by simp
  also have "... = measure ?w {y. \<gamma> * real l \<le> real (card {i \<in> {..<l}. y ! i \<in> V})}"
    using 0 by (intro measure_pmf_cong) (simp)
  also have "... \<le> ?R"
    using assms(5) unfolding \<mu>_eq
    by (intro E.walk_tail_bound_2 assms(1,2,4) 1 2) auto
  finally show ?thesis
    by simp
qed

definition C\<^sub>1 :: real where "C\<^sub>1 = exp 2 + exp 3 + (exp 1 - 1)"

lemma (in regular_graph) deviation_bound:
  fixes f :: "'a \<Rightarrow> real"
  assumes "l > 0"
  assumes "\<Lambda>\<^sub>a \<le> exp (-real l * ln (real l)^3)"
  assumes "\<And>x. x \<ge> 20 \<Longrightarrow> measure (pmf_of_set (verts G)) {v. f v \<ge> x} \<le> exp (-x * ln x^3)"
  shows "measure (pmf_of_multiset (walks G l)) {w. (\<Sum>i\<leftarrow>w. f i) \<ge> C\<^sub>1 * l} \<le> exp (- real l)"
    (is "?L \<le> ?R")
proof -
  let ?w = "pmf_of_multiset (walks G l)"
  let ?p = "pmf_of_set (verts G)"
  let ?a = "real l*(exp 2 + exp 3)"

  define b :: real where "b = exp 1 - 1"
  have b_gt_0: "b > 0"
    unfolding b_def by (approximation 5)

  define L where
    "L k = measure ?w {w. exp (real k)*card{i\<in>{..<l}.f(w!i)\<ge>exp(real k)} \<ge> real l/real k^2}" for k

  define k_max where "k_max = max 4 (MAX v \<in> verts G. nat \<lfloor>ln (f v)\<rfloor>+1)"

  define \<Lambda> where "\<Lambda> = exp (-real l * ln (real l)^3)"

  have \<Lambda>\<^sub>a_le_\<Lambda>: "\<Lambda>\<^sub>a \<le> \<Lambda>"
    unfolding \<Lambda>_def using assms(2) by simp

  have \<Lambda>_gt_0: "\<Lambda> > 0"
    unfolding \<Lambda>_def by simp

  have k_max_ge_4: "k_max \<ge> 4"
    unfolding k_max_def by simp
  have k_max_ge_3: "k_max \<ge> 3"
    unfolding k_max_def by simp

  have 1:"of_bool(\<lfloor>ln(max x (exp 1))\<rfloor>+1=int k) =
    (of_bool(x \<ge> exp (real k-1)) - of_bool(x \<ge> exp k)::real)"
    (is "?L1 = ?R1") if "k \<ge> 3" for k x
  proof -
    have a1: "real k - 1 \<le> k" by simp
    have "?L1 = of_bool(\<lfloor>ln(max x (exp 1))\<rfloor>=int k-1)"
      by simp
    also have "... = of_bool(ln(max x (exp 1))\<in>{real k-1..<real k})"
      unfolding floor_eq_iff by simp
    also have "... = of_bool(exp(ln(max x (exp 1)))\<in>{exp (real k-1)..<exp (real k)})"
      by simp
    also have "... = of_bool(max x (exp 1) \<in>{exp (real k-1)..<exp (real k)})"
      by (subst exp_ln) (auto intro!:max.strict_coboundedI2)
    also have "... = of_bool(x \<in>{exp (real k-1)..<exp (real k)})"
    proof (cases "x \<ge> exp 1")
      case True
      then show ?thesis by simp
    next
      case False
      have "{exp (real k - 1)..<exp (real k)} \<subseteq> {exp (real k - 1)..}"
        by auto
      also have "... \<subseteq> {exp 1..}"
        using that by simp
      finally have "{exp (real k - 1)..<exp (real k)} \<subseteq> {exp 1..}" by simp
      moreover have "x \<notin> {exp 1..}"
        using False by simp
      ultimately have "x \<notin> {exp (real k - 1)..<exp (real k)}" by blast
      hence "of_bool(x \<in>{exp (real k-1)..<exp (real k)}) = 0" by simp
      also have "... = of_bool(max x (exp 1) \<in>{exp (real k-1)..<exp (real k)})"
        using False that by simp
      finally show ?thesis by metis
    qed
    also have "... = ?R1"
      using order_trans[OF iffD2[OF exp_le_cancel_iff a1]] by auto
    finally show ?thesis by simp
  qed

  have 0: "{nat \<lfloor>ln (max (f x) (exp 1))\<rfloor>+1} \<subseteq> {2..k_max}" (is "{?L1} \<subseteq> ?R2")
    if "x \<in> verts G" for x
  proof (cases "f x \<ge> exp 1")
    case True
    hence "?L1 = nat \<lfloor>ln (f x)\<rfloor>+1"
      by simp
    also have "... \<le> (MAX v \<in> verts G. nat \<lfloor>ln (f v)\<rfloor>+1)"
      by (intro Max_ge finite_imageI imageI that) auto
    also have "... \<le> k_max"
      unfolding k_max_def by simp
    finally have le_0: "?L1 \<le> k_max"
      by simp
    have "(1::nat) \<le> nat \<lfloor>ln (exp (1::real))\<rfloor>"
      by simp
    also have "... \<le> nat \<lfloor>ln (f x)\<rfloor>"
      using True order_less_le_trans[OF exp_gt_zero]
      by (intro nat_mono floor_mono iffD2[OF ln_le_cancel_iff]) auto
    finally have "1 \<le> nat \<lfloor>ln (f x)\<rfloor>" by simp
    hence "?L1 \<ge> 2"
      using True by simp
    hence "?L1 \<in> ?R2"
      using le_0 by simp
    then show ?thesis by simp
  next
    case False
    hence "{?L1} = {2}"
      by simp
    also have "... \<subseteq> ?R2"
      using k_max_ge_3 by simp
    finally show ?thesis by simp
  qed

  have 2:"(\<Sum>i\<leftarrow>w. f i) \<le> ?a+b*(\<Sum>k=3..<k_max. exp k * card {i\<in>{..<l}. f (w!i)\<ge>exp k})"
    (is "?L1 \<le> ?R1") if "w \<in># walks G l" for w
  proof -
    have l_w: "length w = l"
      using set_walks that by auto
    have s_w: "set w \<subseteq> verts G"
      using set_walks that by auto

    have "?L1 \<le> (\<Sum>i\<leftarrow>w. exp( ln (max (f i) (exp 1))))"
      by (intro sum_list_mono) (simp add:less_max_iff_disj)
    also have "... \<le> (\<Sum>i\<leftarrow>w. exp (of_nat (nat \<lfloor>ln (max (f i) (exp 1))\<rfloor>+1)))"
      by (intro sum_list_mono iffD2[OF exp_le_cancel_iff]) linarith
    also have "... = (\<Sum>i\<leftarrow>w. (\<Sum>k=2..k_max. exp k * of_bool (k=nat \<lfloor>ln (max (f i)(exp 1))\<rfloor>+1)))"
      using Int_absorb1[OF 0] subsetD[OF s_w] by (intro_cong "[\<sigma>\<^sub>1 sum_list]" more:map_cong)
        (simp add:of_bool_def if_distrib if_distribR sum.If_cases)
    also have "...=
      (\<Sum>i\<leftarrow>w.(\<Sum>k\<in>(insert 2{3..k_max}). exp k* of_bool(k=nat\<lfloor>ln(max(f i)(exp 1))\<rfloor>+1)))"
      using k_max_ge_3 by (intro_cong "[\<sigma>\<^sub>1 sum_list]" more:map_cong sum.cong) auto
    also have "... = (\<Sum>i\<leftarrow>w. exp 2* of_bool (2=nat \<lfloor>ln (max (f i)(exp 1))\<rfloor>+1) +
      (\<Sum>k=3..k_max. exp k * of_bool (k=nat \<lfloor>ln (max (f i)(exp 1))\<rfloor>+1)))"
      by (subst sum.insert) auto
    also have "... \<le> (\<Sum>i\<leftarrow>w. exp 2*1+(\<Sum>k=3..k_max. exp k* of_bool(k=nat\<lfloor>ln(max(f i)(exp 1))\<rfloor>+1)))"
      by (intro sum_list_mono add_mono mult_left_mono) auto
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+(\<Sum>k=3..k_max. exp k* of_bool(\<lfloor>ln(max(f i)(exp 1))\<rfloor>+1=int k)))"
      by (intro_cong "[\<sigma>\<^sub>1 sum_list,\<sigma>\<^sub>1 of_bool, \<sigma>\<^sub>2(+),\<sigma>\<^sub>2(*)]" more:map_cong sum.cong) auto
    also have "... =
      (\<Sum>i\<leftarrow>w. exp 2+(\<Sum>k=3..k_max. exp k*(of_bool(f i\<ge>exp (real k-1))-of_bool(f i\<ge>exp k))))"
      by (intro_cong "[\<sigma>\<^sub>1 sum_list,\<sigma>\<^sub>1 of_bool, \<sigma>\<^sub>2(+),\<sigma>\<^sub>2(*)]" more:map_cong sum.cong 1) auto
    also have "... =
      (\<Sum>i\<leftarrow>w. exp 2+(\<Sum>k=2+1..<k_max+1. exp k*(of_bool(f i\<ge>exp(real k-1))-of_bool(f i\<ge>exp k))))"
      by (intro_cong "[\<sigma>\<^sub>1 sum_list,\<sigma>\<^sub>2(+)]" more:map_cong sum.cong) auto
    also have "... =
      (\<Sum>i\<leftarrow>w. exp 2+(\<Sum>k=2..<k_max. exp (k+1)*(of_bool(f i\<ge>exp k)-of_bool(f i\<ge>exp (Suc k)))))"
      by (subst sum.shift_bounds_nat_ivl) simp
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+ (\<Sum>k=2..<k_max. exp (k+1)* of_bool(f i\<ge>exp k))-
      (\<Sum>k=2..<k_max. exp (k+1)* of_bool(f i\<ge>exp (k+1))))"
      by (simp add:sum_subtractf algebra_simps)
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+ (\<Sum>k=2..<k_max. exp (k+1)* of_bool(f i\<ge>exp k))-
      (\<Sum>k=3..<k_max+1. exp k* of_bool(f i\<ge>exp k)))"
      by (subst sum.shift_bounds_nat_ivl[symmetric]) (simp cong:sum.cong)
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+ (\<Sum>k\<in> insert 2 {3..<k_max}. exp (k+1)* of_bool(f i\<ge>exp k))-
      (\<Sum>k=3..<k_max+1. exp k* of_bool(f i\<ge>exp k)))"
      using k_max_ge_3
      by (intro_cong "[\<sigma>\<^sub>1 sum_list, \<sigma>\<^sub>2 (+), \<sigma>\<^sub>2 (-)]" more: map_cong sum.cong) auto
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+ exp 3 * of_bool (f i \<ge> exp 2) +
      (\<Sum>k=3..<k_max. exp (k+1)* of_bool(f i\<ge>exp k))-(\<Sum>k=3..<k_max+1. exp k* of_bool(f i\<ge>exp k)))"
      by (subst sum.insert) (simp_all add:algebra_simps)
    also have "... \<le> (\<Sum>i\<leftarrow>w. exp 2+exp 3+(\<Sum>k=3..<k_max. exp (k+1)* of_bool(f i\<ge>exp k))-
      (\<Sum>k=3..<k_max+1. exp k* of_bool(f i\<ge>exp k)))"
      by (intro sum_list_mono add_mono diff_mono) auto
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+exp 3+(\<Sum>k=3..<k_max. exp (k+1)* of_bool(f i\<ge>exp k))-
      (\<Sum>k\<in> insert k_max {3..<k_max}. exp k* of_bool(f i\<ge>exp k)))"
      using k_max_ge_3 by (intro_cong "[\<sigma>\<^sub>1 sum_list, \<sigma>\<^sub>2 (+), \<sigma>\<^sub>2 (-)]" more: map_cong sum.cong) auto
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+exp 3+(\<Sum>k=3..<k_max. (exp (k+1)-exp k)* of_bool(f i\<ge>exp k))-
      (exp k_max * of_bool (f i\<ge> exp k_max)))"
      by (subst sum.insert) (auto simp add:sum_subtractf algebra_simps)
    also have "...\<le>(\<Sum>i\<leftarrow>w. exp 2+exp 3+(\<Sum>k=3..<k_max. (exp (k+1)-exp k)* of_bool(f i\<ge>exp k))-0)"
      by (intro sum_list_mono add_mono diff_mono) auto
    also have "... \<le>(\<Sum>i\<leftarrow>w. exp 2+exp 3+ (\<Sum>k=3..<k_max. (exp (k+1)-exp k)* of_bool(f i\<ge>exp k)))"
      by auto
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+exp 3+ (\<Sum>k=3..<k_max. (exp 1-1)*(exp k* of_bool(f i\<ge>exp k))))"
      by (simp add:exp_add algebra_simps)
    also have "... = (\<Sum>i\<leftarrow>w. exp 2+exp 3+b*(\<Sum>k=3..<k_max. exp k* of_bool(f i\<ge>exp k)))"
      unfolding b_def
      by (subst sum_distrib_left) simp
    also have "... = ?a+b*(\<Sum>i=0..<l. (\<Sum>k=3..<k_max. exp k* of_bool(f (w ! i)\<ge>exp k)))"
      unfolding sum_list_sum_nth by (simp add:l_w sum_distrib_left[symmetric])
    also have "... = ?R1"
      by (subst sum.swap) (simp add:ac_simps Int_def)
    finally show ?thesis by simp
  qed

  have 3: "\<exists>k\<in>{3..<k_max}. g k \<ge> l/real k^2" if "(\<Sum>k=3..<k_max. g k) \<ge> real l" for g
  proof (rule ccontr)
    assume a3: "\<not>(\<exists>k\<in>{3..<k_max}. g k \<ge> l/real k^2)"
    hence "g k < l/real k^2" if "k \<in>{3..<k_max}" for k
      using that by force
    hence "(\<Sum>k=3..<k_max. g k) < (\<Sum>k=3..<k_max. l/real k^2)"
      using k_max_ge_4 by (intro sum_strict_mono) auto
    also have "... \<le> (\<Sum>k=3..<k_max. l/ (real k*(real k-1)))"
      by (intro sum_mono divide_left_mono) (auto simp:power2_eq_square)
    also have "... = l * (\<Sum>k=3..<k_max. 1 / (real k-1) - 1/k)"
      by (simp add:sum_distrib_left field_simps)
    also have "... = l * (\<Sum>k=2+1..<(k_max-1)+1. (-1)/k - (-1) / (real k-1))"
      by (intro sum.cong arg_cong2[where f="(*)"]) auto
    also have "... = l * (\<Sum>k=2..<(k_max-1). (-1)/(Suc k) - (-1) / k)"
      by (subst sum.shift_bounds_nat_ivl) auto
    also have "... = l * (1/2 - 1 / real (k_max - 1))"
      using k_max_ge_3 by (subst sum_Suc_diff') auto
    also have "... \<le> real l * (1 - 0)"
       by (intro mult_left_mono diff_mono) auto
    also have "... = l"
      by simp
    finally have "(\<Sum>k=3..<k_max. g k) < l" by simp
    thus "False"
      using that by simp
  qed

  have 4: "L k \<le> exp(-real l-k+2)" if "k \<ge> 3" for k
  proof (cases "k \<le> ln l")
    case True
    define \<gamma> where "\<gamma> = 1 / (real k)\<^sup>2 / exp (real k)"
    define S where "S = {v \<in> verts G. f v \<ge> exp (real k)}"
    define \<mu> where "\<mu> = card S / card (verts G)"

    have exp_k_ubound: "exp (real k) \<le> real l"
      using True assms(1)
      by (simp add: ln_ge_iff)

    have "20 \<le> exp (3::real)"
      by (approximation 10)
    also have "... \<le> exp (real k)"
      using that by simp
    finally have exp_k_lbound: "20 \<le> exp (real k)"
      by simp

    have S_range: "S \<subseteq> verts G"
      unfolding S_def by simp

    have "\<mu> = measure (pmf_of_set (verts G)) S"
      unfolding \<mu>_def using verts_non_empty Int_absorb1[OF S_range]
      by (simp add:measure_pmf_of_set)
    also have "... = measure (pmf_of_set (verts G)) {v. f v \<ge> exp (real k)}"
      unfolding S_def using verts_non_empty by (intro measure_pmf_cong) auto
    also have "... \<le> exp (- exp (real k) * ln (exp (real k)) ^ 3)"
      by (intro assms(3) exp_k_lbound)
    also have "... = exp (-(exp(real k) * real k^3))"
      by simp
    finally have \<mu>_bound: "\<mu> \<le> exp (-exp(real k) * real k^3)" by simp

    have "\<mu>+\<Lambda> \<le> exp (-exp(real k) * real k^3) + exp (- real l * ln (real l) ^ 3)"
      unfolding \<Lambda>_def by (intro add_mono \<mu>_bound) auto
    also have "... =  exp (-(exp(real k) * real k^3)) + exp (- (real l * ln (real l) ^ 3))"
      by simp
    also have "... \<le> exp (-(exp(real k) * real k^3)) + exp (-(exp(real k) * ln(exp (real k))^3))"
      using assms(1) exp_k_ubound by (intro add_mono iffD2[OF exp_le_cancel_iff] le_imp_neg_le
          mult_mono power_mono iffD2[OF ln_le_cancel_iff]) simp_all
    also have "... = 2 * exp (-exp(real k) * real k^3)"
      by simp
    finally have \<mu>_\<Lambda>_bound: "\<mu>+\<Lambda> \<le> 2 * exp (-exp(real k) * real k^3)"
      by simp

    have "\<mu>+\<Lambda> \<le> 2 * exp (-exp(real k) * real k^3)"
      by (intro \<mu>_\<Lambda>_bound)
    also have "... = exp (-exp(real k) * real k^3 + ln 2)"
      unfolding exp_add by simp
    also have "... = exp (-(exp(real k) * real k^3 - ln 2))"
      by simp
    also have "... \<le> exp (-((1+ real k) * real k^3 - ln 2))"
      using that by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le diff_mono mult_right_mono
          exp_ge_add_one_self_aux) auto
    also have "... = exp (-(real k^4 + (real k^3- ln 2)))"
      by (simp add:power4_eq_xxxx power3_eq_cube algebra_simps)
    also have "... \<le> exp (-(real k^4 + (2^3- ln 2)))" using that
      by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le add_mono diff_mono power_mono) auto
    also have "... \<le> exp (-(real k^4 + 0))"
      by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le add_mono order.refl) (approximation 5)
    also have "... \<le> exp (-(real k^3 * real k))"
      by (simp add:power4_eq_xxxx power3_eq_cube algebra_simps)
    also have "... \<le> exp (-(2^3 * real k))" using that
      by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le mult_right_mono power_mono) auto
    also have "... \<le> exp (-3* real k )"
      by (intro iffD2[OF exp_le_cancel_iff]) auto
    also have "... = exp (-(real k + 2 * real k) )"
      by simp
    also have "... \<le> exp (-(real k + 2 * ln k) )"
      using that
      by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le add_mono mult_left_mono ln_bound) auto
    also have "... = exp (-(real k + ln(k^2)) )"
      using that by (subst ln_powr[symmetric]) auto
    also have "... = \<gamma>"
      using that unfolding \<gamma>_def exp_minus exp_add inverse_eq_divide
      by (simp add:algebra_simps)
    finally have \<mu>_\<Lambda>_le_\<gamma>: "\<mu>+\<Lambda>\<le>\<gamma>"
      by simp

    have "\<mu> \<ge> 0"
      unfolding \<mu>_def n_def[symmetric] using n_gt_0
      by (intro divide_nonneg_pos) auto
    hence \<mu>_\<Lambda>_gt_0: "\<mu>+\<Lambda>>0"
      using \<Lambda>_gt_0 by simp

    have "\<gamma> = 1 / ((real k)\<^sup>2 * exp (real k))"
      unfolding \<gamma>_def by simp
    also have "... \<le> 1 / (2^2 * exp 2)"
      using that by (intro divide_left_mono mult_mono power_mono) (auto)
    finally have \<gamma>_ubound: "\<gamma> \<le> 1 / (4 * exp 2)"
      by simp

    have "\<gamma> \<le> 1 / (4 * exp 2)"
      by (intro \<gamma>_ubound)
    also have "... < 1"
      by (approximation 5)
    finally have \<gamma>_lt_1: "\<gamma> < 1"
      by simp

    have \<gamma>_ge_0: "\<gamma> \<ge> 0"
      using that unfolding \<gamma>_def by (intro divide_nonneg_pos) auto

    have "L k = measure ?w {w. \<gamma>*l \<le> real (card {i \<in> {..<l}. exp (real k) \<le> f (w ! i)})}"
      unfolding L_def \<gamma>_def using that
      by (intro_cong "[\<sigma>\<^sub>2 measure]" more:Collect_cong) (simp add:field_simps)
    also have "... = measure ?w {w. \<gamma>*l \<le> real (card {i \<in> {..<l}. w ! i \<in> S})}"
    proof (rule measure_pmf_cong)
      fix x assume "x \<in> set_pmf ?w"
      hence "card {i \<in> {..<l}. exp (real k) \<le> f (x ! i)}=card {i \<in> {..<l}. x ! i \<in> S}"
        using walks_nonempty set_walks_3[of "x"] nth_mem unfolding S_def
        by (intro restr_Collect_cong arg_cong[where f="card"]) force
      thus "x\<in>{w. \<gamma>*l\<le>card{i\<in>{..<l}. exp k\<le>f (w ! i)}}\<longleftrightarrow>x\<in>{w. \<gamma>*l\<le>card {i \<in> {..<l}. w ! i \<in> S}}"
        by simp
    qed
    also have "... \<le> exp (- real l * (\<gamma> * ln (1/(\<mu>+\<Lambda>)) - 2 * exp(-1)))"
      using \<mu>_\<Lambda>_le_\<gamma> \<gamma>_lt_1 S_range \<Lambda>\<^sub>a_le_\<Lambda> \<Lambda>_gt_0 unfolding \<mu>_def
      by (intro walk_tail_bound_2 assms(1)) auto
    also have "... = exp ( real l * (\<gamma> * ln (\<mu>+\<Lambda>) + 2 * exp (-1)))"
      using \<mu>_\<Lambda>_gt_0 by (simp_all add:ln_div algebra_simps)
    also have "... \<le> exp ( real l * (\<gamma> * ln (2 * exp (-exp(real k) * real k^3)) + 2 * exp(-1)))"
      using \<mu>_\<Lambda>_gt_0 \<mu>_\<Lambda>_bound \<gamma>_ge_0
      by (intro iffD2[OF exp_le_cancel_iff] mult_left_mono add_mono iffD2[OF ln_le_cancel_iff])
       simp_all
    also have "... = exp (real l * (\<gamma> * (ln 2 - exp (real k) * real k ^ 3) + 2 * exp (- 1)))"
      by (simp add:ln_mult)
    also have "... = exp (real l * (\<gamma> * ln 2 - real k + 2 * exp (- 1)))"
      using that unfolding \<gamma>_def by (simp add:field_simps power2_eq_square power3_eq_cube)
    also have "... \<le> exp (real l * (ln 2 / (4 * exp 2) - real k + 2 * exp (-1)))"
      using \<gamma>_ubound by (intro iffD2[OF exp_le_cancel_iff] mult_left_mono add_mono diff_mono)
        (auto simp:divide_simps)
    also have "... = exp (real l * (ln 2 / (4 * exp 2) + 2 *exp(-1) - real k))"
      by simp
    also have "... \<le> exp (real l * (1 - real k))"
      by (intro iffD2[OF exp_le_cancel_iff] mult_left_mono diff_mono order.refl of_nat_0_le_iff)
       (approximation 12)
    also have "... \<le> exp (-real l - real k + 2)"
    proof (intro iffD2[OF exp_le_cancel_iff])
      have "1 * (real k-2) \<le> real l * (real k-2)"
        using assms(1) that by (intro mult_right_mono) auto
      thus "real l * (1 - real k) \<le> - real l - real k + 2"
        by argo
    qed
    finally show ?thesis by simp
  next
    case False
    hence k_gt_l: "k \<ge> ln l" by simp
    define \<gamma> where "\<gamma> = 1 / (real k)\<^sup>2 / exp (real k)"

    have "20 \<le> exp (3::real)"
      by (approximation 10)
    also have "... \<le> exp (real k)"
      using that by simp
    finally have exp_k_lbound: "20 \<le> exp (real k)"
      by simp

    have \<gamma>_gt_0: "0 < \<gamma>"
      using that unfolding \<gamma>_def by (intro divide_pos_pos) auto

    hence \<gamma>_l_gt_0: "0 < \<gamma> * real l"
      using assms(1) by auto

    have "L k = measure ?w {w. \<gamma>*l \<le> real (card {i \<in> {..<l}. exp (real k) \<le> f (w ! i)})}"
      unfolding L_def \<gamma>_def using that
      by (intro_cong "[\<sigma>\<^sub>2 measure]" more:Collect_cong) (simp add:field_simps)
    also have "... \<le> (\<integral>w. real (card {i \<in> {..<l}. exp (real k) \<le> f (w ! i)}) \<partial>?w) / (\<gamma>*l)"
      using walks_nonempty \<gamma>_l_gt_0
      by (intro pmf_markov integrable_measure_pmf_finite) simp_all
    also have "... = (\<integral>w. (\<Sum>i<l. of_bool (exp(real k) \<le> f (w ! i)))\<partial>?w) / (\<gamma>*l)"
      by (intro_cong "[\<sigma>\<^sub>2 (/)]" more:integral_cong_AE AE_pmfI) (auto simp add:Int_def)
    also have "... = (\<Sum>i<l. (\<integral>w. of_bool (exp(real k) \<le> f (w ! i))\<partial>?w)) / (\<gamma>*l)"
      using walks_nonempty
      by (intro_cong "[\<sigma>\<^sub>2 (/)]" more:integral_sum integrable_measure_pmf_finite) auto
    also have "... = (\<Sum>i<l. (\<integral>v. of_bool (exp(real k) \<le> f v)\<partial>(map_pmf (\<lambda>w. w!i) ?w))) / (\<gamma>*l)"
      by simp
    also have "... = (\<Sum>i<l. (\<integral>v. of_bool (exp(real k) \<le> f v)\<partial>?p)) / (\<gamma>*l)"
      by (intro_cong "[\<sigma>\<^sub>2(/),\<sigma>\<^sub>2(integral\<^sup>L),\<sigma>\<^sub>1 measure_pmf]" more:sum.cong uniform_property) auto
    also have "... = (\<Sum>i<l. (\<integral>v. indicat_real {v. (exp(real k) \<le> f v)} v\<partial>?p)) / (\<gamma>*l)"
      by (intro_cong "[\<sigma>\<^sub>2(/),\<sigma>\<^sub>2(integral\<^sup>L)]" more:sum.cong) auto
    also have "... = (\<Sum>i<l. (measure ?p {v. f v \<ge> exp (real k)})) / (\<gamma>*l)"
      by simp
    also have "... \<le> (\<Sum>i<l. exp (- exp (real k) * ln (exp (real k)) ^ 3)) / (\<gamma>*l)"
      using \<gamma>_l_gt_0 by (intro divide_right_mono sum_mono assms(3) exp_k_lbound) auto
    also have "... = exp (- exp (real k) * real k ^ 3) / \<gamma>"
      using assms(1) by simp
    also have "... = exp (real k + ln (k^2) - exp (real k) * real k ^ 3)"
      using that unfolding \<gamma>_def
      by (simp add:exp_add exp_diff exp_minus algebra_simps inverse_eq_divide)
    also have "... = exp (real k + 2 * ln k - exp (real k) * real k ^ 3)"
      using that by (subst ln_powr[symmetric]) auto
    also have "... \<le> exp (real k + 2 * real k - exp (ln l) * real k^3)"
      using that k_gt_l ln_bound
      by (intro iffD2[OF exp_le_cancel_iff] add_mono diff_mono mult_left_mono mult_right_mono) auto
    also have "... = exp (3* real k - l * (real k^3-1) -l)"
      using assms(1) by (subst exp_ln) (auto simp add:algebra_simps)
    also have "... \<le> exp (3* real k - 1 * (real k^3-1) -l)"
      using assms(1) that by (intro iffD2[OF exp_le_cancel_iff] diff_mono mult_right_mono) auto
    also have "... = exp (3* real k - real k * real k^2-1 -l+2)"
      by (simp add:power2_eq_square power3_eq_cube)
    also have "... \<le> exp (3* real k - real k * 2^2-0 -l+2)"
      using assms(1) that
      by (intro iffD2[OF exp_le_cancel_iff] add_mono diff_mono mult_left_mono power_mono) auto
    also have "... = exp (- real l - real k + 2)"
      by simp
    finally show ?thesis by simp
  qed

  have "?L \<le> measure ?w
    {w. ?a+b*(\<Sum>k=3..<k_max. exp (real k) * card {i\<in>{..<l}. f (w!i)\<ge>exp (real k)}) \<ge> C\<^sub>1*l}"
    using order_trans[OF _ 2] walks_nonempty by (intro pmf_mono) simp
  also have "... = measure ?w
    {w. (\<Sum>k=3..<k_max. exp(real k)*card{i\<in>{..<l}.f(w!i)\<ge>exp(real k)})\<ge>l}"
    unfolding C\<^sub>1_def b_def[symmetric] using b_gt_0
    by (intro_cong "[\<sigma>\<^sub>2 measure]" more:Collect_cong) (simp add:algebra_simps)
  also have "... \<le> measure ?w
    {w. (\<exists>k\<in>{3..<k_max}. exp (real k)*card{i\<in>{..<l}.f(w!i)\<ge>exp(real k)} \<ge> real l/real k^2)}"
    using 3 by (intro pmf_mono) simp
  also have "... = measure ?w
    (\<Union>k\<in>{3..<k_max}. {w. exp (real k)*card{i\<in>{..<l}.f(w!i)\<ge>exp(real k)} \<ge> real l/real k^2})"
    by (intro_cong "[\<sigma>\<^sub>2 measure]") auto
  also have "... \<le> (\<Sum>k=3..<k_max. L k)"
    unfolding L_def
    by (intro finite_measure.finite_measure_subadditive_finite) auto
  also have "... \<le> (\<Sum>k=3..<k_max. exp (- real l - real k + 2))"
    by (intro sum_mono 4) auto
  also have "... = (\<Sum>k=0+3..<(k_max-3)+3. exp (- real l - real k + 2))"
    using k_max_ge_3 by (intro sum.cong) auto
  also have "... = (\<Sum>k=0..<k_max-3. exp (-1 - real l - real k))"
    by (subst sum.shift_bounds_nat_ivl) ( simp add:algebra_simps)
  also have "... = exp(-1-real l) * (\<Sum>k<k_max-3. exp (real k*(-1)))"
    using atLeast0LessThan
    by (simp add:exp_diff exp_add sum_distrib_left exp_minus inverse_eq_divide)
  also have "... = exp (-1-real l) * ((exp (- 1) ^ (k_max - 3) - 1) / (exp (- 1) - 1))"
    unfolding exp_of_nat_mult by (subst geometric_sum) auto
  also have "... = exp(-1-real l) * (1-exp (- 1) ^ (k_max - 3)) / (1-exp (- 1))"
    by (simp add:field_simps)
  also have "... \<le> exp(-1-real l) * (1-0) / (1-exp (- 1))"
    using k_max_ge_3
    by (intro mult_left_mono divide_right_mono diff_mono) auto
  also have "... = exp (-real l) * (exp (-1) / (1-exp(-1)))"
    by (simp add:exp_diff exp_minus inverse_eq_divide)
  also have "... \<le> exp (-real l) * 1"
    by (intro mult_left_mono exp_ge_zero) (approximation 10)
  finally show ?thesis
    by simp
qed

lemma (in expander_sample_space) deviation_bound:
  fixes f :: "'a \<Rightarrow> real"
  assumes "l > 0"
  assumes "\<Lambda> \<le> exp (-real l * ln (real l)^3)"
  assumes "\<And>x. x \<ge> 20 \<Longrightarrow> measure (sample_pmf S) {v. f v \<ge> x} \<le> exp (-x * ln x^3)"
  shows "measure (\<E> l \<Lambda> S) {\<omega>. (\<Sum>i<l. f (\<omega> i)) \<ge> C\<^sub>1 * l} \<le> exp (- real l)"  (is "?L \<le> ?R")
proof -
  let ?w = "pmf_of_multiset (walks (graph_of e) l)"

  have "E.\<Lambda>\<^sub>a \<le> \<Lambda>"
    using see_standard(1) unfolding is_expander_def e_def by simp
  also have "... \<le>  exp (- real l * ln (real l) ^ 3)"
    using assms(2) by simp
  finally have 0: "E.\<Lambda>\<^sub>a \<le> exp (- real l * ln (real l) ^ 3)"
    by simp

  have 1: "measure (pmf_of_set (verts (graph_of e))) {v. x \<le> f (select S v)} \<le> exp (- x*ln x^3)"
    (is "?L1 \<le> ?R1") if "x \<ge> 20" for x
  proof -
    have "?L1 = measure (map_pmf (select S) (pmf_of_set {..<size S})) {v. x \<le> f v}"
      using see_standard(2) unfolding e_def graph_of_def by simp
    also have "... = measure (sample_pmf S) {v. x \<le> f v}"
      unfolding sample_pmf_alt[OF sample_space_S] by simp
    also have "... \<le> ?R1"
      by (intro assms(3) that)
    finally show ?thesis
      by simp
  qed

  have "?L = measure ?w {w. C\<^sub>1 * real l \<le> (\<Sum>i<l. f (select S (w ! i)))}"
    unfolding walks by simp
  also have "... = measure ?w {ws. C\<^sub>1 * real l \<le> (\<Sum>w\<leftarrow>ws. f (select S w))}"
    using E.walks_nonempty E.set_walks_3 atLeast0LessThan
    unfolding sum_list_sum_nth by (intro measure_pmf_cong) simp
  also have "... \<le> ?R"
    by (intro E.deviation_bound assms(1) 0 1)
  finally show ?thesis by simp
qed

unbundle no_intro_cong_syntax

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_list_elem
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun x :: "'a list => int => 'a" where
"x y z =
   (case z < 0 of
      False =>
        (case y of cons2 z2 x2 => (if (z = 0) then z2 else x x2 (z - 1))))"

fun elem :: "'a => 'a list => bool" where
"elem y (nil2) = False"
| "elem y (cons2 z2 xs) = ((z2 = y) | (elem y xs))"

theorem property0 :
  "((elem y xs) ==> (? (z :: int) . (y = (x xs z))))"
  oops

end


theory weird_nat_add3_rrot
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Nat = Z | S "Nat"

fun add3 :: "Nat => Nat => Nat => Nat" where
"add3 (Z) (Z) z = z"
| "add3 (Z) (S y2) z = S (add3 Z y2 z)"
| "add3 (S x2) y z = S (add3 x2 y z)"

(*hipster add3 *)

theorem x0 :
  "!! (x :: Nat) (y :: Nat) (z :: Nat) . (add3 x y z) = (add3 z x y)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


(*  Title:      ZF/UNITY/State.thy
    Author:     Sidi O Ehmety, Computer Laboratory
    Copyright   2001  University of Cambridge

Formalizes UNITY-program states using dependent types so that:
 - variables are typed.
 - the state space is uniform, common to all defined programs.
 - variables can be quantified over.
*)

section\<open>UNITY Program States\<close>

theory State imports ZF begin

consts var :: i
datatype var = Var("i \<in> list(nat)")
  type_intros  nat_subset_univ [THEN list_subset_univ, THEN subsetD]

consts
  type_of :: "i\<Rightarrow>i"
  default_val :: "i\<Rightarrow>i"

definition
  "state \<equiv> \<Prod>x \<in> var. cons(default_val(x), type_of(x))"

definition
  "st0 \<equiv> \<lambda>x \<in> var. default_val(x)"

definition
  st_set  :: "i\<Rightarrow>o"  where
(* To prevent typing conditions like `A<=state' from
   being used in combination with the rules `constrains_weaken', etc. *)
  "st_set(A) \<equiv> A<=state"

definition
  st_compl :: "i\<Rightarrow>i"  where
  "st_compl(A) \<equiv> state-A"

lemma st0_in_state [simp,TC]: "st0 \<in> state"
by (simp add: state_def st0_def)

lemma st_set_Collect [iff]: "st_set({x \<in> state. P(x)})"
by (simp add: st_set_def, auto)

lemma st_set_0 [iff]: "st_set(0)"
by (simp add: st_set_def)

lemma st_set_state [iff]: "st_set(state)"
by (simp add: st_set_def)

(* Union *)

lemma st_set_Un_iff [iff]: "st_set(A \<union> B) \<longleftrightarrow> st_set(A) \<and> st_set(B)"
by (simp add: st_set_def, auto)

lemma st_set_Union_iff [iff]: "st_set(\<Union>(S)) \<longleftrightarrow> (\<forall>A \<in> S. st_set(A))"
by (simp add: st_set_def, auto)

(* Intersection *)

lemma st_set_Int [intro!]: "st_set(A) | st_set(B) \<Longrightarrow> st_set(A \<inter> B)"
by (simp add: st_set_def, auto)

lemma st_set_Inter [intro!]:
   "(S=0) | (\<exists>A \<in> S. st_set(A)) \<Longrightarrow> st_set(\<Inter>(S))"
apply (simp add: st_set_def Inter_def, auto)
done

(* Diff *)
lemma st_set_DiffI [intro!]: "st_set(A) \<Longrightarrow> st_set(A - B)"
by (simp add: st_set_def, auto)

lemma Collect_Int_state [simp]: "Collect(state,P) \<inter> state = Collect(state,P)"
by auto

lemma state_Int_Collect [simp]: "state \<inter> Collect(state,P) = Collect(state,P)"
by auto

(* Introduction and destruction rules for st_set *)

lemma st_setI: "A \<subseteq> state \<Longrightarrow> st_set(A)"
by (simp add: st_set_def)

lemma st_setD: "st_set(A) \<Longrightarrow> A<=state"
by (simp add: st_set_def)

lemma st_set_subset: "\<lbrakk>st_set(A); B<=A\<rbrakk> \<Longrightarrow> st_set(B)"
by (simp add: st_set_def, auto)

lemma state_update_type:
     "\<lbrakk>s \<in> state; x \<in> var; y \<in> type_of(x)\<rbrakk> \<Longrightarrow> s(x:=y):state"
apply (simp add: state_def)
apply (blast intro: update_type)
done

lemma st_set_compl [simp]: "st_set(st_compl(A))"
by (simp add: st_compl_def, auto)

lemma st_compl_iff [simp]: "x \<in> st_compl(A) \<longleftrightarrow> x \<in> state \<and> x \<notin> A"
by (simp add: st_compl_def)

lemma st_compl_Collect [simp]:
     "st_compl({s \<in> state. P(s)}) = {s \<in> state. \<not>P(s)}"
by (simp add: st_compl_def, auto)

(*For using "disjunction" (union over an index set) to eliminate a variable.*)
lemma UN_conj_eq:
     "\<forall>d\<in>D. f(d) \<in> A \<Longrightarrow> (\<Union>k\<in>A. {d\<in>D. P(d) \<and> f(d) = k}) = {d\<in>D. P(d)}"
by blast

end