/-
Copyright (c) 2019 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Mario Carneiro, Isabel Longbottom, Scott Morrison
-/
import data.fin.basic
import data.nat.cast
import logic.embedding

/-!
# Combinatorial (pre-)games.

The basic theory of combinatorial games, following Conway's book `On Numbers and Games`. We
construct "pregames", define an ordering and arithmetic operations on them, then show that the
operations descend to "games", defined via the equivalence relation `p ≈ q ↔ p ≤ q ∧ q ≤ p`.

The surreal numbers will be built as a quotient of a subtype of pregames.

A pregame (`pgame` below) is axiomatised via an inductive type, whose sole constructor takes two
types (thought of as indexing the possible moves for the players Left and Right), and a pair of
functions out of these types to `pgame` (thought of as describing the resulting game after making a
move).

Combinatorial games themselves, as a quotient of pregames, are constructed in `game.lean`.

## Conway induction

By construction, the induction principle for pregames is exactly "Conway induction". That is, to
prove some predicate `pgame → Prop` holds for all pregames, it suffices to prove that for every
pregame `g`, if the predicate holds for every game resulting from making a move, then it also holds
for `g`.

While it is often convenient to work "by induction" on pregames, in some situations this becomes
awkward, so we also define accessor functions `left_moves`, `right_moves`, `move_left` and
`move_right`. There is a relation `subsequent p q`, saying that `p` can be reached by playing some
non-empty sequence of moves starting from `q`, an instance `well_founded subsequent`, and a local
tactic `pgame_wf_tac` which is helpful for discharging proof obligations in inductive proofs relying
on this relation.

## Order properties

Pregames have both a `≤` and a `<` relation, which are related in quite a subtle way. In particular,
it is worth noting that in Lean's (perhaps unfortunate?) definition of a `preorder`, we have
`lt_iff_le_not_le : ∀ a b : α, a < b ↔ (a ≤ b ∧ ¬ b ≤ a)`, but this is _not_ satisfied by the usual
`≤` and `<` relations on pregames. (It is satisfied once we restrict to the surreal numbers.) In
particular, `<` is not transitive; there is an example below showing `0 < star ∧ star < 0`.

We do have
```
theorem not_le {x y : pgame} : ¬ x ≤ y ↔ y < x := ...
theorem not_lt {x y : pgame} : ¬ x < y ↔ y ≤ x := ...
```

The statement `0 ≤ x` means that Left has a good response to any move by Right; in particular, the
theorem `zero_le` below states
```
0 ≤ x ↔ ∀ j : x.right_moves, ∃ i : (x.move_right j).left_moves, 0 ≤ (x.move_right j).move_left i
```
On the other hand the statement `0 < x` means that Left has a good move right now; in particular the
theorem `zero_lt` below states
```
0 < x ↔ ∃ i : left_moves x, ∀ j : right_moves (x.move_left i), 0 < (x.move_left i).move_right j
```

The theorems `le_def`, `lt_def`, give a recursive characterisation of each relation, in terms of
themselves two moves later. The theorems `le_def_lt` and `lt_def_lt` give recursive
characterisations of each relation in terms of the other relation one move later.

We define an equivalence relation `equiv p q ↔ p ≤ q ∧ q ≤ p`. Later, games will be defined as the
quotient by this relation.

## Algebraic structures

We next turn to defining the operations necessary to make games into a commutative additive group.
Addition is defined for $x = \{xL | xR\}$ and $y = \{yL | yR\}$ by $x + y = \{xL + y, x + yL | xR +
y, x + yR\}$. Negation is defined by $\{xL | xR\} = \{-xR | -xL\}$.

The order structures interact in the expected way with addition, so we have
```
theorem le_iff_sub_nonneg {x y : pgame} : x ≤ y ↔ 0 ≤ y - x := sorry
theorem lt_iff_sub_pos {x y : pgame} : x < y ↔ 0 < y - x := sorry
```

We show that these operations respect the equivalence relation, and hence descend to games. At the
level of games, these operations satisfy all the laws of a commutative group. To prove the necessary
equivalence relations at the level of pregames, we introduce the notion of a `relabelling` of a
game, and show, for example, that there is a relabelling between `x + (y + z)` and `(x + y) + z`.

## Future work
* The theory of dominated and reversible positions, and unique normal form for short games.
* Analysis of basic domineering positions.
* Hex.
* Temperature.
* The development of surreal numbers, based on this development of combinatorial games, is still
  quite incomplete.

## References

The material here is all drawn from
* [Conway, *On numbers and games*][conway2001]

An interested reader may like to formalise some of the material from
* [Andreas Blass, *A game semantics for linear logic*][MR1167694]
* [André Joyal, *Remarques sur la théorie des jeux à deux personnes*][joyal1997]
-/

universes u

/-- The type of pre-games, before we have quotiented
  by extensionality. In ZFC, a combinatorial game is constructed from
  two sets of combinatorial games that have been constructed at an earlier
  stage. To do this in type theory, we say that a pre-game is built
  inductively from two families of pre-games indexed over any type
  in Type u. The resulting type `pgame.{u}` lives in `Type (u+1)`,
  reflecting that it is a proper class in ZFC. -/
inductive pgame : Type (u+1)
| mk : ∀ α β : Type u, (α → pgame) → (β → pgame) → pgame

namespace pgame

/--
Construct a pre-game from list of pre-games describing the available moves for Left and Right.
-/
-- TODO provide some API describing the interaction with
-- `left_moves`, `right_moves`, `move_left` and `move_right` below.
-- TODO define this at the level of games, as well, and perhaps also for finsets of games.
def of_lists (L R : list pgame.{0}) : pgame.{0} :=
pgame.mk (fin L.length) (fin R.length) (λ i, L.nth_le i i.is_lt) (λ j, R.nth_le j.val j.is_lt)

/-- The indexing type for allowable moves by Left. -/
def left_moves : pgame → Type u
| (mk l _ _ _) := l
/-- The indexing type for allowable moves by Right. -/
def right_moves : pgame → Type u
| (mk _ r _ _) := r

/-- The new game after Left makes an allowed move. -/
def move_left : Π (g : pgame), left_moves g → pgame
| (mk l _ L _) i := L i
/-- The new game after Right makes an allowed move. -/
def move_right : Π (g : pgame), right_moves g → pgame
| (mk _ r _ R) j := R j

@[simp] lemma left_moves_mk {xl xr xL xR} : (⟨xl, xr, xL, xR⟩ : pgame).left_moves = xl := rfl
@[simp] lemma move_left_mk {xl xr xL xR i} : (⟨xl, xr, xL, xR⟩ : pgame).move_left i = xL i := rfl
@[simp] lemma right_moves_mk {xl xr xL xR} : (⟨xl, xr, xL, xR⟩ : pgame).right_moves = xr := rfl
@[simp] lemma move_right_mk {xl xr xL xR j} : (⟨xl, xr, xL, xR⟩ : pgame).move_right j = xR j := rfl

/-- `subsequent p q` says that `p` can be obtained by playing
  some nonempty sequence of moves from `q`. -/
inductive subsequent : pgame → pgame → Prop
| left : Π (x : pgame) (i : x.left_moves), subsequent (x.move_left i) x
| right : Π (x : pgame) (j : x.right_moves), subsequent (x.move_right j) x
| trans : Π (x y z : pgame), subsequent x y → subsequent y z → subsequent x z

theorem wf_subsequent : well_founded subsequent :=
⟨λ x, begin
  induction x with l r L R IHl IHr,
  refine ⟨_, λ y h, _⟩,
  generalize_hyp e : mk l r L R = x at h,
  induction h with _ i _ j a b _ h1 h2 IH1 IH2; subst e,
  { apply IHl },
  { apply IHr },
  { exact acc.inv (IH2 rfl) h1 }
end⟩

instance : has_well_founded pgame :=
{ r := subsequent,
  wf := wf_subsequent }

/-- A move by Left produces a subsequent game. (For use in pgame_wf_tac.) -/
lemma subsequent.left_move {xl xr} {xL : xl → pgame} {xR : xr → pgame} {i : xl} :
  subsequent (xL i) (mk xl xr xL xR) :=
subsequent.left (mk xl xr xL xR) i
/-- A move by Right produces a subsequent game. (For use in pgame_wf_tac.) -/
lemma subsequent.right_move {xl xr} {xL : xl → pgame} {xR : xr → pgame} {j : xr} :
  subsequent (xR j) (mk xl xr xL xR) :=
subsequent.right (mk xl xr xL xR) j

