section \<open>Auxiliary Lemmas\<close>

(*<*)
theory Auxiliary
  imports
    "HOL-Library.Multiset"
    "Nested_Multisets_Ordinals.Signed_Multiset"
    "HOL-Library.Linear_Temporal_Logic_on_Streams"
begin
(*>*)

subsection\<open>General\<close>

lemma sum_list_hd_tl:
  fixes xs :: "(_ :: group_add) list"
  shows "xs \<noteq> [] \<Longrightarrow> sum_list (tl xs) = (- hd xs) + sum_list xs"
  by (cases xs) simp_all

lemma finite_distinct_bounded: "finite A \<Longrightarrow> finite {xs. distinct xs \<and> set xs \<subseteq> A}"
  apply (rule finite_subset[of _ "\<Union>n \<in> {0 .. card A}. {xs.  length xs = n \<and> distinct xs \<and> set xs \<subseteq> A}"])
  subgoal by clarsimp (metis card_mono distinct_card)
  subgoal by auto
  done

subsection\<open>Sums\<close>

lemma Sum_eq_pick_changed_elem:
  assumes "finite M"
    and "m \<in> M" "f m = g m + \<Delta>"
    and "\<And>n. n \<noteq> m \<and> n \<in> M \<Longrightarrow> f n = g n"
  shows "(\<Sum>x\<in>M. f x) = (\<Sum>x\<in>M. g x) + \<Delta>"
  using assms
proof (induct M arbitrary: m rule: finite_induct)
  case empty
  then show ?case by simp
next
  case (insert x F)
  then show ?case
  proof (cases "x=m")
    case True
    with insert have "sum f F = sum g F"
      by (intro sum.cong[OF refl]) force
    with insert True show ?thesis
      by (auto simp: add.commute add.left_commute)
  next
    case False
    with insert show ?thesis
      by (auto simp: add.assoc)
  qed
qed

lemma sum_pos_ex_elem_pos: "(0::int) < (\<Sum>m\<in>M. f m) \<Longrightarrow> \<exists>m\<in>M. 0 < f m"
  by (meson not_le sum_nonpos)

lemma sum_if_distrib_add: "finite A \<Longrightarrow> b \<in> A \<Longrightarrow> (\<Sum>a\<in>A. if a=b then X b + Y a else X a) = (\<Sum>a\<in>A. X a) + Y b"
  by (simp add: Sum_eq_pick_changed_elem)

subsection\<open>Partial Orders\<close>

lemma (in order) order_finite_set_exists_foundation:
  fixes   t :: 'a
  assumes "finite M"
    and   "t \<in> M"
  shows   "\<exists>s\<in>M. s \<le> t \<and> (\<forall>u\<in>M. \<not> u < s)"
  using assms
  by (simp add: dual_order.strict_iff_order finite_has_minimal2)

lemma order_finite_set_obtain_foundation:
  fixes   t :: "_ :: order"
  assumes "finite M"
    and   "t \<in> M"
  obtains s where "s \<in> M" "s \<le> t" "\<forall>u\<in>M. \<not> u < s"
  using assms order_finite_set_exists_foundation by blast

subsection\<open>Multisets\<close>

lemma finite_nonzero_count: "finite {t. count M t > 0}"
  using count by auto

lemma finite_count[simp]: "finite {t. count M t > i}"
  by (rule finite_subset[OF _ finite_nonzero_count[of M]]) (auto simp only: set_mset_def)

subsection\<open>Signed Multisets\<close>

lemma zcount_zmset_of_nonneg[simp]: "0 \<le> zcount (zmset_of M) t"
  by simp

lemma finite_zcount_pos[simp]: "finite {t. zcount M t > 0}"
  apply transfer
  subgoal for M
    apply (rule finite_subset[OF _ finite_Un[THEN iffD2, OF conjI[OF finite_nonzero_count finite_nonzero_count]], of _ "fst M" "snd M"])
    apply (auto simp only: set_mset_def fst_conv snd_conv split: prod.splits)
    done
  done

lemma finite_zcount_neg[simp]: "finite {t. zcount M t < 0}"
  apply transfer
  subgoal for M
    apply (rule finite_subset[OF _ finite_Un[THEN iffD2, OF conjI[OF finite_nonzero_count finite_nonzero_count]], of _ "fst M" "snd M"])
    apply (auto simp only: set_mset_def fst_conv snd_conv split: prod.splits)
    done
  done

lemma pos_zcount_in_zmset: "0 < zcount M x \<Longrightarrow> x \<in>#\<^sub>z M"
  by (simp add: zcount_inI)

lemma zmset_elem_nonneg: "x \<in>#\<^sub>z M \<Longrightarrow> (\<And>x. x \<in>#\<^sub>z M \<Longrightarrow> 0 \<le> zcount M x) \<Longrightarrow> 0 < zcount M x"
  by (simp add: order.order_iff_strict zcount_eq_zero_iff)

lemma zero_le_sum_single: "0 \<le> zcount (\<Sum>x\<in>M. {#f x#}\<^sub>z) t"
  by (induct M rule: infinite_finite_induct) auto

lemma mem_zmset_of[simp]: "x \<in>#\<^sub>z zmset_of M \<longleftrightarrow> x \<in># M"
  by (simp add: set_zmset_def)

lemma mset_neg_minus: "mset_neg (abs_zmultiset (Mp,Mn)) = Mn-Mp"
  by (simp add: mset_neg.abs_eq)

lemma mset_pos_minus: "mset_pos (abs_zmultiset (Mp,Mn)) = Mp-Mn"
  by (simp add: mset_pos.abs_eq)

lemma mset_neg_sum_set: "(\<And>m. m \<in> M \<Longrightarrow> mset_neg (f m) = {#}) \<Longrightarrow> mset_neg (\<Sum>m\<in>M. f m) = {#}"
  by (induct M rule: infinite_finite_induct) auto

lemma mset_neg_empty_iff: "mset_neg M = {#} \<longleftrightarrow> (\<forall>t. 0 \<le> zcount M t)"
  apply rule
  subgoal
    by (metis add.commute add.right_neutral mset_pos_as_neg zcount_zmset_of_nonneg zmset_of_empty)
  subgoal
    apply (induct rule: zmultiset.abs_induct)
    subgoal for y
      apply (induct y)
      apply (subst mset_neg_minus)
      apply transfer
      apply (simp add: Diff_eq_empty_iff_mset mset_subset_eqI)
      done
    done
  done

lemma mset_neg_zcount_nonneg: "mset_neg M = {#} \<Longrightarrow> 0 \<le> zcount M t"
  by (subst (asm) mset_neg_empty_iff) simp

lemma in_zmset_conv_pos_neg_disj: "x \<in>#\<^sub>z M \<longleftrightarrow> x \<in># mset_pos M \<or> x \<in># mset_neg M"
  by (metis count_mset_pos in_diff_zcount mem_zmset_of mset_pos_neg_partition nat_code(2) not_in_iff zcount_ne_zero_iff)

lemma in_zmset_notin_mset_pos[simp]: "x \<in>#\<^sub>z M \<Longrightarrow> x \<notin># mset_pos M \<Longrightarrow> x \<in># mset_neg M"
  by (auto simp: in_zmset_conv_pos_neg_disj)

lemma in_zmset_notin_mset_neg[simp]: "x \<in>#\<^sub>z M \<Longrightarrow> x \<notin># mset_neg M \<Longrightarrow> x \<in># mset_pos M"
  by (auto simp: in_zmset_conv_pos_neg_disj)

lemma in_mset_pos_in_zmset: "x \<in># mset_pos M \<Longrightarrow> x \<in>#\<^sub>z M"
  by (auto intro: iffD2[OF in_zmset_conv_pos_neg_disj])

lemma in_mset_neg_in_zmset: "x \<in># mset_neg M \<Longrightarrow> x \<in>#\<^sub>z M"
  by (auto intro: iffD2[OF in_zmset_conv_pos_neg_disj])

lemma set_zmset_eq_set_mset_union: "set_zmset M = set_mset (mset_pos M) \<union> set_mset (mset_neg M)"
  by (auto dest: in_mset_pos_in_zmset in_mset_neg_in_zmset)

lemma member_mset_pos_iff_zcount: "x \<in># mset_pos M \<longleftrightarrow> 0 < zcount M x"
  using not_in_iff pos_zcount_in_zmset by force

lemma member_mset_neg_iff_zcount: "x \<in># mset_neg M \<longleftrightarrow> zcount M x < 0"
  by (metis member_mset_pos_iff_zcount mset_pos_uminus neg_le_0_iff_le not_le zcount_uminus)

lemma mset_pos_mset_neg_disjoint[simp]: "set_mset (mset_pos \<Delta>) \<inter> set_mset (mset_neg \<Delta>) = {}"
  by (auto simp: member_mset_pos_iff_zcount member_mset_neg_iff_zcount)

lemma zcount_sum: "zcount (\<Sum>M\<in>MM. f M) t = (\<Sum>M\<in>MM. zcount (f M) t)"
  by (induct MM rule: infinite_finite_induct) auto

lemma zcount_filter_invariant: "zcount {# t'\<in>#\<^sub>zM. t'=t #} t = zcount M t"
  by auto

lemma in_filter_zmset_in_zmset[simp]: "x \<in>#\<^sub>z filter_zmset P M \<Longrightarrow> x \<in>#\<^sub>z M"
  by (metis count_filter_zmset zcount_ne_zero_iff)

lemma pos_filter_zmset_pos_zmset[simp]: "0 < zcount (filter_zmset P M) x \<Longrightarrow> 0 < zcount M x"
  by (metis (full_types) count_filter_zmset less_irrefl)

lemma neg_filter_zmset_neg_zmset[simp]: "0 > zcount (filter_zmset P M) x \<Longrightarrow> 0 > zcount M x"
  by (metis (full_types) count_filter_zmset less_irrefl)

lift_definition update_zmultiset :: "'t zmultiset \<Rightarrow> 't \<Rightarrow> int \<Rightarrow> 't zmultiset" is
  "\<lambda>(A,B) T D.(if D>0 then (A + replicate_mset (nat D) T, B)
                    else (A,B + replicate_mset (nat (-D)) T))"
  by (auto simp: equiv_zmset_def if_split)

lemma zcount_update_zmultiset: "zcount (update_zmultiset M t n) t' = zcount M t' + (if t = t' then n else 0)"
  by transfer auto

lemma (in order) order_zmset_exists_foundation:
  fixes   t :: 'a
  assumes "0 < zcount M t"
  shows   "\<exists>s. s \<le> t \<and> 0 < zcount M s \<and> (\<forall>u. 0 < zcount M u \<longrightarrow> \<not> u < s)"
  using assms
proof -
  let ?M = "{t. 0 < zcount M t}"
  from assms have "t \<in> ?M"
    by simp
  then have "\<exists>s\<in>?M. s \<le> t \<and> (\<forall>u\<in>?M. \<not> u < s)"
    by - (drule order_finite_set_exists_foundation[rotated 1], auto)
  then show ?thesis by auto
qed

lemma (in order) order_zmset_exists_foundation':
  fixes   t :: 'a
  assumes "0 < zcount M t"
  shows   "\<exists>s. s \<le> t \<and> 0 < zcount M s \<and> (\<forall>u<s. zcount M u \<le> 0)"
  using assms order_zmset_exists_foundation
  by (meson le_less_linear)

lemma (in order) order_zmset_exists_foundation_neg:
  fixes   t :: 'a
  assumes "zcount M t < 0"
  shows   "\<exists>s. s \<le> t \<and> zcount M s < 0 \<and> (\<forall>u. zcount M u < 0 \<longrightarrow> \<not> u < s)"
  using assms
proof -
  let ?M = "{t. zcount M t < 0}"
  from assms have "t \<in> ?M"
    by simp
  then have "\<exists>s\<in>?M. s \<le> t \<and> (\<forall>u\<in>?M. \<not> u < s)"
    by - (drule order_finite_set_exists_foundation[rotated 1], auto)
  then show ?thesis by auto
qed

lemma (in order) order_zmset_exists_foundation_neg':
  fixes   t :: 'a
  assumes "zcount M t < 0"
  shows   "\<exists>s. s \<le> t \<and> zcount M s < 0 \<and> (\<forall>u<s. 0 \<le> zcount M u)"
  using assms order_zmset_exists_foundation_neg
  by (meson le_less_linear)

lemma (in order) elem_order_zmset_exists_foundation:
  fixes x :: 'a
  assumes "x \<in>#\<^sub>z M"
  shows   "\<exists>s\<in>#\<^sub>zM. s \<le> x \<and> (\<forall>u\<in>#\<^sub>zM. \<not> u < s)"
  by (rule order_finite_set_exists_foundation[OF finite_set_zmset, OF assms(1)])

subsubsection\<open>Image of a Signed Multiset\<close>

lift_definition image_zmset :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a zmultiset \<Rightarrow> 'b zmultiset" is
  "\<lambda>f (M, N). (image_mset f M, image_mset f N)"
  by (auto simp: equiv_zmset_def simp flip: image_mset_union)

syntax (ASCII)
  "_comprehension_zmset" :: "'a \<Rightarrow> 'b \<Rightarrow> 'b zmultiset \<Rightarrow> 'a zmultiset"  ("({#_/. _ :#z _#})")
syntax
  "_comprehension_zmset" :: "'a \<Rightarrow> 'b \<Rightarrow> 'b zmultiset \<Rightarrow> 'a zmultiset"  ("({#_/. _ \<in>#\<^sub>z _#})")
translations
  "{#e. x \<in>#\<^sub>z M#}" \<rightleftharpoons> "CONST image_zmset (\<lambda>x. e) M"

