diff --git a/thys/Approximation_Algorithms/Approx_MIS_Hoare.thy b/thys/Approximation_Algorithms/Approx_MIS_Hoare.thy
--- a/thys/Approximation_Algorithms/Approx_MIS_Hoare.thy
+++ b/thys/Approximation_Algorithms/Approx_MIS_Hoare.thy
@@ -1,561 +1,564 @@
 section "Independent Set"
 
 theory Approx_MIS_Hoare
 imports
   "HOL-Hoare.Hoare_Logic"
   "HOL-Library.Disjoint_Sets"
 begin
 
 
 text \<open>The algorithm is classical, the proofs are inspired by the ones
 by Berghammer and M\"uller-Olm \cite{BerghammerM03}.
 In particular the approximation ratio is improved from \<open>\<Delta>+1\<close> to \<open>\<Delta>\<close>.\<close>
 
 
 subsection "Graph"
 
 text \<open>A set set is simply a set of edges, where an edge is a 2-element set.\<close>
 
 definition independent_vertices :: "'a set set \<Rightarrow> 'a set \<Rightarrow> bool" where
 "independent_vertices E S \<longleftrightarrow> S \<subseteq> \<Union>E \<and> (\<forall>v1 v2. v1 \<in> S \<and> v2 \<in> S \<longrightarrow> {v1, v2} \<notin> E)"
 
 locale Graph_E =
   fixes E :: "'a set set"
   assumes finite_E: "finite E"
   assumes edges2: "e \<in> E \<Longrightarrow> card e = 2"
 begin
 
 fun vertices :: "'a set set \<Rightarrow> 'a set" where
 "vertices G = \<Union>G"
 
 abbreviation V :: "'a set" where
 "V \<equiv> vertices E"
 
 definition approximation_miv :: "nat \<Rightarrow> 'a set \<Rightarrow> bool" where
 "approximation_miv n S \<longleftrightarrow> independent_vertices E S \<and> (\<forall>S'. independent_vertices E S' \<longrightarrow> card S' \<le> card S * n)"
 
 fun neighbors :: "'a \<Rightarrow> 'a set" where
 "neighbors v = {u. {u,v} \<in> E}"
 
 fun degree_vertex :: "'a \<Rightarrow> nat" where
 "degree_vertex v = card (neighbors v)"
 
 abbreviation \<Delta> :: nat where
 "\<Delta> \<equiv> Max{degree_vertex u|u. u \<in> V}"
 
 lemma finite_edges: "e \<in> E \<Longrightarrow> finite e"
   using card_ge_0_finite and edges2 by force
 
 lemma finite_V: "finite V"
   using finite_edges and finite_E by auto
 
+lemma neighbors_subset_V: "neighbors u \<subseteq> V"
+by auto
+
 lemma finite_neighbors: "finite (neighbors u)"
-  using finite_V and rev_finite_subset [of V "neighbors u"] by auto
+  using finite_V neighbors_subset_V[of u] by (simp)
 
 lemma independent_vertices_finite: "independent_vertices E S \<Longrightarrow> finite S"
   by (metis rev_finite_subset independent_vertices_def vertices.simps finite_V)
 
 lemma edge_ex_vertices: "e \<in> E \<Longrightarrow> \<exists>u v. u \<noteq> v \<and> e = {u, v}"
 proof -
   assume "e \<in> E"
   then have "card e = Suc (Suc 0)" using edges2 by auto
   then show "\<exists>u v. u \<noteq> v \<and> e = {u, v}"
     by (metis card_eq_SucD insertI1)
 qed
 
 lemma \<Delta>_pos [simp]: "E = {} \<or> 0 < \<Delta>"
 proof cases
   assume "E = {}"
   then show "E = {} \<or> 0 < \<Delta>" by auto
 next
   assume 1: "E \<noteq> {}"
   then have "V \<noteq> {}" using edges2 by fastforce
   moreover have "finite {degree_vertex u |u. u \<in> V}"
     by (metis finite_V finite_imageI Setcompr_eq_image)
   ultimately have 2: "\<Delta> \<in> {degree_vertex u |u. u \<in> V}" using Max_in by auto
   have "\<Delta> \<noteq> 0"
   proof
     assume "\<Delta> = 0"
     with 2 obtain u where 3: "u \<in> V" and 4: "degree_vertex u = 0" by auto
     from 3 obtain e where 5: "e \<in> E" and "u \<in> e" by auto
     moreover with 4 have "\<forall>v. {u, v} \<noteq> e" using finite_neighbors insert_absorb by fastforce
     ultimately show False using edge_ex_vertices by auto
   qed
   then show "E = {} \<or> 0 < \<Delta>" by auto
 qed
 
 lemma \<Delta>_max_degree: "u \<in> V \<Longrightarrow> degree_vertex u \<le> \<Delta>"
 proof -
   assume H: "u \<in> V"
   have "finite {degree_vertex u |u. u \<in> V}"
     by (metis finite_V finite_imageI Setcompr_eq_image)
   with H show "degree_vertex u \<le> \<Delta>" using Max_ge by auto
 qed
 
 subsection \<open>Wei's algorithm: \<open>(\<Delta>+1)\<close>-approximation\<close>
 
 text \<open>The 'functional' part of the invariant, used to prove that the algorithm produces an independent set of vertices.\<close>
 
 definition inv_iv :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" where
 "inv_iv S X \<longleftrightarrow> independent_vertices E S
             \<and> X \<subseteq> V
             \<and> (\<forall>v1 \<in> (V - X). \<forall>v2 \<in> S. {v1, v2} \<notin> E)
             \<and> S \<subseteq> X"
 
 text \<open>Strenghten the invariant with an approximation ratio \<open>r\<close>:\<close>
 
 definition inv_approx :: "'a set \<Rightarrow> 'a set \<Rightarrow> nat \<Rightarrow> bool" where
 "inv_approx S X r \<longleftrightarrow> inv_iv S X \<and> card X \<le> card S * r"
 
 text \<open>Preservation of the functional invariant:\<close>
 
 lemma inv_preserv:
   fixes S :: "'a set"
     and X :: "'a set"
     and x :: "'a"
   assumes inv: "inv_iv S X"
       and x_def: "x \<in> V - X"
     shows "inv_iv (insert x S) (X \<union> neighbors x \<union> {x})"
 proof -
   have inv1: "independent_vertices E S"
    and inv2: "X \<subseteq> V"
    and inv3: "S \<subseteq> X"
    and inv4: "\<forall>v1 v2. v1 \<in> (V - X) \<and> v2 \<in> S \<longrightarrow> {v1, v2} \<notin> E"
     using inv unfolding inv_iv_def by auto
   have finite_S: "finite S" using inv1 and independent_vertices_finite by auto
   have S1: "\<forall>y \<in> S. {x, y} \<notin> E" using inv4 and x_def by blast
   have S2: "\<forall>x \<in> S. \<forall>y \<in> S. {x, y} \<notin> E" using inv1 unfolding independent_vertices_def by metis
   have S3: "v1 \<in> insert x S \<Longrightarrow> v2 \<in> insert x S \<Longrightarrow> {v1, v2} \<notin> E" for v1 v2
     proof -
       assume "v1 \<in> insert x S" and "v2 \<in> insert x S"
       then consider
           (a) "v1 = x" and "v2 = x"
         | (b) "v1 = x" and "v2 \<in> S"
         | (c) "v1 \<in> S" and "v2 = x"
         | (d) "v1 \<in> S" and "v2 \<in> S"
         by auto
       then show "{v1, v2} \<notin> E"
       proof cases
         case a then show ?thesis using edges2 by force
       next
         case b then show ?thesis using S1 by auto
       next
         case c then show ?thesis using S1 by (metis doubleton_eq_iff)
       next
         case d then show ?thesis using S2 by auto
       qed
     qed
   (* invariant conjunct 1 *)
   have "independent_vertices E (insert x S)"
     using S3 and inv1 and x_def unfolding independent_vertices_def by auto
   (* invariant conjunct 2 *)
   moreover have "X \<union> neighbors x \<union> {x} \<subseteq> V"
   proof
     fix xa
     assume "xa \<in> X \<union> neighbors x \<union> {x}"
     then consider (a) "xa \<in> X" | (b) "xa \<in> neighbors x" | (c) "xa = x" by auto
     then show "xa \<in> V"
     proof cases
       case a
       then show ?thesis using inv2 by blast
     next
       case b
       then show ?thesis by auto
     next
       case c
       then show ?thesis using x_def by blast
     qed
   qed
   (* invariant conjunct 3 *)
   moreover have "insert x S \<subseteq> X \<union> neighbors x \<union> {x}" using inv3 by auto
   (* invariant conjunct 4 *)
   moreover have "v1 \<in> V - (X \<union> neighbors x \<union> {x}) \<Longrightarrow> v2 \<in> insert x S \<Longrightarrow> {v1, v2} \<notin> E" for v1 v2
   proof -
     assume H: "v1 \<in> V - (X \<union> neighbors x \<union> {x})" and "v2 \<in> insert x S"
     then consider (a) "v2 = x" | (b) "v2 \<in> S" by auto
     then show "{v1, v2} \<notin> E"
     proof cases
       case a
       with H have "v1 \<notin> neighbors v2" by blast
       then show ?thesis by auto
     next
       case b
       from H have "v1 \<in> V - X" by blast
       with b and inv4 show ?thesis by blast
     qed
   qed
   (* conclusion *)
   ultimately show "inv_iv (insert x S) (X \<union> neighbors x \<union> {x})" unfolding inv_iv_def by blast
 qed
 
 lemma inv_approx_preserv:
   assumes inv: "inv_approx S X (\<Delta> + 1)"
       and x_def: "x \<in> V - X"
     shows "inv_approx (insert x S) (X \<union> neighbors x \<union> {x}) (\<Delta> + 1)"
 proof -
   have finite_S: "finite S" using inv and independent_vertices_finite
     unfolding inv_approx_def inv_iv_def by auto
   have Sx: "x \<notin> S" using inv and x_def unfolding inv_approx_def inv_iv_def by blast
   (* main invariant is preserved *)
   from inv have "inv_iv S X" unfolding inv_approx_def by auto
   with x_def have "inv_iv (insert x S) (X \<union> neighbors x \<union> {x})"
   proof (intro inv_preserv, auto) qed
   (* the approximation ratio is preserved (at most \<Delta>+1 vertices are removed in any iteration) *)
   moreover have "card (X \<union> neighbors x \<union> {x}) \<le> card (insert x S) * (\<Delta> + 1)"
   proof -
     have "degree_vertex x \<le> \<Delta>" using \<Delta>_max_degree and x_def by auto
     then have "card (neighbors x \<union> {x}) \<le> \<Delta> + 1" using card_Un_le [of "neighbors x" "{x}"] by auto
     then have "card (X \<union> neighbors x \<union> {x}) \<le> card X + \<Delta> + 1" using card_Un_le [of X "neighbors x \<union> {x}"] by auto
     also have "... \<le> card S * (\<Delta> + 1) + \<Delta> + 1" using inv unfolding inv_approx_def by auto
     also have "... = card (insert x S) * (\<Delta> + 1)" using finite_S and Sx by auto
     finally show ?thesis .
   qed
   (* conclusion *)
   ultimately show "inv_approx (insert x S) (X \<union> neighbors x \<union> {x}) (\<Delta> + 1)"
     unfolding inv_approx_def by auto
 qed
 
 (* the antecedent combines inv_approx (for an arbitrary ratio r) and the negated post-condition *)
 lemma inv_approx: "independent_vertices E S \<Longrightarrow> card V \<le> card S * r \<Longrightarrow> approximation_miv r S"
 proof -
   assume 1: "independent_vertices E S" and 2: "card V \<le> card S * r"
   have "independent_vertices E S' \<Longrightarrow> card S' \<le> card S * r" for S'
   proof -
     assume  "independent_vertices E S'"
     then have "S' \<subseteq> V" unfolding independent_vertices_def by auto
     then have "card S' \<le> card V" using finite_V and card_mono by auto
     also have "... \<le> card S * r" using 2 by auto
     finally show "card S' \<le> card S * r" .
   qed
   with 1 show "approximation_miv r S" unfolding approximation_miv_def by auto
 qed
 
 theorem wei_approx_\<Delta>_plus_1:
 "VARS (S :: 'a set) (X :: 'a set) (x :: 'a)
   { True }
   S := {};
   X := {};
   WHILE X \<noteq> V
   INV { inv_approx S X (\<Delta> + 1) }
   DO x := (SOME x. x \<in> V - X);
      S := insert x S;
      X := X \<union> neighbors x \<union> {x}
   OD
   { approximation_miv (\<Delta> + 1) S }"
 proof (vcg, goal_cases)
   case (1 S X x) (* invariant initially true *)
   then show ?case unfolding inv_approx_def inv_iv_def independent_vertices_def by auto
 next
   case (2 S X x) (* invariant preserved by loop *)
   (* definedness of assignment *)
   let ?x = "(SOME x. x \<in> V - X)"
   have "V - X \<noteq> {}" using 2 unfolding inv_approx_def inv_iv_def by blast
   then have "?x \<in> V - X" using some_in_eq by metis
   with 2 show ?case using inv_approx_preserv by auto
 next
   case (3 S X x) (* invariant implies post-condition *)
   then show ?case using inv_approx unfolding inv_approx_def inv_iv_def by auto
 qed
 
 
 subsection \<open>Wei's algorithm: \<open>\<Delta>\<close>-approximation\<close>
 
 text \<open>The previous approximation uses very little information about the optimal solution (it has at most as many vertices as the set itself). With some extra effort we can improve the ratio to \<open>\<Delta>\<close> instead of \<open>\<Delta>+1\<close>. In order to do that we must show that among the vertices removed in each iteration, at most \<open>\<Delta>\<close> could belong to an optimal solution. This requires carrying around a set \<open>P\<close> (via a ghost variable) which records the vertices deleted in each iteration.\<close>
 
 definition inv_partition :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set set \<Rightarrow> bool" where
 "inv_partition S X P \<longleftrightarrow> inv_iv S X
                      \<and> \<Union>P = X
                      \<and> (\<forall>p \<in> P. \<exists>s \<in> V. p = {s} \<union> neighbors s)
                      \<and> card P = card S
                      \<and> finite P"
 
 lemma inv_partition_preserv:
   assumes inv: "inv_partition S X P"
       and x_def: "x \<in> V - X"
     shows "inv_partition (insert x S) (X \<union> neighbors x \<union> {x}) (insert ({x} \<union> neighbors x) P)"
 proof -
   have finite_S: "finite S" using inv and independent_vertices_finite
     unfolding inv_partition_def inv_iv_def by auto
   have Sx: "x \<notin> S" using inv and x_def unfolding inv_partition_def inv_iv_def by blast
   (* main invariant is preserved *)
   from inv have "inv_iv S X" unfolding inv_partition_def by auto
   with x_def have "inv_iv (insert x S) (X \<union> neighbors x \<union> {x})"
   proof (intro inv_preserv, auto) qed
   (* conjunct 1 *)
   moreover have "\<Union>(insert ({x} \<union> neighbors x) P) = X \<union> neighbors x \<union> {x}"
     using inv unfolding inv_partition_def by auto
   (* conjunct 2 *)
   moreover have "(\<forall>p\<in>insert ({x} \<union> neighbors x) P. \<exists>s \<in> V. p = {s} \<union> neighbors s)"
     using inv and x_def unfolding inv_partition_def by auto
   (* conjunct 3 *)
   moreover have "card (insert ({x} \<union> neighbors x) P) = card (insert x S)"
   proof -
     from x_def and inv have "x \<notin> \<Union>P" unfolding inv_partition_def by auto
     then have "{x} \<union> neighbors x \<notin> P" by auto
     then have "card (insert ({x} \<union> neighbors x) P) = card P + 1" using inv unfolding inv_partition_def by auto
     moreover have "card (insert x S) = card S + 1" using Sx and finite_S by auto
     ultimately show ?thesis using inv unfolding inv_partition_def by auto
   qed
   (* conjunct 4 *)
   moreover have "finite (insert ({x} \<union> neighbors x) P)"
     using inv unfolding inv_partition_def by auto
   (* conclusion *)
   ultimately show "inv_partition (insert x S) (X \<union> neighbors x \<union> {x}) (insert ({x} \<union> neighbors x) P)"
     unfolding inv_partition_def by auto
 qed
 
 lemma card_Union_le_sum_card:
   fixes U :: "'a set set"
   assumes "\<forall>u \<in> U. finite u"
   shows "card (\<Union>U) \<le> sum card U"
 proof (cases "finite U")
   case False
   then show "card (\<Union>U) \<le> sum card U"
     using card_eq_0_iff finite_UnionD by auto
 next
   case True
   then show "card (\<Union>U) \<le> sum card U"
   proof (induct U rule: finite_induct)
     case empty
     then show ?case by auto
   next
     case (insert x F)
     then have "card(\<Union>(insert x F)) \<le> card(x) + card (\<Union>F)" using card_Un_le by auto
     also have "... \<le> card(x) + sum card F" using insert.hyps by auto
     also have "... = sum card (insert x F)" using sum.insert_if and insert.hyps by auto
     finally show ?case .
   qed
 qed
 
 (* this lemma could be more generally about U :: "nat set", but this makes its application more difficult later *)
 lemma sum_card:
   fixes U :: "'a set set"
     and n :: nat
   assumes "\<forall>S \<in> U. card S \<le> n"
   shows "sum card U \<le> card U * n"
 proof cases
   assume "infinite U \<or> U = {}"
   then have "sum card U = 0" using sum.infinite by auto
   then show "sum card U \<le> card U * n" by auto
 next
   assume "\<not>(infinite U \<or> U = {})"
   with assms have "finite U" and "U \<noteq> {}"and "\<forall>S \<in> U. card S \<le> n" by auto
   then show "sum card U \<le> card U * n"
   proof (induct U rule: finite_ne_induct)
     case (singleton x)
     then show ?case by auto
   next
     case (insert x F)
     assume "\<forall>S\<in>insert x F. card S \<le> n"
     then have 1:"card x \<le> n" and 2:"sum card F \<le> card F * n" using insert.hyps by auto
     then have "sum card (insert x F) = card x + sum card F" using sum.insert_if and insert.hyps by auto
     also have "... \<le> n + card F * n" using 1 and 2 by auto
     also have "... = card (insert x F) * n" using card_insert_if and insert.hyps by auto
     finally show ?case .
   qed
 qed
 
 (* among the vertices deleted in each iteration, at most \<Delta> can belong to an independent set of
    vertices: the chosen vertex or (some of) its neighbors *)
 lemma x_or_neighbors:
   fixes P :: "'a set set"
     and S :: "'a set"
   assumes inv: "\<forall>p\<in>P. \<exists>s \<in> V. p = {s} \<union> neighbors s"
       and ivS: "independent_vertices E S"
     shows "\<forall>p \<in> P. card (S \<inter> p) \<le> \<Delta>"
 proof
   fix p
   assume "p \<in> P"
   then obtain s where 1: "s \<in> V \<and> p = {s} \<union> neighbors s" using inv by blast
   then show "card (S \<inter> p) \<le> \<Delta>"
   proof cases
     assume "s \<in> S"
     then have "S \<inter> neighbors s = {}" using ivS unfolding independent_vertices_def by auto
     then have "S \<inter> p \<subseteq> {s}" using 1 by auto
     then have 2: "card (S \<inter> p) \<le> 1" using subset_singletonD by fastforce
     consider (a) "E = {}" | (b) "0 < \<Delta>" using \<Delta>_pos by auto
     then show "card (S \<inter> p) \<le> \<Delta>"
     proof cases
       case a
       then have "S = {}" using ivS unfolding independent_vertices_def by auto
       then show ?thesis by auto
     next
       case b
       then show ?thesis using 2 by auto
     qed  
   next
     assume "s \<notin> S"
     with 1 have "S \<inter> p \<subseteq> neighbors s" by auto
     then have "card (S \<inter> p) \<le> degree_vertex s" using card_mono and finite_neighbors by auto
     then show "card (S \<inter> p) \<le> \<Delta>" using 1 and \<Delta>_max_degree [of s] by auto
   qed
 qed
 
 (* the premise combines the invariant and the negated post-condition *)
 lemma inv_partition_approx: "inv_partition S V P \<Longrightarrow> approximation_miv \<Delta> S"
 proof -
   assume H1: "inv_partition S V P"
   then have "independent_vertices E S" unfolding inv_partition_def inv_iv_def by auto
   moreover have "independent_vertices E S' \<Longrightarrow> card S' \<le> card S * \<Delta>" for S'
   proof -
     let ?I = "{S' \<inter> p | p. p \<in> P}"
     (* split the optimal solution among the sets of P, which cover V so no element is
        lost. We obtain a cover of S' and show the required bound on its cardinality *)
     assume H2: "independent_vertices E S'"
     then have "S' \<subseteq> V" unfolding independent_vertices_def using vertices.simps by blast
     with H1 have "S' = S' \<inter> \<Union>P" unfolding inv_partition_def by auto
     then have "S' = (\<Union>p \<in> P. S' \<inter> p)" using Int_Union by auto
     then have "S' = \<Union>?I" by blast
     moreover have "finite S'" using H2 and independent_vertices_finite by auto
     then have "p \<in> P \<Longrightarrow> finite (S' \<inter> p)" for p by auto
     ultimately have "card S' \<le> sum card ?I" using card_Union_le_sum_card [of ?I] by auto
     also have "... \<le> card ?I * \<Delta>"
       using x_or_neighbors [of P S']
         and sum_card [of ?I \<Delta>]
         and H1 and H2 unfolding inv_partition_def by auto
     also have "... \<le> card P * \<Delta>"
     proof -
       have "finite P" using H1 unfolding inv_partition_def by auto
       then have "card ?I \<le> card P"
         using Setcompr_eq_image [of "\<lambda>p. S' \<inter> p" P]
           and card_image_le unfolding inv_partition_def by auto
       then show ?thesis by auto
     qed
     also have "... = card S * \<Delta>" using H1 unfolding inv_partition_def by auto
     ultimately show "card S' \<le> card S * \<Delta>" by auto
   qed
   ultimately show "approximation_miv \<Delta> S" unfolding approximation_miv_def by auto
 qed
 
 theorem wei_approx_\<Delta>:
 "VARS (S :: 'a set) (X :: 'a set) (x :: 'a)
   { True }
   S := {};
   X := {};
   WHILE X \<noteq> V
   INV { \<exists>P. inv_partition S X P }
   DO x := (SOME x. x \<in> V - X);
      S := insert x S;
      X := X \<union> neighbors x \<union> {x}
   OD
   { approximation_miv \<Delta> S }"
 proof (vcg, goal_cases)
   case (1 S X x) (* invariant initially true *)
   (* the invariant is initially true with the ghost variable P := {} *)
   have "inv_partition {} {} {}" unfolding inv_partition_def inv_iv_def independent_vertices_def by auto
   then show ?case by auto
 next
   case (2 S X x) (* invariant preserved by loop *)
   (* definedness of assignment *)
   let ?x = "(SOME x. x \<in> V - X)"
   from 2 obtain P where I: "inv_partition S X P" by auto 
   then have "V - X \<noteq> {}" using 2 unfolding inv_partition_def by auto
   then have "?x \<in> V - X" using some_in_eq by metis
   (* show that the invariant is true with the ghost variable P := insert ({?x} \<union> neighbors ?x) P *)
   with I have "inv_partition (insert ?x S) (X \<union> neighbors ?x \<union> {?x}) (insert ({?x} \<union> neighbors ?x) P)"
     using inv_partition_preserv by blast
   then show ?case by auto
 next
   case (3 S X x) (* invariant implies post-condition *)
   then show ?case using inv_partition_approx unfolding inv_approx_def by auto
 qed
 
 subsection "Wei's algorithm with dynamically computed approximation ratio"
 
 text \<open>In this subsection, we augment the algorithm with a variable used to compute the effective approximation ratio of the solution. In addition, the vertex of smallest degree is picked. With this heuristic, the algorithm achieves an approximation ratio of \<open>(\<Delta>+2)/3\<close>, but this is not proved here.\<close>
 
 definition vertex_heuristic :: "'a set \<Rightarrow> 'a \<Rightarrow> bool" where
 "vertex_heuristic X v = (\<forall>u \<in> V - X. card (neighbors v - X) \<le> card (neighbors u - X))"
 
 (* this lemma is needed to show that there exist a vertex to be picked by the heuristic *)
 lemma ex_min_finite_set:
   fixes S :: "'a set"
     and f :: "'a \<Rightarrow> nat"
     shows "finite S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> \<exists>x. x \<in> S \<and> (\<forall>y \<in> S. f x \<le> f y)"
           (is "?P1 \<Longrightarrow> ?P2 \<Longrightarrow> \<exists>x. ?minf S x")
 proof (induct S rule: finite_ne_induct)
   case (singleton x)
   have "?minf {x} x" by auto
   then show ?case by auto
 next
   case (insert x F)
   from insert(4) obtain y where Py: "?minf F y" by auto
   show "\<exists>z. ?minf (insert x F) z"
   proof cases
     assume "f x < f y"
     then have "?minf (insert x F) x" using Py by auto
     then show ?case by auto
   next
     assume "\<not>f x < f y"
     then have "?minf (insert x F) y" using Py by auto
     then show ?case by auto
   qed
 qed
 
 lemma inv_approx_preserv2:
   fixes S :: "'a set"
     and X :: "'a set"
     and s :: nat
     and x :: "'a"
   assumes inv: "inv_approx S X s"
       and x_def: "x \<in> V - X"
     shows "inv_approx (insert x S) (X \<union> neighbors x \<union> {x}) (max (card (neighbors x \<union> {x} - X)) s)"
 proof -
   have finite_S: "finite S" using inv and independent_vertices_finite unfolding inv_approx_def inv_iv_def by auto
   have Sx: "x \<notin> S" using inv and x_def unfolding inv_approx_def inv_iv_def by blast
   (* main invariant is preserved *)
   from inv have "inv_iv S X" unfolding inv_approx_def by auto
   with x_def have "inv_iv (insert x S) (X \<union> neighbors x \<union> {x})"
   proof (intro inv_preserv, auto) qed
   (* the approximation ratio is preserved *)
   moreover have "card (X \<union> neighbors x \<union> {x}) \<le> card (insert x S) * max (card (neighbors x \<union> {x} - X)) s"
   proof -
     let ?N = "neighbors x \<union> {x} - X"
     have "card (X \<union> ?N) \<le> card X + card ?N" using card_Un_le [of X ?N] by auto
     also have "... \<le> card S * s + card ?N" using inv unfolding inv_approx_def by auto
     also have "... \<le> card S * max (card ?N) s + card ?N" by auto
     also have "... \<le> card S * max (card ?N) s + max (card ?N) s" by auto
     also have "... = card (insert x S) * max (card ?N) s" using Sx and finite_S by auto
     finally show ?thesis by auto
   qed
   (* conclusion *)
   ultimately show "inv_approx (insert x S) (X \<union> neighbors x \<union> {x}) (max (card (neighbors x \<union> {x} - X)) s)"
     unfolding inv_approx_def by auto
 qed
 
 theorem wei_approx_min_degree_heuristic:
 "VARS (S :: 'a set) (X :: 'a set) (x :: 'a) (r :: nat)
   { True }
   S := {};
   X := {};
   r := 0;
   WHILE X \<noteq> V
   INV { inv_approx S X r }
   DO x := (SOME x. x \<in> V - X \<and> vertex_heuristic X x);
      S := insert x S;
      r := max (card (neighbors x \<union> {x} - X)) r;
      X := X \<union> neighbors x \<union> {x}
   OD
   { approximation_miv r S }"
 proof (vcg, goal_cases)
   case (1 S X x r) (* invariant initially true *)
   then show ?case unfolding inv_approx_def inv_iv_def independent_vertices_def by auto
 next
   case (2 S X x r) (* invariant preserved by loop *)
   (* definedness of assignment *)
   let ?x = "(SOME x. x \<in> V - X \<and> vertex_heuristic X x)"
   have "V - X \<noteq> {}" using 2 unfolding inv_approx_def inv_iv_def by blast
   moreover have "finite (V - X)" using 2 and finite_V by auto
   ultimately have "\<exists>x. x \<in> V - X \<and> vertex_heuristic X x"
     using ex_min_finite_set [where ?f = "\<lambda>x. card (neighbors x - X)"]
     unfolding vertex_heuristic_def by auto
   then have x_def: "?x \<in> V - X \<and> vertex_heuristic X ?x"
     using someI_ex [where ?P = "\<lambda>x. x \<in> V - X \<and> vertex_heuristic X x"] by auto
   with 2 show ?case using inv_approx_preserv2 by auto
 next
   case (3 S X x r)
   then show ?case using inv_approx unfolding inv_approx_def inv_iv_def by auto
 qed
 
 end
 end
\ No newline at end of file
diff --git a/thys/Buildings/Simplicial.thy b/thys/Buildings/Simplicial.thy
--- a/thys/Buildings/Simplicial.thy
+++ b/thys/Buildings/Simplicial.thy
@@ -1,749 +1,748 @@
 section \<open>Simplicial complexes\<close>
 
 text \<open>
   In this section we develop the basic theory of abstract simplicial complexes as a collection of
   finite sets, where the power set of each member set is contained in the collection. Note that in
   this development we allow the empty simplex, since allowing it or not seemed of no logical
   consequence, but of some small practical consequence. 
 \<close>
 
 theory Simplicial
 imports Prelim
 
 begin
 
 subsection \<open>Geometric notions\<close>
 
 text \<open>
   The geometric notions attached to a simplicial complex of main interest to us are those of facets
   (subsets of codimension one), adjacency (sharing a facet in common), and chains of adjacent
   simplices.
 \<close>
 
 subsubsection \<open>Facets\<close>
 
 definition facetrel :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" (infix "\<lhd>" 60)
   where "y \<lhd> x \<equiv> \<exists>v. v \<notin> y \<and> x = insert v y"
 
 lemma facetrelI: "v \<notin> y \<Longrightarrow> x = insert v y \<Longrightarrow> y \<lhd> x"
   using facetrel_def by fast
 
 lemma facetrelI_card: "y \<subseteq> x \<Longrightarrow> card (x-y) = 1 \<Longrightarrow> y \<lhd> x"
   using card1[of "x-y"] by (blast intro: facetrelI)
 
 lemma facetrel_complement_vertex: "y\<lhd>x \<Longrightarrow> x = insert v y \<Longrightarrow> v\<notin>y"
   using facetrel_def[of y x] by fastforce
 
 lemma facetrel_diff_vertex: "v\<in>x \<Longrightarrow> x-{v} \<lhd> x"
   by (auto intro: facetrelI)
 
 lemma facetrel_conv_insert: "y \<lhd> x \<Longrightarrow> v \<in> x - y \<Longrightarrow> x = insert v y"
   unfolding facetrel_def by fast
 
 lemma facetrel_psubset: "y \<lhd> x \<Longrightarrow> y \<subset> x"
   unfolding facetrel_def by fast
 
 lemma facetrel_subset: "y \<lhd> x \<Longrightarrow> y \<subseteq> x"
   using facetrel_psubset by fast
 
 lemma facetrel_card: "y \<lhd> x \<Longrightarrow> card (x-y) = 1"
   using insert_Diff_if[of _ y y] unfolding facetrel_def by fastforce
 
 lemma finite_facetrel_card: "finite x \<Longrightarrow> y\<lhd>x \<Longrightarrow> card x = Suc (card y)"
   using facetrel_def[of y x] card_insert_disjoint[of x] by auto
 
 lemma facetrelI_cardSuc: "z\<subseteq>x \<Longrightarrow> card x = Suc (card z) \<Longrightarrow> z\<lhd>x"
-  using card_ge_0_finite finite_subset[of z] card_Diff_subset[of z x]
-  by    (force intro: facetrelI_card)
+  using card_ge_0_finite[of x] card_Diff_subset[of z x] by (auto intro: facetrelI_card)
 
 lemma facet2_subset: "\<lbrakk> z\<lhd>x; z\<lhd>y; x\<inter>y - z \<noteq> {} \<rbrakk> \<Longrightarrow> x \<subseteq> y"
   unfolding facetrel_def by force
 
 lemma inj_on_pullback_facet:
   assumes "inj_on f x" "z \<lhd> f`x"
   obtains y where "y \<lhd> x" "f`y = z"
 proof
   from assms(2) obtain v where v: "v\<notin>z" "f`x = insert v z"
     using facetrel_def[of z] by auto
   define u and y where "u \<equiv> the_inv_into x f v" and y: "y \<equiv> {v\<in>x. f v \<in> z}"
   moreover with assms(2) v have "x = insert u y"
     using the_inv_into_f_eq[OF assms(1)] the_inv_into_into[OF assms(1)]
     by fastforce
   ultimately show "y \<lhd> x"
     using v f_the_inv_into_f[OF assms(1)] by (force intro: facetrelI)
   from y assms(2) show "f`y = z" using facetrel_subset by fast
 qed
 
 
 subsubsection \<open>Adjacency\<close>
 
 definition adjacent :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" (infix "\<sim>" 70)
   where "x \<sim> y \<equiv> \<exists>z. z\<lhd>x \<and> z\<lhd>y"
 
 lemma adjacentI: "z\<lhd>x \<Longrightarrow> z\<lhd>y \<Longrightarrow> x \<sim> y"
   using adjacent_def by fast
 
 lemma empty_not_adjacent: "\<not> {} \<sim> x"
   unfolding facetrel_def adjacent_def by fast
 
 lemma adjacent_sym: "x \<sim> y \<Longrightarrow> y \<sim> x"
   unfolding adjacent_def by fast
 
 lemma adjacent_refl:
   assumes "x \<noteq> {}"
   shows   "x \<sim> x"
 proof-
   from assms obtain v where v: "v\<in>x" by fast
   thus "x \<sim> x" using facetrelI[of v "x-{v}"] unfolding adjacent_def by fast
 qed
 
 lemma common_facet: "\<lbrakk> z\<lhd>x; z\<lhd>y; x \<noteq> y \<rbrakk> \<Longrightarrow> z = x \<inter> y"
   using facetrel_subset facet2_subset by fast
 
 lemma adjacent_int_facet1: "x \<sim> y \<Longrightarrow> x \<noteq> y \<Longrightarrow> (x \<inter> y) \<lhd> x"
   using common_facet unfolding adjacent_def by fast
 
 lemma adjacent_int_facet2: "x \<sim> y \<Longrightarrow> x \<noteq> y \<Longrightarrow> (x \<inter> y) \<lhd> y"
   using adjacent_sym adjacent_int_facet1 by (fastforce simp add: Int_commute)
 
 lemma adjacent_conv_insert: "x \<sim> y \<Longrightarrow> v \<in> x - y \<Longrightarrow> x = insert v (x\<inter>y)"
   using adjacent_int_facet1 facetrel_conv_insert by fast
 
 lemma adjacent_int_decomp:
   "x \<sim> y \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<exists>v. v \<notin> y \<and> x = insert v (x\<inter>y)"
   using adjacent_int_facet1 unfolding facetrel_def by fast
 
 lemma adj_antivertex:
   assumes "x\<sim>y" "x\<noteq>y"
   shows   "\<exists>!v. v\<in>x-y"
 proof (rule ex_ex1I)
   from assms obtain w where w: "w\<notin>y" "x = insert w (x\<inter>y)"
     using adjacent_int_decomp by fast
   thus "\<exists>v. v\<in>x-y" by auto
   from w have "\<And>v. v\<in>x-y \<Longrightarrow> v=w" by fast
   thus "\<And>v v'. v\<in>x-y \<Longrightarrow> v'\<in>x-y \<Longrightarrow> v=v'" by auto
 qed
 
 lemma adjacent_card: "x \<sim> y \<Longrightarrow> card x = card y"
   unfolding adjacent_def facetrel_def by (cases "finite x" "x=y" rule: two_cases) auto
 
 lemma adjacent_to_adjacent_int_subset:
   assumes "C \<sim> D" "f`C \<sim> f`D" "f`C \<noteq> f`D"
   shows   "f`C \<inter> f`D \<subseteq> f`(C\<inter>D)"
 proof
   from assms(1,3) obtain v where v: "v \<notin> D" "C = insert v (C\<inter>D)"
     using adjacent_int_decomp by fast
   from assms(2,3) obtain w where w: "w \<notin> f`D" "f`C = insert w (f`C\<inter>f`D)"
     using adjacent_int_decomp[of "f`C" "f`D"] by fast
   from w have w': "w \<in> f`C - f`D" by fast
   with v assms(1,2) have fv_w: "f v = w" using adjacent_conv_insert by fast
   fix b assume "b \<in> f`C \<inter> f`D"
   from this obtain a1 a2
     where a1: "a1 \<in> C" "b = f a1"
     and   a2: "a2 \<in> D" "b = f a2"
     by    fast
   from v a1 a2(2) have "a1 \<notin> D \<Longrightarrow> f a2 = w" using fv_w by auto
   with a2(1) w' have "a1 \<in> D" by fast
   with a1 show "b \<in> f`(C\<inter>D)" by fast
 qed
 
 lemma adjacent_to_adjacent_int:
   "\<lbrakk> C \<sim> D; f`C \<sim> f`D; f`C \<noteq> f`D \<rbrakk> \<Longrightarrow> f`(C\<inter>D) = f`C \<inter> f`D"
   using adjacent_to_adjacent_int_subset by fast
 
 subsubsection \<open>Chains of adjacent sets\<close>
 
 abbreviation "adjacentchain  \<equiv> binrelchain adjacent"
 abbreviation "padjacentchain \<equiv> proper_binrelchain adjacent"
 
 lemmas adjacentchain_Cons_reduce   = binrelchain_Cons_reduce   [of adjacent]
 lemmas adjacentchain_obtain_proper = binrelchain_obtain_proper [of _ _ adjacent]
 
 lemma adjacentchain_card: "adjacentchain (x#xs@[y]) \<Longrightarrow> card x = card y"
   using adjacent_card by (induct xs arbitrary: x) auto
 
 
 subsection \<open>Locale and basic facts\<close>
 
 locale SimplicialComplex =
   fixes   X :: "'a set set"
   assumes finite_simplices: "\<forall>x\<in>X. finite x"
   and     faces           : "x\<in>X \<Longrightarrow> y\<subseteq>x \<Longrightarrow> y\<in>X"
 
 context SimplicialComplex
 begin
 
 abbreviation "Subcomplex Y \<equiv> Y \<subseteq> X \<and> SimplicialComplex Y"
 
 definition "maxsimp x \<equiv> x\<in>X \<and> (\<forall>z\<in>X. x\<subseteq>z \<longrightarrow> z=x)"
 
 definition adjacentset :: "'a set \<Rightarrow> 'a set set"
   where "adjacentset x = {y\<in>X. x\<sim>y}"
 
 lemma finite_simplex: "x\<in>X \<Longrightarrow> finite x"
   using finite_simplices by simp
 
 lemma singleton_simplex: "v\<in>\<Union>X \<Longrightarrow> {v} \<in> X"
   using faces by auto
 
 lemma maxsimpI: "x \<in> X \<Longrightarrow> (\<And>z. z\<in>X \<Longrightarrow> x\<subseteq>z \<Longrightarrow> z=x) \<Longrightarrow> maxsimp x"
   using maxsimp_def by auto
 
 lemma maxsimpD_simplex: "maxsimp x \<Longrightarrow> x\<in>X"
   using maxsimp_def by fast
 
 lemma maxsimpD_maximal: "maxsimp x \<Longrightarrow> z\<in>X \<Longrightarrow> x\<subseteq>z \<Longrightarrow> z=x"
   using maxsimp_def by auto
 
 lemmas finite_maxsimp = finite_simplex[OF maxsimpD_simplex]
 
 lemma maxsimp_nempty: "X \<noteq> {{}} \<Longrightarrow> maxsimp x \<Longrightarrow> x \<noteq> {}"
   unfolding maxsimp_def by fast 
 
 lemma maxsimp_vertices: "maxsimp x \<Longrightarrow> x\<subseteq>\<Union>X"
   using maxsimpD_simplex by fast
 
 lemma adjacentsetD_adj: "y \<in> adjacentset x \<Longrightarrow> x\<sim>y"
   using adjacentset_def by fast
 
 lemma max_in_subcomplex:
   "\<lbrakk> Subcomplex Y; y \<in> Y; maxsimp y \<rbrakk> \<Longrightarrow> SimplicialComplex.maxsimp Y y"
   using maxsimpD_maximal by (fast intro: SimplicialComplex.maxsimpI)
 
 lemma face_im:
   assumes "w \<in> X" "y \<subseteq> f`w"
   defines "u \<equiv> {a\<in>w. f a \<in> y}"
   shows "y \<in> f\<turnstile>X"
   using assms faces[of w u] image_eqI[of y "(`) f" u X]
   by    fast
 
 lemma im_faces: "x \<in> f \<turnstile> X \<Longrightarrow> y \<subseteq> x \<Longrightarrow> y \<in> f \<turnstile> X"
   using faces face_im[of _ y] by (cases "y={}") auto
 
 lemma map_is_simplicial_morph: "SimplicialComplex (f\<turnstile>X)"
 proof
   show "\<forall>x\<in>f\<turnstile>X. finite x" using finite_simplices by fast
   show "\<And>x y. x \<in>f\<turnstile>X \<Longrightarrow> y\<subseteq>x \<Longrightarrow> y\<in>f\<turnstile>X" using im_faces by fast
 qed
 
 lemma vertex_set_int:
   assumes "SimplicialComplex Y"
   shows   "\<Union>(X\<inter>Y) = \<Union>X \<inter> \<Union>Y"
 proof
   have "\<And>v. v \<in> \<Union>X \<inter> \<Union>Y \<Longrightarrow> v\<in> \<Union>(X\<inter>Y)"
     using faces SimplicialComplex.faces[OF assms] by auto
   thus "\<Union>(X\<inter>Y) \<supseteq> \<Union>X \<inter> \<Union>Y" by fast
 qed auto
 
 end (* context SimplicialComplex *)
 
 subsection \<open>Chains of maximal simplices\<close>
 
 text \<open>
   Chains of maximal simplices (with respect to adjacency) will allow us to walk through chamber
   complexes. But there is much we can say about them in simplicial complexes. We will call a chain
   of maximal simplices proper (using the prefix \<open>p\<close> as a naming convention to denote proper)
   if no maximal simplex appears more than once in the chain. (Some sources elect to call improper
   chains prechains, and reserve the name chain to describe a proper chain. And usually a slightly
   weaker notion of proper is used, requiring only that no maximal simplex appear twice in succession. But
   it essentially makes no difference, and we found it easier to use @{const distinct} rather than
   @{term "binrelchain not_equal"}.)
 \<close>
 
 context SimplicialComplex
 begin
 
 definition "maxsimpchain xs  \<equiv> (\<forall>x\<in>set xs. maxsimp x) \<and> adjacentchain xs"
 definition "pmaxsimpchain xs \<equiv> (\<forall>x\<in>set xs. maxsimp x) \<and> padjacentchain xs"
 
 function min_maxsimpchain :: "'a set list \<Rightarrow> bool"
   where
     "min_maxsimpchain [] = True"
   | "min_maxsimpchain [x] = maxsimp x"
   | "min_maxsimpchain (x#xs@[y]) =
       (x\<noteq>y \<and> is_arg_min length (\<lambda>zs. maxsimpchain (x#zs@[y])) xs)"
   by (auto, rule list_cases_Cons_snoc)
   termination by (relation "measure length") auto
 
 lemma maxsimpchain_snocI:
   "\<lbrakk> maxsimpchain (xs@[x]); maxsimp y; x\<sim>y \<rbrakk> \<Longrightarrow> maxsimpchain (xs@[x,y])"
   using maxsimpchain_def binrelchain_snoc maxsimpchain_def by auto
 
 lemma maxsimpchainD_maxsimp:
   "maxsimpchain xs \<Longrightarrow> x \<in> set xs \<Longrightarrow> maxsimp x"
   using maxsimpchain_def by fast
 
 lemma maxsimpchainD_adj: "maxsimpchain xs \<Longrightarrow> adjacentchain xs"
   using maxsimpchain_def by fast
 
 lemma maxsimpchain_CConsI:
   "\<lbrakk> maxsimp w; maxsimpchain (x#xs); w\<sim>x \<rbrakk> \<Longrightarrow> maxsimpchain (w#x#xs)"
   using maxsimpchain_def by auto
 
 lemma maxsimpchain_Cons_reduce:
   "maxsimpchain (x#xs) \<Longrightarrow> maxsimpchain xs"
   using     adjacentchain_Cons_reduce maxsimpchain_def by fastforce
 
 lemma maxsimpchain_append_reduce1:
   "maxsimpchain (xs@ys) \<Longrightarrow> maxsimpchain xs"
   using binrelchain_append_reduce1 maxsimpchain_def by auto
 
 lemma maxsimpchain_append_reduce2:
   "maxsimpchain (xs@ys) \<Longrightarrow> maxsimpchain ys"
   using binrelchain_append_reduce2 maxsimpchain_def by auto
 
 lemma maxsimpchain_remdup_adj:
   "maxsimpchain (xs@[x,x]@ys) \<Longrightarrow> maxsimpchain (xs@[x]@ys)"
   using maxsimpchain_def binrelchain_remdup_adj by auto
 
 lemma maxsimpchain_rev: "maxsimpchain xs \<Longrightarrow> maxsimpchain (rev xs)"
   using     maxsimpchainD_maxsimp adjacent_sym
             binrelchain_sym_rev[of adjacent]
   unfolding maxsimpchain_def
   by        fastforce
 
 lemma maxsimpchain_overlap_join:
   "maxsimpchain (xs@[w]) \<Longrightarrow> maxsimpchain (w#ys) \<Longrightarrow>
     maxsimpchain (xs@w#ys)"
   using binrelchain_overlap_join maxsimpchain_def by auto
 
 lemma pmaxsimpchain: "pmaxsimpchain xs \<Longrightarrow> maxsimpchain xs"
   using maxsimpchain_def pmaxsimpchain_def by fast
 
 lemma pmaxsimpchainI_maxsimpchain:
   "maxsimpchain xs \<Longrightarrow> distinct xs \<Longrightarrow> pmaxsimpchain xs"
   using maxsimpchain_def pmaxsimpchain_def by fast
 
 lemma pmaxsimpchain_CConsI:
   "\<lbrakk> maxsimp w; pmaxsimpchain (x#xs); w\<sim>x; w \<notin> set (x#xs) \<rbrakk> \<Longrightarrow>
     pmaxsimpchain (w#x#xs)"
   using pmaxsimpchain_def by auto
 
 lemmas pmaxsimpchainD_maxsimp =
   maxsimpchainD_maxsimp[OF pmaxsimpchain]
 lemmas pmaxsimpchainD_adj =
   maxsimpchainD_adj [OF pmaxsimpchain]
 
 lemma pmaxsimpchainD_distinct: "pmaxsimpchain xs \<Longrightarrow> distinct xs"
   using pmaxsimpchain_def by fast
 
 lemma pmaxsimpchain_Cons_reduce:
   "pmaxsimpchain (x#xs) \<Longrightarrow> pmaxsimpchain xs"
   using maxsimpchain_Cons_reduce pmaxsimpchain pmaxsimpchainD_distinct
   by    (fastforce intro: pmaxsimpchainI_maxsimpchain)
 
 lemma pmaxsimpchain_append_reduce1:
   "pmaxsimpchain (xs@ys) \<Longrightarrow> pmaxsimpchain xs"
   using maxsimpchain_append_reduce1 pmaxsimpchain pmaxsimpchainD_distinct
   by    (fastforce intro: pmaxsimpchainI_maxsimpchain)
 
 lemma maxsimpchain_obtain_pmaxsimpchain:
   assumes "x\<noteq>y" "maxsimpchain (x#xs@[y])"
   shows   "\<exists>ys. set ys \<subseteq> set xs \<and> length ys \<le> length xs \<and>
             pmaxsimpchain (x#ys@[y])"
 proof-
   obtain ys
     where ys: "set ys \<subseteq> set xs" "length ys \<le> length xs" "padjacentchain (x#ys@[y])"
     using maxsimpchainD_adj[OF assms(2)]
           adjacentchain_obtain_proper[OF assms(1)]
     by    auto
   from ys(1) assms(2) have "\<forall>a\<in>set (x#ys@[y]). maxsimp a"
     using maxsimpchainD_maxsimp by auto
   with ys show ?thesis unfolding pmaxsimpchain_def by auto
 qed
 
 lemma min_maxsimpchainD_maxsimpchain:
   assumes "min_maxsimpchain xs"
   shows   "maxsimpchain xs"
 proof (cases xs rule: list_cases_Cons_snoc)
   case Nil thus ?thesis using maxsimpchain_def by simp
 next
   case Single with assms show ?thesis using maxsimpchain_def by simp
 next
   case Cons_snoc with assms show ?thesis using is_arg_minD1 by fastforce
 qed
 
 lemma min_maxsimpchainD_min_betw:
   "min_maxsimpchain (x#xs@[y]) \<Longrightarrow> maxsimpchain (x#ys@[y]) \<Longrightarrow>
     length ys \<ge> length xs"
   using is_arg_minD2 by fastforce
 
 lemma min_maxsimpchainI_betw:
   assumes "x\<noteq>y" "maxsimpchain (x#xs@[y])"
           "\<And>ys. maxsimpchain (x#ys@[y]) \<Longrightarrow> length xs \<le> length ys"
   shows   "min_maxsimpchain (x#xs@[y])"
   using   assms by (simp add: is_arg_min_linorderI)
 
 lemma min_maxsimpchainI_betw_compare:
   assumes "x\<noteq>y" "maxsimpchain (x#xs@[y])"
           "min_maxsimpchain (x#ys@[y])" "length xs = length ys"
   shows   "min_maxsimpchain (x#xs@[y])"
   using   assms min_maxsimpchainD_min_betw min_maxsimpchainI_betw
   by      auto
 
 lemma min_maxsimpchain_pmaxsimpchain:
   assumes "min_maxsimpchain xs"
   shows   "pmaxsimpchain xs"
 proof (
   rule pmaxsimpchainI_maxsimpchain, rule min_maxsimpchainD_maxsimpchain,
   rule assms, cases xs rule: list_cases_Cons_snoc
 )
   case (Cons_snoc x ys y)
   have "\<not> distinct (x#ys@[y]) \<Longrightarrow> False"
   proof (cases "x\<in>set ys" "y\<in>set ys" rule: two_cases)
     case both
     from both(1) obtain as bs where "ys = as@x#bs"
       using in_set_conv_decomp[of x ys] by fast
     with assms Cons_snoc show False
       using min_maxsimpchainD_maxsimpchain[OF assms]
             maxsimpchain_append_reduce2[of "x#as"]
             min_maxsimpchainD_min_betw[of x ys y]
       by    fastforce
   next
     case one
     from one(1) obtain as bs where "ys = as@x#bs"
       using in_set_conv_decomp[of x ys] by fast
     with assms Cons_snoc show False
       using min_maxsimpchainD_maxsimpchain[OF assms]
             maxsimpchain_append_reduce2[of "x#as"]
             min_maxsimpchainD_min_betw[of x ys y]
       by    fastforce
   next
     case other
     from other(2) obtain as bs where "ys = as@y#bs"
       using in_set_conv_decomp[of y ys] by fast
     with assms Cons_snoc show False
       using min_maxsimpchainD_maxsimpchain[OF assms]
             maxsimpchain_append_reduce1[of "x#as@[y]"]
             min_maxsimpchainD_min_betw[of x ys y]
       by    fastforce
   next
     case neither
     moreover assume "\<not> distinct (x # ys @ [y])"
     ultimately obtain as a bs cs where "ys = as@[a]@bs@[a]@cs"
       using assms Cons_snoc not_distinct_decomp[of ys] by auto
     with assms Cons_snoc show False
       using min_maxsimpchainD_maxsimpchain[OF assms]
             maxsimpchain_append_reduce1[of "x#as@[a]"]
             maxsimpchain_append_reduce2[of "x#as@[a]@bs" "a#cs@[y]"]
             maxsimpchain_overlap_join[of "x#as" a "cs@[y]"]
             min_maxsimpchainD_min_betw[of x ys y "as@a#cs"]
       by    auto
   qed
   with Cons_snoc show "distinct xs" by fast
 qed auto
 
 lemma min_maxsimpchain_rev:
   assumes "min_maxsimpchain xs"
   shows   "min_maxsimpchain (rev xs)"
 proof (cases xs rule: list_cases_Cons_snoc)
   case Single with assms show ?thesis
     using min_maxsimpchainD_maxsimpchain maxsimpchainD_maxsimp by simp
 next
   case (Cons_snoc x ys y)
   moreover have "min_maxsimpchain (y # rev ys @ [x])"
   proof (rule min_maxsimpchainI_betw)
     from Cons_snoc assms show "y\<noteq>x"
       using min_maxsimpchain_pmaxsimpchain pmaxsimpchainD_distinct by auto
     from Cons_snoc show "maxsimpchain (y # rev ys @ [x])"
       using min_maxsimpchainD_maxsimpchain[OF assms] maxsimpchain_rev
       by    fastforce
     from Cons_snoc assms
       show  "\<And>zs. maxsimpchain (y#zs@[x]) \<Longrightarrow> length (rev ys) \<le> length zs"
       using maxsimpchain_rev min_maxsimpchainD_min_betw[of x ys y]
       by    fastforce
   qed
   ultimately show ?thesis by simp
 qed simp
 
 lemma min_maxsimpchain_adj:
   "\<lbrakk> maxsimp x; maxsimp y; x\<sim>y; x\<noteq>y \<rbrakk> \<Longrightarrow> min_maxsimpchain [x,y]"
   using maxsimpchain_def min_maxsimpchainI_betw[of x y "[]"] by simp
 
 lemma min_maxsimpchain_betw_CCons_reduce:
   assumes "min_maxsimpchain (w#x#ys@[z])"
   shows   "min_maxsimpchain (x#ys@[z])"
 proof (rule min_maxsimpchainI_betw)
   from assms show "x\<noteq>z"
     using min_maxsimpchain_pmaxsimpchain pmaxsimpchainD_distinct
     by    fastforce
   show "maxsimpchain (x#ys@[z])" 
     using min_maxsimpchainD_maxsimpchain[OF assms]
           maxsimpchain_Cons_reduce
     by    fast
 next
  fix zs assume "maxsimpchain (x#zs@[z])"
   hence "maxsimpchain (w#x#zs@[z])"
     using min_maxsimpchainD_maxsimpchain[OF assms] maxsimpchain_def
     by    fastforce
   with assms show "length ys \<le> length zs"
     using min_maxsimpchainD_min_betw[of w "x#ys" z "x#zs"] by simp
 qed
 
 lemma min_maxsimpchain_betw_uniform_length:
   assumes "min_maxsimpchain (x#xs@[y])" "min_maxsimpchain (x#ys@[y])"
   shows   "length xs = length ys"
   using   min_maxsimpchainD_min_betw[OF assms(1)]
           min_maxsimpchainD_min_betw[OF assms(2)]
           min_maxsimpchainD_maxsimpchain[OF assms(1)]
           min_maxsimpchainD_maxsimpchain[OF assms(2)]
   by      fastforce
 
 lemma not_min_maxsimpchainI_betw:
   "\<lbrakk> maxsimpchain (x#ys@[y]); length ys < length xs \<rbrakk> \<Longrightarrow>
     \<not> min_maxsimpchain (x#xs@[y])"
   using min_maxsimpchainD_min_betw not_less by blast
 
 lemma maxsimpchain_in_subcomplex:
   "\<lbrakk> Subcomplex Y; set ys \<subseteq> Y; maxsimpchain ys \<rbrakk> \<Longrightarrow>
     SimplicialComplex.maxsimpchain Y ys"
   using maxsimpchain_def max_in_subcomplex
         SimplicialComplex.maxsimpchain_def
   by    force
 
 end (* context SimplicialComplex *)
 
 subsection \<open>Isomorphisms of simplicial complexes\<close>
 
 text \<open>
   Here we develop the concept of isomorphism of simplicial complexes. Note that we have not
   bothered to first develop the concept of morphism of simplicial complexes, since every function
   on the vertex set of a simplicial complex can be considered a morphism of complexes (see lemma
   \<open>map_is_simplicial_morph\<close> above).
 \<close>
 
 locale SimplicialComplexIsomorphism = SimplicialComplex X
   for X :: "'a set set"
 + fixes f :: "'a \<Rightarrow> 'b"
   assumes inj: "inj_on f (\<Union>X)"
 begin
 
 lemmas morph = map_is_simplicial_morph[of f]
 
 lemma iso_codim_map:
   "x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> card (f`x - f`y) = card (x-y)"
   using inj inj_on_image_set_diff[of f _ x y] finite_simplex subset_inj_on[of f _ "x-y"]
         inj_on_iff_eq_card[of "x-y"]
   by    fastforce
 
 lemma maxsimp_im_max: "maxsimp x \<Longrightarrow> w \<in> X \<Longrightarrow> f`x \<subseteq> f`w \<Longrightarrow> f`w = f`x"
   using maxsimpD_simplex inj_onD[OF inj] maxsimpD_maximal[of x w] by blast
 
 lemma maxsimp_map:
   "maxsimp x \<Longrightarrow> SimplicialComplex.maxsimp (f\<turnstile>X) (f`x)"
   using maxsimpD_simplex maxsimp_im_max morph
         SimplicialComplex.maxsimpI[of "f\<turnstile>X" "f`x"]
   by    fastforce
 
 lemma iso_adj_int_im:
   assumes "maxsimp x" "maxsimp y" "x\<sim>y" "x\<noteq>y"
   shows "(f`x \<inter> f`y) \<lhd> f`x"
 proof (rule facetrelI_card)
   from assms(1,2) have  1: "f ` x \<subseteq> f ` y \<Longrightarrow> f ` y = f ` x"
     using maxsimp_map SimplicialComplex.maxsimpD_simplex[OF morph]
           SimplicialComplex.maxsimpD_maximal[OF morph]
     by    simp
   thus "f`x \<inter> f`y \<subseteq> f`x" by fast
 
   from assms(1) have "card (f`x - f`x \<inter> f`y) \<le> card (f`x - f`(x\<inter>y))"
     using finite_maxsimp card_mono[of "f`x - f`(x\<inter>y)" "f`x - f`x \<inter> f`y"] by fast
   moreover from assms(1,3,4) have "card (f`x - f`(x\<inter>y)) = 1"
     using maxsimpD_simplex faces[of x] maxsimpD_simplex
           iso_codim_map adjacent_int_facet1[of x y] facetrel_card
     by    fastforce
   ultimately have "card (f`x - f`x \<inter> f`y) \<le> 1" by simp
   moreover from assms(1,2,4) have "card (f`x - f`x \<inter> f`y) \<noteq> 0"
     using 1 maxsimpD_simplex finite_maxsimp
           inj_onD[OF induced_pow_fun_inj_on, OF inj, of x y]
     by    auto
   ultimately show "card (f`x - f`x \<inter> f`y) = 1" by simp
 qed
 
 lemma iso_adj_map:
   assumes "maxsimp x" "maxsimp y" "x\<sim>y" "x\<noteq>y"
   shows   "f`x \<sim> f`y"
   using assms(3,4) iso_adj_int_im[OF assms] adjacent_sym
         iso_adj_int_im[OF assms(2) assms(1)]
   by    (auto simp add: Int_commute intro: adjacentI)
 
 lemma pmaxsimpchain_map:
   "pmaxsimpchain xs \<Longrightarrow> SimplicialComplex.pmaxsimpchain (f\<turnstile>X) (f\<Turnstile>xs)"
 proof (induct xs rule: list_induct_CCons)
   case Nil show ?case
     using map_is_simplicial_morph SimplicialComplex.pmaxsimpchain_def
     by    fastforce
 next
   case (Single x) thus ?case
     using map_is_simplicial_morph pmaxsimpchainD_maxsimp maxsimp_map
           SimplicialComplex.pmaxsimpchain_def
     by    fastforce
 next
   case (CCons x y xs)
   have "SimplicialComplex.pmaxsimpchain (f \<turnstile> X) ( f`x # f`y # f\<Turnstile>xs)"
   proof (
     rule SimplicialComplex.pmaxsimpchain_CConsI,
     rule map_is_simplicial_morph
   )
     from CCons(2) show "SimplicialComplex.maxsimp (f\<turnstile>X) (f`x)"
       using pmaxsimpchainD_maxsimp maxsimp_map by simp
     from CCons show "SimplicialComplex.pmaxsimpchain (f\<turnstile>X) (f`y # f\<Turnstile>xs)"
       using pmaxsimpchain_Cons_reduce by simp
     from CCons(2) show "f`x \<sim> f`y"
       using pmaxsimpchain_def iso_adj_map by simp
     from inj CCons(2) have "distinct (f\<Turnstile>(x#y#xs))"
       using     maxsimpD_simplex inj_on_distinct_setlistmapim
       unfolding pmaxsimpchain_def
       by        blast
     thus "f`x \<notin> set (f`y # f\<Turnstile>xs)" by simp
   qed
   thus ?case by simp
 qed
 
 end (* context SimplicialComplexIsomorphism *)
 
 subsection \<open>The complex associated to a poset\<close>
 
 text \<open>
   A simplicial complex is naturally a poset under the subset relation. The following develops the
   reverse direction: constructing a simplicial complex from a suitable poset.
 \<close>
 
 context ordering
 begin
 
 definition PosetComplex :: "'a set \<Rightarrow> 'a set set"
   where "PosetComplex P \<equiv> (\<Union>x\<in>P. { {y. pseudominimal_in (P.\<^bold>\<le>x) y} })"
 
 lemma poset_is_SimplicialComplex:
   assumes "\<forall>x\<in>P. simplex_like (P.\<^bold>\<le>x)"
   shows   "SimplicialComplex (PosetComplex P)"
 proof (rule SimplicialComplex.intro, rule ballI)
   fix a assume "a \<in> PosetComplex P"
   from this obtain x where "x\<in>P" "a = {y. pseudominimal_in (P.\<^bold>\<le>x) y}"
     unfolding PosetComplex_def by fast
   with assms show "finite a"
     using pseudominimal_inD1 simplex_likeD_finite finite_subset[of a "P.\<^bold>\<le>x"] by fast
 next
   fix a b assume ab: "a \<in> PosetComplex P" "b\<subseteq>a"
   from ab(1) obtain x where x: "x\<in>P" "a = {y. pseudominimal_in (P.\<^bold>\<le>x) y}"
     unfolding PosetComplex_def by fast
   from assms x(1) obtain f and A::"nat set"
     where fA: "OrderingSetIso less_eq less (\<subseteq>) (\<subset>) (P.\<^bold>\<le>x) f"
               "f`(P.\<^bold>\<le>x) = Pow A"
     using simplex_likeD_iso[of "P.\<^bold>\<le>x"]
     by    auto
   define x' where x': "x' \<equiv> the_inv_into (P.\<^bold>\<le>x) f (\<Union>(f`b))"
   from fA x(2) ab(2) x' have x'_P: "x'\<in>P"
     using collect_pseudominimals_below_in_poset[of P x f] by simp
   moreover from x fA ab(2) x' have "b = {y. pseudominimal_in (P.\<^bold>\<le>x') y}"
     using collect_pseudominimals_below_in_eq[of x P f] by simp
   ultimately show "b \<in> PosetComplex P" unfolding PosetComplex_def by fast
 qed
 
 definition poset_simplex_map :: "'a set \<Rightarrow> 'a \<Rightarrow> 'a set"
   where "poset_simplex_map P x = {y. pseudominimal_in (P.\<^bold>\<le>x) y}"
 
 lemma poset_to_PosetComplex_OrderingSetMap:
   assumes "\<And>x. x\<in>P \<Longrightarrow> simplex_like (P.\<^bold>\<le>x)"
   shows   "OrderingSetMap (\<^bold>\<le>) (\<^bold><) (\<subseteq>) (\<subset>) P (poset_simplex_map P)"
 proof
   from assms
     show  "\<And>a b. \<lbrakk> a\<in>P; b\<in>P; a\<^bold>\<le>b \<rbrakk> \<Longrightarrow>
             poset_simplex_map P a \<subseteq> poset_simplex_map P b"
     using     simplex_like_has_bottom pseudominimal_in_below_in
     unfolding poset_simplex_map_def
     by        fast
 qed
 
 end (* context ordering *)
 
 text \<open>
   When a poset affords a simplicial complex, there is a natural morphism of posets from the
   source poset into the poset of sets in the complex, as above. However, some further assumptions
   are necessary to ensure that this morphism is an isomorphism. These conditions are collected in
   the following locale.
 \<close>
 
 locale ComplexLikePoset = ordering less_eq less
   for less_eq  :: "'a\<Rightarrow>'a\<Rightarrow>bool" (infix "\<^bold>\<le>"  50)
   and less     :: "'a\<Rightarrow>'a\<Rightarrow>bool" (infix "\<^bold><"  50)
 + fixes   P :: "'a set"
   assumes below_in_P_simplex_like: "x\<in>P \<Longrightarrow> simplex_like (P.\<^bold>\<le>x)"
   and     P_has_bottom           : "has_bottom P"
   and     P_has_glbs             : "x\<in>P \<Longrightarrow> y\<in>P \<Longrightarrow> \<exists>b. glbound_in_of P x y b"
 begin
 
 abbreviation "smap \<equiv> poset_simplex_map P"
 
 lemma smap_onto_PosetComplex: "smap ` P = PosetComplex P"
   using poset_simplex_map_def PosetComplex_def by auto
 
 lemma ordsetmap_smap: "\<lbrakk> a\<in>P; b\<in>P; a\<^bold>\<le>b \<rbrakk> \<Longrightarrow> smap a \<subseteq> smap b"
   using OrderingSetMap.ordsetmap[
           OF poset_to_PosetComplex_OrderingSetMap, OF below_in_P_simplex_like
         ]
         poset_simplex_map_def
   by    simp
 
 lemma inj_on_smap: "inj_on smap P"
 proof (rule inj_onI)
   fix x y assume xy: "x\<in>P" "y\<in>P" "smap x = smap y"
   show "x = y"
   proof (cases "smap x = {}")
     case True with xy show ?thesis
       using poset_simplex_map_def below_in_P_simplex_like P_has_bottom
             simplex_like_no_pseudominimal_in_below_in_imp_singleton[of x P]
             simplex_like_no_pseudominimal_in_below_in_imp_singleton[of y P]
             below_in_singleton_is_bottom[of P x] below_in_singleton_is_bottom[of P y]
       by    auto
   next
     case False
     from this obtain z where "z \<in> smap x" by fast
     with xy(3) have z1: "z \<in> P.\<^bold>\<le>x" "z \<in> P.\<^bold>\<le>y"
       using pseudominimal_inD1 poset_simplex_map_def by auto
     hence "lbound_of x y z" by (auto intro: lbound_ofI)
     with z1(1) obtain b where b: "glbound_in_of P x y b"
       using xy(1,2) P_has_glbs by fast
     moreover have "b \<in> P.\<^bold>\<le>x" "b \<in> P.\<^bold>\<le>y"
       using glbound_in_ofD_in[OF b] glbound_in_of_less_eq1[OF b]
             glbound_in_of_less_eq2[OF b]
       by    auto
     ultimately show ?thesis
       using     xy below_in_P_simplex_like 
                 pseudominimal_in_below_in_less_eq_glbound[of P x _ y b]
                 simplex_like_below_in_above_pseudominimal_is_top[of x P]
                 simplex_like_below_in_above_pseudominimal_is_top[of y P]
       unfolding poset_simplex_map_def
       by        force
   qed
 qed
 
 lemma OrderingSetIso_smap:
   "OrderingSetIso (\<^bold>\<le>) (\<^bold><) (\<subseteq>) (\<subset>) P smap"
 proof (rule OrderingSetMap.isoI)
   show "OrderingSetMap (\<^bold>\<le>) (\<^bold><) (\<subseteq>) (\<subset>) P smap"
     using poset_simplex_map_def below_in_P_simplex_like
           poset_to_PosetComplex_OrderingSetMap
     by    simp
 next
   fix x y assume xy: "x\<in>P" "y\<in>P" "smap x \<subseteq> smap y"
   from xy(2) have "simplex_like (P.\<^bold>\<le>y)" using below_in_P_simplex_like by fast
   from this obtain g and A::"nat set"
     where "OrderingSetIso (\<^bold>\<le>) (\<^bold><) (\<subseteq>) (\<subset>) (P.\<^bold>\<le>y) g"
           "g`(P.\<^bold>\<le>y) = Pow A"
     using simplex_likeD_iso[of "P.\<^bold>\<le>y"]
     by    auto
   with xy show "x\<^bold>\<le>y"
     using poset_simplex_map_def collect_pseudominimals_below_in_eq[of y P g]
           collect_pseudominimals_below_in_poset[of P y g]
           inj_onD[OF inj_on_smap, of "the_inv_into (P.\<^bold>\<le>y) g (\<Union>(g ` smap x))" x]
           collect_pseudominimals_below_in_less_eq_top[of P y g A "smap x"]
     by    simp
 qed (rule inj_on_smap)
 
 lemmas rev_ordsetmap_smap =
   OrderingSetIso.rev_ordsetmap[OF OrderingSetIso_smap]
 
 end (* context ComplexLikePoset *)
 
 end (* theory *)
diff --git a/thys/Design_Theory/Block_Designs.thy b/thys/Design_Theory/Block_Designs.thy
--- a/thys/Design_Theory/Block_Designs.thy
+++ b/thys/Design_Theory/Block_Designs.thy
@@ -1,551 +1,551 @@
 (* Title: Block_Designs.thy
    Author: Chelsea Edmonds
 *)
 
 section \<open>Block and Balanced Designs\<close>
 text \<open>We define a selection of the many different types of block and balanced designs, building up 
 to properties required for defining a BIBD, in addition to several base generalisations\<close> 
 
 theory Block_Designs imports Design_Operations
 begin
 
 subsection \<open>Block Designs\<close>
 text \<open>A block design is a design where all blocks have the same size.\<close>
 
 subsubsection \<open>K Block Designs\<close> 
 text \<open>An important generalisation of a typical block design is the $\mathcal{K}$ block design, 
 where all blocks must have a size $x$ where $x \in \mathcal{K}$\<close>
 locale K_block_design = proper_design +
   fixes sizes :: "nat set" ("\<K>")
   assumes block_sizes: "bl \<in># \<B> \<Longrightarrow> card bl \<in> \<K>"
   assumes positive_ints: "x \<in> \<K> \<Longrightarrow> x > 0"
 begin
 
 lemma sys_block_size_subset: "sys_block_sizes \<subseteq> \<K>"
   using block_sizes sys_block_sizes_obtain_bl by blast
 
 end
 
 subsubsection\<open>Uniform Block Design\<close>
 text \<open>The typical uniform block design is defined below\<close>
 locale block_design = proper_design + 
   fixes u_block_size :: nat ("\<k>")
   assumes uniform [simp]: "bl \<in># \<B> \<Longrightarrow> card bl = \<k>"
 begin
 
 lemma k_non_zero: "\<k> \<ge> 1"
 proof -
   obtain bl where bl_in: "bl \<in># \<B>"
     using design_blocks_nempty by auto 
   then have "card bl \<ge> 1" using block_size_gt_0
     by (metis less_not_refl less_one not_le_imp_less) 
   thus ?thesis by (simp add: bl_in)
 qed
 
 lemma uniform_alt_def_all: "\<forall> bl \<in># \<B> .card bl = \<k>"
   using uniform by auto 
 
 lemma uniform_unfold_point_set: "bl \<in># \<B> \<Longrightarrow> card {p \<in> \<V>. p \<in> bl} = \<k>"
   using uniform wellformed by (simp add: Collect_conj_eq inf.absorb_iff2) 
 
 lemma uniform_unfold_point_set_mset: "bl \<in># \<B> \<Longrightarrow> size {#p \<in># mset_set \<V>. p \<in> bl #} = \<k>"
   using uniform_unfold_point_set by (simp add: finite_sets) 
 
 lemma sys_block_sizes_uniform [simp]:  "sys_block_sizes  = {\<k>}"
 proof -
   have "sys_block_sizes = {bs . \<exists> bl . bs = card bl \<and> bl\<in># \<B>}" by (simp add: sys_block_sizes_def)
   then have "sys_block_sizes  = {bs . bs = \<k>}" using uniform uniform_unfold_point_set 
       b_positive block_set_nempty_imp_block_ex
     by (smt (verit, best) Collect_cong design_blocks_nempty)
   thus ?thesis by auto
 qed
 
 lemma sys_block_sizes_uniform_single: "is_singleton (sys_block_sizes)"
   by simp
 
 lemma uniform_size_incomp: "\<k> \<le> \<v> - 1 \<Longrightarrow> bl \<in># \<B> \<Longrightarrow> incomplete_block bl"
   using uniform k_non_zero 
   by (metis block_size_lt_v diff_diff_cancel diff_is_0_eq' less_numeral_extra(1) nat_less_le)
 
 lemma uniform_complement_block_size:
   assumes "bl \<in># \<B>\<^sup>C"
   shows "card bl = \<v> - \<k>"
 proof -
   obtain bl' where bl_assm: "bl = bl'\<^sup>c \<and> bl' \<in># \<B>" 
     using wellformed assms by (auto simp add: complement_blocks_def)
   then have "int (card bl') = \<k>" by simp
   thus ?thesis using bl_assm block_complement_size wellformed
     by (simp add: block_size_lt_order of_nat_diff) 
 qed
 
 lemma uniform_complement[intro]: 
   assumes "\<k> \<le> \<v> - 1"
   shows "block_design \<V> \<B>\<^sup>C (\<v> - \<k>)"
 proof - 
   interpret des: proper_design \<V> "\<B>\<^sup>C" 
     using  uniform_size_incomp assms complement_proper_design by auto 
   show ?thesis using assms uniform_complement_block_size by (unfold_locales) (simp)
 qed
 
 lemma block_size_lt_v: "\<k> \<le> \<v>"
   using v_non_zero block_size_lt_v design_blocks_nempty uniform by auto 
 
 end
 
 lemma (in proper_design) block_designI[intro]: "(\<And> bl . bl \<in># \<B> \<Longrightarrow> card bl = k) 
   \<Longrightarrow> block_design \<V> \<B> k"
   by (unfold_locales) (auto)
 
 context block_design 
 begin
 
 lemma block_design_multiple: "n > 0 \<Longrightarrow> block_design \<V> (multiple_blocks n) \<k>"
   using elem_in_repeat_in_original multiple_proper_design proper_design.block_designI 
   by (metis uniform_alt_def_all)
 
 end
 text \<open>A uniform block design is clearly a type of $K$\_block\_design with a singleton $K$ set\<close>
 sublocale block_design \<subseteq> K_block_design \<V> \<B> "{\<k>}"
   using k_non_zero uniform by unfold_locales simp_all
 
 subsubsection \<open>Incomplete Designs\<close>
 text \<open>An incomplete design is a design where $k < v$, i.e. no block is equal to the point set\<close>
 locale incomplete_design = block_design + 
   assumes incomplete: "\<k> < \<v>"
 
 begin
 
 lemma incomplete_imp_incomp_block: "bl \<in># \<B> \<Longrightarrow> incomplete_block bl"
   using incomplete uniform uniform_size_incomp by fastforce  
 
 lemma incomplete_imp_proper_subset: "bl \<in># \<B> \<Longrightarrow> bl \<subset> \<V>"
   using incomplete_block_proper_subset incomplete_imp_incomp_block by auto
 end
 
 lemma (in block_design) incomplete_designI[intro]: "\<k> < \<v> \<Longrightarrow> incomplete_design \<V> \<B> \<k>"
   by unfold_locales auto
 
 context incomplete_design
 begin
 
 lemma multiple_incomplete: "n > 0 \<Longrightarrow> incomplete_design \<V> (multiple_blocks n) \<k>"
   using block_design_multiple incomplete by (simp add: block_design.incomplete_designI) 
 
 lemma complement_incomplete: "incomplete_design \<V> (\<B>\<^sup>C) (\<v> - \<k>)"
 proof -
   have "\<v> - \<k> < \<v>" using v_non_zero k_non_zero by linarith
   thus ?thesis using uniform_complement incomplete incomplete_designI
     by (simp add: block_design.incomplete_designI) 
 qed
 
 end
 
 subsection \<open>Balanced Designs\<close>
 text \<open>t-wise balance is a design with the property that all point subsets of size $t$ occur in 
 $\lambda_t$ blocks\<close>
 
 locale t_wise_balance = proper_design + 
   fixes grouping :: nat ("\<t>") and index :: nat ("\<Lambda>\<^sub>t")
   assumes t_non_zero: "\<t> \<ge> 1"
   assumes t_lt_order: "\<t> \<le> \<v>"
   assumes balanced [simp]: "ps \<subseteq> \<V> \<Longrightarrow> card ps = \<t> \<Longrightarrow> \<B> index ps = \<Lambda>\<^sub>t"
 begin
 
 lemma t_non_zero_suc: "\<t> \<ge> Suc 0"
   using t_non_zero by auto
 
 lemma balanced_alt_def_all: "\<forall> ps \<subseteq> \<V> . card ps = \<t> \<longrightarrow> \<B> index ps = \<Lambda>\<^sub>t"
   using balanced by auto
 
 end
 
 lemma (in proper_design) t_wise_balanceI[intro]: "\<t> \<le> \<v> \<Longrightarrow> \<t> \<ge> 1 \<Longrightarrow> 
   (\<And> ps . ps \<subseteq> \<V> \<Longrightarrow> card ps = \<t>  \<Longrightarrow> \<B> index ps = \<Lambda>\<^sub>t) \<Longrightarrow> t_wise_balance \<V> \<B> \<t> \<Lambda>\<^sub>t"
   by (unfold_locales) auto
 
 context t_wise_balance
 begin
 
 lemma obtain_t_subset_points:
   obtains T where "T \<subseteq> \<V>" "card T = \<t>" "finite T"
-  using obtain_subset_with_card_n design_points_nempty t_lt_order t_non_zero finite_sets by auto
+  using obtain_subset_with_card_n t_lt_order by auto
 
 lemma multiple_t_wise_balance_index [simp]:
   assumes "ps \<subseteq> \<V>"
   assumes "card ps = \<t>"
   shows "(multiple_blocks n) index ps = \<Lambda>\<^sub>t * n"
   using multiple_point_index balanced assms by fastforce 
 
 lemma multiple_t_wise_balance: 
   assumes "n > 0" 
   shows "t_wise_balance \<V> (multiple_blocks n) \<t> (\<Lambda>\<^sub>t * n)"
 proof - 
   interpret des: proper_design \<V> "(multiple_blocks n)" by (simp add: assms multiple_proper_design)  
   show ?thesis using t_non_zero t_lt_order multiple_t_wise_balance_index 
     by (unfold_locales) (simp_all)
 qed
 
 lemma twise_set_pair_index: "ps \<subseteq> \<V> \<Longrightarrow> ps2 \<subseteq> \<V> \<Longrightarrow> ps \<noteq> ps2 \<Longrightarrow> card ps = \<t> \<Longrightarrow> card ps2 = \<t> 
   \<Longrightarrow> \<B> index ps = \<B> index ps2"
   using balanced by simp 
 
 lemma t_wise_balance_alt: "ps \<subseteq> \<V> \<Longrightarrow> card ps = \<t> \<Longrightarrow> \<B> index ps = l2 
   \<Longrightarrow> (\<And> ps . ps \<subseteq> \<V> \<Longrightarrow> card ps = \<t> \<Longrightarrow> \<B> index ps = l2)"
   using twise_set_pair_index by blast
 
 lemma index_1_imp_mult_1 [simp]: 
   assumes "\<Lambda>\<^sub>t = 1"
   assumes "bl \<in># \<B>"
   assumes "card bl \<ge> \<t>"
   shows "multiplicity bl = 1"
 proof (rule ccontr)
   assume "\<not> (multiplicity bl = 1)"
   then have not: "multiplicity bl \<noteq> 1" by simp
   have "multiplicity bl \<noteq> 0" using assms by simp 
   then have m: "multiplicity bl \<ge> 2" using not by linarith
   obtain ps where ps: "ps \<subseteq> bl \<and> card ps = \<t>"
     using assms obtain_t_subset_points
     by (metis obtain_subset_with_card_n) 
   then have "\<B> index ps \<ge> 2"
     using m points_index_count_min ps by blast
   then show False using balanced ps antisym_conv2 not_numeral_less_zero numeral_le_one_iff 
       points_index_ps_nin semiring_norm(69) zero_neq_numeral
     by (metis assms(1))
 qed
 
 end
 
 subsubsection \<open>Sub-types of t-wise balance\<close>
 
 text \<open>Pairwise balance is when $t = 2$. These are commonly of interest\<close>
 locale pairwise_balance = t_wise_balance \<V> \<B> 2 \<Lambda> 
   for point_set ("\<V>") and block_collection ("\<B>") and index ("\<Lambda>")
 
 text \<open>We can combine the balance properties with $K$\_block design to define tBD's 
 (t-wise balanced designs), and PBD's (pairwise balanced designs)\<close>
 
 locale tBD = t_wise_balance + K_block_design +
   assumes block_size_gt_t: "k \<in> \<K> \<Longrightarrow> k \<ge> \<t>"
 
 locale \<Lambda>_PBD = pairwise_balance + K_block_design + 
   assumes block_size_gt_t: "k \<in> \<K> \<Longrightarrow> k \<ge> 2"
 
 sublocale \<Lambda>_PBD \<subseteq> tBD \<V> \<B> 2 \<Lambda> \<K>
   using t_lt_order block_size_gt_t by (unfold_locales) (simp_all)
 
 locale PBD = \<Lambda>_PBD \<V> \<B> 1 \<K> for point_set ("\<V>") and block_collection ("\<B>") and sizes ("\<K>")
 begin
 lemma multiplicity_is_1:
   assumes "bl \<in># \<B>"
   shows "multiplicity bl = 1"
   using block_size_gt_t index_1_imp_mult_1 by (simp add: assms block_sizes) 
 
 end
 
 sublocale PBD \<subseteq> simple_design
   using multiplicity_is_1 by (unfold_locales)
 
 text \<open>PBD's are often only used in the case where $k$ is uniform, defined here.\<close>
 locale k_\<Lambda>_PBD = pairwise_balance + block_design + 
   assumes block_size_t: "2 \<le> \<k>"
 
 sublocale k_\<Lambda>_PBD \<subseteq> \<Lambda>_PBD \<V> \<B> \<Lambda> "{\<k>}"
   using k_non_zero uniform block_size_t by(unfold_locales) (simp_all)
 
 locale k_PBD = k_\<Lambda>_PBD \<V> \<B> 1 \<k> for point_set ("\<V>") and block_collection ("\<B>") and u_block_size ("\<k>")
 
 sublocale k_PBD \<subseteq> PBD \<V> \<B> "{\<k>}"
   using  block_size_t by (unfold_locales, simp_all)
 
 subsubsection \<open>Covering and Packing Designs\<close>
 text \<open>Covering and packing designs involve a looser balance restriction. Upper/lower bounds
 are placed on the points index, instead of a strict equality\<close>
 
 text \<open>A t-covering design is a relaxed version of a tBD, where, for all point subsets of size t, 
 a lower bound is put on the points index\<close>
 locale t_covering_design = block_design +
   fixes grouping :: nat ("\<t>")
   fixes min_index :: nat ("\<Lambda>\<^sub>t")
   assumes covering: "ps \<subseteq> \<V> \<Longrightarrow> card ps = \<t> \<Longrightarrow> \<B> index ps \<ge> \<Lambda>\<^sub>t" 
   assumes block_size_t: "\<t> \<le> \<k>"
   assumes t_non_zero: "\<t> \<ge> 1"
 begin
 
 lemma covering_alt_def_all: "\<forall> ps \<subseteq> \<V> . card ps = \<t> \<longrightarrow> \<B> index ps \<ge> \<Lambda>\<^sub>t"
   using covering by auto
 
 end
 
 lemma (in block_design) t_covering_designI [intro]: "t \<le> \<k> \<Longrightarrow> t \<ge> 1 \<Longrightarrow> 
   (\<And> ps. ps \<subseteq> \<V> \<Longrightarrow> card ps = t \<Longrightarrow> \<B> index ps \<ge> \<Lambda>\<^sub>t) \<Longrightarrow> t_covering_design \<V> \<B> \<k> t \<Lambda>\<^sub>t"
   by (unfold_locales) simp_all
 
 text \<open>A t-packing design is a relaxed version of a tBD, where, for all point subsets of size t, 
 an upper bound is put on the points index\<close>
 locale t_packing_design = block_design + 
   fixes grouping :: nat ("\<t>")
   fixes min_index :: nat ("\<Lambda>\<^sub>t")
   assumes packing: "ps \<subseteq> \<V> \<Longrightarrow> card ps = \<t> \<Longrightarrow> \<B> index ps \<le> \<Lambda>\<^sub>t"
   assumes block_size_t: "\<t> \<le> \<k>"
   assumes t_non_zero: "\<t> \<ge> 1"
 begin
 
 lemma packing_alt_def_all: "\<forall> ps \<subseteq> \<V> . card ps = \<t> \<longrightarrow> \<B> index ps \<le> \<Lambda>\<^sub>t"
   using packing by auto
 
 end
 
 lemma (in block_design) t_packing_designI [intro]: "t \<le> \<k> \<Longrightarrow> t \<ge> 1 \<Longrightarrow> 
   (\<And> ps . ps \<subseteq> \<V> \<Longrightarrow> card ps = t \<Longrightarrow> \<B> index ps \<le> \<Lambda>\<^sub>t) \<Longrightarrow> t_packing_design \<V> \<B> \<k> t \<Lambda>\<^sub>t"
   by (unfold_locales) simp_all
 
 lemma packing_covering_imp_balance: 
   assumes "t_packing_design V B k t \<Lambda>\<^sub>t" 
   assumes "t_covering_design V B k t \<Lambda>\<^sub>t" 
   shows "t_wise_balance V B t \<Lambda>\<^sub>t"
 proof -
   from assms interpret des: proper_design V B 
     using block_design.axioms(1) t_covering_design.axioms(1) by blast
   show ?thesis 
   proof (unfold_locales)
     show "1 \<le> t" using assms t_packing_design.t_non_zero by auto
     show "t \<le> des.\<v>" using block_design.block_size_lt_v t_packing_design.axioms(1) 
       by (metis assms(1) dual_order.trans t_packing_design.block_size_t)
     show "\<And>ps. ps \<subseteq> V \<Longrightarrow> card ps = t \<Longrightarrow> B index ps = \<Lambda>\<^sub>t" 
       using t_packing_design.packing t_covering_design.covering by (metis assms dual_order.antisym) 
   qed
 qed
 
 subsection \<open>Constant Replication Design\<close>
 text \<open>When the replication number for all points in a design is constant, it is the 
 design replication number.\<close>
 locale constant_rep_design = proper_design +
   fixes design_rep_number :: nat ("\<r>")
   assumes rep_number [simp]: "x \<in> \<V> \<Longrightarrow>  \<B> rep x = \<r>" 
 
 begin
 
 lemma rep_number_alt_def_all: "\<forall> x \<in> \<V>. \<B> rep x = \<r>"
   by (simp)
 
 lemma rep_number_unfold_set: "x \<in> \<V> \<Longrightarrow> size {#bl \<in># \<B> . x \<in> bl#} = \<r>"
   using rep_number by (simp add: point_replication_number_def)
 
 lemma rep_numbers_constant [simp]: "replication_numbers  = {\<r>}"
   unfolding replication_numbers_def using rep_number design_points_nempty Collect_cong finite.cases 
     finite_sets insertCI singleton_conv
   by (smt (verit, ccfv_threshold) fst_conv snd_conv) 
 
 lemma replication_number_single: "is_singleton (replication_numbers)"
   using is_singleton_the_elem by simp
 
 lemma constant_rep_point_pair: "x1 \<in> \<V> \<Longrightarrow> x2 \<in> \<V> \<Longrightarrow> x1 \<noteq> x2 \<Longrightarrow> \<B> rep x1 = \<B> rep x2"
   using rep_number by auto
 
 lemma constant_rep_alt: "x1 \<in> \<V> \<Longrightarrow> \<B> rep x1 = r2 \<Longrightarrow> (\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x = r2)"
   by (simp)
 
 lemma constant_rep_point_not_0:
   assumes "x \<in> \<V>" 
   shows "\<B> rep x \<noteq> 0"
 proof (rule ccontr)
   assume "\<not> \<B> rep x \<noteq> 0"
   then have "\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x = 0" using rep_number assms by auto
   then have "\<And> x . x \<in> \<V> \<Longrightarrow>  size {#bl \<in># \<B> . x \<in> bl#} = 0" 
     by (simp add: point_replication_number_def)
   then show False using design_blocks_nempty wf_design wf_design_iff wf_invalid_point
     by (metis ex_in_conv filter_mset_empty_conv multiset_nonemptyE size_eq_0_iff_empty)
 qed
 
 lemma rep_not_zero: "\<r> \<noteq> 0"
   using rep_number constant_rep_point_not_0 design_points_nempty by auto 
 
 lemma r_gzero: "\<r> > 0"
   using rep_not_zero by auto 
 
 lemma r_lt_eq_b: "\<r> \<le> \<b>"
   using rep_number max_point_rep
   by (metis all_not_in_conv design_points_nempty) 
 
 lemma complement_rep_number: 
   assumes "\<And> bl . bl \<in># \<B> \<Longrightarrow> incomplete_block bl"
   shows "constant_rep_design \<V> \<B>\<^sup>C (\<b> - \<r>)"
 proof - 
   interpret d: proper_design \<V> "(\<B>\<^sup>C)" using complement_proper_design
     by (simp add: assms) 
   show ?thesis using complement_rep_number rep_number by (unfold_locales) simp
 qed
 
 lemma multiple_rep_number: 
   assumes "n > 0"
   shows "constant_rep_design \<V> (multiple_blocks n) (\<r> * n)"
 proof - 
   interpret d: proper_design \<V> "(multiple_blocks n)" using multiple_proper_design
     by (simp add: assms) 
   show ?thesis using multiple_point_rep_num by (unfold_locales) (simp_all)
 qed
 end
 
 lemma (in proper_design) constant_rep_designI [intro]: "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x = \<r>) 
     \<Longrightarrow> constant_rep_design \<V> \<B> \<r>"
   by unfold_locales auto
 
 subsection \<open>T-designs\<close>
 text \<open>All the before mentioned designs build up to the concept of a t-design, which has uniform 
 block size and is t-wise balanced. We limit $t$ to be less than $k$, so the balance condition has 
 relevance\<close>
 locale t_design = incomplete_design + t_wise_balance + 
   assumes block_size_t: "\<t> \<le> \<k>"
 begin
 
 lemma point_indices_balanced: "point_indices \<t> = {\<Lambda>\<^sub>t}" 
 proof -
   have "point_indices \<t> = {i . \<exists> ps . i = \<B> index ps \<and> card ps = \<t> \<and> ps \<subseteq> \<V>}"
     by (simp add: point_indices_def) 
   then have "point_indices  \<t> = {i . i = \<Lambda>\<^sub>t}" using balanced Collect_cong obtain_t_subset_points 
      by (smt (verit, best)) 
   thus ?thesis by auto
 qed
 
 lemma point_indices_singleton: "is_singleton (point_indices \<t>)"
   using point_indices_balanced is_singleton_the_elem by simp
 
 end
 
 lemma t_designI [intro]: 
   assumes "incomplete_design V B k"
   assumes "t_wise_balance V B t \<Lambda>\<^sub>t"
   assumes "t \<le> k"
   shows "t_design V B k t \<Lambda>\<^sub>t"
   by (simp add: assms(1) assms(2) assms(3) t_design.intro t_design_axioms.intro)
 
 sublocale t_design \<subseteq> t_covering_design \<V> \<B> \<k> \<t> \<Lambda>\<^sub>t
   using t_non_zero by (unfold_locales) (auto simp add: block_size_t)
 
 sublocale t_design \<subseteq> t_packing_design \<V> \<B> \<k> \<t> \<Lambda>\<^sub>t
   using t_non_zero by (unfold_locales) (auto simp add: block_size_t)
 
 lemma t_design_pack_cov [intro]: 
   assumes "k < card V"
   assumes "t_covering_design V B k t \<Lambda>\<^sub>t"
   assumes "t_packing_design V B k t \<Lambda>\<^sub>t"
   shows "t_design V B k t \<Lambda>\<^sub>t"
 proof -
   from assms interpret id: incomplete_design V B k
     using block_design.incomplete_designI t_packing_design.axioms(1)
     by blast 
   from assms interpret balance: t_wise_balance V B t \<Lambda>\<^sub>t 
     using packing_covering_imp_balance by blast 
   show ?thesis using assms(3) 
     by (unfold_locales) (simp_all add: t_packing_design.block_size_t)
 qed
 
 sublocale t_design \<subseteq> tBD \<V> \<B> \<t> \<Lambda>\<^sub>t "{\<k>}"
   using uniform k_non_zero block_size_t by (unfold_locales) simp_all
 
 context t_design 
 begin
 
 lemma multiple_t_design: "n > 0 \<Longrightarrow> t_design \<V> (multiple_blocks n) \<k> \<t> (\<Lambda>\<^sub>t * n)"
   using multiple_t_wise_balance multiple_incomplete block_size_t by (simp add: t_designI)
 
 lemma t_design_min_v: "\<v> > 1"
   using k_non_zero incomplete by simp
 
 end
 
 subsection \<open>Steiner Systems\<close>
 
 text \<open>Steiner systems are a special type of t-design where $\Lambda_t = 1$\<close>
 locale steiner_system = t_design \<V> \<B> \<k> \<t> 1 
   for point_set ("\<V>") and block_collection ("\<B>") and u_block_size ("\<k>") and grouping ("\<t>")
 
 begin
 
 lemma block_multiplicity [simp]: 
   assumes "bl \<in># \<B>"
   shows "multiplicity bl = 1"
   by (simp add: assms block_size_t)
 
 end
 
 sublocale steiner_system \<subseteq> simple_design
   by unfold_locales (simp)
 
 lemma (in t_design) steiner_systemI[intro]: "\<Lambda>\<^sub>t = 1 \<Longrightarrow> steiner_system \<V> \<B> \<k> \<t>"
   using t_non_zero t_lt_order block_size_t
   by unfold_locales auto
 
 subsection \<open>Combining block designs\<close>
 text \<open>We define some closure properties for various block designs under the combine operator.
 This is done using locales to reason on multiple instances of the same type of design, building 
 on what was presented in the design operations theory\<close>
 
 locale two_t_wise_eq_points = two_designs_proper \<V> \<B> \<V> \<B>' + des1: t_wise_balance \<V> \<B> \<t> \<Lambda>\<^sub>t + 
   des2: t_wise_balance \<V> \<B>' \<t> \<Lambda>\<^sub>t' for \<V> \<B> \<t> \<Lambda>\<^sub>t \<B>' \<Lambda>\<^sub>t'
 begin
 
 lemma combine_t_wise_balance_index: "ps \<subseteq> \<V> \<Longrightarrow> card ps = \<t> \<Longrightarrow> \<B>\<^sup>+ index ps = (\<Lambda>\<^sub>t + \<Lambda>\<^sub>t')"
   using des1.balanced des2.balanced by (simp add: combine_points_index)
 
 lemma combine_t_wise_balance: "t_wise_balance \<V>\<^sup>+ \<B>\<^sup>+ \<t> (\<Lambda>\<^sub>t + \<Lambda>\<^sub>t')"
 proof (unfold_locales, simp add: des1.t_non_zero_suc)
   have "card \<V>\<^sup>+  \<ge> card \<V>" by simp 
   then show "\<t> \<le> card (\<V>\<^sup>+)" using des1.t_lt_order by linarith 
   show "\<And>ps. ps \<subseteq> \<V>\<^sup>+ \<Longrightarrow> card ps = \<t> \<Longrightarrow> (\<B>\<^sup>+ index ps) = \<Lambda>\<^sub>t + \<Lambda>\<^sub>t'" 
     using combine_t_wise_balance_index by blast 
 qed
 
 sublocale combine_t_wise_des: t_wise_balance "\<V>\<^sup>+" "\<B>\<^sup>+" "\<t>" "(\<Lambda>\<^sub>t + \<Lambda>\<^sub>t')"
   using combine_t_wise_balance by auto
 
 end
 
 locale two_k_block_designs = two_designs_proper \<V> \<B> \<V>' \<B>' + des1: block_design \<V> \<B> \<k> + 
   des2: block_design \<V>' \<B>' \<k> for \<V> \<B> \<k> \<V>' \<B>'
 begin
 
 lemma block_design_combine: "block_design \<V>\<^sup>+ \<B>\<^sup>+ \<k>"
   using des1.uniform des2.uniform by (unfold_locales) (auto)
 
 sublocale combine_block_des: block_design "\<V>\<^sup>+" "\<B>\<^sup>+" "\<k>"
   using block_design_combine by simp
 
 end
 
 locale two_rep_designs_eq_points = two_designs_proper \<V> \<B> \<V> \<B>' + des1: constant_rep_design \<V> \<B> \<r> + 
   des2: constant_rep_design \<V> \<B>' \<r>' for \<V> \<B> \<r> \<B>' \<r>' 
 begin
 
 lemma combine_rep_number: "constant_rep_design \<V>\<^sup>+ \<B>\<^sup>+ (\<r> + \<r>')"
   using combine_rep_number des1.rep_number des2.rep_number by (unfold_locales) (simp)
 
 sublocale combine_const_rep: constant_rep_design "\<V>\<^sup>+" "\<B>\<^sup>+" "(\<r> + \<r>')"
   using combine_rep_number by simp
 
 end
 
 locale two_incomplete_designs = two_k_block_designs \<V> \<B> \<k> \<V>' \<B>' + des1: incomplete_design \<V> \<B> \<k> + 
   des2: incomplete_design \<V>' \<B>' \<k> for \<V> \<B> \<k> \<V>' \<B>'
 begin
 
 lemma combine_is_incomplete: "incomplete_design \<V>\<^sup>+ \<B>\<^sup>+ \<k>"
   using combine_order des1.incomplete des2.incomplete by (unfold_locales) (simp)
 
 sublocale combine_incomplete: incomplete_design "\<V>\<^sup>+" "\<B>\<^sup>+" "\<k>"
   using combine_is_incomplete by simp
 end
 
 locale two_t_designs_eq_points = two_incomplete_designs \<V> \<B> \<k> \<V> \<B>' 
   + two_t_wise_eq_points \<V> \<B> \<t> \<Lambda>\<^sub>t \<B>' \<Lambda>\<^sub>t' + des1: t_design \<V> \<B> \<k> \<t> \<Lambda>\<^sub>t + 
   des2: t_design \<V> \<B>' \<k> \<t> \<Lambda>\<^sub>t' for \<V> \<B> \<k> \<B>' \<t> \<Lambda>\<^sub>t \<Lambda>\<^sub>t'
 begin
 
 lemma combine_is_t_des: "t_design \<V>\<^sup>+ \<B>\<^sup>+ \<k> \<t> (\<Lambda>\<^sub>t + \<Lambda>\<^sub>t')"
   using des1.block_size_t des2.block_size_t by (unfold_locales)
 
 sublocale combine_t_des: t_design "\<V>\<^sup>+" "\<B>\<^sup>+" "\<k>" "\<t>" "(\<Lambda>\<^sub>t + \<Lambda>\<^sub>t')"
   using combine_is_t_des by blast
 
 end
 end
\ No newline at end of file
diff --git a/thys/Khovanskii_Theorem/Khovanskii.thy b/thys/Khovanskii_Theorem/Khovanskii.thy
--- a/thys/Khovanskii_Theorem/Khovanskii.thy
+++ b/thys/Khovanskii_Theorem/Khovanskii.thy
@@ -1,1258 +1,1258 @@
 section\<open>Khovanskii's Theorem\<close>
 
 text\<open>We formalise the proof of an important theorem in additive combinatorics due to Khovanskii,
 attesting that the cardinality of the set of all sums of $n$ many elements of $A$,
 where $A$ is a finite subset of an abelian group, is a polynomial in $n$ for all sufficiently large $n$.
 We follow a proof due to Nathanson and Ruzsa as presented in the notes
 “Introduction to Additive Combinatorics” by Timothy Gowers for the University of Cambridge.\<close>
 
 theory Khovanskii
   imports
     Complex_Main
     FiniteProduct
     "HOL-Library.Equipollence"
     "Pluennecke_Ruzsa_Inequality.Pluennecke_Ruzsa_Inequality"
     "Bernoulli.Bernoulli"               \<comment> \<open>sums of a fixed power are polynomials\<close>
     "HOL-Analysis.Weierstrass_Theorems" \<comment> \<open>needed for polynomial function\<close>
     "HOL-Library.List_Lenlexorder"      \<comment> \<open>lexicographic ordering for the type @{typ \<open>nat list\<close>}\<close>
 begin
 
 lemma real_polynomial_function_sum_of_powers:
   "\<exists>p. real_polynomial_function p \<and> (\<forall>n. (\<Sum>i\<le>n. real i ^ j) = p (real n))"
 proof (intro exI conjI strip)
   let ?p = "\<lambda>n. (bernpoly (Suc j) (1 + n) - bernpoly (Suc j) 0) / (Suc j)"
   show "real_polynomial_function ?p"
     by (force simp add: bernpoly_def)
 qed (simp add: add.commute sum_of_powers)
 
 text \<open>The sum of the elements of a list\<close>
 abbreviation "\<sigma> \<equiv> sum_list"
 
 text \<open>Related to the nsets of Ramsey.thy, but simpler\<close>
 definition finsets :: "['a set, nat] \<Rightarrow> 'a set set"
   where "finsets A n \<equiv> {N. N \<subseteq> A \<and> card N = n}"
 
 lemma card_finsets: "finite N \<Longrightarrow> card (finsets N k) = card N choose k"
   by (simp add: finsets_def n_subsets)
 
 lemma sorted_map_plus_iff [simp]:
   fixes a::"'a::linordered_cancel_ab_semigroup_add"
   shows "sorted (map ((+) a) xs) \<longleftrightarrow> sorted xs"
   by (induction xs) auto
 
 lemma distinct_map_plus_iff [simp]:
   fixes a::"'a::linordered_cancel_ab_semigroup_add"
   shows "distinct (map ((+) a) xs) \<longleftrightarrow> distinct xs"
   by (induction xs) auto
 
 subsection \<open>Arithmetic operations on lists, pointwise on the elements\<close>
 
 text \<open>Weak type class properties.
  Cancellation is difficult to arrange because of complications when lists differ in length.\<close>
 
 instantiation list :: (plus) plus
 begin
 definition "plus_list \<equiv> map2 (+)"
 instance..
 end
 
 lemma length_plus_list [simp]:
   fixes xs :: "'a::plus list"
   shows "length (xs+ys) = min (length xs) (length ys)"
   by (simp add: plus_list_def)
 
 lemma plus_Nil [simp]: "[] + xs = []"
   by (simp add: plus_list_def)
 
 lemma plus_Cons: "(y # ys) + (x # xs) = (y+x) # (ys+xs)"
   by (simp add: plus_list_def)
 
 lemma nth_plus_list [simp]:
   fixes xs :: "'a::plus list"
   assumes "i < length xs" "i < length ys"
   shows "(xs+ys)!i = xs!i + ys!i"
   by (simp add: plus_list_def assms)
 
 
 instantiation list :: (minus) minus
 begin
 definition "minus_list \<equiv> map2 (-)"
 instance..
 end
 
 lemma length_minus_list [simp]:
   fixes xs :: "'a::minus list"
   shows "length (xs-ys) = min (length xs) (length ys)"
   by (simp add: minus_list_def)
 
 lemma minus_Nil [simp]: "[] - xs = []"
   by (simp add: minus_list_def)
 
 lemma minus_Cons: "(y # ys) - (x # xs) = (y-x) # (ys-xs)"
   by (simp add: minus_list_def)
 
 lemma nth_minus_list [simp]:
   fixes xs :: "'a::minus list"
   assumes "i < length xs" "i < length ys"
   shows "(xs-ys)!i = xs!i - ys!i"
   by (simp add: minus_list_def assms)
 
 instance list :: (ab_semigroup_add) ab_semigroup_add
 proof
   have "map2 (+) (map2 (+) xs ys) zs = map2 (+) xs (map2 (+) ys zs)" for xs ys zs :: "'a list"
   proof (induction xs arbitrary: ys zs)
     case (Cons x xs)
     show ?case
     proof (cases "ys=[] \<or> zs=[]")
       case False
       then obtain y ys' z zs' where "ys = y#ys'" "zs = z # zs'"
         by (meson list.exhaust)
       then show ?thesis
         by (simp add: Cons add.assoc)
     qed auto
   qed auto
   then show "a + b + c = a + (b + c)" for a b c :: "'a list"
     by (auto simp: plus_list_def)
 next
   have "map2 (+) xs ys = map2 (+) ys xs" for xs ys :: "'a list"
   proof (induction xs arbitrary: ys)
     case (Cons x xs)
     show ?case
     proof (cases ys)
       case (Cons y ys')
       then show ?thesis
         by (simp add: Cons.IH add.commute)
     qed auto
   qed auto
   then show "a + b = b + a" for a b :: "'a list"
     by (auto simp: plus_list_def)
 qed
 
 
 subsection \<open>The pointwise ordering on two equal-length lists of natural numbers\<close>
 
 text \<open>Gowers uses the usual symbol ($\le$) for his pointwise ordering.
    In our development, $\le$ is the lexicographic ordering and $\unlhd$ is the pointwise ordering.\<close>
 
 definition pointwise_le :: "[nat list, nat list] \<Rightarrow> bool" (infixr "\<unlhd>" 50 )
   where "x \<unlhd> y \<equiv> list_all2 (\<le>) x y"
 
 definition pointwise_less :: "[nat list, nat list] \<Rightarrow> bool" (infixr "\<lhd>" 50 )
   where "x \<lhd> y \<equiv> x \<unlhd> y \<and> x \<noteq> y"
 
 lemma pointwise_le_iff_nth:
   "x \<unlhd> y \<longleftrightarrow> length x = length y \<and> (\<forall>i < length x. x!i \<le> y!i)"
   by (simp add: list_all2_conv_all_nth pointwise_le_def)
 
 lemma pointwise_le_iff:
   "x \<unlhd> y \<longleftrightarrow> length x = length y \<and> (\<forall>(i,j) \<in> set (zip x y). i\<le>j)"
   by (simp add: list_all2_iff pointwise_le_def)
 
 lemma pointwise_append_le_iff [simp]: "u@x \<unlhd> u@y \<longleftrightarrow> x \<unlhd> y"
   by (auto simp: pointwise_le_iff_nth nth_append)
 
 lemma pointwise_le_refl [iff]: "x \<unlhd> x"
   by (simp add: list.rel_refl pointwise_le_def)
 
 lemma pointwise_le_antisym: "\<lbrakk>x \<unlhd> y; y \<unlhd> x\<rbrakk> \<Longrightarrow> x=y"
   by (metis antisym list_all2_antisym pointwise_le_def)
 
 lemma pointwise_le_trans: "\<lbrakk>x \<unlhd> y; y \<unlhd> z\<rbrakk> \<Longrightarrow> x \<unlhd> z"
   by (smt (verit, del_insts) le_trans list_all2_trans pointwise_le_def)
 
 lemma pointwise_le_Nil [simp]: "Nil \<unlhd> x \<longleftrightarrow> x = Nil"
   by (simp add: pointwise_le_def)
 
 lemma pointwise_le_Nil2 [simp]: "x \<unlhd> Nil \<longleftrightarrow> x = Nil"
   by (simp add: pointwise_le_def)
 
 lemma pointwise_le_iff_less_equal: "x \<unlhd> y \<longleftrightarrow> x \<lhd> y \<or> x = y"
   using pointwise_less_def by blast
 
 lemma pointwise_less_iff:
   "x \<lhd> y \<longleftrightarrow> x \<unlhd> y \<and> (\<exists>(i,j) \<in> set (zip x y). i<j)"
   using list_eq_iff_zip_eq pointwise_le_iff pointwise_less_def by fastforce
 
 lemma pointwise_less_iff2: "x \<lhd> y \<longleftrightarrow> x \<unlhd> y \<and> (\<exists>k < length x. x!k <y ! k)"
   unfolding pointwise_less_def pointwise_le_iff_nth
   by (fastforce intro!: nth_equalityI)
 
 lemma pointwise_less_Nil [simp]: "\<not> Nil \<lhd> x"
   by (simp add: pointwise_less_def)
 
 lemma pointwise_less_Nil2 [simp]: "\<not> x \<lhd> Nil"
   by (simp add: pointwise_less_def)
 
 lemma zero_pointwise_le_iff [simp]: "replicate r 0 \<unlhd> x \<longleftrightarrow> length x = r"
   by (auto simp add: pointwise_le_iff_nth)
 
 lemma pointwise_le_imp_\<sigma>:
   assumes "xs \<unlhd> ys" shows "\<sigma> xs \<le> \<sigma> ys"
   using assms
 proof (induction ys arbitrary: xs)
   case Nil
   then show ?case
     by (simp add: pointwise_le_iff)
 next
   case (Cons y ys)
   then obtain x xs' where "x\<le>y" "xs = x#xs'" "xs' \<unlhd> ys"
     by (auto simp: pointwise_le_def list_all2_Cons2)
   then show ?case
     by (simp add: Cons.IH add_le_mono)
 qed
 
 lemma sum_list_plus:
   fixes xs :: "'a::comm_monoid_add list"
   assumes "length xs = length ys" shows "\<sigma> (xs + ys) = \<sigma> xs + \<sigma> ys"
   using assms by (simp add: plus_list_def case_prod_unfold sum_list_addf)
 
 lemma sum_list_minus:
   assumes "xs \<unlhd> ys" shows "\<sigma> (ys - xs) = \<sigma> ys - \<sigma> xs"
   using assms
 proof (induction ys arbitrary: xs)
   case (Cons y ys)
   then obtain x xs' where "x\<le>y" "xs = x#xs'" "xs' \<unlhd> ys"
     by (auto simp: pointwise_le_def list_all2_Cons2)
   then show ?case
     using pointwise_le_imp_\<sigma> by (auto simp: Cons minus_Cons)
 qed (auto simp: in_set_conv_nth)
 
 
 subsection \<open>Pointwise minimum and maximum of a set of lists\<close>
 
 definition min_pointwise :: "[nat, nat list set] \<Rightarrow> nat list"
   where "min_pointwise \<equiv> \<lambda>r U. map (\<lambda>i. Min ((\<lambda>u. u!i) ` U)) [0..<r]"
 
 lemma min_pointwise_le: "\<lbrakk>u \<in> U; finite U\<rbrakk> \<Longrightarrow> min_pointwise (length u) U \<unlhd> u"
   by (simp add: min_pointwise_def pointwise_le_iff_nth)
 
 lemma min_pointwise_ge_iff:
   assumes "finite U" "U \<noteq> {}" "\<And>u. u \<in> U \<Longrightarrow> length u = r" "length x = r"
   shows "x \<unlhd> min_pointwise r U \<longleftrightarrow> (\<forall>u \<in> U. x \<unlhd> u)"
   by (auto simp: min_pointwise_def pointwise_le_iff_nth assms)
 
 definition max_pointwise :: "[nat, nat list set] \<Rightarrow> nat list"
   where "max_pointwise \<equiv> \<lambda>r U. map (\<lambda>i. Max ((\<lambda>u. u!i) ` U)) [0..<r]"
 
 lemma max_pointwise_ge: "\<lbrakk>u \<in> U; finite U\<rbrakk> \<Longrightarrow> u \<unlhd> max_pointwise (length u) U"
   by (simp add: max_pointwise_def pointwise_le_iff_nth)
 
 lemma max_pointwise_le_iff:
   assumes "finite U" "U \<noteq> {}" "\<And>u. u \<in> U \<Longrightarrow> length u = r" "length x = r"
   shows "max_pointwise r U \<unlhd> x \<longleftrightarrow> (\<forall>u \<in> U. u \<unlhd> x)"
   by (auto simp: max_pointwise_def pointwise_le_iff_nth assms)
 
 lemma max_pointwise_mono:
   assumes "X' \<subseteq> X" "finite X" "X' \<noteq> {}"
   shows  "max_pointwise r X' \<unlhd> max_pointwise r X"
-  using assms by (simp add: max_pointwise_def pointwise_le_iff_nth Max_mono image_mono)
+  using assms by (auto simp add: max_pointwise_def pointwise_le_iff_nth Max_mono image_mono)
 
 lemma pointwise_le_plus: "\<lbrakk>xs \<unlhd> ys; length ys \<le> length zs\<rbrakk> \<Longrightarrow> xs \<unlhd> ys+zs"
 proof (induction xs arbitrary: ys zs)
   case (Cons x xs)
   then obtain y ys' z zs' where "ys = y#ys'" "zs = z#zs'"
     unfolding pointwise_le_iff by (metis Suc_le_length_iff le_refl length_Cons)
   with Cons show ?case
     by (auto simp: plus_list_def pointwise_le_def)
 qed (simp add: pointwise_le_iff)
 
 lemma pairwise_minus_cancel: "\<lbrakk>z \<unlhd> x;  z \<unlhd> y; x - z = y - z\<rbrakk> \<Longrightarrow> x = y"
   unfolding pointwise_le_iff_nth by (metis eq_diff_iff nth_equalityI nth_minus_list)
 
 
 subsection \<open>A locale to fix the finite subset @{term "A \<subseteq> G"}\<close>
 
 locale Khovanskii = additive_abelian_group +
   fixes A :: "'a set"
   assumes AsubG: "A \<subseteq> G" and finA: "finite A" and nonempty: "A \<noteq> {}"
 
 begin
 
 text \<open>finite products of a group element\<close>
 definition Gmult :: "'a \<Rightarrow> nat \<Rightarrow> 'a"
   where "Gmult a n \<equiv> (((\<oplus>)a) ^^ n) \<zero>"
 
 lemma Gmult_0 [simp]: "Gmult a 0 = \<zero>"
   by (simp add: Gmult_def)
 
 lemma Gmult_1 [simp]: "a \<in> G \<Longrightarrow> Gmult a (Suc 0) = a"
   by (simp add: Gmult_def)
 
 lemma Gmult_Suc [simp]: "Gmult a (Suc n) = a \<oplus> Gmult a n"
   by (simp add: Gmult_def)
 
 lemma Gmult_in_G [simp,intro]: "a \<in> G \<Longrightarrow> Gmult a n \<in> G"
   by (induction n) auto
 
 lemma Gmult_add_add:
   assumes "a \<in> G"
   shows "Gmult a (m+n) = Gmult a m \<oplus> Gmult a n"
   by (induction m) (use assms local.associative in fastforce)+
 
 lemma Gmult_add_diff:
   assumes "a \<in> G"
   shows "Gmult a (n+k) \<ominus> Gmult a n = Gmult a k"
   by (metis Gmult_add_add Gmult_in_G assms commutative inverse_closed invertible invertible_left_inverse2)
 
 lemma Gmult_diff:
   assumes "a \<in> G" "n\<le>m"
   shows "Gmult a m \<ominus> Gmult a n = Gmult a (m-n)"
   by (metis Gmult_add_diff assms le_add_diff_inverse)
 
 
 text \<open>Mapping elements of @{term A} to their numeric subscript\<close>
 abbreviation "idx \<equiv> to_nat_on A"
 
 text \<open>The elements of @{term A} in order\<close>
 definition aA :: "'a list"
   where "aA \<equiv> map (from_nat_into A) [0..<card A]"
 
 definition \<alpha> :: "nat list \<Rightarrow> 'a"
   where "\<alpha> \<equiv> \<lambda>x. fincomp (\<lambda>i. Gmult (aA!i) (x!i)) {..<card A}"
 
 text \<open>The underlying assumption is @{term "length y = length x"}\<close>
 definition useless:: "nat list  \<Rightarrow> bool"
   where "useless x \<equiv> \<exists>y < x. \<sigma> y = \<sigma> x \<and> \<alpha> y = \<alpha> x \<and> length y = length x"
 
 abbreviation "useful x \<equiv> \<not> useless x"
 
 lemma alpha_replicate_0 [simp]: "\<alpha> (replicate (card A) 0) = \<zero>"
   by (auto simp: \<alpha>_def intro: fincomp_unit_eqI)
 
 lemma idx_less_cardA:
   assumes "a \<in> A" shows "idx a < card A"
   by (metis assms bij_betw_def finA imageI lessThan_iff to_nat_on_finite)
 
 lemma aA_idx_eq [simp]:
   assumes "a \<in> A" shows "aA ! (idx a) = a"
   by (simp add: aA_def assms countable_finite finA idx_less_cardA)
 
 lemma set_aA: "set aA = A"
   using bij_betw_from_nat_into_finite [OF finA]
   by (simp add: aA_def atLeast0LessThan bij_betw_def)
 
 lemma nth_aA_in_G [simp]: "i < card A \<Longrightarrow> aA!i \<in> G"
   using AsubG aA_def set_aA by auto
 
 lemma alpha_in_G [iff]: "\<alpha> x \<in> G"
   using nth_aA_in_G fincomp_closed by (simp add: \<alpha>_def)
 
 lemma Gmult_in_PiG [simp]: "(\<lambda>i. Gmult (aA!i) (f i)) \<in> {..<card A} \<rightarrow> G"
   by simp
 
 lemma alpha_plus:
   assumes "length x = card A" "length y = card A"
   shows "\<alpha> (x + y) = \<alpha> x \<oplus> \<alpha> y"
 proof -
   have "\<alpha> (x + y) = fincomp (\<lambda>i. Gmult (aA!i) (map2 (+) x y!i)) {..<card A}"
     by (simp add: \<alpha>_def plus_list_def)
   also have "\<dots> = fincomp (\<lambda>i. Gmult (aA!i) (x!i + y!i)) {..<card A}"
     by (intro fincomp_cong'; simp add: assms)
   also have "\<dots> = fincomp (\<lambda>i. Gmult (aA!i) (x!i) \<oplus> Gmult (aA!i) (y!i)) {..<card A}"
     by (intro fincomp_cong'; simp add: Gmult_add_add)
   also have "\<dots> = \<alpha> x \<oplus> \<alpha> y"
     by (simp add: \<alpha>_def fincomp_comp)
   finally show ?thesis .
 qed
 
 lemma alpha_minus:
   assumes "y \<unlhd> x" "length y = card A"
   shows "\<alpha> (x - y) = \<alpha> x \<ominus> \<alpha> y"
 proof -
   have "\<alpha> (x - y) = fincomp (\<lambda>i. Gmult (aA!i) (map2 (-) x y!i)) {..<card A}"
     by (simp add: \<alpha>_def minus_list_def)
   also have "\<dots> = fincomp (\<lambda>i. Gmult (aA!i) (x!i - y!i)) {..<card A}"
     using assms by (intro fincomp_cong') (auto simp: pointwise_le_iff)
   also have "\<dots> = fincomp (\<lambda>i. Gmult (aA!i) (x!i) \<ominus> Gmult (aA!i) (y!i)) {..<card A}"
     using assms
     by (intro fincomp_cong') (simp add: pointwise_le_iff_nth Gmult_diff)+
   also have "\<dots> = \<alpha> x \<ominus> \<alpha> y"
     by (simp add: \<alpha>_def fincomp_comp fincomp_inverse)
   finally show ?thesis .
 qed
 
 subsection \<open>Adding one to a list element\<close>
 
 definition list_incr :: "nat \<Rightarrow> nat list \<Rightarrow> nat list"
   where "list_incr i x \<equiv> x[i := Suc (x!i)]"
 
 lemma list_incr_Nil [simp]: "list_incr i [] = []"
   by (simp add: list_incr_def)
 
 lemma list_incr_Cons [simp]: "list_incr (Suc i) (k#ks) = k # list_incr i ks"
   by (simp add: list_incr_def)
 
 lemma sum_list_incr [simp]: "i < length x \<Longrightarrow> \<sigma> (list_incr i x) = Suc (\<sigma> x)"
   by (auto simp: list_incr_def sum_list_update)
 
 lemma length_list_incr [simp]: "length (list_incr i x) = length x"
   by (auto simp: list_incr_def)
 
 lemma nth_le_list_incr: "i < card A \<Longrightarrow> x!i \<le> list_incr (idx a) x!i"
   unfolding list_incr_def
   by (metis Suc_leD linorder_not_less list_update_beyond nth_list_update_eq nth_list_update_neq order_refl)
 
 lemma list_incr_nth_diff: "i < length x \<Longrightarrow> list_incr j x!i - x!i = (if i = j then 1 else 0)"
   by (simp add: list_incr_def)
 
 subsection \<open>The set of all @{term r}-tuples that sum to @{term n}\<close>
 
 definition length_sum_set :: "nat \<Rightarrow> nat \<Rightarrow> nat list set"
   where "length_sum_set r n \<equiv> {x. length x = r \<and> \<sigma> x = n}"
 
 lemma length_sum_set_Nil [simp]: "length_sum_set 0 n = (if n=0 then {[]} else {})"
   by (auto simp: length_sum_set_def)
 
 lemma length_sum_set_Suc [simp]: "k#ks \<in> length_sum_set (Suc r) n \<longleftrightarrow> (\<exists>m. ks \<in> length_sum_set r m \<and> n = m+k)"
   by (auto simp: length_sum_set_def)
 
 lemma length_sum_set_Suc_eqpoll: "length_sum_set (Suc r) n \<approx> Sigma {..n} (\<lambda>i. length_sum_set r (n-i))" (is "?L \<approx> ?R")
   unfolding eqpoll_def
 proof
   let ?f = "(\<lambda>l. (hd l, tl l))"
   show "bij_betw ?f ?L ?R"
   proof (intro bij_betw_imageI)
     show "inj_on ?f ?L"
       by (force simp: inj_on_def length_sum_set_def intro: list.expand)
     show "?f ` ?L = ?R"
       by (force simp: length_sum_set_def length_Suc_conv)
   qed
 qed
 
 lemma finite_length_sum_set: "finite (length_sum_set r n)"
 proof (induction r arbitrary: n)
   case 0
   then show ?case
     by (auto simp: length_sum_set_def)
 next
   case (Suc r)
   then show ?case
     using length_sum_set_Suc_eqpoll eqpoll_finite_iff by blast
 qed
 
 lemma card_length_sum_set: "card (length_sum_set (Suc r) n) = (\<Sum>i\<le>n. card (length_sum_set r (n-i)))"
 proof -
   have "card (length_sum_set (Suc r) n) = card (Sigma {..n} (\<lambda>i. length_sum_set r (n-i)))"
     by (metis eqpoll_finite_iff eqpoll_iff_card finite_length_sum_set length_sum_set_Suc_eqpoll)
   also have "\<dots> = (\<Sum>i\<le>n. card (length_sum_set r (n-i)))"
     by (simp add: finite_length_sum_set)
   finally show ?thesis .
 qed
 
 lemma sum_up_index_split':
   assumes "N \<le> n" shows "(\<Sum>i\<le>n. f i) = (\<Sum>i\<le>n-N. f i) + (\<Sum>i=Suc (n-N)..n. f i)"
   by (metis assms diff_add sum_up_index_split)
 
 lemma sum_invert: "N \<le> n \<Longrightarrow> (\<Sum>i = Suc (n - N)..n. f (n - i)) = (\<Sum>j<N. f j)"
 proof (induction N)
   case (Suc N)
   then show ?case
     apply (auto simp: Suc_diff_Suc)
     by (metis sum.atLeast_Suc_atMost Suc_leD add.commute diff_diff_cancel diff_le_self)
 qed auto
 
 lemma sum_diff_split:
   assumes "N \<le> n"
   shows "(\<Sum>i\<le>n - N. real (n - i) ^ j) = (\<Sum>i\<le>n. real i ^ j) - (\<Sum>i<N. real i ^ j)"
 proof -
   have inj: "inj_on ((-) n) {N..n}"
     by (auto simp: inj_on_def)
   have "(\<Sum>i\<le>n - N. real (n - i) ^ j) = (\<Sum>i\<in>(-) n ` {N..n}. real (n - i) ^ j)"
   proof (rule sum.cong)
     have "\<And>x. x \<le> n - N \<Longrightarrow> \<exists>m\<ge>N. m \<le> n \<and> x = n - m"
       by (metis assms diff_diff_cancel diff_le_mono2 diff_le_self le_trans)
     then show "{..n - N} = (-) n ` {N..n}"
       by (auto simp add: image_iff Bex_def)
   qed auto
   also have "\<dots> = (\<Sum>i=N..n. real i ^ j)"
     using sum.reindex [OF inj, of "\<lambda>i. real (n - i) ^ j", symmetric]
     by (simp add: )
   also have "\<dots> = (\<Sum>i\<le>n. real i ^ j) - (\<Sum>i<N. real i ^ j)"
   proof (cases N)
     case 0
     then show ?thesis
       using atMost_atLeast0 by auto
   next
     case (Suc N')
     then show ?thesis
       using assms sum_up_index_split [of _ N' "n-N'"]
       by (smt (verit, best) Suc_diff_le add_Suc_shift diff_Suc_Suc le_add_diff_inverse lessThan_Suc_atMost)
   qed
   finally show ?thesis .
 qed
 
 
 lemma real_polynomial_function_length_sum_set:
   "\<exists>p. real_polynomial_function p \<and> (\<forall>n>0. real (card (length_sum_set r n)) = p (real n))"
 proof (induction r)
   case 0
   have "\<forall>n>0. real (card (length_sum_set 0 n)) = 0"
     by auto
   then show ?case
     by blast
 next
   case (Suc r)
   then obtain p where poly: "real_polynomial_function p"
     and p: "\<And>n. n>0 \<Longrightarrow> real (card (length_sum_set r n)) = p (real n)"
     by blast
   then obtain a n where p_eq: "p = (\<lambda>x. \<Sum>i\<le>n. a i * x ^ i)"
     using real_polynomial_function_iff_sum by auto
   define q where "q \<equiv> \<lambda>x. \<Sum>j\<le>n. a j * ((bernpoly (Suc j) (1 + x) - bernpoly (Suc j) 0)
                                      / (1 + real j) - 0 ^ j)"
   have rp_q: "real_polynomial_function q"
     by (fastforce simp: bernpoly_def p_eq q_def)
   have q_eq: "(\<Sum>x\<le>n - 1. p (real (n - x))) = q (real n)" if "n>0" for n
     using that
     by (simp add: p_eq q_def sum.swap sum_diff_split add.commute sum_of_powers flip: sum_distrib_left)
   define p' where "p' \<equiv> \<lambda>x. q x + real (card (length_sum_set r 0))"
   have "real_polynomial_function p'"
     using rp_q by (force simp add: p'_def)
   moreover have "(\<Sum>x\<le>n - Suc 0. p (real (n - x))) +
                 real (card (length_sum_set r 0)) = p' (real n)" if "n>0" for n
     using that q_eq by (auto simp: p'_def)
   ultimately show ?case
     unfolding card_length_sum_set
     by (force simp: sum_up_index_split' [of 1] p sum_invert)
 qed
 
 lemma all_zeroes_replicate: "length_sum_set r 0 = {replicate r 0}"
   by (auto simp: length_sum_set_def replicate_eqI)
 
 lemma length_sum_set_Suc_eq_UN: "length_sum_set r (Suc n) = (\<Union>i<r. list_incr i ` length_sum_set r n)"
 proof -
   have "\<exists>i<r. x \<in> list_incr i ` length_sum_set r n"
     if "\<sigma> x = Suc n" and "r = length x" for x
   proof -
     have "x \<noteq> replicate r 0"
       using that by (metis sum_list_replicate Zero_not_Suc mult_zero_right)
     then obtain i where i: "i < r" "x!i \<noteq> 0"
       by (metis \<open>r = length x\<close> in_set_conv_nth replicate_eqI)
     with that have "x[i := x!i - 1] \<in> length_sum_set r n"
       by (simp add: sum_list_update length_sum_set_def)
     with i that show ?thesis
       unfolding list_incr_def by force
   qed
   then show ?thesis
     by (auto simp: length_sum_set_def Bex_def)
 qed
 
 lemma alpha_list_incr:
   assumes "a \<in> A" "x \<in> length_sum_set (card A) n"
   shows "\<alpha> (list_incr (idx a) x) = a \<oplus> \<alpha> x"
 proof -
   have lenx: "length x = card A"
     using assms length_sum_set_def by blast
   have "\<alpha> (list_incr (idx a) x) \<ominus> \<alpha> x = fincomp (\<lambda>i. Gmult (aA!i) (list_incr (idx a) x!i) \<ominus> Gmult (aA!i) (x!i)) {..<card A}"
     by (simp add: \<alpha>_def fincomp_comp fincomp_inverse)
   also have "\<dots> = fincomp (\<lambda>i. Gmult (aA!i) (list_incr (idx a) x!i - x!i)) {..<card A}"
     by (intro fincomp_cong; simp add: Gmult_diff nth_le_list_incr)
   also have "\<dots> = fincomp (\<lambda>i. if i = idx a then (aA!i) else \<zero>) {..<card A}"
     by (intro fincomp_cong'; simp add: list_incr_nth_diff lenx)
   also have "\<dots> = a"
     using assms by (simp add: fincomp_singleton_swap idx_less_cardA)
   finally have "\<alpha> (list_incr (idx a) x) \<ominus> \<alpha> x = a" .
   then show ?thesis
     by (metis alpha_in_G associative inverse_closed invertible invertible_left_inverse right_unit)
 qed
 
 lemma sumset_iterated_enum:
   defines "r \<equiv> card A"
   shows "sumset_iterated A n = \<alpha> ` length_sum_set r n"
 proof (induction n)
   case 0
   then show ?case
     by (simp add: all_zeroes_replicate r_def)
 next
   case (Suc n)
   have eq: "{..<r} = idx ` A"
     by (metis bij_betw_def finA r_def to_nat_on_finite)
   have "sumset_iterated A (Suc n) = (\<Union>a\<in>A. (\<lambda>i. a \<oplus> \<alpha> i) ` length_sum_set r n)"
     using AsubG by (auto simp: Suc sumset)
   also have "\<dots> = (\<Union>a\<in>A. (\<lambda>i. \<alpha> (list_incr (idx a) i)) ` length_sum_set r n)"
     by (simp add: alpha_list_incr r_def)
   also have "\<dots> = \<alpha> ` length_sum_set r (Suc n)"
     by (simp add: image_UN image_comp length_sum_set_Suc_eq_UN eq)
   finally show ?case .
 qed
 
 subsection \<open>Lemma 2.7 in Gowers's notes\<close>
 
 text\<open>The following lemma corresponds to a key fact about the cardinality of the set of all sums of
 $n$ many elements of $A$, stated before Gowers's Lemma 2.7.\<close>
 
 lemma card_sumset_iterated_length_sum_set_useful:
   defines "r \<equiv> card A"
   shows "card(sumset_iterated A n) = card (length_sum_set r n \<inter> {x. useful x})"
     (is "card ?L = card ?R")
 proof -
   have "\<alpha> x \<in> \<alpha> ` (length_sum_set r n \<inter> {x. useful x})"
     if "x \<in> length_sum_set r n" for x
   proof -
     define y where "y \<equiv> LEAST y. y \<in> length_sum_set r n \<and> \<alpha> y = \<alpha> x"
     have y: "y \<in> length_sum_set (card A) n \<and> \<alpha> y = \<alpha> x"
       by (metis (mono_tags, lifting) LeastI r_def y_def that)
     moreover
     have "useful y"
     proof (clarsimp simp: useless_def)
       show False
         if "\<sigma> z = \<sigma> y" "length z = length y" and "z < y" "\<alpha> z = \<alpha> y" for z
         using that Least_le length_sum_set_def not_less_Least r_def y y_def by fastforce
     qed
     ultimately show ?thesis
       unfolding image_iff length_sum_set_def r_def by (smt (verit) Int_Collect)
   qed
   then have "sumset_iterated A n = \<alpha> ` (length_sum_set r n \<inter> {x. useful x})"
     by (auto simp: sumset_iterated_enum length_sum_set_def r_def)
   moreover have "inj_on \<alpha> (length_sum_set r n \<inter> {x. useful x})"
     apply (simp add: image_iff length_sum_set_def r_def inj_on_def useless_def Ball_def)
     by (metis linorder_less_linear)
   ultimately show ?thesis
     by (simp add: card_image length_sum_set_def)
 qed
 
 text\<open>The following lemma corresponds to Lemma 2.7 in Gowers's notes.\<close>
 
 lemma useless_leq_useless:
   defines "r \<equiv> card A"
   assumes "useless x" and "x \<unlhd> y" and "length x = r"
   shows "useless y "
 proof -
   have leny: "length y = r"
     using pointwise_le_iff assms by auto
   obtain x' where "x'< x" and \<sigma>x': "\<sigma> x' = \<sigma> x" and \<alpha>x': "\<alpha> x' = \<alpha> x" and lenx': "length x' = length x"
     using assms useless_def by blast
   obtain i where "i < card A" and xi: "x'!i < x!i" and takex': "take i x' = take i x"
     using \<open>x'<x\<close> lenx' assms by (auto simp: list_less_def lenlex_def elim!: lex_take_index)
   define y' where "y' \<equiv> y+x'-x"
   have leny': "length y' = length y"
     using assms lenx' pointwise_le_iff  by (simp add: y'_def)
   have "x!i \<le> y!i"
     using \<open>x \<unlhd> y\<close> \<open>i < card A\<close> assms by (simp add: pointwise_le_iff_nth)
   then have "y'!i < y!i"
     using \<open>i < card A\<close> assms lenx' xi pointwise_le_iff by (simp add: y'_def plus_list_def minus_list_def)
   moreover have "take i y' = take i y"
   proof (intro nth_equalityI)
     show "length (take i y') = length (take i y)"
       by (simp add: leny')
     show "\<And>k. k < length (take i y') \<Longrightarrow> take i y' ! k = take i y!k"
       using takex' by (simp add: y'_def plus_list_def minus_list_def take_map take_zip)
   qed
   ultimately have "y' < y"
     using leny' \<open>i < card A\<close> assms pointwise_le_iff
     by (auto simp: list_less_def lenlex_def lexord_lex lexord_take_index_conv)
   moreover have "\<sigma> y' = \<sigma> y"
     using assms
     by (simp add: \<sigma>x' lenx' leny pointwise_le_plus sum_list_minus sum_list_plus y'_def)
   moreover have "\<alpha> y' = \<alpha> y"
     using assms lenx' \<alpha>x' leny
     by (fastforce simp add: y'_def pointwise_le_plus alpha_minus alpha_plus local.associative)
   ultimately show ?thesis
     using leny' useless_def by blast
 qed
 
 
 inductive_set minimal_elements for U
   where "\<lbrakk>x \<in> U; \<And>y. y \<in> U \<Longrightarrow> \<not> y \<lhd> x\<rbrakk> \<Longrightarrow> x \<in> minimal_elements U"
 
 
 lemma pointwise_less_imp_\<sigma>:
   assumes "xs \<lhd> ys" shows "\<sigma> xs < \<sigma> ys"
 proof -
   have eq: "length ys = length xs" and "xs \<unlhd> ys"
     using assms by (auto simp: pointwise_le_iff pointwise_less_iff)
   have "\<forall>k<length xs. xs!k \<le> ys!k"
     using \<open>xs \<unlhd> ys\<close> list_all2_nthD pointwise_le_def by auto
   moreover have "\<exists>k<length xs. xs!k < ys!k"
     using assms pointwise_less_iff2 by force
   ultimately show ?thesis
     by (force simp add: eq sum_list_sum_nth intro: sum_strict_mono_ex1)
 qed
 
 lemma wf_measure_\<sigma>: "wf (inv_image less_than \<sigma>)"
   by blast
 
 lemma WFP: "wfP (\<lhd>)"
   by (auto simp: wfP_def pointwise_less_imp_\<sigma> intro: wf_subset [OF wf_measure_\<sigma>])
 
 text\<open>The following is a direct corollary of the above lemma, i.e. a corollary of
  Lemma 2.7 in Gowers's notes.\<close>
 
 corollary useless_iff:
   assumes "length x = card A"
   shows "useless x \<longleftrightarrow> (\<exists>x' \<in> minimal_elements (Collect useless). x' \<unlhd> x)"  (is "_=?R")
 proof
   assume "useless x"
   obtain z where z: "useless z" "z \<unlhd> x" and zmin: "\<And>y. y \<lhd> z \<Longrightarrow> y \<unlhd> x \<Longrightarrow> useful y"
     using wfE_min [to_pred, where Q = "{z. useless z \<and> z \<unlhd> x}", OF WFP]
     by (metis (no_types, lifting) \<open>useless x\<close> mem_Collect_eq pointwise_le_refl)
   then show ?R
     by (smt (verit) mem_Collect_eq minimal_elements.intros pointwise_le_trans pointwise_less_def)
 next
   assume ?R
   with useless_leq_useless minimal_elements.cases show "useless x"
     by (metis assms mem_Collect_eq pointwise_le_iff)
 qed
 
 subsection \<open>The set of minimal elements of a set of $r$-tuples is finite\<close>
 
 text\<open>The following general finiteness claim corresponds to Lemma 2.8 in Gowers's notes and is key to
 the main proof.\<close>
 
 lemma minimal_elements_set_tuples_finite:
   assumes Ur: "\<And>x. x \<in> U \<Longrightarrow> length x = r"
   shows "finite (minimal_elements U)"
   using assms
 proof (induction r arbitrary: U)
   case 0
   then have "U \<subseteq> {[]}"
     by auto
   then show ?case
     by (metis finite.simps minimal_elements.cases finite_subset subset_eq)
 next
   case (Suc r)
   show ?case
   proof (cases "U={}")
     case True
     with Suc.IH show ?thesis by blast
   next
     case False
     then obtain u where u: "u \<in> U" and zmin: "\<And>y. y \<lhd> u \<Longrightarrow> y \<notin> U"
       using wfE_min [to_pred, where Q = "U", OF WFP] by blast
     define V where "V = {v \<in> U. \<not> u \<unlhd> v}"
     define VF where "VF \<equiv> \<lambda>i t. {v \<in> V. v!i = t}"
     have [simp]: "length v = Suc r" if "v \<in> VF i t" for v i t
       using that by (simp add: Suc.prems VF_def V_def)
     have *: "\<exists>i\<le>r. v!i < u!i" if "v \<in> V" for v
       using that u Suc.prems
       by (force simp add: V_def pointwise_le_iff_nth not_le less_Suc_eq_le)
     with u have "minimal_elements U \<le> insert u (\<Union>i\<le>r. \<Union>t < u!i. minimal_elements (VF i t))"
       by (force simp: VF_def V_def minimal_elements.simps pointwise_less_def)
     moreover
     have "finite (minimal_elements (VF i t))" if "i\<le>r" "t < u!i" for i t
     proof -
       define delete where "delete \<equiv> \<lambda>v::nat list. take i v @ drop (Suc i) v" \<comment> \<open>deletion of @{term i}\<close>
       have len_delete[simp]: "length (delete u) = r" if "u \<in> VF i t" for u
         using Suc.prems VF_def V_def \<open>i \<le> r\<close> delete_def that by auto
       have nth_delete: "delete u!k = (if k<i then u!k else u!Suc k)" if "u \<in> VF i t" "k<r" for u k
         using that by (simp add: delete_def nth_append)
       have delete_le_iff [simp]: "delete u \<unlhd> delete v \<longleftrightarrow> u \<unlhd> v" if "u \<in> VF i t" "v \<in> VF i t" for u v
       proof
         assume "delete u \<unlhd> delete v"
         then have "\<forall>j. (j < i \<longrightarrow> u!j \<le> v!j) \<and> (j < r \<longrightarrow> i \<le> j \<longrightarrow> u!Suc j \<le> v!Suc j)"
           using that \<open>i \<le> r\<close>
           by (force simp add: pointwise_le_iff_nth nth_delete split: if_split_asm cong: conj_cong)
         then show "u \<unlhd> v"
           using that \<open>i \<le> r\<close>
           apply (simp add: pointwise_le_iff_nth VF_def)
           by (metis eq_iff le_Suc_eq less_Suc_eq_0_disj linorder_not_less)
       next
         assume "u \<unlhd> v" then show "delete u \<unlhd> delete v"
           using that by (simp add: pointwise_le_iff_nth nth_delete)
       qed
       then have delete_eq_iff: "delete u = delete v \<longleftrightarrow> u = v" if "u \<in> VF i t" "v \<in> VF i t" for u v
         by (metis that pointwise_le_antisym pointwise_le_refl)
       have delete_less_iff: "delete u \<lhd> delete v \<longleftrightarrow> u \<lhd> v" if "u \<in> VF i t" "v \<in> VF i t" for u v
         by (metis delete_le_iff pointwise_le_antisym pointwise_less_def that)
       have "length (delete v) = r" if "v \<in> V" for v
         using id_take_nth_drop Suc.prems V_def \<open>i \<le> r\<close> delete_def that by auto
       then have "finite (minimal_elements (delete ` V))"
         by (metis (mono_tags, lifting) Suc.IH image_iff)
       moreover have "inj_on delete (minimal_elements (VF i t))"
         by (simp add: delete_eq_iff inj_on_def minimal_elements.simps)
       moreover have "delete ` (minimal_elements (VF i t)) \<subseteq> minimal_elements (delete ` (VF i t))"
         by (auto simp: delete_less_iff minimal_elements.simps)
       ultimately show ?thesis
         by (metis (mono_tags, lifting) Suc.IH image_iff inj_on_finite len_delete)
     qed
     ultimately show ?thesis
       by (force elim: finite_subset)
   qed
 qed
 
 subsection \<open>Towards Lemma 2.9 in Gowers's notes\<close>
 
 text \<open>Increasing sequences\<close>
 fun augmentum :: "nat list \<Rightarrow> nat list"
   where "augmentum [] = []"
   | "augmentum (n#ns) = n # map ((+)n) (augmentum ns)"
 
 definition dementum:: "nat list \<Rightarrow> nat list"
   where "dementum xs \<equiv> xs - (0#xs)"
 
 lemma dementum_Nil [simp]: "dementum [] = []"
   by (simp add: dementum_def)
 
 lemma zero_notin_augmentum [simp]: "0 \<notin> set ns \<Longrightarrow> 0 \<notin> set (augmentum ns)"
   by (induction ns) auto
 
 lemma length_augmentum [simp]:"length (augmentum xs) = length xs"
   by (induction xs) auto
 
 lemma sorted_augmentum [simp]: "0 \<notin> set ns \<Longrightarrow> sorted (augmentum ns)"
   by (induction ns) auto
 
 lemma distinct_augmentum [simp]: "0 \<notin> set ns \<Longrightarrow> distinct (augmentum ns)"
   by (induction ns) (simp_all add: image_iff)
 
 lemma augmentum_subset_sum_list: "set (augmentum ns) \<subseteq> {..\<sigma> ns}"
   by (induction ns) auto
 
 lemma sum_list_augmentum: "\<sigma> ns \<in> set (augmentum ns) \<longleftrightarrow> length ns > 0"
   by (induction ns) auto
 
 lemma length_dementum [simp]: "length (dementum xs) = length xs"
   by (simp add: dementum_def)
 
 lemma sorted_imp_pointwise:
   assumes "sorted (xs@[n])"
   shows "0 # xs \<unlhd> xs @ [n]"
   using assms
   by (simp add: pointwise_le_iff_nth nth_Cons' nth_append sorted_append sorted_wrt_append sorted_wrt_nth_less)
 
 lemma sum_list_dementum:
   assumes "sorted (xs@[n])"
   shows "\<sigma> (dementum (xs@[n])) = n"
 proof -
   have "dementum (xs@[n]) = (xs@[n]) - (0 # xs)"
     by (rule nth_equalityI; simp add: nth_append dementum_def nth_Cons')
   then show ?thesis
     by (simp add: sum_list_minus sorted_imp_pointwise assms)
 qed
 
 lemma augmentum_cancel: "map ((+)k) (augmentum ns) - (k # map ((+)k) (augmentum ns)) = ns"
 proof (induction ns arbitrary: k)
   case Nil
   then show ?case
     by simp
 next
   case (Cons n ns)
   have "(+) k \<circ> (+) n = (+) (k+n)" by auto
   then show ?case
     by (simp add: minus_Cons Cons)
 qed
 
 lemma dementum_augmentum [simp]:
   assumes "0 \<notin> set ns"
   shows "(dementum \<circ> sorted_list_of_set) ((set \<circ> augmentum) ns) = ns" (is "?L ns = _")
   using assms augmentum_cancel [of 0]
   by (simp add: dementum_def map_idI sorted_list_of_set.idem_if_sorted_distinct)
 
 lemma dementum_nonzero:
   assumes ns: "sorted_wrt (<) ns" and 0: "0 \<notin> set ns"
   shows "0 \<notin> set (dementum ns)"
   unfolding dementum_def minus_list_def
   using sorted_wrt_nth_less [OF ns] 0
   by (auto simp add: in_set_conv_nth image_iff set_zip nth_Cons' dest: leD)
 
 lemma nth_augmentum [simp]: "i < length ns \<Longrightarrow> augmentum ns!i = (\<Sum>j\<le>i. ns!j)"
 proof (induction ns arbitrary: i)
   case Nil
   then show ?case
     by simp
 next
   case (Cons a ns)
   show ?case
   proof (cases "i=0")
     case False
     then have "augmentum (a # ns)!i = a + sum ((!) ns) {..i-1}"
       using Cons.IH Cons.prems by auto
     also have "\<dots> = a + (\<Sum>j\<in>{0<..i}. ns!(j-1))"
       using sum.reindex [of Suc "{..i - Suc 0}" "\<lambda>j. ns!(j-1)", symmetric] False
       by (simp add: image_Suc_atMost atLeastSucAtMost_greaterThanAtMost del: sum.cl_ivl_Suc)
     also have "\<dots> = (\<Sum>j = 0..i. if j=0 then a else ns!(j-1))"
       by (simp add: sum.head)
     also have "\<dots> = sum ((!) (a # ns)) {..i}"
       by (simp add: nth_Cons' atMost_atLeast0)
     finally show ?thesis .
   qed auto
 qed
 
 lemma augmentum_dementum [simp]:
   assumes "0 \<notin> set ns" "sorted ns"
   shows "augmentum (dementum ns) = ns"
 proof (rule nth_equalityI)
   fix i
   assume "i < length (augmentum (dementum ns))"
   then have i: "i < length ns"
     by simp
   show "augmentum (dementum ns)!i = ns!i"
   proof (cases "i=0")
     case True
     then show ?thesis
       using nth_augmentum dementum_def i by auto
   next
     case False
     have ns_le: "\<And>j. \<lbrakk>0 < j; j \<le> i\<rbrakk> \<Longrightarrow> ns ! (j - Suc 0) \<le> ns ! j"
       using \<open>sorted ns\<close> i by (simp add: sorted_iff_nth_mono)
     have "augmentum (dementum ns)!i = (\<Sum>j\<le>i. ns!j - (if j = 0 then 0 else ns!(j-1)))"
       using i by (simp add: dementum_def nth_Cons')
     also have "\<dots> = (\<Sum>j=0..i. if j = 0 then ns!0 else ns!j - ns!(j-1))"
       by (smt (verit, best) diff_zero sum.cong atMost_atLeast0)
     also have "\<dots> = ns!0 + (\<Sum>j\<in>{0<..i}. ns!j - ns!(j-1))"
       by (simp add: sum.head)
     also have "\<dots> = ns!0 + ((\<Sum>j\<in>{0<..i}. ns!j) - (\<Sum>j\<in>{0<..i}. ns!(j-1)))"
       by (auto simp: ns_le intro: sum_subtractf_nat)
     also have "\<dots> = ns!0 + (\<Sum>j\<in>{0<..i}. ns!j) - (\<Sum>j\<in>{0<..i}. ns!(j-1))"
     proof -
       have "(\<Sum>j\<in>{0<..i}. ns ! (j - 1)) \<le> sum ((!) ns) {0<..i}"
         by (metis One_nat_def greaterThanAtMost_iff ns_le sum_mono)
       then show ?thesis by simp
     qed
     also have "\<dots> = ns!0 + (\<Sum>j\<in>{0<..i}. ns!j) - (\<Sum>j\<le>i-Suc 0. ns!j)"
       using sum.reindex [of Suc "{..i - Suc 0}" "\<lambda>j. ns!(j-1)", symmetric] False
       by (simp add: image_Suc_atMost atLeastSucAtMost_greaterThanAtMost)
     also have "\<dots> = (\<Sum>j=0..i. ns!j) - (\<Sum>j\<le>i-Suc 0. ns!j)"
       by (simp add:  sum.head [of 0 i])
     also have "\<dots> = (\<Sum>j=0..i-Suc 0. ns!j) + ns!i - (\<Sum>j\<le>i-Suc 0. ns!j)"
       by (metis False Suc_pred less_Suc0 not_less_eq sum.atLeast0_atMost_Suc)
     also have "\<dots> = ns!i"
       by (simp add: atLeast0AtMost)
     finally show "augmentum (dementum ns)!i = ns!i" .
   qed
 qed auto
 
 text\<open>The following lemma corresponds to Lemma 2.9 in Gowers's notes. The proof involves introducing
 bijective maps between r-tuples that fulfill certain properties/r-tuples and subsets of naturals,
 so as to show the cardinality claim.  \<close>
 
 lemma bound_sum_list_card:
   assumes "r > 0" and n: "n \<ge> \<sigma> x'" and lenx': "length x' = r"
   defines "S \<equiv> {x. x' \<unlhd> x \<and> \<sigma> x = n}"
   shows "card S = (n - \<sigma> x' + r - 1) choose (r-1)"
 proof-
   define m where "m \<equiv> n - \<sigma> x'"
   define f where "f \<equiv> \<lambda>x::nat list. x - x'"
   have f: "bij_betw f S (length_sum_set r m)"
   proof (intro bij_betw_imageI)
     show "inj_on f S"
       using pairwise_minus_cancel by (force simp: S_def f_def inj_on_def)
     have "\<And>x. x \<in> S \<Longrightarrow> f x \<in> length_sum_set r m"
       by (simp add: S_def f_def length_sum_set_def lenx' m_def pointwise_le_iff sum_list_minus)
     moreover have "x \<in> f ` S" if "x \<in> length_sum_set r m" for x
     proof
       have x[simp]: "length x = r" "\<sigma> x = m"
         using that by (auto simp: length_sum_set_def)
       have "x = x' + x - x'"
         by (rule nth_equalityI; simp add: lenx')
       then show "x = f (x' + x)"
         unfolding f_def by fastforce
       have "x' \<unlhd> x' + x"
         by (simp add: lenx' pointwise_le_plus)
       moreover have "\<sigma> (x' + x) = n"
         by (simp add: lenx' m_def n sum_list_plus)
       ultimately show "x' + x \<in> S"
         using S_def by blast
     qed
     ultimately show "f ` S = length_sum_set r m" by auto
   qed
   define g where "g \<equiv> \<lambda>x::nat list. map Suc x"
   define g' where "g' \<equiv> \<lambda>x::nat list. x - replicate (length x) 1"
   define T where "T \<equiv> length_sum_set r (m+r) \<inter> lists(-{0})"
   have g: "bij_betw g (length_sum_set r m) T"
   proof (intro bij_betw_imageI)
     show "inj_on g (length_sum_set r m)"
       by (auto simp: g_def inj_on_def)
     have "\<And>x. x \<in> length_sum_set r m \<Longrightarrow> g x \<in> T"
       by (auto simp: g_def length_sum_set_def sum_list_Suc T_def)
     moreover have "x \<in> g ` length_sum_set r m" if "x \<in> T" for x
     proof
       have [simp]: "length x = r"
         using length_sum_set_def that T_def by auto
       have r1_x: "replicate r (Suc 0) \<unlhd> x"
         using that unfolding T_def pointwise_le_iff_nth
         by (simp add: lists_def in_listsp_conv_set Suc_leI)
       show "x = g (g' x)"
         using that by (intro nth_equalityI) (auto simp: g_def g'_def T_def)
       show "g' x \<in> length_sum_set r m"
         using that T_def by (simp add: g'_def r1_x sum_list_minus length_sum_set_def sum_list_replicate)
     qed
     ultimately show "g ` (length_sum_set r m) = T" by auto
   qed
   define U where "U \<equiv> (insert (m+r)) ` finsets {0<..<m+r} (r-1)"
   have h: "bij_betw (set \<circ> augmentum) T U"
   proof (intro bij_betw_imageI)
     show "inj_on ((set \<circ> augmentum)) T"
       unfolding inj_on_def T_def
       by (metis ComplD IntE dementum_augmentum in_listsD insertI1)
     have "(set \<circ> augmentum) t \<in> U" if "t \<in> T" for t
     proof -
       have t: "length t = r" "\<sigma> t = m+r" "0 \<notin> set t"
         using that by (force simp add: T_def length_sum_set_def)+
       then have mrt: "m + r \<in> set (augmentum t)"
         by (metis \<open>r>0\<close> sum_list_augmentum)
       then have "set (augmentum t) = insert (m + r) (set (augmentum t) - {m + r})"
         by blast
       moreover have "set (augmentum t) - {m + r} \<in> finsets {0<..<m + r} (r - Suc 0)"
         apply (auto simp: finsets_def mrt distinct_card t)
         by (metis atMost_iff augmentum_subset_sum_list le_eq_less_or_eq subsetD t(2))
       ultimately show ?thesis
         by (metis One_nat_def U_def comp_apply imageI)
     qed
     moreover have "u \<in> (set \<circ> augmentum) ` T" if "u \<in> U" for u
     proof
       from that
       obtain N where u: "u = insert (m + r) N" and Nsub: "N \<subseteq> {0<..<m + r}"
         and [simp]: "card N = r - Suc 0"
         by (auto simp add: U_def finsets_def)
       have [simp]: "0 \<notin> N" "m+r \<notin> N" "finite N"
         using finite_subset Nsub by auto
       have [simp]: "card u = r"
         using Nsub \<open>r>0\<close> by (auto simp add: u card_insert_if)
       have ssN: "sorted (sorted_list_of_set N @ [m + r])"
         using Nsub by (simp add: less_imp_le_nat sorted_wrt_append subset_eq)
       have so_u_N: "sorted_list_of_set u = insort (m+r) (sorted_list_of_set N)"
         by (simp add: u)
       also have "\<dots> = sorted_list_of_set N @ [m+r]"
         using Nsub by (force intro: sorted_insort_is_snoc)
       finally have so_u: "sorted_list_of_set u = sorted_list_of_set N @ [m+r]" .
       have 0: "0 \<notin> set (sorted_list_of_set u)"
         by (simp add: \<open>r>0\<close> set_insort_key so_u_N)
       show "u = (set \<circ> augmentum) ((dementum \<circ> sorted_list_of_set)u)"
         using 0 so_u ssN u by force
       have sortd_wrt_u: "sorted_wrt (<) (sorted_list_of_set u)"
         by simp
       show "(dementum \<circ> sorted_list_of_set) u \<in> T"
         apply (simp add: T_def length_sum_set_def)
         using sum_list_dementum [OF ssN] sortd_wrt_u 0 by (force simp: so_u dementum_nonzero)+
     qed
     ultimately show "(set \<circ> augmentum) ` T = U" by auto
   qed
   obtain \<phi> where "bij_betw \<phi> S U"
     by (meson bij_betw_trans f g h)
   moreover have "card U = (n - \<sigma> x' + r-1) choose (r-1)"
   proof -
     have "inj_on (insert (m + r)) (finsets {0<..<m + r} (r - Suc 0))"
       by (simp add: inj_on_def finsets_def subset_iff) (meson insert_ident order_less_le)
     then have "card U = card (finsets {0<..<m + r} (r - 1))"
       unfolding U_def by (simp add: card_image)
     also have "\<dots> = (n - \<sigma> x' + r-1) choose (r-1)"
       by (simp add: card_finsets m_def)
     finally show ?thesis .
   qed
   ultimately show ?thesis
     by (metis bij_betw_same_card)
 qed
 
 subsection \<open>Towards the main theorem\<close>
 
 lemma extend_tuple:
   assumes "\<sigma> xs \<le> n" "length xs \<noteq> 0"
   obtains ys where "\<sigma> ys = n" "xs \<unlhd> ys"
 proof -
   obtain x xs' where xs: "xs = x#xs'"
     using assms list.exhaust by auto
   define y where "y \<equiv> x + n - \<sigma> xs"
   show thesis
   proof
     show "\<sigma> (y#xs') = n"
       using assms xs y_def by auto
     show "xs \<unlhd> y#xs'"
       using assms y_def pointwise_le_def xs by auto
   qed
 qed
 
 lemma extend_preserving:
   assumes "\<sigma> xs \<le> n" "length xs > 1" "i < length xs"
   obtains ys where "\<sigma> ys = n" "xs \<unlhd> ys" "ys!i = xs!i"
 proof -
   define j where "j \<equiv> Suc i mod length xs"
   define xs1 where "xs1 = take j xs"
   define xs2 where "xs2 = drop (Suc j) xs"
   define x where "x = xs!j"
   have xs: "xs = xs1 @ [x] @ xs2"
     using assms
     apply (simp add: Cons_nth_drop_Suc assms x_def xs1_def xs2_def j_def)
     by (meson Suc_lessD id_take_nth_drop mod_less_divisor)
   define y where "y \<equiv> x + n - \<sigma> xs"
   define ys where "ys \<equiv> xs1 @ [y] @ xs2"
   have "x \<le> y"
     using assms y_def by linarith
   show thesis
   proof
     show "\<sigma> ys = n"
       using assms(1) xs y_def ys_def by auto
     show "xs \<unlhd> ys"
       using xs ys_def \<open>x \<le> y\<close> pointwise_append_le_iff pointwise_le_def by fastforce
     have "length xs1 \<noteq> i"
       using assms by (simp add: xs1_def j_def min_def mod_Suc)
     then show "ys!i = xs!i"
       by (auto simp: ys_def xs nth_append nth_Cons')
   qed
 qed
 
 text\<open>The proof of the main theorem will make use of the inclusion-exclusion formula, in addition to
 the previously shown results.\<close>
 
 theorem Khovanskii:
   assumes "card A > 1"
   defines "f \<equiv> \<lambda>n. card(sumset_iterated A n)"
   obtains N p where "real_polynomial_function p" "\<And>n. n \<ge> N \<Longrightarrow> real (f n) = p (real n)"
 proof -
   define r where "r \<equiv> card A"
   define C where "C \<equiv> \<lambda>n x'. {x. x' \<unlhd> x \<and> \<sigma> x = n}"
   define X where "X \<equiv> minimal_elements {x. useless x \<and> length x = r}"
   have "r > 1" "r \<noteq> 0"
     using assms r_def by auto
   have Csub: "C n x' \<subseteq> length_sum_set (length x') n" for n x'
     by (auto simp add: C_def length_sum_set_def pointwise_le_iff)
   then have finC: "finite (C n x')" for n x'
     by (meson finite_length_sum_set finite_subset)
   have "finite X"
     using "minimal_elements_set_tuples_finite" X_def by force
   then have max_X: "\<And>x'. x' \<in> X \<Longrightarrow>  \<sigma> x' \<le> \<sigma> (max_pointwise r X)"
     using X_def max_pointwise_ge minimal_elements.simps pointwise_le_imp_\<sigma> by force
   let ?z0 = "replicate r 0"
   have Cn0: "C n ?z0 = length_sum_set r n" for n
     by (auto simp: C_def length_sum_set_def)
   then obtain p0 where pf_p0: "real_polynomial_function p0" and p0: "\<And>n. n>0 \<Longrightarrow> p0 (real n) = real (card (C n ?z0))"
     by (metis real_polynomial_function_length_sum_set)
   obtain q where pf_q: "real_polynomial_function q" and q: "\<And>x. q x = x gchoose (r-1)"
     using real_polynomial_function_gchoose by metis
   define p where "p \<equiv> \<lambda>x::real. p0 x - (\<Sum>Y | Y \<subseteq> X \<and> Y \<noteq> {}. (- 1) ^ (card Y + 1) * q((x - real(\<sigma> (max_pointwise r Y)) + real r - 1)))"
   show thesis
   proof
     note pf_q' = real_polynomial_function_compose [OF _ pf_q, unfolded o_def]
     note pf_intros = real_polynomial_function_sum real_polynomial_function_diff real_polynomial_function.intros
     show "real_polynomial_function p"
       unfolding p_def using \<open>finite X\<close> by (intro pf_p0 pf_q' pf_intros | force)+
   next
     fix n
     assume "n \<ge> max 1 (\<sigma> (max_pointwise r X))"
     then have nlarge: "n \<ge> \<sigma> (max_pointwise r X)" and "n > 0"
       by auto
     define U where "U \<equiv> \<lambda>n. length_sum_set r n \<inter> {x. useful x}"
     have 2: "(length_sum_set r n \<inter> {x. useless x}) = (\<Union>x'\<in>X. C n x')"
       unfolding C_def X_def length_sum_set_def r_def
       using useless_leq_useless by (force simp: minimal_elements.simps pointwise_le_iff useless_iff)
     define SUM1 where "SUM1 \<equiv> \<Sum>I | I \<subseteq> C n ` X \<and> I \<noteq> {}. (- 1) ^ (card I + 1) * int (card (\<Inter>I))"
     define SUM2 where "SUM2 \<equiv> \<Sum>Y | Y \<subseteq> X \<and> Y \<noteq> {}. (- 1) ^ (card Y + 1) * int (card (\<Inter>(C n ` Y)))"
     have SUM1_card: "card(length_sum_set r n \<inter> {x. useless x}) = nat SUM1"
       unfolding SUM1_def using \<open>finite X\<close> by (simp add: finC 2 card_UNION)
     have "SUM1 \<ge> 0"
       unfolding SUM1_def using card_UNION_nonneg finC \<open>finite X\<close> by auto
     have C_empty_iff: "C n x' = {} \<longleftrightarrow> \<sigma> x' > n" if "length x' \<noteq> 0" for x'
       by (simp add: set_eq_iff C_def) (meson extend_tuple linorder_not_le pointwise_le_imp_\<sigma> that)
     have C_eq_1: "C n x' = {[n]}" if "\<sigma> x' \<le> n" "length x' = 1" for x'
       using that by (auto simp: C_def length_Suc_conv pointwise_le_def elim!: list.rel_cases)
     have n_ge_X: "\<sigma> x \<le> n" if "x \<in> X" for x
       by (meson le_trans max_X nlarge that)
     have len_X_r: "x \<in> X \<Longrightarrow> length x = r" for x
       by (auto simp: X_def minimal_elements.simps)
 
     have "min_pointwise r (C n x') = x'" if "r > 1" "x' \<in> X" for x'
     proof (rule pointwise_le_antisym)
       have [simp]: "length x' = r" "\<sigma> x' \<le> n"
         using X_def minimal_elements.cases that(2) n_ge_X by auto
       have [simp]: "length (min_pointwise r (C n x')) = r"
         by (simp add: min_pointwise_def)
       show "min_pointwise r (C n x') \<unlhd> x'"
       proof (clarsimp simp add: pointwise_le_iff_nth)
         fix i
         assume "i < r"
         then obtain y where "\<sigma> y = n \<and> x' \<unlhd> y \<and> y!i \<le> x'!i"
           by (metis extend_preserving \<open>1 < r\<close> \<open>length x' = r\<close> \<open>x' \<in> X\<close> order.refl n_ge_X)
         then have "\<exists>y\<in>C n x'. y!i \<le> x'!i"
           using C_def by blast
         with \<open>i < r\<close> show "min_pointwise r (C n x')!i \<le> x'!i"
           by (simp add: min_pointwise_def Min_le_iff finC C_empty_iff leD)
       qed
       have "x' \<unlhd> min_pointwise r (C n x')" if "\<sigma> x' \<le> n" "length x' = r" for x'
         by (smt (verit, del_insts) C_def C_empty_iff \<open>r \<noteq> 0\<close> finC leD mem_Collect_eq min_pointwise_ge_iff pointwise_le_iff that)
       then show "x' \<unlhd> min_pointwise r (C n x')"
         using X_def minimal_elements.cases that by force
     qed
     then have inj_C: "inj_on (C n) X"
       by (smt (verit, best) inj_onI mem_Collect_eq \<open>r>1\<close>)
     have inj_on_imageC: "inj_on (image (C n)) (Pow X - {{}})"
       by (simp add: inj_C inj_on_diff inj_on_image_Pow)
 
     have "Pow (C n ` X) - {{}} \<subseteq> (image (C n)) ` (Pow X - {{}})"
       by (metis Pow_empty image_Pow_surj image_diff_subset image_empty)
     then have "(image (C n)) ` (Pow X - {{}}) = Pow (C n ` X) - {{}}"
       by blast
     then have "SUM1 = sum (\<lambda>I. (- 1) ^ (card I + 1) * int (card (\<Inter>I))) ((image (C n)) ` (Pow X - {{}}))"
       unfolding SUM1_def by (auto intro: sum.cong)
     also have "\<dots> = sum ((\<lambda>I. (- 1) ^ (card I + 1) * int (card (\<Inter> I))) \<circ> (image (C n))) (Pow X - {{}})"
       by (simp add: sum.reindex inj_on_imageC)
     also have "\<dots> = SUM2"
       unfolding SUM2_def using subset_inj_on [OF inj_C] by (force simp: card_image intro: sum.cong)
     finally have "SUM1 = SUM2" .
 
     have "length_sum_set r n = (length_sum_set r n \<inter> {x. useful x}) \<union> (length_sum_set r n \<inter> {x. useless x})"
       by auto
     then have "card (length_sum_set r n) =
                 card (length_sum_set r n \<inter> {x. useful x}) +
                 card (length_sum_set r n \<inter> Collect useless)"
       by (simp add: finite_length_sum_set disjnt_iff flip: card_Un_disjnt)
     moreover have "C n ?z0 = length_sum_set r n"
       by (auto simp: C_def length_sum_set_def)
     ultimately have "card (C n ?z0) = card (U n) + nat SUM2"
       by (simp add: U_def flip: \<open>SUM1 = SUM2\<close> SUM1_card)
     then have SUM2_le: "nat SUM2 \<le> card (C n ?z0)"
       by arith
     have \<sigma>_max_pointwise_le: "\<And>Y. \<lbrakk>Y \<subseteq> X; Y \<noteq> {}\<rbrakk> \<Longrightarrow> \<sigma> (max_pointwise r Y) \<le> n"
       by (meson \<open>finite X\<close> le_trans max_pointwise_mono nlarge pointwise_le_imp_\<sigma>)
 
     have card_C_max: "card (C n (max_pointwise r Y)) =
              (n - \<sigma> (max_pointwise r Y) + r - Suc 0 choose (r - Suc 0))"
       if "Y \<subseteq> X" "Y \<noteq> {}" for Y
     proof -
       have [simp]: "length (max_pointwise r Y) = r"
         by (simp add: max_pointwise_def)
       then show ?thesis
         using \<open>r \<noteq> 0\<close> that C_def by (simp add: bound_sum_list_card [of r] \<sigma>_max_pointwise_le)
     qed
 
     define SUM3 where "SUM3 \<equiv> (\<Sum>Y | Y \<subseteq> X \<and> Y \<noteq> {}.
          - ((- 1) ^ (card Y) * ((n - \<sigma> (max_pointwise r Y) + r - 1 choose (r - 1)))))"
     have "\<Inter>(C n ` Y) = C n (max_pointwise r Y)" if "Y \<subseteq> X" "Y \<noteq> {}" for Y
     proof
       show "\<Inter> (C n ` Y) \<subseteq> C n (max_pointwise r Y)"
         unfolding C_def
       proof clarsimp
         fix x
         assume "\<forall>y\<in>Y. y \<unlhd> x \<and> \<sigma> x = n"
         moreover have "finite Y"
           using \<open>finite X\<close> infinite_super that by blast
         moreover have "\<And>u. u \<in> Y \<Longrightarrow> length u = r"
           using len_X_r that by blast
         ultimately show "max_pointwise r Y \<unlhd> x \<and> \<sigma> x = n"
           by (smt (verit, del_insts) all_not_in_conv max_pointwise_le_iff pointwise_le_iff_nth that(2))
       qed
     next
       show "C n (max_pointwise r Y) \<subseteq> \<Inter> (C n ` Y)"
         apply (clarsimp simp: C_def)
         by (metis \<open>finite X\<close> finite_subset len_X_r max_pointwise_ge pointwise_le_trans subsetD that(1))
     qed
     then have "SUM2 = SUM3"
       by (simp add: SUM2_def SUM3_def card_C_max)
     have "U n = C n ?z0 - (length_sum_set r n \<inter> {x. useless x})"
       by (auto simp: U_def C_def length_sum_set_def)
     then have "card (U n) = card (C n ?z0) - card(length_sum_set r n \<inter> {x. useless x})"
       using finite_length_sum_set
       by (simp add: C_def Collect_mono_iff inf.coboundedI1 length_sum_set_def flip: card_Diff_subset)
     then have card_U_eq_diff: "card (U n) = card (C n ?z0) - nat SUM1"
       using SUM1_card by presburger
     have "SUM3 \<ge> 0"
       using \<open>0 \<le> SUM1\<close> \<open>SUM1 = SUM2\<close> \<open>SUM2 = SUM3\<close> by blast
     have **: "\<And>Y. \<lbrakk>Y \<subseteq> X; Y \<noteq> {}\<rbrakk> \<Longrightarrow> Suc (\<sigma> (max_pointwise r Y)) \<le> n + r"
       by (metis \<open>1 < r\<close> \<sigma>_max_pointwise_le add.commute add_le_mono less_or_eq_imp_le plus_1_eq_Suc)
     have "real (f n) = card (U n)"
       unfolding f_def r_def U_def length_sum_set_def
       using card_sumset_iterated_length_sum_set_useful length_sum_set_def by presburger
     also have "\<dots> = card (C n ?z0) -  nat SUM3"
       using card_U_eq_diff \<open>SUM1 = SUM2\<close> \<open>SUM2 = SUM3\<close> by presburger
     also have "\<dots> = real (card (C n (replicate r 0))) - real (nat SUM3)"
       using SUM2_le \<open>SUM2 = SUM3\<close> of_nat_diff by blast
     also have "\<dots> = p (real n)"
       using \<open>1 < r\<close> \<open>n>0\<close>
       apply (simp add: p_def p0 q \<open>SUM3 \<ge> 0\<close>)
       apply (simp add: SUM3_def binomial_gbinomial of_nat_diff \<sigma>_max_pointwise_le algebra_simps **)
       done
     finally show "real (f n) = p (real n)" .
   qed
 qed
 
 end
 
 end
diff --git a/thys/Matroids/Matroid.thy b/thys/Matroids/Matroid.thy
--- a/thys/Matroids/Matroid.thy
+++ b/thys/Matroids/Matroid.thy
@@ -1,1338 +1,1317 @@
 (*
   File:     Matroid.thy
   Author:   Jonas Keinholz
 *)
 section \<open>Matroids\<close>
 theory Matroid
   imports Indep_System
 begin
 
-lemma card_subset_ex:
-  assumes "finite A" "n \<le> card A"
-  shows "\<exists>B \<subseteq> A. card B = n"
-using assms
-proof (induction A arbitrary: n rule: finite_induct)
-  case (insert x A)
-  show ?case
-  proof (cases n)
-    case 0
-    then show ?thesis using card.empty by blast
-  next
-    case (Suc k)
-    then have "\<exists>B \<subseteq> A. card B = k" using insert by auto
-    then obtain B where "B \<subseteq> A" "card B = k" by auto
-    moreover from this have "finite B" using insert.hyps finite_subset by auto
-    ultimately have "card (insert x B) = n"
-      using Suc insert.hyps card_insert_disjoint by fastforce
-    then show ?thesis using \<open>B \<subseteq> A\<close> by blast
-  qed
-qed auto
-
 locale matroid = indep_system +
   assumes augment_aux:
     "indep X \<Longrightarrow> indep Y \<Longrightarrow> card X = Suc (card Y) \<Longrightarrow> \<exists>x \<in> X - Y. indep (insert x Y)"
 begin
 
 lemma augment:
   assumes "indep X" "indep Y" "card Y < card X"
   shows "\<exists>x \<in> X - Y. indep (insert x Y)"
 proof -
   obtain X' where "X' \<subseteq> X" "card X' = Suc (card Y)"
-    using assms card_subset_ex[of X "Suc (card Y)"] indep_finite by auto
+    using assms obtain_subset_with_card_n[of "Suc (card Y)" X] indep_finite by (metis Suc_leI)
   then obtain x where "x \<in> X' - Y"  "indep (insert x Y)"
     using assms augment_aux[of X' Y] indep_subset by auto
   then show ?thesis using \<open>X' \<subseteq> X\<close> by auto
 qed
 
 lemma augment_psubset:
   assumes "indep X" "indep Y" "Y \<subset> X"
   shows "\<exists>x \<in> X - Y. indep (insert x Y)"
   using assms augment psubset_card_mono indep_finite by blast
 
 subsection \<open>Minors\<close>
 
 text \<open>
   A subset of the ground set induces a matroid.
 \<close>
 
 lemma matroid_subset [simp, intro]:
   assumes "\<E> \<subseteq> carrier"
   shows "matroid \<E> (indep_in \<E>)"
   unfolding matroid_def matroid_axioms_def
 proof (safe, goal_cases indep_system augment)
   case indep_system
   then show ?case using indep_system_subset[OF assms] .
 next
   case (augment X Y)
   then show ?case using augment_aux[of X Y] unfolding indep_in_def by auto
 qed
 
 context
   fixes \<E>
   assumes "\<E> \<subseteq> carrier"
 begin
 
 interpretation \<E>: matroid \<E> "indep_in \<E>"
   using \<open>\<E> \<subseteq> carrier\<close> by auto
 
 lemmas augment_aux_indep_in = \<E>.augment_aux
 lemmas augment_indep_in = \<E>.augment
 lemmas augment_psubset_indep_in = \<E>.augment_psubset
 
 end
 
 subsection \<open>Bases\<close>
 
 lemma basis_card:
   assumes "basis B\<^sub>1"
   assumes "basis B\<^sub>2"
   shows "card B\<^sub>1 = card B\<^sub>2"
 proof (rule ccontr, goal_cases False)
   case False
   then have "card B\<^sub>1 < card B\<^sub>2 \<or> card B\<^sub>2 < card B\<^sub>1" by auto
   moreover {
     fix B\<^sub>1 B\<^sub>2
     assume "basis B\<^sub>1" "basis B\<^sub>2" "card B\<^sub>1 < card B\<^sub>2"
     then obtain x where "x \<in> B\<^sub>2 - B\<^sub>1" "indep (insert x B\<^sub>1)"
       using augment basisD by blast
     then have "x \<in> carrier - B\<^sub>1"
       using \<open>basis B\<^sub>1\<close> basisD indep_subset_carrier by blast
     then have "\<not> indep (insert x B\<^sub>1)" using \<open>basis B\<^sub>1\<close> basisD by auto
     then have "False" using \<open>indep (insert x B\<^sub>1)\<close> by auto
   }
   ultimately show ?case using assms by auto
 qed
 
 lemma basis_indep_card:
   assumes "indep X"
   assumes "basis B"
   shows "card X \<le> card B"
 proof -
   obtain B' where "basis B'" "X \<subseteq> B'" using assms indep_imp_subset_basis by auto
   then show ?thesis using assms basis_finite basis_card[of B B'] by (auto intro: card_mono)
 qed
 
 lemma basis_augment:
   assumes "basis B\<^sub>1" "basis B\<^sub>2" "x \<in> B\<^sub>1 - B\<^sub>2"
   shows "\<exists>y \<in> B\<^sub>2 - B\<^sub>1. basis (insert y (B\<^sub>1 - {x}))"
 proof -
   let ?B\<^sub>1 = "B\<^sub>1 - {x}"
   have "card ?B\<^sub>1 < card B\<^sub>2"
     using assms basis_card[of B\<^sub>1 B\<^sub>2] card_Diff1_less[OF basis_finite, of B\<^sub>1] by auto
   moreover have "indep ?B\<^sub>1" using assms basis_indep[of B\<^sub>1] indep_subset[of B\<^sub>1 ?B\<^sub>1] by auto
   ultimately obtain y where y: "y \<in> B\<^sub>2 - ?B\<^sub>1" "indep (insert y ?B\<^sub>1)"
     using assms augment[of B\<^sub>2 ?B\<^sub>1] basis_indep by auto
   let ?B\<^sub>1' = "insert y ?B\<^sub>1"
   have "basis ?B\<^sub>1'" using \<open>indep ?B\<^sub>1'\<close>
   proof (rule basisI, goal_cases "insert")
     case (insert x)
     have "card (insert x ?B\<^sub>1') > card B\<^sub>1"
     proof -
       have "card (insert x ?B\<^sub>1') = Suc (card ?B\<^sub>1')"
         using insert card.insert_remove[OF indep_finite, of ?B\<^sub>1'] y by auto
       also have "\<dots> = Suc (Suc (card ?B\<^sub>1))"
         using card.insert_remove[OF indep_finite, of ?B\<^sub>1] \<open>indep ?B\<^sub>1\<close> y by auto
       also have "\<dots> = Suc (card B\<^sub>1)"
         using assms basis_finite[of B\<^sub>1] card.remove[of B\<^sub>1] by auto
       finally show ?thesis by auto
     qed
     then have "\<not>indep (insert x (insert y ?B\<^sub>1))"
       using assms basis_indep_card[of "insert x (insert y ?B\<^sub>1)" B\<^sub>1] by auto
     moreover have "insert x (insert y ?B\<^sub>1) \<subseteq> carrier"
       using assms insert y basis_finite indep_subset_carrier by auto
     ultimately show ?case by auto
   qed
   then show ?thesis using assms y by auto
 qed
 
 context
   fixes \<E>
   assumes *: "\<E> \<subseteq> carrier"
 begin
 
 interpretation \<E>: matroid \<E> "indep_in \<E>"
   using \<open>\<E> \<subseteq> carrier\<close> by auto
 
 lemmas basis_in_card = \<E>.basis_card[OF basis_inD_aux[OF *] basis_inD_aux[OF *]]
 lemmas basis_in_indep_in_card = \<E>.basis_indep_card[OF _ basis_inD_aux[OF *]]
 
 lemma basis_in_augment:
   assumes "basis_in \<E> B\<^sub>1" "basis_in \<E> B\<^sub>2" "x \<in> B\<^sub>1 - B\<^sub>2"
   shows "\<exists>y \<in> B\<^sub>2 - B\<^sub>1. basis_in \<E> (insert y (B\<^sub>1 - {x}))"
   using assms \<E>.basis_augment unfolding basis_in_def by auto
 
 end
 
 subsection \<open>Circuits\<close>
 
 lemma circuit_elim:
   assumes "circuit C\<^sub>1" "circuit C\<^sub>2" "C\<^sub>1 \<noteq> C\<^sub>2" "x \<in> C\<^sub>1 \<inter> C\<^sub>2"
   shows "\<exists>C\<^sub>3 \<subseteq> (C\<^sub>1 \<union> C\<^sub>2) - {x}. circuit C\<^sub>3"
 proof -
   let ?C = "(C\<^sub>1 \<union> C\<^sub>2) - {x}"
   let ?carrier = "C\<^sub>1 \<union> C\<^sub>2"
 
   have assms': "circuit_in carrier C\<^sub>1" "circuit_in carrier C\<^sub>2"
     using assms circuit_imp_circuit_in by auto
 
   have "?C \<subseteq> carrier" using assms circuit_subset_carrier by auto
   show ?thesis
   proof (cases "indep ?C")
     case False
     then show ?thesis using dep_iff_supset_circuit \<open>?C \<subseteq> carrier\<close> by auto
   next
     case True
     then have "indep_in ?carrier ?C" using \<open>?C \<subseteq> carrier\<close> by (auto intro: indep_inI)
 
     have *: "?carrier \<subseteq> carrier" using assms circuit_subset_carrier by auto
     obtain y where y: "y \<in> C\<^sub>2" "y \<notin> C\<^sub>1" using assms circuit_subset_eq by blast
     then have "indep_in ?carrier (C\<^sub>2 - {y})"
       using assms' circuit_in_min_dep_in[OF * circuit_in_supI[OF *, of C\<^sub>2]] by auto
     then obtain B where B: "basis_in ?carrier B" "C\<^sub>2 - {y} \<subseteq> B"
       using * assms indep_in_imp_subset_basis_in[of ?carrier "C\<^sub>2 - {y}"] by auto
 
     have "y \<notin> B"
     proof (rule ccontr, goal_cases False)
       case False
       then have "C\<^sub>2 \<subseteq> B" using B by auto
       moreover have "circuit_in ?carrier C\<^sub>2" using * assms' circuit_in_supI by auto
       ultimately have "\<not> indep_in ?carrier B"
         using B basis_in_subset_carrier[OF *] supset_circuit_in_imp_dep_in[OF *] by auto
       then show False using assms B basis_in_indep_in[OF *] by auto
     qed
 
     have "C\<^sub>1 - B \<noteq> {}"
     proof (rule ccontr, goal_cases False)
       case False
       then have "C\<^sub>1 - (C\<^sub>1 \<inter> B) = {}" by auto
       then have "C\<^sub>1 = C\<^sub>1 \<inter> B" using assms circuit_subset_eq by auto
       moreover have "indep (C\<^sub>1 \<inter> B)"
         using assms B basis_in_indep_in[OF *] indep_in_subset[OF *, of B "C\<^sub>1 \<inter> B"] indep_in_indep
         by auto
       ultimately show ?case using assms circuitD by auto
     qed
     then obtain z where z: "z \<in> C\<^sub>1" "z \<notin> B" by auto
 
     have "y \<noteq> z" using y z by auto
     have "x \<in> C\<^sub>1" "x \<in> C\<^sub>2" using assms by auto
 
     have "finite ?carrier" using assms carrier_finite finite_subset by auto
     have "card B \<le> card (?carrier - {y, z})"
     proof (rule card_mono)
       show "finite (C\<^sub>1 \<union> C\<^sub>2 - {y, z})" using \<open>finite ?carrier\<close> by auto
     next
       show "B \<subseteq> C\<^sub>1 \<union> C\<^sub>2 - {y, z}"
         using B basis_in_subset_carrier[OF *, of B] \<open>y \<notin> B\<close> \<open>z \<notin> B\<close> by auto
     qed
     also have "\<dots> = card ?carrier - 2"
       using \<open>finite ?carrier\<close> \<open>y \<in> C\<^sub>2\<close> \<open>z \<in> C\<^sub>1\<close> \<open>y \<noteq> z\<close> card_Diff_subset_Int by auto
     also have "\<dots> < card ?carrier - 1"
     proof -
       have "card ?carrier = card C\<^sub>1 + card C\<^sub>2 - card (C\<^sub>1 \<inter> C\<^sub>2)"
         using assms \<open>finite ?carrier\<close> card_Un_Int[of C\<^sub>1 C\<^sub>2] by auto
       also have "\<dots> = card C\<^sub>1 + (card C\<^sub>2 - card (C\<^sub>1 \<inter> C\<^sub>2))"
         using assms \<open>finite ?carrier\<close> card_mono[of C\<^sub>2] by auto
       also have "\<dots> = card C\<^sub>1 + card (C\<^sub>2 - C\<^sub>1)"
       proof -
         have "card (C\<^sub>2 - C\<^sub>1) = card C\<^sub>2 - card (C\<^sub>2 \<inter> C\<^sub>1)"
           using assms \<open>finite ?carrier\<close> card_Diff_subset_Int[of C\<^sub>2 C\<^sub>1] by auto
         also have "\<dots> = card C\<^sub>2 - card (C\<^sub>1 \<inter> C\<^sub>2)" by (simp add: inf_commute)
         finally show ?thesis by auto
       qed
       finally have "card (C\<^sub>1 \<union> C\<^sub>2) = card C\<^sub>1 + card (C\<^sub>2 - C\<^sub>1)" .
       moreover have "card C\<^sub>1 > 0" using assms circuit_nonempty \<open>finite ?carrier\<close> by auto
       moreover have "card (C\<^sub>2 - C\<^sub>1) > 0" using assms \<open>finite ?carrier\<close> \<open>y \<in> C\<^sub>2\<close> \<open>y \<notin> C\<^sub>1\<close> by auto
       ultimately show ?thesis by auto
     qed
     also have "\<dots> = card ?C"
       using \<open>finite ?carrier\<close> card_Diff_singleton \<open>x \<in> C\<^sub>1\<close> \<open>x \<in> C\<^sub>2\<close> by auto
     finally have "card B < card ?C" .
     then have False
       using basis_in_indep_in_card[OF *, of ?C B] B \<open>indep_in ?carrier ?C\<close> by auto
     then show ?thesis by auto
   qed
 qed
 
 lemma min_dep_imp_supset_circuit:
   assumes "indep X"
   assumes "circuit C"
   assumes "C \<subseteq> insert x X"
   shows "x \<in> C"
 proof (rule ccontr)
   assume "x \<notin> C"
   then have "C \<subseteq> X" using assms by auto
   then have "indep C" using assms indep_subset by auto
   then show False using assms circuitD by auto
 qed
 
 lemma min_dep_imp_ex1_supset_circuit:
   assumes "x \<in> carrier"
   assumes "indep X"
   assumes "\<not> indep (insert x X)"
   shows "\<exists>!C. circuit C \<and> C \<subseteq> insert x X"
 proof -
   obtain C where C: "circuit C" "C \<subseteq> insert x X"
     using assms indep_subset_carrier dep_iff_supset_circuit by auto
 
   show ?thesis
   proof (rule ex1I, goal_cases ex unique)
     show "circuit C \<and> C \<subseteq> insert x X" using C by auto
   next
     {
       fix C'
       assume C': "circuit C'" "C' \<subseteq> insert x X"
       have "C' = C"
       proof (rule ccontr)
         assume "C' \<noteq> C"
         moreover have "x \<in> C' \<inter> C" using C C' assms min_dep_imp_supset_circuit by auto
         ultimately have "\<not> indep (C' \<union> C - {x})"
           using circuit_elim[OF C(1) C'(1), of x] supset_circuit_imp_dep[of _ "C' \<union> C - {x}"] by auto
         moreover have "C' \<union> C - {x} \<subseteq> X" using C C' by auto
         ultimately show False using assms indep_subset by auto
       qed
     }
     then show "\<And>C'. circuit C' \<and> C' \<subseteq> insert x X \<Longrightarrow> C' = C"
       by auto
   qed
 qed
 
 lemma basis_ex1_supset_circuit:
   assumes "basis B"
   assumes "x \<in> carrier - B"
   shows "\<exists>!C. circuit C \<and> C \<subseteq> insert x B"
   using assms min_dep_imp_ex1_supset_circuit basisD by auto
 
 definition fund_circuit :: "'a \<Rightarrow> 'a set \<Rightarrow> 'a set" where
   "fund_circuit x B \<equiv> (THE C. circuit C \<and> C \<subseteq> insert x B)"
 
 lemma circuit_iff_fund_circuit:
   "circuit C \<longleftrightarrow> (\<exists>x B. x \<in> carrier - B \<and> basis B \<and> C = fund_circuit x B)"
 proof (safe, goal_cases LTR RTL)
   case LTR
   then obtain x where "x \<in> C" using circuit_nonempty by auto
   then have "indep (C - {x})" using LTR unfolding circuit_def by auto
   then obtain B where B: "basis B" "C - {x} \<subseteq> B" using indep_imp_subset_basis by auto
   then have "x \<in> carrier" using LTR circuit_subset_carrier \<open>x \<in> C\<close> by auto
   moreover have "x \<notin> B"
   proof (rule ccontr, goal_cases False)
     case False
     then have "C \<subseteq> B" using \<open>C - {x} \<subseteq> B\<close> by auto
     then have "\<not> indep B" using LTR B basis_subset_carrier supset_circuit_imp_dep by auto
     then show ?case using B basis_indep by auto
   qed
   ultimately show ?case
     unfolding fund_circuit_def
     using LTR B theI_unique[OF basis_ex1_supset_circuit[of B x], of C] by auto
 next
   case (RTL x B)
   then have "\<exists>!C. circuit C \<and> C \<subseteq> insert x B"
     using min_dep_imp_ex1_supset_circuit basisD[of B] by auto
   then show ?case
     unfolding fund_circuit_def
     using theI[of "\<lambda>C. circuit C \<and> C \<subseteq> insert x B"] by fastforce
 qed
 
 lemma fund_circuitI:
   assumes "basis B"
   assumes "x \<in> carrier - B"
   assumes "circuit C"
   assumes "C \<subseteq> insert x B"
   shows "fund_circuit x B = C"
   unfolding fund_circuit_def
   using assms theI_unique[OF basis_ex1_supset_circuit, of B x C] by auto
 
 definition fund_circuit_in where "fund_circuit_in \<E> x B \<equiv> matroid.fund_circuit \<E> (indep_in \<E>) x B"
 
 context
   fixes \<E>
   assumes *: "\<E> \<subseteq> carrier"
 begin
 
 interpretation \<E>: matroid \<E> "indep_in \<E>"
   using \<open>\<E> \<subseteq> carrier\<close> by auto
 
 lemma fund_circuit_inI_aux: "\<E>.fund_circuit x B = fund_circuit_in \<E> x B"
   unfolding fund_circuit_in_def by auto
 
 lemma circuit_in_elim:
   assumes "circuit_in \<E> C\<^sub>1" "circuit_in \<E> C\<^sub>2" "C\<^sub>1 \<noteq> C\<^sub>2" "x \<in> C\<^sub>1 \<inter> C\<^sub>2"
   shows "\<exists>C\<^sub>3 \<subseteq> (C\<^sub>1 \<union> C\<^sub>2) - {x}. circuit_in \<E> C\<^sub>3"
   using assms \<E>.circuit_elim unfolding circuit_in_def by auto
 
 lemmas min_dep_in_imp_supset_circuit_in = \<E>.min_dep_imp_supset_circuit[OF _ circuit_inD_aux[OF *]]
 
 lemma min_dep_in_imp_ex1_supset_circuit_in:
   assumes "x \<in> \<E>"
   assumes "indep_in \<E> X"
   assumes "\<not> indep_in \<E> (insert x X)"
   shows "\<exists>!C. circuit_in \<E> C \<and> C \<subseteq> insert x X"
   using assms \<E>.min_dep_imp_ex1_supset_circuit unfolding circuit_in_def by auto
 
 lemma basis_in_ex1_supset_circuit_in:
   assumes "basis_in \<E> B"
   assumes "x \<in> \<E> - B"
   shows "\<exists>!C. circuit_in \<E> C \<and> C \<subseteq> insert x B"
   using assms \<E>.basis_ex1_supset_circuit unfolding circuit_in_def basis_in_def by auto
 
 lemma fund_circuit_inI:
   assumes "basis_in \<E> B"
   assumes "x \<in> \<E> - B"
   assumes "circuit_in \<E> C"
   assumes "C \<subseteq> insert x B"
   shows "fund_circuit_in \<E> x B = C"
   using assms \<E>.fund_circuitI
   unfolding basis_in_def circuit_in_def fund_circuit_in_def by auto
 
 end
 
 context
   fixes \<E>
   assumes *: "\<E> \<subseteq> carrier"
 begin
 
 interpretation \<E>: matroid \<E> "indep_in \<E>"
   using \<open>\<E> \<subseteq> carrier\<close> by auto
 
 lemma fund_circuit_in_sub_cong:
   assumes "\<E>' \<subseteq> \<E>"
   assumes "x \<in> \<E>' - B"
   assumes "basis_in \<E>' B"
   shows "\<E>.fund_circuit_in \<E>' x B = fund_circuit_in \<E>' x B"
 proof -
   obtain C where C: "circuit_in \<E>' C" "C \<subseteq> insert x B"
     using * assms basis_in_ex1_supset_circuit_in[of \<E>' B x] by auto
   then have "fund_circuit_in \<E>' x B = C"
     using * assms fund_circuit_inI by auto
   also have "\<dots> = \<E>.fund_circuit_in \<E>' x B"
     using * assms C \<E>.fund_circuit_inI basis_in_sub_cong[of \<E>] circuit_in_sub_cong[of \<E>] by auto
   finally show ?thesis by auto
 qed
 
 end
 
 subsection \<open>Ranks\<close>
 
 abbreviation rank_of where "rank_of \<equiv> lower_rank_of"
 
 lemmas rank_of_def = lower_rank_of_def
 lemmas rank_of_sub_cong = lower_rank_of_sub_cong
 lemmas rank_of_le = lower_rank_of_le
 
 context
   fixes \<E>
   assumes *: "\<E> \<subseteq> carrier"
 begin
 
 interpretation \<E>: matroid \<E> "indep_in \<E>"
   using * by auto
 
 lemma lower_rank_of_eq_upper_rank_of: "lower_rank_of \<E> = upper_rank_of \<E>"
 proof -
   obtain B where "basis_in \<E> B" using basis_in_ex[OF *] by auto
   then have "{card B | B. basis_in \<E> B} = {card B}"
     by safe (auto dest: basis_in_card[OF *])
   then show ?thesis unfolding lower_rank_of_def upper_rank_of_def by auto
 qed
 
 lemma rank_of_eq_card_basis_in:
   assumes "basis_in \<E> B"
   shows "rank_of \<E> = card B"
 proof -
   have "{card B | B. basis_in \<E> B} = {card B}" using assms by safe (auto dest: basis_in_card[OF *])
   then show ?thesis unfolding rank_of_def by auto
 qed
 
 lemma rank_of_indep_in_le:
   assumes "indep_in \<E> X"
   shows "card X \<le> rank_of \<E>"
 proof -
   {
     fix B
     assume "basis_in \<E> B"
     moreover obtain B' where "basis_in \<E> B'" "X \<subseteq> B'"
       using assms indep_in_imp_subset_basis_in[OF *] by auto
     ultimately have "card X \<le> card B"
       using card_mono[OF basis_in_finite[OF *]] basis_in_card[OF *, of B B'] by auto
   }
   moreover have "finite {card B | B. basis_in \<E> B}"
     using collect_basis_in_finite[OF *] by auto
   ultimately show ?thesis
     unfolding rank_of_def using basis_in_ex[OF *] by auto
 qed
 
 end
 
 lemma rank_of_mono:
   assumes "X \<subseteq> Y"
   assumes "Y \<subseteq> carrier"
   shows "rank_of X \<le> rank_of Y"
 proof -
   obtain B\<^sub>X where B\<^sub>X: "basis_in X  B\<^sub>X" using assms basis_in_ex[of X] by auto
   moreover obtain B\<^sub>Y where B\<^sub>Y: "basis_in Y B\<^sub>Y" using assms basis_in_ex[of Y] by auto
   moreover have "card B\<^sub>X \<le> card B\<^sub>Y"
     using assms basis_in_indep_in_card[OF _ _ B\<^sub>Y] basis_in_indep_in[OF _ B\<^sub>X] indep_in_subI_subset
     by auto
   ultimately show ?thesis using assms rank_of_eq_card_basis_in by auto
 qed
 
 lemma rank_of_insert_le:
   assumes "X \<subseteq> carrier"
   assumes "x \<in> carrier"
   shows "rank_of (insert x X) \<le> Suc (rank_of X)"
 proof -
   obtain B where B: "basis_in X B" using assms basis_in_ex[of X] by auto
   have "basis_in (insert x X) B \<or> basis_in (insert x X) (insert x B)"
   proof -
     obtain B' where B': "B' \<subseteq> insert x X - X" "basis_in (insert x X) (B \<union> B')"
       using assms B basis_in_subI[of "insert x X" X B] by auto
     then have "B' = {} \<or> B' = {x}" by auto
     then show ?thesis
     proof
       assume "B' = {}"
       then have "basis_in (insert x X) B" using B' by auto
       then show ?thesis by auto
     next
       assume "B' = {x}"
       then have "basis_in (insert x X) (insert x B)" using B' by auto
       then show ?thesis by auto
     qed
   qed
   then show ?thesis
   proof
     assume "basis_in (insert x X) B"
     then show ?thesis
       using assms B rank_of_eq_card_basis_in by auto
   next
     assume "basis_in (insert x X) (insert x B)"
     then have "rank_of (insert x X) = card (insert x B)"
       using assms rank_of_eq_card_basis_in by auto
     also have "\<dots> = Suc (card (B - {x}))"
       using assms card.insert_remove[of B x] using B basis_in_finite by auto
     also have "\<dots> \<le> Suc (card B)"
       using assms B basis_in_finite card_Diff1_le[of B] by auto
     also have "\<dots> = Suc (rank_of X)"
       using assms B rank_of_eq_card_basis_in by auto
     finally show ?thesis .
   qed
 qed
 
 lemma rank_of_Un_Int_le:
   assumes "X \<subseteq> carrier"
   assumes "Y \<subseteq> carrier"
   shows "rank_of (X \<union> Y) + rank_of (X \<inter> Y) \<le> rank_of X + rank_of Y"
 proof -
   obtain B_Int where B_Int: "basis_in (X \<inter> Y) B_Int" using assms basis_in_ex[of "X \<inter> Y"] by auto
   then have "indep_in (X \<union> Y) B_Int"
     using assms indep_in_subI_subset[OF _ basis_in_indep_in[of "X \<inter> Y" B_Int], of "X \<union> Y"] by auto
   then obtain B_Un where B_Un: "basis_in (X \<union> Y) B_Un" "B_Int \<subseteq> B_Un"
     using assms indep_in_imp_subset_basis_in[of "X \<union> Y" B_Int] by auto
 
   have "card (B_Un \<inter> (X \<union> Y)) + card (B_Un \<inter> (X \<inter> Y)) = card ((B_Un \<inter> X) \<union> (B_Un \<inter> Y)) + card ((B_Un \<inter> X) \<inter> (B_Un \<inter> Y))"
     by (simp add: inf_assoc inf_left_commute inf_sup_distrib1)
   also have "\<dots> = card (B_Un \<inter> X) + card (B_Un \<inter> Y)"
   proof -
     have "finite (B_Un \<inter> X)" "finite (B_Un \<inter> Y)"
       using assms finite_subset[OF _ carrier_finite] by auto
     then show ?thesis using card_Un_Int[of "B_Un \<inter> X" "B_Un \<inter> Y"] by auto
   qed
   also have "\<dots> \<le> rank_of X + rank_of Y"
   proof -
     have "card (B_Un \<inter> X) \<le> rank_of X"
     proof -
       have "indep_in X (B_Un \<inter> X)" using assms basis_in_indep_in[OF _ B_Un(1)] indep_in_subI by auto
       then show ?thesis using assms rank_of_indep_in_le by auto
     qed
     moreover have "card (B_Un \<inter> Y) \<le> rank_of Y"
     proof -
       have "indep_in Y (B_Un \<inter> Y)" using assms basis_in_indep_in[OF _ B_Un(1)] indep_in_subI by auto
       then show ?thesis using assms rank_of_indep_in_le by auto
     qed
     ultimately show ?thesis by auto
   qed
   finally have "rank_of X + rank_of Y \<ge> card (B_Un \<inter> (X \<union> Y)) + card (B_Un \<inter> (X \<inter> Y))" .
   moreover have "B_Un \<inter> (X \<union> Y) = B_Un" using assms basis_in_subset_carrier[OF _ B_Un(1)] by auto
   moreover have "B_Un \<inter> (X \<inter> Y) = B_Int"
   proof -
     have "card (B_Un \<inter> (X \<inter> Y)) \<le> card B_Int"
     proof -
       have "indep_in (X \<inter> Y) (B_Un \<inter> (X \<inter> Y))"
         using assms basis_in_indep_in[OF _ B_Un(1)] indep_in_subI by auto
       then show ?thesis using assms basis_in_indep_in_card[of "X \<inter> Y" _ B_Int] B_Int by auto
     qed
     moreover have "finite (B_Un \<inter> (X \<inter> Y))"
       using assms carrier_finite finite_subset[of "B_Un \<inter> (X \<inter> Y)"] by auto
     moreover have "B_Int \<subseteq> B_Un \<inter> (X \<inter> Y)"
       using assms B_Un B_Int basis_in_subset_carrier[of "X \<inter> Y" B_Int] by auto
     ultimately show ?thesis using card_seteq by blast
   qed
   ultimately have "rank_of X + rank_of Y \<ge> card B_Un + card B_Int" by auto
   moreover have "card B_Un = rank_of (X \<union> Y)"
     using assms rank_of_eq_card_basis_in[OF _ B_Un(1)] by auto
   moreover have "card B_Int = rank_of (X \<inter> Y)"
     using assms rank_of_eq_card_basis_in[OF _ B_Int] by fastforce
   ultimately show "rank_of X + rank_of Y \<ge> rank_of (X \<union> Y) + rank_of (X \<inter> Y)" by auto
 qed
 
 lemma rank_of_Un_absorbI:
   assumes "X \<subseteq> carrier" "Y \<subseteq> carrier"
   assumes "\<And>y. y \<in> Y - X \<Longrightarrow> rank_of (insert y X) = rank_of X"
   shows "rank_of (X \<union> Y) = rank_of X"
 proof -
   have "finite (Y - X)" using finite_subset[OF \<open>Y \<subseteq> carrier\<close>] carrier_finite by auto
   then show ?thesis using assms
   proof (induction "Y - X" arbitrary: Y rule: finite_induct )
     case empty
     then have "X \<union> Y = X" by auto
     then show ?case by auto
   next
     case (insert y F)
     have "rank_of (X \<union> Y) + rank_of X \<le> rank_of X + rank_of X"
     proof -
       have "rank_of (X \<union> Y) + rank_of X = rank_of ((X \<union> (Y - {y})) \<union> (insert y X)) + rank_of ((X \<union> (Y - {y})) \<inter> (insert y X))"
       proof -
         have "X \<union> Y = (X \<union> (Y - {y})) \<union> (insert y X)" "X = (X \<union> (Y - {y})) \<inter> (insert y X)" using insert by auto
         then show ?thesis by auto
       qed
       also have "\<dots> \<le> rank_of (X \<union> (Y - {y})) +  rank_of (insert y X)"
       proof (rule rank_of_Un_Int_le)
         show "X \<union> (Y - {y}) \<subseteq> carrier" using insert by auto
       next
         show "insert y X \<subseteq> carrier" using insert by auto
       qed
       also have "\<dots> = rank_of (X \<union> (Y - {y})) + rank_of X"
       proof -
         have "y \<in> Y - X" using insert by auto
         then show ?thesis using insert by auto
       qed
       also have "\<dots> = rank_of X + rank_of X"
       proof -
         have "F = (Y - {y}) - X" "Y - {y} \<subseteq> carrier" using insert by auto
         then show ?thesis using insert insert(3)[of "Y - {y}"] by auto
       qed
       finally show ?thesis .
     qed
     moreover have "rank_of (X \<union> Y) + rank_of X \<ge> rank_of X + rank_of X"
       using insert rank_of_mono by auto
     ultimately show ?case by auto
   qed
 qed
 
 lemma indep_iff_rank_of:
   assumes "X \<subseteq> carrier"
   shows "indep X \<longleftrightarrow> rank_of X = card X"
 proof (standard, goal_cases LTR RTL)
   case LTR
   then have "indep_in X X" by (auto intro: indep_inI)
   then have "basis_in X X" by (auto intro: basis_inI[OF assms])
   then show ?case using rank_of_eq_card_basis_in[OF assms] by auto
 next
   case RTL
   obtain B where B: "basis_in X B" using basis_in_ex[OF assms] by auto
   then have "card B = card X" using RTL rank_of_eq_card_basis_in[OF assms] by auto
   then have "B = X"
     using basis_in_subset_carrier[OF assms B] card_seteq[OF finite_subset[OF assms carrier_finite]]
     by auto
   then show ?case using basis_in_indep_in[OF assms B] indep_in_indep by auto
 qed
 
 lemma basis_iff_rank_of:
   assumes "X \<subseteq> carrier"
   shows "basis X \<longleftrightarrow> rank_of X = card X \<and> rank_of X = rank_of carrier"
 proof (standard, goal_cases LTR RTL)
   case LTR
   then have "rank_of X = card X" using assms indep_iff_rank_of basis_indep by auto
   moreover have "\<dots> = rank_of carrier"
     using LTR rank_of_eq_card_basis_in[of carrier X] basis_iff_basis_in by auto
   ultimately show ?case by auto
 next
   case RTL
   show ?case
   proof (rule basisI)
     show "indep X" using assms RTL indep_iff_rank_of by blast
   next
     fix x
     assume x: "x \<in> carrier - X"
     show "\<not> indep (insert x X)"
     proof (rule ccontr, goal_cases False)
       case False
       then have "card (insert x X) \<le> rank_of carrier"
         using assms x indep_inI rank_of_indep_in_le by auto
       also have "\<dots> = card X" using RTL by auto
       finally show ?case using finite_subset[OF assms carrier_finite] x by auto
     qed
   qed
 qed
 
 lemma circuit_iff_rank_of:
   assumes "X \<subseteq> carrier"
   shows "circuit X \<longleftrightarrow> X \<noteq> {} \<and> (\<forall>x \<in> X. rank_of (X - {x}) = card (X - {x}) \<and> card (X - {x}) = rank_of X)"
 proof (standard, goal_cases LTR RTL)
   case LTR
   then have "X \<noteq> {}" using circuit_nonempty by auto
   moreover have indep_remove: "\<And>x. x \<in> X \<Longrightarrow> rank_of (X - {x}) = card (X - {x})"
   proof -
     fix x
     assume "x \<in> X"
     then have "indep (X - {x})" using circuit_min_dep[OF LTR] by auto
     moreover have "X - {x} \<subseteq> carrier" using assms by auto
     ultimately show "rank_of (X - {x}) = card (X - {x})" using indep_iff_rank_of by auto
   qed
   moreover have "\<And>x. x \<in> X \<Longrightarrow> rank_of (X - {x}) = rank_of X"
   proof -
     fix x
     assume *: "x \<in> X"
     have "rank_of X \<le> card X" using assms rank_of_le by auto
     moreover have "rank_of X \<noteq> card X" using assms LTR circuitD indep_iff_rank_of[of X] by auto
     ultimately have "rank_of X < card X" by auto
     then have "rank_of X \<le> card (X - {x})" using * finite_subset[OF assms] carrier_finite by auto
     also have "\<dots> = rank_of (X - {x})" using indep_remove \<open>x \<in> X\<close> by auto
     finally show "rank_of (X - {x}) = rank_of X" using assms rank_of_mono[of "X - {x}" X] by auto
   qed
   ultimately show ?case by auto
 next
   case RTL
   then have "X \<noteq> {}"
     and indep_remove: "\<And>x. x \<in> X \<Longrightarrow> rank_of (X - {x}) = card (X - {x})"
     and dep: "\<And>x. x \<in> X \<Longrightarrow> rank_of (X - {x}) = rank_of X"
     by auto
   show ?case using assms
   proof (rule circuitI)
     obtain x where x: "x \<in> X" using \<open>X \<noteq> {}\<close> by auto
     then have "rank_of X = card (X - {x})" using dep indep_remove by auto
     also have "\<dots> < card X" using card_Diff1_less[OF finite_subset[OF assms carrier_finite] x] .
     finally show "\<not> indep X" using indep_iff_rank_of[OF assms] by auto
   next
     fix x
     assume "x \<in> X"
     then show "indep (X - {x})" using assms indep_remove[of x] indep_iff_rank_of[of "X - {x}"]
       by auto
   qed
 qed
 
 context
   fixes \<E>
   assumes *: "\<E> \<subseteq> carrier"
 begin
 
 interpretation \<E>: matroid \<E> "indep_in \<E>"
   using * by auto
 
 lemma indep_in_iff_rank_of:
   assumes "X \<subseteq> \<E>"
   shows "indep_in \<E> X \<longleftrightarrow> rank_of X = card X"
   using assms \<E>.indep_iff_rank_of rank_of_sub_cong[OF * assms] by auto
 
 lemma basis_in_iff_rank_of:
   assumes "X \<subseteq> \<E>"
   shows "basis_in \<E> X \<longleftrightarrow> rank_of X = card X \<and> rank_of X = rank_of \<E>"
   using \<E>.basis_iff_rank_of[OF assms] rank_of_sub_cong[OF *] assms
   unfolding basis_in_def by auto
 
 lemma circuit_in_iff_rank_of:
   assumes "X \<subseteq> \<E>"
   shows "circuit_in \<E> X \<longleftrightarrow> X \<noteq> {} \<and> (\<forall>x \<in> X. rank_of (X - {x}) = card (X - {x}) \<and> card (X - {x}) = rank_of X)"
 proof -
   have "circuit_in \<E> X \<longleftrightarrow> \<E>.circuit X" unfolding circuit_in_def ..
   also have "\<dots> \<longleftrightarrow>  X \<noteq> {} \<and> (\<forall>x \<in> X. \<E>.rank_of (X - {x}) = card (X - {x}) \<and> card (X - {x}) = \<E>.rank_of X)"
     using \<E>.circuit_iff_rank_of[OF assms] .
   also have "\<dots> \<longleftrightarrow> X \<noteq> {} \<and> (\<forall>x \<in> X. rank_of (X - {x}) = card (X - {x}) \<and> card (X - {x}) = rank_of X)"
   proof -
     {
       fix x
       have "\<E>.rank_of (X - {x}) = rank_of (X - {x})" "\<E>.rank_of X = rank_of X"
         using assms rank_of_sub_cong[OF *, of "X - {x}"] rank_of_sub_cong[OF *, of X] by auto
       then have "\<E>.rank_of (X - {x}) = card (X - {x}) \<and> card (X - {x}) = \<E>.rank_of X \<longleftrightarrow> rank_of (X - {x}) = card (X - {x}) \<and> card (X - {x}) = rank_of X"
         by auto
     }
     then show ?thesis
       by (auto simp: simp del: card_Diff_insert)
   qed
   finally show ?thesis .
 qed
 
 end
 
 subsection \<open>Closure\<close>
 
 definition cl :: "'a set \<Rightarrow> 'a set" where
   "cl X \<equiv> {x \<in> carrier. rank_of (insert x X) = rank_of X}"
 
 lemma clI:
   assumes "x \<in> carrier"
   assumes "rank_of (insert x X) = rank_of X"
   shows "x \<in> cl X"
   unfolding cl_def using assms by auto
 
 lemma cl_altdef:
   assumes "X \<subseteq> carrier"
   shows "cl X = \<Union>{Y \<in> Pow carrier. X \<subseteq> Y \<and> rank_of Y = rank_of X}"
 proof -
   {
     fix x
     assume *: "x \<in> cl X"
     have "x \<in> \<Union>{Y \<in> Pow carrier. X \<subseteq> Y \<and> rank_of Y = rank_of X}"
     proof
       show "insert x X \<in> {Y \<in> Pow carrier. X \<subseteq> Y \<and> rank_of Y = rank_of X}"
         using assms * unfolding cl_def by auto
     qed auto
   }
   moreover {
     fix x
     assume *: "x \<in> \<Union>{Y \<in> Pow carrier. X \<subseteq> Y \<and> rank_of Y = rank_of X}"
     then obtain Y where Y: "x \<in> Y" "Y \<subseteq> carrier" "X \<subseteq> Y" "rank_of Y = rank_of X" by auto
     have "rank_of (insert x X) = rank_of X"
     proof -
       have "rank_of (insert x X) \<le> rank_of X"
       proof -
         have "insert x X \<subseteq> Y" using Y by auto
         then show ?thesis using rank_of_mono[of "insert x X" Y] Y by auto
       qed
       moreover have "rank_of X \<le> rank_of (insert x X)" using Y by (auto intro: rank_of_mono)
       ultimately show ?thesis by auto
     qed
     then have "x \<in> cl X" using * unfolding cl_def by auto
   }
   ultimately show ?thesis by blast
 qed
 
 
 lemma cl_rank_of: "x \<in> cl X \<Longrightarrow> rank_of (insert x X) = rank_of X"
   unfolding cl_def by auto
 
 lemma cl_subset_carrier: "cl X \<subseteq> carrier"
   unfolding cl_def by auto
 
 lemmas clD = cl_rank_of cl_subset_carrier
 
 lemma cl_subset:
   assumes "X \<subseteq> carrier"
   shows "X \<subseteq> cl X"
   using assms using insert_absorb[of _ X] by (auto intro!: clI)
 
 lemma cl_mono:
   assumes "X \<subseteq> Y"
   assumes "Y \<subseteq> carrier"
   shows "cl X \<subseteq> cl Y"
 proof
   fix x
   assume "x \<in> cl X"
   then have "x \<in> carrier" using cl_subset_carrier by auto
 
   have "insert x X \<subseteq> carrier"
     using assms \<open>x \<in> cl X\<close> cl_subset_carrier[of X] by auto
   then interpret X_insert: matroid "insert x X" "indep_in (insert x X)" by auto
 
   have "insert x Y \<subseteq> carrier"
     using assms \<open>x \<in> cl X\<close> cl_subset_carrier[of X] by auto
   then interpret Y_insert: matroid "insert x Y" "indep_in (insert x Y)" by auto
 
   show "x \<in> cl Y" using \<open>x \<in> carrier\<close>
   proof (rule clI, cases "x \<in> X")
     case True
     then show "rank_of (insert x Y) = rank_of Y" using assms insert_absorb[of x Y] by auto
   next
     case False
     obtain B\<^sub>X where B\<^sub>X: "basis_in X B\<^sub>X" using assms basis_in_ex[of X] by auto
 
     have "basis_in (insert x X) B\<^sub>X"
     proof -
       have "rank_of B\<^sub>X = card B\<^sub>X \<and> rank_of B\<^sub>X = rank_of (insert x X)"
       proof -
         have "rank_of B\<^sub>X = card B\<^sub>X \<and> rank_of B\<^sub>X = rank_of X"
           using assms B\<^sub>X
             basis_in_subset_carrier[where \<E> = X and X = B\<^sub>X]
             basis_in_iff_rank_of[where \<E> = X and X = B\<^sub>X]
           by blast
         then show ?thesis using cl_rank_of[OF \<open>x \<in> cl X\<close>] by auto
       qed
       then show ?thesis
         using assms basis_in_subset_carrier[OF _ B\<^sub>X] \<open>x \<in> carrier\<close> basis_in_iff_rank_of[of "insert x X" B\<^sub>X]
         by auto
     qed
 
     have "indep_in (insert x Y) B\<^sub>X"
       using assms basis_in_indep_in[OF _ B\<^sub>X] indep_in_subI_subset[of X "insert x Y"] by auto
     then obtain B\<^sub>Y where B\<^sub>Y: "basis_in (insert x Y) B\<^sub>Y" "B\<^sub>X \<subseteq> B\<^sub>Y"
       using assms \<open>x \<in> carrier\<close> indep_in_iff_subset_basis_in[of "insert x Y" B\<^sub>X] by auto
 
     have "basis_in Y B\<^sub>Y"
     proof -
       have "x \<notin> B\<^sub>Y"
       proof (rule ccontr, goal_cases False)
         case False
         then have "insert x B\<^sub>X \<subseteq> B\<^sub>Y" using \<open>B\<^sub>X \<subseteq> B\<^sub>Y\<close> by auto
         then have "indep_in (insert x Y) (insert x B\<^sub>X)"
           using assms \<open>x \<in> carrier\<close>
             B\<^sub>Y basis_in_indep_in[where \<E> = "insert x Y" and X = B\<^sub>Y]
             indep_in_subset[where \<E> = "insert x Y" and X = B\<^sub>Y and Y = "insert x B\<^sub>X"]
           by auto
         then have "indep_in (insert x X) (insert x B\<^sub>X)"
           using assms B\<^sub>X
             basis_in_subset_carrier[where \<E> = X and X = B\<^sub>X]
             indep_in_supI[where \<E> = "insert x Y" and \<E>' = "insert x X" and X = "insert x B\<^sub>X"]
           by auto
         moreover have "x \<in> insert x X - B\<^sub>X"
           using assms \<open>x \<notin> X\<close> B\<^sub>X basis_in_subset_carrier[where \<E> = X and X = B\<^sub>X] by auto
         ultimately show ?case
           using assms \<open>x \<in> carrier\<close> \<open>basis_in (insert x X) B\<^sub>X\<close>
             basis_in_max_indep_in[where \<E> = "insert x X" and X = B\<^sub>X and x = x]
           by auto
       qed
       then show ?thesis
       using assms \<open>x \<in> carrier\<close> B\<^sub>Y basis_in_subset_carrier[of "insert x Y" B\<^sub>Y]
         basis_in_supI[where \<E> = "insert x Y" and \<E>' = Y and B = B\<^sub>Y] by auto
     qed
 
     show "rank_of (insert x Y) = rank_of Y"
     proof -
       have "rank_of (insert x Y) = card B\<^sub>Y"
         using assms \<open>x \<in> carrier\<close> \<open>basis_in (insert x Y) B\<^sub>Y\<close> basis_in_subset_carrier
         using basis_in_iff_rank_of[where \<E> = "insert x Y" and X = B\<^sub>Y]
         by auto
       also have "\<dots> = rank_of Y"
         using assms \<open>x \<in> carrier\<close> \<open>basis_in Y B\<^sub>Y\<close> basis_in_subset_carrier
         using basis_in_iff_rank_of[where \<E> = Y and X = B\<^sub>Y]
         by auto
       finally show ?thesis .
     qed
   qed
 qed
 
 lemma cl_insert_absorb:
   assumes "X \<subseteq> carrier"
   assumes "x \<in> cl X"
   shows "cl (insert x X) = cl X"
 proof
   show "cl (insert x X) \<subseteq> cl X"
   proof (standard, goal_cases elem)
     case (elem y)
     then have *: "x \<in> carrier" "y \<in> carrier" using assms cl_subset_carrier by auto
 
     have "rank_of (insert y X) = rank_of (insert y (insert x X))"
     proof -
       have "rank_of (insert y X) \<le> rank_of (insert y (insert x X))"
         using assms * by (auto intro: rank_of_mono)
       moreover have "rank_of (insert y (insert x X)) = rank_of (insert y X)"
       proof -
         have "insert y (insert x X) = insert x (insert y X)" by auto
         then have "rank_of (insert y (insert x X)) = rank_of (insert x (insert y X))" by auto
         also have "\<dots> = rank_of (insert y X)"
         proof -
           have "cl X \<subseteq> cl (insert y X)" by (rule cl_mono) (auto simp add: assms \<open>y \<in> carrier\<close>)
           then have "x \<in> cl (insert y X)" using assms by auto
           then show ?thesis unfolding cl_def by auto
         qed
         finally show ?thesis .
       qed
       ultimately show ?thesis by auto
     qed
     also have "\<dots> = rank_of (insert x X)" using elem using cl_rank_of by auto
     also have "\<dots> = rank_of X" using assms cl_rank_of by auto
     finally show "y \<in> cl X" using * by (auto intro: clI)
   qed
 next
   have "insert x X \<subseteq> carrier" using assms cl_subset_carrier by auto
   moreover have "X \<subseteq> insert x X" using assms by auto
   ultimately show "cl X \<subseteq> cl (insert x X)" using assms cl_subset_carrier cl_mono by auto
 qed
 
 lemma cl_cl_absorb:
   assumes "X \<subseteq> carrier"
   shows "cl (cl X) = cl X"
 proof
   show "cl (cl X) \<subseteq> cl X"
   proof (standard, goal_cases elem)
     case (elem x)
     then have "x \<in> carrier" using cl_subset_carrier by auto
     then show ?case
     proof (rule clI)
       have "rank_of (insert x X) \<ge> rank_of X"
         using assms \<open>x \<in> carrier\<close> rank_of_mono[of X "insert x X"] by auto
       moreover have "rank_of (insert x X) \<le> rank_of X"
       proof -
         have "rank_of (insert x X) \<le> rank_of (insert x (cl X))"
           using assms \<open>x \<in> carrier\<close> cl_subset_carrier cl_subset[of X]
                 rank_of_mono[of "insert x X" "insert x (cl X)"] by auto
         also have "\<dots> = rank_of (cl X)" using elem cl_rank_of by auto
         also have "\<dots> = rank_of (X \<union> (cl X - X))"
           using Diff_partition[OF cl_subset[OF assms]] by auto
         also have "\<dots> = rank_of X" using \<open>X \<subseteq> carrier\<close>
         proof (rule rank_of_Un_absorbI)
           show "cl X - X \<subseteq> carrier" using assms cl_subset_carrier by auto
         next
           fix y
           assume "y \<in> cl X - X - X"
           then show "rank_of (insert y X) = rank_of X" unfolding cl_def by auto
         qed
         finally show ?thesis .
       qed
       ultimately show "rank_of (insert x X) = rank_of X" by auto
     qed
   qed
 next
   show "cl X \<subseteq> cl (cl X)" using cl_subset[OF cl_subset_carrier] by auto
 qed
 
 lemma cl_augment:
   assumes "X \<subseteq> carrier"
   assumes "x \<in> carrier"
   assumes "y \<in> cl (insert x X) - cl X"
   shows "x \<in> cl (insert y X)"
   using \<open>x \<in> carrier\<close>
 proof (rule clI)
   have "rank_of (insert y X) \<le> rank_of (insert x (insert y X))"
     using assms cl_subset_carrier by (auto intro: rank_of_mono)
   moreover have "rank_of (insert x (insert y X)) \<le> rank_of (insert y X)"
   proof -
     have "rank_of (insert x (insert y X)) = rank_of (insert y (insert x X))"
     proof -
       have "insert x (insert y X) = insert y (insert x X)" by auto
       then show ?thesis by auto
     qed
     also have "rank_of (insert y (insert x X)) = rank_of (insert x X)"
       using assms cl_def by auto
     also have "\<dots> \<le> Suc (rank_of X)"
       using assms cl_subset_carrier by (auto intro: rank_of_insert_le)
     also have "\<dots> = rank_of (insert y X)"
     proof -
       have "rank_of (insert y X) \<le> Suc (rank_of X)"
         using assms cl_subset_carrier by (auto intro: rank_of_insert_le)
       moreover have "rank_of (insert y X) \<noteq> rank_of X"
         using assms cl_def by auto
       moreover have "rank_of X \<le> rank_of (insert y X)"
         using assms cl_subset_carrier by (auto intro: rank_of_mono)
       ultimately show ?thesis by auto
     qed
     finally show ?thesis .
   qed
   ultimately show "rank_of (insert x (insert y X)) = rank_of (insert y X)" by auto
 qed
 
 lemma clI_insert:
   assumes "x \<in> carrier"
   assumes "indep X"
   assumes "\<not> indep (insert x X)"
   shows "x \<in> cl X"
   using \<open>x \<in> carrier\<close>
 proof (rule clI)
   have *: "X \<subseteq> carrier" using assms indep_subset_carrier by auto
   then have **: "insert x X \<subseteq> carrier" using assms by auto
 
   have "indep_in (insert x X) X" using assms by (auto intro: indep_inI)
   then obtain B where B: "basis_in (insert x X) B" "X \<subseteq> B"
     using assms indep_in_iff_subset_basis_in[OF **] by auto
   have "x \<notin> B"
   proof (rule ccontr, goal_cases False)
     case False
     then have "indep_in (insert x X) (insert x X)"
       using B indep_in_subset[OF ** basis_in_indep_in[OF **]] by auto
     then show ?case using assms indep_in_indep by auto
   qed
 
   have "basis_in X B" using *
   proof (rule basis_inI, goal_cases indep max_indep)
     case indep
     show ?case
     proof (rule indep_in_supI[where \<E> = "insert x X"])
       show "B \<subseteq> X" using B basis_in_subset_carrier[OF **] \<open>x \<notin> B\<close> by auto
     next
       show "indep_in (insert x X) B" using basis_in_indep_in[OF ** B(1)] .
     qed auto
   next
     case (max_indep y)
     then have "\<not> indep_in (insert x X) (insert y B)"
       using B basis_in_max_indep_in[OF **] by auto
     then show ?case by (auto intro: indep_in_subI_subset)
   qed
   then show "rank_of (insert x X) = rank_of X"
     using B rank_of_eq_card_basis_in[OF *] rank_of_eq_card_basis_in[OF **] by auto
 qed
 
 lemma indep_in_carrier [simp]: "indep_in carrier = indep"
   using indep_subset_carrier by (auto simp: indep_in_def fun_eq_iff)
 
 context
   fixes I
   defines "I \<equiv> (\<lambda>X. X \<subseteq> carrier \<and> (\<forall>x\<in>X. x \<notin> cl (X - {x})))"
 begin
 
 lemma I_mono: "I Y" if "Y \<subseteq> X" "I X" for X Y :: "'a set"
 proof -
   have "\<forall>x\<in>Y. x \<notin> cl (Y - {x})"
   proof (intro ballI)
     fix x assume x: "x \<in> Y"
     with that have "cl (Y - {x}) \<subseteq> cl (X - {x})"
       by (intro cl_mono) (auto simp: I_def)
     with that and x show "x \<notin> cl (Y - {x})" by (auto simp: I_def)
   qed
   with that show ?thesis by (auto simp: I_def)
 qed
 
 lemma clI':
   assumes "I X" "x \<in> carrier" "\<not>I (insert x X)"
   shows   "x \<in> cl X"
 proof -
   from assms have x: "x \<notin> X" by (auto simp: insert_absorb)
   from assms obtain y where y: "y \<in> insert x X" "y \<in> cl (insert x X - {y})"
     by (force simp: I_def)
   show "x \<in> cl X"
   proof (cases "x = y")
     case True
     thus ?thesis using assms x y by (auto simp: I_def)
   next
     case False
     have "y \<in> cl (insert x X - {y})" by fact
     also from False have "insert x X - {y} = insert x (X - {y})" by auto
     finally have "y \<in> cl (insert x (X - {y})) - cl (X - {y})"
       using assms False y unfolding I_def by blast
     hence "x \<in> cl (insert y (X - {y}))"
       using cl_augment[of "X - {y}" x y] assms False y by (auto simp: I_def)
     also from y and False have "insert y (X - {y}) = X" by auto
     finally show ?thesis .
   qed
 qed
 
 
 lemma matroid_I: "matroid carrier I"
 proof (unfold_locales, goal_cases)
   show "finite carrier" by (rule carrier_finite)
 next
   case (4 X Y)
   have "\<forall>x\<in>Y. x \<notin> cl (Y - {x})"
   proof (intro ballI)
     fix x assume x: "x \<in> Y"
     with 4 have "cl (Y - {x}) \<subseteq> cl (X - {x})"
       by (intro cl_mono) (auto simp: I_def)
     with 4 and x show "x \<notin> cl (Y - {x})" by (auto simp: I_def)
   qed
   with 4 show ?case by (auto simp: I_def)
 next
   case (5 X Y)
   have "~(\<exists>X Y. I X \<and> I Y \<and> card X < card Y \<and> (\<forall>x\<in>Y-X. \<not>I (insert x X)))"
   proof
     assume *: "\<exists>X Y. I X \<and> I Y \<and> card X < card Y \<and> (\<forall>x\<in>Y-X. \<not>I (insert x X))" (is "\<exists>X Y. ?P X Y")
     define n where "n = Max ((\<lambda>(X, Y). card (X \<inter> Y)) ` {(X, Y). ?P X Y})"
     have "{(X, Y). ?P X Y} \<subseteq> Pow carrier \<times> Pow carrier"
       by (auto simp: I_def)
     hence finite: "finite {(X, Y). ?P X Y}"
       by (rule finite_subset) (insert carrier_finite, auto)
     hence "n \<in> ((\<lambda>(X, Y). card (X \<inter> Y)) ` {(X, Y). ?P X Y})"
       unfolding n_def using * by (intro Max_in finite_imageI) auto
     then obtain X Y where XY: "?P X Y" "n = card (X \<inter> Y)"
       by auto
     hence finite': "finite X" "finite Y"
       using finite_subset[OF _ carrier_finite] XY by (auto simp: I_def)
     from XY finite' have "~(Y \<subseteq> X)"
       using card_mono[of X Y] by auto
     then obtain y where y: "y \<in> Y - X" by blast
 
     have False
     proof (cases "X \<subseteq> cl (Y - {y})")
       case True
       from y XY have [simp]: "y \<in> carrier" by (auto simp: I_def)
       assume "X \<subseteq> cl (Y - {y})"
       hence "cl X \<subseteq> cl (cl (Y - {y}))"
         by (intro cl_mono cl_subset_carrier)
       also have "\<dots> = cl (Y - {y})"
         using XY by (intro cl_cl_absorb) (auto simp: I_def)
       finally have "cl X \<subseteq> cl (Y - {y})" .
       moreover have "y \<notin> cl (Y - {y})"
         using y I_def XY(1) by blast
       ultimately have "y \<notin> cl X" by blast
       thus False unfolding I_def
         using XY y clI' \<open>y \<in> carrier\<close> by blast
     next
       case False
       with y XY have [simp]: "y \<in> carrier" by (auto simp: I_def)
       assume "\<not>(X \<subseteq> cl (Y - {y}))"
       then obtain t where t: "t \<in> X" "t \<notin> cl (Y - {y})"
         by auto
       with XY have [simp]: "t \<in> carrier" by (auto simp: I_def)
 
       have "t \<in> X - Y"
         using t y clI[of t "Y - {y}"] by (cases "t = y") (auto simp: insert_absorb)
       moreover have "I  (Y - {y})" using XY(1) I_mono[of "Y - {y}" Y] by blast
       ultimately have *: "I (insert t (Y - {y}))"
         using clI'[of "Y - {y}" t] t by auto
 
       from XY have "finite Y"
         by (intro finite_subset[OF _ carrier_finite]) (auto simp: I_def)
       moreover from y have "Y \<noteq> {}" by auto
       ultimately have [simp]: "card (insert t (Y - {y})) = card Y" using \<open>t \<in> X - Y\<close> y
         by (simp add: Suc_diff_Suc card_gt_0_iff)
 
       have "\<exists>x\<in>Y - X. I (insert x X)"
       proof (rule ccontr)
         assume "\<not>?thesis"
         hence "?P X (insert t (Y - {y}))" using XY * \<open>t \<in> X - Y\<close>
           by auto
         hence "card (X \<inter> insert t (Y - {y})) \<le> n"
           unfolding n_def using finite by (intro Max_ge) auto
         also have "X \<inter> insert t (Y - {y}) = insert t ((X \<inter> Y) - {y})"
           using y \<open>t \<in> X - Y\<close> by blast
         also have "card \<dots> = Suc (card (X \<inter> Y))"
           using y \<open>t \<in> X - Y\<close> \<open>finite Y\<close> by (simp add: card.insert_remove)
         finally show False using XY by simp
       qed
       with XY show False by blast
     qed
     thus False .
   qed
   with 5 show ?case by auto
 qed (auto simp: I_def)
 
 end
 
 definition cl_in where "cl_in \<E> X = matroid.cl \<E> (indep_in \<E>) X"
 
 lemma cl_eq_cl_in:
   assumes "X \<subseteq> carrier"
   shows "cl X = cl_in carrier X"
 proof -
   interpret \<E>: matroid carrier "indep_in carrier"
     by (intro matroid_subset) auto
   have "cl X = {x \<in> carrier. rank_of (insert x X) = rank_of X}"
     unfolding cl_def by auto
   also have "\<dots> = {x \<in> carrier. \<E>.rank_of (insert x X) = \<E>.rank_of X}"
     using rank_of_sub_cong[of carrier] assms by auto
   also have "\<dots> = cl_in carrier X"
     unfolding cl_in_def \<E>.cl_def by auto
   finally show ?thesis .
 qed
 
 context
   fixes \<E>
   assumes *: "\<E> \<subseteq> carrier"
 begin
 
 interpretation \<E>: matroid \<E> "indep_in \<E>"
   using * by auto
 
 lemma cl_inI_aux: "x \<in> \<E>.cl X \<Longrightarrow> x \<in> cl_in \<E> X"
   unfolding cl_in_def by auto
 
 lemma cl_inD_aux: "x \<in> cl_in \<E> X \<Longrightarrow> x \<in> \<E>.cl X"
   unfolding cl_in_def by auto
 
 lemma cl_inI:
   assumes "X \<subseteq> \<E>"
   assumes "x \<in> \<E>"
   assumes "rank_of (insert x X) = rank_of X"
   shows "x \<in> cl_in \<E> X"
 proof -
   have "\<E>.rank_of (insert x X) = rank_of (insert x X)" "\<E>.rank_of X = rank_of X"
     using assms rank_of_sub_cong[OF *] by auto
   then show ?thesis unfolding cl_in_def using assms by (auto intro: \<E>.clI)
 qed
 
 lemma cl_in_altdef:
   assumes "X \<subseteq> \<E>"
   shows "cl_in \<E> X = \<Union>{Y \<in> Pow \<E>. X \<subseteq> Y \<and> rank_of Y = rank_of X}"
   unfolding cl_in_def
 proof (safe, goal_cases LTR RTL)
   case (LTR x)
   then have "x \<in> \<Union>{Y \<in> Pow \<E>. X \<subseteq> Y \<and> \<E>.rank_of Y = \<E>.rank_of X}"
     using \<E>.cl_altdef[OF assms] by auto
   then obtain Y where Y: "x \<in> Y" "Y \<in> Pow \<E>" "X \<subseteq> Y" "\<E>.rank_of Y = \<E>.rank_of X" by auto
   then show ?case using rank_of_sub_cong[OF *] by auto
 next
   case (RTL x Y)
   then have "x \<in> \<Union>{Y \<in> Pow \<E>. X \<subseteq> Y \<and> \<E>.rank_of Y = \<E>.rank_of X}"
      using rank_of_sub_cong[OF *, of X] rank_of_sub_cong[OF *, of Y] by auto
   then show ?case using \<E>.cl_altdef[OF assms] by auto
 qed
 
 lemma cl_in_subset_carrier: "cl_in \<E> X \<subseteq> \<E>"
   using \<E>.cl_subset_carrier unfolding cl_in_def .
 
 lemma cl_in_rank_of:
   assumes "X \<subseteq> \<E>"
   assumes "x \<in> cl_in \<E> X"
   shows "rank_of (insert x X) = rank_of X"
 proof -
   have "\<E>.rank_of (insert x X) = \<E>.rank_of X"
     using assms \<E>.cl_rank_of unfolding cl_in_def by auto
   moreover have "\<E>.rank_of (insert x X) = rank_of (insert x X)"
     using assms rank_of_sub_cong[OF *, of "insert x X"] cl_in_subset_carrier by auto
   moreover have "\<E>.rank_of X = rank_of X"
     using assms rank_of_sub_cong[OF *] by auto
   ultimately show ?thesis by auto
 qed
 
 lemmas cl_inD = cl_in_rank_of cl_in_subset_carrier
 
 lemma cl_in_subset:
   assumes "X \<subseteq> \<E>"
   shows "X \<subseteq> cl_in \<E> X"
   using \<E>.cl_subset[OF assms] unfolding cl_in_def .
 
 lemma cl_in_mono:
   assumes "X \<subseteq> Y"
   assumes "Y \<subseteq> \<E>"
   shows "cl_in \<E> X \<subseteq> cl_in \<E> Y"
   using \<E>.cl_mono[OF assms] unfolding cl_in_def .
 
 lemma cl_in_insert_absorb:
   assumes "X \<subseteq> \<E>"
   assumes "x \<in> cl_in \<E> X"
   shows "cl_in \<E> (insert x X) = cl_in \<E> X"
   using assms \<E>.cl_insert_absorb unfolding cl_in_def by auto
 
 lemma cl_in_augment:
   assumes "X \<subseteq> \<E>"
   assumes "x \<in> \<E>"
   assumes "y \<in> cl_in \<E> (insert x X) - cl_in \<E> X"
   shows "x \<in> cl_in \<E> (insert y X)"
   using assms \<E>.cl_augment unfolding cl_in_def by auto
 
 lemmas cl_inI_insert = cl_inI_aux[OF \<E>.clI_insert]
 
 end
 
 lemma cl_in_subI:
   assumes "X \<subseteq> \<E>'" "\<E>' \<subseteq> \<E>" "\<E> \<subseteq> carrier"
   shows "cl_in \<E>' X \<subseteq> cl_in \<E> X"
 proof (safe, goal_cases elem)
   case (elem x)
   then have "x \<in> \<E>'" "rank_of (insert x X) = rank_of X"
     using assms cl_inD[where \<E> = \<E>' and X = X] by auto
   then show "x \<in> cl_in \<E> X" using assms by (auto intro: cl_inI)
 qed
 
 context
   fixes \<E>
   assumes *: "\<E> \<subseteq> carrier"
 begin
 
 interpretation \<E>: matroid \<E> "indep_in \<E>"
   using * by auto
 
 lemma cl_in_sub_cong:
   assumes "X \<subseteq> \<E>'" "\<E>' \<subseteq> \<E>"
   shows "\<E>.cl_in \<E>' X = cl_in \<E>' X"
 proof (safe, goal_cases LTR RTL)
   case (LTR x)
   then have "x \<in> \<E>'" "\<E>.rank_of (insert x X) = \<E>.rank_of X"
     using assms
       \<E>.cl_in_rank_of[where \<E> = \<E>' and X = X and x = x]
       \<E>.cl_in_subset_carrier[where \<E> = \<E>']
     by auto
   moreover have "\<E>.rank_of X = rank_of X"
     using assms rank_of_sub_cong[OF *] by auto
   moreover have "\<E>.rank_of (insert x X) = rank_of (insert x X)"
     using assms rank_of_sub_cong[OF *, of "insert x X"] \<open>x \<in> \<E>'\<close> by auto
   ultimately show ?case using assms * by (auto intro: cl_inI)
 next
   case (RTL x)
   then have "x \<in> \<E>'" "rank_of (insert x X) = rank_of X"
     using * assms cl_inD[where \<E> = \<E>' and X = X] by auto
   moreover have "\<E>.rank_of X = rank_of X"
     using assms rank_of_sub_cong[OF *] by auto
   moreover have "\<E>.rank_of (insert x X) = rank_of (insert x X)"
     using assms rank_of_sub_cong[OF *, of "insert x X"] \<open>x \<in> \<E>'\<close> by auto
   ultimately show ?case using assms by (auto intro: \<E>.cl_inI)
 qed
 
 end
 end
 end
\ No newline at end of file
diff --git a/thys/Network_Security_Policy_Verification/Lib/FiniteGraph.thy b/thys/Network_Security_Policy_Verification/Lib/FiniteGraph.thy
--- a/thys/Network_Security_Policy_Verification/Lib/FiniteGraph.thy
+++ b/thys/Network_Security_Policy_Verification/Lib/FiniteGraph.thy
@@ -1,323 +1,323 @@
 theory FiniteGraph
 imports Main 
 begin
 
 (*Lots of this theory is based on a work by Benedikt Nordhoff and Peter Lammich*)
 
 section \<open>Specification of a finite directed graph\<close>
 
 text\<open>A graph \<open>G=(V,E)\<close> consits of a set of vertices \<open>V\<close>, also called nodes, 
        and a set of edges \<open>E\<close>. The edges are tuples of vertices. Both, 
        the set of vertices and edges is finite.\<close>
 
 (* Inspired by
 Title: Dijkstra's Shortest Path Algorithm
 Author: Benedikt Nordhoff and Peter Lammich
 http://isa-afp.org/entries/Dijkstra_Shortest_Path.shtml
 *)
 
 section \<open>Graph\<close>
 subsection\<open>Definitions\<close>
   text \<open>A graph is represented by a record.\<close>
   record 'v graph =
     nodes :: "'v set"
     edges :: "('v \<times>'v) set"
 
   text \<open>In a well-formed graph, edges only go from nodes to nodes.\<close>
   locale wf_graph = 
     fixes G :: "'v graph"
     \<comment> \<open>Edges only reference to existing nodes\<close>
     assumes E_wf: "fst ` (edges G) \<subseteq> (nodes G)"
                      "snd ` (edges G) \<subseteq> (nodes G)"
     and finiteE: "finite (edges G)" (*implied by finiteV*)
     and finiteV: "finite (nodes G)"
   begin
     abbreviation "V \<equiv> (nodes G)"
     abbreviation "E \<equiv> (edges G)"
 
     lemma E_wfD: assumes "(v,v') \<in> E"
       shows "v \<in> V" "v' \<in> V"
       apply -
        apply (rule subsetD[OF E_wf(1)])
        using assms apply force
       apply (rule subsetD[OF E_wf(2)])
       using assms apply force
       done
 
     lemma E_wfD2: "\<forall>e \<in> E. fst e \<in> V \<and> snd e \<in> V"
     by (auto simp add: E_wfD)
   end
 
 subsection \<open>Basic operations on Graphs\<close>
   text \<open>The empty graph.\<close>
   definition empty :: "'v graph" where 
     "empty \<equiv> \<lparr> nodes = {}, edges = {} \<rparr>"
 
   text \<open>Adds a node to a graph.\<close>
   definition add_node :: "'v \<Rightarrow> 'v graph \<Rightarrow> 'v graph" where 
     "add_node v G \<equiv> \<lparr> nodes = ({v} \<union> (nodes G)), edges=edges G \<rparr>"
 
   text \<open>Deletes a node from a graph. Also deletes all adjacent edges.\<close>
   definition delete_node where "delete_node v G \<equiv> \<lparr> 
       nodes = (nodes G) - {v},   
       edges = {(e1, e2). (e1, e2) \<in> edges G \<and> e1 \<noteq> v \<and> e2 \<noteq> v}
     \<rparr>"
 
   text \<open>Adds an edge to a graph.\<close>
   definition add_edge where 
   "add_edge v v' G = \<lparr>nodes = nodes G \<union> {v,v'}, edges = {(v, v')} \<union> edges G \<rparr>"
 
   text \<open>Deletes an edge from a graph.\<close>
   definition delete_edge where "delete_edge v v' G \<equiv> \<lparr>
       nodes = nodes G, 
       edges = {(e1,e2). (e1, e2) \<in> edges G \<and> (e1,e2) \<noteq> (v,v')}
     \<rparr>"
   
   definition delete_edges::"'v graph \<Rightarrow> ('v \<times> 'v) set \<Rightarrow> 'v graph" where 
     "delete_edges G es \<equiv> \<lparr>
       nodes = nodes G, 
       edges = {(e1,e2). (e1, e2) \<in> edges G \<and> (e1,e2) \<notin> es}
     \<rparr>"
 
   fun delete_edges_list::"'v graph \<Rightarrow> ('v \<times> 'v) list \<Rightarrow> 'v graph" where 
     "delete_edges_list G [] = G"|
     "delete_edges_list G ((v,v')#es) = delete_edges_list (delete_edge v v' G) es"
 
   definition fully_connected :: "'v graph \<Rightarrow> 'v graph" where
     "fully_connected G \<equiv> \<lparr>nodes = nodes G, edges = nodes G \<times> nodes G \<rparr>"
 
 
 text \<open>Extended graph operations\<close>
   text \<open>Reflexive transitive successors of a node. Or: All reachable nodes for \<open>v\<close> including \<open>v\<close>.\<close>
   definition succ_rtran :: "'v graph \<Rightarrow> 'v \<Rightarrow> 'v set" where
     "succ_rtran G v = {e2. (v,e2) \<in> (edges G)\<^sup>*}"
 
   text \<open>Transitive successors of a node. Or: All reachable nodes for \<open>v\<close>.\<close>
   definition succ_tran :: "'v graph \<Rightarrow> 'v \<Rightarrow> 'v set" where
     "succ_tran G v = {e2. (v,e2) \<in> (edges G)\<^sup>+}"
 
   \<comment> \<open>succ_tran is always finite\<close>
   lemma succ_tran_finite: "wf_graph G \<Longrightarrow> finite (succ_tran G v)"
   proof -
     assume "wf_graph G"
     from wf_graph.finiteE[OF this] have "finite ((edges G)\<^sup>+)" using finite_trancl[symmetric, of "edges G"] by metis
     from this have "finite {(e1,e2). (e1, e2) \<in> (edges G)\<^sup>+}" by simp
     from this have finite: "finite (snd ` {(e1,e2). (e1, e2) \<in> (edges G)\<^sup>+})" by (metis finite_imageI)
     have "{(e1,e2). (e1, e2) \<in> (edges G)\<^sup>+ \<and> e1 = v} \<subseteq> {(e1,e2). (e1, e2) \<in> (edges G)\<^sup>+}" by blast
     have 1: "snd ` {(e1,e2). (e1, e2) \<in> (edges G)\<^sup>+ \<and> e1 = v} \<subseteq> snd ` {(e1,e2). (e1, e2) \<in> (edges G)\<^sup>+}" by blast
     have 2: "snd ` {(e1,e2). (e1, e2) \<in> (edges G)\<^sup>+ \<and> e1 = v} = {e2. (v,e2) \<in> (edges G)\<^sup>+}" by force
     from 1 2 have "{e2. (v,e2) \<in> (edges G)\<^sup>+} \<subseteq> snd ` {(e1,e2). (e1, e2) \<in> (edges G)\<^sup>+}" by blast
     from this finite have "finite {e2. (v, e2) \<in> (edges G)\<^sup>+}" by (metis finite_subset)
     thus "finite (succ_tran G v)" using succ_tran_def by metis
   qed
   
   text\<open>If there is no edge leaving from \<open>v\<close>, then \<open>v\<close> has no successors\<close>
   lemma succ_tran_empty: "\<lbrakk> wf_graph G; v \<notin> (fst ` edges G) \<rbrakk> \<Longrightarrow> succ_tran G v = {}"
     unfolding succ_tran_def using image_iff tranclD by fastforce
 
   text\<open>@{const succ_tran} is subset of nodes\<close>
   lemma succ_tran_subseteq_nodes: "\<lbrakk> wf_graph G \<rbrakk> \<Longrightarrow> succ_tran G v \<subseteq> nodes G"
     unfolding succ_tran_def using tranclD2 wf_graph.E_wfD(2) by fastforce
 
   text \<open>The number of reachable nodes from \<open>v\<close>\<close>
   definition num_reachable :: "'v graph \<Rightarrow> 'v \<Rightarrow> nat" where
     "num_reachable G v = card (succ_tran G v)"
 
   definition num_reachable_norefl :: "'v graph \<Rightarrow> 'v \<Rightarrow> nat" where
     "num_reachable_norefl G v = card (succ_tran G v - {v})"
 
   text\<open>@{const card} returns @{term 0} for infinite sets.
         Here, for a well-formed graph, if @{const num_reachable} is zero, there are actually no nodes reachable.\<close>
   lemma num_reachable_zero: "\<lbrakk>wf_graph G; num_reachable G v = 0\<rbrakk> \<Longrightarrow> succ_tran G v = {}"
   unfolding num_reachable_def
   apply(subgoal_tac "finite (succ_tran G v)")
    apply(simp)
   apply(blast intro: succ_tran_finite)
   done
   lemma num_succtran_zero: "\<lbrakk>succ_tran G v = {}\<rbrakk> \<Longrightarrow> num_reachable G v = 0"
     unfolding num_reachable_def by simp
   lemma num_reachable_zero_iff: "\<lbrakk>wf_graph G\<rbrakk> \<Longrightarrow> (num_reachable G v = 0) \<longleftrightarrow> (succ_tran G v = {})"
   by(metis num_succtran_zero num_reachable_zero)
 
 
 section\<open>Undirected Graph\<close>
 
 subsection\<open>undirected graph simulation\<close>
   text \<open>Create undirected graph from directed graph by adding backward links\<close>
 
   definition backflows :: "('v \<times> 'v) set \<Rightarrow> ('v \<times> 'v) set" where
     "backflows E \<equiv> {(r,s). (s,r) \<in> E}"
 
   definition undirected :: "'v graph \<Rightarrow> 'v graph"
     where "undirected G = \<lparr> nodes = nodes G, edges = (edges G) \<union> {(b,a). (a,b) \<in> edges G} \<rparr>"
 
 section \<open>Graph Lemmas\<close>
 
   lemma graph_eq_intro: "(nodes (G::'a graph) = nodes G') \<Longrightarrow> (edges G = edges G') \<Longrightarrow> G = G'" by simp
 
   \<comment> \<open>finite\<close>
   lemma wf_graph_finite_filterE: "wf_graph G \<Longrightarrow> finite {(e1, e2). (e1, e2) \<in> edges G \<and> P e1 e2}"
   by(simp add: wf_graph.finiteE split_def)
   lemma wf_graph_finite_filterV: "wf_graph G \<Longrightarrow> finite {n. n \<in> nodes G \<and> P n}"
   by(simp add: wf_graph.finiteV)
 
   \<comment> \<open>empty\<close>
   lemma empty_wf[simp]: "wf_graph empty"
     unfolding empty_def by unfold_locales auto
   lemma nodes_empty[simp]: "nodes empty = {}" unfolding empty_def by simp
   lemma edges_empty[simp]: "edges empty = {}" unfolding empty_def by simp
 
   \<comment> \<open>add node\<close>
   lemma add_node_wf[simp]: "wf_graph g \<Longrightarrow> wf_graph (add_node v g)"
     unfolding add_node_def wf_graph_def by (auto)
 
   lemma delete_node_wf[simp]: "wf_graph G \<Longrightarrow> wf_graph (delete_node v G)"
     by(auto simp add: delete_node_def wf_graph_def wf_graph_finite_filterE)
 
   \<comment> \<open>add edgde\<close>
   lemma add_edge_wf[simp]: "wf_graph G \<Longrightarrow> wf_graph (add_edge v v' G)"
     by(auto simp add: add_edge_def add_node_def wf_graph_def)
 
   \<comment> \<open>delete edge\<close>
   lemma delete_edge_wf[simp]: "wf_graph G \<Longrightarrow> wf_graph (delete_edge v v' G)"
     by(auto simp add: delete_edge_def add_node_def wf_graph_def split_def)
  
   \<comment> \<open>delte edges\<close>
   lemma delete_edges_list_wf[simp]: "wf_graph G \<Longrightarrow> wf_graph (delete_edges_list G E)"
     by(induction E arbitrary: G, simp, force)
   lemma delete_edges_wf[simp]: "wf_graph G \<Longrightarrow> wf_graph (delete_edges G E)"
     by(auto simp add: delete_edges_def add_node_def wf_graph_def split_def)
   lemma delete_edges_list_set: "delete_edges_list G E = delete_edges G (set E)"
     proof(induction E arbitrary: G)
     case Nil thus ?case by (simp add: delete_edges_def)
     next
     case (Cons e E) thus ?case by(cases e)(simp add: delete_edge_def delete_edges_def)
     qed
   lemma delete_edges_list_union: "delete_edges_list G (ff @ keeps) = delete_edges G (set ff \<union> set keeps)"
    by(simp add: delete_edges_list_set)
   lemma add_edge_delete_edges_list: 
     "(add_edge (fst a) (snd a) (delete_edges_list G (a # ff))) = (add_edge (fst a) (snd a) (delete_edges G (set ff)))"
    by(auto simp add: delete_edges_list_set delete_edges_def add_edge_def add_node_def)
   lemma delete_edges_empty[simp]: "delete_edges G {} = G"
    by(simp add: delete_edges_def)
   lemma delete_edges_simp2: "delete_edges G E = \<lparr> nodes = nodes G, edges = edges G - E\<rparr>"
    by(auto simp add: delete_edges_def)
   lemma delete_edges_set_nodes: "nodes (delete_edges G E) = nodes G"
    by(simp add: delete_edges_simp2)
   lemma delete_edges_edges_mono: "E' \<subseteq> E \<Longrightarrow> edges (delete_edges G E) \<subseteq> edges (delete_edges G E')"
     by(simp add: delete_edges_def, fast)
   lemma delete_edges_edges_empty: "(delete_edges G (edges G)) = G\<lparr>edges := {}\<rparr>"
     by(simp add: delete_edges_simp2)
 
  \<comment> \<open>add delete\<close>
   lemma add_delete_edge: "wf_graph (G::'a graph) \<Longrightarrow> (a,b) \<in> edges G \<Longrightarrow> add_edge a b (delete_edge a b G) = G"
    apply(simp add: delete_edge_def add_edge_def wf_graph_def)
    apply(intro graph_eq_intro)
     by auto
 
   lemma add_delete_edges: "wf_graph (G::'v graph) \<Longrightarrow> (a,b) \<in> edges G \<Longrightarrow> (a,b) \<notin> fs \<Longrightarrow>
     add_edge a b (delete_edges G (insert (a, b) fs)) = (delete_edges G fs)"
     by(auto simp add: delete_edges_simp2 add_edge_def wf_graph_def)
 
 
  \<comment> \<open>fully_connected\<close>
   lemma fully_connected_simp: "fully_connected \<lparr>nodes = N, edges = ignore \<rparr>\<equiv> \<lparr>nodes = N, edges = N \<times> N \<rparr>"
     by(simp add: fully_connected_def)
   lemma fully_connected_wf: "wf_graph G \<Longrightarrow> wf_graph (fully_connected G)"
     by(simp add: fully_connected_def wf_graph_def)
 
  \<comment> \<open>succ_tran\<close>
  lemma succ_tran_mono: 
   "wf_graph \<lparr>nodes=N, edges=E\<rparr> \<Longrightarrow> E' \<subseteq> E \<Longrightarrow> succ_tran \<lparr>nodes=N, edges=E'\<rparr> v \<subseteq> succ_tran \<lparr>nodes=N, edges=E\<rparr> v"
    apply(drule wf_graph.finiteE)
    apply(frule_tac A="E'" in rev_finite_subset, simp)
    apply(simp add: num_reachable_def)
    apply(simp add: succ_tran_def)
    apply(metis (lifting, full_types) Collect_mono trancl_mono)
   done
 
   \<comment> \<open>num_reachable\<close>
   lemma num_reachable_mono:
   "wf_graph \<lparr>nodes=N, edges=E\<rparr> \<Longrightarrow> E' \<subseteq> E \<Longrightarrow> num_reachable \<lparr>nodes=N, edges=E'\<rparr> v \<le> num_reachable \<lparr>nodes=N, edges=E\<rparr> v"
    apply(simp add: num_reachable_def)
    apply(frule_tac E'="E'" and v="v" in succ_tran_mono, simp)
    apply(frule_tac v="v" in succ_tran_finite)
    apply(simp add: card_mono)
   done
 
   \<comment> \<open>num_reachable_norefl\<close>
   lemma num_reachable_norefl_mono:
   "wf_graph \<lparr>nodes=N, edges=E\<rparr> \<Longrightarrow> E' \<subseteq> E \<Longrightarrow> num_reachable_norefl \<lparr>nodes=N, edges=E'\<rparr> v \<le> num_reachable_norefl \<lparr>nodes=N, edges=E\<rparr> v"
    apply(simp add: num_reachable_norefl_def)
    apply(frule_tac E'="E'" and v="v" in succ_tran_mono, simp)
    apply(frule_tac v="v" in succ_tran_finite)
    using card_mono by (metis Diff_mono finite_Diff subset_refl)
 
   \<comment> \<open>backflows\<close>
   lemma backflows_wf: 
     "wf_graph \<lparr>nodes=N, edges=E\<rparr> \<Longrightarrow> wf_graph \<lparr>nodes=N, edges=backflows E\<rparr>"
     using [[simproc add: finite_Collect]] by(auto simp add: wf_graph_def backflows_def)
   lemma undirected_backflows: 
     "undirected G = \<lparr> nodes = nodes G, edges = (edges G) \<union> backflows (edges G) \<rparr>"
     by(simp add: backflows_def undirected_def)
   lemma backflows_id: 
     "backflows (backflows E) = E"
     by(simp add: backflows_def)
   lemma backflows_finite: "finite E \<Longrightarrow> finite (backflows E)"
     using [[simproc add: finite_Collect]] by(simp add: backflows_def) 
   lemma backflows_minus_backflows: "backflows (X - backflows Y) = (backflows X) - Y"
     by(auto simp add: backflows_def)
   lemma backflows_subseteq: "X \<subseteq> Y \<longleftrightarrow> backflows X \<subseteq> backflows Y"
     by(auto simp add: backflows_def)
   lemma backflows_un: "backflows (A \<union> B) = (backflows A) \<union> (backflows B)"
     by(auto simp add: backflows_def)
   lemma backflows_inter: "backflows (A \<inter> B) = (backflows A) \<inter> (backflows B)"
     by(auto simp add: backflows_def)
   lemma backflows_alt_fstsnd: "backflows E = (\<lambda>e. (snd e, fst e)) ` E"
     by(auto simp add: backflows_def, force)
 
 
 lemmas graph_ops=add_node_def delete_node_def add_edge_def delete_edge_def delete_edges_simp2
 
 
   \<comment> \<open>wf_graph\<close>
   lemma wf_graph_remove_edges: "wf_graph \<lparr> nodes = V, edges = E \<rparr> \<Longrightarrow> wf_graph \<lparr> nodes = V, edges=E - X\<rparr>"
     by (metis delete_edges_simp2 delete_edges_wf select_convs(1) select_convs(2))
 
   lemma wf_graph_remove_edges_union: 
     "wf_graph \<lparr> nodes = V, edges = E \<union> E' \<rparr> \<Longrightarrow> wf_graph \<lparr> nodes = V, edges=E\<rparr>"
     by(auto simp add: wf_graph_def)
 
   lemma wf_graph_union_edges: "\<lbrakk> wf_graph \<lparr> nodes = V, edges = E \<rparr>; wf_graph \<lparr> nodes = V, edges=E'\<rparr> \<rbrakk> \<Longrightarrow>
      wf_graph \<lparr> nodes = V, edges=E \<union> E'\<rparr>"
     by(auto simp add: wf_graph_def)
 
   lemma wf_graph_add_subset_edges: "\<lbrakk> wf_graph \<lparr> nodes = V, edges = E \<rparr>; E' \<subseteq> E \<rbrakk> \<Longrightarrow>
      wf_graph \<lparr> nodes = V, edges= E \<union> E'\<rparr>"
-    by(auto simp add: wf_graph_def) (metis rev_finite_subset)
+    by(auto simp add: wf_graph_def)
 
 
 (*Inspired by 
 Benedikt Nordhoff and Peter Lammich
 Dijkstra's Shortest Path Algorithm
 http://isa-afp.org/entries/Dijkstra_Shortest_Path.shtml*)
 (*more a literal copy of http://isa-afp.org/browser_info/current/AFP/Dijkstra_Shortest_Path/Graph.html*)
 
   text \<open>Successors of a node.\<close>
   definition succ :: "'v graph \<Rightarrow> 'v \<Rightarrow> 'v set"
     where "succ G v \<equiv> {v'. (v,v')\<in>edges G}"
 
 
   lemma succ_finite[simp, intro]: "finite (edges G) \<Longrightarrow> finite (succ G v)"
     unfolding succ_def
     by (rule finite_subset[where B="snd`edges G"]) force+
 
   lemma succ_empty: "succ empty v = {}" unfolding empty_def succ_def by auto
 
   lemma (in wf_graph) succ_subset: "succ G v \<subseteq> V"
     unfolding succ_def using E_wf
     by (force)
 
 
 end
 
diff --git a/thys/Ordinal_Partitions/Partitions.thy b/thys/Ordinal_Partitions/Partitions.thy
--- a/thys/Ordinal_Partitions/Partitions.thy
+++ b/thys/Ordinal_Partitions/Partitions.thy
@@ -1,926 +1,926 @@
 section \<open>Ordinal Partitions\<close>
 
 text \<open>Material from Jean A. Larson,
      A short proof of a partition theorem for the ordinal $\omega^\omega$.
      \emph{Annals of Mathematical Logic}, 6:129--145, 1973.
 Also from ``Partition Relations'' by A. Hajnal and J. A. Larson,
 in \emph{Handbook of Set Theory}, edited by Matthew Foreman and Akihiro Kanamori
 (Springer, 2010).\<close>
 
 theory Partitions
   imports Library_Additions "ZFC_in_HOL.ZFC_Typeclasses" "ZFC_in_HOL.Cantor_NF"
 
 begin
 
 abbreviation tp :: "V set \<Rightarrow> V"
   where "tp A \<equiv> ordertype A VWF"
 
 subsection \<open>Ordinal Partitions: Definitions\<close>
 
 definition partn_lst :: "[('a \<times> 'a) set, 'a set, V list, nat] \<Rightarrow> bool"
   where "partn_lst r B \<alpha> n \<equiv> \<forall>f \<in> [B]\<^bsup>n\<^esup>  \<rightarrow>  {..<length \<alpha>}.
               \<exists>i < length \<alpha>. \<exists>H. H \<subseteq> B \<and> ordertype H r = (\<alpha>!i) \<and> f ` (nsets H n) \<subseteq> {i}"
 
 abbreviation partn_lst_VWF :: "V \<Rightarrow> V list \<Rightarrow> nat \<Rightarrow> bool"
   where "partn_lst_VWF \<beta> \<equiv> partn_lst VWF (elts \<beta>)"
 
 lemma partn_lst_E:
   assumes "partn_lst r B \<alpha> n" "f \<in> nsets B n \<rightarrow>  {..<l}" "l = length \<alpha>"
   obtains i H where "i < l" "H \<subseteq> B"
                      "ordertype H r = \<alpha>!i" "f ` (nsets H n) \<subseteq> {i}"
   using assms by (auto simp: partn_lst_def)
 
 lemma partn_lst_VWF_nontriv:
   assumes "partn_lst_VWF \<beta> \<alpha> n" "l = length \<alpha>" "Ord \<beta>" "l > 0"
   obtains i where "i < l" "\<alpha>!i \<le> \<beta>"
 proof -
   have "{..<l} \<noteq> {}"
     by (simp add: \<open>l > 0\<close> lessThan_empty_iff)
   then obtain f where  "f \<in> nsets (elts \<beta>) n  \<rightarrow>  {..<l}"
     by (meson Pi_eq_empty equals0I)
   then obtain i H where "i < l" "H \<subseteq> elts \<beta>" and eq: "tp H = \<alpha>!i"
     using assms by (metis partn_lst_E)
   then have "\<alpha>!i \<le> \<beta>"
     by (metis \<open>H \<subseteq> elts \<beta>\<close> \<open>Ord \<beta>\<close> eq ordertype_le_Ord)
   then show thesis
     using \<open>i < l\<close> that by auto
 qed
 
 lemma partn_lst_triv0:
   assumes "\<alpha>!i = 0" "i < length \<alpha>" "n \<noteq> 0"
   shows "partn_lst r B \<alpha> n"
   by (metis partn_lst_def assms bot_least image_empty nsets_empty_iff ordertype_empty)
 
 lemma partn_lst_triv1:
   assumes "\<alpha>!i \<le> 1" "i < length \<alpha>" "n > 1" "B \<noteq> {}" "wf r"  
   shows "partn_lst r B \<alpha> n"
   unfolding partn_lst_def
 proof clarsimp
   obtain \<gamma> where "\<gamma> \<in> B" "\<alpha> \<noteq> []"
     using assms mem_0_Ord by fastforce
   have 01: "\<alpha>!i = 0 \<or> \<alpha>!i = 1"
     using assms by (fastforce simp: one_V_def)
   fix f
   assume f: "f \<in> [B]\<^bsup>n\<^esup> \<rightarrow> {..<length \<alpha>}"
   with assms have "ordertype {\<gamma>} r = 1 \<and> f ` [{\<gamma>}]\<^bsup>n\<^esup> \<subseteq> {i}"
                   "ordertype {} r = 0 \<and> f ` [{}]\<^bsup>n\<^esup> \<subseteq> {i}"
     by (auto simp: one_V_def ordertype_insert nsets_eq_empty)
   with assms 01 show "\<exists>i<length \<alpha>. \<exists>H\<subseteq>B. ordertype H r = \<alpha> ! i \<and> f ` [H]\<^bsup>n\<^esup> \<subseteq> {i}"
     using \<open>\<gamma> \<in> B\<close> by auto
 qed
 
 lemma partn_lst_two_swap:
   assumes "partn_lst r B [x,y] n" shows "partn_lst r B [y,x] n"
 proof -
   { fix f :: "'a set \<Rightarrow> nat"
     assume f: "f \<in> [B]\<^bsup>n\<^esup> \<rightarrow> {..<2}"
     then have f': "(\<lambda>i. 1 - i) \<circ> f \<in> [B]\<^bsup>n\<^esup> \<rightarrow> {..<2}"
       by (auto simp: Pi_def)
     obtain i H where "i<2" "H \<subseteq> B" "ordertype H r = ([x,y]!i)" "((\<lambda>i. 1 - i) \<circ> f) ` (nsets H n) \<subseteq> {i}"
       by (auto intro: partn_lst_E [OF assms f'])
     moreover have "f x = Suc 0" if "Suc 0 \<le> f x" "x\<in>[H]\<^bsup>n\<^esup>" for x
       using f that \<open>H \<subseteq> B\<close> nsets_mono  by (fastforce simp: Pi_iff)
     ultimately have "ordertype H r = [y,x] ! (1-i) \<and> f ` [H]\<^bsup>n\<^esup> \<subseteq> {1-i}"
       by (force simp: eval_nat_numeral less_Suc_eq)
     then have "\<exists>i H. i<2 \<and> H\<subseteq>B \<and> ordertype H r = [y,x] ! i \<and> f ` [H]\<^bsup>n\<^esup> \<subseteq> {i}"
       by (metis Suc_1 \<open>H \<subseteq> B\<close> diff_less_Suc) }
   then show ?thesis
     by (auto simp: partn_lst_def eval_nat_numeral)
 qed
 
 lemma partn_lst_greater_resource:
   assumes M: "partn_lst r B \<alpha> n" and "B \<subseteq> C"
   shows "partn_lst r C \<alpha> n"
 proof (clarsimp simp: partn_lst_def)
   fix f
   assume "f \<in> [C]\<^bsup>n\<^esup> \<rightarrow> {..<length \<alpha>}"
   then have "f \<in> [B]\<^bsup>n\<^esup> \<rightarrow> {..<length \<alpha>}"
     by (metis \<open>B \<subseteq> C\<close> part_fn_def part_fn_subset)
   then obtain i H where "i < length \<alpha>"
                    and "H \<subseteq> B" "ordertype H r = (\<alpha>!i)"
                    and "f ` nsets H n \<subseteq> {i}"
     using M partn_lst_def by metis
   then show "\<exists>i<length \<alpha>. \<exists>H\<subseteq>C. ordertype H r = \<alpha> ! i \<and> f ` [H]\<^bsup>n\<^esup> \<subseteq> {i}"
     using \<open>B \<subseteq> C\<close> by blast
 qed
 
 
 lemma partn_lst_less:
   assumes M: "partn_lst r B \<alpha> n" and eq: "length \<alpha>' = length \<alpha>" and "List.set \<alpha>' \<subseteq> ON"
     and le: "\<And>i. i < length \<alpha> \<Longrightarrow> \<alpha>'!i \<le> \<alpha>!i "
     and r: "wf r" "trans r" "total_on B r" and "small B"
   shows "partn_lst r B \<alpha>' n"
 proof (clarsimp simp: partn_lst_def)
   fix f
   assume "f \<in> [B]\<^bsup>n\<^esup> \<rightarrow> {..<length \<alpha>'}"
   then obtain i H where "i < length \<alpha>"
                    and "H \<subseteq> B" "small H" and H: "ordertype H r = (\<alpha>!i)"
                    and fi: "f ` nsets H n \<subseteq> {i}"
     using assms by (auto simp: partn_lst_def smaller_than_small)
   then have bij: "bij_betw (ordermap H r) H (elts (\<alpha>!i))"
     using ordermap_bij [of r H]
     by (smt assms(8) in_mono r(1) r(3) smaller_than_small total_on_def)
   define H' where "H' = inv_into H (ordermap H r) ` (elts (\<alpha>'!i))"
   have "H' \<subseteq> H"
     using bij \<open>i < length \<alpha>\<close> bij_betw_imp_surj_on le
     by (force simp: H'_def image_subset_iff intro: inv_into_into)
   moreover have ot: "ordertype H' r = (\<alpha>'!i)"
   proof (subst ordertype_eq_iff)
     show "Ord (\<alpha>' ! i)"
       using assms by (simp add: \<open>i < length \<alpha>\<close> subset_eq)
     show "small H'"
       by (simp add: H'_def)
     show "\<exists>f. bij_betw f H' (elts (\<alpha>' ! i)) \<and> (\<forall>x\<in>H'. \<forall>y\<in>H'. (f x < f y) = ((x, y) \<in> r))"
     proof (intro exI conjI ballI)
       show "bij_betw (ordermap H r) H' (elts (\<alpha>' ! i))"
         using \<open>H' \<subseteq> H\<close>
         by (metis H'_def \<open>i < length \<alpha>\<close> bij bij_betw_inv_into_RIGHT bij_betw_subset le less_eq_V_def)
       show "(ordermap H r x < ordermap H r y) = ((x, y) \<in> r)"
         if "x \<in> H'" "y \<in> H'" for x y
       proof (intro iffI ordermap_mono_less)
         assume "ordermap H r x < ordermap H r y"
         then show "(x, y) \<in> r"
           by (metis \<open>H \<subseteq> B\<close> assms(8) calculation in_mono leD ordermap_mono_le r smaller_than_small that total_on_def)
       qed (use assms that \<open>H' \<subseteq> H\<close> \<open>small H\<close> in auto)
     qed
     show "total_on H' r"
       using r by (meson \<open>H \<subseteq> B\<close> \<open>H' \<subseteq> H\<close> subsetD total_on_def)
   qed (use r in auto)
   ultimately show "\<exists>i<length \<alpha>'. \<exists>H\<subseteq>B. ordertype H r = \<alpha>' ! i \<and> f ` [H]\<^bsup>n\<^esup> \<subseteq> {i}"
     using \<open>H \<subseteq> B\<close> \<open>i < length \<alpha>\<close> fi assms
     by (metis image_mono nsets_mono subset_trans)
 qed
 
 
 text \<open>Holds because no $n$-sets exist!\<close>
 lemma partn_lst_VWF_degenerate:
   assumes "k < n"
   shows "partn_lst_VWF \<omega> (ord_of_nat k # \<alpha>s) n"
 proof (clarsimp simp: partn_lst_def)
   fix f :: "V set \<Rightarrow> nat"
   have "[elts (ord_of_nat k)]\<^bsup>n\<^esup> = {}"
     by (simp add: nsets_eq_empty assms finite_Ord_omega)
   then have "f ` [elts (ord_of_nat k)]\<^bsup>n\<^esup> \<subseteq> {0}"
     by auto
   then show "\<exists>i < Suc (length \<alpha>s). \<exists>H\<subseteq>elts \<omega>. tp H = (ord_of_nat k # \<alpha>s) ! i \<and> f ` [H]\<^bsup>n\<^esup> \<subseteq> {i}"
     using assms ordertype_eq_Ord [of "ord_of_nat k"] elts_ord_of_nat less_Suc_eq_0_disj
     by fastforce
 qed
 
 lemma partn_lst_VWF_\<omega>_2:
   assumes "Ord \<alpha>"
   shows "partn_lst_VWF (\<omega> \<up> (1+\<alpha>)) [2, \<omega> \<up> (1+\<alpha>)] 2" (is  "partn_lst_VWF ?\<beta> _ _")
 proof (clarsimp simp: partn_lst_def)
   fix f
   assume f: "f \<in> [elts ?\<beta>]\<^bsup>2\<^esup> \<rightarrow> {..<Suc (Suc 0)}"
   show "\<exists>i<Suc (Suc 0). \<exists>H\<subseteq>elts ?\<beta>. tp H = [2, ?\<beta>] ! i \<and> f ` [H]\<^bsup>2\<^esup> \<subseteq> {i}"
   proof (cases "\<exists>x \<in> elts ?\<beta>. \<exists>y \<in> elts ?\<beta>. x \<noteq> y \<and> f{x,y} = 0")
     case True
     then obtain x y where "x \<in> elts ?\<beta>" "y \<in> elts ?\<beta>" "x \<noteq> y" "f {x, y} = 0"
       by auto
     then have "{x,y} \<subseteq> elts ?\<beta>" "tp {x,y} = 2"
       "f ` [{x, y}]\<^bsup>2\<^esup> \<subseteq> {0}"
       by auto (simp add: eval_nat_numeral ordertype_VWF_finite_nat)
     with \<open>x \<noteq> y\<close> show ?thesis
       by (metis nth_Cons_0 zero_less_Suc)
   next
     case False
     with f have "\<forall>x\<in>elts ?\<beta>. \<forall>y\<in>elts ?\<beta>. x \<noteq> y \<longrightarrow> f {x, y} = 1"
       unfolding Pi_iff using lessThan_Suc by force
     then have "tp (elts ?\<beta>) = ?\<beta>" "f ` [elts ?\<beta>]\<^bsup>2\<^esup> \<subseteq> {Suc 0}"
       by (auto simp: assms nsets_2_eq)
     then show ?thesis
       by (metis lessI nth_Cons_0 nth_Cons_Suc subsetI)
   qed
 qed
 
 
 subsection \<open>Relating partition properties on @{term VWF} to the general case\<close>
 
 text \<open>Two very similar proofs here!\<close>
 
 lemma partn_lst_imp_partn_lst_VWF_eq:
   assumes part: "partn_lst r U \<alpha> n" and \<beta>: "ordertype U r = \<beta>" "small U" 
     and r: "wf r" "trans r" "total_on U r"
   shows "partn_lst_VWF \<beta> \<alpha> n"
   unfolding partn_lst_def
 proof clarsimp
   fix f
   assume f: "f \<in> [elts \<beta>]\<^bsup>n\<^esup> \<rightarrow> {..<length \<alpha>}"
   define cv where "cv \<equiv> \<lambda>X. ordermap U r ` X"
   have bij: "bij_betw (ordermap U r) U (elts \<beta>)"
     using ordermap_bij [of "r" U] assms by blast 
   then have bij_cv: "bij_betw cv ([U]\<^bsup>n\<^esup>) ([elts \<beta>]\<^bsup>n\<^esup>)"
     using bij_betw_nsets cv_def by blast
   then have func: "f \<circ> cv \<in> [U]\<^bsup>n\<^esup> \<rightarrow> {..<length \<alpha>}" and "inj_on (ordermap U r) U"
     using bij bij_betw_def bij_betw_apply f by fastforce+
   then have cv_part: "\<lbrakk>\<forall>x\<in>[X]\<^bsup>n\<^esup>. f (cv x) = i; X \<subseteq> U; a \<in> [cv X]\<^bsup>n\<^esup>\<rbrakk> \<Longrightarrow> f a = i" for a X i n
     by (force simp: cv_def nsets_def subset_image_iff inj_on_subset finite_image_iff card_image)
   have ot_eq [simp]: "tp (cv X) = ordertype X r" if "X \<subseteq> U" for X
     unfolding cv_def
   proof (rule ordertype_inc_eq)
     fix u v
     assume "u \<in> X" "v \<in> X" and "(u,v) \<in> r"
     with that have "ordermap U r u < ordermap U r v"
       by (simp add: assms ordermap_mono_less subset_eq)
     then show "(ordermap U r u, ordermap U r v) \<in> VWF"
       by (simp add: r)
   next
     show "total_on X r"
       using that r by (auto simp: total_on_def)
     show "small X"
       by (meson \<open>small U\<close> smaller_than_small that)
   qed (use assms in auto)
   obtain X i where "X \<subseteq> U" and X: "ordertype X r = \<alpha>!i" "(f \<circ> cv) ` [X]\<^bsup>n\<^esup> \<subseteq> {i}" 
     and "i < length \<alpha>"
     using part func by (auto simp: partn_lst_def)
   show "\<exists>i < length \<alpha>. \<exists>H\<subseteq>elts \<beta>. tp H = \<alpha>!i \<and> f ` [H]\<^bsup>n\<^esup> \<subseteq> {i}"
   proof (intro exI conjI)
     show "i < length \<alpha>"
       by (simp add: \<open>i < length \<alpha>\<close>)
     show "cv X \<subseteq> elts \<beta>"
       using \<open>X \<subseteq> U\<close> bij bij_betw_imp_surj_on cv_def by blast
     show "tp (cv X) = \<alpha> ! i"
       by (simp add: X(1) \<open>X \<subseteq> U\<close>)
     show "f ` [cv X]\<^bsup>n\<^esup> \<subseteq> {i}"
       using X \<open>X \<subseteq> U\<close> cv_part unfolding image_subset_iff cv_def
       by (metis comp_apply insertCI singletonD)
   qed
 qed
 
 lemma partn_lst_imp_partn_lst_VWF:
   assumes part: "partn_lst r U \<alpha> n" and \<beta>: "ordertype U r \<le> \<beta>" "small U" 
     and r: "wf r" "trans r" "total_on U r"
   shows "partn_lst_VWF \<beta> \<alpha> n"
   by (metis assms less_eq_V_def partn_lst_imp_partn_lst_VWF_eq partn_lst_greater_resource)
 
 lemma partn_lst_VWF_imp_partn_lst_eq:
   assumes part: "partn_lst_VWF \<beta> \<alpha> n" and \<beta>: "ordertype U r = \<beta>" "small U" 
     and r: "wf r" "trans r" "total_on U r"
   shows "partn_lst r U \<alpha> n"
   unfolding partn_lst_def
 proof clarsimp
   fix f
   assume f: "f \<in> [U]\<^bsup>n\<^esup> \<rightarrow> {..<length \<alpha>}"
   define cv where "cv \<equiv> \<lambda>X. inv_into U (ordermap U r) ` X"
   have bij: "bij_betw (ordermap U r) U (elts \<beta>)"
     using ordermap_bij [of "r" U] assms by blast 
   then have bij_cv: "bij_betw cv ([elts \<beta>]\<^bsup>n\<^esup>) ([U]\<^bsup>n\<^esup>)"
     using bij_betw_nsets bij_betw_inv_into unfolding cv_def by blast
   then have func: "f \<circ> cv \<in> [elts \<beta>]\<^bsup>n\<^esup> \<rightarrow> {..<length \<alpha>}"
     using bij_betw_apply f by fastforce
   have "inj_on (ordermap U r) U"
     using bij bij_betw_def by blast
   then have cv_part: "\<lbrakk>\<forall>x\<in>[X]\<^bsup>n\<^esup>. f (cv x) = i; X \<subseteq> elts \<beta>; a \<in> [cv X]\<^bsup>n\<^esup>\<rbrakk> \<Longrightarrow> f a = i" for a X i n
     apply ( simp add: cv_def nsets_def subset_image_iff inj_on_subset finite_image_iff card_image)
     by (metis bij bij_betw_def card_image inj_on_finite inj_on_inv_into subset_eq)
   have ot_eq [simp]: "ordertype (cv X) r = tp X" if "X \<subseteq> elts \<beta>" for X
     unfolding cv_def
   proof (rule ordertype_inc_eq)
     show "small X"
       using down that by auto
     show "(inv_into U (ordermap U r) x, inv_into U (ordermap U r) y) \<in> r"
       if "x \<in> X" "y \<in> X" and "(x,y) \<in> VWF" for x y
     proof -
       have xy: "x \<in> ordermap U r ` U" "y \<in> ordermap U r ` U"
         using \<open>X \<subseteq> elts \<beta>\<close> \<open>x \<in> X\<close> \<open>y \<in> X\<close> bij bij_betw_imp_surj_on by blast+
       then have eq: "ordermap U r (inv_into U (ordermap U r) x) = x" "ordermap U r (inv_into U (ordermap U r) y) = y"
         by (meson f_inv_into_f)+
       then have "y \<notin> elts x"
         by (metis (no_types) VWF_non_refl mem_imp_VWF that(3) trans_VWF trans_def)
       then show ?thesis
         by (metis (no_types) VWF_non_refl xy eq assms(3) inv_into_into ordermap_mono r(1) r(3) that(3) total_on_def)
     qed
   qed (use r in auto)
   obtain X i where "X \<subseteq> elts \<beta>" and X: "tp X = \<alpha>!i" "(f \<circ> cv) ` [X]\<^bsup>n\<^esup> \<subseteq> {i}" 
     and "i < length \<alpha>"
     using part func by (auto simp: partn_lst_def)
   show "\<exists>i < length \<alpha>. \<exists>H\<subseteq>U. ordertype H r = \<alpha>!i \<and> f ` [H]\<^bsup>n\<^esup> \<subseteq> {i}"
   proof (intro exI conjI)
     show "i < length \<alpha>"
       by (simp add: \<open>i < length \<alpha>\<close>)
     show "cv X \<subseteq> U"
       using \<open>X \<subseteq> elts \<beta>\<close> bij bij_betw_imp_surj_on bij_betw_inv_into cv_def by blast
     show "ordertype (cv X) r = \<alpha> ! i"
       by (simp add: X(1) \<open>X \<subseteq> elts \<beta>\<close>)
     show "f ` [cv X]\<^bsup>n\<^esup> \<subseteq> {i}"
       using X \<open>X \<subseteq> elts \<beta>\<close> cv_part unfolding image_subset_iff cv_def
       by (metis comp_apply insertCI singletonD)
   qed
 qed
 
 corollary partn_lst_VWF_imp_partn_lst:
   assumes "partn_lst_VWF \<beta> \<alpha> n" and \<beta>: "ordertype U r \<ge> \<beta>" "small U" 
           "wf r" "trans r" "total_on U r"
   shows "partn_lst r U \<alpha> n"
   by (metis assms less_eq_V_def partn_lst_VWF_imp_partn_lst_eq partn_lst_greater_resource)
 
 subsection \<open>Simple consequences of the definitions\<close>
 
 text \<open>A restatement of the infinite Ramsey theorem using partition notation\<close>
 lemma Ramsey_partn: "partn_lst_VWF \<omega> [\<omega>,\<omega>] 2"
 proof (clarsimp simp: partn_lst_def)
   fix f
   assume "f \<in> [elts \<omega>]\<^bsup>2\<^esup> \<rightarrow> {..<Suc (Suc 0)}"
   then have *: "\<forall>x\<in>elts \<omega>. \<forall>y\<in>elts \<omega>. x \<noteq> y \<longrightarrow> f {x, y} < 2"
     by (auto simp: nsets_def eval_nat_numeral)
   obtain H i where H: "H \<subseteq> elts \<omega>" and "infinite H"
     and t: "i < Suc (Suc 0)"
     and teq: "\<forall>x\<in>H. \<forall>y\<in>H. x \<noteq> y \<longrightarrow> f {x, y} = i"
     using Ramsey2 [OF infinite_\<omega> *] by (auto simp: eval_nat_numeral)
   then have "tp H = [\<omega>, \<omega>] ! i"
     using less_2_cases eval_nat_numeral ordertype_infinite_\<omega> by force
   moreover have "f ` {N. N \<subseteq> H \<and> finite N \<and> card N = 2} \<subseteq> {i}"
     by (force simp: teq card_2_iff)
   ultimately have "f ` [H]\<^bsup>2\<^esup> \<subseteq> {i}"
     by (metis (no_types) nsets_def numeral_2_eq_2)
   then show "\<exists>i<Suc (Suc 0). \<exists>H\<subseteq>elts \<omega>. tp H = [\<omega>,\<omega>] ! i \<and> f ` [H]\<^bsup>2\<^esup> \<subseteq> {i}"
     using H \<open>tp H = [\<omega>, \<omega>] ! i\<close> t by blast
 qed
 
 text \<open>This is the counterexample sketched in Hajnal and Larson, section 9.1.\<close>
 proposition omega_basic_counterexample:
   assumes "Ord \<alpha>"
   shows "\<not> partn_lst_VWF \<alpha> [succ (vcard \<alpha>), \<omega>] 2"
 proof -
   obtain \<pi> where fun\<pi>: "\<pi> \<in> elts \<alpha> \<rightarrow> elts (vcard \<alpha>)" and inj\<pi>: "inj_on \<pi> (elts \<alpha>)"
     using inj_into_vcard by auto
   have Ord\<pi>: "Ord (\<pi> x)" if "x \<in> elts \<alpha>" for x
     using Ord_in_Ord fun\<pi> that by fastforce
   define f where "f A \<equiv> @i::nat. \<exists>x y. A = {x,y} \<and> x < y \<and> (\<pi> x < \<pi> y \<and> i=0 \<or> \<pi> y < \<pi> x \<and> i=1)" for A
   have f_Pi: "f \<in> [elts \<alpha>]\<^bsup>2\<^esup> \<rightarrow> {..<Suc (Suc 0)}"
   proof
     fix A
     assume "A \<in> [elts \<alpha>]\<^bsup>2\<^esup>"
     then obtain x y where xy: "x \<in> elts \<alpha>" "y \<in> elts \<alpha>" "x < y" and A: "A = {x,y}"
       apply (clarsimp simp: nsets_2_eq)
       by (metis Ord_in_Ord Ord_linear_lt assms insert_commute)
     consider "\<pi> x < \<pi> y" | "\<pi> y < \<pi> x"
       by (metis Ord\<pi> Ord_linear_lt inj\<pi> inj_onD less_imp_not_eq2 xy)
     then show "f A \<in> {..<Suc (Suc 0)}"
       by (metis A One_nat_def lessI lessThan_iff zero_less_Suc \<open>x < y\<close> A exE_some [OF _ f_def])
   qed
   have fiff: "\<pi> x < \<pi> y \<and> i=0 \<or> \<pi> y < \<pi> x \<and> i=1"
     if f: "f {x,y} = i" and xy: "x \<in> elts \<alpha>" "y \<in> elts \<alpha>" "x<y" for x y i
   proof -
     consider "\<pi> x < \<pi> y" | "\<pi> y < \<pi> x"
       using xy by (metis Ord\<pi> Ord_linear_lt inj\<pi> inj_onD less_V_def)
     then show ?thesis
     proof cases
       case 1
       then have "f{x,y} = 0"
         using \<open>x<y\<close> by (force simp: f_def Set.doubleton_eq_iff)
     then show ?thesis
       using "1" f by auto
     next
       case 2
       then have "f{x,y} = 1"
       using \<open>x<y\<close> by (force simp: f_def Set.doubleton_eq_iff)
     then show ?thesis
       using "2" f by auto
     qed
   qed
   have False
     if eq: "tp H = succ (vcard \<alpha>)" and H: "H \<subseteq> elts \<alpha>"
     and 0: "\<And>A. A \<in> [H]\<^bsup>2\<^esup> \<Longrightarrow> f A = 0" for H
   proof -
     have [simp]: "small H"
       using H down by auto
     have OH: "Ord x" if "x \<in> H" for x
       using H Ord_in_Ord \<open>Ord \<alpha>\<close> that by blast
     have \<pi>: "\<pi> x < \<pi> y" if "x\<in>H" "y\<in>H" "x<y" for x y
       using 0 [of "{x,y}"] that H fiff by (fastforce simp: nsets_2_eq)
     have sub_vcard: "\<pi> ` H \<subseteq> elts (vcard \<alpha>)"
       using H fun\<pi> by auto
     have "tp H = tp (\<pi> ` H)"
     proof (rule ordertype_VWF_inc_eq [symmetric])
       show "\<pi> ` H \<subseteq> ON"
       using H Ord\<pi> by blast
     qed (auto simp: \<pi> OH subsetI)
     also have "\<dots> \<le> vcard \<alpha>"
       by (simp add: H sub_vcard assms ordertype_le_Ord)
     finally show False
       by (simp add: eq succ_le_iff)
   qed
   moreover have False
     if eq: "tp H = \<omega>" and H: "H \<subseteq> elts \<alpha>"
       and 1: "\<And>A. A \<in> [H]\<^bsup>2\<^esup> \<Longrightarrow> f A = Suc 0" for H
   proof -
     have [simp]: "small H"
       using H down by auto
     define \<eta> where "\<eta> \<equiv> inv_into H (ordermap H VWF) \<circ> ord_of_nat"
     have bij: "bij_betw (ordermap H VWF) H (elts \<omega>)"
       by (metis ordermap_bij \<open>small H\<close> eq total_on_VWF wf_VWF)
     then have "bij_betw (inv_into H (ordermap H VWF)) (elts \<omega>) H"
       by (simp add: bij_betw_inv_into)
     then have \<eta>: "bij_betw \<eta> UNIV H"
       unfolding \<eta>_def
       by (metis \<omega>_def bij_betw_comp_iff2 bij_betw_def elts_of_set inf inj_ord_of_nat order_refl)
     moreover have Ord\<eta>: "Ord (\<eta> k)" for k
       by (meson H Ord_in_Ord UNIV_I \<eta> assms bij_betw_apply subsetD)
     moreover obtain k where k: "(\<pi> (\<eta>(Suc k)), \<pi> (\<eta> k)) \<notin> VWF"
       by (meson wf_VWF wf_iff_no_infinite_down_chain)
     moreover have \<pi>: "\<pi> y < \<pi> x" if "x\<in>H" "y\<in>H" "x<y" for x y
       using 1 [of "{x,y}"] that H fiff by (fastforce simp: nsets_2_eq)
     ultimately have "\<eta> (Suc k) \<le> \<eta> k"
       by (metis H Ord\<pi> Ord_linear2 VWF_iff_Ord_less bij_betw_def rangeI subset_iff)
     then have "(\<eta> (Suc k), \<eta> k) \<in> VWF \<or> \<eta> (Suc k) = \<eta> k"
       using Ord\<eta> Ord_mem_iff_lt by auto
     then have "ordermap H VWF (\<eta> (Suc k)) \<le> ordermap H VWF (\<eta> k)"
       by (metis \<eta> \<open>small H\<close> bij_betw_imp_surj_on ordermap_mono_le rangeI trans_VWF wf_VWF)
     moreover have "ordermap H VWF (\<eta> (Suc k)) = succ (ord_of_nat k)"
       unfolding \<eta>_def using bij bij_betw_inv_into_right by force
     moreover have "ordermap H VWF (\<eta> k) = ord_of_nat k"
       using \<eta>_def bij bij_betw_inv_into_right by force
     ultimately show False
       by (simp add: less_eq_V_def)
   qed
   ultimately show ?thesis
     apply (simp add: partn_lst_def image_subset_iff)
     by (metis f_Pi less_2_cases nth_Cons_0 nth_Cons_Suc numeral_2_eq_2)
 qed
 
 subsection \<open>Specker's theorem\<close>
 
 definition form_split :: "[nat,nat,nat,nat,nat] \<Rightarrow> bool" where
   "form_split a b c d i \<equiv> a \<le> c \<and> (i=0 \<and> a<b \<and> b<c \<and> c<d \<or>
                                     i=1 \<and> a<c \<and> c<b \<and> b<d \<or>
                                     i=2 \<and> a<c \<and> c<d \<and> d<b \<or>
                                     i=3 \<and> a=c \<and> b\<noteq>d)"
 
 definition form :: "[(nat*nat)set, nat] \<Rightarrow> bool" where
   "form u i \<equiv> \<exists>a b c d. u = {(a,b),(c,d)} \<and> form_split a b c d i"
 
 definition scheme :: "[(nat*nat)set] \<Rightarrow> nat set" where
   "scheme u \<equiv> fst ` u \<union> snd ` u"
 
 definition UU :: "(nat*nat) set"
   where "UU \<equiv> {(a,b). a < b}"
 
 lemma ordertype_UNIV_\<omega>2: "ordertype UNIV pair_less = \<omega>\<up>2"
   using ordertype_Times [of concl: UNIV UNIV less_than less_than]
   by (simp add: total_less_than pair_less_def ordertype_nat_\<omega> numeral_2_eq_2)
 
 lemma ordertype_UU_ge_\<omega>2:  "ordertype UNIV pair_less \<le> ordertype UU pair_less"
 proof (rule ordertype_inc_le)
   define \<pi> where "\<pi> \<equiv> \<lambda>(m,n). (m, Suc (m+n))"
   show "(\<pi> (x::nat \<times> nat), \<pi> y) \<in> pair_less" if "(x, y) \<in> pair_less" for x y
     using that by (auto simp: \<pi>_def pair_less_def split: prod.split)
   show "range \<pi> \<subseteq> UU"
     by (auto simp: \<pi>_def UU_def)
 qed auto
 
 lemma ordertype_UU_\<omega>2: "ordertype UU pair_less = \<omega>\<up>2"
   by (metis eq_iff ordertype_UNIV_\<omega>2 ordertype_UU_ge_\<omega>2 ordertype_mono small top_greatest trans_pair_less wf_pair_less)
 
 
 text \<open>Lemma 2.3 of Jean A. Larson,
      A short proof of a partition theorem for the ordinal $\omega^\omega$.
      \emph{Annals of Mathematical Logic}, 6:129--145, 1973.\<close>
 lemma lemma_2_3:
   fixes f :: "(nat \<times> nat) set \<Rightarrow> nat"
   assumes "f \<in> [UU]\<^bsup>2\<^esup> \<rightarrow> {..<Suc (Suc 0)}"
   obtains N js where "infinite N" and "\<And>k u. \<lbrakk>k < 4; u \<in> [UU]\<^bsup>2\<^esup>; form u k; scheme u \<subseteq> N\<rbrakk> \<Longrightarrow> f u = js!k"
 proof -
   have f_less2: "f {p,q} < Suc (Suc 0)" if "p \<noteq> q" "p \<in> UU" "q \<in> UU" for p q
   proof -
     have "{p,q} \<in> [UU]\<^bsup>2\<^esup>"
       using that by (simp add: nsets_def)
     then show ?thesis
       using assms by (simp add: Pi_iff)
   qed
   define f0 where "f0 \<equiv> (\<lambda>A::nat set. THE x. \<exists>a b c d. A = {a,b,c,d} \<and> a<b \<and> b<c \<and> c<d \<and> x = f {(a,b),(c,d)})"
   have f0: "f0 {a,b,c,d} = f {(a,b),(c,d)}" if "a<b" "b<c" "c<d" for a b c d
     unfolding f0_def
     apply (rule theI2 [where a = "f {(a,b), (c,d)}"])
     using that by (force simp: insert_eq_iff split: if_split_asm)+
   have "f0 X < Suc (Suc 0)"
     if "finite X" and "card X = 4" for X
   proof -
     have "X \<in> [X]\<^bsup>4\<^esup>"
       using that by (auto simp: nsets_def)
     then obtain a b c d where "X = {a,b,c,d} \<and> a<b \<and> b<c \<and> c<d"
       by (auto simp: ordered_nsets_4_eq)
     then show ?thesis
       using f0 f_less2 by (auto simp: UU_def)
   qed
   then have "\<exists>N t. infinite N \<and> t < Suc (Suc 0)
             \<and> (\<forall>X. X \<subseteq> N \<and> finite X \<and> card X = 4 \<longrightarrow> f0 X = t)"
     using Ramsey [of UNIV 4 f0 2] by (simp add: eval_nat_numeral)
   then obtain N0 j0 where "infinite N0" and j0: "j0 < Suc (Suc 0)" and N0: "\<And>A. A \<in> [N0]\<^bsup>4\<^esup> \<Longrightarrow> f0 A = j0"
     by (auto simp: nsets_def)
 
   define f1 where "f1 \<equiv> (\<lambda>A::nat set. THE x. \<exists>a b c d. A = {a,b,c,d} \<and> a<b \<and> b<c \<and> c<d \<and> x = f {(a,c),(b,d)})"
   have f1: "f1 {a,b,c,d} = f {(a,c),(b,d)}" if "a<b" "b<c" "c<d" for a b c d
     unfolding f1_def
     apply (rule theI2 [where a = "f {(a,c), (b,d)}"])
     using that by (force simp: insert_eq_iff split: if_split_asm)+
   have "f1 X < Suc (Suc 0)"
     if "finite X" and "card X = 4" for X
   proof -
     have "X \<in> [X]\<^bsup>4\<^esup>"
       using that by (auto simp: nsets_def)
     then obtain a b c d where "X = {a,b,c,d} \<and> a<b \<and> b<c \<and> c<d"
       by (auto simp: ordered_nsets_4_eq)
     then show ?thesis
       using f1 f_less2 by (auto simp: UU_def)
   qed
   then have "\<exists>N t. N \<subseteq> N0 \<and> infinite N \<and> t < Suc (Suc 0)
             \<and> (\<forall>X. X \<subseteq> N \<and> finite X \<and> card X = 4 \<longrightarrow> f1 X = t)"
     using \<open>infinite N0\<close> Ramsey [of N0 4 f1 2] by (simp add: eval_nat_numeral)
   then obtain N1 j1 where "N1 \<subseteq> N0" "infinite N1" and j1: "j1 < Suc (Suc 0)" and N1: "\<And>A. A \<in> [N1]\<^bsup>4\<^esup> \<Longrightarrow> f1 A = j1"
     by (auto simp: nsets_def)
 
   define f2 where "f2 \<equiv> (\<lambda>A::nat set. THE x. \<exists>a b c d. A = {a,b,c,d} \<and> a<b \<and> b<c \<and> c<d \<and> x = f {(a,d),(b,c)})"
   have f2: "f2 {a,b,c,d} = f {(a,d),(b,c)}" if "a<b" "b<c" "c<d" for a b c d
     unfolding f2_def
     apply (rule theI2 [where a = "f {(a,d), (b,c)}"])
     using that by (force simp: insert_eq_iff split: if_split_asm)+
   have "f2 X < Suc (Suc 0)"
     if "finite X" and "card X = 4" for X
   proof -
     have "X \<in> [X]\<^bsup>4\<^esup>"
       using that by (auto simp: nsets_def)
     then obtain a b c d where "X = {a,b,c,d} \<and> a<b \<and> b<c \<and> c<d"
       by (auto simp: ordered_nsets_4_eq)
     then show ?thesis
       using f2 f_less2 by (auto simp: UU_def)
   qed
   then have "\<exists>N t. N \<subseteq> N1 \<and> infinite N \<and> t < Suc (Suc 0)
             \<and> (\<forall>X. X \<subseteq> N \<and> finite X \<and> card X = 4 \<longrightarrow> f2 X = t)"
     using \<open>infinite N1\<close> Ramsey [of N1 4 f2 2] by (simp add: eval_nat_numeral)
   then obtain N2 j2 where "N2 \<subseteq> N1" "infinite N2" and j2: "j2 < Suc (Suc 0)" and N2: "\<And>A. A \<in> [N2]\<^bsup>4\<^esup> \<Longrightarrow> f2 A = j2"
     by (auto simp: nsets_def)
 
   define f3 where "f3 \<equiv> (\<lambda>A::nat set. THE x. \<exists>a b c. A = {a,b,c} \<and> a<b \<and> b<c \<and> x = f {(a,b),(a,c)})"
   have f3: "f3 {a,b,c} = f {(a,b),(a,c)}" if "a<b" "b<c" for a b c
     unfolding f3_def
     apply (rule theI2 [where a = "f {(a,b), (a,c)}"])
     using that by (force simp: insert_eq_iff split: if_split_asm)+
   have f3': "f3 {a,b,c} = f {(a,b),(a,c)}" if "a<c" "c<b" for a b c
     using f3 [of a c b] that
     by (simp add: insert_commute)
   have "f3 X < Suc (Suc 0)"
     if "finite X" and "card X = 3" for X
   proof -
     have "X \<in> [X]\<^bsup>3\<^esup>"
       using that by (auto simp: nsets_def)
     then obtain a b c where "X = {a,b,c} \<and> a<b \<and> b<c"
       by (auto simp: ordered_nsets_3_eq)
     then show ?thesis
       using f3 f_less2 by (auto simp: UU_def)
   qed
   then have "\<exists>N t. N \<subseteq> N2 \<and> infinite N \<and> t < Suc (Suc 0)
             \<and> (\<forall>X. X \<subseteq> N \<and> finite X \<and> card X = 3 \<longrightarrow> f3 X = t)"
     using \<open>infinite N2\<close> Ramsey [of N2 3 f3 2] by (simp add: eval_nat_numeral)
   then obtain N3 j3 where "N3 \<subseteq> N2" "infinite N3" and j3: "j3 < Suc (Suc 0)" and N3: "\<And>A. A \<in> [N3]\<^bsup>3\<^esup> \<Longrightarrow> f3 A = j3"
     by (auto simp: nsets_def)
 
   show thesis
   proof
     fix k u
     assume "k < 4"
       and u: "form u k" "scheme u \<subseteq> N3"
       and UU: "u \<in> [UU]\<^bsup>2\<^esup>"
     then consider (0) "k=0" | (1) "k=1" | (2) "k=2" | (3) "k=3"
       by linarith
     then show "f u = [j0,j1,j2,j3] ! k"
     proof cases
       case 0
       have "N3 \<subseteq> N0"
         using \<open>N1 \<subseteq> N0\<close> \<open>N2 \<subseteq> N1\<close> \<open>N3 \<subseteq> N2\<close> by auto
       then show ?thesis
         using u 0
         apply (auto simp: form_def form_split_def scheme_def simp flip: f0)
         apply (force simp: nsets_def intro: N0)
         done
     next
       case 1
       have "N3 \<subseteq> N1"
         using \<open>N2 \<subseteq> N1\<close> \<open>N3 \<subseteq> N2\<close> by auto
       then show ?thesis
         using u 1
         apply (auto simp: form_def form_split_def scheme_def simp flip: f1)
         apply (force simp: nsets_def intro: N1)
         done
     next
       case 2
       then show ?thesis
         using u \<open>N3 \<subseteq> N2\<close>
         apply (auto simp: form_def form_split_def scheme_def nsets_def simp flip: f2)
         apply (force simp: nsets_def intro: N2)
         done
     next
       case 3
       { fix a b d
         assume "{(a, b), (a, d)} \<in> [UU]\<^bsup>2\<^esup>"
           and *: "a \<in> N3" "b \<in> N3" "d \<in> N3" "b \<noteq> d"
         then have "a<b" "a<d"
           by (auto simp: UU_def nsets_def)
         then have "f {(a, b), (a, d)} = j3"
           using *
           apply (auto simp: neq_iff simp flip: f3 f3')
            apply (force simp: nsets_def intro: N3)+
           done
       }
       then show ?thesis
         using u UU 3
         by (auto simp: form_def form_split_def scheme_def)
     qed
   qed (rule \<open>infinite N3\<close>)
 qed
 
 
 text \<open>Lemma 2.4 of Jean A. Larson, ibid.\<close>
 lemma lemma_2_4:
   assumes "infinite N" "k < 4"
   obtains M where "M \<in> [UU]\<^bsup>m\<^esup>" "\<And>u. u \<in> [M]\<^bsup>2\<^esup> \<Longrightarrow> form u k" "\<And>u. u \<in> [M]\<^bsup>2\<^esup> \<Longrightarrow> scheme u \<subseteq> N"
 proof -
   obtain f:: "nat \<Rightarrow> nat" where "bij_betw f UNIV N" "strict_mono f"
     using assms by (meson bij_enumerate enumerate_mono strict_monoI)
   then have iff[simp]: "f x = f y \<longleftrightarrow> x=y" "f x < f y \<longleftrightarrow> x<y" for x y
     by (simp_all add: strict_mono_eq strict_mono_less)
   have [simp]: "f x \<in> N" for x
     using bij_betw_apply [OF \<open>bij_betw f UNIV N\<close>] by blast
   define M0 where "M0 = (\<lambda>i. (f(2*i), f(Suc(2*i)))) ` {..<m}"
   define M1 where "M1 = (\<lambda>i. (f i, f(m+i))) ` {..<m}"
   define M2 where "M2 = (\<lambda>i. (f i, f(2*m-i))) ` {..<m}"
   define M3 where "M3 = (\<lambda>i. (f 0, f (Suc i))) ` {..<m}"
   consider (0) "k=0" | (1) "k=1" | (2) "k=2" | (3) "k=3"
     using assms by linarith
   then show thesis
   proof cases
     case 0
     show ?thesis
     proof
       have "inj_on (\<lambda>i. (f (2 * i), f (Suc (2 * i)))) {..<m}"
         by (auto simp: inj_on_def)
       then show "M0 \<in> [UU]\<^bsup>m\<^esup>"
         by (simp add: M0_def nsets_def card_image UU_def image_subset_iff)
     next
       fix u
       assume u: "(u::(nat \<times> nat) set) \<in> [M0]\<^bsup>2\<^esup>"
       then obtain x y where "u = {x,y}" "x \<noteq> y" "x \<in> M0" "y \<in> M0"
         by (auto simp: nsets_2_eq)
       then obtain i j where "i<j" "j<m" and ueq: "u = {(f(2*i), f(Suc(2*i))), (f(2*j), f(Suc(2*j)))}"
         apply (clarsimp simp: M0_def)
         apply (metis (full_types) insert_commute less_linear)+
         done
       moreover have "f (2 * i) \<le> f (2 * j)"
         by (simp add: \<open>i<j\<close> less_imp_le_nat)
       ultimately show "form u k"
         apply (simp add: 0 form_def form_split_def nsets_def)
         apply (rule_tac x="f (2 * i)" in exI)
         apply (rule_tac x="f (Suc (2 * i))" in exI)
         apply (rule_tac x="f (2 * j)" in exI)
         apply (rule_tac x="f (Suc (2 * j))" in exI)
         apply auto
         done
       show "scheme u \<subseteq> N"
         using ueq by (auto simp: scheme_def)
     qed
   next
     case 1
     show ?thesis
     proof
       have "inj_on (\<lambda>i. (f i, f(m+i))) {..<m}"
         by (auto simp: inj_on_def)
       then show "M1 \<in> [UU]\<^bsup>m\<^esup>"
         by (simp add: M1_def nsets_def card_image UU_def image_subset_iff)
     next
       fix u
       assume u: "(u::(nat \<times> nat) set) \<in> [M1]\<^bsup>2\<^esup>"
       then obtain x y where "u = {x,y}" "x \<noteq> y" "x \<in> M1" "y \<in> M1"
         by (auto simp: nsets_2_eq)
       then obtain i j where "i<j" "j<m" and ueq: "u = {(f i, f(m+i)), (f j, f(m+j))}"
         apply (auto simp: M1_def)
         apply (metis (full_types) insert_commute less_linear)+
         done
       then show "form u k"
         apply (simp add: 1 form_def form_split_def nsets_def)
         by (metis iff(2) nat_add_left_cancel_less nat_less_le trans_less_add1)
       show "scheme u \<subseteq> N"
         using ueq by (auto simp: scheme_def)
     qed
   next
     case 2
     show ?thesis
     proof
       have "inj_on (\<lambda>i. (f i, f(2*m-i))) {..<m}"
         by (auto simp: inj_on_def)
       then show "M2 \<in> [UU]\<^bsup>m\<^esup>"
         by (auto simp: M2_def nsets_def card_image UU_def image_subset_iff)
     next
       fix u
       assume u: "(u::(nat \<times> nat) set) \<in> [M2]\<^bsup>2\<^esup>"
       then obtain x y where "u = {x,y}" "x \<noteq> y" "x \<in> M2" "y \<in> M2"
         by (auto simp: nsets_2_eq)
       then obtain i j where "i<j" "j<m" and ueq: "u = {(f i, f(2*m-i)), (f j, f(2*m-j))}"
         apply (auto simp: M2_def)
         apply (metis (full_types) insert_commute less_linear)+
         done
       then show "form u k"
         apply (simp add: 2 form_def form_split_def nsets_def)
         apply (rule_tac x="f i" in exI)
         apply (rule_tac x="f (2 * m - i)" in exI)
         apply (rule_tac x="f j" in exI)
         apply (rule_tac x="f (2 * m - j)" in exI)
         apply (auto simp: less_imp_le_nat)
         done
       show "scheme u \<subseteq> N"
         using ueq by (auto simp: scheme_def)
     qed
   next
     case 3
     show ?thesis
     proof
       have "inj_on (\<lambda>i. (f 0, f (Suc i))) {..<m}"
         by (auto simp: inj_on_def)
       then show "M3 \<in> [UU]\<^bsup>m\<^esup>"
         by (auto simp: M3_def nsets_def card_image UU_def image_subset_iff)
     next
       fix u
       assume u: "(u::(nat \<times> nat) set) \<in> [M3]\<^bsup>2\<^esup>"
       then obtain x y where "u = {x,y}" "x \<noteq> y" "x \<in> M3" "y \<in> M3"
         by (auto simp: nsets_2_eq)
       then obtain i j where "i<j" "j<m" and ueq: "u = {(f 0, f(Suc i)), (f 0, f(Suc j))}"
         apply (auto simp: M3_def)
         apply (metis (full_types) insert_commute less_linear)+
         done
       then show "form u k"
         by (fastforce simp: 3 form_def form_split_def nsets_def)
       show "scheme u \<subseteq> N"
         using ueq by (auto simp: scheme_def)
     qed
   qed
 qed
 
 
 text \<open>Lemma 2.5 of Jean A. Larson, ibid.\<close>
 lemma lemma_2_5:
   assumes "infinite N"
   obtains X where "X \<subseteq> UU" "ordertype X pair_less = \<omega>\<up>2"
             "\<And>u. u \<in> [X]\<^bsup>2\<^esup> \<Longrightarrow> (\<exists>k<4. form u k) \<and> scheme u \<subseteq> N"
 proof -
   obtain C
     where dis: "pairwise (\<lambda>i j. disjnt (C i) (C j)) UNIV"
       and N: "(\<Union>i. C i) \<subseteq> N" and infC: "\<And>i::nat. infinite (C i)"
     using assms infinite_infinite_partition by blast
   then have "\<exists>\<phi>::nat \<Rightarrow> nat. inj \<phi> \<and> range \<phi> = C i \<and> strict_mono \<phi>" for i
     by (metis bij_betw_imp_inj_on bij_betw_imp_surj_on bij_enumerate enumerate_mono infC strict_mono_def)
   then obtain \<phi>:: "[nat,nat] \<Rightarrow> nat"
       where \<phi>: "\<And>i. inj (\<phi> i) \<and> range (\<phi> i) = C i \<and> strict_mono (\<phi> i)"
     by metis
   then have \<pi>_in_C [simp]: "\<phi> i j \<in> C i' \<longleftrightarrow> i'=i" for i i' j
     using dis by (fastforce simp: pairwise_def disjnt_def)
   have less_iff [simp]: "\<phi> i j' < \<phi> i j \<longleftrightarrow> j' < j" for i j' j
     by (simp add: \<phi> strict_mono_less)
   let ?a = "\<phi> 0"
   define X where "X \<equiv> {(?a i, b) | i b. ?a i < b \<and> b \<in> C (Suc i)}"
   show thesis
   proof
     show "X \<subseteq> UU"
       by (auto simp: X_def UU_def)
     show "ordertype X pair_less = \<omega>\<up>2"
     proof (rule antisym)
       have "ordertype X pair_less \<le> ordertype UU pair_less"
         by (simp add: \<open>X \<subseteq> UU\<close> ordertype_mono)
       then show "ordertype X pair_less \<le> \<omega>\<up>2"
         using ordertype_UU_\<omega>2 by auto
       define \<pi> where "\<pi> \<equiv> \<lambda>(i,j::nat). (?a i, \<phi> (Suc i) (?a j))"
       have "\<And>i j. i < j \<Longrightarrow> \<phi> 0 i < \<phi> (Suc i) (\<phi> 0 j)"
         by (meson \<phi> le_less_trans less_iff strict_mono_imp_increasing)
       then have subX: "\<pi> ` UU \<subseteq> X"
         by (auto simp: UU_def \<pi>_def X_def)
       then have "ordertype (\<pi> ` UU) pair_less \<le> ordertype X pair_less"
         by (simp add: ordertype_mono)
       moreover have "ordertype (\<pi> ` UU) pair_less = ordertype UU pair_less"
       proof (rule ordertype_inc_eq)
         show "(\<pi> x, \<pi> y) \<in> pair_less"
           if "x \<in> UU" "y \<in> UU" and "(x, y) \<in> pair_less" for x y
           using that by (auto simp: UU_def \<pi>_def pair_less_def)
       qed auto
       ultimately show "\<omega>\<up>2 \<le> ordertype X pair_less"
         using ordertype_UU_\<omega>2 by simp
     qed
   next
     fix U
     assume "U \<in> [X]\<^bsup>2\<^esup>"
     then obtain a b c d where Ueq: "U = {(a,b),(c,d)}" and ne: "(a,b) \<noteq> (c,d)" and inX: "(a,b) \<in> X" "(c,d) \<in> X" and "a \<le> c"
       apply (auto simp: nsets_def subset_iff eval_nat_numeral card_Suc_eq Set.doubleton_eq_iff)
        apply (metis  nat_le_linear)+
       done
     show "(\<exists>k<4. form U k) \<and> scheme U \<subseteq> N"
     proof
       show "scheme U \<subseteq> N"
         using inX N \<phi> by (fastforce simp: scheme_def Ueq X_def)
     next
       consider "a < c" | "a = c \<and> b \<noteq> d"
         using \<open>a \<le> c\<close> ne nat_less_le by blast
       then show "\<exists>k<4. form U k"
       proof cases
         case 1
         have *: "a < b"  "b \<noteq> c" "c < d"
           using inX by (auto simp: X_def)
         moreover have "\<lbrakk>a < c; c < b; \<not> d < b\<rbrakk> \<Longrightarrow> b < d"
           using inX apply (clarsimp simp: X_def not_less)
           by (metis \<phi> \<pi>_in_C imageE nat.inject nat_less_le)
         ultimately consider (k0) "a<b \<and> b<c \<and> c<d" | (k1) "a<c \<and> c<b \<and> b<d" | (k2) "a<c \<and> c<d \<and> d<b"
           using 1 less_linear by blast
         then show ?thesis
         proof cases
           case k0
           then have "form U 0"
             unfolding form_def form_split_def using Ueq \<open>a \<le> c\<close> by blast
           then show ?thesis by force
         next
           case k1
           then have "form U 1"
             unfolding form_def form_split_def using Ueq \<open>a \<le> c\<close> by blast
           then show ?thesis by force
         next
           case k2
           then have "form U 2"
             unfolding form_def form_split_def using Ueq \<open>a \<le> c\<close> by blast
           then show ?thesis by force
         qed
       next
         case 2
         then have "form_split a b c d 3"
           by (auto simp: form_split_def)
         then show ?thesis
           using Ueq form_def leI by force
       qed
     qed
   qed
 qed
 
 text \<open>Theorem 2.1 of Jean A. Larson, ibid.\<close>
 lemma Specker_aux:
   assumes "\<alpha> \<in> elts \<omega>"
   shows "partn_lst pair_less UU [\<omega>\<up>2,\<alpha>] 2"
   unfolding partn_lst_def
 proof clarsimp
   fix f
   assume f: "f \<in> [UU]\<^bsup>2\<^esup> \<rightarrow> {..<Suc (Suc 0)}"
   let ?P0 = "\<exists>X \<subseteq> UU. ordertype X pair_less = \<omega>\<up>2 \<and> f ` [X]\<^bsup>2\<^esup> \<subseteq> {0}"
   let ?P1 = "\<exists>M \<subseteq> UU. ordertype M pair_less = \<alpha> \<and> f ` [M]\<^bsup>2\<^esup> \<subseteq> {1}"
   have \<dagger>: "?P0 \<or> ?P1"
   proof (rule disjCI)
     assume "\<not> ?P1"
     then have not1: "\<And>M. \<lbrakk>M \<subseteq> UU; ordertype M pair_less = \<alpha>\<rbrakk> \<Longrightarrow> \<exists>x\<in>[M]\<^bsup>2\<^esup>. f x \<noteq> Suc 0" 
       by auto
     obtain m where m: "\<alpha> = ord_of_nat m"
       using assms elts_\<omega> by auto
     then have f_eq_0: "M \<in> [UU]\<^bsup>m\<^esup> \<Longrightarrow> \<exists>x\<in>[M]\<^bsup>2\<^esup>. f x = 0" for M
       using not1 [of M] finite_ordertype_eq_card [of M pair_less m] f
       apply (clarsimp simp: nsets_def eval_nat_numeral Pi_def)
-      by (meson less_Suc0 not_less_less_Suc_eq subset_trans)
+      by (metis less_Suc0 less_antisym order.trans finite_subset)
     obtain N js where "infinite N" and N: "\<And>k u. \<lbrakk>k < 4; u \<in> [UU]\<^bsup>2\<^esup>; form u k; scheme u \<subseteq> N\<rbrakk> \<Longrightarrow> f u = js!k"
       using f lemma_2_3 by blast
     obtain M0 where M0: "M0 \<in> [UU]\<^bsup>m\<^esup>" "\<And>u. u \<in> [M0]\<^bsup>2\<^esup> \<Longrightarrow> form u 0" "\<And>u. u \<in> [M0]\<^bsup>2\<^esup> \<Longrightarrow> scheme u \<subseteq> N"
       by (rule lemma_2_4 [OF \<open>infinite N\<close>]) auto
     obtain M1 where M1: "M1 \<in> [UU]\<^bsup>m\<^esup>" "\<And>u. u \<in> [M1]\<^bsup>2\<^esup> \<Longrightarrow> form u 1" "\<And>u. u \<in> [M1]\<^bsup>2\<^esup> \<Longrightarrow> scheme u \<subseteq> N"
       by (rule lemma_2_4 [OF \<open>infinite N\<close>]) auto
     obtain M2 where M2: "M2 \<in> [UU]\<^bsup>m\<^esup>" "\<And>u. u \<in> [M2]\<^bsup>2\<^esup> \<Longrightarrow> form u 2" "\<And>u. u \<in> [M2]\<^bsup>2\<^esup> \<Longrightarrow> scheme u \<subseteq> N"
       by (rule lemma_2_4 [OF \<open>infinite N\<close>]) auto
     obtain M3 where M3: "M3 \<in> [UU]\<^bsup>m\<^esup>" "\<And>u. u \<in> [M3]\<^bsup>2\<^esup> \<Longrightarrow> form u 3" "\<And>u. u \<in> [M3]\<^bsup>2\<^esup> \<Longrightarrow> scheme u \<subseteq> N"
       by (rule lemma_2_4 [OF \<open>infinite N\<close>]) auto
     have "js!0 = 0"
       using N [of 0 ] M0 f_eq_0 [of M0] by (force simp: nsets_def eval_nat_numeral)
     moreover have "js!1 = 0"
       using N [of 1] M1 f_eq_0 [of M1] by (force simp: nsets_def eval_nat_numeral)
     moreover have "js!2 = 0"
       using N [of 2 ] M2 f_eq_0 [of M2] by (force simp: nsets_def eval_nat_numeral)
     moreover have "js!3 = 0"
       using N [of 3 ] M3 f_eq_0 [of M3] by (force simp: nsets_def eval_nat_numeral)
     ultimately have js0: "js!k = 0" if "k < 4" for k
       using that by (auto simp: eval_nat_numeral less_Suc_eq)
     obtain X where "X \<subseteq> UU" and otX: "ordertype X pair_less = \<omega>\<up>2"
       and X: "\<And>u. u \<in> [X]\<^bsup>2\<^esup> \<Longrightarrow> (\<exists>k<4. form u k) \<and> scheme u \<subseteq> N"
       using \<open>infinite N\<close> lemma_2_5 by auto
     moreover have "f ` [X]\<^bsup>2\<^esup> \<subseteq> {0}"
     proof (clarsimp simp: image_subset_iff)
       fix u
       assume u: "u \<in> [X]\<^bsup>2\<^esup>"
       then have u_UU2: "u \<in> [UU]\<^bsup>2\<^esup>"
         using \<open>X \<subseteq> UU\<close> nsets_mono by blast
       show "f u = 0"
         using X u N [OF _ u_UU2] js0 by auto
     qed
     ultimately show "\<exists>X \<subseteq> UU. ordertype X pair_less = \<omega>\<up>2 \<and> f ` [X]\<^bsup>2\<^esup> \<subseteq> {0}"
       by blast
   qed
   then show "\<exists>i<Suc (Suc 0). \<exists>H\<subseteq>UU. ordertype H pair_less = [\<omega>\<up>2, \<alpha>] ! i \<and> f ` [H]\<^bsup>2\<^esup> \<subseteq> {i}"
   proof 
     show "?P0 \<Longrightarrow> ?thesis"
       by (metis nth_Cons_0 numeral_2_eq_2 pos2)
     show "?P1 \<Longrightarrow> ?thesis"
       by (metis One_nat_def lessI nth_Cons_0 nth_Cons_Suc)
   qed
 qed
 
 theorem Specker: "\<alpha> \<in> elts \<omega> \<Longrightarrow> partn_lst_VWF (\<omega>\<up>2) [\<omega>\<up>2,\<alpha>] 2"
   using partn_lst_imp_partn_lst_VWF_eq [OF Specker_aux] ordertype_UU_\<omega>2 wf_pair_less by blast
 
 end
diff --git a/thys/Rep_Fin_Groups/Rep_Fin_Groups.thy b/thys/Rep_Fin_Groups/Rep_Fin_Groups.thy
--- a/thys/Rep_Fin_Groups/Rep_Fin_Groups.thy
+++ b/thys/Rep_Fin_Groups/Rep_Fin_Groups.thy
@@ -1,9513 +1,9513 @@
 theory Rep_Fin_Groups
 
 imports
   "HOL-Library.Function_Algebras"
   "HOL-Library.Set_Algebras"
   "HOL-Computational_Algebra.Polynomial"
 
 begin
 
 
 
 
 section \<open>Preliminaries\<close>
 
 text \<open>
   In this section, we establish some basic facts about logic, sets, and functions that are not
   available in the HOL library. As well, we develop some theory for almost-everywhere-zero functions
   in preparation of the definition of the group ring.
 \<close>
 
 
 subsection \<open>Logic\<close>
 
 lemma conjcases [case_names BothTrue OneTrue OtherTrue BothFalse] :
   assumes BothTrue: "P \<and> Q    \<Longrightarrow> R"
   and     OneTrue:   "P \<and> \<not>Q  \<Longrightarrow> R"
   and     OtherTrue: "\<not>P \<and> Q  \<Longrightarrow> R"
   and     BothFalse: "\<not>P \<and> \<not>Q \<Longrightarrow> R"
   shows   "R"
   using   assms
   by      fast
 
 
 subsection \<open>Sets\<close>
 
 lemma empty_set_diff_single : "A - {x} = {} \<Longrightarrow> A = {} \<or> A = {x}"
   by auto
 
 lemma seteqI : "(\<And>a. a \<in> A \<Longrightarrow> a \<in> B) \<Longrightarrow> (\<And>b. b \<in> B \<Longrightarrow> b \<in> A) \<Longrightarrow> A = B"
   using subset_antisym subsetI by fast
 
 lemma prod_ballI : "(\<And>a b. (a,b) \<in> AxB \<Longrightarrow> P a b) \<Longrightarrow> \<forall>(a,b)\<in>AxB. P a b"
   by fast
 
 lemma good_card_imp_finite : "of_nat (card A) \<noteq> (0::'a::semiring_1) \<Longrightarrow> finite A"
   using card_ge_0_finite[of A] by fastforce
 
 subsection \<open>Lists\<close>
 
 subsubsection \<open>\<open>zip\<close>\<close>
 
 lemma zip_truncate_left : "zip xs ys = zip (take (length ys) xs) ys"
   by (induct xs ys rule:list_induct2') auto
 
 lemma zip_truncate_right : "zip xs ys = zip xs (take (length xs) ys)"
   by (induct xs ys rule:list_induct2') auto
 
 text \<open>
   Lemmas \<open>zip_append1\<close> and \<open>zip_append2\<close> in theory @{theory HOL.List} have unnecessary
   \<open>take (length _)\<close> in them. Here are replacements.
 \<close>
 
 lemma zip_append_left :
   "zip (xs@ys) zs = zip xs zs @ zip ys (drop (length xs) zs)"
   using zip_append1 zip_truncate_right[of xs zs] by simp
 
 lemma zip_append_right :
   "zip xs (ys@zs) = zip xs ys @ zip (drop (length ys) xs) zs"
   using zip_append2 zip_truncate_left[of xs ys] by simp
 
 lemma length_concat_map_split_zip :
   "length [f x y. (x,y)\<leftarrow>zip xs ys] = min (length xs) (length ys)"
   by (induct xs ys rule: list_induct2') auto
 
 lemma concat_map_split_eq_map_split_zip :
   "[f x y. (x,y)\<leftarrow>zip xs ys] = map (case_prod f) (zip xs ys)"
   by (induct xs ys rule: list_induct2') auto
 
 lemma set_zip_map2 :
   "(a,z) \<in> set (zip xs (map f ys)) \<Longrightarrow> \<exists>b. (a,b) \<in> set (zip xs ys) \<and> z = f b"
   by (induct xs ys rule: list_induct2') auto
 
 subsubsection \<open>\<open>concat\<close>\<close>
 
 lemma concat_eq :
   "list_all2 (\<lambda>xs ys. length xs = length ys) xss yss \<Longrightarrow> concat xss = concat yss
         \<Longrightarrow> xss = yss"
   by  (induct xss yss rule: list_all2_induct) auto
 
 lemma match_concat :
   fixes   bss :: "'b list list"
   defines eq_len: "eq_len \<equiv> \<lambda>xs ys. length xs = length ys"
   shows   "\<forall>as::'a list. length as = length (concat bss)
                 \<longrightarrow> (\<exists>css::'a list list. as = concat css \<and> list_all2 eq_len css bss)"
 proof (induct bss)
   from eq_len
     show "\<forall>as. length as = length (concat [])
                 \<longrightarrow> (\<exists>css. as = concat css \<and> list_all2 eq_len css [])"
     by   simp
 next
   fix fs :: "'b list" and fss :: "'b list list"
   assume prevcase: "\<forall>as. length as = length (concat fss)
                          \<longrightarrow> (\<exists>css. as = concat css \<and> list_all2 eq_len css fss)"
   have "\<And>as. length as = length (concat (fs # fss))
              \<Longrightarrow> (\<exists>css. as = concat css \<and> list_all2 eq_len css (fs # fss))"
   proof
     fix as :: "'a list"
     assume as: "length as = length (concat (fs#fss))"
     define xs ys where "xs = take (length fs) as" and "ys = drop (length fs) as"
     define gss where "gss = (SOME css. ys = concat css \<and> list_all2 eq_len css fss)"
     define hss where "hss = xs # gss"
     with xs_def ys_def as gss_def eq_len prevcase
       show "as = concat hss \<and> list_all2 eq_len hss (fs#fss)"
       using someI_ex[of "\<lambda>css. ys = concat css \<and> list_all2 eq_len css fss"] by auto
   qed
   thus "\<forall>as. length as = length (concat (fs # fss))
              \<longrightarrow> (\<exists>css. as = concat css \<and> list_all2 eq_len css (fs # fss))"
     by fast
 qed 
 
 subsubsection \<open>\<open>strip_while\<close>\<close>
 
 lemma strip_while_0_nnil :
   "as \<noteq> [] \<Longrightarrow> set as \<noteq> 0 \<Longrightarrow> strip_while ((=) 0) as \<noteq> []"
   by (induct as rule: rev_nonempty_induct) auto
 
 subsubsection \<open>\<open>sum_list\<close>\<close>
 
 lemma const_sum_list :
   "\<forall>x \<in> set xs. f x = a \<Longrightarrow> sum_list (map f xs) = a * (length xs)"
   by (induct xs) auto
 
 lemma sum_list_prod_cong :
   "\<forall>(x,y) \<in> set xys. f x y = g x y
         \<Longrightarrow> (\<Sum>(x,y)\<leftarrow>xys. f x y) = (\<Sum>(x,y)\<leftarrow>xys. g x y)"
   using arg_cong[of "map (case_prod f) xys" "map (case_prod g) xys" sum_list] by fastforce
 
 lemma sum_list_prod_map2 :
   "(\<Sum>(a,y)\<leftarrow>zip as (map f bs). g a y) = (\<Sum>(a,b)\<leftarrow>zip as bs. g a (f b))"
   by (induct as bs rule: list_induct2') auto
 
 lemma sum_list_fun_apply : "(\<Sum>x\<leftarrow>xs. f x) y = (\<Sum>x\<leftarrow>xs. f x y)"
   by (induct xs) auto
 
 lemma sum_list_prod_fun_apply : "(\<Sum>(x,y)\<leftarrow>xys. f x y) z = (\<Sum>(x,y)\<leftarrow>xys. f x y z)"
   by (induct xys) auto
 
 lemma (in comm_monoid_add) sum_list_plus :
   "length xs = length ys
         \<Longrightarrow> sum_list xs + sum_list ys = sum_list [a+b. (a,b)\<leftarrow>zip xs ys]"
 proof (induct xs ys rule: list_induct2)
   case Cons thus ?case by (simp add: algebra_simps)
 qed simp
 
 lemma sum_list_const_mult_prod :
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'r::semiring_0"
   shows "r * (\<Sum>(x,y)\<leftarrow>xys. f x y) = (\<Sum>(x,y)\<leftarrow>xys. r * (f x y))"
   using sum_list_const_mult[of r "case_prod f"] prod.case_distrib[of "\<lambda>x. r*x" f]
   by    simp
 
 lemma sum_list_mult_const_prod :
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'r::semiring_0"
   shows "(\<Sum>(x,y)\<leftarrow>xys. f x y) * r = (\<Sum>(x,y)\<leftarrow>xys. (f x y) * r)"
   using sum_list_mult_const[of "case_prod f" r] prod.case_distrib[of "\<lambda>x. x*r" f]
   by    simp
 
 lemma sum_list_update :
   fixes xs :: "'a::ab_group_add list"
   shows "n < length xs \<Longrightarrow> sum_list (xs[n := y]) = sum_list xs - xs!n + y"
 proof (induct xs arbitrary: n)
   case Cons thus ?case by (cases n) auto
 qed simp
 
 lemma sum_list_replicate0 : "sum_list (replicate n 0) = 0"
   by (induct n) auto
 
 subsubsection \<open>\<open>listset\<close>\<close>
 
 lemma listset_ConsI : "x \<in> X \<Longrightarrow> xs \<in> listset Xs \<Longrightarrow> x#xs \<in> listset (X#Xs)"
   unfolding listset_def set_Cons_def by simp
 
 lemma listset_ConsD : "x#xs \<in> listset (A # As) \<Longrightarrow> x \<in> A \<and> xs \<in> listset As"
   unfolding listset_def set_Cons_def by auto
 
 lemma listset_Cons_conv :
   "xs \<in> listset (A # As) \<Longrightarrow> (\<exists>y ys. y \<in> A \<and> ys \<in> listset As \<and> xs = y#ys)"
   unfolding listset_def set_Cons_def by auto
 
 lemma listset_length : "xs \<in> listset Xs \<Longrightarrow> length xs = length Xs"
   using     listset_ConsD
   unfolding listset_def set_Cons_def
   by        (induct xs Xs rule: list_induct2') auto
 
 lemma set_sum_list_element :
   "x \<in> (\<Sum>A\<leftarrow>As. A) \<Longrightarrow> \<exists>as \<in> listset As. x = (\<Sum>a\<leftarrow>as. a)"
 proof (induct As arbitrary: x)
   case Nil hence "x = (\<Sum>a\<leftarrow>[]. a)" by simp
   moreover have "[] \<in> listset []" by simp
   ultimately show ?case by fast
 next
   case (Cons A As)
   from this obtain a as
     where a_as: "a \<in> A" "as \<in> listset As" "x = (\<Sum>b\<leftarrow>(a#as). b)"
     using set_plus_def[of A]
     by    fastforce
   have "listset (A#As) = set_Cons A (listset As)" by simp
   with a_as(1,2) have "a#as \<in> listset (A#As)" unfolding set_Cons_def by fast
   with a_as(3) show "\<exists>bs\<in>listset (A#As). x = (\<Sum>b\<leftarrow>bs. b)" by fast
 qed
 
 lemma set_sum_list_element_Cons :
   assumes "x \<in> (\<Sum>X\<leftarrow>(A#As). X)"
   shows   "\<exists>a as. a\<in>A \<and> as \<in> listset As \<and> x = a + (\<Sum>b\<leftarrow>as. b)"
 proof-
   from assms obtain xs where xs: "xs \<in> listset (A#As)" "x = (\<Sum>b\<leftarrow>xs. b)"
     using set_sum_list_element by fast
   from xs(1) obtain a as where "a \<in> A" "as \<in> listset As" "xs = a # as"
     using listset_Cons_conv by fast
   with xs(2) show ?thesis by auto
 qed
 
 lemma sum_list_listset : "as \<in> listset As \<Longrightarrow> sum_list as \<in> (\<Sum>A\<leftarrow>As. A)"
 proof-
   have "length as = length As \<Longrightarrow> as \<in> listset As \<Longrightarrow> sum_list as \<in> (\<Sum>A\<leftarrow>As. A)"
   proof (induct as As rule: list_induct2)
     case Nil show ?case by simp
   next
     case (Cons a as A As) thus ?case
       using listset_ConsD[of a] set_plus_def by auto
   qed
   thus "as \<in> listset As \<Longrightarrow> sum_list as \<in> (\<Sum>A\<leftarrow>As. A)" using listset_length by fast
 qed
 
 lemma listsetI_nth :
   "length xs = length Xs \<Longrightarrow> \<forall>n<length xs. xs!n \<in> Xs!n \<Longrightarrow> xs \<in> listset Xs"
 proof (induct xs Xs rule: list_induct2)
   case Nil show ?case by simp
 next
   case (Cons x xs X Xs) thus "x#xs \<in> listset (X#Xs)"
     using listset_ConsI[of x X xs Xs] by fastforce
 qed
 
 lemma listsetD_nth : "xs \<in> listset Xs \<Longrightarrow> \<forall>n<length xs. xs!n \<in> Xs!n"
 proof-
   have "length xs = length Xs \<Longrightarrow> xs \<in> listset Xs \<Longrightarrow> \<forall>n<length xs. xs!n \<in> Xs!n"
   proof (induct xs Xs rule: list_induct2)
      case Nil show ?case by simp
   next
     case (Cons x xs X Xs)
     from Cons(3) have x_xs: "x \<in> X" "xs \<in> listset Xs"
       using listset_ConsD[of x] by auto
     with Cons(2) have 1: "(x#xs)!0 \<in> (X#Xs)!0" "\<forall>n<length xs. xs!n \<in> Xs!n"
       by auto
     have "\<And>n. n < length (x#xs) \<Longrightarrow> (x#xs)!n \<in> (X#Xs)!n"
     proof-
       fix n assume "n < length (x#xs)"
       with 1 show "(x#xs)!n \<in> (X#Xs)!n" by (cases n) auto
     qed
     thus "\<forall>n < length (x#xs). (x#xs)!n \<in> (X#Xs)!n" by fast
   qed
   thus "xs \<in> listset Xs \<Longrightarrow> \<forall>n<length xs. xs!n \<in> Xs!n" using listset_length by fast
 qed
 
 lemma set_listset_el_subset :
   "xs \<in> listset Xs \<Longrightarrow> \<forall>X\<in>set Xs. X \<subseteq> A \<Longrightarrow> set xs \<subseteq> A"
 proof-
   have "\<lbrakk> length xs = length Xs; xs \<in> listset Xs; \<forall>X\<in>set Xs. X \<subseteq> A \<rbrakk> 
               \<Longrightarrow> set xs \<subseteq> A"
   proof (induct xs Xs rule: list_induct2)
     case Cons thus ?case using listset_ConsD by force
   qed simp
   thus "xs \<in> listset Xs \<Longrightarrow> \<forall>X\<in>set Xs. X \<subseteq> A \<Longrightarrow> set xs \<subseteq> A"
     using listset_length by fast
 qed
 
 
 subsection \<open>Functions\<close>
 
 subsubsection \<open>Miscellaneous facts\<close>
 
 lemma sum_fun_apply : "finite A \<Longrightarrow> (\<Sum>a\<in>A. f a) x = (\<Sum>a\<in>A. f a x)"
   by (induct set: finite) auto
 
 lemma sum_single_nonzero :
   "finite A \<Longrightarrow> (\<forall>x\<in>A. \<forall>y\<in>A. f x y = (if y = x then g x else 0)) 
         \<Longrightarrow> (\<forall>x\<in>A. sum (f x) A = g x)"
 proof (induct A rule: finite_induct)
   case (insert a A)
   show "\<forall>x\<in>insert a A. sum (f x) (insert a A) = g x"
   proof
     fix x assume x: "x \<in> insert a A"
     show "sum (f x) (insert a A) = g x"
     proof (cases "x = a")
       case True
       moreover with insert(2,4) have "\<forall>y\<in>A. f x y = 0" by simp
       ultimately show ?thesis using insert(1,2,4) by simp
     next
       case False with x insert show ?thesis by simp
     qed
   qed
 qed simp
 
 lemma distrib_comp_sum_right : "(T + T') \<circ> S = (T \<circ> S) + (T' \<circ> S)"
   by auto
 
 subsubsection \<open>Support of a function\<close>
 
 definition supp :: "('a \<Rightarrow> 'b::zero) \<Rightarrow> 'a set" where "supp f = {x. f x \<noteq> 0}"
 
 lemma suppI: "f x \<noteq> 0 \<Longrightarrow> x \<in> supp f"
   using supp_def by fast
 
 lemma suppI_contra: "x \<notin> supp f \<Longrightarrow> f x = 0"
   using suppI by fast
 
 lemma suppD: "x \<in> supp f \<Longrightarrow> f x \<noteq> 0"
   using supp_def by fast
 
 lemma suppD_contra: "f x = 0 \<Longrightarrow> x \<notin> supp f"
   using suppD by fast
 
 lemma zerofun_imp_empty_supp : "supp 0 = {}"
   unfolding supp_def by simp
 
 lemma supp_zerofun_subset_any : "supp 0 \<subseteq> A"
   using zerofun_imp_empty_supp by fast
 
 lemma supp_sum_subset_union_supp :
   fixes     f g :: "'a \<Rightarrow> 'b::monoid_add"
   shows     "supp (f + g) \<subseteq> supp f \<union> supp g"
   unfolding supp_def
   by        auto
 
 lemma supp_neg_eq_supp :
   fixes     f :: "'a \<Rightarrow> 'b::group_add"
   shows     "supp (- f) = supp f"
   unfolding supp_def
   by        auto
 
 lemma supp_diff_subset_union_supp :
   fixes     f g :: "'a \<Rightarrow> 'b::group_add"
   shows     "supp (f - g) \<subseteq> supp f \<union> supp g"
   unfolding supp_def
   by        auto
 
 abbreviation restrict0 :: "('a\<Rightarrow>'b::zero) \<Rightarrow> 'a set \<Rightarrow> ('a\<Rightarrow>'b)" (infix "\<down>" 70)
   where "restrict0 f A \<equiv> (\<lambda>a. if a \<in> A then f a else 0)"
 
 lemma supp_restrict0 : "supp (f\<down>A) \<subseteq> A"
 proof-
   have "\<And>a. a \<notin> A \<Longrightarrow> a \<notin> supp (f\<down>A)" using suppD_contra[of "f\<down>A"] by simp
   thus ?thesis by fast
 qed
 
 lemma bij_betw_restrict0 : "bij_betw f A B \<Longrightarrow> bij_betw (f \<down> A) A B"
   using     bij_betw_imp_inj_on bij_betw_imp_surj_on
   unfolding bij_betw_def inj_on_def
   by        auto
 
 
 subsubsection \<open>Convolution\<close>
 
 definition convolution ::
   "('a::group_add \<Rightarrow> 'b::{comm_monoid_add,times}) \<Rightarrow> ('a\<Rightarrow>'b) \<Rightarrow> ('a\<Rightarrow>'b)"
   where "convolution f g
               = (\<lambda>x. \<Sum>y|x - y \<in> supp f \<and> y \<in> supp g. (f (x - y)) * g y)"
   \<comment> \<open>More often than not, this definition will be used in the case that @{text "'b"} is of class
         @{text "mult_zero"}, in which case the conditions @{term "x - y \<in> supp f"} and
         @{term "y \<in> supp g"} are obviously mathematically unnecessary. However, they also serve to
         ensure that the sum is taken over a finite set in the case that at least one of @{term f}
         and @{term g} is almost everywhere zero.\<close>
 
 lemma convolution_zero :
   fixes     f g :: "'a::group_add \<Rightarrow> 'b::{comm_monoid_add,mult_zero}"
   shows     "f = 0 \<or> g = 0 \<Longrightarrow> convolution f g = 0"
   unfolding convolution_def
   by        auto
 
 lemma convolution_symm :
   fixes f g :: "'a::group_add \<Rightarrow> 'b::{comm_monoid_add,times}"
   shows "convolution f g
               = (\<lambda>x. \<Sum>y|y \<in> supp f \<and> -y + x \<in> supp g. (f y) * g (-y + x))"
 proof
   fix x::'a
   define c1 c2 i S1 S2
     where "c1 y = (f (x - y)) * g y"
       and "c2 y = (f y) * g (-y + x)"
       and "i y = -y + x"
       and "S1 = {y. x - y \<in> supp f \<and> y \<in> supp g}"
       and "S2 = {y. y \<in> supp f \<and> -y + x \<in> supp g}"
     for y
   have "inj_on i S2" unfolding inj_on_def using i_def by simp
   hence "(\<Sum>y\<in>(i ` S2). c1 y) = (\<Sum>y\<in>S2. (c1 \<circ> i) y)"
     using sum.reindex by fast
   moreover have S1_iS2: "S1 = i ` S2"
   proof (rule seteqI)
     fix y assume y_S1: "y \<in> S1"
     define z where "z = x - y"
     hence y_eq: "-z + x = y" by (auto simp add: algebra_simps)
     hence "-z + x \<in> supp g" using y_S1 S1_def by fast
     moreover have "z \<in> supp f" using z_def y_S1 S1_def by fast
     ultimately have "z \<in> S2" using S2_def by fast
     moreover have "y = i z" using i_def [abs_def] y_eq by fast
     ultimately show "y \<in> i ` S2" by fast
   next
     fix y assume "y \<in> i ` S2"
     from this obtain z where z_S2: "z \<in> S2" and y_eq: "y = -z + x"
       using i_def by fast
     from y_eq have "x - y = z" by (auto simp add: algebra_simps)
     hence "x - y \<in> supp f \<and> y \<in> supp g" using y_eq z_S2 S2_def by fastforce
     thus "y \<in> S1" using S1_def by fast
   qed
   ultimately have "(\<Sum>y\<in>S1. c1 y) = (\<Sum>y\<in>S2. (c1 \<circ> i) y)" by fast
   with i_def c1_def c2_def have "(\<Sum>y\<in>S1. c1 y) = (\<Sum>y\<in>S2. c2 y)"
     using diff_add_eq_diff_diff_swap[of x _ x] by simp
   thus "convolution f g x
               = (\<Sum>y|y \<in> supp f \<and> -y + x \<in> supp g. (f y) * g (-y + x))"
     unfolding S1_def c1_def S2_def c2_def convolution_def by fast
 qed  
 
 lemma supp_convolution_subset_sum_supp :
   fixes f g :: "'a::group_add \<Rightarrow> 'b::{comm_monoid_add,times}"
   shows "supp (convolution f g) \<subseteq> supp f + supp g"
 proof-
   define SS where "SS x = {y. x-y \<in> supp f \<and> y \<in> supp g}" for x
   have "convolution f g = (\<lambda>x. sum (\<lambda>y. (f (x - y)) * g y) (SS x))"
     unfolding SS_def convolution_def by fast
   moreover have "\<And>x. x \<notin> supp f + supp g \<Longrightarrow> SS x = {}"
   proof-
     have "\<And>x. SS x \<noteq> {} \<Longrightarrow> x \<in> supp f + supp g"
     proof-
       fix x::'a assume "SS x \<noteq> {}"
       from this obtain y where "x - y \<in> supp f" and y_G: "y \<in> supp g"
         using SS_def by fast
       from this obtain z where z_F: "z \<in> supp f" and z_eq: "x - y = z" by fast
       from z_eq have "x = z + y" using diff_eq_eq by fast
       with z_F y_G show "x \<in> supp f + supp g" by fast
     qed
     thus "\<And>x. x \<notin> supp f + supp g \<Longrightarrow> SS x = {}" by fast
   qed
   ultimately have "\<And>x. x \<notin> supp f + supp g
                         \<Longrightarrow> convolution f g x = sum (\<lambda>y. (f (x - y)) * g y) {}"
     by simp
   hence "\<And>x. x \<notin> supp f + supp g \<Longrightarrow> convolution f g x = 0"
     using sum.empty by simp
   thus ?thesis unfolding supp_def by fast
 qed
 
 
 subsection \<open>Almost-everywhere-zero functions\<close>
 
 subsubsection \<open>Definition and basic properties\<close>
 
 definition "aezfun_set = {f::'a\<Rightarrow>'b::zero. finite (supp f)}"
 
 lemma aezfun_setD: "f \<in> aezfun_set \<Longrightarrow> finite (supp f)"
   unfolding aezfun_set_def by fast
 
 lemma aezfun_setI: "finite (supp f) \<Longrightarrow> f \<in> aezfun_set"
   unfolding aezfun_set_def by fast
 
 lemma zerofun_is_aezfun : "0 \<in> aezfun_set"
   unfolding supp_def aezfun_set_def by auto
 
 lemma sum_of_aezfun_is_aezfun :
   fixes     f g :: "'a\<Rightarrow>'b::monoid_add"
   shows     "f \<in> aezfun_set \<Longrightarrow> g \<in> aezfun_set \<Longrightarrow> f + g \<in> aezfun_set"
   using     supp_sum_subset_union_supp[of f g] finite_subset[of _ "supp f \<union> supp g"]
   unfolding aezfun_set_def
   by        fastforce
 
 lemma neg_of_aezfun_is_aezfun :
   fixes     f :: "'a\<Rightarrow>'b::group_add"
   shows     "f \<in> aezfun_set \<Longrightarrow> - f \<in> aezfun_set"
   using     supp_neg_eq_supp[of f]
   unfolding aezfun_set_def
   by        simp
 
 lemma diff_of_aezfun_is_aezfun :
   fixes     f g :: "'a\<Rightarrow>'b::group_add"
   shows     "f \<in> aezfun_set \<Longrightarrow> g \<in> aezfun_set \<Longrightarrow> f - g \<in> aezfun_set"
   using     supp_diff_subset_union_supp[of f g] finite_subset[of _ "supp f \<union> supp g"]
   unfolding aezfun_set_def
   by        fastforce
 
 lemma restrict_and_extend0_aezfun_is_aezfun :
   assumes "f \<in> aezfun_set"
   shows   "f\<down>A \<in> aezfun_set"
 proof (rule aezfun_setI)
   have "\<And>a. a \<notin> supp f \<inter> A \<Longrightarrow> a \<notin> supp (f\<down>A)"
   proof-
     fix a assume "a \<notin> supp f \<inter> A"
     thus "a \<notin> supp (f\<down>A)" using suppI_contra[of a] suppD_contra[of "f\<down>A" a]
       by (cases "a \<in> A") auto
   qed
   with assms show "finite (supp (f\<down>A))"
-    using aezfun_setD finite_subset[of "supp (f\<down>A)"] by auto
+    using aezfun_setD finite_subset[of "supp (f\<down>A)"] by blast
 qed
 
 subsubsection \<open>Delta (impulse) functions\<close>
 
 text \<open>The notation is set up in the order output-input so that later when these are used to define
         the group ring RG, it will be in order ring-element-group-element.\<close>
 
 definition deltafun :: "'b::zero \<Rightarrow> 'a \<Rightarrow> ('a \<Rightarrow> 'b)" (infix "\<delta>" 70)
   where "b \<delta> a = (\<lambda>x. if x = a then b else 0)"
 
 lemma deltafun_apply_eq : "(b \<delta> a) a = b"
   unfolding deltafun_def by simp
 
 lemma deltafun_apply_neq : "x \<noteq> a \<Longrightarrow> (b \<delta> a) x = 0"
   unfolding deltafun_def by simp
 
 lemma deltafun0 : "0 \<delta> a = 0"
   unfolding deltafun_def by auto
 
 lemma deltafun_plus :
   fixes     b c :: "'b::monoid_add"
   shows     "(b+c) \<delta> a = (b \<delta> a) + (c \<delta> a)"
   unfolding deltafun_def
   by        auto
 
 lemma supp_delta0fun :  "supp (0 \<delta> a) = {}"
   unfolding supp_def deltafun_def by simp
 
 lemma supp_deltafun :  "b \<noteq> 0 \<Longrightarrow> supp (b \<delta> a) = {a}"
   unfolding supp_def deltafun_def by simp
 
 lemma deltafun_is_aezfun : "b \<delta> a \<in> aezfun_set"
 proof (cases "b = 0")
   case True
   hence "supp (b \<delta> a) = {}" using supp_delta0fun[of a] by fast
   thus ?thesis unfolding aezfun_set_def by simp
 next
   case False thus ?thesis using supp_deltafun[of b a] unfolding aezfun_set_def by simp
 qed
 
 lemma aezfun_common_supp_spanning_set' :
   "finite A \<Longrightarrow> \<exists>as. distinct as \<and> set as = A
       \<and> ( \<forall>f::'a \<Rightarrow> 'b::semiring_1. supp f \<subseteq> A
                    \<longrightarrow> (\<exists>bs. length bs = length as \<and> f = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta> a)) )"
 proof (induct rule: finite_induct)
   case empty show ?case unfolding supp_def by auto
 next
   case (insert a A)
   from insert(3) obtain as
     where as: "distinct as" "set as = A"
               "\<And>f::'a \<Rightarrow> 'b. supp f \<subseteq> A
                     \<Longrightarrow> \<exists>bs. length bs = length as \<and> f = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta> a)"
     by fast
   from as(1,2) insert(2) have "distinct (a#as)" "set (a#as) = insert a A" by auto
   moreover
     have "\<And>f::'a \<Rightarrow> 'b::semiring_1. supp f \<subseteq> insert a A
                 \<Longrightarrow> (\<exists>bs. length bs = length (a#as)
                   \<and> f = (\<Sum>(b,a)\<leftarrow>zip bs (a#as). b \<delta> a))"
   proof-
     fix f :: "'a \<Rightarrow> 'b" assume supp_f : "supp f \<subseteq> insert a A"
     define g where "g x = (if x = a then 0 else f x)" for x
     have "supp g \<subseteq> A"
     proof
       fix x assume x: "x \<in> supp g"
       with x supp_f g_def have "x \<in> insert a A" unfolding supp_def by auto
       moreover from x g_def have "x \<noteq> a" unfolding supp_def by auto
       ultimately show "x \<in> A" by fast
     qed
     with as(3) obtain bs
       where bs: "length bs = length as" "g = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta> a)"
       by    fast
     from bs(1) have "length ((f a) # bs) = length (a#as)" by auto
     moreover from g_def bs(2) have "f = (\<Sum>(b,a)\<leftarrow>zip ((f a) # bs) (a#as). b \<delta> a)"
       using deltafun_apply_eq[of "f a" a] deltafun_apply_neq[of _ a "f a"] by (cases) auto
     ultimately
       show "\<exists>bs. length bs = length (a#as) \<and> f = (\<Sum>(b,a)\<leftarrow>zip bs (a#as). b \<delta> a)"
       by   fast
   qed
   ultimately show ?case by fast
 qed
 
 subsubsection \<open>Convolution of almost-everywhere-zero functions\<close>
 
 lemma convolution_eq_sum_over_supp_right :
   fixes   g f :: "'a::group_add \<Rightarrow> 'b::{comm_monoid_add,mult_zero}"
   assumes "g \<in> aezfun_set"
   shows   "convolution f g = (\<lambda>x. \<Sum>y\<in>supp g. (f (x - y)) * g y )"
 proof
   fix x::'a
   define SS where "SS = {y. x - y \<in> supp f \<and> y \<in> supp g}"
   have "finite (supp g)" using assms unfolding aezfun_set_def by fast
   moreover have "SS \<subseteq> supp g" unfolding SS_def by fast
   moreover have "\<And>y. y \<in> supp g - SS \<Longrightarrow> (f (x - y)) * g y = 0" using SS_def unfolding supp_def by auto
   ultimately show "convolution f g x = (\<Sum>y\<in>supp g. (f (x - y)) * g y )"
     unfolding convolution_def
     using     SS_def sum.mono_neutral_left[of "supp g" SS "\<lambda>y. (f (x - y)) * g y"]
     by        fast
 qed
 
 lemma convolution_symm_eq_sum_over_supp_left :
   fixes   f g :: "'a::group_add \<Rightarrow> 'b::{comm_monoid_add,mult_zero}"
   assumes "f \<in> aezfun_set"
   shows   "convolution f g = (\<lambda>x. \<Sum>y\<in>supp f. (f y) * g (-y + x))"
 proof
   fix x::'a
   define SS where "SS = {y. y \<in> supp f \<and> -y + x \<in> supp g}"
   have "finite (supp f)" using assms unfolding aezfun_set_def by fast
   moreover have "SS \<subseteq> supp f" using SS_def by fast
   moreover have "\<And>y. y \<in> supp f - SS \<Longrightarrow> (f y) * g (-y + x) = 0"
     using SS_def unfolding supp_def by auto
   ultimately
     have "(\<Sum>y\<in>SS. (f y) * g (-y + x)) = (\<Sum>y\<in>supp f. (f y) * g (-y + x) )"
     unfolding convolution_def
     using     SS_def sum.mono_neutral_left[of "supp f" SS "\<lambda>y. (f y) * g (-y + x)"]
     by        fast
   thus "convolution f g x = (\<Sum>y\<in>supp f. (f y) * g (-y + x) )"
     using SS_def convolution_symm[of f g] by simp
 qed
 
 lemma convolution_delta_left :
   fixes b :: "'b::{comm_monoid_add,mult_zero}"
   and   a :: "'a::group_add"
   and   f :: "'a \<Rightarrow> 'b"
   shows "convolution (b \<delta> a) f = (\<lambda>x. b * f (-a + x))"
 proof (cases "b = 0")
   case True
   moreover have "convolution (b \<delta> a) f = 0"
   proof-
     from True have "convolution (b \<delta> a) f = convolution 0 f"
       using deltafun0[of a] arg_cong[of "0 \<delta> a" "0::'a\<Rightarrow>'b"]
       by (simp add: \<open>0 \<delta> a = 0\<close> \<open>b = 0\<close>)
     thus ?thesis using convolution_zero by auto
   qed
   ultimately show ?thesis by auto
 next
   case False thus ?thesis
     using deltafun_is_aezfun[of b a] convolution_symm_eq_sum_over_supp_left
           supp_deltafun[of b a] deltafun_apply_eq[of b a]
     by    fastforce
 qed
 
 lemma convolution_delta_right :
   fixes b :: "'b::{comm_monoid_add,mult_zero}"
   and   f :: "'a::group_add \<Rightarrow> 'b" and a::'a
   shows "convolution f (b \<delta> a) = (\<lambda>x. f (x - a) * b)"
 proof (cases "b = 0")
   case True
   moreover have "convolution f (b \<delta> a) = 0"
   proof-
     from True have "convolution f (b \<delta> a) = convolution f 0"
       using deltafun0[of a] arg_cong[of "0 \<delta> a" "0::'a\<Rightarrow>'b"] 
       by (simp add: \<open>0 \<delta> a = 0\<close>)
     thus ?thesis using convolution_zero by auto
   qed
   ultimately show ?thesis by auto
 next
   case False thus ?thesis
     using deltafun_is_aezfun[of b a] convolution_eq_sum_over_supp_right
           supp_deltafun[of b a] deltafun_apply_eq[of b a]
     by    fastforce
 qed
 
 lemma   convolution_delta_delta :
   fixes b1 b2 :: "'b::{comm_monoid_add,mult_zero}"
   and   a1 a2 :: "'a::group_add"
   shows "convolution (b1 \<delta> a1) (b2 \<delta> a2) = (b1 * b2) \<delta> (a1 + a2)"
 proof
   fix x::'a
   have 1: "convolution (b1 \<delta> a1) (b2 \<delta> a2) x = (b1 \<delta> a1) (x - a2) * b2"
     using convolution_delta_right[of "b1 \<delta> a1"] by simp
   show "convolution (b1 \<delta> a1) (b2 \<delta> a2) x = ((b1 * b2) \<delta> (a1 + a2)) x"
   proof (cases "x = a1 + a2")
     case True
     hence "x - a2 = a1" by (simp add: algebra_simps)
     with 1 have "convolution (b1 \<delta> a1) (b2 \<delta> a2) x = b1 * b2"
       using deltafun_apply_eq[of b1 a1] by simp
     with True show ?thesis
       using deltafun_apply_eq[of "b1 * b2" "a1 + a2"] by simp
   next
     case False
     hence "x - a2 \<noteq> a1" by (simp add: algebra_simps)
     with 1 have "convolution (b1 \<delta> a1) (b2 \<delta> a2) x = 0"
       using deltafun_apply_neq[of "x - a2" a1 b1] by simp
     with False show ?thesis using deltafun_apply_neq by simp
   qed
 qed
 
 lemma convolution_of_aezfun_is_aezfun :
   fixes     f g :: "'a::group_add \<Rightarrow> 'b::{comm_monoid_add,times}"
   shows     "f \<in> aezfun_set \<Longrightarrow> g \<in> aezfun_set \<Longrightarrow> convolution f g \<in> aezfun_set"
   using     supp_convolution_subset_sum_supp[of f g]
             finite_set_plus[of "supp f" "supp g"] finite_subset
   unfolding aezfun_set_def
   by        fastforce
 
 lemma convolution_assoc :
   fixes   f h g :: "'a::group_add \<Rightarrow> 'b::semiring_0"
   assumes f_aez: "f \<in> aezfun_set" and h_aez: "h \<in> aezfun_set"
   shows   "convolution (convolution f g) h = convolution f (convolution g h)"
 proof
   define fg gh where "fg = convolution f g" and "gh = convolution g h"
   fix x::'a
   have "convolution fg h x
               = (\<Sum>y\<in>supp f. (\<Sum>z\<in>supp h. f y * g (-y + x - z) * h z) )"
   proof-
     have "convolution fg h x = (\<Sum>z\<in>supp h. fg (x - z) * h z )"
       using h_aez convolution_eq_sum_over_supp_right[of h fg] by simp
     moreover have "\<And>z. fg (x - z) * h z
                         = (\<Sum>y\<in>supp f. f y * g (-y + x - z) * h z)"
     proof-
       fix z::'a
       have "fg (x - z) = (\<Sum>y\<in>supp f. f y * g (-y + (x - z)) )"
         using fg_def f_aez convolution_symm_eq_sum_over_supp_left by fastforce
       hence "fg (x - z) * h z = (\<Sum>y\<in>supp f. f y * g (-y + (x - z)) * h z )"
         using sum_distrib_right by simp
       thus "fg (x - z) * h z = (\<Sum>y\<in>supp f. f y * g (-y + x - z) * h z )"
         by (simp add: algebra_simps)
     qed
     ultimately 
       have  "convolution fg h x
                   = (\<Sum>z\<in>supp h. (\<Sum>y\<in>supp f. f y * g (-y + x - z) * h z) )"
       using sum.cong
       by    simp
     thus ?thesis using sum.swap by simp
   qed
   moreover have "convolution f gh x
                       = (\<Sum>y\<in>supp f. (\<Sum>z\<in>supp h. f y * g (-y + x - z) * h z) )"
   proof-
     have "convolution f gh x = (\<Sum>y\<in>supp f. f y * gh (-y + x) )"
       using f_aez convolution_symm_eq_sum_over_supp_left[of f gh] by simp
     moreover have "\<And>y. f y * gh (-y + x)
                         = (\<Sum>z\<in>supp h. f y * g (-y + x - z) * h z)"
     proof-
       fix y::'a
       have triple_cong: "\<And>z. f y * (g (-y + x - z) * h z)
                               = f y * g (-y + x - z) * h z"
         using mult.assoc[of "f y"] by simp
       have "gh (-y + x) = (\<Sum>z\<in>supp h. g (-y + x - z) * h z)"
         using gh_def h_aez convolution_eq_sum_over_supp_right by fastforce
       hence "f y * gh (-y + x) = (\<Sum>z\<in>supp h. f y * (g (-y + x - z) * h z))"
         using sum_distrib_left by simp
       also have "\<dots> = (\<Sum>z\<in>supp h. f y * g (-y + x - z) * h z)"
         using triple_cong sum.cong by simp
       finally
         show "f y * gh (-y + x) = (\<Sum>z\<in>supp h. f y * g (-y + x - z) * h z)"
         by   fast
     qed
     ultimately show ?thesis using sum.cong by simp
   qed
   ultimately show "convolution fg h x = convolution f gh x" by simp
 qed
 
 lemma convolution_distrib_left :
   fixes   g h f :: "'a::group_add \<Rightarrow> 'b::semiring_0"
   assumes "g \<in> aezfun_set" "h \<in> aezfun_set"
   shows   "convolution f (g + h) = convolution f g + convolution f h"
 proof
   define gh GH where "gh = g + h" and "GH = supp g \<union> supp h"
   have fin_GH: "finite GH" using GH_def assms unfolding aezfun_set_def by fast
   have gh_aezfun: "gh \<in> aezfun_set" using gh_def assms sum_of_aezfun_is_aezfun by fast
   fix x::'a
   have zero_ext_g : "\<And>y. y \<in> GH - supp g \<Longrightarrow> (f (x - y)) * g y = 0"
   and  zero_ext_h : "\<And>y. y \<in> GH - supp h \<Longrightarrow> (f (x - y)) * h y = 0"
   and  zero_ext_gh: "\<And>y. y \<in> GH - supp gh \<Longrightarrow> (f (x - y)) * gh y = 0"
     unfolding supp_def by auto
   have "convolution f gh x = (\<Sum>y\<in>supp gh. (f (x - y)) * gh y)"
     using assms gh_aezfun convolution_eq_sum_over_supp_right[of gh f] by simp
   also from gh_def GH_def have "\<dots> = (\<Sum>y\<in>GH. (f (x - y)) * gh y)"
     using fin_GH supp_sum_subset_union_supp zero_ext_gh
           sum.mono_neutral_left[of GH "supp gh" "(\<lambda>y. (f (x - y)) * gh y)"]
     by    fast
   also from gh_def
     have  "\<dots> = (\<Sum>y\<in>GH. (f (x - y)) * g y) + (\<Sum>y\<in>GH. (f (x - y)) * h y)"
     using sum.distrib by (simp add: algebra_simps)
   finally show "convolution f gh x = (convolution f g + convolution f h) x"
     using assms GH_def fin_GH zero_ext_g zero_ext_h
           sum.mono_neutral_right[of GH "supp g" "(\<lambda>y. (f (x - y)) * g y)"]
           sum.mono_neutral_right[of GH "supp h" "(\<lambda>y. (f (x - y)) * h y)"]
           convolution_eq_sum_over_supp_right[of g f]
           convolution_eq_sum_over_supp_right[of h f]
     by    fastforce
 qed
 
 lemma convolution_distrib_right :
   fixes   f g h :: "'a::group_add \<Rightarrow> 'b::semiring_0"
   assumes "f \<in> aezfun_set" "g \<in> aezfun_set"
   shows   "convolution (f + g) h = convolution f h + convolution g h"
 proof
   define fg FG where "fg = f + g" and "FG = supp f \<union> supp g"
   have fin_FG: "finite FG" using FG_def assms unfolding aezfun_set_def by fast
   have fg_aezfun: "fg \<in> aezfun_set" using fg_def assms sum_of_aezfun_is_aezfun by fast
   fix x::'a
   have zero_ext_f : "\<And>y. y \<in> FG - supp f \<Longrightarrow> (f y) * h (-y + x) = 0"
   and  zero_ext_g : "\<And>y. y \<in> FG - supp g \<Longrightarrow> (g y) * h (-y + x) = 0"
   and  zero_ext_fg: "\<And>y. y \<in> FG - supp fg \<Longrightarrow> (fg y) * h (-y + x) = 0"
     unfolding supp_def by auto
   from assms have "convolution fg h x = (\<Sum>y\<in>supp fg. (fg y) * h (-y + x))"
     using fg_aezfun convolution_symm_eq_sum_over_supp_left[of fg h] by simp
   also from fg_def FG_def have "\<dots> = (\<Sum>y\<in>FG. (fg y) * h (-y + x))"
     using fin_FG supp_sum_subset_union_supp zero_ext_fg
           sum.mono_neutral_left[of FG "supp fg" "(\<lambda>y. (fg y) * h (-y + x))"]
     by    fast
   also from fg_def
     have  "\<dots> = (\<Sum>y\<in>FG. (f y) * h (-y + x)) + (\<Sum>y\<in>FG. (g y) * h (-y + x))"
     using sum.distrib by (simp add: algebra_simps)
   finally show "convolution fg h x = (convolution f h + convolution g h) x"
     using assms FG_def fin_FG zero_ext_f zero_ext_g
           sum.mono_neutral_right[of FG "supp f" "(\<lambda>y. (f y) * h (-y + x))"]
           sum.mono_neutral_right[of FG "supp g" "(\<lambda>y. (g y) * h (-y + x))"]
           convolution_symm_eq_sum_over_supp_left[of f h]
           convolution_symm_eq_sum_over_supp_left[of g h]
     by    fastforce
 qed
 
 subsubsection \<open>Type definition, instantiations, and instances\<close>
 
 typedef (overloaded) ('a::zero,'b) aezfun = "aezfun_set :: ('b\<Rightarrow>'a) set"
   morphisms aezfun Abs_aezfun
   using     zerofun_is_aezfun
   by        fast
 
 setup_lifting type_definition_aezfun
 
 lemma aezfun_finite_supp : "finite (supp (aezfun a))"
   using aezfun.aezfun unfolding aezfun_set_def by fast
 
 lemma aezfun_transfer : "aezfun a = aezfun b \<Longrightarrow> a = b" by transfer fast
 
 instantiation aezfun :: (zero, type) zero
 begin
   lift_definition zero_aezfun :: "('a,'b) aezfun" is "0::'b\<Rightarrow>'a"
     using zerofun_is_aezfun by fast
   instance ..
 end
 
 lemma zero_aezfun_transfer : "Abs_aezfun ((0::'b::zero) \<delta> (0::'a::zero)) = 0"
 proof-
   define zb za where "zb = (0::'b)" and "za = (0::'a)"
   hence "zb \<delta> za = 0" using deltafun0[of za] by fast
   moreover have "aezfun 0 = 0" using zero_aezfun.rep_eq by fast
   ultimately have "zb \<delta> za = aezfun 0" by simp
   with zb_def za_def show ?thesis using aezfun_inverse by simp
 qed
 
 lemma zero_aezfun_apply [simp]: "aezfun 0 x = 0"
   by transfer simp
 
 instantiation aezfun :: (monoid_add, type) plus
 begin
   lift_definition plus_aezfun :: "('a, 'b) aezfun \<Rightarrow> ('a, 'b) aezfun \<Rightarrow> ('a, 'b) aezfun"
     is    "\<lambda>f g. f + g"
     using sum_of_aezfun_is_aezfun
     by    auto
   instance ..
 end
 
 lemma plus_aezfun_apply [simp]: "aezfun (a+b) x = aezfun a x + aezfun b x"
   by transfer simp
 
 instance aezfun :: (monoid_add, type) semigroup_add
 proof
   fix a b c :: "('a, 'b) aezfun"
   have "aezfun (a + b + c) = aezfun (a + (b + c))"
   proof
     fix x::'b show "aezfun (a + b + c) x = aezfun (a + (b + c)) x" 
       using add.assoc[of "aezfun a x"] by simp
   qed
   thus "a + b + c = a + (b + c)" by transfer fast
 qed
 
 instance aezfun :: (monoid_add, type) monoid_add
 proof
   fix a b c :: "('a, 'b) aezfun"
   show "0 + a = a" by transfer simp
   show "a + 0 = a" by transfer simp
 qed
 
 lemma sum_list_aezfun_apply [simp] :
   "aezfun (sum_list as) x = (\<Sum>a\<leftarrow>as. aezfun a x)"
   by (induct as) auto
 
 lemma sum_list_map_aezfun_apply [simp] :
   "aezfun (\<Sum>a\<leftarrow>as. f a) x = (\<Sum>a\<leftarrow>as. aezfun (f a) x)"
   by (induct as) auto
 
 lemma sum_list_map_aezfun [simp] :
   "aezfun (\<Sum>a\<leftarrow>as. f a) = (\<Sum>a\<leftarrow>as. aezfun (f a))"
   using sum_list_map_aezfun_apply[of f] sum_list_fun_apply[of "aezfun \<circ> f"] by auto
 
 lemma sum_list_prod_map_aezfun_apply :  
   "aezfun (\<Sum>(x,y)\<leftarrow>xys. f x y) a = (\<Sum>(x,y)\<leftarrow>xys. aezfun (f x y) a)"
   by (induct xys) auto
 
 lemma sum_list_prod_map_aezfun :
   "aezfun (\<Sum>(x,y)\<leftarrow>xys. f x y) = (\<Sum>(x,y)\<leftarrow>xys. aezfun (f x y))"
   using sum_list_prod_map_aezfun_apply[of f]
         sum_list_prod_fun_apply[of "\<lambda>y z. aezfun (f y z)"]
   by    auto
 
 instance aezfun :: (comm_monoid_add, type) comm_monoid_add
 proof
   fix a b :: "('a, 'b) aezfun"
   have "aezfun (a + b) = aezfun (b + a)"
   proof
     fix x::'b show "aezfun (a + b) x = aezfun (b + a) x" 
       using add.commute[of "aezfun a x"] by simp
   qed
   thus "a + b = b + a" by transfer fast
   show "0 + a = a" by simp
 qed
 
 lemma sum_aezfun_apply [simp] :
   "finite A \<Longrightarrow> aezfun (\<Sum>A) x = (\<Sum>a\<in>A. aezfun a x)"
   by (induct set: finite) auto
 
 instantiation aezfun :: (group_add, type) minus
 begin
   lift_definition minus_aezfun :: "('a, 'b) aezfun \<Rightarrow> ('a, 'b) aezfun \<Rightarrow> ('a, 'b) aezfun"
     is    "\<lambda>f g. f - g"
     using diff_of_aezfun_is_aezfun
     by    fast
   instance ..
 end
 
 lemma minus_aezfun_apply [simp]: "aezfun (a-b) x = aezfun a x - aezfun b x"
   by transfer simp
 
 instantiation aezfun :: (group_add, type) uminus
 begin
   lift_definition uminus_aezfun :: "('a, 'b) aezfun \<Rightarrow> ('a, 'b) aezfun" is "\<lambda>f. - f"
     using neg_of_aezfun_is_aezfun by fast
   instance ..
 end
 
 lemma uminus_aezfun_apply [simp]: "aezfun (-a) x = - aezfun a x"
   by transfer simp
 
 lemma aezfun_left_minus [simp] :
   fixes a :: "('a::group_add, 'b) aezfun"
   shows "- a + a = 0"
   by    transfer simp
 
 lemma aezfun_diff_minus [simp] :
   fixes a b :: "('a::group_add, 'b) aezfun"
   shows "a - b = a + - b"
   by    transfer auto
 
 instance aezfun :: (group_add, type) group_add
 proof
   fix a b :: "('a::group_add, 'b) aezfun"
   show "- a + a = 0" "a + - b = a - b" by auto
 qed
 
 instance aezfun :: (ab_group_add, type) ab_group_add
 proof
   fix a b :: "('a::ab_group_add, 'b) aezfun"
   show "- a + a = 0" by simp
   show "a - b = a + - b" using aezfun_diff_minus by fast
 qed
 
 instantiation aezfun :: ("{one,zero}", zero) one
 begin
   lift_definition one_aezfun :: "('a,'b) aezfun" is "1 \<delta> 0"
     using deltafun_is_aezfun by fast
   instance ..
 end
 
 lemma one_aezfun_transfer : "Abs_aezfun (1 \<delta> 0) = 1"
 proof-
   define z n where "z = (0::'b::zero)" and "n = (1::'a::{one,zero})"
   hence "aezfun 1 = n \<delta> z" using one_aezfun.rep_eq by fast
   hence "Abs_aezfun (n \<delta> z) = Abs_aezfun (aezfun 1)" by simp
   with z_def n_def show ?thesis using aezfun_inverse by simp
 qed
 
 lemma one_aezfun_apply [simp]: "aezfun 1 x = (1 \<delta> 0) x"
   by transfer rule
 
 lemma one_aezfun_apply_eq [simp]: "aezfun 1 0 = 1"
   using deltafun_apply_eq by simp
 
 lemma one_aezfun_apply_neq [simp]: "x \<noteq> 0 \<Longrightarrow> aezfun 1 x = 0"
   using deltafun_apply_neq by simp
 
 instance aezfun :: (zero_neq_one, zero) zero_neq_one
 proof
   have "(0::'a) \<noteq> 1" "aezfun 0 0 = 0" "aezfun (1::('a,'b) aezfun) 0 = 1"
     using zero_neq_one one_aezfun_apply_eq by auto
   thus "(0::('a,'b) aezfun) \<noteq> 1"
     using zero_neq_one one_aezfun_apply_eq
           fun_eq_iff[of "aezfun (0::('a,'b) aezfun)" "aezfun 1"]
     by    auto
 qed
 
 instantiation aezfun :: ("{comm_monoid_add,times}", group_add) times
 begin
   lift_definition times_aezfun :: "('a, 'b) aezfun \<Rightarrow> ('a, 'b) aezfun \<Rightarrow> ('a, 'b) aezfun"
     is    "\<lambda> f g. convolution f g"
     using convolution_of_aezfun_is_aezfun
     by    fast
   instance ..
 end
 
 lemma convolution_transfer :
   assumes "f \<in> aezfun_set" "g \<in> aezfun_set"
   shows   "Abs_aezfun (convolution f g) = Abs_aezfun f * Abs_aezfun g"
 proof (rule aezfun_transfer)
   from assms have "aezfun (Abs_aezfun (convolution f g)) = convolution f g"
     using convolution_of_aezfun_is_aezfun Abs_aezfun_inverse by fast
   moreover from assms
     have  "aezfun (Abs_aezfun f * Abs_aezfun g) = convolution f g"
     using times_aezfun.rep_eq[of "Abs_aezfun f"] Abs_aezfun_inverse[of f]
           Abs_aezfun_inverse[of g]
     by    simp
   ultimately show "aezfun (Abs_aezfun (convolution f g))
                         = aezfun (Abs_aezfun f * Abs_aezfun g)"
     by simp
 qed
 
 instance aezfun :: ("{comm_monoid_add,mult_zero}", group_add) mult_zero
 proof
   fix a :: "('a, 'b) aezfun"
   show "0 * a = 0" using convolution_zero[of _ "aezfun a"] by transfer fast
   show "a * 0 = 0" using convolution_zero[of   "aezfun a"] by transfer fast
 qed
 
 instance aezfun :: (semiring_0, group_add) semiring_0
 proof
   fix a b c :: "('a, 'b) aezfun"
   show "a * b * c = a * (b * c)"
     using convolution_assoc[of "aezfun a" "aezfun c" "aezfun b"] by transfer
   show "(a + b) * c = a * c + b * c"
     using convolution_distrib_right[of "aezfun a" "aezfun b" "aezfun c"] by transfer
   show "a * (b + c) = a * b + a * c"
     using convolution_distrib_left[of "aezfun b" "aezfun c" "aezfun a"] by transfer
 qed
 
 instance aezfun :: (ring, group_add) ring ..
 
 instance aezfun :: ("{semiring_0,monoid_mult,zero_neq_one}", group_add) monoid_mult
 proof
   fix a :: "('a, 'b) aezfun"
   show "1 * a = a"
   proof-
     have "aezfun (1 * a) = convolution (1 \<delta> 0) (aezfun a)" by transfer fast
     hence "aezfun (1 * a) = (aezfun a)"
       using one_neq_zero convolution_delta_left[of 1 0 "aezfun a"] minus_zero by simp
     thus "1 * a = a" by transfer
   qed
   show "a * 1 = a"
   proof-
     have "aezfun (a * 1) = convolution (aezfun a) (1 \<delta> 0)" by transfer fast
     hence "aezfun (a * 1) = (aezfun a)" 
       using one_neq_zero convolution_delta_right[of "aezfun a"] by simp
     thus ?thesis by transfer
   qed
 qed
 
 instance aezfun :: (ring_1, group_add) ring_1 ..
 
 subsubsection \<open>Transfer facts\<close>
 
 abbreviation aezdeltafun :: "'b::zero \<Rightarrow> 'a \<Rightarrow> ('b,'a) aezfun" (infix "\<delta>\<delta>" 70)
   where "b \<delta>\<delta> a \<equiv> Abs_aezfun (b \<delta> a)"
 
 lemma aezdeltafun : "aezfun (b \<delta>\<delta> a) = b \<delta> a"
   using deltafun_is_aezfun[of b a] Abs_aezfun_inverse by fast
 
 lemma aezdeltafun_plus : "(b+c) \<delta>\<delta> a = (b \<delta>\<delta> a) + (c \<delta>\<delta> a)"
   using aezdeltafun[of "b+c" a] deltafun_plus aezdeltafun[of b a] aezdeltafun[of c a]
         plus_aezfun.rep_eq[of "b \<delta>\<delta> a"]
         aezfun_transfer[of "(b+c) \<delta>\<delta> a" "(b \<delta>\<delta> a) + (c \<delta>\<delta> a)"]
   by    fastforce
 
 lemma   times_aezdeltafun_aezdeltafun :
   fixes b1 b2 :: "'b::{comm_monoid_add,mult_zero}"
   shows "(b1 \<delta>\<delta> a1) * (b2 \<delta>\<delta> a2) = (b1 * b2) \<delta>\<delta> (a1 + a2)"
   using deltafun_is_aezfun convolution_transfer[of "b1 \<delta> a1", THEN sym]
         convolution_delta_delta[of b1 a1 b2 a2]
   by    fastforce
 
 lemma aezfun_restrict_and_extend0 : "(aezfun x)\<down>A \<in> aezfun_set"
   using aezfun.aezfun restrict_and_extend0_aezfun_is_aezfun[of "aezfun x"] by fast
 
 lemma aezdeltafun_decomp :
   fixes b :: "'b::semiring_1"
   shows "b \<delta>\<delta> a = (b \<delta>\<delta> 0) * (1 \<delta>\<delta> a)"
   using convolution_delta_delta[of b 0 1 a] deltafun_is_aezfun[of b 0]
         deltafun_is_aezfun[of 1 a] convolution_transfer
   by    fastforce
 
 lemma aezdeltafun_decomp' :
   fixes b :: "'b::semiring_1"
   shows "b \<delta>\<delta> a = (1 \<delta>\<delta> a) * (b \<delta>\<delta> 0)"
   using convolution_delta_delta[of 1 a b 0] deltafun_is_aezfun[of b 0]
         deltafun_is_aezfun[of 1 a] convolution_transfer
   by    fastforce
 
 lemma supp_aezfun1 :
   "supp ( aezfun ( 1 :: ('a::zero_neq_one,'b::zero) aezfun ) ) = 0"
   using supp_deltafun[of "1::'a" "0::'b"] by transfer simp
 
 lemma supp_aezfun_diff :
   "supp (aezfun (x - y)) \<subseteq> supp (aezfun x) \<union> supp (aezfun y)"
 proof-
   have "supp (aezfun (x - y)) = supp ( (aezfun x) - (aezfun y) )" by transfer fast
   thus ?thesis using supp_diff_subset_union_supp by fast
 qed
 
 lemma supp_aezfun_times :
   "supp (aezfun (x * y)) \<subseteq> supp (aezfun x) + supp (aezfun y)"
 proof-
   have "supp (aezfun (x * y)) = supp (convolution (aezfun x) (aezfun y))"
     by transfer fast
   thus ?thesis using supp_convolution_subset_sum_supp by fast
 qed
 
 subsubsection \<open>Almost-everywhere-zero functions with constrained support\<close>
 
 text \<open>The name of the next definition anticipates \<open>aezfun_common_supp_spanning_set\<close>
         below.\<close>
 
 definition aezfun_setspan :: "'a set \<Rightarrow> ('b::zero,'a) aezfun set"
   where "aezfun_setspan A = {x. supp (aezfun x) \<subseteq> A}"
 
 lemma aezfun_setspanD : "x \<in> aezfun_setspan A \<Longrightarrow> supp (aezfun x) \<subseteq> A"
   unfolding aezfun_setspan_def by fast
 
 lemma aezfun_setspanI : "supp (aezfun x) \<subseteq> A \<Longrightarrow> x \<in> aezfun_setspan A"
   unfolding aezfun_setspan_def by fast
 
 lemma aezfun_common_supp_spanning_set :
   assumes "finite A"
   shows   "\<exists>as. distinct as \<and> set as = A \<and> (
                   \<forall>x::('b::semiring_1,'a) aezfun \<in> aezfun_setspan A.
                     \<exists>bs. length bs = length as \<and> x = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta>\<delta> a)
           )"
 proof-
   from assms aezfun_common_supp_spanning_set'[of A] obtain as
     where as: "distinct as" "set as = A"
               "\<forall>f::'a \<Rightarrow> 'b. supp f \<subseteq> A
                     \<longrightarrow> (\<exists>bs. length bs = length as \<and> f = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta> a))"
     by    fast
   have "\<And>x::('b,'a) aezfun. x \<in> aezfun_setspan A \<Longrightarrow>
              (\<exists>bs. length bs = length as \<and> x = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta>\<delta> a))"
   proof-
     fix x::"('b,'a) aezfun" assume "x \<in> aezfun_setspan A"
     with as(3) obtain bs
       where bs: "length bs = length as" "aezfun x = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta> a)"
       using aezfun_setspanD
       by    fast
     have "\<And>b a. (b,a) \<in> set (zip bs as) \<Longrightarrow> b \<delta> a = aezfun (b \<delta>\<delta> a)"
     proof-
       fix b a assume "(b,a) \<in> set (zip bs as)"
       show "b \<delta> a = aezfun (b \<delta>\<delta> a)" using aezdeltafun[of b a] by simp
     qed
     with bs show "\<exists>bs. length bs = length as \<and> x = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta>\<delta> a)"
       using sum_list_prod_cong[of "zip bs as" deltafun "\<lambda>b a. aezfun (b \<delta>\<delta> a)"]
             sum_list_prod_map_aezfun[of aezdeltafun "zip bs as"]
             aezfun_transfer[of x]
       by    fastforce
   qed
   with as(1,2) show ?thesis by fast
 qed
 
 lemma aezfun_common_supp_spanning_set_decomp :
   fixes   G :: "'g::group_add set"
   assumes "finite G"
   shows   "\<exists>gs. distinct gs \<and> set gs = G \<and> (
                   \<forall>x::('r::semiring_1,'g) aezfun \<in> aezfun_setspan G.
                     \<exists>rs. length rs = length gs
                       \<and> x = (\<Sum>(r,g)\<leftarrow>zip rs gs. (r \<delta>\<delta> 0) * (1 \<delta>\<delta> g))
           )"
 proof-
   from  aezfun_common_supp_spanning_set[OF assms] obtain gs
     where gs: "distinct gs" "set gs = G"
               "\<forall>x::('r,'g) aezfun \<in> aezfun_setspan G.
                     \<exists>rs. length rs = length gs
                       \<and> x = (\<Sum>(r,g)\<leftarrow>zip rs gs. r \<delta>\<delta> g)"
     by    fast
   have "\<And>x::('r,'g) aezfun. x \<in> aezfun_setspan G
               \<Longrightarrow> \<exists>rs. length rs = length gs
                 \<and> x = (\<Sum>(r,g)\<leftarrow>zip rs gs. (r \<delta>\<delta> 0) * (1 \<delta>\<delta> g))"
   proof-
     fix x::"('r,'g) aezfun" assume "x \<in> aezfun_setspan G"
     with gs(3) obtain rs
       where "length rs = length gs" "x = (\<Sum>(r,g)\<leftarrow>zip rs gs. r \<delta>\<delta> g)"
       using aezfun_setspanD
       by    fast
     thus "\<exists>rs. length rs = length gs
                 \<and> x = (\<Sum>(r,g)\<leftarrow>zip rs gs. (r \<delta>\<delta> 0) * (1 \<delta>\<delta> g))"
       using aezdeltafun_decomp sum_list_prod_cong[
               of "zip rs gs" "\<lambda>r g. r \<delta>\<delta> g" "\<lambda>r g. (r \<delta>\<delta> 0) * (1 \<delta>\<delta> g)"
             ]
       by    auto
   qed
   with gs(1,2) show ?thesis by fast
 qed
 
 lemma aezfun_decomp_aezdeltafun :
   fixes c :: "('r::semiring_1,'a) aezfun"
   shows "\<exists>ras. set (map snd ras) = supp (aezfun c) \<and> c = (\<Sum>(r,a)\<leftarrow>ras. r \<delta>\<delta> a)"
 proof-
   from aezfun_finite_supp[of c] obtain as
     where as: "set as = supp (aezfun c)"
               "\<forall>x::('r,'a) aezfun \<in> aezfun_setspan (supp (aezfun c)).
                     \<exists>bs. length bs = length as
                       \<and> x = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta>\<delta> a)"
     using aezfun_common_supp_spanning_set[of "supp (aezfun c)"]
     by    fast
   from as(2) obtain bs
     where bs: "length bs = length as" "c = (\<Sum>(b,a)\<leftarrow>zip bs as. b \<delta>\<delta> a)"
     using aezfun_setspanI[of c "supp (aezfun c)"]
     by    fast
   from bs(1) as(1) have "set (map snd (zip bs as)) = supp (aezfun c)" by simp
   with bs(2) show ?thesis by fast
 qed
 
 lemma aezfun_setspan_el_decomp_aezdeltafun :
   fixes c :: "('r::semiring_1,'a) aezfun"
   shows "c \<in> aezfun_setspan A
               \<Longrightarrow> \<exists>ras. set (map snd ras) \<subseteq> A \<and> c = (\<Sum>(r,a)\<leftarrow>ras. r \<delta>\<delta> a)"
   using aezfun_setspanD aezfun_decomp_aezdeltafun
   by    fast
 
 lemma aezdelta0fun_commutes' :
   fixes b1 b2 :: "'b::comm_semiring_1"
   shows "b1 \<delta>\<delta> a * (b2 \<delta>\<delta> 0) = b2 \<delta>\<delta> 0 * (b1 \<delta>\<delta> a)"
   using times_aezdeltafun_aezdeltafun[of b1 a]
         times_aezdeltafun_aezdeltafun[of b2 0 b1 a]
   by    (simp add: algebra_simps)
 
 lemma aezdelta0fun_commutes :
   fixes b :: "'b::comm_semiring_1"
   shows "c * (b \<delta>\<delta> 0) = b \<delta>\<delta> 0 * c"
 proof-
   from aezfun_decomp_aezdeltafun obtain ras
     where c: "c = (\<Sum>(r,a)\<leftarrow>ras. r \<delta>\<delta> a)"
     by    fast
   thus ?thesis
     using sum_list_mult_const_prod[of "\<lambda>r a. r \<delta>\<delta> a" ras] aezdelta0fun_commutes'
           sum_list_prod_cong[of ras "\<lambda>r a. r \<delta>\<delta> a * (b \<delta>\<delta> 0)" "\<lambda>r a. b \<delta>\<delta> 0 * (r \<delta>\<delta> a)"]
           sum_list_const_mult_prod[of "b \<delta>\<delta> 0" "\<lambda>r a. r \<delta>\<delta> a" ras]
     by    auto
 qed
 
 text \<open>
   The following definition constrains the support of arbitrary almost-everywhere-zero functions, as
   a sort of projection onto a \<open>aezfun_setspan\<close>.
 \<close>
 
 definition aezfun_setspan_proj :: "'a set \<Rightarrow> ('b::zero,'a) aezfun \<Rightarrow> ('b::zero,'a) aezfun"
   where "aezfun_setspan_proj A x \<equiv> Abs_aezfun ((aezfun x)\<down>A)"
 
 lemma aezfun_setspan_projD1 :
   "a \<in> A \<Longrightarrow> aezfun (aezfun_setspan_proj A x) a = aezfun x a"
   using     aezfun_restrict_and_extend0[of A x] Abs_aezfun_inverse[of "(aezfun x)\<down>A"]
   unfolding aezfun_setspan_proj_def
   by        simp
 
 lemma aezfun_setspan_projD2 :
   "a \<notin> A \<Longrightarrow> aezfun (aezfun_setspan_proj A x) a = 0"
   using     aezfun_restrict_and_extend0[of A x] Abs_aezfun_inverse[of "(aezfun x)\<down>A"]
   unfolding aezfun_setspan_proj_def
   by        simp
 
 lemma aezfun_setspan_proj_in_setspan :
   "aezfun_setspan_proj A x \<in> aezfun_setspan A"
   using aezfun_setspan_projD2[of _ A]
         suppD_contra[of "aezfun (aezfun_setspan_proj A x)"]
         aezfun_setspanI[of "aezfun_setspan_proj A x" A]
   by    auto
 
 lemma aezfun_setspan_proj_zero : "aezfun_setspan_proj A 0 = 0"
 proof-
   have "aezfun (aezfun_setspan_proj A 0) = aezfun 0"
   proof
     fix a show "aezfun (aezfun_setspan_proj A 0) a = aezfun 0 a"
       using aezfun_setspan_projD1[of a A 0] aezfun_setspan_projD2[of a A 0]
       by    (cases "a\<in>A") auto
   qed
   thus ?thesis using aezfun_transfer by fast
 qed
 
 lemma aezfun_setspan_proj_aezdeltafun :
   "aezfun_setspan_proj A (b \<delta>\<delta> a) = (if a \<in> A then b \<delta>\<delta> a else 0)"
 proof-
   have "aezfun (aezfun_setspan_proj A (b \<delta>\<delta> a))
               = aezfun (if a \<in> A then b \<delta>\<delta> a else 0)"
   proof
     fix x show "aezfun (aezfun_setspan_proj A (b \<delta>\<delta> a)) x
                       = aezfun (if a \<in> A then b \<delta>\<delta> a else 0) x"
     proof (cases "x \<in> A")
       case True thus ?thesis
         using aezfun_setspan_projD1[of x A "b \<delta>\<delta> a"] aezdeltafun[of b a]
               deltafun_apply_neq[of x]
         by    fastforce
     next
       case False
       hence "aezfun (aezfun_setspan_proj A (b \<delta>\<delta> a)) x = 0"
         using aezfun_setspan_projD2[of x A] by simp
       moreover from False
         have  "a \<in> A \<Longrightarrow> aezfun (if a \<in> A then b \<delta>\<delta> a else 0) x = 0"
         using aezdeltafun[of b a] deltafun_apply_neq[of x a b] by auto
       ultimately show ?thesis by auto
     qed
   qed
   thus ?thesis using aezfun_transfer by fast
 qed
 
 lemma aezfun_setspan_proj_add :
   "aezfun_setspan_proj A (x+y)
         = aezfun_setspan_proj A x + aezfun_setspan_proj A y"
 proof-
   have "aezfun (aezfun_setspan_proj A (x+y))
              = aezfun (aezfun_setspan_proj A x + aezfun_setspan_proj A y)"
   proof
     fix a show "aezfun (aezfun_setspan_proj A (x+y)) a
                      = aezfun (aezfun_setspan_proj A x + aezfun_setspan_proj A y) a"
       using aezfun_setspan_projD1[of a A "x+y"] aezfun_setspan_projD2[of a A "x+y"]
             aezfun_setspan_projD1[of a A x] aezfun_setspan_projD1[of a A y]
             aezfun_setspan_projD2[of a A x] aezfun_setspan_projD2[of a A y]
       by    (cases "a \<in> A") auto
   qed
   thus ?thesis using aezfun_transfer by auto
 qed
 
 lemma aezfun_setspan_proj_sum_list : 
   "aezfun_setspan_proj A (\<Sum>x\<leftarrow>xs. f x) = (\<Sum>x\<leftarrow>xs. aezfun_setspan_proj A (f x))"
 proof (induct xs)
   case Nil show ?case using aezfun_setspan_proj_zero by simp
 next
   case (Cons x xs) thus ?case using aezfun_setspan_proj_add[of A "f x"] by simp
 qed
 
 lemma aezfun_setspan_proj_sum_list_prod :
   "aezfun_setspan_proj A (\<Sum>(x,y)\<leftarrow>xys. f x y)
         = (\<Sum>(x,y)\<leftarrow>xys. aezfun_setspan_proj A (f x y))"
   using aezfun_setspan_proj_sum_list[of A "\<lambda>xy. case_prod f xy"]
         prod.case_distrib[of "aezfun_setspan_proj A" f]
   by    simp
 
 
 subsection \<open>Polynomials\<close>
 
 lemma nonzero_coeffs_nonzero_poly : "as \<noteq> [] \<Longrightarrow> set as \<noteq> 0 \<Longrightarrow> Poly as \<noteq> 0"
   using coeffs_Poly[of as] strip_while_0_nnil[of as] by fastforce
 
 lemma const_poly_nonzero_coeff :
   assumes "degree p = 0" "p \<noteq> 0"
   shows   "coeff p 0 \<noteq> 0"
 proof
   assume z: "coeff p 0 = 0"
   have "\<And>n. coeff p n = 0"
   proof-
     fix n from z assms show "coeff p n = 0"
       using coeff_eq_0[of p] by (cases "n = 0") auto
   qed
   with assms(2) show False using poly_eqI[of p 0] by simp
 qed
 
 lemma pCons_induct2 [case_names 00 lpCons rpCons pCons2]:
   assumes 00: "P 0 0"
   and     lpCons: "\<And>a p. a \<noteq> 0 \<or> p \<noteq> 0 \<Longrightarrow> P (pCons a p) 0"
   and     rpCons: "\<And>b q. b \<noteq> 0 \<or> q \<noteq> 0 \<Longrightarrow> P 0 (pCons b q)"
   and     pCons2: "\<And>a p b q. a \<noteq> 0 \<or> p \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<or> q \<noteq> 0 \<Longrightarrow> P p q
                                                                     \<Longrightarrow> P (pCons a p) (pCons b q)"
   shows   "P p q"
 proof (induct p arbitrary: q)
   case 0
   show ?case
   proof (cases q)
     fix b q' assume "q = pCons b q'"
     with 00 rpCons show ?thesis by (cases "b \<noteq> 0 \<or> q' \<noteq> 0") auto
   qed
 next
   case (pCons a p)
   show ?case
   proof (cases q)
     fix b q' assume "q = pCons b q'"
     with pCons lpCons pCons2 show ?thesis by (cases "b \<noteq> 0 \<or> q' \<noteq> 0") auto
   qed
 qed
 
 
 subsection \<open>Algebra of sets\<close>
 
 subsubsection \<open>General facts\<close>
 
 lemma zeroset_eqI: "0 \<in> A \<Longrightarrow> (\<And>a. a \<in> A \<Longrightarrow> a = 0) \<Longrightarrow> A = 0"
   by auto
 
 lemma sum_list_sets_single : "(\<Sum>X\<leftarrow>[A]. X) = A"
   using add_0_right[of A] by simp
 
 lemma sum_list_sets_double : "(\<Sum>X\<leftarrow>[A,B]. X) = A + B"
   using add_0_right[of B] by simp
 
 subsubsection \<open>Additive independence of sets\<close>
 
 primrec add_independentS :: "'a::monoid_add set list \<Rightarrow> bool"
   where "add_independentS [] = True"
       | "add_independentS (A#As) = ( add_independentS As
               \<and> (\<forall>x\<in>(\<Sum>B\<leftarrow>As. B). \<forall>a\<in>A. a + x = 0 \<longrightarrow> a = 0) )"
 
 lemma add_independentS_doubleI:
   assumes "\<And>b a. b\<in>B \<Longrightarrow> a\<in>A \<Longrightarrow> a + b = 0 \<Longrightarrow> a = 0"
   shows   "add_independentS [A,B]"
   using assms sum_list_sets_single[of B] by simp
 
 lemma add_independentS_doubleD:
   assumes "add_independentS [A,B]"
   shows   "\<And>b a. b\<in>B \<Longrightarrow> a\<in>A \<Longrightarrow> a + b = 0 \<Longrightarrow> a = 0"
   using assms sum_list_sets_single[of B] by simp
 
 lemma add_independentS_double_iff :
   "add_independentS [A,B] = (\<forall>b\<in>B. \<forall>a\<in>A. a + b = 0 \<longrightarrow> a = 0 )"
   using add_independentS_doubleI add_independentS_doubleD by fast
 
 lemma add_independentS_Cons_conv_sum_right : 
   "add_independentS (A#As)
         = (add_independentS [A,\<Sum>B\<leftarrow>As. B] \<and> add_independentS As)"
   using add_independentS_double_iff[of A] by auto
 
 lemma add_independentS_double_sum_conv_append :
   "\<lbrakk> \<forall>X\<in>set As. 0 \<in> X; add_independentS As; add_independentS Bs; 
         add_independentS [\<Sum>X\<leftarrow>As. X, \<Sum>X\<leftarrow>Bs. X] \<rbrakk>
           \<Longrightarrow> add_independentS (As@Bs)"
 proof (induct As)
   case (Cons A As)
   have "add_independentS [\<Sum>X\<leftarrow>As. X, \<Sum>X\<leftarrow>Bs. X]"
   proof (rule add_independentS_doubleI)
     fix b a assume ba: "b \<in> (\<Sum>X\<leftarrow>Bs. X)" "a \<in> (\<Sum>X\<leftarrow>As. X)" "a + b = 0"
     from Cons(2) ba(2) have "a \<in> (\<Sum>X\<leftarrow>A#As. X)"
       using set_plus_intro[of 0 A a] by simp
     with ba(1,3) Cons(5) show "a = 0"
       using add_independentS_doubleD[of "\<Sum>X\<leftarrow>A # As. X" "\<Sum>X\<leftarrow>Bs. X" b a]
       by    simp
   qed
   moreover have "\<And>x a. \<lbrakk> x \<in> (\<Sum>X\<leftarrow>As@Bs. X); a \<in> A; a + x = 0 \<rbrakk> 
                       \<Longrightarrow> a = 0"
   proof-
     fix x a assume x_a: "x \<in> (\<Sum>X\<leftarrow>As@Bs. X)" "a \<in> A" "a + x = 0"
     from x_a(1) obtain xa xb
       where xa_xb: "x = xa + xb" "xa \<in> (\<Sum>X\<leftarrow>As. X)" "xb \<in> (\<Sum>X\<leftarrow>Bs. X)"
       using set_plus_elim[of x "\<Sum>X\<leftarrow>As. X"]
       by    auto
     from x_a(2) xa_xb(2) have "a + xa \<in> A + (\<Sum>X\<leftarrow>As. X)"
       using set_plus_intro by auto
     with Cons(3,5) xa_xb x_a(2,3) show "a = 0"
       using add_independentS_doubleD[
               of "\<Sum>X\<leftarrow>A # As. X" "\<Sum>X\<leftarrow>Bs. X" xb "a+xa"
             ]
             add.assoc[of a] add_independentS_doubleD
       by    simp
   qed
   ultimately show "add_independentS ((A#As)@Bs)" using Cons by simp
 qed simp
 
 lemma add_independentS_ConsI :
   assumes "add_independentS As"
           "\<And>x a. \<lbrakk> x\<in>(\<Sum>X\<leftarrow>As. X); a \<in> A; a+x = 0 \<rbrakk> \<Longrightarrow> a = 0"
   shows   "add_independentS (A#As)"
   using assms by simp
 
 lemma add_independentS_append_reduce_right :
   "add_independentS (As@Bs) \<Longrightarrow> add_independentS Bs"
   by (induct As) auto
 
 lemma add_independentS_append_reduce_left : 
   "add_independentS (As@Bs) \<Longrightarrow> 0 \<in> (\<Sum>X\<leftarrow>Bs. X) \<Longrightarrow> add_independentS As"
 proof (induct As)
   case (Cons A As) show "add_independentS (A#As)"
   proof (rule add_independentS_ConsI)
     from Cons show "add_independentS As" by simp
   next
     fix x a assume x: "x \<in> (\<Sum>X\<leftarrow>As. X)" and a: "a \<in> A" and sum: "a+x = 0"
     from x Cons(3) have "x + 0 \<in> (\<Sum>X\<leftarrow>As. X) + (\<Sum>X\<leftarrow>Bs. X)" by fast
     with a sum Cons(2) show "a = 0" by simp
   qed
 qed simp
 
 lemma add_independentS_append_conv_double_sum : 
   "add_independentS (As@Bs) \<Longrightarrow> add_independentS [\<Sum>X\<leftarrow>As. X, \<Sum>X\<leftarrow>Bs. X]"
 proof (induct As)
   case (Cons A As)
   show "add_independentS [\<Sum>X\<leftarrow>(A#As). X, \<Sum>X\<leftarrow>Bs. X]"
   proof (rule add_independentS_doubleI)
     fix b x assume bx: "b \<in> (\<Sum>X\<leftarrow>Bs. X)" "x \<in> (\<Sum>X\<leftarrow>A # As. X)" "x + b = 0"
     from bx(2) obtain a as
       where a_as: "a \<in> A" "as \<in> listset As" "x = a + (\<Sum>z\<leftarrow>as. z)"
       using set_sum_list_element_Cons
       by    fast
     from Cons(2) have "add_independentS [A,\<Sum>X\<leftarrow>As@Bs. X]"
       using add_independentS_Cons_conv_sum_right[of A "As@Bs"] by simp
     moreover from a_as(2) bx(1)
       have  "(\<Sum>z\<leftarrow>as. z) + b \<in> (\<Sum>X\<leftarrow>(As@Bs). X)"
       using sum_list_listset set_plus_intro
       by    auto
     ultimately have "a = 0"
       using a_as(1,3) bx(3) add_independentS_doubleD[of A _ _ a] add.assoc[of a]
       by    auto
     with a_as(2,3) bx(1,3) Cons show "x = 0"
       using sum_list_listset
             add_independentS_doubleD[of "\<Sum>X\<leftarrow>As. X" "\<Sum>X\<leftarrow>Bs. X" b "\<Sum>z\<leftarrow>as. z"]
       by    auto
   qed
 qed simp
 
 subsubsection \<open>Inner direct sums\<close>
 
 definition inner_dirsum :: "'a::monoid_add set list \<Rightarrow> 'a set"
   where "inner_dirsum As = (if add_independentS As then \<Sum>A\<leftarrow>As. A else 0)"
 
 text\<open>Some syntactic sugar for \<open>inner_dirsum\<close>, borrowed from theory @{theory HOL.List}.\<close>
 
 syntax 
   "_inner_dirsum" :: "pttrn => 'a list => 'b => 'b"
   ("(3\<Oplus>_\<leftarrow>_. _)" [0, 51, 10] 10)
 translations \<comment> \<open>Beware of argument permutation!\<close>
   "\<Oplus>M\<leftarrow>Ms. b" == "CONST inner_dirsum (CONST map (%M. b) Ms)"
 
 abbreviation inner_dirsum_double ::
   "'a::monoid_add set \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixr "\<oplus>" 70)
   where "inner_dirsum_double A B \<equiv> inner_dirsum [A,B]"
 
 lemma inner_dirsumI :
   "M = (\<Sum>N\<leftarrow>Ns. N) \<Longrightarrow> add_independentS Ns \<Longrightarrow> M = (\<Oplus>N\<leftarrow>Ns. N)"
   unfolding inner_dirsum_def by simp
 
 lemma inner_dirsum_doubleI :
   "M = A + B \<Longrightarrow> add_independentS [A,B] \<Longrightarrow> M = A \<oplus> B"
   using inner_dirsumI[of M "[A,B]"] sum_list_sets_double[of A] by simp
 
 lemma inner_dirsumD :
   "add_independentS Ms \<Longrightarrow> (\<Oplus>M\<leftarrow>Ms. M) = (\<Sum>M\<leftarrow>Ms. M)"
   unfolding inner_dirsum_def by simp
 
 lemma inner_dirsumD2 : "\<not> add_independentS Ms \<Longrightarrow> (\<Oplus>M\<leftarrow>Ms. M) = 0"
   unfolding inner_dirsum_def by simp
 
 lemma inner_dirsum_Nil : "(\<Oplus>A\<leftarrow>[]. A) = 0"
   unfolding inner_dirsum_def by simp
 
 lemma inner_dirsum_singleD : "(\<Oplus>N\<leftarrow>[M]. N) = M"
   using inner_dirsumD[of "[M]"] sum_list_sets_single[of M] by simp
 
 lemma inner_dirsum_doubleD : "add_independentS [M,N] \<Longrightarrow> M \<oplus> N = M + N"
   using inner_dirsumD[of "[M,N]"] sum_list_sets_double[of M N] by simp
 
 lemma inner_dirsum_Cons :
   "add_independentS (A # As) \<Longrightarrow> (\<Oplus>X\<leftarrow>(A#As). X) = A \<oplus> (\<Oplus>X\<leftarrow>As. X)"
   using inner_dirsumD[of "A#As"] add_independentS_Cons_conv_sum_right[of A] 
         inner_dirsum_doubleD[of A] inner_dirsumD[of As]
   by    simp
 
 lemma inner_dirsum_append :
   "add_independentS (As@Bs) \<Longrightarrow> 0 \<in> (\<Sum>X\<leftarrow>Bs. X)
         \<Longrightarrow> (\<Oplus>X\<leftarrow>(As@Bs). X) = (\<Oplus>X\<leftarrow>As. X) \<oplus> (\<Oplus>X\<leftarrow>Bs. X)"
   using inner_dirsumD[of "As@Bs"] add_independentS_append_reduce_left[of As]
         inner_dirsumD[of As] inner_dirsumD[of Bs]
         add_independentS_append_reduce_right[of As Bs]
         add_independentS_append_conv_double_sum[of As]
         inner_dirsum_doubleD[of "\<Sum>X\<leftarrow>As. X"]
   by    simp
 
 lemma inner_dirsum_double_left0: "0 \<oplus> A = A"
   using add_independentS_doubleD inner_dirsum_doubleI[of "0+A"] add_0_left[of A] by simp
 
 lemma add_independentS_Cons_conv_dirsum_right :
   "add_independentS (A#As) = (add_independentS [A,\<Oplus>B\<leftarrow>As. B]
         \<and> add_independentS As)"
   using add_independentS_Cons_conv_sum_right[of A As] inner_dirsumD by auto
 
 lemma sum_list_listset_dirsum : 
   "add_independentS As \<Longrightarrow> as \<in> listset As \<Longrightarrow> sum_list as \<in> (\<Oplus>A\<leftarrow>As. A)"
   using inner_dirsumD sum_list_listset by fast
 
 
 
 
 section \<open>Groups\<close>
 
 subsection \<open>Locales and basic facts\<close>
 
 subsubsection \<open>Locale \<open>Group\<close> and finite variant \<open>FinGroup\<close>\<close>
 
 text \<open>
   Define a \<open>Group\<close> to be a closed subset of @{term UNIV} for the \<open>group_add\<close> class.
 \<close>
 
 locale Group =
   fixes G :: "'g::group_add set"
   assumes nonempty   : "G \<noteq> {}"
   and     diff_closed: "\<And>g h. g \<in> G \<Longrightarrow> h \<in> G \<Longrightarrow> g - h \<in> G"
 
 lemma trivial_Group : "Group 0"
   by unfold_locales auto
 
 locale FinGroup = Group G
   for G :: "'g::group_add set"
 + assumes finite: "finite G"
 
 lemma (in FinGroup) Group : "Group G" by unfold_locales
 
 lemma (in Group) FinGroupI : "finite G \<Longrightarrow> FinGroup G" by unfold_locales
 
 context Group
 begin
 
 abbreviation Subgroup ::
   "'g set \<Rightarrow> bool" where "Subgroup H \<equiv> Group H \<and> H \<subseteq> G"
 
 lemma SubgroupD1 : "Subgroup H \<Longrightarrow> Group H" by fast
 
 lemma zero_closed : "0 \<in> G"
 proof-
   from nonempty obtain g where "g \<in> G" by fast
   hence "g - g \<in> G" using diff_closed by fast
   thus ?thesis by simp
 qed
 
 lemma obtain_nonzero: assumes "G \<noteq> 0" obtains g where "g \<in> G" and "g \<noteq> 0"
   using assms zero_closed by auto
 
 lemma zeroS_closed : "0 \<subseteq> G"
   using zero_closed by simp
 
 lemma neg_closed : "g \<in> G \<Longrightarrow> -g \<in> G"
   using zero_closed diff_closed[of 0 g] by simp
 
 lemma add_closed : "g \<in> G \<Longrightarrow> h \<in> G \<Longrightarrow> g + h \<in> G"
   using neg_closed[of h] diff_closed[of g "-h"] by simp
 
 lemma neg_add_closed : "g \<in> G \<Longrightarrow> h \<in> G \<Longrightarrow> -g + h \<in> G"
   using neg_closed add_closed by fast
 
 lemma sum_list_closed : "set (map f as) \<subseteq> G \<Longrightarrow> (\<Sum>a\<leftarrow>as. f a) \<in> G"
   using zero_closed add_closed by (induct as) auto
 
 lemma sum_list_closed_prod :
   "set (map (case_prod f) xys) \<subseteq> G \<Longrightarrow> (\<Sum>(x,y)\<leftarrow>xys. f x y) \<in> G"
   using sum_list_closed by fast
 
 lemma set_plus_closed : "A \<subseteq> G \<Longrightarrow> B \<subseteq> G \<Longrightarrow> A + B \<subseteq> G"
   using set_plus_def[of A B] add_closed by force
 
 lemma zip_add_closed :
   "set as \<subseteq> G \<Longrightarrow> set bs \<subseteq> G \<Longrightarrow> set [a + b. (a,b)\<leftarrow>zip as bs] \<subseteq> G"
   using add_closed by (induct as bs rule: list_induct2') auto
 
 lemma list_diff_closed :
   "set gs \<subseteq> G \<Longrightarrow> set hs \<subseteq> G \<Longrightarrow> set [x-y. (x,y)\<leftarrow>zip gs hs] \<subseteq> G"
   using diff_closed by (induct gs hs rule: list_induct2') auto
 
 lemma add_closed_converse_right : "g+x \<in> G \<Longrightarrow> g \<in> G \<Longrightarrow> x \<in> G"
   using neg_add_closed add.assoc[of "-g" g x] by fastforce
 
 lemma add_closed_inverse_right : "x \<notin> G \<Longrightarrow> g \<in> G \<Longrightarrow> g+x \<notin> G"
   using add_closed_converse_right by fast
 
 lemma add_closed_converse_left : "g+x \<in> G \<Longrightarrow> x \<in> G \<Longrightarrow> g \<in> G"
   using diff_closed add.assoc[of g] by fastforce
 
 lemma add_closed_inverse_left : "g \<notin> G \<Longrightarrow> x \<in> G \<Longrightarrow> g+x \<notin> G"
   using add_closed_converse_left by fast
 
 lemma right_translate_bij :
   assumes "g \<in> G"
   shows   "bij_betw (\<lambda>x. x + g) G G"
 unfolding bij_betw_def proof
   show "inj_on (\<lambda>x. x + g) G" by (rule inj_onI) simp
   show "(\<lambda>x. x + g) ` G = G"
   proof
     show "(\<lambda>x. x + g) ` G \<subseteq> G" using assms add_closed by fast
     show "(\<lambda>x. x + g) ` G \<supseteq> G"
     proof
       fix x assume "x \<in> G"
       with assms have "x - g \<in> G" "x = (\<lambda>x. x + g) (x - g)"
         using diff_closed diff_add_cancel[of x] by auto
       thus "x \<in> (\<lambda>x. x + g) ` G" by fast
     qed
   qed
 qed
 
 lemma right_translate_sum : "g \<in> G \<Longrightarrow> (\<Sum>h\<in>G. f h) = (\<Sum>h\<in>G. f (h + g))"
   using right_translate_bij[of g] bij_betw_def[of "\<lambda>h. h + g"]
         sum.reindex[of "\<lambda>h. h + g" G]
   by    simp
 
 end (* context Group *)
 
 subsubsection \<open>Abelian variant locale \<open>AbGroup\<close>\<close>
 
 locale AbGroup = Group G
   for G :: "'g::ab_group_add set"
 begin
 
 lemmas nonempty    = nonempty
 lemmas zero_closed = zero_closed
 lemmas diff_closed = diff_closed
 lemmas add_closed  = add_closed
 lemmas neg_closed  = neg_closed
 
 lemma sum_closed : "finite A \<Longrightarrow> f ` A \<subseteq> G \<Longrightarrow> (\<Sum>a\<in>A. f a) \<in> G"
 proof (induct set: finite)
   case empty show ?case using zero_closed by simp
 next
   case (insert a A) thus ?case using add_closed by simp
 qed
 
 lemma subset_plus_right : "A \<subseteq> G + A"
   using zero_closed set_zero_plus2 by fast
 
 lemma subset_plus_left : "A \<subseteq> A + G"
   using subset_plus_right add.commute by fast
 
 end (* context AbGroup *)
 
 
 subsection \<open>Right cosets\<close>
 
 context Group
 begin
 
 definition rcoset_rel :: "'g set \<Rightarrow> ('g\<times>'g) set" 
   where "rcoset_rel H \<equiv> {(g,g'). g \<in> G \<and> g' \<in> G \<and> g - g' \<in> H}"
 
 lemma (in Group) rcosets :
   assumes subgrp: "Subgroup H" and g: "g \<in> G"
   shows   "(rcoset_rel H)``{g} = H + {g}"
 proof (rule seteqI)
   fix x assume "x \<in> (rcoset_rel H)``{g}"
   hence "x \<in> G" "g - x \<in> H" using rcoset_rel_def by auto
   with subgrp have "x - g \<in> H"
     using Group.neg_closed minus_diff_eq[of g x] by fastforce
   from this obtain h where h: "h \<in> H" "x - g = h" by fast
   from h(2) have "x = h + g" by (simp add: algebra_simps)
   with h(1) show "x \<in> H + {g}" using set_plus_def by fast
 next
   fix x assume "x \<in> H + {g}"
   from this obtain h where h: "h \<in> H" "x = h + g" unfolding set_plus_def by fast
   with subgrp g have 1: "x \<in> G" using add_closed by fast
   from h(2) have "x - g = h" by (simp add: algebra_simps)
   with subgrp h(1) have "g - x \<in> H" using Group.neg_closed by fastforce
   with g 1 show "x \<in> (rcoset_rel H)``{g}" using rcoset_rel_def by fast
 qed
 
 lemma rcoset_equiv :
   assumes "Subgroup H"
   shows   "equiv G (rcoset_rel H)"
 proof (rule equivI)
   show "refl_on G (rcoset_rel H)"
   proof (rule refl_onI)
     show "(rcoset_rel H) \<subseteq> G \<times> G" using rcoset_rel_def by auto
   next
     fix x assume "x \<in> G"
     with assms show "(x,x) \<in> (rcoset_rel H)"
       using rcoset_rel_def Group.zero_closed by auto
   qed
   show "sym (rcoset_rel H)"
   proof (rule symI)
     fix a b assume "(a,b) \<in> (rcoset_rel H)"
     with assms show "(b,a) \<in> (rcoset_rel H)"
       using rcoset_rel_def Group.neg_closed[of H "a - b"] minus_diff_eq by simp
   qed
   show "trans (rcoset_rel H)"
   proof (rule transI)
     fix x y z assume "(x,y) \<in> (rcoset_rel H)" "(y,z) \<in> (rcoset_rel H)"
     with assms show "(x,z) \<in> (rcoset_rel H)"
       using rcoset_rel_def Group.add_closed[of H "x - y" "y - z"]
       by    (simp add: algebra_simps)
   qed
 qed
 
 lemma rcoset0 : "Subgroup H \<Longrightarrow> (rcoset_rel H)``{0} = H"
   using zero_closed rcosets unfolding set_plus_def by simp
 
 definition is_rcoset_replist :: "'g set \<Rightarrow> 'g list \<Rightarrow> bool"
   where "is_rcoset_replist H gs
               \<equiv> set gs \<subseteq> G \<and> distinct (map (\<lambda>g. (rcoset_rel H)``{g}) gs)
                 \<and> G = (\<Union>g\<in>set gs. (rcoset_rel H)``{g})"
 
 lemma is_rcoset_replistD_set : "is_rcoset_replist H gs \<Longrightarrow> set gs \<subseteq> G"
   unfolding is_rcoset_replist_def by fast
 
 lemma is_rcoset_replistD_distinct :
   "is_rcoset_replist H gs \<Longrightarrow> distinct (map (\<lambda>g. (rcoset_rel H)``{g}) gs)"
   unfolding is_rcoset_replist_def by fast
 
 lemma is_rcoset_replistD_cosets :
   "is_rcoset_replist H gs \<Longrightarrow> G = (\<Union>g\<in>set gs. (rcoset_rel H)``{g})"
   unfolding is_rcoset_replist_def by fast
 
 lemma group_eq_subgrp_rcoset_un :
   "Subgroup H \<Longrightarrow> is_rcoset_replist H gs \<Longrightarrow> G = (\<Union>g\<in>set gs. H + {g})"
   using is_rcoset_replistD_set is_rcoset_replistD_cosets rcosets
     by (auto, smt UN_E subsetCE, blast)
 
 lemma is_rcoset_replist_imp_nrelated_nth :
   assumes "Subgroup H" "is_rcoset_replist H gs"
   shows   "\<And>i j. i < length gs \<Longrightarrow> j < length gs \<Longrightarrow> i \<noteq> j \<Longrightarrow> gs!i - gs!j \<notin> H"
 proof
   fix i j assume ij: "i < length gs" "j < length gs" "i\<noteq>j" "gs!i - gs!j \<in> H"
   from assms(2) ij(1,2,4) have "(gs!i,gs!j) \<in> rcoset_rel H"
     using set_conv_nth is_rcoset_replistD_set rcoset_rel_def by fastforce
   with assms(1) ij(1,2)
     have  "(map (\<lambda>g. (rcoset_rel H)``{g}) gs)!i
                 = (map (\<lambda>g. (rcoset_rel H)``{g}) gs)!j"
     using rcoset_equiv equiv_class_eq
     by    fastforce
   with assms(2) ij(1-3) show False
     using is_rcoset_replistD_distinct distinct_conv_nth[
             of "map (\<lambda>g. (rcoset_rel H)``{g}) gs"
           ]
     by    auto
 qed
 
 lemma is_rcoset_replist_Cons :
   "is_rcoset_replist H (g#gs) \<longleftrightarrow>
       g \<in> G \<and> set gs \<subseteq> G
     \<and> (rcoset_rel H)``{g} \<notin> set (map (\<lambda>x. (rcoset_rel H)``{x}) gs)
     \<and> distinct (map (\<lambda>x. (rcoset_rel H)``{x}) gs)
     \<and> G = (rcoset_rel H)``{g} \<union> (\<Union>x\<in>set gs. (rcoset_rel H)``{x})"
   using is_rcoset_replist_def[of H "g#gs"] by auto
 
 lemma rcoset_replist_Hrep :
   assumes "Subgroup H" "is_rcoset_replist H gs"
   shows   "\<exists>g\<in>set gs. g \<in> H"
 proof-
   from assms(2) obtain g where g: "g \<in> set gs" "0 \<in> (rcoset_rel H)``{g}"
     using zero_closed is_rcoset_replistD_cosets by fast
   from assms(1) g(2) have "g \<in> (rcoset_rel H)``{0}"
     using rcoset_equiv equivE sym_def[of "rcoset_rel H"] by force
   with assms(1) g show "\<exists>g\<in>set gs. g \<in> H" using rcoset0 by fast
 qed
 
 lemma rcoset_replist_reorder :
   "is_rcoset_replist H (gs @ g # gs') \<Longrightarrow> is_rcoset_replist H (g # gs @ gs')"
   using is_rcoset_replist_def by auto
 
 lemma rcoset_replist_replacehd :
   assumes "Subgroup H" "g' \<in> (rcoset_rel H)``{g}" "is_rcoset_replist H (g # gs)"
   shows   "is_rcoset_replist H (g' # gs)"
 proof-
   from assms(2) have "g' \<in> G" using rcoset_rel_def by simp
   moreover from assms(3) have "set gs \<subseteq> G"
     using is_rcoset_replistD_set by fastforce
   moreover from assms(1-3)
     have  "(rcoset_rel H)``{g'} \<notin> set (map (\<lambda>x. (rcoset_rel H)``{x}) gs)"
     using set_conv_nth[of gs] rcoset_equiv equiv_class_eq_iff[of G] is_rcoset_replistD_distinct
     by    fastforce
   moreover from assms(3) have "distinct (map (\<lambda>g. (rcoset_rel H)``{g}) gs)"
     using is_rcoset_replistD_distinct by fastforce
   moreover from assms(1-3)
     have  "G = (rcoset_rel H)``{g'} \<union> (\<Union>x\<in>set gs. (rcoset_rel H)``{x})"
     using is_rcoset_replistD_cosets[of H "g#gs"] rcoset_equiv equiv_class_eq_iff[of G]
     by    simp
   ultimately show ?thesis using is_rcoset_replist_Cons by auto 
 qed
 
 end (* context Group *)
 
 lemma (in FinGroup) ex_rcoset_replist :
   assumes "Subgroup H"
   shows   "\<exists>gs. is_rcoset_replist H gs"
 proof-
   define r where "r = rcoset_rel H"
   hence equiv_r: "equiv G r" using rcoset_equiv[OF assms] by fast
   have "\<forall>x\<in>G//r. \<exists>g. g \<in> x"
   proof
     fix x assume "x \<in> G//r"
     from this obtain g where g: "g \<in> G" "x = r``{g}"
       using quotient_def[of G r] by auto
     hence "g \<in> x" using equiv_r equivE[of G r] refl_onD[of G r] by auto
     thus "\<exists>g. g \<in> x" by fast
   qed
   from this obtain f where f: "\<forall>x\<in>G//r. f x \<in> x" using bchoice by force
   from r_def have "r \<subseteq> G \<times> G" using rcoset_rel_def by auto
   with finite have "finite (f`(G//r))" using finite_quotient by auto
   from this obtain gs where gs: "distinct gs" "set gs = f`(G//r)"
     using finite_distinct_list by force
 
   have 1: "set gs \<subseteq> G"
   proof
     fix g assume "g \<in> set gs"
     with gs(2) obtain x where x: "x \<in> G//r" "g = f x" by fast
     with f show "g \<in> G" using equiv_r Union_quotient by fast
   qed
 
   moreover have "distinct (map (\<lambda>g. r``{g}) gs)"
   proof-
     have "\<And>i j. \<lbrakk> i < length (map (\<lambda>g. r``{g}) gs);
                 j < length (map (\<lambda>g. r``{g}) gs); i \<noteq> j \<rbrakk>
                   \<Longrightarrow> (map (\<lambda>g. r``{g}) gs)!i \<noteq> (map (\<lambda>g. r``{g}) gs)!j"
     proof
       fix i j assume ij:
         "i < length (map (\<lambda>g. r``{g}) gs)"
         "j< length (map (\<lambda>g. r``{g}) gs)"
         "i \<noteq> j"
         "(map (\<lambda>g. r``{g}) gs)!i = (map (\<lambda>g. r``{g}) gs)!j"
       from ij(1,2) have "gs!i \<in> set gs" "gs!j \<in> set gs" using set_conv_nth by auto
       from this gs(2) obtain x y
         where x: "x \<in> G//r" "gs!i = f x" and y: "y \<in> G//r" "gs!j = f y"
         by    auto
       have "x = y"
         using equiv_r x(1) y(1)
       proof (rule quotient_eqI[of G r])
         from ij(1,2,4) have "r``{gs!i} = r``{gs!j}" by simp
         with ij(1,2) 1 show "(gs!i,gs!j) \<in> r"
           using eq_equiv_class_iff[OF equiv_r] by force
         from x y f show "gs!i \<in> x" "gs!j \<in> y" by auto
       qed        
       with x(2) y(2) ij(1-3) gs(1) show False using distinct_conv_nth by fastforce
     qed
     thus ?thesis using distinct_conv_nth by fast
   qed
 
   moreover have "G = (\<Union>g\<in>set gs. r``{g})"
   proof (rule subset_antisym, rule subsetI)
     fix g assume "g \<in> G"
     hence rg: "r``{g} \<in> G//r" using quotientI by fast
     with gs(2) obtain g' where g': "g' \<in> set gs" "g' = f (r``{g})" by fast
     from f g'(2) rg have "g \<in> r``{g'}" using equiv_r equivE sym_def[of r] by force
     with g'(1) show "g \<in> (\<Union>g\<in>set gs. r``{g})" by fast
   next
     from r_def show "G \<supseteq> (\<Union>g\<in>set gs. r``{g})" using rcoset_rel_def by auto
   qed
 
   ultimately show ?thesis using r_def unfolding is_rcoset_replist_def by fastforce
 qed
 
 lemma (in FinGroup) ex_rcoset_replist_hd0 :
   assumes "Subgroup H"
   shows   "\<exists>gs. is_rcoset_replist H (0#gs)"
 proof-
   from assms obtain xs where xs: "is_rcoset_replist H xs"
     using ex_rcoset_replist by fast
   with assms obtain x where x: "x \<in> set xs" "x \<in> H"
     using rcoset_replist_Hrep by fast
   from x(2) have "(0,x) \<in> rcoset_rel H" using rcoset0[OF assms] by auto
   moreover have "sym (rcoset_rel H)"
     using rcoset_equiv[OF assms] equivE[of G "rcoset_rel H"] by simp
   ultimately have "0 \<in> (rcoset_rel H)``{x}" using sym_def by fast
   with x(1) xs assms show "\<exists>gs. is_rcoset_replist H (0#gs)" 
     using split_list rcoset_replist_reorder rcoset_replist_replacehd by fast
 qed
 
 
 
 
 subsection \<open>Group homomorphisms\<close>
 
 subsubsection \<open>Preliminaries\<close>
 
 definition ker :: "('a\<Rightarrow>'b::zero) \<Rightarrow> 'a set"
   where "ker f = {a. f a = 0}"
 
 lemma kerI : "f a = 0 \<Longrightarrow> a \<in> ker f"
   unfolding ker_def by fast
 
 lemma kerD : "a \<in> ker f \<Longrightarrow> f a = 0"
   unfolding ker_def by fast
 
 lemma ker_im_iff : "(A \<noteq> {} \<and> A \<subseteq> ker f) = (f ` A = 0)"
 proof
   assume A: "A \<noteq> {} \<and> A \<subseteq> ker f"
   show "f ` A = 0"
   proof (rule zeroset_eqI)
     from A obtain a where a: "a \<in> A" by fast
     with A have "f a = 0" using kerD by fastforce
     from this[THEN sym] a show "0 \<in> f ` A" by fast
   next
     fix b assume "b \<in> f ` A"
     from this obtain a where "a \<in> A" "b = f a" by fast
     with A show "b = 0" using kerD by fast
   qed
 next
   assume fA: "f ` A = 0"
   have "A \<noteq> {}"
   proof-
     from fA obtain a where "a \<in> A" "f a = 0" by force
     thus ?thesis by fast
   qed
   moreover have "A \<subseteq> ker f"
   proof
     fix a assume "a \<in> A"
     with fA have "f a = 0" by auto
     thus "a \<in> ker f" using kerI by fast
   qed
   ultimately show "A \<noteq> {} \<and> A \<subseteq> ker f" by fast
 qed
 
 subsubsection \<open>Locales\<close>
 
 text \<open>The \<open>supp\<close> condition is not strictly necessary, but helps with equality
         and uniqueness arguments.\<close>
 
 locale GroupHom = Group G
   for   G :: "'g::group_add set"
 + fixes T :: "'g \<Rightarrow> 'h::group_add"
   assumes hom : "\<And>g g'. g \<in> G \<Longrightarrow> g' \<in> G \<Longrightarrow> T (g + g') = T g + T g'"
   and     supp: "supp T \<subseteq> G" 
 
 abbreviation (in GroupHom) "Ker \<equiv> ker T \<inter> G"
 abbreviation (in GroupHom) "ImG \<equiv> T ` G"
 
 locale GroupEnd = GroupHom G T
   for G :: "'g::group_add set"
   and T :: "'g \<Rightarrow> 'g"
 + assumes endomorph: "ImG \<subseteq> G"
 
 locale GroupIso = GroupHom G T
   for   G :: "'g::group_add set"
   and   T :: "'g \<Rightarrow> 'h::group_add"
 + fixes H :: "'h set"
   assumes bijective: "bij_betw T G H"
 
 subsubsection \<open>Basic facts\<close>
 
 lemma (in Group) trivial_GroupHom : "GroupHom G (0::('g\<Rightarrow>'h::group_add))"
 proof
   fix g g'
   define z z_map where "z = (0::'h)" and "z_map = (0::'g\<Rightarrow>'h)"
   thus "z_map (g + g') = z_map g + z_map g'" by simp
 qed (rule supp_zerofun_subset_any)
 
 lemma (in Group) GroupHom_idhom : "GroupHom G (id\<down>G)"
   using add_closed supp_restrict0 by unfold_locales simp
 
 context GroupHom
 begin
 
 lemma im_zero : "T 0 = 0"
   using zero_closed hom[of 0 0] add_diff_cancel[of "T 0" "T 0"] by simp
 
 lemma zero_in_Ker : "0 \<in> Ker"
   using im_zero kerI zero_closed by fast
 
 lemma comp_zero : "T \<circ> 0 = 0"
   using im_zero by auto
 
 lemma im_neg : "T (- g) = - T g"
   using im_zero hom[of g "- g"] neg_closed[of g] minus_unique[of "T g"]
         neg_closed[of "-g"] supp suppI_contra[of g T] suppI_contra[of "-g" T]
   by    fastforce
 
 lemma im_diff : "g \<in> G \<Longrightarrow> g' \<in> G \<Longrightarrow> T (g - g') = T g - T g'"
   using hom neg_closed hom[of g "-g'"] im_neg by simp
 
 lemma eq_im_imp_diff_in_Ker : "\<lbrakk> g \<in> G; h \<in> G; T g = T h \<rbrakk> \<Longrightarrow> g - h \<in> Ker"
   using im_diff kerI diff_closed[of g h] by force
 
 lemma im_sum_list_prod : 
   "set (map (case_prod f) xys) \<subseteq> G
         \<Longrightarrow> T (\<Sum>(x,y)\<leftarrow>xys. f x y) = (\<Sum>(x,y)\<leftarrow>xys. T (f x y))"
 proof (induct xys)
   case Nil
   show ?case using im_zero by simp
 next
   case (Cons xy xys)
   define Tf where "Tf = T \<circ> (case_prod f)"
   have "T (\<Sum>(x,y)\<leftarrow>(xy#xys). f x y) = T ( (case_prod f) xy + (\<Sum>(x,y)\<leftarrow>xys. f x y) )"
     by simp
   moreover from Cons(2) have "(case_prod f) xy \<in> G" "set (map (case_prod f) xys) \<subseteq> G"
     by auto
   ultimately have "T (\<Sum>(x,y)\<leftarrow>(xy#xys). f x y) = Tf xy + (\<Sum>(x,y)\<leftarrow>xys. Tf (x,y))"
     using Tf_def sum_list_closed[of "case_prod f"] hom Cons by auto
   also have "\<dots> = (\<Sum>(x,y)\<leftarrow>(xy#xys). Tf (x,y))" by simp
   finally show ?case using Tf_def by simp
 qed
 
 lemma distrib_comp_sum_left :
   "range S \<subseteq> G \<Longrightarrow> range S' \<subseteq> G \<Longrightarrow> T \<circ> (S + S') = (T \<circ> S) + (T \<circ> S')"
   using hom by (auto simp add: fun_eq_iff)
 
 lemma Ker_Im_iff : "(Ker = G) = (ImG = 0)"
   using nonempty ker_im_iff[of G T] by fast
 
 lemma Ker0_imp_inj_on :
   assumes "Ker \<subseteq> 0"
   shows   "inj_on T G"
 proof (rule inj_onI)
   fix x y assume xy: "x \<in> G" "y \<in> G" "T x = T y"
   hence "T (x - y) = 0" using im_diff by simp
   with xy(1,2) have "x - y \<in> Ker" using diff_closed kerI by fast
   with assms show "x = y" using zero_in_Ker by auto
 qed
 
 lemma inj_on_imp_Ker0 :
   assumes "inj_on T G"
   shows   "Ker = 0"
   using   zero_in_Ker kerD zero_closed im_zero inj_onD[OF assms]
   by      fastforce
 
 lemma nonzero_Ker_el_imp_n_inj :
   "g \<in> G \<Longrightarrow> g \<noteq> 0 \<Longrightarrow> T g = 0 \<Longrightarrow> \<not> inj_on T G"
   using inj_on_imp_Ker0 kerI[of T] by auto
 
 lemma Group_Ker : "Group Ker"
 proof
   show "Ker \<noteq> {}" using zero_in_Ker by fast
 next
   fix g h assume "g \<in> Ker" "h \<in> Ker" thus "g - h \<in> Ker"
     using im_diff kerD[of g T] kerD[of h T] diff_closed kerI[of T] by auto
 qed
 
 lemma Group_Im : "Group ImG"
 proof
   show "ImG \<noteq> {}" using nonempty by fast
 next
   fix g' h' assume "g' \<in> ImG" "h' \<in> ImG"
   from this obtain g h where gh: "g \<in> G" "g' = T g" "h \<in> G" "h' = T h" by fast
   thus "g' - h' \<in> ImG" using im_diff diff_closed by force
 qed
 
 lemma GroupHom_restrict0_subgroup  :
   assumes "Subgroup H"
   shows   "GroupHom H (T \<down> H)"
 proof (intro_locales, rule SubgroupD1[OF assms], unfold_locales)
   show "supp (T \<down> H) \<subseteq> H" using supp_restrict0 by fast
 next
   fix h h' assume hh': "h \<in> H" "h' \<in> H"
   with assms show "(T \<down> H) (h + h') = (T \<down> H) h + (T \<down> H) h'"
     using Group.add_closed hom[of h h'] by auto
 qed
 
 lemma im_subgroup :
   assumes "Subgroup H"
   shows   "Group.Subgroup ImG (T ` H)"
 proof
   from assms have "Group ((T \<down> H) ` H)"
     using GroupHom_restrict0_subgroup GroupHom.Group_Im by fast
   moreover have "(T \<down> H) ` H = T ` H" by auto
   ultimately show "Group (T ` H)" by simp
   from assms show "T ` H \<subseteq> ImG" by fast
 qed
 
 lemma GroupHom_composite_left :
   assumes "ImG \<subseteq> H" "GroupHom H S"
   shows   "GroupHom G (S \<circ> T)"
 proof
   fix g g' assume "g \<in> G" "g' \<in> G"
   with hom assms(1) show "(S \<circ> T) (g + g') = (S \<circ> T) g + (S \<circ> T) g'"
     using GroupHom.hom[OF assms(2)] by fastforce
 next
   from supp have "\<And>g. g \<notin> G \<Longrightarrow> (S \<circ> T) g = 0"
     using suppI_contra GroupHom.im_zero[OF assms(2)] by fastforce
   thus "supp (S \<circ> T) \<subseteq> G" using suppD_contra by fast
 qed
 
 lemma idhom_left : "T ` G \<subseteq> H \<Longrightarrow> (id\<down>H) \<circ> T = T"
   using supp suppI_contra by fastforce
 
 end (* context GroupHom *)
 
 subsubsection \<open>Basic facts about endomorphisms\<close>
 
 context GroupEnd
 begin
 
 lemmas hom = hom
 
 lemma range : "range T \<subseteq> G"
 proof (rule image_subsetI)
   fix x show "T x \<in> G"
   proof (cases "x \<in> G")
     case True with endomorph show ?thesis by fast
   next
     case False with supp show ?thesis using suppI_contra zero_closed by fastforce
   qed
 qed
 
 lemma proj_decomp :
   assumes "\<And>g. g \<in> G \<Longrightarrow> T (T g) = T g"
   shows   "G = Ker \<oplus> ImG"
 proof (rule inner_dirsum_doubleI, rule subset_antisym, rule subsetI)
   fix g assume g: "g \<in> G"
   have "g = (g - T g) + T g" using diff_add_cancel[of g] by simp
   moreover have "g - T g \<in> Ker"
   proof
     from g endomorph assms have "T (g - T g) = 0" using im_diff by auto
     thus "g - T g \<in> ker T" using kerI by fast
     from g endomorph show "g - T g \<in> G" using diff_closed by fast
   qed
   moreover from g have "T g \<in> ImG" by fast
   ultimately show "g \<in> Ker + ImG"
     using set_plus_intro[of "g - T g" Ker "T g"] by simp
 next
   from endomorph show "G \<supseteq> Ker + ImG" using set_plus_closed by simp
   show "add_independentS [Ker,ImG]"
   proof (rule add_independentS_doubleI)
     fix g h assume gh: "h \<in> ImG" "g \<in> Ker" "g + h = 0"
     from gh(1) obtain g' where "g' \<in> G" "h = T g'" by fast
     with gh(2,3) endomorph assms have "h = 0"
       using im_zero hom[of g "T g'"] kerD by fastforce
     with gh(3) show "g = 0" by simp
   qed
 qed
 
 end (* context GroupEnd *)
 
 subsubsection \<open>Basic facts about isomorphisms\<close>
 
 context GroupIso
 begin
 
 abbreviation "invT \<equiv> (the_inv_into G T) \<down> H"
 
 lemma ImG : "ImG = H" using bijective bij_betw_imp_surj_on by fast
 
 lemma GroupH : "Group H" using ImG Group_Im by fast
 
 lemma invT_onto : "invT ` H = G"
   using bijective bij_betw_imp_inj_on[of T] ImG the_inv_into_onto[of T] by force
 
 lemma inj_on_invT : "inj_on invT H"
   using     bijective bij_betw_imp_inj_on[of T G] ImG inj_on_the_inv_into[of T]
   unfolding inj_on_def
   by        force
 
 lemma bijective_invT : "bij_betw invT H G"
   using inj_on_invT invT_onto unfolding bij_betw_def by fast
 
 lemma invT_into : "h \<in> H \<Longrightarrow> invT h \<in> G"
   using bijective bij_betw_imp_inj_on ImG the_inv_into_into[of T] by force
 
 lemma T_invT : "h \<in> H \<Longrightarrow> T (invT h) = h"
   using bijective bij_betw_imp_inj_on ImG f_the_inv_into_f[of T] by force
 
 lemma invT_eq: "g \<in> G \<Longrightarrow> T g = h \<Longrightarrow> invT h = g"
   using bijective bij_betw_imp_inj_on ImG the_inv_into_f_eq[of T] by force
 
 lemma inv : "GroupIso H invT G"
 proof (intro_locales, rule GroupH, unfold_locales)
   show "supp invT \<subseteq> H" using supp_restrict0 by fast
   show "bij_betw invT H G" using bijective_invT by fast
 next
   fix h h' assume "h \<in> H" "h' \<in> H"
   thus "invT (h + h') = invT h + invT h'"
     using invT_into hom T_invT add_closed invT_eq by simp
 qed
 
 end (* context GroupIso *)
 
 subsubsection \<open>Hom-sets\<close>
 
 definition GroupHomSet :: "'g::group_add set \<Rightarrow> 'h::group_add set \<Rightarrow> ('g \<Rightarrow> 'h) set"
   where "GroupHomSet G H \<equiv> {T. GroupHom G T} \<inter> {T. T ` G \<subseteq> H}"
 
 lemma GroupHomSetI :
   "GroupHom G T \<Longrightarrow> T ` G \<subseteq> H \<Longrightarrow> T \<in> GroupHomSet G H"
   unfolding GroupHomSet_def by fast
 
 lemma GroupHomSetD_GroupHom :
   "T \<in> GroupHomSet G H \<Longrightarrow> GroupHom G T"
   unfolding GroupHomSet_def by fast
 
 lemma GroupHomSetD_Im : "T \<in> GroupHomSet G H \<Longrightarrow> T ` G \<subseteq> H"
   unfolding GroupHomSet_def by fast
 
 lemma (in Group) Group_GroupHomSet :
   fixes   H :: "'h::ab_group_add set"
   assumes "AbGroup H"
   shows   "Group (GroupHomSet G H)"
 proof
   show "GroupHomSet G H \<noteq> {}"
     using trivial_GroupHom AbGroup.zero_closed[OF assms] GroupHomSetI
     by    fastforce
 next
   fix S T assume ST: "S \<in> GroupHomSet G H" "T \<in> GroupHomSet G H"
   show "S - T \<in> GroupHomSet G H"
   proof (rule GroupHomSetI, unfold_locales)
     from ST show "supp (S - T) \<subseteq> G" 
       using GroupHomSetD_GroupHom[of S] GroupHomSetD_GroupHom[of T]
             GroupHom.supp[of G S] GroupHom.supp[of G T]
             supp_diff_subset_union_supp[of S T]
       by    auto
     show "(S - T) ` G \<subseteq> H"
     proof (rule image_subsetI)
       fix g assume "g \<in> G"
       with ST have "S g \<in> H" "T g \<in> H"
         using GroupHomSetD_Im[of S G] GroupHomSetD_Im[of T G] by auto
       thus "(S - T) g \<in> H" using AbGroup.diff_closed[OF assms] by simp
     qed
   next 
     fix g g' assume "g \<in> G" "g' \<in> G"
     with ST show "(S - T) (g + g') = (S - T) g + (S - T) g'"
       using GroupHomSetD_GroupHom[of S] GroupHom.hom[of G S]
             GroupHomSetD_GroupHom[of T] GroupHom.hom[of G T]
       by    simp
   qed
 qed
 
 
 
 
 subsection \<open>Facts about collections of groups\<close>
 
 lemma listset_Group_plus_closed :
   "\<lbrakk> \<forall>G\<in>set Gs. Group G; as \<in> listset Gs; bs \<in> listset Gs\<rbrakk>
                                                 \<Longrightarrow> [a+b. (a,b)\<leftarrow>zip as bs] \<in> listset Gs"
 proof-
   have "\<lbrakk> length as = length bs; length bs = length Gs;
                 as \<in> listset Gs; bs \<in> listset Gs; \<forall>G\<in>set Gs. Group G\<rbrakk>
                                                 \<Longrightarrow> [a+b. (a,b)\<leftarrow>zip as bs] \<in> listset Gs"
   proof (induct as bs Gs rule: list_induct3)
     case (Cons a as b bs G Gs)
     thus "[x+y. (x,y)\<leftarrow>zip (a#as) (b#bs)] \<in> listset (G#Gs)"
       using listset_ConsD[of a] listset_ConsD[of b] Group.add_closed
             listset_ConsI[of "a+b" G]
       by    fastforce
   qed simp
   thus   "\<lbrakk> \<forall>G\<in>set Gs. Group G; as \<in> listset Gs; bs \<in> listset Gs\<rbrakk>
                                                 \<Longrightarrow> [a+b. (a,b)\<leftarrow>zip as bs] \<in> listset Gs"
     using listset_length[of as Gs] listset_length[of bs Gs, THEN sym] by fastforce
 qed
 
 lemma AbGroup_set_plus :
   assumes "AbGroup H" "AbGroup G"
   shows   "AbGroup (H + G)"
 proof
   from assms show "H + G \<noteq> {}" using AbGroup.nonempty by blast
 next
   fix x y assume "x \<in> H + G" "y \<in> H + G"
   from this obtain xh xg yh yg
     where xy: "xh \<in> H" "xg \<in> G" "x = xh + xg" "yh \<in> H" "yg \<in> G" "y = yh + yg"
     unfolding set_plus_def by fast
   hence "x - y = (xh - yh) + (xg - yg)" by simp
   thus "x - y \<in> H + G" using assms xy(1,2,4,5) AbGroup.diff_closed by auto
 qed
 
 lemma AbGroup_sum_list :
   "(\<forall>G\<in>set Gs. AbGroup G) \<Longrightarrow> AbGroup (\<Sum>G\<leftarrow>Gs. G)"
   using trivial_Group AbGroup.intro AbGroup_set_plus
   by    (induct Gs) auto
 
 lemma AbGroup_subset_sum_list :
   "\<forall>G \<in> set Gs. AbGroup G \<Longrightarrow> H \<in> set Gs \<Longrightarrow> H \<subseteq> (\<Sum>G\<leftarrow>Gs. G)"
 proof (induct Gs arbitrary: H)
   case (Cons G Gs)
   show "H \<subseteq> (\<Sum>X\<leftarrow>(G#Gs). X)"
   proof (cases "H = G")
     case True with Cons(2) show ?thesis
       using AbGroup_sum_list AbGroup.subset_plus_left by auto
   next
     case False
     with Cons have "H \<subseteq> (\<Sum>G\<leftarrow>Gs. G)" by simp
     with Cons(2) show ?thesis using AbGroup.subset_plus_right by auto
   qed
 qed simp
 
 lemma independent_AbGroups_pairwise_int0 :
   "\<lbrakk> \<forall>G\<in>set Gs. AbGroup G; add_independentS Gs; G \<in> set Gs; G' \<in> set Gs;
         G \<noteq> G' \<rbrakk> \<Longrightarrow> G \<inter> G' = 0"
 proof (induct Gs arbitrary: G G')
   case (Cons H Hs)
   from Cons(1-3) have "\<And>A B. \<lbrakk> A \<in> set Hs; B \<in> set Hs; A \<noteq> B \<rbrakk> 
                             \<Longrightarrow> A \<inter> B \<subseteq> 0"
     by simp
   moreover have "\<And>A. A \<in> set Hs \<Longrightarrow> A \<noteq> H \<Longrightarrow>  A \<inter> H \<subseteq> 0"
   proof
     fix A g assume A: "A \<in> set Hs" "A \<noteq> H" and g: "g \<in> A \<inter> H"
     from A(1) g Cons(2) have "-g \<in> (\<Sum>X\<leftarrow>Hs. X)"
       using AbGroup.neg_closed AbGroup_subset_sum_list by force
     moreover have "g + (-g) = 0" by simp
     ultimately show "g \<in> 0" using g Cons(3) by simp
   qed
   ultimately have "\<And>A B. \<lbrakk> A \<in> set (H#Hs); B \<in> set (H#Hs); A \<noteq> B \<rbrakk>
                         \<Longrightarrow> A \<inter> B \<subseteq> 0"
     by auto
   with Cons(4-6) have "G \<inter> G' \<subseteq> 0" by fast
   moreover from Cons(2,4,5) have "0 \<subseteq> G \<inter> G'"
     using AbGroup.zero_closed by auto
   ultimately show ?case by fast
 qed simp
 
 lemma independent_AbGroups_pairwise_int0_double :
   assumes "AbGroup G" "AbGroup G'" "add_independentS [G,G']"
   shows   "G \<inter> G' = 0"
 proof (cases "G = 0")
   case True with assms(2) show ?thesis using AbGroup.zero_closed by auto
 next
   case False show ?thesis
   proof (rule independent_AbGroups_pairwise_int0)
     from assms(1,2) show "\<forall>G\<in>set [G,G']. AbGroup G" by simp
     from assms(3) show "add_independentS [G,G']" by fast
     show "G \<in> set [G,G']" "G' \<in> set [G,G']" by auto
     show "G \<noteq> G'"
     proof
       assume GG': "G = G'"
       from False assms(1) obtain g where g: "g \<in> G" "g \<noteq> 0"
         using AbGroup.nonempty by auto
       moreover from assms(2) GG' g(1) have "-g \<in> G'"
         using AbGroup.neg_closed by fast
       moreover have "g + (-g) = 0" by simp
       ultimately show False using assms(3) by force
     qed
   qed
 qed
 
 
 subsection \<open>Inner direct sums of Abelian groups\<close>
 
 subsubsection \<open>General facts\<close>
 
 lemma AbGroup_inner_dirsum :
   "\<forall>G\<in>set Gs. AbGroup G \<Longrightarrow> AbGroup (\<Oplus>G\<leftarrow>Gs. G)"
   using inner_dirsumD[of Gs] inner_dirsumD2[of Gs] AbGroup_sum_list AbGroup.intro
         trivial_Group
   by    (cases "add_independentS Gs") auto
 
 lemma inner_dirsum_double_leftfull_imp_right0:
   assumes "Group A" "B \<noteq> {}" "A = A \<oplus> B"
   shows   "B = 0"
 proof (cases "add_independentS [A,B]")
   case True
   with assms(3) have 1: "A = A + B" using inner_dirsum_doubleD by fast
   have "\<And>b. b \<in> B \<Longrightarrow> b = 0"
   proof-
     fix b assume b: "b \<in> B"
     from assms(1) obtain a where a: "a \<in> A" using Group.nonempty by fast
     with b 1 have "a + b \<in> A" by fast
     from this obtain a' where a': "a' \<in> A" "a + b = a'" by fast
     hence "(-a'+a) + b = 0" by (simp add: add.assoc)
     with assms(1) True a a'(1) b show "b = 0"
       using Group.neg_add_closed[of A] add_independentS_doubleD[of A B b "-a'+a"]
       by    simp
   qed
   with assms(2) show ?thesis by auto
 next
   case False
   hence 1: "A \<oplus> B = 0" unfolding inner_dirsum_def by auto
   moreover with assms(3) have "A = 0" by fast
   ultimately show ?thesis using inner_dirsum_double_left0 by auto
 qed
 
 lemma AbGroup_subset_inner_dirsum :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs; H \<in> set Gs \<rbrakk>
         \<Longrightarrow> H \<subseteq> (\<Oplus>G\<leftarrow>Gs. G)"
   using AbGroup_subset_sum_list inner_dirsumD by fast
 
 lemma AbGroup_nth_subset_inner_dirsum :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs; n < length Gs \<rbrakk>
         \<Longrightarrow> Gs!n \<subseteq> (\<Oplus>G\<leftarrow>Gs. G)"
   using AbGroup_subset_inner_dirsum by force
 
 lemma AbGroup_inner_dirsum_el_decomp_ex1_double :
   assumes "AbGroup G" "AbGroup H" "add_independentS [G,H]" "x \<in> G \<oplus> H"
   shows   "\<exists>!gh. fst gh \<in> G \<and> snd gh \<in> H \<and> x = fst gh + snd gh"
 proof (rule ex_ex1I)
   from assms(3,4) obtain g h where "x = g + h" "g \<in> G" "h \<in> H"
     using inner_dirsum_doubleD set_plus_elim by blast
   from this have 1: "fst (g,h) \<in> G" "snd (g,h) \<in> H" "x = fst (g,h) + snd (g,h)"
     by auto
   thus "\<exists>gh. fst gh \<in> G \<and> snd gh \<in> H \<and> x = fst gh + snd gh" by fast
 next
   fix gh gh' assume A:
     "fst gh  \<in> G \<and> snd gh  \<in> H \<and> x = fst gh  + snd gh "
     "fst gh' \<in> G \<and> snd gh' \<in> H \<and> x = fst gh' + snd gh'"
   show "gh = gh'"
   proof
     from A assms(1,2) have "fst gh - fst gh' \<in> G" "snd gh - snd gh' \<in> H"
       using AbGroup.diff_closed by auto
     moreover from A have z: "(fst gh - fst gh') + (snd gh - snd gh') = 0"
       by (simp add: algebra_simps)
     ultimately show "fst gh = fst gh'"
       using assms(3)
             add_independentS_doubleD[of G H "snd gh - snd gh'" "fst gh - fst gh'"]
       by    simp
     with z show "snd gh = snd gh'" by simp
   qed
 qed
 
 lemma AbGroup_inner_dirsum_el_decomp_ex1 :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs \<rbrakk>
         \<Longrightarrow> \<forall>x \<in> (\<Oplus>G\<leftarrow>Gs. G). \<exists>!gs\<in>listset Gs. x = sum_list gs"
 proof (induct Gs)
   case Nil
   have "\<And>x::'a. x \<in> (\<Oplus>H\<leftarrow>[]. H) \<Longrightarrow> \<exists>!gs\<in>listset []. x = sum_list gs"
   proof
     fix x::'a assume "x \<in> (\<Oplus>G\<leftarrow>[]. G)"
     moreover define f :: "'a \<Rightarrow> 'a list" where "f x = []" for x
     ultimately show "f x \<in> listset [] \<and> x = sum_list (f x)"
       using inner_dirsum_Nil by auto
   next
     fix x::'a and gs
     assume  x: "x \<in> (\<Oplus>G\<leftarrow>[]. G)"
     and    gs: "gs \<in> listset [] \<and> x = sum_list gs"
     thus "gs = []" by simp
   qed
   thus "\<forall>x::'a \<in> (\<Oplus>H\<leftarrow>[]. H). \<exists>!gs\<in>listset []. x = sum_list gs" by fast
 next
   case (Cons G Gs)
   hence prevcase: "\<forall>x\<in>(\<Oplus>H\<leftarrow>Gs. H). \<exists>!gs\<in>listset Gs. x = sum_list gs" by auto
   from Cons(2) have grps: "AbGroup G" "AbGroup (\<Oplus>H\<leftarrow>Gs. H)"
     using AbGroup_inner_dirsum by auto
   from Cons(3) have ind: "add_independentS [G, \<Oplus>H\<leftarrow>Gs. H]"
     using add_independentS_Cons_conv_dirsum_right by fast
   have "\<And>x. x \<in> (\<Oplus>H\<leftarrow>(G#Gs). H) \<Longrightarrow> \<exists>!gs\<in>listset (G#Gs). x = sum_list gs"
   proof (rule ex_ex1I)
     fix x assume "x \<in> (\<Oplus>H\<leftarrow>(G#Gs). H)"
     with Cons(3) have "x \<in> G \<oplus> (\<Oplus>H\<leftarrow>Gs. H)"
       using inner_dirsum_Cons by fast
     with grps ind obtain gh
       where gh: "fst gh \<in> G" "snd gh \<in> (\<Oplus>H\<leftarrow>Gs. H)" "x = fst gh + snd gh"
       using AbGroup_inner_dirsum_el_decomp_ex1_double
       by    blast
     from gh(2) prevcase obtain gs where gs: "gs \<in> listset Gs" "snd gh = sum_list gs"
       by fast
     with gh(1) gs(1) have "fst gh # gs \<in> listset (G#Gs)"
       using set_Cons_def by fastforce
     moreover from gh(3) gs(2) have "x = sum_list (fst gh # gs)" by simp
     ultimately show "\<exists>gs. gs \<in> listset (G#Gs) \<and> x = sum_list gs" by fast
   next
     fix x gs hs
     assume "x \<in> (\<Oplus>H\<leftarrow>(G#Gs). H)"
       and gs: "gs \<in> listset (G#Gs) \<and> x = sum_list gs"
       and hs: "hs \<in> listset (G#Gs) \<and> x = sum_list hs"
     hence "gs \<in> set_Cons G (listset Gs)" "hs \<in> set_Cons G (listset Gs)" by auto
     from this obtain a as b bs
       where     a_as: "gs = a#as" "a\<in>G" "as \<in> listset Gs"
       and       b_bs: "hs = b#bs" "b\<in>G" "bs \<in> listset Gs"
       unfolding set_Cons_def
       by        fast
     from a_as(3) b_bs(3) Cons(3) 
       have  as: "sum_list as \<in> (\<Oplus>H\<leftarrow>Gs. H)" and bs: "sum_list bs \<in> (\<Oplus>H\<leftarrow>Gs. H)"
       using sum_list_listset_dirsum
       by    auto
     with a_as(2) b_bs(2) grps
       have  "a - b \<in> G" "sum_list as - sum_list bs \<in> (\<Oplus>H\<leftarrow>Gs. H)"
       using AbGroup.diff_closed
       by    auto
     moreover from gs hs a_as(1) b_bs(1)
       have z: "(a - b) + (sum_list as - sum_list bs) = 0"
       by   (simp add: algebra_simps)
     ultimately have "a - b = 0" using ind add_independentS_doubleD by blast
     with z have 1: "a = b" and z': "sum_list as = sum_list bs" by auto
     from z' prevcase as a_as(3) bs b_bs(3) have 2: "as = bs" by fast
     from 1 2 a_as(1) b_bs(1) show "gs = hs" by fast
   qed
   thus "\<forall>x\<in>(\<Oplus>H\<leftarrow>(G#Gs). H). \<exists>!gs. gs \<in> listset (G#Gs) \<and> x = sum_list gs"
     by fast
 qed
 
 lemma AbGroup_inner_dirsum_pairwise_int0 :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs; G \<in> set Gs; G' \<in> set Gs;
         G \<noteq> G' \<rbrakk> \<Longrightarrow> G \<inter> G' = 0"
 proof (induct Gs arbitrary: G G')
   case (Cons H Hs)
   from Cons(1-3) have "\<And>A B. \<lbrakk> A \<in> set Hs; B \<in> set Hs; A \<noteq> B \<rbrakk> 
                             \<Longrightarrow> A \<inter> B \<subseteq> 0"
     by simp
   moreover have "\<And>A. A \<in> set Hs \<Longrightarrow> A \<noteq> H \<Longrightarrow>  A \<inter> H \<subseteq> 0"
   proof
     fix A g assume A: "A \<in> set Hs" "A \<noteq> H" and g: "g \<in> A \<inter> H"
     from A(1) g Cons(2) have "-g \<in> (\<Sum>X\<leftarrow>Hs. X)"
       using AbGroup.neg_closed AbGroup_subset_sum_list by force
     moreover have "g + (-g) = 0" by simp
     ultimately show "g \<in> 0" using g Cons(3) by simp
   qed
   ultimately have "\<And>A B. \<lbrakk> A \<in> set (H#Hs); B \<in> set (H#Hs); A \<noteq> B \<rbrakk> 
                         \<Longrightarrow> A \<inter> B \<subseteq> 0"
     by auto
   with Cons(4-6) have "G \<inter> G' \<subseteq> 0" by fast
   moreover from Cons(2,4,5) have "0 \<subseteq> G \<inter> G'"
     using AbGroup.zero_closed by auto
   ultimately show ?case by fast
 qed simp
 
 lemma AbGroup_inner_dirsum_pairwise_int0_double :
   assumes "AbGroup G" "AbGroup G'" "add_independentS [G,G']"
   shows   "G \<inter> G' = 0"
 proof (cases "G = 0")
   case True with assms(2) show ?thesis using AbGroup.zero_closed by auto
 next
   case False show ?thesis
   proof (rule AbGroup_inner_dirsum_pairwise_int0)
     from assms(1,2) show "\<forall>G\<in>set [G,G']. AbGroup G" by simp
     from assms(3) show "add_independentS [G,G']" by fast
     show "G \<in> set [G,G']" "G' \<in> set [G,G']" by auto
     show "G \<noteq> G'"
     proof
       assume GG': "G = G'"
       from False assms(1) obtain g where g: "g \<in> G" "g \<noteq> 0"
         using AbGroup.nonempty by auto
       moreover from assms(2) GG' g(1) have "-g \<in> G'"
         using AbGroup.neg_closed by fast
       moreover have "g + (-g) = 0" by simp
       ultimately show False using assms(3) by force
     qed
   qed
 qed
 
 subsubsection \<open>Element decomposition and projection\<close>
 
 definition inner_dirsum_el_decomp ::
   "'g::ab_group_add set list \<Rightarrow> ('g \<Rightarrow> 'g list)" ("\<Oplus>_\<leftarrow>")
   where "\<Oplus>Gs\<leftarrow> = (\<lambda>x. if x \<in> (\<Oplus>G\<leftarrow>Gs. G)
               then THE gs. gs \<in> listset Gs \<and> x = sum_list gs else [])"
 
 abbreviation inner_dirsum_el_decomp_double ::
   "'g::ab_group_add set \<Rightarrow> 'g set \<Rightarrow> ('g \<Rightarrow> 'g list)" ("_\<oplus>_\<leftarrow>") where "G\<oplus>H\<leftarrow> \<equiv> \<Oplus>[G,H]\<leftarrow>"
 
 abbreviation inner_dirsum_el_decomp_nth ::
   "'g::ab_group_add set list \<Rightarrow> nat \<Rightarrow> ('g \<Rightarrow> 'g)" ("\<Oplus>_\<down>_")
   where "\<Oplus>Gs\<down>n \<equiv> restrict0 (\<lambda>x. (\<Oplus>Gs\<leftarrow>x)!n) (\<Oplus>G\<leftarrow>Gs. G)"
 
 lemma AbGroup_inner_dirsum_el_decompI :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs; x \<in> (\<Oplus>G\<leftarrow>Gs. G) \<rbrakk>
         \<Longrightarrow> (\<Oplus>Gs\<leftarrow>x) \<in> listset Gs \<and> x = sum_list (\<Oplus>Gs\<leftarrow>x)"
   using     AbGroup_inner_dirsum_el_decomp_ex1 theI'[
               of "\<lambda>gs. gs \<in> listset Gs \<and> x = sum_list gs"
             ]
   unfolding inner_dirsum_el_decomp_def
   by        fastforce
 
 lemma (in AbGroup) abSubgroup_inner_dirsum_el_decomp_set :
   "\<lbrakk> \<forall>H \<in> set Hs. Subgroup H; add_independentS Hs; x \<in> (\<Oplus>H\<leftarrow>Hs. H) \<rbrakk>
     \<Longrightarrow> set (\<Oplus>Hs\<leftarrow>x) \<subseteq> G"
   using AbGroup.intro AbGroup_inner_dirsum_el_decompI[of Hs x]
         set_listset_el_subset[of "(\<Oplus>Hs\<leftarrow>x)" Hs G]
   by    fast
 
 lemma AbGroup_inner_dirsum_el_decomp_eq :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs; x \<in> (\<Oplus>G\<leftarrow>Gs. G);
         gs \<in> listset Gs; x = sum_list gs \<rbrakk> \<Longrightarrow> (\<Oplus>Gs\<leftarrow>x) = gs"
   using AbGroup_inner_dirsum_el_decomp_ex1[of Gs]
         inner_dirsum_el_decomp_def[of Gs]
   by    force
 
 lemma AbGroup_inner_dirsum_el_decomp_plus :
   assumes "\<forall>G \<in> set Gs. AbGroup G" "add_independentS Gs" "x \<in> (\<Oplus>G\<leftarrow>Gs. G)"
           "y \<in> (\<Oplus>G\<leftarrow>Gs. G)"
   shows   "(\<Oplus>Gs\<leftarrow>(x+y)) = [a+b. (a,b)\<leftarrow>zip (\<Oplus>Gs\<leftarrow>x) (\<Oplus>Gs\<leftarrow>y)]"
 proof-
   define xs ys where "xs = (\<Oplus>Gs\<leftarrow>x)" and "ys = (\<Oplus>Gs\<leftarrow>y)"
   with assms
     have  xy: "xs \<in> listset Gs" "x = sum_list xs" "ys \<in> listset Gs" "y = sum_list ys"
     using AbGroup_inner_dirsum_el_decompI
     by    auto
   from assms(1) xy(1,3) have "[a+b. (a,b)\<leftarrow>zip xs ys] \<in> listset Gs"
     using AbGroup.axioms listset_Group_plus_closed by fast
   moreover from xy have "x + y = sum_list [a+b. (a,b)\<leftarrow>zip xs ys]"
     using listset_length[of xs Gs] listset_length[of ys Gs, THEN sym] sum_list_plus
     by    simp
   ultimately show "(\<Oplus>Gs\<leftarrow>(x+y)) = [a+b. (a,b)\<leftarrow>zip xs ys]"
     using assms AbGroup_inner_dirsum AbGroup.add_closed
           AbGroup_inner_dirsum_el_decomp_eq
     by    fast
 qed
 
 lemma AbGroup_length_inner_dirsum_el_decomp :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs; x \<in> (\<Oplus>G\<leftarrow>Gs. G) \<rbrakk>
         \<Longrightarrow> length (\<Oplus>Gs\<leftarrow>x) = length Gs"
   using AbGroup_inner_dirsum_el_decompI listset_length by fastforce
 
 lemma AbGroup_inner_dirsum_el_decomp_in_nth :
   assumes "\<forall>G \<in> set Gs. AbGroup G" "add_independentS Gs" "n < length Gs"
           "x \<in> Gs!n"
   shows   "(\<Oplus>Gs\<leftarrow>x) = (replicate (length Gs) 0)[n := x]"
 proof-
   from assms have x: "x \<in> (\<Oplus>G\<leftarrow>Gs. G)"
     using AbGroup_nth_subset_inner_dirsum by fast
   define xgs where "xgs = (replicate (length Gs) (0::'a))[n := x]"
   hence "length xgs = length Gs" by simp
   moreover have "\<forall>k<length xgs. xgs!k \<in> Gs!k"
   proof-
     have "\<And>k. k < length xgs \<Longrightarrow> xgs!k \<in> Gs!k"
     proof-
       fix k assume "k < length xgs"
       with assms(1,4) xgs_def show "xgs!k \<in> Gs!k" 
         using AbGroup.zero_closed[of "Gs!k"] by (cases "k = n") auto
     qed
     thus ?thesis by fast
   qed
   ultimately have "xgs \<in> listset Gs" using listsetI_nth by fast
   moreover from xgs_def assms(3) have "x = sum_list xgs"
     using sum_list_update[of n "replicate (length Gs) 0" x] nth_replicate sum_list_replicate0
     by    simp
   ultimately show "(\<Oplus>Gs\<leftarrow>x) = xgs"
     using assms(1,2) x xgs_def AbGroup_inner_dirsum_el_decomp_eq by fast
 qed
 
 lemma AbGroup_inner_dirsum_el_decomp_nth_in_nth :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs; k < length Gs;
         n < length Gs; x \<in> Gs!n \<rbrakk> \<Longrightarrow> (\<Oplus>Gs\<down>k) x = (if k = n then x else 0)"
   using AbGroup_nth_subset_inner_dirsum
         AbGroup_inner_dirsum_el_decomp_in_nth[of Gs n x]
   by    auto
 
 lemma AbGroup_inner_dirsum_el_decomp_nth_id_on_nth :
   "\<lbrakk> \<forall>G \<in> set Gs. AbGroup G; add_independentS Gs; n < length Gs; x \<in> Gs!n \<rbrakk> 
         \<Longrightarrow> (\<Oplus>Gs\<down>n) x = x"
   using AbGroup_inner_dirsum_el_decomp_nth_in_nth by fastforce
 
 lemma AbGroup_inner_dirsum_el_decomp_nth_onto_nth :
   assumes "\<forall>G \<in> set Gs. AbGroup G" "add_independentS Gs" "n < length Gs"
   shows   "(\<Oplus>Gs\<down>n) ` (\<Oplus>G\<leftarrow>Gs. G) = Gs!n"
 proof
   from assms show "(\<Oplus>Gs\<down>n) ` (\<Oplus>G\<leftarrow>Gs. G) \<supseteq> Gs!n"
     using AbGroup_nth_subset_inner_dirsum[of Gs n]
           AbGroup_inner_dirsum_el_decomp_nth_id_on_nth[of Gs n]
     by    force
   from assms show "(\<Oplus>Gs\<down>n) ` (\<Oplus>G\<leftarrow>Gs. G) \<subseteq> Gs!n"
       using AbGroup_inner_dirsum_el_decompI listset_length listsetD_nth by fastforce
 qed
 
 lemma AbGroup_inner_dirsum_subset_proj_eq_0 :
   assumes "Gs \<noteq> []" "\<forall>G \<in> set Gs. AbGroup G" "add_independentS Gs"
           "X \<subseteq> (\<Oplus>G\<leftarrow>Gs. G)" "\<forall>i < length Gs. (\<Oplus>Gs\<down>i) ` X = 0"
   shows   "X = 0"
 proof-
   have "X \<subseteq> 0"
   proof
     fix x assume x: "x \<in> X"
     with assms(2-4) have "x = (\<Sum>i=0..< length Gs. (\<Oplus>Gs\<down>i) x)"
       using AbGroup_inner_dirsum_el_decompI sum_list_sum_nth[of "(\<Oplus>Gs\<leftarrow>x)"]
             AbGroup_length_inner_dirsum_el_decomp
       by    fastforce
     moreover from x assms(5) have "\<forall>i<length Gs. (\<Oplus>Gs\<down>i) x = 0" by auto
     ultimately show "x \<in> 0" by simp
   qed
   moreover from assms(1,5) have "X \<noteq> {}" by auto
   ultimately show ?thesis by auto
 qed
 
 lemma GroupEnd_inner_dirsum_el_decomp_nth :
   assumes "\<forall>G \<in> set Gs. AbGroup G" "add_independentS Gs" "n < length Gs"
   shows   "GroupEnd (\<Oplus>G\<leftarrow>Gs. G) (\<Oplus>Gs\<down>n)"
 proof (intro_locales)
   from assms(1) show grp: "Group (\<Oplus>G\<leftarrow>Gs. G)"
     using AbGroup_inner_dirsum AbGroup.axioms by fast
   show "GroupHom_axioms (\<Oplus>G\<leftarrow>Gs. G) \<Oplus>Gs\<down>n"
   proof
     show "supp (\<Oplus>Gs\<down>n) \<subseteq> (\<Oplus>G\<leftarrow>Gs. G)" using supp_restrict0 by fast
   next
     fix x y assume xy: "x \<in> (\<Oplus>G\<leftarrow>Gs. G)" "y \<in> (\<Oplus>G\<leftarrow>Gs. G)"
     with assms(1,2) have "(\<Oplus>Gs\<leftarrow>(x+y)) = [x+y. (x,y)\<leftarrow>zip (\<Oplus>Gs\<leftarrow>x) (\<Oplus>Gs\<leftarrow>y)]"
       using AbGroup_inner_dirsum_el_decomp_plus by fast
     hence "(\<Oplus>Gs\<leftarrow>(x+y)) = map (case_prod (+)) (zip (\<Oplus>Gs\<leftarrow>x) (\<Oplus>Gs\<leftarrow>y))"
       using concat_map_split_eq_map_split_zip by simp
     moreover from assms xy
       have  "n < length (\<Oplus>Gs\<leftarrow>x)" "n < length (\<Oplus>Gs\<leftarrow>y)"
             "n < length (zip (\<Oplus>Gs\<leftarrow>x) (\<Oplus>Gs\<leftarrow>y))"
       using AbGroup_length_inner_dirsum_el_decomp[of Gs x]
             AbGroup_length_inner_dirsum_el_decomp[of Gs y]
       by    auto
     ultimately show "(\<Oplus>Gs\<down>n) (x + y) = (\<Oplus>Gs\<down>n) x + (\<Oplus>Gs\<down>n) y"
       using xy assms(1) AbGroup_inner_dirsum
             AbGroup.add_closed[of "\<Oplus>G\<leftarrow>Gs. G"]
       by    auto
   qed
   show "GroupEnd_axioms (\<Oplus>G\<leftarrow>Gs. G) \<Oplus>Gs\<down>n"
     using assms AbGroup_inner_dirsum_el_decomp_nth_onto_nth AbGroup_nth_subset_inner_dirsum
     by    unfold_locales fast
 qed
 
 
 subsection \<open>Rings\<close>
 
 subsubsection \<open>Preliminaries\<close>
 
 lemma (in ring_1) map_times_neg1_eq_map_uminus : "[(-1)*r. r\<leftarrow>rs] = [-r. r\<leftarrow>rs]"
   using map_eq_conv by simp
 
 subsubsection \<open>Locale and basic facts\<close>
 
 text \<open>Define a \<open>Ring1\<close> to be a multiplicatively closed additive subgroup of @{term UNIV} for
         the \<open>ring_1\<close> class.\<close>
 
 (* Don't need to use AbGroup for R because ring_1 already assumes add_commute *)
 locale Ring1 = Group R
   for R :: "'r::ring_1 set"
 + assumes one_closed : "1 \<in> R"
   and     mult_closed: "\<And>r s. r \<in> R \<Longrightarrow> s \<in> R \<Longrightarrow> r * s \<in> R"
 begin
 
 lemma AbGroup : "AbGroup R"
   using Ring1_axioms Ring1.axioms(1) AbGroup.intro by fast
 
 lemmas zero_closed         = zero_closed
 lemmas add_closed          = add_closed
 lemmas neg_closed          = neg_closed
 lemmas diff_closed         = diff_closed
 lemmas zip_add_closed      = zip_add_closed
 lemmas sum_closed       = AbGroup.sum_closed[OF AbGroup]
 lemmas sum_list_closed      = sum_list_closed
 lemmas sum_list_closed_prod = sum_list_closed_prod
 lemmas list_diff_closed    = list_diff_closed
 
 abbreviation Subring1 :: "'r set \<Rightarrow> bool" where "Subring1 S \<equiv> Ring1 S \<and> S \<subseteq> R"
 
 lemma Subring1D1 : "Subring1 S \<Longrightarrow> Ring1 S" by fast
 
 end (* context Ring1 *)
 
 lemma (in ring_1) full_Ring1 : "Ring1 UNIV" 
   by unfold_locales auto
 
 
 subsection \<open>The group ring\<close>
 
 subsubsection \<open>Definition and basic facts\<close>
 
 text \<open>
   Realize the group ring as the set of almost-every-zero functions from group to ring. One can
   recover the usual notion of group ring element by considering such a function to send group
   elements to their coefficients. Here the codomain of such functions is not restricted to some
   \<open>Ring1\<close> subset since we will not be interested in having the ability to change the ring of
   scalars for a group ring.
 \<close>
 
 context Group
 begin
 
 abbreviation group_ring :: "('a::zero, 'g) aezfun set"
   where "group_ring \<equiv> aezfun_setspan G"
 
 lemmas group_ringD = aezfun_setspan_def[of G]
 
 lemma RG_one_closed : "(1::('r::zero_neq_one,'g) aezfun) \<in> group_ring"
 proof-
   have "supp (aezfun (1::('r,'g) aezfun)) \<subseteq> G"
     using supp_aezfun1 zeroS_closed by fast
   thus ?thesis using group_ringD by fast
 qed
 
 lemma RG_zero_closed : "(0::('r::zero,'g) aezfun) \<in> group_ring"
 proof-
   have "aezfun (0::('r,'g) aezfun) = (0::'g\<Rightarrow>'r)" using zero_aezfun.rep_eq by fast
   hence "supp (aezfun (0::('r,'g) aezfun)) = supp (0::'g\<Rightarrow>'r)" by simp
   moreover have "supp (0::'g\<Rightarrow>'r) \<subseteq> G" using supp_zerofun_subset_any by fast
   ultimately show ?thesis using group_ringD by fast
 qed
 
 lemma RG_n0 : "group_ring \<noteq> (0::('r::zero_neq_one, 'g) aezfun set)"
   using RG_one_closed zero_neq_one by force
 
 lemma RG_mult_closed :
   defines RG: "RG \<equiv> group_ring :: ('r::ring_1, 'g) aezfun set"
   shows   "x \<in> RG \<Longrightarrow> y \<in> RG \<Longrightarrow> x * y \<in> RG"
   using   RG supp_aezfun_times[of x y]
           set_plus_closed[of "supp (aezfun x)" "supp (aezfun y)"]
           group_ringD
   by      blast
 
 lemma Ring1_RG :
   defines RG: "RG \<equiv> group_ring :: ('r::ring_1, 'g) aezfun set"
   shows   "Ring1 RG"
 proof
   from RG show "RG \<noteq> {}" "1 \<in> RG" "\<And>x y. x \<in> RG \<Longrightarrow> y \<in> RG \<Longrightarrow> x * y \<in> RG"
     using RG_one_closed RG_mult_closed by auto
 next
   fix x y assume "x \<in> RG" "y \<in> RG"
   with RG show "x - y \<in> RG" using supp_aezfun_diff[of x y] group_ringD by blast
 qed
 
 lemma RG_aezdeltafun_closed :
   defines RG: "RG \<equiv> group_ring :: ('r::ring_1, 'g) aezfun set"
   assumes "g \<in> G"
   shows   "r \<delta>\<delta> g \<in> RG"
 proof-
   have supp: "supp (aezfun (r \<delta>\<delta> g)) = supp (r \<delta> g)"
     using aezdeltafun arg_cong[of _ _ "supp"] by fast
   have "supp (aezfun (r \<delta>\<delta> g)) \<subseteq> G"
   proof (cases "r = 0")
     case True with supp show ?thesis using supp_delta0fun by fast
   next
     case False with assms supp show ?thesis using supp_deltafun[of r g] by fast
   qed
   with RG show ?thesis using group_ringD by fast
 qed
 
 lemma RG_aezdelta0fun_closed : "(r::'r::ring_1) \<delta>\<delta> 0 \<in> group_ring"
   using zero_closed RG_aezdeltafun_closed[of 0] by fast
 
 lemma RG_sum_list_rddg_closed :
   defines RG: "RG \<equiv> group_ring :: ('r::ring_1, 'g) aezfun set"
   assumes "set (map snd rgs) \<subseteq> G"
   shows   "(\<Sum>(r,g)\<leftarrow>rgs. r \<delta>\<delta> g) \<in> RG"
 proof (rule Ring1.sum_list_closed_prod)
   from RG show "Ring1 RG" using Ring1_RG by fast
   from assms show "set (map (case_prod aezdeltafun) rgs) \<subseteq> RG"
     using RG_aezdeltafun_closed by fastforce
 qed
 
 lemmas RG_el_decomp_aezdeltafun = aezfun_setspan_el_decomp_aezdeltafun[of _ G]
 
 lemma Subgroup_imp_Subring :
   fixes   H  :: "'g set"
   and     FH :: "('r::ring_1,'g) aezfun set"
   and     FG :: "('r,'g) aezfun set"
   defines "FH \<equiv> Group.group_ring H"
   and     "FG \<equiv> group_ring"
   shows   "Subgroup H \<Longrightarrow> Ring1.Subring1 FG FH"
   using   assms Group.Ring1_RG Group.RG_el_decomp_aezdeltafun RG_sum_list_rddg_closed
   by      fast
 
 end (* context Group *)
 
 lemma (in FinGroup) group_ring_spanning_set :
   "\<exists>gs. distinct gs \<and> set gs = G
         \<and> (\<forall>f\<in> (group_ring :: ('b::semiring_1, 'g) aezfun set). \<exists>bs.
           length bs = length gs \<and> f = (\<Sum>(b,g)\<leftarrow>zip bs gs. (b \<delta>\<delta> 0) * (1 \<delta>\<delta> g)) )"
   using     finite aezfun_common_supp_spanning_set_decomp[of G] group_ringD
   by        fast
 
 subsubsection \<open>Projecting almost-everywhere-zero functions onto a group ring\<close>
 
 context Group
 begin
 
 abbreviation "RG_proj \<equiv> aezfun_setspan_proj G"
 
 lemmas RG_proj_in_RG        = aezfun_setspan_proj_in_setspan
 lemmas RG_proj_sum_list_prod = aezfun_setspan_proj_sum_list_prod[of G]
 
 lemma RG_proj_mult_leftdelta' :
   fixes   r s :: "'r::{comm_monoid_add,mult_zero}"
   shows   "g \<in> G \<Longrightarrow> RG_proj (r \<delta>\<delta> g * (s \<delta>\<delta> g')) = r \<delta>\<delta> g * RG_proj (s \<delta>\<delta> g')"
   using   add_closed add_closed_inverse_right times_aezdeltafun_aezdeltafun[of r g]
           aezfun_setspan_proj_aezdeltafun[of G "r*s"]
           aezfun_setspan_proj_aezdeltafun[of G s]
   by      simp
 
 lemma RG_proj_mult_leftdelta :
   fixes   r :: "'r::semiring_1"
   assumes "g \<in> G"
   shows   "RG_proj ((r \<delta>\<delta> g) * x) = r \<delta>\<delta> g * RG_proj x"
 proof-                                                                                
   from aezfun_decomp_aezdeltafun obtain rgs
     where rgs: "x = (\<Sum>(s,h)\<leftarrow>rgs. s \<delta>\<delta> h)"
     using RG_el_decomp_aezdeltafun
     by    fast
   hence "RG_proj ((r \<delta>\<delta> g) * x) = (\<Sum>(s,h)\<leftarrow>rgs. RG_proj ((r \<delta>\<delta> g) * (s \<delta>\<delta> h)))"
     using sum_list_const_mult_prod[of "r \<delta>\<delta> g" "\<lambda>s h. s \<delta>\<delta> h"] RG_proj_sum_list_prod
     by    simp
   also from assms rgs have "\<dots> = (r \<delta>\<delta> g) * RG_proj x"
     using RG_proj_mult_leftdelta'[of g r]
           sum_list_const_mult_prod[of "r \<delta>\<delta> g" "\<lambda>s h. RG_proj (s \<delta>\<delta> h)"]
           RG_proj_sum_list_prod[of "\<lambda>s h. s \<delta>\<delta> h" rgs]
     by    simp
   finally show ?thesis by fast
 qed
 
 lemma RG_proj_mult_rightdelta' :
   fixes   r s :: "'r::{comm_monoid_add,mult_zero}"
   assumes "g' \<in> G"
   shows   "RG_proj (r \<delta>\<delta> g * (s \<delta>\<delta> g')) = RG_proj (r \<delta>\<delta> g) * (s \<delta>\<delta> g')"
   using   assms times_aezdeltafun_aezdeltafun[of r g]
           aezfun_setspan_proj_aezdeltafun[of G "r*s"]
           add_closed add_closed_inverse_left aezfun_setspan_proj_aezdeltafun[of G r]
   by      simp
 
 lemma RG_proj_mult_rightdelta :
   fixes   r :: "'r::semiring_1"
   assumes "g \<in> G"
   shows   "RG_proj (x * (r \<delta>\<delta> g)) = (RG_proj x) * (r \<delta>\<delta> g)"
 proof-
   from aezfun_decomp_aezdeltafun obtain rgs
     where rgs: "x = (\<Sum>(s,h)\<leftarrow>rgs. s \<delta>\<delta> h)"
     using RG_el_decomp_aezdeltafun
     by    fast
   hence "RG_proj (x * (r \<delta>\<delta> g)) = (\<Sum>(s,h)\<leftarrow>rgs. RG_proj ((s \<delta>\<delta> h) * (r \<delta>\<delta> g)))"
     using sum_list_mult_const_prod[of "\<lambda>s h. s \<delta>\<delta> h" rgs] RG_proj_sum_list_prod
     by    simp
   with assms rgs show ?thesis
     using RG_proj_mult_rightdelta'[of g _ _ r]
           sum_list_prod_cong[of
             rgs "\<lambda>s h. RG_proj ((s \<delta>\<delta> h) * (r \<delta>\<delta> g))"
             "\<lambda>s h. RG_proj (s \<delta>\<delta> h) * (r \<delta>\<delta> g)"
           ]
           sum_list_mult_const_prod[of "\<lambda>s h. RG_proj (s \<delta>\<delta> h)" rgs]
           RG_proj_sum_list_prod[of "\<lambda>s h. s \<delta>\<delta> h" rgs]
           sum_list_mult_const_prod[of "\<lambda>s h. RG_proj (s \<delta>\<delta> h)" rgs "r \<delta>\<delta> g"]
           RG_proj_sum_list_prod[of "\<lambda>s h. s \<delta>\<delta> h" rgs]
     by    simp
 qed
 
 lemma RG_proj_mult_right :
   "x \<in> (group_ring :: ('r::ring_1, 'g) aezfun set)
         \<Longrightarrow> RG_proj (y * x) = RG_proj y * x"
   using RG_el_decomp_aezdeltafun sum_list_const_mult_prod[of y "\<lambda>r g. r \<delta>\<delta> g"]
         RG_proj_sum_list_prod[of "\<lambda>r g. y * (r \<delta>\<delta> g)"] RG_proj_mult_rightdelta[of _ y]
         sum_list_prod_cong[
           of _ "\<lambda>r g. RG_proj (y * (r \<delta>\<delta> g))" "\<lambda>r g. RG_proj y * (r \<delta>\<delta> g)"
         ]
         sum_list_const_mult_prod[of "RG_proj y" "\<lambda>r g. r \<delta>\<delta> g"]
   by    fastforce
 
 end (* context Group *)
 
 
 section \<open>Modules\<close>
 
 
 subsection \<open>Locales and basic facts\<close>
 
 subsubsection \<open>Locales\<close>
 
 locale scalar_mult =
   fixes smult :: "'r::ring_1 \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
 
 locale R_scalar_mult = scalar_mult smult + Ring1 R
   for R     :: "'r::ring_1 set"
   and smult :: "'r \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
 
 lemma (in scalar_mult) R_scalar_mult : "R_scalar_mult UNIV"
   using full_Ring1 R_scalar_mult.intro by fast
 
 lemma (in R_scalar_mult) Ring1 : "Ring1 R" ..
 
 locale RModule = R_scalars?: R_scalar_mult R smult + VecGroup?: Group M
   for R     :: "'r::ring_1 set"
   and smult :: "'r \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
   and M     :: "'m set"
 + assumes smult_closed : "\<lbrakk> r \<in> R; m \<in> M \<rbrakk> \<Longrightarrow> r \<cdot> m \<in> M"
   and smult_distrib_left  [simp] : "\<lbrakk> r \<in> R; m \<in> M; n \<in> M \<rbrakk>
                                           \<Longrightarrow> r \<cdot> (m + n) = r \<cdot> m + r \<cdot> n"
   and smult_distrib_right [simp] : "\<lbrakk> r \<in> R; s \<in> R; m \<in> M \<rbrakk>
                                           \<Longrightarrow> (r + s) \<cdot> m = r \<cdot> m + s \<cdot> m"
   and smult_assoc [simp] : "\<lbrakk> r \<in> R; s \<in> R; m \<in> M \<rbrakk>
                                   \<Longrightarrow> r \<cdot> s \<cdot> m = (r * s) \<cdot> m"
   and one_smult [simp] : "m \<in> M \<Longrightarrow> 1 \<cdot> m = m"
 
 lemmas RModuleI = RModule.intro[OF R_scalar_mult.intro]
 
 locale Module = RModule UNIV smult M
   for smult :: "'r::ring_1 \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
   and M     :: "'m set"
 
 lemmas ModuleI = RModuleI[of UNIV, OF full_Ring1, THEN Module.intro]
 
 subsubsection \<open>Basic facts\<close>
 
 lemma trivial_RModule :
   fixes   smult :: "'r::ring_1 \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)  
   assumes "Ring1 R" "\<forall>r\<in>R. smult r (0::'m::ab_group_add) = 0"
   shows   "RModule R smult (0::'m set)"
 proof (rule RModuleI, rule assms(1), rule trivial_Group, unfold_locales)
   define Z where "Z = (0::'m set)"
   fix r s m n assume rsmn: "r \<in> R" "s \<in> R" "m \<in> Z" "n \<in> Z"
   from rsmn(1,3) Z_def assms(2) show "r \<cdot> m \<in> Z" by simp
   from rsmn(1,3,4) Z_def assms(2) show "r \<cdot> (m+n) = r \<cdot> m + r \<cdot> n" by simp
   from rsmn(1-3) Z_def assms show "(r + s) \<cdot> m = r \<cdot> m + s \<cdot> m"
     using Ring1.add_closed by auto
   from rsmn(1-3) Z_def assms show "r \<cdot> (s \<cdot> m) = (r*s) \<cdot> m"
     using Ring1.mult_closed by auto
 next
   define Z where "Z = (0::'m set)"
   fix m assume "m \<in> Z" with Z_def assms show "1 \<cdot> m = m"
     using Ring1.one_closed by auto
 qed
 
 context RModule
 begin
 
 abbreviation RSubmodule :: "'m set \<Rightarrow> bool"
   where "RSubmodule N \<equiv> RModule R smult N \<and> N \<subseteq> M"
 
 lemma Group : "Group M"
   using RModule_axioms RModule.axioms(2) by fast
 
 lemma Subgroup_RSubmodule : "RSubmodule N \<Longrightarrow> Subgroup N"
   using RModule.Group by fast
 
 lemma AbGroup : "AbGroup M"
   using AbGroup.intro Group by fast
 
 lemmas zero_closed     = zero_closed
 lemmas diff_closed     = diff_closed
 lemmas set_plus_closed = set_plus_closed
 lemmas sum_closed   = AbGroup.sum_closed[OF AbGroup]
 
 lemma map_smult_closed :
   "r \<in> R \<Longrightarrow> set ms \<subseteq> M \<Longrightarrow> set (map ((\<cdot>) r) ms) \<subseteq> M"
   using smult_closed by (induct ms) auto
 
 lemma zero_smult : "m \<in> M \<Longrightarrow> 0 \<cdot> m = 0"
   using R_scalars.zero_closed smult_distrib_right[of 0] add_left_imp_eq by simp
 
 lemma smult_zero : "r \<in> R \<Longrightarrow> r \<cdot> 0 = 0"
   using zero_closed smult_distrib_left[of r 0] by simp
 
 lemma neg_smult : "r \<in> R \<Longrightarrow> m \<in> M \<Longrightarrow> (-r) \<cdot> m = - (r \<cdot> m)"
   using R_scalars.neg_closed smult_distrib_right[of r "-r" m]
         zero_smult minus_unique[of "r \<cdot> m"]
   by    simp
 
 lemma neg_eq_neg1_smult : "m \<in> M \<Longrightarrow> (-1) \<cdot> m = - m"
   using one_closed neg_smult one_smult by fastforce
 
 lemma smult_neg : "r \<in> R \<Longrightarrow> m \<in> M \<Longrightarrow> r \<cdot> (- m) = - (r \<cdot> m)"
   using neg_eq_neg1_smult one_closed R_scalars.neg_closed smult_assoc[of r "- 1"]
         smult_closed
   by    force
 
 lemma smult_distrib_left_diff :
   "\<lbrakk> r \<in> R; m \<in> M; n \<in> M \<rbrakk> \<Longrightarrow> r \<cdot> (m - n) = r \<cdot> m - r \<cdot> n"
   using neg_closed smult_distrib_left[of r m "-n"] smult_neg by (simp add: algebra_simps)
 
 lemma smult_distrib_right_diff :
   "\<lbrakk> r \<in> R; s \<in> R; m \<in> M \<rbrakk> \<Longrightarrow> (r - s) \<cdot> m = r \<cdot> m - s \<cdot> m"
   using R_scalars.neg_closed smult_distrib_right[of r "-s"] neg_smult
   by    (simp add: algebra_simps)
 
 lemma smult_sum_distrib :
   assumes "r \<in> R"
   shows   "finite A \<Longrightarrow> f ` A \<subseteq> M \<Longrightarrow> r \<cdot> (\<Sum>a\<in>A. f a) = (\<Sum>a\<in>A. r \<cdot> f a)"
 proof (induct set: finite)
   case empty from assms show ?case using smult_zero by simp
 next
   case (insert a A) with assms show ?case using sum_closed[of A] by simp
 qed
 
 lemma sum_smult_distrib :
   assumes "m \<in> M"
   shows   "finite A \<Longrightarrow> f ` A \<subseteq> R \<Longrightarrow> (\<Sum>a\<in>A. f a) \<cdot> m = (\<Sum>a\<in>A. (f a) \<cdot> m)"
 proof (induct set: finite)
   case empty from assms show ?case using zero_smult by simp
 next
   case (insert a A) with assms show ?case using R_scalars.sum_closed[of A] by simp
 qed
 
 lemma smult_sum_list_distrib :
   "r \<in> R \<Longrightarrow> set ms \<subseteq> M \<Longrightarrow> r \<cdot> (sum_list ms) = (\<Sum>m\<leftarrow>ms. r \<cdot> m)"
   using smult_zero sum_list_closed[of id] by (induct ms) auto
 
 lemma sum_list_prod_map_smult_distrib :
   "m \<in> M \<Longrightarrow> set (map (case_prod f) xys) \<subseteq> R
         \<Longrightarrow> (\<Sum>(x,y)\<leftarrow>xys. f x y) \<cdot> m = (\<Sum>(x,y)\<leftarrow>xys. f x y \<cdot> m)"
   using zero_smult R_scalars.sum_list_closed_prod[of f]
   by    (induct xys) auto
 
 lemma RSubmoduleI :
   assumes "Subgroup N" "\<And>r n. r \<in> R \<Longrightarrow> n \<in> N \<Longrightarrow> r \<cdot> n \<in> N"
   shows   "RSubmodule N"
 proof
   show "RModule R smult N"
   proof (intro_locales, rule SubgroupD1[OF assms(1)], unfold_locales)
     from assms(2) show "\<And>r m. r \<in> R \<Longrightarrow> m \<in> N \<Longrightarrow> r \<cdot> m \<in> N" by fast
     from assms(1)
       show  "\<And>r m n. \<lbrakk> r \<in> R; m \<in> N; n \<in> N \<rbrakk> \<Longrightarrow> r \<cdot> (m + n) = r \<cdot> m + r \<cdot> n"
       using smult_distrib_left
       by    blast
     from assms(1)
       show  "\<And>r s m. \<lbrakk> r \<in> R; s \<in> R; m \<in> N \<rbrakk> \<Longrightarrow> (r + s) \<cdot> m = r \<cdot> m + s \<cdot> m"
       using smult_distrib_right
       by    blast
     from assms(1)
       show  "\<And>r s m. \<lbrakk> r \<in> R; s \<in> R; m \<in> N \<rbrakk> \<Longrightarrow> r \<cdot> s \<cdot> m = (r * s) \<cdot> m"
       using smult_assoc
       by    blast
     from assms(1) show "\<And>m. m \<in> N \<Longrightarrow> 1 \<cdot> m = m" using one_smult by blast
   qed
   from assms(1) show "N \<subseteq> M" by fast
 qed
 
 end (* context RModule *)
 
 lemma (in R_scalar_mult) listset_RModule_Rsmult_closed :
   "\<lbrakk> \<forall>M\<in>set Ms. RModule R smult M; r \<in> R; ms \<in> listset Ms \<rbrakk> 
         \<Longrightarrow> [r \<cdot> m. m\<leftarrow>ms] \<in> listset Ms"
 proof-
   have "\<lbrakk> length ms = length Ms; ms \<in> listset Ms;
               \<forall>M\<in>set Ms. RModule R smult M; r \<in> R \<rbrakk>
                 \<Longrightarrow> [r \<cdot> m. m\<leftarrow>ms] \<in> listset Ms"
   proof (induct ms Ms rule: list_induct2)
     case (Cons m ms M Ms) thus ?case
       using listset_ConsD[of m] RModule.smult_closed listset_ConsI[of "r \<cdot> m" M]
       by    fastforce
   qed simp
   thus "\<lbrakk> \<forall>M\<in>set Ms. RModule R smult M; r \<in> R; ms \<in> listset Ms \<rbrakk> 
               \<Longrightarrow> [r \<cdot> m. m\<leftarrow>ms] \<in> listset Ms"
     using listset_length[of ms Ms] by fast
 qed
 
 context Module
 begin
 
 abbreviation Submodule :: "'m set \<Rightarrow> bool"
   where "Submodule \<equiv> RModule.RSubmodule UNIV smult M"
 
 lemmas AbGroup    = AbGroup
 lemmas SubmoduleI = RSubmoduleI
 
 end (* context Module *)
 
 subsubsection \<open>Module and submodule instances\<close>
 
 lemma (in R_scalar_mult) trivial_RModule :
   "(\<And>r. r \<in> R \<Longrightarrow> r \<cdot> 0 = 0) \<Longrightarrow> RModule R smult 0"
   using trivial_Group add_closed mult_closed one_closed by unfold_locales auto
 
 context RModule
 begin
 
 lemma trivial_RSubmodule : "RSubmodule 0"
   using zeroS_closed smult_zero trivial_RModule by fast
 
 lemma RSubmodule_set_plus :
   assumes "RSubmodule L" "RSubmodule N"
   shows   "RSubmodule (L + N)"
 proof (rule RSubmoduleI)
   from assms have "Group (L + N)"
     using RModule.AbGroup AbGroup_set_plus[of L N] AbGroup.axioms by fast
   moreover from assms have "L + N \<subseteq> M"
     using Group Group.set_plus_closed by auto
   ultimately show "Subgroup (L + N)" by fast
 next
   fix r x assume rx: "r \<in> R" "x \<in> L + N"
   from rx(2) obtain m n where mn: "m \<in> L" "n \<in> N" "x = m + n"
     using set_plus_def[of L N] by fast
   with assms rx(1) show "r \<cdot> x \<in> L + N"
     using RModule.smult_closed[of R smult L] RModule.smult_closed[of R smult N]
           smult_distrib_left set_plus_def
     by    fast
 qed
 
 lemma RSubmodule_sum_list :
   "(\<forall>N\<in>set Ns. RSubmodule N) \<Longrightarrow> RSubmodule (\<Sum>N\<leftarrow>Ns. N)"
   using trivial_RSubmodule RSubmodule_set_plus
   by    (induct Ns) auto
 
 lemma RSubmodule_inner_dirsum :
   assumes "(\<forall>N\<in>set Ns. RSubmodule N)"
   shows   "RSubmodule (\<Oplus>N\<leftarrow>Ns. N)"
 proof (cases "add_independentS Ns")
   case True with assms show ?thesis
     using RSubmodule_sum_list inner_dirsumD by fastforce
 next
   case False thus ?thesis
     using inner_dirsumD2[of Ns] trivial_RSubmodule by simp
 qed
 
 lemma RModule_inner_dirsum :
   "(\<forall>N\<in>set Ns. RSubmodule N) \<Longrightarrow> RModule R smult (\<Oplus>N\<leftarrow>Ns. N)"
   using RSubmodule_inner_dirsum by fast
 
 lemma SModule_restrict_scalars :
   assumes "Subring1 S"
   shows   "RModule S smult M"
 proof (rule RModuleI, rule Subring1D1[OF assms], rule Group, unfold_locales)
   from assms show
     "\<And>r m. r \<in> S \<Longrightarrow> m \<in> M \<Longrightarrow> r \<cdot> m \<in> M"
     "\<And>r m n. r \<in> S \<Longrightarrow> m \<in> M \<Longrightarrow> n \<in> M \<Longrightarrow> r \<cdot> (m + n) = r \<cdot> m + r \<cdot> n"
     "\<And>m. m \<in> M \<Longrightarrow> 1 \<cdot> m = m"
     using smult_closed smult_distrib_left
     by    auto
   from assms
     show  "\<And>r s m. r \<in> S \<Longrightarrow> s \<in> S \<Longrightarrow> m \<in> M \<Longrightarrow> (r + s) \<cdot> m = r \<cdot> m + s \<cdot> m"
     using Ring1.add_closed smult_distrib_right
     by    fast
   from assms
     show  "\<And>r s m. r \<in> S \<Longrightarrow> s \<in> S \<Longrightarrow> m \<in> M \<Longrightarrow> r \<cdot> s \<cdot> m = (r * s) \<cdot> m"
     using Ring1.mult_closed smult_assoc
     by    fast
 qed
 
 end (* context RModule *)
 
 
 subsection \<open>Linear algebra in modules\<close>
 
 subsubsection \<open>Linear combinations: \<open>lincomb\<close>\<close>
 
 context scalar_mult
 begin
 
 definition lincomb :: "'r list \<Rightarrow> 'm list \<Rightarrow> 'm" (infix "\<bullet>\<cdot>" 70)
   where "rs \<bullet>\<cdot> ms = (\<Sum>(r,m)\<leftarrow>zip rs ms. r \<cdot> m)"
 
 text \<open>Note: \<open>zip\<close> will truncate if lengths of coefficient and vector lists differ.\<close>
 
 lemma lincomb_Nil : "rs = [] \<or> ms = [] \<Longrightarrow> rs \<bullet>\<cdot> ms = 0"
   unfolding lincomb_def by auto
 
 lemma lincomb_singles : "[a] \<bullet>\<cdot> [m] = a \<cdot> m"
   using lincomb_def by simp
 
 lemma lincomb_Cons : "(r # rs) \<bullet>\<cdot> (m # ms) = r \<cdot> m + rs \<bullet>\<cdot> ms"
   unfolding lincomb_def by simp
 
 lemma lincomb_append :
   "length rs = length ms \<Longrightarrow> (rs@ss) \<bullet>\<cdot> (ms@ns) = rs \<bullet>\<cdot> ms + ss \<bullet>\<cdot> ns"
   unfolding lincomb_def by simp
 
 lemma lincomb_append_left :
   "(rs @ ss) \<bullet>\<cdot> ms = rs \<bullet>\<cdot> ms + ss \<bullet>\<cdot> drop (length rs) ms"
   using zip_append_left[of rs ss ms] unfolding lincomb_def by simp
 
 lemma lincomb_append_right :
   "rs \<bullet>\<cdot> (ms@ns) = rs \<bullet>\<cdot> ms + (drop (length ms) rs) \<bullet>\<cdot> ns"
   using zip_append_right[of rs ms] unfolding lincomb_def by simp
 
 lemma lincomb_conv_take_right : "rs \<bullet>\<cdot> ms = rs \<bullet>\<cdot> take (length rs) ms"
   using lincomb_Nil lincomb_Cons by (induct rs ms rule: list_induct2') auto
 
 end (* context scalar_mult *)
 
 context RModule
 begin
 
 lemmas lincomb_Nil  = lincomb_Nil
 lemmas lincomb_Cons = lincomb_Cons
 
 lemma lincomb_closed : "set rs \<subseteq> R \<Longrightarrow> set ms \<subseteq> M \<Longrightarrow> rs \<bullet>\<cdot> ms \<in> M"
 proof (induct ms arbitrary: rs)
   case Nil show ?case using lincomb_Nil zero_closed by simp
 next
   case (Cons m ms)
   hence Cons1: "\<And>rs. set rs \<subseteq> R \<Longrightarrow> rs \<bullet>\<cdot> ms \<in> M" "m \<in> M" "set rs \<subseteq> R" by auto
   show "rs \<bullet>\<cdot> (m#ms) \<in> M"
   proof (cases rs)
     case Nil thus ?thesis using lincomb_Nil zero_closed by simp
   next
     case Cons with Cons1 show ?thesis
       using lincomb_Cons smult_closed add_closed by fastforce
   qed
 qed
 
 lemma smult_lincomb :
   "\<lbrakk> set rs \<subseteq> R; s \<in> R; set ms \<subseteq> M \<rbrakk> \<Longrightarrow> s \<cdot> (rs \<bullet>\<cdot> ms) = [s*r. r\<leftarrow>rs] \<bullet>\<cdot> ms"
   using lincomb_Nil smult_zero lincomb_Cons smult_closed lincomb_closed
   by    (induct rs ms rule: list_induct2') auto
 
 lemma neg_lincomb :
   "set rs \<subseteq> R \<Longrightarrow> set ms \<subseteq> M \<Longrightarrow> - (rs \<bullet>\<cdot> ms) = [-r. r\<leftarrow>rs] \<bullet>\<cdot> ms"
   using lincomb_closed neg_eq_neg1_smult one_closed R_scalars.neg_closed[of 1]
         smult_lincomb[of rs "- 1"] map_times_neg1_eq_map_uminus
   by    auto
 
 lemma lincomb_sum_left :
   "\<lbrakk> set rs \<subseteq> R; set ss \<subseteq> R; set ms \<subseteq> M; length rs \<le> length ss \<rbrakk>
         \<Longrightarrow> [r + s. (r,s)\<leftarrow>zip rs ss] \<bullet>\<cdot> ms = rs \<bullet>\<cdot> ms + (take (length rs) ss) \<bullet>\<cdot> ms"
 proof (induct rs ss arbitrary: ms rule: list_induct2')
   case 1 show ?case using lincomb_Nil by simp
 next
   case (2 r rs)
   show "\<And>ms. length (r#rs) \<le> length []
               \<Longrightarrow> [a + b. (a,b)\<leftarrow>zip (r#rs) []] \<bullet>\<cdot> ms
                 = (r#rs) \<bullet>\<cdot> ms + (take (length (r#rs)) []) \<bullet>\<cdot> ms"
     by simp
 next
   case 3 show ?case using lincomb_Nil by simp
 next
   case (4 r rs s ss)
   thus "[a+b. (a,b)\<leftarrow>zip (r#rs) (s#ss)] \<bullet>\<cdot> ms
               = (r#rs) \<bullet>\<cdot> ms + (take (length (r#rs)) (s#ss)) \<bullet>\<cdot> ms"
     using lincomb_Nil lincomb_Cons by (cases ms) auto
 qed
 
 lemma lincomb_sum :
   assumes "set rs \<subseteq> R" "set ss \<subseteq> R" "set ms \<subseteq> M" "length rs \<le> length ss"
   shows   "rs \<bullet>\<cdot> ms + ss \<bullet>\<cdot> ms
                 = ([a + b. (a,b)\<leftarrow>zip rs ss] @ (drop (length rs) ss)) \<bullet>\<cdot> ms"
 proof-
   define zs fss bss
     where "zs = [a + b. (a,b)\<leftarrow>zip rs ss]"
       and "fss = take (length rs) ss"
       and "bss = drop (length rs) ss"
   from assms(4) zs_def fss_def have "length zs = length rs" "length fss = length rs"
     using length_concat_map_split_zip[of "\<lambda>a b. a + b" rs] by auto
   hence "(zs @ bss) \<bullet>\<cdot> ms = rs \<bullet>\<cdot> ms + (fss @ bss) \<bullet>\<cdot> ms"
     using assms(1,2,3) zs_def fss_def lincomb_sum_left lincomb_append_left
     by    simp
   thus ?thesis using fss_def bss_def zs_def by simp
 qed
 
 lemma lincomb_diff_left :
   "\<lbrakk> set rs \<subseteq> R; set ss \<subseteq> R; set ms \<subseteq> M; length rs \<le> length ss \<rbrakk>
         \<Longrightarrow> [r - s. (r,s)\<leftarrow>zip rs ss] \<bullet>\<cdot> ms = rs \<bullet>\<cdot> ms - (take (length rs) ss) \<bullet>\<cdot> ms"
 proof (induct rs ss arbitrary: ms rule: list_induct2')
   case 1 show ?case using lincomb_Nil by simp
 next
   case (2 r rs)
   show "\<And>ms. length (r#rs) \<le> length []
               \<Longrightarrow> [a - b. (a,b)\<leftarrow>zip (r#rs) []] \<bullet>\<cdot> ms
                 = (r#rs) \<bullet>\<cdot> ms - (take (length (r#rs)) []) \<bullet>\<cdot> ms"
     by simp
 next
   case 3 show ?case using lincomb_Nil by simp
 next
   case (4 r rs s ss)
   thus "[a-b. (a,b)\<leftarrow>zip (r#rs) (s#ss)] \<bullet>\<cdot> ms
               = (r#rs) \<bullet>\<cdot> ms - (take (length (r#rs)) (s#ss)) \<bullet>\<cdot> ms"
     using lincomb_Nil lincomb_Cons smult_distrib_right_diff by (cases ms) auto
 qed
 
 lemma lincomb_replicate_left : 
   "r \<in> R \<Longrightarrow> set ms \<subseteq> M \<Longrightarrow> (replicate k r) \<bullet>\<cdot> ms = r \<cdot> ( \<Sum>m\<leftarrow>(take k ms). m )"
 proof (induct k arbitrary: ms)
   case 0 thus ?case using lincomb_Nil smult_zero by simp
 next
   case (Suc k)
   show ?case
   proof (cases ms)
     case Nil with Suc(2) show ?thesis using lincomb_Nil smult_zero by simp
   next
     case (Cons m ms) with Suc show ?thesis
       using lincomb_Cons set_take_subset[of k ms] sum_list_closed[of id]
       by    auto
   qed
 qed
 
 lemma lincomb_replicate0_left : "set ms \<subseteq> M \<Longrightarrow> (replicate k 0) \<bullet>\<cdot> ms = 0"
 proof-
   assume ms: "set ms \<subseteq> M"
   hence "(replicate k 0) \<bullet>\<cdot> ms = 0 \<cdot> (\<Sum>m\<leftarrow>(take k ms). m)" 
     using R_scalars.zero_closed lincomb_replicate_left by fast
   moreover from ms have "(\<Sum>m\<leftarrow>(take k ms). m) \<in> M"
     using set_take_subset sum_list_closed by fastforce
   ultimately show "(replicate k 0) \<bullet>\<cdot> ms = 0" using zero_smult by simp
 qed
 
 lemma lincomb_0coeffs : "set ms \<subseteq> M \<Longrightarrow> \<forall>s\<in>set rs. s = 0 \<Longrightarrow> rs \<bullet>\<cdot> ms = 0"
   using lincomb_Nil lincomb_Cons zero_smult
   by    (induct rs ms rule: list_induct2') auto
 
 lemma delta_scalars_lincomb_eq_nth :
   "set ms \<subseteq> M \<Longrightarrow> n < length ms
         \<Longrightarrow> ((replicate (length ms) 0)[n := 1]) \<bullet>\<cdot> ms = ms!n"
 proof (induct ms arbitrary: n)
   case (Cons m ms) thus ?case
     using lincomb_Cons lincomb_replicate0_left zero_smult by (cases n) auto
 qed simp
 
 lemma lincomb_obtain_same_length_Rcoeffs :
   "set rs \<subseteq> R \<Longrightarrow> set ms \<subseteq> M
         \<Longrightarrow> \<exists>ss. set ss \<subseteq> R \<and> length ss = length ms
           \<and> take (length rs) ss = take (length ms) rs \<and> rs \<bullet>\<cdot> ms = ss \<bullet>\<cdot> ms"
 proof (induct rs ms rule: list_induct2')
   case 1 show ?case using lincomb_Nil by simp
 next
   case 2 thus ?case using lincomb_Nil by simp
 next
   case (3 m ms)
   define ss where "ss = replicate (Suc (length ms)) (0::'r)"
   from 3(2) ss_def
     have  "set ss \<subseteq> R" "length ss = length (m#ms)" "[] \<bullet>\<cdot> (m#ms) = ss \<bullet>\<cdot> (m#ms)"
     using R_scalars.zero_closed lincomb_Nil
           lincomb_replicate0_left[of "m#ms" "Suc (length ms)"]
     by    auto
   thus ?case by auto
 next
   case (4 r rs m ms)
   from this obtain ss
     where ss: "set ss \<subseteq> R" "length ss = length ms"
               "take (length rs) ss = take (length ms) rs" "rs \<bullet>\<cdot> ms = ss \<bullet>\<cdot> ms"
       by  auto
   from 4(2) ss have 
     "set (r#ss) \<subseteq> R" "length (r#ss) = length (m#ms)"
     "take (length (r#rs)) (r#ss) = take (length (m#ms)) (r#rs)"
     "(r#rs) \<bullet>\<cdot> (m#ms) = (r#ss) \<bullet>\<cdot> (m#ms)"
     using lincomb_Cons
     by    auto
   thus ?case by fast
 qed
 
 lemma lincomb_concat :
   "list_all2 (\<lambda>rs ms. length rs = length ms) rss mss
         \<Longrightarrow> (concat rss) \<bullet>\<cdot> (concat mss) = (\<Sum>(rs,ms)\<leftarrow>zip rss mss. rs \<bullet>\<cdot> ms)"
   using lincomb_Nil lincomb_append by (induct rss mss rule: list_induct2') auto
 
 lemma lincomb_snoc0 : "set ms \<subseteq> M \<Longrightarrow> (as@[0]) \<bullet>\<cdot> ms = as \<bullet>\<cdot> ms"
   using lincomb_append_left set_drop_subset lincomb_replicate0_left[of _ 1] by fastforce
 
 lemma lincomb_strip_while_0coeffs :
   assumes "set ms \<subseteq> M"
   shows   "(strip_while ((=) 0) as) \<bullet>\<cdot> ms = as \<bullet>\<cdot> ms"
 proof (induct as rule: rev_induct)
   case (snoc a as)
   hence caseassm: "strip_while ((=) 0) as \<bullet>\<cdot> ms = as \<bullet>\<cdot> ms" by fast
   show ?case
   proof (cases "a = 0")
     case True
     moreover with assms have "(as@[a]) \<bullet>\<cdot> ms = as \<bullet>\<cdot> ms"
       using lincomb_snoc0 by fast
     ultimately show "strip_while ((=) 0) (as @ [a]) \<bullet>\<cdot> ms = (as@[a]) \<bullet>\<cdot> ms"
       using caseassm by simp
   qed simp
 qed simp
 
 end (* context RModule *)
 
 lemmas (in Module) lincomb_obtain_same_length_coeffs = lincomb_obtain_same_length_Rcoeffs
 lemmas (in Module) lincomb_concat                    = lincomb_concat
 
 subsubsection \<open>Spanning: \<open>RSpan\<close> and \<open>Span\<close>\<close>
 
 context R_scalar_mult
 begin
 
 primrec RSpan :: "'m list \<Rightarrow> 'm set"
   where "RSpan [] = 0"
       | "RSpan (m#ms) = { r \<cdot> m | r. r \<in> R } + RSpan ms"
 
 lemma RSpan_single : "RSpan [m] = { r \<cdot> m | r. r \<in> R }"
   using add_0_right[of "{ r \<cdot> m | r. r \<in> R }"] by simp
 
 lemma RSpan_Cons : "RSpan (m#ms) = RSpan [m] + RSpan ms"
   using RSpan_single by simp
 
 lemma in_RSpan_obtain_same_length_coeffs :
   "n \<in> RSpan ms \<Longrightarrow> \<exists>rs. set rs \<subseteq> R \<and> length rs = length ms \<and> n = rs \<bullet>\<cdot> ms"
 proof (induct ms arbitrary: n)
   case Nil
   hence "n = 0" by simp
   thus "\<exists>rs. set rs \<subseteq> R \<and> length rs = length [] \<and> n = rs \<bullet>\<cdot> []"
     using lincomb_Nil by simp
 next
   case (Cons m ms)
   from this obtain r rs
     where "set (r#rs) \<subseteq> R" "length (r#rs) = length (m#ms)" "n = (r#rs) \<bullet>\<cdot> (m#ms)"
     using set_plus_def[of _ "RSpan ms"] lincomb_Cons
     by    fastforce
   thus "\<exists>rs. set rs \<subseteq> R \<and> length rs = length (m#ms) \<and> n = rs \<bullet>\<cdot> (m#ms)" by fast
 qed
 
 lemma in_RSpan_Cons_obtain_same_length_coeffs :
   "n \<in> RSpan (m#ms) \<Longrightarrow> \<exists>r rs. set (r#rs) \<subseteq> R \<and> length rs = length ms 
         \<and> n = r \<cdot> m + rs \<bullet>\<cdot> ms"
 proof-
   assume "n \<in> RSpan (m#ms)"
   from this obtain x y where "x \<in> RSpan [m]" "y \<in> RSpan ms" "n = x + y"
     using RSpan_Cons set_plus_def[of "RSpan [m]"] by auto
   thus "\<exists>r rs. set (r # rs) \<subseteq> R \<and> length rs = length ms \<and> n = r \<cdot> m + rs \<bullet>\<cdot> ms"
     using RSpan_single in_RSpan_obtain_same_length_coeffs[of y ms] by auto
 qed
 
 lemma RSpanD_lincomb :
   "RSpan ms = { rs \<bullet>\<cdot> ms | rs. set rs \<subseteq> R \<and> length rs = length ms}"
 proof
   show "RSpan ms \<subseteq> {rs \<bullet>\<cdot> ms |rs. set rs \<subseteq> R \<and> length rs = length ms}"
     using in_RSpan_obtain_same_length_coeffs by fast
   show "{rs \<bullet>\<cdot> ms |rs. set rs \<subseteq> R \<and> length rs = length ms} \<subseteq> RSpan ms"
   proof
     fix x assume "x \<in> {rs \<bullet>\<cdot> ms |rs. set rs \<subseteq> R  \<and> length rs = length ms}"
     from this obtain rs where rs: "set rs \<subseteq> R" "length rs = length ms" "x = rs \<bullet>\<cdot> ms"
       by fast
     from rs(2) have "set rs \<subseteq> R \<Longrightarrow> rs \<bullet>\<cdot> ms \<in> RSpan ms"
       using lincomb_Nil lincomb_Cons by (induct rs ms rule: list_induct2) auto
     with rs(1,3) show "x \<in> RSpan ms" by fast
   qed
 qed
 
 lemma RSpan_append : "RSpan (ms @ ns) = RSpan ms + RSpan ns"
 proof (induct ms)
   case Nil show ?case using add_0_left[of "RSpan ns"] by simp
 next
   case (Cons m ms) thus ?case
     using RSpan_Cons[of m "ms@ns"] add.assoc by fastforce
 qed
 
 end (* context R_scalar_mult *)
 
 context scalar_mult
 begin
 
 abbreviation "Span \<equiv> R_scalar_mult.RSpan UNIV smult"
 
 lemmas Span_append = R_scalar_mult.RSpan_append[OF R_scalar_mult, of smult]
 lemmas SpanD_lincomb
           = R_scalar_mult.RSpanD_lincomb [OF R_scalar_mult, of smult]
 
 lemmas in_Span_obtain_same_length_coeffs
           = R_scalar_mult.in_RSpan_obtain_same_length_coeffs[
               OF R_scalar_mult, of _ smult
             ]
 
 end (* context scalar_mult *)
 
 context RModule
 begin
 
 lemma RSpan_contains_spanset_single : "m \<in> M \<Longrightarrow> m \<in> RSpan [m]"
   using one_closed RSpan_single by fastforce
 
 lemma RSpan_single_nonzero : "m \<in> M \<Longrightarrow> m \<noteq> 0 \<Longrightarrow> RSpan [m] \<noteq> 0"
   using RSpan_contains_spanset_single by auto
 
 lemma Group_RSpan_single :
   assumes "m \<in> M"
   shows   "Group (RSpan [m])"
 proof
   from assms show "RSpan [m] \<noteq> {}" using RSpan_contains_spanset_single by fast
 next
   fix x y assume "x \<in> RSpan [m]" "y \<in> RSpan [m]"
   from this obtain r s where rs: "r \<in> R" "x = r \<cdot> m" "s \<in> R" "y = s \<cdot> m"
     using RSpan_single by auto
   with assms have "x - y = (r - s) \<cdot> m" using smult_distrib_right_diff by simp
   with rs(1,3) show "x - y \<in> RSpan [m]"
     using R_scalars.diff_closed[of r s] RSpan_single[of m] by auto
 qed
 
 lemma Group_RSpan : "set ms \<subseteq> M \<Longrightarrow> Group (RSpan ms)"
 proof (induct ms)
   case Nil show ?case using trivial_Group by simp
 next
   case (Cons m ms)
   hence "Group (RSpan [m])" "Group (RSpan ms)"
     using Group_RSpan_single[of m] by auto
   thus ?case
     using RSpan_Cons[of m ms] AbGroup.intro AbGroup_set_plus AbGroup.axioms(1)
     by    fastforce
 qed
 
 lemma RSpanD_lincomb_arb_len_coeffs :
   "set ms \<subseteq> M \<Longrightarrow> RSpan ms = { rs \<bullet>\<cdot> ms | rs. set rs \<subseteq> R }"
 proof
   show "RSpan ms \<subseteq> { rs \<bullet>\<cdot> ms | rs. set rs \<subseteq> R }" using RSpanD_lincomb by fast
   show "set ms \<subseteq> M \<Longrightarrow> RSpan ms \<supseteq> { rs \<bullet>\<cdot> ms | rs. set rs \<subseteq> R }"
   proof (induct ms)
     case Nil show ?case using lincomb_Nil by auto
   next
     case (Cons m ms) show ?case
     proof
       fix x assume "x \<in> { rs \<bullet>\<cdot> (m#ms) | rs. set rs \<subseteq> R }"
       from this obtain rs where rs: "set rs \<subseteq> R" "x = rs \<bullet>\<cdot> (m#ms)" by fast
       with Cons show "x \<in> RSpan (m#ms)"
         using lincomb_Nil Group_RSpan[of "m#ms"] Group.zero_closed lincomb_Cons
         by    (cases rs) auto
     qed
   qed
 qed
 
 lemma RSpanI_lincomb_arb_len_coeffs :
   "set rs \<subseteq> R \<Longrightarrow> set ms \<subseteq> M \<Longrightarrow> rs \<bullet>\<cdot> ms \<in> RSpan ms"
   using RSpanD_lincomb_arb_len_coeffs by fast
 
 lemma RSpan_contains_RSpans_Cons_left :
   "set ms \<subseteq> M \<Longrightarrow> RSpan [m] \<subseteq> RSpan (m#ms)"
   using RSpan_Cons Group_RSpan AbGroup.intro AbGroup.subset_plus_left by fast
 
 lemma RSpan_contains_RSpans_Cons_right :
   "m \<in> M \<Longrightarrow> RSpan ms \<subseteq> RSpan (m#ms)"
   using RSpan_Cons Group_RSpan_single AbGroup.intro AbGroup.subset_plus_right by fast
 
 lemma RSpan_contains_RSpans_append_left :
   "set ns \<subseteq> M \<Longrightarrow> RSpan ms \<subseteq> RSpan (ms@ns)"
   using RSpan_append Group_RSpan AbGroup.intro AbGroup.subset_plus_left
   by    fast
 
 lemma RSpan_contains_spanset : "set ms \<subseteq> M \<Longrightarrow> set ms \<subseteq> RSpan ms"
 proof (induct ms)
   case Nil show ?case by simp
 next
   case (Cons m ms) thus ?case
     using RSpan_contains_spanset_single
           RSpan_contains_RSpans_Cons_left[of ms m]
           RSpan_contains_RSpans_Cons_right[of m ms]
     by    auto
 qed
 
 lemma RSpan_contains_spanset_append_left :
   "set ms \<subseteq> M \<Longrightarrow> set ns \<subseteq> M \<Longrightarrow> set ms \<subseteq> RSpan (ms@ns)"
   using RSpan_contains_spanset[of "ms@ns"] by simp
 
 lemma RSpan_contains_spanset_append_right :
   "set ms \<subseteq> M \<Longrightarrow> set ns \<subseteq> M \<Longrightarrow> set ns \<subseteq> RSpan (ms@ns)"
   using RSpan_contains_spanset[of "ms@ns"] by simp
 
 lemma RSpan_zero_closed : "set ms \<subseteq> M \<Longrightarrow> 0 \<in> RSpan ms"
   using Group_RSpan Group.zero_closed by fast
 
 lemma RSpan_single_closed : "m \<in> M \<Longrightarrow> RSpan [m] \<subseteq> M"
   using RSpan_single smult_closed by auto
 
 lemma RSpan_closed : "set ms \<subseteq> M \<Longrightarrow> RSpan ms \<subseteq> M"
 proof (induct ms)
   case Nil show ?case using zero_closed by simp
 next
   case (Cons m ms) thus ?case 
     using RSpan_single_closed RSpan_Cons Group Group.set_plus_closed[of M]
     by    simp
 qed
 
 lemma RSpan_smult_closed :
   assumes "r \<in> R" "set ms \<subseteq> M" "n \<in> RSpan ms"
   shows "r \<cdot> n \<in> RSpan ms"
 proof-
   from assms(2,3) obtain rs where rs: "set rs \<subseteq> R" "n = rs \<bullet>\<cdot> ms"
     using RSpanD_lincomb_arb_len_coeffs by fast
   with assms(1,2) show ?thesis
     using smult_lincomb[OF rs(1) assms(1,2)] mult_closed
           RSpanI_lincomb_arb_len_coeffs[of "[r*a. a\<leftarrow>rs]" ms]
     by    auto
 qed
 
 lemma RSpan_add_closed :
   assumes "set ms \<subseteq> M" "n \<in> RSpan ms" "n' \<in> RSpan ms"
   shows   "n + n' \<in> RSpan ms"
 proof-
   from assms (2,3) obtain rs ss
     where rs: "set rs \<subseteq> R" "length rs = length ms" "n = rs \<bullet>\<cdot> ms"
     and   ss: "set ss \<subseteq> R" "length ss = length ms" "n' = ss \<bullet>\<cdot> ms"
     using RSpanD_lincomb by auto
   with assms(1) have "n + n' = [r + s. (r,s)\<leftarrow>zip rs ss] \<bullet>\<cdot> ms"
     using lincomb_sum_left by simp
   moreover from rs(1) ss(1) have "set [r + s. (r,s)\<leftarrow>zip rs ss] \<subseteq> R"
     using set_zip_leftD[of _ _ rs ss] set_zip_rightD[of _ _ rs ss]  
           R_scalars.add_closed R_scalars.zip_add_closed by blast
   ultimately show "n + n' \<in> RSpan ms"
     using assms(1) RSpanI_lincomb_arb_len_coeffs by simp
 qed
 
 lemma RSpan_lincomb_closed :
   "\<lbrakk> set rs \<subseteq> R; set ms \<subseteq> M; set ns \<subseteq> RSpan ms \<rbrakk> \<Longrightarrow> rs \<bullet>\<cdot> ns \<in> RSpan ms"
   using lincomb_Nil RSpan_zero_closed lincomb_Cons RSpan_smult_closed RSpan_add_closed
   by    (induct rs ns rule: list_induct2') auto
 
 lemma RSpanI : "set ms \<subseteq> M \<Longrightarrow> M \<subseteq> RSpan ms \<Longrightarrow> M = RSpan ms"
   using RSpan_closed by fast
 
 lemma RSpan_contains_RSpan_take :
   "set ms \<subseteq> M \<Longrightarrow> RSpan (take k ms) \<subseteq> RSpan ms"
   using append_take_drop_id set_drop_subset
         RSpan_contains_RSpans_append_left[of "drop k ms"]
   by    fastforce
 
 lemma RSubmodule_RSpan_single :
   assumes "m \<in> M"
   shows   "RSubmodule (RSpan [m])"
 proof (rule RSubmoduleI)
   from assms show "Subgroup (RSpan [m])"
     using Group_RSpan_single RSpan_closed[of "[m]"] by simp
 next
   fix r n assume rn: "r \<in> R" "n \<in> RSpan [m]"
   from rn(2) obtain s where s: "s \<in> R" "n = s \<cdot> m" using RSpan_single by fast
   with assms rn(1) have "r * s \<in> R" "r \<cdot> n = (r * s) \<cdot> m"
     using mult_closed by auto
   thus "r \<cdot> n \<in> RSpan [m]" using RSpan_single by fast
 qed
 
 lemma RSubmodule_RSpan : "set ms \<subseteq> M \<Longrightarrow> RSubmodule (RSpan ms)"
 proof (induct ms)
   case Nil show ?case using trivial_RSubmodule by simp
 next
   case (Cons m ms)
   hence "RSubmodule (RSpan [m])" "RSubmodule (RSpan ms)"
     using RSubmodule_RSpan_single by auto
   thus ?case using RSpan_Cons RSubmodule_set_plus by simp
 qed
 
 lemma RSpan_RSpan_closed :
   "set ms \<subseteq> M \<Longrightarrow> set ns \<subseteq> RSpan ms \<Longrightarrow> RSpan ns \<subseteq> RSpan ms"
   using RSpanD_lincomb[of ns] RSpan_lincomb_closed by auto
 
 lemma spanset_reduce_Cons :
   "set ms \<subseteq> M \<Longrightarrow> m \<in> RSpan ms \<Longrightarrow> RSpan (m#ms) = RSpan ms"
   using RSpan_Cons RSpan_RSpan_closed[of ms "[m]"]
         RSpan_contains_RSpans_Cons_right[of m ms]
         RSubmodule_RSpan[of ms]
         RModule.set_plus_closed[of R smult "RSpan ms" "RSpan [m]" "RSpan ms"]
   by    auto
 
 lemma RSpan_replace_hd :
   assumes "n \<in> M" "set ms \<subseteq> M" "m \<in> RSpan (n # ms)"
   shows   "RSpan (m # ms) \<subseteq> RSpan (n # ms)"
 proof
   fix x assume "x \<in> RSpan (m # ms)"
   from this assms(3) obtain r rs s ss
     where r_rs: "r \<in> R" "set rs \<subseteq> R" "length rs = length ms" "x = r \<cdot> m + rs \<bullet>\<cdot> ms"
     and   s_ss: "s \<in> R" "set ss \<subseteq> R" "length ss = length ms" "m = s \<cdot> n + ss \<bullet>\<cdot> ms"
     using in_RSpan_Cons_obtain_same_length_coeffs[of x m ms]
           in_RSpan_Cons_obtain_same_length_coeffs[of m n ms]
     by    fastforce
   from r_rs(1) s_ss(2) have set1: "set [r*a. a\<leftarrow>ss] \<subseteq> R" using mult_closed by auto
   have "x = ((r * s) # [a + b. (a,b)\<leftarrow>zip [r*a. a\<leftarrow>ss] rs]) \<bullet>\<cdot> (n # ms)"
   proof-
     from r_rs(2,3) s_ss(3) assms(2)
       have  "[r*a. a\<leftarrow>ss] \<bullet>\<cdot> ms + rs \<bullet>\<cdot> ms
                   = [a + b. (a,b)\<leftarrow>zip [r*a. a\<leftarrow>ss] rs] \<bullet>\<cdot> ms"
       using set1 lincomb_sum
       by    simp
     moreover from assms(1,2) r_rs(1,2,4) s_ss(1,2,4)
       have  "x = (r * s) \<cdot> n + ([r*a. a\<leftarrow>ss] \<bullet>\<cdot> ms + rs \<bullet>\<cdot> ms)"
       using smult_closed lincomb_closed smult_lincomb mult_closed lincomb_sum
       by    simp
     ultimately show ?thesis using lincomb_Cons by simp
   qed
   moreover have "set ((r * s) # [a + b. (a,b)\<leftarrow>zip [r*a. a\<leftarrow>ss] rs]) \<subseteq> R"
   proof-
     from r_rs(2) have "set [a + b. (a,b)\<leftarrow>zip [r*a. a\<leftarrow>ss] rs] \<subseteq> R" 
       using set1 R_scalars.zip_add_closed by fast
     with r_rs(1) s_ss(1) show ?thesis using mult_closed by simp
   qed
   ultimately show "x \<in> RSpan (n # ms)"
     using assms(1,2) RSpanI_lincomb_arb_len_coeffs[of _ "n#ms"] by fastforce
 qed
 
 end (* context RModule *)
 
 lemmas (in scalar_mult)
   Span_Cons = R_scalar_mult.RSpan_Cons[OF R_scalar_mult, of smult]
 
 context Module
 begin
 
 lemmas SpanD_lincomb_arb_len_coeffs       = RSpanD_lincomb_arb_len_coeffs
 lemmas SpanI                              = RSpanI
 lemmas SpanI_lincomb_arb_len_coeffs       = RSpanI_lincomb_arb_len_coeffs
 lemmas Span_contains_Spans_Cons_right     = RSpan_contains_RSpans_Cons_right
 lemmas Span_contains_spanset              = RSpan_contains_spanset
 lemmas Span_contains_spanset_append_left  = RSpan_contains_spanset_append_left
 lemmas Span_contains_spanset_append_right = RSpan_contains_spanset_append_right
 lemmas Span_closed                        = RSpan_closed
 lemmas Span_smult_closed                  = RSpan_smult_closed
 lemmas Span_contains_Span_take            = RSpan_contains_RSpan_take
 lemmas Span_replace_hd                    = RSpan_replace_hd
 lemmas Submodule_Span                     = RSubmodule_RSpan
 
 end (* context Module *)
 
 subsubsection \<open>Finitely generated modules\<close>
 
 context R_scalar_mult
 begin
 
 abbreviation "R_fingen M \<equiv> (\<exists>ms. set ms \<subseteq> M \<and> RSpan ms = M)"
 
 text \<open>
   Similar to definition of \<open>card\<close> for finite sets, we default \<open>dim\<close> to 0 if no finite
   spanning set exists. Note that @{term "RSpan [] = 0"} implies that @{term "dim_R {0} = 0"}.
 \<close>
 
 definition dim_R :: "'m set \<Rightarrow> nat"
   where "dim_R M = (if R_fingen M then (
                 LEAST n. \<exists>ms. length ms = n \<and> set ms \<subseteq> M \<and> RSpan ms = M
               ) else 0)"
 
 lemma dim_R_nonzero :
   assumes "dim_R M > 0"
   shows   "M \<noteq> 0"
 proof
   assume M: "M = 0"
   hence "dim_R M
               = (LEAST n. \<exists>ms. length ms = n \<and> set ms \<subseteq> M \<and> RSpan ms = M)"
     using dim_R_def by simp
   moreover from M have "length [] = 0 \<and> set [] \<subseteq> M \<and> RSpan [] = M" by simp
   ultimately show False using assms by simp
 qed
 
 end (* context R_scalar_mult *)
 
 
 hide_const real_vector.dim
 hide_const (open) Real_Vector_Spaces.dim
 
 abbreviation (in scalar_mult) "fingen \<equiv> R_scalar_mult.R_fingen UNIV smult"
 abbreviation (in scalar_mult) "dim    \<equiv> R_scalar_mult.dim_R UNIV smult"
 
 lemmas (in Module) dim_nonzero = dim_R_nonzero
 
 subsubsection \<open>@{term R}-linear independence\<close>
 
 context R_scalar_mult
 begin
 
 primrec R_lin_independent :: "'m list \<Rightarrow> bool" where
   R_lin_independent_Nil: "R_lin_independent [] = True" |
   R_lin_independent_Cons:
   "R_lin_independent (m#ms) = (R_lin_independent ms
         \<and> (\<forall>r rs. (set (r#rs) \<subseteq> R \<and> (r#rs) \<bullet>\<cdot> (m#ms) = 0) \<longrightarrow> r = 0))"
 
 lemma R_lin_independent_ConsI :
   assumes "R_lin_independent ms"
           "\<And>r rs. set (r#rs) \<subseteq> R \<Longrightarrow> (r#rs) \<bullet>\<cdot> (m#ms) = 0 \<Longrightarrow> r = 0"
   shows   "R_lin_independent (m#ms)"
   using   assms R_lin_independent_Cons
   by      fast
 
 lemma R_lin_independent_ConsD1 :
   "R_lin_independent (m#ms) \<Longrightarrow> R_lin_independent ms"
   by simp
 
 lemma R_lin_independent_ConsD2 :
   "\<lbrakk> R_lin_independent (m#ms); set (r#rs) \<subseteq> R; (r#rs) \<bullet>\<cdot> (m#ms) = 0 \<rbrakk> 
         \<Longrightarrow> r = 0"
   by auto
 
 end (* context R_scalar_mult *)
 
 context RModule
 begin
 
 lemma R_lin_independent_imp_same_scalars :
   "\<lbrakk> length rs = length ss; length rs \<le> length ms; set rs \<subseteq> R; set ss \<subseteq> R;
         set ms \<subseteq> M; R_lin_independent ms; rs \<bullet>\<cdot> ms = ss \<bullet>\<cdot> ms \<rbrakk> \<Longrightarrow> rs = ss"
 proof (induct rs ss arbitrary: ms rule: list_induct2)
   case (Cons r rs s ss)
   from Cons(3) have "ms \<noteq> []" by auto
   from this obtain n ns where ms: "ms = n#ns"
     using neq_Nil_conv[of ms] by fast
   from Cons(4,5) have "set ([a-b. (a,b)\<leftarrow>zip (r#rs) (s#ss)]) \<subseteq> R"
     using Ring1 Ring1.list_diff_closed by fast
   hence "set ((r-s)#[a-b. (a,b)\<leftarrow>zip rs ss]) \<subseteq> R" by simp
   moreover from Cons(1,4-6,8) ms
     have  1: "((r-s)#[a-b. (a,b)\<leftarrow>zip rs ss]) \<bullet>\<cdot> (n#ns) = 0"
     using lincomb_diff_left[of "r#rs" "s#ss"]
     by    simp
   ultimately have "r - s = 0" using Cons(7) ms R_lin_independent_Cons by fast
   hence 2: "r = s" by simp
   with 1 Cons(1,4-6) ms have "rs \<bullet>\<cdot> ns = ss \<bullet>\<cdot> ns"
     using lincomb_Cons zero_smult lincomb_diff_left by simp
   with Cons(2-7) ms have "rs = ss" by simp
   with 2 show ?case by fast
 qed fast
 
 lemma R_lin_independent_obtain_unique_scalars :
   "\<lbrakk> set ms \<subseteq> M; R_lin_independent ms; n \<in> RSpan ms \<rbrakk>
         \<Longrightarrow> (\<exists>! rs. set rs \<subseteq> R \<and> length rs = length ms \<and> n = rs \<bullet>\<cdot> ms)"
   using in_RSpan_obtain_same_length_coeffs[of n ms]
         R_lin_independent_imp_same_scalars[of _ _ ms]
   by    auto
 
 lemma R_lin_independentI_all_scalars :
   "set ms \<subseteq> M \<Longrightarrow>
         (\<forall>rs. set rs \<subseteq> R \<and> length rs = length ms \<and> rs \<bullet>\<cdot> ms = 0 \<longrightarrow> set rs \<subseteq> 0)
           \<Longrightarrow> R_lin_independent ms"
 proof (induct ms)
   case (Cons m ms) show ?case
   proof (rule R_lin_independent_ConsI)
     have "\<And>rs. \<lbrakk> set rs \<subseteq> R; length rs = length ms; rs \<bullet>\<cdot> ms = 0 \<rbrakk> \<Longrightarrow> set rs \<subseteq> 0"
     proof-
       fix rs assume rs: "set rs \<subseteq> R" "length rs = length ms" "rs \<bullet>\<cdot> ms = 0"
       with Cons(2) have "set (0#rs) \<subseteq> R" "length (0#rs)
                               = length (m#ms)" "(0#rs) \<bullet>\<cdot> (m#ms) = 0"
         using R_scalars.zero_closed lincomb_Cons zero_smult by auto
       with Cons(3) have "set (0#rs) \<subseteq> 0" by fast
       thus "set rs \<subseteq> 0" by simp
     qed
     with Cons(1,2) show "R_lin_independent ms" by simp
   next
     fix r rs assume r_rs: "set (r # rs) \<subseteq> R" "(r # rs) \<bullet>\<cdot> (m # ms) = 0"
     from r_rs(1) Cons(2) obtain ss
       where ss: "set ss \<subseteq> R" "length ss = length ms" "rs \<bullet>\<cdot> ms = ss \<bullet>\<cdot> ms"
       using lincomb_obtain_same_length_Rcoeffs[of rs ms]
       by    auto
     with r_rs have "(r#ss) \<bullet>\<cdot> (m#ms) = 0" using lincomb_Cons by simp
     moreover from r_rs(1) ss(1) have "set (r#ss) \<subseteq> R" by simp
     moreover from ss(2) have "length (r#ss) = length (m#ms)" by simp
     ultimately have "set (r#ss) \<subseteq> 0" using Cons(3) by fast
     thus "r = 0" by simp
   qed
 qed simp
 
 lemma R_lin_independentI_concat_all_scalars :
   defines eq_len: "eq_len \<equiv> \<lambda>xs ys. length xs = length ys"
   assumes "set (concat mss) \<subseteq> M"
           "\<And>rss. set (concat rss) \<subseteq> R \<Longrightarrow> list_all2 eq_len rss mss
               \<Longrightarrow> (concat rss) \<bullet>\<cdot> (concat mss) = 0 \<Longrightarrow> (\<forall>rs \<in> set rss. set rs \<subseteq> 0)"
   shows   "R_lin_independent (concat mss)"
   using   assms(2)
 proof (rule R_lin_independentI_all_scalars)
   have "\<And>rs. \<lbrakk> set rs \<subseteq> R; length rs = length (concat mss); rs \<bullet>\<cdot> concat mss = 0 \<rbrakk>
               \<Longrightarrow> set rs \<subseteq> 0"
   proof-
     fix rs
     assume rs: "set rs \<subseteq> R" "length rs = length (concat mss)" "rs \<bullet>\<cdot> concat mss = 0"
     from rs(2) eq_len obtain rss where "rs = concat rss" "list_all2 eq_len rss mss"
       using match_concat by fast
     with rs(1,3) assms(3) show "set rs \<subseteq> 0" by auto
   qed
   thus "\<forall>rs. set rs \<subseteq> R \<and> length rs = length (concat mss) \<and> rs \<bullet>\<cdot> concat mss = 0
               \<longrightarrow> set rs \<subseteq> 0"
     by auto
 qed
 
 lemma R_lin_independentD_all_scalars :
   "\<lbrakk> set rs \<subseteq> R; set ms \<subseteq> M; length rs \<le> length ms; R_lin_independent ms;
         rs \<bullet>\<cdot> ms = 0 \<rbrakk> \<Longrightarrow> set rs \<subseteq> 0"
 proof (induct rs ms rule: list_induct2')
   case (4 r rs m ms)
   from 4(2,5,6) have "r = 0" by auto
   moreover with 4 have "set rs \<subseteq> 0" using lincomb_Cons zero_smult by simp
   ultimately show ?case by simp
 qed auto
 
 lemma R_lin_independentD_all_scalars_nth :
   assumes "set rs \<subseteq> R" "set ms \<subseteq> M" "R_lin_independent ms" "rs \<bullet>\<cdot> ms = 0"
           "k < min (length rs) (length ms)"
   shows   "rs!k = 0"
 proof-
   from assms(1,2) obtain ss
     where ss: "set ss \<subseteq> R" "length ss = length ms"
               "take (length rs) ss = take (length ms) rs" "rs \<bullet>\<cdot> ms = ss \<bullet>\<cdot> ms"
     using lincomb_obtain_same_length_Rcoeffs[of rs ms]
     by    fast
   from ss(1,2,4) assms(2,3,4) have "set ss \<subseteq> 0"
     using R_lin_independentD_all_scalars by auto
   moreover from assms(5) ss(3) have "rs!k = (take (length rs) ss)!k" by simp
   moreover from assms(5) ss(2) have "k < length (take (length rs) ss)" by simp
   ultimately show ?thesis using in_set_conv_nth by force
 qed
 
 lemma R_lin_dependent_dependence_relation :
   "set ms \<subseteq> M \<Longrightarrow> \<not> R_lin_independent ms
         \<Longrightarrow> \<exists>rs. set rs \<subseteq> R \<and> set rs \<noteq> 0 \<and> length rs = length ms \<and> rs \<bullet>\<cdot> ms = 0"
 proof (induct ms)
   case (Cons m ms) show ?case
   proof (cases "R_lin_independent ms")
     case True
     with Cons(3)
       have "\<not> (\<forall>r rs. (set (r#rs) \<subseteq> R \<and> (r#rs) \<bullet>\<cdot> (m#ms) = 0) \<longrightarrow> r = 0)"
       by   simp
     from this obtain r rs
       where r_rs: "set (r#rs) \<subseteq> R" "(r#rs) \<bullet>\<cdot> (m#ms) = 0" "r \<noteq> 0"
       by    fast
     from r_rs(1) Cons(2) obtain ss  
       where ss: "set ss \<subseteq> R" "length ss = length ms" "rs \<bullet>\<cdot> ms = ss \<bullet>\<cdot> ms"
       using lincomb_obtain_same_length_Rcoeffs[of rs ms]
       by    auto
     from ss r_rs have "set (r#ss) \<subseteq> R \<and> set (r#ss) \<noteq> 0
                             \<and> length (r#ss) = length (m#ms) \<and> (r#ss) \<bullet>\<cdot> (m#ms) = 0"
       using lincomb_Cons
       by    simp
     thus ?thesis by fast
   next
     case False
     with Cons(1,2) obtain rs  
       where rs: "set rs \<subseteq> R" "set rs \<noteq> 0" "length rs = length ms" "rs \<bullet>\<cdot> ms = 0"
       by    fastforce
     from False rs Cons(2)
       have  "set (0#rs) \<subseteq> R \<and> set (0#rs) \<noteq> 0 \<and> length (0#rs) = length (m#ms)
                   \<and> (0#rs) \<bullet>\<cdot> (m#ms) = 0"
       using Ring1.zero_closed[OF Ring1] lincomb_Cons[of 0 rs m ms]
             zero_smult[of m] empty_set_diff_single[of "set rs"]
       by    fastforce
     thus ?thesis by fast
   qed
 qed simp
 
 lemma R_lin_independent_imp_distinct :
   "set ms \<subseteq> M \<Longrightarrow> R_lin_independent ms \<Longrightarrow> distinct ms"
 proof (induct ms)
   case (Cons m ms)
   have "\<And>n. n \<in> set ms \<Longrightarrow> m \<noteq> n"
   proof
     fix n assume n: "n \<in> set ms" "m = n"
     from n(1) obtain xs ys where "ms = xs @ n # ys" using split_list by fast
     with Cons(2) n(2)
       have  "(1 # replicate (length xs) 0 @ [-1]) \<bullet>\<cdot> (m # ms) = 0"
       using lincomb_Cons lincomb_append lincomb_replicate0_left lincomb_Nil neg_eq_neg1_smult
       by    simp
     with Cons(3) have "1 = 0"
       using R_scalars.zero_closed one_closed R_scalars.neg_closed by force
     thus False using one_neq_zero by fast
   qed
   with Cons show ?case by auto
 qed simp
 
 lemma R_lin_independent_imp_independent_take : 
   "set ms \<subseteq> M \<Longrightarrow> R_lin_independent ms \<Longrightarrow> R_lin_independent (take n ms)"
 proof (induct ms arbitrary: n)
   case (Cons m ms) show ?case
   proof (cases n)
     case (Suc k)
     hence "take n (m#ms) = m # take k ms" by simp
     moreover have "R_lin_independent (m # take k ms)"
     proof (rule R_lin_independent_ConsI)
       from Cons show "R_lin_independent (take k ms)" by simp
     next
       fix r rs assume r_rs: "set (r#rs) \<subseteq> R" "(r#rs)\<bullet>\<cdot>(m # take k ms) = 0"
       from r_rs(1) Cons(2) obtain ss
         where ss: "set ss \<subseteq> R" "length ss = length (take k ms)"
                   "rs \<bullet>\<cdot> take k ms = ss \<bullet>\<cdot> take k ms"
         using set_take_subset[of k ms] lincomb_obtain_same_length_Rcoeffs
         by    force
       from r_rs(1) ss(1) have "set (r#ss) \<subseteq> R" by simp
       moreover from r_rs(2) ss have "(r#ss) \<bullet>\<cdot> (m#ms) = 0"
         using lincomb_Cons lincomb_Nil
               lincomb_append_right[of ss "take k ms" "drop k ms"]
         by    simp
       ultimately show "r = 0" using Cons(3) by auto
     qed
     ultimately show ?thesis by simp
   qed simp
 qed simp
 
 lemma R_lin_independent_Cons_imp_independent_RSpans :
   assumes "m \<in> M" "R_lin_independent (m#ms)"
   shows   "add_independentS [RSpan [m], RSpan ms]"
 proof (rule add_independentS_doubleI)
   fix x y assume xy: "x \<in> RSpan [m]" "y \<in> RSpan ms" "x + y = 0"
   from xy(1,2) obtain r rs where r_rs: "r \<in> R" "x = r \<cdot> m" "set rs \<subseteq> R" "y = rs \<bullet>\<cdot> ms"
     using RSpan_single RSpanD_lincomb by fast
   with xy(3) have "set (r#rs) \<subseteq> R" "(r#rs) \<bullet>\<cdot> (m#ms) = 0"
     using lincomb_Cons by auto
   with assms r_rs(2) show "x = 0" using zero_smult by auto
 qed
 
 lemma hd0_imp_R_lin_dependent : "\<not> R_lin_independent (0#ms)"
   using lincomb_Cons[of 1 "[]" 0 ms] lincomb_Nil[of "[]" ms] smult_zero one_closed 
         R_lin_independent_Cons
   by    fastforce
 
 lemma R_lin_independent_imp_hd_n0 : "R_lin_independent (m#ms) \<Longrightarrow> m \<noteq> 0"
   using hd0_imp_R_lin_dependent by fast
 
 lemma R_lin_independent_imp_hd_independent_from_RSpan :
   assumes "m \<in> M" "set ms \<subseteq> M" "R_lin_independent (m#ms)"
   shows   "m \<notin> RSpan ms"
 proof
   assume m: "m \<in> RSpan ms"
   with assms(2) have "(-1) \<cdot> m \<in> RSpan ms"
     using RSubmodule_RSpan[of ms]
           RModule.smult_closed[of R smult "RSpan ms" "-1" m]
           one_closed R_scalars.neg_closed[of 1]
     by    simp
   moreover from assms(1) have "m + (-1) \<cdot> m = 0"
     using neg_eq_neg1_smult by simp
   ultimately show False
     using RSpan_contains_spanset_single assms R_lin_independent_Cons_imp_independent_RSpans
           add_independentS_doubleD R_lin_independent_imp_hd_n0
     by    fast
 qed
 
 lemma R_lin_independent_reduce :
   assumes "n \<in> M"
   shows   "set ms \<subseteq> M \<Longrightarrow> R_lin_independent (ms @ n # ns)
                 \<Longrightarrow> R_lin_independent (ms @ ns)"
 proof (induct ms)
   case (Cons m ms)
   moreover have "\<And>r rs. set (r#rs) \<subseteq> R \<Longrightarrow> (r#rs) \<bullet>\<cdot> (m#ms@ns) = 0
                       \<Longrightarrow> r = 0"
   proof-
     fix r rs assume r_rs: "set (r#rs) \<subseteq> R" "(r#rs) \<bullet>\<cdot> (m # ms @ ns) = 0"
     from Cons(2) r_rs(1) obtain ss
       where ss: "set ss \<subseteq> R" "length ss = length ms" "rs \<bullet>\<cdot> ms = ss \<bullet>\<cdot> ms"
       using lincomb_obtain_same_length_Rcoeffs[of rs ms]
       by    auto
     from assms ss(2,3) r_rs(2)
       have  "(r # ss @ 0 # drop (length ms) rs) \<bullet>\<cdot> (m # ms @ n # ns) = 0"
       using lincomb_Cons
             lincomb_append_right add.assoc[of "r\<cdot>m" "rs\<bullet>\<cdot>ms" "(drop (length ms) rs)\<bullet>\<cdot>ns"]
             zero_smult lincomb_append
       by    simp
     moreover from r_rs(1) ss(1)
       have  "set (r # ss @ 0 # drop (length ms) rs) \<subseteq> R"
       using R_scalars.zero_closed set_drop_subset[of _ rs]
       by    auto
     ultimately show "r = 0"
       using Cons(3)
             R_lin_independent_ConsD2[of m _ r "ss @ 0 # drop (length ms) rs"]
       by    simp
   qed
   ultimately show "R_lin_independent ( (m#ms) @ ns)" by auto
 qed simp
 
 lemma R_lin_independent_vs_lincomb0 :
   assumes "set (ms@n#ns) \<subseteq> M" "R_lin_independent (ms @ n # ns)"
           "set (rs@s#ss) \<subseteq> R" "length rs = length ms"
           "(rs@s#ss) \<bullet>\<cdot> (ms@n#ns) = 0"
   shows   "s = 0"
 proof-
   define k where "k = length rs"
   hence "(rs@s#ss)!k = s" by simp
   moreover from k_def assms(4) have "k < min (length (rs@s#ss)) (length (ms@n#ns))"
     by simp
   ultimately show ?thesis
     using assms(1,2,3,5) R_lin_independentD_all_scalars_nth[of "rs@s#ss" "ms@n#ns"]
     by    simp
 qed
 
 lemma R_lin_independent_append_imp_independent_RSpans :
   "set ms \<subseteq> M \<Longrightarrow> R_lin_independent (ms@ns)
         \<Longrightarrow> add_independentS [RSpan ms, RSpan ns]"
 proof (induct ms)
   case (Cons m ms)
   show ?case
   proof (rule add_independentS_doubleI)
     fix x y assume xy: "y \<in> RSpan ns""x \<in> RSpan (m#ms)"  "x + y = 0"
     from xy(2) obtain x1 x2
       where x1_x2: "x1 \<in> RSpan [m]" "x2 \<in> RSpan ms" "x = x1 + x2"
       using RSpan_Cons set_plus_def[of "RSpan [m]"]
       by    auto
     from x1_x2(1,2) xy(1) obtain r rs ss
       where r_rs_ss: "set (r#(rs@ss)) \<subseteq> R" "length rs = length ms" "x1 = r \<cdot> m"
                      "x2 = rs \<bullet>\<cdot> ms" "y = ss \<bullet>\<cdot> ns"
       using RSpan_single in_RSpan_obtain_same_length_coeffs[of x2 ms]
             RSpanD_lincomb[of ns]
       by    auto
     have x1_0: "x1 = 0"
     proof-
       from xy(3) x1_x2(3) r_rs_ss(2-5) have "(r#(rs@ss)) \<bullet>\<cdot> (m#(ms@ns)) = 0"
         using lincomb_append lincomb_Cons by (simp add: algebra_simps)
       with r_rs_ss(1,3) Cons(2,3) show ?thesis
         using R_lin_independent_ConsD2[of m "ms@ns" r "rs@ss"] zero_smult by simp
     qed
     moreover have "x2 = 0"
     proof-
       from x1_0 xy(3) x1_x2(3) have "x2 + y = 0" by simp
       with xy(1) x1_x2(2) Cons show ?thesis
         using add_independentS_doubleD by simp
     qed
     ultimately show "x = 0" using x1_x2(3) by simp
   qed
 qed simp
 
 end (* context RModule *)
 
 subsubsection \<open>Linear independence over \<open>UNIV\<close>\<close>
 
 context scalar_mult
 begin
 
 abbreviation "lin_independent ms
                     \<equiv> R_scalar_mult.R_lin_independent UNIV smult ms"
 
 lemmas lin_independent_ConsI
               = R_scalar_mult.R_lin_independent_ConsI [OF R_scalar_mult, of smult]
 lemmas lin_independent_ConsD1
               = R_scalar_mult.R_lin_independent_ConsD1[OF R_scalar_mult, of smult]
 
 end (* context scalar_mult *)
 
 context Module
 begin
 
 lemmas lin_independent_imp_independent_take = R_lin_independent_imp_independent_take
 lemmas lin_independent_reduce               = R_lin_independent_reduce
 lemmas lin_independent_vs_lincomb0          = R_lin_independent_vs_lincomb0
 lemmas lin_dependent_dependence_relation    = R_lin_dependent_dependence_relation
 lemmas lin_independent_imp_distinct         = R_lin_independent_imp_distinct
 
 lemmas lin_independent_imp_hd_independent_from_Span
                                                 = R_lin_independent_imp_hd_independent_from_RSpan
 lemmas lin_independent_append_imp_independent_Spans
                                                 = R_lin_independent_append_imp_independent_RSpans
 
 end (* context Module *)
 
 subsubsection \<open>Rank\<close>
 
 context R_scalar_mult
 begin
 
 definition R_finrank :: "'m set \<Rightarrow> bool"
   where "R_finrank M = (\<exists>n. \<forall>ms. set ms \<subseteq> M
               \<and> R_lin_independent ms \<longrightarrow> length ms \<le> n)"
 
 lemma R_finrankI :
   "(\<And>ms. set ms \<subseteq> M \<Longrightarrow> R_lin_independent ms \<Longrightarrow> length ms \<le> n) 
         \<Longrightarrow> R_finrank M"
   unfolding R_finrank_def by blast
 
 lemma R_finrankD :
   "R_finrank M \<Longrightarrow> \<exists>n. \<forall>ms. set ms \<subseteq> M \<and> R_lin_independent ms 
         \<longrightarrow> length ms \<le> n"
   unfolding R_finrank_def by fast
 
 lemma submodule_R_finrank : "R_finrank M \<Longrightarrow> N \<subseteq> M \<Longrightarrow> R_finrank N"
   unfolding R_finrank_def by blast
 
 end (* context R_scalar_mult *)
 
 context scalar_mult
 begin
 
 abbreviation finrank :: "'m set \<Rightarrow> bool"
   where "finrank \<equiv> R_scalar_mult.R_finrank UNIV smult"
 
 lemmas finrankI = R_scalar_mult.R_finrankI[OF R_scalar_mult, of _ smult]
 lemmas finrankD = R_scalar_mult.R_finrankD[OF R_scalar_mult, of smult]
 lemmas submodule_finrank
               = R_scalar_mult.submodule_R_finrank [OF R_scalar_mult, of smult]
 
 end (* context scalar_mult *)
 
 
 subsection \<open>Module homomorphisms\<close>
 
 subsubsection \<open>Locales\<close>
 
 locale RModuleHom = Domain?: RModule R smult M
 + Codomain?: scalar_mult smult'
 + GroupHom?: GroupHom M T
   for R      :: "'r::ring_1 set"
   and smult  :: "'r \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
   and M      :: "'m set"
   and smult' :: "'r \<Rightarrow> 'n::ab_group_add \<Rightarrow> 'n" (infixr "\<star>" 70)
   and T      :: "'m \<Rightarrow> 'n"
 + assumes R_map: "\<And>r m. r \<in> R \<Longrightarrow> m \<in> M \<Longrightarrow> T (r \<cdot> m) = r \<star> T m"
 
 abbreviation (in RModuleHom) lincomb' :: "'r list \<Rightarrow> 'n list \<Rightarrow> 'n" (infix "\<bullet>\<star>" 70)
   where "lincomb' \<equiv> Codomain.lincomb"
 
 lemma (in RModule) RModuleHomI :
   assumes "GroupHom M T"
           "\<And>r m. r \<in> R \<Longrightarrow> m \<in> M \<Longrightarrow> T (r \<cdot> m) = smult' r (T m)"
   shows   "RModuleHom R smult M smult' T"
   by      (
             rule RModuleHom.intro, rule RModule_axioms, rule assms(1), unfold_locales,
             rule assms(2)
           )
 
 locale RModuleEnd = RModuleHom R smult M smult T
   for R     :: "'r::ring_1 set"
   and smult :: "'r \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
   and M     :: "'m set"
   and T     :: "'m \<Rightarrow> 'm"
 + assumes endomorph: "ImG \<subseteq> M"
 
 locale ModuleHom = RModuleHom UNIV smult M smult' T
   for smult  :: "'r::ring_1 \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
   and M      :: "'m set"
   and smult' :: "'r \<Rightarrow> 'n::ab_group_add \<Rightarrow> 'n" (infixr "\<star>" 70)
   and T      :: "'m \<Rightarrow> 'n"
 
 lemmas (in ModuleHom) hom = hom
 
 lemmas (in Module) ModuleHomI = RModuleHomI[THEN ModuleHom.intro]
 
 locale ModuleEnd = ModuleHom smult M smult T
   for smult :: "'r::ring_1 \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
   and M     :: "'m set" and T :: "'m \<Rightarrow> 'm"
 + assumes endomorph: "ImG \<subseteq> M"
 
 locale RModuleIso = RModuleHom R smult M smult' T
   for   R      :: "'r::ring_1 set"
   and   smult  :: "'r \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
   and   M      :: "'m set"
   and   smult' :: "'r \<Rightarrow> 'n::ab_group_add \<Rightarrow> 'n" (infixr "\<star>" 70)
   and   T      :: "'m \<Rightarrow> 'n"
 + fixes N      :: "'n set"
   assumes bijective: "bij_betw T M N"
 
 lemma (in RModule) RModuleIsoI :
   assumes "GroupIso M T N"
           "\<And>r m. r \<in> R \<Longrightarrow> m \<in> M \<Longrightarrow> T (r \<cdot> m) = smult' r (T m)"
   shows   "RModuleIso R smult M smult' T N"
 proof (rule RModuleIso.intro)
   from assms show "RModuleHom R (\<cdot>) M smult' T"
     using GroupIso.axioms(1) RModuleHomI by fastforce
   from assms(1) show "RModuleIso_axioms M T N"
     using GroupIso.bijective by unfold_locales
 qed
 
 subsubsection \<open>Basic facts\<close>
 
 lemma (in RModule) trivial_RModuleHom :
   "\<forall>r\<in>R. smult' r 0 = 0 \<Longrightarrow> RModuleHom R smult M smult' 0"
   using trivial_GroupHom RModuleHomI by fastforce
 
 lemma (in RModule) RModHom_idhom : "RModuleHom R smult M smult (id\<down>M)"
   using RModule_axioms GroupHom_idhom
 proof (rule RModuleHom.intro)
   show "RModuleHom_axioms R (\<cdot>) M (\<cdot>) (id \<down> M)"
     using smult_closed by unfold_locales simp
 qed
 
 context RModuleHom
 begin
 
 lemmas additive        = hom
 lemmas supp            = supp
 lemmas im_zero         = im_zero
 lemmas im_diff         = im_diff
 lemmas Ker_Im_iff      = Ker_Im_iff
 lemmas Ker0_imp_inj_on = Ker0_imp_inj_on
 
 lemma GroupHom : "GroupHom M T" ..
 
 lemma codomain_smult_zero : "r \<in> R \<Longrightarrow> r \<star> 0 = 0"
   using im_zero smult_zero zero_closed R_map[of r 0] by simp
 
 lemma RSubmodule_Ker : "Domain.RSubmodule Ker"
 proof (rule Domain.RSubmoduleI, rule conjI, rule Group_Ker)
   fix r m assume r: "r \<in> R" and m: "m \<in> Ker"
   thus "r \<cdot> m \<in> Ker"
     using R_map[of r m] kerD[of m T] codomain_smult_zero kerI Domain.smult_closed
     by    simp
 qed fast
 
 lemma RModule_Im : "RModule R smult' ImG"
   using Ring1 Group_Im
 proof (rule RModuleI, unfold_locales)
   show "\<And>n. n \<in> T ` M \<Longrightarrow> 1 \<star> n = n" using one_closed R_map[of 1] by auto
 next
   fix r s m n assume r: "r \<in> R" and s: "s \<in> R" and m: "m \<in> T ` M"
     and n: "n \<in> T ` M"
   from m n obtain m' n'
     where m': "m' \<in> M" "m = T m'" and n': "n' \<in> M" "n = T n'"
     by    fast
   from m' r R_map have "r \<star> m = T (r \<cdot> m')" by simp
   with r m'(1) show "r \<star> m \<in> T ` M" using smult_closed by fast
   from r m' n' show "r \<star> (m + n) = r \<star> m + r \<star> n"
     using hom add_closed R_map[of r "m'+n'"] smult_closed R_map[of r] by simp
   from r s m' show "(r + s) \<star> m = r \<star> m + s \<star> m"
     using R_scalars.add_closed R_map[of "r+s"] smult_closed hom R_map by simp
   from r s m' show "r \<star> s \<star> m = (r * s) \<star> m"
     using smult_closed R_map[of s] R_map[of r "s \<cdot> m'"] mult_closed R_map[of "r*s"]
     by    simp
 qed
 
 lemma im_submodule :
   assumes "RSubmodule N"
   shows   "RModule.RSubmodule R smult' ImG (T ` N)"
 proof (rule RModule.RSubmoduleI, rule RModule_Im)
   from assms show "Group.Subgroup (T ` M) (T ` N)"
     using im_subgroup Subgroup_RSubmodule by fast
   from assms R_map  show "\<And>r n. r \<in> R \<Longrightarrow> n \<in> T ` N \<Longrightarrow> r \<star> n \<in> T ` N"
     using RModule.smult_closed by force
 qed
 
 lemma RModHom_composite_left :
   assumes "T ` M \<subseteq> N" "RModuleHom R smult' N smult'' S"
   shows   "RModuleHom R smult M smult'' (S \<circ> T)"
 proof (rule RModule.RModuleHomI, rule RModule_axioms)
   from assms(1) show "GroupHom M (S \<circ> T)"
     using RModuleHom.GroupHom[OF assms(2)] GroupHom_composite_left
     by    auto
   from assms(1)
     show  "\<And>r m. r \<in> R \<Longrightarrow> m \<in> M \<Longrightarrow> (S \<circ> T) (r \<cdot> m) = smult'' r ((S \<circ> T) m)"
     using R_map RModuleHom.R_map[OF assms(2)]
     by    auto
 qed
 
 lemma RModuleHom_restrict0_submodule :
   assumes "RSubmodule N"
   shows   "RModuleHom R smult N smult' (T \<down> N)"
 proof (rule RModuleHom.intro)
   from assms show "RModule R (\<cdot>) N" by fast
   from assms show "GroupHom N (T \<down> N)"
     using RModule.Group GroupHom_restrict0_subgroup by fast
   show "RModuleHom_axioms R (\<cdot>) N (\<star>) (T \<down> N)"
   proof
     fix r m assume "r \<in> R" "m \<in> N"
     with assms show "(T \<down> N) (r \<cdot> m) = r \<star> (T \<down> N) m"
       using RModule.smult_closed R_map by fastforce
   qed
 qed
 
 lemma distrib_lincomb :
   "set rs \<subseteq> R \<Longrightarrow> set ms \<subseteq> M \<Longrightarrow> T (rs \<bullet>\<cdot> ms) = rs \<bullet>\<star> map T ms"
   using Domain.lincomb_Nil im_zero Codomain.lincomb_Nil R_map Domain.lincomb_Cons
         Domain.smult_closed Domain.lincomb_closed additive Codomain.lincomb_Cons
   by    (induct rs ms rule: list_induct2') auto
 
 lemma same_image_on_RSpanset_imp_same_hom :
   assumes "RModuleHom R smult M smult' S" "set ms \<subseteq> M"
           "M = Domain.R_scalars.RSpan ms" "\<forall>m\<in>set ms. S m = T m"
   shows   "S = T"
 proof
   fix m show "S m = T m"
   proof (cases "m \<in> M")
     case True
     with assms(2,3) obtain rs where rs: "set rs \<subseteq> R" "m = rs \<bullet>\<cdot> ms"
       using Domain.RSpanD_lincomb_arb_len_coeffs by fast
     from rs(1) assms(2) have "S (rs \<bullet>\<cdot> ms) = rs \<bullet>\<star> (map S ms)"
       using RModuleHom.distrib_lincomb[OF assms(1)] by simp
     moreover from rs(1) assms(2) have "T (rs \<bullet>\<cdot> ms) = rs \<bullet>\<star> (map T ms)"
       using distrib_lincomb by simp
     ultimately show ?thesis using assms(4) map_ext[of ms S T] rs(2) by auto
   next
     case False with assms(1) supp show ?thesis
       using RModuleHom.supp suppI_contra[of _ S] suppI_contra[of _ T] by fastforce
   qed
 qed
 
 end (* context RModuleHom *)
 
 lemma RSubmodule_eigenspace :
   fixes   smult :: "'r::ring_1 \<Rightarrow> 'm::ab_group_add \<Rightarrow> 'm" (infixr "\<cdot>" 70)
   assumes RModHom: "RModuleHom R smult M smult T"
   and     r: "r \<in> R" "\<And>s m. s \<in> R \<Longrightarrow> m \<in> M \<Longrightarrow> s \<cdot> r \<cdot> m = r \<cdot> s \<cdot> m"
   defines E: "E \<equiv> {m \<in> M. T m = r \<cdot> m}"
   shows   "RModule.RSubmodule R smult M E"
 proof (rule RModule.RSubmoduleI)
   from RModHom show rmod: "RModule R smult M"
     using RModuleHom.axioms(1) by fast
   have "Group E"
   proof
     from r(1) E show "E \<noteq> {}"
       using RModule.zero_closed[OF rmod] RModuleHom.im_zero[OF RModHom]
             RModule.smult_zero[OF rmod]
       by    auto
   next
     fix m n assume "m \<in> E" "n \<in> E"
     with r(1) E show "m - n \<in> E"
       using RModule.diff_closed[OF rmod] RModuleHom.im_diff[OF RModHom] 
             RModule.smult_distrib_left_diff[OF rmod]
       by    simp
   qed
   with E show "Group.Subgroup M E" by fast
   show "\<And>s m. s \<in> R \<Longrightarrow> m \<in> E \<Longrightarrow> s \<cdot> m \<in> E"
   proof-
     fix s m assume "s \<in> R" "m \<in> E"
     with E r RModuleHom.R_map[OF RModHom] show "s \<cdot> m \<in> E"
       using RModule.smult_closed[OF rmod] by simp
   qed
 qed
 
 subsubsection \<open>Basic facts about endomorphisms\<close>
 
 lemma (in RModule) Rmap_endomorph_is_RModuleEnd :
   assumes grpend: "GroupEnd M T"
   and     Rmap  : "\<And>r m. r \<in> R \<Longrightarrow> m \<in> M \<Longrightarrow> T (r \<cdot> m) = r \<cdot> (T m)"
   shows   "RModuleEnd R smult M T"
 proof (rule RModuleEnd.intro, rule RModuleHomI)
   from grpend show "GroupHom M T" using GroupEnd.axioms(1) by fast
   from grpend show "RModuleEnd_axioms M T"
     using GroupEnd.endomorph by unfold_locales
 qed (rule Rmap)
 
 lemma (in RModuleEnd) GroupEnd : "GroupEnd M T"
 proof (rule GroupEnd.intro)
   from endomorph show "GroupEnd_axioms M T" by unfold_locales
 qed (unfold_locales)
 
 lemmas (in RModuleEnd) proj_decomp    = GroupEnd.proj_decomp[OF GroupEnd]
 
 lemma (in ModuleEnd) RModuleEnd : "RModuleEnd UNIV smult M T"
   using endomorph RModuleEnd.intro by unfold_locales
 
 lemmas (in ModuleEnd) GroupEnd = RModuleEnd.GroupEnd[OF RModuleEnd]
 
 lemma RModuleEnd_over_UNIV_is_ModuleEnd :
   "RModuleEnd UNIV rsmult M T \<Longrightarrow> ModuleEnd rsmult M T"
 proof (rule ModuleEnd.intro, rule ModuleHom.intro)
   assume endo: "RModuleEnd UNIV rsmult M T"
   thus "RModuleHom UNIV rsmult M rsmult T"
     using RModuleEnd.axioms(1) by fast
   from endo show "ModuleEnd_axioms M T"
     using RModuleEnd.endomorph by unfold_locales
 qed
 
 subsubsection \<open>Basic facts about isomorphisms\<close>
 
 context RModuleIso
 begin
 
 abbreviation "invT \<equiv> (the_inv_into M T) \<down> N"
 
 lemma GroupIso : "GroupIso M T N"
 proof (rule GroupIso.intro)
   show "GroupHom M T" ..
   from bijective show "GroupIso_axioms M T N" by unfold_locales
 qed
 
 lemmas ImG           = GroupIso.ImG         [OF GroupIso]
 lemmas GroupHom_inv = GroupIso.inv        [OF GroupIso]
 lemmas invT_into    = GroupIso.invT_into  [OF GroupIso]
 lemmas T_invT       = GroupIso.T_invT     [OF GroupIso]
 lemmas invT_eq      = GroupIso.invT_eq    [OF GroupIso]
 
 lemma RModuleN : "RModule R smult' N" using RModule_Im ImG by fast
 
 lemma inv : "RModuleIso R smult' N smult invT M"
   using RModuleN GroupHom_inv
 proof (rule RModule.RModuleIsoI)
   fix r n assume rn: "r \<in> R" "n \<in> N"
   thus "invT (r \<star> n) = r \<cdot> invT n"
     using invT_into smult_closed R_map T_invT invT_eq by simp
 qed
 
 end (* context RModuleIso *)
 
 
 subsection \<open>Inner direct sums of RModules\<close>
 
 lemma (in RModule) RModule_inner_dirsum_el_decomp_Rsmult :
   assumes "\<forall>N\<in>set Ns. RSubmodule N" "add_independentS Ns" "r \<in> R"
           "x \<in> (\<Oplus>N\<leftarrow>Ns. N)"
   shows   "(\<Oplus>Ns\<leftarrow>(r \<cdot> x)) = [r \<cdot> m. m\<leftarrow>(\<Oplus>Ns\<leftarrow>x)]"
 proof-
   define xs where "xs = (\<Oplus>Ns\<leftarrow>x)"
   with assms have x: "xs \<in> listset Ns" "x = sum_list xs"
     using RModule.AbGroup[of R] AbGroup_inner_dirsum_el_decompI[of Ns x]
     by    auto
   from assms(1,2,4) xs_def have xs_M: "set xs \<subseteq> M"
     using Subgroup_RSubmodule
           AbGroup.abSubgroup_inner_dirsum_el_decomp_set[OF AbGroup]
     by    fast
   from assms(1,3) x(1) have "[r \<cdot> m. m\<leftarrow>xs] \<in> listset Ns"
     using listset_RModule_Rsmult_closed by fast
   moreover from x assms(3) xs_M have "r \<cdot> x = sum_list [r \<cdot> m. m\<leftarrow>xs]"
     using smult_sum_list_distrib by fast
   moreover from assms(1,3,4) have "r \<cdot> x \<in> (\<Oplus>M\<leftarrow>Ns. M)" 
     using RModule_inner_dirsum RModule.smult_closed by fast
   ultimately show "(\<Oplus>Ns\<leftarrow>(r \<cdot> x)) = [r \<cdot> m. m\<leftarrow>xs]"
     using assms(1,2) RModule.AbGroup AbGroup_inner_dirsum_el_decomp_eq
      by   fast
 qed
 
 lemma (in RModule) RModuleEnd_inner_dirsum_el_decomp_nth :
   assumes "\<forall>N \<in> set Ns. RSubmodule N" "add_independentS Ns" "n < length Ns"
   shows   "RModuleEnd R smult (\<Oplus>N\<leftarrow>Ns. N) (\<Oplus>Ns\<down>n)"
 proof (rule RModule.Rmap_endomorph_is_RModuleEnd)
   from assms(1) show "RModule R smult (\<Oplus>N\<leftarrow>Ns. N)"
     using RSubmodule_inner_dirsum by fast
   from assms show "GroupEnd (\<Oplus>N\<leftarrow>Ns. N) \<Oplus>Ns\<down>n"
     using RModule.AbGroup GroupEnd_inner_dirsum_el_decomp_nth[of Ns] by fast
   show "\<And>r m. r \<in> R \<Longrightarrow> m \<in> (\<Oplus>N\<leftarrow>Ns. N)
               \<Longrightarrow> (\<Oplus>Ns\<down>n) (r \<cdot> m) = r \<cdot> ((\<Oplus>Ns\<down>n) m)"
   proof-
     fix r m assume "r \<in> R" "m \<in> (\<Oplus>N\<leftarrow>Ns. N)"
     moreover with assms(1) have "r \<cdot> m \<in> (\<Oplus>M\<leftarrow>Ns. M)" 
       using RModule_inner_dirsum RModule.smult_closed by fast
     ultimately show "(\<Oplus>Ns\<down>n) (r \<cdot> m) = r \<cdot> (\<Oplus>Ns\<down>n) m"
       using assms RModule.AbGroup[of R smult]
             AbGroup_length_inner_dirsum_el_decomp[of Ns]
             RModule_inner_dirsum_el_decomp_Rsmult
       by    simp
   qed
 qed
 
 
 
 
 section \<open>Vector Spaces\<close>
 
 
 subsection \<open>Locales and basic facts\<close>
 
 text \<open>Here we don't care about being able to switch scalars.\<close>
 
 locale fscalar_mult = scalar_mult smult
   for smult :: "'f::field \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
 
 abbreviation (in fscalar_mult) "findim \<equiv> fingen"
 
 locale VectorSpace = Module smult V
   for smult :: "'f::field \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   and V     :: "'v set"
 
 lemmas VectorSpaceI = ModuleI[THEN VectorSpace.intro]
 
 sublocale VectorSpace < fscalar_mult proof- qed
 
 locale FinDimVectorSpace = VectorSpace
 + assumes findim: "findim V"
 
 lemma (in VectorSpace) FinDimVectorSpaceI :
   "findim V \<Longrightarrow> FinDimVectorSpace (\<cdot>) V"
   by unfold_locales fast
 
 context VectorSpace
 begin
 
 abbreviation Subspace :: "'v set \<Rightarrow> bool" where "Subspace \<equiv> Submodule"
 
 lemma SubspaceD1 : "Subspace U \<Longrightarrow> VectorSpace smult U"
   using VectorSpace.intro Module.intro by fast
 
 lemmas AbGroup                           = AbGroup
 lemmas add_closed                        = add_closed
 lemmas smult_closed                      = smult_closed
 lemmas one_smult                         = one_smult
 lemmas smult_assoc                       = smult_assoc
 lemmas smult_distrib_left                = smult_distrib_left
 lemmas smult_distrib_right               = smult_distrib_right
 lemmas zero_closed                       = zero_closed
 lemmas zero_smult                        = zero_smult
 lemmas smult_zero                        = smult_zero
 lemmas smult_lincomb                     = smult_lincomb
 lemmas smult_distrib_left_diff           = smult_distrib_left_diff
 lemmas smult_sum_distrib              = smult_sum_distrib
 lemmas sum_smult_distrib              = sum_smult_distrib
 lemmas lincomb_sum                       = lincomb_sum
 lemmas lincomb_closed                    = lincomb_closed
 lemmas lincomb_concat                    = lincomb_concat
 lemmas lincomb_replicate0_left           = lincomb_replicate0_left
 lemmas delta_scalars_lincomb_eq_nth      = delta_scalars_lincomb_eq_nth
 lemmas SpanI                             = SpanI
 lemmas Span_closed                       = Span_closed
 lemmas SpanD_lincomb_arb_len_coeffs      = SpanD_lincomb_arb_len_coeffs
 lemmas SpanI_lincomb_arb_len_coeffs      = SpanI_lincomb_arb_len_coeffs
 lemmas in_Span_obtain_same_length_coeffs = in_Span_obtain_same_length_coeffs
 lemmas SubspaceI                         = SubmoduleI
 lemmas subspace_finrank                  = submodule_finrank
 
 lemma cancel_scalar: "\<lbrakk> a \<noteq> 0; u \<in> V; v \<in> V; a \<cdot> u = a \<cdot> v \<rbrakk> \<Longrightarrow> u = v"
   using smult_assoc[of "1/a" a u] by simp
 
 end (* context VectorSpace *)
 
 
 subsection \<open>Linear algebra in vector spaces\<close>
 
 subsubsection \<open>Linear independence and spanning\<close>
 
 context VectorSpace
 begin
 
 lemmas Subspace_Span                         = Submodule_Span
 lemmas lin_independent_Nil                   = R_lin_independent_Nil
 lemmas lin_independentI_concat_all_scalars   = R_lin_independentI_concat_all_scalars
 lemmas lin_independentD_all_scalars          = R_lin_independentD_all_scalars
 lemmas lin_independent_obtain_unique_scalars = R_lin_independent_obtain_unique_scalars
 
 lemma lincomb_Cons_0_imp_in_Span :
   "\<lbrakk> v \<in> V; set vs \<subseteq> V; a \<noteq> 0; (a#as) \<bullet>\<cdot> (v#vs) = 0 \<rbrakk> \<Longrightarrow> v \<in> Span vs"
   using lincomb_Cons eq_neg_iff_add_eq_0[of "a \<cdot> v" "as \<bullet>\<cdot> vs"]
         neg_lincomb smult_assoc[of "1/a" a v] smult_lincomb SpanD_lincomb_arb_len_coeffs
   by    auto
 
 lemma lin_independent_Cons_conditions :  
   "\<lbrakk> v \<in> V; set vs \<subseteq> V; v \<notin> Span vs; lin_independent vs \<rbrakk>
         \<Longrightarrow> lin_independent (v#vs)"
   using lincomb_Cons_0_imp_in_Span lin_independent_ConsI by fast
 
 lemma coeff_n0_imp_in_Span_others :
   assumes "v \<in> V" "set us \<subseteq> V" "set vs \<subseteq> V" "b \<noteq> 0" "length as = length us"
           "w = (as @ b # bs) \<bullet>\<cdot> (us @ v # vs)"
   shows   "v \<in> Span (w # us @ vs)"
 proof-
   define x where "x = (1 # [- c. c\<leftarrow>as@bs]) \<bullet>\<cdot> (w # us @ vs)"
   from assms(1,4-6) have "v = (1/b) \<cdot> (w + - ( (as@bs) \<bullet>\<cdot> (us@vs) ))"
     using lincomb_append lincomb_Cons by simp
   moreover from assms(1,2,3,6) have w: "w \<in> V" using lincomb_closed by simp
   ultimately have "v = (1/b) \<cdot> x"
     using x_def assms(2,3) neg_lincomb[of _ "us@vs"] lincomb_Cons[of 1 _ w] by simp
   with x_def w assms(2,3) show ?thesis
     using SpanD_lincomb_arb_len_coeffs[of "w # us @ vs"]
           Span_smult_closed[of "1/b" "w # us @ vs" x]
     by    auto
 qed
 
 lemma lin_independent_replace1_by_lincomb :
   assumes "set us \<subseteq> V" "v \<in> V" "set vs \<subseteq> V" "lin_independent (us @ v # vs)"
           "length as = length us" "b \<noteq> 0"
   shows   "lin_independent ( ((as @ b # bs) \<bullet>\<cdot> (us @ v # vs)) # us @ vs )"
 proof-
   define w where "w = (as @ b # bs) \<bullet>\<cdot> (us @ v # vs)"
   from assms(1,2,4) have "lin_independent (us @ vs)"
     using lin_independent_reduce by fast
   hence "lin_independent (w # us @ vs)"
   proof (rule lin_independent_ConsI)
     fix c cs assume A: "(c#cs) \<bullet>\<cdot> (w # us @ vs) = 0"
     from assms(1,3) obtain ds es fs
       where dsesfs: "length ds = length vs" "bs \<bullet>\<cdot> vs = ds \<bullet>\<cdot> vs"
                     "length es = length vs" "(drop (length us) cs) \<bullet>\<cdot> vs = es \<bullet>\<cdot> vs"
                     "length fs = length us" "cs \<bullet>\<cdot> us = fs \<bullet>\<cdot> us"
       using lincomb_obtain_same_length_coeffs[of bs vs]
             lincomb_obtain_same_length_coeffs[of "drop (length us) cs" vs]
             lincomb_obtain_same_length_coeffs[of cs us]
       by    auto
     define xs ys
       where "xs = [x+y. (x,y)\<leftarrow>zip [c*a. a\<leftarrow>as] fs]"
         and "ys = [x+y. (x,y)\<leftarrow>zip es [c*d. d\<leftarrow>ds]]"
     with assms(5) dsesfs(5) have len_xs: "length xs = length us"
       using length_concat_map_split_zip[of _ "[c*a. a\<leftarrow>as]" fs] by simp
     from A w_def assms(1-3,5) dsesfs(2,4,6)
       have "0 = c \<cdot> as \<bullet>\<cdot> us + fs \<bullet>\<cdot> us + (c * b) \<cdot> v + es \<bullet>\<cdot> vs + c \<cdot> ds \<bullet>\<cdot> vs"
       using lincomb_Cons lincomb_append_right lincomb_append add_closed smult_closed
             lincomb_closed
       by    (simp add: algebra_simps)
     also from assms(1,3,5) dsesfs(1,3,5) xs_def ys_def len_xs
       have "\<dots> = (xs @ (c * b) # ys) \<bullet>\<cdot> (us @ v # vs)"
       using smult_lincomb lincomb_sum lincomb_Cons lincomb_append by simp
     finally have "(xs @ (c * b) # ys) \<bullet>\<cdot> (us @ v # vs) = 0" by simp
     with assms(1-3,4,6) len_xs show "c = 0"
       using lin_independent_vs_lincomb0 by fastforce
   qed
   with w_def show ?thesis by fast
 qed
 
 lemma build_lin_independent_seq :
   assumes us_V: "set us \<subseteq> V"
   and     indep_us: "lin_independent us"
   shows   "\<exists>ws. set ws \<subseteq> V \<and> lin_independent (ws @ us) \<and> (Span (ws @ us) = V
                 \<or> length ws = n)"
 proof (induct n)
   case 0 from indep_us show ?case by force
 next
   case (Suc m)
   from this obtain ws 
     where ws: "set ws \<subseteq> V" "lin_independent (ws @ us)"
               "Span (ws@us) = V \<or> length ws = m"
     by    auto
   show ?case
   proof (cases "V = Span (ws@us)")
     case True with ws show ?thesis by fast
   next
     case False
     moreover from ws(1) us_V have ws_us_V: "set (ws @ us) \<subseteq> V" by simp
     ultimately have "Span (ws@us) \<subset> V" using Span_closed by fast
     from this obtain w where w: "w \<in> V" "w \<notin> Span (ws@us)" by fast
     define vs where "vs = w # ws"
     with w ws_us_V ws(2,3)
       have  "set (vs @ us) \<subseteq> V" "lin_independent (vs @ us)" "length vs = Suc m"
       using lin_independent_Cons_conditions[of w "ws@us"]
       by    auto
     thus ?thesis by auto
   qed
 qed
 
 end (* context VectorSpace *)
 
 subsubsection \<open>Basis for a vector space: \<open>basis_for\<close>\<close>
 
 abbreviation (in fscalar_mult) basis_for :: "'v set \<Rightarrow> 'v list \<Rightarrow> bool"
   where "basis_for V vs \<equiv> (set vs \<subseteq> V \<and> V = Span vs \<and> lin_independent vs)"
 
 context VectorSpace
 begin
 
 lemma spanset_contains_basis :
   "set vs \<subseteq> V \<Longrightarrow> \<exists>us. set us \<subseteq> set vs \<and> basis_for (Span vs) us"
 proof (induct vs)
   case Nil show ?case using lin_independent_Nil by simp
 next
   case (Cons v vs)
   from this obtain ws where ws: "set ws \<subseteq> set vs" "basis_for (Span vs) ws" by auto
   show ?case
   proof (cases "v \<in> Span vs")
     case True
     with Cons(2) ws(2) have "basis_for (Span (v#vs)) ws"
       using spanset_reduce_Cons by force
     with ws(1) show ?thesis by auto
   next
     case False
     from Cons(2) ws
       have  "set (v#ws) \<subseteq> set (v#vs)" "set (v#ws) \<subseteq> Span (v#vs)"
             "Span (v#vs) = Span (v#ws)"
       using Span_contains_spanset[of "v#vs"]
             Span_contains_Spans_Cons_right[of v vs] Span_Cons
       by    auto
     moreover have "lin_independent (v#ws)"
     proof (rule lin_independent_Cons_conditions)
       from Cons(2) ws(1) show "v \<in> V" "set ws \<subseteq> V" by auto
       from ws(2) False show "v \<notin> Span ws" "lin_independent ws" by auto
     qed
     ultimately show ?thesis by blast
   qed
 qed
 
 lemma basis_for_Span_ex : "set vs \<subseteq> V \<Longrightarrow> \<exists>us. basis_for (Span vs) us"
   using spanset_contains_basis by fastforce
 
 lemma replace_basis_one_step :
   assumes closed: "set vs \<subseteq> V" "set us \<subseteq> V" and indep: "lin_independent (us@vs)"
   and     new_w: "w \<in> Span (us@vs) - Span us"
   shows   "\<exists>xs y ys. vs = xs @ y # ys
                 \<and> basis_for (Span (us@vs)) (w # us @ xs @ ys)"
 proof-
   from new_w obtain u v where uv: "u \<in> Span us" "v \<in> Span vs" "w = u + v"
     using Span_append set_plus_def[of "Span us"] by auto
   from uv(1,3) new_w have v_n0: "v \<noteq> 0" by auto
   from uv(1,2) obtain as bs
     where as_bs: "length as = length us" "u = as \<bullet>\<cdot> us" "length bs = length vs"
                  "v = bs \<bullet>\<cdot> vs"
     using in_Span_obtain_same_length_coeffs
     by    blast
   from v_n0 as_bs(4) closed(1) obtain b where b: "b \<in> set bs" "b \<noteq> 0"
     using lincomb_0coeffs[of vs] by auto
   from b(1) obtain cs ds where cs_ds: "bs = cs @ b # ds" using split_list by fast
   define n where "n = length cs"
   define fvs where "fvs = take n vs"
   define y where "y = vs!n"
   define bvs where "bvs = drop (Suc n) vs"
   define ufvs where "ufvs = us @ fvs"
   define acs where "acs = as @ cs"
   from as_bs(1,3) cs_ds n_def acs_def ufvs_def fvs_def
     have n_len_vs: "n < length vs" and len_acs: "length acs = length ufvs"
     by   auto
   from n_len_vs fvs_def y_def bvs_def have vs_decomp: "vs = fvs @ y # bvs"
     using id_take_nth_drop by simp
   with uv(3) as_bs(1,2,4) cs_ds acs_def ufvs_def
     have  w_decomp: "w = (acs @ b # ds) \<bullet>\<cdot> (ufvs @ y # bvs)"
     using lincomb_append
     by    simp
   from closed(1) vs_decomp
     have y_V: "y \<in> V" and fvs_V: "set fvs \<subseteq> V" and bvs_V: "set bvs \<subseteq> V"
     by   auto
   from ufvs_def fvs_V closed(2) have ufvs_V: "set ufvs \<subseteq> V" by simp
   from w_decomp ufvs_V y_V bvs_V have w_V: "w \<in> V"
     using lincomb_closed by simp
   have "Span (us@vs) = Span (w # ufvs @ bvs)"
   proof
     from vs_decomp ufvs_def have 1: "Span (us@vs) = Span (y # ufvs @ bvs)"
       using Span_append Span_Cons[of y bvs] Span_Cons[of y ufvs]
             Span_append[of "y#ufvs" bvs]
       by    (simp add: algebra_simps)
     with new_w y_V ufvs_V bvs_V show "Span (w # ufvs @ bvs) \<subseteq> Span (us@vs)"
       using Span_replace_hd by simp
     from len_acs w_decomp y_V ufvs_V bvs_V have "y \<in> Span (w # ufvs @ bvs)"
       using b(2) coeff_n0_imp_in_Span_others by simp
     with w_V ufvs_V bvs_V have "Span (y # ufvs @ bvs) \<subseteq> Span (w # ufvs @ bvs)"
       using Span_replace_hd by simp
     with 1 show "Span (us@vs) \<subseteq> Span (w # ufvs @ bvs)" by fast
   qed
   moreover from ufvs_V y_V bvs_V ufvs_def indep vs_decomp w_decomp len_acs b(2)
     have  "lin_independent (w # ufvs @ bvs)"
     using lin_independent_replace1_by_lincomb[of ufvs y bvs acs b ds]
     by    simp
   moreover have "set (w # (us@fvs) @ bvs) \<subseteq> Span (us@vs)"
   proof-
     from new_w have "w \<in> Span (us@vs)" by fast
     moreover from closed have "set us \<subseteq> Span (us@vs)"
       using Span_contains_spanset_append_left by fast
     moreover from closed fvs_def have "set fvs \<subseteq> Span (us@vs)"
       using Span_contains_spanset_append_right[of us] set_take_subset by fastforce
     moreover from closed bvs_def have "set bvs \<subseteq> Span (us@vs)"
       using Span_contains_spanset_append_right[of us] set_drop_subset by fastforce
     ultimately show ?thesis by simp
   qed
   ultimately show ?thesis using ufvs_def vs_decomp by auto
 qed
 
 lemma replace_basis :
   assumes closed: "set vs \<subseteq> V" and indep_vs: "lin_independent vs"
   shows   "\<lbrakk> length us \<le> length vs; set us \<subseteq> Span vs; lin_independent us \<rbrakk>
                 \<Longrightarrow> \<exists>pvs. length pvs = length vs \<and> set pvs = set vs
                   \<and> basis_for (Span vs) (take (length vs) (us @ pvs))"
 proof (induct us)
   case Nil from closed indep_vs show ?case
     using Span_contains_spanset[of vs] by fastforce
 next
   case (Cons u us)
   from this obtain ppvs
     where ppvs: "length ppvs = length vs" "set ppvs = set vs"
                 "basis_for (Span vs) (take (length vs) (us @ ppvs))"
     using lin_independent_ConsD1[of u us]
     by    auto
   define fppvs bppvs
     where "fppvs = take (length vs - length us) ppvs"
       and "bppvs = drop (length vs - length us) ppvs"
   with ppvs(1) Cons(2)
     have ppvs_decomp: "ppvs = fppvs @ bppvs"
     and  len_fppvs  : "length fppvs = length vs - length us"
     by    auto
   from closed Cons(3) have uus_V:  "u \<in> V" "set us \<subseteq> V"
     using Span_closed by auto
   from closed ppvs(2) have "set ppvs \<subseteq> V" by fast
   with fppvs_def have fppvs_V: "set fppvs \<subseteq> V" using set_take_subset[of _ ppvs] by fast
   from fppvs_def Cons(2)
     have prev_basis_decomp: "take (length vs) (us @ ppvs) = us @ fppvs"
     by   auto
   with Cons(3,4) ppvs(3) fppvs_V uus_V obtain xs y ys
     where xs_y_ys: "fppvs = xs @ y # ys" "basis_for (Span vs) (u # us @ xs @ ys)"
     using lin_independent_imp_hd_independent_from_Span
           replace_basis_one_step[of fppvs us u]
     by    auto
   define pvs where "pvs = xs @ ys @ y # bppvs"
   with xs_y_ys len_fppvs ppvs_decomp ppvs(1,2)
     have "length pvs = length vs" "set pvs = set vs" 
          "basis_for (Span vs) (take (length vs) ((u # us) @ pvs))"
     using take_append[of "length vs" "u # us @ xs @ ys"]
     by    auto
   thus ?case by fast
 qed
 
 lemma replace_basis_completely :
   "\<lbrakk> set vs \<subseteq> V; lin_independent vs; length us = length vs;
         set us \<subseteq> Span vs; lin_independent us \<rbrakk> \<Longrightarrow> basis_for (Span vs) us"
   using replace_basis[of vs us] by auto
 
 lemma basis_for_obtain_unique_scalars :
   "basis_for V vs \<Longrightarrow> v \<in> V \<Longrightarrow> \<exists>! as. length as = length vs \<and> v = as \<bullet>\<cdot> vs"
   using lin_independent_obtain_unique_scalars by fast
 
 lemma add_unique_scalars :
   assumes vs: "basis_for V vs" and v: "v \<in> V" and v': "v' \<in> V"
   defines as: "as \<equiv> (THE ds. length ds = length vs \<and> v = ds \<bullet>\<cdot> vs)"
   and     bs: "bs \<equiv> (THE ds. length ds = length vs \<and> v' = ds \<bullet>\<cdot> vs)"
   and     cs: "cs \<equiv> (THE ds. length ds = length vs \<and> v+v' = ds \<bullet>\<cdot> vs)"
   shows   "cs = [a+b. (a,b)\<leftarrow>zip as bs]"
 proof-
   from vs v v' as bs
     have  as': "length as = length vs \<and> v = as \<bullet>\<cdot> vs"
     and   bs': "length bs = length vs \<and> v' = bs \<bullet>\<cdot> vs"
     using basis_for_obtain_unique_scalars theI'[
             of "\<lambda>ds. length ds = length vs \<and> v = ds \<bullet>\<cdot> vs"
           ]
           theI'[of "\<lambda>ds. length ds = length vs \<and> v' = ds \<bullet>\<cdot> vs"]
     by    auto
   have "length [a+b. (a,b)\<leftarrow>zip as bs] = length (zip as bs)"
     by (induct as bs rule: list_induct2') auto
   with vs as' bs'
     have  "length [a+b. (a,b)\<leftarrow>zip as bs]
                 = length vs \<and> v + v' = [a + b. (a,b)\<leftarrow>zip as bs] \<bullet>\<cdot> vs"
     using lincomb_sum
     by    auto
   moreover from vs v v' have "\<exists>! ds. length ds = length vs \<and> v+v' = ds \<bullet>\<cdot> vs"
     using add_closed basis_for_obtain_unique_scalars by force
   ultimately show ?thesis using cs the1_equality by fast
 qed
 
 lemma smult_unique_scalars :
   fixes   a::'f
   assumes vs: "basis_for V vs" and v: "v \<in> V"
   defines as: "as \<equiv> (THE cs. length cs = length vs \<and> v = cs \<bullet>\<cdot> vs)"
   and     bs: "bs \<equiv> (THE cs. length cs = length vs \<and> a \<cdot> v = cs \<bullet>\<cdot> vs)"
   shows   "bs = map ((*) a) as"
 proof-
   from vs v as have "length as = length vs \<and> v = as \<bullet>\<cdot> vs"
     using basis_for_obtain_unique_scalars theI'[
             of "\<lambda>cs. length cs = length vs \<and> v = cs \<bullet>\<cdot> vs"
           ]
     by    auto
   with vs have "length (map ((*) a) as)
                       = length vs \<and> a \<cdot> v = (map ((*) a) as) \<bullet>\<cdot> vs"
     using smult_lincomb by auto
   moreover from vs v have "\<exists>! cs. length cs = length vs \<and> a \<cdot> v = cs \<bullet>\<cdot> vs"
     using smult_closed basis_for_obtain_unique_scalars by fast
   ultimately show ?thesis using bs the1_equality by fast
 qed
 
 lemma max_lin_independent_set_in_Span :
   assumes "set vs \<subseteq> V" "set us \<subseteq> Span vs" "lin_independent us"
   shows   "length us \<le> length vs"
 proof (cases us)
   case (Cons x xs)
   from assms(1) spanset_contains_basis[of vs] obtain bvs
     where bvs: "set bvs \<subseteq> set vs" "basis_for (Span vs) bvs"
     by    auto
   with assms(1) have len_bvs: "length bvs \<le> length vs"
     using lin_independent_imp_distinct[of bvs] distinct_card finite_set 
           card_mono[of "set vs" "set bvs"] card_length[of vs]
     by    fastforce
   moreover have "length (x#xs) > length bvs \<Longrightarrow> \<not> lin_independent (x#xs)"
   proof
     assume A: "length (x#xs) > length bvs" "lin_independent (x#xs)"
     define ws where "ws = take (length bvs) xs"
     from Cons assms(1,2) have xxs_V: "x \<in> V" "set xs \<subseteq> V"
       using Span_closed by auto
     from ws_def A(1) have "length ws = length bvs" by simp
     moreover from Cons assms(2) bvs(2) ws_def have "set ws \<subseteq> Span bvs"
       using set_take_subset by fastforce
     ultimately have "basis_for (Span vs) ws"
       using A(2) ws_def assms(1) bvs xxs_V lin_independent_ConsD1
             lin_independent_imp_independent_take replace_basis_completely[of bvs ws]
       by    force
     with Cons assms(2) ws_def A(2) xxs_V show False
       using Span_contains_Span_take[of xs]
             lin_independent_imp_hd_independent_from_Span[of x xs]
       by    auto
   qed
   ultimately show ?thesis using Cons assms(3) by fastforce
 qed simp
 
 lemma finrank_Span : "set vs \<subseteq> V \<Longrightarrow> finrank (Span vs)"
   using max_lin_independent_set_in_Span finrankI by blast
 
 end (* context VectorSpace *)
 
 
 subsection \<open>Finite dimensional spaces\<close>
 
 context VectorSpace
 begin
 
 lemma dim_eq_size_basis : "basis_for V vs \<Longrightarrow> length vs = dim V"
   using max_lin_independent_set_in_Span
         Least_equality[
           of "\<lambda>n::nat. \<exists>us. length us = n \<and> set us \<subseteq> V \<and> RSpan us = V" "length vs"
         ]
   unfolding dim_R_def by fastforce
 
 lemma finrank_imp_findim :
   assumes "finrank V"
   shows   "findim V"
 proof-
   from assms obtain n
     where "\<forall>vs. set vs \<subseteq> V \<and> lin_independent vs \<longrightarrow> length vs \<le> n"
     using finrankD
     by    fastforce
   moreover from build_lin_independent_seq[of "[]"] obtain ws
     where "set ws \<subseteq> V" "lin_independent ws" "Span ws = V \<or> length ws = Suc n"
     by    auto
   ultimately show ?thesis by auto
 qed
 
 lemma subspace_Span_is_findim :
   "\<lbrakk> set vs \<subseteq> V; Subspace W; W \<subseteq> Span vs \<rbrakk> \<Longrightarrow> findim W"
   using finrank_Span subspace_finrank[of "Span vs" W] SubspaceD1[of W]
         VectorSpace.finrank_imp_findim
   by    auto
 
 end (* context VectorSpace *)
 
 context FinDimVectorSpace
 begin
 
 lemma Subspace_is_findim : "Subspace U \<Longrightarrow> findim U"
   using findim subspace_Span_is_findim by fast
 
 lemma basis_ex : "\<exists>vs. basis_for V vs"
   using findim basis_for_Span_ex by auto
 
 lemma lin_independent_length_le_dim :
   "set us \<subseteq> V \<Longrightarrow> lin_independent us \<Longrightarrow> length us \<le> dim V"
   using basis_ex max_lin_independent_set_in_Span dim_eq_size_basis
   by    force
 
 lemma too_long_lin_dependent :
   "set us \<subseteq> V \<Longrightarrow> length us > dim V \<Longrightarrow> \<not> lin_independent us"
   using lin_independent_length_le_dim by fastforce
 
 lemma extend_lin_independent_to_basis :
   assumes "set us \<subseteq> V" "lin_independent us"
   shows   "\<exists>vs. basis_for V (vs @ us)"
 proof-
   define n where "n = Suc (dim V - length us)"
   from assms obtain vs
     where vs: "set vs \<subseteq> V" "lin_independent (vs @ us)"
               "Span (vs @ us) = V \<or> length vs = n"
     using build_lin_independent_seq[of us n]
     by    fast
   with assms n_def show ?thesis
     using set_append lin_independent_length_le_dim[of "vs @ us"] by auto
 qed
 
 lemma extend_Subspace_basis :
   "U \<subseteq> V \<Longrightarrow> basis_for U us \<Longrightarrow> \<exists>vs. basis_for V (vs@us)"
   using Span_contains_spanset extend_lin_independent_to_basis by fast
 
 lemma Subspace_dim_le :
   assumes "Subspace U"
   shows   "dim U \<le> dim V"
   using   assms findim 
 proof-
   from assms obtain us where "basis_for U us"
     using Subspace_is_findim SubspaceD1
           VectorSpace.FinDimVectorSpaceI[of "(\<cdot>)" U]
           FinDimVectorSpace.basis_ex[of "(\<cdot>)" U]
     by    auto
   with assms show ?thesis
     using RSpan_contains_spanset[of us] lin_independent_length_le_dim[of us]
           SubspaceD1 VectorSpace.dim_eq_size_basis[of "(\<cdot>)" U us]
     by    auto
 qed
 
 lemma Subspace_eqdim_imp_equal :
   assumes "Subspace U" "dim U = dim V"
   shows   "U = V"
 proof-
   from assms(1) obtain us where us: "basis_for U us"
     using Subspace_is_findim SubspaceD1
           VectorSpace.FinDimVectorSpaceI[of "(\<cdot>)" U]
           FinDimVectorSpace.basis_ex[of "(\<cdot>)" U]
     by    auto
   with assms(1) obtain vs where vs: "basis_for V (vs@us)"
     using extend_Subspace_basis[of U us] by fast
   from assms us vs show ?thesis
     using SubspaceD1 VectorSpace.dim_eq_size_basis[of smult U]
           dim_eq_size_basis[of "vs@us"]
     by    auto
 qed
 
 lemma Subspace_dim_lt : "Subspace U \<Longrightarrow> U \<noteq> V \<Longrightarrow> dim U < dim V"
   using Subspace_dim_le Subspace_eqdim_imp_equal by fastforce
 
 lemma semisimple :
   assumes "Subspace U"
   shows   "\<exists>W. Subspace W \<and> (V = W \<oplus> U)"
 proof-
   from assms obtain us where us: "basis_for U us"
     using SubspaceD1 Subspace_is_findim VectorSpace.FinDimVectorSpaceI
           FinDimVectorSpace.basis_ex[of _ U]
     by    fastforce
   with assms obtain ws where basis: "basis_for V (ws@us)"
     using extend_Subspace_basis by fastforce
   hence ws_V: "set ws \<subseteq> V" and ind_ws_us: "lin_independent (ws@us)"
     and V_eq: "V = Span (ws@us)"
     by  auto
   have "V = Span ws \<oplus> Span us"
   proof (rule inner_dirsum_doubleI)
     from V_eq show "V = Span ws + Span us" using Span_append by fast
     from ws_V ind_ws_us show "add_independentS [Span ws, Span us]"
       using lin_independent_append_imp_independent_Spans by auto
   qed
   with us ws_V have "Subspace (Span ws) \<and> V = (Span ws) \<oplus> U"
     using Subspace_Span by auto
   thus ?thesis by fast
 qed
 
 end (* context FinDimVectorSpace *)
 
 
 subsection \<open>Vector space homomorphisms\<close>
 
 subsubsection \<open>Locales\<close>
 
 locale VectorSpaceHom = ModuleHom smult V smult' T
   for smult  :: "'f::field \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   and V      :: "'v set"
   and smult' :: "'f \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and T      :: "'v \<Rightarrow> 'w"
 
 sublocale VectorSpaceHom < VectorSpace ..
 
 lemmas (in VectorSpace)
   VectorSpaceHomI = ModuleHomI[THEN VectorSpaceHom.intro]
 
 lemma (in VectorSpace) VectorSpaceHomI_fromaxioms :
   assumes "\<And>g g'. g \<in> V \<Longrightarrow> g' \<in> V \<Longrightarrow> T (g + g') = T g + T g'"
           "supp T \<subseteq> V"
           "\<And>r m. r \<in> UNIV \<Longrightarrow> m \<in> V \<Longrightarrow> T (r \<cdot> m) = smult' r (T m)"
   shows   "VectorSpaceHom smult V smult' T"
   using   assms
   by      unfold_locales
 
 locale VectorSpaceEnd = VectorSpaceHom smult V smult T
   for smult :: "'f::field \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   and V     :: "'v set"
   and T     :: "'v \<Rightarrow> 'v"
 + assumes endomorph: "ImG \<subseteq> V"
 
 abbreviation (in VectorSpace) "VEnd \<equiv> VectorSpaceEnd smult V"
 
 lemma VectorSpaceEndI :
   fixes   smult :: "'f::field \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v"
   assumes "VectorSpaceHom smult V smult T" "T ` V \<subseteq> V"
   shows   "VectorSpaceEnd smult V T"
   by      (rule VectorSpaceEnd.intro, rule assms(1), unfold_locales, rule assms(2))
 
 lemma (in VectorSpaceEnd) VectorSpaceHom: "VectorSpaceHom smult V smult T"
   ..
 
 lemma (in VectorSpaceEnd) ModuleEnd : "ModuleEnd smult V T"
   using endomorph ModuleEnd.intro by unfold_locales
 
 locale VectorSpaceIso = VectorSpaceHom smult V smult' T
   for   smult  :: "'f::field \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   and   V      :: "'v set"
   and   smult' :: "'f \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and   T      :: "'v \<Rightarrow> 'w"
 + fixes W      :: "'w set"
   assumes bijective: "bij_betw T V W"
 
 abbreviation (in VectorSpace) isomorphic ::
   "('f \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w) \<Rightarrow> 'w set \<Rightarrow> bool"
   where "isomorphic smult' W \<equiv> (\<exists> T. VectorSpaceIso smult V smult' T W)"
 
 subsubsection \<open>Basic facts\<close>
 
 lemma (in VectorSpace) trivial_VectorSpaceHom :
   "(\<And>a. smult' a 0 = 0) \<Longrightarrow> VectorSpaceHom smult V smult' 0"
   using trivial_RModuleHom[of smult'] ModuleHom.intro VectorSpaceHom.intro
   by    fast
 
 lemma (in VectorSpace) VectorSpaceHom_idhom :
   "VectorSpaceHom smult V smult (id\<down>V)"
   using smult_zero RModHom_idhom ModuleHom.intro VectorSpaceHom.intro
   by    fast
 
 context VectorSpaceHom
 begin
 
 lemmas hom             = hom
 lemmas supp            = supp
 lemmas f_map           = R_map
 lemmas im_zero         = im_zero
 lemmas im_sum_list_prod = im_sum_list_prod
 lemmas additive        = additive
 lemmas GroupHom        = GroupHom
 lemmas distrib_lincomb = distrib_lincomb
 
 lemmas same_image_on_spanset_imp_same_hom
   = same_image_on_RSpanset_imp_same_hom[
       OF ModuleHom.axioms(1), OF VectorSpaceHom.axioms(1)
     ]
 
 lemma VectorSpace_Im : "VectorSpace smult' ImG"
   using RModule_Im VectorSpace.intro Module.intro by fast
 
 lemma VectorSpaceHom_scalar_mul :
   "VectorSpaceHom smult V smult' (\<lambda>v. a \<star> T v)"
 proof
   show "\<And>v v'. v \<in> V \<Longrightarrow> v' \<in> V \<Longrightarrow> a \<star> T (v + v') = a \<star> T v + a \<star> T v'"
     using additive VectorSpace.smult_distrib_left[OF VectorSpace_Im] by simp
   have "\<And>v. v \<notin> V \<Longrightarrow> v \<notin> supp (\<lambda>v. a \<star> T v)"
   proof-
     fix v assume "v \<notin> V"
     hence "a \<star> T v = 0"
       using supp suppI_contra[of _ T] codomain_smult_zero by fastforce
     thus "v \<notin> supp (\<lambda>v. a \<star> T v)" using suppD_contra by fast
   qed
   thus "supp (\<lambda>v. a \<star> T v) \<subseteq> V" by fast
   show "\<And>c v. v \<in> V \<Longrightarrow> a \<star> T (c \<cdot> v) = c \<star> a \<star> T v"
     using f_map VectorSpace.smult_assoc[OF VectorSpace_Im] by (simp add: field_simps)
 qed
 
 lemma VectorSpaceHom_composite_left :
   assumes "ImG \<subseteq> W" "VectorSpaceHom smult' W smult'' S"
   shows   "VectorSpaceHom smult V smult'' (S \<circ> T)"
 proof-
   have "RModuleHom UNIV smult' W smult'' S"
     using VectorSpaceHom.axioms(1)[OF assms(2)] ModuleHom.axioms(1)
     by    fast
   with assms(1) have "RModuleHom UNIV smult V smult'' (S \<circ> T)"
     using RModHom_composite_left[of W] by fast
   thus ?thesis using ModuleHom.intro VectorSpaceHom.intro by fast
 qed
 
 lemma findim_domain_findim_image :
   assumes "findim V"
   shows   "fscalar_mult.findim smult' ImG"
 proof-
   from assms obtain vs where vs: "set vs \<subseteq> V" "scalar_mult.Span smult vs = V"
     by fast
   define ws where "ws = map T vs"
   with vs(1) have 1: "set ws \<subseteq> ImG" by auto
   moreover have "Span ws = ImG"
   proof
     show "Span ws \<subseteq> ImG"
       using 1 VectorSpace.Span_closed[OF VectorSpace_Im] by fast
     from vs ws_def show "Span ws \<supseteq> ImG"
       using 1 SpanD_lincomb_arb_len_coeffs distrib_lincomb
             VectorSpace.SpanD_lincomb_arb_len_coeffs[OF VectorSpace_Im]
       by auto
   qed
   ultimately show ?thesis by fast
 qed
 
 end (* context VectorSpaceHom *)
 
 lemma (in VectorSpace) basis_im_defines_hom :
   fixes   smult'   :: "'f \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and     lincomb' :: "'f list \<Rightarrow> 'w list \<Rightarrow> 'w" (infixr "\<bullet>\<star>" 70)
   defines lincomb'  : "lincomb' \<equiv> scalar_mult.lincomb smult'"
   assumes VSpW      : "VectorSpace smult' W"
   and     basisV    : "basis_for V vs"
   and     basisV_im : "set ws \<subseteq> W" "length ws = length vs"
   shows   "\<exists>! T. VectorSpaceHom smult V smult' T \<and> map T vs = ws"
 proof (rule ex_ex1I)
   define T where "T = restrict0 (\<lambda>v. (THE as. length as = length vs \<and> v = as \<bullet>\<cdot> vs) \<bullet>\<star> ws) V"
   have "VectorSpaceHom (\<cdot>) V smult' T"
   proof
     fix v v' assume vv': "v \<in> V" "v' \<in> V"
     with T_def lincomb' basisV basisV_im(1) show "T (v + v') = T v + T v'"
       using basis_for_obtain_unique_scalars theI'[
               of "\<lambda>ds. length ds = length vs \<and> v = ds \<bullet>\<cdot> vs"
             ]
             theI'[of "\<lambda>ds. length ds = length vs \<and> v' = ds \<bullet>\<cdot> vs"] add_closed
             add_unique_scalars VectorSpace.lincomb_sum[OF VSpW]
       by    auto
   next
     from T_def show "supp T \<subseteq> V" using supp_restrict0 by fast
   next
     fix a v assume v: "v \<in> V"
     with basisV basisV_im(1) T_def lincomb' show "T (a \<cdot> v) = a \<star> T v"
       using smult_closed smult_unique_scalars VectorSpace.smult_lincomb[OF VSpW] by auto
   qed
   moreover have "map T vs = ws"
   proof (rule nth_equalityI)
     from basisV_im(2) show "length (map T vs) = length ws" by simp
     have "\<And>i. i<length (map T vs) \<Longrightarrow> map T vs ! i = ws ! i"
     proof-
       fix i assume i: "i < length (map T vs)"
       define zs where "zs = (replicate (length vs) (0::'f))[i:=1]"
       with basisV i have "length zs = length vs \<and> vs!i = zs \<bullet>\<cdot> vs" 
         using delta_scalars_lincomb_eq_nth by auto
       moreover from basisV i have "vs!i \<in> V" by auto
       ultimately show "(map T vs)!i = ws!i"
         using basisV basisV_im T_def lincomb' zs_def i
               basis_for_obtain_unique_scalars[of vs "vs!i"]
               the1_equality[of "\<lambda>zs. length zs = length vs \<and> vs!i = zs \<bullet>\<cdot> vs"]
               VectorSpace.delta_scalars_lincomb_eq_nth[OF VSpW, of ws]
         by    force
     qed
     thus "\<And>i. i < length (map T vs) \<Longrightarrow> map T vs ! i = ws ! i" by fast
   qed
   ultimately have "VectorSpaceHom (\<cdot>) V smult' T \<and> map T vs = ws" by fast
   thus "\<exists>T. VectorSpaceHom (\<cdot>) V smult' T \<and> map T vs = ws" by fast
 next
   fix S T assume
     "VectorSpaceHom (\<cdot>) V smult' S \<and> map S vs = ws" 
     "VectorSpaceHom (\<cdot>) V smult' T \<and> map T vs = ws"
   with basisV show "S = T"
     using VectorSpaceHom.same_image_on_spanset_imp_same_hom map_eq_conv
     by    fastforce  (* slow *)
 qed
 
 subsubsection \<open>Hom-sets\<close>
 
 definition VectorSpaceHomSet ::
   "('f::field \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v) \<Rightarrow> 'v set \<Rightarrow> ('f \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w)
         \<Rightarrow> 'w set \<Rightarrow> ('v \<Rightarrow> 'w) set"
   where "VectorSpaceHomSet fsmult V fsmult' W
               \<equiv> {T. VectorSpaceHom fsmult V fsmult' T} \<inter> {T. T ` V \<subseteq> W}"
 
 abbreviation (in VectorSpace) "VectorSpaceEndSet \<equiv> {S. VEnd S}"
 
 lemma VectorSpaceHomSetI :
   "VectorSpaceHom fsmult V fsmult' T \<Longrightarrow> T ` V \<subseteq> W
         \<Longrightarrow> T \<in> VectorSpaceHomSet fsmult V fsmult' W"
   unfolding VectorSpaceHomSet_def by fast
 
 lemma VectorSpaceHomSetD_VectorSpaceHom :
   "T \<in> VectorSpaceHomSet fsmult V fsmult' N
         \<Longrightarrow> VectorSpaceHom fsmult V fsmult' T"
   unfolding VectorSpaceHomSet_def by fast
 
 lemma VectorSpaceHomSetD_Im :
   "T \<in> VectorSpaceHomSet fsmult V fsmult' W \<Longrightarrow> T ` V \<subseteq> W"
   unfolding VectorSpaceHomSet_def by fast
 
 context VectorSpace
 begin
 
 lemma VectorSpaceHomSet_is_fmaps_in_GroupHomSet :
   fixes smult' :: "'f \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   shows "VectorSpaceHomSet smult V smult' W
               = (GroupHomSet V W) \<inter> {T. \<forall>a. \<forall>v\<in>V. T (a \<cdot> v) = a \<star> (T v)}"
 proof
   show "VectorSpaceHomSet smult V smult' W
               \<subseteq> (GroupHomSet V W) \<inter> {T. \<forall>a. \<forall>v\<in>V. T (a \<cdot> v) = a \<star> (T v)}"
     using VectorSpaceHomSetD_VectorSpaceHom[of _ smult]
           VectorSpaceHomSetD_Im[of _ smult]
           VectorSpaceHom.GroupHom[of smult] GroupHomSetI[of V _ W]
           VectorSpaceHom.f_map[of smult]
     by    fastforce
   show "VectorSpaceHomSet smult V smult' W
               \<supseteq> (GroupHomSet V W) \<inter> {T. \<forall>a. \<forall>v\<in>V. T (a \<cdot> v) = a \<star> (T v)}"
   proof
     fix T assume T: "T \<in> (GroupHomSet V W)
                           \<inter> {T. \<forall>a. \<forall>v\<in>V. T (a \<cdot> v) = a \<star> (T v)}"
     have "VectorSpaceHom smult V smult' T"
     proof (rule VectorSpaceHom.intro, rule ModuleHom.intro, rule RModuleHom.intro)
       show "RModule UNIV (\<cdot>) V" ..
       from T show "GroupHom V T" using GroupHomSetD_GroupHom by fast
       from T show "RModuleHom_axioms UNIV smult V smult' T"
         by unfold_locales fast
     qed
     with T show "T \<in> VectorSpaceHomSet smult V smult' W"
       using GroupHomSetD_Im[of T] VectorSpaceHomSetI by fastforce
   qed
 qed
 
 lemma Group_VectorSpaceHomSet :
   fixes   smult' :: "'f \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   assumes "VectorSpace smult' W"
   shows   "Group (VectorSpaceHomSet smult V smult' W)"
 proof
   show "VectorSpaceHomSet smult V smult' W \<noteq> {}"
     using VectorSpace.smult_zero[OF assms] VectorSpace.zero_closed[OF assms]
           trivial_VectorSpaceHom[of smult'] VectorSpaceHomSetI
     by    fastforce
 next
   fix S T
   assume S: "S \<in> VectorSpaceHomSet smult V smult' W"
     and  T: "T \<in> VectorSpaceHomSet smult V smult' W"
   from S T
     have  ST: "S \<in> (GroupHomSet V W)
                     \<inter> {T. \<forall>a. \<forall>v\<in>V. T (a \<cdot> v) = a \<star> (T v)}"
               "T \<in> (GroupHomSet V W) \<inter> {T. \<forall>a. \<forall>v\<in>V. T (a \<cdot> v) = a \<star> (T v)}"
     using VectorSpaceHomSet_is_fmaps_in_GroupHomSet
     by    auto
   hence "S - T \<in> GroupHomSet V W"
     using VectorSpace.AbGroup[OF assms] Group_GroupHomSet Group.diff_closed
     by    fast
   moreover have "\<And>a v. v \<in> V \<Longrightarrow> (S - T) (a \<cdot> v) = a \<star> ((S-T) v)"
   proof-
     fix a v assume "v \<in> V"
     with ST show "(S - T) (a \<cdot> v) = a \<star> ((S - T) v)" 
       using GroupHomSetD_Im
             VectorSpace.smult_distrib_left_diff[OF assms, of a "S v" "T v"]
       by    fastforce
   qed
   ultimately show "S - T \<in> VectorSpaceHomSet (\<cdot>) V (\<star>) W"
     using VectorSpaceHomSet_is_fmaps_in_GroupHomSet[of smult' W] by fast
 qed
 
 lemma VectorSpace_VectorSpaceHomSet :
   fixes   smult'    :: "'f \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and     hom_smult :: "'f \<Rightarrow> ('v \<Rightarrow> 'w) \<Rightarrow> ('v \<Rightarrow> 'w)" (infixr "\<star>\<cdot>" 70)
   defines hom_smult: "hom_smult \<equiv> \<lambda>a T v. a \<star> T v"
   assumes VSpW: "VectorSpace smult' W"
   shows   "VectorSpace hom_smult (VectorSpaceHomSet smult V smult' W)"
 proof (rule VectorSpace.intro, rule Module.intro, rule RModule.intro, rule R_scalar_mult)
 
   from VSpW show "Group (VectorSpaceHomSet (\<cdot>) V (\<star>) W)"
     using Group_VectorSpaceHomSet by fast
 
   show "RModule_axioms UNIV hom_smult (VectorSpaceHomSet (\<cdot>) V (\<star>) W)"
   proof
     fix a b S T
     assume S: "S \<in> VectorSpaceHomSet (\<cdot>) V (\<star>) W"
       and  T: "T \<in> VectorSpaceHomSet (\<cdot>) V (\<star>) W"
     show "a \<star>\<cdot> T \<in> VectorSpaceHomSet (\<cdot>) V (\<star>) W"
     proof (rule VectorSpaceHomSetI)
       from assms T show "VectorSpaceHom (\<cdot>) V (\<star>) (a \<star>\<cdot> T)"
         using VectorSpaceHomSetD_VectorSpaceHom VectorSpaceHomSetD_Im
               VectorSpaceHom.VectorSpaceHom_scalar_mul
         by    fast
       from hom_smult show "(a \<star>\<cdot> T) ` V \<subseteq> W"
         using VectorSpaceHomSetD_Im[OF T] VectorSpace.smult_closed[OF VSpW]
         by    auto
     qed
 
     show "a \<star>\<cdot> (S + T) = a \<star>\<cdot> S + a \<star>\<cdot> T"
     proof
       fix v from assms show "(a \<star>\<cdot> (S + T)) v = (a \<star>\<cdot> S + a \<star>\<cdot> T) v"
         using VectorSpaceHomSetD_Im[OF S] VectorSpaceHomSetD_Im[OF T]
               VectorSpace.smult_distrib_left[OF VSpW, of a "S v" "T v"]
               VectorSpaceHomSetD_VectorSpaceHom[OF S]
               VectorSpaceHomSetD_VectorSpaceHom[OF S]
               VectorSpaceHom.supp suppI_contra[of v S] suppI_contra[of v T]
               VectorSpace.smult_zero
         by    fastforce
     qed
 
     show "(a + b) \<star>\<cdot> T = a \<star>\<cdot> T + b \<star>\<cdot> T"
     proof
       fix v from assms show "((a + b) \<star>\<cdot> T) v = (a \<star>\<cdot> T + b \<star>\<cdot> T) v"
         using VectorSpaceHomSetD_Im[OF T] VectorSpace.smult_distrib_right
               VectorSpaceHomSetD_VectorSpaceHom[OF T] VectorSpaceHom.supp
               suppI_contra[of v] VectorSpace.smult_zero
         by    fastforce
     qed
 
     show "a \<star>\<cdot> b \<star>\<cdot> T = (a * b) \<star>\<cdot> T"
     proof
       fix v from assms show "(a \<star>\<cdot> b \<star>\<cdot> T) v = ((a * b) \<star>\<cdot> T) v"
         using VectorSpaceHomSetD_Im[OF T] VectorSpace.smult_assoc
               VectorSpaceHomSetD_VectorSpaceHom[OF T]
               VectorSpaceHom.supp suppI_contra[of v]
               VectorSpace.smult_zero[OF VSpW, of b]
               VectorSpace.smult_zero[OF VSpW, of a]
               VectorSpace.smult_zero[OF VSpW, of "a * b"]
         by    fastforce
     qed
 
     show "1 \<star>\<cdot> T = T"
     proof
       fix v from assms T show "(1 \<star>\<cdot> T) v = T v"
         using VectorSpaceHomSetD_Im VectorSpace.one_smult
               VectorSpaceHomSetD_VectorSpaceHom VectorSpaceHom.supp
               suppI_contra[of v] VectorSpace.smult_zero
         by    fastforce
     qed
 
   qed
 qed
 
 end (* context VectorSpace *)
 
 subsubsection \<open>Basic facts about endomorphisms\<close>
 
 lemma ModuleEnd_over_field_is_VectorSpaceEnd :
   fixes   smult :: "'f::field \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v"
   assumes "ModuleEnd smult V T"
   shows   "VectorSpaceEnd smult V T"
 proof (rule VectorSpaceEndI, rule VectorSpaceHom.intro)
   from assms show "ModuleHom smult V smult T"
     using ModuleEnd.axioms(1) by fast
   from assms show "T ` V \<subseteq>  V" using ModuleEnd.endomorph by fast
 qed
 
 context VectorSpace
 begin
 
 lemmas VectorSpaceEnd_inner_dirsum_el_decomp_nth =
   RModuleEnd_inner_dirsum_el_decomp_nth[
     THEN RModuleEnd_over_UNIV_is_ModuleEnd,
     THEN ModuleEnd_over_field_is_VectorSpaceEnd
   ]
 
 abbreviation end_smult :: "'f \<Rightarrow> ('v \<Rightarrow> 'v) \<Rightarrow> ('v \<Rightarrow> 'v)" (infixr "\<cdot>\<cdot>" 70) 
   where "a \<cdot>\<cdot> T \<equiv> (\<lambda>v. a \<cdot> T v)"
 
 abbreviation end_lincomb
   :: "'f list \<Rightarrow> (('v \<Rightarrow> 'v) list) \<Rightarrow> ('v \<Rightarrow> 'v)" (infixr "\<bullet>\<cdot>\<cdot>" 70)
   where "end_lincomb \<equiv> scalar_mult.lincomb end_smult"
 
 lemma end_smult0: "a \<cdot>\<cdot> 0 = 0"
   using smult_zero by auto
 
 lemma end_0smult: "range T \<subseteq> V \<Longrightarrow> 0 \<cdot>\<cdot> T = 0"
   using zero_smult by fastforce
 
 lemma end_smult_distrib_left :
   assumes "range S \<subseteq> V" "range T \<subseteq> V"
   shows   "a \<cdot>\<cdot> (S + T) = a \<cdot>\<cdot> S + a \<cdot>\<cdot> T"
 proof
   fix v from assms show "(a \<cdot>\<cdot> (S + T)) v = (a \<cdot>\<cdot> S  + a \<cdot>\<cdot> T) v"
     using smult_distrib_left[of a "S v" "T v"] by fastforce
 qed
 
 lemma end_smult_distrib_right :
   assumes "range T \<subseteq> V"
   shows   "(a+b) \<cdot>\<cdot> T = a \<cdot>\<cdot> T + b \<cdot>\<cdot> T"
 proof
   fix v from assms show "((a+b) \<cdot>\<cdot> T) v = (a \<cdot>\<cdot> T + b \<cdot>\<cdot> T) v"
     using smult_distrib_right[of a b "T v"] by fastforce
 qed
 
 lemma end_smult_assoc :
   assumes "range T \<subseteq> V"
   shows   "a \<cdot>\<cdot> b \<cdot>\<cdot> T = (a * b) \<cdot>\<cdot> T"
 proof
   fix v from assms show "(a \<cdot>\<cdot> b \<cdot>\<cdot> T) v = ((a * b) \<cdot>\<cdot> T) v"
     using smult_assoc[of a b "T v"] by fastforce
 qed
 
 lemma end_smult_comp_comm_left : "(a \<cdot>\<cdot> T) \<circ> S = a \<cdot>\<cdot> (T \<circ> S)"
   by auto
 
 lemma end_idhom : "VEnd (id\<down>V)"
   by (rule VectorSpaceEnd.intro, rule VectorSpaceHom_idhom, unfold_locales) auto
 
 lemma VectorSpaceEndSet_is_VectorSpaceHomSet :
   "VectorSpaceHomSet smult V smult V = {T. VEnd T}"
 proof
   show "VectorSpaceHomSet smult V smult V \<subseteq> {T. VEnd T}"
     using VectorSpaceHomSetD_VectorSpaceHom VectorSpaceHomSetD_Im
           VectorSpaceEndI
     by    fast
   show "VectorSpaceHomSet smult V smult V \<supseteq> {T. VEnd T}"
     using VectorSpaceEnd.VectorSpaceHom[of smult V]
           VectorSpaceEnd.endomorph[of smult V]
           VectorSpaceHomSetI[of smult V smult _ V]
     by fast
 qed
 
 lemma VectorSpace_VectorSpaceEndSet : "VectorSpace end_smult VectorSpaceEndSet"
   using VectorSpace_axioms VectorSpace_VectorSpaceHomSet
         VectorSpaceEndSet_is_VectorSpaceHomSet
   by    fastforce
 
 end (* context VectorSpace *)
 
 context VectorSpaceEnd
 begin
 
 lemmas f_map                         = R_map
 lemmas supp                          = supp
 lemmas GroupEnd                      = ModuleEnd.GroupEnd[OF ModuleEnd]
 lemmas idhom_left                    = idhom_left
 lemmas range                         = GroupEnd.range[OF GroupEnd]
 lemmas Ker0_imp_inj_on               = Ker0_imp_inj_on
 lemmas inj_on_imp_Ker0               = inj_on_imp_Ker0
 lemmas nonzero_Ker_el_imp_n_inj      = nonzero_Ker_el_imp_n_inj
 lemmas VectorSpaceHom_composite_left
               = VectorSpaceHom_composite_left[OF endomorph]
 
 lemma in_VEndSet : "T \<in> VectorSpaceEndSet"
   using VectorSpaceEnd_axioms by fast
 
 lemma end_smult_comp_comm_right :
   "range S \<subseteq> V \<Longrightarrow> T \<circ> (a \<cdot>\<cdot> S) = a \<cdot>\<cdot> (T \<circ> S)"
   using f_map by fastforce
 
 lemma VEnd_end_smult_VEnd : "VEnd (a \<cdot>\<cdot> T)"
   using in_VEndSet VectorSpace.smult_closed[OF VectorSpace_VectorSpaceEndSet]
   by    fast
 
 lemma VEnd_composite_left :
   assumes "VEnd S"
   shows   "VEnd (S \<circ> T)"
   using endomorph VectorSpaceEnd.axioms(1)[OF assms] VectorSpaceHom_composite_left
         VectorSpaceEnd.endomorph[OF assms] VectorSpaceEndI[of smult V "S \<circ> T"]
   by    fastforce
 
 lemma VEnd_composite_right : "VEnd S \<Longrightarrow> VEnd (T \<circ> S)"
   using VectorSpaceEnd_axioms VectorSpaceEnd.VEnd_composite_left by fast
 
 end (* context VectorSpaceEnd *)
 
 lemma (in VectorSpace) inj_comp_end :
   assumes "VEnd S" "inj_on S V" "VEnd T" "inj_on T V"
   shows   "inj_on (S \<circ> T) V"
 proof-
   have "ker (S \<circ> T) \<inter> V \<subseteq> 0"
   proof
     fix v assume "v \<in> ker (S \<circ> T) \<inter> V"
     moreover hence "T v = 0" using kerD[of v "S \<circ> T"]
       using VectorSpaceEnd.endomorph[OF assms(3)] kerI[of S]
             VectorSpaceEnd.inj_on_imp_Ker0[OF assms(1,2)]
       by    auto
     ultimately show "v \<in> 0"
       using kerI[of T] VectorSpaceEnd.inj_on_imp_Ker0[OF assms(3,4)] by auto
   qed
   with assms(1,3) show ?thesis
     using VectorSpaceEnd.VEnd_composite_right VectorSpaceEnd.Ker0_imp_inj_on
     by    fast
 qed
 
 lemma (in VectorSpace) n_inj_comp_end : 
   "\<lbrakk> VEnd S; VEnd T; \<not> inj_on (S \<circ> T) V \<rbrakk> \<Longrightarrow> \<not> inj_on S V \<or> \<not> inj_on T V"
   using inj_comp_end by fast
 
 subsubsection \<open>Polynomials of endomorphisms\<close>
 
 context VectorSpaceEnd
 begin
 
 primrec endpow :: "nat \<Rightarrow> ('v\<Rightarrow>'v)"
   where endpow0:   "endpow 0 = id\<down>V"
   |     endpowSuc: "endpow (Suc n) = T \<circ> (endpow n)"
 
 definition polymap :: "'f poly \<Rightarrow> ('v\<Rightarrow>'v)"
   where "polymap p \<equiv> (coeffs p) \<bullet>\<cdot>\<cdot> (map endpow [0..<Suc (degree p)])"
 
 lemma VEnd_endpow : "VEnd (endpow n)"
 proof (induct n)
   case 0 show ?case using end_idhom by simp
 next
   case (Suc k)
   moreover have "VEnd T" ..
   ultimately have "VEnd (T \<circ> (endpow k))" using VEnd_composite_right by fast
   moreover have "endpow (Suc k) = T \<circ> (endpow k)" by simp
   ultimately show "VEnd (endpow (Suc k))" by simp
 qed
 
 lemma endpow_list_apply_closed :
   "v \<in> V \<Longrightarrow> set (map (\<lambda>S. S v) (map endpow [0..<k])) \<subseteq> V"
   using VEnd_endpow VectorSpaceEnd.endomorph by fastforce
 
 lemma map_endpow_Suc :
   "map endpow [0..<Suc n] = (id\<down>V) # map ((\<circ>) T) (map endpow [0..<n])"
 proof (induct n)
   case (Suc k)
   hence "map endpow [0..<Suc (Suc k)] = id \<down> V
               # map ((\<circ>) T) (map endpow [0..<k]) @ map ((\<circ>) T) [endpow k]"
     by auto
   also have "\<dots> = id \<down> V # map ((\<circ>) T) (map endpow ([0..<Suc k]))" by simp
   finally show ?case by fast
 qed simp
 
 lemma T_endpow_list_apply_commute :
   "map T (map (\<lambda>S. S v) (map endpow [0..<n]))
         = map (\<lambda>S. S v) (map ((\<circ>) T) (map endpow [0..<n]))"
   by (induct n) auto
 
 lemma polymap0 : "polymap 0 = 0"
   using polymap_def scalar_mult.lincomb_Nil by force
 
 lemma VEnd_polymap : "VEnd (polymap p)"
 proof-
   have "set (map endpow [0..<Suc (degree p)]) \<subseteq> {S. VEnd S}"
     using VEnd_endpow by auto
   thus ?thesis
     using polymap_def VectorSpace_VectorSpaceEndSet VectorSpace.lincomb_closed
     by    fastforce
 qed
 
 lemma polymap_pCons : "polymap (pCons a p) = a \<cdot>\<cdot> (id\<down>V) + (T \<circ> (polymap p))"
 proof cases
   assume p: "p = 0"
   show ?thesis
   proof cases
     assume "a = 0" with p show ?thesis
       using polymap0 VectorSpace_VectorSpaceEndSet VectorSpace.zero_smult end_idhom
             comp_zero
       by    fastforce
   next
     assume a: "a \<noteq> 0"
     define zmap where "zmap = (0::'v\<Rightarrow>'v)"
     from a p have "polymap (pCons a p) = a \<cdot>\<cdot> (endpow 0)" 
       using polymap_def scalar_mult.lincomb_singles by simp
     moreover have "a \<cdot>\<cdot> (id\<down>V) + (T \<circ> (polymap p)) = a \<cdot>\<cdot> (id\<down>V)"
       using p polymap0 comp_zero by simp
     ultimately show ?thesis by simp
   qed
 next
   assume "p \<noteq> 0"
   hence "polymap (pCons a p)
               = (a # (coeffs p)) \<bullet>\<cdot>\<cdot> (map endpow [0..<Suc (Suc (degree p))])"
     using polymap_def by simp
   also have "\<dots> = (a # (coeffs p))
                    \<bullet>\<cdot>\<cdot> ((id\<down>V) # map ((\<circ>) T) (map endpow [0..<Suc (degree p)]))"
     using map_endpow_Suc[of "Suc (degree p)"] by fastforce
   also have "\<dots> = a \<cdot>\<cdot> (id\<down>V) + (coeffs p)
                   \<bullet>\<cdot>\<cdot> (map ((\<circ>) T) (map endpow [0..<Suc (degree p)]))"
     using scalar_mult.lincomb_Cons by simp
   also have "\<dots> = a \<cdot>\<cdot> (id\<down>V) + (\<Sum>(c,S)
                   \<leftarrow>zip (coeffs p) (map ((\<circ>) T) (map endpow [0..<Suc (degree p)])).
                       c \<cdot>\<cdot> S)"
     using scalar_mult.lincomb_def by simp
   finally have calc:
     "polymap (pCons a p) = a \<cdot>\<cdot> (id\<down>V)
       + (\<Sum>(c,k)\<leftarrow>zip (coeffs p) [0..<Suc (degree p)]. c \<cdot>\<cdot> (T \<circ> (endpow k)))"
     using sum_list_prod_map2[
             of "\<lambda>c S. c \<cdot>\<cdot> S" "coeffs p" "(\<circ>) T" "map endpow [0..<Suc (degree p)]"
           ]
           sum_list_prod_map2[
             of "\<lambda>c S. c \<cdot>\<cdot> (T \<circ> S)" "coeffs p" endpow "[0..<Suc (degree p)]"
           ]
     by    simp
   show ?thesis
   proof
     fix v show "polymap (pCons a p) v = ((a \<cdot>\<cdot> (id\<down>V)) + (T \<circ> (polymap p))) v"
     proof (cases "v \<in> V")
       case True
       with calc
         have "polymap (pCons a p) v = a \<cdot> v + (\<Sum>(c,k)
                     \<leftarrow>zip (coeffs p) [0..<Suc (degree p)]. c \<cdot> T (endpow k v))"
         using sum_list_prod_fun_apply[of "\<lambda>c k. c \<cdot>\<cdot> (T \<circ> (endpow k))"] by simp
       hence "polymap (pCons a p) v = a \<cdot> v + (coeffs p) \<bullet>\<cdot> (map T
                   (map (\<lambda>S. S v) (map endpow [0..<Suc (degree p)])))"
         using sum_list_prod_map2[
                 of "\<lambda>c S. c \<cdot> T (S v)" "coeffs p" endpow "[0..<Suc (degree p)]"
               ]
               sum_list_prod_map2[
                 of "\<lambda>c u. c \<cdot> T u" "coeffs p" "\<lambda>S. S v" "map endpow [0..<Suc (degree p)]"
               ]
               sum_list_prod_map2[
                 of "\<lambda>c u. c \<cdot> u" "coeffs p" T
                    "map (\<lambda>S. S v) (map endpow [0..<Suc (degree p)])"
               ]
               lincomb_def
         by    simp
       also from True
         have  "\<dots> = a \<cdot> v + T ( (coeffs p)
                     \<bullet>\<cdot> (map (\<lambda>S. S v) (map endpow [0..<Suc (degree p)])) )"
         using endpow_list_apply_closed[of v "Suc (degree p)"] distrib_lincomb
         by    simp
       finally show ?thesis
         using True lincomb_def
               sum_list_prod_map2[
                 of "\<lambda>c u. c \<cdot> u" "coeffs p" "\<lambda>S. S v" "map endpow [0..<Suc (degree p)]"
               ]
               sum_list_prod_fun_apply[of "\<lambda>c S. c \<cdot>\<cdot> S"] polymap_def 
               scalar_mult.lincomb_def[of end_smult]
         by    simp
     next
       case False
       hence "polymap (pCons a p) v = 0"
         using VEnd_polymap VectorSpaceEnd.supp suppI_contra by fast
       moreover from False have "((a \<cdot>\<cdot> (id\<down>V)) + (T \<circ> (polymap p))) v = 0"
         using smult_zero VEnd_polymap[of p] VectorSpaceEnd.supp suppI_contra
               im_zero
         by    fastforce
       ultimately show ?thesis by simp
     qed
   qed
 qed
 
 lemma polymap_plus : "polymap (p + q) = polymap p + polymap q"
 proof (induct p q rule: pCons_induct2)
   case 00 show ?case using polymap0 by simp
   case lpCons show ?case using polymap0 by simp
   case rpCons show ?case using polymap0 by simp
 next
   case (pCons2 a p b q)
   have "polymap (pCons a p + pCons b q) = a \<cdot>\<cdot> (id\<down>V) + b \<cdot>\<cdot> (id\<down>V)
               + (T \<circ> (polymap (p+q)))"
     using polymap_pCons end_idhom end_smult_distrib_right[OF VectorSpaceEnd.range]
     by    simp
   also from pCons2(3)
     have "\<dots> = a \<cdot>\<cdot> (id\<down>V) + b \<cdot>\<cdot> (id\<down>V) + (T \<circ> (polymap p + polymap q))"
     by   auto
   finally show ?case
     using pCons2(3) distrib_comp_sum_left[of "polymap p" "polymap q"] VEnd_polymap
           VectorSpaceEnd.range polymap_pCons
     by    fastforce
 qed
 
 lemma polymap_polysmult : "polymap (Polynomial.smult a p) = a \<cdot>\<cdot> polymap p"
 proof (induct p)
   case 0 show "polymap (Polynomial.smult a 0) = a \<cdot>\<cdot> polymap 0"
     using polymap0 end_smult0 by simp
 next
   case (pCons b p)
   hence "polymap (Polynomial.smult a (pCons b p))
               = a \<cdot>\<cdot> b \<cdot>\<cdot> (id\<down>V) + a \<cdot>\<cdot> (T \<circ> polymap p)"
     using polymap_pCons VectorSpaceEnd.range[OF VEnd_polymap]
           end_smult_comp_comm_right VectorSpaceEnd.range[OF end_idhom] end_smult_assoc
     by    simp
   thus "polymap (Polynomial.smult a (pCons b p)) = a \<cdot>\<cdot> (polymap (pCons b p))"
     using VectorSpaceEnd.VEnd_end_smult_VEnd[OF end_idhom, of b]
           VEnd_composite_right[OF VEnd_polymap, of p]
           end_smult_distrib_left[
             OF VectorSpaceEnd.range VectorSpaceEnd.range,
             of smult _ smult "T \<circ> polymap p"
           ]
           polymap_pCons
     by    simp
 qed
 
 lemma polymap_times : "polymap (p * q) = (polymap p) \<circ> (polymap q)"
 proof (induct p)
   case 0 show ?case using polymap0 by auto
 next
   case (pCons a p)
   have "polymap (pCons a p * q) = a \<cdot>\<cdot> polymap q + (T \<circ> (polymap (p*q)))"
     using polymap_plus polymap_polysmult polymap_pCons end_idhom
           end_0smult[OF VectorSpaceEnd.range]
     by    simp
   also from pCons(2)
     have "\<dots> = a \<cdot>\<cdot> ((id\<down>V) \<circ> polymap q) + (T \<circ> polymap p \<circ> polymap q)"
     using VectorSpaceEnd.endomorph[OF VEnd_polymap]
           VectorSpaceEnd.idhom_left[OF VEnd_polymap]
     by    auto
   finally show "polymap (pCons a p * q) = (polymap (pCons a p)) \<circ> (polymap q)"
     using end_smult_comp_comm_left
           distrib_comp_sum_right[of "a \<cdot>\<cdot> id \<down> V" _ "polymap q"]
           polymap_pCons
     by    simp
 qed
 
 lemma polymap_apply :
   assumes "v \<in> V"
   shows   "polymap p v = (coeffs p)
                 \<bullet>\<cdot> (map (\<lambda>S. S v) (map endpow [0..<Suc (degree p)]))"
 proof (induct p)
   case 0 show ?case
     using lincomb_Nil scalar_mult.lincomb_Nil[of _ _ end_smult] polymap_def
     by    simp
 next
   case (pCons a p)
   show ?case
   proof (cases "p = 0")
     case True
     moreover with pCons(1) have "polymap (pCons a p) = a \<cdot>\<cdot> id\<down>V"
       using polymap_pCons polymap0 comp_zero by simp
     ultimately show ?thesis using assms pCons(1) lincomb_singles by simp
   next
     case False
     from assms pCons(2)
       have "polymap (pCons a p) v = a \<cdot> v
                   + T (coeffs p \<bullet>\<cdot> map (\<lambda>S. S v) (map endpow [0..<Suc (degree p)]))"
       using polymap_pCons by simp
     with assms pCons(1)
       have  1: "polymap (pCons a p) v = (coeffs (pCons a p)) \<bullet>\<cdot> (v #
                       map T (map (\<lambda>S. S v) (map endpow [0..<Suc (degree p)])))"
       using endpow_list_apply_closed[of v "Suc (degree p)"] distrib_lincomb lincomb_Cons
       by    auto
     have 2: "map T (map (\<lambda>S. S v) (map endpow [0..<Suc (degree p)]))
                   = map (\<lambda>S. S v) (map ((\<circ>) T) (map endpow [0..<Suc (degree p)]))"
       using T_endpow_list_apply_commute[of v "Suc (degree p)"] by simp
     from 1 2
       have  "polymap (pCons a p) v = (coeffs (pCons a p)) \<bullet>\<cdot> (v #
                   map (\<lambda>S. S v) (map ((\<circ>) T) (map endpow [0..<Suc (degree p)])))"
       using subst[
               OF 2, of "\<lambda>x. polymap (pCons a p) v = (coeffs (pCons a p)) \<bullet>\<cdot> (v # x)"
             ]
       by    simp
     with assms
       have 3: "polymap (pCons a p) v = (coeffs (pCons a p))
                     \<bullet>\<cdot> (map (\<lambda>S. S v) (id\<down>V # map ((\<circ>) T)
                       (map endpow [0..<Suc (degree p)])))"
       by   simp
     from False pCons(1)
       have  4: "id \<down> V # map ((\<circ>) T) (map endpow [0..<Suc (degree p)])
                       = map endpow [0..<Suc (degree (pCons a p))]"
       using map_endpow_Suc[of "Suc (degree p)", THEN sym]
       by    simp
     from 3 show ?thesis
       using subst[
               OF 4,
               of "\<lambda>x. polymap (pCons a p) v
                         = (coeffs (pCons a p)) \<bullet>\<cdot> (map (\<lambda>S. S v) x)"
             ]
       by    simp
   qed
 qed
 
 lemma polymap_apply_linear : "v \<in> V \<Longrightarrow> polymap [:-c, 1:] v = T v - c \<cdot> v"
   using polymap_apply lincomb_def neg_smult endomorph by auto
 
 lemma polymap_const_inj :
   assumes "degree p = 0" "p \<noteq> 0"
   shows   "inj_on (polymap p) V"
 proof (rule inj_onI)
   fix u v assume uv: "u \<in> V" "v \<in> V" "polymap p u = polymap p v"
   from assms have p: "coeffs p = [coeff p 0]" unfolding coeffs_def by simp
   from uv assms have "(coeff p 0) \<cdot> u = (coeff p 0) \<cdot> v"
     using polymap_apply lincomb_singles unfolding coeffs_def by simp
   with assms uv(1,2) show "u = v"
     using const_poly_nonzero_coeff cancel_scalar by auto
 qed
 
 lemma n_inj_polymap_times :
   "\<not> inj_on (polymap (p * q)) V
         \<Longrightarrow> \<not> inj_on (polymap p) V \<or> \<not> inj_on (polymap q) V"
   using polymap_times VEnd_polymap n_inj_comp_end by fastforce
 
 text \<open>In the following lemma, @{term "[:-c, 1:]"} is the linear polynomial @{term "x - c"}.\<close>
 
 lemma n_inj_polymap_findlinear :
   assumes alg_closed: "\<And>p::'f poly. degree p > 0 \<Longrightarrow> \<exists>c. poly p c = 0"
   shows   "p \<noteq> 0 \<Longrightarrow> \<not> inj_on (polymap p) V
                 \<Longrightarrow> \<exists>c. \<not> inj_on (polymap [:-c, 1:]) V"
 proof (induct n \<equiv> "degree p" arbitrary: p)
   case (0 p) thus ?case using polymap_const_inj by simp
 next
   case (Suc n p)
   from Suc(2) alg_closed obtain c where c: "poly p c = 0" by fastforce
   define q where "q = synthetic_div p c"
   with c have p_decomp: "p = [:-c, 1:] * q"
     using synthetic_div_correct'[of c p] by simp
   show ?case
   proof (cases "inj_on (polymap q) V")
     case True with Suc(4) show ?thesis
       using p_decomp n_inj_polymap_times by fast
   next
     case False
     then have "n = degree q"
       using degree_synthetic_div [of p c] q_def \<open>Suc n = degree p\<close>
       by auto
     moreover have "q \<noteq> 0"
       using \<open>p \<noteq> 0\<close> p_decomp
       by auto
     ultimately show ?thesis
       using False
       by (rule Suc.hyps)
   qed
 qed
 
 end (* context VectorSpaceEnd *)
 
 subsubsection \<open>Existence of eigenvectors of endomorphisms of finite-dimensional vector spaces\<close>
 
 lemma (in FinDimVectorSpace) endomorph_has_eigenvector :
   assumes alg_closed: "\<And>p::'a poly. degree p > 0 \<Longrightarrow> \<exists>c. poly p c = 0"
   and     dim       : "dim V > 0"
   and     endo      : "VectorSpaceEnd smult V T"
   shows   "\<exists>c u. u \<in> V \<and> u \<noteq> 0 \<and> T u = c \<cdot> u"
 proof-
   define Tpolymap where "Tpolymap = VectorSpaceEnd.polymap smult V T"
   from dim obtain v where v: "v \<in> V" "v \<noteq> 0"
     using dim_nonzero nonempty by auto
   define Tpows where "Tpows = map (VectorSpaceEnd.endpow V T) [0..<Suc (dim V)]"
   define Tpows_v where "Tpows_v = map (\<lambda>S. S v) Tpows"
   with endo Tpows_def v(1) have Tpows_v_V: "set Tpows_v \<subseteq> V"
     using VectorSpaceEnd.endpow_list_apply_closed by fast
   moreover from Tpows_v_def Tpows_def Tpows_v_V have "\<not> lin_independent Tpows_v"
     using too_long_lin_dependent by simp
   ultimately obtain as
     where as: "set as \<noteq> 0" "length as = length Tpows_v" "as \<bullet>\<cdot> Tpows_v = 0"
     using lin_dependent_dependence_relation
     by    fast
   define p where "p = Poly as"
   with dim Tpows_def Tpows_v_def as(1,2) have p_n0: "p \<noteq> 0"
     using nonzero_coeffs_nonzero_poly[of as] by fastforce
   define Tpows' where "Tpows' = map (VectorSpaceEnd.endpow V T) [0..<Suc (degree p)]"
   define Tpows_v' where "Tpows_v' = map (\<lambda>S. S v) Tpows'"
   have "Tpows' = take (Suc (degree p)) Tpows"
   proof-
     from Tpows_def
       have  1: "take (Suc (degree p)) Tpows = map (VectorSpaceEnd.endpow V T)
                       (take (Suc (degree p)) [0..<Suc (dim V)])"
       using take_map[of _ _ "[0..<Suc (dim V)]"]
       by    simp
     from p_n0 p_def as(2) Tpows_v_def Tpows_def
       have  2: "take (Suc (degree p)) [0..<Suc (dim V)] = [0..<Suc (degree p)]"
       using length_coeffs_degree[of p] length_strip_while_le[of "(=) 0" as]
             take_upt[of 0 "Suc (degree p)" "Suc (dim V)"]
       by    simp
     from 1 Tpows'_def have "take (Suc (degree p)) Tpows = Tpows'"
       using subst[OF 2] by fast
     thus ?thesis by simp
   qed
   with Tpows_v_def Tpows_v'_def have "Tpows_v' = take (Suc (degree p)) Tpows_v"
     using take_map[of _ "\<lambda>S. S v" Tpows] by simp
   moreover from p_def Tpows_v_V as(3) Tpows_v'_def have "(coeffs p) \<bullet>\<cdot> Tpows_v = 0"
     using lincomb_strip_while_0coeffs by simp
   ultimately have "(coeffs p) \<bullet>\<cdot> Tpows_v' = 0"
     using p_n0 lincomb_conv_take_right[of "coeffs p"] length_coeffs_degree[of p] by simp
   with Tpolymap_def v(1) Tpows_v'_def Tpows'_def have "Tpolymap p v = 0"
     using VectorSpaceEnd.polymap_apply[OF endo] by simp
   with alg_closed Tpolymap_def v endo p_n0 obtain c
     where "\<not> inj_on (Tpolymap [:-c, 1:]) V"
     using VectorSpaceEnd.VEnd_polymap VectorSpaceEnd.nonzero_Ker_el_imp_n_inj
           VectorSpaceEnd.n_inj_polymap_findlinear[OF endo]
     by    fastforce
   with Tpolymap_def have "(GroupHom.Ker V (Tpolymap [:-c, 1:])) - 0 \<noteq> {}"
     using VectorSpaceEnd.VEnd_polymap[OF endo] VectorSpaceEnd.Ker0_imp_inj_on
     by    fast
   from this obtain u where "u \<in> V" "Tpolymap [:-c, 1:] u = 0" "u \<noteq> 0"
     using kerD by fastforce
   with Tpolymap_def show ?thesis
     using VectorSpaceEnd.polymap_apply_linear[OF endo] by auto
 qed
 
 
 
 
 section \<open>Modules Over a Group Ring\<close>
 
 subsection \<open>Almost-everywhere-zero functions as scalars\<close>
 
 locale aezfun_scalar_mult = scalar_mult smult
   for smult ::
     "('r::ring_1, 'g::group_add) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
 begin
 
 definition fsmult :: "'r \<Rightarrow> 'v \<Rightarrow> 'v" (infixr "\<sharp>\<cdot>" 70) where "a \<sharp>\<cdot> v \<equiv> (a \<delta>\<delta> 0) \<cdot> v"
 abbreviation flincomb :: "'r list \<Rightarrow> 'v list \<Rightarrow> 'v" (infixr "\<bullet>\<sharp>\<cdot>" 70)
   where "as \<bullet>\<sharp>\<cdot> vs \<equiv> scalar_mult.lincomb fsmult as vs"
 abbreviation f_lin_independent :: "'v list \<Rightarrow> bool"
   where "f_lin_independent \<equiv> scalar_mult.lin_independent fsmult"
 abbreviation fSpan :: "'v list \<Rightarrow> 'v set" where "fSpan \<equiv> scalar_mult.Span fsmult"
 definition Gmult :: "'g \<Rightarrow> 'v \<Rightarrow> 'v" (infixr "*\<cdot>" 70) where "g *\<cdot> v \<equiv> (1 \<delta>\<delta> g) \<cdot> v"
 
 lemmas R_scalar_mult = R_scalar_mult
 
 lemma fsmultD : "a \<sharp>\<cdot> v = (a \<delta>\<delta> 0) \<cdot> v"
   unfolding fsmult_def by fast
 
 lemma GmultD : "g *\<cdot> v = (1 \<delta>\<delta> g) \<cdot> v"
   unfolding Gmult_def by fast
 
 definition negGorbit_list :: "'g list \<Rightarrow> ('a \<Rightarrow> 'v) \<Rightarrow> 'a list \<Rightarrow> 'v list list"
   where "negGorbit_list gs T as \<equiv> map (\<lambda>g. map (Gmult (-g) \<circ> T) as) gs"
 
 lemma negGorbit_Cons :
   "negGorbit_list (g#gs) T as
         = (map (Gmult (-g) \<circ> T) as) # negGorbit_list gs T as"
   using negGorbit_list_def[of _ T as] by simp
 
 lemma length_negGorbit_list : "length (negGorbit_list gs T as) = length gs"
   using negGorbit_list_def[of gs T] by simp
 
 lemma length_negGorbit_list_sublist :
   "fs \<in> set (negGorbit_list gs T as) \<Longrightarrow> length fs = length as"
   using negGorbit_list_def[of gs T] by auto
 
 lemma length_concat_negGorbit_list : 
   "length (concat (negGorbit_list gs T as)) = (length gs) * (length as)"
   using length_concat[of "negGorbit_list gs T as"]
         length_negGorbit_list_sublist[of _ gs T as]
         const_sum_list[of "negGorbit_list gs T as" length "length as"] length_negGorbit_list
   by    auto
 
 lemma negGorbit_list_nth : 
   "\<And>i. i < length gs \<Longrightarrow> (negGorbit_list gs T as)!i = map (Gmult (-gs!i) \<circ> T) as"
 proof (induct gs)
   case (Cons g gs) thus ?case using negGorbit_Cons[of _ _ T] by (cases i) auto
 qed simp
 
 end (* context aezfun_scalar_mult *)
 
 subsection \<open>Locale and basic facts\<close>
 
 locale FGModule = ActingGroup?: Group G
 + FGMod?: RModule ActingGroup.group_ring smult V
   for G     :: "'g::group_add set"
   and smult :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   and V     :: "'v set"
 
 sublocale FGModule < aezfun_scalar_mult proof- qed
 
 lemma (in Group) trivial_FGModule :
   fixes   smult :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v"
   assumes smult_zero: "\<forall>a\<in>group_ring. smult a (0::'v) = 0"
   shows   "FGModule G smult (0::'v set)"
 proof (rule FGModule.intro)
   from assms show "RModule group_ring  smult 0"
     using Ring1_RG trivial_RModule by fast
 qed (unfold_locales)
 
 context FGModule
 begin
 
 abbreviation FG :: "('f,'g) aezfun set" where "FG \<equiv> ActingGroup.group_ring"
 abbreviation "FGSubmodule \<equiv> RSubmodule"
 abbreviation "FG_proj     \<equiv> ActingGroup.RG_proj"
 
 lemma GroupG: "Group G" ..
 
 lemmas zero_closed            = zero_closed
 lemmas neg_closed             = neg_closed
 lemmas diff_closed            = diff_closed
 lemmas zero_smult             = zero_smult
 lemmas smult_zero             = smult_zero
 lemmas AbGroup                = AbGroup
 lemmas sum_closed          = AbGroup.sum_closed[OF AbGroup]
 lemmas FGSubmoduleI           = RSubmoduleI
 lemmas FG_proj_mult_leftdelta = ActingGroup.RG_proj_mult_leftdelta
 lemmas FG_proj_mult_right     = ActingGroup.RG_proj_mult_right
 lemmas FG_el_decomp           = ActingGroup.RG_el_decomp_aezdeltafun
 
 lemma FG_n0: "FG \<noteq> 0" using ActingGroup.RG_n0 by fast
 
 lemma FG_proj_in_FG : "FG_proj x \<in> FG"
   using ActingGroup.RG_proj_in_RG by fast
 
 lemma FG_fddg_closed : "g \<in> G \<Longrightarrow> a \<delta>\<delta> g \<in> FG"
   using ActingGroup.RG_aezdeltafun_closed by fast
 
 lemma FG_fdd0_closed : "a \<delta>\<delta> 0 \<in> FG"
   using ActingGroup.RG_aezdelta0fun_closed by fast
 
 lemma Gmult_closed : "g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> g *\<cdot> v \<in> V"
   using FG_fddg_closed smult_closed GmultD by simp
 
 lemma map_Gmult_closed :
   "g \<in> G \<Longrightarrow> set vs \<subseteq> V \<Longrightarrow> set (map ((*\<cdot>) g) vs) \<subseteq> V"
   using Gmult_def FG_fddg_closed map_smult_closed[of "1 \<delta>\<delta> g" vs] by auto
 
 lemma Gmult0 :
   assumes "v \<in> V"
   shows   "0 *\<cdot> v = v"
 proof-
   have "0 *\<cdot> v = (1 \<delta>\<delta> 0) \<cdot> v" using GmultD by fast
   moreover have "1 \<delta>\<delta> 0 = (1::('f,'g) aezfun)" using one_aezfun_transfer by fast
   ultimately have "0 *\<cdot> v = (1::('f,'g) aezfun) \<cdot> v" by simp
   with assms show ?thesis using one_smult by simp
 qed
 
 lemma Gmult_assoc :
   assumes "g \<in> G" "h \<in> G" "v \<in> V"
   shows   "g *\<cdot> h *\<cdot> v = (g + h) *\<cdot> v"
 proof-
   define n where "n = (1::'f)"
   with assms have "g *\<cdot> h *\<cdot> v = ((n \<delta>\<delta> g) * (n \<delta>\<delta> h)) \<cdot> v"
     using FG_fddg_closed GmultD by simp
   moreover from n_def have "n \<delta>\<delta> g * (n \<delta>\<delta> h) = n \<delta>\<delta> (g + h)"
     using times_aezdeltafun_aezdeltafun[of n g n h] by simp
   ultimately show ?thesis using n_def GmultD by simp
 qed
 
 lemma Gmult_distrib_left :
   "\<lbrakk> g \<in> G; v \<in> V; v' \<in> V \<rbrakk> \<Longrightarrow> g *\<cdot> (v + v') = g *\<cdot> v + g *\<cdot> v'"
   using GmultD FG_fddg_closed by simp
 
 lemma neg_Gmult : "g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> g *\<cdot> (- v) = - (g *\<cdot> v)"
   using GmultD FG_fddg_closed smult_neg by simp
 
 lemma Gmult_neg_left : "g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> (- g) *\<cdot> g *\<cdot> v = v"
   using ActingGroup.neg_closed Gmult_assoc[of "- g" g] Gmult0 by simp
 
 lemma fddg_smult_decomp : "g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> (f \<delta>\<delta> g) \<cdot> v = f \<sharp>\<cdot> g *\<cdot> v"
   using aezdeltafun_decomp[of f g] FG_fddg_closed FG_fdd0_closed GmultD
         fsmult_def
   by    simp
 
 lemma sum_list_aezdeltafun_smult_distrib :
   assumes "v \<in> V" "set (map snd fgs) \<subseteq> G"
   shows   "(\<Sum>(f,g)\<leftarrow>fgs. f \<delta>\<delta> g) \<cdot> v = (\<Sum>(f,g)\<leftarrow>fgs. f \<sharp>\<cdot> g *\<cdot> v)"
 proof-
   from assms(2) have "set (map (case_prod aezdeltafun) fgs) \<subseteq> FG"
     using FG_fddg_closed by auto
   with assms(1) have "(\<Sum>(f,g)\<leftarrow>fgs. f \<delta>\<delta> g) \<cdot> v =  (\<Sum>(f,g)\<leftarrow>fgs. (f \<delta>\<delta> g) \<cdot> v)"
     using sum_list_prod_map_smult_distrib by auto
   also have "\<dots> = (\<Sum>(f,g)\<leftarrow>fgs. f \<sharp>\<cdot> g *\<cdot> v)"
     using assms fddg_smult_decomp
           sum_list_prod_cong[of fgs "\<lambda> f g. (f \<delta>\<delta> g) \<cdot> v" "\<lambda> f g. f \<sharp>\<cdot> g *\<cdot> v"]
     by    fastforce
   finally show ?thesis by fast
 qed
 
 abbreviation "GSubspace \<equiv> RSubmodule"
 abbreviation "GSpan     \<equiv> RSpan"
 abbreviation "G_fingen  \<equiv> R_fingen"
 
 lemma GSubspaceI : "FGModule G smult U \<Longrightarrow> U \<subseteq> V \<Longrightarrow> GSubspace U"
   using FGModule.axioms(2) by fast
 
 lemma GSubspace_is_FGModule :
   assumes "GSubspace U"
   shows   "FGModule G smult U"
 proof (rule FGModule.intro, rule GroupG)
   from assms show "RModule FG (\<cdot>) U" by fast
 qed (unfold_locales)
 
 lemma restriction_to_subgroup_is_module :
   fixes   H  :: "'g set"
   assumes subgrp: "Group.Subgroup G H"
   shows   "FGModule H smult V"
 proof (rule FGModule.intro)
   from subgrp show "Group H" by fast
   from assms show "RModule (Group.group_ring H) (\<cdot>) V"
     using ActingGroup.Subgroup_imp_Subring SModule_restrict_scalars by fast
 qed
 
 lemma negGorbit_list_V :
   assumes "set gs \<subseteq> G" "T ` (set as) \<subseteq> V"
   shows   "set (concat (negGorbit_list gs T as)) \<subseteq> V"
 proof-
   from assms(2)
     have  "set (concat (negGorbit_list gs T as)) \<subseteq> (\<Union>g\<in>set gs. (Gmult (-g)) ` V)"
     using set_concat negGorbit_list_def[of gs T as]
     by    force
   moreover from assms(1) have "\<And>g. g \<in> set gs \<Longrightarrow> (Gmult (-g)) ` V \<subseteq> V"
     using ActingGroup.neg_closed Gmult_closed by fast
   ultimately show ?thesis by fast    
 qed
 
 lemma negGorbit_list_Cons0 :
   "T ` (set as) \<subseteq> V
         \<Longrightarrow> negGorbit_list (0#gs) T as = (map T as) # (negGorbit_list gs T as)"
   using negGorbit_Cons[of 0 gs T as] Gmult0 by auto
 
 end (* context FGModule *)
 
 subsection \<open>Modules over a group ring as a vector spaces\<close>
 
 context FGModule
 begin
 
 lemma fVectorSpace : "VectorSpace fsmult V"
 proof (rule VectorSpaceI, unfold_locales)
   fix a::'f show "\<And>v. v \<in> V \<Longrightarrow> a \<sharp>\<cdot> v \<in> V"
     using fsmult_def smult_closed FG_fdd0_closed by simp
 next
   fix a::'f show "\<And>u v. u \<in> V \<Longrightarrow> v \<in> V \<Longrightarrow> a \<sharp>\<cdot> (u + v) = a \<sharp>\<cdot> u + a \<sharp>\<cdot> v"
     using fsmult_def FG_fdd0_closed by simp
 next
   fix a b :: 'f and v :: 'v assume v: "v \<in> V"
   have "(a+b) \<sharp>\<cdot> v = (a \<delta>\<delta> 0 + b \<delta>\<delta> 0) \<cdot> v"
     using aezdeltafun_plus[of a b 0] arg_cong[of _ _ "\<lambda>r. r \<cdot> v"] fsmult_def by fastforce
   with v show "(a+b) \<sharp>\<cdot> v = a \<sharp>\<cdot> v + b \<sharp>\<cdot> v"
     using fsmult_def FG_fdd0_closed by simp
 next
   fix a b :: 'f show "\<And>v. v \<in> V \<Longrightarrow> a \<sharp>\<cdot> (b \<sharp>\<cdot> v) = (a * b) \<sharp>\<cdot> v"
     using times_aezdeltafun_aezdeltafun[of a 0 b 0] arg_cong fsmult_def FG_fdd0_closed
     by    simp
 next
   fix v :: 'v assume "v \<in> V" thus "1 \<sharp>\<cdot> v = v"
     using one_aezfun_transfer arg_cong[of "1 \<delta>\<delta> 0" 1 "\<lambda>a. a \<cdot> v"] fsmult_def by fastforce
 qed
 
 abbreviation "fSubspace  \<equiv> VectorSpace.Subspace fsmult V"
 abbreviation "fbasis_for \<equiv> fscalar_mult.basis_for fsmult"
 abbreviation "fdim       \<equiv> scalar_mult.dim fsmult V"
 
 lemma VectorSpace_fSubspace : "fSubspace W \<Longrightarrow> VectorSpace fsmult W"
   using Module.intro VectorSpace.intro by fast
 
 lemma fsmult_closed : "v \<in> V \<Longrightarrow> a \<sharp>\<cdot> v \<in> V"
   using FG_fdd0_closed smult_closed fsmult_def by simp
 
 lemmas one_fsmult          [simp] = VectorSpace.one_smult   [OF fVectorSpace]
 lemmas fsmult_assoc        [simp] = VectorSpace.smult_assoc [OF fVectorSpace]
 lemmas fsmult_zero         [simp] = VectorSpace.smult_zero  [OF fVectorSpace]
 lemmas fsmult_distrib_left [simp] = VectorSpace.smult_distrib_left
                                           [OF fVectorSpace]
 lemmas flincomb_closed       = VectorSpace.lincomb_closed       [OF fVectorSpace]
 lemmas fsmult_sum_distrib = VectorSpace.smult_sum_distrib [OF fVectorSpace]
 lemmas sum_fsmult_distrib = VectorSpace.sum_smult_distrib [OF fVectorSpace]
 lemmas flincomb_concat       = VectorSpace.lincomb_concat       [OF fVectorSpace]
 lemmas fSpan_closed          = VectorSpace.Span_closed          [OF fVectorSpace]
 lemmas flin_independentD_all_scalars
               = VectorSpace.lin_independentD_all_scalars[OF fVectorSpace]
 lemmas in_fSpan_obtain_same_length_coeffs
               = VectorSpace.in_Span_obtain_same_length_coeffs [OF fVectorSpace]
 
 lemma fsmult_smult_comm : "r \<in> FG \<Longrightarrow> v \<in> V \<Longrightarrow> a \<sharp>\<cdot> r \<cdot> v = r \<cdot> a \<sharp>\<cdot> v"
   using fsmultD FG_fdd0_closed smult_assoc aezdelta0fun_commutes[of r] by simp
 
 lemma fsmult_Gmult_comm : "g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> a \<sharp>\<cdot> g *\<cdot> v = g *\<cdot> a \<sharp>\<cdot> v"
   using aezdeltafun_decomp[of a g] aezdeltafun_decomp'[of a g] FG_fddg_closed
         FG_fdd0_closed fsmult_def GmultD
   by    simp
 
 lemma Gmult_flincomb_comm :
   assumes "g \<in> G" "set vs \<subseteq> V"
   shows   "g *\<cdot> as \<bullet>\<sharp>\<cdot> vs = as \<bullet>\<sharp>\<cdot> (map (Gmult g) vs)"
 proof-
   have "g *\<cdot> as \<bullet>\<sharp>\<cdot> vs = (1 \<delta>\<delta> g) \<cdot> (\<Sum>(a,v)\<leftarrow>zip as vs. a \<sharp>\<cdot> v)"
     using Gmult_def scalar_mult.lincomb_def[of fsmult] by simp
   with assms have "g *\<cdot> as \<bullet>\<sharp>\<cdot> vs
                         = sum_list (map ((\<cdot>) (1 \<delta>\<delta> g) \<circ> (\<lambda>(x, y). x \<sharp>\<cdot> y)) (zip as vs))"
     using set_zip_rightD fsmult_closed FG_fddg_closed[of g "1::'f"]
           smult_sum_list_distrib[of "1 \<delta>\<delta> g" "map (case_prod (\<sharp>\<cdot>)) (zip as vs)"]
           map_map[of "(\<cdot>) (1 \<delta>\<delta> g)" "case_prod (\<sharp>\<cdot>)" "zip as vs"]
     by    fastforce
   moreover have "(\<cdot>) (1 \<delta>\<delta> g) \<circ> (\<lambda>(x, y). x \<sharp>\<cdot> y) = (\<lambda>(x,y). (1 \<delta>\<delta> g) \<cdot> (x \<sharp>\<cdot> y))"
     by auto
   ultimately have "g *\<cdot> as \<bullet>\<sharp>\<cdot> vs = sum_list (map (\<lambda>(x,y). g *\<cdot> x \<sharp>\<cdot> y) (zip as vs))"
     using Gmult_def by simp
   moreover from assms have "\<forall>(x,y) \<in> set (zip as vs). g *\<cdot> x \<sharp>\<cdot> y = x \<sharp>\<cdot> g *\<cdot> y"
     using set_zip_rightD fsmult_Gmult_comm by fastforce
   ultimately have "g *\<cdot> as \<bullet>\<sharp>\<cdot> vs
                         = sum_list (map (\<lambda>(x,y). x \<sharp>\<cdot> y) (zip as (map (Gmult g) vs)))"
     using sum_list_prod_cong sum_list_prod_map2[of "\<lambda>x y. x \<sharp>\<cdot> y" as "Gmult g"]
     by    force
   thus ?thesis using scalar_mult.lincomb_def[of fsmult] by simp
 qed
 
 lemma GSubspace_is_Subspace :
   "GSubspace U \<Longrightarrow> VectorSpace.Subspace fsmult V U"
   using GSubspace_is_FGModule FGModule.fVectorSpace VectorSpace.axioms
         Module.axioms
   by    fast
 
 
 end (* context FGModule *)
 
 subsection \<open>Homomorphisms of modules over a group ring\<close>
 
 subsubsection \<open>Locales\<close>
 
 locale FGModuleHom = ActingGroup?: Group G
 + RModHom?: RModuleHom ActingGroup.group_ring smult V smult' T
   for G      :: "'g::group_add set"
   and smult  :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   and V      :: "'v set"
   and smult' :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and T      :: "'v \<Rightarrow> 'w"
 
 sublocale FGModuleHom < FGModule ..
 
 lemma (in FGModule) FGModuleHomI_fromaxioms :
   assumes "\<And>v v'. v \<in> V \<Longrightarrow> v' \<in> V \<Longrightarrow> T (v + v') = T v + T v'"
           "supp T \<subseteq> V" "\<And>r m. r \<in> FG \<Longrightarrow> m \<in> V \<Longrightarrow> T (r \<cdot> m) = smult' r (T m)"
   shows   "FGModuleHom G smult V smult' T"
   using   assms
   by      unfold_locales
 
 locale FGModuleEnd = FGModuleHom G smult V smult T
   for G     :: "'g::group_add set"
   and FG    :: "('f::field,'g) aezfun set"
   and smult :: "('f, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   and V     :: "'v set"
   and T     :: "'v \<Rightarrow> 'v"
 + assumes endomorph: "ImG \<subseteq> V"
 
 locale FGModuleIso = FGModuleHom G smult V smult' T
   for   G      :: "'g::group_add set"
   and   smult  :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   and   V      :: "'v set"
   and   smult' :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and   T      :: "'v \<Rightarrow> 'w"
 + fixes W      :: "'w set"
   assumes bijective: "bij_betw T V W"
 
 abbreviation (in FGModule) isomorphic ::
   "(('f,'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w) \<Rightarrow> 'w set \<Rightarrow> bool"
   where "isomorphic smult' W \<equiv> (\<exists> T. FGModuleIso G smult V smult' T W)"
 
 subsubsection \<open>Basic facts\<close>
 
 context FGModule
 begin
 
 lemma trivial_FGModuleHom :
   assumes "\<And>r. r \<in> FG \<Longrightarrow> smult' r 0 = 0"
   shows   "FGModuleHom G smult V smult' 0"
 proof (rule FGModuleHom.intro)
   from assms show "RModuleHom FG (\<cdot>) V smult' 0"
     using trivial_RModuleHom by auto
 qed (unfold_locales)
 
 lemma FGModHom_idhom : "FGModuleHom G smult V smult (id\<down>V)"
 proof (rule FGModuleHom.intro)
   show "RModuleHom FG smult V smult (id\<down>V)" using RModHom_idhom by fast
 qed (unfold_locales)
 
 lemma VecHom_GMap_is_FGModuleHom :
   fixes   smult'  :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and     fsmult' :: "'f \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "\<sharp>\<star>" 70)
   and     Gmult'  :: "'g \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "*\<star>" 70)
   defines fsmult': "fsmult' \<equiv> aezfun_scalar_mult.fsmult smult'"
   and     Gmult' : "Gmult' \<equiv> aezfun_scalar_mult.Gmult smult'"
   assumes hom  : "VectorSpaceHom fsmult V fsmult' T"
   and     Im_W : "FGModule G smult' W" "T ` V \<subseteq> W"
   and     G_map : "\<And>g v. g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> T (g *\<cdot> v) = g *\<star> (T v)"
   shows   "FGModuleHom G smult V smult' T"
 proof
 
   show "\<And>v v'. v \<in> V \<Longrightarrow> v' \<in> V \<Longrightarrow> T (v + v') = T v + T v'" 
     using VectorSpaceHom.GroupHom[OF hom] GroupHom.hom by auto
 
   from hom show "supp T \<subseteq> V" using VectorSpaceHom.supp by fast
 
   show "\<And>r v. r \<in> FG \<Longrightarrow> v \<in> V \<Longrightarrow> T (r \<cdot> v) = r \<star> T v"
   proof-
     fix r v assume r: "r \<in> FG" and v: "v \<in> V"
     from r obtain fgs
       where fgs: "set (map snd fgs) \<subseteq> G" "r = (\<Sum>(f,g)\<leftarrow>fgs. f \<delta>\<delta> g)"
       using FG_el_decomp
       by    fast
     from fgs v have "r \<cdot> v = (\<Sum>(f,g)\<leftarrow>fgs. f \<sharp>\<cdot> g *\<cdot> v)"
       using sum_list_aezdeltafun_smult_distrib by simp
     moreover from v fgs(1) have "set (map (\<lambda>(f,g). f \<sharp>\<cdot> g *\<cdot> v) fgs) \<subseteq> V"
       using Gmult_closed fsmult_closed by auto
     ultimately have "T (r \<cdot> v) = (\<Sum>(f,g)\<leftarrow>fgs. T (f \<sharp>\<cdot> g *\<cdot> v))"
       using hom VectorSpaceHom.im_sum_list_prod by auto
     moreover from hom G_map fgs(1) v
       have  "\<forall>(f,g) \<in> set fgs. T (f \<sharp>\<cdot> g *\<cdot> v) = f \<sharp>\<star> g *\<star> T v"
       using Gmult_closed VectorSpaceHom.f_map[of fsmult V fsmult' T]
       by    auto
     ultimately have "T (r \<cdot> v) = (\<Sum>(f,g)\<leftarrow>fgs. f \<sharp>\<star> g *\<star> T v)"
       using sum_list_prod_cong by simp
     with v fgs fsmult' Gmult' Im_W(2) show "T (r \<cdot> v) = r \<star> (T v)"
       using FGModule.sum_list_aezdeltafun_smult_distrib[OF Im_W(1)] by auto
   qed
 
 qed
 
 lemma VecHom_GMap_on_fbasis_is_FGModuleHom :
   fixes   smult'    :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and     fsmult'   :: "'f \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "\<sharp>\<star>" 70)
   and     Gmult'    :: "'g \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "*\<star>" 70)
   and     flincomb' :: "'f list \<Rightarrow> 'w list \<Rightarrow> 'w" (infixr "\<bullet>\<sharp>\<star>" 70)
   defines fsmult'    : "fsmult' \<equiv> aezfun_scalar_mult.fsmult smult'"
   and     Gmult'     : "Gmult' \<equiv> aezfun_scalar_mult.Gmult smult'"
   and     flincomb'  : "flincomb' \<equiv> aezfun_scalar_mult.flincomb smult'"
   assumes fbasis     : "fbasis_for V vs"
   and     hom        : "VectorSpaceHom fsmult V fsmult' T"
   and     Im_W       : "FGModule G smult' W" "T ` V \<subseteq> W"
   and     G_map      : "\<And>g v. g \<in> G \<Longrightarrow> v \<in> set vs \<Longrightarrow> T (g *\<cdot> v) = g *\<star> (T v)"
   shows   "FGModuleHom G smult V smult' T"
 proof (rule VecHom_GMap_is_FGModuleHom)
   from fsmult' hom
     show "VectorSpaceHom (\<sharp>\<cdot>) V (aezfun_scalar_mult.fsmult (\<star>)) T"
     by   fast
 next
   fix g v assume g: "g \<in> G" and v: "v \<in> V"
   from v fbasis obtain cs where cs: "v = cs \<bullet>\<sharp>\<cdot> vs" 
     using VectorSpace.in_Span_obtain_same_length_coeffs[OF fVectorSpace] by fast
   with g(1) fbasis fsmult' flincomb'
     have  "T (g *\<cdot> v) = cs \<bullet>\<sharp>\<star> (map (T \<circ> (Gmult g)) vs)"
     using Gmult_flincomb_comm map_Gmult_closed
           VectorSpaceHom.distrib_lincomb[OF hom]
     by    auto
   moreover have "T \<circ> (Gmult g) = (\<lambda>v. T (g *\<cdot> v))" by auto
   ultimately have "T (g *\<cdot> v) = cs \<bullet>\<sharp>\<star> (map (\<lambda>v. g *\<star> (T v)) vs)"
     using fbasis g(1) G_map map_cong[of vs vs "\<lambda>v. T (g *\<cdot> v)"]
     by    simp
   moreover have "(\<lambda>v. g *\<star> (T v)) = (Gmult' g) \<circ> T" by auto
   ultimately have "T (g *\<cdot> v) = g *\<star> cs \<bullet>\<sharp>\<star> (map T vs)"
     using g(1) fbasis Im_W(2) Gmult' flincomb' 
           FGModule.Gmult_flincomb_comm[OF Im_W(1), of g "map T vs"]
     by    fastforce
   thus "T (g *\<cdot> v) = aezfun_scalar_mult.Gmult (\<star>) g (T v)"
     using fbasis fsmult' Gmult' flincomb' cs
           VectorSpaceHom.distrib_lincomb[OF hom]
     by auto
 qed (rule Im_W(1), rule Im_W(2))
 
 end (* context FGModule *)
 
 context FGModuleHom
 begin
 
 abbreviation fsmult' :: "'f \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "\<sharp>\<star>" 70) 
   where "fsmult' \<equiv> aezfun_scalar_mult.fsmult smult'"
 abbreviation Gmult' :: "'g \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "*\<star>" 70)
   where "Gmult' \<equiv> aezfun_scalar_mult.Gmult smult'"
 
 lemmas supp                     = supp
 lemmas additive                 = additive
 lemmas FG_map                   = R_map
 lemmas FG_fdd0_closed           = FG_fdd0_closed
 lemmas fsmult_smult_domain_comm = fsmult_smult_comm
 lemmas GSubspace_Ker            = RSubmodule_Ker
 lemmas Ker_Im_iff               = Ker_Im_iff
 lemmas Ker0_imp_inj_on          = Ker0_imp_inj_on
 lemmas eq_im_imp_diff_in_Ker    = eq_im_imp_diff_in_Ker
 lemmas im_submodule             = im_submodule
 lemmas fsmultD'                 = aezfun_scalar_mult.fsmultD[of smult']
 lemmas GmultD'                  = aezfun_scalar_mult.GmultD[of smult']
 
 lemma f_map : "v \<in> V \<Longrightarrow> T (a \<sharp>\<cdot> v) = a \<sharp>\<star> T v"
   using fsmultD ActingGroup.RG_aezdelta0fun_closed[of a] FG_map fsmultD'
   by    simp
 
 lemma G_map : "g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> T (g *\<cdot> v) = g *\<star> T v"
   using GmultD ActingGroup.RG_aezdeltafun_closed[of g 1] FG_map GmultD'
   by    simp
 
 lemma VectorSpaceHom : "VectorSpaceHom fsmult V fsmult' T"
   by  (
         rule VectorSpace.VectorSpaceHomI, rule fVectorSpace, unfold_locales,
         rule f_map
       )
 
 lemmas distrib_flincomb = VectorSpaceHom.distrib_lincomb[OF VectorSpaceHom]
 
 lemma FGModule_Im : "FGModule G smult' ImG"
   by (rule FGModule.intro, rule GroupG, rule RModule_Im, unfold_locales)
 
 lemma FGModHom_composite_left :
   assumes "FGModuleHom G smult' W smult'' S" "T ` V \<subseteq> W"
   shows   "FGModuleHom G smult V smult'' (S \<circ> T)"
 proof (rule FGModuleHom.intro)
   from assms(2) show "RModuleHom FG smult V smult'' (S \<circ> T)"
     using FGModuleHom.axioms(2)[OF assms(1)] RModHom_composite_left[of W]
     by    fast
 qed (rule GroupG, unfold_locales)
 
 lemma restriction_to_subgroup_is_hom :
   fixes   H  :: "'g set"
   assumes subgrp: "Group.Subgroup G H"
   shows   "FGModuleHom H smult V smult' T"
 proof (rule FGModule.FGModuleHomI_fromaxioms)
   have "FGModule G smult V" ..
   with assms show "FGModule H (\<cdot>) V"
     using FGModule.restriction_to_subgroup_is_module by fast
   from supp show "supp T \<subseteq> V" by fast
   from assms
     show  "\<And>r m. \<lbrakk> r \<in> (Group.group_ring H); m \<in> V \<rbrakk> \<Longrightarrow> T (r \<cdot> m) = r \<star> T m"
     using FG_map ActingGroup.Subgroup_imp_Subring by fast
 qed (rule hom)
 
 lemma FGModuleHom_restrict0_GSubspace :
   assumes "GSubspace U"
   shows   "FGModuleHom G smult U smult' (T \<down> U)"
 proof (rule FGModuleHom.intro)
   from assms show "RModuleHom FG (\<cdot>) U (\<star>) (T \<down> U)"
     using RModuleHom_restrict0_submodule by fast
 qed (unfold_locales)
 
 lemma FGModuleHom_fscalar_mul :
   "FGModuleHom G smult V smult' (\<lambda>v. a \<sharp>\<star> T v)"
 proof
   have vsphom: "VectorSpaceHom fsmult V fsmult' (\<lambda>v. a \<sharp>\<star> T v)"
     using VectorSpaceHom.VectorSpaceHom_scalar_mul[OF VectorSpaceHom]
     by    fast
   thus "\<And>v v'. v \<in> V \<Longrightarrow> v' \<in> V \<Longrightarrow> a \<sharp>\<star> T (v + v') = a \<sharp>\<star> T v + a \<sharp>\<star> T v'"
     using VectorSpaceHom.additive[of fsmult V] by auto
   from vsphom show "supp (\<lambda>v. a \<sharp>\<star> T v) \<subseteq> V"
     using VectorSpaceHom.supp by fast
 next
   fix r v assume rv: "r \<in> FG" "v \<in> V"
   thus "a \<sharp>\<star> T (r \<cdot> v) = r \<star> a \<sharp>\<star> T v"
     using FG_map FGModule.fsmult_smult_comm[OF FGModule_Im] 
     by    auto
 qed
 
 end (* context FGModuleHom *)
 
 lemma GSubspace_eigenspace :
   fixes   e     :: "'f::field"
   and     E     :: "'v::ab_group_add set"
   and     smult :: "('f::field, 'g::group_add) aezfun \<Rightarrow> 'v \<Rightarrow> 'v" (infixr "\<cdot>" 70)
   assumes FGModHom: "FGModuleHom G smult V smult T"
   defines E       : "E \<equiv> {v \<in> V. T v = aezfun_scalar_mult.fsmult smult e v}"
   shows   "FGModule.GSubspace G smult V E"
 proof-
   have "FGModule.GSubspace G smult V {v \<in> V. T v = (e \<delta>\<delta> 0) \<cdot> v}"
     using FGModuleHom.axioms(2)[OF FGModHom]
   proof (rule RSubmodule_eigenspace)
     show "e \<delta>\<delta> 0 \<in> FGModule.FG G"
       using FGModuleHom.FG_fdd0_closed[OF FGModHom] by fast
     show "\<And>s v. s \<in> FGModule.FG G \<Longrightarrow> v \<in> V \<Longrightarrow> s \<cdot> (e \<delta>\<delta> 0) \<cdot> v = (e \<delta>\<delta> 0) \<cdot> s \<cdot> v"
       using FGModuleHom.fsmult_smult_domain_comm[OF FGModHom]
             aezfun_scalar_mult.fsmultD[of smult]
       by    simp
   qed
   with E show ?thesis using aezfun_scalar_mult.fsmultD[of smult] by simp
 qed
 
 subsubsection \<open>Basic facts about endomorphisms\<close>
 
 lemma RModuleEnd_over_group_ring_is_FGModuleEnd :
   fixes   G     :: "'g::group_add set"
   and     smult :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v"
   assumes G : "Group G" and endo: "RModuleEnd (Group.group_ring G) smult V T"
   shows   "FGModuleEnd G smult V T"
 proof (rule FGModuleEnd.intro, rule FGModuleHom.intro, rule G)
   from endo show "RModuleHom (Group.group_ring G) smult V smult T"
     using RModuleEnd.axioms(1) by fast
   from endo show "FGModuleEnd_axioms V T"
     using RModuleEnd.endomorph by unfold_locales
 qed
 
 lemma (in FGModule) VecEnd_GMap_is_FGModuleEnd :
   assumes endo : "VectorSpaceEnd fsmult V T"
   and     G_map: "\<And>g v. g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> T (g *\<cdot> v) = g *\<cdot> (T v)"
   shows   "FGModuleEnd G smult V T"
 proof (rule FGModuleEnd.intro, rule VecHom_GMap_is_FGModuleHom)
   from endo show "VectorSpaceHom (\<sharp>\<cdot>) V (\<sharp>\<cdot>) T"
     using VectorSpaceEnd.axioms(1) by fast
   from endo show "T ` V \<subseteq> V" using VectorSpaceEnd.endomorph by fast
   from endo show "FGModuleEnd_axioms V T"
     using VectorSpaceEnd.endomorph by unfold_locales
 qed (unfold_locales, rule G_map)
 
 lemma (in FGModule) GEnd_inner_dirsum_el_decomp_nth :
   "\<lbrakk> \<forall>U\<in>set Us. GSubspace U; add_independentS Us; n < length Us \<rbrakk>
         \<Longrightarrow> FGModuleEnd G smult  (\<Oplus>U\<leftarrow>Us. U) (\<Oplus>Us\<down>n)"
   using GroupG RModuleEnd_inner_dirsum_el_decomp_nth
         RModuleEnd_over_group_ring_is_FGModuleEnd
   by    fast
 
 context FGModuleEnd
 begin
 
 lemma RModuleEnd : "RModuleEnd ActingGroup.group_ring smult V T"
   using endomorph by unfold_locales
 
 lemma VectorSpaceEnd : "VectorSpaceEnd fsmult V T"
   by  (
         rule VectorSpaceEnd.intro, rule VectorSpaceHom, unfold_locales,
         rule endomorph
       )
 
 lemmas proj_decomp                     = RModuleEnd.proj_decomp[OF RModuleEnd]
 lemmas GSubspace_Ker                   = GSubspace_Ker
 lemmas FGModuleHom_restrict0_GSubspace = FGModuleHom_restrict0_GSubspace
 
 end (* context FGModuleEnd *)
 
 subsubsection \<open>Basic facts about isomorphisms\<close>
 
 context FGModuleIso
 begin
 
 lemmas VectorSpaceHom = VectorSpaceHom
 
 abbreviation "invT \<equiv> (the_inv_into V T) \<down> W"
 
 lemma RModuleIso : "RModuleIso FG smult V smult' T W"
 proof (rule RModuleIso.intro)
   show "RModuleHom FG (\<cdot>) V (\<star>) T"
     using FGModuleIso_axioms FGModuleIso.axioms(1) FGModuleHom.axioms(2)
     by    fast
 qed (unfold_locales, rule bijective)
 
 lemmas ImG = RModuleIso.ImG[OF RModuleIso]
 
 lemma FGModuleIso_restrict0_GSubspace :
   assumes "GSubspace U"
   shows   "FGModuleIso G smult U smult' (T \<down> U) (T ` U)"
 proof (rule FGModuleIso.intro)
   from assms show "FGModuleHom G (\<cdot>) U (\<star>) (T \<down> U)"
     using FGModuleHom_restrict0_GSubspace by fast
   show "FGModuleIso_axioms U (T \<down> U) (T ` U)"
   proof
     from assms bijective have "bij_betw T U (T ` U)"
       using subset_inj_on unfolding bij_betw_def by auto
     thus "bij_betw (T \<down> U) U (T ` U)" unfolding bij_betw_def inj_on_def by auto
   qed
 qed
 
 lemma inv : "FGModuleIso G smult' W smult invT V"
 proof (rule FGModuleIso.intro, rule FGModuleHom.intro)
   show "RModuleHom FG (\<star>) W (\<cdot>) invT"
     using RModuleIso.inv[OF RModuleIso] RModuleIso.axioms(1) by fast
   show "FGModuleIso_axioms W invT V" 
     using RModuleIso.inv[OF RModuleIso] RModuleIso.bijective by unfold_locales
 qed (unfold_locales)
 
 lemma FGModIso_composite_left :
   assumes "FGModuleIso G smult' W smult'' S X"
   shows   "FGModuleIso G smult V smult'' (S \<circ> T) X"
 proof (rule FGModuleIso.intro)
   from assms show "FGModuleHom G (\<cdot>) V smult'' (S \<circ> T)"
     using FGModuleIso.axioms(1) ImG FGModHom_composite_left by fast
   show "FGModuleIso_axioms V (S \<circ> T) X"
     using bijective FGModuleIso.bijective[OF assms] bij_betw_trans by unfold_locales
 qed
 
 lemma isomorphic_sym : "FGModule.isomorphic G smult' W smult V"
   using inv by fast
 
 lemma isomorphic_trans :
   "FGModule.isomorphic G smult' W smult'' X
         \<Longrightarrow> FGModule.isomorphic G smult V smult'' X"
   using FGModIso_composite_left by fast
 
 lemma isomorphic_to_zero_left : "V = 0 \<Longrightarrow> W = 0"
   using bijective bij_betw_imp_surj_on im_zero by fastforce
 
 lemma isomorphic_to_zero_right : "W = 0 \<Longrightarrow> V = 0"
   using isomorphic_sym FGModuleIso.isomorphic_to_zero_left by fast
 
 lemma isomorphic_to_irr_right' :
   assumes "\<And>U. FGModule.GSubspace G smult' W U \<Longrightarrow> U = 0 \<or> U = W"
   shows   "\<And>U. GSubspace U \<Longrightarrow> U = 0 \<or> U = V"
 proof-
   fix U assume U: "GSubspace U"
   have "U \<noteq> V \<Longrightarrow> U = 0"
   proof-
     assume UV: "U \<noteq> V"
     from U bijective have "T ` U = T ` V \<Longrightarrow> U = V"
       using bij_betw_imp_inj_on[of T V W] inj_onD[of T V] by fast
     with UV bijective have "T ` U \<noteq> W" using bij_betw_imp_surj_on by fast
     moreover from U have "FGModule.GSubspace G smult' W (T ` U)"
       using ImG im_submodule by fast
     ultimately show "U = 0" 
       using assms U FGModuleIso_restrict0_GSubspace
             FGModuleIso.isomorphic_to_zero_right
       by    fast
   qed
   thus "U = 0 \<or> U = V" by fast
 qed
 
 end (* context FGModuleIso *)
 
 context FGModule
 begin
 
 lemma isomorphic_sym :
   "isomorphic smult' W \<Longrightarrow> FGModule.isomorphic G smult' W smult V"
   using FGModuleIso.inv by fast
 
 lemma isomorphic_trans : 
   "isomorphic smult' W \<Longrightarrow> FGModule.isomorphic G smult' W smult'' X
         \<Longrightarrow> isomorphic smult'' X"
   using FGModuleIso.FGModIso_composite_left by fast
 
 lemma isomorphic_to_zero_left : "V = 0 \<Longrightarrow> isomorphic smult' W \<Longrightarrow> W = 0"
   using FGModuleIso.isomorphic_to_zero_left by fast
 
 lemma isomorphic_to_zero_right : "isomorphic smult' 0 \<Longrightarrow> V = 0"
   using FGModuleIso.isomorphic_to_zero_right by fast
 
 lemma FGModIso_idhom : "FGModuleIso G smult V smult (id\<down>V) V"
   using FGModHom_idhom
 proof (rule FGModuleIso.intro)
   show "FGModuleIso_axioms V (id\<down>V) V"
     using bij_betw_id bij_betw_restrict0 by unfold_locales fast
 qed
 
 lemma isomorphic_refl : "isomorphic smult V" using FGModIso_idhom by fast
 
 end (* context FGModule *)
 
 subsubsection \<open>Hom-sets\<close>
 
 definition FGModuleHomSet ::
   "'g::group_add set \<Rightarrow> (('f::field,'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v) \<Rightarrow> 'v set
         \<Rightarrow> (('f,'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w) \<Rightarrow> 'w set
         \<Rightarrow> ('v \<Rightarrow> 'w) set"
   where "FGModuleHomSet G fgsmult V fgsmult' W
               \<equiv> {T. FGModuleHom G fgsmult V fgsmult' T} \<inter> {T. T ` V \<subseteq> W}"
 
 lemma FGModuleHomSetI :
   "FGModuleHom G fgsmult V fgsmult' T \<Longrightarrow> T ` V \<subseteq> W
         \<Longrightarrow> T \<in> FGModuleHomSet G fgsmult V fgsmult' W"
   unfolding FGModuleHomSet_def by fast
 
 lemma FGModuleHomSetD_FGModuleHom :
   "T \<in> FGModuleHomSet G fgsmult V fgsmult' W
         \<Longrightarrow> FGModuleHom G fgsmult V fgsmult' T"
   unfolding FGModuleHomSet_def by fast
 
 lemma FGModuleHomSetD_Im :
   "T \<in> FGModuleHomSet G fgsmult V fgsmult' W \<Longrightarrow> T ` V \<subseteq> W"
   unfolding FGModuleHomSet_def by fast
 
 context FGModule
 begin
 
 lemma FGModuleHomSet_is_Gmaps_in_VectorSpaceHomSet :
   fixes   smult'  :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and     fsmult' :: "'f \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "\<sharp>\<star>" 70)
   and     Gmult'  :: "'g \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "*\<star>" 70)
   defines fsmult'  : "fsmult' \<equiv> aezfun_scalar_mult.fsmult smult'"
   and     Gmult'   : "Gmult' \<equiv> aezfun_scalar_mult.Gmult smult'"
   assumes FGModW   : "FGModule G smult' W"
   shows   "FGModuleHomSet G smult V smult' W
                 = (VectorSpaceHomSet fsmult V fsmult' W)
                   \<inter> {T. \<forall>g\<in>G. \<forall>v\<in>V. T (g *\<cdot> v) = g *\<star> (T v)}"
 proof
   from fsmult' Gmult'
     show  "FGModuleHomSet G smult V smult' W
                 \<subseteq> (VectorSpaceHomSet fsmult V fsmult' W)
                   \<inter> {T. \<forall>g\<in>G. \<forall>v\<in>V. T (g *\<cdot> v) = g *\<star> T v}"
     using FGModuleHomSetD_FGModuleHom[of _ G smult V smult']
           FGModuleHom.VectorSpaceHom[of G smult V smult'] 
           FGModuleHomSetD_Im[of _ G smult V smult']
           VectorSpaceHomSetI[of fsmult V fsmult']
           FGModuleHom.G_map[of G smult V smult']
     by    auto
   show "FGModuleHomSet G smult V smult' W
               \<supseteq> (VectorSpaceHomSet fsmult V fsmult' W)
                 \<inter> {T. \<forall>g\<in>G. \<forall>v\<in>V. T (g *\<cdot> v) = g *\<star> T v}"
   proof
     fix T
     assume T: "T \<in> (VectorSpaceHomSet fsmult V fsmult' W)
                     \<inter> {T. \<forall>g\<in>G. \<forall>v\<in>V. T (g *\<cdot> v) = g *\<star> T v}"
     show "T \<in> FGModuleHomSet G smult V smult' W"
     proof (rule FGModuleHomSetI, rule VecHom_GMap_is_FGModuleHom)
       from T fsmult'
         show  "VectorSpaceHom (\<sharp>\<cdot>) V (aezfun_scalar_mult.fsmult smult') T"
         using VectorSpaceHomSetD_VectorSpaceHom
         by    fast
       from T show "T ` V \<subseteq> W" using VectorSpaceHomSetD_Im by fast
       from T Gmult' 
         show  "\<And>g v. g \<in> G \<Longrightarrow> v \<in> V
                     \<Longrightarrow> T (g *\<cdot> v) = aezfun_scalar_mult.Gmult (\<star>) g (T v)" 
         by    fast
       from T show "T ` V \<subseteq> W" using VectorSpaceHomSetD_Im by fast
     qed (rule FGModW)
   qed
 qed
 
 lemma Group_FGModuleHomSet :
   fixes   smult'  :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and     fsmult' :: "'f \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "\<sharp>\<star>" 70)
   and     Gmult'  :: "'g \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "*\<star>" 70)
   defines fsmult'  : "fsmult' \<equiv> aezfun_scalar_mult.fsmult smult'"
   and     Gmult'   : "Gmult' \<equiv> aezfun_scalar_mult.Gmult smult'"
   assumes FGModW   : "FGModule G smult' W"
   shows   "Group (FGModuleHomSet G smult V smult' W)"
 proof
   from FGModW show "FGModuleHomSet G (\<cdot>) V smult' W \<noteq> {}"
     using FGModule.smult_zero trivial_FGModuleHom[of smult'] FGModule.zero_closed
           FGModuleHomSetI
     by    fastforce
 next
   fix S T
   assume S: "S \<in> FGModuleHomSet G (\<cdot>) V smult' W"
     and  T: "T \<in> FGModuleHomSet G (\<cdot>) V smult' W"
   with assms
     have  ST: "S \<in> (VectorSpaceHomSet fsmult V fsmult' W)
                     \<inter> {T. \<forall>g\<in>G. \<forall>v\<in>V. T (g *\<cdot> v) = g *\<star> T v}"
               "T \<in> (VectorSpaceHomSet fsmult V fsmult' W)
                     \<inter> {T. \<forall>g\<in>G. \<forall>v\<in>V. T (g *\<cdot> v) = g *\<star> T v}"
     using FGModuleHomSet_is_Gmaps_in_VectorSpaceHomSet
     by    auto
   with fsmult' have "S - T \<in> VectorSpaceHomSet fsmult V fsmult' W"
     using FGModule.fVectorSpace[OF FGModW]
           VectorSpace.Group_VectorSpaceHomSet[OF fVectorSpace] Group.diff_closed
     by    fast
   moreover have "\<And>g v. g\<in>G \<Longrightarrow> v\<in>V \<Longrightarrow> (S-T) (g *\<cdot> v) = g *\<star> ((S-T) v)"
   proof-
     fix g v assume "g \<in> G" "v \<in> V"
     moreover with ST have "S v \<in> W" "T v \<in> W" "- T v \<in> W"
       using VectorSpaceHomSetD_Im[of S fsmult V fsmult']
             VectorSpaceHomSetD_Im[of T fsmult V fsmult']
             FGModule.neg_closed[OF FGModW]
       by    auto
     ultimately show "(S-T) (g *\<cdot> v) = g *\<star> ((S-T) v)"
       using ST Gmult' FGModule.neg_Gmult[OF FGModW]
             FGModule.Gmult_distrib_left[OF FGModW, of g "S v" "- T v"]
       by    auto
   qed
   ultimately show "S - T \<in> FGModuleHomSet G (\<cdot>) V smult' W"
     using fsmult' Gmult'
           FGModuleHomSet_is_Gmaps_in_VectorSpaceHomSet[OF FGModW]
     by    fast
 qed
 
 lemma Subspace_FGModuleHomSet :
   fixes   smult'     :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and     fsmult'    :: "'f \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "\<sharp>\<star>" 70)
   and     Gmult'     :: "'g \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "*\<star>" 70)
   and     hom_fsmult :: "'f \<Rightarrow> ('v \<Rightarrow> 'w) \<Rightarrow> ('v \<Rightarrow> 'w)" (infixr "\<sharp>\<star>\<cdot>" 70)
   defines fsmult'     : "fsmult' \<equiv> aezfun_scalar_mult.fsmult smult'"
   and     Gmult'      : "Gmult' \<equiv> aezfun_scalar_mult.Gmult smult'"
   defines hom_fsmult  : "hom_fsmult \<equiv> \<lambda>a T v. a \<sharp>\<star> T v"
   assumes FGModW      : "FGModule G smult' W"
   shows   "VectorSpace.Subspace hom_fsmult
                 (VectorSpaceHomSet fsmult V fsmult' W)
                   (FGModuleHomSet G smult V smult' W)"
 proof (rule VectorSpace.SubspaceI)
   from hom_fsmult fsmult'
     show  "VectorSpace (\<sharp>\<star>\<cdot>) (VectorSpaceHomSet (\<sharp>\<cdot>) V (\<sharp>\<star>) W)"
     using FGModule.fVectorSpace[OF FGModW]
           VectorSpace.VectorSpace_VectorSpaceHomSet[OF fVectorSpace]
     by    fast
   from fsmult' Gmult' FGModW
     show  "Group (FGModuleHomSet G (\<cdot>) V (\<star>) W)
                 \<and> FGModuleHomSet G (\<cdot>) V (\<star>) W
                   \<subseteq> VectorSpaceHomSet (\<sharp>\<cdot>) V (\<sharp>\<star>) W"
     using Group_FGModuleHomSet FGModuleHomSet_is_Gmaps_in_VectorSpaceHomSet
     by    fast
 next
   fix a T assume T: "T \<in> FGModuleHomSet G (\<cdot>) V (\<star>) W"
   from hom_fsmult fsmult' have "FGModuleHom G smult V smult' (a \<sharp>\<star>\<cdot> T)"
     using FGModuleHomSetD_FGModuleHom[OF T]
           FGModuleHomSetD_Im[OF T] 
           FGModuleHom.FGModuleHom_fscalar_mul
     by    simp
   moreover from hom_fsmult fsmult' have "(a \<sharp>\<star>\<cdot> T) ` V \<subseteq> W"
     using FGModuleHomSetD_Im[OF T] FGModule.fsmult_closed[OF FGModW]
     by    auto
   ultimately show "a \<sharp>\<star>\<cdot> T \<in> FGModuleHomSet G (\<cdot>) V (\<star>) W"
     using FGModuleHomSetI by fastforce
 qed
 
 lemma VectorSpace_FGModuleHomSet :
   fixes   smult'     :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and     fsmult'    :: "'f \<Rightarrow> 'w \<Rightarrow> 'w" (infixr "\<sharp>\<star>" 70)
   and     hom_fsmult :: "'f \<Rightarrow> ('v \<Rightarrow> 'w) \<Rightarrow> ('v \<Rightarrow> 'w)" (infixr "\<sharp>\<star>\<cdot>" 70)
   defines "fsmult' \<equiv> aezfun_scalar_mult.fsmult smult'"
   defines "hom_fsmult \<equiv> \<lambda>a T v. a \<sharp>\<star> T v"
   assumes "FGModule G smult' W"
   shows   "VectorSpace hom_fsmult (FGModuleHomSet G smult V smult' W)"
   using   assms Subspace_FGModuleHomSet Module.intro VectorSpace.intro
   by      fast
 
 end (* context FGModule *)
 
 subsection \<open>Induced modules\<close>
 
 subsubsection \<open>Additive function spaces\<close>
 
 definition addfunset ::
   "'a::monoid_add set \<Rightarrow> 'm::monoid_add set \<Rightarrow> ('a \<Rightarrow> 'm) set"
   where "addfunset A M \<equiv> {f. supp f \<subseteq> A \<and> range f \<subseteq> M
               \<and> (\<forall>x\<in>A. \<forall>y\<in>A. f (x+y) = f x + f y) }"
 
 lemma addfunsetI :
   "\<lbrakk> supp f \<subseteq> A; range f \<subseteq> M; \<forall>x\<in>A. \<forall>y\<in>A. f (x+y) = f x + f y \<rbrakk>
         \<Longrightarrow> f \<in> addfunset A M"
   unfolding addfunset_def by fast
 
 lemma addfunsetD_supp : "f \<in> addfunset A M \<Longrightarrow> supp  f \<subseteq> A"
   unfolding addfunset_def by fast
 
 lemma addfunsetD_range : "f \<in> addfunset A M \<Longrightarrow> range f \<subseteq> M"
   unfolding addfunset_def by fast
 
 lemma addfunsetD_range' : "f \<in> addfunset A M \<Longrightarrow> f x \<in> M"
   using addfunsetD_range by fast
 
 lemma addfunsetD_add :
   "\<lbrakk> f \<in> addfunset A M; x\<in>A; y\<in>A \<rbrakk> \<Longrightarrow> f (x+y) = f x + f y"
   unfolding addfunset_def by fast
 
 lemma addfunset0 : "addfunset A (0::'m::monoid_add set) = 0"
 proof
   show "addfunset A 0 \<subseteq> 0" using addfunsetD_range' by fastforce
   have "(0::'a\<Rightarrow>'m) \<in> addfunset A 0"
     using supp_zerofun_subset_any by (rule addfunsetI) auto
   thus "addfunset A (0::'m::monoid_add set) \<supseteq> 0" by simp
 qed
 
 lemma Group_addfunset :
   fixes   M::"'g::ab_group_add set"
   assumes "Group M"
   shows   "Group (addfunset R M)"
 proof
   from assms show "addfunset R M \<noteq> {}"
     using addfunsetI[of 0 R M] supp_zerofun_subset_any Group.zero_closed
     by    fastforce
 next
   fix g h assume gh: "g \<in> addfunset R M" "h \<in> addfunset R M"
   show "g - h \<in> addfunset R M"
   proof (rule addfunsetI)
     from gh show "supp (g - h) \<subseteq> R"
       using addfunsetD_supp supp_diff_subset_union_supp by fast
     from gh show "range (g - h) \<subseteq> M"
       using addfunsetD_range Group.diff_closed [OF assms]
         by (simp add: addfunsetD_range' image_subsetI)
     show "\<forall>x\<in>R. \<forall>y\<in>R. (g - h) (x + y) = (g - h) x + (g - h) y"
       using addfunsetD_add[OF gh(1)] addfunsetD_add[OF gh(2)] by simp
   qed
 qed
 
 subsubsection \<open>Spaces of functions which transform under scalar multiplication by
                  almost-everywhere-zero functions\<close>
 
 context aezfun_scalar_mult
 begin
 
 definition smultfunset :: "'g set \<Rightarrow> ('r,'g) aezfun set \<Rightarrow> (('r,'g) aezfun \<Rightarrow> 'v) set"
   where "smultfunset G FH \<equiv> {f. (\<forall>a::'r. \<forall>g\<in>G. \<forall>x\<in>FH.
               f ( a \<delta>\<delta> g * x ) = (a \<delta>\<delta> g) \<cdot> (f x))}"
 
 lemma smultfunsetD :
   "\<lbrakk>f \<in> smultfunset G FH; g\<in>G; x\<in>FH \<rbrakk> \<Longrightarrow> f ( a \<delta>\<delta> g * x ) = (a \<delta>\<delta> g) \<cdot> (f x)"
   unfolding smultfunset_def by fast
 
 lemma smultfunsetI : 
   "\<forall>a::'r. \<forall>g\<in>G. \<forall>x\<in>FH. f ( a \<delta>\<delta> g * x ) = (a \<delta>\<delta> g) \<cdot> (f x)
         \<Longrightarrow> f \<in> smultfunset G FH"
   unfolding smultfunset_def by fast
 
 end (* context aezfun_scalar_mult *)
 
 subsubsection \<open>General induced spaces of functions on a group ring\<close>
 
 context aezfun_scalar_mult
 begin
 
 definition indspace ::
   "'g set \<Rightarrow> ('r,'g) aezfun set \<Rightarrow> 'v set \<Rightarrow> (('r,'g) aezfun \<Rightarrow> 'v) set"
   where "indspace G FH V = addfunset FH V \<inter> smultfunset G FH"
 
 lemma indspaceD :
   "f \<in> indspace G FH V \<Longrightarrow> f \<in> addfunset FH V \<inter> smultfunset G FH"
   using indspace_def by fast
 
 lemma indspaceD_supp : "f \<in> indspace G FH V \<Longrightarrow> supp  f \<subseteq> FH"
   using indspace_def addfunsetD_supp by fast
 
 lemma indspaceD_supp' : "f \<in> indspace G FH V \<Longrightarrow> x \<notin> FH \<Longrightarrow> f x = 0"
   using indspaceD_supp suppI_contra by fast
 
 lemma indspaceD_range : "f \<in> indspace G FH V \<Longrightarrow> range f \<subseteq> V"
   using indspace_def addfunsetD_range by fast
 
 lemma indspaceD_range': "f \<in> indspace G FH V \<Longrightarrow> f x \<in> V"
   using indspaceD_range by fast
 
 lemma indspaceD_add :
   "\<lbrakk> f \<in> indspace G FH V; x\<in>FH; y\<in>FH \<rbrakk> \<Longrightarrow> f (x+y) = f x + f y"
   using indspace_def addfunsetD_add by auto
 
 lemma indspaceD_transform : 
   "\<lbrakk>f \<in> indspace G FH V; g\<in>G; x\<in>FH \<rbrakk> \<Longrightarrow> f ( a \<delta>\<delta> g * x ) = (a \<delta>\<delta> g) \<cdot> (f x)"
   using indspace_def smultfunsetD by auto
 
 lemma indspaceI :
   "f \<in> addfunset FH V \<Longrightarrow> f \<in> smultfunset G FH \<Longrightarrow> f \<in> indspace G FH V"
   using indspace_def by fast
 
 lemma indspaceI' :
   "\<lbrakk> supp f \<subseteq> FH; range f \<subseteq> V; \<forall>x\<in>FH. \<forall>y\<in>FH. f (x+y) = f x + f y;
                 \<forall>a::'r. \<forall>g\<in>G. \<forall>x\<in>FH. f ( a \<delta>\<delta> g * x ) = (a \<delta>\<delta> g) \<cdot> (f x) \<rbrakk>
                   \<Longrightarrow> f \<in> indspace G FH V"
   using smultfunsetI addfunsetI[of f] indspaceI by simp
 
 lemma mono_indspace : "mono (indspace G FH)"
 proof (rule monoI)
   fix U V :: "'v set" assume U_V: "U \<subseteq> V"
   show "indspace G FH U \<subseteq> indspace G FH V"
   proof
     fix f assume f: "f \<in> indspace G FH U"
     show "f \<in> indspace G FH V" using indspaceD_supp[OF f]
     proof (rule indspaceI')
       from f U_V show "range f \<subseteq> V" using indspaceD_range[of f G FH] by auto
       from f show "\<forall>x\<in>FH. \<forall>y\<in>FH. f (x+y) = f x + f y"
         using indspaceD_add by auto
       from f show "\<forall>a::'r. \<forall>g\<in>G. \<forall>x\<in>FH. f ( a \<delta>\<delta> g * x ) = (a \<delta>\<delta> g) \<cdot> (f x)" 
         using indspaceD_transform by auto
     qed
   qed
 qed
 
 end (* context aezfun_scalar_mult *)
 
 context FGModule
 begin
 
 lemma zero_transforms : "0 \<in> smultfunset G FH"
   using smultfunsetI FG_fddg_closed smult_zero by simp
 
 lemma indspace0 : "indspace G FH 0 = 0"
   using zero_transforms addfunset0 indspace_def by auto
 
 lemma Group_indspace :
   assumes "Ring1 FH"
   shows   "Group (indspace G FH V)"
 proof
   from zero_closed have "0 \<subseteq> V" by simp
   with mono_indspace [of G FH]
   have "indspace G FH 0 \<subseteq> indspace G FH V"
     by (auto dest!: monoD [of _ 0 V])
   then show "indspace G FH V \<noteq> {}"
     using indspace0 [of FH] by auto
 next
   fix f1 f2 assume ff: "f1 \<in> indspace G FH V" "f2 \<in> indspace G FH V"
   hence "f1 - f2 \<in> addfunset FH V"
     using assms indspaceD indspaceD Group Group_addfunset Group.diff_closed
     by    fast
   moreover from ff have "f1 - f2 \<in> smultfunset G FH"
     using indspaceD_transform FG_fddg_closed indspaceD_range' smult_distrib_left_diff
           smultfunsetI
     by    simp
   ultimately show "f1 - f2 \<in> indspace G FH V" using indspaceI by fast
 qed
 
 end (* context FGModule *)
 
 subsubsection \<open>The right regular action\<close>
 
 context Ring1
 begin
 
 definition rightreg_scalar_mult :: 
   "'r::ring_1 \<Rightarrow> ('r \<Rightarrow> 'm::ab_group_add) \<Rightarrow> ('r \<Rightarrow> 'm)" (infixr "\<currency>" 70)
   where "rightreg_scalar_mult r f = (\<lambda>x. if x \<in> R then f (x*r) else 0)"
 
 lemma rightreg_scalar_multD1 : "x \<in> R \<Longrightarrow> (r \<currency> f) x = f (x*r)"
   unfolding rightreg_scalar_mult_def by simp
 
 lemma rightreg_scalar_multD2 : "x \<notin> R \<Longrightarrow> (r \<currency> f) x = 0"
   unfolding rightreg_scalar_mult_def by simp
 
 lemma rrsmult_supp : "supp (r \<currency> f) \<subseteq> R"
   using rightreg_scalar_multD2 suppD_contra by force
 
 lemma rrsmult_range : "range (r \<currency> f) \<subseteq> {0} \<union> range f"
 proof (rule image_subsetI)
   fix x show "(r \<currency> f) x \<in> {0} \<union> range f"
     using rightreg_scalar_multD1[of x r f] image_eqI
           rightreg_scalar_multD2[of x r f]
     by    (cases "x \<in> R") auto
 qed
 
 lemma rrsmult_distrib_left : "r \<currency> (f + g) = r \<currency> f + r \<currency> g"
 proof
   fix x show "(r \<currency> (f + g)) x = (r \<currency> f + r \<currency> g) x"
     unfolding rightreg_scalar_mult_def by (cases "x \<in> R") auto
 qed
 
 lemma rrsmult_distrib_right :
   assumes "\<And>x y. x \<in> R \<Longrightarrow> y \<in> R \<Longrightarrow> f (x+y) = f x + f y" "r \<in> R" "s \<in> R"
   shows   "(r + s) \<currency> f = r \<currency> f + s \<currency> f"
 proof
   fix x show "((r + s) \<currency> f) x = (r \<currency> f + s \<currency> f) x"
     using     assms mult_closed
     unfolding rightreg_scalar_mult_def
     by        (cases "x \<in> R") (auto simp add: distrib_left)
 qed
 
 lemma RModule_addfunset :
   fixes   M::"'g::ab_group_add set"
   assumes "Group M"
   shows   "RModule R rightreg_scalar_mult (addfunset R M)"
 proof (rule RModuleI)
 
   from assms show "Group (addfunset R M)" using Group_addfunset by fast
 
   show "RModule_axioms R (\<currency>) (addfunset R M)"
   proof
     fix r f assume r: "r \<in> R" and f: "f \<in> addfunset R M"
     show "r \<currency> f \<in> addfunset R M"
     proof (rule addfunsetI)
       show "supp (r \<currency> f) \<subseteq> R"
         using rightreg_scalar_multD2 suppD_contra by force
       show "range (r \<currency> f) \<subseteq> M"
         using     addfunsetD_range[OF f] Group.zero_closed[OF assms]
         unfolding rightreg_scalar_mult_def
         by        fastforce
       from r show "\<forall>x\<in>R. \<forall>y\<in>R. (r \<currency> f) (x + y) = (r \<currency> f) x + (r \<currency> f) y"
         using     mult_closed add_closed addfunsetD_add[OF f]
         unfolding rightreg_scalar_mult_def
         by        (simp add: distrib_right)
     qed
   next
     show "\<And>r f g. r \<currency> (f + g) = r \<currency> f + r \<currency> g" using rrsmult_distrib_left by fast
   next
     fix r s f assume "r \<in> R" "s \<in> R" "f \<in> addfunset R M"
     thus "(r + s) \<currency> f = r \<currency> f + s \<currency> f"
       using addfunsetD_add[of f] rrsmult_distrib_right[of f] by simp
   next
     fix r s f assume r: "r \<in> R" and s: "s \<in> R" and f: "f \<in> addfunset R M"
     show "r \<currency> s \<currency> f = (r * s) \<currency> f"
     proof
       fix x from r show "(r \<currency> s \<currency> f) x = ((r * s) \<currency> f) x"
         using mult_closed unfolding rightreg_scalar_mult_def
         by    (cases "x \<in> R") (auto simp add: mult.assoc)
     qed
   next
     fix f assume f: "f \<in> addfunset R M"
     show "1 \<currency> f = f"
     proof
       fix x show "(1 \<currency> f) x = f x"
         unfolding rightreg_scalar_mult_def 
         using     addfunsetD_supp[OF f] suppI_contra[of x f]
                   contra_subsetD[of "supp f"]
         by        (cases "x \<in> R") auto
     qed
   qed
 
 qed (unfold_locales)
 
 end (* context Ring1 *)
 
 subsubsection \<open>Locale and basic facts\<close>
 
 text \<open>
   In the following locale, @{term G} is a subgroup of @{term H}, @{term V} is a module over the
   group ring for @{term G}, and the induced space @{term indV} will be shown to be a module over the
   group ring for @{term H} under the right regular scalar multiplication @{term rrsmult}.
 \<close>
 
 locale InducedFHModule = Supgroup?: Group H
 + BaseFGMod?    : FGModule G smult V
 + induced_smult?: aezfun_scalar_mult rrsmult
   for   H       :: "'g::group_add set"
   and   G       :: "'g set"
   and   FG      :: "('f::field, 'g) aezfun set"
   and   smult   :: "('f, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixl "\<cdot>" 70)
   and   V       :: "'v set"
   and   rrsmult :: "('f,'g) aezfun \<Rightarrow> (('f,'g) aezfun \<Rightarrow> 'v) \<Rightarrow> (('f,'g) aezfun \<Rightarrow> 'v)"
                                                                                     (infixl "\<currency>" 70)
 + fixes FH      :: "('f, 'g) aezfun set"
   and   indV    :: "(('f, 'g) aezfun \<Rightarrow> 'v) set"
   defines FH      : "FH \<equiv> Supgroup.group_ring"
   and     indV    : "indV \<equiv> BaseFGMod.indspace G FH V"
   assumes rrsmult : "rrsmult = Ring1.rightreg_scalar_mult FH"
   and     Subgroup: "Supgroup.Subgroup G"  (* G is a subgroup of H *)
 begin
 
 abbreviation indfsmult ::
   "'f \<Rightarrow> (('f, 'g) aezfun \<Rightarrow> 'v) \<Rightarrow> (('f, 'g) aezfun \<Rightarrow> 'v)" (infixl "\<currency>\<currency>" 70)
   where "indfsmult \<equiv> induced_smult.fsmult"
 abbreviation indflincomb ::
   "'f list \<Rightarrow> (('f, 'g) aezfun \<Rightarrow> 'v) list \<Rightarrow> (('f, 'g) aezfun \<Rightarrow> 'v)" (infixl "\<bullet>\<currency>\<currency>" 70)
   where "indflincomb \<equiv> induced_smult.flincomb"
 abbreviation Hmult ::
   "'g \<Rightarrow> (('f, 'g) aezfun \<Rightarrow> 'v) \<Rightarrow> (('f, 'g) aezfun \<Rightarrow> 'v)" (infixl "*\<currency>" 70)
   where "Hmult \<equiv> induced_smult.Gmult"
 
 lemma Ring1_FH : "Ring1 FH" using FH Supgroup.Ring1_RG by fast
 
 lemma FG_subring_FH : "Ring1.Subring1 FH BaseFGMod.FG"
   using FH Supgroup.Subgroup_imp_Subring[OF Subgroup] by fast
 
 lemma rrsmultD1 : "x \<in> FH \<Longrightarrow> (r \<currency> f) x = f (x*r)"
   using Ring1.rightreg_scalar_multD1[OF Ring1_FH] rrsmult by simp
 
 lemma rrsmultD2 : "x \<notin> FH \<Longrightarrow> (r \<currency> f) x = 0"
   using Ring1.rightreg_scalar_multD2[OF Ring1_FH] rrsmult by fast
 
 lemma rrsmult_supp : "supp (r \<currency> f) \<subseteq> FH"
   using Ring1.rrsmult_supp[OF Ring1_FH] rrsmult by auto
 
 lemma rrsmult_range : "range (r \<currency> f) \<subseteq> {0} \<union> range f"
   using Ring1.rrsmult_range[OF Ring1_FH] rrsmult by auto
 
 lemma FHModule_addfunset : "FGModule H rrsmult (addfunset FH V)"
 proof (rule FGModule.intro)
   from FH rrsmult show "RModule Supgroup.group_ring (\<currency>) (addfunset FH V)"
     using Group Supgroup.Ring1_RG Ring1.RModule_addfunset by fast
 qed (unfold_locales)
 
 lemma FHSubmodule_indspace :
   "FGModule.FGSubmodule H rrsmult (addfunset FH V) indV"
 proof (rule FGModule.FGSubmoduleI[of H], rule FHModule_addfunset, rule conjI)
   from Ring1_FH indV show "Group indV" using Group_indspace by fast
   from indV show "indV \<subseteq> addfunset FH V"
     using BaseFGMod.indspaceD by fast
 next
   fix r f assume rf: "r \<in> (Supgroup.group_ring :: ('f,'g) aezfun set)" "f \<in> indV"
   from rf(2) indV have rf2': "f \<in> BaseFGMod.indspace G FH V" by fast
   show "r \<currency> f \<in> indV"
     unfolding indV
   proof (rule BaseFGMod.indspaceI', rule rrsmult_supp)
     show "range (r \<currency> f) \<subseteq> V"
       using rrsmult_range BaseFGMod.indspaceD_range[OF rf2'] zero_closed
       by    force
     from FH rf(1) rf2'
       show  "\<forall>x\<in>FH. \<forall>y\<in>FH. (r \<currency> f) (x + y) = (r \<currency> f) x + (r \<currency> f) y"
       using Ring1.add_closed[OF Ring1_FH] rrsmultD1[of _ r f]
             Ring1.mult_closed[OF Ring1_FH] BaseFGMod.indspaceD_add
       by    (simp add: distrib_right)
     {
       fix a g x assume gx: "g\<in>G" "x\<in>FH"
       with FH have "a \<delta>\<delta> g * x \<in> FH"
         using FG_fddg_closed FG_subring_FH Ring1.mult_closed[OF Ring1_FH]
         by    fast
       with FH rf(1) gx(2) have "(r \<currency> f) (a \<delta>\<delta> g * x) = a \<delta>\<delta> g \<cdot> ((r \<currency> f) x)"
         using rrsmultD1[of _ r f] Ring1.mult_closed[OF Ring1_FH] 
               BaseFGMod.indspaceD_transform[OF rf2' gx(1)]
         by    (simp add: mult.assoc)
     }
     thus "\<forall>a. \<forall>g\<in>G. \<forall>x\<in>FH. (r \<currency> f) (a \<delta>\<delta> g * x) = a \<delta>\<delta> g \<cdot> (r \<currency> f) x" by fast
   qed
 qed
 
 lemma FHModule_indspace : "FGModule H rrsmult indV"
 proof (rule FGModule.intro)
   show "RModule Supgroup.group_ring (\<currency>) indV" using FHSubmodule_indspace by fast
 qed (unfold_locales)
 
 lemmas fVectorSpace_indspace = FGModule.fVectorSpace[OF FHModule_indspace]
 lemmas restriction_is_FGModule
               = FGModule.restriction_to_subgroup_is_module[OF FHModule_indspace]
 
 definition induced_vector :: "'v \<Rightarrow> (('f, 'g) aezfun \<Rightarrow> 'v)"
   where "induced_vector v \<equiv> (if v \<in> V
               then (\<lambda>y. if y \<in> FH then (FG_proj y) \<cdot> v else 0) else 0)"
 
 lemma induced_vector_apply1 :
   "v \<in> V \<Longrightarrow> x \<in> FH \<Longrightarrow> induced_vector v x = (FG_proj x) \<cdot> v"
   using induced_vector_def by simp
 
 lemma induced_vector_apply2 : "v \<in> V \<Longrightarrow> x \<notin> FH \<Longrightarrow> induced_vector v x = 0"
   using induced_vector_def by simp
 
 lemma induced_vector_indV :
   assumes v: "v \<in> V"
   shows   "induced_vector v \<in> indV"
   unfolding indV 
 proof (rule BaseFGMod.indspaceI')
 
   from assms show "supp (induced_vector v) \<subseteq> FH"
     using induced_vector_def supp_restrict0[of FH "\<lambda>y. (FG_proj y) \<cdot> v"] by simp
 
   show "range (induced_vector v) \<subseteq> V"
   proof (rule image_subsetI)
     fix y
     from v show "(induced_vector v) y \<in> V"
       using     induced_vector_def zero_closed aezfun_setspan_proj_in_setspan[of G y]
                 smult_closed ActingGroup.group_ringD
       by        auto
   qed
 
   {
     fix x y assume xy: "x \<in> FH" "y \<in> FH"
     with v have "(induced_vector v) (x + y)
                       = (induced_vector v) x + (induced_vector v) y"
       using Ring1_FH Ring1.add_closed aezfun_setspan_proj_add[of G x y] FG_proj_in_FG
             smult_distrib_left induced_vector_def
       by    auto
   }
   thus "\<forall>x\<in>FH. \<forall>y\<in>FH. induced_vector v (x + y)
               = induced_vector v x + induced_vector v y"
     by fast
 
   {
     fix a g x assume g: "g \<in> G" and x: "x \<in> FH"
     with v FH
       have  "(induced_vector v) (a \<delta>\<delta> g * x) = a \<delta>\<delta> g \<cdot> (induced_vector v) x"
       using FG_subring_FH FG_fddg_closed Ring1_FH
             Ring1.mult_closed[of FH "a \<delta>\<delta> g"] FG_proj_mult_leftdelta[of g a]
             FG_fddg_closed FG_proj_in_FG smult_assoc induced_vector_def
       by    fastforce
   }
   thus "\<forall>a. \<forall>g\<in>G. \<forall>x\<in>FH. induced_vector v (a \<delta>\<delta> g * x)
               = a \<delta>\<delta> g \<cdot> induced_vector v x"
     by fast
 
 qed
 
 lemma induced_vector_additive :
   "v \<in> V \<Longrightarrow> v' \<in> V
         \<Longrightarrow> induced_vector (v+v') = induced_vector v + induced_vector v'"
   using add_closed induced_vector_def FG_proj_in_FG smult_distrib_left by auto
 
 lemma hom_induced_vector : "FGModuleHom G smult V rrsmult induced_vector"
 proof
 
   show "\<And>v v'. v \<in> V \<Longrightarrow> v' \<in> V
               \<Longrightarrow> induced_vector (v + v') = induced_vector v + induced_vector v'"
     using induced_vector_additive by fast
 
   have "induced_vector = (\<lambda>v. if v\<in>V then \<lambda>y. if y \<in> FH
               then (FG_proj y) \<cdot> v else 0 else 0)"
     using induced_vector_def by fast
   thus "supp induced_vector \<subseteq> V" using supp_restrict0[of V] by fastforce
 
   show "\<And>x v. x \<in> BaseFGMod.FG \<Longrightarrow> v \<in> V
               \<Longrightarrow> induced_vector (x \<cdot> v) = x \<currency> induced_vector v"
   proof-
     fix x v assume xv: "x \<in> BaseFGMod.FG" "v \<in> V"
     show "induced_vector (x \<cdot> v) = x \<currency> induced_vector v"
     proof
       fix a
       from xv FH show "induced_vector (x \<cdot> v) a = (x \<currency> induced_vector v) a"
         using smult_closed induced_vector_def FG_proj_in_FG smult_assoc rrsmultD1
               FG_subring_FH Ring1.mult_closed[OF Ring1_FH] induced_vector_apply1
               FG_proj_mult_right[of x] smult_closed induced_vector_apply2 rrsmultD2
         by    auto
     qed
   qed
 
 qed
 
 lemma indspace_sum_list_fddh: 
   "\<lbrakk> fhs \<noteq> []; set (map snd fhs) \<subseteq> H; f \<in> indV \<rbrakk>
         \<Longrightarrow> f (\<Sum>(a,h)\<leftarrow>fhs. a \<delta>\<delta> h) = (\<Sum>(a,h)\<leftarrow>fhs. f (a \<delta>\<delta> h))"
 proof (induct fhs rule: list_nonempty_induct)
   case (single fh) show ?case 
     using split_beta[of "\<lambda>a h. a \<delta>\<delta> h" fh] split_beta[of "\<lambda>a h. f (a \<delta>\<delta> h)" fh] by simp
 next
   case (cons fh fhs)
   hence prevcase: "snd fh \<in> H" "set (map snd fhs) \<subseteq> H" "f \<in> indV"
                   "f (\<Sum>(a,h)\<leftarrow>fhs. a \<delta>\<delta> h) = (\<Sum>(a,h)\<leftarrow>fhs. f (a \<delta>\<delta> h))"
     by auto
   have "f (\<Sum>(a,h)\<leftarrow>fh#fhs. a \<delta>\<delta> h)
               = f ((fst fh) \<delta>\<delta> (snd fh) + (\<Sum>ah\<leftarrow>fhs. case_prod (\<lambda>a h. a \<delta>\<delta> h) ah))"
     using split_beta[of "\<lambda>a h. a \<delta>\<delta> h" fh] by simp
   moreover from prevcase(1) FH have "(fst fh) \<delta>\<delta> (snd fh) \<in> FH"
     using Supgroup.RG_aezdeltafun_closed by fast
   moreover from prevcase(2) FH
     have  "(\<Sum>ah\<leftarrow>fhs. case_prod (\<lambda>a h. a \<delta>\<delta> h) ah) \<in> FH"
     using Supgroup.RG_aezdeltafun_closed
           Ring1.sum_list_closed[OF Ring1_FH, of "\<lambda>ah. case_prod (\<lambda>a h. a \<delta>\<delta> h) ah" fhs]
     by    fastforce
   ultimately have "f (\<Sum>(a,h)\<leftarrow>fh#fhs. a \<delta>\<delta> h)
                               = f ((fst fh) \<delta>\<delta> (snd fh)) + f (\<Sum>(a,h)\<leftarrow>fhs. a \<delta>\<delta> h)"
     using indV prevcase(3) BaseFGMod.indspaceD_add by simp
   with prevcase(4) show ?case using split_beta[of "\<lambda>a h. f (a \<delta>\<delta> h)" fh] by simp
 qed
 
 lemma induced_fsmult_conv_fsmult_1ddh :
   "f \<in> indV \<Longrightarrow> h \<in> H \<Longrightarrow> (r \<currency>\<currency> f) (1 \<delta>\<delta> h) = r \<sharp>\<cdot> (f (1 \<delta>\<delta> h))"
   using FH indV induced_smult.fsmultD Supgroup.RG_aezdeltafun_closed[of h "1::'f"]
         rrsmultD1 aezdeltafun_decomp'[of r h]
         aezdeltafun_decomp[of r h] Supgroup.RG_aezdeltafun_closed[of h "1::'f"]
         Group.zero_closed[OF GroupG]
         BaseFGMod.indspaceD_transform[of f G FH V 0 "(1::'f) \<delta>\<delta> h" r]
         BaseFGMod.fsmultD
   by    simp
 
 lemma indspace_el_eq_on_1ddh_imp_eq_on_rddh :
   assumes "HmodG \<subseteq> H" "H = (\<Union>h\<in>HmodG. G + {h})" "f \<in> indV" "f' \<in> indV" 
           "\<forall>h\<in>HmodG. f (1 \<delta>\<delta> h) = f' (1 \<delta>\<delta> h)" "h \<in> H"
   shows   "f (r \<delta>\<delta> h) = f' (r \<delta>\<delta> h)"
 proof-
   from assms(2,6) obtain h' where h': "h' \<in> HmodG" "h \<in> G + {h'}" by fast
   from h'(2) obtain g where g: "g \<in> G" "h = g + h'"
     using set_plus_def[of G] by auto
   from g(2) have "r \<delta>\<delta> h = r \<delta>\<delta> 0 * (1 \<delta>\<delta> (g+h'))"
     using aezdeltafun_decomp by simp
   moreover have "(1::'f) \<delta>\<delta> (g+h') = 1 \<delta>\<delta> g * (1 \<delta>\<delta> h')"
     using times_aezdeltafun_aezdeltafun[of "1::'f", THEN sym] by simp
   ultimately have "r \<delta>\<delta> h = r \<delta>\<delta> g * (1 \<delta>\<delta> h')"
     using aezdeltafun_decomp[of r g]
     by    (simp add: algebra_simps)
   with indV FH assms(1,3,4) g(1) h'(1)
     have  "f (r \<delta>\<delta> h) = r \<delta>\<delta> g \<cdot> f (1 \<delta>\<delta> h')" "f' (r \<delta>\<delta> h) = r \<delta>\<delta> g \<cdot> f' (1 \<delta>\<delta> h')"
     using Supgroup.RG_aezdeltafun_closed[of h' 1]
           BaseFGMod.indspaceD_transform[of f G FH V g "1 \<delta>\<delta> h'" r]
           BaseFGMod.indspaceD_transform[of f' G FH V g "1 \<delta>\<delta> h'" r]
     by    auto
   thus "f (r \<delta>\<delta> h) = f' (r \<delta>\<delta> h)" using h'(1) assms(5) by simp
 qed
 
 lemma indspace_el_eq :
   assumes "HmodG \<subseteq> H" "H = (\<Union>h\<in>HmodG. G + {h})" "f \<in> indV" "f' \<in> indV" 
           "\<forall>h\<in>HmodG. f (1 \<delta>\<delta> h) = f' (1 \<delta>\<delta> h)"
   shows   "f = f'"
 proof
   fix x show "f x = f' x"
   proof (cases "x = 0" "x \<in> FH" rule: conjcases)
     case BothTrue 
     hence "x = 0 \<delta>\<delta> 0" using zero_aezfun_transfer by simp
     with assms show ?thesis
       using indspace_el_eq_on_1ddh_imp_eq_on_rddh[of HmodG f f'] Supgroup.zero_closed
         by auto
   next
     case OneTrue with FH show ?thesis using Supgroup.RG_zero_closed by fast
   next
     case OtherTrue 
     with FH obtain rhs
       where rhs: "set (map snd rhs) \<subseteq> H" "x = (\<Sum>(r,h)\<leftarrow>rhs. r \<delta>\<delta> h)"
       using Supgroup.RG_el_decomp_aezdeltafun
       by    fast
     from OtherTrue rhs(2) have rhs_nnil: "rhs \<noteq> []" by auto
     with assms(3,4) rhs
       have  "f x = (\<Sum>(r,h)\<leftarrow>rhs. f (r \<delta>\<delta> h))" "f' x = (\<Sum>(r,h)\<leftarrow>rhs. f' (r \<delta>\<delta> h))"
       using indspace_sum_list_fddh
       by    auto
     moreover from rhs(1) assms have "\<forall>(r,h) \<in> set rhs. f (r \<delta>\<delta> h) = f' (r \<delta>\<delta> h)"
       using indspace_el_eq_on_1ddh_imp_eq_on_rddh[of HmodG f f'] by fastforce
     ultimately show ?thesis
       using sum_list_prod_cong[of rhs "\<lambda>r h. f (r \<delta>\<delta> h)"] by simp
   next
     case BothFalse
     with indV assms(3,4) show ?thesis
       using BaseFGMod.indspaceD_supp'[of f] BaseFGMod.indspaceD_supp'[of f']
       by    simp
   qed
 qed
 
 lemma indspace_el_eq' :
   assumes "set hs \<subseteq> H" "H = (\<Union>h\<in>set hs. G + {h})" "f \<in> indV" "f' \<in> indV"
           "\<forall>i<length hs. f (1 \<delta>\<delta> (hs!i)) = f' (1 \<delta>\<delta> (hs!i))"
   shows   "f = f'"
   using assms(1-4)
 proof (rule indspace_el_eq[of "set hs"])
   have "\<And>h. h\<in>set hs \<Longrightarrow> f (1 \<delta>\<delta> h) = f' (1 \<delta>\<delta> h)"
   proof-
     fix h assume "h \<in> set hs"
     from this obtain i where "i < length hs" "h = hs!i"
       using in_set_conv_nth[of h] by fast
     with assms(5) show "f (1 \<delta>\<delta> h) = f' (1 \<delta>\<delta> h)" by simp
   qed
   thus "\<forall>h\<in>set hs. f (1 \<delta>\<delta> h) = f' (1 \<delta>\<delta> h)" by fast
 qed
 
 end (* context InducedFHModule *)
 
 
 
 
 section \<open>Representations of Finite Groups\<close>
 
 subsection \<open>Locale and basic facts\<close>
 
 text \<open>
   Define a group representation to be a module over the group ring that is finite-dimensional as
   a vector space. The only restriction on the characteristic of the field is that it does not
   divide the order of the group. Also, we don't explicitly assume that the group is finite;
   instead, the \<open>good_char\<close> assumption implies that the cardinality of G is not zero, which
   implies G is finite. (See lemma \<open>good_card_imp_finite\<close>.)
 \<close>
 
 locale FinGroupRepresentation = FGModule G smult V
   for G     :: "'g::group_add set"
   and smult :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixl "\<cdot>" 70)
   and V     :: "'v set"
 +
   assumes good_char: "of_nat (card G) \<noteq> (0::'f)"
   and     findim   : "fscalar_mult.findim fsmult V"
 
 lemma (in Group) trivial_FinGroupRep :
   fixes   smult     :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v"
   assumes good_char  : "of_nat (card G) \<noteq> (0::'f)"
   and     smult_zero : "\<forall>a\<in>group_ring. smult a (0::'v) = 0"
   shows   "FinGroupRepresentation G smult (0::'v set)"
 proof (rule FinGroupRepresentation.intro)
   from smult_zero show "FGModule G smult (0::'v set)"
     using trivial_FGModule by fast
 
   have "fscalar_mult.findim (aezfun_scalar_mult.fsmult smult) 0"
     by auto (metis R_scalar_mult.RSpan.simps(1) aezfun_scalar_mult.R_scalar_mult empty_set empty_subsetI set_zero)
 
   with good_char show "FinGroupRepresentation_axioms G smult 0" by unfold_locales
 qed
 
 context FinGroupRepresentation
 begin
 
 abbreviation ordG :: 'f where "ordG \<equiv> of_nat (card G)"
 abbreviation "GRepHom \<equiv> FGModuleHom G smult V"
 abbreviation "GRepIso \<equiv> FGModuleIso G smult V"
 abbreviation "GRepEnd \<equiv> FGModuleEnd G smult V"
 
 lemmas zero_closed              = zero_closed
 lemmas Group                    = Group
 lemmas GSubmodule_GSpan_single  = RSubmodule_RSpan_single
 lemmas GSpan_single_nonzero     = RSpan_single_nonzero
 
 lemma finiteG: "finite G"
   using good_char good_card_imp_finite by fast
 
 lemma FinDimVectorSpace: "FinDimVectorSpace fsmult V"
   using findim fVectorSpace VectorSpace.FinDimVectorSpaceI by fast
 
 lemma GSubspace_is_FinGroupRep :
   assumes "GSubspace U"
   shows   "FinGroupRepresentation G smult U"
 proof (
   rule FinGroupRepresentation.intro, rule GSubspace_is_FGModule[OF assms], unfold_locales
 )
   from assms show "fscalar_mult.findim fsmult U"
     using FinDimVectorSpace GSubspace_is_Subspace FinDimVectorSpace.Subspace_is_findim
     by    fast
 qed (rule good_char)
 
 lemma isomorphic_imp_GRep :
   assumes "isomorphic smult' W"
   shows   "FinGroupRepresentation G smult' W"
 proof (rule FinGroupRepresentation.intro)
   from assms show "FGModule G smult' W"
     using FGModuleIso.ImG FGModuleHom.FGModule_Im[OF FGModuleIso.axioms(1)]
     by    fast
   from assms have "fscalar_mult.findim (aezfun_scalar_mult.fsmult smult') W"
     using FGModuleIso.ImG findim FGModuleIso.VectorSpaceHom
           VectorSpaceHom.findim_domain_findim_image
     by    fastforce
   with good_char show "FinGroupRepresentation_axioms G smult' W" by unfold_locales
 qed
 
 end (* context FinGroupRepresentation *)
 
 
 subsection \<open>Irreducible representations\<close>
 
 locale IrrFinGroupRepresentation = FinGroupRepresentation
 + assumes irr: "GSubspace U \<Longrightarrow> U = 0 \<or> U = V"
 begin
 
 lemmas AbGroup = AbGroup
 
 lemma zero_isomorphic_to_FG_zero :
   assumes "V = 0"
   shows   "isomorphic (*) (0::('b,'a) aezfun set)"
 proof
   show "GRepIso (*) 0 0"
   proof (rule FGModuleIso.intro)
     show "GRepHom (*) 0" using trivial_FGModuleHom[of "(*)"] by simp
     show "FGModuleIso_axioms V 0 0"
     proof
       from assms show "bij_betw 0 V 0" unfolding bij_betw_def inj_on_def by simp
     qed
   qed
 qed
 
 lemma eq_GSpan_single : "v \<in> V \<Longrightarrow> v \<noteq> 0 \<Longrightarrow> V = GSpan [v]"
   using irr RSubmodule_RSpan_single RSpan_single_nonzero by fast
 
 end (* context IrrFinGroupRepresentation *)
 
 lemma (in Group) trivial_IrrFinGroupRepI :
   fixes   smult :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v"
   assumes "of_nat (card G) \<noteq> (0::'f)"
   and     "\<forall>a\<in>group_ring. smult a (0::'v) = 0"
   shows   "IrrFinGroupRepresentation G smult (0::'v set)"
 proof (rule IrrFinGroupRepresentation.intro)
   from assms show "FinGroupRepresentation G smult 0"
     using trivial_FinGroupRep by fast
   show "IrrFinGroupRepresentation_axioms G smult 0"
     using RModule.zero_closed by unfold_locales auto
 qed
 
 lemma (in Group) trivial_IrrFinGroupRepresentation_in_FG :
   "of_nat (card G) \<noteq> (0::'f::field)
         \<Longrightarrow> IrrFinGroupRepresentation G (*) (0::('f,'g) aezfun set)"
   using trivial_IrrFinGroupRepI[of "(*)"] by simp
 
 context FinGroupRepresentation
 begin
 
 lemma IrrFinGroupRep_trivialGSubspace :
   "IrrFinGroupRepresentation G smult (0::'v set)"
 proof-
   have "ordG \<noteq> (0::'f)" using good_char by fast
   moreover have "\<forall>a\<in>FG. a \<cdot> 0 = 0" using smult_zero by simp
   ultimately show ?thesis
     using ActingGroup.trivial_IrrFinGroupRepI[of smult] by fast
 qed
 
 lemma IrrI :
   assumes "\<And>U. FGModule.GSubspace G smult V U \<Longrightarrow> U = 0 \<or> U = V"
   shows   "IrrFinGroupRepresentation G smult V"
   using assms IrrFinGroupRepresentation.intro by unfold_locales
 
 lemma notIrr :
   "\<not> IrrFinGroupRepresentation G smult V
         \<Longrightarrow> \<exists>U. GSubspace U \<and> U \<noteq> 0 \<and> U \<noteq> V"
   using IrrI by fast
 
 end (* context FinGroupRepresentation *)
 
 
 subsection \<open>Maschke's theorem\<close>
 
 subsubsection \<open>Averaged projection onto a G-subspace\<close>
 
 context FinGroupRepresentation
 begin
 
 lemma avg_proj_eq_id_on_right :
   assumes "VectorSpace fsmult W" "add_independentS [W,V]" "v \<in> V"
   defines P : "P \<equiv> (\<Oplus>[W,V]\<down>1)"
   defines CP: "CP \<equiv> (\<lambda>g. Gmult (- g) \<circ> P \<circ> Gmult g)"
   defines T : "T \<equiv> fsmult (1/ordG) \<circ> (\<Sum>g\<in>G. CP g)"
   shows   "T v = v"
 proof-
   from P assms(2,3) have "\<And>g. g \<in> G \<Longrightarrow> P (g *\<cdot> v) = g *\<cdot> v"
     using Gmult_closed VectorSpace.AbGroup[OF assms(1)] AbGroup 
           AbGroup_inner_dirsum_el_decomp_nth_id_on_nth[of "[W,V]"]
     by    simp
   with CP assms(3) have "\<And>g. g \<in> G \<Longrightarrow> CP g v = v"
     using Gmult_neg_left by simp
   with assms(3) good_char T show "T v = v"
     using finiteG sum_fun_apply[of G CP] sum_fsmult_distrib[of v G "\<lambda>x. 1"]
           fsmult_assoc[of _ ordG v]
     by    simp
 qed
 
 lemma avg_proj_onto_right :
   assumes "VectorSpace fsmult W" "GSubspace U" "add_independentS [W,U]"
           "V = W \<oplus> U"
   defines P : "P \<equiv> (\<Oplus>[W,U]\<down>1)"
   defines CP: "CP \<equiv> (\<lambda>g. Gmult (- g) \<circ> P \<circ> Gmult g)"
   defines T : "T \<equiv> fsmult (1/ordG) \<circ> (\<Sum>g\<in>G. CP g)"
   shows   "T ` V = U"
 proof
   from assms(2) have U: "FGModule G smult U"
     using GSubspace_is_FGModule by fast
   show "T ` V \<subseteq> U"
   proof (rule image_subsetI)
     fix v assume v: "v \<in> V"
     with assms(1,3,4) P U have "\<And>g. g \<in> G \<Longrightarrow> P (g *\<cdot> v) \<in> U"
       using Gmult_closed VectorSpace.AbGroup FGModule.AbGroup
             AbGroup_inner_dirsum_el_decomp_nth_onto_nth[of "[W,U]" 1]
       by    fastforce
     with U CP have "\<And>g. g \<in> G \<Longrightarrow> CP g v \<in> U"
       using FGModule.Gmult_closed GroupG Group.neg_closed by fastforce
     with assms(2) U T show "T v \<in> U"
       using finiteG FGModule.sum_closed[of G smult U G "\<lambda>g. CP g v"]
             sum_fun_apply[of G CP] FGModule.fsmult_closed[of G smult U]
       by    fastforce
   qed
   show "T ` V \<supseteq> U"
   proof
     fix u assume u: "u \<in> U"
     with u T CP P assms(1,2,3) have "T u = u"
       using GSubspace_is_FinGroupRep FinGroupRepresentation.avg_proj_eq_id_on_right
       by    fast
     from this[THEN sym] assms(1-4) u show "u \<in> T ` V"
       using Module.AbGroup RModule.AbGroup AbGroup_subset_inner_dirsum
       by    fast
   qed
 qed
 
 lemma FGModuleEnd_avg_proj_right :
   assumes "fSubspace W" "GSubspace U" "add_independentS [W,U]" "V = W \<oplus> U"
   defines P : "P \<equiv> (\<Oplus>[W,U]\<down>1)"
   defines CP: "CP \<equiv> (\<lambda>g. Gmult (- g) \<circ> P \<circ> Gmult g)"
   defines T : "T \<equiv> (fsmult (1/ordG) \<circ> (\<Sum>g\<in>G. CP g))\<down>V"
   shows   "FGModuleEnd G smult V T"
 proof (rule VecEnd_GMap_is_FGModuleEnd)
 
   from T have T_apply: "\<And>v. v\<in>V \<Longrightarrow> T v = (1/ordG) \<sharp>\<cdot> (\<Sum>g\<in>G. CP g v)"
     using finiteG sum_fun_apply[of G CP] by simp
 
   from assms(1-4) P have Pgv: "\<And>g v. g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> P ( g *\<cdot> v ) \<in> V"
     using Gmult_closed VectorSpace_fSubspace VectorSpace.AbGroup[of fsmult W]
           RModule.AbGroup[of FG smult U]
           GroupEnd_inner_dirsum_el_decomp_nth[of "[W,U]" 1]
           GroupEnd.endomorph[of V]
     by force
 
   have im_CP_V: "\<And>v. v \<in> V \<Longrightarrow> (\<lambda>g. CP g v) ` G \<subseteq> V"
   proof-
     fix v assume "v \<in> V" thus "(\<lambda>g. CP g v) ` G \<subseteq> V"
       using CP Pgv[of _ v] ActingGroup.neg_closed Gmult_closed finiteG by auto
   qed
 
   have sumCP_V: "\<And>v. v \<in> V \<Longrightarrow> (\<Sum>g\<in>G. CP g v) \<in> V"
     using finiteG im_CP_V sum_closed by force
 
   show "VectorSpaceEnd (\<sharp>\<cdot>) V T"
   proof (
     rule VectorSpaceEndI, rule VectorSpace.VectorSpaceHomI, rule fVectorSpace
   )
 
     show "GroupHom V T"
     proof
       fix v v' assume vv': "v \<in> V" "v' \<in> V"
       with T_apply have "T (v + v') = (1/ordG) \<sharp>\<cdot> (\<Sum>g\<in>G. CP g (v + v'))"
         using add_closed by fast
       moreover have "\<And>g. g \<in> G \<Longrightarrow> CP g (v + v') = CP g v + CP g v'"
       proof-
         fix g assume g: "g \<in> G"
         with CP P vv' assms(1-4)
           have  "CP g (v + v') = (- g) *\<cdot> ( P ( g *\<cdot> v ) + P ( g *\<cdot> v' ) )"
           using Gmult_distrib_left Gmult_closed VectorSpace_fSubspace
                 VectorSpace.AbGroup[of fsmult W] RModule.AbGroup[of FG smult U]
                 GroupEnd_inner_dirsum_el_decomp_nth[of "[W,U]" 1]
                 GroupEnd.hom[of V P]
           by    simp
         with g vv' have "CP g (v + v')
                               = (- g) *\<cdot> P ( g *\<cdot> v ) + (- g) *\<cdot> P ( g *\<cdot> v' )"
           using Pgv ActingGroup.neg_closed Gmult_distrib_left by simp
         thus "CP g (v + v') = CP g v + CP g v'" using CP by simp
       qed
       ultimately show "T (v + v') = T v + T v'"
         using vv' sumCP_V[of v] sumCP_V[of v'] sum.distrib[of "\<lambda>g. CP g v"]
               T_apply
         by    simp
     next
       from T show "supp T \<subseteq> V" using supp_restrict0 by fast
     qed
 
     show "\<And>a v. v \<in> V \<Longrightarrow> T (a \<sharp>\<cdot> v) = a \<sharp>\<cdot> T v"
     proof-
       fix a::'f and v assume v: "v \<in> V"
       with T_apply have "T (a \<sharp>\<cdot> v) = (1/ordG) \<sharp>\<cdot> (\<Sum>g\<in>G. CP g (a \<sharp>\<cdot> v))"
         using fsmult_closed by fast
       moreover have "\<And>g. g \<in> G \<Longrightarrow> CP g (a \<sharp>\<cdot> v) = a \<sharp>\<cdot> CP g v"
       proof-
         fix g assume "g \<in> G"
         with assms(1-4) CP P v show "CP g (a \<sharp>\<cdot> v) = a \<sharp>\<cdot> CP g v"
           using fsmult_Gmult_comm GSubspace_is_Subspace Gmult_closed fVectorSpace
                 VectorSpace.VectorSpaceEnd_inner_dirsum_el_decomp_nth[of fsmult]
                 VectorSpaceEnd.f_map[of fsmult "(\<Oplus>N\<leftarrow>[W, U]. N)" P a "g *\<cdot> v"]
                 ActingGroup.neg_closed Pgv
           by    simp
       qed
       ultimately show "T (a \<sharp>\<cdot> v) = a \<sharp>\<cdot> T v"
         using v im_CP_V sumCP_V T_apply finiteG
               fsmult_sum_distrib[of a G "\<lambda>g. CP g v"]
               fsmult_assoc[of "1/ordG" a "(\<Sum>g\<in>G. CP g v)"]
         by    simp
     qed
 
     show "T ` V \<subseteq> V" using sumCP_V fsmult_closed T_apply image_subsetI by auto
 
   qed
 
   show "\<And>g v. g \<in> G \<Longrightarrow> v \<in> V \<Longrightarrow> T (g *\<cdot> v) = g *\<cdot> T v"
   proof-
     fix g v assume g: "g \<in> G" and v: "v \<in> V"
     with T_apply have "T (g *\<cdot> v) = (1/ordG) \<sharp>\<cdot> (\<Sum>h\<in>G. CP h (g *\<cdot> v))"
       using Gmult_closed by fast
     with g have "T (g *\<cdot> v) = (1/ordG) \<sharp>\<cdot> (\<Sum>h\<in>G. CP (h + - g) (g *\<cdot> v))"
       using GroupG Group.neg_closed
             Group.right_translate_sum[of G "- g" "\<lambda>h. CP h (g *\<cdot> v)"]
       by    fastforce
     moreover from CP
       have  "\<And>h. h \<in> G \<Longrightarrow> CP (h + - g) (g *\<cdot> v) = g *\<cdot> CP h v"
       using g v Gmult_closed[of g v] ActingGroup.neg_closed
             Gmult_assoc[of _ "- g" "g *\<cdot> v", THEN sym]
             Gmult_neg_left minus_add[of _ "- g"] Pgv Gmult_assoc
       by    simp
     ultimately show "T (g *\<cdot> v) = g *\<cdot> T v"
       using g v GmultD finiteG FG_fddg_closed im_CP_V sumCP_V
             smult_sum_distrib[of "1 \<delta>\<delta> g" G]
             fsmult_Gmult_comm[of g "\<Sum>h\<in>G. (CP h v)"] T_apply
       by    simp
   qed
 
 qed
 
 lemma avg_proj_is_proj_right :
   assumes "VectorSpace fsmult W" "GSubspace U" "add_independentS [W,U]"
           "V = W \<oplus> U" "v \<in> V"
   defines P : "P \<equiv> (\<Oplus>[W,U]\<down>1)"
   defines CP: "CP \<equiv> (\<lambda>g. Gmult (- g) \<circ> P \<circ> Gmult g)"
   defines T : "T \<equiv> fsmult (1/ordG) \<circ> (\<Sum>g\<in>G. CP g)"
   shows   "T (T v) = T v"
   using   assms avg_proj_onto_right GSubspace_is_FinGroupRep
           FinGroupRepresentation.avg_proj_eq_id_on_right
   by      fast
 
 end (* context FinGroupRepresentation *)
 
 subsubsection \<open>The theorem\<close>
 
 context FinGroupRepresentation
 begin
 
 theorem Maschke :
   assumes "GSubspace U"
   shows   "\<exists>W. GSubspace W \<and> V = W \<oplus> U"
 proof (cases "V = 0")
   case True
   moreover from assms True have "U = 0" using RModule.zero_closed by auto
   ultimately have "V = 0 + U" using set_plus_def by fastforce
   moreover have "add_independentS [0,U]" by simp
   ultimately have "V = 0 \<oplus> U" using inner_dirsum_doubleI by fast
   moreover have "GSubspace 0" using trivial_RSubmodule zero_closed by auto
   ultimately show "\<exists>W. GSubspace W \<and> V = W \<oplus> U" by fast
 next
   case False
   from assms obtain W'
     where W': "VectorSpace.Subspace fsmult V W' \<and> V = W' \<oplus> U"
     using GSubspace_is_Subspace FinDimVectorSpace FinDimVectorSpace.semisimple
     by    force
   hence vsp_W': "VectorSpace fsmult W'" and dirsum: "V = W' \<oplus> U"
     using VectorSpace.SubspaceD1[OF fVectorSpace] by auto
   from False dirsum have indS: "add_independentS [W',U]"
     using inner_dirsumD2 by fastforce
   define P where "P  = (\<Oplus>[W',U]\<down>1)"
   define CP where "CP = (\<lambda>g. Gmult (- g) \<circ> P \<circ> Gmult g)"
   define S where "S = fsmult (1/ordG) \<circ> (\<Sum>g\<in>G. CP g)"
   define W where "W = GroupHom.Ker V (S\<down>V)"
   from assms W' indS S_def CP_def P_def have endo: "GRepEnd (S\<down>V)"
     using FGModuleEnd_avg_proj_right by fast
   moreover from S_def CP_def P_def have "\<And>v. v \<in> V \<Longrightarrow> (S\<down>V) ((S\<down>V) v) = (S\<down>V) v"
       using endo FGModuleEnd.endomorph
             avg_proj_is_proj_right[OF vsp_W' assms indS dirsum]
       by    fastforce
   moreover have "(S\<down>V) ` V = U"
   proof-
     from assms indS P_def CP_def S_def dirsum vsp_W' have "S ` V = U"
       using avg_proj_onto_right by fast
     moreover have "(S\<down>V) ` V = S ` V" by auto
     ultimately show ?thesis by fast
   qed
   ultimately have "V = W \<oplus> U" "GSubspace W"
     using W_def FGModuleEnd.proj_decomp[of G smult V "S\<down>V"]
           FGModuleEnd.GSubspace_Ker
     by    auto
   thus ?thesis by fast
 qed
 
 corollary Maschke_proper :
   assumes "GSubspace U" "U \<noteq> 0" "U \<noteq> V"
   shows   "\<exists>W. GSubspace W \<and> W \<noteq> 0 \<and> W \<noteq> V \<and> V = W \<oplus> U"
 proof-
   from assms(1) obtain W where W: "GSubspace W" "V = W \<oplus> U"
     using Maschke by fast
   from assms(3) W(2) have "W \<noteq> 0" using inner_dirsum_double_left0 by fast
   moreover from assms(1,2) W have "W \<noteq> V"
     using Subgroup_RSubmodule Group.nonempty
           inner_dirsum_double_leftfull_imp_right0[of W U]
     by    fastforce
   ultimately show ?thesis using W by fast
 qed
 
 end (* context FinGroupRepresentation *)
 
 subsubsection \<open>Consequence: complete reducibility\<close>
 
 lemma (in FinGroupRepresentation) notIrr_decompose :
   "\<not> IrrFinGroupRepresentation G smult V
         \<Longrightarrow> \<exists>U W. GSubspace U \<and> U \<noteq> 0 \<and> U \<noteq> V \<and> GSubspace W \<and> W \<noteq> 0
           \<and> W \<noteq> V \<and> V = U \<oplus> W"
   using notIrr Maschke_proper by blast
 
 text \<open>
   In the following decomposition lemma, we do not need to explicitly include the condition that all
   @{term U} in @{term "set Us"} are subsets of @{term V}. (See lemma \<open>AbGroup_subset_inner_dirsum\<close>.)
 \<close>
 
 lemma FinGroupRepresentation_reducible' :
   fixes n::nat
   shows "\<And>V. FinGroupRepresentation G fgsmult V
               \<and> n = FGModule.fdim fgsmult V
                 \<Longrightarrow> (\<exists>Us. Ball (set Us) (IrrFinGroupRepresentation G fgsmult)
                   \<and> (0 \<notin> set Us) \<and> V = (\<Oplus>U\<leftarrow>Us. U) )"
 proof (induct n rule: full_nat_induct)
   fix n V
   define GRep IGRep GSubspace GSpan fdim
     where "GRep = FinGroupRepresentation G fgsmult"
       and "IGRep = IrrFinGroupRepresentation G fgsmult"
       and "GSubspace = FGModule.GSubspace G fgsmult V"
       and "GSpan = FGModule.GSpan G fgsmult"
       and "fdim = FGModule.fdim fgsmult"
   assume "\<forall>m. Suc m \<le> n \<longrightarrow> (\<forall>x. GRep x \<and> m = fdim x \<longrightarrow> ( \<exists>Us.
               Ball (set Us) IGRep \<and> (0 \<notin> set Us) \<and> x = (\<Oplus>U\<leftarrow>Us. U)) )"
   hence prev_case:
     "\<And>m. m < n \<Longrightarrow> (\<And>W. GRep W \<Longrightarrow> m = fdim W \<Longrightarrow> ( \<exists>Us.
             Ball (set Us) IGRep \<and> (0 \<notin> set Us) \<and> W = (\<Oplus>U\<leftarrow>Us. U)))"
     using Suc_le_eq by auto
   show "GRep V \<and> n = fdim V \<Longrightarrow> ( \<exists>Us.
           Ball (set Us) IGRep \<and> (0 \<notin> set Us) \<and> V = (\<Oplus>U\<leftarrow>Us. U) )"
   proof-
     assume V: "GRep V \<and> n = fdim V"
     show "(\<exists>Us. Ball (set Us) IGRep \<and> (0 \<notin> set Us) \<and> V = (\<Oplus>U\<leftarrow>Us. U))"
     proof (cases "IGRep V" "V = 0" rule: conjcases)
       case BothTrue
       moreover have "Ball (set []) IGRep" "\<forall>U\<in>set []. U \<noteq> 0" by auto
       ultimately show ?thesis using inner_dirsum_Nil by fast
     next
       case OneTrue
       with V GRep_def obtain v where v: "v \<in> V" "v \<noteq> 0" 
         using FinGroupRepresentation.Group[of G fgsmult] Group.obtain_nonzero
         by    auto
       from v(1) V GRep_def GSpan_def GSubspace_def have GSub: "GSubspace (GSpan [v])"
         using FinGroupRepresentation.GSubmodule_GSpan_single by fast
       moreover from v V GRep_def GSpan_def have nzero: "GSpan [v] \<noteq> 0"
         using FinGroupRepresentation.GSpan_single_nonzero by fast
       ultimately have "V = GSpan [v]"
         using OneTrue GSpan_def GSubspace_def IGRep_def IrrFinGroupRepresentation.irr
         by    fast
       with OneTrue
         have  "Ball (set [GSpan [v]]) IGRep" "0 \<notin> set [GSpan [v]]"
               "V = (\<Oplus>U\<leftarrow>[GSpan [v]]. U)"
         using nzero GSub inner_dirsum_singleD
         by    auto
       thus ?thesis by fast
     next
       case OtherTrue with V GRep_def IGRep_def show ?thesis
         using FinGroupRepresentation.IrrFinGroupRep_trivialGSubspace by fast
     next
       case BothFalse
       with V GRep_def IGRep_def GSubspace_def obtain U W
         where U: "GSubspace U" "U \<noteq> 0" "U \<noteq> V"
         and   W: "GSubspace W" "W \<noteq> 0" "W \<noteq> V"
         and   Vdecompose: "V = U \<oplus> W"
         using FinGroupRepresentation.notIrr_decompose[of G fgsmult V]
         by    auto
       from U(1,3) W(1,3) V GRep_def GSubspace_def fdim_def
         have  "fdim U < fdim V" "fdim W < fdim V"
         using FinGroupRepresentation.axioms(1)
               FGModule.GSubspace_is_Subspace[of G fgsmult V U]
               FGModule.GSubspace_is_Subspace[of G fgsmult V W]
               FinGroupRepresentation.FinDimVectorSpace[of G fgsmult V]
               FinDimVectorSpace.Subspace_dim_lt[
                 of "aezfun_scalar_mult.fsmult fgsmult" V U
               ]
               FinDimVectorSpace.Subspace_dim_lt[
                 of "aezfun_scalar_mult.fsmult fgsmult" V W
               ]
         by    auto
       from this U(1) W(1) V GSubspace_def obtain Us Ws
         where "Ball (set Us) IGRep \<and> (0 \<notin> set Us) \<and> U = (\<Oplus>X\<leftarrow>Us. X)"
         and   "Ball (set Ws) IGRep \<and> (0 \<notin> set Ws) \<and> W = (\<Oplus>X\<leftarrow>Ws. X)"
         using prev_case[of "fdim U"] prev_case[of "fdim W"] GRep_def
               FinGroupRepresentation.GSubspace_is_FinGroupRep[
                 of G fgsmult V U
               ]
               FinGroupRepresentation.GSubspace_is_FinGroupRep[
                 of G fgsmult V W
               ]
         by    fastforce
       hence Us: "Ball (set Us) IGRep" "0 \<notin> set Us" "U = (\<Oplus>X\<leftarrow>Us. X)"
         and Ws: "Ball (set Ws) IGRep" "0 \<notin> set Ws" "W = (\<Oplus>X\<leftarrow>Ws. X)"
         by  auto
       from Us(1) Ws(1) have "Ball (set (Us@Ws)) IGRep" by auto
       moreover from Us(2) Ws(2) have "0 \<notin> set (Us@Ws)" by auto
       moreover have "V = (\<Oplus>X\<leftarrow>(Us@Ws). X)"
       proof-
         from U(2) Us(3) W(2) Ws(3)
           have  indUs: "add_independentS Us"
           and   indWs: "add_independentS Ws"
           using inner_dirsumD2
           by    auto
         moreover from IGRep_def Us(1) have "Ball (set Us) ((\<in>) 0)"
           using IrrFinGroupRepresentation.axioms(1)[of G fgsmult]
                 FinGroupRepresentation.zero_closed[of G fgsmult]
           by    fast
         moreover from Us(3) Ws(3) BothFalse Vdecompose indUs indWs
           have "add_independentS [(\<Sum>X\<leftarrow>Us. X),(\<Sum>X\<leftarrow>Ws. X)]"
           using inner_dirsumD2[of "[U,W]"] inner_dirsumD[of Us]
                 inner_dirsumD[of Ws]
           by    auto
         ultimately have "add_independentS (Us@Ws)"
           by (metis add_independentS_double_sum_conv_append) 
         moreover from W(1) Ws(3) indWs have "0 \<in> (\<Sum>X\<leftarrow>Ws. X)"
           using inner_dirsumD GSubspace_def RModule.zero_closed by fast
         ultimately show ?thesis
           using Vdecompose Us(3) Ws(3) inner_dirsum_append by fast
       qed
       ultimately show ?thesis by fast
     qed
   qed
 qed
 
 theorem (in FinGroupRepresentation) reducible :
   "\<exists>Us. (\<forall>U\<in>set Us. IrrFinGroupRepresentation G smult U) \<and> (0 \<notin> set Us) 
         \<and> V = (\<Oplus>U\<leftarrow>Us. U)"
   using FinGroupRepresentation_axioms FinGroupRepresentation_reducible' by fast
 
 subsubsection \<open>Consequence: decomposition relative to a homomomorphism\<close>
 
 lemma (in FinGroupRepresentation) GRepHom_decomp :
   fixes   T   :: "'v \<Rightarrow> 'w::ab_group_add"
   defines KerT : "KerT \<equiv> (ker T \<inter> V)"
   assumes hom  : "GRepHom smult' T" and nonzero: "V \<noteq> 0"
   shows   "\<exists>U. GSubspace U \<and> V = U \<oplus> KerT
                 \<and> FGModule.isomorphic G smult U smult' (T ` V)"
 proof-
   from KerT have KerT': "GSubspace KerT"
     using FGModuleHom.GSubspace_Ker[OF hom] by fast
   from this obtain U where U: "GSubspace U" "V = U \<oplus> KerT"
     using Maschke[of KerT] by fast
   from nonzero U(2) have indep: "add_independentS [U,KerT]"
     using inner_dirsumD2 by fastforce
   have "FGModuleIso G smult U smult' (T \<down> U) (T ` V)"
   proof (rule FGModuleIso.intro)
     from U(1) show "FGModuleHom G (\<cdot>) U smult' (T \<down> U)"
       using FGModuleHom.FGModuleHom_restrict0_GSubspace[OF hom] by fast
     show "FGModuleIso_axioms U (T \<down> U) (T ` V)"
       unfolding FGModuleIso_axioms_def bij_betw_def
     proof (rule conjI, rule inj_onI)
       show "(T \<down> U) ` U = T ` V"
       proof
         from U(1) show "(T \<down> U) ` U \<subseteq> T ` V" by auto
         show "(T \<down> U) ` U \<supseteq> T ` V"
         proof (rule image_subsetI)
           fix v assume "v \<in> V"
           with U(2) obtain u k where uk: "u \<in> U" "k \<in> KerT" "v = u + k"
             using inner_dirsum_doubleD[OF indep] set_plus_def[of U KerT] by fast
           with KerT U(1) have "T v = (T \<down> U) u"
             using kerD FGModuleHom.additive[OF hom] by force
           with uk(1) show "T v \<in> (T \<down> U) ` U" by fast
         qed
       qed
     next
       fix x y assume xy: "x \<in> U" "y \<in> U" "(T \<down> U) x = (T \<down> U) y"
       with U(1) KerT have "x - y \<in> U \<inter> KerT"
         using FGModuleHom.eq_im_imp_diff_in_Ker[OF hom]
               GSubspace_is_FGModule FGModule.diff_closed[of G smult U x y]
         by    auto
       moreover from U(1) have "AbGroup U" using RModule.AbGroup by fast
       moreover from KerT' have "AbGroup KerT"
         using RModule.AbGroup by fast
       ultimately show "x = y" 
         using indep AbGroup_inner_dirsum_pairwise_int0_double[of U KerT]
         by    force
     qed
   qed
   with U show ?thesis by fast
 qed
 
 
 subsection \<open>Schur's lemma\<close>
 
 lemma (in IrrFinGroupRepresentation) Schur_Ker :
   "GRepHom smult' T \<Longrightarrow> T ` V \<noteq> 0 \<Longrightarrow> inj_on T V"
   using irr FGModuleHom.GSubspace_Ker[of G smult V smult' T] 
         FGModuleHom.Ker_Im_iff[of G smult V smult' T]
         FGModuleHom.Ker0_imp_inj_on[of G smult V smult' T]
   by    auto
 
 lemma (in FinGroupRepresentation) Schur_Im :
   assumes "IrrFinGroupRepresentation G smult' W" "GRepHom smult' T"
           "T ` V \<subseteq> W"
           "T ` V \<noteq> 0"
   shows   "T ` V = W"
 proof-
   have "FGModule.GSubspace G smult' W (T ` V)"
   proof
     from assms(2) show "RModule FG smult' (T ` V)"
       using FGModuleHom.axioms(2)[of G]
             RModuleHom.RModule_Im[of FG smult V smult' T]
       by    fast
     from assms(3) show "T ` V \<subseteq> W" by fast
   qed
   with assms(1,4) show ?thesis using IrrFinGroupRepresentation.irr by fast
 qed
 
 theorem (in IrrFinGroupRepresentation) Schur1 :
   assumes   "IrrFinGroupRepresentation G smult' W" 
             "GRepHom smult' T" "T ` V \<subseteq> W" "T ` V \<noteq> 0"
   shows     "GRepIso smult' T W"
 proof (rule FGModuleIso.intro, rule assms(2), unfold_locales)
   show "bij_betw T V W"
     using     IrrFinGroupRepresentation_axioms assms
               IrrFinGroupRepresentation.axioms(1)[of G]
               FinGroupRepresentation.Schur_Im[of G]
               IrrFinGroupRepresentation.Schur_Ker[of G smult V smult' T]
     unfolding bij_betw_def
     by        fast
 qed
 
 theorem (in IrrFinGroupRepresentation) Schur2 :
   assumes GRep      : "GRepEnd T"
   and     fdim       : "fdim > 0"
   and     alg_closed: "\<And>p::'b poly. degree p > 0 \<Longrightarrow> \<exists>c. poly p c = 0"
   shows   "\<exists>c. \<forall>v \<in> V. T v = c \<sharp>\<cdot> v"
 proof-
   from fdim alg_closed obtain e u where eu: "u \<in> V" "u \<noteq> 0" "T u = e \<sharp>\<cdot> u"
     using FGModuleEnd.VectorSpaceEnd[OF GRep]
           FinDimVectorSpace.endomorph_has_eigenvector[
             OF FinDimVectorSpace, of T
           ]
     by    fast
   define U where "U = {v \<in> V. T v = e \<sharp>\<cdot> v}"
   moreover from eu U_def have "U \<noteq> 0" by auto
   ultimately have "\<forall>v \<in> V. T v = e \<sharp>\<cdot> v"
     using GRep irr FGModuleEnd.axioms(1)[of G smult V T]
           GSubspace_eigenspace[of G smult]
     by    fast
   thus ?thesis by fast
 qed
 
 
 subsection \<open>The group ring as a representation space\<close>
 
 subsubsection \<open>The group ring is a representation space\<close>
 
 lemma (in Group) FGModule_FG :
   defines FG: "FG \<equiv> group_ring :: ('f::field, 'g) aezfun set"
   shows   "FGModule G (*) FG"
 proof (rule FGModule.intro, rule Group_axioms, rule RModuleI)
   show 1: "Ring1 group_ring" using Ring1_RG by fast
   from 1 FG show "Group FG" using Ring1.axioms(1) by fast
   from 1 FG show "RModule_axioms group_ring (*) FG"
     using Ring1.mult_closed
     by    unfold_locales (auto simp add: algebra_simps)
 qed
 
 theorem (in Group) FinGroupRepresentation_FG :
   defines FG: "FG \<equiv> group_ring :: ('f::field, 'g) aezfun set"
   assumes good_char: "of_nat (card G) \<noteq> (0::'f)"
   shows   "FinGroupRepresentation G (*) FG"
 proof (rule FinGroupRepresentation.intro)
   from FG show "FGModule G (*) FG" using FGModule_FG by fast
   show "FinGroupRepresentation_axioms G (*) FG"
   proof
     from FG good_char obtain gs
       where gs: "set gs = G"
                 "\<forall>f\<in> FG. \<exists>bs. length bs = length gs
                       \<and> f = (\<Sum>(b,g)\<leftarrow>zip bs gs. (b \<delta>\<delta> 0) * (1 \<delta>\<delta> g))"
       using good_card_imp_finite FinGroupI FinGroup.group_ring_spanning_set
       by    fast
     define xs where "xs = map ((\<delta>\<delta>) (1::'f)) gs"
     with FG gs(1) have 1: "set xs \<subseteq> FG" using RG_aezdeltafun_closed by auto
     moreover have "aezfun_scalar_mult.fSpan (*) xs = FG"
     proof
       from 1 FG show "aezfun_scalar_mult.fSpan (*) xs \<subseteq> FG"
         using FGModule_FG FGModule.fSpan_closed by fast
       show "aezfun_scalar_mult.fSpan (*) xs \<supseteq> FG"
       proof
         fix x assume "x \<in> FG"
         from this gs(2) obtain bs
           where bs: "length bs = length gs"
                     "x = (\<Sum>(b,g)\<leftarrow>zip bs gs. (b \<delta>\<delta> 0) * (1 \<delta>\<delta> g))"
           by    fast
         from bs(2) xs_def have "x = (\<Sum>(b,a)\<leftarrow>zip bs xs. (b \<delta>\<delta> 0) * a)"
           using sum_list_prod_map2[THEN sym] by fast
         with bs(1) xs_def show "x \<in> aezfun_scalar_mult.fSpan (*) xs"
           using aezfun_scalar_mult.fsmultD[of "(*)", THEN sym]
                 sum_list_prod_cong[
                   of "zip bs xs" "\<lambda>b a. (b \<delta>\<delta> 0) * a"
                      "\<lambda>b a. aezfun_scalar_mult.fsmult (*) b a"
                 ]
                 scalar_mult.lincomb_def[of "aezfun_scalar_mult.fsmult (*)" bs xs]
                 scalar_mult.SpanD_lincomb[of "aezfun_scalar_mult.fsmult (*)"]
           by    force
       qed
     qed
     ultimately show "\<exists>xs. set xs \<subseteq> FG \<and> aezfun_scalar_mult.fSpan (*) xs = FG"
       by fast
   qed (rule good_char)
 qed
 
 lemma (in FinGroupRepresentation) FinGroupRepresentation_FG :
   "FinGroupRepresentation G (*) FG"
   using good_char ActingGroup.FinGroupRepresentation_FG by fast
 
 lemma (in Group) FG_reducible :
   assumes "of_nat (card G) \<noteq> (0::'f::field)"
   shows   "\<exists>Us::('f,'g) aezfun set list.
                 (\<forall>U\<in>set Us. IrrFinGroupRepresentation G (*) U) \<and> 0 \<notin> set Us
                   \<and> group_ring = (\<Oplus>U\<leftarrow>Us. U)"
   using   assms FinGroupRepresentation_FG FinGroupRepresentation.reducible
   by      fast
 
 subsubsection \<open>Irreducible representations are constituents of the group ring\<close>
 
 lemma (in FGModuleIso) isomorphic_to_irr_right :
   assumes "IrrFinGroupRepresentation G smult' W"
   shows   "IrrFinGroupRepresentation G smult V"
 proof (rule FinGroupRepresentation.IrrI)
   from assms show "FinGroupRepresentation G (\<cdot>) V"
     using IrrFinGroupRepresentation.axioms(1) isomorphic_sym
           FinGroupRepresentation.isomorphic_imp_GRep
     by    fast
   from assms show "\<And>U. GSubspace U \<Longrightarrow> U = 0 \<or> U = V"
     using IrrFinGroupRepresentation.irr isomorphic_to_irr_right' by fast
 qed
 
 lemma (in FinGroupRepresentation) IrrGSubspace_iso_constituent :
   assumes nonzero : "V \<noteq> 0"
   and     subsp   : "W \<subseteq> V" "W \<noteq> 0" "IrrFinGroupRepresentation G smult W"
   and     V_decomp: "\<forall>U\<in>set Us. IrrFinGroupRepresentation G smult U"
                     "0 \<notin> set Us" "V = (\<Oplus>U\<leftarrow>Us. U)"
   shows   "\<exists>U\<in>set Us. FGModule.isomorphic G smult W smult U"
 proof-
   from V_decomp(1) have abGrp: "\<forall>U\<in>set Us. AbGroup U"
     using IrrFinGroupRepresentation.AbGroup by fast
   from nonzero V_decomp(3) have indep: "add_independentS Us"
     using inner_dirsumD2 by fast
   with V_decomp (3) have "\<forall>U\<in>set Us. U \<subseteq> V"
     using abGrp AbGroup_subset_inner_dirsum by fast
   with subsp(1,3) V_decomp(1)
     have  GSubspaces: "GSubspace W" "\<forall>U\<in> set Us. GSubspace U"
     using IrrFinGroupRepresentation.axioms(1)[of G smult]
           FinGroupRepresentation.axioms(1)[of G smult] GSubspaceI
     by    auto
   have "\<And>i. i < length Us \<Longrightarrow> (\<Oplus>Us\<down>i) ` W \<noteq> 0
               \<Longrightarrow> FGModuleIso G smult W smult ( (\<Oplus>Us\<down>i) \<down> W ) (Us!i)"
   proof-
     fix i assume i: "i < length Us" "(\<Oplus>Us\<down>i) ` W \<noteq> 0"
     from i(1) V_decomp(3) have "GRepEnd (\<Oplus>Us\<down>i)"
       using GSubspaces(2) indep GEnd_inner_dirsum_el_decomp_nth by fast
     hence "FGModuleHom G smult W smult ( (\<Oplus>Us\<down>i) \<down> W )"
       using GSubspaces(1) FGModuleEnd.FGModuleHom_restrict0_GSubspace
       by    fast
     moreover have "( (\<Oplus>Us\<down>i) \<down> W ) ` W \<subseteq> Us!i"
     proof-
       from V_decomp(3) i(1) subsp(1,3) have "(\<Oplus>Us\<down>i) ` W \<subseteq> Us!i"
         using indep abGrp AbGroup_inner_dirsum_el_decomp_nth_onto_nth by fast
       thus ?thesis by auto
     qed
     moreover from i(1) V_decomp(1)
       have "IrrFinGroupRepresentation G smult (Us!i)"
       by   simp
     ultimately show "FGModuleIso G smult W smult ( (\<Oplus>Us\<down>i) \<down> W ) (Us!i)"
       using i(2)
             IrrFinGroupRepresentation.Schur1[
               OF subsp(3), of smult "Us!i" "(\<Oplus>Us\<down>i) \<down> W "
             ]
       by    auto
   qed
   moreover from nonzero V_decomp(3)
     have  "\<forall>i<length Us. (\<Oplus>Us\<down>i) ` W = 0 \<Longrightarrow> W = 0"
     using inner_dirsum_Nil abGrp subsp(1) indep
           AbGroup_inner_dirsum_subset_proj_eq_0[of Us W]
     by    fastforce
   ultimately have "\<exists>i<length Us.  FGModuleIso G smult W smult
                         ( (\<Oplus>Us\<down>i) \<down> W ) (Us!i)"
     using subsp(2) by auto
   thus ?thesis using set_conv_nth[of Us] by auto
 qed
 
 theorem (in IrrFinGroupRepresentation) iso_FG_constituent :
   assumes nonzero  : "V \<noteq> 0"
   and     FG_decomp: "\<forall>U\<in>set Us. IrrFinGroupRepresentation G (*) U"
                      "0 \<notin> set Us" "FG = (\<Oplus>U\<leftarrow>Us. U)"
   shows   "\<exists>U\<in>set Us. isomorphic (*) U"
 proof-
   from nonzero obtain v where v: "v \<in> V" "v \<noteq> 0" using nonempty by auto
   define T where "T = (\<lambda>x. x \<cdot> v)\<down>FG"
   have "FGModuleHom G (*) FG smult T"
   proof (rule FGModule.FGModuleHomI_fromaxioms)
     show "FGModule G (*) FG"
       using ActingGroup.FGModule_FG by fast
     from T_def v(1) show "\<And>v v'. v \<in> FG \<Longrightarrow> v' \<in> FG \<Longrightarrow> T (v + v') = T v + T v'"
       using Ring1.add_closed[OF Ring1] smult_distrib_right by auto
     from T_def show "supp T \<subseteq> FG" using supp_restrict0 by fast
     from T_def v(1) show "\<And>r m. r \<in> FG \<Longrightarrow> m \<in> FG \<Longrightarrow> T (r * m) = r \<cdot> T m"
       using ActingGroup.RG_mult_closed by auto
   qed
   then obtain W
     where W: "FGModule.GSubspace G (*) FG W" "FG = W \<oplus> (ker T \<inter> FG)"
              "FGModule.isomorphic G (*) W smult (T ` FG)"
     using FG_n0
           FinGroupRepresentation.GRepHom_decomp[
             OF FinGroupRepresentation_FG
           ]
     by    fast
   from T_def v have "T ` FG = V" using eq_GSpan_single RSpan_single by auto
   with W(3) have W': "FGModule.isomorphic G (*) W smult V" by fast
   with W(1) nonzero have "W \<noteq> 0"
     using FGModule.GSubspace_is_FGModule[OF ActingGroup.FGModule_FG]
           FGModule.isomorphic_to_zero_left
     by    fastforce
   moreover from W' have "IrrFinGroupRepresentation G (*) W"
     using IrrFinGroupRepresentation_axioms FGModuleIso.isomorphic_to_irr_right
     by    fast
   ultimately have "\<exists>U\<in>set Us. FGModule.isomorphic G (*) W (*) U"
     using FG_decomp W(1) good_char FG_n0
           FinGroupRepresentation.IrrGSubspace_iso_constituent[
             OF ActingGroup.FinGroupRepresentation_FG, of W
           ]
     by    simp
   with W(1) W' show ?thesis
     using FGModule.GSubspace_is_FGModule[OF ActingGroup.FGModule_FG]
           FGModule.isomorphic_sym[of G "(*)" W smult] isomorphic_trans
     by    fast
 qed
 
 
 subsection \<open>Isomorphism classes of irreducible representations\<close>
 
 text \<open>
   We have already demonstrated that the relation \<open>FGModule.isomorphic\<close> is reflexive
   (lemma \<open>FGModule.isomorphic_refl\<close>), symmetric (lemma \<open>FGModule.isomorphic_sym\<close>),
   and transitive (lemma \<open>FGModule.isomorphic_trans\<close>). In this section, we provide a finite
   set of representatives for the resulting isomorphism classes of irreducible representations.
 \<close>
 
 context Group
 begin
 
 primrec remisodups :: "('f::field,'g) aezfun set list \<Rightarrow> ('f,'g) aezfun set list" where
   "remisodups [] = []"
 | "remisodups (U # Us) = (if
         (\<exists>W\<in>set Us. FGModule.isomorphic G (*) U (*) W)
           then remisodups Us else U # remisodups Us)"
 
 lemma set_remisodups : "set (remisodups Us) \<subseteq> set Us"
   by (induct Us) auto
 
 lemma isodistinct_remisodups :
   "\<lbrakk> \<forall>U\<in>set Us. FGModule G (*) U; V \<in> set (remisodups Us);
         W \<in> set (remisodups Us); V \<noteq> W \<rbrakk>
           \<Longrightarrow> \<not> (FGModule.isomorphic G (*) V (*) W)"
 proof (induct Us arbitrary: V W)
   case (Cons U Us)
   show ?case
   proof (cases "\<exists>X\<in>set Us. FGModule.isomorphic G (*) U (*) X")
     case True with Cons show ?thesis by simp
   next
     case False show ?thesis
     proof (cases "V=U" "W=U" rule: conjcases)
       case BothTrue with Cons(5) show ?thesis by fast
     next
       case OneTrue with False Cons(4,5) show ?thesis
         using set_remisodups by auto
     next
       case OtherTrue with False Cons(2,3) show ?thesis
         using set_remisodups FGModule.isomorphic_sym[of G "(*)" V "(*)" W]
         by    fastforce
     next
       case BothFalse with Cons False show ?thesis by simp
     qed
   qed
 qed simp
 
 definition "FG_constituents \<equiv> SOME Us.
                   (\<forall>U\<in>set Us. IrrFinGroupRepresentation G (*) U)
                     \<and> 0 \<notin> set Us \<and> group_ring = (\<Oplus>U\<leftarrow>Us. U)"
 
 lemma FG_constituents_irr :
   "of_nat (card G) \<noteq> (0::'f::field)
         \<Longrightarrow> \<forall>U\<in>set (FG_constituents::('f,'g) aezfun set list). 
           IrrFinGroupRepresentation G (*) U"
   using someI_ex[OF FG_reducible] unfolding FG_constituents_def by fast
 
 lemma FG_consitutents_n0:
   "of_nat (card G) \<noteq> (0::'f::field)
         \<Longrightarrow> 0 \<notin> set (FG_constituents::('f,'g) aezfun set list)"
   using someI_ex[OF FG_reducible] unfolding FG_constituents_def by fast
 
 lemma FG_constituents_constituents :
   "of_nat (card G) \<noteq> (0::'f::field)
         \<Longrightarrow> (group_ring::('f,'g) aezfun set) = (\<Oplus>U\<leftarrow>FG_constituents. U)"
   using someI_ex[OF FG_reducible] unfolding FG_constituents_def by fast
 
 definition "GIrrRep_repset \<equiv> 0 \<union> set (remisodups FG_constituents)"
 
 lemma finite_GIrrRep_repset : "finite GIrrRep_repset"
   unfolding GIrrRep_repset_def by simp
 
 lemma all_irr_GIrrRep_repset :
   assumes "of_nat (card G) \<noteq> (0::'f::field)"
   shows "\<forall>U\<in>(GIrrRep_repset::('f,'g) aezfun set set).
               IrrFinGroupRepresentation G (*) U"
 proof
   fix U :: "('f,'g) aezfun set" assume "U \<in> GIrrRep_repset"
   with assms show "IrrFinGroupRepresentation G (*) U"
     using trivial_IrrFinGroupRepresentation_in_FG GIrrRep_repset_def
           set_remisodups FG_constituents_irr
     by    (cases "U = 0") auto
 qed
 
 lemma isodistinct_GIrrRep_repset :
   defines "GIRRS \<equiv> GIrrRep_repset :: ('f::field,'g) aezfun set set"
   assumes "of_nat (card G) \<noteq> (0::'f)" "V \<in> GIRRS" "W \<in> GIRRS" "V \<noteq> W"
   shows   "\<not> (FGModule.isomorphic G (*) V (*) W)"
 proof (cases "V = 0" "W = 0" rule: conjcases)
   case BothTrue with assms(5) show ?thesis by fast
 next
   case OneTrue with assms(1,2,4,5) show ?thesis
     using GIrrRep_repset_def set_remisodups FG_consitutents_n0
           trivial_FGModule[of "(*)"] FGModule.isomorphic_to_zero_left[of G "(*)"]
     by    fastforce
 next
   case OtherTrue
   moreover with assms(1,3) have "V \<in> set FG_constituents"
     using GIrrRep_repset_def set_remisodups by auto
   ultimately show ?thesis
     using assms(2) FG_consitutents_n0 FG_constituents_irr
           IrrFinGroupRepresentation.axioms(1)
           FinGroupRepresentation.axioms(1)
           FGModule.isomorphic_to_zero_right[of G "(*)" V "(*)"]
     by    fastforce
 next
   case BothFalse
   with assms(1,3,4) have "V \<in> set (remisodups FG_constituents)"
                          "W \<in> set (remisodups FG_constituents)"
     using GIrrRep_repset_def by auto
   with assms(2,5) show ?thesis
     using FG_constituents_irr IrrFinGroupRepresentation.axioms(1)
           FinGroupRepresentation.axioms(1) isodistinct_remisodups
     by    fastforce
 qed
 
 end (* context Group *)
 
 lemma (in FGModule) iso_in_list_imp_iso_in_remisodups :
   "\<exists>U\<in>set Us. isomorphic (*) U
         \<Longrightarrow> \<exists>U\<in>set (ActingGroup.remisodups Us). isomorphic (*) U"
 proof (induct Us)
   case (Cons U Us)
   from Cons(2) obtain W where W: "W \<in> set (U#Us)" "isomorphic (*) W"
     by fast
   show ?case
   proof (
     cases "W = U" "\<exists>X\<in>set Us. FGModule.isomorphic G (*) U (*) X"
     rule: conjcases
   )
     case BothTrue with W(2) Cons(1) show ?thesis
       using isomorphic_trans[of "(*)" W] by force
   next
     case OneTrue with W(2) show ?thesis by simp
   next
     case OtherTrue with Cons(1) W show ?thesis by auto
   next
     case BothFalse with Cons(1) W show ?thesis by auto
   qed
 qed simp
 
 lemma (in IrrFinGroupRepresentation) iso_to_GIrrRep_rep :
   "\<exists>U\<in>ActingGroup.GIrrRep_repset. isomorphic (*) U"
   using zero_isomorphic_to_FG_zero ActingGroup.GIrrRep_repset_def
         good_char ActingGroup.FG_constituents_irr
         ActingGroup.FG_consitutents_n0 ActingGroup.FG_constituents_constituents
         iso_FG_constituent iso_in_list_imp_iso_in_remisodups
         ActingGroup.GIrrRep_repset_def
   by    (cases "V = 0") auto
 
 theorem (in Group) iso_class_reps :
   defines "GIRRS \<equiv> GIrrRep_repset :: ('f::field,'g) aezfun set set"
   assumes "of_nat (card G) \<noteq> (0::'f)"
   shows "finite GIRRS"
         "\<forall>U\<in>GIRRS. IrrFinGroupRepresentation G (*) U"
         "\<And>U W. \<lbrakk> U \<in> GIRRS; W \<in> GIRRS; U \<noteq> W \<rbrakk>
               \<Longrightarrow> \<not> (FGModule.isomorphic G (*) U (*) W)"
         "\<And>fgsmult V. IrrFinGroupRepresentation G fgsmult V
               \<Longrightarrow> \<exists>U\<in>GIRRS. FGModule.isomorphic G fgsmult V (*) U"
   using assms finite_GIrrRep_repset all_irr_GIrrRep_repset
         isodistinct_GIrrRep_repset IrrFinGroupRepresentation.iso_to_GIrrRep_rep
   by    auto
 
 
 subsection \<open>Induced representations\<close>
 
 subsubsection \<open>Locale and basic facts\<close>
 
 locale InducedFinGroupRepresentation = Supgroup?: Group H
 + BaseRep?: FinGroupRepresentation G smult V
 + induced_smult?: aezfun_scalar_mult rrsmult
   for   H       :: "'g::group_add set"
   and   G       :: "'g set"
   and   smult   :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixl "\<cdot>" 70)
   and   V       :: "'v set"
   and   rrsmult :: "('f,'g) aezfun \<Rightarrow> (('f,'g) aezfun \<Rightarrow>'v)
                           \<Rightarrow> (('f,'g) aezfun \<Rightarrow>'v)" (infixl "\<currency>" 70)
 + fixes FH      :: "('f, 'g) aezfun set"
   and   indV    :: "(('f, 'g) aezfun \<Rightarrow> 'v) set"
   defines FH            : "FH \<equiv> Supgroup.group_ring"
   and     indV          : "indV \<equiv> BaseRep.indspace G FH V"
   assumes rrsmult       : "rrsmult = Ring1.rightreg_scalar_mult FH"
   and     good_ordSupgrp: "of_nat (card H) \<noteq> (0::'f)"  (* this implies H is finite *)
   and     Subgroup      : "Supgroup.Subgroup G"  (* G is a subgroup of H *)
 
 sublocale InducedFinGroupRepresentation < InducedFHModule 
   using FH indV rrsmult Subgroup by unfold_locales fast
 
 context InducedFinGroupRepresentation
 begin
 
 abbreviation ordH :: 'f where "ordH \<equiv> of_nat (card H)"
 abbreviation "is_Vfbasis \<equiv> fbasis_for V"
 abbreviation "GRepHomSet \<equiv> FGModuleHomSet G smult V"
 abbreviation "HRepHom    \<equiv> FGModuleHom H rrsmult indV"
 abbreviation "HRepHomSet \<equiv> FGModuleHomSet H rrsmult indV"
 
 lemma finiteSupgroup: "finite H"
   using good_ordSupgrp good_card_imp_finite by fast
 
 lemma FinGroupSupgroup : "FinGroup H"
   using finiteSupgroup Supgroup.FinGroupI by fast
 
 lemmas fVectorSpace          = fVectorSpace
 lemmas FinDimVectorSpace     = FinDimVectorSpace
 lemmas ex_rcoset_replist_hd0
               = FinGroup.ex_rcoset_replist_hd0[OF FinGroupSupgroup Subgroup]
 
 end (* context InducedFinGroupRepresentation *)
 
 subsubsection \<open>A basis for the induced space\<close>
 
 context InducedFinGroupRepresentation
 begin
 
 abbreviation "negHorbit_list \<equiv> induced_smult.negGorbit_list"
 
 lemmas ex_rcoset_replist
               = FinGroup.ex_rcoset_replist[OF FinGroupSupgroup Subgroup]
 lemmas length_negHorbit_list         = induced_smult.length_negGorbit_list
 lemmas length_negHorbit_list_sublist = induced_smult.length_negGorbit_list_sublist
 lemmas negHorbit_list_indV           = FGModule.negGorbit_list_V[OF FHModule_indspace]
 
 lemma flincomb_Horbit_induced_veclist_reduce :
   fixes   vs         :: "'v list"
   and     hs         :: "'g list"
   defines hfvss       : "hfvss \<equiv> negHorbit_list hs induced_vector vs"
   assumes vs          : "set vs \<subseteq> V" and i: "i < length hs"
   and     scalars     : "list_all2 (\<lambda>rs ms. length rs = length ms) css hfvss"
   and     rcoset_reps : "Supgroup.is_rcoset_replist G hs"
   shows   "((concat css) \<bullet>\<currency>\<currency> (concat hfvss)) (1 \<delta>\<delta> (hs!i)) = (css!i) \<bullet>\<sharp>\<cdot> vs"
 proof-
   have mostly_zero:
     "\<And>k j. k < length hs \<Longrightarrow> j < length hs 
           \<Longrightarrow> ((css!j) \<bullet>\<currency>\<currency> (hfvss!j)) (1 \<delta>\<delta> hs!k)
             = (if j = k then (css!k) \<bullet>\<sharp>\<cdot> vs else 0)"
   proof-
     fix k j assume k: "k < length hs" and j: "j < length hs"
     hence hsk_H: "hs!k \<in> H" and hsj_H: "hs!j \<in> H"
       using Supgroup.is_rcoset_replistD_set[OF rcoset_reps] by auto
     define LHS where "LHS = ((css!j) \<bullet>\<currency>\<currency> (hfvss!j)) (1 \<delta>\<delta> hs!k)"
     with hfvss
       have "LHS = (\<Sum>(r,m)\<leftarrow>zip (css!j) (hfvss!j). (r \<currency>\<currency> m) (1 \<delta>\<delta> hs!k))"
       using length_negHorbit_list scalar_mult.lincomb_def[of induced_smult.fsmult]
             sum_list_prod_fun_apply
       by    simp
     moreover have "\<forall>(r,m) \<in> set (zip (css!j) (hfvss!j)).
                         (induced_smult.fsmult r m) (1 \<delta>\<delta> hs!k) = r \<sharp>\<cdot> m (1 \<delta>\<delta> hs!k)"
     proof (rule prod_ballI)
       fix r m assume "(r,m) \<in> set (zip (css!j) (hfvss!j))"
       with k j vs hfvss
         show "(induced_smult.fsmult r m) (1 \<delta>\<delta> hs!k) = r \<sharp>\<cdot> m (1 \<delta>\<delta> hs!k)"
         using Supgroup.is_rcoset_replistD_set[OF rcoset_reps] set_zip_rightD
               set_concat length_negHorbit_list[of hs induced_vector vs]
               nth_mem[of j hfvss] hsk_H induced_fsmult_conv_fsmult_1ddh[of m "hs!k" r]
               induced_vector_indV negHorbit_list_indV[of hs induced_vector vs]
         by    force
     qed
     ultimately have
       "LHS = (\<Sum>(r,v)\<leftarrow>zip (css!j) vs.
             r \<sharp>\<cdot> (induced_vector v) (1 \<delta>\<delta> hs!k * (1 \<delta>\<delta> - hs!j)))"
       using FH j hfvss induced_smult.negGorbit_list_def[of hs induced_vector vs]
             sum_list_prod_cong[of _ "\<lambda>r m. (induced_smult.fsmult r m) (1 \<delta>\<delta> hs!k)"]
             sum_list_prod_map2[of
               "\<lambda>r m. r \<sharp>\<cdot> m (1 \<delta>\<delta> hs!k)" _ "Hmult (- hs!j)" "map induced_vector vs"
             ]
             sum_list_prod_map2[of "\<lambda>r v. r \<sharp>\<cdot> (Hmult (-hs!j) v) (1 \<delta>\<delta> hs!k)"]
             induced_smult.GmultD hsk_H
             Supgroup.RG_aezdeltafun_closed[of "hs!k" "1::'f"]
             rrsmultD1[of "1 \<delta>\<delta> (hs!k)"]
       by    force
     moreover have "(1::'f) \<delta>\<delta> hs!k * (1 \<delta>\<delta> - hs!j) = 1 \<delta>\<delta> (hs!k - hs!j)"
       using times_aezdeltafun_aezdeltafun[of "1::'f" "hs!k" 1 "-(hs!j)"]
       by (simp add: algebra_simps)
     ultimately have "LHS = (\<Sum>(r,v)\<leftarrow>zip (css!j) vs.
                           r \<sharp>\<cdot> (induced_vector v) (1 \<delta>\<delta> (hs!k - hs!j)))"
       using sum_list_prod_map2 by simp
     moreover from FH vs
       have "\<forall>(r,v) \<in> set (zip (css!j) vs). r \<sharp>\<cdot> (induced_vector v) (1 \<delta>\<delta> (hs!k - hs!j))
                   = r \<sharp>\<cdot> (FG_proj (1 \<delta>\<delta> (hs!k - hs!j)) \<cdot> v)"
       using set_zip_rightD induced_vector_def hsk_H hsj_H Supgroup.diff_closed
             Supgroup.RG_aezdeltafun_closed[of _ "1::'f"]
       by    fastforce
     ultimately have calc: "LHS = (\<Sum>(r,v)\<leftarrow>zip (css!j) vs.
                                 r \<sharp>\<cdot> (FG_proj (1 \<delta>\<delta> (hs!k - hs!j)) \<cdot> v) )"
       using sum_list_prod_cong by force
     show "LHS = (if j = k then (css!k) \<bullet>\<sharp>\<cdot> vs else 0)"
     proof (cases "j = k")
       case True
       with calc have "LHS = (\<Sum>(r,v)\<leftarrow>zip (css!k) vs. r \<sharp>\<cdot> 1 \<sharp>\<cdot> v)"
         using Group.zero_closed[OF GroupG]
               aezfun_setspan_proj_aezdeltafun[of G "1::'f"]
               BaseRep.fsmult_def
         by    simp
       moreover from vs have "\<forall>(r,v) \<in> set (zip (css!k) vs). r \<sharp>\<cdot> 1 \<sharp>\<cdot> v = r \<sharp>\<cdot> v"
         using set_zip_rightD BaseRep.fsmult_assoc by fastforce
       ultimately show ?thesis
         using True sum_list_prod_cong[of _ "\<lambda>r v. r \<sharp>\<cdot> 1 \<sharp>\<cdot> v"]
               scalar_mult.lincomb_def[of BaseRep.fsmult]
         by    simp
     next
       case False
       with k j calc have "LHS = (\<Sum>(r,v)\<leftarrow>zip (css!j) vs. r \<sharp>\<cdot> (0 \<cdot> v))"
         using Supgroup.is_rcoset_replist_imp_nrelated_nth[OF Subgroup rcoset_reps]
               aezfun_setspan_proj_aezdeltafun[of G "1::'f"]
         by    simp
       moreover from vs have "\<forall>(r,v) \<in> set (zip (css!j) vs). r \<sharp>\<cdot> (0 \<cdot> v) = 0"
         using set_zip_rightD BaseRep.zero_smult by fastforce
       ultimately have "LHS = (\<Sum>(r,v)\<leftarrow>zip (css!j) vs. (0::'v))"
         using sum_list_prod_cong[of _ "\<lambda>r v. r \<sharp>\<cdot> (0 \<cdot> v)"] by simp
       hence "LHS = (\<Sum>rv\<leftarrow>zip (css!j) vs. case_prod (\<lambda>r v. (0::'v)) rv)" by fastforce
       with False show ?thesis by simp
     qed
   qed
 
   define terms LHS
     where "terms = map (\<lambda>a. case_prod (\<lambda>cs hfvs. (cs \<bullet>\<currency>\<currency> hfvs) (1 \<delta>\<delta> hs!i)) a) (zip css hfvss)"
       and "LHS = ((concat css) \<bullet>\<currency>\<currency> (concat hfvss)) (1 \<delta>\<delta> (hs!i))"
   hence "LHS = sum_list terms"
     using scalars
           VectorSpace.lincomb_concat[OF fVectorSpace_indspace, of css hfvss]
           sum_list_prod_fun_apply
     by    simp
   hence "LHS = (\<Sum>j\<in>{0..<length terms}. terms!j)"
     using sum_list_sum_nth[of terms] by simp
   moreover from terms_def
     have "\<forall>j\<in>{0..<length terms}. terms!j = ((css!j) \<bullet>\<currency>\<currency> (hfvss!j)) (1 \<delta>\<delta> hs!i)"
     by   simp
   ultimately show "LHS = (css!i) \<bullet>\<sharp>\<cdot> vs"
     using terms_def sum.cong scalars list_all2_lengthD[of _ css hfvss] hfvss 
           length_negHorbit_list[of hs induced_vector vs] i mostly_zero
           sum_single_nonzero[
             of "{0..<length hs}" "\<lambda>i j. ((css!j) \<bullet>\<currency>\<currency> (hfvss!j)) (1 \<delta>\<delta> (hs!i))"
                "\<lambda>i. (css!i) \<bullet>\<sharp>\<cdot> vs"
           ]
     by    simp
 
 qed
 
 lemma indspace_fspanning_set :
   fixes   vs         :: "'v list"
   and     hs         :: "'g list"
   defines hfvss       : "hfvss \<equiv> negHorbit_list hs induced_vector vs"
   assumes base_spset  : "set vs \<subseteq> V" "V = BaseRep.fSpan vs"
   and     rcoset_reps : "Supgroup.is_rcoset_replist G hs"
   shows   "indV = induced_smult.fSpan (concat hfvss)"
 proof (rule VectorSpace.SpanI[OF fVectorSpace_indspace])
   from base_spset(1) hfvss show "set (concat hfvss) \<subseteq> indV"
     using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
           induced_vector_indV negHorbit_list_indV
     by    fast
   show "indV \<subseteq> R_scalar_mult.RSpan UNIV (aezfun_scalar_mult.fsmult (\<currency>))
               (concat hfvss)"
   proof
 
     fix f assume f: "f \<in> indV"
     hence "\<forall>h \<in> set hs. f (1 \<delta>\<delta> h) \<in> V"
       using indV BaseRep.indspaceD_range by fast
     with base_spset(2)
       have  coeffs_exist: "\<forall>h \<in> set hs. \<exists>ahs. length ahs = length vs
                                 \<and> f (1 \<delta>\<delta> h) = ahs \<bullet>\<sharp>\<cdot> vs"
       using BaseRep.in_fSpan_obtain_same_length_coeffs
       by    fast
     define f_coeffs
       where "f_coeffs h = (SOME ahs. length ahs = length vs \<and> f (1 \<delta>\<delta> h) = ahs \<bullet>\<sharp>\<cdot> vs)" for h
     define ahss where "ahss = map f_coeffs hs"
     hence len_ahss: "length ahss = length hs" by simp
     with hfvss have len_zip_ahss_hfvss: "length (zip ahss hfvss) = length hs"
       using length_negHorbit_list[of hs induced_vector vs] by simp
     have len_ahss_el: "\<forall>ahs\<in>set ahss. length ahs = length vs"
     proof
       fix ahs assume "ahs \<in> set ahss"
       from this ahss_def obtain h where h: "h \<in> set hs" "ahs = f_coeffs h"
         using set_map by auto
       from h(1) have "\<exists>ahs. length ahs = length vs \<and> f (1 \<delta>\<delta> h) = ahs \<bullet>\<sharp>\<cdot> vs"
         using coeffs_exist by fast
       with h(2) show "length ahs = length vs"
         unfolding f_coeffs_def
         using someI_ex[of "\<lambda>ahs. length ahs = length vs \<and> f (1 \<delta>\<delta> h) = ahs \<bullet>\<sharp>\<cdot> vs"]
         by    fast
     qed
     have "\<forall>(ahs,hfvs)\<in>set (zip ahss hfvss). length ahs = length hfvs"
     proof
       fix x assume x: "x \<in> set (zip ahss hfvss)"
       show "case x of (ahs, hfvs) \<Rightarrow> length ahs = length hfvs"
       proof
         fix ahs hfvs assume "x = (ahs,hfvs)"
         with x hfvss have "length ahs = length vs" "length hfvs = length vs"
           using set_zip_leftD[of ahs hfvs] len_ahss_el set_zip_rightD[of ahs hfvs]
                 length_negHorbit_list_sublist[of _ hs induced_vector]
           by    auto
         thus "length ahs = length hfvs" by simp
       qed
     qed
     with hfvss have list_all2_len_ahss_hfvss:
       "list_all2 (\<lambda>rs ms. length rs = length ms) ahss hfvss"
       using len_ahss length_negHorbit_list[of hs induced_vector vs]
             list_all2I[of ahss hfvss]
       by    auto
 
     define f' where "f' = (concat ahss) \<bullet>\<currency>\<currency> (concat hfvss)"
     have "f = f'"
       using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
             Supgroup.group_eq_subgrp_rcoset_un[OF Subgroup rcoset_reps]
             f
     proof (rule indspace_el_eq'[of hs])
       from f'_def hfvss base_spset(1) show "f' \<in> indV"
         using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
               induced_vector_indV negHorbit_list_indV[of hs induced_vector vs]
               FGModule.flincomb_closed[OF FHModule_indspace]
         by    fast
       have "\<And>i. i<length hs \<Longrightarrow> f (1 \<delta>\<delta> (hs!i)) = f' (1 \<delta>\<delta> (hs!i))"
       proof-
         fix i assume i: "i < length hs"
         with f_coeffs_def have "f (1 \<delta>\<delta> (hs!i)) = (f_coeffs (hs!i)) \<bullet>\<sharp>\<cdot> vs"
           using coeffs_exist
                 someI_ex[of "\<lambda>ahs. length ahs = length vs \<and> f (1 \<delta>\<delta> hs!i) = ahs \<bullet>\<sharp>\<cdot> vs"]
           by    auto
         moreover from i hfvss f'_def base_spset(1) rcoset_reps ahss_def
           have  "f' (1 \<delta>\<delta> (hs!i)) = (f_coeffs (hs!i)) \<bullet>\<sharp>\<cdot> vs"
           using list_all2_len_ahss_hfvss flincomb_Horbit_induced_veclist_reduce
           by    simp
         ultimately show "f (1 \<delta>\<delta> (hs!i)) = f' (1 \<delta>\<delta> (hs!i))" by simp
       qed
       thus "\<forall>i<length hs. f (1 \<delta>\<delta> (hs!i)) = f' (1 \<delta>\<delta> (hs!i))" by fast
     qed
     with f'_def hfvss base_spset(1) show "f \<in> induced_smult.fSpan (concat hfvss)"
       using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
             induced_vector_indV negHorbit_list_indV[of hs induced_vector vs]
             VectorSpace.SpanI_lincomb_arb_len_coeffs[OF fVectorSpace_indspace]
       by    fast
   
   qed
 qed
 
 lemma indspace_basis :
   fixes   vs         :: "'v list"
   and     hs         :: "'g list"
   defines hfvss       : "hfvss \<equiv> negHorbit_list hs induced_vector vs"
   assumes base_spset  : "BaseRep.fbasis_for V vs"
   and     rcoset_reps : "Supgroup.is_rcoset_replist G hs"
   shows   "fscalar_mult.basis_for induced_smult.fsmult indV (concat hfvss)"
 proof-
   from assms
     have  1: "set (concat hfvss) \<subseteq> indV"
       and    "indV = induced_smult.fSpan (concat hfvss)"
     using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
           induced_vector_indV negHorbit_list_indV[of hs induced_vector vs]
           indspace_fspanning_set[of vs hs]
     by    auto
   moreover have "induced_smult.f_lin_independent (concat hfvss)"
   proof (
     rule VectorSpace.lin_independentI_concat_all_scalars[OF fVectorSpace_indspace],
     rule 1
   )
     fix rss
     assume rss: "list_all2 (\<lambda>xs ys. length xs = length ys) rss hfvss"
                 "(concat rss) \<bullet>\<currency>\<currency> (concat hfvss) = 0"
     from rss(1) have len_rss_hfvsss: "length rss = length hfvss"
       using list_all2_lengthD by fast
     with hfvss have len_rss_hs: "length rss = length hs"
       using length_negHorbit_list by fastforce
     show "\<forall>rs\<in>set rss. set rs \<subseteq> 0"
     proof
       fix rs assume "rs \<in> set rss"
       from this obtain i where i: "i < length rss" "rs = rss!i"
         using in_set_conv_nth[of rs] by fast
       with hfvss rss(1) have "length rs = length vs"
         using list_all2_nthD len_rss_hfvsss in_set_conv_nth[of _ hfvss]
               length_negHorbit_list_sublist
         by    fastforce
       moreover from hfvss rss i base_spset(1) rcoset_reps have "rs \<bullet>\<sharp>\<cdot> vs = 0"
         using len_rss_hs flincomb_Horbit_induced_veclist_reduce by force
       ultimately show "set rs \<subseteq> 0"
         using base_spset flin_independentD_all_scalars by force
     qed
   qed
   ultimately show ?thesis by fast
 qed
 
 lemma induced_vector_decomp :
   fixes   vs         :: "'v list"
   and     hs         :: "'g list"
   and     cs         :: "'f list"
   defines hfvss       : "hfvss \<equiv> negHorbit_list (0#hs) induced_vector vs"
   and     extrazeros  : "extrazeros \<equiv> replicate ((length hs)*(length vs)) 0"
   assumes base_spset  : "BaseRep.fbasis_for V vs"
   and     rcoset_reps : "Supgroup.is_rcoset_replist G (0#hs)"
   and     cs          : "length cs = length vs"
   and     v           : "v = cs \<bullet>\<sharp>\<cdot> vs"
   shows   "induced_vector v = (cs@extrazeros) \<bullet>\<currency>\<currency> (concat hfvss)"
 proof-
   from hfvss base_spset
     have  "hfvss = (map induced_vector vs) # (negHorbit_list hs induced_vector vs)"
     using induced_vector_indV
           FGModule.negGorbit_list_Cons0[OF FHModule_indspace]
     by    fastforce
   with cs extrazeros base_spset rcoset_reps v
     show  "induced_vector v = (cs@extrazeros) \<bullet>\<currency>\<currency> (concat hfvss)"
     using scalar_mult.lincomb_append[of cs _ induced_smult.fsmult]
           Supgroup.is_rcoset_replistD_set induced_vector_indV
           negHorbit_list_indV[of hs induced_vector vs]
           VectorSpace.lincomb_replicate0_left[OF fVectorSpace_indspace]
           FGModuleHom.VectorSpaceHom[OF hom_induced_vector]
           VectorSpaceHom.distrib_lincomb
     by    fastforce
 qed
 
 end (* context InducedFinGroupRepresentation *)
 
 subsubsection \<open>The induced space is a representation space\<close>
 
 context InducedFinGroupRepresentation
 begin
 
 lemma indspace_findim :
   "fscalar_mult.findim induced_smult.fsmult indV"
 proof-
   from BaseRep.findim obtain vs where vs: "set vs \<subseteq> V" "V = BaseRep.fSpan vs"
     by fast
   obtain hs where hs: "Supgroup.is_rcoset_replist G hs"
     using ex_rcoset_replist by fast
   define hfvss where "hfvss = negHorbit_list hs induced_vector vs"
   with vs hs
     have  "set (concat hfvss) \<subseteq> indV" "indV = induced_smult.fSpan (concat hfvss)"
     using Supgroup.is_rcoset_replistD_set[OF hs] induced_vector_indV
           negHorbit_list_indV[of hs induced_vector vs] indspace_fspanning_set
     by    auto
   thus ?thesis by fast
 qed
 
 theorem FinGroupRepresentation_indspace :
   "FinGroupRepresentation H rrsmult indV"
   using FHModule_indspace
 proof (rule FinGroupRepresentation.intro)
   from good_ordSupgrp show "FinGroupRepresentation_axioms H (\<currency>) indV" 
     using indspace_findim by unfold_locales fast
 qed
 
 end (* context InducedFinGroupRepresentation *)
 
 
 subsection \<open>Frobenius reciprocity\<close>
 
 subsubsection \<open>Locale and basic facts\<close>
 
 text \<open>There are a number of defined objects and lemmas concerning those objects leading up to the
         theorem of Frobenius reciprocity, so we create a locale to contain it all.\<close>
 
 locale FrobeniusReciprocity
 = GRep?: InducedFinGroupRepresentation H G smult V rrsmult
 + HRep?: FinGroupRepresentation H smult' W
   for H       :: "'g::group_add set"
   and G       :: "'g set"
   and smult   :: "('f::field, 'g) aezfun \<Rightarrow> 'v::ab_group_add \<Rightarrow> 'v" (infixl "\<cdot>" 70)
   and V       :: "'v set"
   and rrsmult :: "('f,'g) aezfun \<Rightarrow> (('f,'g) aezfun \<Rightarrow> 'v)
                         \<Rightarrow> (('f,'g) aezfun \<Rightarrow> 'v)" (infixl "\<currency>" 70)
   and smult'  :: "('f, 'g) aezfun \<Rightarrow> 'w::ab_group_add \<Rightarrow> 'w" (infixr "\<star>" 70)
   and W       :: "'w set"
 begin
 
 abbreviation fsmult'   :: "'f \<Rightarrow> 'w \<Rightarrow> 'w"           (infixr "\<sharp>\<star>" 70)
   where "fsmult' \<equiv> HRep.fsmult"
 abbreviation flincomb' :: "'f list \<Rightarrow> 'w list \<Rightarrow> 'w" (infixr "\<bullet>\<sharp>\<star>" 70) 
   where "flincomb' \<equiv> HRep.flincomb"
 abbreviation Hmult'    :: "'g \<Rightarrow> 'w \<Rightarrow> 'w"           (infixr "*\<star>" 70)
   where "Hmult' \<equiv> HRep.Gmult"
 
 definition Tsmult1 :: 
   "'f \<Rightarrow> ((('f, 'g) aezfun \<Rightarrow> 'v)\<Rightarrow>'w) \<Rightarrow> ((('f, 'g) aezfun \<Rightarrow> 'v)\<Rightarrow>'w)" (infixr "\<star>\<currency>" 70)
   where "Tsmult1 \<equiv> \<lambda>a T. \<lambda>f. a \<sharp>\<star> (T f)"
 
 definition Tsmult2 :: "'f \<Rightarrow> ('v\<Rightarrow>'w) \<Rightarrow> ('v\<Rightarrow>'w)" (infixr "\<star>\<cdot>" 70) 
   where "Tsmult2 \<equiv> \<lambda>a T. \<lambda>v. a \<sharp>\<star> (T v)"
 
 lemma FHModuleW : "FGModule H (\<star>) W" ..
 
 lemma FGModuleW: "FGModule G smult' W"
  using FHModuleW Subgroup HRep.restriction_to_subgroup_is_module
  by    fast
 
 text \<open>
   In order to build an inverse for the required isomorphism of Hom-sets, we will need a basis for
   the induced @{term H}-space.
 \<close>
 
 definition Vfbasis :: "'v list" where "Vfbasis \<equiv> (SOME vs. is_Vfbasis vs)"
 
 lemma Vfbasis : "is_Vfbasis Vfbasis"
   using Vfbasis_def FinDimVectorSpace.basis_ex[OF GRep.FinDimVectorSpace] someI_ex
   by    simp
 
 lemma Vfbasis_V : "set Vfbasis \<subseteq> V"
   using Vfbasis by fast
 
 definition nonzero_H_rcoset_reps :: "'g list"
   where "nonzero_H_rcoset_reps \<equiv> (SOME hs. Group.is_rcoset_replist H G (0#hs))"
 
 definition H_rcoset_reps :: "'g list" where "H_rcoset_reps \<equiv> 0 # nonzero_H_rcoset_reps"
 
 lemma H_rcoset_reps : "Group.is_rcoset_replist H G H_rcoset_reps"
   using H_rcoset_reps_def nonzero_H_rcoset_reps_def GRep.ex_rcoset_replist_hd0 someI_ex
   by    simp
 
 lemma H_rcoset_reps_H : "set H_rcoset_reps \<subseteq> H"
   using H_rcoset_reps Group.is_rcoset_replistD_set[OF HRep.GroupG] by fast
 
 lemma nonzero_H_rcoset_reps_H : "set nonzero_H_rcoset_reps \<subseteq> H"
   using H_rcoset_reps_H H_rcoset_reps_def by simp
 
 abbreviation negHorbit_homVfbasis :: "('v \<Rightarrow> 'w) \<Rightarrow> 'w list list"
   where "negHorbit_homVfbasis T \<equiv> HRep.negGorbit_list H_rcoset_reps T Vfbasis"
 
 lemma negHorbit_Hom_indVfbasis_W :
   "T ` V \<subseteq> W \<Longrightarrow> set (concat (negHorbit_homVfbasis T)) \<subseteq> W"
   using H_rcoset_reps_H Vfbasis_V
         HRep.negGorbit_list_V[of H_rcoset_reps T Vfbasis]
   by    fast
 
 lemma negHorbit_HomSet_indVfbasis_W :  
   "T \<in> GRepHomSet smult' W \<Longrightarrow> set (concat (negHorbit_homVfbasis T)) \<subseteq> W"
   using FGModuleHomSetD_Im negHorbit_Hom_indVfbasis_W by fast
 
 definition indVfbasis :: "(('f, 'g) aezfun \<Rightarrow> 'v) list list"
   where "indVfbasis \<equiv> GRep.negHorbit_list H_rcoset_reps induced_vector Vfbasis"
 
 lemma indVfbasis :
   "fscalar_mult.basis_for induced_smult.fsmult indV (concat indVfbasis)"
   using Vfbasis H_rcoset_reps indVfbasis_def indspace_basis[of Vfbasis H_rcoset_reps]
   by    auto
 
 lemma indVfbasis_indV : "hfvs \<in> set indVfbasis \<Longrightarrow> set hfvs \<subseteq> indV"
   using indVfbasis by auto
 
 end (* context FrobeniusReciprocity *)
 
 subsubsection \<open>The required isomorphism of Hom-sets\<close>
 
 context FrobeniusReciprocity
 begin
 
 text \<open>The following function will demonstrate the required isomorphism of Hom-sets (as vector
         spaces).\<close>
 
 definition \<phi> :: "((('f, 'g) aezfun \<Rightarrow> 'v) \<Rightarrow> 'w) \<Rightarrow> ('v \<Rightarrow> 'w)"
   where "\<phi> \<equiv> restrict0 (\<lambda>T. T \<circ> GRep.induced_vector) (HRepHomSet smult' W)"
 
 lemma \<phi>_im : "\<phi> ` HRepHomSet (\<star>) W \<subseteq> GRepHomSet (\<star>) W"
 proof (rule image_subsetI)
 
   fix T assume T: "T \<in> HRepHomSet (\<star>) W"
   show "\<phi> T \<in> GRepHomSet (\<star>) W"
   proof (rule FGModuleHomSetI)
 
     from T have "FGModuleHom G rrsmult indV smult' T"
       using FGModuleHomSetD_FGModuleHom GRep.Subgroup
             FGModuleHom.restriction_to_subgroup_is_hom
       by    fast
     thus "BaseRep.GRepHom (\<star>) (\<phi> T)"
       using T \<phi>_def GRep.hom_induced_vector GRep.induced_vector_indV
             FGModuleHom.FGModHom_composite_left
       by    fastforce
 
       show "\<phi> T ` V \<subseteq> W"
         using T \<phi>_def GRep.induced_vector_indV FGModuleHomSetD_Im by fastforce
 
   qed
 
 qed
 
 end (* context FrobeniusReciprocity *)
 
 subsubsection \<open>The inverse map of Hom-sets\<close>
 
 text \<open>In this section we build an inverse for the required isomorphism, @{term "\<phi>"}.\<close>
 
 context FrobeniusReciprocity
 begin
 
 definition \<psi>_condition :: "('v \<Rightarrow> 'w) \<Rightarrow> ((('f, 'g) aezfun \<Rightarrow> 'v) \<Rightarrow> 'w) \<Rightarrow> bool"
   where "\<psi>_condition T S
               \<equiv> VectorSpaceHom induced_smult.fsmult indV fsmult' S 
                 \<and> map (map S) indVfbasis = negHorbit_homVfbasis T"
 
 lemma inverse_im_exists' :
   assumes "T \<in> GRepHomSet (\<star>) W"
   shows   "\<exists>! S. VectorSpaceHom induced_smult.fsmult indV fsmult' S
                 \<and> map S (concat indVfbasis) = concat (negHorbit_homVfbasis T)"
 proof (
   rule VectorSpace.basis_im_defines_hom, rule fVectorSpace_indspace,
   rule HRep.fVectorSpace, rule indVfbasis
 )
   from  assms show "set (concat (negHorbit_homVfbasis T)) \<subseteq> W"
     using negHorbit_HomSet_indVfbasis_W by fast
   show  "length (concat (negHorbit_homVfbasis T)) = length (concat indVfbasis)"
     using length_concat_negGorbit_list indVfbasis_def
           induced_smult.length_concat_negGorbit_list[of H_rcoset_reps induced_vector]
     by    simp
 qed
 
 lemma inverse_im_exists :
   assumes "T \<in> GRepHomSet (\<star>) W"
   shows   "\<exists>! S. \<psi>_condition T S"
 proof-
   have "\<exists> S. \<psi>_condition T S"
   proof-
     from assms obtain S
       where S: "VectorSpaceHom induced_smult.fsmult indV fsmult' S" 
                "map S (concat indVfbasis) = concat (negHorbit_homVfbasis T)"
       using inverse_im_exists'
       by    fast
     from S(2) have "concat (map (map S) indVfbasis)
                           = concat (negHorbit_homVfbasis T)"
       using map_concat[of S] by simp
     moreover have "list_all2 (\<lambda>xs ys. length xs = length ys)
                         (map (map S) indVfbasis) (negHorbit_homVfbasis T)"
     proof (rule iffD2[OF list_all2_iff], rule conjI)
       show "length (map (map S) indVfbasis) = length (negHorbit_homVfbasis T)"
         using indVfbasis_def induced_smult.length_negGorbit_list
               HRep.length_negGorbit_list[of H_rcoset_reps T]
         by    auto
       show "\<forall>(xs,ys)\<in>set (zip (map (map S) indVfbasis)
                   (negHorbit_homVfbasis T)). length xs = length ys"
       proof (rule prod_ballI)
         fix xs ys
         assume xsys: "(xs,ys) \<in> set (zip (map (map S) indVfbasis)
                             (negHorbit_homVfbasis T))"
         from this obtain zs where zs: "zs \<in> set indVfbasis" "xs = map S zs"
           using set_zip_leftD by fastforce
         with xsys show "length xs = length ys"
           using indVfbasis_def set_zip_rightD[of xs ys]
                 HRep.length_negGorbit_list_sublist[of ys H_rcoset_reps T Vfbasis]
                 induced_smult.length_negGorbit_list_sublist
           by    simp
       qed
     qed
     ultimately have "map (map S) indVfbasis = negHorbit_homVfbasis T"
       using concat_eq[of "map (map S) indVfbasis"] by fast
     with S(1) show ?thesis using \<psi>_condition_def by fast
   qed
   moreover have "\<And>S U. \<psi>_condition T S \<Longrightarrow> \<psi>_condition T U \<Longrightarrow> S = U"
   proof-
     fix S U assume "\<psi>_condition T S" "\<psi>_condition T U"
     hence "VectorSpaceHom induced_smult.fsmult indV fsmult' S"
           "map S (concat indVfbasis) = concat (negHorbit_homVfbasis T)"
           "VectorSpaceHom induced_smult.fsmult indV fsmult' U"
           "map U (concat indVfbasis) = concat (negHorbit_homVfbasis T)"
       using \<psi>_condition_def map_concat[of S] map_concat[of U] by auto
     with assms show "S = U" using inverse_im_exists' by fast
   qed
   ultimately show ?thesis by fast
 qed
 
 definition \<psi> :: "('v \<Rightarrow> 'w) \<Rightarrow> ((('f, 'g) aezfun \<Rightarrow> 'v) \<Rightarrow> 'w)"
   where "\<psi> \<equiv> restrict0 (\<lambda>T. THE S. \<psi>_condition T S) (GRepHomSet (\<star>) W)"
 
 lemma \<psi>D : "T \<in> GRepHomSet (\<star>) W \<Longrightarrow> \<psi>_condition T (\<psi> T)"
   using \<psi>_def inverse_im_exists[of T] theI'[of "\<lambda>S. \<psi>_condition T S"] by simp
 
 lemma \<psi>D_VectorSpaceHom :
   "T \<in> GRepHomSet (\<star>) W
         \<Longrightarrow> VectorSpaceHom induced_smult.fsmult indV fsmult' (\<psi> T)"
   using \<psi>D \<psi>_condition_def by fast
 
 lemma \<psi>D_im :
   "T \<in> GRepHomSet (\<star>) W \<Longrightarrow> map (map (\<psi> T)) indVfbasis
         = aezfun_scalar_mult.negGorbit_list (\<star>) H_rcoset_reps T Vfbasis"
   using \<psi>D \<psi>_condition_def by fast
 
 lemma \<psi>D_im_single :
   assumes "T \<in> GRepHomSet (\<star>) W" "h \<in> set H_rcoset_reps" "v \<in> set Vfbasis"
   shows   "\<psi> T ((- h) *\<currency> (induced_vector v)) = (-h) *\<star> (T v)"
 proof-
   from assms(2,3) obtain i j
     where i: "i < length H_rcoset_reps" "h = H_rcoset_reps!i"
     and   j: "j < length Vfbasis" "v = Vfbasis!j"
     using set_conv_nth[of H_rcoset_reps] set_conv_nth[of Vfbasis] by auto
   moreover
     hence "map (map (\<psi> T)) indVfbasis !i !j = \<psi> T ((-h) *\<currency> (induced_vector v))"
     using indVfbasis_def
           aezfun_scalar_mult.length_negGorbit_list[
             of rrsmult H_rcoset_reps induced_vector
           ]
           aezfun_scalar_mult.negGorbit_list_nth[
             of i H_rcoset_reps rrsmult induced_vector
           ]
     by    auto
   ultimately show ?thesis
     using assms(1) HRep.negGorbit_list_nth[of i H_rcoset_reps T] \<psi>D_im by simp
 qed
 
 lemma \<psi>T_W :
   assumes "T \<in> GRepHomSet (\<star>) W"
   shows   "\<psi> T ` indV \<subseteq> W"
 proof (rule image_subsetI)
   from assms have T: "VectorSpaceHom induced_smult.fsmult indV fsmult' (\<psi> T)"
     using \<psi>D_VectorSpaceHom by fast
   fix f assume "f \<in> indV"
   from this obtain cs 
     where cs:"length cs = length (concat indVfbasis)" "f = cs \<bullet>\<currency>\<currency> (concat indVfbasis)"
     using indVfbasis scalar_mult.in_Span_obtain_same_length_coeffs
     by    fast
   from cs(1) obtain css
     where css: "cs = concat css" "list_all2 (\<lambda>xs ys. length xs = length ys) css indVfbasis"
     using match_concat
     by    fast
   from assms cs(2) css
     have "\<psi> T f = \<psi> T (\<Sum>(cs,hfvs)\<leftarrow>zip css indVfbasis. cs \<bullet>\<currency>\<currency> hfvs)"
     using VectorSpace.lincomb_concat[OF fVectorSpace_indspace] by simp
   also have "\<dots> = (\<Sum>(cs,hfvs)\<leftarrow>zip css indVfbasis. \<psi> T  (cs \<bullet>\<currency>\<currency> hfvs))"
     using set_zip_rightD[of _ _ css indVfbasis] indVfbasis_indV
           VectorSpace.lincomb_closed[OF GRep.fVectorSpace_indspace]
           VectorSpaceHom.im_sum_list_prod[OF T]
     by    force
   finally have "\<psi> T f = (\<Sum>(cs,\<psi>Thfvs)\<leftarrow>zip css (map (map (\<psi> T)) indVfbasis).
                       cs \<bullet>\<sharp>\<star> \<psi>Thfvs)"
     using set_zip_rightD[of _ _ css indVfbasis] indVfbasis_indV
           VectorSpaceHom.distrib_lincomb[OF T] 
           sum_list_prod_cong[of
             "zip css indVfbasis" "\<lambda>cs hfvs. \<psi> T (cs \<bullet>\<currency>\<currency> hfvs)" 
             "\<lambda>cs hfvs. cs \<bullet>\<sharp>\<star> (map (\<psi> T) hfvs)"
           ]
           sum_list_prod_map2[of "\<lambda>cs \<psi>Thfvs. cs \<bullet>\<sharp>\<star> \<psi>Thfvs" css "map (\<psi> T)"]
     by    fastforce
   moreover from css(2)
     have "list_all2 (\<lambda>xs ys. length xs = length ys) css (map (map (\<psi> T)) indVfbasis)"
     using list_all2_iff[of _ css indVfbasis] set_zip_map2
           list_all2_iff[of _ css "map (map (\<psi> T)) indVfbasis"]
     by    force
   ultimately have "\<psi> T f = (concat css) \<bullet>\<sharp>\<star> (concat (negHorbit_homVfbasis T))"
     using HRep.flincomb_concat map_concat[of "\<psi> T"] \<psi>D_im[OF assms]
     by    simp
   thus "\<psi> T f \<in> W"
     using assms negHorbit_HomSet_indVfbasis_W HRep.flincomb_closed by simp
 qed
 
 lemma \<psi>T_Hmap_on_indVfbasis :
   assumes "T \<in> GRepHomSet (\<star>) W"
   shows   "\<And>x f. x \<in> H \<Longrightarrow> f \<in> set (concat indVfbasis)
                 \<Longrightarrow> \<psi> T (x *\<currency> f) = x *\<star> (\<psi> T f)"
 proof-
   fix x f assume x: "x \<in> H" and f: "f \<in> set (concat indVfbasis)"
   from f obtain i where i: "i < length indVfbasis" "f \<in> set (indVfbasis!i)"
     using set_concat set_conv_nth[of indVfbasis] by auto
   from i(1) have i': "i < length H_rcoset_reps"
     using indVfbasis_def
           aezfun_scalar_mult.length_negGorbit_list[
             of rrsmult H_rcoset_reps induced_vector
           ]
     by    simp
   define hi where "hi = H_rcoset_reps!i"
   with i' have hi_H: "hi \<in> H" using set_conv_nth H_rcoset_reps_H by fast
   from hi_def i(2) have "f \<in> set (map (Hmult (-hi) \<circ> induced_vector) Vfbasis)"
     using indVfbasis_def i'
           aezfun_scalar_mult.negGorbit_list_nth[
             of i H_rcoset_reps rrsmult induced_vector
           ]
     by    simp
   from this obtain v where v: "v \<in> set Vfbasis" "f = (-hi) *\<currency> (induced_vector v)"
     by auto
   from v(1) have v_V: "v \<in> V" and Tv_W: "T v \<in> W"
     using Vfbasis_V FGModuleHomSetD_Im[OF assms] by auto
   from x have "hi - x \<in> H" using hi_H Supgroup.diff_closed by fast
   from this obtain j
     where j: "j < length H_rcoset_reps" "hi - x \<in> G + {H_rcoset_reps!j}"
     using set_conv_nth[of H_rcoset_reps] H_rcoset_reps
           Group.group_eq_subgrp_rcoset_un[OF HRep.GroupG Subgroup H_rcoset_reps]
     by    force
   from j(1) have j': "j < length indVfbasis"
     using indVfbasis_def
           aezfun_scalar_mult.length_negGorbit_list[
             of rrsmult H_rcoset_reps induced_vector
           ]
     by    simp
   define hj where "hj = H_rcoset_reps!j"
   with j(1) have hj_H: "hj \<in> H" using set_conv_nth H_rcoset_reps_H by fast
   from hj_def j(2) obtain g where g: "g \<in> G" "hi - x = g + hj"
     unfolding set_plus_def by fast
   from g(2) have x_hi: "x - hi = - hj + - g"
     using minus_diff_eq[of hi x] minus_add[of g] by simp
   from g(1) have "-g *\<cdot> v \<in> V"
     using v_V ActingGroup.neg_closed BaseRep.Gmult_closed by fast
   from this obtain cs
     where cs: "length cs = length Vfbasis" "-g *\<cdot> v = cs \<bullet>\<sharp>\<cdot> Vfbasis"
     using Vfbasis
           VectorSpace.in_Span_obtain_same_length_coeffs[OF GRep.fVectorSpace]
     by    fast
 
   from v(2) x have "\<psi> T (x *\<currency> f) = \<psi> T ((x-hi) *\<currency> (induced_vector v))"
     using hi_H Supgroup.neg_closed v_V induced_vector_indV
           FGModule.Gmult_assoc[OF GRep.FHModule_indspace]
     by    (simp add: algebra_simps)
   also from g(1) have "\<dots> = \<psi> T ((-hj) *\<currency> (induced_vector (-g *\<cdot> v)))"
     using x_hi hj_H Subgroup Supgroup.neg_closed v_V induced_vector_indV
           FGModule.Gmult_assoc[OF GRep.FHModule_indspace]
           ActingGroup.neg_closed
           FGModuleHom.G_map[OF hom_induced_vector]
     by    auto
   also from cs(2) hj_def j(1) have "\<dots> = \<psi> T (cs \<bullet>\<currency>\<currency> (indVfbasis!j))"
     using hj_H Vfbasis_V FGModuleHom.distrib_flincomb[OF hom_induced_vector]
           indVfbasis_def Supgroup.neg_closed[of hj] induced_vector_indV
           FGModule.Gmult_flincomb_comm[
             OF GRep.FHModule_indspace,
             of "-hj" "map induced_vector Vfbasis"
           ]
           aezfun_scalar_mult.negGorbit_list_nth[
             of j H_rcoset_reps rrsmult induced_vector
           ]
     by    fastforce
   also have "\<dots> = cs \<bullet>\<sharp>\<star> ((map (map (\<psi> T)) indVfbasis)!j)"
     using \<psi>D_VectorSpaceHom[OF assms] indVfbasis_indV j' set_conv_nth
           VectorSpaceHom.distrib_lincomb[of induced_smult.fsmult indV fsmult']
     by    simp
   also from j(1) hj_def have "\<dots> = (- hj) *\<star> cs \<bullet>\<sharp>\<star> (map T Vfbasis)"
     using \<psi>D_im[OF assms]
           aezfun_scalar_mult.negGorbit_list_nth[of j H_rcoset_reps smult' T] hj_H
           Group.neg_closed[OF HRep.GroupG]
           Vfbasis_V FGModuleHomSetD_Im[OF assms]
           HRep.Gmult_flincomb_comm[of "- hj" "map T Vfbasis"]
     by    fastforce
   also from cs(2) g(1) have "\<dots> = (- hj) *\<star> (-g) *\<star> (T v)"
     using v_V FGModuleHomSetD_FGModuleHom[OF assms] Vfbasis_V
           FGModuleHom.distrib_flincomb[of G smult V smult']
           ActingGroup.neg_closed
           FGModuleHom.G_map[of G smult V smult' T "-g" v]
     by    auto
   also from g(1) v(1) have "\<dots> = (x - hi) *\<star> (T v)"
     using FGModuleHomSetD_FGModuleHom[OF assms] Vfbasis_V Supgroup.neg_closed
           hj_H Subgroup FGModuleHomSetD_Im[OF assms]
           HRep.Gmult_assoc[of "-hj" "-g" "T v"] x_hi
     by    auto
   also from x(1) have "\<dots> = x *\<star> (- hi) *\<star> (T v)"
     using hi_H Supgroup.neg_closed Tv_W HRep.Gmult_assoc
     by    (simp add: algebra_simps)
   finally show "\<psi> T (x *\<currency> f) = x *\<star> (\<psi> T f)"
     using assms(1) v hi_def i' set_conv_nth[of H_rcoset_reps] \<psi>D_im_single by fastforce
 qed
 
 lemma \<psi>T_hom :
   assumes "T \<in> GRepHomSet (\<star>) W"
   shows   "HRepHom (\<star>) (\<psi> T)"
   using indVfbasis \<psi>D_VectorSpaceHom[OF assms] FHModuleW
 proof (
   rule FGModule.VecHom_GMap_on_fbasis_is_FGModuleHom[
     OF GRep.FHModule_indspace
   ]
 )
   show "\<psi> T ` indV \<subseteq> W" using indVfbasis \<psi>T_W[OF assms] by fast
   show "\<And>g v. g \<in> H \<Longrightarrow> v \<in> set (concat indVfbasis)
               \<Longrightarrow> \<psi> T (g *\<currency> v) = g *\<star> \<psi> T v"
     using \<psi>T_Hmap_on_indVfbasis[OF assms] by fast
 qed
 
 lemma \<psi>_im : "\<psi> ` GRepHomSet (\<star>) W \<subseteq> HRepHomSet (\<star>) W"
   using \<psi>T_W \<psi>T_hom FGModuleHomSetI by fastforce
 
 end (* context FrobeniusReciprocity *)
 
 subsubsection \<open>Demonstration of bijectivity\<close>
 
 text \<open>Now we demonstrate that @{term "\<phi>"} is bijective via the inverse @{term "\<psi>"}.\<close>
 
 context FrobeniusReciprocity
 begin
 
 lemma \<phi>\<psi> :
   assumes "T \<in> GRepHomSet smult' W"
   shows   "(\<phi> \<circ> \<psi>) T = T"
 proof
   fix v show "(\<phi> \<circ> \<psi>) T v = T v"
   proof (cases "v \<in> V")
     case True
     from this obtain cs where cs: "length cs = length Vfbasis" "v = cs \<bullet>\<sharp>\<cdot> Vfbasis"
       using Vfbasis
             VectorSpace.in_Span_obtain_same_length_coeffs[OF GRep.fVectorSpace]
       by    fast
     define extrazeros
       where "extrazeros = replicate ((length nonzero_H_rcoset_reps)*(length Vfbasis)) (0::'f)"
     with cs have "GRep.induced_vector v = (cs@extrazeros) \<bullet>\<currency>\<currency> (concat indVfbasis)"
       using     H_rcoset_reps induced_vector_decomp[OF Vfbasis]
       unfolding H_rcoset_reps_def indVfbasis_def
       by        auto
     with assms
       have  "(\<phi> \<circ> \<psi>) T v = (cs@extrazeros) \<bullet>\<sharp>\<star> (map (\<psi> T) (concat indVfbasis))"
       using \<psi>_im \<phi>_def indVfbasis
             VectorSpaceHom.distrib_lincomb[OF \<psi>D_VectorSpaceHom]
       by    auto
     also have "\<dots> = (cs@extrazeros) \<bullet>\<sharp>\<star> (map T Vfbasis
                     @ concat (HRep.negGorbit_list nonzero_H_rcoset_reps T Vfbasis))"
       using map_concat[of "\<psi> T"] \<psi>D_im[OF assms] H_rcoset_reps_def
             FGModuleHomSetD_Im[OF assms] Vfbasis_V HRep.negGorbit_list_Cons0
       by    fastforce
     also from cs(1)
       have  "\<dots> = cs \<bullet>\<sharp>\<star> (map T Vfbasis) + extrazeros
                   \<bullet>\<sharp>\<star> (concat (HRep.negGorbit_list nonzero_H_rcoset_reps T Vfbasis))"
       using scalar_mult.lincomb_append[of cs _ fsmult']
       by    simp
     also have "\<dots> = cs \<bullet>\<sharp>\<star> (map T Vfbasis)"
       using nonzero_H_rcoset_reps_H Vfbasis FGModuleHomSetD_Im[OF assms]
             HRep.negGorbit_list_V
             VectorSpace.lincomb_replicate0_left[OF HRep.fVectorSpace]
       unfolding extrazeros_def
       by    force
     also from cs(2) have "\<dots> = T v"
       using FGModuleHomSetD_FGModuleHom[OF assms]
             FGModuleHom.VectorSpaceHom Vfbasis
             VectorSpaceHom.distrib_lincomb[of "aezfun_scalar_mult.fsmult smult"]
       by    fastforce
     finally show ?thesis by fast
   next
     case False
     with assms show ?thesis
       using \<psi>_im \<phi>_def GRep.induced_vector_def \<psi>D_VectorSpaceHom
             VectorSpaceHom.im_zero
             FGModuleHomSetD_FGModuleHom[of T G smult V]
             FGModuleHom.supp suppI_contra
       by    fastforce
   qed
 qed
 
 lemma \<phi>_inverse_im : "\<phi> ` HRepHomSet (\<star>) W \<supseteq> GRepHomSet (\<star>) W"
   using \<phi>\<psi> \<psi>_im by force
 
 lemma bij_\<phi> : "bij_betw \<phi> (HRepHomSet (\<star>) W) (GRepHomSet (\<star>) W)"
   unfolding bij_betw_def
 proof
 
   have "\<And> S T. \<lbrakk> S \<in> HRepHomSet (\<star>) W; T \<in> HRepHomSet (\<star>) W;
             \<phi> S = \<phi> T \<rbrakk> \<Longrightarrow> S = T"
   proof (rule VectorSpaceHom.same_image_on_spanset_imp_same_hom)
     fix S T
     assume ST: "S \<in> HRepHomSet (\<star>) W" "T \<in> HRepHomSet (\<star>) W" "\<phi> S = \<phi> T"
     from ST(1,2) have ST': "HRepHom smult' S" "HRepHom smult' T"
       using FGModuleHomSetD_FGModuleHom[of _ H rrsmult] by auto
 
     from ST'
       show  "VectorSpaceHom induced_smult.fsmult indV fsmult' S"
             "VectorSpaceHom induced_smult.fsmult indV fsmult' T"
       using FGModuleHom.VectorSpaceHom[of H rrsmult indV smult']
       by    auto
 
     show "indV = induced_smult.fSpan (concat indVfbasis)"
          "set (concat indVfbasis) \<subseteq> indV"
       using indVfbasis by auto
 
     show "\<forall>f\<in>set (concat indVfbasis). S f = T f"
     proof
       fix f assume "f \<in> set (concat indVfbasis)"
       from this obtain hfvs where hfvs: "hfvs \<in> set indVfbasis" "f \<in> set hfvs"
         using set_concat by fast
       from hfvs(1) obtain h
         where h: "h \<in> set H_rcoset_reps"
                  "hfvs = map (Hmult (-h) \<circ> induced_vector) Vfbasis"
         using indVfbasis_def
               induced_smult.negGorbit_list_def[of H_rcoset_reps induced_vector]
         by    auto
       from hfvs(2) h(2) obtain v
         where v: "v \<in> set Vfbasis" "f = (-h) *\<currency> (induced_vector v)"
         by    auto
       from v h(1) ST(1) have "S f = (-h) *\<star> (\<phi> S v)"
         using ST'(1) H_rcoset_reps_H Group.neg_closed[OF HRep.GroupG]
               GRep.induced_vector_indV Vfbasis_V \<phi>_def FGModuleHom.G_map
         by    fastforce
       moreover from v h(1) ST(2) have "T f = (-h) *\<star> (\<phi> T v)"
         using ST'(2) H_rcoset_reps_H Group.neg_closed[OF HRep.GroupG] GRep.induced_vector_indV
               Vfbasis_V \<phi>_def FGModuleHom.G_map
         by    fastforce
       ultimately show "S f = T f" using ST(3) by simp
 
     qed
   qed
   thus "inj_on \<phi> (HRepHomSet (\<star>) W)" unfolding inj_on_def by fast
 
   show "\<phi> ` HRepHomSet (\<star>) W = GRepHomSet (\<star>) W"
     using \<phi>_im \<phi>_inverse_im by fast
 
 qed
 
 end (* context FrobeniusReciprocity *)
 
 subsubsection \<open>The theorem\<close>
 
 text \<open>
   Finally we demonstrate that @{term "\<phi>"} is an isomorphism of vector spaces between the two
   hom-sets, leading to Frobenius reciprocity.
 \<close>
 
 context FrobeniusReciprocity
 begin
 
 lemma VectorSpaceIso_\<phi> :
   "VectorSpaceIso Tsmult1 (HRepHomSet (\<star>) W) Tsmult2 \<phi>
         (GRepHomSet (\<star>) W)"
 proof (rule VectorSpaceIso.intro, rule VectorSpace.VectorSpaceHomI_fromaxioms)
 
   from Tsmult1_def show "VectorSpace Tsmult1 (HRepHomSet (\<star>) W)"
     using FHModule_indspace FHModuleW
           FGModule.VectorSpace_FGModuleHomSet
     by    simp
 
   from \<phi>_def show "supp \<phi> \<subseteq> HRepHomSet (\<star>) W"
     using suppD_contra[of \<phi>] by fastforce
 
   have "bij_betw \<phi> (HRepHomSet (\<star>) W) (GRepHomSet (\<star>) W)"
     using bij_\<phi> by fast
   thus "VectorSpaceIso_axioms (HRepHomSet (\<star>) W) \<phi> (GRepHomSet (\<star>) W)"
     by unfold_locales
 
 next    
   fix S T assume "S \<in> HRepHomSet (\<star>) W" "T \<in> HRepHomSet (\<star>) W"
   thus "\<phi> (S + T) = \<phi> S + \<phi> T"
     using \<phi>_def Group.add_closed
           FGModule.Group_FGModuleHomSet[OF FHModule_indspace FHModuleW]
     by    auto
 
 next
   fix a T assume T: "T \<in> HRepHomSet (\<star>) W"
   moreover with Tsmult1_def have aT: "a \<star>\<currency> T \<in> HRepHomSet (\<star>) W"
     using FGModule.VectorSpace_FGModuleHomSet[
             OF FHModule_indspace FHModuleW
           ]
           VectorSpace.smult_closed
     by    simp
   ultimately show "\<phi> (a \<star>\<currency> T) = a \<star>\<cdot> (\<phi> T)"
     using \<phi>_def Tsmult1_def Tsmult2_def by auto
 
 qed
 
 theorem FrobeniusReciprocity :
   "VectorSpace.isomorphic Tsmult1 (HRepHomSet smult' W) Tsmult2
         (GRepHomSet smult' W)"
   using VectorSpaceIso_\<phi> by fast
 
 end (* context FrobeniusReciprocity *)
 
 
 end (* theory *)
diff --git a/thys/Solidity/Reentrancy.thy b/thys/Solidity/Reentrancy.thy
--- a/thys/Solidity/Reentrancy.thy
+++ b/thys/Solidity/Reentrancy.thy
@@ -1,3308 +1,3310 @@
 section\<open>Reentrancy\<close>
 
 text \<open>
   In the following we use our semantics to verify a contract implementing a simple token.
   The contract is defined by definition \<^emph>\<open>victim\<close> and consist of one state variable and two methods:
   \<^item> The state variable "balance" is a mapping which assigns a balance to each address.
   \<^item> Method "deposit" allows to send money to the contract which is then added to the sender's balance.
   \<^item> Method "withdraw" allows to withdraw the callers balance.
 \<close>
 
 text \<open>
   We then verify that the following invariant (defined by \<^emph>\<open>INV\<close>) is preserved by both methods:
   The difference between
   \<^item> the contracts own account-balance and
   \<^item> the sum of all the balances kept in the contracts state variable
   is larger than a certain threshold.
 \<close>
 
 text \<open>
   There are two things to note here:
   First, Solidity implicitly triggers the call of a so-called fallback method whenever we transfer money to a contract.
   In particular if another contract calls "withdraw", this triggers an implict call to the callee's fallback method.
   This functionality was exploited in the infamous DAO attack which we demonstrate it in terms of an example later on.
   Since we do not know all potential contracts which call "withdraw", we need to verify our invariant for all possible Solidity programs.
   Thus, the core result here is a lemma which shows that the invariant is preserved by every Solidity program which is not executed in the context of our own contract.
   For our own methods we show that the invariant holds after executing it.
   Since our own program as well as the unknown program may depend on each other both properties are encoded in a single lemma (\<^emph>\<open>secure\<close>) which is then proved by induction over all statements.
   The final result is then given in terms of two corollaries for the corresponding methods of our contract.
 \<close>
 
 text \<open>
   The second thing to note is that we were not able to verify that the difference is indeed constant.
   During verification it turned out that this is not the case since in the fallback method a contract could just send us additional money withouth calling "deposit".
   In such a case the difference would change. In particular it would grow. However, we were able to verify that the difference does never shrink which is what we actually want to ensure.
 \<close>
 
 theory Reentrancy
 imports Solidity_Evaluator
 begin
 
 subsection\<open>Example of Re-entrancy\<close>
 
 (* The following value can take several minutes to process. *)
 value "eval 1000
           stmt
           (COMP
             (EXTERNAL (ADDRESS (STR ''Victim'')) (STR ''deposit'') [] (UINT 256 10))
             (EXTERNAL (ADDRESS (STR ''Victim'')) (STR ''withdraw'') [] (UINT 256 0)))
           (STR ''Attacker'')
           (STR '''')
           (STR ''0'')
           [(STR ''Victim'', STR ''100''), (STR ''Attacker'', STR ''100'')]
           [
             (STR ''Attacker'',
               [],
               ITE
                 (LESS (BALANCE THIS) (UINT 256 125))
                 (EXTERNAL (ADDRESS (STR ''Victim'')) (STR ''withdraw'') [] (UINT 256 0))
                 SKIP),
             (STR ''Victim'',
               [
                 (STR ''balance'', Var (STMap TAddr (STValue (TUInt 256)))),
                 (STR ''deposit'', Method ([], ASSIGN (Ref (STR ''balance'') [SENDER]) VALUE, None)),
                 (STR ''withdraw'', Method ([],
                 ITE
                   (LESS (UINT 256 0) (LVAL (Ref (STR ''balance'') [SENDER])))
                   (COMP
                     (TRANSFER SENDER (LVAL (Ref (STR ''balance'') [SENDER])))
                     (ASSIGN (Ref (STR ''balance'') [SENDER]) (UINT 256 0)))
                   SKIP
                 , None))],
               SKIP)
           ]
           []"
 
 subsection\<open>Definition of Contract\<close>
 
 abbreviation myrexp::L
   where "myrexp \<equiv> Ref (STR ''balance'') [SENDER]"
 
 abbreviation mylval::E
   where "mylval \<equiv> LVAL myrexp"
 
 abbreviation assign::S
   where "assign \<equiv> ASSIGN (Ref (STR ''balance'') [SENDER]) (UINT 256 0)"
 
 abbreviation transfer::S
   where "transfer \<equiv> TRANSFER SENDER (LVAL (Id (STR ''bal'')))"
 
 abbreviation comp::S
   where "comp \<equiv> COMP assign transfer"
 
 abbreviation keep::S
   where "keep \<equiv> BLOCK ((STR ''bal'', Value (TUInt 256)), Some mylval) comp"
 
 abbreviation deposit::S
   where "deposit \<equiv> ASSIGN (Ref (STR ''balance'') [SENDER]) (PLUS (LVAL (Ref (STR ''balance'') [SENDER])) VALUE)"
 
 definition victim::"(Identifier, Member) fmap"
   where "victim \<equiv> fmap_of_list [
           (STR ''balance'', Var (STMap TAddr (STValue (TUInt 256)))),
           (STR ''deposit'', Method ([], deposit, None)),
           (STR ''withdraw'', Method ([], keep, None))]"
 
 subsection\<open>Definition of Invariant\<close>
 
 abbreviation "SUMM s \<equiv> \<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x. ReadL\<^sub>i\<^sub>n\<^sub>t x"
 
 abbreviation "POS s \<equiv> \<forall>ad x. fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<longrightarrow> ReadL\<^sub>i\<^sub>n\<^sub>t x \<ge> 0"
 
 abbreviation "INV st s val bal \<equiv>
   fmlookup (storage st) (STR ''Victim'') = Some s \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - val \<ge> bal \<and> bal \<ge> 0"
 
 definition frame_def: "frame bal st \<equiv> (\<exists>s. INV st s (SUMM s) bal \<and> POS s)"
 
 subsection\<open>Verification\<close>
 
 lemma conj3: "P \<Longrightarrow> Q \<Longrightarrow> R \<Longrightarrow> P \<and> (Q \<and> R)" by simp
 
 lemma fmfinite: "finite ({(ad, x). fmlookup y ad = Some x})"
 proof -
   have "{(ad, x). fmlookup y ad = Some x} \<subseteq> dom (fmlookup y) \<times> ran (fmlookup y)"
   proof
     fix x assume "x \<in> {(ad, x). fmlookup y ad = Some x}"
     then have "fmlookup y (fst x) = Some (snd x)" by auto
     then have "fst x \<in> dom (fmlookup y)" and "snd x \<in> ran (fmlookup y)" using Map.ranI by (blast,metis)
     then show "x \<in> dom (fmlookup y) \<times> ran (fmlookup y)" by (simp add: mem_Times_iff)
   qed
   thus ?thesis by (simp add: finite_ran finite_subset)
 qed
 
 lemma fmlookup_finite:
   fixes f :: "'a \<Rightarrow> 'a"
     and y :: "('a, 'b) fmap"
   assumes "inj_on (\<lambda>(ad, x). (f ad, x)) {(ad, x). (fmlookup y \<circ> f) ad = Some x}"
   shows "finite {(ad, x). (fmlookup y \<circ> f) ad = Some x}"
 proof (cases rule: inj_on_finite[OF assms(1), of "{(ad, x)|ad x. (fmlookup y) ad = Some x}"])
   case 1
   then show ?case by auto
 next
   case 2
   then have *: "finite {(ad, x) |ad x. fmlookup y ad = Some x}" using fmfinite[of y] by simp
   show ?case using finite_image_set[OF *, of "\<lambda>(ad, x). (ad, x)"] by simp
 qed
 
 lemma balance_inj: "inj_on (\<lambda>(ad, x). (ad + (STR ''.'' + STR ''balance''),x)) {(ad, x). (fmlookup y \<circ> f) ad = Some x}"
 proof
   fix v v' assume asm1: "v \<in> {(ad, x). (fmlookup y \<circ> f) ad = Some x}" and asm2: "v' \<in> {(ad, x). (fmlookup y \<circ> f) ad = Some x}"
   and *:"(case v of (ad, x) \<Rightarrow> (ad + (STR ''.'' + STR ''balance''),x)) = (case v' of (ad, x) \<Rightarrow> (ad + (STR ''.'' + STR ''balance''),x))"
   then obtain ad ad' x x' where **: "v = (ad,x)" and ***: "v'=(ad',x')" by auto
   moreover from * ** *** have "ad + (STR ''.'' + STR ''balance'') = ad' + (STR ''.'' + STR ''balance'')" by simp
   with * ** have "ad = ad'" using String_Cancel[of ad "STR ''.'' + STR ''balance''" ad' ] by simp
   moreover from asm1 asm2 ** *** have "(fmlookup y \<circ> f) ad = Some x" and "(fmlookup y \<circ> f) ad' = Some x'" by auto
   with calculation(3) have "x=x'" by simp
   ultimately show "v=v'" by simp
 qed
   
 lemma transfer_frame:
 assumes "Accounts.transfer ad adv v (accounts st) = Some acc"
     and "frame bal st"
     and "ad \<noteq> STR ''Victim''"
   shows "frame bal (st\<lparr>accounts := acc\<rparr>)"
 proof (cases "adv = STR ''Victim''")
   case True
   define st' where "st' = st\<lparr>accounts := acc, stack := emptyStore, memory := emptyStore\<rparr>"
   from True assms(2) transfer_mono[OF assms(1)] have "(\<exists>s. fmlookup (storage st) (STR ''Victim'') = Some s \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc (STR ''Victim'')) - (SUMM s) \<ge> bal \<and> bal \<ge> 0)" by (auto simp add:frame_def)
   then have "(\<exists>s. fmlookup (storage st') (STR ''Victim'') = Some s \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - (SUMM s) \<ge> bal \<and> bal \<ge> 0)" by (auto simp add: st'_def)
   then show ?thesis using assms(2) by (auto simp add:st'_def frame_def)
 next
   case False
   define st' where "st' = st\<lparr>accounts := acc, stack := emptyStore, memory := emptyStore\<rparr>"
   from False assms(2) assms(3) transfer_eq[OF assms(1)] have "(\<exists>s. fmlookup (storage st) (STR ''Victim'') = Some s \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc (STR ''Victim'')) - (SUMM s) \<ge> bal \<and> bal \<ge> 0)" by (auto simp add:frame_def)
   then have "(\<exists>s. fmlookup (storage st') (STR ''Victim'') = Some s \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - (SUMM s) \<ge> bal \<and> bal \<ge> 0)" by (auto simp add: st'_def)
   then show ?thesis using assms(2) by (auto simp add:st'_def frame_def)
 qed 
 
 lemma decl_frame:
   assumes "frame bal st"
       and "decl a1 a2 a3 cp cd mem c env st = Normal (rv, st')"
     shows "frame bal st'"
 proof (cases a2)
   case (Value t)
   then show ?thesis
   proof (cases a3)
     case None
     with Value show ?thesis using assms by (auto simp add:frame_def)
   next
     case (Some a)
     show ?thesis
     proof (cases a)
       case (Pair a b)
       then show ?thesis
       proof (cases a)
         case (KValue v)
         then show ?thesis
         proof (cases b)
           case v2: (Value t')
           show ?thesis
           proof (cases "Valuetypes.convert t' t v")
             case None
             with Some Pair KValue Value v2 show ?thesis using assms by simp
           next
             case s2: (Some a)
             show ?thesis
             proof (cases a)
               case p2: (Pair a b)
               with Some Pair KValue Value v2 s2 show ?thesis using assms by (auto simp add:frame_def)
             qed
           qed
         next
           case (Calldata x2)
           with Some Pair KValue Value show ?thesis using assms by simp
         next
           case (Memory x3)
           with Some Pair KValue Value show ?thesis using assms by simp
         next
           case (Storage x4)
           with Some Pair KValue Value show ?thesis using assms by simp
         qed
       next
         case (KCDptr x2)
         with Some Pair Value show ?thesis using assms by simp
       next
         case (KMemptr x3)
         with Some Pair Value show ?thesis using assms by simp
       next
         case (KStoptr x4)
         with Some Pair Value show ?thesis using assms by simp
       qed
     qed
   qed
 next
   case (Calldata x2)
   then show ?thesis
   proof (cases cp)
     case True
     then show ?thesis
     proof (cases x2)
       case (MTArray x t)
       then show ?thesis
       proof (cases a3)
         case None
         with Calldata show ?thesis using assms by simp
       next
         case (Some a)
         show ?thesis
         proof (cases a)
           case (Pair a b)
           then show ?thesis
           proof (cases a)
             case (KValue x1)
             with Calldata Some Pair show ?thesis using assms by simp
           next
             case (KCDptr p)
             define l where "l = ShowL\<^sub>n\<^sub>a\<^sub>t (toploc c)"
             obtain c' where c_def: "\<exists>x. (x, c') = allocate c" by simp
             show ?thesis
             proof (cases "cpm2m p l x t cd c'")
               case None
               with Calldata MTArray Some Pair KCDptr l_def c_def True show ?thesis using assms by simp
             next
               case s2: (Some a)
               with Calldata MTArray Some Pair KCDptr l_def c_def True show ?thesis using assms by (auto simp add:frame_def)
             qed
           next
             case (KMemptr p)
             define l where "l = ShowL\<^sub>n\<^sub>a\<^sub>t (toploc c)"
             obtain c' where c_def: "\<exists>x. (x, c') = allocate c" by simp
             show ?thesis
             proof (cases "cpm2m p l x t mem c'")
               case None
               with Calldata MTArray Some Pair KMemptr l_def c_def True show ?thesis using assms by simp
             next
               case s2: (Some a)
               with Calldata MTArray Some Pair KMemptr l_def c_def True show ?thesis using assms by (auto simp add:frame_def)
             qed
           next
             case (KStoptr x4)
             with Calldata Some Pair show ?thesis using assms by simp
           qed
         qed
       qed
     next
       case (MTValue x2)
       with Calldata show ?thesis using assms by simp
     qed
   next
     case False
     with Calldata show ?thesis using assms by simp
   qed
 next
   case (Memory x3)
   then show ?thesis
   proof (cases x3)
     case (MTArray x t)
     then show ?thesis
     proof (cases a3)
       case None
       with Memory MTArray None show ?thesis using assms by (auto simp add:frame_def simp add:Let_def)
     next
       case (Some a)
       then show ?thesis
       proof (cases a)
         case (Pair a b)
         then show ?thesis
         proof (cases a)
           case (KValue x1)
           with Memory MTArray Some Pair show ?thesis using assms by simp
         next
           case (KCDptr p)
           define m l where "m = memory st" and "l = ShowL\<^sub>n\<^sub>a\<^sub>t (toploc m)"
           obtain m' where m'_def: "\<exists>x. (x, m') = allocate m" by simp
           then show ?thesis
           proof (cases "cpm2m p l x t cd m'")
             case None
             with Memory MTArray Some Pair KCDptr m_def l_def m'_def show ?thesis using assms by simp
           next
             case s2: (Some a)
             with Memory MTArray Some Pair KCDptr m_def l_def m'_def show ?thesis using assms by (auto simp add:frame_def)
           qed
         next
           case (KMemptr p)
           then show ?thesis
           proof (cases cp)
             case True
             define m l where "m = memory st" and "l = ShowL\<^sub>n\<^sub>a\<^sub>t (toploc m)"
             obtain m' where m'_def: "\<exists>x. (x, m') = allocate m" by simp
             then show ?thesis
             proof (cases "cpm2m p l x t mem m'")
               case None
               with Memory MTArray Some Pair KMemptr True m_def l_def m'_def show ?thesis using assms by simp
             next
               case s2: (Some a)
               with Memory MTArray Some Pair KMemptr True m_def l_def m'_def show ?thesis using assms by (auto simp add:frame_def)
             qed
           next
             case False
             with Memory MTArray Some Pair KMemptr show ?thesis using assms by (auto simp add:frame_def)
           qed
         next
           case (KStoptr p)
           then show ?thesis
           proof (cases b)
             case (Value x1)
             with Memory MTArray Some Pair KStoptr show ?thesis using assms by simp
           next
             case (Calldata x2)
             with Memory MTArray Some Pair KStoptr show ?thesis using assms by simp
           next
             case m2: (Memory x3)
             with Memory MTArray Some Pair KStoptr show ?thesis using assms by simp
           next
             case (Storage x4)
             then show ?thesis
             proof (cases x4)
               case (STArray x' t')
               define m l where "m = memory st" and "l = ShowL\<^sub>n\<^sub>a\<^sub>t (toploc m)"
               obtain m' where m'_def: "\<exists>x. (x, m') = allocate m" by simp
               from assms(2) Memory MTArray Some Pair KStoptr Storage STArray m_def l_def m'_def
               obtain s where *: "fmlookup (storage st) (address env) = Some s" using Let_def by (auto simp add: Let_def split:option.split_asm)
               then show ?thesis
               proof (cases "cps2m p l x' t' s m'")
                 case None
                 with Memory MTArray Some Pair KStoptr Storage STArray m_def l_def m'_def * show ?thesis using assms by simp
               next
                 case s2: (Some a)
                 with Memory MTArray Some Pair KStoptr Storage STArray m_def l_def m'_def * show ?thesis using assms by (auto simp add:frame_def)
               qed
             next
               case (STMap x21 x22)
               with Memory MTArray Some Pair KStoptr Storage show ?thesis using assms by simp
             next
               case (STValue x3)
               with Memory MTArray Some Pair KStoptr Storage show ?thesis using assms by simp
             qed
           qed
         qed
       qed
     qed
   next
     case (MTValue x2)
     with Memory show ?thesis using assms by simp
   qed
 next
   case (Storage x4)
   then show ?thesis
   proof (cases x4)
     case (STArray x t)
     then show ?thesis
     proof (cases a3)
       case None
       with Storage STArray show ?thesis using assms by simp
     next
       case (Some a)
       then show ?thesis
       proof (cases a)
         case (Pair a b)
         then show ?thesis
         proof (cases a)
           case (KValue x1)
           with Storage STArray Some Pair show ?thesis using assms by simp
         next
           case (KCDptr x2)
           with Storage STArray Some Pair show ?thesis using assms by simp
         next
           case (KMemptr x3)
           with Storage STArray Some Pair show ?thesis using assms by simp
         next
           case (KStoptr x4)
           with Storage STArray Some Pair show ?thesis using assms by (auto simp add:frame_def)
         qed
       qed
     qed
   next
     case (STMap t t')
     then show ?thesis
     proof (cases a3)
       case None
       with Storage STMap show ?thesis using assms by simp
     next
       case (Some a)
       then show ?thesis
       proof (cases a)
         case (Pair a b)
         then show ?thesis
         proof (cases a)
           case (KValue x1)
           with Storage STMap Some Pair show ?thesis using assms by simp
         next
           case (KCDptr x2)
           with Storage STMap Some Pair show ?thesis using assms by simp
         next
           case (KMemptr x3)
           with Storage STMap Some Pair show ?thesis using assms by simp
         next
           case (KStoptr x4)
           with Storage STMap Some Pair show ?thesis using assms by (auto simp add:frame_def)
         qed
       qed
     qed
   next
     case (STValue x3)
     with Storage show ?thesis using assms by simp
   qed
 qed
 
 
 context statement_with_gas
 begin
 
 lemma secureassign:
   assumes "stmt assign ep env cd st = Normal((), st')"
       and "fmlookup (storage st) (STR ''Victim'') = Some s"
       and "address env = (STR ''Victim'')"
       and "fmlookup (denvalue env) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')"
       and "accessStore x (stack st) = Some (KValue (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s))"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - (SUMM s) \<ge> bal"
       and "POS s"
     obtains s'
     where "fmlookup (storage st') (STR ''Victim'') = Some s'"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - (SUMM s' + ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s)) \<ge> bal"
       and "accessStore x (stack st') = Some (KValue (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s))"
       and "POS s'"
 proof -
   define st'' where "st'' = st\<lparr>gas := gas st - costs assign ep env cd st\<rparr>"
   define st''' where "st''' = st''\<lparr>gas := gas st'' - costs\<^sub>e (UINT 256 0) ep env cd st''\<rparr>"
   define st'''' where "st'''' = st'''\<lparr>gas := gas st''' - costs\<^sub>e SENDER ep env cd st'''\<rparr>"
 
   from assms(1) have c1: "gas st > costs assign ep env cd st" by (auto split:if_split_asm)
   have c2: "gas st'' > costs\<^sub>e (UINT 256 0) ep env cd st''"
   proof (rule ccontr)
     assume "\<not> costs\<^sub>e (UINT 256 0) ep env cd st'' < gas st''"
     with c1 show False using assms(1) st''_def st'''_def by auto
   qed
   hence *:"expr (UINT 256 0) ep env cd st'' = Normal ((KValue (createUInt 256 0),Value (TUInt 256)), st''')" using expr.simps(2)[of 256 0 ep env cd "st\<lparr>gas := gas st - costs assign ep env cd st\<rparr>"] st''_def st'''_def by simp
   moreover have "gas st''' > costs\<^sub>e SENDER ep env cd st'''"
   proof (rule ccontr)
     assume "\<not> costs\<^sub>e SENDER ep env cd st''' < gas st'''"
     with c1 c2 show False using assms(1,4) st''_def st'''_def by auto
   qed    
   with assms(4) have **:"lexp (Ref (STR ''balance'') [SENDER]) ep env cd st''' = Normal ((LStoreloc ((sender env) + (STR ''.'' +  STR ''balance'')), Storage (STValue (TUInt 256))), st'''')" using st''''_def by simp
   moreover have "Valuetypes.convert (TUInt 256) (TUInt 256) (ShowL\<^sub>i\<^sub>n\<^sub>t 0) = Some (ShowL\<^sub>i\<^sub>n\<^sub>t 0, TUInt 256)" by simp
   moreover from * ** st''_def assms(1) obtain s'' where ***: "fmlookup (storage st'''') (address env) = Some s''" by (auto split:if_split_asm option.split_asm)
   ultimately have ****:"st' = st''''\<lparr>storage := fmupd (STR ''Victim'') (fmupd ((sender env) + (STR ''.'' + STR ''balance'')) (ShowL\<^sub>i\<^sub>n\<^sub>t 0) s'') (storage st)\<rparr>" using c1 st''_def st'''_def st''''_def assms(1,3) by auto
   moreover define s' where s'_def: "s' = (fmupd ((sender env) + (STR ''.'' + STR ''balance'')) (ShowL\<^sub>i\<^sub>n\<^sub>t 0) s'')"
   ultimately have "fmlookup (storage st') (STR ''Victim'') = Some s'"
               and *****:"fmlookup s' ((sender env) + (STR ''.'' +  STR ''balance'')) = Some (ShowL\<^sub>i\<^sub>n\<^sub>t 0)" by simp_all
   moreover have "SUMM s' + ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) = SUMM s"
   proof -
     have s1: "SUMM s = (\<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x) + ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s)"
     proof (cases "fmlookup s (sender env + (STR ''.'' + STR ''balance'')) = None")
       case True
       then have "accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s = ShowL\<^sub>i\<^sub>n\<^sub>t 0" by simp
       moreover have "{(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x} = {(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
       proof
         show "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x} \<subseteq> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
         proof
           fix x
           assume "x \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}"
           then show "x \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" using True by auto
         qed
       next
         show "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env} \<subseteq> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x }"
         proof
           fix x
           assume "x \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
           then show "x \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}" using True by auto
         qed
       qed
       then have "SUMM s = (\<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)" by simp
       ultimately show ?thesis using Read_ShowL_id by simp
     next
       case False
       then obtain val where val_def: "fmlookup s (sender env + (STR ''.'' + STR ''balance'')) = Some val" by auto
 
       have "inj_on (\<lambda>(ad, x). (ad + (STR ''.'' + STR ''balance''), x)) {(ad, x). (fmlookup s \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using balance_inj by simp
       then have "finite {(ad, x). (fmlookup s \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using fmlookup_finite[of "\<lambda>ad. (ad + (STR ''.'' + STR ''balance''))" s] by simp
-      then have sum1: "finite ({(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env})" using finite_subset[of "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by auto
+      then have sum1: "finite ({(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env})" using finite_subset[of "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}"]
+        by fastforce
       moreover have sum2: "(sender env,val) \<notin> {(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" by simp
       moreover from sum1 x1 val_def have "insert (sender env,val) {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env} = {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}" by auto
       ultimately show ?thesis using sum.insert[OF sum1 sum2, of "\<lambda>(ad,x). ReadL\<^sub>i\<^sub>n\<^sub>t x"] val_def by simp
     qed
     moreover have s2: "SUMM s' = (\<Sum>(ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)"
     proof -
       have "inj_on (\<lambda>(ad, x). (ad + (STR ''.'' + STR ''balance''), x)) {(ad, x). (fmlookup s' \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using balance_inj by simp
       then have "finite {(ad, x). (fmlookup s' \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using fmlookup_finite[of "\<lambda>ad. (ad + (STR ''.'' + STR ''balance''))" s'] by simp
-      then have sum1: "finite ({(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env})" using finite_subset[of "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by auto
+      then have sum1: "finite ({(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env})" using finite_subset[of "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}"]
+        by fastforce
       moreover have sum2: "(sender env,ShowL\<^sub>i\<^sub>n\<^sub>t 0) \<notin> {(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" by simp
       moreover from ***** have "insert (sender env,ShowL\<^sub>i\<^sub>n\<^sub>t 0) {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env} = {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}" by auto
       ultimately show ?thesis using sum.insert[OF sum1 sum2, of "\<lambda>(ad,x). ReadL\<^sub>i\<^sub>n\<^sub>t x"] Read_ShowL_id by simp
     qed
     moreover have s3: "(\<Sum>(ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)
                   =(\<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)"
     proof -
       have "{(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env} = {(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
       proof
         show "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}
            \<subseteq> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
         proof
           fix xx
           assume "xx \<in> {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
           then obtain ad x where "xx = (ad,x)" and "fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x" and "ad \<noteq> sender env" by auto
           moreover have "s''=s" using assms(2,3) s'_def *** st''''_def st'''_def st''_def by simp
           moreover from `ad \<noteq> sender env` have "ad + (STR ''.'' + STR ''balance'') \<noteq> (sender env) + (STR ''.'' + STR ''balance'')" using String_Cancel[where c="(STR ''.'' + STR ''balance'')"] by auto
           ultimately show "xx \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" using s'_def by simp
         qed
       next
         show "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}
            \<subseteq> {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
         proof
           fix xx
           assume "xx \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
           then obtain ad x where "xx = (ad,x)" and "fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x" and "ad \<noteq> sender env" by auto
           moreover have "s''=s" using assms(2,3) s'_def *** st''''_def st'''_def st''_def by simp
           moreover from `ad \<noteq> sender env` have "ad + (STR ''.'' + STR ''balance'') \<noteq> (sender env) + (STR ''.'' + STR ''balance'')" using String_Cancel[where c="(STR ''.'' + STR ''balance'')"] by auto
           ultimately show "xx \<in> {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" using s'_def by simp
         qed
       qed
       thus ?thesis by simp
     qed
     ultimately have "SUMM s' = SUMM s - ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) "
     proof -
       from s2 have "SUMM s' = (\<Sum>(ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)" by simp
       also from s3 have "\<dots> = (\<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)" by simp
       also from s1 have "\<dots> = SUMM s - ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) " by simp
       finally show ?thesis .
     qed
     then show ?thesis by simp
   qed
   moreover have "POS s'"
   proof (rule allI[OF allI])
     fix x xa
     show "fmlookup s' (x + (STR ''.'' + STR ''balance'')) = Some xa \<longrightarrow> 0 \<le> (\<lceil>xa\<rceil>::int)"
     proof
       assume a1: "fmlookup s' (x + (STR ''.'' + STR ''balance'')) = Some xa"
       show "0 \<le> (\<lceil>xa\<rceil>::int)"
       proof (cases "x = sender env")
         case True
         then show ?thesis using s'_def a1 using Read_ShowL_id by auto
       next
         case False
         moreover have "s''=s" using assms(2,3) s'_def *** st''''_def st'''_def st''_def by simp
         ultimately have "fmlookup s (x + (STR ''.'' + STR ''balance'')) = Some xa" using s'_def a1 String_Cancel by (auto split:if_split_asm)
         then show ?thesis using assms(7) by simp
       qed
     qed
   qed
   moreover have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim''))" using **** st''_def st'''_def st''''_def by simp
   moreover from assms(5) have "accessStore x (stack st') = Some (KValue (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) )"using **** st''_def st'''_def st''''_def by simp
   ultimately show ?thesis using assms(6) that by simp
 qed
 
 
 lemma securesender:
   assumes "expr SENDER ep env cd st = Normal((KValue v,t), st')"
       and "fmlookup (storage st) (STR ''Victim'') = Some s"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - SUMM s \<ge> bal \<and> POS s"
     obtains s' where
       "v = sender env" 
       and "t = Value TAddr"
       and "fmlookup (storage st') (STR ''Victim'') = Some s'"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - SUMM s' \<ge> bal \<and> POS s'"
   using assms by (auto split:if_split_asm)
 
 lemma securessel:
   assumes "ssel type loc [] ep env cd st = Normal (x, st')"
       and "fmlookup (storage st) (STR ''Victim'') = Some s"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - SUMM s \<ge> bal \<and> POS s"
     obtains s' where
       "x = (loc, type)"
       and "fmlookup (storage st') (STR ''Victim'') = Some s'"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - SUMM s' \<ge> bal \<and> POS s'"
   using assms by auto
 
 lemma securessel2:
   assumes "ssel (STMap TAddr (STValue (TUInt 256))) (STR ''balance'') [SENDER] ep env cd st = Normal ((loc, type), st')"
       and "fmlookup (storage st) (STR ''Victim'') = Some s"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - SUMM s \<ge> bal \<and> POS s"
     obtains s' where
       "loc = sender env + (STR ''.'' + STR ''balance'')"
       and "type = STValue (TUInt 256)"
       and "fmlookup (storage st') (STR ''Victim'') = Some s'"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - SUMM s' \<ge> bal \<and> POS s'"
 proof -
   from assms(1) obtain v t st'' st''' x
     where *: "expr SENDER ep env cd st = Normal ((KValue v, t), st'')"
       and **: "ssel (STValue (TUInt 256)) (hash (STR ''balance'') v) [] ep env cd st'' = Normal (x,st''')"
       and "st' = st'''"
     by (auto split:if_split_asm)
   moreover obtain s'' where "v =sender env" 
       and "t = Value TAddr"
       and ***:"fmlookup (storage st'') (STR ''Victim'') = Some s''"
       and ****: "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'') (STR ''Victim'')) - SUMM s'' \<ge> bal \<and> POS s''"
     using securesender[OF * assms(2,3)] by auto
   moreover obtain s''' where "x = (hash (STR ''balance'') v, STValue (TUInt 256))"
       and "fmlookup (storage st''') (STR ''Victim'') = Some s'''"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st''') (STR ''Victim'')) - SUMM s''' \<ge> bal \<and> POS s'''"
     using securessel[OF ** *** ****] by auto
   ultimately show ?thesis using assms(1) that by simp
 qed
 
 lemma securerexp:
   assumes "rexp myrexp e\<^sub>p env cd st = Normal ((v, t), st')"
       and "fmlookup (denvalue env) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')"
       and "fmlookup (storage st) (STR ''Victim'') = Some s"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - SUMM s \<ge> bal \<and> POS s"
       and "address env = STR ''Victim''"
     obtains s' where
       "fmlookup (storage st') (address env) = Some s'"
       and "v = KValue (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s')"
       and "t = Value (TUInt 256)"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - SUMM s' \<ge> bal \<and> POS s'"
 proof -
   from assms(1,2) obtain l' t'' st'' s
     where *: "ssel (STMap TAddr (STValue (TUInt 256))) (STR ''balance'') [SENDER] e\<^sub>p env cd st = Normal ((l', STValue t''), st'')"
       and "fmlookup (storage st'') (address env) = Some s"
       and "v = KValue (accessStorage t'' l' s)"
       and "t = Value t''" and "st'=st''"
     by (simp split:if_split_asm option.split_asm)
   moreover obtain s'' where
       "fmlookup (storage st'') (STR ''Victim'') = Some s''"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'') (STR ''Victim'')) - SUMM s'' \<ge> bal \<and> POS s''"
       and "l'=sender env + (STR ''.'' + STR ''balance'')" and "t'' = TUInt 256" using securessel2[OF * assms(3,4)] by blast
   ultimately show ?thesis using assms(1,5) that by auto
 qed
 
 lemma securelval:
   assumes "expr mylval ep env cd st = Normal((v,t), st')"
       and "fmlookup (denvalue env) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')"
       and "fmlookup (storage st) (STR ''Victim'') = Some s"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - SUMM s \<ge> bal \<and> bal \<ge> 0 \<and> POS s"
       and "address env = STR ''Victim''"
     obtains s' where "fmlookup (storage st') (STR ''Victim'') = Some s'"
       and "v = KValue (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s')"
       and "t = Value (TUInt 256)"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - SUMM s' \<ge> bal \<and> bal \<ge> 0 \<and> POS s'"
 proof -
   define st'' where "st'' = st\<lparr>gas := gas st - costs\<^sub>e mylval ep env cd st\<rparr>"
   with assms(3,4) have *: "fmlookup (storage st'') (STR ''Victim'') = Some s"
     and **: "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'') (STR ''Victim'')) - SUMM s \<ge> bal \<and> POS s" by simp+
 
   from assms(1) st''_def obtain v' t' st''' where ***: "rexp myrexp ep env cd st'' =  Normal ((v, t), st''')"
   and "v' = v"
   and "t' = t"
   and "st''' = st'"
     by (simp split:if_split_asm)
 
   with securerexp[OF *** assms(2) * **] show ?thesis using assms(1,4,5) that by auto
 qed
 
 lemma plus_frame:
   assumes "expr (PLUS (LVAL (Ref (STR ''balance'') [SENDER])) VALUE) ep env cd st = Normal (kv, st')"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env) < 2^256"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env) \<ge> 0"
       and "fmlookup (storage st) (STR ''Victim'') = Some s"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - SUMM s \<ge> bal"
       and "fmlookup (denvalue env) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')"
       and "address env = (STR ''Victim'')"
     shows "kv = (KValue (ShowL\<^sub>i\<^sub>n\<^sub>t (ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env))), Value (TUInt 256))"
       and "fmlookup (storage st') (STR ''Victim'') = Some s"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim''))"
 proof -
   define st0 where "st0 = st\<lparr>gas := gas st - costs\<^sub>e (PLUS (LVAL (Ref (STR ''balance'') [SENDER])) VALUE) ep env cd st\<rparr>"
   define st1 where "st1 = st0\<lparr>gas := gas st0 - costs\<^sub>e (LVAL (Ref (STR ''balance'') [SENDER])) ep env cd st0\<rparr>"
   define st2 where "st2 = st1\<lparr>gas := gas st1 - costs\<^sub>e SENDER ep env cd st1\<rparr>"
 
   define st3 where "st3 = st2\<lparr>gas := gas st2 - costs\<^sub>e VALUE ep env cd st2\<rparr>"
   from assms(1) obtain v1 t1 v2 t2 st'' st''' st'''' v t where
     *: "expr (LVAL (Ref (STR ''balance'') [SENDER])) ep env cd st0 = Normal ((KValue v1, Value t1), st'')"
     and **: "expr VALUE ep env cd st'' = Normal ((KValue v2, Value t2), st''')"
     and ***: "add t1 t2 v1 v2 = Some (v,t)"
     and ****: "expr (PLUS (LVAL (Ref (STR ''balance'') [SENDER])) VALUE) ep env cd st = Normal ((KValue v, Value t), st'''')"
     using st0_def by (auto simp del: expr.simps simp add:expr.simps(11) split:if_split_asm result.split_asm Stackvalue.split_asm Type.split_asm option.split_asm)
  
   moreover have "expr (LVAL (Ref (STR ''balance'') [SENDER])) ep env cd st0 = Normal ((KValue (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s), Value (TUInt 256)), st'')"
     and "st'' = st2"
   proof -
     from * obtain l' t' s'' where *****: "ssel (STMap TAddr (STValue (TUInt 256))) (STR ''balance'') [SENDER] ep env cd st1 = Normal ((l', STValue t'), st'')"
       and ******: "fmlookup (storage st'') (address env) = Some s''" and "v1 = (accessStorage t' l' s'')" and "t' = t1"
       using st0_def st1_def assms(4,6) by (auto simp del: accessStorage.simps ssel.simps split:if_split_asm option.split_asm STypes.split_asm result.split_asm)
     moreover from ***** have "expr SENDER ep env cd st1 = Normal ((KValue (sender env), Value TAddr), st2)" using st2_def by (simp split:if_split_asm)
     with ***** have "st'' = st2" and "l' = sender env + (STR ''.'' + STR ''balance'')" and "t' = TUInt 256" by auto
     moreover from ****** `st'' = st2` have "s''=s" using st0_def st1_def st2_def assms(4,7) by auto
     ultimately show "expr (LVAL (Ref (STR ''balance'') [SENDER])) ep env cd st0 = Normal ((KValue (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s), Value (TUInt 256)), st'')"
     and "st'' = st2" using * by (auto split:if_split_asm)
   qed
     
   moreover from ** `st'' = st2` have "expr VALUE ep env cd st2 = Normal ((KValue (svalue env), Value (TUInt 256)), st3)" and "st''' = st3" using st1_def st3_def by (auto split:if_split_asm)
   moreover have "add (TUInt 256) (TUInt 256) (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) (svalue env) = Some (ShowL\<^sub>i\<^sub>n\<^sub>t (ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env)), TUInt 256)" (is "?LHS = ?RHS")
   proof -
     have "?LHS = Some (createUInt 256 (\<lceil>(accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s)\<rceil>+ \<lceil>(svalue env)\<rceil>), TUInt 256)" using add_def olift.simps(2)[of "(+)" 256 256] by simp
     with assms(2,3) show "?LHS = ?RHS" by simp
   qed
   ultimately have "v= (ShowL\<^sub>i\<^sub>n\<^sub>t (ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env)))" and "t = TUInt 256" and "st' = st3" using st0_def assms(1) by (auto split:if_split_asm)
   with assms(1) **** have "kv = (KValue (ShowL\<^sub>i\<^sub>n\<^sub>t (ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env))), Value (TUInt 256))" using st0_def by simp
   moreover from assms(4) st0_def st1_def st2_def st3_def `st' = st3` have "fmlookup (storage st') (STR ''Victim'') = Some s" by simp
   moreover from assms(5) st0_def st1_def st2_def st3_def `st' = st3` have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - SUMM s \<ge> bal" by simp
   moreover have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim''))" using st0_def st1_def st2_def st3_def `st' = st3` by simp
   ultimately show "kv = (KValue (ShowL\<^sub>i\<^sub>n\<^sub>t (ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env))), Value (TUInt 256))"
    and "fmlookup (storage st') (STR ''Victim'') = Some s"
    and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim''))" by auto
 qed
 
 
 
 lemma deposit_frame:
   assumes "stmt deposit ep env cd st = Normal ((), st')"
       and "fmlookup (storage st) (STR ''Victim'') = Some s"
       and "address env = (STR ''Victim'')"
       and "fmlookup (denvalue env) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim'')) - SUMM s \<ge> bal + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env)"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env) < 2^256"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env) \<ge> 0"
       and "POS s"
     obtains s'
     where "fmlookup (storage st') (STR ''Victim'') = Some s'"
       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) - SUMM s' \<ge> bal"
       and "POS s'"
 proof -
   define st0 where "st0 = st\<lparr>gas := gas st - costs deposit ep env cd st\<rparr>"
 
   from assms(1) st0_def obtain kv st'' where *: "expr (PLUS (LVAL (Ref (STR ''balance'') [SENDER])) VALUE) ep env cd st0 = Normal (kv, st'')" by (auto simp del: expr.simps split:if_split_asm result.split_asm)
   moreover have "fmlookup (storage st0) (STR ''Victim'') = Some s" using st0_def assms(2) by simp
   moreover from assms(5) have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st0) (STR ''Victim'')) - SUMM s \<ge> bal + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue env)" using st0_def by simp
   ultimately have **: "kv = (KValue \<lfloor>(\<lceil>accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s\<rceil>::int) + \<lceil>svalue env\<rceil>\<rfloor>, Value (TUInt 256))"
     and st''_s:"fmlookup (storage st'') STR ''Victim'' = Some s"
     and ac: "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'') (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st0) (STR ''Victim''))"
     using plus_frame[OF _ assms(6,7) _ _ assms(4,3), of ep cd st0 kv st''] by auto
 
   define v where "v= (\<lceil>accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s\<rceil>::int) + \<lceil>svalue env\<rceil>"
   moreover from * ** assms(1) st0_def obtain rl st''' where ***: "lexp (Ref (STR ''balance'') [SENDER]) ep env cd st'' = Normal (rl, st''')" by (auto simp del:expr.simps lexp.simps accessStorage.simps split:if_split_asm result.split_asm)
   moreover from *** assms have "rl = (LStoreloc ((sender env) + (STR ''.'' +  STR ''balance'')), Storage (STValue (TUInt 256)))" and st'''_def: "st''' = st''\<lparr>gas := gas st'' - costs\<^sub>e SENDER ep env cd st''\<rparr>"
   proof -
     from *** assms(4) obtain l' t' where
       "fmlookup (denvalue env) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc (STR ''balance''))"
       and *:"ssel (STMap TAddr (STValue (TUInt 256))) (STR ''balance'') [SENDER] ep env cd st'' = Normal ((l',t'), st''')"
       and "rl = (LStoreloc l', Storage t')"
       by (auto simp del: ssel.simps split:if_split_asm option.split_asm result.split_asm)
     moreover from * have "ssel (STMap TAddr (STValue (TUInt 256))) (STR ''balance'') [SENDER] ep env cd st'' = Normal ((((sender env) + (STR ''.'' +  STR ''balance'')), STValue (TUInt 256)), st''\<lparr>gas := gas st'' - costs\<^sub>e SENDER ep env cd st''\<rparr>)" by (simp split:if_split_asm)
     ultimately show "rl = (LStoreloc ((sender env) + (STR ''.'' +  STR ''balance'')), Storage (STValue (TUInt 256)))" and st'''_def: "st''' = st''\<lparr>gas := gas st'' - costs\<^sub>e SENDER ep env cd st''\<rparr>" by auto
   qed
   moreover have "Valuetypes.convert (TUInt 256) (TUInt 256) (ShowL\<^sub>i\<^sub>n\<^sub>t v) = Some (ShowL\<^sub>i\<^sub>n\<^sub>t v, TUInt 256)" by simp
 
   moreover from st''_s st'''_def have s'''_s: "fmlookup (storage st''') (STR ''Victim'') = Some s" by simp
   ultimately have ****:"st' = st'''\<lparr>storage := fmupd (STR ''Victim'') (fmupd ((sender env) + (STR ''.'' + STR ''balance'')) (ShowL\<^sub>i\<^sub>n\<^sub>t v) s) (storage st''')\<rparr>"
     using assms(1) * ** st0_def assms(3) by (auto simp del:expr.simps lexp.simps accessStorage.simps split:if_split_asm)
 
   moreover define s' where "s' = (fmupd ((sender env) + (STR ''.'' + STR ''balance'')) (ShowL\<^sub>i\<^sub>n\<^sub>t v) s)"
   ultimately have "fmlookup (storage st') (STR ''Victim'') = Some s'"
               and *****:"fmlookup s' ((sender env) + (STR ''.'' +  STR ''balance'')) = Some (ShowL\<^sub>i\<^sub>n\<^sub>t v)" by simp_all
 
   moreover have "SUMM s' = SUMM s + \<lceil>svalue env\<rceil>"
   proof -
     have s1: "SUMM s = (\<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x) + ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s)"
     proof (cases "fmlookup s (sender env + (STR ''.'' + STR ''balance'')) = None")
       case True
       then have "accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s = ShowL\<^sub>i\<^sub>n\<^sub>t 0" by simp
       moreover have "{(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x} = {(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
       proof
         show "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x} \<subseteq> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
         proof
           fix x
           assume "x \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}"
           then show "x \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" using True by auto
         qed
       next
         show "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env} \<subseteq> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x }"
         proof
           fix x
           assume "x \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
           then show "x \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}" using True by auto
         qed
       qed
       then have "SUMM s = (\<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)" by simp
       ultimately show ?thesis using Read_ShowL_id by simp
     next
       case False
       then obtain val where val_def: "fmlookup s (sender env + (STR ''.'' + STR ''balance'')) = Some val" by auto
 
       have "inj_on (\<lambda>(ad, x). (ad + (STR ''.'' + STR ''balance''), x)) {(ad, x). (fmlookup s \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using balance_inj by simp
       then have "finite {(ad, x). (fmlookup s \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using fmlookup_finite[of "\<lambda>ad. (ad + (STR ''.'' + STR ''balance''))" s] by simp
-      then have sum1: "finite ({(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env})" using finite_subset[of "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by auto
+      then have sum1: "finite ({(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env})" using finite_subset[of "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by fastforce
       moreover have sum2: "(sender env,val) \<notin> {(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" by simp
       moreover from sum1 x1 val_def have "insert (sender env,val) {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env} = {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x}" by auto
       ultimately show ?thesis using sum.insert[OF sum1 sum2, of "\<lambda>(ad,x). ReadL\<^sub>i\<^sub>n\<^sub>t x"] val_def by simp
     qed
     moreover have s2: "SUMM s' = (\<Sum>(ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x) + v"
     proof -
       have "inj_on (\<lambda>(ad, x). (ad + (STR ''.'' + STR ''balance''), x)) {(ad, x). (fmlookup s' \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using balance_inj by simp
       then have "finite {(ad, x). (fmlookup s' \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using fmlookup_finite[of "\<lambda>ad. (ad + (STR ''.'' + STR ''balance''))" s'] by simp
-      then have sum1: "finite ({(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env})" using finite_subset[of "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by auto
+      then have sum1: "finite ({(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env})" using finite_subset[of "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by fastforce
       moreover have sum2: "(sender env,ShowL\<^sub>i\<^sub>n\<^sub>t v) \<notin> {(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" by simp
       moreover from ***** have "insert (sender env,ShowL\<^sub>i\<^sub>n\<^sub>t v) {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env} = {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}" by auto
       ultimately show ?thesis using sum.insert[OF sum1 sum2, of "\<lambda>(ad,x). ReadL\<^sub>i\<^sub>n\<^sub>t x"] Read_ShowL_id by simp
     qed
     moreover have s3: "(\<Sum>(ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)
                   =(\<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x)"
     proof -
       have "{(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env} = {(ad,x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
       proof
         show "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}
            \<subseteq> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
         proof
           fix xx
           assume "xx \<in> {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
           then obtain ad x where "xx = (ad,x)" and "fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x" and "ad \<noteq> sender env" by auto
           then have "fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x" using s'_def String_Cancel[of ad "(STR ''.'' + STR ''balance'')" "sender env"] by (simp split:if_split_asm)
           with `ad \<noteq> sender env` `xx = (ad,x)` show "xx \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" by simp
         qed
       next
         show "{(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}
            \<subseteq> {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
         proof
           fix xx
           assume "xx \<in> {(ad, x). fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}"
           then obtain ad x where "xx = (ad,x)" and "fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x" and "ad \<noteq> sender env" by auto
           then have "fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x" using s'_def String_Cancel[of ad "(STR ''.'' + STR ''balance'')" "sender env"] by (auto split:if_split_asm)
           with `ad \<noteq> sender env` `xx = (ad,x)` show "xx \<in> {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env}" by simp
         qed
       qed
       thus ?thesis by simp
     qed
     moreover from s'_def v_def have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s') = ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + \<lceil>svalue env\<rceil>" using Read_ShowL_id by (simp split:option.split_asm)
     ultimately have "SUMM s' = SUMM s + \<lceil>svalue env\<rceil>"
     proof -
       from s2 have "SUMM s' = (\<Sum>(ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x) + v" by simp
       also from s3 have "\<dots> = (\<Sum>(ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x \<and> ad \<noteq> sender env. ReadL\<^sub>i\<^sub>n\<^sub>t x) + v" by simp
       also from s1 have "\<dots> = SUMM s - ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender env + (STR ''.'' + STR ''balance'')) s) + v" by simp
       finally show ?thesis using v_def by simp
     qed
     then show ?thesis by simp
   qed
   moreover have "POS s'"
   proof (rule allI[OF allI])
     fix ad xa
     show "fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some xa \<longrightarrow> 0 \<le> (\<lceil>xa\<rceil>::int)"
     proof
       assume a1: "fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some xa"
       show "0 \<le> (\<lceil>xa\<rceil>::int)"
       proof (cases "ad = sender env")
         case True
         then show ?thesis using s'_def assms(7) Read_ShowL_id a1 v_def by auto
       next
         case False
         then show ?thesis using s'_def assms(7,8) using Read_ShowL_id a1 v_def by (auto split:if_split_asm)
       qed
     qed
   qed
   moreover have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st') (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st) (STR ''Victim''))" using **** ac st0_def st'''_def by simp
   ultimately show ?thesis using that assms(5) by simp
 qed
 
 
 lemma secure:
         "address ev1 \<noteq> (STR ''Victim'') \<and> fmlookup ep1 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv1 st1' bal. frame bal st1 \<and> msel c1 t1 l1 xe1 ep1 ev1 cd1 st1 = Normal (rv1, st1') \<longrightarrow> frame bal st1')"
         "address ev2 \<noteq> (STR ''Victim'') \<and> fmlookup ep2 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv2 st2' bal. frame bal st2 \<and> ssel t2 l2 xe2 ep2 ev2 cd2 st2 = Normal (rv2, st2') \<longrightarrow> frame bal st2')"
         "address ev5 \<noteq> (STR ''Victim'') \<and> fmlookup ep5 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv3 st5' bal. frame bal st5 \<and> lexp l5 ep5 ev5 cd5 st5 = Normal (rv3, st5') \<longrightarrow> frame bal st5')"
         "address ev4 \<noteq> (STR ''Victim'') \<and> fmlookup ep4 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv4 st4' bal. frame bal st4 \<and> expr e4 ep4 ev4 cd4 st4 = Normal (rv4, st4') \<longrightarrow> frame bal st4')"
         "address lev \<noteq> (STR ''Victim'') \<and> fmlookup lep (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>ev cd st st' bal. load lcp lis lxs lep lev0 lcd0 lst0 lev lcd lst = Normal ((ev, cd, st), st') \<longrightarrow> (frame bal lst0 \<longrightarrow> frame bal st) \<and> (frame bal lst \<longrightarrow> frame bal st') \<and> address lev0 = address ev \<and> sender lev0 = sender ev \<and> svalue lev0 = svalue ev)"
         "address ev3 \<noteq> (STR ''Victim'') \<and> fmlookup ep3 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv3 st3' bal. frame bal st3 \<and> rexp l3 ep3 ev3 cd3 st3 = Normal (rv3, st3') \<longrightarrow> frame bal st3')"
         "(fmlookup ep6 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow>
           (\<forall>st6'. stmt s6 ep6 ev6 cd6 st6 = Normal((), st6') \<longrightarrow>
             ((address ev6 \<noteq> (STR ''Victim'') \<longrightarrow> (\<forall>bal. frame bal st6 \<longrightarrow> frame bal st6'))
            \<and> (address ev6 = (STR ''Victim'') \<longrightarrow>
               (\<forall>s val bal x. s6 = transfer
               \<and> INV st6 s (SUMM s + ReadL\<^sub>i\<^sub>n\<^sub>t val) bal \<and> POS s
               \<and> fmlookup (denvalue ev6) (STR ''bal'') = Some (Value (TUInt 256), Stackloc x)
               \<and> accessStore x (stack st6) = Some (KValue val)
               \<and> sender ev6 \<noteq> address ev6
               \<longrightarrow> (\<exists>s'. fmlookup (storage st6') (STR ''Victim'') = Some s'
                   \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st6') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s')) \<and>
               (\<forall>s bal x. s6 = comp
               \<and> INV st6 s (SUMM s) bal \<and> POS s
               \<and> fmlookup (denvalue ev6) (STR ''bal'') = Some (Value (TUInt 256), Stackloc x)
               \<and> fmlookup (denvalue ev6) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')
               \<and> accessStore x (stack st6) = Some (KValue (accessStorage (TUInt 256) (sender ev6 + (STR ''.'' + STR ''balance'')) s))
               \<and> sender ev6 \<noteq> address ev6
               \<longrightarrow> (\<exists>s'. fmlookup (storage st6') (STR ''Victim'') = Some s'
                   \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st6') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s')) \<and>
               (\<forall>s bal. s6 = keep
               \<and> INV st6 s (SUMM s) bal \<and> POS s
               \<and> fmlookup (denvalue ev6) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')
               \<and> sender ev6 \<noteq> address ev6
               \<longrightarrow> (\<exists>s'. fmlookup (storage st6') (STR ''Victim'') = Some s'
                   \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st6') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s'))
 ))))"
 proof (induct rule: msel_ssel_lexp_expr_load_rexp_stmt.induct
 [where ?P1.0="\<lambda>c1 t1 l1 xe1 ep1 ev1 cd1 st1. address ev1 \<noteq> (STR ''Victim'') \<and> fmlookup ep1 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv1 st1' bal. frame bal st1 \<and> msel c1 t1 l1 xe1 ep1 ev1 cd1 st1 = Normal (rv1, st1') \<longrightarrow> frame bal st1')"
    and ?P2.0="\<lambda>t2 l2 xe2 ep2 ev2 cd2 st2. address ev2 \<noteq> (STR ''Victim'') \<and> fmlookup ep2 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv2 st2' bal. frame bal st2 \<and> ssel t2 l2 xe2 ep2 ev2 cd2 st2 = Normal (rv2, st2') \<longrightarrow> frame bal st2')"
    and ?P3.0="\<lambda>l5 ep5 ev5 cd5 st5. address ev5 \<noteq> (STR ''Victim'') \<and> fmlookup ep5 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv5 st5' bal. frame bal st5 \<and> lexp l5 ep5 ev5 cd5 st5 = Normal (rv5, st5') \<longrightarrow> frame bal st5')"
    and ?P4.0="\<lambda>e4 ep4 ev4 cd4 st4. address ev4 \<noteq> (STR ''Victim'') \<and> fmlookup ep4 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv4 st4' bal. frame bal st4 \<and> expr e4 ep4 ev4 cd4 st4 = Normal (rv4, st4') \<longrightarrow> frame bal st4')"
    and ?P5.0="\<lambda>lcp lis lxs lep lev0 lcd0 lst0 lev lcd lst. address lev \<noteq> (STR ''Victim'') \<and> fmlookup lep (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>ev cd st st' bal. load lcp lis lxs lep lev0 lcd0 lst0 lev lcd lst = Normal ((ev, cd, st), st') \<longrightarrow> (frame bal lst0 \<longrightarrow> frame bal st) \<and> (frame bal lst \<longrightarrow> frame bal st') \<and> address lev0 = address ev \<and> sender lev0 = sender ev \<and> svalue lev0 = svalue ev)"
    and ?P6.0="\<lambda>l3 ep3 ev3 cd3 st3. address ev3 \<noteq> (STR ''Victim'') \<and> fmlookup ep3 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow> (\<forall>rv3 st3' bal. frame bal st3 \<and> rexp l3 ep3 ev3 cd3 st3 = Normal (rv3, st3') \<longrightarrow> frame bal st3')"
    and ?P7.0="\<lambda>s6 ep6 ev6 cd6 st6.
 (fmlookup ep6 (STR ''Victim'') = Some (victim, SKIP) \<longrightarrow>
           (\<forall>st6'. stmt s6 ep6 ev6 cd6 st6 = Normal((), st6') \<longrightarrow>
             ((address ev6 \<noteq> (STR ''Victim'') \<longrightarrow> (\<forall>bal. frame bal st6 \<longrightarrow> frame bal st6'))
            \<and> (address ev6 = (STR ''Victim'') \<longrightarrow>
               (\<forall>s val bal x. s6 = transfer
               \<and> INV st6 s (SUMM s + ReadL\<^sub>i\<^sub>n\<^sub>t val) bal \<and> POS s
               \<and> fmlookup (denvalue ev6) (STR ''bal'') = Some (Value (TUInt 256), Stackloc x)
               \<and> accessStore x (stack st6) = Some (KValue val)
               \<and> sender ev6 \<noteq> address ev6
               \<longrightarrow> (\<exists>s'. fmlookup (storage st6') (STR ''Victim'') = Some s'
                   \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st6') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s')) \<and>
               (\<forall>s bal x. s6 = comp
               \<and> INV st6 s (SUMM s) bal \<and> POS s
               \<and> fmlookup (denvalue ev6) (STR ''bal'') = Some (Value (TUInt 256), Stackloc x)
               \<and> fmlookup (denvalue ev6) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')
               \<and> accessStore x (stack st6) = Some (KValue (accessStorage (TUInt 256) (sender ev6 + (STR ''.'' + STR ''balance'')) s))
               \<and> sender ev6 \<noteq> address ev6
               \<longrightarrow> (\<exists>s'. fmlookup (storage st6') (STR ''Victim'') = Some s'
                   \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st6') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s')) \<and>
               (\<forall>s bal. s6 = keep
               \<and> INV st6 s (SUMM s) bal \<and> POS s
               \<and> fmlookup (denvalue ev6) (STR ''balance'') = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')
               \<and> sender ev6 \<noteq> address ev6
               \<longrightarrow> (\<exists>s'. fmlookup (storage st6') (STR ''Victim'') = Some s'
                   \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st6') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s'))
 ))))"
 ])
   case (1 uu uv uw ux uy uz st)
   then show ?case by simp
 next
   case (2 va vb vc vd ve vf vg st)
   then show ?case by simp
 next
   case (3 vh al t loc x e\<^sub>p env cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address env \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> msel vh (MTArray al t) loc [x] e\<^sub>p env cd st = Normal (rv1, st')"
       moreover from * obtain v4 t4 st4' where **: "expr x e\<^sub>p env cd st = Normal ((v4, t4), st4')" by (auto split: result.split_asm)
       moreover from * ** have "frame bal st4'" using 3(1) asm by (auto split:if_split_asm)
       ultimately show "frame bal st'" by (simp split:Stackvalue.split_asm Type.split_asm if_split_asm)
     qed
   qed
 next
   case (4 mm al t loc x y ys e\<^sub>p env cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address env \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> msel mm (MTArray al t) loc (x # y # ys) e\<^sub>p env cd st = Normal (rv1, st')"
       moreover from * obtain v4 t4 st'' where **: "expr x e\<^sub>p env cd st = Normal ((KValue v4, Value t4), st'')" by (auto split: result.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have f1: "frame bal st''" using 4(1) asm by (auto split:if_split_asm)
       moreover from * ** have ***: "Valuetypes.less t4 (TUInt 256) v4 \<lfloor>al\<rfloor> = Some (\<lceil>True\<rceil>, TBool)" by (auto split: result.split_asm Stackvalue.split_asm Type.split_asm if_split_asm)
       moreover from * ** *** obtain vb st''' where ****: "(applyf (\<lambda>st. if mm then memory st else cd) st'') = Normal (vb, st''')"
         and f2: "frame bal st'''" using f1 by (simp split:Stackvalue.split_asm Type.split_asm if_split_asm)
       moreover from * ** *** **** obtain ll where *****: "accessStore (hash loc v4) vb = Some (MPointer ll)"
         by (simp split: Type.split_asm if_split_asm option.split_asm Memoryvalue.split_asm)
       moreover from * ** *** **** ***** obtain l1' st'''' where ******: "msel mm t ll (y # ys) e\<^sub>p env cd st''' = Normal (l1', st'''')"
         by (simp split: Type.split_asm if_split_asm option.split_asm Memoryvalue.split_asm)
       ultimately have "st' = st''''" by simp
       moreover have x1: "\<forall>rv1' st1' bal. (frame bal st''') \<and> local.msel mm t ll (y # ys) e\<^sub>p env cd st''' = Normal (rv1', st1') \<longrightarrow> frame bal st1'" using 4(2)[OF ** _ _ _ *** _ *****] **** asm apply safe by auto
       ultimately show "frame bal st'" using f2 ****** by blast
     qed
   qed
 next
   case (5 tp loc vi vj vk st)
   then show ?case by simp
 next
   case (6 vl vm vn vo vp vq vr st)
   then show ?case by simp
 next
   case (7 al t loc x xs e\<^sub>p env cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address env \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> ssel (STArray al t) loc (x # xs) e\<^sub>p env cd st = Normal (rv1, st')"
       moreover from * obtain v4 t4 st4' where **: "expr x e\<^sub>p env cd st = Normal ((KValue v4, Value t4), st4')" by (auto split: result.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have f1: "frame bal st4'" using 7(1) asm by (auto split:if_split_asm)
       moreover from * ** have ***: "Valuetypes.less t4 (TUInt 256) v4 \<lfloor>al\<rfloor> = Some (\<lceil>True\<rceil>, TBool)" by (auto split: result.split_asm Stackvalue.split_asm Type.split_asm if_split_asm)
       moreover from * ** *** obtain l1' st''' where ****: "ssel t (hash loc v4) xs e\<^sub>p env cd st4' = Normal (l1', st''')" by (simp split: Type.split_asm if_split_asm option.split_asm Memoryvalue.split_asm)
       ultimately have "st' = st'''" by simp
       moreover have "\<forall>rv' st2' bal. (frame bal  st4') \<and> ssel t (hash loc v4) xs e\<^sub>p env cd st4' = Normal (rv', st2') \<longrightarrow> frame bal st2'" using 7(2)[OF ** _ _ _ ***] asm apply safe by auto
       ultimately show "frame bal st'" using f1 **** by blast
     qed
   qed
 next
   case (8 vs t loc x xs e\<^sub>p env cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address env \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> ssel (STMap vs t) loc (x # xs) e\<^sub>p env cd st = Normal (rv1, st')"
       moreover from * obtain v4 t4 st4' where **: "expr x e\<^sub>p env cd st = Normal ((KValue v4, t4), st4')" by (auto split: result.split_asm Stackvalue.split_asm)
       moreover from * ** have ***: "frame bal st4'" using 8(1) asm by (auto split:if_split_asm)
       moreover from * ** *** obtain l1' st''' where ****:"ssel t (hash loc v4) xs e\<^sub>p env cd st4' = Normal (l1', st''')" by simp
       moreover from *** **** have "frame bal st'''" using 8(2)[OF **,of "KValue v4" t4 v4] asm by blast
       ultimately show "frame bal st'" by (simp split:Stackvalue.split_asm)
     qed
   qed
 next
   case (9 i vt e vu st)
   then show ?case by (auto split:option.split_asm result.split_asm Denvalue.split_asm)
 next
   case (10 i r e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> lexp (Ref i r) e\<^sub>p e cd st = Normal (rv1, st')"
       show "frame bal st'"
       proof (cases "fmlookup (denvalue e) i")
         case None
         with * show ?thesis by simp
       next
         case (Some a)
         then show ?thesis
         proof (cases a)
           case (Pair tp b)
           then show ?thesis
           proof (cases b)
             case (Stackloc l')
             then show ?thesis
             proof (cases "accessStore l' (stack st)")
               case None
               with * show ?thesis using Some Pair Stackloc by simp
             next
               case s2: (Some k)
               then show ?thesis
               proof (cases k)
                 case (KValue x1)
                 with * show ?thesis using Some Pair Stackloc s2 by simp
               next
                 case (KCDptr x2)
                 with * show ?thesis using Some Pair Stackloc s2 by simp
               next
                 case (KMemptr l'')
                 then show ?thesis
                 proof (cases tp)
                   case (Value x1)
                   with * show ?thesis using Some Pair Stackloc s2 KMemptr by simp
                 next
                   case (Calldata x2)
                   with * show ?thesis using Some Pair Stackloc s2 KMemptr by simp
                 next
                   case (Memory x3)
                   with * Some Pair Stackloc KMemptr s2 obtain l1' t1' where "msel True x3 l'' r e\<^sub>p e cd st = Normal ((l1', t1'), st')" by (auto split: result.split_asm)
                   with * 10(1)[OF Some Pair Stackloc _ _ KMemptr, of "Some k" st x3] show ?thesis using s2 Memory asm by auto
                 next
                   case (Storage x4)
                   with * show ?thesis using Some Pair Stackloc s2 KMemptr by simp
                 qed
               next
                 case (KStoptr l'')
                 then show ?thesis
                 proof (cases tp)
                   case (Value x1)
                   with * show ?thesis using Some Pair Stackloc s2 KStoptr by simp
                 next
                   case (Calldata x2)
                   with * show ?thesis using Some Pair Stackloc s2 KStoptr by simp
                 next
                   case (Memory x3)
                   with * show ?thesis using Some Pair Stackloc s2 KStoptr by simp
                 next
                   case (Storage x4)
                   with * Some Pair Stackloc KStoptr s2 obtain l1' t1' where "ssel x4 l'' r e\<^sub>p e cd st = Normal ((l1', t1'), st')" by (auto split: result.split_asm)
                   with * 10(2)[OF Some Pair Stackloc _ _ KStoptr, of "Some k" st x4] show ?thesis using s2 Storage asm by auto
                 qed
               qed
             qed        
           next
             case (Storeloc l'')
             then show ?thesis
             proof (cases tp)
               case (Value x1)
               with * show ?thesis using Some Pair Storeloc by simp
             next
               case (Calldata x2)
               with * show ?thesis using Some Pair Storeloc by simp
             next
               case (Memory x3)
               with * show ?thesis using Some Pair Storeloc by simp
             next
               case (Storage x4)
               with * Some Pair Storeloc obtain l1' t1' where "ssel x4 l'' r e\<^sub>p e cd st = Normal ((l1', t1'), st')" by (auto split: result.split_asm)
               with * 10(3)[OF Some Pair Storeloc Storage] asm show ?thesis by auto
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (11 b x e\<^sub>p e cd st)
   then show ?case by (simp add:frame_def)
 next
   case (12 b x e\<^sub>p e cd st)
   then show ?case by (simp add:frame_def)
 next
   case (13 ad e\<^sub>p e cd st)
   then show ?case by (simp add:frame_def)
 next
   case (14 ad e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (BALANCE ad) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * obtain adv st'' where **:"expr ad e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (BALANCE ad) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue adv, Value TAddr),st'')" by (auto split:if_split_asm result.split_asm Stackvalue.split_asm Types.split_asm Type.split_asm)
       with * ** have "frame bal st''" using 14(1) asm by (auto simp add:frame_def split:if_split_asm)
       moreover from * ** have "st' = st''" by (simp split:if_split_asm)
       ultimately show "frame bal st'" by simp
     qed
   qed
 next
   case (15 e\<^sub>p e cd st)
   then show ?case by (simp add:frame_def)
 next
   case (16 e\<^sub>p e cd st)
   then show ?case by (simp add:frame_def)
 next
   case (17 e\<^sub>p e cd st)
   then show ?case by (simp add:frame_def)
 next
   case (18 e\<^sub>p e cd st)
   then show ?case by (simp add:frame_def)
 next
   case (19 e\<^sub>p e cd st)
   then show ?case by (simp add:frame_def)
 next
   case (20 x e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (NOT x) e\<^sub>p e cd st = Normal (rv1, st')"
       then have f1: "frame bal (st\<lparr>gas:=gas st - (costs\<^sub>e (NOT x) e\<^sub>p e cd st)\<rparr>)" by (simp add:frame_def)
       moreover from * obtain v t st'' where **: "expr x e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (NOT x) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue v, Value t), st'')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have ***: "frame bal st''" using 20(1) asm by (auto simp add:frame_def split:if_split_asm)
       show "frame bal st'"
       proof (cases "v = ShowL\<^sub>b\<^sub>o\<^sub>o\<^sub>l True")
         case True
         with * ** *** obtain x st''' where "expr FALSE e\<^sub>p e cd st'' = Normal (x, st''')"
           and "frame bal st'''" by (auto simp add:frame_def split:if_split_asm)
         with * ** *** True show ?thesis by (auto split: if_split_asm)
       next
         case False
         with * ** *** obtain x st''' where "expr TRUE e\<^sub>p e cd st'' = Normal (x, st''')"
           and "frame bal st'''" by (auto simp add:frame_def split:if_split_asm)
         with * ** *** False show ?thesis by (auto split: if_split_asm)
       qed
     qed
   qed
 next
   case (21 e1 e2 e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (PLUS e1 e2) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * obtain v1 t1 st'' where **: "expr e1 e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (PLUS e1 e2) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue v1, Value t1), st'')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have ***: "frame bal st''" using 21(1) asm by (auto simp add:frame_def split:if_split_asm)
       moreover from * ** *** obtain v2 t2 st''' where ****: "expr e2 e\<^sub>p e cd st'' = Normal ((KValue v2, Value t2), st''')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** *** **** have "frame bal st'''" using 21(2)[OF _ **] asm by (auto split:if_split_asm)
       moreover from * ** **** obtain v t where "add t1 t2 v1 v2 = Some (v, t)" by (auto split:if_split_asm option.split_asm)
       ultimately show "frame bal st'" by (auto split:if_split_asm)
     qed
   qed
 next
   case (22 e1 e2 e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (MINUS e1 e2) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * obtain v1 t1 st'' where **: "expr e1 e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (MINUS e1 e2) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue v1, Value t1), st'')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have ***: "frame bal st''" using 22(1) asm by (auto simp add:frame_def split:if_split_asm)
       moreover from * ** *** obtain v2 t2 st''' where ****: "expr e2 e\<^sub>p e cd st'' = Normal ((KValue v2, Value t2), st''')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** *** **** have "frame bal st'''" using 22(2)[OF _ **] asm by (auto split:if_split_asm)
       moreover from * ** **** obtain v t where "sub t1 t2 v1 v2 = Some (v, t)" by (auto split:if_split_asm option.split_asm)
       ultimately show "frame bal st'" by (auto split:if_split_asm)
     qed
   qed
 next
   case (23 e1 e2 e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (LESS e1 e2) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * obtain v1 t1 st'' where **: "expr e1 e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (LESS e1 e2) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue v1, Value t1), st'')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have ***: "frame bal st''" using 23(1) asm by (auto simp add:frame_def split:if_split_asm)
       moreover from * ** *** obtain v2 t2 st''' where ****: "expr e2 e\<^sub>p e cd st'' = Normal ((KValue v2, Value t2), st''')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** *** **** have "frame bal st'''" using 23(2)[OF _ **] asm by (auto split:if_split_asm)
       moreover from * ** **** obtain v t where "Valuetypes.less t1 t2 v1 v2 = Some (v, t)" by (auto split:if_split_asm option.split_asm)
       ultimately show "frame bal st'" by (auto split:if_split_asm)
     qed
   qed
 next
   case (24 e1 e2 e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (EQUAL e1 e2) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * obtain v1 t1 st'' where **: "expr e1 e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (EQUAL e1 e2) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue v1, Value t1), st'')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have ***: "frame bal st''" using 24(1) asm by (auto simp add:frame_def split:if_split_asm)
       moreover from * ** *** obtain v2 t2 st''' where ****: "expr e2 e\<^sub>p e cd st'' = Normal ((KValue v2, Value t2), st''')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** *** **** have "frame bal st'''" using 24(2)[OF _ **] asm by (auto split:if_split_asm)
       moreover from * ** **** obtain v t where "Valuetypes.equal t1 t2 v1 v2 = Some (v, t)" by (auto split:if_split_asm option.split_asm)
       ultimately show "frame bal st'" by (auto split:if_split_asm)
     qed
   qed
 next
   case (25 e1 e2 e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (AND e1 e2) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * obtain v1 t1 st'' where **: "expr e1 e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (AND e1 e2) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue v1, Value t1), st'')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have ***: "frame bal st''" using 25(1) asm by (auto simp add:frame_def split:if_split_asm)
       moreover from * ** *** obtain v2 t2 st''' where ****: "expr e2 e\<^sub>p e cd st'' = Normal ((KValue v2, Value t2), st''')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** *** **** have "frame bal st'''" using 25(2)[OF _ **] asm by (auto split:if_split_asm)
       moreover from * ** **** obtain v t where "Valuetypes.vtand t1 t2 v1 v2 = Some (v, t)" by (auto split:if_split_asm option.split_asm)
       ultimately show "frame bal st'" by (auto split:if_split_asm)
     qed
   qed
 next
   case (26 e1 e2 e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (OR e1 e2) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * obtain v1 t1 st'' where **: "expr e1 e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (OR e1 e2) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue v1, Value t1), st'')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** have ***: "frame bal st''" using 26(1) asm by (auto simp add:frame_def split:if_split_asm)
       moreover from * ** *** obtain v2 t2 st''' where ****: "expr e2 e\<^sub>p e cd st'' = Normal ((KValue v2, Value t2), st''')"
         by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from * ** *** **** have "frame bal st'''" using 26(2)[OF _ **] asm by (auto split:if_split_asm)
       moreover from * ** **** obtain v t where "Valuetypes.vtor t1 t2 v1 v2 = Some (v, t)" by (auto split:if_split_asm option.split_asm)
       ultimately show "frame bal st'" by (auto split:if_split_asm)
     qed
   qed
 next
   case (27 i e\<^sub>p e cd st)
   show ?case using 27(1)[of "()" "st\<lparr>gas:=gas st - (costs\<^sub>e (LVAL i) e\<^sub>p e cd st)\<rparr>"] apply safe by (auto simp add:frame_def split:if_split_asm)
 next
   case (28 i xe e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (CALL i xe) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * have a1: "(applyf (costs\<^sub>e (CALL i xe) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))  st = Normal ((), st\<lparr>gas := gas st - costs\<^sub>e (CALL i xe) e\<^sub>p e cd st\<rparr>)" by auto
       moreover from * obtain ct bla where **: "fmlookup e\<^sub>p (address e) = Some (ct, bla)"
         by (auto split:if_split_asm option.split_asm)
       moreover from * ** obtain fp f x where ***: "fmlookup ct i = Some (Method (fp, f, Some x))"
         by (auto split:if_split_asm option.split_asm Member.split_asm)
       moreover define e' where "e' = ffold_init ct (emptyEnv (address e) (sender e) (svalue e)) (fmdom ct)"
       moreover from * ** *** obtain e'' cd' st'' st''' where ****: "load False fp xe e\<^sub>p e' emptyStore (st\<lparr>gas:=gas st - (costs\<^sub>e (CALL i xe) e\<^sub>p e cd st), stack:=emptyStore\<rparr>) e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (CALL i xe) e\<^sub>p e cd st)\<rparr>) = Normal ((e'', cd', st''), st''')"
         using e'_def by (auto split:if_split_asm result.split_asm)
       moreover from * **** have f1: "frame bal st''" and ad: "address e' = address e''"
         using asm 28(1)[OF _ ** _ *** _ _ _ _ e'_def, of _ "st\<lparr>gas := gas st - costs\<^sub>e (CALL i xe) e\<^sub>p e cd st\<rparr>" bla "(fp, f, Some x)" fp "(f, Some x)" f "Some x" x "st\<lparr>gas := gas st - costs\<^sub>e (CALL i xe) e\<^sub>p e cd st, stack := emptyStore\<rparr>" "st\<lparr>gas := gas st - costs\<^sub>e (CALL i xe) e\<^sub>p e cd st\<rparr>"] by (auto simp add:frame_def split:if_split_asm result.split_asm)
       moreover from e'_def have ad2: "address e = address e'" using ffold_init_ad_same[of ct "(emptyEnv (address e) (sender e) (svalue e))" "(fmdom ct)" e'] by simp
       moreover from * ** *** **** e'_def obtain st'''' where *****: "stmt f e\<^sub>p e'' cd' st'' = Normal ((), st'''')" by (auto split:if_split_asm result.split_asm)
       moreover from f1 ad ad2 asm ***** have f2:"frame bal st''''"
         using 28(2)[OF a1 ** _ *** _ _ _ _ e'_def _ ****, of bla "(fp, f, Some x)" "(f, Some x)" f "Some x" x e'' "(cd', st'')" "cd'" "st''" st''' st''' "()" st''] by (simp add:frame_def)
       moreover from * ** *** **** ***** f1 f2 e'_def obtain rv st''''' where ******: "expr x e\<^sub>p e'' cd' st'''' = Normal (rv, st''''')" by (auto split:if_split_asm result.split_asm)
       ultimately have "st' = st'''''\<lparr>stack:=stack st''', memory := memory st'''\<rparr>" apply safe by auto
       moreover from f1 f2 ad ad2 asm a1 ***** ****** have "\<forall>rv4 st4' bal.
         frame bal st'''' \<and>
         local.expr x e\<^sub>p e'' cd' st'''' = Normal (rv4, st4') \<longrightarrow>
         frame bal st4'" using e'_def asm 28(3)[OF a1 ** _ *** _ _ _ _ e'_def _ **** _ _ _ _ *****, of bla "(fp, f, Some x)" " (f, Some x)" "Some x" x "(cd', st'')" st'' st''' st''' "()"] apply safe by auto
       with ****** f2 have "frame bal st'''''" by blast
       ultimately show "frame bal st'" by (simp add:frame_def)
     qed
   qed
 next
   case (29 ad i xe val e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv1 and st' and bal
       assume *: "frame bal st \<and> expr (ECALL ad i xe val) e\<^sub>p e cd st = Normal (rv1, st')"
       moreover from * have a1: "(applyf (costs\<^sub>e (ECALL ad i xe val) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))  st = Normal ((), st\<lparr>gas := gas st - costs\<^sub>e (ECALL ad i xe val) e\<^sub>p e cd st\<rparr>)" by auto
       moreover from * obtain adv st'' where **: "expr ad e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs\<^sub>e (ECALL ad i xe val) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue adv, Value TAddr), st'')"
         by (auto split:if_split_asm result.split_asm Stackvalue.split_asm Type.split_asm Types.split_asm)
       moreover from * ** have f1: "frame bal st''"using asm 29(1) by (auto simp add:frame_def split:if_split_asm)
       moreover from * ** obtain ct bla where ***: "fmlookup e\<^sub>p adv = Some (ct, bla)"
         by (auto split:if_split_asm option.split_asm)
       moreover from * ** *** obtain fp f x where ****: "fmlookup ct i = Some (Method (fp, f, Some x))"
         by (auto split:if_split_asm option.split_asm Member.split_asm)
       moreover from * ** *** **** obtain v t st''' where *****: "expr val e\<^sub>p e cd st'' = Normal ((KValue v, Value t), st''')" by (auto split:if_split_asm result.split_asm Stackvalue.split_asm Type.split_asm)
       moreover from f1 ***** asm have f2: "frame bal st'''" and f3: "frame bal (st'''\<lparr>stack := emptyStore, memory := emptyStore\<rparr>)" using asm 29(2)[OF a1 ** _ _ _ _ *** _ ****] by (auto simp add:frame_def)
       moreover define e' where "e' = ffold_init ct (emptyEnv adv (address e) v) (fmdom ct)"
       moreover from * ** *** **** ***** obtain e'' cd' st'''' st''''' where *******: "load True fp xe e\<^sub>p e' emptyStore (st'''\<lparr>stack:=emptyStore, memory:=emptyStore\<rparr>) e cd st''' = Normal ((e'', cd', st''''), st''''')"
         using e'_def by (auto split:if_split_asm result.split_asm option.split_asm)
       moreover have "(\<forall>ev cda st st' bal.
         local.load True fp xe e\<^sub>p e' emptyStore (st'''\<lparr>stack := emptyStore, memory := emptyStore\<rparr>) e cd st''' = Normal ((ev, cda, st), st') \<longrightarrow>
         (frame bal (st'''\<lparr>stack := emptyStore, memory := emptyStore\<rparr>) \<longrightarrow> frame bal st) \<and>
         (frame bal st''' \<longrightarrow> frame bal st') \<and> address e' = address ev \<and> sender e' = sender ev \<and> svalue e' = svalue ev)"
         using 29(3)[OF a1 ** _ _ _ _ *** _ **** _ _ _ _ ***** _ _ _ e'_def, of "KValue adv" "Value TAddr" TAddr bla "(fp, f, Some x)" fp "(f, Some x)" f "Some x" x "KValue v" "Value t" t "st'''\<lparr>stack := emptyStore, memory := emptyStore\<rparr>" st'''] asm ******* by simp
       then have "frame bal st'''' \<and> frame bal st''''' \<and> address e' = address e''" using ******* f2 f3 by blast
       then have f4: "frame bal st''''" and ad1: "address e' = address e''" by auto
       moreover from * ** *** **** ***** ******* e'_def obtain acc where ******: "Accounts.transfer (address e) adv v (accounts st'''') = Some acc" by (auto split:if_split_asm option.split_asm)
       then have ******: "Accounts.transfer (address e) adv v (accounts st'''') = Some acc" by (auto split:if_split_asm option.split_asm)
       moreover from f4 have f5: "frame bal (st''''\<lparr>accounts := acc\<rparr>)" using transfer_frame[OF ******] asm by simp
       moreover from e'_def have ad2: "adv = address e'" using ffold_init_ad_same[of ct "(emptyEnv adv (address e) v)" "(fmdom ct)" e'] by simp
       moreover from * ** *** **** ***** ****** ******* ****** obtain st'''''' where ********: "stmt f e\<^sub>p e'' cd' (st''''\<lparr>accounts := acc\<rparr>) = Normal ((), st'''''')"
         using e'_def by (auto simp del: transfer.simps split:if_split_asm result.split_asm)
       moreover have "adv \<noteq> STR ''Victim''"
       proof (rule ccontr)
         assume "\<not> adv \<noteq> STR ''Victim''"
         with asm ** *** **** show False using victim_def fmap_of_list_SomeD[of "[(STR ''balance'', Var (STMap TAddr (STValue (TUInt 256)))), (STR ''deposit'', Method ([], deposit, None)), (STR ''withdraw'', Method ([], keep, None))]"] by auto
       qed
       with ad1 ad2 have ad: "address e'' \<noteq> STR ''Victim'' \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)" using asm by simp
       then have "(\<forall>bal. frame bal (st''''\<lparr>accounts := acc\<rparr>) \<longrightarrow> frame bal st'''''')" using 29(4)[OF a1 ** _ _ _ _ *** _ **** _ _ _ _ ***** _ _ _ _ _ ******* _ _ _ ******, of "KValue adv" "Value TAddr" TAddr bla "(fp, f, Some x)" "(f, Some x)" f "Some x" x "KValue v" "Value t" t e'' "(cd', st'''')" cd'  st'''''  st''''' "()" "st''''\<lparr>accounts := acc\<rparr>"] ******** e'_def by auto
       then have f4: "frame bal st''''''" using f5 ******** by auto
       moreover from * ** *** **** ***** ****** ******* ******** obtain rv st''''''' where *********: "expr x e\<^sub>p e'' cd' st'''''' = Normal (rv, st''''''')"
         using e'_def by (auto split:if_split_asm result.split_asm)
       ultimately have "st' = st'''''''\<lparr>stack:=stack st''''', memory := memory st'''''\<rparr>" apply safe by auto
       moreover from ad have "\<forall>rv4 st4' bal.
         frame bal st'''''' \<and>
         local.expr x e\<^sub>p e'' cd' st'''''' = Normal (rv4, st4') \<longrightarrow>
         frame bal st4'"
         using e'_def 29(5)[OF a1 ** _ _ _ _ *** _ **** _ _ _ _ ***** _ _ _ _ _ ******* _ _ _ ****** _ ********, of "KValue adv" "Value TAddr" TAddr bla "(fp, f, Some x)"] by auto
       then have"frame bal st'''''''" using f4 ********* by blast
       ultimately show "frame bal st'" by (simp add:frame_def)
     qed
   qed
 next
   case (30 cp i\<^sub>p t\<^sub>p pl e el e\<^sub>p e\<^sub>v' cd' st' e\<^sub>v cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e\<^sub>v \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF allI[OF allI[OF impI]]]]])
       fix ev and cda and sta and st'a and bal
       assume *: "local.load cp ((i\<^sub>p, t\<^sub>p) # pl) (e # el) e\<^sub>p e\<^sub>v' cd' st' e\<^sub>v cd st = Normal ((ev, cda, sta), st'a)"
       moreover from * obtain v t st'' where **: "expr e e\<^sub>p e\<^sub>v cd st = Normal ((v,t),st'')" by (auto split: result.split_asm)
       moreover from * ** obtain cd'' e\<^sub>v'' st''' where ***: "decl i\<^sub>p t\<^sub>p (Some (v,t)) cp cd (memory st'') cd' e\<^sub>v' st' = Normal ((cd'', e\<^sub>v''),st''')" by (auto split: result.split_asm)
       moreover from *** have ad: "address e\<^sub>v' = address e\<^sub>v'' \<and> sender e\<^sub>v' = sender e\<^sub>v'' \<and> svalue e\<^sub>v' = svalue e\<^sub>v''" using decl_gas_address by simp
       moreover from * ** *** obtain ev' cda' sta' st'a' where ****: "local.load cp pl el e\<^sub>p e\<^sub>v'' cd'' st''' e\<^sub>v cd st''= Normal ((ev', cda', sta'), st'a')" by (auto split: result.split_asm)
       ultimately have "ev = ev'" and "sta = sta'" and "st'a = st'a'" by simp+
       
       from **** asm have IH: "(frame bal st''' \<longrightarrow> frame bal sta') \<and>
         (frame bal st'' \<longrightarrow> frame bal st'a') \<and> 
         address e\<^sub>v'' = address ev' \<and> sender e\<^sub>v'' = sender ev' \<and> svalue e\<^sub>v'' = svalue ev'" using 30(2)[OF ** _ _ _ ***, of st'' "()" cd'' e\<^sub>v'' st''' st''' "()" st''] apply safe by (auto simp add:frame_def)
       show "(frame bal st' \<longrightarrow> frame bal sta) \<and> (frame bal st \<longrightarrow> frame bal st'a) \<and> address e\<^sub>v' = address ev \<and> sender e\<^sub>v' = sender ev \<and> svalue e\<^sub>v' = svalue ev"
       proof (rule conj3)
         show "frame bal st' \<longrightarrow> frame bal sta"
         proof
           assume "frame bal st'"
           with * ** *** have "frame bal st'''" using decl_frame by simp
           with IH have "frame bal sta'" by simp
           with `sta = sta'` show "frame bal sta" by simp
         qed
       next
         show "frame bal st \<longrightarrow> frame bal st'a"
         proof
           assume "frame bal st"
           with ** have "frame bal st''" using 30(1) asm by simp
           with IH have "frame bal st'a'" by simp
           with `st'a = st'a'` show "frame bal st'a" by simp
         qed
       next
         from ad IH show "address e\<^sub>v' = address ev \<and> sender e\<^sub>v' = sender ev \<and> svalue e\<^sub>v' = svalue ev" using `ev = ev'` by simp
       qed
     qed
   qed
 next
   case (31 vv vw vx vy vz wa wb wc wd st)
   then show ?case by simp
 next
   case (32 we wf wg wh wi wj wk wl wm st)
   then show ?case by simp
 next
   case (33 wn wo e\<^sub>v' cd' st' e\<^sub>v cd st)
   then show ?case by simp
 next
   case (34 i e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv3 and st3' and bal
       assume *: "frame bal st \<and> local.rexp (L.Id i) e\<^sub>p e cd st = Normal (rv3, st3')"
       show "frame bal st3'"
       proof (cases "fmlookup (denvalue e) i")
         case None
         with * show ?thesis by simp
       next
         case (Some a)
         then show ?thesis
         proof (cases a)
           case (Pair tp b)
           then show ?thesis
           proof (cases b)
             case (Stackloc l)
             then show ?thesis
             proof (cases "accessStore l (stack st)")
               case None
               with * Some Pair Stackloc show ?thesis by (auto split: Type.split_asm STypes.split_asm)
             next
               case s2: (Some a)
               with * Some Pair Stackloc s2 show ?thesis by (auto split: Type.split_asm STypes.split_asm Stackvalue.split_asm)
             qed
           next
             case (Storeloc x2)
             with * Some Pair Storeloc show ?thesis by (auto split: Type.split_asm STypes.split_asm option.split_asm)
           qed
         qed
       qed
     qed
   qed
 next
   case (35 i r e\<^sub>p e cd st)
   show ?case (is "_ \<longrightarrow> ?RHS")
   proof
     assume asm: "address e \<noteq> (STR ''Victim'') \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)"
     show ?RHS
     proof (rule allI[OF allI[OF allI[OF impI]]])
       fix rv3 and st3' and bal
       assume *: "frame bal st \<and> local.rexp (L.Ref i r) e\<^sub>p e cd st = Normal (rv3, st3')"
       show "frame bal st3'"
       proof (cases "fmlookup (denvalue e) i")
         case None
         with * show ?thesis by simp
       next
         case (Some a)
         then show ?thesis
         proof (cases a)
           case (Pair tp b)
           then show ?thesis
           proof (cases b)
             case (Stackloc l')
             then show ?thesis
             proof (cases "accessStore l' (stack st)")
               case None
               with * Some Pair Stackloc show ?thesis by simp
             next
               case s2: (Some a)
               then show ?thesis
               proof (cases a)
                 case (KValue x1)
                 with * Some Pair Stackloc s2 show ?thesis by simp
               next
                 case (KCDptr l'')
                 then show ?thesis
                 proof (cases tp)
                   case (Value x1)
                   with * Some Pair Stackloc s2 KCDptr show ?thesis by simp
                 next
                   case (Calldata t)
                   with * Some Pair Stackloc s2 KCDptr obtain l''' t' st' where **: "msel False t l'' r e\<^sub>p e cd st = Normal ((l''',t'), st')" by (auto split: Type.split_asm STypes.split_asm result.split_asm)
                   then have "\<forall>rv1 st1' bal.
                   frame bal st \<and>
                   local.msel False t l'' r e\<^sub>p e cd st = Normal (rv1, st1') \<longrightarrow>
                   frame bal st1'" using asm 35(1)[OF Some Pair Stackloc _ s2 KCDptr Calldata] by auto
                   with * ** have f2: "frame bal st'" by blast
                   then show ?thesis
                   proof (cases t')
                     case (MTArray x t'')
                     then show ?thesis
                     proof (cases "accessStore l''' cd")
                       case None
                       with * ** Some Pair Stackloc s2 KCDptr Calldata MTArray show ?thesis by simp
                     next
                       case s3: (Some a)
                       then show ?thesis
                       proof (cases a)
                         case (MValue x1)
                         with * ** Some Pair Stackloc s2 KCDptr Calldata MTArray s3 show ?thesis by simp
                       next
                         case (MPointer x2)
                         with * ** f2 Some Pair Stackloc s2 KCDptr Calldata MTArray s3 show ?thesis by simp
                       qed
                     qed
                   next
                     case (MTValue t''')
                     then show ?thesis
                     proof (cases "accessStore l''' cd")
                       case None
                       with * ** Some Pair Stackloc s2 KCDptr Calldata MTValue show ?thesis by simp
                     next
                       case s3: (Some a)
                       then show ?thesis
                       proof (cases a)
                         case (MValue x1)
                         with * ** f2 Some Pair Stackloc s2 KCDptr Calldata MTValue s3 show ?thesis by simp
                       next
                         case (MPointer x2)
                         with * ** Some Pair Stackloc s2 KCDptr Calldata MTValue s3 show ?thesis by simp
                       qed
                     qed
                   qed
                 next
                   case (Memory x3)
                   with * Some Pair Stackloc s2 KCDptr show ?thesis by simp
                 next
                   case (Storage x4)
                   with * Some Pair Stackloc s2 KCDptr show ?thesis by simp
                 qed
               next
                 case (KMemptr l'')
                 then show ?thesis
                 proof (cases tp)
                   case (Value x1)
                   with * Some Pair Stackloc s2 KMemptr show ?thesis by simp
                 next
                   case (Calldata x2)
                   with * Some Pair Stackloc s2 KMemptr show ?thesis by simp
                 next
                   case (Memory t)
                   with * Some Pair Stackloc s2 KMemptr obtain l''' t' st' where **: "msel True t l'' r e\<^sub>p e cd st = Normal ((l''',t'), st')" by (auto split: Type.split_asm STypes.split_asm result.split_asm)
                   then have "\<forall>rv1 st1' bal. frame bal st \<and>
                   local.msel True t l'' r e\<^sub>p e cd st = Normal (rv1, st1') \<longrightarrow>
                   frame bal st1'" using asm 35(2)[OF Some Pair Stackloc _ s2 KMemptr Memory, of st] by auto
                   with * ** have f2: "frame bal st'" by blast
                   then show ?thesis
                   proof (cases t')
                     case (MTArray x11 x12)
                     then show ?thesis
                     proof (cases "accessStore l''' (memory st')")
                       case None
                       with * ** Some Pair Stackloc s2 KMemptr Memory MTArray show ?thesis by simp
                     next
                       case s3: (Some a)
                       then show ?thesis
                       proof (cases a)
                         case (MValue x1)
                         with * ** Some Pair Stackloc s2 KMemptr Memory MTArray s3 show ?thesis by simp
                       next
                         case (MPointer x2)
                         with * ** f2 Some Pair Stackloc s2 KMemptr Memory MTArray s3 show ?thesis by simp
                       qed
                     qed
                   next
                     case (MTValue x2)
                     then show ?thesis
                     proof (cases "accessStore l''' (memory st')")
                       case None
                       with * ** Some Pair Stackloc s2 KMemptr Memory MTValue show ?thesis by simp
                     next
                       case s3: (Some a)
                       then show ?thesis
                       proof (cases a)
                         case (MValue x1)
                         with * ** f2 Some Pair Stackloc s2 KMemptr Memory MTValue s3 show ?thesis by simp
                       next
                         case (MPointer x2)
                         with * ** Some Pair Stackloc s2 KMemptr Memory MTValue s3 show ?thesis by simp
                       qed
                     qed
                   qed
                 next
                   case (Storage x4)
                   with * Some Pair Stackloc s2 KMemptr show ?thesis by simp
                 qed
               next
                 case (KStoptr l'')
                 then show ?thesis
                 proof (cases tp)
                   case (Value x1)
                   with * Some Pair Stackloc s2 KStoptr show ?thesis by simp
                 next
                   case (Calldata x2)
                   with * Some Pair Stackloc s2 KStoptr show ?thesis by simp
                 next
                   case (Memory x3)
                   with * Some Pair Stackloc s2 KStoptr show ?thesis by simp
                 next
                   case (Storage t)
                   with * Some Pair Stackloc s2 KStoptr obtain l''' t' st' where **: "ssel t l'' r e\<^sub>p e cd st = Normal ((l''',t'), st')" by (auto split: Type.split_asm STypes.split_asm result.split_asm)
                   then have "\<forall>rv2 st2' bal.
                   frame bal st \<and>
                   local.ssel t l'' r e\<^sub>p e cd st = Normal (rv2, st2') \<longrightarrow>
                   frame bal st2'" using asm 35(3)[OF Some Pair Stackloc _ s2 KStoptr Storage, of st] by auto
                   with * ** have "frame bal st'" by blast
                   with * ** Some Pair Stackloc s2 KStoptr Storage show ?thesis by (simp split: STypes.split_asm option.split_asm)
                 qed
               qed
             qed
           next
             case (Storeloc l')
             then show ?thesis
             proof (cases tp)
               case (Value x1)
               with * Some Pair Storeloc show ?thesis by simp
             next
               case (Calldata x2)
               with * Some Pair Storeloc show ?thesis by simp
             next
               case (Memory x3)
               with * Some Pair Storeloc show ?thesis by simp
             next
               case (Storage t)
               with * Some Pair Storeloc obtain l'' t' st' where **: "ssel t l' r e\<^sub>p e cd st = Normal ((l'',t'), st')" by (auto split: result.split_asm)
               then have "\<forall>rv2 st2' bal.
               frame bal st \<and>
               local.ssel t l' r e\<^sub>p e cd st = Normal (rv2, st2') \<longrightarrow>
               frame bal st2'" using asm 35(4)[OF Some Pair Storeloc Storage] by auto
               with * ** have "frame bal st'" by blast
               with * ** Some Pair Storeloc Storage show ?thesis by (simp split: STypes.split_asm option.split_asm)
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (36 e\<^sub>p e cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume *: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st6'
       show "?RHS st6'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume t0: "stmt SKIP e\<^sub>p e cd st = Normal ((), st6')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume ad: "address e \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st6'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st6'"
               proof
                 assume "frame bal st"
                 with t0 * show "frame bal st6'" by (auto simp add: frame_def split:if_split_asm)
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume "address e = STR ''Victim''"
             show ?RHS (is "?A \<and> (?B \<and> ?C)")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (37 lv ex e\<^sub>p env cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume 0: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st6'
       show "?RHS st6'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume *: "stmt (ASSIGN lv ex) e\<^sub>p env cd st = Normal ((), st6')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume asm: "address env \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st6'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st6'"
               proof
                 assume "frame bal st"
                 with * have a1: "(applyf (costs (ASSIGN lv ex) e\<^sub>p env cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>)))) st =
                   Normal ((), st\<lparr>gas:=gas st - costs (ASSIGN lv ex) e\<^sub>p env cd st\<rparr>)" 
                   and f1: "frame bal (st\<lparr>gas:=gas st - costs (ASSIGN lv ex) e\<^sub>p env cd st\<rparr>)" by (auto simp add:frame_def)
                 moreover from * obtain kv kt st' where **: "expr ex e\<^sub>p env cd (st\<lparr>gas:=gas st - costs (ASSIGN lv ex) e\<^sub>p env cd st\<rparr>) = Normal ((kv, kt), st')" by (auto split:if_split_asm result.split_asm)
                 ultimately have "\<forall>rv4 st4' (ev4'::Environment) bal.
                   frame bal (st\<lparr>gas := gas st - costs (ASSIGN lv ex) e\<^sub>p env cd st\<rparr>) \<and>
                   local.expr ex e\<^sub>p env cd (st\<lparr>gas := gas st - costs (ASSIGN lv ex) e\<^sub>p env cd st\<rparr>) = Normal (rv4, st4') \<longrightarrow>
                   frame bal st4'" using asm 0 37(1) by simp
                 with f1 ** have f2: "frame bal st'" by blast
                 show "frame bal st6'"
                 proof (cases kv)
                   case (KValue v)
                   then show ?thesis
                   proof (cases kt)
                     case (Value t)
                     with * ** KValue obtain rv rt st'' where ***: "lexp lv e\<^sub>p env cd st' = Normal ((rv,rt), st'')" by (auto split:if_split_asm result.split_asm)
                     with KValue Value have "\<forall>rv5 st5' (ev5'::Environment) bal.
                     frame bal st' \<and>
                     local.lexp lv e\<^sub>p env cd st' = Normal (rv5, st5') \<longrightarrow>
                     frame bal st5'" using asm 0 37(2)[OF a1 **] by simp
                     with f2 *** have f3: "frame bal st''" by blast
                     then show ?thesis
                     proof (cases rv)
                       case (LStackloc l')
                       then show ?thesis
                       proof (cases rt)
                         case v2: (Value t')
                         then show ?thesis
                         proof (cases "Valuetypes.convert t t' v")
                           case None
                           with * ** *** KValue Value LStackloc v2 show ?thesis by (auto split:if_split_asm)
                         next
                           case (Some a)
                           then show ?thesis
                           proof (cases a)
                             case (Pair v' b)
                             with * ** *** KValue Value LStackloc v2 Some have "st6' = st'' \<lparr>stack := updateStore l' (KValue v') (stack st'')\<rparr>" by (auto split:if_split_asm)
                             with f3 show ?thesis by (simp add:frame_def)
                           qed
                         qed
                       next
                         case (Calldata x2)
                         with * ** *** KValue Value LStackloc show ?thesis by (auto split:if_split_asm)
                       next
                         case (Memory x3)
                         with * ** *** KValue Value LStackloc show ?thesis by (auto split:if_split_asm)
                       next
                         case (Storage x4)
                         with * ** *** KValue Value LStackloc show ?thesis by (auto split:if_split_asm)
                       qed
                     next
                       case (LMemloc l')
                       then show ?thesis
                       proof (cases rt)
                         case v2: (Value t')
                         with * ** *** KValue Value LMemloc show ?thesis by (auto split:if_split_asm)
                       next
                         case (Calldata x2)
                         with * ** *** KValue Value LMemloc show ?thesis by (auto split:if_split_asm)
                       next
                         case (Memory x3)
                         then show ?thesis
                         proof (cases x3)
                           case (MTArray x11 x12)
                           with * ** *** KValue Value LMemloc Memory show ?thesis by (auto split:if_split_asm)
                         next
                           case (MTValue t')
                           then show ?thesis
                           proof (cases "Valuetypes.convert t t' v")
                             case None
                             with * ** *** KValue Value LMemloc Memory MTValue show ?thesis by (auto split:if_split_asm)
                           next
                             case (Some a)
                             then show ?thesis
                             proof (cases a)
                               case (Pair v' b)
                               with * ** *** KValue Value LMemloc Memory MTValue Some have "st6' = st'' \<lparr>memory := updateStore l' (MValue v') (memory st'')\<rparr>" by (auto split:if_split_asm)
                               with f3 show ?thesis by (simp add:frame_def)
                             qed
                           qed
                         qed
                       next
                         case (Storage x4)
                         with * ** *** KValue Value LMemloc Storage show ?thesis by (auto split:if_split_asm)
                       qed
                     next
                       case (LStoreloc l')
                       then show ?thesis
                       proof (cases rt)
                         case v2: (Value x1)
                         with * ** *** KValue Value LStoreloc show ?thesis by (auto split:if_split_asm)
                       next
                         case (Calldata x2)
                         with * ** *** KValue Value LStoreloc show ?thesis by (auto split:if_split_asm)
                       next
                         case (Memory x3)
                         with * ** *** KValue Value LStoreloc show ?thesis by (auto split:if_split_asm)
                       next
                         case (Storage x4)
                         then show ?thesis
                         proof (cases x4)
                           case (STArray x11 x12)
                           with * ** *** KValue Value LStoreloc Storage show ?thesis by (auto split:if_split_asm)
                         next
                           case (STMap x21 x22)
                           with * ** *** KValue Value LStoreloc Storage show ?thesis by (auto split:if_split_asm)
                         next
                           case (STValue t')
                           then show ?thesis
                           proof (cases "Valuetypes.convert t t' v")
                             case None
                             with * ** *** KValue Value LStoreloc Storage STValue show ?thesis by (auto split:if_split_asm)
                           next
                             case (Some a)
                             then show ?thesis
                             proof (cases a)
                               case (Pair v' b)
                               then show ?thesis
                               proof (cases "fmlookup (storage st'') (address env)")
                                 case None
                                 with * ** *** KValue Value LStoreloc Storage STValue Some Pair show ?thesis by (auto split:if_split_asm)
                               next
                                 case s2: (Some s)
                                 with * ** *** KValue Value LStoreloc Storage STValue Some Pair have "st6' = st''\<lparr>storage := fmupd (address env) (fmupd l' v' s) (storage st'')\<rparr>" by (auto split:if_split_asm)
                                 with f3 show ?thesis using asm by (simp add:frame_def)
                               qed
                             qed
                           qed
                         qed
                       qed
                     qed
                   next
                     case (Calldata x2)
                     with * ** KValue show ?thesis by (auto split:if_split_asm)
                   next
                     case (Memory x3)
                     with * ** KValue show ?thesis by (auto split:if_split_asm)
                   next
                     case (Storage x4)
                     with * ** KValue show ?thesis by (auto split:if_split_asm)
                   qed
                 next
                   case (KCDptr p)
                   then show ?thesis
                   proof (cases kt)
                     case (Value t)
                     with * ** KCDptr show ?thesis by (auto split:if_split_asm)
                   next
                     case (Calldata x2)
                     then show ?thesis
                     proof (cases x2)
                       case (MTArray x t)
                       with * ** KCDptr Calldata obtain rv rt st'' where ***: "lexp lv e\<^sub>p env cd st' = Normal ((rv,rt), st'')" by (auto split:if_split_asm result.split_asm)
                       with KCDptr Calldata MTArray have "\<forall>rv5 st5' (ev5'::Environment) bal.
                       frame bal st' \<and>
                       local.lexp lv e\<^sub>p env cd st' = Normal (rv5, st5') \<longrightarrow>
                       frame bal st5'" using asm 0 37(3)[OF a1 **] by auto
                       with f2 *** have f3: "frame bal st''" by blast
                       then show ?thesis
                       proof (cases rv)
                         case (LStackloc l')
                         then show ?thesis
                         proof (cases rt)
                           case (Value x1)
                           with * ** *** KCDptr Calldata MTArray LStackloc show ?thesis by (auto split:if_split_asm)
                         next
                           case c2: (Calldata x2)
                           with * ** *** KCDptr Calldata MTArray LStackloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Memory x3)
                           with f3 * ** *** KCDptr Calldata MTArray LStackloc show ?thesis by (auto simp add:frame_def split:if_split_asm)
                         next
                           case (Storage x4)
                           then show ?thesis
                           proof (cases "accessStore l' (stack st'')")
                             case None
                             with * ** *** KCDptr Calldata MTArray LStackloc Storage show ?thesis by (simp split:if_split_asm)
                           next
                             case (Some sv)
                             then show ?thesis
                             proof (cases sv)
                               case (KValue x1)
                               with * ** *** KCDptr Calldata MTArray LStackloc Storage Some show ?thesis by (simp split:if_split_asm)
                             next
                               case c2: (KCDptr x2)
                               with * ** *** KCDptr Calldata MTArray LStackloc Storage Some show ?thesis by (simp split:if_split_asm)
                             next
                               case (KMemptr x3)
                               with * ** *** KCDptr Calldata MTArray LStackloc Storage Some show ?thesis by (simp split:if_split_asm)
                             next
                               case (KStoptr p')
                               then show ?thesis
                               proof (cases "fmlookup (storage st'') (address env)")
                                 case None
                                 with * ** *** KCDptr Calldata MTArray LStackloc Storage Some KStoptr show ?thesis by (simp split:if_split_asm)
                               next
                                 case s2: (Some s)
                                 then show ?thesis
                                 proof (cases "cpm2s p p' x t cd s")
                                   case None
                                   with * ** *** KCDptr Calldata MTArray LStackloc Storage Some KStoptr s2 show ?thesis by (simp split:if_split_asm)
                                 next
                                   case s3: (Some s')
                                   with * ** *** KCDptr Calldata MTArray LStackloc Storage Some KStoptr s2 have "st6' = st'' \<lparr>storage := fmupd (address env) s' (storage st'')\<rparr>" by (auto split:if_split_asm)
                                   with f3 show ?thesis using asm by (simp add:frame_def)
                                 qed
                               qed
                             qed
                           qed
                         qed
                       next
                         case (LMemloc l')
                         then show ?thesis
                         proof (cases "cpm2m p l' x t cd (memory st'')")
                           case None
                           with * ** *** KCDptr Calldata MTArray LMemloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Some m)
                           with * ** *** KCDptr Calldata MTArray LMemloc have "st6' = st'' \<lparr>memory := m\<rparr>" by (auto split:if_split_asm)
                           with f3 show ?thesis using asm by (simp add:frame_def)
                         qed
                       next
                         case (LStoreloc l')
                         then show ?thesis
                         proof (cases "fmlookup (storage st'') (address env)")
                           case None
                           with * ** *** KCDptr Calldata MTArray LStoreloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Some s)
                           then show ?thesis
                           proof (cases "cpm2s p l' x t cd s")
                             case None
                             with * ** *** KCDptr Calldata MTArray LStoreloc Some show ?thesis by (auto split:if_split_asm)
                           next
                             case s2: (Some s')
                             with * ** *** KCDptr Calldata MTArray LStoreloc Some s2 have "st6' = st'' \<lparr>storage := fmupd (address env) s' (storage st'')\<rparr>" by (auto split:if_split_asm)
                             with f3 show ?thesis using asm by (simp add:frame_def)
                           qed
                         qed
                       qed
                     next
                       case (MTValue x2)
                       with * ** KCDptr Calldata show ?thesis by (simp split:if_split_asm)
                     qed
                   next
                     case (Memory x3)
                     with * ** KCDptr show ?thesis by (simp split:if_split_asm)
                   next
                     case (Storage x4)
                     with * ** KCDptr show ?thesis by (simp split:if_split_asm)
                   qed
                 next
                   case (KMemptr p)
                   then show ?thesis
                   proof (cases kt)
                     case (Value t)
                     with * ** KMemptr show ?thesis by (auto split:if_split_asm)
                   next
                     case (Calldata x2)
                     with * ** KMemptr show ?thesis by (simp split:if_split_asm)
                   next
                     case (Memory x3)
                     then show ?thesis
                     proof (cases x3)
                       case (MTArray x t)
                       with * ** KMemptr Memory obtain rv rt st'' where ***: "lexp lv e\<^sub>p env cd st' = Normal ((rv,rt), st'')" by (auto split:if_split_asm result.split_asm)
                       with KMemptr Memory MTArray have "\<forall>rv5 st5' (ev5'::Environment) bal.
                       frame bal st' \<and>
                       local.lexp lv e\<^sub>p env cd st' = Normal (rv5, st5') \<longrightarrow>
                       frame bal st5'" using asm 0 37(4)[OF a1 **] by auto
                       with f2 *** have f3: "frame bal st''" by blast
                       then show ?thesis
                       proof (cases rv)
                         case (LStackloc l')
                         then show ?thesis
                         proof (cases rt)
                           case (Value x1)
                           with * ** *** KMemptr Memory MTArray LStackloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Calldata x2)
                           with * ** *** KMemptr Memory MTArray LStackloc show ?thesis by (auto split:if_split_asm)
                         next
                           case m3: (Memory x3)
                           with f3 * ** *** KMemptr Memory MTArray LStackloc show ?thesis by (auto simp add:frame_def split:if_split_asm)
                         next
                           case (Storage x4)
                           then show ?thesis
                           proof (cases "accessStore l' (stack st'')")
                             case None
                             with * ** *** KMemptr Memory MTArray LStackloc Storage show ?thesis by (simp split:if_split_asm)
                           next
                             case (Some sv)
                             then show ?thesis
                             proof (cases sv)
                               case (KValue x1)
                               with * ** *** KMemptr Memory MTArray LStackloc Storage Some show ?thesis by (simp split:if_split_asm)
                             next
                               case (KCDptr x2)
                               with * ** *** KMemptr Memory MTArray LStackloc Storage Some show ?thesis by (simp split:if_split_asm)
                             next
                               case m2: (KMemptr x3)
                               with * ** *** KMemptr Memory MTArray LStackloc Storage Some show ?thesis by (simp split:if_split_asm)
                             next
                               case (KStoptr p')
                               then show ?thesis
                               proof (cases "fmlookup (storage st'') (address env)")
                                 case None
                                 with * ** *** KMemptr Memory MTArray LStackloc Storage Some KStoptr show ?thesis by (simp split:if_split_asm)
                               next
                                 case s2: (Some s)
                                 then show ?thesis
                                 proof (cases "cpm2s p p' x t (memory st'') s")
                                   case None
                                   with * ** *** KMemptr Memory MTArray LStackloc Storage Some KStoptr s2 show ?thesis by (simp split:if_split_asm)
                                 next
                                   case s3: (Some s')
                                   with * ** *** KMemptr Memory MTArray LStackloc Storage Some KStoptr s2 have "st6' = st'' \<lparr>storage := fmupd (address env) s' (storage st'')\<rparr>" by (auto split:if_split_asm)
                                   with f3 show ?thesis using asm by (simp add:frame_def)
                                 qed
                               qed
                             qed
                           qed
                         qed
                       next
                         case (LMemloc l')
                         with * ** *** KMemptr Memory MTArray LMemloc have "st6' = st'' \<lparr>memory := updateStore l' (MPointer p) (memory st'')\<rparr>" by (auto split:if_split_asm)
                         with f3 show ?thesis using asm by (simp add:frame_def)
                       next
                         case (LStoreloc l')
                         then show ?thesis
                         proof (cases "fmlookup (storage st'') (address env)")
                           case None
                           with * ** *** KMemptr Memory MTArray LStoreloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Some s)
                           then show ?thesis
                           proof (cases "cpm2s p l' x t (memory st'') s")
                             case None
                             with * ** *** KMemptr Memory MTArray LStoreloc Some show ?thesis by (auto split:if_split_asm)
                           next
                             case s2: (Some s')
                             with * ** *** KMemptr Memory MTArray LStoreloc Some s2 have "st6' = st'' \<lparr>storage := fmupd (address env) s' (storage st'')\<rparr>" by (auto split:if_split_asm)
                             with f3 show ?thesis using asm by (simp add:frame_def)
                           qed
                         qed
                       qed
                     next
                       case (MTValue x2)
                       with * ** KMemptr Memory show ?thesis by (simp split:if_split_asm)
                     qed
                   next
                     case (Storage x4)
                     with * ** KMemptr show ?thesis by (simp split:if_split_asm)
                   qed
                 next
                   case (KStoptr p)
                   then show ?thesis
                   proof (cases kt)
                     case (Value t)
                     with * ** KStoptr show ?thesis by (auto split:if_split_asm)
                   next
                     case (Calldata x2)
                     with * ** KStoptr show ?thesis by (simp split:if_split_asm)
                   next
                     case (Storage x3)
                     then show ?thesis
                     proof (cases x3)
                       case (STArray x t)
                       with * ** KStoptr Storage obtain rv rt st'' where ***: "lexp lv e\<^sub>p env cd st' = Normal ((rv,rt), st'')" by (auto split:if_split_asm result.split_asm)
                       with KStoptr Storage STArray have "\<forall>rv5 st5' bal.
                       frame bal st' \<and>
                       local.lexp lv e\<^sub>p env cd st' = Normal (rv5, st5') \<longrightarrow>
                       frame bal st5'" using asm 0 37(5)[OF a1 **] by auto
                       with f2 *** have f3: "frame bal st''" by blast
                       then show ?thesis
                       proof (cases rv)
                         case (LStackloc l')
                         then show ?thesis
                         proof (cases rt)
                           case (Value x1)
                           with * ** *** KStoptr Storage STArray LStackloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Calldata x2)
                           with * ** *** KStoptr Storage STArray LStackloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Memory x3)
                           then show ?thesis
                           proof (cases "accessStore l' (stack st'')")
                             case None
                             with * ** *** KStoptr Storage STArray LStackloc Memory show ?thesis by (simp split:if_split_asm)
                           next
                             case (Some sv)
                             then show ?thesis
                             proof (cases sv)
                               case (KValue x1)
                               with * ** *** KStoptr Storage STArray LStackloc Memory Some show ?thesis by (simp split:if_split_asm)
                             next
                               case (KCDptr x2)
                               with * ** *** KStoptr Storage STArray LStackloc Memory Some show ?thesis by (simp split:if_split_asm)
                             next
                               case (KMemptr p')
                               then show ?thesis
                               proof (cases "fmlookup (storage st'') (address env)")
                                 case None
                                 with * ** *** KStoptr Storage STArray LStackloc Memory Some KMemptr show ?thesis by (simp split:if_split_asm)
                               next
                                 case s2: (Some s)
                                 then show ?thesis
                                 proof (cases "cps2m p p' x t s (memory st'')")
                                   case None
                                   with * ** *** KStoptr Storage STArray LStackloc Memory Some KMemptr s2 show ?thesis by (simp split:if_split_asm)
                                 next
                                   case s3: (Some m)
                                   with * ** *** KStoptr Storage STArray LStackloc Memory Some KMemptr s2 have "st6' = st'' \<lparr>memory := m\<rparr>" by (auto split:if_split_asm)
                                   with f3 show ?thesis using asm by (simp add:frame_def)
                                 qed
                               qed
                             next
                               case m2: (KStoptr x3)
                               with * ** *** KStoptr Storage STArray LStackloc Memory Some show ?thesis by (simp split:if_split_asm)
                             qed
                           qed
                         next
                           case st2: (Storage x4)
                           with f3 * ** *** KStoptr Storage STArray LStackloc show ?thesis by (auto simp add:frame_def split:if_split_asm)
                         qed
                       next
                         case (LStoreloc l')
                         then show ?thesis
                         proof (cases "fmlookup (storage st'') (address env)")
                           case None
                           with * ** *** KStoptr Storage STArray LStoreloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Some s)
                           then show ?thesis
                           proof (cases "copy p l' x t s")
                             case None
                             with * ** *** KStoptr Storage STArray LStoreloc Some show ?thesis by (auto split:if_split_asm)
                           next
                             case s2: (Some s')
                             with * ** ***  KStoptr Storage STArray LStoreloc Some s2 have "st6' = st'' \<lparr>storage := fmupd (address env) s' (storage st'')\<rparr>" by (auto split:if_split_asm)
                             with f3 show ?thesis using asm by (simp add:frame_def)
                           qed
                         qed
                       next
                         case (LMemloc l')
                         then show ?thesis
                         proof (cases "fmlookup (storage st'') (address env)")
                           case None
                           with * ** *** KStoptr Storage STArray LMemloc show ?thesis by (auto split:if_split_asm)
                         next
                           case (Some s)
                           then show ?thesis
                           proof (cases "cps2m p l' x t s (memory st'')")
                             case None
                             with * ** *** KStoptr Storage STArray LMemloc Some show ?thesis by (auto split:if_split_asm)
                           next
                             case s2: (Some m)
                             with * ** ***  KStoptr Storage STArray LMemloc Some s2 have "st6' = st'' \<lparr>memory := m\<rparr>" by (auto split:if_split_asm)
                             with f3 show ?thesis using asm by (simp add:frame_def)
                           qed
                         qed
                       qed
                     next
                       case (STMap t t')
                       with * ** KStoptr Storage obtain l' rt st'' where ***: "lexp lv e\<^sub>p env cd st' = Normal ((LStackloc l',rt), st'')" by (auto split:if_split_asm result.split_asm LType.split_asm)
                       with KStoptr Storage STMap have "\<forall>rv5 st5' (ev5'::Environment) bal.
                       frame bal st' \<and>
                       local.lexp lv e\<^sub>p env cd st' = Normal (rv5, st5') \<longrightarrow>
                       frame bal st5'" using asm 0 37(6)[OF a1 **] by auto
                       with f2 *** have f3: "frame bal st''" by blast
                       moreover from * ** *** KStoptr Storage STMap have "st6' = st'' \<lparr>stack := updateStore l' (KStoptr p) (stack st'')\<rparr>" by (auto split:if_split_asm)
                       ultimately show ?thesis using asm f3 by (simp add:frame_def)
                     next
                       case (STValue x2)
                       with * ** KStoptr Storage show ?thesis by (simp split:if_split_asm)
                     qed
                   next
                     case (Memory x4)
                     with * ** KStoptr show ?thesis by (simp split:if_split_asm)
                   qed
                 qed
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume "address env = STR ''Victim''"
             show ?RHS (is "?A \<and> (?B \<and> ?C)")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (38 s1 s2 e\<^sub>p e cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume 0: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st6'
       show "?RHS st6'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume *: "stmt (COMP s1 s2) e\<^sub>p e cd st = Normal ((), st6')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume asm: "address e \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st6'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st6'"
               proof
                 assume "frame bal st"
                 with * have a1: "(applyf (costs (COMP s1 s2) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>)))) st =
                   Normal ((), st\<lparr>gas:=gas st - costs (COMP s1 s2) e\<^sub>p e cd st\<rparr>)" 
                   and f1: "frame bal (st\<lparr>gas:=gas st - costs (COMP s1 s2) e\<^sub>p e cd st\<rparr>)" by (auto simp add:frame_def)
                 then have "\<forall>rv4 st4' bal.
                   frame bal (st\<lparr>gas := gas st - costs (COMP s1 s2) e\<^sub>p e cd st\<rparr>) \<and>
                   stmt s1 e\<^sub>p e cd (st\<lparr>gas := gas st - costs (COMP s1 s2) e\<^sub>p e cd st\<rparr>) = Normal (rv4, st4') \<longrightarrow>
                   frame bal st4'" using asm 0 38(1) by (simp add:frame_def)
                 moreover from * obtain st' where **: "stmt s1 e\<^sub>p e cd (st\<lparr>gas:=gas st - costs (COMP s1 s2) e\<^sub>p e cd st\<rparr>) = Normal ((), st')" by (auto split:if_split_asm result.split_asm)
                 ultimately have f2: "frame bal st'" using f1 by blast
                 
                 have "\<forall>rv4 st4' bal.
                   frame bal st' \<and>
                   stmt s2 e\<^sub>p e cd st' = Normal (rv4, st4') \<longrightarrow>
                   frame bal st4'" using asm 0 38(2)[OF a1 **]  by (simp add:frame_def)
                 moreover from * ** obtain st'' where ***: "stmt s2 e\<^sub>p e cd st' = Normal ((), st'')" by (auto split:if_split_asm result.split_asm)
                 ultimately have f3: "frame bal st''" using f2 by blast
           
                 from a1 * ** *** have "st6' = st''" by (simp split:if_split_asm)
                 with f3 asm show "frame bal st6'" by simp
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume ad: "address e = STR ''Victim''"
             show ?RHS (is "?A \<and> ?B \<and> ?C")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS(is "?A1 \<and> ?A2 \<and> ?A3 \<and> ?A4 \<and> ?A5 \<and> ?A6")
                   then have ?A1 and ?A2 and ?A3 and ?A4 and ?A5 and ?A6 by auto
                   with * have c1: "gas st > costs comp e\<^sub>p e cd st" by (auto split:if_split_asm)
                   with `?A1` * obtain st'' where 00: "stmt assign e\<^sub>p e cd (st\<lparr>gas := gas st - costs comp e\<^sub>p e cd st\<rparr>) = Normal((), st'')" by (auto split:result.split_asm)
                   moreover from `?A2` have "fmlookup (storage (st\<lparr>gas := gas st - costs comp e\<^sub>p e cd st\<rparr>)) (STR ''Victim'') = Some s" by simp
                   moreover from `?A2` have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st\<lparr>gas := gas st - costs comp e\<^sub>p e cd st\<rparr>)) (STR ''Victim'')) - (SUMM s) \<ge> bal \<and> bal \<ge> 0" by simp
                   moreover from `?A3` have "POS s" by simp
                   moreover from `?A6` have "accessStore x (stack (st\<lparr>gas := gas st - costs comp e\<^sub>p e cd st\<rparr>)) = Some (KValue (accessStorage (TUInt 256) (sender e + (STR ''.'' + STR ''balance'')) s))" by simp
                   ultimately obtain s'' where "fmlookup (storage st'') (STR ''Victim'') = Some s''"
                       and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'') (STR ''Victim'')) - (SUMM s'' + ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender e + (STR ''.'' + STR ''balance'')) s)) \<ge> bal \<and> bal \<ge> 0"
                       and **: "accessStore x (stack st'') = Some (KValue (accessStorage (TUInt 256) (sender e + (STR ''.'' + STR ''balance'')) s))"
                       and "POS s''"
                     using secureassign[OF 00 _ ad `?A5`] that by blast
                   moreover from c1 `?A1` * 00 obtain st''' where ***: "stmt transfer e\<^sub>p e cd st'' = Normal((), st''')" and "st6' = st'''" by auto
     
                   moreover from `?A1` 00 have x1: "stmt s1 e\<^sub>p e cd (st\<lparr>gas := gas st - costs (COMP s1 s2) e\<^sub>p e cd st\<rparr>) = Normal((), st'')" by simp
                   moreover from * have x2: "(applyf (costs (COMP s1 s2) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas
                                                      (\<lambda>st. gas st \<le> g)
                                                      (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))
                    st = Normal ((), st\<lparr>gas:=gas st - costs (COMP s1 s2) e\<^sub>p e cd st\<rparr>)" by (simp split: if_split_asm)
                   ultimately show "\<exists>s'. fmlookup (storage st6') (STR ''Victim'') = Some s'
                       \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st6') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s'"
                     using 38(2)[OF x2 x1] `?A1` `?A4` ad 0 ** `?A6` by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (39 ex s1 s2 e\<^sub>p e cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume 0: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st6'
       show "?RHS st6'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume *: "stmt (ITE ex s1 s2) e\<^sub>p e cd st = Normal ((), st6')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume asm: "address e \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st6'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st6'"
               proof
                 assume "frame bal st"
                 with * have a1: "(applyf (costs (ITE ex s1 s2) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>)))) st =
                 Normal ((), st\<lparr>gas:=gas st - costs (ITE ex s1 s2) e\<^sub>p e cd st\<rparr>)" 
                 and f1: "frame bal (st\<lparr>gas:=gas st - costs (ITE ex s1 s2) e\<^sub>p e cd st\<rparr>)" by (auto simp add:frame_def)
         
                 from * obtain b st' where **: "expr ex e\<^sub>p e cd (st\<lparr>gas:=gas st - costs (ITE ex s1 s2) e\<^sub>p e cd st\<rparr>) = Normal ((KValue b, Value TBool), st')" by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm Types.split_asm)
                 moreover from asm have "\<forall>rv4 st4' bal.
                   frame bal (st\<lparr>gas := gas st - costs (ITE ex s1 s2) e\<^sub>p e cd st\<rparr>) \<and>
                   expr ex e\<^sub>p e cd (st\<lparr>gas := gas st - costs (ITE ex s1 s2) e\<^sub>p e cd st\<rparr>) = Normal (rv4, st4') \<longrightarrow>
                   frame bal st4'" using 0 39(1)[OF a1] by (simp add:frame_def)
                 ultimately have f2: "frame bal st'" using f1 by blast 
       
                 show "frame bal st6'"
                 proof (cases "b = ShowL\<^sub>b\<^sub>o\<^sub>o\<^sub>l True")
                   case True
                   then have "\<forall>st6' bal.
                   frame bal st' \<and>
                   local.stmt s1 e\<^sub>p e cd st' = Normal ((), st6') \<longrightarrow>
                   frame bal st6'" using asm 0 39(2)[OF a1 **, of "KValue b" "Value TBool" b TBool] by (simp add:frame_def)
                   moreover from * ** True obtain st'' where ***: "stmt s1 e\<^sub>p e cd st' = Normal ((), st'')" by (auto split:if_split_asm result.split_asm)
                   ultimately have "frame bal st''" using f2 by blast
                   moreover from a1 * ** True *** have "st6' = st''" by (simp split:if_split_asm)
                   ultimately show "frame bal st6'" using asm by simp
                 next
                   case False
                   then have "\<forall>st6' bal.
                   frame bal st' \<and>
                   local.stmt s2 e\<^sub>p e cd st' = Normal ((), st6') \<longrightarrow>
                   frame bal st6'" using 0 asm 39(3)[OF a1 **, of "KValue b" "Value TBool" b TBool] by (simp add:frame_def)
                   moreover from * ** False obtain st'' where ***: "stmt s2 e\<^sub>p e cd st' = Normal ((), st'')" by (auto split:if_split_asm result.split_asm)
                   ultimately have "frame bal st''" using f2 by blast
                   moreover from a1 * ** False *** have "st6' = st''" by (simp split:if_split_asm)
                   ultimately show "frame bal st6'" using asm by simp
                 qed
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume "address e = STR ''Victim''"
             show ?RHS (is "?A \<and> (?B \<and> ?C)")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (40 ex s0 e\<^sub>p e cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume 0: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st6'
       show "?RHS st6'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume *: "stmt (WHILE ex s0) e\<^sub>p e cd st = Normal ((), st6')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume asm: "address e \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st6'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st6'"
               proof
                 assume "frame bal st"
                 with * have a1: "(applyf (costs (WHILE ex s0) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>)))) st =
                 Normal ((), st\<lparr>gas:=gas st - costs (WHILE ex s0) e\<^sub>p e cd st\<rparr>)" 
                 and f1: "frame bal (st\<lparr>gas:=gas st - costs (WHILE ex s0) e\<^sub>p e cd st\<rparr>)" by (auto simp add:frame_def)
         
                 from * obtain b st' where **: "expr ex e\<^sub>p e cd (st\<lparr>gas:=gas st - costs (WHILE ex s0) e\<^sub>p e cd st\<rparr>) = Normal ((KValue b, Value TBool), st')" by (auto split:if_split_asm result.split_asm prod.split_asm Stackvalue.split_asm Type.split_asm Types.split_asm)
                 moreover from asm have "\<forall>rv4 st4' bal.
                   frame bal (st\<lparr>gas := gas st - costs (WHILE ex s0) e\<^sub>p e cd st\<rparr>) \<and>
                   expr ex e\<^sub>p e cd (st\<lparr>gas := gas st - costs (WHILE ex s0) e\<^sub>p e cd st\<rparr>) = Normal (rv4, st4') \<longrightarrow>
                   frame bal st4'" using 0 40(1)[OF a1] by (simp add:frame_def)
                 ultimately have f2: "frame bal st'" using f1 by blast 
           
                 show "frame bal st6'"
                 proof (cases "b = ShowL\<^sub>b\<^sub>o\<^sub>o\<^sub>l True")
                   case True
                   then have "\<forall>st6' bal.
                   frame bal st' \<and>
                   local.stmt s0 e\<^sub>p e cd st' = Normal ((), st6') \<longrightarrow>
                   frame bal st6'" using 0 asm 40(2)[OF a1 **, of "KValue b" "Value TBool" b TBool]  by (simp add:frame_def)
                   moreover from * ** True obtain st'' where ***: "stmt s0 e\<^sub>p e cd st' = Normal ((), st'')" by (auto split:if_split_asm result.split_asm)
                   ultimately have f3: "frame bal st''" using f2 by blast
           
                   have "\<forall>st6' bal.
                   frame bal st'' \<and>
                   local.stmt (WHILE ex s0) e\<^sub>p e cd st'' = Normal ((), st6') \<longrightarrow>
                   frame bal st6'" using 0 asm 40(3)[OF a1 ** _ _ _ _ True ***] by (simp add:frame_def)
                   moreover from * ** True *** obtain st''' where ****: "stmt (WHILE ex s0) e\<^sub>p e cd st'' = Normal ((), st''')" by (auto split:if_split_asm result.split_asm)
                   ultimately have "frame bal st'''" using f3 by blast
                   
                   moreover from a1 * ** True *** **** have "st6' = st'''" by (simp split:if_split_asm)
                   ultimately show "frame bal st6'" using asm by simp
                 next
                   case False
                   then show "frame bal st6'" using * ** f1 f2 asm by (simp split:if_split_asm)
                 qed
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume "address e = STR ''Victim''"
             show ?RHS (is "?A \<and> (?B \<and> ?C)")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (41 i xe e\<^sub>p e cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume 0: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st'
       show "?RHS st'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume *: "stmt (INVOKE i xe) e\<^sub>p e cd st = Normal ((), st')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume asm: "address e \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st'"
               proof
                 assume ff: "frame bal st"
                 moreover from * have a1: "(applyf (costs (INVOKE i xe) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))  st = Normal ((), st\<lparr>gas := gas st - costs (INVOKE i xe) e\<^sub>p e cd st\<rparr>)" by auto
                 moreover from * obtain ct bla where **: "fmlookup e\<^sub>p (address e) = Some (ct, bla)"
                   by (auto split:if_split_asm option.split_asm)
                 moreover from * ** obtain fp f where ***: "fmlookup ct i = Some (Method (fp, f, None))"
                   by (auto split:if_split_asm option.split_asm Member.split_asm)
                 moreover define e' where "e' = ffold_init ct (emptyEnv (address e) (sender e) (svalue e)) (fmdom ct)"
                 moreover from * ** *** obtain e'' cd' st'' st''' where ****: "load False fp xe e\<^sub>p e' emptyStore (st\<lparr>gas:=gas st - (costs (INVOKE i xe) e\<^sub>p e cd st), stack:=emptyStore\<rparr>) e cd (st\<lparr>gas:=gas st - (costs (INVOKE i xe) e\<^sub>p e cd st)\<rparr>) = Normal ((e'', cd', st''), st''')"
                   using e'_def by (auto split:if_split_asm result.split_asm)
                 moreover from * **** have f1: "frame bal st''" and ad: "address e' = address e''"
                   using asm ff 0 41(1)[OF a1 ** _ *** _ _ _ _ e'_def, of bla "(fp, f, None)" fp "(f, None)" f None] by (auto simp add:frame_def)
                 moreover from e'_def have ad2: "address e = address e'" using ffold_init_ad_same[of ct "(emptyEnv (address e) (sender e) (svalue e))" "(fmdom ct)" e'] by simp
                 moreover from * ** *** **** e'_def obtain st'''' where *****: "stmt f e\<^sub>p e'' cd' st'' = Normal ((), st'''')" by (auto split:if_split_asm result.split_asm)
                 ultimately have "st' = st''''\<lparr>stack:=stack st''', memory := memory st'''\<rparr>" using * apply safe by simp
                 moreover from f1 ad ad2 asm ***** have f2:"frame bal st''''"
                   using 41(2)[OF a1 ** _ *** _ _ _ _ e'_def _ ****] using 0 * by (auto simp add:frame_def)
                 ultimately show "frame bal st'" by (simp add:frame_def)
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume "address e = STR ''Victim''"
             show ?RHS (is "?A \<and> (?B \<and> ?C)")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (42 ad i xe val e\<^sub>p e cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume 0: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st'
       show "?RHS st'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume *: "stmt (EXTERNAL ad i xe val) e\<^sub>p e cd st = Normal ((), st')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume asm: "address e \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st'"
               proof
                 assume ff: "frame bal st"
                 moreover from * have a1: "(applyf (costs (EXTERNAL ad i xe val) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))  st = Normal ((), st\<lparr>gas := gas st - costs (EXTERNAL ad i xe val) e\<^sub>p e cd st\<rparr>)" by auto
                 moreover from * obtain adv st'' where **: "expr ad e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs (EXTERNAL ad i xe val) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue adv, Value TAddr), st'')"
                   by (auto split:if_split_asm result.split_asm Stackvalue.split_asm Type.split_asm Types.split_asm)
                 moreover from * ** ff have f1: "frame bal st''" using asm 0 42(1) by (simp add:frame_def split:if_split_asm)
                 moreover from * ** obtain ct fb where ***: "fmlookup e\<^sub>p adv = Some (ct, fb)"
                   by (auto split:if_split_asm option.split_asm)
                 moreover from * ** *** f1 obtain v t st''' where ****: "expr val e\<^sub>p e cd st'' = Normal ((KValue v, Value t), st''')"
                   by (auto split:if_split_asm result.split_asm Stackvalue.split_asm Type.split_asm)
                 moreover from **** f1 have "frame bal st'''" using asm 42(2)[OF a1 ** _ _ _ _ ***] 0 by (simp split:if_split_asm)
                 then have f2: "frame bal (st'''\<lparr>stack := emptyStore, memory := emptyStore\<rparr>)" by (simp add:frame_def)
                 show "frame bal st'"
                 proof (cases "fmlookup ct i")
                   case None
                   with * ** *** **** obtain acc where trans: "Accounts.transfer (address e) adv v (accounts st''') = Some acc" by (auto split:if_split_asm option.split_asm)
                   with * ** *** **** None obtain st'''' where *****: "stmt fb e\<^sub>p (emptyEnv adv (address e) v) cd (st'''\<lparr>accounts := acc,stack:=emptyStore, memory:=emptyStore\<rparr>) = Normal ((), st'''')"
                     by (auto split:if_split_asm result.split_asm)
                   moreover have f4: "frame bal (st''''\<lparr>stack:=stack st'', memory := memory st''\<rparr>)"
                   proof (cases "adv = STR ''Victim''")
                     case True
                     with 0 *** have "fb = SKIP" by simp
                     moreover from f2 have "frame bal (st'''\<lparr>accounts := acc,stack:=emptyStore, memory:=emptyStore\<rparr>)" using transfer_frame[OF trans] asm by (simp add:frame_def)
                     ultimately show ?thesis using ***** by (auto split:if_split_asm simp add:frame_def)
                   next
                     case False
                     moreover from f2 have "frame bal (st'''\<lparr>accounts := acc,stack:=emptyStore, memory:=emptyStore\<rparr>)" using transfer_frame[OF trans] asm by (simp add:frame_def)
                     then have "frame bal st''''" using f2 0 42(5)[OF a1 ** _ _ _ _ *** _ **** _ _ _ None _ trans, of "KValue adv" "Value TAddr" TAddr fb "KValue v" "Value t" t st''' st''' st'''] asm ***** False by (auto simp add:frame_def)
                     then show ?thesis by (simp add:frame_def)
                   qed
                   ultimately show "frame bal st'" using a1 * ** *** **** None trans by (auto simp add:frame_def)
                 next
                   case (Some a)
                   with * ** *** **** obtain fp f where *****: "fmlookup ct i = Some (Method (fp, f, None))"
                     by (auto split:if_split_asm option.split_asm Member.split_asm)
                   moreover define e' where e'_def: "e' = ffold_init ct (emptyEnv adv (address e) v) (fmdom ct)"
                   moreover from * ** *** ***** **** obtain e'' cd' st'''' st''''' where *******: "load True fp xe e\<^sub>p e' emptyStore (st'''\<lparr>stack:=emptyStore, memory:=emptyStore\<rparr>) e cd st''' = Normal ((e'', cd', st''''), st''''')"
                     using e'_def by (auto split:if_split_asm result.split_asm option.split_asm)
                   moreover from e'_def have ad2: "address e' = adv" and send2: "sender e' = address e" and sval2: "svalue e' = v" using ffold_init_ad_same[of ct "(emptyEnv adv (address e) v)" "(fmdom ct)" e'] by auto
                   moreover from * ** *** ***** **** ******* e'_def obtain acc where trans: "Accounts.transfer (address e) adv v (accounts st'''') = Some acc" by (auto split:if_split_asm option.split_asm)
                   then have ******: "Accounts.transfer (address e) adv v (accounts st'''') = Some acc" by (auto split:if_split_asm option.split_asm)
                   moreover from * ** *** ***** **** ****** ******* obtain st'''''' where ********: "stmt f e\<^sub>p e'' cd' (st''''\<lparr>accounts := acc\<rparr>) = Normal ((), st'''''')"
                     using e'_def by (auto split:if_split_asm result.split_asm)
                   moreover have f4: "frame bal st''''''"
                   proof (cases "adv = STR ''Victim''")
                     case True
                     with 0 *** have ct_def: "ct = victim" by simp
   
                     moreover have
                       "(\<forall>(ev::Environment) cda st st' bal.
                               local.load True fp xe e\<^sub>p e' emptyStore (st'''\<lparr>stack := emptyStore, memory := emptyStore\<rparr>) e cd st''' = Normal ((ev, cda, st), st') \<longrightarrow>
                               (frame bal (st'''\<lparr>stack := emptyStore, memory := emptyStore\<rparr>) \<longrightarrow> frame bal st) \<and>
                               (frame bal st''' \<longrightarrow> frame bal st') \<and> address e' = address ev \<and> sender e' = sender ev \<and> svalue e' = svalue ev)"
                       using 0 42(3)[OF a1 ** _ _ _ _ *** _ **** _ _ _ ***** _ _ _ _ e'_def] asm by simp
                     with f2 ******* have f3: "frame bal st''''" and ad1: "address e' = address e''" and send1: "sender e' = sender e''" and sval1: "svalue e' = svalue e''" by auto
   
                     from ct_def ***** consider (withdraw) "i = STR ''withdraw''" | (deposit) "i = STR ''deposit''" using victim_def fmap_of_list_SomeD[of "[(STR ''balance'', Var (STMap TAddr (STValue (TUInt 256)))), (STR ''deposit'', Method ([], deposit, None)), (STR ''withdraw'', Method ([], keep, None))]"] by auto
                     then show ?thesis
                     proof cases
                       case withdraw
                       moreover have "fmlookup victim (STR ''withdraw'') = Some (Method ([], keep, None))" using victim_def by eval 
                       ultimately have "f=keep" and "fp = []" using *** ***** True 0 by auto
                       with ******** have *********: "stmt keep e\<^sub>p e'' cd' (st''''\<lparr>accounts := acc\<rparr>) = Normal ((), st'''''')" by simp
                       have "fmlookup (denvalue e'') STR ''balance'' = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')"
                       proof -
                         from victim_def have some: "fmlookup victim (STR ''balance'') = Some (Var (STMap TAddr (STValue (TUInt 256))))" by eval
                         with ct_def have "fmlookup ct (STR ''balance'') = Some (Var (STMap TAddr (STValue (TUInt 256))))" by simp
                         moreover have "STR ''balance'' |\<notin>| fmdom (denvalue (emptyEnv adv (address e) v))" by simp
                         moreover from ct_def some have "STR ''balance'' |\<in>| fmdom ct" using fmdomI by simp
                         ultimately have "fmlookup (denvalue e') STR ''balance'' = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')" using e'_def ffold_init_fmap[of ct "STR ''balance''" "(STMap TAddr (STValue (TUInt 256)))" "(emptyEnv adv (address e) v)" "(fmdom ct)"] by simp
                         moreover have "e'' = e'"
                         proof (cases "xe=[]")
                           case True
                           with ******* `fp = []` show ?thesis by simp
                         next
                           case False
                           then obtain xx xe' where "xe = xx # xe'" using list.exhaust by auto
                           with ******* `fp = []` show ?thesis by simp
                         qed
                         ultimately show ?thesis by simp
                       qed
   
                       moreover from ad1 ad2 True have ad: "address e'' = STR ''Victim''" by simp
                       moreover from ad send1 send2 asm have "sender e'' \<noteq> address e''" by simp
                       moreover from f3 have f4: "frame bal (st''''\<lparr>accounts := acc\<rparr>)" using transfer_frame[OF ******] asm by simp
                       then obtain s'''' where "fmlookup (storage (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim'') = Some s'''' \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim'')) - (SUMM s'''') \<ge> bal \<and> bal \<ge> 0 \<and> POS s''''" by (auto simp add:frame_def)
                       ultimately have "(\<exists>s'. fmlookup (storage st'''''') (STR ''Victim'') = Some s'
                       \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''''') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s')"
                         using 0 ******** `f=keep` 42(4)[OF a1 ** _ _ _ _ *** _ **** _ _ _ *****  _ _ _ _ e'_def _ ******* _ _ _ trans, of "KValue adv" "Value TAddr" TAddr fb "KValue v" "Value t" t "(fp, f, None)" "(f, None)" f None e'' "(cd', st'''')" cd' st''''' st''''' "()" "st''''\<lparr>accounts := acc\<rparr>"] apply safe by auto
                       then show ?thesis by (simp add:frame_def)
                     next
                       case deposit
                       moreover from f2 have "frame bal (st'''\<lparr>stack:=emptyStore, memory:=emptyStore\<rparr>)" using transfer_frame[OF ******] asm by simp
                       moreover have "fmlookup victim (STR ''deposit'') = Some (Method ([], deposit, None))" using victim_def by eval
                       ultimately have "f=deposit" and "fp = []" using *** ***** True 0 by auto
                       with ******** have *: "stmt deposit e\<^sub>p e'' cd' (st''''\<lparr>accounts := acc\<rparr>) = Normal ((), st'''''')" by simp
   
                       have f4: "frame (bal + ReadL\<^sub>i\<^sub>n\<^sub>t v) (st''''\<lparr>accounts := acc\<rparr>)" and ad1: "address e' = address e''" and send1: "sender e' = sender e''" and sval1: "svalue e' = svalue e''"
                       proof -
                         have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''') (STR ''Victim'')) + ReadL\<^sub>i\<^sub>n\<^sub>t v" using transfer_add[OF ******] asm True by simp
                         moreover have "ReadL\<^sub>i\<^sub>n\<^sub>t v \<ge> 0" using transfer_val1[OF  ******] by simp
                         ultimately have "frame (bal + ReadL\<^sub>i\<^sub>n\<^sub>t v) (st''''\<lparr>accounts := acc\<rparr>)" using f3 by (auto simp add:frame_def)
                         then show "frame (bal + ReadL\<^sub>i\<^sub>n\<^sub>t v) (st''''\<lparr>accounts := acc\<rparr>)" and "address e' = address e''" and "sender e' = sender e''" and "svalue e' = svalue e''" using f2 0 42(3)[OF a1 ** _ _ _ _ *** _ **** _ _ _ ***** _ _ _ _ e'_def, of "KValue adv" "Value TAddr" TAddr fb "KValue v" "Value t"] asm ******* by (auto simp add:frame_def)
                       qed
                       moreover from sval1 sval2 have "v = svalue e''" by simp
                       ultimately have "frame (bal + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue e'')) (st''''\<lparr>accounts := acc\<rparr>)" by simp
                       then obtain s''''' where II: "INV (st''''\<lparr>accounts := acc\<rparr>) s''''' (SUMM s''''') (bal + ReadL\<^sub>i\<^sub>n\<^sub>t (svalue e''))" and III:"POS s'''''" by (auto simp add:frame_def)
                       then have s'''''_def: "fmlookup (storage (st''''\<lparr>accounts := acc\<rparr>)) STR ''Victim'' = Some s'''''" by simp
   
                       have yyy: "fmlookup (denvalue e'') STR ''balance'' = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')"
                       proof -
                         from victim_def have some: "fmlookup victim (STR ''balance'') = Some (Var (STMap TAddr (STValue (TUInt 256))))" by eval
                         with ct_def have "fmlookup ct (STR ''balance'') = Some (Var (STMap TAddr (STValue (TUInt 256))))" by simp
                         moreover have "STR ''balance'' |\<notin>| fmdom (denvalue (emptyEnv adv (address e) v))" by simp
                         moreover from ct_def some have "STR ''balance'' |\<in>| fmdom ct" using fmdomI by simp
                         ultimately have "fmlookup (denvalue e') STR ''balance'' = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')" using e'_def ffold_init_fmap[of ct "STR ''balance''" "(STMap TAddr (STValue (TUInt 256)))" "(emptyEnv adv (address e) v)" "(fmdom ct)"] by simp
                         moreover have "e'' = e'"
                         proof (cases "xe=[]")
                           case True
                           with ******* `fp = []` show ?thesis by simp
                         next
                           case False
                           then obtain xx xe' where "xe = xx # xe'" using list.exhaust by auto
                           with ******* `fp = []` show ?thesis by simp
                         qed
                         ultimately show ?thesis by simp
                       qed
   
                       from asm True have "address e \<noteq> (STR ''Victim'')" by simp
                       then have  "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''')  (STR ''Victim'')) + ReadL\<^sub>i\<^sub>n\<^sub>t v < 2^256" using transfer_val2[OF  ******] True by simp
                       moreover from `address e \<noteq> (STR ''Victim'')` have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc  (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''')  (STR ''Victim'')) + ReadL\<^sub>i\<^sub>n\<^sub>t v" using transfer_add[OF ******] (******) True by simp
                       ultimately have abc: "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>))  (STR ''Victim'')) < 2^256" by simp
   
                       from II have "fmlookup (storage (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim'') = Some s'''''  \<and> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim'')) - (SUMM s''''') \<ge> bal + ReadL\<^sub>i\<^sub>n\<^sub>t  (svalue e'') \<and> bal + ReadL\<^sub>i\<^sub>n\<^sub>t  (svalue e'') \<ge> 0" by (auto)
                       moreover have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender e'' + (STR ''.'' + STR ''balance'')) s''''')  + \<lceil>svalue e''\<rceil> < 2 ^ 256 \<and>
                           ReadL\<^sub>i\<^sub>n\<^sub>t (accessStorage (TUInt 256) (sender e'' + (STR ''.'' + STR ''balance'')) s''''')  + \<lceil>svalue e''\<rceil> \<ge> 0"
                       proof (cases "fmlookup s''''' (sender e'' + (STR ''.'' + STR ''balance'')) = None")
                         case True
                         hence "(accessStorage (TUInt 256) (sender e'' + (STR ''.'' + STR ''balance'')) s''''') = ShowL\<^sub>i\<^sub>n\<^sub>t 0" by simp
                         moreover have "(\<lceil>svalue e''\<rceil>::int) < 2 ^ 256"
                         proof -
                           from II have "bal + \<lceil>svalue e''\<rceil> + SUMM s''''' \<le> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim''))" by simp
                           moreover have "0 \<le> SUMM s'''''"
                           using III sum_nonneg[of "{(ad,x). fmlookup s''''' (ad + (STR ''.'' + STR ''balance'')) = Some x}" "\<lambda>(ad,x). ReadL\<^sub>i\<^sub>n\<^sub>t x"] by auto
                           ultimately have "bal + \<lceil>svalue e''\<rceil> \<le> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim''))" by simp
                           moreover from ff have "bal\<ge>0" by (auto simp add:frame_def)
                           ultimately show "(\<lceil>svalue e''\<rceil>::int) < 2 ^ 256" using abc by simp
                         qed
                         moreover have "ReadL\<^sub>i\<^sub>n\<^sub>t v \<ge> 0" using transfer_val1[OF  ******] by simp
                         with `svalue e' = v` sval1 have "(\<lceil>svalue e''\<rceil>::int) \<ge> 0" by simp
                         ultimately show ?thesis using Read_ShowL_id by simp
                       next
                         case False
                         then obtain x where x_def: "fmlookup s'''''  (sender e'' + (STR ''.'' + STR ''balance'')) = Some x" by auto
                         moreover from II have "bal + \<lceil>svalue e''\<rceil> + SUMM s''''' \<le> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim''))" by simp
                         moreover have "(case (sender e'', x) of (ad, x) \<Rightarrow> \<lceil>x\<rceil>) \<le> (\<Sum>(ad, x)\<in>{(ad, x). fmlookup s''''' (ad + (STR ''.'' + STR ''balance'')) = Some x}. ReadL\<^sub>i\<^sub>n\<^sub>t x)"
                         proof (cases rule: member_le_sum[of "(sender e'',x)" "{(ad,x). fmlookup s''''' (ad + (STR ''.'' + STR ''balance'')) = Some x}" "\<lambda>(ad,x). ReadL\<^sub>i\<^sub>n\<^sub>t x"])
                           case 1
                           then show ?case using x_def by simp
                         next
                           case (2 x)
                           with III show ?case by auto
                         next
                           case 3
                           have "inj_on (\<lambda>(ad, x). (ad + (STR ''.'' + STR ''balance''), x)) {(ad, x). (fmlookup s''''' \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using balance_inj by simp
                           then have "finite {(ad, x). (fmlookup s''''' \<circ> (\<lambda>ad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using fmlookup_finite[of "\<lambda>ad. (ad + (STR ''.'' + STR ''balance''))" s'''''] by simp
                           then show ?case using finite_subset[of "{(ad, x). fmlookup s''''' (ad + (STR ''.'' + STR ''balance'')) = Some x}" "{(ad, x). fmlookup s''''' (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by auto
                         qed
                         then have "ReadL\<^sub>i\<^sub>n\<^sub>t x \<le> SUMM s'''''" by simp
                         ultimately have "bal + \<lceil>svalue e''\<rceil> + ReadL\<^sub>i\<^sub>n\<^sub>t x \<le> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim''))" by simp
                         moreover from ff have "bal\<ge>0" by (auto simp add:frame_def)
                         ultimately have "\<lceil>svalue e''\<rceil> + ReadL\<^sub>i\<^sub>n\<^sub>t x \<le> ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim''))" by simp
                         with abc have "\<lceil>svalue e''\<rceil> + ReadL\<^sub>i\<^sub>n\<^sub>t x < 2^256" by simp
                         moreover have "fmlookup s''''' (sender e' + (STR ''.'' + STR ''balance'')) = fmlookup s'''''  (sender e'' + (STR ''.'' + STR ''balance''))" using send1 by simp
                         ultimately have "bal + \<lceil>svalue e''\<rceil> \<le> \<lceil>accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) STR ''Victim''\<rceil> - SUMM s'''''" and lck: "fmlookup s''''' (sender e'' + (STR ''.'' + STR ''balance'')) = Some x"  and "ReadL\<^sub>i\<^sub>n\<^sub>t x + \<lceil>svalue e''\<rceil> < 2 ^ 256" using ad1 ad2 True II x_def by simp+
                         moreover from lck have "(accessStorage (TUInt 256) (sender e'' + (STR ''.'' + STR ''balance'')) s''''') = x" by simp
                         moreover have "\<lceil>svalue e''\<rceil> + ReadL\<^sub>i\<^sub>n\<^sub>t x \<ge> 0"
                         proof -
                           have "ReadL\<^sub>i\<^sub>n\<^sub>t v \<ge> 0" using transfer_val1[OF  ******] by simp
                           with `svalue e' = v` sval1 have "(\<lceil>svalue e''\<rceil>::int) \<ge> 0" by simp
                           moreover from III have "ReadL\<^sub>i\<^sub>n\<^sub>t x \<ge> 0" using x_def by simp
                           ultimately show ?thesis by simp
                         qed
                         ultimately show ?thesis using Read_ShowL_id by simp
                       qed
                       moreover have "address e'' = STR ''Victim''" using ad1 ad2 True by simp
                       ultimately obtain s'''''' where "fmlookup (storage st'''''') (STR ''Victim'') = Some s''''''" and "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''''') (STR ''Victim'')) - SUMM s'''''' \<ge> bal" and "POS s''''''"
                       using deposit_frame[OF * s'''''_def _ yyy] III by auto
                       then show ?thesis using ff by (auto simp add:frame_def)
                     qed
                   next
                     case False
                     moreover from f2 have "frame bal (st'''\<lparr>stack:=emptyStore, memory:=emptyStore\<rparr>)" using transfer_frame[OF ******] asm by simp
                     then have "frame bal st''''" and ad1: "address e' = address e''" using f2 0 42(3)[OF a1 ** _ _ _ _ *** _ **** _ _ _ ***** _ _ _ _ e'_def, of "KValue adv" "Value TAddr" TAddr fb "KValue v" "Value t"] asm ******* by (auto simp add:frame_def)
                     then have f4: "frame bal (st''''\<lparr>accounts := acc\<rparr>)" using transfer_frame[OF ******] asm by simp
                     
                     moreover from ad1 ad2 have "address e'' \<noteq> STR ''Victim'' \<and> fmlookup e\<^sub>p (STR ''Victim'') = Some (victim, SKIP)" using 0 False by simp
                     then have "\<forall>st6' bal.
                     frame bal (st''''\<lparr>accounts := acc\<rparr>) \<and>
                     local.stmt f e\<^sub>p e'' cd' (st''''\<lparr>accounts := acc\<rparr>) = Normal ((), st6') \<longrightarrow>
                     frame bal st6'" using 42(4)[OF a1 ** _ _ _ _ *** _ **** _ _ _ ***** _ _ _ _ e'_def _ ******* _ _ _ ******] False asm by (auto simp add:frame_def)
                     ultimately show ?thesis using ******** by blast
                   qed
                   ultimately show "frame bal st'" using a1 * ** *** **** by (auto simp add:frame_def)
                 qed
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume "address e = STR ''Victim''"
             show ?RHS (is "?A \<and> (?B \<and> ?C)")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (43 ad ex e\<^sub>p e cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume 0: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st'
       show "?RHS st'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume *: "stmt (TRANSFER ad ex) e\<^sub>p e cd st = Normal ((), st')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume asm: "address e \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st'"
               proof
                 assume ff: "frame bal st"
                 from * have a1: "(applyf (costs (TRANSFER ad ex) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))  st = Normal ((), st\<lparr>gas := gas st - costs (TRANSFER ad ex) e\<^sub>p e cd st\<rparr>)" by auto
                 from * obtain v t st'' where **: "expr ex e\<^sub>p e cd (st\<lparr>gas:=gas st - (costs (TRANSFER ad ex) e\<^sub>p e cd st)\<rparr>) = Normal ((KValue v, Value t), st'')"
                   by (auto split:if_split_asm result.split_asm Stackvalue.split_asm Type.split_asm)
                 from asm ff * ** have f1: "frame bal st''" using 43(1)[OF a1] 0 by (simp add:frame_def)
                 from * ** obtain adv st''' where ***: "expr ad e\<^sub>p e cd st'' = Normal ((KValue adv, Value TAddr), st''')"
                   by (auto split:if_split_asm result.split_asm Stackvalue.split_asm Type.split_asm Types.split_asm)
                 from asm * *** f1 have f2: "frame bal st'''" using asm 43(2)[OF a1 **] 0 by (simp add:frame_def)
                 from * ** *** obtain acc where *****: "Accounts.transfer (address e) adv v (accounts st''') = Some acc" by (auto split:if_split_asm option.split_asm)
                 from f2 have f3: "frame bal (st'''\<lparr>accounts := acc\<rparr>)" using transfer_frame[OF *****] asm by simp
                 show "frame bal st'"
                 proof (cases "fmlookup e\<^sub>p adv")
                   case None
                   with a1 * ** *** ***** show ?thesis using f3 by auto
                 next
                   case (Some a)
                   then show ?thesis
                   proof (cases a)
                     case (Pair ct f)
                     moreover define e' where "e' = ffold_init ct (emptyEnv adv (address e) v) (fmdom ct)"
                     moreover from * ** *** Some Pair ***** e'_def obtain st'''' where ******: "stmt f e\<^sub>p e' emptyStore (st'''\<lparr>accounts := acc, stack:=emptyStore, memory:=emptyStore\<rparr>) = Normal ((), st'''')" by (auto split:if_split_asm option.split_asm result.split_asm)
                     moreover from e'_def have ad: "adv = address e'" using ffold_init_ad_same[of ct "(emptyEnv adv (address e) v)" "(fmdom ct)" e'] by simp
               
                     moreover have f4: "frame bal st''''" 
                     proof (cases "adv = STR ''Victim''")
                       case True
                       with 0 ** *** Some Pair have "f = SKIP" using victim_def by simp
                       with ****** have "st''''=  st'''
                       \<lparr>accounts := acc, stack := emptyStore, memory := emptyStore,
                       gas := gas st''' - costs SKIP e\<^sub>p e' emptyStore (st'''\<lparr>accounts := acc, stack := emptyStore, memory := emptyStore\<rparr>)\<rparr>" by (simp split:if_split_asm)
                       with f3 show ?thesis by (simp add:frame_def)
                     next
                       case False
                       with asm ad have "\<forall>st6' bal.
                       frame bal (st'''\<lparr>accounts := acc\<rparr>) \<and>
                       local.stmt f e\<^sub>p e' emptyStore (st'''\<lparr>accounts := acc, stack := emptyStore, memory := emptyStore\<rparr>) = Normal ((), st6') \<longrightarrow>
                       frame bal st6'" using asm Some Pair 43(3)[OF a1 ** _ _ _ *** _ _ _ _ _ ***** _ _ e'_def, where s'e = "st'''\<lparr>accounts := acc, stack:=emptyStore, memory:=emptyStore\<rparr>", of "KValue v" "Value t" t "KValue adv" "Value TAddr" TAddr st''' _ f st''' st''' "()"] using 0 by (simp add:frame_def)
                       with f3 ****** show ?thesis by blast
                     qed
                     moreover from * ** *** Some Pair ***** ****** e'_def have st'_def: "st' = st''''\<lparr>stack:=stack st''', memory := memory st'''\<rparr>" by (simp split:if_split_asm)
                     ultimately show "frame bal st'" apply safe by (simp_all add:frame_def)
                   qed
                 qed
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume ad: "address e = STR ''Victim''"
             show ?RHS (is "?A \<and> ?B \<and> ?C")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS (is "?A1 \<and> ?A2 \<and> ?A3 \<and> ?A4 \<and> ?A5")
                   then have ?A1 and ?A2 and ?A3 and ?A4 and ?A5 by auto
                   define st'' where "st'' = st\<lparr>gas := gas st - costs transfer e\<^sub>p e cd st\<rparr>"
                   define st''' where "st''' = st''\<lparr>gas := gas st'' - costs\<^sub>e (LVAL (Id (STR ''bal''))) e\<^sub>p e cd st''\<rparr>"
                   define st'''' where "st'''' = st'''\<lparr>gas := gas st''' - costs\<^sub>e SENDER e\<^sub>p e cd st'''\<rparr>"
                   from `?A1` * have c1: "gas st > costs transfer e\<^sub>p e cd st" by (auto split:if_split_asm)
                   have c2: "gas st'' > costs\<^sub>e (LVAL (Id (STR ''bal''))) e\<^sub>p e cd st''"
                   proof (rule ccontr)
                     assume "\<not> costs\<^sub>e (LVAL (Id (STR ''bal''))) e\<^sub>p e cd st'' < gas st''"
                     with c1 show False using `?A1` * st''_def st'''_def by auto
                   qed
                   with `?A4` `?A5` have 00:"expr (LVAL (Id (STR ''bal''))) e\<^sub>p e cd st'' = Normal ((KValue val, Value (TUInt 256)), st''')" using st'''_def st''_def by simp
                   moreover have "gas st'''>costs\<^sub>e SENDER e\<^sub>p e cd st'''"
                   proof (rule ccontr)
                     assume "\<not> costs\<^sub>e SENDER e\<^sub>p e cd st''' < gas st'''"
                     with c1 c2 show False using `?A1` `?A4` `?A5` * st''_def st'''_def by auto
                   qed      
                   then have **:"expr SENDER e\<^sub>p e cd st''' = Normal ((KValue (sender e), Value TAddr), st'''')" using st''''_def by simp
                   then obtain acc where ***:"Accounts.transfer (address e) (sender e) val (accounts st'''') = Some acc"
                     and ****: "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''') (STR ''Victim'')) - (ReadL\<^sub>i\<^sub>n\<^sub>t val)"
                   proof -
                     from `?A1` * c1 00 ** obtain acc where acc_def: "Accounts.transfer (address e) (sender e) val (accounts st'''') = Some acc" using st''''_def st'''_def st''_def by (auto split: option.split_asm)
                     with ad obtain acc' where *: "subBalance (STR ''Victim'') val (accounts st'''') = Some acc'"
                       and "addBalance (sender e) val acc' = Some acc" by (simp split: option.split_asm)
                     moreover from * have "acc' = updateBalance(STR ''Victim'') (ShowL\<^sub>i\<^sub>n\<^sub>t (ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''') (STR ''Victim'')) - ReadL\<^sub>i\<^sub>n\<^sub>t val)) (accounts st'''')" by (simp split: if_split_asm)
                     then have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc' (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''') (STR ''Victim'')) - (ReadL\<^sub>i\<^sub>n\<^sub>t val)" using Read_ShowL_id by simp
                     moreover from `?A5` ad have "sender e \<noteq> (STR ''Victim'')" by simp
                     ultimately have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc (STR ''Victim'')) = ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''') (STR ''Victim'')) - (ReadL\<^sub>i\<^sub>n\<^sub>t val)" using addBalance_eq[of "sender e" val acc' acc " STR ''Victim''"] by simp
                     with acc_def show ?thesis using that by simp
                   qed
                   show ?RHS
                   proof (cases "fmlookup e\<^sub>p (sender e)")
                     case None
                     with `?A1` 00 * ** *** have "st' = st''''\<lparr>accounts := acc\<rparr>" using c1 st''_def by auto
                     moreover from `?A2` have "fmlookup (storage st'''') (STR ''Victim'') = Some s" using st''_def st'''_def st''''_def by simp
                     moreover from `?A2` have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''') (STR ''Victim'')) - (SUMM s + ReadL\<^sub>i\<^sub>n\<^sub>t val) \<ge> bal \<and> bal \<ge> 0"  using st''_def st'''_def st''''_def by simp
                     with **** have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc (STR ''Victim'')) - SUMM s \<ge> bal \<and> bal \<ge> 0" by simp
                     then have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc\<rparr>)) (STR ''Victim'')) - SUMM s \<ge> bal \<and> bal \<ge> 0" by simp
                     ultimately show ?thesis using `?A3` by (simp add:frame_def)
                   next
                     case (Some a)
                     then show ?thesis
                     proof (cases a)
                       case (Pair ct f)
                       moreover define e' where e'_def: "e'=ffold_init ct (emptyEnv (sender e) (address e) val) (fmdom ct)"
                       ultimately obtain st''''' where *****: "stmt f e\<^sub>p e' emptyStore (st''''\<lparr>accounts := acc, stack:=emptyStore, memory:=emptyStore\<rparr>) = Normal ((), st''''')" 
                         and ******: "st' = st'''''\<lparr>stack:=stack st'''', memory := memory st''''\<rparr>"  using `?A1` 00 ** *** Some *  stmt.simps(8)[of SENDER "(LVAL (Id (STR ''bal'')))" e\<^sub>p e cd st] c1 st''_def st'''_def st''''_def by (auto split: result.split_asm unit.split_asm)
                       from `?A1` * have x1: "(applyf (costs (TRANSFER ad ex) e\<^sub>p e cd) \<bind> (\<lambda>g. assert Gas
                                                                            (\<lambda>st. gas st \<le> g)
                                                                            (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))
                        st =
                       Normal ((), st'')" using st''_def by (simp split:if_split_asm)
                       from 00 `?A1` have x2: "expr ex e\<^sub>p e cd st'' = Normal ((KValue val, Value (TUInt 256)), st''')" by simp
                       have x3: "(KValue val, Value (TUInt 256)) = (KValue val, Value (TUInt 256))" by simp
                       have x4: "KValue val = KValue val" by simp
                       have  x5: "Value (TUInt 256) = Value (TUInt 256)" by simp
                       from  ** `?A1` have x6: "expr ad e\<^sub>p e cd st''' = Normal ((KValue (sender e), Value TAddr), st'''')" by simp
                       have x7: "(KValue (sender e), Value TAddr) = (KValue (sender e), Value TAddr)" by simp
                       have x8: "KValue (sender e) = KValue (sender e)" by simp
                       have x9: "Value TAddr = Value TAddr" by simp
                       have x10: "TAddr = TAddr" by simp
                       have x11: "applyf accounts st'''' = Normal (accounts st'''', st'''')" by simp
                       from *** have x12: "Accounts.transfer (address e) (sender e) val (accounts st'''') = Some acc" by simp
                       from Some Pair have x13: "fmlookup e\<^sub>p (sender e) = Some (ct,f)" by simp
                       have x14: "(ct, f) = (ct, f)" by simp
                       from e'_def have x15: "e' = ffold_init ct (emptyEnv (sender e) (address e) val) (fmdom ct)" by simp
                       have x16: "get st'''' = Normal (st'''', st'''')" by simp
                       have x17: "modify (\<lambda>st. st\<lparr>accounts := acc, stack := emptyStore, memory := emptyStore\<rparr>) st'''' = Normal ((), st''''\<lparr>accounts := acc, stack := emptyStore, memory := emptyStore\<rparr>)" by simp
                       
                       from `?A2` have "fmlookup (storage st'''') (STR ''Victim'') = Some s" using st''_def st'''_def st''''_def by simp
                       moreover from `?A2` have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''') (STR ''Victim'')) - (SUMM s + ReadL\<^sub>i\<^sub>n\<^sub>t val) \<ge> bal \<and> bal \<ge> 0"  using st''_def st'''_def st''''_def by simp
                       with **** have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance acc (STR ''Victim'')) - SUMM s \<ge> bal \<and> bal \<ge> 0" by simp
                       then have "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts (st''''\<lparr>accounts := acc, stack:=emptyStore, memory:=emptyStore\<rparr>)) (STR ''Victim'')) - SUMM s \<ge> bal \<and> bal \<ge> 0" by simp
                       moreover from `?A5` ad have "sender e \<noteq> (STR ''Victim'')" by simp
                       with e'_def have "address e' \<noteq> STR ''Victim''" using ffold_init_ad_same[of ct "(emptyEnv (sender e) (address e) val)" "(fmdom ct)" e'] by simp
                       ultimately have "frame bal st'''''" using 0 ***** 43(3)[OF x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17] `?A3` apply safe by (auto simp add:frame_def)
                       with "******" show ?RHS by (auto simp add:frame_def)
                     qed
                   qed
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case (44 id0 tp ex smt e\<^sub>p e\<^sub>v cd st)
   show ?case (is "?LHS \<longrightarrow> ?RHS")
   proof
     assume 0: "fmlookup e\<^sub>p STR ''Victim'' = Some (victim, SKIP)"
     show ?RHS (is "\<forall>st6'. ?RHS st6'")
     proof
       fix st6'
       show "?RHS st6'" (is "?LHS \<longrightarrow> ?RHS")
       proof
         assume *: "stmt (BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd st = Normal ((), st6')"
         show ?RHS (is "?LHS \<and> ?RHS")
         proof
           show "?LHS"
           proof
             assume asm: "address e\<^sub>v \<noteq> STR ''Victim''"
             show "\<forall>bal. frame bal st \<longrightarrow> frame bal st6'"
             proof
               fix bal
               show "frame bal st \<longrightarrow> frame bal st6'"
               proof
                 assume ff: "frame bal st"
                 with * have a1: "(applyf (costs(BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))  st = Normal ((), st\<lparr>gas := gas st - costs (BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd st\<rparr>)" by auto
                 from * ff have f1: "frame bal (st\<lparr>gas := gas st - costs (BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd st\<rparr>)" by (simp add:frame_def)
     
                 show "frame bal st6'"
                 proof (cases ex)
                   case None
                   with * obtain cd' e' st' where **:"decl id0 tp None False cd (memory (st\<lparr>gas := gas st - costs (BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd st\<rparr>)) cd e\<^sub>v (st\<lparr>gas := gas st - costs (BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd st\<rparr>) = Normal ((cd', e'), st')" by (auto split:result.split_asm if_split_asm)
                   with * have f2: "frame bal st'" using decl_frame[OF f1 **] by simp
                   moreover from * None ** obtain st'' where ***: "stmt smt e\<^sub>p e' cd' st' = Normal ((), st'')" by (simp split:if_split_asm)
                   moreover from ** have ad: "address e' = address e\<^sub>v" using decl_gas_address by simp
                   moreover from *** asm f2 ad 0 have "frame bal st''" using 44(3)[OF a1 None _ **, of cd' e'] by (simp add:frame_def)
                   moreover from * None ** *** have "st6' = st''" by (auto split:if_split_asm)
                   ultimately show ?thesis using f1 asm by auto
                 next
                   case (Some ex')
                   with * obtain v t st' where **:"expr ex' e\<^sub>p e\<^sub>v cd (st\<lparr>gas := gas st - costs (BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd st\<rparr>) = Normal ((v, t), st')" by (auto split:result.split_asm if_split_asm)
                   with * f1 Some have f2: "frame bal st'" using 44(1)[OF a1 Some] asm 0 by simp
                   moreover from Some * ** obtain cd' e' st'' where ***:"decl id0 tp (Some (v,t)) False cd (memory st') cd e\<^sub>v st' = Normal ((cd', e'), st'')" by (auto split:result.split_asm if_split_asm)
                   with * have f3: "frame bal st''" using decl_frame[OF f2 ***] by simp
                   moreover from ** *** have ad: "address e' = address e\<^sub>v" using decl_gas_address by simp
                   moreover from * Some ** *** obtain st''' where ****: "stmt smt e\<^sub>p e' cd' st'' = Normal ((), st''')" by (simp split:if_split_asm)
                   moreover from **** asm f3 ad have "frame bal st'''" using 44(2)[OF a1 Some ** _ _ ***] 0 by (simp add:frame_def)
                   moreover from * Some ** *** **** have "st6' = st'''" by (auto split:if_split_asm)
                   ultimately show ?thesis using f1 asm by auto
                 qed
               qed
             qed
           qed
         next
           show "?RHS" (is "?LHS \<longrightarrow> ?RHS")
           proof
             assume ad: "address e\<^sub>v = STR ''Victim''"
             show ?RHS (is "?A \<and> (?B \<and> ?C)")
             proof (rule conj3)
               show ?A (is "\<forall>s val bal x. ?LHS s val bal x")
               proof (rule allI[OF allI[OF allI[OF allI]]])
                 fix s val bal x
                 show "?LHS s val bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?B (is "\<forall>s bal x. ?LHS s bal x")
               proof (rule allI[OF allI[OF allI]])
                 fix s bal x
                 show "?LHS s bal x" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS
                   then show ?RHS by simp
                 qed
               qed
             next
               show ?C (is "\<forall>s bal. ?LHS s bal")
               proof (rule allI[OF allI])
                 fix s bal
                 show "?LHS s bal" (is "?LHS \<longrightarrow> ?RHS")
                 proof
                   assume ?LHS (is "?A1 \<and> ?A2 \<and> ?A3 \<and> ?A4 \<and> ?A5")
                   then have ?A1 and ?A2 and ?A3 and ?A4 and ?A5 by auto
 
                   define st'' where "st'' = st\<lparr>gas := gas st - costs keep e\<^sub>p e\<^sub>v cd st\<rparr>"
                   with `?A2` `?A3` have 00: "fmlookup (storage st'') (STR ''Victim'') = Some s"
                       and **: "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'') (STR ''Victim'')) - (SUMM s) \<ge> bal \<and> bal \<ge> 0 \<and> POS s" by simp+
                 
                   from `?A1` * st''_def obtain v t st''' cd' e' st'''' st'''''
                     where ***: "expr mylval e\<^sub>p e\<^sub>v cd st'' = Normal ((v,t), st''')"
                       and ****: "decl (STR ''bal'') (Value (TUInt 256)) (Some (v, t)) False cd (memory st''') cd e\<^sub>v st''' = Normal ((cd', e'),st'''')"
                       and *****: "stmt comp e\<^sub>p e' cd' st'''' = Normal ((), st''''')"
                       and "st6' = st'''''"
                     by (auto split:if_split_asm result.split_asm)
                 
                   obtain s''' where
                       f1: "fmlookup (storage st''') (STR ''Victim'') = Some s'''"
                       and v_def: "v = KValue (accessStorage (TUInt 256) (sender e\<^sub>v + (STR ''.'' + STR ''balance'')) s''')"
                       and t_def: "t = Value (TUInt 256)"
                       and f2: "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st''') (STR ''Victim'')) - (SUMM s''') \<ge> bal \<and> bal \<ge> 0 \<and> POS s'''"
                     using securelval[OF *** `?A4` 00 ** ad] by auto
                 
                   with **** obtain s'''' where 
                     *******: "fmlookup (storage st'''') (STR ''Victim'') = Some s''''"
                     and bbal: "ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st'''') (STR ''Victim'')) - (SUMM s'''') \<ge> bal \<and> bal \<ge> 0 \<and> POS s''''" using decl_frame frame_def by auto
                 
                   from ad `?A5` have 
                     ad2: "address e' = STR ''Victim''"
                     and ss: "sender e'\<noteq>address e'" using decl_gas_address[OF ****] by auto
                 
                   then obtain x where 
                     ******: "fmlookup (denvalue e') (STR ''bal'') = Some (Value (TUInt 256), (Stackloc x))"
                     and lkup: "fmlookup (denvalue e') STR ''balance'' = Some (Storage (STMap TAddr (STValue (TUInt 256))), Storeloc STR ''balance'')"
                     and "accessStore x (stack st'''') = Some (KValue (accessStorage (TUInt 256) (sender e\<^sub>v + (STR ''.'' + STR ''balance'')) s''''))"
                   proof -
                     have "Valuetypes.convert (TUInt 256) (TUInt 256) (accessStorage (TUInt 256) (sender e\<^sub>v + (STR ''.'' + STR ''balance'')) s''') = Some (accessStorage (TUInt 256) (sender e\<^sub>v + (STR ''.'' + STR ''balance'')) s''', TUInt 256)" by simp
                     with **** v_def t_def have "append (STR ''bal'') (Value (TUInt 256)) (KValue (accessStorage (TUInt 256) (sender e\<^sub>v + (STR ''.'' + STR ''balance'')) s''')) cd e\<^sub>v st''' = Normal ((cd', e'),st'''')" by simp
                     with f1 v_def t_def have st''''_def: "st'''' = st'''\<lparr>stack := push v (stack st''')\<rparr>" and "e' = updateEnv (STR ''bal'') t (Stackloc (ShowL\<^sub>n\<^sub>a\<^sub>t (toploc (stack st''')))) e\<^sub>v" by auto
                     moreover from ******* f1 st''''_def have "Some (KValue (accessStorage (TUInt 256) (sender e\<^sub>v + (STR ''.'' + STR ''balance'')) s''')) = Some (KValue (accessStorage (TUInt 256) (sender e\<^sub>v + (STR ''.'' + STR ''balance'')) s''''))" by simp
                     ultimately show ?thesis using t_def v_def `?A4` that by simp
                   qed
                   with decl_gas_address **** have sck: "accessStore x (stack st'''') = Some (KValue (accessStorage (TUInt 256) (sender e' + (STR ''.'' + STR ''balance'')) s''''))" by simp
 
                   from * have a1: "(applyf (costs(BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd) \<bind> (\<lambda>g. assert Gas (\<lambda>st. gas st \<le> g) (modify (\<lambda>st. st\<lparr>gas := gas st - g\<rparr>))))  st = Normal ((), st\<lparr>gas := gas st - costs (BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd st\<rparr>)" by auto
                   from `?A1` have a2: "ex = Some (LVAL (Ref STR ''balance'' [SENDER]))" by simp
                   from `?A1` *** have a3: "local.expr (LVAL (Ref STR ''balance'' [SENDER])) e\<^sub>p e\<^sub>v cd
                        (st\<lparr>gas := gas st - costs (BLOCK ((id0, tp), ex) smt) e\<^sub>p e\<^sub>v cd st\<rparr>) =
                       Normal ((v, t), st''')" using st''_def by simp
                   from `?A1` **** have a4: "decl id0 tp (Some (v, t)) False cd (memory st''') cd e\<^sub>v st''' = Normal ((cd', e'), st'''')" by simp
                   from `?A1` ***** `st6' = st'''''` have a5: "local.stmt smt e\<^sub>p e' cd' st'''' = Normal ((), st6')" by simp
                   show "(\<exists>s'. fmlookup (storage st6') STR ''Victim'' = Some s' \<and>
                          ReadL\<^sub>i\<^sub>n\<^sub>t (accessBalance (accounts st6') (STR ''Victim'')) - (SUMM s') \<ge> bal \<and> bal \<ge> 0 \<and> POS s')"
                     using 44(2)[OF a1 a2 a3 _ _ a4, of cd' e'] 0 a5 ad2 `?A1` ******* bbal ****** lkup sck `?A4` ss apply safe by auto
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 qed
 
 corollary final1:
   assumes "fmlookup ep (STR ''Victim'') = Some (victim, SKIP)"
       and "stmt (EXTERNAL (ADDRESS (STR ''Victim'')) (STR ''withdraw'') [] val) ep env cd st = Normal((), st')"
       and "address env \<noteq> (STR ''Victim'')"
       and "frame bal st"
       shows "frame bal st'"
   using assms secure(7)[of ep "(EXTERNAL (ADDRESS (STR ''Victim'')) (STR ''withdraw'') [] val)" env cd st] by simp
 
 corollary final2:
   assumes "fmlookup ep (STR ''Victim'') = Some (victim, SKIP)"
       and "stmt (EXTERNAL (ADDRESS (STR ''Victim'')) (STR ''deposit'') [] val) ep env cd st = Normal((), st')"
       and "address env \<noteq> (STR ''Victim'')"
       and "frame bal st"
       shows "frame bal st'"
   using assms secure(7)[of ep "(EXTERNAL (ADDRESS (STR ''Victim'')) (STR ''deposit'') [] val)" env cd st] by simp
 
 end
 
 end
diff --git a/thys/VectorSpace/MonoidSums.thy b/thys/VectorSpace/MonoidSums.thy
--- a/thys/VectorSpace/MonoidSums.thy
+++ b/thys/VectorSpace/MonoidSums.thy
@@ -1,118 +1,116 @@
 section \<open>Sums in monoids\<close>
 
 theory MonoidSums
 
 imports Main
   "HOL-Algebra.Module"
   RingModuleFacts
   FunctionLemmas
 begin
 
 text \<open>We build on the finite product simplifications in FiniteProduct.thy and the analogous ones
 for finite sums (see "lemmas" in Ring.thy).\<close>
 
 text \<open>Use as an intro rule\<close>
 lemma (in comm_monoid) factors_equal:
   "\<lbrakk>a=b; c=d\<rbrakk> \<Longrightarrow> a\<otimes>\<^bsub>G\<^esub>c =  b\<otimes>\<^bsub>G\<^esub>d"
   by simp
 
 
 lemma (in comm_monoid) extend_prod:
   fixes a A S
   assumes fin: "finite S" and subset: "A\<subseteq>S" and a: "a\<in>A\<rightarrow>carrier G"
   shows "(\<Otimes>\<^bsub>G\<^esub> x\<in>S. (if x\<in>A then a x else \<one>\<^bsub>G\<^esub>)) = (\<Otimes>\<^bsub>G\<^esub> x\<in>A. a x)"
   (is "(\<Otimes>\<^bsub>G\<^esub> x\<in>S. ?b x) = (\<Otimes>\<^bsub>G\<^esub> x\<in>A. a x)")
 proof - 
   from subset have uni:"S = A \<union> (S-A)" by auto
   from assms subset show ?thesis
     apply (subst uni)
     apply (subst finprod_Un_disjoint, auto)
     by (auto cong: finprod_cong if_cong elim: finite_subset simp add:Pi_def finite_subset)
 (*Pi_def is key for automation here*)
 qed
 
 text \<open>Scalar multiplication distributes over scalar multiplication (on left).\<close>(*Add to module.*)
 lemma (in module) finsum_smult:
   "[| c\<in> carrier R; g \<in> A \<rightarrow> carrier M |] ==>
    (c \<odot>\<^bsub>M\<^esub> finsum M g A) = finsum M (%x. c \<odot>\<^bsub>M\<^esub> g x) A "
 proof (induct A rule: infinite_finite_induct)
   case (insert a A)
   from insert.hyps insert.prems have 1: "finsum M g (insert a A) = g a \<oplus>\<^bsub>M\<^esub> finsum M g A"
     by (intro finsum_insert, auto)
   from insert.hyps insert.prems have 2: "(\<Oplus>\<^bsub>M\<^esub>x\<in>insert a A. c \<odot>\<^bsub>M\<^esub> g x) = c \<odot>\<^bsub>M\<^esub> g a \<oplus>\<^bsub>M\<^esub>(\<Oplus>\<^bsub>M\<^esub>x\<in>A. c \<odot>\<^bsub>M\<^esub> g x)" 
     by (intro finsum_insert, auto)
   from insert.hyps insert.prems show ?case 
     by (auto simp add:1 2 smult_r_distr)
 qed auto
 
 text \<open>Scalar multiplication distributes over scalar multiplication (on right).\<close>(*Add to module.*)
 lemma (in module) finsum_smult_r:
   "[| v\<in> carrier M; f \<in> A \<rightarrow> carrier R |] ==>
    (finsum R f A \<odot>\<^bsub>M\<^esub> v) = finsum M (%x. f x \<odot>\<^bsub>M\<^esub> v) A "
 proof (induct A rule: infinite_finite_induct)
   case (insert a A)
   from insert.hyps insert.prems have 1: "finsum R f (insert a A) = f a \<oplus>\<^bsub>R\<^esub> finsum R f A"
     by (intro R.finsum_insert, auto)
   from insert.hyps insert.prems have 2: "(\<Oplus>\<^bsub>M\<^esub>x\<in>insert a A. f x \<odot>\<^bsub>M\<^esub> v) = f a \<odot>\<^bsub>M\<^esub> v \<oplus>\<^bsub>M\<^esub>(\<Oplus>\<^bsub>M\<^esub>x\<in>A. f x \<odot>\<^bsub>M\<^esub> v)" 
     by (intro finsum_insert, auto)
   from insert.hyps insert.prems show ?case 
     by (auto simp add:1 2 smult_l_distr)
 qed auto
 
 text \<open>A sequence of lemmas that shows that the product does not depend on the ambient group. 
 Note I had to dig back into the definitions of foldSet to show this.\<close>
 (*Add the following 2 lemmas to Group.*)
 lemma foldSet_not_depend:
   fixes A E 
   assumes h1: "D\<subseteq>E"
   shows "foldSetD D f e \<subseteq>foldSetD E f e"
 proof -
   from h1 have 1: "\<And>x1 x2. (x1,x2) \<in> foldSetD D f e \<Longrightarrow> (x1, x2) \<in> foldSetD E f e" 
   proof -
     fix x1 x2 
     assume 2: "(x1,x2) \<in> foldSetD D f e"
     from h1 2 show "?thesis x1 x2"
     apply (intro foldSetD.induct[where ?D="D" and ?f="f" and ?e="e" and ?x1.0="x1" and ?x2.0="x2"
         and ?P = "\<lambda>x1 x2. ((x1, x2)\<in> foldSetD E f e)"]) 
       apply auto
      apply (intro emptyI, auto)
     by (intro insertI, auto)
   qed
   from 1 show ?thesis by auto
 qed 
 
 lemma foldD_not_depend:
   fixes D E B f e A
   assumes h1: "LCD B D f" and h2: "LCD B E f" and h3: "D\<subseteq>E" and h4: "e\<in>D" and h5: "A\<subseteq>B" and h6: "finite B"
   shows "foldD D f e A = foldD E f e A"
 proof - 
   from assms have 1: "\<exists>y. (A,y)\<in>foldSetD D f e"
-    apply (intro finite_imp_foldSetD, auto)
-     apply (metis finite_subset)
-    by (unfold LCD_def, auto)
+    by (intro finite_imp_foldSetD, auto simp: LCD_def)
   from 1 obtain y where 2: "(A,y)\<in>foldSetD D f e" by auto
   from assms 2 have 3: "foldD D f e A = y" by (intro LCD.foldD_equality[of B], auto)
   from h3 have 4: "foldSetD D f e \<subseteq> foldSetD E f e" by (rule foldSet_not_depend)
   from 2 4 have 5: "(A,y)\<in>foldSetD E f e" by auto
   from assms 5 have 6: "foldD E f e A = y" by (intro LCD.foldD_equality[of B], auto)
 (*(A,y)\<in>f*)
   from 3 6 show ?thesis by auto
 qed
 
 lemma (in comm_monoid) finprod_all1[simp]:
   assumes all1:" \<And>a. a\<in>A\<Longrightarrow>f a = \<one>\<^bsub>G\<^esub>"
   shows "(\<Otimes>\<^bsub>G\<^esub> a\<in>A. f a) = \<one>\<^bsub>G\<^esub>"
 (*  "[| \<And>a. a\<in>A\<Longrightarrow>f a = \<one>\<^bsub>G\<^esub> |] ==> (\<Otimes>\<^bsub>G\<^esub> a\<in>A. f a) = \<one>\<^bsub>G\<^esub>" won't work with proof - *)
 proof - 
   from assms show ?thesis
     by (simp cong: finprod_cong)
 qed
 
 context abelian_monoid
 begin
 lemmas summands_equal = add.factors_equal
 lemmas extend_sum = add.extend_prod
 lemmas finsum_all0 = add.finprod_all1
 end
 
 end
diff --git a/thys/VectorSpace/VectorSpace.thy b/thys/VectorSpace/VectorSpace.thy
--- a/thys/VectorSpace/VectorSpace.thy
+++ b/thys/VectorSpace/VectorSpace.thy
@@ -1,1210 +1,1207 @@
 section \<open>Basic theory of vector spaces, using locales\<close>
 
 theory VectorSpace
 imports Main
   "HOL-Algebra.Module"
   "HOL-Algebra.Coset"
   RingModuleFacts
   MonoidSums
   LinearCombinations
   SumSpaces
 begin
 
 subsection \<open>Basic definitions and facts carried over from modules\<close>
 text \<open>A \<open>vectorspace\<close> is a module where the ring is a field. 
 Note that we switch notation from $(R, M)$ to $(K, V)$.\<close>
 locale vectorspace = 
   module?: module K V + field?: field K  
   for K and V
 
 (*
 Use sets for bases, and functions from the sets to carrier K 
 represent the coefficients. 
 *)
 
 text \<open>A \<open>subspace\<close> of a vectorspace is a nonempty subset 
 that is closed under addition and scalar multiplication. These properties
 have already been defined in submodule. Caution: W is a set, while V is 
 a module record. To get W as a vectorspace, write vs W.\<close>
 locale subspace =
   fixes K and W and V (structure)
   assumes vs: "vectorspace K V"
       and submod: "submodule K W V"
 
 
 lemma (in vectorspace) is_module[simp]:
   "subspace K W V\<Longrightarrow>submodule K W V"
 by (unfold subspace_def, auto)
 
 text \<open>We introduce some basic facts and definitions copied from module.
 We introduce some abbreviations, to match convention.\<close>
 abbreviation (in vectorspace) vs::"'c set \<Rightarrow> ('a, 'c, 'd) module_scheme"
   where "vs W \<equiv> V\<lparr>carrier :=W\<rparr>"
 
 lemma (in vectorspace) carrier_vs_is_self [simp]:
   "carrier (vs W) = W"
   by auto
 
 lemma (in vectorspace) subspace_is_vs:
   fixes W::"'c set"
   assumes 0: "subspace K W V"
   shows "vectorspace K (vs W)"
 proof -
   from 0 show ?thesis
     apply (unfold vectorspace_def subspace_def, auto)
     by (intro submodule_is_module, auto)
 qed
 
 abbreviation (in module) subspace_sum:: "['c set, 'c set] \<Rightarrow> 'c set"
   where "subspace_sum W1 W2 \<equiv>submodule_sum W1 W2"
 
 lemma (in vectorspace) vs_zero_lin_dep: 
   assumes h2: "S\<subseteq>carrier V" and h3: "lin_indpt S"
   shows "\<zero>\<^bsub>V\<^esub> \<notin> S"
 proof -
   have vs: "vectorspace K V"..
   from vs have nonzero: "carrier K \<noteq>{\<zero>\<^bsub>K\<^esub>}"
     by (metis one_zeroI zero_not_one)
   from h2 h3 nonzero show ?thesis by (rule zero_nin_lin_indpt)
 qed
 
 text \<open>A \<open>linear_map\<close> is a module homomorphism between 2 vectorspaces
 over the same field.\<close>
 locale linear_map = 
   V?: vectorspace K V + W?: vectorspace K W
   + mod_hom?: mod_hom K V W T
     for K and V and W and T
 
 context linear_map
 begin
 lemmas T_hom = f_hom
 lemmas T_add = f_add
 lemmas T_smult = f_smult
 lemmas T_im = f_im
 lemmas T_neg = f_neg
 lemmas T_minus = f_minus
 lemmas T_ker = f_ker
 
 abbreviation imT:: "'e set"
   where "imT \<equiv> mod_hom.im"
 
 abbreviation kerT:: "'c set"
   where "kerT \<equiv> mod_hom.ker"
 
 lemmas T0_is_0[simp] = f0_is_0
 
 lemma kerT_is_subspace: "subspace K ker V"
 proof - 
   have vs: "vectorspace K V"..
   from vs show ?thesis
     apply (unfold subspace_def, auto)
     by (rule ker_is_submodule)
 qed
 
 lemma imT_is_subspace: "subspace K imT W"
 proof - 
   have vs: "vectorspace K W"..
   from vs show ?thesis
     apply (unfold subspace_def, auto)
     by (rule im_is_submodule)
 qed
 end
 
 lemma vs_criteria:
   fixes K and V 
   assumes field: "field K"
       and zero: "\<zero>\<^bsub>V\<^esub>\<in> carrier V" 
       and add: "\<forall>v w. v\<in>carrier V \<and> w\<in>carrier V\<longrightarrow> v\<oplus>\<^bsub>V\<^esub> w\<in> carrier V"
       and neg: "\<forall>v\<in>carrier V. (\<exists>neg_v\<in>carrier V. v\<oplus>\<^bsub>V\<^esub>neg_v=\<zero>\<^bsub>V\<^esub>)"
       and smult: "\<forall>c v. c\<in> carrier K \<and> v\<in>carrier V\<longrightarrow> c\<odot>\<^bsub>V\<^esub> v \<in> carrier V"
       and comm: "\<forall>v w. v\<in>carrier V \<and> w\<in>carrier V\<longrightarrow> v\<oplus>\<^bsub>V\<^esub> w=w\<oplus>\<^bsub>V\<^esub> v"
       and assoc: "\<forall>v w x. v\<in>carrier V \<and> w\<in>carrier V \<and> x\<in>carrier V\<longrightarrow> (v\<oplus>\<^bsub>V\<^esub> w)\<oplus>\<^bsub>V\<^esub> x= v\<oplus>\<^bsub>V\<^esub> (w\<oplus>\<^bsub>V\<^esub> x)"
       and add_id: "\<forall>v\<in>carrier V. (v\<oplus>\<^bsub>V\<^esub> \<zero>\<^bsub>V\<^esub> =v)"
       and compat: "\<forall>a b v. a\<in> carrier K \<and> b\<in> carrier K \<and> v\<in>carrier V\<longrightarrow> (a\<otimes>\<^bsub>K\<^esub> b)\<odot>\<^bsub>V\<^esub> v =a\<odot>\<^bsub>V\<^esub> (b\<odot>\<^bsub>V\<^esub> v)"
       and smult_id: "\<forall>v\<in>carrier V. (\<one>\<^bsub>K\<^esub> \<odot>\<^bsub>V\<^esub> v =v)"
       and dist_f: "\<forall>a b v. a\<in> carrier K \<and> b\<in> carrier K \<and> v\<in>carrier V\<longrightarrow> (a\<oplus>\<^bsub>K\<^esub> b)\<odot>\<^bsub>V\<^esub> v =(a\<odot>\<^bsub>V\<^esub> v) \<oplus>\<^bsub>V\<^esub> (b\<odot>\<^bsub>V\<^esub> v)"
       and dist_add: "\<forall>a v w. a\<in> carrier K \<and> v\<in>carrier V \<and> w\<in>carrier V\<longrightarrow> a\<odot>\<^bsub>V\<^esub> (v\<oplus>\<^bsub>V\<^esub> w) =(a\<odot>\<^bsub>V\<^esub> v) \<oplus>\<^bsub>V\<^esub> (a\<odot>\<^bsub>V\<^esub> w)"
   shows "vectorspace K V"
 proof - 
   from field have 1: "cring K" by (unfold field_def domain_def, auto)
   from assms 1 have 2: "module K V" by (intro module_criteria, auto)
   from field 2 show ?thesis by (unfold vectorspace_def module_def, auto)
 qed
 
 text \<open>For any set $S$, the space of functions $S\to K$ forms a vector space.\<close>
 lemma (in vectorspace) func_space_is_vs:
   fixes S
   shows "vectorspace K (func_space S)" 
 proof -
   have 0: "field K"..
   have 1: "module K (func_space S)" by (rule func_space_is_module)
   from 0 1 show ?thesis by (unfold vectorspace_def module_def, auto)
 qed
 
 
 lemma direct_sum_is_vs: 
   fixes K V1 V2
   assumes h1: "vectorspace K V1" and h2: "vectorspace K V2"
   shows "vectorspace K (direct_sum V1 V2)"
 proof -
   from h1 h2 have mod: "module K (direct_sum V1 V2)" by (unfold vectorspace_def, intro direct_sum_is_module, auto)
   from mod h1 show ?thesis by (unfold vectorspace_def, auto)
 qed
 
 lemma inj1_linear:
   fixes K V1 V2
   assumes h1: "vectorspace K V1" and h2: "vectorspace K V2"
   shows "linear_map K V1 (direct_sum V1 V2) (inj1 V1 V2)"
 proof - 
   from h1 h2 have mod: "mod_hom K V1 (direct_sum V1 V2) (inj1 V1 V2)" by (unfold vectorspace_def, intro inj1_hom, auto)
   from mod h1 h2 show ?thesis 
     by (unfold linear_map_def vectorspace_def , auto, intro direct_sum_is_module, auto)
 qed
 
 lemma inj2_linear:
   fixes K V1 V2
   assumes h1: "vectorspace K V1" and h2: "vectorspace K V2"
   shows "linear_map K V2 (direct_sum V1 V2) (inj2 V1 V2)"
 proof - 
   from h1 h2 have mod: "mod_hom K V2 (direct_sum V1 V2) (inj2 V1 V2)" by (unfold vectorspace_def, intro inj2_hom, auto)
   from mod h1 h2 show ?thesis 
     by (unfold linear_map_def vectorspace_def , auto, intro direct_sum_is_module, auto)
 qed
 
 text \<open>For subspaces $V_1,V_2\subseteq V$, the map $V_1\oplus V_2\to V$ given by $(v_1,v_2)\mapsto 
 v_1+v_2$ is linear.\<close>
 lemma (in vectorspace) sum_map_linear: 
   fixes V1 V2
   assumes h1: "subspace K V1 V" and h2: "subspace K V2 V"
   shows "linear_map K (direct_sum (vs V1) (vs V2)) V (\<lambda> v. (fst v) \<oplus>\<^bsub>V\<^esub> (snd v))"
 proof - 
   from h1 h2 have mod: "mod_hom K (direct_sum (vs V1) (vs V2)) V (\<lambda> v. (fst v) \<oplus>\<^bsub>V\<^esub> (snd v))" 
     by ( intro sum_map_hom, unfold subspace_def, auto)
   from mod h1 h2 show ?thesis 
     apply (unfold linear_map_def, auto) apply (intro direct_sum_is_vs subspace_is_vs, auto).. 
 qed
 
 lemma (in vectorspace) sum_is_subspace:
   fixes W1 W2
   assumes h1: "subspace K W1 V" and h2: "subspace K W2 V"
   shows "subspace K (subspace_sum W1 W2) V"
 proof -
   from h1 h2 have mod: "submodule K (submodule_sum W1 W2) V" 
     by ( intro sum_is_submodule, unfold subspace_def, auto)
   from mod h1 h2 show ?thesis 
     by (unfold subspace_def, auto)
 qed
 
 text \<open>If $W_1,W_2\subseteq V$ are subspaces, $W_1\subseteq W_1 + W_2$\<close>
 lemma (in vectorspace) in_sum_vs:
   fixes W1 W2
   assumes h1: "subspace K W1 V" and h2: "subspace K W2 V"
   shows "W1 \<subseteq> subspace_sum W1 W2"
 proof -
   from h1 h2 show ?thesis by (intro in_sum, unfold subspace_def, auto)
 qed
 
 lemma (in vectorspace) vsum_comm:
   fixes W1 W2
   assumes h1: "subspace K W1 V" and h2: "subspace K W2 V"
   shows "(subspace_sum W1 W2) = (subspace_sum W2 W1)"
 proof - 
   from h1 h2 show ?thesis by (intro msum_comm, unfold subspace_def, auto)
 qed
 
 text \<open>If $W_1,W_2\subseteq V$ are subspaces, then $W_1+W_2$ is the minimal subspace such that 
 both $W_1\subseteq W$ and $W_2\subseteq W$.\<close>
 lemma (in vectorspace) vsum_is_minimal:
   fixes W W1 W2
   assumes h1: "subspace K W1 V" and h2: "subspace K W2 V" and h3: "subspace K W V"
   shows "(subspace_sum W1 W2) \<subseteq> W \<longleftrightarrow> W1 \<subseteq> W \<and> W2 \<subseteq> W"
 proof - 
   from h1 h2 h3 show ?thesis by (intro sum_is_minimal, unfold subspace_def, auto)
 qed
 
 
 lemma (in vectorspace) span_is_subspace:
   fixes S
   assumes h2: "S\<subseteq>carrier V"
   shows "subspace K (span S) V"
 proof -
   have 0: "vectorspace K V"..
   from h2 have 1: "submodule K (span S) V" by (rule span_is_submodule)
   from 0 1 show ?thesis by (unfold subspace_def mod_hom_def linear_map_def, auto)
 qed
 
 subsubsection \<open>Facts specific to vector spaces\<close>
 
 text \<open>If $av = w$ and $a\neq 0$, $v=a^{-1}w$.\<close>
 lemma (in vectorspace) mult_inverse:
   assumes h1: "a\<in>carrier K" and h2: "v\<in>carrier V" and h3: "a \<odot>\<^bsub>V\<^esub> v = w" and h4: "a\<noteq>\<zero>\<^bsub>K\<^esub>"
   shows "v = (inv\<^bsub>K\<^esub> a )\<odot>\<^bsub>V\<^esub> w"
 proof -
   from h1 h2 h3 have 1: "w\<in>carrier V" by auto
   from h3 1 have 2: "(inv\<^bsub>K\<^esub> a )\<odot>\<^bsub>V\<^esub>(a \<odot>\<^bsub>V\<^esub> v) =(inv\<^bsub>K\<^esub> a )\<odot>\<^bsub>V\<^esub>w" by auto
   from h1 h4 have 3: "inv\<^bsub>K\<^esub> a\<in>carrier K" by auto
   interpret g: group "(units_group K)" by (rule units_form_group)
   have f: "field K"..
   from f h1 h4 have 4: "a\<in>Units K" 
     by (unfold field_def field_axioms_def, simp)
   from 4 h1 h4 have 5: "((inv\<^bsub>K\<^esub> a) \<otimes>\<^bsub>K\<^esub>a) = \<one>\<^bsub>K\<^esub>" 
     by (intro Units_l_inv, auto)
   from 5 have 6: "(inv\<^bsub>K\<^esub> a )\<odot>\<^bsub>V\<^esub>(a \<odot>\<^bsub>V\<^esub> v) = v" 
   proof - 
     from h1 h2 h4 have 7: "(inv\<^bsub>K\<^esub> a )\<odot>\<^bsub>V\<^esub>(a \<odot>\<^bsub>V\<^esub> v) =(inv\<^bsub>K\<^esub> a \<otimes>\<^bsub>K\<^esub>a) \<odot>\<^bsub>V\<^esub> v" by (auto simp add: smult_assoc1)
     from 5 h2 have 8: "(inv\<^bsub>K\<^esub> a \<otimes>\<^bsub>K\<^esub>a) \<odot>\<^bsub>V\<^esub> v = v" by auto
     from 7 8 show ?thesis by auto
   qed
   from 2 6 show ?thesis by auto
 qed
 
 text \<open>If $w\in S$ and $\sum_{w\in S} a_ww=0$, we have $v=\sum_{w\not\in S}a_v^{-1}a_ww$\<close>
 lemma (in vectorspace) lincomb_isolate: 
   fixes A v
   assumes h1: "finite A" and h2: "A\<subseteq>carrier V"  and h3: "a\<in>A\<rightarrow>carrier K" and h4: "v\<in>A"
     and h5: "a v \<noteq> \<zero>\<^bsub>K\<^esub>" and h6: "lincomb a A=\<zero>\<^bsub>V\<^esub>"
   shows "v=lincomb (\<lambda>w. \<ominus>\<^bsub>K\<^esub>(inv\<^bsub>K\<^esub> (a v)) \<otimes>\<^bsub>K\<^esub> a w) (A-{v})" and "v\<in> span (A-{v})"
 proof -
   from h1 h2 h3 h4 have 1: "lincomb a A = ((a v) \<odot>\<^bsub>V\<^esub> v) \<oplus>\<^bsub>V\<^esub> lincomb a (A-{v})" 
     by (rule lincomb_del2)
   from 1 have 2: "\<zero>\<^bsub>V\<^esub>= ((a v) \<odot>\<^bsub>V\<^esub> v) \<oplus>\<^bsub>V\<^esub> lincomb a (A-{v})" by (simp add: h6)
   from h1 h2 h3 have 5: "lincomb a (A-{v}) \<in>carrier V" by auto (*intro lincomb_closed*)
   from 2 h1 h2 h3 h4 have 3: " \<ominus>\<^bsub>V\<^esub> lincomb a (A-{v}) = ((a v) \<odot>\<^bsub>V\<^esub> v)" 
     by (auto intro!: M.minus_equality)
   have 6: "v = (\<ominus>\<^bsub>K\<^esub> (inv\<^bsub>K\<^esub> (a v))) \<odot>\<^bsub>V\<^esub> lincomb a (A-{v})"
   proof - 
     from h2 h3 h4 h5 3 have 7: "v = inv\<^bsub>K\<^esub> (a v) \<odot>\<^bsub>V\<^esub> (\<ominus>\<^bsub>V\<^esub> lincomb a (A-{v}))" 
       by (intro mult_inverse, auto)
     from assms have 8: "inv\<^bsub>K\<^esub> (a v)\<in>carrier K" by auto
     from assms 5 8 have 9: "inv\<^bsub>K\<^esub> (a v) \<odot>\<^bsub>V\<^esub> (\<ominus>\<^bsub>V\<^esub> lincomb a (A-{v})) 
       = (\<ominus>\<^bsub>K\<^esub> (inv\<^bsub>K\<^esub> (a v))) \<odot>\<^bsub>V\<^esub> lincomb a (A-{v})"
         by (simp add: smult_assoc_simp smult_minus_1_back r_minus)
     from 7 9 show ?thesis by auto
   qed
   from h1 have 10: "finite (A-{v})" by auto
   from assms have 11 : "(\<ominus>\<^bsub>K\<^esub> (inv\<^bsub>K\<^esub> (a v)))\<in> carrier K" by auto
   from assms have 12: "lincomb (\<lambda>w. \<ominus>\<^bsub>K\<^esub>(inv\<^bsub>K\<^esub> (a v)) \<otimes>\<^bsub>K\<^esub> a w) (A-{v}) = 
     (\<ominus>\<^bsub>K\<^esub> (inv\<^bsub>K\<^esub> (a v))) \<odot>\<^bsub>V\<^esub> lincomb a (A-{v})" 
     by (intro lincomb_smult, auto)
   from 6 12 show "v=lincomb (\<lambda>w. \<ominus>\<^bsub>K\<^esub>(inv\<^bsub>K\<^esub> (a v)) \<otimes>\<^bsub>K\<^esub> a w) (A-{v})" by auto
   with assms show "v\<in> span (A-{v})" 
     unfolding span_def 
     by (force simp add: 11 ring_subset_carrier)
 qed
 
 text \<open>The map $(S\to K)\mapsto V$ given by $(a_v)_{v\in S}\mapsto \sum_{v\in S} a_v v$ is linear.\<close>
 lemma (in vectorspace) lincomb_is_linear:
   fixes S
   assumes h: "finite S" and h2: "S\<subseteq>carrier V"
   shows "linear_map K (func_space S) V (\<lambda>a. lincomb a S)" 
 proof -
   have 0: "vectorspace K V"..
   from h h2 have 1: "mod_hom K (func_space S) V (\<lambda>a. lincomb a S)" by (rule lincomb_is_mod_hom)
   from 0 1 show ?thesis by (unfold vectorspace_def mod_hom_def linear_map_def, auto)
 qed
 
 subsection \<open>Basic facts about span and linear independence\<close>
 
 text \<open>If $S$ is linearly independent, then $v\in \text{span}S$ iff $S\cup \{v\}$ is linearly 
 dependent.\<close>
 theorem (in vectorspace) lin_dep_iff_in_span:
   fixes A v S
   assumes  h1: "S \<subseteq> carrier V" and h2: "lin_indpt S" and h3: "v\<in> carrier V" and h4: "v\<notin>S"
   shows "v\<in> span S \<longleftrightarrow> lin_dep (S \<union> {v})"
 proof -
   let ?T = "S \<union> {v}" 
   have 0: "v\<in>?T " by auto
   from h1 h3 have h1_1: "?T \<subseteq> carrier V" by auto
   have a1:"lin_dep ?T \<Longrightarrow> v\<in> span S"
   proof - 
     assume a11: "lin_dep ?T"
     from a11 obtain a w A where a: "(finite A \<and> A\<subseteq>?T \<and> (a\<in> (A\<rightarrow>carrier K)) \<and> (lincomb a A = \<zero>\<^bsub>V\<^esub>) \<and> (w\<in>A) \<and> (a w\<noteq> \<zero>\<^bsub>K\<^esub>))"
       by (metis lin_dep_def)
     from assms a have nz2: "\<exists>v\<in>A-S. a v\<noteq>\<zero>\<^bsub>K\<^esub>" 
       by (intro lincomb_must_include[where ?v="w" and ?T="S\<union>{v}"], auto)
     from a nz2 have singleton: "{v}=A-S" by auto
     from singleton nz2 have nz3: "a v\<noteq>\<zero>\<^bsub>K\<^esub>" by auto
 (*Can modularize this whole section out. "solving for one variable"*)
     let ?b="(\<lambda>w. \<ominus>\<^bsub>K\<^esub> (inv\<^bsub>K\<^esub> (a v)) \<otimes>\<^bsub>K\<^esub> (a w))"
     from singleton have Ains: "(A\<inter>S) = A-{v}" by auto
     from assms a singleton nz3 have a31: "v= lincomb ?b (A\<inter>S)" 
       apply (subst Ains)
       by (intro lincomb_isolate(1), auto)
     from a a31 nz3 singleton show ?thesis 
       apply (unfold span_def, auto) 
       apply (rule_tac x="?b" in exI)
       apply (rule_tac x="A\<inter>S" in exI) 
       by (auto intro!: m_closed)
   qed
   have a2: "v\<in> (span S) \<Longrightarrow> lin_dep ?T"
   proof - 
     assume inspan: "v\<in> (span S)"
     from inspan obtain a A where a: "A\<subseteq>S \<and> finite A \<and> (v = lincomb a A)\<and> a\<in>A\<rightarrow>carrier K" by (simp add: span_def, auto)
     let ?b = "\<lambda> w. if (w=v) then (\<ominus>\<^bsub>K\<^esub> \<one>\<^bsub>K\<^esub>) else a w" (*consider -v + \sum a_w w*)
     have lc0: " lincomb ?b (A\<union>{v})=\<zero>\<^bsub>V\<^esub>" 
     proof - 
       from assms a have lc_ins: "lincomb ?b (A\<union>{v}) = ((?b v) \<odot>\<^bsub>V\<^esub> v) \<oplus>\<^bsub>V\<^esub> lincomb ?b A" 
         by (intro lincomb_insert, auto)
       from assms a have lc_elim: "lincomb ?b A=lincomb a A" by (intro lincomb_elim_if, auto)
       from assms lc_ins lc_elim a show ?thesis by (simp add: M.l_neg smult_minus_1)
     qed
     from  a lc0 show ?thesis 
       apply (unfold lin_dep_def)
       apply (rule_tac x="A\<union>{v}" in exI)
       apply (rule_tac x="?b" in exI)
       apply (rule_tac x="v" in exI)
       by auto
   qed
   from a1 a2 show ?thesis by auto
 qed
 
 text \<open>If $v\in \text{span} A$ then $\text{span}A =\text{span}(A\cup \{v\})$\<close>
 lemma (in vectorspace) already_in_span:
   fixes v A
   assumes  inC: "A\<subseteq>carrier V" and inspan: "v\<in>span A"
   shows "span A= span (A\<union>{v})"
 proof - 
   from inC inspan have dir1: "span A \<subseteq> span (A\<union>{v})" by (intro span_is_monotone, auto)
 
   from inC have inown: "A\<subseteq>span A" by (rule in_own_span)
   from inC have subm: "submodule K (span A) V" by (rule span_is_submodule)
   from inown inspan subm have dir2: "span (A \<union> {v}) \<subseteq> span A" by (intro span_is_subset, auto) 
 
   from dir1 dir2 show ?thesis by auto
 qed
 
 subsection \<open>The Replacement Theorem\<close>
 
 text \<open>If $A,B\subseteq V$ are finite, $A$ is linearly independent, $B$ generates $W$, 
 and $A\subseteq W$, then there exists $C\subseteq V$ disjoint from $A$ such that
 $\text{span}(A\cup C) = W$ and $|C|\le |B|-|A|$. In other words, we can complete
 any linearly independent set to a generating set of $W$ by adding at most $|B|-|A|$ more elements.\<close>
 theorem (in vectorspace) replacement:
   fixes A B (*A B are lists of vectors (colloquially we refer to them as sets)*) 
   assumes h1: "finite A"
       and h2: "finite B"
       and h3: "B\<subseteq>carrier V"
       and h4: "lin_indpt A" (*A is linearly independent*)
       and h5: "A\<subseteq>span B" (*All entries of A are in K*)
   shows "\<exists>C. finite C \<and> C\<subseteq>carrier V \<and> C\<subseteq>span B \<and> C\<inter>A={} \<and> int (card C) \<le> (int (card B)) - (int (card A)) \<and> (span (A \<union> C) = span B)" 
   (is "\<exists>C. ?P A B C")
   (*There is a set C of cardinality |B| - |A| such that A\<union>C generates V*)
 using h1 h2 h3 h4 h5 
 proof (induct "card A" arbitrary: A B)
   case 0
   from "0.prems"(1) "0.hyps" have a0: "A={}" by auto
   from "0.prems"(3) have a3: "B\<subseteq>span B" by (rule in_own_span)
   from a0 a3 "0.prems" show ?case by (rule_tac x="B" in exI, auto)
 next
   case (Suc m)
   let ?W="span B"
   from Suc.prems(3) have BinC: "span B\<subseteq>carrier V" by (rule span_is_subset2)
   (*everything you want to know about A*)
   from Suc.prems Suc.hyps BinC have A: "finite A" "lin_indpt A" "A\<subseteq>span B" "Suc m = card A" "A\<subseteq>carrier V" 
     by auto
   (*everything you want to know about B*)
   from Suc.prems have B: "finite B" "B\<subseteq>carrier V" by auto
   (*A B are lists of vectors (colloquially we refer to them as sets)*) 
   from Suc.hyps(2) obtain v where v: "v\<in>A" by fastforce
   let ?A'="A-{v}"
   (*?A' is linearly independent because it is the subset of a linearly independent set, A.*)
   from A(2) have liA': "lin_indpt ?A'" 
     apply (intro subset_li_is_li[of "A" "?A'"]) 
      by auto
   from v liA' Suc.prems Suc.hyps(2) have "\<exists>C'. ?P ?A' B C'" 
     apply (intro Suc.hyps(1))
          by auto
   from this obtain C' where C': "?P ?A' B C'" by auto
 
   show ?case 
   proof (cases "v\<in> C'")
     case True
     have vinC': "v\<in>C'" by fact
     from vinC' v have seteq: "A - {v} \<union> C' = A \<union> (C' - {v})" by auto
     from C' seteq have spaneq: "span (A \<union> (C' - {v})) = span (B)" by algebra
     from Suc.prems Suc.hyps C' vinC' v spaneq show ?thesis
       apply (rule_tac x="C'-{v}" in exI)
       apply (subgoal_tac "card C' >0")
        by auto
   next 
     case False
     have f: "v\<notin>C'" by fact
     from A v C' have "\<exists>a. a\<in>(?A'\<union>C')\<rightarrow>carrier K \<and>  lincomb a (?A' \<union> C') =v" 
       by (intro finite_in_span, auto)
     from this obtain a where a: "a\<in>(?A'\<union>C')\<rightarrow>carrier K \<and> v= lincomb a (?A' \<union> C')" by metis
     let ?b="(\<lambda> w. if (w=v) then \<ominus>\<^bsub>K\<^esub>\<one>\<^bsub>K\<^esub> else a w)"
     from a have b: "?b\<in>A\<union>C'\<rightarrow>carrier K" by auto
     from v have rewrite_ins: "A\<union>C'=(?A'\<union>C')\<union>{v}" by auto
     from f have "v\<notin>?A'\<union>C'" by auto
     from this A C' v a f have lcb: "lincomb ?b (A \<union> C') = \<zero>\<^bsub>V\<^esub>"
       apply (subst rewrite_ins)
       apply (subst lincomb_insert)
            apply (simp_all add: ring_subset_carrier coeff_in_ring)
         apply (auto split: if_split_asm)
       apply (subst lincomb_elim_if)
           by (auto simp add: smult_minus_1 l_neg ring_subset_carrier)
 (*NOTE: l_neg got deleted from the simp rules, but it is very useful.*)
     from C' f have rewrite_minus: "C'=(A\<union>C')-A" by auto
     from A C' b lcb v have exw: "\<exists>w\<in> C'. ?b w\<noteq>\<zero>\<^bsub>K\<^esub>" 
       apply (subst rewrite_minus)
       apply (intro lincomb_must_include[where ?T="A\<union>C'" and ?v="v"])
               by auto
     from exw obtain w where w: "w\<in> C'" "?b w\<noteq>\<zero>\<^bsub>K\<^esub>" by auto
     from A C' w f b lcb have w_in: "w\<in>span ((A\<union> C') -{w})" 
       apply (intro lincomb_isolate[where a="?b"]) 
            by auto
     have spaneq2: "span (A\<union>(C'-{w})) = span B"
     proof - 
       have 1: "span (?A'\<union>C') = span (A\<union> C')" (*adding v doesn't change the span*)
         proof - 
           from A C' v have m1: "span (?A'\<union>C') = span ((?A'\<union> C')\<union>{v})"
             apply (intro already_in_span) 
              by auto
           from f m1 show ?thesis by (metis rewrite_ins)
         qed
       have 2: "span (A\<union> (C'-{w})) = span (A\<union> C')" (*removing w doesn't change the span*)
       proof - 
         from C' w(1) f have b60: "A\<union> (C'-{w}) = (A\<union> C') -{w}" by auto
         from  w(1) have b61: "A\<union> C'= (A\<union> C' -{w})\<union>{w}" by auto
         from A C'  w_in show ?thesis 
           apply (subst b61) 
           apply (subst b60) 
           apply (intro already_in_span) 
            by auto
         qed
     from C' 1 2 show ?thesis by auto
   qed(* "span (A\<union>(C'-{w})) = span B"*)
     from A C' w f v spaneq2 show ?thesis
       apply (rule_tac x="C'-{w}" in exI)
       apply (subgoal_tac "card C' >0")
        by auto
   qed
 qed
 
 subsection \<open>Defining dimension and bases.\<close>
 
 text \<open>Finite dimensional is defined as having a finite generating set.\<close>
 definition (in vectorspace) fin_dim:: "bool"
   where "fin_dim = (\<exists> A. ((finite A) \<and> (A \<subseteq> carrier V) \<and> (gen_set A)))"
 
 text \<open>The dimension is the size of the smallest generating set. For equivalent
 characterizations see below.\<close>
 definition (in vectorspace) dim:: "nat"
   where "dim = (LEAST n. (\<exists> A. ((finite A) \<and> (card A = n) \<and> (A \<subseteq> carrier V) \<and> (gen_set A))))"
 
 text \<open>A \<open>basis\<close> is a linearly independent generating set.\<close>
 definition (in vectorspace) basis:: "'c set \<Rightarrow> bool"
   where "basis A = ((lin_indpt A) \<and> (gen_set A)\<and> (A\<subseteq>carrier V))"
 
 text \<open>From the replacement theorem, any linearly independent set is smaller than any generating set.\<close>
 lemma (in vectorspace) li_smaller_than_gen:
   fixes A B
   assumes h1: "finite A" and h2: "finite B" and h3: "A\<subseteq>carrier V" and h4: "B\<subseteq>carrier V" 
     and h5: "lin_indpt A" and h6: "gen_set B"
   shows "card A \<le> card B"
 proof - 
   from h3 h6 have 1: "A\<subseteq>span B" by  auto
   from h1 h2 h4 h5 1 obtain C where 
     2: "finite C \<and> C\<subseteq>carrier V \<and> C\<subseteq>span B \<and> C\<inter>A={} \<and> int (card C) \<le> int (card B) - int (card A) \<and> (span (A \<union> C) = span B)" 
     by (metis replacement) 
   from 2 show ?thesis by arith
 qed
 
 text \<open>The dimension is the cardinality of any basis. (In particular, all bases are the same size.)\<close>
 lemma (in vectorspace) dim_basis:
   fixes A 
   assumes  fin: "finite A" and h2: "basis A"
   shows "dim = card A"
 proof - 
   have 0: "\<And>B m. ((finite B) \<and> (card B = m) \<and> (B \<subseteq> carrier V) \<and> (gen_set B)) \<Longrightarrow> card A \<le> m"
   proof - 
     fix B m 
     assume 1: "((finite B) \<and> (card B = m) \<and> (B \<subseteq> carrier V) \<and> (gen_set B))"
     from 1 fin h2 have 2: "card A \<le> card B" 
       apply (unfold basis_def) 
       apply (intro li_smaller_than_gen) 
            by auto
     from 1 2 show "?thesis B m" by auto
   qed
   from fin h2 0 show ?thesis
     apply (unfold dim_def basis_def) 
     apply (intro Least_equality)
      apply (rule_tac x="A" in exI)
      by auto 
 qed
 
 (*can define more generally with posets*)
 text \<open>A \<open>maximal\<close> set with respect to $P$ is such that if $B\supseteq A$ and $P$ is also 
 satisfied for $B$, then $B=A$.\<close>
 definition maximal::"'a set \<Rightarrow> ('a set \<Rightarrow> bool) \<Rightarrow> bool"
   where "maximal A P = ((P A) \<and> (\<forall>B. B\<supseteq>A \<and> P B \<longrightarrow> B = A))"
 
 text \<open>A \<open>minimal\<close> set with respect to $P$ is such that if $B\subseteq A$ and $P$ is also 
 satisfied for $B$, then $B=A$.\<close>
 definition minimal::"'a set \<Rightarrow> ('a set \<Rightarrow> bool) \<Rightarrow> bool"
   where "minimal A P = ((P A) \<and> (\<forall>B. B\<subseteq>A \<and> P B \<longrightarrow> B = A))"
  
 text \<open>A maximal linearly independent set is a generating set.\<close>
 lemma (in vectorspace) max_li_is_gen:
   fixes A
   assumes h1: "maximal A (\<lambda>S. S\<subseteq>carrier V \<and> lin_indpt S)"
   shows "gen_set A"
 proof (rule ccontr)
   assume 0: "\<not>(gen_set A)"
   from h1 have 1: " A\<subseteq> carrier V \<and> lin_indpt A" by (unfold maximal_def, auto)
   from 1 have 2: "span A \<subseteq> carrier V" by (intro span_is_subset2, auto)
   from 0 1 2 have 3: "\<exists>v. v\<in>carrier V \<and> v \<notin> (span A)"
     by auto
   from 3 obtain v where 4: "v\<in>carrier V \<and> v \<notin> (span A)" by auto
   have 5: "v\<notin>A" 
   proof - 
     from h1 1 have 51: "A\<subseteq>span A" apply (intro in_own_span) by auto
     from 4 51 show ?thesis by auto
   qed
   from lin_dep_iff_in_span have 6: "\<And>S v. S \<subseteq> carrier V\<and> lin_indpt S \<and> v\<in> carrier V \<and> v\<notin>S
     \<and> v\<notin> span S \<Longrightarrow>  (lin_indpt (S \<union> {v}))" by auto
   from 1 4 5 have 7: "lin_indpt (A \<union> {v})" apply (intro 6) by auto
 (*  assumes h0:"finite S" and h1: "S \<subseteq> carrier V" and h2: "lin_indpt S" and h3: "v\<in> carrier V" and h4: "v\<notin>S"
   shows "v\<in> span S \<longleftrightarrow>  \<not> (lin_indpt (S \<union> {v}))"*)
   have 9: "\<not>(maximal A (\<lambda>S. S\<subseteq>carrier V \<and> lin_indpt S))"
   proof - 
     from 1 4 5 7 have 8: "(\<exists>B. A \<subseteq> B  \<and> B \<subseteq> carrier V \<and> lin_indpt B \<and> B \<noteq> A)"
       apply (rule_tac x="A\<union>{v}" in exI) 
       by auto    
     from 8 show ?thesis 
       apply (unfold maximal_def) 
       by simp
   qed
   from h1 9 show False by auto
 qed
 
 text \<open>A minimal generating set is linearly independent.\<close>
 lemma (in vectorspace) min_gen_is_li:
   fixes A
   assumes h1: "minimal A (\<lambda>S. S\<subseteq>carrier V \<and> gen_set S)"
   shows "lin_indpt A"
 proof (rule ccontr)
   assume 0: "\<not>lin_indpt A"
   from h1 have 1: " A\<subseteq> carrier V \<and> gen_set A" by (unfold minimal_def, auto)
   from 1 have 2: "span A = carrier V" by auto
   from 0 1 obtain a v A' where 
     3: "finite A' \<and> A'\<subseteq>A \<and> a \<in> A' \<rightarrow> carrier K \<and> LinearCombinations.module.lincomb V a A' = \<zero>\<^bsub>V\<^esub> \<and> v \<in> A' \<and> a v \<noteq> \<zero>\<^bsub>K\<^esub>" 
     by (unfold lin_dep_def, auto)
   have 4: "gen_set (A-{v})"
   proof - 
     from 1 3 have 5: "v\<in>span (A'-{v})" 
       apply (intro lincomb_isolate[where a="a" and v="v"]) 
            by auto
     from 3 5 have 51: "v\<in>span (A-{v})"
       apply (intro subsetD[where ?A="span (A'-{v})" and ?B="span (A-{v})" and ?c="v"])
        by (intro span_is_monotone, auto)
     from 1 have 6: "A\<subseteq>span A" apply (intro in_own_span) by auto
     from 1 51 have 7: "span (A-{v}) = span ((A-{v})\<union>{v})" apply (intro already_in_span) by auto
     from 3 have 8: "A =  ((A-{v})\<union>{v})" by auto
     from 2 7 8 have 9:"span (A-{v}) = carrier V" by auto (*can't use 3 directly :( *)
     from 9 show ?thesis  by auto
   qed
   have 10: "\<not>(minimal A (\<lambda>S. S\<subseteq>carrier V \<and> gen_set S))"
   proof - 
     from 1 3 4 have 11: "(\<exists>B. A \<supseteq> B \<and> B \<subseteq> carrier V \<and> gen_set B \<and> B \<noteq> A)"
       apply (rule_tac x="A-{v}" in exI) 
       by auto
     from 11 show ?thesis 
       apply (unfold minimal_def) 
       by auto
   qed
   from h1 10 show False by auto
 qed
 
 text \<open>Given that some finite set satisfies $P$, there is a minimal set that satisfies $P$.\<close>
 lemma minimal_exists:
   fixes A P
   assumes h1: "finite A" and h2: "P A"
   shows "\<exists>B. B\<subseteq>A \<and> minimal B P"
 using h1 h2 
 proof (induct "card A"  arbitrary: A rule: less_induct)
 case (less A)
   show ?case
   proof (cases "card A = 0")  
   case True
     from True less.hyps less.prems show ?thesis
       apply (rule_tac x="{}" in exI)
       apply (unfold minimal_def)
       by  auto
   next
   case False
     show ?thesis
     proof (cases "minimal A P")
       case True
         then show ?thesis 
           apply (rule_tac x="A" in exI) 
           by auto
       next
       case False
         have 2: "\<not>minimal A P" by fact
         from less.prems 2 have 3: "\<exists>B. P B \<and> B \<subseteq> A \<and> B\<noteq>A"
           apply (unfold minimal_def) 
           by auto
         from 3 obtain B where 4: "P B \<and> B \<subset> A \<and> B\<noteq>A" by auto
         from 4 have 5: "card B < card A" by (metis less.prems(1) psubset_card_mono)
         from less.hyps less.prems 3 4 5 have 6: "\<exists>C\<subseteq>B. minimal C P" 
-          apply (intro less.hyps) 
-            apply auto
-          by (metis rev_finite_subset)
+          by (intro less.hyps, auto) 
         from 6 obtain C where 7: "C\<subseteq>B \<and> minimal C P" by auto
         from 4 7 show ?thesis 
           apply (rule_tac x="C" in exI) 
           apply (unfold minimal_def) 
           by auto
      qed
    qed
 qed
 
 text \<open>If $V$ is finite-dimensional, then any linearly independent set is finite.\<close>
 lemma (in vectorspace) fin_dim_li_fin:
   assumes fd: "fin_dim" and li: "lin_indpt A" and inC: "A\<subseteq>carrier V"
   shows fin: "finite A"
 proof (rule ccontr)
   assume A: "\<not>finite A"
   from fd obtain C where C: "finite C \<and> C\<subseteq>carrier V \<and> gen_set C" by (unfold fin_dim_def, auto)
   from A obtain B where B: "B\<subseteq>A\<and> finite B \<and> card B = card C + 1"
     by (metis infinite_arbitrarily_large) 
   from B li have liB: "lin_indpt B" 
     by (intro subset_li_is_li[where ?A="A" and ?B="B"], auto)
   from B C liB inC have "card B \<le> card C" by (intro li_smaller_than_gen, auto) 
   from this B show False by auto
 qed
 
 text \<open>If $V$ is finite-dimensional (has a finite generating set), then a finite basis exists.\<close>
 lemma (in vectorspace) finite_basis_exists:
   assumes h1: "fin_dim"
   shows "\<exists>\<beta>. finite \<beta> \<and> basis \<beta>"
 proof -
   from h1 obtain A where 1: "finite A \<and> A\<subseteq>carrier V \<and> gen_set A" by (metis fin_dim_def)
   hence 2: "\<exists>\<beta>. \<beta>\<subseteq>A \<and> minimal \<beta> (\<lambda>S. S\<subseteq>carrier V \<and> gen_set S)" 
     apply (intro minimal_exists) 
      by auto
   then obtain \<beta> where 3: "\<beta>\<subseteq>A \<and> minimal \<beta> (\<lambda>S. S\<subseteq>carrier V \<and> gen_set S)" by auto
   hence 4: "lin_indpt \<beta>" apply (intro min_gen_is_li) by auto
   moreover from 3 have 5: "gen_set \<beta> \<and> \<beta>\<subseteq>carrier V" apply (unfold minimal_def) by auto
   moreover from 1 3 have 6: "finite \<beta>" by (auto simp add: finite_subset)
   ultimately show ?thesis apply (unfold basis_def) by auto
 qed
 text\<open>
 The proof is as follows.
 \begin{enumerate}
 \item Because $V$ is finite-dimensional, there is a finite generating set 
 (we took this as our definition of finite-dimensional).
 \item Hence, there is a minimal $\beta \subseteq A$ such that $\beta$ generates $V$.
 \item $\beta$ is linearly independent because a minimal generating set is linearly independent.
 \end{enumerate}
 Finally, $\beta$ is a basis because it is both generating and linearly independent.
 \<close>
 
 text \<open>Any linearly independent set has cardinality at most equal to the dimension.\<close>
 lemma (in vectorspace) li_le_dim: 
   fixes A
   assumes fd: "fin_dim" and c: "A\<subseteq>carrier V" and l: "lin_indpt A"
   shows "finite A" "card A \<le> dim"
 proof  -
   from fd c l show fa: "finite A" by (intro fin_dim_li_fin, auto)
   from fd obtain \<beta> where 1: "finite \<beta> \<and> basis \<beta>" 
     by (metis finite_basis_exists)
   from assms fa 1 have 2: "card A \<le> card \<beta>" 
     apply (intro li_smaller_than_gen, auto) 
       by (unfold basis_def, auto)
   from assms 1 have 3: "dim = card \<beta>" by (intro dim_basis, auto)
   from 2 3 show "card A \<le> dim" by auto
 qed
 
 text \<open>Any generating set has cardinality at least equal to the dimension.\<close>
 lemma (in vectorspace) gen_ge_dim: 
   fixes A
   assumes fa: "finite A" and c: "A\<subseteq>carrier V" and l: "gen_set A"
   shows "card A \<ge> dim"
 proof  -
   from assms have fd: "fin_dim" by (unfold fin_dim_def, auto)
   from fd obtain \<beta> where 1: "finite \<beta> \<and> basis \<beta>" by (metis finite_basis_exists)
   from assms 1 have 2: "card A \<ge> card \<beta>" 
     apply (intro li_smaller_than_gen, auto) 
      by (unfold basis_def, auto)
   from assms 1 have 3: "dim = card \<beta>" by (intro dim_basis, auto)
   from 2 3 show ?thesis by auto
 qed
 
 
 text \<open>If there is an upper bound on the cardinality of sets satisfying $P$, then there is a maximal
 set satisfying $P$.\<close>
 lemma maximal_exists:
   fixes P B N
   assumes maxc: "\<And>A. P A \<Longrightarrow> finite A \<and> (card A \<le>N)" and b: "P B"
   shows "\<exists>A. finite A \<and> maximal A P"
 proof -
 (*take the maximal*)
   let ?S="{card A| A. P A}"
   let ?n="Max ?S"
   from maxc have 1:"finite ?S"
     apply (simp add: finite_nat_set_iff_bounded_le) by auto
   from 1 have 2: "?n\<in>?S"
     by (metis (mono_tags, lifting) Collect_empty_eq Max_in b) 
   from assms 2 have 3: "\<exists>A. P A \<and> finite A \<and> card A = ?n" 
     by auto
   from 3 obtain A where 4: "P A \<and> finite A \<and> card A = ?n" by auto
   from 1 maxc have 5: "\<And>A. P A \<Longrightarrow> finite A \<and> (card A \<le>?n)"
     by (metis (mono_tags, lifting) Max.coboundedI mem_Collect_eq) 
   from 4 5 have 6: "maximal A P"
     apply (unfold maximal_def)
     by (metis card_seteq)
   from 4 6 show ?thesis by auto
 qed
 
 text \<open>Any maximal linearly independent set is a basis.\<close>
 lemma (in vectorspace) max_li_is_basis:
   fixes A
   assumes h1: "maximal A (\<lambda>S. S\<subseteq>carrier V \<and> lin_indpt S)"
   shows "basis A"
 proof - 
   from h1 have 1: "gen_set A" by (rule max_li_is_gen)
   from assms 1 show ?thesis by (unfold basis_def maximal_def, auto)
 qed
 
 text \<open>Any minimal linearly independent set is a generating set.\<close>
 lemma (in vectorspace) min_gen_is_basis:
   fixes A
   assumes h1: "minimal A (\<lambda>S. S\<subseteq>carrier V \<and> gen_set S)"
   shows "basis A"
 proof - 
   from h1 have 1: "lin_indpt A" by (rule min_gen_is_li)
   from assms 1 show ?thesis by (unfold basis_def minimal_def, auto)
 qed
 
 text \<open>Any linearly independent set with cardinality at least the dimension is a basis.\<close>
 lemma (in vectorspace) dim_li_is_basis:
   fixes A
   assumes fd: "fin_dim" and fa: "finite A" and ca: "A\<subseteq>carrier V" and li: "lin_indpt A" 
     and d: "card A \<ge> dim" (*\<ge>*)
   shows "basis A"
 proof - 
   from fd have 0: "\<And>S. S\<subseteq>carrier V \<and> lin_indpt S \<Longrightarrow> finite S \<and> card S \<le>dim"
     by (auto intro: li_le_dim)
 (*fin_dim_li_fin*)
   from 0 assms have h1:  "finite A \<and> maximal A (\<lambda>S.  S\<subseteq>carrier V \<and> lin_indpt S)"
     apply (unfold maximal_def) 
     apply auto
     by (metis card_seteq eq_iff)
   from h1 show ?thesis by (auto intro: max_li_is_basis)
 qed
 
 text \<open>Any generating set with cardinality at most the dimension is a basis.\<close>
 lemma (in vectorspace) dim_gen_is_basis:
   fixes A
   assumes fa: "finite A" and ca: "A\<subseteq>carrier V" and li: "gen_set A" 
     and d: "card A \<le> dim"
   shows "basis A"
 proof - 
   have 0: "\<And>S. finite S\<and> S\<subseteq>carrier V \<and> gen_set S \<Longrightarrow> card S \<ge>dim"
     by (intro gen_ge_dim, auto)
 (*li_le_dim*)
   from 0 assms have h1:  "minimal A (\<lambda>S. finite S \<and> S\<subseteq>carrier V \<and> gen_set S)"
-    apply (unfold minimal_def) 
-    apply auto
-    by (metis card_seteq eq_iff)
+    unfolding minimal_def
+    by (metis card_seteq le_antisym) 
   (*slightly annoying: we have to get rid of "finite S" inside.*)
   from h1 have h: "\<And>B. B \<subseteq> A \<and> B \<subseteq> carrier V \<and> LinearCombinations.module.gen_set K V B \<Longrightarrow> B = A"
   proof - 
     fix B
     assume asm: "B \<subseteq> A \<and> B \<subseteq> carrier V \<and> LinearCombinations.module.gen_set K V B" 
     from asm h1 have "finite B" 
       apply (unfold minimal_def) 
        apply (intro finite_subset[where ?A="B" and ?B="A"]) 
        by auto
     from h1 asm this show "?thesis B" apply (unfold minimal_def) by simp
   qed
   from h1 h have h2: "minimal A (\<lambda>S. S\<subseteq>carrier V \<and> gen_set S)" 
     apply (unfold minimal_def)
     by presburger
   from h2 show ?thesis by (rule min_gen_is_basis)
 qed
 
 text \<open>$\beta$ is a basis iff for all $v\in V$, there exists a unique $(a_v)_{v\in S}$ such that
 $\sum_{v\in S} a_v v=v$.\<close>
 lemma (in vectorspace) basis_criterion:
   assumes A_fin: "finite A" and AinC: "A\<subseteq>carrier V"
   shows "basis A \<longleftrightarrow> (\<forall>v. v\<in> carrier V \<longrightarrow>(\<exists>! a.  a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v))"
 proof -
   have 1: "\<not>(\<forall>v.  v\<in> carrier V \<longrightarrow>(\<exists>! a.  a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v)) \<Longrightarrow> \<not>basis A"
   proof - 
     assume "\<not>(\<forall>v.  v\<in> carrier V \<longrightarrow>(\<exists>! a.  a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v))"
     then obtain v where v: "v\<in> carrier V \<and> \<not>(\<exists>! a.  a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v)" by metis
     (*either there is more than 1 rep, or no reps*)
     from v have vinC: "v\<in>carrier V" by auto
     from v have "\<not>(\<exists> a.  a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v) \<or>  (\<exists> a b. 
       a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v \<and> b\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb b A = v 
       \<and> a\<noteq>b)" by metis
     then show ?thesis
     proof
       assume a: "\<not>(\<exists> a.  a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v)"
       from A_fin AinC have "\<And>a. a\<in>A \<rightarrow> carrier K \<Longrightarrow> lincomb a A = lincomb (restrict a A) A" 
         unfolding lincomb_def restrict_def
         by (simp cong: finsum_cong add: ring_subset_carrier coeff_in_ring)
       with a have "\<not>(\<exists> a.  a\<in>A \<rightarrow> carrier K \<and> lincomb a A = v)" by auto
       with A_fin AinC have "v\<notin>span A"
         using finite_in_span by blast 
       with AinC v show "\<not>(basis A)" by (unfold basis_def, auto)
     next
       assume a2: "(\<exists> a b. 
         a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v \<and> b\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb b A = v 
         \<and> a\<noteq>b)"
       then obtain a b where ab: "a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v \<and> b\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb b A = v 
         \<and> a\<noteq>b" by metis
       from ab obtain w where w: "w\<in>A \<and> a w \<noteq> b w" apply (unfold PiE_def, auto)
         by (metis extensionalityI)
       let ?c="\<lambda> x. (if x\<in>A then ((a x) \<ominus>\<^bsub>K\<^esub> (b x)) else undefined)"
       from ab have a_fun: "a\<in>A \<rightarrow> carrier K" 
                and b_fun: "b\<in>A \<rightarrow> carrier K" 
         by (unfold PiE_def, auto)
       from w a_fun b_fun have abinC: "a w \<in>carrier K" "b w \<in>carrier K" by auto
 
       from abinC w have nz: "a w \<ominus>\<^bsub>K\<^esub> b w \<noteq> \<zero>\<^bsub>K\<^esub>" 
         by auto (*uses M.minus_other_side*)
       from A_fin AinC a_fun b_fun ab vinC have a_b:
       "LinearCombinations.module.lincomb V (\<lambda>x. if x \<in> A then a x \<ominus>\<^bsub>K\<^esub> b x else undefined) A = \<zero>\<^bsub>V\<^esub>"
         by (simp cong: lincomb_cong add: coeff_in_ring lincomb_diff)
       from A_fin AinC ab w v nz a_b have "lin_dep A"
         apply (intro lin_dep_crit[where ?A="A" and ?a="?c" and ?v="w"])
              apply (auto simp add: PiE_def)
         by auto
       thus "\<not>basis A" by (unfold basis_def, auto)
     qed
   qed
   have 2: "(\<forall>v. v\<in> carrier V \<longrightarrow>(\<exists>! a.  a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v)) \<Longrightarrow> basis A"
   proof -
     assume b1: "(\<forall>v. v\<in> carrier V \<longrightarrow>(\<exists>! a.  a\<in>A \<rightarrow>\<^sub>E carrier K \<and> lincomb a A = v))" 
       (is "(\<forall>v. v\<in> carrier V \<longrightarrow>(\<exists>! a.  ?Q a v))")
     from b1 have b2: "(\<forall>v.  v\<in> carrier V \<longrightarrow>(\<exists> a.  a\<in>A \<rightarrow> carrier K \<and> lincomb a A = v))" 
       apply (unfold PiE_def) 
       by blast 
     from A_fin AinC b2 have "gen_set A"
       apply (unfold span_def)
       by blast
     from b1 have A_li: "lin_indpt A"
     proof -
       let ?z="\<lambda> x. (if (x\<in>A) then \<zero>\<^bsub>K\<^esub> else undefined)" 
       from A_fin AinC have zero: "?Q ?z \<zero>\<^bsub>V\<^esub>" 
         by (unfold PiE_def extensional_def lincomb_def, auto simp add: ring_subset_carrier)
         (*uses finsum_all0*)
       from A_fin AinC show ?thesis 
       proof (rule finite_lin_indpt2)
         fix a
         assume a_fun: "a \<in> A \<rightarrow> carrier K" and
           lc_a: "LinearCombinations.module.lincomb V a A = \<zero>\<^bsub>V\<^esub>"
         from a_fun have a_res: "restrict a A \<in> A \<rightarrow>\<^sub>E carrier K" by auto
         from a_fun A_fin AinC lc_a have 
           lc_a_res: "LinearCombinations.module.lincomb V (restrict a A) A = \<zero>\<^bsub>V\<^esub>"
           apply (unfold lincomb_def restrict_def)
           by (simp cong: finsum_cong2 add: coeff_in_ring ring_subset_carrier)
         from a_fun a_res lc_a_res zero b1 have "restrict a A = ?z" by auto
         from this show "\<forall>v\<in>A. a v = \<zero>\<^bsub>K\<^esub>" 
           apply (unfold restrict_def)
           by meson
       qed
     qed
     have A_gen: "gen_set A" 
     proof - 
       from AinC have dir1: "span A\<subseteq>carrier V" by (rule span_is_subset2)
       have dir2: "carrier V\<subseteq>span A"
       proof (auto)
         fix v
         assume v: "v\<in>carrier V"
         from v b2 obtain a where "a\<in>A \<rightarrow> carrier K \<and> lincomb a A = v" by auto
         from this A_fin AinC show "v\<in>span A" by (subst finite_span, auto)
       qed
       from dir1 dir2 show ?thesis by auto
     qed
     from A_li A_gen AinC show "basis A" by (unfold basis_def, auto)
   qed
   from 1 2 show ?thesis by satx
 qed
 
 lemma (in linear_map) surj_imp_imT_carrier:
   assumes surj: "T` (carrier V) = carrier W"
   shows "(imT) = carrier W" 
   by (simp add: surj im_def)
 
 subsection \<open>The rank-nullity (dimension) theorem\<close>
 
 text \<open>If $V$ is finite-dimensional and $T:V\to W$ is a linear map, then $\text{dim}(\text{im}(T))+
 \text{dim}(\text{ker}(T)) = \text{dim} V$. Moreover, we prove that if $T$ is surjective 
   linear-map between $V$ and $W$, where $V$ is finite-dimensional, then also $W$ is finite-dimensional.\<close>
 theorem (in linear_map) rank_nullity_main: 
   assumes fd: "V.fin_dim"
   shows "(vectorspace.dim K (W.vs imT)) + (vectorspace.dim K (V.vs kerT)) = V.dim"       
     "T ` (carrier V) = carrier W \<Longrightarrow> W.fin_dim"
 proof - 
   \<comment> \<open>First interpret kerT, imT as vectorspaces\<close>
   have subs_ker: "subspace K kerT V" by (intro kerT_is_subspace)
   from subs_ker have vs_ker: "vectorspace K (V.vs kerT)" by (rule V.subspace_is_vs)
   from vs_ker interpret ker: vectorspace K "(V.vs kerT)" by auto
   have kerInC: "kerT\<subseteq>carrier V" by (unfold ker_def, auto)
 
   have subs_im: "subspace K imT W" by (intro imT_is_subspace)  
   from subs_im have vs_im: "vectorspace K (W.vs imT)" by (rule W.subspace_is_vs)
   from vs_im interpret im: vectorspace K "(W.vs imT)" by auto
   have imInC: "imT\<subseteq>carrier W" by (unfold im_def, auto)
   (* obvious fact *)
   have zero_same[simp]: "\<zero>\<^bsub>V.vs kerT\<^esub> = \<zero>\<^bsub>V\<^esub>" apply (unfold ker_def) by auto
   \<comment> \<open>Show ker T has a finite basis. This is not obvious. Show that any linearly independent set 
 has size at most that of V. There exists a maximal linearly independent set, which is the basis.\<close>
   have every_li_small: "\<And>A. (A \<subseteq> kerT)\<and> ker.lin_indpt A \<Longrightarrow> 
     finite A \<and> card A \<le> V.dim"
   proof - 
     fix A
     assume eli_asm: "(A \<subseteq> kerT)\<and> ker.lin_indpt A"
     (*annoying: I can't just use subst V.module.span_li_not_depend(2) in the show ?thesis 
     statement because it doesn't appear in the conclusion.*)
     note V.module.span_li_not_depend(2)[where ?N="kerT" and ?S="A"] 
     from this subs_ker fd eli_asm kerInC show "?thesis A" 
       apply (intro conjI) 
        by (auto intro!: V.li_le_dim)
   qed
   from every_li_small have exA: 
     "\<exists>A. finite A \<and> maximal A (\<lambda>S. S\<subseteq>carrier (V.vs kerT) \<and> ker.lin_indpt S)"
     apply (intro maximal_exists[where ?N="V.dim" and ?B="{}"])
      apply auto
     by (unfold ker.lin_dep_def, auto)
   from exA obtain A where A:" finite A \<and> maximal A (\<lambda>S. S\<subseteq>carrier (V.vs kerT) \<and> ker.lin_indpt S)" 
     by blast
   hence finA: "finite A" and Ainker: "A\<subseteq>carrier (V.vs kerT)" and AinC: "A\<subseteq>carrier V"
     by (unfold maximal_def ker_def, auto)
   \<comment> \<open>We obtain the basis A of kerT. It is also linearly independent when considered in V rather
 than kerT\<close>
   from A have Abasis: "ker.basis A" 
     by (intro ker.max_li_is_basis, auto) 
   from subs_ker Abasis have spanA: "V.module.span A = kerT"
     apply (unfold ker.basis_def)
     by (subst sym[OF V.module.span_li_not_depend(1)[where ?N="kerT"]], auto)
   from Abasis have Akerli: "ker.lin_indpt A" 
     apply (unfold ker.basis_def) 
     by auto
   from subs_ker Ainker Akerli have Ali: "V.module.lin_indpt A" 
     by (auto simp add: V.module.span_li_not_depend(2))
   txt\<open>Use the replacement theorem to find C such that $A\cup C$ is a basis of V.\<close>
   from fd obtain B where B: "finite B\<and> V.basis B" by (metis V.finite_basis_exists)
   from B have Bfin: "finite B" and Bbasis:"V.basis B" by auto
   from B have Bcard: "V.dim = card B" by (intro V.dim_basis, auto) 
   from Bbasis have 62: "V.module.span B = carrier V" 
     by (unfold V.basis_def, auto)
   from A Abasis Ali B vs_ker have "\<exists>C. finite C \<and> C\<subseteq>carrier V \<and> C\<subseteq> V.module.span B \<and> C\<inter>A={} 
       \<and> int (card C) \<le> (int (card B)) - (int (card A)) \<and> (V.module.span (A \<union> C) = V.module.span B)"
     apply (intro V.replacement)
     apply (unfold vectorspace.basis_def V.basis_def)
       by (unfold ker_def, auto)
   txt \<open>From replacement we got $|C|\leq |B|-|A|$. Equality must actually hold, because no generating set
 can be smaller than $B$. Now $A\cup C$ is a maximal generating set, hence a basis; its cardinality
 equals the dimension.\<close>
   txt \<open>We claim that $T(C)$ is basis for $\text{im}(T)$.\<close>
   then obtain C where C: "finite C \<and> C\<subseteq>carrier V \<and> C\<subseteq> V.module.span B \<and> C\<inter>A={} 
     \<and> int (card C) \<le> (int (card B)) - (int (card A)) \<and> (V.module.span (A \<union> C) = V.module.span B)" by auto
   hence Cfin: "finite C" and CinC: "C\<subseteq>carrier V" and CinspanB: " C\<subseteq>V.module.span B" and CAdis: "C\<inter>A={}" 
     and Ccard: "int (card C) \<le> (int (card B)) - (int (card A))"
     and ACspanB: "(V.module.span (A \<union> C) = V.module.span B)" by auto
   from C have cardLe: "card A + card C \<le> card B" by auto
   from B C have ACgen: "V.module.gen_set (A\<union>C)" apply (unfold V.basis_def) by auto
   from finA C ACgen AinC B have cardGe: "card (A\<union>C) \<ge> card B" by (intro V.li_smaller_than_gen, unfold V.basis_def, auto)
   from finA C have cardUn: "card (A\<union>C)\<le>  card A + card C"
     by (metis Int_commute card_Un_disjoint le_refl)
   from cardLe cardUn cardGe Bcard have cardEq: 
     "card (A\<union>C) = card A + card C" 
     "card (A\<union>C) = card B" 
     "card (A\<union>C) = V.dim" 
     by auto
   from Abasis C cardEq have disj: "A\<inter>C={}" by auto
   from finA AinC C cardEq 62 have ACfin: "finite (A\<union>C)" and ACbasis: "V.basis (A\<union>C)" 
     by (auto intro!: V.dim_gen_is_basis) 
   have lm: "linear_map K V W T"..
   txt \<open>Let $C'$ be the image of $C$ under $T$. We will show $C'$ is a basis for $\text{im}(T)$.\<close>
   let ?C' = "T`C"
   from Cfin have C'fin: "finite ?C'" by auto
   from AinC C have cim: "?C'\<subseteq>imT" by (unfold im_def, auto)
 
   txt \<open>"There is a subtle detail: we first have to show $T$ is injective on $C$.\<close>
   txt \<open>We establish that no nontrivial linear combination of $C$ can have image 0 under $T$, 
 because that would mean it is a linear combination of $A$, giving that $A\cup C$ is linearly dependent, 
 contradiction. We use this result in 2 ways: (1) if $T$ is not injective on $C$, then we obtain $v$, $w\in C$ 
 such that $v-w$ is in the kernel, contradiction, (2) if $T(C)$ is linearly dependent, 
 taking the inverse image of that linear combination gives a linear combination of $C$ in the kernel, 
 contradiction. Hence $T$ is injective on $C$ and $T(C)$ is linearly independent.\<close>
   have lc_in_ker: "\<And>d D v. \<lbrakk>D\<subseteq>C; d\<in>D\<rightarrow>carrier K; T (V.module.lincomb d D) = \<zero>\<^bsub>W\<^esub>; 
     v\<in>D; d v \<noteq>\<zero>\<^bsub>K\<^esub>\<rbrakk>\<Longrightarrow>False"
   proof -
     fix d D v
     assume D: "D\<subseteq>C" and d: "d\<in>D\<rightarrow>carrier K" and T0: "T (V.module.lincomb d D) = \<zero>\<^bsub>W\<^esub>" 
       and v: "v\<in>D" and dvnz: "d v \<noteq>\<zero>\<^bsub>K\<^esub>"
     from D Cfin have Dfin: "finite D"  by (auto intro: finite_subset)
     from D CinC have DinC: "D\<subseteq>carrier V" by auto
     from T0 d Dfin DinC have lc_d: "V.module.lincomb d D\<in>kerT" 
       by (unfold ker_def, auto)
     from lc_d spanA AinC have  "\<exists>a' A'. A'\<subseteq>A \<and> a'\<in>A'\<rightarrow>carrier K \<and>
        V.module.lincomb a' A'= V.module.lincomb d D" 
       by (intro V.module.in_span, auto)
     then obtain a' A' where a': "A'\<subseteq>A \<and> a'\<in>A'\<rightarrow>carrier K \<and>
       V.module.lincomb d D = V.module.lincomb a' A'" 
       by metis
     hence  A'sub: "A'\<subseteq>A" and a'fun: "a'\<in>A'\<rightarrow>carrier K" 
       and a'_lc:"V.module.lincomb d D = V.module.lincomb a' A'"  by auto
     from a' finA Dfin have A'fin: "finite (A')"  by (auto intro: finite_subset)
     from AinC A'sub have A'inC: "A'\<subseteq>carrier V" by auto
     let ?e = "(\<lambda>v. if v \<in> A' then a' v else \<ominus>\<^bsub>K\<^esub>\<one>\<^bsub>K\<^esub>\<otimes>\<^bsub>K\<^esub> d v)"
     from a'fun d have e_fun: "?e \<in> A' \<union> D \<rightarrow> carrier K" 
       apply (unfold Pi_def) 
       by auto
     from
       A'fin Dfin (*finiteness*)
       A'inC DinC (*in carrier*)
       a'fun d e_fun (*coefficients valid*)
       disj D A'sub (*A and C disjoint*)
     have lccomp1:
       "V.module.lincomb a' A' \<oplus>\<^bsub>V\<^esub> \<ominus>\<^bsub>K\<^esub>\<one>\<^bsub>K\<^esub>\<odot>\<^bsub>V\<^esub> V.module.lincomb d D = 
         V.module.lincomb (\<lambda>v. if v\<in>A' then a' v else \<ominus>\<^bsub>K\<^esub>\<one>\<^bsub>K\<^esub>\<otimes>\<^bsub>K\<^esub> d v) (A'\<union>D)"
       apply (subst sym[OF V.module.lincomb_smult])
           apply (simp_all)
       apply (subst V.module.lincomb_union2)
            by (auto)
     from
       A'fin (*finiteness*)
       A'inC (*in carrier*)
       a'fun (*coefficients valid*)
     have lccomp2: 
       "V.module.lincomb a' A' \<oplus>\<^bsub>V\<^esub> \<ominus>\<^bsub>K\<^esub>\<one>\<^bsub>K\<^esub>\<odot>\<^bsub>V\<^esub> V.module.lincomb d D = 
       \<zero>\<^bsub>V\<^esub>" 
       by (simp add: a'_lc 
         V.module.smult_minus_1  V.module.M.r_neg)
     from lccomp1 lccomp2 have lc0: "V.module.lincomb (\<lambda>v. if v\<in>A' then a' v else \<ominus>\<^bsub>K\<^esub>\<one>\<^bsub>K\<^esub>\<otimes>\<^bsub>K\<^esub> d v) (A'\<union>D)
       =\<zero>\<^bsub>V\<^esub>" by auto
     from disj a' v D have v_nin: "v\<notin>A'" by auto
     from A'fin Dfin (*finiteness*)
       A'inC DinC (*in carrier*)
       e_fun d (*coefficients valid*)
       A'sub D disj (*A' D are disjoint subsets*)
       v dvnz (*d v is nonzero coefficient*)
       lc0
     have AC_ld: "V.module.lin_dep (A\<union>C)" 
       apply (intro V.module.lin_dep_crit[where ?A="A'\<union>D" and 
         ?S="A\<union>C" and ?a="\<lambda>v. if v\<in>A' then a' v else \<ominus>\<^bsub>K\<^esub>\<one>\<^bsub>K\<^esub>\<otimes>\<^bsub>K\<^esub> d v" and ?v="v"])
            by (auto dest: integral)
     from AC_ld ACbasis show False by (unfold V.basis_def, auto)
   qed
   have C'_card: "inj_on T C" "card C = card ?C'"
   proof -
     show "inj_on T C"
     proof (rule ccontr)
       assume "\<not>inj_on T C"
       then obtain v w where "v\<in>C" "w\<in>C" "v\<noteq>w" "T v = T w" by (unfold inj_on_def, auto) 
       from this CinC show False 
         apply (intro lc_in_ker[where ?D1="{v,w}" and ?d1="\<lambda>x. if x=v then \<one>\<^bsub>K\<^esub> else \<ominus>\<^bsub>K\<^esub>\<one>\<^bsub>K\<^esub>"
           and ?v1="v"])
             by (auto simp add: V.module.lincomb_def hom_sum ring_subset_carrier 
               W.module.smult_minus_1 r_neg T_im)
     qed
     from this Cfin show "card C = card ?C'"
       by (metis card_image) 
   qed
   let ?f="the_inv_into C T"
   have f: "\<And>x. x\<in>C \<Longrightarrow> ?f (T x) = x" "\<And>y. y\<in>?C' \<Longrightarrow> T (?f y) = y"
     apply (insert C'_card(1))
      apply (metis the_inv_into_f_f)
     by (metis f_the_inv_into_f)
 (*We show C' is a basis for the image. First we show it is linearly independent.*)
   have C'_li: "im.lin_indpt ?C'"
   proof (rule ccontr)
     assume Cld: "\<not>im.lin_indpt ?C'"
     from Cld cim subs_im have CldW: "W.module.lin_dep ?C'" 
       apply (subst sym[OF W.module.span_li_not_depend(2)[where ?S="T`C" and ?N="imT"]]) 
         by auto
     from C CldW have "\<exists>c' v'. (c'\<in> (?C'\<rightarrow>carrier K)) \<and> (W.module.lincomb c' ?C' = \<zero>\<^bsub>W\<^esub>) 
       \<and> (v'\<in>?C') \<and> (c' v'\<noteq> \<zero>\<^bsub>K\<^esub>)" by (intro W.module.finite_lin_dep, auto)
     then obtain c' v' where c': "(c'\<in> (?C'\<rightarrow>carrier K)) \<and> (W.module.lincomb c' ?C' = \<zero>\<^bsub>W\<^esub>) 
       \<and> (v'\<in>?C') \<and> (c' v'\<noteq> \<zero>\<^bsub>K\<^esub>)" by auto
     hence c'fun: "(c'\<in> (?C'\<rightarrow>carrier K))" and c'lc: "(W.module.lincomb c' ?C' = \<zero>\<^bsub>W\<^esub>)" and 
       v':"(v'\<in>?C')" and cvnz: "(c' v'\<noteq> \<zero>\<^bsub>K\<^esub>)" by auto
 (*can't get c' directly with metis/auto with W.module.finite_lin_dep*)
     txt \<open>We take the inverse image of $C'$ under $T$ to get a linear combination of $C$ that is 
 in the kernel and hence a linear combination of $A$. This contradicts $A\cup C$ being linearly
 independent.\<close>
     let ?c="\<lambda>v. c' (T v)"
     from c'fun have c_fun: "?c\<in> C\<rightarrow>carrier K" by auto
     from Cfin (*C finite*)
       c_fun c'fun (*coefficients valid*)
       C'_card (*bijective*)
       CinC (*C in carrier*)
       f (*inverse to T*) 
       c'lc (*lc c' = 0*)
     have "T (V.module.lincomb ?c C) = \<zero>\<^bsub>W\<^esub>"
       apply (unfold V.module.lincomb_def W.module.lincomb_def)
       apply (subst hom_sum, auto)
       apply (simp cong: finsum_cong add: ring_subset_carrier coeff_in_ring)
       apply (subst finsum_reindex[where ?f="\<lambda>w. c' w \<odot>\<^bsub>W\<^esub> w" and ?h="T" and ?A="C", THEN sym])
          by auto
     with f c'fun cvnz v' show False
       by (intro lc_in_ker[where ?D1="C" and ?d1="?c" and ?v1="?f v'"], auto)
   qed
   have C'_gen: "im.gen_set ?C'"
   proof - 
     have C'_span: "span ?C' = imT"
     proof (rule equalityI)
       from cim subs_im show "W.module.span ?C' \<subseteq> imT"
         by (intro span_is_subset, unfold subspace_def, auto)
     next
       show "imT\<subseteq>W.module.span ?C'"
       proof (auto)
         fix w
         assume w: "w\<in>imT"
         from this finA Cfin AinC CinC obtain v where v_inC: "v\<in>carrier V" and w_eq_T_v: "w= T v" 
           by (unfold im_def image_def, auto)
         from finA Cfin AinC CinC v_inC ACgen have "\<exists>a.  a \<in> A\<union>C \<rightarrow> carrier K\<and> V.module.lincomb a (A\<union>C) = v"
           by (intro V.module.finite_in_span, auto)
         then obtain a where 
           a_fun: "a \<in> A\<union>C \<rightarrow> carrier K" and
           lc_a_v: "v= V.module.lincomb a (A\<union>C)"
           by auto
         let ?a'="\<lambda>v. a (?f v)"
         from finA Cfin AinC CinC a_fun disj Ainker f C'_card have Tv: "T v = W.module.lincomb ?a' ?C'"
           apply (subst lc_a_v)
           apply (subst V.module.lincomb_union, simp_all) (*Break up the union A\<union>C*)
           apply (unfold lincomb_def V.module.lincomb_def)
           apply (subst hom_sum, auto) (*Take T inside the sum over A*)
           apply (simp add: subsetD coeff_in_ring
             hom_sum (*Take T inside the sum over C*)
             T_ker (*all terms become 0 because the vectors are in the kernel.*)
             ) 
           apply (subst finsum_reindex[where ?h="T" and ?f="\<lambda>v. ?a' v\<odot>\<^bsub>W\<^esub> v"], auto)
            by (auto cong: finsum_cong simp add: coeff_in_ring ring_subset_carrier)
         from a_fun f have a'_fun: "?a'\<in>?C' \<rightarrow> carrier K" by auto
         from C'fin CinC this w_eq_T_v a'_fun Tv show "w \<in> LinearCombinations.module.span K W (T ` C)" 
           by (subst finite_span, auto)
       qed
     qed
     from this subs_im CinC show ?thesis 
       apply (subst span_li_not_depend(1))
         by (unfold im_def subspace_def, auto)
   qed
   from C'_li C'_gen C cim have C'_basis: "im.basis  (T`C)" 
     by (unfold im.basis_def, auto)
   have C_card_im: "card C = (vectorspace.dim K (W.vs imT))"
     using C'_basis C'_card(2) C'fin im.dim_basis by auto
   from finA Abasis have  "ker.dim = card A" by (rule ker.dim_basis)
   note * = this C_card_im cardEq 
   show "(vectorspace.dim K (W.vs imT)) + (vectorspace.dim K (V.vs kerT)) = V.dim"  using * by auto
   assume "T` (carrier V) = carrier W" 
   from * surj_imp_imT_carrier[OF this]  
   show "W.fin_dim" using C'_basis C'fin unfolding W.fin_dim_def im.basis_def by auto
 qed
 
 theorem (in linear_map) rank_nullity: 
   assumes fd: "V.fin_dim"
   shows "(vectorspace.dim K (W.vs imT)) + (vectorspace.dim K (V.vs kerT)) = V.dim"       
   by (rule rank_nullity_main[OF fd])
 
 
 end
 
diff --git a/thys/Verified_SAT_Based_AI_Planning/SAS_Plus_STRIPS.thy b/thys/Verified_SAT_Based_AI_Planning/SAS_Plus_STRIPS.thy
--- a/thys/Verified_SAT_Based_AI_Planning/SAS_Plus_STRIPS.thy
+++ b/thys/Verified_SAT_Based_AI_Planning/SAS_Plus_STRIPS.thy
@@ -1,4403 +1,4402 @@
 (*
   Author: Mohammad Abdulaziz, Fred Kurz
 *)
 theory SAS_Plus_STRIPS
   imports "STRIPS_Semantics" "SAS_Plus_Semantics" 
     "Map_Supplement"
 begin
 
 section "SAS+/STRIPS Equivalence"
 
 text \<open> The following part is concerned with showing the equivalent expressiveness of SAS+ and
 STRIPS as discussed in \autoref{sub:equivalence-sas-plus-strips}. \<close>
 
 subsection "Translation of SAS+ Problems to STRIPS Problems"
 
 definition possible_assignments_for 
   :: "('variable, 'domain) sas_plus_problem \<Rightarrow> 'variable \<Rightarrow> ('variable \<times> 'domain) list" 
   where "possible_assignments_for \<Psi> v \<equiv> [(v, a). a \<leftarrow> the (range_of \<Psi> v)]"
 
 definition all_possible_assignments_for
   :: "('variable, 'domain) sas_plus_problem \<Rightarrow> ('variable \<times> 'domain) list"
   where "all_possible_assignments_for \<Psi> 
     \<equiv> concat [possible_assignments_for \<Psi> v. v \<leftarrow> variables_of \<Psi>]" 
 
 definition state_to_strips_state
   :: "('variable, 'domain) sas_plus_problem 
     \<Rightarrow> ('variable, 'domain) state 
     \<Rightarrow> ('variable, 'domain) assignment strips_state" 
   ("\<phi>\<^sub>S _ _" 99)
   where "state_to_strips_state \<Psi> s 
     \<equiv> let defined = filter (\<lambda>v. s v \<noteq> None) (variables_of \<Psi>) in
       map_of (map (\<lambda>(v, a). ((v, a), the (s v) = a)) 
         (concat [possible_assignments_for \<Psi> v. v \<leftarrow> defined]))"
 
 definition sasp_op_to_strips
   :: "('variable, 'domain) sas_plus_problem
     \<Rightarrow> ('variable, 'domain) sas_plus_operator
     \<Rightarrow> ('variable, 'domain) assignment strips_operator" 
   ("\<phi>\<^sub>O _ _" 99)
   where "sasp_op_to_strips \<Psi> op \<equiv> let
       pre = precondition_of op
       ; add = effect_of op
       ; delete = [(v, a'). (v, a) \<leftarrow> effect_of op, a' \<leftarrow> filter ((\<noteq>) a) (the (range_of \<Psi> v))]
     in STRIPS_Representation.operator_for pre add delete"
 
 definition sas_plus_problem_to_strips_problem
   :: "('variable, 'domain) sas_plus_problem \<Rightarrow> ('variable, 'domain) assignment strips_problem" 
   ("\<phi> _ " 99)
   where "sas_plus_problem_to_strips_problem \<Psi> \<equiv> let 
       vs = [as. v \<leftarrow> variables_of \<Psi>, as \<leftarrow> (possible_assignments_for \<Psi>) v]
       ; ops = map (sasp_op_to_strips \<Psi>) (operators_of \<Psi>)
       ; I = state_to_strips_state \<Psi> (initial_of \<Psi>)
       ; G = state_to_strips_state \<Psi> (goal_of \<Psi>)
     in STRIPS_Representation.problem_for vs ops I G"
 
 definition sas_plus_parallel_plan_to_strips_parallel_plan
   :: "('variable, 'domain) sas_plus_problem
     \<Rightarrow> ('variable, 'domain) sas_plus_parallel_plan
     \<Rightarrow> ('variable \<times> 'domain) strips_parallel_plan" 
   ("\<phi>\<^sub>P _ _" 99)
   where "sas_plus_parallel_plan_to_strips_parallel_plan \<Psi> \<psi>
     \<equiv> [[sasp_op_to_strips \<Psi> op. op \<leftarrow> ops]. ops \<leftarrow> \<psi>]"
 
 (* TODO first argument should be ('variable, 'domain) strips_problem *)
 definition strips_state_to_state
   :: "('variable, 'domain) sas_plus_problem
     \<Rightarrow> ('variable, 'domain) assignment strips_state
     \<Rightarrow> ('variable, 'domain) state" 
   ("\<phi>\<^sub>S\<inverse> _ _" 99)
   where "strips_state_to_state \<Psi> s 
     \<equiv> map_of (filter (\<lambda>(v, a). s (v, a) = Some True) (all_possible_assignments_for \<Psi>))"
 
 (* TODO remove problem argument *)
 definition strips_op_to_sasp 
   :: "('variable, 'domain) sas_plus_problem 
     \<Rightarrow> ('variable \<times> 'domain) strips_operator
     \<Rightarrow> ('variable, 'domain) sas_plus_operator"
   ("\<phi>\<^sub>O\<inverse> _ _" 99)
   where "strips_op_to_sasp \<Psi> op 
     \<equiv> let 
         precondition = strips_operator.precondition_of op
         ; effect = strips_operator.add_effects_of op 
       in \<lparr> precondition_of = precondition, effect_of = effect \<rparr>" 
 
 (* TODO \<open>strips_parallel_plan_to_sas_plus_parallel_plan \<leadsto> \<phi>_P\<inverse>\<close> and 
 \<open>strips_op_to_sasp \<leadsto> \<phi>_O\<inverse>\<close> *)
 definition strips_parallel_plan_to_sas_plus_parallel_plan
   :: "('variable, 'domain) sas_plus_problem
     \<Rightarrow> ('variable \<times> 'domain) strips_parallel_plan
     \<Rightarrow> ('variable, 'domain) sas_plus_parallel_plan" 
   ("\<phi>\<^sub>P\<inverse> _ _" 99)
   where "strips_parallel_plan_to_sas_plus_parallel_plan \<Pi> \<pi>
     \<equiv> [[strips_op_to_sasp \<Pi> op. op \<leftarrow> ops]. ops \<leftarrow> \<pi>]"
 
 text \<open> To set up the equivalence proof context, we declare a common locale 
 \isaname{sas_plus_strips_equivalence} for both the STRIPS and SAS+ formalisms and make it a 
 sublocale of both locale \isaname{strips} as well as \isaname{sas_plus}.
 The declaration itself is omitted for brevity since it basically just joins locales 
 \isaname{sas_plus} and \isaname{strips} while renaming the locale parameter to avoid name clashes.
 The sublocale proofs are shown below.
 \footnote{We append a suffix identifying the respective formalism to the the parameter names 
 passed to the parameter names in the locale. This is necessary to avoid ambiguous names in the 
 sublocale declarations. For example, without addition of suffixes the type for \<open>initial_of\<close> is 
 ambiguous and will therefore not be bound to either \<open>strips_problem.initial_of\<close> or 
 \<open>sas_plus_problem.initial_of\<close>. 
 Isabelle in fact considers it to be a a free variable in this case. We also qualify the parent 
 locales in the sublocale declarations by adding \texttt{strips:} and \texttt{sas\_plus:} before 
 the respective parent locale identifiers. } \<close>
 
 definition "range_of_strips \<Pi> x \<equiv> { True, False }"
 
 context
 begin
 
 \<comment> \<open> Set-up simp rules. \<close>
 lemma[simp]: 
   "(\<phi> \<Psi>) = (let 
       vs = [as. v \<leftarrow> variables_of \<Psi>, as \<leftarrow> (possible_assignments_for \<Psi>) v]
       ; ops = map (sasp_op_to_strips \<Psi>) (operators_of \<Psi>)
       ; I = state_to_strips_state \<Psi> (initial_of \<Psi>)
       ; G = state_to_strips_state \<Psi> (goal_of \<Psi>)
     in STRIPS_Representation.problem_for vs ops I G)"
   and "(\<phi>\<^sub>S \<Psi> s)
     = (let defined = filter (\<lambda>v. s v \<noteq> None) (variables_of \<Psi>) in
       map_of (map (\<lambda>(v, a). ((v, a), the (s v) = a)) 
         (concat [possible_assignments_for \<Psi> v. v \<leftarrow> defined])))"
   and "(\<phi>\<^sub>O \<Psi> op)
     = (let
       pre = precondition_of op
       ; add = effect_of op
       ; delete = [(v, a'). (v, a) \<leftarrow> effect_of op, a' \<leftarrow> filter ((\<noteq>) a) (the (range_of \<Psi> v))]
     in STRIPS_Representation.operator_for pre add delete)" 
   and "(\<phi>\<^sub>P \<Psi> \<psi>) = [[\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]. ops \<leftarrow> \<psi>]"
   and "(\<phi>\<^sub>S\<inverse> \<Psi> s')= map_of (filter (\<lambda>(v, a). s' (v, a) = Some True) 
     (all_possible_assignments_for \<Psi>))" 
   and "(\<phi>\<^sub>O\<inverse> \<Psi> op') = (let 
         precondition = strips_operator.precondition_of op'
         ; effect = strips_operator.add_effects_of op' 
       in \<lparr> precondition_of = precondition, effect_of = effect \<rparr>)" 
   and "(\<phi>\<^sub>P\<inverse> \<Psi> \<pi>) = [[\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> ops]. ops \<leftarrow> \<pi>]"
   unfolding
     SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
     sas_plus_problem_to_strips_problem_def
     SAS_Plus_STRIPS.state_to_strips_state_def
     state_to_strips_state_def
     SAS_Plus_STRIPS.sasp_op_to_strips_def
     sasp_op_to_strips_def
     SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
     sas_plus_parallel_plan_to_strips_parallel_plan_def
     SAS_Plus_STRIPS.strips_state_to_state_def
     strips_state_to_state_def 
     SAS_Plus_STRIPS.strips_op_to_sasp_def
     strips_op_to_sasp_def 
     SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
     strips_parallel_plan_to_sas_plus_parallel_plan_def 
   by blast+
 
 lemmas [simp] = range_of'_def
 
 lemma is_valid_problem_sas_plus_dom_sas_plus_problem_range_of:
   assumes "is_valid_problem_sas_plus \<Psi>" 
   shows "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). v \<in> dom (sas_plus_problem.range_of \<Psi>)"
   using assms(1) is_valid_problem_sas_plus_then(1)
   unfolding is_valid_problem_sas_plus_def
   by (meson domIff list.pred_set)
 
 lemma possible_assignments_for_set_is:
   assumes "v \<in> dom (sas_plus_problem.range_of \<Psi>)"
   shows "set (possible_assignments_for \<Psi> v) 
     = { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v }" 
 proof -
   have "sas_plus_problem.range_of \<Psi> v \<noteq> None"
     using assms(1) 
     by auto
   thus  ?thesis 
     unfolding possible_assignments_for_def
     by fastforce
 qed
 
 lemma all_possible_assignments_for_set_is:
   assumes "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). range_of \<Psi> v \<noteq> None" 
   shows "set (all_possible_assignments_for \<Psi>)
     = (\<Union>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })" 
 proof -
   let ?vs = "variables_of \<Psi>"
   have "set (all_possible_assignments_for \<Psi>) = 
     (\<Union>(set ` (\<lambda>v. map (\<lambda>(v, a). (v, a)) (possible_assignments_for \<Psi> v)) ` set ?vs))"
     unfolding all_possible_assignments_for_def set_concat
     using set_map 
     by auto
   also have "\<dots> = (\<Union>((\<lambda>v. set (possible_assignments_for \<Psi> v)) ` set ?vs))"
     using image_comp set_map
     by simp
   (* TODO slow *)
   also have "\<dots> = (\<Union>((\<lambda>v. { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v }) ` set ?vs))"
     using possible_assignments_for_set_is assms 
     by fastforce
   finally show ?thesis
     by force
 qed
 
 lemma state_to_strips_state_dom_is_i[simp]:
   assumes "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). v \<in> dom (sas_plus_problem.range_of \<Psi>)"
   shows "set (concat 
       [possible_assignments_for \<Psi> v. v \<leftarrow> filter (\<lambda>v. s v \<noteq> None) (variables_of \<Psi>)])
     = (\<Union>v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }. 
       { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })" 
 proof -
   let ?vs = "variables_of \<Psi>"
   let ?defined = "filter (\<lambda>v. s v \<noteq> None) ?vs"
   let ?l = "concat [possible_assignments_for \<Psi> v. v \<leftarrow> ?defined]"
   have nb: "set ?defined = { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }" 
     unfolding set_filter
     by force
   have "set ?l = \<Union>(set ` set (map (possible_assignments_for \<Psi>) ?defined ))" 
     unfolding set_concat image_Union
     by blast
   also have "\<dots> = \<Union>(set ` (possible_assignments_for \<Psi>) ` set ?defined)" 
     unfolding set_map
     by blast
   also have "\<dots> = (\<Union>v \<in> set ?defined. set (possible_assignments_for \<Psi> v))"
     by blast
   also have "\<dots> = (\<Union>v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }.
     set (possible_assignments_for \<Psi> v))"
     using nb 
     by argo
   finally show ?thesis
     using possible_assignments_for_set_is 
       is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
     by fastforce
 qed
 
 lemma state_to_strips_state_dom_is:
   \<comment> \<open> NOTE A transformed state is defined on all possible assignments for all variables defined 
 in the original state. \<close>
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "dom (\<phi>\<^sub>S \<Psi> s) 
     = (\<Union>v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }. 
       { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })"
 proof -
   let ?vs = "variables_of \<Psi>"
   let ?l = "concat [possible_assignments_for \<Psi> v. v \<leftarrow> filter (\<lambda>v. s v \<noteq> None) ?vs]"
   have nb: "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). v \<in> dom (sas_plus_problem.range_of \<Psi>)"
     using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
     by fastforce
   have "dom (\<phi>\<^sub>S \<Psi> s) = fst ` set (map (\<lambda>(v, a). ((v, a), the (s v) = a)) ?l)" 
     unfolding state_to_strips_state_def 
       SAS_Plus_STRIPS.state_to_strips_state_def 
     using dom_map_of_conv_image_fst[of "map (\<lambda>(v, a). ((v, a), the (s v) = a)) ?l"]
     by presburger
   also have "\<dots> = fst ` (\<lambda>(v, a). ((v, a), the (s v) = a)) ` set ?l" 
     unfolding set_map
     by blast
   also have "\<dots> = (\<lambda>(v, a). fst  ((v, a), the (s v) = a)) ` set ?l"
     unfolding image_comp[of fst "\<lambda>(v, a). ((v, a), the (s v) = a)"] comp_apply[of 
         fst "\<lambda>(v, a). ((v, a), the (s v) = a)"] prod.case_distrib
     by blast
   finally show ?thesis
     unfolding state_to_strips_state_dom_is_i[OF nb]
     by force
 qed
 
 corollary state_to_strips_state_dom_element_iff:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "(v, a) \<in> dom (\<phi>\<^sub>S \<Psi> s) \<longleftrightarrow> v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)
     \<and> s v \<noteq> None
     \<and> a \<in> \<R>\<^sub>+ \<Psi> v"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?s' = "\<phi>\<^sub>S \<Psi> s"
   show ?thesis 
     proof (rule iffI)
       assume "(v, a) \<in> dom (\<phi>\<^sub>S \<Psi> s)" 
       then have "v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }"
           and "a \<in> \<R>\<^sub>+ \<Psi> v"
         unfolding state_to_strips_state_dom_is[OF assms(1)]
         by force+
       moreover have "v \<in> set ?vs" and "s v \<noteq> None" 
         using calculation(1) 
         by fastforce+
       ultimately show 
         "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None \<and> a \<in> \<R>\<^sub>+ \<Psi> v"
         by force
     next 
       assume "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None \<and> a \<in> \<R>\<^sub>+ \<Psi> v"
       then have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
         and "s v \<noteq> None"
         and a_in_range_of_v: "a \<in> \<R>\<^sub>+ \<Psi> v" 
         by simp+
       then have "v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }"
         by force
       thus "(v, a) \<in> dom (\<phi>\<^sub>S \<Psi> s)"
         unfolding state_to_strips_state_dom_is[OF assms(1)]
         using a_in_range_of_v
         by blast
     qed
 qed
 
 lemma state_to_strips_state_range_is:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "(v, a) \<in> dom (\<phi>\<^sub>S \<Psi> s)" 
   shows "(\<phi>\<^sub>S \<Psi> s) (v, a) = Some (the (s v) = a)"
 proof -
   let ?vs = "variables_of \<Psi>" 
   let ?s' = "\<phi>\<^sub>S \<Psi> s"
     and ?defined = "filter (\<lambda>v. s v \<noteq> None) ?vs"
   let ?l = "concat [possible_assignments_for \<Psi> v. v \<leftarrow> ?defined]"
   have v_in_set_vs: "v \<in> set ?vs" 
     and s_of_v_is_not_None: "s v \<noteq> None" 
     and a_in_range_of_v: "a \<in> \<R>\<^sub>+ \<Psi> v" 
     using assms(2)
     unfolding state_to_strips_state_dom_is[OF assms(1)]
     by fastforce+
   moreover {
     have "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). v \<in> dom (sas_plus_problem.range_of \<Psi>)"
       using assms(1) is_valid_problem_sas_plus_then(1)
       unfolding is_valid_problem_sas_plus_def
       by fastforce
     moreover have "(v, a) \<in> set ?l" 
       unfolding state_to_strips_state_dom_is_i[OF calculation(1)]
       using s_of_v_is_not_None a_in_range_of_v v_in_set_vs
       by fastforce
     moreover have "set ?l \<noteq> {}" 
       using calculation
       by fastforce
     \<comment> \<open> TODO slow. \<close>
     ultimately have "(\<phi>\<^sub>S \<Psi> s) (v, a) = Some (the (s v) = a)"
       using map_of_from_function_graph_is_some_if[of 
           ?l "(v, a)" "\<lambda>(v, a). the (s v) = a"] 
       unfolding SAS_Plus_STRIPS.state_to_strips_state_def
         state_to_strips_state_def Let_def case_prod_beta'
       by fastforce
   }
   thus ?thesis.
 qed
 
 
 \<comment> \<open> Show that a STRIPS state corresponding to a SAS+ state via transformation is consistent
 w.r.t. to the variable subset with same left component (i.e. the original SAS+ variable). This is
 the consistency notion corresponding to SAS+ consistency: i.e. if no two assignments with different
 values for the same variable exist in the SAS+ state, then assigning the corresponding assignment
 both to @{text "True"} is impossible. Vice versa, if both are assigned to @{text "True"} then the
 assignment variables must be the same SAS+ variable/SAS+ value pair. \<close>
 lemma state_to_strips_state_effect_consistent:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "(v, a) \<in> dom (\<phi>\<^sub>S \<Psi> s)"
     and "(v, a') \<in> dom (\<phi>\<^sub>S \<Psi> s)"
     and "(\<phi>\<^sub>S \<Psi> s) (v, a) = Some True"
     and  "(\<phi>\<^sub>S \<Psi> s) (v, a') = Some True"
   shows "(v, a) = (v, a')" 
 proof -
   have "the (s v) = a" and "the (s v) = a'"
     using state_to_strips_state_range_is[OF assms(1)] assms(2, 3, 4, 5)
     by fastforce+
   thus ?thesis 
     by argo
 qed
 
 
 lemma sasp_op_to_strips_set_delete_effects_is:
   assumes "is_valid_operator_sas_plus \<Psi> op" 
   shows "set (strips_operator.delete_effects_of (\<phi>\<^sub>O \<Psi> op)) 
     = (\<Union>(v, a) \<in> set (effect_of op). { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })"
 proof -
   let ?D = "range_of \<Psi>"
     and ?effect = "effect_of op" 
   let ?delete = "[(v, a'). (v, a) \<leftarrow> ?effect, a' \<leftarrow> filter ((\<noteq>) a) (the (?D v))]"
   {
     fix v a
     assume "(v, a) \<in> set ?effect"
     then have "(\<R>\<^sub>+ \<Psi> v) = set (the (?D v))"
       using assms 
       using is_valid_operator_sas_plus_then_range_of_sas_plus_op_is_set_range_of_op
       by fastforce
     hence "set (filter ((\<noteq>) a) (the (?D v))) = { a' \<in> \<R>\<^sub>+ \<Psi> v. a' \<noteq> a }"
       unfolding set_filter 
       by blast
   } note nb = this
   {
     \<comment> \<open> TODO slow. \<close>
     have "set ?delete = \<Union>(set ` (\<lambda>(v, a). map (Pair v) (filter ((\<noteq>) a) (the (?D v)))) 
       ` (set ?effect))" 
       using set_concat
       by simp
     also have "\<dots> = \<Union>((\<lambda>(v, a). Pair v ` set (filter ((\<noteq>) a) (the (?D v)))) 
       ` (set ?effect))"
       unfolding image_comp[of set] set_map 
       by auto
     \<comment> \<open> TODO slow. \<close>
     also have "\<dots> = (\<Union>(v, a) \<in> set ?effect. Pair v ` { a' \<in> \<R>\<^sub>+ \<Psi> v. a' \<noteq> a })" 
       using nb 
       by fast
     finally have "set ?delete = (\<Union>(v, a) \<in> set ?effect.
       { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })" 
       by blast
   }
   thus ?thesis
     unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
       sasp_op_to_strips_def Let_def
     by force 
 qed
 
 lemma sas_plus_problem_to_strips_problem_variable_set_is:
   \<comment> \<open> The variable set of \<open>\<Pi>\<close> is the set of all possible 
 assignments that are possible using the variables of \<open>\<V>\<close> and the corresponding domains. \<close>
   assumes "is_valid_problem_sas_plus \<Psi>" 
   shows "set ((\<phi> \<Psi>)\<^sub>\<V>) = (\<Union>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })"
 proof -
   let ?\<Pi> = "\<phi> \<Psi>"
     and ?vs = "variables_of \<Psi>"
   {
     have "set (strips_problem.variables_of ?\<Pi>) 
       = set [as. v \<leftarrow> ?vs, as \<leftarrow> possible_assignments_for \<Psi> v]"
       unfolding sas_plus_problem_to_strips_problem_def 
         SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
       by force
     also have "\<dots> = (\<Union>(set ` (\<lambda>v. possible_assignments_for \<Psi> v) ` set ?vs))" 
       using set_concat
       by auto
     also have "\<dots> = (\<Union>((set \<circ> possible_assignments_for \<Psi>) ` set ?vs))" 
       using image_comp[of set "\<lambda>v. possible_assignments_for \<Psi> v" "set ?vs"]
       by argo
     finally have "set (strips_problem.variables_of ?\<Pi>) 
       = (\<Union>v \<in> set ?vs. set (possible_assignments_for \<Psi> v))"
       unfolding o_apply
       by blast
   }
   moreover have "\<forall>v \<in> set ?vs. v \<in> dom (sas_plus_problem.range_of \<Psi>)"
     using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms
     by force
   ultimately show ?thesis
     using possible_assignments_for_set_is
     by force 
 qed
 
 corollary sas_plus_problem_to_strips_problem_variable_set_element_iff:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "(v, a) \<in> set ((\<phi> \<Psi>)\<^sub>\<V>)  \<longleftrightarrow> v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> a \<in> \<R>\<^sub>+ \<Psi> v"
   unfolding sas_plus_problem_to_strips_problem_variable_set_is[OF assms]
   by fast
 
 lemma sasp_op_to_strips_effect_consistent:
   assumes "op = \<phi>\<^sub>O \<Psi> op'" 
     and "op' \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
     and "is_valid_operator_sas_plus \<Psi> op'"
   shows "(v, a) \<in> set (add_effects_of op) \<longrightarrow> (v, a) \<notin> set (delete_effects_of op)"
     and "(v, a) \<in> set (delete_effects_of op) \<longrightarrow> (v, a) \<notin> set (add_effects_of op)"
 proof -
   have nb: "(\<forall>(v, a) \<in> set (effect_of op'). \<forall>(v', a') \<in> set (effect_of op'). v \<noteq> v' \<or> a = a')" 
     using assms(3)
     unfolding is_valid_operator_sas_plus_def 
       SAS_Plus_Representation.is_valid_operator_sas_plus_def list_all_iff ListMem_iff Let_def
     by argo
   {
     fix v a
     assume v_a_in_add_effects_of_op: "(v, a) \<in> set (add_effects_of op)" 
     have "(v, a) \<notin> set (delete_effects_of op)" 
       proof (rule ccontr)
         assume "\<not>(v, a) \<notin> set (delete_effects_of op)" 
         moreover have "(v, a) \<in> 
           (\<Union>(v, a') \<in> set (effect_of op'). { (v, a'') 
             | a''. a'' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a'' \<noteq> a' })"
           using calculation sasp_op_to_strips_set_delete_effects_is 
             assms 
           by blast
         moreover obtain a' where "(v, a') \<in> set (effect_of op')" and "a \<noteq> a'" 
           using calculation
           by blast
         moreover have "(v, a') \<in> set (add_effects_of op)" 
           using assms(1) calculation(3)
           unfolding sasp_op_to_strips_def
             SAS_Plus_STRIPS.sasp_op_to_strips_def
             Let_def
           by fastforce
         moreover have "(v, a) \<in> set (effect_of op')" and "(v, a') \<in> set (effect_of op')" 
           using assms(1) v_a_in_add_effects_of_op calculation(5)
           unfolding sasp_op_to_strips_def 
             SAS_Plus_STRIPS.sasp_op_to_strips_def
             Let_def 
           by force+
         ultimately show False 
           using nb 
           by fast
       qed
   }
   moreover {
     fix v a
     assume v_a_in_delete_effects_of_op: "(v, a) \<in> set (delete_effects_of op)" 
     have "(v, a) \<notin> set (add_effects_of op)" 
       proof (rule ccontr)
         assume "\<not>(v, a) \<notin> set (add_effects_of op)" 
         moreover have "(v, a) \<in> set (add_effects_of op)" 
           using calculation 
           by blast
         moreover have "(v, a) \<in> 
           (\<Union>(v, a') \<in> set (effect_of op'). { (v, a'') 
             | a''. a'' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a'' \<noteq> a' })"
           using sasp_op_to_strips_set_delete_effects_is  
             nb assms(1, 3) v_a_in_delete_effects_of_op
           by force
         moreover obtain a' where "(v, a') \<in> set (effect_of op')" and "a \<noteq> a'" 
           using calculation
           by blast
         moreover have "(v, a') \<in> set (add_effects_of op)" 
           using assms(1) calculation(4)
           unfolding sasp_op_to_strips_def 
             SAS_Plus_STRIPS.sasp_op_to_strips_def
             Let_def
           by fastforce
         moreover have "(v, a) \<in> set (effect_of op')" and "(v, a') \<in> set (effect_of op')" 
           using assms(1) calculation(2, 6)
           unfolding sasp_op_to_strips_def 
             SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def 
           by force+
         ultimately show False 
           using nb 
           by fast
       qed
     }
     ultimately show "(v, a) \<in> set (add_effects_of op) 
       \<longrightarrow> (v, a) \<notin> set (delete_effects_of op)"
       and "(v, a) \<in> set (delete_effects_of op) 
       \<longrightarrow> (v, a) \<notin> set (add_effects_of op)"
       by blast+
   qed
 
 lemma is_valid_problem_sas_plus_then_strips_transformation_too_iii:
   assumes "is_valid_problem_sas_plus \<Psi>" 
   shows "list_all (is_valid_operator_strips (\<phi> \<Psi>))
     (strips_problem.operators_of (\<phi> \<Psi>))"
 proof -
   let ?\<Pi> = "\<phi> \<Psi>"
   let ?vs = "strips_problem.variables_of ?\<Pi>"
   {
     fix op
     assume "op \<in> set (strips_problem.operators_of ?\<Pi>)" 
     \<comment> \<open> TODO slow. \<close>
     then obtain op' 
       where op_is: "op = \<phi>\<^sub>O \<Psi> op'" 
         and op'_in_operators: "op' \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
       unfolding SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
         sas_plus_problem_to_strips_problem_def 
         sasp_op_to_strips_def 
       by auto
     then have is_valid_op': "is_valid_operator_sas_plus \<Psi> op'"
       using sublocale_sas_plus_finite_domain_representation_ii(2)[OF assms]
       by blast
     moreover {
       fix v a
       assume "(v, a) \<in> set (strips_operator.precondition_of op)"
       \<comment> \<open> TODO slow. \<close>
       then have "(v, a) \<in> set (sas_plus_operator.precondition_of op')" 
         using op_is
         unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def 
           sasp_op_to_strips_def
         by force
       moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
         using is_valid_op' calculation
         using is_valid_operator_sas_plus_then(1)
         by fastforce 
       moreover have  "a \<in> \<R>\<^sub>+ \<Psi> v" 
         using is_valid_op' calculation(1)
         using is_valid_operator_sas_plus_then(2) 
         by fast
       ultimately have "(v, a) \<in> set ?vs" 
         using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
         by force
     }
     moreover {
       fix v a
       assume "(v, a) \<in> set (strips_operator.add_effects_of op)"
       then have "(v, a) \<in> set (effect_of op')" 
         using op_is
         unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
           sasp_op_to_strips_def
         by force
       then have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" and "a \<in> \<R>\<^sub>+ \<Psi> v" 
         using is_valid_operator_sas_plus_then is_valid_op'
         by fastforce+
       hence "(v, a) \<in> set ?vs" 
         using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
         by force
     }
     moreover {
       fix v a'
       assume v_a'_in_delete_effects: "(v, a') \<in> set (strips_operator.delete_effects_of op)"
       moreover have "set (strips_operator.delete_effects_of op) 
         =  (\<Union>(v, a) \<in> set (effect_of op'). 
           { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })"
         using sasp_op_to_strips_set_delete_effects_is[OF is_valid_op']
           op_is
         by simp
       \<comment> \<open> TODO slow. \<close>
       ultimately obtain a 
         where "(v, a) \<in> set (effect_of op')" 
           and a'_in: "a' \<in> { a' \<in> \<R>\<^sub>+ \<Psi> v. a' \<noteq> a }"
         by blast 
       moreover have "is_valid_operator_sas_plus \<Psi> op'"
         using op'_in_operators assms(1) 
           is_valid_problem_sas_plus_then(2)
         by blast
       moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
         using is_valid_operator_sas_plus_then calculation(1, 3)
         by fast
       moreover have "a' \<in> \<R>\<^sub>+ \<Psi> v"
         using a'_in 
         by blast
       ultimately have "(v, a') \<in> set ?vs" 
         using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
         by force
     }
     ultimately have "set (strips_operator.precondition_of op) \<subseteq> set ?vs
       \<and> set (strips_operator.add_effects_of op) \<subseteq> set ?vs
       \<and> set (strips_operator.delete_effects_of op) \<subseteq> set ?vs
       \<and> (\<forall>v\<in>set (add_effects_of op). v \<notin> set (delete_effects_of op))
       \<and> (\<forall>v\<in>set (delete_effects_of op). v \<notin> set (add_effects_of op))"
       using sasp_op_to_strips_effect_consistent[OF 
           op_is op'_in_operators is_valid_op']
       by fast+
   }
   thus ?thesis
     unfolding is_valid_operator_strips_def STRIPS_Representation.is_valid_operator_strips_def 
       list_all_iff ListMem_iff Let_def 
     by blast
 qed
 
 lemma is_valid_problem_sas_plus_then_strips_transformation_too_iv:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "\<forall>x. ((\<phi> \<Psi>)\<^sub>I) x \<noteq> None
     \<longleftrightarrow> ListMem x (strips_problem.variables_of (\<phi> \<Psi>))"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?I = "initial_of \<Psi>"
     and ?\<Pi> = "\<phi> \<Psi>"
   let ?vs' = "strips_problem.variables_of ?\<Pi>"
     and ?I' = "strips_problem.initial_of ?\<Pi>"
   {
     fix x
     have "?I' x \<noteq> None \<longleftrightarrow> ListMem x ?vs'" 
       proof (rule iffI)
         assume I'_of_x_is_not_None: "?I' x \<noteq> None"
         then have "x \<in> dom ?I'" 
           by blast
         moreover obtain v a where x_is: "x = (v, a)" 
           by fastforce
         ultimately have "(v, a) \<in> dom ?I'" 
           by blast
         then have "v \<in> set ?vs" 
             and "?I v \<noteq> None"
             and "a \<in> \<R>\<^sub>+ \<Psi> v"
           using state_to_strips_state_dom_element_iff[OF assms(1), of v a  ?I] 
           unfolding sas_plus_problem_to_strips_problem_def 
             SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def 
             state_to_strips_state_def
             SAS_Plus_STRIPS.state_to_strips_state_def 
           by simp+
         thus "ListMem x ?vs'"
           unfolding ListMem_iff
           using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)] 
             x_is
           by auto
       next 
         assume list_mem_x_vs': "ListMem x ?vs'"
         then obtain v a where x_is: "x = (v, a)" 
           by fastforce
         then have "(v, a) \<in> set ?vs'" 
           using list_mem_x_vs'
           unfolding ListMem_iff
           by blast
         then have "v \<in> set ?vs" and "a \<in> \<R>\<^sub>+ \<Psi> v" 
           using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
           by force+
         moreover have "?I v \<noteq> None" 
           using is_valid_problem_sas_plus_then(3) assms(1) calculation(1)
           by auto
         ultimately have "(v, a) \<in> dom ?I'" 
           using state_to_strips_state_dom_element_iff[OF assms(1), of v a ?I]
           unfolding SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def 
             sas_plus_problem_to_strips_problem_def
             SAS_Plus_STRIPS.state_to_strips_state_def
             state_to_strips_state_def
           by force 
         thus "?I' x \<noteq> None"
           using x_is 
           by fastforce
       qed
   }
   thus ?thesis
     by simp
 qed
 
 private lemma is_valid_problem_sas_plus_then_strips_transformation_too_v:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "\<forall>x. ((\<phi> \<Psi>)\<^sub>G) x \<noteq> None
     \<longrightarrow> ListMem x (strips_problem.variables_of (\<phi> \<Psi>))"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?D = "range_of \<Psi>"
     and ?G = "goal_of \<Psi>"
   let ?\<Pi> = "\<phi> \<Psi>"
   let ?vs' = "strips_problem.variables_of ?\<Pi>"
     and ?G' = "strips_problem.goal_of ?\<Pi>" 
   have nb: "?G' = \<phi>\<^sub>S \<Psi> ?G" 
     by simp
   {
     fix x
     assume "?G' x \<noteq> None" 
     moreover obtain v a where "x = (v, a)" 
       by fastforce
     moreover have "(v, a) \<in> dom ?G'" 
       using domIff calculation(1, 2)
       by blast
     moreover have "v \<in> set ?vs" and "a \<in> \<R>\<^sub>+ \<Psi> v"
       using state_to_strips_state_dom_is[OF assms(1), of ?G] nb calculation(3)
       by auto+
     ultimately have "x \<in> set ?vs'"
       using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
       by auto
   }
   thus ?thesis 
     unfolding ListMem_iff
     by simp
 qed
 
 text \<open> We now show that given \<^term>\<open>\<Psi>\<close> is a valid SASPlus problem, then \<^term>\<open>\<Pi> \<equiv> \<phi> \<Psi>\<close> is a valid
 STRIPS problem as well. 
 The proof unfolds the definition of \<^term>\<open>is_valid_problem_strips\<close> and then shows each of the conjuncts 
 for \<^term>\<open>\<Pi>\<close>. These are:
 \begin{itemize}
   \item \<^term>\<open>\<Pi>\<close> has at least one variable;
   \item \<^term>\<open>\<Pi>\<close> has at least one operator;
   \item all operators are valid STRIPS operators;
   \item \<^term>\<open>(\<Pi>::'a strips_problem)\<^sub>I\<close> is defined for all variables in \<^term>\<open>(\<Pi>::'a strips_problem)\<^sub>\<V>\<close>; and finally,
   \item if \<^term>\<open>((\<Pi>::'a strips_problem)\<^sub>G) x\<close> is defined, then \<^term>\<open>x\<close> is in \<^term>\<open>(\<Pi>::'a strips_problem)\<^sub>\<V>\<close>.
 \end{itemize} \<close>
 
 theorem
   is_valid_problem_sas_plus_then_strips_transformation_too:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "is_valid_problem_strips (\<phi> \<Psi>)" 
 proof -
   let ?\<Pi> = "\<phi> \<Psi>"
   have "list_all (is_valid_operator_strips (\<phi> \<Psi>))
    (strips_problem.operators_of (\<phi> \<Psi>))" 
     using is_valid_problem_sas_plus_then_strips_transformation_too_iii[OF assms].
   moreover have "\<forall>x. (((\<phi> \<Psi>)\<^sub>I) x \<noteq> None) =
     ListMem x (strips_problem.variables_of (\<phi> \<Psi>))" 
     using is_valid_problem_sas_plus_then_strips_transformation_too_iv[OF assms].
   moreover have "\<forall>x. ((\<phi> \<Psi>)\<^sub>G) x \<noteq> None \<longrightarrow>
     ListMem x (strips_problem.variables_of (\<phi> \<Psi>))" 
     using is_valid_problem_sas_plus_then_strips_transformation_too_v[OF assms].
   ultimately show ?thesis 
     using is_valid_problem_strips_def 
     unfolding STRIPS_Representation.is_valid_problem_strips_def
     by fastforce
 qed 
 
 lemma set_filter_all_possible_assignments_true_is:
   assumes "is_valid_problem_sas_plus \<Psi>" 
   shows "set (filter (\<lambda>(v, a). s (v, a) = Some True) 
       (all_possible_assignments_for \<Psi>))
     =  (\<Union>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). Pair v ` { a \<in> \<R>\<^sub>+ \<Psi> v. s (v, a) = Some True })"
 proof -
   let ?vs = "sas_plus_problem.variables_of \<Psi>"
     and ?P = "(\<lambda>(v, a). s (v, a) = Some True)"
   let ?l = "filter ?P (all_possible_assignments_for \<Psi>)"
   have "set ?l = set (concat (map (filter ?P) (map (possible_assignments_for \<Psi>) ?vs)))" 
     unfolding all_possible_assignments_for_def
       filter_concat[of ?P "map (possible_assignments_for \<Psi>) (sas_plus_problem.variables_of \<Psi>)"]
     by simp
   also have "\<dots> = set (concat (map (\<lambda>v. filter ?P (possible_assignments_for \<Psi> v)) ?vs))" 
     unfolding map_map comp_apply 
     by blast
   also have "\<dots> = set (concat (map (\<lambda>v. map (Pair v) 
     (filter (?P \<circ> Pair v) (the (range_of \<Psi> v)))) ?vs))" 
     unfolding possible_assignments_for_def filter_map
     by blast
   also have "\<dots> = set (concat (map (\<lambda>v. map (Pair v) (filter (\<lambda>a. s (v, a) = Some True) 
     (the (range_of \<Psi> v)))) ?vs))" 
     unfolding comp_apply
     by fast
   also have "\<dots> = \<Union>(set ` ((\<lambda>v. map (Pair v) (filter (\<lambda>a. s (v, a) = Some True) 
     (the (range_of \<Psi> v)))) ` set ?vs))"
     unfolding set_concat set_map..
   also have "\<dots> = (\<Union>v \<in> set ?vs. Pair v ` set (filter (\<lambda>a. s (v, a) = Some True) 
     (the (range_of \<Psi> v))))" 
     unfolding image_comp[of set] comp_apply set_map..
   also have "\<dots> = (\<Union>v \<in> set ?vs. Pair v 
     ` { a \<in> set (the (range_of \<Psi> v)). s (v, a) = Some True })"
     unfolding set_filter..
   finally show ?thesis 
     using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)]
     by auto
 qed
 
 lemma strips_state_to_state_dom_is: 
   assumes "is_valid_problem_sas_plus \<Psi>" 
   shows "dom (\<phi>\<^sub>S\<inverse> \<Psi> s) 
     = (\<Union>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). 
       { v | a. a \<in> (\<R>\<^sub>+ \<Psi> v) \<and> s (v, a) = Some True })"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?s' = "\<phi>\<^sub>S\<inverse> \<Psi> s" 
     and ?P = "(\<lambda>(v, a). s (v, a) = Some True)"
   let ?l = "filter ?P (all_possible_assignments_for \<Psi>)"
   { 
     have "fst ` set ?l = fst ` (\<Union>v \<in> set ?vs. Pair v 
       ` { a \<in> \<R>\<^sub>+ \<Psi> v. s (v, a) = Some True })"
       unfolding set_filter_all_possible_assignments_true_is[OF assms]
       by auto
     also have "\<dots> = (\<Union>v \<in> set ?vs. fst ` Pair v 
       ` { a \<in> \<R>\<^sub>+ \<Psi> v. s (v, a) = Some True })" 
       by blast
     also have "\<dots> = (\<Union>v \<in> set ?vs. (\<lambda>a. fst (Pair v a)) ` 
       { a \<in> \<R>\<^sub>+ \<Psi> v. s (v, a) = Some True })" 
       unfolding image_comp[of fst] comp_apply
       by blast
     finally have "fst ` set ?l = (\<Union>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). 
       { v | a. a \<in> (\<R>\<^sub>+ \<Psi> v) \<and> s (v, a) = Some True })" 
       unfolding setcompr_eq_image fst_conv 
       by simp
   }
   thus ?thesis
     unfolding SAS_Plus_STRIPS.strips_state_to_state_def 
       strips_state_to_state_def dom_map_of_conv_image_fst
     by blast
 qed
 
 lemma strips_state_to_state_range_is: 
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
     and "a \<in> \<R>\<^sub>+ \<Psi> v" 
     and "(v, a) \<in> dom s'"
     and "\<forall>(v, a) \<in> dom s'. \<forall>(v, a') \<in> dom s'. s' (v, a) = Some True \<and> s' (v, a') = Some True 
       \<longrightarrow> (v, a) = (v, a')" 
   shows "(\<phi>\<^sub>S\<inverse> \<Psi> s') v = Some a \<longleftrightarrow> the (s' (v, a))" 
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?D = "range_of \<Psi>"
     and ?s = "\<phi>\<^sub>S\<inverse> \<Psi> s'"
   let ?as = "all_possible_assignments_for \<Psi>"
   let ?l = "filter (\<lambda>(v, a). s' (v, a) = Some True) ?as"
   show ?thesis 
     proof (rule iffI)
       assume s_of_v_is_Some_a: "?s v = Some a" 
       {
         have "(v, a) \<in> set ?l" 
           using s_of_v_is_Some_a 
           unfolding SAS_Plus_STRIPS.strips_state_to_state_def 
             strips_state_to_state_def 
           using map_of_SomeD
           by fast
         hence "s' (v, a) = Some True"
           unfolding all_possible_assignments_for_set_is set_filter
           by blast
       }
       thus "the (s' (v, a))"
         by simp
     next 
       assume the_of_s'_of_v_a_is: "the (s' (v, a))"
       then have s'_of_v_a_is_Some_true: "s' (v, a) = Some True"
         using assms(4) domIff 
         by force
       \<comment> \<open> TODO slow. \<close>
       moreover {
         fix v v' a a'
         assume "(v, a) \<in> set ?l" and "(v', a') \<in> set ?l"
         then have "v \<noteq> v' \<or> a = a'" 
         using assms(5)
         by fastforce
       }
       moreover {
         have "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). sas_plus_problem.range_of \<Psi> v \<noteq> None"  
           using is_valid_problem_sas_plus_then(1) assms(1)
             range_of_not_empty 
           by force
         (* TODO slow. *)
         moreover have "set ?l = Set.filter (\<lambda>(v, a). s' (v, a) = Some True) 
           (\<Union>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). { (v, a) | a.  a \<in> \<R>\<^sub>+ \<Psi> v })"
           using all_possible_assignments_for_set_is calculation
           by force
         ultimately have "(v, a) \<in> set ?l" 
           using assms(2, 3) s'_of_v_a_is_Some_true
           by simp
       }
       ultimately show "?s v = Some a"  
         using map_of_constant_assignments_defined_if[of ?l v a]
         unfolding SAS_Plus_STRIPS.strips_state_to_state_def
           strips_state_to_state_def
         by blast
     qed
 qed
 
 \<comment> \<open> NOTE A technical lemma which characterizes the return values for possible assignments 
 @{text "(v, a)"} when used as variables on a state @{text "s"} which was transformed from. \<close> 
 lemma strips_state_to_state_inverse_is_i:
 assumes "is_valid_problem_sas_plus \<Psi>"
   and "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
   and "s v \<noteq> None" 
   and "a \<in> \<R>\<^sub>+ \<Psi> v" 
 shows "(\<phi>\<^sub>S \<Psi> s) (v, a) = Some (the (s v) = a)"
 proof -
    let ?vs = "sas_plus_problem.variables_of \<Psi>"
   let ?s' = "\<phi>\<^sub>S \<Psi> s"
     and ?f = "\<lambda>(v, a). the (s v) = a"
     and ?l = "concat (map (possible_assignments_for \<Psi>) (filter (\<lambda>v. s v \<noteq> None) ?vs))"
   have "(v, a) \<in> dom ?s'" 
     using state_to_strips_state_dom_element_iff[
         OF assms(1)] assms(2, 3, 4)
     by presburger
   {
     have "v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }"
       using assms(2, 3)
       by blast
     moreover have "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). v \<in> dom (sas_plus_problem.range_of \<Psi>)"
       using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of[OF assms(1)]. 
     moreover have "set ?l = (\<Union>v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }. 
       { (v, a) |a. a \<in> \<R>\<^sub>+ \<Psi> v })"
       unfolding state_to_strips_state_dom_is_i[OF calculation(2)]
       by blast
     ultimately have "(v, a) \<in> set ?l" 
       using assms(4)
       by blast
   }
   moreover have "set ?l \<noteq> {}" 
     using calculation
     by force
   \<comment> \<open> TODO slow.\<close>
   ultimately show ?thesis 
     unfolding SAS_Plus_STRIPS.state_to_strips_state_def
       state_to_strips_state_def 
     using map_of_from_function_graph_is_some_if[of ?l "(v, a)" ?f] 
     unfolding split_def
     by fastforce
 qed
 
 \<comment> \<open> NOTE Show that the transformed strips state is consistent for pairs of assignments 
 @{text "(v, a)"} and @{text "(v, a')"} in the same variable domain. \<close>
 (* TODO make private. *)
 corollary strips_state_to_state_inverse_is_ii:
 assumes "is_valid_problem_sas_plus \<Psi>"
   and "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
   and "s v = Some a"  
   and "a \<in> \<R>\<^sub>+ \<Psi> v" 
   and "a' \<in> \<R>\<^sub>+ \<Psi> v" 
   and "a' \<noteq> a"
 shows "(\<phi>\<^sub>S \<Psi> s) (v, a') = Some False"
 proof -
   have "s v \<noteq> None" 
     using assms(3) 
     by simp
   moreover have "the (s v) \<noteq> a'" 
     using assms(3, 6) 
     by simp 
   ultimately show ?thesis 
     using strips_state_to_state_inverse_is_i[OF assms(1, 2) _ assms(5)]
     by force
 qed
 
 \<comment> \<open> NOTE Follows from the corollary above by contraposition. \<close>
 (* TODO make private. *)
 corollary strips_state_to_state_inverse_is_iii:
 assumes "is_valid_problem_sas_plus \<Psi>"
   and "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
   and "s v = Some a" 
   and "a \<in> \<R>\<^sub>+ \<Psi> v" 
   and "a' \<in> \<R>\<^sub>+ \<Psi> v" 
   and "(\<phi>\<^sub>S \<Psi> s) (v, a) = Some True"
   and "(\<phi>\<^sub>S \<Psi> s) (v, a') = Some True"
 shows "a = a'"
 proof -
   have "s v \<noteq> None" 
     using assms(3)
     by blast
   thus ?thesis 
     using strips_state_to_state_inverse_is_i[OF assms(1, 2)] assms(4, 5, 6, 7)
     by auto
 qed
 
 (* TODO make private. *)
 lemma strips_state_to_state_inverse_is_iv:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "dom s \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
     and "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
     and "s v = Some a" 
     and "a \<in> \<R>\<^sub>+ \<Psi> v" 
   shows "(\<phi>\<^sub>S\<inverse> \<Psi> (\<phi>\<^sub>S \<Psi> s)) v = Some a"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?s' = "\<phi>\<^sub>S \<Psi> s"
   let ?s'' = "\<phi>\<^sub>S\<inverse> \<Psi> ?s'" 
   let ?P = "\<lambda>(v, a). ?s' (v, a) = Some True"
   let ?as = "filter ?P (all_possible_assignments_for \<Psi>)" 
     and ?As = "Set.filter ?P (\<Union>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). 
       { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })"
   {
     have "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). range_of \<Psi> v \<noteq> None"
       using sublocale_sas_plus_finite_domain_representation_ii(1)[OF assms(1)] 
         range_of_not_empty
       by force
     (* TODO slow. *)
     hence "set ?as = ?As"
       unfolding set_filter 
       using all_possible_assignments_for_set_is
       by force
   } note nb = this
   moreover {
     {
       fix v v' a a' 
       assume "(v, a) \<in> set ?as" 
         and "(v', a') \<in> set ?as" 
       then have "(v, a) \<in> ?As" and "(v', a') \<in> ?As" 
         using nb 
         by blast+
       then have v_in_set_vs: "v \<in> set ?vs" and v'_in_set_vs: "v' \<in> set ?vs"
         and a_in_range_of_v: "a \<in> \<R>\<^sub>+ \<Psi> v" 
         and a'_in_range_of_v: "a' \<in> \<R>\<^sub>+ \<Psi> v'" 
         and s'_of_v_a_is: "?s' (v, a) = Some True" and s'_of_v'_a'_is: "?s' (v', a') = Some True" 
         by fastforce+
       then have "(v, a) \<in> dom ?s'"  
         by blast
       then have s_of_v_is_Some_a: "s v = Some a"  
         using state_to_strips_state_dom_element_iff[OF assms(1)]
           state_to_strips_state_range_is[OF assms(1)] s'_of_v_a_is 
            by auto
       have "v \<noteq> v' \<or> a = a'"
         proof (rule ccontr)
           assume "\<not>(v \<noteq> v' \<or> a = a')"
           then have "v = v'" and "a \<noteq> a'" 
             by simp+
           thus False
             using a'_in_range_of_v a_in_range_of_v assms(1) v'_in_set_vs s'_of_v'_a'_is 
               s'_of_v_a_is s_of_v_is_Some_a strips_state_to_state_inverse_is_iii
             by force
         qed
     }
     moreover {
       have "s v \<noteq> None" 
         using assms(4)
         by simp
       then have "?s' (v, a) = Some True" 
         using strips_state_to_state_inverse_is_i[OF assms(1, 3) _ assms(5)] 
           assms(4)
         by simp
       (* TODO slow *)
       hence "(v, a) \<in> set ?as" 
         using all_possible_assignments_for_set_is assms(3, 5) nb
         by simp
     }
     ultimately have "map_of ?as v = Some a" 
       using map_of_constant_assignments_defined_if[of ?as v a] 
       by blast
   }
   \<comment> \<open> TODO slow. \<close>
   thus ?thesis
     unfolding SAS_Plus_STRIPS.strips_state_to_state_def
       strips_state_to_state_def all_possible_assignments_for_def
     by simp
 qed
 
 (* TODO the constraints on the state @{text "s"} could be refactored into a definition of valid 
 states for a problem description. *)
 (* TODO The proof is not very elegant. Should be simplified. *)
 \<comment> \<open> Show that that \<open>\<phi>\<^sub>S\<inverse> \<Psi>\<close> is the inverse of \<open>\<phi>\<^sub>S \<Psi>\<close>. The additional constraints 
 \<^term>\<open>dom s = set ((\<Psi>)\<^sub>\<V>\<^sub>+)\<close> and \<^term>\<open>\<forall>v \<in> dom s. the (s v) \<in> \<R>\<^sub>+ \<Psi> v\<close> are needed because the 
 transformation functions only take into account variables and domains declared in the problem 
 description. They also sufficiently characterize a state that was transformed from SAS+ to STRIPS. \<close>
 lemma strips_state_to_state_inverse_is:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "dom s \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
     and "\<forall>v \<in> dom s. the (s v) \<in> \<R>\<^sub>+ \<Psi> v" 
   shows "s = (\<phi>\<^sub>S\<inverse> \<Psi> (\<phi>\<^sub>S \<Psi> s))"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?D = "range_of \<Psi>"
   let ?s' = "\<phi>\<^sub>S \<Psi> s" 
   let ?s'' = "\<phi>\<^sub>S\<inverse> \<Psi> ?s'"
   \<comment> \<open> NOTE Show the thesis by proving that @{text "s"} and @{text "?s'"} are mutual submaps. \<close>
   {
     fix v
     assume v_in_dom_s: "v \<in> dom s"
     then have v_in_set_vs: "v \<in> set ?vs" 
       using assms(2) 
       by auto
     then obtain a 
       where the_s_v_is_a: "s v = Some a" 
         and a_in_dom_v: "a \<in> \<R>\<^sub>+ \<Psi> v" 
       using assms(2, 3) v_in_dom_s
       by force
     moreover have "?s'' v = Some a" 
       using strips_state_to_state_inverse_is_iv[OF assms(1, 2)] v_in_set_vs
         the_s_v_is_a a_in_dom_v 
       by force
     ultimately have "s v = ?s'' v"
       by argo
   } note nb = this
   moreover {
     fix v
     assume "v \<in> dom ?s''"
     then obtain a 
       where "a \<in> \<R>\<^sub>+ \<Psi> v" 
         and "?s' (v, a) = Some True" 
       using strips_state_to_state_dom_is[OF assms(1)]
       by blast
     then have "(v, a) \<in> dom ?s'" 
       by blast
     then have "s v \<noteq> None" 
       using state_to_strips_state_dom_is[OF assms(1)]
       by simp
     then obtain a where "s v = Some a" 
       by blast
     hence "?s'' v = s v"
       using nb 
       by fastforce
   }
   \<comment> \<open> TODO slow.\<close>
   ultimately show ?thesis 
     using map_le_antisym[of s ?s''] map_le_def
     unfolding strips_state_to_state_def 
       state_to_strips_state_def
     by blast
 qed
 
 \<comment> \<open> An important lemma which shows that the submap relation does not change if we transform the 
 states on either side from SAS+ to STRIPS. 
 % TODO what is this called generally? Predicate monotony?? \<close>
 lemma state_to_strips_state_map_le_iff:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "dom s \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
     and "\<forall>v \<in> dom s. the (s v) \<in> \<R>\<^sub>+ \<Psi> v" 
   shows "s \<subseteq>\<^sub>m t \<longleftrightarrow> (\<phi>\<^sub>S \<Psi> s) \<subseteq>\<^sub>m (\<phi>\<^sub>S \<Psi> t)"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?D = "range_of \<Psi>"
     and ?s' = "\<phi>\<^sub>S \<Psi> s" 
     and ?t' = "\<phi>\<^sub>S \<Psi> t" 
   show ?thesis
     proof (rule iffI)
       assume s_map_le_t: "s \<subseteq>\<^sub>m t"
       {
         fix v a
         assume "(v, a) \<in> dom ?s'" 
         moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" and "s v \<noteq> None" and "a \<in> \<R>\<^sub>+ \<Psi> v"
           using state_to_strips_state_dom_is[OF assms(1)] calculation 
           by blast+
         moreover have "?s' (v, a) = Some (the (s v) = a)"
           using state_to_strips_state_range_is[OF assms(1)] calculation(1) 
           by meson
         moreover have "v \<in> dom s" 
           using calculation(3)
           by auto 
         moreover have "s v = t v" 
           using s_map_le_t calculation(6) 
           unfolding map_le_def
           by blast
         moreover have "t v \<noteq> None" 
           using calculation(3, 7)
           by argo
         moreover have "(v, a) \<in> dom ?t'" 
           using state_to_strips_state_dom_is[OF assms(1)] calculation(2, 4, 8) 
           by blast
         moreover have "?t' (v, a) = Some (the (t v) = a)" 
           using state_to_strips_state_range_is[OF assms(1)] calculation(9)
           by simp
         ultimately have "?s' (v, a) = ?t' (v, a)"
           by presburger
       }
       thus "?s' \<subseteq>\<^sub>m ?t'" 
         unfolding map_le_def 
         by fast
     next
       assume s'_map_le_t': "?s' \<subseteq>\<^sub>m ?t'"
       {
         fix v 
         assume v_in_dom_s: "v \<in> dom s" 
         moreover obtain a where the_of_s_of_v_is_a: "the (s v) = a" 
           by blast
         moreover have v_in_vs: "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
           and s_of_v_is_not_None: "s v \<noteq> None" 
           and a_in_range_of_v: "a \<in> \<R>\<^sub>+ \<Psi> v"
           using assms(2, 3) v_in_dom_s calculation
           by blast+
         moreover have "(v, a) \<in> dom ?s'"  
           using state_to_strips_state_dom_is[OF assms(1)] 
             calculation(3, 4, 5)
           by simp
         moreover have "?s' (v, a) = ?t' (v, a)"
           using s'_map_le_t' calculation
           unfolding map_le_def 
           by blast
         moreover have "(v, a) \<in> dom ?t'" 
           using calculation 
           unfolding domIff
           by argo
         moreover have "?s' (v, a) = Some (the (s v) = a)"
           and "?t' (v, a) = Some (the (t v) = a)" 
           using state_to_strips_state_range_is[OF assms(1)] calculation
           by fast+
         moreover have "s v = Some a" 
           using calculation(2, 4) 
           by force
         moreover have "?s' (v, a) = Some True" 
           using calculation(9, 11)
           by fastforce
         moreover have "?t' (v, a) = Some True" 
           using calculation(7, 12)
           by argo
         moreover have "the (t v) = a" 
           using calculation(10, 13) try0
           by force
         moreover {
           have "v \<in> dom t" 
             using state_to_strips_state_dom_element_iff[OF assms(1)] 
               calculation(8) 
             by auto
           hence "t v = Some a"
             using calculation(14)
             by force
         }
         ultimately have "s v = t v"
           by argo
       }
       thus "s \<subseteq>\<^sub>m t"
         unfolding map_le_def
         by simp
     qed
 qed
 
 \<comment> \<open> We also show that \<open>\<phi>\<^sub>O\<inverse> \<Pi>\<close> is the inverse of \<open>\<phi>\<^sub>O \<Psi>\<close>. Note that this proof is completely 
 mechanical since both the precondition and effect lists are simply being copied when transforming 
 from SAS+ to STRIPS and when transforming back from STRIPS to SAS+. \<close>
 (* TODO rename \<open>sasp_op_to_strips_inverse_is\<close> *)
 (* TODO prune assumptions (not required) *)
 lemma sas_plus_operator_inverse_is:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
   shows "(\<phi>\<^sub>O\<inverse> \<Psi> (\<phi>\<^sub>O \<Psi> op)) = op"
 proof -
   let ?op = "\<phi>\<^sub>O\<inverse> \<Psi> (\<phi>\<^sub>O \<Psi> op)"
   have "precondition_of ?op = precondition_of op"
     unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
       strips_op_to_sasp_def
       SAS_Plus_STRIPS.sasp_op_to_strips_def
       sasp_op_to_strips_def
     by fastforce
   moreover have "effect_of ?op = effect_of op" 
     unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
       strips_op_to_sasp_def
       SAS_Plus_STRIPS.sasp_op_to_strips_def
       sasp_op_to_strips_def
     by force
   ultimately show ?thesis 
     by simp
 qed
 
 \<comment> \<open> Note that we have to make the assumption that \<open>op'\<close> is a member of the operator set of the 
 induced STRIPS problem \<open>\<phi> \<Psi>\<close>. This implies that \<open>op'\<close> was transformed from an 
 \<open>op \<in> operators_of \<Psi>\<close>. If we don't make this assumption, then multiple STRIPS operators of the 
 form  \<open>\<lparr> precondition_of = [], add_effects_of = [], delete_effects_of = [(v, a), ...] \<rparr>\<close> correspond 
 to one SAS+ operator (since the delete effects are being discarded in the transformation function). 
 \<close>
 lemma strips_operator_inverse_is:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)" 
   shows "(\<phi>\<^sub>O \<Psi> (\<phi>\<^sub>O\<inverse> \<Psi> op')) = op'" 
   proof -
     let ?\<Pi> = "\<phi> \<Psi>"
     obtain op where "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = \<phi>\<^sub>O \<Psi> op" 
       using assms 
       by auto
     moreover have "\<phi>\<^sub>O\<inverse> \<Psi> op' = op" 
       using sas_plus_operator_inverse_is[OF assms(1) calculation(1)] calculation(2)
       by blast
     ultimately show ?thesis
       by argo
   qed
 
 (* 
   \<^item> TODO Simplify | refactor proof. 
   \<^item> TODO make private. *)
 lemma sas_plus_equivalent_to_strips_i_a_I:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "set ops' \<subseteq> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "STRIPS_Semantics.are_all_operators_applicable (\<phi>\<^sub>S \<Psi> s) ops'"
     and "op \<in> set [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']" 
   shows "map_of (precondition_of op) \<subseteq>\<^sub>m (\<phi>\<^sub>S\<inverse> \<Psi> (\<phi>\<^sub>S \<Psi> s))" 
 proof -
   let ?\<Pi> = "\<phi> \<Psi>"
     and ?s' = "\<phi>\<^sub>S \<Psi> s" 
   let ?s = "\<phi>\<^sub>S\<inverse> \<Psi> ?s'" 
     and ?D = "range_of \<Psi>"
     and ?ops = "[\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']" 
     and ?pre = "precondition_of op" 
   have nb\<^sub>1: "\<forall>(v, a) \<in> dom ?s'. 
     \<forall>(v, a') \<in> dom ?s'. 
       ?s' (v, a) = Some True \<and> ?s' (v, a') = Some True
       \<longrightarrow> (v, a) = (v, a')" 
     using state_to_strips_state_effect_consistent[OF assms(1)] 
     by blast
   {
     fix op'
     assume "op' \<in> set ops'" 
     moreover have "op' \<in> set ((?\<Pi>)\<^sub>\<O>)"
       using assms(2) calculation 
       by blast
     ultimately have "\<exists>op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+). op' = (\<phi>\<^sub>O \<Psi> op)" 
       by auto
   } note nb\<^sub>2 = this
   {
     fix op
     assume "op \<in> set ?ops" 
     then obtain op' where "op' \<in> set ops'" and "op = \<phi>\<^sub>O\<inverse> \<Psi> op'" 
       using assms(4) 
       by auto
     moreover obtain op'' where "op'' \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = \<phi>\<^sub>O \<Psi> op''" 
       using nb\<^sub>2 calculation(1)
       by blast
     moreover have "op = op''"
       using sas_plus_operator_inverse_is[OF assms(1) calculation(3)] calculation(2, 4)  
       by blast
     ultimately have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
       by blast
   } note nb\<^sub>3 = this
   {
     fix op v a
     assume "op \<in> set ?ops" 
       and v_a_in_precondition_of_op': "(v, a) \<in> set (precondition_of op)"
     moreover obtain op' where "op' \<in> set ops'" and "op = \<phi>\<^sub>O\<inverse> \<Psi> op'" 
       using calculation(1) 
       by auto
     moreover have "strips_operator.precondition_of op' = precondition_of op" 
       using calculation(4) 
       unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
         strips_op_to_sasp_def
       by simp
     ultimately have "\<exists>op' \<in> set ops'. op = (\<phi>\<^sub>O\<inverse> \<Psi> op')
       \<and> (v, a) \<in> set (strips_operator.precondition_of op')" 
       by metis
   } note nb\<^sub>4 = this
   {
     fix op' v a
     assume "op' \<in> set ops'" 
       and v_a_in_precondition_of_op': "(v, a) \<in> set (strips_operator.precondition_of op')"
     moreover have s'_of_v_a_is_Some_True: "?s' (v, a) = Some True" 
       using assms(3) calculation(1, 2) 
       unfolding are_all_operators_applicable_set
       by blast
     moreover {
       obtain op where "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = \<phi>\<^sub>O \<Psi> op" 
         using nb\<^sub>2 calculation(1) 
         by blast
       moreover have "strips_operator.precondition_of op' = precondition_of op" 
         using calculation(2) 
         unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
           sasp_op_to_strips_def
         by simp
       moreover have "(v, a) \<in> set (precondition_of op)"
         using v_a_in_precondition_of_op' calculation(3)
         by argo
       moreover have "is_valid_operator_sas_plus \<Psi> op" 
         using is_valid_problem_sas_plus_then(2) assms(1) calculation(1)
         unfolding is_valid_operator_sas_plus_def
         by auto
       moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" and "a \<in> \<R>\<^sub>+ \<Psi> v" 
         using is_valid_operator_sas_plus_then(1,2) calculation(4, 5)
         unfolding is_valid_operator_sas_plus_def
         by fastforce+
       moreover have "v \<in> dom ?s" 
         using strips_state_to_state_dom_is[OF assms(1), of ?s'] 
           s'_of_v_a_is_Some_True calculation(6, 7)
         by blast
       moreover have "(v, a) \<in> dom ?s'" 
         using s'_of_v_a_is_Some_True domIff 
         by blast
       ultimately have "?s v = Some a"
         using strips_state_to_state_range_is[OF assms(1) _ _ _ nb\<^sub>1] 
           s'_of_v_a_is_Some_True 
         by simp
     }
     hence "?s v = Some a".
   } note nb\<^sub>5 = this
   {
     fix v
     assume "v \<in> dom (map_of ?pre)"
     then obtain a where "map_of ?pre v = Some a"
       by fast
     moreover have "(v, a) \<in> set ?pre" 
       using map_of_SomeD calculation
       by fast
     moreover {
       have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
         using assms(4) nb\<^sub>3
         by blast
       then have "is_valid_operator_sas_plus \<Psi> op" 
         using is_valid_problem_sas_plus_then(2) assms(1)
         unfolding is_valid_operator_sas_plus_def
         by auto
       hence "\<forall>(v, a) \<in> set ?pre. \<forall>(v', a') \<in> set ?pre. v \<noteq> v' \<or> a = a'"
         using is_valid_operator_sas_plus_then(5)
         unfolding is_valid_operator_sas_plus_def
         by fast
     }
     moreover have "map_of ?pre v = Some a"
       using map_of_constant_assignments_defined_if[of ?pre] calculation(2, 3)
       by blast
     moreover obtain op' where "op' \<in> set ops'" 
       and "(v, a) \<in> set (strips_operator.precondition_of op')" 
       using nb\<^sub>4[OF assms(4) calculation(2)]
       by blast
     moreover have "?s v = Some a" 
       using nb\<^sub>5 calculation(5, 6) 
       by fast
     ultimately have "map_of ?pre v = ?s v"
       by argo
   }
   thus ?thesis 
     unfolding map_le_def
     by blast
 qed
 
 lemma to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "set ops' \<subseteq> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "op \<in> set [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']" 
   shows "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+) \<and> (\<exists>op' \<in> set ops'. op' = \<phi>\<^sub>O \<Psi> op)"
 proof - 
   let ?\<Pi> = "\<phi> \<Psi>"
   obtain op' where "op' \<in> set ops'" and "op = \<phi>\<^sub>O\<inverse> \<Psi> op'" 
     using assms(3) 
     by auto
   moreover have "op' \<in> set ((?\<Pi>)\<^sub>\<O>)"
     using assms(2) calculation(1) 
     by blast
   moreover obtain op'' where "op'' \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = \<phi>\<^sub>O \<Psi> op''" 
     using calculation(3) 
     by auto
   moreover have "op = op''" 
     using sas_plus_operator_inverse_is[OF assms(1) calculation(4)] calculation(2, 5) 
     by presburger
   ultimately show ?thesis 
     by blast
 qed
 
 (* \<^item> TODO Prune premises (2nd premise and \<open>are_all_operators_applicable s' ops'\<close> can be removed?). 
    \<^item> TODO make private. 
    \<^item> TODO adjust nb indexes *)
 lemma sas_plus_equivalent_to_strips_i_a_II:
   fixes \<Psi> :: "('variable, 'domain) sas_plus_problem"
   fixes s :: "('variable, 'domain) state" 
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "set ops' \<subseteq> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "STRIPS_Semantics.are_all_operators_applicable (\<phi>\<^sub>s \<Psi> s) ops' 
       \<and> STRIPS_Semantics.are_all_operator_effects_consistent ops'"
   shows "are_all_operator_effects_consistent [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']" 
 proof -
   let ?s' = "\<phi>\<^sub>S \<Psi> s"
   let ?s = "\<phi>\<^sub>S\<inverse> \<Psi> ?s'"
     and ?ops = "[\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']"
     and ?\<Pi> = "\<phi> \<Psi>"
   have nb: "\<forall>(v, a) \<in> dom ?s'. 
     \<forall>(v, a') \<in> dom ?s'. 
       ?s' (v, a) = Some True \<and> ?s' (v, a') = Some True
       \<longrightarrow> (v, a) = (v, a')" 
     using state_to_strips_state_effect_consistent[OF assms(1)] 
     by blast
   {
     fix op\<^sub>1' op\<^sub>2'
     assume "op\<^sub>1' \<in> set ops'" and "op\<^sub>2' \<in> set ops'"
     hence "STRIPS_Semantics.are_operator_effects_consistent op\<^sub>1' op\<^sub>2'" 
       using assms(3)
       unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
       by blast
   } note nb\<^sub>1 = this
   {
     fix op\<^sub>1 op\<^sub>1' op\<^sub>2 op\<^sub>2'
     assume op\<^sub>1_in_ops: "op\<^sub>1 \<in> set ?ops"
       and op\<^sub>1'_in_ops': "op\<^sub>1' \<in> set ops'" 
       and op\<^sub>1'_is: "op\<^sub>1' = \<phi>\<^sub>O \<Psi> op\<^sub>1" 
       and is_valid_op\<^sub>1: "is_valid_operator_sas_plus \<Psi> op\<^sub>1"
       and op\<^sub>2_in_ops: "op\<^sub>2 \<in> set ?ops"
       and op\<^sub>2'_in_ops': "op\<^sub>2' \<in> set ops'" 
       and op\<^sub>2'_is: "op\<^sub>2' = \<phi>\<^sub>O \<Psi> op\<^sub>2"
       and is_valid_op\<^sub>2: "is_valid_operator_sas_plus \<Psi> op\<^sub>2"
     have "\<forall>(v, a) \<in> set (add_effects_of op\<^sub>1'). \<forall>(v', a') \<in> set (add_effects_of op\<^sub>2').
           v \<noteq> v' \<or> a = a'" 
       proof (rule ccontr)
         assume "\<not>(\<forall>(v, a) \<in> set (add_effects_of op\<^sub>1'). \<forall>(v', a') \<in> set (add_effects_of op\<^sub>2'). 
         v \<noteq> v' \<or> a = a')"
         then obtain v v' a a' where "(v, a) \<in> set (add_effects_of op\<^sub>1')" 
           and "(v', a') \<in> set (add_effects_of op\<^sub>2')" 
           and "v = v'" 
           and "a \<noteq> a'" 
           by blast
         \<comment> \<open> TODO slow. \<close>
         moreover have "(v, a) \<in> set (effect_of op\<^sub>1)"  
           using op\<^sub>1'_is op\<^sub>2'_is calculation(1, 2)
           unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
             sasp_op_to_strips_def 
           by force
         moreover {
           have "(v', a') \<in> set (effect_of op\<^sub>2)" 
             using op\<^sub>2'_is calculation(2) 
             unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
               sasp_op_to_strips_def
             by force
           hence "a' \<in> \<R>\<^sub>+ \<Psi> v"
             using is_valid_operator_sas_plus_then is_valid_op\<^sub>2 calculation(3)
             by fastforce
         }
         moreover have "(v, a') \<in> set (delete_effects_of op\<^sub>1')" 
           using sasp_op_to_strips_set_delete_effects_is
             op\<^sub>1'_is is_valid_op\<^sub>1 calculation(3, 4, 5, 6)
           by blast
         moreover have "\<not>STRIPS_Semantics.are_operator_effects_consistent op\<^sub>1' op\<^sub>2'" 
           unfolding STRIPS_Semantics.are_operator_effects_consistent_def list_ex_iff 
           using calculation(2, 3, 7)
           by meson
         ultimately show False 
           using assms(3) op\<^sub>1'_in_ops' op\<^sub>2'_in_ops'
           unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
           by blast
       qed
   } note nb\<^sub>3 = this
   {
     fix op\<^sub>1 op\<^sub>2
     assume op\<^sub>1_in_ops: "op\<^sub>1 \<in> set ?ops" and op\<^sub>2_in_ops: "op\<^sub>2 \<in> set ?ops" 
     moreover have op\<^sub>1_in_operators_of_\<Psi>: "op\<^sub>1 \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
       and op\<^sub>2_in_operators_of_\<Psi>: "op\<^sub>2 \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
       using to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure[OF 
           assms(1, 2)] calculation
       by blast+
     moreover have is_valid_operator_op\<^sub>1: "is_valid_operator_sas_plus \<Psi> op\<^sub>1" 
       and is_valid_operator_op\<^sub>2: "is_valid_operator_sas_plus \<Psi> op\<^sub>2" 
       using is_valid_problem_sas_plus_then(2) op\<^sub>1_in_operators_of_\<Psi> op\<^sub>2_in_operators_of_\<Psi>
         assms(1)
       unfolding is_valid_operator_sas_plus_def
       by auto+
     moreover obtain op\<^sub>1' op\<^sub>2' 
       where op\<^sub>1_in_ops': "op\<^sub>1' \<in> set ops'" 
         and op\<^sub>1_is: "op\<^sub>1' = \<phi>\<^sub>O \<Psi> op\<^sub>1"
         and op\<^sub>2_in_ops': "op\<^sub>2' \<in> set ops'"
         and op\<^sub>2_is: "op\<^sub>2' = \<phi>\<^sub>O \<Psi> op\<^sub>2"
       using to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure[OF 
           assms(1, 2)] op\<^sub>1_in_ops op\<^sub>2_in_ops
       by blast
     \<comment> \<open> TODO slow.\<close>
     ultimately have "\<forall>(v, a) \<in> set (add_effects_of op\<^sub>1'). \<forall>(v', a') \<in> set (add_effects_of op\<^sub>2').
           v \<noteq> v' \<or> a = a'" 
       using nb\<^sub>3 
       by auto
     hence "are_operator_effects_consistent op\<^sub>1 op\<^sub>2"
       using op\<^sub>1_is op\<^sub>2_is 
       unfolding are_operator_effects_consistent_def
         sasp_op_to_strips_def 
         SAS_Plus_STRIPS.sasp_op_to_strips_def
         list_all_iff Let_def
       by simp
   }
   thus ?thesis 
     unfolding are_all_operator_effects_consistent_def list_all_iff 
     by fast
 qed
 
 \<comment> \<open> A technical lemmas used in \<open>sas_plus_equivalent_to_strips_i_a\<close> showing that 
 the execution precondition is linear w.r.t. to STRIPS transformation to SAS+. 
 
 The second premise states that the given STRIPS state corresponds to a consistent SAS+ state (i.e.
 no two assignments of the same variable to different values exist). \<close>
 (* 
   \<^item> TODO make private. 
   \<^item> TODO decrement suffix *)
 lemma sas_plus_equivalent_to_strips_i_a_IV: 
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "set ops' \<subseteq> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "STRIPS_Semantics.are_all_operators_applicable (\<phi>\<^sub>S \<Psi> s) ops' 
       \<and> STRIPS_Semantics.are_all_operator_effects_consistent ops'"
   shows "are_all_operators_applicable_in (\<phi>\<^sub>S\<inverse> \<Psi> (\<phi>\<^sub>S \<Psi> s)) [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops'] \<and>
     are_all_operator_effects_consistent [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']" 
 proof -
   let ?\<Pi> = "\<phi> \<Psi>"
     and ?s' = "\<phi>\<^sub>S \<Psi> s"
   let ?vs' = "strips_problem.variables_of ?\<Pi>"
     and ?ops' = "strips_problem.operators_of ?\<Pi>" 
     and ?vs = "variables_of \<Psi>"
     and ?D = "range_of \<Psi>"
     and ?s = "\<phi>\<^sub>S\<inverse> \<Psi> ?s'"
     and ?ops = "[\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']"
   have nb: "\<forall>(v, a) \<in> dom ?s'. 
     \<forall>(v, a') \<in> dom (\<phi>\<^sub>S \<Psi> s). 
       ?s' (v, a) = Some True \<and> ?s' (v, a') = Some True
       \<longrightarrow> (v, a) = (v, a')" 
     using state_to_strips_state_effect_consistent[OF assms(1)] 
     by blast
   {
     have "STRIPS_Semantics.are_all_operators_applicable ?s' ops'" 
       using assms(3)
       by simp
     moreover have "list_all (\<lambda>op. map_of (precondition_of op) \<subseteq>\<^sub>m ?s) ?ops"
       using sas_plus_equivalent_to_strips_i_a_I[OF assms(1) assms(2)] calculation
       unfolding list_all_iff
       by blast
     moreover have "list_all (\<lambda>op. list_all (are_operator_effects_consistent op) ?ops) ?ops" 
       using sas_plus_equivalent_to_strips_i_a_II assms nb
       unfolding are_all_operator_effects_consistent_def is_valid_operator_sas_plus_def list_all_iff 
       by blast
     ultimately have "are_all_operators_applicable_in ?s ?ops" 
       unfolding are_all_operators_applicable_in_def is_operator_applicable_in_def list_all_iff
       by argo
   }
   moreover have "are_all_operator_effects_consistent ?ops" 
     using sas_plus_equivalent_to_strips_i_a_II assms nb
     by simp
   ultimately show ?thesis
     by simp
 qed
 
 (* TODO:
   \<^item> prune premises + make private. 
   \<^item> decrement suffixes 
 *)
 lemma sas_plus_equivalent_to_strips_i_a_VI:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "dom s \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
     and "\<forall>v \<in> dom s. the (s v) \<in> \<R>\<^sub>+ \<Psi> v" 
     and "set ops' \<subseteq> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "are_all_operators_applicable_in s [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops'] \<and>
       are_all_operator_effects_consistent [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']"  
   shows "STRIPS_Semantics.are_all_operators_applicable (\<phi>\<^sub>S \<Psi> s) ops'"
 proof -   
   let ?vs = "variables_of \<Psi>" 
     and ?D = "range_of \<Psi>"
     and ?\<Pi> = "\<phi> \<Psi>" 
     and ?ops = "[\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']" 
     and ?s' = "\<phi>\<^sub>S \<Psi> s"
   \<comment> \<open> TODO refactor. \<close>
   {
     fix op' 
     assume "op' \<in> set ops'" 
     moreover obtain op where "op \<in> set ?ops" and "op = \<phi>\<^sub>O\<inverse> \<Psi> op'" 
       using calculation
       by force
     moreover obtain op'' where "op'' \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = \<phi>\<^sub>O \<Psi> op''" 
       using assms(4) calculation(1) 
       by auto
     moreover have "is_valid_operator_sas_plus \<Psi> op''" 
       using is_valid_problem_sas_plus_then(2) assms(1) calculation(4)
       unfolding is_valid_operator_sas_plus_def
       by auto
     moreover have "op = op''" 
       using sas_plus_operator_inverse_is[OF assms(1)] calculation(3, 4, 5)
       by blast
     ultimately have "\<exists>op \<in> set ?ops. op \<in> set ?ops \<and> op = (\<phi>\<^sub>O\<inverse> \<Psi> op') 
       \<and> is_valid_operator_sas_plus \<Psi> op"
       by blast
   } note nb\<^sub>1 = this
   have nb\<^sub>2: "\<forall>(v, a) \<in> dom ?s'. 
     \<forall>(v, a') \<in> dom ?s'. 
       ?s' (v, a) = Some True \<and> ?s' (v, a') = Some True
       \<longrightarrow> (v, a) = (v, a')" 
     using state_to_strips_state_effect_consistent[OF assms(1), of _ _ s]
     by blast
   {
     fix op
     assume "op \<in> set ?ops" 
     hence "map_of (precondition_of op) \<subseteq>\<^sub>m s" 
       using assms(5) 
       unfolding are_all_operators_applicable_in_def 
         is_operator_applicable_in_def list_all_iff
       by blast
   } note nb\<^sub>3 = this
   {
     fix op'
     assume "op' \<in> set ops'" 
     then obtain op where op_in_ops: "op \<in> set ?ops" 
       and op_is: "op = (\<phi>\<^sub>O\<inverse> \<Psi> op')" 
       and is_valid_operator_op: "is_valid_operator_sas_plus \<Psi> op" 
       using nb\<^sub>1
       by force
     moreover have preconditions_are_consistent: 
       "\<forall>(v, a) \<in> set (precondition_of op). \<forall>(v', a') \<in> set (precondition_of op). v \<noteq> v' \<or> a = a'" 
       using is_valid_operator_sas_plus_then(5) calculation(3) 
       unfolding is_valid_operator_sas_plus_def
       by fast
     moreover {
       fix v a
       assume "(v, a) \<in> set (strips_operator.precondition_of op')"
       moreover have v_a_in_precondition_of_op: "(v, a) \<in> set (precondition_of op)" 
         using op_is calculation 
         unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
           strips_op_to_sasp_def
         by auto
       moreover have "map_of (precondition_of op) v = Some a" 
         using map_of_constant_assignments_defined_if[OF 
             preconditions_are_consistent calculation(2)]
         by blast
       moreover have s_of_v_is: "s v = Some a" 
         using nb\<^sub>3[OF op_in_ops] calculation(3) 
         unfolding map_le_def 
         by force
       moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" and "a \<in> \<R>\<^sub>+ \<Psi> v" 
         using is_valid_operator_sas_plus_then(1, 2) is_valid_operator_op
           v_a_in_precondition_of_op 
         unfolding is_valid_operator_sas_plus_def 
           SAS_Plus_Representation.is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff
         by auto+
       moreover have "(v, a) \<in> dom ?s'" 
         using state_to_strips_state_dom_is[OF assms(1)] s_of_v_is 
         calculation 
         by simp
       moreover have "(\<phi>\<^sub>S\<inverse> \<Psi> ?s') v = Some a" 
         using strips_state_to_state_inverse_is[OF assms(1, 2, 3)] s_of_v_is
         by argo
       \<comment> \<open> TODO slow. \<close>
       ultimately have "?s' (v, a) = Some True" 
         using strips_state_to_state_range_is[OF assms(1)] nb\<^sub>2 
         by auto
     }
     ultimately have "\<forall>(v, a) \<in> set (strips_operator.precondition_of op'). ?s' (v, a) = Some True" 
       by fast
   }
   thus ?thesis 
     unfolding are_all_operators_applicable_def is_operator_applicable_in_def 
       STRIPS_Representation.is_operator_applicable_in_def list_all_iff
     by simp
 qed
 
 (* TODO Prune premises. *)
 lemma sas_plus_equivalent_to_strips_i_a_VII:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "dom s \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
     and "\<forall>v \<in> dom s. the (s v) \<in> \<R>\<^sub>+ \<Psi> v" 
     and "set ops' \<subseteq> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "are_all_operators_applicable_in s [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops'] \<and>
     are_all_operator_effects_consistent [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']"  
   shows "STRIPS_Semantics.are_all_operator_effects_consistent ops'"
 proof - 
   let ?s' = "\<phi>\<^sub>S \<Psi> s" 
     and ?ops = "[\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']"
     and ?D = "range_of \<Psi>"
     and ?\<Pi> = "\<phi> \<Psi>"
   \<comment> \<open> TODO refactor. \<close>
   {
     fix op' 
     assume "op' \<in> set ops'" 
     moreover obtain op where "op \<in> set ?ops" and "op = \<phi>\<^sub>O\<inverse> \<Psi> op'" 
       using calculation
       by force
     moreover obtain op'' where "op'' \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = \<phi>\<^sub>O \<Psi> op''" 
       using assms(4) calculation(1) 
       by auto
     moreover have "is_valid_operator_sas_plus \<Psi> op''" 
       using is_valid_problem_sas_plus_then(2) assms(1) calculation(4)
       unfolding is_valid_operator_sas_plus_def
       by auto
     moreover have "op = op''" 
       using sas_plus_operator_inverse_is[OF assms(1)] calculation(3, 4, 5)
       by blast
     ultimately have "\<exists>op \<in> set ?ops. op \<in> set ?ops \<and> op' = (\<phi>\<^sub>O \<Psi> op)
       \<and> is_valid_operator_sas_plus \<Psi> op"
       by blast
   } note nb\<^sub>1 = this  
   {
     fix op\<^sub>1' op\<^sub>2'
     assume "op\<^sub>1' \<in> set ops'" 
       and "op\<^sub>2' \<in> set ops'" 
       and "\<exists>(v, a) \<in> set (add_effects_of op\<^sub>1'). \<exists>(v', a') \<in> set (delete_effects_of op\<^sub>2').
         (v, a) = (v', a')" 
     moreover obtain op\<^sub>1 op\<^sub>2
       where "op\<^sub>1 \<in> set ?ops" 
           and "op\<^sub>1' = \<phi>\<^sub>O \<Psi> op\<^sub>1" 
           and "is_valid_operator_sas_plus \<Psi> op\<^sub>1"
         and "op\<^sub>2 \<in> set ?ops" 
           and "op\<^sub>2' = \<phi>\<^sub>O \<Psi> op\<^sub>2" 
           and is_valid_op\<^sub>2: "is_valid_operator_sas_plus \<Psi> op\<^sub>2"
       using nb\<^sub>1 calculation(1, 2)
       by meson
     moreover obtain v v' a a' 
       where "(v, a) \<in> set (add_effects_of op\<^sub>1')" 
         and "(v', a') \<in> set (delete_effects_of op\<^sub>2')"
         and "(v, a) = (v', a')" 
       using calculation
       by blast
     moreover have "(v, a) \<in> set (effect_of op\<^sub>1)" 
       using calculation(5, 10) 
       unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
         sasp_op_to_strips_def
       by fastforce
     moreover have "v = v'" and "a = a'"
       using calculation(12) 
       by simp+
     \<comment> \<open> The next proof block shows that \<open>(v', a')\<close> is constructed from an effect \<open>(v'', a'')\<close>
       s.t. \<open>a' \<noteq> a''\<close>.  \<close>
     moreover {
       (* TODO slow. *)
       have "(v', a') \<in> (\<Union>(v'', a'') \<in> set (effect_of op\<^sub>2). 
         { (v'', a''') | a'''. a''' \<in> (\<R>\<^sub>+ \<Psi> v'') \<and>  a''' \<noteq> a'' })"
         using sasp_op_to_strips_set_delete_effects_is 
           calculation(8, 11) is_valid_op\<^sub>2 
         by blast
       then obtain v'' a'' where "(v'', a'') \<in> set (effect_of op\<^sub>2)" 
         and "(v', a') \<in> { (v'', a''') | a'''. a''' \<in> (\<R>\<^sub>+ \<Psi> v'') \<and>  a''' \<noteq> a'' }"
         by blast
       moreover have "(v', a'') \<in> set (effect_of op\<^sub>2)" 
         using calculation 
         by blast
       moreover have "a' \<in> \<R>\<^sub>+ \<Psi> v''" and "a' \<noteq> a''"
         using calculation(1, 2) 
         by fast+
       ultimately have "\<exists>a''. (v', a'') \<in> set (effect_of op\<^sub>2) \<and> a' \<in> (\<R>\<^sub>+ \<Psi> v') 
         \<and> a' \<noteq> a''" 
         by blast
     }
     moreover obtain a'' where "(v', a'') \<in> set (effect_of op\<^sub>2)" 
       and "a' \<in> \<R>\<^sub>+ \<Psi> v'"
       and "a' \<noteq> a''"
       using calculation(16) 
       by blast
     moreover have "\<exists>(v, a) \<in> set (effect_of op\<^sub>1). (\<exists>(v', a') \<in> set (effect_of op\<^sub>2). 
       v = v' \<and> a \<noteq> a')"
       using calculation(13, 14, 15, 17, 19)
       by blast
     moreover have "\<not>are_operator_effects_consistent op\<^sub>1 op\<^sub>2"
       unfolding are_operator_effects_consistent_def list_all_iff
       using calculation(20)
       by fastforce
     ultimately have "\<not>are_all_operator_effects_consistent ?ops" 
       unfolding are_all_operator_effects_consistent_def list_all_iff
       by meson
   } note nb\<^sub>2 = this
   {
     fix op\<^sub>1' op\<^sub>2'
     assume op\<^sub>1'_in_ops: "op\<^sub>1' \<in> set ops'" and op\<^sub>2'_in_ops: "op\<^sub>2' \<in> set ops'" 
     have "STRIPS_Semantics.are_operator_effects_consistent op\<^sub>1' op\<^sub>2'"
       proof (rule ccontr)
         assume "\<not>STRIPS_Semantics.are_operator_effects_consistent op\<^sub>1' op\<^sub>2'"
         then consider (A) "\<exists>(v, a) \<in> set (add_effects_of op\<^sub>1'). 
           \<exists>(v', a') \<in> set (delete_effects_of op\<^sub>2'). (v, a) = (v', a')"
           | (B) "\<exists>(v, a) \<in> set (add_effects_of op\<^sub>2'). 
           \<exists>(v', a') \<in> set (delete_effects_of op\<^sub>1'). (v, a) = (v', a')"
           unfolding STRIPS_Semantics.are_operator_effects_consistent_def list_ex_iff
           by fastforce
         thus False 
           using nb\<^sub>2[OF op\<^sub>1'_in_ops op\<^sub>2'_in_ops] nb\<^sub>2[OF op\<^sub>2'_in_ops op\<^sub>1'_in_ops] assms(5)
           by (cases, argo, force)
       qed
   }
   thus ?thesis 
     unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def 
       STRIPS_Semantics.are_operator_effects_consistent_def list_all_iff
     by blast
 qed
 
 lemma sas_plus_equivalent_to_strips_i_a_VIII:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "dom s \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
     and "\<forall>v \<in> dom s. the (s v) \<in> \<R>\<^sub>+ \<Psi> v" 
     and "set ops' \<subseteq> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "are_all_operators_applicable_in s [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops'] \<and>
     are_all_operator_effects_consistent [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']"  
   shows "STRIPS_Semantics.are_all_operators_applicable (\<phi>\<^sub>S \<Psi> s) ops' 
     \<and> STRIPS_Semantics.are_all_operator_effects_consistent ops'"
   using sas_plus_equivalent_to_strips_i_a_VI sas_plus_equivalent_to_strips_i_a_VII assms
   by fastforce
 
 (* TODO refactor. *)
 lemma sas_plus_equivalent_to_strips_i_a_IX:
   assumes "dom s \<subseteq> V"
     and "\<forall>op \<in> set ops. \<forall>(v, a) \<in> set (effect_of op). v \<in> V" 
   shows "dom (execute_parallel_operator_sas_plus s ops) \<subseteq> V"  
 proof -
   show ?thesis 
     using assms
     proof (induction ops arbitrary: s)
       case Nil 
       then show ?case
         unfolding execute_parallel_operator_sas_plus_def
         by simp 
     next
       case (Cons op ops)
       let ?s' = "s ++ map_of (effect_of op)" 
       \<comment> \<open> TODO Wrap IH instantiation in block. \<close>
       {
         have "\<forall>(v, a) \<in> set (effect_of op). v \<in> V" 
           using Cons.prems(2)
           by fastforce
         moreover have "fst ` set (effect_of op) \<subseteq> V" 
           using calculation
           by fastforce
         ultimately have "dom ?s' \<subseteq> V" 
           unfolding dom_map_add dom_map_of_conv_image_fst
           using Cons.prems(1)
           by blast
       }
       moreover have "\<forall>op \<in> set ops. \<forall>(v, a) \<in> set (effect_of op). v \<in> V"
         using Cons.prems(2)
         by fastforce
       ultimately have "dom (execute_parallel_operator_sas_plus ?s' ops) \<subseteq> V"
         using Cons.IH[of ?s']
         by fast
       thus ?case 
         unfolding execute_parallel_operator_sas_plus_cons.
     qed
 qed
 
 \<comment> \<open> NOTE Show that the domain value constraint on states is monotonous w.r.t. to valid operator 
 execution. I.e. if a parallel operator is executed on a state for which the domain value constraint 
 holds, the domain value constraint will also hold on the resultant state. \<close>
 (* TODO refactor. 
   TODO Rewrite lemma without domain function, i.e. \<open>set (the (D v)) \<leadsto> D\<close> *)
 lemma sas_plus_equivalent_to_strips_i_a_X:
   assumes "dom s \<subseteq> V"
     and "V \<subseteq> dom D"
     and "\<forall>v \<in> dom s. the (s v) \<in> set (the (D v))" 
     and "\<forall>op \<in> set ops. \<forall>(v, a) \<in> set (effect_of op). v \<in> V \<and> a \<in> set (the (D v))" 
   shows "\<forall>v \<in> dom (execute_parallel_operator_sas_plus s ops). 
     the (execute_parallel_operator_sas_plus s ops v) \<in> set (the (D v))"  
 proof -
   show ?thesis 
     using assms
     proof (induction ops arbitrary: s)
       case Nil 
       then show ?case
         unfolding execute_parallel_operator_sas_plus_def
         by simp 
     next
       case (Cons op ops)
       let ?s' = "s ++ map_of (effect_of op)" 
       {
         {
           have "\<forall>(v, a) \<in> set (effect_of op). v \<in> V" 
             using Cons.prems(4)
             by fastforce
           moreover have "fst ` set (effect_of op) \<subseteq> V" 
             using calculation
             by fastforce
           ultimately have "dom ?s' \<subseteq> V" 
             unfolding dom_map_add dom_map_of_conv_image_fst
             using Cons.prems(1)
             by blast
         }
         moreover {
           fix v
           assume v_in_dom_s': "v \<in> dom ?s'"
           hence "the (?s' v) \<in> set (the (D v))" 
             proof (cases "v \<in> dom (map_of (effect_of op))")
               case True
               moreover have "?s' v = (map_of (effect_of op)) v"
                 unfolding map_add_dom_app_simps(1)[OF True]
                 by blast
               moreover obtain a where "(map_of (effect_of op)) v = Some a" 
                 using calculation(1) 
                 by fast
               moreover have "(v, a) \<in> set (effect_of op)" 
                 using map_of_SomeD calculation(3)
                 by fast
               moreover have "a \<in> set (the (D v))"
                 using Cons.prems(4) calculation(4)
                 by fastforce
               ultimately show ?thesis
                 by force
             next
               case False
               then show ?thesis
                 unfolding map_add_dom_app_simps(3)[OF False]
                 using Cons.prems(3) v_in_dom_s'
                 by fast
             qed
         }
         moreover have "\<forall>op \<in> set ops. \<forall>(v, a) \<in> set (effect_of op). v \<in> V \<and> a \<in> set (the (D v))" 
           using Cons.prems(4)
           by auto
         ultimately have "\<forall>v \<in> dom (execute_parallel_operator_sas_plus ?s' ops).
           the (execute_parallel_operator_sas_plus ?s' ops v) \<in> set (the (D v))" 
           using Cons.IH[of "s ++ map_of (effect_of op)", OF _ Cons.prems(2)]
           by meson
       }
       thus ?case 
         unfolding execute_parallel_operator_sas_plus_cons
         by blast
     qed
 qed
 
 lemma transfom_sas_plus_problem_to_strips_problem_operators_valid:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
   obtains op 
   where "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
     and "op' = (\<phi>\<^sub>O \<Psi> op)" "is_valid_operator_sas_plus \<Psi> op" 
 proof -
   {
     obtain op where "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = \<phi>\<^sub>O \<Psi> op" 
       using assms 
       by auto
     moreover have "is_valid_operator_sas_plus \<Psi> op" 
       using is_valid_problem_sas_plus_then(2) assms(1) calculation(1)
       by auto
     ultimately have "\<exists>op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+). op' = (\<phi>\<^sub>O \<Psi> op)
       \<and> is_valid_operator_sas_plus \<Psi> op"
       by blast
   } 
   thus ?thesis 
     using that
     by blast
 qed
 
 lemma sas_plus_equivalent_to_strips_i_a_XI:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)" 
   shows "(\<phi>\<^sub>S \<Psi> s) ++ map_of (effect_to_assignments op') 
     = \<phi>\<^sub>S \<Psi> (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op')))"
 proof -
   let ?\<Pi> = "\<phi> \<Psi>" 
   let ?vs = "variables_of \<Psi>"
     and?ops = "operators_of \<Psi>" 
     and ?ops' = "strips_problem.operators_of ?\<Pi>"
   let ?s' = "\<phi>\<^sub>S \<Psi> s"                 
   let ?t = "?s' ++ map_of (effect_to_assignments op')"
     and ?t' = "\<phi>\<^sub>S \<Psi> (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op')))"
   obtain op where op'_is: "op' = (\<phi>\<^sub>O \<Psi> op)" 
     and op_in_ops: "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
     and is_valid_operator_op: "is_valid_operator_sas_plus \<Psi> op"
     using transfom_sas_plus_problem_to_strips_problem_operators_valid[OF assms]
     by auto
   have nb\<^sub>1: "(\<phi>\<^sub>O\<inverse> \<Psi> op') = op" 
     using sas_plus_operator_inverse_is[OF assms(1)] op'_is op_in_ops 
     by blast
   \<comment> \<open> TODO refactor. \<close>
   {
 
     (*have "fst ` set (effect_to_assignments op') \<equiv>
 fst ` ((\<lambda>v. (v, True)) ` set (add_effects_of op') \<union> (\<lambda>v. (v, False)) ` set (delete_effects_of op'))"
       
       by auto
     then*) have "dom (map_of (effect_to_assignments op')) 
       = set (strips_operator.add_effects_of op') \<union> set (strips_operator.delete_effects_of op')"
       unfolding dom_map_of_conv_image_fst
       by force
     \<comment> \<open> TODO slow.\<close>
     also have "\<dots> = set (effect_of op) \<union> set (strips_operator.delete_effects_of op')" 
       using op'_is 
       unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
         sasp_op_to_strips_def 
       by auto
     \<comment> \<open> TODO slow.\<close>
     finally have "dom (map_of (effect_to_assignments op')) = set (effect_of op)
       \<union> (\<Union>(v, a) \<in> set (effect_of op). { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })" 
       using sasp_op_to_strips_set_delete_effects_is[OF 
           is_valid_operator_op] op'_is
       by argo
   } note nb\<^sub>2 = this
   have nb\<^sub>3: "dom ?t = dom ?s' \<union> set (effect_of op)
     \<union> (\<Union>(v, a) \<in> set (effect_of op). { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })" 
     unfolding nb\<^sub>2 dom_map_add
     by blast
   \<comment> \<open> TODO refactor. \<close>
   have nb\<^sub>4: "dom (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))) 
     = dom s \<union> fst ` set (effect_of op)"
     unfolding dom_map_add dom_map_of_conv_image_fst nb\<^sub>1
     by fast
   {
     let ?u = "s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))"
     have "dom ?t' = (\<Union>v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> ?u v \<noteq> None }. 
       { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })" 
       using state_to_strips_state_dom_is[OF assms(1)]
       by presburger
   } note nb\<^sub>5 = this
   \<comment> \<open> TODO refactor. \<close>
   have nb\<^sub>6: "set (add_effects_of op') = set (effect_of op)"
     using op'_is 
     unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
       sasp_op_to_strips_def
     by auto
   \<comment> \<open> TODO refactor. \<close>
   have nb\<^sub>7: "set (delete_effects_of op') = (\<Union>(v, a) \<in> set (effect_of op). 
       { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })" 
     using sasp_op_to_strips_set_delete_effects_is[OF 
         is_valid_operator_op] op'_is
     by argo
   \<comment> \<open> TODO refactor. \<close>
   {
     let ?Add = "set (effect_of op)" 
     let ?Delete = "(\<Union>(v, a) \<in> set (effect_of op). 
       { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })" 
     have dom_add: "dom (map_of (map (\<lambda>v. (v, True)) (add_effects_of op'))) = ?Add" 
       unfolding dom_map_of_conv_image_fst set_map image_comp comp_apply 
       using nb\<^sub>6
       by simp
     have dom_delete: "dom (map_of (map (\<lambda>v. (v, False)) (delete_effects_of op'))) = ?Delete"
       unfolding dom_map_of_conv_image_fst set_map image_comp comp_apply 
       using nb\<^sub>7
       by auto
     {
       {
         fix v a 
         assume v_a_in_dom_add: "(v, a) \<in> dom (map_of (map (\<lambda>v. (v, True)) (add_effects_of op')))"
         have "(v, a) \<notin> dom (map_of (map (\<lambda>v. (v, False)) (delete_effects_of op')))" 
           proof (rule ccontr) 
             assume "\<not>((v, a) \<notin> dom (map_of (map (\<lambda>v. (v, False)) (delete_effects_of op'))))"
             then have "(v, a) \<in> ?Delete" and "(v, a) \<in> ?Add"
               using dom_add dom_delete v_a_in_dom_add
               by argo+   
             moreover have "\<forall>(v', a') \<in> ?Add. v \<noteq> v' \<or> a = a'"
               using is_valid_operator_sas_plus_then(6) is_valid_operator_op
                 calculation(2)
               unfolding is_valid_operator_sas_plus_def
               by fast
             ultimately show False
               by fast
           qed
       }
       hence "disjnt (dom (map_of (map (\<lambda>v. (v, True)) (add_effects_of op')))) 
         (dom (map_of (map (\<lambda>v. (v, False)) (delete_effects_of op'))))"
         unfolding disjnt_def Int_def
         using nb\<^sub>7
         by simp
     }
     hence "dom (map_of (map (\<lambda>v. (v, True)) (add_effects_of op'))) = ?Add"
       and "dom (map_of (map (\<lambda>v. (v, False)) (delete_effects_of op'))) = ?Delete"
       and "disjnt (dom (map_of (map (\<lambda>v. (v, True)) (add_effects_of op')))) 
         (dom (map_of (map (\<lambda>v. (v, False)) (delete_effects_of op'))))" 
       using dom_add dom_delete
       by blast+
   } note nb\<^sub>8 = this
   \<comment> \<open> TODO refactor. \<close>
   {
     let ?Add = "set (effect_of op)" 
     let ?Delete = "(\<Union>(v, a) \<in> set (effect_of op). 
       { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })" 
     \<comment> \<open> TODO slow.\<close>
     have "\<forall>(v, a) \<in> ?Add. map_of (effect_to_assignments op') (v, a) = Some True" 
       and "\<forall>(v, a) \<in> ?Delete. map_of (effect_to_assignments op') (v, a) = Some False"
       proof -
         {
           fix v a
           assume "(v, a) \<in> ?Add" 
           hence "map_of (effect_to_assignments op') (v, a) = Some True"
             unfolding effect_to_assignments_simp
             using  nb\<^sub>6 map_of_defined_if_constructed_from_list_of_constant_assignments[of 
                 "map (\<lambda>v. (v, True)) (add_effects_of op')" True "add_effects_of op'"]
             by force
         }
         moreover {
           fix v a
           assume "(v, a) \<in> ?Delete"
           moreover have "(v, a) \<in> dom (map_of (map (\<lambda>v. (v, False)) (delete_effects_of op')))"
             using nb\<^sub>8(2) calculation(1)
             by argo
           moreover have "(v, a) \<notin> dom (map_of (map (\<lambda>v. (v, True)) (add_effects_of op')))" 
             using nb\<^sub>8
             unfolding disjnt_def 
             using calculation(1)
             by blast
           moreover have "map_of (effect_to_assignments op') (v, a) 
             = map_of (map (\<lambda>v. (v, False)) (delete_effects_of op')) (v, a)"
             unfolding effect_to_assignments_simp map_of_append 
             using map_add_dom_app_simps(3)[OF calculation(3)]
             by presburger 
           \<comment> \<open> TODO slow. \<close>
           ultimately have "map_of (effect_to_assignments op') (v, a) = Some False"
             using map_of_defined_if_constructed_from_list_of_constant_assignments[
                 of "map (\<lambda>v. (v, False)) (delete_effects_of op')" False "delete_effects_of op'"]
                nb\<^sub>7
             by auto
         }
         ultimately show "\<forall>(v, a) \<in> ?Add. map_of (effect_to_assignments op') (v, a) = Some True" 
           and "\<forall>(v, a) \<in> ?Delete. map_of (effect_to_assignments op') (v, a) = Some False" 
           by blast+
       qed
   } note nb\<^sub>9 = this
   {
     fix v a
     assume "(v, a) \<in> set (effect_of op)"
     moreover have "\<forall>(v, a) \<in> set (effect_of op). \<forall>(v', a') \<in> set (effect_of op). v \<noteq> v' \<or> a = a'"
       using is_valid_operator_sas_plus_then is_valid_operator_op
       unfolding is_valid_operator_sas_plus_def
       by fast
     ultimately have "map_of (effect_of op) v = Some a" 
       using map_of_constant_assignments_defined_if[of "effect_of op"]
       by presburger
   } note nb\<^sub>1\<^sub>0 = this
   {
     fix v a
     assume v_a_in_effect_of_op: "(v, a) \<in> set (effect_of op)"
       and "(s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))) v \<noteq> None"
     moreover have "v \<in> set ?vs"
         using is_valid_operator_op is_valid_operator_sas_plus_then(3) calculation(1)
         by fastforce 
     moreover {
       have "is_valid_problem_strips ?\<Pi>"
         using is_valid_problem_sas_plus_then_strips_transformation_too 
           assms(1) 
         by blast
       thm calculation(1) nb\<^sub>6 assms(2)
       moreover have "set (add_effects_of op') \<subseteq> set ((?\<Pi>)\<^sub>\<V>)" 
         using assms(2) is_valid_problem_strips_operator_variable_sets(2)
           calculation 
         by blast
       moreover have "(v, a) \<in> set ((?\<Pi>)\<^sub>\<V>)"
         using v_a_in_effect_of_op nb\<^sub>6 calculation(2) 
         by blast
       ultimately have "a \<in> \<R>\<^sub>+ \<Psi> v"
         using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF 
             assms(1)]
         by fast
     }
     \<comment> \<open> TODO slow. \<close>
     ultimately have "(v, a) \<in> dom (\<phi>\<^sub>S \<Psi> (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))))"  
       using state_to_strips_state_dom_is[OF assms(1), of 
           "s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))"]
       by simp
   } note nb\<^sub>1\<^sub>1 = this
   {
     fix v a
     assume "(v, a) \<in> set (effect_of op)"
     moreover have "v \<in> dom (map_of (effect_of op))" 
       unfolding dom_map_of_conv_image_fst 
       using calculation
       by force 
     moreover have "(s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))) v = Some a" 
       unfolding map_add_dom_app_simps(1)[OF calculation(2)] nb\<^sub>1
       using nb\<^sub>1\<^sub>0 calculation(1)
       by blast
     moreover have "(s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))) v \<noteq> None" 
       using calculation(3)
       by auto
     moreover have "(v, a) \<in> dom (\<phi>\<^sub>S \<Psi> (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))))"
       using nb\<^sub>1\<^sub>1 calculation(1, 4)
       by presburger
     ultimately have "(\<phi>\<^sub>S \<Psi> (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op')))) (v, a) = Some True" 
       using state_to_strips_state_range_is[OF assms(1)]
       by simp
   } note nb\<^sub>1\<^sub>2 = this
   {
     fix v a'
     assume "(v, a') \<in> dom (map_of (effect_to_assignments op'))"   
       and "(v, a') \<in>  (\<Union>(v, a) \<in> set (effect_of op).
         { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })"
     moreover have "v \<in> dom (map_of (effect_of op))" 
       unfolding dom_map_of_conv_image_fst 
       using calculation(2)
       by force
     moreover have "v \<in> set ?vs"
       using calculation(3) is_valid_operator_sas_plus_then(3) is_valid_operator_op
       unfolding dom_map_of_conv_image_fst is_valid_operator_sas_plus_def
       by fastforce
     moreover obtain a where "(v, a) \<in> set (effect_of op)" 
       and "a' \<in> \<R>\<^sub>+ \<Psi> v" 
       and "a' \<noteq> a" 
       using calculation(2)
       by blast
     moreover have "(s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))) v = Some a" 
       unfolding map_add_dom_app_simps(1)[OF calculation(3)] nb\<^sub>1
       using nb\<^sub>1\<^sub>0 calculation(5)
       by blast
     moreover have "(s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))) v \<noteq> None" 
       using calculation(8) 
       by auto
     \<comment> \<open> TODO slow. \<close>
     moreover have "(v, a') \<in> dom (\<phi>\<^sub>S \<Psi> (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))))"
       using state_to_strips_state_dom_is[OF assms(1), of 
         "s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))"] calculation(4, 6, 9)
       by simp
     \<comment> \<open> TODO slow. \<close>
     ultimately have "(\<phi>\<^sub>S \<Psi> (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op')))) (v, a') = Some False" 
       using state_to_strips_state_range_is[OF assms(1), 
           of v a' "s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))"]
       by simp
   } note nb\<^sub>1\<^sub>3 = this
   {
     fix v a
     assume "(v, a) \<in> dom ?t" 
       and "(v, a) \<notin> dom (map_of (effect_to_assignments op'))"
     moreover have "(v, a) \<in> dom ?s'" 
       using calculation(1, 2)
       unfolding dom_map_add
       by blast
     moreover have "?t (v, a) = ?s' (v, a)" 
       unfolding map_add_dom_app_simps(3)[OF calculation(2)]..
     ultimately have "?t (v, a) = Some (the (s v) = a)"
       using state_to_strips_state_range_is[OF assms(1)] 
       by presburger
   } note nb\<^sub>1\<^sub>4 = this
   {
     fix v a
     assume "(v, a) \<in> dom ?t" 
       and v_a_not_in: "(v, a) \<notin> dom (map_of (effect_to_assignments op'))"
     moreover have "(v, a) \<in> dom ?s'" 
       using calculation(1, 2)
       unfolding dom_map_add
       by blast
     moreover have "(v, a) \<in> (\<Union> v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }.
       { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })"
       using state_to_strips_state_dom_is[OF assms(1)] calculation(3)
       by presburger
     moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" and "s v \<noteq> None" and "a \<in> \<R>\<^sub>+ \<Psi> v" 
       using calculation(4)
       by blast+
     \<comment> \<open> NOTE Hasn't this been proved before? \<close>
     moreover {
       have "dom (map_of (effect_to_assignments op')) = (\<Union>(v, a) \<in> set (effect_of op). { (v, a) }) 
         \<union> (\<Union>(v, a) \<in> set (effect_of op). 
           { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })"
         unfolding nb\<^sub>2
         by blast
       also have "\<dots> = (\<Union>(v, a) \<in> set (effect_of op). { (v, a) } 
           \<union> { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })" 
         by blast
       finally have "dom (map_of (effect_to_assignments op')) 
         = (\<Union>(v, a) \<in> set (effect_of op). { (v, a) } 
           \<union> { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })"
         by auto
       then have "(v, a) \<notin> (\<Union>(v, a) \<in> set (effect_of op). 
         { (v, a) | a. a \<in> \<R>\<^sub>+ \<Psi> v })" 
         using v_a_not_in
         by blast
     }
     \<comment> \<open> TODO slow. \<close>
     moreover have "v \<notin> dom (map_of (effect_of op))" 
       using dom_map_of_conv_image_fst calculation 
       by fastforce
     moreover have "(s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))) v = s v" 
       unfolding nb\<^sub>1 map_add_dom_app_simps(3)[OF calculation(9)]
       by simp
     \<comment> \<open> TODO slow. \<close>
     moreover have "(v, a) \<in> dom ?t'" 
       using state_to_strips_state_dom_is[OF assms(1), of 
         "s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))"] calculation(5, 6, 7, 8, 10)
       by simp
     ultimately have "?t' (v, a) = Some (the (s v) = a)" 
       using state_to_strips_state_range_is[OF assms(1)]
       by presburger
   } note nb\<^sub>1\<^sub>5 = this
   \<comment> \<open> TODO refactor. \<close>
   have nb\<^sub>1\<^sub>6: "dom ?t = (\<Union> v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None }. 
       { (v, a) | a. a \<in> (\<R>\<^sub>+ \<Psi> v) }) 
     \<union> set (effect_of op) 
     \<union> (\<Union>(v, a)\<in>set (effect_of op).
       {(v, a') |a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a})"
     unfolding dom_map_add nb\<^sub>2
     using state_to_strips_state_dom_is[OF assms(1), of s]
     by auto
   {
     {
       fix v a
       assume "(v, a) \<in> dom ?t"
       then consider (A) "(v, a) \<in> dom (\<phi>\<^sub>S \<Psi> s)" 
         | (B) "(v, a) \<in> dom (map_of (effect_to_assignments op'))" 
         by fast
       hence "(v, a) \<in> dom ?t'" 
         proof (cases)
           case A
           then have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" and "s v \<noteq> None" and "a \<in> \<R>\<^sub>+ \<Psi> v"
             unfolding state_to_strips_state_dom_element_iff[OF assms(1)]
             by blast+
           thm map_add_None state_to_strips_state_dom_element_iff[OF assms(1)]
           moreover have "(s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))) v \<noteq> None" 
             using calculation(2)
             by simp
           ultimately show ?thesis 
             unfolding state_to_strips_state_dom_element_iff[OF assms(1)]
             by blast
         next
           case B
           then have "(v, a) \<in> 
               set (effect_of op) 
               \<union> (\<Union>(v, a)\<in>set (effect_of op). { (v, a') | a'. a' \<in> \<R>\<^sub>+ \<Psi> v \<and> a' \<noteq> a })" 
             unfolding nb\<^sub>2
             by blast
           then consider (B\<^sub>1) "(v, a) \<in> set (effect_of op)" 
             | (B\<^sub>2) "(v, a) \<in> (\<Union>(v, a)\<in>set (effect_of op). 
             { (v, a') | a'. a' \<in> \<R>\<^sub>+ \<Psi> v \<and> a' \<noteq> a })"
             by blast
           thm nb\<^sub>1\<^sub>2 nb\<^sub>1\<^sub>3 nb\<^sub>2
           thus ?thesis
             proof (cases)
               case B\<^sub>1
               then show ?thesis
                 using nb\<^sub>1\<^sub>2
                 by fast
             next
               case B\<^sub>2
               then show ?thesis
                 using nb\<^sub>1\<^sub>3 B
                 by blast
             qed 
         qed 
     } 
     moreover {
       let ?u = "s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))"
       fix v a
       assume v_a_in_dom_t': "(v, a) \<in> dom ?t'"
       thm nb\<^sub>5
       then have v_in_vs: "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
         and u_of_v_is_not_None: "?u v \<noteq> None" 
         and a_in_range_of_v: "a \<in> \<R>\<^sub>+ \<Psi> v" 
         using state_to_strips_state_dom_element_iff[OF assms(1)]
           v_a_in_dom_t'
         by meson+
       {
         assume "(v, a) \<notin> dom ?t" 
         then have contradiction: "(v, a) \<notin> 
           (\<Union>v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None}. { (v, a) |a. a \<in> \<R>\<^sub>+ \<Psi> v }) 
           \<union> set (effect_of op) 
           \<union> (\<Union>(v, a)\<in>set (effect_of op). {(v, a') |a'. a' \<in> \<R>\<^sub>+ \<Psi> v \<and> a' \<noteq> a})" 
           unfolding nb\<^sub>1\<^sub>6
           by fast
         hence False 
           proof (cases "map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op')) v = None")
             case True
             then have "s v \<noteq> None" 
               using u_of_v_is_not_None
               by simp
             then have "(v, a) \<in> (\<Union>v \<in> { v | v. v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> s v \<noteq> None}. 
               { (v, a) |a. a \<in> \<R>\<^sub>+ \<Psi> v })" 
               using v_in_vs a_in_range_of_v 
               by blast
             thus ?thesis 
               using contradiction
               by blast
           next
             case False
             then have "v \<in> dom (map_of (effect_of op))" 
               using u_of_v_is_not_None nb\<^sub>1 
               by blast
             then obtain a' where map_of_effect_of_op_v_is: "map_of (effect_of op) v = Some a'" 
               by blast
             then have v_a'_in: "(v, a') \<in> set (effect_of op)" 
               using map_of_SomeD 
               by fast
             then show ?thesis
               proof (cases "a = a'")
                 case True
                 then have "(v, a) \<in> set (effect_of op)" 
                   using v_a'_in
                   by blast
                 then show ?thesis 
                   using contradiction
                   by blast
               next
                 case False
                 then have "(v, a) \<in> (\<Union>(v, a)\<in>set (effect_of op). 
                   {(v, a') |a'. a' \<in> \<R>\<^sub>+ \<Psi> v \<and> a' \<noteq> a})" 
                   using v_a'_in calculation a_in_range_of_v
                   by blast
                 thus ?thesis
                   using contradiction
                   by fast
               qed
           qed
       }
       hence "(v, a) \<in> dom ?t"
         by argo
     }
     moreover have "dom ?t \<subseteq> dom ?t'" and "dom ?t' \<subseteq> dom ?t" 
       subgoal 
         using calculation(1) subrelI[of "dom ?t" "dom ?t'"]
         by fast
       subgoal
         using calculation(2) subrelI[of "dom ?t'" "dom ?t"]
         by argo
       done
     ultimately have "dom ?t = dom ?t'"
       by force
   } note nb\<^sub>1\<^sub>7 = this
   {
     fix v a
     assume v_a_in_dom_t: "(v, a) \<in> dom ?t" 
     hence "?t (v, a) = ?t' (v, a)"
       proof (cases "(v, a) \<in> dom (map_of (effect_to_assignments op'))")
         case True
         \<comment> \<open> TODO slow. \<close>
         \<comment> \<open> NOTE Split on the (disjunct) domain variable sets of 
           @{text "map_of (effect_to_assignments op')"}. \<close> 
         then consider (A1) "(v, a) \<in> set (effect_of op)" 
           | (A2) "(v, a) \<in> (\<Union>(v, a) \<in> set (effect_of op).
             { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and> a' \<noteq> a })"
           using nb\<^sub>2
           by fastforce
         then show ?thesis 
           proof (cases)
             case A1
             then have "?t (v, a) = Some True" 
               unfolding map_add_dom_app_simps(1)[OF True]
               using nb\<^sub>9(1)
               by fast
             moreover have "?t' (v, a) = Some True"
               using nb\<^sub>1\<^sub>2[OF A1].
             ultimately show ?thesis..
           next
             case A2
             then have "?t (v, a) = Some False" 
               unfolding map_add_dom_app_simps(1)[OF True]
               using nb\<^sub>9(2)
               by blast
             moreover have "?t' (v, a) = Some False"
               using nb\<^sub>1\<^sub>3[OF True A2].
             ultimately show ?thesis..
           qed
       next
         case False
         moreover have "?t (v, a) = Some (the (s v) = a)" 
           using nb\<^sub>1\<^sub>4[OF v_a_in_dom_t False].
         moreover have "?t' (v, a) = Some (the (s v) = a)" 
           using nb\<^sub>1\<^sub>5[OF v_a_in_dom_t False].
         ultimately show ?thesis 
           by argo
       qed
   } note nb\<^sub>1\<^sub>8 = this
   moreover {
     fix v a
     assume "(v, a) \<in> dom ?t'" 
     hence "?t (v, a) = ?t' (v, a)" 
       using nb\<^sub>1\<^sub>7 nb\<^sub>1\<^sub>8
       by presburger
   }
   \<comment> \<open> TODO slow.\<close>
   ultimately have "?t \<subseteq>\<^sub>m ?t'" and "?t' \<subseteq>\<^sub>m ?t" 
     unfolding map_le_def 
     by fastforce+
   thus ?thesis
     using map_le_antisym[of ?t ?t'] 
     by fast
 qed
 
 \<comment> \<open> NOTE This is the essential step in the SAS+/STRIPS equivalence theorem. We show that executing
 a given parallel STRIPS operator @{text "ops'"} on the corresponding STRIPS state 
 @{text "s' = \<phi>\<^sub>S \<Psi> s"} yields the same state as executing the transformed SAS+ parallel operator
 @{text "ops = [\<phi>\<^sub>O\<inverse> (\<phi> \<Psi>) op'. op' \<leftarrow> ops']"} on the original SAS+ state @{text "s"} and the 
 transforming the resultant SAS+ state to its corresponding STRIPS state. \<close>
 (* TODO refactor. *)
 lemma sas_plus_equivalent_to_strips_i_a_XII:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "\<forall>op' \<in> set ops'. op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)" 
   shows "execute_parallel_operator (\<phi>\<^sub>S \<Psi> s) ops' 
     = \<phi>\<^sub>S \<Psi> (execute_parallel_operator_sas_plus s [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops'])" 
 using assms
 proof (induction ops' arbitrary: s)
   case Nil
   then show ?case 
     unfolding execute_parallel_operator_def execute_parallel_operator_sas_plus_def 
     by simp
 next
   case (Cons op' ops')
   let ?\<Pi> = "\<phi> \<Psi>"
   let ?t' = "(\<phi>\<^sub>S \<Psi> s) ++ map_of (effect_to_assignments op')"
     and ?t = "s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> op'))"
   have nb\<^sub>1: "?t' = \<phi>\<^sub>S \<Psi> ?t" 
     using sas_plus_equivalent_to_strips_i_a_XI[OF assms(1)] Cons.prems(2)
     by force
   {
     have "\<forall>op' \<in> set ops'. op' \<in> set (strips_problem.operators_of ?\<Pi>)" 
       using Cons.prems(2) 
       by simp
     then have "execute_parallel_operator (\<phi>\<^sub>S \<Psi> ?t) ops' 
       = \<phi>\<^sub>S \<Psi> (execute_parallel_operator_sas_plus ?t [\<phi>\<^sub>O\<inverse> \<Psi> x. x \<leftarrow> ops'])"
       using Cons.IH[OF Cons.prems(1), of ?t]
       by fastforce
     hence "execute_parallel_operator ?t' ops'
       = \<phi>\<^sub>S \<Psi> (execute_parallel_operator_sas_plus ?t [\<phi>\<^sub>O\<inverse> \<Psi> x. x \<leftarrow> ops'])" 
       using nb\<^sub>1
       by argo
   }
   thus ?case 
     by simp
 qed
 
 lemma sas_plus_equivalent_to_strips_i_a_XIII: 
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "\<forall>op' \<in> set ops'. op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "(\<phi>\<^sub>S \<Psi> G) \<subseteq>\<^sub>m execute_parallel_plan 
       (execute_parallel_operator (\<phi>\<^sub>S \<Psi> I) ops') \<pi>"
   shows "(\<phi>\<^sub>S \<Psi> G) \<subseteq>\<^sub>m execute_parallel_plan 
     (\<phi>\<^sub>S \<Psi> (execute_parallel_operator_sas_plus I [\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops'])) \<pi>"
 proof -
   let ?I' = "(\<phi>\<^sub>S \<Psi> I)"
     and ?G' = "\<phi>\<^sub>S \<Psi> G" 
     and ?ops = "[\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']" 
     and ?\<Pi> = "\<phi> \<Psi>"
   let ?J = "execute_parallel_operator_sas_plus I ?ops"
   {
     fix v a
     assume "(v, a) \<in> dom ?G'"
     then have "?G' (v, a) = execute_parallel_plan 
       (execute_parallel_operator ?I' ops') \<pi> (v, a)"
       using assms(3) 
       unfolding map_le_def
       by auto
     hence "?G' (v, a) = execute_parallel_plan (\<phi>\<^sub>S \<Psi> ?J) \<pi> (v, a)" 
       using sas_plus_equivalent_to_strips_i_a_XII[OF assms(1, 2)]
       by simp
   }
   thus ?thesis 
     unfolding map_le_def
     by fast
 qed
 
 \<comment> \<open> NOTE This is a more abstract formulation of the proposition in 
 \<open>sas_plus_equivalent_to_strips_i\<close> which is better suited for induction proofs. We essentially claim 
 that given a plan the execution in STRIPS semantics of which solves the problem of reaching a 
 transformed goal state \<open>\<phi>\<^sub>S \<Psi> G\<close> from a transformed initial state \<open>\<phi>\<^sub>S \<Psi> I\<close>---such as 
 the goal and initial state of an induced STRIPS problem for a SAS+ problem---is equivalent to an
 execution in SAS+ semantics of the transformed plan \<open>\<phi>\<^sub>P\<inverse> (\<phi> \<Psi>) \<pi>\<close> w.r.t to the original 
 initial state \<open>I\<close> and original goal state \<open>G\<close>. \<close> 
 lemma sas_plus_equivalent_to_strips_i_a:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "dom I \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
     and "\<forall>v \<in> dom I. the (I v) \<in> \<R>\<^sub>+ \<Psi> v" 
     and "dom G \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
     and "\<forall>v \<in> dom G. the (G v) \<in> \<R>\<^sub>+ \<Psi> v" 
     and "\<forall>ops' \<in> set \<pi>. \<forall>op' \<in> set ops'. op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "(\<phi>\<^sub>S \<Psi> G) \<subseteq>\<^sub>m execute_parallel_plan (\<phi>\<^sub>S \<Psi> I) \<pi>"
   shows "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I (\<phi>\<^sub>P\<inverse> \<Psi> \<pi>)"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?\<psi> = "\<phi>\<^sub>P\<inverse> \<Psi> \<pi>"
   show ?thesis 
     using assms
     proof (induction \<pi> arbitrary: I)
       case Nil
       then have "(\<phi>\<^sub>S \<Psi> G) \<subseteq>\<^sub>m (\<phi>\<^sub>S \<Psi> I)" 
         by fastforce
       then have "G \<subseteq>\<^sub>m I" 
         using state_to_strips_state_map_le_iff[OF assms(1, 4, 5)]
         by blast
       thus ?case 
         unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
           strips_parallel_plan_to_sas_plus_parallel_plan_def 
         by fastforce
     next
       case (Cons ops' \<pi>)
       let ?D = "range_of \<Psi>"
         and ?\<Pi> = "\<phi> \<Psi>" 
         and ?I' = "\<phi>\<^sub>S \<Psi> I"
         and ?G' = "\<phi>\<^sub>S \<Psi> G"
       let ?ops = "[\<phi>\<^sub>O\<inverse> \<Psi> op'. op' \<leftarrow> ops']" 
       let ?J = "execute_parallel_operator_sas_plus I ?ops"
         and ?J' = "execute_parallel_operator ?I' ops'" 
       have nb\<^sub>1: "set ops' \<subseteq> set ((?\<Pi>)\<^sub>\<O>)" 
         using Cons.prems(6)
         unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def list_all_iff ListMem_iff
         by fastforce
       {
         fix op 
         assume "op \<in> set ?ops" 
         moreover obtain op' where "op' \<in> set ops'" and "op = \<phi>\<^sub>O\<inverse> \<Psi> op'" 
           using calculation 
           by auto
         moreover have "op' \<in> set ((?\<Pi>)\<^sub>\<O>)"
           using nb\<^sub>1 calculation(2)
           by blast
         moreover obtain op'' where "op'' \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = \<phi>\<^sub>O \<Psi> op''" 
           using calculation(4) 
           by auto
         moreover have "op = op''" 
           using sas_plus_operator_inverse_is[OF assms(1) calculation(5)] calculation(3, 6) 
           by presburger
         ultimately have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+) \<and> (\<exists>op' \<in> set ops'. op' = \<phi>\<^sub>O \<Psi> op)" 
           by blast
       } note nb\<^sub>2 = this
       {
         fix op v a
         assume "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "(v, a) \<in> set (effect_of op)" 
         moreover have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
           using nb\<^sub>2 calculation(1)
           by blast
         moreover have "is_valid_operator_sas_plus \<Psi> op"
           using is_valid_problem_sas_plus_then(2) Cons.prems(1) calculation(3) 
           by blast
         ultimately have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
           using is_valid_operator_sas_plus_then(3) 
           by fastforce
       } note nb\<^sub>3 = this
       {
         fix op
         assume "op \<in> set ?ops" 
         then have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
           using nb\<^sub>2 
           by blast
         then have "is_valid_operator_sas_plus \<Psi> op"
           using is_valid_problem_sas_plus_then(2) Cons.prems(1)
           by blast
         hence "\<forall>(v, a) \<in> set (effect_of op). v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) 
           \<and> a \<in> \<R>\<^sub>+ \<Psi> v"
           using is_valid_operator_sas_plus_then(3,4) 
           by fast
       } note nb\<^sub>4 = this
       show ?case 
         proof (cases "STRIPS_Semantics.are_all_operators_applicable ?I' ops' 
           \<and> STRIPS_Semantics.are_all_operator_effects_consistent ops'")
           case True
           {
             {
               have "dom I \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
                 using Cons.prems(2)
                 by blast
               hence "(\<phi>\<^sub>S\<inverse> \<Psi> ?I') = I"
                 using strips_state_to_state_inverse_is[OF 
                     Cons.prems(1) _ Cons.prems(3)]
                 by argo
             }
             then have "are_all_operators_applicable_in I ?ops
               \<and> are_all_operator_effects_consistent ?ops" 
               using sas_plus_equivalent_to_strips_i_a_IV[OF assms(1) nb\<^sub>1, of I] True
               by simp
             moreover have "(\<phi>\<^sub>P\<inverse> \<Psi> (ops' # \<pi>)) = ?ops # (\<phi>\<^sub>P\<inverse> \<Psi> \<pi>)" 
               unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
                 strips_parallel_plan_to_sas_plus_parallel_plan_def
                 SAS_Plus_STRIPS.strips_op_to_sasp_def
                   strips_op_to_sasp_def  
               by simp
             ultimately have "execute_parallel_plan_sas_plus I (\<phi>\<^sub>P\<inverse> \<Psi> (ops' # \<pi>)) 
               = execute_parallel_plan_sas_plus ?J (\<phi>\<^sub>P\<inverse> \<Psi> \<pi>)" 
               by force
           } note nb\<^sub>5 = this
           \<comment> \<open> Show the goal using the IH. \<close>
           {
             have dom_J_subset_eq_vs: "dom ?J \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
               using sas_plus_equivalent_to_strips_i_a_IX[OF Cons.prems(2)] nb\<^sub>2 nb\<^sub>4
               by blast
             moreover {
               have "set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<subseteq> dom (range_of \<Psi>)"
                 using is_valid_problem_sas_plus_then(1)[OF assms(1)]
                 by fastforce
               moreover have "\<forall>v \<in> dom I. the (I v) \<in> set (the (range_of \<Psi> v))"
                 using Cons.prems(2, 3) assms(1) set_the_range_of_is_range_of_sas_plus_if 
                 by force
               moreover have "\<forall>op \<in> set ?ops. \<forall>(v, a) \<in> set (effect_of op).
                 v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+) \<and> a \<in> set (the (?D v))" 
                 using set_the_range_of_is_range_of_sas_plus_if assms(1) nb\<^sub>4 
                 by fastforce
               moreover have v_in_dom_J_range: "\<forall>v \<in> dom ?J. the (?J v) \<in> set (the (?D v))" 
                 using sas_plus_equivalent_to_strips_i_a_X[of 
                     I "set ((\<Psi>)\<^sub>\<V>\<^sub>+)" ?D ?ops, OF Cons.prems(2)] calculation(1, 2, 3)
                 by fastforce
               {
                 fix v 
                 assume "v \<in> dom ?J"
                 moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
                   using nb\<^sub>2 calculation dom_J_subset_eq_vs 
                   by blast
                 moreover have "set (the (range_of \<Psi> v)) = \<R>\<^sub>+ \<Psi> v" 
                   using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)] 
                     calculation(2)
                   by presburger
                 ultimately have "the (?J v) \<in> \<R>\<^sub>+ \<Psi> v" 
                   using nb\<^sub>3 v_in_dom_J_range
                   by blast
               }
               ultimately have "\<forall>v \<in> dom ?J. the (?J v) \<in> \<R>\<^sub>+ \<Psi> v"
                 by fast
             }
             moreover have "\<forall>ops' \<in> set \<pi>. \<forall>op'\<in>set ops'. op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
               using Cons.prems(6)
               by simp
             moreover {
               have "?G' \<subseteq>\<^sub>m execute_parallel_plan ?J' \<pi>" 
                 using Cons.prems(7) True
                 by auto
               hence "(\<phi>\<^sub>S \<Psi> G) \<subseteq>\<^sub>m execute_parallel_plan (\<phi>\<^sub>S \<Psi> ?J) \<pi>"
                 using sas_plus_equivalent_to_strips_i_a_XIII[OF Cons.prems(1)] nb\<^sub>1
                 by blast
             }
             ultimately have "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I (\<phi>\<^sub>P\<inverse> \<Psi> (ops' # \<pi>))"
               using Cons.IH[of ?J, OF Cons.prems(1) _ _ Cons.prems(4, 5)] Cons.prems(6) nb\<^sub>5 
               by presburger
           }
           thus ?thesis.
         next
           case False
           then have "?G' \<subseteq>\<^sub>m ?I'" 
             using Cons.prems(7)
             by force
           moreover {
             have "dom I \<subseteq> set ?vs" 
               using Cons.prems(2)
               by simp
             hence "\<not>(are_all_operators_applicable_in I ?ops
               \<and> are_all_operator_effects_consistent ?ops)" 
               using sas_plus_equivalent_to_strips_i_a_VIII[OF Cons.prems(1) _ Cons.prems(3) nb\<^sub>1] 
                 False
               by force
           }
           moreover {
             have "(\<phi>\<^sub>P\<inverse> \<Psi> (ops' # \<pi>)) = ?ops # (\<phi>\<^sub>P\<inverse> \<Psi> \<pi>)" 
               unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
                 strips_parallel_plan_to_sas_plus_parallel_plan_def
                 SAS_Plus_STRIPS.strips_op_to_sasp_def
                 strips_op_to_sasp_def
               by simp
             hence "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I (?ops # (\<phi>\<^sub>P\<inverse> \<Psi> \<pi>))
               \<longleftrightarrow> G \<subseteq>\<^sub>m I" 
               using calculation(2)
               by force
           }
           ultimately show ?thesis 
             using state_to_strips_state_map_le_iff[OF Cons.prems(1, 4, 5)] 
             unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
               strips_parallel_plan_to_sas_plus_parallel_plan_def
               SAS_Plus_STRIPS.strips_op_to_sasp_def
               strips_op_to_sasp_def
             by force
         qed
     qed
 qed
 
 \<comment> \<open> NOTE Show that a solution for the induced STRIPS problem for the given valid SAS+ problem, 
   corresponds to a solution for the given SAS+ problem.
 
 Note that in the context of the SAS+ problem solving pipeline, we
 \begin{enumerate}
   \item convert the given valid SAS+ @{text "\<Psi>"} problem to the corresponding STRIPS problem 
 @{text "\<Pi>"} (this is implicitely also valid by lemma 
 @{text "is_valid_problem_sas_plus_then_strips_transformation_too"}); then,
   \item get a solution @{text "\<pi>"}---if it exists---for the induced STRIPS problem by executing 
 SATPlan; and finally,
   \item convert @{text "\<pi>"} back to a solution @{text "\<psi>"} for the SAS+ problem.
 \end{enumerate} \<close>
 lemma sas_plus_equivalent_to_strips_i:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "STRIPS_Semantics.is_parallel_solution_for_problem 
     (\<phi> \<Psi>) \<pi>"
   shows "goal_of \<Psi> \<subseteq>\<^sub>m execute_parallel_plan_sas_plus 
     (sas_plus_problem.initial_of \<Psi>) (\<phi>\<^sub>P\<inverse> \<Psi> \<pi>)"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?I = "initial_of \<Psi>" 
     and ?G = "goal_of \<Psi>"
   let ?\<Pi> = "\<phi> \<Psi>"
   let ?G' = "strips_problem.goal_of ?\<Pi>"
     and ?I' = "strips_problem.initial_of ?\<Pi>"
   let ?\<psi> = "\<phi>\<^sub>P\<inverse> \<Psi> \<pi>"
   have "dom ?I \<subseteq> set ?vs" 
     using is_valid_problem_sas_plus_then(3) assms(1)
     by auto
   moreover have "\<forall>v \<in> dom ?I. the (?I v) \<in> \<R>\<^sub>+ \<Psi> v" 
     using is_valid_problem_sas_plus_then(4) assms(1) calculation
     by auto
   moreover have "dom ?G \<subseteq> set ?vs"  and "\<forall>v \<in> dom ?G. the (?G v) \<in> \<R>\<^sub>+ \<Psi> v" 
     using is_valid_problem_sas_plus_then(5, 6) assms(1)
     by blast+
   moreover have "\<forall>ops'\<in>set \<pi>. \<forall>op'\<in>set ops'. op' \<in> set ((?\<Pi>)\<^sub>\<O>)"
     using is_parallel_solution_for_problem_operator_set[OF assms(2)]
     by simp
   moreover {
     have "?G' \<subseteq>\<^sub>m execute_parallel_plan ?I' \<pi>"
       using assms(2) 
       unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def..
     moreover have "?G' = \<phi>\<^sub>S \<Psi> ?G" and "?I' = \<phi>\<^sub>S \<Psi> ?I" 
       by simp+
     ultimately have "(\<phi>\<^sub>S \<Psi> ?G) \<subseteq>\<^sub>m execute_parallel_plan (\<phi>\<^sub>S \<Psi> ?I) \<pi>"
       by simp
   }
   ultimately show ?thesis 
     using sas_plus_equivalent_to_strips_i_a[OF assms(1)]
     by simp
 qed
 
 \<comment> \<open> NOTE Show that the operators for a given solution @{text "\<pi>"} to the induced STRIPS problem 
 for a given SAS+ problem correspond to operators of the SAS+ problem. \<close>
 lemma sas_plus_equivalent_to_strips_ii:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "STRIPS_Semantics.is_parallel_solution_for_problem (\<phi> \<Psi>) \<pi>"
   shows "list_all (list_all (\<lambda>op. ListMem op (operators_of \<Psi>))) (\<phi>\<^sub>P\<inverse> \<Psi> \<pi>)" 
 proof -
   let ?\<Pi> = "\<phi> \<Psi>" 
   let ?ops = "operators_of \<Psi>" 
     and ?\<psi> = "\<phi>\<^sub>P\<inverse> \<Psi> \<pi>"
   have "is_valid_problem_strips ?\<Pi>" 
     using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)]
     by simp 
   have nb\<^sub>1: "\<forall>op' \<in> set ((?\<Pi>)\<^sub>\<O>). (\<exists>op \<in> set ?ops. op' = (\<phi>\<^sub>O \<Psi> op))"  
     by auto
   {
     fix ops' op' op
     assume "ops' \<in> set \<pi>" and "op' \<in> set ops'" 
     then have "op' \<in> set (strips_problem.operators_of ?\<Pi>)"
       using is_parallel_solution_for_problem_operator_set[OF assms(2)]
       by simp
     then obtain op where "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" and "op' = (\<phi>\<^sub>O \<Psi> op)" 
       by auto
     then have "(\<phi>\<^sub>O\<inverse> \<Psi> op') \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
       using sas_plus_operator_inverse_is[OF assms(1)]
       by presburger
   }
   thus ?thesis 
     unfolding list_all_iff ListMem_iff 
       strips_parallel_plan_to_sas_plus_parallel_plan_def
       SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
       SAS_Plus_STRIPS.strips_op_to_sasp_def
       strips_op_to_sasp_def
     by auto
 qed
 
 text \<open> We now show that for a parallel solution \<^term>\<open>\<pi>\<close> of \<^term>\<open>\<Pi>\<close> the SAS+ plan 
 \<^term>\<open>\<psi> \<equiv> \<phi>\<^sub>P\<inverse> \<Psi> \<pi>\<close> yielded by the STRIPS to SAS+ plan transformation is a solution for 
 \<^term>\<open>\<Psi>\<close>. The proof uses the definition of parallel STRIPS solutions and shows that the 
 execution of \<^term>\<open>\<psi>\<close> on the initial state of the SAS+ problem yields a state satisfying the 
 problem's goal state, i.e.
   @{text[display, indent=4]"G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I \<psi>"}
 and by showing that all operators in all parallel operators of \<^term>\<open>\<psi>\<close> are operators of the 
 problem. \<close>
 
 theorem
   sas_plus_equivalent_to_strips:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "STRIPS_Semantics.is_parallel_solution_for_problem (\<phi> \<Psi>) \<pi>" 
   shows "is_parallel_solution_for_problem \<Psi> (\<phi>\<^sub>P\<inverse> \<Psi> \<pi>)"
 proof -
   let ?I = "initial_of \<Psi>"
     and ?G = "goal_of \<Psi>" 
     and ?ops = "operators_of \<Psi>"
     and ?\<psi> = "\<phi>\<^sub>P\<inverse> \<Psi> \<pi>"
   show ?thesis
     unfolding is_parallel_solution_for_problem_def Let_def
     proof (rule conjI)
       show "?G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus ?I ?\<psi>"
         using sas_plus_equivalent_to_strips_i[OF assms].
     next 
       show "list_all (list_all (\<lambda>op. ListMem op ?ops)) ?\<psi>" 
         using sas_plus_equivalent_to_strips_ii[OF assms].
     qed
 qed
 
 private lemma strips_equivalent_to_sas_plus_i_a_I:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "\<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
     and "op' \<in> set [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]"
   obtains op where "op \<in> set ops" 
     and "op' = \<phi>\<^sub>O \<Psi> op"
 proof -
   let ?\<Pi> = "\<phi> \<Psi>" 
   let ?ops = "operators_of \<Psi>"
   obtain op where "op \<in> set ops" and "op' = \<phi>\<^sub>O \<Psi> op" 
     using assms(3) 
     by auto
   thus ?thesis 
     using that
     by blast
 qed
 
 private corollary strips_equivalent_to_sas_plus_i_a_II:
   assumes"is_valid_problem_sas_plus \<Psi>"
     and "\<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
     and "op' \<in> set [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]"
   shows "op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "is_valid_operator_strips (\<phi> \<Psi>) op'"
 proof -
   let ?\<Pi> = "\<phi> \<Psi>" 
   let ?ops = "operators_of \<Psi>"
     and ?ops' = "strips_problem.operators_of ?\<Pi>"
   obtain op where op_in: "op \<in> set ops" and op'_is: "op' = \<phi>\<^sub>O \<Psi> op" 
     using strips_equivalent_to_sas_plus_i_a_I[OF assms].
   then have nb: "op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     using assms(2) op_in op'_is 
     by fastforce
   thus "op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
     and "is_valid_operator_strips ?\<Pi> op'" 
     proof -
       have "\<forall>op' \<in> set ?ops'. is_valid_operator_strips ?\<Pi> op'"
         using is_valid_problem_sas_plus_then_strips_transformation_too_iii[OF assms(1)]
         unfolding list_all_iff. 
       thus "is_valid_operator_strips ?\<Pi> op'" 
         using nb
         by fastforce
     qed fastforce
 qed
 
 (* TODO make private *)
 lemma strips_equivalent_to_sas_plus_i_a_III:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "\<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
   shows "execute_parallel_operator (\<phi>\<^sub>S \<Psi> s) [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]
     = (\<phi>\<^sub>S \<Psi> (execute_parallel_operator_sas_plus s ops))"
 proof -
   {
     fix op s
     assume "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
     moreover have "(\<phi>\<^sub>O \<Psi> op) \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
       using calculation 
       by simp
     moreover have "(\<phi>\<^sub>S \<Psi> s) ++ map_of (effect_to_assignments (\<phi>\<^sub>O \<Psi> op))
       = (\<phi>\<^sub>S \<Psi> (s ++ map_of (effect_of (\<phi>\<^sub>O\<inverse> \<Psi> (\<phi>\<^sub>O \<Psi> op)))))"
       using sas_plus_equivalent_to_strips_i_a_XI[OF assms(1) calculation(2)]
       by blast
     moreover have "(\<phi>\<^sub>O\<inverse> \<Psi> (\<phi>\<^sub>O \<Psi> op)) = op"
       using sas_plus_operator_inverse_is[OF assms(1) calculation(1)].
     ultimately have "(\<phi>\<^sub>S \<Psi> s) \<then> (\<phi>\<^sub>O \<Psi> op)
       = (\<phi>\<^sub>S \<Psi> (s \<then>\<^sub>+ op))" 
       unfolding execute_operator_def execute_operator_sas_plus_def 
       by simp
   } note nb\<^sub>1 = this
   show ?thesis 
     using assms
     proof (induction ops arbitrary: s)
       case Nil
       then show ?case 
         unfolding execute_parallel_operator_def execute_parallel_operator_sas_plus_def 
         by simp
     next
       case (Cons op ops)
       let ?t = "s \<then>\<^sub>+ op"
       let ?s' = "\<phi>\<^sub>S \<Psi> s" 
         and ?ops' = "[\<phi>\<^sub>O \<Psi> op. op \<leftarrow> op # ops]"
       let ?t' = "?s' \<then> (\<phi>\<^sub>O \<Psi> op)"
       have "execute_parallel_operator ?s' ?ops' 
         = execute_parallel_operator ?t' [\<phi>\<^sub>O \<Psi> x. x \<leftarrow> ops]"
         unfolding execute_operator_def
         by simp
       moreover have "(\<phi>\<^sub>S \<Psi> (execute_parallel_operator_sas_plus s (op # ops)))
         = (\<phi>\<^sub>S \<Psi> (execute_parallel_operator_sas_plus ?t ops))" 
         unfolding execute_operator_sas_plus_def
         by simp
       moreover {
         have "?t' = (\<phi>\<^sub>S \<Psi> ?t)"
           using nb\<^sub>1 Cons.prems(2)
           by simp
         hence "execute_parallel_operator ?t'[\<phi>\<^sub>O \<Psi> x. x \<leftarrow> ops] 
           = (\<phi>\<^sub>S \<Psi> (execute_parallel_operator_sas_plus ?t ops))" 
           using Cons.IH[of ?t] Cons.prems
           by simp
       }
       ultimately show ?case 
         by argo
     qed
 qed
 
 private lemma strips_equivalent_to_sas_plus_i_a_IV:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "\<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
     and "are_all_operators_applicable_in I ops 
     \<and> are_all_operator_effects_consistent ops"
   shows "STRIPS_Semantics.are_all_operators_applicable (\<phi>\<^sub>S \<Psi> I) [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]
     \<and> STRIPS_Semantics.are_all_operator_effects_consistent [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]"
 proof -
   let ?vs = "variables_of \<Psi>" 
     and ?ops = "operators_of \<Psi>" 
   let ?I' = "\<phi>\<^sub>S \<Psi> I" 
     and ?ops' = "[\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]"
   have nb\<^sub>1: "\<forall>op \<in> set ops. is_operator_applicable_in I op"
     using assms(3) 
     unfolding are_all_operators_applicable_in_def list_all_iff
     by blast
   have nb\<^sub>2: "\<forall>op \<in> set ops. is_valid_operator_sas_plus \<Psi> op"
     using is_valid_problem_sas_plus_then(2) assms(1, 2)
     unfolding is_valid_operator_sas_plus_def
     by auto
   have nb\<^sub>3: "\<forall>op \<in> set ops. map_of (precondition_of op) \<subseteq>\<^sub>m I" 
     using nb\<^sub>1 
     unfolding is_operator_applicable_in_def list_all_iff 
     by blast
   {
     fix op\<^sub>1 op\<^sub>2
     assume "op\<^sub>1 \<in> set ops" and "op\<^sub>2 \<in> set ops" 
     hence "are_operator_effects_consistent op\<^sub>1 op\<^sub>2" 
       using assms(3)
       unfolding are_all_operator_effects_consistent_def list_all_iff 
       by blast
   } note nb\<^sub>4 = this
   {
     fix op\<^sub>1 op\<^sub>2
     assume "op\<^sub>1 \<in> set ops" and "op\<^sub>2 \<in> set ops"
     hence "\<forall>(v, a) \<in> set (effect_of op\<^sub>1). \<forall>(v', a') \<in> set (effect_of op\<^sub>2).
       v \<noteq> v' \<or> a = a'"
       using nb\<^sub>4
       unfolding are_operator_effects_consistent_def Let_def list_all_iff
       by presburger
   } note nb\<^sub>5 = this
   {
     fix op\<^sub>1' op\<^sub>2' I
     assume "op\<^sub>1' \<in> set ?ops'" 
       and "op\<^sub>2' \<in> set ?ops'" 
       and "\<exists>(v, a) \<in> set (add_effects_of op\<^sub>1'). \<exists>(v', a') \<in> set (delete_effects_of op\<^sub>2').
         (v, a) = (v', a')" 
     moreover obtain op\<^sub>1 op\<^sub>2
       where "op\<^sub>1 \<in> set ops" 
           and "op\<^sub>1' = \<phi>\<^sub>O \<Psi> op\<^sub>1" 
         and "op\<^sub>2 \<in> set ops" 
           and "op\<^sub>2' = \<phi>\<^sub>O \<Psi> op\<^sub>2" 
       using strips_equivalent_to_sas_plus_i_a_I[OF assms(1, 2)] calculation(1, 2) 
       by auto
     moreover have "is_valid_operator_sas_plus \<Psi> op\<^sub>1"
        and is_valid_operator_op\<^sub>2: "is_valid_operator_sas_plus \<Psi> op\<^sub>2"
       using calculation(4, 6) nb\<^sub>2 
        by blast+
     moreover obtain v v' a a' 
       where "(v, a) \<in> set (add_effects_of op\<^sub>1')" 
         and "(v', a') \<in> set (delete_effects_of op\<^sub>2')"
         and "(v, a) = (v', a')" 
       using calculation
       by blast
     moreover have "(v, a) \<in> set (effect_of op\<^sub>1)" 
       using calculation(5, 10) 
       unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
         sasp_op_to_strips_def Let_def
       by fastforce
     moreover have "v = v'" and "a = a'"
       using calculation(12) 
       by simp+
     moreover {
       have "(v', a') \<in> (\<Union>(v, a) \<in> set (effect_of op\<^sub>2). 
         { (v, a') | a'. a' \<in> (\<R>\<^sub>+ \<Psi> v) \<and>  a' \<noteq> a })"
         using sasp_op_to_strips_set_delete_effects_is 
           calculation(7, 9, 11)
         by blast
       then obtain v'' a'' where "(v'', a'') \<in> set (effect_of op\<^sub>2)" 
         and "(v', a') \<in> { (v'', a''') | a'''. a''' \<in> (\<R>\<^sub>+ \<Psi> v'') \<and>  a''' \<noteq> a'' }"
         by blast
       moreover have "(v', a'') \<in> set (effect_of op\<^sub>2)" 
         using calculation 
         by blast
       moreover have "a' \<in> \<R>\<^sub>+ \<Psi> v''" and "a' \<noteq> a''"
         using calculation(1, 2) 
         by fast+
       ultimately have "\<exists>a''. (v', a'') \<in> set (effect_of op\<^sub>2) \<and> a' \<in> (\<R>\<^sub>+ \<Psi> v') 
         \<and> a' \<noteq> a''" 
         by blast
     }
     moreover obtain a'' where "a' \<in> \<R>\<^sub>+ \<Psi> v'" 
       and "(v', a'') \<in> set (effect_of op\<^sub>2)" 
       and "a' \<noteq> a''"
       using calculation(16)
       by blast
     moreover have "\<exists>(v, a) \<in> set (effect_of op\<^sub>1). (\<exists>(v', a') \<in> set (effect_of op\<^sub>2). 
       v = v' \<and> a \<noteq> a')"
       using calculation(13, 14, 15, 17, 18, 19)
       by blast
     \<comment> \<open> TODO slow. \<close>
     ultimately have "\<exists>op\<^sub>1 \<in> set ops. \<exists>op\<^sub>2 \<in> set ops. \<not>are_operator_effects_consistent op\<^sub>1 op\<^sub>2"
       unfolding are_operator_effects_consistent_def list_all_iff
       by fastforce
   } note nb\<^sub>6 = this
   show ?thesis
     proof (rule conjI)
       {
         fix op' 
         assume "op' \<in> set ?ops'" 
         moreover obtain op where op_in: "op \<in> set ops" 
           and op'_is: "op' = \<phi>\<^sub>O \<Psi> op"
           and op'_in: "op' \<in> set ((\<phi> \<Psi>)\<^sub>\<O>)"
           and is_valid_op': "is_valid_operator_strips (\<phi> \<Psi>) op'"
           using strips_equivalent_to_sas_plus_i_a_I[OF assms(1, 2)]
             strips_equivalent_to_sas_plus_i_a_II[OF assms(1, 2)] calculation 
           by metis
         moreover have is_valid_op: "is_valid_operator_sas_plus \<Psi> op"
           using nb\<^sub>2 calculation(2)..
         {
           fix v a
           assume v_a_in_preconditions': "(v, a) \<in> set (strips_operator.precondition_of op')"
           have v_a_in_preconditions: "(v, a) \<in> set (precondition_of op)" 
             using op'_is
             unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
               sasp_op_to_strips_def Let_def
             using v_a_in_preconditions' 
             by force
           moreover have "v \<in> set ?vs" and "a \<in> \<R>\<^sub>+ \<Psi> v"
             using is_valid_operator_sas_plus_then(1,2) is_valid_op calculation(1)
             by fastforce+
           moreover {
             have "\<forall>(v, a) \<in> set (precondition_of op). \<forall>(v', a') \<in> set (precondition_of op).
               v \<noteq> v' \<or> a = a'" 
               using is_valid_operator_sas_plus_then(5) is_valid_op
               by fast
             hence "map_of (precondition_of op) v = Some a" 
               using map_of_constant_assignments_defined_if[OF _ v_a_in_preconditions]
               by blast
           }
           moreover have "v \<in> dom (map_of (precondition_of op))" 
             using calculation(4)
             by blast
           moreover have "I v = Some a" 
             using nb\<^sub>3 
             unfolding map_le_def 
             using op_in calculation(4, 5)
             by metis
           moreover have "(v, a) \<in> dom ?I'" 
             using state_to_strips_state_dom_element_iff[OF assms(1)] 
               calculation(2, 3, 6)
             by simp
           ultimately have "?I' (v, a) = Some True" 
             using state_to_strips_state_range_is[OF assms(1)]
             by simp
         }
         hence "STRIPS_Representation.is_operator_applicable_in ?I' op'" 
           unfolding 
             STRIPS_Representation.is_operator_applicable_in_def 
             Let_def list_all_iff 
           by fast
       }
       thus "are_all_operators_applicable ?I' ?ops'"
         unfolding are_all_operators_applicable_def list_all_iff
         by blast
     next 
       {
         fix op\<^sub>1' op\<^sub>2'
         assume op\<^sub>1'_in_ops': "op\<^sub>1' \<in> set ?ops'" and op\<^sub>2'_in_ops': "op\<^sub>2' \<in> set ?ops'" 
         have "STRIPS_Semantics.are_operator_effects_consistent op\<^sub>1' op\<^sub>2'" 
           unfolding STRIPS_Semantics.are_operator_effects_consistent_def Let_def
           \<comment> \<open> TODO proof is symmetrical... refactor into nb. \<close>
           proof (rule conjI)          
             show "\<not>list_ex (\<lambda>x. list_ex ((=) x) (delete_effects_of op\<^sub>2')) 
               (add_effects_of op\<^sub>1')"
               proof (rule ccontr)
                 assume "\<not>\<not>list_ex (\<lambda>v. list_ex ((=) v) (delete_effects_of op\<^sub>2')) 
                   (add_effects_of op\<^sub>1')" 
                 then have "\<exists>(v, a) \<in> set (delete_effects_of op\<^sub>2'). 
                   \<exists>(v', a') \<in> set (add_effects_of op\<^sub>1'). (v, a) = (v', a')" 
                   unfolding list_ex_iff 
                   by fastforce
                 then obtain op\<^sub>1 op\<^sub>2 where "op\<^sub>1 \<in> set ops"
                   and "op\<^sub>2 \<in> set ops" 
                   and "\<not>are_operator_effects_consistent op\<^sub>1 op\<^sub>2" 
                   using nb\<^sub>6[OF op\<^sub>1'_in_ops' op\<^sub>2'_in_ops']
                   by blast
                 thus False 
                   using nb\<^sub>4
                   by blast              
               qed
           next
             show "\<not>list_ex (\<lambda>v. list_ex ((=) v) (add_effects_of op\<^sub>2')) (delete_effects_of op\<^sub>1')" 
               proof (rule ccontr)
                 assume "\<not>\<not>list_ex (\<lambda>v. list_ex ((=) v) (add_effects_of op\<^sub>2')) 
                   (delete_effects_of op\<^sub>1')" 
                 then have "\<exists>(v, a) \<in> set (delete_effects_of op\<^sub>1'). 
                   \<exists>(v', a') \<in> set (add_effects_of op\<^sub>2'). (v, a) = (v', a')" 
                   unfolding list_ex_iff
                   by fastforce
                 then obtain op\<^sub>1 op\<^sub>2 where "op\<^sub>1 \<in> set ops"
                   and "op\<^sub>2 \<in> set ops" 
                   and "\<not>are_operator_effects_consistent op\<^sub>1 op\<^sub>2" 
                   using nb\<^sub>6[OF op\<^sub>2'_in_ops' op\<^sub>1'_in_ops']
                   by blast
                 thus False 
                   using nb\<^sub>4
                   by blast
               qed
           qed
       }
       thus "STRIPS_Semantics.are_all_operator_effects_consistent ?ops'" 
         unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
         by blast
     qed
 qed
 
 private lemma strips_equivalent_to_sas_plus_i_a_V:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "\<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
     and "\<not>(are_all_operators_applicable_in s ops 
     \<and> are_all_operator_effects_consistent ops)"
   shows "\<not>(STRIPS_Semantics.are_all_operators_applicable (\<phi>\<^sub>S \<Psi> s) [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]
     \<and> STRIPS_Semantics.are_all_operator_effects_consistent [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops])"
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?ops = "operators_of \<Psi>" 
   let ?s' = "\<phi>\<^sub>S \<Psi> s"
     and ?ops' = "[\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]"
   {
     fix op
     assume "op \<in> set ops" 
     hence "\<exists>op' \<in> set ?ops'. op' = \<phi>\<^sub>O \<Psi> op" 
       by simp
   } note nb\<^sub>1 = this
   {
     fix op
     assume "op \<in> set ops" 
     then have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
       using assms(2) 
       by blast
     then have "is_valid_operator_sas_plus \<Psi> op"
       using is_valid_problem_sas_plus_then(2) assms(1)
       unfolding is_valid_operator_sas_plus_def
       by auto
     hence "\<forall>(v, a) \<in> set (precondition_of op). \<forall>(v', a') \<in> set (precondition_of op).
       v \<noteq> v' \<or> a = a'" 
       using is_valid_operator_sas_plus_then(5)
       unfolding is_valid_operator_sas_plus_def
       by fast
   } note nb\<^sub>2 = this
   {
     consider (A) "\<not>are_all_operators_applicable_in s ops" 
       | (B) "\<not>are_all_operator_effects_consistent ops" 
       using assms(3)
       by blast
     hence "\<not>STRIPS_Semantics.are_all_operators_applicable ?s' ?ops' 
       \<or> \<not>STRIPS_Semantics.are_all_operator_effects_consistent ?ops'"
       proof (cases)
         case A
         then obtain op where op_in: "op \<in> set ops" 
           and not_precondition_map_le_s: "\<not>(map_of (precondition_of op) \<subseteq>\<^sub>m s)"
           using A
           unfolding are_all_operators_applicable_in_def list_all_iff 
             is_operator_applicable_in_def
           by blast
         then obtain op' where op'_in: "op' \<in> set ?ops'" and op'_is: "op' = \<phi>\<^sub>O \<Psi> op" 
           using nb\<^sub>1
           by blast
         have "\<not>are_all_operators_applicable ?s' ?ops'" 
           proof (rule ccontr)
             assume "\<not>\<not>are_all_operators_applicable ?s' ?ops'"
             then have all_operators_applicable: "are_all_operators_applicable ?s' ?ops'"
               by simp
             moreover {
               fix v 
               assume "v \<in> dom (map_of (precondition_of op))" 
               moreover obtain a where "map_of (precondition_of op) v = Some a" 
                 using calculation
                 by blast
               moreover have "(v, a) \<in> set (precondition_of op)"
                 using map_of_SomeD[OF calculation(2)].
               moreover have "(v, a) \<in> set (strips_operator.precondition_of op')"
                 using op'_is 
                 unfolding sasp_op_to_strips_def
                   SAS_Plus_STRIPS.sasp_op_to_strips_def
                 using calculation(3) 
                 by auto 
               moreover have "?s' (v, a) = Some True"
                 using all_operators_applicable calculation 
                 unfolding are_all_operators_applicable_def 
                     STRIPS_Representation.is_operator_applicable_in_def 
                     is_operator_applicable_in_def Let_def list_all_iff 
                 using op'_in
                 by fast
               moreover have "(v, a) \<in> dom ?s'" 
                 using calculation(5)
                 by blast
               moreover have "(v, a) \<in> set (precondition_of op)" 
                 using op'_is calculation(3)
                 unfolding sasp_op_to_strips_def Let_def
                 by fastforce
               moreover have "v \<in> set ?vs" 
                 and "a \<in> \<R>\<^sub>+ \<Psi> v" 
                 and "s v \<noteq> None" 
                 using state_to_strips_state_dom_element_iff[OF assms(1)]
                   calculation(6)
                 by simp+
               moreover have "?s' (v, a) = Some (the (s v) = a)" 
                 using state_to_strips_state_range_is[OF 
                     assms(1) calculation(6)].
               moreover have "the (s v) = a" 
                 using calculation(5, 11)
                 by fastforce
               moreover have "s v = Some a" 
                 using calculation(12) option.collapse[OF calculation(10)]
                 by argo
               moreover have "map_of (precondition_of op) v = Some a"
                 using map_of_constant_assignments_defined_if[OF nb\<^sub>2[OF op_in] calculation(7)].
               ultimately have "map_of (precondition_of op) v = s v"
                 by argo
             }
             then have "map_of (precondition_of op) \<subseteq>\<^sub>m s" 
               unfolding map_le_def
               by blast
             thus False 
               using not_precondition_map_le_s
               by simp
           qed
         thus ?thesis 
           by simp
       next
         case B
         {
           obtain op\<^sub>1 op\<^sub>2 v v' a a' 
             where "op\<^sub>1 \<in> set ops"
               and op\<^sub>2_in: "op\<^sub>2 \<in> set ops"
               and v_a_in: "(v, a) \<in> set (effect_of op\<^sub>1)"
               and v'_a'_in: "(v', a') \<in> set (effect_of op\<^sub>2)" 
               and v_is: "v = v'" and a_is: "a \<noteq> a'"  
             using B 
             unfolding are_all_operator_effects_consistent_def 
               are_operator_effects_consistent_def list_all_iff Let_def
             by blast
           moreover obtain op\<^sub>1' op\<^sub>2' where "op\<^sub>1' \<in> set ?ops'" and "op\<^sub>1' = \<phi>\<^sub>O \<Psi> op\<^sub>1"
             and "op\<^sub>1' \<in> set ?ops'" and op\<^sub>2'_is: "op\<^sub>2' = \<phi>\<^sub>O \<Psi> op\<^sub>2"
             using nb\<^sub>1[OF calculation(1)] nb\<^sub>1[OF calculation(2)]
             by blast
           moreover have "(v, a) \<in> set (add_effects_of op\<^sub>1')"
             using calculation(3, 8)
             unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
               sasp_op_to_strips_def Let_def
             by force
           moreover {
             have "is_valid_operator_sas_plus \<Psi> op\<^sub>1" 
               using assms(2) calculation(1) is_valid_problem_sas_plus_then(2) assms(1)
               unfolding is_valid_operator_sas_plus_def 
               by auto
             moreover have "is_valid_operator_sas_plus \<Psi> op\<^sub>2"
               using sublocale_sas_plus_finite_domain_representation_ii(2)[
                   OF assms(1)] assms(2) op\<^sub>2_in 
               by blast 
             moreover have "a \<in> \<R>\<^sub>+ \<Psi> v" 
               using is_valid_operator_sas_plus_then(4) calculation v_a_in
               unfolding is_valid_operator_sas_plus_def
               by fastforce
             ultimately have "(v, a) \<in> set (delete_effects_of op\<^sub>2')" 
               using sasp_op_to_strips_set_delete_effects_is[of \<Psi> op\<^sub>2]
                 v'_a'_in v_is a_is 
               using op\<^sub>2'_is 
               by blast
           }
           \<comment> \<open> TODO slow. \<close>
           ultimately have "\<exists>op\<^sub>1' \<in> set ?ops'. \<exists>op\<^sub>2' \<in> set ?ops'. 
             \<exists>(v, a) \<in> set (delete_effects_of op\<^sub>2'). \<exists>(v', a') \<in> set (add_effects_of op\<^sub>1').
             (v, a) = (v', a')"
             by fastforce
         }
         then have "\<not>STRIPS_Semantics.are_all_operator_effects_consistent ?ops'" 
           unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def 
             STRIPS_Semantics.are_operator_effects_consistent_def list_all_iff list_ex_iff Let_def 
           by blast
         thus ?thesis 
           by simp 
       qed
   }
   thus ?thesis 
     by blast
 qed
 
 (* TODO make private *)
 lemma strips_equivalent_to_sas_plus_i_a:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "dom I \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
     and "\<forall>v \<in> dom I. the (I v) \<in> \<R>\<^sub>+ \<Psi> v" 
     and "dom G \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
     and "\<forall>v \<in> dom G. the (G v) \<in> \<R>\<^sub>+ \<Psi> v" 
     and "\<forall>ops \<in> set \<psi>. \<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
     and "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I \<psi>" 
   shows "(\<phi>\<^sub>S \<Psi> G) \<subseteq>\<^sub>m execute_parallel_plan (\<phi>\<^sub>S \<Psi> I) (\<phi>\<^sub>P \<Psi> \<psi>)" 
 proof -
   let ?\<Pi> = "\<phi> \<Psi>"
     and ?G' = "\<phi>\<^sub>S \<Psi> G"
   show ?thesis 
     using assms
     proof (induction \<psi> arbitrary: I)
       case Nil
       let ?I' = "\<phi>\<^sub>S \<Psi> I"
       have "G \<subseteq>\<^sub>m I" 
         using Nil
         by simp
       moreover have "?G' \<subseteq>\<^sub>m ?I'"
         using state_to_strips_state_map_le_iff[OF Nil.prems(1, 4, 5)] 
           calculation..
       ultimately show ?case 
         unfolding SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
           sas_plus_parallel_plan_to_strips_parallel_plan_def
         by simp
     next
       case (Cons ops \<psi>)
       let ?vs = "variables_of \<Psi>"
         and ?ops = "operators_of \<Psi>"
         and ?J = "execute_parallel_operator_sas_plus I ops" 
         and ?\<pi> = "\<phi>\<^sub>P \<Psi> (ops # \<psi>)"
       let ?I' = "\<phi>\<^sub>S \<Psi> I"
         and ?J' = "\<phi>\<^sub>S \<Psi> ?J"
         and ?ops' = "[\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]"
       {
         fix op v a
         assume "op \<in> set ops" and "(v, a) \<in> set (effect_of op)" 
         moreover have "op \<in> set ?ops"
           using Cons.prems(6) calculation(1)
           by simp
         moreover have "is_valid_operator_sas_plus \<Psi> op" 
           using is_valid_problem_sas_plus_then(2) Cons.prems(1) calculation(3)
           unfolding is_valid_operator_sas_plus_def
           by auto
         ultimately have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
           and "a \<in> \<R>\<^sub>+ \<Psi> v"
           using is_valid_operator_sas_plus_then(3,4)
           by fastforce+
       } note nb\<^sub>1 = this
       show ?case
       proof (cases "are_all_operators_applicable_in I ops 
         \<and> are_all_operator_effects_consistent ops")
         case True
         {
           have "(\<phi>\<^sub>P \<Psi> (ops # \<psi>)) = ?ops' # (\<phi>\<^sub>P \<Psi> \<psi>)"
             unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
               SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def 
               sasp_op_to_strips_def
               SAS_Plus_STRIPS.sasp_op_to_strips_def
             by simp
           moreover have "\<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)" 
             using Cons.prems(6)
             by simp
           moreover have "STRIPS_Semantics.are_all_operators_applicable ?I' ?ops'" 
             and "STRIPS_Semantics.are_all_operator_effects_consistent ?ops'" 
             using strips_equivalent_to_sas_plus_i_a_IV[OF Cons.prems(1) _ True] calculation
             by blast+
           ultimately have "execute_parallel_plan ?I' ?\<pi> 
             = execute_parallel_plan (execute_parallel_operator ?I' ?ops') (\<phi>\<^sub>P \<Psi> \<psi>)"
             by fastforce
         }
         \<comment> \<open> NOTE Instantiate the IH on the next state of the SAS+ execution 
           \<open>execute_parallel_operator_sas_plus I ops\<close>. \<close>
         moreover
         {
           {
             have "dom I \<subseteq> set (sas_plus_problem.variables_of \<Psi>)"
               using Cons.prems(2)
               by blast
             moreover have "\<forall>op \<in> set ops. \<forall>(v, a) \<in> set (effect_of op). 
               v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
               using nb\<^sub>1(1) 
               by blast
             ultimately have "dom ?J \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
               using sas_plus_equivalent_to_strips_i_a_IX[of I "set ?vs"]
               by simp
           } note nb\<^sub>2 = this
           moreover {
             have "dom I \<subseteq> set (sas_plus_problem.variables_of \<Psi>)"
               using Cons.prems(2)
               by blast
             moreover have "set (sas_plus_problem.variables_of \<Psi>)
               \<subseteq> dom (range_of \<Psi>)"
               using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
               by auto
            moreover {
               fix v 
               assume "v \<in> dom I"  
               moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
                 using Cons.prems(2) calculation
                 by blast
               ultimately have "the (I v) \<in> set (the (range_of \<Psi> v))" 
                 using Cons.prems(3)
                 using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)]
                 by blast
             }
             moreover have "\<forall>op\<in>set ops. \<forall>(v, a)\<in>set (effect_of op).
               v \<in> set (sas_plus_problem.variables_of \<Psi>) \<and> a \<in> set (the (range_of \<Psi> v))"
               using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)] nb\<^sub>1(1) nb\<^sub>1(2)
               by force
             moreover have nb\<^sub>3: "\<forall>v \<in> dom ?J. the (?J v) \<in> set (the (range_of \<Psi> v))" 
               using sas_plus_equivalent_to_strips_i_a_X[of I "set ?vs" "range_of \<Psi>" ops] 
                 calculation
               by fast
             moreover {
               fix v
               assume "v \<in> dom ?J"
               moreover have "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
                 using nb\<^sub>2 calculation
                 by blast
               moreover have "set (the (range_of \<Psi> v)) = \<R>\<^sub>+ \<Psi> v" 
                 using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)] 
                   calculation(2)
                 by presburger
               ultimately have "the (?J v) \<in> \<R>\<^sub>+ \<Psi> v" 
                 using nb\<^sub>3
                 by blast
             }
             ultimately have "\<forall>v \<in> dom ?J. the (?J v) \<in> \<R>\<^sub>+ \<Psi> v"
               by fast
           }
           moreover have "\<forall>ops\<in>set \<psi>. \<forall>op\<in>set ops. op \<in> set ?ops" 
             using Cons.prems(6)
             by auto
           moreover have "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus ?J \<psi>" 
             using Cons.prems(7) True
             by simp
           ultimately have "(\<phi>\<^sub>S \<Psi> G) \<subseteq>\<^sub>m execute_parallel_plan ?J' (\<phi>\<^sub>P \<Psi> \<psi>)"
             using Cons.IH[of ?J, OF Cons.prems(1) _ _ Cons.prems(4, 5)]
             by fastforce
         }
         moreover have "execute_parallel_operator ?I' ?ops' = ?J'" 
           using assms(1) strips_equivalent_to_sas_plus_i_a_III[OF assms(1)] Cons.prems(6)
           by auto
         ultimately show ?thesis
           by argo
       next
         case False
         then have nb: "G \<subseteq>\<^sub>m I" 
           using Cons.prems(7)
           by force
         moreover {
           have "?\<pi> = ?ops' # (\<phi>\<^sub>P \<Psi> \<psi>)"
             unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
               SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def 
               sasp_op_to_strips_def
               SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def
             by auto
           moreover have "set ?ops' \<subseteq> set (strips_problem.operators_of ?\<Pi>)"
             using strips_equivalent_to_sas_plus_i_a_II(1)[OF assms(1)] Cons.prems(6)
             by auto
           moreover have "\<not>(STRIPS_Semantics.are_all_operators_applicable ?I' ?ops' 
             \<and> STRIPS_Semantics.are_all_operator_effects_consistent ?ops')"
             using strips_equivalent_to_sas_plus_i_a_V[OF assms(1) _ False] Cons.prems(6)
             by force 
           ultimately have "execute_parallel_plan ?I' ?\<pi> = ?I'"
             by auto
         }
         moreover have "?G' \<subseteq>\<^sub>m ?I'" 
           using state_to_strips_state_map_le_iff[OF Cons.prems(1, 4, 5)] nb
           by blast
         ultimately show ?thesis 
           by presburger
         qed 
     qed
 qed
 
 (* TODO make private *)
 lemma strips_equivalent_to_sas_plus_i:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "is_parallel_solution_for_problem \<Psi> \<psi>"
   shows "(strips_problem.goal_of (\<phi> \<Psi>)) \<subseteq>\<^sub>m execute_parallel_plan 
     (strips_problem.initial_of (\<phi> \<Psi>)) (\<phi>\<^sub>P \<Psi> \<psi>)" 
 proof -
   let ?vs = "variables_of \<Psi>"
     and ?ops = "operators_of \<Psi>"
     and ?I = "initial_of \<Psi>"
     and ?G = "goal_of \<Psi>"
   let ?\<Pi> = "\<phi> \<Psi>"
   let ?I' = "strips_problem.initial_of ?\<Pi>"
     and ?G' = "strips_problem.goal_of ?\<Pi>"
   have "dom ?I \<subseteq> set ?vs"
     using is_valid_problem_sas_plus_then(3) assms(1)
     by auto
   moreover have "\<forall>v\<in>dom ?I. the (?I v) \<in> \<R>\<^sub>+ \<Psi> v" 
     using is_valid_problem_sas_plus_then(4) assms(1) calculation
     by auto
   moreover have "dom ?G \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)" 
     using is_valid_problem_sas_plus_then(5) assms(1)
     by auto
   moreover have "\<forall>v \<in> dom ?G. the (?G v) \<in> \<R>\<^sub>+ \<Psi> v"
     using is_valid_problem_sas_plus_then(6) assms(1)
     by auto
   moreover have "\<forall>ops \<in> set \<psi>. \<forall>op \<in> set ops. op \<in> set ?ops"
     using is_parallel_solution_for_problem_plan_operator_set[OF assms(2)]
     by fastforce
   moreover have "?G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus ?I \<psi>" 
     using assms(2) 
     unfolding is_parallel_solution_for_problem_def
     by simp
   (* TODO slow *)
   ultimately show ?thesis
     using strips_equivalent_to_sas_plus_i_a[OF assms(1), of ?I ?G \<psi>]
     unfolding sas_plus_problem_to_strips_problem_def
       SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def 
       state_to_strips_state_def
       SAS_Plus_STRIPS.state_to_strips_state_def
     by force
 qed
 
 (* TODO make private *)
 lemma strips_equivalent_to_sas_plus_ii:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "is_parallel_solution_for_problem \<Psi> \<psi>"
   shows "list_all (list_all (\<lambda>op. ListMem op (strips_problem.operators_of (\<phi> \<Psi>)))) (\<phi>\<^sub>P \<Psi> \<psi>)" 
 proof -
   let ?ops = "operators_of \<Psi>"
   let ?\<Pi> = "\<phi> \<Psi>"
   let ?ops' = "strips_problem.operators_of ?\<Pi>"
     and ?\<pi> = "\<phi>\<^sub>P \<Psi> \<psi>"
   have "is_valid_problem_strips ?\<Pi>" 
     using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)]
     by simp 
   have nb\<^sub>1: "\<forall>op \<in> set ?ops. (\<exists>op' \<in> set ?ops'. op' = (\<phi>\<^sub>O \<Psi> op))" 
     unfolding sas_plus_problem_to_strips_problem_def
       SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def Let_def 
       sasp_op_to_strips_def
     by force
   {
     fix ops op op'
     assume "ops \<in> set \<psi>" and "op \<in> set ops" 
     moreover have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
       using is_parallel_solution_for_problem_plan_operator_set[OF assms(2)] 
         calculation
       by blast
     moreover obtain op' where "op' \<in> set ?ops'" and "op' = (\<phi>\<^sub>O \<Psi> op)" 
       using nb\<^sub>1 calculation(3)
       by auto
     ultimately have "(\<phi>\<^sub>O \<Psi> op) \<in> set ?ops'"
       by blast
   }
   thus ?thesis 
     unfolding list_all_iff ListMem_iff Let_def  
       sas_plus_problem_to_strips_problem_def
       SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
       sas_plus_parallel_plan_to_strips_parallel_plan_def
       SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def 
       sasp_op_to_strips_def
       SAS_Plus_STRIPS.sasp_op_to_strips_def 
       Let_def 
     by auto
 qed
 
 text \<open> The following lemma proves the complementary proposition to theorem 
 \ref{isathm:equivalence-parallel-strips-parallel-sas-plus}. Namely, given a parallel solution
 \<^term>\<open>\<psi>\<close> for a SAS+ problem, the transformation to a STRIPS plan \<^term>\<open>\<phi>\<^sub>P \<Psi> \<psi>\<close> also is a solution 
 to the corresponding STRIPS problem \<^term>\<open>\<Pi> \<equiv> (\<phi> \<Psi>)\<close>. In this direction, we have to show that the 
 execution of the transformed plan reaches the goal state \<^term>\<open>G' \<equiv> strips_problem.goal_of \<Pi>\<close> 
 of the corresponding STRIPS problem, i.e.
   @{text[display, indent=4] "G' \<subseteq>\<^sub>m execute_parallel_plan I' \<pi>"} 
 and that all operators in the transformed plan \<^term>\<open>\<pi>\<close> are operators of \<^term>\<open>\<Pi>\<close>. \<close>
 
 theorem
   strips_equivalent_to_sas_plus:
   assumes "is_valid_problem_sas_plus \<Psi>"
     and "is_parallel_solution_for_problem \<Psi> \<psi>"
   shows "STRIPS_Semantics.is_parallel_solution_for_problem (\<phi> \<Psi>) (\<phi>\<^sub>P \<Psi> \<psi>)"
 proof -
   let ?\<Pi> = "\<phi> \<Psi>"
   let ?I' = "strips_problem.initial_of ?\<Pi>"
     and ?G' = "strips_problem.goal_of ?\<Pi>"
     and ?ops' = "strips_problem.operators_of ?\<Pi>"
     and ?\<pi> = "\<phi>\<^sub>P \<Psi> \<psi>"
   show ?thesis
     unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def 
     proof (rule conjI)
       show "?G' \<subseteq>\<^sub>m execute_parallel_plan ?I' ?\<pi>"
         using strips_equivalent_to_sas_plus_i[OF assms]
         by simp
     next 
       show "list_all (list_all (\<lambda>op. ListMem op ?ops')) ?\<pi>" 
         using strips_equivalent_to_sas_plus_ii[OF assms].
     qed
 qed
 
 lemma embedded_serial_sas_plus_plan_operator_structure:
   assumes "ops \<in> set (embed \<psi>)"
   obtains op 
   where "op \<in> set \<psi>" 
     and "[\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops] = [\<phi>\<^sub>O \<Psi> op]"
 proof -
   let ?\<psi>' = "embed \<psi>"
   {
     have "?\<psi>' = [[op]. op \<leftarrow> \<psi>]"
       by (induction \<psi>; force)
     moreover obtain op where "ops = [op]" and "op \<in> set \<psi>" 
       using assms calculation 
       by fastforce
     ultimately have "\<exists>op \<in> set \<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops] = [\<phi>\<^sub>O \<Psi> op]"
       by auto
   }
   thus ?thesis 
     using that
     by meson
 qed
 
 private lemma serial_sas_plus_equivalent_to_serial_strips_i: 
   assumes "ops \<in> set (\<phi>\<^sub>P \<Psi> (embed \<psi>))"
   obtains op where "op \<in> set \<psi>" and "ops = [\<phi>\<^sub>O \<Psi> op]"  
 proof -
   let ?\<psi>' = "embed \<psi>" 
   {
     have "set (\<phi>\<^sub>P \<Psi> (embed \<psi>)) = { [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops]  | ops. ops \<in> set ?\<psi>' }"
       
       unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def  
         SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
         sasp_op_to_strips_def set_map
       using setcompr_eq_image  
       by blast
     moreover obtain ops' where "ops' \<in> set ?\<psi>'" and "ops = [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> ops']" 
       using assms(1) calculation
       by blast
     moreover obtain op where "op \<in> set \<psi>" and "ops = [\<phi>\<^sub>O \<Psi> op]" 
       using embedded_serial_sas_plus_plan_operator_structure calculation(2, 3)
       by blast
     ultimately have "\<exists>op \<in> set \<psi>. ops = [\<phi>\<^sub>O \<Psi> op]"
       by meson
   }
   thus ?thesis 
     using that..
 qed
 
 private lemma serial_sas_plus_equivalent_to_serial_strips_ii[simp]:
   "concat (\<phi>\<^sub>P \<Psi> (embed \<psi>)) = [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]" 
 proof -
   let ?\<psi>' = "List_Supplement.embed \<psi>"
   have "concat (\<phi>\<^sub>P \<Psi> ?\<psi>') = map (\<lambda>op. \<phi>\<^sub>O \<Psi> op) (concat ?\<psi>')" 
     unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
       SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
       sasp_op_to_strips_def
       SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def
       map_concat
     by blast
   also have "\<dots> = map (\<lambda>op. \<phi>\<^sub>O \<Psi> op) \<psi>" 
     unfolding concat_is_inverse_of_embed[of \<psi>]..
   finally show "concat (\<phi>\<^sub>P \<Psi> (embed \<psi>)) = [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]".
 qed
 
 text \<open> Having established the equivalence of parallel STRIPS and SAS+, we can now show the 
 equivalence in the serial case. The proof combines the 
 embedding theorem for serial SAS+ solutions (\ref{isathm:serial-sas-plus-embedding}), the parallel 
 plan equivalence theorem \ref{isathm:equivalence-parallel-sas-plus-parallel-strips}, and the 
 flattening theorem for parallel STRIPS plans (\ref{isathm:embedded-serial-plan-flattening-strips}).
 More precisely, given a serial SAS+ solution \<^term>\<open>\<psi>\<close> for a SAS+ problem \<^term>\<open>\<Psi>\<close>, the embedding 
 theorem confirms that the embedded plan \<^term>\<open>embed \<psi>\<close> is an equivalent parallel solution to
 \<^term>\<open>\<Psi>\<close>. By parallel plan equivalence, \<^term>\<open>\<pi> \<equiv> \<phi>\<^sub>P \<Psi> (embed \<psi>)\<close> is a parallel solution for the 
 corresponding STRIPS problem \<^term>\<open>\<phi> \<Psi>\<close>. Moreover, since \<^term>\<open>embed \<psi>\<close> is a plan consisting of 
 singleton parallel operators, the same is true for \<^term>\<open>\<pi>\<close>. Hence, the flattening lemma applies 
 and \<^term>\<open>concat \<pi>\<close> is a serial solution for \<^term>\<open>\<phi> \<Psi>\<close>. Since \<^term>\<open>concat\<close> moreover can be shown 
 to be the inverse of \<^term>\<open>embed\<close>, the term 
   @{text[display, indent=4] "concat \<pi> = concat (\<phi>\<^sub>P \<Psi> (embed \<psi>))"}
 can be reduced to the intuitive form 
   @{text[display, indent=4] "\<pi> = [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]"}
 which concludes the proof. \<close>
 
 theorem 
   serial_sas_plus_equivalent_to_serial_strips:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "SAS_Plus_Semantics.is_serial_solution_for_problem \<Psi> \<psi>"
   shows "STRIPS_Semantics.is_serial_solution_for_problem (\<phi> \<Psi>) [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]" 
 proof -
   let ?\<psi>' = "embed \<psi>"
     and ?\<Pi> = "\<phi> \<Psi>"
   let ?\<pi>' = "\<phi>\<^sub>P \<Psi> ?\<psi>'"
   let ?\<pi> = "concat ?\<pi>'"
   {
     have "SAS_Plus_Semantics.is_parallel_solution_for_problem \<Psi> ?\<psi>'"
       using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus[OF assms]
       by simp
     hence "STRIPS_Semantics.is_parallel_solution_for_problem ?\<Pi> ?\<pi>'"
       using strips_equivalent_to_sas_plus[OF assms(1)]
       by simp
   }
   moreover have "?\<pi> = [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]"
     by simp
   moreover have "is_valid_problem_strips ?\<Pi>"
       using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)].
   moreover have "\<forall>ops \<in> set ?\<pi>'. \<exists>op \<in> set \<psi>. ops = [\<phi>\<^sub>O \<Psi> op]" 
     using serial_sas_plus_equivalent_to_serial_strips_i[of _ \<Psi> \<psi>]
     by metis
   ultimately show ?thesis
     using STRIPS_Semantics.flattening_lemma[of ?\<Pi>]
     by metis
 qed
 
 
 lemma embedded_serial_strips_plan_operator_structure:
   assumes "ops' \<in> set (embed \<pi>)"
   obtains op 
     where "op \<in> set \<pi>" and "[\<phi>\<^sub>O\<inverse> \<Pi> op. op \<leftarrow> ops'] = [\<phi>\<^sub>O\<inverse> \<Pi> op]"
 proof -
   let ?\<pi>' = "embed \<pi>" 
   {
     have "?\<pi>' = [[op]. op \<leftarrow> \<pi>]"
       by (induction \<pi>; force)
     moreover obtain op where "ops' = [op]" and "op \<in> set \<pi>" 
       using calculation assms 
       by fastforce
     ultimately have "\<exists>op \<in> set \<pi>. [\<phi>\<^sub>O\<inverse> \<Pi> op. op \<leftarrow> ops'] = [\<phi>\<^sub>O\<inverse> \<Pi> op]"
       by auto
   }
   thus ?thesis 
     using that
     by meson
 qed
 
 private lemma serial_strips_equivalent_to_serial_sas_plus_i: 
   assumes "ops \<in> set (\<phi>\<^sub>P\<inverse> \<Pi> (embed \<pi>))"
   obtains op where "op \<in> set \<pi>" and "ops = [\<phi>\<^sub>O\<inverse> \<Pi> op]"  
 proof -
   let ?\<pi>' = "embed \<pi>" 
   {
     have "set (\<phi>\<^sub>P\<inverse> \<Pi> (embed \<pi>)) = { [\<phi>\<^sub>O\<inverse> \<Pi> op. op \<leftarrow> ops]  | ops. ops \<in> set ?\<pi>' }"
       unfolding strips_parallel_plan_to_sas_plus_parallel_plan_def
         SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
         strips_op_to_sasp_def set_map
       using setcompr_eq_image 
       by blast
     moreover obtain ops' where "ops' \<in> set ?\<pi>'" and "ops = [\<phi>\<^sub>O\<inverse> \<Pi> op. op \<leftarrow> ops']" 
       using assms(1) calculation
       by blast
     moreover obtain op where "op \<in> set \<pi>" and "ops = [\<phi>\<^sub>O\<inverse> \<Pi> op]" 
       using embedded_serial_strips_plan_operator_structure calculation(2, 3)
       by blast
     ultimately have "\<exists>op \<in> set \<pi>. ops = [\<phi>\<^sub>O\<inverse> \<Pi> op]" 
       by meson
   }
   thus ?thesis 
     using that..
 qed
 
 private lemma serial_strips_equivalent_to_serial_sas_plus_ii[simp]:
   "concat (\<phi>\<^sub>P\<inverse> \<Pi> (embed \<pi>)) = [\<phi>\<^sub>O\<inverse> \<Pi> op. op \<leftarrow> \<pi>]" 
 proof -
   let ?\<pi>' = "List_Supplement.embed \<pi>"
   have "concat (\<phi>\<^sub>P\<inverse> \<Pi> ?\<pi>') = map (\<lambda>op. \<phi>\<^sub>O\<inverse> \<Pi> op) (concat ?\<pi>')" 
     unfolding strips_parallel_plan_to_sas_plus_parallel_plan_def
       SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
       strips_op_to_sasp_def
       SAS_Plus_STRIPS.strips_op_to_sasp_def Let_def
       map_concat 
     by simp
   also have "\<dots> = map (\<lambda>op. \<phi>\<^sub>O\<inverse> \<Pi> op) \<pi>" 
     unfolding concat_is_inverse_of_embed[of \<pi>]..
   finally show "concat (\<phi>\<^sub>P\<inverse> \<Pi> (embed \<pi>)) = [\<phi>\<^sub>O\<inverse> \<Pi> op. op \<leftarrow> \<pi>]".
 qed
 
 text \<open> Using the analogous lemmas for the opposite direction, we can show the counterpart to 
 theorem \ref{isathm:equivalence-serial-sas-plus-serial-strips} which shows that serial solutions 
 to STRIPS solutions can be transformed to serial SAS+ solutions via composition of embedding, 
 transformation and flattening. \<close>
 
 theorem 
   serial_strips_equivalent_to_serial_sas_plus:
   assumes "is_valid_problem_sas_plus \<Psi>" 
     and "STRIPS_Semantics.is_serial_solution_for_problem (\<phi> \<Psi>) \<pi>"
   shows "SAS_Plus_Semantics.is_serial_solution_for_problem \<Psi> [\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> \<pi>]" 
 proof -
   let ?\<pi>' = "embed \<pi>"
     and ?\<Pi> = "\<phi> \<Psi>"
   let ?\<psi>' = "\<phi>\<^sub>P\<inverse> \<Psi> ?\<pi>'"
   let ?\<psi> = "concat ?\<psi>'"
   {
     have "STRIPS_Semantics.is_parallel_solution_for_problem ?\<Pi> ?\<pi>'"
       using embedding_lemma[OF 
           is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)] assms(2)].
     hence "SAS_Plus_Semantics.is_parallel_solution_for_problem \<Psi> ?\<psi>'"
       using sas_plus_equivalent_to_strips[OF assms(1)]
       by simp
   }
   moreover have "?\<psi> = [\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> \<pi>]"
     by simp
   moreover have "is_valid_problem_strips ?\<Pi>"
       using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)].
   moreover have "\<forall>ops \<in> set ?\<psi>'. \<exists>op \<in> set \<pi>. ops = [\<phi>\<^sub>O\<inverse> \<Psi> op]" 
     using serial_strips_equivalent_to_serial_sas_plus_i
     by metis
   ultimately show ?thesis
     using flattening_lemma[OF assms(1)]
     by metis
 qed
 
 subsection "Equivalence of SAS+ and STRIPS" 
 
 \<comment> \<open> Define the sets of plans with upper length bound as well as the sets of solutions with 
 upper length bound for  SAS problems and induced STRIPS problems.
 
  We keep this polymorphic by not specifying concrete types so it applies to both STRIPS and 
 SAS+ plans. \<close>
 abbreviation bounded_plan_set 
   where "bounded_plan_set ops k \<equiv> { \<pi>. set \<pi> \<subseteq> set ops \<and> length \<pi> = k }"
 
 definition bounded_solution_set_sas_plus' 
   :: "('variable, 'domain) sas_plus_problem 
     \<Rightarrow> nat
     \<Rightarrow> ('variable, 'domain) sas_plus_plan set" 
   where "bounded_solution_set_sas_plus' \<Psi> k 
     \<equiv> { \<psi>. is_serial_solution_for_problem \<Psi> \<psi> \<and> length \<psi> = k}"
 
 abbreviation bounded_solution_set_sas_plus
   :: "('variable, 'domain) sas_plus_problem 
     \<Rightarrow> nat
     \<Rightarrow> ('variable, 'domain) sas_plus_plan set" 
   where "bounded_solution_set_sas_plus \<Psi> N 
     \<equiv> (\<Union>k \<in> {0..N}. bounded_solution_set_sas_plus' \<Psi> k)"
 
 definition bounded_solution_set_strips'
   :: "('variable \<times> 'domain) strips_problem 
     \<Rightarrow> nat
     \<Rightarrow> ('variable \<times> 'domain) strips_plan set" 
   where "bounded_solution_set_strips' \<Pi> k
     \<equiv> { \<pi>. STRIPS_Semantics.is_serial_solution_for_problem \<Pi> \<pi> \<and> length \<pi> = k }"
 
 abbreviation bounded_solution_set_strips
   :: "('variable \<times> 'domain) strips_problem 
     \<Rightarrow> nat 
     \<Rightarrow> ('variable \<times> 'domain) strips_plan set" 
   where "bounded_solution_set_strips \<Pi> N \<equiv> (\<Union>k \<in> {0..N}. bounded_solution_set_strips' \<Pi> k)"
 
 \<comment> \<open> Show that plan transformation for all SAS Plus solutions yields a STRIPS solution for the
 induced STRIPS problem with same length. 
 
 We first show injectiveness of plan transformation \<open>\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]\<close> on the set of plans 
 \<open>P\<^sub>k \<equiv> bounded_plan_set (operators_of \<Psi>) k\<close> with length bound \<open>k\<close>. The injectiveness of 
 \<open>Sol\<^sub>k \<equiv> bounded_solution_set_sas_plus \<Psi> k\<close>---the set of solutions with length bound \<open>k\<close>--then 
 follows from the subset relation \<open>Sol\<^sub>k \<subseteq> P\<^sub>k\<close>. \<close>
 lemma sasp_op_to_strips_injective:
   assumes "(\<phi>\<^sub>O \<Psi> op\<^sub>1) = (\<phi>\<^sub>O \<Psi> op\<^sub>2)"
   shows "op\<^sub>1 = op\<^sub>2" 
   proof  -
     let ?op\<^sub>1' = "\<phi>\<^sub>O \<Psi> op\<^sub>1" 
       and ?op\<^sub>2' = "\<phi>\<^sub>O \<Psi> op\<^sub>2" 
     {
       have "strips_operator.precondition_of ?op\<^sub>1' = strips_operator.precondition_of ?op\<^sub>2'"
         using assms 
         by argo
       hence "sas_plus_operator.precondition_of op\<^sub>1 = sas_plus_operator.precondition_of op\<^sub>2"
         unfolding sasp_op_to_strips_def
           SAS_Plus_STRIPS.sasp_op_to_strips_def
           Let_def 
         by simp
     }
     moreover {
       have "strips_operator.add_effects_of ?op\<^sub>1' = strips_operator.add_effects_of ?op\<^sub>2'"
         using assms 
         unfolding sasp_op_to_strips_def Let_def 
         by argo
       hence "sas_plus_operator.effect_of op\<^sub>1 = sas_plus_operator.effect_of op\<^sub>2"
         unfolding sasp_op_to_strips_def Let_def
           SAS_Plus_STRIPS.sasp_op_to_strips_def
         by simp
     }
     ultimately show ?thesis 
       by simp
   qed
 
 lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_a:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "inj_on (\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]) (bounded_plan_set (sas_plus_problem.operators_of \<Psi>) k)" 
   proof -
     let ?ops = "sas_plus_problem.operators_of \<Psi>"
       (* TODO refactor transformation definitions *)
       and ?\<phi>\<^sub>P = "\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]"
     let ?P = "bounded_plan_set ?ops"
     {
       fix \<psi>\<^sub>1 \<psi>\<^sub>2
       assume \<psi>\<^sub>1_in: "\<psi>\<^sub>1 \<in> ?P k" 
         and \<psi>\<^sub>2_in: "\<psi>\<^sub>2 \<in> ?P k" 
         and \<phi>\<^sub>P_of_\<psi>\<^sub>1_is_\<phi>\<^sub>P_of_\<psi>\<^sub>2: "(?\<phi>\<^sub>P \<psi>\<^sub>1) = (?\<phi>\<^sub>P \<psi>\<^sub>2)"
       hence "\<psi>\<^sub>1 = \<psi>\<^sub>2"
         proof (induction k arbitrary: \<psi>\<^sub>1 \<psi>\<^sub>2)
           case 0
           then have "length \<psi>\<^sub>1 = 0" 
             and "length \<psi>\<^sub>2 = 0" 
             using \<psi>\<^sub>1_in \<psi>\<^sub>2_in
             unfolding bounded_solution_set_sas_plus'_def 
             by blast+
           then show ?case 
             by blast
         next
           case (Suc k)
           moreover have "length \<psi>\<^sub>1 = Suc k" and "length \<psi>\<^sub>2 = Suc k"
             using length_Suc_conv Suc(2, 3) 
             unfolding bounded_solution_set_sas_plus'_def
             by blast+
           moreover obtain op\<^sub>1 \<psi>\<^sub>1' where "\<psi>\<^sub>1 = op\<^sub>1 # \<psi>\<^sub>1'" 
             and "set (op\<^sub>1 # \<psi>\<^sub>1') \<subseteq> set ?ops"
             and "length \<psi>\<^sub>1' = k" 
             using calculation(5) Suc(2)
             unfolding length_Suc_conv
             by blast
           moreover obtain op\<^sub>2 \<psi>\<^sub>2' where "\<psi>\<^sub>2 = op\<^sub>2 # \<psi>\<^sub>2'" 
             and "set (op\<^sub>2 # \<psi>\<^sub>2') \<subseteq> set ?ops" 
             and "length \<psi>\<^sub>2' = k"
             using calculation(6) Suc(3)
             unfolding length_Suc_conv
             by blast
           moreover have "set \<psi>\<^sub>1' \<subseteq> set ?ops" and "set \<psi>\<^sub>2' \<subseteq> set ?ops" 
             using calculation(8, 11) 
             by auto+
           moreover have "\<psi>\<^sub>1' \<in> ?P k" and "\<psi>\<^sub>2' \<in> ?P k"
             using calculation(9, 12, 13, 14)
             by fast+
           moreover have "?\<phi>\<^sub>P \<psi>\<^sub>1' = ?\<phi>\<^sub>P \<psi>\<^sub>2'" 
             using Suc.prems(3) calculation(7, 10) 
             by fastforce
           moreover have "\<psi>\<^sub>1' = \<psi>\<^sub>2'" 
             using Suc.IH[of \<psi>\<^sub>1' \<psi>\<^sub>2', OF calculation(15, 16, 17)]
             by simp
           moreover have "?\<phi>\<^sub>P \<psi>\<^sub>1 = (\<phi>\<^sub>O \<Psi> op\<^sub>1) # ?\<phi>\<^sub>P \<psi>\<^sub>1'" 
             and "?\<phi>\<^sub>P \<psi>\<^sub>2 = (\<phi>\<^sub>O \<Psi> op\<^sub>2) # ?\<phi>\<^sub>P \<psi>\<^sub>2'"
             using Suc.prems(3) calculation(7, 10) 
             by fastforce+
           moreover have "(\<phi>\<^sub>O \<Psi> op\<^sub>1) = (\<phi>\<^sub>O \<Psi> op\<^sub>2)" 
             using Suc.prems(3) calculation(17, 19, 20)
             by simp
           moreover have "op\<^sub>1 = op\<^sub>2" 
             using sasp_op_to_strips_injective[OF calculation(21)].
           ultimately show ?case 
             by argo
         qed
     }
     thus ?thesis 
       unfolding inj_on_def 
       by blast
   qed
 
 private corollary sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "inj_on (\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]) (bounded_solution_set_sas_plus' \<Psi> k)"
   proof -
     let ?ops = "sas_plus_problem.operators_of \<Psi>"
       and ?\<phi>\<^sub>P = "\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]"
     {
       fix \<psi>
       assume "\<psi> \<in> bounded_solution_set_sas_plus' \<Psi> k" 
       then have "set \<psi> \<subseteq> set ?ops" 
         and "length \<psi> = k" 
         unfolding bounded_solution_set_sas_plus'_def is_serial_solution_for_problem_def Let_def 
           list_all_iff ListMem_iff 
         by fast+
       hence "\<psi> \<in> bounded_plan_set ?ops k" 
          by blast
     }
     hence "bounded_solution_set_sas_plus' \<Psi> k \<subseteq> bounded_plan_set ?ops k" 
       by blast
     moreover have "inj_on ?\<phi>\<^sub>P (bounded_plan_set ?ops k)" 
       using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_a[OF assms(1)].
     ultimately show ?thesis
       using inj_on_subset[of ?\<phi>\<^sub>P "bounded_plan_set ?ops k" "bounded_solution_set_sas_plus' \<Psi> k"]
       by fast
   qed
 
 (*
 lemma "card ((\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]) ` (bounded_solution_set_sas_plus' \<Psi> k)) 
   = card (bounded_solution_set_strips' (\<phi> \<Psi>) k)"  sorry
 *)
 
 \<comment> \<open> Show that mapping plan transformation \<open>\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]\<close> over the solution set for a 
 given SAS+ problem yields the solution set for the induced STRIPS problem. \<close>
 private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "(\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]) ` (bounded_solution_set_sas_plus' \<Psi> k) 
     = bounded_solution_set_strips' (\<phi> \<Psi>) k" 
  proof -
    let ?\<Pi> = "\<phi> \<Psi>"
      and ?\<phi>\<^sub>P = "\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]"
    let ?Sol\<^sub>k = "bounded_solution_set_sas_plus' \<Psi> k"
     and ?Sol\<^sub>k' = "bounded_solution_set_strips' ?\<Pi> k"
    {
      assume "?\<phi>\<^sub>P ` ?Sol\<^sub>k \<noteq> ?Sol\<^sub>k'" 
      then consider (A) "\<exists>\<pi> \<in> ?\<phi>\<^sub>P ` ?Sol\<^sub>k. \<pi> \<notin> ?Sol\<^sub>k'"
        | (B) "\<exists>\<pi> \<in> ?Sol\<^sub>k'. \<pi> \<notin>  ?\<phi>\<^sub>P ` ?Sol\<^sub>k"
        by blast
      hence False 
        proof (cases)
          case A
          moreover obtain \<pi> where "\<pi> \<in> ?\<phi>\<^sub>P ` ?Sol\<^sub>k" and "\<pi> \<notin> ?Sol\<^sub>k'"
            using calculation
            by blast
          moreover obtain \<psi> where "length \<psi> = k" 
            and "SAS_Plus_Semantics.is_serial_solution_for_problem \<Psi> \<psi>" 
            and "\<pi> = ?\<phi>\<^sub>P \<psi>" 
            using calculation(2)
            unfolding bounded_solution_set_sas_plus'_def 
            by blast
          moreover have "length \<pi> = k" and "STRIPS_Semantics.is_serial_solution_for_problem ?\<Pi> \<pi>"
            subgoal 
              using calculation(4, 6) by auto
            subgoal
              using serial_sas_plus_equivalent_to_serial_strips
                assms(1) calculation(5) calculation(6) 
              by blast
            done
          moreover have "\<pi> \<in> ?Sol\<^sub>k'" 
            unfolding bounded_solution_set_strips'_def 
            using calculation(7, 8) 
            by simp
          ultimately show ?thesis
            by fast
        next
          case B
          moreover obtain \<pi> where "\<pi> \<in> ?Sol\<^sub>k'" and "\<pi> \<notin> ?\<phi>\<^sub>P ` ?Sol\<^sub>k"
            using calculation
            by blast
          moreover have "STRIPS_Semantics.is_serial_solution_for_problem ?\<Pi> \<pi>"
            and "length \<pi> = k"
            using calculation(2)
            unfolding bounded_solution_set_strips'_def 
            by simp+
          \<comment> \<open> Construct the counter example \<open>\<psi> \<equiv> [\<phi>\<^sub>O\<inverse> ?\<Pi> op. op \<leftarrow> \<pi>]\<close> and show that \<open>\<psi> \<in> ?Sol\<^sub>k\<close>
             as well as \<open>?\<phi>\<^sub>P \<psi> = \<pi>\<close> hence \<open>\<pi> \<in> ?\<phi>\<^sub>P ` ?Sol\<^sub>k\<close>. \<close>
          moreover have "length [\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> \<pi>] = k"
            and "SAS_Plus_Semantics.is_serial_solution_for_problem \<Psi> [\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> \<pi>]" 
            subgoal 
              using calculation(5) 
              by simp
            subgoal 
              using serial_strips_equivalent_to_serial_sas_plus[OF assms(1)] 
                calculation(4)
              by simp
            done
          moreover have "[\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> \<pi>] \<in> ?Sol\<^sub>k" 
            unfolding bounded_solution_set_sas_plus'_def 
            using calculation(6, 7) 
            by blast
          (* TODO refactor transformation lemmas *)
          moreover {
            have "\<forall>op \<in> set \<pi>. op \<in> set ((?\<Pi>)\<^sub>\<O>)"
              using calculation(4)
              unfolding STRIPS_Semantics.is_serial_solution_for_problem_def list_all_iff ListMem_iff
              by simp
            hence "?\<phi>\<^sub>P [\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> \<pi>] = \<pi>" 
              proof (induction \<pi>)
                case (Cons op \<pi>)
                moreover have "?\<phi>\<^sub>P [\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> op # \<pi>] 
                 = (\<phi>\<^sub>O \<Psi> (\<phi>\<^sub>O\<inverse> \<Psi> op)) # ?\<phi>\<^sub>P [\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> \<pi>]"
                  by simp
                moreover have "op \<in>  set ((?\<Pi>)\<^sub>\<O>)" 
                  using Cons.prems
                  by simp
                moreover have "(\<phi>\<^sub>O \<Psi> (\<phi>\<^sub>O\<inverse> \<Psi> op)) = op"
                  using strips_operator_inverse_is[OF assms(1) calculation(4)].
                moreover have "?\<phi>\<^sub>P [\<phi>\<^sub>O\<inverse> \<Psi> op. op \<leftarrow> \<pi>] = \<pi>" 
                  using Cons.IH Cons.prems 
                  by auto
                ultimately show ?case 
                  by argo
              qed simp
          }
          moreover have "\<pi> \<in> ?\<phi>\<^sub>P ` ?Sol\<^sub>k" 
            using calculation(8, 9) 
            by force
          ultimately show ?thesis
            by blast
       qed
    }
    thus ?thesis 
      by blast
   qed
 
 private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_d:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "card (bounded_solution_set_sas_plus' \<Psi> k) \<le> card (bounded_solution_set_strips' (\<phi> \<Psi>) k)"
   proof -
     let ?\<Pi> = "\<phi> \<Psi>"
       and ?\<phi>\<^sub>P = "\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]"
     let ?Sol\<^sub>k = "bounded_solution_set_sas_plus' \<Psi> k"
       and ?Sol\<^sub>k' = "bounded_solution_set_strips' ?\<Pi> k"
     have "card (?\<phi>\<^sub>P ` ?Sol\<^sub>k) = card (?Sol\<^sub>k)"
      using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b[OF assms(1)] 
        card_image 
      by blast
     moreover have "?\<phi>\<^sub>P ` ?Sol\<^sub>k = ?Sol\<^sub>k'"
      using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c[OF assms(1)].
     ultimately show ?thesis 
      by simp
   qed
 
 \<comment> \<open> The set of fixed length plans with operators in a given operator set is finite. \<close>
 lemma bounded_plan_set_finite:
   shows "finite { \<pi>. set \<pi> \<subseteq> set ops \<and> length \<pi> = k }"
   proof (induction k)
     case (Suc k)
     let ?P = "{ \<pi>. set \<pi> \<subseteq> set ops \<and> length \<pi> = k }"
       and ?P' = "{ \<pi>. set \<pi> \<subseteq> set ops \<and> length \<pi> = Suc k }"  
     let ?P'' = "(\<Union>op \<in> set ops. (\<Union>\<pi> \<in> ?P. { op # \<pi> }))" 
     {
       have "\<forall>op \<pi>. finite { op # \<pi> }"
         by simp
       then have "\<forall>op. finite (\<Union>\<pi> \<in> ?P. { op # \<pi> })" 
         using finite_UN[of ?P] Suc 
         by blast
       hence "finite ?P''" 
         using finite_UN[of "set ops"]
         by blast
     }
     moreover {
       {
         fix \<pi>
         assume "\<pi> \<in> ?P'"
         moreover have "set \<pi> \<subseteq> set ops" 
           and "length \<pi> = Suc k" 
           using calculation 
           by simp+
         moreover obtain op \<pi>' where "\<pi> = op # \<pi>'" 
           using calculation (3)
           unfolding length_Suc_conv 
           by fast
         moreover have "set \<pi>' \<subseteq> set ops" and "op \<in> set ops"
           using calculation(2, 4) 
           by simp+
         moreover have "length \<pi>' = k"
           using calculation(3, 4) 
           by auto
         moreover have "\<pi>' \<in> ?P" 
           using calculation(5, 7)
           by blast
         ultimately have "\<pi> \<in> ?P''"
           by blast
       }
       hence "?P' \<subseteq> ?P''"
         by blast
     }
     ultimately show ?case 
       using rev_finite_subset[of ?P'' ?P']
       by blast
   qed force
 
 \<comment> \<open> The set of fixed length SAS+ solutions are subsets of the set of plans with fixed length and 
 therefore also finite. \<close>
 private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_a:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "finite (bounded_solution_set_sas_plus' \<Psi> k)"
 proof -
   let ?Ops = "set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
   let ?Sol\<^sub>k = "bounded_solution_set_sas_plus' \<Psi> k"
     and ?P\<^sub>k = "{ \<pi>. set \<pi> \<subseteq> ?Ops \<and> length \<pi> = k }"
   {
     fix \<psi>
     assume "\<psi> \<in> ?Sol\<^sub>k"
     then have "length \<psi> = k" and "set \<psi> \<subseteq> ?Ops"
       unfolding bounded_solution_set_sas_plus'_def 
         SAS_Plus_Semantics.is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
       by fastforce+
     hence "\<psi> \<in> ?P\<^sub>k" 
       by blast
   }
   then have "?Sol\<^sub>k \<subseteq> ?P\<^sub>k" 
     by force
   thus ?thesis
-    using bounded_plan_set_finite rev_finite_subset[of ?P\<^sub>k ?Sol\<^sub>k]
-    by auto
+    using bounded_plan_set_finite rev_finite_subset[of ?P\<^sub>k ?Sol\<^sub>k] by blast
 qed
 
 \<comment> \<open> The set of fixed length STRIPS solutions are subsets of the set of plans with fixed length and 
 therefore also finite. \<close>
 private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_b:
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "finite (bounded_solution_set_strips' (\<phi> \<Psi>) k)"
 proof -
   let ?\<Pi> = "\<phi> \<Psi>"
   let ?Ops = "set ((?\<Pi>)\<^sub>\<O>)"
   let ?Sol\<^sub>k = "bounded_solution_set_strips' ?\<Pi> k"
     and ?P\<^sub>k = "{ \<pi>. set \<pi> \<subseteq> ?Ops \<and> length \<pi> = k }"
   {
     fix \<pi>
     assume "\<pi> \<in> ?Sol\<^sub>k"
     then have "length \<pi> = k" and "set \<pi> \<subseteq> ?Ops"
       unfolding bounded_solution_set_strips'_def 
         STRIPS_Semantics.is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
       by fastforce+
     hence "\<pi> \<in> ?P\<^sub>k" 
       by blast
   }
   then have "?Sol\<^sub>k \<subseteq> ?P\<^sub>k" 
     by force
   thus ?thesis
     using bounded_plan_set_finite rev_finite_subset[of ?P\<^sub>k ?Sol\<^sub>k] 
     unfolding state_to_strips_state_def
       SAS_Plus_STRIPS.state_to_strips_state_def operators_of_def
     by blast
 qed
 
 text \<open> With the results on the equivalence of SAS+ and STRIPS solutions, we can now show that given 
 problems in both formalisms, the solution sets have the same size.
 This is the property required by the definition of planning formalism equivalence presented earlier 
 in theorem \ref{thm:solution-sets-sas-plus-strips-f} (\autoref{sub:equivalence-sas-plus-strips}) and 
 thus end up with the desired equivalence result.
 
 The proof uses the finiteness and disjunctiveness of the solution sets for either problem to be 
 able to equivalently transform the set cardinality over the union of sets of solutions with bounded 
 lengths into a sum over the cardinality of the sets of solutions with bounded length. Moreover, 
 since we know that for each SAS+ solution with a given length an equivalent STRIPS solution exists 
 in the solution set of the transformed problem with the same length, both sets must have the same 
 cardinality. 
 
 Hence the cardinality of the  SAS+ solution set over all lengths up to a given upper bound \<^term>\<open>N\<close> 
 has the same size as the solution set of the corresponding STRIPS problem over all length up to a 
 given upper bound \<^term>\<open>N\<close>. \<close>
 
 theorem
   assumes "is_valid_problem_sas_plus \<Psi>"
   shows "card (bounded_solution_set_sas_plus \<Psi> N) 
     = card (bounded_solution_set_strips (\<phi> \<Psi>) N)" 
   proof -
     let ?\<Pi> = "\<phi> \<Psi>"
       and ?R = "{0..N}" 
     \<comment> \<open> Due to the disjoint nature of the bounded solution sets for fixed plan length for different 
     lengths, we can sum the individual set cardinality to obtain the cardinality of the overall SAS+ 
     resp. STRIPS solution sets. \<close>
     have finite_R: "finite ?R" 
       by simp
     moreover {
       have "\<forall>k \<in> ?R. finite (bounded_solution_set_sas_plus' \<Psi> k)" 
         using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_a[OF 
             assms(1)]..
       moreover have "\<forall>j \<in> ?R. \<forall>k \<in> ?R. j \<noteq> k 
         \<longrightarrow> bounded_solution_set_sas_plus' \<Psi> j 
           \<inter> bounded_solution_set_sas_plus' \<Psi> k = {}"
         unfolding bounded_solution_set_sas_plus'_def 
         by blast
       (* TODO slow. *)
       ultimately have "card (bounded_solution_set_sas_plus \<Psi> N)
         = (\<Sum>k \<in> ?R. card (bounded_solution_set_sas_plus' \<Psi> k))"
         using card_UN_disjoint 
         by blast
     }
     moreover {
       have "\<forall>k \<in> ?R. finite (bounded_solution_set_strips' ?\<Pi> k)" 
         using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_b[OF 
             assms(1)]..
       moreover have "\<forall>j \<in> ?R. \<forall>k \<in> ?R. j \<noteq> k 
         \<longrightarrow> bounded_solution_set_strips' ?\<Pi> j 
           \<inter> bounded_solution_set_strips' ?\<Pi> k = {}"
         unfolding bounded_solution_set_strips'_def
         by blast
       (* TODO slow. *)
       ultimately have "card (bounded_solution_set_strips ?\<Pi> N)
         = (\<Sum>k \<in> ?R. card (bounded_solution_set_strips' ?\<Pi> k))"
         using card_UN_disjoint
         by blast
     }
     moreover {
       fix k
       have "card (bounded_solution_set_sas_plus' \<Psi> k)
         = card ((\<lambda>\<psi>. [\<phi>\<^sub>O \<Psi> op. op \<leftarrow> \<psi>]) 
           ` bounded_solution_set_sas_plus' \<Psi> k)"
         using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b[OF assms]
           card_image[symmetric] 
         by blast
       hence "card (bounded_solution_set_sas_plus' \<Psi> k)
         = card (bounded_solution_set_strips' ?\<Pi> k)" 
         using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c[OF assms]
         by presburger
     } 
     ultimately show ?thesis
       by presburger
   qed
 
 
 end
 
 end
\ No newline at end of file