import data.real.basic

lemma eq_of_arbitrarily_close :
  ∀ x y : ℝ, (∀ ε : ℝ, ε > 0 → |y - x| < ε) → x = y :=
begin
  intros x y arbitrarily_close,
  by_contradiction,
  have false_of_abs_lt : ∀ a : ℝ, |a| < a → false,
  {
    intros a abs_lt,
    have lt_self : a < a, exact lt_of_abs_lt abs_lt,
    have ne_self : a ≠ a, exact ne_of_lt lt_self,
    exact false_of_ne ne_self,
  },
  cases lt_or_gt_of_ne h with case_lt case_gt,
  {
    rw ← sub_pos at case_lt,
    specialize arbitrarily_close (y - x) case_lt,
    exact false_of_abs_lt (y - x) arbitrarily_close,
  },
  {
    change y < x at case_gt,
    rw ← sub_pos at case_gt,
    specialize arbitrarily_close (x - y) case_gt,
    rw abs_sub_comm y x at arbitrarily_close,
    exact false_of_abs_lt (x - y) arbitrarily_close,
  },
end

lemma min__div {a b c : ℝ} (c_pos : c > 0) :
  (min a b) / c = min (a / c) (b / c) :=
begin
  unfold min,
  unfold min_default,
  split_ifs with hab habc habc,
  {
    refl,
  },
  {
    exfalso,
    rw ← div_le_div_right c_pos at hab,
    exact habc hab,
  },
  {
    exfalso,
    rw div_le_div_right c_pos at habc,
    exact hab habc,
  },
  {
    refl,
  },
end

lemma mul__div_div {a b c : ℝ} (c_pos : c > 0) : a * (c / b / c) = a / b :=
begin
  have hc : c ≠ 0, exact ne_of_gt c_pos,
  have almost : c / b / c = 1 / b,
  {
    ring_nf,
    rw mul_comm,
    rw ← mul_assoc,
    rw mul_inv_cancel hc,
    rw one_mul,
  },
  rw almost,
  exact mul_one_div a b,
end

lemma lin_on_real {f : ℝ → ℝ}
  (increasing : ∀ x y : ℝ,  0 < x  →  x < y  →  f x < f y)
  (lin_on_rat : ∀ x : ℚ,  0 < x  →  f x = f 1 + (x - 1) * (f 2 - f 1)
  ) :           ∀ x : ℝ,  0 < x  →  f x = f 1 + (x - 1) * (f 2 - f 1)  :=
begin
  have lt_f2_f1 : 0 < f 2 - f 1,
  {
    rw sub_pos,
    exact increasing _ _ one_pos one_lt_two,
  },
  intros x x_pos,
  have ex₁ : ∀ ε : ℝ, ε > 0 → ∃ x₁ : ℚ,
    ↑x₁ < x  ∧  x - ↑x₁ < ε / (f 2 - f 1),
  {
    intros ε ε_pos,
    have that_pos : ε / (f 2 - f 1) > 0,
    {
      exact div_pos ε_pos lt_f2_f1,
    },
    rcases exists_rat_btwn (sub_lt_self x that_pos) with ⟨x₁, below, above⟩,
    use x₁,
    split,
    {
      exact above,
    },
    {
      rw sub_lt,
      exact below,
    },
  },
  have ex₂ : ∀ ε : ℝ, ε > 0 → ∃ x₂ : ℚ,
    x < ↑x₂  ∧  ↑x₂ - x < ε / (f 2 - f 1),
  {
    intros ε ε_pos,
    have that_pos : ε / (f 2 - f 1) > 0,
    {
      exact div_pos ε_pos lt_f2_f1,
    },
    rcases exists_rat_btwn (lt_add_of_pos_right x that_pos) with ⟨x₂, below, above⟩,
    use x₂,
    split,
    {
      exact below,
    },
    {
      rw sub_lt_iff_lt_add',
      exact above,
    },
  },
  apply eq_of_arbitrarily_close,
  intros ε ε_pos,
  cases ex₁ ((min ε (x * (f 2 - f 1) / 2))) (by {
    change 0 < min ε (x * (f 2 - f 1) / 2),
    rw lt_min_iff,
    split,
    {
      exact ε_pos,
    },
    {
      apply half_pos,
      exact mul_pos x_pos lt_f2_f1,
    },
  }) with x₁ hx₁,
  cases hx₁ with x₁_lt_x dist₁,
  rw min__div lt_f2_f1 at dist₁,
  have x₁_pos : 0 < (x₁ : ℝ),
  {
    rw lt_min_iff at dist₁,
    cases dist₁ with foo bar,
    have baz : x - ↑x₁ < x / 2,
    {
      rw mul_div_assoc at bar,
      rw mul_div_assoc at bar,
      convert bar,
      rw mul__div_div lt_f2_f1,
    },
    have qux : x / 2 < ↑x₁,
    {
      clear_except baz,
      linarith,
    },
    apply lt_trans' qux,
    exact half_pos x_pos,
  },
  have fx₁ := lin_on_rat x₁ (by {
    clear_except x₁_pos,
    assumption_mod_cast,
  }),
  cases ex₂ ε ε_pos with x₂ hx₂,
  cases hx₂ with x_lt_x₂ dist₂,
  have fx₂ := lin_on_rat x₂ (by {
    have x₂_pos := lt_trans x_pos x_lt_x₂,
    clear_except x₂_pos,
    assumption_mod_cast,
  }),
  have inc₁ := increasing ↑x₁ x x₁_pos x₁_lt_x,
  have inc₂ := increasing x  ↑x₂ x_pos x_lt_x₂,
  rw fx₁ at inc₁,
  rw fx₂ at inc₂,
  rw abs_lt,
  split,
  {
    rw lt_sub,
    apply lt_trans inc₂,
    rw sub_neg_eq_add,
    rw add_assoc,
    rw add_lt_add_iff_left,
    rw sub_mul,
    rw sub_mul,
    rw sub_add_comm,
    rw add_comm,
    rw ← add_sub_assoc,
    rw sub_lt_sub_iff_right,
    rw ← sub_lt_iff_lt_add',
    rw ← sub_mul,
    rw ← lt_div_iff lt_f2_f1,
    exact dist₂,
  },
  {
    have intermediate_ineq :
      f 1 + (x - 1) * (f 2 - f 1) - f x <
      f 1 + (x - 1) * (f 2 - f 1) - (f 1 + (↑x₁ - 1) * (f 2 - f 1)),
    {
      exact sub_lt_sub_left inc₁ (f 1 + (x - 1) * (f 2 - f 1)),
    },
    apply lt_trans intermediate_ineq,
    rw sub_mul,
    rw sub_mul,
    rw add_sub_add_left_eq_sub,
    rw sub_sub_sub_cancel_right,
    rw ← sub_mul,
    rw ← lt_div_iff lt_f2_f1,
    {
      clear_except dist₁,
      finish,
    },
  },
