(*  Title:       variants/e_all_abcd/Aodv_Data.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Predicates and functions used in the AODV model"

theory E_Aodv_Data
imports E_All_ABCD
begin

subsection "Sequence Numbers"

text \<open>Sequence numbers approximate the relative freshness of routing information.\<close>

definition inc :: "sqn \<Rightarrow> sqn"
  where "inc sn \<equiv> if sn = 0 then sn else sn + 1"

lemma less_than_inc [simp]: "x \<le> inc x"
  unfolding inc_def by simp

lemma inc_minus_suc_0 [simp]:
  "inc x - Suc 0 = x"
  unfolding inc_def by simp

lemma inc_never_one' [simp, intro]: "inc x \<noteq> Suc 0"
  unfolding inc_def by simp

lemma inc_never_one [simp, intro]: "inc x \<noteq> 1"
  by simp

subsection "Modelling Routes"

text \<open>
  A route is a t-tuple, @{term "(dsn, dsk, flag, hops, nhip)"} where
  @{term dsn} is the `destination sequence number', @{term dsk} is the
  `destination-sequence-number status', @{term flag} is the route status,
  @{term hops} is the number of hops to the destination, and @{term nhip} is the
  next hop toward the destination.
\<close>

type_synonym r = "sqn \<times> k \<times> f \<times> nat \<times> ip"

definition proj2 :: "r \<Rightarrow> sqn" ("\<pi>\<^sub>2")
  where "\<pi>\<^sub>2 \<equiv> \<lambda>(dsn, _, _, _, _). dsn"

definition proj3 :: "r \<Rightarrow> k" ("\<pi>\<^sub>3")
  where "\<pi>\<^sub>3 \<equiv> \<lambda>(_, dsk, _, _, _). dsk"

definition proj4 :: "r \<Rightarrow> f" ("\<pi>\<^sub>4")
  where "\<pi>\<^sub>4 \<equiv> \<lambda>(_, _, flag, _, _). flag"

definition proj5 :: "r \<Rightarrow> nat" ("\<pi>\<^sub>5")
  where "\<pi>\<^sub>5 \<equiv> \<lambda>(_, _, _, hops, _). hops"

definition proj6 :: "r \<Rightarrow> ip" ("\<pi>\<^sub>6")
  where "\<pi>\<^sub>6 \<equiv> \<lambda>(_, _, _, _, nhip). nhip"

lemma projs [simp]:
  "\<pi>\<^sub>2(dsn, dsk, flag, hops, nhip) = dsn"
  "\<pi>\<^sub>3(dsn, dsk, flag, hops, nhip) = dsk"
  "\<pi>\<^sub>4(dsn, dsk, flag, hops, nhip) = flag"
  "\<pi>\<^sub>5(dsn, dsk, flag, hops, nhip) = hops"
  "\<pi>\<^sub>6(dsn, dsk, flag, hops, nhip) = nhip"
  by (clarsimp simp: proj2_def proj3_def proj4_def
                     proj5_def proj6_def)+

lemma proj3_pred [intro]: "\<lbrakk> P kno; P unk \<rbrakk> \<Longrightarrow> P (\<pi>\<^sub>3 x)"
  by (rule k.induct)

lemma proj4_pred [intro]: "\<lbrakk> P val; P inv \<rbrakk> \<Longrightarrow> P (\<pi>\<^sub>4 x)"
  by (rule f.induct)

subsection "Routing Tables"

text \<open>Routing tables map ip addresses to route entries.\<close>

type_synonym rt = "ip \<rightharpoonup> r"

syntax
  "_Sigma_route" :: "rt \<Rightarrow> ip \<rightharpoonup> r"  ("\<sigma>\<^bsub>route\<^esub>'(_, _')")

translations
 "\<sigma>\<^bsub>route\<^esub>(rt, dip)" => "rt dip"

definition sqn :: "rt \<Rightarrow> ip \<Rightarrow> sqn"
  where "sqn rt dip \<equiv> case \<sigma>\<^bsub>route\<^esub>(rt, dip) of Some r \<Rightarrow> \<pi>\<^sub>2(r) | None \<Rightarrow> 0"

definition sqnf :: "rt \<Rightarrow> ip \<Rightarrow> k"
  where "sqnf rt dip \<equiv> case \<sigma>\<^bsub>route\<^esub>(rt, dip) of Some r \<Rightarrow> \<pi>\<^sub>3(r) | None \<Rightarrow> unk"

abbreviation flag :: "rt \<Rightarrow> ip \<rightharpoonup> f"
  where "flag rt dip \<equiv> map_option \<pi>\<^sub>4 (\<sigma>\<^bsub>route\<^esub>(rt, dip))"

abbreviation dhops :: "rt \<Rightarrow> ip \<rightharpoonup> nat"
   where "dhops rt dip \<equiv> map_option \<pi>\<^sub>5 (\<sigma>\<^bsub>route\<^esub>(rt, dip))"

abbreviation nhop :: "rt \<Rightarrow> ip \<rightharpoonup> ip"
   where "nhop rt dip \<equiv> map_option \<pi>\<^sub>6 (\<sigma>\<^bsub>route\<^esub>(rt, dip))"

definition vD :: "rt \<Rightarrow> ip set"
  where "vD rt \<equiv> {dip. flag rt dip = Some val}"

definition iD :: "rt \<Rightarrow> ip set"
  where "iD rt \<equiv> {dip. flag rt dip = Some inv}"

definition kD :: "rt \<Rightarrow> ip set"
  where "kD rt \<equiv> {dip. rt dip \<noteq> None}"

lemma kD_is_vD_and_iD: "kD rt = vD rt \<union> iD rt"
  unfolding kD_def vD_def iD_def by auto

lemma vD_iD_gives_kD [simp]:
   "\<And>ip rt. ip \<in> vD rt \<Longrightarrow> ip \<in> kD rt"
   "\<And>ip rt. ip \<in> iD rt \<Longrightarrow> ip \<in> kD rt"
  unfolding kD_is_vD_and_iD by simp_all

lemma kD_Some [dest]:
    fixes dip rt
  assumes "dip \<in> kD rt"
    shows "\<exists>dsn dsk flag hops nhip.
           \<sigma>\<^bsub>route\<^esub>(rt, dip) = Some (dsn, dsk, flag, hops, nhip)"
  using assms unfolding kD_def by simp

lemma kD_None [dest]:
    fixes dip rt
  assumes "dip \<notin> kD rt"
    shows "\<sigma>\<^bsub>route\<^esub>(rt, dip) = None"
  using assms unfolding kD_def
  by (metis (mono_tags) mem_Collect_eq)

lemma vD_Some [dest]:
    fixes dip rt
  assumes "dip \<in> vD rt"
    shows "\<exists>dsn dsk hops nhip.
           \<sigma>\<^bsub>route\<^esub>(rt, dip) = Some (dsn, dsk, val, hops, nhip)"
  using assms unfolding vD_def by simp

lemma vD_empty [simp]: "vD Map.empty = {}"
  unfolding vD_def by simp

lemma iD_Some [dest]:
    fixes dip rt
  assumes "dip \<in> iD rt"
    shows "\<exists>dsn dsk hops nhip.
           \<sigma>\<^bsub>route\<^esub>(rt, dip) = Some (dsn, dsk, inv, hops, nhip)"
  using assms unfolding iD_def by simp

lemma val_is_vD [elim]:
    fixes ip rt
  assumes "ip\<in>kD(rt)"
      and "the (flag rt ip) = val"
    shows "ip\<in>vD(rt)"
  using assms unfolding vD_def by auto

lemma inv_is_iD [elim]:
    fixes ip rt
  assumes "ip\<in>kD(rt)"
      and "the (flag rt ip) = inv"
    shows "ip\<in>iD(rt)"
  using assms unfolding iD_def by auto

lemma iD_flag_is_inv [elim, simp]:
    fixes ip rt
  assumes "ip\<in>iD(rt)"
    shows "the (flag rt ip) = inv"
  proof -
    from \<open>ip\<in>iD(rt)\<close> have "ip\<in>kD(rt)" by auto
    with assms show ?thesis unfolding iD_def by auto
  qed

lemma kD_but_not_vD_is_iD [elim]:
    fixes ip rt
  assumes "ip\<in>kD(rt)"
      and "ip\<notin>vD(rt)"
    shows "ip\<in>iD(rt)"
  proof -
    from \<open>ip\<in>kD(rt)\<close> obtain dsn dsk f hops nhop
      where rtip: "rt ip = Some (dsn, dsk, f, hops, nhop)"
       by (metis kD_Some)
    from \<open>ip\<notin>vD(rt)\<close> have "f \<noteq> val"
    proof (rule contrapos_nn)
      assume "f = val"
      with rtip have "the (flag rt ip) = val" by simp
      with \<open>ip\<in>kD(rt)\<close> show "ip\<in>vD(rt)" ..
    qed
    with rtip have "the (flag rt ip)= inv" by simp
    with \<open>ip\<in>kD(rt)\<close> show "ip\<in>iD(rt)" ..
  qed

lemma vD_or_iD [elim]:
    fixes ip rt
  assumes "ip\<in>kD(rt)"
      and "ip\<in>vD(rt) \<Longrightarrow> P rt ip"
      and "ip\<in>iD(rt) \<Longrightarrow> P rt ip"
    shows "P rt ip"
  proof -
    from \<open>ip\<in>kD(rt)\<close> have "ip\<in>vD(rt) \<union> iD(rt)"
      by (simp add: kD_is_vD_and_iD)
    thus ?thesis by (auto elim: assms(2-3))
  qed

lemma proj5_eq_dhops: "\<And>dip rt. dip\<in>kD(rt) \<Longrightarrow> \<pi>\<^sub>5(the (rt dip)) = the (dhops rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj4_eq_flag: "\<And>dip rt. dip\<in>kD(rt) \<Longrightarrow> \<pi>\<^sub>4(the (rt dip)) = the (flag rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj2_eq_sqn: "\<And>dip rt. dip\<in>kD(rt) \<Longrightarrow> \<pi>\<^sub>2(the (rt dip)) = sqn rt dip"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma kD_sqnf_is_proj3 [simp]:
  "\<And>ip rt. ip\<in>kD(rt) \<Longrightarrow> sqnf rt ip = \<pi>\<^sub>3(the (rt ip))"
  unfolding sqnf_def by auto

lemma vD_flag_val [simp]:
  "\<And>dip rt. dip \<in> vD (rt) \<Longrightarrow> the (flag rt dip) = val"
  unfolding vD_def by clarsimp

lemma kD_update [simp]:
  "\<And>rt nip v. kD (rt(nip \<mapsto> v)) = insert nip (kD rt)"
  unfolding kD_def by auto

lemma kD_empty [simp]: "kD Map.empty = {}"
  unfolding kD_def by simp

lemma ip_equal_or_known [elim]:
  fixes rt ip ip'
  assumes "ip = ip' \<or> ip\<in>kD(rt)"
      and "ip = ip' \<Longrightarrow> P rt ip ip'"
      and "\<lbrakk> ip \<noteq> ip'; ip\<in>kD(rt)\<rbrakk> \<Longrightarrow> P rt ip ip'"
    shows "P rt ip ip'"
  using assms by auto

subsection "Updating Routing Tables"

text \<open>Routing table entries are modified through explicit functions.
      The properties of these functions are important in invariant proofs.\<close>

subsubsection "Updating route entries"

lemma not_in_kD_case [simp]:
    fixes dip rt
  assumes "dip \<notin> kD(rt)"
    shows "(case rt dip of None \<Rightarrow> en | Some r \<Rightarrow> es r) = en"
  using assms [THEN kD_None] by auto

lemma rt_Some_sqn [dest]:
    fixes rt and ip dsn dsk flag hops nhip
  assumes "rt ip = Some (dsn, dsk, flag, hops, nhip)"
    shows "sqn rt ip = dsn"
  unfolding sqn_def using assms by simp

lemma not_kD_sqn [simp]:
    fixes dip rt
  assumes "dip \<notin> kD(rt)"
    shows "sqn rt dip = 0"
  using assms unfolding sqn_def
  by simp

definition update_arg_wf :: "r \<Rightarrow> bool"
where "update_arg_wf r \<equiv> \<pi>\<^sub>4(r) = val \<and>
                         (\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk) \<and>
                         (\<pi>\<^sub>3(r) = unk \<longrightarrow> \<pi>\<^sub>5(r) = 1)"

lemma update_arg_wf_gives_cases:
  "\<And>r. update_arg_wf r \<Longrightarrow> (\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)"
  unfolding update_arg_wf_def by simp

lemma update_arg_wf_tuples [simp]:
  "\<And>nhip. update_arg_wf (0, unk, val, Suc 0, nhip)"
  "\<And>n hops nhip. update_arg_wf (Suc n, kno, val, hops,  nhip)"
  unfolding update_arg_wf_def by auto

lemma update_arg_wf_tuples' [elim]:
  "\<And>n hops nhip. Suc 0 \<le> n \<Longrightarrow> update_arg_wf (n, kno, val, hops,  nhip)"
  unfolding update_arg_wf_def by auto

lemma wf_r_cases [intro]:
    fixes P r
  assumes "update_arg_wf r"
      and c1: "\<And>nhip. P (0, unk, val, Suc 0, nhip)"
      and c2: "\<And>dsn hops nhip. dsn > 0 \<Longrightarrow> P (dsn, kno, val, hops, nhip)"
    shows "P r"
  proof -
    obtain dsn dsk flag hops nhip
    where *: "r = (dsn, dsk, flag, hops, nhip)" by (cases r)
    with \<open>update_arg_wf r\<close> have wf1: "flag = val"
                            and wf2: "(dsn = 0) = (dsk = unk)"
                            and wf3: "dsk = unk \<longrightarrow> (hops = 1)"
      unfolding update_arg_wf_def by auto
    have "P (dsn, dsk, flag, hops, nhip)"
    proof (cases dsk)
      assume "dsk = unk"
      moreover with wf2 wf3 have "dsn = 0" and "hops = Suc 0" by auto
      ultimately show ?thesis using \<open>flag = val\<close> by simp (rule c1)
    next
      assume "dsk = kno"
      moreover with wf2 have "dsn > 0" by simp
      ultimately show ?thesis using \<open>flag = val\<close> by simp (rule c2)
    qed
    with * show "P r" by simp
  qed

definition update :: "rt \<Rightarrow> ip \<Rightarrow> r \<Rightarrow> rt"
  where
  "update rt ip r \<equiv>
     case \<sigma>\<^bsub>route\<^esub>(rt, ip) of
       None \<Rightarrow> rt (ip \<mapsto> r)
     | Some s \<Rightarrow>
          if \<pi>\<^sub>2(s) < \<pi>\<^sub>2(r) then rt (ip \<mapsto> r)
          else if \<pi>\<^sub>2(s) = \<pi>\<^sub>2(r) \<and> (\<pi>\<^sub>5(s) > \<pi>\<^sub>5(r) \<or> \<pi>\<^sub>4(s) = inv)
               then rt (ip \<mapsto> r)
               else if \<pi>\<^sub>3(r) = unk
                    then rt (ip \<mapsto> (\<pi>\<^sub>2(s), snd (r)))
                    else rt (ip \<mapsto> s)"

lemma update_simps [simp]:
  fixes r s nrt nr' ns rt ip
  defines "s \<equiv> the \<sigma>\<^bsub>route\<^esub>(rt, ip)"
      and "nr' \<equiv> (\<pi>\<^sub>2(s), \<pi>\<^sub>3(r), \<pi>\<^sub>4(r), \<pi>\<^sub>5(r), \<pi>\<^sub>6(r))"
  shows
  "\<lbrakk>ip \<notin> kD(rt)\<rbrakk>                            \<Longrightarrow> update rt ip r = rt (ip \<mapsto> r)"
  "\<lbrakk>ip \<in> kD(rt); sqn rt ip < \<pi>\<^sub>2(r)\<rbrakk>         \<Longrightarrow> update rt ip r = rt (ip \<mapsto> r)"
  "\<lbrakk>ip \<in> kD(rt); sqn rt ip = \<pi>\<^sub>2(r);
                 the (dhops rt ip) > \<pi>\<^sub>5(r)\<rbrakk> \<Longrightarrow> update rt ip r = rt (ip \<mapsto> r)"
  "\<lbrakk>ip \<in> kD(rt); sqn rt ip = \<pi>\<^sub>2(r);
                 flag rt ip = Some inv\<rbrakk>     \<Longrightarrow> update rt ip r = rt (ip \<mapsto> r)"
  "\<lbrakk>ip \<in> kD(rt); \<pi>\<^sub>3(r) = unk; (\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)\<rbrakk>  \<Longrightarrow> update rt ip r = rt (ip \<mapsto> nr')"
  "\<lbrakk>ip \<in> kD(rt); sqn rt ip \<ge> \<pi>\<^sub>2(r); \<pi>\<^sub>3(r) = kno;
    sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val \<rbrakk>
                                            \<Longrightarrow> update rt ip r = rt (ip \<mapsto> s)"
  proof -
    assume "ip\<notin>kD(rt)"
    hence "\<sigma>\<^bsub>route\<^esub>(rt, ip) = None" ..
    thus "update rt ip r = rt (ip \<mapsto> r)"
      unfolding update_def by simp
  next
    assume "ip \<in> kD(rt)"
       and "sqn rt ip < \<pi>\<^sub>2(r)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with \<open>sqn rt ip < \<pi>\<^sub>2(r)\<close> show "update rt ip r = rt (ip \<mapsto> r)"
      unfolding update_def s_def by auto
  next
    assume "ip \<in> kD(rt)"
       and "sqn rt ip = \<pi>\<^sub>2(r)"
       and "the (dhops rt ip) > \<pi>\<^sub>5(r)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with \<open>sqn rt ip = \<pi>\<^sub>2(r)\<close> and \<open>the (dhops rt ip) > \<pi>\<^sub>5(r)\<close>
      show "update rt ip r = rt (ip \<mapsto> r)"
        unfolding update_def s_def by auto
   next
     assume "ip \<in> kD(rt)"
        and "sqn rt ip = \<pi>\<^sub>2(r)"
        and "flag rt ip = Some inv"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
     with \<open>sqn rt ip = \<pi>\<^sub>2(r)\<close> and \<open>flag rt ip = Some inv\<close>
      show "update rt ip r = rt (ip \<mapsto> r)"
        unfolding update_def s_def by auto
   next
    assume "ip \<in> kD(rt)"
       and "\<pi>\<^sub>3(r) = unk"
       and "(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with \<open>(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)\<close> and \<open>\<pi>\<^sub>3(r) = unk\<close>
      show "update rt ip r = rt (ip \<mapsto> nr')"
        unfolding update_def nr'_def s_def
      by (cases r) simp
   next
    assume "ip \<in> kD(rt)"
       and otherassms: "sqn rt ip \<ge> \<pi>\<^sub>2(r)"
           "\<pi>\<^sub>3(r) = kno"
           "sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
     with otherassms show "update rt ip r = rt (ip \<mapsto> s)"
      unfolding update_def s_def by auto
  qed

lemma update_cases [elim]:
  assumes "(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)"
      and c1: "\<lbrakk>ip \<notin> kD(rt)\<rbrakk> \<Longrightarrow> P (rt (ip \<mapsto> r))"

      and c2: "\<lbrakk>ip \<in> kD(rt); sqn rt ip < \<pi>\<^sub>2(r)\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> r ))"
      and c3: "\<lbrakk>ip \<in> kD(rt); sqn rt ip = \<pi>\<^sub>2(r); the (dhops rt ip) > \<pi>\<^sub>5(r)\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> r ))"
      and c4: "\<lbrakk>ip \<in> kD(rt); sqn rt ip = \<pi>\<^sub>2(r); the (flag rt ip) = inv\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> r ))"
      and c5: "\<lbrakk>ip \<in> kD(rt); \<pi>\<^sub>3(r) = unk\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> (\<pi>\<^sub>2(the \<sigma>\<^bsub>route\<^esub>(rt, ip)), \<pi>\<^sub>3(r),
                                  \<pi>\<^sub>4(r), \<pi>\<^sub>5(r), \<pi>\<^sub>6(r))))"
      and c6: "\<lbrakk>ip \<in> kD(rt); sqn rt ip \<ge> \<pi>\<^sub>2(r); \<pi>\<^sub>3(r) = kno;
                sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> the \<sigma>\<^bsub>route\<^esub>(rt, ip)))"
  shows "(P (update rt ip r))"
  proof (cases "ip \<in> kD(rt)")
    assume "ip \<notin> kD(rt)"
    with c1 show ?thesis
      by simp
  next
    assume "ip \<in> kD(rt)"
    moreover then obtain dsn dsk fl hops nhip
      where rteq: "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    moreover obtain dsn' dsk' fl' hops' nhip'
      where req: "r = (dsn', dsk', fl', hops', nhip')"
        by (cases r) metis
    ultimately show ?thesis
      using \<open>(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)\<close>
            c2 [OF \<open>ip\<in>kD(rt)\<close>]
            c3 [OF \<open>ip\<in>kD(rt)\<close>]
            c4 [OF \<open>ip\<in>kD(rt)\<close>]
            c5 [OF \<open>ip\<in>kD(rt)\<close>]
            c6 [OF \<open>ip\<in>kD(rt)\<close>]
    unfolding update_def sqn_def by auto
  qed

