(*  Title:       Formalization of Schneider's generalized clock synchronization protocol.
    Author:      Alwen Tiu, LORIA, June 11, 2005
    Maintainer:  Alwen Tiu <Alwen.Tiu at loria.fr>
*)

theory GenClock imports Complex_Main begin

subsection\<open>Types and constants definitions\<close>

text\<open>Process is represented by natural numbers. The type 'event' corresponds
to synchronization rounds.\<close>

type_synonym process = nat
type_synonym event = nat      (* synchronization rounds *)
type_synonym time = real
type_synonym Clocktime = real

axiomatization
  \<delta> :: real and
  \<mu> :: real and
  \<rho> :: real and
  rmin :: real and
  rmax :: real and
  \<beta> :: real and
  \<Lambda> :: real and
  (* Number of processes *)
  np :: process and
  maxfaults :: process and
  (* Physical clocks *)
  PC :: "[process, time] \<Rightarrow> Clocktime" and
  (* Virtual / Logical clocks *)
  VC :: "[process, time] \<Rightarrow> Clocktime" and
  (* Starting (real) time of synchronization rounds *)
  te :: "[process, event] \<Rightarrow> time" and
  (* Clock readings at each round *)
  \<theta> :: "[process, event] \<Rightarrow> (process \<Rightarrow> Clocktime)" and
  (* Logical clock in-effect at a time interval *)
  IC :: "[process, event, time] \<Rightarrow> Clocktime" and
  (* Correct clocks *)
  correct :: "[process, time] \<Rightarrow> bool" and
  (* The averaging function to calculate clock adjustment *)
  cfn :: "[process, (process \<Rightarrow> Clocktime)] \<Rightarrow> Clocktime" and

  \<pi> :: "[Clocktime, Clocktime] \<Rightarrow> Clocktime" and

  \<alpha> :: "Clocktime \<Rightarrow> Clocktime"

definition
  count :: "[process \<Rightarrow> bool, process] \<Rightarrow> nat" where
  "count f n = card {p. p < n \<and> f p}"

definition
  (* Adjustment to a clock *)
  Adj :: "[process, event] \<Rightarrow> Clocktime" where
  "Adj = (\<lambda> p i. if 0 < i then cfn p (\<theta> p i) - PC p (te p i)
                 else 0)"

definition
  (* Auxilary predicates used in the definition of precision enhancement *)
  okRead1 :: "[process \<Rightarrow> Clocktime, Clocktime, process \<Rightarrow> bool] \<Rightarrow> bool" where
  "okRead1 f x ppred \<longleftrightarrow> (\<forall> l m. ppred l \<and> ppred m \<longrightarrow> \<bar>f l - f m\<bar> \<le> x)"

definition
  okRead2 :: "[process \<Rightarrow> Clocktime, process \<Rightarrow> Clocktime, Clocktime,
               process \<Rightarrow> bool] \<Rightarrow> bool" where
  "okRead2 f g x ppred \<longleftrightarrow> (\<forall> p. ppred p \<longrightarrow> \<bar>f p - g p\<bar> \<le> x)"

definition
  rho_bound1 :: "[[process, time] \<Rightarrow> Clocktime] \<Rightarrow> bool" where
  "rho_bound1 C \<longleftrightarrow> (\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> C p t - C p s \<le> (t - s)*(1 + \<rho>))"
definition
  rho_bound2 :: "[[process, time] \<Rightarrow> Clocktime] \<Rightarrow> bool" where
  "rho_bound2 C \<longleftrightarrow> (\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> (t - s)*(1 - \<rho>) \<le> C p t - C p s)"

subsection\<open>Clock conditions\<close>

text\<open>Some general assumptions\<close>
axiomatization where
  constants_ax: "0 < \<beta> \<and> 0 < \<mu> \<and> 0 < rmin
  \<and> rmin \<le> rmax \<and> 0 < \<rho> \<and> 0 < np \<and> maxfaults \<le> np"

axiomatization where
  PC_monotone: "\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> PC p s \<le> PC p t"

axiomatization where
  VClock: "\<forall> p t i. correct p t \<and> te p i \<le> t \<and> t < te p (i + 1) \<longrightarrow> VC p t = IC p i t"

axiomatization where
  IClock: "\<forall> p t i. correct p t \<longrightarrow> IC p i t = PC p t + Adj p i"

text\<open>Condition 1: initial skew\<close>
axiomatization where
  init: "\<forall> p. correct p 0 \<longrightarrow> 0 \<le> PC p 0 \<and> PC p 0 \<le> \<mu>"

text\<open>Condition 2: bounded drift\<close>
axiomatization where
  rate_1: "\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> PC p t - PC p s \<le> (t - s)*(1 + \<rho>)" and
  rate_2: "\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> (t - s)*(1 - \<rho>) \<le> PC p t - PC p s"

text\<open>Condition 3: bounded interval\<close>
axiomatization where
  rts0: "\<forall> p t i. correct p t \<and> t \<le> te p (i+1) \<longrightarrow> t - te p i \<le> rmax" and
  rts1: "\<forall> p t i. correct p t \<and> te p (i+1) \<le> t \<longrightarrow> rmin \<le> t - te p i"

text\<open>Condition 4 : bounded delay\<close>
axiomatization where
  rts2a: "\<forall> p q t i. correct p t \<and> correct q t \<and> te q i + \<beta> \<le> t \<longrightarrow> te p i \<le> t"  and
  rts2b: "\<forall> p q i. correct p (te p i) \<and> correct q (te q i) \<longrightarrow> abs(te p i - te q i) \<le> \<beta>"

text\<open>Condition 5: initial synchronization\<close>
axiomatization where
  synch0: "\<forall> p. te p 0 = 0"

text\<open>Condition 6: nonoverlap\<close>
axiomatization where
  nonoverlap: "\<beta> \<le> rmin"

text\<open>Condition 7: reading errors\<close>
axiomatization where
  readerror: "\<forall> p q i. correct p (te p (i+1)) \<and> correct q (te p (i+1)) \<longrightarrow>
              abs(\<theta> p (i+1) q - IC q i (te p (i+1))) \<le> \<Lambda>"

text\<open>Condition 8: bounded faults\<close>
axiomatization where
  correct_closed: "\<forall> p s t. s \<le> t \<and> correct p t \<longrightarrow> correct p s" and
  correct_count:  "\<forall> t. np - maxfaults \<le> count (\<lambda> p. correct p t) np"

text\<open>Condition 9: Translation invariance\<close>
axiomatization where
  trans_inv: "\<forall> p f x. 0 \<le> x \<longrightarrow> cfn p (\<lambda> y. f y + x) = cfn p f + x"

text\<open>Condition 10: precision enhancement\<close>
axiomatization where
  prec_enh:
  "\<forall> ppred p q f g x y.
          np - maxfaults \<le> count ppred np \<and>
          okRead1 f y ppred \<and> okRead1 g y ppred \<and>
          okRead2 f g x ppred \<and> ppred p \<and> ppred q
      \<longrightarrow> abs(cfn p f - cfn q g) \<le> \<pi> x y"

text\<open>Condition 11: accuracy preservation\<close>
axiomatization where
  acc_prsv:
  "\<forall> ppred p q f x. okRead1 f x ppred \<and> np - maxfaults \<le> count ppred np
          \<and> ppred p \<and> ppred q \<longrightarrow> abs(cfn p f - f q) \<le> \<alpha> x"

subsubsection\<open>Some derived properties of clocks\<close>

lemma rts0d:
assumes cp: "correct p (te p (i+1))"
shows "te p (i+1) - te p i \<le> rmax"
using cp rts0 by simp

lemma rts1d:
assumes cp: "correct p (te p (i+1))"
shows "rmin \<le> te p (i+1) - te p i"
using cp rts1 by simp

lemma rte:
assumes cp: "correct p (te p (i+1))"
shows "te p i \<le> te p (i+1)"
proof-
  from cp rts1d have "rmin \<le> te p (i+1) - te p i"
    by simp
  from this constants_ax show ?thesis by arith
qed

lemma beta_bound1:
assumes corr_p: "correct p (te p (i+1))"
and corr_q: "correct q (te p (i+1))"
shows "0 \<le> te p (i+1) - te q i"
proof-
  from corr_p rte have "te p i \<le> te p (i+1)"
    by simp
  from this corr_p correct_closed have corr_pi: "correct p (te p i)"
    by blast
  from corr_p rts1d nonoverlap have "rmin \<le> te p (i+1) - te p i"
    by simp
  from this nonoverlap have "\<beta> \<le> te p (i+1) - te p i" by simp
  hence "te p i + \<beta> \<le> te p (i+1)" by simp

  from this corr_p corr_q rts2a
  have "te q i \<le> te p (i+1)"
    by blast
  thus ?thesis by simp
qed

lemma beta_bound2:
assumes corr_p: "correct p (te p (i+1))"
and corr_q: "correct q (te q i)"
shows "te p (i+1) - te q i \<le> rmax + \<beta>"
proof-
  from corr_p rte have "te p i \<le> te p (i+1)"
    by simp
  from this corr_p correct_closed have corr_pi: "correct p (te p i)"
    by blast

  have split: "te p (i+1) - te q i =
    (te p (i+1) - te p i) + (te p i - te q i)"
    by (simp)

  from corr_q corr_pi rts2b have Eq1: "abs(te p i - te q i) \<le> \<beta>"
    by simp
  have Eq2: "te p i - te q i \<le> \<beta>"
  proof cases
    assume "te q i \<le> te p i"
    from this Eq1 show ?thesis
      by (simp add: abs_if)
  next
    assume "\<not> (te q i \<le> te p i)"
    from this Eq1 show ?thesis
      by (simp add: abs_if)
  qed

  from corr_p rts0d have "te p (i+1) - te p i \<le> rmax"
    by simp
  from this split Eq2 show ?thesis by simp
qed

subsubsection\<open>Bounded-drift for logical clocks (IC)\<close>

lemma bd:
  assumes ie: "s \<le> t"
  and rb1: "rho_bound1 C"
  and rb2: "rho_bound2 D"
  and PC_ie: "D q t - D q s \<le> C p t - C p s"
  and corr_p: "correct p t"
  and corr_q: "correct q t"
  shows "\<bar> C p t - D q t \<bar>  \<le> \<bar> C p s - D q s \<bar> + 2*\<rho>*(t - s)"
proof-
  let ?Dt = "C p t - D q t"
  let ?Ds = "C p s - D q s"
  let ?Bp = "C p t - C p s"
  let ?Bq = "D q t - D q s"
  let ?I = "t - s"

  have "\<bar> ?Bp - ?Bq \<bar> \<le> 2*\<rho>*(t - s)"
  proof-
    from PC_ie have Eq1: "\<bar> ?Bp - ?Bq \<bar> = ?Bp - ?Bq" by (simp add: abs_if)
    from corr_p ie rb1 have Eq2: "?Bp - ?Bq \<le> ?I*(1+\<rho>) - ?Bq" (is "?E1 \<le> ?E2")
      by(simp add: rho_bound1_def)
    from corr_q ie rb2 have "?I*(1 - \<rho>) \<le> ?Bq"
      by(simp add: rho_bound2_def)
    from this have Eq3: "?E2 \<le> ?I*(1+\<rho>) - ?I*(1 - \<rho>)"
      by(simp)
    have Eq4: "?I*(1+\<rho>) - ?I*(1 - \<rho>) = 2*\<rho>*?I"
      by(simp add: algebra_simps)
    from Eq1 Eq2 Eq3 Eq4 show ?thesis by simp
  qed
  moreover
  have "\<bar>?Dt\<bar>  \<le> \<bar>?Bp - ?Bq\<bar>  + \<bar>?Ds\<bar>"
    by(simp add: abs_if)
  ultimately show ?thesis by simp
qed

lemma bounded_drift:
  assumes ie: "s \<le> t"
  and rb1: "rho_bound1 C"
  and rb2: "rho_bound2 C"
  and rb3: "rho_bound1 D"
  and rb4: "rho_bound2 D"
  and corr_p: "correct p t"
  and corr_q: "correct q t"
  shows "\<bar>C p t - D q t\<bar> \<le> \<bar>C p s - D q s\<bar>  + 2*\<rho>*(t - s)"
proof-
  let ?Bp = "C p t - C p s"
  let ?Bq = "D q t - D q s"

  show ?thesis
  proof cases
    assume "?Bq \<le> ?Bp"
    from this ie rb1 rb4 corr_p corr_q bd show ?thesis by simp
  next
    assume "\<not> (?Bq \<le> ?Bp)"
    hence "?Bp \<le> ?Bq" by simp
    from this ie rb2 rb3 corr_p corr_q bd
    have "\<bar>D q t - C p t\<bar>  \<le> \<bar>D q s - C p s\<bar> + 2*\<rho>*(t - s)"
      by simp
    from this show ?thesis by (simp add: abs_minus_commute)
  qed
qed

text\<open>Drift rate of logical clocks\<close>

lemma IC_rate1:
"rho_bound1 (\<lambda> p t. IC p i t)"
proof-
  {
    fix p::process
    fix s::time
    fix t::time
    assume cp: "correct p t"
    assume ie: "s \<le> t"
    from cp ie correct_closed have cps: "correct p s"
      by blast
    have "IC p i t - IC p i s \<le> (t - s)*(1+\<rho>)"
    proof-
      from cp IClock have "IC p i t = PC p t + Adj p i"
        by simp
      moreover
      from cps IClock have "IC p i s = PC p s + Adj p i"
        by simp
      moreover
      from cp ie rate_1 have "PC p t - PC p s \<le> (t - s)*(1+\<rho>)"
        by simp
      ultimately show ?thesis by simp
    qed
  }
  thus ?thesis by (simp add: rho_bound1_def)
qed

lemma IC_rate2:
"rho_bound2 (\<lambda> p t. IC p i t)"
proof-
  {
    fix p::process
    fix s::time
    fix t::time
    assume cp: "correct p t"
    assume ie: "s \<le> t"
    from cp ie correct_closed have cps: "correct p s"
      by blast
    have "(t - s)*(1 - \<rho>) \<le> IC p i t - IC p i s"
    proof-
      from cp IClock have "IC p i t = PC p t + Adj p i"
        by simp
      moreover
      from cps IClock have "IC p i s = PC p s + Adj p i"
        by simp
      moreover
      from cp ie rate_2 have "(t - s)*(1-\<rho>) \<le> PC p t - PC p s"
        by simp
      ultimately show ?thesis by simp
    qed
  }
  thus ?thesis by (simp add: rho_bound2_def)
qed

text\<open>Auxilary function \<open>ICf\<close>: we introduce this to avoid some
unification problem in some tactic of isabelle.\<close>

definition
  ICf :: "nat \<Rightarrow> (process \<Rightarrow> time \<Rightarrow> Clocktime)" where
  "ICf i = (\<lambda> p t. IC p i t)"

