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

! This file was ported from Lean 3 source module linear_algebra.matrix.polynomial
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Polynomial.BigOperators
import Mathbin.Data.Polynomial.Degree.Lemmas
import Mathbin.LinearAlgebra.Matrix.Determinant

/-!
# Matrices of polynomials and polynomials of matrices

In this file, we prove results about matrices over a polynomial ring.
In particular, we give results about the polynomial given by
`det (t * I + A)`.

## References

  * "The trace Cayley-Hamilton theorem" by Darij Grinberg, Section 5.3

## Tags

matrix determinant, polynomial
-/

open Matrix BigOperators Polynomial

variable {n α : Type _} [DecidableEq n] [Fintype n] [CommRing α]

open Polynomial Matrix Equiv.Perm

namespace Polynomial

theorem natDegree_det_x_add_c_le (A B : Matrix n n α) :
    natDegree (det ((X : α[X]) • A.map C + B.map C)) ≤ Fintype.card n :=
  by
  rw [det_apply]
  refine' (nat_degree_sum_le _ _).trans _
  refine' Multiset.max_nat_le_of_forall_le _ _ _
  simp only [forall_apply_eq_imp_iff', true_and_iff, Function.comp_apply, Multiset.map_map,
    Multiset.mem_map, exists_imp, Finset.mem_univ_val]
  intro g
  calc
    nat_degree (SignType.sign g • ∏ i : n, (X • A.map C + B.map C) (g i) i) ≤
        nat_degree (∏ i : n, (X • A.map C + B.map C) (g i) i) :=
      by
      cases' Int.units_eq_one_or (SignType.sign g) with sg sg
      · rw [sg, one_smul]
      · rw [sg, Units.neg_smul, one_smul, nat_degree_neg]
    _ ≤ ∑ i : n, nat_degree (((X : α[X]) • A.map C + B.map C) (g i) i) :=
      (nat_degree_prod_le (Finset.univ : Finset n) fun i : n => (X • A.map C + B.map C) (g i) i)
    _ ≤ finset.univ.card • 1 := (Finset.sum_le_card_nsmul _ _ 1 fun (i : n) _ => _)
    _ ≤ Fintype.card n := by simpa

  calc
    nat_degree (((X : α[X]) • A.map C + B.map C) (g i) i) =
        nat_degree ((X : α[X]) * C (A (g i) i) + C (B (g i) i)) :=
      by simp
    _ ≤ max (nat_degree ((X : α[X]) * C (A (g i) i))) (nat_degree (C (B (g i) i))) :=
      (nat_degree_add_le _ _)
    _ = nat_degree ((X : α[X]) * C (A (g i) i)) :=
      (max_eq_left ((nat_degree_C _).le.trans (zero_le _)))
    _ ≤ nat_degree (X : α[X]) := (nat_degree_mul_C_le _ _)
    _ ≤ 1 := nat_degree_X_le

#align polynomial.nat_degree_det_X_add_C_le Polynomial.natDegree_det_x_add_c_le

theorem coeff_det_x_add_c_zero (A B : Matrix n n α) :
    coeff (det ((X : α[X]) • A.map C + B.map C)) 0 = det B :=
  by
  rw [det_apply, finset_sum_coeff, det_apply]
  refine' Finset.sum_congr rfl _
  intro g hg
  convert coeff_smul (SignType.sign g) _ 0
  rw [coeff_zero_prod]
  refine' Finset.prod_congr rfl _
  simp
#align polynomial.coeff_det_X_add_C_zero Polynomial.coeff_det_x_add_c_zero

