(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

(*
   Test proofs for corres methods. Builds on AInvs image.
*)

theory Corres_Test
imports "Refine.VSpace_R" "Lib.Corres_Method"
begin

chapter \<open>The Corres Method\<close>

section \<open>Introduction\<close>

text \<open>The @{method corres} method tries to do for corres-style refinement proofs what
@{method wp} did for hoare logic proofs. The intention is to automate the application
of corres calculational rules, so that the bulk of the manual proof is now handling
a verification condition. In general refinement proofs are difficult to automate, so here we
exploit the fact that in l4v the abstract and executable specifications tend to be structurally
similar. Corres proofs are based on the @{const corres_underlying} constant, which takes a number
of parameters that allow it to be specialized for different flavours of refinement.

A corres statement has the following form: @{term "corres_underlying sr nf nf' r P P' f f'"}, where
@{term sr} is a state-relation, @{term nf} and @{term nf'} refer to whether or not the left and
right hand functions may fail, @{term r} is a return value relation between the functions, @{term P}
and @{term P'} are preconditions for the functions @{term f} and @{term f'} respectively. Informally
the statement says that: under the given preconditions, for every execution of @{term f'} there exists
an execution of @{term f} that is related by the given state relation @{term sr} and return-value
relation @{term r}.

If the left and right side of a corres statement share similar structure, we can "unzip" the function
into one corres obligation for each atomic function. This is done through the application of
  @{thm corres_split}.
\<close>

thm corres_split[no_vars]

text \<open>Briefly this states that: given a corres goal proving refinement between @{term "a >>= b"} and
  @{term "c >>= d"}, we can decompose this into a proof showing refinement between @{term a} and
@{term c}, and between @{term a} and @{term c}. Additionally @{term a} and @{term c} must establish
appropriate postconditions to satisfy the obligations of proving refinement between @{term b} and @{term d}.

The first subgoal that is produced has an important characteristic: the preconditions for each
side may only discuss the return value of its respective side. This means that rules such as
@{term "corres_underlying sr nf nf' r (\<lambda>s. x = x') (\<lambda>_. True) (f x) (f' x')"} will not apply to a goal
 if @{term x} and @{term x'} are variables generated by applying @{thm corres_split} (i.e. the
return values of functions).

This means that any such conditions must instead be phrased as an assumption to the rule, and our rule must be
rephrased as follows:
  @{term "x = x' \<Longrightarrow> corres_underlying sr nf nf' r (\<lambda>_. True) (\<lambda>_. True) (f x) (f' x')"}.
The result is that we must solve @{term "x = x'"} immediately after applying our rule. While this
is not a major concern for a manual proof, it proves to be a significant obstacle if we're trying
to focus on automating the "corres" part of the refinement.
\<close>

section \<open>corres_underlyingK and corres_rv\<close>

text \<open>To remedy this situation, we augment the @{const corres_underlying} definition to include
yet another flag: a single boolean. This new constant: @{const corres_underlyingK},
will form the basis of the calculus for our corres method.\<close>

thm corres_underlyingK_def[no_vars]

text \<open>The boolean in @{const corres_underlyingK} can be thought of as a stateless precondition. It
is used to propagate additional proof obligations for rules that either do not need to discuss
either the left or right hand state, or must discuss bound variables from both sides.\<close>

thm corresK_split[no_vars]

text \<open>In this split rule for @{const corres_underlyingK} we see that the additional precondition @{term F'}
may discuss both @{term rv} and @{term rv'}. To show that this condition is satisified, however,
we can't use hoare logic and instead need a new definition: @{const corres_rv}.\<close>

thm corres_rv_def_I_know_what_I'm_doing[no_vars]

text \<open>This is a weaker form of @{const corres_underlying} that is only interested in the return value
of the functions. In essence, it states the given functions will establish @{term Q} after executing,
assuming the given return-value relation @{term r} holds, along with the given stateless precondition
@{term F} and left/right preconditions @{term P} and @{term P'}.

The assumption in general is that corres_rv rules should never be written, instead corres_rv obligations
should be propagated into either the stateless precondition (@{term F} from @{term corres_underlyingK}),
the left precondition (@{term P}) or the right precondition @{term P'}. This is implicitly handled
by @{method corres_rv} (called from @{method corres}) by applying one of the following rules to each conjunct:\<close>

thm corres_rv_defer
thm corres_rv_wp_left
thm corres_rv_wp_right

text \<open>If none of these rules can be safely applied, then @{method corres_rv} will leave the
  obligation untouched. The user can manually apply one of them if desired, but this is liable to
  create unsolvable proof obligations. In the worst case, the user may manually solve the goal in-place.\<close>

thm corres_rv_proveT[no_vars]

section \<open>The corres method\<close>

text \<open>The core algorithm of the corres method is simple:
  1) start by applying any necessary weakening rules to ensure the goal has schematic preconditions
  2) apply a known @{thm corres} or @{thm corresK} rule (see next section)
  3) if unsuccessful, apply a split rule (i.e. @{thm corresK_split}) and go to 2

Importantly, @{method corres} will not split a goal if it ultimately is not able to apply at least
one @{thm corres} or @{thm corresK} rule.
\<close>

subsection \<open>The corres and corresK named_theorems\<close>

text \<open>To address the fact that existing refinement rules are phrased as @{const corres_underlying}
and not @{const corres_underlyingK} there are two different named_theorems that are used for different
kind of rules @{thm corres} and @{thm corresK}. A @{thm corres} rule is understood to be phrased
with @{const corres_underlying} and may have additional assumptions. These assumptions will be
propagated through the additional @{term F} flag in @{const corres_underlyingK}, rather than presented
as proof obligations immediately. A @{thm corresK} rule is understood to be phrased with
@{const corres_underlyingK}, and is meant for calculational rules which may have proper assumptions that
should not be propagated.
\<close>
thm corresK
thm corres

subsection \<open>The corresc method\<close>

text \<open>Similar to @{method wpc}, @{method corresc} can handle case statements in @{const corres_underlyingK}
proof goals. Importantly, however, it is split into two sub-methods @{method corresc_left} and
@{method corresc_right}, which perform case-splitting on each side respectively. The combined method
@{method corresc}, however, attempts to discharge the contradictions that arise from the quadratic
blowup of a case analysis on both the left and right sides.\<close>

subsection \<open>corres_concrete_r, corres_concrete_rE\<close>

text \<open>Some @{thm corresK} rules should only be applied if certain variables are concrete
(i.e. not schematic) in the goal. These are classified separately with the named_theorems
@{thm corres_concrete_r} and @{thm corres_concrete_rER}. The first
indicates that the return value relation of the goal must be concrete, the second indicates that
only the left side of the error relation must be concrete.\<close>

thm corres_concrete_r
thm corres_concrete_rER

subsection \<open>The corres_search method\<close>

text \<open>The purpose of @{method corres_search} is to address cases where there is non-trivial control flow.
In particular: in the case where there is an "if" statement or either side needs to be symbolically
executed. The core idea is that corres_search should be provided with a "search" rule that acts
as an anchoring point. Symbolic execution and control flow is decomposed until either the given
rule is successfully applied or all search branches are exhausted.\<close>

subsubsection \<open>Symbolic Execution\<close>

text \<open>Symbolic execution is handled by two named theorems:
 @{thm corres_symb_exec_ls} and @{thm corres_symb_exec_rs}, which perform symbolic execution on
the left and right hand sides of a corres goal.\<close>

thm corres_symb_exec_ls
thm corres_symb_exec_rs

text \<open>A function may be symbolically executed if it does not modify the state, i.e. its only purpose
is to compute some value and return it. After being symbolically executed,
this value can only be discussed by the precondition of the associated side or the stateless
precondition of corresK. The resulting @{const corres_rv} goal has @{const corres_noop} as the
function on the alternate side. This gives @{method corres_rv} a hint that the resulting obligation
should be aggressively re-written into a hoare triple over @{term m} if it can't be propagated
back statelessly safely.
\<close>

section \<open>Demo\<close>

context begin interpretation Arch .

(* VSpace_R *)

lemmas load_hw_asid_corres_args[corres] =
  loadHWASID_corres[@lift_corres_args]

lemmas invalidate_asid_corres_args[corres] =
  invalidateASID_corres[@lift_corres_args]

lemmas invalidate_hw_asid_entry_corres_args[corres] =
  invalidateHWASIDEntry_corres[@lift_corres_args]

lemma invalidateASIDEntry_corres:
  "corres dc (valid_vspace_objs and valid_asid_map
                and K (asid \<le> mask asid_bits \<and> asid \<noteq> 0)
                and vspace_at_asid asid pd and valid_vs_lookup
                and unique_table_refs o caps_of_state
                and valid_global_objs and valid_arch_state
                and pspace_aligned and pspace_distinct)
             (pspace_aligned' and pspace_distinct' and no_0_obj')
             (invalidate_asid_entry asid) (invalidateASIDEntry asid)"
  apply (simp add: invalidate_asid_entry_def invalidateASIDEntry_def)
  apply_debug (trace) (* apply_trace between steps *)
   (tags "corres") (* break at breakpoints labelled "corres" *)
   corres (* weaken precondition *)
   continue (* split *)
   continue (* solve load_hw_asid *)
   continue (* split *)
   continue (* apply corres_when *)
   continue (* trivial simplification *)
   continue (* invalidate _hw_asid_entry *)
   finish (* invalidate_asid *)

  apply (corressimp wp: load_hw_asid_wp)+
  apply (fastforce simp: pd_at_asid_uniq)
  done

crunch typ_at'[wp]: invalidateASIDEntry, flushSpace "typ_at' T t"
crunch ksCurThread[wp]: invalidateASIDEntry, flushSpace "\<lambda>s. P (ksCurThread s)"
crunch obj_at'[wp]: invalidateASIDEntry, flushSpace "obj_at' P p"

lemmas flush_space_corres_args[corres] =
  flushSpace_corres[@lift_corres_args]

lemmas invalidate_asid_entry_corres_args[corres] =
  invalidateASIDEntry_corres[@lift_corres_args]

lemma corres_inst_eq_ext:
  "(\<And>x. corres_inst_eq (f x) (f' x)) \<Longrightarrow> corres_inst_eq f f'"
  by (auto simp add: corres_inst_eq_def)

lemma delete_asid_corresb:
  notes [corres] = corres_gets_asid getCurThread_corres setObject_ASIDPool_corres and
    [@lift_corres_args, corres] =  get_asid_pool_corres_inv'
    invalidateASIDEntry_corres
    setVMRoot_corres
  notes [wp] = set_asid_pool_asid_map_unmap set_asid_pool_vs_lookup_unmap'
    set_asid_pool_vspace_objs_unmap'
    invalidate_asid_entry_invalidates
    getASID_wp
  notes if_weak_cong[cong] option.case_cong_weak[cong]
  shows
    "corres dc
          (invs and valid_etcbs and K (asid \<le> mask asid_bits \<and> asid \<noteq> 0))
          (pspace_aligned' and pspace_distinct' and no_0_obj'
              and valid_arch_state' and cur_tcb')
          (delete_asid asid pd) (deleteASID asid pd)"
  apply (simp add: delete_asid_def deleteASID_def)
  apply_debug (trace) (* apply_trace between steps *)
    (tags "corres") (* break at breakpoints labelled "corres" *)
    corres (* weaken precondition *)
   continue (* split *)
       continue (* gets rule *)
      continue (* corresc *)
       continue (* return rule *)
      continue (* split *)
          continue (* function application *)
          continue (* liftM rule *)
          continue (* get_asid_pool_corres_inv' *)
         continue (* function application *)
         continue (* function application *)
         continue (* corresK_when *)
         continue (* split *)
             continue (* flushSpace_corres *)
            continue (* K_bind *)
            continue (* K_bind *)
            continue (* split *)
                continue (* invalidateASIDEntry_corres *)
               continue (* K_bind *)
               continue (* return bind *)
               continue (* K_bind *)
               continue (* split *)
                   continue (* backtracking *)
               continue (* split *)
                   continue (* function application *)
                   continue (* setObject_ASIDPool_corres *)
                  continue (* K_bind *)
                  continue (* K_bind *)
                  continue (* split *)
                      continue (* getCurThread_corres *)
                     continue (* setVMRoot_corres *)
                    finish (* backtracking? *)
                    apply (corressimp simp: mask_asid_low_bits_ucast_ucast
      | fold cur_tcb_def | wps)+
  apply (frule arm_asid_table_related,clarsimp)
  apply (rule conjI)
   apply (intro impI allI)
    apply (rule conjI)
     apply (safe; assumption?)
     apply (rule ext)
     apply (fastforce simp: inv_def dest: ucast_ucast_eq)
    apply (rule context_conjI)
    apply (fastforce simp: o_def dest: valid_asid_tableD invs_valid_asid_table)
   apply (intro allI impI)
   apply (subgoal_tac "vspace_at_asid asid pd s")
    prefer 2
    apply (simp add: vspace_at_asid_def)
    apply (rule vs_lookupI)
     apply (simp add: vs_asid_refs_def)
     apply (rule image_eqI[OF refl])
     apply (rule graph_ofI)
     apply fastforce
    apply (rule r_into_rtrancl)
    apply simp
    apply (rule vs_lookup1I [OF _ _ refl], assumption)
    apply (simp add: vs_refs_def)
    apply (rule image_eqI[rotated], erule graph_ofI)
    apply (simp add: mask_asid_low_bits_ucast_ucast)
   prefer 2
   apply (intro allI impI context_conjI; assumption?)
    apply (rule aligned_distinct_relation_asid_pool_atI'; fastforce?)
    apply (fastforce simp: o_def dest: valid_asid_tableD invs_valid_asid_table)
    apply (simp add: cur_tcb'_def)
    apply (safe; assumption?)
    apply (erule ko_at_weakenE)
    apply (clarsimp simp: graph_of_def)
    apply (fastforce split: if_split_asm)
   apply (frule invs_vspace_objs)
   apply (drule (2) valid_vspace_objsD)
   apply (erule ranE)
   apply (fastforce split: if_split_asm)
  apply (erule ko_at_weakenE)
  apply (clarsimp simp: graph_of_def)
  apply (fastforce split: if_split_asm)
  done

lemma cte_wp_at_ex:
  "cte_wp_at (\<lambda>_. True) p s \<Longrightarrow> (\<exists>cap. cte_wp_at ((=) cap) p s)"
  by (simp add: cte_wp_at_def)

(* Sadly broken:
lemma setVMRootForFlush_corres:
  notes [corres] = getCurThread_corres getSlotCap_corres
  shows
  "corres (=)
          (cur_tcb and vspace_at_asid asid pd
           and K (asid \<noteq> 0 \<and> asid \<le> mask asid_bits)
           and valid_asid_map and valid_vs_lookup
           and valid_vspace_objs and valid_global_objs
           and unique_table_refs o caps_of_state
           and valid_arch_state
           and pspace_aligned and pspace_distinct)
          (pspace_aligned' and pspace_distinct' and no_0_obj')
          (set_vm_root_for_flush pd asid)
          (setVMRootForFlush pd asid)"
  apply (simp add: set_vm_root_for_flush_def setVMRootForFlush_def getThreadVSpaceRoot_def locateSlot_conv)
  apply corres
         apply_debug (trace) (tags "corres_search") (corres_search search: armv_contextSwitch_corres)
  continue (* step left *)
  continue (* if rule *)
  continue (* failed corres on first subgoal, trying next *)
  continue (* fail corres on last subgoal, trying reverse if rule *)
  continue (* can't make corres progress here, trying other goal *)
  finish (* successful goal discharged by corres *)

  apply (corressimp wp: get_cap_wp getSlotCap_wp)+
  apply (rule context_conjI)
  subgoal by (simp add: cte_map_def objBits_simps tcb_cnode_index_def
                        tcbVTableSlot_def to_bl_1 cte_level_bits_def)
  apply (rule context_conjI)
  subgoal by (fastforce simp: cur_tcb_def intro!: tcb_at_cte_at_1[simplified])
  apply (rule conjI)
   subgoal by (fastforce simp: isCap_simps)
  apply (drule cte_wp_at_ex)
  apply clarsimp
  apply (drule (1) pspace_relation_cte_wp_at[rotated 1]; (assumption | clarsimp)?)
  apply (drule cte_wp_at_norm')
  apply clarsimp
  apply (rule_tac x="cteCap cte" in exI)
  apply (auto elim: cte_wp_at_weakenE' dest!: curthread_relation)
  done

text \<open>Note we can wrap it all up in corressimp\<close>

lemma setVMRootForFlush_corres':
  notes [corres] = getCurThread_corres getSlotCap_corres
  shows
  "corres (=)
          (cur_tcb and vspace_at_asid asid pd
           and K (asid \<noteq> 0 \<and> asid \<le> mask asid_bits)
           and valid_asid_map and valid_vs_lookup
           and valid_vspace_objs and valid_global_objs
           and unique_table_refs o caps_of_state
           and valid_arch_state
           and pspace_aligned and pspace_distinct)
          (pspace_aligned' and pspace_distinct' and no_0_obj')
          (set_vm_root_for_flush pd asid)
          (setVMRootForFlush pd asid)"
  apply (simp add: set_vm_root_for_flush_def setVMRootForFlush_def getThreadVSpaceRoot_def locateSlot_conv)
  apply (corressimp search: armv_contextSwitch_corres
                        wp: get_cap_wp getSlotCap_wp
                      simp: isCap_simps)
  apply (rule context_conjI)
  subgoal by (simp add: cte_map_def objBits_simps tcb_cnode_index_def
                        tcbVTableSlot_def to_bl_1 cte_level_bits_def)
  apply (rule context_conjI)
  subgoal by (fastforce simp: cur_tcb_def intro!: tcb_at_cte_at_1[simplified])
  apply (rule conjI)
   subgoal by (fastforce)
  apply (drule cte_wp_at_ex)
  apply clarsimp
  apply (drule (1) pspace_relation_cte_wp_at[rotated 1]; (assumption | clarsimp)?)
  apply (drule cte_wp_at_norm')
  apply clarsimp
  apply (rule_tac x="cteCap cte" in exI)
  apply (auto elim: cte_wp_at_weakenE' dest!: curthread_relation)
  done
*)

end
end


subsection\<open>\<open>\<Sigma>\<close>-OR statements\<close>

theory Sigma_OR imports
  Sigma_Protocols
  Xor
begin

locale \<Sigma>_OR_base = \<Sigma>0: \<Sigma>_protocols_base init0 response0 check0 Rel0 S0_raw \ss0 "carrier L" valid_pub0
  + \<Sigma>1: \<Sigma>_protocols_base init1 response1 check1 Rel1 S1_raw \ss1 "carrier L" valid_pub1
  for init1 :: "'pub1 \<Rightarrow> 'witness1 \<Rightarrow> ('rand1 \<times> 'msg1) spmf"
    and response1 :: "'rand1 \<Rightarrow> 'witness1 \<Rightarrow> 'bool  \<Rightarrow> 'response1 spmf"
    and check1 :: "'pub1 \<Rightarrow> 'msg1 \<Rightarrow> 'bool \<Rightarrow> 'response1 \<Rightarrow> bool"
    and Rel1 :: "('pub1 \<times> 'witness1) set"
    and S1_raw :: "'pub1 \<Rightarrow> 'bool \<Rightarrow> ('msg1 \<times> 'response1) spmf"
    and \ss1 :: "'pub1 \<Rightarrow> 'msg1 \<times> 'bool \<times> 'response1 \<Rightarrow> 'msg1 \<times> 'bool \<times> 'response1 \<Rightarrow> 'witness1 spmf"
    and challenge_space1 :: "'bool set"
    and valid_pub1 :: "'pub1 set"
    and init0 :: "'pub0 \<Rightarrow> 'witness0 \<Rightarrow> ('rand0 \<times> 'msg0) spmf"
    and response0 :: "'rand0 \<Rightarrow> 'witness0 \<Rightarrow> 'bool \<Rightarrow> 'response0 spmf"
    and check0 :: "'pub0 \<Rightarrow> 'msg0 \<Rightarrow> 'bool \<Rightarrow> 'response0 \<Rightarrow> bool"
    and Rel0 :: "('pub0 \<times> 'witness0) set"
    and S0_raw :: "'pub0 \<Rightarrow> 'bool \<Rightarrow> ('msg0 \<times> 'response0) spmf"
    and \ss0 :: "'pub0 \<Rightarrow> 'msg0 \<times> 'bool \<times> 'response0 \<Rightarrow> 'msg0 \<times> 'bool \<times> 'response0 \<Rightarrow> 'witness0 spmf"
    and challenge_space0 :: "'bool set"
    and valid_pub0 :: "'pub0 set"
    and G :: "(('pub0 \<times> 'pub1)  \<times> ('witness0 + 'witness1)) spmf"
    and L :: "'bool boolean_algebra" (structure)
    +
  assumes \<Sigma>_prot1: "\<Sigma>1.\<Sigma>_protocol"
    and \<Sigma>_prot0: "\<Sigma>0.\<Sigma>_protocol"
    and lossless_init: "lossless_spmf (init0 h0 w0)" "lossless_spmf (init1 h1 w1)"
    and lossless_response: "lossless_spmf (response0 r0 w0 e0)" "lossless_spmf (response1 r1 w1 e1)"
    and lossless_S: "lossless_spmf (S0 h0 e0)" "lossless_spmf (S1 h1 e1)"
    and finite_L: "finite (carrier L)"
    and carrier_L_not_empty: "carrier L \<noteq> {}"
    and lossless_G: "lossless_spmf G"
begin

inductive_set Rel_OR :: "(('pub0 \<times> 'pub1) \<times> ('witness0 + 'witness1)) set" where
  Rel_OR_I0: "((x0, x1), Inl w0) \<in> Rel_OR" if "(x0, w0) \<in> Rel0 \<and> x1 \<in> valid_pub1"
| Rel_OR_I1: "((x0, x1), Inr w1) \<in> Rel_OR" if "(x1, w1) \<in> Rel1 \<and> x0 \<in> valid_pub0"

inductive_simps Rel_OR_simps [simp]:
  "((x0, x1), Inl w0) \<in> Rel_OR"
  "((x0, x1), Inr w1) \<in> Rel_OR"

lemma Domain_Rel_cases:
  assumes "(x0,x1) \<in> Domain Rel_OR"
  shows "(\<exists> w0. (x0,w0) \<in> Rel0 \<and> x1 \<in> valid_pub1) \<or> (\<exists> w1. (x1,w1) \<in> Rel1 \<and> x0 \<in> valid_pub0)"
  using assms
  by (meson DomainE Rel_OR.cases)

lemma set_spmf_lists_sample [simp]: "set_spmf (spmf_of_set (carrier L)) = (carrier L)"
  using finite_L by simp

definition "challenge_space = carrier L"

fun init_OR :: "('pub0 \<times> 'pub1) \<Rightarrow> ('witness0 + 'witness1) \<Rightarrow> (((('rand0 \<times> 'bool \<times> 'response1 + 'rand1 \<times> 'bool \<times> 'response0)) \<times> 'msg0 \<times> 'msg1)) spmf"
  where "init_OR (x0,x1) (Inl w0) = do {
    (r0,a0) \<leftarrow> init0 x0 w0;
    e1 \<leftarrow> spmf_of_set (carrier L);
    (a1, e'1, z1) \<leftarrow> \<Sigma>1.S x1 e1;
    return_spmf (Inl (r0, e1, z1), a0, a1)}" |
    "init_OR (x0, x1) (Inr w1) = do {
    (r1, a1) \<leftarrow> init1 x1 w1;
    e0 \<leftarrow> spmf_of_set (carrier L);
    (a0, e'0, z0) \<leftarrow> \<Sigma>0.S x0 e0;
    return_spmf ((Inr (r1, e0, z0), a0, a1))}"

lemma lossless_\<Sigma>_S: "lossless_spmf (\<Sigma>1.S x1 e1)" "lossless_spmf (\<Sigma>0.S x0 e0)"
  using lossless_S by fast +

lemma lossless_init_OR: "lossless_spmf (init_OR (x0,x1) w)"
  by(cases w;simp add: lossless_\<Sigma>_S split_def lossless_init lossless_S finite_L carrier_L_not_empty)

fun response_OR :: "(('rand0 \<times> 'bool \<times> 'response1 + 'rand1 \<times> 'bool \<times> 'response0)) \<Rightarrow> ('witness0 + 'witness1)
                        \<Rightarrow> 'bool \<Rightarrow> (('bool \<times> 'response0) \<times> ('bool \<times> 'response1)) spmf"
  where "response_OR (Inl (r0 , e_1, z1)) (Inl w0) s = do {
    let e0 = s \<oplus> e_1;
    z0 \<leftarrow> response0 r0 w0 e0;
    return_spmf ((e0,z0),  (e_1,z1))}" |
    "response_OR  (Inr (r1, e_0, z0)) (Inr w1) s = do {
    let e1 = s \<oplus> e_0;
    z1 \<leftarrow> response1 r1 w1 e1;
    return_spmf ((e_0, z0), (e1, z1))}"

definition check_OR :: "('pub0 \<times> 'pub1) \<Rightarrow> ('msg0 \<times> 'msg1) \<Rightarrow> 'bool \<Rightarrow> (('bool \<times> 'response0) \<times> ('bool \<times> 'response1)) \<Rightarrow> bool"
  where "check_OR X A s Z
             = (s = (fst (fst Z)) \<oplus> (fst (snd Z))
                   \<and> (fst (fst Z)) \<in> challenge_space \<and> (fst (snd Z)) \<in> challenge_space
                      \<and> check0 (fst X) (fst A) (fst (fst Z)) (snd (fst Z)) \<and> check1 (snd X) (snd A) (fst (snd Z)) (snd (snd Z)))"

lemma  "check_OR (x0,x1) (a0,a1) s ((e0,z0), (e1,z1))
             = (s = e0 \<oplus> e1
                   \<and> e0 \<in> challenge_space \<and> e1 \<in> challenge_space
                      \<and> check0 x0 a0 e0 z0 \<and> check1 x1 a1 e1 z1)"
  by(simp add: check_OR_def)

fun S_OR where "S_OR (x0,x1) c = do {
    e1 \<leftarrow> spmf_of_set (carrier L);
    (a1, e1', z1) \<leftarrow> \<Sigma>1.S x1 e1;
    let e0 = c \<oplus> e1;
    (a0, e0', z0) \<leftarrow> \<Sigma>0.S x0 e0;
    let z = ((e0',z0), (e1',z1));
    return_spmf ((a0, a1),z)}"

definition \ss_OR' :: "'pub0 \<times> 'pub1 \<Rightarrow> ('msg0 \<times> 'msg1) \<times> 'bool \<times> ('bool \<times> 'response0) \<times> 'bool \<times> 'response1
                    \<Rightarrow> ('msg0 \<times> 'msg1) \<times> 'bool \<times> ('bool \<times> 'response0) \<times> 'bool \<times> 'response1 \<Rightarrow> ('witness0 + 'witness1) spmf"
  where "\ss_OR' X C1 C2 = TRY do {
    _ :: unit \<leftarrow> assert_spmf ((fst (fst  (snd (snd C1)))) \<noteq> (fst (fst (snd (snd C2)))));
    w0 :: 'witness0 \<leftarrow> \ss0 (fst X) (fst (fst C1),fst (fst (snd (snd C1))),snd (fst (snd (snd C1)))) (fst (fst C2),fst (fst (snd (snd C2))),snd (fst (snd (snd C2))));
    return_spmf ((Inl w0)) :: ('witness0 + 'witness1) spmf} ELSE do {
     w1 :: 'witness1 \<leftarrow> \ss1  (snd X) (snd (fst C1),fst (snd (snd (snd C1))), snd (snd (snd (snd C1)))) (snd (fst C2), fst (snd (snd (snd C2))), snd (snd (snd (snd C2))));
    (return_spmf ((Inr w1)) :: ('witness0 + 'witness1) spmf)}"

definition \ss_OR :: "'pub0 \<times> 'pub1 \<Rightarrow> ('msg0 \<times> 'msg1) \<times> 'bool \<times> ('bool \<times> 'response0) \<times> 'bool \<times> 'response1
                    \<Rightarrow> ('msg0 \<times> 'msg1) \<times> 'bool \<times> ('bool \<times> 'response0) \<times> 'bool \<times> 'response1 \<Rightarrow> ('witness0 + 'witness1) spmf"
  where "\ss_OR X C1 C2 = do {
    if ((fst (fst  (snd (snd C1)))) \<noteq> (fst (fst (snd (snd C2))))) then do
        {w0 :: 'witness0 \<leftarrow> \ss0 (fst X) (fst (fst C1),fst (fst (snd (snd C1))),snd (fst (snd (snd C1)))) (fst (fst C2),fst (fst (snd (snd C2))),snd (fst (snd (snd C2)))); return_spmf (Inl w0)}
    else
    do  {w1 :: 'witness1 \<leftarrow> \ss1  (snd X) (snd (fst C1),fst (snd (snd (snd C1))), snd (snd (snd (snd C1)))) (snd (fst C2), fst (snd (snd (snd C2))), snd (snd (snd (snd C2)))); return_spmf (Inr w1)}}"

lemma \ss_OR_alt_def: "\ss_OR (x0,x1) ((a0,a1),s,(e0,z0),e1,z1) ((a0,a1),s',(e0',z0'),e1',z1') = do {
    if (e0 \<noteq> e0') then do {w0 :: 'witness0 \<leftarrow> \ss0 x0 (a0,e0,z0) (a0,e0',z0'); return_spmf (Inl w0)}
    else do {w1 :: 'witness1 \<leftarrow> \ss1 x1 (a1,e1,z1) (a1,e1',z1'); return_spmf (Inr w1)}}"
  by(simp add: \ss_OR_def)

definition "valid_pub_OR = {(x0,x1). x0 \<in> valid_pub0 \<and> x1 \<in> valid_pub1}"

sublocale \<Sigma>_OR: \<Sigma>_protocols_base init_OR response_OR check_OR Rel_OR S_OR \ss_OR challenge_space valid_pub_OR
  unfolding \<Sigma>_protocols_base_def
proof(goal_cases)
  case 1
  then show ?case
  proof
    fix x
    assume asm: "x \<in> Domain Rel_OR"
    then obtain x0 x1 where x: "(x0,x1) = x"
      by (metis surj_pair)
    show "x \<in> valid_pub_OR"
    proof(cases "\<exists> w0. (x0,w0) \<in> Rel0 \<and> x1 \<in> valid_pub1")
      case True
      then show ?thesis
        using \<Sigma>0.domain_subset_valid_pub valid_pub_OR_def x by auto
    next
      case False
      hence "\<exists> w1. (x1,w1) \<in> Rel1 \<and> x0 \<in> valid_pub0"
        using Domain_Rel_cases asm x by auto
      then show ?thesis
        using \<Sigma>1.domain_subset_valid_pub valid_pub_OR_def x by auto
    qed
  qed
qed

end

locale \<Sigma>_OR_proofs = \<Sigma>_OR_base + boolean_algebra L +
  assumes G_Rel_OR: "((x0, x1), w) \<in> set_spmf G \<Longrightarrow> ((x0, x1), w) \<in> Rel_OR"
    and lossless_response_OR: "lossless_spmf (response_OR R W s)"
begin

lemma HVZK1:
  assumes "(x1,w1) \<in> Rel1"
  shows "\<forall> c \<in> challenge_space. \<Sigma>_OR.R (x0,x1) (Inr w1) c = \<Sigma>_OR.S (x0,x1) c"
  including monad_normalisation
proof
  fix c
  assume c: "c \<in> challenge_space"
  show "\<Sigma>_OR.R (x0,x1) (Inr w1) c = \<Sigma>_OR.S (x0,x1) c"
  proof-
    have *: "x \<in> carrier L \<longrightarrow> c \<oplus> c \<oplus> x = x" for x
      using c challenge_space_def by auto
    have "\<Sigma>_OR.R (x0,x1) (Inr w1) c = do {
    (r1, ab1) \<leftarrow> init1 x1 w1;
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 eb';
    let ((r, eb', zb'),a) = ((r1, eb', zb0' ),  ab0' , ab1);
    let eb = c \<oplus> eb';
    zb1 \<leftarrow> response1 r w1 eb;
    let z = ((eb', zb') , (eb, zb1));
    return_spmf (a,c,z)}"
      supply [[simproc del: monad_normalisation]]
      by(simp add: \<Sigma>_OR.R_def split_def Let_def)
    also have "... = do {
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 eb';
    let eb = c \<oplus> eb';
    (ab1, c', zb1) \<leftarrow> \<Sigma>1.R x1 w1 eb;
    let z = ((eb', zb0'), (eb, zb1));
    return_spmf ((ab0',ab1),c,z)}"
      by(simp add: \<Sigma>1.R_def split_def Let_def)
    also have "... = do {
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 eb';
    let eb = c \<oplus> eb';
    (ab1, c', zb1) \<leftarrow> \<Sigma>1.S x1 eb;
    let z = ((eb', zb0'), (eb, zb1));
    return_spmf ((ab0',ab1),c,z)}"
      using c
      by(simp add: split_def Let_def \<Sigma>_prot1 \<Sigma>1.HVZK_unfold1 assms challenge_space_def  cong: bind_spmf_cong_simp)
    also have "... = do {
    eb \<leftarrow> map_spmf (\<lambda> eb'. c \<oplus> eb') (spmf_of_set (carrier L));
    (ab1, c', zb1) \<leftarrow> \<Sigma>1.S x1 eb;
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 (c \<oplus> eb);
    let z = ((c \<oplus> eb, zb0'), (eb, zb1));
    return_spmf ((ab0',ab1),c,z)}"
      apply(simp add: bind_map_spmf o_def Let_def)
      by(simp add: * split_def cong: bind_spmf_cong_simp)
    also have "... = do {
    eb \<leftarrow> (spmf_of_set (carrier L));
    (ab1, c', zb1) \<leftarrow> \<Sigma>1.S x1 eb;
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 (c \<oplus> eb);
    let z = ((c \<oplus> eb, zb0'), (eb, zb1));
    return_spmf ((ab0',ab1),c,z)}"
      using assms assms one_time_pad c challenge_space_def by simp
    also have "... = do {
    eb \<leftarrow> (spmf_of_set (carrier L));
    (ab1, c', zb1) \<leftarrow> \<Sigma>1.S x1 eb;
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 (c \<oplus> eb);
    let z = ((eb0'', zb0'), (c', zb1));
    return_spmf ((ab0',ab1),c,z)}"
      by(simp add: \<Sigma>0.S_def \<Sigma>1.S_def bind_map_spmf o_def split_def)
    ultimately show ?thesis by(simp add: Let_def map_spmf_conv_bind_spmf \<Sigma>_OR.S_def split_def)
  qed
qed

lemma HVZK0:
  assumes "(x0,w0) \<in> Rel0"
  shows "\<forall> c \<in> challenge_space. \<Sigma>_OR.R (x0,x1) (Inl w0) c = \<Sigma>_OR.S (x0,x1) c"
proof
  fix c
  assume c: "c \<in> challenge_space"
  show "\<Sigma>_OR.R (x0,x1) (Inl w0) c = \<Sigma>_OR.S (x0,x1) c"
  proof-
    have "\<Sigma>_OR.R (x0,x1) (Inl w0) c = do {
    (r0,ab0) \<leftarrow> init0 x0 w0;
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab1', eb1'', zb1') \<leftarrow> \<Sigma>1.S x1 eb';
    let ((r, eb', zb'),a) = ((r0, eb', zb1'),  ab0,  ab1');
    let eb = c \<oplus> eb';
    zb0 \<leftarrow> response0 r w0 eb;
    let z = ((eb,zb0), (eb',zb'));
    return_spmf (a,c,z)}"
      by(simp add: \<Sigma>_OR.R_def split_def Let_def)
    also have "... = do {
    eb' \<leftarrow> (spmf_of_set (carrier L));
    (ab1', eb1'', zb1') \<leftarrow> \<Sigma>1.S x1 eb';
    let eb = c \<oplus> eb';
    (ab0, c', zb0) \<leftarrow> \<Sigma>0.R x0 w0 eb;
    let z = ((eb,zb0),  (eb',zb1'));
    return_spmf ((ab0,  ab1'),c,z)}"
      apply(simp add: \<Sigma>0.R_def split_def Let_def)
      apply(rewrite bind_commute_spmf)
      apply(rewrite bind_commute_spmf[of _ "\<Sigma>1.S _ _"])
      by simp
    also have "... = do {
    eb' \<leftarrow> (spmf_of_set (carrier L));
    (ab1', eb1'', zb1') \<leftarrow> \<Sigma>1.S x1 eb';
    let eb = c \<oplus> eb';
    (ab0, c', zb0) \<leftarrow> \<Sigma>0.S x0 eb;
    let z = ((eb,zb0), (eb',zb1'));
    return_spmf ((ab0,  ab1'),c,z)}"
      using c
      by(simp add: \<Sigma>_prot0 \<Sigma>0.HVZK_unfold1 assms challenge_space_def split_def Let_def cong: bind_spmf_cong_simp)
    ultimately show ?thesis
      by(simp add: \<Sigma>_OR.S_def \<Sigma>1.S_def \<Sigma>0.S_def Let_def o_def bind_map_spmf split_def map_spmf_conv_bind_spmf)
  qed
qed

lemma HVZK:
  shows "\<Sigma>_OR.HVZK"
  unfolding \<Sigma>_OR.HVZK_def
  apply auto
  subgoal for e a b w
    apply(cases w)
    using HVZK0 HVZK1 by auto
  apply(auto simp add: valid_pub_OR_def \<Sigma>_OR.S_def bind_map_spmf o_def check_OR_def image_def \<Sigma>0.S_def \<Sigma>1.S_def split_def challenge_space_def local.xor_ac(1))
  using \<Sigma>0.HVZK_unfold2 \<Sigma>_prot0 challenge_space_def apply force
  using \<Sigma>1.HVZK_unfold2 \<Sigma>_prot1 challenge_space_def by force

lemma assumes "(x0,x1) \<in> Domain Rel_OR"
  shows "(\<exists> w0. (x0,w0) \<in> Rel0) \<or> (\<exists> w1. (x1,w1) \<in> Rel1)"
  using assms Rel_OR.simps by blast

lemma ss:
  assumes valid_pub_OR: "(x0,x1) \<in> valid_pub_OR"
    and check: "check_OR (x0,x1) (a0,a1) s ((e0,z0), (e1,z1))"
    and check': "check_OR (x0,x1) (a0,a1) s' ((e0',z0'), (e1',z1'))"
    and "s \<noteq> s'"
    and challenge_space: "s \<in> challenge_space" "s' \<in> challenge_space"
  shows "lossless_spmf (\ss_OR (x0,x1) ((a0,a1),s,(e0,z0), e1,z1) ((a0,a1),s',(e0',z0'), e1',z1')) \<and>
           (\<forall>w'\<in>set_spmf (\ss_OR (x0,x1) ((a0,a1),s,(e0,z0), e1,z1) ((a0,a1),s',(e0',z0'), e1',z1')). ((x0,x1), w') \<in> Rel_OR)"
proof-
  have e_or: "e0 \<noteq> e0' \<or> e1 \<noteq> e1'" using assms check_OR_def by auto
  show ?thesis
  proof(cases "e0 \<noteq> e0'")
    case True
    moreover have 2: "x0 \<in> valid_pub0"
      using valid_pub_OR valid_pub_OR_def by simp
    moreover have 3: "check0 x0 a0 e0 z0"
      using assms check_OR_def by simp
    moreover have 4: "check0 x0 a0 e0' z0'"
      using assms check_OR_def by simp
    moreover have e: "e0 \<in> carrier L" "e0' \<in> carrier L"
      using challenge_space_def check check' check_OR_def by auto
    ultimately have "(\<forall>w'\<in>set_spmf (\ss0 x0 (a0,e0,z0) (a0,e0',z0')). (x0, w') \<in> Rel0)"
      using True \<Sigma>0.\<Sigma>_protocol_def \<Sigma>0.special_soundness_def \<Sigma>_prot0 challenge_space assms by blast
    moreover have  "lossless_spmf (\ss0 x0 (a0, e0, z0) (a0, e0', z0'))"
      using 2 3 4 \ss_OR_def True \<Sigma>_prot0  \<Sigma>0.\<Sigma>_protocol_def \<Sigma>0.special_soundness_def challenge_space_def e by blast
    ultimately have "\<forall> w' \<in> set_spmf (\ss_OR (x0,x1) ((a0,a1),s,(e0,z0), e1,z1) ((a0,a1),s',(e0',z0'), e1',z1')). ((x0,x1),  w') \<in> Rel_OR"
      apply(auto simp only: \ss_OR_alt_def True)
      apply(auto simp add: o_def \ss_OR_def)
      using assms valid_pub_OR_def by blast
    moreover have "lossless_spmf (\ss_OR (x0,x1) ((a0,a1),s,(e0,z0), e1,z1) ((a0,a1),s',(e0',z0'), e1',z1'))"
      apply(simp add: \ss_OR_def)
      using 2 3 4 True \<Sigma>_prot0  \<Sigma>0.\<Sigma>_protocol_def \<Sigma>0.special_soundness_def challenge_space e by blast
    ultimately show ?thesis by simp
  next
    case False
    hence e1_neq_e1': "e1 \<noteq> e1'" using e_or by simp
    moreover have 2: "x1 \<in> valid_pub1"
      using valid_pub_OR valid_pub_OR_def by simp
    moreover have 3: "check1 x1 a1 e1 z1"
      using assms check_OR_def by simp
    moreover have 4: "check1 x1 a1 e1' z1'"
      using assms check_OR_def by simp
    moreover have e: "e1 \<in> carrier L" "e1' \<in> carrier L"
      using challenge_space_def check check' check_OR_def by auto
    ultimately have "(\<forall>w'\<in>set_spmf (\ss1 x1 (a1,e1,z1) (a1,e1',z1')). (x1,w') \<in> Rel1)"
      using False \<Sigma>1.\<Sigma>_protocol_def \<Sigma>1.special_soundness_def \<Sigma>_prot1 e1_neq_e1' challenge_space by blast
    hence "\<forall>w' \<in> set_spmf (\ss_OR (x0,x1) ((a0,a1),s,(e0,z0), e1,z1) ((a0,a1),s',(e0',z0'), e1',z1')). ((x0,x1), w') \<in> Rel_OR"
      apply(auto simp add: o_def \ss_OR_def)
      using False assms \<Sigma>1.L_def assms valid_pub_OR_def by auto
    moreover have "lossless_spmf (\ss_OR (x0,x1) ((a0,a1),s,(e0,z0), e1,z1) ((a0,a1),s',(e0',z0'), e1',z1'))"
      apply(simp add: \ss_OR_def)
      using 2 3 4 \<Sigma>_prot1 \<Sigma>1.\<Sigma>_protocol_def \<Sigma>1.special_soundness_def False e1_neq_e1' challenge_space e by blast
    ultimately show ?thesis by simp
  qed
qed

lemma special_soundness:
  shows "\<Sigma>_OR.special_soundness"
  unfolding \<Sigma>_OR.special_soundness_def
  using ss prod.collapse by fastforce

lemma correct0:
  assumes e_in_carrier: "e \<in> carrier L"
    and "(x0,w0) \<in> Rel0"
    and valid_pub: "x1 \<in> valid_pub1"
  shows "\<Sigma>_OR.completeness_game (x0,x1) (Inl w0) e = return_spmf True"
    (is "?lhs = ?rhs")
proof-
  have "x \<in> carrier L \<longrightarrow> e = (e \<oplus> x) \<oplus> x" for x
    using e_in_carrier xor_assoc by simp
  hence "?lhs = do {
    (r0,ab0) \<leftarrow> init0 x0 w0;
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab1', eb1'', zb1') \<leftarrow> \<Sigma>1.S x1 eb';
    let eb = e \<oplus> eb';
    zb0 \<leftarrow> response0 r0 w0 eb;
    return_spmf ((check0 x0 ab0 eb zb0 \<and> check1 x1 ab1' eb' zb1'))}"
    by(simp add: \<Sigma>_OR.completeness_game_def split_def Let_def challenge_space_def assms check_OR_def cong: bind_spmf_cong_simp)
  also have "... = do {
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab1', eb1'', zb1') \<leftarrow> \<Sigma>1.S x1 eb';
    let eb = e \<oplus> eb';
    (r0,ab0) \<leftarrow> init0 x0 w0;
    zb0 \<leftarrow> response0 r0 w0 eb;
    return_spmf ((check0 x0 ab0 eb zb0 \<and> check1 x1 ab1' eb' zb1'))}"
    apply(simp add: Let_def split_def)
    apply(rewrite bind_commute_spmf)
    apply(rewrite bind_commute_spmf[of _ "\<Sigma>1.S _ _"])
    by simp
  also have "... = do {
    eb' :: 'e \<leftarrow> spmf_of_set (carrier L);
    (ab1', eb1'', zb1') \<leftarrow> \<Sigma>1.S x1 eb';
    return_spmf (check1 x1 ab1' eb' zb1')}"
    apply(simp add: Let_def)
    apply(intro bind_spmf_cong; clarsimp?)+
    subgoal for e' a e z
      apply(cases "check1 x1 a e' z")
      using \<Sigma>0.complete_game_return_true \<Sigma>_prot0 \<Sigma>0.completeness_game_def \<Sigma>0.\<Sigma>_protocol_def
      by(auto simp add: assms bind_spmf_const lossless_init lossless_response lossless_weight_spmfD split_def cong: bind_spmf_cong_simp)
    done
  also have "... = do {
    eb' :: 'e \<leftarrow> spmf_of_set (carrier L);
    (ab1', eb1'', zb1') \<leftarrow> \<Sigma>1.S x1 eb';
    return_spmf (True)}"
    apply(intro bind_spmf_cong; clarsimp?)
    subgoal for x a aa b
      using  \<Sigma>_prot1
      apply(auto simp add: \<Sigma>1.S_def split_def image_def \<Sigma>1.HVZK_unfold2_alt)
      using \<Sigma>1.S_def split_def image_def \<Sigma>1.HVZK_unfold2_alt \<Sigma>_prot1 valid_pub by blast
    done
  ultimately show ?thesis
    using \<Sigma>1.HVZK_unfold2_alt
    by(simp add: bind_spmf_const Let_def \<Sigma>1.HVZK_unfold2_alt split_def lossless_\<Sigma>_S lossless_weight_spmfD carrier_L_not_empty finite_L)
qed

lemma correct1:
  assumes rel1: "(x1,w1) \<in> Rel1"
    and valid_pub: "x0 \<in> valid_pub0"
    and e_in_carrier: "e \<in> carrier L"
  shows "\<Sigma>_OR.completeness_game (x0,x1) (Inr w1) e = return_spmf True"
    (is "?lhs = ?rhs")
proof-
  have x1_inL: "x1 \<in> \<Sigma>1.L"
    using \<Sigma>1.L_def rel1 by auto
  have "x \<in> carrier L \<longrightarrow> e = x \<oplus> e \<oplus> x" for x
    by (simp add: e_in_carrier xor_assoc xor_commute  local.xor_ac(3))
  hence "?lhs = do {
    (r1, ab1) \<leftarrow> init1 x1 w1;
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 eb';
    let eb = e \<oplus> eb';
    zb1 \<leftarrow> response1 r1 w1 eb;
    return_spmf (check0 x0 ab0' eb' zb0' \<and> check1 x1 ab1 eb zb1)}"
    by(simp add: \<Sigma>_OR.completeness_game_def split_def Let_def assms challenge_space_def check_OR_def cong: bind_spmf_cong_simp)
  also have "... = do {
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 eb';
    let eb = e \<oplus> eb';
    (r1, ab1) \<leftarrow> init1 x1 w1;
    zb1 \<leftarrow> response1 r1 w1 eb;
    return_spmf (check0 x0 ab0' eb' zb0' \<and> check1 x1 ab1 eb zb1)}"
    apply(simp add: Let_def split_def)
    apply(rewrite bind_commute_spmf)
    apply(rewrite bind_commute_spmf[of _ "\<Sigma>0.S _ _"])
    by simp
  also have "... = do {
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 eb';
    return_spmf (check0 x0 ab0' eb' zb0')}"
    apply(simp add: Let_def)
    apply(intro bind_spmf_cong; clarsimp?)+
    subgoal for e' a e z
      apply(cases "check0 x0 a e' z")
      using \<Sigma>1.complete_game_return_true \<Sigma>_prot1 \<Sigma>1.completeness_game_def \<Sigma>1.\<Sigma>_protocol_def
      by(auto simp add: x1_inL assms bind_spmf_const lossless_init lossless_response lossless_weight_spmfD split_def)
    done
  also have "... = do {
    eb' \<leftarrow> spmf_of_set (carrier L);
    (ab0', eb0'', zb0') \<leftarrow> \<Sigma>0.S x0 eb';
    return_spmf (True)}"
    apply(intro bind_spmf_cong; clarsimp?)
    subgoal for x a aa b
      using  \<Sigma>_prot0
      by(auto simp add: valid_pub valid_pub_OR_def \<Sigma>0.S_def split_def image_def \<Sigma>0.HVZK_unfold2_alt)
    done
  ultimately show ?thesis
    apply(simp add: \<Sigma>0.HVZK_unfold2 Let_def)
    using \<Sigma>0.complete_game_return_true \<Sigma>_OR.completeness_game_def
    by(simp add: bind_spmf_const split_def lossless_\<Sigma>_S(2) lossless_weight_spmfD Let_def carrier_L_not_empty finite_L)
qed

lemma completeness':
  assumes  Rel_OR_asm: "((x0,x1), w) \<in> Rel_OR"
  shows "\<forall> e \<in> carrier L. spmf (\<Sigma>_OR.completeness_game (x0,x1) w e) True = 1"
proof
  fix e
  assume asm: "e \<in> carrier L"
  hence "(\<Sigma>_OR.completeness_game (x0,x1) w e) = return_spmf True"
  proof(cases w)
    case inl: (Inl a)
    then show ?thesis
      using asm correct0 assms inl by auto
  next
    case inr: (Inr b)
    then show ?thesis
      using asm correct1 assms inr by auto
  qed
  thus "spmf (\<Sigma>_OR.completeness_game (x0,x1) w e) True = 1"
    by simp
qed

lemma completeness: shows "\<Sigma>_OR.completeness"
  unfolding \<Sigma>_OR.completeness_def
  using completeness' challenge_space_def by auto

lemma \<Sigma>_protocol: shows "\<Sigma>_OR.\<Sigma>_protocol"
 by(simp add: completeness HVZK special_soundness \<Sigma>_OR.\<Sigma>_protocol_def)

sublocale OR_\<Sigma>_commit: \<Sigma>_protocols_to_commitments init_OR response_OR check_OR Rel_OR S_OR \ss_OR challenge_space valid_pub_OR G
  by unfold_locales (auto simp add: \<Sigma>_protocol lossless_G lossless_init_OR G_Rel_OR lossless_response_OR)

lemma "OR_\<Sigma>_commit.abstract_com.correct"
  using OR_\<Sigma>_commit.commit_correct by simp

lemma "OR_\<Sigma>_commit.abstract_com.perfect_hiding_ind_cpa \"
  using OR_\<Sigma>_commit.perfect_hiding by blast

lemma bind_advantage_bound_dis_log:
  shows "OR_\<Sigma>_commit.abstract_com.bind_advantage \ \<le> OR_\<Sigma>_commit.rel_advantage (OR_\<Sigma>_commit.adversary \)"
  using OR_\<Sigma>_commit.bind_advantage by simp

end

end


section \<open>Accuracy without cutoff\label{sec:accuracy_wo_cutoff}\<close>

text \<open>This section verifies that each of the $l$ estimate have the required accuracy with high
probability assuming that there was no cut-off, i.e., that $s=0$. Section~\ref{sec:accuracy} will
then show that this remains true as long as the cut-off is below @{term "t f"} the subsampling
threshold.\<close>

theory Distributed_Distinct_Elements_Accuracy_Without_Cutoff
  imports
    Distributed_Distinct_Elements_Inner_Algorithm
    Distributed_Distinct_Elements_Balls_and_Bins
begin

no_notation Polynomials.var ("X\<index>")

locale inner_algorithm_fix_A = inner_algorithm +
  fixes A
  assumes A_range: "A \<subseteq> {..<n}"
  assumes A_nonempty: "{} \<noteq> A"
begin

definition X :: nat where "X = card A"

definition q_max where "q_max = nat (\<lceil>log 2 X\<rceil> - b_exp)"

definition t :: "(nat \<Rightarrow> nat) \<Rightarrow> int"
  where "t f = int (Max (f ` A)) - b_exp + 9"

definition s :: "(nat \<Rightarrow> nat) \<Rightarrow> nat"
  where "s f = nat (t f)"

definition R :: "(nat \<Rightarrow> nat) \<Rightarrow> nat set"
  where "R f = {a. a \<in> A \<and> f a \<ge> s f}"

definition r :: "nat \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> nat"
  where "r x f = card {a. a \<in> A \<and> f a \<ge> x}"

definition p where "p = (\<lambda>(f,g,h). card {j\<in> {..<b}. \<tau>\<^sub>1 (f,g,h) A 0 j \<ge> s f})"

definition Y where "Y = (\<lambda>(f,g,h). 2 ^ s f * \<rho>_inv (p (f,g,h)))"

lemma fin_A: "finite A"
  using A_range finite_nat_iff_bounded by auto

lemma X_le_n: "X \<le> n"
proof -
  have "card A \<le> card {..<n}"
    by (intro card_mono A_range) simp
  thus ?thesis
    unfolding X_def by simp
qed

lemma X_ge_1: "X \<ge> 1"
  unfolding X_def
  using fin_A A_nonempty by (simp add: leI)

lemma of_bool_square: "(of_bool x)\<^sup>2 = ((of_bool x)::real)"
  by (cases x, auto)

lemma r_eq: "r x f = (\<Sum> a \<in> A.( of_bool( x \<le> f a) :: real))"
  unfolding r_def of_bool_def sum.If_cases[OF fin_A]
  by (simp add: Collect_conj_eq)

lemma
  shows
    r_exp: "(\<integral>\<omega>. real (r x \<omega>) \<partial> \<Psi>\<^sub>1) = real X * (of_bool (x \<le> max (nat \<lceil>log 2 n\<rceil>) 1) / 2^x)" and
    r_var: "measure_pmf.variance \<Psi>\<^sub>1 (\<lambda>\<omega>. real (r x \<omega>)) \<le> (\<integral>\<omega>. real (r x \<omega>) \<partial> \<Psi>\<^sub>1)"
proof -
  define V :: "nat \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> real" where "V = (\<lambda>a f. of_bool (x \<le> f a))"

  have V_exp: "(\<integral>\<omega>. V a \<omega> \<partial>\<Psi>\<^sub>1) = of_bool (x \<le> max (nat \<lceil>log 2 n\<rceil>) 1)/2^x"
    (is "?L = ?R") if "a \<in> A" for a
  proof -
    have a_le_n: "a < n"
      using that A_range by auto

    have "?L = (\<integral>\<omega>. indicator {f. x \<le> f a} \<omega> \<partial> \<Psi>\<^sub>1)"
      unfolding V_def by (intro integral_cong_AE) auto
    also have "... = measure (map_pmf (\<lambda>\<omega>. \<omega> a) (sample_pmf \<Psi>\<^sub>1)) {f. x \<le> f}"
      by simp
    also have "... = measure (\<G> n_exp) {f. x \<le> f}"
      unfolding \<Psi>\<^sub>1.single[OF a_le_n] by simp
    also have "... = of_bool (x \<le> max (nat \<lceil>log 2 n\<rceil>) 1)/2^x"
      unfolding \<G>_prob n_exp_def by simp
    finally show ?thesis by simp
  qed

  have b:"(\<integral>\<omega>. real (r x \<omega>) \<partial> \<Psi>\<^sub>1) = (\<Sum> a \<in> A. (\<integral>\<omega>. V a \<omega> \<partial>\<Psi>\<^sub>1))"
    unfolding r_eq V_def  using \<Psi>\<^sub>1.sample_space
    by (intro Bochner_Integration.integral_sum) auto
  also have "... = (\<Sum> a \<in> A.  of_bool (x \<le> max (nat \<lceil>log 2 n\<rceil>) 1)/2^x)"
    using V_exp by (intro sum.cong) auto
  also have "... = X * (of_bool (x \<le> max (nat \<lceil>log 2 n\<rceil>) 1) / 2^x)"
    using X_def by simp
  finally show "(\<integral>\<omega>. real (r x \<omega>) \<partial> \<Psi>\<^sub>1) = real X * (of_bool (x \<le> max (nat \<lceil>log 2 n\<rceil>) 1)/ 2^x)"
    by simp

  have "(\<integral>\<omega>. (V a \<omega>)^2 \<partial> \<Psi>\<^sub>1) = (\<integral>\<omega>. V a \<omega> \<partial> \<Psi>\<^sub>1)" for a
    unfolding V_def of_bool_square by simp

  hence a:"measure_pmf.variance \<Psi>\<^sub>1 (V a) \<le> measure_pmf.expectation \<Psi>\<^sub>1 (V a)"  for a
    using \<Psi>\<^sub>1.sample_space by (subst measure_pmf.variance_eq) auto

  have "J \<subseteq> A \<Longrightarrow> card J = 2 \<Longrightarrow> prob_space.indep_vars \<Psi>\<^sub>1 (\<lambda>_. borel) V J" for J
    unfolding V_def using A_range finite_subset[OF _ fin_A]
    by (intro prob_space.indep_vars_compose2[where Y="\<lambda>i y. of_bool(x \<le> y)" and M'="\<lambda>_. discrete"]
        prob_space.k_wise_indep_vars_subset[OF _ \<Psi>\<^sub>1.\<H>_indep]) (auto simp:prob_space_measure_pmf)
  hence "measure_pmf.variance \<Psi>\<^sub>1 (\<lambda>\<omega>. real (r x \<omega>)) = (\<Sum> a \<in> A. measure_pmf.variance \<Psi>\<^sub>1 (V a))"
    unfolding r_eq V_def using \<Psi>\<^sub>1.sample_space
    by (intro measure_pmf.var_sum_pairwise_indep_2 fin_A) (simp_all)
  also have "... \<le> (\<Sum> a \<in> A. (\<integral>\<omega>. V a \<omega> \<partial> \<Psi>\<^sub>1))"
    by (intro sum_mono a)
  also have "... = (\<integral>\<omega>. real (r x \<omega>) \<partial> \<Psi>\<^sub>1)"
    unfolding b by simp
  finally show "measure_pmf.variance \<Psi>\<^sub>1 (\<lambda>\<omega>. real (r x \<omega>)) \<le> (\<integral>\<omega>. real (r x \<omega>) \<partial> \<Psi>\<^sub>1)" by simp
qed

definition E\<^sub>1 where "E\<^sub>1 = (\<lambda>(f,g,h). 2 powr (-t f) * X \<in> {b/2^16..b/2})"

lemma t_low:
  "measure \<Psi>\<^sub>1 {f. of_int (t f) < log 2 (real X) + 1 - b_exp} \<le> 1/2^7" (is "?L \<le> ?R")
proof (cases "log 2 (real X) \<ge> 8")
  case True
  define Z :: "(nat \<Rightarrow> nat) \<Rightarrow> real" where "Z = r (nat \<lceil>log 2 (real X) - 8\<rceil>)"

  have "log 2 (real X) \<le> log 2 (real n)"
    using X_le_n X_ge_1 by (intro log_mono) auto
  hence "nat \<lceil>log 2 (real X) - 8\<rceil> \<le> nat \<lceil>log 2 (real n)\<rceil>"
    by (intro nat_mono ceiling_mono) simp
  hence a:"(nat \<lceil>log 2 (real X) - 8\<rceil> \<le> max (nat \<lceil>log 2 (real n)\<rceil>) 1)"
    by simp

  have b:"real (nat (\<lceil>log 2 (real X)\<rceil> - 8)) \<le> log 2 (real X) - 7"
    using True by linarith

  have "2 ^ 7 = real X / (2 powr (log 2 X) * 2 powr (-7))"
    using X_ge_1 by simp
  also have "... = real X / (2 powr (log 2 X - 7))"
    by (subst powr_add[symmetric]) simp
  also have "... \<le> real X / (2 powr (real (nat \<lceil>log 2 (real X) - 8\<rceil>)))"
    using b by (intro divide_left_mono powr_mono) auto
  also have "... = real X / 2 ^ nat \<lceil>log 2 (real X) - 8\<rceil>"
    by (subst powr_realpow) auto
  finally have "2 ^ 7 \<le> real X / 2 ^ nat \<lceil>log 2 (real X) - 8\<rceil>"
    by simp
  hence exp_Z_gt_2_7: "(\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1) \<ge> 2^7"
    using a unfolding Z_def r_exp by simp

  have var_Z_le_exp_Z: "measure_pmf.variance \<Psi>\<^sub>1 Z \<le> (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1)"
    unfolding Z_def by (intro r_var)

  have "?L \<le> measure \<Psi>\<^sub>1 {f. of_nat (Max (f ` A)) < log 2 (real X) - 8}"
    unfolding t_def by (intro pmf_mono) (auto simp add:int_of_nat_def)
  also have "... \<le> measure \<Psi>\<^sub>1 {f \<in> space \<Psi>\<^sub>1.  (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1) \<le> \<bar>Z f - (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1) \<bar>}"
  proof (rule pmf_mono)
    fix f assume "f \<in> set_pmf (sample_pmf \<Psi>\<^sub>1)"
    have fin_f_A: "finite (f ` A)" using fin_A finite_imageI by blast
    assume " f \<in> {f. real (Max (f ` A)) < log 2 (real X) - 8}"
    hence "real (Max (f ` A)) < log 2 (real X) - 8" by auto
    hence "real (f a) < log 2 (real X) - 8" if "a \<in> A" for a
      using Max_ge[OF fin_f_A] imageI[OF that]  order_less_le_trans by fastforce
    hence "of_nat (f a) < \<lceil>log 2 (real X) - 8\<rceil>" if "a \<in> A" for a
      using that by (subst less_ceiling_iff) auto
    hence "f a < nat \<lceil>log 2 (real X) - 8\<rceil>" if "a \<in> A" for a
      using that True by fastforce
    hence "r (nat \<lceil>log 2 (real X) - 8\<rceil>) f = 0"
      unfolding r_def card_eq_0_iff using not_less by auto
    hence "Z f = 0"
      unfolding Z_def by simp
    thus "f \<in> {f \<in> space \<Psi>\<^sub>1.  (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1) \<le> \<bar>Z f - (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1)\<bar>}"
      by auto
  qed
  also have "... \<le> measure_pmf.variance \<Psi>\<^sub>1 Z / (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1)^2"
    using exp_Z_gt_2_7 \<Psi>\<^sub>1.sample_space by (intro measure_pmf.second_moment_method) simp_all
  also have "... \<le> (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1) / (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1)^2"
    by (intro divide_right_mono var_Z_le_exp_Z) simp
  also have "... = 1 / (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1)"
    using exp_Z_gt_2_7 by (simp add:power2_eq_square)
  also have "... \<le> ?R"
    using exp_Z_gt_2_7 by (intro divide_left_mono) auto
  finally show ?thesis by simp
next
  case "False"
  have "?L \<le> measure \<Psi>\<^sub>1 {f. of_nat (Max (f ` A)) < log 2 (real X) - 8}"
    unfolding t_def by (intro pmf_mono) (auto simp add:int_of_nat_def)
  also have "... \<le> measure \<Psi>\<^sub>1 {}"
    using False by (intro pmf_mono) simp
  also have "... = 0"
    by simp
  also have "... \<le> ?R" by simp
  finally show ?thesis by simp
qed

lemma t_high:
  "measure \<Psi>\<^sub>1 {f. of_int (t f) > log 2 (real X) + 16 - b_exp} \<le> 1/2^7" (is "?L \<le> ?R")
proof -
  define Z :: "(nat \<Rightarrow> nat) \<Rightarrow> real" where "Z = r (nat \<lfloor>log 2 (real X) + 8\<rfloor>)"

  have Z_nonneg: "Z f \<ge> 0" for f
    unfolding Z_def r_def by simp

  have "(\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1) \<le> real X / (2 ^ nat \<lfloor>log 2 (real X) + 8\<rfloor>)"
    unfolding Z_def r_exp by simp
  also have "... \<le> real X / (2 powr (real (nat \<lfloor>log 2 (real X) + 8\<rfloor>)))"
    by (subst powr_realpow) auto
  also have "... \<le> real X / (2 powr \<lfloor>log 2 (real X) + 8\<rfloor>)"
    by (intro divide_left_mono powr_mono) auto
  also have "... \<le> real X / (2 powr (log 2 (real X) + 7))"
    by (intro divide_left_mono powr_mono, linarith) auto
  also have "... = real X / 2 powr (log 2 (real X)) / 2 powr 7"
    by (subst powr_add) simp
  also have "... \<le> 1/2 powr 7"
    using X_ge_1 by (subst powr_log_cancel) auto
  finally have Z_exp: "(\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1) \<le> 1/2^7"
    by simp

  have "?L \<le> measure \<Psi>\<^sub>1 {f. of_nat (Max (f ` A)) > log 2 (real X) + 7}"
    unfolding t_def  by (intro pmf_mono) (auto simp add:int_of_nat_def)
  also have "... \<le> measure \<Psi>\<^sub>1 {f. Z f \<ge> 1}"
  proof (rule pmf_mono)
    fix f assume "f \<in> set_pmf (sample_pmf \<Psi>\<^sub>1)"
    assume " f \<in> {f. real (Max (f ` A)) > log 2 (real X) + 7}"
    hence "real (Max (f ` A)) > log 2 (real X) + 7" by simp
    hence "int (Max (f ` A)) \<ge> \<lfloor>log 2 (real X) + 8\<rfloor>"
      by linarith
    hence "Max (f ` A) \<ge> nat \<lfloor>log 2 (real X) + 8\<rfloor>"
      by simp
    moreover have "f ` A \<noteq> {}" "finite (f ` A)"
      using fin_A finite_imageI A_nonempty by auto
    ultimately obtain fa where "fa \<in> f ` A" " fa \<ge>  nat \<lfloor>log 2 (real X) + 8\<rfloor>"
      using Max_in by auto
    then obtain ae where ae_def: "ae \<in> A" "nat \<lfloor>log 2 (real X) + 8\<rfloor> \<le> f ae"
      by auto
    hence "r (nat \<lfloor>log 2 (real X) + 8\<rfloor>) f > 0"
      unfolding r_def card_gt_0_iff using fin_A by auto
    hence "Z f \<ge> 1"
      unfolding Z_def by simp
    thus "f \<in> {f. 1 \<le> Z f}" by simp
  qed
  also have "... \<le> (\<integral>\<omega>. Z \<omega> \<partial>\<Psi>\<^sub>1) / 1"
    using Z_nonneg using \<Psi>\<^sub>1.sample_space by (intro pmf_markov) auto
  also have "... \<le> ?R"
    using Z_exp by simp
  finally show ?thesis by simp
qed

lemma e_1: "measure \<Psi> {\<psi>. \<not>E\<^sub>1 \<psi>} \<le> 1/2^6"
proof -
  have "measure \<Psi>\<^sub>1 {f. 2 powr (of_int (-t f)) * real X \<notin> {real b/2^16..real b/2}} \<le>
    measure \<Psi>\<^sub>1 {f. 2 powr (of_int (-t f)) * real X < real b/2^16} +
    measure \<Psi>\<^sub>1 {f. 2 powr (of_int (-t f)) * real X > real b/2}"
    by (intro pmf_add) auto
  also have "... \<le> measure \<Psi>\<^sub>1 {f. of_int (t f) > log 2 X + 16 - b_exp} +
                   measure \<Psi>\<^sub>1 {f. of_int (t f) < log 2 X + 1 - b_exp}"
  proof (rule add_mono)
    show "measure \<Psi>\<^sub>1 {f. 2 powr (of_int (-t f)) * real X < real b/2^16} \<le>
    measure \<Psi>\<^sub>1 {f. of_int (t f) > log 2 X + 16 - b_exp}"
    proof (rule pmf_mono)
      fix f assume "f \<in> {f. 2 powr real_of_int (-t f) * real X < real b / 2 ^ 16}"
      hence "2 powr real_of_int (-t f) * real X < real b / 2 ^ 16"
        by simp
      hence "log 2 (2 powr of_int (-t f) * real X) < log 2 (real b / 2^16)"
        using b_min X_ge_1 by (intro iffD2[OF log_less_cancel_iff]) auto
      hence "of_int (-t f) + log  2 (real X) < log 2 (real b / 2^16)"
        using X_ge_1 by (subst (asm) log_mult) auto
      also have  "... = real b_exp - log 2 (2 powr 16)"
        unfolding b_def by (subst log_divide) auto
      also have "... = real b_exp - 16"
        by (subst log_powr_cancel) auto
      finally have "of_int (-t f) + log 2 (real X) < real b_exp - 16" by simp
      thus "f \<in> {f. of_int (t f) > log 2 (real X) + 16 - b_exp}"
        by simp
    qed
  next
    show "measure \<Psi>\<^sub>1 {f. 2 powr of_int (-t f) * real X > real b/2} \<le>
      measure \<Psi>\<^sub>1 {f. of_int (t f) < log 2 X + 1 - b_exp}"
    proof (rule pmf_mono)
      fix f assume "f \<in> {f. 2 powr real_of_int (-t f) * real X > real b / 2}"
      hence "2 powr real_of_int (-t f) * real X > real b / 2"
        by simp
      hence "log 2 (2 powr of_int (-t f) * real X) > log 2 (real b / 2)"
        using b_min X_ge_1 by (intro iffD2[OF log_less_cancel_iff]) auto
      hence "of_int (-t f) + log  2 (real X) > log 2 (real b / 2)"
        using X_ge_1 by (subst (asm) log_mult) auto
      hence  "of_int (-t f) + log  2 (real X) > real b_exp - 1"
        unfolding b_def by (subst (asm) log_divide) auto
      hence "of_int (t f) < log 2 (real X) + 1 - b_exp"
        by simp
      thus "f \<in> {f. of_int (t f) < log 2 (real X) + 1 - b_exp}"
        by simp
    qed
  qed
  also have "... \<le> 1/2^7 + 1/2^7"
    by (intro add_mono t_low t_high)
  also have "... = 1/2^6" by simp
  finally have "measure \<Psi>\<^sub>1 {f. 2 powr of_int (-t f) * real X \<notin> {real b/2^16..real b/2}} \<le> 1/2^6"
    by simp

  thus ?thesis
    unfolding sample_pmf_\<Psi> E\<^sub>1_def case_prod_beta
    by (subst pair_pmf_prob_left)
qed

definition E\<^sub>2 where "E\<^sub>2 = (\<lambda>(f,g,h). \<bar>card (R f) - X / 2^(s f)\<bar> \<le> \<delta>/3 * X / 2^(s f))"

lemma e_2: "measure \<Psi> {\<psi>. E\<^sub>1 \<psi> \<and> \<not>E\<^sub>2 \<psi>} \<le> 1/2^6" (is "?L \<le> ?R")
proof -
  define t\<^sub>m :: int where "t\<^sub>m = \<lfloor>log 2 (real X)\<rfloor> + 16 - b_exp"

  have t_m_bound: "t\<^sub>m \<le> \<lfloor>log 2 (real X)\<rfloor> - 10"
    unfolding t\<^sub>m_def using b_exp_ge_26 by simp

  have "real b / 2^16 = (real X * (1/ X)) * (real b / 2^16)"
    using X_ge_1 by simp
  also have "... = (real X * 2 powr (-log 2 X)) * (real b / 2^16)"
    using X_ge_1 by (subst powr_minus_divide) simp
  also have "... \<le> (real X * 2 powr (- \<lfloor>log 2 (real X)\<rfloor>)) * (2 powr b_exp / 2^16)"
    unfolding b_def using powr_realpow
    by (intro mult_mono powr_mono) auto
  also have "... = real X * (2 powr (- \<lfloor>log 2 (real X)\<rfloor>) * 2 powr(real b_exp-16))"
    by (subst powr_diff) simp
  also have "... = real X * 2 powr (- \<lfloor>log 2 (real X)\<rfloor> + (int b_exp - 16))"
    by (subst powr_add[symmetric]) simp
  also have "... = real X * 2 powr (-t\<^sub>m)"
    unfolding t\<^sub>m_def by (simp add:algebra_simps)
  finally have c:"real b / 2^16 \<le> real X * 2 powr (-t\<^sub>m)" by simp

  define T :: "nat set" where "T = {x. (real X / 2^x \<ge> real b / 2^16)}"

  have "x \<in> T \<longleftrightarrow> int x \<le> t\<^sub>m" for x
  proof -
    have "x \<in> T \<longleftrightarrow> 2^ x \<le> real X * 2^16 / b"
      using b_min by (simp add: field_simps T_def)
    also have "... \<longleftrightarrow> log 2 (2^x) \<le> log 2 (real X * 2^16 / b)"
      using X_ge_1 b_min by (intro log_le_cancel_iff[symmetric] divide_pos_pos) auto
    also have "... \<longleftrightarrow> x \<le> log 2 (real X * 2^16) - log 2 b"
      using X_ge_1 b_min by (subst log_divide) auto
    also have "... \<longleftrightarrow> x \<le> log 2 (real X) + log 2 (2 powr 16) - b_exp"
      unfolding b_def using X_ge_1 by (subst log_mult) auto
    also have "... \<longleftrightarrow> x \<le> \<lfloor>log 2 (real X) + log 2 (2 powr 16) - b_exp\<rfloor>"
      by linarith
    also have "... \<longleftrightarrow> x \<le> \<lfloor>log 2 (real X) + 16 - real_of_int (int b_exp)\<rfloor>"
      by (subst log_powr_cancel) auto
    also have "... \<longleftrightarrow> x \<le> t\<^sub>m"
      unfolding t\<^sub>m_def by linarith
    finally show ?thesis by simp
  qed
  hence T_eq: "T = {x. int x \<le> t\<^sub>m}" by auto

  have "T = {x. int x < t\<^sub>m+1}"
    unfolding T_eq by simp
  also have "... = {x. x < nat (t\<^sub>m + 1)}"
    unfolding zless_nat_eq_int_zless by simp
  finally have T_eq_2: "T = {x. x < nat (t\<^sub>m + 1)}"
    by simp

  have inj_1: "inj_on ((-) (nat t\<^sub>m)) T"
    unfolding T_eq by (intro inj_onI) simp
  have fin_T: "finite T"
    unfolding T_eq_2 by simp

  have r_exp: "(\<integral>\<omega>. real (r t \<omega>) \<partial>\<Psi>\<^sub>1) = real X / 2^t" if "t \<in> T" for t
  proof -
    have "t \<le> t\<^sub>m"
      using that unfolding T_eq by simp
    also have "... \<le> \<lfloor>log 2 (real X)\<rfloor> - 10"
      using t_m_bound by simp
    also have "... \<le> \<lfloor>log 2 (real X)\<rfloor>"
      by simp
    also have "... \<le> \<lfloor>log 2 (real n)\<rfloor>"
      using X_le_n X_ge_1 by (intro floor_mono log_mono) auto
    also have "... \<le> \<lceil>log 2 (real n)\<rceil>"
      by simp
    finally have "t \<le> \<lceil>log 2 (real n)\<rceil>" by simp
    hence "t \<le> max (nat \<lceil>log 2 (real n)\<rceil>) 1"by simp
    thus ?thesis
      unfolding r_exp by simp
  qed

  have r_var: "measure_pmf.variance \<Psi>\<^sub>1 (\<lambda>\<omega>. real (r t \<omega>)) \<le> real X / 2^t" if "t \<in> T" for t
    using r_exp[OF that] r_var by metis

  have "9 = C\<^sub>4 / \<delta>\<^sup>2 * \<delta>^2/2^23"
    using \<delta>_gt_0 by (simp add:C\<^sub>4_def)
  also have "... = 2 powr (log 2 (C\<^sub>4 /  \<delta>\<^sup>2)) *  \<delta>^2/2^23"
    using \<delta>_gt_0 C\<^sub>4_def by (subst powr_log_cancel) auto
  also have "... \<le> 2 powr b_exp * \<delta>^2/2^23"
    unfolding b_exp_def
    by (intro divide_right_mono mult_right_mono powr_mono, linarith) auto
  also have "... = b * \<delta>^2/2^23"
    using powr_realpow unfolding b_def by simp
  also have "... = (b/2^16) * (\<delta>^2/2^7)"
    by simp
  also have "... \<le> (X * 2 powr (-t\<^sub>m)) * (\<delta>^2/2^7)"
    by (intro mult_mono c) auto
  also have "... = X * (2 powr (-t\<^sub>m) * 2 powr (-7)) * \<delta>^2"
    using powr_realpow by simp
  also have "... = 2 powr (-t\<^sub>m-7) * (\<delta>^2 * X)"
    by (subst powr_add[symmetric]) (simp )
  finally have "9 \<le> 2 powr (-t\<^sub>m-7) * (\<delta>^2 * X)" by simp
  hence b: "9/ (\<delta>^2 * X) \<le> 2 powr (-t\<^sub>m -7)"
    using \<delta>_gt_0 X_ge_1
    by (subst pos_divide_le_eq) auto

  have a: "measure \<Psi>\<^sub>1 {f.\<bar>real (r t f)-real X/2^t\<bar>> \<delta>/3 *real X/2^t} \<le> 2 powr (real t-t\<^sub>m-7)"
    (is"?L1 \<le> ?R1") if "t \<in> T" for t
  proof -
    have "?L1 \<le> \<P>(f in \<Psi>\<^sub>1. \<bar>real (r t f) - real X / 2^t\<bar> \<ge>  \<delta>/3 * real X / 2^t)"
      by (intro pmf_mono) auto
    also have "... = \<P>(f in \<Psi>\<^sub>1. \<bar>real (r t f)-(\<integral>\<omega>. real (r t \<omega>) \<partial> \<Psi>\<^sub>1)\<bar> \<ge> \<delta>/3 * real X/2^t)"
      by (simp add: r_exp[OF that])
    also have "... \<le> measure_pmf.variance \<Psi>\<^sub>1 (\<lambda>\<omega>. real (r t \<omega>)) / (\<delta>/3 * real X / 2^t)^2"
      using X_ge_1 \<delta>_gt_0 \<Psi>\<^sub>1.sample_space
      by (intro measure_pmf.Chebyshev_inequality divide_pos_pos mult_pos_pos) auto
    also have "... \<le> (X / 2^t) / (\<delta>/3 * X / 2^t)^2"
      by (intro divide_right_mono r_var[OF that]) simp
    also have "... = 2^t*(9/ ( \<delta>^2 * X))"
      by (simp add:power2_eq_square algebra_simps)
    also have "... \<le> 2^t*(2 powr (-t\<^sub>m-7))"
      by (intro mult_left_mono b) simp
    also have "... = 2 powr t * 2 powr (-t\<^sub>m-7)"
      by (subst powr_realpow[symmetric]) auto
    also have "... = ?R1"
      by (subst powr_add[symmetric]) (simp add:algebra_simps)
    finally show "?L1 \<le> ?R1" by simp
  qed

  have "\<exists>y<nat (t\<^sub>m + 1). x = nat t\<^sub>m - y" if "x < nat (t\<^sub>m+1)" for x
    using that by (intro exI[where x="nat t\<^sub>m - x"]) simp
  hence T_reindex: "(-) (nat t\<^sub>m) ` {x. x < nat (t\<^sub>m + 1)} = {..<nat (t\<^sub>m + 1)}"
    by (auto simp add: set_eq_iff image_iff)

  have "?L \<le> measure \<Psi> {\<psi>. (\<exists>t \<in> T. \<bar>real (r t (fst \<psi>))-real X/2^t\<bar> > \<delta>/3 * real X / 2^t)}"
  proof (rule pmf_mono)
    fix \<psi>
    assume "\<psi> \<in> set_pmf (sample_pmf \<Psi>)"
    obtain f g h where \<psi>_def: "\<psi> = (f,g,h)" by (metis prod_cases3)
    assume "\<psi> \<in> {\<psi>. E\<^sub>1 \<psi> \<and> \<not> E\<^sub>2 \<psi>}"
    hence a:"2 powr ( -real_of_int (t f)) * real X \<in> {real b/2^16..real b/2}" and
      b:"\<bar>card (R f) - real X / 2^(s f)\<bar> >  \<delta>/3 * X / 2^(s f)"
      unfolding E\<^sub>1_def E\<^sub>2_def by (auto simp add:\<psi>_def)
    have "\<bar>card (R f) - X / 2^(s f)\<bar> = 0" if "s f= 0"
      using that by (simp add:R_def X_def)
    moreover have "( \<delta>/3) * (X / 2^s f) \<ge> 0"
      using \<delta>_gt_0 X_ge_1 by (intro mult_nonneg_nonneg) auto
    ultimately have "False" if "s f = 0"
      using b that by simp
    hence "s f > 0" by auto
    hence "t f = s f" unfolding s_def by simp
    hence "2 powr (-real (s f)) * X \<ge> b / 2^16"
      using a by simp
    hence "X / 2 powr (real (s f)) \<ge> b / 2^16"
      by (simp add: divide_powr_uminus mult.commute)
    hence "real X / 2 ^ (s f) \<ge> b / 2^16"
      by (subst (asm) powr_realpow, auto)
    hence "s f \<in> T" unfolding T_def by simp
    moreover have "\<bar>r (s f) f - X / 2^s f\<bar> >  \<delta>/3 * X / 2^s f"
      using R_def r_def b by simp
    ultimately have "\<exists>t \<in> T. \<bar>r t (fst \<psi>) - X / 2^t\<bar> >  \<delta>/3 * X / 2^t"
      using \<psi>_def by (intro bexI[where x="s f"]) simp
    thus "\<psi> \<in> {\<psi>. (\<exists>t \<in> T. \<bar>r t (fst \<psi>) - X / 2^t\<bar> >  \<delta>/3 * X / 2^t)}" by simp
  qed
  also have "... = measure \<Psi>\<^sub>1 {f. (\<exists>t \<in> T. \<bar>real (r t f)-real X / 2^t\<bar> > \<delta>/3 * real X/2^t)}"
    unfolding sample_pmf_\<Psi> by (intro pair_pmf_prob_left)
  also have "... = measure \<Psi>\<^sub>1 (\<Union>t \<in> T. {f. \<bar>real (r t f)-real X / 2^t\<bar> > \<delta>/3 * real X/2^t})"
    by (intro measure_pmf_cong) auto
  also have "... \<le> (\<Sum>t \<in> T. measure \<Psi>\<^sub>1 {f.\<bar>real (r t f)-real X / 2^t\<bar> > \<delta>/3 * real X/2^t})"
    by (intro measure_UNION_le fin_T) (simp)
  also have "... \<le> (\<Sum>t \<in> T.  2 powr (real t - of_int t\<^sub>m - 7))"
    by (intro sum_mono a)
  also have "... = (\<Sum>t \<in> T.  2 powr (-int (nat t\<^sub>m-t) - 7))"
    unfolding T_eq
    by (intro sum.cong refl arg_cong2[where f="(powr)"]) simp
  also have "... = (\<Sum>x \<in> (\<lambda>x. nat t\<^sub>m - x) ` T. 2 powr (-real x - 7))"
    by (subst sum.reindex[OF inj_1]) simp
  also have "... = (\<Sum>x \<in> (\<lambda>x. nat t\<^sub>m - x) ` T. 2 powr (-7) * 2 powr (-real x))"
    by (subst powr_add[symmetric]) (simp add:algebra_simps)
  also have "... = 1/2^7 * (\<Sum>x \<in> (\<lambda>x. nat t\<^sub>m - x) ` T. 2 powr (-real x))"
    by (subst sum_distrib_left) simp
  also have "... = 1/2^7 * (\<Sum>x <nat (t\<^sub>m+1). 2 powr (-real x))"
    unfolding T_eq_2 T_reindex
    by (intro arg_cong2[where f="(*)"] sum.cong) auto
  also have "... = 1/2^7 * (\<Sum>x <nat (t\<^sub>m+1). (2 powr (-1)) powr (real x))"
    by (subst powr_powr) simp
  also have "... = 1/2^7 * (\<Sum>x <nat (t\<^sub>m+1). (1/2)^x)"
    using powr_realpow by simp
  also have "... \<le> 1/2^7 * 2"
    by(subst geometric_sum) auto
  also have "... = 1/2^6" by simp
  finally show ?thesis by simp
qed

definition E\<^sub>3 where "E\<^sub>3 = (\<lambda>(f,g,h). inj_on g (R f))"

lemma R_bound:
  fixes f g h
  assumes "E\<^sub>1 (f,g,h)"
  assumes "E\<^sub>2 (f,g,h)"
  shows "card (R f) \<le> 2/3 * b"
proof -
  have "real (card (R f)) \<le> ( \<delta> / 3) * (real X / 2 ^ s f) + real X / 2 ^ s f"
    using assms(2) unfolding E\<^sub>2_def by simp
  also have "... \<le> (1/3) * (real X / 2 ^ s f) + real X / 2 ^ s f"
    using \<delta>_lt_1 by (intro add_mono mult_right_mono) auto
  also have "... = (4/3) * (real X / 2 powr s f)"
    using powr_realpow by simp
  also have "... \<le> (4/3) * (real X / 2 powr t f)"
    unfolding s_def
    by (intro mult_left_mono divide_left_mono powr_mono) auto
  also have "... = (4/3) * (2 powr (-(of_int (t f))) * real X)"
    by (subst powr_minus_divide) simp
  also have "... = (4/3) * (2 powr (- t f) * real X)"
    by simp
  also have "... \<le> (4/3) * (b/2)"
    using assms(1) unfolding E\<^sub>1_def
    by (intro mult_left_mono) auto
  also have "... \<le> (2/3) * b" by simp
  finally show ?thesis by simp
qed

lemma e_3: "measure \<Psi> {\<psi>. E\<^sub>1 \<psi> \<and> E\<^sub>2 \<psi> \<and> \<not>E\<^sub>3 \<psi>} \<le> 1/2^6" (is "?L \<le> ?R")
proof -
  let ?\<alpha> = "(\<lambda>(z,x,y) f. z < C\<^sub>7*b^2 \<and> x \<in> R f \<and> y \<in> R f \<and> x < y)"
  let ?\<beta> = "(\<lambda>(z,x,y) g. g x = z \<and> g y = z)"

  have \<beta>_prob: "measure \<Psi>\<^sub>2 {g. ?\<beta> \<omega> g} \<le> (1/real (C\<^sub>7*b^2)^2)"
    if "?\<alpha> \<omega> f" for \<omega> f
  proof -
    obtain x y z where \<omega>_def: "\<omega> = (z,x,y)" by (metis prod_cases3)
    have a:"prob_space.k_wise_indep_vars \<Psi>\<^sub>2 2 (\<lambda>i. discrete) (\<lambda>x \<omega>. \<omega> x = z) {..<n}"
      by (intro prob_space.k_wise_indep_vars_compose[OF _ \<Psi>\<^sub>2.\<H>_indep])
       (simp_all add:prob_space_measure_pmf)

    have "u \<in> R f \<Longrightarrow> u < n" for u
      unfolding R_def using A_range by auto
    hence b: "x < n" "y < n" "card {x, y} = 2"
      using that \<omega>_def by auto
    have c: "z < C\<^sub>7*b\<^sup>2" using \<omega>_def that by simp

    have "measure \<Psi>\<^sub>2 {g. ?\<beta> \<omega> g} = measure \<Psi>\<^sub>2 {g. (\<forall>\<xi> \<in> {x,y}. g \<xi> = z)}"
      by (simp add:\<omega>_def)
    also have "... = (\<Prod>\<xi> \<in> {x,y}. measure \<Psi>\<^sub>2 {g. g \<xi> = z})"
      using b by (intro measure_pmf.split_indep_events[OF refl, where I="{x,y}"]
          prob_space.k_wise_indep_vars_subset[OF _ a]) (simp_all add:prob_space_measure_pmf)
    also have "... = (\<Prod>\<xi> \<in> {x,y}. measure (map_pmf (\<lambda>\<omega>. \<omega> \<xi>) (sample_pmf \<Psi>\<^sub>2)) {g. g = z}) "
      by (simp add:vimage_def)
    also have "... = (\<Prod>\<xi> \<in> {x,y}. measure [C\<^sub>7 * b\<^sup>2]\<^sub>S {g. g=z})"
      using b \<Psi>\<^sub>2.single by (intro prod.cong) fastforce+
    also have "... = (\<Prod>\<xi> \<in> {x,y}. measure (pmf_of_set {..<C\<^sub>7 * b\<^sup>2}) {z})"
      by (subst nat_sample_pmf) simp
    also have "... = (measure (pmf_of_set {..<C\<^sub>7 * b\<^sup>2}) {z})^2"
      using b by simp
    also have "... \<le> (1 /(C\<^sub>7*b\<^sup>2))^2"
      using c by (subst measure_pmf_of_set) auto
    also have "... = (1 /(C\<^sub>7*b\<^sup>2)^2)"
      by (simp add:algebra_simps power2_eq_square)
    finally show ?thesis by simp
  qed

  have \<alpha>_card: "card {\<omega>. ?\<alpha> \<omega> f} \<le> (C\<^sub>7*b^2) * (card (R f) * (card (R f)-1)/2)"
    (is "?TL \<le> ?TR") and fin_\<alpha>: "finite {\<omega>. ?\<alpha> \<omega> f}" (is "?T2") for f
  proof -
    have t1: "{\<omega>. ?\<alpha> \<omega> f} \<subseteq> {..<C\<^sub>7*b^2} \<times> {(x,y) \<in> R f \<times> R f. x < y}"
      by (intro subsetI) auto
    moreover have "card ({..<C\<^sub>7*b^2} \<times> {(x,y) \<in> R f \<times> R f. x < y}) = ?TR"
      using  card_ordered_pairs'[where M="R f"]
      by (simp add: card_cartesian_product)
    moreover have "finite (R f)"
      unfolding R_def using fin_A finite_subset by simp
    hence "finite {(x, y). (x, y) \<in> R f \<times> R f \<and> x < y}"
      by (intro finite_subset[where B="R f \<times> R f", OF _ finite_cartesian_product]) auto
    hence t2: "finite ({..<C\<^sub>7*b^2} \<times> {(x,y) \<in> R f \<times> R f. x < y})"
      by (intro finite_cartesian_product) auto
    ultimately show "?TL \<le> ?TR"
      using card_mono of_nat_le_iff by (metis (no_types, lifting))
    show ?T2
      using finite_subset[OF t1 t2] by simp
  qed

  have "?L \<le> measure \<Psi> {(f,g,h). card (R f) \<le> b \<and> (\<exists> x y z. ?\<alpha> (x,y,z) f \<and> ?\<beta> (x,y,z) g)}"
  proof (rule pmf_mono)
    fix \<psi> assume b:"\<psi> \<in> set_pmf (sample_pmf \<Psi>)"
    obtain f g h where \<psi>_def:"\<psi> = (f,g,h)" by (metis prod_cases3)
    have "(f,g,h) \<in> sample_set \<Psi>"
      using sample_space_alt[OF sample_space_\<Psi>] b \<psi>_def by simp
    hence c:"g x < C\<^sub>7*b^2" for x
      using g_range by simp

    assume a:"\<psi> \<in> {\<psi>. E\<^sub>1 \<psi> \<and> E\<^sub>2 \<psi> \<and> \<not> E\<^sub>3 \<psi>}"
    hence "card (R f) \<le> 2/3 * b"
      using R_bound \<psi>_def by force
    moreover have "\<exists>a b. a \<in> R f \<and> b \<in> R f \<and> a \<noteq> b \<and> g a = g b"
      using a unfolding \<psi>_def E\<^sub>3_def inj_on_def by auto
    hence "\<exists>x y. x \<in> R f \<and> y \<in> R f \<and> x < y \<and> g x = g y"
      by (metis not_less_iff_gr_or_eq)
    hence "\<exists>x y z. ?\<alpha> (x,y,z) f \<and> ?\<beta> (x,y,z) g"
      using c by blast
    ultimately show "\<psi> \<in> {(f, g, h). card (R f) \<le> b \<and> (\<exists> x y z. ?\<alpha> (x,y,z) f \<and> ?\<beta> (x,y,z) g)}"
      unfolding \<psi>_def by auto
  qed
  also have "... = (\<integral>f. measure (pair_pmf \<Psi>\<^sub>2 \<Psi>\<^sub>3)
     {g. card (R f) \<le> b \<and> (\<exists>x y z. ?\<alpha> (x,y,z) f \<and> ?\<beta> (x,y,z) (fst g))} \<partial>\<Psi>\<^sub>1)"
    unfolding sample_pmf_\<Psi> split_pair_pmf by (simp add: case_prod_beta)
  also have
    "... = (\<integral>f. measure \<Psi>\<^sub>2 {g. card (R f) \<le> b \<and> (\<exists>x y z. ?\<alpha> (x,y,z) f \<and> ?\<beta> (x,y,z) g)} \<partial>\<Psi>\<^sub>1)"
    by (subst pair_pmf_prob_left) simp
  also have "... \<le> (\<integral>f. 1/real (2*C\<^sub>7) \<partial>\<Psi>\<^sub>1)"
  proof (rule pmf_exp_mono[OF integrable_sample_pmf[OF \<Psi>\<^sub>1.sample_space]
          integrable_sample_pmf[OF \<Psi>\<^sub>1.sample_space]])
    fix f assume "f \<in> set_pmf (sample_pmf \<Psi>\<^sub>1)"
    show "measure \<Psi>\<^sub>2 {g. card (R f) \<le> b \<and> (\<exists>x y z. ?\<alpha> (x,y,z) f \<and> ?\<beta> (x,y,z) g)} \<le> 1 / real (2 * C\<^sub>7)"
      (is "?L1 \<le> ?R1")
    proof (cases "card (R f) \<le> b")
      case True
      have "?L1 \<le> measure \<Psi>\<^sub>2 (\<Union> \<omega> \<in> {\<omega>. ?\<alpha> \<omega> f}. {g. ?\<beta> \<omega> g})"
        by (intro pmf_mono) auto
      also have "... \<le> (\<Sum>\<omega> \<in> {\<omega>. ?\<alpha> \<omega> f}. measure \<Psi>\<^sub>2 {g. ?\<beta> \<omega> g})"
        by (intro measure_UNION_le fin_\<alpha>) auto
      also have "... \<le> (\<Sum>\<omega> \<in> {\<omega>. ?\<alpha> \<omega> f}. (1/real (C\<^sub>7*b^2)^2))"
        by (intro sum_mono \<beta>_prob) auto
      also have "... = card {\<omega>. ?\<alpha> \<omega> f} /(C\<^sub>7*b^2)^2"
        by simp
      also have "... \<le> (C\<^sub>7*b^2) * (card (R f) * (card (R f)-1)/2) / (C\<^sub>7*b^2)^2"
        by (intro \<alpha>_card divide_right_mono) simp
      also have "... \<le> (C\<^sub>7*b^2) * (b * b / 2)  / (C\<^sub>7*b^2)^2"
        unfolding C\<^sub>7_def using True
        by (intro divide_right_mono Nat.of_nat_mono mult_mono) auto
      also have "... = 1/(2*C\<^sub>7)"
        using b_min by (simp add:algebra_simps power2_eq_square)
      finally show ?thesis by simp
    next
      case False
      then show ?thesis by simp
    qed
  qed
  also have "... \<le> 1/2^6"
    unfolding C\<^sub>7_def by simp
  finally show ?thesis by simp
qed

definition E\<^sub>4 where "E\<^sub>4 = (\<lambda>(f,g,h). \<bar>p (f,g,h) - \<rho> (card (R f))\<bar> \<le>  \<delta>/12 * card (R f))"

lemma e_4_h: "9 / sqrt b \<le> \<delta> / 12"
proof -
  have "108 \<le> sqrt (C\<^sub>4)"
    unfolding C\<^sub>4_def by (approximation 5)
  also have "... \<le> sqrt( \<delta>^2 * real b)"
    using b_lower_bound \<delta>_gt_0
    by (intro real_sqrt_le_mono) (simp add: pos_divide_le_eq algebra_simps)
  also have "... =  \<delta> * sqrt b"
    using \<delta>_gt_0 by (simp add:real_sqrt_mult)
  finally have "108 \<le>  \<delta> * sqrt b"  by simp
  thus ?thesis
    using b_min by (simp add:pos_divide_le_eq)
qed

lemma e_4: "measure \<Psi> {\<psi>. E\<^sub>1 \<psi> \<and> E\<^sub>2 \<psi> \<and> E\<^sub>3 \<psi> \<and> \<not>E\<^sub>4 \<psi>} \<le> 1/2^6" (is "?L \<le> ?R")
proof -
  have a: "measure \<Psi>\<^sub>3 {h. E\<^sub>1 (f,g,h) \<and> E\<^sub>2 (f,g,h) \<and> E\<^sub>3 (f,g,h) \<and> \<not>E\<^sub>4 (f,g,h)} \<le> 1/2^6"
    (is "?L1 \<le> ?R1") if "f \<in> set_pmf (sample_pmf \<Psi>\<^sub>1)" "g \<in> set_pmf(sample_pmf \<Psi>\<^sub>2)"
    for f g
  proof (cases "card (R f) \<le> b \<and> inj_on g (R f)")
    case True

    have g_inj: "inj_on g (R f)"
      using True by simp

    have fin_R: "finite (g ` R f)"
      unfolding R_def using fin_A
      by (intro finite_imageI) simp

    interpret B:balls_and_bins_abs "g ` R f" "{..<b}"
      using fin_R b_ne by unfold_locales auto

    have "range g \<subseteq> {..<C\<^sub>7 * b\<^sup>2}"
      using g_range_1 that(2) unfolding sample_space_alt[OF \<Psi>\<^sub>2.sample_space] by auto
    hence g_ran: "g ` R f \<subseteq> {..<C\<^sub>7 * b\<^sup>2}"
      by auto

    have "sample_pmf [b]\<^sub>S = pmf_of_set {..<b}"
      unfolding sample_pmf_def nat_sample_space_def by simp
    hence " map_pmf (\<lambda>\<omega>. \<omega> x) (sample_pmf (\<H> k (C\<^sub>7 * b\<^sup>2) [b]\<^sub>S)) = pmf_of_set {..<b}"
      if "x \<in> g ` R f" for x
      using g_ran \<Psi>\<^sub>3.single that by auto
    moreover have "prob_space.k_wise_indep_vars \<Psi>\<^sub>3 k (\<lambda>_. discrete) (\<lambda>x \<omega>. \<omega> x) (g ` R f)"
      by (intro prob_space.k_wise_indep_subset[OF _ _ \<Psi>\<^sub>3.\<H>_indep] g_ran prob_space_measure_pmf)
    ultimately have lim_balls_and_bins: "B.lim_balls_and_bins k (sample_pmf (\<H> k (C\<^sub>7 * b\<^sup>2) [b]\<^sub>S))"
      unfolding B.lim_balls_and_bins_def by auto

    have card_g_R: "card (g ` R f) = card (R f)"
      using True card_image by auto
    hence b_mu: "\<rho> (card (R f)) = B.\<mu>"
      unfolding B.\<mu>_def \<rho>_def using b_min by (simp add:powr_realpow)

    have card_g_le_b: "card (g ` R f) \<le> card {..<b}"
      unfolding card_g_R using True by simp

    have "?L1 \<le> measure \<Psi>\<^sub>3 {h. \<bar>B.Y h - B.\<mu>\<bar> > 9 * real (card (g ` R f)) / sqrt (card {..<b})}"
    proof (rule pmf_mono)
      fix h assume "h \<in> {h. E\<^sub>1 (f,g,h) \<and> E\<^sub>2 (f,g,h) \<and> E\<^sub>3 (f,g,h) \<and> \<not>E\<^sub>4 (f,g,h)}"
      hence b: "\<bar>p (f,g,h) -\<rho> (card (R f))\<bar> >  \<delta>/12 * card (R f)"
        unfolding E\<^sub>4_def by simp
      assume "h \<in> set_pmf (sample_pmf \<Psi>\<^sub>3)"
      hence h_range: "h x < b" for x
        unfolding sample_space_alt[OF \<Psi>\<^sub>3.sample_space,symmetric] using h_range_1 by simp

      have "{j \<in> {..<b}. int (s f) \<le> \<tau>\<^sub>1 (f, g, h) A 0 j} =
        {j \<in> {..<b}. int (s f) \<le> max (Max ({int (f a) |a. a \<in> A \<and> h (g a) = j} \<union> {-1})) (- 1)}"
        unfolding \<tau>\<^sub>1_def by simp
      also have "... = {j \<in> {..<b}. int (s f) \<le> Max ({int (f a) |a. a \<in> A \<and> h (g a) = j} \<union> {-1})}"
        using fin_A by (subst max_absorb1) (auto intro: Max_ge)
      also have "... = {j \<in> {..<b}. (\<exists>a \<in> R f. h (g a) = j)}"
        unfolding R_def using fin_A by (subst Max_ge_iff) auto
      also have "... = {j. \<exists>a \<in> R f. h (g a) = j}"
        using h_range by auto
      also have "... = (h \<circ> g) ` (R f)"
        by (auto simp add:set_eq_iff image_iff)
      also have "... = h ` (g ` (R f))"
        by (simp add:image_image)
      finally have c:"{j \<in> {..<b}. int (s f) \<le> \<tau>\<^sub>1 (f, g, h) A 0 j} = h ` (g ` R f)"
        by simp
      have "9 * real (card (g ` R f)) / sqrt (card {..<b}) = 9/ sqrt b * real (card (R f))"
        using card_image[OF g_inj] by simp
      also have "... \<le>  \<delta>/12 * card (R f)"
        by (intro mult_right_mono e_4_h) simp
      also have "... < \<bar>B.Y h - B.\<mu>\<bar>"
        using b c unfolding B.Y_def p_def b_mu by simp
      finally show "h \<in> {h. \<bar>B.Y h - B.\<mu>\<bar> >  9 * real (card (g ` R f)) / sqrt (card {..<b})}"
        by simp
    qed
    also have "... \<le> 1/2^6"
      using k_min
      by (intro B.devitation_bound[OF card_g_le_b lim_balls_and_bins]) auto
    finally show ?thesis by simp
  next
    case False
    have "?L1 \<le> measure \<Psi>\<^sub>3 {}"
    proof (rule pmf_mono)
      fix h assume b:"h \<in> {h. E\<^sub>1 (f, g, h) \<and> E\<^sub>2 (f, g, h) \<and> E\<^sub>3 (f, g, h) \<and> \<not> E\<^sub>4 (f, g, h)}"
      hence "card (R f) \<le> (2/3)*b"
        by (auto intro!: R_bound[simplified])
      hence "card (R f) \<le> b"
        by simp
      moreover have "inj_on g (R f)"
        using b by (simp add:E\<^sub>3_def)
      ultimately have "False" using False by simp
      thus "h \<in> {}" by simp
    qed
    also have "... = 0" by simp
    finally show ?thesis by simp
  qed

  have "?L = (\<integral>f. (\<integral>g.
    measure \<Psi>\<^sub>3 {h. E\<^sub>1 (f,g,h) \<and> E\<^sub>2 (f,g,h) \<and> E\<^sub>3 (f,g,h) \<and> \<not>E\<^sub>4 (f,g,h)} \<partial>\<Psi>\<^sub>2) \<partial>\<Psi>\<^sub>1)"
    unfolding sample_pmf_\<Psi> split_pair_pmf by simp
  also have "... \<le> (\<integral>f. (\<integral>g.  1/2^6  \<partial>\<Psi>\<^sub>2) \<partial>\<Psi>\<^sub>1)"
    using a \<Psi>\<^sub>1.sample_space \<Psi>\<^sub>2.sample_space
    by (intro integral_mono_AE AE_pmfI) simp_all
  also have "... = 1/2^6"
    by simp
  finally show ?thesis by simp
qed

lemma \<rho>_inverse: "\<rho>_inv (\<rho> x) = x"
proof -
  have a:"1-1/b \<noteq> 0"
    using b_min by simp

  have "\<rho> x = b * (1-(1-1/b) powr x)"
    unfolding \<rho>_def by simp
  hence "\<rho> x / real b = 1-(1-1/b) powr x" by simp
  hence "ln (1 - \<rho> x / real b) = ln ((1-1/b) powr x)" by simp
  also have "... = x * ln (1 - 1/ b)"
    using a by (intro ln_powr)
  finally have "ln (1 - \<rho> x / real b) = x * ln (1- 1/ b)"
    by simp
  moreover have "ln (1-1/b) < 0"
    using b_min by (subst ln_less_zero_iff) auto
  ultimately show ?thesis
    using \<rho>_inv_def by simp
qed

lemma rho_mono:
  assumes "x \<le> y"
  shows "\<rho> x \<le> \<rho> y"
proof-
  have "(1 - 1 / real b) powr y \<le> (1 - 1 / real b) powr x"
    using b_min
    by (intro powr_mono_rev assms) auto
  thus ?thesis
    unfolding \<rho>_def by (intro mult_left_mono) auto
qed

lemma rho_two_thirds: "\<rho> (2/3 * b) \<le> 3/5 *b"
proof -
  have "1/3 \<le> exp ( - 13 / 12::real )"
    by (approximation 8)
  also have "... \<le> exp ( - 1 - 2 / real b )"
    using b_min by (intro iffD2[OF exp_le_cancel_iff]) (simp add:algebra_simps)
  also have "... \<le> exp ( b * (-(1/real b)-2*(1/real b)^2))"
    using b_min by (simp add:algebra_simps power2_eq_square)
  also have  "... \<le> exp ( b * ln (1-1/real b))"
    using b_min
    by (intro iffD2[OF exp_le_cancel_iff] mult_left_mono ln_one_minus_pos_lower_bound) auto
  also have "... = exp ( ln ( (1-1/real b) powr b))"
    using b_min by (subst ln_powr) auto
  also have "... = (1-1/real b) powr b"
    using b_min by (subst exp_ln) auto
  finally have a:"1/3 \<le> (1-1/real b) powr b" by simp

  have "2/5 \<le> (1/3) powr (2/3::real)"
    by (approximation 5)
  also have "... \<le> ((1-1/real b) powr b) powr (2/3)"
    by (intro powr_mono2 a) auto
  also have "... = (1-1/real b) powr (2/3 * real b)"
    by (subst powr_powr) (simp add:algebra_simps)
  finally have "2/5 \<le> (1 - 1 / real b) powr (2 / 3 * real b)" by simp
  hence "1 - (1 - 1 / real b) powr (2 / 3 * real b) \<le> 3/5"
    by simp
  hence "\<rho> (2/3 * b) \<le> b * (3/5)"
    unfolding \<rho>_def by (intro mult_left_mono) auto
  thus ?thesis
    by simp
qed

definition \<rho>_inv' :: "real \<Rightarrow> real"
  where "\<rho>_inv' x = -1 / (real b * (1-x / real b) * ln (1 - 1 / real b))"

lemma \<rho>_inv'_bound:
  assumes "x \<ge> 0"
  assumes "x \<le> 59/90*b"
  shows "\<bar>\<rho>_inv' x\<bar> \<le> 4"
proof -
  have c:"ln (1 - 1 / real b) < 0"
    using b_min
    by (subst ln_less_zero_iff) auto
  hence d:"real b * (1 - x / real b) * ln (1 - 1 / real b) < 0"
    using b_min assms by (intro Rings.mult_pos_neg) auto

  have "(1::real) \<le> 31/30" by simp
  also have "... \<le> (31/30) * (b * -(- 1 / real b))"
    using b_min by simp
  also have "... \<le> (31/30) * (b * -ln (1 + (- 1 / real b)))"
    using b_min
    by (intro mult_left_mono le_imp_neg_le  ln_add_one_self_le_self2) auto
  also have "... \<le> 3 * (31/90) * (- b * ln (1 - 1 / real b))"
    by simp
  also have "... \<le> 3 * (1 - x / real b) * (- b * ln (1 - 1 / real b))"
    using assms b_min pos_divide_le_eq[where c="b"] c
    by (intro mult_right_mono mult_left_mono mult_nonpos_nonpos) auto
  also have "... \<le> 3 * (real b * (1 - x / real b) * (-ln (1 - 1 / real b)))"
    by (simp add:algebra_simps)
  finally have "3 * (real b * (1 - x / real b) * (-ln (1 - 1 / real b))) \<ge> 1" by simp
  hence "3 * (real b * (1 - x / real b) * ln (1 - 1 / real b)) \<le> -1" by simp
  hence "\<rho>_inv' x \<le> 3"
    unfolding \<rho>_inv'_def using d
    by (subst neg_divide_le_eq) auto
  moreover have "\<rho>_inv' x > 0"
    unfolding \<rho>_inv'_def using d by (intro divide_neg_neg) auto
  ultimately show ?thesis by simp
qed

lemma \<rho>_inv':
  fixes x :: real
  assumes "x < b"
  shows "DERIV \<rho>_inv x :> \<rho>_inv' x"
proof -
  have "DERIV (ln \<circ> (\<lambda>x. (1 - x / real b))) x :> 1 / (1-x / real b) * (0 -1/b)"
    using assms b_min
    by (intro DERIV_chain DERIV_ln_divide DERIV_cdivide derivative_intros) auto
  hence "DERIV \<rho>_inv x :> (1 / (1-x / real b) * (-1/b)) / ln (1-1/real b)"
    unfolding comp_def \<rho>_inv_def by (intro DERIV_cdivide) auto
  thus ?thesis
    by (simp add:\<rho>_inv'_def algebra_simps)
qed

lemma accuracy_without_cutoff:
  "measure \<Psi> {(f,g,h). \<bar>Y (f,g,h) - real X\<bar> > \<delta> * X \<or> s f < q_max} \<le> 1/2^4"
  (is "?L \<le> ?R")
proof -
  have "?L \<le> measure \<Psi> {\<psi>. \<not>E\<^sub>1 \<psi> \<or>  \<not>E\<^sub>2 \<psi> \<or>  \<not>E\<^sub>3 \<psi> \<or>  \<not>E\<^sub>4 \<psi>}"
  proof (rule pmf_rev_mono)
    fix \<psi> assume "\<psi> \<in> set_pmf (sample_pmf \<Psi>)"
    obtain f g h where \<psi>_def: "\<psi> = (f,g,h)" by (metis prod_cases3)

    assume "\<psi> \<notin> {\<psi>. \<not> E\<^sub>1 \<psi> \<or> \<not> E\<^sub>2 \<psi> \<or> \<not> E\<^sub>3 \<psi> \<or> \<not> E\<^sub>4 \<psi>}"
    hence assms: "E\<^sub>1 (f,g,h)" "E\<^sub>2 (f,g,h)" "E\<^sub>3 (f,g,h)" "E\<^sub>4 (f,g,h)"
      unfolding \<psi>_def by auto

    define I :: "real set" where "I = {0..59/90*b}"

    have "p (f,g,h) \<le> \<rho> (card (R f)) + \<delta>/12 * card (R f)"
      using assms(4) E\<^sub>4_def unfolding abs_le_iff by simp
    also have "... \<le> \<rho>(2/3*b) + 1/12* (2/3*b)"
      using \<delta>_lt_1 R_bound[OF assms(1,2)]
      by (intro add_mono rho_mono mult_mono) auto
    also have "... \<le> 3/5 * b + 1/18*b"
      by (intro add_mono rho_two_thirds) auto
    also have "... \<le> 59/90 * b"
       by simp
    finally have "p (f,g,h) \<le> 59/90 * b" by simp
    hence p_in_I: "p (f,g,h) \<in> I"
      unfolding I_def by simp

    have "\<rho> (card (R f)) \<le> \<rho>(2/3 * b)"
      using  R_bound[OF assms(1,2)]
      by (intro rho_mono) auto
    also have "... \<le> 3/5 * b"
      using rho_two_thirds by simp
    also have "... \<le> b * 59/90" by simp
    finally have "\<rho> (card (R f)) \<le> b * 59/90" by simp
    moreover have "(1 - 1 / real b) powr (real (card (R f))) \<le> 1 powr (real (card (R f)))"
      using b_min by (intro powr_mono2) auto
    hence "\<rho> (card (R f)) \<ge> 0"
      unfolding \<rho>_def by (intro mult_nonneg_nonneg) auto
    ultimately have "\<rho> (card (R f)) \<in> I"
      unfolding I_def by simp

    moreover have "interval I"
      unfolding I_def interval_def by simp
    moreover have "59 / 90 * b < b"
      using b_min by simp
    hence "DERIV \<rho>_inv x :> \<rho>_inv' x" if "x \<in> I" for x
      using that I_def by (intro \<rho>_inv') simp
    ultimately obtain \<xi> :: real where \<xi>_def: "\<xi> \<in> I"
      "\<rho>_inv (p(f,g,h)) - \<rho>_inv (\<rho> (card (R f))) = (p (f,g,h) - \<rho>(card (R f))) * \<rho>_inv' \<xi>"
      using p_in_I MVT_interval by blast

    have "\<bar>\<rho>_inv(p (f,g,h)) - card (R f)\<bar> = \<bar>\<rho>_inv(p (f,g,h)) - \<rho>_inv(\<rho>(card (R f)))\<bar>"
      by (subst \<rho>_inverse) simp
    also have "... = \<bar>(p (f,g,h) - \<rho> (card (R f)))\<bar> * \<bar>\<rho>_inv' \<xi> \<bar>"
      using \<xi>_def(2) abs_mult by simp
    also have "... \<le> \<bar>p (f,g,h) - \<rho> (card (R f))\<bar> * 4"
      using \<xi>_def(1) I_def
      by (intro mult_left_mono \<rho>_inv'_bound) auto
    also have "... \<le> ( \<delta>/12 * card (R f)) * 4"
      using assms(4) E\<^sub>4_def by (intro mult_right_mono) auto
    also have "... = \<delta>/3 * card (R f)" by simp
    finally have b: "\<bar>\<rho>_inv(p (f,g,h)) - card (R f)\<bar> \<le> \<delta>/3 * card (R f)"  by simp

    have "\<bar>\<rho>_inv(p (f,g,h)) - X / 2 ^ (s f)\<bar> \<le>
      \<bar>\<rho>_inv(p (f,g,h)) - card (R f)\<bar> + \<bar>card (R f) - X / 2 ^ (s f)\<bar>"
      by simp
    also have "... \<le> \<delta>/3 * card (R f) + \<bar>card (R f) - X / 2 ^ (s f)\<bar>"
      by (intro add_mono b) auto
    also have "... =  \<delta>/3 * \<bar>X / 2 ^ (s f) + (card (R f) - X / 2 ^ (s f))\<bar> +
      \<bar>card (R f) - X / 2 ^ (s f)\<bar>" by simp
    also have "... \<le>  \<delta>/3 * (\<bar>X / 2 ^ (s f)\<bar> + \<bar>card (R f) - X / 2 ^ (s f)\<bar>) +
      \<bar>card (R f) - X / 2 ^ (s f)\<bar>"
      using \<delta>_gt_0 by (intro mult_left_mono add_mono abs_triangle_ineq) auto
    also have "... \<le>  \<delta>/3 * \<bar>X / 2 ^ (s f)\<bar> + (1+  \<delta>/3) * \<bar>card (R f) - X / 2 ^ (s f)\<bar>"
      using \<delta>_gt_0 \<delta>_lt_1 by (simp add:algebra_simps)
    also have "... \<le>  \<delta>/3 * \<bar>X / 2 ^ s f\<bar> + (4/3) * ( \<delta> / 3 * real X / 2 ^ s f)"
      using assms(2) \<delta>_gt_0 \<delta>_lt_1
      unfolding E\<^sub>2_def by (intro add_mono mult_mono) auto
    also have "... = (7/9) * \<delta> * real X / 2^s f"
      using X_ge_1 by (subst abs_of_nonneg) auto
    also have "... \<le> 1 * \<delta> * real X / 2^s f"
      using \<delta>_gt_0 by (intro mult_mono divide_right_mono) auto
    also have "... =  \<delta> * real X / 2^s f" by simp
    finally have a:"\<bar>\<rho>_inv(p (f,g,h)) - X / 2 ^ (s f)\<bar> \<le> \<delta> * X / 2 ^ (s f)"
      by simp

    have "\<bar>Y (f, g, h) - real X\<bar> = \<bar>2 ^ (s f)\<bar> * \<bar>\<rho>_inv(p (f,g,h)) - real X / 2 ^ (s f)\<bar>"
      unfolding Y_def by (subst abs_mult[symmetric]) (simp add:algebra_simps powr_add[symmetric])
    also have "... \<le> 2 ^ (s f) * (\<delta> * X / 2 ^ (s f))"
      by (intro mult_mono a) auto
    also have "... = \<delta> * X"
      by (simp add:algebra_simps powr_add[symmetric])
    finally have "\<bar>Y (f, g, h) - real X\<bar> \<le> \<delta> * X" by simp
    moreover have "2 powr (\<lceil>log 2 (real X)\<rceil> - t f) \<le> 2 powr b_exp" (is "?L1 \<le> ?R1")
    proof -
      have "?L1 \<le> 2 powr (1 + log 2 (real X)- t f)"
        by (intro powr_mono, linarith) auto
      also have "... = 2 powr 1 * 2 powr (log 2 (real X)) * 2 powr (- t f)"
        unfolding powr_add[symmetric] by simp
      also have "... = 2 * (2 powr (-t f) * X)"
        using X_ge_1 by simp
      also have "... \<le> 2 * (b/2)"
        using assms(1) unfolding E\<^sub>1_def by (intro mult_left_mono) auto
      also have "... = b" by simp
      also have "... = ?R1"
        unfolding b_def by (simp add: powr_realpow)
      finally show ?thesis by simp
    qed
    hence "\<lceil>log 2 (real X)\<rceil> - t f \<le> real b_exp"
      unfolding not_less[symmetric] using powr_less_mono[where x="2"] by simp
    hence "s f \<ge> q_max" unfolding s_def q_max_def by (intro nat_mono) auto
    ultimately show "\<psi> \<notin> {(f, g, h). \<delta> * X < \<bar>Y (f, g, h) - real X\<bar> \<or> s f < q_max}"
      unfolding \<psi>_def by auto
  qed
  also have "... \<le>
    measure \<Psi> {\<psi>. \<not>E\<^sub>1 \<psi> \<or> \<not>E\<^sub>2 \<psi> \<or> \<not>E\<^sub>3 \<psi>} + measure \<Psi> {\<psi>. E\<^sub>1 \<psi> \<and> E\<^sub>2 \<psi> \<and> E\<^sub>3 \<psi> \<and> \<not>E\<^sub>4 \<psi>}"
    by (intro pmf_add) auto
  also have "... \<le> (measure \<Psi> {\<psi>. \<not>E\<^sub>1 \<psi> \<or> \<not>E\<^sub>2 \<psi>} + measure \<Psi> {\<psi>. E\<^sub>1 \<psi> \<and> E\<^sub>2 \<psi> \<and> \<not>E\<^sub>3 \<psi>}) + 1/2^6"
    by (intro add_mono e_4 pmf_add) auto
  also have "... \<le> ((measure \<Psi> {\<psi>. \<not>E\<^sub>1 \<psi>} + measure \<Psi> {\<psi>. E\<^sub>1 \<psi> \<and> \<not>E\<^sub>2 \<psi>}) + 1/2^6) + 1/2^6"
    by (intro add_mono e_3 pmf_add) auto
  also have "... \<le> ((1/2^6 + 1/2^6) + 1/2^6) + 1/2^6"
    by (intro add_mono e_2 e_1) auto
  also have "... = ?R" by simp
  finally show ?thesis by simp
qed

end

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               December 2004               |
            |                   June 2005  (modified)   |
            |              September 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |               November 2005  (modified)   |
            |               December 2005  (modified)   |
            |                  April 2006  (modified)   |
            |                  March 2007  (modified)   |
            |                 August 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law
imports CSP_F_law_SKIP      CSP_F_law_ref
        CSP_F_law_dist      CSP_F_law_alpha_par
        CSP_F_law_step      CSP_F_law_rep_par
        CSP_F_law_fix
        CSP_F_law_DIV       CSP_F_law_SKIP_DIV
        CSP_F_law_step_ext  CSP_F_law_norm
        CSP_T_law
begin

(*********************************************************
            SKIP , DIV  and Internal choice
 *********************************************************)

(*** |~| ***)

lemma cspF_SKIP_DIV_Int_choice:
  "[| P = SKIP | P = DIV ; Q = SKIP | Q = DIV |] ==>
   (P |~| Q) =F[M1,M2] (if (P = SKIP | Q = SKIP) then SKIP else DIV)"
apply (elim disjE)
apply (simp_all)
apply (rule cspF_rw_left)
apply (rule cspF_idem)
apply (rule cspF_reflex)
apply (rule cspF_rw_left)
apply (rule cspF_unit)
apply (rule cspF_reflex)
apply (rule cspF_rw_left)
apply (rule cspF_unit)
apply (rule cspF_reflex)
apply (rule cspF_rw_left)
apply (rule cspF_idem)
apply (rule cspF_reflex)
done

(*** !! ***)

lemma cspF_SKIP_DIV_Rep_int_choice_sum:
  "[| ALL c: sumset C. (Qf c = SKIP | Qf c = DIV) |] ==>
   (!! c:C .. Qf c) =F[M1,M2]
   (if (EX c: sumset C. Qf c = SKIP) then SKIP else DIV)"
apply (case_tac " sumset C={}")
apply (simp add: cspF_Rep_int_choice_empty)
apply (case_tac "ALL c: sumset C. Qf c = DIV")
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_const)
 apply (simp)
 apply (force)
 apply (simp)

 apply (simp)
 apply (elim bexE)
 apply (frule_tac x="c" in bspec)
 apply (simp_all)
 apply (intro conjI impI)

  apply (rule cspF_rw_left)
  apply (subgoal_tac
  "!! :C .. Qf =F[M1,M1]
   !! :({c:C. Qf c = SKIP}s Uns {c:C. Qf c ~= SKIP}s) .. Qf")
  apply (simp (no_asm))
  apply (rule cspF_decompo)
   apply (simp)
   apply (simp)

  apply (rule cspF_rw_left)
  apply (rule cspF_Rep_int_choice_union_Int)
  apply (simp)

  apply (rule cspF_rw_left)
  apply (rule cspF_decompo)
  apply (rule cspF_Rep_int_choice_const)
  apply (force)
  apply (rule ballI)
  apply (simp)
  apply (case_tac " sumset ({c:C. Qf c ~= SKIP}s) ={}")
   apply (rule cspF_Rep_int_choice_DIV)
   apply (simp)

   apply (rule cspF_rw_left)
   apply (rule cspF_Rep_int_choice_const)
   apply (simp_all)
   apply (intro allI impI)
   apply (subgoal_tac "Qf ca = DIV")
   apply (simp)
   apply (force)
   apply (simp)

  apply (rule cspF_rw_left)
  apply (rule cspF_unit)
  apply (simp)
done

lemma cspF_SKIP_DIV_Rep_int_choice_nat:
  "[| ALL n:N. (Qf n = SKIP | Qf n = DIV) |] ==>
   (!nat n:N .. Qf n) =F[M1,M2]
   (if (EX n:N. Qf n = SKIP) then SKIP else DIV)"
apply (unfold Rep_int_choice_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_SKIP_DIV_Rep_int_choice_sum)
apply (auto)
done

lemma cspF_SKIP_DIV_Rep_int_choice_set:
  "[| ALL X:Xs. (Qf X = SKIP | Qf X = DIV) |] ==>
   (!set X:Xs .. Qf X) =F[M1,M2]
   (if (EX X:Xs. Qf X = SKIP) then SKIP else DIV)"
apply (unfold Rep_int_choice_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_SKIP_DIV_Rep_int_choice_sum)
apply (auto)
done

lemmas cspF_SKIP_DIV_Rep_int_choice =
       cspF_SKIP_DIV_Rep_int_choice_sum
       cspF_SKIP_DIV_Rep_int_choice_nat
       cspF_SKIP_DIV_Rep_int_choice_set

end