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

import Algdata.Init.LawfulLT
import Algdata.Data.List.Basic
import Algdata.Data.List.Prop

namespace List

universe u
/-
  Property of lists that every pair of consequtive entries satisfies a specified condition.
-/
inductive Ascending {α : Type u} (r : α → α → Prop) : List α → Prop
| nil : Ascending r []
| singleton (a : α) : Ascending r [a]
| cons {a b : α} {bs : List α} : r a b → Ascending r (b::bs) → Ascending r (a::b::bs)

namespace Ascending

variable {α : Type u} {r : α → α → Prop}

protected
theorem tail {a : α} {as : List α} : Ascending r (a::as) → Ascending r as
| singleton _ => Ascending.nil
| cons _ h => h

protected
theorem head {a : α} {as : List α} : Ascending r (a::as) → as.predHead (r a) := by
  intro hchain; cases hchain
  case singleton => exact True.intro
  case cons => exact ‹r a _›

theorem of_implies {r₁ : α → α → Prop} : (∀ a b, r a b → r₁ a b) → {as : List α} → Ascending r as → Ascending r₁ as
| _, _, nil => Ascending.nil
| _, _, singleton a => Ascending.singleton a
| himp, _, cons ha has => Ascending.cons (himp _ _ ha) (of_implies himp has)

theorem of_append_left {as bs : List α} : Ascending r (as++bs) → Ascending r as := by
  induction as
  case nil => exact λ _ => Ascending.nil
  case cons a as h_ind =>
    cases as
    case nil => exact λ _ => Ascending.singleton a
    case cons a₁ as =>
      simp [List.cons_append] at *
      intro has; cases has with | cons ha htail =>
      exact Ascending.cons ha (h_ind htail)

theorem of_append_right {as bs : List α} : Ascending r (as++bs) → Ascending r bs := by
  induction as
  case nil => exact id
  case cons _ _ h_ind => exact h_ind ∘ Ascending.tail

theorem predHead_tail {a : α} {as : List α} {p : α → Prop} : (∀ a b, p a → r a b → p b) → Ascending r (a::as) → (a::as).predHead p → as.predHead p := by
  intro hup hchain hpa
  cases as
  case nil => exact True.intro
  case cons a₁ as => exact hup a a₁ hpa hchain.head

theorem forAll_of_tail [Trans r r r] {a : α} {as : List α} : Ascending r (a::as) → as.forAll (r a) := by
  revert a
  induction as <;> intro a h
  case nil => exact True.intro
  case cons a₁ as h_ind =>
    cases h with | cons ha htail =>
    have : as.forAll (r a) :=
      forAll_of_forAll (λ x => trans ha) $ h_ind htail
    exact And.intro ha this

theorem forAll_of_predHead {p : α → Prop} {as : List α} : (∀ a b, p a → r a b → p b) → as.predHead p → as.Ascending r → as.forAll p := by
  induction as
  case nil => intros; exact True.intro
  case cons a as h_ind =>
    intro hup hpa hchain
    exact ⟨hpa, h_ind hup (hchain.predHead_tail hup hpa) hchain.tail⟩

theorem forAllRel_of_append [Trans r r r] {as bs : List α} : Ascending r (as++bs) → List.forAllRel r as bs := by
  induction as <;> simp
  -- case nil has been closed
  case cons a as h_ind =>
    intro hass
    have := hass.forAll_of_tail; simp at this
    exact And.intro this.right (h_ind hass.tail)

theorem cons_of_head_tail {a : α} {as : List α} : as.predHead (r a) → as.Ascending r → Ascending r (a::as) := by
  cases as
  case nil => exact λ _ _ => Ascending.singleton _
  case cons => exact Ascending.cons

theorem cons_of_forAll {a : α} {as : List α} : as.forAll (r a) → Ascending r as → Ascending r (a::as) := by
  cases as
  case nil => intros; exact Ascending.singleton a
  case cons a₁ as =>
    intro h
    exact Ascending.cons h.left

theorem append [Trans r r r] {as bs : List α} : List.forAllRel r as bs →  Ascending r as → Ascending r bs → Ascending r (as ++ bs) := by
  induction as
  case nil => dsimp; exact λ _ _ => id
  case cons a as h_ind =>
    dsimp [forAllRel_cons_left]
    rw [List.forAllRel_cons_left]
    intro h hass hbs
    have htail := h_ind h.right hass.tail hbs
    have hhead : bs.forAll (r a) := h.left
    apply cons_of_forAll _ htail
    rw [forAll_append]
    exact And.intro hass.forAll_of_tail hhead

protected
theorem map.{v} {β : Type v} (r' : β → β → Prop) (f : α → β) (rel_pres : ∀ a₁ a₂, r a₁ a₂ → r' (f a₁) (f a₂)) : ∀ {as : List α}, as.Ascending r → (as.map f).Ascending r'
| [], _ => Ascending.nil
| [a], Ascending.singleton _ => Ascending.singleton (f a)
| (_::_::_), Ascending.cons h hs => Ascending.cons (rel_pres _ _ h) $ hs.map r' f rel_pres

protected
theorem reverseAux_cons {a : α} {as bs : List α} : Ascending (flip r) (a::as) → Ascending r (a::bs) → Ascending r (List.reverseAux (a::as) bs) := by
  revert a bs; induction as <;> dsimp [reverseAux] <;> intro a bs
  case nil => exact λ _ => id
  case cons a' as h_ind =>
    intro haaas habs
    simp [reverseAux] at h_ind
    cases haaas with | cons haa haas =>
    apply h_ind haas (habs.cons haa)

theorem reverseAux {as bs : List α} : List.relHead r as bs → Ascending (flip r) as → Ascending r bs → Ascending r (reverseAux as bs) := by
  revert bs; induction as <;> intro bs
  case nil => exact λ _ _ => id
  case cons a as h_ind =>
    intro hhead has hbs
    unfold List.reverseAux
    apply h_ind
    . exact relHead_cons_right ▸ has.head
    . exact has.tail
    . exact hbs.cons_of_head_tail (relHead_cons_left ▸ hhead)

protected
theorem reverse {as : List α} : Ascending r as → Ascending (flip r) as.reverse :=
  λ hchain =>
    have : Ascending (flip (flip r)) as :=
      hchain.of_implies λ _ _ => id
    reverseAux (as:=as) (bs:=[]) (by cases as <;> exact True.intro) this Ascending.nil

protected
theorem subst_head {a b : α} (hab : ∀ c, r a c → r b c) : {as : List α} → Ascending r (a::as) → Ascending r (b::as)
| _, singleton _ => Ascending.singleton _
| _, cons ha' has => Ascending.cons (hab _ ha') has

protected
theorem filterMap.{v} [Trans r r r] {β : Type v} (r' : β → β → Prop) (f : α → Option β) (rel_pres : ∀ a₁ a₂, r a₁ a₂ → ∀ b₁ b₂, f a₁ = some b₁ → f a₂ = some b₂ → r' b₁ b₂) : ∀ {as : List α}, as.Ascending r → (as.filterMap f).Ascending r' := by
  intro as; induction as
  case nil => exact λ _ => Ascending.nil
  case cons a as h_ind =>
    intro hchain
    unfold filterMap
    cases hfa : f a <;> dsimp
    case none => exact h_ind hchain.tail
    case some b =>
      apply cons_of_forAll
      . clear h_ind
        induction as <;> dsimp [filterMap]
        case a.nil => dsimp [List.forAll]
        case a.cons a₁ as h_ind₁ =>
          have hchainaas : Ascending r (a::as) := by
            apply hchain.tail.subst_head
            exact λ _ h => trans hchain.head h
          cases hfa₁ : f a₁ <;> dsimp
          case none => exact h_ind₁ hchainaas
          case some b₁ =>
            constructor
            . have := rel_pres a a₁ hchain.head
              rw [hfa, hfa₁] at this
              exact this b b₁ rfl rfl
            . exact h_ind₁ hchainaas
      . exact h_ind hchain.tail

end Ascending

/-!
  Pair `(fst,snd)` of lists such that
    - `fst` is a reversed chain
    - `snd` is a chain
    - `fst.reverse ++ snd` is a chain
-/
structure HookedAscending {α : Type _} (r : α → α → Prop) (as bs : List α) : Prop where
  fst_lt_snd : List.forAllRel r as bs
  fst_revAscending : as.Ascending (flip r)
  snd_Ascending : bs.Ascending r

namespace HookedAscending

variable {α : Type _} {r : α → α → Prop}

protected
theorem inl {as : List α} (has : as.Ascending (flip r)) : HookedAscending r as [] where
  fst_lt_snd := by simp
  fst_revAscending := has
  snd_Ascending := List.Ascending.nil

protected
theorem inr {bs : List α} (hbs : bs.Ascending r) : HookedAscending r [] bs where
  fst_lt_snd := by simp
  fst_revAscending := List.Ascending.nil
  snd_Ascending := hbs

theorem of_implies {r₁ : α → α → Prop} : (∀ a b, r a b → r₁ a b) → {as bs : List α} → HookedAscending r as bs → HookedAscending r₁ as bs := by
  intro himp as bs hhook
  constructor
  case fst_lt_snd =>
    exact List.forAllRel_of_forAllRel himp hhook.fst_lt_snd
  case fst_revAscending =>
    have : ∀ a b, flip r a b → flip r₁ a b := λ a b => himp b a
    exact hhook.fst_revAscending.of_implies this
  case snd_Ascending =>
    exact hhook.snd_Ascending.of_implies himp

protected
theorem unhook {as bs : List α} : HookedAscending r as bs → Ascending r (as.reverseAux bs) := by
  cases as <;> simp
  case nil => exact HookedAscending.snd_Ascending
  case cons a as =>
    intro hhook
    apply Ascending.reverseAux_cons
    . exact hhook.fst_revAscending
    . apply Ascending.cons_of_forAll _ hhook.snd_Ascending
      have := hhook.fst_lt_snd
      rw [List.forAllRel_cons_left] at this
      exact this.left

protected
theorem flip {as bs : List α} (hhook : HookedAscending r as bs) : HookedAscending (flip r) bs as where
  fst_lt_snd := by simp; exact hhook.fst_lt_snd
  fst_revAscending := by
    have : ∀ a b, r a b → flip (flip r) a b := λ _ _ => id
    apply Ascending.of_implies this
    exact hhook.snd_Ascending
  snd_Ascending := hhook.fst_revAscending

theorem reelL [Trans r r r] {as : List α} {b : α} {bs : List α} : HookedAscending r as (b::bs) → HookedAscending r (b::as) bs := by
  intro hhook
  have hlt := hhook.fst_lt_snd
  rw [List.forAllRel_cons_right] at hlt
  constructor <;> simp
  case fst_lt_snd =>
    constructor
    case left => exact hhook.snd_Ascending.forAll_of_tail
    case right => exact hlt.right
  case fst_revAscending =>
    exact List.Ascending.cons_of_forAll hlt.left hhook.fst_revAscending
  case snd_Ascending => exact hhook.snd_Ascending.tail

theorem reelR [Trans r r r] {a : α} {as bs : List α} : HookedAscending r (a::as) bs → HookedAscending r as (a::bs) :=
  λ hhook =>
    have : Trans (flip r) (flip r) (flip r) :=
      Trans.mk (by simp [flip]; exact flip trans)
    hhook.flip.reelL.flip

theorem substToL [Trans r r r] {eqv : α → α → Prop} [Trans eqv r r] [Trans r eqv r] {a b : α} {as bs : List α} : eqv a b → eqv b a → HookedAscending r as (b::bs) → HookedAscending r (a::as) bs := by
  intro hab hba hhook
  have hlt := hhook.fst_lt_snd
  rw [List.forAllRel_cons_right] at hlt
  constructor <;> simp
  case fst_lt_snd =>
    constructor
    case left =>
      apply List.forAll_of_forAll (λ x (h : r b x) => trans hab h)
      exact hhook.snd_Ascending.forAll_of_tail
    case right => exact hlt.right
  case fst_revAscending =>
    apply List.Ascending.cons_of_forAll _ hhook.fst_revAscending
    apply List.forAll_of_forAll (λ x (h : r x b) => trans h hba)
    exact hlt.left
  case snd_Ascending => exact hhook.snd_Ascending.tail

theorem consL {a : α} {as bs : List α} : as.forAll (r · a) → bs.forAll (r a) → HookedAscending r as bs → HookedAscending r (a::as) bs := by
  intro has hbs hhook
  constructor
  case fst_lt_snd =>
    simp [List.forAllRel_cons_left]
    exact And.intro hbs hhook.fst_lt_snd
  case fst_revAscending =>
    exact List.Ascending.cons_of_forAll has hhook.fst_revAscending
  case snd_Ascending => exact hhook.snd_Ascending

theorem consR {as : List α} {b : α} {bs : List α} : as.forAll (r · b) → bs.forAll (r b) → HookedAscending r as bs → HookedAscending r as (b::bs) := by
  intro has hbs hhook
  have : ∀ a b, flip (flip r) a b → r a b := λ _ _ => id
  exact (hhook.flip.consL hbs has).flip.of_implies this

theorem tailL [Trans r r r] {a : α} {as bs : List α} : HookedAscending r (a::as) bs → HookedAscending r as bs := by
  intro hhook
  constructor
  case fst_lt_snd =>
    have := hhook.fst_lt_snd
    simp [List.forAllRel_cons_left] at this
    exact this.right
  case fst_revAscending => exact hhook.fst_revAscending.tail
  case snd_Ascending => exact hhook.snd_Ascending

theorem tailR [Trans r r r] {as : List α} {b : α} {bs : List α} : HookedAscending r as (b::bs) → HookedAscending r as bs := by
  intro hhook
  have : Trans (flip r) (flip r) (flip r) :=
    Trans.mk (by simp [flip]; exact flip trans)
  exact hhook.flip.tailL.flip

end HookedAscending

end List


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis

! This file was ported from Lean 3 source module analysis.convex.extrema
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Function
import Mathbin.Topology.Algebra.Affine
import Mathbin.Topology.LocalExtr
import Mathbin.Topology.MetricSpace.Basic

/-!
# Minima and maxima of convex functions

We show that if a function `f : E → β` is convex, then a local minimum is also
a global minimum, and likewise for concave functions.
-/

variable {E β : Type _} [AddCommGroup E] [TopologicalSpace E] [Module ℝ E] [TopologicalAddGroup E]
  [ContinuousSMul ℝ E] [OrderedAddCommGroup β] [Module ℝ β] [OrderedSMul ℝ β] {s : Set E}

open Set Filter Function

open Classical Topology