lemma update_cases_kD:
  assumes "(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)"
      and "ip \<in> kD(rt)"
      and c2: "sqn rt ip < \<pi>\<^sub>2(r) \<Longrightarrow> P (rt (ip \<mapsto> r ))"
      and c3: "\<lbrakk>sqn rt ip = \<pi>\<^sub>2(r); the (dhops rt ip) > \<pi>\<^sub>5(r)\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> r ))"
      and c4: "\<lbrakk>sqn rt ip = \<pi>\<^sub>2(r); the (flag rt ip) = inv\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> r ))"
      and c5: "\<pi>\<^sub>3(r) = unk \<Longrightarrow> P (rt (ip \<mapsto> (\<pi>\<^sub>2(the \<sigma>\<^bsub>route\<^esub>(rt, ip)), \<pi>\<^sub>3(r),
                                            \<pi>\<^sub>4(r), \<pi>\<^sub>5(r), \<pi>\<^sub>6(r))))"
      and c6: "\<lbrakk>sqn rt ip \<ge> \<pi>\<^sub>2(r); \<pi>\<^sub>3(r) = kno;
                sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> the \<sigma>\<^bsub>route\<^esub>(rt, ip)))"
  shows "(P (update rt ip r))"
  using assms(1) proof (rule update_cases)
    assume "sqn rt ip < \<pi>\<^sub>2(r)"
    thus "P (rt(ip \<mapsto> r))" by (rule c2)
  next
    assume "sqn rt ip = \<pi>\<^sub>2(r)"
       and "the (dhops rt ip) > \<pi>\<^sub>5(r)"
    thus "P (rt(ip \<mapsto> r))"
      by (rule c3)
  next
    assume "sqn rt ip = \<pi>\<^sub>2(r)"
       and "the (flag rt ip) = inv"
    thus "P (rt(ip \<mapsto> r))"
      by (rule c4)
  next
    assume "\<pi>\<^sub>3(r) = unk"
    thus "P (rt (ip \<mapsto> (\<pi>\<^sub>2(the \<sigma>\<^bsub>route\<^esub>(rt, ip)), \<pi>\<^sub>3(r), \<pi>\<^sub>4(r), \<pi>\<^sub>5(r), \<pi>\<^sub>6(r))))"
      by (rule c5)
  next
    assume "sqn rt ip \<ge> \<pi>\<^sub>2(r)"
       and "\<pi>\<^sub>3(r) = kno"
       and "sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val"
    thus "P (rt (ip \<mapsto> the (rt ip)))"
      by (rule c6)
  qed (simp add: \<open>ip \<in> kD(rt)\<close>)

