/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import data.real.basic
import data.set.disjointed
import data.set.intervals
import set_theory.cardinal
/-!
Proof that a cube (in dimension n ≥ 3) cannot be cubed:
There does not exist a partition of a cube into finitely many smaller cubes (at least two)
of different sizes.

We follow the proof described here:
http://www.alaricstephen.com/main-featured/2017/9/28/cubing-a-cube-proof
-/

open real set function fin

noncomputable theory

variable {n : ℕ}

/-- Given three intervals `I, J, K` such that `J ⊂ I`,
  neither endpoint of `J` coincides with an endpoint of `I`, `¬ (K ⊆ J)` and
  `K` does not lie completely to the left nor completely to the right of `J`.
  Then `I ∩ K \ J` is nonempty. -/
lemma Ico_lemma {α} [linear_order α] {x₁ x₂ y₁ y₂ z₁ z₂ w : α}
  (h₁ : x₁ < y₁) (hy : y₁ < y₂) (h₂ : y₂ < x₂)
  (hz₁ : z₁ ≤ y₂) (hz₂ : y₁ ≤ z₂) (hw : w ∉ Ico y₁ y₂ ∧ w ∈ Ico z₁ z₂) :
  ∃w, w ∈ Ico x₁ x₂ ∧ w ∉ Ico y₁ y₂ ∧ w ∈ Ico z₁ z₂ :=
begin
  simp only [not_and, not_lt, mem_Ico] at hw,
  refine ⟨max x₁ (min w y₂), _, _, _⟩,
  { simp [le_refl, lt_trans h₁ (lt_trans hy h₂), h₂] },
  { simp [hw, lt_irrefl, not_le_of_lt h₁] {contextual := tt} },
  { simp [hw.2.1, hw.2.2, hz₁, lt_of_lt_of_le h₁ hz₂] at ⊢ }
end

/-- A (hyper)-cube (in standard orientation) is a vector `b` consisting of the bottom-left point
of the cube, a width `w` and a proof that `w > 0`. We use functions from `fin n` to denote vectors.
-/
structure cube (n : ℕ) : Type :=
(b : fin n → ℝ) -- bottom-left coordinate
(w : ℝ) -- width
(hw : 0 < w)

namespace cube
lemma hw' (c : cube n) : 0 ≤ c.w := le_of_lt c.hw

/-- The j-th side of a cube is the half-open interval `[b j, b j + w)` -/
def side (c : cube n) (j : fin n) : set ℝ :=
Ico (c.b j) (c.b j + c.w)

@[simp] lemma b_mem_side (c : cube n) (j : fin n) : c.b j ∈ c.side j :=
by simp [side, cube.hw, le_refl]

def to_set (c : cube n) : set (fin n → ℝ) :=
{ x | ∀j, x j ∈ side c j }

def to_set_subset {c c' : cube n} : c.to_set ⊆ c'.to_set ↔ ∀j, c.side j ⊆ c'.side j :=
begin
  split, intros h j x hx,
  let f : fin n → ℝ := λ j', if j' = j then x else c.b j',
  have : f ∈ c.to_set,
  { intro j', by_cases hj' : j' = j; simp [f, hj', if_pos, if_neg, hx] },
  convert h this j, { simp [f, if_pos] },
  intros h f hf j, exact h j (hf j)
end

