theory WOP_koenig
imports Main
begin

type_synonym 'a Edge = "'a \<times> 'a"

record 'a Graph =
  verts :: "'a set" ("V\<index>")
  arcs :: "'a Edge set" ("E\<index>")
abbreviation is_arc :: "('a, 'b) Graph_scheme \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl "\<rightarrow>\<index>" 60) where
  "v \<rightarrow>\<^bsub>G\<^esub> w \<equiv> (v,w) \<in> E\<^bsub>G\<^esub>"

locale Graph =
  fixes G :: "('a, 'b) Graph_scheme" (structure)
  assumes finite_vertex_set: "finite V"
    and valid_edge_set: "E \<subseteq> V \<times> V"
    and undirected: "v\<rightarrow>w = w\<rightarrow>v"
    and bipartit: "\<exists>A B.(A \<union> B = V) \<and> (\<forall>a \<in> A. (\<not>(\<exists>b \<in> A. ((a, b) \<in> E )))) \<and>
      (\<forall>a \<in> B. (\<not>(\<exists>b \<in> B. ((a, b) \<in> E )))) \<and> (\<forall>v \<in> V. \<not>(v \<in> A \<and> v \<in> B))"
begin

fun neighbors :: "'a \<Rightarrow> 'a set" where
"neighbors v = {w . (v, w) \<in> E}"

fun degree :: "'a \<Rightarrow> nat" where
"degree v = (if neighbors v = {} then 0 else card (neighbors v))"

(* Für leeren Graph sei max_deg = 0*)
definition max_degree :: "nat" where
"max_degree = (if (V = {}) then 0 else Max {degree v| v. v \<in> V})"

(*TODO*)
lemma max_deg_k: "(max_degree = k) = (if (V = {}) then (k = 0) else (\<not>(\<exists>w \<in> V. degree w > k) \<and> (\<exists>u \<in> V. degree u = k)))"
  sorry
proof(simp)
  assume A1: "(max_degree = k)"
  then have "(if (V = {}) then 0 else Max {degree v| v. v \<in> V}) = k" by (unfold max_degree_def)
  then have A2: "(V = {} \<longrightarrow> k=0)  \<and> (V\<noteq>{} \<longrightarrow> Max {degree v| v. v \<in> V} = k)"
  by presburger
  show "(V = {} \<longrightarrow> k = 0) \<and>
    (V \<noteq> {} \<longrightarrow>
     (\<forall>w\<in>V. (\<exists>x. w \<rightarrow> x) \<longrightarrow> \<not> k < card {wa. w \<rightarrow> wa}) \<and>
     (\<exists>u\<in>V. ((\<forall>x. (u, x) \<notin> E) \<longrightarrow> k = 0) \<and> ((\<exists>x. u \<rightarrow> x) \<longrightarrow> card {w. u \<rightarrow> w} = k)))"
  proof(rule conjI)
    show "V = {} \<longrightarrow> k = 0"
    proof(rule impI)
      assume A3: "V = {}"
      from this A2 show " k = 0" by simp
    qed
  next
    show " V \<noteq> {} \<longrightarrow>
    (\<forall>w\<in>V. (\<exists>x. w \<rightarrow> x) \<longrightarrow> \<not> k < card {wa. w \<rightarrow> wa}) \<and>
    (\<exists>u\<in>V. ((\<forall>x. (u, x) \<notin> E) \<longrightarrow> k = 0) \<and> ((\<exists>x. u \<rightarrow> x) \<longrightarrow> card {w. u \<rightarrow> w} = k))"
    proof(rule impI)
      assume A4:"V \<noteq> {}"
      show "(\<forall>w\<in>V. (\<exists>x. w \<rightarrow> x) \<longrightarrow> \<not> k < card {wa. w \<rightarrow> wa}) \<and>
    (\<exists>u\<in>V. ((\<forall>x. (u, x) \<notin> E) \<longrightarrow> k = 0) \<and> ((\<exists>x. u \<rightarrow> x) \<longrightarrow> card {w. u \<rightarrow> w} = k))"
      proof(rule conjI)
        from A4 A2 have "(Max {degree v| v. v \<in> V} = k)" by simp
        then have "(Max{(if neighbors v = {} then 0 else card (neighbors v))|v. v\<in> V}) = k" by simp
        oops

(*leerer Graph sei 0 regulär*)
definition k_reg :: "nat \<Rightarrow> bool" where
"k_reg (k::nat) \<equiv> (if (V = {}) then (k=0) else  (\<forall>v \<in> V. (degree v) = k))"

(*Perfektes Matching:
A ist ein perfektes Matching wenn jeder Knoten von A abgedeckt ist aber nur einmal getroffen wird.*)
definition perf_match :: "'a Edge set \<Rightarrow> bool" where
"perf_match A \<equiv> (\<forall>v \<in> V.\<exists>e \<in> A. \<exists>w \<in> V. e = (v, w) \<and> (\<forall>f \<in> A. (e = f) \<or> \<not>(\<exists>u \<in> V. f = (v, u))))"

definition perf_match_alt :: "'a Edge set \<Rightarrow> bool" where
"perf_match_alt A \<equiv> (\<forall>v \<in> V.\<exists>e \<in> A. \<exists>w \<in> V. e = (v, w) \<and> (\<forall>u \<in> V. (u=w \<or> \<not>((v, u)\<in>A))))"