/-- Helper lemma for the more general case: `is_min_on.of_is_local_min_on_of_convex_on`.
-/
theorem IsMinOn.of_isLocalMinOn_of_convexOn_Icc {f : ℝ → β} {a b : ℝ} (a_lt_b : a < b)
    (h_local_min : IsLocalMinOn f (Icc a b) a) (h_conv : ConvexOn ℝ (Icc a b) f) :
    IsMinOn f (Icc a b) a := by
  rintro c hc
  dsimp only [mem_set_of_eq]
  rw [IsLocalMinOn, nhdsWithin_Icc_eq_nhdsWithin_Ici a_lt_b] at h_local_min
  rcases hc.1.eq_or_lt with (rfl | a_lt_c)
  · exact le_rfl
  have H₁ : ∀ᶠ y in 𝓝[>] a, f a ≤ f y :=
    h_local_min.filter_mono (nhdsWithin_mono _ Ioi_subset_Ici_self)
  have H₂ : ∀ᶠ y in 𝓝[>] a, y ∈ Ioc a c := Ioc_mem_nhdsWithin_Ioi (left_mem_Ico.2 a_lt_c)
  rcases(H₁.and H₂).exists with ⟨y, hfy, hy_ac⟩
  rcases(Convex.mem_Ioc a_lt_c).mp hy_ac with ⟨ya, yc, ya₀, yc₀, yac, rfl⟩
  suffices : ya • f a + yc • f a ≤ ya • f a + yc • f c
  exact (smul_le_smul_iff_of_pos yc₀).1 (le_of_add_le_add_left this)
  calc
    ya • f a + yc • f a = f a := by rw [← add_smul, yac, one_smul]
    _ ≤ f (ya * a + yc * c) := hfy
    _ ≤ ya • f a + yc • f c := h_conv.2 (left_mem_Icc.2 a_lt_b.le) hc ya₀ yc₀.le yac

#align is_min_on.of_is_local_min_on_of_convex_on_Icc IsMinOn.of_isLocalMinOn_of_convexOn_Icc

/-- A local minimum of a convex function is a global minimum, restricted to a set `s`.
-/
theorem IsMinOn.of_isLocalMinOn_of_convexOn {f : E → β} {a : E} (a_in_s : a ∈ s)
    (h_localmin : IsLocalMinOn f s a) (h_conv : ConvexOn ℝ s f) : IsMinOn f s a :=
  by
  intro x x_in_s
  let g : ℝ →ᵃ[ℝ] E := AffineMap.lineMap a x
  have hg0 : g 0 = a := AffineMap.lineMap_apply_zero a x
  have hg1 : g 1 = x := AffineMap.lineMap_apply_one a x
  have hgc : Continuous g := AffineMap.lineMap_continuous
  have h_maps : maps_to g (Icc 0 1) s := by
    simpa only [maps_to', ← segment_eq_image_lineMap] using h_conv.1.segment_subset a_in_s x_in_s
  have fg_local_min_on : IsLocalMinOn (f ∘ g) (Icc 0 1) 0 :=
    by
    rw [← hg0] at h_localmin
    exact h_localmin.comp_continuous_on h_maps hgc.continuous_on (left_mem_Icc.2 zero_le_one)
  have fg_min_on : IsMinOn (f ∘ g) (Icc 0 1 : Set ℝ) 0 :=
    by
    refine' IsMinOn.of_isLocalMinOn_of_convexOn_Icc one_pos fg_local_min_on _
    exact (h_conv.comp_affine_map g).Subset h_maps (convex_Icc 0 1)
  simpa only [hg0, hg1, comp_app, mem_set_of_eq] using fg_min_on (right_mem_Icc.2 zero_le_one)
#align is_min_on.of_is_local_min_on_of_convex_on IsMinOn.of_isLocalMinOn_of_convexOn

/-- A local maximum of a concave function is a global maximum, restricted to a set `s`. -/
theorem IsMaxOn.of_isLocalMaxOn_of_concaveOn {f : E → β} {a : E} (a_in_s : a ∈ s)
    (h_localmax : IsLocalMaxOn f s a) (h_conc : ConcaveOn ℝ s f) : IsMaxOn f s a :=
  @IsMinOn.of_isLocalMinOn_of_convexOn _ βᵒᵈ _ _ _ _ _ _ _ _ s f a a_in_s h_localmax h_conc
#align is_max_on.of_is_local_max_on_of_concave_on IsMaxOn.of_isLocalMaxOn_of_concaveOn

/-- A local minimum of a convex function is a global minimum. -/
theorem IsMinOn.of_isLocalMin_of_convex_univ {f : E → β} {a : E} (h_local_min : IsLocalMin f a)
    (h_conv : ConvexOn ℝ univ f) : ∀ x, f a ≤ f x := fun x =>
  (IsMinOn.of_isLocalMinOn_of_convexOn (mem_univ a) (h_local_min.on univ) h_conv) (mem_univ x)
#align is_min_on.of_is_local_min_of_convex_univ IsMinOn.of_isLocalMin_of_convex_univ

/-- A local maximum of a concave function is a global maximum. -/
theorem IsMaxOn.of_isLocalMax_of_convex_univ {f : E → β} {a : E} (h_local_max : IsLocalMax f a)
    (h_conc : ConcaveOn ℝ univ f) : ∀ x, f x ≤ f a :=
  @IsMinOn.of_isLocalMin_of_convex_univ _ βᵒᵈ _ _ _ _ _ _ _ _ f a h_local_max h_conc
#align is_max_on.of_is_local_max_of_convex_univ IsMaxOn.of_isLocalMax_of_convex_univ


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker

TODO: Provide a GCD monoid instance for `ℕ`, port GCD facts about nats
TODO: Generalize normalization monoids commutative (cancellative) monoids with or without zero
TODO: Generalize GCD monoid to not require normalization in all cases
-/
import algebra.associated
import data.nat.gcd

/-!

# Monoids with normalization functions, `gcd`, and `lcm`

This file defines extra structures on `comm_cancel_monoid_with_zero`s, including `integral_domain`s.

## Main Definitions

* `normalization_monoid`
* `gcd_monoid`
* `gcd_monoid_of_exists_gcd`
* `gcd_monoid_of_exists_lcm`

## Implementation Notes

* `normalization_monoid` is defined by assigning to each element a `norm_unit` such that multiplying
by that unit normalizes the monoid, and `normalize` is an idempotent monoid homomorphism. This
definition as currently implemented does casework on `0`.

* `gcd_monoid` extends `normalization_monoid`, so the `gcd` and `lcm` are always normalized.
This makes `gcd`s of polynomials easier to work with, but excludes Euclidean domains, and monoids
without zero.

* `gcd_monoid_of_gcd` noncomputably constructs a `gcd_monoid` structure just from the `gcd`
  and its properties.

* `gcd_monoid_of_exists_gcd` noncomputably constructs a `gcd_monoid` structure just from a proof
  that any two elements have a (not necessarily normalized) `gcd`.

* `gcd_monoid_of_lcm` noncomputably constructs a `gcd_monoid` structure just from the `lcm`
  and its properties.

* `gcd_monoid_of_exists_lcm` noncomputably constructs a `gcd_monoid` structure just from a proof
  that any two elements have a (not necessarily normalized) `lcm`.

## TODO

* Provide a GCD monoid instance for `ℕ`, port GCD facts about nats, definition of coprime
* Generalize normalization monoids to commutative (cancellative) monoids with or without zero
* Generalize GCD monoid to not require normalization in all cases

## Tags

divisibility, gcd, lcm, normalize

-/

variables {α : Type*}

set_option old_structure_cmd true

/-- Normalization monoid: multiplying with `norm_unit` gives a normal form for associated
elements. -/
@[protect_proj] class normalization_monoid (α : Type*) [nontrivial α]
  [comm_cancel_monoid_with_zero α] :=
(norm_unit : α → units α)
(norm_unit_zero      : norm_unit 0 = 1)
(norm_unit_mul       : ∀{a b}, a ≠ 0 → b ≠ 0 → norm_unit (a * b) = norm_unit a * norm_unit b)
(norm_unit_coe_units : ∀(u : units α), norm_unit u = u⁻¹)

export normalization_monoid (norm_unit norm_unit_zero norm_unit_mul norm_unit_coe_units)

attribute [simp] norm_unit_coe_units norm_unit_zero norm_unit_mul

section normalization_monoid
variables [comm_cancel_monoid_with_zero α] [nontrivial α] [normalization_monoid α]

@[simp] theorem norm_unit_one : norm_unit (1:α) = 1 :=
norm_unit_coe_units 1

/-- Chooses an element of each associate class, by multiplying by `norm_unit` -/
def normalize : monoid_with_zero_hom α α :=
{ to_fun := λ x, x * norm_unit x,
  map_zero' := by simp,
  map_one' := by rw [norm_unit_one, units.coe_one, mul_one],
  map_mul' := λ x y,
  classical.by_cases (λ hx : x = 0, by rw [hx, zero_mul, zero_mul, zero_mul]) $ λ hx,
  classical.by_cases (λ hy : y = 0, by rw [hy, mul_zero, zero_mul, mul_zero]) $ λ hy,
  by simp only [norm_unit_mul hx hy, units.coe_mul]; simp only [mul_assoc, mul_left_comm y], }

theorem associated_normalize {x : α} : associated x (normalize x) :=
⟨_, rfl⟩

theorem normalize_associated {x : α} : associated (normalize x) x :=
associated_normalize.symm

lemma associates.mk_normalize {x : α} : associates.mk (normalize x) = associates.mk x :=
associates.mk_eq_mk_iff_associated.2 normalize_associated

@[simp] lemma normalize_apply {x : α} : normalize x = x * norm_unit x := rfl

@[simp] lemma normalize_zero : normalize (0 : α) = 0 := normalize.map_zero

@[simp] lemma normalize_one : normalize (1 : α) = 1 := normalize.map_one

lemma normalize_coe_units (u : units α) : normalize (u : α) = 1 := by simp

lemma normalize_eq_zero {x : α} : normalize x = 0 ↔ x = 0 :=
⟨λ hx, (associated_zero_iff_eq_zero x).1 $ hx ▸ associated_normalize,
  by rintro rfl; exact normalize_zero⟩

lemma normalize_eq_one {x : α} : normalize x = 1 ↔ is_unit x :=
⟨λ hx, is_unit_iff_exists_inv.2 ⟨_, hx⟩, λ ⟨u, hu⟩, hu ▸ normalize_coe_units u⟩

@[simp] theorem norm_unit_mul_norm_unit (a : α) : norm_unit (a * norm_unit a) = 1 :=
classical.by_cases (assume : a = 0, by simp only [this, norm_unit_zero, zero_mul]) $
  assume h, by rw [norm_unit_mul h (units.ne_zero _), norm_unit_coe_units, mul_inv_eq_one]

theorem normalize_idem (x : α) : normalize (normalize x) = normalize x := by simp

theorem normalize_eq_normalize {a b : α}
  (hab : a ∣ b) (hba : b ∣ a) : normalize a = normalize b :=
begin
  rcases associated_of_dvd_dvd hab hba with ⟨u, rfl⟩,
  refine classical.by_cases (by rintro rfl; simp only [zero_mul]) (assume ha : a ≠ 0, _),
  suffices : a * ↑(norm_unit a) = a * ↑u * ↑(norm_unit a) * ↑u⁻¹,
    by simpa only [normalize_apply, mul_assoc, norm_unit_mul ha u.ne_zero, norm_unit_coe_units],
  calc a * ↑(norm_unit a) = a * ↑(norm_unit a) * ↑u * ↑u⁻¹:
      (units.mul_inv_cancel_right _ _).symm
    ... = a * ↑u * ↑(norm_unit a) * ↑u⁻¹ : by rw mul_right_comm a
end

lemma normalize_eq_normalize_iff {x y : α} : normalize x = normalize y ↔ x ∣ y ∧ y ∣ x :=
⟨λ h, ⟨units.dvd_mul_right.1 ⟨_, h.symm⟩, units.dvd_mul_right.1 ⟨_, h⟩⟩,
λ ⟨hxy, hyx⟩, normalize_eq_normalize hxy hyx⟩

theorem dvd_antisymm_of_normalize_eq {a b : α}
  (ha : normalize a = a) (hb : normalize b = b) (hab : a ∣ b) (hba : b ∣ a) :
  a = b :=
ha ▸ hb ▸ normalize_eq_normalize hab hba

--can be proven by simp
lemma dvd_normalize_iff {a b : α} : a ∣ normalize b ↔ a ∣ b :=
units.dvd_mul_right

--can be proven by simp
lemma normalize_dvd_iff {a b : α} : normalize a ∣ b ↔ a ∣ b :=
units.mul_right_dvd

end normalization_monoid

namespace comm_group_with_zero
variables [decidable_eq α] [comm_group_with_zero α]

@[priority 100] -- see Note [lower instance priority]
instance : normalization_monoid α :=
{ norm_unit := λ x, if h : x = 0 then 1 else (units.mk0 x h)⁻¹,
  norm_unit_zero := dif_pos rfl,
  norm_unit_mul := λ x y x0 y0, units.eq_iff.1 (by simp [x0, y0, mul_inv']),
  norm_unit_coe_units := λ u, by { rw [dif_neg (units.ne_zero _), units.mk0_coe], apply_instance } }

@[simp]
lemma coe_norm_unit {a : α} (h0 : a ≠ 0) : (↑(norm_unit a) : α) = a⁻¹ :=
by simp [norm_unit, h0]

end comm_group_with_zero

namespace associates
variables [comm_cancel_monoid_with_zero α] [nontrivial α] [normalization_monoid α]

local attribute [instance] associated.setoid

/-- Maps an element of `associates` back to the normalized element of its associate class -/
protected def out : associates α → α :=
quotient.lift (normalize : α → α) $ λ a b ⟨u, hu⟩, hu ▸
normalize_eq_normalize ⟨_, rfl⟩ (units.mul_right_dvd.2 $ dvd_refl a)

lemma out_mk (a : α) : (associates.mk a).out = normalize a := rfl

@[simp] lemma out_one : (1 : associates α).out = 1 :=
normalize_one

lemma out_mul (a b : associates α) : (a * b).out = a.out * b.out :=
quotient.induction_on₂ a b $ assume a b,
by simp only [associates.quotient_mk_eq_mk, out_mk, mk_mul_mk, normalize.map_mul]

lemma dvd_out_iff (a : α) (b : associates α) : a ∣ b.out ↔ associates.mk a ≤ b :=
quotient.induction_on b $
  by simp [associates.out_mk, associates.quotient_mk_eq_mk, mk_le_mk_iff_dvd_iff]

lemma out_dvd_iff (a : α) (b : associates α) : b.out ∣ a ↔ b ≤ associates.mk a :=
quotient.induction_on b $
  by simp [associates.out_mk, associates.quotient_mk_eq_mk, mk_le_mk_iff_dvd_iff]

@[simp] lemma out_top : (⊤ : associates α).out = 0 :=
normalize_zero

@[simp] lemma normalize_out (a : associates α) : normalize a.out = a.out :=
quotient.induction_on a normalize_idem

end associates

/-- GCD monoid: a `comm_cancel_monoid_with_zero` with normalization and `gcd`
(greatest common divisor) and `lcm` (least common multiple) operations. In this setting `gcd` and
`lcm` form a bounded lattice on the associated elements where `gcd` is the infimum, `lcm` is the
supremum, `1` is bottom, and `0` is top. The type class focuses on `gcd` and we derive the
corresponding `lcm` facts from `gcd`.
-/
@[protect_proj] class gcd_monoid (α : Type*) [comm_cancel_monoid_with_zero α] [nontrivial α]
  extends normalization_monoid α :=
(gcd : α → α → α)
(lcm : α → α → α)
(gcd_dvd_left   : ∀a b, gcd a b ∣ a)
(gcd_dvd_right  : ∀a b, gcd a b ∣ b)
(dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b)
(normalize_gcd  : ∀a b, normalize (gcd a b) = gcd a b)
(gcd_mul_lcm    : ∀a b, gcd a b * lcm a b = normalize (a * b))
(lcm_zero_left  : ∀a, lcm 0 a = 0)
(lcm_zero_right : ∀a, lcm a 0 = 0)

export gcd_monoid (gcd lcm gcd_dvd_left gcd_dvd_right dvd_gcd  lcm_zero_left lcm_zero_right)

attribute [simp] lcm_zero_left lcm_zero_right

section gcd_monoid
variables [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]

@[simp] theorem normalize_gcd : ∀a b:α, normalize (gcd a b) = gcd a b :=
gcd_monoid.normalize_gcd

@[simp] theorem gcd_mul_lcm : ∀a b:α, gcd a b * lcm a b = normalize (a * b) :=
gcd_monoid.gcd_mul_lcm

section gcd

theorem dvd_gcd_iff (a b c : α) : a ∣ gcd b c ↔ (a ∣ b ∧ a ∣ c) :=
iff.intro
  (assume h, ⟨dvd_trans h (gcd_dvd_left _ _), dvd_trans h (gcd_dvd_right _ _)⟩)
  (assume ⟨hab, hac⟩, dvd_gcd hab hac)

theorem gcd_comm (a b : α) : gcd a b = gcd b a :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))

theorem gcd_assoc (m n k : α) : gcd (gcd m n) k = gcd m (gcd n k) :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (dvd_gcd
    (dvd.trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_left m n))
    (dvd_gcd (dvd.trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_right m n))
      (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) (dvd.trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_left n k)))
    (dvd.trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_right n k)))