lemma image_zmset_empty[simp]: "image_zmset f {#}\<^sub>z = {#}\<^sub>z"
  by transfer (auto simp: equiv_zmset_def)

lemma image_zmset_single[simp]: "image_zmset f {#x#}\<^sub>z = {#f x#}\<^sub>z"
  by transfer (simp add: equiv_zmset_def)

lemma image_zmset_union[simp]: "image_zmset f (M + N) = image_zmset f M + image_zmset f N"
  by transfer (auto simp: equiv_zmset_def)

lemma image_zmset_Diff[simp]: "image_zmset f (A - B) = image_zmset f A - image_zmset f B"
proof -
  have "image_zmset f (A - B + B) = image_zmset f (A - B) + image_zmset f B"
    using image_zmset_union by blast
  then show ?thesis by simp
qed

lemma mset_neg_image_zmset: "mset_neg M = {#} \<Longrightarrow> mset_neg (image_zmset f M) = {#}"
  unfolding multiset_eq_iff count_empty
  by transfer (auto simp add: image_mset_subseteq_mono mset_subset_eqI mset_subset_eq_count)

lemma nonneg_zcount_image_zmset[simp]: "(\<And>t. 0 \<le> zcount M t) \<Longrightarrow> 0 \<le> zcount (image_zmset f M) t"
  by (meson mset_neg_empty_iff mset_neg_image_zmset)

lemma image_zmset_add_zmset[simp]: "image_zmset f (add_zmset t M) = add_zmset (f t) (image_zmset f M)"
  by transfer (auto simp: equiv_zmset_def)

lemma pos_zcount_image_zmset[simp]: "(\<And>t. 0 \<le> zcount M t) \<Longrightarrow> 0 < zcount M t \<Longrightarrow> 0 < zcount (image_zmset f M) (f t)"
  apply transfer
  subgoal for M t f
    apply (induct M)
    subgoal for Mp Mn
      apply simp
      apply (metis count_diff count_image_mset_ge_count image_mset_Diff less_le_trans subseteq_mset_def zero_less_diff)
      done
    done
  done

lemma set_zmset_transfer[transfer_rule]:
  "(rel_fun (pcr_zmultiset (=)) (rel_set (=)))
   (\<lambda>(Mp, Mn). set_mset Mp \<union> set_mset Mn - {x. count Mp x = count Mn x}) set_zmset"
  by (auto simp: rel_fun_def pcr_zmultiset_def cr_zmultiset_def
      rel_set_eq multiset.rel_eq set_zmset_def zcount.abs_eq count_eq_zero_iff[symmetric]
      simp del: zcount_ne_zero_iff)

lemma zcount_image_zmset:
  "zcount (image_zmset f M) x = (\<Sum>y \<in> f -` {x} \<inter> set_zmset M. zcount M y)"
  apply (transfer fixing: f x)
  subgoal for M
    apply (cases M; clarify)
    subgoal for Mp Mn
      unfolding count_image_mset int_sum
    proof -
      have "(\<Sum>x\<in>f -` {x} \<inter> set_mset Mp. int (count Mp x)) =
        (\<Sum>x\<in>f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn). int (count Mp x))" (is "?S1 = _")
        by (subst sum.same_carrier[where C="f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn)"])
          (auto simp: count_eq_zero_iff)
      moreover
      have "(\<Sum>x\<in>f -` {x} \<inter> set_mset Mn. int (count Mn x)) =
        (\<Sum>x\<in>f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn). int (count Mn x))"(is "?S2 = _")
        by (subst sum.same_carrier[where C="f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn)"])
          (auto simp: count_eq_zero_iff)
      moreover
      have "(\<Sum>x\<in>f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn - {x. count Mp x = count Mn x}). int (count Mp x) - int (count Mn x))
        = (\<Sum>x\<in>f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn). int (count Mp x) - int (count Mn x))"
        (is "?S = _")
        by (subst sum.same_carrier[where C="f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn)"]) auto
      ultimately show "?S1 - ?S2 = ?S"
        by (auto simp: sum_subtractf)
    qed
    done
  done

lemma zmset_empty_image_zmset_empty: "(\<And>t. zcount M t = 0) \<Longrightarrow> zcount (image_zmset f M) t = 0"
  by (auto simp: zcount_image_zmset)

lemma in_image_zmset_in_zmset: "t \<in>#\<^sub>z image_zmset f M \<Longrightarrow> \<exists>t. t \<in>#\<^sub>z M"
  by (rule ccontr) simp

lemma zcount_image_zmset_zero: "(\<And>m. m \<in>#\<^sub>z M \<Longrightarrow> f m \<noteq> x) \<Longrightarrow> x \<notin>#\<^sub>z image_zmset f M"
  unfolding set_zmset_def
  by (simp add: zcount_image_zmset) (metis Int_emptyI sum.empty vimage_singleton_eq)

lemma image_zmset_pre: "t \<in>#\<^sub>z image_zmset f M \<Longrightarrow> \<exists>m. m \<in>#\<^sub>z M \<and> f m = t"
proof (rule ccontr)
  assume t: "t \<in>#\<^sub>z image_zmset f M"
  assume "\<nexists>m. m \<in>#\<^sub>z M \<and> f m = t"
  then have "m \<in>#\<^sub>z M \<Longrightarrow> \<not> f m = t" for m
    by blast
  then have "zcount (image_zmset f M) t = 0"
    by (meson t zcount_image_zmset_zero)
  with t show False
    by (meson zcount_ne_zero_iff)
qed

lemma pos_image_zmset_obtain_pre:
  "(\<And>t. 0 \<le> zcount M t) \<Longrightarrow> 0 < zcount (image_zmset f M) t \<Longrightarrow> \<exists>m. 0 < zcount M m \<and> f m = t"
proof -
  assume nonneg: "0 \<le> zcount M t" for t
  assume "0 < zcount (image_zmset f M) t"
  then have "t \<in>#\<^sub>z image_zmset f M"
    by (simp add: pos_zcount_in_zmset)
  then obtain x where x: "x \<in>#\<^sub>z M" "f x = t"
    by (auto dest: image_zmset_pre)
  with nonneg have "0 < zcount M x"
    by (meson zmset_elem_nonneg)
  with x show ?thesis
    by auto
qed

subsection\<open>Streams\<close>

definition relates :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a stream \<Rightarrow> bool" where
  "relates \<phi> s = \<phi> (shd s) (shd (stl s))"

lemma relatesD[dest]: "relates P s \<Longrightarrow> P (shd s) (shd (stl s))"
  unfolding relates_def by simp

lemma alw_relatesD[dest]: "alw (relates P) s \<Longrightarrow> P (shd s) (shd (stl s))"
  by auto

lemma relatesI[intro]: "P (shd s) (shd (stl s)) \<Longrightarrow> relates P s"
  by (auto simp: relates_def)

lemma alw_holds_smap_conv_comp: "alw (holds P) (smap f s) = alw (\<lambda>s. (P o f) (shd s)) s"
  apply (rule iffI)
   apply (coinduction arbitrary: s)
   apply auto []
  apply (coinduction arbitrary: s)
  apply auto
  done

lemma alw_relates: "alw (relates P) s \<longleftrightarrow> P (shd s) (shd (stl s)) \<and> alw (relates P) (stl s)"
  apply (rule iffI)
   apply (auto simp: relates_def dest: alwD) []
  apply (coinduction arbitrary: s)
  apply (auto simp: relates_def)
  done

subsection\<open>Notation\<close>

no_notation AND  (infix "aand" 60)
no_notation OR   (infix "or" 60)
no_notation IMPL (infix "imp" 60)

notation AND  (infixr "aand" 70)
notation OR   (infixr "or" 65)
notation IMPL (infixr "imp" 60)

(*<*)
end
(*>*)


section \<open> Uniform Selection Algorithms \<close>

text \<open> This example illustrates how to prove a tail-recursive probabilistic program that achieves a
uniform choice out of N based on a binary probabilistic choice operator @{text "\<oplus>\<^bsub>r\<^esub>"}. See
@{url "https://robostar.cs.york.ac.uk/prob_case_studies/ransac_simp/index.html#-v2"} for its
diagrammatic presentation in RoboChart.\<close>

theory utp_prob_ex1
  imports
  "../utp_prob_des_laws"
  "UTP.utp_hoare"
  "UTP.utp"
begin recall_syntax

alphabet unisel_vars =
  i :: "nat"
  c :: "bool"

subsection \<open> unisel_rec_body \<close>
(* Use meta-subst operator for the weight of probabilistic choice *)
abbreviation unisel_rec_body_choice ::
  "nat \<Rightarrow> (unisel_vars, unisel_vars) rel_pdes" where
"unisel_rec_body_choice N \<equiv> ((\<K>(c :=\<^sub>D false)) \<oplus>\<^bsub>r\<^esub> (\<K>(i :=\<^sub>D i+1))) \<lbrakk>r\<rightarrow>(\<lceil>\<lceil>U(1/real (\<guillemotleft>N\<guillemotright>-i))\<rceil>\<^sub><\<rceil>\<^sub>D)\<rbrakk>"

abbreviation unisel_rec_body :: "nat
     \<Rightarrow> (unisel_vars, unisel_vars) rel_pdes
     \<Rightarrow> (unisel_vars, unisel_vars) rel_pdes" where
"unisel_rec_body N X \<equiv> (
        (unisel_rec_body_choice N ;; \<up>X)
          \<triangleleft> U(i < \<guillemotleft>N-1\<guillemotright> \<and> c) \<triangleright>\<^sub>D
        \<K>(II\<^sub>D)
      )"