lemma in_kD_after_update [simp]:
  fixes rt nip dsn dsk flag hops nhip pre
  shows "kD (update rt nip (dsn, dsk, flag, hops, nhip)) = insert nip (kD rt)"
  unfolding update_def
  by (cases "rt nip") auto

lemma nhop_of_update [simp]:
  fixes rt dip dsn dsk flag hops nhip
  assumes "rt \<noteq> update rt dip (dsn, dsk, flag, hops, nhip)"
  shows "the (nhop (update rt dip (dsn, dsk, flag, hops, nhip)) dip) = nhip"
  proof -
  from assms
  have update_neq: "\<And>v. rt dip = Some v \<Longrightarrow>
          update rt dip (dsn, dsk, flag, hops, nhip)
             \<noteq> rt(dip \<mapsto> the (rt dip))"
    by auto
  show ?thesis
    proof (cases "rt dip = None")
      assume "rt dip = None"
      thus "?thesis" unfolding update_def by clarsimp
    next
      assume "rt dip \<noteq> None"
      then obtain v where "rt dip = Some v" by (metis not_None_eq)
      with update_neq [OF this] show ?thesis
        unfolding update_def by auto
    qed
  qed

lemma sqn_if_updated:
  fixes rip v rt ip
  shows "sqn (\<lambda>x. if x = rip then Some v else rt x) ip
         = (if ip = rip then \<pi>\<^sub>2(v) else sqn rt ip)"
  unfolding sqn_def by simp

lemma update_sqn [simp]:
  fixes rt dip rip dsn dsk hops nhip
  assumes "(dsn = 0) = (dsk = unk)"
  shows "sqn rt dip \<le> sqn (update rt rip (dsn, dsk, val, hops, nhip)) dip"
  proof (rule update_cases)
    show "(\<pi>\<^sub>2 (dsn, dsk, val, hops, nhip) = 0) = (\<pi>\<^sub>3 (dsn, dsk, val, hops, nhip) = unk)"
      by simp (rule assms)
  qed (clarsimp simp: sqn_if_updated sqn_def)+

lemma sqn_update_bigger [simp]:
    fixes rt ip ip' dsn dsk flag hops nhip
  assumes "1 \<le> hops"
    shows "sqn rt ip \<le> sqn (update rt ip' (dsn, dsk, flag, hops, nhip)) ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.split) auto

lemma dhops_update [intro]:
    fixes rt dsn dsk flag hops ip rip nhip
  assumes ex: "\<forall>ip\<in>kD rt. the (dhops rt ip) \<ge> 1"
      and ip: "(ip = rip \<and> Suc 0 \<le> hops) \<or> (ip \<noteq> rip \<and> ip\<in>kD rt)"
    shows "Suc 0 \<le> the (dhops (update rt rip (dsn, dsk, flag, hops, nhip)) ip)"
  using ip proof
    assume "ip = rip \<and> Suc 0 \<le> hops" thus ?thesis
      unfolding update_def using ex
      by (cases "rip \<in> kD rt") (drule(1) bspec, auto)
  next
    assume "ip \<noteq> rip \<and> ip\<in>kD rt" thus ?thesis
      using ex unfolding update_def
      by (cases "rip\<in>kD rt") auto
  qed

lemma update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip \<noteq> dip"
    shows "(update rt dip (dsn, dsk, flag, hops, nhip)) ip = rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma nhop_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip \<noteq> dip"
    shows "nhop (update rt dip (dsn, dsk, flag, hops, nhip)) ip = nhop rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma dhops_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip \<noteq> dip"
    shows "dhops (update rt dip (dsn, dsk, flag, hops, nhip)) ip = dhops rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma sqn_update_same [simp]:
  "\<And>rt ip dsn dsk flag hops nhip. sqn (rt(ip \<mapsto> v)) ip = \<pi>\<^sub>2(v)"
  unfolding sqn_def by simp

lemma dhops_update_changed [simp]:
    fixes rt dip osn hops nhip
  assumes "rt \<noteq> update rt dip (osn, kno, val, hops, nhip)"
    shows "the (dhops (update rt dip (osn, kno, val, hops, nhip)) dip) = hops"
  using assms unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma nhop_update_changed [simp]:
    fixes rt dip dsn dsk flg hops sip
  assumes "update rt dip (dsn, dsk, flg, hops, sip) \<noteq> rt"
    shows "the (nhop (update rt dip (dsn, dsk, flg, hops, sip)) dip) = sip"
  using assms unfolding update_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_rt_split_asm:
  "\<And>rt ip dsn dsk flag hops sip.
   P (update rt ip (dsn, dsk, flag, hops, sip))
   =
   (\<not>(rt = update rt ip (dsn, dsk, flag, hops, sip) \<and> \<not>P rt
      \<or> rt \<noteq> update rt ip (dsn, dsk, flag, hops, sip)
         \<and> \<not>P (update rt ip (dsn, dsk, flag, hops, sip))))"
  by auto

lemma sqn_update [simp]: "\<And>rt dip dsn flg hops sip.
  rt \<noteq> update rt dip (dsn, kno, flg, hops, sip)
  \<Longrightarrow> sqn (update rt dip (dsn, kno, flg, hops, sip)) dip = dsn"
  unfolding update_def by (clarsimp split: option.split if_split_asm) auto

lemma sqnf_update [simp]: "\<And>rt dip dsn dsk flg hops sip.
  rt \<noteq> update rt dip (dsn, dsk, flg, hops, sip)
  \<Longrightarrow> sqnf (update rt dip (dsn, dsk, flg, hops, sip)) dip = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_kno_dsn_greater_zero:
  "\<And>rt dip ip dsn hops. 1 \<le> dsn \<Longrightarrow> 1 \<le> (sqn (update rt dip (dsn, kno, val, hops, ip)) dip)"
   unfolding update_def
  by (clarsimp split: option.splits)

lemma proj3_update [simp]: "\<And>rt dip dsn dsk flg hops sip.
  rt \<noteq> update rt dip (dsn, dsk, flg, hops, sip)
  \<Longrightarrow> \<pi>\<^sub>3(the (update rt dip (dsn, dsk, flg, hops, sip) dip)) = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma nhop_update_changed_kno_val [simp]: "\<And>rt ip dsn dsk hops nhip.
  rt \<noteq> update rt ip (dsn, kno, val, hops, nhip)
   \<Longrightarrow> the (nhop (update rt ip (dsn, kno, val, hops, nhip)) ip) = nhip"
  unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma flag_update [simp]: "\<And>rt dip dsn flg hops sip.
  rt \<noteq> update rt dip (dsn, kno, flg, hops, sip)
  \<Longrightarrow> the (flag (update rt dip (dsn, kno, flg, hops, sip)) dip) = flg"
  unfolding update_def
  by (clarsimp split: option.split if_split_asm) auto

lemma the_flag_Some [dest!]:
    fixes ip rt
  assumes "the (flag rt ip) = x"
      and "ip \<in> kD rt"
    shows "flag rt ip = Some x"
  using assms by auto

lemma kD_update_unchanged [dest]:
    fixes rt dip dsn dsk flag hops nhip
  assumes "rt = update rt dip (dsn, dsk, flag, hops, nhip)"
    shows "dip\<in>kD(rt)"
  proof -
    have "dip\<in>kD(update rt dip (dsn, dsk, flag, hops, nhip))" by simp
    with assms show ?thesis by simp
  qed

lemma nhop_update [simp]: "\<And>rt dip dsn dsk flg hops sip.
  rt \<noteq> update rt dip (dsn, dsk, flg, hops, sip)
  \<Longrightarrow> the (nhop (update rt dip (dsn, dsk, flg, hops, sip)) dip) = sip"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma sqn_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip \<noteq> dip"
    shows "sqn (update rt dip (dsn, dsk, flag, hops, nhip)) ip = sqn rt ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.splits) auto

lemma vD_update_val [dest]:
  "\<And>dip rt dip' dsn dsk hops nhip.
   dip \<in> vD(update rt dip' (dsn, dsk, val, hops, nhip)) \<Longrightarrow> (dip\<in>vD(rt) \<or> dip=dip')"
   unfolding update_def vD_def by (clarsimp split: option.split_asm if_split_asm)

subsubsection "Invalidating route entries"

definition invalidate :: "rt \<Rightarrow> (ip \<rightharpoonup> sqn) \<Rightarrow> rt"
where "invalidate rt dests \<equiv>
  \<lambda>ip. case (rt ip, dests ip) of
    (None, _) \<Rightarrow> None
  | (Some s, None) \<Rightarrow> Some s
  | (Some (_, dsk, _, hops, nhip), Some rsn) \<Rightarrow>
                      Some (rsn, dsk, inv, hops, nhip)"

lemma proj3_invalidate [simp]:
  "\<And>dip. \<pi>\<^sub>3(the ((invalidate rt dests) dip)) = \<pi>\<^sub>3(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj5_invalidate [simp]:
  "\<And>dip. \<pi>\<^sub>5(the ((invalidate rt dests) dip)) = \<pi>\<^sub>5(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj6_invalidate [simp]:
  "\<And>dip. \<pi>\<^sub>6(the ((invalidate rt dests) dip)) = \<pi>\<^sub>6(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

subsection "Route Requests"

lemma invalidate_kD_inv [simp]:
  "\<And>rt dests. kD (invalidate rt dests) = kD rt"
  unfolding invalidate_def kD_def
  by (simp split: option.split)

lemma invalidate_sqn:
  fixes rt dip dests
  assumes "\<forall>rsn. dests dip = Some rsn \<longrightarrow> sqn rt dip \<le> rsn"
  shows "sqn rt dip \<le> sqn (invalidate rt dests) dip"
  proof (cases "dip \<notin> kD(rt)")
    assume "\<not> dip \<notin> kD(rt)"
    hence "dip\<in>kD(rt)" by simp
    then obtain dsn dsk flag hops nhip where "rt dip = Some (dsn, dsk, flag, hops, nhip)"
      by (metis kD_Some)
    with assms show "sqn rt dip \<le> sqn (invalidate rt dests) dip"
      by (cases "dests dip") (auto simp add: invalidate_def sqn_def)
  qed simp

lemma sqn_invalidate_in_dests [simp]:
    fixes dests ipa rsn rt
  assumes "dests ipa = Some rsn"
      and "ipa\<in>kD(rt)"
    shows "sqn (invalidate rt dests) ipa = rsn"
  unfolding invalidate_def sqn_def
  using assms(1) assms(2) [THEN kD_Some]
  by clarsimp

lemma dhops_invalidate [simp]:
  "\<And>dip. the (dhops (invalidate rt dests) dip) = the (dhops rt dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma sqnf_invalidate [simp]:
  "\<And>dip. sqnf (invalidate (rt \<xi>) (dests \<xi>)) dip = sqnf (rt \<xi>) dip"
  unfolding sqnf_def invalidate_def by (clarsimp split: option.split)

lemma nhop_invalidate [simp]:
  "\<And>dip. the (nhop (invalidate (rt \<xi>) (dests \<xi>)) dip) = the (nhop (rt \<xi>) dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_other [simp]:
    fixes rt dests dip
  assumes "dip\<notin>dom(dests)"
    shows "invalidate rt dests dip = rt dip"
  using assms unfolding invalidate_def
  by (clarsimp split: option.split_asm)

lemma invalidate_none [simp]:
    fixes rt dests dip
  assumes "dip\<notin>kD(rt)"
    shows "invalidate rt dests dip = None"
  using assms unfolding invalidate_def by clarsimp

lemma vD_invalidate_vD_not_dests:
  "\<And>dip rt dests. dip\<in>vD(invalidate rt dests) \<Longrightarrow> dip\<in>vD(rt) \<and> dests dip = None"
  unfolding invalidate_def vD_def
  by (clarsimp split: option.split_asm)