definition perf_match_alt2 :: "'a Edge set \<Rightarrow> bool" where
"perf_match_alt2 A \<equiv> (\<forall>v \<in> V. \<exists>w \<in>V. (v, w) \<in> A \<and> (\<forall>u \<in> V. u = w \<or> \<not>((v, u) \<in> A)))"

lemma "perf_match_alt A = perf_match A"
  by (smt (verit) Graph.perf_match_def Graph_axioms perf_match_alt_def prod.inject)

lemma "perf_match A = perf_match_alt2 A"
  by (smt (verit, del_insts) Pair_inject perf_match_alt2_def perf_match_def)

(* Für k=0: Wenn E \<noteq> {} dann ist A={} keine Zerlegung, aber im Kontext k-regulär reicht das.*)
definition perf_match_zerlegung :: "'a Edge set set \<Rightarrow> nat \<Rightarrow> bool" where
"perf_match_zerlegung A k \<equiv> (if k=0 then A={}
else (card A = k \<and> (\<forall>a \<in> E. \<exists>B \<in> A. a \<in> B) \<and> (\<forall>B \<in> A. perf_match_alt2 B \<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> A. B2 \<noteq> B \<and> a \<in> B2)))))"

(*Kantenmenge sodass keine zwei Kanten zu dem gleichen Knoten inzident sind.*)
(*matching*)
definition class2 :: "('a Edge set) \<Rightarrow> bool" where
"class2 A \<equiv> (\<forall>(v, w) \<in> A. (v, w) \<in> E \<and> \<not>(\<exists>e \<in> A. (v, w) \<noteq> e \<and> (\<exists>u \<in> V. e = (v, u))))"

(*Menge A ist class2-Mengen Zerlegung*)
definition is_k_class_decompos ::"('a Edge set) set \<Rightarrow> nat \<Rightarrow> bool" where
"is_k_class_decompos A k \<equiv> (if k=0 then (A={} \<and> E={}) else
(card A = k) \<and> (\<forall>B \<in> A. class2 B \<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> A. B2 \<noteq> B \<and> a \<in> B2))) \<and> (\<forall>e \<in> E. \<exists>B \<in> A. e \<in> B))"

(*Wenn Graph endlich, bipartit, max Grad k dann gibt es eine Zerlegung in k Klassen,
sodass zwei Klassen mit inzidentem Knoten immer zu verschiedenen Klassen gehören.*)
lemma 15:
  fixes k::nat
  assumes A1: "max_degree = k"
  shows "\<exists>A. is_k_class_decompos A k"
  sorry

(*Nur Definitionen eingesetzt, mit Try auch möglich*)
lemma k_reg_k_max: "k_reg k \<Longrightarrow> (max_degree = k)"
proof-
  assume A1: "k_reg k"
  show "(max_degree = k)"
  proof(unfold max_deg_k)
    show "if V = {} then k = 0 else \<not> (\<exists>w\<in>V. k < degree w) \<and> (\<exists>u\<in>V. degree u = k)"
    proof(simp)
      from A1 have A2: "(if (V = {}) then (k=0) else  (\<forall>v \<in> V. (degree v) = k))"
        by (unfold k_reg_def)
      have A3: "(if (V = {}) then (k=0) else  (\<forall>v \<in> V. (degree v) = k)) =
        (((V = {}) \<longrightarrow> (k = 0)) \<and> ((V \<noteq> {}) \<longrightarrow> ((\<forall>v \<in> V. (degree v) = k))))"
        by simp
      from A2 this have A4:"(V = {} \<longrightarrow> k = 0)" by simp
      from A2 this have A5: "((V \<noteq> {}) \<longrightarrow> ((\<forall>v \<in> V. (degree v) = k)))" by metis
      show "(V = {} \<longrightarrow> k = 0) \<and>
    (V \<noteq> {} \<longrightarrow>
     (\<forall>w\<in>V. (\<exists>x. w \<rightarrow> x) \<longrightarrow> \<not> k < card {wa. w \<rightarrow> wa}) \<and>
     (\<exists>u\<in>V. ((\<forall>x. (u, x) \<notin> E) \<longrightarrow> k = 0) \<and> ((\<exists>x. u \<rightarrow> x) \<longrightarrow> card {w. u \<rightarrow> w} = k)))"
      proof(rule conjI)
        from A4 show  "V = {} \<longrightarrow> k = 0" by assumption
      next
        show "V \<noteq> {} \<longrightarrow>
    (\<forall>w\<in>V. (\<exists>x. w \<rightarrow> x) \<longrightarrow> \<not> k < card {wa. w \<rightarrow> wa}) \<and>
    (\<exists>u\<in>V. ((\<forall>x. (u, x) \<notin> E) \<longrightarrow> k = 0) \<and> ((\<exists>x. u \<rightarrow> x) \<longrightarrow> card {w. u \<rightarrow> w} = k))"
        proof(rule impI)
          assume A6: "V \<noteq> {}"
          from A6 A5 have A7: "(\<forall>v \<in> V. (degree v) = k)"
          using A5 by fastforce
          then have A9: "(\<forall>v \<in> V. card (neighbors v) = k)"
            by auto
          then have A10: "(\<forall>v \<in> V. card ({w . (v, w) \<in> E}) = k)"
            by (unfold local.neighbors.simps)
          show "(\<forall>w\<in>V. (\<exists>x. w \<rightarrow> x) \<longrightarrow> \<not> k < card {wa. w \<rightarrow> wa}) \<and>
    (\<exists>u\<in>V. ((\<forall>x. (u, x) \<notin> E) \<longrightarrow> k = 0) \<and> ((\<exists>x. u \<rightarrow> x) \<longrightarrow> card {w. u \<rightarrow> w} = k))"
          proof(rule conjI)
            from A9 show "\<forall>w\<in>V. (\<exists>x. w \<rightarrow> x) \<longrightarrow> \<not> k < card {wa. w \<rightarrow> wa}" by simp
          next
            from A6 A9 show "\<exists>u\<in>V. ((\<forall>x. (u, x) \<notin> E) \<longrightarrow> k = 0) \<and> ((\<exists>x. u \<rightarrow> x) \<longrightarrow> card {w. u \<rightarrow> w} = k)"
              by auto
          qed
        qed
      qed
    qed
  qed