/-- A local tactic for proving well-foundedness of recursive definitions involving pregames. -/
meta def pgame_wf_tac :=
`[solve_by_elim
  [psigma.lex.left, psigma.lex.right,
   subsequent.left_move, subsequent.right_move,
   subsequent.left, subsequent.right, subsequent.trans]
  { max_depth := 6 }]

/-- The pre-game `zero` is defined by `0 = { | }`. -/
instance : has_zero pgame := ⟨⟨pempty, pempty, pempty.elim, pempty.elim⟩⟩

@[simp] lemma zero_left_moves : (0 : pgame).left_moves = pempty := rfl
@[simp] lemma zero_right_moves : (0 : pgame).right_moves = pempty := rfl

instance : inhabited pgame := ⟨0⟩

/-- The pre-game `one` is defined by `1 = { 0 | }`. -/
instance : has_one pgame := ⟨⟨punit, pempty, λ _, 0, pempty.elim⟩⟩

@[simp] lemma one_left_moves : (1 : pgame).left_moves = punit := rfl
@[simp] lemma one_move_left : (1 : pgame).move_left punit.star = 0 := rfl
@[simp] lemma one_right_moves : (1 : pgame).right_moves = pempty := rfl

/-- Define simultaneously by mutual induction the `<=` and `<`
  relation on pre-games. The ZFC definition says that `x = {xL | xR}`
  is less or equal to `y = {yL | yR}` if `∀ x₁ ∈ xL, x₁ < y`
  and `∀ y₂ ∈ yR, x < y₂`, where `x < y` is the same as `¬ y <= x`.
  This is a tricky induction because it only decreases one side at
  a time, and it also swaps the arguments in the definition of `<`.
  The solution is to define `x < y` and `x <= y` simultaneously. -/
def le_lt : Π (x y : pgame), Prop × Prop
| (mk xl xr xL xR) (mk yl yr yL yR) :=
  -- the orderings of the clauses here are carefully chosen so that
  --   and.left/or.inl refer to moves by Left, and
  --   and.right/or.inr refer to moves by Right.
((∀ i : xl, (le_lt (xL i) ⟨yl, yr, yL, yR⟩).2) ∧ (∀ j : yr, (le_lt ⟨xl, xr, xL, xR⟩ (yR j)).2),
  (∃ i : yl, (le_lt ⟨xl, xr, xL, xR⟩ (yL i)).1) ∨ (∃ j : xr, (le_lt (xR j) ⟨yl, yr, yL, yR⟩).1))
using_well_founded { dec_tac := pgame_wf_tac }

instance : has_le pgame := ⟨λ x y, (le_lt x y).1⟩
instance : has_lt pgame := ⟨λ x y, (le_lt x y).2⟩

/-- Definition of `x ≤ y` on pre-games built using the constructor. -/
@[simp] theorem mk_le_mk {xl xr xL xR yl yr yL yR} :
  (⟨xl, xr, xL, xR⟩ : pgame) ≤ ⟨yl, yr, yL, yR⟩ ↔
  (∀ i, xL i < ⟨yl, yr, yL, yR⟩) ∧
  (∀ j, (⟨xl, xr, xL, xR⟩ : pgame) < yR j) :=
show (le_lt _ _).1 ↔ _, by { rw le_lt, refl }

/-- Definition of `x ≤ y` on pre-games, in terms of `<` -/
theorem le_def_lt {x y : pgame} : x ≤ y ↔
  (∀ i : x.left_moves, x.move_left i < y) ∧
  (∀ j : y.right_moves, x < y.move_right j) :=
by { cases x, cases y, rw mk_le_mk, refl }

/-- Definition of `x < y` on pre-games built using the constructor. -/
@[simp] theorem mk_lt_mk {xl xr xL xR yl yr yL yR} :
  (⟨xl, xr, xL, xR⟩ : pgame) < ⟨yl, yr, yL, yR⟩ ↔
  (∃ i, (⟨xl, xr, xL, xR⟩ : pgame) ≤ yL i) ∨
  (∃ j, xR j ≤ ⟨yl, yr, yL, yR⟩) :=
show (le_lt _ _).2 ↔ _, by { rw le_lt, refl }

/-- 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, rw mk_lt_mk, refl }

/-- The definition of `x ≤ y` on pre-games, in terms of `≤` two moves later. -/
theorem le_def {x y : pgame} : x ≤ y ↔
  (∀ i : x.left_moves,
   (∃ i' : y.left_moves, x.move_left i ≤ y.move_left i') ∨
   (∃ j : (x.move_left i).right_moves, (x.move_left i).move_right j ≤ y)) ∧
  (∀ j : y.right_moves,
   (∃ i : (y.move_right j).left_moves, x ≤ (y.move_right j).move_left i) ∨
   (∃ j' : x.right_moves, x.move_right j' ≤ y.move_right j)) :=
begin
  rw [le_def_lt],
  conv { to_lhs, simp only [lt_def_le] },
end

/-- The definition of `x < y` on pre-games, in terms of `<` two moves later. -/
theorem lt_def {x y : pgame} : x < y ↔
  (∃ i : y.left_moves,
    (∀ i' : x.left_moves, x.move_left i' < y.move_left i) ∧
    (∀ j : (y.move_left i).right_moves, x < (y.move_left i).move_right j)) ∨
  (∃ j : x.right_moves,
    (∀ i : (x.move_right j).left_moves, (x.move_right j).move_left i < y) ∧
    (∀ j' : y.right_moves, x.move_right j < y.move_right j')) :=
begin
  rw [lt_def_le],
  conv { to_lhs, simp only [le_def_lt] },
end

/-- The definition of `x ≤ 0` on pre-games, in terms of `≤ 0` two moves later. -/
theorem le_zero {x : pgame} : x ≤ 0 ↔
  ∀ i : x.left_moves, ∃ j : (x.move_left i).right_moves, (x.move_left i).move_right j ≤ 0 :=
begin
  rw le_def,
  dsimp,
  simp [forall_pempty, exists_pempty]
end

/-- The definition of `0 ≤ x` on pre-games, in terms of `0 ≤` two moves later. -/
theorem zero_le {x : pgame} : 0 ≤ x ↔
  ∀ j : x.right_moves, ∃ i : (x.move_right j).left_moves, 0 ≤ (x.move_right j).move_left i :=
begin
  rw le_def,
  dsimp,
  simp [forall_pempty, exists_pempty]
end

/-- The definition of `x < 0` on pre-games, in terms of `< 0` two moves later. -/
theorem lt_zero {x : pgame} : x < 0 ↔
  ∃ j : x.right_moves, ∀ i : (x.move_right j).left_moves, (x.move_right j).move_left i < 0 :=
begin
  rw lt_def,
  dsimp,
  simp [forall_pempty, exists_pempty]
end

/-- The definition of `0 < x` on pre-games, in terms of `< x` two moves later. -/
theorem zero_lt {x : pgame} : 0 < x ↔
  ∃ i : x.left_moves, ∀ j : (x.move_left i).right_moves, 0 < (x.move_left i).move_right j :=
begin
  rw lt_def,
  dsimp,
  simp [forall_pempty, exists_pempty]
end

/-- Given a right-player-wins game, provide a response to any move by left. -/
noncomputable def right_response {x : pgame} (h : x ≤ 0) (i : x.left_moves) :
  (x.move_left i).right_moves :=
classical.some $ (le_zero.1 h) i

/-- Show that the response for right provided by `right_response`
    preserves the right-player-wins condition. -/
lemma right_response_spec {x : pgame} (h : x ≤ 0) (i : x.left_moves) :
  (x.move_left i).move_right (right_response h i) ≤ 0 :=
classical.some_spec $ (le_zero.1 h) i

/-- Given a left-player-wins game, provide a response to any move by right. -/
noncomputable def left_response {x : pgame} (h : 0 ≤ x) (j : x.right_moves) :
  (x.move_right j).left_moves :=
classical.some $ (zero_le.1 h) j

/-- Show that the response for left provided by `left_response`
    preserves the left-player-wins condition. -/
lemma left_response_spec {x : pgame} (h : 0 ≤ x) (j : x.right_moves) :
  0 ≤ (x.move_right j).move_left (left_response h j) :=
classical.some_spec $ (zero_le.1 h) j

theorem lt_of_le_mk {xl xr xL xR y i} :
  (⟨xl, xr, xL, xR⟩ : pgame) ≤ y → xL i < y :=
by { cases y, rw mk_le_mk, tauto }

theorem lt_of_mk_le {x : pgame} {yl yr yL yR i} :
  x ≤ ⟨yl, yr, yL, yR⟩ → x < yR i :=
by { cases x, rw mk_le_mk, tauto }

theorem mk_lt_of_le {xl xr xL xR y i} :
  ((xR : xr → pgame) i ≤ y) → (⟨xl, xr, xL, xR⟩ : pgame) < y :=
by { cases y, rw mk_lt_mk, tauto }

theorem lt_mk_of_le {x : pgame} {yl yr : Type*} {yL : yl → pgame} {yR i} :
  (x ≤ yL i) → x < ⟨yl, yr, yL, yR⟩ :=
by { cases x, rw mk_lt_mk, exact λ h, or.inl ⟨_, h⟩ }

theorem not_le_lt {x y : pgame} :
  (¬ x ≤ y ↔ y < x) ∧ (¬ x < y ↔ y ≤ x) :=
begin
  induction x with xl xr xL xR IHxl IHxr generalizing y,
  induction y with yl yr yL yR IHyl IHyr,
  classical,
  simp only [mk_le_mk, mk_lt_mk,
    not_and_distrib, not_or_distrib, not_forall, not_exists,
    and_comm, or_comm, IHxl, IHxr, IHyl, IHyr, iff_self, and_self]
end

theorem not_le {x y : pgame} : ¬ x ≤ y ↔ y < x := not_le_lt.1
theorem not_lt {x y : pgame} : ¬ x < y ↔ y ≤ x := not_le_lt.2

@[refl] protected theorem le_refl : ∀ x : pgame, x ≤ x
| ⟨l, r, L, R⟩ := by rw mk_le_mk; exact
⟨λ i, lt_mk_of_le (le_refl _), λ i, mk_lt_of_le (le_refl _)⟩

protected theorem lt_irrefl (x : pgame) : ¬ x < x :=
not_lt.2 (pgame.le_refl _)

protected theorem ne_of_lt : ∀ {x y : pgame}, x < y → x ≠ y
| x _ h rfl := pgame.lt_irrefl x h

theorem le_trans_aux
  {xl xr} {xL : xl → pgame} {xR : xr → pgame}
  {yl yr} {yL : yl → pgame} {yR : yr → pgame}
  {zl zr} {zL : zl → pgame} {zR : zr → pgame}
  (h₁ : ∀ i, mk yl yr yL yR ≤ mk zl zr zL zR → mk zl zr zL zR ≤ xL i → mk yl yr yL yR ≤ xL i)
  (h₂ : ∀ i, zR i ≤ mk xl xr xL xR → mk xl xr xL xR ≤ mk yl yr yL yR → zR i ≤ mk yl yr yL yR) :
  mk xl xr xL xR ≤ mk yl yr yL yR →
  mk yl yr yL yR ≤ mk zl zr zL zR →
  mk xl xr xL xR ≤ mk zl zr zL zR :=
by simp only [mk_le_mk] at *; exact
λ ⟨xLy, xyR⟩ ⟨yLz, yzR⟩, ⟨
  λ i, not_le.1 (λ h, not_lt.2 (h₁ _ ⟨yLz, yzR⟩ h) (xLy _)),
  λ i, not_le.1 (λ h, not_lt.2 (h₂ _ h ⟨xLy, xyR⟩) (yzR _))⟩

@[trans] theorem le_trans {x y z : pgame} : x ≤ y → y ≤ z → x ≤ z :=
suffices ∀ {x y z : pgame},
  (x ≤ y → y ≤ z → x ≤ z) ∧ (y ≤ z → z ≤ x → y ≤ x) ∧ (z ≤ x → x ≤ y → z ≤ y),
from this.1, begin
  clear x y z, intros,
  induction x with xl xr xL xR IHxl IHxr generalizing y z,
  induction y with yl yr yL yR IHyl IHyr generalizing z,
  induction z with zl zr zL zR IHzl IHzr,
  exact ⟨
    le_trans_aux (λ i, (IHxl _).2.1) (λ i, (IHzr _).2.2),
    le_trans_aux (λ i, (IHyl _).2.2) (λ i, (IHxr _).1),
    le_trans_aux (λ i, (IHzl _).1) (λ i, (IHyr _).2.1)⟩,
end

@[trans] theorem lt_of_le_of_lt {x y z : pgame} (hxy : x ≤ y) (hyz : y < z) : x < z :=
begin
  rw ←not_le at ⊢ hyz,
  exact mt (λ H, le_trans H hxy) hyz
end

@[trans] theorem lt_of_lt_of_le {x y z : pgame} (hxy : x < y) (hyz : y ≤ z) : x < z :=
begin
  rw ←not_le at ⊢ hxy,
  exact mt (λ H, le_trans hyz H) hxy
end

/-- Define the equivalence relation on pre-games. Two pre-games
  `x`, `y` are equivalent if `x ≤ y` and `y ≤ x`. -/
def equiv (x y : pgame) : Prop := x ≤ y ∧ y ≤ x

local infix ` ≈ ` := pgame.equiv

@[refl, simp] theorem equiv_refl (x) : x ≈ x := ⟨pgame.le_refl _, pgame.le_refl _⟩
@[symm] theorem equiv_symm {x y} : x ≈ y → y ≈ x | ⟨xy, yx⟩ := ⟨yx, xy⟩
@[trans] theorem equiv_trans {x y z} : x ≈ y → y ≈ z → x ≈ z
| ⟨xy, yx⟩ ⟨yz, zy⟩ := ⟨le_trans xy yz, le_trans zy yx⟩

@[trans]
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
@[trans]
theorem le_of_le_of_equiv {x y z} (h₁ : x ≤ y) (h₂ : y ≈ z) : x ≤ z := le_trans h₁ h₂.1
@[trans]
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₂
@[trans]
theorem le_of_equiv_of_le {x y z} (h₁ : x ≈ y) (h₂ : y ≤ z) : x ≤ z := le_trans h₁.1 h₂

theorem le_congr {x₁ y₁ x₂ y₂} : x₁ ≈ x₂ → y₁ ≈ y₂ → (x₁ ≤ y₁ ↔ x₂ ≤ y₂)
| ⟨x12, x21⟩ ⟨y12, y21⟩ := ⟨λ h, le_trans x21 (le_trans h y12), λ h, le_trans x12 (le_trans h y21)⟩

theorem lt_congr {x₁ y₁ x₂ y₂} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ < y₁ ↔ x₂ < y₂ :=
not_le.symm.trans $ (not_congr (le_congr hy hx)).trans not_le

theorem equiv_congr_left {y₁ y₂} : y₁ ≈ y₂ ↔ ∀ x₁, x₁ ≈ y₁ ↔ x₁ ≈ y₂ :=
⟨λ h x₁, ⟨λ h', equiv_trans h' h, λ h', equiv_trans h' (equiv_symm h)⟩,
 λ h, (h y₁).1 $ equiv_refl _⟩

theorem equiv_congr_right {x₁ x₂} : x₁ ≈ x₂ ↔ ∀ y₁, x₁ ≈ y₁ ↔ x₂ ≈ y₁ :=
⟨λ h y₁, ⟨λ h', equiv_trans (equiv_symm h) h', λ h', equiv_trans h h'⟩,
 λ h, (h x₂).2 $ equiv_refl _⟩

theorem equiv_of_mk_equiv {x y : pgame}
  (L : x.left_moves ≃ y.left_moves) (R : x.right_moves ≃ y.right_moves)
  (hl : ∀ (i : x.left_moves), x.move_left i ≈ y.move_left (L i))
  (hr : ∀ (j : y.right_moves), x.move_right (R.symm j) ≈ y.move_right j) :
  x ≈ y :=
begin
  fsplit; rw le_def,
  { exact ⟨λ i, or.inl ⟨L i, (hl i).1⟩, λ j, or.inr ⟨R.symm j, (hr j).1⟩⟩ },
  { fsplit,
    { intro i,
      left,
      specialize hl (L.symm i),
      simp only [move_left_mk, equiv.apply_symm_apply] at hl,
      use ⟨L.symm i, hl.2⟩ },
    { intro j,
      right,
      specialize hr (R j),
      simp only [move_right_mk, equiv.symm_apply_apply] at hr,
      use ⟨R j, hr.2⟩ } }
end

/-- `restricted x y` says that Left always has no more moves in `x` than in `y`,
     and Right always has no more moves in `y` than in `x` -/
inductive restricted : pgame.{u} → pgame.{u} → Type (u+1)
| mk : Π {x y : pgame} (L : x.left_moves → y.left_moves) (R : y.right_moves → x.right_moves),
         (∀ (i : x.left_moves), restricted (x.move_left i) (y.move_left (L i))) →
         (∀ (j : y.right_moves), restricted (x.move_right (R j)) (y.move_right j)) → restricted x y

/-- The identity restriction. -/
@[refl] def restricted.refl : Π (x : pgame), restricted x x
| (mk xl xr xL xR) :=
  restricted.mk
    id id
    (λ i, restricted.refl _) (λ j, restricted.refl _)
using_well_founded { dec_tac := pgame_wf_tac }

-- TODO trans for restricted

theorem restricted.le : Π {x y : pgame} (r : restricted x y), x ≤ y
| (mk xl xr xL xR) (mk yl yr yL yR)
  (restricted.mk L_embedding R_embedding L_restriction R_restriction) :=
begin
  rw le_def,
  exact
    ⟨λ i, or.inl ⟨L_embedding i, (L_restriction i).le⟩,
     λ i, or.inr ⟨R_embedding i, (R_restriction i).le⟩⟩
end

/--
`relabelling x y` says that `x` and `y` are really the same game, just dressed up differently.
Specifically, there is a bijection between the moves for Left in `x` and in `y`, and similarly
for Right, and under these bijections we inductively have `relabelling`s for the consequent games.
-/
inductive relabelling : pgame.{u} → pgame.{u} → Type (u+1)
| mk : Π {x y : pgame} (L : x.left_moves ≃ y.left_moves) (R : x.right_moves ≃ y.right_moves),
         (∀ (i : x.left_moves), relabelling (x.move_left i) (y.move_left (L i))) →
         (∀ (j : y.right_moves), relabelling (x.move_right (R.symm j)) (y.move_right j)) →
       relabelling x y

/-- If `x` is a relabelling of `y`, then Left and Right have the same moves in either game,
    so `x` is a restriction of `y`. -/
def relabelling.restricted: Π {x y : pgame} (r : relabelling x y), restricted x y
| (mk xl xr xL xR) (mk yl yr yL yR) (relabelling.mk L_equiv R_equiv L_relabelling R_relabelling) :=
restricted.mk L_equiv.to_embedding R_equiv.symm.to_embedding
  (λ i, (L_relabelling i).restricted)
  (λ j, (R_relabelling j).restricted)

-- It's not the case that `restricted x y → restricted y x → relabelling x y`,
-- but if we insisted that the maps in a restriction were injective, then one
-- could use Schröder-Bernstein for do this.

/-- The identity relabelling. -/
@[refl] def relabelling.refl : Π (x : pgame), relabelling x x
| (mk xl xr xL xR) :=
  relabelling.mk (equiv.refl _) (equiv.refl _)
    (λ i, relabelling.refl _) (λ j, relabelling.refl _)
using_well_founded { dec_tac := pgame_wf_tac }

/-- Reverse a relabelling. -/
@[symm] def relabelling.symm : Π {x y : pgame}, relabelling x y → relabelling y x
| (mk xl xr xL xR) (mk yl yr yL yR) (relabelling.mk L_equiv R_equiv L_relabelling R_relabelling) :=
begin
  refine relabelling.mk L_equiv.symm R_equiv.symm _ _,
  { intro i, simpa using (L_relabelling (L_equiv.symm i)).symm },
  { intro j, simpa using (R_relabelling (R_equiv j)).symm }
end

/-- Transitivity of relabelling -/
@[trans] def relabelling.trans :
  Π {x y z : pgame}, relabelling x y → relabelling y z → relabelling x z
| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR)
  (relabelling.mk L_equiv₁ R_equiv₁ L_relabelling₁ R_relabelling₁)
  (relabelling.mk L_equiv₂ R_equiv₂ L_relabelling₂ R_relabelling₂) :=
begin
  refine relabelling.mk (L_equiv₁.trans L_equiv₂) (R_equiv₁.trans R_equiv₂) _ _,
  { intro i, simpa using (L_relabelling₁ _).trans (L_relabelling₂ _) },
  { intro j, simpa using (R_relabelling₁ _).trans (R_relabelling₂ _) },
end

theorem relabelling.le {x y : pgame} (r : relabelling x y) : x ≤ y :=
r.restricted.le

/-- A relabelling lets us prove equivalence of games. -/
theorem relabelling.equiv {x y : pgame} (r : relabelling x y) : x ≈ y :=
⟨r.le, r.symm.le⟩

instance {x y : pgame} : has_coe (relabelling x y) (x ≈ y) := ⟨relabelling.equiv⟩

/-- Replace the types indexing the next moves for Left and Right by equivalent types. -/
def relabel {x : pgame} {xl' xr'} (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') :=
pgame.mk xl' xr' (λ i, x.move_left (el.symm i)) (λ j, x.move_right (er.symm j))

@[simp] lemma relabel_move_left' {x : pgame} {xl' xr'}
  (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') (i : xl') :
  move_left (relabel el er) i = x.move_left (el.symm i) :=
rfl
@[simp] lemma relabel_move_left {x : pgame} {xl' xr'}
  (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') (i : x.left_moves) :
  move_left (relabel el er) (el i) = x.move_left i :=
by simp

@[simp] lemma relabel_move_right' {x : pgame} {xl' xr'}
  (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') (j : xr') :
  move_right (relabel el er) j = x.move_right (er.symm j) :=
rfl
@[simp] lemma relabel_move_right {x : pgame} {xl' xr'}
  (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') (j : x.right_moves) :
  move_right (relabel el er) (er j) = x.move_right j :=
by simp

/-- The game obtained by relabelling the next moves is a relabelling of the original game. -/
def relabel_relabelling {x : pgame} {xl' xr'} (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') :
  relabelling x (relabel el er) :=
relabelling.mk el er (λ i, by simp) (λ j, by simp)

/-- The negation of `{L | R}` is `{-R | -L}`. -/
def neg : pgame → pgame
| ⟨l, r, L, R⟩ := ⟨r, l, λ i, neg (R i), λ i, neg (L i)⟩

instance : has_neg pgame := ⟨neg⟩

@[simp] lemma neg_def {xl xr xL xR} : -(mk xl xr xL xR) = mk xr xl (λ j, -(xR j)) (λ i, -(xL i)) :=
rfl

@[simp] theorem neg_neg : Π {x : pgame}, -(-x) = x
| (mk xl xr xL xR) :=
begin
  dsimp [has_neg.neg, neg],
  congr; funext i; apply neg_neg
end

@[simp] theorem neg_zero : -(0 : pgame) = 0 :=
begin
  dsimp [has_zero.zero, has_neg.neg, neg],
  congr; funext i; cases i
end

/-- An explicit equivalence between the moves for Left in `-x` and the moves for Right in `x`. -/
-- This equivalence is useful to avoid having to use `cases` unnecessarily.
def left_moves_neg (x : pgame) : (-x).left_moves ≃ x.right_moves :=
by { cases x, refl }

/-- An explicit equivalence between the moves for Right in `-x` and the moves for Left in `x`. -/
def right_moves_neg (x : pgame) : (-x).right_moves ≃ x.left_moves :=
by { cases x, refl }

@[simp] lemma move_right_left_moves_neg {x : pgame} (i : left_moves (-x)) :
  move_right x ((left_moves_neg x) i) = -(move_left (-x) i) :=
begin
  induction x,
  exact neg_neg.symm
end
@[simp] lemma move_left_left_moves_neg_symm {x : pgame} (i : right_moves x) :
  move_left (-x) ((left_moves_neg x).symm i) = -(move_right x i) :=
by { cases x, refl }
@[simp] lemma move_left_right_moves_neg {x : pgame} (i : right_moves (-x)) :
  move_left x ((right_moves_neg x) i) = -(move_right (-x) i) :=
begin
  induction x,
  exact neg_neg.symm
end
@[simp] lemma move_right_right_moves_neg_symm {x : pgame} (i : left_moves x) :
  move_right (-x) ((right_moves_neg x).symm i) = -(move_left x i) :=
by { cases x, refl }

/-- If `x` has the same moves as `y`, then `-x` has the sames moves as `-y`. -/
def relabelling.neg_congr : ∀ {x y : pgame}, x.relabelling y → (-x).relabelling (-y)
| (mk xl xr xL xR) (mk yl yr yL yR) ⟨L_equiv, R_equiv, L_relabelling, R_relabelling⟩ :=
  ⟨R_equiv, L_equiv,
    λ i, relabelling.neg_congr (by simpa using R_relabelling (R_equiv i)),
    λ i, relabelling.neg_congr (by simpa using L_relabelling (L_equiv.symm i))⟩

theorem le_iff_neg_ge : Π {x y : pgame}, x ≤ y ↔ -y ≤ -x
| (mk xl xr xL xR) (mk yl yr yL yR) :=
begin
  rw [le_def],
  rw [le_def],
  dsimp [neg],
  split,
  { intro h,
    split,
    { intro i, have t := h.right i, cases t,
      { right, cases t,
        use (@right_moves_neg (yR i)).symm t_w, convert le_iff_neg_ge.1 t_h, simp },
      { left, cases t,
        use t_w, exact le_iff_neg_ge.1 t_h, } },
    { intro j, have t := h.left j, cases t,
      { right, cases t,
        use t_w, exact le_iff_neg_ge.1 t_h, },
      { left, cases t,
        use (@left_moves_neg (xL j)).symm t_w, convert le_iff_neg_ge.1 t_h, simp, } } },
  { intro h,
    split,
    { intro i, have t := h.right i, cases t,
      { right, cases t,
        use (@left_moves_neg (xL i)) t_w, convert le_iff_neg_ge.2 _, convert t_h, simp, },
      { left, cases t,
        use t_w, exact le_iff_neg_ge.2 t_h, } },
    { intro j, have t := h.left j, cases t,
      { right, cases t,
        use t_w, exact le_iff_neg_ge.2 t_h, },
      { left, cases t,
        use (@right_moves_neg (yR j)) t_w, convert le_iff_neg_ge.2 _, convert t_h, simp } } },
end
using_well_founded { dec_tac := pgame_wf_tac }

theorem neg_congr {x y : pgame} (h : x ≈ y) : -x ≈ -y :=
⟨le_iff_neg_ge.1 h.2, le_iff_neg_ge.1 h.1⟩

theorem lt_iff_neg_gt : Π {x y : pgame}, x < y ↔ -y < -x :=
begin
  classical,
  intros,
  rw [←not_le, ←not_le, not_iff_not],
  apply le_iff_neg_ge
end

theorem zero_le_iff_neg_le_zero {x : pgame} : 0 ≤ x ↔ -x ≤ 0 :=
begin
  convert le_iff_neg_ge,
  rw neg_zero
end

theorem le_zero_iff_zero_le_neg {x : pgame} : x ≤ 0 ↔ 0 ≤ -x :=
begin
  convert le_iff_neg_ge,
  rw neg_zero
end

/-- The sum of `x = {xL | xR}` and `y = {yL | yR}` is `{xL + y, x + yL | xR + y, x + yR}`. -/
def add (x y : pgame) : pgame :=
begin
  induction x with xl xr xL xR IHxl IHxr generalizing y,
  induction y with yl yr yL yR IHyl IHyr,
  have y := mk yl yr yL yR,
  refine ⟨xl ⊕ yl, xr ⊕ yr, sum.rec _ _, sum.rec _ _⟩,
  { exact λ i, IHxl i y },
  { exact λ i, IHyl i },
  { exact λ i, IHxr i y },
  { exact λ i, IHyr i }
end

instance : has_add pgame := ⟨add⟩

/-- `x + 0` has exactly the same moves as `x`. -/
def add_zero_relabelling : Π (x : pgame.{u}), relabelling (x + 0) x
| (mk xl xr xL xR) :=
begin
  refine ⟨equiv.sum_empty xl pempty, equiv.sum_empty xr pempty, _, _⟩,
  { rintro (⟨i⟩|⟨⟨⟩⟩),
    apply add_zero_relabelling, },
  { rintro j,
    apply add_zero_relabelling, }
end

/-- `x + 0` is equivalent to `x`. -/
lemma add_zero_equiv (x : pgame.{u}) : x + 0 ≈ x :=
(add_zero_relabelling x).equiv

/-- `0 + x` has exactly the same moves as `x`. -/
def zero_add_relabelling : Π (x : pgame.{u}), relabelling (0 + x) x
| (mk xl xr xL xR) :=
begin
  refine ⟨equiv.empty_sum pempty xl, equiv.empty_sum pempty xr, _, _⟩,
  { rintro (⟨⟨⟩⟩|⟨i⟩),
    apply zero_add_relabelling, },
  { rintro j,
    apply zero_add_relabelling, }
end

/-- `0 + x` is equivalent to `x`. -/
lemma zero_add_equiv (x : pgame.{u}) : 0 + x ≈ x :=
(zero_add_relabelling x).equiv

/-- An explicit equivalence between the moves for Left in `x + y` and the type-theory sum
    of the moves for Left in `x` and in `y`. -/
def left_moves_add (x y : pgame) : (x + y).left_moves ≃ x.left_moves ⊕ y.left_moves :=
by { cases x, cases y, refl, }

/-- An explicit equivalence between the moves for Right in `x + y` and the type-theory sum
    of the moves for Right in `x` and in `y`. -/
def right_moves_add (x y : pgame) : (x + y).right_moves ≃ x.right_moves ⊕ y.right_moves :=
by { cases x, cases y, refl, }

@[simp] lemma mk_add_move_left_inl {xl xr yl yr} {xL xR yL yR} {i} :
  (mk xl xr xL xR + mk yl yr yL yR).move_left (sum.inl i) =
    (mk xl xr xL xR).move_left i + (mk yl yr yL yR) :=
rfl
@[simp] lemma add_move_left_inl {x y : pgame} {i} :
  (x + y).move_left ((@left_moves_add x y).symm (sum.inl i)) = x.move_left i + y :=
by { cases x, cases y, refl, }

@[simp] lemma mk_add_move_right_inl {xl xr yl yr} {xL xR yL yR} {i} :
  (mk xl xr xL xR + mk yl yr yL yR).move_right (sum.inl i) =
    (mk xl xr xL xR).move_right i + (mk yl yr yL yR) :=
rfl
@[simp] lemma add_move_right_inl {x y : pgame} {i} :
  (x + y).move_right ((@right_moves_add x y).symm (sum.inl i)) = x.move_right i + y :=
by { cases x, cases y, refl, }

@[simp] lemma mk_add_move_left_inr {xl xr yl yr} {xL xR yL yR} {i} :
  (mk xl xr xL xR + mk yl yr yL yR).move_left (sum.inr i) =
    (mk xl xr xL xR) + (mk yl yr yL yR).move_left i :=
rfl
@[simp] lemma add_move_left_inr {x y : pgame} {i : y.left_moves} :
  (x + y).move_left ((@left_moves_add x y).symm (sum.inr i)) = x + y.move_left i :=
by { cases x, cases y, refl, }

@[simp] lemma mk_add_move_right_inr {xl xr yl yr} {xL xR yL yR} {i} :
  (mk xl xr xL xR + mk yl yr yL yR).move_right (sum.inr i) =
    (mk xl xr xL xR) + (mk yl yr yL yR).move_right i :=
rfl
@[simp] lemma add_move_right_inr {x y : pgame} {i} :
  (x + y).move_right ((@right_moves_add x y).symm (sum.inr i)) = x + y.move_right i :=
by { cases x, cases y, refl, }

/-- If `w` has the same moves as `x` and `y` has the same moves as `z`,
then `w + y` has the same moves as `x + z`. -/
def relabelling.add_congr : ∀ {w x y z : pgame.{u}},
  w.relabelling x → y.relabelling z → (w + y).relabelling (x + z)
| (mk wl wr wL wR) (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR)
  ⟨L_equiv₁, R_equiv₁, L_relabelling₁, R_relabelling₁⟩
  ⟨L_equiv₂, R_equiv₂, L_relabelling₂, R_relabelling₂⟩ :=
begin
  refine ⟨equiv.sum_congr L_equiv₁ L_equiv₂, equiv.sum_congr R_equiv₁ R_equiv₂, _, _⟩,
  { rintro (i|j),
    { exact relabelling.add_congr
        (L_relabelling₁ i)
        (⟨L_equiv₂, R_equiv₂, L_relabelling₂, R_relabelling₂⟩) },
    { exact relabelling.add_congr
        (⟨L_equiv₁, R_equiv₁, L_relabelling₁, R_relabelling₁⟩)
        (L_relabelling₂ j) }},
  { rintro (i|j),
    { exact relabelling.add_congr
        (R_relabelling₁ i)
        (⟨L_equiv₂, R_equiv₂, L_relabelling₂, R_relabelling₂⟩) },
    { exact relabelling.add_congr
        (⟨L_equiv₁, R_equiv₁, L_relabelling₁, R_relabelling₁⟩)
        (R_relabelling₂ j) }}
end
using_well_founded { dec_tac := pgame_wf_tac }

instance : has_sub pgame := ⟨λ x y, x + -y⟩

/-- If `w` has the same moves as `x` and `y` has the same moves as `z`,
then `w - y` has the same moves as `x - z`. -/
def relabelling.sub_congr {w x y z : pgame}
  (h₁ : w.relabelling x) (h₂ : y.relabelling z) : (w - y).relabelling (x - z) :=
h₁.add_congr h₂.neg_congr

/-- `-(x+y)` has exactly the same moves as `-x + -y`. -/
def neg_add_relabelling : Π (x y : pgame), relabelling (-(x + y)) (-x + -y)
| (mk xl xr xL xR) (mk yl yr yL yR) :=
⟨equiv.refl _, equiv.refl _,
 λ j, sum.cases_on j
   (λ j, neg_add_relabelling (xR j) (mk yl yr yL yR))
   (λ j, neg_add_relabelling (mk xl xr xL xR) (yR j)),
 λ i, sum.cases_on i
   (λ i, neg_add_relabelling (xL i) (mk yl yr yL yR))
   (λ i, neg_add_relabelling (mk xl xr xL xR) (yL i))⟩
using_well_founded { dec_tac := pgame_wf_tac }

theorem neg_add_le {x y : pgame} : -(x + y) ≤ -x + -y :=
(neg_add_relabelling x y).le

/-- `x+y` has exactly the same moves as `y+x`. -/
def add_comm_relabelling : Π (x y : pgame.{u}), relabelling (x + y) (y + x)
| (mk xl xr xL xR) (mk yl yr yL yR) :=
begin
  refine ⟨equiv.sum_comm _ _, equiv.sum_comm _ _, _, _⟩;
  rintros (_|_);
  { simp [left_moves_add, right_moves_add], apply add_comm_relabelling }
end
using_well_founded { dec_tac := pgame_wf_tac }

theorem add_comm_le {x y : pgame} : x + y ≤ y + x :=
(add_comm_relabelling x y).le

theorem add_comm_equiv {x y : pgame} : x + y ≈ y + x :=
(add_comm_relabelling x y).equiv

/-- `(x + y) + z` has exactly the same moves as `x + (y + z)`. -/
def add_assoc_relabelling : Π (x y z : pgame.{u}), relabelling ((x + y) + z) (x + (y + z))
| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
begin
  refine ⟨equiv.sum_assoc _ _ _, equiv.sum_assoc _ _ _, _, _⟩,
  { rintro (⟨i|i⟩|i),
    { apply add_assoc_relabelling, },
    { change relabelling
        (mk xl xr xL xR + yL i + mk zl zr zL zR) (mk xl xr xL xR + (yL i + mk zl zr zL zR)),
      apply add_assoc_relabelling, },
    { change relabelling
        (mk xl xr xL xR + mk yl yr yL yR + zL i) (mk xl xr xL xR + (mk yl yr yL yR + zL i)),
      apply add_assoc_relabelling, } },
  { rintro (j|⟨j|j⟩),
    { apply add_assoc_relabelling, },
    { change relabelling
        (mk xl xr xL xR + yR j + mk zl zr zL zR) (mk xl xr xL xR + (yR j + mk zl zr zL zR)),
      apply add_assoc_relabelling, },
    { change relabelling
        (mk xl xr xL xR + mk yl yr yL yR + zR j) (mk xl xr xL xR + (mk yl yr yL yR + zR j)),
      apply add_assoc_relabelling, } },
end
using_well_founded { dec_tac := pgame_wf_tac }

theorem add_assoc_equiv {x y z : pgame} : (x + y) + z ≈ x + (y + z) :=
(add_assoc_relabelling x y z).equiv

theorem add_le_add_right : Π {x y z : pgame} (h : x ≤ y), x + z ≤ y + z
| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
begin
  intros h,
  rw le_def,
  split,
  { -- if Left plays first
    intros i,
    change xl ⊕ zl at i,
    cases i,
    { -- either they play in x
      rw le_def at h,
      cases h,
      have t := h_left i,
      rcases t with ⟨i', ih⟩ | ⟨j, jh⟩,
      { left,
        refine ⟨(left_moves_add _ _).inv_fun (sum.inl i'), _⟩,
        exact add_le_add_right ih, },
      { right,
        refine ⟨(right_moves_add _ _).inv_fun (sum.inl j), _⟩,
        convert add_le_add_right jh,
        apply add_move_right_inl } },
    { -- or play in z
      left,
      refine ⟨(left_moves_add _ _).inv_fun (sum.inr i), _⟩,
      exact add_le_add_right h, }, },
  { -- if Right plays first
    intros j,
    change yr ⊕ zr at j,
    cases j,
    { -- either they play in y
      rw le_def at h,
      cases h,
      have t := h_right j,
      rcases t with ⟨i, ih⟩ | ⟨j', jh⟩,
      { left,
        refine ⟨(left_moves_add _ _).inv_fun (sum.inl i), _⟩,
        convert add_le_add_right ih,
        apply add_move_left_inl },
      { right,
        refine ⟨(right_moves_add _ _).inv_fun (sum.inl j'), _⟩,
        exact add_le_add_right jh } },
    { -- or play in z
      right,
      refine ⟨(right_moves_add _ _).inv_fun (sum.inr j), _⟩,
      exact add_le_add_right h } }
end
using_well_founded { dec_tac := pgame_wf_tac }

theorem add_le_add_left {x y z : pgame} (h : y ≤ z) : x + y ≤ x + z :=
calc x + y ≤ y + x : add_comm_le
     ... ≤ z + x : add_le_add_right h
     ... ≤ x + z : add_comm_le

theorem add_congr {w x y z : pgame} (h₁ : w ≈ x) (h₂ : y ≈ z) : w + y ≈ x + z :=
⟨calc w + y ≤ w + z : add_le_add_left h₂.1
        ... ≤ x + z : add_le_add_right h₁.1,
 calc x + z ≤ x + y : add_le_add_left h₂.2
        ... ≤ w + y : add_le_add_right h₁.2⟩

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

theorem add_left_neg_le_zero : Π {x : pgame}, (-x) + x ≤ 0
| ⟨xl, xr, xL, xR⟩ :=
begin
  rw [le_def],
  split,
  { intro i,
    change xr ⊕ xl at i,
    cases i,
    { -- If Left played in -x, Right responds with the same move in x.
      right,
      refine ⟨(right_moves_add _ _).inv_fun (sum.inr i), _⟩,
      convert @add_left_neg_le_zero (xR i),
      exact add_move_right_inr },
    { -- If Left in x, Right responds with the same move in -x.
      right,
      dsimp,
      refine ⟨(right_moves_add _ _).inv_fun (sum.inl i), _⟩,
      convert @add_left_neg_le_zero (xL i),
      exact add_move_right_inl }, },
  { rintro ⟨⟩, }
end
using_well_founded { dec_tac := pgame_wf_tac }

theorem zero_le_add_left_neg : Π {x : pgame}, 0 ≤ (-x) + x :=
begin
  intro x,
  rw [le_iff_neg_ge, neg_zero],
  exact le_trans neg_add_le add_left_neg_le_zero
end

theorem add_left_neg_equiv {x : pgame} : (-x) + x ≈ 0 :=
⟨add_left_neg_le_zero, zero_le_add_left_neg⟩

theorem add_right_neg_le_zero {x : pgame} : x + (-x) ≤ 0 :=
calc x + (-x) ≤ (-x) + x : add_comm_le
     ... ≤ 0 : add_left_neg_le_zero

theorem zero_le_add_right_neg {x : pgame} : 0 ≤ x + (-x) :=
calc 0 ≤ (-x) + x : zero_le_add_left_neg
     ... ≤ x + (-x) : add_comm_le

theorem add_right_neg_equiv {x : pgame} : x + (-x) ≈ 0 :=
⟨add_right_neg_le_zero, zero_le_add_right_neg⟩

theorem add_lt_add_right {x y z : pgame} (h : x < y) : x + z < y + z :=
suffices y + z ≤ x + z → y ≤ x, by { rw ←not_le at ⊢ h, exact mt this h },
assume w,
calc y ≤ y + 0            : (add_zero_relabelling _).symm.le
     ... ≤ y + (z + -z)   : add_le_add_left zero_le_add_right_neg
     ... ≤ (y + z) + (-z) : (add_assoc_relabelling _ _ _).symm.le
     ... ≤ (x + z) + (-z) : add_le_add_right w
     ... ≤ x + (z + -z)   : (add_assoc_relabelling _ _ _).le
     ... ≤ x + 0          : add_le_add_left add_right_neg_le_zero
     ... ≤ x              : (add_zero_relabelling _).le

theorem add_lt_add_left {x y z : pgame} (h : y < z) : x + y < x + z :=
calc x + y ≤ y + x : add_comm_le
     ... < z + x   : add_lt_add_right h
     ... ≤ x + z   : add_comm_le

theorem le_iff_sub_nonneg {x y : pgame} : x ≤ y ↔ 0 ≤ y - x :=
⟨λ h, le_trans zero_le_add_right_neg (add_le_add_right h),
 λ h,
  calc x ≤ 0 + x : (zero_add_relabelling x).symm.le
     ... ≤ (y - x) + x : add_le_add_right h
     ... ≤ y + (-x + x) : (add_assoc_relabelling _ _ _).le
     ... ≤ y + 0 : add_le_add_left (add_left_neg_le_zero)
     ... ≤ y : (add_zero_relabelling y).le⟩
theorem lt_iff_sub_pos {x y : pgame} : x < y ↔ 0 < y - x :=
⟨λ h, lt_of_le_of_lt zero_le_add_right_neg (add_lt_add_right h),
 λ h,
  calc x ≤ 0 + x : (zero_add_relabelling x).symm.le
     ... < (y - x) + x : add_lt_add_right h
     ... ≤ y + (-x + x) : (add_assoc_relabelling _ _ _).le
     ... ≤ y + 0 : add_le_add_left (add_left_neg_le_zero)
     ... ≤ y : (add_zero_relabelling y).le⟩

/-- The pre-game `star`, which is fuzzy/confused with zero. -/
def star : pgame := pgame.of_lists [0] [0]

theorem star_lt_zero : star < 0 :=
by rw lt_def; exact
or.inr ⟨⟨0, zero_lt_one⟩, (by split; rintros ⟨⟩)⟩

theorem zero_lt_star : 0 < star :=
by rw lt_def; exact
or.inl ⟨⟨0, zero_lt_one⟩, (by split; rintros ⟨⟩)⟩

/-- The pre-game `ω`. (In fact all ordinals have game and surreal representatives.) -/
def omega : pgame := ⟨ulift ℕ, pempty, λ n, ↑n.1, pempty.elim⟩

theorem zero_lt_one : (0 : pgame) < 1 :=
begin
  rw lt_def,
  left,
  use ⟨punit.star, by split; rintro ⟨ ⟩⟩,
end

/-- The pre-game `half` is defined as `{0 | 1}`. -/
def half : pgame := ⟨punit, punit, 0, 1⟩

@[simp] lemma half_move_left : half.move_left punit.star = 0 := rfl

@[simp] lemma half_move_right : half.move_right punit.star = 1 := rfl

theorem zero_lt_half : 0 < half :=
begin
  rw lt_def,
  left,
  use punit.star,
  split; rintro ⟨ ⟩,
end

theorem half_lt_one : half < 1 :=
begin
  rw lt_def,
  right,
  use punit.star,
  split; rintro ⟨ ⟩,
  exact zero_lt_one,
end

end pgame


import Sets.Basic

namespace Func

variable { α β γ : Type }

def Injective (f : α → β) : Prop := ∀ ⦃a₁ a₂⦄, f a₁ = f a₂ → a₁ = a₂

def Surjective (f : α → β) : Prop := ∀ b, ∃ a, f a = b

def Bijective (f : α → β) : Prop :=  Injective f ∧ Surjective f

structure LeftInverse (f : α → β) where
  to_fun : β → α
  invl : to_fun ∘ f = id

structure RightInverse (f : β → α) where
  to_fun : α → β
  invr : f ∘ to_fun = id

structure Inverse (f : α → β) where
  to_fun : β → α
  invl : to_fun ∘ f = id
  invr : f ∘ to_fun = id

def HasLeftInv (f : α → β) : Prop := Nonempty (LeftInverse f)

def HasRightInv (f : α → β) : Prop := Nonempty (RightInverse f)

def IdInv : LeftInverse (@id α) := ⟨id,by rfl⟩

theorem inj_comp {f : α → β} {g : β → γ} (h₁ : Injective f) (h₂ : Injective g) : Injective (g ∘ f)
  := by
    intro a₁ a₂ h
    have (l₁ : f a₁ = f a₂) := h₂ h
    exact h₁ l₁

theorem surj_comp {f : α → β} {g : β → γ} (h₁ : Surjective f) (h₂ : Surjective g) : Surjective (g ∘ f)
  := by
    intro c
    have ⟨b,l₁⟩ := h₂ c
    have ⟨a,l₂⟩ := h₁ b
    have : g (f a) = c := by rw [l₂,l₁]
    exact ⟨a,this⟩

theorem comp_inj { f : α → β } { g : β → γ } (h : Injective (g ∘ f)) : Injective f := by
  intro a₁ a₂ h₁
  have : g (f a₁) = g (f a₂) := congrArg g h₁
  exact h this

theorem comp_surj { f : α → β } { g : β → γ } (h : Surjective (g ∘ f)) : Surjective g := by
  intro c
  have ⟨a,h₁⟩ : ∃ a, g (f a) = c := h c
  exact ⟨f a, h₁⟩

theorem has_left_inv_injective (f : α → β) (h : HasLeftInv f) : Injective f := by
  -- Introduce a pair of arguments and the assumption that
  -- f evaluates to the same on them
  intro (a₁:α) (a₂:α) (l₁: f a₁ = f a₂)
  -- Break up the existence of a left-inverse into a function and a proof it is a
  -- left inverse
  have ⟨g,l₂⟩ := h
  -- A calculation block allows us to more efficiently perform equality manipulations
  calc
    a₁ = id a₁        := by rfl
    _  = (g ∘ f) a₁   := Eq.symm (congrFun l₂ a₁)
    _  = (g ∘ f) a₂   := congrArg g l₁
    _  = id a₂        := congrFun l₂ a₂
    _  = a₂           := by rfl

def InvtoLeftInv { f : α → β } (g : Inverse f) : LeftInverse f := ⟨g.to_fun,g.invl⟩

def InvtoRightInv { f : α → β } (g : Inverse f) : RightInverse f := ⟨g.to_fun,g.invr⟩

theorem left_inv_right_inv_eq { f : α → β } (g : LeftInverse f) (h : RightInverse f) :
  g.to_fun = h.to_fun := by
    apply funext
    intro (b: β)
    calc
        g.to_fun b = g.to_fun (f (h.to_fun b))  :=
          congrArg g.to_fun (Eq.symm (congrFun h.invr b))
        _    = h.to_fun b                       :=
          congrFun g.invl (h.to_fun b)

theorem inv_unique (f : α → β) (g : Inverse f) (h : Inverse f) : g.to_fun = h.to_fun := by
  calc
    g.to_fun = (InvtoLeftInv g).to_fun    := by rfl
    _        = (InvtoRightInv h).to_fun   :=
      left_inv_right_inv_eq (InvtoLeftInv g) (InvtoRightInv h)
    _        = h.to_fun                   := by rfl

noncomputable def Section (f : α → β) (l : Nonempty α) : β → α := by
  intro (b:β)
  have a₀ : α := Classical.choice l
  have : Decidable (∃ a, f a = b) := Classical.propDecidable (∃ a, f a = b)
  exact if h : ∃ a, f a = b then Classical.choose h else a₀

theorem inj_has_left_inv (f : α → β) (l : Nonempty α) (h : Injective f) : HasLeftInv f := by
  let g : β → α := Section f l
  suffices u : g ∘ f = id from ⟨g,u⟩
  apply funext
  intro (a:α)
  have (v : ∃ x, f x = f a) := by exists a
  have (w : g (f a) = Classical.choose v) := dif_pos v
  calc
    g (f a) = Classical.choose v  := w
    _       = a                   := h (Classical.choose_spec v)

theorem surj_has_right_inv (f : α → β) (h : Surjective f) : HasRightInv f := by
  let g : β → α := by
    intro b
    have : ∃ a, f a = b := h b
    have (a : α) := Classical.choose this
    exact a
  have (l : f ∘ g = id) := by
    apply funext
    intro b
    have u : g b = Classical.choose (h b) := by rfl
    have v : f (Classical.choose (h b)) = b := Classical.choose_spec (h b)
    calc
      f (g b) = f (Classical.choose (h b))  := by rw [u]
      _       = b                           := by rw [v]
  exact ⟨g,l⟩

def empty_bijection_inverse (f : Empty → β) (h : Bijective f) : Inverse f := by
  let g : β → Empty := fun b => by
    have (a : Empty) := Classical.choose (h.right b)
    exact Empty.rec a
  have invl : g ∘ f = id := by
    apply funext
    exact fun a => Empty.rec a
  have invr : f ∘ g = id := funext (fun b => Empty.rec (Classical.choose (h.right b)))
  exact ⟨g,invl,invr⟩

noncomputable def inverse (f : α → β) (h : Bijective f) : Inverse f :=
  have : Decidable (Nonempty α) := Classical.propDecidable (Nonempty α)
  if u : Nonempty α then
    have g : LeftInverse f := Classical.choice (inj_has_left_inv f u h.left)
    have h : RightInverse f := Classical.choice (surj_has_right_inv f h.right)
    have : g.to_fun = h.to_fun := left_inv_right_inv_eq g h
    have invr' : f ∘ g.to_fun = id := by {rw [this]; exact h.invr}
    ⟨g.to_fun,g.invl,invr'⟩
  else by
    let g : β → α := fun b => by
      have (p : Nonempty α) := ⟨Classical.choose (h.right b)⟩
      exact False.elim (u p)
    have invl : g ∘ f = id := by
      apply funext
      exact fun a => False.elim (u (Nonempty.intro a))
    have invr : f ∘ g = id := funext <| fun b => by
      have (p : Nonempty α) := ⟨Classical.choose (h.right b)⟩
      exact False.elim (u p)
    exact ⟨g,invl,invr⟩

theorem has_right_inv_surjective (f : α → β) (h : HasRightInv f) : Surjective f := by
  have ⟨g,l⟩ := h
  intro (b:β)
  exact ⟨g b, congrFun l b⟩

open Set

def Image (f : α → β) (X : Set α) : Set β := fun b => ∃ a, a ∈ X ∧ f a = b
-- infix:80 " '' " => Image
--
-- declare_syntax_cat set_image
-- syntax set_image "[" ident "]" : term
--
-- syntax ident : binder_construct
--
-- macro_rules
-- | `({ $var:ident [ $var2:ident ]}) => `(Image ($var : $ty) ($body :term) ))

def PreImage (f : α → β) (Y : Set β) : Set α := fun a => f a ∈ Y
infix:80 " ⁻¹ " => PreImage

theorem image_sub (f : α → β) { X X' : Set α } (h : X ⊆ X')  : Image f X ⊆ Image f X' := by
  intro b h'
  have ⟨a,h''⟩ := h'
  exact ⟨a,⟨h a h''.left,h''.right⟩⟩

theorem preimage_sub (f : α → β) { Y Y' : Set β } (h : Y ⊆ Y') : f⁻¹ Y ⊆ f⁻¹ Y' := by
  intro a h'
  exact h (f a) h'

theorem image_preimage_sub (f : α → β) (Y : Set β) : Image f (PreImage f Y) ⊆ Y := by
  intro b h
  have ⟨a,h'⟩ := h
  rw [←h'.right]
  exact h'.left

theorem sub_preimage_image (f : α → β) (X : Set α) : X ⊆ PreImage f (Image f X) := by
  intro a h
  have : f a ∈ Image f X := ⟨a,⟨h,Eq.refl (f a) ⟩⟩
  exact this

theorem union_preimage (f : α → β) (Y Y' : Set β) : f⁻¹ (Y ∪ Y') = f⁻¹ Y ∪ f⁻¹ Y' := by rfl

theorem inter_preimage (f : α → β) (Y Y' : Set β) : f⁻¹ (Y ∩ Y') = f⁻¹ Y ∩ f⁻¹ Y' := by rfl

theorem union_image (f : α → β) (X X' : Set α) : Image f (X ∪ X') = Image f X ∪ Image f X' := by
  set_extensionality b
  · intro h
    have ⟨a,h'⟩ := h
    cases h'.left with
    | inl hl => exact Or.inl ⟨a,hl,h'.right⟩
    | inr hr => exact Or.inr ⟨a,hr,h'.right⟩
  · intro h
    cases h with
    | inl hl =>
      have ⟨a,h'⟩ := hl
      exact ⟨a,⟨Or.inl h'.left,h'.right⟩⟩
    | inr hr =>
      have ⟨a,h'⟩ := hr
      exact ⟨a,⟨Or.inr h'.left,h'.right⟩⟩

theorem inter_image (f : α → β) (X X' : Set α) : Image f (X ∩ X') ⊆ Image f X ∩ Image f X' := by
  intro b h
  have ⟨a,h'⟩ := h
  exact ⟨⟨a,⟨h'.left.left,h'.right⟩⟩,⟨a,⟨h'.left.right,h'.right⟩⟩⟩

def InBijection (γ δ : Type) : Prop := ∃ (f : γ → δ), Bijective f
infixl:60 " ≅ " => InBijection

def circ (f : α → β) : (β → γ) → (α → γ) := fun v => v ∘ f

theorem identity (f : α → β) (u : β → γ) : circ f u = u ∘ f := by rfl

theorem comp_assoc (f : α → β) (g : β → γ) (h : γ → δ) : (h ∘ g) ∘ f = h ∘ g ∘ f := by rfl

theorem bij_comp (h : α ≅ β) : (α → γ) ≅ (β → γ) := by
  have ⟨f,h'⟩ := h
  have (g : Inverse f) := inverse f h'
  have invl : (circ f) ∘ (circ g.to_fun) = id := by
    apply funext
    intro (v: α → γ)
    dsimp
    rw [identity g.to_fun v, identity f (v ∘ g.to_fun)]
    rw [comp_assoc f g.to_fun v, g.invl]
    rfl
  have invr : (circ g.to_fun) ∘ (circ f) = id := by
    apply funext
    intro (v: β → γ)
    dsimp
    rw [identity f v, identity g.to_fun (v ∘ f)]
    rw [comp_assoc g.to_fun f v, g.invr]
    rfl
  have inj : Injective (circ g.to_fun) := has_left_inv_injective (circ g.to_fun) ⟨(circ f),invl⟩
  have surj : Surjective (circ g.to_fun) := has_right_inv_surjective (circ g.to_fun) ⟨(circ f),invr⟩
  exact ⟨circ g.to_fun,⟨inj,surj⟩⟩
end Func


import plane_separation_world.level05 --hide
open IncidencePlane --hide

/-
# Plane Separation World

## Level 6: on the way to the final level (III).

This is the third of five lemmas that we need to prove before jumping into the final level of the game! You will be provided with
its mathematical proof in paper right below. Remember that you can use all the theorem statements from the left-hand side box.

## Mathematical proof in paper...

**Claim:** Given a line ℓ and the segments A·B and B·C, if both segments are on the same side of ℓ, then `A ∉ ℓ ∧ B ∉ ℓ ∧ C ∉ ℓ`.

**Proof:**

By the lemma `not_in_line_of_same_side_left`, since the points A and B are on the same side of ℓ, then `A ∉ ℓ`.

By the lemma `not_in_line_of_same_side_right`, since the points A and B are on the same side of ℓ, then `B ∉ ℓ`.

By the lemma `not_in_line_of_same_side_right`, since the points B and C are on the same side of ℓ, then `C ∉ ℓ`.

Hence, we have shown that `A ∉ ℓ ∧ B ∉ ℓ ∧ C ∉ ℓ`.
-/

/- Hint : Click here for a hint, in case you get stuck.
Starting the proof by typing `repeat {split},` may get you going. In case you feel bewildered, do not hesitate
to click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
Given a line ℓ and the segments A·B and B·C, if both segments are on the same side of ℓ, then `A ∉ ℓ ∧ B ∉ ℓ ∧ C ∉ ℓ`.
-/
lemma same_side_of_noncollinear_ne_line (hlAB : same_side ℓ A B) (hlBC : same_side ℓ B C) :
A ∉ ℓ ∧ B ∉ ℓ ∧ C ∉ ℓ :=
begin
  repeat {split},
  apply not_in_line_of_same_side_left hlAB,
  apply not_in_line_of_same_side_right hlAB,
  apply not_in_line_of_same_side_right hlBC,
end


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Eric Rodriguez
-/

import algebra.group_power.lemmas
import algebra.order.field
import data.nat.cast
import data.nat.choose.basic

/-!
# Inequalities for binomial coefficients

This file proves exponential bounds on binomial coefficients. We might want to add here the
bounds `n^r/r^r ≤ n.choose r ≤ e^r n^r/r^r` in the future.

## Main declarations

* `nat.choose_le_pow`: `n.choose r ≤ n^r / r!`
* `nat.pow_le_choose`: `(n + 1 - r)^r / r! ≤ n.choose r`. Beware of the fishy ℕ-subtraction.
-/

open_locale nat

variables {α : Type*} [linear_ordered_field α]

namespace nat

lemma choose_le_pow (r n : ℕ) : (n.choose r : α) ≤ n^r / r! :=
begin
  rw le_div_iff',
  { norm_cast,
    rw ←nat.desc_factorial_eq_factorial_mul_choose,
    exact n.desc_factorial_le_pow r },
  exact_mod_cast r.factorial_pos,
end

-- horrific casting is due to ℕ-subtraction
lemma pow_le_choose (r n : ℕ) : ((n + 1 - r : ℕ)^r : α) / r! ≤ n.choose r :=
begin
  rw div_le_iff',
  { norm_cast,
    rw [←nat.desc_factorial_eq_factorial_mul_choose],
    exact n.pow_sub_le_desc_factorial r },
  exact_mod_cast r.factorial_pos,
end

end nat


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import set_theory.cardinal.ordinal

/-!
# Cardinality of continuum

In this file we define `cardinal.continuum` (notation: `𝔠`, localized in `cardinal`) to be `2 ^ ℵ₀`.
We also prove some `simp` lemmas about cardinal arithmetic involving `𝔠`.

## Notation

- `𝔠` : notation for `cardinal.continuum` in locale `cardinal`.
-/

namespace cardinal

universes u v

open_locale cardinal

/-- Cardinality of continuum. -/
def continuum : cardinal.{u} := 2 ^ aleph_0.{u}

localized "notation `𝔠` := cardinal.continuum" in cardinal

@[simp] lemma two_power_aleph_0 : 2 ^ aleph_0.{u} = continuum.{u} := rfl

@[simp] lemma lift_continuum : lift.{v} 𝔠 = 𝔠 :=
by rw [←two_power_aleph_0, lift_two_power, lift_aleph_0, two_power_aleph_0]

/-!
### Inequalities
-/

lemma aleph_0_lt_continuum : ℵ₀ < 𝔠 := cantor ℵ₀

lemma aleph_0_le_continuum : ℵ₀ ≤ 𝔠 := aleph_0_lt_continuum.le

lemma nat_lt_continuum (n : ℕ) : ↑n < 𝔠 := (nat_lt_aleph_0 n).trans aleph_0_lt_continuum

lemma mk_set_nat : #(set ℕ) = 𝔠 := by simp

lemma continuum_pos : 0 < 𝔠 := nat_lt_continuum 0

lemma continuum_ne_zero : 𝔠 ≠ 0 := continuum_pos.ne'

lemma aleph_one_le_continuum : aleph 1 ≤ 𝔠 :=
by { rw ←succ_aleph_0, exact order.succ_le_of_lt aleph_0_lt_continuum }

@[simp] theorem continuum_to_nat : continuum.to_nat = 0 :=
to_nat_apply_of_aleph_0_le aleph_0_le_continuum

@[simp] theorem continuum_to_enat : continuum.to_enat = ⊤ :=
to_enat_apply_of_aleph_0_le aleph_0_le_continuum

/-!
### Addition
-/

@[simp] lemma aleph_0_add_continuum : ℵ₀ + 𝔠 = 𝔠 :=
add_eq_right aleph_0_le_continuum aleph_0_le_continuum

@[simp] lemma continuum_add_aleph_0 : 𝔠 + ℵ₀ = 𝔠 :=
(add_comm _ _).trans aleph_0_add_continuum

@[simp] lemma continuum_add_self : 𝔠 + 𝔠 = 𝔠 :=
add_eq_right aleph_0_le_continuum le_rfl

@[simp] lemma nat_add_continuum (n : ℕ) : ↑n + 𝔠 = 𝔠 :=
add_eq_right aleph_0_le_continuum (nat_lt_continuum n).le

@[simp] lemma continuum_add_nat (n : ℕ) : 𝔠 + n = 𝔠 :=
(add_comm _ _).trans (nat_add_continuum n)

/-!
### Multiplication
-/

@[simp] lemma continuum_mul_self : 𝔠 * 𝔠 = 𝔠 :=
mul_eq_left aleph_0_le_continuum le_rfl continuum_ne_zero

@[simp] lemma continuum_mul_aleph_0 : 𝔠 * ℵ₀ = 𝔠 :=
mul_eq_left aleph_0_le_continuum aleph_0_le_continuum aleph_0_ne_zero

@[simp] lemma aleph_0_mul_continuum : ℵ₀ * 𝔠 = 𝔠 :=
(mul_comm _ _).trans continuum_mul_aleph_0

@[simp] lemma nat_mul_continuum {n : ℕ} (hn : n ≠ 0) : ↑n * 𝔠 = 𝔠 :=
mul_eq_right aleph_0_le_continuum (nat_lt_continuum n).le (nat.cast_ne_zero.2 hn)

@[simp] lemma continuum_mul_nat {n : ℕ} (hn : n ≠ 0) : 𝔠 * n = 𝔠 :=
(mul_comm _ _).trans (nat_mul_continuum hn)

/-!
### Power
-/

@[simp] lemma aleph_0_power_aleph_0 : aleph_0.{u} ^ aleph_0.{u} = 𝔠 :=
power_self_eq le_rfl

@[simp] lemma nat_power_aleph_0 {n : ℕ} (hn : 2 ≤ n) : (n ^ aleph_0.{u} : cardinal.{u}) = 𝔠 :=
nat_power_eq le_rfl hn

@[simp] lemma continuum_power_aleph_0 : continuum.{u} ^ aleph_0.{u} = 𝔠 :=
by rw [←two_power_aleph_0, ←power_mul, mul_eq_left le_rfl le_rfl aleph_0_ne_zero]

end cardinal


import .natural
import .integer

--
-- So here we make use of two new features, quotients and subtypes
--
--  Given a type α an a property p: α → Prop we can define a new type
--  { a: α // p a }, which is a type where each element is of the form
--  ⟨a, h⟩, where a : α and h : p a.
--
--  Given a type α and a relation r: α → α → Prop we have new properties
--    * reflexive r := (∀ a : α, r a a)
--    * symmetric r := (∀ a b : α, r a b ↔ r b a)
--    * transitive r := (∀ a b c : α, r a b ∧ r b c → r a c)
--    * equivalence r := reflexive r ∧ symmetric r ∧ transitive r
--
--  Given a type α, a relation r: α → α → Prop and a proof h: equivalence r
--    * s: setoid α is an instance which can be defined as ⟨r, h⟩
--    * and this defines a new type quotient s
--    * given any a : α we have ⟦a⟧ : quotient s
--    * given any a b : α we have the notation a ≈ b := r a b
--    * given any a b : α quotient.sound is a proof a ≈ b → ⟦a⟧ = ⟦b⟧
--    * given any a b : α quotient.exact is a proof ⟦a⟧ = ⟦b⟧ → a ≈ b
--    * given any f: α → α and a proof h: ∀ a b : α, a ≈ b → f a ≈ f b then
--      given x : quotient s, then quotient.lift_on x f h : quotient s, defined
--      such that quotient.lift_on ⟦a⟧ f h = ⟦f a⟧
--    * given any p: (quotient s) → Prop and a proof h: ∀ a : α, p ⟦a⟧ then
--      for any x : (quotient s), quotient.induction_on x h is a proof of p x
--
--   quotient.lift_on₂ and quotient.lift_on₃ are shorthands for using quotient.lift_on
--   repeatedly on a function α → α → α or α → α → α → α respectively.
--

-- Here we go! Fractions!

structure int_nat_pair := (n: 𝐙) (d: 𝐍)

def fraction := {x: int_nat_pair // (x.d ≠ 0)}

namespace fraction

open fraction

def n: fraction → 𝐙 := λ x: fraction, x.val.n

def d: fraction → 𝐍 := λ x: fraction, x.val.d

def nz (x: fraction): (x.d ≠ 0) := x.2

protected lemma eq: ∀ {x y : fraction}, x.n = y.n → x.d = y.d → x = y
| ⟨⟨xn, xd⟩, hx⟩ ⟨⟨.(xn), .(xd)⟩, hy⟩ rfl rfl := rfl

def equiv (x y: fraction): Prop := x.n * y.d = y.n * x.d

lemma equiv_refl: reflexive equiv := assume x: fraction, eq.refl (x.n * x.d)

lemma equiv_symm: symmetric equiv :=
    assume x y: fraction,
    assume h: x.n * ↑y.d = y.n * ↑x.d,
    eq.symm h

lemma equiv_trans: transitive equiv :=
    assume x y z: fraction,
    assume hxy: x.n * ↑y.d = y.n * ↑x.d,
    assume hyz: y.n * ↑z.d = z.n * ↑y.d,
    have hnz: (integer.from_natural y.d) ≠ 0, from
        assume hc,
        have y.d = 0, by injection hc,
        absurd this y.nz,
    if hyn: y.n = 0 then
        have hxy: x.n * ↑y.d = 0 * ↑y.d, from calc
            x.n * ↑y.d = y.n * ↑x.d  : by rw hxy
            ...        = 0 * ↑x.d    : by rw hyn
            ...        = 0           : by rw integer.zero_mult
            ...        = 0 * ↑y.d    : by rw integer.zero_mult,
        have hyz: z.n * ↑y.d = 0 * ↑y.d, from calc
            z.n * ↑y.d = y.n * ↑z.d  : by rw hyz
            ...        = 0 * ↑z.d    : by rw hyn
            ...        = 0           : by rw integer.zero_mult
            ...        = 0 * ↑y.d    : by rw integer.zero_mult,
        have hxy: x.n = 0, from integer.mult_elim_right hnz hxy,
        have hyz: z.n = 0, from integer.mult_elim_right hnz hyz,
        calc
            x.n * ↑z.d = 0 * ↑z.d   : by rw hxy
            ...        = 0          : by rw integer.zero_mult
            ...        = 0 * ↑x.d   : by rw integer.zero_mult
            ...        = z.n * ↑x.d : by rw hyz
    else
        have y.n * ↑y.d ≠ 0, from
            assume hc: y.n * ↑y.d = 0,
            have hc: y.n * ↑y.d = 0 * ↑y.d, from
                calc
                    y.n * ↑y.d = 0        : by rw hc
                    ...        = ↑y.d * 0 : by rw integer.mult_zero ↑y.d
                    ...        = 0 * ↑y.d : by rw integer.mul_com ↑y.d,
            have y.n = 0, from integer.mult_elim_right hnz hc,
            absurd ‹y.n = 0› hyn,
        suffices (x.n * ↑z.d) * (y.n * ↑y.d) = (z.n * ↑x.d) * (y.n * ↑y.d), from integer.mult_elim_right ‹y.n * ↑y.d ≠ 0› this,
        calc
            (x.n * ↑z.d) * (y.n * ↑y.d) = (x.n * ↑y.d) * (y.n * ↑z.d)  : by rw [integer.mul_com y.n, integer.mul_asoc, ←integer.mul_asoc x.n, integer.mul_com (↑z.d), integer.mul_asoc, ←integer.mul_asoc, integer.mul_com (↑z.d)]
            ...                         = (y.n * ↑x.d) * (z.n * ↑y.d)  : by rw [hxy, hyz]
            ...                         = (z.n * ↑x.d) * (y.n * ↑y.d)  : by rw [integer.mul_asoc, ←integer.mul_asoc y.n, integer.mul_com (↑x.d), integer.mul_com y.n, integer.mul_asoc]

lemma equiv_equiv: equivalence equiv := ⟨equiv_refl, equiv_symm, equiv_trans⟩

instance fraction_setoid: setoid fraction := ⟨equiv, equiv_equiv⟩

instance equiv_decidable: ∀ x y: fraction, decidable (x ≈ y) :=
    assume x y: fraction,
    if h: x.n*y.d = y.n*x.d then
        is_true h
    else
        is_false h

def add (x y: fraction): fraction := ⟨⟨((x.n * y.d) + (y.n * x.d)), (x.d*y.d)⟩, natural.mult_nz x.nz y.nz⟩
instance fraction_has_add: has_add fraction  := ⟨add⟩

lemma add_asoc (x y z : fraction): (x + y) + z = x + (y + z) :=
have hn: ((x + y) + z).n = (x + (y + z)).n, from (
    calc
        ((x + y) + z).n = (x+y).n*z.d + z.n*(x+y).d                    : by refl
        ...             = (x.n*y.d + y.n*x.d)*z.d + z.n*(x.d*y.d)      : by refl
        ...             = x.n*y.d*z.d + y.n*x.d*z.d + z.n*x.d*y.d      : by simp only [integer.add_mult, integer.mul_asoc]
        ...             = x.n*(y.d*z.d) + (y.n*x.d*z.d + z.n*x.d*y.d)  : by rw [integer.add_asoc, integer.mul_asoc]
        ...             = x.n*(y.d*z.d) + (y.n*z.d*x.d + z.n*y.d*x.d)  : by rw [←integer.mul_asoc y.n, integer.mul_com x.d, integer.mul_asoc y.n, ←integer.mul_asoc z.n, integer.mul_com x.d, integer.mul_asoc z.n]
        ...             = x.n*(y.d*z.d) + (y.n*z.d + z.n*y.d)*x.d      : by rw integer.add_mult
        ...             = x.n*(y + z).d + (y + z).n*x.d                : by refl
        ...             = (x + (y + z)).n                              : by refl
),
have hd: ((x + y) + z).d = (x + (y + z)).d, from (show x.d*y.d*z.d = x.d*(y.d*z.d), by rw natural.mult_asoc),
fraction.eq hn hd

lemma add_com (x y : fraction): x + y = y + x :=
have hn: (x + y).n = (y + x).n, from (show x.n*y.d + y.n*x.d = y.n*x.d + x.n*y.d, by rw integer.add_com),
have hd: (x + y).d = (y + x).d, from (show x.d*y.d = y.d*x.d, by rw natural.mult_com),
fraction.eq hn hd

lemma add_invariant (x₁ y₁ x₂ y₂: fraction): x₁ ≈ x₂ → y₁ ≈ y₂ → ⟦x₁+y₁⟧ = ⟦x₂+y₂⟧ :=
    assume hx: x₁.n * x₂.d = x₂.n * x₁.d,
    assume hy: y₁.n * y₂.d = y₂.n * y₁.d,
    suffices (x₁+y₁).n * (x₂+y₂).d = (x₂+y₂).n * (x₁+y₁).d, from quotient.sound this,
    calc
        (x₁+y₁).n * (x₂+y₂).d = ((x₁.n * y₁.d) + (y₁.n * x₁.d)) * (x₂.d * y₂.d)            : by refl
        ...                   = (x₁.n * y₁.d)*(x₂.d * y₂.d) + (y₁.n * x₁.d)*(x₂.d * y₂.d)  : by rw integer.add_mult
        ...                   = (x₁.n * y₁.d)*(x₂.d * y₂.d) + (y₁.n * x₁.d)*(y₂.d * x₂.d)  : by rw integer.mul_com x₂.d
        ...                   = ((x₁.n * y₁.d)*x₂.d)*y₂.d + ((y₁.n * x₁.d)*y₂.d)*x₂.d      : by rw [integer.mul_asoc, integer.mul_asoc]
        ...                   = (x₁.n*(y₁.d*x₂.d))*y₂.d + (y₁.n*(x₁.d*y₂.d))*x₂.d          : by rw [integer.mul_asoc, integer.mul_asoc]
        ...                   = (x₁.n*(x₂.d*y₁.d))*y₂.d + (y₁.n*(y₂.d*x₁.d))*x₂.d          : by rw [integer.mul_com (y₁.d), integer.mul_com (x₁.d)]
        ...                   = (x₁.n*x₂.d)*(y₁.d*y₂.d) + (y₁.n*y₂.d)*(x₁.d*x₂.d)          : by rw [integer.mul_asoc, integer.mul_asoc, integer.mul_asoc, integer.mul_asoc]
        ...                   = (x₂.n*x₁.d)*(y₁.d*y₂.d) + (y₂.n*y₁.d)*(x₁.d*x₂.d)          : by rw [hx, hy]
        ...                   = (x₂.n*y₂.d)*(x₁.d*y₁.d) + (y₂.n*y₁.d)*(x₁.d*x₂.d)          : by rw [integer.mul_com y₁.d, integer.mul_asoc, ←integer.mul_asoc x₂.n, integer.mul_com x₁.d, integer.mul_asoc, ←integer.mul_asoc]
        ...                   = (x₂.n*y₂.d)*(x₁.d*y₁.d) + (y₂.n*y₁.d)*(x₂.d*x₁.d)          : by rw [←integer.mul_com x₁.d]
        ...                   = (x₂.n*y₂.d)*(x₁.d*y₁.d) + (y₂.n*x₂.d)*(x₁.d*y₁.d)          : by rw [integer.mul_asoc (y₂.n*y₁.d), ←integer.mul_asoc y₂.n, integer.mul_com y₁.d, integer.mul_asoc y₂.n, ←integer.mul_asoc (y₂.n*x₂.d), integer.mul_com y₁.d]
        ...                   = ((x₂.n*y₂.d)+(y₂.n*x₂.d))*(x₁.d*y₁.d)                      : by rw integer.add_mult
        ...                   = (x₂+y₂).n * (x₁+y₁).d                                      : by refl

def neg (x: fraction): fraction := ⟨⟨-x.n, x.d⟩, x.nz⟩
instance fraction_has_neg: has_neg fraction  := ⟨neg⟩

lemma neg_invariant (x y: fraction): x ≈ y → ⟦-x⟧ = ⟦-y⟧ :=
    assume h: x.n * y.d = y.n * x.d,
    suffices -x.n * y.d = -y.n * x.d, from quotient.sound this,
    calc
        -x.n * y.d = -(x.n * y.d)  : by rw integer.neg_mult
        ...        = -(y.n * x.d)  : by rw h
        ...        = -y.n * x.d    : by rw integer.neg_mult

lemma neg_neg (x: fraction): -(-x) = x :=
    suffices (-(-x)).n = x.n, from fraction.eq this rfl,
    show -(-x.n) = x.n, by rw ←integer.neg_neg x.n

#check integer.to_UnitRing.mul_one

lemma neg_add (x: fraction): -x + x ≈ ⟨⟨0, 1⟩, assume h, natural.no_confusion h⟩ :=
calc
    ((-(x.n))*↑x.d + x.n*↑x.d)*1  = (-(x.n))*↑x.d + x.n*↑x.d      : by rw integer.to_UnitRing.mul_one
    ...                           = (-(x.n) + x.n)*↑x.d           : by rw ←integer.to_Ring.add_mul
    ...                           = (0)*↑x.d                      : by rw integer.to_Ring.neg_add
    ...                           = 0                             : by rw integer.to_Ring.zero_mul
    ...                           = 0*(-x + x).d                  : by rw integer.to_Ring.zero_mul

def mult (x y: fraction): fraction := ⟨⟨x.n * y.n, x.d * y.d⟩, natural.mult_nz x.nz y.nz⟩
instance fraction_has_mult: has_mul fraction := ⟨mult⟩

lemma mult_invariant (x₁ y₁ x₂ y₂: fraction): x₁ ≈ x₂ → y₁ ≈ y₂ → ⟦x₁*y₁⟧ = ⟦x₂*y₂⟧ :=
    assume hx: x₁.n * x₂.d = x₂.n * x₁.d,
    assume hy: y₁.n * y₂.d = y₂.n * y₁.d,
    suffices (x₁.n*y₁.n)*(x₂.d*y₂.d) = (x₂.n*y₂.n)*(x₁.d*y₁.d), from quotient.sound this,
    calc
        (x₁.n*y₁.n)*(x₂.d*y₂.d) = (x₁.n*x₂.d)*(y₁.n*y₂.d)  : by simp
        ...                     = (x₂.n*x₁.d)*(y₂.n*y₁.d)  : by rw [hx, hy]
        ...                     = (x₂.n*y₂.n)*(x₁.d*y₁.d)  : by simp

lemma mult_asoc (x y z: fraction): (x * y) * z = x * (y * z) :=
    have hn: ((x*y)*z).n = (x*(y*z)).n, from (show (x.n*y.n)*z.n = x.n*(y.n*z.n), by rw integer.mul_asoc),
    have hd: ((x*y)*z).d = (x*(y*z)).d, from (show (x.d*y.d)*z.d = x.d*(y.d*z.d), by rw natural.mult_asoc),
    fraction.eq hn hd

lemma mult_com (x y: fraction): x * y = y * x :=
    have hn: (x*y).n = (y*x).n, from (show x.n*y.n = y.n*x.n, by rw integer.mul_com),
    have hd: (x*y).d = (y*x).d, from (show x.d*y.d = y.d*x.d, by rw natural.mult_com),
    fraction.eq hn hd

def non_zero_fraction := {f: fraction // (f.n ≠ 0)}
def inv (x: non_zero_fraction): non_zero_fraction :=
    have (integer.sgn x.val.n) * x.val.d ≠ 0, from integer.nz_mult_nz_nz (mt (iff.elim_right integer.sgn_zero) x.property) (integer.nz_impl_coe_nz x.val.nz),
    ⟨⟨⟨(integer.sgn x.val.n) * x.val.d, integer.abs x.val.n⟩, mt (iff.elim_right integer.abs_zero) x.property⟩, by assumption⟩

lemma inv_invariant {x y: non_zero_fraction}: x.val ≈ y.val → (inv x).val ≈ (inv y).val :=
    assume h: x.val.n*y.val.d = y.val.n*x.val.d,
    have hsgn: integer.sgn x.val.n = integer.sgn y.val.n, from (
        calc
            integer.sgn x.val.n = integer.sgn (x.val.n * y.val.d)   : by rw integer.sgn_mult_nat y.val.nz
            ...                 = integer.sgn (y.val.n * x.val.d)   : by rw h
            ...                 = integer.sgn y.val.n               : by rw ←integer.sgn_mult_nat x.val.nz
    ),
    calc
        (inv x).val.n*(inv y).val.d = (integer.sgn x.val.n * x.val.d)*(integer.abs y.val.n)  : by refl
        ...                         = (integer.sgn x.val.n * integer.abs y.val.n) * x.val.d  : by rw [←integer.mul_asoc, integer.mul_com (x.val.d), integer.mul_asoc]
        ...                         = (integer.sgn y.val.n * integer.abs y.val.n) * x.val.d  : by rw [hsgn]
        ...                         = y.val.n * x.val.d                                      : by rw integer.sgn_mult_abs
        ...                         = x.val.n * y.val.d                                      : by rw h
        ...                         = (integer.sgn x.val.n * integer.abs x.val.n) * y.val.d  : by rw integer.sgn_mult_abs
        ...                         = (integer.sgn y.val.n * integer.abs x.val.n) * y.val.d  : by rw hsgn
        ...                         = (integer.sgn y.val.n * y.val.d) * integer.abs x.val.n  : by rw [←integer.mul_asoc, ←integer.mul_com (y.val.d), integer.mul_asoc]
        ...                         = (inv y).val.n*(inv x).val.d                            : by refl

def over_one (x: 𝐙): fraction := ⟨⟨x, 1⟩, assume h, natural.no_confusion h⟩

lemma int_mult (a: 𝐙) (y: fraction): (over_one a) * y = ⟨⟨a*y.n, y.d⟩, y.nz⟩ := show (⟨⟨a*y.n, 1*y.d⟩, natural.mult_nz (assume h, natural.no_confusion h) (y.nz)⟩ : fraction) = ⟨⟨a*y.n, y.d⟩, y.nz⟩, from fraction.eq (rfl) (natural.one_mult y.d)

end fraction

def rational: Type := quotient fraction.fraction_setoid

notation `𝐐` := rational

namespace rational

open rational

notation n `÷` d := ⟦⟨⟨n, d⟩, (assume h, natural.no_confusion h)⟩⟧

instance has_coe_integer_rational: has_coe integer rational := ⟨assume n: 𝐙, (n ÷ 1)⟩

def zero : 𝐐 := ↑(0: 𝐙)
def one  : 𝐐 := ↑(1: 𝐙)

instance rational_has_zero: has_zero rational := ⟨zero⟩
instance rational_has_one: has_one rational := ⟨one⟩
instance rational_has_zero_: has_zero (quotient fraction.fraction_setoid) := ⟨zero⟩
instance rational_has_one_: has_one (quotient fraction.fraction_setoid) := ⟨one⟩

instance rational_of_fraction_decidable_equality (x y : fraction): decidable (⟦x⟧ = ⟦y⟧) :=
    if h: x ≈ y then is_true (quotient.sound h) else is_false (mt quotient.exact h)

protected lemma eq {x y: fraction} (h: x.n*y.d = y.n*x.d): ⟦x⟧ = ⟦y⟧ := suffices x ≈ y, from quotient.sound this, h

lemma eq_zero {x: fraction}: ⟦x⟧ = 0 ↔ x.n = 0 :=
iff.intro (
    assume h: ⟦x⟧ = 0,
    have h: x ≈ ⟨⟨0, 1⟩, (assume h, natural.no_confusion h)⟩, from quotient.exact h,
    have h: x.n*1 = 0*x.d, from h,
    show x.n = 0, by rw [←integer.mult_one x.n, h, integer.zero_mult]
) (
    assume h: x.n = 0,
    suffices x ≈ ⟨⟨0, 1⟩, (assume h, natural.no_confusion h)⟩, from quotient.sound this,
    show x.n*1 = 0*x.d, by rw [integer.mult_one, h, integer.zero_mult]
)

lemma zero_ne_one: rational.zero ≠ rational.one :=
    assume h: (0 : rational) = ⟦⟨⟨1, 1⟩, assume h, natural.no_confusion h⟩⟧,
    have h: fraction.n (⟨⟨1, 1⟩, assume h, natural.no_confusion h⟩ : fraction) = 0, from iff.elim_left eq_zero (eq.symm h),
    have h: (1 : 𝐙) = 0, from h,
    have h: (1 : 𝐍) = 0, by injection h,
    natural.no_confusion h

-- addition

def add (x y: 𝐐): 𝐐 := quotient.lift_on₂ x y (λ f g: fraction, ⟦f + g⟧) fraction.add_invariant
instance rational_has_add: has_add rational := ⟨add⟩
instance rational_has_add_: has_add (quotient fraction.fraction_setoid) := ⟨add⟩

lemma add_asoc (x y z: 𝐐): (x + y) + z = x + (y + z) := quotient.induction_on₃ x y z (assume a b c: fraction, show ⟦(a+b)+c⟧ = ⟦a+(b+c)⟧, by rw fraction.add_asoc)
lemma add_com (x y: 𝐐): x + y = y + x := quotient.induction_on₂ x y (assume a b: fraction, show ⟦a+b⟧ = ⟦b+a⟧, by rw fraction.add_com)
lemma zero_add (x: 𝐐): 0 + x = x := quotient.induction_on x (
    assume ⟨⟨n, d⟩, hnz⟩,
    suffices (⟨⟨0, 1⟩, assume h, natural.no_confusion h⟩ + ⟨⟨n, d⟩, hnz⟩ : fraction) ≈ ⟨⟨n, d⟩, hnz⟩, from quotient.sound this,
    suffices (⟨⟨0, 1⟩, assume h, natural.no_confusion h⟩ + ⟨⟨n, d⟩, hnz⟩ : fraction) = ⟨⟨n, d⟩, hnz⟩, from (eq.symm this) ▸ (fraction.equiv_refl ⟨⟨n, d⟩, hnz⟩),
    suffices (⟨⟨0, 1⟩, assume h, natural.no_confusion h⟩ + ⟨⟨n, d⟩, hnz⟩ : fraction).n = n ∧ (⟨⟨0, 1⟩, assume h, natural.no_confusion h⟩ + ⟨⟨n, d⟩, hnz⟩ : fraction).d = d, from fraction.eq this.left this.right,
    and.intro (
        calc
            (⟨⟨0, 1⟩, assume h, natural.no_confusion h⟩ + ⟨⟨n, d⟩, hnz⟩ : fraction).n = 0*d + n*1  : by refl
            ...                                                                       = 0 + n*1    : by rw integer.to_Ring.zero_mul
            ...                                                                       = n*1        : by rw integer.to_Ring.zero_add
            ...                                                                       = n          : by rw integer.to_UnitRing.mul_one
    ) (
        calc
            (⟨⟨0, 1⟩, assume h, natural.no_confusion h⟩ + ⟨⟨n, d⟩, hnz⟩ : fraction).d = 1*d  : by refl
            ...                                                                       = d    : by rw natural.one_mult
    )
)

-- negation

def neg (x : 𝐐): 𝐐 := quotient.lift_on x (λ f:fraction, ⟦-f⟧) fraction.neg_invariant
instance rational_has_neg: has_neg rational := ⟨neg⟩

lemma neg_neg (x : 𝐐): -(-x) = x := quotient.induction_on x (assume a: fraction, show ⟦-(-a)⟧ = ⟦a⟧, by rw fraction.neg_neg)
lemma neg_add (x : 𝐐): -x + x = 0 := quotient.induction_on x (
    assume a: fraction,
    suffices -a + a ≈ ⟨⟨0, 1⟩, (assume h, natural.no_confusion h)⟩, from quotient.sound this,
    fraction.neg_add a
)

-- subtraction

def sub (x y: 𝐐): 𝐐 := x + -y

-- multiplication

def mult (x y: 𝐐): 𝐐 := quotient.lift_on₂ x y (λ f g: fraction, ⟦f*g⟧) fraction.mult_invariant
instance rational_has_mult: has_mul rational := ⟨mult⟩
instance rational_has_mult_: has_mul (quotient fraction.fraction_setoid) := ⟨mult⟩

lemma mult_asoc (x y z: 𝐐): (x*y)*z = x*(y*z) := quotient.induction_on₃ x y z (assume a b c: fraction, show ⟦(a*b)*c⟧ = ⟦a*(b*c)⟧, by rw fraction.mult_asoc)
lemma mult_com (x y: 𝐐): x*y = y*x := quotient.induction_on₂ x y (assume a b: fraction, show ⟦a*b⟧ = ⟦b*a⟧, by rw fraction.mult_com)

lemma one_mult (x: 𝐐): 1*x = x := quotient.induction_on x (
    assume y,
    show ⟦(fraction.over_one 1) * y⟧ = ⟦y⟧, from
    suffices (⟦⟨⟨1*y.n, y.d⟩, y.nz⟩⟧ : rational) = ⟦y⟧, from calc
        ⟦(fraction.over_one 1) * y⟧ = ⟦⟨⟨1*y.n, y.d⟩, y.nz⟩⟧ : by rw ←fraction.int_mult 1
        ...                        =  ⟦y⟧  : by rw this
    ,
    rational.eq (
        show 1 * y.n * y.d = y.n * y.d, by rw integer.to_UnitRing.one_mul
    )
)
lemma mult_add (x y z: 𝐐): z*(x + y) = z*x + z*y := quotient.induction_on₃ x y z (
    assume a b c : fraction,
    show ⟦c * (a + b)⟧ = ⟦c*a + c*b⟧, from
    suffices (c* (a + b)).n * (c*a + c*b).d = (c*a + c*b).n * (c* (a + b)).d, from rational.eq this,
    calc
        (c* (a + b)).n * (c*a + c*b).d = (c.n * (a.n*b.d + b.n*a.d)) * ((c.d*a.d)*(c.d*b.d))         : by refl
        ...                            = (c.n*(a.n*b.d) + c.n*(b.n*a.d)) * ((c.d*a.d)*(c.d*b.d))     : by rw Ring.mul_add
        ...                            = ((c.n*a.n)*b.d + (c.n*b.n)*a.d) * ((c.d*a.d)*(c.d*b.d))     : by rw [Ring.mul_assoc 𝐙 c.n, Ring.mul_assoc 𝐙 c.n]
        ...                            = (((c.n*a.n)*b.d + (c.n*b.n)*a.d) * c.d)*(a.d*(c.d*b.d))     : by rw [Ring.mul_assoc 𝐙 c.d, Ring.mul_assoc 𝐙 ((c.n*a.n)*b.d + (c.n*b.n)*a.d)]
        ...                            = ((c.n*a.n)*b.d*c.d + (c.n*b.n)*a.d*c.d)*(a.d*(c.d*b.d))     : by rw [Ring.add_mul]
        ...                            = ((c.n*a.n)*(b.d*c.d) + (c.n*b.n)*(a.d*c.d))*(a.d*(c.d*b.d)) : by rw [Ring.mul_assoc 𝐙, Ring.mul_assoc 𝐙 (c.n*b.n)]
        ...                            = ((c.n*a.n)*(c.d*b.d) + (c.n*b.n)*(c.d*a.d))*(a.d*(c.d*b.d)) : by rw [CommRing.mul_comm 𝐙 b.d, CommRing.mul_comm 𝐙 a.d]
        ...                            = ((c*a).n*(c*b).d + (c*b).n*(c*a).d)*(a.d*(c.d*b.d))         : by refl
        ...                            = (c*a + c*b).n*(a.d*(c.d*b.d))                               : by refl
        ...                            = (c*a + c*b).n*((a.d*c.d)*b.d)                               : by rw [Ring.mul_assoc 𝐙]
        ...                            = (c*a + c*b).n*((c.d*a.d)*b.d)                               : by rw [CommRing.mul_comm 𝐙 a.d]
        ...                            = (c*a + c*b).n*(c.d*(a.d*b.d))                               : by rw [Ring.mul_assoc 𝐙]
        ...                            = (c*a + c*b).n * (c* (a + b)).d                              : by refl
)
lemma no_zero_divisors (x y : 𝐐): x*y = 0 → x ≠ 0 → y = 0 := quotient.induction_on₂ x y (
    assume a b : fraction,
    assume h: ⟦a * b⟧ = 0,
    assume ha: ⟦a⟧ ≠ 0,
    have h: (a * b).n = 0, from iff.elim_left eq_zero h,
    have h: a.n * b.n = 0, from h,
    have ha: a.n ≠ 0, from (mt (iff.elim_right eq_zero)) ha,
    suffices b.n = 0, from iff.elim_right eq_zero this,
    integer.to_NZDRing.no_zero_divisors h ha
)

-- inverse

private def inv_frac_rat (a: fraction) : 𝐐 :=
if h: a.n = 0 then
    (0: 𝐐)
else
    ⟦(fraction.inv ⟨a, h⟩).val⟧

lemma inv_frac_rat_nz (x: fraction): (x.n ≠ 0) → inv_frac_rat x = ⟦(fraction.inv ⟨x, ‹x.n ≠ 0›⟩).val⟧ :=
match x with
| ⟨⟨0, d⟩, h⟩                          := assume h, absurd (eq.refl 0) h
| ⟨⟨integer.from_natural (n+1), d⟩, h⟩ := assume h, by refl
| ⟨⟨-[n+1], d⟩, h⟩                     := assume h, by refl
end

lemma inv_frac_rat_invariant (a b: fraction): a ≈ b → inv_frac_rat a = inv_frac_rat b :=
assume h: a.n*b.d = b.n*a.d,
if ha: a.n = 0 then
    have hb: b.n = 0, from (
        suffices b.n*a.d = 0, from integer.mult_nz_eq_z_imp_z this (integer.nz_impl_coe_nz a.nz),
        calc
            b.n*a.d = a.n*b.d  : by rw h
            ...     = 0*b.d    : by rw ha
            ...     = 0        : by rw integer.zero_mult
    ),
    calc
        inv_frac_rat a = inv_frac_rat ⟨⟨a.n, a.d⟩, a.nz⟩  : by refl
        ...            = inv_frac_rat ⟨⟨0, a.d⟩, a.nz⟩    : by rw ha
        ...            = 0                                : by refl
        ...            = inv_frac_rat ⟨⟨0, b.d⟩, b.nz⟩    : by refl
        ...            = inv_frac_rat ⟨⟨b.n, b.d⟩, b.nz⟩  : by rw hb
        ...            = inv_frac_rat b                   : by refl
else
    have hb: b.n ≠ 0, from (
        assume hc: b.n = 0,
        suffices a.n = 0, from absurd this ha,
        suffices a.n*b.d = 0, from integer.mult_nz_eq_z_imp_z this (integer.nz_impl_coe_nz b.nz),
        calc
            a.n*b.d = b.n*a.d : by rw h
            ...     = 0*a.d   : by rw hc
            ...     = 0       : by rw integer.zero_mult
    ),
    have hs: (fraction.inv ⟨a, ha⟩).val ≈ (fraction.inv ⟨b, hb⟩).val, from fraction.inv_invariant h,
    calc
        inv_frac_rat a = ⟦(fraction.inv ⟨a, ha⟩).val⟧  : by rw inv_frac_rat_nz a ha
        ...            = ⟦(fraction.inv ⟨b, hb⟩).val⟧  : by rw quotient.sound hs
        ...            = inv_frac_rat b                : by rw inv_frac_rat_nz b hb

def inv (x: 𝐐): 𝐐 := quotient.lift_on x (λ f, inv_frac_rat f) inv_frac_rat_invariant
instance: has_inv 𝐐 := ⟨inv⟩

lemma inv_nz_is_nz {x: 𝐐}: x ≠ 0 → x⁻¹ ≠ 0 := quotient.induction_on x (
    assume a: fraction,
    assume ha: ⟦a⟧ ≠ 0,
    have ha: a.n ≠ 0, from mt (iff.elim_right eq_zero) ha,
    show inv_frac_rat a ≠ 0, from
    suffices ⟦(fraction.inv ⟨a, ha⟩).val⟧ ≠ 0, from eq.symm (inv_frac_rat_nz a ha) ▸ this,
    suffices (fraction.inv ⟨a, ha⟩).val.n ≠ 0, from mt (iff.elim_left eq_zero) this,
    assume hc: ((fraction.inv ⟨a, ha⟩).val).n = 0,
    suffices (a.d : 𝐍) = 0, from absurd this a.nz,
    suffices (a.d : 𝐙) = 0, by injection this,
    have hc: (integer.sgn a.n) * a.d = 0, from hc,
    have integer.sgn a.n ≠ 0, from mt (iff.elim_right integer.sgn_zero) ha,
    integer.to_NZDRing.no_zero_divisors hc ‹integer.sgn a.n ≠ 0›
)

lemma inv_mul {x: 𝐐}: x ≠ 0 → x⁻¹ * x = 1 := quotient.induction_on x (
    assume a: fraction,
    assume ha: ⟦a⟧ ≠ 0,
    have ha: a.n ≠ 0, from mt (iff.elim_right eq_zero) ha,
    show inv_frac_rat a * ⟦a⟧ = 1, from
    suffices ⟦(fraction.inv ⟨a, ha⟩).val⟧ * ⟦a⟧ = (1 : 𝐐), by rw [inv_frac_rat_nz, this],
    suffices ⟦(fraction.inv ⟨a, ha⟩).val * a⟧ = (1 : 𝐐), from this,
    suffices ((fraction.inv ⟨a, ha⟩).val * a).n*1 = 1*((fraction.inv ⟨a, ha⟩).val * a).d, from rational.eq this,
    calc
        ((fraction.inv ⟨a, ha⟩).val * a).n*1 = ((fraction.inv ⟨a, ha⟩).val * a).n                             : by rw integer.to_UnitRing.mul_one
        ...                                  = ((fraction.inv ⟨a, ha⟩).val).n * a.n                           : by refl
        ...                                  = (integer.sgn a.n * a.d) * a.n                                  : by refl
        ...                                  = (integer.sgn a.n * a.d) * (integer.sgn a.n * integer.abs a.n)  : by rw integer.sgn_mult_abs
        ...                                  = (integer.sgn a.n * integer.sgn a.n) * (integer.abs a.n * a.d)  : by rw [Ring.mul_assoc, CommRing.mul_comm 𝐙 a.d, Ring.mul_assoc, Ring.mul_assoc]
        ...                                  = 1 * (integer.abs a.n * a.d)                                    : by rw integer.sgn_mult_sgn ha
)

instance rational_decidable_equal: decidable_eq 𝐐 := quotient.decidable_eq

-- 𝐐 is a field
def to_Field: Field 𝐐 :=
{
    is_set := assume x y, if h:x = y then or.intro_left _ h else or.intro_right _ h,
    add_assoc := add_asoc,
    add_comm := add_com,
    left_zero := zero_add,
    left_neg := neg_add,
    mul_assoc := mult_asoc,
    mul_comm := mult_com,
    left_distrib := mult_add,
    left_one := one_mult,
    nzd := no_zero_divisors,
    inv_nz_is_nz := @inv_nz_is_nz,
    left_inv := @inv_mul,
    zero_ne_one := zero_ne_one,
}

end rational


-- Union_de_pares_e_impares.lean
-- Unión de pares e impares
-- José A. Alonso Jiménez
-- Sevilla, 31 de mayo de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Los conjuntos de los números naturales, de los pares y de los impares
-- se definen por
--    def naturales : set ℕ := {n | true}
--    def pares     : set ℕ := {n | even n}
--    def impares   : set ℕ := {n | ¬ even n}
--
-- Demostrar que
--    pares ∪ impares = naturales
-- ----------------------------------------------------------------------

import data.nat.parity
import data.set.basic
import tactic

open set

def naturales : set ℕ := {n | true}
def pares     : set ℕ := {n | even n}
def impares   : set ℕ := {n | ¬ even n}

-- 1ª demostración
-- ===============

example : pares ∪ impares = naturales :=
begin
  unfold pares impares naturales,
  ext n,
  simp,
  apply classical.em,
end

-- 2ª demostración
-- ===============

example : pares ∪ impares = naturales :=
begin
  unfold pares impares naturales,
  ext n,
  finish,
end

-- 3ª demostración
-- ===============

example : pares ∪ impares = naturales :=
by finish [pares, impares, naturales, ext_iff]


import tactic

/-
The goal for next week is to introduce the last major piece of the Lean language that's used
regularly in mathlib. This is the **type class** system. But before we do that, lets finish talking
about the underlying logic of Lean.

First recall how we got here: Proving theorems in Lean amounts to constructing terms of the right
type. For example we prove the next example four times. But fundamentall all 4 proofs are exactly
the same
-/
lemma lemma1 {P Q : Prop} (h : P ∧ Q) : Q ∧ P := and.intro (and.elim_right h) (and.elim_left h)

lemma lemma2 {P Q : Prop} (h : P ∧ Q) : Q ∧ P := and.intro (h.right) (h.left)

lemma lemma3 {P Q : Prop} : P ∧ Q → Q ∧ P := λh, ⟨h.2, h.1⟩

lemma lemma4 {P Q : Prop} : P ∧ Q → Q ∧ P :=
begin
intro h,
cases h with p q,
split,
exact q,
exact p,
end

#print lemma1
#print lemma2
#print lemma3
#print lemma4
/-
The expressiveness of Lean that allows it to formalize more complicated mathematics than just simple
logical puzzles like those above comes from its support for a couple of pieces of type theory:
**dependent types** and **inductive data types**.

Lets focus on dependent types first.
-/

/-
There are likely others, but in your daily life working on proofs in mathlib there are basically
only two kinds of dependent types you'll run into: _dependent products_ and _dependent sums_.

A dependent product is kind of like a function type, but the function's values map into different
places depending on the input. For example, consider the type of fixed-length lists:
-/
structure len_list (n : ℕ) :=
(carrier : list ℕ)
(len_eq_n : carrier.length = n)

#check len_list 3 -- List of natural numbers of length 3

/-
Consider the function which adds 0 to the front of a list
-/
def F (n : ℕ) : len_list n → len_list (n + 1) := λL,
{ carrier  := 0 :: L.carrier,
  len_eq_n := by simp [L.len_eq_n] } -- Notice we actually had to prove something!

#check F
/-
Note the type of `F`. The `Π` in the output is exactly the dependent product. Think about what you
would want the type of `F` to be... It takes an input `n : ℕ` and the output is a function type
`len_list n → len_list (n + 1)`. You would expect that this means the type of `F` should be

`ℕ → len_list n → len_list (n + 1)`

But of course this doesn't make sense because until we know the first argument, `n` has no meaning.
The way we should think about this is in terms of a _dependent product_ or _dependent function type_
In general, the dependent product is often times written as `Πα, β` in the CS literature which
confuses me until I realize that `β` can actually depend on

An even easier example that this shows up in is the `cons` function for lists (we usually write it
as `(::)`, for example `0 :: L.carrier` above)
-/

#check @list.cons
/-
Showing all the implicit arguments reveals that the `cons` function is a dependent type.

The way this appears in formalizing mathematics is in terms of the `∀` symbol. In fact, according
to lean `Π` and `∀` are synonyms. For example consider the following lemma
-/

example : ∀ (N : ℕ), N + 1 > N := lt_add_one
/-
The conclusion `N + 1 > N` is a type of type `Prop`, which _depends on a natural number N_. This is
exactly a _dependent function type_ of type `Πℕ, Prop`. he usual function type is just a dependent
function type where the output type does not depend on the input.

Why do we also use the dependent product terminology? We can kind of think of a dependent product
as a big infinite product over the input.
-/

/-
The other kind of dependent type is the _dependent sum_ type `Σ`. In this case, coming up with a non
contrived CS example is a little tough, so I'll jump straight to the _logical_ analogue `∃`.

Consider this example:
-/

example : ∃(M : ℕ), M > 2 := sorry

/-
Again, the type `M > 2` has type `Prop`, but it doesn't make sense unless we already have an `M : ℕ`
in context. In this case we say this example has type `Σℕ, Prop`.

In general the dependent product of the form `Σα, β` (here `β` could depend on `α`) is the type of
pairs `(a, b)` where `a : α` and `b : β(α)`. In the above example the type is all the pairs

`(3, by norm_num)`,
`(4, _)`,
`(5, _)`,
...
where the underscores can be filled in with any term proving `M > 2`.
-/

example : ∀(n : ℕ), ∃(M : ℕ), M > n := sorry

/-
Reasoning about these quantifiers almost always boils down to the following rules:

* Have a `∀` in my goal? Use `intro` to eliminate it.
-/
example : ∀ (N : ℕ), N + 1 > N :=
begin
  sorry
end

/-
* Have a `∀` in a hypothesis `h`, and want to use it in a particular instance `x`? Use
`specialize h x`
-/
example (f : ℕ → ℕ) (h1 : ∀(n : ℕ), f n > n) (h2 : ∀(n : ℕ), f n < n + 2) : ∀n , f n = n + 1 :=
begin
  sorry
end
/-
* Have a `∃` in a goal? Find some witness of the property `x` and `use x`:
-/
example : ∃ (z : ℤ), ∀(n : ℕ), z < n :=
begin
  sorry
end

/-
* Have a `∃` in a hypothesis? Use `cases` to split it up into the witness, and the proposition it
satisfies.
-/
example (S : set ℕ) (h : ∃n, n ∈ S) : S.nonempty :=
begin
  sorry
end

/-
We've already spent time talking about inductive data types and structures, but just to recall
briefly look at the following two examples.
-/

inductive mynat
| zero : mynat
| succ : mynat → mynat

#print prefix mynat

structure bdd_func :=
(to_fun : ℕ → ℕ)
(bdd : ∃(M : ℕ), ∀(n : ℕ), to_fun n < M)

#print prefix bdd_func

variable f : bdd_func

-- #check f 3

instance : has_coe_to_fun bdd_func (λ_, ℕ → ℕ) := {
  coe := λf, f.to_fun
}

#check f.bdd

/-
If we have time, lets try to prove this more involved example:
-/
instance : has_add bdd_func := sorry


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

import linear_algebra.free_module.rank
import linear_algebra.free_module.finite.basic

/-!

# Rank of finite free modules

This is a basic API for the rank of finite free modules.

-/

--TODO: `linear_algebra/finite_dimensional` should import this file, and a lot of results should
--be moved here.

universes u v w

variables (R : Type u) (M : Type v) (N : Type w)

open_locale tensor_product direct_sum big_operators cardinal

open cardinal finite_dimensional fintype

namespace module.free

section ring

variables [ring R] [strong_rank_condition R]
variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]

/-- The rank of a finite and free module is finite. -/
lemma rank_lt_omega : module.rank R M < ω :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  rw [← (choose_basis R M).mk_eq_dim'', lt_omega_iff_fintype],
  exact nonempty.intro infer_instance
end

/-- If `M` is finite and free, `finrank M = rank M`. -/
@[simp] lemma finrank_eq_rank : ↑(finrank R M) = module.rank R M :=
by { rw [finrank, cast_to_nat_of_lt_omega (rank_lt_omega R M)] }

/-- The finrank of a free module `M` over `R` is the cardinality of `choose_basis_index R M`. -/
lemma finrank_eq_card_choose_basis_index : finrank R M = @card (choose_basis_index R M)
  (@choose_basis_index.fintype R M _ _ _ _ (nontrivial_of_invariant_basis_number R) _) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp [finrank, rank_eq_card_choose_basis_index]
end

/-- The finrank of `(ι →₀ R)` is `fintype.card ι`. -/
@[simp] lemma finrank_finsupp {ι : Type v} [fintype ι] : finrank R (ι →₀ R) = card ι :=
by { rw [finrank, rank_finsupp, ← mk_to_nat_eq_card, to_nat_lift] }

/-- The finrank of `(ι → R)` is `fintype.card ι`. -/
lemma finrank_pi {ι : Type v} [fintype ι] : finrank R (ι → R) = card ι :=
by simp [finrank]

/-- The finrank of the direct sum is the sum of the finranks. -/
@[simp] lemma finrank_direct_sum  {ι : Type v} [fintype ι] (M : ι → Type w)
  [Π (i : ι), add_comm_group (M i)] [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)]
  [Π (i : ι), module.finite R (M i)] : finrank R (⨁ i, M i) = ∑ i, finrank R (M i) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp only [finrank, λ i, rank_eq_card_choose_basis_index R (M i), rank_direct_sum,
    ← mk_sigma, mk_to_nat_eq_card, card_sigma],
end

/-- The finrank of `M × N` is `(finrank R M) + (finrank R N)`. -/
@[simp] lemma finrank_prod : finrank R (M × N) = (finrank R M) + (finrank R N) :=
by { simp [finrank, rank_lt_omega R M, rank_lt_omega R N] }

/-- The finrank of a finite product is the sum of the finranks. -/
--TODO: this should follow from `linear_equiv.finrank_eq`, that is over a field.
lemma finrank_pi_fintype {ι : Type v} [fintype ι] {M : ι → Type w}
  [Π (i : ι), add_comm_group (M i)] [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)]
  [Π (i : ι), module.finite R (M i)] : finrank R (Π i, M i) = ∑ i, finrank R (M i) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp only [finrank, λ i, rank_eq_card_choose_basis_index R (M i), rank_pi_fintype,
    ← mk_sigma, mk_to_nat_eq_card, card_sigma],
end

/-- If `n` and `m` are `fintype`, the finrank of `n × m` matrices is
  `(fintype.card n) * (fintype.card m)`. -/
lemma finrank_matrix (n : Type v) [fintype n] (m : Type w) [fintype m] :
  finrank R (matrix n m R) = (card n) * (card m) :=
by { simp [finrank] }

end ring

section comm_ring

variables [comm_ring R] [strong_rank_condition R]
variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]

/-- The finrank of `M →ₗ[R] N` is `(finrank R M) * (finrank R N)`. -/
--TODO: this should follow from `linear_equiv.finrank_eq`, that is over a field.
lemma finrank_linear_hom : finrank R (M →ₗ[R] N) = (finrank R M) * (finrank R N) :=
begin
  classical,
  letI := nontrivial_of_invariant_basis_number R,
  have h := (linear_map.to_matrix (choose_basis R M) (choose_basis R N)),
  let b := (matrix.std_basis _ _ _).map h.symm,
  rw [finrank, dim_eq_card_basis b, ← mk_fintype, mk_to_nat_eq_card, finrank, finrank,
    rank_eq_card_choose_basis_index, rank_eq_card_choose_basis_index, mk_to_nat_eq_card,
    mk_to_nat_eq_card, card_prod, mul_comm]
end

/-- The finrank of `M ⊗[R] N` is `(finrank R M) * (finrank R N)`. -/
@[simp] lemma finrank_tensor_product (M : Type v) (N : Type w) [add_comm_group M] [module R M]
  [module.free R M] [add_comm_group N] [module R N] [module.free R N] :
finrank R (M ⊗[R] N) = (finrank R M) * (finrank R N) :=
by { simp [finrank] }

end comm_ring

end module.free