instance : is_commutative α gcd := ⟨gcd_comm⟩
instance : is_associative α gcd := ⟨gcd_assoc⟩

theorem gcd_eq_normalize {a b c : α} (habc : gcd a b ∣ c) (hcab : c ∣ gcd a b) :
  gcd a b = normalize c :=
normalize_gcd a b ▸ normalize_eq_normalize habc hcab

@[simp] theorem gcd_zero_left (a : α) : gcd 0 a = normalize a :=
gcd_eq_normalize (gcd_dvd_right 0 a) (dvd_gcd (dvd_zero _) (dvd_refl a))

@[simp] theorem gcd_zero_right (a : α) : gcd a 0 = normalize a :=
gcd_eq_normalize (gcd_dvd_left a 0) (dvd_gcd (dvd_refl a) (dvd_zero _))

@[simp] theorem gcd_eq_zero_iff (a b : α) : gcd a b = 0 ↔ a = 0 ∧ b = 0 :=
iff.intro
  (assume h, let ⟨ca, ha⟩ := gcd_dvd_left a b, ⟨cb, hb⟩ := gcd_dvd_right a b in
    by rw [h, zero_mul] at ha hb; exact ⟨ha, hb⟩)
  (assume ⟨ha, hb⟩, by rw [ha, hb, gcd_zero_left, normalize_zero])

@[simp] theorem gcd_one_left (a : α) : gcd 1 a = 1 :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) normalize_one (gcd_dvd_left _ _) (one_dvd _)

@[simp] theorem gcd_one_right (a : α) : gcd a 1 = 1 :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) normalize_one (gcd_dvd_right _ _) (one_dvd _)

theorem gcd_dvd_gcd {a b c d: α} (hab : a ∣ b) (hcd : c ∣ d) : gcd a c ∣ gcd b d :=
dvd_gcd (dvd.trans (gcd_dvd_left _ _) hab) (dvd.trans (gcd_dvd_right _ _) hcd)

@[simp] theorem gcd_same (a : α) : gcd a a = normalize a :=
gcd_eq_normalize (gcd_dvd_left _ _) (dvd_gcd (dvd_refl a) (dvd_refl a))

@[simp] theorem gcd_mul_left (a b c : α) : gcd (a * b) (a * c) = normalize a * gcd b c :=
classical.by_cases (by rintro rfl; simp only [zero_mul, gcd_zero_left, normalize_zero]) $
assume ha : a ≠ 0,
suffices gcd (a * b) (a * c) = normalize (a * gcd b c),
  by simpa only [normalize.map_mul, normalize_gcd],
let ⟨d, eq⟩ := dvd_gcd (dvd_mul_right a b) (dvd_mul_right a c) in
gcd_eq_normalize
  (eq.symm ▸ mul_dvd_mul_left a $ show d ∣ gcd b c, from
    dvd_gcd
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_left _ _)
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_right _ _))
  (dvd_gcd
    (mul_dvd_mul_left a $ gcd_dvd_left _ _)
    (mul_dvd_mul_left a $ gcd_dvd_right _ _))

@[simp] theorem gcd_mul_right (a b c : α) : gcd (b * a) (c * a) = gcd b c * normalize a :=
by simp only [mul_comm, gcd_mul_left]

theorem gcd_eq_left_iff (a b : α) (h : normalize a = a) : gcd a b = a ↔ a ∣ b :=
iff.intro (assume eq, eq ▸ gcd_dvd_right _ _) $
  assume hab, dvd_antisymm_of_normalize_eq (normalize_gcd _ _) h (gcd_dvd_left _ _)
    (dvd_gcd (dvd_refl a) hab)

theorem gcd_eq_right_iff (a b : α) (h : normalize b = b) : gcd a b = b ↔ b ∣ a :=
by simpa only [gcd_comm a b] using gcd_eq_left_iff b a h

theorem gcd_dvd_gcd_mul_left (m n k : α) : gcd m n ∣ gcd (k * m) n :=
gcd_dvd_gcd (dvd_mul_left _ _) (dvd_refl _)

theorem gcd_dvd_gcd_mul_right (m n k : α) : gcd m n ∣ gcd (m * k) n :=
gcd_dvd_gcd (dvd_mul_right _ _) (dvd_refl _)