qed

(*Beweisidee: Da sonst eine der anderen Klassen min. 2 Kanten zu einem Knoten haben müsste, was
keine korrekte Zerlegung mehr wäre.*)
lemma k_reg_theorem_15:
  fixes k::nat
  assumes A1: "k_reg k"
(*aufschlüsselung: Es gibt eine Zerlegung A. Für jede Zerlegung gilt, jedes Matching der Zerlegung
enthält für jeden Knoten genau eine inzidente Kante.*)
  shows "(\<exists>A. is_k_class_decompos A k) \<and>
(\<forall>A. (is_k_class_decompos A k) \<longrightarrow> (\<forall>B \<in> A. \<forall>v \<in> V. (\<exists>w \<in> V. (v, w) \<in> B \<and> (\<forall>u \<in> V. u=w \<or> (v, u) \<notin> B))))"
  sorry

(*nichtmehr benötigt*)
lemma perf_match_2:
  fixes A::"'a Edge set"
  shows "(\<forall>v \<in> V. (\<exists>w \<in> V. (v, w) \<in> A \<and> (\<forall>u \<in> V. u=w \<or> (v, u) \<notin> A))) \<Longrightarrow> perf_match A"
proof-
  assume A1: "(\<forall>v \<in> V. (\<exists>w \<in> V. (v, w) \<in> A \<and> (\<forall>u \<in> V. u=w \<or> (v, u) \<notin> A)))"
  show "perf_match A"
  proof(unfold perf_match_def)
    show "\<forall>v\<in>V. \<exists>e\<in>A. \<exists>w\<in>V. e = (v, w) \<and> (\<forall>f\<in>A. e = f \<or> \<not> (\<exists>u\<in>V. f = (v, u)))"
    proof(rule ballI)
      fix v
      assume A2: "v \<in> V"
      from A1 this have A3: "(\<exists>w \<in> V. (v, w) \<in> A \<and> (\<forall>u \<in> V. u=w \<or> (v, u) \<notin> A))"
        by (rule bspec)
      then obtain w1 where A4: "(v, w1) \<in> A \<and> (\<forall>u \<in> V. u=w1 \<or> (v, u) \<notin> A)"
        by (rule bexE)
      then have A5: "(v, w1) \<in> A " by (rule conjE)
      from A4 have A6: "(\<forall>u \<in> V. u=w1 \<or> (v, u) \<notin> A)" by (rule conjE)
          (*Sledgehammering*)
      from A5 have A7: "w1 \<in> V"
        using A3 A4 by fastforce
      show "\<exists>e\<in>A. \<exists>w\<in>V. e = (v, w) \<and> (\<forall>f\<in>A. e = f \<or> \<not> (\<exists>u\<in>V. f = (v, u)))"
      proof(rule bexI)
        show "\<exists>w\<in>V. (v, w1) = (v, w) \<and> (\<forall>f\<in>A. (v, w1) = f \<or> \<not> (\<exists>u\<in>V. f = (v, u)))"
        proof(rule bexI)
          show "(v, w1) = (v, w1) \<and> (\<forall>f\<in>A. (v, w1) = f \<or> \<not> (\<exists>u\<in>V. f = (v, u)))"
          proof(rule conjI)
            show "(v, w1) = (v, w1)" by simp
          next
            show "\<forall>f\<in>A. (v, w1) = f \<or> \<not> (\<exists>u\<in>V. f = (v, u))"
            proof(rule ballI)
              fix f
              assume A8: "f \<in> A"
              have A9: "(v, w1) = f \<or> (v, w1) \<noteq> f" by simp
              then show "(v, w1) = f \<or> \<not> (\<exists>u\<in>V. f = (v, u))"
              proof(rule disjE)
                assume "(v, w1) = f"
                then show "(v, w1) = f \<or> \<not> (\<exists>u\<in>V. f = (v, u))" by simp
              next
                assume A10: "(v, w1) \<noteq> f"
                show "(v, w1) = f \<or> \<not> (\<exists>u\<in>V. f = (v, u))"
                proof(rule disjI2)
                  show "\<not> (\<exists>u\<in>V. f = (v, u))"
                  proof(unfold bex_simps)
                    show " \<forall>x\<in>V. f \<noteq> (v, x)"
                    proof(rule ballI)
                      fix x
                      assume "x \<in> V"
                      show "f \<noteq> (v, x)"
                        using A10 A4 A8 \<open>x \<in> V\<close> by fastforce
                    qed
                  qed
                qed
              qed
            qed
          qed
          from A7 show "w1 \<in> V" by assumption
        qed
        from A5 show "(v, w1) \<in> A " by assumption
      qed
    qed
  qed
qed

lemma perf_matching_empty:
"V = {} \<Longrightarrow> perf_match {}"
  using perf_match_def by auto