lemma unisel_rec_body_pchoice_simp:
  assumes "r \<in> {0..1} "
  shows "(\<K>(c :=\<^sub>D false)) \<parallel>\<^sup>D\<^bsub>\<^bold>P\<^bold>M\<^bsub>r\<^esub>\<^esub> (\<K>(i :=\<^sub>D i+1))
    = U(true \<turnstile>\<^sub>n ($prob\<acute>($\<^bold>v\<lbrakk>false/$c\<rbrakk>) = \<guillemotleft>r\<guillemotright> \<and> $prob\<acute>($\<^bold>v\<lbrakk>$i+1/$i\<rbrakk>) = 1 - \<guillemotleft>r\<guillemotright>))"
  apply (simp add: pemp_assign)
  apply (ndes_simp cls: assms)
  apply (simp add: upred_defs)
  apply (rel_auto)
  using assms apply (simp add: pmf_wplus)
  apply (simp add: pmf_not_the_one_is_zero)
  using assms apply (simp add: pmf_wplus)
  apply (simp add: pmf_not_the_one_is_zero)
  proof -
    fix ok\<^sub>v::"bool" and i\<^sub>v::"nat" and c\<^sub>v::"bool" and nn\<^sub>v::"nat" and more::"'a" and ok\<^sub>v'::"bool" and
         prob\<^sub>v::"'a unisel_vars_scheme pmf"
    let ?s1 = "\<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False,  \<dots> = more\<rparr>"
    let ?s2 = "\<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = c\<^sub>v,  \<dots> = more\<rparr>"
    let ?prob' = "pmf_of_list [(?s1, (1::real))]"
    let ?prob'' = "pmf_of_list [(?s2, (1::real))]"

    assume a1: "pmf prob\<^sub>v ?s2 = (1::real) - pmf prob\<^sub>v ?s1"
    assume a2: "r = pmf prob\<^sub>v ?s1"
    have f1: "prob\<^sub>v = ?prob' +\<^bsub>r\<^esub> ?prob''"
      apply (subst pmf_instance_from_two_full_states'[of "prob\<^sub>v" "?s1" "?s2"])
      using a1 apply auto[1]
      apply simp
      by (simp add: a2)
    show "\<exists>(i\<^sub>v'::nat) (c\<^sub>v'::bool) (morea::'a) prob\<^sub>v'::'a unisel_vars_scheme pmf.
            pmf prob\<^sub>v' ?s1 = (1::real) \<and>
            (\<exists>prob\<^sub>v''::'a unisel_vars_scheme pmf.
                pmf prob\<^sub>v'' ?s2 = (1::real) \<and>
                i\<^sub>v' = i\<^sub>v \<and>
                c\<^sub>v' = c\<^sub>v \<and>
                morea = more \<and>
                prob\<^sub>v = prob\<^sub>v' +\<^bsub>pmf prob\<^sub>v ?s1\<^esub> prob\<^sub>v'')"
      apply (rule_tac x = "i\<^sub>v" in exI)
      apply (rule_tac x = "c\<^sub>v" in exI)
      apply (rule_tac x = "more" in exI)
      apply (rule_tac x = "?prob'" in exI)
      apply (rule conjI)
      apply (subst pmf_pmf_of_list, simp add: pmf_of_list_wf_def, simp)
      apply (rule_tac x = "?prob''" in exI)
      apply (rule conjI)
      apply (subst pmf_pmf_of_list, simp add: pmf_of_list_wf_def, simp, auto)
      using f1 a2 by force
  qed

lemma unisel_rec_body_pchoice_simp':
  shows "( ((\<K>(c :=\<^sub>D false)) \<oplus>\<^bsub>r\<^esub> (\<K>(i :=\<^sub>D i+1)))
    = U(true \<turnstile>\<^sub>n (($prob\<acute>($\<^bold>v\<lbrakk>false/$c\<rbrakk>) = \<guillemotleft>r\<guillemotright> \<and> $prob\<acute>($\<^bold>v\<lbrakk>$i+1/$i\<rbrakk>) = 1 - \<guillemotleft>r\<guillemotright>)
      \<triangleleft> \<guillemotleft>r\<guillemotright> \<in> {0..1} \<triangleright> false)))" (is "?LHS = ?RHS")
proof (cases "r \<in> {0..1}")
  case True
  then have T: "r \<in> {0..1}" by auto
  show ?thesis
    proof (cases "r = 0")
      case True
      have lhs: "?LHS = (\<K>(i :=\<^sub>D i+1))"
        using True by (simp add: prob_choice_zero)
      have lhs': "... =  U(true \<turnstile>\<^sub>n ($prob\<acute>($\<^bold>v\<lbrakk>$i+1/$i\<rbrakk>) = 1))"
        apply (simp add: pemp_assign)
        by (rel_auto)
      have rhs: "?RHS = U(true \<turnstile>\<^sub>n (($prob\<acute>($\<^bold>v\<lbrakk>false/$c\<rbrakk>) = 0 \<and> $prob\<acute>($\<^bold>v\<lbrakk>$i+1/$i\<rbrakk>) = 1)))"
        using True
        by (smt cond_true_false conj_conds diff_zero le_pred_refl true_conj_zero(1) uset_laws(2)
            utp_pred_laws.cond_idem utp_pred_laws.inf_top_right uzero_le_laws(3) zero_uexpr_def)
      have rhs': "... = U(true \<turnstile>\<^sub>n ($prob\<acute>($\<^bold>v\<lbrakk>$i+1/$i\<rbrakk>) = 1))"
        apply (rel_auto)
        by (simp add: pmf_not_the_one_is_zero)
      show ?thesis using lhs lhs' rhs rhs' by auto
    next
      case False
      have TF: "r \<in> {0..1} \<and> \<not> (r::real) = (0::real)"
        using T False by blast
      then show ?thesis
        proof (cases "r = 1")
          case True
          have lhs: "?LHS = (\<K>(c :=\<^sub>D false))"
            using True by (simp add: prob_choice_one)
          have lhs': "... =  U(true \<turnstile>\<^sub>n ($prob\<acute>($\<^bold>v\<lbrakk>false/$c\<rbrakk>) = 1))"
            by (simp add: pemp_assign)
          have rhs: "?RHS = U(true \<turnstile>\<^sub>n (($prob\<acute>($\<^bold>v\<lbrakk>false/$c\<rbrakk>) = 1 \<and> $prob\<acute>($\<^bold>v\<lbrakk>$i+1/$i\<rbrakk>) = 0)))"
            using True
            by (smt cond_true_false conj_conds diff_numeral_special(9) le_pred_refl one_uexpr_def
                true_conj_zero(1) uset_laws(2) utp_pred_laws.cond_idem utp_pred_laws.inf_top_right
                uzero_le_laws(3))
          have rhs': "... = U(true \<turnstile>\<^sub>n ($prob\<acute>($\<^bold>v\<lbrakk>false/$c\<rbrakk>) = 1))"
            apply (rel_auto)
            by (simp add: pmf_not_the_one_is_zero)
          show ?thesis using lhs lhs' rhs rhs' by auto
        next
          case False
          then have TFF: "r \<in> {0<..<1}"
            using TF by auto
          have lhs: "?LHS = (\<K>(c :=\<^sub>D false)) \<parallel>\<^sup>D\<^bsub>\<^bold>P\<^bold>M\<^bsub>r\<^esub>\<^esub> (\<K>(i :=\<^sub>D i+1))"
            using TFF by (simp add: prob_choice_r)
          have f0: "U(\<guillemotleft>r\<guillemotright> \<in> {0..1}) = U(true)"
            using True apply (rel_auto)
            by (smt lit.rep_eq lit_fun_simps(3) true_inf(2) ulit_eq)
          have rhs: "?RHS = U(true \<turnstile>\<^sub>n ($prob\<acute>($\<^bold>v\<lbrakk>false/$c\<rbrakk>) = \<guillemotleft>r\<guillemotright> \<and> $prob\<acute>($\<^bold>v\<lbrakk>$i+1/$i\<rbrakk>) = 1 - \<guillemotleft>r\<guillemotright>))"
            using TFF True f0 by (metis cond_unit_T)
          then show ?thesis using lhs rhs unisel_rec_body_pchoice_simp
            using True by auto
        qed
    qed
next
  case False
  have lhs: "?LHS = \<top>\<^sub>D"
    apply (subst prob_choice_def)
    using False by (auto)
  have f0: "U(\<guillemotleft>r\<guillemotright> \<in> {0..1}) = U(false)"
    using False apply (pred_auto)
    by (metis inf_bool_def inf_uexpr.rep_eq lit.rep_eq lit_fun_simps(3))+
  then have rhs: "?RHS = U(true \<turnstile>\<^sub>n (($prob\<acute>($\<^bold>v\<lbrakk>false/$c\<rbrakk>) = \<guillemotleft>r\<guillemotright> \<and> $prob\<acute>($\<^bold>v\<lbrakk>$i+1/$i\<rbrakk>) = 1 - \<guillemotleft>r\<guillemotright>)
      \<triangleleft> false \<triangleright> false))"
    by (metis)
  then have rhs': "... = U(true \<turnstile>\<^sub>n false)"
    by (simp)
  then have rhs'': "... = \<top>\<^sub>D"
    using ndesign_miracle by blast
  then show ?thesis
    using lhs rhs by auto
qed

lemma infsetsum_uni_c:
  assumes "finite A"
  assumes "\<forall>x \<in> A. P x = (cc::real)"
  shows "(\<Sum>\<^sub>aa \<in> A . P a) = (real (card A)) * cc"
proof (cases "A = {}")
  case True
  then show ?thesis
    by simp
next
  case False
  then show ?thesis
    using assms
    by (metis (full_types) assms(1) infsetsum_cong infsetsum_finite sum_constant)
qed

lemma card_set_comp_uniq:
  assumes "\<forall>x y. P x = P y \<longrightarrow> x = y"
  shows "card {P x | x . x < n} = n"
  apply (induct n)
  apply simp