end

theorem must_be_identity {f : ℝ → ℝ} (codomain : ∀ x : ℝ, f x > 0)
    (h : ∀ x y : ℝ, f (f x + (y + 1) / (f y)) = 1 / (f y) + x + 1) :
  ∀ x : ℝ,  x > 0  →  f x = x  :=
begin
  let A : ℝ := 1 / f 1 + 1,
  have high_range : ∀ B : ℝ, B > A → (∃ z : ℝ, f z = B),
  {
    intros B B_gt_A,
    let x := B - A,
    have equ := h x 1,
    use f x + 2 / f 1,
    rw one_add_one_eq_two at equ,
    rw equ,
    change 1 / f 1 + (B - (1 / f 1 + 1)) + 1 = B,
    ring,
  },
  have inj_f : function.injective f,
  {
    intros a b fa_eq_fb,
    have foo : ∀ c : ℝ, 1 / (f c) + a + 1 = 1 / (f c) + b + 1,
    {
      intro c,
      rw ← h a c,
      rw ← h b c,
      rw fa_eq_fb,
    },
    finish,
  },
  have f_increment :
    ∀ δ : ℝ, (0 < δ ∧ δ < 1 / A) → ∃ ε : ℝ,
      ∀ x : ℝ, x > 0 → f (x + δ) = f x + ε,
  {
    intros δ restrictions,
    have delta_inv_pos : 0 < 1 / δ, exact one_div_pos.mpr restrictions.1,
    have f1_inv_pos : 1 / f 1 > 0, exact one_div_pos.mpr (codomain 1),

    let B := (A + 1 / δ) / 2,
    let C := (A + 1 / δ) * (1 / δ) / ((1 / δ) - A),
    have delta_eq : δ = 1 / B - 1 / C,
    {
      change δ = 1 / ((A + 1 / δ) / 2) - 1 / ((A + 1 / δ) * (1 / δ) / ((1 / δ) - A)),
      rw one_div_div,
      rw one_div_div,
      symmetry,
      have positiv : A + 1 / δ > 0,
      {
        change 1 / f 1 + 1 + 1 / δ > 0,
        linarith,
      },
      calc 2 / (A + 1 / δ) - (1 / δ - A) / ((A + 1 / δ) * (1 / δ))
          = (2 * (1 / δ)) / ((A + 1 / δ) * (1 / δ)) - (1 / δ - A) / ((A + 1 / δ) * (1 / δ)) :
            by rw mul_div_mul_right _ _ (ne_of_gt (one_div_pos.mpr restrictions.1))
      ... = (2 * (1 / δ) - (1 / δ - A)) / ((A + 1 / δ) * (1 / δ)) : by rw div_sub_div_same
      ... = ((1 / δ) + A) / ((A + 1 / δ) * (1 / δ))               : by ring
      ... = (A + 1 / δ) / ((A + 1 / δ) * (1 / δ))                 : by rw add_comm
      ... = ((A + 1 / δ) / (A + 1 / δ)) / (1 / δ)                 : by rw div_div
      ... = 1 / (1 / δ)                                           : by rw div_self (ne_of_gt positiv)
      ... = δ                                                     : by rw one_div_one_div,
    },
    have A_pos : A > 0,
    {
      change 1 / f 1 + 1 > 0,
      specialize codomain 1,
      linarith,
    },
    have A_lt_delta_inv : A < 1 / δ,
    {
      exact (lt_one_div restrictions.1 A_pos).mp restrictions.2,
    },
    have B_gt_A : B > A,
    {
      change (A + 1 / δ) / 2 > A,
      linarith,
    },
    have C_gt_B : C > B,
    {
      have is_pos := restrictions.1,
      have inv_ineq : 1 / C < 1 / B,
      {
        rw delta_eq at is_pos,
        exact sub_pos.mp is_pos,
      },
      have B_pos : B > 0, exact gt_trans B_gt_A A_pos,
      have C_pos : C > 0,
      {
        apply mul_pos,
        apply mul_pos,
        {
          exact add_pos A_pos delta_inv_pos,
        },
        {
          rw one_div_pos,
          exact is_pos,
        },
        {
          rw inv_pos,
          rw sub_pos,
          exact A_lt_delta_inv,
        },
      },
      exact (one_div_lt_one_div C_pos B_pos).mp inv_ineq,
    },
    obtain ⟨y₁, preimage_B⟩ : ∃ y₁ : ℝ, f y₁ = B,
    {
      exact high_range B B_gt_A,
    },
    obtain ⟨y₂, preimage_C⟩ : ∃ y₂ : ℝ, f y₂ = C,
    {
      exact high_range C (gt_trans C_gt_B B_gt_A),
    },
    have equ : ∀ x : ℝ, x > 0 → 1 / f y₁ + x + 1 = 1 / f y₂ + (x+δ) + 1,
    {
      intros x x_pos,
      rw delta_eq,
      rw preimage_B,
      rw preimage_C,
      ring,
    },
    have henc : ∀ x : ℝ, x > 0 → f (f x + (y₁ + 1) / (f y₁)) = f (f (x+δ) + (y₂ + 1) / (f y₂)),
    {
      intros x x_pos,
      rw h x y₁,
      rw h (x+δ) y₂,
      rw delta_eq,
      rw preimage_B,
      rw preimage_C,
      ring,
    },
    have by_inj : ∀ x : ℝ, x > 0 → f x + (y₁ + 1) / (f y₁) = f (x+δ) + (y₂ + 1) / (f y₂),
    {
      intros x x_pos,
      exact inj_f (henc x x_pos),
    },
    use (y₁ + 1) / (f y₁) - (y₂ + 1) / (f y₂),
    intros x x_pos,
    sorry,
  },
  have f_multiple_increment :
    ∀ δ : ℝ, (0 < δ ∧ δ < 1 / A) → ∃ ε : ℝ,
      ∀ x : ℝ, x > 0 → ∀ n : ℕ, f (x + n * δ) = f x + n * ε,
  {
    intros δ restrictions,
    obtain ⟨ε, step⟩ := f_increment δ restrictions,
    use ε,
    intros x x_pos n,
    induction n with n ih,
    {
      simp,
    },
    convert_to f (x + ↑n * δ + δ) = f x + ↑n * ε + ε, sorry, sorry,
    rw ← ih,
    rw step,
    calc x + ↑n * δ ≥ x : by finish
    ... > 0 : x_pos,
  },
  have f_lin_on_rat : ∀ x : ℚ,  0 < x  →  f x = f 1 + (x - 1) * (f 2 - f 1),
  {
    intros x x_pos,
    sorry,
  },
  have f_increasing :  ∀ x y : ℝ,  0 < x  →  x < y  →  f x < f y,
  {
    sorry,
  },
  have f_lin_on_real : ∀ x : ℝ,  0 < x  →  f x = f 1 + (x - 1) * (f 2 - f 1),
  {
    exact lin_on_real f_increasing f_lin_on_rat,
  },

  have degree_one : ∃ a b : ℝ, ∀ x : ℝ,  0 < x  →  f x = a * x + b,
  {
    use f 2 - f 1,
    use f 1 + f 1 - f 2,
    intros x x_pos,
    rw f_lin_on_real x x_pos,
    ring,
  },
  rcases degree_one with ⟨a, b, hf⟩,
  have a_eq_1 : a = 1,
  {
    specialize h 1 1,
    repeat { rw hf 1 zero_lt_one at h },
    rw hf at h, swap, sorry,
    rw mul_one at h,
    rw mul_add at h,
    rw mul_add at h,
    have multiplied := congr_arg (λ v, (a + b) * v) h,
    dsimp at multiplied,
    rw mul_add (a + b) _ 1 at multiplied,
    rw mul_add (a + b) _ 1 at multiplied,
    rw mul_div (a + b) 1 (a + b) at multiplied,
    rw mul_comm (a + b) 1 at multiplied,
    repeat { rw one_mul at multiplied },
    have a_plus_b_neq_zero : a + b ≠ 0, sorry,
    rw div_self a_plus_b_neq_zero at multiplied,
    repeat { rw mul_add (a + b) at multiplied },
    rw ← mul_assoc (a + b) a ((1 + 1) / (a + b)) at multiplied,
    rw mul_div at multiplied,
    rw mul_comm (a + b) a at multiplied,
    rw mul_assoc at multiplied,
    rw mul_comm (a + b) (1 + 1) at multiplied,
    rw ← mul_div at multiplied,
    rw ← mul_div at multiplied,
    rw div_self a_plus_b_neq_zero at multiplied,
    rw mul_one at multiplied,
    have subtracted := congr_arg (λ v, v - 2 * a) multiplied,
    dsimp at subtracted,
    ring_nf at subtracted,
    sorry,
  },
  have b_eq_0 : b = 0,
  {
    rw a_eq_1 at hf,
    sorry,
  },

  intros x x_pos,
  rw hf x x_pos,
  rw a_eq_1,
  rw b_eq_0,
  rw add_zero,
  rw one_mul,
