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

! This file was ported from Lean 3 source module analysis.box_integral.partition.split
! leanprover-community/mathlib commit 6ca1a09bc9aa75824bf97388c9e3b441fc4ccf3f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.BoxIntegral.Partition.Basic

/-!
# Split a box along one or more hyperplanes

## Main definitions

A hyperplane `{x : ι → ℝ | x i = a}` splits a rectangular box `I : box_integral.box ι` into two
smaller boxes. If `a ∉ Ioo (I.lower i, I.upper i)`, then one of these boxes is empty, so it is not a
box in the sense of `box_integral.box`.

We introduce the following definitions.

* `box_integral.box.split_lower I i a` and `box_integral.box.split_upper I i a` are these boxes (as
  `with_bot (box_integral.box ι)`);
* `box_integral.prepartition.split I i a` is the partition of `I` made of these two boxes (or of one
   box `I` if one of these boxes is empty);
* `box_integral.prepartition.split_many I s`, where `s : finset (ι × ℝ)` is a finite set of
  hyperplanes `{x : ι → ℝ | x i = a}` encoded as pairs `(i, a)`, is the partition of `I` made by
  cutting it along all the hyperplanes in `s`.

## Main results

The main result `box_integral.prepartition.exists_Union_eq_diff` says that any prepartition `π` of
`I` admits a prepartition `π'` of `I` that covers exactly `I \ π.Union`. One of these prepartitions
is available as `box_integral.prepartition.compl`.

## Tags

rectangular box, partition, hyperplane
-/

noncomputable section

open Classical BigOperators Filter

open Function Set Filter

namespace BoxIntegral

variable {ι M : Type _} {n : ℕ}

namespace Box

variable {I : Box ι} {i : ι} {x : ℝ} {y : ι → ℝ}

/-- Given a box `I` and `x ∈ (I.lower i, I.upper i)`, the hyperplane `{y : ι → ℝ | y i = x}` splits
`I` into two boxes. `box_integral.box.split_lower I i x` is the box `I ∩ {y | y i ≤ x}`
(if it is nonempty). As usual, we represent a box that may be empty as
`with_bot (box_integral.box ι)`. -/
def splitLower (I : Box ι) (i : ι) (x : ℝ) : WithBot (Box ι) :=
  mk' I.lower (update I.upper i (min x (I.upper i)))
#align box_integral.box.split_lower BoxIntegral.Box.splitLower