proof -
  fix n::"nat"
  assume a1: "card {uu::'a. \<exists>x::nat. uu = P x \<and> x < n} = n"
  have f1: "{uu::'a. \<exists>x::nat. uu = P x \<and> x < Suc n} = {uu::'a. \<exists>x::nat. uu = P x \<and> (x < n \<or> x = n)}"
    by (simp add: less_Suc_eq)
  then have f2: "... = {uu::'a. \<exists>x::nat. uu = P x \<and> (x < n)} \<union>
    {uu::'a. \<exists>x::nat. uu = P x \<and> (x = n)}"
    by auto
  have f3: "card {uu::'a. \<exists>x::nat. uu = P x \<and> x < Suc n}
    = card ({uu::'a. \<exists>x::nat. uu = P x \<and> (x < n)} \<union>
    {uu::'a. \<exists>x::nat. uu = P x \<and> (x = n)})"
    using f1 f2 by auto
  have f4: "... = card {uu::'a. \<exists>x::nat. uu = P x \<and> (x < n)}
    + card {uu::'a. \<exists>x::nat. uu = P x \<and> (x = n)}"
    apply (rule card_Un_disjoint)
    apply simp+
    using assms by auto
  have f5: "... = n + 1"
    using a1 by auto
  show "card {uu::'a. \<exists>x::nat. uu = P x \<and> x < Suc n} = Suc n"
    using a1 f1 f2 f4 by auto
qed

subsection \<open> Uniform selection (recursion) \<close>

definition unisel_rec :: "nat \<Rightarrow> (unisel_vars, unisel_vars) rel_pdes" where
"unisel_rec N =  (\<mu>\<^sub>N X \<bullet> (unisel_rec_body N X))"

lemma dcond_H1_H2_closed' [closure]:
  assumes "P is \<^bold>H" "Q is \<^bold>H"
  shows "(P \<triangleleft> b \<triangleright>\<^sub>D Q) is \<^bold>H"
  proof -
    have "\<^bold>H (P \<triangleleft> b \<triangleright>\<^sub>D Q) = (pre\<^sub>D P \<triangleleft> b\<^sup>< \<triangleright> pre\<^sub>D Q) \<turnstile>\<^sub>r (post\<^sub>D P \<triangleleft> b\<^sup>< \<triangleright> post\<^sub>D Q)"
      by (simp add: H1_H2_eq_rdesign)
    then show ?thesis
      by (metis (no_types) H1_H2_eq_rdesign Healthy_def' aext_cond assms(1) assms(2) design_condr
          rdesign_def)
  qed

lemma dcond_H1_H3_closed' [closure]:
  assumes "P is \<^bold>N" "Q is \<^bold>N"
  shows "(P \<triangleleft> b \<triangleright>\<^sub>D Q) is \<^bold>N"
  proof -
    have "\<^bold>N (P \<triangleleft> b \<triangleright>\<^sub>D Q) = (pre\<^sub>D P \<triangleleft> b\<^sup>< \<triangleright> pre\<^sub>D Q) \<turnstile>\<^sub>r (post\<^sub>D P \<triangleleft> b\<^sup>< \<triangleright> post\<^sub>D Q)"
      by (metis H1_H2_eq_rdesign H1_H3_right_unit H2_H3_absorb H3_def assms(1) assms(2)
          dcond_H1_H2_closed design_post_condr design_pre_condr)
    then show ?thesis
      using assms(1) assms(2) dcond_H1_H2_closed by blast
  qed

subsubsection \<open> Invariant of recursion \<close>

lemma design_mu_N_refine_intro:
  assumes "$ok\<acute> \<sharp> C" "$ok\<acute> \<sharp> S" "(C \<turnstile> S) \<sqsubseteq> F(C \<turnstile> S)" "`C \<Rightarrow> (\<mu>\<^sub>N F \<Leftrightarrow> \<nu>\<^sub>N F)`" "(C \<turnstile> S) is \<^bold>N"
  shows "(C \<turnstile> S) \<sqsubseteq> \<mu>\<^sub>N F"
proof -
  from assms have "(C \<turnstile> S) \<sqsubseteq> \<nu>\<^sub>N F"
    by (simp add: assms design_is_H1_H2 ndes_theory.GFP_upperbound)
  with assms show ?thesis
    by (rel_auto, metis (no_types, lifting))
qed

definition unisel_inv ::
  "nat \<Rightarrow> (unisel_vars, unisel_vars) rel_pdes" where
"unisel_inv n = U(true \<turnstile>\<^sub>n
    ((($c \<and> $i < (\<guillemotleft>n-1\<guillemotright>)) \<Rightarrow>
      ((\<forall>j<\<guillemotleft>n\<guillemotright>-$i-1. $prob\<acute>($\<^bold>v\<lbrakk>\<guillemotleft>j\<guillemotright>+$i, false/$i, $c\<rbrakk>) = U(1/real (\<guillemotleft>n\<guillemotright>-$i))) \<and>
      $prob\<acute>($\<^bold>v\<lbrakk>\<guillemotleft>n-1\<guillemotright>, true/$i, $c\<rbrakk>) = U(1/real (\<guillemotleft>n\<guillemotright>-$i)))
    ) \<and>
    (U(\<not>($c \<and> $i < (\<guillemotleft>n-1\<guillemotright>))) \<Rightarrow> ($prob\<acute>($\<^bold>v) = 1)))
  )"

lemma unisel_rec_inv:
  assumes "N \<ge> 1"
  shows "unisel_inv N \<sqsubseteq> unisel_rec N"
proof (cases "N=1")
  case True
  have f1: "\<forall>X. (unisel_rec_body N X) = II\<^sub>p"
    using True by (rel_auto)
  then have f2: "(\<mu>\<^sub>N X \<bullet> unisel_rec_body N X) = (\<mu>\<^sub>N X \<bullet> II\<^sub>p)"
    by simp
  have f3: "... = II\<^sub>p"
    by (metis ndes_theory.LFP_const ndesign_H1_H3 pemp_skip)
  then have f4: "unisel_rec N = II\<^sub>p"
    apply (simp add: unisel_rec_def)
    using f2 by auto
  have lhs: "unisel_inv N = II\<^sub>p"
    apply (simp add: unisel_inv_def pemp_skip)
    using True by (rel_auto)
  then show ?thesis
    by (simp add: f4)
next
  case False
  then have F: "N > 1"
    using assms by linarith
  then show ?thesis
    apply (simp add: unisel_rec_def unisel_inv_def)
    \<comment> \<open> Actually, (N - i) is not the variant as it is not always guaranteed to decrease. Sometime,
    it just sets c to false and make i equal. \<close>
    apply (rule ndesign_mu_wf_refine_intro''[where e="U((\<guillemotleft>N\<guillemotright> - &i - (0 \<triangleleft> &c \<triangleright> 1)))" and R="{(x, y). x < y}"])
    apply (simp_all add: wf closure)
    apply (simp add: cond_mono kleisli_left_mono seqr_mono)
    apply (simp add: Pi_def)
    apply (clarify)
    apply (rule dcond_H1_H3_closed')
    apply (rule seq_r_H1_H3_closed)
    apply (simp add: unisel_rec_body_pchoice_simp')
    apply (rel_auto)
    using kleisli_left_N apply blast
    apply (simp add: ndesign_H1_H3 pemp_skip)
    apply (simp add: unisel_rec_body_pchoice_simp')
    apply (ndes_simp)
    apply (simp add: kleisli_lift_alt_def kleisli_lift2'_def)
    apply (simp add: upred_set_def)
    apply (rel_auto)
  proof -
    fix c\<^sub>v'::"bool" and ok\<^sub>v::"bool" and i\<^sub>v'::"nat" and ok\<^sub>v'::"bool" and
      ok\<^sub>v''::"bool" and prob\<^sub>v'::"unisel_vars pmf"
    let ?sset = "{s::unisel_vars.
              (c\<^sub>v s \<longrightarrow> N - i\<^sub>v s < N - i\<^sub>v') \<and> (\<not> c\<^sub>v s \<longrightarrow> N - Suc (i\<^sub>v s) < N - i\<^sub>v')}"
    let ?s1 = "\<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr>"
    let ?s2 = "\<lparr>i\<^sub>v = Suc i\<^sub>v', c\<^sub>v = True\<rparr>"
    assume a1: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real) / real (N - i\<^sub>v')"
    assume a2: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v', c\<^sub>v = True\<rparr> = (1::real) - (1::real) / real (N - i\<^sub>v')"
    assume a3: "i\<^sub>v' < N - Suc (0::nat)"
    assume a4: "(1::real) \<le> real (N - i\<^sub>v')"
    assume a5: "\<not>infsetsum (pmf prob\<^sub>v') ?sset = (1::real)"
    have f1: "?s1 \<in> ?sset"
      using a3 by auto
    have f2: "?s2 \<in> ?sset"
      using a3 by auto
    have f3: "infsetsum (pmf prob\<^sub>v') ?sset \<ge> infsetsum (pmf prob\<^sub>v') {?s1, ?s2}"
      apply (rule infsetsum_mono_neutral_left)
      apply simp
      apply blast
      apply simp
      using f1 f2
      apply blast
      by simp
    have f4: "infsetsum (pmf prob\<^sub>v') {?s1, ?s2} = (pmf prob\<^sub>v' ?s1 + pmf prob\<^sub>v' ?s2)"
      by auto
    have f5: "infsetsum (pmf prob\<^sub>v') ?sset \<ge> 1"
      using f3 a1 a2 f4 by linarith
    have f6: "infsetsum (pmf prob\<^sub>v') ?sset = 1"
      using sum_pmf_eq_1
      by (metis (mono_tags) UNIV_eq_I dual_order.antisym f5 mem_Collect_eq pmf_disj_leq)
    show "False"
      using f6 a4 a5 by blast
  next
    fix c\<^sub>v'::"bool" and ok\<^sub>v::"bool" and i\<^sub>v'::"nat" and prob\<^sub>v::"unisel_vars pmf" and
      ok\<^sub>v''::"bool" and prob\<^sub>v'::"unisel_vars pmf" and x::"nat"
    let ?sset = "{s::unisel_vars.
              (c\<^sub>v s \<longrightarrow> N - i\<^sub>v s < N - i\<^sub>v') \<and> (\<not> c\<^sub>v s \<longrightarrow> N - Suc (i\<^sub>v s) < N - i\<^sub>v')}"
    let ?s1 = "\<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr>"
    let ?s2 = "\<lparr>i\<^sub>v = Suc i\<^sub>v', c\<^sub>v = True\<rparr>"
    assume a1: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real) / real (N - i\<^sub>v')"
    assume a2: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v', c\<^sub>v = True\<rparr> = (1::real) - (1::real) / real (N - i\<^sub>v')"
    assume a3: "i\<^sub>v' < N - Suc (0::nat)"
    assume a4: "\<not> infsetsum (pmf prob\<^sub>v') ?sset = (1::real)"
    have f1: "?s1 \<in> ?sset"
      using a3 by auto
    have f2: "?s2 \<in> ?sset"
      using a3 by auto
    have f3: "infsetsum (pmf prob\<^sub>v') ?sset \<ge> infsetsum (pmf prob\<^sub>v') {?s1, ?s2}"
      apply (rule infsetsum_mono_neutral_left)
      apply simp
      apply blast
      apply simp
      using f1 f2
      apply blast
      by simp
    have f4: "infsetsum (pmf prob\<^sub>v') {?s1, ?s2} = (pmf prob\<^sub>v' ?s1 + pmf prob\<^sub>v' ?s2)"
      by auto
    have f5: "infsetsum (pmf prob\<^sub>v') ?sset \<ge> 1"
      using f3 a1 a2 f4 by linarith
    have f6: "infsetsum (pmf prob\<^sub>v') ?sset = 1"
      using sum_pmf_eq_1
      by (metis (mono_tags) UNIV_eq_I dual_order.antisym f5 mem_Collect_eq pmf_disj_leq)
    show "False"
      using f6 a4 by blast
  next
    fix c\<^sub>v'::"bool" and ok\<^sub>v::"bool" and i\<^sub>v'::"nat" and prob\<^sub>v::"unisel_vars pmf" and
      ok\<^sub>v''::"bool" and prob\<^sub>v'::"unisel_vars pmf"
    let ?sset = "{s::unisel_vars.
              (c\<^sub>v s \<longrightarrow> N - i\<^sub>v s < N - i\<^sub>v') \<and> (\<not> c\<^sub>v s \<longrightarrow> N - Suc (i\<^sub>v s) < N - i\<^sub>v')}"
    let ?s1 = "\<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr>"
    let ?s2 = "\<lparr>i\<^sub>v = Suc i\<^sub>v', c\<^sub>v = True\<rparr>"
    assume a1: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real) / real (N - i\<^sub>v')"
    assume a2: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v', c\<^sub>v = True\<rparr> = (1::real) - (1::real) / real (N - i\<^sub>v')"
    assume a3: "i\<^sub>v' < N - Suc 0"
    assume a4: "\<not> infsetsum (pmf prob\<^sub>v') ?sset = (1::real)"
    have f1: "?s1 \<in> ?sset"
      using a3 by auto
    have f2: "?s2 \<in> ?sset"
      using a3 by auto
    have f3: "infsetsum (pmf prob\<^sub>v') ?sset \<ge> infsetsum (pmf prob\<^sub>v') {?s1, ?s2}"
      apply (rule infsetsum_mono_neutral_left)
      apply simp
      apply blast
      apply simp
      using f1 f2
      apply blast
      by simp
    have f4: "infsetsum (pmf prob\<^sub>v') {?s1, ?s2} = (pmf prob\<^sub>v' ?s1 + pmf prob\<^sub>v' ?s2)"
      by auto
    have f5: "infsetsum (pmf prob\<^sub>v') ?sset \<ge> 1"
      using f3 a1 a2 f4 by linarith
    have f6: "infsetsum (pmf prob\<^sub>v') ?sset = 1"
      using sum_pmf_eq_1
      by (metis (mono_tags) UNIV_eq_I dual_order.antisym f5 mem_Collect_eq pmf_disj_leq)
    show "False"
      using f6 a4 by blast
  next
    fix c\<^sub>v::"bool" and ok\<^sub>v::"bool" and i\<^sub>v::"nat" and ok\<^sub>v'::"bool" and prob\<^sub>v::"unisel_vars pmf" and
      ok\<^sub>v''::"bool" and prob\<^sub>v'::"unisel_vars pmf" and x::"unisel_vars \<Rightarrow> unisel_vars pmf" and xa::"nat"
    let ?s1 = "\<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>"
    let ?s2 = "\<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>"
    let ?p_s1 = "(1::real) / real (N - i\<^sub>v)"
    let ?p_s2 = "(1::real) - (1::real) / real (N - i\<^sub>v)"
    assume a1: "i\<^sub>v < N - Suc 0"
    assume a2: "(1::real) \<le> real (N - i\<^sub>v)"
    assume a3: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr> = (1::real) / real (N - i\<^sub>v)"
    assume a4: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr> = (1::real) - (1::real) / real (N - i\<^sub>v)"
    assume a5: "\<forall>(i\<^sub>v::nat) c\<^sub>v::bool.
            pmf prob\<^sub>v \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = c\<^sub>v\<rparr> =
            (\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = c\<^sub>v\<rparr>)"
    assume a6: "\<forall>(i\<^sub>v'::nat) c\<^sub>v::bool.
            (0::real) < pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr> \<longrightarrow>
            (\<forall>prob\<^sub>v::unisel_vars pmf.
                c\<^sub>v \<and>
                N - i\<^sub>v' < N - i\<^sub>v \<and>
                (i\<^sub>v' < N - Suc (0::nat) \<longrightarrow>
                 (\<forall>x<N - Suc i\<^sub>v'. pmf prob\<^sub>v \<lparr>i\<^sub>v = x + i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real) / real (N - i\<^sub>v')) \<and>
                 pmf prob\<^sub>v \<lparr>i\<^sub>v = N - Suc (0::nat), c\<^sub>v = True\<rparr> = (1::real) / real (N - i\<^sub>v')) \<and>
                (i\<^sub>v' < N - Suc (0::nat) \<or> pmf prob\<^sub>v \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = True\<rparr> = (1::real)) \<or>
                \<not> c\<^sub>v \<and> N - Suc i\<^sub>v' < N - i\<^sub>v \<and> pmf prob\<^sub>v \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real) \<or>
                (\<exists>(i\<^sub>v::nat) c\<^sub>v'::bool.
                    \<not> pmf prob\<^sub>v \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = c\<^sub>v'\<rparr> =
                       pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = c\<^sub>v'\<rparr>))"
    assume a7: "xa < N - Suc i\<^sub>v"
    assume a8: "\<not> (\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = xa + i\<^sub>v, c\<^sub>v = False\<rparr>) =
            (1::real) / real (N - i\<^sub>v)"

    have f1: "(\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = xa + i\<^sub>v, c\<^sub>v = False\<rparr>)
                 = (1::real) / real (N - i\<^sub>v)"
    proof -
      have a6': "\<forall>(i\<^sub>v'::nat) c\<^sub>v::bool.
          (0::real) < pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr> \<longrightarrow>
          (
              c\<^sub>v \<and>
              N - i\<^sub>v' < N - i\<^sub>v \<and>
              (i\<^sub>v' < N - Suc 0 \<longrightarrow>
               (\<forall>xx<N - Suc i\<^sub>v'. pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = xx + i\<^sub>v', c\<^sub>v = False\<rparr> =
                      (1::real) / (real (N - i\<^sub>v'))) \<and>
               pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr> = (1::real) / (real (N - i\<^sub>v'))) \<and>
              (i\<^sub>v' < N - Suc (0::nat) \<or> pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = True\<rparr> = (1::real)) \<or>
              \<not> c\<^sub>v \<and> N - Suc i\<^sub>v' < N - i\<^sub>v \<and> pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real)
          )"
        using a6 by blast
      (* *)
      have f10: "pmf (x ?s1) ?s1 = (1::real)"
        using a3 a6' a7 by force
      have f10': "xa > 0 \<longrightarrow> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr> = (0::real)"
        apply (auto)
        apply (rule pmf_not_the_one_is_zero[where xa="\<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>"])
        using f10 apply simp by simp
       \<comment> \<open> From s1, terminate is 1 and others are 0 \<close>
      have f10'': "pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr> =
        (if xa = 0 then (1::real) else (0::real))"
        using f10 f10' by simp

      have Fi': "Suc i\<^sub>v < N"
        using a1 by simp
      have Fi'': "N - Suc i\<^sub>v < N - i\<^sub>v"
        using Fi' Suc_lessD diff_less_mono2 by blast
      have a6'': "(0::real) < pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr> \<longrightarrow>
            (True \<and>
              N - Suc i\<^sub>v < N - i\<^sub>v \<and>
              (Suc i\<^sub>v < N - Suc 0 \<longrightarrow>
               (\<forall>xx<N - Suc (Suc i\<^sub>v). pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = xx + Suc i\<^sub>v, c\<^sub>v = False\<rparr>
                = (1::real) / (real (N - Suc i\<^sub>v))) \<and>
               pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>
                = (1::real) / (real (N - Suc i\<^sub>v))) \<and>
              (Suc i\<^sub>v < N - Suc (0::nat) \<or> pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr> = (1::real)))"
        using a6'
        by blast

      have a6''': "(Suc i\<^sub>v < N - Suc 0 \<longrightarrow> (
         (\<forall>xx<N - Suc (Suc i\<^sub>v). pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = xx + Suc i\<^sub>v, c\<^sub>v = False\<rparr>
          = (1::real) / (real (N - Suc i\<^sub>v))) \<and>
         pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>
          = (1::real) / (real (N - Suc i\<^sub>v)))) \<and>
       (Suc i\<^sub>v < N - Suc (0::nat) \<or> pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr> = (1::real))"
        using a6'' Fi' Fi'' a4 by auto

      have a6'''': "((
         (\<forall>xx<N - Suc (Suc i\<^sub>v). pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = xx + Suc i\<^sub>v, c\<^sub>v = False\<rparr>
          = (1::real) / (real (N - Suc i\<^sub>v))) \<and>
         pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>
          = (1::real) / (real (N - Suc i\<^sub>v))))"
        using a6''' Fi' Fi'' a4
        by (metis One_nat_def Suc_lessI a1 assms diff_diff_cancel diff_self_eq_0 div_by_1
            le_add_diff_inverse not_less0 of_nat_1 plus_1_eq_Suc)

      have f11: "(\<Sum>\<^sub>aa::unisel_vars\<in>
          {\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx < N - Suc (Suc i\<^sub>v)} \<union> {\<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>}.
          pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) a) =
        (\<Sum>\<^sub>aa::unisel_vars\<in> {\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx < N - Suc (Suc i\<^sub>v)}.
          pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) a)
      + (\<Sum>\<^sub>aa::unisel_vars\<in> {\<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>}. pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) a)"
        unfolding infsetsum_altdef abs_summable_on_altdef
        apply (subst set_integral_Un, auto)
        using abs_summable_on_altdef apply fastforce
        using abs_summable_on_altdef by blast
      then have f12: "... = (\<Sum>\<^sub>aa::unisel_vars\<in> {\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx < N - Suc (Suc i\<^sub>v)}.
          pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) a)
          + (1::real) / (real (N - Suc i\<^sub>v))"
        using a6'''' by (smt measure_pmf_conv_infsetsum pmf.rep_eq)

      (* Sum of (pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr>) *)
      have f13: "
        ((\<Sum>\<^sub>aa::unisel_vars\<in> {\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx < N - Suc (Suc i\<^sub>v)}.
          pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) a)
        = ((1::real) / (real (N - Suc i\<^sub>v)))* (N - Suc (Suc i\<^sub>v)))"
        proof -
          have f1: "\<forall>a \<in> {\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx <  N - Suc (Suc i\<^sub>v)}.
              pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) a = ((1::real) / (real (N - Suc i\<^sub>v)))"
            using a6'''' by (smt add.commute mem_Collect_eq)
          have f2: "card {\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx <  N - Suc (Suc i\<^sub>v)} =  N - Suc (Suc i\<^sub>v)"
            apply (rule card_set_comp_uniq)
            by auto
          show ?thesis
            apply (subst infsetsum_uni_c[where cc="((1::real) / (real (N - Suc i\<^sub>v)))"])
            apply simp
            using f1 apply blast
            using f2 by simp
        qed
      have f14: "(\<Sum>\<^sub>aa::unisel_vars\<in>
        {\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx < N - Suc (Suc i\<^sub>v)} \<union> {\<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>}.
        pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) a) =
        ((1::real) / (real (N - Suc i\<^sub>v)))* (N - Suc (Suc i\<^sub>v)) +
        (1::real) / (real (N - Suc i\<^sub>v))"
        using f11 f12 f13 by simp
      have f15: "... = 1"
        by (metis Fi' Suc_diff_Suc add.commute add_divide_distrib diff_is_0_eq diff_zero divide_self
            le_add1 mult.left_neutral n_not_Suc_n of_nat_Suc of_nat_eq_0_iff times_divide_eq_left)
      have f_not_in1: "\<not> \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr> \<in>
        {\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx < N - Suc (Suc i\<^sub>v)} \<union> {\<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>}"
        by simp
      have f16: "pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr> = (0::real)"
        apply (rule pmf_not_in_the_one_is_zero[where
              A="{\<lparr>i\<^sub>v = Suc i\<^sub>v + xx, c\<^sub>v = False\<rparr> |xx. xx < N - Suc (Suc i\<^sub>v)} \<union> {\<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>}"])
        using f14 f15 apply simp
        using f_not_in1 by blast
      \<comment> \<open> Calculate pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr> \<close>
      have f17: "pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
            = (if xa = 0 then 0 else (1::real) / (real (N - Suc i\<^sub>v)))"
        proof (cases "xa = 0")
          case True
          then show ?thesis
            apply (simp)
            using f16 by blast
        next
          case False
          have f111: "pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr> =
            pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = Suc i\<^sub>v + xa - 1, c\<^sub>v = False\<rparr>"
            using False by simp
          have f112: "xa - 1 < N - Suc (Suc i\<^sub>v)"
            using a7 False by linarith
          have "pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = Suc i\<^sub>v + xa - 1, c\<^sub>v = False\<rparr>
            = (1::real) / (real (N - Suc i\<^sub>v))"
            using a7 a6'''' False f112
            by (metis Nat.add_diff_assoc One_nat_def Suc_leI add.commute neq0_conv)
          then show ?thesis
            using a5 a6'''' by (simp add: False)
        qed
      have prob\<^sub>v_1_1: "infsetsum (pmf prob\<^sub>v') {\<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>, \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>}
        = (pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>) + (pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>)"
        by auto
      have prob\<^sub>v_1_2: "... = (1::real)"
        using a3 a4 by simp
      have not_s1_s2_is_0: "\<forall>a. a \<notin> {?s1, ?s2} \<longrightarrow> pmf prob\<^sub>v' a = 0"
        apply (auto)
        apply (rule pmf_not_in_the_one_is_zero[where A="{?s1, ?s2}"])
        apply (simp add: prob\<^sub>v_1_2)
        by simp
      have s1_s2_all: "{?s1,?s2}\<union>({x. x \<notin> {?s1,?s2}}) = UNIV"
        by blast
      have pmf_x_simp: "\<forall>a. (if a = ?s1
             then ?p_s1 \<cdot> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then ?p_s2 \<cdot> pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>))
          = (if a = ?s1
             then ?p_s1 \<cdot> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then ?p_s2 \<cdot> pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else 0 \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>))"
        apply (auto)
        using not_s1_s2_is_0 by auto
      then have pmf_x_simp': "(\<lambda>a. (if a = ?s1
             then ?p_s1 \<cdot> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then ?p_s2 \<cdot> pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>)))
        = (\<lambda>a. (if a = ?s1
             then ?p_s1 \<cdot> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then ?p_s2 \<cdot> pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else 0 \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>)))"
        by blast
      \<comment> \<open> Steps towards the goal:
          Hard to deal with @{text "pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>"} directly,
          but we can split it into conditional expression.
         \<close>
      have f18: "(\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>)
        = (\<Sum>\<^sub>aa::unisel_vars.
            (if a = ?s1
             then pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>)))"
        by presburger
      have f18': "... = (\<Sum>\<^sub>aa::unisel_vars.
            (if a = ?s1
             then ?p_s1 \<cdot> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then ?p_s2 \<cdot> pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>)))"
        using a3 a4
        by (metis (no_types, hide_lams))
      have f18'': "... = (\<Sum>\<^sub>aa::unisel_vars.
            (if a = ?s1
             then ?p_s1 \<cdot> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then ?p_s2 \<cdot> pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else 0 \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>)))"
        using pmf_x_simp' by presburger
      have f18''': "... = (\<Sum>\<^sub>aa::unisel_vars.
            (if a = ?s1
             then ?p_s1 \<cdot> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then ?p_s2 \<cdot> pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else 0)))"
        apply (subst mult_zero_left)
        by (simp)
      have f18'''': "... = (\<Sum>\<^sub>aa::unisel_vars\<in>{?s1,?s2}\<union>({x. x \<notin> {?s1,?s2}}).
            (if a = ?s1
             then ?p_s1 \<cdot> pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
             else (if a = ?s2
                   then ?p_s2 \<cdot> pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>
                   else 0)))"
        using s1_s2_all by simp
      \<comment> \<open> Substitute @{text "pmf (x ?s1) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>"} by f10'' and
              @{text "pmf (x ?s2) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>"} by f17
         \<close>
      have f18''''': "... = (\<Sum>\<^sub>aa::unisel_vars\<in>{?s1,?s2}\<union>({x. x \<notin> {?s1,?s2}}).
            (if a = ?s1
             then ?p_s1 \<cdot> (if xa = 0 then (1::real) else (0::real))
             else (if a = ?s2
                   then ?p_s2 \<cdot> (if xa = 0 then 0 else (1::real) /  (real (N - Suc i\<^sub>v)))
                   else 0)))"
        using f10'' f17 by presburger
      show ?thesis
        proof (cases "xa = 0")
          case True
          have f111: "(\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>)
            = (\<Sum>\<^sub>aa::unisel_vars\<in>{?s1,?s2}\<union>({x. x \<notin> {?s1,?s2}}).
            (if a = ?s1
             then ?p_s1 \<cdot> (if xa = 0 then (1::real) else (0::real))
             else (if a = ?s2
                   then ?p_s2 \<cdot> (if xa = 0 then 0 else (1::real) / (real (N - Suc i\<^sub>v)))
                   else 0)))"
            by (metis f18' f18'' f18''' f18''''' s1_s2_all)
          have f112: "... = (\<Sum>\<^sub>aa::unisel_vars\<in>{?s1,?s2}\<union>({x. x \<notin> {?s1,?s2}}).
            (if a = ?s1
             then ?p_s1 \<cdot> (1::real)
             else (if a = ?s2 then ?p_s2 \<cdot> (0::real) else 0)))"
            using True by simp
          have f113: "... = (\<Sum>\<^sub>aa::unisel_vars.
            (if a = ?s1 then ?p_s1 else 0))"
            using s1_s2_all by (smt infsetsum_cong)
          have f114: "... = ?p_s1"
            apply (subst infsetsum_single)
            by simp
          then show ?thesis
            proof -
              have "(\<Sum>\<^sub>au. pmf prob\<^sub>v' u \<cdot> pmf (x u) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>) = 1 / real (N - i\<^sub>v)"
                using f111 f112 f113 f114 by presburger
              then show ?thesis
                by (simp add: add.commute)
            qed
        next
          case False
          have p_s2': "?p_s2 = ((real (N - i\<^sub>v) - 1) / (real (N - i\<^sub>v)))"
            by (metis a2 diff_divide_distrib divide_self f10 not_le pmf_pos zero_neq_one)
          have f110: "(real (N - i\<^sub>v) - 1) = (real (N - Suc i\<^sub>v))"
            using a1 by linarith
          have f110': "(real (N - Suc i\<^sub>v)) > 0"
            using a1 by linarith
          have f111: "(\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v + xa, c\<^sub>v = False\<rparr>)
            = (\<Sum>\<^sub>aa::unisel_vars\<in>{?s1,?s2}\<union>({x. x \<notin> {?s1,?s2}}).
            (if a = ?s1
             then ?p_s1 \<cdot> (if xa = 0 then (1::real) else (0::real))
             else (if a = ?s2
                   then ?p_s2 \<cdot> (if xa = 0 then 0 else (1::real) / ((real (N - Suc i\<^sub>v))))
                   else 0)))"
            by (metis f18' f18'' f18''' f18''''' s1_s2_all)
          have f112: "... = (\<Sum>\<^sub>aa::unisel_vars\<in>{?s1,?s2}\<union>({x. x \<notin> {?s1,?s2}}).
            (if a = ?s1
             then ?p_s1 \<cdot> (0::real)
             else (if a = ?s2 then ?p_s2 \<cdot> ((1::real) / ((real (N - Suc i\<^sub>v)))) else 0)))"
            using False by simp
          have f113: "... = (\<Sum>\<^sub>aa::unisel_vars.
            (if a = ?s2 then ?p_s2 \<cdot> ((1::real) / ((real (N - Suc i\<^sub>v)))) else 0))"
            using s1_s2_all
            by (smt infsetsum_cong unisel_vars.iffs)
          have f114: "... = ?p_s2 \<cdot> ((1::real) / ((real (N - Suc i\<^sub>v))))"
            apply (subst infsetsum_single)
            by simp
          have f115: "... = ((real (N - i\<^sub>v) - 1) / (real (N - i\<^sub>v))) \<cdot>
              ((1::real) / (((real (N - Suc i\<^sub>v)))))"
            by (simp add: p_s2')
          have f116: "(real (N - i\<^sub>v) - 1) = ((real (N - Suc i\<^sub>v)))"
            using f110 by blast
          then show ?thesis
            using f110 f111 f112 f113 f114 f115 f110'
            by (simp add: add.commute)
        qed
      qed
    show "False"
      using a8 f1 by blast
  next
    fix c\<^sub>v::"bool" and ok\<^sub>v::"bool" and i\<^sub>v::"nat" and ok\<^sub>v'::"bool" and prob\<^sub>v::"unisel_vars pmf" and
      ok\<^sub>v''::"bool" and prob\<^sub>v'::"unisel_vars pmf" and x::"unisel_vars \<Rightarrow> unisel_vars pmf" and xa::"nat"
    let ?s1 = "\<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>"
    let ?s2 = "\<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>"
    let ?p_s1 = "(1::real) / real (N - i\<^sub>v)"
    let ?p_s2 = "(1::real) - (1::real) / real (N - i\<^sub>v)"
    let ?s' = "\<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>"
    assume a1: "i\<^sub>v < N - Suc 0"
    assume a2: "(1::real) \<le> real (N - i\<^sub>v)"
    assume a3: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr> = (1::real) / real (N - i\<^sub>v)"
    assume a4: "pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr> = (1::real) - (1::real) / real (N - i\<^sub>v)"
    assume a5: "\<forall>(i\<^sub>v::nat) c\<^sub>v::bool.
            pmf prob\<^sub>v \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = c\<^sub>v\<rparr> =
            (\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = c\<^sub>v\<rparr>)"
    assume a6: "\<forall>(i\<^sub>v'::nat) c\<^sub>v::bool.
            (0::real) < pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr> \<longrightarrow>
            (\<forall>prob\<^sub>v::unisel_vars pmf.
                c\<^sub>v \<and>
                N - i\<^sub>v' < N - i\<^sub>v \<and>
                (i\<^sub>v' < N - Suc (0::nat) \<longrightarrow>
                 (\<forall>x<N - Suc i\<^sub>v'. pmf prob\<^sub>v \<lparr>i\<^sub>v = x + i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real) / real (N - i\<^sub>v')) \<and>
                 pmf prob\<^sub>v \<lparr>i\<^sub>v = N - Suc (0::nat), c\<^sub>v = True\<rparr> = (1::real) / real (N - i\<^sub>v')) \<and>
                (i\<^sub>v' < N - Suc (0::nat) \<or> pmf prob\<^sub>v \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = True\<rparr> = (1::real)) \<or>
                \<not> c\<^sub>v \<and> N - Suc i\<^sub>v' < N - i\<^sub>v \<and> pmf prob\<^sub>v \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real) \<or>
                (\<exists>(i\<^sub>v::nat) c\<^sub>v'::bool.
                    \<not> pmf prob\<^sub>v \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = c\<^sub>v'\<rparr> = pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = c\<^sub>v'\<rparr>))"
    assume a7: "i\<^sub>v < N - Suc (0::nat)"
    assume a8: "\<not> (\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v = N - Suc (0::nat), c\<^sub>v = True\<rparr>) =
            (1::real) / real (N - i\<^sub>v)"

    have a6': "\<forall>(i\<^sub>v'::nat) c\<^sub>v::bool.
        (0::real) < pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr> \<longrightarrow>
        (
            c\<^sub>v \<and>
            N - i\<^sub>v' < N - i\<^sub>v \<and>
            (i\<^sub>v' < N - Suc 0 \<longrightarrow>
             (\<forall>xx<N - Suc i\<^sub>v'. pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = xx + i\<^sub>v', c\<^sub>v = False\<rparr> =
                    (1::real) / (real (N - i\<^sub>v'))) \<and>
             pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr> = (1::real) / (real (N - i\<^sub>v'))) \<and>
            (i\<^sub>v' < N - Suc (0::nat) \<or> pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = True\<rparr> = (1::real)) \<or>
            \<not> c\<^sub>v \<and> N - Suc i\<^sub>v' < N - i\<^sub>v \<and> pmf (x \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = c\<^sub>v\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v', c\<^sub>v = False\<rparr> = (1::real)
        )"
      using a6 by blast
    have a6'': "(0::real) < pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr> \<longrightarrow>
          (True \<and>
            N - Suc i\<^sub>v < N - i\<^sub>v \<and>
            (Suc i\<^sub>v < N - Suc 0 \<longrightarrow>
             (\<forall>xx<N - Suc (Suc i\<^sub>v). pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = xx + Suc i\<^sub>v, c\<^sub>v = False\<rparr>
              = (1::real) / (real (N - Suc i\<^sub>v))) \<and>
             pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>
              = (1::real) / (real (N - Suc i\<^sub>v))) \<and>
            (Suc i\<^sub>v < N - Suc (0::nat) \<or> pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr> = (1::real)))"
      using a6'
      by blast

    have a6''': "(Suc i\<^sub>v < N - Suc 0 \<longrightarrow> (
       (\<forall>xx<N - Suc (Suc i\<^sub>v). pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = xx + Suc i\<^sub>v, c\<^sub>v = False\<rparr>
        = (1::real) / (real (N - Suc i\<^sub>v))) \<and>
       pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>
        = (1::real) / (real (N - Suc i\<^sub>v)))) \<and>
     (Suc i\<^sub>v < N - Suc (0::nat) \<or> pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr> = (1::real))"
      using a6'' a4 a7 by auto

    have a6'''': "((
       (\<forall>xx<N - Suc (Suc i\<^sub>v). pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = xx + Suc i\<^sub>v, c\<^sub>v = False\<rparr>
        = (1::real) / (real (N - Suc i\<^sub>v))) \<and>
       pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>
        = (1::real) / (real (N - Suc i\<^sub>v))))"
      using a6''' a4
      by (metis One_nat_def Suc_lessI a7 assms diff_diff_cancel diff_self_eq_0 div_by_1
          le_add_diff_inverse not_less0 of_nat_1 plus_1_eq_Suc)

    have f1: "(\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>i\<^sub>v =  N - Suc (0::nat), c\<^sub>v = True\<rparr>) =
      (1::real) / real (N - i\<^sub>v)"
      proof -
        have f10: "(pmf (x \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>) \<lparr>i\<^sub>v = N - Suc 0, c\<^sub>v = True\<rparr>
                        = (1::real) / (real (N - Suc i\<^sub>v)))"
          using a6'''' by simp

        have f11: "pmf (x \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>) \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr> = (1::real)"
          using a6' a3 using a2 by force

        have f11': "pmf (x ?s1) ?s' = (0::real)"
          apply (rule pmf_not_the_one_is_zero[where xa="\<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>"])
          using f11 apply simp
          by simp

        have f12: "pmf (x ?s2) ?s' = (1::real) / (real (N - Suc i\<^sub>v))"
          using a6'''' by simp

        have prob\<^sub>v_1_1: "infsetsum (pmf prob\<^sub>v') {\<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>, \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>}
          = (pmf prob\<^sub>v' \<lparr>i\<^sub>v = i\<^sub>v, c\<^sub>v = False\<rparr>) + (pmf prob\<^sub>v' \<lparr>i\<^sub>v = Suc i\<^sub>v, c\<^sub>v = True\<rparr>)"
          by auto
        have prob\<^sub>v_1_2: "... = (1::real)"
          using a3 a4 by simp
        have not_s1_s2_is_0: "\<forall>a. a \<notin> {?s1, ?s2} \<longrightarrow> pmf prob\<^sub>v' a = 0"
          apply (auto)
          apply (rule pmf_not_in_the_one_is_zero[where A="{?s1, ?s2}"])
          apply (simp add: prob\<^sub>v_1_2)
          by simp

        have pmf_x_simp: "\<forall>a. (if a = ?s1
               then ?p_s1 \<cdot> pmf (x ?s1) ?s'
               else (if a = ?s2
                     then ?p_s2 \<cdot> pmf (x ?s2) ?s'
                     else pmf prob\<^sub>v' a \<cdot> pmf (x a) ?s'))
            = (if a = ?s1
               then ?p_s1 \<cdot> pmf (x ?s1) ?s'
               else (if a = ?s2
                     then ?p_s2 \<cdot> pmf (x ?s2) ?s'
                     else 0 \<cdot> pmf (x a) ?s'))"
          apply (auto)
          using not_s1_s2_is_0 by auto
        then have pmf_x_simp': "(\<lambda>a. (if a = ?s1
               then ?p_s1 \<cdot> pmf (x ?s1) ?s'
               else (if a = ?s2
                     then ?p_s2 \<cdot> pmf (x ?s2) ?s'
                     else pmf prob\<^sub>v' a \<cdot> pmf (x a) ?s')))
          = (\<lambda>a. (if a = ?s1
               then ?p_s1 \<cdot> pmf (x ?s1) ?s'
               else (if a = ?s2
                     then ?p_s2 \<cdot> pmf (x ?s2) ?s'
                     else 0 \<cdot> pmf (x a) ?s')))"
          by blast
        have f13: "(\<Sum>\<^sub>aa::unisel_vars. pmf prob\<^sub>v' a \<cdot> pmf (x a) ?s')
          = (\<Sum>\<^sub>aa::unisel_vars.
              (if a = ?s1
               then pmf prob\<^sub>v' a \<cdot> pmf (x a) ?s'
               else (if a = ?s2
                     then pmf prob\<^sub>v' a \<cdot> pmf (x a) ?s'
                     else pmf prob\<^sub>v' a \<cdot> pmf (x a) ?s')))"
          by presburger
        have f13': "... = (\<Sum>\<^sub>aa::unisel_vars.
              (if a = ?s1
               then ?p_s1 \<cdot> pmf (x ?s1) ?s'
               else (if a = ?s2
                     then ?p_s2 \<cdot> pmf (x ?s2) ?s'
                     else pmf prob\<^sub>v' a \<cdot> pmf (x a) ?s')))"
          using a3 a4
          by (metis (no_types, hide_lams))
        have f13'': "... = (\<Sum>\<^sub>aa::unisel_vars.
              (if a = ?s1
               then ?p_s1 \<cdot> pmf (x ?s1) ?s'
               else (if a = ?s2
                     then ?p_s2 \<cdot> pmf (x ?s2) ?s'
                     else 0 \<cdot> pmf (x a) ?s')))"
          using pmf_x_simp' by presburger
        have f13''': "... = (\<Sum>\<^sub>aa::unisel_vars.
              (if a = ?s1
               then ?p_s1 \<cdot> pmf (x ?s1) ?s'
               else (if a = ?s2
                     then ?p_s2 \<cdot> pmf (x ?s2) ?s'
                     else 0)))"
          apply (subst mult_zero_left)
          by (simp)
        have f13'''': "... = (\<Sum>\<^sub>aa::unisel_vars.
              (if a = ?s1
               then ?p_s1 \<cdot> (0::real)
               else (if a = ?s2
                     then ?p_s2 \<cdot> ((1::real) / (real (N - Suc i\<^sub>v)))
                     else 0)))"
          using f11' f12 by presburger
        have f13''''': "... = (\<Sum>\<^sub>aa::unisel_vars.
              (if a = ?s2
               then ?p_s2 \<cdot> ((1::real) / (real (N - Suc i\<^sub>v)))
               else 0))"
          by (metis mult_zero_right unisel_vars.ext_inject)
        have f13'''''': "... = ?p_s2 \<cdot> ((1::real) / (real (N - Suc i\<^sub>v)))"
          apply (subst infsetsum_single)
          by simp
        have p_s2_simp: "?p_s2 = (real (N - i\<^sub>v) - 1) / (real (N - i\<^sub>v))"
           by (metis (no_types, hide_lams) a2 add_divide_distrib add_uminus_conv_diff
               divide_minus_left divide_self linorder_neqE_linordered_idom not_le of_nat_1
               of_nat_less_0_iff zero_neq_one)
        have p_s'_simp': "(real (N - i\<^sub>v) - 1) = (real (N - Suc i\<^sub>v))"
          using a1 by linarith
        have p_s2_s'_simp: "?p_s2 \<cdot> ((1::real) / (real (N - Suc i\<^sub>v)))
          = (1::real) / (real (N - i\<^sub>v))"
          using p_s'_simp' p_s2_simp a7 by force
        show ?thesis
          using f13 f13' f13'' f13''' f13'''' f13''''' f13'''''' p_s2_s'_simp by auto
      qed
    show "False"
      using f1 a8 by auto
  qed
qed

subsubsection \<open> Contract \<close>
lemma unisel_contract:
  assumes "N \<ge> 1"
  shows "U(true \<turnstile>\<^sub>n
    (
      ((\<forall>j<\<guillemotleft>N\<guillemotright>-1. $prob\<acute>($\<^bold>v\<lbrakk>\<guillemotleft>j\<guillemotright>, false/$i, $c\<rbrakk>) = U(1/real (\<guillemotleft>N\<guillemotright>))) \<and>
      $prob\<acute>($\<^bold>v\<lbrakk>\<guillemotleft>N-1\<guillemotright>, true/$i, $c\<rbrakk>) = U(1/real (\<guillemotleft>N\<guillemotright>)))
    )) \<sqsubseteq> (i :=\<^sub>D 0 ;; c :=\<^sub>D true ;; unisel_rec N)"
proof -
  have f1: "i :=\<^sub>D 0 ;; c :=\<^sub>D true ;; unisel_inv N \<sqsubseteq> (i :=\<^sub>D 0 ;; c :=\<^sub>D true ;; unisel_rec N)"
    apply (rule seqr_mono, simp)
    apply (rule seqr_mono, simp)
    using assms unisel_rec_inv by auto
  have f2: "i :=\<^sub>D 0 ;; c :=\<^sub>D true ;; unisel_inv N = U(true \<turnstile>\<^sub>n
    (
      ((\<forall>j<\<guillemotleft>N\<guillemotright>-1. $prob\<acute>($\<^bold>v\<lbrakk>\<guillemotleft>j\<guillemotright>, false/$i, $c\<rbrakk>) = U(1/real (\<guillemotleft>N\<guillemotright>))) \<and>
      $prob\<acute>($\<^bold>v\<lbrakk>\<guillemotleft>N-1\<guillemotright>, true/$i, $c\<rbrakk>) = U(1/real (\<guillemotleft>N\<guillemotright>)))
    ))"
    apply (simp add: unisel_inv_def)
    apply (rel_auto)
    using assms apply linarith+
    apply blast
    by (metis (mono_tags, hide_lams) assms diff_is_0_eq' diff_zero div_by_1
        less_Suc0 less_asym linorder_neqE_nat not_less_zero
        of_nat_1_eq_iff zero_less_Suc zero_less_diff zero_neq_one)
  show ?thesis
    using f1 f2 by auto
qed

end


(*  Title:      HOL/Proofs/Extraction/Util.thy
    Author:     Stefan Berghofer, TU Muenchen
*)

section \<open>Auxiliary lemmas used in program extraction examples\<close>

theory Util
imports "~~/src/HOL/Library/Old_Datatype"
begin

text \<open>Decidability of equality on natural numbers.\<close>

lemma nat_eq_dec: "\<And>n::nat. m = n \<or> m \<noteq> n"
  apply (induct m)
  apply (case_tac n)
  apply (case_tac [3] n)
  apply (simp only: nat.simps, iprover?)+
  done

text \<open>
  Well-founded induction on natural numbers, derived using the standard
  structural induction rule.
\<close>

lemma nat_wf_ind:
  assumes R: "\<And>x::nat. (\<And>y. y < x \<Longrightarrow> P y) \<Longrightarrow> P x"
  shows "P z"
proof (rule R)
  show "\<And>y. y < z \<Longrightarrow> P y"
  proof (induct z)
    case 0
    then show ?case by simp
  next
    case (Suc n y)
    from nat_eq_dec show ?case
    proof
      assume ny: "n = y"
      have "P n"
        by (rule R) (rule Suc)
      with ny show ?case by simp
    next
      assume "n \<noteq> y"
      with Suc have "y < n" by simp
      then show ?case by (rule Suc)
    qed
  qed
qed

text \<open>Bounded search for a natural number satisfying a decidable predicate.\<close>

lemma search:
  assumes dec: "\<And>x::nat. P x \<or> \<not> P x"
  shows "(\<exists>x<y. P x) \<or> \<not> (\<exists>x<y. P x)"
proof (induct y)
  case 0
  show ?case by simp
next
  case (Suc z)
  then show ?case
  proof
    assume "\<exists>x<z. P x"
    then obtain x where le: "x < z" and P: "P x" by iprover
    from le have "x < Suc z" by simp
    with P show ?case by iprover
  next
    assume nex: "\<not> (\<exists>x<z. P x)"
    from dec show ?case
    proof
      assume P: "P z"
      have "z < Suc z" by simp
      with P show ?thesis by iprover
    next
      assume nP: "\<not> P z"
      have "\<not> (\<exists>x<Suc z. P x)"
      proof
        assume "\<exists>x<Suc z. P x"
        then obtain x where le: "x < Suc z" and P: "P x" by iprover
        have "x < z"
        proof (cases "x = z")
          case True
          with nP and P show ?thesis by simp
        next
          case False
          with le show ?thesis by simp
        qed
        with P have "\<exists>x<z. P x" by iprover
        with nex show False ..
      qed
      then show ?case by iprover
    qed
  qed
qed

end


(*
Auction Theory Toolbox (http://formare.github.io/auctions/)

Authors:
* Marco B. Caminati http://caminati.co.nr
* Manfred Kerber <mnfrd.krbr@gmail.com>
* Christoph Lange <math.semantic.web@gmail.com>
* Colin Rowat <c.rowat@bham.ac.uk>

Dually licenced under
* Creative Commons Attribution (CC-BY) 3.0
* ISC License (1-clause BSD License)
See LICENSE file for details
(Rationale for this dual licence: http://arxiv.org/abs/1107.3212)
*)

section \<open>Additional operators on relations, going beyond Relations.thy,
  and properties of these operators\<close>

theory RelationOperators
imports
  SetUtils
  "HOL-Library.Code_Target_Nat"

begin

subsection \<open>Evaluating a relation as a function\<close>

text \<open>If an input has a unique image element under a given relation, return that element;
  otherwise return a fallback value.\<close>
fun eval_rel_or :: "('a \<times> 'b) set \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  where "eval_rel_or R a z = (let im = R `` {a} in if card im = 1 then the_elem im else z)"

text \<open>right-uniqueness of a relation: the image of a @{const trivial} set (i.e.\ an empty or
  singleton set) under the relation is trivial again.
This is the set-theoretical way of characterizing functions, as opposed to \<open>\<lambda>\<close> functions.\<close>
definition runiq :: "('a \<times> 'b) set \<Rightarrow> bool"
  where "runiq R = (\<forall> X . trivial X \<longrightarrow> trivial (R `` X))"

subsection \<open>Restriction\<close>

text \<open>restriction of a relation to a set (usually resulting in a relation with a smaller domain)\<close>
definition restrict :: "('a \<times> 'b) set \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'b) set" (infix "||" 75)
  where "R || X = (X \<times> Range R) \<inter> R"

text \<open>extensional characterization of the pairs within a restricted relation\<close>
lemma restrict_ext: "R || X = {(x, y) | x y . x \<in> X \<and> (x, y) \<in> R}"
      unfolding restrict_def using Range_iff by blast

text \<open>alternative statement of @{thm restrict_ext} without explicitly naming the pair's components\<close>
lemma restrict_ext': "R || X = {p . fst p \<in> X \<and> p \<in> R}"
proof -
  have "R || X = {(x, y) | x y . x \<in> X \<and> (x, y) \<in> R}" by (rule restrict_ext)
  also have "\<dots> = { p . fst p \<in> X \<and> p \<in> R }" by force
  finally show ?thesis .
qed

text \<open>Restricting a relation to the empty set yields the empty set.\<close>
lemma restrict_empty: "P || {} = {}"
      unfolding restrict_def by simp

text \<open>A restriction is a subrelation of the original relation.\<close>
lemma restriction_is_subrel: "P || X \<subseteq> P"
      using restrict_def by blast

text \<open>Restricting a relation only has an effect within its domain.\<close>
lemma restriction_within_domain: "P || X = P || (X \<inter> (Domain P))"
      unfolding restrict_def by fast

text \<open>alternative characterization of the restriction of a relation to a singleton set\<close>
lemma restrict_to_singleton: "P || {x} = {x} \<times> (P `` {x})"
      unfolding restrict_def by fast

subsection \<open>Relation outside some set\<close>

text \<open>For a set-theoretical relation @{term R} and an ``exclusion'' set @{term X}, return those
  tuples of @{term R} whose first component is not in @{term X}.  In other words, exclude @{term X}
  from the domain of @{term R}.\<close>
definition Outside :: "('a \<times> 'b) set \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'b) set" (infix "outside" 75)
   where "R outside X = R - (X \<times> Range R)"

text \<open>Considering a relation outside some set @{term X} reduces its domain by @{term X}.\<close>
lemma outside_reduces_domain: "Domain (P outside X) = (Domain P) - X"
      unfolding Outside_def by fast

text \<open>Considering a relation outside a singleton set @{term "{x}"} reduces its domain by
  @{term x}.\<close>
corollary Domain_outside_singleton:
  assumes "Domain R = insert x A"
      and "x \<notin> A"
  shows "Domain (R outside {x}) = A"
  using assms outside_reduces_domain by (metis Diff_insert_absorb)

text \<open>For any set, a relation equals the union of its restriction to that set and its
  pairs outside that set.\<close>
lemma outside_union_restrict: "P = (P outside X) \<union> (P || X)"
      unfolding Outside_def restrict_def by fast

text \<open>The range of a relation @{term R} outside some exclusion set @{term X} is a
  subset of the image of the domain of @{term R}, minus @{term X}, under @{term R}.\<close>
lemma Range_outside_sub_Image_Domain: "Range (R outside X) \<subseteq> R `` (Domain R - X)"
      using Outside_def Image_def Domain_def Range_def by blast

text \<open>Considering a relation outside some set does not enlarge its range.\<close>
lemma Range_outside_sub:
  assumes "Range R \<subseteq> Y"
  shows "Range (R outside X) \<subseteq> Y"
  using assms outside_union_restrict by (metis Range_mono inf_sup_ord(3) subset_trans)

subsection \<open>Flipping pairs of relations\<close>

text \<open>flipping a pair: exchanging first and second component\<close>
definition flip where "flip tup = (snd tup, fst tup)"

text \<open>Flipped pairs can be found in the converse relation.\<close>
lemma flip_in_conv:
  assumes "tup \<in> R"
  shows "flip tup \<in> R\<inverse>"
  using assms unfolding flip_def by simp

text \<open>Flipping a pair twice doesn't change it.\<close>
lemma flip_flip: "flip (flip tup) = tup"
  by (metis flip_def fst_conv snd_conv surjective_pairing)

text \<open>Flipping all pairs in a relation yields the converse relation.\<close>
lemma flip_conv: "flip ` R = R\<inverse>"
proof -
  have "flip ` R = { flip tup | tup . tup \<in> R }" by (metis image_Collect_mem)
  also have "\<dots> = { tup . tup \<in> R\<inverse> }" using flip_in_conv by (metis converse_converse flip_flip)
  also have "\<dots> = R\<inverse>" by simp
  finally show ?thesis .
qed

subsection \<open>Evaluation as a function\<close>

text \<open>Evaluates a relation @{term R} for a single argument, as if it were a function.
  This will only work if @{term R} is right-unique, i.e. if the image is always a singleton set.\<close>
fun eval_rel :: "('a \<times> 'b) set \<Rightarrow> 'a \<Rightarrow> 'b" (infix ",," 75) (* . (Mizar's notation) confuses Isar *)
    where "R ,, a = the_elem (R `` {a})"

subsection \<open>Paste\<close>

text \<open>the union of two binary relations @{term P} and @{term Q}, where pairs from @{term Q}
  override pairs from @{term P} when their first components coincide.
This is particularly useful when P, Q are @{term runiq}, and one wants to preserve that property.\<close>
definition paste (infix "+*" 75)
   where "P +* Q = (P outside Domain Q) \<union> Q"

text \<open>If a relation @{term P} is a subrelation of another relation @{term Q} on @{term Q}'s
  domain, pasting @{term Q} on @{term P} is the same as forming their union.\<close>
lemma paste_subrel:
   assumes "P || Domain Q \<subseteq> Q"
   shows "P +* Q = P \<union> Q"
   unfolding paste_def using assms outside_union_restrict by blast

text \<open>Pasting two relations with disjoint domains is the same as forming their union.\<close>
lemma paste_disj_domains:
   assumes "Domain P \<inter> Domain Q = {}"
   shows "P +* Q = P \<union> Q"
   unfolding paste_def Outside_def using assms by fast

text \<open>A relation @{term P} is equivalent to pasting its restriction to some set @{term X} on
  @{term "P outside X"}.\<close>
lemma paste_outside_restrict: "P = (P outside X) +* (P || X)"
proof -
  have "Domain (P outside X) \<inter> Domain (P || X) = {}"
    unfolding Outside_def restrict_def by fast
  moreover have "P = P outside X \<union> P || X" by (rule outside_union_restrict)
  ultimately show ?thesis using paste_disj_domains by metis
qed

text \<open>The domain of two pasted relations equals the union of their domains.\<close>
lemma paste_Domain: "Domain(P +* Q)=Domain P\<union>Domain Q" unfolding paste_def Outside_def by blast

text \<open>Pasting two relations yields a subrelation of their union.\<close>
lemma paste_sub_Un: "P +* Q \<subseteq> P \<union> Q"
  unfolding paste_def Outside_def by fast

text \<open>The range of two pasted relations is a subset of the union of their ranges.\<close>
lemma paste_Range: "Range (P +* Q) \<subseteq> Range P \<union> Range Q"
  using paste_sub_Un by blast
end


(*  Title:       Countable Ordinals

    Author:      Brian Huffman, 2005
    Maintainer:  Brian Huffman <brianh at cse.ogi.edu>
*)

section \<open>Continuity\<close>

theory OrdinalCont
  imports OrdinalInduct
begin

subsection \<open>Continuous functions\<close>

locale continuous =
  fixes F :: "ordinal \<Rightarrow> ordinal"
  assumes cont: "F (oLimit f) = oLimit (\<lambda>n. F (f n))"

lemmas continuousD = continuous.cont

lemma (in continuous) monoD: assumes "x \<le> y" shows "F x \<le> F y"
proof -
  have "oLimit (case_nat u (\<lambda>n. v)) = max u v" for u v
    apply (simp add: max_def)
    by (metis (no_types, lifting) le_oLimit less_oLimitE linorder_not_le oLimit_Suc nat.case order_le_less)
  then show "F x \<le> F y"
    by (metis \<open>x \<le> y\<close> cont le_oLimit max.absorb2 nat.case(1))
qed

lemma (in continuous) mono: "mono F"
  by (simp add: local.monoD monoI)

lemma continuousI:
  assumes lim: "\<And>f. strict_mono f \<Longrightarrow> F (oLimit f) = oLimit (\<lambda>n. F (f n))"
  assumes suc: "\<And>x. F x \<le> F (oSuc x)"
  shows "continuous F"
proof -
  have mono: "x \<le> y \<Longrightarrow> F x \<le> F y" for x y
  proof (induction y arbitrary: x rule: oLimit_induct)
    case zero
    then show ?case by auto
  next
    case (suc x)
    with assms show ?case
      by (metis antisym_conv1 le_oSucE nless_le order.trans)
  next
    case (lim f)
    with assms show ?case thm assms(1)
      by (metis le_oLimitI nle_le oLimit_leI)
  qed
  have "F (oLimit f) = oLimit (\<lambda>n. F (f n))" for f
  proof (cases "\<forall>n. f n < oLimit f")
    case True
    then have \<section>: "oLimit (\<lambda>n. f (make_mono f n)) = oLimit f"
      by (simp add: oLimit_make_mono_eq)
    have "\<And>n. \<exists>m. F (f n) \<le> F (f (make_mono f m))"
      by (metis True mono less_oLimitD linorder_not_less oLimit_make_mono_eq ordinal_linear)
    then show ?thesis
      by (metis True \<section> oLimit_eqI lim strict_mono_f_make_mono)
  next
    case False
    then show ?thesis
      by (metis le_oLimit less_oLimitE linorder_not_le mono nle_le)
  qed
  with mono show ?thesis
    by (simp add: continuous.intro)
qed

subsection \<open>Normal functions\<close>

locale normal = continuous +
  assumes strict: "strict_mono F"

lemma (in normal) mono: "mono F"
  by (rule mono)

lemma (in normal) continuous: "continuous F"
  by (rule continuous.intro, rule cont)

lemma (in normal) monoD: "x \<le> y \<Longrightarrow> F x \<le> F y"
  by (rule monoD)

lemma (in normal) strict_monoD: "x < y \<Longrightarrow> F x < F y"
  by (erule strict_monoD[OF strict])

lemma (in normal) cancel_eq: "(F x = F y) = (x = y)"
  by (rule strict_mono_cancel_eq[OF strict])

lemma (in normal) cancel_less: "(F x < F y) = (x < y)"
  by (rule strict_mono_cancel_less[OF strict])

lemma (in normal) cancel_le: "(F x \<le> F y) = (x \<le> y)"
  by (rule strict_mono_cancel_le[OF strict])

lemma (in normal) oLimit: "F (oLimit f) = oLimit (\<lambda>n. F (f n))"
  by (rule cont)

lemma (in normal) increasing: "x \<le> F x"
proof (induction x rule: oLimit_induct)
  case zero
  then show ?case
    by simp
next
  case (suc x)
  then show ?case
    by (simp add: normal.strict_monoD normal_axioms oSuc_leI order.strict_trans1)
next
  case (lim f)
  then show ?case
    by (metis cont le_oLimitI oLimit_leI)
qed

lemma normalI:
  assumes lim: "\<And>f. strict_mono f \<Longrightarrow> F (oLimit f) = oLimit (\<lambda>n. F (f n))"
  assumes suc: "\<And>x. F x < F (oSuc x)"
  shows "normal F"
proof -
  have mono: "x \<le> y \<Longrightarrow> F x \<le> F y" for x y
    using continuousI assms
    by (metis continuous.monoD linorder_not_less ordinal_linear)
  then have "OrdinalInduct.strict_mono F"
    by (metis OrdinalInduct.strict_monoI leD oSuc_leI order_less_le suc)
  then show ?thesis
    by (meson continuousI leD lim nle_le normal.intro normal_axioms.intro suc)
qed

lemma normal_range_le:
  assumes nml: "normal F" "normal G" and "range G \<subseteq> range F"
  shows "F x \<le> G x"
proof (induction x rule: oLimit_induct)
  case zero
  with assms show ?case
    by (metis image_iff normal.monoD ordinal_0_le range_subsetD)
next
  case (suc x)
  then have "G (oSuc x) \<in> range F"
    using assms(3) by blast
  then show ?case
    by (smt (verit, ccfv_SIG) nml dual_order.trans leD le_oSucE less_oSuc normal.cancel_le ordinal_linear rangeE suc)
next
  case (lim f)
  then show ?case
    by (metis nml le_oLimitI normal.oLimit oLimit_leI)
qed

lemma normal_range_eq:
  "\<lbrakk>normal F; normal G; range F = range G\<rbrakk> \<Longrightarrow> F = G"
  by (force simp add: normal_range_le intro: order_antisym)

end


(* Title:      Demonic refinement algebra
   Author:     Alasdair Armstrong, Victor B. F. Gomes, Georg Struth
   Maintainer: Georg Struth <g.struth at sheffield.ac.uk>
*)

section \<open>Models for Demonic Refinement Algebra with Tests\<close>

theory DRA_Models
  imports DRAT
begin

text \<open>
  We formalise the predicate transformer model of demonic refinement algebra.
  Predicate transformers are formalised as strict and additive functions over a field of sets,
  or alternatively as costrict and multiplicative functions.
  In the future, this should be merged with Preoteasa's more abstract formalisation~\cite{Preoteasa11}.
\<close>

no_notation
  plus (infixl "+" 65) and
  less_eq  ("'(\<le>')") and
  less_eq  ("(_/ \<le> _)"  [51, 51] 50)

notation comp (infixl "\<cdot>" 55)

type_synonym 'a bfun = "'a set \<Rightarrow> 'a set"

text \<open>
  Definitions of signature:
\<close>

definition top :: "'a bfun" where "top \<equiv> \<lambda>x. UNIV"
definition bot :: "'a bfun" where "bot \<equiv> \<lambda>x. {}"
definition adjoint :: "'a bfun \<Rightarrow> 'a bfun" where "adjoint f \<equiv> (\<lambda>p. - f (-p))"

definition fun_inter :: "'a bfun \<Rightarrow> 'a bfun \<Rightarrow> 'a bfun" (infix "\<sqinter>" 51) where
  "f \<sqinter> g \<equiv> \<lambda>p. f p \<inter> g p"

definition fun_union :: "'a bfun \<Rightarrow> 'a bfun \<Rightarrow> 'a bfun" (infix "+" 52) where
  "f + g \<equiv> \<lambda>p. f p \<union> g p"

definition fun_order :: "'a bfun \<Rightarrow> 'a bfun \<Rightarrow> bool" (infix "\<le>" 50) where
  "f \<le> g \<equiv> \<forall>p. f p \<subseteq> g p"

definition fun_strict_order :: "'a bfun \<Rightarrow> 'a bfun \<Rightarrow> bool" (infix "<." 50) where
  "f <. g \<equiv> f \<le> g \<and> f \<noteq> g"

definition N :: "'a bfun \<Rightarrow> 'a bfun" where
  "N f \<equiv> ((adjoint f o bot) \<sqinter> id)"

lemma top_max: "f \<le> top"
  by (auto simp: top_def fun_order_def)

lemma bot_min: "bot \<le> f"
  by (auto simp: bot_def fun_order_def)

lemma oder_def: "f \<sqinter> g = f \<Longrightarrow> f \<le> g"
  by (metis fun_inter_def fun_order_def le_iff_inf)

lemma order_def_var: "f \<le> g \<Longrightarrow> f \<sqinter> g = f"
  by (auto simp: fun_inter_def fun_order_def)

lemma adjoint_idem [simp]: "adjoint (adjoint f) = f"
  by (auto simp: adjoint_def)

lemma adjoint_prop1[simp]: "(f o top) \<sqinter> (adjoint f o bot) = bot"
  by (auto simp: fun_inter_def adjoint_def bot_def top_def)

lemma adjoint_prop2[simp]: "(f o top) + (adjoint f o bot) = top"
  by (auto simp: fun_union_def adjoint_def bot_def top_def)

lemma adjoint_mult: "adjoint (f o g) = adjoint f o adjoint g"
  by (auto simp: adjoint_def)

lemma adjoint_top[simp]: "adjoint top = bot"
  by (auto simp: adjoint_def bot_def top_def)

lemma N_comp1: "(N (N f)) + N f = id"
  by (auto simp: fun_union_def N_def fun_inter_def adjoint_def bot_def)

lemma N_comp2: "(N (N f)) o N f = bot"
  by (auto simp: N_def fun_inter_def adjoint_def bot_def)

lemma N_comp3: "N f o (N (N f)) = bot"
  by (auto simp: N_def fun_inter_def adjoint_def bot_def)

lemma N_de_morgan: "N (N f) o N (N g) = N (N f) \<sqinter> N (N g)"
  by (auto simp: fun_union_def N_def fun_inter_def adjoint_def bot_def)

lemma conj_pred_aux [simp]: "(\<lambda>p. x p \<union> y p) = y \<Longrightarrow> \<forall>p. x p \<subseteq> y p"
  by (metis Un_upper1)

text \<open>
  Next, we define a type for conjuctive or multiplicative predicate transformers.
\<close>

typedef 'a bool_op = "{f::'a bfun. (\<forall>g h. mono f \<and> f \<circ> g + f \<circ> h = f \<circ> (g + h) \<and> bot o f = bot)}"
  apply (rule_tac x="\<lambda>x. x" in exI)
  apply auto
  apply (metis monoI)
  by (auto simp: fun_order_def fun_union_def)

setup_lifting type_definition_bool_op

text \<open>
  Conjuctive predicate transformers form a dioid with tests without right annihilator.
\<close>

instantiation bool_op :: (type) dioid_one_zerol
begin
  lift_definition less_eq_bool_op :: "'a bool_op \<Rightarrow> 'a bool_op \<Rightarrow> bool" is fun_order .

  lift_definition less_bool_op :: "'a bool_op \<Rightarrow> 'a bool_op \<Rightarrow> bool" is "(<.)" .

  lift_definition zero_bool_op :: "'a bool_op" is "bot"
    by (auto simp: bot_def fun_union_def fun_order_def mono_def)

  lift_definition one_bool_op :: "'a bool_op" is "id"
    by (auto simp: fun_union_def fun_order_def mono_def)

  lift_definition times_bool_op :: "'a bool_op \<Rightarrow> 'a bool_op \<Rightarrow> 'a bool_op" is "(o)"
    by (auto simp: o_def fun_union_def fun_order_def bot_def mono_def) metis

  lift_definition plus_bool_op :: "'a bool_op \<Rightarrow> 'a bool_op \<Rightarrow> 'a bool_op" is "(+)"
    apply (auto simp: o_def fun_union_def fun_order_def bot_def mono_def)
    apply (metis subsetD)
    apply (metis subsetD)
    apply (rule ext)
    by (metis (no_types, lifting) semilattice_sup_class.sup.assoc semilattice_sup_class.sup.left_commute)

  instance
    by standard (transfer, auto simp: fun_order_def fun_strict_order_def fun_union_def bot_def)+

end

instantiation bool_op :: (type) test_semiring_zerol
begin
  lift_definition n_op_bool_op :: "'a bool_op \<Rightarrow> 'a bool_op" is "N"
    by (auto simp: N_def fun_inter_def adjoint_def bot_def fun_union_def mono_def)

  instance
  apply standard
  apply (transfer, clarsimp simp add: N_def adjoint_def bot_def id_def comp_def fun_inter_def)
  apply (transfer, clarsimp simp add: N_def adjoint_def bot_def id_def comp_def fun_inter_def fun_union_def mono_def, blast)
  apply (transfer, clarsimp simp add: N_def adjoint_def bot_def comp_def mono_def fun_union_def fun_inter_def)
  by (transfer, clarsimp simp add: N_def adjoint_def bot_def comp_def mono_def fun_union_def fun_inter_def, blast)

end

definition fun_star :: "'a bfun \<Rightarrow> 'a bfun" where
  "fun_star f = lfp (\<lambda>r. f o r + id)"

definition fun_iteration :: "'a bfun \<Rightarrow> 'a bfun" where
  "fun_iteration f = gfp (\<lambda>g. f o g + id)"

text \<open>
  Verifying the iteration laws is left for future work. This could be obtained by integrating
  Preoteasa's approach~\cite{Preoteasa11}.
\<close>

end


theory Reg imports Main
begin

type_synonym vname = string
type_synonym val = int
type_synonym state = "vname \<Rightarrow> val"

datatype aexp =
  N val |
  V vname |
  Plus aexp aexp

fun aval :: "aexp \<Rightarrow> state \<Rightarrow> val" where
  "aval (N n) s = n" |
  "aval (V x) s = s x" |
  "aval (Plus a1 a2) s = aval a1 s + aval a2 s"

type_synonym reg = nat
type_synonym rstate = "reg \<Rightarrow> val"

datatype instr =
  LDI val reg |
  LD vname reg |
  ADD reg reg

fun exec1 :: "instr \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
  "exec1 ( LDI i r ) s rs = rs ( r := i )" |
  "exec1 ( LD  x r ) s rs = rs ( r := ( s x ) )" |
  "exec1 ( ADD r1 r2 ) s rs = rs ( r1 := ( rs r1 + rs r2 ) )"

fun exec :: "instr list \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
  "exec [] _ rs = rs" |
  "exec ( i # is ) s rs = exec is s ( exec1 i s rs )"

fun comp :: "aexp \<Rightarrow> reg \<Rightarrow> instr list" where
  "comp ( N i ) r = [ LDI i r ]" |
  "comp ( V x ) r = [ LD x r ]" |
  "comp ( Plus a1 a2 ) r =  comp a1 r  @  comp a2 ( r + 1 )  @  [ ADD r ( r + 1 ) ]"

lemma append_compose : "exec ( is1 @ is2 ) s rs = exec is2 s ( exec is1 s rs )"
  apply ( induction is1 arbitrary: is2 s rs)
  apply ( auto )
done

lemma immutable_lesser_states :
  "r2 > r1 \<Longrightarrow> exec ( comp a r2 ) s rs r1 = rs r1"

  apply ( induction a arbitrary: r2 rs )
  apply ( auto simp: append_compose )
done

lemma correctness : "exec ( comp a r ) s rs r = aval a s"
  apply ( induction a arbitrary: r s rs )
  apply ( auto simp: append_compose immutable_lesser_states )
done

datatype instr0 =
  LDI0 int |
  LD0 vname |
  MV0 reg |
  ADD0 reg

fun exec01 :: "instr0 \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
  "exec01 ( LDI0 i ) s rs = rs ( 0 := i )" |
  "exec01 ( LD0  x ) s rs = rs ( 0 := ( s x ) )" |
  "exec01 ( MV0 r ) s rs = rs ( r := ( rs 0 ) )" |
  "exec01 ( ADD0 r ) s rs = rs ( 0 := ( rs 0 + rs r ) )"

fun exec0 :: "instr0 list \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
  "exec0 [] _ rs = rs" |
  "exec0 ( i # is ) s rs = exec0 is s ( exec01 i s rs )"

fun comp0 :: "aexp \<Rightarrow> reg \<Rightarrow> instr0 list" where
  "comp0 ( N i ) r = [ LDI0 i , MV0 r ]" |
  "comp0 ( V x ) r = [ LD0 x , MV0 r ]" |
  "comp0 ( Plus a1 a2 ) r = comp0 a1 ( r + 1 ) @  comp0 a2 ( r + 2 )  @
                            [ LDI0 0 , ADD0 ( r + 1 ) , ADD0 ( r + 2 ) , MV0 r ]"

lemma exec0_append_compose : "exec0 ( is1 @ is2 ) s rs = exec0 is2 s ( exec0 is1 s rs )"
  apply ( induction is1 arbitrary: rs )
  apply ( auto )
done

lemma exec0_immutable_lesser_states :
  "( r2 > r1 \<and> r1 > 0 ) \<Longrightarrow> exec0 ( comp0 a r2 ) s rs r1 = rs r1"

  apply ( induction a arbitrary: r2 rs )
  apply ( auto simp: exec0_append_compose )
done

lemma "exec0 ( comp0 a r ) s rs r = exec0 ( comp0 a r ) s rs 0"
  apply ( induction a r rule: comp0.induct )
  apply ( auto simp: exec0_append_compose)
done

lemma exec0_correctness : "exec0 ( comp0 a r ) s rs r = aval a s"
  apply ( induction a arbitrary: r s rs )
  apply ( auto simp: exec0_append_compose exec0_immutable_lesser_states )
done

end