theorem gcd_dvd_gcd_mul_left_right (m n k : α) : gcd m n ∣ gcd m (k * n) :=
gcd_dvd_gcd (dvd_refl _) (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right (m n k : α) : gcd m n ∣ gcd m (n * k) :=
gcd_dvd_gcd (dvd_refl _) (dvd_mul_right _ _)

theorem gcd_eq_of_associated_left {m n : α} (h : associated m n) (k : α) : gcd m k = gcd n k :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (gcd_dvd_gcd (dvd_of_associated h) (dvd_refl _))
  (gcd_dvd_gcd (dvd_of_associated h.symm) (dvd_refl _))

theorem gcd_eq_of_associated_right {m n : α} (h : associated m n) (k : α) : gcd k m = gcd k n :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (gcd_dvd_gcd (dvd_refl _) (dvd_of_associated h))
  (gcd_dvd_gcd (dvd_refl _) (dvd_of_associated h.symm))

lemma dvd_gcd_mul_of_dvd_mul {m n k : α} (H : k ∣ m * n) : k ∣ (gcd k m) * n :=
begin
  transitivity gcd k m * normalize n,
  { rw ← gcd_mul_right,
    exact dvd_gcd (dvd_mul_right _ _) H },
  { apply dvd.intro ↑(norm_unit n)⁻¹,
    rw [normalize_apply, mul_assoc, mul_assoc, ← units.coe_mul],
    simp }
end

lemma dvd_mul_gcd_of_dvd_mul {m n k : α} (H : k ∣ m * n) : k ∣ m * gcd k n :=
by { rw mul_comm at H ⊢, exact dvd_gcd_mul_of_dvd_mul H }

/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`.

 Note: In general, this representation is highly non-unique. -/
lemma exists_dvd_and_dvd_of_dvd_mul {m n k : α} (H : k ∣ m * n) :
  ∃ d₁ (hd₁ : d₁ ∣ m) d₂ (hd₂ : d₂ ∣ n), k = d₁ * d₂ :=
begin
  by_cases h0 : gcd k m = 0,
  { rw gcd_eq_zero_iff at h0,
    rcases h0 with ⟨rfl, rfl⟩,
    refine ⟨0, dvd_refl 0, n, dvd_refl n, _⟩,
    simp },
  { obtain ⟨a, ha⟩ := gcd_dvd_left k m,
    refine ⟨gcd k m, gcd_dvd_right _ _, a, _, ha⟩,
    suffices h : gcd k m * a ∣ gcd k m * n,
    { cases h with b hb,
      use b,
      rw mul_assoc at hb,
      apply mul_left_cancel' h0 hb },
    rw ← ha,
    exact dvd_gcd_mul_of_dvd_mul H }
end

theorem gcd_mul_dvd_mul_gcd (k m n : α) : gcd k (m * n) ∣ gcd k m * gcd k n :=
begin
  obtain ⟨m', hm', n', hn', h⟩ := (exists_dvd_and_dvd_of_dvd_mul $ gcd_dvd_right k (m * n)),
  replace h : gcd k (m * n) = m' * n' := h,
  rw h,
  have hm'n' : m' * n' ∣ k := h ▸ gcd_dvd_left _ _,
  apply mul_dvd_mul,
  { have hm'k : m' ∣ k := dvd_trans (dvd_mul_right m' n') hm'n',
    exact dvd_gcd hm'k hm' },
  { have hn'k : n' ∣ k := dvd_trans (dvd_mul_left n' m') hm'n',
    exact dvd_gcd hn'k hn' }
end

theorem gcd_pow_right_dvd_pow_gcd {a b : α} {k : ℕ} : gcd a (b ^ k) ∣ (gcd a b) ^ k :=
begin
  by_cases hg : gcd a b = 0,
  { rw gcd_eq_zero_iff at hg,
    rcases hg with ⟨rfl, rfl⟩,
    simp },
  { induction k with k hk, simp,
    rw [pow_succ, pow_succ],
    transitivity gcd a b * gcd a (b ^ k),
    apply gcd_mul_dvd_mul_gcd a b (b ^ k),
    refine (mul_dvd_mul_iff_left hg).mpr hk }
end

theorem gcd_pow_left_dvd_pow_gcd {a b : α} {k : ℕ} : gcd (a ^ k) b ∣ (gcd a b) ^ k :=
by { rw [gcd_comm, gcd_comm a b], exact gcd_pow_right_dvd_pow_gcd }

theorem pow_dvd_of_mul_eq_pow {a b c d₁ d₂ : α} (ha : a ≠ 0)
  (hab : gcd a b = 1) {k : ℕ} (h : a * b = c ^ k) (hc : c = d₁ * d₂)
  (hd₁ : d₁ ∣ a) : d₁ ^ k ≠ 0 ∧ d₁ ^ k ∣ a :=
begin
  have h1 : gcd (d₁ ^ k) b = 1,
  { rw ← normalize_gcd (d₁ ^ k) b, rw normalize_eq_one,
    apply is_unit_of_dvd_one,
    transitivity (gcd d₁ b) ^ k,
    { exact gcd_pow_left_dvd_pow_gcd },
    { apply is_unit.dvd, apply is_unit.pow, apply is_unit_of_dvd_one,
      rw ← hab, apply gcd_dvd_gcd hd₁ (dvd_refl b) } },
  have h2 : d₁ ^ k ∣ a * b, { use d₂ ^ k, rw [h, hc], exact mul_pow d₁ d₂ k },
  rw mul_comm at h2,
  have h3 : d₁ ^ k ∣ a, { rw [← one_mul a, ← h1], apply dvd_gcd_mul_of_dvd_mul h2 },
  have h4 : d₁ ^ k ≠ 0,
  { intro hdk, rw hdk at h3, apply absurd (zero_dvd_iff.mp h3) ha },
  tauto
end

theorem exists_associated_pow_of_mul_eq_pow {a b c : α} (hab : gcd a b = 1) {k : ℕ}
  (h : a * b = c ^ k) : ∃ (d : α), associated (d ^ k) a :=
begin
  by_cases ha : a = 0,
  { use 0, rw ha,
    by_cases hk : k = 0,
    { exfalso, revert h, rw [ha, hk, zero_mul, pow_zero], apply zero_ne_one },
    { rw zero_pow (nat.pos_of_ne_zero hk) }},
  by_cases hb : b = 0,
  { rw [hb, gcd_zero_right] at hab, use 1, rw one_pow,
    apply (associated_one_iff_is_unit.mpr (normalize_eq_one.mp hab)).symm },
  by_cases hk : k = 0,
  { use 1, rw [hk, pow_zero] at h ⊢, use units.mk_of_mul_eq_one _ _ h,
    rw [units.coe_mk_of_mul_eq_one, one_mul] },
  have hc : c ∣ a * b, { rw h, refine dvd_pow (dvd_refl c) hk },
  obtain ⟨d₁, hd₁, d₂, hd₂, hc⟩ := exists_dvd_and_dvd_of_dvd_mul hc,
  use d₁,
  obtain ⟨h0₁, ⟨a', ha'⟩⟩ := pow_dvd_of_mul_eq_pow ha hab h hc hd₁,
  rw [mul_comm] at h hc, rw [gcd_comm] at hab,
  obtain ⟨h0₂, ⟨b', hb'⟩⟩ := pow_dvd_of_mul_eq_pow hb hab h hc hd₂,
  rw [ha', hb', hc, mul_pow] at h,
  have h' : a' * b' = 1,
  { apply (mul_right_inj' h0₁).mp, rw mul_one,
    apply (mul_right_inj' h0₂).mp, rw ← h,
    rw [mul_assoc, mul_comm a', ← mul_assoc (d₁ ^ k), ← mul_assoc _ (d₁ ^ k), mul_comm b'] },
  use units.mk_of_mul_eq_one _ _ h',
  rw [units.coe_mk_of_mul_eq_one, ha']
end

end gcd

section lcm

lemma lcm_dvd_iff {a b c : α} : lcm a b ∣ c ↔ a ∣ c ∧ b ∣ c :=
classical.by_cases
  (assume : a = 0 ∨ b = 0, by rcases this with rfl | rfl;
    simp only [iff_def, lcm_zero_left, lcm_zero_right, zero_dvd_iff, dvd_zero,
      eq_self_iff_true, and_true, imp_true_iff] {contextual:=tt})
  (assume this : ¬ (a = 0 ∨ b = 0),
    let ⟨h1, h2⟩ := not_or_distrib.1 this in
    have h : gcd a b ≠ 0, from λ H, h1 ((gcd_eq_zero_iff _ _).1 H).1,
    by rw [← mul_dvd_mul_iff_left h, gcd_mul_lcm, normalize_dvd_iff, ← dvd_normalize_iff,
        normalize.map_mul, normalize_gcd, ← gcd_mul_right, dvd_gcd_iff,
        mul_comm b c, mul_dvd_mul_iff_left h1, mul_dvd_mul_iff_right h2, and_comm])

lemma dvd_lcm_left (a b : α) : a ∣ lcm a b := (lcm_dvd_iff.1 (dvd_refl _)).1

lemma dvd_lcm_right (a b : α) : b ∣ lcm a b := (lcm_dvd_iff.1 (dvd_refl _)).2

lemma lcm_dvd {a b c : α} (hab : a ∣ b) (hcb : c ∣ b) : lcm a c ∣ b :=
lcm_dvd_iff.2 ⟨hab, hcb⟩

@[simp] theorem lcm_eq_zero_iff (a b : α) : lcm a b = 0 ↔ a = 0 ∨ b = 0 :=
iff.intro
  (assume h : lcm a b = 0,
    have normalize (a * b) = 0,
      by rw [← gcd_mul_lcm _ _, h, mul_zero],
    by simpa only [normalize_eq_zero, mul_eq_zero, units.ne_zero, or_false])
  (by rintro (rfl | rfl); [apply lcm_zero_left, apply lcm_zero_right])

@[simp] lemma normalize_lcm (a b : α) : normalize (lcm a b) = lcm a b :=
classical.by_cases (assume : lcm a b = 0, by rw [this, normalize_zero]) $
  assume h_lcm : lcm a b ≠ 0,
  have h1 : gcd a b ≠ 0, from mt (by rw [gcd_eq_zero_iff, lcm_eq_zero_iff];
    rintros ⟨rfl, rfl⟩; left; refl) h_lcm,
  have h2 : normalize (gcd a b * lcm a b) = gcd a b * lcm a b,
    by rw [gcd_mul_lcm, normalize_idem],
  by simpa only [normalize.map_mul, normalize_gcd, one_mul, mul_right_inj' h1] using h2

theorem lcm_comm (a b : α) : lcm a b = lcm b a :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))

theorem lcm_assoc (m n k : α) : lcm (lcm m n) k = lcm m (lcm n k) :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left _ _) (dvd.trans (dvd_lcm_left _ _) (dvd_lcm_right _ _)))
    (dvd.trans (dvd_lcm_right _ _) (dvd_lcm_right _ _)))
  (lcm_dvd
    (dvd.trans (dvd_lcm_left _ _) (dvd_lcm_left _ _))
    (lcm_dvd (dvd.trans (dvd_lcm_right _ _) (dvd_lcm_left _ _)) (dvd_lcm_right _ _)))

instance : is_commutative α lcm := ⟨lcm_comm⟩
instance : is_associative α lcm := ⟨lcm_assoc⟩

lemma lcm_eq_normalize {a b c : α} (habc : lcm a b ∣ c) (hcab : c ∣ lcm a b) :
  lcm a b = normalize c :=
normalize_lcm a b ▸ normalize_eq_normalize habc hcab

theorem lcm_dvd_lcm {a b c d : α} (hab : a ∣ b) (hcd : c ∣ d) : lcm a c ∣ lcm b d :=
lcm_dvd (dvd.trans hab (dvd_lcm_left _ _)) (dvd.trans hcd (dvd_lcm_right _ _))

@[simp] theorem lcm_units_coe_left (u : units α) (a : α) : lcm ↑u a = normalize a :=
lcm_eq_normalize (lcm_dvd units.coe_dvd (dvd_refl _)) (dvd_lcm_right _ _)

@[simp] theorem lcm_units_coe_right (a : α) (u : units α) : lcm a ↑u = normalize a :=
(lcm_comm a u).trans $ lcm_units_coe_left _ _

@[simp] theorem lcm_one_left (a : α) : lcm 1 a = normalize a :=
lcm_units_coe_left 1 a

@[simp] theorem lcm_one_right (a : α) : lcm a 1 = normalize a :=
lcm_units_coe_right a 1

@[simp] theorem lcm_same (a : α) : lcm a a = normalize a :=
lcm_eq_normalize (lcm_dvd (dvd_refl _) (dvd_refl _)) (dvd_lcm_left _ _)

@[simp] theorem lcm_eq_one_iff (a b : α) : lcm a b = 1 ↔ a ∣ 1 ∧ b ∣ 1 :=
iff.intro
  (assume eq, eq ▸ ⟨dvd_lcm_left _ _, dvd_lcm_right _ _⟩)
  (assume ⟨⟨c, hc⟩, ⟨d, hd⟩⟩,
    show lcm (units.mk_of_mul_eq_one a c hc.symm : α) (units.mk_of_mul_eq_one b d hd.symm) = 1,
      by rw [lcm_units_coe_left, normalize_coe_units])

@[simp] theorem lcm_mul_left (a b c : α) : lcm (a * b) (a * c) = normalize a * lcm b c :=
classical.by_cases (by rintro rfl; simp only [zero_mul, lcm_zero_left, normalize_zero]) $
assume ha : a ≠ 0,
suffices lcm (a * b) (a * c) = normalize (a * lcm b c),
  by simpa only [normalize.map_mul, normalize_lcm],
have a ∣ lcm (a * b) (a * c), from dvd.trans (dvd_mul_right _ _) (dvd_lcm_left _ _),
let ⟨d, eq⟩ := this in
lcm_eq_normalize
  (lcm_dvd (mul_dvd_mul_left a (dvd_lcm_left _ _)) (mul_dvd_mul_left a (dvd_lcm_right _ _)))
  (eq.symm ▸ (mul_dvd_mul_left a $ lcm_dvd
    ((mul_dvd_mul_iff_left ha).1 $ eq ▸ dvd_lcm_left _ _)
    ((mul_dvd_mul_iff_left ha).1 $ eq ▸ dvd_lcm_right _ _)))

@[simp] theorem lcm_mul_right (a b c : α) : lcm (b * a) (c * a) = lcm b c * normalize a :=
by simp only [mul_comm, lcm_mul_left]

theorem lcm_eq_left_iff (a b : α) (h : normalize a = a) : lcm a b = a ↔ b ∣ a :=
iff.intro (assume eq, eq ▸ dvd_lcm_right _ _) $
  assume hab, dvd_antisymm_of_normalize_eq (normalize_lcm _ _) h (lcm_dvd (dvd_refl a) hab)
    (dvd_lcm_left _ _)

theorem lcm_eq_right_iff (a b : α) (h : normalize b = b) : lcm a b = b ↔ a ∣ b :=
by simpa only [lcm_comm b a] using lcm_eq_left_iff b a h

theorem lcm_dvd_lcm_mul_left (m n k : α) : lcm m n ∣ lcm (k * m) n :=
lcm_dvd_lcm (dvd_mul_left _ _) (dvd_refl _)

theorem lcm_dvd_lcm_mul_right (m n k : α) : lcm m n ∣ lcm (m * k) n :=
lcm_dvd_lcm (dvd_mul_right _ _) (dvd_refl _)

theorem lcm_dvd_lcm_mul_left_right (m n k : α) : lcm m n ∣ lcm m (k * n) :=
lcm_dvd_lcm (dvd_refl _) (dvd_mul_left _ _)

theorem lcm_dvd_lcm_mul_right_right (m n k : α) : lcm m n ∣ lcm m (n * k) :=
lcm_dvd_lcm (dvd_refl _) (dvd_mul_right _ _)

theorem lcm_eq_of_associated_left {m n : α} (h : associated m n) (k : α) : lcm m k = lcm n k :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd_lcm (dvd_of_associated h) (dvd_refl _))
  (lcm_dvd_lcm (dvd_of_associated h.symm) (dvd_refl _))

theorem lcm_eq_of_associated_right {m n : α} (h : associated m n) (k : α) : lcm k m = lcm k n :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd_lcm (dvd_refl _) (dvd_of_associated h))
  (lcm_dvd_lcm (dvd_refl _) (dvd_of_associated h.symm))

end lcm

namespace gcd_monoid
theorem prime_of_irreducible {x : α} (hi: irreducible x) : prime x :=
⟨hi.ne_zero, ⟨hi.1, λ a b h,
begin
  cases gcd_dvd_left x a with y hy,
  cases hi.is_unit_or_is_unit hy with hu hu; cases hu with u hu,
  { right, transitivity (gcd (x * b) (a * b)), apply dvd_gcd (dvd_mul_right x b) h,
    rw gcd_mul_right, rw ← hu,
    apply dvd_of_associated, transitivity (normalize b), symmetry, use u, apply mul_comm,
    apply normalize_associated, },
  { left, rw [hy, ← hu],
    transitivity, {apply dvd_of_associated, symmetry, use u}, apply gcd_dvd_right, }
end ⟩⟩

theorem irreducible_iff_prime {p : α} : irreducible p ↔ prime p :=
⟨prime_of_irreducible, irreducible_of_prime⟩

end gcd_monoid
end gcd_monoid

section unique_unit

variables [comm_cancel_monoid_with_zero α] [unique (units α)]

lemma units_eq_one (u : units α) : u = 1 := subsingleton.elim u 1

variable [nontrivial α]

@[priority 100] -- see Note [lower instance priority]
instance normalization_monoid_of_unique_units : normalization_monoid α :=
{ norm_unit := λ x, 1,
  norm_unit_zero := rfl,
  norm_unit_mul := λ x y hx hy, (mul_one 1).symm,
  norm_unit_coe_units := λ u, subsingleton.elim _ _ }

@[simp] lemma norm_unit_eq_one (x : α) : norm_unit x = 1 := rfl

@[simp] lemma normalize_eq (x : α) : normalize x = x := mul_one x

end unique_unit

section integral_domain

variables [integral_domain α] [gcd_monoid α]

lemma gcd_eq_of_dvd_sub_right {a b c : α} (h : a ∣ b - c) : gcd a b = gcd a c :=
begin
  apply dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _);
  rw dvd_gcd_iff; refine ⟨gcd_dvd_left _ _, _⟩,
  { rcases h with ⟨d, hd⟩,
    rcases gcd_dvd_right a b with ⟨e, he⟩,
    rcases gcd_dvd_left a b with ⟨f, hf⟩,
    use e - f * d,
    rw [mul_sub, ← he, ← mul_assoc, ← hf, ← hd, sub_sub_cancel] },
  { rcases h with ⟨d, hd⟩,
    rcases gcd_dvd_right a c with ⟨e, he⟩,
    rcases gcd_dvd_left a c with ⟨f, hf⟩,
    use e + f * d,
    rw [mul_add, ← he, ← mul_assoc, ← hf, ← hd, ← add_sub_assoc, add_comm c b, add_sub_cancel] }
end

lemma gcd_eq_of_dvd_sub_left {a b c : α} (h : a ∣ b - c) : gcd b a = gcd c a :=
by rw [gcd_comm _ a, gcd_comm _ a, gcd_eq_of_dvd_sub_right h]

end integral_domain

section constructors
noncomputable theory

open associates

variables [comm_cancel_monoid_with_zero α] [nontrivial α]

private lemma map_mk_unit_aux [decidable_eq α] {f : associates α →* α}
  (hinv : function.right_inverse f associates.mk) (a : α) :
    a * ↑(classical.some (associated_map_mk hinv a)) = f (associates.mk a) :=
classical.some_spec (associated_map_mk hinv a)

/-- Define `normalization_monoid` on a structure from a `monoid_hom` inverse to `associates.mk`. -/
def normalization_monoid_of_monoid_hom_right_inverse [decidable_eq α] (f : associates α →* α)
  (hinv : function.right_inverse f associates.mk) :
  normalization_monoid α :=
{ norm_unit := λ a, if a = 0 then 1 else
    classical.some (associates.mk_eq_mk_iff_associated.1 (hinv (associates.mk a)).symm),
  norm_unit_zero := if_pos rfl,
  norm_unit_mul := λ a b ha hb, by {
    rw [if_neg (mul_ne_zero ha hb), if_neg ha, if_neg hb, units.ext_iff, units.coe_mul],
    suffices : (a * b) * ↑(classical.some (associated_map_mk hinv (a * b))) =
      (a * ↑(classical.some (associated_map_mk hinv a))) *
      (b * ↑(classical.some (associated_map_mk hinv b))),
    { apply mul_left_cancel' (mul_ne_zero ha hb) _,
      simpa only [mul_assoc, mul_comm, mul_left_comm] using this },
    rw [map_mk_unit_aux hinv a, map_mk_unit_aux hinv (a * b), map_mk_unit_aux hinv b,
        ← monoid_hom.map_mul, associates.mk_mul_mk] },
  norm_unit_coe_units := λ u, by {
    rw [if_neg (units.ne_zero u), units.ext_iff],
    apply mul_left_cancel' (units.ne_zero u),
    rw [units.mul_inv, map_mk_unit_aux hinv u,
      associates.mk_eq_mk_iff_associated.2 (associated_one_iff_is_unit.2 ⟨u, rfl⟩),
      associates.mk_one, monoid_hom.map_one] } }

variable [normalization_monoid α]

/-- Define `gcd_monoid` on a structure just from the `gcd` and its properties. -/
noncomputable def gcd_monoid_of_gcd [decidable_eq α] (gcd : α → α → α)
  (gcd_dvd_left   : ∀a b, gcd a b ∣ a)
  (gcd_dvd_right  : ∀a b, gcd a b ∣ b)
  (dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b)
  (normalize_gcd  : ∀a b, normalize (gcd a b) = gcd a b) :
  gcd_monoid α :=
{ gcd := gcd,
  gcd_dvd_left := gcd_dvd_left,
  gcd_dvd_right := gcd_dvd_right,
  dvd_gcd := λ a b c, dvd_gcd,
  normalize_gcd := normalize_gcd,
  lcm := λ a b, if a = 0 then 0 else classical.some (dvd_normalize_iff.2
          (dvd.trans (gcd_dvd_left a b) (dvd.intro b rfl))),
  gcd_mul_lcm := λ a b, by {
    split_ifs with a0,
    { rw [mul_zero, a0, zero_mul, normalize_zero] },
    { exact (classical.some_spec (dvd_normalize_iff.2
                  (dvd.trans (gcd_dvd_left a b) (dvd.intro b rfl)))).symm } },
  lcm_zero_left := λ a, if_pos rfl,
  lcm_zero_right := λ a, by {
    split_ifs with a0, { refl },
    rw ← normalize_eq_zero at a0,
    have h := (classical.some_spec (dvd_normalize_iff.2
                  (dvd.trans (gcd_dvd_left a 0) (dvd.intro 0 rfl)))).symm,
    have gcd0 : gcd a 0 = normalize a,
    { rw ← normalize_gcd,
      exact normalize_eq_normalize (gcd_dvd_left _ _) (dvd_gcd (dvd_refl a) (dvd_zero a)) },
    rw ← gcd0 at a0,
    apply or.resolve_left (mul_eq_zero.1 _) a0,
    rw [h, mul_zero, normalize_zero] },
  .. (infer_instance : normalization_monoid α) }

/-- Define `gcd_monoid` on a structure just from the `lcm` and its properties. -/
noncomputable def gcd_monoid_of_lcm [decidable_eq α] (lcm : α → α → α)
  (dvd_lcm_left   : ∀a b, a ∣ lcm a b)
  (dvd_lcm_right  : ∀a b, b ∣ lcm a b)
  (lcm_dvd        : ∀{a b c}, c ∣ a → b ∣ a → lcm c b ∣ a)
  (normalize_lcm  : ∀a b, normalize (lcm a b) = lcm a b) :
  gcd_monoid α :=
let exists_gcd := λ a b, dvd_normalize_iff.2 (lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl)) in
{ lcm := lcm,
  gcd := λ a b, if a = 0 then normalize b else (if b = 0 then normalize a else
    classical.some (exists_gcd a b)),
  gcd_mul_lcm := λ a b, by {
    split_ifs,
    { rw [h, zero_dvd_iff.1 (dvd_lcm_left _ _), mul_zero, zero_mul, normalize_zero] },
    { rw [h_1, zero_dvd_iff.1 (dvd_lcm_right _ _), mul_zero, mul_zero, normalize_zero] },
    apply eq.trans (mul_comm _ _) (classical.some_spec
      (dvd_normalize_iff.2 (lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl)))).symm },
  normalize_gcd := λ a b, by {
    split_ifs,
    { apply normalize_idem },
    { apply normalize_idem },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    apply mul_left_cancel' h0,
    refine trans _ (classical.some_spec (exists_gcd a b)),
    conv_lhs { congr, rw [← normalize_lcm a b] },
    erw [← normalize.map_mul, ← classical.some_spec (exists_gcd a b), normalize_idem] },
  lcm_zero_left := λ a, zero_dvd_iff.1 (dvd_lcm_left _ _),
  lcm_zero_right := λ a, zero_dvd_iff.1 (dvd_lcm_right _ _),
  gcd_dvd_left := λ a b, by {
    split_ifs,
    { rw h, apply dvd_zero },
    { apply dvd_of_associated normalize_associated },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        normalize_dvd_iff, mul_comm, mul_dvd_mul_iff_right h],
    apply dvd_lcm_right },
  gcd_dvd_right := λ a b, by {
    split_ifs,
    { apply dvd_of_associated normalize_associated },
    { rw h_1, apply dvd_zero },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        normalize_dvd_iff, mul_dvd_mul_iff_right h_1],
    apply dvd_lcm_left },
  dvd_gcd := λ a b c ac ab, by {
    split_ifs,
    { apply dvd_normalize_iff.2 ab },
    { apply dvd_normalize_iff.2 ac },
    have h0 : lcm c b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left c rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (dvd_normalize_iff.2
        (lcm_dvd (dvd.intro b rfl) (dvd.intro_left c rfl))), dvd_normalize_iff],
    rcases ab with ⟨d, rfl⟩,
    rw mul_eq_zero at h_1,
    push_neg at h_1,
    rw [mul_comm a, ← mul_assoc, mul_dvd_mul_iff_right h_1.1],
    apply lcm_dvd (dvd.intro d rfl),
    rw [mul_comm, mul_dvd_mul_iff_right h_1.2],
    apply ac },
  .. (infer_instance : normalization_monoid α) }

/-- Define a `gcd_monoid` structure on a monoid just from the existence of a `gcd`. -/
noncomputable def gcd_monoid_of_exists_gcd [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, d ∣ a ∧ d ∣ b ↔ d ∣ c) :
  gcd_monoid α :=
gcd_monoid_of_gcd
  (λ a b, normalize (classical.some (h a b)))
  (λ a b, normalize_dvd_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 (dvd_refl _))).1)
  (λ a b, normalize_dvd_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 (dvd_refl _))).2)
  (λ a b c ac ab, dvd_normalize_iff.2 ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))
  (λ a b, normalize_idem _)

/-- Define a `gcd_monoid` structure on a monoid just from the existence of an `lcm`. -/
noncomputable def gcd_monoid_of_exists_lcm [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, a ∣ d ∧ b ∣ d ↔ c ∣ d) :
  gcd_monoid α :=
gcd_monoid_of_lcm
  (λ a b, normalize (classical.some (h a b)))
  (λ a b, dvd_normalize_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 (dvd_refl _))).1)
  (λ a b, dvd_normalize_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 (dvd_refl _))).2)
  (λ a b c ac ab, normalize_dvd_iff.2 ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))
  (λ a b, normalize_idem _)

/-- `ℕ` is a `gcd_monoid` -/
instance : gcd_monoid ℕ :=
{ gcd                 := nat.gcd,
  lcm                 := nat.lcm,
  gcd_dvd_left        := nat.gcd_dvd_left,
  gcd_dvd_right       := nat.gcd_dvd_right,
  dvd_gcd             := λ _ _ _, nat.dvd_gcd,
  normalize_gcd       := λ a b, nat.mul_one (a.gcd b),
  gcd_mul_lcm         := λ a b, (a.gcd_mul_lcm b).trans (mul_one (a * b)).symm,
  lcm_zero_left       := nat.lcm_zero_left,
  lcm_zero_right      := nat.lcm_zero_right,
  norm_unit           := λ _, 1,
  norm_unit_zero      := rfl,
  norm_unit_mul       := λ _ _ _ _, rfl,
  norm_unit_coe_units := λ u, eq_inv_of_eq_inv
    (by rw [one_inv, units.ext_iff, units.coe_one, nat.is_unit_iff.mp u.is_unit]) }

@[simp] lemma nat.normalize_eq (n : ℕ) : normalize n = n := n.mul_one

lemma nat.gcd_eq_gcd (m n : ℕ) : gcd m n = nat.gcd m n := rfl

lemma nat.lcm_eq_lcm (m n : ℕ) : lcm m n = nat.lcm m n := rfl

end constructors


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.convex.topology
/-!
# Locally convex topological modules

A `locally_convex_space` is a topological semimodule over an ordered semiring in which any point
admits a neighborhood basis made of convex sets, or equivalently, in which convex neighborhoods of
a point form a neighborhood basis at that point.

In a module, this is equivalent to `0` satisfying such properties.

## Main results

- `locally_convex_space_iff_zero` : in a module, local convexity at zero gives
  local convexity everywhere
- `seminorm.locally_convex_space` : a topology generated by a family of seminorms is locally convex
- `normed_space.locally_convex_space` : a normed space is locally convex

## TODO

- define a structure `locally_convex_filter_basis`, extending `module_filter_basis`, for filter
  bases generating a locally convex topology
- show that any locally convex topology is generated by a family of seminorms

-/

open topological_space filter

open_locale topological_space

section semimodule

/-- A `locally_convex_space` is a topological semimodule over an ordered semiring in which convex
neighborhoods of a point form a neighborhood basis at that point. -/
class locally_convex_space (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E]
  [topological_space E] : Prop :=
(convex_basis : ∀ x : E, (𝓝 x).has_basis (λ (s : set E), s ∈ 𝓝 x ∧ convex 𝕜 s) id)

variables (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] [topological_space E]

lemma locally_convex_space_iff :
  locally_convex_space 𝕜 E ↔
  ∀ x : E, (𝓝 x).has_basis (λ (s : set E), s ∈ 𝓝 x ∧ convex 𝕜 s) id :=
⟨@locally_convex_space.convex_basis _ _ _ _ _ _, locally_convex_space.mk⟩

lemma locally_convex_space.of_bases {ι : Type*} (b : E → ι → set E) (p : ι → Prop)
  (hbasis : ∀ x : E, (𝓝 x).has_basis p (b x)) (hconvex : ∀ x i, p i → convex 𝕜 (b x i)) :
  locally_convex_space 𝕜 E :=
⟨λ x, (hbasis x).to_has_basis
  (λ i hi, ⟨b x i, ⟨⟨(hbasis x).mem_of_mem hi, hconvex x i hi⟩, le_refl (b x i)⟩⟩)
  (λ s hs, ⟨(hbasis x).index s hs.1,
    ⟨(hbasis x).property_index hs.1, (hbasis x).set_index_subset hs.1⟩⟩)⟩

lemma locally_convex_space.convex_basis_zero [locally_convex_space 𝕜 E] :
  (𝓝 0 : filter E).has_basis (λ s, s ∈ (𝓝 0 : filter E) ∧ convex 𝕜 s) id :=
locally_convex_space.convex_basis 0

lemma locally_convex_space_iff_exists_convex_subset :
  locally_convex_space 𝕜 E ↔ ∀ x : E, ∀ U ∈ 𝓝 x, ∃ S ∈ 𝓝 x, convex 𝕜 S ∧ S ⊆ U :=
(locally_convex_space_iff 𝕜 E).trans (forall_congr $ λ x, has_basis_self)

end semimodule

section module

variables (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E]
  [topological_add_group E]

lemma locally_convex_space.of_basis_zero {ι : Type*} (b : ι → set E) (p : ι → Prop)
  (hbasis : (𝓝 0).has_basis p b) (hconvex : ∀ i, p i → convex 𝕜 (b i)) :
  locally_convex_space 𝕜 E :=
begin
  refine locally_convex_space.of_bases 𝕜 E (λ (x : E) (i : ι), ((+) x) '' b i) p (λ x, _)
    (λ x i hi, (hconvex i hi).translate x),
  rw ← map_add_left_nhds_zero,
  exact hbasis.map _
end

lemma locally_convex_space_iff_zero :
  locally_convex_space 𝕜 E ↔
  (𝓝 0 : filter E).has_basis (λ (s : set E), s ∈ (𝓝 0 : filter E) ∧ convex 𝕜 s) id :=
⟨λ h, @locally_convex_space.convex_basis _ _ _ _ _ _ h 0,
 λ h, locally_convex_space.of_basis_zero 𝕜 E _ _ h (λ s, and.right)⟩

lemma locally_convex_space_iff_exists_convex_subset_zero :
  locally_convex_space 𝕜 E ↔
  ∀ U ∈ (𝓝 0 : filter E), ∃ S ∈ (𝓝 0 : filter E), convex 𝕜 S ∧ S ⊆ U :=
(locally_convex_space_iff_zero 𝕜 E).trans has_basis_self

end module


lemma add_right_eq_zero {a b : mynat} : a + b = 0 → a = 0 :=
begin
cases a with d,
intro h,
refl,
intro h,
rw succ_add at h,
exfalso,
apply succ_ne_zero (d + b),
exact h,
end


import tactic
import data.set.basic

-- Usually a family of sets is represented as a term
-- `f: F → set α`, but this leads to difficulties
-- composing `cl` twice. Thus I represent a family of sets
-- as a term of type `set (set α)` at the outset.

-- Writing out the definition is half the problem solved.
def cl {α : Type*} (F : set (set α)) : set (set α) :=
  {S : set α | ∃ (X ∈ F), S ⊆ X}

example {α : Type*} (F : set (set α)) : cl (cl F) = cl F :=
begin
  ext, split; intros hx,
  { obtain ⟨S, hS, hxS⟩ := hx,
    obtain ⟨T, hT, hST⟩ := hS,
    use T,
    exact ⟨hT, subset_trans hxS hST⟩ },
  { obtain ⟨S, hS, hxS⟩ := hx,
    use S,
    exact ⟨exists.intro S ⟨hS, subset_refl _⟩, hxS⟩ }
end


import algebra.ring
import algebra.group_power group_theory.submonoid
import algebra.geom_sum commutative_algebra.nilpotent

universe u
variables {A : Type u} [comm_ring A]

namespace commutative_algebra

def is_regular (a : A) : Prop := ∀ (x : A), a * x = 0 → x = 0

variable (A)
lemma is_regular_one : is_regular (1 : A) := λ x h, (one_mul x) ▸ h
variable {A}

lemma is_regular_mul_iff {a b : A} :
  is_regular (a * b) ↔ (is_regular a) ∧ (is_regular b) :=
begin
  split,
  { intro hab,split,
    { intros x e,
      have e' : (a * b) * x = b * (a * x) := by rw [mul_comm a b, mul_assoc],
      rw [e, mul_zero] at e',
      exact hab _ e' },
    { intros x e,
      have e' : (a * b) * x = a * (b * x) := mul_assoc a b x,
      rw [e, mul_zero] at e',
      exact hab _ e' } },
  { rintro ⟨ha,hb⟩ x e,
    rw [mul_assoc] at e,
    replace e := ha (b * x) e,
    replace e := hb x e,
    exact e }
end

lemma is_regular_pow_iff {a : A} {n : ℕ} :
 is_regular (a ^ (n + 1)) ↔ is_regular a :=
begin
 induction n with n ih,
 {rw[zero_add,pow_one]},
 {rw[pow_succ,is_regular_mul_iff,ih,and_self]}
end

def as_zero_divisor (a : A) := {x : A // a * x = 0 ∧ x ≠ 0}

inductive is_zero_divisor (a : A) : Prop
| mk : (as_zero_divisor a) → is_zero_divisor

def is_zero_divisor_iff_not_regular {a : A} :
 (is_zero_divisor a) ↔ (¬ is_regular a) :=
⟨ λ ha hr, by { rcases ha with ⟨x,hax,hx⟩, exact hx (hr x hax) },
  λ hnr, by { haveI := classical.dec,
              rcases (not_forall.mp hnr) with ⟨x,hx⟩,
              by_cases hxz : x = 0,
              { exfalso, exact hx (λ _,hxz) },
              { by_cases hax : a * x = 0,
                { exact ⟨⟨x,⟨hax,hxz⟩⟩⟩ },
                { exfalso, exact hx (λ hax', (hax hax').elim) } } } ⟩

variable (A)
def regular : submonoid A := {
 carrier := is_regular,
 one_mem' := is_regular_one A,
 mul_mem' := λ a b ha hb x hx, hb x (ha (b * x) ((mul_assoc a b x) ▸ hx))
}
variable {A}

namespace units

def to_regular : (units A) →* (regular A) := {
 to_fun := λ u, ⟨u, λ x hx, begin
  rw[← (one_mul x), ← u.inv_mul, mul_assoc, hx, mul_zero]
 end⟩,
 map_one' := rfl,
 map_mul' := λ u v, by { ext, refl }
}

instance : has_coe (units A) (regular A) := ⟨to_regular⟩

end units

namespace regular

def coe_hom : (regular A) →* A := {
 to_fun := coe,
 map_one' := by refl,
 map_mul' := λ a b, by refl
}

lemma coe_coe_unit (u : units A) : ((u : regular A) : A) = u := rfl

lemma add_nilpotent_aux {a b : A} (ha : is_regular a) (hb : is_nilpotent b) :
 is_regular (a + b) :=
begin
  rcases hb  with ⟨⟨n,hn⟩⟩,
  replace ha : is_regular (a ^ n) :=
  by { cases n with m,
       { rw [pow_zero], exact is_regular_one A },
       { exact is_regular_pow_iff.mpr ha } },
  let u := (finset.range n).sum (λ i, a ^ i * (- b) ^ (n - 1 - i)),
  have hu : u * (a - (-b)) = a ^ n - (- b) ^ n := geom_sum₂_mul a (- b) n,
  rw [sub_neg_eq_add, ← neg_one_mul, mul_pow, hn, mul_zero, sub_zero] at hu,
  rw[← hu] at ha,
  exact (is_regular_mul_iff.mp ha).right
end

def add_nilpotent (a : regular A) (b : nilradical A) : regular A :=
⟨a + b, add_nilpotent_aux a.property b.property⟩

lemma not_nilpotent_aux {a : A} (ha : is_regular a)
  {n : ℕ} (hn : a ^ n = 0) : (1 : A) = 0 :=
begin
  induction n with n ih,
  { exact (pow_zero a) ▸ hn },
  { rw[pow_succ] at hn, exact ih (ha _ hn) }
end

lemma not_nilpotent (zero_ne_one : (0 : A) ≠ (1 : A)) {a : A}
  (ha : is_regular a) : ¬ (is_nilpotent a) :=
begin
  rintro ⟨⟨n,hn⟩⟩,
  exact zero_ne_one.symm (not_nilpotent_aux ha hn)
end

end regular

end commutative_algebra


theorem le_of_not_lt {a b : Nat} (_: ¬ a < b): b ≤ a := sorry
theorem lt_of_succ_lt          (_: a + 1 < b): a < b := sorry
theorem succ_pred_eq_of_pos        (_: 0 < v): v - 1 + 1 = v := sorry

set_option trace.Meta.Tactic.simp true
--set_option trace.Debug.Meta.Tactic.simp true

example (h₁: k ≤ v - 1) (h₂: 0 < v):
    (if k ≤ v - 1 then Fin.mk (v-1+1) sorry else Fin.mk (v-1) sorry) = Fin.mk v sorry (n:=n) := by
    simp only [
      h₁, h₂,
      ite_true,
      succ_pred_eq_of_pos
      ----------------
      , le_of_not_lt
      , lt_of_succ_lt
    ]

-- it works

example (h₁: k ≤ v - 1) (h₂: 0 < v):
    (if k ≤ v - 1 then Fin.mk (v-1+1) sorry else Fin.mk (v-1) sorry) = Fin.mk v sorry (n:=n) := by
    simp (config := { memoize := false}) only [
      h₁, h₂,
      ite_true,
      succ_pred_eq_of_pos
      ----------------
      , le_of_not_lt
      , lt_of_succ_lt
    ]

example (h₁: k ≤ v - 1) (h₂: 0 < v):
    (if k ≤ v - 1 then Fin.mk (v-1+1) sorry else Fin.mk (v-1) sorry) = Fin.mk v sorry (n:=n) := by
    simp only [
      h₁, h₂,
      ite_true,
      succ_pred_eq_of_pos
      ----------------
      --, le_of_not_lt
      --, lt_of_succ_lt
    ]


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

! This file was ported from Lean 3 source module init.data.nat.bitwise
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Nat.Lemmas
import Leanbin.Init.Meta.WellFoundedTactics

universe u

namespace Nat

#print Nat.boddDiv2 /-
def boddDiv2 : ℕ → Bool × ℕ
  | 0 => (false, 0)
  | succ n =>
    match bodd_div2 n with
    | (ff, m) => (true, m)
    | (tt, m) => (false, succ m)
#align nat.bodd_div2 Nat.boddDiv2
-/

#print Nat.div2 /-
def div2 (n : ℕ) : ℕ :=
  (boddDiv2 n).2
#align nat.div2 Nat.div2
-/

#print Nat.bodd /-
def bodd (n : ℕ) : Bool :=
  (boddDiv2 n).1
#align nat.bodd Nat.bodd
-/

#print Nat.bodd_zero /-
@[simp]
theorem bodd_zero : bodd 0 = false :=
  rfl
#align nat.bodd_zero Nat.bodd_zero
-/

#print Nat.bodd_one /-
theorem bodd_one : bodd 1 = true :=
  rfl
#align nat.bodd_one Nat.bodd_one
-/

#print Nat.bodd_two /-
theorem bodd_two : bodd 2 = false :=
  rfl
#align nat.bodd_two Nat.bodd_two
-/

#print Nat.bodd_succ /-
@[simp]
theorem bodd_succ (n : ℕ) : bodd (succ n) = not (bodd n) := by
  unfold bodd bodd_div2 <;> cases bodd_div2 n <;> cases fst <;> rfl
#align nat.bodd_succ Nat.bodd_succ
-/

#print Nat.bodd_add /-
@[simp]
theorem bodd_add (m n : ℕ) : bodd (m + n) = xor (bodd m) (bodd n) :=
  by
  induction' n with n IH
  · simp
    cases bodd m <;> rfl
  · simp [add_succ, IH]
    cases bodd m <;> cases bodd n <;> rfl
#align nat.bodd_add Nat.bodd_add
-/

#print Nat.bodd_mul /-
@[simp]
theorem bodd_mul (m n : ℕ) : bodd (m * n) = (bodd m && bodd n) :=
  by
  induction' n with n IH
  · simp
    cases bodd m <;> rfl
  · simp [mul_succ, IH]
    cases bodd m <;> cases bodd n <;> rfl
#align nat.bodd_mul Nat.bodd_mul
-/

#print Nat.mod_two_of_bodd /-
theorem mod_two_of_bodd (n : ℕ) : n % 2 = cond (bodd n) 1 0 :=
  by
  have := congr_arg bodd (mod_add_div n 2)
  simp [not] at this
  rw [show ∀ b, (ff && b) = ff by intros <;> cases b <;> rfl,
    show ∀ b, xor b ff = b by intros <;> cases b <;> rfl] at this
  rw [← this]
  cases' mod_two_eq_zero_or_one n with h h <;> rw [h] <;> rfl
#align nat.mod_two_of_bodd Nat.mod_two_of_bodd
-/

#print Nat.div2_zero /-
@[simp]
theorem div2_zero : div2 0 = 0 :=
  rfl
#align nat.div2_zero Nat.div2_zero
-/

#print Nat.div2_one /-
theorem div2_one : div2 1 = 0 :=
  rfl
#align nat.div2_one Nat.div2_one
-/

#print Nat.div2_two /-
theorem div2_two : div2 2 = 1 :=
  rfl
#align nat.div2_two Nat.div2_two
-/

#print Nat.div2_succ /-
@[simp]
theorem div2_succ (n : ℕ) : div2 (succ n) = cond (bodd n) (succ (div2 n)) (div2 n) := by
  unfold bodd div2 bodd_div2 <;> cases bodd_div2 n <;> cases fst <;> rfl
#align nat.div2_succ Nat.div2_succ
-/

attribute [local simp] Nat.add_comm Nat.add_assoc Nat.add_left_comm Nat.mul_comm Nat.mul_assoc

#print Nat.bodd_add_div2 /-
theorem bodd_add_div2 : ∀ n, cond (bodd n) 1 0 + 2 * div2 n = n
  | 0 => rfl
  | succ n => by
    simp
    refine' Eq.trans _ (congr_arg succ (bodd_add_div2 n))
    cases bodd n <;> simp [cond, not]
    · rw [Nat.add_comm, Nat.zero_add]
    · rw [succ_mul, Nat.add_comm 1, Nat.zero_add]
#align nat.bodd_add_div2 Nat.bodd_add_div2
-/

#print Nat.div2_val /-
theorem div2_val (n) : div2 n = n / 2 :=
  by
  refine'
    Nat.eq_of_mul_eq_mul_left (by decide)
      (Nat.add_left_cancel (Eq.trans _ (Nat.mod_add_div n 2).symm))
  rw [mod_two_of_bodd, bodd_add_div2]
#align nat.div2_val Nat.div2_val
-/

#print Nat.bit /-
def bit (b : Bool) : ℕ → ℕ :=
  cond b bit1 bit0
#align nat.bit Nat.bit
-/

#print Nat.bit0_val /-
theorem bit0_val (n : Nat) : bit0 n = 2 * n :=
  calc
    n + n = 0 + n + n := by rw [Nat.zero_add]
    _ = n * 2 := rfl
    _ = 2 * n := Nat.mul_comm _ _

#align nat.bit0_val Nat.bit0_val
-/

#print Nat.bit1_val /-
theorem bit1_val (n : Nat) : bit1 n = 2 * n + 1 :=
  congr_arg succ (bit0_val _)
#align nat.bit1_val Nat.bit1_val
-/

#print Nat.bit_val /-
theorem bit_val (b n) : bit b n = 2 * n + cond b 1 0 :=
  by
  cases b
  apply bit0_val
  apply bit1_val
#align nat.bit_val Nat.bit_val
-/

#print Nat.bit_decomp /-
theorem bit_decomp (n : Nat) : bit (bodd n) (div2 n) = n :=
  (bit_val _ _).trans <| (Nat.add_comm _ _).trans <| bodd_add_div2 _
#align nat.bit_decomp Nat.bit_decomp
-/

#print Nat.bitCasesOn /-
def bitCasesOn {C : Nat → Sort u} (n) (h : ∀ b n, C (bit b n)) : C n := by
  rw [← bit_decomp n] <;> apply h
#align nat.bit_cases_on Nat.bitCasesOn
-/

#print Nat.bit_zero /-
theorem bit_zero : bit false 0 = 0 :=
  rfl
#align nat.bit_zero Nat.bit_zero
-/

#print Nat.shiftl' /-
def shiftl' (b : Bool) (m : ℕ) : ℕ → ℕ
  | 0 => m
  | n + 1 => bit b (shiftl' n)
#align nat.shiftl' Nat.shiftl'
-/

#print Nat.shiftl /-
def shiftl : ℕ → ℕ → ℕ :=
  shiftl' false
#align nat.shiftl Nat.shiftl
-/

#print Nat.shiftl_zero /-
@[simp]
theorem shiftl_zero (m) : shiftl m 0 = m :=
  rfl
#align nat.shiftl_zero Nat.shiftl_zero
-/

#print Nat.shiftl_succ /-
@[simp]
theorem shiftl_succ (m n) : shiftl m (n + 1) = bit0 (shiftl m n) :=
  rfl
#align nat.shiftl_succ Nat.shiftl_succ
-/

#print Nat.shiftr /-
def shiftr : ℕ → ℕ → ℕ
  | m, 0 => m
  | m, n + 1 => div2 (shiftr m n)
#align nat.shiftr Nat.shiftr
-/

#print Nat.testBit /-
def testBit (m n : ℕ) : Bool :=
  bodd (shiftr m n)
#align nat.test_bit Nat.testBit
-/

#print Nat.binaryRec /-
def binaryRec {C : Nat → Sort u} (z : C 0) (f : ∀ b n, C n → C (bit b n)) : ∀ n, C n
  | n =>
    if n0 : n = 0 then by rw [n0] <;> exact z
    else by
      let n' := div2 n
      have : n' < n := by
        change div2 n < n; rw [div2_val]
        apply (div_lt_iff_lt_mul <| succ_pos 1).2
        have := Nat.mul_lt_mul_of_pos_left (lt_succ_self 1) (lt_of_le_of_ne n.zero_le (Ne.symm n0))
        rwa [Nat.mul_one] at this
      rw [← show bit (bodd n) n' = n from bit_decomp n] <;> exact f (bodd n) n' (binary_rec n')
#align nat.binary_rec Nat.binaryRec
-/

#print Nat.size /-
def size : ℕ → ℕ :=
  binaryRec 0 fun _ _ => succ
#align nat.size Nat.size
-/

#print Nat.bits /-
def bits : ℕ → List Bool :=
  binaryRec [] fun b _ IH => b :: IH
#align nat.bits Nat.bits
-/

#print Nat.bitwise' /-
def bitwise' (f : Bool → Bool → Bool) : ℕ → ℕ → ℕ :=
  binaryRec (fun n => cond (f false true) n 0) fun a m Ia =>
    binaryRec (cond (f true false) (bit a m) 0) fun b n _ => bit (f a b) (Ia n)
#align nat.bitwise Nat.bitwise'
-/

#print Nat.lor' /-
def lor' : ℕ → ℕ → ℕ :=
  bitwise' or
#align nat.lor Nat.lor'
-/

#print Nat.land' /-
def land' : ℕ → ℕ → ℕ :=
  bitwise' and
#align nat.land Nat.land'
-/

#print Nat.ldiff' /-
def ldiff' : ℕ → ℕ → ℕ :=
  bitwise' fun a b => a && not b
#align nat.ldiff Nat.ldiff'
-/

#print Nat.lxor' /-
def lxor' : ℕ → ℕ → ℕ :=
  bitwise' xor
#align nat.lxor Nat.lxor'
-/

#print Nat.binaryRec_zero /-
@[simp]
theorem binaryRec_zero {C : Nat → Sort u} (z : C 0) (f : ∀ b n, C n → C (bit b n)) :
    binaryRec z f 0 = z := by
  rw [binary_rec]
  rfl
#align nat.binary_rec_zero Nat.binaryRec_zero
-/

/-! bitwise ops -/

#print Nat.bodd_bit /-
theorem bodd_bit (b n) : bodd (bit b n) = b := by
  rw [bit_val] <;> simp <;> cases b <;> cases bodd n <;> rfl
#align nat.bodd_bit Nat.bodd_bit
-/

#print Nat.div2_bit /-
theorem div2_bit (b n) : div2 (bit b n) = n := by
  rw [bit_val, div2_val, Nat.add_comm, add_mul_div_left, div_eq_of_lt, Nat.zero_add] <;> cases b <;>
    exact by decide
#align nat.div2_bit Nat.div2_bit
-/

#print Nat.shiftl'_add /-
theorem shiftl'_add (b m n) : ∀ k, shiftl' b m (n + k) = shiftl' b (shiftl' b m n) k
  | 0 => rfl
  | k + 1 => congr_arg (bit b) (shiftl'_add k)
#align nat.shiftl'_add Nat.shiftl'_add
-/

#print Nat.shiftl_add /-
theorem shiftl_add : ∀ m n k, shiftl m (n + k) = shiftl (shiftl m n) k :=
  shiftl'_add _
#align nat.shiftl_add Nat.shiftl_add
-/

#print Nat.shiftr_add /-
theorem shiftr_add (m n) : ∀ k, shiftr m (n + k) = shiftr (shiftr m n) k
  | 0 => rfl
  | k + 1 => congr_arg div2 (shiftr_add k)
#align nat.shiftr_add Nat.shiftr_add
-/

#print Nat.shiftl'_sub /-
theorem shiftl'_sub (b m) : ∀ {n k}, k ≤ n → shiftl' b m (n - k) = shiftr (shiftl' b m n) k
  | n, 0, h => rfl
  | n + 1, k + 1, h => by
    simp [shiftl']; rw [Nat.add_comm, shiftr_add]
    simp [shiftr, div2_bit]
    apply shiftl'_sub (Nat.le_of_succ_le_succ h)
#align nat.shiftl'_sub Nat.shiftl'_sub
-/

#print Nat.shiftl_sub /-
theorem shiftl_sub : ∀ (m) {n k}, k ≤ n → shiftl m (n - k) = shiftr (shiftl m n) k :=
  shiftl'_sub _
#align nat.shiftl_sub Nat.shiftl_sub
-/

#print Nat.testBit_zero /-
@[simp]
theorem testBit_zero (b n) : testBit (bit b n) 0 = b :=
  bodd_bit _ _
#align nat.test_bit_zero Nat.testBit_zero
-/

#print Nat.testBit_succ /-
theorem testBit_succ (m b n) : testBit (bit b n) (succ m) = testBit n m :=
  by
  have : bodd (shiftr (shiftr (bit b n) 1) m) = bodd (shiftr n m) := by
    dsimp [shiftr] <;> rw [div2_bit]
  rw [← shiftr_add, Nat.add_comm] at this <;> exact this
#align nat.test_bit_succ Nat.testBit_succ
-/

/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:145:2: warning: unsupported: with_cases -/
#print Nat.binaryRec_eq /-
theorem binaryRec_eq {C : Nat → Sort u} {z : C 0} {f : ∀ b n, C n → C (bit b n)}
    (h : f false 0 z = z) (b n) : binaryRec z f (bit b n) = f b n (binaryRec z f n) :=
  by
  rw [binary_rec]
  by_cases bit b n = 0
  case pos h' =>
    simp [dif_pos h']
    generalize binary_rec._main._pack._proof_1 (bit b n) h' = e
    revert e
    have bf := bodd_bit b n
    have n0 := div2_bit b n
    rw [h'] at bf n0
    simp at bf n0
    rw [← bf, ← n0, binary_rec_zero]
    intros ; exact h.symm
  case neg h' =>
    simp [dif_neg h']
    generalize binary_rec._main._pack._proof_2 (bit b n) = e
    revert e
    rw [bodd_bit, div2_bit]
    intros ; rfl
#align nat.binary_rec_eq Nat.binaryRec_eq
-/

#print Nat.bitwise'_bit_aux /-
theorem bitwise'_bit_aux {f : Bool → Bool → Bool} (h : f false false = false) :
    (@binaryRec (fun _ => ℕ) (cond (f true false) (bit false 0) 0) fun b n _ =>
        bit (f false b) (cond (f false true) n 0)) =
      fun n : ℕ => cond (f false true) n 0 :=
  by
  funext n
  apply bit_cases_on n; intro b n; rw [binary_rec_eq]
  · cases b <;> try rw [h] <;> induction' fft : f ff tt with <;> simp [cond] <;> rfl
  ·
    rw [h, show cond (f ff tt) 0 0 = 0 by cases f ff tt <;> rfl,
        show cond (f tt ff) (bit ff 0) 0 = 0 by cases f tt ff <;> rfl] <;>
      rfl
#align nat.bitwise_bit_aux Nat.bitwise'_bit_aux
-/

#print Nat.bitwise'_zero_left /-
@[simp]
theorem bitwise'_zero_left (f : Bool → Bool → Bool) (n) :
    bitwise' f 0 n = cond (f false true) n 0 := by unfold bitwise <;> rw [binary_rec_zero]
#align nat.bitwise_zero_left Nat.bitwise'_zero_left
-/

#print Nat.bitwise'_zero_right /-
@[simp]
theorem bitwise'_zero_right (f : Bool → Bool → Bool) (h : f false false = false) (m) :
    bitwise' f m 0 = cond (f true false) m 0 := by
  unfold bitwise <;> apply bit_cases_on m <;> intros <;> rw [binary_rec_eq, binary_rec_zero] <;>
    exact bitwise_bit_aux h
#align nat.bitwise_zero_right Nat.bitwise'_zero_right
-/

#print Nat.bitwise'_zero /-
@[simp]
theorem bitwise'_zero (f : Bool → Bool → Bool) : bitwise' f 0 0 = 0 := by
  rw [bitwise_zero_left] <;> cases f ff tt <;> rfl
#align nat.bitwise_zero Nat.bitwise'_zero
-/

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic tactic.swap -/
#print Nat.bitwise'_bit /-
@[simp]
theorem bitwise'_bit {f : Bool → Bool → Bool} (h : f false false = false) (a m b n) :
    bitwise' f (bit a m) (bit b n) = bit (f a b) (bitwise' f m n) :=
  by
  unfold bitwise
  rw [binary_rec_eq, binary_rec_eq]
  · induction' ftf : f tt ff with <;> dsimp [cond]
    rw [show f a ff = ff by cases a <;> assumption]
    apply @congr_arg _ _ _ 0 (bit ff)
    run_tac
      tactic.swap
    rw [show f a ff = a by cases a <;> assumption]
    apply congr_arg (bit a)
    all_goals
      apply bit_cases_on m; intro a m
      rw [binary_rec_eq, binary_rec_zero]
      rw [← bitwise_bit_aux h, ftf]; rfl
  · exact bitwise_bit_aux h
#align nat.bitwise_bit Nat.bitwise'_bit
-/

#print Nat.bitwise'_swap /-
theorem bitwise'_swap {f : Bool → Bool → Bool} (h : f false false = false) :
    bitwise' (Function.swap f) = Function.swap (bitwise' f) :=
  by
  funext m n; revert n
  dsimp [Function.swap]
  apply binary_rec _ (fun a m' IH => _) m <;> intro n
  · rw [bitwise_zero_left, bitwise_zero_right]
    exact h
  apply bit_cases_on n <;> intro b n'
  rw [bitwise_bit, bitwise_bit, IH] <;> exact h
#align nat.bitwise_swap Nat.bitwise'_swap
-/

#print Nat.lor'_bit /-
@[simp]
theorem lor'_bit : ∀ a m b n, lor' (bit a m) (bit b n) = bit (a || b) (lor' m n) :=
  bitwise'_bit rfl
#align nat.lor_bit Nat.lor'_bit
-/

#print Nat.land'_bit /-
@[simp]
theorem land'_bit : ∀ a m b n, land' (bit a m) (bit b n) = bit (a && b) (land' m n) :=
  bitwise'_bit rfl
#align nat.land_bit Nat.land'_bit
-/

#print Nat.ldiff'_bit /-
@[simp]
theorem ldiff'_bit : ∀ a m b n, ldiff' (bit a m) (bit b n) = bit (a && not b) (ldiff' m n) :=
  bitwise'_bit rfl
#align nat.ldiff_bit Nat.ldiff'_bit
-/

#print Nat.lxor'_bit /-
@[simp]
theorem lxor'_bit : ∀ a m b n, lxor' (bit a m) (bit b n) = bit (xor a b) (lxor' m n) :=
  bitwise'_bit rfl
#align nat.lxor_bit Nat.lxor'_bit
-/

#print Nat.testBit_bitwise' /-
@[simp]
theorem testBit_bitwise' {f : Bool → Bool → Bool} (h : f false false = false) (m n k) :
    testBit (bitwise' f m n) k = f (testBit m k) (testBit n k) :=
  by
  revert m n <;> induction' k with k IH <;> intro m n <;> apply bit_cases_on m <;> intro a m' <;>
        apply bit_cases_on n <;>
      intro b n' <;>
    rw [bitwise_bit h]
  · simp [test_bit_zero]
  · simp [test_bit_succ, IH]
#align nat.test_bit_bitwise Nat.testBit_bitwise'
-/

#print Nat.testBit_lor' /-
@[simp]
theorem testBit_lor' : ∀ m n k, testBit (lor' m n) k = (testBit m k || testBit n k) :=
  testBit_bitwise' rfl
#align nat.test_bit_lor Nat.testBit_lor'
-/

#print Nat.testBit_land' /-
@[simp]
theorem testBit_land' : ∀ m n k, testBit (land' m n) k = (testBit m k && testBit n k) :=
  testBit_bitwise' rfl
#align nat.test_bit_land Nat.testBit_land'
-/

#print Nat.testBit_ldiff' /-
@[simp]
theorem testBit_ldiff' : ∀ m n k, testBit (ldiff' m n) k = (testBit m k && not (testBit n k)) :=
  testBit_bitwise' rfl
#align nat.test_bit_ldiff Nat.testBit_ldiff'
-/

#print Nat.testBit_lxor' /-
@[simp]
theorem testBit_lxor' : ∀ m n k, testBit (lxor' m n) k = xor (testBit m k) (testBit n k) :=
  testBit_bitwise' rfl
#align nat.test_bit_lxor Nat.testBit_lxor'
-/

end Nat


-- Enumerated Types

inductive weekday : Type
| sunday : weekday
| monday : weekday
| tuesday : weekday
| wednesday : weekday
| thursday : weekday
| friday : weekday
| saturday : weekday

#check weekday
#print weekday

#check weekday.sunday
#check weekday.monday

open weekday

#check sunday
#check monday

#check weekday.rec
#check @weekday.rec

#check weekday.rec_on
#check @weekday.rec_on

def number_of_day (d : weekday) : ℕ :=
weekday.rec_on d 1 2 3 4 5 6 7

#reduce number_of_day sunday
#reduce number_of_day monday
#reduce number_of_day tuesday

def number_of_day' (d : weekday) : ℕ :=
weekday.cases_on d 1 2 3 4 5 6 7

#reduce number_of_day' wednesday

namespace weekday
@[reducible]
private def cases_on := @weekday.cases_on

def number_of_day₁ (d : weekday) : nat :=
cases_on d 1 2 3 4 5 6 7
end weekday

#reduce weekday.number_of_day₁ weekday.sunday

open weekday (renaming cases_on → cases_on)

#reduce number_of_day₁ sunday
#check cases_on

namespace weekday
def next (d : weekday) : weekday :=
weekday.cases_on d monday tuesday wednesday thursday friday saturday sunday

def previous (d : weekday) : weekday :=
weekday.cases_on d saturday sunday monday tuesday wednesday thursday friday

#reduce next (next tuesday)
#reduce next (previous tuesday)

example : next (previous tuesday) = tuesday := rfl

theorem next_previous (d: weekday) : next (previous d) = d :=
weekday.cases_on d
  (show next (previous sunday) = sunday, from rfl)
  (show next (previous monday) = monday, from rfl)
  (show next (previous tuesday) = tuesday, from rfl)
  (show next (previous wednesday) = wednesday, from rfl)
  (show next (previous thursday) = thursday, from rfl)
  (show next (previous friday) = friday, from rfl)
  (show next (previous saturday) = saturday, from rfl)

theorem next_previous' (d: weekday) : next (previous d) = d :=
weekday.cases_on d rfl rfl rfl rfl rfl rfl rfl

theorem next_previous'' (d: weekday) : next (previous d) = d :=
by apply weekday.cases_on d; refl

theorem next_previous₁ (d: weekday) : next (previous d) = d :=
by apply weekday.rec_on d; refl

end weekday


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl

! This file was ported from Lean 3 source module category_theory.types
! leanprover-community/mathlib commit 48085f140e684306f9e7da907cd5932056d1aded
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.EpiMono
import Mathlib.CategoryTheory.Functor.FullyFaithful
import Mathlib.Logic.Equiv.Basic
import Mathlib.Data.Set.Basic

/-!
# The category `Type`.

In this section we set up the theory so that Lean's types and functions between them
can be viewed as a `LargeCategory` in our framework.

Lean can not transparently view a function as a morphism in this category, and needs a hint in
order to be able to type check. We provide the abbreviation `asHom f` to guide type checking,
as well as a corresponding notation `↾ f`. (Entered as `\upr `.)

We provide various simplification lemmas for functors and natural transformations valued in `Type`.

We define `uliftFunctor`, from `Type u` to `Type (max u v)`, and show that it is fully faithful
(but not, of course, essentially surjective).

We prove some basic facts about the category `Type`:
*  epimorphisms are surjections and monomorphisms are injections,
* `Iso` is both `Iso` and `Equiv` to `Equiv` (at least within a fixed universe),
* every type level `IsLawfulFunctor` gives a categorical functor `Type ⥤ Type`
  (the corresponding fact about monads is in `Mathlib/CategoryTheory/Monad/Types.lean`).
-/

namespace CategoryTheory

-- morphism levels before object levels. See note [CategoryTheory universes].
universe v v' w u u'

/- The `@[to_additive]` attribute is just a hint that expressions involving this instance can
  still be additivized. -/
@[to_additive existing CategoryTheory.types]
instance types : LargeCategory (Type u)
    where
  Hom a b := a → b
  id a := id
  comp f g := g ∘ f
#align category_theory.types CategoryTheory.types

theorem types_hom {α β : Type u} : (α ⟶ β) = (α → β) :=
  rfl
#align category_theory.types_hom CategoryTheory.types_hom

theorem types_id (X : Type u) : 𝟙 X = id :=
  rfl
#align category_theory.types_id CategoryTheory.types_id

theorem types_comp {X Y Z : Type u} (f : X ⟶ Y) (g : Y ⟶ Z) : f ≫ g = g ∘ f :=
  rfl
#align category_theory.types_comp CategoryTheory.types_comp

@[simp]
theorem types_id_apply (X : Type u) (x : X) : (𝟙 X : X → X) x = x :=
  rfl
#align category_theory.types_id_apply CategoryTheory.types_id_apply

@[simp]
theorem types_comp_apply {X Y Z : Type u} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) :=
  rfl
#align category_theory.types_comp_apply CategoryTheory.types_comp_apply

@[simp]
theorem hom_inv_id_apply {X Y : Type u} (f : X ≅ Y) (x : X) : f.inv (f.hom x) = x :=
  congr_fun f.hom_inv_id x
#align category_theory.hom_inv_id_apply CategoryTheory.hom_inv_id_apply

@[simp]
theorem inv_hom_id_apply {X Y : Type u} (f : X ≅ Y) (y : Y) : f.hom (f.inv y) = y :=
  congr_fun f.inv_hom_id y
#align category_theory.inv_hom_id_apply CategoryTheory.inv_hom_id_apply

-- Unfortunately without this wrapper we can't use `CategoryTheory` idioms, such as `IsIso f`.
/-- `asHom f` helps Lean type check a function as a morphism in the category `Type`. -/
abbrev asHom {α β : Type u} (f : α → β) : α ⟶ β :=
  f
#align category_theory.as_hom CategoryTheory.asHom

@[inherit_doc]
scoped notation "↾" f:200 => CategoryTheory.asHom f

section

-- We verify the expected type checking behaviour of `asHom`
variable (α β γ : Type u) (f : α → β) (g : β → γ)

example : α → γ :=
  ↾f ≫ ↾g

example [IsIso (↾f)] : Mono (↾f) := by infer_instance

example [IsIso (↾f)] : ↾f ≫ inv (↾f) = 𝟙 α := by simp

end

namespace Functor

variable {J : Type u} [Category.{v} J]

/-- The sections of a functor `J ⥤ Type` are
the choices of a point `u j : F.obj j` for each `j`,
such that `F.map f (u j) = u j` for every morphism `f : j ⟶ j'`.

We later use these to define limits in `Type` and in many concrete categories.
-/
def sections (F : J ⥤ Type w) : Set (∀ j, F.obj j) :=
  { u | ∀ {j j'} (f : j ⟶ j'), F.map f (u j) = u j' }
#align category_theory.functor.sections CategoryTheory.Functor.sections

-- porting note: added this simp lemma
@[simp]
lemma sections_property {F : J ⥤ Type w} (s : (F.sections : Type _))
  {j j' : J} (f : j ⟶ j') : F.map f (s.val j) = s.val j' :=
  s.property f

end Functor

namespace FunctorToTypes

variable {C : Type u} [Category.{v} C] (F G H : C ⥤ Type w) {X Y Z : C}

variable (σ : F ⟶ G) (τ : G ⟶ H)

@[simp]
theorem map_comp_apply (f : X ⟶ Y) (g : Y ⟶ Z) (a : F.obj X) :
    (F.map (f ≫ g)) a = (F.map g) ((F.map f) a) := by simp [types_comp]
#align category_theory.functor_to_types.map_comp_apply CategoryTheory.FunctorToTypes.map_comp_apply

@[simp]
theorem map_id_apply (a : F.obj X) : (F.map (𝟙 X)) a = a := by simp [types_id]
#align category_theory.functor_to_types.map_id_apply CategoryTheory.FunctorToTypes.map_id_apply

theorem naturality (f : X ⟶ Y) (x : F.obj X) : σ.app Y ((F.map f) x) = (G.map f) (σ.app X x) :=
  congr_fun (σ.naturality f) x
#align category_theory.functor_to_types.naturality CategoryTheory.FunctorToTypes.naturality

@[simp]
theorem comp (x : F.obj X) : (σ ≫ τ).app X x = τ.app X (σ.app X x) :=
  rfl
#align category_theory.functor_to_types.comp CategoryTheory.FunctorToTypes.comp

variable {D : Type u'} [𝒟 : Category.{u'} D] (I J : D ⥤ C) (ρ : I ⟶ J) {W : D}

@[simp]
theorem hcomp (x : (I ⋙ F).obj W) : (ρ ◫ σ).app W x = (G.map (ρ.app W)) (σ.app (I.obj W) x) :=
  rfl
#align category_theory.functor_to_types.hcomp CategoryTheory.FunctorToTypes.hcomp

@[simp]
theorem map_inv_map_hom_apply (f : X ≅ Y) (x : F.obj X) : F.map f.inv (F.map f.hom x) = x :=
  congr_fun (F.mapIso f).hom_inv_id x
#align category_theory.functor_to_types.map_inv_map_hom_apply CategoryTheory.FunctorToTypes.map_inv_map_hom_apply

@[simp]
theorem map_hom_map_inv_apply (f : X ≅ Y) (y : F.obj Y) : F.map f.hom (F.map f.inv y) = y :=
  congr_fun (F.mapIso f).inv_hom_id y
#align category_theory.functor_to_types.map_hom_map_inv_apply CategoryTheory.FunctorToTypes.map_hom_map_inv_apply

@[simp]
theorem hom_inv_id_app_apply (α : F ≅ G) (X) (x) : α.inv.app X (α.hom.app X x) = x :=
  congr_fun (α.hom_inv_id_app X) x
#align category_theory.functor_to_types.hom_inv_id_app_apply CategoryTheory.FunctorToTypes.hom_inv_id_app_apply

@[simp]
theorem inv_hom_id_app_apply (α : F ≅ G) (X) (x) : α.hom.app X (α.inv.app X x) = x :=
  congr_fun (α.inv_hom_id_app X) x
#align category_theory.functor_to_types.inv_hom_id_app_apply CategoryTheory.FunctorToTypes.inv_hom_id_app_apply

end FunctorToTypes

/-- The isomorphism between a `Type` which has been `ulift`ed to the same universe,
and the original type.
-/
def uliftTrivial (V : Type u) : ULift.{u} V ≅ V where
  hom a := a.1
  inv a := .up a
  hom_inv_id := by aesop_cat
  inv_hom_id := by aesop_cat
#align category_theory.ulift_trivial CategoryTheory.uliftTrivial

/-- The functor embedding `Type u` into `Type (max u v)`.
Write this as `uliftFunctor.{5 2}` to get `Type 2 ⥤ Type 5`.
-/
def uliftFunctor : Type u ⥤ Type max u v
    where
  obj X := ULift.{v} X
  map {X} {Y} f := fun x : ULift.{v} X => ULift.up (f x.down)
#align category_theory.ulift_functor CategoryTheory.uliftFunctor

@[simp]
theorem uliftFunctor_map {X Y : Type u} (f : X ⟶ Y) (x : ULift.{v} X) :
    uliftFunctor.map f x = ULift.up (f x.down) :=
  rfl
#align category_theory.ulift_functor_map CategoryTheory.uliftFunctor_map

instance uliftFunctorFull : Full.{u} uliftFunctor where preimage f x := (f (ULift.up x)).down
#align category_theory.ulift_functor_full CategoryTheory.uliftFunctorFull

instance uliftFunctor_faithful : Faithful uliftFunctor
    where map_injective {_X} {_Y} f g p :=
    funext fun x =>
      congr_arg ULift.down (congr_fun p (ULift.up x) : ULift.up (f x) = ULift.up (g x))
#align category_theory.ulift_functor_faithful CategoryTheory.uliftFunctor_faithful

/-- The functor embedding `Type u` into `Type u` via `ulift` is isomorphic to the identity functor.
 -/
def uliftFunctorTrivial : uliftFunctor.{u, u} ≅ 𝟭 _ :=
  NatIso.ofComponents uliftTrivial (by aesop_cat)
#align category_theory.ulift_functor_trivial CategoryTheory.uliftFunctorTrivial

-- TODO We should connect this to a general story about concrete categories
-- whose forgetful functor is representable.
/-- Any term `x` of a type `X` corresponds to a morphism `punit ⟶ X`. -/
def homOfElement {X : Type u} (x : X) : PUnit ⟶ X := fun _ => x
#align category_theory.hom_of_element CategoryTheory.homOfElement

theorem homOfElement_eq_iff {X : Type u} (x y : X) : homOfElement x = homOfElement y ↔ x = y :=
  ⟨fun H => congr_fun H PUnit.unit, by aesop⟩
#align category_theory.hom_of_element_eq_iff CategoryTheory.homOfElement_eq_iff

/-- A morphism in `Type` is a monomorphism if and only if it is injective.

See <https://stacks.math.columbia.edu/tag/003C>.
-/
theorem mono_iff_injective {X Y : Type u} (f : X ⟶ Y) : Mono f ↔ Function.Injective f := by
  constructor
  · intro H x x' h
    skip
    rw [← homOfElement_eq_iff] at h⊢
    exact (cancel_mono f).mp h
  · exact fun H => ⟨fun g g' h => H.comp_left h⟩
#align category_theory.mono_iff_injective CategoryTheory.mono_iff_injective

theorem injective_of_mono {X Y : Type u} (f : X ⟶ Y) [hf : Mono f] : Function.Injective f :=
  (mono_iff_injective f).1 hf
#align category_theory.injective_of_mono CategoryTheory.injective_of_mono

/-- A morphism in `Type` is an epimorphism if and only if it is surjective.

See <https://stacks.math.columbia.edu/tag/003C>.
-/
theorem epi_iff_surjective {X Y : Type u} (f : X ⟶ Y) : Epi f ↔ Function.Surjective f := by
  constructor
  · rintro ⟨H⟩
    refine' Function.surjective_of_right_cancellable_Prop fun g₁ g₂ hg => _
    rw [← Equiv.ulift.symm.injective.comp_left.eq_iff]
    apply H
    change ULift.up ∘ g₁ ∘ f = ULift.up ∘ g₂ ∘ f
    rw [hg]
  · exact fun H => ⟨fun g g' h => H.injective_comp_right h⟩
#align category_theory.epi_iff_surjective CategoryTheory.epi_iff_surjective

theorem surjective_of_epi {X Y : Type u} (f : X ⟶ Y) [hf : Epi f] : Function.Surjective f :=
  (epi_iff_surjective f).1 hf
#align category_theory.surjective_of_epi CategoryTheory.surjective_of_epi

section

/-- `ofTypeFunctor m` converts from Lean's `Type`-based `Category` to `CategoryTheory`. This
allows us to use these functors in category theory. -/
def ofTypeFunctor (m : Type u → Type v) [_root_.Functor m] [LawfulFunctor m] : Type u ⥤ Type v
    where
  obj := m
  map f := Functor.map f
  map_id := fun α => by funext X; apply id_map  /- Porting note: original proof is via
  `fun α => _root_.Functor.map_id` but I cannot get Lean to find this. Reproduced its
  original proof -/
  map_comp f g := funext fun a => LawfulFunctor.comp_map f g _
#align category_theory.of_type_functor CategoryTheory.ofTypeFunctor

variable (m : Type u → Type v) [_root_.Functor m] [LawfulFunctor m]

@[simp]
theorem ofTypeFunctor_obj : (ofTypeFunctor m).obj = m :=
  rfl
#align category_theory.of_type_functor_obj CategoryTheory.ofTypeFunctor_obj

@[simp]
theorem ofTypeFunctor_map {α β} (f : α → β) :
    (ofTypeFunctor m).map f = (Functor.map f : m α → m β) :=
  rfl
#align category_theory.of_type_functor_map CategoryTheory.ofTypeFunctor_map

end

end CategoryTheory

-- Isomorphisms in Type and equivalences.
namespace Equiv

universe u

variable {X Y : Type u}

/-- Any equivalence between types in the same universe gives
a categorical isomorphism between those types.
-/
def toIso (e : X ≃ Y) : X ≅ Y where
  hom := e.toFun
  inv := e.invFun
  hom_inv_id := funext e.left_inv
  inv_hom_id := funext e.right_inv
#align equiv.to_iso Equiv.toIso

@[simp]
theorem toIso_hom {e : X ≃ Y} : e.toIso.hom = e :=
  rfl
#align equiv.to_iso_hom Equiv.toIso_hom

@[simp]
theorem toIso_inv {e : X ≃ Y} : e.toIso.inv = e.symm :=
  rfl
#align equiv.to_iso_inv Equiv.toIso_inv

end Equiv

universe u

namespace CategoryTheory.Iso

open CategoryTheory

variable {X Y : Type u}

/-- Any isomorphism between types gives an equivalence.
-/
def toEquiv (i : X ≅ Y) : X ≃ Y where
  toFun := i.hom
  invFun := i.inv
  left_inv x := congr_fun i.hom_inv_id x
  right_inv y := congr_fun i.inv_hom_id y
#align category_theory.iso.to_equiv CategoryTheory.Iso.toEquiv

@[simp]

@[simp]
theorem toEquiv_symm_fun (i : X ≅ Y) : (i.toEquiv.symm : Y → X) = i.inv :=
  rfl
#align category_theory.iso.to_equiv_symm_fun CategoryTheory.Iso.toEquiv_symm_fun

@[simp]
theorem toEquiv_id (X : Type u) : (Iso.refl X).toEquiv = Equiv.refl X :=
  rfl
#align category_theory.iso.to_equiv_id CategoryTheory.Iso.toEquiv_id

@[simp]
theorem toEquiv_comp {X Y Z : Type u} (f : X ≅ Y) (g : Y ≅ Z) :
    (f ≪≫ g).toEquiv = f.toEquiv.trans g.toEquiv :=
  rfl
#align category_theory.iso.to_equiv_comp CategoryTheory.Iso.toEquiv_comp

end CategoryTheory.Iso

namespace CategoryTheory

/-- A morphism in `Type u` is an isomorphism if and only if it is bijective. -/
theorem isIso_iff_bijective {X Y : Type u} (f : X ⟶ Y) : IsIso f ↔ Function.Bijective f :=
  Iff.intro (fun _ => (asIso f : X ≅ Y).toEquiv.bijective) fun b =>
    IsIso.of_iso (Equiv.ofBijective f b).toIso
#align category_theory.is_iso_iff_bijective CategoryTheory.isIso_iff_bijective

instance : SplitEpiCategory (Type u)
    where isSplitEpi_of_epi f hf :=
    IsSplitEpi.mk' <|
      { section_ := Function.surjInv <| (epi_iff_surjective f).1 hf
        id := funext <| Function.rightInverse_surjInv <| (epi_iff_surjective f).1 hf }

end CategoryTheory

-- We prove `equivIsoIso` and then use that to sneakily construct `equivEquivIso`.
-- (In this order the proofs are handled by `obviously`.)
/-- Equivalences (between types in the same universe) are the same as (isomorphic to) isomorphisms
of types. -/
@[simps]
def equivIsoIso {X Y : Type u} : X ≃ Y ≅ X ≅ Y
    where
  hom e := e.toIso
  inv i := i.toEquiv
#align equiv_iso_iso equivIsoIso

/-- Equivalences (between types in the same universe) are the same as (equivalent to) isomorphisms
of types. -/
def equivEquivIso {X Y : Type u} : X ≃ Y ≃ (X ≅ Y) :=
  equivIsoIso.toEquiv
#align equiv_equiv_iso equivEquivIso

@[simp]
theorem equivEquivIso_hom {X Y : Type u} (e : X ≃ Y) : equivEquivIso e = e.toIso :=
  rfl
#align equiv_equiv_iso_hom equivEquivIso_hom

@[simp]
theorem equivEquivIso_inv {X Y : Type u} (e : X ≅ Y) : equivEquivIso.symm e = e.toEquiv :=
  rfl
#align equiv_equiv_iso_inv equivEquivIso_inv