lemma IC_bd:
  assumes ie: "s \<le> t"
  and corr_p: "correct p t"
  and corr_q: "correct q t"
  shows "\<bar>IC p i t - IC q j t\<bar> \<le> \<bar>IC p i s - IC q j s\<bar> + 2*\<rho>*(t - s)"
proof-
  let ?C = "ICf i"
  let ?D = "ICf j"
  let ?G = "\<bar>?C p t - ?D q t\<bar> \<le> \<bar>?C p s - ?D q s\<bar> + 2*\<rho>*(t - s)"

  from IC_rate1 have rb1: "rho_bound1 (ICf i) \<and> rho_bound1 (ICf j)"
    by (simp add: ICf_def)

  from IC_rate2 have rb2: "rho_bound2 (ICf i) \<and> rho_bound2 (ICf j)"
    by (simp add: ICf_def)

  from ie rb1 rb2 corr_p corr_q bounded_drift
  have ?G by simp

  from this show ?thesis by (simp add: ICf_def)
qed

lemma event_bound:
assumes ie1: "0 \<le> (t::real)"
and corr_p: "correct p t"
and corr_q: "correct q t"
shows "\<exists> i. t < max (te p i) (te q i)"
proof (rule ccontr)
  assume A: "\<not> (\<exists> i. t < max (te p i) (te q i))"
  show False
  proof-
    have F1: "\<forall> i. te p i \<le> t"
    proof
      fix i :: nat
      from A have "\<not> (t < max (te p i) (te q i))"
        by simp
      hence Eq1: "max (te p i) (te q i) \<le> t" by arith
      have Eq2: "te p i \<le> max (te p i) (te q i)"
        by (simp add: max_def)
      from Eq1 Eq2 show "te p i \<le> t" by simp
    qed

    have F2: "\<forall> (i :: nat). correct p (te p i)"
    proof
      fix i :: nat
      from F1 have "te p i \<le> t" by simp
      from this corr_p correct_closed
      show "correct p (te p i)" by blast
    qed

    have F3: "\<forall> (i :: nat). real i * rmin \<le> te p i"
    proof
      fix i :: nat
      show "real i * rmin \<le> te p i"
      proof (induct i)
        from synch0 show "real (0::nat) * rmin \<le> te p 0" by simp
      next
        fix i :: nat assume ind_hyp: "real i * rmin \<le> te p i"

        show "real (Suc i) * rmin \<le> te p (Suc i)"
        proof-

          have Eq1: "real i * rmin + rmin = (real i + 1)*rmin"
            by (simp add: distrib_right)
          have Eq2: "real i + 1 = real (i+1)" by simp
          from Eq1 Eq2
          have Eq3: "real i * rmin + rmin = real (i+1) * rmin"
            by presburger

          from F2 have cp1: "correct p (te p (i+1))"
            by simp
          from F2 have cp2: "correct p (te p i)"
            by simp
          from cp1 rts1d have "rmin \<le> te p (i+1) - te p i"
            by simp
          hence Eq4: "te p i + rmin \<le> te p (i+1)" by simp
          from ind_hyp have "real i * rmin + rmin \<le> te p i + rmin"
            by (simp)
          from this Eq4 have "real i * rmin + rmin \<le> te p (i+1)"
            by simp
          from this Eq3 show ?thesis by simp
        qed
      qed
    qed

    have F4: "\<forall> (i::nat). real i * rmin \<le> t"
    proof
      fix i::nat
      from F1 have "te p i \<le> t" by simp
      moreover
      from F3 have "real i * rmin \<le> te p i" by simp
      ultimately show "real i * rmin \<le> t" by simp
    qed

    from constants_ax have "0 < rmin" by simp

    from this reals_Archimedean3
    have Archi: "\<exists> (k::nat). t < real k * rmin"
      by blast

    from Archi obtain k::nat where C: "t < real k * rmin" ..

    from F4 have "real k * rmin \<le> t" by simp
    hence notC: "\<not> (t < real k * rmin)" by simp

    from C notC show False by simp
  qed
qed

subsection\<open>Agreement property\<close>

definition "\<gamma>1 x = \<pi> (2*\<rho>*\<beta> + 2*\<Lambda>) (2*\<Lambda> + x + 2*\<rho>*(rmax + \<beta>))"
definition "\<gamma>2 x = x + 2*\<rho>*rmax"
definition "\<gamma>3 x = \<alpha> (2*\<Lambda> + x + 2*\<rho>*(rmax + \<beta>)) + \<Lambda> + 2*\<rho>*\<beta>"

definition
  okmaxsync :: "[nat, Clocktime] \<Rightarrow> bool" where
  "okmaxsync i x \<longleftrightarrow> (\<forall> p q. correct p (max (te p i) (te q i))
     \<and> correct q (max (te p i) (te q i)) \<longrightarrow>
       \<bar>IC p i (max (te p i) (te q i)) - IC q i (max (te p i) (te q i))\<bar> \<le> x)"

definition
  okClocks :: "[process, process, nat] \<Rightarrow> bool" where
  "okClocks p q i \<longleftrightarrow> (\<forall> t. 0 \<le> t \<and> t < max (te p i) (te q i)
        \<and> correct p t \<and> correct q t
     \<longrightarrow> \<bar>VC p t - VC q t\<bar> \<le> \<delta>)"

lemma okClocks_sym:
assumes ok_pq: "okClocks p q i"
shows "okClocks q p i"
proof-
  {
    fix t :: time
    assume ie1: "0 \<le> t"
    assume ie2: "t < max (te q i) (te p i)"
    assume corr_q: "correct q t"
    assume corr_p: "correct p t"

    have "max (te q i) (te p i) = max (te p i) (te q i)"
      by (simp add: max_def)
    from this ok_pq ie1 ie2 corr_p corr_q
    have "\<bar>VC q t - VC p t\<bar> \<le> \<delta>"
      by(simp add: abs_minus_commute okClocks_def)
  }
  thus ?thesis by (simp add: okClocks_def)
qed

lemma ICp_Suc:
assumes corr_p: "correct p (te p (i+1))"
shows "IC p (i+1) (te p (i+1)) = cfn p (\<theta> p (i+1)) "
using corr_p IClock by(simp add: Adj_def)

lemma IC_trans_inv:
assumes ie1: "te q (i+1) \<le> te p (i+1)"
and corr_p: "correct p (te p (i+1))"
and corr_q: "correct q (te p (i+1))"
shows
"IC q (i+1) (te p (i+1)) =
  cfn q (\<lambda> n. \<theta> q (i+1) n + (PC q (te p (i+1)) - PC q (te q (i+1))))"
(is "?T1 = ?T2")
proof-
  let ?X = "PC q (te p (i+1)) - PC q (te q (i+1))"

  from corr_q ie1 PC_monotone have posX: "0 \<le> ?X"
    by (simp add: le_diff_eq)
  from IClock corr_q have "?T1 = cfn q (\<theta> q (i+1)) + ?X"
    by(simp add: Adj_def)

  from this posX trans_inv show ?thesis by simp
qed

lemma beta_rho:
assumes ie: "te q (i+1) \<le> te p (i+1)"
and corr_p: "correct p (te p (i+1))"
and corr_q: "correct q (te p (i+1))"
and corr_l: "correct l (te p (i+1))"
shows "\<bar>(PC l (te p (i+1)) - PC l (te q (i+1))) - (te p (i+1) - te q (i+1))\<bar> \<le> \<beta>*\<rho>"
proof-
  let ?X = "(PC l (te p (i+1)) - PC l (te q (i+1)))"
  let ?D = "te p (i+1) - te q (i+1)"

  from ie have posD: "0 \<le> ?D" by simp

  from ie PC_monotone corr_l have posX: "0 \<le> ?X"
    by (simp add: le_diff_eq)
  from ie corr_l rate_1 have bound1: "?X \<le> ?D * (1 + \<rho>)" by simp
  from ie corr_l correct_closed have corr_l_tq: "correct l (te q (i+1))"
    by(blast)
  from ie corr_q correct_closed have corr_q_tq: "correct q (te q (i+1))"
    by blast
  from corr_q_tq corr_p rts2b have "\<bar>?D\<bar> \<le> \<beta>"
    by(simp)
  from this constants_ax posD have D_beta: "?D*\<rho> \<le> \<beta>*\<rho>"
    by(simp add: abs_if)

  show ?thesis
  proof cases
    assume A: "?D \<le> ?X"
    from posX posD A have absEq: "\<bar>?X - ?D\<bar> = ?X - ?D"
      by(simp add: abs_if)
    from bound1 have bound2: "?X - ?D \<le> ?D*\<rho>"
      by(simp add: mult.commute distrib_right)
    from D_beta absEq bound2 show ?thesis by simp
  next
    assume notA: "\<not> (?D \<le> ?X)"
    from this have absEq2: "\<bar>?X - ?D\<bar> = ?D - ?X"
      by(simp add: abs_if)
    from ie corr_l rate_2 have bound3: "?D*(1 - \<rho>) \<le> ?X" by simp
    from this have "?D - ?X \<le> ?D*\<rho>" by (simp add: algebra_simps)
    from this absEq2 D_beta show ?thesis by simp
  qed
qed

text\<open>This lemma (and the next one pe-cond2) proves an assumption used
in the precision enhancement.\<close>

lemma pe_cond1:
assumes ie: "te q (i+1) \<le> te p (i+1)"
and corr_p: "correct p (te p (i+1))"
and corr_q: "correct q (te p (i + 1))"
and corr_l: "correct l (te p (i+1))"
shows "\<bar>\<theta> q (i+1) l + (PC q (te p (i+1)) - PC q (te q (i+1))) -
           \<theta> p (i+1) l\<bar> \<le> 2* \<rho> * \<beta> + 2*\<Lambda>"
(is "?M \<le> ?N")
proof-
  let ?Xl = "(PC l (te p (i+1)) - PC l (te q (i+1)))"
  let ?Xq = "(PC q (te p (i+1)) - PC q (te q (i+1)))"
  let ?D = "te p (i+1) - te q (i+1)"
  let ?T = "\<theta> p (i+1) l - \<theta> q (i+1) l"
  let ?RE1 = "\<theta> p (i+1) l - IC l i (te p (i+1))"
  let ?RE2 = "\<theta> q (i+1) l - IC l i (te q (i+1))"
  let ?ICT = "IC l i (te p (i+1)) - IC l i (te q (i+1))"

  have "?M = \<bar>(?Xq - ?D) - (?T - ?D)\<bar>"
  by(simp add: abs_if)

  hence Split: "?M \<le> \<bar>?Xq - ?D\<bar> + \<bar>?T - ?D\<bar>"
    by(simp add: abs_if)

  from ie corr_q correct_closed have corr_q_tq: "correct q (te q (i+1))"
    by(blast)
  from ie corr_l correct_closed have corr_l_tq: "correct l (te q (i+1))"
    by blast

  from corr_p corr_q corr_l ie beta_rho
  have XlD: "\<bar>?Xl - ?D\<bar> \<le> \<beta>*\<rho>"
    by simp

  from corr_p corr_q ie beta_rho
  have XqD: "\<bar>?Xq - ?D\<bar> \<le> \<beta>*\<rho>" by simp

  have TD: "\<bar>?T - ?D\<bar> \<le> 2*\<Lambda> + \<beta>*\<rho>"
  proof-
    have Eq1: "\<bar>?T - ?D\<bar> = \<bar>(?T - ?ICT) + (?ICT - ?D)\<bar>" (is "?E1 = ?E2")
      by (simp add: abs_if)

    have Eq2: "?E2 \<le> \<bar>?T - ?ICT\<bar> + \<bar>?ICT - ?D\<bar>"
      by(simp add: abs_if)

    have Eq3: "\<bar>?T - ?ICT\<bar> \<le>  \<bar>?RE1\<bar> + \<bar>?RE2\<bar>"
      by(simp add: abs_if)

    from readerror corr_p corr_l
    have Eq4: "\<bar>?RE1\<bar> \<le> \<Lambda>" by simp

    from corr_l_tq corr_q_tq this readerror
    have Eq5: "\<bar>?RE2\<bar> \<le> \<Lambda>" by simp

    from Eq3 Eq4 Eq5 have Eq6: "\<bar>?T - ?ICT\<bar> \<le> 2*\<Lambda>"
      by simp

    have Eq7: "?ICT - ?D = ?Xl - ?D"
    proof-
      from corr_p rte have "te p i \<le> te p (i+1)"
        by(simp)
      from this corr_l correct_closed have corr_l_tpi: "correct l (te p i)"
        by blast
      from corr_q_tq rte have "te q i \<le> te q (i+1)"
        by simp
      from this corr_l_tq correct_closed have corr_l_tqi: "correct l (te q i)"
        by blast

      from IClock corr_l
      have F1: "IC l i (te p (i+1)) = PC l (te p (i+1)) + Adj l i"
        by(simp)
      from IClock corr_l_tq
      have F2: "IC l i (te q (i+1)) = PC l (te q (i+1)) + Adj l i"
        by simp
      from F1 F2 show ?thesis by(simp)
    qed

    from this XlD have Eq8: "\<bar>?ICT - ?D\<bar> \<le> \<beta>*\<rho>"
      by arith
    from Eq1 Eq2 Eq6 Eq8 show ?thesis
      by(simp)
  qed

  from Split XqD TD have F1: "?M \<le> 2* \<beta> * \<rho> + 2*\<Lambda>"
    by(simp)
  have F2: "2 * \<rho> * \<beta> + 2*\<Lambda> = 2* \<beta> * \<rho> + 2*\<Lambda>"
    by simp
  from F1 show ?thesis by (simp only: F2)

qed

