header {* Linear Combinations *}

theory LinearCombinations
imports Main
  "~~/src/HOL/Algebra/Module"
  "~~/src/HOL/Algebra/Coset"
  RingModuleFacts
  MonoidSums
  FunctionLemmas
begin

subsection {*Lemmas for simplification *}
text {*The following are helpful in certain simplifications (esp. congruence rules). Warning: arbitrary
use leads to looping. *}
lemma (in ring) coeff_in_ring:
  "\<lbrakk>a\<in>A\<rightarrow>carrier R; x\<in>A\<rbrakk> \<Longrightarrow> a x \<in>carrier R"
by (rule Pi_mem)

lemma (in ring) coeff_in_ring2:
  "\<lbrakk> x\<in>A;a\<in>A\<rightarrow>carrier R\<rbrakk> \<Longrightarrow> a x \<in>carrier R"
by (metis Pi_mem)

lemma ring_subset_carrier:
  "\<lbrakk>x \<in>A; A\<subseteq>carrier R\<rbrakk> \<Longrightarrow> x \<in>carrier R"
by auto

lemma disj_if:
  "\<lbrakk>A\<inter>B={}; x\<in> B\<rbrakk> \<Longrightarrow> (if x\<in>A then f x else g x) = g x"
by auto

lemmas (in module) sum_simp = ring_subset_carrier

subsection {* Linear combinations*}
text {*A linear combination is $\sum_{v\in A} a_v v$. $(a_v)_{v\in S}$ is a function
$A\to K$, where $A\subseteq K$.*}
definition (in module) lincomb::"['c \<Rightarrow> 'a, 'c set]\<Rightarrow> 'c"
where "lincomb a A = (\<Oplus>\<^bsub>M\<^esub>  v\<in>A. (a v \<odot>\<^bsub>M\<^esub> v))"

lemma (in module) summands_valid:
  fixes A a
  assumes h2: "A\<subseteq> carrier M" and h3: "a\<in>(A\<rightarrow>carrier R)"
  shows "\<forall> v\<in> A. (((a v) \<odot>\<^bsub>M\<^esub> v)\<in> carrier M)"
proof -
  from assms show ?thesis by auto
qed

lemma (in module) lincomb_closed [simp, intro]:
  fixes S a
  assumes h1: "finite S" and h2: "S\<subseteq> carrier M" and h3: "a\<in>(S\<rightarrow>carrier R)"
  shows "lincomb a S \<in> carrier M"
proof -
  from h1 h2 h3 show ?thesis by (unfold lincomb_def, auto intro:finsum_closed)
(*doesn't work with simp*)
qed

lemma (in comm_monoid) finprod_cong2:
  "[| A = B;
      !!i. i \<in> B ==> f i = g i; f \<in> B -> carrier G|] ==>
finprod G f A = finprod G g B"
by (intro finprod_cong, auto)

lemmas (in abelian_monoid) finsum_cong2 = add.finprod_cong2

lemma (in module) lincomb_cong:
  assumes h1: "finite (A)"  and h2: "A=B" and h3: "A \<subseteq> carrier M"
    and h4: "\<And>v. v\<in>A \<Longrightarrow> a v = b v" and h5: "b\<in> B\<rightarrow>carrier R"
  shows "lincomb a A = lincomb b B"
using assms
    by (simp cong: finsum_cong2 add: lincomb_def summands_valid ring_subset_carrier)

lemma (in module) lincomb_union:
  fixes a A B
  assumes h1: "finite (A\<union> B)"  and h3: "A\<union>B \<subseteq> carrier M"
    and h4: "A\<inter>B={}" and h5: "a\<in>(A\<union>B\<rightarrow>carrier R)"
  shows "lincomb a (A\<union>B) = lincomb a A \<oplus>\<^bsub>M\<^esub> lincomb a B"
using assms
  by (auto cong: finsum_cong2 simp add: lincomb_def finsum_Un_disjoint summands_valid ring_subset_carrier)

text {*This is useful as a simp rule sometimes, for combining linear combinations.*}
lemma (in module) lincomb_union2:
  fixes a b A B
  assumes h1: "finite (A\<union> B)"  and h3: "A\<union>B \<subseteq> carrier M"
    and h4: "A\<inter>B={}" and h5: "a\<in>A\<rightarrow>carrier R" and h6: "b\<in>B\<rightarrow>carrier R"
  shows "lincomb a A \<oplus>\<^bsub>M\<^esub> lincomb b B = lincomb (\<lambda>v. if (v\<in>A) then a v else b v) (A\<union>B)"
    (is "lincomb a A \<oplus>\<^bsub>M\<^esub> lincomb b B = lincomb ?c (A\<union>B)")
using assms
  by (auto cong: finsum_cong2
        simp add: lincomb_def finsum_Un_disjoint summands_valid ring_subset_carrier disj_if)

lemma (in module) lincomb_del2:
  fixes S a v
  assumes h1: "finite S" and h2: "S\<subseteq> carrier M" and h3: "a\<in>(S\<rightarrow>carrier R)" and h4:"v\<in>S"
  shows "lincomb a S = ((a v) \<odot>\<^bsub>M\<^esub> v) \<oplus>\<^bsub>M\<^esub> lincomb a (S-{v})"
proof -
  from h4 have 1: "S={v}\<union>(S-{v})" by (metis insert_Diff insert_is_Un)
  from assms show ?thesis
    apply (subst 1)
    apply (subst lincomb_union, auto)
    by (unfold lincomb_def, auto simp add: coeff_in_ring)
qed

(*alternate form of the above*)
lemma (in module) lincomb_insert:
  fixes S a v
  assumes h1: "finite S" and h2: "S\<subseteq> carrier M" and h3: "a\<in>(S\<union>{v}\<rightarrow>carrier R)" and h4:"v\<notin>S" and
h5:"v\<in> carrier M"
  shows "lincomb a (S\<union>{v}) = ((a v) \<odot>\<^bsub>M\<^esub> v) \<oplus>\<^bsub>M\<^esub> lincomb a S"
using assms
  by (auto cong: finsum_cong2
        simp add: lincomb_def finsum_Un_disjoint summands_valid ring_subset_carrier disj_if)

lemma (in module) lincomb_elim_if [simp]:
  fixes b c S
  assumes h0:"finite S" and h1: "S \<subseteq> carrier M" and h2: "\<And>v. v\<in>S\<Longrightarrow> \<not>P v" and h3: "c\<in>S\<rightarrow>carrier R"
  shows "lincomb (\<lambda>w. if P w then b w else c w) S = lincomb c S"
using assms
  by (auto cong: finsum_cong2
        simp add: lincomb_def finsum_Un_disjoint summands_valid ring_subset_carrier disj_if)

lemma (in module) lincomb_smult:
  fixes A c
  assumes h1: "finite A" and h2: "A\<subseteq>carrier M"  and h3: "a\<in>A\<rightarrow>carrier R" and h4: "c\<in>carrier R"
  shows "lincomb (\<lambda>w. c\<otimes>\<^bsub>R\<^esub> a w) A = c\<odot>\<^bsub>M\<^esub> (lincomb a A)"
using assms
  by (auto cong: finsum_cong2
        simp add: lincomb_def finsum_Un_disjoint finsum_smult ring_subset_carrier disj_if smult_assoc1 coeff_in_ring)

subsection {*Linear dependence and independence.*}
text {*A set $S$ in a module/vectorspace is linearly dependent if there is a finite set $A \subseteq S$
 and coefficients $(a_v)_{v\in A}$ such that $sum_{v\in A} a_vv=0$ and for some $v$, $a_v\neq 0$.*}
definition (in module) lin_dep where
  "lin_dep S = (\<exists>A a v. (finite A \<and> A\<subseteq>S \<and> (a\<in> (A\<rightarrow>carrier R)) \<and> (lincomb a A = \<zero>\<^bsub>M\<^esub>) \<and> (v\<in>A) \<and> (a v\<noteq> \<zero>\<^bsub>R\<^esub>)))"
  (*shows "\<exists>a. (a\<in> (S\<rightarrow>carrier K)) \<and> (lincomb a S = \<zero>\<^bsub>V\<^esub>) \<and> (\<exists>v\<in>S. a v\<noteq> \<zero>\<^bsub>K\<^esub>)"*)

abbreviation (in module) lin_indpt::"'c set \<Rightarrow> bool"
  where "lin_indpt S \<equiv> \<not>lin_dep S"