lemma 14[simp]:
  fixes k ::nat
  assumes A1: "(k_reg k)"
(*B: Mengen an prfekten Matchings
A, A2: einzelne perfekte Matchings
a: Kanten in den Matchings (A, A2)*)
(*Aussage aufgeschlüsselt: Es gibt eine Zerlegung B, sodass B aus k perfekten Matchings besteht und diese
Matchings paarweise disjunkt sind. *)
  shows "\<exists>B. ((k=0 \<longrightarrow> B = {}) \<and>
(\<not>(k=0) \<longrightarrow> (B = {A. (perf_match A)} \<and> (\<forall>a \<in> E. \<exists>A \<in> B. a \<in> A) \<and> card B = k)))"
proof-
from A1 have A2: "max_degree = k" by (rule k_reg_k_max)
  then have A3: "\<exists>C. is_k_class_decompos C k" by (rule 15)
  then obtain C where A4: "is_k_class_decompos C k" by (rule exE)
  from k_reg_theorem_15 A1 A4 have A5: "(\<forall>B \<in> C. \<forall>v \<in> V. (\<exists>w \<in> V. (v, w) \<in> B \<and> (\<forall>u \<in> V. u=w \<or> (v, u) \<notin> B)))"
    by simp
  have A6: "card C = k" using A4 is_k_class_decompos_def
    by (metis card.empty)
  show "\<exists>B. (k = 0 \<longrightarrow> B = {}) \<and>
(k \<noteq> 0 \<longrightarrow> B = Collect perf_match \<and>  (\<forall>a \<in> E. \<exists>A \<in> B. a \<in> A)\<and> card B = k)"
  proof(rule exI)
    have "k \<noteq> 0 \<longrightarrow> C = {A. (perf_match A)}" sorry
    show "(k = 0 \<longrightarrow> C = {}) \<and>
(k \<noteq> 0 \<longrightarrow> C = Collect perf_match \<and> (\<forall>a \<in> E. \<exists>A \<in> C. a \<in> A) \<and> card C = k)"
    proof(rule conjI)
      show "k = 0 \<longrightarrow> C = {}"
      proof(rule impI)
        assume A8: "k = 0"
        show "C = {}"
        proof-
          from A4 have "(if k=0 then C={} else
(card C = k) \<and> (\<forall>B \<in> C. class2 B) \<and> (\<forall>e \<in> E. \<exists>B \<in> C. e \<in> B))"
            by (simp add: Graph.is_k_class_decompos_def Graph_axioms)
          then have "k=0 \<longrightarrow> C={}" by simp
          from this A8 show "C={}" by simp
        qed
      qed
    next
      show " k \<noteq> 0 \<longrightarrow> C = Collect perf_match \<and> (\<forall>a\<in>E. \<exists>A\<in>C. a \<in> A) \<and> card C = k "
      proof(rule impI)
        assume "k \<noteq> 0"
        show "C = Collect perf_match \<and> (\<forall>a\<in>E. \<exists>A\<in>C. a \<in> A) \<and> card C = k"
          using A4 \<open>k \<noteq> 0 \<longrightarrow> C = Collect perf_match\<close> \<open>k \<noteq> 0\<close> is_k_class_decompos_def by auto
      qed
    qed
  qed
qed

(*Theorem 14 von König*)
lemma koenig:
  fixes k::nat
  assumes A1: "k_reg k"
  shows "\<exists>A. perf_match_zerlegung A k"
proof-
(*Aus Theorem 15 die Matching Zerlegung obtained*)
  from A1 have A2: "max_degree = k" by (rule k_reg_k_max)
  then have A3: "\<exists>C. is_k_class_decompos C k" by (rule 15)
  then obtain C where A4: "is_k_class_decompos C k" by (rule exE)
(*Definitionen einsetzen*)
  then have "(if k=0 then (C={} \<and> E={}) else
(card C = k) \<and> (\<forall>B \<in> C. class2 B \<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> C. B2 \<noteq> B \<and> a \<in> B2))) \<and> (\<forall>e \<in> E. \<exists>B \<in> C. e \<in> B))"
    by (unfold is_k_class_decompos_def)
  then have A5: "(k=0\<longrightarrow>(C={} \<and> E={})) \<and>
(k \<noteq>0 \<longrightarrow> ((card C = k) \<and> (\<forall>B \<in> C. class2 B \<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> C. B2 \<noteq> B \<and> a \<in> B2))) \<and> (\<forall>e \<in> E. \<exists>B \<in> C. e \<in> B)))"
    by simp
  then have A6: "k=0\<longrightarrow>(C={} \<and> E={})" by (rule conjE)
  from A5 have A7:
(*C besteht aus k Mengen, jede der Mengen ist eine class2/ein Matching,
C ist eine Zerlegung (Mengen disjunkt, alle Kanten enthalten.)*)
"(k \<noteq>0 \<longrightarrow> ((card C = k) \<and> (\<forall>B \<in> C. class2 B \<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> C. B2 \<noteq> B \<and> a \<in> B2))) \<and> (\<forall>e \<in> E. \<exists>B \<in> C. e \<in> B)))"
    by (rule conjE)
  then have A8: "(k \<noteq> 0 \<longrightarrow> (\<forall>e \<in> E. \<exists>B \<in> C. e \<in> B))"
    by simp
  from A7 have A9: "(k \<noteq> 0 \<longrightarrow>(\<forall>B \<in> C. class2 B \<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> C. B2 \<noteq> B \<and> a \<in> B2))))"
    by simp