@[simp]
theorem coe_splitLower : (splitLower I i x : Set (ι → ℝ)) = I ∩ { y | y i ≤ x } :=
  by
  rw [split_lower, coe_mk']
  ext y
  simp only [mem_univ_pi, mem_Ioc, mem_inter_iff, mem_coe, mem_set_of_eq, forall_and, ← Pi.le_def,
    le_update_iff, le_min_iff, and_assoc', and_forall_ne i, mem_def]
  rw [and_comm' (y i ≤ x), Pi.le_def]
#align box_integral.box.coe_split_lower BoxIntegral.Box.coe_splitLower

theorem splitLower_le : I.splitLower i x ≤ I :=
  withBotCoe_subset_iff.1 <| by simp
#align box_integral.box.split_lower_le BoxIntegral.Box.splitLower_le

@[simp]
theorem splitLower_eq_bot {i x} : I.splitLower i x = ⊥ ↔ x ≤ I.lower i :=
  by
  rw [split_lower, mk'_eq_bot, exists_update_iff I.upper fun j y => y ≤ I.lower j]
  simp [(I.lower_lt_upper _).not_le]
#align box_integral.box.split_lower_eq_bot BoxIntegral.Box.splitLower_eq_bot

@[simp]
theorem splitLower_eq_self : I.splitLower i x = I ↔ I.upper i ≤ x := by
  simp [split_lower, update_eq_iff]
#align box_integral.box.split_lower_eq_self BoxIntegral.Box.splitLower_eq_self

theorem splitLower_def [DecidableEq ι] {i x} (h : x ∈ Ioo (I.lower i) (I.upper i))
    (h' : ∀ j, I.lower j < update I.upper i x j :=
      (forall_update_iff I.upper fun j y => I.lower j < y).2
        ⟨h.1, fun j hne => I.lower_lt_upper _⟩) :
    I.splitLower i x = (⟨I.lower, update I.upper i x, h'⟩ : Box ι) :=
  by
  simp only [split_lower, mk'_eq_coe, min_eq_left h.2.le]
  use rfl
  congr
#align box_integral.box.split_lower_def BoxIntegral.Box.splitLower_def

/-- Given a box `I` and `x ∈ (I.lower i, I.upper i)`, the hyperplane `{y : ι → ℝ | y i = x}` splits
`I` into two boxes. `box_integral.box.split_upper I i x` is the box `I ∩ {y | x < y i}`
(if it is nonempty). As usual, we represent a box that may be empty as
`with_bot (box_integral.box ι)`. -/
def splitUpper (I : Box ι) (i : ι) (x : ℝ) : WithBot (Box ι) :=
  mk' (update I.lower i (max x (I.lower i))) I.upper
#align box_integral.box.split_upper BoxIntegral.Box.splitUpper

@[simp]
theorem coe_splitUpper : (splitUpper I i x : Set (ι → ℝ)) = I ∩ { y | x < y i } :=
  by
  rw [split_upper, coe_mk']
  ext y
  simp only [mem_univ_pi, mem_Ioc, mem_inter_iff, mem_coe, mem_set_of_eq, forall_and,
    forall_update_iff I.lower fun j z => z < y j, max_lt_iff, and_assoc' (x < y i), and_forall_ne i,
    mem_def]
  exact and_comm' _ _
#align box_integral.box.coe_split_upper BoxIntegral.Box.coe_splitUpper

theorem splitUpper_le : I.splitUpper i x ≤ I :=
  withBotCoe_subset_iff.1 <| by simp
#align box_integral.box.split_upper_le BoxIntegral.Box.splitUpper_le

@[simp]
theorem splitUpper_eq_bot {i x} : I.splitUpper i x = ⊥ ↔ I.upper i ≤ x :=
  by
  rw [split_upper, mk'_eq_bot, exists_update_iff I.lower fun j y => I.upper j ≤ y]
  simp [(I.lower_lt_upper _).not_le]
#align box_integral.box.split_upper_eq_bot BoxIntegral.Box.splitUpper_eq_bot

@[simp]
theorem splitUpper_eq_self : I.splitUpper i x = I ↔ x ≤ I.lower i := by
  simp [split_upper, update_eq_iff]
#align box_integral.box.split_upper_eq_self BoxIntegral.Box.splitUpper_eq_self

theorem splitUpper_def [DecidableEq ι] {i x} (h : x ∈ Ioo (I.lower i) (I.upper i))
    (h' : ∀ j, update I.lower i x j < I.upper j :=
      (forall_update_iff I.lower fun j y => y < I.upper j).2
        ⟨h.2, fun j hne => I.lower_lt_upper _⟩) :
    I.splitUpper i x = (⟨update I.lower i x, I.upper, h'⟩ : Box ι) :=
  by
  simp only [split_upper, mk'_eq_coe, max_eq_left h.1.le]
  refine' ⟨_, rfl⟩
  congr
#align box_integral.box.split_upper_def BoxIntegral.Box.splitUpper_def

theorem disjoint_splitLower_splitUpper (I : Box ι) (i : ι) (x : ℝ) :
    Disjoint (I.splitLower i x) (I.splitUpper i x) :=
  by
  rw [← disjoint_with_bot_coe, coe_split_lower, coe_split_upper]
  refine' (Disjoint.inf_left' _ _).inf_right' _
  rw [Set.disjoint_left]
  exact fun y (hle : y i ≤ x) hlt => not_lt_of_le hle hlt
#align box_integral.box.disjoint_split_lower_split_upper BoxIntegral.Box.disjoint_splitLower_splitUpper

theorem splitLower_ne_splitUpper (I : Box ι) (i : ι) (x : ℝ) :
    I.splitLower i x ≠ I.splitUpper i x :=
  by
  cases le_or_lt x (I.lower i)
  · rw [split_upper_eq_self.2 h, split_lower_eq_bot.2 h]
    exact WithBot.bot_ne_coe
  · refine' (disjoint_split_lower_split_upper I i x).Ne _
    rwa [Ne.def, split_lower_eq_bot, not_le]
#align box_integral.box.split_lower_ne_split_upper BoxIntegral.Box.splitLower_ne_splitUpper

end Box

namespace Prepartition

variable {I J : Box ι} {i : ι} {x : ℝ}

/-- The partition of `I : box ι` into the boxes `I ∩ {y | y ≤ x i}` and `I ∩ {y | x i < y}`.
One of these boxes can be empty, then this partition is just the single-box partition `⊤`. -/
def split (I : Box ι) (i : ι) (x : ℝ) : Prepartition I :=
  ofWithBot {I.splitLower i x, I.splitUpper i x}
    (by
      simp only [Finset.mem_insert, Finset.mem_singleton]
      rintro J (rfl | rfl)
      exacts[box.split_lower_le, box.split_upper_le])
    (by
      simp only [Finset.coe_insert, Finset.coe_singleton, true_and_iff, Set.mem_singleton_iff,
        pairwise_insert_of_symmetric symmetric_disjoint, pairwise_singleton]
      rintro J rfl -
      exact I.disjoint_split_lower_split_upper i x)
#align box_integral.prepartition.split BoxIntegral.Prepartition.split

@[simp]
theorem mem_split_iff : J ∈ split I i x ↔ ↑J = I.splitLower i x ∨ ↑J = I.splitUpper i x := by
  simp [split]
#align box_integral.prepartition.mem_split_iff BoxIntegral.Prepartition.mem_split_iff

theorem mem_split_iff' :
    J ∈ split I i x ↔
      (J : Set (ι → ℝ)) = I ∩ { y | y i ≤ x } ∨ (J : Set (ι → ℝ)) = I ∩ { y | x < y i } :=
  by simp [mem_split_iff, ← box.with_bot_coe_inj]
#align box_integral.prepartition.mem_split_iff' BoxIntegral.Prepartition.mem_split_iff'

@[simp]
theorem union_split (I : Box ι) (i : ι) (x : ℝ) : (split I i x).unionᵢ = I := by
  simp [split, ← inter_union_distrib_left, ← set_of_or, le_or_lt]
#align box_integral.prepartition.Union_split BoxIntegral.Prepartition.union_split

theorem isPartitionSplit (I : Box ι) (i : ι) (x : ℝ) : IsPartition (split I i x) :=
  isPartition_iff_union_eq.2 <| union_split I i x
#align box_integral.prepartition.is_partition_split BoxIntegral.Prepartition.isPartitionSplit

theorem sum_split_boxes {M : Type _} [AddCommMonoid M] (I : Box ι) (i : ι) (x : ℝ) (f : Box ι → M) :
    (∑ J in (split I i x).boxes, f J) = (I.splitLower i x).elim 0 f + (I.splitUpper i x).elim 0 f :=
  by rw [split, sum_of_with_bot, Finset.sum_pair (I.split_lower_ne_split_upper i x)]
#align box_integral.prepartition.sum_split_boxes BoxIntegral.Prepartition.sum_split_boxes

/-- If `x ∉ (I.lower i, I.upper i)`, then the hyperplane `{y | y i = x}` does not split `I`. -/
theorem split_of_not_mem_Ioo (h : x ∉ Ioo (I.lower i) (I.upper i)) : split I i x = ⊤ :=
  by
  refine' ((is_partition_top I).eq_of_boxes_subset fun J hJ => _).symm
  rcases mem_top.1 hJ with rfl; clear hJ
  rw [mem_boxes, mem_split_iff]
  rw [mem_Ioo, not_and_or, not_lt, not_lt] at h
  cases h <;> [right, left]
  · rwa [eq_comm, box.split_upper_eq_self]
  · rwa [eq_comm, box.split_lower_eq_self]
#align box_integral.prepartition.split_of_not_mem_Ioo BoxIntegral.Prepartition.split_of_not_mem_Ioo

theorem coe_eq_of_mem_split_of_mem_le {y : ι → ℝ} (h₁ : J ∈ split I i x) (h₂ : y ∈ J)
    (h₃ : y i ≤ x) : (J : Set (ι → ℝ)) = I ∩ { y | y i ≤ x } :=
  (mem_split_iff'.1 h₁).resolve_right fun H =>
    by
    rw [← box.mem_coe, H] at h₂
    exact h₃.not_lt h₂.2
#align box_integral.prepartition.coe_eq_of_mem_split_of_mem_le BoxIntegral.Prepartition.coe_eq_of_mem_split_of_mem_le

theorem coe_eq_of_mem_split_of_lt_mem {y : ι → ℝ} (h₁ : J ∈ split I i x) (h₂ : y ∈ J)
    (h₃ : x < y i) : (J : Set (ι → ℝ)) = I ∩ { y | x < y i } :=
  (mem_split_iff'.1 h₁).resolve_left fun H =>
    by
    rw [← box.mem_coe, H] at h₂
    exact h₃.not_le h₂.2
#align box_integral.prepartition.coe_eq_of_mem_split_of_lt_mem BoxIntegral.Prepartition.coe_eq_of_mem_split_of_lt_mem

@[simp]
theorem restrict_split (h : I ≤ J) (i : ι) (x : ℝ) : (split J i x).restrict I = split I i x :=
  by
  refine' ((is_partition_split J i x).restrict h).eq_of_boxes_subset _
  simp only [Finset.subset_iff, mem_boxes, mem_restrict', exists_prop, mem_split_iff']
  have : ∀ s, (I ∩ s : Set (ι → ℝ)) ⊆ J := fun s => (inter_subset_left _ _).trans h
  rintro J₁ ⟨J₂, H₂ | H₂, H₁⟩ <;> [left, right] <;> simp [H₁, H₂, inter_left_comm ↑I, this]
#align box_integral.prepartition.restrict_split BoxIntegral.Prepartition.restrict_split

theorem inf_split (π : Prepartition I) (i : ι) (x : ℝ) :
    π ⊓ split I i x = π.bunionᵢ fun J => split J i x :=
  bUnion_congr_of_le rfl fun J hJ => restrict_split hJ i x
#align box_integral.prepartition.inf_split BoxIntegral.Prepartition.inf_split

/-- Split a box along many hyperplanes `{y | y i = x}`; each hyperplane is given by the pair
`(i x)`. -/
def splitMany (I : Box ι) (s : Finset (ι × ℝ)) : Prepartition I :=
  s.inf fun p => split I p.1 p.2
#align box_integral.prepartition.split_many BoxIntegral.Prepartition.splitMany

@[simp]
theorem splitMany_empty (I : Box ι) : splitMany I ∅ = ⊤ :=
  Finset.inf_empty
#align box_integral.prepartition.split_many_empty BoxIntegral.Prepartition.splitMany_empty

@[simp]
theorem splitMany_insert (I : Box ι) (s : Finset (ι × ℝ)) (p : ι × ℝ) :
    splitMany I (insert p s) = splitMany I s ⊓ split I p.1 p.2 := by
  rw [split_many, Finset.inf_insert, inf_comm, split_many]
#align box_integral.prepartition.split_many_insert BoxIntegral.Prepartition.splitMany_insert

theorem splitMany_le_split (I : Box ι) {s : Finset (ι × ℝ)} {p : ι × ℝ} (hp : p ∈ s) :
    splitMany I s ≤ split I p.1 p.2 :=
  Finset.inf_le hp
#align box_integral.prepartition.split_many_le_split BoxIntegral.Prepartition.splitMany_le_split

theorem isPartitionSplitMany (I : Box ι) (s : Finset (ι × ℝ)) : IsPartition (splitMany I s) :=
  Finset.induction_on s (by simp only [split_many_empty, is_partition_top]) fun a s ha hs => by
    simpa only [split_many_insert, inf_split] using hs.bUnion fun J hJ => is_partition_split _ _ _
#align box_integral.prepartition.is_partition_split_many BoxIntegral.Prepartition.isPartitionSplitMany

@[simp]
theorem union_splitMany (I : Box ι) (s : Finset (ι × ℝ)) : (splitMany I s).unionᵢ = I :=
  (isPartitionSplitMany I s).unionᵢ_eq
#align box_integral.prepartition.Union_split_many BoxIntegral.Prepartition.union_splitMany

theorem inf_splitMany {I : Box ι} (π : Prepartition I) (s : Finset (ι × ℝ)) :
    π ⊓ splitMany I s = π.bunionᵢ fun J => splitMany J s :=
  by
  induction' s using Finset.induction_on with p s hp ihp
  · simp
  · simp_rw [split_many_insert, ← inf_assoc, ihp, inf_split, bUnion_assoc]
#align box_integral.prepartition.inf_split_many BoxIntegral.Prepartition.inf_splitMany

/-- Let `s : finset (ι × ℝ)` be a set of hyperplanes `{x : ι → ℝ | x i = r}` in `ι → ℝ` encoded as
pairs `(i, r)`. Suppose that this set contains all faces of a box `J`. The hyperplanes of `s` split
a box `I` into subboxes. Let `Js` be one of them. If `J` and `Js` have nonempty intersection, then
`Js` is a subbox of `J`.  -/
theorem not_disjoint_imp_le_of_subset_of_mem_splitMany {I J Js : Box ι} {s : Finset (ι × ℝ)}
    (H : ∀ i, {(i, J i), (i, J.upper i)} ⊆ s) (HJs : Js ∈ splitMany I s)
    (Hn : ¬Disjoint (J : WithBot (Box ι)) Js) : Js ≤ J :=
  by
  simp only [Finset.insert_subset, Finset.singleton_subset_iff] at H
  rcases box.not_disjoint_coe_iff_nonempty_inter.mp Hn with ⟨x, hx, hxs⟩
  refine' fun y hy i => ⟨_, _⟩
  · rcases split_many_le_split I (H i).1 HJs with ⟨Jl, Hmem : Jl ∈ split I i (J.lower i), Hle⟩
    have := Hle hxs
    rw [← box.coe_subset_coe, coe_eq_of_mem_split_of_lt_mem Hmem this (hx i).1] at Hle
    exact (Hle hy).2
  · rcases split_many_le_split I (H i).2 HJs with ⟨Jl, Hmem : Jl ∈ split I i (J.upper i), Hle⟩
    have := Hle hxs
    rw [← box.coe_subset_coe, coe_eq_of_mem_split_of_mem_le Hmem this (hx i).2] at Hle
    exact (Hle hy).2
#align box_integral.prepartition.not_disjoint_imp_le_of_subset_of_mem_split_many BoxIntegral.Prepartition.not_disjoint_imp_le_of_subset_of_mem_splitMany

section Fintype

variable [Finite ι]

/-- Let `s` be a finite set of boxes in `ℝⁿ = ι → ℝ`. Then there exists a finite set `t₀` of
hyperplanes (namely, the set of all hyperfaces of boxes in `s`) such that for any `t ⊇ t₀`
and any box `I` in `ℝⁿ` the following holds. The hyperplanes from `t` split `I` into subboxes.
Let `J'` be one of them, and let `J` be one of the boxes in `s`. If these boxes have a nonempty
intersection, then `J' ≤ J`. -/
theorem eventually_not_disjoint_imp_le_of_mem_splitMany (s : Finset (Box ι)) :
    ∀ᶠ t : Finset (ι × ℝ) in atTop,
      ∀ (I : Box ι), ∀ J ∈ s, ∀ J' ∈ splitMany I t, ¬Disjoint (J : WithBot (Box ι)) J' → J' ≤ J :=
  by
  cases nonempty_fintype ι
  refine'
    eventually_at_top.2
      ⟨s.bUnion fun J => finset.univ.bUnion fun i => {(i, J i), (i, J.upper i)},
        fun t ht I J hJ J' hJ' => not_disjoint_imp_le_of_subset_of_mem_split_many (fun i => _) hJ'⟩
  exact fun p hp =>
    ht (Finset.mem_bunionᵢ.2 ⟨J, hJ, Finset.mem_bunionᵢ.2 ⟨i, Finset.mem_univ _, hp⟩⟩)
#align box_integral.prepartition.eventually_not_disjoint_imp_le_of_mem_split_many BoxIntegral.Prepartition.eventually_not_disjoint_imp_le_of_mem_splitMany

theorem eventually_splitMany_inf_eq_filter (π : Prepartition I) :
    ∀ᶠ t : Finset (ι × ℝ) in atTop,
      π ⊓ splitMany I t = (splitMany I t).filterₓ fun J => ↑J ⊆ π.unionᵢ :=
  by
  refine' (eventually_not_disjoint_imp_le_of_mem_split_many π.boxes).mono fun t ht => _
  refine' le_antisymm ((bUnion_le_iff _).2 fun J hJ => _) (le_inf (fun J hJ => _) (filter_le _ _))
  · refine' of_with_bot_mono _
    simp only [Finset.mem_image, exists_prop, mem_boxes, mem_filter]
    rintro _ ⟨J₁, h₁, rfl⟩ hne
    refine' ⟨_, ⟨J₁, ⟨h₁, subset.trans _ (π.subset_Union hJ)⟩, rfl⟩, le_rfl⟩
    exact ht I J hJ J₁ h₁ (mt disjoint_iff.1 hne)
  · rw [mem_filter] at hJ
    rcases Set.mem_unionᵢ₂.1 (hJ.2 J.upper_mem) with ⟨J', hJ', hmem⟩
    refine' ⟨J', hJ', ht I _ hJ' _ hJ.1 <| box.not_disjoint_coe_iff_nonempty_inter.2 _⟩
    exact ⟨J.upper, hmem, J.upper_mem⟩
#align box_integral.prepartition.eventually_split_many_inf_eq_filter BoxIntegral.Prepartition.eventually_splitMany_inf_eq_filter

theorem exists_splitMany_inf_eq_filter_of_finite (s : Set (Prepartition I)) (hs : s.Finite) :
    ∃ t : Finset (ι × ℝ),
      ∀ π ∈ s, π ⊓ splitMany I t = (splitMany I t).filterₓ fun J => ↑J ⊆ π.unionᵢ :=
  haveI := fun π (hπ : π ∈ s) => eventually_split_many_inf_eq_filter π
  (hs.eventually_all.2 this).exists
#align box_integral.prepartition.exists_split_many_inf_eq_filter_of_finite BoxIntegral.Prepartition.exists_splitMany_inf_eq_filter_of_finite

/-- If `π` is a partition of `I`, then there exists a finite set `s` of hyperplanes such that
`split_many I s ≤ π`. -/
theorem IsPartition.exists_splitMany_le {I : Box ι} {π : Prepartition I} (h : IsPartition π) :
    ∃ s, splitMany I s ≤ π :=
  (eventually_splitMany_inf_eq_filter π).exists.imp fun s hs =>
    by
    rwa [h.Union_eq, filter_of_true, inf_eq_right] at hs
    exact fun J hJ => le_of_mem _ hJ
#align box_integral.prepartition.is_partition.exists_split_many_le BoxIntegral.Prepartition.IsPartition.exists_splitMany_le

/-- For every prepartition `π` of `I` there exists a prepartition that covers exactly
`I \ π.Union`. -/
theorem exists_union_eq_diff (π : Prepartition I) :
    ∃ π' : Prepartition I, π'.unionᵢ = I \ π.unionᵢ :=
  by
  rcases π.eventually_split_many_inf_eq_filter.exists with ⟨s, hs⟩
  use (split_many I s).filterₓ fun J => ¬(J : Set (ι → ℝ)) ⊆ π.Union
  simp [← hs]
#align box_integral.prepartition.exists_Union_eq_diff BoxIntegral.Prepartition.exists_union_eq_diff

/-- If `π` is a prepartition of `I`, then `π.compl` is a prepartition of `I`
such that `π.compl.Union = I \ π.Union`. -/
def compl (π : Prepartition I) : Prepartition I :=
  π.exists_union_eq_diff.some
#align box_integral.prepartition.compl BoxIntegral.Prepartition.compl

@[simp]
theorem union_compl (π : Prepartition I) : π.compl.unionᵢ = I \ π.unionᵢ :=
  π.exists_union_eq_diff.choose_spec
#align box_integral.prepartition.Union_compl BoxIntegral.Prepartition.union_compl

/-- Since the definition of `box_integral.prepartition.compl` uses `Exists.some`,
the result depends only on `π.Union`. -/
theorem compl_congr {π₁ π₂ : Prepartition I} (h : π₁.unionᵢ = π₂.unionᵢ) : π₁.compl = π₂.compl :=
  by
  dsimp only [compl]
  congr 1
  rw [h]
#align box_integral.prepartition.compl_congr BoxIntegral.Prepartition.compl_congr

theorem IsPartition.compl_eq_bot {π : Prepartition I} (h : IsPartition π) : π.compl = ⊥ := by
  rw [← Union_eq_empty, Union_compl, h.Union_eq, diff_self]
#align box_integral.prepartition.is_partition.compl_eq_bot BoxIntegral.Prepartition.IsPartition.compl_eq_bot

@[simp]
theorem compl_top : (⊤ : Prepartition I).compl = ⊥ :=
  (isPartitionTop I).compl_eq_bot
#align box_integral.prepartition.compl_top BoxIntegral.Prepartition.compl_top

end Fintype

end Prepartition

end BoxIntegral


/- Lecture 3.2: Program Semantics — Hoare Logic -/

-- loads big-step semantics `(p, s) ⟹ t` over `state` as state space
import .x32_library

namespace lecture

open program

variables
  {c : state → Prop} {f : state → ℕ} {n : string}
  {p p₀ p₁ p₂ : program} {s s₀ s₁ s₂ t u : state}
  {P P' P₁ P₂ P₃ Q Q' : state → Prop}

/- Hoare triples `{* P *} p {* Q *}` for partial correctness -/

def partial_hoare (P : state → Prop) (p : program) (Q : state → Prop) : Prop :=
∀s t, P s → (p, s) ⟹ t → Q t

notation `{* ` P : 1 ` *} ` p : 1 ` {* ` Q : 1 ` *}` := partial_hoare P p Q

/- Introduction rules for Hoare triples -/

namespace partial_hoare

lemma skip_intro :
  {* P *} skip {* P *} :=
begin
  intros s t hs hst,
  cases hst,
  assumption
end

lemma assign_intro (P : state → Prop) :
  {* λs, P (s.update n (f s)) *} assign n f {* P *} :=
begin
  intros s t P hst,
  cases hst,
  assumption
end

lemma seq_intro (h₁ : {* P₁ *} p₁ {* P₂ *}) (h₂ : {* P₂ *} p₂ {* P₃ *}) :
  {* P₁ *} p₁ ;; p₂ {* P₃ *} :=
begin
  intros s t P hst,
  cases hst,
  apply h₂ _ _ _ hst_h₂,
  apply h₁ _ _ _ hst_h₁,
  assumption
end

lemma ite_intro (h₁ : {* λs, P s ∧ c s *} p₁ {* Q *}) (h₂ : {* λs, P s ∧ ¬ c s *} p₂ {* Q *}) :
  {* P *} ite c p₁ p₂ {* Q *} :=
begin
  intros s t hs hst,
  cases hst,
  { apply h₁ _ _ _ hst_h,
    exact ⟨hs, hst_hs⟩ },
  { apply h₂ _ _ _ hst_h,
    exact ⟨hs, hst_hs⟩ },
end

lemma while_intro (P : state → Prop) (h₁ : {* λs, P s ∧ c s *} p {* P *}) :
  {* P *} while c p {* λs, P s ∧ ¬ c s *} :=
begin
  intros s t hs,
  generalize eq : (while c p, s) = ps,
  intro hst,
  induction hst generalizing s; cases eq,
  { apply hst_ih_hw hst_t _ rfl,
    exact h₁ _ _ ⟨hs, hst_hs⟩ hst_hp },
  { exact ⟨hs, hst_hs⟩ }
end

lemma consequence (h : {* P *} p {* Q *}) (hp : ∀s, P' s → P s) (hq : ∀s, Q s → Q' s) :
  {* P' *} p {* Q' *} :=
assume s t hs hst, hq _ $ h s t (hp s hs) hst

lemma consequence_left (P' : state → Prop) (h : {* P *} p {* Q *}) (hp : ∀s, P' s → P s) :
  {* P' *} p {* Q *} :=
consequence h hp (assume s hs, hs)

lemma consequence_right (Q : state → Prop) (h : {* P *} p {* Q *}) (hq : ∀s, Q s → Q' s) :
  {* P *} p {* Q' *} :=
consequence h (assume s hs, hs) hq

/- Many of the above rules are nonlinear (i.e. their conclusions contain repeated variables). This
makes them inconvenient to apply. We combine some of the previous rules with `consequence` to derive
linear rules. -/

lemma skip_intro' (h : ∀s, P s → Q s):
  {* P *} skip {* Q *} :=
consequence skip_intro h (assume s hs, hs)

lemma assign_intro' (h : ∀s, P s → Q (s.update n (f s))):
  {* P *} assign n f {* Q *} :=
consequence (assign_intro Q) h (assume s hs, hs)

lemma seq_intro' (h₂ : {* P₂ *} p₂ {* P₃ *}) (h₁ : {* P₁ *} p₁ {* P₂ *}) :
  {* P₁ *} p₁ ;; p₂ {* P₃ *} :=
seq_intro h₁ h₂

lemma while_intro_inv (I : state → Prop)
  (h₁ : {* λs, I s ∧ c s *} p {* I *}) (hp : ∀s, P s → I s) (hq : ∀s, ¬ c s → I s → Q s) :
  {* P *} while c p {* Q *} :=
consequence (while_intro I h₁) hp (assume s ⟨hs, hnc⟩, hq s hnc hs)

end partial_hoare

/- Example: `SWAP`

Exchanges the values of variables `a` and `b`. -/

section SWAP

open partial_hoare

def SWAP : program :=
assign "t" (λs, s "a") ;;
assign "a" (λs, s "b") ;;
assign "b" (λs, s "t")

lemma SWAP_correct (x y : ℕ) :
  {* λs, s "a" = x ∧ s "b" = y *} SWAP {* λs, s "a" = y ∧ s "b" = x *} :=
begin
  apply seq_intro',
  apply seq_intro',
  apply assign_intro,
  apply assign_intro,
  apply assign_intro',
  /- The remaining goal looks horrible. But `simp` can simplify it dramatically, and with contextual
  rewriting (i.e. using assumptions in the goal as rewrite rules), it can solve it. -/
  simp {contextual := tt},
end

end SWAP

/- Example: `ADD`

Computes `m + n`, leaving the result in `n`, using only these primitive operations: `n + 1`,
`n - 1`, and `n ≠ 0`. -/

section ADD

open partial_hoare

def ADD : program :=
while (λs, s "n" ≠ 0)
( assign "n" (λs, s "n" - 1) ;;
  assign "m" (λs, s "m" + 1) )

lemma ADD_correct (n m : ℕ) :
  {* λs, s "n" = n ∧ s "m" = m *} ADD {* λs, s "m" = n + m *} :=
begin
  -- `refine` is like `exact`, but it lets us specify holes to be filled later
  refine while_intro_inv (λs, s "n" + s "m" = n + m) _ _ _,
  apply seq_intro',
  apply assign_intro,
  apply assign_intro',
  { simp,
    -- puhh this looks much better: `simp` removed all `update`s
    intros s hnm hn0,
    rw ←hnm,
    -- subtracting on `ℕ` is annoying
    cases s "n",
    { contradiction },
    { simp [nat.succ_eq_add_one] } },
  { simp {contextual := tt} },
  { simp [not_not_iff] {contextual := tt} }
end

end ADD

/- Annotated while loop -/

def program.while_inv (I : state → Prop) (c : state → Prop) (p : program) : program :=
while c p

open program -- makes `program.while_inv` available as `while_inv`

namespace partial_hoare

/- `while_inv` rules use the invariant annotation -/

lemma while_inv_intro {I : state → Prop}
  (h₁ : {* λs, I s ∧ c s *} p {* I *}) (hq : ∀s, ¬ c s → I s → Q s) :
  {* I *} while_inv I c p {* Q *} :=
while_intro_inv I h₁ (assume s hs, hs) hq

lemma while_inv_intro' {I : state → Prop}
  (h₁ : {* λs, I s ∧ c s *} p {* I *}) (hp : ∀s, P s → I s) (hq : ∀s, ¬ c s → I s → Q s) :
  {* P *} while_inv I c p {* Q *} :=
while_intro_inv I h₁ hp hq

end partial_hoare

end lecture

namespace tactic.interactive

open lecture.partial_hoare lecture tactic

meta def is_meta {elab : bool} : expr elab → bool
| (expr.mvar _ _ _) := tt
| _                 := ff

/- Verification condition generator -/

meta def vcg : tactic unit := do
  t ← target,
  match t with
  | `({* %%P *} %%p {* _ *}) :=
    match p with
    | `(program.skip)            := applyc (if is_meta P then ``skip_intro else ``skip_intro')
    | `(program.assign _ _)      := applyc (if is_meta P then ``assign_intro else ``assign_intro')
    | `(program.ite _ _ _)       := do applyc ``ite_intro; vcg
    | `(program.seq _ _)         := do applyc ``seq_intro'; vcg
    | `(program.while_inv _ _ _) :=
      do applyc (if is_meta P then ``while_inv_intro else ``while_inv_intro'); vcg
    | _                          := fail (to_fmt "cannot analyze " ++ to_fmt p)
    end
  | _ := skip  -- do nothing if the goal is not a Hoare triple
  end

end tactic.interactive

namespace lecture

open program

example (n m : ℕ) :
  {* λs, s "n" = n ∧ s "m" = m *} ADD {* λs, s "n" = 0 ∧ s "m" = n + m *} :=
begin
  -- use `show` to annotate the while loop with an invariant
  show {* λs, s "n" = n ∧ s "m" = m *}
      while_inv (λs, s "n" + s "m" = n + m) (λs, s "n" ≠ 0)
      ( assign "n" (λs, s "n" - 1) ;;
        assign "m" (λs, s "m" + 1) )
    {* λs, s "n" = 0 ∧ s "m" = n + m *},
  vcg;
    simp {contextual := tt},
  intros s hnm hn,
  rw ←hnm,
  cases s "n",
  { contradiction },
  { simp [nat.succ_eq_add_one] }
end

end lecture


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import topology.separation

/-!
# Idempotents in topological semigroups

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

This file provides a sufficient condition for a semigroup `M` to contain an idempotent (i.e. an
element `m` such that `m * m = m `), namely that `M` is a nonempty compact Hausdorff space where
right-multiplication by constants is continuous.

We also state a corresponding lemma guaranteeing that a subset of `M` contains an idempotent.
-/

/-- Any nonempty compact Hausdorff semigroup where right-multiplication is continuous contains
an idempotent, i.e. an `m` such that `m * m = m`. -/
@[to_additive "Any nonempty compact Hausdorff additive semigroup where right-addition is continuous
contains an idempotent, i.e. an `m` such that `m + m = m`"]
lemma exists_idempotent_of_compact_t2_of_continuous_mul_left {M} [nonempty M] [semigroup M]
  [topological_space M] [compact_space M] [t2_space M]
  (continuous_mul_left : ∀ r : M, continuous (* r)) : ∃ m : M, m * m = m :=
begin
/- We apply Zorn's lemma to the poset of nonempty closed subsemigroups of `M`. It will turn out that
any minimal element is `{m}` for an idempotent `m : M`. -/
  let S : set (set M) := {N | is_closed N ∧ N.nonempty ∧ ∀ m m' ∈ N, m * m' ∈ N},
  rsuffices ⟨N, ⟨N_closed, ⟨m, hm⟩, N_mul⟩, N_minimal⟩ : ∃ N ∈ S, ∀ N' ∈ S, N' ⊆ N → N' = N,
  { use m,
/- We now have an element `m : M` of a minimal subsemigroup `N`, and want to show `m + m = m`.
We first show that every element of `N` is of the form `m' + m`.-/
    have scaling_eq_self : (* m) '' N = N,
    { apply N_minimal,
      { refine ⟨(continuous_mul_left m).is_closed_map _ N_closed, ⟨_, ⟨m, hm, rfl⟩⟩, _⟩,
        rintros _ ⟨m'', hm'', rfl⟩ _ ⟨m', hm', rfl⟩,
        refine ⟨m'' * m * m', N_mul _ (N_mul _ hm'' _ hm) _ hm', mul_assoc _ _ _⟩ },
      { rintros _ ⟨m', hm', rfl⟩,
        exact N_mul _ hm' _ hm } },
/- In particular, this means that `m' * m = m` for some `m'`. We now use minimality again to show
that this holds for all `m' ∈ N`. -/
    have absorbing_eq_self : N ∩ {m' | m' * m = m} = N,
    { apply N_minimal,
      { refine ⟨N_closed.inter ((t1_space.t1 m).preimage (continuous_mul_left m)), _, _⟩,
        { rwa ←scaling_eq_self at hm },
        { rintros m'' ⟨mem'', eq'' : _ = m⟩ m' ⟨mem', eq' : _ = m⟩,
          refine ⟨N_mul _ mem'' _ mem', _⟩,
          rw [set.mem_set_of_eq, mul_assoc, eq', eq''] } },
      apply set.inter_subset_left },
/- Thus `m * m = m` as desired. -/
    rw ←absorbing_eq_self at hm,
    exact hm.2 },
  refine zorn_superset _ (λ c hcs hc, _),
  refine ⟨⋂₀ c, ⟨is_closed_sInter $ λ t ht, (hcs ht).1, _, λ m hm m' hm', _⟩,
    λ s hs, set.sInter_subset_of_mem hs⟩,
  { obtain rfl | hcnemp := c.eq_empty_or_nonempty,
    { rw set.sInter_empty, apply set.univ_nonempty },
    convert @is_compact.nonempty_Inter_of_directed_nonempty_compact_closed _ _ _ hcnemp.coe_sort
      (coe : c → set M) _ _ _ _,
    { simp only [subtype.range_coe_subtype, set.set_of_mem_eq] } ,
    { refine directed_on.directed_coe (is_chain.directed_on hc.symm) },
    exacts [λ i, (hcs i.prop).2.1, λ i, (hcs i.prop).1.is_compact, λ i, (hcs i.prop).1] },
  { rw set.mem_sInter,
    exact λ t ht, (hcs ht).2.2 m (set.mem_sInter.mp hm t ht) m' (set.mem_sInter.mp hm' t ht) },
end

/-- A version of `exists_idempotent_of_compact_t2_of_continuous_mul_left` where the idempotent lies
in some specified nonempty compact subsemigroup. -/
@[to_additive exists_idempotent_in_compact_add_subsemigroup "A version of
`exists_idempotent_of_compact_t2_of_continuous_add_left` where the idempotent lies in some specified
nonempty compact additive subsemigroup."]
lemma exists_idempotent_in_compact_subsemigroup {M} [semigroup M] [topological_space M] [t2_space M]
  (continuous_mul_left : ∀ r : M, continuous (* r))
  (s : set M) (snemp : s.nonempty) (s_compact : is_compact s) (s_add : ∀ x y ∈ s, x * y ∈ s) :
  ∃ m ∈ s, m * m = m :=
begin
  let M' := {m // m ∈ s},
  letI : semigroup M' :=
    { mul       := λ p q, ⟨p.1 * q.1, s_add _ p.2 _ q.2⟩,
      mul_assoc := λ p q r, subtype.eq (mul_assoc _ _ _) },
  haveI : compact_space M' := is_compact_iff_compact_space.mp s_compact,
  haveI : nonempty M' := nonempty_subtype.mpr snemp,
  have : ∀ p : M', continuous (* p) := λ p,
    ((continuous_mul_left p.1).comp continuous_subtype_val).subtype_mk _,
  obtain ⟨⟨m, hm⟩, idem⟩ := exists_idempotent_of_compact_t2_of_continuous_mul_left this,
  exact ⟨m, hm, subtype.ext_iff.mp idem⟩
end


open function
/- this question should read Q4 (but on the 2016/17 example sheet, this reads 3)
4. (One-sided inverses.)
(i) Say f : X → Y is a function and there exists a function g : Y → X such that f ◦ g is the identity function Y → Y . Prove that f is surjective.
(ii) Say f : X → Y is a function and there exists a function g : Y → X such that g ◦ f is the identity function X → X. Prove that f is injective.
-/
variables {X: Type*} {Y : Type*} {f : X → Y} {g : Y → X}

#check id_of_right_inverse
theorem Q1004i : f ∘ g = id → surjective f :=
begin
intros,
apply surjective_of_has_right_inverse,
unfold has_right_inverse,
sorry
end

theorem Q1004ii : g ∘ f = id → injective f :=
begin
intros,
apply injective_of_has_left_inverse,
sorry
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Gabriel Ebner
-/
import data.int.cast.defs
import algebra.group.basic

/-!
# Cast of integers (additional theorems)

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

This file proves additional properties about the *canonical* homomorphism from
the integers into an additive group with a one (`int.cast`).

There is also `data.int.cast.lemmas`,
which includes lemmas stated in terms of algebraic homomorphisms,
and results involving the order structure of `ℤ`.

By contrast, this file's only import beyond `data.int.cast.defs` is `algebra.group.basic`.
-/

universes u

namespace nat
variables {R : Type u} [add_group_with_one R]

@[simp, norm_cast] theorem cast_sub {m n} (h : m ≤ n) : ((n - m : ℕ) : R) = n - m :=
eq_sub_of_add_eq $ by rw [← cast_add, nat.sub_add_cancel h]

@[simp, norm_cast]

end nat

open nat

namespace int
variables {R : Type u} [add_group_with_one R]

@[simp] theorem cast_neg_succ_of_nat (n : ℕ) : (-[1+ n] : R) = -(n + 1 : ℕ) :=
add_group_with_one.int_cast_neg_succ_of_nat n

@[simp, norm_cast] theorem cast_zero : ((0 : ℤ) : R) = 0 := (cast_of_nat 0).trans nat.cast_zero

@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : R) = n := cast_of_nat _

@[simp, norm_cast] theorem cast_one : ((1 : ℤ) : R) = 1 :=
show (((1 : ℕ) : ℤ) : R) = 1, by simp

@[simp, norm_cast] theorem cast_neg : ∀ n, ((-n : ℤ) : R) = -n
| (0 : ℕ) := by erw [cast_zero, neg_zero]
| (n + 1 : ℕ) := by erw [cast_of_nat, cast_neg_succ_of_nat]; refl
| -[1+ n] := by erw [cast_of_nat, cast_neg_succ_of_nat, neg_neg]

@[simp] theorem cast_sub_nat_nat (m n) :
  ((int.sub_nat_nat m n : ℤ) : R) = m - n :=
begin
  unfold sub_nat_nat, cases e : n - m,
  { simp only [sub_nat_nat, cast_of_nat], simp [e, nat.le_of_sub_eq_zero e] },
  { rw [sub_nat_nat, cast_neg_succ_of_nat, nat.add_one, ← e,
        nat.cast_sub $ _root_.le_of_lt $ nat.lt_of_sub_eq_succ e, neg_sub] },
end

lemma neg_of_nat_eq (n : ℕ) : neg_of_nat n = -(n : ℤ) := by cases n; refl

@[simp] theorem cast_neg_of_nat (n : ℕ) : ((neg_of_nat n : ℤ) : R) = -n :=
by simp [neg_of_nat_eq]

@[simp, norm_cast] theorem cast_add : ∀ m n, ((m + n : ℤ) : R) = m + n
| (m : ℕ) (n : ℕ) := by simp [← int.coe_nat_add]
| (m : ℕ) -[1+ n] := by erw [cast_sub_nat_nat, cast_coe_nat, cast_neg_succ_of_nat, sub_eq_add_neg]
| -[1+ m] (n : ℕ) := by erw [cast_sub_nat_nat, cast_coe_nat, cast_neg_succ_of_nat,
  sub_eq_iff_eq_add, add_assoc, eq_neg_add_iff_add_eq, ← nat.cast_add, ← nat.cast_add, nat.add_comm]
| -[1+ m] -[1+ n] := show (-[1+ m + n + 1] : R) = _,
  by rw [cast_neg_succ_of_nat, cast_neg_succ_of_nat, cast_neg_succ_of_nat, ← neg_add_rev,
    ← nat.cast_add, nat.add_right_comm m n 1, nat.add_assoc, nat.add_comm]

@[simp, norm_cast] theorem cast_sub (m n) : ((m - n : ℤ) : R) = m - n :=
by simp [int.sub_eq_add_neg, sub_eq_add_neg]

@[simp, norm_cast]
theorem coe_nat_bit0 (n : ℕ) : (↑(bit0 n) : ℤ) = bit0 ↑n := rfl

@[simp, norm_cast]
theorem coe_nat_bit1 (n : ℕ) : (↑(bit1 n) : ℤ) = bit1 ↑n := rfl

@[simp, norm_cast] theorem cast_bit0 (n : ℤ) : ((bit0 n : ℤ) : R) = bit0 n :=
cast_add _ _

@[simp, norm_cast] theorem cast_bit1 (n : ℤ) : ((bit1 n : ℤ) : R) = bit1 n :=
by rw [bit1, cast_add, cast_one, cast_bit0]; refl

lemma cast_two : ((2 : ℤ) : R) = 2 := by simp

lemma cast_three : ((3 : ℤ) : R) = 3 := by simp

lemma cast_four : ((4 : ℤ) : R) = 4 := by simp

end int


import Basics.TypeDefinitions
/-!
## Function Definitions

If all we want is to declare a function, we can use the `def` command.
Going back to the arithmetic expression example from [Typoe Definitions](./TypeDefinitions.lean.md), if we wanted to
implement an eval function in Java, we would probably add it as part of AExp’s
interface and implement it in each subclass. For Add, Sub, Mul, and Div, we would
recursively call eval on the left and right objects.

In Lean, the syntax is very compact. We define a single function and use pattern
matching to distinguish the six cases:
-/
def eval (env: String → Int) : aexp → Int
| (aexp.num i) => i
| (aexp.var x) => env x
| (aexp.add e₁ e₂) => eval env e₁ + eval env e₂
| (aexp.sub e₁ e₂) => eval env e₁ - eval env e₂
| (aexp.mul e₁ e₂) => eval env e₁ * eval env e₂
| (aexp.div e₁ e₂) => eval env e₁ / eval env e₂

/-!
The keyword `def` introduces the definition. The general format of definitions by
pattern matching is:

```lean
def name (params₁ : type₁) . . . (paramsₘ : typeₘ) : type
| patterns₁ := result₁
.
.
.
| patternsₙ := resultₙ
```

The parentheses ( ) around the parameters can also be curly braces { } if we want
to make them implicit arguments. The parameters cannot be subjected to pattern
matching, only the remaining arguments (e.g., the `aexp` argument of `eval`).

Patterns may contain variables, which are then visible in the corresponding
right-hand side, as well as constructors. For example, in the second case in eval’s
definition, the variable `x` can be used in the right-hand side `env x`.

Some definitions do not need pattern matching. For these, the syntax is simply

```lean
def name (params₁ : type₁) . . . (paramsₘ : typeₘ) : type :=
  result
```

We can have pattern matching without recursion (e.g., in the `aexp.num` and `aexp.var` cases above),
and we can have recursion without pattern matching.

The basic arithmetic operations on natural numbers, such as addition, can be
defined by recursion:

-/
def add : Nat → Nat → Nat
| m, Nat.zero => m
| m, (Nat.succ n) => Nat.succ (add m n)
/-!
We pattern-match on two arguments at the same time, distinguishing the case where the second
argument is zero and the case where it is nonzero. Each recursive call to add peels off one `Nat.succ`
constructor from the second argument. Instead of `Nat.zero` and `Nat.succ n`, Lean also allows us to
write `0` and `n + 1` as syntactic sugar.

-/
def add₂ : Nat → Nat → Nat
| m, 0 => m
| m, (n + 1) => (m + n) + 1
/-!
We can evaluate the result of applying add to numbers using `#eval` or `#reduce`:
-/
#eval add 2 7
#reduce add 2 7

/-!
Both commands print 9, as expected. `#eval` employs an optimized interpreter,
whereas `#reduce` uses Lean’s inference kernel, which is less effcient.

Perhaps you are worried about division by zero in the definition of eval above.
Let us see what `#eval` has to say about it:

-/
#eval eval (λ x => 7) (aexp.div (aexp.var "x") (aexp.num 0))
/-!
The output is 0. In Lean, division is conveniently defined as a total function that
returns zero when the denominator is zero. For a lucid explanation of why this is
not dangerous, see [Buzzard’s blog](https://xenaproject.wordpress.com/2020/07/05/division-by-zero-in-type-theory-a-faq/).

It is good practice to provide a few tests each time we define a function, to
ensure that it behaves as expected. You can even leave the `#eval` or `#reduce`
calls in your Lean files as documentation.

The definition of multiplication is similar to that of addition and we can reuse our
`add` function here:
-/
def mul : Nat → Nat → Nat
| _, Nat.zero => Nat.zero
| m, (Nat.succ n) => add m (mul m n)

/-!
The underscore (`_`) stands for an unused variable. We could have put a name (e.g., `m`),
but `_` documents our intentions better.

The #eval command below prints 14, as expected:
-/
#eval mul 2 7
/-!
The power operation (“_m_ to the power of _n_”) can be defined in various ways.
Our first proposal is structurally identical to the definition of multiplication:
-/
def power : Nat → Nat → Nat
| _, Nat.zero => 1
| m, (Nat.succ n) => mul m (power m n)
/-!
Since the first argument, `m`, remains unchanged in the recursive call, `power m n`, we
can factor it out and put it next to the function’s name, as a parameter, before the
colon introducing the type of the function (excluding the parameter `m`):
-/
def power₂ (m : Nat) : Nat → Nat
| Nat.zero => 1
| (Nat.succ n) => mul m (power₂ m n)

#eval power₂ 2 7    -- 128
/-!
Yet another definition is possible by first introducing a general-purpose iterator
that applies a function recursively over the Nat values:
-/
def iter (z : α) (f : α → α) : Nat → α
| Nat.zero => z
| (Nat.succ n) => f (iter z f n)

def power₃ (m n : Nat) : Nat :=
  iter 1 (λ l => m * l) n

#eval power₃ 2 7    -- 128

/-!
Notice that the `power₃` is not recursive since the recursion is done by `iter`.

Recursive functions on lists can be defined in a similar way:
-/
def append (α : Type): List α → List α → List α
| xs, List.nil => xs
| List.nil, ys => ys
| (List.cons x xs), ys => List.cons x (append _ xs ys)

#check append
#eval append _ [3, 1] [4, 1, 5]   -- [3, 1, 4, 1, 5]
/-!
This append function takes three arguments: a type `α` and two lists of type `List α`
and it produces a resulting list of type `List α`.
By passing the placeholder `_`, we leave it to Lean to infer the type α from the type
of the other two arguments.

To make the type argument α implicit, we can put it in curly braces `{ }`
-/
def append₂ {α : Type} : List α → List α → List α
| xs, List.nil => xs
| List.nil, ys => ys
| (List.cons x xs), ys => List.cons x (append₂ xs ys)

#check append₂
#eval append₂ [3, 1] [4, 1, 5]    -- [3, 1, 4, 1, 5]
/-!
The at sign (`@`) can be used to make the implicit arguments explicit.
This is useful for debugging and occasionally necessary to guide Lean’s parser:
-/
#check @append₂
#eval @append₂ _ [3, 1] [4, 1, 5]
/-!
We can use syntactic sugar in the definition, both in the patterns on the left-hand sides of `=>` and in the right-hand sides:
-/
def append₃ {α : Type} : List α → List α → List α
| [], ys => ys
| (x :: xs), ys => x :: append₃ xs ys

#eval append₃ [3, 1] [4, 1, 5]    -- [3, 1, 4, 1, 5]
/-!
In Lean’s standard library, the append function has an infix operator called `++`.
We can use it to define a function that reverses a list:
-/
def reverse {α : Type} : List α → List α
| [] => []
| (x :: xs) => reverse xs ++ [x]

#eval reverse [1,2,3]   -- [3, 2, 1]


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

! This file was ported from Lean 3 source module data.nat.upto
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Order.Basic

/-!
# `nat.upto`

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

`nat.upto p`, with `p` a predicate on `ℕ`, is a subtype of elements `n : ℕ` such that no value
(strictly) below `n` satisfies `p`.

This type has the property that `>` is well-founded when `∃ i, p i`, which allows us to implement
searches on `ℕ`, starting at `0` and with an unknown upper-bound.

It is similar to the well founded relation constructed to define `nat.find` with
the difference that, in `nat.upto p`, `p` does not need to be decidable. In fact,
`nat.find` could be slightly altered to factor decidability out of its
well founded relation and would then fulfill the same purpose as this file.
-/

namespace Nat

#print Nat.Upto /-
/-- The subtype of natural numbers `i` which have the property that
no `j` less than `i` satisfies `p`. This is an initial segment of the
natural numbers, up to and including the first value satisfying `p`.

We will be particularly interested in the case where there exists a value
satisfying `p`, because in this case the `>` relation is well-founded.  -/
@[reducible]
def Upto (p : ℕ → Prop) : Type :=
  { i : ℕ // ∀ j < i, ¬p j }
#align nat.upto Nat.Upto
-/

namespace Upto

variable {p : ℕ → Prop}

#print Nat.Upto.GT /-
/-- Lift the "greater than" relation on natural numbers to `nat.upto`. -/
protected def GT (p) (x y : Upto p) : Prop :=
  x.1 > y.1
#align nat.upto.gt Nat.Upto.GT
-/

instance : LT (Upto p) :=
  ⟨fun x y => x.1 < y.1⟩

#print Nat.Upto.wf /-
/-- The "greater than" relation on `upto p` is well founded if (and only if) there exists a value
satisfying `p`. -/
protected theorem wf : (∃ x, p x) → WellFounded (Upto.GT p)
  | ⟨x, h⟩ =>
    by
    suffices upto.gt p = Measure fun y : Nat.Upto p => x - y.val
      by
      rw [this]
      apply measure_wf
    ext (⟨a, ha⟩⟨b, _⟩)
    dsimp [Measure, InvImage, upto.gt]
    rw [tsub_lt_tsub_iff_left_of_le]
    exact le_of_not_lt fun h' => ha _ h' h
#align nat.upto.wf Nat.Upto.wf
-/

#print Nat.Upto.zero /-
/-- Zero is always a member of `nat.upto p` because it has no predecessors. -/
def zero : Nat.Upto p :=
  ⟨0, fun j h => False.elim (Nat.not_lt_zero _ h)⟩
#align nat.upto.zero Nat.Upto.zero
-/

#print Nat.Upto.succ /-
/-- The successor of `n` is in `nat.upto p` provided that `n` doesn't satisfy `p`. -/
def succ (x : Nat.Upto p) (h : ¬p x.val) : Nat.Upto p :=
  ⟨x.val.succ, fun j h' => by
    rcases Nat.lt_succ_iff_lt_or_eq.1 h' with (h' | rfl) <;> [exact x.2 _ h', exact h]⟩
#align nat.upto.succ Nat.Upto.succ
-/

end Upto

end Nat


import data.real.basic
-- we need to know that the reals are a thing.

/- Let us define some bits about the complex numbers! We shall also use this as an
    oppourtunity to understand what happens when we define a new 'set' of numbers in Lean.
    To define a new set of numbers we need to do some things, these things may be seen as very
    simple or even obvious to us, but we have to remember that Lean doesn't understand anything
    we don't tell it. At the moment it knows nothing about Complex Numbers, it only knows things
    about the reals. -/

/- Firstly we start with what we call a `structure`, this is a way to denote how the number
    shall be written. We let the structure be a type, meaning it is a 'set', by writing:
    `structure complex : Type`. Then we tell Lean how we want the structure of our thing to
    look, in this case we want two real numbers. So we write: `(re: ℝ) (im: ℝ)`, which says as
    we said above, two reals. We call the first `re`, our real part and second, `im`, our
    imaginary part. This corresponds with how we write complex numbers in a more normal way:
    `a + bi`

    NB! To write ℝ in lean, just use \R and press your space bar
-/
structure complex : Type :=
(re : ℝ) (im : ℝ)

/- As Lean knows nothing about the complex numbers, we have to tell it how to denote the set,
    So here we are telling Lean that we notate the set of complexes with ℂ, please carefully
    note that there are backticks around the ℂ, I spent too long trying to work out why my
    notation code wasn't working when I first started Lean. We shall also note that `:=` means
    is defined as.
-/
notation `ℂ` := complex

/- Let us take an example of a complex number, `3 + 4i`, we can write this rather easily in
    a multide of ways.
-/
example : ℂ :=
{ re := 3,
  im := 4 }

-- Or like this:
example : ℂ := complex.mk 3 4

-- or like this:
example : ℂ := ⟨3, 4⟩

-- They all give the same complex number.

namespace complex -- This tells us that what we are doing from here on in is in is about the
                  -- complexes.

/-! # Zero -/

/- Now we need to define what a zero is in this new and rather strange number system, this
    may look a bit odd at first, but I shall talk / walk you through whats going on here -/

-- This says, let us define a zero in the complexes and we define it as the diple `⟨0, 0⟩`,
-- or if you prefer, `complex.mk 0 0`.
def zero : ℂ := ⟨0, 0⟩

-- Now we set up notation so that `0 : ℂ` will mean `zero`.

/- This does something very similar to before and instead of using the command `notation`,
    we define a zero using `has_zero`, which is a typeclass. Basically what this does is it
    allows us to use the `(0 : ℂ)`, which says `0` is a complex.  -/
instance : has_zero ℂ := ⟨zero⟩

/- If I give you the famed `(0 : ℂ)` from the line above, now I ask you to prove that
    following, that the real part of `0` is zero and the complex part of `0` is zero. Obviously
    these are true by definition, or reflexivly true. So we can write `rfl` as the proof, the
    shortened term mode brother of refl. -/

@[simp] lemma zero_re : re(0 : ℂ) = 0 := rfl
@[simp] lemma zero_im : im(0 : ℂ) = 0 := rfl

/- Now for a few exercises or even examples: -/

--C01
example : re( ⟨1, 2⟩ ) = 1 :=
begin
  sorry
end

--C02
example (a b : ℝ) : im( ⟨a + b, b⟩ ) = b :=
begin
  sorry
end

--*C03
/-- For the following example, you will need to `rw` instead the `refl` that you need is
    `add_comm`. Note that Lean does a refl after every `rw` -/
example (a b : ℝ) : re( ⟨a + b, b⟩ ) = b + a :=
begin
  sorry
end

/- # One -/
/- As you probably guessed we needed the zero as a additive identity, so now we need a
    multiplicative identity. We are going to do basically the same thing as we did for zero,
    so less annoying comments this time! -/

/-- The complex number with real part 1 and imaginary part 0 -/
def one : ℂ := ⟨1, 0⟩

/-- Notation `1` for `one` -/
instance : has_one ℂ := ⟨one⟩

-- name the basic properties and tag them with `simp`
@[simp] lemma one_re : re(1 : ℂ) = 1 := begin refl end
@[simp] lemma one_im : im(1 : ℂ) = 0 := begin refl end

/- Before I give you some more examples or exercises let's just quickly define the operations. It
    again works in a very similar way to before when we defined `0` and `1`. -/

/- # Add (+) -/

/- This says take two numbers: `z = a  bi` and `w = u + vi` and then when we add them, just
    add their real parts and then add their imaginary parts and define
    `z + w = (a + u) + (b + v)i` -/
def add (z w : ℂ) : ℂ := ⟨z.re + w.re, z.im + w.im⟩

/-- Notation `+` for addition -/
instance : has_add ℂ := ⟨add⟩

/-- Let us define some more bits that is similar, to above -/
@[simp] lemma add_re (z w : ℂ) : re(z + w) = re(z) + re(w) := begin refl end
@[simp] lemma add_im (z w : ℂ) : im(z + w) = im(z) + im(w) := begin refl end

/- # Negation (-) -/
-- We note as mathematicians, that `a - b = a + -b` and so if we define negation, we then
-- don't have to define subtraction.

/-- The negation `-z` of a complex number `z` -/
def neg (z : ℂ) : ℂ := ⟨-re(z), -im(z)⟩

/-- Notation `-` for negation -/
instance : has_neg ℂ := ⟨neg⟩

-- how neg interacts with re and im
@[simp] lemma neg_re (z : ℂ) : re(-z) = -re(z) := begin refl end
@[simp] lemma neg_im (z : ℂ) : im(-z) = -im(z) := begin refl end

/- ## Multiplication (*) -/

/-- Multiplication `z*w` of two complex numbers -/
def mul (z w : ℂ) : ℂ := ⟨re(z) * re(w) - im(z) * im(w), re(z) * im(w) + im(z) * re(w)⟩

/-- Notation `*` for multiplication -/
instance : has_mul ℂ := ⟨mul⟩

-- how `mul` reacts with `re` and `im`
@[simp] lemma mul_re (z w : ℂ) : re(z * w) = re(z) * re(w) - im(z) * im(w) := begin refl end
@[simp] lemma mul_im (z w : ℂ) : im(z * w) = re(z) * im(w) + im(z) * re(w) := begin refl end

end complex


-- Graham, Knuth, Patashnik
-- Concrete Mathematics

import tactic
import data.real.basic
import data.num.basic

lemma l1 (x y : ℝ) : 0 ≤ x^2-2*x*y + y^2 :=
begin
  have h1 : 0 ≤ (x - y)^2,
  exact pow_two_nonneg (x - y),
  ring SOP at h1,
  ring at h1,
  ring,
  exact h1,
end

example (a b : ℝ) : a ≤ b → 0 ≤ b - a :=
begin
  exact sub_nonneg.mpr,
end

-- CSI, two variable case
-- todo: use sqrt?
theorem csi_two_variable (a1 a2 b1 b2 : ℝ) : (a1*b1 + a2*b2)^2 ≤ (a1^2 + a2^2)*(b1^2 + b2^2) :=
begin
  have h1 := l1 (a1*b2) (a2*b1),
  rw ← sub_nonneg,
  ring SOP at h1,
  ring SOP at h1,
  ring SOP,
  ring SOP,
  ring SOP,
  exact h1,
end


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

open int

/-lifted from tutorial project. I think there's potential to explain and
develop these lemmas and parity in detail, but it could make the tutorial pretty long-/
def odd (n : ℤ) : Prop := ∃ k, n = 2*k + 1

#check int.not_even_iff

theorem not_even_iff_odd (n : ℤ) : ¬ even n ↔ odd n :=
begin
  rw int.not_even_iff,
  split ; intro h,
  use n/2,
  conv_rhs { rw add_comm, congr, rw ← h },
  exact (int.mod_add_div n 2).symm,
  rcases h with ⟨k, rfl⟩,
  simp [add_comm],
  refl,
end

theorem square_even_iff_even (n : ℤ) : even (n^2) ↔ even n :=
begin
  -- sorry
  split,
  { contrapose,
    rw not_even_iff_odd,
    rw not_even_iff_odd,
    rintro ⟨k, rfl⟩,
    use 2*k*(k+1),
    ring },
  { rintro ⟨k, rfl⟩,
    use 2*k^2,
    ring },
  -- sorry
end

def int_divides (a b : ℤ) : Prop := b % a = 0

def rel_prime (a b : ℤ) : Prop :=
    ¬ ∃ k:ℕ, (int_divides k a ∧ int_divides  k b ∧ k>1)

lemma even_imp_square_even (a : ℤ) : even a → even (a^2) :=
begin
unfold even,
rintro ⟨k, h⟩,
use (2*k^2),
rw h,
ring,
end

def rational (n : ℤ) : Prop := ∃ a b : ℤ, (rel_prime a b ∧ a^2 = n*b^2)

--I feel like this exists in mathlib. I'm trying to find it.
lemma div_both_sides {a b k : ℤ} (h : k*a = k*b) (hk : k ≠ 0) : a = b :=
begin
  sorry,
end

--this could probably be cleaner/broken into smaller steps
theorem root_two_not_rational : ¬ rational 2 :=
begin
    rintros ⟨a, b, a_b_rel_prime, h⟩,
    unfold rel_prime at a_b_rel_prime,
    have a_squared_even : even (a^2),
        rw h,
        use b^2,
    have a_even : even a,
        exact (square_even_iff_even a).mp a_squared_even,
    cases a_even with c a_even,
    rw a_even at h,
    have b_squared_even : even (b^2),
        unfold even,
        use c^2,
        rw mul_pow 2 c 2 at h,
        rw pow_succ at h,
        rw mul_assoc 2 (2^1) (c^2) at h,
        have h' := div_both_sides h (by linarith),
        simp at h',
        rw h',
    have b_even : even b,
        exact (square_even_iff_even b).mp b_squared_even,
    apply a_b_rel_prime,
    use 2,
    split,
    unfold int_divides,
    rw a_even,
    simp,
    split,
    rcases b_even with ⟨b_2, b_even⟩,
    rw b_even,
    unfold int_divides,
    simp,
    linarith,
end

--me trying to find lemmas in mathlib
-- example (a b c : ℕ) (h : a*c = b*c) (h' : c ≠ 0) (h'' : a ≠ 0) (h''' : b ≠ 0)
--    : a = b :=
-- begin
--   library_search,
--   sorry,
-- end

example (a b c : ℕ) (h : a = b) : a*c = b*c :=
begin
  exact congr_fun (congr_arg has_mul.mul h) c,
end

example (a b : ℕ) (h : 2*a = 2*b) : a = b :=
begin
  refine eq.symm _,
  sorry,
end

example (a : ℕ) : (2*a)^2 = 2^2 * a^2 :=
begin
  exact nat.mul_pow 2 a 2,
end


/-
This file contains a formal computer proof of O(1/k) convergence of gradient descent with
constant stepsize for convex functions on a real inner-product space. It is
self-contained other than using properties of real and natural numbers defined in mathlib.
I define the properties of convexity and Lipschitz continuous gradient here
and do not rely on the mathlib-defined gradient. This means that a user
would have to ensure that their function is convex and the gradient is correct.
While not ideal, this simplified the proofs.
We closely follow the proof of
http://www.seas.ucla.edu/~vandenbe/236C/lectures/gradient.pdf
-/

import data.real.basic
import analysis.inner_product_space.pi_L2

-- H is an inner product space over the reals
-- It is an abstract type but [inner_product_space ℝ H]
-- ensures it satisfies all the properties of a real inner product space.
-- It is interesting to note that we do not need H
-- to be a Hilbert space. This is because, for
-- nonasymptotic analyses, we do not need the space
-- to be complete as we do not take limits anywhere.
variables {H : Type*} [inner_product_space ℝ H]

-- inner product notation, i.e. scalar product.
notation `⟪`x`, `y`⟫` := @inner ℝ _ _ x y

-- method under study. Note that • means "scalar multiply"
-- i.e. a scalar times a vector.
-- it is written "backslash+smul"
noncomputable def grad_descent
            (η : ℝ) (x0 : H) (gradf : H → H): (ℕ → H)
| 0      := x0
| (n+1)  := grad_descent(n) - η•gradf(grad_descent(n))

-- Definition of a convex function and it's gradient.
def is_convex (f: H → ℝ) (gradf : H → H) : Prop :=
  ∀ (x y : H), f(y) ≥  f(x) + ⟪gradf(x),y-x⟫

-- Definition of Lipschitz-continuous gradient
def is_lip_grad (f: H → ℝ) (gradf : H → H) (L : ℝ) : Prop :=
  ∀ (x y : H), f(y) ≤ f(x) + ⟪gradf(x),y-x⟫ + 0.5*L*∥y-x∥^2

-- some simple helper lemmas
lemma helper_norm_sq_eq_inner (x : H)
        : ∥x∥^2= ⟪x,x⟫_ℝ
        :=
begin
  let h := norm_sq_eq_inner x,
  assumption,
end

lemma helper_inner_neg (x y:H)
        : ⟪x,-y⟫ = -⟪x,y⟫
        :=
begin
  exact inner_neg_right,
end

-- A basic descent lemma for gradient descent
lemma basic_grad_step (x : H) (η L : ℝ) (f : H → ℝ) (gradf : H → H)
                      (hlip : is_lip_grad f gradf L)
                      :
  f(x-η•gradf x) ≤ f(x) - η*(1-L*η/2)*∥gradf x∥^2
  :=
begin
  have HLip := hlip x (x-η•gradf x),

  have h : x - η • gradf x - x = x - x - η • gradf x := by abel,
  rw h at HLip, clear h,
  rw sub_self at HLip,
  rw zero_sub at HLip,

  rw inner_neg_right at HLip,
  rw real_inner_smul_right at HLip,

  have h1 := helper_norm_sq_eq_inner (gradf x),
  rw ← h1 at HLip,

  rw norm_neg at HLip,

  have h : ∥η • gradf x∥ = |η|*∥gradf x ∥  :=  norm_smul η (gradf x),
  rw h at HLip, clear h,

  rw mul_pow at HLip,

  have h : |η| ^ 2 = η^2 := sq_abs η,
  rw h at HLip, clear h,

  rw mul_sub,
  rw mul_one,
  rw sub_mul,
  rw ← sub_add,

  have h : 1 / 2 * L * (η ^ 2 * ∥gradf x∥ ^ 2)
          = η * (L * η / 2) * ∥gradf x∥ ^ 2 := by ring,
  rw h at HLip, clear h,
  exact HLip,

end

-- an algebraic manipulation lemma
lemma complete_square (x y : H) (t : ℝ) (ht : t > 0):
  ⟪x,y⟫ - (t/2)*∥y∥^2 = (1/(2*t))*(∥x∥^2 - ∥x-t•y∥^2)
  :=
begin
  rw norm_sub_sq_real,
  have h0 : ∥x∥ ^ 2 - (∥x∥ ^ 2 - 2 * inner x (t • y) + ∥t • y∥ ^ 2)
          = ∥x∥ ^ 2 - ∥x∥ ^ 2 + 2 * inner x (t • y) - ∥t • y∥ ^ 2
          := by abel,
  simp at h0,
  rw h0,
  rw inner_smul_right,
  rw norm_smul,
  have h1 : ∥t∥ = |t| := real.norm_eq_abs t,
  rw h1,
  have h2 : |t| = t := abs_of_pos ht,
  rw h2,
  rw mul_sub,
  have h3 : 1 / (2 * t) * (2 * (t * inner x y)) =
            (1 / (2 * t)) * 2 * t * inner x y
            := by ring,
  rw h3,
  have h4 : 1 / (2 * t) * 2 * t =  2 / (2 * t) * t
        := by ring,
  rw h4,
  have h5 : 2 / (2 * t) * t = (2*t) / (2 * t)
        := by ring,
  rw h5,

  have h6 : (2:ℝ)≠ 0:=by norm_num,
  have h7 : t ≠ 0 := ne_of_gt ht,
  have h8 : 2*t ≠ 0 := mul_ne_zero h6 h7,

  have h8 : (2*t) / (2 * t) = 1 := div_self h8,

  rw h8,
  rw one_mul,

  have h9 : (t * ∥y∥) ^ 2  = t^ 2 * ∥y∥ ^ 2
          := mul_pow t (∥y∥) 2,
  rw h9,

  have h10 : 1 / (2 * t) * (t ^ 2 * ∥y∥ ^ 2)
          = t ^ 2 / (2 * t) * ∥y∥ ^ 2
          := by ring,

  rw h10,

  rw mul_comm 2 t,

  have h11 : t^2 / (t * 2) = (t ^ 2 / t) / 2
    := (div_div_eq_div_mul (t^2) t 2).symm,
  rw h11,

  rw sq t,
  have h12 : t * t / t = t*(t/t):=by ring,
  rw h12,
  rw div_self h7,
  rw mul_one,

end

-- a stepsize technicality
lemma stepsz_upper (t L : ℝ) (hL : L ≥ 0) (h : t≤1/L): t*L ≤ 1 :=
begin

  cases lt_or_ge 0 L,

  exact (le_div_iff h_1).mp h,

  have h2 : L=0 := by linarith,
  rw h2,
  linarith,

end

-- further refinement of the descent properties of the algorithm
lemma basic_grad_step_v2 (x : H) (η L : ℝ) (f : H → ℝ) (gradf : H → H)
                    (hL : L ≥ 0)
                    (hη_low : η ≥ 0)
                    (hη2 : η ≤ 1/L)
                    (hlip : is_lip_grad f gradf L)
                    :
  f(x-η•gradf x) ≤ f(x) -(η/2)*∥gradf x∥^2
:=
begin
  have h := basic_grad_step x η L f gradf hlip,
  rw mul_sub at h,
  rw mul_one at h,
  rw sub_mul at h,
  rw ← sub_add at h,

  have h1 := stepsz_upper η L hL hη2,
  rw mul_comm L _ at h,

  have h2 :  2 > 0 := by norm_num,
  have h3 : η * L /2 ≤ 1 /2 := by nlinarith,
  have h4 : η*(η * L /2)≤ η*1/2 := by nlinarith,
  clear h3,

  have h4 : 0 ≤ ∥gradf x∥ ^ 2  := by exact sq_nonneg (∥gradf x∥),
  have h5 : ∥gradf x∥ ^ 2 ≥ 0 := by linarith, clear h4,

  have h6 : η*(η * L /2)*∥gradf x∥ ^ 2 ≤ (η*1/2)*∥gradf x∥ ^ 2
          := by nlinarith,

  clear h4, clear h5,

  have h7 : f (x - η • gradf x)
            ≤ f x - η * ∥gradf x∥ ^ 2 + (η*1/2)*∥gradf x∥ ^ 2
          := by linarith,
  clear h, clear h6,

  rw mul_one at h7,

  rw sub_add at h7,

  rw ← sub_mul at h7,

  have h : η - η / 2 = η/2 := by linarith,
  rw h at h7,
  exact h7,
end

-- formally stating that the algorithm decreases function values
lemma descent (x : H) (η L : ℝ) (f : H → ℝ) (gradf : H → H)
                      (hL : L ≥ 0)
                      (hη_low : η ≥ 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      :
    f(x-η•gradf x) ≤ f(x)
  :=
begin
  have h := basic_grad_step_v2 x η L f gradf hL hη_low hη2 hlip,

  have h2 : 2>0:=by norm_num,
  have h3 : η/2≥0:= by nlinarith,
  have h4 : 0 ≤ ∥gradf x∥ ^ 2  := by exact sq_nonneg (∥gradf x∥),
  have h5 : ∥gradf x∥ ^ 2 ≥ 0 := by linarith, clear h4,

  have h6 : η / 2 * ∥gradf x∥ ^ 2 ≥ 0 := by nlinarith,

  linarith,
end

lemma prepare_to_telescope (x y: H) (η L : ℝ) (f : H → ℝ) (gradf : H → H)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    f(x-η•gradf x) - f y ≤ (1/(2*η))*(∥x-y∥^2 - ∥x-η•gradf x - y∥^2)
    :=
begin
  have hη_low2 : η ≥ 0 := by linarith,
  have h1 := basic_grad_step_v2  x η L f gradf hL hη_low2 hη2 hlip,

  have h2 :  f (x - η • gradf x) -f y ≤ f x - f y - η / 2 * ∥gradf x ∥^ 2
    := by linarith,

  have h3 := hconv x y,

  have h4 : f x-f y ≤  - inner (gradf x) (y - x) := by linarith,

  have h5 := helper_inner_neg (gradf x) (y - x),
  clear h3,
  rw ← h5 at h4, clear h5,
  have h5 : -(y-x)=x-y:=by abel,
  rw h5 at h4, clear h5,

  have h5 : f(x - η • gradf x) - f y ≤ ⟪gradf x,x-y⟫ - η / 2 * ∥gradf x∥ ^ 2
    := by linarith,
  clear h2,clear h4,clear h1,

  rw real_inner_comm at h5,

  have h2 := complete_square (x-y) (gradf x)  η hη_low,
  rw h2 at h5,

  have h4 : x - y - η • gradf x = x - η • gradf x - y := sub_right_comm x y (η • gradf x),

  rw h4 at h5,
  exact h5,

end

-- rewrite the telescoping more favorably
lemma prepare_to_telescope2 (x0 y: H) (n : ℕ) (η L : ℝ) (f : H → ℝ) (gradf : H → H)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    f(grad_descent η x0 gradf (n+1)) - f y ≤
    (1/(2*η))*(∥grad_descent η x0 gradf n-y∥^2 - ∥grad_descent η x0 gradf (n+1) - y∥^2)
    :=
begin
  have h1 : grad_descent η x0 gradf (n+1) =
            grad_descent η x0 gradf (n) - η•gradf(grad_descent η x0 gradf (n))
          := by simp [grad_descent],

  rw h1,
  clear h1,
  exact prepare_to_telescope (grad_descent η x0 gradf (n)) y η L f gradf hL hη_low hη2 hlip hconv,

end

-- sum_f is just the sum of function values evaluated at the points
-- generated by the algorithm (again defined recursively)
noncomputable def sum_f (y x0 : H) (f : H → ℝ) (η : ℝ) (gradf : H → H): (ℕ → ℝ)
| 0      := 0
| (n+1)  := sum_f(n) + f(grad_descent η x0 gradf (n+1)) - f y

-- the all important telescoping result
lemma telescope (x0 y: H) (n : ℕ) (η L : ℝ) (f : H → ℝ) (gradf : H → H)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    sum_f y x0 f η gradf (n) ≤ (1/(2*η))*(∥x0-y∥^2 - ∥grad_descent η x0 gradf n  - y∥^2)
    :=
begin
  induction n with k hk,
  have h1 : grad_descent η x0 gradf 0 = x0 := by refl,
  rw h1,

  have h2 : 1 / (2 * η) * (∥x0 - y∥ ^ 2 - ∥x0 - y∥ ^ 2) = 0 := by linarith,
  rw h2,
  refl,

  have h : sum_f y x0 f η gradf k.succ = sum_f y x0 f η gradf k +
       f(grad_descent η x0 gradf (k+1)) - f y := by simp [sum_f],
  rw h, clear h,

  have h := prepare_to_telescope2 x0 y k η L f gradf hL hη_low hη2 hlip hconv,
  linarith,

end

-- a simple upper bound derived from telescoping
lemma from_telescope (x0 y: H) (n : ℕ) (η L : ℝ) (f : H → ℝ) (gradf : H → H)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    sum_f y x0 f η gradf (n) ≤ (1/(2*η))*∥x0-y∥^2
    :=
begin
  have h := telescope x0 y n η L f gradf hL hη_low hη2 hlip hconv,

  have h1 : ∥grad_descent η x0 gradf n - y∥ ^ 2 ≥ 0
    := sq_nonneg (∥grad_descent η x0 gradf n - y∥),

  rw mul_sub at h,
  have h2 : 2 > 0 := by norm_num,
  have h3 : 2*η > 0 := by nlinarith,
  have h5 : 1 / (2*η) >0 := one_div_pos.mpr h3,

  have h6 :  1 / (2 * η) * ∥grad_descent η x0 gradf n - y∥ ^ 2 ≥ 0
    := by nlinarith,
  linarith,

end

-- since func values are decreasing, the sum of func vals provides
-- a bound on the last function value as follows
lemma last_less_than_av (x0 y: H) (n : ℕ) (η L : ℝ) (f : H → ℝ) (gradf : H → H)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    sum_f y x0 f η gradf (n) ≥ n*(f(grad_descent η x0 gradf n) - f y)
    :=
begin
  induction n with k hk,

  have h : ↑0 = (0:ℝ):= nat.cast_zero,
  rw h,
  rw zero_mul,
  have h1 : sum_f y x0 f η gradf 0 = 0 := by refl,
  rw h1,
  exact rfl.ge,

  have h2 : sum_f y x0 f η gradf k.succ = sum_f y x0 f η gradf (k) + f(grad_descent η x0 gradf (k+1)) - f y
    := by simp [sum_f],

  rw h2,

  rw nat.succ_eq_add_one,
  have h3 : ↑(k+1) = (k+1 : ℝ):= nat.cast_succ k,
  rw h3,
  have h4 : (↑k + 1) * (f (grad_descent η x0 gradf (k + 1)) - f y)
            = ↑k*(f (grad_descent η x0 gradf (k + 1)) - f y)
              + f (grad_descent η x0 gradf (k + 1)) - f y
          := by linarith,
  rw h4,

  have hη_low2 : η ≥ 0 := by linarith,

  have hdesc := descent (grad_descent η x0 gradf k) η L f gradf hL hη_low2 hη2 hlip,

  have h5 : grad_descent η x0 gradf (k+1) =
        grad_descent η x0 gradf k - η • gradf (grad_descent η x0 gradf k)
    := by simp [grad_descent],

  rw ← h5 at hdesc,

  have h6 : ↑k * f (grad_descent η x0 gradf (k + 1)) ≤ ↑k * f (grad_descent η x0 gradf k),
  {
    have hupk : (0:ℝ) ≤ (↑k)  := nat.cast_nonneg k,

    exact mul_le_mul_of_nonneg_left hdesc hupk,

  },

  linarith,
end

-- Main convergence rate result
-- Note that y is an arbitrary point but it is customarily taken to
-- be one of the minimizers (assuming minimizers exist)
theorem grad_descent_convergence_rate (n : ℕ) (η L : ℝ) (x0 y : H) (f : H → ℝ) (gradf : H → H)
                        (hn : n ≥ 1)
                        (hη_low : η > 0)
                        (hη_up : η ≤ 1/L)
                        (hL : L ≥ 0)
                        (hconv : is_convex f gradf)
                        (hlip : is_lip_grad f gradf L)
                        :
      f(grad_descent η x0 gradf n) - f(y)≤ (1/(2*η*n))*∥x0-y∥^2
   :=
begin
  have h0 := from_telescope x0 y n η L f gradf hL hη_low hη_up hlip hconv,
  have h1 := last_less_than_av x0 y n η L f gradf hL hη_low hη_up hlip hconv,

  have h2 : ↑n * (f (grad_descent η x0 gradf n) - f y) ≤ 1 / (2 * η) * ∥x0 - y∥ ^ 2
   := by linarith,

  have h3 :  (f (grad_descent η x0 gradf n) - f y) ≤ 1 / (2 * η) * ∥x0 - y∥ ^ 2 / ↑n,
  {
    have h4 : ↑n≥ (1:ℝ) := nat.one_le_cast.mpr hn,

    have h5 : ↑n > (0:ℝ) := by linarith,

    exact (le_div_iff' h5).mpr h2,
  },
  clear h2,

  have h6 : 1 / (2 * η) * ∥x0 - y∥ ^ 2 / ↑n = (1/↑n)*1 / (2 * η) * ∥x0 - y∥ ^ 2
    := by ring,

  have h7 : (1/↑n)*1 / (2 * η)
            = 1 / (2 * η * ↑n),
  {
    ring_nf,
    exact mul_inv₀.symm,
  },
  rw h6 at h3,
  rw h7 at h3,
  exact h3,

end


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

This is about "gappy sets", ie subsets s in fin n = {0,...,n-1}
such that s contains no adjacent pairs {i,i+1}.  We define
`(gappy n)` to be the set of such subsets.

A key point is that there is a bijection
`(gappy n) ⊕ (gappy n + 1) ≃ (gappy n + 2)`, which we define as
`(gappy_equiv n)`.  From this it follows inductively that the
cardinality of `(gappy n)` is the (n + 2)nd Fibonacci number.

-/

import data.fintype.basic
import combinatorics.fibonacci combinatorics.shift

namespace combinatorics

/- We find it convenient to introduce a new notation for
   the zero element in fin m.  Notice that this only exists
   when m > 0, or equivalently, when m has the form
   n.succ = n + 1 for some n.
-/
def fin.z {n : ℕ} : fin (n.succ) := 0

lemma fin.z_val {n : ℕ} : (@fin.z n).val = 0 := rfl

lemma fin.succ_ne_z {n : ℕ} (i : fin n) : i.succ ≠ fin.z :=
begin
 cases i with i i_is_lt,
 intro e,
 cases e
end

/- Definition of gappiness -/
def is_gappy : ∀ {n : ℕ} (s : finset (fin n)), Prop
| 0 _ := true
| (nat.succ n) s := ∀ a : fin n, ¬ (a.cast_succ ∈ s ∧ a.succ ∈ s)

instance is_gappy_decidable :
 forall {n : ℕ} (s : finset (fin n)), decidable (is_gappy s)
| 0 _ := by {dsimp[is_gappy],apply_instance}
| (nat.succ n) s := by {dsimp[is_gappy],apply_instance}

def gappy' (n : ℕ) : finset (finset (fin n)) :=
 finset.univ.filter is_gappy

def gappy (n : ℕ) : Type :=
 { s : finset (fin n) // is_gappy s }

instance {n : ℕ} : fintype (gappy n) :=
 by { dsimp[gappy], apply_instance }

instance {n : ℕ} : decidable_eq (gappy n) :=
 by { dsimp[gappy], apply_instance }

instance {n : ℕ} : has_coe (gappy n) (finset (fin n)) :=
 by { dsimp[gappy], apply_instance }

lemma gappy_spec {n : ℕ} (s : gappy n) : is_gappy (s : finset (fin n)) := s.property

/- How to generate a string describing a gappy set -/
instance {n : ℕ} : has_repr (gappy n) :=
 ⟨λ (s : gappy n), repr s.val⟩

/- Some lemmas about (un)shifting and gappiness -/

lemma shift_gappy : ∀ {n : ℕ} {s : finset (fin n)},
 is_gappy s → is_gappy (shift s)
| 0 _ _ := λ a, fin.elim0 a
| (nat.succ n) s s_gappy := begin
 rintros a ⟨a_in_shift,a_succ_in_shift⟩,
 let a_in_s : a ∈ s := (succ_mem_shift_iff s a).mp a_succ_in_shift,
 rcases (mem_shift s a.cast_succ).mp a_in_shift with ⟨b,⟨b_in_s,eb⟩⟩,
 replace eb := congr_arg (coe : (fin _) → ℕ) eb,
 rw[fin.coe_succ,fin.coe_cast_succ] at eb,
 have a_is_lt : (a : ℕ) < n.succ := a.property,
 rw[← eb] at a_is_lt,
 let c_is_lt : (b : ℕ) < n := nat.lt_of_succ_lt_succ a_is_lt,
 let c : fin n := ⟨b,c_is_lt⟩,
 have ebc : b = fin.cast_succ c := fin.ext (by { rw[fin.coe_cast_succ], refl } ),
 have eac : a = fin.succ c := fin.ext (nat.succ_inj'.mp (by { rw[← eb,fin.coe_succ], refl })),
 rw[ebc] at b_in_s,
 rw[eac] at a_in_s,
 exact s_gappy c ⟨b_in_s,a_in_s⟩,
end

lemma unshift_gappy : ∀ {n : ℕ} {s : finset (fin n.succ)},
 is_gappy s → is_gappy (unshift s)
| 0 _ _ := trivial
| (nat.succ n) s s_gappy := begin
 rintros a ⟨a_in_unshift,a_succ_in_unshift⟩,
 let a_succ_in_s := (mem_unshift s a.cast_succ).mp a_in_unshift,
 let a_succ_succ_in_s := (mem_unshift s a.succ).mp a_succ_in_unshift,
 have e : a.cast_succ.succ = a.succ.cast_succ :=
  fin.ext
   (by { rw[fin.coe_succ,fin.coe_cast_succ,fin.coe_cast_succ,fin.coe_succ]}),
 rw[e] at a_succ_in_s,
 exact s_gappy a.succ ⟨a_succ_in_s,a_succ_succ_in_s⟩,
end

lemma insert_gappy : ∀ {n : ℕ} {s : finset (fin n.succ.succ)},
 is_gappy s → (∀ (a : fin n.succ.succ), a ∈ s → a.val ≥ 2) →
  is_gappy (insert (0 : fin _) s) :=
begin
 rintros n s s_gappy s_big a ⟨a_in_t,a_succ_in_t⟩,
 rcases finset.mem_insert.mp a_succ_in_t with a_succ_zero | a_succ_in_s,
 {exact fin.succ_ne_z a a_succ_zero},
 have a_pos₀ : (a.succ : ℕ) ≥ 2 := (s_big a.succ a_succ_in_s),
 rw[fin.coe_succ] at a_pos₀,
 let a_pos : 0 < (a : ℕ) := nat.lt_of_succ_lt_succ a_pos₀,
 rcases finset.mem_insert.mp a_in_t with a_zero | a_in_s,
 {replace a_zero : (a : ℕ) = 0 :=
  (fin.coe_cast_succ a).symm.trans (congr_arg coe a_zero),
  rw[a_zero] at a_pos,
  exact lt_irrefl 0 a_pos,
 },{
  exact s_gappy a ⟨a_in_s,a_succ_in_s⟩,
 }
end

def i {n : ℕ} (s : gappy n) : gappy n.succ :=
 ⟨shift s.val,shift_gappy s.property⟩

lemma i_val {n : ℕ} (s : gappy n) : (i s).val = shift s.val := rfl

lemma zero_not_in_i {n : ℕ} (s : gappy n) : (0 : fin _) ∉ ((i s) : finset (fin n.succ)) :=
 zero_not_mem_shift s.val

lemma shift_big {n : ℕ} (s : finset (fin n)) :
 ∀ (a : fin n.succ.succ), a ∈ shift (shift s) → (a : ℕ) ≥ 2 :=
begin
 intros a ma,
 rcases (mem_shift (shift s) a).mp ma with ⟨b,⟨mb,eb⟩⟩,
 rcases (mem_shift s b).mp mb with ⟨c,⟨mc,ec⟩⟩,
 rw[← eb,← ec,fin.coe_succ,fin.coe_succ],
 apply nat.succ_le_succ,
 apply nat.succ_le_succ,
 exact nat.zero_le c.val,
end

def j {n : ℕ} (s : gappy n) : gappy n.succ.succ :=
 ⟨insert (0 : fin _) (shift (shift s.val)),
  begin
   let h := insert_gappy (shift_gappy (shift_gappy s.property)) (shift_big s.val),
   exact h,
  end⟩

lemma j_val {n : ℕ} (s : gappy n) :
 (j s).val = insert (0 : fin _) (shift (shift s.val)) := rfl

lemma zero_in_j {n : ℕ} (s : gappy n) : (0 : fin _) ∈ (j s : finset (fin n.succ.succ)) :=
 finset.mem_insert_self _ _

def p {n : ℕ} : (gappy n) ⊕ (gappy n.succ) → gappy n.succ.succ
| (sum.inl s) := j s
| (sum.inr s) := i s

def q {n : ℕ} (s : gappy n.succ.succ) : (gappy n) ⊕ (gappy n.succ) :=
if (0 : fin _) ∈ s.val then
 sum.inl ⟨unshift (unshift s.val),unshift_gappy (unshift_gappy s.property)⟩
else
 sum.inr ⟨unshift s.val,unshift_gappy s.property⟩

lemma qp {n : ℕ} (s : (gappy n) ⊕ (gappy n.succ)) : q (p s) = s :=
begin
 rcases s with s | s; dsimp[p,q],
 {rw[if_pos (zero_in_j s)],congr,apply subtype.eq,
  change unshift (unshift (j s).val) = s.val,
  rw[j_val,unshift_insert,unshift_shift,unshift_shift],
 },
 {rw[if_neg (zero_not_in_i s)],congr,apply subtype.eq,
  change unshift (i s).val = s.val,
  rw[i_val,unshift_shift],
 }
end

lemma pq {n : ℕ} (s : gappy n.succ.succ) : p (q s) = s :=
begin
 dsimp[q],split_ifs; dsimp[p]; apply subtype.eq,
 {rw[j_val],
  change insert (0 : fin _) (shift (shift (unshift (unshift s.val )))) = s.val,
  have z_not_in_us : (0 : fin _) ∉ unshift s.val := begin
   intro z_in_us,
   let z_succ_in_s := (mem_unshift s.val (0 : fin _)).mp z_in_us,
   exact s.property (0 : fin _) ⟨h,z_succ_in_s⟩,
  end,
  rw[shift_unshift0 (unshift s.val) z_not_in_us],
  rw[shift_unshift1 s.val h],
 },{
  rw[i_val],
  change shift (unshift s.val) = s.val,
  exact shift_unshift0 s.val h,
 }
end

def gappy_equiv {n : ℕ} :
 ((gappy n) ⊕ (gappy n.succ)) ≃ (gappy n.succ.succ) := {
 to_fun := p,
 inv_fun := q,
 left_inv := qp,
 right_inv := pq
}

lemma gappy_card_step (n : ℕ) :
 fintype.card (gappy n.succ.succ) =
  fintype.card (gappy n) + fintype.card (gappy n.succ) :=
begin
 let e0 := fintype.card_congr (@gappy_equiv n),
 rw[fintype.card_sum] at e0,
 exact e0.symm
end

lemma gappy_card : ∀ (n : ℕ), fintype.card (gappy n) = fibonacci n.succ.succ
| 0 := rfl
| 1 := rfl
| (nat.succ (nat.succ n)) := begin
 rw[gappy_card_step n,gappy_card n,gappy_card n.succ],
 dsimp[fibonacci],refl,
end

end combinatorics


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

! This file was ported from Lean 3 source module analysis.normed_space.star.exponential
! leanprover-community/mathlib commit 1e3201306d4d9eb1fd54c60d7c4510ad5126f6f9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.Exponential

/-! # The exponential map from selfadjoint to unitary
In this file, we establish various propreties related to the map `λ a, exp ℂ A (I • a)` between the
subtypes `self_adjoint A` and `unitary A`.

## TODO

* Show that any exponential unitary is path-connected in `unitary A` to `1 : unitary A`.
* Prove any unitary whose distance to `1 : unitary A` is less than `1` can be expressed as an
  exponential unitary.
* A unitary is in the path component of `1` if and only if it is a finite product of exponential
  unitaries.
-/

section Star

variable {A : Type _} [NormedRing A] [NormedAlgebra ℂ A] [StarRing A] [ContinuousStar A]
  [CompleteSpace A] [StarModule ℂ A]

open Complex

/-- The map from the selfadjoint real subspace to the unitary group. This map only makes sense
over ℂ. -/
@[simps]
noncomputable def selfAdjoint.expUnitary (a : selfAdjoint A) : unitary A :=
  ⟨exp ℂ (I • a), exp_mem_unitary_of_mem_skewAdjoint _ (a.Prop.smul_mem_skewAdjoint conj_I)⟩
#align self_adjoint.exp_unitary selfAdjoint.expUnitary

open selfAdjoint

theorem Commute.expUnitary_add {a b : selfAdjoint A} (h : Commute (a : A) (b : A)) :
    expUnitary (a + b) = expUnitary a * expUnitary b :=
  by
  ext
  have hcomm : Commute (I • (a : A)) (I • (b : A))
  calc
    _ = _ := by simp only [h.eq, Algebra.smul_mul_assoc, Algebra.mul_smul_comm]

  simpa only [exp_unitary_coe, AddSubgroup.coe_add, smul_add] using exp_add_of_commute hcomm
#align commute.exp_unitary_add Commute.expUnitary_add

theorem Commute.expUnitary {a b : selfAdjoint A} (h : Commute (a : A) (b : A)) :
    Commute (expUnitary a) (expUnitary b) :=
  calc
    expUnitary a * expUnitary b = expUnitary b * expUnitary a := by
      rw [← h.exp_unitary_add, ← h.symm.exp_unitary_add, add_comm]

#align commute.exp_unitary Commute.expUnitary

end Star


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Neil Strickland
-/
import data.pnat.defs
import data.nat.bits
import data.nat.order.basic
import data.set.basic
import algebra.group_with_zero.divisibility
import algebra.order.positive.ring

/-!
# The positive natural numbers

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

This file develops the type `ℕ+` or `pnat`, the subtype of natural numbers that are positive.
It is defined in `data.pnat.defs`, but most of the development is deferred to here so
that `data.pnat.defs` can have very few imports.
-/

attribute [derive [add_left_cancel_semigroup, add_right_cancel_semigroup, add_comm_semigroup,
  linear_ordered_cancel_comm_monoid, has_add, has_mul, distrib]] pnat

namespace pnat

instance : is_well_order ℕ+ (<) := { }

@[simp] lemma one_add_nat_pred (n : ℕ+) : 1 + n.nat_pred = n :=
by rw [nat_pred, add_tsub_cancel_iff_le.mpr $ show 1 ≤ (n : ℕ), from n.2]

@[simp] lemma nat_pred_add_one (n : ℕ+) : n.nat_pred + 1 = n :=
(add_comm _ _).trans n.one_add_nat_pred

@[mono] lemma nat_pred_strict_mono : strict_mono nat_pred := λ m n h, nat.pred_lt_pred m.2.ne' h
@[mono] lemma nat_pred_monotone : monotone nat_pred := nat_pred_strict_mono.monotone
lemma nat_pred_injective : function.injective nat_pred := nat_pred_strict_mono.injective

@[simp] lemma nat_pred_lt_nat_pred {m n : ℕ+} : m.nat_pred < n.nat_pred ↔ m < n :=
nat_pred_strict_mono.lt_iff_lt

@[simp] lemma nat_pred_le_nat_pred {m n : ℕ+} : m.nat_pred ≤ n.nat_pred ↔ m ≤ n :=
nat_pred_strict_mono.le_iff_le

@[simp] lemma nat_pred_inj {m n : ℕ+} : m.nat_pred = n.nat_pred ↔ m = n := nat_pred_injective.eq_iff

end pnat

namespace nat

@[mono] theorem succ_pnat_strict_mono : strict_mono succ_pnat := λ m n, nat.succ_lt_succ

@[mono] theorem succ_pnat_mono : monotone succ_pnat := succ_pnat_strict_mono.monotone

@[simp] theorem succ_pnat_lt_succ_pnat {m n : ℕ} : m.succ_pnat < n.succ_pnat ↔ m < n :=
succ_pnat_strict_mono.lt_iff_lt

@[simp] theorem succ_pnat_le_succ_pnat {m n : ℕ} : m.succ_pnat ≤ n.succ_pnat ↔ m ≤ n :=
succ_pnat_strict_mono.le_iff_le

theorem succ_pnat_injective : function.injective succ_pnat := succ_pnat_strict_mono.injective

@[simp] theorem succ_pnat_inj {n m : ℕ} : succ_pnat n = succ_pnat m ↔ n = m :=
succ_pnat_injective.eq_iff

end nat

namespace pnat

open nat

/-- We now define a long list of structures on ℕ+ induced by
 similar structures on ℕ. Most of these behave in a completely
 obvious way, but there are a few things to be said about
 subtraction, division and powers.
-/

@[simp, norm_cast] lemma coe_inj {m n : ℕ+} : (m : ℕ) = n ↔ m = n := set_coe.ext_iff

@[simp, norm_cast] theorem add_coe (m n : ℕ+) : ((m + n : ℕ+) : ℕ) = m + n := rfl

/-- `pnat.coe` promoted to an `add_hom`, that is, a morphism which preserves addition. -/
def coe_add_hom : add_hom ℕ+ ℕ :=
{ to_fun := coe,
  map_add' := add_coe }

instance : covariant_class ℕ+ ℕ+ (+) (≤) := positive.covariant_class_add_le
instance : covariant_class ℕ+ ℕ+ (+) (<) := positive.covariant_class_add_lt
instance : contravariant_class ℕ+ ℕ+ (+) (≤) := positive.contravariant_class_add_le
instance : contravariant_class ℕ+ ℕ+ (+) (<) := positive.contravariant_class_add_lt

/-- An equivalence between `ℕ+` and `ℕ` given by `pnat.nat_pred` and `nat.succ_pnat`. -/
@[simps { fully_applied := ff }] def _root_.equiv.pnat_equiv_nat : ℕ+ ≃ ℕ :=
{ to_fun := pnat.nat_pred,
  inv_fun := nat.succ_pnat,
  left_inv := succ_pnat_nat_pred,
  right_inv := nat.nat_pred_succ_pnat }

/-- The order isomorphism between ℕ and ℕ+ given by `succ`. -/
@[simps apply { fully_applied := ff }] def _root_.order_iso.pnat_iso_nat : ℕ+ ≃o ℕ :=
{ to_equiv := equiv.pnat_equiv_nat,
  map_rel_iff' := λ _ _, nat_pred_le_nat_pred }

@[simp] lemma _root_.order_iso.pnat_iso_nat_symm_apply :
  ⇑order_iso.pnat_iso_nat.symm = nat.succ_pnat := rfl

theorem lt_add_one_iff : ∀ {a b : ℕ+}, a < b + 1 ↔ a ≤ b :=
λ a b, nat.lt_add_one_iff

theorem add_one_le_iff : ∀ {a b : ℕ+}, a + 1 ≤ b ↔ a < b :=
λ a b, nat.add_one_le_iff

instance : order_bot ℕ+ :=
{ bot := 1,
  bot_le := λ a, a.property }

@[simp] lemma bot_eq_one : (⊥ : ℕ+) = 1 := rfl

-- Some lemmas that rewrite `pnat.mk n h`, for `n` an explicit numeral, into explicit numerals.
@[simp] lemma mk_bit0 (n) {h} : (⟨bit0 n, h⟩ : ℕ+) = (bit0 ⟨n, pos_of_bit0_pos h⟩ : ℕ+) := rfl
@[simp] lemma mk_bit1 (n) {h} {k} : (⟨bit1 n, h⟩ : ℕ+) = (bit1 ⟨n, k⟩ : ℕ+) := rfl

-- Some lemmas that rewrite inequalities between explicit numerals in `ℕ+`
-- into the corresponding inequalities in `ℕ`.
-- TODO: perhaps this should not be attempted by `simp`,
-- and instead we should expect `norm_num` to take care of these directly?
-- TODO: these lemmas are perhaps incomplete:
-- * 1 is not represented as a bit0 or bit1
-- * strict inequalities?
@[simp] lemma bit0_le_bit0 (n m : ℕ+) : (bit0 n) ≤ (bit0 m) ↔ (bit0 (n : ℕ)) ≤ (bit0 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit0_le_bit1 (n m : ℕ+) : (bit0 n) ≤ (bit1 m) ↔ (bit0 (n : ℕ)) ≤ (bit1 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit1_le_bit0 (n m : ℕ+) : (bit1 n) ≤ (bit0 m) ↔ (bit1 (n : ℕ)) ≤ (bit0 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit1_le_bit1 (n m : ℕ+) : (bit1 n) ≤ (bit1 m) ↔ (bit1 (n : ℕ)) ≤ (bit1 (m : ℕ)) :=
iff.rfl

@[simp, norm_cast] theorem mul_coe (m n : ℕ+) : ((m * n : ℕ+) : ℕ) = m * n := rfl

/-- `pnat.coe` promoted to a `monoid_hom`. -/
def coe_monoid_hom : ℕ+ →* ℕ :=
{ to_fun := coe,
  map_one' := one_coe,
  map_mul' := mul_coe }

@[simp] lemma coe_coe_monoid_hom : (coe_monoid_hom : ℕ+ → ℕ) = coe := rfl

@[simp] lemma le_one_iff {n : ℕ+} : n ≤ 1 ↔ n = 1 := le_bot_iff

lemma lt_add_left (n m : ℕ+) : n < m + n := lt_add_of_pos_left _ m.2

lemma lt_add_right (n m : ℕ+) : n < n + m := (lt_add_left n m).trans_eq (add_comm _ _)

@[simp, norm_cast] lemma coe_bit0 (a : ℕ+) : ((bit0 a : ℕ+) : ℕ) = bit0 (a : ℕ) := rfl
@[simp, norm_cast] lemma coe_bit1 (a : ℕ+) : ((bit1 a : ℕ+) : ℕ) = bit1 (a : ℕ) := rfl

@[simp, norm_cast] theorem pow_coe (m : ℕ+) (n : ℕ) : ((m ^ n : ℕ+) : ℕ) = (m : ℕ) ^ n :=
rfl

/-- Subtraction a - b is defined in the obvious way when
  a > b, and by a - b = 1 if a ≤ b.
-/
instance : has_sub ℕ+ := ⟨λ a b, to_pnat' (a - b : ℕ)⟩

theorem sub_coe (a b : ℕ+) : ((a - b : ℕ+) : ℕ) = ite (b < a) (a - b : ℕ) 1 :=
begin
  change (to_pnat' _ : ℕ) = ite _ _ _,
  split_ifs with h,
  { exact to_pnat'_coe (tsub_pos_of_lt h) },
  { rw tsub_eq_zero_iff_le.mpr (le_of_not_gt h : (a : ℕ) ≤ b), refl }
end

theorem add_sub_of_lt {a b : ℕ+} : a < b → a + (b - a) = b :=
 λ h, eq $ by { rw [add_coe, sub_coe, if_pos h],
                exact add_tsub_cancel_of_le h.le }

/-- If `n : ℕ+` is different from `1`, then it is the successor of some `k : ℕ+`. -/
lemma exists_eq_succ_of_ne_one : ∀ {n : ℕ+} (h1 : n ≠ 1), ∃ (k : ℕ+), n = k + 1
| ⟨1, _⟩ h1 := false.elim $ h1 rfl
| ⟨n+2, _⟩ _ := ⟨⟨n+1, by simp⟩, rfl⟩

/-- Strong induction on `ℕ+`, with `n = 1` treated separately. -/
def case_strong_induction_on {p : ℕ+ → Sort*} (a : ℕ+) (hz : p 1)
  (hi : ∀ n, (∀ m, m ≤ n → p m) → p (n + 1)) : p a :=
begin
  apply strong_induction_on a,
  rintro ⟨k, kprop⟩ hk,
  cases k with k,
  { exact (lt_irrefl 0 kprop).elim },
  cases k with k,
  { exact hz },
  exact hi ⟨k.succ, nat.succ_pos _⟩ (λ m hm, hk _ (lt_succ_iff.2 hm)),
end

/-- An induction principle for `ℕ+`: it takes values in `Sort*`, so it applies also to Types,
not only to `Prop`. -/
@[elab_as_eliminator]
def rec_on (n : ℕ+) {p : ℕ+ → Sort*} (p1 : p 1) (hp : ∀ n, p n → p (n + 1)) : p n :=
begin
  rcases n with ⟨n, h⟩,
  induction n with n IH,
  { exact absurd h dec_trivial },
  { cases n with n,
    { exact p1 },
    { exact hp _ (IH n.succ_pos) } }
end

@[simp] theorem rec_on_one {p} (p1 hp) : @pnat.rec_on 1 p p1 hp = p1 := rfl

@[simp] theorem rec_on_succ (n : ℕ+) {p : ℕ+ → Sort*} (p1 hp) :
  @pnat.rec_on (n + 1) p p1 hp = hp n (@pnat.rec_on n p p1 hp) :=
by { cases n with n h, cases n; [exact absurd h dec_trivial, refl] }

lemma mod_div_aux_spec : ∀ (k : ℕ+) (r q : ℕ) (h : ¬ (r = 0 ∧ q = 0)),
 (((mod_div_aux k r q).1 : ℕ) + k * (mod_div_aux k r q).2 = (r + k * q))
| k 0 0 h := (h ⟨rfl, rfl⟩).elim
| k 0 (q + 1) h := by
{ change (k : ℕ) + (k : ℕ) * (q + 1).pred = 0 + (k : ℕ) * (q + 1),
  rw [nat.pred_succ, nat.mul_succ, zero_add, add_comm]}
| k (r + 1) q h := rfl

theorem mod_add_div (m k : ℕ+) : ((mod m k) + k * (div m k) : ℕ) = m :=
begin
  let h₀ := nat.mod_add_div (m : ℕ) (k : ℕ),
  have : ¬ ((m : ℕ) % (k : ℕ) = 0 ∧ (m : ℕ) / (k : ℕ) = 0),
  by { rintro ⟨hr, hq⟩, rw [hr, hq, mul_zero, zero_add] at h₀,
       exact (m.ne_zero h₀.symm).elim },
  have := mod_div_aux_spec k ((m : ℕ) % (k : ℕ)) ((m : ℕ) / (k : ℕ)) this,
  exact (this.trans h₀),
end

theorem div_add_mod (m k : ℕ+) : (k * (div m k) + mod m k : ℕ) = m :=
(add_comm _ _).trans (mod_add_div _ _)

lemma mod_add_div' (m k : ℕ+) : ((mod m k) + (div m k) * k : ℕ) = m :=
by { rw mul_comm, exact mod_add_div _ _ }

lemma div_add_mod' (m k : ℕ+) : ((div m k) * k + mod m k : ℕ) = m :=
by { rw mul_comm, exact div_add_mod _ _ }

theorem mod_le (m k : ℕ+) : mod m k ≤ m ∧ mod m k ≤ k :=
begin
  change ((mod m k) : ℕ) ≤ (m : ℕ) ∧ ((mod m k) : ℕ) ≤ (k : ℕ),
  rw [mod_coe], split_ifs,
  { have hm : (m : ℕ) > 0 := m.pos,
    rw [← nat.mod_add_div (m : ℕ) (k : ℕ), h, zero_add] at hm ⊢,
    by_cases h' : ((m : ℕ) / (k : ℕ)) = 0,
    { rw [h', mul_zero] at hm, exact (lt_irrefl _ hm).elim},
    { let h' := nat.mul_le_mul_left (k : ℕ)
             (nat.succ_le_of_lt (nat.pos_of_ne_zero h')),
      rw [mul_one] at h', exact ⟨h', le_refl (k : ℕ)⟩ } },
  { exact ⟨nat.mod_le (m : ℕ) (k : ℕ), (nat.mod_lt (m : ℕ) k.pos).le⟩ }
end

theorem dvd_iff {k m : ℕ+} : k ∣ m ↔ (k : ℕ) ∣ (m : ℕ) :=
begin
  split; intro h, rcases h with ⟨_, rfl⟩, apply dvd_mul_right,
  rcases h with ⟨a, h⟩, cases a, { contrapose h, apply ne_zero, },
  use a.succ, apply nat.succ_pos, rw [← coe_inj, h, mul_coe, mk_coe],
end

theorem dvd_iff' {k m : ℕ+} : k ∣ m ↔ mod m k = k :=
begin
  rw dvd_iff,
  rw [nat.dvd_iff_mod_eq_zero], split,
  { intro h, apply eq, rw [mod_coe, if_pos h] },
  { intro h, by_cases h' : (m : ℕ) % (k : ℕ) = 0,
    { exact h'},
    { replace h : ((mod m k) : ℕ) = (k : ℕ) := congr_arg _ h,
      rw [mod_coe, if_neg h'] at h,
      exact ((nat.mod_lt (m : ℕ) k.pos).ne h).elim } }
end

lemma le_of_dvd {m n : ℕ+} : m ∣ n → m ≤ n :=
by { rw dvd_iff', intro h, rw ← h, apply (mod_le n m).left }

theorem mul_div_exact {m k : ℕ+} (h : k ∣ m) : k * (div_exact m k) = m :=
begin
 apply eq, rw [mul_coe],
 change (k : ℕ) * (div m k).succ = m,
 rw [← div_add_mod m k, dvd_iff'.mp h, nat.mul_succ]
end

theorem dvd_one_iff (n : ℕ+) : n ∣ 1 ↔ n = 1 :=
 ⟨λ h, dvd_antisymm h (one_dvd n), λ h, h.symm ▸ (dvd_refl 1)⟩

lemma pos_of_div_pos {n : ℕ+} {a : ℕ} (h : a ∣ n) : 0 < a :=
begin
  apply pos_iff_ne_zero.2,
  intro hzero,
  rw hzero at h,
  exact pnat.ne_zero n (eq_zero_of_zero_dvd h)
end

end pnat


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

/-!
# `norm_swap`

Evaluating `swap x y z` for numerals `x y z` that are `ℕ`, `ℤ`, or `ℚ`, via a `norm_num` plugin.
Terms are passed to `eval`, quickly failing if not of the form `swap x y z`.
The expressions for numerals `x y z` are converted to `nat`, and then compared.
Based on equality of these `nat`s, equality proofs are generated using either
`equiv.swap_apply_left`, `equiv.swap_apply_right`, or `swap_apply_of_ne_of_ne`.
-/

open equiv tactic expr

open norm_num

namespace norm_swap

/--
A `norm_num` plugin for normalizing `equiv.swap a b c`
where `a b c` are numerals of `ℕ`, `ℤ`, `ℚ` or `fin n`.

```
example : equiv.swap 1 2 1 = 2 := by norm_num
```
-/
@[norm_num] meta def eval : expr → tactic (expr × expr) := λ e, do
  (swapt, fun_ty, coe_fn_inst, fexpr, c) ← e.match_app_coe_fn
    <|> fail "did not get an app coe_fn expr",
  guard (fexpr.get_app_fn.const_name = ``equiv.swap) <|> fail "coe_fn not of equiv.swap",
  [α, deceq_inst, a, b] ← pure fexpr.get_app_args <|>
    fail "swap did not have exactly two args applied",
  na ← a.to_rat <|> (do (fa, _) ← norm_fin.eval_fin_num a, fa.to_rat),
  nb ← b.to_rat <|> (do (fb, _) ← norm_fin.eval_fin_num b, fb.to_rat),
  nc ← c.to_rat <|> (do (fc, _) ← norm_fin.eval_fin_num c, fc.to_rat),
  if nc = na then do
    p ← mk_mapp `equiv.swap_apply_left [α, deceq_inst, a, b],
    pure (b, p)
  else if nc = nb then do
    p ← mk_mapp `equiv.swap_apply_right [α, deceq_inst, a, b],
    pure (a, p)
  else do
    nic ← mk_instance_cache α,
    hca ← (prod.snd <$> prove_ne nic c a nc na) <|>
      (do (_, ff, p) ← norm_fin.prove_eq_ne_fin c a, pure p),
    hcb ← (prod.snd <$> prove_ne nic c b nc nb) <|>
      (do (_, ff, p) ← norm_fin.prove_eq_ne_fin c b, pure p),
    p ← mk_mapp `equiv.swap_apply_of_ne_of_ne [α, deceq_inst, a, b, c, hca, hcb],
    pure (c, p)

end norm_swap


import MyNat
import MyNat.multiplication_world
import MyNat.advanced_addition_world
import MyNat.advanced_proposition_world

open MyNat

theorem mul_pos (a b : ℕ) :
  a ≠ 0 → b ≠ 0 → a * b ≠ 0 := by
  intro nea neb
  cases a with
  | zero =>
    exact False.elim nea.irrefl
  | succ a' =>
    cases b with
    | zero => exact False.elim neb.irrefl
    | succ b' =>
      rewrite [succ_mul, add_comm, succ_add]
      exact succ_ne_zero _

theorem eq_zero_or_eq_zero_of_mul_eq_zero (a b : ℕ)
  (h : a * b = 0) : a = 0 ∨ b = 0 := by
  cases a with
  | zero =>
    rewrite [zero_mul] at h
    exact Or.inl h
  | succ a' =>
    cases b with
    | zero =>
      rewrite [mul_zero] at h
      exact Or.inr h
    | succ b' =>
      let nea := succ_ne_zero a'
      let neb := succ_ne_zero b'
      let f := mul_pos (succ a') (succ b') nea neb
      exact (False.elim (Ne.elim f h))

theorem mul_eq_zero_iff (a b : ℕ) :
  a * b = 0 ↔ a = 0 ∨ b = 0 := by
  constructor
  { exact eq_zero_or_eq_zero_of_mul_eq_zero a b }
  { intro h
  exact (
    h.elim
    (fun a0 => by
      rewrite [a0, zero_equal_numeral, zero_mul]
      rfl

    )
    (fun b0 => by
      rewrite [b0, zero_equal_numeral, mul_zero]
      rfl
    )
  )
  }

theorem mul_left_cancel (a b c : ℕ)
  (ha : a ≠ 0) : a * b = a * c → b = c := by
  intro h
  induction c generalizing b with
  | zero =>
    rewrite [mul_zero] at h
    let f := eq_zero_or_eq_zero_of_mul_eq_zero _ _ h
    exact (
      Or.elim f
      (fun a0 => False.elim (ha.elim a0))
      id
    )
  | succ c' ih =>
    induction b with
    | zero =>
      rewrite [mul_zero] at h
      let f := eq_zero_or_eq_zero_of_mul_eq_zero _ _ h.symm
      exact (
        Or.elim f
        (fun a0 => False.elim (ha.elim a0))
        Eq.symm
      )
    | succ b' _ =>
      rewrite [mul_succ, mul_succ] at h
      let f := add_left_cancel _ _ _ h
      let f' := (ih b') f
      rewrite [f']
      rfl


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import data.real.cau_seq
import topology.uniform_space.basic

/-!
# Uniform structure induced by an absolute value

We build a uniform space structure on a commutative ring `R` equipped with an absolute value into
a linear ordered field `𝕜`. Of course in the case `R` is `ℚ`, `ℝ` or `ℂ` and
`𝕜 = ℝ`, we get the same thing as the metric space construction, and the general construction
follows exactly the same path.

## Implementation details

Note that we import `data.real.cau_seq` because this is where absolute values are defined, but
the current file does not depend on real numbers. TODO: extract absolute values from that
`data.real` folder.

## References

* [N. Bourbaki, *Topologie générale*][bourbaki1966]

## Tags

absolute value, uniform spaces
-/

open set function filter uniform_space
open_locale filter

namespace is_absolute_value
variables {𝕜 : Type*} [linear_ordered_field 𝕜]
variables {R : Type*} [comm_ring R] (abv : R → 𝕜) [is_absolute_value abv]

/-- The uniformity coming from an absolute value. -/
def uniform_space_core : uniform_space.core R :=
{ uniformity := (⨅ ε>0, 𝓟 {p:R×R | abv (p.2 - p.1) < ε}),
  refl := le_infi $ assume ε, le_infi $ assume ε_pos, principal_mono.2
    (λ ⟨x, y⟩ h, by simpa [show x = y, from h, abv_zero abv]),
  symm := tendsto_infi.2 $ assume ε, tendsto_infi.2 $ assume h,
    tendsto_infi' ε $ tendsto_infi' h $ tendsto_principal_principal.2 $ λ ⟨x, y⟩ h,
      have h : abv (y - x) < ε, by simpa [-sub_eq_add_neg] using h,
      by rwa abv_sub abv at h,
  comp := le_infi $ assume ε, le_infi $ assume h, lift'_le
    (mem_infi_sets (ε / 2) $ mem_infi_sets (div_pos h zero_lt_two) (subset.refl _)) $
    have ∀ (a b c : R), abv (c-a) < ε / 2 → abv (b-c) < ε / 2 → abv (b-a) < ε,
      from assume a b c hac hcb,
       calc abv (b - a) ≤ _ : abv_sub_le abv b c a
        ... = abv (c - a) + abv (b - c) : add_comm _ _
        ... < ε / 2 + ε / 2 : add_lt_add hac hcb
        ... = ε : by rw [div_add_div_same, add_self_div_two],
    by simpa [comp_rel] }

/-- The uniform structure coming from an absolute value. -/
def uniform_space : uniform_space R :=
uniform_space.of_core (uniform_space_core abv)

theorem mem_uniformity {s : set (R×R)} :
  s ∈ (uniform_space_core abv).uniformity ↔
  (∃ε>0, ∀{a b:R}, abv (b - a) < ε → (a, b) ∈ s) :=
begin
  suffices : s ∈ (⨅ ε: {ε : 𝕜 // ε > 0}, 𝓟 {p:R×R | abv (p.2 - p.1) < ε.val}) ↔ _,
  { rw infi_subtype at this,
    exact this },
  rw mem_infi,
  { simp [subset_def] },
  { rintros ⟨r, hr⟩ ⟨p, hp⟩,
    exact ⟨⟨min r p, lt_min hr hp⟩, by simp [lt_min_iff, (≥)] {contextual := tt}⟩, },
end

end is_absolute_value