end


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Keeley Hoek, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.monotonicity.default
import Mathlib.PostPort

namespace Mathlib

namespace tactic

/-- Apply the function `f` given by `e : pexpr` to the local hypothesis `hyp`, which must either be
of the form `a = b` or `a ≤ b`, replacing the type of `hyp` with `f a = f b` or `f a ≤ f b`. If
`hyp` names an inequality then a new goal `monotone f` is created, unless the name of a proof of
this fact is passed as the optional argument `mono_lem`, or the `mono` tactic can prove it.
-/
namespace interactive

/--
Apply a function to some local assumptions which are either equalities
or inequalities. For instance, if the context contains `h : a = b` and
some function `f` then `apply_fun f at h` turns `h` into
`h : f a = f b`. When the assumption is an inequality `h : a ≤ b`, a side
goal `monotone f` is created, unless this condition is provided using
`apply_fun f at h using P` where `P : monotone f`, or the `mono` tactic
can prove it.

Typical usage is:
```lean
open function

example (X Y Z : Type) (f : X → Y) (g : Y → Z) (H : injective $ g ∘ f) :
  injective f :=
begin
  intros x x' h,
  apply_fun g at h,
  exact H h
end
```
 -/


/-
Copyright (c) 2022 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Junyan Xu
-/
import data.sym.sym2
import logic.relation