(*zZ.: Matching Zerlegung ist auch perfekte Matching zerlegung*)
  have A_C: "perf_match_zerlegung C k"
(*Definitionen einsetzen*)
  proof(unfold perf_match_zerlegung_def)
    show "if k = 0 then C = {}
else card C = k \<and> (\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. perf_match_alt2 B \<and> (\<forall>a\<in>B. \<not> (\<exists>B2\<in>C. B2 \<noteq> B \<and> a \<in> B2)))"
    proof(simp)
      show "(k = 0 \<longrightarrow> C = {}) \<and> (0 < k \<longrightarrow> card C = k \<and> (\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. perf_match_alt2 B \<and> (\<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2)))"
      proof(rule conjI)
        from A6 show "k = 0 \<longrightarrow> C = {}" by simp
      next
(*zZ: Zerlegung aus k perfekten Matchings*)
        show "0 < k \<longrightarrow> card C = k \<and> (\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. perf_match_alt2 B \<and> (\<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2))"
        proof(rule impI)
          assume Ak: "0 < k"
          show "card C = k \<and> (\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. perf_match_alt2 B \<and> (\<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2))"
          proof(rule conjI)
            from A7 show "card C = k"
              using A5 by fastforce
          next
            show "(\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. perf_match_alt2 B \<and> (\<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2))"
            proof(rule conjI)
              from A8 Ak show "\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B" by simp
            next
(*zZ: jede Menge ist ein perfektes Matching (und Zerlegung ist disjunkt)*)
              show "\<forall>B\<in>C. perf_match_alt2 B \<and> (\<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2)"
              proof(rule ballI)
                fix B
                assume AB: "B \<in> C"
(*Da B \<in> C gilt ist B ein Matching mit allen Eigenschaften*)
                from Ak A9 have "(\<forall>B \<in> C. class2 B \<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> C. B2 \<noteq> B \<and> a \<in> B2)))"
                  by simp
                then have A10: "(\<forall>B \<in> C.
(\<forall>(v, w) \<in> B. (v, w) \<in> E \<and> \<not>(\<exists>e \<in> B. (v, w) \<noteq> e \<and> (\<exists>u \<in> V. e = (v, u))))
\<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> C. B2 \<noteq> B \<and> a \<in> B2)))"
                  by (unfold class2_def)
                from this AB have A11: "(\<forall>(v, w) \<in> B. (v, w) \<in> E \<and> \<not>(\<exists>e \<in> B. (v, w) \<noteq> e \<and> (\<exists>u \<in> V. e = (v, u))))
\<and> (\<forall>a \<in> B. \<not>(\<exists>B2 \<in> C. B2 \<noteq> B \<and> a \<in> B2))"
                  by (rule bspec)
                then have A12: "(\<forall>(v, w) \<in> B.\<not>(\<exists>e \<in> B. (v, w) \<noteq> e \<and> (\<exists>u \<in> V. e = (v, u))))"
                  by blast
                then have A13: "(\<forall>(v, w) \<in> B.(\<forall>e \<in> B. \<not>((v, w) \<noteq> e \<and> (\<exists>u \<in> V. e = (v, u)))))" by (unfold bex_simps)
                then have A14:  "(\<forall>(v, w) \<in> B.(\<forall>e \<in> B. ((v, w) = e \<or> (\<forall>u \<in> V. e \<noteq> (v, u)))))" by simp
                from A11 have A15: "(\<forall>a \<in> B. \<not>(\<exists>B2 \<in> C. B2 \<noteq> B \<and> a \<in> B2))"
                  by (rule conjE)
                show "perf_match_alt2 B \<and> (\<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2)"
                proof(rule conjI)
(*Zerlegung ist disjunkt*)
                  from A11 show "\<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2" by simp
                next
(*zZ: B ist perfektes Matching*)
                  show "perf_match_alt2 B"
                  proof(unfold perf_match_alt2_def)
                    show "\<forall>v\<in>V. \<exists>w\<in>V. (v, w) \<in> B \<and> (\<forall>u\<in>V. u = w \<or> (v, u) \<notin> B)"
(*Besserer Ansatz: *)
(*Widerspruchsbeweis:
                    proof(rule ccontr)
                      assume WA1: "\<not>(\<forall>v\<in>V. \<exists>w\<in>V. (v, w) \<in> B \<and> (\<forall>u\<in>V. u = w \<or> (v, u) \<notin> B))"
                      then have "(\<exists>v\<in>V. \<forall>w\<in>V. \<not>((v, w) \<in> B \<and> (\<forall>u\<in>V. u = w \<or> (v, u) \<notin> B)))"
                        by simp
                      then have "(\<exists>v\<in>V. \<forall>w\<in>V. ((v, w) \<notin> B \<or> (\<exists>u\<in>V. \<not> (u = w \<or> (v, u) \<notin> B))))"
                        by simp
*)
(*Eigentlich nur umformungen:*)
                    proof(rule ballI)
                      fix v
                      assume Av: "v \<in> V"
                      show "\<exists>w\<in>V. (v, w) \<in> B \<and> (\<forall>u\<in>V. u = w \<or> (v, u) \<notin> B)"
                      proof(rule bexI)
                        from A1 Ak have "E \<noteq> {}"
                          by (metis A6 AB degree.simps empty_Collect_eq empty_iff k_reg_def k_reg_k_max neighbors.simps)
                        then obtain w where A16: "(v, w) \<in> B"
                          by (meson A4 AB \<open>v \<in> V\<close> assms k_reg_theorem_15)
                        from A14 A16 have A17: "(\<forall>e \<in> B. ((v, w) = e \<or> (\<forall>u \<in> V. e \<noteq> (v, u))))" by blast
                        have "(\<forall>u\<in>V. u = w \<or> (v, u) \<notin> B)"
                        proof
                          fix u
                          assume "u \<in> V"
                          have A18: "u = w \<or> u \<noteq> w" by simp
                          then show "u = w \<or> (v, u) \<notin> B"
                          proof(rule disjE)
                            assume "u = w"
                            then show "u = w \<or> (v, u) \<notin> B" by simp
                          next
                            assume "u \<noteq> w"
                            show "u = w \<or> (v, u) \<notin> B"sorry
                            (*proof(rule disjI2)*)

                qed
              qed
            qed
          qed
        qed
      qed
    qed
  qed
  from A_C show "\<exists>A. perf_match_zerlegung A k" by auto
