/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

! This file was ported from Lean 3 source module init.propext
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Logic

#print propext /-
axiom propext {a b : Prop} : (a ↔ b) → a = b
#align propext propext
-/

/-! # Additional congruence lemmas. -/

universe u v

#print forall_congr /-
theorem forall_congr {a : Sort u} {p q : a → Prop} (h : ∀ x, p x = q x) : (∀ x, p x) = ∀ x, q x :=
  propext (forall_congr' fun a => (h a).to_iff)
#align forall_congr_eq forall_congr
-/

#print imp_congr_eq /-
theorem imp_congr_eq {a b c d : Prop} (h₁ : a = c) (h₂ : b = d) : (a → b) = (c → d) :=
  propext (imp_congr h₁.to_iff h₂.to_iff)
#align imp_congr_eq imp_congr_eq
-/

#print imp_congr_ctx_eq /-
theorem imp_congr_ctx_eq {a b c d : Prop} (h₁ : a = c) (h₂ : c → b = d) : (a → b) = (c → d) :=
  propext (imp_congr_ctx h₁.to_iff fun hc => (h₂ hc).to_iff)
#align imp_congr_ctx_eq imp_congr_ctx_eq
-/

#print eq_true /-
theorem eq_true {a : Prop} (h : a) : a = True :=
  propext (iff_true_intro h)
#align eq_true_intro eq_true
-/

#print eq_false /-
theorem eq_false {a : Prop} (h : ¬a) : a = False :=
  propext (iff_false_intro h)
#align eq_false_intro eq_false
-/

#print Iff.to_eq /-
theorem Iff.to_eq {a b : Prop} (h : a ↔ b) : a = b :=
  propext h
#align iff.to_eq Iff.to_eq
-/

#print iff_eq_eq /-
theorem iff_eq_eq {a b : Prop} : (a ↔ b) = (a = b) :=
  propext (Iff.intro (fun h => Iff.to_eq h) fun h => h.to_iff)
#align iff_eq_eq iff_eq_eq
-/


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.group_action.defs

/-! # Group actions on and by `Mˣ`

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file provides the action of a unit on a type `α`, `has_smul Mˣ α`, in the presence of
`has_smul M α`, with the obvious definition stated in `units.smul_def`. This definition preserves
`mul_action` and `distrib_mul_action` structures too.

Additionally, a `mul_action G M` for some group `G` satisfying some additional properties admits a
`mul_action G Mˣ` structure, again with the obvious definition stated in `units.coe_smul`.
These instances use a primed name.

The results are repeated for `add_units` and `has_vadd` where relevant.
-/

variables {G H M N : Type*} {α : Type*}

namespace units

/-! ### Action of the units of `M` on a type `α` -/

@[to_additive]
instance [monoid M] [has_smul M α] : has_smul Mˣ α :=
{ smul := λ m a, (m : M) • a }

@[to_additive]
lemma smul_def [monoid M] [has_smul M α] (m : Mˣ) (a : α) :
  m • a = (m : M) • a := rfl

@[simp] lemma smul_is_unit [monoid M] [has_smul M α] {m : M} (hm : is_unit m) (a : α) :
  hm.unit • a = m • a :=
rfl

lemma _root_.is_unit.inv_smul [monoid α] {a : α} (h : is_unit a) :
  (h.unit)⁻¹ • a = 1 :=
h.coe_inv_mul

@[to_additive]
instance [monoid M] [has_smul M α] [has_faithful_smul M α] : has_faithful_smul Mˣ α :=
{ eq_of_smul_eq_smul := λ u₁ u₂ h, units.ext $ eq_of_smul_eq_smul h, }

@[to_additive]
instance [monoid M] [mul_action M α] : mul_action Mˣ α :=
{ one_smul := (one_smul M : _),
  mul_smul := λ m n, mul_smul (m : M) n, }

instance [monoid M] [has_zero α] [smul_zero_class M α] : smul_zero_class Mˣ α :=
{ smul := (•),
  smul_zero := λ m, smul_zero m }

instance [monoid M] [add_zero_class α] [distrib_smul M α] : distrib_smul Mˣ α :=
{ smul_add := λ m, smul_add (m : M) }

instance [monoid M] [add_monoid α] [distrib_mul_action M α] : distrib_mul_action Mˣ α :=
{ .. units.distrib_smul }

instance [monoid M] [monoid α] [mul_distrib_mul_action M α] : mul_distrib_mul_action Mˣ α :=
{ smul_mul := λ m, smul_mul' (m : M),
  smul_one := λ m, smul_one m, }

instance smul_comm_class_left [monoid M] [has_smul M α] [has_smul N α]
  [smul_comm_class M N α] : smul_comm_class Mˣ N α :=
{ smul_comm := λ m n, (smul_comm (m : M) n : _)}

instance smul_comm_class_right [monoid N] [has_smul M α] [has_smul N α]
  [smul_comm_class M N α] : smul_comm_class M Nˣ α :=
{ smul_comm := λ m n, (smul_comm m (n : N) : _)}

instance [monoid M] [has_smul M N] [has_smul M α] [has_smul N α] [is_scalar_tower M N α] :
  is_scalar_tower Mˣ N α :=
{ smul_assoc := λ m n, (smul_assoc (m : M) n : _)}

/-! ### Action of a group `G` on units of `M` -/

/-- If an action `G` associates and commutes with multiplication on `M`, then it lifts to an
action on `Mˣ`. Notably, this provides `mul_action Mˣ Nˣ` under suitable
conditions.
-/
instance mul_action' [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] : mul_action G Mˣ :=
{ smul := λ g m, ⟨g • (m : M), g⁻¹ • ↑(m⁻¹),
    by rw [smul_mul_smul, units.mul_inv, mul_right_inv, one_smul],
    by rw [smul_mul_smul, units.inv_mul, mul_left_inv, one_smul]⟩,
  one_smul := λ m, units.ext $ one_smul _ _,
  mul_smul := λ g₁ g₂ m, units.ext $ mul_smul _ _ _ }

@[simp] lemma coe_smul [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] (g : G) (m : Mˣ) : ↑(g • m) = g • (m : M) := rfl

/-- Note that this lemma exists more generally as the global `smul_inv` -/
@[simp] lemma smul_inv [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] (g : G) (m : Mˣ) : (g • m)⁻¹ = g⁻¹ • m⁻¹ := ext rfl

/-- Transfer `smul_comm_class G H M` to `smul_comm_class G H Mˣ` -/
instance smul_comm_class' [group G] [group H] [monoid M]
  [mul_action G M] [smul_comm_class G M M]
  [mul_action H M] [smul_comm_class H M M]
  [is_scalar_tower G M M] [is_scalar_tower H M M]
  [smul_comm_class G H M] : smul_comm_class G H Mˣ :=
{ smul_comm := λ g h m, units.ext $ smul_comm g h (m : M) }

/-- Transfer `is_scalar_tower G H M` to `is_scalar_tower G H Mˣ` -/
instance is_scalar_tower' [has_smul G H] [group G] [group H] [monoid M]
  [mul_action G M] [smul_comm_class G M M]
  [mul_action H M] [smul_comm_class H M M]
  [is_scalar_tower G M M] [is_scalar_tower H M M]
  [is_scalar_tower G H M] : is_scalar_tower G H Mˣ :=
{ smul_assoc := λ g h m, units.ext $ smul_assoc g h (m : M) }

/-- Transfer `is_scalar_tower G M α` to `is_scalar_tower G Mˣ α` -/
instance is_scalar_tower'_left [group G] [monoid M] [mul_action G M] [has_smul M α]
  [has_smul G α] [smul_comm_class G M M] [is_scalar_tower G M M]
  [is_scalar_tower G M α] :
  is_scalar_tower G Mˣ α :=
{ smul_assoc := λ g m, (smul_assoc g (m : M) : _)}

-- Just to prove this transfers a particularly useful instance.
example [monoid M] [monoid N] [mul_action M N] [smul_comm_class M N N]
  [is_scalar_tower M N N] : mul_action Mˣ Nˣ := units.mul_action'

/-- A stronger form of `units.mul_action'`. -/
instance mul_distrib_mul_action' [group G] [monoid M] [mul_distrib_mul_action G M]
  [smul_comm_class G M M] [is_scalar_tower G M M] : mul_distrib_mul_action G Mˣ :=
{ smul := (•),
  smul_one := λ m, units.ext $ smul_one _,
  smul_mul := λ g m₁ m₂, units.ext $ smul_mul' _ _ _,
  .. units.mul_action' }

end units

lemma is_unit.smul [group G] [monoid M] [mul_action G M]
  [smul_comm_class G M M] [is_scalar_tower G M M] {m : M} (g : G) (h : is_unit m) :
  is_unit (g • m) :=
let ⟨u, hu⟩ := h in hu ▸ ⟨g • u, units.coe_smul _ _⟩


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_graph_two_colorable : ∀ G : graph,
  is_two_colorable G ↔ is_bipartite G := sorry

/--`theorem`
Power Set is Closed under Union
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cup B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Union of Sets is a Subset we have that $A \cup B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cup B \subseteq S$.

Thus $A \cup B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_union_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∪ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  -- Then $(A ∪ B) ⊆ A$, by union of set is a subset
  have h2 : (A ∪ B) ⊆ A, from sorry,
  -- Then $(A ∪ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∪ B) ⊆ S, from sorry,
  -- Hence $(A ∪ B) ∈  𝒫 S$, by power set definition
  show (A ∪ B) ∈  𝒫 S, from sorry,
end

--OUTPUT 2
theorem bipartite_graph_two_colorable (G : Type) [graph G] :
  (∀ c : G → color, valid_coloring c → ∃ c' : G → color, valid_coloring c' ∧ c ≠ c') ↔ bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h1 : (∀ c : G → color, valid_coloring c → ∃ c' : G → color, valid_coloring c' ∧ c ≠ c') → bipartite G, from sorry,

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h2 : bipartite G → (∀ c : G → color, valid_coloring c → ∃ c' : G → color, valid_coloring c' ∧ c ≠ c'), from sorry,

  -- QED
  show (∀ c : G → color, valid_coloring c → ∃ c' : G → color, valid_coloring c' ∧ c ≠ c') ↔ bipartite G, from sorry,
end

--OUTPUT 3
theorem bipartite_graph_two_colorable (G : Type*) (red blue : G → Prop) :
  (∀ g : G, red g ∨ blue g) ∧ (∀ g1 g2 : G, red g1 ∧ red g2 → ¬ (g1 = g2)) ∧ (∀ g1 g2 : G, blue g1 ∧ blue g2 → ¬ (g1 = g2))
  → ∀ g1 g2 : G, red g1 ∧ blue g2 → ¬ (g1 = g2) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume (h1 : ∀ g : G, red g ∨ blue g)
    (h2 : ∀ g1 g2 : G, red g1 ∧ red g2 → ¬ (g1 = g2))
    (h3 : ∀ g1 g2 : G, blue g1 ∧ blue g2 → ¬ (g1 = g2))
    (g1 g2 : G) (h4 : red g1 ∧ blue g2),
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h5 : ∀ g : G, red g → g ∈ {g : G | red g}, from sorry,
  have h6 : ∀ g : G, blue g → g ∈ {g : G | blue g}, from sorry,
  have h7 : ∀ g : G, red g → ¬ g ∈ {g : G | blue g}, from sorry,
  have h8 : ∀ g : G, blue g → ¬ g ∈ {g : G | red g}, from sorry,
  have h9 : ∀ g : G, red g → ¬ (g ∈ {g : G | red g} ∧ g ∈ {g : G | blue g}), from sorry,
  have h10 : ∀ g : G, blue g → ¬ (g ∈ {g : G | red g} ∧ g ∈ {g : G | blue g}), from sorry,
  have h11 : ∀ g : G, red g → ¬ (g ∈ {g : G | blue g} → g ∈ {g : G | red g}), from sorry,
  have h12 : ∀ g : G, blue g → ¬ (g ∈ {g : G | red g} → g ∈ {g : G | blue g}), from sorry,
  have h13 : ∀ g : G, red g → ¬ (g ∈ {g : G | red g} → g ∈ {g : G | blue g}), from sorry,
  have h14 : ∀ g : G, blue g → ¬ (g ∈ {g : G | blue g} → g ∈ {g : G | red g}), from sorry,
  have h15 : ∀ g : G, ¬ (g ∈ {g : G | red g} → g ∈ {g : G | blue g}), from sorry,
  have h16 : ∀ g : G, ¬ (g ∈ {g : G | blue g} → g ∈ {g : G | red g}), from sorry,
  have h17 : ∀ g : G, ¬ (g ∈ {g : G | red g} ∧ g ∈ {g : G | blue g}), from sorry,
  have h18 : ∀ g : G, ¬ (g ∈ {g : G | blue g} ∧ g ∈ {g : G | red g}), from sorry,

  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h19 : ∀ g1 g2 : G, red g1 ∧ red g2 → ¬ (g1 = g2), from sorry,
  have h20 : ∀ g1 g2 : G, blue g1 ∧ blue g2 → ¬ (g1 = g2), from sorry,

  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h21 : ∀ g1 g2 : G, (g1 ∈ {g : G | red g} ∧ g2 ∈ {g : G | blue g}) ∨ (g1 ∈ {g : G | blue g} ∧ g2 ∈ {g : G | red g}), from sorry,
  have h22 : ∀ g1 g2 : G, (g1 ∈ {g : G | red g} ∧ g2 ∈ {g : G | blue g}) ∨ (g1 ∈ {g : G | blue g} ∧ g2 ∈ {g : G | red g}), from sorry,

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  have h23 : ∀ g1 g2 : G, (g1 ∈ {g : G | red g} ∧ g2 ∈ {g : G | blue g}) ∨ (g1 ∈ {g : G | blue g} ∧ g2 ∈ {g : G | red g}), from sorry,
  have h24 : ∀ g1 g2 : G, (g1 ∈ {g : G | red g} ∧ g2 ∈ {g : G | blue g}) ∨ (g1 ∈ {g : G | blue g} ∧ g2 ∈ {g : G | red g}), from sorry,

  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h25 : ∀ g : G, red g ∨ blue g, from sorry,
  have h26 : ∀ g1 g2 : G, red g1 ∧ red g2 → ¬ (g1 = g2), from sorry,
  have h27 : ∀ g1 g2 : G, blue g1 ∧ blue g2 → ¬ (g1 = g2), from sorry,

  -- QED
  show ∀ g1 g2 : G, red g1 ∧ blue g2 → ¬ (g1 = g2), from sorry,
end

--OUTPUT 4
theorem bipartite_graph_two_colorable {G : Type*} [graph G] : ∀ G : G, (bipartite G) ↔ (two_colorable G) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue,
  -- and no edge will have both endpoints colored the same color.
  assume (G : G),
  have h1 : (two_colorable G), from sorry,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices
  -- colored blue.
  have h2 : ∃ A B : set G,
    -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
    (∀ a b : G, (a ∈ A) ∧ (b ∈ A) → (a = b) ∨ (¬ (edge G a b)))
    ∧ (∀ a b : G, (a ∈ B) ∧ (b ∈ B) → (a = b) ∨ (¬ (edge G a b)))
    ∧
    -- This implies that every edge has one endpoint in $A$ and the other in $B$,
    -- which means $G$ is bipartite.
    (∀ a b : G, (edge G a b) → ((a ∈ A) ∧ (b ∈ B)) ∨ ((a ∈ B) ∧ (b ∈ A))), from sorry,

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two
  -- subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  have h3 : bipartite G, from sorry,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid
  -- coloring, so $G$ is 2-colorable.
  have h4 : two_colorable G, from sorry,

  show (bipartite G) ↔ (two_colorable G), from sorry,
end

--OUTPUT 5
theorem bipartite_graph_is_2_colorable (G : Type*) :
  (∃ A B : set G,
    (∀ a b : G, a ∈ A ∧ b ∈ B → ¬ (a,b) ∈ G.edge) ∧
    (∀ a b : G, a ∈ A ∧ b ∈ B → (a,b) ∈ G.edge)) ↔
  (∃ f : G → ℕ, ∀ a b : G, (a,b) ∈ G.edge → f a ≠ f b) :=
begin
  -- let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue
  -- since all vertices of $A$ are red, there are no edges within $A$
  -- similarly for $B$
  -- this implies that every edge has one endpoint in $A$ and the other in $B$
  -- which means $G$ is bipartite
  have h1 : (∃ A B : set G,
    (∀ a b : G, a ∈ A ∧ b ∈ B → ¬ (a,b) ∈ G.edge) ∧
    (∀ a b : G, a ∈ A ∧ b ∈ B → (a,b) ∈ G.edge)) →
  (∃ f : G → ℕ, ∀ a b : G, (a,b) ∈ G.edge → f a ≠ f b), from sorry,

  -- conversely, suppose $G$ is bipartite
  -- that is, we can partition the vertices into two subsets $V_{1}, V_{2}$
  -- every edge has one endpoint in $V_{1}$ and the other in $V_{2}$
  -- then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring
  -- so $G$ is 2-colorable
  have h2 : (∃ f : G → ℕ, ∀ a b : G, (a,b) ∈ G.edge → f a ≠ f b) →
  (∃ A B : set G,
    (∀ a b : G, a ∈ A ∧ b ∈ B → ¬ (a,b) ∈ G.edge) ∧
    (∀ a b : G, a ∈ A ∧ b ∈ B → (a,b) ∈ G.edge)), from sorry,
  show (∃ A B : set G,
    (∀ a b : G, a ∈ A ∧ b ∈ B → ¬ (a,b) ∈ G.edge) ∧
    (∀ a b : G, a ∈ A ∧ b ∈ B → (a,b) ∈ G.edge)) ↔
  (∃ f : G → ℕ, ∀ a b : G, (a,b) ∈ G.edge → f a ≠ f b), from sorry,
end

--OUTPUT 6
theorem bipartite_graph_two_colorable {G : Type*} [graph G] :
  (∀ V1 V2 : set G, V1 ≠ ∅ → V2 ≠ ∅ → (∀ (v1 v2 : G), v1 ∈ V1 → v2 ∈ V2 → v1 ≠ v2 → v1 -- v2 ∈ G) → (∀ v : G, v ∈ V1 ∨ v ∈ V2)) ↔
  (∃ R B : set G, R ≠ ∅ ∧ B ≠ ∅ ∧ (∀ (v1 v2 : G), v1 ∈ R → v2 ∈ B → v1 ≠ v2 → v1 -- v2 ∈ G) ∧ (∀ v : G, v ∈ R ∨ v ∈ B)) :=
begin
  split,
  {
    --$G$ is 2-colorable
    assume h1 : ∀ V1 V2 : set G, V1 ≠ ∅ → V2 ≠ ∅ → (∀ (v1 v2 : G), v1 ∈ V1 → v2 ∈ V2 → v1 ≠ v2 → v1 -- v2 ∈ G) → (∀ v : G, v ∈ V1 ∨ v ∈ V2),
    --Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue
    let A := sorry,
    let B := sorry,
    --Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
    have h2 : ∀ (v1 v2 : G), v1 ∈ A → v2 ∈ A → v1 ≠ v2 → v1 -- v2 ∈ G, from sorry,
    have h3 : ∀ (v1 v2 : G), v1 ∈ B → v2 ∈ B → v1 ≠ v2 → v1 -- v2 ∈ G, from sorry,
    --This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
    have h4 : ∀ (v1 v2 : G), v1 ∈ A → v2 ∈ B → v1 ≠ v2 → v1 -- v2 ∈ G, from sorry,
    -- Hence $G$ is bipartite
    show ∃ R B : set G, R ≠ ∅ ∧ B ≠ ∅ ∧ (∀ (v1 v2 : G), v1 ∈ R → v2 ∈ B → v1 ≠ v2 → v1 -- v2 ∈ G) ∧ (∀ v : G, v ∈ R ∨ v ∈ B), from sorry,
  },
  {
    -- Suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
    assume h1 : ∃ R B : set G, R ≠ ∅ ∧ B ≠ ∅ ∧ (∀ (v1 v2 : G), v1 ∈ R → v2 ∈ B → v1 ≠ v2 → v1 -- v2 ∈ G) ∧ (∀ v : G, v ∈ R ∨ v ∈ B),
    -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
    show ∀ V1 V2 : set G, V1 ≠ ∅ → V2 ≠ ∅ → (∀ (v1 v2 : G), v1 ∈ V1 → v2 ∈ V2 → v1 ≠ v2 → v1 -- v2 ∈ G) → (∀ v : G, v ∈ V1 ∨ v ∈ V2), from sorry,
  },
end

--OUTPUT 7
theorem two_colorable_bipartite_graph (G : Type*) [fintype G] [decidable_eq G] [fintype (G × G)] [decidable_eq (G × G)] [graph G] :
  ∀ red blue : set G, (is_coloring red blue) ↔ (is_bipartite_graph red blue) :=
begin
  assume (red : set G) (blue : set G),
  show (is_coloring red blue) ↔ (is_bipartite_graph red blue), from by {
    -- Let $G$ be a 2-colorable graph
    assume h1 : is_coloring red blue,
    have h2 : (∀ n : G, n ∈ red ∨ n ∈ blue) ∧
              (∀ m n : G, (m, n) ∈ edges G → m ∉ blue ∨ n ∉ blue ∨ m = n), from h1,
    -- which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
    have h3 : ∀ n : G, n ∈ red ∨ n ∈ blue, from h2.left,
    have h4 : ∀ m n : G, (m, n) ∈ edges G → m ∉ blue ∨ n ∉ blue ∨ m = n, from h2.right,
    -- Let A denote the subset of vertices colored red, and let B denote the subset of vertices colored blue.
    have h5 : ∀ n : G, n ∈ red ↔ n ∈ A, from sorry,
    have h6 : ∀ n : G, n ∈ blue ↔ n ∈ B, from sorry,
    have h7 : ∀ n : G, n ∈ red → n ∈ A, from sorry,
    have h8 : ∀ n : G, n ∈ blue → n ∈ B, from sorry,
    have h9 : ∀ n : G, n ∈ A → n ∈ red, from sorry,
    have h10 : ∀ n : G, n ∈ B → n ∈ blue, from sorry,
    -- Since all vertices of A are red, there are no edges within A,
    -- and similarly for B. This implies that every edge has one endpoint in A and the other in B,
    -- which means G is bipartite.
    have h11 : ∀ m n : G, m ∈ A ∧ n ∈ A → (m, n) ∉ edges G, from sorry,
    have h12 : ∀ m n : G, m ∈ B ∧ n ∈ B → (m, n) ∉ edges G, from sorry,
    have h13 : (∀ m n : G, (m, n) ∈ edges G → m ∈ A ∨ n ∈ B) ∧
               (∀ m n : G, (m, n) ∈ edges G → m ∈ B ∨ n ∈ A), from sorry,
    have h14 : ∀ m n : G, (m, n) ∈ edges G → m ∈ A ∨ n ∈ B, from sorry,
    have h15 : ∀ m n : G, (m, n) ∈ edges G → m ∈ B ∨ n ∈ A, from sorry,
    show is_bipartite_graph red blue, from sorry,
    show is_bipartite_graph red blue → is_coloring red blue, from by {
      assume h16 : is_bipartite_graph red blue,
      have h17 : (∀ m n : G, (m, n) ∈ edges G → m ∈ A ∨ n ∈ B) ∧
                 (∀ m n : G, (m, n) ∈ edges G → m ∈ B ∨ n ∈ A), from h16,
      have h18 : ∀ m n : G, (m, n) ∈ edges G → m ∈ A ∨ n ∈ B, from h17.left,
      have h19 : ∀ m n : G, (m, n) ∈ edges G → m ∈ B ∨ n ∈ A, from h17.right,
      have h20 : ∀ n : G, ∃! x : G, (n, x) ∈ edges G, from sorry,
      have h21 : ∀ n : G, ∃! y : G, (y, n) ∈ edges G, from sorry,
      have h22 : ∀ (n : G) (h22 : ∃! x : G, (n, x) ∈ edges G), n ∈ A ∨ n ∈ B, from sorry,
      have h23 : ∀ (n : G) (h23 : ∃! y : G, (y, n) ∈ edges G), n ∈ A ∨ n ∈ B, from sorry,
      show is_coloring red blue, from sorry,
    },
  }
end

--OUTPUT 8
theorem bipartite_graph_two_colorable {G : Type*} [graph G] :
  (∃ A B : set (vertex G), is_bipartite A B) ↔ ∃ f : vertex G → two_colors, is_valid_coloring f :=
begin
  -- Suppose $G$ is 2-colorable, which means we can color every vertex either red or blue,
  -- and no edge will have both endpoints colored the same color.
  assume h1 : ∃ (f : vertex G → two_colors), is_valid_coloring f,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ (A B : set (vertex G)), is_bipartite A B, from sorry,

  -- Suppose $G$ is bipartite, that is, we can partition the vertices into two subsets
  -- $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  assume h3 : ∃ (A B : set (vertex G)), is_bipartite A B,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring,
  have h4 : ∃ (f : vertex G → two_colors), is_valid_coloring f, from sorry,

  show (∃ (A B : set (vertex G)), is_bipartite A B) ↔ ∃ (f : vertex G → two_colors), is_valid_coloring f, from sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from sorry,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from sorry,
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by sorry
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by sorry
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import .form

namespace nat

@[omega] def push_neg : form → form
| (p ∨* q) := (push_neg p) ∧* (push_neg q)
| (p ∧* q) := (push_neg p) ∨* (push_neg q)
| (¬*p)    := p
| p        := ¬* p

lemma push_neg_equiv :
  ∀ {p}, form.equiv (push_neg p) (¬* p) :=
begin
  form.induce `[intros v; try {refl}],
  { simp_omega [classical.not_not] },
  { simp only [form.holds, push_neg, not_or_distrib, ihp v, ihq v] },
  { simp only [form.holds, push_neg, classical.not_and_distrib, ihp v, ihq v] }
end

def nnf : form → form
| (¬* p)   := push_neg (nnf p)
| (p ∨* q) := (nnf p) ∨* (nnf q)
| (p ∧* q) := (nnf p) ∧* (nnf q)
| a        := a

def is_nnf : form → Prop
| (t =* s) := true
| (t ≤* s) := true
| ¬*(t =* s) := true
| ¬*(t ≤* s) := true
| (p ∨* q) := is_nnf p ∧ is_nnf q
| (p ∧* q) := is_nnf p ∧ is_nnf q
| _ := false

lemma is_nnf_push_neg : ∀ p, is_nnf p → is_nnf (push_neg p) :=
begin
  form.induce `[intro h1; try {trivial}],
  { cases p; try {cases h1}; trivial },
  { cases h1, constructor; [{apply ihp}, {apply ihq}]; assumption },
  { cases h1, constructor; [{apply ihp}, {apply ihq}]; assumption }
end

lemma is_nnf_nnf : ∀ p, is_nnf (nnf p) :=
begin
  form.induce `[try {trivial}],
  { apply is_nnf_push_neg _ ih },
  { constructor; assumption },
  { constructor; assumption }
end

lemma nnf_equiv : ∀ {p : form}, form.equiv (nnf p) p :=
begin
  form.induce `[intros v; try {refl}; simp only [nnf]],
  { rw push_neg_equiv,
    apply not_iff_not_of_iff, apply ih },
  { apply or_iff_or (ihp v) (ihq v) },
  { apply and_iff_and (ihp v) (ihq v) }
end

@[omega] def neg_elim_core : form → form
| (¬* (t =* s)) := (t.succ ≤* s) ∨* (s.succ ≤* t)
| (¬* (t ≤* s)) := s.succ ≤* t
| (p ∨* q) := (neg_elim_core p) ∨* (neg_elim_core q)
| (p ∧* q) := (neg_elim_core p) ∧* (neg_elim_core q)
| p        := p

lemma neg_free_neg_elim_core : ∀ p, is_nnf p → (neg_elim_core p).neg_free :=
begin
  form.induce `[intro h1, try {simp only [neg_free, neg_elim_core]}, try {trivial}],
  { cases p; try {cases h1}; try {trivial},
    constructor; trivial },
  { cases h1, constructor; [{apply ihp}, {apply ihq}]; assumption },
  { cases h1, constructor; [{apply ihp}, {apply ihq}]; assumption }
end

lemma le_and_le_iff_eq {α : Type} [partial_order α] {a b : α} :
  (a ≤ b ∧ b ≤ a) ↔ a = b :=
begin
  constructor; intro h1,
  { cases h1, apply le_antisymm; assumption },
  { constructor; apply le_of_eq; rw h1  }
end

lemma implies_neg_elim_core : ∀ {p : form}, form.implies p (neg_elim_core p) :=
begin
  form.induce `[intros v h, try {apply h}],
  { cases p with t s t s; try {apply h},
    { simp_omega [le_and_le_iff_eq.symm,
        classical.not_and_distrib, not_le] at h,
      simp_omega [int.add_one_le_iff], rw or.comm, assumption },
    { simp_omega [not_le, int.add_one_le_iff] at *, assumption} },
  { simp only [neg_elim_core], cases h; [{left, apply ihp},
    {right, apply ihq}]; assumption },
  { apply and_of_and (ihp _) (ihq _) h }
end

def neg_elim : form → form := neg_elim_core ∘ nnf

lemma neg_free_neg_elim {p} : (neg_elim p).neg_free :=
neg_free_neg_elim_core _ (is_nnf_nnf _)

lemma implies_neg_elim {p : form} : form.implies p (neg_elim p) :=
begin
  intros v h1, apply implies_neg_elim_core,
  apply (nnf_equiv v).elim_right h1
end

end nat


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash

! This file was ported from Lean 3 source module algebra.lie.cartan_matrix
! leanprover-community/mathlib commit 65ec59902eb17e4ab7da8d7e3d0bd9774d1b8b99
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.Free
import Mathbin.Algebra.Lie.Quotient
import Mathbin.Data.Matrix.Notation

/-!
# Lie algebras from Cartan matrices

Split semi-simple Lie algebras are uniquely determined by their Cartan matrix. Indeed, if `A` is
an `l × l` Cartan matrix, the corresponding Lie algebra may be obtained as the Lie algebra on
`3l` generators: $H_1, H_2, \ldots H_l, E_1, E_2, \ldots, E_l, F_1, F_2, \ldots, F_l$
subject to the following relations:
$$
\begin{align}
  [H_i, H_j] &= 0\\
  [E_i, F_i] &= H_i\\
  [E_i, F_j] &= 0 \quad\text{if $i \ne j$}\\
  [H_i, E_j] &= A_{ij}E_j\\
  [H_i, F_j] &= -A_{ij}F_j\\
  ad(E_i)^{1 - A_{ij}}(E_j) &= 0 \quad\text{if $i \ne j$}\\
  ad(F_i)^{1 - A_{ij}}(F_j) &= 0 \quad\text{if $i \ne j$}\\
\end{align}
$$

In this file we provide the above construction. It is defined for any square matrix of integers but
the results for non-Cartan matrices should be regarded as junk.

Recall that a Cartan matrix is a square matrix of integers `A` such that:
 * For diagonal values we have: `A i i = 2`.
 * For off-diagonal values (`i ≠ j`) we have: `A i j ∈ {-3, -2, -1, 0}`.
 * `A i j = 0 ↔ A j i = 0`.
 * There exists a diagonal matrix `D` over ℝ such that `D ⬝ A ⬝ D⁻¹` is symmetric positive definite.

## Alternative construction

This construction is sometimes performed within the free unital associative algebra
`free_algebra R X`, rather than within the free Lie algebra `free_lie_algebra R X`, as we do here.
However the difference is illusory since the construction stays inside the Lie subalgebra of
`free_algebra R X` generated by `X`, and this is naturally isomorphic to `free_lie_algebra R X`
(though the proof of this seems to require Poincaré–Birkhoff–Witt).

## Definitions of exceptional Lie algebras

This file also contains the Cartan matrices of the exceptional Lie algebras. By using these in the
above construction, it thus provides definitions of the exceptional Lie algebras. These definitions
make sense over any commutative ring. When the ring is ℝ, these are the split real forms of the
exceptional semisimple Lie algebras.

## References

* [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 4--6*](bourbaki1968) plates V -- IX,
  pages 275--290

* [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 7--9*](bourbaki1975b) chapter VIII, §4.3

* [J.P. Serre, *Complex Semisimple Lie Algebras*](serre1965) chapter VI, appendix

## Main definitions

  * `matrix.to_lie_algebra`
  * `cartan_matrix.E₆`
  * `cartan_matrix.E₇`
  * `cartan_matrix.E₈`
  * `cartan_matrix.F₄`
  * `cartan_matrix.G₂`
  * `lie_algebra.e₆`
  * `lie_algebra.e₇`
  * `lie_algebra.e₈`
  * `lie_algebra.f₄`
  * `lie_algebra.g₂`

## Tags

lie algebra, semi-simple, cartan matrix
-/

universe u v w

noncomputable section

variable (R : Type u) {B : Type v} [CommRing R] [DecidableEq B] [Fintype B]

variable (A : Matrix B B ℤ)

namespace CartanMatrix

variable (B)

/-- The generators of the free Lie algebra from which we construct the Lie algebra of a Cartan
matrix as a quotient. -/
inductive Generators
  | H : B → generators
  | E : B → generators
  | F : B → generators
#align cartan_matrix.generators CartanMatrix.Generators

instance [Inhabited B] : Inhabited (Generators B) :=
  ⟨Generators.H default⟩

variable {B}

namespace Relations

open Function

-- mathport name: exprH
local notation "H" => FreeLieAlgebra.of R ∘ Generators.H

-- mathport name: exprE
local notation "E" => FreeLieAlgebra.of R ∘ Generators.E

-- mathport name: exprF
local notation "F" => FreeLieAlgebra.of R ∘ Generators.F

-- mathport name: exprad
local notation "ad" => LieAlgebra.ad R (FreeLieAlgebra R (Generators B))

/-- The terms correpsonding to the `⁅H, H⁆`-relations. -/
def hH : B × B → FreeLieAlgebra R (Generators B) :=
  uncurry fun i j => ⁅H i, H j⁆
#align cartan_matrix.relations.HH CartanMatrix.Relations.hH

/-- The terms correpsonding to the `⁅E, F⁆`-relations. -/
def eF : B × B → FreeLieAlgebra R (Generators B) :=
  uncurry fun i j => if i = j then ⁅E i, F i⁆ - H i else ⁅E i, F j⁆
#align cartan_matrix.relations.EF CartanMatrix.Relations.eF

/-- The terms correpsonding to the `⁅H, E⁆`-relations. -/
def hE : B × B → FreeLieAlgebra R (Generators B) :=
  uncurry fun i j => ⁅H i, E j⁆ - A i j • E j
#align cartan_matrix.relations.HE CartanMatrix.Relations.hE

/-- The terms correpsonding to the `⁅H, F⁆`-relations. -/
def hF : B × B → FreeLieAlgebra R (Generators B) :=
  uncurry fun i j => ⁅H i, F j⁆ + A i j • F j
#align cartan_matrix.relations.HF CartanMatrix.Relations.hF

/-- The terms correpsonding to the `ad E`-relations.

Note that we use `int.to_nat` so that we can take the power and that we do not bother
restricting to the case `i ≠ j` since these relations are zero anyway. We also defensively
ensure this with `ad_E_of_eq_eq_zero`. -/
def adE : B × B → FreeLieAlgebra R (Generators B) :=
  uncurry fun i j => ad (E i) ^ (-A i j).toNat <| ⁅E i, E j⁆
#align cartan_matrix.relations.ad_E CartanMatrix.Relations.adE

/-- The terms correpsonding to the `ad F`-relations.

See also `ad_E` docstring. -/
def adF : B × B → FreeLieAlgebra R (Generators B) :=
  uncurry fun i j => ad (F i) ^ (-A i j).toNat <| ⁅F i, F j⁆
#align cartan_matrix.relations.ad_F CartanMatrix.Relations.adF

private theorem ad_E_of_eq_eq_zero (i : B) (h : A i i = 2) : adE R A ⟨i, i⟩ = 0 :=
  by
  have h' : (-2 : ℤ).toNat = 0 := by rfl
  simp [ad_E, h, h']
#align cartan_matrix.relations.ad_E_of_eq_eq_zero cartan_matrix.relations.ad_E_of_eq_eq_zero

private theorem ad_F_of_eq_eq_zero (i : B) (h : A i i = 2) : adF R A ⟨i, i⟩ = 0 :=
  by
  have h' : (-2 : ℤ).toNat = 0 := by rfl
  simp [ad_F, h, h']
#align cartan_matrix.relations.ad_F_of_eq_eq_zero cartan_matrix.relations.ad_F_of_eq_eq_zero

/-- The union of all the relations as a subset of the free Lie algebra. -/
def toSet : Set (FreeLieAlgebra R (Generators B)) :=
  (Set.range <| hH R) ∪ (Set.range <| eF R) ∪ (Set.range <| hE R A) ∪ (Set.range <| hF R A) ∪
      (Set.range <| adE R A) ∪
    (Set.range <| adF R A)
#align cartan_matrix.relations.to_set CartanMatrix.Relations.toSet

/-- The ideal of the free Lie algebra generated by the relations. -/
def toIdeal : LieIdeal R (FreeLieAlgebra R (Generators B)) :=
  LieSubmodule.lieSpan R _ <| toSet R A
#align cartan_matrix.relations.to_ideal CartanMatrix.Relations.toIdeal

end Relations

end CartanMatrix

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler lie_algebra[lie_algebra] R -/
/-- The Lie algebra corresponding to a Cartan matrix.

Note that it is defined for any matrix of integers. Its value for non-Cartan matrices should be
regarded as junk. -/
def Matrix.ToLieAlgebra :=
  FreeLieAlgebra R _ ⧸ CartanMatrix.Relations.toIdeal R A deriving Inhabited, LieRing,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler lie_algebra[lie_algebra] R»
#align matrix.to_lie_algebra Matrix.ToLieAlgebra

namespace CartanMatrix

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/-- The Cartan matrix of type e₆. See [bourbaki1968] plate V, page 277.

The corresponding Dynkin diagram is:
```
            o
            |
o --- o --- o --- o --- o
```
-/
def e₆ : Matrix (Fin 6) (Fin 6) ℤ :=
  «expr!![ »
    "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation"
#align cartan_matrix.E₆ CartanMatrix.e₆

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/-- The Cartan matrix of type e₇. See [bourbaki1968] plate VI, page 281.

The corresponding Dynkin diagram is:
```
            o
            |
o --- o --- o --- o --- o --- o
```
-/
def e₇ : Matrix (Fin 7) (Fin 7) ℤ :=
  «expr!![ »
    "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation"
#align cartan_matrix.E₇ CartanMatrix.e₇

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/-- The Cartan matrix of type e₈. See [bourbaki1968] plate VII, page 285.

The corresponding Dynkin diagram is:
```
            o
            |
o --- o --- o --- o --- o --- o --- o
```
-/
def e₈ : Matrix (Fin 8) (Fin 8) ℤ :=
  «expr!![ »
    "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation"
#align cartan_matrix.E₈ CartanMatrix.e₈

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/-- The Cartan matrix of type f₄. See [bourbaki1968] plate VIII, page 288.

The corresponding Dynkin diagram is:
```
o --- o =>= o --- o
```
-/
def f₄ : Matrix (Fin 4) (Fin 4) ℤ :=
  «expr!![ »
    "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation"
#align cartan_matrix.F₄ CartanMatrix.f₄

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/-- The Cartan matrix of type g₂. See [bourbaki1968] plate IX, page 290.

The corresponding Dynkin diagram is:
```
o ≡>≡ o
```
Actually we are using the transpose of Bourbaki's matrix. This is to make this matrix consistent
with `cartan_matrix.F₄`, in the sense that all non-zero values below the diagonal are -1. -/
def g₂ : Matrix (Fin 2) (Fin 2) ℤ :=
  «expr!![ »
    "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation"
#align cartan_matrix.G₂ CartanMatrix.g₂

end CartanMatrix

namespace LieAlgebra

/-- The exceptional split Lie algebra of type e₆. -/
abbrev E₆ :=
  CartanMatrix.e₆.ToLieAlgebra R
#align lie_algebra.e₆ LieAlgebra.E₆

/-- The exceptional split Lie algebra of type e₇. -/
abbrev E₇ :=
  CartanMatrix.e₇.ToLieAlgebra R
#align lie_algebra.e₇ LieAlgebra.E₇

/-- The exceptional split Lie algebra of type e₈. -/
abbrev E₈ :=
  CartanMatrix.e₈.ToLieAlgebra R
#align lie_algebra.e₈ LieAlgebra.E₈

/-- The exceptional split Lie algebra of type f₄. -/
abbrev F₄ :=
  CartanMatrix.f₄.ToLieAlgebra R
#align lie_algebra.f₄ LieAlgebra.F₄

/-- The exceptional split Lie algebra of type g₂. -/
abbrev G₂ :=
  CartanMatrix.g₂.ToLieAlgebra R
#align lie_algebra.g₂ LieAlgebra.G₂

end LieAlgebra


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Yury Kudryashov.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.sqrt
import Mathlib.data.rat.sqrt
import Mathlib.ring_theory.int.basic
import Mathlib.data.polynomial.eval
import Mathlib.data.polynomial.degree.default
import Mathlib.tactic.interval_cases
import Mathlib.PostPort

namespace Mathlib

/-!
# Irrational real numbers

In this file we define a predicate `irrational` on `ℝ`, prove that the `n`-th root of an integer
number is irrational if it is not integer, and that `sqrt q` is irrational if and only if
`rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q`.

We also provide dot-style constructors like `irrational.add_rat`, `irrational.rat_sub` etc.
-/

/-- A real number is irrational if it is not equal to any rational number. -/
def irrational (x : ℝ) := ¬x ∈ set.range coe

theorem irrational_iff_ne_rational (x : ℝ) : irrational x ↔ ∀ (a b : ℤ), x ≠ ↑a / ↑b := sorry

/-!
### Irrationality of roots of integer and rational numbers
-/

/-- If `x^n`, `n > 0`, is integer and is not the `n`-th power of an integer, then
`x` is irrational. -/
theorem irrational_nrt_of_notint_nrt {x : ℝ} (n : ℕ) (m : ℤ) (hxr : x ^ n = ↑m)
    (hv : ¬∃ (y : ℤ), x = ↑y) (hnpos : 0 < n) : irrational x :=
  sorry

/-- If `x^n = m` is an integer and `n` does not divide the `multiplicity p m`, then `x`
is irrational. -/
theorem irrational_nrt_of_n_not_dvd_multiplicity {x : ℝ} (n : ℕ) {m : ℤ} (hm : m ≠ 0) (p : ℕ)
    [hp : fact (nat.prime p)] (hxr : x ^ n = ↑m)
    (hv :
      roption.get (multiplicity (↑p) m)
            (iff.mpr multiplicity.finite_int_iff { left := nat.prime.ne_one hp, right := hm }) %
          n ≠
        0) :
    irrational x :=
  sorry

theorem irrational_sqrt_of_multiplicity_odd (m : ℤ) (hm : 0 < m) (p : ℕ) [hp : fact (nat.prime p)]
    (Hpv :
      roption.get (multiplicity (↑p) m)
            (iff.mpr multiplicity.finite_int_iff
              { left := nat.prime.ne_one hp, right := ne.symm (ne_of_lt hm) }) %
          bit0 1 =
        1) :
    irrational (real.sqrt ↑m) :=
  sorry

theorem nat.prime.irrational_sqrt {p : ℕ} (hp : nat.prime p) : irrational (real.sqrt ↑p) := sorry

theorem irrational_sqrt_two : irrational (real.sqrt (bit0 1)) := sorry

theorem irrational_sqrt_rat_iff (q : ℚ) :
    irrational (real.sqrt ↑q) ↔ rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q :=
  sorry

protected instance irrational.decidable (q : ℚ) : Decidable (irrational (real.sqrt ↑q)) :=
  decidable_of_iff' (rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q) (irrational_sqrt_rat_iff q)

/-!
### Adding/subtracting/multiplying by rational numbers
-/

theorem rat.not_irrational (q : ℚ) : ¬irrational ↑q :=
  fun (h : irrational ↑q) => h (Exists.intro q rfl)

namespace irrational

theorem add_cases {x : ℝ} {y : ℝ} : irrational (x + y) → irrational x ∨ irrational y := sorry

theorem of_rat_add (q : ℚ) {x : ℝ} (h : irrational (↑q + x)) : irrational x :=
  or.elim (add_cases h) (fun (h : irrational ↑q) => absurd h (rat.not_irrational q)) id

theorem rat_add (q : ℚ) {x : ℝ} (h : irrational x) : irrational (↑q + x) :=
  of_rat_add (-q)
    (eq.mpr (id (Eq._oldrec (Eq.refl (irrational (↑(-q) + (↑q + x)))) (rat.cast_neg q)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (irrational (-↑q + (↑q + x)))) (neg_add_cancel_left (↑q) x)))
        h))

theorem of_add_rat (q : ℚ) {x : ℝ} : irrational (x + ↑q) → irrational x :=
  add_comm (↑q) x ▸ of_rat_add q

theorem add_rat (q : ℚ) {x : ℝ} (h : irrational x) : irrational (x + ↑q) :=
  add_comm (↑q) x ▸ rat_add q h

theorem of_neg {x : ℝ} (h : irrational (-x)) : irrational x := sorry

protected theorem neg {x : ℝ} (h : irrational x) : irrational (-x) :=
  of_neg (eq.mpr (id (Eq._oldrec (Eq.refl (irrational ( --x))) (neg_neg x))) h)

theorem sub_rat (q : ℚ) {x : ℝ} (h : irrational x) : irrational (x - ↑q) := sorry

theorem rat_sub (q : ℚ) {x : ℝ} (h : irrational x) : irrational (↑q - x) :=
  eq.mpr
    (id
      ((fun (x x_1 : ℝ) (e_1 : x = x_1) => congr_arg irrational e_1) (↑q - x) (↑q + -x)
        (sub_eq_add_neg (↑q) x)))
    (eq.mp (Eq.refl (irrational (↑q + -x))) (rat_add q (irrational.neg h)))

theorem of_sub_rat (q : ℚ) {x : ℝ} (h : irrational (x - ↑q)) : irrational x := sorry

theorem of_rat_sub (q : ℚ) {x : ℝ} (h : irrational (↑q - x)) : irrational x := sorry

theorem mul_cases {x : ℝ} {y : ℝ} : irrational (x * y) → irrational x ∨ irrational y := sorry

theorem of_mul_rat (q : ℚ) {x : ℝ} (h : irrational (x * ↑q)) : irrational x :=
  or.elim (mul_cases h) id fun (h : irrational ↑q) => absurd h (rat.not_irrational q)

theorem mul_rat {x : ℝ} (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (x * ↑q) := sorry

theorem of_rat_mul (q : ℚ) {x : ℝ} : irrational (↑q * x) → irrational x :=
  mul_comm x ↑q ▸ of_mul_rat q

theorem rat_mul {x : ℝ} (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (↑q * x) :=
  mul_comm x ↑q ▸ mul_rat h hq

theorem of_mul_self {x : ℝ} (h : irrational (x * x)) : irrational x := or.elim (mul_cases h) id id

theorem of_inv {x : ℝ} (h : irrational (x⁻¹)) : irrational x := sorry

protected theorem inv {x : ℝ} (h : irrational x) : irrational (x⁻¹) :=
  of_inv (eq.mpr (id (Eq._oldrec (Eq.refl (irrational (x⁻¹⁻¹))) (inv_inv' x))) h)

theorem div_cases {x : ℝ} {y : ℝ} (h : irrational (x / y)) : irrational x ∨ irrational y :=
  or.imp id of_inv (mul_cases h)

theorem of_rat_div (q : ℚ) {x : ℝ} (h : irrational (↑q / x)) : irrational x :=
  of_inv (of_rat_mul q h)

theorem of_one_div {x : ℝ} (h : irrational (1 / x)) : irrational x :=
  of_rat_div 1 (eq.mpr (id (Eq._oldrec (Eq.refl (irrational (↑1 / x))) rat.cast_one)) h)

theorem of_pow {x : ℝ} (n : ℕ) : irrational (x ^ n) → irrational x := sorry

theorem of_fpow {x : ℝ} (m : ℤ) : irrational (x ^ m) → irrational x := sorry

end irrational

theorem one_lt_nat_degree_of_irrational_root (x : ℝ) (p : polynomial ℤ) (hx : irrational x)
    (p_nonzero : p ≠ 0) (x_is_root : coe_fn (polynomial.aeval x) p = 0) :
    1 < polynomial.nat_degree p :=
  sorry

@[simp] theorem irrational_rat_add_iff {q : ℚ} {x : ℝ} : irrational (↑q + x) ↔ irrational x :=
  { mp := irrational.of_rat_add q, mpr := irrational.rat_add q }

@[simp] theorem irrational_add_rat_iff {q : ℚ} {x : ℝ} : irrational (x + ↑q) ↔ irrational x :=
  { mp := irrational.of_add_rat q, mpr := irrational.add_rat q }

@[simp] theorem irrational_rat_sub_iff {q : ℚ} {x : ℝ} : irrational (↑q - x) ↔ irrational x :=
  { mp := irrational.of_rat_sub q, mpr := irrational.rat_sub q }

@[simp] theorem irrational_sub_rat_iff {q : ℚ} {x : ℝ} : irrational (x - ↑q) ↔ irrational x :=
  { mp := irrational.of_sub_rat q, mpr := irrational.sub_rat q }

@[simp] theorem irrational_neg_iff {x : ℝ} : irrational (-x) ↔ irrational x :=
  { mp := irrational.of_neg, mpr := irrational.neg }

@[simp] theorem irrational_inv_iff {x : ℝ} : irrational (x⁻¹) ↔ irrational x :=
  { mp := irrational.of_inv, mpr := irrational.inv }

end Mathlib


-- This is content that isn't yet ready for the main file.

/-
noncomputable def cond_dist_pr {B : set Ω} (h : σ.Pr B ≠ 0) (x : Ω) : ℝ
  := σ.Pr_cond {x} B

lemma cond_dist_finite {B : set Ω} (h : σ.Pr B ≠ 0) : (function.support (σ.cond_dist_pr h)).finite := sorry

lemma cond_dist_nonneg {B : set Ω} (h : σ.Pr B ≠ 0) : ∀ (x : Ω), 0 ≤ σ.cond_dist_pr h x := sorry

lemma cond_dist_normal {B : set Ω} (h : σ.Pr B ≠ 0) : ∑ᶠ (x : Ω), σ.cond_dist_pr h x = 1 := sorry

noncomputable def cond_dist {B : set Ω} (h : σ.Pr B ≠ 0) : fspm Ω :=
⟨σ.cond_dist_pr h,
σ.cond_dist_finite _, σ.cond_dist_nonneg _, σ.cond_dist_normal _⟩

lemma cond_dist_eq_Pr_cond {A B : set Ω} (h : σ.Pr B ≠ 0)
  : (σ.cond_dist h).Pr (A ∩ B) = σ.Pr_cond A B :=
begin
  unfold Pr cond_dist, simp, unfold cond_dist_pr, unfold Pr_cond, unfold Pr, simp,
end
-/
/-

structure rvar (α : Type*) :=
(map : Ω → α)
(σ : fspm Ω)

variables {α : Type*}

namespace rvar

def Pr {σ : fspm Ω} (X : rvar α) (T : set α) : ℝ := σ.Pr (X.map⁻¹' T)

def pure {α : Type*} (b : α) : rvar α :=
⟨λ _, b,
⟨_, _, _⟩⟩
--def bind {α β : Type*} {σ : fspm Ω} (X : rvar σ α) (f : α → )
end rvar
-/


import field_definition
import field_results
import numbers
import roots
import quadratic

lemma multiply_out_cubed (f : Type) [myfld f] (x a : f) :
    (cubed f (x .+ a)) = ((cubed f x) .+ (((three f) .* ((square f x) .* a)) .+ (((three f) .* ((x .* a) .* a)) .+ (cubed f a)))) :=
begin
  unfold cubed, unfold three, unfold square,
  repeat {rw distrib_simp f _ _ _}, repeat {rw distrib_simp_alt f _ _ _},
  rw one_mul_simp f _, rw myfld.mul_assoc _ _ _,
  rw myfld.mul_comm a x, rw myfld.mul_assoc a x a, rw myfld.mul_comm a x, rw myfld.mul_assoc _ _ _,
  rw myfld.mul_assoc a x x, rw myfld.mul_comm a x, rw <- myfld.mul_assoc x a x, rw myfld.mul_comm a x,
  repeat {rw myfld.mul_assoc _ _ _}, repeat {rw <- myfld.add_assoc _ _ _},
  rw myfld.add_assoc ((x .* a) .* a) ((x .* x) .* a) _,
  rw myfld.add_comm ((x .* a) .* a) ((x .* x) .* a),
  repeat {rw <- myfld.add_assoc _ _ _}, rw one_mul_simp f _,
end

def depressed_cubic_subst (f : Type) [myfld f] (c d x : f) : f :=
  (cubed f x) .+ ((c .* x) .+ d)

lemma depressed_cubic_solution_two_vars (f : Type) [myfld f] (x c d s t : f) :
    (x = myfld.add s (myfld.negate t)) /\
    c = (myfld.mul (three f) (myfld.mul s t)) /\
    d = (myfld.add (cubed f s) (myfld.negate (cubed f t))) ->
        (myfld.add (cubed f x) (myfld.mul c x) = d) :=
begin
  intros h, cases h with hx h, cases h with ha hb,
  rw hx, rw ha, rw hb, rw multiply_out_cubed f s (myfld.negate t),
  rw distrib_simp_alt f _ _ _,
  repeat {rw <- mul_negate_alt f _ _}, repeat {rw mul_negate f _ _}, repeat {rw <- mul_negate_alt f _ _},
  rw double_negative f _,
  have tmp : (cubed f (myfld.negate t)) = myfld.negate (cubed f t),
    unfold cubed, repeat {rw mul_negate_alt_simp f _ _}, repeat {rw mul_negate f _ _}, rw double_negative f _,
    rw mul_negate_alt_simp f _ _,
  rw tmp, clear tmp,
  rw <- myfld.mul_assoc _ (s .* t) s, rw myfld.mul_comm (s .* t) s,
  unfold square, repeat {rw myfld.mul_assoc},
  rw myfld.add_assoc _ (three f) .* s .* s .* t _, rw myfld.add_comm _ (three f) .* s .* s .* t,
  repeat {rw <- myfld.add_assoc},
  rw myfld.add_assoc _ (.- ((three f) .* s .* s .* t)) _, rw myfld.add_comm _ (.- ((three f) .* s .* s .* t)),
  repeat {rw myfld.add_assoc}, rw myfld.add_negate, rw simp_zero,
  rw myfld.add_comm _ (.- ((three f) .* s .* t .* t)),
  rw myfld.add_comm _ (three f) .* s .* t .* t,
  repeat {rw myfld.add_assoc}, rw myfld.add_comm (.- ((three f) .* s .* t .* t)) _,
  rw myfld.add_negate, rw simp_zero,
end

lemma depressed_cubic_simultaneous_solution (f : Type) [myfld f]
    [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
 (c d s t : f) (c_ne_zero : c ≠ myfld.zero) (s_ne_zero : s ≠ myfld.zero):
    (s = fld_with_cube_root.cubrt
        (quadratic_formula f myfld.one (.- d)
                (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one))
    -> (t = myfld.mul c (myfld.reciprocal ((three f) .* s) (mul_nonzero f (three f) s fld_not_char_three.not_char_three
                                                                            s_ne_zero))) ->
    ((c = myfld.mul (three f) (myfld.mul s t)) /\ (d = myfld.add (cubed f s) (myfld.negate (cubed f t)))) :=
begin
  intros hs ht,
  have hs_tmp : (cubed f s) = (quadratic_formula f myfld.one (.- d) (.- (cubed f c) .*
                                    (myfld.reciprocal (twenty_seven f) _)) myfld.zero_distinct_one),
    rw hs, rw cubrt_cubed, clear hs, rename hs_tmp hs,
  split,
    rw ht, rw myfld.mul_assoc, rw myfld.mul_comm c _, rw myfld.mul_assoc, rw myfld.mul_reciprocal, rw one_mul_simp,

    have ht_tmp : (cubed f t) =
                          (cubed f c) .*
                          (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f)) .*
                          (myfld.reciprocal (cubed f s) (cube_nonzero f s s_ne_zero)),
      rw ht, rw cube_of_product, rw cube_of_reciprocal,
      rw reciprocal_rewrite f _ _ (cube_of_product f _ _), rw split_reciprocal f,
      rw reciprocal_rewrite f _ _ (three_cubed f) _,
      rw only_one_reciprocal f (twenty_seven f) _ (twenty_seven_ne_zero f),
      rw only_one_reciprocal f (cubed f s) _ (cube_nonzero f s s_ne_zero),
      rw myfld.mul_assoc,
    clear ht, rename ht_tmp ht, rw ht,
    rw mul_both_sides f _ _ (cubed f s) (cube_nonzero f s s_ne_zero),
    rw carry_term_across_alt, rw distrib_simp, symmetry,
    rw <- mul_negate f d (cubed f s), rw mul_negate, repeat {rw <- myfld.mul_assoc},
    rw myfld.mul_comm (myfld.reciprocal _ _) (cubed f _), rw myfld.mul_reciprocal, rw simp_mul_one,
    rw <- myfld.add_assoc, rw myfld.add_comm _ (.-d .* _),
    have tmp : quadratic_subst f (cubed f s) myfld.one (.- d) (.- ((cubed f c) .* (myfld.reciprocal (twenty_seven f) _)))
                  = myfld.zero,
      rw hs, rw only_one_reciprocal f (twenty_seven f) _ (twenty_seven_ne_zero f),
      rw mul_negate,
      exact quadratic_formula_works f myfld.one (.- d) (.- ((cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f)))) myfld.zero_distinct_one,
    unfold quadratic_subst at tmp, rw one_mul_simp at tmp, exact tmp,
end

lemma cardano_den_ne_zero (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
      (c d : f) (c_ne_zero : c ≠ myfld.zero)
      : (quadratic_formula f myfld.one (d) (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one ≠ myfld.zero)
      :=
begin
  unfold quadratic_formula, apply mul_nonzero,
  intros h, rw carry_term_across at h, rw simp_zero at h,
  have tmp : ∀ (a b : f), (.- a = .- b) <-> (a = b),
    intros a b, split, intros h, have tmp_tmp : .- .- a = .- .- b, rw h,
    repeat {rw double_negative at tmp_tmp}, exact tmp_tmp,
    intros h, rw h,
  rw tmp at h, clear tmp,
  have h_tmp : d .* d = sqroot (d .* d .+ .- ((four f) .* (myfld.one .* ( .- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f)))))) .* sqroot (d .* d .+ .- ((four f) .* (myfld.one .* ( .- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f)))))),
    rw <- h,
  clear h, rename h_tmp h,
  rw fld_with_sqrt.sqrt_mul_sqrt at h,
  have tmp : ∀ (a b : f), (a = a .+ b) <-> (b = myfld.zero), intros a b, split,
    intros h, have tmp_tmp : (.- a) .+ a = (.- a) .+ (a .+ b), rw <- h,
    rw myfld.add_assoc at tmp_tmp, rw myfld.add_comm (.- a) a at tmp_tmp,
    rw myfld.add_negate a at tmp_tmp, rw simp_zero at tmp_tmp, symmetry, exact tmp_tmp,
    intros h, rw h, rw zero_simp,
  rw tmp at h, clear tmp,
  rw one_mul_simp at h, repeat {rw mul_negate at h}, rw mul_negate_alt_simp at h,
  rw double_negative at h,
  exact (mul_nonzero f (four f) (_ .* _) (four_ne_zero f) (mul_nonzero f _ _ (cube_nonzero f c c_ne_zero) (reciprocal_ne_zero f _ _))) h,
  exact reciprocal_ne_zero f _ _,
end

def cardano_formula_new (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
    (c d : f) (c_ne_zero : c ≠ myfld.zero) (cubrt_func : f -> f)
      (cubrt_func_nonzero : ∀ (x : f), x ≠ myfld.zero -> (cubrt_func x ≠ myfld.zero))
      (cubrt_func_correct : ∀ (x : f), (cubed f (cubrt_func x)) = x) : f :=
  (fld_with_cube_root.cubrt
        (quadratic_formula f myfld.one d
                (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one))
    .+ .- (myfld.mul c (myfld.reciprocal ((three f) .* (fld_with_cube_root.cubrt
        (quadratic_formula f myfld.one d
                (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one))) (mul_nonzero f (three f) (fld_with_cube_root.cubrt
        (quadratic_formula f myfld.one d
                (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one)) fld_not_char_three.not_char_three
                                                                            (cubrt_nonzero f (quadratic_formula f myfld.one (d) (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one) (cardano_den_ne_zero f c d c_ne_zero)))))

def cardano_formula_a_new (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
    (c d : f) (c_ne_zero : c ≠ myfld.zero) : f :=
    cardano_formula_new f c d c_ne_zero fld_with_cube_root.cubrt (cubrt_nonzero f) (cubrt_cubed f)

def cardano_formula_b_new (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
    (c d : f) (c_ne_zero : c ≠ myfld.zero) : f :=
    cardano_formula_new f c d c_ne_zero (alt_cubrt_a f) (alt_cubrt_a_nonzero f) (alt_cubrt_a_correct f)

def cardano_formula_c_new (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
    (c d : f) (c_ne_zero : c ≠ myfld.zero) : f :=
    cardano_formula_new f c d c_ne_zero (alt_cubrt_b f) (alt_cubrt_b_nonzero f) (alt_cubrt_b_correct f)

lemma cardano_works (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
      (c d : f) (c_ne_zero : c ≠ myfld.zero) (cubrt_func : f -> f)
      (cubrt_func_nonzero : ∀ (x : f), x ≠ myfld.zero -> (cubrt_func x ≠ myfld.zero))
      (cubrt_func_correct : ∀ (x : f), (cubed f (cubrt_func x)) = x) :
      depressed_cubic_subst f c d (cardano_formula_new f c d c_ne_zero cubrt_func cubrt_func_nonzero cubrt_func_correct)
            = myfld.zero :=
begin
  have clear_term : ∀ (a b x : f), a = b -> (x .+ a) = (x .+ b),
    intros a b x h, rw h,
  unfold depressed_cubic_subst, rw myfld.add_assoc, rw carry_term_across,
  rw simp_zero,
  apply depressed_cubic_solution_two_vars f (cardano_formula_new f c d c_ne_zero cubrt_func cubrt_func_nonzero cubrt_func_correct)
                                               c (.- d) (fld_with_cube_root.cubrt
        (quadratic_formula f myfld.one (d)
                (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one)) ((myfld.mul c (myfld.reciprocal ((three f) .* (fld_with_cube_root.cubrt
        (quadratic_formula f myfld.one (d)
                (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one))) (mul_nonzero f (three f) (fld_with_cube_root.cubrt
        (quadratic_formula f myfld.one (d)
                (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one)) fld_not_char_three.not_char_three
                                                                            (cubrt_nonzero f (quadratic_formula f myfld.one (d) (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one) (cardano_den_ne_zero f c d c_ne_zero)))))),
  split,
  unfold cardano_formula_new,

  apply depressed_cubic_simultaneous_solution,

  exact c_ne_zero,
  apply cubrt_eq, rw double_negative, refl,
end

def cubic_subst (f : Type) [myfld f] (a b c d x : f) : f :=
  (a .* (cubed f x)) .+ ((b .* (square f x)) .+ ((c .* x) .+ d))

lemma divide_cubic_through (f : Type) [myfld f] (a b c d x : f) (a_ne_zero : a ≠ myfld.zero) :
      (cubic_subst f a b c d x) = myfld.zero <->
      (cubic_subst f myfld.one (b .* (myfld.reciprocal a a_ne_zero)) (c .* (myfld.reciprocal a a_ne_zero)) (d .* (myfld.reciprocal a a_ne_zero)) x)
       = myfld.zero :=
begin
  unfold cubic_subst, split, intros h,
  have h1 : (((a .* (cubed f x)) .+ ((b .* (square f x)) .+ ((c .* x) .+ d))) .* (myfld.reciprocal a a_ne_zero)) = myfld.zero,
    rw h, rw mul_zero,
  clear h, rename h1 h,
  repeat {rw distrib_simp f _ _ _ at h},
  repeat {rw <- myfld.mul_assoc _ _ (myfld.reciprocal a a_ne_zero) at h},
  repeat {rw myfld.mul_comm _ (myfld.reciprocal a a_ne_zero) at h},
  rw myfld.mul_assoc a (myfld.reciprocal a a_ne_zero) _ at h,
  rw myfld.mul_reciprocal a a_ne_zero at h,
  rw myfld.mul_comm d (myfld.reciprocal a a_ne_zero),
  repeat {rw myfld.mul_assoc _ _ _ at h}, repeat {rw myfld.mul_assoc _ _ _},
  exact h,

  intros h,
  have h1 : (((myfld.one .* (cubed f x)) .+ (((b .* (myfld.reciprocal a a_ne_zero)) .* (square f x)) .+ (((c .* (myfld.reciprocal a a_ne_zero)) .* x) .+ (d .* (myfld.reciprocal a a_ne_zero))))) .* a) = myfld.zero,
    rw h, rw mul_zero,
  clear h, rename h1 h,
  repeat {rw distrib_simp f _ _ _ at h},
  rw <- myfld.mul_assoc _ (myfld.reciprocal a a_ne_zero) a at h,
  rw myfld.mul_comm (myfld.reciprocal a a_ne_zero) a at h, rw myfld.mul_reciprocal a a_ne_zero at h, rw simp_mul_one at h,
  repeat {rw <- myfld.mul_assoc _ _ a at h}, repeat {rw myfld.mul_comm _ a at h},
  repeat {rw myfld.mul_assoc _ a _ at h}, repeat {rw <- myfld.mul_assoc _ _ a at h},
  repeat {rw myfld.mul_comm (myfld.reciprocal a a_ne_zero) a at h},
  rw myfld.mul_reciprocal a a_ne_zero at h,
  repeat {rw simp_mul_one at h}, rw one_mul_simp at h,
  exact h,
end

def third (f : Type) [myfld f] [fld_not_char_three f] : f :=
  (myfld.reciprocal (three f) fld_not_char_three.not_char_three)

def twenty_seventh (f : Type) [myfld f] [fld_not_char_three f] : f :=
  (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))

/- This looks weird and pointless but it simplifies a proof later.-/
lemma depressed_cubic_equal_split (f : Type) [myfld f] (c1 d1 c2 d2 x : f) :
  (c1 = c2) /\ (d1 = d2) -> (depressed_cubic_subst f c1 d1 x) = (depressed_cubic_subst f c2 d2 x) :=
begin
  intros h, cases h with h1 h2, rw h1, rw h2,
end

/- This is used in the next proof (reduce_cubic_to_depressed) . It could have been done with a "have",
but the next proof is long enough that my computer was struggling with it, so it seemed worth moving this bit out.-/
lemma helper_bcubed (f : Type) [myfld f] [fld_not_char_three f] (b : f) :
(b .* ((third f) .* (b .* ((third f) .* b)))) =
          ((three f) .* ((myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f)) .* ((b .* b) .* b))) :=
begin
  unfold third, unfold twenty_seven, unfold nine, rw split_reciprocal f _ _ _,
  rw <- myfld.mul_assoc (myfld.reciprocal (three f) _),
  rw myfld.mul_assoc (three f) (myfld.reciprocal (three f) _) _,
  rw myfld.mul_reciprocal (three f) _, rw one_mul_simp f _,
  repeat {rw myfld.mul_comm b (_ .* _) },
  repeat {rw myfld.mul_assoc _ _ _}, rw mul_two_reciprocals f _ _ _ _,
end

/- Ditto.-/
lemma helper_twothirds (f : Type) [myfld f] [fld_not_char_three f] :
    ((.- (third f)) .+ myfld.one) = (third f) .+ (third f) :=
begin
  have h : myfld.one = (third f) .* (three f) ,
    unfold third, rw myfld.mul_comm, symmetry, exact myfld.mul_reciprocal (three f) _,
  rw h, clear h,
  have h : (.- (third f)) = (third f) .* (.- myfld.one) ,
    rw <- mul_negate_alt f _ _, rw simp_mul_one f _,
  rw h, clear h,
  rw <- distrib_simp_alt f _ _ _, unfold third, unfold three,
  rw myfld.add_assoc (.- myfld.one) myfld.one _,
  rw myfld.add_comm (.- myfld.one) myfld.one, rw myfld.add_negate myfld.one,
  rw simp_zero f _,
  rw distrib_simp_alt f _ _ _, rw simp_mul_one f _,
end

lemma reduce_cubic_to_depressed (f : Type) [myfld f] [fld_not_char_three f] (b c d x y : f) :
    x = y .+ (.- (b .* (third f))) ->
    (cubic_subst f myfld.one b c d x) =
    (depressed_cubic_subst f (((square f b) .* (.- (third f))) .+ c) ((twenty_seventh f) .* ((((two f) .* (cubed f b)) .+ (.- ((nine f) .* (b .* c)))) .+ ((twenty_seven f) .* d))) y) :=
begin
  intros h, rw h, clear h, unfold cubic_subst,
  rw multiply_out_cubed f y _, rw multiply_out_squared f _ _,
  rw one_mul_simp f _,
  repeat {rw distrib_simp_alt f _ _ _},
  rw mul_negate f _ _, repeat {rw mul_negate_alt_simp f _ _}, repeat {rw mul_negate f _ _}, rw mul_negate_alt_simp f _ _,
  rw double_negative f _,

  /- First job is to cancel the terms that have 3 * (1/3) in them.-/
  have third_three : (three f) .* (third f) = myfld.one,
    unfold third, rw myfld.mul_reciprocal (three f) _,
  rw myfld.mul_comm b (third f), rw myfld.mul_assoc _ (third f) _,
  rw myfld.mul_comm _ (third f), rw <- myfld.mul_assoc (third f) _ _,
  rw myfld.mul_assoc y (third f) b, rw myfld.mul_comm y (third f),
  rw <- myfld.mul_assoc (third f) y b, rw <- myfld.mul_assoc (third f) (y .* b) _,
  repeat {rw myfld.mul_assoc (three f) (third f) _},
  rw third_three, clear third_three,
  repeat {rw one_mul_simp f _},

  /- Now we have a term for by^2 and -by^2, so these cancel.-/
  unfold square, rw myfld.mul_comm b (y .* y),
  rw myfld.add_comm (.- ((y .* y) .* b)) _,
  repeat {rw <- myfld.add_assoc},
  rw myfld.add_assoc (.- ((y .* y) .* b)) ((y .* y) .* b) _,
  rw myfld.add_comm (.- ((y .* y) .* b)) ((y .* y) .* b),
  rw myfld.add_negate ((y .* y) .* b), rw simp_zero,

  /- This ultimately needs to be made equivalent to the depressed cubic formula, so we gather all the
      terms that are multiplied by y together.-/
  rw myfld.mul_comm _ y,
  repeat {rw myfld.mul_assoc _ y _, rw myfld.mul_comm _ y},
  rw <- myfld.mul_assoc y (two f) _, rw myfld.mul_assoc _ y _, rw myfld.mul_comm b y, repeat {rw <- myfld.mul_assoc y b _},
  rw mul_negate_alt f y _, rw myfld.mul_comm c y,
  rw myfld.add_assoc (cubed f (.- ((third f) .* b))) (y .* _) _,
  rw myfld.add_comm _ (y .* (.- (b .* ((two f) .* ((third f) .* b))))),
  rw <- myfld.add_assoc (y .* (.- (b .* ((two f) .* ((third f) .* b))))) _ _,
  rw myfld.add_assoc (y .* _) (y .* _),
  rw <- distrib_simp_alt f y _ _,
  rw myfld.add_assoc _ (y .* c) _, rw myfld.add_comm _ (y .* c), rw <- myfld.add_assoc (y .* c) _ _,
  rw myfld.add_assoc _ (y .* c) _, rw myfld.add_comm _ (y .* c), rw <- myfld.add_assoc (y .* c) _ _,
  rw myfld.add_assoc _ (y .* c) _,
  rw <- distrib_simp_alt f y _ c,

  /- We can now fold this back into the depressed cubic formula,
      which will make the remaining algebra slightly easier to follow.-/
  rw myfld.mul_comm y _,
  /- The following line is ugly, but it's just a copy-paste of the algebra in the sidebar.-/
  have tmp : (cubed f y) .+ (((((b .* ((third f) .* b)) .+ (.- (b .* ((two f) .* ((third f) .* b))))) .+ c) .* y) .+ ((cubed f (.- ((third f) .* b))) .+ ((b .* ((.- ((third f) .* b)) .* (.- ((third f) .* b)))) .+ ((.- (c .* ((third f) .* b))) .+ d))))
      =
      depressed_cubic_subst f (((b .* ((third f) .* b)) .+ (.- (b .* ((two f) .* ((third f) .* b))))) .+ c) ((cubed f (.- ((third f) .* b))) .+ ((b .* ((.- ((third f) .* b)) .* (.- ((third f) .* b)))) .+ ((.- (c .* ((third f) .* b))) .+ d))) y,
    unfold depressed_cubic_subst,
  rw tmp, clear tmp,

  /- This enables us to break down into two goals (one for the y term and one for the constant.) -/
  apply depressed_cubic_equal_split f _ _ _ _ y, split,

  /- (b^2) /3 - 2 (b/^2) 3 = - (b^2) /3, which solves the y term goal.-/
  rw myfld.mul_comm _ b, rw myfld.mul_comm _ (b .* _), rw myfld.mul_assoc _ b _,
  rw myfld.mul_comm (two f) b, rw <- myfld.mul_assoc b (two f) _,
  rw myfld.mul_comm (b .* (third f)) b, repeat {rw myfld.mul_assoc b b _},
  rw mul_negate_alt f (b .* b) _,
  rw <- distrib_simp_alt f (b .* b) _ _,
  rw myfld.mul_comm (two f) (third f),
  have tmp : (third f) = ((third f) .* myfld.one),
    exact myfld.mul_one (third f),
  rewrite [tmp] {occs := occurrences.pos [1]}, clear tmp,
  rw mul_negate_alt f (third f) (two f),
  rw <- distrib_simp_alt f (third f) _ _,
  have tmp : myfld.one .+ (.- (two f)) = .- (myfld.one),
    unfold two, rw add_negate f myfld.one myfld.one,
    rw myfld.add_assoc myfld.one (.- myfld.one) (.- myfld.one),
    rw myfld.add_negate myfld.one, rw <- zero_add f (.- myfld.one),
  rw tmp, clear tmp,
  rw <- mul_negate_alt f (third f) myfld.one, rw simp_mul_one f _,
  rw <- mul_negate_alt f (b .* b) (third f),

  /- The constant goal is a bit more complicated, but all it really involves is collecting together the b^3 terms
       and reducing the coefficient of each term to a single power of three.-/
  unfold cubed, repeat {rw mul_negate f _ _}, repeat {rw mul_negate_alt_simp f _ _},
  repeat {rw double_negative f _},
  rw myfld.mul_assoc (twenty_seventh f) (twenty_seven f) _,
  rw myfld.mul_comm (twenty_seventh f) (twenty_seven f), unfold twenty_seventh,
  rw myfld.mul_reciprocal (twenty_seven f) _, rw one_mul_simp f _,
  rw myfld.mul_assoc (myfld.reciprocal (twenty_seven f) _) (nine f),
  rw only_one_reciprocal f (twenty_seven f) _ (twenty_seven_ne_zero f),
  have tmp : ((myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f)) .* (nine f)) =
                (myfld.reciprocal (three f) fld_not_char_three.not_char_three),
    unfold twenty_seven, unfold nine, rw split_reciprocal f _ _ _, rw split_reciprocal f _ _ _,
    repeat {rw <- myfld.mul_assoc _ _ _}, rw myfld.mul_assoc (myfld.reciprocal _ _) (three f) _,
    rw myfld.mul_comm (myfld.reciprocal (three f) _) (three f),
    rw myfld.mul_reciprocal (three f) _, rw one_mul_simp f _,
    rw myfld.mul_comm (myfld.reciprocal (three f) _) (three f),
    rw myfld.mul_reciprocal (three f) _, rw simp_mul_one f _,
  rw myfld.mul_assoc (myfld.reciprocal (twenty_seven f) _) (nine f) _,
  rw tmp, clear tmp,
  rw myfld.mul_assoc _ (two f) _, rw myfld.mul_comm _ (two f), rw <- myfld.mul_assoc (two f) _ _,
  unfold two, rw distrib_simp f myfld.one myfld.one _, rw one_mul_simp f _,
  rw myfld.add_assoc _ (b .* ((third f) .* (b .* ((third f) .* b)))) _,
  rw helper_bcubed f b,
  have tmp : ((three f) .* ((myfld.reciprocal (twenty_seven f) _) .* ((b .* b) .* b))) =
    (myfld.one .* ((three f) .* ((myfld.reciprocal (twenty_seven f) _) .* ((b .* b) .* b)))),
    rw one_mul_simp f _,
  rewrite [tmp] {occs := occurrences.pos [2]}, clear tmp,
  rw <- mul_negate f (third f) _, rw <- distrib_simp f _ _ _, rw helper_twothirds f,
  rw distrib_simp f (third f) (third f) _,
  rw myfld.mul_assoc (third f) (three f) _,
  have tmp : (third f) .* (three f) = myfld.one,
    unfold third, rw myfld.mul_comm _ _, rw myfld.mul_reciprocal (three f) _,
  rw tmp, rw one_mul_simp f _, clear tmp,
  rw myfld.mul_assoc c (third f) b, rw myfld.mul_comm c (third f), rw <- myfld.mul_assoc (third f) c b,
  rw myfld.mul_comm c b,
  rw myfld.mul_assoc b b b,
  unfold third,
end

lemma int_quantity_ne_zero_simp (f : Type) [myfld f] [fld_not_char_three f] (a1 b c : f) (a_ne_zero : a1 ≠ myfld.zero) :
  ((three f) .* (a1 .* c)) .+ (.- (square f b)) ≠ myfld.zero ->
  (((square f (b .* (myfld.reciprocal a1 a_ne_zero))) .* (.- (third f))) .+ (c .* (myfld.reciprocal a1 a_ne_zero))) ≠ myfld.zero :=
begin
  intros h1 h2,
  unfold square at h2, rw myfld.mul_comm _ (.- _) at h2,
  repeat {rw myfld.mul_assoc _ _ (myfld.reciprocal a1 a_ne_zero) at h2},
  rw <- distrib_simp f _ _ _ at h2, rw <- mul_zero_by_reciprocal f a1 _ _ at h2,
  rw mul_both_sides f _ _ (three f) at h2, rw mul_zero at h2,
  rw distrib_simp at h2, repeat {rw mul_negate at h2}, rw myfld.mul_comm (_ .* _) (three f) at h2,
  rw myfld.mul_assoc (three f) (third f) _ at h2,
  unfold third at h2, rw myfld.mul_reciprocal (three f) _ at h2, rw one_mul_simp at h2,
  rw mul_both_sides f _ _ a1 at h2, rw distrib_simp at h2, rw mul_zero at h2, rw mul_negate at h2,
  rw myfld.mul_comm _ b at h2, repeat {rw <- myfld.mul_assoc at h2},
  rw myfld.mul_comm _ a1 at h2, rw myfld.mul_reciprocal a1 _ at h2, rw simp_mul_one at h2,

  unfold square at h1, rw myfld.mul_comm c _ at h2, rw myfld.mul_assoc at h1, rw myfld.add_comm at h1,
  cc, cc, exact fld_not_char_three.not_char_three,
end

def cubic_formula_a (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
  (a b c d : f) (a_ne_zero : a ≠ myfld.zero) (int_quantity_ne_zero : ((three f) .* (a .* c)) .+ (.- (square f b)) ≠ myfld.zero) : f
  := ((cardano_formula_a_new f (((square f (b .* (myfld.reciprocal a a_ne_zero))) .* (.- (third f))) .+ (c .* (myfld.reciprocal a a_ne_zero))) ((twenty_seventh f) .* ((((two f) .* (cubed f (b .* (myfld.reciprocal a a_ne_zero)))) .+ (.- ((nine f) .* ((b .* (myfld.reciprocal a a_ne_zero)) .* (c .* (myfld.reciprocal a a_ne_zero)))))) .+ ((twenty_seven f) .* (d .* (myfld.reciprocal a a_ne_zero))))) (int_quantity_ne_zero_simp f a b c a_ne_zero int_quantity_ne_zero)) .+ (.- ((b .* (myfld.reciprocal a a_ne_zero)) .* (third f))))

lemma cubic_formula_a_correct (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f]
                                         [fld_not_char_two f] [fld_not_char_three f]
  (a b c d : f) (a_ne_zero : a ≠ myfld.zero)
                (int_quantity_ne_zero : ((three f) .* (a .* c)) .+ (.- (square f b)) ≠ myfld.zero) :
    cubic_subst f a b c d (cubic_formula_a f a b c d a_ne_zero int_quantity_ne_zero) = myfld.zero :=
begin
  rw divide_cubic_through f a b c d _ a_ne_zero,
  have tmp : (cubic_formula_a f a b c d a_ne_zero int_quantity_ne_zero)
              = (((cubic_formula_a f a b c d a_ne_zero int_quantity_ne_zero) .+ ((b .* (myfld.reciprocal a a_ne_zero)) .* (third f))) .+ (.- ((b .* (myfld.reciprocal a a_ne_zero)) .* (third f)))),
    simp,
  rw reduce_cubic_to_depressed f (b .* (myfld.reciprocal a a_ne_zero)) (c .* (myfld.reciprocal a a_ne_zero)) (d .* (myfld.reciprocal a a_ne_zero)) (cubic_formula_a f a b c d a_ne_zero int_quantity_ne_zero) ((cubic_formula_a f a b c d a_ne_zero int_quantity_ne_zero) .+ ((b .* (myfld.reciprocal a a_ne_zero)) .* (third f))) tmp,
  clear tmp, unfold cubic_formula_a, unfold cardano_formula_a_new,
  rw <- myfld.add_assoc (cardano_formula_new f _ _ _ _ _ _) (.- _) _,
  rw myfld.add_comm (.- _) _, rw myfld.add_negate _, rw zero_simp f _,
  exact cardano_works f _ _ _ _ _ _,
end

/- I was hoping to be able to prove the formulae formations equivalent, but that's unfortunately impossible.
    We end up needing to prove that sqrt (x)/2 = sqrt(x/4).
    This is obviously true for any sensible sqrt function, but our minimalist specification of square roots means it isn't
    necessarily true of any valid implementation.-/

/- def cardano_formula_old (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
      (c d : f) (c_ne_zero : c ≠ myfld.zero) (cubrt_func : f -> f)
      (cubrt_func_nonzero : ∀ (x : f), x ≠ myfld.zero -> (cubrt_func x ≠ myfld.zero))
      (cubrt_func_correct : ∀ (x : f), (cubed f (cubrt_func x)) = x) : f :=
  ((cubrt_func ((cardano_intermediate_val f c d) .+ (cardano_other_int_val f d))) .+ (.- (c .* (myfld.reciprocal ((cubrt_func ((cardano_intermediate_val f c d) .+ (cardano_other_int_val f d))) .* (three f)) (cardano_denominator_not_zero f c d c_ne_zero cubrt_func cubrt_func_nonzero)))))

lemma cardano_versions_equiv (f : Type) [myfld f] [fld_with_sqrt f] [fld_with_cube_root f] [fld_not_char_two f] [fld_not_char_three f]
      (c d : f) (c_ne_zero : c ≠ myfld.zero) (cubrt_func : f -> f)
      (cubrt_func_nonzero : ∀ (x : f), x ≠ myfld.zero -> (cubrt_func x ≠ myfld.zero))
      (cubrt_func_correct : ∀ (x : f), (cubed f (cubrt_func x)) = x) :
  (cardano_formula_new f c d c_ne_zero cubrt_func cubrt_func_nonzero cubrt_func_correct) =
  (cardano_formula_old f c d c_ne_zero cubrt_func cubrt_func_nonzero cubrt_func_correct) :=
begin
  have clear_term : ∀ (a b x : f), a = b -> (x .+ a) = (x .+ b),
    intros a b x h, rw h,
  unfold cardano_formula_new, unfold cardano_formula_old,
  have reduce_1 : ((quadratic_formula f myfld.one d (.- (cubed f c) .* (myfld.reciprocal (twenty_seven f) (twenty_seven_ne_zero f))) myfld.zero_distinct_one))
              =
        (cardano_intermediate_val f c d) .+ (cardano_other_int_val f d),
    unfold quadratic_formula, unfold cardano_intermediate_val, unfold cardano_other_int_val,
    rw one_mul_simp, rw reciprocal_rewrite f _ _ (simp_mul_one f _),
    rw distrib_simp,
    repeat {rw mul_negate}, repeat {rw mul_negate_alt_simp}, rw double_negative,
    rw myfld.add_comm _ (.- (d .* (myfld.reciprocal (two f) fld_not_char_two.not_char_two))),
    rw only_one_reciprocal f (two f) _ (fld_not_char_two.not_char_two),
    apply clear_term,
end
-/


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import data.fin
import tactic.linarith
import tactic.zify

/-
  Note : Looking at the documentation of zmod suggests this is unnecessary.
 -/

namespace nat

--Used below in simps in many places.
@[simp] lemma mul_mod_mod {a b c : ℕ} : (a * (b % c)) % c = (a * b) % c :=
begin
  rw ← mod_add_div b c,
  simp [right_distrib, left_distrib],
  rw mul_comm a (c * (b / c)),
  rw mul_assoc,
  rw add_mul_mod_self_left,
end

end nat

namespace fin

lemma pos_of_fin {n:ℕ} (a:fin n) : 0 < n :=
begin
  apply lt_of_le_of_lt (nat.zero_le _) a.property,
end

def neg {n:ℕ} (a:fin n):fin n := @subtype.mk ℕ _ ((n - a) % n)
begin
  apply nat.mod_lt,
  apply fin.pos_of_fin a,
end

instance has_neg (n:ℕ):has_neg (fin n) := ⟨@fin.neg n⟩

lemma neg_def {n:ℕ} (a:fin n.succ):(-a).val = (n.succ - a.val) % n.succ :=
begin
  have A1:(-a) = fin.of_nat (n.succ - a.val) := rfl,
  rw A1,
  unfold fin.of_nat,
end

@[simp]
lemma val_mod {n:ℕ} {a:fin n}:(↑a:nat) % n = (↑a:nat) :=
begin
  have A1:(↑a:ℕ) = (a.val) := rfl,
  rw A1,
  rw nat.mod_eq_of_lt a.property,
end

instance add_comm_group (n:ℕ):add_comm_group (fin n.succ) := {
  add_assoc :=
  begin
    intros a b c,
    apply subtype.eq,
    simp [fin.add_def],
    rw add_assoc,
  end,
  zero_add :=
  begin
    intros a,
    apply subtype.eq,
    simp [fin.add_def],
  end,
  add_zero :=
  begin
    intros a,
    apply subtype.eq,
    simp [fin.add_def],
  end,
  add_left_neg :=
  begin
    intro a,
    apply subtype.eq,
    simp [fin.add_def, fin.neg_def],
    have A3: (↑a) < n.succ,
    { apply a.property, },
    have A4: n.succ - (↑a) + (↑a) = n.succ,
    { zify [le_of_lt A3], linarith },
    rw A4,
    simp,
  end,
  add_comm :=
  begin
    intros a b,
    apply subtype.eq,
    simp [fin.add_def],
    rw add_comm,
  end,
  ..fin.has_add,
  ..fin.has_zero,
  ..fin.has_neg (n.succ),
}

instance comm_ring (n:ℕ):comm_ring (fin n.succ.succ) := {
  mul_assoc :=
  begin
    intros a b c,
    apply subtype.eq,
    simp [fin.mul_def],
    rw mul_comm,
    --rw mul_mod_mod,
    rw ← mul_assoc,
    simp,
    rw mul_comm,
  end,
  one_mul :=
  begin
    intros a,
    apply subtype.eq,
    simp [fin.mul_def],
  end,
  mul_one :=
  begin
    intros a,
    apply subtype.eq,
    simp [fin.mul_def],
  end,
  mul_comm :=
  begin
    intros a b,
    apply subtype.eq,
    simp [fin.mul_def],
    rw mul_comm,
  end,
  left_distrib :=
  begin
    intros a b c,
    apply subtype.eq,
    simp [fin.mul_def, fin.add_def],
    rw left_distrib,
  end,
  right_distrib :=
  begin
    intros a b c,
    apply subtype.eq,
    simp [fin.mul_def, fin.add_def],
    rw mul_comm,
    simp,
    rw mul_comm,
    rw right_distrib,
  end,
  ..fin.has_one,
  ..fin.has_mul,
  ..fin.has_add,
  ..fin.has_zero,
  ..fin.has_neg (n.succ.succ),
  ..fin.add_comm_group (n.succ),
}

end fin


import tools.super

namespace imp
open tactic

@[reducible] def uname := string

inductive aexp
| val  : nat → aexp
| var  : uname → aexp
| plus : aexp → aexp → aexp

instance : decidable_eq aexp :=
by mk_dec_eq_instance

@[reducible] def value := nat

def state := uname → value

open aexp

def aval : aexp → state → value
| (val n)      s := n
| (var x)      s := s x
| (plus a₁ a₂) s := aval a₁ s + aval a₂ s

def updt (s : state) (x : uname) (v : value) : state :=
λ y, if x = y then v else s y

def asimp_const : aexp → aexp
| (val n)      := val n
| (var x)      := var x
| (plus a₁ a₂) :=
  match asimp_const a₁, asimp_const a₂ with
  | val n₁, val n₂ := val (n₁ + n₂)
  | b₁,     b₂     := plus b₁ b₂
  end

lemma aval_asimp_const (a : aexp) (s : state) : aval (asimp_const a) s = aval a s :=
begin
  induction a with n x a₁ a₂ ih₁ ih₂,
  repeat {reflexivity},
  unfold asimp_const aval,
  rewrite [-ih₁, -ih₂],
  cases (asimp_const a₁),
  repeat {cases (asimp_const a₂), repeat {reflexivity}}
end

end imp


import tactic
import data.real.basic

import .custom.defs
import .custom.sequences
import .custom.cauchy

noncomputable theory

open set
open_locale classical
section suites

open espace_metrique
variables {X: Type} [espace_metrique X]
variables {Y: Type} [espace_metrique Y]
variables {Z: Type} [espace_metrique Z]

/-- on définit le *type* des suites de Cauchy --/

def cauchy_seqs (X: Type*) [espace_metrique X] := { f : ℕ → X // cauchy f }

/-- Si le temps le permet, et seulement dans ce cas,
-- montrer que le pre-ecart induit une structure
d'espace pre-metrique sur l'ensemble des suites de cauchy pour
pouvoir éventuellement construire la completion de l'espace X
comme le quotient de l'ensemble des suites de cauchy par la
relation d'équivalence appropriée --/

-- Retourne la limite de d(x_n, y_n) (bien définie par complétude de R), requiert l'axiome du choix.

-- Définit la distance entre 2 suites de Cauchy par lim d(x_n, y_n).
def cauchy.dist (T: Type*) [espace_metrique T] (x y: cauchy_seqs T): ℝ
  := cauchy.limit (pre_ecart x.val y.val) (pre_ecart_cauchy x.val y.val x.property y.property)

def cauchy.d_pos (T: Type*) [espace_metrique T] (x y: cauchy_seqs T): cauchy.dist T x y ≥ 0 := begin
rw cauchy.dist,
apply cauchy.limit_ge_of_seq_ge,
intro n,
rw pre_ecart,
simp,
exact espace_metrique.d_pos _ _,
end

def cauchy.pre_ecart_self_eq_zero_seq (T: Type*) [espace_metrique T] (x: cauchy_seqs T):
  pre_ecart x.val x.val = ((λ n, 0): ℕ → ℝ) := begin
  rw pre_ecart,
  ext,
  apply espace_metrique.presep,
  refl,
end

instance pre_ecart.premetrique (X: Type*) [espace_metrique X]: espace_pre_metrique (cauchy_seqs X) :=
{ d := cauchy.dist X,
  d_pos := cauchy.d_pos X,
  presep := begin
  intros x y h,
  rw cauchy.dist,
  rw h,
  conv {
    congr,
    congr,
    rw cauchy.pre_ecart_self_eq_zero_seq X y,
    skip,
    skip,
  },
  apply cauchy.constant_limit 0,
  end,
  sym := begin
  intros x y,
  rw cauchy.dist,
  rw cauchy.dist,
  conv {
    congr,
    congr,
    rw cauchy.pre_ecart_sym,
    skip,
    skip,
  },
  end,
  triangle := begin
  intros x y z,
  rw cauchy.dist,
  rw cauchy.dist,
  rw cauchy.dist,
  apply cauchy.limit_le_of_add_seq_le,
  exact pre_ecart.triangle _ _ _,
  end
}

def cauchy.cong (T: Type*) [espace_metrique T] (x y: cauchy_seqs T): Prop := cauchy.dist T x y = 0
lemma cauchy.cong_refl (T: Type*) [espace_metrique T]: reflexive (cauchy.cong T) := begin
  intro x,
  rw cauchy.cong,
  exact espace_pre_metrique.presep x x (by refl),
end
lemma cauchy.cong_symm (T: Type*) [espace_metrique T]: symmetric (cauchy.cong T) := begin
  intros x y H,
  rw cauchy.cong,
  rw cauchy.cong at H,
  rw ← H,
  symmetry,
  exact espace_pre_metrique.sym x y,
end
lemma cauchy.cong_trans (T: Type*) [espace_metrique T]: transitive (cauchy.cong T) := begin
  intros x y z Hxy Hyz,
  rw cauchy.cong,
  rw cauchy.cong at Hxy,
  rw cauchy.cong at Hyz,
  apply le_antisymm,
  calc
    cauchy.dist T x z ≤ cauchy.dist T x y + cauchy.dist T y z : espace_pre_metrique.triangle x y z
    ... ≤ 0 + 0 : by rw [Hxy, Hyz]
    ... ≤ 0 : by simp,
  exact espace_pre_metrique.d_pos x z,
end
theorem cauchy.cong_equiv (T: Type*) [espace_metrique T]: equivalence (cauchy.cong T) :=
⟨cauchy.cong_refl T, cauchy.cong_symm T, cauchy.cong_trans T⟩

instance pre_ecart.setoid (T: Type*) [espace_metrique T] : setoid (cauchy_seqs T) :=
{
  r := cauchy.cong T,
  iseqv := cauchy.cong_equiv T
}

local attribute [instance] pre_ecart.premetrique
def completion.dist_soundness (T: Type*) [espace_metrique T]:
  ∀ x₁ x₂: cauchy_seqs T, ∀ y₁ y₂: cauchy_seqs T, (x₁ ≈ y₁) → (x₂ ≈ y₂) → (espace_pre_metrique.d x₁ x₂ = espace_pre_metrique.d y₁ y₂) := begin
  intros x y z t Hxz Hyt,
  change (espace_pre_metrique.d x z = 0) at Hxz,
  change (espace_pre_metrique.d y t = 0) at Hyt,
  apply le_antisymm,
  calc
    espace_pre_metrique.d x y ≤ espace_pre_metrique.d x z + espace_pre_metrique.d z y : espace_pre_metrique.triangle x z y
    ... ≤ espace_pre_metrique.d x z + (espace_pre_metrique.d z t + espace_pre_metrique.d t y) : add_le_add_left (espace_pre_metrique.triangle z t y) _
    ... = espace_pre_metrique.d z t + espace_pre_metrique.d y t : by rw [Hxz, zero_add, espace_pre_metrique.sym t y]
    ... = espace_pre_metrique.d z t : by rw Hyt; simp,
  calc
    espace_pre_metrique.d z t ≤ espace_pre_metrique.d z x + espace_pre_metrique.d x t : espace_pre_metrique.triangle z x t
    ... ≤ espace_pre_metrique.d z x + (espace_pre_metrique.d x y + espace_pre_metrique.d y t) : add_le_add_left (espace_pre_metrique.triangle x y t) _
    ... = espace_pre_metrique.d x z + espace_pre_metrique.d x y : by rw [Hyt, add_zero, espace_pre_metrique.sym z x]
    ... = espace_pre_metrique.d x y : by rw Hxz; simp,
end

end suites

-- Le complété !
section completion
def completion (T: Type*) [espace_metrique T]: Type* := quotient (pre_ecart.setoid T)
local attribute [instance] pre_ecart.setoid

def completion.dist (T: Type*) [espace_metrique T] (x y: completion T): ℝ :=
  quotient.lift₂ (cauchy.dist T) (completion.dist_soundness T) x y

instance completion.metric_space (T: Type*) [espace_metrique T]: espace_metrique (completion T) :=
{
  d := completion.dist T,
  d_pos := λ x y,
    quotient.induction_on₂ x y $ λ X Y, show cauchy.dist T X Y ≥ 0, from cauchy.d_pos T X Y,
  presep := λ x y, quotient.induction_on₂ x y $ λ X Y H, show cauchy.dist T X Y = 0, from quotient.eq.1 H,
  sep := λ x y, quotient.induction_on₂ x y $ λ X Y H, show ⟦ X ⟧ = ⟦ Y ⟧, from quotient.sound H,
  sym := λ x y, quotient.induction_on₂ x y $ λ X Y, show cauchy.dist T X Y = cauchy.dist T Y X,
    from espace_pre_metrique.sym X Y,
  triangle := λ x y z, quotient.induction_on₃ x y z $ λ X Y Z, show cauchy.dist T X Z ≤ cauchy.dist T X Y + cauchy.dist T Y Z,
    from espace_pre_metrique.triangle X Y Z
}

end completion


-- import init.data.nat.basic
-- import init.algebra.ring
-- import init.algebra.norm_num
import init
import tactic
import data.nat.parity
import data.finset
import data.fintype
import algebra.big_operators
import data.real.basic
set_option class.instance_max_depth 15000000

#eval 2

open_locale classical

--open_local matrix

--Alice only sees r and Bob only sees c. The strategy isn't (r,c) → (...) but two maps, r→(r1 r2 r3) and c → (c1 c2 c3)
--I'm using 0 and 1 instead of Green and Red as the two options to fill squares. This makes checking parity of strategies easier

--fin 3 (type = {1,2,3})
--eventually we will be interested in relative probabilities

------------METHOD 1: enumerate all the constraints as concisely as possible and reduce to show we get a contraditcion----------------------------------
--try namespace outside of def but enclosing it
def checkStrategyrc (r c : ℕ) (strategy : ((ℕ → ℕ × ℕ × ℕ) × (ℕ → ℕ × ℕ × ℕ))) : Prop :=
        --functionalize this with lists.
        let r1 := (strategy.1 r).1,
        r2 := (strategy.1 r).2.1,
        r3 := (strategy.1 r).2.2,
        c1 := (strategy.2 c).1,
        c2 := (strategy.2 c).2.1,
        c3 := (strategy.2 c).2.2

        in nat.even(r1 + r2 + r3) ∧ (¬ nat.even(c1 + c2 + c3)) ∧
        ((r = 1 ∧ c = 1 ∧ r1 = c1) ∨ (r = 1 ∧ c = 2 ∧ r2 = c1) ∨ (r = 1 ∧ c = 3 ∧ r3 = c1)
        ∨(r = 2 ∧ c = 1 ∧ r1 = c2) ∨ (r = 2 ∧ c = 2 ∧ r2 = c2) ∨ (r = 2 ∧ c = 3 ∧ r3 = c2)
        ∨(r = 3 ∧ c = 1 ∧ r1 = c3) ∨ (r = 3 ∧ c = 2 ∧ r2 = c3) ∨ (r = 3 ∧ c = 3 ∧ r3 = c3))

--checks all three conditions are met for the strategy
def checkStrategy (strategy : ((ℕ → ℕ × ℕ × ℕ) × (ℕ → ℕ × ℕ × ℕ))) : Prop :=
    (checkStrategyrc 1 1 strategy) ∧ (checkStrategyrc 1 2 strategy) ∧ (checkStrategyrc 1 3 strategy) ∧
    (checkStrategyrc 2 1 strategy) ∧ (checkStrategyrc 2 2 strategy) ∧ (checkStrategyrc 2 3 strategy) ∧
    (checkStrategyrc 3 1 strategy) ∧ (checkStrategyrc 3 2 strategy) ∧ (checkStrategyrc 3 3 strategy)

--someone on Zulip said to try putting this not directly after the import statements. This seems to have helped

--given a strategy, we can't have it satisfy all the conditions

theorem odd_add_odd {m n} : ¬ nat.even m → ¬ nat.even n → nat.even (m + n) := sorry
theorem odd_add_even {m n} : ¬ nat.even m → nat.even n → ¬ nat.even (m + n) := sorry
theorem even_add_even {m n} : nat.even m → nat.even n → nat.even (m + n) := sorry

theorem noStrategy2 (strategy : ((ℕ → ℕ × ℕ × ℕ) × (ℕ → ℕ × ℕ × ℕ))) : ¬ (checkStrategy (strategy)) :=
begin
intro s,
rw checkStrategy at s,
repeat {rw checkStrategyrc at s},
revert s,
rw (show 1 = 2 ↔ false, by norm_num),
rw (show 2 = 1 ↔ false, by norm_num),
rw (show 3 = 1 ↔ false, by norm_num),
rw (show 1 = 3 ↔ false, by norm_num),
rw (show 3 = 2 ↔ false, by norm_num),
rw (show 2 = 3 ↔ false, by norm_num),
repeat {simp only [false_and, false_or, and_false, or_false]},
rw (show 1=1 ↔ true, by norm_num),
rw (show 2=2 ↔ true, by norm_num),
rw (show 3=3 ↔ true, by norm_num),
simp only [true_and, and_true, true_or, or_true],
intro s,
rcases s with ⟨⟨s1, t1, u1⟩, ⟨s2, t2, u2⟩, ⟨s3, t3, u3⟩,
               ⟨s4, t4, u4⟩, ⟨s5, t5, u5⟩, ⟨s6, t6, u6⟩,
               ⟨s7, t7, u7⟩, ⟨s8, t8, u8⟩, ⟨s9, t9, u9⟩⟩,
 -- fails
rw u1 at *,
rw u2 at *,
rw u3 at *,
rw u4 at *,
rw u5 at *,
rw u6 at *,
rw u7 at *,
rw u8 at *,
rw u9 at *,
apply odd_add_even t1 (odd_add_odd t2 t3),
convert even_add_even s1 (even_add_even s4 s7) using 1,
ring,

--seems like norm_num, finish, or safe could be useful here

--every case here has a false equality and-ed with something else. How do I replace them with false and reduce?
--how do I tell it that we only care about the cases where r,c ∈ {1,2,3} and then do cases on those?
end

--------------General case: mxn where m and n are odd
def checkStrategyMN {m n : nat} (strategyA : fin m → fin n → nat) (strategyB: fin n → fin m → nat) : Prop :=
(∀ r : fin m, (∀ c : fin n, ((finset.univ.sum (strategyA r)).even) ∧ (¬ (finset.univ.sum (strategyB c)).even) ∧ ((strategyA r c) = (strategyB c r))))

-- (∀ r : fin m, (finset.univ.sum (strategyA r)).even) ∧ (∀ c : fin n, ¬ (finset.univ.sum (strategyB c)).even) ∧
-- (∀ r : m, ∀ c : n, ((strategyA r c) = (strategyB c r)))

theorem noStrategyMN {m n : nat} (strategyA : fin m → fin n → nat) (strategyB: fin n → fin m → nat) : ((¬ m.even) ∧ (¬ n.even)) → ¬ (checkStrategyMN strategyA strategyB) :=
begin
rw checkStrategyMN,
intro h,
push_neg,
--??????????????????????
end

----Method 2: show sampling---

#check [[1,2],[1,2,3,4],[1,2,3,4,0],[]]

def board {m n : nat} (strategyA : fin m → fin n → nat) (strategyB: fin n → fin m → nat) : fin m → fin n → nat := strategyA --woah man...these representations are THE SAME!!!! (function that returns a vector and a matrix)

def consistent {m n : nat} (strategyA : fin m → fin n → nat) (strategyB: fin n → fin m → nat) : Prop
:= ∀ (r : fin m) (c : fin n), (strategyA r c) = (strategyB c r)

def sampleA {m n : nat} (board : fin m → fin n → nat) : fin m → fin n → nat := board

def sampleB {m n : nat} (board : fin m → fin n → nat) : fin n → fin m → nat := λ (n : fin n) (m : fin m), board m n
#check sampleA
#check sampleB

lemma board_equiv_strategy {m n : nat} (strategyA : fin m → fin n → nat) (strategyB: fin n → fin m → nat) :
(consistent strategyA strategyB) → (strategyA = ((sampleA (board strategyA strategyB))) ∧ (strategyB = (sampleB (board strategyA strategyB))))
:=
begin
intro h,
split,
rw sampleA,
rw board,
rw board,
rw sampleB,
rw consistent at h,
ext i,
rw h, --Logically this should work and seems pretty simple. How do I tell lean to do this???????????
end

def each_row_sum_even {m n : nat} (board : fin m → fin n → nat) : Prop := ∀ (r : fin m), (finset.univ.sum (sampleA board r)).even

def each_col_sum_odd {m n : nat} (board : fin m → fin n → nat) : Prop := ∀ (c : fin n), ¬(finset.univ.sum (sampleB board c)).even

def even_strategy {m n : nat} (strategyA : fin m → fin n → nat) : Prop := (∀ r : fin m, ((finset.univ.sum (strategyA r)).even))

def odd_strategy {m n : nat} (strategyB : fin n → fin m → nat) : Prop := (∀ (c : fin n), ¬ (finset.univ.sum (strategyB c)).even)

lemma even_strategy_implies_even_rows {m n : nat} (strategyA : fin m → fin n → nat) (strategyB : fin n → fin m → nat)
: ((consistent strategyA strategyB) ∧ even_strategy strategyA) → each_row_sum_even (board strategyA strategyB)
:=
begin
rw even_strategy,
rw each_row_sum_even,
rw sampleA,
rw board,
intro h,
have h := h.right,
exact h,
end

--In order to talk about a board we need to assume the two strategies are consistent. Or else we need to define the board differently to allowfor this
lemma odd_strategy_implies_odd_cols {m n : nat} (strategyA : fin m → fin n → nat) (strategyB : fin n → fin m → nat)
: ((consistent strategyA strategyB) ∧ odd_strategy strategyB) → each_col_sum_odd (board strategyA strategyB)
:=
begin
intro h,
cases h with h1 h2,
have h3 := board_equiv_strategy strategyA strategyB h1,
cases h3 with h4 h5,
rw each_col_sum_odd,
rw ← h5,
rw odd_strategy at h2,
exact h2,
end

--switch to mathlib matrix implementation
--Posted on Zulip about this-------------------
--Does this actually sum rows???????? We don't need a column one because we have our sampling function sampleB which is like a transpose
def matrix_sum {m n : ℕ} (M : fin m → fin n → ℕ ) : ℕ :=
finset.univ.sum $ λ i, finset.univ.sum $ M i

def row_sum {m n : nat} (board : fin m → fin n → nat) : nat := matrix_sum (sampleA board)

def col_sum {m n : nat} (board : fin m → fin n → nat) : nat := matrix_sum (sampleB board)

--how does this use sorry?????
theorem sum_univ_fin_eq_sum_range (n : ℕ) (f : fin n → ℝ) :
  finset.sum finset.univ f = (finset.range n).sum (λ i, if hi : i < n then f ⟨i, hi⟩ else 0) :=
begin
  set F : ℕ → ℝ := λ i, if hi : i < n then f ⟨i, hi⟩ else 0 with hF,
  have H : f = λ (i : fin n), F (i.val),
  { ext i,
    rw hF,
    show f i = dite (i.val < n) (λ (hi : i.val < n), f ⟨i.val, hi⟩) (λ (hi : ¬i.val < n), 0),
    rw dif_pos i.is_lt,
    cases i, refl,
  },
  rw H,
  rw ←finset.sum_image,
  { congr',
    -- ⊢ finset.image (λ (x : fin n), x.val) finset.univ = finset.range n
    ext j, -- sigh
    rw [finset.mem_range, finset.mem_image],
    split,
      rintro ⟨⟨j,hj⟩, _, rfl⟩,
      exact hj,
    intro hj,
    use ⟨j, hj⟩,
    split, apply finset.mem_univ, refl
  },
  intros _ _ _ _,
  exact fin.eq_of_veq,
end

lemma row_sum_eq_col_sum {m n : nat} (board : fin m → fin n → nat) : row_sum board = col_sum board
:=
begin
rw row_sum,
rw col_sum,
rw matrix_sum,
rw matrix_sum,
rw sampleB,
rw sampleA,
have h := sum_univ_fin_eq_sum_range,
sorry,
-- finset.sum_comm,
end

theorem noStrategyMN2 {m n : nat} (strategyA : fin m → fin n → nat) (strategyB: fin n → fin m → nat) :
¬ ((consistent strategyA strategyB) ∧  (even_strategy strategyA) ∧ (odd_strategy strategyB))
:=
begin
intro h,
cases h with c y,
cases y with even odd,
have cEven := even,
have x := even_strategy_implies_even_rows strategyA strategyB (c ∧ even),  --why is this not ok???????
have y := odd_strategy_implies_odd_cols strategyA strategyB (c ∧ even),
end

------------------------tests-----------------
theorem myTheorem : ¬ (∀ x : nat, x = 2) :=
begin
intro h,
specialize h 0,
end

------Ideas----
--use mathlib matrix representation