section \<open> Eric C.R. Hehner: "Probabilistic Predicative Programming" (PPP) \<close>

theory utp_prob_PPP
  imports
  "../utp_prob_des_laws"
begin recall_syntax

subsection \<open> State space \<close>
alphabet state =
  x :: "int"
  y :: "int"

subsection \<open> Definitions \<close>

abbreviation pchoice ("(pif (_)/ pthen (_)/ pelse (_)/ pfi)")
  where "pchoice b P Q \<equiv> P \<oplus>\<^bsub>b\<^esub> Q"

abbreviation pchoice_assign::"real \<Rightarrow> int \<Rightarrow> int \<Rightarrow> (state, state) rel_pdes"
where
"pchoice_assign r a b \<equiv> (\<K>(x :=\<^sub>D \<guillemotleft>a\<guillemotright>) \<oplus>\<^bsub>(r)\<^esub> \<K>(x :=\<^sub>D \<guillemotleft>b\<guillemotright>))"

abbreviation pchoice_assign' ::
    "real \<Rightarrow> (int, state) uexpr  \<Rightarrow> (int, state) uexpr \<Rightarrow> (state, state) rel_pdes"
where
"pchoice_assign' r a b \<equiv> (\<K>(x :=\<^sub>D a) \<oplus>\<^bsub>(r)\<^esub> \<K>(x :=\<^sub>D b))"

lemma pchoice_assign_simp:
  assumes "r \<in> {0..1}" "a \<noteq> b"
  shows "pchoice_assign r a b =
         (\<^U>(true) \<turnstile>\<^sub>n U($prob\<acute>($\<^bold>v\<lbrakk>\<guillemotleft>a\<guillemotright>/$x\<rbrakk>) = \<guillemotleft>r\<guillemotright> \<and> $prob\<acute>($\<^bold>v\<lbrakk>\<guillemotleft>b\<guillemotright>/$x\<rbrakk>) = \<guillemotleft>(1-r)\<guillemotright>))"
proof (cases "r = 0")
  case True
  have T: "r = 0"
    using True by simp
  show ?thesis
    apply (simp add: True prob_choice_zero)
    apply (simp add: pemp_assign)
    apply (rel_auto)
    using assms(2) pmf_not_the_one_is_zero by fastforce