def to_set_disjoint {c c' : cube n} : disjoint c.to_set c'.to_set ↔
  ∃j, disjoint (c.side j) (c'.side j) :=
begin
  split, intros h, classical, by_contra h',
  simp only [not_disjoint_iff, classical.skolem, not_exists] at h',
  cases h' with f hf,
  apply not_disjoint_iff.mpr ⟨f, _, _⟩ h; intro j, exact (hf j).1, exact (hf j).2,
  rintro ⟨j, hj⟩, rw [set.disjoint_iff], rintros f ⟨h1f, h2f⟩,
  apply not_disjoint_iff.mpr ⟨f j, h1f j, h2f j⟩ hj
end

lemma b_mem_to_set (c : cube n) : c.b ∈ c.to_set :=
by simp [to_set]

protected def tail (c : cube (n+1)) : cube n :=
⟨tail c.b, c.w, c.hw⟩

lemma side_tail (c : cube (n+1)) (j : fin n) : c.tail.side j = c.side j.succ := rfl

def bottom (c : cube (n+1)) : set (fin (n+1) → ℝ) :=
{ x | x 0 = c.b 0 ∧ tail x ∈ c.tail.to_set }

lemma b_mem_bottom (c : cube (n+1)) : c.b ∈ c.bottom :=
by simp [bottom, to_set, side, cube.hw, le_refl, cube.tail]

def xm (c : cube (n+1)) : ℝ :=
c.b 0 + c.w

lemma b_lt_xm (c : cube (n+1)) : c.b 0 < c.xm := by simp [xm, hw]
lemma b_ne_xm (c : cube (n+1)) : c.b 0 ≠ c.xm := ne_of_lt c.b_lt_xm

def shift_up (c : cube (n+1)) : cube (n+1) :=
⟨cons c.xm $ tail c.b, c.w, c.hw⟩

@[simp] lemma tail_shift_up (c : cube (n+1)) : c.shift_up.tail = c.tail :=
by simp [shift_up, cube.tail]

@[simp] lemma head_shift_up (c : cube (n+1)) : c.shift_up.b 0 = c.xm := rfl

def unit_cube : cube n :=
⟨λ _, 0, 1, by norm_num⟩

@[simp] lemma side_unit_cube {j : fin n} : unit_cube.side j = Ico 0 1 :=
by norm_num [unit_cube, side]

end cube
open cube

variables {ι : Type} [fintype ι] {cs : ι → cube (n+1)} {i i' : ι}

/-- A finite family of (at least 2) cubes partitioning the unit cube with different sizes -/
def correct (cs : ι → cube n) : Prop :=
pairwise (disjoint on (cube.to_set ∘ cs)) ∧
(⋃(i : ι), (cs i).to_set) = unit_cube.to_set ∧
injective (cube.w ∘ cs) ∧
2 ≤ cardinal.mk ι ∧
3 ≤ n

variable (h : correct cs)

include h
lemma to_set_subset_unit_cube {i} : (cs i).to_set ⊆ unit_cube.to_set :=
by { rw [←h.2.1], exact subset_Union _ i }

lemma side_subset {i j} : (cs i).side j ⊆ Ico 0 1 :=
by { have := to_set_subset_unit_cube h, rw [to_set_subset] at this,
     convert this j, norm_num [unit_cube] }

lemma zero_le_of_mem_side {i j x} (hx : x ∈ (cs i).side j) : 0 ≤ x :=
(side_subset h hx).1

lemma zero_le_of_mem {i p} (hp : p ∈ (cs i).to_set) (j) : 0 ≤ p j :=
zero_le_of_mem_side h (hp j)

lemma zero_le_b {i j} : 0 ≤ (cs i).b j :=
zero_le_of_mem h (cs i).b_mem_to_set j

lemma b_add_w_le_one {j} : (cs i).b j + (cs i).w ≤ 1 :=
by { have := side_subset h, rw [side, Ico_subset_Ico_iff] at this, convert this.2, simp [hw] }

/-- The width of any cube in the partition cannot be 1. -/
lemma w_ne_one (i : ι) : (cs i).w ≠ 1 :=
begin
  intro hi,
  have := h.2.2.2.1, rw [cardinal.two_le_iff' i] at this, cases this with i' hi',
  let p := (cs i').b,
  have hp : p ∈ (cs i').to_set := (cs i').b_mem_to_set,
  have h2p : p ∈ (cs i).to_set,
  { intro j, split,
    transitivity (0 : ℝ),
    { rw [←add_le_add_iff_right (1 : ℝ)], convert b_add_w_le_one h, rw hi, rw zero_add },
    apply zero_le_b h, apply lt_of_lt_of_le (side_subset h $ (cs i').b_mem_side j).2,
    simp [hi, zero_le_b h] },
  apply not_disjoint_iff.mpr ⟨p, hp, h2p⟩,
  apply h.1, exact hi'.symm
end

/-- The top of a cube (which is the bottom of the cube shifted up by its width) must be covered by
  bottoms of (other) cubes in the family. -/
lemma shift_up_bottom_subset_bottoms (hc : (cs i).xm ≠ 1) :
  (cs i).shift_up.bottom ⊆ ⋃(i : ι), (cs i).bottom :=
begin
  intros p hp, cases hp with hp0 hps, rw [tail_shift_up] at hps,
  have : p ∈ (unit_cube : cube (n+1)).to_set,
  { simp only [to_set, forall_fin_succ, hp0, side_unit_cube, mem_set_of_eq, mem_Ico,
      head_shift_up], refine ⟨⟨_, _⟩, _⟩,
    { rw [←zero_add (0 : ℝ)], apply add_le_add, apply zero_le_b h, apply (cs i).hw' },
    { exact lt_of_le_of_ne (b_add_w_le_one h) hc },
    intro j, exact side_subset h (hps j) },
  rw [←h.2.1] at this, rcases this with ⟨_, ⟨i', rfl⟩, hi'⟩,
  rw [mem_Union], use i', refine ⟨_, λ j, hi' j.succ⟩,
  have : i ≠ i', { rintro rfl, apply not_le_of_lt (hi' 0).2, rw [hp0], refl },
  have := h.1 i i' this, rw [on_fun, to_set_disjoint, exists_fin_succ] at this,
  rcases this with h0|⟨j, hj⟩,
  rw [hp0], symmetry, apply eq_of_Ico_disjoint h0 (by simp [hw]) _,
  convert hi' 0, rw [hp0], refl,
  exfalso, apply not_disjoint_iff.mpr ⟨tail p j, hps j, hi' j.succ⟩ hj
end
omit h

/-- A valley is a square on which cubes in the family of cubes are placed, so that the cubes
  completely cover the valley and none of those cubes is partially outside the square.
  We also require that no cube on it has the same size as the valley (so that there are at least
  two cubes on the valley).
  This is the main concept in the formalization.
  We prove that the smallest cube on a valley has another valley on the top of it, which
  gives an infinite sequence of cubes in the partition, which contradicts the finiteness.
  A valley is characterized by a cube `c` (which is not a cube in the family cs) by considering
  the bottom face of `c`. -/
def valley (cs : ι → cube (n+1)) (c : cube (n+1)) : Prop :=
c.bottom ⊆ (⋃(i : ι), (cs i).bottom) ∧
(∀i, (cs i).b 0 = c.b 0 → (∃x, x ∈ (cs i).tail.to_set ∩ c.tail.to_set) →
  (cs i).tail.to_set ⊆ c.tail.to_set) ∧
∀(i : ι), (cs i).b 0 = c.b 0 → (cs i).w ≠ c.w

variables {c : cube (n+1)} (v : valley cs c)

/-- The bottom of the unit cube is a valley -/
lemma valley_unit_cube (h : correct cs) : valley cs unit_cube :=
begin
  refine ⟨_, _, _⟩,
  { intro v,
    simp only [bottom, and_imp, mem_Union, mem_set_of_eq],
    intros h0 hv,
    have : v ∈ (unit_cube : cube (n+1)).to_set,
    { dsimp only [to_set, unit_cube, mem_set_of_eq],
      rw [forall_fin_succ, h0], split, norm_num [side, unit_cube], exact hv },
    rw [←h.2.1] at this, rcases this with ⟨_, ⟨i, rfl⟩, hi⟩,
    use i,
    split, { apply le_antisymm, rw h0, exact zero_le_b h, exact (hi 0).1 },
    intro j, exact hi _ },
  { intros i hi h', rw to_set_subset, intro j, convert side_subset h using 1, simp [side_tail] },
  { intros i hi, exact w_ne_one h i }
end

/-- the cubes which lie in the valley `c` -/
def bcubes (cs : ι → cube (n+1)) (c : cube (n+1)) : set ι :=
{ i : ι | (cs i).b 0 = c.b 0 ∧ (cs i).tail.to_set ⊆ c.tail.to_set }

/-- A cube which lies on the boundary of a valley in dimension `j` -/
def on_boundary (hi : i ∈ bcubes cs c) (j : fin n) : Prop :=
c.b j.succ = (cs i).b j.succ ∨ (cs i).b j.succ + (cs i).w = c.b j.succ + c.w

lemma tail_sub (hi : i ∈ bcubes cs c) : ∀j, (cs i).tail.side j ⊆ c.tail.side j :=
by { rw [←to_set_subset], exact hi.2 }

lemma bottom_mem_side (hi : i ∈ bcubes cs c) : c.b 0 ∈ (cs i).side 0 :=
by { convert b_mem_side (cs i) _ using 1, rw hi.1 }

lemma b_le_b (hi : i ∈ bcubes cs c) (j : fin n) : c.b j.succ ≤ (cs i).b j.succ :=
(tail_sub hi j $ b_mem_side _ _).1

lemma t_le_t (hi : i ∈ bcubes cs c) (j : fin n) :
  (cs i).b j.succ + (cs i).w ≤ c.b j.succ + c.w  :=
begin
  have h' := tail_sub hi j, dsimp only [side] at h', rw [Ico_subset_Ico_iff] at h',
  exact h'.2, simp [hw]
end

include h v
/-- Every cube in the valley must be smaller than it -/
lemma w_lt_w (hi : i ∈ bcubes cs c) : (cs i).w < c.w :=
begin
  apply lt_of_le_of_ne _ (v.2.2 i hi.1),
  have j : fin n := ⟨1, nat.le_of_succ_le_succ h.2.2.2.2⟩,
  rw [←add_le_add_iff_left ((cs i).b j.succ)],
  apply le_trans (t_le_t hi j), rw [add_le_add_iff_right], apply b_le_b hi,
end

open cardinal
/-- There are at least two cubes in a valley -/
lemma two_le_mk_bcubes : 2 ≤ cardinal.mk (bcubes cs c) :=
begin
  rw [two_le_iff],
  rcases v.1 c.b_mem_bottom with ⟨_, ⟨i, rfl⟩, hi⟩,
  have h2i : i ∈ bcubes cs c :=
    ⟨hi.1.symm, v.2.1 i hi.1.symm ⟨tail c.b, hi.2, λ j, c.b_mem_side j.succ⟩⟩,
  let j : fin (n+1) := ⟨2, h.2.2.2.2⟩,
  have hj : 0 ≠ j := by { simp only [fin.ext_iff, ne.def], contradiction },
  let p : fin (n+1) → ℝ := λ j', if j' = j then c.b j + (cs i).w else c.b j',
  have hp : p ∈ c.bottom,
  { split, { simp only [bottom, p, if_neg hj] },
    intro j', simp only [tail, side_tail],
    by_cases hj' : j'.succ = j,
    { simp [p, -add_comm, if_pos, side, hj', hw', w_lt_w h v h2i] },
    { simp [p, -add_comm, if_neg hj'] }},
  rcases v.1 hp with ⟨_, ⟨i', rfl⟩, hi'⟩,
  have h2i' : i' ∈ bcubes cs c := ⟨hi'.1.symm, v.2.1 i' hi'.1.symm ⟨tail p, hi'.2, hp.2⟩⟩,
  refine ⟨⟨i, h2i⟩, ⟨i', h2i'⟩, _⟩,
  intro hii', cases congr_arg subtype.val hii',
  apply not_le_of_lt (hi'.2 ⟨1, nat.le_of_succ_le_succ h.2.2.2.2⟩).2,
  simp only [-add_comm, tail, cube.tail, p],
  rw [if_pos, add_le_add_iff_right],
  { exact (hi.2 _).1 },
  refl
end

/-- There is a cube in the valley -/
lemma nonempty_bcubes : (bcubes cs c).nonempty :=
begin
  rw [←set.ne_empty_iff_nonempty], intro h', have := two_le_mk_bcubes h v, rw h' at this,
  apply not_lt_of_le this, rw mk_emptyc, norm_cast, norm_num
end

/-- There is a smallest cube in the valley -/
lemma exists_mi : ∃(i : ι), i ∈ bcubes cs c ∧ ∀(i' ∈ bcubes cs c),
  (cs i).w ≤ (cs i').w :=
by simpa
  using (bcubes cs c).exists_min_image (λ i, (cs i).w) (finite.of_fintype _) (nonempty_bcubes h v)

/-- We let `mi` be the (index for the) smallest cube in the valley `c` -/
def mi : ι := classical.some $ exists_mi h v

variables {h v}
lemma mi_mem_bcubes : mi h v ∈ bcubes cs c :=
(classical.some_spec $ exists_mi h v).1

lemma mi_minimal (hi : i ∈ bcubes cs c) : (cs $ mi h v).w ≤ (cs i).w :=
(classical.some_spec $ exists_mi h v).2 i hi

lemma mi_strict_minimal (hii' : mi h v ≠ i) (hi : i ∈ bcubes cs c) :
  (cs $ mi h v).w < (cs i).w :=
by { apply lt_of_le_of_ne (mi_minimal hi), apply h.2.2.1.ne, apply hii' }

/-- The top of `mi` cannot be 1, since there is a larger cube in the valley -/
lemma mi_xm_ne_one : (cs $ mi h v).xm ≠ 1 :=
begin
  apply ne_of_lt, rcases (two_le_iff' _).mp (two_le_mk_bcubes h v) with ⟨⟨i, hi⟩, h2i⟩,
  swap, exact ⟨mi h v, mi_mem_bcubes⟩,
  apply lt_of_lt_of_le _ (b_add_w_le_one h), exact i, exact 0,
  rw [xm, mi_mem_bcubes.1, hi.1, _root_.add_lt_add_iff_left],
  apply mi_strict_minimal _ hi, intro h', apply h2i, rw subtype.ext_iff_val, exact h'
end

/-- If `mi` lies on the boundary of the valley in dimension j, then this lemma expresses that all
  other cubes on the same boundary extend further from the boundary.
  More precisely, there is a j-th coordinate `x : ℝ` in the valley, but not in `mi`,
  such that every cube that shares a (particular) j-th coordinate with `mi` also contains j-th
  coordinate `x` -/
lemma smallest_on_boundary {j} (bi : on_boundary (mi_mem_bcubes : mi h v ∈ _) j) :
  ∃(x : ℝ), x ∈ c.side j.succ \ (cs $ mi h v).side j.succ ∧
  ∀{{i'}} (hi' : i' ∈ bcubes cs c), i' ≠ mi h v →
    (cs $ mi h v).b j.succ ∈ (cs i').side j.succ → x ∈ (cs i').side j.succ :=
begin
  let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes,
  cases bi,
  { refine ⟨(cs i).b j.succ + (cs i).w, ⟨_, _⟩, _⟩,
    { simp [side, bi, hw', w_lt_w h v hi] },
    { intro h', simpa [i, lt_irrefl] using h'.2 },
    intros i' hi' i'_i h2i', split,
    apply le_trans h2i'.1, { simp [hw'] },
    apply lt_of_lt_of_le (add_lt_add_left (mi_strict_minimal i'_i.symm hi') _),
    simp [bi.symm, b_le_b hi'] },
  let s := bcubes cs c \ { i },
  have hs : s.nonempty,
  { rcases (two_le_iff' (⟨i, hi⟩ : bcubes cs c)).mp (two_le_mk_bcubes h v) with ⟨⟨i', hi'⟩, h2i'⟩,
    refine ⟨i', hi', _⟩, simp only [mem_singleton_iff], intro h, apply h2i', simp [h] },
  rcases set.exists_min_image s (w ∘ cs) (finite.of_fintype _) hs with ⟨i', ⟨hi', h2i'⟩, h3i'⟩,
  rw [mem_singleton_iff] at h2i',
  let x := c.b j.succ + c.w - (cs i').w,
  have hx : x < (cs i).b j.succ,
  { dsimp only [x], rw [←bi, add_sub_assoc, add_lt_iff_neg_left, sub_lt_zero],
    apply mi_strict_minimal (ne.symm h2i') hi' },
  refine ⟨x, ⟨_, _⟩, _⟩,
  { simp only [side, x, -add_comm, -add_assoc, neg_lt_zero, hw, add_lt_iff_neg_left, and_true,
      mem_Ico, sub_eq_add_neg],
    rw [add_assoc, le_add_iff_nonneg_right, ←sub_eq_add_neg, sub_nonneg],
    apply le_of_lt (w_lt_w h v hi') },
  { simp only [side, not_and_distrib, not_lt, add_comm, not_le, mem_Ico], left, exact hx },
  intros i'' hi'' h2i'' h3i'', split, swap, apply lt_trans hx h3i''.2,
  simp only [x], rw [le_sub_iff_add_le],
  refine le_trans _ (t_le_t hi'' j), rw [add_le_add_iff_left], apply h3i' i'' ⟨hi'', _⟩,
  simp [mem_singleton, h2i'']
end

variables (h v)
/-- `mi` cannot lie on the boundary of the valley. Otherwise, the cube adjacent to it in the `j`-th
  direction will intersect one of the neighbouring cubes on the same boundary as `mi`. -/
lemma mi_not_on_boundary (j : fin n) : ¬on_boundary (mi_mem_bcubes : mi h v ∈ _) j :=
begin
  let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes,
  rcases (two_le_iff' j).mp _ with ⟨j', hj'⟩, swap,
  { rw [mk_fin, ←nat.cast_two, nat_cast_le], apply nat.le_of_succ_le_succ h.2.2.2.2 },
  intro hj,
  rcases smallest_on_boundary hj with ⟨x, ⟨hx, h2x⟩, h3x⟩,
  let p : fin (n+1) → ℝ := cons (c.b 0) (λ j₂, if j₂ = j then x else (cs i).b j₂.succ),
  have hp : p ∈ c.bottom,
  { suffices : ∀ (j' : fin n), ite (j' = j) x ((cs i).b j'.succ) ∈ c.side j'.succ,
    { simpa [bottom, p, to_set, tail, side_tail] },
    intro j₂,
    by_cases hj₂ : j₂ = j, { simp [hj₂, hx] },
    simp only [hj₂, if_false], apply tail_sub hi, apply b_mem_side },
  rcases v.1 hp with ⟨_, ⟨i', rfl⟩, hi'⟩,
  have h2i' : i' ∈ bcubes cs c := ⟨hi'.1.symm, v.2.1 i' hi'.1.symm ⟨tail p, hi'.2, hp.2⟩⟩,
  have i_i' : i ≠ i', { rintro rfl, simpa [p, side_tail, i, h2x] using hi'.2 j },
  have : nonempty ↥((cs i').tail.side j' \ (cs i).tail.side j'),
  { apply nonempty_Ico_sdiff, apply mi_strict_minimal i_i' h2i', apply hw },
  rcases this with ⟨⟨x', hx'⟩⟩,
  let p' : fin (n+1) → ℝ :=
  cons (c.b 0) (λ j₂, if j₂ = j' then x' else (cs i).b j₂.succ),
  have hp' : p' ∈ c.bottom,
  { suffices : ∀ (j : fin n), ite (j = j') x' ((cs i).b j.succ) ∈ c.side j.succ,
    { simpa [bottom, p', to_set, tail, side_tail] },
    intro j₂,
    by_cases hj₂ : j₂ = j', simp [hj₂], apply tail_sub h2i', apply hx'.1,
    simp only [if_congr, if_false, hj₂], apply tail_sub hi, apply b_mem_side },
  rcases v.1 hp' with ⟨_, ⟨i'', rfl⟩, hi''⟩,
  have h2i'' : i'' ∈ bcubes cs c := ⟨hi''.1.symm, v.2.1 i'' hi''.1.symm ⟨tail p', hi''.2, hp'.2⟩⟩,
  have i'_i'' : i' ≠ i'',
  { rintro ⟨⟩,
    have : (cs i).b ∈ (cs i').to_set,
    { simp only [to_set, forall_fin_succ, hi.1, bottom_mem_side h2i', true_and, mem_set_of_eq],
    intro j₂, by_cases hj₂ : j₂ = j,
    { simpa [side_tail, p', hj', hj₂] using hi''.2 j },
    { simpa [hj₂] using hi'.2 j₂ } },
    apply not_disjoint_iff.mpr ⟨(cs i).b, (cs i).b_mem_to_set, this⟩ (h.1 i i' i_i') },
  have i_i'' : i ≠ i'', { intro h, induction h, simpa [hx'.2] using hi''.2 j' },
  apply not.elim _ (h.1 i' i'' i'_i''),
  simp only [on_fun, to_set_disjoint, not_disjoint_iff, forall_fin_succ, not_exists, comp_app],
  refine ⟨⟨c.b 0, bottom_mem_side h2i', bottom_mem_side h2i''⟩, _⟩,
  intro j₂,
  by_cases hj₂ : j₂ = j,
  { cases hj₂, refine ⟨x, _, _⟩,
    { convert hi'.2 j, simp [p] },
    apply h3x h2i'' i_i''.symm, convert hi''.2 j, simp [p', hj'] },
  by_cases h2j₂ : j₂ = j',
  { cases h2j₂, refine ⟨x', hx'.1, _⟩, convert hi''.2 j', simp },
  refine ⟨(cs i).b j₂.succ, _, _⟩,
  { convert hi'.2 j₂, simp [hj₂] },
  { convert hi''.2 j₂, simp [h2j₂] }
end

variables {h v}
/-- The same result that `mi` cannot lie on the boundary of the valley written as inequalities. -/
lemma mi_not_on_boundary' (j : fin n) : c.tail.b j < (cs (mi h v)).tail.b j ∧
  (cs (mi h v)).tail.b j + (cs (mi h v)).w < c.tail.b j + c.w :=
begin
  have := mi_not_on_boundary h v j,
  simp only [on_boundary, not_or_distrib] at this, cases this with h1 h2,
  split,
  apply lt_of_le_of_ne (b_le_b mi_mem_bcubes _) h1,
  apply lt_of_le_of_ne _ h2,
  apply ((Ico_subset_Ico_iff _).mp (tail_sub mi_mem_bcubes j)).2,
  simp [hw]
end

/-- The top of `mi` gives rise to a new valley, since the neighbouring cubes extend further upward
  than `mi`. -/
def valley_mi : valley cs ((cs (mi h v)).shift_up) :=
begin
  let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes,
  refine ⟨_, _, _⟩,
  { intro p, apply shift_up_bottom_subset_bottoms h mi_xm_ne_one },
  { rintros i' hi' ⟨p2, hp2, h2p2⟩, simp only [head_shift_up] at hi', classical, by_contra h2i',
    rw [tail_shift_up] at h2p2, simp only [not_subset, tail_shift_up] at h2i',
    rcases h2i' with ⟨p1, hp1, h2p1⟩,
    have : ∃p3, p3 ∈ (cs i').tail.to_set ∧ p3 ∉ (cs i).tail.to_set ∧ p3 ∈ c.tail.to_set,
    { simp only [to_set, not_forall, mem_set_of_eq] at h2p1, cases h2p1 with j hj,
      rcases Ico_lemma (mi_not_on_boundary' j).1 (by simp [hw]) (mi_not_on_boundary' j).2
        (le_trans (hp2 j).1 $ le_of_lt (h2p2 j).2)
        (le_trans (h2p2 j).1 $ le_of_lt (hp2 j).2) ⟨hj, hp1 j⟩ with ⟨w, hw, h2w, h3w⟩,
      refine ⟨λ j', if j' = j then w else p2 j', _, _, _⟩,
      { intro j', by_cases h : j' = j,
        { simp only [if_pos h], convert h3w },
        { simp only [if_neg h], exact hp2 j' } },
      { simp only [to_set, not_forall, mem_set_of_eq], use j, rw [if_pos rfl], convert h2w },
      { intro j', by_cases h : j' = j,
        { simp only [if_pos h, side_tail], convert hw },
        { simp only [if_neg h], apply hi.2, apply h2p2 } } },
    rcases this with ⟨p3, h1p3, h2p3, h3p3⟩,
    let p := @cons n (λ_, ℝ) (c.b 0) p3,
    have hp : p ∈ c.bottom, { refine ⟨rfl, _⟩, rwa [tail_cons] },
    rcases v.1 hp with ⟨_, ⟨i'', rfl⟩, hi''⟩,
    have h2i'' : i'' ∈ bcubes cs c,
    { use hi''.1.symm, apply v.2.1 i'' hi''.1.symm,
      use tail p, split, exact hi''.2, rw [tail_cons], exact h3p3 },
    have h3i'' : (cs i).w < (cs i'').w,
    { apply mi_strict_minimal _ h2i'', rintro rfl, apply h2p3, convert hi''.2, rw [tail_cons] },
    let p' := @cons n (λ_, ℝ) (cs i).xm p3,
    have hp' : p' ∈ (cs i').to_set,
    { simpa [to_set, forall_fin_succ, p', hi'.symm] using h1p3 },
    have h2p' : p' ∈ (cs i'').to_set,
    { simp only [to_set, forall_fin_succ, p', cons_succ, cons_zero, mem_set_of_eq],
      refine ⟨_, by simpa [to_set, p] using hi''.2⟩,
      have : (cs i).b 0 = (cs i'').b 0, { by rw [hi.1, h2i''.1] },
      simp [side, hw', xm, this, h3i''] },
    apply not_disjoint_iff.mpr ⟨p', hp', h2p'⟩,
    apply h.1, rintro rfl, apply (cs i).b_ne_xm, rw [←hi', ←hi''.1, hi.1], refl },
  { intros i' hi' h2i',
    dsimp only [shift_up] at h2i',
    replace h2i' := h.2.2.1 h2i'.symm,
    induction h2i',
    exact b_ne_xm (cs i) hi' }
end

variables (h)
omit v

/-- We get a sequence of cubes whose size is decreasing -/
noncomputable def sequence_of_cubes : ℕ → { i : ι // valley cs ((cs i).shift_up) }
| 0     := let v := valley_unit_cube h      in ⟨mi h v, valley_mi⟩
| (k+1) := let v := (sequence_of_cubes k).2 in ⟨mi h v, valley_mi⟩

def decreasing_sequence (k : ℕ) : order_dual ℝ :=
(cs (sequence_of_cubes h k).1).w

lemma strict_mono_sequence_of_cubes : strict_mono $ decreasing_sequence h :=
strict_mono.nat $
begin
  intro k, let v := (sequence_of_cubes h k).2, dsimp only [decreasing_sequence, sequence_of_cubes],
  apply w_lt_w h v (mi_mem_bcubes : mi h v ∈ _),
end

omit h
/-- The infinite sequence of cubes contradicts the finiteness of the family. -/
theorem not_correct : ¬correct cs :=
begin
  intro h, apply not_le_of_lt (lt_omega_iff_fintype.mpr ⟨_inst_1⟩),
  rw [omega, lift_id], fapply mk_le_of_injective, exact λ n, (sequence_of_cubes h n).1,
  intros n m hnm, apply strict_mono.injective (strict_mono_sequence_of_cubes h),
  dsimp only [decreasing_sequence], rw hnm
end

/-- A cube cannot be cubed. -/
theorem cannot_cube_a_cube :
  ∀{n : ℕ}, n ≥ 3 →                              -- In ℝ^n for n ≥ 3
  ∀{ι : Type} [fintype ι] {cs : ι → cube n},     -- given a finite collection of (hyper)cubes
  2 ≤ cardinal.mk ι →                            -- containing at least two elements
  pairwise (disjoint on (cube.to_set ∘ cs)) →    -- which is pairwise disjoint
  (⋃(i : ι), (cs i).to_set) = unit_cube.to_set → -- whose union is the unit cube
  injective (cube.w ∘ cs) →                      -- such that the widths of all cubes are different
  false :=                                       -- then we can derive a contradiction
begin
  intros n hn ι hι cs h1 h2 h3 h4, resetI,
  rcases n, cases hn,
  exact not_correct ⟨h2, h3, h4, h1, hn⟩
end


def f (x : Nat) :=
  open Nat in
  succ (succ x)

theorem f_eq : f x = Nat.succ (Nat.succ x) :=
  rfl

def g (x : Nat) := open Nat in succ (succ x)

theorem f_eq_g : f x = g x := rfl

def h (x : Nat) := Nat.succ (open Nat in succ x)

theorem f_eq_h : f x = h x := rfl

open Nat in
def h' (x : Nat) := succ x

theorem ex (x y : Nat) (h : x = y) : x + 1 = y + 1 := by
  open Nat in show succ x = succ y
  apply congrArg
  assumption

inductive InductiveWithAVeryLongName where
  | c1 | c2 | c3 | c4 | c5 | c6 | c7

def foo (e : InductiveWithAVeryLongName) : Type :=
  open InductiveWithAVeryLongName in
  match e with
    | c1 => Nat
    | c2 => Nat → Nat
    | c3 => Nat → Nat → Nat
    | c4 => Nat → Nat → Nat → Nat
    | c5 => Nat → Nat → Nat → Nat → Nat
    | c6 => Nat → Nat → Nat → Nat → Nat → Nat
    | c7 => Nat → Nat → Nat → Nat → Nat → Nat → Nat


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

open nat
-- SOLUTIONS:
-- There are no exercises in this section.
/- TEXT:
Overview
--------

Put simply, Lean is a tool for building complex expressions in a formal language
known as *dependent type theory*.

.. index:: check, commands ; check

Every expression has a *type*, and you can use the `#check` command to
print it.
Some expressions have types like `ℕ` or `ℕ → ℕ`.
These are mathematical objects.
TEXT. -/
/- These are pieces of data. -/

-- QUOTE:
#check 2 + 2

def f (x : ℕ) := x + 3

#check f
-- QUOTE.

/- TEXT:
Some expressions have type `Prop`.
These are mathematical statements.
TEXT. -/
/- These are propositions, of type `Prop`. -/

-- QUOTE:
#check 2 + 2 = 4

def fermat_last_theorem :=
  ∀ x y z n : ℕ, n > 2 ∧ x * y * z ≠ 0 → x^n + y^n ≠ z^n

#check fermat_last_theorem
-- QUOTE.

/- TEXT:
Some expressions have a type, `P`, where `P` itself has type `Prop`.
Such an expression is a proof of the proposition `P`.
TEXT. -/
/- These are proofs of propositions. -/

-- QUOTE:
theorem easy : 2 + 2 = 4 := rfl

#check easy

theorem hard : fermat_last_theorem := sorry

#check hard
-- QUOTE.

/- TEXT:
If you manage to construct an expression of type `fermat_last_theorem` and
Lean accepts it as a term of that type,
you have done something very impressive.
(Using ``sorry`` is cheating, and Lean knows it.)
So now you know the game.
All that is left to learn are the rules.

This book is complementary to a companion tutorial,
`Theorem Proving in Lean <https://leanprover.github.io/theorem_proving_in_lean/>`_,
which provides a more thorough introduction to the underlying logical framework
and core syntax of Lean.
*Theorem Proving in Lean* is for people who prefer to read a user manual cover to cover before
using a new dishwasher.
If you are the kind of person who prefers to hit the *start* button and
figure out how to activate the potscrubber feature later,
it makes more sense to start here and refer back to
*Theorem Proving in Lean* as necessary.

Another thing that distinguishes *Mathematics in Lean* from
*Theorem Proving in Lean* is that here we place a much greater
emphasis on the use of *tactics*.
Given that we are trying to build complex expressions,
Lean offers two ways of going about it:
we can write down the expressions themselves
(that is, suitable text descriptions thereof),
or we can provide Lean with *instructions* as to how to construct them.
For example, the following expression represents a proof of the fact that
if ``n`` is even then so is ``m * n``:
TEXT. -/
/- Here are some proofs. -/

-- QUOTE:
example : ∀ m n : nat, even n → even (m * n) :=
assume m n ⟨k, (hk : n = k + k)⟩,
have hmn : m * n = m * k + m * k,
  by rw [hk, mul_add],
show ∃ l, m * n = l + l,
  from ⟨_, hmn⟩
-- QUOTE.

/- TEXT:
The *proof term* can be compressed to a single line:
TEXT. -/
-- QUOTE:
example : ∀ m n : nat, even n → even (m * n) :=
λ m n ⟨k, hk⟩, ⟨m * k, by rw [hk, mul_add]⟩
-- QUOTE.

/- TEXT:
The following is, instead, a *tactic-style* proof of the same theorem:
TEXT. -/
-- QUOTE:
example : ∀ m n : nat, even n → even (m * n) :=
begin
  -- say m and n are natural numbers, and assume n=2*k
  rintros m n ⟨k, hk⟩,
  -- We need to prove m*n is twice a natural. Let's show it's twice m*k.
  use m * k,
  -- substitute in for n
  rw hk,
  -- and now it's obvious
  ring
end
-- QUOTE.

/- TEXT:
As you enter each line of such a proof in VS Code,
Lean displays the *proof state* in a separate window,
telling you what facts you have already established and what
tasks remain to prove your theorem.
You can replay the proof by stepping through the lines,
since Lean will continue to show you the state of the proof
at the point where the cursor is.
In this example, you will then see that
the first line of the proof introduces ``m`` and ``n``
(we could have renamed them at that point, if we wanted to),
and also decomposes the hypothesis ``even n`` to
a ``k`` and the assumption that ``n = 2 * k``.
The second line, ``use m * k``,
declares that we are going to show that ``m * n`` is even by
showing ``m * n = 2 * (m * k)``.
The next line uses the ``rewrite`` tactic
to replace ``n`` by ``2 * k`` in the goal,
and the `ring` tactic solves the resulting goal ``m * (2 * k) = 2 * (m * k)``.

The ability to build a proof in small steps with incremental feedback
is extremely powerful. For that reason,
tactic proofs are often easier and quicker to write than
proof terms.
There isn't a sharp distinction between the two:
tactic proofs can be inserted in proof terms,
as we did with the phrase ``by rw [hk, mul_left_comm]`` in the example above.
We will also see that, conversely,
it is often useful to insert a short proof term in the middle of a tactic proof.
That said, in this book, our emphasis will be on the use of tactics.

In our example, the tactic proof can also be reduced to a one-liner:
TEXT. -/
-- QUOTE:
example : ∀ m n : nat, even n → even (m * n) :=
by { rintros m n ⟨k, hk⟩, use m * k, rw hk, ring }
-- QUOTE.

/- TEXT:
Here we have used tactics to carry out small proof steps.
But they can also provide substantial automation,
and justify longer calculations and bigger inferential steps.
For example, we can invoke Lean's simplifier with
specific rules for simplifying statements about parity to
prove our theorem automatically.
TEXT. -/
-- QUOTE:
example : ∀ m n : nat, even n → even (m * n) :=
by intros; simp * with parity_simps
-- QUOTE.

/- TEXT:
Another big difference between the two introductions is that
*Theorem Proving in Lean* depends only on core Lean and its built-in
tactics, whereas *Mathematics in Lean* is built on top of Lean's
powerful and ever-growing library, *mathlib*.
As a result, we can show you how to use some of the mathematical
objects and theorems in the library,
and some of the very useful tactics.
This book is not meant to be used as an overview of the library;
the `community <https://leanprover-community.github.io/>`_
web pages contain extensive documentation.
Rather, our goal is to introduce you to the style of thinking that
underlies that formalization,
so that you are comfortable browsing the library and
finding things on your own.

Interactive theorem proving can be frustrating,
and the learning curve is steep.
But the Lean community is very welcoming to newcomers,
and people are available on the
`Lean Zulip chat group <https://leanprover.zulipchat.com/>`_ round the clock
to answer questions.
We hope to see you there, and have no doubt that
soon enough you, too, will be able to answer such questions
and contribute to the development of *mathlib*.

So here is your mission, should you choose to accept it:
dive in, try the exercises, come to Zulip with questions, and have fun.
But be forewarned:
interactive theorem proving will challenge you to think about
mathematics and mathematical reasoning in fundamentally new ways.
Your life may never be the same.

*Acknowledgments.* We are grateful to Gabriel Ebner for setting up the
infrastructure for running this tutorial in VS Code.
We are also grateful for help from
Bryan Gin-ge Chen, Johan Commelin, Julian Külshammer, and Guilherme Silva.
Our work has been partially supported by the Hoskinson Center for
Formal Mathematics.
TEXT. -/


import algebra.group -- for is_add_group_hom
import group_theory.subgroup -- for kernels
import algebra.module
import tactic.linarith
import tactic.omega
import tactic.fin_cases
import add_group_hom.basic
import algebra.pi_instances

class G_module (G : Type*) [group G] (M : Type*) [add_comm_group M]
  extends  has_scalar G M :=
(id : ∀ m : M, (1 : G) • m = m)
(mul : ∀ g h : G, ∀ m : M, g • (h • m) = (g * h) • m)
(linear : ∀ g : G, ∀ m n : M, g • (m + n) = g • m + g • n)

attribute [simp] G_module.linear G_module.mul

@[simp] lemma G_module.G_neg {G : Type*} [group G] {M : Type*} [add_comm_group M]
  [G_module G M]
  (g : G) (m : M) : g • (-m) = -(g • m) :=
  begin
  -- h1: g • (m+(-m))=(0:M),
  --norm_num,
 -- have h: g• (0:M)+g• (0:M)=g• ((0:M)+(0:M)),
  --rw G_module.linear,
 -- rw add_zero at h,
  --exact add_left_eq_self.mp h,
  --rw G_module.linear at h1,
  --have h2:g • m + g • -m -(g• m)= -(g• m),
 -- exact add_left_eq_self.mpr h1,
 -- have h3:g • m + g • -m -(g• m)= g • -m,
 -- exact add_sub_cancel' _ _,
 -- exact (eq.congr rfl h2).mp (eq.symm h3),
 have h:g • -m +g • m= -(g • m)+g • m,
 rw <-G_module.linear,
 norm_num,
 have h: g• (0:M)+g• (0:M)=g• ((0:M)+(0:M)),
 rw G_module.linear,
 rw add_zero at h,
 exact add_left_eq_self.mp h,
 exact (add_right_inj (g • m)).mp h,
  end

lemma G_module.G_sum_smul {G : Type*} [group G] {M : Type*} [add_comm_group M]
[G_module G M] (n:ℕ )(g : G)(f: ℕ → M):finset.sum  (finset.range (n+1))(λ (x : ℕ ), g • f x) = g • finset.sum (finset.range(n+1)) f:=
begin
induction n with d hd,
norm_num,
rw finset.sum_range_succ,
rw hd,
rw <-G_module.linear,
rw <-finset.sum_range_succ _ (d+1),
end

lemma G_module.neg_one_pow_mul_comm {G : Type*} [group G] {M : Type*} [add_comm_group M]
[G_module G M] (n:ℕ  )(g:G)(m:M): (-1:ℤ )^n • g • m = g • (-1:ℤ)^n • m:=
begin
induction n with d hd,
norm_num,
rw nat.succ_eq_add_one,
rw pow_add,
norm_num,
exact hd,
end


-- Existencia_de_valor_intermedio.lean
-- ∃ x ∈ ℝ, 2 < x < 3.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 25-noviembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que hay algún número real entre 2 y 3.
-- ----------------------------------------------------------------------

import data.real.basic

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

example : ∃ x : ℝ, 2 < x ∧ x < 3 :=
begin
  have h : 2 < (5 : ℝ) / 2 ∧ (5 : ℝ) / 2 < 3,
    by norm_num,
  show ∃ x : ℝ, 2 < x ∧ x < 3,
    by exact Exists.intro (5 / 2) h,
end

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

example : ∃ x : ℝ, 2 < x ∧ x < 3 :=
begin
  have h : 2 < (5 : ℝ) / 2 ∧ (5 : ℝ) / 2 < 3,
    by norm_num,
  show ∃ x : ℝ, 2 < x ∧ x < 3,
    by exact ⟨5 / 2, h⟩,
end

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

example : ∃ x : ℝ, 2 < x ∧ x < 3 :=
begin
  use 5 / 2,
  norm_num
end

-- 4ª demostración
-- ===============

example : ∃ x : ℝ, 2 < x ∧ x < 3 :=
⟨5 / 2, by norm_num⟩


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

/-!
# Cardinality of continuum

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

## Notation

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

namespace cardinal

universes u v

open_locale cardinal

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

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

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

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

/-!
### Inequalities
-/

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

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

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

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

lemma continuum_pos : 0 < 𝔠 := nat_lt_continuum 0

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

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

/-!
### Addition
-/

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

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

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

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

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

/-!
### Multiplication
-/

@[simp]

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

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

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

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

/-!
### Power
-/

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

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

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

end cardinal


namespace andOrCom
    theorem and_com {p q : Prop} : p ∧ q ↔ q ∧ p :=
    iff.intro
        (λ h : p ∧ q, and.intro h.right h.left)
        (λ h : q ∧ p, and.intro h.right h.left)
    #check and_com

    lemma or_lem_1 {p q : Prop} : p ∨ q → q ∨ p :=
    λ h : p ∨ q,
    h.elim (λ hp : p, or.inr hp) (λ hq : q, or.inl hq)
    lemma or_lem_2 {p q : Prop} : q ∨ p → p ∨ q :=
    λ h : q ∨ p,
    h.elim (λ hq : q, or.inr hq) (λ hp : p, or.inl hp)
    theorem or_com {p q : Prop} : p ∨ q ↔ q ∨ p :=
    iff.intro
        or_lem_1
        or_lem_2
    #check or_com
end andOrCom
namespace andOrAssoc
    lemma aal1 {p q r : Prop} : (p ∧ q) ∧ r → p ∧ (q ∧ r) :=
    λ h : (p ∧ q) ∧ r,
    have hp : p, from (h.left).left,
    have hq : q, from (h.left).right,
    have hr : r, from h.right,
    ⟨hp, hq, hr⟩
    lemma aal2 {p q r : Prop} : p ∧ (q ∧ r) → (p ∧ q) ∧ r :=
    λ h : p ∧ (q ∧ r),
    have hp : p, from h.left,
    have hq : q, from (h.right).left,
    have hr : r, from (h.right).right,
    ⟨⟨hp, hq⟩, hr⟩
    theorem and_assoc {p q r : Prop} : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
    iff.intro
        aal1
        aal2

    lemma oal1 {p q r : Prop} : (p ∨ q) ∨ r → p ∨ (q ∨ r) :=
    λ h : (p ∨ q) ∨ r,
    h.elim
        (assume hpq : p ∨ q,
            hpq.elim
                (assume hp : p,
                    show p ∨ q ∨ r, from or.inl hp)
                (assume hq : q,
                    show p ∨ q ∨ r, from or.inr $ or.inl hq))
        (assume hr : r,
            show p ∨ q ∨ r, from or.inr $ or.inr hr)
    lemma oal2 {p q r : Prop} : p ∨ (q ∨ r) → (p ∨ q) ∨ r :=
    λ h : p ∨ (q ∨ r),
    h.elim
        (assume hp : p,
            show (p ∨ q) ∨ r, from or.inl $ or.inl hp)
        (assume hqr : q ∨ r,
            hqr.elim
                (assume hq : q,
                    show (p ∨ q) ∨ r, from or.inl $ or.inr hq)
                (assume hr : r,
                    show (p ∨ q) ∨ r, from or.inr hr))
    theorem or_assoc {p q r : Prop} : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
    iff.intro
        oal1
        oal2
end andOrAssoc

namespace andOrDistrib
    lemma aod1 {p q r : Prop} : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
    λ h : p ∧ (q ∨ r),
    have hp : p, from h.left,
    have hqr : (q ∨ r), from h.right,
    hqr.elim
        (assume hq : q,
            show (p ∧ q) ∨ (p ∧ r), from or.inl ⟨hp, hq⟩)
        (assume hr : r,
            show (p ∧ q) ∨ (p ∧ r), from or.inr ⟨hp, hr⟩)

    lemma aod2 {p q r : Prop} : (p ∧ q) ∨ (p ∧ r) → p ∧ (q ∨ r) :=
    λ h : (p ∧ q) ∨ (p ∧ r),
    h.elim
        (assume hpq : p ∧ q,
        have hp : p, from hpq.left,
        have hq : q, from hpq.right,
        and.intro
            (show p, from hp)
            (show q ∨ r, from or.inl hq))
        (assume hpr : p ∧ r,
        have hp : p, from hpr.left,
        have hr : r, from hpr.right,
        and.intro
            (show p, from hp)
            (show q ∨ r, from or.inr hr))
    theorem and_or_distrib {p q r : Prop} : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    iff.intro
        aod1
        aod2

lemma oad1 {p q r : Prop} : p ∨ (q ∧ r) → (p ∨ q) ∧ (p ∨ r) :=
λ h : p ∨ (q ∧ r),
h.elim
    (assume hp : p,
     and.intro
        (show p ∨ q,from or.inl hp)
        (show p ∨ r, from or.inl hp))
    (assume hqr : q ∧ r,
     have hq : q, from hqr.left,
     have hr : r, from hqr.right,
     and.intro
        (show p ∨ q, from or.inr hq)
        (show p ∨ r, from or.inr hr))

lemma oad2 {p q r : Prop} : (p ∨ q) ∧ (p ∨ r) → p ∨ (q ∧ r) :=
λ h : (p ∨ q) ∧ (p ∨ r),
have hpq : p ∨ q, from h.left,
have hpr : p ∨ r, from h.right,
sorry

theorem or_and_distrib {p q r : Prop} : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
iff.intro
    (oad1)
    (oad2)
#check or_and_distrib

end andOrDistrib


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import linear_algebra.finite_dimensional

/-!

# Vector spaces

The definition of a vector space `V` over a field `k` is the following:

1) `V` is an abelian group
2) If `r : k` and `v : V` there's an element `r • v : V`
3) Axioms for `•`: `(r + s) • v = r • v + s • v`, `r • (v + w) = r • v = r • w`
and `1 • v = v`.

Fields have inverses, but there is no mention of inverses in the axioms of a vector
space. This means that we can make the *definition* of a vector space just under
the assumption that `k` is a `ring`, rather than a `field`, although of course
fewer things will be true (for example, over a general ring it is not true that
every vector space has a basis). However, when `k` is a ring, mathematicians don't
call these things vector spaces; they call them *modules*. So the way we say
"let `V` be a vector space over `k`" in Lean is "let `V` be a module over `k`".

(**TODO** add the vector_space notation back in a locale and PR to mathlib
so that next year's students don't have to suffer this)

-/

-- if we make variable definitions in a section then they will disappear
-- when we close the section
section explanations

-- This says "let `k` be a field and let `V` be a vector space over `k`"
variables (k : Type) [field k] (V : Type) [add_comm_group V] [module k V]

-- This says "let `B` be a basis for `V`, with basis vectors eᵢ for `i : I`"
variables (I : Type) (B : basis I k V)

-- This says "assume `V` is finite-dimensional

variable [finite_dimensional k V]

end explanations

/-

# subspaces of a vector space are a lattice

-/

section lattice

-- Let V be a vector space over a field k
variables (k : Type) [field k] (V : Type) [add_comm_group V] [module k V]

-- let A and B be subspaces
variables (A B : subspace k V)

-- Note that A and B are terms not types.

-- How do we say A ⊆ B?

-- #check A ⊆ B -- doesn't work!

-- We need to use *lattice notation*

#check A ≤ B -- A is a subset of B; it's a Prop

#check A ⊓ B -- intersection of A and B, as a subspace

#check A ⊔ B -- A + B, as a subspace

#check (⊥ : subspace k V) -- the 0-dimensional subspace

#check (⊤ : subspace k V) -- V considered as a subspace of itself; note that
                          -- we can't use V to represent this subspace because
                          -- V is a type, and a subspace of V is a term

-- For elements it's just like sets:

variable (v : V)

#check v ∈ A -- it's a Prop

-- There are a ton of general theorems about lattices such as `A ≤ A ⊔ B`
-- and `A ⊓ B ≤ B` in the library; they apply to all lattices (like the lattice
-- of subsets of a type, the lattice of subgroups of a group etc etc).

end lattice

/-

# The question

A 2019 University of Edinburgh example sheet question: prove that if `V` is a 9-dimensional
vector space and `A, B` are two subspaces of dimension 5, then `A ∩ B` cannot be
the zero vector space.

-/

-- let k be a field and let V be a k-vector space
variables (k : Type) [field k] (V : Type) [add_comm_group V] [module k V]

-- Let `A` and `B` be subspaces of `V`
variables (A B : subspace k V)

-- If we don't put in a finite-dimensional hypothesis then `dim V` will be a "cardinal",
-- a generalisation of a number which could be infinity.

variables [finite_dimensional k V]

-- Now we can use `finite_dimensional.finrank k V` which is the dimension of V as a natural number
-- However, if we open the namespace...
open finite_dimensional

-- ...then we can just talk about `finrank` which makes typing easier. Here's the question.

example (hV : finrank k V = 9) (hA : finrank k A = 5) (hB : finrank k B = 5) :
  A ⊓ B ≠ ⊥ :=
begin
  -- see below for the API (i.e. the theorems) you will need
  sorry,
end

/-

## Some API for finite-dimensional vector spaces

`submodule.dim_sup_add_dim_inf_eq A B : finrank k ↥(A ⊔ B) + finrank k ↥(A ⊓ B) = finrank k ↥A + finrank k ↥B`
`submodule.finrank_le A : finrank k ↥A ≤ finrank k V`
`finrank_bot k V : finrank K ↥⊥ = 0`

-/


namespace ind

  inductive nat : Type
  | O : nat
  | S : nat → nat

  namespace nat
    def add : nat → nat → nat
    | O n := n
    | (S m) n := S (add m n)

    notation x `+` y := add x y

    def mul : nat → nat → nat
    | O n := O
    | (S m) n := add n (mul m n)

    #reduce (S (S O)) + (S (S (S O)))

    theorem add_zero_id : ∀ n : nat, n = n + O :=
    begin
      intro,
      induction n with n IH,
        refl,
        simp [add], apply IH
    end

    theorem add_comm : ∀ m n : nat, m + n = n + m :=
    begin
      intro,
      induction m with m IH,
        intro,
        simp [add], rewrite <- add_zero_id n,

        intro,
        simp [add],
        rewrite IH,
        induction n with n IHn,
          simp [add],
          rewrite <- IH,

          simp [add],
          rewrite IH,
          simp [add],
          exact IHn,
    end
  end nat

  inductive l  : Type
  | E : l
  | A : nat → l → l

  variable x : nat
  variable y : nat
  variable z : nat

  namespace l
    #check A
    #check E  -- ()
    #check A x E  -- (x)
    #check A x (A x E)  -- (x, x)
    #check A z (A y (A x E))  -- (x, y, z)

    def len : l → nat
    | E := nat.O
    | (A t s) := nat.S (len s)

    example : ∀ s : l, ∀ n : nat, len (A n s) = nat.S (len s) :=
    begin
      intro, intro, refl
    end
  end l

  inductive p (A B : Type) : Type -- A x B
  | con : A → B → p

  namespace p
    def p1 (A B : Type) : (p A B) → A
    | (con m n) := m

    def p2 (A B : Type) : (p A B) → B
    | (con m n) := n

    def s (A B : Type) : (p A B) -> (p B A)
    | (con m n) := con n m

    def s1 (A B : Type) : (p A B) -> (p B A):= fun x : (p A B),
                            con (p2 A B x) (p1 A B x)
  end p

end ind


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Std.Logic

theorem not_or_iff_and_not {p q : Prop} : ¬ (p ∨ q) ↔ ¬ p ∧ ¬ q where
  mp := by
    intro hnpq
    constructor
    case left =>
      exact hnpq ∘ Or.inl
    case right =>
      exact hnpq ∘ Or.inr
  mpr := by
    intro hnpnq hpq
    cases hpq
    case inl hp => exact hnpnq.1 hp
    case inr hq => exact hnpnq.2 hq

theorem And.map {p₁ p₂ q₁ q₂ : Prop} (hp : p₁ → p₂) (hq : q₁ → q₂) : p₁ ∧ q₁ → p₂ ∧ q₂
| And.intro hp₁ hq₁ => And.intro (hp hp₁) (hq hq₁)

theorem And.substIff {p₁ p₂ q₁ q₂ : Prop} (hp : p₁ ↔ p₂) (hq : q₁ ↔ q₂) : (p₁ ∧ q₁) ↔ (p₂ ∧ q₂) where
  mp h1 := h1.map hp.mp hq.mp
  mpr h2 := h2.map hp.mpr hq.mpr

theorem Or.map {p₁ p₂ q₁ q₂ : Prop} (hp : p₁ → p₂) (hq : q₁ → q₂) : p₁ ∨ q₁ → p₂ ∨ q₂
| Or.inl hp₁ => Or.inl (hp hp₁)
| Or.inr hq₁ => Or.inr (hq hq₁)

theorem Or.substIff {p₁ p₂ q₁ q₂ : Prop} (hp : p₁ ↔ p₂) (hq : q₁ ↔ q₂) : (p₁ ∨ q₁ ↔  p₂ ∨ q₂) where
  mp h1 := h1.map hp.mp hq.mp
  mpr h2 := h2.map hp.mpr hq.mpr


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Heather Macbeth, Johannes Hölzl, Yury Kudryashov
-/
import algebra.big_operators.intervals
import analysis.normed.group.basic
import topology.instances.nnreal

/-!
# Infinite sums in (semi)normed groups

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

In a complete (semi)normed group,

- `summable_iff_vanishing_norm`: a series `∑' i, f i` is summable if and only if for any `ε > 0`,
  there exists a finite set `s` such that the sum `∑ i in t, f i` over any finite set `t` disjoint
  with `s` has norm less than `ε`;

- `summable_of_norm_bounded`, `summable_of_norm_bounded_eventually`: if `‖f i‖` is bounded above by
  a summable series `∑' i, g i`, then `∑' i, f i` is summable as well; the same is true if the
  inequality hold only off some finite set.

- `tsum_of_norm_bounded`, `has_sum.norm_le_of_bounded`: if `‖f i‖ ≤ g i`, where `∑' i, g i` is a
  summable series, then `‖∑' i, f i‖ ≤ ∑' i, g i`.

## Tags

infinite series, absolute convergence, normed group
-/

open_locale classical big_operators topology nnreal
open finset filter metric

variables {ι α E F : Type*} [seminormed_add_comm_group E] [seminormed_add_comm_group F]

lemma cauchy_seq_finset_iff_vanishing_norm {f : ι → E} :
  cauchy_seq (λ s : finset ι, ∑ i in s, f i) ↔
    ∀ε > (0 : ℝ), ∃s:finset ι, ∀t, disjoint t s → ‖ ∑ i in t, f i ‖ < ε :=
begin
  rw [cauchy_seq_finset_iff_vanishing, nhds_basis_ball.forall_iff],
  { simp only [ball_zero_eq, set.mem_set_of_eq] },
  { rintros s t hst ⟨s', hs'⟩,
    exact ⟨s', λ t' ht', hst $ hs' _ ht'⟩ }
end

lemma summable_iff_vanishing_norm [complete_space E] {f : ι → E} :
  summable f ↔ ∀ε > (0 : ℝ), ∃s:finset ι, ∀t, disjoint t s → ‖ ∑ i in t, f i ‖ < ε :=
by rw [summable_iff_cauchy_seq_finset, cauchy_seq_finset_iff_vanishing_norm]

lemma cauchy_seq_finset_of_norm_bounded_eventually {f : ι → E} {g : ι → ℝ} (hg : summable g)
  (h : ∀ᶠ i in cofinite, ‖f i‖ ≤ g i) : cauchy_seq (λ s, ∑ i in s, f i) :=
begin
  refine cauchy_seq_finset_iff_vanishing_norm.2 (λ ε hε, _),
  rcases summable_iff_vanishing_norm.1 hg ε hε with ⟨s, hs⟩,
  refine ⟨s ∪ h.to_finset, λ t ht, _⟩,
  have : ∀ i ∈ t, ‖f i‖ ≤ g i,
  { intros i hi,
    simp only [disjoint_left, mem_union, not_or_distrib, h.mem_to_finset, set.mem_compl_iff,
      not_not] at ht,
    exact (ht hi).2 },
  calc ‖∑ i in t, f i‖ ≤ ∑ i in t, g i    : norm_sum_le_of_le _ this
                    ... ≤ ‖∑ i in t, g i‖ : le_abs_self _
                    ... < ε               : hs _ (ht.mono_right le_sup_left),
end

lemma cauchy_seq_finset_of_norm_bounded {f : ι → E} (g : ι → ℝ) (hg : summable g)
  (h : ∀i, ‖f i‖ ≤ g i) : cauchy_seq (λ s : finset ι, ∑ i in s, f i) :=
cauchy_seq_finset_of_norm_bounded_eventually hg $ eventually_of_forall h

/-- A version of the **direct comparison test** for conditionally convergent series.
See `cauchy_seq_finset_of_norm_bounded` for the same statement about absolutely convergent ones. -/
lemma cauchy_seq_range_of_norm_bounded {f : ℕ → E} (g : ℕ → ℝ)
  (hg : cauchy_seq (λ n, ∑ i in range n, g i)) (hf : ∀ i, ‖f i‖ ≤ g i) :
  cauchy_seq (λ n, ∑ i in range n, f i) :=
begin
  refine metric.cauchy_seq_iff'.2 (λ ε hε, _),
  refine (metric.cauchy_seq_iff'.1 hg ε hε).imp (λ N hg n hn, _),
  specialize hg n hn,
  rw [dist_eq_norm, ←sum_Ico_eq_sub _ hn] at ⊢ hg,
  calc  ‖∑ k in Ico N n, f k‖
      ≤  ∑ k in _, ‖f k‖ : norm_sum_le _ _
  ... ≤  ∑ k in _, g k   : sum_le_sum (λ x _, hf x)
  ... ≤ ‖∑ k in _, g k‖  : le_abs_self _
  ... <  ε               : hg
end

lemma cauchy_seq_finset_of_summable_norm {f : ι → E} (hf : summable (λa, ‖f a‖)) :
  cauchy_seq (λ s : finset ι, ∑ a in s, f a) :=
cauchy_seq_finset_of_norm_bounded _ hf (assume i, le_rfl)

/-- If a function `f` is summable in norm, and along some sequence of finsets exhausting the space
its sum is converging to a limit `a`, then this holds along all finsets, i.e., `f` is summable
with sum `a`. -/
lemma has_sum_of_subseq_of_summable {f : ι → E} (hf : summable (λa, ‖f a‖))
  {s : α → finset ι} {p : filter α} [ne_bot p]
  (hs : tendsto s p at_top) {a : E} (ha : tendsto (λ b, ∑ i in s b, f i) p (𝓝 a)) :
  has_sum f a :=
tendsto_nhds_of_cauchy_seq_of_subseq (cauchy_seq_finset_of_summable_norm hf) hs ha

lemma has_sum_iff_tendsto_nat_of_summable_norm {f : ℕ → E} {a : E} (hf : summable (λi, ‖f i‖)) :
  has_sum f a ↔ tendsto (λn:ℕ, ∑ i in range n, f i) at_top (𝓝 a) :=
⟨λ h, h.tendsto_sum_nat,
λ h, has_sum_of_subseq_of_summable hf tendsto_finset_range h⟩

/-- The direct comparison test for series:  if the norm of `f` is bounded by a real function `g`
which is summable, then `f` is summable. -/
lemma summable_of_norm_bounded
  [complete_space E] {f : ι → E} (g : ι → ℝ) (hg : summable g) (h : ∀i, ‖f i‖ ≤ g i) :
  summable f :=
by { rw summable_iff_cauchy_seq_finset, exact cauchy_seq_finset_of_norm_bounded g hg h }

lemma has_sum.norm_le_of_bounded {f : ι → E} {g : ι → ℝ} {a : E} {b : ℝ}
  (hf : has_sum f a) (hg : has_sum g b) (h : ∀ i, ‖f i‖ ≤ g i) :
  ‖a‖ ≤ b :=
le_of_tendsto_of_tendsto' hf.norm hg $ λ s, norm_sum_le_of_le _ $ λ i hi, h i

/-- Quantitative result associated to the direct comparison test for series:  If `∑' i, g i` is
summable, and for all `i`, `‖f i‖ ≤ g i`, then `‖∑' i, f i‖ ≤ ∑' i, g i`. Note that we do not
assume that `∑' i, f i` is summable, and it might not be the case if `α` is not a complete space. -/
lemma tsum_of_norm_bounded {f : ι → E} {g : ι → ℝ} {a : ℝ} (hg : has_sum g a)
  (h : ∀ i, ‖f i‖ ≤ g i) :
  ‖∑' i : ι, f i‖ ≤ a :=
begin
  by_cases hf : summable f,
  { exact hf.has_sum.norm_le_of_bounded hg h },
  { rw [tsum_eq_zero_of_not_summable hf, norm_zero],
    exact ge_of_tendsto' hg (λ s, sum_nonneg $ λ i hi, (norm_nonneg _).trans (h i)) }
end

/-- If `∑' i, ‖f i‖` is summable, then `‖∑' i, f i‖ ≤ (∑' i, ‖f i‖)`. Note that we do not assume
that `∑' i, f i` is summable, and it might not be the case if `α` is not a complete space. -/
lemma norm_tsum_le_tsum_norm {f : ι → E} (hf : summable (λi, ‖f i‖)) :
  ‖∑' i, f i‖ ≤ ∑' i, ‖f i‖ :=
tsum_of_norm_bounded hf.has_sum $ λ i, le_rfl

/-- Quantitative result associated to the direct comparison test for series: If `∑' i, g i` is
summable, and for all `i`, `‖f i‖₊ ≤ g i`, then `‖∑' i, f i‖₊ ≤ ∑' i, g i`. Note that we
do not assume that `∑' i, f i` is summable, and it might not be the case if `α` is not a complete
space. -/
lemma tsum_of_nnnorm_bounded {f : ι → E} {g : ι → ℝ≥0} {a : ℝ≥0} (hg : has_sum g a)
  (h : ∀ i, ‖f i‖₊ ≤ g i) :
  ‖∑' i : ι, f i‖₊ ≤ a :=
begin
  simp only [← nnreal.coe_le_coe, ← nnreal.has_sum_coe, coe_nnnorm] at *,
  exact tsum_of_norm_bounded hg h
end

/-- If `∑' i, ‖f i‖₊` is summable, then `‖∑' i, f i‖₊ ≤ ∑' i, ‖f i‖₊`. Note that
we do not assume that `∑' i, f i` is summable, and it might not be the case if `α` is not a complete
space. -/
lemma nnnorm_tsum_le {f : ι → E} (hf : summable (λi, ‖f i‖₊)) :
  ‖∑' i, f i‖₊ ≤ ∑' i, ‖f i‖₊ :=
tsum_of_nnnorm_bounded hf.has_sum (λ i, le_rfl)

variable [complete_space E]

/-- Variant of the direct comparison test for series:  if the norm of `f` is eventually bounded by a
real function `g` which is summable, then `f` is summable. -/
lemma summable_of_norm_bounded_eventually {f : ι → E} (g : ι → ℝ) (hg : summable g)
  (h : ∀ᶠ i in cofinite, ‖f i‖ ≤ g i) : summable f :=
summable_iff_cauchy_seq_finset.2 $ cauchy_seq_finset_of_norm_bounded_eventually hg h

lemma summable_of_nnnorm_bounded {f : ι → E} (g : ι → ℝ≥0) (hg : summable g)
  (h : ∀i, ‖f i‖₊ ≤ g i) : summable f :=
summable_of_norm_bounded (λ i, (g i : ℝ)) (nnreal.summable_coe.2 hg) (λ i, by exact_mod_cast h i)

lemma summable_of_summable_norm {f : ι → E} (hf : summable (λa, ‖f a‖)) : summable f :=
summable_of_norm_bounded _ hf (assume i, le_rfl)

lemma summable_of_summable_nnnorm {f : ι → E} (hf : summable (λ a, ‖f a‖₊)) : summable f :=
summable_of_nnnorm_bounded _ hf (assume i, le_rfl)


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

! This file was ported from Lean 3 source module data.pnat.factors
! leanprover-community/mathlib commit e3d9ab8faa9dea8f78155c6c27d62a621f4c152d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Multiset.Basic
import Mathlib.Data.PNat.Prime
import Mathlib.Data.Nat.Factors
import Mathlib.Data.Multiset.Sort

/-!
# Prime factors of nonzero naturals

This file defines the factorization of a nonzero natural number `n` as a multiset of primes,
the multiplicity of `p` in this factors multiset being the p-adic valuation of `n`.

## Main declarations

* `PrimeMultiset`: Type of multisets of prime numbers.
* `FactorMultiset n`: Multiset of prime factors of `n`.
-/

-- Porting note: `deriving` contained
-- Inhabited, CanonicallyOrderedAddMonoid, DistribLattice, SemilatticeSup, OrderBot, Sub, OrderedSub
/-- The type of multisets of prime numbers.  Unique factorization
 gives an equivalence between this set and ℕ+, as we will formalize
 below. -/
def PrimeMultiset :=
  Multiset Nat.Primes deriving Inhabited, CanonicallyOrderedAddMonoid, DistribLattice,
  SemilatticeSup, Sub
#align prime_multiset PrimeMultiset

instance : OrderBot PrimeMultiset where
  bot_le := by simp only [bot_le, forall_const]

instance : OrderedSub PrimeMultiset where
  tsub_le_iff_right _ _ _ := Multiset.sub_le_iff_le_add

namespace PrimeMultiset

-- `@[derive]` doesn't work for `meta` instances
unsafe instance : Repr PrimeMultiset := by delta PrimeMultiset; infer_instance

/-- The multiset consisting of a single prime -/
def ofPrime (p : Nat.Primes) : PrimeMultiset :=
  ({p} : Multiset Nat.Primes)
#align prime_multiset.of_prime PrimeMultiset.ofPrime

theorem card_ofPrime (p : Nat.Primes) : Multiset.card (ofPrime p) = 1 :=
  rfl
#align prime_multiset.card_of_prime PrimeMultiset.card_ofPrime

/-- We can forget the primality property and regard a multiset
 of primes as just a multiset of positive integers, or a multiset
 of natural numbers.  In the opposite direction, if we have a
 multiset of positive integers or natural numbers, together with
 a proof that all the elements are prime, then we can regard it
 as a multiset of primes.  The next block of results records
 obvious properties of these coercions.
-/
def toNatMultiset : PrimeMultiset → Multiset ℕ := fun v => v.map Coe.coe
#align prime_multiset.to_nat_multiset PrimeMultiset.toNatMultiset

instance coeNat : Coe PrimeMultiset (Multiset ℕ) :=
  ⟨toNatMultiset⟩
#align prime_multiset.coe_nat PrimeMultiset.coeNat

/-- `PrimeMultiset.coe`, the coercion from a multiset of primes to a multiset of
naturals, promoted to an `AddMonoidHom`. -/
def coeNatMonoidHom : PrimeMultiset →+ Multiset ℕ :=
  { Multiset.mapAddMonoidHom Coe.coe with toFun := Coe.coe }
#align prime_multiset.coe_nat_monoid_hom PrimeMultiset.coeNatMonoidHom

@[simp]
theorem coe_coeNatMonoidHom : (coeNatMonoidHom : PrimeMultiset → Multiset ℕ) = Coe.coe :=
  rfl
#align prime_multiset.coe_coe_nat_monoid_hom PrimeMultiset.coe_coeNatMonoidHom

theorem coeNat_injective : Function.Injective (Coe.coe : PrimeMultiset → Multiset ℕ) :=
  Multiset.map_injective Nat.Primes.coe_nat_injective
#align prime_multiset.coe_nat_injective PrimeMultiset.coeNat_injective

theorem coeNat_ofPrime (p : Nat.Primes) : (ofPrime p : Multiset ℕ) = {(p : ℕ)} :=
  rfl
#align prime_multiset.coe_nat_of_prime PrimeMultiset.coeNat_ofPrime

theorem coeNat_prime (v : PrimeMultiset) (p : ℕ) (h : p ∈ (v : Multiset ℕ)) : p.Prime := by
  rcases Multiset.mem_map.mp h with ⟨⟨_, hp'⟩, ⟨_, h_eq⟩⟩
  exact h_eq ▸ hp'
#align prime_multiset.coe_nat_prime PrimeMultiset.coeNat_prime

/-- Converts a `PrimeMultiset` to a `Multiset ℕ+`. -/
def toPNatMultiset : PrimeMultiset → Multiset ℕ+ := fun v => v.map Coe.coe
#align prime_multiset.to_pnat_multiset PrimeMultiset.toPNatMultiset

instance coePNat : Coe PrimeMultiset (Multiset ℕ+) :=
  ⟨toPNatMultiset⟩
#align prime_multiset.coe_pnat PrimeMultiset.coePNat

/-- `coePNat`, the coercion from a multiset of primes to a multiset of positive
naturals, regarded as an `AddMonoidHom`. -/
def coePNatMonoidHom : PrimeMultiset →+ Multiset ℕ+ :=
  { Multiset.mapAddMonoidHom Coe.coe with toFun := Coe.coe }
#align prime_multiset.coe_pnat_monoid_hom PrimeMultiset.coePNatMonoidHom

@[simp]
theorem coe_coePNatMonoidHom : (coePNatMonoidHom : PrimeMultiset → Multiset ℕ+) = Coe.coe :=
  rfl
#align prime_multiset.coe_coe_pnat_monoid_hom PrimeMultiset.coe_coePNatMonoidHom

theorem coePNat_injective : Function.Injective (Coe.coe : PrimeMultiset → Multiset ℕ+) :=
  Multiset.map_injective Nat.Primes.coe_pnat_injective
#align prime_multiset.coe_pnat_injective PrimeMultiset.coePNat_injective

theorem coePNat_ofPrime (p : Nat.Primes) : (ofPrime p : Multiset ℕ+) = {(p : ℕ+)} :=
  rfl
#align prime_multiset.coe_pnat_of_prime PrimeMultiset.coePNat_ofPrime

theorem coePNat_prime (v : PrimeMultiset) (p : ℕ+) (h : p ∈ (v : Multiset ℕ+)) : p.Prime := by
  rcases Multiset.mem_map.mp h with ⟨⟨_, hp'⟩, ⟨_, h_eq⟩⟩
  exact h_eq ▸ hp'
#align prime_multiset.coe_pnat_prime PrimeMultiset.coePNat_prime

instance coeMultisetPNatNat : Coe (Multiset ℕ+) (Multiset ℕ) :=
  ⟨fun v => v.map Coe.coe⟩
#align prime_multiset.coe_multiset_pnat_nat PrimeMultiset.coeMultisetPNatNat

theorem coePNat_nat (v : PrimeMultiset) : ((v : Multiset ℕ+) : Multiset ℕ) = (v : Multiset ℕ) := by
  change (v.map (Coe.coe : Nat.Primes → ℕ+)).map Subtype.val = v.map Subtype.val
  rw [Multiset.map_map]
  congr
#align prime_multiset.coe_pnat_nat PrimeMultiset.coePNat_nat

/-- The product of a `PrimeMultiset`, as a `ℕ+`. -/
def prod (v : PrimeMultiset) : ℕ+ :=
  (v : Multiset PNat).prod
#align prime_multiset.prod PrimeMultiset.prod

theorem coe_prod (v : PrimeMultiset) : (v.prod : ℕ) = (v : Multiset ℕ).prod := by
  let h : (v.prod : ℕ) = ((v.map Coe.coe).map Coe.coe).prod :=
    PNat.coeMonoidHom.map_multiset_prod v.toPNatMultiset
  rw [Multiset.map_map] at h
  have : (Coe.coe : ℕ+ → ℕ) ∘ (Coe.coe : Nat.Primes → ℕ+) = Coe.coe := funext fun p => rfl
  rw [this] at h; exact h
#align prime_multiset.coe_prod PrimeMultiset.coe_prod

theorem prod_ofPrime (p : Nat.Primes) : (ofPrime p).prod = (p : ℕ+) :=
  Multiset.prod_singleton _
#align prime_multiset.prod_of_prime PrimeMultiset.prod_ofPrime

/-- If a `Multiset ℕ` consists only of primes, it can be recast as a `PrimeMultiset`. -/
def ofNatMultiset (v : Multiset ℕ) (h : ∀ p : ℕ, p ∈ v → p.Prime) : PrimeMultiset :=
  @Multiset.pmap ℕ Nat.Primes Nat.Prime (fun p hp => ⟨p, hp⟩) v h
#align prime_multiset.of_nat_multiset PrimeMultiset.ofNatMultiset

theorem to_ofNatMultiset (v : Multiset ℕ) (h) : (ofNatMultiset v h : Multiset ℕ) = v := by
  dsimp [ofNatMultiset, toNatMultiset]
  have : (fun p h => (Coe.coe : Nat.Primes → ℕ) ⟨p, h⟩) = fun p _ => id p := by
    funext p h
    rfl
  rw [Multiset.map_pmap, this, Multiset.pmap_eq_map, Multiset.map_id]
#align prime_multiset.to_of_nat_multiset PrimeMultiset.to_ofNatMultiset

theorem prod_ofNatMultiset (v : Multiset ℕ) (h) : ((ofNatMultiset v h).prod : ℕ) = (v.prod : ℕ) :=
  by rw [coe_prod, to_ofNatMultiset]
#align prime_multiset.prod_of_nat_multiset PrimeMultiset.prod_ofNatMultiset

/-- If a `Multiset ℕ+` consists only of primes, it can be recast as a `PrimeMultiset`. -/
def ofPNatMultiset (v : Multiset ℕ+) (h : ∀ p : ℕ+, p ∈ v → p.Prime) : PrimeMultiset :=
  @Multiset.pmap ℕ+ Nat.Primes PNat.Prime (fun p hp => ⟨(p : ℕ), hp⟩) v h
#align prime_multiset.of_pnat_multiset PrimeMultiset.ofPNatMultiset

theorem to_ofPNatMultiset (v : Multiset ℕ+) (h) : (ofPNatMultiset v h : Multiset ℕ+) = v := by
  dsimp [ofPNatMultiset, toPNatMultiset]
  have : (fun (p : ℕ+) (h : p.Prime) => (Coe.coe : Nat.Primes → ℕ+) ⟨p, h⟩) = fun p _ => id p := by
    funext p h
    apply Subtype.eq
    rfl
  rw [Multiset.map_pmap, this, Multiset.pmap_eq_map, Multiset.map_id]
#align prime_multiset.to_of_pnat_multiset PrimeMultiset.to_ofPNatMultiset

theorem prod_ofPNatMultiset (v : Multiset ℕ+) (h) : ((ofPNatMultiset v h).prod : ℕ+) = v.prod := by
  dsimp [prod]
  rw [to_ofPNatMultiset]
#align prime_multiset.prod_of_pnat_multiset PrimeMultiset.prod_ofPNatMultiset

/-- Lists can be coerced to multisets; here we have some results
about how this interacts with our constructions on multisets. -/
def ofNatList (l : List ℕ) (h : ∀ p : ℕ, p ∈ l → p.Prime) : PrimeMultiset :=
  ofNatMultiset (l : Multiset ℕ) h
#align prime_multiset.of_nat_list PrimeMultiset.ofNatList

theorem prod_ofNatList (l : List ℕ) (h) : ((ofNatList l h).prod : ℕ) = l.prod := by
  have := prod_ofNatMultiset (l : Multiset ℕ) h
  rw [Multiset.coe_prod] at this
  exact this
#align prime_multiset.prod_of_nat_list PrimeMultiset.prod_ofNatList

/-- If a `List ℕ+` consists only of primes, it can be recast as a `PrimeMultiset` with
the coercion from lists to multisets. -/
def ofPNatList (l : List ℕ+) (h : ∀ p : ℕ+, p ∈ l → p.Prime) : PrimeMultiset :=
  ofPNatMultiset (l : Multiset ℕ+) h
#align prime_multiset.of_pnat_list PrimeMultiset.ofPNatList

theorem prod_ofPNatList (l : List ℕ+) (h) : (ofPNatList l h).prod = l.prod := by
  have := prod_ofPNatMultiset (l : Multiset ℕ+) h
  rw [Multiset.coe_prod] at this
  exact this
#align prime_multiset.prod_of_pnat_list PrimeMultiset.prod_ofPNatList

/-- The product map gives a homomorphism from the additive monoid
of multisets to the multiplicative monoid ℕ+. -/
theorem prod_zero : (0 : PrimeMultiset).prod = 1 := by
  dsimp [Prod]
  exact Multiset.prod_zero
#align prime_multiset.prod_zero PrimeMultiset.prod_zero

theorem prod_add (u v : PrimeMultiset) : (u + v).prod = u.prod * v.prod := by
  change (coePNatMonoidHom (u + v)).prod = _
  rw [coePNatMonoidHom.map_add]
  exact Multiset.prod_add _ _
#align prime_multiset.prod_add PrimeMultiset.prod_add

-- Porting note: Need to replace ^ with Pow.pow to get the original mathlib statement
theorem prod_smul (d : ℕ) (u : PrimeMultiset) : (d • u).prod = Pow.pow u.prod d := by
  induction' d with n ih
  · rfl
  · have : ∀ n' : ℕ, Pow.pow (prod u) n' = Monoid.npow n' (prod u) := fun _ ↦ rfl
    rw [succ_nsmul, prod_add, ih, this, this, Monoid.npow_succ, mul_comm]
#align prime_multiset.prod_smul PrimeMultiset.prod_smul

end PrimeMultiset

namespace PNat

/-- The prime factors of n, regarded as a multiset -/
def factorMultiset (n : ℕ+) : PrimeMultiset :=
  PrimeMultiset.ofNatList (Nat.factors n) (@Nat.prime_of_mem_factors n)
#align pnat.factor_multiset PNat.factorMultiset

/-- The product of the factors is the original number -/
theorem prod_factorMultiset (n : ℕ+) : (factorMultiset n).prod = n :=
  eq <| by
    dsimp [factorMultiset]
    rw [PrimeMultiset.prod_ofNatList]
    exact Nat.prod_factors n.ne_zero
#align pnat.prod_factor_multiset PNat.prod_factorMultiset

theorem coeNat_factorMultiset (n : ℕ+) :
    (factorMultiset n : Multiset ℕ) = (Nat.factors n : Multiset ℕ) :=
  PrimeMultiset.to_ofNatMultiset (Nat.factors n) (@Nat.prime_of_mem_factors n)
#align pnat.coe_nat_factor_multiset PNat.coeNat_factorMultiset

end PNat

namespace PrimeMultiset

/-- If we start with a multiset of primes, take the product and
 then factor it, we get back the original multiset. -/
theorem factorMultiset_prod (v : PrimeMultiset) : v.prod.factorMultiset = v := by
  apply PrimeMultiset.coeNat_injective
  suffices toNatMultiset (PNat.factorMultiset (prod v)) = toNatMultiset v by exact this
  rw [v.prod.coeNat_factorMultiset, PrimeMultiset.coe_prod]
  rcases v with ⟨l⟩
  --unfold_coes
  dsimp [PrimeMultiset.toNatMultiset]
  rw [Multiset.coe_prod]
  let l' := l.map (Coe.coe : Nat.Primes → ℕ)
  have : ∀ p : ℕ, p ∈ l' → p.Prime := fun p hp => by
    rcases List.mem_map.mp hp with ⟨⟨_, hp'⟩, ⟨_, h_eq⟩⟩
    exact h_eq ▸ hp'
  exact Multiset.coe_eq_coe.mpr (@Nat.factors_unique _ l' rfl this).symm
#align prime_multiset.factor_multiset_prod PrimeMultiset.factorMultiset_prod

end PrimeMultiset

namespace PNat

/-- Positive integers biject with multisets of primes. -/
def factorMultisetEquiv : ℕ+ ≃ PrimeMultiset
    where
  toFun := factorMultiset
  invFun := PrimeMultiset.prod
  left_inv := prod_factorMultiset
  right_inv := PrimeMultiset.factorMultiset_prod
#align pnat.factor_multiset_equiv PNat.factorMultisetEquiv

/-- Factoring gives a homomorphism from the multiplicative
 monoid ℕ+ to the additive monoid of multisets. -/

theorem factorMultiset_mul (n m : ℕ+) :
    factorMultiset (n * m) = factorMultiset n + factorMultiset m := by
  let u := factorMultiset n
  let v := factorMultiset m
  have : n = u.prod := (prod_factorMultiset n).symm; rw [this]
  have : m = v.prod := (prod_factorMultiset m).symm; rw [this]
  rw [← PrimeMultiset.prod_add]
  repeat' rw [PrimeMultiset.factorMultiset_prod]
#align pnat.factor_multiset_mul PNat.factorMultiset_mul

theorem factorMultiset_pow (n : ℕ+) (m : ℕ) :
    factorMultiset (Pow.pow n m ) = m • factorMultiset n := by
  let u := factorMultiset n
  have : n = u.prod := (prod_factorMultiset n).symm
  rw [this, ← PrimeMultiset.prod_smul]
  repeat' rw [PrimeMultiset.factorMultiset_prod]
#align pnat.factor_multiset_pow PNat.factorMultiset_pow

/-- Factoring a prime gives the corresponding one-element multiset. -/
theorem factorMultiset_ofPrime (p : Nat.Primes) :
    (p : ℕ+).factorMultiset = PrimeMultiset.ofPrime p := by
  apply factorMultisetEquiv.symm.injective
  change (p : ℕ+).factorMultiset.prod = (PrimeMultiset.ofPrime p).prod
  rw [(p : ℕ+).prod_factorMultiset, PrimeMultiset.prod_ofPrime]
#align pnat.factor_multiset_of_prime PNat.factorMultiset_ofPrime

/-- We now have four different results that all encode the
 idea that inequality of multisets corresponds to divisibility
 of positive integers. -/
theorem factorMultiset_le_iff {m n : ℕ+} : factorMultiset m ≤ factorMultiset n ↔ m ∣ n := by
  constructor
  · intro h
    rw [← prod_factorMultiset m, ← prod_factorMultiset m]
    apply Dvd.intro (n.factorMultiset - m.factorMultiset).prod
    rw [← PrimeMultiset.prod_add, PrimeMultiset.factorMultiset_prod, add_tsub_cancel_of_le h,
      prod_factorMultiset]
  · intro h
    rw [← mul_div_exact h, factorMultiset_mul]
    exact le_self_add
#align pnat.factor_multiset_le_iff PNat.factorMultiset_le_iff

theorem factorMultiset_le_iff' {m : ℕ+} {v : PrimeMultiset} : factorMultiset m ≤ v ↔ m ∣ v.prod :=
  by
  let h := @factorMultiset_le_iff m v.prod
  rw [v.factorMultiset_prod] at h
  exact h
#align pnat.factor_multiset_le_iff' PNat.factorMultiset_le_iff'

end PNat

namespace PrimeMultiset

theorem prod_dvd_iff {u v : PrimeMultiset} : u.prod ∣ v.prod ↔ u ≤ v := by
  let h := @PNat.factorMultiset_le_iff' u.prod v
  rw [u.factorMultiset_prod] at h
  exact h.symm
#align prime_multiset.prod_dvd_iff PrimeMultiset.prod_dvd_iff

theorem prod_dvd_iff' {u : PrimeMultiset} {n : ℕ+} : u.prod ∣ n ↔ u ≤ n.factorMultiset := by
  let h := @prod_dvd_iff u n.factorMultiset
  rw [n.prod_factorMultiset] at h
  exact h
#align prime_multiset.prod_dvd_iff' PrimeMultiset.prod_dvd_iff'

end PrimeMultiset

namespace PNat

/-- The gcd and lcm operations on positive integers correspond
 to the inf and sup operations on multisets. -/
theorem factorMultiset_gcd (m n : ℕ+) :
    factorMultiset (gcd m n) = factorMultiset m ⊓ factorMultiset n := by
  apply le_antisymm
  · apply le_inf_iff.mpr ; constructor <;> apply factorMultiset_le_iff.mpr
    exact gcd_dvd_left m n
    exact gcd_dvd_right m n
  · rw [← PrimeMultiset.prod_dvd_iff, prod_factorMultiset]
    apply dvd_gcd <;> rw [PrimeMultiset.prod_dvd_iff']
    exact inf_le_left
    exact inf_le_right
#align pnat.factor_multiset_gcd PNat.factorMultiset_gcd

theorem factorMultiset_lcm (m n : ℕ+) :
    factorMultiset (lcm m n) = factorMultiset m ⊔ factorMultiset n := by
  apply le_antisymm
  · rw [← PrimeMultiset.prod_dvd_iff, prod_factorMultiset]
    apply lcm_dvd <;> rw [← factorMultiset_le_iff']
    exact le_sup_left
    exact le_sup_right
  · apply sup_le_iff.mpr ; constructor <;> apply factorMultiset_le_iff.mpr
    exact dvd_lcm_left m n
    exact dvd_lcm_right m n
#align pnat.factor_multiset_lcm PNat.factorMultiset_lcm

/-- The number of occurrences of p in the factor multiset of m
 is the same as the p-adic valuation of m. -/
theorem count_factorMultiset (m : ℕ+) (p : Nat.Primes) (k : ℕ) :
    Pow.pow (p : ℕ+) k ∣ m ↔ k ≤ m.factorMultiset.count p := by
  intros
  rw [Multiset.le_count_iff_replicate_le, ← factorMultiset_le_iff, factorMultiset_pow,
    factorMultiset_ofPrime]
  congr! 2
  apply Multiset.eq_replicate.mpr
  constructor
  · rw [Multiset.card_nsmul, PrimeMultiset.card_ofPrime, mul_one]
  · intro q h
    rw [PrimeMultiset.ofPrime, Multiset.nsmul_singleton _ k] at h
    exact Multiset.eq_of_mem_replicate h
#align pnat.count_factor_multiset PNat.count_factorMultiset

end PNat

namespace PrimeMultiset

theorem prod_inf (u v : PrimeMultiset) : (u ⊓ v).prod = PNat.gcd u.prod v.prod := by
  let n := u.prod
  let m := v.prod
  change (u ⊓ v).prod = PNat.gcd n m
  have : u = n.factorMultiset := u.factorMultiset_prod.symm; rw [this]
  have : v = m.factorMultiset := v.factorMultiset_prod.symm; rw [this]
  rw [← PNat.factorMultiset_gcd n m, PNat.prod_factorMultiset]
#align prime_multiset.prod_inf PrimeMultiset.prod_inf

theorem prod_sup (u v : PrimeMultiset) : (u ⊔ v).prod = PNat.lcm u.prod v.prod := by
  let n := u.prod
  let m := v.prod
  change (u ⊔ v).prod = PNat.lcm n m
  have : u = n.factorMultiset := u.factorMultiset_prod.symm; rw [this]
  have : v = m.factorMultiset := v.factorMultiset_prod.symm; rw [this]
  rw [← PNat.factorMultiset_lcm n m, PNat.prod_factorMultiset]
#align prime_multiset.prod_sup PrimeMultiset.prod_sup

end PrimeMultiset


import data.nat.basic

section
variables x y : ℕ

def double := x + x

#check double
#check double (2 * x)

local attribute [simp] add_assoc add_comm add_left_comm

theorem t1 : double (x + y) = double x + double y :=
by simp [double]

#check t1 y
#check t1 (2 * x)

theorem t2 : double (x * y) = double x * y :=
by simp [double, add_mul]

end

section
variables (x y z : ℕ)
variables (h₁ : x = y) (h₂ : y = z)

include h₁ h₂
theorem foo : x = z :=
begin
  rw [h₁, h₂],
end
omit h₁ h₂

theorem bar : x = z :=
eq.trans h₁ h₂

theorem baz : x = x := rfl

#check @foo
#check @bar
#check @baz

end


import SciLean.Core.Defs
import SciLean.Core.Tactic.FunctionTransformation.AttribInit

namespace SciLean

#check differential

@[fun_trans_def]
def diff {X Y} [Vec X] [Vec Y] (f : X → Y) : X → X → Y := sorry

@[fun_trans_def]
def inv {X Y} [Nonempty X] (f : X → Y) : Y → X := sorry

@[fun_trans_rule]
theorem diff_id (X) [Vec X]
  : diff (λ x : X => x)
    =
    λ x dx => dx := sorry

@[fun_trans_rule]
theorem diff_const {X} (Y : Type) [Vec X] [Vec Y] (x : X)
  : diff (λ y : Y => x)
    =
    λ y dy => 0 := sorry

@[fun_trans_rule]
theorem diff_comp {X Y Z} [Vec X] [Vec Y] [Vec Z]
  (f : Y → Z) (g : X → Y)
  : diff (λ x : X => f (g x))
    =
    λ x dx => diff f (g x) (diff g x dx) := sorry

@[fun_trans_rule]
theorem diff_swap {α X Y : Type} [Vec X] [Vec Y]
  (f : α → X → Y)
  : diff (λ (x : X) (a : α) => f a x)
    =
    λ x dx a => diff (f a) x dx := sorry

@[fun_trans_rule]
theorem diff_forallMap {α X Y : Type} [Vec X] [Vec Y]
  (f : α → X → Y)
  : diff (λ (g : α → X) (a : α) => f a (g a))
    =
    λ g dg a => diff (f a) (g a) (dg a) := sorry

@[fun_trans_rule]
theorem diff_eval {α} (X) [Vec X] (a : α)
  : diff (λ (f : α → X) => f a)
    =
    λ f df => df a := sorry

@[fun_trans_rule]
theorem diff_letE {X Y Z} [Vec X] [Vec Y] [Vec Z]
  (f : X → Y → Z) (g : X → Y)
  : diff (λ (x : X) => let y := g x; f x y)
    =
    λ x dx =>
      let y  := g x
      let dy := diff g x dx
      diff (λ xy => f xy.1 xy.2) (x,y) (dx,dy) := sorry

@[fun_trans_rule]
theorem diff_letComp {X Y Z} [Vec X] [Vec Y] [Vec Z]
  (f : Y → Z) (g : X → Y)
  : diff (λ (x : X) => let y := g x; f y)
    =
    λ x dx =>
      let y  := g x
      let dy := diff g x dx
      diff f y dy := sorry

@[fun_trans]
theorem diff_fst (X Y) [Vec X] [Vec Y]
  : diff (λ (xy : X×Y) => xy.1)
    =
    λ xy dxy => dxy.1 := sorry

@[fun_trans_rule]
theorem inv_id (X) [Nonempty X]
  : inv (λ x : X => x)
    =
    λ x => x := sorry


import formula
import semantics
import schemas
import model_theory.basic
import model_theory.terms_and_formulas
import data.fin.basic
import data.fin.vec_notation

open first_order.language
open first_order.language.bounded_formula

variables {vars : Type} [denumerable vars] {W : Type} [nonempty W]
variables {A B C : form vars}

/-- Classes of models defined by a property of their frames. -/
def 𝔽 (F_prop : ∀ {W : Type}, (W → W → Prop) → Prop) : set frame :=
{F | F_prop F.R}

def 𝔽_reflexive : set frame :=
𝔽 (λ W R, ∀ w, R w w)

def 𝔽_transitive : set frame :=
𝔽 (λ W R, is_trans W R)

def 𝔽_euclidean : set frame :=
𝔽 (λ W R, ∀ u v w, R u v → R u w → R v w)

def 𝔽_converse_well_founded : set frame :=
𝔽 (λ W R, well_founded (flip R))

@[simp]
lemma 𝔽_reflexive_def (F : frame) : F ∈ 𝔽_reflexive ↔ ∀ w, F.R w w :=
by simp only [𝔽_reflexive, 𝔽, set.mem_set_of_eq]

/-- A is true in a frame F iff M ⊩ A for every model M based on F. -/
def frame_eval (F : frame) (A : form vars) := ∀ V, ⟨F, V⟩ ⊩ A
notation F ` ⊩ ` A := frame_eval F A
notation F ` ⊮ ` A := ¬ frame_eval F A

theorem frame_eval_and (F : frame) : (F ⊩ A) ∧ (F ⊩ B) ↔ (F ⊩ A ⋀ B) :=
begin
  simp [frame_eval, ←forall_and_distrib],
end

/-- A is valid in a class of frames 𝔽 iff F ⊨ A for every frame F ∈ 𝔽. -/
def class_frame_valid (𝔽 : set frame) (A : form vars) := ∀ F ∈ 𝔽, F ⊩ A
notation 𝔽 ` ⊨ ` A := class_frame_valid 𝔽 A

def defines (A : form vars) (𝔽 : set frame) :=
∀ F, F ∈ 𝔽 ↔ (F ⊩ A)

theorem 𝔽_reflexive_is_definable {p : vars}
: defines (□ ⦃p⦄ ⟹ ⦃p⦄) 𝔽_reflexive :=
begin
  intro F,
  simp only [𝔽_reflexive_def, diamond_eq_not_box_not],
  split,
  { -- This direction is easy: if □ p holds at w, then p holds at all worlds
    -- related to w, which includes w itself by the reflexivity of R.
    intros hF V w,
    simp only [eval, not_forall, set.not_not_mem, exists_prop],
    intro hw,
    exact hw w (hF w)
  },
  { -- Suppose for a contradiction R is not reflexive
    intros hT w,
    by_contra,
    -- so we have a world w s.t. h : ¬ R w w.
    -- We want to contradict against hT, which states T is true at all worlds
    -- under all valuations
    simp only [frame_eval, eval] at hT,
    -- so we need a valuation that falsifies T at some world.
    -- i.e. makes □ p true but p false at w (the only world we have in scope)
    -- Since ¬ R w w, w is not included in the following set so p is false at w
    -- However, □ p is true at w since p is true in all worlds related to w by
    -- construction.
    let V := λ _, {w' | F.R w w'},
    specialize hT V w,
    have := mt hT h,
    simp only [set.mem_set_of_eq, imp_self, forall_const, not_true] at this,
    exact this
  }
end

/-- Transitive frames are defined by formula 4 (name due to historical reasons)
-/
theorem 𝔽_transitive_is_definable {p : vars}
: defines (◇ ◇ ⦃p⦄ ⟹ ◇ ⦃p⦄) 𝔽_transitive :=
begin
  intro F,
  split,
  { simp only [frame_eval, eval, not_forall, set.not_not_mem, exists_prop,
               not_exists, not_and, forall_exists_index, and_imp],
    rintros ⟨hF⟩ V u v huv w hvw hw,
    use w,
    exact ⟨hF u v w huv hvw, hw⟩
  },
  { -- as before we prove by contradiction and forming a valuation that
    -- falsifies the defining formula from the assumption that F is intransitive
    intros h4,
    refine ⟨_⟩,
    intros u v w huv hvw,
    by_contra,
    let V := λ _, {w}, -- so from world u, only ◇ ◇ p holds but not ◇ p since p
                      -- is not true in v
    simp only [frame_eval, eval, not_forall, set.not_not_mem, exists_prop,
               not_exists, not_and, forall_exists_index, and_imp] at h4,
    specialize h4 V u v huv w hvw (set.mem_singleton w),
    simp only [set.mem_singleton_iff, exists_eq_right] at h4,
    exact h h4
  }
end

/-- Euclidean frames are defined by formula 5 (again, historical reasons)-/
theorem 𝔽_euclidean_is_definable {p : vars}
: defines (◇ ⦃p⦄ ⟹ □ ◇ ⦃p⦄) 𝔽_euclidean :=
begin
  intro F,
  split,
  { simp only [frame_eval, eval, not_forall, set.not_not_mem, exists_prop, forall_exists_index, and_imp],
    rintros hF V u w huw hw v huv,
    use w,
    exact ⟨hF u v w huv huw, hw⟩
  },
  { intros h5 u v w huv huw,
    by_contra,
    -- since ¬ F.R v w, w is in this set so ◇ p holds in u by virtue of R u w.
    -- However, by construction ◇ p does not hold in v as p is false in all the
    -- worlds accessible from v, so □ ◇ p does not hold in u.
    let V := λ_, {z | ¬ F.R v z},
    simp only [frame_eval, eval, not_forall, set.not_not_mem, exists_prop,
               not_exists, not_and, forall_exists_index, and_imp] at h5,
    specialize h5 V u w huw h v huv,
    simp at h5,
    exact h5
  }
end

theorem 𝔽_inter {𝔽₁ 𝔽₂ : set frame} (h1 : defines A 𝔽₁) (h2 : defines B 𝔽₂)
: defines (A ⋀ B) (𝔽₁ ∩ 𝔽₂) :=
begin
  intro F,
  simp only [set.mem_inter_eq],
  rw [h1, h2],
  exact frame_eval_and F,
end

/-- The Lob formula characterise frames that are transitive and converse
well-founded.-/
theorem 𝔽_transitive_converse_well_founded_is_definable {p : vars}
: defines (□ (□ ⦃p⦄ ⟹ ⦃p⦄) ⟹ □ ⦃p⦄) (𝔽_transitive ∩ 𝔽_converse_well_founded)
:= begin
  intro F,
  split,
  { intros hF V w,
    rcases hF with ⟨htrans, hwf⟩,
    simp [𝔽_converse_well_founded, 𝔽] at hwf,
    -- Supppose for a contradiction that the defining formula is not true in F
    by_contra,
    -- So we have a world w s.t. w ⊩ □ (□ p ⟹ p) but w ⊮ □ p
    unfold1 eval at h,
    simp only [not_forall, exists_prop] at h,
    rcases h with ⟨h1, h2⟩,
    -- From this, we can form an infinite chain w₁Rw₂... of worlds to
    -- contradict R's (converse) wellfoundness.
    -- Since w ⊮ □ p, w has an R-successor w₁ s.t.  w₁ ⊮ p.
    -- Since w ⊩ □ (□ p ⟹ p). w₁ ⊩ □ p ⟹ p. So by modus tolens, w₁ ⊮ □ p.
    -- Now we can repeat the argument: since wᵢ ⊮ □ p then wᵢ₊₁ ⊮ p for some
    -- successor wᵢ₊₁ of wᵢ. By transitivity, wᵢ₊₁ is also a successor of w so
    -- wᵢ₊₁ ⊩ □ p ⟹ p and hence we can conclude wᵢ₊₁ ⊮ □ p.

    -- To formalise this argument, we find a maximal world a satisfying the
    -- required conditions using the (converse) wellfoundness of R. We apply the
    -- inductive part of the argument to effectively show that since a = wᵢ for
    -- some i, then a' = wᵢ₊₁ is an R-successor of a, so in fact a is not the
    -- maximal world. This gives the required contradiction.
    haveI : is_trans F.W F.R := by { simp [𝔽_transitive, 𝔽] at htrans, exact htrans },
    -- the min of the flipped R is the max of R.
    obtain ⟨a, ha, hwf⟩ :=
      well_founded.has_min hwf
      {u | F.R w u ∧
        (⟪F, V⟫@@u ⊩ □ ⦃p⦄ ⟹ ⦃p⦄) ∧
        (⟪F, V⟫@@u ⊮ (□ ⦃p⦄))}
      -- the base case forms the proof of nonemptiness
      ⟨_, _⟩,
    rotate,

    -- The base case
    unfold1 eval at h2,
    simp only [not_forall, exists_prop] at h2,
    let w₁ := classical.some h2,
    exact w₁,
    unfold1 eval at h2,
    simp only [not_forall, exists_prop] at h2,
    obtain ⟨hww₁, h2⟩ := classical.some_spec h2,
    exact ⟨hww₁, h1 _ hww₁, mt (h1 _ hww₁) h2⟩,

    -- The inductive case
    obtain ⟨hwa, ih1, ih2⟩ := ha,
    unfold1 eval at ih2, simp only [not_forall, exists_prop] at ih2,
    rcases ih2 with ⟨a', haa', ih2⟩,
    have hwa' := trans hwa haa',
    specialize hwf a' ⟨hwa', h1 a' hwa', mt (h1 a' hwa') ih2⟩,
    simp [inv_image, flip] at hwf,
    exact hwf haa',
  }, {
    sorry -- not enough time!
  }
end

/-- The first order frame language with one 2-ary relation symbol. -/
def L : first_order.language := {
  functions := λ _, empty,
  relations := λ n, match n with
    | 2 := unit
    | n := empty
  end
}

def realize_sentence' (M : L.Structure W) (S : L.sentence)
:= realize_sentence W S

def first_order_definable (𝔽 : set frame) (S : L.sentence) :=
begin
  refine ∀ F, F ∈ 𝔽 ↔ _,
  let M : L.Structure F.W := {
    fun_map := λ n e args, empty.elim e,
    rel_map := λ n t args, match n, args with
    | 2, args := F.R (args 0) (args 1)
    | n, args := false
    end
  },
  -- M ⊨ S
  exact realize_sentence' M S,
end

theorem 𝔽_reflexive_is_fodefinable : first_order_definable 𝔽_reflexive
(bounded_formula.all
  (@relations.bounded_formula L empty 2 1 ()
    ![term.var (sum.inr 0), term.var (sum.inr 0)]))
:= begin
  -- It turns out you don't even need the simp...
  -- but I don't actualy understand what's going on unless I simp it so
  -- leave this here just in case.
  -- simp only [first_order_definable, realize_sentence', realize_sentence,
  --            formula.realize, realize_all, realize_rel, term.realize,
  --            matrix.cons_val_zero, sum.elim_inr, matrix.cons_val_one,
  --            matrix.head_cons, 𝔽_reflexive, 𝔽, set.mem_set_of_eq],
  intro F,
  split,
  { intros hF, exact hF },
  { intros h, exact h }
end

/- The key reason for using this embedded first-order language is I wanted
to show that the converse-wellfounded + transitive class from before cannot
be defined by a first-order sentence. I never got around to it, but I still
learned about using lean's definitions for first-order logic.-/


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

import ring_theory.polynomial.cyclotomic.basic
import topology.algebra.polynomial
import field_theory.finite.basic

/-!
# Primes congruent to one

We prove that, for any positive `k : ℕ`, there are infinitely many primes `p` such that
`p ≡ 1 [MOD k]`.
-/

namespace nat

open polynomial nat filter

/-- For any positive `k : ℕ` there are infinitely many primes `p` such that `p ≡ 1 [MOD k]`. -/
lemma exists_prime_ge_modeq_one (k n : ℕ) (hpos : 0 < k) :
  ∃ (p : ℕ), nat.prime p ∧ n ≤ p ∧ p ≡ 1 [MOD k] :=
begin
  have hli : tendsto (abs ∘ (λ (a : ℕ), |(a : ℚ)|)) at_top at_top,
  { simp only [(∘), abs_cast],
    exact nat.strict_mono_cast.monotone.tendsto_at_top_at_top exists_nat_ge },
  have hcff : int.cast_ring_hom ℚ (cyclotomic k ℤ).leading_coeff ≠ 0,
  { simp only [cyclotomic.monic, ring_hom.eq_int_cast, monic.leading_coeff, int.cast_one, ne.def,
     not_false_iff, one_ne_zero] },
  obtain ⟨a, ha⟩ := tendsto_at_top_at_top.1 (tendsto_abv_eval₂_at_top (int.cast_ring_hom ℚ)
    abs (cyclotomic k ℤ) (degree_cyclotomic_pos k ℤ hpos) hcff hli) 2,
  let b := a * (k * n.factorial),
  have hgt : 1 < (eval ↑(a * (k * n.factorial)) (cyclotomic k ℤ)).nat_abs,
  { suffices hgtabs : 1 < |eval ↑b (cyclotomic k ℤ)|,
    { rw [int.abs_eq_nat_abs] at hgtabs,
      exact_mod_cast hgtabs },
    suffices hgtrat : 1 < |eval ↑b (cyclotomic k ℚ)|,
    { rw [← map_cyclotomic_int k ℚ, ← int.cast_coe_nat, ← int.coe_cast_ring_hom, eval_map,
        eval₂_hom, int.coe_cast_ring_hom] at hgtrat,
      assumption_mod_cast },
    suffices hleab : a ≤ b,
    { replace ha := lt_of_lt_of_le one_lt_two (ha b hleab),
      rwa [← eval_map, map_cyclotomic_int k ℚ, abs_cast] at ha },
    exact le_mul_of_pos_right (mul_pos hpos (factorial_pos n)) },
  let p := min_fac (eval ↑b (cyclotomic k ℤ)).nat_abs,
  haveI hprime : fact p.prime := ⟨min_fac_prime (ne_of_lt hgt).symm⟩,
  have hroot : is_root (cyclotomic k (zmod p)) (cast_ring_hom (zmod p) b),
  { rw [is_root.def, ← map_cyclotomic_int k (zmod p), eval_map, coe_cast_ring_hom,
    ← int.cast_coe_nat, ← int.coe_cast_ring_hom, eval₂_hom, int.coe_cast_ring_hom,
      zmod.int_coe_zmod_eq_zero_iff_dvd _ _],
    apply int.dvd_nat_abs.1,
    exact_mod_cast min_fac_dvd (eval ↑b (cyclotomic k ℤ)).nat_abs },
  refine ⟨p, hprime.1, _, _⟩,
  { by_contra habs,
    exact (prime.dvd_iff_not_coprime hprime.1).1
      (dvd_factorial (min_fac_pos _) (le_of_not_ge habs))
      (coprime_of_root_cyclotomic hpos hroot).symm.coprime_mul_left_right.coprime_mul_left_right },
  { have hdiv := order_of_dvd_of_pow_eq_one (zmod.units_pow_card_sub_one_eq_one p
      (zmod.unit_of_coprime b (coprime_of_root_cyclotomic hpos hroot))),
    have : ¬p ∣ k := hprime.1.coprime_iff_not_dvd.1
      (coprime_of_root_cyclotomic hpos hroot).symm.coprime_mul_left_right.coprime_mul_right_right,
    haveI := ne_zero.of_not_dvd (zmod p) this,
    have : k = order_of (b : zmod p) := (is_root_cyclotomic_iff.mp hroot).eq_order_of,
    rw [←order_of_units, zmod.coe_unit_of_coprime, ←this] at hdiv,
    exact ((modeq_iff_dvd' hprime.1.pos).2 hdiv).symm }
end

lemma frequently_at_top_modeq_one (k : ℕ) (hpos : 0 < k) :
  ∃ᶠ p in at_top, nat.prime p ∧ p ≡ 1 [MOD k] :=
begin
  refine frequently_at_top.2 (λ n, _),
  obtain ⟨p, hp⟩ := exists_prime_ge_modeq_one k n hpos,
  exact ⟨p, ⟨hp.2.1, hp.1, hp.2.2⟩⟩
end

lemma infinite_set_of_prime_modeq_one (k : ℕ) (hpos : 0 < k) :
  set.infinite {p : ℕ | nat.prime p ∧ p ≡ 1 [MOD k]} :=
frequently_at_top_iff_infinite.1 (frequently_at_top_modeq_one k hpos)

end nat


-- Relacion_entre_los_indices_de_las_subsucesiones_y_de_la_sucesion.lean
-- Relación entre los índices de las subsucesiones y los de la sucesión
-- José A. Alonso Jiménez
-- Sevilla, 29 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Para extraer una subsucesión se aplica una función de extracción que
-- conserva el orden; por ejemplo, la subsucesión
--    uₒ, u₂, u₄, u₆, ...
-- se ha obtenido con la función de extracción φ tal que φ(n) = 2*n.
--
-- En Lean, se puede definir que φ es una función de extracción por
--    def extraccion (φ : ℕ → ℕ) :=
--      ∀ {n m}, n < m → φ n < φ m
--
-- Demostrar que si φ es una función de extracción, entonces
--    ∀ n, n ≤ φ n
-- ---------------------------------------------------------------------

import tactic
open nat

variable {φ : ℕ → ℕ}

set_option pp.structure_projections false

def extraccion (φ : ℕ → ℕ) :=
  ∀ {n m}, n < m → φ n < φ m

-- 1ª demostración
example :
  extraccion φ → ∀ n, n ≤ φ n :=
begin
  intros h n,
  induction n with m HI,
  { exact nat.zero_le (φ 0), },
  { apply nat.succ_le_of_lt,
    have h1 : m < succ m := lt_add_one m,
    calc m ≤ φ m        : HI
       ... < φ (succ m) : h h1, },
end

-- 2ª demostración
example :
  extraccion φ → ∀ n, n ≤ φ n :=
begin
  intros h n,
  induction n with m HI,
  { exact nat.zero_le (φ 0), },
  { apply nat.succ_le_of_lt,
    calc m ≤ φ m        : HI
       ... < φ (succ m) : h (lt_add_one m), },
end

-- 3ª demostración
example :
  extraccion φ → ∀ n, n ≤ φ n :=
assume h : extraccion φ,
assume n,
nat.rec_on n
  ( show 0 ≤ φ 0,
      from nat.zero_le (φ 0) )
  ( assume m,
    assume HI : m ≤ φ m,
    have h1 : m < succ m,
      from lt_add_one m,
    have h2 : m < φ (succ m), from
      calc m ≤ φ m        : HI
         ... < φ (succ m) : h h1,
    show succ m ≤ φ (succ m),
      from nat.succ_le_of_lt h2)


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.set.function
import logic.function.iterate

/-!
# Fixed points of a self-map

In this file we define

* the predicate `is_fixed_pt f x := f x = x`;
* the set `fixed_points f` of fixed points of a self-map `f`.

We also prove some simple lemmas about `is_fixed_pt` and `∘`, `iterate`, and `semiconj`.

## Tags

fixed point
-/

universes u v

variables {α : Type u} {β : Type v} {f fa g : α → α} {x y : α} {fb : β → β} {m n k : ℕ}

namespace function

/-- A point `x` is a fixed point of `f : α → α` if `f x = x`. -/
def is_fixed_pt (f : α → α) (x : α) := f x = x

/-- Every point is a fixed point of `id`. -/
lemma is_fixed_pt_id (x : α) : is_fixed_pt id x := (rfl : _)

namespace is_fixed_pt

instance [h : decidable_eq α] {f : α → α} {x : α} : decidable (is_fixed_pt f x) :=
h (f x) x

/-- If `x` is a fixed point of `f`, then `f x = x`. This is useful, e.g., for `rw` or `simp`.-/
protected

/-- If `x` is a fixed point of `f` and `g`, then it is a fixed point of `f ∘ g`. -/
protected lemma comp (hf : is_fixed_pt f x) (hg : is_fixed_pt g x) : is_fixed_pt (f ∘ g) x :=
calc f (g x) = f x : congr_arg f hg
         ... = x   : hf

/-- If `x` is a fixed point of `f`, then it is a fixed point of `f^[n]`. -/
protected lemma iterate (hf : is_fixed_pt f x) (n : ℕ) : is_fixed_pt (f^[n]) x :=
iterate_fixed hf n

/-- If `x` is a fixed point of `f ∘ g` and `g`, then it is a fixed point of `f`. -/
lemma left_of_comp (hfg : is_fixed_pt (f ∘ g) x) (hg : is_fixed_pt g x) : is_fixed_pt f x :=
calc f x = f (g x) : congr_arg f hg.symm
     ... = x       : hfg

/-- If `x` is a fixed point of `f` and `g` is a left inverse of `f`, then `x` is a fixed
point of `g`. -/
lemma to_left_inverse (hf : is_fixed_pt f x) (h : left_inverse g f) : is_fixed_pt g x :=
calc g x = g (f x) : congr_arg g hf.symm
     ... = x       : h x

/-- If `g` (semi)conjugates `fa` to `fb`, then it sends fixed points of `fa` to fixed points
of `fb`. -/
protected lemma map {x : α} (hx : is_fixed_pt fa x) {g : α → β} (h : semiconj g fa fb) :
  is_fixed_pt fb (g x) :=
calc fb (g x) = g (fa x) : (h.eq x).symm
          ... = g x      : congr_arg g hx

end is_fixed_pt

/-- The set of fixed points of a map `f : α → α`. -/
def fixed_points (f : α → α) : set α := {x : α | is_fixed_pt f x}

instance fixed_points.decidable [decidable_eq α] (f : α → α) (x : α) :
  decidable (x ∈ fixed_points f) :=
is_fixed_pt.decidable

@[simp] lemma mem_fixed_points : x ∈ fixed_points f ↔ is_fixed_pt f x := iff.rfl

@[simp] lemma fixed_points_id : fixed_points (@id α) = set.univ :=
set.ext $ λ _, by simpa using is_fixed_pt_id _

/-- If `g` semiconjugates `fa` to `fb`, then it sends fixed points of `fa` to fixed points
of `fb`. -/
lemma semiconj.maps_to_fixed_pts {g : α → β} (h : semiconj g fa fb) :
  set.maps_to g (fixed_points fa) (fixed_points fb) :=
λ x hx, hx.map h

/-- Any two maps `f : α → β` and `g : β → α` are inverse of each other on the sets of fixed points
of `f ∘ g` and `g ∘ f`, respectively. -/
lemma inv_on_fixed_pts_comp (f : α → β) (g : β → α) :
  set.inv_on f g (fixed_points $ f ∘ g) (fixed_points $ g ∘ f) :=
⟨λ x, id, λ x, id⟩

/-- Any map `f` sends fixed points of `g ∘ f` to fixed points of `f ∘ g`. -/
lemma maps_to_fixed_pts_comp (f : α → β) (g : β → α) :
  set.maps_to f (fixed_points $ g ∘ f) (fixed_points $ f ∘ g) :=
λ x hx, hx.map $ λ x, rfl

/-- Given two maps `f : α → β` and `g : β → α`, `g` is a bijective map between the fixed points
of `f ∘ g` and the fixed points of `g ∘ f`. The inverse map is `f`, see `inv_on_fixed_pts_comp`. -/
lemma bij_on_fixed_pts_comp (f : α → β) (g : β → α) :
  set.bij_on g (fixed_points $ f ∘ g) (fixed_points $ g ∘ f) :=
(inv_on_fixed_pts_comp f g).bij_on (maps_to_fixed_pts_comp g f) (maps_to_fixed_pts_comp f g)

/-- If self-maps `f` and `g` commute, then they are inverse of each other on the set of fixed points
of `f ∘ g`. This is a particular case of `function.inv_on_fixed_pts_comp`. -/
lemma commute.inv_on_fixed_pts_comp (h : commute f g) :
  set.inv_on f g (fixed_points $ f ∘ g) (fixed_points $ f ∘ g) :=
by simpa only [h.comp_eq] using inv_on_fixed_pts_comp f g

/-- If self-maps `f` and `g` commute, then `f` is bijective on the set of fixed points of `f ∘ g`.
This is a particular case of `function.bij_on_fixed_pts_comp`. -/
lemma commute.left_bij_on_fixed_pts_comp (h : commute f g) :
  set.bij_on f (fixed_points $ f ∘ g) (fixed_points $ f ∘ g) :=
by simpa only [h.comp_eq] using bij_on_fixed_pts_comp g f

/-- If self-maps `f` and `g` commute, then `g` is bijective on the set of fixed points of `f ∘ g`.
This is a particular case of `function.bij_on_fixed_pts_comp`. -/
lemma commute.right_bij_on_fixed_pts_comp (h : commute f g) :
  set.bij_on g (fixed_points $ f ∘ g) (fixed_points $ f ∘ g) :=
by simpa only [h.comp_eq] using bij_on_fixed_pts_comp f g

end function