/-!
# Game addition relation

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

This file defines, given relations `rα : α → α → Prop` and `rβ : β → β → Prop`, a relation
`prod.game_add` on pairs, such that `game_add rα rβ x y` iff `x` can be reached from `y` by
decreasing either entry (with respect to `rα` and `rβ`). It is so called since it models the
subsequency relation on the addition of combinatorial games.

We also define `sym2.game_add`, which is the unordered pair analog of `prod.game_add`.

## Main definitions and results

- `prod.game_add`: the game addition relation on ordered pairs.
- `well_founded.prod_game_add`: formalizes induction on ordered pairs, where exactly one entry
  decreases at a time.

- `sym2.game_add`: the game addition relation on unordered pairs.
- `well_founded.sym2_game_add`: formalizes induction on unordered pairs, where exactly one entry
  decreases at a time.
-/

variables {α β : Type*} {rα : α → α → Prop} {rβ : β → β → Prop}

/-! ### `prod.game_add` -/

namespace prod

variables (rα rβ)

/-- `prod.game_add rα rβ x y` means that `x` can be reached from `y` by decreasing either entry with
  respect to the relations `rα` and `rβ`.

  It is so called, as it models game addition within combinatorial game theory. If `rα a₁ a₂` means
  that `a₂ ⟶ a₁` is a valid move in game `α`, and `rβ b₁ b₂` means that `b₂ ⟶ b₁` is a valid move
  in game `β`, then `game_add rα rβ` specifies the valid moves in the juxtaposition of `α` and `β`:
  the player is free to choose one of the games and make a move in it, while leaving the other game
  unchanged.

  See `sym2.game_add` for the unordered pair analog. -/
inductive game_add : α × β → α × β → Prop
| fst {a₁ a₂ b} : rα a₁ a₂ → game_add (a₁, b) (a₂, b)
| snd {a b₁ b₂} : rβ b₁ b₂ → game_add (a, b₁) (a, b₂)

lemma game_add_iff {rα rβ} {x y : α × β} :
  game_add rα rβ x y ↔ rα x.1 y.1 ∧ x.2 = y.2 ∨ rβ x.2 y.2 ∧ x.1 = y.1 :=