lemma pe_cond2:
assumes ie: "te m i \<le> te l i"
and corr_k: "correct k (te k (i+1))"
and corr_l_tk: "correct l (te k (i+1))"
and corr_m_tk: "correct m (te k (i+1))"
and ind_hyp: "\<bar>IC l i (te l i) - IC m i (te l i)\<bar> \<le> \<delta>S"
shows "\<bar>\<theta> k (i+1) l - \<theta> k (i+1) m\<bar> \<le> 2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
proof-
  let ?X = "\<theta> k (i+1) l - \<theta> k (i+1) m"
  let ?N = "2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
  let ?D1 = "\<theta> k (i+1) l - IC l i (te k (i+1))"
  let ?D2 = "\<theta> k (i+1) m - IC m i (te k (i+1))"
  let ?ICS = "IC l i (te k (i+1)) - IC m i (te k (i+1))"
  let ?tlm = "te l i"
  let ?IC = "IC l i ?tlm - IC m i ?tlm"

  have Eq1: "\<bar>?X\<bar> = \<bar>(?D1 - ?D2) + ?ICS\<bar>" (is "?E1 = ?E2")
    by (simp add: abs_if)

  have Eq2: "?E2 \<le> \<bar>?D1 - ?D2\<bar> + \<bar>?ICS\<bar>" by (simp add: abs_if)

  from corr_l_tk corr_k beta_bound1 have ie_lk: "te l i \<le> te k (i+1)"
    by (simp add: le_diff_eq)

  from this corr_l_tk correct_closed have corr_l: "correct l (te l i)"
    by blast

  from ie_lk corr_l_tk corr_m_tk IC_bd
  have Eq3: "\<bar>?ICS\<bar> \<le> \<bar>?IC\<bar> + 2*\<rho>*(te k (i+1) - ?tlm)"
    by simp
  from this ind_hyp have Eq4: "\<bar>?ICS\<bar> \<le> \<delta>S + 2*\<rho>*(te k (i+1) - ?tlm)"
    by simp

  from corr_l corr_k beta_bound2 have "te k (i+1) - ?tlm \<le> rmax + \<beta>"
    by simp
  from this constants_ax have "2*\<rho>*(te k (i+1) - ?tlm) \<le> 2*\<rho>*(rmax + \<beta>)"
    by simp
  from this Eq4 have Eq4a: "\<bar>?ICS\<bar> \<le> \<delta>S + 2*\<rho>*(rmax + \<beta>)"
    by simp

  from corr_k corr_l_tk readerror
  have Eq5: "\<bar>?D1\<bar> \<le> \<Lambda>" by simp
  from corr_k corr_m_tk readerror
  have Eq6: "\<bar>?D2\<bar> \<le> \<Lambda>" by simp
  have "\<bar>?D1 - ?D2\<bar> \<le> \<bar>?D1\<bar> + \<bar>?D2\<bar>" by (simp add: abs_if)
  from this Eq5 Eq6 have Eq7: "\<bar>?D1 - ?D2\<bar> \<le> 2*\<Lambda>"
    by (simp)

  from Eq1 Eq2 Eq4a Eq7 split show ?thesis by (simp)
qed

lemma theta_bound:
assumes corr_l: "correct l (te p (i+1))"
and corr_m: "correct m (te p (i+1))"
and corr_p: "correct p (te p (i+1))"
and IC_bound:
    "\<bar>IC l i (max (te l i) (te m i)) - IC m i (max (te l i) (te m i))\<bar>
      \<le> \<delta>S"
shows "\<bar>\<theta> p (i+1) l - \<theta> p (i+1) m\<bar>
       \<le>  2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
proof-
  from corr_p corr_l beta_bound1 have tli_le_tp: "te l i \<le> te p (i+1)"
    by (simp add: le_diff_eq)
  from corr_p corr_m beta_bound1 have tmi_le_tp: "te m i \<le> te p (i+1)"
    by (simp add: le_diff_eq)

  let ?tml = "max (te l i) (te m i)"
  from tli_le_tp tmi_le_tp have tml_le_tp: "?tml \<le> te p (i+1)"
    by simp

  from tml_le_tp corr_l correct_closed have corr_l_tml: "correct l ?tml"
    by blast
  from tml_le_tp corr_m correct_closed have corr_m_tml: "correct m ?tml"
    by blast

  let ?Y = "2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
  show "\<bar>\<theta> p (i+1) l - \<theta> p (i+1) m\<bar> \<le> ?Y"
  proof cases
    assume A: "te m i < te l i"

    from this IC_bound
    have "\<bar>IC l i (te l i) - IC m i (te l i)\<bar> \<le> \<delta>S"
      by(simp add: max_def)
    from this A corr_p corr_l corr_m pe_cond2
    show ?thesis by(simp)
  next
    assume "\<not> (te m i < te l i)"
    hence Eq1: "te l i \<le> te m i" by simp
    from this IC_bound
    have Eq2: "\<bar>IC l i (te m i) - IC m i (te m i)\<bar> \<le> \<delta>S"
      by(simp add: max_def)

    hence "\<bar>IC m i (te m i) - IC l i (te m i)\<bar> \<le> \<delta>S"
      by (simp add: abs_minus_commute)
    from this Eq1 corr_p corr_l corr_m pe_cond2
    have "\<bar>\<theta> p (i+1) m - \<theta> p (i+1) l\<bar> \<le> ?Y"
      by(simp)
    thus ?thesis by (simp add: abs_minus_commute)
  qed
qed

lemma four_one_ind_half:
  assumes ie1: "\<beta> \<le> rmin"
  and ie2: "\<mu> \<le> \<delta>S"
  and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
  and ind_hyp: "okmaxsync i \<delta>S"
  and ie4: "te q (i+1) \<le> te p (i+1)"
  and corr_p: "correct p (te p (i+1))"
  and corr_q: "correct q (te p (i+1))"
shows "\<bar>IC p (i+1) (te p (i+1)) - IC q (i+1) (te p (i+1))\<bar> \<le> \<delta>S"
proof-
  let ?tpq = "te p (i+1)"

  let ?f = "\<lambda> n. \<theta> q (i+1) n + (PC q (te p (i+1)) - PC q (te q (i+1)))"
  let ?g = "\<theta> p (i+1)"

  from ie4 corr_q correct_closed have corr_q_tq: "correct q (te q (i+1))"
    by blast

  have Eq_IC_cfn: "\<bar>IC p (i+1) ?tpq - IC q (i+1) ?tpq\<bar> =
    \<bar>cfn q ?f - cfn p ?g\<bar>"
  proof-
    from corr_p ICp_Suc have Eq1: "IC p (i+1) ?tpq = cfn p ?g" by simp

    from ie4 corr_p corr_q IC_trans_inv
    have Eq2: "IC q (i+1) ?tpq = cfn q ?f" by simp

    from Eq1 Eq2 show ?thesis by(simp add: abs_if)
  qed

  let ?ppred = "\<lambda> l. correct l (te p (i+1))"

  let ?X = "2*\<rho>*\<beta> + 2*\<Lambda>"
  have "\<forall> l. ?ppred l \<longrightarrow> \<bar>?f l - ?g l\<bar> \<le> ?X"
  proof -
    {
      fix l
      assume "?ppred l"
      from ie4 corr_p corr_q this pe_cond1
      have "\<bar>?f l - ?g l\<bar> \<le> (2*\<rho>*\<beta> + 2*\<Lambda>)"
        by(auto)
    }
    thus ?thesis by blast
  qed
  hence cond1: "okRead2 ?f ?g ?X ?ppred"
    by(simp add: okRead2_def)

  let ?Y = "2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"

  have "\<forall> l m. ?ppred l \<and> ?ppred m \<longrightarrow> \<bar>?f l - ?f m\<bar> \<le> ?Y"
  proof-
    {
      fix l m
      assume corr_l: "?ppred l"
      assume corr_m: "?ppred m"

      from corr_p corr_l beta_bound1 have tli_le_tp: "te l i \<le> te p (i+1)"
        by (simp add: le_diff_eq)
      from corr_p corr_m beta_bound1 have tmi_le_tp: "te m i \<le> te p (i+1)"
        by (simp add: le_diff_eq)

      let ?tlm = "max (te l i) (te m i)"

      from tli_le_tp tmi_le_tp have tlm_le_tp: "?tlm \<le> te p (i+1)"
        by simp

      from ie4 corr_l correct_closed have corr_l_tq: "correct l (te q (i+1))"
        by blast
      from ie4 corr_m correct_closed have corr_m_tq: "correct m (te q (i+1))"
        by blast
      from tlm_le_tp corr_l correct_closed have corr_l_tlm: "correct l ?tlm"
        by blast
      from tlm_le_tp corr_m correct_closed have corr_m_tlm: "correct m ?tlm"
        by blast

      from ind_hyp corr_l_tlm corr_m_tlm
      have EqAbs1: "\<bar>IC l i ?tlm - IC m i ?tlm\<bar> \<le> \<delta>S"
        by(auto simp add: okmaxsync_def)

      have EqAbs3: "\<bar>?f l - ?f m\<bar> = \<bar>\<theta> q (i+1) l - \<theta> q (i+1) m\<bar>"
        by (simp add: abs_if)

      from EqAbs1 corr_q_tq corr_l_tq corr_m_tq theta_bound
      have "\<bar>\<theta> q (i+1) l - \<theta> q (i+1) m\<bar> \<le> ?Y"
        by simp
      from this EqAbs3  have "\<bar>?f l - ?f m\<bar> \<le> ?Y"
        by simp
    }
    thus ?thesis by simp
  qed
  hence cond2a: "okRead1 ?f ?Y ?ppred" by (simp add: okRead1_def)

  have "\<forall> l m. ?ppred l \<and> ?ppred m \<longrightarrow> \<bar>?g l - ?g m\<bar> \<le> ?Y"
  proof-
    {
      fix l m
      assume corr_l: "?ppred l"
      assume corr_m: "?ppred m"

      from corr_p corr_l beta_bound1 have tli_le_tp: "te l i \<le> te p (i+1)"
        by (simp add: le_diff_eq)
      from corr_p corr_m beta_bound1 have tmi_le_tp: "te m i \<le> te p (i+1)"
        by (simp add: le_diff_eq)

      let ?tlm = "max (te l i) (te m i)"
      from tli_le_tp tmi_le_tp have tlm_le_tp: "?tlm \<le> te p (i+1)"
        by simp

      from tlm_le_tp corr_l correct_closed have corr_l_tlm: "correct l ?tlm"
        by blast
      from tlm_le_tp corr_m correct_closed have corr_m_tlm: "correct m ?tlm"
        by blast

      from ind_hyp corr_l_tlm corr_m_tlm
      have EqAbs1: "\<bar>IC l i ?tlm - IC m i ?tlm\<bar> \<le> \<delta>S"
        by(auto simp add: okmaxsync_def)

      from EqAbs1 corr_p corr_l corr_m theta_bound
      have "\<bar>?g l - ?g m\<bar> \<le> ?Y" by simp
    }
    thus ?thesis by simp
  qed
  hence cond2b: "okRead1 ?g ?Y ?ppred" by (simp add: okRead1_def)

  from correct_count have "np - maxfaults \<le> count ?ppred np"
    by simp
  from this corr_p corr_q cond1 cond2a cond2b prec_enh
  have "\<bar>cfn q ?f - cfn p ?g\<bar> \<le> \<pi> ?X ?Y"
    by blast

  from ie3 this have "\<bar>cfn q ?f - cfn p ?g\<bar> \<le> \<delta>S"
    by (simp add: \<gamma>1_def)

  from this Eq_IC_cfn show ?thesis by (simp)
qed

text\<open>Theorem 4.1 in Shankar's paper.\<close>

theorem four_one:
  assumes ie1: "\<beta> \<le> rmin"
  and ie2: "\<mu> \<le> \<delta>S"
  and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
shows "okmaxsync i \<delta>S"
proof(induct i)
  show "okmaxsync 0 \<delta>S"
  proof-
    {
      fix p q
      assume corr_p: "correct p (max (te p 0) (te q 0))"
      assume corr_q: "correct q (max (te p 0) (te q 0))"

      from corr_p synch0 have cp0: "correct p 0" by simp
      from corr_q synch0 have cq0: "correct q 0" by simp

      from synch0 cp0 cq0 IClock
      have IC_eq_PC:
        "\<bar>IC p 0 (max (te p 0) (te q 0)) - IC q 0 (max (te p 0) (te q 0))\<bar>
         = \<bar>PC p 0 - PC q 0\<bar>" (is "?T1 = ?T2")
        by(simp add: Adj_def)

      from ie2 init synch0 cp0 have range1: "0 \<le> PC p 0 \<and> PC p 0 \<le> \<delta>S"
        by auto
      from ie2 init synch0 cq0 have range2: "0 \<le> PC q 0 \<and> PC q 0 \<le> \<delta>S"
        by auto
      have "?T2 \<le> \<delta>S"
      proof cases
        assume A:"PC p 0 < PC q 0"
        from A range1 range2 show ?thesis
          by(auto simp add: abs_if)
      next
        assume notA: "\<not> (PC p 0 < PC q 0)"
        from notA range1 range2 show ?thesis
          by(auto simp add: abs_if)
      qed
      from this IC_eq_PC have "?T1 \<le> \<delta>S" by simp
    }
    thus ?thesis by (simp add: okmaxsync_def)
  qed
next
  fix i assume ind_hyp: "okmaxsync i \<delta>S"
  show "okmaxsync (Suc i) \<delta>S"
  proof-
    {
      fix p q
      assume corr_p: "correct p (max (te p (i + 1)) (te q (i + 1)))"
      assume corr_q: "correct q (max (te p (i + 1)) (te q (i + 1)))"
      let ?tp = "te p (i + 1)"
      let ?tq = "te q (i + 1)"
      let ?tpq = "max ?tp ?tq"

      have "\<bar>IC p (i+1) ?tpq - IC q (i+1) ?tpq\<bar> \<le> \<delta>S" (is "?E1 \<le> \<delta>S")
      proof cases
        assume A: "?tq < ?tp"
        from A corr_p have cp1: "correct p (te p (i+1))"
          by (simp add: max_def)
        from A corr_q have cq1: "correct q (te p (i+1))"
          by (simp add: max_def)
        from A
        have Eq1: "?E1 = \<bar>IC p (i+1) (te p (i+1)) - IC q (i+1) (te p (i+1))\<bar>"
                  (is "?E1 = ?E2")
          by (simp add: max_def)
        from A cp1 cq1 corr_p corr_q ind_hyp ie1 ie2 ie3
          four_one_ind_half
        have "?E2 \<le> \<delta>S" by (simp)
        from this Eq1 show ?thesis by simp
      next
        assume notA: "\<not> (?tq < ?tp)"
        from this corr_p have cp2: "correct p (te q (i+1))"
          by (simp add: max_def)
        from notA corr_q have cq2: "correct q (te q (i+1))"
          by (simp add: max_def)
        from notA
        have Eq2: "?E1 = \<bar>IC q (i+1) (te q (i+1)) - IC p (i+1) (te q (i+1))\<bar>"
                  (is "?E1  = ?E3")
          by (simp add: max_def abs_minus_commute)
        from notA have "?tp \<le> ?tq" by simp
        from this cp2 cq2 ind_hyp ie1 ie2 ie3 four_one_ind_half
        have "?E3 \<le> \<delta>S"
          by simp
        from this Eq2 show ?thesis by (simp)
      qed
    }
    thus ?thesis by (simp add: okmaxsync_def)
  qed
qed

lemma VC_cfn:
  assumes corr_p: "correct p (te p (i+1))"
  and ie: "te p (i+1) < te p (i+2)"
shows "VC p (te p (i+1)) = cfn p (\<theta> p (i+1))"
proof-
  from ie corr_p VClock have "VC p (te p (i+1)) = IC p (i+1) (te p (i+1))"
    by simp
  moreover
  from corr_p IClock
  have "IC p (i+1) (te p (i+1)) = PC p (te p (i+1)) + Adj p (i+1)"
    by blast
  moreover
  have "PC p (te p (i+1)) + Adj p (i+1) = cfn p (\<theta> p (i+1))"
    by(simp add: Adj_def)
  ultimately show ?thesis by simp
qed

text\<open>Lemma for the inductive case in Theorem 4.2\<close>

