/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import algebra.order.floor
import topology.algebra.order.basic

/-!
# Topological facts about `int.floor`, `int.ceil` and `int.fract`

This file proves statements about limits and continuity of functions involving `floor`, `ceil` and
`fract`.

## Main declarations

* `tendsto_floor_at_top`, `tendsto_floor_at_bot`, `tendsto_ceil_at_top`, `tendsto_ceil_at_bot`:
  `int.floor` and `int.ceil` tend to +-∞ in +-∞.
* `continuous_on_floor`: `int.floor` is continuous on `Ico n (n + 1)`, because constant.
* `continuous_on_ceil`: `int.ceil` is continuous on `Ioc n (n + 1)`, because constant.
* `continuous_on_fract`: `int.fract` is continuous on `Ico n (n + 1)`.
* `continuous_on.comp_fract`: Precomposing a continuous function satisfying `f 0 = f 1` with
  `int.fract` yields another continuous function.
-/

open filter function int set
open_locale topological_space

variables {α β γ : Type*} [linear_ordered_ring α] [floor_ring α]

lemma tendsto_floor_at_top : tendsto (floor : α → ℤ) at_top at_top :=
floor_mono.tendsto_at_top_at_top $ λ b, ⟨(b + 1 : ℤ), by { rw floor_coe, exact (lt_add_one _).le }⟩

lemma tendsto_floor_at_bot : tendsto (floor : α → ℤ) at_bot at_bot :=
floor_mono.tendsto_at_bot_at_bot $ λ b, ⟨b, (floor_coe _).le⟩

lemma tendsto_ceil_at_top : tendsto (ceil : α → ℤ) at_top at_top :=
ceil_mono.tendsto_at_top_at_top $ λ b, ⟨b, (ceil_coe _).ge⟩

lemma tendsto_ceil_at_bot : tendsto (ceil : α → ℤ) at_bot at_bot :=
ceil_mono.tendsto_at_bot_at_bot $ λ b, ⟨(b - 1 : ℤ), by { rw ceil_coe, exact (sub_one_lt _).le }⟩

variables [topological_space α]