begin
  split,
  { rintro (@⟨a₁, a₂, b, h⟩ | @⟨a, b₁, b₂, h⟩),
    exacts [or.inl ⟨h, rfl⟩, or.inr ⟨h, rfl⟩] },
  { revert x y,
    rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ (⟨h, rfl : b₁ = b₂⟩ | ⟨h, rfl : a₁ = a₂⟩),
    exacts [game_add.fst h, game_add.snd h] }
end

@[simp] lemma game_add_swap_swap : ∀ a b : α × β,
  game_add rβ rα a.swap b.swap ↔ game_add rα rβ a b :=
λ ⟨a₁, b₁⟩ ⟨a₂, b₂⟩, by rw [prod.swap, game_add_mk_iff, game_add_mk_iff, or_comm]

lemma game_add_swap_swap_mk (a₁ a₂ : α) (b₁ b₂ : β) :
  game_add rα rβ (a₁, b₁) (a₂, b₂) ↔ game_add rβ rα (b₁, a₁) (b₂, a₂) :=
game_add_swap_swap rβ rα (b₁, a₁) (b₂, a₂)

/-- `prod.game_add` is a `subrelation` of `prod.lex`. -/
lemma game_add_le_lex : game_add rα rβ ≤ prod.lex rα rβ :=
λ _ _ h, h.rec (λ _ _ b, prod.lex.left b b) (λ a _ _, prod.lex.right a)

/-- `prod.rprod` is a subrelation of the transitive closure of `prod.game_add`. -/
lemma rprod_le_trans_gen_game_add : rprod rα rβ ≤ relation.trans_gen (game_add rα rβ) :=
λ _ _ h, h.rec begin
  intros _ _ _ _ hα hβ,
  exact relation.trans_gen.tail (relation.trans_gen.single $ game_add.fst hα) (game_add.snd hβ),
end

end prod

/-- If `a` is accessible under `rα` and `b` is accessible under `rβ`, then `(a, b)` is
  accessible under `prod.game_add rα rβ`. Notice that `prod.lex_accessible` requires the
  stronger condition `∀ b, acc rβ b`. -/
lemma acc.prod_game_add {a b} (ha : acc rα a) (hb : acc rβ b) : acc (prod.game_add rα rβ) (a, b) :=
begin
  induction ha with a ha iha generalizing b,
  induction hb with b hb ihb,
  refine acc.intro _ (λ h, _),
  rintro (⟨ra⟩ | ⟨rb⟩),
  exacts [iha _ ra (acc.intro b hb), ihb _ rb],
end

/-- The `prod.game_add` relation on well-founded inputs is well-founded.

  In particular, the sum of two well-founded games is well-founded. -/
lemma well_founded.prod_game_add (hα : well_founded rα) (hβ : well_founded rβ) :
  well_founded (prod.game_add rα rβ) := ⟨λ ⟨a, b⟩, (hα.apply a).prod_game_add (hβ.apply b)⟩

namespace prod

/-- Recursion on the well-founded `prod.game_add` relation.

  Note that it's strictly more general to recurse on the lexicographic order instead. -/