lemma four_two_ind:
  assumes ie1: "\<beta> \<le> rmin"
  and ie2: "\<mu> \<le> \<delta>S"
  and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
  and ie4: "\<gamma>2 \<delta>S \<le> \<delta>"
  and ie5: "\<gamma>3 \<delta>S \<le> \<delta>"
  and ie6: "te q (i+1) \<le> te p (i+1)"
  and ind_hyp: "okClocks p q i"
  and t_bound1: "0 \<le> t"
  and t_bound2: "t < max (te p (i+1)) (te q (i+1))"
  and t_bound3: "max (te p i) (te q i) \<le> t"
  and tpq_bound: "max (te p i) (te q i) < max (te p (i+1)) (te q (i+1))"
  and corr_p: "correct p t"
  and corr_q: "correct q t"
shows "\<bar>VC p t - VC q t\<bar> \<le> \<delta>"
proof cases
  assume A: "t < te q (i+1)"

  let ?tpq = "max (te p i) (te q i)"

  have Eq1: "te p i \<le> t \<and> te q i \<le> t"
  proof cases
    assume "te p i \<le> te q i"
    from this  t_bound3 show ?thesis by (simp add: max_def)
  next
    assume "\<not> (te p i \<le> te q i)"
    from this t_bound3 show ?thesis by (simp add: max_def)
  qed

  from ie6 have tp_max: "max (te p (i+1)) (te q (i+1)) = te p (i+1)"
    by(simp add: max_def)
  from this t_bound2 have Eq2: "t < te p (i+1)" by simp

  from VClock Eq1 Eq2 corr_p have Eq3: "VC p t = IC p i t" by simp

  from VClock Eq1 A corr_q have Eq4: "VC q t = IC q i t" by simp
  from Eq3 Eq4 have Eq5: "\<bar>VC p t - VC q t\<bar> = \<bar>IC p i t - IC q i t\<bar>"
    by simp

  from t_bound3 corr_p corr_q correct_closed
  have corr_tpq: "correct p ?tpq \<and> correct q ?tpq"
    by(blast)

  from t_bound3 IC_bd corr_p corr_q
  have Eq6: "\<bar>IC p i t - IC q i t\<bar>  \<le> \<bar>IC p i ?tpq - IC q i ?tpq\<bar>
    + 2*\<rho>*(t - ?tpq)" (is "?E1 \<le> ?E2")
    by(blast)

  from ie1 ie2 ie3 four_one have "okmaxsync i \<delta>S" by simp

  from this corr_tpq have "\<bar>IC p i ?tpq - IC q i ?tpq\<bar> \<le> \<delta>S"
    by(simp add: okmaxsync_def)

  from Eq6 this  have Eq7: "?E1 \<le> \<delta>S + 2*\<rho>*(t - ?tpq)" by simp

  from corr_p Eq2 rts0 have "t - te p i \<le> rmax" by simp
  from this have "t - ?tpq \<le> rmax" by (simp add: max_def)
  from this constants_ax have "2*\<rho>*(t - ?tpq) \<le> 2*\<rho>*rmax"
    by simp
  hence "\<delta>S + 2*\<rho>*(t - ?tpq) \<le> \<delta>S + 2*\<rho>*rmax"
    by simp
  from this Eq7 have "?E1 \<le> \<delta>S + 2*\<rho>*rmax" by simp
  from this Eq5 ie4 show ?thesis by(simp add: \<gamma>2_def)
next
  assume "\<not> (t < te q (i+1))"
  hence  B: "te q (i+1) \<le> t" by simp

  from ie6 t_bound2
  have tp_max: "max (te p (i+1)) (te q (i+1)) = te p (i+1)"
    by(simp add: max_def)

  have "te p i \<le> max (te p i) (te q i)"
    by(simp add: max_def)

  from this t_bound3 have tp_bound1: "te p i \<le> t" by simp

  from tp_max t_bound2 have tp_bound2: "t < te p (i+1)" by simp

  have tq_bound1: "t < te q (i+2)"
  proof (rule ccontr)
    assume "\<not> (t < te q (i+2))"
    hence C: "te q (i+2) \<le> t" by simp

    from C corr_q correct_closed
    have corr_q_t2: "correct q (te q (i+2))" by blast

    have "te q (i+1) + \<beta> \<le> t"
    proof-
      from corr_q_t2 rts1d have "rmin \<le> te q (i+2) - te q (i+1)"
        by simp
      from this ie1 have "\<beta> \<le> te q (i+2) - te q (i+1)"
        by simp
      hence "te q (i+1) + \<beta> \<le> te q (i+2)" by simp
      from this C show ?thesis by simp
    qed
    from this corr_p corr_q rts2a have "te p (i+1) \<le> t"
      by blast
    hence "\<not> (t < te p (i+1))" by simp
    from this tp_bound2 show False by simp
  qed

  from tq_bound1 B have tq_bound2: "te q (i+1) < te q (i+2)" by simp
  from B tp_bound2 have tq_bound3: "te q (i+1) < te p (i+1)"
    by simp
  from B corr_p correct_closed
  have corr_p_tq1: "correct p (te q (i+1))" by blast

  from B correct_closed corr_q
  have corr_q_tq1: "correct q (te q (i+1))" by blast

  from corr_p_tq1 corr_q_tq1 beta_bound1
  have tq_bound4: "te p i \<le> te q (i+1)"
    by(simp add: le_diff_eq)

  from tq_bound1 VClock B corr_q
  have Eq1: "VC q t = IC q (i+1) t" by simp

  from VClock tp_bound1 tp_bound2 corr_p
  have Eq2: "VC p t = IC p i t" by simp

  from Eq1 Eq2 have Eq3: "\<bar>VC p t - VC q t\<bar> = \<bar>IC p i t - IC q (i+1) t\<bar>"
    by simp

  from B corr_p corr_q IC_bd
  have "\<bar>IC p i t - IC q (i+1) t\<bar> \<le>
     \<bar>IC p i (te q (i+1)) - IC q (i+1) (te q (i+1))\<bar> + 2*\<rho>*(t - te q (i+1))"
    by simp

  from this Eq3
  have VC_split: "\<bar>VC p t - VC q t\<bar> \<le>
    \<bar>IC p i (te q (i+1)) - IC q (i+1) (te q (i+1))\<bar> + 2*\<rho>*(t - te q (i+1))"
    by simp

  from tq_bound2 VClock corr_q_tq1
  have Eq4: "VC q (te q (i+1)) = IC q (i+1) (te q (i+1))" by simp

  from this tq_bound2 VC_cfn corr_q_tq1
  have Eq5: "IC q (i+1) (te q (i+1)) = cfn q (\<theta> q (i+1))" by simp

  hence IC_eq_cfn: "IC p i (te q (i+1)) - IC q (i+1) (te q (i+1)) =
    IC p i (te q (i+1)) - cfn q (\<theta> q (i+1))"
    (is "?E1 = ?E2")
    by simp

  let ?f = "\<theta> q (i+1)"
  let ?ppred = "\<lambda> l. correct l (te q (i+1))"
  let ?X = "2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"

  have "\<forall> l m. ?ppred l \<and> ?ppred m \<longrightarrow> \<bar>\<theta> q (i+1) l - \<theta> q (i+1) m\<bar> \<le> ?X"
  proof-
    {
      fix l :: process
      fix m :: process
      assume corr_l: "?ppred l"
      assume corr_m: "?ppred m"

      let ?tlm = "max (te l i) (te m i)"
      have tlm_bound: "?tlm \<le> te q (i+1)"
      proof-
        from corr_l corr_q_tq1 beta_bound1 have "te l i \<le> te q (i+1)"
          by (simp add: le_diff_eq)
        moreover
        from corr_m corr_q_tq1 beta_bound1 have "te m i \<le> te q (i+1)"
          by (simp add: le_diff_eq)
        ultimately show ?thesis by simp
      qed

      from tlm_bound corr_l corr_m correct_closed
      have corr_tlm: "correct l ?tlm \<and> correct m ?tlm"
        by blast

      have "\<bar>IC l i ?tlm - IC m i ?tlm\<bar> \<le> \<delta>S"
      proof-
        from ie1 ie2 ie3 four_one  have "okmaxsync i \<delta>S"
          by simp
        from this corr_tlm show ?thesis by(simp add: okmaxsync_def)
      qed

      from this corr_l corr_m corr_q_tq1 theta_bound
      have "\<bar>\<theta> q (i+1) l - \<theta> q (i+1) m\<bar> \<le> ?X" by simp
    }
    thus ?thesis by blast
  qed
  hence readOK: "okRead1 (\<theta> q (i+1)) ?X ?ppred"
    by(simp add: okRead1_def)

  let ?E3 = "cfn q (\<theta> q (i+1)) - \<theta> q (i+1) p"
  let ?E4 = "\<theta> q (i+1) p - IC p i (te q (i+1))"

  have "\<bar>?E2\<bar> = \<bar>?E3 + ?E4\<bar>" by (simp add: abs_if)
  hence Eq8: "\<bar>?E2\<bar> \<le> \<bar>?E3\<bar> + \<bar>?E4\<bar>" by (simp add: abs_if)

  from correct_count have ppredOK: "np - maxfaults \<le> count ?ppred np"
    by simp
  from readOK ppredOK corr_p_tq1 corr_q_tq1 acc_prsv
  have "\<bar>?E3\<bar> \<le> \<alpha> ?X"
    by blast
  from this Eq8 have Eq9: "\<bar>?E2\<bar> \<le> \<alpha> ?X + \<bar>?E4\<bar>" by simp

  from corr_p_tq1 corr_q_tq1 readerror
  have "\<bar>?E4\<bar> \<le> \<Lambda>" by simp

  from this Eq9 have Eq10: "\<bar>?E2\<bar> \<le> \<alpha> ?X + \<Lambda>" by simp

  from this VC_split IC_eq_cfn
  have almost_right:
    "\<bar>VC p t - VC q t\<bar> \<le>
     \<alpha> ?X + \<Lambda> + 2*\<rho>*(t - te q (i+1))"
    by simp

  have "t - te q (i+1) \<le> \<beta>"
  proof (rule ccontr)
    assume "\<not> (t - te q (i+1) \<le> \<beta>)"
    hence "te q (i+1) + \<beta> \<le> t" by simp
    from this corr_p corr_q rts2a have "te p (i+1) \<le> t"
      by auto
    hence "\<not> (t < te p (i+1))" by simp
    from this tp_bound2 show False
      by simp
  qed

  from this constants_ax
  have "\<alpha> ?X + \<Lambda> + 2*\<rho>*(t - te q (i+1))
        \<le> \<alpha> ?X + \<Lambda> + 2*\<rho>*\<beta>"
    by (simp)

  from this almost_right
  have "\<bar>VC p t - VC q t\<bar> \<le> \<alpha> ?X + \<Lambda> + 2*\<rho>*\<beta>"
    by arith

  from this ie5 show ?thesis by (simp add: \<gamma>3_def)
qed

text\<open>Theorem 4.2 in Shankar's paper.\<close>

theorem four_two:
  assumes ie1: "\<beta> \<le> rmin"
  and ie2: "\<mu> \<le> \<delta>S"
  and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
  and ie4: "\<gamma>2 \<delta>S \<le> \<delta>"
  and ie5: "\<gamma>3 \<delta>S \<le> \<delta>"
shows "okClocks p q i"
proof (induct i)
  show "okClocks p q 0"
  proof-
    {
      fix t :: time
      assume t_bound1: "0 \<le> t"
      assume t_bound2: "t < max (te p 0) (te q 0)"
      assume corr_p: "correct p t"
      assume corr_q: "correct q t"
      from t_bound2 synch0 have "t < 0"
        by(simp add: max_def)
      from this t_bound1 have False by simp
      hence "\<bar>VC p t - VC q t\<bar> \<le> \<delta>" by simp
    }
    thus ?thesis by (simp add: okClocks_def)
  qed
next
  fix i::nat assume ind_hyp: "okClocks p q i"
  show "okClocks p q (Suc i)"
  proof -
    {
      fix t :: time
      assume t_bound1: "0 \<le> t"
      assume t_bound2: "t < max (te p (i+1)) (te q (i+1))"
      assume corr_p: "correct p t"
      assume corr_q: "correct q t"

      let ?tpq1 = "max (te p i) (te q i)"
      let ?tpq2 = "max (te p (i+1)) (te q (i+1))"

      have "\<bar>VC p t - VC q t\<bar> \<le> \<delta>"
      proof cases
        assume tpq_bound: "?tpq1 < ?tpq2"
        show ?thesis
        proof cases
          assume "t < ?tpq1"
          from t_bound1 this  corr_p corr_q ind_hyp
          show ?thesis by(simp add: okClocks_def)
        next
          assume "\<not> (t < ?tpq1)"
          hence tpq_le_t: "?tpq1 \<le> t" by arith

          show ?thesis
          proof cases
            assume A: "te q (i+1) \<le> te p (i+1)"

            from this tpq_le_t tpq_bound ie1 ie2 ie3 ie4 ie5
              ind_hyp t_bound1 t_bound2
              corr_p corr_q tpq_bound four_two_ind
            show ?thesis by(simp)
          next
            assume "\<not> (te q (i+1) \<le> te p (i+1))"
            hence B: "te p (i+1) \<le> te q (i+1)" by simp

            from ind_hyp okClocks_sym have ind_hyp1: "okClocks q p i"
              by blast

            have maxsym1: "max (te p (i+1)) (te q (i+1)) = max (te q (i+1)) (te p (i+1))"
              by (simp add: max_def)
            have maxsym2: "max (te p i) (te q i) = max (te q i) (te p i)"
              by (simp add: max_def)

            from maxsym1 t_bound2
            have t_bound21: "t < max (te q (i+1)) (te p (i+1))"
              by simp

            from maxsym1 maxsym2 tpq_bound
            have tpq_bound1: "max (te q i) (te p i) < max (te q (i+1)) (te p (i+1))"
              by simp
            from maxsym2 tpq_le_t
            have tpq_le_t1: "max (te q i) (te p i) \<le> t" by simp

            from B tpq_le_t1 tpq_bound1 ie1 ie2 ie3 ie4 ie5
              ind_hyp1 t_bound1 t_bound21
              corr_p corr_q tpq_bound four_two_ind
            have "\<bar>VC q t - VC p t\<bar> \<le> \<delta>" by(simp)
            thus ?thesis by (simp add: abs_minus_commute)
          qed

        qed
      next
        assume "\<not> (?tpq1 < ?tpq2)"
        hence "?tpq2 \<le> ?tpq1" by arith
        from t_bound2 this have "t < ?tpq1" by arith
        from t_bound1 this corr_p corr_q ind_hyp
        show ?thesis by(simp add: okClocks_def)
      qed
    }
    thus ?thesis by (simp add: okClocks_def)
  qed
qed

text\<open>The main theorem: all correct clocks are synchronized within the
bound delta.\<close>

theorem agreement:
  assumes ie1: "\<beta> \<le> rmin"
  and ie2: "\<mu> \<le> \<delta>S"
  and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
  and ie4: "\<gamma>2 \<delta>S \<le> \<delta>"
  and ie5: "\<gamma>3 \<delta>S \<le> \<delta>"
  and ie6: "0 \<le> t"
  and cpq: "correct p t \<and> correct q t"