lemma sqn_invalidate_not_in_dests [simp]:
  fixes dests dip rt
  assumes "dip\<notin>dom(dests)"
  shows "sqn (invalidate rt dests) dip = sqn rt dip"
  using assms unfolding sqn_def by simp

lemma invalidate_changes:
    fixes rt dests dip dsn dsk flag hops nhip pre
  assumes "invalidate rt dests dip = Some (dsn, dsk, flag, hops, nhip)"
    shows "  dsn = (case dests dip of None \<Rightarrow> \<pi>\<^sub>2(the (rt dip)) | Some rsn \<Rightarrow> rsn)
           \<and> dsk = \<pi>\<^sub>3(the (rt dip))
           \<and> flag = (if dests dip = None then \<pi>\<^sub>4(the (rt dip)) else inv)
           \<and> hops = \<pi>\<^sub>5(the (rt dip))
           \<and> nhip = \<pi>\<^sub>6(the (rt dip))"
  using assms unfolding invalidate_def
  by (cases "rt dip", clarsimp, cases "dests dip") auto

lemma proj3_inv: "\<And>dip rt dests. dip\<in>kD (rt)
                      \<Longrightarrow> \<pi>\<^sub>3(the (invalidate rt dests dip)) = \<pi>\<^sub>3(the (rt dip))"
  by (clarsimp simp: invalidate_def kD_def split: option.split)

lemma dests_iD_invalidate [simp]:
  assumes "dests ip = Some rsn"
      and "ip\<in>kD(rt)"
    shows "ip\<in>iD(invalidate rt dests)"
  using assms(1) assms(2) [THEN kD_Some] unfolding invalidate_def iD_def
  by (clarsimp split: option.split)

subsection "Queued Packets"

text \<open>Functions for sending data packets.\<close>

type_synonym store = "ip \<rightharpoonup> (p \<times> data list)"

definition sigma_queue :: "store \<Rightarrow> ip \<Rightarrow> data list"    ("\<sigma>\<^bsub>queue\<^esub>'(_, _')")
  where "\<sigma>\<^bsub>queue\<^esub>(store, dip) \<equiv> case store dip of None \<Rightarrow> [] | Some (p, q) \<Rightarrow> q"

definition qD :: "store \<Rightarrow> ip set"
  where "qD \<equiv> dom"

definition add :: "data \<Rightarrow> ip \<Rightarrow> store \<Rightarrow> store"
  where "add d dip store \<equiv> case store dip of
                              None \<Rightarrow> store (dip \<mapsto> (req, [d]))
                            | Some (p, q) \<Rightarrow> store (dip \<mapsto> (p, q @ [d]))"

lemma qD_add [simp]:
  fixes d dip store
  shows "qD(add d dip store) = insert dip (qD store)"
  unfolding add_def Let_def qD_def
  by (clarsimp split: option.split)

definition drop :: "ip \<Rightarrow> store \<rightharpoonup> store"
  where "drop dip store \<equiv>
    map_option (\<lambda>(p, q). if tl q = [] then store (dip := None)
                                      else store (dip \<mapsto> (p, tl q))) (store dip)"

definition sigma_p_flag :: "store \<Rightarrow> ip \<rightharpoonup> p" ("\<sigma>\<^bsub>p-flag\<^esub>'(_, _')")
  where "\<sigma>\<^bsub>p-flag\<^esub>(store, dip) \<equiv> map_option fst (store dip)"

definition unsetRRF :: "store \<Rightarrow> ip \<Rightarrow> store"
  where "unsetRRF store dip \<equiv> case store dip of
                                None \<Rightarrow> store
                              | Some (p, q) \<Rightarrow> store (dip \<mapsto> (noreq, q))"

definition setRRF :: "store \<Rightarrow> (ip \<rightharpoonup> sqn) \<Rightarrow> store"
  where "setRRF store dests \<equiv> \<lambda>dip. if dests dip = None then store dip
                                    else map_option (\<lambda>(_, q). (req, q)) (store dip)"

subsection "Comparison with the original technical report"