qed

(*
  from k_reg_theorem_15 A1 A4 have A5: "(\<forall>B \<in> C. \<forall>v \<in> V. (\<exists>w \<in> V. (v, w) \<in> B \<and> (\<forall>u \<in> V. u=w \<or> (v, u) \<notin> B)))"
    by simp
  from A4 have A6: "(if k=0 then (C={} \<and> E={}) else
(card C = k) \<and> (\<forall>B \<in> C. class2 B) \<and> (\<forall>e \<in> E. \<exists>B \<in> C. e \<in> B))" by (unfold is_k_class_decompos_def)
  then have A7: "k=0 \<longrightarrow> C ={} \<and> k > 0 \<longrightarrow> (card C = k) \<and> (\<forall>B \<in> C. class2 B) \<and> (\<forall>e \<in> E. \<exists>B \<in> C. e \<in> B)"
    by simp
  show "\<exists>A. perf_match_zerlegung A k"
  proof(rule exI)
    show "perf_match_zerlegung C k"
    proof(unfold perf_match_zerlegung_def)
      show "if k = 0 then C = {} else card C = k \<and> (\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. \<forall>a\<in>B. \<not> (\<exists>B2\<in>C. B2 \<noteq> B \<and> a \<in> B2))"
      proof(simp)
        show "(k = 0 \<longrightarrow> C = {}) \<and> (0 < k \<longrightarrow> card C = k \<and> (\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. \<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2))"
        proof(rule conjI)
          show "k = 0 \<longrightarrow> C = {}"
          proof(rule impI)
            assume A8: "k = 0"
            from this A6 show "C = {}" by simp
          qed
        next
          show "0 < k \<longrightarrow> card C = k \<and> (\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. \<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2)"
          proof(rule impI)
            assume A8: "0 < k"
            show "card C = k \<and> (\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. \<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2)"
            proof(rule conjI)
              from A8 A6 show "card C = k" by simp
            next
              show "(\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B) \<and> (\<forall>B\<in>C. \<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2)"
              proof(rule conjI)
                from A8 A7 have A9: "(\<forall>B \<in> C. class2 B)"
                  using A6 by presburger
                from A6 A8 have A10: "(\<forall>e \<in> E. \<exists>B \<in> C. e \<in> B)" by simp
                show "\<forall>a\<in>E. \<exists>B\<in>C. a \<in> B"
                proof(rule ballI)
                  fix a
                  assume A11:"a\<in>E"
                  from A10 A11 show "\<exists>B\<in>C. a \<in> B" by (rule bspec)
                qed
              next
                show "(\<forall>B\<in>C. \<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2)"
                proof(rule ballI)
                  fix B
                  assume A12: "B \<in> C"
                  show "\<forall>a\<in>B. \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2"
                  proof(rule ballI)
                    fix a
                    assume A13: "a \<in> B"
                    show " \<forall>B2\<in>C. B2 = B \<or> a \<notin> B2"
                    proof(rule ballI)
                      fix B2
                      assume A14: "B2 \<in> C"
                      have A15: "B2 = B \<or> B2 \<noteq> B" by simp
                      then show "B2 = B \<or> a \<notin> B2"
                      proof(rule disjE)
                        assume "B2=B" then show "B2 = B \<or> a \<notin> B2" by simp
                      next
                        assume A16: "B2 \<noteq> B"
                        show "B2 = B \<or> a \<notin> B2"
                        proof(rule disjI2) oops

*)

end
end


(* Author: Alexander Maletzky *)

section \<open>More Stuff about Multivariate Polynomials with Power-Products Represented by Polynomial Mappings\<close>

theory More_MPoly_PM
  imports Polynomials.MPoly_PM
begin

subsection \<open>Order relation on polynomial mappings\<close>

definition le_pm :: "('a \<Rightarrow>\<^sub>0 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>0 'b::{ord,zero}) \<Rightarrow> bool" (infixl "\<unlhd>" 50)
  where "le_pm s t \<longleftrightarrow> lookup s \<le> lookup t"

lemma le_pmI: "(\<And>x. lookup s x \<le> lookup t x) \<Longrightarrow> s \<unlhd> t"
  unfolding le_pm_def le_fun_def ..

lemma le_pmD: "s \<unlhd> t \<Longrightarrow> lookup s x \<le> lookup t x"
  by (simp add: le_pm_def le_fun_def)

lemma le_pm_refl [simp]: "s \<unlhd> (s::_ \<Rightarrow>\<^sub>0 _::preorder)"
  by (simp add: le_pm_def)