next
  case False
  have F: "\<not> r = 0"
    using False by simp
  then show ?thesis
    proof (cases "r = 1")
      case True
      then show ?thesis
        apply (simp add: True prob_choice_zero)
        apply (simp add: pemp_assign)
        apply (rel_auto)
        using assms(2) pmf_not_the_one_is_zero by fastforce
    next
      case False
      then have "r \<in> {0<..<1}"
        using F assms(1) by auto
      then show ?thesis
        apply (simp add: pemp_assign prob_choice_r)
        apply (simp add: ndes_par)
        apply (rule ndesign_eq_intro)
        apply (simp)
        apply (rel_auto)
        apply (simp add: pmf_wplus pmf_not_the_one_is_zero)
        using assms(2) pmf_not_the_one_is_zero apply fastforce
        apply (simp add: pmf_wplus pmf_not_the_one_is_zero)
        using assms(2) pmf_not_the_one_is_zero apply fastforce
        apply (rule_tac ?x = "x\<^sub>v" in exI)
        apply (rule_tac ?x = "y\<^sub>v" in exI)
        apply (rule_tac x = "pmf_of_set {\<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr>}" in exI)
        apply (simp)
        apply (rule_tac x = "pmf_of_set {\<lparr>x\<^sub>v = b, y\<^sub>v = y\<^sub>v\<rparr>}" in exI)
        apply (simp)
        apply (subgoal_tac "\<forall>s. (pmf prob\<^sub>v s) =
             pmf (pmf_of_set {\<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr>} +\<^bsub>r\<^esub>
                  pmf_of_set {\<lparr>x\<^sub>v = b, y\<^sub>v = y\<^sub>v\<rparr>}) s")
        using pmf_eqI apply blast
        apply (auto)
        apply (simp add: pmf_wplus)
        apply (case_tac "s = \<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr>")
        using assms(2) apply auto[1]
        apply (case_tac "s = \<lparr>x\<^sub>v = b, y\<^sub>v = y\<^sub>v\<rparr>")
        using assms(2) apply auto[1]
        proof -
          fix y\<^sub>v::"int" and prob\<^sub>v::"state pmf" and s::"state"
          assume a1: "pmf prob\<^sub>v \<lparr>x\<^sub>v = b, y\<^sub>v = y\<^sub>v\<rparr> = (1::real) - pmf prob\<^sub>v \<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr>"
          assume a2: "r = pmf prob\<^sub>v \<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr>"
          assume a3: "\<not> s = \<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr>"
          assume a4: "\<not> s = \<lparr>x\<^sub>v = b, y\<^sub>v = y\<^sub>v\<rparr>"
          show "pmf prob\<^sub>v s =
           indicat_real {\<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr>} s \<cdot> pmf prob\<^sub>v \<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr> +
           indicat_real {\<lparr>x\<^sub>v = b, y\<^sub>v = y\<^sub>v\<rparr>} s \<cdot> ((1::real) - pmf prob\<^sub>v \<lparr>x\<^sub>v = a, y\<^sub>v = y\<^sub>v\<rparr>)"
            apply (subst pmf_not_in_the_two_is_zero[where a = "r" and
                sa="\<lparr>x\<^sub>v = (a), y\<^sub>v = y\<^sub>v\<rparr>" and
                sb="\<lparr>x\<^sub>v = (b), y\<^sub>v = y\<^sub>v\<rparr>"])
            using assms(1) apply simp
                apply simp
            using assms(2) apply simp
            using a2 apply simp
            using a1 apply simp
            using a2 apply simp
            apply (simp add: a3 a4)
            by (simp add: a3 a4)
        qed
    qed
qed

subsection \<open> Section 4 \<close>

lemma "U((x := x + 1) ;; ($x > 5)) = U($x > 4)"
  by (rel_auto)

lemma "U((x := x + 1) wp (&x > 5)) = U(&x > 4)"
  by (rel_auto)

subsection \<open> Section 6 \<close>
abbreviation P1 :: "(state, state) rel_pdes" where
  "P1 \<equiv> (pif 1/3 pthen \<K>(x :=\<^sub>D 0) pelse \<K>(x :=\<^sub>D 1) pfi)"

abbreviation P2 :: "(state, state) rel_pdes" where
  "P2 \<equiv> (pif 1/2 pthen \<K>(x :=\<^sub>D x + 2) pelse \<K>(x :=\<^sub>D x + 3) pfi)"

abbreviation P3 :: "(state, state) rel_pdes" where
  "P3 \<equiv> (pif 1/4 pthen \<K>(x :=\<^sub>D x + 4) pelse \<K>(x :=\<^sub>D x + 5) pfi)"

term "(pif 1/3 pthen \<K>(x :=\<^sub>D 0) pelse \<K>(x :=\<^sub>D 1) pfi)"

lemma P1_alt:
  "P1 = (\<^U>(true) \<turnstile>\<^sub>n U($prob\<acute>($\<^bold>v\<lbrakk>0/$x\<rbrakk>) = 1/3 \<and> $prob\<acute>($\<^bold>v\<lbrakk>1/$x\<rbrakk>) = 2/3))"
  apply (subgoal_tac "pchoice_assign (1/3) 0 1
    = (\<^U>(true) \<turnstile>\<^sub>n U($prob\<acute>($\<^bold>v\<lbrakk>0/$x\<rbrakk>) = 1/3 \<and> $prob\<acute>($\<^bold>v\<lbrakk>1/$x\<rbrakk>) = 2/3))")
  apply (subgoal_tac "P1 = pchoice_assign (1/3) 0 1")
  apply auto[1]
  apply (simp add: one_uexpr_def zero_uexpr_def)
  apply (subst pchoice_assign_simp[where r="1/3"])
  apply simp+
  by (rel_auto)

lemma P2_alt:
  "P2 = (\<^U>(true) \<turnstile>\<^sub>n U($prob\<acute>($\<^bold>v\<lbrakk>$x+2/$x\<rbrakk>) = 1/2 \<and> $prob\<acute>($\<^bold>v\<lbrakk>$x+3/$x\<rbrakk>) = 1/2))"
  apply (subgoal_tac "pchoice_assign' (1/2) (&x+2) (&x+3)
    = (\<^U>(true) \<turnstile>\<^sub>n U($prob\<acute>($\<^bold>v\<lbrakk>$x+2/$x\<rbrakk>) = 1/2 \<and> $prob\<acute>($\<^bold>v\<lbrakk>$x+3/$x\<rbrakk>) = 1/2))")
  apply (subgoal_tac "P2 = pchoice_assign' (1/2) (&x+2) (&x+3)")
  apply auto[1]
  apply (simp)
  apply (simp add: pemp_assign prob_choice_r)
  apply (simp add: ndes_par)
  apply (rule ndesign_eq_intro)
  apply (simp)
  apply (rel_auto)
  apply (simp add: pmf_wplus pmf_not_the_one_is_zero)+
  apply (rule_tac ?x = "x\<^sub>v" in exI)
  apply (rule_tac ?x = "y\<^sub>v" in exI)
  apply (rule_tac x = "pmf_of_set {\<lparr>x\<^sub>v = x\<^sub>v + (2::int), y\<^sub>v = y\<^sub>v\<rparr>}" in exI)
  apply (simp)
  apply (rule_tac x = "pmf_of_set {\<lparr>x\<^sub>v = x\<^sub>v + (3::int), y\<^sub>v = y\<^sub>v\<rparr>}" in exI)
  apply (simp)
  apply (rule pmf_eqI)
  apply (simp add: pmf_wplus)
  apply (case_tac "i = \<lparr>x\<^sub>v = x\<^sub>v + (2::int), y\<^sub>v = y\<^sub>v\<rparr>")
  apply auto[1]
  apply (case_tac "i = \<lparr>x\<^sub>v = x\<^sub>v + (3::int), y\<^sub>v = y\<^sub>v\<rparr>")
  apply auto[1]
  proof -
    fix x\<^sub>v::"int" and y\<^sub>v::"int" and prob\<^sub>v::"state pmf" and i::"state"
    assume a1: "pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (2::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real)"
    assume a2: "pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (3::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real)"
    assume a3: "\<not> i = \<lparr>x\<^sub>v = x\<^sub>v + (2::int), y\<^sub>v = y\<^sub>v\<rparr>"
    assume a4: "\<not> i = \<lparr>x\<^sub>v = x\<^sub>v + (3::int), y\<^sub>v = y\<^sub>v\<rparr>"
    show "pmf prob\<^sub>v i =
       indicat_real {\<lparr>x\<^sub>v = x\<^sub>v + (2::int), y\<^sub>v = y\<^sub>v\<rparr>} i / (2::real) +
       indicat_real {\<lparr>x\<^sub>v = x\<^sub>v + (3::int), y\<^sub>v = y\<^sub>v\<rparr>} i / (2::real)"
      apply (subst pmf_not_in_the_two_is_zero[where a = "1/2" and
          sa="\<lparr>x\<^sub>v = x\<^sub>v + (2::int), y\<^sub>v = y\<^sub>v\<rparr>" and
          sb="\<lparr>x\<^sub>v = x\<^sub>v + (3::int), y\<^sub>v = y\<^sub>v\<rparr>"])
      apply simp+
      using a1 apply simp
      using a2 apply simp
      apply (simp add: a3 a4)
      by (simp add: a3 a4)
  qed

lemma P3_alt:
  "P3 = (\<^U>(true) \<turnstile>\<^sub>n U($prob\<acute>($\<^bold>v\<lbrakk>$x+4/$x\<rbrakk>) = 1/4 \<and> $prob\<acute>($\<^bold>v\<lbrakk>$x+5/$x\<rbrakk>) = 3/4))"
  apply (subgoal_tac "pchoice_assign' (1/4) (&x+4) (&x+5)
    = (\<^U>(true) \<turnstile>\<^sub>n U($prob\<acute>($\<^bold>v\<lbrakk>$x+4/$x\<rbrakk>) = 1/4 \<and> $prob\<acute>($\<^bold>v\<lbrakk>$x+5/$x\<rbrakk>) = 3/4))")
  apply (subgoal_tac "P3 = pchoice_assign' (1/4) (&x+4) (&x+5)")
  apply auto[1]
  apply (simp)
  apply (simp add: pemp_assign prob_choice_r)
  apply (simp add: ndes_par)
  apply (rule ndesign_eq_intro)
  apply (simp)
  apply (rel_auto)
  apply (simp add: pmf_wplus pmf_not_the_one_is_zero)+
  apply (rule_tac ?x = "x\<^sub>v" in exI)
  apply (rule_tac ?x = "y\<^sub>v" in exI)
  apply (rule_tac x = "pmf_of_set {\<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr>}" in exI)
  apply (simp)
  apply (rule_tac x = "pmf_of_set {\<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr>}" in exI)
  apply (simp)
  apply (rule pmf_eqI)
  apply (simp add: pmf_wplus)
  apply (case_tac "i = \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr>")
  apply auto[1]
  apply (case_tac "i = \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr>")
  apply auto[1]
  proof -
    fix x\<^sub>v::"int" and y\<^sub>v::"int" and prob\<^sub>v::"state pmf" and i::"state"
    assume a1: "pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real)"
    assume a2: "pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real)"
    assume a3: "\<not> i = \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr>"
    assume a4: "\<not> i = \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr>"
    show "pmf prob\<^sub>v i =
       indicat_real {\<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr>} i / (4::real) +
       indicat_real {\<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr>} i \<cdot> (3::real) / (4::real)"
      apply (subst pmf_not_in_the_two_is_zero[where a = "1/4" and
          sa="\<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr>" and
          sb="\<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr>"])
      apply simp+
      using a1 apply simp
      using a2 apply simp
      apply (simp add: a3 a4)
      by (simp add: a3 a4)
  qed

lemma ex6_1: "
  (P1 ;;\<^sub>p (P2 \<triangleleft> U(x = 0) \<triangleright>\<^sub>D P3))
  = U(true \<turnstile>\<^sub>n (
    ($prob\<acute>($\<^bold>v\<lbrakk>2/$x\<rbrakk>) = 1/6 \<and>
     $prob\<acute>($\<^bold>v\<lbrakk>3/$x\<rbrakk>) = 1/6 \<and>
     $prob\<acute>($\<^bold>v\<lbrakk>5/$x\<rbrakk>) = 1/6 \<and>
     $prob\<acute>($\<^bold>v\<lbrakk>6/$x\<rbrakk>) = 1/2)))"
  apply (simp add: P1_alt P2_alt P3_alt)
  apply (simp add: kleisli_lift_alt_def kleisli_lift2'_def)
  apply (ndes_simp)
  apply (rule ndesign_eq_intro)
  apply (rel_simp)
  apply (metis (full_types) Collect_cong lit.rep_eq order_top_class.top.extremum_unique top1I
      top_set_def upred_ref_iff upred_set.rep_eq sum_pmf_eq_1)
  apply (rel_auto)
proof -
  fix y\<^sub>v::"int" and prob\<^sub>v::"state pmf" and prob\<^sub>v'::"state pmf" and x::"state \<Rightarrow> state pmf"
  let ?s1 = "\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>"
  let ?s2 = "\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>"
  assume a1: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (1::real)"
  assume a2: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (2::real)"
  assume a3: " \<forall>(x\<^sub>v::int) y\<^sub>v::int.
          (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
          (\<forall>prob\<^sub>v::state pmf.
              x\<^sub>v = (0::int) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
              \<not> x\<^sub>v = (0::int) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real) \<or>
              (\<exists>(x\<^sub>v'::int) y\<^sub>v'::int.
                  \<not> pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr> =
                     pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr>))"
  from a3 have a3': "\<forall>(x\<^sub>v::int) y\<^sub>v::int.
          (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
          (
              x\<^sub>v = (0::int) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
              \<not> x\<^sub>v = (0::int) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real))"
    by blast
  have a3'': "pmf (x ?s1) \<lparr>x\<^sub>v = (2::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf (x ?s1) \<lparr>x\<^sub>v = (3::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real)"
    using a3' a1 by force
  have a3''': "pmf (x ?s2) \<lparr>x\<^sub>v = (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf (x ?s2) \<lparr>x\<^sub>v = (6::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real)"
    using a3' a2 by smt
  have f1: "pmf (x ?s2) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> = 0"
    apply (subst pmf_not_in_the_two_is_zero[where a = "1/4" and
          sa="\<lparr>x\<^sub>v = (5::int), y\<^sub>v = y\<^sub>v\<rparr>" and
          sb="\<lparr>x\<^sub>v = (6::int), y\<^sub>v = y\<^sub>v\<rparr>"])
         apply (simp)+
    using a3''' by simp+
  have f2: "(\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>) =
    pmf prob\<^sub>v' ?s1 \<cdot> pmf (x ?s1) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> +
    pmf prob\<^sub>v' ?s2 \<cdot> pmf (x ?s2) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>"
    apply (subst infsetsum_two'[where xa="?s1" and xb="?s2"])
    apply simp
    using a1 a2 apply simp
    by (simp)
  have f3: "pmf prob\<^sub>v' ?s1 \<cdot> pmf (x ?s1) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> = 1/3 * 1/2"
    using a1 a3'' apply auto
    by (smt distrib_left mult_cancel_left1)
  have f4: "pmf prob\<^sub>v' ?s2 \<cdot> pmf (x ?s2) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> = pmf prob\<^sub>v' ?s2 \<cdot> 0"
    by (simp add: f1)
  show "(\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>) \<cdot> (6::real) = (1::real)"
    using f3 f4 f2 by simp
next
  fix y\<^sub>v::"int" and prob\<^sub>v::"state pmf" and prob\<^sub>v'::"state pmf" and x::"state \<Rightarrow> state pmf"
  let ?s1 = "\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>"
  let ?s2 = "\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>"
  assume a1: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (1::real)"
  assume a2: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (2::real)"
  assume a3: " \<forall>(x\<^sub>v::int) y\<^sub>v::int.
          (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
          (\<forall>prob\<^sub>v::state pmf.
              x\<^sub>v = (0::int) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
              \<not> x\<^sub>v = (0::int) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real) \<or>
              (\<exists>(x\<^sub>v'::int) y\<^sub>v'::int.
                  \<not> pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr> =
                     pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr>))"
  from a3 have a3': "\<forall>(x\<^sub>v::int) y\<^sub>v::int.
          (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
          (
              x\<^sub>v = (0::int) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
              \<not> x\<^sub>v = (0::int) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real))"
    by blast
  have a3'': "pmf (x ?s1) \<lparr>x\<^sub>v = (2::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf (x ?s1) \<lparr>x\<^sub>v = (3::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real)"
    using a3' a1 by force
  have a3''': "pmf (x ?s2) \<lparr>x\<^sub>v = (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf (x ?s2) \<lparr>x\<^sub>v = (6::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real)"
    using a3' a2 by smt
  have f1: "pmf (x ?s2) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> = 0"
    apply (subst pmf_not_in_the_two_is_zero[where a = "1/4" and
          sa="\<lparr>x\<^sub>v = (5::int), y\<^sub>v = y\<^sub>v\<rparr>" and
          sb="\<lparr>x\<^sub>v = (6::int), y\<^sub>v = y\<^sub>v\<rparr>"])
         apply (simp)+
    using a3''' by simp+
  have f2: "(\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>) =
    pmf prob\<^sub>v' ?s1 \<cdot> pmf (x ?s1) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> +
    pmf prob\<^sub>v' ?s2 \<cdot> pmf (x ?s2) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>"
    apply (subst infsetsum_two'[where xa="?s1" and xb="?s2"])
    apply simp
    using a1 a2 apply simp
    by (simp)
  have f3: "pmf prob\<^sub>v' ?s1 \<cdot> pmf (x ?s1) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> = 1/3 * 1/2"
    using a1 a3'' apply auto
    by (smt distrib_left mult_cancel_left1)
  have f4: "pmf prob\<^sub>v' ?s2 \<cdot> pmf (x ?s2) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> = pmf prob\<^sub>v' ?s2 \<cdot> 0"
    by (simp add: f1)
  show "(\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>) \<cdot> (6::real) = (1::real)"
    using f3 f4 f2 by simp
next
  fix y\<^sub>v::"int" and prob\<^sub>v::"state pmf" and prob\<^sub>v'::"state pmf" and x::"state \<Rightarrow> state pmf"
  let ?s1 = "\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>"
  let ?s2 = "\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>"
  assume a1: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (1::real)"
  assume a2: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (2::real)"
  assume a3: " \<forall>(x\<^sub>v::int) y\<^sub>v::int.
          (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
          (\<forall>prob\<^sub>v::state pmf.
              x\<^sub>v = (0::int) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
              \<not> x\<^sub>v = (0::int) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real) \<or>
              (\<exists>(x\<^sub>v'::int) y\<^sub>v'::int.
                  \<not> pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr> =
                     pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr>))"
  from a3 have a3': "\<forall>(x\<^sub>v::int) y\<^sub>v::int.
          (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
          (
              x\<^sub>v = (0::int) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
              \<not> x\<^sub>v = (0::int) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real))"
    by blast
  have a3'': "pmf (x ?s1) \<lparr>x\<^sub>v = (2::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf (x ?s1) \<lparr>x\<^sub>v = (3::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real)"
    using a3' a1 by force
  have a3''': "pmf (x ?s2) \<lparr>x\<^sub>v = (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf (x ?s2) \<lparr>x\<^sub>v = (6::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real)"
    using a3' a2 by smt
  have f1: "pmf (x ?s1) \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr> = 0"
    apply (subst pmf_not_in_the_two_is_zero[where a = "1/2" and
          sa="\<lparr>x\<^sub>v = (2::int), y\<^sub>v = y\<^sub>v\<rparr>" and
          sb="\<lparr>x\<^sub>v = (3::int), y\<^sub>v = y\<^sub>v\<rparr>"])
         apply (simp)+
    using a3'' by simp+
  have f2: "(\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>) =
    pmf prob\<^sub>v' ?s1 \<cdot> pmf (x ?s1) \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr> +
    pmf prob\<^sub>v' ?s2 \<cdot> pmf (x ?s2) \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>"
    apply (subst infsetsum_two'[where xa="?s1" and xb="?s2"])
    apply simp
    using a1 a2 apply simp
    by (simp)
  have f3: "pmf prob\<^sub>v' ?s1 \<cdot> pmf (x ?s1) \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr> = 1/3 * 0"
    by (simp add: f1)
  have f4: "pmf prob\<^sub>v' ?s2 \<cdot> pmf (x ?s2) \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr> = 2/3 \<cdot> 1/4"
    using a2 a3''' apply auto
    by (metis a2 mult.assoc mult.commute mult_2 numeral_Bit0)
  show "(\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>) \<cdot> (6::real) = (1::real)"
    using f3 f4 f2 by simp
next
  fix y\<^sub>v::"int" and prob\<^sub>v::"state pmf" and prob\<^sub>v'::"state pmf" and x::"state \<Rightarrow> state pmf"
  let ?s1 = "\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>"
  let ?s2 = "\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>"
  assume a1: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (1::real)"
  assume a2: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (2::real)"
  assume a3: " \<forall>(x\<^sub>v::int) y\<^sub>v::int.
          (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
          (\<forall>prob\<^sub>v::state pmf.
              x\<^sub>v = (0::int) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
              \<not> x\<^sub>v = (0::int) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real) \<or>
              (\<exists>(x\<^sub>v'::int) y\<^sub>v'::int.
                  \<not> pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr> =
                     pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr>))"
  from a3 have a3': "\<forall>(x\<^sub>v::int) y\<^sub>v::int.
          (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
          (
              x\<^sub>v = (0::int) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
              \<not> x\<^sub>v = (0::int) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real))"
    by blast
  have a3'': "pmf (x ?s1) \<lparr>x\<^sub>v = (2::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
              pmf (x ?s1) \<lparr>x\<^sub>v = (3::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real)"
    using a3' a1 by force
  have a3''': "pmf (x ?s2) \<lparr>x\<^sub>v = (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
              pmf (x ?s2) \<lparr>x\<^sub>v = (6::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real)"
    using a3' a2 by smt
  have f1: "pmf (x ?s1) \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr> = 0"
    apply (subst pmf_not_in_the_two_is_zero[where a = "1/2" and
          sa="\<lparr>x\<^sub>v = (2::int), y\<^sub>v = y\<^sub>v\<rparr>" and
          sb="\<lparr>x\<^sub>v = (3::int), y\<^sub>v = y\<^sub>v\<rparr>"])
         apply (simp)+
    using a3'' by simp+
  have f2: "(\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>) =
    pmf prob\<^sub>v' ?s1 \<cdot> pmf (x ?s1) \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr> +
    pmf prob\<^sub>v' ?s2 \<cdot> pmf (x ?s2) \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>"
    apply (subst infsetsum_two'[where xa="?s1" and xb="?s2"])
    apply simp
    using a1 a2 apply simp
    by (simp)
  have f3: "pmf prob\<^sub>v' ?s1 \<cdot> pmf (x ?s1) \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr> = 1/3 * 0"
    by (simp add: f1)
  have f4: "pmf prob\<^sub>v' ?s2 \<cdot> pmf (x ?s2) \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr> = 2/3 \<cdot> 3/4"
    using a2 a3''' apply auto
    proof -
      assume a1: "pmf (x \<lparr>x\<^sub>v = 1, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 5, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> 4 = 1"
      assume a2: "pmf (x \<lparr>x\<^sub>v = 1, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 6, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> 4 = 3"
      assume a3: "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 1, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> 3 = 2"
      have f4: "\<forall>n r. 2 \<cdot> ((r::real) \<cdot> numeral n) = r \<cdot> numeral (num.Bit0 n)"
        by simp
        have f5: "\<forall>r ra. 2 \<cdot> ((ra::real) \<cdot> (r \<cdot> 1)) = ra \<cdot> (r \<cdot> 2)"
          by linarith
        have "\<forall>r. (Numeral1::real) \<cdot> r = r"
          by simp
        then have "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 1, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (pmf (x \<lparr>x\<^sub>v = 1, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 6, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> 2) = 1"
        using f5 f4 a3 a2 a1 by (metis (full_types) mult.left_commute)
        then show "pmf prob\<^sub>v' \<lparr>x\<^sub>v = 1, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> pmf (x \<lparr>x\<^sub>v = 1, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = 6, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> 2 = 1"
          by linarith
      qed
  show "(\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>) \<cdot> (2::real) = (1::real)"
    using f3 f4 f2 by simp
next
  fix y\<^sub>v::"int" and prob\<^sub>v::"state pmf"
  assume a1: "pmf prob\<^sub>v \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (6::real) = (1::real)"
  assume a2: "pmf prob\<^sub>v \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (6::real) = (1::real)"
  assume a3: "pmf prob\<^sub>v \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (6::real) = (1::real)"
  assume a4: "pmf prob\<^sub>v \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real)"
  let ?prob' = "pmf_of_list [(\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>, 1/3),
            (\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>, 2/3)]"
  let ?x1 = "pmf_of_list [(\<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>, 1/2),
            (\<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>, 1/2)]"
  let ?x2 = "pmf_of_list [(\<lparr>x\<^sub>v = (5::int), y\<^sub>v = y\<^sub>v\<rparr>, 1/4),
            (\<lparr>x\<^sub>v = (6::int), y\<^sub>v = y\<^sub>v\<rparr>, 3/4)] "
  let ?x = "\<lambda>s. (if s = \<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr> then
      ?x1
      else (if s = \<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr> then
      ?x2
      else pmf_of_set {\<lparr>x\<^sub>v = 1::int, y\<^sub>v = 1::int\<rparr>}))"
  show "\<exists>prob\<^sub>v'::state pmf.
          pmf prob\<^sub>v' \<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (1::real) \<and>
          pmf prob\<^sub>v' \<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (3::real) = (2::real) \<and>
          (\<exists>x::state \<Rightarrow> state pmf.
              (\<forall>(x\<^sub>v::int) y\<^sub>v::int.
                  pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> =
                  (\<Sum>\<^sub>aa::state. pmf prob\<^sub>v' a \<cdot> pmf (x a) \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>)) \<and>
              (\<forall>(x\<^sub>v::int) y\<^sub>v::int.
                  (0::real) < pmf prob\<^sub>v' \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr> \<longrightarrow>
                  (\<forall>prob\<^sub>v::state pmf.
                      x\<^sub>v = (0::int) \<and>
                      pmf prob\<^sub>v \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<and>
                      pmf prob\<^sub>v \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (2::real) = (1::real) \<or>
                      \<not> x\<^sub>v = (0::int) \<and>
                      pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (1::real) \<and>
                      pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v\<rparr> \<cdot> (4::real) = (3::real) \<or>
                      (\<exists>(x\<^sub>v'::int) y\<^sub>v'::int.
                          \<not> pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr> =
                             pmf (x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v'\<rparr>))))"
    apply (rule_tac x = "?prob'" in exI)
    apply auto
    apply (subst pmf_pmf_of_list, simp add: pmf_of_list_wf_def, simp)
    apply (subst pmf_pmf_of_list, simp add: pmf_of_list_wf_def, simp)
    apply (rule_tac x = "?x" in exI)
    apply (rule conjI)
    apply (rule allI)+
  proof -
    fix x\<^sub>v::"int" and y\<^sub>v'::"int"
    have f1: "(\<Sum>\<^sub>aa::state.
          pmf (pmf_of_list
                [(\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>, (1::real) / (3::real)),
                 (\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>, (2::real) / (3::real))])
           a \<cdot>
          pmf (?x a) \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) =
      (1/3) * pmf (?x1) \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> +
      (2/3) * pmf (?x2) \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>"
      apply (subst infsetsum_two'[where xa="\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>" and xb="\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>"])
      apply simp
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (auto)
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      by (simp add: pmf_of_list_wf_def)+
    have f2: "... = pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>"
      apply (case_tac "x\<^sub>v = (2::int) \<and> y\<^sub>v' = y\<^sub>v")
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      using a1 apply simp
      apply (case_tac "x\<^sub>v = (3::int) \<and> y\<^sub>v' = y\<^sub>v")
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      using a2 apply simp
      apply (case_tac "x\<^sub>v = (5::int) \<and> y\<^sub>v' = y\<^sub>v")
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      using a3 apply simp
      apply (case_tac "x\<^sub>v = (6::int) \<and> y\<^sub>v' = y\<^sub>v")
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      using a4 apply simp
      apply (subgoal_tac "pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> = 0")
      apply (subgoal_tac "pmf ?x1 \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> = 0")
      apply (subgoal_tac "pmf ?x2 \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> = 0")
      apply simp
      apply (rule pmf_not_in_the_two_is_zero[where a="1/4" and
              sa="\<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>" and
              sb="\<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>"])
      apply simp+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (rule pmf_not_in_the_two_is_zero[where a="1/2" and
              sa="\<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>" and
              sb="\<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>"])
      apply simp+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (rule pmf_not_in_the_one_is_zero[where
            A = "{\<lparr>x\<^sub>v = 2, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 3, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 5, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 6, y\<^sub>v = y\<^sub>v\<rparr>}"])
      apply (subgoal_tac "infsetsum (pmf prob\<^sub>v)
        {\<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>}
        = infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>} + infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>}
        + infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>} + infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>}")
      using a1 a2 a3 a4 apply auto[1]
      apply (subgoal_tac "(infsetsum (pmf prob\<^sub>v)
        {\<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>}) =
        infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>} +
        infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>}")
      apply (subgoal_tac "infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>} =
        infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v\<rparr>} + infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v\<rparr>}")
      apply (subgoal_tac "infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>, \<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>} =
        infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 5::int, y\<^sub>v = y\<^sub>v\<rparr>} + infsetsum (pmf prob\<^sub>v) {\<lparr>x\<^sub>v = 6::int, y\<^sub>v = y\<^sub>v\<rparr>}")
      apply simp
      apply auto[1]
      apply auto[1]
      apply auto[1]
      by simp

    show "pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> =
       (\<Sum>\<^sub>aa::state.
          pmf (pmf_of_list
                [(\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>, (1::real) / (3::real)),
                 (\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>, (2::real) / (3::real))])
           a \<cdot>
          pmf (?x a) \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>)"
      using f1 f2 by linarith
  next
    have f0: "\<forall>x\<^sub>v.\<forall>y\<^sub>v'.(0::real) < pmf (pmf_of_list
               [(\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>, (1::real) / (3::real)),
                (\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>, (2::real) / (3::real))]) \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> \<longrightarrow>
      ((x\<^sub>v = (0::int) \<or> x\<^sub>v = (1::int)) \<and> y\<^sub>v'= y\<^sub>v)"
      apply (subst pmf_pmf_of_list)+
      by (simp add: pmf_of_list_wf_def)+
    have f1: "(\<forall>(x\<^sub>v::int) y\<^sub>v'::int.
       (0::real)
       < pmf (pmf_of_list
               [(\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>, (1::real) / (3::real)),
                (\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>, (2::real) / (3::real))])
          \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> \<longrightarrow>
       (
           x\<^sub>v = (0::int) \<and>
           pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (2::real) = (1::real) \<and>
           pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (2::real) = (1::real) \<or>
           \<not> x\<^sub>v = (0::int) \<and>
           pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (4::real) = (1::real) \<and>
           pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (4::real) = (3::real)))
      \<longrightarrow> (\<forall>(x\<^sub>v::int) y\<^sub>v'::int.
       (0::real)
       < pmf (pmf_of_list
               [(\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>, (1::real) / (3::real)),
                (\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>, (2::real) / (3::real))])
          \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> \<longrightarrow>
       (\<forall>prob\<^sub>v::state pmf.
           x\<^sub>v = (0::int) \<and>
           pmf prob\<^sub>v \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (2::real) = (1::real) \<and>
           pmf prob\<^sub>v \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (2::real) = (1::real) \<or>
           \<not> x\<^sub>v = (0::int) \<and>
           pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (4::real) = (1::real) \<and>
           pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (4::real) = (3::real) \<or>
           (\<exists>(x\<^sub>v'::int) y\<^sub>v''::int.
               \<not> pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v''\<rparr> =
                  pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v''\<rparr>)))
      "
      by metis
    have f2: "(\<forall>(x\<^sub>v::int) y\<^sub>v'::int.
       (0::real)
       < pmf (pmf_of_list
               [(\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>, (1::real) / (3::real)),
                (\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>, (2::real) / (3::real))])
          \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> \<longrightarrow>
       (
           x\<^sub>v = (0::int) \<and>
           pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (2::real) = (1::real) \<and>
           pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (2::real) = (1::real) \<or>
           \<not> x\<^sub>v = (0::int) \<and>
           pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (4::real) = (1::real) \<and>
           pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (4::real) = (3::real)))"
      apply (rule allI)+
      apply (auto)
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      apply (subst pmf_pmf_of_list)+
      apply (simp add: pmf_of_list_wf_def)+
      using f0 by blast+
    show "\<forall>(x\<^sub>v::int) y\<^sub>v'::int.
       (0::real)
       < pmf (pmf_of_list
               [(\<lparr>x\<^sub>v = 0::int, y\<^sub>v = y\<^sub>v\<rparr>, (1::real) / (3::real)),
                (\<lparr>x\<^sub>v = 1::int, y\<^sub>v = y\<^sub>v\<rparr>, (2::real) / (3::real))])
          \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr> \<longrightarrow>
       (\<forall>prob\<^sub>v::state pmf.
           x\<^sub>v = (0::int) \<and>
           pmf prob\<^sub>v \<lparr>x\<^sub>v = 2::int, y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (2::real) = (1::real) \<and>
           pmf prob\<^sub>v \<lparr>x\<^sub>v = 3::int, y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (2::real) = (1::real) \<or>
           \<not> x\<^sub>v = (0::int) \<and>
           pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (4::int), y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (4::real) = (1::real) \<and>
           pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v + (5::int), y\<^sub>v = y\<^sub>v'\<rparr> \<cdot> (4::real) = (3::real) \<or>
           (\<exists>(x\<^sub>v'::int) y\<^sub>v''::int.
               \<not> pmf prob\<^sub>v \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v''\<rparr> =
                  pmf (?x \<lparr>x\<^sub>v = x\<^sub>v, y\<^sub>v = y\<^sub>v'\<rparr>) \<lparr>x\<^sub>v = x\<^sub>v', y\<^sub>v = y\<^sub>v''\<rparr>))"
      by (metis f2)
  qed
qed

end


theory SeCaV_Propositional_Examples imports SeCaV begin

section \<open>Example 1\<close>

proposition \<open>p \<longrightarrow> p\<close> by metis

text \<open>
  Predicate numbers
    0 = p
  \<close>

lemma \<open>\<tturnstile>
  [
    Imp (Pre 0 []) (Pre 0 [])
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 []),
      Pre 0 []
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [],
      Neg (Pre 0 [])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

(*

Imp p p

AlphaImp
  Neg p
  p
Ext p
  Neg p
Basic

*)

section \<open>Example 2\<close>

proposition \<open>\<not> p \<longrightarrow> \<not> \<not> \<not> p\<close> by metis

text \<open>
  Predicate numbers
    0 = p
  \<close>

lemma \<open>\<tturnstile>
  [
    Imp (Neg (Pre 0 [])) (Neg (Neg (Neg (Pre 0 []))))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Neg (Pre 0 [])),
      Neg (Neg (Neg (Pre 0 [])))
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

(*

Imp (Neg p) (Neg (Neg (Neg p)))

AlphaImp
  Neg (Neg p)
  Neg (Neg (Neg p))
Basic

*)

section \<open>Example 3\<close>

proposition \<open>p \<and> q \<longrightarrow> r \<longrightarrow> p \<and> r\<close> by metis

text \<open>
  Predicate numbers
    0 = p
    1 = q
    2 = r
  \<close>

lemma \<open>\<tturnstile>
  [
    Imp (Con (Pre 0 []) (Pre 1 [])) (Imp (Pre 2 []) (Con (Pre 0 []) (Pre 2 [])))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Con (Pre 0 []) (Pre 1 [])),
      Imp (Pre 2 []) (Con (Pre 0 []) (Pre 2 []))
    ]
    \<close>
    using that by simp
  with AlphaCon have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 []),
      Neg (Pre 1 []),
      Imp (Pre 2 []) (Con (Pre 0 []) (Pre 2 []))
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Imp (Pre 2 []) (Con (Pre 0 []) (Pre 2 [])),
      Neg (Pre 0 [])
    ]
    \<close>
    using that by simp
  with AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 2 []),
      Con (Pre 0 []) (Pre 2 []),
      Neg (Pre 0 [])
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Con (Pre 0 []) (Pre 2 []),
      Neg (Pre 2 []),
      Neg (Pre 0 [])
    ]
    \<close>
    using that by simp
  with BetaCon have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [],
      Neg (Pre 2 []),
      Neg (Pre 0 [])
    ]
    \<close> and \<open>\<tturnstile>
    [
      Pre 2 [],
      Neg (Pre 2 []),
      Neg (Pre 0 [])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

(*

Imp (Con p q) (Imp r (Con p r))

AlphaImp
  Neg (Con p q)
  Imp r (Con p r)
AlphaCon
  Neg p
  Neg q
  Imp r (Con p r)
Ext
  Imp r (Con p r)
  Neg p
AlphaImp
  Neg r
  Con p r
  Neg p
Ext
  Con p r
  Neg r
  Neg p
BetaCon
  p
  Neg r
  Neg p
+
  r
  Neg r
  Neg p
Basic

*)

section \<open>Example 4\<close>

proposition \<open>p \<and> q \<longrightarrow> q \<and> p\<close> by metis

text \<open>
  Predicate numbers
    0 = p
    1 = q
  \<close>

lemma \<open>\<tturnstile>
  [
    Imp (Con (Pre 0 []) (Pre 1 [])) (Con (Pre 1 []) (Pre 0 []))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Con (Pre 0 []) (Pre 1 [])),
      Con (Pre 1 []) (Pre 0 [])
    ]
    \<close>
    using that by simp
  with AlphaCon have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 []),
      Neg (Pre 1 []),
      Con (Pre 1 []) (Pre 0 [])
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Con (Pre 1 []) (Pre 0 []),
      Neg (Pre 0 []),
      Neg (Pre 1 [])
    ]
    \<close>
    using that by simp
  with BetaCon have ?thesis if \<open>\<tturnstile>
    [
      Pre 1 [],
      Neg (Pre 0 []),
      Neg (Pre 1 [])
    ]
    \<close> and \<open>\<tturnstile>
    [
      Pre 0 [],
      Neg (Pre 0 []),
      Neg (Pre 1 [])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

(*

Imp (Con p q) (Con q p)

AlphaImp
  Neg (Con p q)
  Con q p
AlphaCon
  Neg p
  Neg q
  Con q p
Ext
  Con q p
  Neg p
  Neg q
BetaCon
  q
  Neg p
  Neg q
+
  p
  Neg p
  Neg q
Basic

*)

section \<open>Example 5\<close>

proposition \<open>p \<or> q \<longrightarrow> q \<or> p\<close> by metis

text \<open>
  Predicate numbers
    0 = p
    1 = q
  \<close>

lemma \<open>\<tturnstile>
  [
    Imp (Dis (Pre 0 []) (Pre 1 [])) (Dis (Pre 1 []) (Pre 0 []))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Dis (Pre 0 []) (Pre 1 [])),
      Dis (Pre 1 []) (Pre 0 [])
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Dis (Pre 1 []) (Pre 0 []),
      Neg (Dis (Pre 0 []) (Pre 1 []))
    ]
    \<close>
    using that by simp
  with AlphaDis have ?thesis if \<open>\<tturnstile>
    [
      Pre 1 [],
      Pre 0 [],
      Neg (Dis (Pre 0 []) (Pre 1 []))
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Neg (Dis (Pre 0 []) (Pre 1 [])),
      Pre 0 [],
      Pre 1 []
    ]
    \<close>
    using that by simp
  with BetaDis have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 []),
      Pre 0 [],
      Pre 1 []
    ]
    \<close> and \<open>\<tturnstile>
    [
      Neg (Pre 1 []),
      Pre 0 [],
      Pre 1 []
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [],
      Neg (Pre 0 [])
    ]
    \<close> and \<open>\<tturnstile>
    [
      Pre 1 [],
      Neg (Pre 1 [])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

(*

Imp (Dis p q) (Dis q p)

AlphaImp
  Neg (Dis p q)
  Dis q p
Ext
  Dis q p
  Neg (Dis p q)
AlphaDis
  q
  p
  Neg (Dis p q)
Ext
  Neg (Dis p q)
  p
  q
BetaDis
  Neg p
  p
  q
+
  Neg q
  p
  q
Ext
  p
  Neg p
+
  q
  Neg q
Basic

*)

end


section \<open>The Optimized Voting Model\<close>

theory Voting_Opt
imports Voting
begin

subsection \<open>Model definition\<close>
(*****************************************************************************)

record opt_v_state =
  next_round :: round
  last_vote :: "(process, val) map"
  decisions :: "(process, val)map"

definition flv_init where
  "flv_init = { \<lparr> next_round = 0, last_vote = Map.empty, decisions = Map.empty \<rparr> }"

context quorum_process begin

definition fmru_lv :: "(process, round \<times> val)map \<Rightarrow> (process set, round \<times> val)map" where
  "fmru_lv lvs Q = option_Max_by fst (ran (lvs |` Q))"

definition flv_guard :: "(process, round \<times> val)map \<Rightarrow> process set \<Rightarrow> val \<Rightarrow> bool" where
  "flv_guard lvs Q v \<equiv> Q \<in> Quorum \<and>
    (let alv = fmru_lv lvs Q in alv = None \<or> (\<exists>r. alv = Some (r, v)))"

definition opt_no_defection :: "opt_v_state \<Rightarrow> (process, val)map \<Rightarrow> bool" where
  opt_no_defection_def':
    "opt_no_defection s round_votes \<equiv>
    \<forall>v. \<forall>Q. quorum_for Q v (last_vote s) \<longrightarrow> round_votes ` Q \<subseteq> {None, Some v}"

lemma opt_no_defection_def:
  "opt_no_defection s round_votes =
    (\<forall>a Q v. quorum_for Q v (last_vote s) \<and> a \<in> Q \<longrightarrow> round_votes a \<in> {None, Some v})"
  apply(auto simp add: opt_no_defection_def')
  by (metis option.distinct(1) option.sel)

definition flv_round :: "round \<Rightarrow> (process, val)map \<Rightarrow>  (process, val)map \<Rightarrow> (opt_v_state \<times> opt_v_state) set" where
  "flv_round r r_votes r_decisions = {(s, s').
     \<comment> \<open>guards\<close>
     r = next_round s
     \<and> opt_no_defection s r_votes
     \<and> d_guard r_decisions r_votes
     \<and> \<comment> \<open>actions\<close>
     s' = s\<lparr>
       next_round := Suc r
       , last_vote := last_vote s ++ r_votes
       , decisions := (decisions s) ++ r_decisions
     \<rparr>
  }"

lemmas flv_evt_defs = flv_round_def flv_guard_def

definition flv_trans :: "(opt_v_state \<times> opt_v_state) set" where
  "flv_trans = (\<Union>r v_f d_f. flv_round r v_f d_f)"

definition flv_TS :: "opt_v_state TS" where
  "flv_TS = \<lparr> init = flv_init, trans = flv_trans \<rparr>"

lemmas flv_TS_defs = flv_TS_def flv_init_def flv_trans_def

subsection \<open>Refinement\<close>
(******************************************************************************)

definition flv_ref_rel :: "(v_state \<times> opt_v_state)set" where
  "flv_ref_rel = {(sa, sc).
    sc = \<lparr>
      next_round = v_state.next_round sa
      , last_vote = map_option snd o (process_mru (votes sa))
      , decisions = v_state.decisions sa
    \<rparr>
  }"

subsubsection \<open>Guard strengthening\<close>
(******************************************************************************)

lemma process_mru_Max:
  assumes
    inv: "sa \<in> Vinv1"
    and process_mru: "process_mru (votes sa) p = Some (r, v)"
  shows
    "votes sa r p = Some v \<and> (\<forall>r' > r. votes sa r' p = None)"
proof-
  from process_mru have not_empty: "vote_set (votes sa) {p} \<noteq> {}"
    by(auto simp add: process_mru_def mru_of_set_def option_Max_by_def)
  note Max_by_conds = Vinv1_finite_vote_set[OF inv] this
  from Max_by_dest[OF Max_by_conds, where f=fst]
  have
    r:
      "(r, v) = Max_by fst (vote_set (votes sa) {p})"
      "votes sa r p = Some v"
      using process_mru
      by(auto simp add: process_mru_def mru_of_set_def option_Max_by_def vote_set_def)
  have "\<forall>r' >r . votes sa r' p = None"
  proof(safe)
    fix r'
    assume less: "r < r'"
    hence "\<forall>v. (r', v) \<notin> vote_set (votes sa) {p}" using process_mru
      by(auto dest!: Max_by_ge[where f=fst, OF Vinv1_finite_vote_set[OF inv]]
        simp add: process_mru_def mru_of_set_def option_Max_by_def)
    thus "votes sa r' p = None"
      by(auto simp add: vote_set_def)
  qed
  thus ?thesis using r(2)
    by(auto)
qed

lemma opt_no_defection_imp_no_defection:
  assumes
    conc_guard: "opt_no_defection sc round_votes"
    and R: "(sa, sc) \<in> flv_ref_rel"
    and ainv: "sa \<in> Vinv1" "sa \<in> Vinv2"
  shows
    "no_defection sa round_votes r"
proof(unfold no_defection_def, safe)
  fix r' v a Q w
  assume
    r'_less: "r' < r"
    and a_votes_w: "round_votes a = Some w"
    and Q: "quorum_for Q v (votes sa r')"
    and a_in_Q: "a \<in> Q"
  have "Q \<in> Quorum" using Q
    by(auto simp add: quorum_for_def)
  hence "quorum_for Q v (last_vote sc)"
  proof(clarsimp simp add: quorum_for_def)
    fix q
    assume "q \<in> Q"
    with Q have q_r': "votes sa r' q = Some v"
      by(auto simp add: quorum_for_def)
    hence votes: "vote_set (votes sa) {q} \<noteq> {}"
      by(auto simp add: vote_set_def)
    then obtain w where w: "last_vote sc q = Some w" using R
      by(clarsimp simp add: flv_ref_rel_def process_mru_def mru_of_set_def
        option_Max_by_def)
    with R obtain r_max where "process_mru (votes sa) q = Some (r_max, w)"
      by(clarsimp simp add: flv_ref_rel_def)
    from process_mru_Max[OF ainv(1) this] q_r' have
      "votes sa r_max q = Some w"
      "r' \<le> r_max"
      using q_r'
      by(auto simp add: not_less[symmetric])
    thus "last_vote sc q = Some v" using ainv(2) Q \<open>q \<in> Q\<close>
      apply(case_tac "r_max = r'")
       apply(clarsimp simp add: w Vinv2_def no_defection_def q_r' dest: le_neq_implies_less)
      apply(fastforce simp add: w Vinv2_def no_defection_def q_r' dest!: le_neq_implies_less)
      done
  qed
  thus "round_votes a = Some v" using conc_guard a_in_Q a_votes_w r'_less
    by(fastforce simp add: opt_no_defection_def)
qed

subsubsection \<open>Action refinement\<close>
(******************************************************************************)

lemma act_ref:
  assumes
    inv: "s \<in> Vinv1"
  shows
    "map_option snd o (process_mru ((votes s)(v_state.next_round s := v_f)))
    = ((map_option snd o (process_mru (votes s))) ++ v_f)"
    by(auto simp add: process_mru_map_add[OF inv] map_add_def split: option.split)

subsubsection \<open>The complete refinement proof\<close>
(******************************************************************************)

lemma flv_round_refines:
  "{flv_ref_rel \<inter> (Vinv1 \<inter> Vinv2) \<times> UNIV}
    v_round r v_f  d_f, flv_round r v_f d_f
  {> flv_ref_rel}"
  by(auto simp add: PO_rhoare_defs flv_round_def v_round_def
    flv_ref_rel_def act_ref
    intro: opt_no_defection_imp_no_defection)

lemma Last_Voting_Refines:
  "PO_refines (flv_ref_rel \<inter> (Vinv1 \<inter> Vinv2) \<times> UNIV) v_TS flv_TS"
proof(rule refine_using_invariants)
  show "init flv_TS \<subseteq> flv_ref_rel `` init v_TS"
    by(auto simp add: flv_TS_defs v_TS_defs flv_ref_rel_def
      process_mru_def mru_of_set_def vote_set_def option_Max_by_def)
next
  show
    "{flv_ref_rel \<inter> (Vinv1 \<inter> Vinv2) \<times> UNIV} trans v_TS, trans flv_TS {> flv_ref_rel}"
    by(auto simp add: v_TS_defs flv_TS_defs intro!: flv_round_refines)
next
  show
    "{Vinv1 \<inter> Vinv2 \<inter> Domain (flv_ref_rel \<inter> UNIV \<times> UNIV)}
      trans v_TS
    {> Vinv1 \<inter> Vinv2}"
    using Vinv1_inductive(2) Vinv2_inductive(2)
    by blast
qed(auto intro!: Vinv1_inductive(1) Vinv2_inductive(1))

end

end


theory T180
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(x, join(y, z)) = join(undr(x, y), undr(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z)))
"
nitpick[card nat=7,timeout=86400]
oops
end


theory T121
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(x, join(y, z)) = join(undr(x, y), undr(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z)))
"
nitpick[card nat=8,timeout=86400]
oops
end


(* Property from Productive Use of Failure in Inductive Proof,
   Andrew Ireland and Alan Bundy, JAR 1996.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_prop_27
  imports "../../Test_Base"
begin

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

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

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

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

theorem property0 :
  "((rev y) = (qrev y (nil2)))"
  oops

end


theory Subdivision
imports
  Arc_Walk
  Digraph_Component
  Pair_Digraph
  Bidirected_Digraph
  Funpow
begin

section \<open>Subdivision on Digraphs\<close>

definition
  subdivision_step :: "('a, 'b) pre_digraph \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> ('a, 'b) pre_digraph \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> 'a \<times> 'a \<times> 'a \<Rightarrow> 'b \<times> 'b \<times> 'b \<Rightarrow> bool"
where
  "subdivision_step G rev_G H rev_H \<equiv> \<lambda>(u, v, w) (uv, uw, vw).
      bidirected_digraph G rev_G
    \<and> bidirected_digraph H rev_H
    \<and> perm_restrict rev_H (arcs G) = perm_restrict rev_G (arcs H)
    \<and> compatible G H

    \<and> verts H = verts G \<union> {w}
    \<and> w \<notin> verts G

    \<and> arcs H = {uw, rev_H uw, vw, rev_H vw} \<union> arcs G - {uv, rev_G uv}
    \<and> uv \<in> arcs G
    \<and> distinct [uw, rev_H uw, vw, rev_H vw]
    \<and> arc_to_ends G uv = (u,v)
    \<and> arc_to_ends H uw = (u,w)
    \<and> arc_to_ends H vw = (v,w)
  "

inductive subdivision :: "('a,'b) pre_digraph \<times> ('b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) pre_digraph \<times> ('b \<Rightarrow> 'b) \<Rightarrow> bool"
  for biG where
    base: "bidirected_digraph (fst biG) (snd biG) \<Longrightarrow> subdivision biG biG"
  | divide: "\<lbrakk>subdivision biG biI; subdivision_step (fst biI) (snd biI) (fst biH) (snd biH) (u,v,w) (uv,uw,vw)\<rbrakk> \<Longrightarrow> subdivision biG biH"

lemma subdivision_induct[case_names base divide, induct pred: subdivision]:
  assumes "subdivision (G, rev_G) (H, rev_H)"
    and "bidirected_digraph G rev_G \<Longrightarrow> P G rev_G"
    and "\<And>I rev_I H rev_H u v w uv uw vw.
            subdivision (G, rev_G) (I, rev_I) \<Longrightarrow> P I rev_I \<Longrightarrow> subdivision_step I rev_I H rev_H (u, v, w) (uv, uw, vw) \<Longrightarrow> P H rev_H"
  shows "P H rev_H"
  using assms(1) by (induct biH\<equiv>"(H, rev_H)" arbitrary: H rev_H) (auto intro: assms(2,3))

lemma subdivision_base:
  "bidirected_digraph G rev_G \<Longrightarrow> subdivision (G, rev_G) (G, rev_G)"
  by (rule subdivision.base) simp

lemma subdivision_step_rev:
  assumes "subdivision_step G rev_G H rev_H (u, v, w) (uv, uw, vw)" "subdivision (H, rev_H) (I, rev_I)"
  shows "subdivision (G, rev_G) (I, rev_I)"
proof -
  have "bidirected_digraph (fst (G, rev_G)) (snd (G, rev_G))" using assms by (auto simp: subdivision_step_def)
  with assms(2,1) show ?thesis
    using assms(2,1) by induct (auto intro: subdivision.intros dest: subdivision_base)
qed

lemma subdivision_trans:
  assumes "subdivision (G, rev_G) (H, rev_H)" "subdivision (H, rev_H) (I, rev_I)"
  shows "subdivision (G, rev_G) (I, rev_I)"
  using assms by induction (auto intro: subdivision_step_rev)

locale subdiv_step =
  fixes G rev_G H rev_H u v w uv uw vw
  assumes subdiv_step: "subdivision_step G rev_G H rev_H (u, v, w) (uv, uw, vw)"

sublocale subdiv_step \<subseteq> G: bidirected_digraph G rev_G
  using subdiv_step unfolding subdivision_step_def by simp
sublocale subdiv_step \<subseteq> H: bidirected_digraph H rev_H
  using subdiv_step unfolding subdivision_step_def by simp

context subdiv_step begin

  (*XXX*)
  abbreviation (input) "vu \<equiv> rev_G uv"
  abbreviation (input) "wu \<equiv> rev_H uw"
  abbreviation (input) "wv \<equiv> rev_H vw"

  lemma subdiv_compat: "compatible G H"
    using subdiv_step by (simp add: subdivision_step_def)

  lemma arc_to_ends_eq: "arc_to_ends H = arc_to_ends G"
    using subdiv_compat by (simp add: compatible_def arc_to_ends_def fun_eq_iff)

  lemma head_eq: "head H = head G"
    using subdiv_compat by (simp add: compatible_def fun_eq_iff)

  lemma tail_eq: "tail H = tail G"
    using subdiv_compat by (simp add: compatible_def fun_eq_iff)

  lemma verts_H: "verts H = verts G \<union> {w}"
    using subdiv_step by (simp add: subdivision_step_def)

  lemma verts_G: "verts G = verts H - {w}"
    using subdiv_step by (auto simp: subdivision_step_def)

  lemma arcs_H: "arcs H = {uw, wu, vw, wv} \<union> arcs G - {uv, vu}"
    using subdiv_step by (simp add: subdivision_step_def)

  lemma not_in_verts_G: "w \<notin> verts G"
    using subdiv_step by (simp add: subdivision_step_def)

  lemma in_arcs_G: "{uv, vu} \<subseteq> arcs G"
    using subdiv_step by (simp add: subdivision_step_def)

  lemma not_in_arcs_H: "{uv,vu} \<inter> arcs H = {}"
    using arcs_H by auto

  lemma subdiv_ate:
      "arc_to_ends G uv = (u,v)"
      "arc_to_ends H uv = (u,v)"
      "arc_to_ends H uw = (u,w)"
      "arc_to_ends H vw = (v,w)"
    using subdiv_step subdiv_compat by (auto simp: subdivision_step_def arc_to_ends_def compatible_def)

  lemma subdiv_ends[simp]:
    "tail G uv = u" "head G uv = v" "tail H uv = u" "head H uv = v"
    "tail H uw = u" "head H uw = w" "tail H vw = v" "head H vw = w"
    using subdiv_ate by (auto simp: arc_to_ends_def)

  lemma subdiv_ends_G_rev[simp]:
    "tail G (vu) = v" "head G (vu) = u" "tail H (vu) = v" "head H (vu) = u"
    using in_arcs_G by (auto simp: tail_eq head_eq)

  lemma subdiv_distinct_verts0: "u \<noteq> w" "v \<noteq> w"
      using in_arcs_G not_in_verts_G using subdiv_ate by (auto simp: arc_to_ends_def dest: G.wellformed)

  lemma in_arcs_H: "{uw, wu, vw, wv} \<subseteq> arcs H"
  proof -
    { assume "uv = uw"
      then have "arc_to_ends H uv = arc_to_ends H uw" by simp
      then have "v = w" by (simp add: arc_to_ends_def)
    } moreover
    { assume "uv = vw"
      then have "arc_to_ends H uv = arc_to_ends H vw" by simp
      then have "v = w" by (simp add: arc_to_ends_def)
    } moreover
    { assume "vu = uw"
      then have "arc_to_ends H (vu) = arc_to_ends H uw" by simp
      then have "u = w" by (simp add: arc_to_ends_def)
    } moreover
    { assume "vu = vw"
      then have "arc_to_ends H (vu) = arc_to_ends H vw" by simp
      then have "u = w" by (simp add: arc_to_ends_def)
    } ultimately
    have "{uw,vw} \<subseteq> arcs H" unfolding arcs_H using subdiv_distinct_verts0 by auto
    then show ?thesis by auto
  qed

  lemma subdiv_ends_H_rev[simp]:
    "tail H (wu) = w" "tail H (wv) = w"
    "head H (wu) = u" "head H (wv) = v"
    using in_arcs_H subdiv_ate by simp_all

  lemma in_verts_G: "{u,v} \<subseteq> verts G"
    using in_arcs_G by (auto dest: G.wellformed)

  lemma not_in_arcs_G: "{uw, wu, vw, wv} \<inter> arcs G = {}"
  proof -
    note X = G.wellformed[simplified tail_eq[symmetric] head_eq[symmetric]]
    show ?thesis using not_in_verts_G in_arcs_H by (auto dest: X )
  qed

  lemma subdiv_distinct_arcs: "distinct [uv, vu, uw, wu, vw, wv]"
  proof -
    have "distinct [uw, wu, vw, wv]"
      using subdiv_step by (simp add: subdivision_step_def)
    moreover
    have "distinct [uv, vu]" using in_arcs_G G.arev_dom by auto
    moreover
    have "{uv, vu} \<inter> {uw, wu, vw, wv} = {}"
      using arcs_H in_arcs_H by auto
    ultimately show ?thesis by auto
  qed

  lemma arcs_G: "arcs G = arcs H \<union> {uv, vu} - {uw, wu, vw, wv}"
    using in_arcs_G not_in_arcs_G unfolding arcs_H by auto

  lemma subdiv_ate_H_rev:
    "arc_to_ends H (wu) = (w,u)"
    "arc_to_ends H (wv) = (w,v)"
    using in_arcs_H subdiv_ate by simp_all

  lemma adj_with_w: "u \<rightarrow>\<^bsub>H\<^esub> w" "w \<rightarrow>\<^bsub>H\<^esub> u" "v \<rightarrow>\<^bsub>H\<^esub> w" "w \<rightarrow>\<^bsub>H\<^esub> v"
    using in_arcs_H subdiv_ate by (auto intro: H.dominatesI[rotated])

  lemma w_reach: "u \<rightarrow>\<^sup>*\<^bsub>H\<^esub> w" "w \<rightarrow>\<^sup>*\<^bsub>H\<^esub> u" "v \<rightarrow>\<^sup>*\<^bsub>H\<^esub> w" "w \<rightarrow>\<^sup>*\<^bsub>H\<^esub> v"
    using adj_with_w by auto

  lemma G_reach: "v \<rightarrow>\<^sup>*\<^bsub>G\<^esub> u" "u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v"
    using subdiv_ate in_arcs_G by (simp add: G.dominatesI G.symmetric_reachable')+

  lemma out_arcs_w: "out_arcs H w = {wu, wv}"
    using subdiv_distinct_verts0 in_arcs_H
    by (auto simp: arcs_H) (auto simp: tail_eq verts_G dest: G.tail_in_verts)

  lemma out_degree_w: "out_degree H w = 2"
    using subdiv_distinct_arcs by (auto simp: out_degree_def out_arcs_w card_insert_if)

end

lemma subdivision_compatible:
  assumes "subdivision (G, rev_G) (H, rev_H)" shows "compatible G H"
  using assms by induct (auto simp: compatible_def subdivision_step_def)

lemma subdivision_bidir:
  assumes "subdivision (G, rev_G) (H, rev_H)"
  shows "bidirected_digraph H rev_H"
  using assms by induct (auto simp: subdivision_step_def)

lemma subdivision_choose_rev:
  assumes "subdivision (G, rev_G) (H, rev_H)" "bidirected_digraph H rev_H'"
  shows "\<exists>rev_G'. subdivision (G, rev_G') (H, rev_H')"
  using assms
proof (induction arbitrary: rev_H')
  case base
  then show ?case by (auto dest: subdivision_base)
next
  case (divide I rev_I H rev_H u v w uv uw vw)

  interpret subdiv_step I rev_I H rev_H u v w uv uw vw using divide by unfold_locales
  interpret H': bidirected_digraph H rev_H' by fact

  define rev_I' where "rev_I' x =
    (if x = uv then rev_I uv else if x = rev_I uv then uv else if x \<in> arcs I then rev_H' x else x)"
    for x

  have rev_H_injD: "\<And>x y z. rev_H' x = z \<Longrightarrow> rev_H' y = z \<Longrightarrow> x \<noteq> y \<Longrightarrow> False"
    by (metis H'.arev_eq_iff)

  have rev_H'_simps: "rev_H' uw = rev_H uw \<and> rev_H' vw = rev_H vw
    \<or> rev_H' uw = rev_H vw \<and> rev_H' vw = rev_H uw"
  proof -
    have "arc_to_ends H (rev_H' uw) = (w,u)" "arc_to_ends H (rev_H' vw) = (w,v)"
      using in_arcs_H by (auto simp: subdiv_ate)
    moreover
    have "\<And>x. x \<in> arcs H \<Longrightarrow> tail H x = w \<Longrightarrow> x \<in> {rev_H uw, rev_H vw}"
      using subdiv_distinct_verts0 not_in_verts_G by (auto simp: arcs_H) (simp add: tail_eq)
    ultimately
    have "rev_H' uw \<in> {rev_H uw, rev_H vw}" "rev_H' vw \<in> {rev_H uw, rev_H vw}"
      using in_arcs_H by auto
    then show ?thesis using in_arcs_H by (auto dest: rev_H_injD)
  qed

  have rev_H_uv: "rev_H' uv = uv" "rev_H' (rev_I uv) = rev_I uv"
    using not_in_arcs_H by (auto simp: H'.arev_eq)

  have bd_I': "bidirected_digraph I rev_I'"
  proof
    fix a
    have "\<And>a. a \<noteq> uv \<Longrightarrow> a \<noteq> rev_I uv \<Longrightarrow> a \<in> arcs I \<Longrightarrow> a \<in> arcs H"
      by (auto simp: arcs_H)
    then show "(a \<in> arcs I) = (rev_I' a \<noteq> a)"
      using in_arcs_G by (auto simp: rev_I'_def dest: G.arev_neq H'.arev_neq)
  next
    fix a
    have *: "\<And>a. rev_H' a = rev_I uv \<longleftrightarrow> a = rev_I uv"
      by (metis H'.arev_arev H'.arev_dom insert_disjoint(1) not_in_arcs_H)
    have **: "\<And>a. uv = rev_H' a \<longleftrightarrow> a = uv" using H'.arev_eq not_in_arcs_H by force
    have ***: "\<And>a. a \<in> arcs I \<Longrightarrow> rev_H' a \<in> arcs I"
      using rev_H'_simps  by (case_tac "a \<in> {uv,vu}") (fastforce simp: rev_H_uv, auto simp: arcs_G dest: rev_H_injD)
    show "rev_I' (rev_I' a) = a"
      by (auto simp: rev_I'_def H'.arev_eq rev_H_uv * ** ***)
  next
    fix a assume "a \<in> arcs I"
    then show "tail I (rev_I' a) = head I a"
      using in_arcs_G by (auto simp: rev_I'_def tail_eq[symmetric] head_eq[symmetric] arcs_H)
  qed
  moreover
  have "\<And>x. rev_H' x = uv \<longleftrightarrow> x = uv" "\<And>x. rev_H' x = rev_I uv \<longleftrightarrow> x = rev_I uv"
    using not_in_arcs_H by (auto dest: H'.arev_eq) (metis H'.arev_arev H'.arev_eq)
  then have "perm_restrict rev_H' (arcs I) = perm_restrict rev_I' (arcs H)"
    using not_in_arcs_H by (auto simp: rev_I'_def perm_restrict_def H'.arev_eq)
  ultimately
  have sds_I'H': "subdivision_step I rev_I' H rev_H' (u, v, w) (uv, uw, vw)"
    using divide(2,4) rev_H'_simps unfolding subdivision_step_def
    by (fastforce simp:  rev_I'_def)
  then have "subdivision (I, rev_I') (H, rev_H')" "\<exists>rev_G'. subdivision (G, rev_G') (I, rev_I')"
    using bd_I' divide by (auto intro: subdivision.intros dest: subdivision_base)
  then show ?case by (blast intro: subdivision_trans)
qed

lemma subdivision_verts_subset:
  assumes "subdivision (G,rev_G) (H,rev_H)" "x \<in> verts G"
  shows "x \<in> verts H"
  using assms by induct (auto simp: subdiv_step.verts_H subdiv_step_def)

subsection \<open>Subdivision on Pair Digraphs\<close>

text \<open>
  In this section, we introduce specialized rules for pair digraphs.
\<close>

abbreviation "subdivision_pair G H \<equiv> subdivision (with_proj G, swap_in (parcs G)) (with_proj H, swap_in (parcs H))"

lemma arc_to_ends_with_proj[simp]: "arc_to_ends (with_proj G) = id"
  by (auto simp: arc_to_ends_def)

context
begin

  text \<open>
    We use the @{verbatim inductive} command to define an inductive definition pair graphs.
    This is proven to be equivalent to @{const subdivision}.
    This allows us to transfer the rules proven by @{verbatim inductive} to @{const subdivision}.
    To spare the user confusion, we hide this new constant.
  \<close>

  private inductive pair_sd :: "'a pair_pre_digraph \<Rightarrow> 'a pair_pre_digraph \<Rightarrow> bool"
    for G where
      base: "pair_bidirected_digraph G \<Longrightarrow> pair_sd G G"
    | divide: "\<And>e w H. \<lbrakk>e \<in> parcs H; w \<notin> pverts H; pair_sd G H\<rbrakk>
        \<Longrightarrow> pair_sd G (subdivide H e w)"

  private lemma bidirected_digraphI_pair_sd:
    assumes "pair_sd G H" shows "pair_bidirected_digraph H"
    using assms
  proof induct
    case base
    then show ?case by auto
  next
    case (divide e w H)
    interpret H: pair_bidirected_digraph H by fact
    from divide show ?case by (intro H.pair_bidirected_digraph_subdivide)
  qed

  private lemma subdivision_with_projI:
    assumes "pair_sd G H"
    shows "subdivision_pair G H"
    using assms
  proof induct
    case base
    then show ?case by (blast intro: pair_bidirected_digraph.bidirected_digraph subdivision_base)
  next
    case (divide e w H)

    obtain u v where "e = (u,v)" by (cases e)

    interpret H: pair_bidirected_digraph H
      using divide(3) by (rule bidirected_digraphI_pair_sd)
    interpret I: pair_bidirected_digraph "subdivide H e w"
      using divide(1,2) by (rule H.pair_bidirected_digraph_subdivide)

    have uvw: "u \<noteq> v" "u \<noteq> w" "v \<noteq> w"
      using divide by (auto simp: \<open>e = _\<close> dest: H.adj_not_same H.wellformed)

    have "subdivision (with_proj G, swap_in (parcs G)) (H, swap_in (parcs H))"
      using divide by auto
    moreover
    have *: "perm_restrict (swap_in (parcs (subdivide H e w))) (parcs H) = perm_restrict (swap_in (parcs H)) (parcs (subdivide H e w))"
      by (auto simp: perm_restrict_def fun_eq_iff swap_in_def)
    have "subdivision_step (with_proj H) (swap_in (arcs H)) (with_proj (subdivide H e w)) (swap_in (arcs (subdivide H e w)))
        (u, v, w) (e, (u,w), (v,w))"
      unfolding subdivision_step_def
      unfolding prod.simps with_proj_simps
      using divide uvw
      by (intro conjI H.bidirected_digraph I.bidirected_digraph *)
         (auto simp add: swap_in_def \<open>e = _\<close> compatibleI_with_proj)
    ultimately
    show ?case by (auto intro: subdivision.divide)
  qed

  private lemma subdivision_with_projD:
    assumes "subdivision_pair G H"
    shows "pair_sd G H"
    using assms
  proof (induct "with_proj H" "swap_in (parcs H)" arbitrary: H rule: subdivision_induct)
    case base
    interpret bidirected_digraph "with_proj G" "swap_in (parcs G)" by fact
    from base have "G = H" by (simp add: with_proj_def)
    with base show ?case
      by (auto intro: pair_sd.base pair_bidirected_digraphI_bidirected_digraph)
  next
    case (divide I rev_I u v w uv uw vw)
    define I' where "I' = \<lparr> pverts = verts I, parcs = arcs I \<rparr>"
    have "compatible G I " using \<open>subdivision (with_proj G, _) (I, _)\<close>
      by (rule subdivision_compatible)
    then have "tail I = fst" "head I = snd" by (auto simp: compatible_def)
    then have I: "I = I'" by (auto simp: I'_def)
    moreover
    from I have "rev_I = swap_in (parcs I')"
      using \<open>subdivision_step _ _ _ _ _ _\<close>
      by (simp add: subdivision_step_def bidirected_digraph_rev_conv_pair)
    ultimately
    have pd_sd: "pair_sd G I'" by (auto intro: divide.hyps)

    interpret sd: subdiv_step I' "swap_in (parcs I')" H "swap_in (parcs H)" u v w uv uw vw
      using \<open>subdivision_step _ _ _ _ _ _\<close> unfolding \<open>I = _\<close> \<open>rev_I = _\<close> by unfold_locales

    have ends: "uv = (u,v)" "uw = (u,w)" "vw = (v,w)"
      using sd.subdiv_ate by simp_all
    then have si_ends: "swap_in (parcs H) (u,w) = (w,u)" "swap_in (parcs H) (v,w) = (w,v)"
        "swap_in (parcs I') (u,v) = (v,u)"
      using sd.subdiv_ends_H_rev sd.subdiv_ends_G_rev by (auto simp: swap_in_def)

    have "parcs H = parcs I' - {(u, v), (v, u)} \<union> {(u, w), (w, u), (w, v), (v, w)}"
      using sd.in_arcs_G sd.not_in_arcs_G sd.arcs_H by (auto simp: si_ends ends)
    then have "H = subdivide I' uv w" using sd.verts_H by (simp add: ends subdivide.simps)
    then show ?case
      using sd.in_arcs_G sd.not_in_verts_G by (auto intro: pd_sd pair_sd.divide)
  qed

  private lemma subdivision_pair_conv:
    "pair_sd G H = subdivision_pair G H "
    by (metis subdivision_with_projD subdivision_with_projI)

  lemmas subdivision_pair_induct = pair_sd.induct[
      unfolded subdivision_pair_conv, case_names base divide, induct pred: pair_sd]

  lemmas subdivision_pair_base = pair_sd.base[unfolded subdivision_pair_conv]
  lemmas subdivision_pair_divide = pair_sd.divide[unfolded subdivision_pair_conv]

  lemmas subdivision_pair_intros = pair_sd.intros[unfolded subdivision_pair_conv]
  lemmas subdivision_pair_cases = pair_sd.cases[unfolded subdivision_pair_conv]

  lemmas subdivision_pair_simps = pair_sd.simps[unfolded subdivision_pair_conv]

  lemmas bidirected_digraphI_subdivision = bidirected_digraphI_pair_sd[unfolded subdivision_pair_conv]

end

lemma (in pair_graph) pair_graph_subdivision:
  assumes "subdivision_pair G H"
  shows "pair_graph H"
  using assms
by (induct rule: subdivision_pair_induct) (blast intro: pair_graph.pair_graph_subdivide divide)+

end