theorem coeff_det_x_add_c_card (A B : Matrix n n α) :
    coeff (det ((X : α[X]) • A.map C + B.map C)) (Fintype.card n) = det A :=
  by
  rw [det_apply, det_apply, finset_sum_coeff]
  refine' Finset.sum_congr rfl _
  simp only [Algebra.id.smul_eq_mul, Finset.mem_univ, RingHom.mapMatrix_apply, forall_true_left,
    map_apply, Pi.smul_apply]
  intro g
  convert coeff_smul (SignType.sign g) _ _
  rw [← mul_one (Fintype.card n)]
  convert(coeff_prod_of_nat_degree_le _ _ _ _).symm
  · ext
    simp [coeff_C]
  · intro p hp
    refine' (nat_degree_add_le _ _).trans _
    simpa only [Pi.smul_apply, map_apply, Algebra.id.smul_eq_mul, X_mul_C, nat_degree_C,
      max_eq_left, zero_le'] using (nat_degree_C_mul_le _ _).trans nat_degree_X_le
#align polynomial.coeff_det_X_add_C_card Polynomial.coeff_det_x_add_c_card

theorem leadingCoeff_det_x_one_add_c (A : Matrix n n α) :
    leadingCoeff (det ((X : α[X]) • (1 : Matrix n n α[X]) + A.map C)) = 1 :=
  by
  cases subsingleton_or_nontrivial α
  · simp
  rw [← @det_one n, ← coeff_det_X_add_C_card _ A, leading_coeff]
  simp only [Matrix.map_one, C_eq_zero, RingHom.map_one]
  cases' (nat_degree_det_X_add_C_le 1 A).eq_or_lt with h h
  · simp only [RingHom.map_one, Matrix.map_one, C_eq_zero] at h
    rw [h]
  · -- contradiction. we have a hypothesis that the degree is less than |n|
    -- but we know that coeff _ n = 1
    have H := coeff_eq_zero_of_nat_degree_lt h
    rw [coeff_det_X_add_C_card] at H
    simpa using H
#align polynomial.leading_coeff_det_X_one_add_C Polynomial.leadingCoeff_det_x_one_add_c

end Polynomial


import mynat.le

lemma one_add_le_self (x : mynat) : x ≤ 1 + x :=
begin
rw le_iff_exists_add,
use 1,
exact add_comm 1 x,
end


import algebra.category.Module.basic
import logic.unique
import data.set.basic

variables {R : Type} [ring R] (M : Module R)

def is_trivial (R : Type) [ring R] (M : Module R) := nonempty (M ≅ 0)

@[simp]
lemma eq_zero_of_zero_module (a : (0 : Module R)) : a = 0
  := punit.unique.uniq a

lemma eq_zero_of_elts_of_trivial_module (f : M ≅ 0) (a : M) : a = 0 :=
  calc a = ((𝟙 M) : M → M) a : by simp
     ... = (f.hom ≫ f.inv) a : by rw f.hom_inv_id
     ... = f.inv (f.hom a) : rfl
     ... = f.inv 0 : by rw (eq_zero_of_zero_module (f.hom a))
     ... = 0 : by simp

lemma bot_isom_trivial (M : Module R) : ((⊥ : submodule R M) : Module R) ≅ 0 := {
  hom := 0,
  inv := 0,
  hom_inv_id' :=
  begin
    apply Module.hom_ext',
    rw Module.module_hom_comp,
    apply function.funext_iff.2,
    intros,
    simp[*],
    exact eq.symm (submodule.eq_zero_of_bot_submodule a)
   end,
  inv_hom_id' :=
  begin
    apply Module.hom_ext',
    rw Module.module_hom_comp,
    simp,
    apply function.funext_iff.2,
    intros,
    simp[*],
    exact eq.symm (eq_zero_of_zero_module a)
   end,
}

lemma bot_is_trivial (M : Module R) : is_trivial R (⊥ : submodule R M) := ⟨ bot_isom_trivial M ⟩

lemma isom_trivial_is_bot (M : Module R) (N : submodule R M) : is_trivial R N → N = ⊥ :=
begin
  intros,
  apply nonempty.elim a,
  intro f,
  have h : ∀ x: N, x = 0 := eq_zero_of_elts_of_trivial_module _ f,
  apply submodule.ext,
  intro,
  split,
    swap,
    intro,
    have i : x = 0 := set.eq_of_mem_singleton a_1,
    finish,
  intro,
  have q := h ⟨ x, a_1 ⟩ ,
  apply set.mem_singleton_of_eq,
  exact subtype.ext.elim_left q
end


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson, Markus Himmel
-/
import data.nat.bitwise
import set_theory.game.impartial
import set_theory.ordinal_arithmetic

/-!
# Nim and the Sprague-Grundy theorem

This file contains the definition for nim for any ordinal `O`. In the game of `nim O₁` both players
may move to `nim O₂` for any `O₂ < O₁`.
We also define a Grundy value for an impartial game `G` and prove the Sprague-Grundy theorem, that
`G` is equivalent to `nim (grundy_value G)`.
Finally, we compute the sum of finite Grundy numbers: if `G` and `H` have Grundy values `n` and `m`,
where `n` and `m` are natural numbers, then `G + H` has the Grundy value `n xor m`.

## Implementation details

The pen-and-paper definition of nim defines the possible moves of `nim O` to be `{O' | O' < O}`.
However, this definition does not work for us because it would make the type of nim
`ordinal.{u} → pgame.{u + 1}`, which would make it impossible for us to state the Sprague-Grundy
theorem, since that requires the type of `nim` to be `ordinal.{u} → pgame.{u}`. For this reason, we
instead use `O.out.α` for the possible moves, which makes proofs significantly more messy and
tedious, but avoids the universe bump.

The lemma `nim_def` is somewhat prone to produce "motive is not type correct" errors. If you run
into this problem, you may find the lemmas `exists_ordinal_move_left_eq` and `exists_move_left_eq`
useful.

-/
universes u

/-- `ordinal.out'` has the sole purpose of making `nim` computable. It performs the same job as
  `quotient.out` but is specific to ordinals. -/
def ordinal.out' (o : ordinal) : Well_order :=
⟨o.out.α, (<), o.out.wo⟩

/-- The definition of single-heap nim, which can be viewed as a pile of stones where each player can
  take a positive number of stones from it on their turn. -/
def nim : ordinal → pgame
| O₁ := let f := λ O₂, have hwf : ordinal.typein O₁.out'.r O₂ < O₁ := ordinal.typein_lt_self O₂,
          nim (ordinal.typein O₁.out'.r O₂) in ⟨O₁.out'.α, O₁.out'.α, f, f⟩
using_well_founded { dec_tac := tactic.assumption }

namespace pgame

local infix ` ≈ ` := equiv

namespace nim

open ordinal

lemma nim_def (O : ordinal) : nim O = pgame.mk O.out.α O.out.α
  (λ O₂, nim (ordinal.typein (<) O₂))
  (λ O₂, nim (ordinal.typein (<) O₂)) :=
by { rw nim, refl }

instance nim_impartial : ∀ (O : ordinal), impartial (nim O)
| O :=
begin
  rw [impartial_def, nim_def, neg_def],
  split, split;
  rw pgame.le_def,
  all_goals { refine ⟨λ i, let hwf := ordinal.typein_lt_self i in _,
    λ j, let hwf := ordinal.typein_lt_self j in _⟩ },
  { exact or.inl ⟨i, (@impartial.neg_equiv_self _ $ nim_impartial $ typein (<) i).1⟩ },
  { exact or.inr ⟨j, (@impartial.neg_equiv_self _ $ nim_impartial $ typein (<) j).1⟩ },
  { exact or.inl ⟨i, (@impartial.neg_equiv_self _ $ nim_impartial $ typein (<) i).2⟩ },
  { exact or.inr ⟨j, (@impartial.neg_equiv_self _ $ nim_impartial $ typein (<) j).2⟩ },
  { exact nim_impartial (typein (<) i) },
  { exact nim_impartial (typein (<) j) }
end
using_well_founded { dec_tac := tactic.assumption }

lemma exists_ordinal_move_left_eq (O : ordinal) : ∀ i, ∃ O' < O, (nim O).move_left i = nim O' :=
by { rw nim_def, exact λ i, ⟨_, ⟨ordinal.typein_lt_self i, rfl⟩⟩ }

lemma exists_move_left_eq {O : ordinal} : ∀ O' < O, ∃ i, (nim O).move_left i = nim O' :=
by { rw nim_def, exact λ _ h, ⟨(ordinal.principal_seg_out h).top, by simp⟩ }

lemma zero_first_loses : (nim (0 : ordinal)).first_loses :=
begin
  rw [impartial.first_loses_symm, nim_def, le_def_lt],
  exact ⟨@is_empty_elim (0 : ordinal).out.α _ _, @is_empty_elim pempty _ _⟩
end

lemma non_zero_first_wins {O : ordinal} (hO : O ≠ 0) : (nim O).first_wins :=
begin
  rw [impartial.first_wins_symm, nim_def, lt_def_le],
  rw ←ordinal.pos_iff_ne_zero at hO,
  exact or.inr ⟨(ordinal.principal_seg_out hO).top, by simpa using zero_first_loses.1⟩
end

lemma sum_first_loses_iff_eq (O₁ O₂ : ordinal) : (nim O₁ + nim O₂).first_loses ↔ O₁ = O₂ :=
begin
  split,
  { contrapose,
    intro h,
    rw [impartial.not_first_loses],
    wlog h' : O₁ ≤ O₂ using [O₁ O₂, O₂ O₁],
    { exact ordinal.le_total O₁ O₂ },
    { have h : O₁ < O₂ := lt_of_le_of_ne h' h,
      rw [impartial.first_wins_symm', lt_def_le, nim_def O₂],
      refine or.inl ⟨(left_moves_add (nim O₁) _).symm (sum.inr _), _⟩,
      { exact (ordinal.principal_seg_out h).top },
      { simpa using (impartial.add_self (nim O₁)).2 } },
    { exact first_wins_of_equiv add_comm_equiv (this (ne.symm h)) } },
  { rintro rfl,
    exact impartial.add_self (nim O₁) }
end

lemma sum_first_wins_iff_neq (O₁ O₂ : ordinal) : (nim O₁ + nim O₂).first_wins ↔ O₁ ≠ O₂ :=
by rw [iff_not_comm, impartial.not_first_wins, sum_first_loses_iff_eq]

lemma equiv_iff_eq (O₁ O₂ : ordinal) : nim O₁ ≈ nim O₂ ↔ O₁ = O₂ :=
⟨λ h, (sum_first_loses_iff_eq _ _).1 $
  by rw [first_loses_of_equiv_iff (add_congr h (equiv_refl _)), sum_first_loses_iff_eq],
 by { rintro rfl, refl }⟩

end nim

/-- The Grundy value of an impartial game, the ordinal which corresponds to the game of nim that the
 game is equivalent to -/
noncomputable def grundy_value : Π (G : pgame.{u}) [G.impartial], ordinal.{u}
| G := λ hG, by exactI ordinal.mex.{u u} (λ i, grundy_value (G.move_left i))
using_well_founded { dec_tac := pgame_wf_tac }

lemma grundy_value_def (G : pgame) [G.impartial] :
  grundy_value G = ordinal.mex.{u u} (λ i, grundy_value (G.move_left i)) :=
by rw grundy_value

/-- The Sprague-Grundy theorem which states that every impartial game is equivalent to a game of
 nim, namely the game of nim corresponding to the games Grundy value -/
theorem equiv_nim_grundy_value : ∀ (G : pgame.{u}) [G.impartial], by exactI G ≈ nim (grundy_value G)
| G :=
begin
  introI hG,
  rw [impartial.equiv_iff_sum_first_loses, ←impartial.no_good_left_moves_iff_first_loses],
  intro i,
  equiv_rw left_moves_add G (nim (grundy_value G)) at i,
  cases i with i₁ i₂,
  { rw add_move_left_inl,
    apply first_wins_of_equiv
     (add_congr (equiv_nim_grundy_value (G.move_left i₁)).symm (equiv_refl _)),
    rw nim.sum_first_wins_iff_neq,
    intro heq,
    rw [eq_comm, grundy_value_def G] at heq,
    have h := ordinal.ne_mex _,
    rw heq at h,
    exact (h i₁).irrefl },
  { rw [add_move_left_inr, ←impartial.good_left_move_iff_first_wins],
    revert i₂,
    rw nim.nim_def,
    intro i₂,

    have h' : ∃ i : G.left_moves, (grundy_value (G.move_left i)) =
      ordinal.typein (quotient.out (grundy_value G)).r i₂,
    { revert i₂,
      rw grundy_value_def,
      intros i₂,
      have hnotin : _ ∉ _ := λ hin, (le_not_le_of_lt (ordinal.typein_lt_self i₂)).2 (cInf_le' hin),
      simpa using hnotin},

    cases h' with i hi,
    use (left_moves_add _ _).symm (sum.inl i),
    rw [add_move_left_inl, move_left_mk],
    apply first_loses_of_equiv
      (add_congr (equiv_symm (equiv_nim_grundy_value (G.move_left i))) (equiv_refl _)),
    simpa only [hi] using impartial.add_self (nim (grundy_value (G.move_left i))) }
end
using_well_founded { dec_tac := pgame_wf_tac }

lemma equiv_nim_iff_grundy_value_eq (G : pgame) [G.impartial] (O : ordinal) :
  G ≈ nim O ↔ grundy_value G = O :=
⟨by { intro h, rw ←nim.equiv_iff_eq, exact equiv_trans (equiv_symm (equiv_nim_grundy_value G)) h },
 by { rintro rfl, exact equiv_nim_grundy_value G }⟩

lemma nim.grundy_value (O : ordinal.{u}) : grundy_value (nim O) = O :=
by rw ←equiv_nim_iff_grundy_value_eq

lemma equiv_iff_grundy_value_eq (G H : pgame) [G.impartial] [H.impartial] :
  G ≈ H ↔ grundy_value G = grundy_value H :=
(equiv_congr_left.1 (equiv_nim_grundy_value H) _).trans $ equiv_nim_iff_grundy_value_eq _ _

lemma grundy_value_zero : grundy_value 0 = 0 :=
by rw [(equiv_iff_grundy_value_eq 0 (nim 0)).1 (equiv_symm nim.zero_first_loses), nim.grundy_value]

lemma equiv_zero_iff_grundy_value (G : pgame) [G.impartial] : G ≈ 0 ↔ grundy_value G = 0 :=
by rw [equiv_iff_grundy_value_eq, grundy_value_zero]

lemma grundy_value_nim_add_nim (n m : ℕ) : grundy_value (nim.{u} n + nim.{u} m) = nat.lxor n m :=
begin
  induction n using nat.strong_induction_on with n hn generalizing m,
  induction m using nat.strong_induction_on with m hm,
  rw [grundy_value_def],

  -- We want to show that `n xor m` is the smallest unreachable Grundy value. We will do this in two
  -- steps:
  -- h₀: `n xor m` is not a reachable grundy number.
  -- h₁: every Grundy number strictly smaller than `n xor m` is reachable.

  have h₀ : ∀ i, grundy_value ((nim n + nim m).move_left i) ≠ (nat.lxor n m : ordinal),
  { -- To show that `n xor m` is unreachable, we show that every move produces a Grundy number
    -- different from `n xor m`.
    equiv_rw left_moves_add _ _,

    -- The move operates either on the left pile or on the right pile.
    rintro (a|a),

    all_goals
    { -- One of the piles is reduced to `k` stones, with `k < n` or `k < m`.
      obtain ⟨ok, ⟨hk, hk'⟩⟩ := nim.exists_ordinal_move_left_eq _ a,
      obtain ⟨k, rfl⟩ := ordinal.lt_omega.1 (lt_trans hk (ordinal.nat_lt_omega _)),
      replace hk := ordinal.nat_cast_lt.1 hk,

      -- Thus, the problem is reduced to computing the Grundy value of `nim n + nim k` or
      -- `nim k + nim m`, both of which can be dealt with using an inductive hypothesis.
      simp only [hk', add_move_left_inl, add_move_left_inr, id],
      rw hn _ hk <|> rw hm _ hk,

      -- But of course xor is injective, so if we change one of the arguments, we will not get the
      -- same value again.
      intro h,
      rw ordinal.nat_cast_inj at h,
      try { rw [nat.lxor_comm n k, nat.lxor_comm n m] at h },
      exact hk.ne (nat.lxor_left_inj h) } },

  have h₁ : ∀ (u : ordinal), u < nat.lxor n m →
    u ∈ set.range (λ i, grundy_value ((nim n + nim m).move_left i)),
  { -- Take any natural number `u` less than `n xor m`.
    intros ou hu,
    obtain ⟨u, rfl⟩ := ordinal.lt_omega.1 (lt_trans hu (ordinal.nat_lt_omega _)),
    replace hu := ordinal.nat_cast_lt.1 hu,

    -- Our goal is to produce a move that gives the Grundy value `u`.
    rw set.mem_range,

    -- By a lemma about xor, either `u xor m < n` or `u xor n < m`.
    have : nat.lxor u (nat.lxor n m) ≠ 0,
    { intro h, rw nat.lxor_eq_zero at h, linarith },
    rcases nat.lxor_trichotomy this with h|h|h,
    { linarith },

    -- Therefore, we can play the corresponding move, and by the inductive hypothesis the new state
    -- is `(u xor m) xor m = u` or `n xor (u xor n) = u` as required.
    { obtain ⟨i, hi⟩ := nim.exists_move_left_eq _ (ordinal.nat_cast_lt.2 h),
      refine ⟨(left_moves_add _ _).symm (sum.inl i), _⟩,
      simp only [hi, add_move_left_inl],
      rw [hn _ h, nat.lxor_assoc, nat.lxor_self, nat.lxor_zero] },
    { obtain ⟨i, hi⟩ := nim.exists_move_left_eq _ (ordinal.nat_cast_lt.2 h),
      refine ⟨(left_moves_add _ _).symm (sum.inr i), _⟩,
      simp only [hi, add_move_left_inr],
      rw [hm _ h, nat.lxor_comm, nat.lxor_assoc, nat.lxor_self, nat.lxor_zero] } },

  -- We are done!
  apply (ordinal.mex_le_of_ne.{u u} h₀).antisymm,
  contrapose! h₁,
  exact ⟨_, ⟨h₁, ordinal.mex_not_mem_range _⟩⟩,
end

lemma nim_add_nim_equiv {n m : ℕ} : nim n + nim m ≈ nim (nat.lxor n m) :=
by rw [equiv_nim_iff_grundy_value_eq, grundy_value_nim_add_nim]

lemma grundy_value_add (G H : pgame) [G.impartial] [H.impartial] {n m : ℕ} (hG : grundy_value G = n)
  (hH : grundy_value H = m) : grundy_value (G + H) = nat.lxor n m :=
begin
  rw [←nim.grundy_value (nat.lxor n m), ←equiv_iff_grundy_value_eq],
  refine equiv_trans _ nim_add_nim_equiv,
  convert add_congr (equiv_nim_grundy_value G) (equiv_nim_grundy_value H);
  simp only [hG, hH]
end

end pgame


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Theory of complete Boolean algebras.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.complete_lattice
import Mathlib.PostPort

universes u_1 l u w

namespace Mathlib

/-- A complete distributive lattice is a bit stronger than the name might
  suggest; perhaps completely distributive lattice is more descriptive,
  as this class includes a requirement that the lattice join
  distribute over *arbitrary* infima, and similarly for the dual. -/
class complete_distrib_lattice (α : Type u_1)
extends complete_lattice α
where
  infi_sup_le_sup_Inf : ∀ (a : α) (s : set α), (infi fun (b : α) => infi fun (H : b ∈ s) => a ⊔ b) ≤ a ⊔ Inf s
  inf_Sup_le_supr_inf : ∀ (a : α) (s : set α), a ⊓ Sup s ≤ supr fun (b : α) => supr fun (H : b ∈ s) => a ⊓ b

theorem sup_Inf_eq {α : Type u} [complete_distrib_lattice α] {a : α} {s : set α} : a ⊔ Inf s = infi fun (b : α) => infi fun (H : b ∈ s) => a ⊔ b :=
  le_antisymm (le_infi fun (i : α) => le_infi fun (h : i ∈ s) => sup_le_sup_left (Inf_le h) a)
    (complete_distrib_lattice.infi_sup_le_sup_Inf a s)

theorem Inf_sup_eq {α : Type u} [complete_distrib_lattice α] {b : α} {s : set α} : Inf s ⊔ b = infi fun (a : α) => infi fun (H : a ∈ s) => a ⊔ b := sorry

theorem inf_Sup_eq {α : Type u} [complete_distrib_lattice α] {a : α} {s : set α} : a ⊓ Sup s = supr fun (b : α) => supr fun (H : b ∈ s) => a ⊓ b :=
  le_antisymm (complete_distrib_lattice.inf_Sup_le_supr_inf a s)
    (supr_le fun (i : α) => supr_le fun (h : i ∈ s) => inf_le_inf_left a (le_Sup h))

theorem Sup_inf_eq {α : Type u} [complete_distrib_lattice α] {b : α} {s : set α} : Sup s ⊓ b = supr fun (a : α) => supr fun (H : a ∈ s) => a ⊓ b := sorry

theorem Inf_sup_Inf {α : Type u} [complete_distrib_lattice α] {s : set α} {t : set α} : Inf s ⊔ Inf t = infi fun (p : α × α) => infi fun (H : p ∈ set.prod s t) => prod.fst p ⊔ prod.snd p := sorry

theorem Sup_inf_Sup {α : Type u} [complete_distrib_lattice α] {s : set α} {t : set α} : Sup s ⊓ Sup t = supr fun (p : α × α) => supr fun (H : p ∈ set.prod s t) => prod.fst p ⊓ prod.snd p := sorry

protected instance complete_distrib_lattice.bounded_distrib_lattice {α : Type u} [d : complete_distrib_lattice α] : bounded_distrib_lattice α :=
  bounded_distrib_lattice.mk complete_distrib_lattice.sup complete_distrib_lattice.le complete_distrib_lattice.lt
    complete_distrib_lattice.le_refl complete_distrib_lattice.le_trans complete_distrib_lattice.le_antisymm
    complete_distrib_lattice.le_sup_left complete_distrib_lattice.le_sup_right complete_distrib_lattice.sup_le
    complete_distrib_lattice.inf complete_distrib_lattice.inf_le_left complete_distrib_lattice.inf_le_right
    complete_distrib_lattice.le_inf sorry complete_distrib_lattice.top complete_distrib_lattice.le_top
    complete_distrib_lattice.bot complete_distrib_lattice.bot_le

/-- A complete boolean algebra is a completely distributive boolean algebra. -/
class complete_boolean_algebra (α : Type u_1)
extends boolean_algebra α, complete_distrib_lattice α
where

theorem compl_infi {α : Type u} {ι : Sort w} [complete_boolean_algebra α] {f : ι → α} : infi fᶜ = supr fun (i : ι) => f iᶜ :=
  le_antisymm (compl_le_of_compl_le (le_infi fun (i : ι) => compl_le_of_compl_le (le_supr (compl ∘ f) i)))
    (supr_le fun (i : ι) => compl_le_compl (infi_le f i))

theorem compl_supr {α : Type u} {ι : Sort w} [complete_boolean_algebra α] {f : ι → α} : supr fᶜ = infi fun (i : ι) => f iᶜ := sorry

theorem compl_Inf {α : Type u} [complete_boolean_algebra α] {s : set α} : Inf sᶜ = supr fun (i : α) => supr fun (H : i ∈ s) => iᶜ := sorry

theorem compl_Sup {α : Type u} [complete_boolean_algebra α] {s : set α} : Sup sᶜ = infi fun (i : α) => infi fun (H : i ∈ s) => iᶜ := sorry


import .basic

namespace hidden
namespace oldint

open mynat
open oldint

def add: oldint → oldint → oldint
| (of_nat m) (of_nat n) := of_nat (m + n)
| -[1+ m]    (of_nat n) := sub_nat_nat n (succ m)
| (of_nat m) -[1+ n]    := sub_nat_nat m (succ n)
| -[1+ m]    -[1+ n]    := -[1+ succ (m + n)]

instance: has_add oldint := ⟨add⟩

-- maybe this is done automatically anyway, idk
def sub (m n: oldint): oldint := m + (-n)
instance: has_sub oldint := ⟨sub⟩

variables {m n k : oldint}
variables {a b c : mynat}

@[simp]
theorem coe_succ: (↑(succ a): oldint) = ↑a + 1 := rfl

@[simp] theorem nat_nat_add: (↑a: oldint) + ↑b = ↑(a + b) := rfl

@[simp]
theorem neg_nat_add: -[1+ a] + ↑b = sub_nat_nat b (succ a) := rfl

@[simp]
theorem nat_neg_add: ↑a + -[1+ b] = sub_nat_nat a (succ b) := rfl

@[simp]
theorem neg_neg_add: -[1+ a] + -[1+ b] = -[1+ succ (a + b)] := rfl

theorem of_nat_succ_add_one: of_nat (succ a) = of_nat a + 1 := rfl

theorem sub_add_neg: m - n = m + (-n) := rfl

theorem add_comm: ∀ {m n : oldint}, m + n = n + m
| (of_nat a) (of_nat b) :=
by rw [←coe_nat_eq, ←coe_nat_eq, nat_nat_add,
       nat_nat_add, of_nat_cancel, mynat.add_comm]
| (of_nat a) -[1+ b]    :=
by rw [←coe_nat_eq, nat_neg_add, neg_nat_add]
| -[1+ a]    (of_nat b) :=
by rw [←coe_nat_eq, neg_nat_add, nat_neg_add]
| -[1+ a]    -[1+ b]    :=
by rw [neg_neg_add, neg_neg_add, mynat.add_comm]

instance add_is_comm: is_commutative oldint add :=
⟨assume a b, add_comm⟩

@[simp]
theorem zero_add: ∀ m : oldint, 0 + m = m
| (of_nat m) := by rw [←zero_nat, ←coe_nat_eq,
                       nat_nat_add, mynat.zero_add]
| -[1+ n]    := by rw [←zero_nat, nat_neg_add]; refl

@[simp]
theorem add_zero: m + 0 = m :=
begin
  have := @zero_add m,
  rwa add_comm,
end

private theorem negative_one: -(1 : oldint) = -↑(1 : mynat) := rfl

theorem neg_distr_coe_one: -(↑a + (1 : oldint)) = -(↑a) + -1 :=
begin
  rw [←one_nat, nat_nat_add, add_one_succ,
  neg_coe_succ],
  cases a,
    rw [zz, ←neg_one, ←negative_one, zero_nat, neg_zero, zero_add],
  rw [neg_coe_succ, ←negative_one, neg_one, neg_neg_add,
  mynat.add_zero],
end

-- Stupid but useful
private theorem one: 1 = succ 0 := one_eq_succ_zero.symm

theorem succ_of_sub_succ: ∀ {a b : mynat},
sub_nat_nat a (succ b) + 1 = sub_nat_nat a b
| zero zero := rfl
| zero (succ b) :=
by rw [zz, zero_sub_neg, zero_sub_neg, neg_succ, neg_succ,
       ←one_nat, neg_nat_add, one, sub_succ_succ, zero_sub_neg,
       neg_succ]
| (succ a) zero :=
by rw [zz, sub_succ_succ, nat_sub_zero, nat_sub_zero, ←one_nat,
  nat_nat_add, add_one_succ]
| (succ a) (succ b) :=
-- This line is particularly interesting, by using
-- succ_of_sub_succ we using recursion
by rw [sub_succ_succ, sub_succ_succ, succ_of_sub_succ]

theorem sub_nat_succ:
∀ {b : mynat}, sub_nat_nat (succ a) b = sub_nat_nat a b + 1
| zero     := by rw [←succ_of_sub_succ, sub_succ_succ]
| (succ b) := by rw [succ_of_sub_succ, sub_succ_succ]

private lemma add_one_switch: ∀ {m n : oldint},
(m + n) + 1 = (m + 1) + n
| (of_nat a) (of_nat b) :=
begin
  rw ←one_nat,
  repeat {rw [←coe_nat_eq]},
  repeat {rw [nat_nat_add]},
  rw [of_nat_cancel, mynat.add_assoc,
      mynat.add_comm b, mynat.add_assoc],
end
| (of_nat a) -[1+ b] :=
begin
  rw ←one_nat,
  repeat {rw ←coe_nat_eq},
  rw [nat_neg_add, nat_nat_add, nat_neg_add, one_nat,
      ←sub_nat_succ, add_one_succ],
end
| -[1+ a] (of_nat b) :=
begin
  rw ←one_nat,
  repeat {rw ←coe_nat_eq},
  rw [neg_nat_add, neg_nat_add, one_nat, one, sub_succ_succ,
      ←sub_nat_succ, zero_sub_neg, sub_succ_succ],
  cases a,
    rw [zz, nat_sub_zero, neg_of_nat_zero, zero_add],
  rw [neg_succ, neg_nat_add],
end
| -[1+ a] -[1+ b] :=
begin
  rw [←one_nat, neg_nat_add, neg_neg_add, neg_nat_add, one,
  sub_succ_succ, sub_succ_succ, zero_sub_neg, zero_sub_neg, neg_succ],
  cases a,
    rw [zz, neg_of_nat_zero, zero_add, mynat.zero_add],
  rw [succ_add, neg_succ, neg_neg_add],
end

theorem sub_nat_add: ∀ {a},
sub_nat_nat (a + b) c = ↑a + sub_nat_nat b c
| zero     := by
  rw [zz, mynat.zero_add, zero_nat, zero_add]
| (succ a) := by rw [succ_add, sub_nat_succ, sub_nat_add,
add_one_switch, ←one_nat, nat_nat_add, add_one_succ]

private lemma sub_add_neg_one: ∀ {a b : mynat},
sub_nat_nat a b + -1 = sub_nat_nat a (succ b)
| zero zero :=
by rw [zz, nat_sub_zero, zero_sub_neg, zero_nat, zero_add,
  neg_one, neg_succ]
| zero (succ b) :=
by rw [zz, zero_sub_neg, zero_sub_neg, neg_succ, neg_succ,
  neg_one, neg_neg_add, mynat.add_zero]
| (succ a) zero :=
by rw [zz, sub_succ_succ, nat_sub_zero, nat_sub_zero, neg_one,
  nat_neg_add, sub_succ_succ, nat_sub_zero]
| (succ a) (succ b) :=
by rw [sub_succ_succ, sub_succ_succ, sub_add_neg_one]

private lemma add_neg_one_switch: ∀ {m n : oldint},
(m + n) + -1 = (m + -1) + n
| (of_nat a) (of_nat b) :=
by rw [←coe_nat_eq, ←coe_nat_eq, neg_one, nat_nat_add, nat_neg_add,
  nat_neg_add, add_comm, ←sub_nat_add, mynat.add_comm]
| (of_nat a) -[1+ b] :=
begin
  rw [←coe_nat_eq, neg_one, nat_neg_add, nat_neg_add],
  cases a,
    rw [zz, zero_sub_neg, neg_succ, add_comm],
    refl,
  rw [sub_succ_succ, sub_succ_succ, nat_sub_zero, ←neg_one,
  nat_neg_add, sub_add_neg_one],
end
| -[1+ a] (of_nat b) :=
by rw [←coe_nat_eq, neg_one, neg_nat_add, neg_neg_add, ←neg_one,
  neg_nat_add, sub_add_neg_one, mynat.add_zero]
| -[1+ a] -[1+ b] :=
begin
  rw neg_one,
  repeat {rw neg_neg_add},
  rw [mynat.add_zero, mynat.add_zero, succ_add],
end

-- Oh god
private lemma sub_add_neg': ∀ {c : mynat},
sub_nat_nat a b + -↑c = sub_nat_nat a (b + c)
| zero := by rw [zz, zero_nat, neg_zero, add_zero, mynat.add_zero]
| (succ c) :=
by rw [←add_one_succ, ←nat_nat_add, one_nat, neg_distr_coe_one,
  add_comm, ←add_neg_one_switch, @add_comm (-↑c), sub_add_neg',
  sub_add_neg_one, add_one_succ, add_succ]

-- Bad naming is bad :/
private theorem sub_neg_add:
sub_nat_nat a (b + succ c) = -[1+ c] + sub_nat_nat a b
:= by rw [←neg_coe_succ, add_comm, sub_add_neg']

-- She's a beauty
theorem add_assoc : ∀ {m n k : oldint}, m + n + k = m + (n + k)
| (of_nat a) (of_nat b) (of_nat c) :=
by repeat {rw ←coe_nat_eq <|> rw nat_nat_add}; rw mynat.add_assoc
| (of_nat a) (of_nat b) -[1+ c]    :=
by  rw [←coe_nat_eq, ←coe_nat_eq, nat_nat_add, nat_neg_add,
      nat_neg_add, sub_nat_add]
| (of_nat a) -[1+ b]    (of_nat c) :=
by rw [←coe_nat_eq, ←coe_nat_eq, neg_nat_add, nat_neg_add,
      add_comm, ←sub_nat_add, ←sub_nat_add, mynat.add_comm]
| (of_nat a) -[1+ b]    -[1+ c]    :=
by rw [←coe_nat_eq, neg_neg_add, nat_neg_add, nat_neg_add,
  add_comm, ←sub_neg_add, succ_add, add_succ]
| -[1+ a]    (of_nat b) (of_nat c) :=
by rw [←coe_nat_eq, ←coe_nat_eq, neg_nat_add, nat_nat_add,
      neg_nat_add, add_comm, ←sub_nat_add, mynat.add_comm]
| -[1+ a]    (of_nat b) -[1+ c]    :=
by rw [←coe_nat_eq, neg_nat_add, nat_neg_add, ←sub_neg_add,
  add_comm, ←sub_neg_add, succ_add, add_succ, succ_add,
  add_succ, mynat.add_comm]
| -[1+ a]    -[1+ b]    (of_nat c) :=
begin
  rw [←coe_nat_eq, neg_neg_add, neg_nat_add, neg_nat_add,
  ←sub_neg_add, succ_add, add_succ, mynat.add_comm],
end
| -[1+ a]    -[1+ b]    -[1+ c]    :=
by repeat {rw neg_neg_add};
  rw [neg_succ_of_nat_cancel, succ_add, add_succ, mynat.add_assoc]

instance add_is_assoc: is_associative oldint add :=
⟨assume a b c, add_assoc⟩

@[simp]
theorem neg_distr: ∀ {m n : oldint}, -(m + n) = -m + -n
| (of_nat a) (of_nat b) :=
begin
  rw [←coe_nat_eq, ←coe_nat_eq],
  cases a,
    rw [zz, zero_nat, neg_zero, zero_add, zero_add],
  rw [neg_coe_succ],
  cases b,
    rw [zz, zero_nat, neg_zero, add_zero, add_zero, neg_coe_succ],
  rw [neg_coe_succ, neg_neg_add, nat_nat_add, succ_add, neg_coe_succ,
  neg_succ_of_nat_cancel, add_succ],
end
| (of_nat a) -[1+ b] :=
begin
  rw [←coe_nat_eq, nat_neg_add, neg_neg_succ],
  cases a,
    rw [zz, zero_sub_neg, neg_succ, neg_neg_succ, zero_nat,
        neg_zero, zero_add],
  rw [sub_succ_succ, neg_coe_succ, neg_nat_add, sub_succ_succ,
      sub_nat_nat_switch],
end
| -[1+ a] (of_nat b) :=
begin
  rw [←coe_nat_eq, neg_neg_succ, neg_nat_add],
  cases b,
    rw [zz, zero_sub_neg, neg_succ, neg_neg_succ, zero_nat, neg_zero,
        add_zero],
  rw [sub_succ_succ, neg_coe_succ, nat_neg_add, sub_succ_succ,
      sub_nat_nat_switch],
end
| -[1+ a] -[1+ b] :=
by rw [neg_neg_add, neg_neg_succ, neg_neg_succ, neg_neg_succ,
      nat_nat_add, of_nat_cancel, succ_add, add_succ]

-- Existence is pain
private lemma add_cancel_one: ∀ {m n : oldint},
m + 1 = n + 1 → m = n
| (of_nat a) (of_nat b) :=
begin
  rw [←coe_nat_eq, ←coe_nat_eq, ←one_nat, nat_nat_add, nat_nat_add,
      of_nat_cancel, of_nat_cancel],
  assume h,
  apply @add_cancel a b 1,
  rwa [mynat.add_comm, mynat.add_comm 1],
end
| (of_nat a) -[1+ b] :=
begin
  assume h,
  exfalso,
  rw [←coe_nat_eq, ←one_nat, neg_nat_add, one,
      sub_succ_succ, zero_sub_neg, ←one, nat_nat_add] at h,
  cases b,
    rw [zz, neg_of_nat_zero, ←zero_nat, of_nat_cancel,
    mynat.add_comm] at h,
    suffices h1ne0 : 1 ≠ (0:mynat),
      from h1ne0 (add_integral h),
    apply mynat.no_confusion,
  rw [neg_succ] at h,
  from of_nat_ne_neg_succ h,
end
| -[1+ a] (of_nat b) :=
begin
  assume h,
  exfalso,
  rw [←coe_nat_eq, ←one_nat, nat_nat_add, neg_nat_add,
  one, sub_succ_succ, zero_sub_neg, ←one, add_one_succ] at h,
  cases a,
    rw [zz, neg_of_nat_zero, ←zero_nat, of_nat_cancel] at h,
    have : 0 ≠ succ b,
      apply mynat.no_confusion,
    contradiction,
  rw [neg_succ] at h,
  from of_nat_ne_neg_succ h.symm,
end
| -[1+ a] -[1+ b] :=
begin
  rw [←one_nat, neg_nat_add, neg_nat_add, one, sub_succ_succ,
      sub_succ_succ, zero_sub_neg, zero_sub_neg],
  assume h,
  congr,
  rwa [neg_of_nat_cancel] at h,
end

-- Thankfully we can prove this quickly using add_cancel_one
private lemma add_cancel_neg_one: m + -1 = n + -1 → m = n :=
begin
  rw [←neg_cancel, neg_distr, neg_distr, neg_neg],
  assume h,
  have := add_cancel_one h,
  rwa neg_cancel at this,
end

private lemma add_cancel_mp: ∀ k : oldint, m + k = n + k → m = n
| (of_nat a) :=
begin
  assume h,
  induction a with a ha,
    rwa [zz, of_nat_zero, add_zero, add_zero] at h,
  {
    rw [of_nat_succ_add_one, ←add_assoc, ←add_assoc] at h,
    have h₁ := add_cancel_one h,
    from ha h₁,
  },
end
| -[1+ a] :=
begin
  assume h,
  induction a with a ha,
    rw [zz, ←neg_one] at h,
    from add_cancel_neg_one h,
  rw [←neg_coe_succ, ←add_one_succ, ←add_one_succ,
  ←nat_nat_add, one_nat, neg_distr_coe_one, ←nat_nat_add,
  one_nat, neg_distr_coe_one, ←@add_assoc m, ←@add_assoc n] at h,
  have h₁ := add_cancel_neg_one h,
  rw [←neg_distr_coe_one, ←one_nat, nat_nat_add, add_one_succ,
  neg_coe_succ] at h₁,
  from ha h₁,
end

-- It's more useful as an iff
@[simp]
theorem add_cancel (k : oldint): m + k = n + k ↔ m = n :=
⟨add_cancel_mp k, assume h, by congr; assumption⟩

@[simp]
theorem add_cancel_to_zero: n + m = m ↔ n = 0 :=
by rw [←zero_add m, ←add_assoc, add_cancel, add_zero]

private lemma add_one_neg_one: (1:oldint) + -1 = 0 := rfl

@[simp]
theorem self_neg_add: ∀ m : oldint, m + (-m) = 0
| (of_nat a) :=
begin
  induction a with a ha,
    rw [zz, of_nat_zero, zero_add, neg_zero],
  rw ←coe_nat_eq at ha,
  rw [←coe_nat_eq, coe_succ, neg_distr_coe_one, add_assoc,
  ←@add_assoc 1, @add_comm 1, @add_assoc (-↑a) 1, add_one_neg_one,
  add_zero, ha],
end
| -[1+ a] :=
by rw [neg_neg_succ, neg_nat_add, sub_succ_succ, sub_self]

@[simp]
theorem neg_self_add : -m + m = 0 := by
rw add_comm; apply self_neg_add

lemma neg_succ_of_succ_add_one: -[1+ succ a] + 1 = -[1+ a] :=
by rw [←one_nat, neg_nat_add, one, sub_succ_succ, zero_sub_neg,
      ←neg_coe_eq_neg_of_nat, neg_coe_succ]

end oldint
end hidden


import tactic
import topology.basic

/-!
Starting with a theorem
If f: X → Y is a function then the folowing are equivalent:
1) f is surjective;
2) ∃ g : Y → X such that "g is a one-sided inverse of f" i.e. ∀ y ∈ Y, f(g(y)) = y
  i.e. f∘g = id_y

The proof:
1 ⇒ 2:
  Define g thus if y ∈ Y, by surjectivity of f ⇒ ∃ x ∈ X s.t. f(x) = y
  Define g(y) to be this x. ∎

2 ⇒ 1
  If y ∈ Y need x ∈ X such that f(x) = y.
  But x = g(y) works. ∎

Surjectivity of f means {x ∈ X | f(x) = y} ≠ ∅
This proof uses axiom of choice

Try proving this in Lean.
-/

variables (X Y : Type) (f : X → Y)

example (f g: X → Y) (h: f = g) : ∀ x, f x = g x :=
begin
  intro x,
  exact congr_fun h x,
end

example : function.surjective f ↔
  ∃ g : Y → X, f ∘ g = id :=
begin
  split, {
    intro h,
    -- Nonsense
    --have h37 : f = f, refl,
    let g_not_working : Y → X, {
      -- Lean has two universes Type and Prop
      -- examples of types ℝ, ℕ, G (a group)
      -- examples of Prop "2+2=4", "2+2=5", Fer;at last Theorem
      -- examples of terms π, 7, 9 or proofs of 2+2=4
      -- but everything is a term which has type of the "above layer"
      -- Prop is a term of Type, and Type is a term of Type 1, which is a term of Type2, etc.
      -- Note Type is identical to Type0
      -- And Prop = Sort0, Type = Sort1, Type1 = Sort2, etc.
      intro y,
      unfold function.surjective at h,
      specialize h y,
      -- Try to use axiom of choice
      -- how to get a from h,
      -- "cases h with x hx" does not work as we shouldn't be creating data in tactic mode
      -- see below
      -- the fix is to not do this
      sorry,
    },
    -- need an axiom of choice tactic
    choose g hg using h,
    use g,
    -- extentionality tactic for functions
    ext y,
    exact hg y,
  }, {
    intro h,
    cases h with g hg,
    replace hg := congr_fun hg,
    change ∀ y, f (g y) = y at hg,
    intro y,
    use g y,
    apply hg,
    -- Golfed version
    -- rintro ⟨g, hg⟩ y,
    -- exact ⟨g y, (congr_fun hg) y⟩,
  }
end

#check Y → X
#check f

#check Exists
#check @Exists.rec
#check @nat.rec

example (a : ℕ) : ℕ :=
begin
  cases a,
  sorry, sorry,
end
-- bad case because of recursive
example (h : ∃ x : ℕ, x = x) : ℕ :=
begin
  cases h,
  sorry,
end

/-
  In Lean the axiom of choice is your route from Prop to Type
  Proofs are not stored.

  Axiom of choice in Lean is a function (∃ x: X, px) → X
-/

#check nonempty
#check @classical.choice

-- Need to write non computable as we're using axiom of choice
noncomputable def foo : ℕ :=
begin
  have h : nonempty ℕ,
    { exact ⟨2⟩ },
  exact classical.choice h,
end

/-!
# Second hour
-/
class has_star (α : Type) :=
{ starry_element : α }

notation `★` := has_star.starry_element

instance : has_star ℕ :=
{ starry_element := 37 }

#eval 30 + ★

instance : has_star ℤ :=
{ starry_element := 42 }

#eval (30 : ℤ) + ★

class my_group (G: Type) extends has_mul G, has_one G, has_inv G :=
( mul_assoc : ∀ g h k : G, g * (h * k) = (g * h) * k)
-- Has error, because Lean doesn't know what is meant by 1
-- One fix is to add has_one to the extends
( one_mul : ∀ g : G, 1 * g = g)
-- Or use
-- ( one_mul : ∃ e : G, ∀ g : G, e * g = g)
-- But then how do we "get" the identity, so use initial thing
( inv_mul : ∀ g, g * g⁻¹ = (1 : G))

structure my_group_iso (G H : Type)
 [group G] [group H] :=
 (f : G → H)
 (hmul : ∀ a b : G, f(a * b) = f a * f b)
 (hbij : function.bijective f)

example (G H : Type) [group G] [group H] (e : my_group_iso G H): G :=
 -- hard to access the inverse function
begin
  sorry,
end

structure my_homeomorphism (X Y : Type)
  [topological_space X] [topological_space Y] :=
  (f : X → Y)
  --(hf : function.bijective f) -- terrible idea
  -- Just carry the inverse around by adding it to the structure
  (g : Y → X)
  (h_cont : continuous f)
  (h_cont_inv : continuous g)
  (h1 : f ∘ g = id)
  (h2 : g ∘ f = id)

#check equiv
#check equiv ℕ ℕ

example : ℕ ≃ ℕ :=
{
  to_fun := λ x, x,
  inv_fun := λ y, y,
  left_inv := begin intro x, dsimp only, refl, end,
  right_inv := begin intro y, refl, end,
}

example (P: Prop) (h1 : P) (h2 : P) : h1 = h2 :=
begin
  refl,
end

def e1 : ℤ ≃ ℤ :=
{
  to_fun := id,
  inv_fun := id,
  left_inv := λ x, rfl,
  right_inv := λ y, rfl,
}
def e2 : ℤ ≃ ℤ :=
{
  to_fun := λ x, -x,
  inv_fun := λ y, -y,
  left_inv := λ x, begin dsimp only, ring, end,
  right_inv := λ y, begin dsimp, ring, end,
}

example (X Y : Type) (e : X ≃ Y) : Y ≃ X :=
--equiv.symm e
-- or
e.symm

def foobar (X Y : Type) (e : X ≃ Y) : X → Y := e
#print foobar
-- coercion is happening

example (X Y : Type) (e : X ≃ Y) : Y → X := e.symm

example (Z : Type) (e : X ≃ Y) (f : Y ≃ Z): X ≃ Z  := e.trans f

/-!
# Some tricks
-/

-- Get gols for all ands
example (P Q : Prop) : P ∧ Q ∧ P ∧ P :=
begin
  refine ⟨_, _, _, _⟩,
  sorry, sorry, sorry, sorry,
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/

import algebra.big_operators.basic
import data.finset.pi
import data.finset.powerset

/-!
# Results about big operators with values in a (semi)ring

We prove results about big operators that involve some interaction between
multiplicative and additive structures on the values being combined.
-/

universes u v w

open_locale big_operators

variables {α : Type u} {β : Type v} {γ : Type w}

namespace finset
variables {s s₁ s₂ : finset α} {a : α} {b : β}  {f g : α → β}

section semiring
variables [non_unital_non_assoc_semiring β]

lemma sum_mul : (∑ x in s, f x) * b = ∑ x in s, f x * b :=
add_monoid_hom.map_sum (add_monoid_hom.mul_right b) _ s

lemma mul_sum : b * (∑ x in s, f x) = ∑ x in s, b * f x :=
add_monoid_hom.map_sum (add_monoid_hom.mul_left b) _ s

lemma sum_mul_sum {ι₁ : Type*} {ι₂ : Type*} (s₁ : finset ι₁) (s₂ : finset ι₂)
  (f₁ : ι₁ → β) (f₂ : ι₂ → β) :
  (∑ x₁ in s₁, f₁ x₁) * (∑ x₂ in s₂, f₂ x₂) = ∑ p in s₁.product s₂, f₁ p.1 * f₂ p.2 :=
by { rw [sum_product, sum_mul, sum_congr rfl], intros, rw mul_sum }

end semiring

section semiring
variables [non_assoc_semiring β]

lemma sum_mul_boole [decidable_eq α] (s : finset α) (f : α → β) (a : α) :
  (∑ x in s, (f x * ite (a = x) 1 0)) = ite (a ∈ s) (f a) 0 :=
by simp

lemma sum_boole_mul [decidable_eq α] (s : finset α) (f : α → β) (a : α) :
  (∑ x in s, (ite (a = x) 1 0) * f x) = ite (a ∈ s) (f a) 0 :=
by simp

end semiring

lemma sum_div [division_ring β] {s : finset α} {f : α → β} {b : β} :
  (∑ x in s, f x) / b = ∑ x in s, f x / b :=
by simp only [div_eq_mul_inv, sum_mul]

section comm_semiring
variables [comm_semiring β]

/-- The product over a sum can be written as a sum over the product of sets, `finset.pi`.
  `finset.prod_univ_sum` is an alternative statement when the product is over `univ`. -/
lemma prod_sum {δ : α → Type*} [decidable_eq α] [∀a, decidable_eq (δ a)]
  {s : finset α} {t : Πa, finset (δ a)} {f : Πa, δ a → β} :
  (∏ a in s, ∑ b in (t a), f a b) =
    ∑ p in (s.pi t), ∏ x in s.attach, f x.1 (p x.1 x.2) :=
begin
  induction s using finset.induction with a s ha ih,
  { rw [pi_empty, sum_singleton], refl },
  { have h₁ : ∀x ∈ t a, ∀y ∈ t a, ∀h : x ≠ y,
        disjoint (image (pi.cons s a x) (pi s t)) (image (pi.cons s a y) (pi s t)),
    { assume x hx y hy h,
      simp only [disjoint_iff_ne, mem_image],
      rintros _ ⟨p₂, hp, eq₂⟩ _ ⟨p₃, hp₃, eq₃⟩ eq,
      have : pi.cons s a x p₂ a (mem_insert_self _ _) = pi.cons s a y p₃ a (mem_insert_self _ _),
      { rw [eq₂, eq₃, eq] },
      rw [pi.cons_same, pi.cons_same] at this,
      exact h this },
    rw [prod_insert ha, pi_insert ha, ih, sum_mul, sum_bUnion h₁],
    refine sum_congr rfl (λ b _, _),
    have h₂ : ∀p₁∈pi s t, ∀p₂∈pi s t, pi.cons s a b p₁ = pi.cons s a b p₂ → p₁ = p₂, from
      assume p₁ h₁ p₂ h₂ eq, pi_cons_injective ha eq,
    rw [sum_image h₂, mul_sum],
    refine sum_congr rfl (λ g _, _),
    rw [attach_insert, prod_insert, prod_image],
    { simp only [pi.cons_same],
      congr' with ⟨v, hv⟩, congr',
      exact (pi.cons_ne (by rintro rfl; exact ha hv)).symm },
    { exact λ _ _ _ _, subtype.eq ∘ subtype.mk.inj },
    { simp only [mem_image], rintro ⟨⟨_, hm⟩, _, rfl⟩, exact ha hm } }
end

open_locale classical

/-- The product of `f a + g a` over all of `s` is the sum
  over the powerset of `s` of the product of `f` over a subset `t` times
  the product of `g` over the complement of `t`  -/
lemma prod_add (f g : α → β) (s : finset α) :
  ∏ a in s, (f a + g a) = ∑ t in s.powerset, ((∏ a in t, f a) * (∏ a in (s \ t), g a)) :=
calc ∏ a in s, (f a + g a)
    = ∏ a in s, ∑ p in ({true, false} : finset Prop), if p then f a else g a : by simp
... = ∑ p in (s.pi (λ _, {true, false}) : finset (Π a ∈ s, Prop)),
        ∏ a in s.attach, if p a.1 a.2 then f a.1 else g a.1 : prod_sum
... = ∑ t in s.powerset, (∏ a in t, f a) * (∏ a in (s \ t), g a) : begin
  refine eq.symm (sum_bij (λ t _ a _, a ∈ t) _ _ _ _),
  { simp [subset_iff]; tauto },
  { intros t ht,
    erw [prod_ite (λ a : {a // a ∈ s}, f a.1) (λ a : {a // a ∈ s}, g a.1)],
    refine congr_arg2 _
      (prod_bij (λ (a : α) (ha : a ∈ t), ⟨a, mem_powerset.1 ht ha⟩)
         _ _ _
        (λ b hb, ⟨b, by cases b; finish⟩))
      (prod_bij (λ (a : α) (ha : a ∈ s \ t), ⟨a, by simp * at *⟩)
        _ _ _
        (λ b hb, ⟨b, by cases b; finish⟩));
    intros; simp * at *; simp * at * },
  { finish [function.funext_iff, finset.ext_iff, subset_iff] },
  { assume f hf,
    exact ⟨s.filter (λ a : α, ∃ h : a ∈ s, f a h),
      by simp, by funext; intros; simp *⟩ }
end

/-- `∏ i, (f i + g i) = (∏ i, f i) + ∑ i, g i * (∏ j < i, f j + g j) * (∏ j > i, f j)`. -/
lemma prod_add_ordered {ι R : Type*} [comm_semiring R] [linear_order ι] (s : finset ι)
  (f g : ι → R) :
  (∏ i in s, (f i + g i)) = (∏ i in s, f i) +
    ∑ i in s, g i * (∏ j in s.filter (< i), (f j + g j)) * ∏ j in s.filter (λ j, i < j), f j :=
begin
  refine finset.induction_on_max s (by simp) _,
  clear s, intros a s ha ihs,
  have ha' : a ∉ s, from λ ha', (ha a ha').false,
  rw [prod_insert ha', prod_insert ha', sum_insert ha', filter_insert, if_neg (lt_irrefl a),
    filter_true_of_mem ha, ihs, add_mul, mul_add, mul_add, add_assoc],
  congr' 1, rw add_comm, congr' 1,
  { rw [filter_false_of_mem, prod_empty, mul_one],
    exact (forall_mem_insert _ _ _).2 ⟨lt_irrefl a, λ i hi, (ha i hi).not_lt⟩ },
  { rw mul_sum,
    refine sum_congr rfl (λ i hi, _),
    rw [filter_insert, if_neg (ha i hi).not_lt, filter_insert, if_pos (ha i hi), prod_insert,
      mul_left_comm],
    exact mt (λ ha, (mem_filter.1 ha).1) ha' }
end

/-- `∏ i, (f i - g i) = (∏ i, f i) - ∑ i, g i * (∏ j < i, f j - g j) * (∏ j > i, f j)`. -/

/-- `∏ i, (1 - f i) = 1 - ∑ i, f i * (∏ j < i, 1 - f j)`. This formula is useful in construction of
a partition of unity from a collection of “bump” functions.  -/
lemma prod_one_sub_ordered {ι R : Type*} [comm_ring R] [linear_order ι] (s : finset ι) (f : ι → R) :
  (∏ i in s, (1 - f i)) = 1 - ∑ i in s, f i * ∏ j in s.filter (< i), (1 - f j) :=
by { rw prod_sub_ordered, simp }

/--  Summing `a^s.card * b^(n-s.card)` over all finite subsets `s` of a `finset`
gives `(a + b)^s.card`.-/
lemma sum_pow_mul_eq_add_pow
  {α R : Type*} [comm_semiring R] (a b : R) (s : finset α) :
  (∑ t in s.powerset, a ^ t.card * b ^ (s.card - t.card)) = (a + b) ^ s.card :=
begin
  rw [← prod_const, prod_add],
  refine finset.sum_congr rfl (λ t ht, _),
  rw [prod_const, prod_const, ← card_sdiff (mem_powerset.1 ht)]
end

lemma prod_pow_eq_pow_sum {x : β} {f : α → ℕ} :
  ∀ {s : finset α}, (∏ i in s, x ^ (f i)) = x ^ (∑ x in s, f x) :=
begin
  apply finset.induction,
  { simp },
  { assume a s has H,
    rw [finset.prod_insert has, finset.sum_insert has, pow_add, H] }
end

theorem dvd_sum {b : β} {s : finset α} {f : α → β}
  (h : ∀ x ∈ s, b ∣ f x) : b ∣ ∑ x in s, f x :=
multiset.dvd_sum (λ y hy, by rcases multiset.mem_map.1 hy with ⟨x, hx, rfl⟩; exact h x hx)

@[norm_cast]
lemma prod_nat_cast (s : finset α) (f : α → ℕ) :
  ↑(∏ x in s, f x : ℕ) = (∏ x in s, (f x : β)) :=
(nat.cast_ring_hom β).map_prod f s

end comm_semiring

section comm_ring

variables {R : Type*} [comm_ring R]

lemma prod_range_cast_nat_sub (n k : ℕ) :
  ∏ i in range k, (n - i : R) = (∏ i in range k, (n - i) : ℕ) :=
begin
  rw prod_nat_cast,
  cases le_or_lt k n with hkn hnk,
  { exact prod_congr rfl (λ i hi, (nat.cast_sub $ (mem_range.1 hi).le.trans hkn).symm) },
  { rw ← mem_range at hnk,
    rw [prod_eq_zero hnk, prod_eq_zero hnk]; simp }
end

end comm_ring

/-- A product over all subsets of `s ∪ {x}` is obtained by multiplying the product over all subsets
of `s`, and over all subsets of `s` to which one adds `x`. -/
@[to_additive]
lemma prod_powerset_insert [decidable_eq α] [comm_monoid β] {s : finset α} {x : α} (h : x ∉ s)
  (f : finset α → β) :
  (∏ a in (insert x s).powerset, f a) =
    (∏ a in s.powerset, f a) * (∏ t in s.powerset, f (insert x t)) :=
begin
  rw [powerset_insert, finset.prod_union, finset.prod_image],
  { assume t₁ h₁ t₂ h₂ heq,
    rw [← finset.erase_insert (not_mem_of_mem_powerset_of_not_mem h₁ h),
        ← finset.erase_insert (not_mem_of_mem_powerset_of_not_mem h₂ h), heq] },
  { rw finset.disjoint_iff_ne,
    assume t₁ h₁ t₂ h₂,
    rcases finset.mem_image.1 h₂ with ⟨t₃, h₃, H₃₂⟩,
    rw ← H₃₂,
    exact ne_insert_of_not_mem _ _ (not_mem_of_mem_powerset_of_not_mem h₁ h) }
end

/-- A product over `powerset s` is equal to the double product over
sets of subsets of `s` with `card s = k`, for `k = 1, ... , card s`. -/
@[to_additive]
lemma prod_powerset [comm_monoid β] (s : finset α) (f : finset α → β) :
  ∏ t in powerset s, f t = ∏ j in range (card s + 1), ∏ t in powerset_len j s, f t :=
begin
  classical,
  rw [powerset_card_bUnion, prod_bUnion],
  intros i hi j hj hij,
  rw [function.on_fun, powerset_len_eq_filter, powerset_len_eq_filter, disjoint_filter],
  intros x hx hc hnc,
  apply hij,
  rwa ← hc,
end

end finset


import set_theory.surreal
namespace pgame
universe u
open pgame

local infix ` ≈ ` := pgame.equiv

theorem sub_congr {w x y z : pgame} (h₁ : w ≈ x) (h₂ : y ≈ z) : w - y ≈ x - z :=
sorry

theorem mul_congr {w x y z : pgame} (h₁ : w ≈ x) (h₂ : y ≈ z) : w * y ≈ x * z :=
sorry

lemma sub_zero_equiv (x : pgame.{u}) : x - 0 ≈ x := sorry
#check lt_of_equiv_of_lt

-- theorem lt_of_lt_of_equiv {x y z} (h₁ : x < y) (h₂ : y ≈ z) : x < z := lt_of_lt_of_le h₁ h₂.1
-- theorem le_of_le_of_equiv {x y z} (h₁ : x ≤ y) (h₂ : y ≈ z) : x ≤ z := le_trans h₁ h₂.1
-- theorem lt_of_equiv_of_lt {x y z} (h₁ : x ≈ y) (h₂ : y < z) : x < z := lt_of_le_of_lt h₁.1 h₂
-- theorem le_of_equiv_of_le {x y z} (h₁ : x ≈ y) (h₂ : y ≤ z) : x ≤ z := le_trans h₁.1 h₂

#check @zero_le
-- zero_le :
--   ∀ {x : pgame},
--     0 ≤ x ↔
-- ∀ (j : xR), ∃ (i : (xR j).left_moves), 0 ≤ (xR j).move_left i

#check @zero_lt
-- zero_lt :
--   ∀ {x : pgame},
--     0 < x ↔
-- ∃ (i : xL), ∀ (j : (xL i).right_moves), 0 < (xL i).move_right j

#check left_moves_add

def left_moves_add_add (x y z : pgame) : (x + y + z).left_moves ≃ x.left_moves ⊕ y.left_moves ⊕ z.left_moves :=
by { cases x, cases y, cases z, sorry }

def right_moves_add_add (x y z : pgame) : (x + y + z).right_moves ≃ x.right_moves ⊕ y.right_moves ⊕ z.right_moves :=
by { cases x, cases y, cases z, sorry }

theorem zero_le' {x : pgame} : 0 ≤ x ↔
  (∀ j : x.right_moves, 0 < x.move_right j) :=
begin
  rw le_def_lt,
  split,
  rintros ⟨hi,hj⟩ j,
  exact hj j,
  rintros hj,
  split,
  rintros ⟨⟩,
  exact hj,
end

theorem zero_lt' {x : pgame} : 0 < x ↔
  (∃ i : x.left_moves, 0 ≤ x.move_left i) :=
by {rw lt_def_le, dsimp, simp[forall_pempty] }

/-- An explicit description of the moves for Right in `x * y`. -/

lemma mk_mul_move_left_inl' {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inl (i,j))
  = (xL i - mk xl xr xL xR) * (mk yl yr yL yR - yL j) + mk xl xr xL xR * mk yl yr yL yR :=
sorry

lemma mul_move_left_inl' {x y : pgame} {i j} :
   (x * y).move_left ((@left_moves_mul x y).symm (sum.inl (i,j)))
   = (x.move_left i - x) * (y - y.move_left j) + x * y :=
sorry

lemma mk_mul_move_left_inr' {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inr (i,j))
  = (xR i - mk xl xr xL xR) * (mk yl yr yL yR - yR j) + mk xl xr xL xR * mk yl yr yL yR :=
sorry

lemma mul_move_left_inr' {x y : pgame} {i j} :
   (x * y).move_left ((@left_moves_mul x y).symm (sum.inr (i,j)))
   = (x.move_right i - x) * (y - y.move_right j) + x * y :=
sorry

lemma mk_mul_move_right_inl' {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inl (i,j))
  = (xL i - mk xl xr xL xR) * (mk yl yr yL yR - yR j) + mk xl xr xL xR * mk yl yr yL yR :=
sorry

lemma mul_move_right_inl' {x y : pgame} {i j} :
   (x * y).move_right ((@right_moves_mul x y).symm (sum.inr (i, j)))
   = (x.move_right i - x) * (y - y.move_left j) + x * y :=
sorry

@[simp] lemma mk_mul_move_right_inr' {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inr (i,j))
  = (xR i - mk xl xr xL xR) * (mk yl yr yL yR - yL j) + mk xl xr xL xR * mk yl yr yL yR :=
sorry

lemma mul_move_right_inr' {x y : pgame} {i j} :
   (x * y).move_right ((@right_moves_mul x y).symm (sum.inr (i,j)))
   = (x.move_right i - x) * (y - y.move_left j) + x * y :=
sorry

lemma aux {x : pgame} (ox : numeric x) : (0 ≤ x) → (0 ≈ x) ∨ (0 < x) :=
begin
  rintros,
  by_cases 0 ≈ x,
  left, exact h,

  unfold pgame.equiv at *,
  push_neg at h,
  right,
  rw lt_iff_le_not_le numeric_zero ox,
  split, assumption,
  intros ᾰ_1, solve_by_elim,

end

def foo : Π {x y : pgame} (ox : numeric x) (oy : numeric y), ((0 < x) → (0 < y) → 0 < x * y) ∧ (x * y).numeric
| (mk xl xr xL xR) (mk yl yr yL yR) ox oy:=
begin
  let x := mk xl xr xL xR,
  let y := mk yl yr yL yR,
  split,

  intros pos_x pos_y,

  cases  zero_lt'.1 pos_x with i hi,
  dsimp at *,
  cases zero_lt'.1 pos_y with j hj,
  dsimp at *,

  rw zero_lt',

  use sum.inl (i,j),
  dsimp,

  cases aux (ox.2.1 i) hi with h₁ h₂,
  cases aux (oy.2.1 j) hj with h₃ h₄,
  { calc 0 ≤ 0 : by refl
       ... ≈ 0 + 0 : (add_zero_equiv 0).symm
       ... ≈ 0 + 0 - 0 : (sub_zero_equiv _).symm
       ... ≈ 0 * y + x * 0 - 0 * 0 : sub_congr (add_congr (zero_mul_equiv _).symm (mul_zero_equiv _).symm) (mul_zero_equiv _).symm
       ... ≈ xL i * y + x * yL j - xL i * yL j : by {refine sub_congr (add_congr _ _) _; refine mul_congr _ _; simpa <|> refl } },
  { calc 0 ≤ mk xl xr xL xR * yL j : le_of_lt numeric_zero (foo ox (oy.2.1 j)).2 ((foo ox (oy.2.1 j)).1 pos_x h₄)
       ... ≈ 0 + mk xl xr xL xR * yL j : (zero_add_equiv _).symm
       ... ≈ 0 + mk xl xr xL xR * yL j - 0 : (sub_zero_equiv _).symm
       ... ≈ 0 * mk yl yr yL yR + mk xl xr xL xR * yL j - 0 * yL j : sub_congr (add_congr (zero_mul_equiv _).symm (equiv_refl _)) (zero_mul_equiv _).symm
       ... ≈ xL i * mk yl yr yL yR + mk xl xr xL xR * yL j - xL i * yL j : by {refine sub_congr (add_congr _ _) _; refine mul_congr _ _; simpa <|> refl } },

  sorry, -- most complex case
repeat {sorry},
end
using_well_founded { dec_tac := pgame_wf_tac }

#check @add_le_add_right

#check @mk_mul_move_left_inl

end pgame
/-- Definition of `x < y` on pre-games, in terms of `≤` -/
-- theorem lt_def_le {x y : pgame} : x < y ↔
--   (∃ i : y.left_moves, x ≤ y.move_left i) ∨
--   (∃ j : x.right_moves, x.move_right j ≤ y) :=
-- by { cases x, cases y, refl }