lemma le_pm_antisym: "s \<unlhd> t \<Longrightarrow> t \<unlhd> s \<Longrightarrow> s = (t::_ \<Rightarrow>\<^sub>0 _::order)"
  by (simp only: le_pm_def poly_mapping_eq_iff in_keys_iff)

lemma le_pm_trans [trans]: "s \<unlhd> t \<Longrightarrow> t \<unlhd> u \<Longrightarrow> s \<unlhd> (u::_ \<Rightarrow>\<^sub>0 _::preorder)"
  by (auto simp: le_pm_def dest: order_trans)

lemma le_pm_mono_plus_right: "s \<unlhd> t \<Longrightarrow> s + u \<unlhd> t + (u::_ \<Rightarrow>\<^sub>0 _::ordered_ab_semigroup_add)"
  by (simp add: le_pm_def lookup_plus_fun le_fun_def add_right_mono)

lemma le_pm_mono_plus_left: "s \<unlhd> t \<Longrightarrow> u + s \<unlhd> u + (t::_ \<Rightarrow>\<^sub>0 _::ordered_ab_semigroup_add)"
  by (simp add: le_pm_def lookup_plus_fun le_fun_def add_left_mono)

lemma le_pm_mono_plus: "s \<unlhd> t \<Longrightarrow> u \<unlhd> v \<Longrightarrow> s + u \<unlhd> t + (v::_ \<Rightarrow>\<^sub>0 _::ordered_ab_semigroup_add)"
  by (simp add: le_pm_def lookup_plus_fun le_fun_def add_mono)

lemma le_pm_increasing: "0 \<unlhd> u \<Longrightarrow> s \<unlhd> t \<Longrightarrow> s \<unlhd> u + (t::_ \<Rightarrow>\<^sub>0 _::ordered_comm_monoid_add)"
  using le_pm_mono_plus[of 0 u s t] by simp

lemma le_pm_increasing2: "0 \<unlhd> u \<Longrightarrow> s \<unlhd> t \<Longrightarrow> s \<unlhd> t + (u::_ \<Rightarrow>\<^sub>0 _::ordered_comm_monoid_add)"
  by (simp add: le_pm_increasing add.commute[of t])

lemma le_pm_decreasing: "u \<unlhd> 0 \<Longrightarrow> s \<unlhd> t \<Longrightarrow> u + s \<unlhd> (t::_ \<Rightarrow>\<^sub>0 _::ordered_comm_monoid_add)"
  using le_pm_mono_plus[of u 0 s t] by simp

lemma le_pm_decreasing2: "u \<unlhd> 0 \<Longrightarrow> s \<unlhd> t \<Longrightarrow> s + u \<unlhd> (t::_ \<Rightarrow>\<^sub>0 _::ordered_comm_monoid_add)"
  using le_pm_mono_plus[of s t u 0] by simp

lemma zero_le_pm: "0 \<unlhd> (t::_ \<Rightarrow>\<^sub>0 _::add_linorder_min)"
  by (simp add: le_pmI)

lemma le_pm_mono_minus: "s \<unlhd> t \<Longrightarrow> s - u \<unlhd> t - (u::_ \<Rightarrow>\<^sub>0 _::ordered_ab_group_add)"
  by (simp add: le_pm_def lookup_minus_fun)

lemma adds_pmI: "s \<unlhd> t \<Longrightarrow> s adds (t::'a \<Rightarrow>\<^sub>0 'b::add_linorder)"
  by (simp add: le_pm_def, intro adds_poly_mappingI)

lemma adds_pm: "s adds t \<longleftrightarrow> s \<unlhd> (t::'a \<Rightarrow>\<^sub>0 'b::add_linorder_min)"
  by (simp add: adds_poly_mapping le_pm_def)

lemma gcs_le_pm:
  shows "gcs s t \<unlhd> s" and "gcs s t \<unlhd> t"
  by (simp_all add: gcs_leq_fun_1 gcs_leq_fun_2 le_pm_def lookup_gcs_fun)

lemma gcs_ge_pm: "u \<unlhd> s \<Longrightarrow> u \<unlhd> t \<Longrightarrow> u \<unlhd> gcs s t"
  by (simp add: leq_gcs_fun le_pm_def lookup_gcs_fun)

lemma lcs_ge_pm:
  shows "s \<unlhd> lcs s t" and "t \<unlhd> lcs s t"
  by (simp_all add: leq_lcs_fun_1 leq_lcs_fun_2 le_pm_def lookup_lcs_fun)

lemma lcs_le_pm: "s \<unlhd> u \<Longrightarrow> t \<unlhd> u \<Longrightarrow> lcs s t \<unlhd> u"
  by (simp add: lcs_leq_fun le_pm_def lookup_lcs_fun)

lemma gcs_add_distrib_left: "gcs s t + u = gcs (s + u) (t + (u::_ \<Rightarrow>\<^sub>0 _::ordered_ab_semigroup_add_imp_le))"
  by (rule poly_mapping_eqI) (simp only: lookup_gcs_fun lookup_add gcs_fun min_add_distrib_left)

lemma gcs_add_distrib_right: "u + gcs s t = gcs (u + s) (u + (t::_ \<Rightarrow>\<^sub>0 _::ordered_ab_semigroup_add_imp_le))"
  by (rule poly_mapping_eqI) (simp only: lookup_gcs_fun lookup_add gcs_fun min_add_distrib_right)