text {*In the finite case, we can take $A=S$. This may be more convenient (e.g., when adding two
linear combinations.*}
lemma (in module) finite_lin_dep:
  fixes S
  assumes finS:"finite S" and ld: "lin_dep S" and inC: "S\<subseteq>carrier M"
  shows "\<exists>a v. (a\<in> (S\<rightarrow>carrier R)) \<and> (lincomb a S = \<zero>\<^bsub>M\<^esub>) \<and> (v\<in>S) \<and> (a v\<noteq> \<zero>\<^bsub>R\<^esub>)"
proof -
  from ld obtain A a v where A: "(A\<subseteq>S \<and> (a\<in> (A\<rightarrow>carrier R)) \<and> (lincomb a A = \<zero>\<^bsub>M\<^esub>) \<and> (v\<in>A) \<and> (a v\<noteq> \<zero>\<^bsub>R\<^esub>))"
    by (unfold lin_dep_def, auto)
  let ?b="\<lambda>w. if w\<in>A then a w else \<zero>\<^bsub>R\<^esub>" (*extend the coefficients to be 0 outside of A*)
  from finS inC A have if_in: "(\<Oplus>\<^bsub>M\<^esub>v\<in>S. (if v \<in> A then a v else \<zero>) \<odot>\<^bsub>M\<^esub> v) = (\<Oplus>\<^bsub>M\<^esub>v\<in>S. (if v \<in> A then a v \<odot>\<^bsub>M\<^esub> v else \<zero>\<^bsub>M\<^esub>))"
    apply auto
      apply (intro finsum_cong')
    by (auto simp add: coeff_in_ring)  (*massage the sum*)
  from finS inC A have b: "lincomb ?b S = \<zero>\<^bsub>M\<^esub>"
    apply (unfold lincomb_def)
    apply (subst if_in)
    by (subst extend_sum, auto)
  from A b show ?thesis
    apply (rule_tac x="?b" in exI)
    apply (rule_tac x="v" in exI)
    by auto
qed

text {*Criteria of linear dependency in a easy format to apply: apply (rule lin-dep-crit)*}
lemma (in module) lin_dep_crit:
  fixes A S a v
  assumes fin: "finite A" and subset: "A\<subseteq>S" and h1: "(a\<in> (A\<rightarrow>carrier R))" and h2: "v\<in> A"
    and h3:"a v\<noteq> \<zero>\<^bsub>R\<^esub>" and h4: "(lincomb a A = \<zero>\<^bsub>M\<^esub>)"
  shows "lin_dep S"
proof -
  from assms show ?thesis
    by (unfold lin_dep_def, auto)
qed

text {*If $\sum_{v\in A} a_vv=0$ implies $a_v=0$ for all $v\in S$, then $A$ is linearly independent.*}
lemma (in module) finite_lin_indpt2:
  fixes A
  assumes A_fin: "finite A" and AinC: "A\<subseteq>carrier M" and
    lc0: "\<And>a. a\<in> (A\<rightarrow>carrier R) \<Longrightarrow> (lincomb a A = \<zero>\<^bsub>M\<^esub>) \<Longrightarrow> (\<forall> v\<in>A. a v= \<zero>\<^bsub>R\<^esub>)"
  shows "lin_indpt A"
proof (rule ccontr)
  assume "\<not>lin_indpt A"
  from A_fin AinC this obtain a v where av:
    "(a\<in> (A\<rightarrow>carrier R)) \<and> (lincomb a A = \<zero>\<^bsub>M\<^esub>) \<and> (v\<in>A) \<and> (a v\<noteq> \<zero>\<^bsub>R\<^esub>)"
    by (metis finite_lin_dep)
  from av lc0 show False by auto
qed

text {*Any set containing 0 is linearly dependent.*}
lemma (in module) zero_lin_dep:
  assumes 0: "\<zero>\<^bsub>M\<^esub> \<in> S" and nonzero: "carrier R \<noteq> {\<zero>\<^bsub>R\<^esub>}"
  shows "lin_dep S"
proof -
  from nonzero have zero_not_one: "\<zero>\<^bsub>R\<^esub> \<noteq> \<one>\<^bsub>R\<^esub>" by (rule nontrivial_ring)
  from 0 zero_not_one show ?thesis
    apply (unfold lin_dep_def)
    apply (rule_tac x="{\<zero>\<^bsub>M\<^esub>}" in exI)
    apply (rule_tac x="(\<lambda>v. \<one>\<^bsub>R\<^esub>)" in exI)
    apply (rule_tac x="\<zero>\<^bsub>M\<^esub>" in exI)
    by (unfold lincomb_def, auto)
qed

lemma (in module) zero_nin_lin_indpt:
  assumes h2: "S\<subseteq>carrier M" and li: "\<not>(lin_dep S)" and nonzero: "carrier R \<noteq> {\<zero>\<^bsub>R\<^esub>}"
  shows "\<zero>\<^bsub>M\<^esub> \<notin> S"
proof (rule ccontr)
  assume a1: "\<not>(\<zero>\<^bsub>M\<^esub> \<notin> S)"
  from a1 have a2: "\<zero>\<^bsub>M\<^esub> \<in> S" by auto
  from a2 nonzero have ld: "lin_dep S" by (rule zero_lin_dep)
  from li ld show False by auto
qed

text {*The @{text "span"} of $S$ is the set of linear combinations with $A \subseteq S$.*}
definition (in module) span::"'c set \<Rightarrow>'c set"
  where "span S = {lincomb a A | a A. finite A \<and> A\<subseteq>S \<and> a\<in> (A\<rightarrow>carrier R)}"

text {*The @{text "span"} interpreted as a module or vectorspace.*}
abbreviation (in module) span_vs::"'c set \<Rightarrow> ('a,'c,'d) module_scheme"
  where "span_vs S \<equiv> M \<lparr>carrier := span S\<rparr>"

text {*In the finite case, we can take $A=S$ without loss of generality.*}
lemma (in module) finite_span:
  assumes fin: "finite S" and inC: "S\<subseteq>carrier M"
  shows "span S = {lincomb a S | a. a\<in> (S\<rightarrow>carrier R)}"
proof (rule equalityI)
  {
    fix A a
    assume subset: "A \<subseteq> S" and   a: "a \<in> A \<rightarrow> carrier R"
    let ?b="(\<lambda>v. if v \<in> A then a v else \<zero>)"
    from fin inC subset a have if_in: "(\<Oplus>\<^bsub>M\<^esub>v\<in>S. ?b v \<odot>\<^bsub>M\<^esub> v) = (\<Oplus>\<^bsub>M\<^esub>v\<in>S. (if v \<in> A then a v \<odot>\<^bsub>M\<^esub> v else \<zero>\<^bsub>M\<^esub>))"
      apply (intro finsum_cong')
        by (auto simp add: coeff_in_ring)  (*massage the sum*)
    from fin inC subset a have "\<exists>b. lincomb a A = lincomb b S \<and> b \<in> S \<rightarrow> carrier R"
      apply (rule_tac x="?b" in exI)
      apply (unfold lincomb_def, auto)
      apply (subst if_in)
      by (subst extend_sum, auto)
  }
  from this show "span S \<subseteq> {lincomb a S |a. a \<in> S \<rightarrow> carrier R}"
    by (unfold span_def, auto)
next
  from fin show "{lincomb a S |a. a \<in> S \<rightarrow> carrier R} \<subseteq> span S"
    by (unfold span_def, auto)
qed

text {*If $v\in \text{span S}$, then we can find a linear combination. This is in an easy to apply
format (e.g. obtain a A where\ldots)*}
lemma (in module) in_span:
  fixes S v
  assumes  h2: "S\<subseteq>carrier V" and h3: "v\<in>span S"
  shows "\<exists>a A. (A\<subseteq>S \<and> (a\<in>A\<rightarrow>carrier R) \<and> (lincomb a A=v))"
proof -
  from h2 h3 show ?thesis
    apply (unfold span_def)
    by auto
qed

text {*In the finite case, we can take $A=S$.*}
lemma (in module) finite_in_span:
  fixes S v
  assumes fin: "finite S" and h2: "S\<subseteq>carrier M" and h3: "v\<in>span S"
  shows "\<exists>a. (a\<in>S\<rightarrow>carrier R) \<and> (lincomb a S=v)"
proof -
  from fin h2 have fin_span: "span S = {lincomb a S |a. a \<in> S \<rightarrow> carrier R}" by (rule finite_span)
  from h3 fin_span show ?thesis by auto
qed

text {*If a subset is linearly independent, then any linear combination that is 0 must have a
nonzero coefficient outside that set.*}
lemma (in module) lincomb_must_include:
  fixes A S T b v
  assumes  inC: "T\<subseteq>carrier M" and li: "lin_indpt S" and Ssub: "S\<subseteq>T" and Ssub: "A\<subseteq>T"
    and fin: "finite A"
    and b: "b\<in>A\<rightarrow>carrier R" and lc: "lincomb b A=\<zero>\<^bsub>M\<^esub>" and v_in: "v\<in>A"
    and nz_coeff: "b v\<noteq>\<zero>\<^bsub>R\<^esub>"
  shows "\<exists>w\<in>A-S. b w\<noteq>\<zero>\<^bsub>R\<^esub>"
proof (rule ccontr)
  (*we may assume B doesn't intersect A.*)
  assume 0: "\<not>(\<exists> w\<in>A-S. b w\<noteq>\<zero>\<^bsub>R\<^esub>)"
  from 0 have 1: "\<And>w. w\<in>A-S\<Longrightarrow> b w=\<zero>\<^bsub>R\<^esub>" by auto
  have Auni: "A=(S\<inter>A) \<union>(A-S)" by auto
  from fin b Ssub inC 1 have 2: "lincomb b A = lincomb b (S\<inter>A)"(* \<oplus>\<^bsub>M\<^esub> lincomb b ((-S)\<inter>A)*)
    apply (subst Auni)
    apply (subst lincomb_union, auto)
    (*apply (intro r_zero)*)
    apply (unfold lincomb_def)
    apply (subst (2) finsum_all0, auto)
    by (subst show_r_zero, auto intro!: finsum_closed)
  from 1 2 assms have ld: "lin_dep S"
    apply (intro lin_dep_crit[where ?A="S\<inter>A" and ?a="b" and ?v="v"])
    by auto
  from ld li show False by auto
qed

text {*A generating set is a set such that the span of $S$ is all of $M$.*}
abbreviation (in module) gen_set::"'c set \<Rightarrow> bool"
  where "gen_set S \<equiv> (span S = carrier M)"

subsection {*Submodules*}

lemma module_criteria:
  fixes R and M
  assumes cring: "cring R"
      and zero: "\<zero>\<^bsub>M\<^esub>\<in> carrier M"
      and add: "\<forall>v w. v\<in>carrier M \<and> w\<in>carrier M\<longrightarrow> v\<oplus>\<^bsub>M\<^esub> w\<in> carrier M"
      and neg: "\<forall>v\<in>carrier M. (\<exists>neg_v\<in>carrier M. v\<oplus>\<^bsub>M\<^esub>neg_v=\<zero>\<^bsub>M\<^esub>)"
      and smult: "\<forall>c v. c\<in> carrier R \<and> v\<in>carrier M\<longrightarrow> c\<odot>\<^bsub>M\<^esub> v \<in> carrier M"
      and comm: "\<forall>v w. v\<in>carrier M \<and> w\<in>carrier M\<longrightarrow> v\<oplus>\<^bsub>M\<^esub> w=w\<oplus>\<^bsub>M\<^esub> v"
      and assoc: "\<forall>v w x. v\<in>carrier M \<and> w\<in>carrier M \<and> x\<in>carrier M\<longrightarrow> (v\<oplus>\<^bsub>M\<^esub> w)\<oplus>\<^bsub>M\<^esub> x= v\<oplus>\<^bsub>M\<^esub> (w\<oplus>\<^bsub>M\<^esub> x)"
      and add_id: "\<forall>v\<in>carrier M. (v\<oplus>\<^bsub>M\<^esub> \<zero>\<^bsub>M\<^esub> =v)"
      and compat: "\<forall>a b v. a\<in> carrier R \<and> b\<in> carrier R \<and> v\<in>carrier M\<longrightarrow> (a\<otimes>\<^bsub>R\<^esub> b)\<odot>\<^bsub>M\<^esub> v =a\<odot>\<^bsub>M\<^esub> (b\<odot>\<^bsub>M\<^esub> v)"
      and smult_id: "\<forall>v\<in>carrier M. (\<one>\<^bsub>R\<^esub> \<odot>\<^bsub>M\<^esub> v =v)"
      and dist_f: "\<forall>a b v. a\<in> carrier R \<and> b\<in> carrier R \<and> v\<in>carrier M\<longrightarrow> (a\<oplus>\<^bsub>R\<^esub> b)\<odot>\<^bsub>M\<^esub> v =(a\<odot>\<^bsub>M\<^esub> v) \<oplus>\<^bsub>M\<^esub> (b\<odot>\<^bsub>M\<^esub> v)"
      and dist_add: "\<forall>a v w. a\<in> carrier R \<and> v\<in>carrier M \<and> w\<in>carrier M\<longrightarrow> a\<odot>\<^bsub>M\<^esub> (v\<oplus>\<^bsub>M\<^esub> w) =(a\<odot>\<^bsub>M\<^esub> v) \<oplus>\<^bsub>M\<^esub> (a\<odot>\<^bsub>M\<^esub> w)"
  shows "module R M"
proof -
  from assms have 2: "abelian_group M"
    by (intro abelian_groupI, auto)
  from assms have 3: "module_axioms R M"
    by (unfold module_axioms_def, auto)
  from 2 3 cring show ?thesis
    by (unfold module_def module_def, auto)
qed

text {*A submodule is $N\subseteq M$ that is closed under addition and scalar multiplication, and
contains 0 (so is not empty).*}
locale submodule =
  fixes R and N and M (structure)
  assumes module: "module R M"
    and subset: "N \<subseteq> carrier M"
    and m_closed [intro, simp]: "\<lbrakk>v \<in> N; w \<in> N\<rbrakk> \<Longrightarrow> v \<oplus> w \<in> N"
    and zero_closed [simp]: "\<zero> \<in> N" (*prevents N from being the empty set*)
    and smult_closed [intro, simp]: "\<lbrakk>c \<in> carrier R; v \<in> N\<rbrakk> \<Longrightarrow> c\<odot>v \<in> N"

abbreviation (in module) md::"'c set \<Rightarrow> ('a, 'c, 'd) module_scheme"
  where "md N \<equiv> M\<lparr>carrier :=N\<rparr>"

lemma (in module) carrier_vs_is_self [simp]:
  "carrier (md N) = N"
  by auto

lemma (in module) submodule_is_module:
  fixes N::"'c set"
  assumes 0: "submodule R N M"
  shows "module R (md N)"
proof  (unfold module_def, auto)
  show 1: "cring R"..
next
  from assms show 2: "abelian_group (md N)"
    apply (unfold submodule_def)
    apply (intro abelian_groupI, auto)
      apply (metis (no_types, hide_lams) M.add.m_assoc contra_subsetD)
     apply (metis (no_types, hide_lams) M.add.m_comm contra_subsetD)
    apply (rename_tac v)
    txt {*The inverse of $v$ under addition is $-v$*}
    apply (rule_tac x="\<ominus>\<^bsub>M\<^esub>v" in bexI)
     apply (metis M.l_neg contra_subsetD)
    by (metis R.add.inv_closed one_closed smult_minus_1 subset_iff)
next
  from assms show 3: "module_axioms R (md N)"
    apply (unfold module_axioms_def submodule_def, auto)
      apply (metis (no_types, hide_lams) smult_l_distr contra_subsetD)
     apply (metis (no_types, hide_lams) smult_r_distr contra_subsetD)
    by (metis (no_types, hide_lams) smult_assoc1 contra_subsetD)
qed

text {*$N_1+N_2=\{x+y | x\in N_1,y\in N_2\}$ *}
definition (in module) submodule_sum:: "['c set, 'c set] \<Rightarrow> 'c set"
  where "submodule_sum N1 N2 = (\<lambda> (x,y). x \<oplus>\<^bsub>M\<^esub> y) `{(x,y). x\<in>  N1 \<and> y\<in> N2}"
(*This only depends on the carriers, actually, so it could be defined on that level if desired.*)

text {*A module homomorphism $M\to N$ preserves addition and scalar multiplication.*}
definition module_hom:: "[('a, 'c0) ring_scheme,
  ('a,'b1,'c1) module_scheme, ('a,'b2,'c2) module_scheme] \<Rightarrow>('b1\<Rightarrow>'b2) set"
  where "module_hom R M N = {f.
    ((f\<in> carrier M \<rightarrow> carrier N)
    \<and> (\<forall>m1 m2. m1\<in>carrier M\<and> m2\<in>carrier M \<longrightarrow> f (m1 \<oplus>\<^bsub>M\<^esub> m2) = (f m1) \<oplus>\<^bsub>N\<^esub> (f m2))
    \<and> (\<forall>r m. r\<in>carrier R\<and> m\<in>carrier M \<longrightarrow>f (r \<odot>\<^bsub>M\<^esub> m) = r \<odot>\<^bsub>N\<^esub> (f m)))}"

lemma module_hom_closed: "f\<in> module_hom R M N \<Longrightarrow> f\<in> carrier M \<rightarrow> carrier N"
by (unfold module_hom_def, auto)

lemma module_hom_add: "\<lbrakk>f\<in> module_hom R M N; m1\<in>carrier M; m2\<in>carrier M \<rbrakk> \<Longrightarrow> f (m1 \<oplus>\<^bsub>M\<^esub> m2) = (f m1) \<oplus>\<^bsub>N\<^esub> (f m2)"
by (unfold module_hom_def, auto)

lemma module_hom_smult: "\<lbrakk>f\<in> module_hom R M N; r\<in>carrier R; m\<in>carrier M \<rbrakk>  \<Longrightarrow> f (r \<odot>\<^bsub>M\<^esub> m) = r \<odot>\<^bsub>N\<^esub> (f m)"
by (unfold module_hom_def, auto)

locale mod_hom =
  M: module R M + N: module R N
    for R and M and N +
  fixes f
  assumes f_hom: "f \<in> module_hom R M N"
  notes f_add [simp] = module_hom_add [OF f_hom]
    and f_smult [simp] = module_hom_smult [OF f_hom]

text {*Some basic simplification rules for module homomorphisms.*}
context mod_hom
begin

lemma f_im [simp, intro]:
assumes "v \<in> carrier M" (*doesn't work if \<Longrightarrow>*)
shows "f v \<in> carrier N"
proof -
  have 0: "mod_hom R M N f"..
  from 0 assms show ?thesis
    apply (unfold mod_hom_def module_hom_def mod_hom_axioms_def Pi_def)
    by auto
qed

definition im:: "'e set"
  where "im = f`(carrier M)"

definition ker:: "'c set"
  where "ker = {v. v \<in> carrier M & f v = \<zero>\<^bsub>N\<^esub>}"

lemma f0_is_0[simp]: "f \<zero>\<^bsub>M\<^esub>=\<zero>\<^bsub>N\<^esub>"
proof -
  have 1: "f \<zero>\<^bsub>M\<^esub> = f (\<zero>\<^bsub>R\<^esub> \<odot>\<^bsub>M\<^esub> \<zero>\<^bsub>M\<^esub>)" by simp
  have 2: "f (\<zero>\<^bsub>R\<^esub> \<odot>\<^bsub>M\<^esub> \<zero>\<^bsub>M\<^esub>) = \<zero>\<^bsub>N\<^esub>" by (simp del: M.lmult_0 M.rmult_0 add:f_smult f_im)
  from 1 2 show ?thesis by auto
qed

lemma f_neg [simp]:
  "v\<in>carrier M\<Longrightarrow>f (\<ominus>\<^bsub>M\<^esub> v) = \<ominus>\<^bsub>N\<^esub> f v"
by (simp add: M.smult_minus_1[THEN sym] N.smult_minus_1[THEN sym] f_smult)

lemma f_minus [simp]:
  "\<lbrakk>v\<in>carrier M; w\<in>carrier M\<rbrakk>\<Longrightarrow>f (v\<ominus>\<^bsub>M\<^esub>w) = f v \<ominus>\<^bsub>N\<^esub> f w"
by (simp add: a_minus_def f_neg f_add)

lemma ker_is_submodule: "submodule R ker M"
proof -
  have 0: "mod_hom R M N f"..
  from 0 have 1: "module R M" by (unfold mod_hom_def, auto)
  show ?thesis
    by  (rule submodule.intro, auto simp add: ker_def, rule 1) (*rmult_0*)
qed

lemma im_is_submodule: "submodule R im N"
proof -
  have 1: "im \<subseteq> carrier N" by (auto simp add: im_def image_def mod_hom_def module_hom_def f_im)
  have 2: "\<And>w1 w2.\<lbrakk>w1 \<in> im; w2 \<in> im\<rbrakk> \<Longrightarrow> w1 \<oplus>\<^bsub>N\<^esub> w2 \<in> im" (*it can't auto convert \<And> and w/ o*)
  proof -
    fix w1 w2
    assume w1: "w1 \<in> im" and w2: "w2\<in> im"
    from w1 obtain v1 where 3: "v1\<in> carrier M \<and> f v1 = w1" by (unfold im_def, auto)
    from w2 obtain v2 where 4: "v2\<in> carrier M \<and> f v2 = w2" by (unfold im_def, auto)
    from 3 4 have 5: "f (v1\<oplus>\<^bsub>M\<^esub>v2) = w1 \<oplus>\<^bsub>N\<^esub> w2" by simp
    from 3 4 have 6: "v1\<oplus>\<^bsub>M\<^esub>v2\<in> carrier M" by simp
    from 5 6 have 7: "\<exists>x\<in>carrier M. w1 \<oplus>\<^bsub>N\<^esub> w2 = f x" by metis
    from 7 show "?thesis w1 w2" by (unfold im_def image_def, auto)
  qed
  have 3: " \<zero>\<^bsub>N\<^esub> \<in> im"
  proof -
    have 8: "f \<zero>\<^bsub>M\<^esub> = \<zero>\<^bsub>N\<^esub> \<and> \<zero>\<^bsub>M\<^esub>\<in>carrier M" by auto
    from 8 have 9: "\<exists>x\<in>carrier M. \<zero>\<^bsub>N\<^esub> = f x" by metis
    from 9 show ?thesis by (unfold im_def image_def, auto)
  qed
  have 4: "\<And>c w. \<lbrakk>c \<in> carrier R; w \<in> im\<rbrakk> \<Longrightarrow> c\<odot>\<^bsub>N\<^esub> w \<in> im"
  proof -
    fix c w
    assume c: "c \<in> carrier R" and w: "w \<in> im"
    from w obtain v where 10: "v\<in> carrier M \<and> f v = w" by (unfold im_def, auto)
    from c 10 have 11: "f (c\<odot>\<^bsub>M\<^esub> v) = c\<odot>\<^bsub>N\<^esub> w\<and> (c \<odot>\<^bsub>M\<^esub> v\<in>carrier M)" by auto
    from 11 have 12: "\<exists>v1\<in>carrier M.  c\<odot>\<^bsub>N\<^esub> w=f v1" by metis
    from 12 show "?thesis c w" by (unfold im_def image_def, auto) (*sensitive to ordering*)
  qed
  from 1 2 3 4 show ?thesis by (unfold_locales, auto)
qed

lemma (in mod_hom) f_ker:
  "v\<in>ker \<Longrightarrow> f v=\<zero>\<^bsub>N\<^esub>"
by (unfold ker_def, auto)
end

text {*We will show that for any set $S$, the space of functions $S\to K$ forms a vector space.*}
definition (in ring) func_space:: "'z set\<Rightarrow>('a,('z \<Rightarrow> 'a)) module"
  where "func_space S = \<lparr>carrier = S\<rightarrow>\<^sub>Ecarrier R,
                  mult = (\<lambda> f g. restrict (\<lambda>v. \<zero>\<^bsub>R\<^esub>) S),
                  one =  restrict (\<lambda>v. \<zero>\<^bsub>R\<^esub>) S,
                  zero = restrict (\<lambda>v. \<zero>\<^bsub>R\<^esub>) S,
                  add = (\<lambda> f g. restrict (\<lambda>v. f v \<oplus>\<^bsub>R\<^esub> g v) S),
                  smult = (\<lambda> c f. restrict (\<lambda>v. c \<otimes>\<^bsub>R\<^esub> f v) S)\<rparr>"

lemma (in cring) func_space_is_module:
  fixes S
  shows "module R (func_space S)"
proof -
have 0: "cring R"..
from 0 show ?thesis
  apply (auto intro!: module_criteria simp add: func_space_def)
           apply (auto simp add: module_def)
         apply (rename_tac f)
         apply (rule_tac x="restrict (\<lambda>v'. \<ominus>\<^bsub>R\<^esub> (f v')) S" in bexI)
          apply (auto simp add:restrict_def cong: if_cong split: split_if_asm, auto)
         apply (auto simp add: a_ac PiE_mem2 r_neg) (*intro: ext*)
      apply (unfold PiE_def extensional_def Pi_def)
      by (auto simp add: m_assoc l_distr r_distr)
qed

text {*Note: one can define $M^n$ from this.*}

text {*A linear combination is a module homomorphism from the space of coefficients to the module,
 $(a_v)\mapsto \sum_{v\in S} a_vv$.*}
lemma (in module) lincomb_is_mod_hom:
  fixes S
  assumes h: "finite S" and h2: "S\<subseteq>carrier M"
  shows "mod_hom R (func_space S) M (\<lambda>a. lincomb a S)"
proof -
  have 0: "module R M"..
  {
    fix m1 m2
    assume m1: "m1 \<in> S \<rightarrow>\<^sub>E carrier R" and m2: "m2 \<in> S \<rightarrow>\<^sub>E carrier R"
    from h h2 m1 m2 have a1: "(\<Oplus>\<^bsub>M\<^esub>v\<in>S. (\<lambda>v\<in>S. m1 v \<oplus>\<^bsub>R\<^esub> m2 v) v \<odot>\<^bsub>M\<^esub> v) =
      (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m1 v \<odot>\<^bsub>M\<^esub> v \<oplus>\<^bsub>M\<^esub> m2 v \<odot>\<^bsub>M\<^esub> v)"
      by (intro finsum_cong', auto simp add: smult_l_distr PiE_mem2)
    from h h2 m1 m2 have a2: "(\<Oplus>\<^bsub>M\<^esub>v\<in>S. m1 v \<odot>\<^bsub>M\<^esub> v \<oplus>\<^bsub>M\<^esub> m2 v \<odot>\<^bsub>M\<^esub> v) =
      (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m1 v \<odot>\<^bsub>M\<^esub> v) \<oplus>\<^bsub>M\<^esub> (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m2 v \<odot>\<^bsub>M\<^esub> v)"
      by (intro finsum_addf, auto)
    from a1 a2 have "(\<Oplus>\<^bsub>M\<^esub>v\<in>S. (\<lambda>v\<in>S. m1 v \<oplus> m2 v) v \<odot>\<^bsub>M\<^esub> v) =
       (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m1 v \<odot>\<^bsub>M\<^esub> v) \<oplus>\<^bsub>M\<^esub> (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m2 v \<odot>\<^bsub>M\<^esub> v)" by auto
  }
  hence 1: "\<And>m1 m2.
       m1 \<in> S \<rightarrow>\<^sub>E carrier R \<Longrightarrow>
       m2 \<in> S \<rightarrow>\<^sub>E carrier R \<Longrightarrow> (\<Oplus>\<^bsub>M\<^esub>v\<in>S. (\<lambda>v\<in>S. m1 v \<oplus> m2 v) v \<odot>\<^bsub>M\<^esub> v) =
       (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m1 v \<odot>\<^bsub>M\<^esub> v) \<oplus>\<^bsub>M\<^esub> (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m2 v \<odot>\<^bsub>M\<^esub> v)" by auto
  {
    fix r m
    assume r: "r \<in> carrier R" and m: "m \<in> S \<rightarrow>\<^sub>E carrier R"
    from h h2 r m have b1: "r \<odot>\<^bsub>M\<^esub> (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m v \<odot>\<^bsub>M\<^esub> v) =  (\<Oplus>\<^bsub>M\<^esub>v\<in>S. r \<odot>\<^bsub>M\<^esub>(m v \<odot>\<^bsub>M\<^esub> v))"
      by (intro finsum_smult, auto)
    from h h2 r m have b2: "(\<Oplus>\<^bsub>M\<^esub>v\<in>S. (\<lambda>v\<in>S. r \<otimes> m v) v \<odot>\<^bsub>M\<^esub> v) = r \<odot>\<^bsub>M\<^esub> (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m v \<odot>\<^bsub>M\<^esub> v)"
      apply (subst b1)
      apply (intro finsum_cong', auto)
      by (subst smult_assoc1, auto)
  }
  hence 2: "\<And>r m. r \<in> carrier R \<Longrightarrow>
           m \<in> S \<rightarrow>\<^sub>E carrier R \<Longrightarrow> (\<Oplus>\<^bsub>M\<^esub>v\<in>S. (\<lambda>v\<in>S. r \<otimes> m v) v \<odot>\<^bsub>M\<^esub> v) = r \<odot>\<^bsub>M\<^esub> (\<Oplus>\<^bsub>M\<^esub>v\<in>S. m v \<odot>\<^bsub>M\<^esub> v)"
            by auto
  from h h2 0 1 2 show ?thesis
    apply (unfold mod_hom_def, auto)
     apply (rule func_space_is_module)
    apply (unfold mod_hom_axioms_def module_hom_def, auto)
      apply (rule lincomb_closed, unfold func_space_def, auto)
     apply (unfold lincomb_def)
     by auto
qed

(*These are not really used.*)
lemma (in module) lincomb_sum:
  assumes A_fin: "finite A" and AinC: "A\<subseteq>carrier M" and a_fun: "a\<in>A\<rightarrow>carrier R" and
    b_fun: "b\<in>A\<rightarrow>carrier R"
  shows "lincomb (\<lambda>v. a v \<oplus>\<^bsub>R\<^esub> b v) A = lincomb a A \<oplus>\<^bsub>M\<^esub> lincomb b A"
proof -
  from A_fin AinC interpret mh: mod_hom R "func_space A" M  "(\<lambda>a. lincomb a A)" by (rule
    lincomb_is_mod_hom)
  let ?a="restrict a A"
  let ?b="restrict b A"
  from a_fun b_fun A_fin AinC
  have 1: "LinearCombinations.module.lincomb M (?a\<oplus>\<^bsub>(LinearCombinations.ring.func_space R A)\<^esub> ?b) A
    = LinearCombinations.module.lincomb M (\<lambda>x.  a x \<oplus>\<^bsub>R\<^esub> b x) A"
    by (auto simp add: func_space_def Pi_iff restrict_apply' cong: lincomb_cong)
  from a_fun b_fun A_fin AinC
  have 2: "LinearCombinations.module.lincomb M ?a A \<oplus>\<^bsub>M\<^esub>
      LinearCombinations.module.lincomb M ?b A = LinearCombinations.module.lincomb M a A \<oplus>\<^bsub>M\<^esub>
      LinearCombinations.module.lincomb M b A"
    by (simp_all add: sum_simp cong: lincomb_cong)
  from a_fun b_fun have ainC: "?a\<in>carrier (LinearCombinations.ring.func_space R A)"
    and binC: "?b\<in>carrier (LinearCombinations.ring.func_space R A)" by (unfold func_space_def, auto)
  from ainC binC have "LinearCombinations.module.lincomb M (?a\<oplus>\<^bsub>(LinearCombinations.ring.func_space R A)\<^esub> ?b) A
    = LinearCombinations.module.lincomb M ?a A \<oplus>\<^bsub>M\<^esub>
      LinearCombinations.module.lincomb M ?b A"
    by (simp cong: lincomb_cong)
  with 1 2 show ?thesis by auto
qed

text {*The negative of a function is just pointwise negation.*}
lemma (in cring) func_space_neg:
  fixes f
  assumes "f\<in> carrier (func_space S)"
  shows "\<ominus>\<^bsub>func_space S\<^esub> f = (\<lambda> v. if (v\<in>S) then \<ominus>\<^bsub>R\<^esub> f v else undefined)"
proof -
  interpret fs: module R "func_space S" by (rule func_space_is_module)
  from assms show ?thesis
    apply (intro fs.minus_equality)
      apply (unfold func_space_def PiE_def extensional_def)
      apply auto
     apply (intro restrict_ext, auto)
    by (simp add: l_neg coeff_in_ring)
qed

text {*Ditto for subtraction. Note the above is really a special case, when a is the 0 function.*}
lemma (in module) lincomb_diff:
  assumes A_fin: "finite A" and AinC: "A\<subseteq>carrier M" and a_fun: "a\<in>A\<rightarrow>carrier R" and
    b_fun: "b\<in>A\<rightarrow>carrier R"
  shows "lincomb (\<lambda>v. a v \<ominus>\<^bsub>R\<^esub> b v) A = lincomb a A \<ominus>\<^bsub>M\<^esub> lincomb b A"
proof -
  from A_fin AinC interpret mh: mod_hom R "func_space A" M  "(\<lambda>a. lincomb a A)" by (rule
    lincomb_is_mod_hom)
  let ?a="restrict a A"
  let ?b="restrict b A"
  from a_fun b_fun have ainC: "?a\<in>carrier (LinearCombinations.ring.func_space R A)"
    and binC: "?b\<in>carrier (LinearCombinations.ring.func_space R A)" by (unfold func_space_def, auto)
  from a_fun b_fun ainC binC A_fin AinC
  have 1: "LinearCombinations.module.lincomb M (?a\<ominus>\<^bsub>(func_space A)\<^esub> ?b) A
    = LinearCombinations.module.lincomb M (\<lambda>x.  a x \<ominus>\<^bsub>R\<^esub> b x) A"
    apply (subst mh.M.M.minus_eq)
      apply (auto simp del: mh.f_minus mh.f_add )
    apply (intro lincomb_cong, auto)
    apply (subst func_space_neg, auto)
    apply (simp add: restrict_def func_space_def)
    by (subst R.minus_eq, auto)
  from a_fun b_fun A_fin AinC
  have 2: "LinearCombinations.module.lincomb M ?a A \<ominus>\<^bsub>M\<^esub>
      LinearCombinations.module.lincomb M ?b A = LinearCombinations.module.lincomb M a A \<ominus>\<^bsub>M\<^esub>
      LinearCombinations.module.lincomb M b A"
    by (simp cong: lincomb_cong)
  from ainC binC have "LinearCombinations.module.lincomb M (?a\<ominus>\<^bsub>(LinearCombinations.ring.func_space R A)\<^esub> ?b) A
    = LinearCombinations.module.lincomb M ?a A \<ominus>\<^bsub>M\<^esub>
      LinearCombinations.module.lincomb M ?b A"
    by (simp cong: lincomb_cong)
  with 1 2 show ?thesis by auto
qed

text {*The union of nested submodules is a submodule. We will use this to show that span of any
set is a submodule.*}
lemma (in module) nested_union_vs:
  fixes I N N'
  assumes subm: "\<And>i. i\<in>I\<Longrightarrow> submodule R (N i) M"
    and max_exists: "\<And>i j. i\<in>I\<Longrightarrow>j\<in>I\<Longrightarrow> (\<exists>k. k\<in>I \<and> N i\<subseteq>N k \<and> N j \<subseteq>N k)"
    and uni: "N'=(\<Union> i\<in>I. N i)"
    and ne: "I\<noteq>{}"
  shows "submodule R N' M"
proof -
  have 1: "module R M"..
  from subm have all_in: "\<And>i. i\<in>I \<Longrightarrow> N i \<subseteq> carrier M"
    by (unfold submodule_def, auto)
  from uni all_in have 2: "\<And>x. x \<in> N' \<Longrightarrow> x \<in> carrier M"
    by auto
  from uni have 3: "\<And>v w. v \<in> N' \<Longrightarrow> w \<in> N' \<Longrightarrow> v \<oplus>\<^bsub>M\<^esub> w \<in> N'"
  proof -
    fix v w
    assume v: "v \<in> N'" and w: "w \<in> N'"
    from uni v w obtain i j where i: "i\<in>I\<and> v\<in> N i" and j: "j\<in>I\<and> w\<in> N j" by auto
    from max_exists i j obtain k where k: "k\<in>I \<and> N i \<subseteq> N k \<and> N j \<subseteq> N k" by presburger
    from v w i j k have v2: "v\<in>N k" and w2: "w\<in> N k" by auto
    from v2 w2 k subm[of k] have vw: "v \<oplus>\<^bsub>M\<^esub> w \<in> N k" apply (unfold submodule_def) by auto
    from k vw uni show "?thesis v w"  by auto
  qed
  have 4: "\<zero>\<^bsub>M\<^esub> \<in> N'"
  proof -
    from ne obtain i where i: "i\<in>I" by auto
    from i subm have zi: "\<zero>\<^bsub>M\<^esub>\<in>N i" by (unfold submodule_def, auto)
    from i zi uni show ?thesis by auto
  qed
  from uni subm have 5: "\<And>c v. c \<in> carrier R \<Longrightarrow> v \<in> N' \<Longrightarrow> c \<odot>\<^bsub>M\<^esub> v \<in> N'"
    by (unfold submodule_def, auto)
  from 1 2 3 4 5 show ?thesis by (unfold submodule_def, auto)
qed

lemma (in module) span_is_monotone:
  fixes S T
  assumes subs: "S\<subseteq>T"
  shows "span S \<subseteq> span T"
proof -
  from subs show ?thesis
    by (unfold span_def, auto)
qed

lemma (in module) span_is_submodule:
  fixes S
  assumes  h2: "S\<subseteq>carrier M"
  shows "submodule R (span S) M"
proof (cases "S={}")
  case True
  moreover have "module R M"..
  ultimately show ?thesis apply (unfold submodule_def span_def lincomb_def, auto) done
next
  case False
  show ?thesis
  proof (rule nested_union_vs[where ?I="{F. F\<subseteq>S \<and> finite F}" and ?N="\<lambda>F. span F" and ?N'="span S"])
    show " \<And>F. F \<in> {F. F \<subseteq> S \<and> finite F} \<Longrightarrow> submodule R (span F) M"
    proof -
      fix F
      assume F: "F \<in> {F. F \<subseteq> S \<and> finite F}"
      from F have h1: "finite F" by auto
      from F h2 have inC: "F\<subseteq>carrier M" by auto
      from h1 inC interpret mh: mod_hom R "(func_space F)" M "(\<lambda>a. lincomb a F)"
        by (rule lincomb_is_mod_hom)
      from h1 inC have 1: "mh.im = span F"
        apply (unfold mh.im_def)
        apply (unfold func_space_def, simp)
        apply (subst finite_span, auto)
        apply (unfold image_def, auto)
        apply (rule_tac x="restrict a F" in bexI)
         by (auto intro!: lincomb_cong)
      from 1 show "submodule R (span F) M" by (metis mh.im_is_submodule)
    qed
  next
    show "\<And>i j. i \<in> {F. F \<subseteq> S \<and> finite F} \<Longrightarrow>
           j \<in> {F. F \<subseteq> S \<and> finite F} \<Longrightarrow>
           \<exists>k. k \<in> {F. F \<subseteq> S \<and> finite F} \<and> span i \<subseteq> span k \<and> span j \<subseteq> span k"
    proof -
      fix i j
      assume i: "i \<in> {F. F \<subseteq> S \<and> finite F}" and j: "j \<in> {F. F \<subseteq> S \<and> finite F}"
      from i j show "?thesis i j"
        apply (rule_tac x="i\<union>j" in exI)
        apply (auto del: subsetI)
         by (intro span_is_monotone, auto del: subsetI)+
    qed
  next
    show "span S=(\<Union> i\<in>{F. F \<subseteq> S \<and> finite F}. span i)"
      by (unfold span_def,auto)
  next
    have ne: "S\<noteq>{}" by fact
    from ne show "{F. F \<subseteq> S \<and> finite F} \<noteq> {}" by auto
  qed
qed

text {*A finite sum does not depend on the ambient module. This can be done for monoid, but
"submonoid" isn't currently defined. (It can be copied, however, for groups\ldots)
This lemma requires a somewhat annoying lemma foldD-not-depend. Then we show that linear combinations,
linear independence, span do not depend on the ambient module.*}
lemma (in module) finsum_not_depend:
  fixes a A N
  assumes h1: "finite A" and h2: "A\<subseteq>N" and h3: "submodule R N M" and h4: "f:A\<rightarrow>N"
  shows "(\<Oplus>\<^bsub>(md N)\<^esub> v\<in>A. f v) = (\<Oplus>\<^bsub>M\<^esub> v\<in>A. f v)"
proof -
  from h1 h2 h3 h4 show ?thesis
    apply (unfold finsum_def finprod_def)
    apply simp
    apply (intro foldD_not_depend[where ?B="A"])
         apply (unfold submodule_def LCD_def, auto)
    apply (meson M.add.m_lcomm PiE subsetCE)+
    done
qed

lemma (in module) lincomb_not_depend:
  fixes a A N
  assumes h1: "finite A" and h2: "A\<subseteq>N" and h3: "submodule R N M" and h4: "a:A\<rightarrow>carrier R"
  shows "lincomb a A = module.lincomb (md N) a A"
proof -
  from h3 interpret N: module R "(md N)" by (rule submodule_is_module)
  have 3: "N=carrier (md N)" by auto
  have 4: "(smult M ) = (smult (md N))" by auto
  from h1 h2 h3 h4 have "(\<Oplus>\<^bsub>(md N)\<^esub>v\<in>A. a v \<odot>\<^bsub>M\<^esub> v) = (\<Oplus>\<^bsub>M\<^esub>v\<in>A. a v \<odot>\<^bsub>M\<^esub> v)"
    apply (intro finsum_not_depend)
    using N.summands_valid by auto
  from this show ?thesis by (unfold lincomb_def N.lincomb_def, simp)
qed

lemma (in module) span_li_not_depend:
  fixes S N
  assumes h2: "S\<subseteq>N" and  h3: "submodule R N M"
  shows "module.span R (md N) S = module.span R M S"
    and "module.lin_dep R (md N) S = module.lin_dep R M S"
proof -
  from h3 interpret w: module R "(md N)" by (rule submodule_is_module)
  from h2 have 1:"submodule R (module.span R (md N) S) (md N)"
    by (intro w.span_is_submodule, simp)
  have 3: "\<And>a A. (finite A \<and> A\<subseteq>S \<and> a \<in> A \<rightarrow> carrier R \<Longrightarrow>
    module.lincomb M a A = module.lincomb (md N) a A)"
  proof -
    fix a A
    assume 31: "finite A \<and> A\<subseteq>S \<and> a \<in> A \<rightarrow> carrier R"
    from assms 31 show "?thesis a A"
      by (intro lincomb_not_depend, auto)
  qed
  from 3 show 4: "module.span R (md N) S = module.span R M S"
    apply (unfold span_def w.span_def)
    apply auto
    by (metis)
  have zeros: "\<zero>\<^bsub>md N\<^esub>=\<zero>\<^bsub>M\<^esub>" by auto
  from assms 3 show 5: "module.lin_dep R (md N) S = module.lin_dep R M S"
    apply (unfold lin_dep_def w.lin_dep_def)
    apply (subst zeros)
    by metis
qed

lemma (in module) span_is_subset:
  fixes S N
  assumes h2: "S\<subseteq>N" and  h3: "submodule R N M"
  shows "span S \<subseteq> N"
proof -
  from h3 interpret w: module R "(md N)" by (rule submodule_is_module)
  from h2 have 1:"submodule R (module.span R (md N) S) (md N)"
    by (intro w.span_is_submodule, simp)
  from assms have 4: "module.span R (md N) S = module.span R M S"
     by (rule span_li_not_depend)
  from 1 4 have 5: "submodule R (module.span R M S) (md N)" by auto
  from 5 show ?thesis by (unfold submodule_def, simp)
qed

lemma (in module) span_is_subset2:
  fixes S
  assumes h2: "S\<subseteq>carrier M"
  shows "span S \<subseteq> carrier M"
proof -
  have 0: "module R M"..
  from 0 have h3: "submodule R (carrier M) M" by (unfold submodule_def, auto)
  from h2 h3 show ?thesis by (rule span_is_subset)
qed

lemma (in module) in_own_span:
  fixes S
  assumes  inC:"S\<subseteq>carrier M"
  shows "S \<subseteq> span S"
proof -
  from inC show ?thesis
    apply (unfold span_def, auto)
    apply (rename_tac v)
    apply (rule_tac x="(\<lambda> w. if (w=v) then \<one>\<^bsub>R\<^esub> else \<zero>\<^bsub>R\<^esub>)" in exI)
    apply (rule_tac x="{v}" in exI)
    apply (unfold lincomb_def)
    by (auto simp add: finsum_insert)
qed

lemma (in module) subset_li_is_li:
  fixes A B
  assumes li: "lin_indpt A" and sub: "B \<subseteq> A"
  shows "lin_indpt B"
proof (rule ccontr)
  assume ld: "\<not>lin_indpt B"
  from ld sub have ldA: "lin_dep A" by (metis supset_ld_is_ld)
  from li ldA show False by auto
qed

lemma (in mod_hom) hom_sum:
  fixes A B g
  assumes h1: "finite A" and h2: "A\<subseteq>carrier M" and h3: "g:A\<rightarrow>carrier M"
  shows "f (\<Oplus>\<^bsub>M\<^esub> a\<in>A. g a) = (\<Oplus>\<^bsub>N\<^esub> a\<in>A. f (g a))"
proof -
  from h1 h2 h3 show ?thesis
  proof (induct set: finite) (*doesn't work on outside?*)
    case empty
    show ?case by auto
  next
    case (insert a A)
    then have "(\<Oplus>\<^bsub>N\<^esub>a\<in>insert a A. f (g a)) = f (g a) \<oplus>\<^bsub>N\<^esub> (\<Oplus>\<^bsub>N\<^esub>a\<in>A. f (g a))"
      by (intro finsum_insert, auto)
    with insert.prems insert.hyps show ?case
      by simp
  qed
qed

end


theory Planar_Complete
imports
  Digraph_Map_Impl
begin

section \<open>Kuratowski Graphs are not Combinatorially Planar\<close>

subsection \<open>A concrete K5 graph\<close>

definition "c_K5_list \<equiv> ([0..4], [(x,y). x <- [0..4], y <- [0..4], x \<noteq> y])"

abbreviation c_K5 :: "int pair_pre_digraph" where
  "c_K5 \<equiv> list_digraph c_K5_list"

lemma c_K5_not_comb_planar: "\<not>comb_planar c_K5"
  by (subst comb_planar_impl_correct) eval+

lemma pverts_c_K5: "pverts c_K5 = {0..4}"
  by (simp add: c_K5_list_def list_digraph_ext_def)

lemma parcs_c_K5: "parcs c_K5 = {(u,v). u \<in> {0..4} \<and> v \<in> {0..4} \<and> u \<noteq> v}"
  by (auto simp: c_K5_list_def list_digraph_ext_def)

lemmas c_K5_simps = pverts_c_K5 parcs_c_K5

lemma complete_c_K5: "K\<^bsub>5\<^esub> c_K5"
proof -
  interpret K5: pair_graph c_K5 by eval
  show ?thesis unfolding complete_digraph_def by (auto simp: c_K5_simps)
qed

subsection \<open>A concrete K33 graph\<close>

definition "c_K33_list \<equiv> ([0..5], [(x,y). x <- [0..5], y <- [0..5], even x \<longleftrightarrow> odd y])"

abbreviation c_K33 :: "int pair_pre_digraph" where
  "c_K33 \<equiv> list_digraph c_K33_list"

lemma c_K33_not_comb_planar: "\<not>comb_planar c_K33"
  by (subst comb_planar_impl_correct) eval+

lemma complete_c_K33: "K\<^bsub>3,3\<^esub> c_K33"
proof -
  interpret K33: pair_graph c_K33 by eval
  show ?thesis
    unfolding complete_bipartite_digraph_def
    apply (intro conjI)
    apply unfold_locales
    apply (rule exI[of _ "{0,2,4}"])
    apply (rule exI[of _ "{1,3,5}"])
    unfolding c_K33_list_def list_digraph_simps with_proj_simps
    apply eval
    done
qed

subsection \<open>Generalization to arbitrary Kuratowski Graphs\<close>

subsubsection \<open>Number of Face Cycles is a Graph Invariant\<close>

lemma (in digraph_map) wrap_wrap_iso:
  assumes hom: "digraph_isomorphism hom"
  assumes f: "f \<in> arcs G \<rightarrow> arcs G" and g: "g \<in> arcs G \<rightarrow> arcs G"
  shows "wrap_iso_arcs hom f (wrap_iso_arcs hom g x) = wrap_iso_arcs hom (f o g) x"
proof -
  have "\<And>x. x \<in> arcs G \<Longrightarrow> g x \<in> arcs G" using g by auto
  with hom f show ?thesis
    by (cases "x \<in> iso_arcs hom ` arcs G") (auto simp: wrap_iso_arcs_def perm_restrict_simps)
qed

lemma (in digraph_map) face_cycle_succ_iso:
  assumes hom: "digraph_isomorphism hom" "x \<in> iso_arcs hom ` arcs G"
  shows "pre_digraph_map.face_cycle_succ (map_iso hom) x = wrap_iso_arcs hom face_cycle_succ x"
  using assms by (simp add: pre_digraph_map.face_cycle_succ_def map_iso_def wrap_wrap_iso)

lemma (in digraph_map) face_cycle_set_iso:
  assumes hom: "digraph_isomorphism hom" "x \<in> iso_arcs hom ` arcs G"
  shows "pre_digraph_map.face_cycle_set (map_iso hom) x = iso_arcs hom ` face_cycle_set (iso_arcs (inv_iso hom) x)"
proof -
  have *: "\<And>x y. x \<in> orbit face_cycle_succ y \<Longrightarrow> y \<in> arcs G \<Longrightarrow> x \<in> arcs G"
          "\<And>x. x \<in> arcs G \<Longrightarrow> x \<in> orbit face_cycle_succ x"
    using face_cycle_set_def by (auto simp: in_face_cycle_setD)
  show ?thesis
    using assms unfolding pre_digraph_map.face_cycle_set_def
    by (subst orbit_FOO[where g'="pre_digraph_map.face_cycle_succ (map_iso hom)"])
       (auto simp: * face_cycle_succ_iso)
qed

lemma (in digraph_map) face_cycle_sets_iso:
  assumes hom: "digraph_isomorphism hom"
  shows "pre_digraph_map.face_cycle_sets (app_iso hom G) (map_iso hom) = (\<lambda>x. iso_arcs hom ` x) ` face_cycle_sets"
  using assms by (auto simp: pre_digraph_map.face_cycle_sets_def face_cycle_set_iso) (auto simp: face_cycle_set_iso intro: rev_image_eqI)

lemma (in digraph_map) card_face_cycle_sets_iso:
  assumes hom: "digraph_isomorphism hom"
  shows "card (pre_digraph_map.face_cycle_sets (app_iso hom G) (map_iso hom)) = card face_cycle_sets"
proof -
  have "inj_on ((`) (iso_arcs hom)) face_cycle_sets"
    by (rule inj_on_f_imageI digraph_isomorphism_inj_on_arcs hom in_face_cycle_setsD)+
  then show ?thesis using hom by (simp add: face_cycle_sets_iso card_image)
qed

subsubsection \<open>Combinatorial planarity is a Graph Invariant\<close>

lemma (in digraph_map) euler_char_iso:
  assumes "digraph_isomorphism hom"
  shows "pre_digraph_map.euler_char (app_iso hom G) (map_iso hom) = euler_char"
  using assms by (auto simp: pre_digraph_map.euler_char_def card_face_cycle_sets_iso)

lemma (in digraph_map) euler_genus_iso:
  assumes "digraph_isomorphism hom"
  shows "pre_digraph_map.euler_genus (app_iso hom G) (map_iso hom) = euler_genus"
  using assms by (auto simp: pre_digraph_map.euler_genus_def euler_char_iso)

lemma (in wf_digraph) comb_planar_iso:
  assumes "digraph_isomorphism hom"
  shows "comb_planar (app_iso hom G) \<longleftrightarrow> comb_planar G"
proof
  assume "comb_planar G"
  then obtain M where "digraph_map G M" "pre_digraph_map.euler_genus G M = 0"
    by (auto simp: comb_planar_def)
  then have "digraph_map (app_iso hom G) (pre_digraph_map.map_iso G M hom)"
      "pre_digraph_map.euler_genus (app_iso hom G) (pre_digraph_map.map_iso G M hom) = 0"
    using assms by (auto intro: digraph_map.digraph_map_isoI simp: digraph_map.euler_genus_iso)
  then show "comb_planar (app_iso hom G)"
    by (metis comb_planar_def)
next
  let ?G = "app_iso hom G"
  assume "comb_planar ?G"
  then obtain M where "digraph_map ?G M"
      "pre_digraph_map.euler_genus ?G M = 0"
    by (auto simp: comb_planar_def)
  moreover
  have "pre_digraph.digraph_isomorphism ?G (inv_iso hom)"
    using assms by (rule digraph_isomorphism_invI)
  ultimately
  have "digraph_map (app_iso (inv_iso hom) ?G) (pre_digraph_map.map_iso ?G M (inv_iso hom))"
      "pre_digraph_map.euler_genus (app_iso (inv_iso hom) ?G) (pre_digraph_map.map_iso ?G M (inv_iso hom)) = 0"
    using assms by (auto intro: digraph_map.digraph_map_isoI simp only: digraph_map.euler_genus_iso)
  then show "comb_planar G"
    using assms by (auto simp: comb_planar_def)
qed

subsubsection \<open>Completeness is a Graph Invariant\<close>

lemma (in loopfree_digraph) loopfree_digraphI_app_iso:
  assumes "digraph_isomorphism hom"
  shows "loopfree_digraph (app_iso hom G)"
proof -
  interpret iG: wf_digraph "app_iso hom G" using assms by (rule wf_digraphI_app_iso)
  show ?thesis
    using assms digraph_isomorphism_inj_on_verts[OF assms]
    by unfold_locales (auto simp: iso_verts_tail iso_verts_head dest: inj_onD no_loops)
qed

lemma (in nomulti_digraph) nomulti_digraphI_app_iso:
  assumes "digraph_isomorphism hom"
  shows "nomulti_digraph (app_iso hom G)"
proof -
  interpret iG: wf_digraph "app_iso hom G" using assms by (rule wf_digraphI_app_iso)
  show ?thesis
    using assms
    by unfold_locales (auto simp: iso_verts_tail iso_verts_head arc_to_ends_def no_multi_arcs dest: inj_onD)
qed

lemma (in pre_digraph) symmetricI_app_iso:
  assumes "digraph_isomorphism hom"
  assumes "symmetric G"
  shows "symmetric (app_iso hom G)"
proof -
  let ?G = "app_iso hom G"
  have "sym (arcs_ends ?G)"
  proof (rule symI)
    fix u v assume "u \<rightarrow>\<^bsub>?G\<^esub> v"
    then obtain a where a: "a \<in> arcs ?G" "tail ?G a = u" "head ?G a = v" by auto
    then obtain a0 where a0: "a0 \<in> arcs G" "a = iso_arcs hom a0" by auto
    with \<open>symmetric G\<close> obtain b0 where "b0 \<in> arcs G" "tail G b0 = head G a0" "head G b0 = tail G a0"
      by (auto simp: symmetric_def arcs_ends_conv elim: symE)
    moreover
    define b where "b = iso_arcs hom b0"
    ultimately
    have "b \<in> iso_arcs hom ` arcs G" "tail ?G b = v" "head ?G b = u"
      using a a0 assms by (auto simp: iso_verts_tail iso_verts_head)
    then show "v \<rightarrow>\<^bsub>?G\<^esub> u" by (auto simp: arcs_ends_conv)
  qed
  then show ?thesis by (simp add: symmetric_def)
qed

lemma (in sym_digraph) sym_digraphI_app_iso:
  assumes "digraph_isomorphism hom"
  shows "sym_digraph (app_iso hom G)"
proof -
  interpret iG: wf_digraph "app_iso hom G" using assms by (rule wf_digraphI_app_iso)
  show ?thesis using assms by unfold_locales (intro symmetricI_app_iso sym_arcs)
qed

lemma (in graph) graphI_app_iso:
  assumes "digraph_isomorphism hom"
  shows "graph (app_iso hom G)"
proof -
  interpret iG: fin_digraph "app_iso hom G"
    using assms by (rule fin_digraphI_app_iso)
  interpret iG: loopfree_digraph "app_iso hom G"
    using assms by (rule loopfree_digraphI_app_iso)
  interpret iG: nomulti_digraph "app_iso hom G"
    using assms by (rule nomulti_digraphI_app_iso)
  interpret iG: sym_digraph "app_iso hom G"
    using assms by (rule sym_digraphI_app_iso)
  show ?thesis by intro_locales
qed

lemma (in wf_digraph) graph_app_iso_eq:
  assumes "digraph_isomorphism hom"
  shows "graph (app_iso hom G) \<longleftrightarrow> graph G"
  using assms by (metis app_iso_inv digraph_isomorphism_invI graph.graphI_app_iso)

lemma (in pre_digraph) arcs_ends_iso:
  assumes "digraph_isomorphism hom"
  shows "arcs_ends (app_iso hom G) = (\<lambda>(u,v). (iso_verts hom u, iso_verts hom v)) ` arcs_ends G"
  using assms
  by (auto simp: arcs_ends_conv image_image iso_verts_tail iso_verts_head cong: image_cong)

lemma inj_onI_pair:
  assumes "inj_on f S" "T \<subseteq> S \<times> S"
  shows "inj_on (\<lambda>(u,v). (f u, f v)) T"
  using assms by (intro inj_onI) (auto dest: inj_onD)

lemma (in wf_digraph) complete_digraph_iso:
  assumes "digraph_isomorphism hom"
  shows "K\<^bsub>n\<^esub> (app_iso hom G) \<longleftrightarrow> K\<^bsub>n\<^esub> G" (is "?L \<longleftrightarrow> ?R")
proof
  assume "?L"
  then interpret iG: graph "app_iso hom G" by (simp add: complete_digraph_def)
  { have "{(u, v). u \<in> iso_verts hom ` verts G \<and> v \<in> iso_verts hom ` verts G \<and> u \<noteq> v}
        = (\<lambda>(u,v). (iso_verts hom u, iso_verts hom v)) ` {(u,v). u \<in> verts G \<and> v \<in> verts G \<and> iso_verts hom u \<noteq> iso_verts hom v}" (is "?L = _")
      by auto
    also have "\<dots> = (\<lambda>(u,v). (iso_verts hom u, iso_verts hom v)) ` {(u,v). u \<in> verts G \<and> v \<in> verts G \<and> u \<noteq> v}"
      using digraph_isomorphism_inj_on_verts[OF assms] by (auto dest: inj_onD)
    finally have "?L = \<dots>" .
  } note X = this

  { fix A assume A: "A \<subseteq> verts G \<times> verts G"
    then have "inj_on (\<lambda>(u, v). (iso_verts hom u, iso_verts hom v)) A"
      using A digraph_isomorphism_inj_on_verts[OF assms] by (intro inj_onI_pair)
  } note Y = this
  have "(arcs_ends G \<union> {(u, v). u \<in> verts G \<and> v \<in> verts G \<and> u \<noteq> v}) \<subseteq> verts G \<times> verts G"
    by auto
  note Y' = Y[OF this]

  show ?R using assms \<open>?L\<close>
    by (simp add: complete_digraph_def X arcs_ends_iso graph_app_iso_eq inj_on_Un_image_eq_iff Y')
next
  assume "?R" then show ?L using assms
    by (fastforce simp add: complete_digraph_def arcs_ends_iso graph_app_iso_eq)
qed

subsubsection \<open>Conclusion\<close>

definition (in pre_digraph)
  mk_iso :: "('a \<Rightarrow> 'c) \<Rightarrow> ('b \<Rightarrow> 'd) \<Rightarrow> ('a, 'b, 'c, 'd) digraph_isomorphism"
where
  "mk_iso fv fa \<equiv> \<lparr> iso_verts = fv, iso_arcs = fa,
    iso_head = fv o head G o the_inv_into (arcs G) fa,
    iso_tail = fv o tail G o the_inv_into (arcs G) fa \<rparr>"

lemma (in pre_digraph) mk_iso_simps[simp]:
  "iso_verts (mk_iso fv fa) = fv"
  "iso_arcs (mk_iso fv fa) = fa"
  by (auto simp: mk_iso_def)

lemma (in wf_digraph) digraph_isomorphism_mk_iso:
  assumes "inj_on fv (verts G)" "inj_on fa (arcs G)"
  shows "digraph_isomorphism (mk_iso fv fa)"
  using assms by (auto simp: digraph_isomorphism_def mk_iso_def the_inv_into_f_f wf_digraph)

definition "pairself f \<equiv> \<lambda>x. case x of (u,v) \<Rightarrow> (f u, f v)"

lemma inj_on_pairself:
  assumes "inj_on f S" and "T \<subseteq> S \<times> S"
  shows "inj_on (pairself f) T"
  using assms unfolding pairself_def by (rule inj_onI_pair)

definition
  mk_iso_nomulti :: "('a,'b) pre_digraph \<Rightarrow> ('c,'d) pre_digraph \<Rightarrow> ('a \<Rightarrow> 'c) \<Rightarrow> ('a, 'b, 'c, 'd) digraph_isomorphism"
where
  "mk_iso_nomulti G H fv \<equiv> \<lparr>
    iso_verts = fv,
    iso_arcs = the_inv_into (arcs H) (arc_to_ends H) o pairself fv o arc_to_ends G,
    iso_head = head H,
    iso_tail = tail H
  \<rparr>"

lemma (in pre_digraph) mk_iso_simps_nomulti[simp]:
  "iso_verts (mk_iso_nomulti G H fv) = fv"
  "iso_head (mk_iso_nomulti G H fv) = head H"
  "iso_tail (mk_iso_nomulti G H fv) = tail H"
  by (auto simp: mk_iso_nomulti_def)

lemma (in nomulti_digraph)
  assumes "nomulti_digraph H"
  assumes fv: "inj_on fv (verts G)" "verts H = fv ` verts G" and arcs_ends: "arcs_ends H = pairself fv ` arcs_ends G"
  shows digraph_isomorphism_mk_iso_nomulti: "digraph_isomorphism (mk_iso_nomulti G H fv)" (is "?t_multi")
    and ap_iso_mk_iso_nomulti_eq: "app_iso (mk_iso_nomulti G H fv) G = H" (is "?t_app")
    and digraph_iso_mk_iso_nomulti: "digraph_iso G H" (is "?t_iso")
  using assms
proof -
  interpret H: nomulti_digraph H by fact
  let ?fa = "iso_arcs (mk_iso_nomulti G H fv)"

  have fa: "bij_betw ?fa (arcs G) (arcs H)"
  proof -
    have "bij_betw (arc_to_ends G) (arcs G) (arcs_ends G)"
      by (auto simp: bij_betw_def inj_on_arc_to_ends arcs_ends_def)
    also have "bij_betw (pairself fv) (arcs_ends G) (arcs_ends H)"
      using arcs_ends by (auto simp: bij_betw_def arcs_ends_def arc_to_ends_def intro: fv inj_on_pairself)
    also (bij_betw_trans) have "bij_betw (the_inv_into (arcs H) (arc_to_ends H)) (arcs_ends H) (arcs H)"
      by (auto simp: bij_betw_def the_inv_into_into H.inj_on_arc_to_ends arcs_ends_def inj_on_the_inv_into)
    finally (bij_betw_trans) show ?thesis
      by (simp add: mk_iso_nomulti_def o_assoc)
  qed
  moreover
  { fix a assume "a \<in> arcs G"
    then have "pairself fv (arc_to_ends G a) \<in> arcs_ends H"
      using arcs_ends by (auto simp: arcs_ends_def)
    then obtain b where "(pairself fv (arc_to_ends G a)) = arc_to_ends H b" "b \<in> arcs H"
      by (auto simp: arcs_ends_def)
    then have "fv (tail G a) = tail H (?fa a)" "fv (head G a) = head H (?fa a)"
      by (auto simp: mk_iso_nomulti_def the_inv_into_f_f H.inj_on_arc_to_ends)
        (auto simp: pairself_def arc_to_ends_def)
  }
  ultimately
  show ?t_multi ?t_app using fv by (auto simp: digraph_isomorphism_def bij_betw_def wf_digraph)
  then show ?t_iso by (auto simp: digraph_iso_def)
qed

lemma complete_digraph_are_iso:
  assumes "K\<^bsub>n\<^esub> G" "K\<^bsub>n\<^esub> H" shows "digraph_iso G H"
proof -
  interpret G: graph G using assms by (simp add: complete_digraph_def)
  interpret H: graph H using assms by (simp add: complete_digraph_def)

  from assms have "card (verts G) = n" "card (verts H) = n"
    by (auto simp: complete_digraph_def)
  with G.finite_verts H.finite_verts obtain fv where "bij_betw fv (verts G) (verts H)"
    by (metis finite_same_card_bij)
  then have fv: "inj_on fv (verts G)" "verts H = fv ` verts G" by (auto simp: bij_betw_def)

  have "arcs_ends H = {(u,v). u \<in> verts H \<and> v \<in> verts H \<and> u \<noteq> v}"
    using \<open>K\<^bsub>n\<^esub> H\<close> by (auto simp: complete_digraph_def)
  also have "\<dots> = pairself fv ` {(u,v). u \<in> verts G \<and> v \<in> verts G \<and> u \<noteq> v}" (is "?L = ?R")
  proof (intro set_eqI iffI)
    fix x assume "x \<in> ?L"
    then have "fst x \<in> fv ` verts G" "snd x \<in> fv ` verts G" "fst x \<noteq> snd x"
      using fv by auto
    then obtain u v where "fst x = fv u" "snd x = fv v" "u \<in> verts G" "v \<in> verts G" by auto
    then have "(fst x, snd x) \<in> ?R" using \<open>x \<in> ?L\<close> by (auto simp: pairself_def)
    then show "x \<in> ?R" by auto
  next
    fix x assume "x \<in> ?R" then show "x \<in> ?L"
    using fv by (auto simp: pairself_def dest: inj_onD)
  qed
  also have "\<dots> = pairself fv ` arcs_ends G"
    using \<open>K\<^bsub>n\<^esub> G\<close> by (auto simp: complete_digraph_def)
  finally  have arcs_ends: "arcs_ends H = pairself fv ` arcs_ends G" .

  show ?thesis using H.nomulti_digraph fv arcs_ends by (rule G.digraph_iso_mk_iso_nomulti)
qed

lemma pairself_image_prod:
  "pairself f ` (A \<times> B) = f ` A \<times> f ` B"
  by (auto simp: pairself_def)

lemma complete_bipartite_digraph_are_iso:
  assumes "K\<^bsub>m,n\<^esub> G" "K\<^bsub>m,n\<^esub> H" shows "digraph_iso G H"
proof -
  interpret G: graph G using assms by (simp add: complete_bipartite_digraph_def)
  interpret H: graph H using assms by (simp add: complete_bipartite_digraph_def)

  from assms obtain GU GV where G_parts: "verts G = GU \<union> GV" "GU \<inter> GV = {}"
      "card GU = m" "card GV = n" "arcs_ends G = GU \<times> GV \<union> GV \<times> GU"
    by (auto simp: complete_bipartite_digraph_def)
  from assms obtain HU HV where H_parts: "verts H = HU \<union> HV" "HU \<inter> HV = {}"
      "card HU = m" "card HV = n" "arcs_ends H = HU \<times> HV \<union> HV \<times> HU"
    by (auto simp: complete_bipartite_digraph_def)

  have fin: "finite GU" "finite GV" "finite HU" "finite HV"
    using G_parts H_parts G.finite_verts H.finite_verts by simp_all

  obtain fv_U where fv_U: "bij_betw fv_U GU HU"
    using \<open>card GU = _\<close> \<open>card HU = _\<close> \<open>finite GU\<close> \<open>finite HU\<close> by (metis finite_same_card_bij)
  obtain fv_V where fv_V: "bij_betw fv_V GV HV"
    using \<open>card GV = _\<close> \<open>card HV = _\<close> \<open>finite GV\<close> \<open>finite HV\<close> by (metis finite_same_card_bij)

  define fv where "fv x = (if x \<in> GU then fv_U x else fv_V x)" for x
  have "\<And>x. x \<in> GV \<Longrightarrow> x \<notin> GU" using \<open>GU \<inter> GV = {}\<close> by blast
  then have bij_fv_UV: "bij_betw fv GU HU" "bij_betw fv GV HV"
    using fv_U fv_V by (auto simp: fv_def cong: bij_betw_cong)
  then have "bij_betw fv (verts G) (verts H)"
    unfolding \<open>verts G = _\<close> \<open>verts H = _\<close> using \<open>HU \<inter> _ = {}\<close> by (rule bij_betw_combine)
  then have fv: "inj_on fv (verts G)" "verts H = fv ` verts G" by (auto simp: bij_betw_def)

  have "arcs_ends H = HU \<times> HV \<union> HV \<times> HU"
    using \<open>K\<^bsub>m,n\<^esub> H\<close> H_parts by (auto simp: complete_digraph_def)
  also have "\<dots> = pairself fv ` (GU \<times> GV \<union> GV \<times> GU)" (is "?L = ?R")
  proof (intro set_eqI iffI)
    fix x assume "x \<in> ?L"
    then have "(fst x \<in> fv ` GU \<and> snd x \<in> fv ` GV) \<or> (fst x \<in> fv ` GV \<and> snd x \<in> fv ` GU)"
      using bij_fv_UV by (auto simp: bij_betw_def)
    then show "x \<in> ?R"
      by (cases x) (auto simp: pairself_image_prod image_Un)
  next
    fix x assume "x \<in> ?R" then show "x \<in> ?L"
      using bij_fv_UV by (auto simp: pairself_image_prod image_Un bij_betw_def)
  qed
  also have "\<dots> = pairself fv ` arcs_ends G"
    using \<open>K\<^bsub>m,n\<^esub> G\<close> G_parts by (auto simp: complete_bipartite_digraph_def)
  finally have arcs_ends: "arcs_ends H = pairself fv ` arcs_ends G" .

  show ?thesis using H.nomulti_digraph fv arcs_ends by (rule G.digraph_iso_mk_iso_nomulti)
qed

lemma K5_not_comb_planar:
  assumes "K\<^bsub>5\<^esub> G" shows "\<not>comb_planar G"
proof -
  interpret graph G using assms by (auto simp: complete_digraph_def)
  have "digraph_iso G c_K5"
    using assms complete_c_K5 by (rule complete_digraph_are_iso)
  then obtain hom where hom: "digraph_isomorphism hom" "app_iso hom G = c_K5"
    by (auto simp: digraph_iso_def)
  then show ?thesis using c_K5_not_comb_planar comb_planar_iso by fastforce
qed

lemma K33_not_comb_planar:
  assumes "K\<^bsub>3,3\<^esub> G" shows "\<not>comb_planar G"
proof -
  interpret graph G using assms by (auto simp: complete_bipartite_digraph_def)
  have "digraph_iso G c_K33"
    using assms complete_c_K33 by (rule complete_bipartite_digraph_are_iso)
  then obtain hom where hom: "digraph_isomorphism hom" "app_iso hom G = c_K33"
    by (auto simp: digraph_iso_def)
  then show ?thesis using c_K33_not_comb_planar comb_planar_iso by fastforce
qed

end