text \<open>
  The major differences with the AODV technical report of Fehnker et al are:
  \begin{enumerate}
  \item @{term nhop} is partial, thus a `@{term the}' is needed, similarly for @{term dhops}
        and @{term addpreRT}.
  \item @{term precs} is partial.
  \item @{term "\<sigma>\<^bsub>p-flag\<^esub>(store, dip)"} is partial.
  \item The routing table (@{typ rt}) is modelled as a map (@{typ "ip \<Rightarrow> r option"})
        rather than a set of 7-tuples, likewise, the @{typ r} is a 6-tuple rather than
        a 7-tuple, i.e., the destination ip-address (@{term "dip"}) is taken from the
        argument to the function, rather than a part of the result. Well-definedness then
        follows from the structure of the type and more related facts are available
        automatically, rather than having to be acquired through tedious proofs.
  \item Similar remarks hold for the dests mapping passed to @{term "invalidate"},
        and @{term "store"}.
  \end{enumerate}
\<close>

end


theory Habbouly160503144
imports VDMToolkit VDMSet VDMRecord

begin

text {*  NAME   STD-NO *}

(*=========================================================================================*)
section {* Introduction *}

text {* Write here your design decisions as text.

        It is a good idea to structure your Isabelle model per VDM construct
        in (sub)sections. We add section snipets for you below.

        Key features of Isabelle syntax needed in the definitions are given as
        comments.
      *}

(*=========================================================================================*)
section {* VDM values *}

text {* Write here values you might have declared in Overture. Remember that in Isabelle
        you must declare before you can use! VDM values can be given as Isabelle @{term abbreviation}.
      *}

(* In VDM it would look like:
        SIZE : nat = 3;

   In Isabelle:
        abbreviation name :: "TYPE" where "name \<equiv> EXPR"

--{* abbreviation name :: "TYPE" where "name \<equiv> EXPR" *}
*)

abbreviation
    SIZE :: "VDMNat1"
where
    "SIZE \<equiv> 4"

abbreviation
    BOXN :: "VDMNat1"
where
    "BOXN \<equiv> 2*SIZE + 1"

abbreviation
    DOTN :: "VDMNat1"
where
    "DOTN \<equiv> SIZE * SIZE"

(*=========================================================================================*)
section {* VDM types and their invariants *}

text {* VDM enumerations can be Isabelle data type. For example *}

(*--{* datatype name :: name = VALUE1 | VALUEN *}*)
(*datatype Player = NOUGHT | CROSS*)

print_theorems  (*--"curiosity: Player type has loads of useful facts in Isabelle!"*)

text {* VDM types like pairs can be constructed with @{term type_synonym}.
        VDM type invariants are functions from the type to boolean. Remember
        that you need to define and check type invariants manually in Isabelle!

        As in VDM, you can write pattern matching (let) expressions to simplify models.
        For example, we use a let expression below in the invariant definition for type Pos.
      *}

(*  In VDM it would look like:

      Pos = nat * nat
      inv mk_(x,y) == x <= SIZE and y <= SIZE

      inv_Pos : nat * nat -> bool
      inv_Pos(x,y) == x <= SIZE and y <= SIZE
*)

(*{* type_synonym name = "TYPE_EXPR" *}*)
type_synonym Dot = VDMNat1

(*{* definition name :: "TYPE1 \<Rightarrow> TYPN \<Rightarrow> RES_TYPE" where "name \<equiv> DEF" *}*)
definition
  inv_Dot :: "VDMNat1 \<Rightarrow> bool"
where
  "inv_Dot dot \<equiv>  inv_VDMNat1 dot  \<and> dot \<le> SIZE"

record Move =
  dot1field:: Dot
  dot2field:: Dot
print_theorems

definition
  inv_Move :: "Move \<Rightarrow> bool"
  where
  "inv_Move m \<equiv> (let x=(dot1field m); s=(dot2field m) in
                    inv_Dot x \<and>
                    inv_Dot s \<and>
                    x < s \<and>
                    s \<le> DOTN \<and>
                    (if x mod SIZE = 0 then
                    s = x+1
                    else
                    s = x+SIZE \<or> s = x+1 ))"

record Player =
  boxesfield:: "VDMNat VDMSet"
  movelistfield:: "Move VDMSet"
print_theorems

record Box =
  nofield:: VDMNat1
  movesfield:: "Move VDMSet"

definition
  inv_Box :: "Box \<Rightarrow> bool"
  where
  "inv_Box b \<equiv> (let x=(nofield b); y=(movesfield b) in
                   inv_VDMNat1 x \<and>
                  inv_VDMSet y\<and>
                  vdm_card  y < 4)"

type_synonym Boxs = "Box VDMSet"

definition
  inv_Boxs :: "Boxs \<Rightarrow> bool"
  where
  "inv_Boxs b \<equiv> vdm_card b \<le> BOXN"

datatype result = P1HASWON | P2HASWON | DRAW

abbreviation
    p1 :: "Player"
    where
    "p1 \<equiv> \<lparr> boxesfield = {} , movelistfield = {}\<rparr>"

abbreviation
    p2 :: "Player"
    where
    "p2 \<equiv> \<lparr> boxesfield = {} , movelistfield = {}\<rparr>"

abbreviation
    q :: "VDMNat1 VDMSet"
    where
    "q \<equiv> {1 .. (DOTN-SIZE)}"

abbreviation
    BoxList :: "Boxs"
    where
    "BoxList \<equiv> { \<lparr>nofield = s , movesfield = { \<lparr>dot1field = s, dot2field = s+1\<rparr>,
                                               \<lparr>dot1field = s, dot2field = s+SIZE\<rparr>,
                                               \<lparr>dot1field = s+1, dot2field = s+1+SIZE\<rparr>,
                                               \<lparr>dot1field = s+SIZE, dot2field = s+1+SIZE\<rparr>}\<rparr>
                                               | s . s \<in> q \<and> s mod SIZE \<noteq> 0}"

(*=========================================================================================*)
section {* VDM functions *}

text {* VDM functions can be described using Isabelle @{term definition}
        (e.g. predicates, or basic functions) or @{term fun} (e.g. recursive definitions).
     *}

(*-----------------------------------------------------------------------------------------*)
subsection {* Explicitly defined functions *}

text {* Encode here your explicitly defined VDM functions. Remember that you need to define
        and check type invariants, as well as VDM pre/post conditions manually in Isabelle!

        For every VDM function, you need to define three entities: function itself, and
        its pre and post conditions.

        Precondition definitions go from function parameters to bool, whereas
        postcondition definitions go from function parameters and result to bool.
      *}
(* In VDM these look like:
        myFun: nat * nat -> nat
        myFun(t1,t2) == t1 + t2
          pre t1 > 0 and t2 > 0
          post RESULT >= t1+t2;

        pre_myFun: nat * nat -> bool
        pre_myFun(t1,t2) == t1 > 0 and t2 > 0

        post_myFun: nat * nat * nat -> bool
        post_myFun(t1,t2,RESULT) == RESULT >= t1+t2

    Pre/Pos are optional in VDM explicit functions.
*)

definition
  removeFromBoxes :: " Move \<Rightarrow> Boxs \<Rightarrow> Boxs "
  where
  "removeFromBoxes m b \<equiv> {\<lparr>nofield = nofield x , movesfield = movesfield x\<rparr>
                                        | x . x \<in> b \<and> movesfield x \<noteq> {m}} "

definition
  pre_removeFromBoxes :: " Move \<Rightarrow> Boxs \<Rightarrow> bool "
  where
  "pre_removeFromBoxes m b \<equiv> b \<noteq> {}"

print_theorems

definition
  chooseMove :: " Move \<Rightarrow> Player \<Rightarrow> Boxs \<Rightarrow> Player "
  where
  "chooseMove m p b \<equiv> if \<exists> x .(x \<in> b \<and> movesfield x = {m} )then
                               \<lparr>boxesfield = boxesfield p \<union> {nofield x |x . x \<in> b \<and> movesfield  x = {m}}
                                                                   ,movelistfield = movelistfield p\<rparr>
                      else
                               \<lparr>boxesfield = boxesfield p,movelistfield = movelistfield p \<union> {m}\<rparr>"

definition
  pre_chooseMove :: " Move \<Rightarrow> Player \<Rightarrow> Boxs \<Rightarrow> bool "
  where
  "pre_chooseMove m p b \<equiv> \<exists> x . (x \<in> b \<and> m \<in> movesfield x)"

definition
  post_chooseMove :: " Move \<Rightarrow> Player \<Rightarrow> Boxs \<Rightarrow> bool "
  where
  "post_chooseMove m p b \<equiv> \<exists> x . ( x \<in> movelistfield p \<and> x = m)"

definition
  switchPlayers :: "bool \<Rightarrow> bool"
  where
  "switchPlayers p1plays \<equiv> if p1plays then False else True"

definition
  isTurnPl1 :: "Move \<Rightarrow> Boxs \<Rightarrow> bool \<Rightarrow> bool"
  where
  "isTurnPl1 m b bo \<equiv> if \<exists> x . (x \<in> b \<and> movesfield x = {m}) then bo
                      else switchPlayers(bo)"

definition
  isTurnPl1_pre :: "Move \<Rightarrow> Boxs \<Rightarrow> bool \<Rightarrow> bool"
  where
  "isTurnPl1_pre m b bo \<equiv> \<exists> x . (x \<in> b \<and> m \<in> movesfield x)"

definition
  tally :: "Player \<Rightarrow> Player \<Rightarrow> result"
  where
  "tally pl1 pl2 \<equiv> if vdm_card (movelistfield pl1) > vdm_card (movelistfield pl2 )then
                       P1HASWON
                    else
                    (if vdm_card (movelistfield pl1) < vdm_card (movelistfield pl2) then
                        P2HASWON
                        else
                        DRAW)"

definition
  tally_pre :: "Player \<Rightarrow> Player \<Rightarrow> bool"
  where
  "tally_pre pl1 pl2 \<equiv> pl1 \<noteq> pl2"
(*
definition
  myFun :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
  "myFun t1 t2 \<equiv> t1 + t2"

print_theorems (*--"what Isabelle knows about @{term myFun}?"*)

definition
  pre_myFun :: "nat \<Rightarrow> nat \<Rightarrow> bool"
where
  "pre_myFun t1 t2 \<equiv> t1 > 0 \<and> t2 > 0"

definition
  post_myFun :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool"
where
  "post_myFun t1 t2 RESULT \<equiv> RESULT \<ge> t1+t2"
*)

(*-----------------------------------------------------------------------------------------*)
subsection {* Implicitly defined functions *}

text {* Encode here your implicitly defined VDM functions. Remember that you need to check
        type invariants, as well as VDM pre/post conditions manually in Isabelle!
      *}
(* In VDM these look like:
        myFun(T1 * T2) r: T3
          [pre PRED]
          post PRED;

   Pre is optional; Post is mandatory in VDM implicit functions
*)

(*=========================================================================================*)
section {* VDM state *}

record DBGame =
  P1field :: Player
  P2field :: Player
  p1playsfield :: bool
  BoxListfield :: Boxs

definition
  inv_DBGame_flat :: "Player \<Rightarrow> Player \<Rightarrow> bool \<Rightarrow> Boxs \<Rightarrow> bool"
  where
  "inv_DBGame_flat pl1 pl2 pl1pl b \<equiv> \<forall> x .( x \<in> movelistfield pl1 \<and>
                                     (\<forall> i .(i \<in> movelistfield pl2 \<and>
                                     i \<noteq> x \<and>
                                     (\<forall> y .(y \<in> b  \<and>
                                     (\<forall> z . (z \<in> movesfield y \<and>
                                     z \<noteq> i \<and> z \<noteq> x  )))))))"

definition
  inv_DBGame :: "DBGame \<Rightarrow> bool "
  where
  "inv_DBGame state \<equiv> inv_DBGame_flat (P1field state)
                                      (P2field state)
                                      (p1playsfield state)
                                      (BoxListfield state)"

definition
  init_DBGame :: "DBGame"
  where
  "init_DBGame \<equiv> \<lparr> P1field = p1, P2field = p2, p1playsfield = True , BoxListfield = BoxList\<rparr>"

definition
  post_init_DBGame :: "bool"
  where
  "post_init_DBGame \<equiv> inv_DBGame (init_DBGame)"

(*=========================================================================================*)
section {* VDM operations (over the state) *}

definition
  pre_play_move :: "Move \<Rightarrow> DBGame \<Rightarrow> bool"
  where
  "pre_play_move m DB \<equiv> \<exists> x . (x \<in> BoxListfield DB \<and> m \<in> movesfield x)"

definition
  post_play_move :: "Move \<Rightarrow> DBGame \<Rightarrow> DBGame \<Rightarrow> bool"
  where
  "post_play_move m preDB postDB \<equiv> \<forall> x . (x \<in> BoxListfield postDB \<and>
                                (\<forall> y . (y \<in> movesfield x \<and> m \<noteq> y \<and>
                                 BoxListfield postDB \<noteq> BoxListfield preDB \<and>
                                 (P1field preDB \<noteq> P1field postDB \<or>
                                  P2field preDB \<noteq> P2field postDB))))"

definition
  play_move :: "Move \<Rightarrow> DBGame \<Rightarrow> DBGame"
  where
  "play_move m DB \<equiv> if p1playsfield DB then
                       \<lparr>P1field = chooseMove(m)(P1field DB)(BoxListfield DB),
                       P2field = P2field DB,
                       p1playsfield = isTurnPl1 (m)(BoxListfield DB)(p1playsfield DB) ,
                       BoxListfield = removeFromBoxes(m)(BoxListfield DB)\<rparr>
                     else
                      \<lparr>P1field = P1field DB,
                       P2field =chooseMove(m)(P2field DB)(BoxListfield DB),
                       p1playsfield = isTurnPl1 (m)(BoxListfield DB)(p1playsfield DB) ,
                       BoxListfield = removeFromBoxes(m)(BoxListfield DB)\<rparr>"
(*=========================================================================================*)
section {* VDM proof obligations *}

text {* If you use Overture, generate proof obligation text and write it using Isabelle.
        You can name your goals with the same name as the Overture PO for my reference.
      *}
(*-----------------------------------------------------------------------------------------*)
subsection {* Well formedness (if any) *}

(*{* lemma goal_name : "predicate" proof_script *}*)
lemma myFun_subtype: "P = NP"
oops

(*-----------------------------------------------------------------------------------------*)
subsection {* Satisfiability (of each VDM operation) *}

lemma myFun_satisfiability: "P = NP"
oops

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
subsubsection {* Operation1 .. N *}

lemma "P = NP"
oops

(*-----------------------------------------------------------------------------------------*)
subsection {* Sanity checks *}

lemma "P = NP"
oops

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
subsubsection {* Single winner or draw *}

lemma "P = NP"
oops

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
subsubsection {* Moves within board maximum size *}

lemma "P = NP"
oops

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
subsubsection {* Moves fairness (i.e. one player move per round) *}

lemma "P = NP"
oops

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_regexp_Reverse
imports "../../Test_Base"
begin

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

datatype A = X | Y

datatype R
         = Nil | Eps | Atom "A" | Plus "R" "R" | Seq "R" "R" | Star "R"

fun x :: "'a list => 'a list => 'a list" where
"x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun seq :: "R => R => R" where
"seq y z =
   (case y of
      Nil => Nil
      | other =>
          (case z of
             Nil => Nil
             | other =>
                 (case y of
                    Eps => z
                    | other =>
                        (case z of
                           Eps => y
                           | other => Seq y z))))"

fun reverse :: "'a list => 'a list" where
"reverse (nil2) = nil2"
| "reverse (cons2 z xs) = x (reverse xs) (cons2 z (nil2))"

fun rev :: "R => R" where
"rev y =
   (case y of
      Plus a b => Plus (rev a) (rev b)
      | Seq c b2 => Seq (rev b2) (rev c)
      | Star a2 => Star (rev a2)
      | other => y)"

fun plus :: "R => R => R" where
"plus y z =
   (case y of
      Nil => z
      | other =>
          (case z of
             Nil => y
             | other => Plus y z))"

fun eqA :: "A => A => bool" where
"eqA (X) (X) = True"
| "eqA (X) (Y) = False"
| "eqA (Y) (X) = False"
| "eqA (Y) (Y) = True"

fun eps :: "R => bool" where
"eps y =
   (case y of
      Eps => True
      | Plus p q => ((eps p) | (eps q))
      | Seq r q2 => ((eps r) & (eps q2))
      | Star z => True
      | other => False)"

fun epsR :: "R => R" where
"epsR y = (if eps y then Eps else Nil)"

fun step :: "R => A => R" where
"step y z =
   (case y of
      Atom a => (if eqA a z then Eps else Nil)
      | Plus p q => plus (step p z) (step q z)
      | Seq r q2 => plus (seq (step r z) q2) (seq (epsR r) (step q2 z))
      | Star p2 => seq (step p2 z) y
      | other => Nil)"

fun recognise :: "R => A list => bool" where
"recognise y (nil2) = eps y"
| "recognise y (cons2 z2 xs) = recognise (step y z2) xs"

theorem property0 :
  "((recognise (rev r) s) = (recognise r (reverse s)))"
  oops

end


subsection \<open>Optimal Binary Search Trees\<close>

theory OptBST
imports
  "HOL-Library.Tree"
  "HOL-Library.Code_Target_Numeral"
  "../state_monad/State_Main"
  "../heap_monad/Heap_Default"
  Example_Misc
begin

subsubsection \<open>Misc\<close>

(* FIXME mv List *)
lemma induct_list012:
  "\<lbrakk>P []; \<And>x. P [x]; \<And>x y zs. P (y # zs) \<Longrightarrow> P (x # y # zs)\<rbrakk> \<Longrightarrow> P xs"
by induction_schema (pat_completeness, lexicographic_order)

lemma upto_split1:
  "i \<le> j \<Longrightarrow> j \<le> k \<Longrightarrow> [i..k] = [i..j-1] @ [j..k]"
proof (induction j rule: int_ge_induct)
  case base thus ?case by (simp add: upto_rec1)
next
  case step thus ?case using upto_rec1 upto_rec2 by simp
qed

lemma upto_split2:
  "i \<le> j \<Longrightarrow> j \<le> k \<Longrightarrow> [i..k] = [i..j] @ [j+1..k]"
using upto_rec1 upto_rec2 upto_split1 by auto

lemma upto_Nil: "[i..j] = [] \<longleftrightarrow> j < i"
by (simp add: upto.simps)

lemma upto_Nil2: "[] = [i..j] \<longleftrightarrow> j < i"
by (simp add: upto.simps)

lemma upto_join3: "\<lbrakk> i \<le> j; j \<le> k \<rbrakk> \<Longrightarrow> [i..j-1] @ j # [j+1..k] = [i..k]"
using upto_rec1 upto_split1 by auto

fun arg_min_list :: "('a \<Rightarrow> ('b::linorder)) \<Rightarrow> 'a list \<Rightarrow> 'a" where
"arg_min_list f [x] = x" |
"arg_min_list f (x#y#zs) = (let m = arg_min_list f (y#zs) in if f x \<le> f m then x else m)"

lemma f_arg_min_list_f: "xs \<noteq> [] \<Longrightarrow> f (arg_min_list f xs) = Min (f ` (set xs))"
by(induction f xs rule: arg_min_list.induct) (auto simp: min_def intro!: antisym)
(* end mv *)

subsubsection \<open>Definitions\<close>

context
fixes W :: "int \<Rightarrow> int \<Rightarrow> nat"
begin

fun wpl :: "int \<Rightarrow> int \<Rightarrow> int tree \<Rightarrow> nat" where
   "wpl i j Leaf = 0"
 | "wpl i j (Node l k r) = wpl i (k-1) l + wpl (k+1) j r + W i j"