lemma lcs_add_distrib_left: "lcs s t + u = lcs (s + u) (t + (u::_ \<Rightarrow>\<^sub>0 _::ordered_ab_semigroup_add_imp_le))"
  by (rule poly_mapping_eqI) (simp only: lookup_lcs_fun lookup_add lcs_fun_def max_add_distrib_left)

lemma lcs_add_distrib_right: "u + lcs s t = lcs (u + s) (u + (t::_ \<Rightarrow>\<^sub>0 _::ordered_ab_semigroup_add_imp_le))"
  by (rule poly_mapping_eqI) (simp only: lookup_lcs_fun lookup_add lcs_fun_def max_add_distrib_right)

lemma gcs_diff_distrib_left: "gcs s t - u = gcs (s - u) (t - (u::_ \<Rightarrow>\<^sub>0 _::ordered_ab_group_add))"
  by (rule poly_mapping_eqI) (simp only: lookup_gcs_fun lookup_minus gcs_fun min_diff_distrib_left)

lemma lcs_diff_distrib_left: "lcs s t - u = lcs (s - u) (t - (u::_ \<Rightarrow>\<^sub>0 _::ordered_ab_group_add))"
  by (rule poly_mapping_eqI) (simp only: lookup_lcs_fun lookup_minus lcs_fun_def max_diff_distrib_left)

lemma deg_pm_mono_le: "s \<unlhd> t \<Longrightarrow> deg_pm s \<le> deg_pm (t::'a \<Rightarrow>\<^sub>0 'b::add_linorder)"
  unfolding le_pm_def by (transfer) (auto intro!: deg_fun_leq simp: supp_fun_def)

lemma le_deg_pm_antisym:
  assumes "s \<unlhd> t" and "deg_pm t \<le> deg_pm (s::'a \<Rightarrow>\<^sub>0 'b::add_linorder)"
  shows "s = t"
proof (rule ccontr)
  assume "s \<noteq> t"
  have fin: "finite (keys s \<union> keys t)" by simp
  with _ have "deg_pm s = (\<Sum>x\<in>keys s \<union> keys t. lookup s x)" by (rule deg_pm_superset) simp
  also from fin have "\<dots> < (\<Sum>x\<in>keys s \<union> keys t. lookup t x)"
  proof (rule sum_strict_mono_ex1)
    from assms(1) show "\<forall>x\<in>keys s \<union> keys t. lookup s x \<le> lookup t x"
      by (auto dest: le_pmD)
  next
    from \<open>s \<noteq> t\<close> obtain x where neq: "lookup s x \<noteq> lookup t x" by (auto simp flip: lookup_inject)
    moreover from assms(1) have "lookup s x \<le> lookup t x" by (rule le_pmD)
    ultimately have "lookup s x < lookup t x" by simp
    moreover from neq have "x \<in> keys s \<union> keys t" by (auto simp: in_keys_iff)
    ultimately show "\<exists>x\<in>keys s \<union> keys t. lookup s x < lookup t x" ..
  qed
  also from _ fin have "\<dots> = deg_pm t" by (rule deg_pm_superset[symmetric]) simp
  finally have "deg_pm s < deg_pm t" .
  with assms(2) show False by simp
qed

lemma times_le_interval:
  assumes "x \<le> y + a * z" and "x \<le> y + b * z" and "a \<le> c" and "c \<le> (b::'b::{linorder,ordered_ring})"
  shows "x \<le> y + c * z"
proof (cases "0 \<le> z")
  case True
  from assms(3) True have "y + a * z \<le> y + c * z" by (simp add: add_left_mono mult_right_mono)
  with assms(1) show ?thesis by (rule order_trans)
next
  case False
  hence "z \<le> 0" by simp
  with assms(4) have "y + b * z \<le> y + c * z" by (simp add: add_left_mono mult_right_mono_neg)
  with assms(2) show ?thesis by (rule order_trans)
qed

corollary times_le_interval':
  "x \<le> a * z \<Longrightarrow> x \<le> b * z \<Longrightarrow> a \<le> c \<Longrightarrow> c \<le> (b::'b::{linorder,ordered_ring}) \<Longrightarrow> x \<le> c * z"
  using times_le_interval[of x 0 a z b c] by simp

lemma map_scale_le_interval:
  assumes "x \<unlhd> y + a \<cdot> z" and "x \<unlhd> y + b \<cdot> z" and "a \<le> c" and "c \<le> (b::'b::{linorder,ordered_ring})"
  shows "x \<unlhd> y + c \<cdot> z"
proof (rule le_pmI)
  fix k
  from assms(1) have "lookup x k \<le> lookup (y + a \<cdot> z) k" by (rule le_pmD)
  hence *: "lookup x k \<le> lookup y k + a * lookup z k" by (simp add: lookup_add)
  from assms(2) have "lookup x k \<le> lookup (y + b \<cdot> z) k" by (rule le_pmD)
  hence "lookup x k \<le> lookup y k + b * lookup z k" by (simp add: lookup_add)
  with * have "lookup x k \<le> lookup y k + c * lookup z k" using assms(3, 4) by (rule times_le_interval)
  thus "lookup x k \<le> lookup (y + c \<cdot> z) k" by (simp add: lookup_add)
qed

corollary map_scale_le_interval':
  "x \<unlhd> a \<cdot> z \<Longrightarrow> x \<unlhd> b \<cdot> z \<Longrightarrow> a \<le> c \<Longrightarrow> c \<le> (b::'b::{linorder,ordered_ring}) \<Longrightarrow> x \<unlhd> c \<cdot> z"
  using map_scale_le_interval[of x 0 a z b c] by simp

end (* theory *)