def game_add.fix {C : α → β → Sort*} (hα : well_founded rα) (hβ : well_founded rβ)
  (IH : Π a₁ b₁, (Π a₂ b₂, game_add rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) (a : α) (b : β) :
  C a b :=
@well_founded.fix (α × β) (λ x, C x.1 x.2) _ (hα.prod_game_add hβ)
  (λ ⟨x₁, x₂⟩ IH', IH x₁ x₂ $ λ a' b', IH' ⟨a', b'⟩) ⟨a, b⟩

lemma game_add.fix_eq {C : α → β → Sort*} (hα : well_founded rα) (hβ : well_founded rβ)
  (IH : Π a₁ b₁, (Π a₂ b₂, game_add rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) (a : α) (b : β) :
  game_add.fix hα hβ IH a b = IH a b (λ a' b' h, game_add.fix hα hβ IH a' b') :=
well_founded.fix_eq _ _ _

/-- Induction on the well-founded `prod.game_add` relation.

  Note that it's strictly more general to induct on the lexicographic order instead. -/
lemma game_add.induction {C : α → β → Prop} : well_founded rα → well_founded rβ →
  (∀ a₁ b₁, (∀ a₂ b₂, game_add rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) → ∀ a b, C a b :=
game_add.fix

end prod

/-! ### `sym2.game_add` -/

namespace sym2

/-- `sym2.game_add rα x y` means that `x` can be reached from `y` by decreasing either entry with
  respect to the relation `rα`.

  See `prod.game_add` for the ordered pair analog. -/
def game_add (rα : α → α → Prop): sym2 α → sym2 α → Prop :=
sym2.lift₂
⟨λ a₁ b₁ a₂ b₂, prod.game_add rα rα (a₁, b₁) (a₂, b₂) ∨ prod.game_add rα rα (b₁, a₁) (a₂, b₂),
  λ a₁ b₁ a₂ b₂, begin
    rw [prod.game_add_swap_swap_mk _ _ b₁ b₂ a₁ a₂, prod.game_add_swap_swap_mk _ _ a₁ b₂ b₁ a₂],
    simp [or_comm]
  end⟩

variable {rα}

lemma game_add_iff : ∀ {x y : α × α}, game_add rα ⟦x⟧ ⟦y⟧ ↔
  prod.game_add rα rα x y ∨ prod.game_add rα rα x.swap y :=
by { rintros ⟨_, _⟩ ⟨_, _⟩, refl }

lemma game_add_mk_iff {a₁ a₂ b₁ b₂ : α} : game_add rα ⟦(a₁, b₁)⟧ ⟦(a₂, b₂)⟧ ↔
  prod.game_add rα rα (a₁, b₁) (a₂, b₂) ∨ prod.game_add rα rα (b₁, a₁) (a₂, b₂) :=
iff.rfl

lemma _root_.prod.game_add.to_sym2 {a₁ a₂ b₁ b₂ : α}
  (h : prod.game_add rα rα (a₁, b₁) (a₂, b₂)) : sym2.game_add rα ⟦(a₁, b₁)⟧ ⟦(a₂, b₂)⟧ :=
game_add_mk_iff.2 $ or.inl $ h

lemma game_add.fst {a₁ a₂ b : α} (h : rα a₁ a₂) : game_add rα ⟦(a₁, b)⟧ ⟦(a₂, b)⟧ :=
(prod.game_add.fst h).to_sym2

lemma game_add.snd {a b₁ b₂ : α} (h : rα b₁ b₂) : game_add rα ⟦(a, b₁)⟧ ⟦(a, b₂)⟧ :=
(prod.game_add.snd h).to_sym2

lemma game_add.fst_snd {a₁ a₂ b : α} (h : rα a₁ a₂) : game_add rα ⟦(a₁, b)⟧ ⟦(b, a₂)⟧ :=
by { rw sym2.eq_swap, exact game_add.snd h }

lemma game_add.snd_fst {a₁ a₂ b : α} (h : rα a₁ a₂) : game_add rα ⟦(b, a₁)⟧ ⟦(a₂, b)⟧ :=
by { rw sym2.eq_swap, exact game_add.fst h }

end sym2

lemma acc.sym2_game_add {a b} (ha : acc rα a) (hb : acc rα b) : acc (sym2.game_add rα) ⟦(a, b)⟧ :=
begin
  induction ha with a ha iha generalizing b,
  induction hb with b hb ihb,
  refine acc.intro _ (λ s, _),
  induction s using sym2.induction_on with c d,
  rintros ((rc | rd) | (rd | rc)),
  { exact iha c rc ⟨b, hb⟩ },
  { exact ihb d rd },
  { rw sym2.eq_swap,
    exact iha d rd ⟨b, hb⟩ },
  { rw sym2.eq_swap,
    exact ihb c rc }
end

/-- The `sym2.game_add` relation on well-founded inputs is well-founded. -/
lemma well_founded.sym2_game_add (h : well_founded rα) : well_founded (sym2.game_add rα) :=
⟨λ i, sym2.induction_on i $ λ x y, (h.apply x).sym2_game_add (h.apply y)⟩

namespace sym2

/-- Recursion on the well-founded `sym2.game_add` relation. -/
def game_add.fix {C : α → α → Sort*} (hr : well_founded rα)
  (IH : Π a₁ b₁, (Π a₂ b₂, sym2.game_add rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) (a b : α) :
  C a b :=
@well_founded.fix (α × α) (λ x, C x.1 x.2) _ hr.sym2_game_add.of_quotient_lift₂
  (λ ⟨x₁, x₂⟩ IH', IH x₁ x₂ $ λ a' b', IH' ⟨a', b'⟩) (a, b)

lemma game_add.fix_eq {C : α → α → Sort*} (hr : well_founded rα)
  (IH : Π a₁ b₁, (Π a₂ b₂, sym2.game_add rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) (a b : α) :
  game_add.fix hr IH a b = IH a b (λ a' b' h, game_add.fix hr IH a' b') :=
well_founded.fix_eq _ _ _

/-- Induction on the well-founded `sym2.game_add` relation. -/
lemma game_add.induction {C : α → α → Prop} : well_founded rα →
  (∀ a₁ b₁, (∀ a₂ b₂, sym2.game_add rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) → ∀ a b, C a b :=
game_add.fix

end sym2


/-
Copyright (c) 2021 Alex J. Best. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best, Yaël Dillies
-/
import algebra.bounds

/-!
# Pointwise operations on ordered algebraic objects

This file contains lemmas about the effect of pointwise operations on sets with an order structure.

## TODO

`Sup (s • t) = Sup s • Sup t` and `Inf (s • t) = Inf s • Inf t` hold as well but
`covariant_class` is currently not polymorphic enough to state it.
-/

open function set
open_locale pointwise

variables {α : Type*}

section conditionally_complete_lattice
variables [conditionally_complete_lattice α]

section has_one
variables [has_one α]

@[simp, to_additive] lemma cSup_one : Sup (1 : set α) = 1 := cSup_singleton _
@[simp, to_additive] lemma cInf_one : Inf (1 : set α) = 1 := cInf_singleton _

end has_one

section group
variables [group α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] {s t : set α}

@[to_additive] lemma cSup_inv (hs₀ : s.nonempty) (hs₁ : bdd_below s) : Sup s⁻¹ = (Inf s)⁻¹ :=
by { rw ←image_inv, exact ((order_iso.inv α).map_cInf' hs₀ hs₁).symm }

@[to_additive] lemma cInf_inv (hs₀ : s.nonempty) (hs₁ : bdd_above s) : Inf s⁻¹ = (Sup s)⁻¹ :=
by { rw ←image_inv, exact ((order_iso.inv α).map_cSup' hs₀ hs₁).symm }

@[to_additive] lemma cSup_mul (hs₀ : s.nonempty) (hs₁ : bdd_above s) (ht₀ : t.nonempty)
  (ht₁ : bdd_above t) :
  Sup (s * t) = Sup s * Sup t :=
cSup_image2_eq_cSup_cSup (λ _, (order_iso.mul_right _).to_galois_connection)
  (λ _, (order_iso.mul_left _).to_galois_connection) hs₀ hs₁ ht₀ ht₁

@[to_additive] lemma cInf_mul (hs₀ : s.nonempty) (hs₁ : bdd_below s) (ht₀ : t.nonempty)
  (ht₁ : bdd_below t) :
  Inf (s * t) = Inf s * Inf t :=
cInf_image2_eq_cInf_cInf (λ _, (order_iso.mul_right _).symm.to_galois_connection)
  (λ _, (order_iso.mul_left _).symm.to_galois_connection) hs₀ hs₁ ht₀ ht₁

@[to_additive] lemma cSup_div (hs₀ : s.nonempty) (hs₁ : bdd_above s) (ht₀ : t.nonempty)
  (ht₁ : bdd_below t) :
  Sup (s / t) = Sup s / Inf t :=
by rw [div_eq_mul_inv, cSup_mul hs₀ hs₁ ht₀.inv ht₁.inv, cSup_inv ht₀ ht₁, div_eq_mul_inv]

@[to_additive] lemma cInf_div (hs₀ : s.nonempty) (hs₁ : bdd_below s) (ht₀ : t.nonempty)
  (ht₁ : bdd_above t) :
  Inf (s / t) = Inf s / Sup t :=
by rw [div_eq_mul_inv, cInf_mul hs₀ hs₁ ht₀.inv ht₁.inv, cInf_inv ht₀ ht₁, div_eq_mul_inv]

end group
end conditionally_complete_lattice

section complete_lattice
variables [complete_lattice α]

section has_one
variables [has_one α]

@[simp, to_additive] lemma Sup_one : Sup (1 : set α) = 1 := Sup_singleton
@[simp, to_additive] lemma Inf_one : Inf (1 : set α) = 1 := Inf_singleton

end has_one

section group
variables [group α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] (s t : set α)

@[to_additive] lemma Sup_inv (s : set α) : Sup s⁻¹ = (Inf s)⁻¹ :=
by { rw [←image_inv, Sup_image], exact ((order_iso.inv α).map_Inf _).symm }

@[to_additive] lemma Inf_inv (s : set α) : Inf s⁻¹ = (Sup s)⁻¹ :=
by { rw [←image_inv, Inf_image], exact ((order_iso.inv α).map_Sup _).symm }

@[to_additive] lemma Sup_mul : Sup (s * t) = Sup s * Sup t :=
Sup_image2_eq_Sup_Sup (λ _, (order_iso.mul_right _).to_galois_connection) $
  λ _, (order_iso.mul_left _).to_galois_connection

@[to_additive] lemma Inf_mul : Inf (s * t) = Inf s * Inf t :=
Inf_image2_eq_Inf_Inf (λ _, (order_iso.mul_right _).symm.to_galois_connection) $
  λ _, (order_iso.mul_left _).symm.to_galois_connection

@[to_additive] lemma Sup_div : Sup (s / t) = Sup s / Inf t :=
by simp_rw [div_eq_mul_inv, Sup_mul, Sup_inv]

@[to_additive] lemma Inf_div : Inf (s / t) = Inf s / Sup t :=
by simp_rw [div_eq_mul_inv, Inf_mul, Inf_inv]

end group
end complete_lattice

namespace linear_ordered_field

variables {K : Type*} [linear_ordered_field K] {a b r : K} (hr : 0 < r)
open set

include hr

lemma smul_Ioo : r • Ioo a b = Ioo (r • a) (r • b) :=
begin
  ext x,
  simp only [mem_smul_set, smul_eq_mul, mem_Ioo],
  split,
  { rintro ⟨a, ⟨a_h_left_left, a_h_left_right⟩, rfl⟩, split,
    exact (mul_lt_mul_left hr).mpr a_h_left_left,
    exact (mul_lt_mul_left hr).mpr a_h_left_right, },
  { rintro ⟨a_left, a_right⟩,
    use x / r,
    refine ⟨⟨(lt_div_iff' hr).mpr a_left, (div_lt_iff' hr).mpr a_right⟩, _⟩,
    rw mul_div_cancel' _ (ne_of_gt hr), }
end

lemma smul_Icc : r • Icc a b = Icc (r • a) (r • b) :=
begin
  ext x,
  simp only [mem_smul_set, smul_eq_mul, mem_Icc],
  split,
  { rintro ⟨a, ⟨a_h_left_left, a_h_left_right⟩, rfl⟩, split,
    exact (mul_le_mul_left hr).mpr a_h_left_left,
    exact (mul_le_mul_left hr).mpr a_h_left_right, },
  { rintro ⟨a_left, a_right⟩,
    use x / r,
    refine ⟨⟨(le_div_iff' hr).mpr a_left, (div_le_iff' hr).mpr a_right⟩, _⟩,
    rw mul_div_cancel' _ (ne_of_gt hr), }
end

lemma smul_Ico : r • Ico a b = Ico (r • a) (r • b) :=
begin
  ext x,
  simp only [mem_smul_set, smul_eq_mul, mem_Ico],
  split,
  { rintro ⟨a, ⟨a_h_left_left, a_h_left_right⟩, rfl⟩, split,
    exact (mul_le_mul_left hr).mpr a_h_left_left,
    exact (mul_lt_mul_left hr).mpr a_h_left_right, },
  { rintro ⟨a_left, a_right⟩,
    use x / r,
    refine ⟨⟨(le_div_iff' hr).mpr a_left, (div_lt_iff' hr).mpr a_right⟩, _⟩,
    rw mul_div_cancel' _ (ne_of_gt hr), }
end

lemma smul_Ioc : r • Ioc a b = Ioc (r • a) (r • b) :=
begin
  ext x,
  simp only [mem_smul_set, smul_eq_mul, mem_Ioc],
  split,
  { rintro ⟨a, ⟨a_h_left_left, a_h_left_right⟩, rfl⟩, split,
    exact (mul_lt_mul_left hr).mpr a_h_left_left,
    exact (mul_le_mul_left hr).mpr a_h_left_right, },
  { rintro ⟨a_left, a_right⟩,
    use x / r,
    refine ⟨⟨(lt_div_iff' hr).mpr a_left, (div_le_iff' hr).mpr a_right⟩, _⟩,
    rw mul_div_cancel' _ (ne_of_gt hr), }
end

lemma smul_Ioi : r • Ioi a = Ioi (r • a) :=
begin
  ext x,
  simp only [mem_smul_set, smul_eq_mul, mem_Ioi],
  split,
  { rintro ⟨a_w, a_h_left, rfl⟩,
    exact (mul_lt_mul_left hr).mpr a_h_left, },
  { rintro h,
    use x / r,
    split,
    exact (lt_div_iff' hr).mpr h,
    exact mul_div_cancel' _ (ne_of_gt hr), }
end

lemma smul_Iio : r • Iio a = Iio (r • a) :=
begin
  ext x,
  simp only [mem_smul_set, smul_eq_mul, mem_Iio],
  split,
  { rintro ⟨a_w, a_h_left, rfl⟩,
    exact (mul_lt_mul_left hr).mpr a_h_left, },
  { rintro h,
    use x / r,
    split,
    exact (div_lt_iff' hr).mpr h,
    exact mul_div_cancel' _ (ne_of_gt hr), }
end

lemma smul_Ici : r • Ici a = Ici (r • a) :=
begin
  ext x,
  simp only [mem_smul_set, smul_eq_mul, mem_Ioi],
  split,
  { rintro ⟨a_w, a_h_left, rfl⟩,
    exact (mul_le_mul_left hr).mpr a_h_left, },
  { rintro h,
    use x / r,
    split,
    exact (le_div_iff' hr).mpr h,
    exact mul_div_cancel' _ (ne_of_gt hr), }
end

lemma smul_Iic : r • Iic a = Iic (r • a) :=
begin
  ext x,
  simp only [mem_smul_set, smul_eq_mul, mem_Iio],
  split,
  { rintro ⟨a_w, a_h_left, rfl⟩,
    exact (mul_le_mul_left hr).mpr a_h_left, },
  { rintro h,
    use x / r,
    split,
    exact (div_le_iff' hr).mpr h,
    exact mul_div_cancel' _ (ne_of_gt hr), }
end
end linear_ordered_field