function min_wpl :: "int \<Rightarrow> int \<Rightarrow> nat" where
"min_wpl i j =
  (if i > j then 0
   else min_list (map (\<lambda>k. min_wpl i (k-1) + min_wpl (k+1) j + W i j) [i..j]))"
by auto
termination by (relation "measure (\<lambda>(i,j) . nat(j-i+1))") auto
declare min_wpl.simps[simp del]

function opt_bst :: "int * int \<Rightarrow> int tree" where
"opt_bst (i,j) =
  (if i > j then Leaf else arg_min_list (wpl i j) [\<langle>opt_bst (i,k-1), k, opt_bst (k+1,j)\<rangle>. k \<leftarrow> [i..j]])"
by auto
termination by (relation "measure (\<lambda>(i,j) . nat(j-i+1))") auto
declare opt_bst.simps[simp del]

subsubsection \<open>Functional Memoization\<close>

context
  fixes n :: nat
begin

context fixes
  mem :: "nat option array"
begin

memoize_fun min_wpl\<^sub>T: min_wpl
  with_memory dp_consistency_heap_default where bound = "Bound (0, 0) (int n, int n)" and mem="mem"
  monadifies (heap) min_wpl.simps

context includes heap_monad_syntax begin
thm min_wpl\<^sub>T'.simps min_wpl\<^sub>T_def
end

memoize_correct
  by memoize_prover

lemmas memoized_empty = min_wpl\<^sub>T.memoized_empty

end (* Fixed array *)

context
  includes heap_monad_syntax
  notes [simp del] = min_wpl\<^sub>T'.simps
begin

definition "min_wpl\<^sub>h \<equiv> \<lambda> i j. Heap_Monad.bind (mem_empty (n * n)) (\<lambda> mem. min_wpl\<^sub>T' mem i j)"

lemma min_wpl_heap:
  "min_wpl i j = result_of (min_wpl\<^sub>h i j) Heap.empty"
  unfolding min_wpl\<^sub>h_def
  using memoized_empty[of _ "\<lambda> m. \<lambda> (a, b). min_wpl\<^sub>T' m a b" "(i, j)", OF min_wpl\<^sub>T.crel]
  by (simp add: index_size_defs)

end

end (* Bound *)

context begin
memoize_fun min_wpl\<^sub>m: min_wpl with_memory dp_consistency_mapping monadifies (state) min_wpl.simps
thm min_wpl\<^sub>m'.simps

memoize_correct
  by memoize_prover
print_theorems
lemmas [code] = min_wpl\<^sub>m.memoized_correct

end

subsubsection \<open>Correctness Proof\<close>

lemma min_wpl_minimal:
  "inorder t = [i..j] \<Longrightarrow> min_wpl i j \<le> wpl i j t"
proof(induction i j t rule: wpl.induct)
  case (1 i j)
  then show ?case by (simp add: min_wpl.simps upto_Nil2)
next
  case (2 i j l k r)
  then show ?case
  proof cases
    assume "i > j" thus ?thesis by(simp add: min_wpl.simps)
  next
    assume [arith]: "\<not> i > j"
    have kk_ij: "k\<in>set[i..j]" using 2
        by (metis set_inorder tree.set_intros(2))

    let ?M = "((\<lambda>k. min_wpl i (k-1) + min_wpl (k+1) j + W i j) ` {i..j})"
    let ?w = "min_wpl i (k-1) + min_wpl (k+1) j + W i j"

    have aux_min:"Min ?M \<le> ?w"
    proof (rule Min_le)
      show "finite ?M" by simp
      show "?w \<in> ?M" using kk_ij by auto
    qed

    have"inorder \<langle>l,k,r\<rangle> = inorder l @k#inorder r" by auto
    from this have C:"[i..j] = inorder l @ k#inorder r" using 2 by auto
    have D: "[i..j] = [i..k-1]@k#[k+1..j]" using kk_ij upto_rec1 upto_split1
      by (metis atLeastAtMost_iff set_upto)

    have l_inorder: "inorder l = [i..k-1]"
      by (smt C D append_Cons_eq_iff atLeastAtMost_iff set_upto)
    have r_inorder: "inorder r = [k+1..j]"
      by (smt C D append_Cons_eq_iff atLeastAtMost_iff set_upto)

    have "min_wpl i j = Min ?M" by (simp add: min_wpl.simps min_list_Min upto_Nil)
    also have "... \<le> ?w" by (rule aux_min)
    also have "... \<le> wpl i (k-1) l + wpl (k+1) j r + W i j" using l_inorder r_inorder "2.IH" by simp
    also have "... = wpl i j \<langle>l,k,r\<rangle>" by simp
    finally show ?thesis .
  qed
qed

lemma P_arg_min_list: "(\<And>x. x \<in> set xs \<Longrightarrow> P x) \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> P(arg_min_list f xs)"
by(induction f xs rule: arg_min_list.induct) (auto simp: Let_def)

lemma opt_bst_correct: "inorder (opt_bst (i,j)) = [i..j]"
apply(induction "(i,j)" arbitrary: i j rule: opt_bst.induct)
by (force simp: opt_bst.simps upto_Nil upto_join3 intro: P_arg_min_list)

lemma wpl_opt_bst: "wpl i j (opt_bst (i,j)) = min_wpl i j"
proof(induction i j rule: min_wpl.induct)
  case (1 i j)
  show ?case
  proof cases
    assume "i > j" thus ?thesis by(simp add: min_wpl.simps opt_bst.simps)
  next
    assume *[arith]: "\<not> i > j"
    let ?ts = "[\<langle>opt_bst (i,k-1), k, opt_bst (k+1,j)\<rangle>. k <- [i..j]]"
    let ?M = "((\<lambda>k. min_wpl i (k-1) + min_wpl (k+1) j + W i j) ` {i..j})"
    have "?ts \<noteq> []" by (auto simp add: upto.simps)
    have "wpl i j (opt_bst (i,j)) = wpl i j (arg_min_list (wpl i j) ?ts)" by (simp add: opt_bst.simps)
    also have "\<dots> = Min (wpl i j ` (set ?ts))" by(rule f_arg_min_list_f[OF \<open>?ts \<noteq> []\<close>])
    also have "\<dots> = Min ?M"
    proof (rule arg_cong[where f=Min])
      show "wpl i j ` (set ?ts) = ?M"
        by (fastforce simp: Bex_def image_iff 1[OF *])
    qed
    also have "\<dots> = min_wpl i j" by (simp add: min_wpl.simps min_list_Min upto_Nil)
    finally show ?thesis .
  qed
qed

lemma opt_bst_is_optimal:
  "inorder t = [i..j] \<Longrightarrow> wpl i j (opt_bst (i,j)) \<le> wpl i j t"
by (simp add: min_wpl_minimal wpl_opt_bst)

end

subsubsection \<open>Test Case\<close>

code_thms min_wpl

definition "min_wpl_test = min_wpl\<^sub>h (\<lambda>i j. nat(i+j)) 2 3 3"

code_reflect Test functions min_wpl_test

ML \<open>Test.min_wpl_test ()\<close>

end


theory Chapter10_3
imports
  "HOL-IMP.Live"
  "HOL-IMP.Small_Step"
  "Short_Theory"
begin

text\<open>
\exercise
Prove the following termination-insensitive version of the correctness of
@{const L}:
\<close>

theorem "\<lbrakk> (c,s) \<Rightarrow> s';  (c,t) \<Rightarrow> t';  s = t on L c X \<rbrakk> \<Longrightarrow> s' = t' on X"
(* your definition/proof here *)

text\<open>
Do not derive it as a corollary of the original correctness theorem
but prove it separately. Hint: modify the original proof.
\endexercise

\exercise\label{exe:bury-not-idemp}
Find a command @{text c} such that @{prop"bury (bury c {}) {} \<noteq> bury c {}"}.
For an arbitrary command, can you put a limit on the amount of burying needed
until everything that is dead is also buried?
\<close>

text\<open>
\endexercise

\exercise
Let @{term"lvars c"} / @{term"rvars c"} be the set of variables that
occur on the left-hand / right-hand side of an assignment in @{text c}.
Let @{term "rvars c"} additionally including those variables mentioned in
the conditionals of @{text IF} and @{text WHILE}.
Both functions are predefined in theory @{short_theory "Vars"}.
Show the following two properties of the small-step semantics.
Variables that are not assigned to do not change their value:
\<close>

lemma "\<lbrakk>(c,s) \<rightarrow>* (c',s'); lvars c \<inter> X = {}\<rbrakk> \<Longrightarrow> s = s' on X"
(* your definition/proof here *)

text\<open>
The reduction behaviour of a command is only influenced by the variables
read by the command:
\<close>

lemma "\<lbrakk>(c,s) \<rightarrow>* (c',s'); s = t on X; rvars c \<subseteq> X\<rbrakk>
  \<Longrightarrow> \<exists>t'. (c,t) \<rightarrow>* (c',t') \<and> s' = t' on X"
(* your definition/proof here *)

text\<open>
Hint: prove single step versions of the lemmas first.
\endexercise

\exercise
An \concept{available definitions} analysis determines which previous
assignments \texttt{x := a} are valid equalities \texttt{x = a} at later
program points.  For example, after \texttt{x := y+1} the equality \texttt{x =
y+1} is available, but after \mbox{\texttt{x := y+1;}} \texttt{y := 2} the equality \texttt{x = y+1} is
no longer available. The motivation for the analysis is that if \texttt{x =
a} is available before \texttt{v := a} then \mbox{\texttt{v := a}} can be replaced by
\texttt{v := x}.

Define an available definitions analysis as a gen/kill analysis,
for suitably defined @{text gen} and @{text kill} (which may need to be
mutually recursive):
\<close>
hide_const (open) gen "kill"
fun gen :: "com \<Rightarrow> (vname * aexp) set"
and "kill" :: "com \<Rightarrow> (vname * aexp) set" where
(* your definition/proof here *)

definition AD :: "(vname * aexp) set \<Rightarrow> com \<Rightarrow> (vname * aexp) set" where
"AD A c = gen c \<union> (A - kill c)"

text\<open>
The defining equations for both @{const gen} and @{const kill} follow
the \isacom{where} and are separated by \<open>\<close>@{text "|"}'' as usual.

A call \ @{term"AD A c"} \ should compute the available definitions
after the execution of @{text c} assuming that the definitions in @{text A}
are available before the execution of @{text c}.

Prove correctness of the analysis:
\<close>

theorem "\<lbrakk> (c,s) \<Rightarrow> s';  \<forall> (x,a) \<in> A. s x = aval a s \<rbrakk>
  \<Longrightarrow> \<forall> (x,a) \<in> AD A c. s' x = aval a s'"
(* your definition/proof here *)

text\<open>
\endexercise
\<close>

end


theory Dining_Cryptographers
imports "HOL-Probability.Information"
begin

lemma image_ex1_eq: "inj_on f A \<Longrightarrow> (b \<in> f ` A) \<longleftrightarrow> (\<exists>!x \<in> A. b = f x)"
  by (unfold inj_on_def) blast

lemma Ex1_eq: "\<exists>!x. P x \<Longrightarrow> P x \<Longrightarrow> P y \<Longrightarrow> x = y"
  by auto

subsection \<open>Define the state space\<close>

text \<open>

We introduce the state space on which the algorithm operates.

This contains:

\begin{description}
\item[n]
  The number of cryptographers on the table.

\item[payer]
  Either one of the cryptographers or the NSA.

\item[coin]
  The result of the coin flipping for each cryptographer.

\item[inversion]
  The public result for each cryptographer, e.g. the sum of the coin flipping
  for the cryptographer, its right neighbour and the information if he paid or
  not.

\end{description}

The observables are the \emph{inversions}

\<close>

locale dining_cryptographers_space =
  fixes n :: nat
  assumes n_gt_3: "n \<ge> 3"
begin