shows "\<bar>VC p t - VC q t\<bar> \<le> \<delta>"
proof-
  from ie6 cpq event_bound have "\<exists> i :: nat. t < max (te p i) (te q i)"
    by simp
  from this obtain i  :: nat where t_bound: "t < max (te p i) (te q i)" ..

  from t_bound ie1 ie2 ie3 ie4 ie5 four_two have "okClocks p q i"
    by simp

  from ie6 this t_bound cpq show ?thesis
    by (simp add: okClocks_def)
qed

end


theory StreamExample
imports Main "$HIPSTER_HOME/IsaHipster"
begin
(* Set Hipster tactic*)
setup Tactic_Data.set_coinduct_sledgehammer

codatatype (sset: 'a) Stream =
  SCons (shd: 'a) (stl: "'a Stream")

primcorec smap :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a Stream \<Rightarrow> 'b Stream" where
  "smap f xs = SCons (f (shd xs)) (smap f (stl xs))"

(* Call Hipster for coinductive theory exploration *)
(*cohipster smap*)
lemma lemma_a [thy_expl]: "SCons (y z) (smap y x2) = smap y (SCons z x2)"
  by(coinduction arbitrary: x2 y z rule: Stream.coinduct_strong)
    simp

(*cohipster smap Fun.id*)
lemma lemma_aa [thy_expl]: "smap id y = y"
  by(coinduction arbitrary: y rule: Stream.coinduct_strong)
    simp

(*cohipster smap Fun.comp*)
lemma lemma_ab [thy_expl]: "smap (y \<circ> z) x2 = smap y (smap z x2)"
  by(coinduction arbitrary: x2 y z rule: Stream.coinduct_strong)
auto

primcorec siterate :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a Stream" where
  "siterate f a = SCons a (siterate f (f a))"

(*cohipster smap siterate*)
lemma lemma_ac [thy_expl]: "smap y (siterate y z) = siterate y (y z)"
  by(coinduction arbitrary: y z rule: Stream.coinduct_strong)
    auto

lemma lemma_ad [thy_expl]: "smap z (SCons y (siterate z x2)) = SCons (z y) (siterate z (z x2))"
  by(coinduction arbitrary: x2 y z rule: Stream.coinduct_strong)
    (simp add: lemma_ac)

end


theory Chapter10_1_Language
imports DeBruijnEnvironment
begin

datatype type =
  Nat
| Arrow type type
| Unit
| Prod type type

datatype expr =
  Var var
| Zero
| Suc expr
| Rec expr expr expr
| Lam type expr
| Appl expr expr
| Triv
| Pair expr expr
| ProjL expr
| ProjR expr

primrec insert :: "var => expr => expr"
where "insert n (Var v) = Var (incr n v)"
    | "insert n Zero = Zero"
    | "insert n (Suc e) = Suc (insert n e)"
    | "insert n (Rec et e0 es) = Rec (insert n et) (insert n e0) (insert (next (next n)) es)"
    | "insert n (Lam t e) = Lam t (insert (next n) e)"
    | "insert n (Appl e1 e2) = Appl (insert n e1) (insert n e2)"
    | "insert n Triv = Triv"
    | "insert n (Pair e1 e2) = Pair (insert n e1) (insert n e2)"
    | "insert n (ProjL e) = ProjL (insert n e)"
    | "insert n (ProjR e) = ProjR (insert n e)"

primrec subst :: "expr => var => expr => expr"
where "subst e' n (Var v) = (if v = n then e' else Var (subr n v))"
    | "subst e' n Zero = Zero"
    | "subst e' n (Suc e) = Suc (subst e' n e)"
    | "subst e' n (Rec et e0 es) =
                      Rec (subst e' n et) (subst e' n e0)
                          (subst (insert first (insert first e')) (next (next n)) es)"
    | "subst e' n (Lam t e) = Lam t (subst (insert first e') (next n) e)"
    | "subst e' n (Appl e1 e2) = Appl (subst e' n e1) (subst e' n e2)"
    | "subst e' n Triv = Triv"
    | "subst e' n (Pair e1 e2) = Pair (subst e' n e1) (subst e' n e2)"
    | "subst e' n (ProjL e) = ProjL (subst e' n e)"
    | "subst e' n (ProjR e) = ProjR (subst e' n e)"

end


theory prop_07
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype Nat = Z | S "Nat"
  fun plus :: "Nat => Nat => Nat" where
  "plus (Z) y = y"
  | "plus (S z) y = S (plus z y)"
  fun minus :: "Nat => Nat => Nat" where
  "minus (Z) y = Z"
  | "minus (S z) (Z) = S z"
  | "minus (S z) (S x2) = minus z x2"
  (*hipster plus minus *)
(*hipster minus*)
lemma lemma_a [thy_expl]: "minus x2 x2 = Z"
by (hipster_induct_schemes minus.simps)

lemma lemma_aa [thy_expl]: "minus x3 Z = x3"
by (hipster_induct_schemes minus.simps)

lemma lemma_ab [thy_expl]: "minus x2 (S x2) = Z"
by (hipster_induct_schemes)

lemma lemma_ac [thy_expl]: "minus (S x2) x2 = S Z"
by (hipster_induct_schemes)

lemma lemma_ad [thy_expl]: "minus (minus x3 y3) (minus y3 x3) = minus x3 y3"
by (hipster_induct_schemes minus.simps)

lemma lemma_ae [thy_expl]: "minus (minus x3 y3) (S Z) = minus x3 (S y3)"
by (hipster_induct_schemes minus.simps)

lemma lemma_af [thy_expl]: "minus (minus x4 y4) x4 = Z"
by (hipster_induct_schemes minus.simps)

  theorem x0 :
    "(minus (plus n m) n) = m"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


(* Author: Johannes Hölzl <hoelzl@in.tum.de> *)

header {* Formalization of the Crowds-Protocol *}

theory Crowds_Protocol
  imports "../Discrete_Time_Markov_Chain"
begin

subsection {* Definition of the Crowds-Protocol *}

datatype 'a state = Start | Init 'a | Mix 'a | End

lemma inj_Mix[simp]: "inj_on Mix A"
  by (auto intro: inj_onI)

lemma inj_Init[simp]: "inj_on Init A"
  by (auto intro: inj_onI)

lemma distinct_state_image[simp]:
  "Start \<notin> Mix ` A" "Init j \<notin> Mix ` A" "End \<notin> Mix ` A" "Mix j \<in> Mix ` A \<longleftrightarrow> j \<in> A"
  "Start \<notin> Init ` A" "Mix j \<notin> Init ` A" "End \<notin> Init ` A" "Init j \<in> Init ` A \<longleftrightarrow> j \<in> A"
  by auto

lemma Init_cut_Mix[simp]:
  "Init ` H \<inter> Mix ` J = {}"
  by auto

abbreviation "Jondo B \<equiv> Init`B \<union> Mix`B"

locale Crowds_Protocol =
  fixes J :: "'a set" and C :: "'a set" and p_f :: real and p_i :: "'a \<Rightarrow> real"
  assumes J_not_empty: "J \<noteq> {}" and finite_J[simp]: "finite J"
  assumes C_smaller: "C \<subset> J" and C_non_empty: "C \<noteq> {}"
  assumes p_f: "0 < p_f" "p_f < 1"
  assumes p_i_nonneg: "\<And>j. j \<in> J \<Longrightarrow> 0 \<le> p_i j"
  assumes p_i_distr: "(\<Sum>j\<in>J. p_i j) = 1"
  assumes p_i_C: "\<And>j. j \<in> C \<Longrightarrow> p_i j = 0"
begin

abbreviation H :: "'a set" where
  "H \<equiv> J - C"

definition "p_j = 1 / card J"

definition "p_H = card H / card J"

definition next_prob :: "'a state \<Rightarrow> 'a state \<Rightarrow> real" where
  "next_prob s t = (case (s, t) of (Start, Init j) \<Rightarrow> if j \<in> H then p_i j else 0
                                 | (Init j, Mix j') \<Rightarrow> if j' \<in> J then p_j else 0
                                 | (Mix j, Mix j') \<Rightarrow> if j' \<in> J then p_f * p_j else 0
                                 | (Mix j, End) \<Rightarrow> 1 - p_f
                                 | (End, End) \<Rightarrow> 1
                                 | _ \<Rightarrow> 0)"

definition "N s = embed_pmf (next_prob s)"

interpretation MC_syntax N .

abbreviation "\<PP> \<equiv> T Start"

abbreviation "E s \<equiv> set_pmf (N s)"

lemma finite_C[simp]: "finite C"
  using C_smaller finite_J by (blast intro: finite_subset)

lemma setsum_p_i_C[simp]: "setsum p_i C = 0"
  by (auto intro: setsum.neutral p_i_C)

lemma setsum_p_i_H[simp]: "setsum p_i H = 1"
  using C_smaller by (simp add: setsum_diff p_i_distr)

lemma possible_jondo:
  obtains j where "j \<in> J" "j \<notin> C" "p_i j \<noteq> 0"
proof (atomize_elim, rule ccontr)
  assume "\<not> (\<exists>j. j \<in> J \<and> j \<notin> C \<and> p_i j \<noteq> 0)"
  with p_i_C have "\<forall>j\<in>J. p_i j = 0"
    by auto
  with p_i_distr show False
    by simp
qed

lemma C_le_J[simp]: "card C < card J"
  using C_smaller
  by (intro psubset_card_mono) auto

lemma p_H: "0 < p_H" "p_H < 1"
  using J_not_empty C_smaller C_non_empty
  by (simp_all add: p_H_def card_Diff_subset card_mono real_of_nat_diff
                    field_simps zero_less_divide_iff card_gt_0_iff)

lemma p_H_p_f_pos: "0 < p_H * p_f"
  using p_f p_H by (simp add: zero_less_mult_iff)

lemma p_H_p_f_less_1: "p_H * p_f < 1"
proof -
  have "p_H * p_f < 1 * 1"
    using p_H p_f by (intro mult_strict_mono) auto
  then show "p_H * p_f < 1" by simp
qed

lemma p_j_pos: "0 < p_j"
  unfolding p_j_def using J_not_empty by auto

lemma H_compl: "1 - p_H = real (card C) / real (card J)"
  using C_non_empty J_not_empty C_smaller
  by (simp add: p_H_def card_Diff_subset card_mono real_of_nat_diff divide_eq_eq field_simps)

lemma H_compl2: "1 - p_H = card C * p_j"
  unfolding H_compl p_j_def by simp

lemma H_eq2: "card H * p_j = p_H"
  unfolding p_j_def p_H_def by simp

lemma pmf_next_pmf[simp]: "pmf (N s) t = next_prob s t"
  unfolding N_def
proof (rule pmf_embed_pmf)
  show "\<And>x. 0 \<le> next_prob s x"
    using p_j_pos p_f by (auto simp: next_prob_def intro: p_i_nonneg split: state.split)
  show "(\<integral>\<^sup>+ x. ereal (next_prob s x) \<partial>count_space UNIV) = 1"
    using p_f J_not_empty
    by (subst nn_integral_count_space'[where A="Init`H \<union> Mix`J \<union> {End}"])
       (auto simp: next_prob_def p_i_nonneg setsum.reindex setsum.union_disjoint
                   p_i_distr p_j_def real_of_nat_def[symmetric]
             split: state.split)
qed

lemma next_prob_Start[simp]: "next_prob Start (Init j) = (if j \<in> H then p_i j else 0)"
  by (auto simp: next_prob_def)

lemma next_prob_to_Init[simp]: "j \<in> H \<Longrightarrow> next_prob s (Init j) =
    (case s of Start \<Rightarrow> p_i j | _ \<Rightarrow> 0)"
  by (cases s) (auto simp: next_prob_def)

lemma next_prob_to_Mix[simp]: "j \<in> J \<Longrightarrow> next_prob s (Mix j) =
    (case s of Init j \<Rightarrow> p_j | Mix j \<Rightarrow> p_f * p_j | _ \<Rightarrow> 0)"
  by (cases s) (auto simp: next_prob_def)

lemma next_prob_to_End[simp]: "next_prob s End =
    (case s of Mix j \<Rightarrow> 1 - p_f | End \<Rightarrow> 1 | _ \<Rightarrow> 0)"
  by (cases s) (auto simp: next_prob_def)

lemma next_prob_Mix_MixI: "\<exists>j. s = Mix j \<Longrightarrow> \<exists>j\<in>J. s' = Mix j \<Longrightarrow> next_prob s s' = p_f * p_j"
  by (cases s) auto

lemma E_Start: "E Start = {Init j | j. j \<in> H \<and> p_i j \<noteq> 0 }"
  using p_i_C by (auto simp: set_pmf_iff next_prob_def split: state.splits split_if_asm)

lemma E_Init: "E (Init j) = {Mix j | j. j \<in> J }"
  using p_j_pos C_smaller by (auto simp: set_pmf_iff next_prob_def split: state.splits split_if_asm)

lemma E_Mix: "E (Mix j) = {Mix j | j. j \<in> J } \<union> {End}"
  using p_j_pos p_f by (auto simp: set_pmf_iff next_prob_def split: state.splits split_if_asm)

lemma E_End: "E End = {End}"
  by (auto simp: set_pmf_iff next_prob_def split: state.splits split_if_asm)

lemma enabled_End:
  "enabled End \<omega> \<longleftrightarrow> \<omega> = sconst End"
proof safe
  assume "enabled End \<omega>" then show "\<omega> = sconst End"
  proof (coinduction arbitrary: \<omega>)
    case Eq_stream then show ?case
      by (auto simp: enabled.simps[of _ \<omega>] E_End)
  qed
next
  show "enabled End (sconst End)"
    by coinduction (simp add: E_End)
qed

lemma AE_End: "(AE \<omega> in T End. P \<omega>) \<longleftrightarrow> P (sconst End)"
proof -
  have "(AE \<omega> in T End. P \<omega>) \<longleftrightarrow> (AE \<omega> in T End. P \<omega> \<and> \<omega> = sconst End)"
    using AE_T_enabled[of End] by (simp add: enabled_End)
  also have "\<dots> = (AE \<omega> in T End. P (sconst End) \<and> \<omega> = sconst End)"
    by (simp add: enabled_End del: AE_conj_iff cong: rev_conj_cong)
  also have "\<dots> = (AE \<omega> in T End. P (sconst End))"
    using AE_T_enabled[of End] by (simp add: enabled_End)
  finally show ?thesis
    by simp
qed

lemma emeasure_Init_eq_Mix:
  assumes [measurable]: "Measurable.pred S P"
  assumes AE_End: "AE x in T End. \<not> P (End ## x)"
  shows "emeasure (T (Init j)) {x\<in>space (T (Init j)). P x} =
    emeasure (T (Mix j)) {x\<in>space (T (Mix j)). P x} / p_f"
proof -
  have *: "{Mix j | j. j \<in> J } = Mix ` J"
    by auto
  show ?thesis
    using emeasure_eq_0_AE[OF AE_End] p_f
    apply (subst (1 2) emeasure_Collect_T)
    apply simp
    apply (subst (1 2) nn_integral_measure_pmf_finite)
    apply (auto simp: E_Mix E_Init * setsum.reindex setsum_ereal_left_distrib[symmetric]
                      ereal_times_divide_eq[symmetric] emeasure_nonneg)
    done
qed

text {*

What is the probability that the server sees a specific jondo (including the initiator) as sender.

*}

definition visit :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a state stream \<Rightarrow> bool" where
  "visit I L = Init`(I \<inter> H) \<cdot> (HLD (Mix`J) suntil (Mix`(L \<inter> J) \<cdot> HLD {End}))"

lemma visit_unique1:
  "visit I1 L1 \<omega> \<Longrightarrow> visit I2 L2 \<omega> \<Longrightarrow> I1 \<inter> I2 \<noteq> {}"
  using assms by (auto simp: visit_def HLD_iff)

lemma visit_unique2:
  assumes "visit I1 L1 \<omega>" "visit I2 L2 \<omega>"
  shows "L1 \<inter> L2 \<noteq> {}"
proof -
  let ?U = "\<lambda>L \<omega>. (HLD (Mix`J) suntil ((Mix`(L\<inter>J)) \<cdot> HLD {End})) \<omega>"
  have "?U L1 (stl \<omega>)" "?U L2 (stl \<omega>)"
    using assms by (auto simp: visit_def)
  then show "L1 \<inter> L2 \<noteq> {}"
  proof (induction "stl \<omega>" arbitrary: \<omega> rule: suntil_induct_strong)
    case base then show ?case
      by (auto simp add: suntil.simps[of _ _ "stl (stl \<omega>)"] suntil.simps[of _ _ "stl \<omega>"] HLD_iff)
  next
    case step
    show ?case
    proof cases
      assume "((Mix`(L2\<inter>J)) \<cdot> HLD {End}) (stl \<omega>)"
      with step.hyps show ?thesis
        by (auto simp: inj_Mix HLD_iff elim: suntil.cases)
    next
      assume "\<not> ((Mix`(L2\<inter>J)) \<cdot> HLD {End}) (stl \<omega>)"
      with step.prems have "?U L2 (stl (stl \<omega>))"
        by (auto elim: suntil.cases)
      then show ?thesis
        by (rule step.hyps(4)[OF refl])
    qed
  qed
qed

lemma visit_imp_in_H: "visit {i} J \<omega> \<Longrightarrow> i \<in> H"
  by (auto simp: visit_def HLD_iff)

lemma emeasure_visit:
  assumes I: "I \<subseteq> H" and L: "L \<subseteq> J"
  shows "emeasure \<PP> {\<omega>\<in>space \<PP>. visit I L \<omega>} = (\<Sum>i\<in>I. p_i i) * (card L * p_j)"
proof -
  let ?J = "HLD (Mix`J)" and ?E = "(Mix`L) \<cdot> HLD {End}"
  let ?\<phi> = "?J aand not ?E"
  let ?P = "\<lambda>x P. emeasure (T x) {\<omega>\<in>space (T x). P \<omega>}"

  have [intro]: "finite L"
    using finite_J `L \<subseteq> J` by (blast intro: finite_subset)
  have [simp, intro]: "finite I"
    using finite_J `I \<subseteq> H` by (blast intro: finite_subset)

  { fix j assume j: "j \<in> H"
    have "?P (Mix j) (?J suntil ?E) = (p_f * p_j * (1 - p_f) * card L) / (1 - p_f)"
    proof (rule emeasure_suntil_geometric[OF _ _ _ order_refl])
      fix s assume s: "s \<in> Mix ` J"
      then have "?P s ?E = (\<integral>\<^sup>+x. ereal (1 - p_f) * indicator (Mix`L) x \<partial>N s)"
        by (auto simp add: emeasure_HLD_nxt emeasure_HLD AE_measure_pmf_iff emeasure_pmf_single
                 split: state.split split_indicator simp del: space_T nxt.simps
                 intro!: nn_integral_cong_AE)
      also have "\<dots> = ereal (1 - p_f) * emeasure (N s) (Mix`L)"
        using p_f by (intro nn_integral_cmult_indicator) auto
      also have "\<dots> = ereal ((1 - p_f) * card L * p_j * p_f)"
        using s assms by (subst emeasure_measure_pmf_finite) (auto simp: setsum.reindex subset_eq real_of_nat_def)
      finally show "?P s ?E = p_f * p_j * (1 - p_f) * card L"
        by simp
    next
      fix s show "AE \<omega> in T s. (?\<phi> aand nxt ?E) \<omega> \<longleftrightarrow> (Mix`J \<cdot> ?E) \<omega>"
        "AE \<omega> in T s. (?\<phi> aand nxt ?\<phi>) \<omega> \<longleftrightarrow> (Mix`J \<cdot> ?\<phi>) \<omega>"
        by (auto simp add: HLD_iff)
    qed (insert p_f j, auto simp: emeasure_measure_pmf_finite setsum.reindex p_j_def real_of_nat_def)
    then have "?P (Init j) (?J suntil ?E) = (p_f * p_j * (1 - p_f) * card L) / (1 - p_f) / p_f"
      by (subst emeasure_Init_eq_Mix) (simp_all add:  suntil.simps[of _ _ "x ## s" for x s])
    then have "?P (Init j) (?J suntil ?E) = p_j * card L"
      using p_f by simp }
  note J_suntil_E = this

  have "?P Start (visit I L) = (\<integral>\<^sup>+x. ?P x (?J suntil ?E) * indicator (Init`I) x \<partial>N Start)"
    unfolding visit_def using I L by (subst emeasure_HLD_nxt) (auto simp: Int_absorb2)
  also have "\<dots> = (\<integral>\<^sup>+x. ereal (p_j * card L) * indicator (Init`I) x \<partial>N Start)"
    using I J_suntil_E by (intro nn_integral_cong mult_indicator_cong) auto
  also have "\<dots> = ereal ((\<Sum>i\<in>I. p_i i) * card L * p_j)"
    using p_j_pos assms
    by (subst nn_integral_cmult_indicator)
       (auto simp: emeasure_measure_pmf_finite setsum.reindex subset_eq)
  finally show ?thesis by simp
qed

lemma measurable_visit[measurable]: "Measurable.pred S (visit I L)"
  by (simp add: visit_def)

lemma AE_visit: "AE \<omega> in \<PP>. visit H J \<omega>"
proof (rule T.AE_I_eq_1)
  show "emeasure \<PP> {\<omega>\<in>space \<PP>. visit H J \<omega>} = 1"
    using J_not_empty by (subst emeasure_visit ) (simp_all add: p_j_def)
qed simp

subsection {* Server gets no information *}

lemma server_view1: "j \<in> J \<Longrightarrow> \<P>(\<omega> in \<PP>. visit H {j} \<omega>) = p_j"
  unfolding measure_def by (subst emeasure_visit) simp_all

lemma server_view_indep:
  "L \<subseteq> J \<Longrightarrow> I \<subseteq> H \<Longrightarrow> \<P>(\<omega> in \<PP>. visit I L \<omega>) = \<P>(\<omega> in \<PP>. visit H L \<omega>) * \<P>(\<omega> in \<PP>. visit I J \<omega>)"
  unfolding measure_def by (subst (1 2 3) emeasure_visit) (auto simp: p_j_def)

lemma server_view: "\<P>(\<omega> in \<PP>. \<exists>j\<in>H. visit {j} {j} \<omega>) = p_j"
  using finite_J
proof (subst T.prob_setsum[where I="H" and P="\<lambda>j. visit {j} {j}"])
  show "(\<Sum>j\<in>H. \<P>(\<omega> in \<PP>. visit {j} {j} \<omega>)) = p_j"
    by (auto simp: measure_def emeasure_visit setsum_left_distrib[symmetric] simp del: space_T sets_T)
  show "AE x in \<PP>. (\<forall>n\<in>H. visit {n} {n} x \<longrightarrow> (\<exists>j\<in>H. visit {j} {j} x)) \<and>
                ((\<exists>j\<in>H. visit {j} {j} x) \<longrightarrow> (\<exists>!n. n \<in> H \<and> visit {n} {n} x))"
    by (auto dest: visit_unique1)
qed simp_all

subsection {* Probability that collaborators gain information *}

definition "hit_C = Init`H \<cdot> ev (HLD (Mix`C))"
definition "before_C B = (HLD (Jondo H)) suntil ((Jondo (B \<inter> H)) \<cdot> HLD (Mix ` C))"

lemma measurable_hit_C[measurable]: "Measurable.pred S hit_C"
  by (simp add: hit_C_def)

lemma measurable_before_C[measurable]: "Measurable.pred S (before_C B)"
  by (simp add: before_C_def)

lemma before_C:
  assumes \<omega>: "enabled Start \<omega>"
  shows "before_C B \<omega> \<longleftrightarrow>
    ((Init`H \<cdot> (HLD (Mix`H) suntil (Mix`(B \<inter> H) \<cdot> HLD (Mix`C)))) or (Init`(B \<inter> H) \<cdot> HLD (Mix`C))) \<omega>"
proof -
  { fix \<omega> s assume "((HLD (Jondo H)) suntil (Jondo (B \<inter> H) \<cdot> HLD (Mix ` C))) \<omega>"
      "enabled s \<omega>" "s \<in> Jondo H"
    then have "(HLD (Mix ` H) suntil (Mix ` (B \<inter> H) \<cdot> (HLD (Mix ` C)))) \<omega>"
    proof (induction arbitrary: s)
      case (base \<omega>) then show ?case
        by (auto simp: HLD_iff enabled.simps[of _ \<omega>] E_Init E_Mix intro!: suntil.intros(1))
    next
      case (step \<omega>) from step.prems step.hyps step.IH[of "shd \<omega>"] show ?case
        by (auto simp: HLD_iff enabled.simps[of _ \<omega>] E_Init E_Mix
                       suntil.simps[of _ _ \<omega>] enabled_End suntil_sconst)
    qed }
  note this[of "stl \<omega>" "shd \<omega>"]
  moreover
  { fix \<omega> s assume "(HLD (Mix ` H) suntil (Mix ` (B \<inter> H) \<cdot> (HLD (Mix ` C)))) \<omega>"
      "enabled s \<omega>" "s \<in> Jondo H"
    then have "((HLD (Jondo H)) suntil ((Jondo (B \<inter> H)) \<cdot> HLD (Mix ` C))) \<omega>"
    proof (induction arbitrary: s)
      case (step \<omega>) from step.prems step.hyps step.IH[of "shd \<omega>"] show ?case
        by (auto simp: HLD_iff enabled.simps[of _ \<omega>] E_Init E_Mix
                       suntil.simps[of _ _ \<omega>] enabled_End suntil_sconst)
    qed (auto intro: suntil.intros simp: HLD_iff) }
  note this[of "stl \<omega>" "shd \<omega>"]
  ultimately show ?thesis
    using assms
    using `enabled Start \<omega>`
    unfolding before_C_def suntil.simps[of _ _ \<omega>] enabled.simps[of _ \<omega>]
    by (auto simp: E_Start HLD_iff)
qed

lemma before_C_unique:
  assumes \<omega>: "before_C I1 \<omega>" "before_C I2 \<omega>" shows "I1 \<inter> I2 \<noteq> {}"
  using \<omega> unfolding before_C_def
proof induction
  case (base \<omega>) then show ?case
    by (auto simp add: suntil.simps[of _ _ \<omega>] suntil.simps[of _ _ "stl \<omega>"] HLD_iff)
next
  case (step \<omega>) then show ?case
    by (auto simp add: suntil.simps[of _ _ \<omega>] suntil.simps[of _ _ "stl \<omega>"] HLD_iff)
qed

lemma hit_C_imp_before_C:
  assumes "enabled Start \<omega>" "hit_C \<omega>" shows "before_C H \<omega>"
proof -
  let ?X = "Init`H \<union> Mix`H"
  { fix \<omega> s assume "ev (HLD (Mix`C)) \<omega>" "s\<in>?X" "enabled s \<omega>"
    then have "((HLD (Jondo H)) suntil (?X \<cdot> HLD (Mix ` C))) (s ## \<omega>)"
    proof (induction arbitrary: s rule: ev_induct_strong)
      case (step \<omega> s) from step.IH[of "shd \<omega>"] step.prems step.hyps show ?case
        by (auto simp: enabled.simps[of _ \<omega>] suntil_Stream E_Init E_Mix HLD_iff
          enabled_End ev_sconst)
    qed (auto simp: suntil_Stream) }
  from this[of "stl \<omega>" "shd \<omega>"] assms show ?thesis
    by (auto simp: before_C_def hit_C_def enabled.simps[of _ \<omega>] E_Start)
qed

lemma before_C_single:
  assumes "before_C I \<omega>" shows "\<exists>i\<in>I \<inter> H. before_C {i} \<omega>"
  using assms unfolding before_C_def by induction (auto simp: HLD_iff intro: suntil.intros)

lemma before_C_imp_in_H: "before_C {i} \<omega> \<Longrightarrow> i \<in> H"
  by (auto dest: before_C_single)

subsection {* The probability that the sender hits a collaborator *}

lemma Pr_hit_C: "\<P>(\<omega> in \<PP>. hit_C \<omega>) = (1 - p_H) / (1 - p_H * p_f)"
proof -
  let ?P = "\<lambda>x P. emeasure (T x) {\<omega>\<in>space (T x). P \<omega>}"
  let ?M = "HLD (Mix ` C)" and ?I = "Init`H" and ?J = "Mix`H"
  let ?\<phi> = "(HLD ?J) aand not ?M"

  { fix s assume s: "s \<in> Jondo J"
    have "AE \<omega> in T s. ev ?M \<omega> \<longleftrightarrow> (HLD ?J suntil ?M) \<omega>"
      using AE_T_enabled
    proof eventually_elim
      fix \<omega> assume \<omega>: "enabled s \<omega>"
      show "ev ?M \<omega> \<longleftrightarrow> (HLD ?J suntil ?M) \<omega>"
      proof
        assume "ev ?M \<omega>"
        from this \<omega> s show "(HLD ?J suntil ?M) \<omega>"
        proof (induct arbitrary: s rule: ev_induct_strong)
          case (step \<omega>) then show ?case
            by (auto simp: HLD_iff enabled.simps[of _ \<omega>] suntil.simps[of _ _ \<omega>] E_End E_Init E_Mix
                           enabled_End ev_sconst)
        qed (auto simp: HLD_iff E_Init intro: suntil.intros)
      qed (rule ev_suntil)
    qed }
  note ev_eq_suntil = this

  have "?P Start hit_C = (\<integral>\<^sup>+x. ?P x (ev ?M) * indicator ?I x \<partial>N Start)"
    unfolding hit_C_def by (rule emeasure_HLD_nxt) measurable
  also have "\<dots> = (\<integral>\<^sup>+x. ereal ((1 - p_H) / (1 - p_f * p_H)) * indicator ?I x \<partial>N Start)"
  proof (intro nn_integral_cong mult_indicator_cong)
    fix x assume "x \<in> ?I"
    { fix j assume j: "j \<in> H"
      with ev_eq_suntil[of "Mix j"] have "?P (Mix j) (ev ?M) = ?P (Mix j) ((HLD ?J) suntil ?M)"
        by (intro emeasure_eq_AE) auto
      also have "\<dots> = (((1 - p_H) * p_f)) / (1 - p_H * p_f)"
      proof (rule emeasure_suntil_geometric[OF _ _ _ order_refl p_H_p_f_less_1])
        show "Mix j \<in> Mix`H"
          using j by auto
      next
        fix s assume s: "s \<in> Mix ` H"
        then show
          "AE \<omega> in T s. (?\<phi> aand nxt (HLD (Mix ` C))) \<omega> \<longleftrightarrow> (Mix ` H \<cdot> HLD (Mix ` C)) \<omega>"
          by (auto simp add: AE_T_iff E_Mix E_End)
        from s show
          "AE \<omega> in T s. (?\<phi> aand nxt ?\<phi>) \<omega> \<longleftrightarrow> (Mix ` H \<cdot> ?\<phi>) \<omega>"
          by (auto simp add: AE_T_iff E_Mix)
        from s C_smaller show "?P s ?M = ereal ((1 - p_H) * p_f)"
          by (subst emeasure_HLD)
             (auto simp add: emeasure_measure_pmf_finite setsum.reindex subset_eq p_j_def H_compl
                             real_of_nat_def[symmetric])
        from s show "emeasure (N s) (Mix`H) = p_H * p_f"
          by (auto simp: emeasure_measure_pmf_finite setsum.reindex real_of_nat_def[symmetric] H_eq2)
      qed auto
      finally have "?P (Init j) (ev ?M) = (1 - p_H) / (1 - p_H * p_f)"
        using p_f by (subst emeasure_Init_eq_Mix) (auto simp: ev_Stream AE_End ev_sconst HLD_iff) }
    then show "?P x (ev ?M) = (1 - p_H) / (1 - p_f * p_H)"
      using `x \<in> ?I` by auto
  qed
  also have "\<dots> = ereal ((1 - p_H) / (1 - p_H * p_f))"
    using p_j_pos assms p_H p_H_p_f_less_1
    by (subst nn_integral_cmult_indicator)
       (auto simp: emeasure_measure_pmf_finite setsum.reindex subset_eq mult_ac
             intro!: divide_nonneg_nonneg)
  finally show ?thesis
    by (simp add: measure_def)
qed

lemma before_C_imp_hit_C:
  assumes "enabled Start \<omega>" "before_C B \<omega>"
  shows "hit_C \<omega>"
proof -
  { fix \<omega> j assume "((HLD (Jondo H)) suntil (Jondo (B \<inter> H) \<cdot> HLD (Mix ` C))) \<omega>"
      "j \<in> H" "enabled (Mix j) \<omega>"
    then have "ev (HLD (Mix`C)) \<omega>"
    proof (induction arbitrary: j rule: suntil_induct_strong)
      case (step \<omega>) then show ?case
        by (auto simp: enabled.simps[of _ \<omega>] E_Mix enabled_End ev_sconst suntil_sconst HLD_iff)
    qed auto }
  from this[of "stl (stl \<omega>)"] assms show "hit_C \<omega>"
    by (force simp: before_C_def hit_C_def E_Start HLD_iff E_Init
      enabled.simps[of _ \<omega>] ev.simps[of _ \<omega>] suntil.simps[of _ _ \<omega>]
      enabled.simps[of _ "stl \<omega>"] ev.simps[of _ "stl \<omega>"] suntil.simps[of _ _ "stl \<omega>"])
qed

lemma Pr_visit_before_C:
  assumes L: "L \<subseteq> H" and I: "I \<subseteq> H"
  shows "\<P>(\<omega> in \<PP>. visit I J \<omega> \<and> before_C L \<omega> \<bar> hit_C \<omega> ) =
    (\<Sum>i\<in>I. p_i i) * card L * p_j * p_f + (\<Sum>i\<in>I \<inter> L. p_i i) * (1 - p_H * p_f)"
proof -
  let ?M = "Mix`H"
  let ?P = "\<lambda>x P. emeasure (T x) {\<omega>\<in>space (T x). P \<omega>}"
  let ?V = "(visit I J aand before_C L) aand hit_C"
  let ?U = "HLD ?M suntil (Mix`L \<cdot> HLD (Mix`C))"
  let ?L = "HLD (Mix`C)"

  have [simp, intro]: "finite I" "finite L"
    using L I by (auto dest: finite_subset)

  have "?P Start ?V = ?P Start ((Init`I \<cdot> ?U) or (Init`(I \<inter> L) \<cdot> ?L))"
  proof (rule emeasure_Collect_eq_AE)
    show "AE \<omega> in \<PP>. ?V \<omega> \<longleftrightarrow> ((Init`I \<cdot> ?U) or (Init`(I \<inter> L) \<cdot> ?L)) \<omega>"
      using AE_T_enabled AE_visit
    proof eventually_elim
      case elim then show ?case
        using before_C_imp_hit_C[of \<omega> "L"]  before_C[of \<omega> "L"] I L
        by (auto simp: visit_def HLD_iff Int_absorb2)
    qed
    show "Measurable.pred \<PP> ((Init`I \<cdot> ?U) or (Init`(I \<inter> L) \<cdot> ?L))"
      by measurable
  qed measurable
  also have "\<dots> = ?P Start (Init`I \<cdot> ?U) + ?P Start (Init`(I \<inter> L) \<cdot> ?L)"
    using L I
    apply (subst plus_emeasure)
    apply (auto intro!: arg_cong2[where f=emeasure])
    apply (subst (asm) suntil.simps)
    apply (auto simp add: HLD_iff[abs_def] elim: suntil.cases)
    done
  also have "?P Start (Init`(I \<inter> L) \<cdot> ?L) = (\<Sum>i\<in>I\<inter>L. p_i i * (1 - p_H))"
    using L I C_smaller p_j_pos
    apply (subst emeasure_HLD_nxt emeasure_HLD, simp)+
    apply (subst nn_integral_indicator_finite)
    apply (auto simp: emeasure_measure_pmf_finite setsum.reindex next_prob_def setsum.If_cases
                      real_of_nat_def[symmetric] Int_absorb2 H_compl2
                intro!: setsum.cong setsum_nonneg)
    done
  also have "?P Start (Init`I \<cdot> ?U) = (\<Sum>i\<in>I. ?P (Init i) ?U * p_i i)"
    using I
    by (subst emeasure_HLD_nxt, simp)
       (auto simp: nn_integral_indicator_finite emeasure_nonneg setsum.reindex
                   emeasure_measure_pmf_finite
             intro!: setsum.cong[OF refl])
  also have "\<dots> = (\<Sum>i\<in>I. ereal (p_f * (1 - p_H) * p_j * card L / (1 - p_H * p_f)) * p_i i)"
  proof (intro setsum.cong refl arg_cong2[where f="op *"])
    fix i assume "i \<in> I"
    with I have i: "i \<in> H"
      by auto
    have "?P (Mix i) ?U = (p_f * p_f * (1 - p_H) * p_j * card L / (1 - p_H * p_f))"
      unfolding before_C_def
    proof (rule emeasure_suntil_geometric[OF _ _ _ order_refl, where X="?M"])
      show "Mix i \<in> ?M"
        using i by auto
    next
      fix s assume "s \<in> ?M"
      with p_f p_j_pos L C_smaller[THEN less_imp_le]
      show "?P s (Mix`L \<cdot> (HLD (Mix ` C))) = ereal (p_f * p_f * (1 - p_H) * p_j * card L)"
        apply (simp add: emeasure_HLD emeasure_HLD_nxt del: nxt.simps space_T)
        apply (subst nn_integral_measure_pmf_support[of "Mix`L"])
        apply (auto simp add: subset_eq emeasure_measure_pmf_finite setsum.reindex
                              real_of_nat_def[symmetric] H_compl p_j_def)
        done
    next
      fix s assume "s \<in> ?M" then show "emeasure (N s) ?M = ereal (p_H * p_f)"
        by (auto simp add: emeasure_measure_pmf_finite setsum.reindex H_eq2 real_of_nat_def[symmetric])
    qed (insert L, auto simp: AE_T_iff p_H_p_f_less_1 E_Mix)
    then show "?P (Init i) ?U = p_f * (1 - p_H) * p_j * card L / (1 - p_H * p_f)"
      by (subst emeasure_Init_eq_Mix) (auto simp: AE_End suntil_Stream)
  qed
  finally have *: "\<P>(\<omega> in T Start. ?V \<omega>) =
      (p_f * (1 - p_H) * p_j * (card L) / (1 - p_H * p_f)) * (\<Sum>i\<in>I. p_i i) +
      (\<Sum>i\<in>I \<inter> L. p_i i) * (1 - p_H)"
    by (simp add: mult_ac measure_def setsum_left_distrib[symmetric] setsum_right_distrib[symmetric]
                  setsum_divide_distrib[symmetric])
  show ?thesis
    unfolding cond_prob_def Pr_hit_C *
    using *
    using p_f p_H p_j_pos p_H_p_f_less_1 by (simp add: divide_simps) (simp add: field_simps)
qed

lemma Pr_visit_eq_before_C:
  "\<P>(\<omega> in \<PP>. \<exists>j\<in>H. visit {j} J \<omega> \<and> before_C {j} \<omega> \<bar> hit_C \<omega> ) = 1 - (p_H - p_j) * p_f"
proof -
  let ?V = "\<lambda>j. visit {j} J aand before_C {j}" and ?H = "hit_C"
  let ?J = "H"
  have "\<P>(\<omega> in \<PP>. (\<exists>j\<in>?J. ?V j \<omega>) \<and> ?H \<omega>) = (\<Sum>j\<in>?J. \<P>(\<omega> in \<PP>. (?V j aand ?H) \<omega>))"
  proof (rule T.prob_setsum)
    show "AE \<omega> in \<PP>. (\<forall>j\<in>?J. (?V j aand ?H) \<omega> \<longrightarrow> ((\<exists>j\<in>?J. ?V j \<omega>) \<and> ?H \<omega>)) \<and>
      (((\<exists>j\<in>?J. ?V j \<omega>) \<and> ?H \<omega>) \<longrightarrow> (\<exists>!j. j\<in>?J \<and> (?V j aand ?H) \<omega>))"
      by (auto intro!: AE_I2 dest: visit_unique1)
  qed auto
  then have "\<P>(\<omega> in \<PP>. (\<exists>j\<in>?J. ?V j \<omega>) \<bar> ?H \<omega>) = (\<Sum>j\<in>?J. \<P>(\<omega> in \<PP>. ?V j \<omega> \<bar> ?H \<omega>))"
    by (simp add: cond_prob_def setsum_divide_distrib)
  also have "\<dots> = p_j * p_f + (1 - p_H * p_f)"
    by (simp add: Pr_visit_before_C setsum_left_distrib[symmetric] setsum.distrib)
  finally show ?thesis
    by (simp add: field_simps)
qed

lemma probably_innocent:
  assumes approx: "1 / (2 * (p_H - p_j)) \<le> p_f" and "p_H \<noteq> p_j"
  shows "\<P>(\<omega> in \<PP>. \<exists>j\<in>H. visit {j} J \<omega> \<and> before_C {j} \<omega> \<bar> hit_C \<omega> ) \<le> 1 / 2"
  unfolding Pr_visit_eq_before_C
proof -
  have [simp]: "\<And>n :: nat. 1 \<le> real n \<longleftrightarrow> 1 \<le> n" by auto
  have "0 \<le> p_j" unfolding p_j_def by auto
  then have "1 * p_j \<le> p_H"
    unfolding H_eq2[symmetric] using C_smaller
    by (intro mult_mono) (auto simp: Suc_le_eq card_Diff_subset not_le)
  with `p_H \<noteq> p_j` have "p_j < p_H" by auto
  with approx show "1 - (p_H - p_j) * p_f \<le> 1 / 2"
    by (auto simp add: field_simps divide_le_eq split: split_if_asm)
qed

lemma Pr_before_C:
  assumes L: "L \<subseteq> H"
  shows "\<P>(\<omega> in \<PP>. before_C L \<omega> \<bar> hit_C \<omega> ) =
    card L * p_j * p_f + (\<Sum>l\<in>L. p_i l) * (1 - p_H * p_f)"
proof -
  have "\<P>(\<omega> in \<PP>. before_C L \<omega> \<bar> hit_C \<omega> ) =
    \<P>(\<omega> in \<PP>. visit H J \<omega> \<and> before_C L \<omega> \<bar> hit_C \<omega> )"
    using AE_visit by (auto intro!: T.cond_prob_eq_AE)
  also have "\<dots> = card L * p_j * p_f + (\<Sum>i\<in>L. p_i i) * (1 - p_H * p_f)"
    using L by (subst Pr_visit_before_C[OF L order_refl]) (auto simp: Int_absorb1)
  finally show ?thesis .
qed

lemma P_visit:
  assumes I: "I \<subseteq> H"
  shows "\<P>(\<omega> in \<PP>. visit I J \<omega> \<bar> hit_C \<omega> ) = (\<Sum>i\<in>I. p_i i)"
proof -
  have "\<P>(\<omega> in \<PP>. visit I J \<omega> \<bar> hit_C \<omega> ) =
    \<P>(\<omega> in \<PP>. visit I J \<omega> \<and> before_C H \<omega> \<bar> hit_C \<omega> )"
  proof (rule T.cond_prob_eq_AE)
    show "AE x in \<PP>. hit_C x \<longrightarrow>
                visit I J x = (visit I J x \<and> before_C H x)"
      using AE_T_enabled by eventually_elim (auto intro: hit_C_imp_before_C)
  qed auto
  also have "\<dots> = setsum p_i I"
    using I by (subst Pr_visit_before_C[OF order_refl]) (auto simp: Int_absorb2 field_simps p_H_def p_j_def)
  finally show ?thesis .
qed

subsection {* Probability space of hitting a collaborator *}

definition "hC = uniform_measure \<PP> {\<omega>\<in>space \<PP>. hit_C \<omega>}"

lemma emeasure_hit_C_not_0: "emeasure \<PP> {\<omega> \<in> space \<PP>. hit_C \<omega>} \<noteq> 0"
  using p_H p_H_p_f_less_1 unfolding Pr_hit_C T.emeasure_eq_measure by auto

lemma measurable_hC[measurable (raw)]:
  "A \<in> sets S \<Longrightarrow> A \<in> sets hC"
  "f \<in> measurable M S \<Longrightarrow> f \<in> measurable M hC"
  "g \<in> measurable S M \<Longrightarrow> g \<in> measurable hC M"
  "A \<inter> space S \<in> sets S \<Longrightarrow> A \<inter> space hC \<in> sets S"
  unfolding hC_def uniform_measure_def
  by simp_all

lemma vimage_Int_space_C[simp]:
  "f -` {x} \<inter> space hC = {\<omega>\<in>space S. f \<omega> = x}"
  by (auto simp: hC_def)

sublocale hC!: information_space hC 2
proof -
  interpret hC!: prob_space hC
    unfolding hC_def
    using emeasure_hit_C_not_0
    by (intro prob_space_uniform_measure) auto
  show "information_space hC 2"
    by default simp
qed

abbreviation
  mutual_information_Pow_CP ("\<I>'(_ ; _')") where
  "\<I>(X ; Y) \<equiv> hC.mutual_information 2 (count_space (X`space hC)) (count_space (Y`space hC)) X Y"

lemma simple_functionI:
  assumes "finite (range f)"
  assumes [measurable]: "\<And>x. {\<omega>\<in>space S. f \<omega> = x} \<in> sets S"
  shows "simple_function hC f"
  using assms unfolding simple_function_def hC_def
  by (simp add: vimage_def space_stream_space)

subsection {* Estimate the information to the collaborators *}

lemma measure_hC[simp]:
  assumes A[measurable]: "A \<in> sets S"
  shows "measure hC A = \<P>(\<omega> in \<PP>. \<omega> \<in> A \<bar> hit_C \<omega> )"
  unfolding hC_def cond_prob_def
  using emeasure_hit_C_not_0 A
  by (subst measure_uniform_measure) (simp_all add: T.emeasure_eq_measure Int_def conj_ac)

subsubsection {* Setup random variables for mutual information *}

definition "first_J \<omega> = (THE i. visit {i} J \<omega>)"

lemma first_J_eq:
  "visit {i} J \<omega> \<Longrightarrow> first_J \<omega> = i"
  unfolding first_J_def by (intro the_equality) (auto dest: visit_unique1)

lemma AE_first_J:
  "AE \<omega> in \<PP>. visit {i} J \<omega> \<longleftrightarrow> first_J \<omega> = i"
  using AE_visit
proof eventually_elim
  fix \<omega> assume "visit H J \<omega>"
  then obtain j where "visit {j} J \<omega>" "j \<in> H"
    by (auto simp: visit_def HLD_iff)
  then show "visit {i} J \<omega> \<longleftrightarrow> first_J \<omega> = i"
    by (auto dest: visit_unique1 first_J_eq)
qed

lemma measurbale_first_J[measurable]: "first_J \<in> measurable S (count_space UNIV)"
  unfolding first_J_def[abs_def]
  by (intro measurable_THE[where I=H])
     (auto dest: visit_imp_in_H visit_unique1 intro: countable_finite)

definition "last_H \<omega> = (THE i. before_C {i} \<omega>)"

lemma measurbale_last_H[measurable]: "last_H \<in> measurable S (count_space UNIV)"
  unfolding last_H_def[abs_def]
  by (intro measurable_THE[where I=H])
     (auto dest: before_C_single before_C_unique intro: countable_finite)

lemma last_H_eq:
  "before_C {i} \<omega> \<Longrightarrow> last_H \<omega> = i"
  unfolding last_H_def by (intro the_equality) (auto dest: before_C_unique)

lemma last_H:
  assumes "enabled Start \<omega>" "hit_C \<omega>"
  shows "before_C {last_H \<omega>} \<omega>" "last_H \<omega> \<in> H"
  by (metis before_C_single hit_C_imp_before_C last_H_eq Int_iff assms)+

lemma AE_last_H:
  "AE \<omega> in \<PP>. hit_C \<omega> \<longrightarrow> before_C {i} \<omega> \<longleftrightarrow> last_H \<omega> = i"
  using AE_T_enabled
proof eventually_elim
  fix \<omega> assume "enabled Start \<omega>" then show "hit_C \<omega> \<longrightarrow> before_C {i} \<omega> = (last_H \<omega> = i)"
    by (auto dest: last_H last_H_eq)
qed

lemma information_flow:
  defines "h \<equiv> real (card H)"
  assumes init_uniform: "\<And>i. i \<in> H \<Longrightarrow> p_i i = 1 / h"
  shows "\<I>(first_J ; last_H) \<le> (1 - (h - 1) * p_j * p_f) * log 2 h"
proof -
  let ?il = "\<lambda>i l. \<P>(\<omega> in \<PP>. visit {i} J \<omega> \<and> before_C {l} \<omega> \<bar> hit_C \<omega> )"
  let ?i = "\<lambda>i. \<P>(\<omega> in \<PP>. visit {i} J \<omega> \<bar> hit_C \<omega> )"
  let ?l = "\<lambda>l. \<P>(\<omega> in \<PP>. before_C {l} \<omega> \<bar> hit_C \<omega> )"

  from init_uniform have init_H: "\<And>i. i \<in> H \<Longrightarrow> p_i i = p_j / p_H"
    by (simp add: p_j_def p_H_def h_def)

  from h_def have "1/h = p_j/p_H" "h = p_H / p_j" "p_H = h * p_j"
    by (auto simp: p_H_def p_j_def field_simps)
  from C_smaller have h_pos: "0 < h"
    by (auto simp add: card_gt_0_iff h_def)

  let ?s = "(h - 1) * p_j"
  let ?f = "?s * p_f"

  from psubset_card_mono[OF _ C_smaller]
  have "1 \<le> card J - card C"
    by (simp del: C_le_J)
  then have "1 \<le> h"
    using C_smaller
    by (simp add: h_def card_Diff_subset real_of_nat_diff card_mono field_simps
             del: C_le_J)

  have log_le_0: "?f * log 2 (p_H * p_f) \<le> ?f * log 2 1"
    using p_H_p_f_less_1 p_H_p_f_pos p_j_pos p_f `1 \<le> h`
    by (intro mult_left_mono log_le mult_nonneg_nonneg) auto

  have "(h - 1) * p_j < 1"
    using `1 \<le> h` C_smaller
    by (auto simp: h_def p_j_def divide_less_eq card_Diff_subset real_of_nat_diff card_mono)
  then have 1: "(h - 1) * p_j * p_f < 1 * 1"
    using p_f by (intro mult_strict_mono) auto

  { fix \<omega> have "first_J \<omega> \<in> H \<or> first_J \<omega> = (THE x. False)"
      apply (cases "\<forall>i. \<not> visit {i} J \<omega>")
      apply (simp add: first_J_def)
      apply (auto dest: visit_imp_in_H first_J_eq)
      done }
  then have range_fj: "range first_J \<subseteq> H \<union> {THE x. False}"
    by auto

  have sf_fj: "simple_function hC first_J"
    by (rule simple_functionI) (auto intro: finite_subset[OF range_fj])

  have sd_fj: "simple_distributed hC first_J ?i"
    apply (rule hC.simple_distributedI[OF sf_fj])
    apply (subst measure_hC)
    apply (auto intro!: T.cond_prob_eq_AE)
    apply (auto simp: space_stream_space)
    using AE_first_J
    apply eventually_elim
    apply auto
    done

  { fix \<omega> have "last_H \<omega> \<in> H \<or> last_H \<omega> = (THE x. False)"
      apply (cases "\<forall>i. \<not> before_C {i} \<omega>")
      apply (simp add: last_H_def)
      apply (auto dest: before_C_imp_in_H last_H_eq)
      done }
  then have range_lnc: "range last_H \<subseteq> H \<union> {THE x. False}"
    by auto

  have sf_lnc: "simple_function hC last_H"
    by (rule simple_functionI) (auto intro: finite_subset[OF range_lnc])

  have sd_lnc: "simple_distributed hC last_H ?l"
    apply (rule hC.simple_distributedI[OF sf_lnc])
    apply (subst measure_hC)
    apply (auto intro!: T.cond_prob_eq_AE)
    apply (auto simp: space_stream_space)
    using AE_last_H
    apply eventually_elim
    apply auto
    done

  have sd_fj_lnc: "simple_distributed hC (\<lambda>\<omega>. (first_J \<omega>, last_H \<omega>)) (\<lambda>(i, l). ?il i l)"
    apply (rule hC.simple_distributedI)
    apply (rule simple_function_Pair[OF sf_fj sf_lnc])
    apply (subst measure_hC)
    apply (auto intro!: T.cond_prob_eq_AE)
    apply (auto simp: space_stream_space)
    using AE_last_H AE_first_J
    apply eventually_elim
    apply auto
    done

  def c \<equiv> "SOME j. j \<in> C"
  have c: "c \<in> C"
    using C_non_empty unfolding ex_in_conv[symmetric] c_def by (rule someI_ex)

  let ?inner = "\<lambda>i. \<Sum>l\<in>H. ?il i l * log 2 (?il i l / (?i i * ?l l))"
  { fix i assume i: "i \<in> H"
    with h_pos have card_idx: "real_of_nat (card (H - {i})) = p_H / p_j - 1"
      by (auto simp add: p_j_def p_H_def real_eq_of_nat[symmetric] h_def)

    have neq0: "p_j \<noteq> 0" "p_H \<noteq> 0"
      unfolding p_j_def p_H_def
      using C_smaller i by auto

    from i have "?inner i =
      (\<Sum>l\<in>H - {i}. ?il i l * log 2 (?il i l / (?i i * ?l l))) +
      ?il i i * log 2 (?il i i / (?i i * ?l i))"
      by (simp add: setsum_diff)
    also have "\<dots> =
      (\<Sum>l\<in>H - {i}. p_j/p_H * p_j * p_f * log 2 (p_j * p_f / (p_j * p_f + p_j/p_H * (1 - p_H * p_f)))) +
      p_j/p_H * (p_j * p_f + (1 - p_H * p_f)) * log 2 ((p_j * p_f + (1 - p_H * p_f)) / (p_j * p_f + p_j/p_H * (1 - p_H * p_f)))"
      using i p_f p_j_pos p_H
      apply (simp add: Pr_visit_before_C P_visit init_H Pr_before_C
                  del: setsum_constant)
      apply (simp add: divide_simps distrib_left)
      apply (intro arg_cong2[where f="op*"] refl arg_cong2[where f=log])
      apply (auto simp: field_simps)
      done
    also have "\<dots> = (?f * log 2 (h * p_j * p_f) + (1 - ?f) * log 2 ((1 - ?f) * h)) / h"
      using neq0 p_f by (simp add: card_idx field_simps `p_H = h * p_j`)
    finally have "?inner i = (?f * log 2 (h * p_j * p_f) + (1 - ?f) * log 2 ((1 - ?f) * h)) / h" . }
  then have "(\<Sum>i\<in>H. ?inner i) = ?f * log 2 (h * p_j * p_f) + (1 - ?f) * log 2 ((1 - ?f) * h)"
    using h_pos by (simp add: h_def[symmetric] real_eq_of_nat[symmetric])
  also have "\<dots> = ?f * log 2 (p_H * p_f) + (1 - ?f) * log 2 ((1 - ?f) * h)"
    by (simp add: `h = p_H / p_j`)
  also have "\<dots> \<le> (1 - ?f) * log 2 ((1 - ?f) * h)"
    using log_le_0 by simp
  also have "\<dots> \<le> (1 - ?f) * log 2 h"
    using h_pos `1 \<le> h` 1 p_j_pos p_f
    by (intro mult_left_mono log_le mult_pos_pos mult_nonneg_nonneg) auto
  finally have "(\<Sum>i\<in>H. ?inner i) \<le> (1 - ?f) * log 2 h" .
  also have "(\<Sum>i\<in>H. ?inner i) =
      (\<Sum>(i, l)\<in>(first_J`space S) \<times> (last_H`space S). ?il i l * log 2 (?il i l / (?i i * ?l l)))"
    unfolding setsum.cartesian_product
  proof (safe intro!: setsum.mono_neutral_cong_left del: DiffE DiffI)
    show "finite ((first_J ` space S) \<times> (last_H ` space S))"
      using sf_fj sf_lnc by (auto simp add: hC_def dest!: simple_functionD(1))
  next
    fix i assume "i \<in> H"
    then have "visit {i} J (Init i ## Mix i ## sconst End)"
      "before_C {i} (Init i ## Mix c ## sconst End)"
      by (auto simp: before_C_def visit_def suntil_Stream HLD_iff c)
    then show "i \<in> first_J ` space S" "i \<in> last_H ` space S"
      by (auto simp: space_stream_space image_iff eq_commute dest!: first_J_eq last_H_eq)
  next
    fix i l assume "(i, l) \<in> first_J ` space S \<times> last_H ` space S - H \<times> H"
    then have H: "i \<notin> H \<or> l \<notin> H"
      by auto
    have "\<P>(\<omega> in \<PP>. (visit {i} J \<omega> \<and> before_C {l} \<omega>) \<and> hit_C \<omega>) = 0"
      using H by (intro T.prob_eq_0_AE) (auto dest: visit_imp_in_H before_C_imp_in_H)
    then show "?il i l * log 2 (?il i l / (?i i * ?l l)) = 0"
      by (simp add: cond_prob_def)
  qed
  also have "\<dots> = \<I>(first_J ; last_H)"
    unfolding setsum.cartesian_product
    apply (subst hC.mutual_information_simple_distributed[OF sd_fj sd_lnc sd_fj_lnc])
    apply (simp add: hC_def)
  proof (safe intro!: setsum.mono_neutral_right imageI)
    show "finite ((first_J ` space S) \<times> (last_H ` space S))"
      using sf_fj sf_lnc by (auto simp add: hC_def dest!: simple_functionD(1))
  next
    fix i l assume "(first_J i, last_H l) \<notin> (\<lambda>x. (first_J x, last_H x)) ` space S"
    moreover
    { fix i l assume "i \<in> H" "l \<in> H"
      then have "visit {i} J (Init i ## Mix l ## Mix c ## sconst End)"
        "before_C {l} (Init i ## Mix l ## Mix c ## sconst End)"
        using c C_smaller by (auto simp: before_C_def visit_def HLD_iff suntil_Stream)
      then have "first_J (Init i ## Mix l ## Mix c ## sconst End) = i"
        "last_H (Init i ## Mix l ## Mix c ## sconst End) = l"
        by (auto intro!: first_J_eq last_H_eq) }
    note this[of "first_J i" "last_H l"]
    ultimately have "(first_J i, last_H l) \<notin> H\<times>H"
      by (auto simp: space_stream_space image_iff eq_commute) metis
    then have "\<P>(\<omega> in \<PP>. (visit {first_J i} J \<omega> \<and> before_C {last_H l} \<omega>) \<and> hit_C \<omega>) = 0"
      by (intro T.prob_eq_0_AE) (auto dest: visit_imp_in_H before_C_imp_in_H)
    then show "?il (first_J i) (last_H l) *
      log 2 (?il (first_J i) (last_H l) / (?i (first_J i) * ?l (last_H l))) = 0"
      by (simp add: cond_prob_def)
  qed
  finally show ?thesis by simp
qed

end

end