lemma continuous_on_floor (n : ℤ) : continuous_on (λ x, floor x : α → α) (Ico n (n+1) : set α) :=
(continuous_on_congr $ floor_eq_on_Ico' n).mpr continuous_on_const

lemma continuous_on_ceil (n : ℤ) : continuous_on (λ x, ceil x : α → α) (Ioc (n-1) n : set α) :=
(continuous_on_congr $ ceil_eq_on_Ioc' n).mpr continuous_on_const

lemma tendsto_floor_right' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[≥] n) (𝓝 n) :=
begin
  rw ← nhds_within_Ico_eq_nhds_within_Ici (lt_add_one (n : α)),
  simpa only [floor_coe] using
    (continuous_on_floor n _ (left_mem_Ico.mpr $ lt_add_one (_ : α))).tendsto
end

lemma tendsto_ceil_left' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[≤] n) (𝓝 n) :=
begin
  rw ← nhds_within_Ioc_eq_nhds_within_Iic (sub_one_lt (n : α)),
  simpa only [ceil_coe] using
    (continuous_on_ceil _ _ (right_mem_Ioc.mpr $ sub_one_lt (_ : α))).tendsto
end

lemma tendsto_floor_right [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[≥] n) (𝓝[≥] n) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ (tendsto_floor_right' _)
begin
  refine (eventually_nhds_within_of_forall $ λ x (hx : (n : α) ≤ x), _),
  change _ ≤ _,
  norm_cast,
  convert ← floor_mono hx,
  rw floor_eq_iff,
  exact ⟨le_rfl, lt_add_one _⟩
end

lemma tendsto_ceil_left [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[≤] n) (𝓝[≤] n) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ (tendsto_ceil_left' _)
begin
  refine (eventually_nhds_within_of_forall $ λ x (hx : x ≤ (n : α)), _),
  change _ ≤ _,
  norm_cast,
  convert ← ceil_mono hx,
  rw ceil_eq_iff,
  exact ⟨sub_one_lt _, le_rfl⟩
end

lemma tendsto_floor_left [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[<] n) (𝓝[≤] (n-1)) :=
begin
  rw ← nhds_within_Ico_eq_nhds_within_Iio (sub_one_lt (n : α)),
  convert (tendsto_nhds_within_congr $ (λ x hx, (floor_eq_on_Ico' (n-1) x hx).symm))
    (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ tendsto_const_nhds
      (eventually_of_forall (λ _, mem_Iic.mpr $ le_rfl)));
  norm_cast <|> apply_instance,
  ring
end

lemma tendsto_ceil_right [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[>] n) (𝓝[≥] (n+1)) :=
begin
  rw ← nhds_within_Ioc_eq_nhds_within_Ioi (lt_add_one (n : α)),
  convert (tendsto_nhds_within_congr $ (λ x hx, (ceil_eq_on_Ioc' (n+1) x hx).symm))
    (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ tendsto_const_nhds
      (eventually_of_forall (λ _, mem_Ici.mpr $ le_rfl)));
  norm_cast <|> apply_instance,
  ring
end

lemma tendsto_floor_left' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[<] n) (𝓝 (n-1)) :=
begin
  rw ← nhds_within_univ,
  exact tendsto_nhds_within_mono_right (subset_univ _) (tendsto_floor_left n),
end

lemma tendsto_ceil_right' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[>] n) (𝓝 (n+1)) :=
begin
  rw ← nhds_within_univ,
  exact tendsto_nhds_within_mono_right (subset_univ _) (tendsto_ceil_right n),
end

lemma continuous_on_fract [topological_add_group α] (n : ℤ) :
  continuous_on (fract : α → α) (Ico n (n+1) : set α) :=
continuous_on_id.sub (continuous_on_floor n)

lemma tendsto_fract_left' [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[<] n) (𝓝 1) :=
begin
  convert (tendsto_nhds_within_of_tendsto_nhds tendsto_id).sub (tendsto_floor_left' n);
  [{norm_cast, ring}, apply_instance, apply_instance]
end

lemma tendsto_fract_left [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[<] n) (𝓝[<] 1) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
  (tendsto_fract_left' _) (eventually_of_forall fract_lt_one)

lemma tendsto_fract_right' [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[≥] n) (𝓝 0) :=
begin
  convert (tendsto_nhds_within_of_tendsto_nhds tendsto_id).sub (tendsto_floor_right' n);
  [exact (sub_self _).symm, apply_instance, apply_instance]
end

lemma tendsto_fract_right [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[≥] n) (𝓝[≥] 0) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
  (tendsto_fract_right' _) (eventually_of_forall fract_nonneg)

local notation `I` := (Icc 0 1 : set α)

variables [order_topology α] [topological_add_group α] [topological_space β] [topological_space γ]

/-- Do not use this, use `continuous_on.comp_fract` instead. -/
lemma continuous_on.comp_fract' {f : β → α → γ}
  (h : continuous_on (uncurry f) $ (univ : set β) ×ˢ I) (hf : ∀ s, f s 0 = f s 1) :
  continuous (λ st : β × α, f st.1 $ fract st.2) :=
begin
  change continuous ((uncurry f) ∘ (prod.map id (fract))),
  rw continuous_iff_continuous_at,
  rintro ⟨s, t⟩,
  by_cases ht : t = floor t,
  { rw ht,
    rw ← continuous_within_at_univ,
    have : (univ : set (β × α)) ⊆ ((univ : set β) ×ˢ Iio ↑⌊t⌋) ∪ ((univ : set β) ×ˢ Ici ↑⌊t⌋),
    { rintros p -,
      rw ← prod_union,
      exact ⟨trivial, lt_or_le p.2 _⟩ },
    refine continuous_within_at.mono _ this,
    refine continuous_within_at.union _ _,
    { simp only [continuous_within_at, fract_coe, nhds_within_prod_eq,
                  nhds_within_univ, id.def, comp_app, prod.map_mk],
      have : (uncurry f) (s, 0) = (uncurry f) (s, (1 : α)),
        by simp [uncurry, hf],
      rw this,
      refine (h _ ⟨true.intro, by exact_mod_cast right_mem_Icc.mpr zero_le_one⟩).tendsto.comp _,
      rw [nhds_within_prod_eq, nhds_within_univ],
      rw nhds_within_Icc_eq_nhds_within_Iic (@zero_lt_one α _ _),
      exact tendsto_id.prod_map
        (tendsto_nhds_within_mono_right Iio_subset_Iic_self $ tendsto_fract_left _) },
    { simp only [continuous_within_at, fract_coe, nhds_within_prod_eq,
                  nhds_within_univ, id.def, comp_app, prod.map_mk],
      refine (h _ ⟨true.intro, by exact_mod_cast left_mem_Icc.mpr zero_le_one⟩).tendsto.comp _,
      rw [nhds_within_prod_eq, nhds_within_univ,
        nhds_within_Icc_eq_nhds_within_Ici (@zero_lt_one α _ _)],
      exact tendsto_id.prod_map (tendsto_fract_right _) } },
  { have : t ∈ Ioo (floor t : α) ((floor t : α) + 1),
      from ⟨lt_of_le_of_ne (floor_le t) (ne.symm ht), lt_floor_add_one _⟩,
    apply (h ((prod.map _ fract) _) ⟨trivial, ⟨fract_nonneg _, (fract_lt_one _).le⟩⟩).tendsto.comp,
    simp only [nhds_prod_eq, nhds_within_prod_eq, nhds_within_univ, id.def, prod.map_mk],
    exact continuous_at_id.tendsto.prod_map
            (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
              (((continuous_on_fract _ _ (Ioo_subset_Ico_self this)).mono
                  Ioo_subset_Ico_self).continuous_at (Ioo_mem_nhds this.1 this.2))
              (eventually_of_forall (λ x, ⟨fract_nonneg _, (fract_lt_one _).le⟩)) ) }
end

lemma continuous_on.comp_fract
  {s : β → α}
  {f : β → α → γ}
  (h : continuous_on (uncurry f) $ (univ : set β) ×ˢ (Icc 0 1 : set α))
  (hs : continuous s)
  (hf : ∀ s, f s 0 = f s 1) :
  continuous (λ x : β, f x $ int.fract (s x)) :=
(h.comp_fract' hf).comp (continuous_id.prod_mk hs)

/-- A special case of `continuous_on.comp_fract`. -/
lemma continuous_on.comp_fract'' {f : α → β} (h : continuous_on f I) (hf : f 0 = f 1) :
  continuous (f ∘ fract) :=
continuous_on.comp_fract (h.comp continuous_on_snd $ λ x hx, (mem_prod.mp hx).2)
  continuous_id (λ _, hf)


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import algebra.order.sub.defs
import algebra.order.monoid.with_top

/-!
# Lemma about subtraction in ordered monoids with a top element adjoined.

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

variables {α β : Type*}

namespace with_top

section
variables [has_sub α] [has_zero α]

/-- If `α` has subtraction and `0`, we can extend the subtraction to `with_top α`. -/
protected def sub : Π (a b : with_top α), with_top α
| _       ⊤       := 0
| ⊤       (x : α) := ⊤
| (x : α) (y : α) := (x - y : α)

instance : has_sub (with_top α) :=
⟨with_top.sub⟩

@[simp, norm_cast]

@[simp] theorem sub_eq_top_iff : ∀ {a b : with_top α}, a - b = ⊤ ↔ a = ⊤ ∧ b ≠ ⊤
| _ ⊤ := by simp
| ⊤ (b : α) := by simp
| (a : α) (b : α) := by simp only [← coe_sub, coe_ne_top, false_and]

lemma map_sub [has_sub β] [has_zero β] {f : α → β} (h : ∀ x y, f (x - y) = f x - f y)
  (h₀ : f 0 = 0) :
  ∀ x y : with_top α, (x - y).map f = x.map f - y.map f
| _ ⊤ := by simp only [h₀, sub_top, with_top.map_zero, coe_zero, map_top]
| ⊤ (x : α) := rfl
| (x : α) (y : α) := by simp only [← coe_sub, map_coe, h]

end

variables [canonically_ordered_add_monoid α] [has_sub α] [has_ordered_sub α]
instance : has_ordered_sub (with_top α) :=
begin
  constructor,
  rintro x y z,
  induction y using with_top.rec_top_coe, { simp },
  induction x using with_top.rec_top_coe, { simp },
  induction z using with_top.rec_top_coe, { simp },
  norm_cast, exact tsub_le_iff_right
end

end with_top


import Runtime.MergeSort.Split
import Runtime.MergeSort.Merge

universe u

variable {α : Type u} (r : α → α → Prop) [DecidableRel r]
local infixl:50 " ≼ " => r

def mergeSort : List α → (List α × Nat)
  | [] => ([], 0)
  | [a] => ([a], 0)
  | a :: b :: l => by
    cases r₁: split (a :: b :: l) with
    | mk ls₁ ls₂n =>
      cases r₂: ls₂n with
      | mk ls₂ n =>
        have e : split (a :: b :: l) = ⟨ls₁, ⟨ls₂, n⟩⟩ := by
          rw [r₁, r₂]
        have h := length_split_lt e
        have := h.1
        have := h.2
        let ⟨sorted_ls₁, m₁⟩ := mergeSort ls₁
        let ⟨sorted_ls₂, m₂⟩ := mergeSort ls₂
        let ⟨ls', m⟩ := merge r sorted_ls₁ sorted_ls₂
        exact ⟨ls', n + m₁ + m₂ + m⟩
  termination_by mergeSort l => List.length l

theorem mergeSort_cons_cons {a b} {l l₁ l₂ : List α} {n : Nat} (h : split (a :: b :: l) = (l₁, l₂, n)) :
    (mergeSort r (a :: b :: l)).1 = (merge r (mergeSort r l₁).1 (mergeSort r l₂).1).1 := by
    simp [mergeSort]
    simp at h
    have ⟨h₁, ⟨h₂, _⟩⟩ := h
    rw [← h₁, ← h₂]

theorem mergeSort_equivalence : ∀ (l : List α), (mergeSort r l).fst = List.mergeSort r l
| []          => by simp [mergeSort]
| [a]         => by simp [mergeSort]
| a :: b :: l => by
  have : (split (a :: b :: l)).fst.length < (a :: b :: l).length :=
    by cases e : split (a :: b :: l) with
       | mk l₁ l₂n =>
         have ⟨h₁, _⟩ := length_split_lt e
         exact h₁
  have : (split (a :: b :: l)).snd.fst.length < (a :: b :: l).length :=
    by cases e : split (a :: b :: l) with
       | mk l₁ l₂n =>
         have ⟨_, h₂⟩ := length_split_lt e
         exact h₂
  rw [List.mergeSort_cons_cons r (Prod.ext rfl rfl)]
  rw [mergeSort_cons_cons r (Prod.ext rfl (Prod.ext rfl rfl))]
  rw [merge_equivalence]
  rw [mergeSort_equivalence (split (a :: b :: l)).1]
  rw [mergeSort_equivalence (split (a :: b :: l)).2.1]
  rw [(split_equivalence (a :: b :: l)).left]
  rw [(split_equivalence (a :: b :: l)).right]
  termination_by mergeSort_equivalence l => List.length l

theorem mergeSort_cons_cons_snd {a b n} {l l₁ l₂ : List α}
  (hs : split (a :: b :: l) = (l₁, l₂, n)) :
    (mergeSort r (a :: b :: l)).snd =
    (split (a :: b :: l)).snd.snd + (mergeSort r l₁).snd + (mergeSort r l₂).snd +
    (merge r (mergeSort r l₁).fst (mergeSort r l₂).fst).snd := by
  simp at hs
  simp [mergeSort, hs]

theorem merge_sort_complexity : ∀ l : List α, (mergeSort r l).snd ≤ 8 * l.length * Nat.log 2 l.length := sorry


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson, Markus Himmel

! This file was ported from Lean 3 source module set_theory.game.nim
! leanprover-community/mathlib commit 92ca63f0fb391a9ca5f22d2409a6080e786d99f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Bitwise
import Mathbin.SetTheory.Game.Birthday
import Mathbin.SetTheory.Game.Impartial

/-!
# Nim and the Sprague-Grundy theorem

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

## Implementation details

The pen-and-paper definition of nim defines the possible moves of `nim o` to be `set.Iio o`.
However, this definition does not work for us because it would make the type of nim
`ordinal.{u} → pgame.{u + 1}`, which would make it impossible for us to state the Sprague-Grundy
theorem, since that requires the type of `nim` to be `ordinal.{u} → pgame.{u}`. For this reason, we
instead use `o.out.α` for the possible moves. You can use `to_left_moves_nim` and
`to_right_moves_nim` to convert an ordinal less than `o` into a left or right move of `nim o`, and
vice versa.
-/

noncomputable section

universe u

open Pgame

namespace Pgame

-- Uses `noncomputable!` to avoid `rec_fn_macro only allowed in meta definitions` VM error
/-- The definition of single-heap nim, which can be viewed as a pile of stones where each player can
  take a positive number of stones from it on their turn. -/
noncomputable def nim : Ordinal.{u} → Pgame.{u}
  | o₁ =>
    let f o₂ :=
      have : Ordinal.typein o₁.out.R o₂ < o₁ := Ordinal.typein_lt_self o₂
      nim (Ordinal.typein o₁.out.R o₂)
    ⟨o₁.out.α, o₁.out.α, f, f⟩
#align pgame.nim Pgame.nim

open Ordinal

theorem nim_def (o : Ordinal) :
    nim o =
      Pgame.mk o.out.α o.out.α (fun o₂ => nim (Ordinal.typein (· < ·) o₂)) fun o₂ =>
        nim (Ordinal.typein (· < ·) o₂) :=
  by
  rw [nim]
  rfl
#align pgame.nim_def Pgame.nim_def

theorem leftMoves_nim (o : Ordinal) : (nim o).LeftMoves = o.out.α :=
  by
  rw [nim_def]
  rfl
#align pgame.left_moves_nim Pgame.leftMoves_nim

theorem rightMoves_nim (o : Ordinal) : (nim o).RightMoves = o.out.α :=
  by
  rw [nim_def]
  rfl
#align pgame.right_moves_nim Pgame.rightMoves_nim

theorem moveLeft_nim_hEq (o : Ordinal) :
    HEq (nim o).moveLeft fun i : o.out.α => nim (typein (· < ·) i) :=
  by
  rw [nim_def]
  rfl
#align pgame.move_left_nim_heq Pgame.moveLeft_nim_hEq

theorem moveRight_nim_hEq (o : Ordinal) :
    HEq (nim o).moveRight fun i : o.out.α => nim (typein (· < ·) i) :=
  by
  rw [nim_def]
  rfl
#align pgame.move_right_nim_heq Pgame.moveRight_nim_hEq

/-- Turns an ordinal less than `o` into a left move for `nim o` and viceversa. -/
noncomputable def toLeftMovesNim {o : Ordinal} : Set.Iio o ≃ (nim o).LeftMoves :=
  (enumIsoOut o).toEquiv.trans (Equiv.cast (leftMoves_nim o).symm)
#align pgame.to_left_moves_nim Pgame.toLeftMovesNim

/-- Turns an ordinal less than `o` into a right move for `nim o` and viceversa. -/
noncomputable def toRightMovesNim {o : Ordinal} : Set.Iio o ≃ (nim o).RightMoves :=
  (enumIsoOut o).toEquiv.trans (Equiv.cast (rightMoves_nim o).symm)
#align pgame.to_right_moves_nim Pgame.toRightMovesNim

@[simp]
theorem toLeftMovesNim_symm_lt {o : Ordinal} (i : (nim o).LeftMoves) :
    ↑(toLeftMovesNim.symm i) < o :=
  (toLeftMovesNim.symm i).Prop
#align pgame.to_left_moves_nim_symm_lt Pgame.toLeftMovesNim_symm_lt

@[simp]
theorem toRightMovesNim_symm_lt {o : Ordinal} (i : (nim o).RightMoves) :
    ↑(toRightMovesNim.symm i) < o :=
  (toRightMovesNim.symm i).Prop
#align pgame.to_right_moves_nim_symm_lt Pgame.toRightMovesNim_symm_lt

@[simp]
theorem moveLeft_nim' {o : Ordinal.{u}} (i) :
    (nim o).moveLeft i = nim (toLeftMovesNim.symm i).val :=
  (congr_heq (moveLeft_nim_hEq o).symm (cast_hEq _ i)).symm
#align pgame.move_left_nim' Pgame.moveLeft_nim'

theorem moveLeft_nim {o : Ordinal} (i) : (nim o).moveLeft (toLeftMovesNim i) = nim i := by simp
#align pgame.move_left_nim Pgame.moveLeft_nim

@[simp]
theorem moveRight_nim' {o : Ordinal} (i) : (nim o).moveRight i = nim (toRightMovesNim.symm i).val :=
  (congr_heq (moveRight_nim_hEq o).symm (cast_hEq _ i)).symm
#align pgame.move_right_nim' Pgame.moveRight_nim'

theorem moveRight_nim {o : Ordinal} (i) : (nim o).moveRight (toRightMovesNim i) = nim i := by simp
#align pgame.move_right_nim Pgame.moveRight_nim

/-- A recursion principle for left moves of a nim game. -/
@[elab_as_elim]
def leftMovesNimRecOn {o : Ordinal} {P : (nim o).LeftMoves → Sort _} (i : (nim o).LeftMoves)
    (H : ∀ a < o, P <| toLeftMovesNim ⟨a, H⟩) : P i :=
  by
  rw [← to_left_moves_nim.apply_symm_apply i]
  apply H
#align pgame.left_moves_nim_rec_on Pgame.leftMovesNimRecOn

/-- A recursion principle for right moves of a nim game. -/
@[elab_as_elim]
def rightMovesNimRecOn {o : Ordinal} {P : (nim o).RightMoves → Sort _} (i : (nim o).RightMoves)
    (H : ∀ a < o, P <| toRightMovesNim ⟨a, H⟩) : P i :=
  by
  rw [← to_right_moves_nim.apply_symm_apply i]
  apply H
#align pgame.right_moves_nim_rec_on Pgame.rightMovesNimRecOn

instance isEmpty_nim_zero_leftMoves : IsEmpty (nim 0).LeftMoves :=
  by
  rw [nim_def]
  exact Ordinal.isEmpty_out_zero
#align pgame.is_empty_nim_zero_left_moves Pgame.isEmpty_nim_zero_leftMoves

instance isEmpty_nim_zero_rightMoves : IsEmpty (nim 0).RightMoves :=
  by
  rw [nim_def]
  exact Ordinal.isEmpty_out_zero
#align pgame.is_empty_nim_zero_right_moves Pgame.isEmpty_nim_zero_rightMoves

/-- `nim 0` has exactly the same moves as `0`. -/
def nimZeroRelabelling : nim 0 ≡r 0 :=
  Relabelling.isEmpty _
#align pgame.nim_zero_relabelling Pgame.nimZeroRelabelling

theorem nim_zero_equiv : nim 0 ≈ 0 :=
  Equiv.isEmpty _
#align pgame.nim_zero_equiv Pgame.nim_zero_equiv

noncomputable instance uniqueNimOneLeftMoves : Unique (nim 1).LeftMoves :=
  (Equiv.cast <| leftMoves_nim 1).unique
#align pgame.unique_nim_one_left_moves Pgame.uniqueNimOneLeftMoves

noncomputable instance uniqueNimOneRightMoves : Unique (nim 1).RightMoves :=
  (Equiv.cast <| rightMoves_nim 1).unique
#align pgame.unique_nim_one_right_moves Pgame.uniqueNimOneRightMoves

@[simp]
theorem default_nim_one_leftMoves_eq :
    (default : (nim 1).LeftMoves) = @toLeftMovesNim 1 ⟨0, zero_lt_one⟩ :=
  rfl
#align pgame.default_nim_one_left_moves_eq Pgame.default_nim_one_leftMoves_eq

@[simp]
theorem default_nim_one_rightMoves_eq :
    (default : (nim 1).RightMoves) = @toRightMovesNim 1 ⟨0, zero_lt_one⟩ :=
  rfl
#align pgame.default_nim_one_right_moves_eq Pgame.default_nim_one_rightMoves_eq

@[simp]
theorem toLeftMovesNim_one_symm (i) : (@toLeftMovesNim 1).symm i = ⟨0, zero_lt_one⟩ := by simp
#align pgame.to_left_moves_nim_one_symm Pgame.toLeftMovesNim_one_symm

@[simp]
theorem toRightMovesNim_one_symm (i) : (@toRightMovesNim 1).symm i = ⟨0, zero_lt_one⟩ := by simp
#align pgame.to_right_moves_nim_one_symm Pgame.toRightMovesNim_one_symm

theorem nim_one_moveLeft (x) : (nim 1).moveLeft x = nim 0 := by simp
#align pgame.nim_one_move_left Pgame.nim_one_moveLeft

theorem nim_one_moveRight (x) : (nim 1).moveRight x = nim 0 := by simp
#align pgame.nim_one_move_right Pgame.nim_one_moveRight

/-- `nim 1` has exactly the same moves as `star`. -/
def nimOneRelabelling : nim 1 ≡r star := by
  rw [nim_def]
  refine' ⟨_, _, fun i => _, fun j => _⟩
  any_goals dsimp; apply Equiv.equivOfUnique
  all_goals simp; exact nim_zero_relabelling
#align pgame.nim_one_relabelling Pgame.nimOneRelabelling

theorem nim_one_equiv : nim 1 ≈ star :=
  nimOneRelabelling.Equiv
#align pgame.nim_one_equiv Pgame.nim_one_equiv

@[simp]
theorem nim_birthday (o : Ordinal) : (nim o).birthday = o :=
  by
  induction' o using Ordinal.induction with o IH
  rw [nim_def, birthday_def]
  dsimp
  rw [max_eq_right le_rfl]
  convert lsub_typein o
  exact funext fun i => IH _ (typein_lt_self i)
#align pgame.nim_birthday Pgame.nim_birthday

@[simp]
theorem neg_nim (o : Ordinal) : -nim o = nim o :=
  by
  induction' o using Ordinal.induction with o IH
  rw [nim_def]; dsimp <;> congr <;> funext i <;> exact IH _ (Ordinal.typein_lt_self i)
#align pgame.neg_nim Pgame.neg_nim

instance nim_impartial (o : Ordinal) : Impartial (nim o) :=
  by
  induction' o using Ordinal.induction with o IH
  rw [impartial_def, neg_nim]
  refine' ⟨equiv_rfl, fun i => _, fun i => _⟩ <;> simpa using IH _ (typein_lt_self _)
#align pgame.nim_impartial Pgame.nim_impartial

theorem nim_fuzzy_zero_of_ne_zero {o : Ordinal} (ho : o ≠ 0) : nim o ‖ 0 :=
  by
  rw [impartial.fuzzy_zero_iff_lf, nim_def, lf_zero_le]
  rw [← Ordinal.pos_iff_ne_zero] at ho
  exact ⟨(Ordinal.principalSegOut ho).top, by simp⟩
#align pgame.nim_fuzzy_zero_of_ne_zero Pgame.nim_fuzzy_zero_of_ne_zero

@[simp]
theorem nim_add_equiv_zero_iff (o₁ o₂ : Ordinal) : (nim o₁ + nim o₂ ≈ 0) ↔ o₁ = o₂ :=
  by
  constructor
  · refine' not_imp_not.1 fun hne : _ ≠ _ => (impartial.not_equiv_zero_iff _).2 _
    wlog h : o₁ < o₂
    · exact (fuzzy_congr_left add_comm_equiv).1 (this _ _ hne.symm (hne.lt_or_lt.resolve_left h))
    rw [impartial.fuzzy_zero_iff_gf, zero_lf_le, nim_def o₂]
    refine' ⟨to_left_moves_add (Sum.inr _), _⟩
    · exact (Ordinal.principalSegOut h).top
    · simpa using (impartial.add_self (nim o₁)).2
  · rintro rfl
    exact impartial.add_self (nim o₁)
#align pgame.nim_add_equiv_zero_iff Pgame.nim_add_equiv_zero_iff

@[simp]
theorem nim_add_fuzzy_zero_iff {o₁ o₂ : Ordinal} : nim o₁ + nim o₂ ‖ 0 ↔ o₁ ≠ o₂ := by
  rw [iff_not_comm, impartial.not_fuzzy_zero_iff, nim_add_equiv_zero_iff]
#align pgame.nim_add_fuzzy_zero_iff Pgame.nim_add_fuzzy_zero_iff

@[simp]
theorem nim_equiv_iff_eq {o₁ o₂ : Ordinal} : (nim o₁ ≈ nim o₂) ↔ o₁ = o₂ := by
  rw [impartial.equiv_iff_add_equiv_zero, nim_add_equiv_zero_iff]
#align pgame.nim_equiv_iff_eq Pgame.nim_equiv_iff_eq

/-- The Grundy value of an impartial game, the ordinal which corresponds to the game of nim that the
 game is equivalent to -/
noncomputable def grundyValue : ∀ G : Pgame.{u}, Ordinal.{u}
  | G => Ordinal.mex.{u, u} fun i => grundy_value (G.moveLeft i)decreasing_by pgame_wf_tac
#align pgame.grundy_value Pgame.grundyValue

theorem grundyValue_eq_mex_left (G : Pgame) :
    grundyValue G = Ordinal.mex.{u, u} fun i => grundyValue (G.moveLeft i) := by rw [grundy_value]
#align pgame.grundy_value_eq_mex_left Pgame.grundyValue_eq_mex_left

/-- The Sprague-Grundy theorem which states that every impartial game is equivalent to a game of
 nim, namely the game of nim corresponding to the games Grundy value -/
theorem equiv_nim_grundyValue : ∀ (G : Pgame.{u}) [G.Impartial], G ≈ nim (grundyValue G)
  | G => by
    intro hG
    rw [impartial.equiv_iff_add_equiv_zero, ← impartial.forall_left_moves_fuzzy_iff_equiv_zero]
    intro i
    apply left_moves_add_cases i
    · intro i₁
      rw [add_move_left_inl]
      apply (fuzzy_congr_left (add_congr_left (equiv_nim_grundy_value (G.move_left i₁)).symm)).1
      rw [nim_add_fuzzy_zero_iff]
      intro heq
      rw [eq_comm, grundy_value_eq_mex_left G] at heq
      have h := Ordinal.ne_mex _
      rw [HEq] at h
      exact (h i₁).irrefl
    · intro i₂
      rw [add_move_left_inr, ← impartial.exists_left_move_equiv_iff_fuzzy_zero]
      revert i₂
      rw [nim_def]
      intro i₂
      have h' :
        ∃ i : G.left_moves,
          grundy_value (G.move_left i) = Ordinal.typein (Quotient.out (grundy_value G)).R i₂ :=
        by
        revert i₂
        rw [grundy_value_eq_mex_left]
        intro i₂
        have hnotin : _ ∉ _ := fun hin =>
          (le_not_le_of_lt (Ordinal.typein_lt_self i₂)).2 (cinfₛ_le' hin)
        simpa using hnotin
      cases' h' with i hi
      use to_left_moves_add (Sum.inl i)
      rw [add_move_left_inl, move_left_mk]
      apply (add_congr_left (equiv_nim_grundy_value (G.move_left i))).trans
      simpa only [hi] using impartial.add_self (nim (grundy_value (G.move_left i)))decreasing_by
  pgame_wf_tac
#align pgame.equiv_nim_grundy_value Pgame.equiv_nim_grundyValue

theorem grundyValue_eq_iff_equiv_nim {G : Pgame} [G.Impartial] {o : Ordinal} :
    grundyValue G = o ↔ (G ≈ nim o) :=
  ⟨by
    rintro rfl
    exact equiv_nim_grundy_value G, by
    intro h
    rw [← nim_equiv_iff_eq]
    exact (equiv_nim_grundy_value G).symm.trans h⟩
#align pgame.grundy_value_eq_iff_equiv_nim Pgame.grundyValue_eq_iff_equiv_nim

@[simp]
theorem nim_grundyValue (o : Ordinal.{u}) : grundyValue (nim o) = o :=
  grundyValue_eq_iff_equiv_nim.2 Pgame.equiv_rfl
#align pgame.nim_grundy_value Pgame.nim_grundyValue

theorem grundyValue_eq_iff_equiv (G H : Pgame) [G.Impartial] [H.Impartial] :
    grundyValue G = grundyValue H ↔ (G ≈ H) :=
  grundyValue_eq_iff_equiv_nim.trans (equiv_congr_left.1 (equiv_nim_grundyValue H) _).symm
#align pgame.grundy_value_eq_iff_equiv Pgame.grundyValue_eq_iff_equiv

@[simp]
theorem grundyValue_zero : grundyValue 0 = 0 :=
  grundyValue_eq_iff_equiv_nim.2 nim_zero_equiv.symm
#align pgame.grundy_value_zero Pgame.grundyValue_zero

theorem grundyValue_iff_equiv_zero (G : Pgame) [G.Impartial] : grundyValue G = 0 ↔ (G ≈ 0) := by
  rw [← grundy_value_eq_iff_equiv, grundy_value_zero]
#align pgame.grundy_value_iff_equiv_zero Pgame.grundyValue_iff_equiv_zero

@[simp]
theorem grundyValue_star : grundyValue star = 1 :=
  grundyValue_eq_iff_equiv_nim.2 nim_one_equiv.symm
#align pgame.grundy_value_star Pgame.grundyValue_star

@[simp]
theorem grundyValue_neg (G : Pgame) [G.Impartial] : grundyValue (-G) = grundyValue G := by
  rw [grundy_value_eq_iff_equiv_nim, neg_equiv_iff, neg_nim, ← grundy_value_eq_iff_equiv_nim]
#align pgame.grundy_value_neg Pgame.grundyValue_neg

theorem grundyValue_eq_mex_right :
    ∀ (G : Pgame) [G.Impartial],
      grundyValue G = Ordinal.mex.{u, u} fun i => grundyValue (G.moveRight i)
  | ⟨l, r, L, R⟩ => by
    intro H
    rw [← grundy_value_neg, grundy_value_eq_mex_left]
    congr
    ext i
    haveI : (R i).Impartial := @impartial.move_right_impartial ⟨l, r, L, R⟩ _ i
    apply grundy_value_neg
#align pgame.grundy_value_eq_mex_right Pgame.grundyValue_eq_mex_right

-- Todo: this actually generalizes to all ordinals, by defining `ordinal.lxor` as the pairwise
-- `nat.lxor` of base `ω` Cantor normal forms.
/-- The Grundy value of the sum of two nim games with natural numbers of piles equals their bitwise
xor. -/
@[simp]
theorem grundyValue_nim_add_nim (n m : ℕ) : grundyValue (nim.{u} n + nim.{u} m) = Nat.lxor' n m :=
  by
  -- We do strong induction on both variables.
  induction' n using Nat.strong_induction_on with n hn generalizing m
  induction' m using Nat.strong_induction_on with m hm
  rw [grundy_value_eq_mex_left]
  apply (Ordinal.mex_le_of_ne.{u, u} fun i => _).antisymm (Ordinal.le_mex_of_forall fun ou hu => _)
  -- The Grundy value `nat.lxor n m` can't be reached by left moves.
  ·
    apply left_moves_add_cases i <;>
      · -- A left move leaves us with a Grundy value of `nat.lxor k m` for `k < n`, or `nat.lxor n k`
        -- for `k < m`.
        refine' fun a => left_moves_nim_rec_on a fun ok hk => _
        obtain ⟨k, rfl⟩ := Ordinal.lt_omega.1 (hk.trans (Ordinal.nat_lt_omega _))
        simp only [add_move_left_inl, add_move_left_inr, move_left_nim', Equiv.symm_apply_apply]
        -- The inequality follows from injectivity.
        rw [nat_cast_lt] at hk
        first |rw [hn _ hk]|rw [hm _ hk]
        refine' fun h => hk.ne _
        rw [Ordinal.nat_cast_inj] at h
        first |rwa [Nat.lxor'_left_inj] at h|rwa [Nat.lxor'_right_inj] at h
  -- Every other smaller Grundy value can be reached by left moves.
  · -- If `u < nat.lxor m n`, then either `nat.lxor u n < m` or `nat.lxor u m < n`.
    obtain ⟨u, rfl⟩ := Ordinal.lt_omega.1 (hu.trans (Ordinal.nat_lt_omega _))
    replace hu := Ordinal.nat_cast_lt.1 hu
    cases' Nat.lt_lxor'_cases hu with h h
    -- In the first case, reducing the `m` pile to `nat.lxor u n` gives the desired Grundy value.
    · refine' ⟨to_left_moves_add (Sum.inl <| to_left_moves_nim ⟨_, Ordinal.nat_cast_lt.2 h⟩), _⟩
      simp [Nat.lxor_cancel_right, hn _ h]
    -- In the second case, reducing the `n` pile to `nat.lxor u m` gives the desired Grundy value.
    · refine' ⟨to_left_moves_add (Sum.inr <| to_left_moves_nim ⟨_, Ordinal.nat_cast_lt.2 h⟩), _⟩
      have : n.lxor (u.lxor n) = u
      rw [Nat.lxor'_comm u, Nat.lxor'_cancel_left]
      simpa [hm _ h] using this
#align pgame.grundy_value_nim_add_nim Pgame.grundyValue_nim_add_nim

theorem nim_add_nim_equiv {n m : ℕ} : nim n + nim m ≈ nim (Nat.lxor' n m) := by
  rw [← grundy_value_eq_iff_equiv_nim, grundy_value_nim_add_nim]
#align pgame.nim_add_nim_equiv Pgame.nim_add_nim_equiv

theorem grundyValue_add (G H : Pgame) [G.Impartial] [H.Impartial] {n m : ℕ} (hG : grundyValue G = n)
    (hH : grundyValue H = m) : grundyValue (G + H) = Nat.lxor' n m :=
  by
  rw [← nim_grundy_value (Nat.lxor' n m), grundy_value_eq_iff_equiv]
  refine' Equiv.trans _ nim_add_nim_equiv
  convert add_congr (equiv_nim_grundy_value G) (equiv_nim_grundy_value H) <;> simp only [hG, hH]
#align pgame.grundy_value_add Pgame.grundyValue_add

end Pgame


/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andreas Swerdlow
-/
import ring_theory.ring_invo
import algebra.module.linear_map

/-!
# Sesquilinear form

This file defines a sesquilinear form over a module. The definition requires a ring antiautomorphism
on the scalar ring. Basic ideas such as
orthogonality are also introduced.

A sesquilinear form on an `R`-module `M`, is a function from `M × M` to `R`, that is linear in the
first argument and antilinear in the second, with respect to an antiautomorphism on `R` (an
antiisomorphism from `R` to `R`).

## Notations

Given any term `S` of type `sesq_form`, due to a coercion, can use the notation `S x y` to
refer to the function field, ie. `S x y = S.sesq x y`.

## References

* <https://en.wikipedia.org/wiki/Sesquilinear_form#Over_arbitrary_rings>

## Tags

Sesquilinear form,
-/

open_locale big_operators

universes u v w

/-- A sesquilinear form over a module  -/
structure sesq_form (R : Type u) (M : Type v) [ring R] (I : R ≃+* Rᵒᵖ)
  [add_comm_group M] [module R M] :=
(sesq : M → M → R)
(sesq_add_left : ∀ (x y z : M), sesq (x + y) z = sesq x z + sesq y z)
(sesq_smul_left : ∀ (a : R) (x y : M), sesq (a • x) y = a * (sesq x y))
(sesq_add_right : ∀ (x y z : M), sesq x (y + z) = sesq x y + sesq x z)
(sesq_smul_right : ∀ (a : R) (x y : M), sesq x (a • y) = (I a).unop * (sesq x y))

namespace sesq_form

section general_ring
variables {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M]
variables {I : R ≃+* Rᵒᵖ} {S : sesq_form R M I}

instance : has_coe_to_fun (sesq_form R M I) :=
⟨_, λ S, S.sesq⟩

lemma add_left (x y z : M) : S (x + y) z = S x z + S y z := sesq_add_left S x y z

lemma smul_left (a : R) (x y : M) : S (a • x) y = a * (S x y) := sesq_smul_left S a x y

lemma add_right (x y z : M) : S x (y + z) = S x y + S x z := sesq_add_right S x y z

lemma smul_right (a : R) (x y : M) : S x (a • y) = (I a).unop * (S x y) := sesq_smul_right S a x y

lemma zero_left (x : M) : S 0 x = 0 :=
by { rw [←zero_smul R (0 : M), smul_left, zero_mul] }

lemma zero_right (x : M) : S x 0 = 0 :=
by { rw [←zero_smul R (0 : M), smul_right], simp }

lemma neg_left (x y : M) : S (-x) y = -(S x y) :=
by { rw [←@neg_one_smul R _ _, smul_left, neg_one_mul] }

lemma neg_right (x y : M) : S x (-y) = -(S x y) :=
by { rw [←@neg_one_smul R _ _, smul_right], simp }

lemma sub_left (x y z : M) :
  S (x - y) z = S x z - S y z :=
by simp only [sub_eq_add_neg, add_left, neg_left]

lemma sub_right (x y z : M) :
  S x (y - z) = S x y - S x z :=
by simp only [sub_eq_add_neg, add_right, neg_right]

variable {D : sesq_form R M I}
@[ext] lemma ext (H : ∀ (x y : M), S x y = D x y) : S = D :=
by {cases S, cases D, congr, funext, exact H _ _}

instance : has_add (sesq_form R M I) :=
⟨λ S D, { sesq := λ x y, S x y + D x y,
                  sesq_add_left := λ x y z, by {rw add_left, rw add_left, abel},
                  sesq_smul_left := λ a x y, by {rw [smul_left, smul_left, mul_add]},
                  sesq_add_right := λ x y z, by {rw add_right, rw add_right, abel},
                  sesq_smul_right := λ a x y, by {rw [smul_right, smul_right, mul_add]} }⟩

instance : has_zero (sesq_form R M I) :=
⟨{ sesq := λ x y, 0,
            sesq_add_left := λ x y z, (add_zero 0).symm,
            sesq_smul_left := λ a x y, (mul_zero a).symm,
            sesq_add_right := λ x y z, (zero_add 0).symm,
            sesq_smul_right := λ a x y, (mul_zero (I a).unop).symm }⟩

instance : has_neg (sesq_form R M I) :=
⟨λ S, { sesq := λ x y, - (S.1 x y),
                sesq_add_left := λ x y z, by rw [sesq_add_left, neg_add],
                sesq_smul_left := λ a x y, by rw [sesq_smul_left, mul_neg_eq_neg_mul_symm],
                sesq_add_right := λ x y z, by rw [sesq_add_right, neg_add],
                sesq_smul_right := λ a x y, by rw [sesq_smul_right, mul_neg_eq_neg_mul_symm] }⟩

instance : add_comm_group (sesq_form R M I) :=
{ add := (+),
  add_assoc := by { intros, ext,
    unfold coe_fn has_coe_to_fun.coe sesq coe_fn has_coe_to_fun.coe sesq, rw add_assoc },
  zero := 0,
  zero_add := by { intros, ext, unfold coe_fn has_coe_to_fun.coe sesq, rw zero_add },
  add_zero := by { intros, ext, unfold coe_fn has_coe_to_fun.coe sesq, rw add_zero },
  neg := has_neg.neg,
  add_left_neg := by { intros, ext, unfold coe_fn has_coe_to_fun.coe sesq, rw neg_add_self },
  add_comm := by { intros, ext, unfold coe_fn has_coe_to_fun.coe sesq, rw add_comm } }

instance : inhabited (sesq_form R M I) := ⟨0⟩

/-- The proposition that two elements of a sesquilinear form space are orthogonal -/
def is_ortho (S : sesq_form R M I) (x y : M) : Prop :=
S x y = 0

lemma ortho_zero (x : M) :
is_ortho S (0 : M) x := zero_left x

lemma is_add_monoid_hom_left (S : sesq_form R M I) (x : M) : is_add_monoid_hom (λ z, S z x) :=
{ map_add := λ z y, sesq_add_left S _ _ _,
  map_zero := zero_left x }

lemma is_add_monoid_hom_right (S : sesq_form R M I) (x : M) : is_add_monoid_hom (λ z, S x z) :=
{ map_add := λ z y, sesq_add_right S _ _ _,
  map_zero := zero_right x }

lemma sum_left {α : Type*} (S : sesq_form R M I) (t : finset α) (g : α → M) (w : M) :
  S (∑ i in t, g i) w = ∑ i in t, S (g i) w :=
by haveI s_inst := is_add_monoid_hom_left S w; exact (finset.sum_hom t (λ z, S z w)).symm

lemma sum_right {α : Type*} (S : sesq_form R M I) (t : finset α) (g : α → M) (w : M) :
  S w (∑ i in t, g i) = ∑ i in t, S w (g i) :=
by haveI s_inst := is_add_monoid_hom_right S w; exact (finset.sum_hom t (λ z, S w z)).symm

variables {M₂ : Type w} [add_comm_group M₂] [module R M₂]

/-- Apply the linear maps `f` and `g` to the left and right arguments of the sesquilinear form. -/
def comp (S : sesq_form R M I) (f g : M₂ →ₗ[R] M) : sesq_form R M₂ I :=
{ sesq := λ x y, S (f x) (g y),
  sesq_add_left := by simp [add_left],
  sesq_smul_left := by simp [smul_left],
  sesq_add_right := by simp [add_right],
  sesq_smul_right := by simp [smul_right] }

/-- Apply the linear map `f` to the left argument of the sesquilinear form. -/
def comp_left (S : sesq_form R M I) (f : M →ₗ[R] M) : sesq_form R M I :=
  S.comp f linear_map.id

/-- Apply the linear map `f` to the right argument of the sesquilinear form. -/
def comp_right (S : sesq_form R M I) (f : M →ₗ[R] M) : sesq_form R M I :=
  S.comp linear_map.id f

lemma comp_left_comp_right (S : sesq_form R M I) (f g : M →ₗ[R] M) :
  (S.comp_left f).comp_right g = S.comp f g := rfl

lemma comp_right_comp_left (S : sesq_form R M I) (f g : M →ₗ[R] M) :
  (S.comp_right g).comp_left f = S.comp f g := rfl

lemma comp_comp {M₃ : Type*} [add_comm_group M₃] [module R M₃]
  (S : sesq_form R M₃ I) (l r : M →ₗ[R] M₂) (l' r' : M₂ →ₗ[R] M₃) :
  (S.comp l' r').comp l r = S.comp (l'.comp l) (r'.comp r) := rfl

@[simp] lemma comp_apply (S : sesq_form R M₂ I) (l r : M →ₗ[R] M₂) (v w : M) :
  S.comp l r v w = S (l v) (r w) := rfl

@[simp] lemma comp_left_apply (S : sesq_form R M I) (f : M →ₗ[R] M) (v w : M) :
  S.comp_left f v w = S (f v) w := rfl

@[simp] lemma comp_right_apply (S : sesq_form R M I) (f : M →ₗ[R] M) (v w : M) :
  S.comp_right f v w = S v (f w) := rfl

/-- Let `l`, `r` be surjective linear maps, then two sesquilinear forms are equal if and only if
  the sesquilinear forms resulting from composition with `l` and `r` are equal. -/
lemma comp_injective (S₁ S₂ : sesq_form R M₂ I) {l r : M →ₗ[R] M₂}
  (hl : function.surjective l) (hr : function.surjective r) :
  S₁.comp l r = S₂.comp l r ↔ S₁ = S₂ :=
begin
  split; intros h,
  { ext,
    rcases hl x with ⟨x', rfl⟩,
    rcases hr y with ⟨y', rfl⟩,
    rw [← comp_apply, ← comp_apply, h], },
  { rw h },
end

end general_ring

section comm_ring

variables {R : Type*} [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
  {J : R ≃+* Rᵒᵖ} (F : sesq_form R M J) (f : M → M)

instance to_module : module R (sesq_form R M J) :=
{ smul := λ c S,
  { sesq := λ x y, c * S x y,
    sesq_add_left := λ x y z, by {unfold coe_fn has_coe_to_fun.coe sesq,
      rw [sesq_add_left, left_distrib]},
    sesq_smul_left := λ a x y, by {unfold coe_fn has_coe_to_fun.coe sesq,
      rw [sesq_smul_left, ←mul_assoc, mul_comm c, mul_assoc]},
    sesq_add_right := λ x y z, by {unfold coe_fn has_coe_to_fun.coe sesq,
      rw [sesq_add_right, left_distrib]},
    sesq_smul_right := λ a x y, by {unfold coe_fn has_coe_to_fun.coe sesq,
      rw [sesq_smul_right, ←mul_assoc, mul_comm c, mul_assoc], refl} },
  smul_add := λ c S D, by {ext, unfold coe_fn has_coe_to_fun.coe sesq, rw left_distrib},
  add_smul := λ c S D, by {ext, unfold coe_fn has_coe_to_fun.coe sesq, rw right_distrib},
  mul_smul := λ a c D, by {ext, unfold coe_fn has_coe_to_fun.coe sesq, rw mul_assoc},
  one_smul := λ S, by {ext, unfold coe_fn has_coe_to_fun.coe sesq, rw one_mul},
  zero_smul := λ S, by {ext, unfold coe_fn has_coe_to_fun.coe sesq, rw zero_mul},
  smul_zero := λ S, by {ext, unfold coe_fn has_coe_to_fun.coe sesq, rw mul_zero} }

end comm_ring

section domain

variables {R : Type*} [domain R]
  {M : Type v} [add_comm_group M] [module R M]
  {K : R ≃+* Rᵒᵖ} {G : sesq_form R M K}

theorem ortho_smul_left {x y : M} {a : R} (ha : a ≠ 0) :
(is_ortho G x y) ↔ (is_ortho G (a • x) y) :=
begin
  dunfold is_ortho,
  split; intro H,
  { rw [smul_left, H, mul_zero] },
  { rw [smul_left, mul_eq_zero] at H,
    cases H,
    { trivial },
    { exact H }}
end

theorem ortho_smul_right {x y : M} {a : R} (ha : a ≠ 0) :
(is_ortho G x y) ↔ (is_ortho G x (a • y)) :=
begin
  dunfold is_ortho,
  split; intro H,
  { rw [smul_right, H, mul_zero] },
  { rw [smul_right, mul_eq_zero] at H,
    cases H,
    { exfalso,
      -- `map_eq_zero_iff` doesn't fire here even if marked as a simp lemma, probably bcecause
      -- different instance paths
      simp only [opposite.unop_eq_zero_iff] at H,
      exact ha (K.map_eq_zero_iff.mp H), },
    { exact H }}
end

end domain

end sesq_form

namespace refl_sesq_form

open refl_sesq_form sesq_form

variables {R : Type*} {M : Type*} [ring R] [add_comm_group M] [module R M]
variables {I : R ≃+* Rᵒᵖ} {S : sesq_form R M I}

/-- The proposition that a sesquilinear form is reflexive -/
def is_refl (S : sesq_form R M I) : Prop := ∀ (x y : M), S x y = 0 → S y x = 0

variable (H : is_refl S)

lemma eq_zero : ∀ {x y : M}, S x y = 0 → S y x = 0 := λ x y, H x y

lemma ortho_sym {x y : M} :
is_ortho S x y ↔ is_ortho S y x := ⟨eq_zero H, eq_zero H⟩

end refl_sesq_form

namespace sym_sesq_form

open sym_sesq_form sesq_form

variables {R : Type*} {M : Type*} [ring R] [add_comm_group M] [module R M]
variables {I : R ≃+* Rᵒᵖ} {S : sesq_form R M I}

/-- The proposition that a sesquilinear form is symmetric -/
def is_sym (S : sesq_form R M I) : Prop := ∀ (x y : M), (I (S x y)).unop = S y x

variable (H : is_sym S)
include H

lemma sym (x y : M) : (I (S x y)).unop = S y x := H x y

lemma is_refl : refl_sesq_form.is_refl S := λ x y H1, by { rw [←H], simp [H1], }

lemma ortho_sym {x y : M} :
is_ortho S x y ↔ is_ortho S y x := refl_sesq_form.ortho_sym (is_refl H)

end sym_sesq_form

namespace alt_sesq_form

open alt_sesq_form sesq_form

variables {R : Type*} {M : Type*} [ring R] [add_comm_group M] [module R M]
variables {I : R ≃+* Rᵒᵖ} {S : sesq_form R M I}

/-- The proposition that a sesquilinear form is alternating -/
def is_alt (S : sesq_form R M I) : Prop := ∀ (x : M), S x x = 0

variable (H : is_alt S)
include H

lemma self_eq_zero (x : M) : S x x = 0 := H x

lemma neg (x y : M) :
- S x y = S y x :=
begin
  have H1 : S (x + y) (x + y) = 0,
  { exact self_eq_zero H (x + y) },
  rw [add_left, add_right, add_right,
    self_eq_zero H, self_eq_zero H, ring.zero_add,
    ring.add_zero, add_eq_zero_iff_neg_eq] at H1,
  exact H1,
end

end alt_sesq_form


-- Infinite products of analytic functions

import analysis.analytic.basic
import analysis.analytic.composition
import data.complex.basic
import data.real.basic
import data.real.ennreal
import data.real.nnreal
import data.real.pi.bounds
import data.set.basic
import data.stream.defs
import data.stream.init
import topology.metric_space.basic
import topology.uniform_space.uniform_convergence
import topology.algebra.infinite_sum

import analytic
import bounds
import finset
import holomorphic
import series
import simple
import tactics

open complex (abs exp log)
open filter (at_top)
open metric (ball closed_ball sphere)
open_locale classical real nnreal ennreal topological_space

noncomputable theory

-- Equivalents of has_sum and has_sum_on
def has_prod (f : ℕ → ℂ) (g : ℂ) := filter.tendsto (λ N : finset ℕ, N.prod (λ n, f n)) at_top (𝓝 g)
def has_prod_on (f : ℕ → ℂ → ℂ) (g : ℂ → ℂ) (s : set ℂ) := ∀ z, z ∈ s → has_prod (λ n, f n z) (g z)
def prod_exists (f : ℕ → ℂ) : Prop := ∃ g, has_prod f g
noncomputable def tprod (f : ℕ → ℂ) := if h : prod_exists f then classical.some h else 0
noncomputable def tprod_on (f : ℕ → ℂ → ℂ) := λ z, tprod (λ n, f n z)
def prod_exists_on (f : ℕ → ℂ → ℂ) (s : set ℂ) := ∀ z, z ∈ s → prod_exists (λ n, f n z)

-- Products are unique
lemma has_prod.unique {f : ℕ → ℂ} {a b : ℂ} : has_prod f a → has_prod f b → a = b := tendsto_nhds_unique
lemma has_prod.prod_exists {f : ℕ → ℂ} {g : ℂ} (h : has_prod f g) : prod_exists f := ⟨g,h⟩

-- tprod is the product if it exists
lemma has_prod.tprod_eq {f : ℕ → ℂ} {g : ℂ} : has_prod f g → tprod f = g := begin
  intro h, rw tprod, simp [h.prod_exists],
  have s := classical.some_spec (h.prod_exists),
  exact s.unique h
end

-- tprod_on is the product on s if it exists on s
lemma has_prod_on.tprod_on_eq {f : ℕ → ℂ → ℂ} {g : ℂ → ℂ} {s : set ℂ}
    : has_prod_on f g s → ∀ z, z ∈ s → tprod_on f z = g z := begin
  intros h z zs, exact (h z zs).tprod_eq
end

-- The product of ones is one
theorem prod_ones : has_prod (λ _, (1 : ℂ)) 1 := by { rw has_prod, simp, exact tendsto_const_nhds }

-- The product of ones is one (tprod version)
theorem prod_ones' : tprod (λ _, (1 : ℂ)) = 1 := has_prod.tprod_eq prod_ones

-- Analytic products that converge exponentially converge to analytic functions.
-- For now, we require the constant to be ≤ 1/2 so that we can take logs without care.
theorem fast_products_converge {f : ℕ → ℂ → ℂ} {s : set ℂ} {a c : ℝ}
    (o : is_open s) (c12 : c ≤ 1/2) (a0 : a ≥ 0) (a1 : a < 1)
    (h : ∀ n, analytic_on ℂ (f n) s) (hf : ∀ n z, z ∈ s → abs (f n z - 1) ≤ c * a^n)
    : ∃ (g : ℂ → ℂ), has_prod_on f g s ∧ analytic_on ℂ g s := begin
  set fl := λ n z, log (f n z),
  have near1 : ∀ n z, z ∈ s → abs (f n z - 1) ≤ 1/2, {
    intros n z zs,
    calc abs (f n z - 1) ≤ c * a^n : hf n z zs
    ... ≤ (1/2 : ℝ) * 1^n : by bound
    ... = 1/2 : by norm_num
  },
  have near1' : ∀ n z, z ∈ s → abs (f n z - 1) < 1 := λ n z zs, lt_of_le_of_lt (near1 n z zs) (by bound),
  have expfl : ∀ n z, z ∈ s → exp (fl n z) = f n z, {
    intros n z zs, refine complex.exp_log _,
    exact near_one_avoids_zero (near1' n z zs)
  },
  have hl : ∀ n, analytic_on ℂ (fl n) s := λ n, log_analytic_near_one o (h n) (near1' n),
  set c2 := 2 * c,
  have hfl : ∀ n z, z ∈ s → abs (fl n z) ≤ c2 * a^n, {
    intros n z zs,
    calc abs (fl n z) = abs (log (f n z)) : rfl
    ... ≤ 2 * abs (f n z - 1) : log_small (near1 n z zs)
    ... ≤ 2 * (c * a^n) : by bound [hf n z zs]
    ... = 2 * c * a^n : by ring
    ... = c2 * a^n : rfl
  },
  rcases fast_series_converge o a0 a1 hl hfl with ⟨gl,gla,us⟩,
  set g := λ z, exp (gl z),
  existsi g,
  constructor, {
    intros z zs,
    specialize us z zs, simp at us,
    have comp : filter.tendsto (exp ∘ λ N : finset ℕ, N.sum (λ n, fl n z)) at_top (𝓝 (exp (gl z)))
      := filter.tendsto.comp (continuous.tendsto complex.continuous_exp _) us,
    have expsum0 : (exp ∘ λ N : finset ℕ, N.sum (λ n, fl n z)) = λ N : finset ℕ, N.prod (λ n, f n z), {
      apply funext, intro N, simp, rw complex.exp_sum, simp_rw expfl _ z zs,
    },
    rw expsum0 at comp, assumption
  }, {
    intros z zs,
    exact analytic_at.comp (entire.exp _) (gla z zs)
  }
end

-- Same as above, but converge to tprod_on
theorem fast_products_converge' {f : ℕ → ℂ → ℂ} {s : set ℂ} {c a : ℝ}
    (o : is_open s) (c12 : c ≤ 1/2) (a0 : 0 ≤ a) (a1 : a < 1)
    (h : ∀ n, analytic_on ℂ (f n) s) (hf : ∀ n z, z ∈ s → abs (f n z - 1) ≤ c * a^n)
    : prod_exists_on f s ∧ analytic_on ℂ (tprod_on f) s := begin
  rcases fast_products_converge o c12 a0 a1 h hf with ⟨g,gp,ga⟩,
  constructor, {
    intros z zs, existsi g z, exact gp z zs
  }, {
    rwa ←analytic_on_congr o (λ z zs, (gp.tprod_on_eq z zs).symm),
  }
end

-- Powers commute with products
theorem product_pow {f : ℕ → ℂ} {g : ℂ} (p : ℕ) (h : has_prod f g) : has_prod (λ n, f n ^ p) (g ^ p) := begin
  rw has_prod, simp_rw finset.prod_pow,
  exact filter.tendsto.comp (continuous.tendsto (continuous_pow p) g) h
end

-- Powers commute with products (tprod version)
theorem product_pow' {f : ℕ → ℂ} {p : ℕ} (h : prod_exists f) : (tprod f) ^ p = tprod (λ n, f n ^ p) := begin
  rcases h with ⟨g,h⟩, rw has_prod.tprod_eq h, rw has_prod.tprod_eq _, exact product_pow p h
end

-- Adding one more term to a product multiplies by it
theorem product_cons {a g : ℂ} {f : ℕ → ℂ} (h : has_prod f g) : has_prod (a :: f) (a * g) := begin
  rw has_prod at ⊢ h,
  have ha := filter.tendsto.comp (continuous.tendsto (continuous_mul_left a) g) h,
  have s : (λ z, a * z) ∘ (λ N : finset ℕ, N.prod f) = (λ N : finset ℕ, N.prod (a::f)) ∘ push, {
    apply funext, intro N, simp, exact push_prod
  },
  rw s at ha,
  exact tendsto_comp_push.mp ha
end

-- Adding one more term to a product multiplies by it (tprod version)
theorem product_cons' {a : ℂ} {f : ℕ → ℂ} (h : prod_exists f) : tprod (a :: f) = a * tprod f := begin
  rcases h with ⟨g,h⟩, rw has_prod.tprod_eq h, rw has_prod.tprod_eq _, exact product_cons h
end

-- Dropping a nonzero term divides by it
theorem product_drop {f : ℕ → ℂ} {g : ℂ} (f0 : f 0 ≠ 0) (h : has_prod f g) : has_prod (λ n, f (n+1)) (g / f 0) := begin
  have c := @product_cons (f 0)⁻¹ _ _ h,
  rw has_prod,
  rw [inv_mul_eq_div, has_prod, ←tendsto_comp_push, ←tendsto_comp_push] at c,
  have s : ((λ N : finset ℕ, N.prod (λ n, ((f 0)⁻¹::f) n)) ∘ push) ∘ push = λ N : finset ℕ, N.prod (λ n, f (n+1)), {
    clear c h g, apply funext, intro N, simp,
    nth_rewrite 1 ←stream.eta f,
    rw [←push_prod, ←push_prod, stream.head, stream.tail],
    field_simp, ring
  },
  rw s at c, assumption
end

-- Dropping a nonzero term divides by it (tprod version)
theorem product_drop' {f : ℕ → ℂ} (f0 : f 0 ≠ 0) (h : prod_exists f) : tprod (λ n, f (n+1)) = tprod f / f 0 := begin
  rcases h with ⟨g,h⟩, rw has_prod.tprod_eq h, rw has_prod.tprod_eq _, exact product_drop f0 h
end

-- Products that start with zero are zero
lemma product_head_zero {f : ℕ → ℂ} (f0 : f 0 = 0) : has_prod f 0 := begin
  rw has_prod, rw metric.tendsto_at_top, intros e ep,
  existsi (finset.range 1), intros N N1,
  simp at N1, rw finset.prod_eq_zero N1 f0, simpa
end

-- Separate out head and tail in a product
theorem product_split {f : ℕ → ℂ} (h : prod_exists f) : tprod f = f 0 * tprod (λ n, f (n+1)) := begin
  by_cases f0 : f 0 = 0, { rw [f0, (product_head_zero f0).tprod_eq], simp },
  rw [product_drop' f0 h], field_simp, exact mul_comm _ _
end

-- The zero product
theorem has_prod.zero : has_prod (λ _, 0) 0 := begin apply product_head_zero, refl end


import tactic
import tactic.positivity
import data.set.intervals.basic
import data.rat.order
import data.nat.gcd
import data.finset.basic
import ring_theory.int.basic
open_locale big_operators
open_locale classical

def P (n m a : ℕ) : Prop := a ≤ m - 1 ∧ m < n * a

lemma exists_a {n m : ℕ} (h₁ : n > 0) (h₂ : n < m) (h₃ : ¬ n ∣ m) :
  ∃ a, P n m a :=
begin
  have : n > 1,
  { by_contra,
    push_neg at h,
    have h₄ : n = 1 := by interval_cases n,
    exact (h₄ ▸ h₃) (one_dvd _) },
  have : m > 0 := lt_trans h₁ h₂,

  use m - 1,
  refine ⟨le_refl (m-1), _⟩,
  -- Why can't `mono` prove `m + n < m + m` :madge:
  have : m + n < n * m := calc m + n < m + m : add_lt_add_left h₂ _
  ... = 2 * m : (two_mul _).symm
  ... ≤ n * m : by {mono, positivity},

  linarith
end

lemma a_prop {n m : ℕ} (h₁ : n > 0) (h₂ : n < m) (h₃ : ¬ n ∣ m) :
let a := nat.find (exists_a h₁ h₂ h₃) in
  a > 0 ∧ a * n - m < n ∧ a * n < 2 * m :=
begin
  -- Find some way to eliminate this duplication
  let Q := exists_a h₁ h₂ h₃,
  set a := nat.find Q with ha,
  obtain ⟨ha₁, ha₂⟩ := nat.find_spec Q,

  have h₄ : a > 0,
  { by_contra h', push_neg at h',
    replace h' := nat.eq_zero_of_le_zero h',
    refine nat.not_lt_zero m _,
    have := ha₂,
    rwa [←ha, h', mul_zero] at this },
  split,
    exact h₄,

  have h₅ : a * n < m + n,
  { by_contra, push_neg at h,

    have : m + n ≠ a * n,
    { by_contra h',
      have : m = (a - 1) * n := by linarith,
      rw dvd_iff_exists_eq_mul_left at h₃,
      exact h₃ (exists.intro (a - 1) this) },
    replace h := ne.lt_of_le this h,

    have h₆ : P n m (a - 1),
    { split,
      { exact le_trans (nat.pred_le _) ha₁ },
      { linarith } },

    have h₇ : a - 1 < a := by linarith,
    exact nat.find_min (exists_a h₁ h₂ h₃) h₇ h₆ },

  -- Needs to be in this exact form for `linarith` to work
  have : m ≤ a * n := by {rw mul_comm, exact le_of_lt ha₂},

  split; rw ←ha,
  { linarith },
  { calc a * n < m + n : h₅
    ... < m + m : add_lt_add_left h₂ _
    ... = 2 * m : (two_mul _).symm }
end

lemma coe_to_nat {z : ℤ} (h : z > 0) :
  z = ↑(z.to_nat) :=
by { cases z, refl, linarith [int.neg_succ_of_nat_lt_zero z] }

-- This should be in `mathlib`
lemma to_nat_of_pos {z : ℤ} (h : z > 0) : z.to_nat > 0 :=
begin
  by_contra h', push_neg at h',
  linarith [int.to_nat_eq_zero.mp $ nat.eq_zero_of_le_zero h']
end

lemma one_div_eq_mk {n : ℕ} (hn : n > 0) : 1 / ↑n = rat.mk 1 n :=
by { rw [rat.mk_eq_div, div_eq_div_iff]; simp; linarith }

lemma one_div_eq_mk' (n : ℕ+) : 1 / ↑n = rat.mk 1 n :=
by { rw [rat.mk_eq_div, div_eq_div_iff]; simp; linarith }

lemma pos_one_div {n : ℕ} (hn : n > 0) : 0 < rat.mk 1 ↑n :=
begin
  rw [rat.mk_eq_div, div_pos_iff],
  left; norm_cast,
  exact ⟨by positivity, hn⟩
end

lemma pos_one_div' (n : ℕ+) : (0 : ℚ) < 1 / ↑n :=
by simp

example (r : ℚ) (hr : r ∈ set.Ioo (0 : ℚ) 1) :
  ∃ (S : finset ℕ+), r = ∑ x in S, 1 / x :=
begin
  generalize h : r.num.to_nat - 1 = n,
  revert r,
  induction n using nat.case_strong_induction_on with i hi,

  all_goals {
    intros r hr h,
    set n := r.num with hn,
    set m : ℤ := ↑r.denom with hm,
    have npos : n > 0 := rat.num_pos_iff_pos.mpr hr.1,
    have n_lt_m : n < m := rat.lt_one_iff_num_lt_denom.mp hr.2
  },

  { have n_eq_1 : n = 1,
    { rw [←int.pred_to_nat _, int.to_nat_eq_zero] at h,
      linarith },
    use {⟨r.denom, r.pos⟩},
    rw [finset.sum_singleton],
    conv_lhs { rw [←@rat.num_denom r, ←hn, ←hm, n_eq_1] },
    simp [rat.mk_eq_div] },

  { -- Note that `n` and `m` have type `ℤ` instead of `ℕ`
    have mpos_int : m > 0 := int.coe_nat_pos.mpr r.pos,
    have npos_nat : n.to_nat > 0 := to_nat_of_pos npos,
    have n_gt_1_nat : n.to_nat > 1 := calc n.to_nat = i.succ + 1 : by linarith [h]
      ... > 0 + 1 : by simp
      ... = 1 : zero_add _,

    have n_lt_m_nat : n.to_nat < m.to_nat := by rwa int.to_nat_lt_to_nat mpos_int,
    have n_ndvd_m_nat : ¬ n.to_nat ∣ m.to_nat,
    { by_contra n_dvd_m_nat,
      have h₁ : ¬ n.to_nat.coprime m.to_nat := nat.not_coprime_of_dvd_of_dvd
        n_gt_1_nat (dvd_refl _) n_dvd_m_nat,

      have hnp : ¬ n.nat_abs.coprime r.denom,
      { convert h₁,
        cases r.num with _ x,
        { rw hn, refl },
        linarith [int.neg_succ_of_nat_lt_zero x] },

      exact hnp r.cop },

    let Q := exists_a npos_nat n_lt_m_nat n_ndvd_m_nat,
    set a := nat.find Q with ha,
    obtain ⟨a_lt_m, m_lt_na⟩ := nat.find_spec Q,
    obtain ⟨apos, an_sub_m_lt_n, an_lt_2m⟩ := a_prop npos_nat n_lt_m_nat n_ndvd_m_nat,
    have apos_int := int.coe_nat_pos.mpr apos,

    -- `hs'` is the clean untainted version, and
    -- we will do some manipulations on `hs`
    set s := r - rat.mk 1 a with hs',
    have hs := hs',
    rw [←@rat.num_denom r, rat.sub_def, one_mul] at hs,
    rotate, -- handle subgoals generated by `rat.sub_def`
    { exact ne_of_gt (int.coe_nat_pos.mpr r.pos) },
    { norm_cast, rw ha, linarith [a_lt_m] },

    have h₁ : n * a > 0 := int.mul_pos npos apos_int,

    have h₂ : 0 < n * a - m,
    { rw [coe_to_nat npos, sub_pos],
      norm_cast,
      assumption },

    have h₃ : s.num ≤ n * a - m,
    { refine int.le_of_dvd h₂ _,
      rw hs,
      exact (rat.num_dvd (n * ↑a - m) $ ne_of_gt $
        int.mul_pos mpos_int apos_int) },

    have h₄ : ↑a * n = ↑(a * n.to_nat),
    { rw coe_to_nat npos, norm_cast },

    have h₅ : ↑a * n - m < n,
    { rw [coe_to_nat npos, sub_lt_iff_lt_add],
      norm_cast,
      -- idk why `linarith` can't solve this...
      replace an_sub_m_lt_n := nat.add_lt_add_right an_sub_m_lt_n m.to_nat,
      rwa [mul_comm, nat.sub_add_cancel (le_of_lt m_lt_na), mul_comm] at an_sub_m_lt_n },

    have h₆ : s.num < n := calc s.num ≤ n * a - m : h₃
      ... = a * n - m : by rw mul_comm
      ... < n : h₅,

    have h₇ : s.num.to_nat - 1 ≤ i,
    { rw nat.sub_eq_iff_eq_add (le_of_lt n_gt_1_nat) at h,
      rw [←nat.pred_eq_sub_one, nat.pred_le_iff, ←nat.lt_succ_iff],
      calc s.num.to_nat < n.to_nat : (int.to_nat_lt_to_nat npos).mpr h₆
      ... = i.succ + 1 : h },

    have spos : 0 < s,
    { rw [hs, rat.mk_eq_div, div_pos_iff],
      left; norm_cast,
      exact ⟨h₂, nat.mul_pos r.pos apos⟩ },

    specialize hi (s.num.to_nat - 1) h₇ s _ rfl,
    { split,
      { exact spos },
      { rw hs',
        calc r - rat.mk 1 ↑a < r : (sub_lt_self_iff _).mpr (pos_one_div apos)
        ... < 1 : hr.2 } },

    obtain ⟨S, hS⟩ := hi,
    have h₈ : (⟨a, apos⟩ : ℕ+) ∉ S,
    { by_contra h',
      have h₉ : S.nonempty,
      { by_contra Sempty,
        rw finset.not_nonempty_iff_eq_empty at Sempty,
        rw [Sempty, finset.sum_empty] at hS,
        linarith [spos] },

      have h₁₀ := finset.sum_pos (λ (b : ℕ+) _, (@pos_one_div' b)) h₉,

      have h₁₁ : (1 : ℚ) / a ≤ s,
      { rw hS,
        exact finset.single_le_sum (λ (b : ℕ+) _, le_of_lt (@pos_one_div' b)) h' },

      have h₁₂ : r ≥ 2 / ↑a := calc r = s + rat.mk 1 a : by linarith [hs]
      ... ≥ 1 / ↑a + rat.mk 1 a : add_le_add_right h₁₁ _
      ... = 1 / ↑a + 1 / ↑a : by rw one_div_eq_mk apos
      ... = 2 / ↑a : by {field_simp, abel},

      have apos_rat : (↑a : ℚ) > 0 := by {norm_cast, exact apos},
      have mpos_rat : (↑m : ℚ) > 0 := by {norm_cast, zify, exact mpos_int},

      have h₁₃ : ↑a * n ≥ 2 * m,
      { rw [←@rat.num_denom r, rat.mk_eq_div] at h₁₂,
        change (2 : ℚ) / ↑a ≤ ↑n / ↑m at h₁₂,
        rw div_le_div_iff apos_rat mpos_rat at h₁₂,
        norm_cast at h₁₂,
        convert h₁₂ using 1,
        ring },

      rw h₄ at h₁₃,
      norm_cast at h₁₃,
      rw ←int.to_nat_coe_nat r.denom at h₁₃,
      linarith only [h₁₃, an_lt_2m] },

    use finset.cons ⟨a, apos⟩ S h₈,
    rw [finset.sum_cons, ←hS, one_div_eq_mk' ⟨a, apos⟩],
    simp [hs']
  }
end


/-
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 Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.pgame
import Mathlib.PostPort

universes u_1 u

namespace Mathlib

/-!
# Combinatorial games.

In this file we define the quotient of pre-games by the equivalence relation `p ≈ q ↔ p ≤ q ∧ q ≤
p`, and construct an instance `add_comm_group game`, as well as an instance `partial_order game`
(although note carefully the warning that the `<` field in this instance is not the usual relation
on combinatorial games).
-/

protected instance pgame.setoid : setoid pgame :=
  setoid.mk (fun (x y : pgame) => pgame.equiv x y) sorry

/-- The type of combinatorial games. 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 combinatorial pre-game is built
  inductively from two families of combinatorial 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.
  A combinatorial game is then constructed by quotienting by the equivalence
  `x ≈ y ↔ x ≤ y ∧ y ≤ x`. -/
def game :=
  quotient pgame.setoid

namespace game

/-- The relation `x ≤ y` on games. -/
def le : game → game → Prop :=
  quotient.lift₂ (fun (x y : pgame) => x ≤ y) sorry

protected instance has_le : HasLessEq game :=
  { LessEq := le }

theorem le_refl (x : game) : x ≤ x :=
  quot.induction_on x fun (x : pgame) => pgame.le_refl x

theorem le_trans (x : game) (y : game) (z : game) : x ≤ y → y ≤ z → x ≤ z :=
  quot.induction_on x
    fun (x : pgame) => quot.induction_on y fun (y : pgame) => quot.induction_on z fun (z : pgame) => pgame.le_trans

theorem le_antisymm (x : game) (y : game) : x ≤ y → y ≤ x → x = y := sorry

/-- The relation `x < y` on games. -/
-- We don't yet make this into an instance, because it will conflict with the (incorrect) notion

-- of `<` provided by `partial_order` later.

def lt : game → game → Prop :=
  quotient.lift₂ (fun (x y : pgame) => x < y) sorry

theorem not_le {x : game} {y : game} : ¬x ≤ y ↔ lt y x :=
  quot.induction_on x fun (x : pgame) => quot.induction_on y fun (y : pgame) => pgame.not_le

protected instance has_zero : HasZero game :=
  { zero := quotient.mk 0 }

protected instance inhabited : Inhabited game :=
  { default := 0 }

protected instance has_one : HasOne game :=
  { one := quotient.mk 1 }

/-- The negation of `{L | R}` is `{-R | -L}`. -/
def neg : game → game :=
  Quot.lift (fun (x : pgame) => quotient.mk (-x)) sorry

protected instance has_neg : Neg game :=
  { neg := neg }

/-- The sum of `x = {xL | xR}` and `y = {yL | yR}` is `{xL + y, x + yL | xR + y, x + yR}`. -/
def add : game → game → game :=
  quotient.lift₂ (fun (x y : pgame) => quotient.mk (x + y)) sorry

protected instance has_add : Add game :=
  { add := add }

theorem add_assoc (x : game) (y : game) (z : game) : x + y + z = x + (y + z) :=
  quot.induction_on x
    fun (x : pgame) =>
      quot.induction_on y fun (y : pgame) => quot.induction_on z fun (z : pgame) => quot.sound pgame.add_assoc_equiv

protected instance add_semigroup : add_semigroup game :=
  add_semigroup.mk Add.add add_assoc

theorem add_zero (x : game) : x + 0 = x :=
  quot.induction_on x fun (x : pgame) => quot.sound (pgame.add_zero_equiv x)

theorem zero_add (x : game) : 0 + x = x :=
  quot.induction_on x fun (x : pgame) => quot.sound (pgame.zero_add_equiv x)

protected instance add_monoid : add_monoid game :=
  add_monoid.mk add_semigroup.add add_semigroup.add_assoc 0 zero_add add_zero

theorem add_left_neg (x : game) : -x + x = 0 :=
  quot.induction_on x fun (x : pgame) => quot.sound pgame.add_left_neg_equiv

protected instance add_group : add_group game :=
  add_group.mk add_monoid.add add_monoid.add_assoc add_monoid.zero add_monoid.zero_add add_monoid.add_zero Neg.neg
    (sub_neg_monoid.sub._default add_monoid.add add_monoid.add_assoc add_monoid.zero add_monoid.zero_add
      add_monoid.add_zero Neg.neg)
    add_left_neg

theorem add_comm (x : game) (y : game) : x + y = y + x :=
  quot.induction_on x fun (x : pgame) => quot.induction_on y fun (y : pgame) => quot.sound pgame.add_comm_equiv

protected instance add_comm_semigroup : add_comm_semigroup game :=
  add_comm_semigroup.mk add_semigroup.add add_semigroup.add_assoc add_comm

protected instance add_comm_group : add_comm_group game :=
  add_comm_group.mk add_comm_semigroup.add add_comm_semigroup.add_assoc add_group.zero add_group.zero_add
    add_group.add_zero add_group.neg add_group.sub add_group.add_left_neg add_comm_semigroup.add_comm

theorem add_le_add_left (a : game) (b : game) : a ≤ b → ∀ (c : game), c + a ≤ c + b := sorry

-- While it is very tempting to define a `partial_order` on games, and prove

-- that games form an `ordered_add_comm_group`, it is a bit dangerous.

-- The relations `≤` and `<` on games do not satisfy

-- `lt_iff_le_not_le : ∀ a b : α, a < b ↔ (a ≤ b ∧ ¬ b ≤ a)`

-- (Consider `a = 0`, `b = star`.)

-- (`lt_iff_le_not_le` is satisfied by surreal numbers, however.)

-- Thus we can not use `<` when defining a `partial_order`.

-- Because of this issue, we define the `partial_order` and `ordered_add_comm_group` instances,

-- but do not actually mark them as instances, for safety.

/-- The `<` operation provided by this partial order is not the usual `<` on games! -/
def game_partial_order : partial_order game :=
  partial_order.mk LessEq (preorder.lt._default LessEq) le_refl le_trans le_antisymm

/-- The `<` operation provided by this `ordered_add_comm_group` is not the usual `<` on games! -/
def ordered_add_comm_group_game : ordered_add_comm_group game :=
  ordered_add_comm_group.mk add_comm_group.add add_comm_group.add_assoc add_comm_group.zero add_comm_group.zero_add
    add_comm_group.add_zero add_comm_group.neg add_comm_group.sub add_comm_group.add_left_neg add_comm_group.add_comm
    partial_order.le partial_order.lt partial_order.le_refl partial_order.le_trans partial_order.le_antisymm
    add_le_add_left


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.homotopy_equivalence
! leanprover-community/mathlib commit f951e201d416fb50cc7826171d80aa510ec20747
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.DoldKan.Normalized

/-!

# The normalized Moore complex and the alternating face map complex are homotopy equivalent

In this file, when the category `A` is abelian, we obtain the homotopy equivalence
`homotopy_equiv_normalized_Moore_complex_alternating_face_map_complex` between the
normalized Moore complex and the alternating face map complex of a simplicial object in `A`.

-/

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits CategoryTheory.Preadditive

open Simplicial DoldKan

noncomputable section

namespace AlgebraicTopology

namespace DoldKan

variable {C : Type _} [Category C] [Preadditive C] (X : SimplicialObject C)

/-- Inductive construction of homotopies from `P q` to `𝟙 _` -/
noncomputable def homotopyPToId : ∀ q : ℕ, Homotopy (p q : K[X] ⟶ _) (𝟙 _)
  | 0 => Homotopy.refl _
  | q + 1 =>
    by
    refine'
      Homotopy.trans (Homotopy.ofEq _)
        (Homotopy.trans
          (Homotopy.add (homotopy_P_to_id q) (Homotopy.compLeft (homotopy_Hσ_to_zero q) (P q)))
          (Homotopy.ofEq _))
    · unfold P
      simp only [comp_add, comp_id]
    · simp only [add_zero, comp_zero]
#align algebraic_topology.dold_kan.homotopy_P_to_id AlgebraicTopology.DoldKan.homotopyPToId

/-- The complement projection `Q q` to `P q` is homotopic to zero. -/
def homotopyQToZero (q : ℕ) : Homotopy (q q : K[X] ⟶ _) 0 :=
  Homotopy.equivSubZero.toFun (homotopyPToId X q).symm
#align algebraic_topology.dold_kan.homotopy_Q_to_zero AlgebraicTopology.DoldKan.homotopyQToZero

theorem homotopyPToId_eventually_constant {q n : ℕ} (hqn : n < q) :
    ((homotopyPToId X (q + 1)).Hom n (n + 1) : X _[n] ⟶ X _[n + 1]) =
      (homotopyPToId X q).Hom n (n + 1) :=
  by
  unfold homotopy_P_to_id
  simp only [homotopy_Hσ_to_zero, hσ'_eq_zero hqn (c_mk (n + 1) n rfl), Homotopy.trans_hom,
    Pi.add_apply, Homotopy.ofEq_hom, Pi.zero_apply, Homotopy.add_hom, Homotopy.compLeft_hom,
    Homotopy.nullHomotopy'_hom, ComplexShape.down_Rel, eq_self_iff_true, dite_eq_ite, if_true,
    comp_zero, add_zero, zero_add]
#align algebraic_topology.dold_kan.homotopy_P_to_id_eventually_constant AlgebraicTopology.DoldKan.homotopyPToId_eventually_constant

variable (X)

/-- Construction of the homotopy from `P_infty` to the identity using eventually
(termwise) constant homotopies from `P q` to the identity for all `q` -/
@[simps]
def homotopyPInftyToId : Homotopy (pInfty : K[X] ⟶ _) (𝟙 _)
    where
  Hom i j := (homotopyPToId X (j + 1)).Hom i j
  zero' i j hij := Homotopy.zero _ i j hij
  comm n := by
    cases n
    ·
      simpa only [Homotopy.dNext_zero_chainComplex, Homotopy.prevD_chainComplex, P_f_0_eq, zero_add,
        HomologicalComplex.id_f, P_infty_f] using (homotopy_P_to_id X 2).comm 0
    ·
      simpa only [Homotopy.dNext_succ_chainComplex, Homotopy.prevD_chainComplex,
        HomologicalComplex.id_f, P_infty_f, ← P_is_eventually_constant (rfl.le : n + 1 ≤ n + 1),
        homotopy_P_to_id_eventually_constant X (lt_add_one (n + 1))] using
        (homotopy_P_to_id X (n + 2)).comm (n + 1)
#align algebraic_topology.dold_kan.homotopy_P_infty_to_id AlgebraicTopology.DoldKan.homotopyPInftyToId

/-- The inclusion of the Moore complex in the alternating face map complex
is an homotopy equivalence -/
@[simps]
def homotopyEquivNormalizedMooreComplexAlternatingFaceMapComplex {A : Type _} [Category A]
    [Abelian A] {Y : SimplicialObject A} :
    HomotopyEquiv ((normalizedMooreComplex A).obj Y) ((alternatingFaceMapComplex A).obj Y)
    where
  Hom := inclusionOfMooreComplexMap Y
  inv := pInftyToNormalizedMooreComplex Y
  homotopyHomInvId := Homotopy.ofEq (splitMonoInclusionOfMooreComplexMap Y).id
  homotopyInvHomId :=
    Homotopy.trans
      (Homotopy.ofEq (pInftyToNormalizedMooreComplex_comp_inclusionOfMooreComplexMap Y))
      (homotopyPInftyToId Y)
#align algebraic_topology.dold_kan.homotopy_equiv_normalized_Moore_complex_alternating_face_map_complex AlgebraicTopology.DoldKan.homotopyEquivNormalizedMooreComplexAlternatingFaceMapComplex

end DoldKan

end AlgebraicTopology


/-
Copyright (c) 2021 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Junyan Xu
-/
import algebraic_geometry.Scheme
import category_theory.adjunction.limits
import category_theory.adjunction.reflective

/-!
# Adjunction between `Γ` and `Spec`

We define the adjunction `Γ_Spec.adjunction : Γ ⊣ Spec` by defining the unit (`to_Γ_Spec`,
in multiple steps in this file) and counit (done in Spec.lean) and checking that they satisfy
the left and right triangle identities. The constructions and proofs make use of
maps and lemmas defined and proved in structure_sheaf.lean extensively.

Notice that since the adjunction is between contravariant functors, you get to choose
one of the two categories to have arrows reversed, and it is equally valid to present
the adjunction as `Spec ⊣ Γ` (`Spec.to_LocallyRingedSpace.right_op ⊣ Γ`), in which
case the unit and the counit would switch to each other.

## Main definition

* `algebraic_geometry.identity_to_Γ_Spec` : The natural transformation `𝟭 _ ⟶ Γ ⋙ Spec`.
* `algebraic_geometry.Γ_Spec.LocallyRingedSpace_adjunction` : The adjunction `Γ ⊣ Spec` from
  `CommRingᵒᵖ` to `LocallyRingedSpace`.
* `algebraic_geometry.Γ_Spec.adjunction` : The adjunction `Γ ⊣ Spec` from
  `CommRingᵒᵖ` to `Scheme`.

-/

noncomputable theory
universes u

open prime_spectrum

namespace algebraic_geometry
open opposite
open category_theory
open structure_sheaf Spec (structure_sheaf)
open topological_space
open algebraic_geometry.LocallyRingedSpace
open Top.presheaf
open Top.presheaf.sheaf_condition

namespace LocallyRingedSpace

variable (X : LocallyRingedSpace.{u})

/-- The map from the global sections to a stalk. -/
def Γ_to_stalk (x : X) : Γ.obj (op X) ⟶ X.presheaf.stalk x :=
X.presheaf.germ (⟨x,trivial⟩ : (⊤ : opens X))

/-- The canonical map from the underlying set to the prime spectrum of `Γ(X)`. -/
def to_Γ_Spec_fun : X → prime_spectrum (Γ.obj (op X)) :=
λ x, comap (X.Γ_to_stalk x) (local_ring.closed_point (X.presheaf.stalk x))

lemma not_mem_prime_iff_unit_in_stalk (r : Γ.obj (op X)) (x : X) :
  r ∉ (X.to_Γ_Spec_fun x).as_ideal ↔ is_unit (X.Γ_to_stalk x r) :=
by erw [local_ring.mem_maximal_ideal, not_not]

/-- The preimage of a basic open in `Spec Γ(X)` under the unit is the basic
open in `X` defined by the same element (they are equal as sets). -/
lemma to_Γ_Spec_preim_basic_open_eq (r : Γ.obj (op X)) :
  X.to_Γ_Spec_fun⁻¹' (basic_open r).1 = (X.to_RingedSpace.basic_open r).1 :=
by { ext, erw X.to_RingedSpace.mem_top_basic_open, apply not_mem_prime_iff_unit_in_stalk }

/-- `to_Γ_Spec_fun` is continuous. -/
lemma to_Γ_Spec_continuous : continuous X.to_Γ_Spec_fun :=
begin
  apply is_topological_basis_basic_opens.continuous,
  rintro _ ⟨r, rfl⟩,
  erw X.to_Γ_Spec_preim_basic_open_eq r,
  exact (X.to_RingedSpace.basic_open r).2,
end

/-- The canonical (bundled) continuous map from the underlying topological
space of `X` to the prime spectrum of its global sections. -/
@[simps]
def to_Γ_Spec_base : X.to_Top ⟶ Spec.Top_obj (Γ.obj (op X)) :=
{ to_fun := X.to_Γ_Spec_fun,
  continuous_to_fun := X.to_Γ_Spec_continuous }

variable (r : Γ.obj (op X))

/-- The preimage in `X` of a basic open in `Spec Γ(X)` (as an open set). -/
abbreviation to_Γ_Spec_map_basic_open : opens X :=
(opens.map X.to_Γ_Spec_base).obj (basic_open r)

/-- The preimage is the basic open in `X` defined by the same element `r`. -/
lemma to_Γ_Spec_map_basic_open_eq : X.to_Γ_Spec_map_basic_open r = X.to_RingedSpace.basic_open r :=
opens.ext (X.to_Γ_Spec_preim_basic_open_eq r)

/-- The map from the global sections `Γ(X)` to the sections on the (preimage of) a basic open. -/
abbreviation to_to_Γ_Spec_map_basic_open :
  X.presheaf.obj (op ⊤) ⟶ X.presheaf.obj (op $ X.to_Γ_Spec_map_basic_open r) :=
X.presheaf.map (X.to_Γ_Spec_map_basic_open r).le_top.op

/-- `r` is a unit as a section on the basic open defined by `r`. -/
lemma is_unit_res_to_Γ_Spec_map_basic_open :
  is_unit (X.to_to_Γ_Spec_map_basic_open r r) :=
begin
  convert (X.presheaf.map $ (eq_to_hom $ X.to_Γ_Spec_map_basic_open_eq r).op)
    .is_unit_map (X.to_RingedSpace.is_unit_res_basic_open r),
  rw ← comp_apply,
  erw ← functor.map_comp,
  congr
end

/-- Define the sheaf hom on individual basic opens for the unit. -/
def to_Γ_Spec_c_app :
  (structure_sheaf $ Γ.obj $ op X).val.obj (op $ basic_open r) ⟶
    X.presheaf.obj (op $ X.to_Γ_Spec_map_basic_open r) :=
is_localization.away.lift r (is_unit_res_to_Γ_Spec_map_basic_open _ r)

/-- Characterization of the sheaf hom on basic opens,
    direction ← (next lemma) is used at various places, but → is not used in this file. -/
lemma to_Γ_Spec_c_app_iff
  (f : (structure_sheaf $ Γ.obj $ op X).val.obj (op $ basic_open r) ⟶
    X.presheaf.obj (op $ X.to_Γ_Spec_map_basic_open r)) :
  to_open _ (basic_open r) ≫ f = X.to_to_Γ_Spec_map_basic_open r ↔ f = X.to_Γ_Spec_c_app r :=
begin
  rw ← (is_localization.away.away_map.lift_comp r
    (X.is_unit_res_to_Γ_Spec_map_basic_open r)),
  swap 5, exact is_localization.to_basic_open _ r,
  split,
  { intro h, refine is_localization.ring_hom_ext _ _,
    swap 5, exact is_localization.to_basic_open _ r, exact h },
  apply congr_arg,
end

lemma to_Γ_Spec_c_app_spec :
  to_open _ (basic_open r) ≫ X.to_Γ_Spec_c_app r = X.to_to_Γ_Spec_map_basic_open r :=
(X.to_Γ_Spec_c_app_iff r _).2 rfl

/-- The sheaf hom on all basic opens, commuting with restrictions. -/
def to_Γ_Spec_c_basic_opens :
  (induced_functor basic_open).op ⋙ (structure_sheaf (Γ.obj (op X))).1 ⟶
  (induced_functor basic_open).op ⋙ ((Top.sheaf.pushforward X.to_Γ_Spec_base).obj X.𝒪).1 :=
{ app := λ r, X.to_Γ_Spec_c_app r.unop,
  naturality' := λ r s f, begin
    apply (structure_sheaf.to_basic_open_epi (Γ.obj (op X)) r.unop).1,
    simp only [← category.assoc],
    erw X.to_Γ_Spec_c_app_spec r.unop,
    convert X.to_Γ_Spec_c_app_spec s.unop,
    symmetry,
    apply X.presheaf.map_comp
  end }

/-- The canonical morphism of sheafed spaces from `X` to the spectrum of its global sections. -/
@[simps]
def to_Γ_Spec_SheafedSpace : X.to_SheafedSpace ⟶ Spec.to_SheafedSpace.obj (op (Γ.obj (op X))) :=
{ base := X.to_Γ_Spec_base,
  c := Top.sheaf.restrict_hom_equiv_hom (structure_sheaf (Γ.obj (op X))).1 _
    is_basis_basic_opens X.to_Γ_Spec_c_basic_opens }

lemma to_Γ_Spec_SheafedSpace_app_eq :
  X.to_Γ_Spec_SheafedSpace.c.app (op (basic_open r)) = X.to_Γ_Spec_c_app r :=
Top.sheaf.extend_hom_app _ _ _ _ _

lemma to_Γ_Spec_SheafedSpace_app_spec (r : Γ.obj (op X)) :
  to_open _ (basic_open r) ≫ X.to_Γ_Spec_SheafedSpace.c.app (op (basic_open r)) =
    X.to_to_Γ_Spec_map_basic_open r :=
(X.to_Γ_Spec_SheafedSpace_app_eq r).symm ▸ X.to_Γ_Spec_c_app_spec r

/-- The map on stalks induced by the unit commutes with maps from `Γ(X)` to
    stalks (in `Spec Γ(X)` and in `X`). -/
lemma to_stalk_stalk_map_to_Γ_Spec (x : X) : to_stalk _ _ ≫
  PresheafedSpace.stalk_map X.to_Γ_Spec_SheafedSpace x = X.Γ_to_stalk x :=
begin
  rw PresheafedSpace.stalk_map,
  erw ← to_open_germ _ (basic_open (1 : Γ.obj (op X)))
    ⟨X.to_Γ_Spec_fun x, by rw basic_open_one; trivial⟩,
  rw [← category.assoc, category.assoc (to_open _ _)],
  erw stalk_functor_map_germ,
  rw [← category.assoc (to_open _ _), X.to_Γ_Spec_SheafedSpace_app_spec 1],
  unfold Γ_to_stalk,
  rw ← stalk_pushforward_germ _ X.to_Γ_Spec_base X.presheaf ⊤,
  congr' 1,
  change (X.to_Γ_Spec_base _* X.presheaf).map le_top.hom.op ≫ _ = _,
  apply germ_res,
end

/-- The canonical morphism from `X` to the spectrum of its global sections. -/
@[simps val_base]
def to_Γ_Spec : X ⟶ Spec.LocallyRingedSpace_obj (Γ.obj (op X)) :=
{ val := X.to_Γ_Spec_SheafedSpace,
  prop :=
  begin
    intro x,
    let p : prime_spectrum (Γ.obj (op X)) := X.to_Γ_Spec_fun x,
    constructor, /- show stalk map is local hom ↓ -/
    let S := (structure_sheaf _).presheaf.stalk p,
    rintros (t : S) ht,
    obtain ⟨⟨r, s⟩, he⟩ := is_localization.surj p.as_ideal.prime_compl t,
    dsimp at he,
    apply is_unit_of_mul_is_unit_left,
    rw he,
    refine is_localization.map_units S (⟨r, _⟩ : p.as_ideal.prime_compl),
    apply (not_mem_prime_iff_unit_in_stalk _ _ _).mpr,
    rw [← to_stalk_stalk_map_to_Γ_Spec, comp_apply],
    erw ← he,
    rw ring_hom.map_mul,
    exact ht.mul ((is_localization.map_units S s : _).map
      (PresheafedSpace.stalk_map X.to_Γ_Spec_SheafedSpace x))
  end }

lemma comp_ring_hom_ext {X : LocallyRingedSpace} {R : CommRing}
  {f : R ⟶ Γ.obj (op X)} {β : X ⟶ Spec.LocallyRingedSpace_obj R}
  (w : X.to_Γ_Spec.1.base ≫ (Spec.LocallyRingedSpace_map f).1.base = β.1.base)
  (h : ∀ r : R,
    f ≫ X.presheaf.map (hom_of_le le_top : (opens.map β.1.base).obj (basic_open r) ⟶ _).op =
      to_open R (basic_open r) ≫ β.1.c.app (op (basic_open r))) :
  X.to_Γ_Spec ≫ Spec.LocallyRingedSpace_map f = β :=
begin
  ext1,
  apply Spec.basic_open_hom_ext,
  { intros r _,
    rw LocallyRingedSpace.comp_val_c_app,
    erw to_open_comp_comap_assoc,
    rw category.assoc,
    erw [to_Γ_Spec_SheafedSpace_app_spec, ← X.presheaf.map_comp],
    convert h r },
  exact w,
end

/-- `to_Spec_Γ _` is an isomorphism so these are mutually two-sided inverses. -/
lemma Γ_Spec_left_triangle : to_Spec_Γ (Γ.obj (op X)) ≫ X.to_Γ_Spec.1.c.app (op ⊤) = 𝟙 _ :=
begin
  unfold to_Spec_Γ,
  rw ← to_open_res _ (basic_open (1 : Γ.obj (op X))) ⊤ (eq_to_hom basic_open_one.symm),
  erw category.assoc,
  rw [nat_trans.naturality, ← category.assoc],
  erw [X.to_Γ_Spec_SheafedSpace_app_spec 1, ← functor.map_comp],
  convert eq_to_hom_map X.presheaf _, refl,
end

end LocallyRingedSpace

/-- The unit as a natural transformation. -/
def identity_to_Γ_Spec : 𝟭 LocallyRingedSpace.{u} ⟶ Γ.right_op ⋙ Spec.to_LocallyRingedSpace :=
{ app := LocallyRingedSpace.to_Γ_Spec,
  naturality' := λ X Y f, begin
    symmetry,
    apply LocallyRingedSpace.comp_ring_hom_ext,
    { ext1 x,
      dsimp [Spec.Top_map, LocallyRingedSpace.to_Γ_Spec_fun],
      rw [← local_ring.comap_closed_point (PresheafedSpace.stalk_map _ x),
        ← prime_spectrum.comap_comp_apply, ← prime_spectrum.comap_comp_apply],
      congr' 2,
      exact (PresheafedSpace.stalk_map_germ f.1 ⊤ ⟨x,trivial⟩).symm,
      apply_instance },
    { intro r,
      rw [LocallyRingedSpace.comp_val_c_app, ← category.assoc],
      erw [Y.to_Γ_Spec_SheafedSpace_app_spec, f.1.c.naturality],
      refl },
  end }

namespace Γ_Spec

/-- `Spec_Γ_identity` is iso so these are mutually two-sided inverses. -/
lemma right_triangle (R : CommRing) :
  identity_to_Γ_Spec.app (Spec.to_LocallyRingedSpace.obj $ op R) ≫
  Spec.to_LocallyRingedSpace.map (Spec_Γ_identity.inv.app R).op = 𝟙 _ :=
begin
  apply LocallyRingedSpace.comp_ring_hom_ext,
  { ext (p : prime_spectrum R) x,
    erw ← is_localization.at_prime.to_map_mem_maximal_iff
      ((structure_sheaf R).presheaf.stalk p) p.as_ideal x,
    refl },
  { intro r, apply to_open_res },
end

-- Removing this makes the following definition time out.
local attribute [irreducible] Spec_Γ_identity identity_to_Γ_Spec Spec.to_LocallyRingedSpace

/-- The adjunction `Γ ⊣ Spec` from `CommRingᵒᵖ` to `LocallyRingedSpace`. -/
@[simps unit counit] def LocallyRingedSpace_adjunction : Γ.right_op ⊣ Spec.to_LocallyRingedSpace :=
adjunction.mk_of_unit_counit
{ unit := identity_to_Γ_Spec,
  counit := (nat_iso.op Spec_Γ_identity).inv,
  left_triangle' := by { ext X, erw category.id_comp,
    exact congr_arg quiver.hom.op (left_triangle X) },
  right_triangle' := by { ext1, ext1 R, erw category.id_comp,
    exact right_triangle R.unop } }

local attribute [semireducible] Spec.to_LocallyRingedSpace

/-- The adjunction `Γ ⊣ Spec` from `CommRingᵒᵖ` to `Scheme`. -/
def adjunction : Scheme.Γ.right_op ⊣ Scheme.Spec :=
LocallyRingedSpace_adjunction.restrict_fully_faithful
  Scheme.forget_to_LocallyRingedSpace (𝟭 _)
  (nat_iso.of_components (λ X, iso.refl _) (λ _ _ f, by simpa))
  (nat_iso.of_components (λ X, iso.refl _) (λ _ _ f, by simpa))

lemma adjunction_hom_equiv_apply {X : Scheme} {R : CommRingᵒᵖ}
  (f : (op $ Scheme.Γ.obj $ op X) ⟶ R) :
  Γ_Spec.adjunction.hom_equiv X R f =
    LocallyRingedSpace_adjunction.hom_equiv X.1 R f :=
by { dsimp [adjunction, adjunction.restrict_fully_faithful], simp }

local attribute [irreducible] LocallyRingedSpace_adjunction Γ_Spec.adjunction

lemma adjunction_hom_equiv (X : Scheme) (R : CommRingᵒᵖ) :
  Γ_Spec.adjunction.hom_equiv X R = LocallyRingedSpace_adjunction.hom_equiv X.1 R :=
equiv.ext $ λ f, adjunction_hom_equiv_apply f

lemma adjunction_hom_equiv_symm_apply {X : Scheme} {R : CommRingᵒᵖ}
  (f : X ⟶ Scheme.Spec.obj R) :
  (Γ_Spec.adjunction.hom_equiv X R).symm f =
    (LocallyRingedSpace_adjunction.hom_equiv X.1 R).symm f :=
by { congr' 2, exact adjunction_hom_equiv _ _ }

@[simp] lemma adjunction_counit_app {R : CommRingᵒᵖ} :
  Γ_Spec.adjunction.counit.app R = LocallyRingedSpace_adjunction.counit.app R :=
by { rw [← adjunction.hom_equiv_symm_id, ← adjunction.hom_equiv_symm_id,
  adjunction_hom_equiv_symm_apply], refl }

@[simp] lemma adjunction_unit_app {X : Scheme} :
  Γ_Spec.adjunction.unit.app X = LocallyRingedSpace_adjunction.unit.app X.1 :=
by { rw [← adjunction.hom_equiv_id, ← adjunction.hom_equiv_id, adjunction_hom_equiv_apply], refl }

local attribute [semireducible] LocallyRingedSpace_adjunction Γ_Spec.adjunction

instance is_iso_LocallyRingedSpace_adjunction_counit :
  is_iso LocallyRingedSpace_adjunction.counit :=
is_iso.of_iso_inv _

instance is_iso_adjunction_counit : is_iso Γ_Spec.adjunction.counit :=
begin
  apply_with nat_iso.is_iso_of_is_iso_app { instances := ff },
  intro R,
  rw adjunction_counit_app,
  apply_instance,
end

-- This is just
-- `(Γ_Spec.adjunction.unit.app X).1.c.app (op ⊤) = Spec_Γ_identity.hom.app (X.presheaf.obj (op ⊤))`
-- But lean times out when trying to unify the types of the two sides.
lemma adjunction_unit_app_app_top (X : Scheme) :
  @eq ((Scheme.Spec.obj (op $ X.presheaf.obj (op ⊤))).presheaf.obj (op ⊤) ⟶
    ((Γ_Spec.adjunction.unit.app X).1.base _* X.presheaf).obj (op ⊤))
  ((Γ_Spec.adjunction.unit.app X).val.c.app (op ⊤))
    (Spec_Γ_identity.hom.app (X.presheaf.obj (op ⊤))) :=
begin
  have := congr_app Γ_Spec.adjunction.left_triangle X,
  dsimp at this,
  rw ← is_iso.eq_comp_inv at this,
  simp only [Γ_Spec.LocallyRingedSpace_adjunction_counit, nat_trans.op_app, category.id_comp,
    Γ_Spec.adjunction_counit_app] at this,
  rw [← op_inv, nat_iso.inv_inv_app, quiver.hom.op_inj.eq_iff] at this,
  exact this
end

end Γ_Spec

/-! Immediate consequences of the adjunction. -/

/-- Spec preserves limits. -/
instance : limits.preserves_limits Spec.to_LocallyRingedSpace :=
Γ_Spec.LocallyRingedSpace_adjunction.right_adjoint_preserves_limits
instance Spec.preserves_limits : limits.preserves_limits Scheme.Spec :=
Γ_Spec.adjunction.right_adjoint_preserves_limits

/-- Spec is a full functor. -/
instance : full Spec.to_LocallyRingedSpace :=
R_full_of_counit_is_iso Γ_Spec.LocallyRingedSpace_adjunction
instance Spec.full : full Scheme.Spec :=
R_full_of_counit_is_iso Γ_Spec.adjunction

/-- Spec is a faithful functor. -/
instance : faithful Spec.to_LocallyRingedSpace :=
R_faithful_of_counit_is_iso Γ_Spec.LocallyRingedSpace_adjunction
instance Spec.faithful : faithful Scheme.Spec :=
R_faithful_of_counit_is_iso Γ_Spec.adjunction

instance : is_right_adjoint Spec.to_LocallyRingedSpace := ⟨_, Γ_Spec.LocallyRingedSpace_adjunction⟩
instance : is_right_adjoint Scheme.Spec := ⟨_, Γ_Spec.adjunction⟩

instance : reflective Spec.to_LocallyRingedSpace := ⟨⟩
instance Spec.reflective : reflective Scheme.Spec := ⟨⟩

end algebraic_geometry


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.unique_factorization_domain
import Mathlib.ring_theory.int.basic
import Mathlib.number_theory.divisors
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Squarefree elements of monoids
An element of a monoid is squarefree when it is not divisible by any squares
except the squares of units.

## Main Definitions
 - `squarefree r` indicates that `r` is only divisible by `x * x` if `x` is a unit.

## Main Results
 - `multiplicity.squarefree_iff_multiplicity_le_one`: `x` is `squarefree` iff for every `y`, either
  `multiplicity y x ≤ 1` or `is_unit y`.
 - `unique_factorization_monoid.squarefree_iff_nodup_factors`: A nonzero element `x` of a unique
 factorization monoid is squarefree iff `factors x` has no duplicate factors.
 - `nat.squarefree_iff_nodup_factors`: A positive natural number `x` is squarefree iff
  the list `factors x` has no duplicate factors.
## Tags
squarefree, multiplicity

-/

/-- An element of a monoid is squarefree if the only squares that
  divide it are the squares of units. -/
def squarefree {R : Type u_1} [monoid R] (r : R) :=
  ∀ (x : R), x * x ∣ r → is_unit x

@[simp] theorem is_unit.squarefree {R : Type u_1} [comm_monoid R] {x : R} (h : is_unit x) : squarefree x :=
  fun (y : R) (hdvd : y * y ∣ x) => is_unit_of_mul_is_unit_left (is_unit_of_dvd_unit hdvd h)

@[simp] theorem squarefree_one {R : Type u_1} [comm_monoid R] : squarefree 1 :=
  is_unit.squarefree is_unit_one

@[simp] theorem not_squarefree_zero {R : Type u_1} [monoid_with_zero R] [nontrivial R] : ¬squarefree 0 := sorry

@[simp] theorem irreducible.squarefree {R : Type u_1} [comm_monoid R] {x : R} (h : irreducible x) : squarefree x := sorry

@[simp] theorem prime.squarefree {R : Type u_1} [comm_cancel_monoid_with_zero R] {x : R} (h : prime x) : squarefree x :=
  irreducible.squarefree (irreducible_of_prime h)

theorem squarefree_of_dvd_of_squarefree {R : Type u_1} [comm_monoid R] {x : R} {y : R} (hdvd : x ∣ y) (hsq : squarefree y) : squarefree x :=
  fun (a : R) (h : a * a ∣ x) => hsq a (dvd.trans h hdvd)

namespace multiplicity

theorem squarefree_iff_multiplicity_le_one {R : Type u_1} [comm_monoid R] [DecidableRel has_dvd.dvd] (r : R) : squarefree r ↔ ∀ (x : R), multiplicity x r ≤ 1 ∨ is_unit x := sorry

end multiplicity

namespace unique_factorization_monoid

theorem squarefree_iff_nodup_factors {R : Type u_1} [comm_cancel_monoid_with_zero R] [nontrivial R] [unique_factorization_monoid R] [normalization_monoid R] [DecidableEq R] {x : R} (x0 : x ≠ 0) : squarefree x ↔ multiset.nodup (factors x) := sorry

theorem dvd_pow_iff_dvd_of_squarefree {R : Type u_1} [comm_cancel_monoid_with_zero R] [nontrivial R] [unique_factorization_monoid R] [normalization_monoid R] {x : R} {y : R} {n : ℕ} (hsq : squarefree x) (h0 : n ≠ 0) : x ∣ y ^ n ↔ x ∣ y := sorry

end unique_factorization_monoid

namespace nat

theorem squarefree_iff_nodup_factors {n : ℕ} (h0 : n ≠ 0) : squarefree n ↔ list.nodup (factors n) := sorry

protected instance squarefree.decidable_pred : decidable_pred squarefree :=
  sorry

theorem divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) : finset.val (finset.filter squarefree (divisors n)) =
  multiset.map (fun (x : finset ℕ) => multiset.prod (finset.val x))
    (finset.val (finset.powerset (multiset.to_finset (unique_factorization_monoid.factors n)))) := sorry

theorem sum_divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) {α : Type u_1} [add_comm_monoid α] {f : ℕ → α} : (finset.sum (finset.filter squarefree (divisors n)) fun (i : ℕ) => f i) =
  finset.sum (finset.powerset (multiset.to_finset (unique_factorization_monoid.factors n)))
    fun (i : finset ℕ) => f (multiset.prod (finset.val i)) := sorry


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_961 :
  2003 % 11 = 1 :=
begin
  norm_num,
end