definition "dining_cryptographers =
  ({None} \<union> Some ` {0..<n}) \<times> {xs :: bool list. length xs = n}"
definition "payer dc = fst dc"
definition coin :: "(nat option \<times> bool list) \<Rightarrow> nat \<Rightarrow> bool" where
  "coin dc c = snd dc ! (c mod n)"
definition "inversion dc =
  map (\<lambda>c. (payer dc = Some c) \<noteq> (coin dc c \<noteq> coin dc (c + 1))) [0..<n]"

definition "result dc = foldl (\<lambda> a b. a \<noteq> b) False (inversion dc)"

lemma coin_n[simp]: "coin dc n = coin dc 0"
  unfolding coin_def by simp

theorem correctness:
  assumes "dc \<in> dining_cryptographers"
  shows "result dc \<longleftrightarrow> (payer dc \<noteq> None)"
proof -
  let ?XOR = "\<lambda>f l. foldl (\<noteq>) False (map f [0..<l])"

  have foldl_coin:
    "\<not> ?XOR (\<lambda>c. coin dc c \<noteq> coin dc (c + 1)) n"
  proof -
    define n' where "n' = n" \<comment> \<open>Need to hide n, as it is hidden in coin\<close>
    have "?XOR (\<lambda>c. coin dc c \<noteq> coin dc (c + 1)) n'
        = (coin dc 0 \<noteq> coin dc n')"
      by (induct n') auto
    thus ?thesis using \<open>n' \<equiv> n\<close> by simp
  qed

  from assms have "payer dc = None \<or> (\<exists>k<n. payer dc = Some k)"
    unfolding dining_cryptographers_def payer_def by auto
  thus ?thesis
  proof (rule disjE)
    assume "payer dc = None"
    thus ?thesis unfolding result_def inversion_def
      using foldl_coin by simp
  next
    assume "\<exists>k<n. payer dc = Some k"
    then obtain k where "k < n" and "payer dc = Some k" by auto
    define l where "l = n" \<comment> \<open>Need to hide n, as it is hidden in coin, payer etc.\<close>
    have "?XOR (\<lambda>c. (payer dc = Some c) \<noteq> (coin dc c \<noteq> coin dc (c + 1))) l =
        ((k < l) \<noteq> ?XOR (\<lambda>c. (coin dc c \<noteq> coin dc (c + 1))) l)"
      using \<open>payer dc = Some k\<close> by (induct l) auto
    thus ?thesis
      unfolding result_def inversion_def l_def
      using \<open>payer dc = Some k\<close> foldl_coin \<open>k < n\<close> by simp
  qed
qed

text \<open>

We now restrict the state space for the dining cryptographers to the cases when
one of the cryptographer pays.

\<close>

definition
  "dc_crypto = dining_cryptographers - {None}\<times>UNIV"

lemma dc_crypto: "dc_crypto = Some ` {0..<n} \<times> {xs :: bool list. length xs = n}"
  unfolding dc_crypto_def dining_cryptographers_def by auto

lemma image_payer_dc_crypto: "payer ` dc_crypto = Some ` {0..<n}"
proof -
  have *: "{xs. length xs = n} \<noteq> {}"
    by (auto intro!: exI[of _ "replicate n undefined"])
  show ?thesis
    unfolding payer_def [abs_def] dc_crypto fst_image_times if_not_P[OF *] ..
qed

lemma card_payer_and_inversion:
  assumes "xs \<in> inversion ` dc_crypto" and "i < n"
  shows "card {dc \<in> dc_crypto. payer dc = Some i \<and> inversion dc = xs} = 2"
    (is "card ?S = 2")
proof -
  obtain ys j where xs_inv: "inversion (Some j, ys) = xs" and
    "j < n" and "(Some j, ys) \<in> dc_crypto"
    using assms(1) by (auto simp: dc_crypto)

  hence "length ys = n" by (simp add: dc_crypto)
  have [simp]: "length xs = n" using xs_inv[symmetric] by (simp add: inversion_def)

  { fix b
    have "inj_on (\<lambda>x. inversion (Some i, x)) {ys. ys ! 0 = b \<and> length ys = length xs}"
    proof (rule inj_onI)
      fix x y
      assume "x \<in> {ys. ys ! 0 = b \<and> length ys = length xs}"
        and "y \<in> {ys. ys ! 0 = b \<and> length ys = length xs}"
        and inv: "inversion (Some i, x) = inversion (Some i, y)"
      hence [simp]: "x ! 0 = y ! 0" "length y = n" "length x = n"
        using \<open>length xs = n\<close> by simp_all
      have *: "\<And>j. j < n \<Longrightarrow>
        (x ! j = x ! (Suc j mod n)) = (y ! j = y ! (Suc j mod n))"
        using inv unfolding inversion_def map_eq_conv payer_def coin_def
        by fastforce
      show "x = y"
      proof (rule nth_equalityI, simp)
        fix j assume "j < length x" hence "j < n" using \<open>length xs = n\<close> by simp
        thus "x ! j = y ! j"
        proof (induct j)
          case (Suc j)
          hence "j < n" by simp
          with Suc show ?case using *[OF \<open>j < n\<close>]
            by (cases "y ! j") simp_all
        qed simp
      qed
    qed }
  note inj_inv = this

  txt \<open>
    We now construct the possible inversions for \<^term>\<open>xs\<close> when the payer is
    \<^term>\<open>i\<close>.
\<close>

  define zs where "zs = map (\<lambda>p. if p \<in> {min i j<..max i j} then \<not> ys ! p else ys ! p) [0..<n]"
  hence [simp]: "length zs = n" by simp
  hence [simp]: "0 < length zs" using n_gt_3 by simp

  have "\<And>l. l < max i j \<Longrightarrow> Suc l mod n = Suc l"
    using \<open>i < n\<close> \<open>j < n\<close> by auto
  { fix l assume "l < n"
    hence "(((l < min i j \<or> l = min i j) \<or> (min i j < l \<and> l < max i j)) \<or> l = max i j) \<or> max i j < l" by auto
    hence "((i = l) = (zs ! l = zs ! (Suc l mod n))) = ((j = l) = (ys ! l = ys ! (Suc l mod n)))"
    apply - proof ((erule disjE)+)
      assume "l < min i j"
      hence "l \<noteq> i" and "l \<noteq> j" and "zs ! l = ys ! l" and
        "zs ! (Suc l mod n) = ys ! (Suc l mod n)" using \<open>i < n\<close> \<open>j < n\<close> unfolding zs_def by auto
      thus ?thesis by simp
    next
      assume "l = min i j"
      show ?thesis
      proof (cases rule: linorder_cases)
        assume "i < j"
        hence "l = i" and "Suc l < n" and "i \<noteq> j" and "Suc l \<le> max i j" using \<open>l = min i j\<close> using \<open>j < n\<close> by auto
        hence "zs ! l = ys ! l" and "zs ! (Suc l mod n) = (\<not> ys ! (Suc l mod n))"
          using \<open>l = min i j\<close>[symmetric] by (simp_all add: zs_def)
        thus ?thesis using \<open>l = i\<close> \<open>i \<noteq> j\<close> by simp
      next
        assume "j < i"
        hence "l = j" and "Suc l < n" and "i \<noteq> j" and "Suc l \<le> max i j" using \<open>l = min i j\<close> using \<open>i < n\<close> by auto
        hence "zs ! l = ys ! l" and "zs ! (Suc l mod n) = (\<not> ys ! (Suc l mod n))"
          using \<open>l = min i j\<close>[symmetric] by (simp_all add: zs_def)
        thus ?thesis using \<open>l = j\<close> \<open>i \<noteq> j\<close> by simp
      next
        assume "i = j"
        hence "i = j" and "max i j = l" and "min i j = l" and "zs = ys"
          using \<open>l = min i j\<close> by (simp_all add: zs_def \<open>length ys = n\<close>[symmetric] map_nth)
        thus ?thesis by simp
      qed
    next
      assume "min i j < l \<and> l < max i j"
      hence "i \<noteq> l" and "j \<noteq> l" and "zs ! l = (\<not> ys ! l)"
        "zs ! (Suc l mod n) = (\<not> ys ! (Suc l mod n))"
        using \<open>i < n\<close> \<open>j < n\<close> by (auto simp: zs_def)
      thus ?thesis by simp
    next
      assume "l = max i j"
      show ?thesis
      proof (cases rule: linorder_cases)
        assume "i < j"
        hence "l = j" and "i \<noteq> j" using \<open>l = max i j\<close> using \<open>j < n\<close> by auto
        have "zs ! (Suc l mod n) = ys ! (Suc l mod n)"
          using \<open>j < n\<close> \<open>i < j\<close> \<open>l = j\<close> by (cases "Suc l = n") (auto simp add: zs_def)
        moreover have "zs ! l = (\<not> ys ! l)"
          using \<open>j < n\<close> \<open>i < j\<close> by (auto simp add: \<open>l = j\<close> zs_def)
        ultimately show ?thesis using \<open>l = j\<close> \<open>i \<noteq> j\<close> by simp
      next
        assume "j < i"
        hence "l = i" and "i \<noteq> j" using \<open>l = max i j\<close> by auto
        have "zs ! (Suc l mod n) = ys ! (Suc l mod n)"
          using \<open>i < n\<close> \<open>j < i\<close> \<open>l = i\<close> by (cases "Suc l = n") (auto simp add: zs_def)
        moreover have "zs ! l = (\<not> ys ! l)"
          using \<open>i < n\<close> \<open>j < i\<close> by (auto simp add: \<open>l = i\<close> zs_def)
        ultimately show ?thesis using \<open>l = i\<close> \<open>i \<noteq> j\<close> by auto
      next
        assume "i = j"
        hence "i = j" and "max i j = l" and "min i j = l" and "zs = ys"
          using \<open>l = max i j\<close> by (simp_all add: zs_def \<open>length ys = n\<close>[symmetric] map_nth)
        thus ?thesis by simp
      qed
    next
      assume "max i j < l"
      hence "j \<noteq> l" and "i \<noteq> l" by simp_all
      have "zs ! (Suc l mod n) = ys ! (Suc l mod n)"
        using \<open>l < n\<close> \<open>max i j < l\<close> by (cases "Suc l = n") (auto simp add: zs_def)
      moreover have "zs ! l = ys ! l"
        using \<open>l < n\<close> \<open>max i j < l\<close> by (auto simp add: zs_def)
      ultimately show ?thesis using \<open>j \<noteq> l\<close> \<open>i \<noteq> l\<close> by auto
    qed }
  hence zs: "inversion (Some i, zs) = xs"
    by (simp add: xs_inv[symmetric] inversion_def coin_def payer_def)
  moreover
  from zs have Not_zs: "inversion (Some i, (map Not zs)) = xs"
    by (simp add: xs_inv[symmetric] inversion_def coin_def payer_def)
  ultimately
  have "{dc \<in> dc_crypto. payer dc = Some i \<and> inversion dc = xs} =
    {(Some i, zs), (Some i, map Not zs)}"
    using \<open>i < n\<close> [[ hypsubst_thin = true ]]
  proof (safe, simp_all add:dc_crypto payer_def)
    fix b assume [simp]: "length b = n"
      and *: "inversion (Some i, b) = xs" and "b \<noteq> zs"
    show "b = map Not zs"
    proof (cases "b ! 0 = zs ! 0")
      case True
      hence zs: "zs \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs} \<and> xs = inversion (Some i, zs)"
        using zs by simp
      have b: "b \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs} \<and> xs = inversion (Some i, b)"
        using * by simp
      hence "b \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs}" ..
      with *[symmetric] have "xs \<in> (\<lambda>x. inversion (Some i, x)) ` {ys. ys ! 0 = b ! 0 \<and> length ys = length xs}"
         by (rule image_eqI)
      from this[unfolded image_ex1_eq[OF inj_inv]] b zs
      have "b = zs" by (rule Ex1_eq)
      thus ?thesis using \<open>b \<noteq> zs\<close> by simp
    next
      case False
      hence zs: "map Not zs \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs} \<and> xs = inversion (Some i, map Not zs)"
        using Not_zs by (simp add: nth_map[OF \<open>0 < length zs\<close>])
      have b: "b \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs} \<and> xs = inversion (Some i, b)"
        using * by simp
      hence "b \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs}" ..
      with *[symmetric] have "xs \<in> (\<lambda>x. inversion (Some i, x)) ` {ys. ys ! 0 = b ! 0 \<and> length ys = length xs}"
         by (rule image_eqI)
      from this[unfolded image_ex1_eq[OF inj_inv]] b zs
      show "b = map Not zs" by (rule Ex1_eq)
    qed
  qed
  moreover
  have "zs \<noteq> map Not zs"
    using \<open>0 < length zs\<close> by (cases zs) simp_all
  ultimately show ?thesis by simp
qed

lemma finite_dc_crypto: "finite dc_crypto"
  using finite_lists_length_eq[where A="UNIV :: bool set"]
  unfolding dc_crypto by simp

lemma card_inversion:
  assumes "xs \<in> inversion ` dc_crypto"
  shows "card {dc \<in> dc_crypto. inversion dc = xs} = 2 * n"
proof -
  let ?set = "\<lambda>i. {dc \<in> dc_crypto. payer dc = Some i \<and> inversion dc = xs}"
  let ?sets = "{?set i | i. i < n}"

  have [simp]: "length xs = n" using assms
    by (auto simp: dc_crypto inversion_def [abs_def])

  have "{dc \<in> dc_crypto. inversion dc = xs} = (\<Union>i < n. ?set i)"
    unfolding dc_crypto payer_def by auto
  also have "\<dots> = (\<Union>?sets)" by auto
  finally have eq_Union: "{dc \<in> dc_crypto. inversion dc = xs} = (\<Union>?sets)" by simp

  have card_double: "2 * card ?sets = card (\<Union>?sets)"
  proof (rule card_partition)
    show "finite ?sets" by simp
    { fix i assume "i < n"
      have "?set i \<subseteq> dc_crypto" by auto
      have "finite (?set i)" using finite_dc_crypto by auto }
    thus "finite (\<Union>?sets)" by auto

  next
    fix c assume "c \<in> ?sets"
    thus "card c = 2" using card_payer_and_inversion[OF assms] by auto

  next
    fix x y assume "x \<in> ?sets" and "y \<in> ?sets" "x \<noteq> y"
    then obtain i j where xy: "x = ?set i" "y = ?set j" by auto
    hence "i \<noteq> j" using \<open>x \<noteq> y\<close> by auto
    thus "x \<inter> y = {}" using xy by auto
  qed

  have sets: "?sets = ?set ` {..< n}"
    unfolding image_def by auto
  { fix i j :: nat assume asm: "i \<noteq> j" "i < n" "j < n"
    { assume iasm: "?set i = {}"
      have "card (?set i) = 2"
        using card_payer_and_inversion[OF assms \<open>i < n\<close>] by auto
      hence "False"
        using iasm by auto }
    then obtain c where ci: "c \<in> ?set i" by blast
    hence cj: "c \<notin> ?set j" using asm by auto
    { assume "?set i = ?set j"
      hence "False" using ci cj by auto }
    hence "?set i \<noteq> ?set j" by auto }
  hence "inj_on ?set {..< n}" unfolding inj_on_def by auto
  from card_image[OF this]
  have "card (?set ` {..< n}) = n" by auto
  hence "card ?sets = n" using sets by auto
  thus ?thesis using eq_Union card_double by auto
qed

lemma card_dc_crypto:
  "card dc_crypto = n * 2^n"
  unfolding dc_crypto
  using card_lists_length_eq[of "UNIV :: bool set"]
  by (simp add: card_cartesian_product card_image)

lemma card_image_inversion:
  "card (inversion ` dc_crypto) = 2^(n - 1)"
proof -
  let ?P = "{inversion -` {x} \<inter> dc_crypto |x. x \<in> inversion ` dc_crypto}"
  have "\<Union>?P = dc_crypto" by auto

  { fix a b assume *: "(a, b) \<in> dc_crypto"
    have inv_SOME: "inversion (SOME x. inversion x = inversion (a, b) \<and> x \<in> dc_crypto) = inversion (a, b)"
      apply (rule someI2)
      by (auto simp: *) }
  note inv_SOME = this

  { fix a b assume *: "(a, b) \<in> dc_crypto"
    have "(SOME x. inversion x = inversion (a, b) \<and> x \<in> dc_crypto) \<in> dc_crypto"
      by (rule someI2) (auto simp: *) }
  note SOME_inv_dc = this

  have "bij_betw (\<lambda>s. inversion (SOME x. x \<in> s \<and> x \<in> dc_crypto))
    {inversion -` {x} \<inter> dc_crypto |x. x \<in> inversion ` dc_crypto}
    (inversion ` dc_crypto)"
    unfolding bij_betw_def
    by (auto intro!: inj_onI image_eqI simp: inv_SOME SOME_inv_dc)
  hence card_eq: "card {inversion -` {x} \<inter> dc_crypto |x. x \<in> inversion ` dc_crypto} = card (inversion ` dc_crypto)"
    by (rule bij_betw_same_card)

  have "(2*n) * card (inversion ` dc_crypto) = card (\<Union>?P)"
    unfolding card_eq[symmetric]
  proof (rule card_partition)
    have "\<Union>?P \<subseteq> dc_crypto" by auto
    thus "finite (\<Union>?P)" using finite_dc_crypto by (auto intro: finite_subset)

    have "?P = (\<lambda>x. inversion -` {x} \<inter> dc_crypto) ` (inversion ` dc_crypto)"
      by auto
    thus "finite ?P" using finite_dc_crypto by auto

  next
    fix c assume "c \<in> {inversion -` {x} \<inter> dc_crypto |x. x \<in> inversion ` dc_crypto}"
    then obtain x where "c = inversion -` {x} \<inter> dc_crypto" and x: "x \<in> inversion ` dc_crypto" by auto
    hence "c = {dc \<in> dc_crypto. inversion dc = x}" by auto
    thus "card c = 2 * n" using card_inversion[OF x] by simp

  next
    fix x y assume "x \<in> ?P" "y \<in> ?P" and "x \<noteq> y"
    then obtain i j where
      x: "x = inversion -` {i} \<inter> dc_crypto" and i: "i \<in> inversion ` dc_crypto" and
      y: "y = inversion -` {j} \<inter> dc_crypto" and j: "j \<in> inversion ` dc_crypto" by auto
    show "x \<inter> y = {}" using x y \<open>x \<noteq> y\<close> by auto
  qed
  hence "2 * card (inversion ` dc_crypto) = 2 ^ n" unfolding \<open>\<Union>?P = dc_crypto\<close> card_dc_crypto
    using n_gt_3 by auto
  thus ?thesis by (cases n) auto
qed

end

sublocale dining_cryptographers_space \<subseteq> prob_space "uniform_count_measure dc_crypto"
  by (rule prob_space_uniform_count_measure[OF finite_dc_crypto])
     (insert n_gt_3, auto simp: dc_crypto intro: exI[of _ "replicate n True"])

sublocale dining_cryptographers_space \<subseteq> information_space "uniform_count_measure dc_crypto" 2
  by standard auto

notation (in dining_cryptographers_space)
  mutual_information_Pow ("\<I>'( _ ; _ ')")

notation (in dining_cryptographers_space)
  entropy_Pow ("\<H>'( _ ')")

notation (in dining_cryptographers_space)
  conditional_entropy_Pow ("\<H>'( _ | _ ')")

theorem (in dining_cryptographers_space)
  "\<I>( inversion ; payer ) = 0"
proof (rule mutual_information_eq_0_simple)
  have n: "0 < n" using n_gt_3 by auto
  have card_image_inversion:
    "real (card (inversion ` dc_crypto)) = 2^n / 2"
    unfolding card_image_inversion using \<open>0 < n\<close> by (cases n) auto

  show inversion: "simple_distributed (uniform_count_measure dc_crypto) inversion (\<lambda>x. 2 / 2^n)"
  proof (rule simple_distributedI)
    show "simple_function (uniform_count_measure dc_crypto) inversion"
      using finite_dc_crypto
      by (auto simp: simple_function_def space_uniform_count_measure sets_uniform_count_measure)
    fix x assume "x \<in> inversion ` space (uniform_count_measure dc_crypto)"
    moreover have "inversion -` {x} \<inter> dc_crypto = {dc \<in> dc_crypto. inversion dc = x}" by auto
    ultimately show "2 / 2^n = prob (inversion -` {x} \<inter> space (uniform_count_measure dc_crypto))"
      using \<open>0 < n\<close>
      by (simp add: card_inversion card_dc_crypto finite_dc_crypto
                    subset_eq space_uniform_count_measure measure_uniform_count_measure)
  qed simp

  show "simple_distributed (uniform_count_measure dc_crypto) payer (\<lambda>x. 1 / real n)"
  proof (rule simple_distributedI)
    show "simple_function (uniform_count_measure dc_crypto) payer"
      using finite_dc_crypto
      by (auto simp: simple_function_def space_uniform_count_measure sets_uniform_count_measure)
    fix z assume "z \<in> payer ` space (uniform_count_measure dc_crypto)"
    then have "payer -` {z} \<inter> dc_crypto = {z} \<times> {xs. length xs = n}"
      by (auto simp: dc_crypto payer_def space_uniform_count_measure cong del: image_cong_simp)
    hence "card (payer -` {z} \<inter> dc_crypto) = 2^n"
      using card_lists_length_eq[where A="UNIV::bool set"]
      by (simp add: card_cartesian_product_singleton)
    then show "1 / real n = prob (payer -` {z} \<inter> space (uniform_count_measure dc_crypto))"
      using finite_dc_crypto
      by (subst measure_uniform_count_measure) (auto simp add: card_dc_crypto space_uniform_count_measure)
  qed simp

  show "simple_distributed (uniform_count_measure dc_crypto) (\<lambda>x. (inversion x, payer x)) (\<lambda>x. 2 / (real n *2^n))"
  proof (rule simple_distributedI)
    show "simple_function (uniform_count_measure dc_crypto) (\<lambda>x. (inversion x, payer x))"
      using finite_dc_crypto
      by (auto simp: simple_function_def space_uniform_count_measure sets_uniform_count_measure)
    fix x assume "x \<in> (\<lambda>x. (inversion x, payer x)) ` space (uniform_count_measure dc_crypto)"
    then obtain i xs where x: "x = (inversion (Some i, xs), payer (Some i, xs))"
      and "i < n" "length xs = n"
      by (simp add: image_iff space_uniform_count_measure dc_crypto Bex_def) blast
    then have xs: "inversion (Some i, xs) \<in> inversion`dc_crypto" and i: "Some i \<in> Some ` {0..<n}"
      and x: "x = (inversion (Some i, xs), Some i)" by (simp_all add: payer_def dc_crypto)
    moreover define ys where "ys = inversion (Some i, xs)"
    ultimately have ys: "ys \<in> inversion`dc_crypto"
      and "Some i \<in> Some ` {0..<n}" "x = (ys, Some i)" by simp_all
    then have "(\<lambda>x. (inversion x, payer x)) -` {x} \<inter> space (uniform_count_measure dc_crypto) =
      {dc \<in> dc_crypto. payer dc = Some (the (Some i)) \<and> inversion dc = ys}"
      by (auto simp add: payer_def space_uniform_count_measure)
    then show "2 / (real n * 2 ^ n) = prob ((\<lambda>x. (inversion x, payer x)) -` {x} \<inter> space (uniform_count_measure dc_crypto))"
      using \<open>i < n\<close> ys
      by (simp add: measure_uniform_count_measure card_payer_and_inversion finite_dc_crypto subset_eq card_dc_crypto)
  qed simp

  show "\<forall>x\<in>space (uniform_count_measure dc_crypto). 2 / (real n * 2 ^ n) = 2 / 2 ^ n * (1 / real n) "
    by simp
qed

end