/-
Copyright © 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Shing Tak Lam
-/

import topology.algebra.ordered.proj_Icc
import topology.continuous_function.basic

/-!
# Bundled continuous maps into orders, with order-compatible topology

-/

variables {α : Type*} {β : Type*} {γ : Type*}
variables [topological_space α] [topological_space β] [topological_space γ]

namespace continuous_map

section
variables [linear_ordered_add_comm_group β] [order_topology β]

/-- The pointwise absolute value of a continuous function as a continuous function. -/
def abs (f : C(α, β)) : C(α, β) :=
{ to_fun := λ x, |f x|, }

@[priority 100] -- see Note [lower instance priority]
instance : has_abs C(α, β) := ⟨λf, abs f⟩

@[simp] lemma abs_apply (f : C(α, β)) (x : α) : |f| x = |f x| :=
rfl

end

/-!
We now set up the partial order and lattice structure (given by pointwise min and max)
on continuous functions.
-/
section lattice

instance partial_order [partial_order β] :
  partial_order C(α, β) :=
partial_order.lift (λ f, f.to_fun) (by tidy)

lemma le_def [partial_order β] {f g : C(α, β)} : f ≤ g ↔ ∀ a, f a ≤ g a :=
pi.le_def

lemma lt_def [partial_order β] {f g : C(α, β)} :
  f < g ↔ (∀ a, f a ≤ g a) ∧ (∃ a, f a < g a) :=
pi.lt_def

instance has_sup [linear_order β] [order_closed_topology β] : has_sup C(α, β) :=
{ sup := λ f g, { to_fun := λ a, max (f a) (g a), } }

@[simp, norm_cast] lemma sup_coe [linear_order β] [order_closed_topology β] (f g : C(α, β)) :
  ((f ⊔ g : C(α, β)) : α → β) = (f ⊔ g : α → β) :=
rfl

@[simp] lemma sup_apply [linear_order β] [order_closed_topology β] (f g : C(α, β)) (a : α) :
  (f ⊔ g) a = max (f a) (g a) :=
rfl

instance [linear_order β] [order_closed_topology β] : semilattice_sup C(α, β) :=
{ le_sup_left := λ f g, le_def.mpr (by simp [le_refl]),
  le_sup_right := λ f g, le_def.mpr (by simp [le_refl]),
  sup_le := λ f₁ f₂ g w₁ w₂, le_def.mpr (λ a, by simp [le_def.mp w₁ a, le_def.mp w₂ a]),
  ..continuous_map.partial_order,
  ..continuous_map.has_sup, }

instance has_inf [linear_order β] [order_closed_topology β] : has_inf C(α, β) :=
{ inf := λ f g, { to_fun := λ a, min (f a) (g a), } }

@[simp, norm_cast] lemma inf_coe [linear_order β] [order_closed_topology β] (f g : C(α, β)) :
  ((f ⊓ g : C(α, β)) : α → β) = (f ⊓ g : α → β) :=
rfl

@[simp] lemma inf_apply [linear_order β] [order_closed_topology β] (f g : C(α, β)) (a : α) :
  (f ⊓ g) a = min (f a) (g a) :=
rfl

instance [linear_order β] [order_closed_topology β] : semilattice_inf C(α, β) :=
{ inf_le_left := λ f g, le_def.mpr (by simp [le_refl]),
  inf_le_right := λ f g, le_def.mpr (by simp [le_refl]),
  le_inf := λ f₁ f₂ g w₁ w₂, le_def.mpr (λ a, by simp [le_def.mp w₁ a, le_def.mp w₂ a]),
  ..continuous_map.partial_order,
  ..continuous_map.has_inf, }

instance [linear_order β] [order_closed_topology β] : lattice C(α, β) :=
{ ..continuous_map.semilattice_inf,
  ..continuous_map.semilattice_sup }

-- TODO transfer this lattice structure to `bounded_continuous_function`

section sup'
variables [linear_order γ] [order_closed_topology γ]

lemma sup'_apply {ι : Type*} {s : finset ι} (H : s.nonempty) (f : ι → C(β, γ)) (b : β) :
  s.sup' H f b = s.sup' H (λ a, f a b) :=
finset.comp_sup'_eq_sup'_comp H (λ f : C(β, γ), f b) (λ i j, rfl)

@[simp, norm_cast]
lemma sup'_coe {ι : Type*} {s : finset ι} (H : s.nonempty) (f : ι → C(β, γ)) :
  ((s.sup' H f : C(β, γ)) : ι → β) = s.sup' H (λ a, (f a : β → γ)) :=
by { ext, simp [sup'_apply], }

end sup'

section inf'
variables [linear_order γ] [order_closed_topology γ]

lemma inf'_apply {ι : Type*} {s : finset ι} (H : s.nonempty) (f : ι → C(β, γ)) (b : β) :
  s.inf' H f b = s.inf' H (λ a, f a b) :=
@sup'_apply _ (order_dual γ) _ _ _ _ _ _ H f b

@[simp, norm_cast]
lemma inf'_coe {ι : Type*} {s : finset ι} (H : s.nonempty) (f : ι → C(β, γ)) :
  ((s.inf' H f : C(β, γ)) : ι → β) = s.inf' H (λ a, (f a : β → γ)) :=
@sup'_coe _ (order_dual γ) _ _ _ _ _ _ H f

end inf'

end lattice

section extend

variables [linear_order α] [order_topology α] {a b : α} (h : a ≤ b)

/--
Extend a continuous function `f : C(set.Icc a b, β)` to a function `f : C(α, β)`.
-/
def Icc_extend (f : C(set.Icc a b, β)) : C(α, β) := ⟨set.Icc_extend h f⟩

@[simp] lemma coe_Icc_extend (f : C(set.Icc a b, β)) :
  ((Icc_extend h f : C(α, β)) : α → β) = set.Icc_extend h f := rfl

end extend

end continuous_map


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import algebra.char_p.invertible
import order.filter.at_top_bot
import tactic.linarith
import tactic.field_simp
import tactic.linear_combination

/-!
# Quadratic discriminants and roots of a quadratic

This file defines the discriminant of a quadratic and gives the solution to a quadratic equation.

## Main definition

- `discrim a b c`: the discriminant of a quadratic `a * x * x + b * x + c` is `b * b - 4 * a * c`.

## Main statements

- `quadratic_eq_zero_iff`: roots of a quadratic can be written as
  `(-b + s) / (2 * a)` or `(-b - s) / (2 * a)`, where `s` is a square root of the discriminant.
- `quadratic_ne_zero_of_discrim_ne_sq`: if the discriminant has no square root,
  then the corresponding quadratic has no root.
- `discrim_le_zero`: if a quadratic is always non-negative, then its discriminant is non-positive.

## Tags

polynomial, quadratic, discriminant, root
-/

open filter

section ring
variables {R : Type*}

/-- Discriminant of a quadratic -/
def discrim [ring R] (a b c : R) : R := b^2 - 4 * a * c

variables [comm_ring R] [is_domain R] {a b c : R}

/--
A quadratic has roots if and only if its discriminant equals some square.
-/
lemma quadratic_eq_zero_iff_discrim_eq_sq (h2 : (2 : R) ≠ 0) (ha : a ≠ 0) (x : R) :
  a * x * x + b * x + c = 0 ↔ discrim a b c = (2 * a * x + b) ^ 2 :=
begin
  dsimp [discrim] at *,
  split,
  { assume h,
    linear_combination -4 * a * h },
  { assume h,
    have ha : 2 * 2 * a ≠ 0 := mul_ne_zero (mul_ne_zero h2 h2) ha,
    apply mul_left_cancel₀ ha,
    linear_combination -h }
end

/-- A quadratic has no root if its discriminant has no square root. -/
lemma quadratic_ne_zero_of_discrim_ne_sq (h2 : (2 : R) ≠ 0) (ha : a ≠ 0)
  (h : ∀ s : R, discrim a b c ≠ s * s) (x : R) :
  a * x * x + b * x + c ≠ 0 :=
begin
  assume h',
  rw [quadratic_eq_zero_iff_discrim_eq_sq h2 ha, sq] at h',
  exact h _ h'
end

end ring

section field
variables {K : Type*} [field K] [invertible (2 : K)] {a b c x : K}

/-- Roots of a quadratic -/
lemma quadratic_eq_zero_iff (ha : a ≠ 0) {s : K} (h : discrim a b c = s * s) (x : K) :
  a * x * x + b * x + c = 0 ↔ x = (-b + s) / (2 * a) ∨ x = (-b - s) / (2 * a) :=
begin
  have h2 : (2 : K) ≠ 0 := nonzero_of_invertible 2,
  rw [quadratic_eq_zero_iff_discrim_eq_sq h2 ha, h, sq, mul_self_eq_mul_self_iff],
  have ne : 2 * a ≠ 0 := mul_ne_zero h2 ha,
  field_simp,
  apply or_congr,
  { split; intro h'; linear_combination -h' },
  { split; intro h'; linear_combination h' },
end

/-- A quadratic has roots if its discriminant has square roots -/
lemma exists_quadratic_eq_zero (ha : a ≠ 0) (h : ∃ s, discrim a b c = s * s) :
  ∃ x, a * x * x + b * x + c = 0 :=
begin
  rcases h with ⟨s, hs⟩,
  use (-b + s) / (2 * a),
  rw quadratic_eq_zero_iff ha hs,
  simp
end

/-- Root of a quadratic when its discriminant equals zero -/
lemma quadratic_eq_zero_iff_of_discrim_eq_zero (ha : a ≠ 0) (h : discrim a b c = 0) (x : K) :
  a * x * x + b * x + c = 0 ↔ x = -b / (2 * a) :=
begin
  have : discrim a b c = 0 * 0, by rw [h, mul_zero],
  rw [quadratic_eq_zero_iff ha this, add_zero, sub_zero, or_self]
end

end field

section linear_ordered_field
variables {K : Type*} [linear_ordered_field K] {a b c : K}

/-- If a polynomial of degree 2 is always nonnegative, then its discriminant is nonpositive -/
lemma discrim_le_zero (h : ∀ x : K, 0 ≤ a * x * x + b * x + c) : discrim a b c ≤ 0 :=
begin
  rw [discrim, sq],
  obtain ha|rfl|ha : a < 0 ∨ a = 0 ∨ 0 < a := lt_trichotomy a 0,
  -- if a < 0
  { have : tendsto (λ x, (a * x + b) * x + c) at_top at_bot :=
     tendsto_at_bot_add_const_right _ c ((tendsto_at_bot_add_const_right _ b
       (tendsto_id.neg_const_mul_at_top ha)).at_bot_mul_at_top tendsto_id),
    rcases (this.eventually (eventually_lt_at_bot 0)).exists with ⟨x, hx⟩,
    exact false.elim ((h x).not_lt $ by rwa ← add_mul) },
  -- if a = 0
  { rcases em (b = 0) with (rfl|hb),
    { simp },
    { have := h ((-c - 1) / b), rw [mul_div_cancel' _ hb] at this, linarith } },
  -- if a > 0
  { have := calc
      4 * a * (a * (-(b / a) * (1 / 2)) * (-(b / a) * (1 / 2)) + b * (-(b / a) * (1 / 2)) + c)
          = (a * (b / a)) * (a * (b / a)) - 2 * (a * (b / a)) * b + 4 * a * c : by ring
      ... = -(b * b - 4 * a * c) : by { simp only [mul_div_cancel' b (ne_of_gt ha)], ring },
    have ha' : 0 ≤ 4 * a, by linarith,
    have h := (mul_nonneg ha' (h (-(b / a) * (1 / 2)))),
    rw this at h, rwa ← neg_nonneg }
end

/--
If a polynomial of degree 2 is always positive, then its discriminant is negative,
at least when the coefficient of the quadratic term is nonzero.
-/
lemma discrim_lt_zero (ha : a ≠ 0) (h : ∀ x : K, 0 < a * x * x + b * x + c) : discrim a b c < 0 :=
begin
  have : ∀ x : K, 0 ≤ a*x*x + b*x + c := assume x, le_of_lt (h x),
  refine lt_of_le_of_ne (discrim_le_zero this) _,
  assume h',
  have := h (-b / (2 * a)),
  have : a * (-b / (2 * a)) * (-b / (2 * a)) + b * (-b / (2 * a)) + c = 0,
  { rw [quadratic_eq_zero_iff_of_discrim_eq_zero ha h' (-b / (2 * a))] },
  linarith
end

end linear_ordered_field


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

! This file was ported from Lean 3 source module algebra.squarefree
! leanprover-community/mathlib commit 79de90f7beca025f469dcda978ae655c4d985946
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.RingTheory.UniqueFactorizationDomain

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

Results about squarefree natural numbers are proved in `Data.Nat.Squarefree`.

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

## Main Results
 - `multiplicity.squarefree_iff_multiplicity_le_one`: `x` is `Squarefree` iff for every `y`, either
  `multiplicity y x ≤ 1` or `IsUnit y`.
 - `UniqueFactorizationMonoid.squarefree_iff_nodup_factors`: A nonzero element `x` of a unique
 factorization monoid is squarefree iff `factors x` has no duplicate factors.

## Tags
squarefree, multiplicity

-/

variable {R : Type _}

/-- An element of a monoid is squarefree if the only squares that
  divide it are the squares of units. -/
def Squarefree [Monoid R] (r : R) : Prop :=
  ∀ x : R, x * x ∣ r → IsUnit x
#align squarefree Squarefree

@[simp]
theorem IsUnit.squarefree [CommMonoid R] {x : R} (h : IsUnit x) : Squarefree x := fun _ hdvd =>
  isUnit_of_mul_isUnit_left (isUnit_of_dvd_unit hdvd h)
#align is_unit.squarefree IsUnit.squarefree

-- @[simp] -- Porting note: simp can prove this
theorem squarefree_one [CommMonoid R] : Squarefree (1 : R) :=
  isUnit_one.squarefree
#align squarefree_one squarefree_one

@[simp]
theorem not_squarefree_zero [MonoidWithZero R] [Nontrivial R] : ¬Squarefree (0 : R) := by
  erw [not_forall]
  exact ⟨0, by simp⟩
#align not_squarefree_zero not_squarefree_zero

theorem Squarefree.ne_zero [MonoidWithZero R] [Nontrivial R] {m : R} (hm : Squarefree (m : R)) :
    m ≠ 0 := by
  rintro rfl
  exact not_squarefree_zero hm
#align squarefree.ne_zero Squarefree.ne_zero

@[simp]
theorem Irreducible.squarefree [CommMonoid R] {x : R} (h : Irreducible x) : Squarefree x := by
  rintro y ⟨z, hz⟩
  rw [mul_assoc] at hz
  rcases h.isUnit_or_isUnit hz with (hu | hu)
  · exact hu
  · apply isUnit_of_mul_isUnit_left hu
#align irreducible.squarefree Irreducible.squarefree

@[simp]
theorem Prime.squarefree [CancelCommMonoidWithZero R] {x : R} (h : Prime x) : Squarefree x :=
  h.irreducible.squarefree
#align prime.squarefree Prime.squarefree

theorem Squarefree.of_mul_left [CommMonoid R] {m n : R} (hmn : Squarefree (m * n)) : Squarefree m :=
  fun p hp => hmn p (dvd_mul_of_dvd_left hp n)
#align squarefree.of_mul_left Squarefree.of_mul_left

theorem Squarefree.of_mul_right [CommMonoid R] {m n : R} (hmn : Squarefree (m * n)) :
    Squarefree n := fun p hp => hmn p (dvd_mul_of_dvd_right hp m)
#align squarefree.of_mul_right Squarefree.of_mul_right

theorem Squarefree.squarefree_of_dvd [CommMonoid R] {x y : R} (hdvd : x ∣ y) (hsq : Squarefree y) :
    Squarefree x := fun _ h => hsq _ (h.trans hdvd)
#align squarefree.squarefree_of_dvd Squarefree.squarefree_of_dvd

section SquarefreeGcdOfSquarefree

variable {α : Type _} [CancelCommMonoidWithZero α] [GCDMonoid α]

theorem Squarefree.gcd_right (a : α) {b : α} (hb : Squarefree b) : Squarefree (gcd a b) :=
  hb.squarefree_of_dvd (gcd_dvd_right _ _)
#align squarefree.gcd_right Squarefree.gcd_right

theorem Squarefree.gcd_left {a : α} (b : α) (ha : Squarefree a) : Squarefree (gcd a b) :=
  ha.squarefree_of_dvd (gcd_dvd_left _ _)
#align squarefree.gcd_left Squarefree.gcd_left

end SquarefreeGcdOfSquarefree

namespace multiplicity

section CommMonoid

variable [CommMonoid R] [DecidableRel (Dvd.dvd : R → R → Prop)]

theorem squarefree_iff_multiplicity_le_one (r : R) :
    Squarefree r ↔ ∀ x : R, multiplicity x r ≤ 1 ∨ IsUnit x := by
  refine' forall_congr' fun a => _
  rw [← sq, pow_dvd_iff_le_multiplicity, or_iff_not_imp_left, not_le, imp_congr _ Iff.rfl]
  rw [←one_add_one_eq_two]
  simpa using PartENat.add_one_le_iff_lt (PartENat.natCast_ne_top 1)
#align multiplicity.squarefree_iff_multiplicity_le_one multiplicity.squarefree_iff_multiplicity_le_one

end CommMonoid

section CancelCommMonoidWithZero

variable [CancelCommMonoidWithZero R] [WfDvdMonoid R]

theorem finite_prime_left {a b : R} (ha : Prime a) (hb : b ≠ 0) : multiplicity.Finite a b := by
  classical
    revert hb
    refine'
      WfDvdMonoid.induction_on_irreducible b (fun c => c.irrefl.elim) (fun u hu _ => _)
        fun b p hb hp ih _ => _
    · rw [multiplicity.finite_iff_dom, multiplicity.isUnit_right ha.not_unit hu]
      exact PartENat.dom_natCast 0
    · refine'
        multiplicity.finite_mul ha
          (multiplicity.finite_iff_dom.mpr
            (PartENat.dom_of_le_natCast (show multiplicity a p ≤ ↑1 from _)))
          (ih hb)
      norm_cast
      exact
        ((multiplicity.squarefree_iff_multiplicity_le_one p).mp hp.squarefree a).resolve_right
          ha.not_unit
#align multiplicity.finite_prime_left multiplicity.finite_prime_left

end CancelCommMonoidWithZero

end multiplicity

section Irreducible

variable [CommMonoidWithZero R] [WfDvdMonoid R]

theorem irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree (r : R) :
    (∀ x : R, Irreducible x → ¬x * x ∣ r) ↔ (r = 0 ∧ ∀ x : R, ¬Irreducible x) ∨ Squarefree r := by
  symm
  constructor
  · rintro (⟨rfl, h⟩ | h)
    · simpa using h
    intro x hx t
    exact hx.not_unit (h x t)
  intro h
  rcases eq_or_ne r 0 with (rfl | hr)
  · exact Or.inl (by simpa using h)
  right
  intro x hx
  by_contra i
  have : x ≠ 0 := by
    rintro rfl
    apply hr
    simpa only [zero_dvd_iff, MulZeroClass.mul_zero] using hx
  obtain ⟨j, hj₁, hj₂⟩ := WfDvdMonoid.exists_irreducible_factor i this
  exact h _ hj₁ ((mul_dvd_mul hj₂ hj₂).trans hx)
#align irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree

theorem squarefree_iff_irreducible_sq_not_dvd_of_ne_zero {r : R} (hr : r ≠ 0) :
    Squarefree r ↔ ∀ x : R, Irreducible x → ¬x * x ∣ r := by
  simpa [hr] using (irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree r).symm
#align squarefree_iff_irreducible_sq_not_dvd_of_ne_zero squarefree_iff_irreducible_sq_not_dvd_of_ne_zero

theorem squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible {r : R}
    (hr : ∃ x : R, Irreducible x) : Squarefree r ↔ ∀ x : R, Irreducible x → ¬x * x ∣ r := by
  rw [irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree, ← not_exists]
  simp only [hr, not_true, false_or_iff, and_false_iff]
#align squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible

end Irreducible

section IsRadical

variable [CancelCommMonoidWithZero R]

theorem IsRadical.squarefree {x : R} (h0 : x ≠ 0) (h : IsRadical x) : Squarefree x := by
  rintro z ⟨w, rfl⟩
  specialize h 2 (z * w) ⟨w, by simp_rw [pow_two, mul_left_comm, ← mul_assoc]⟩
  rwa [← one_mul (z * w), mul_assoc, mul_dvd_mul_iff_right, ← isUnit_iff_dvd_one] at h
  rw [mul_assoc, mul_ne_zero_iff] at h0; exact h0.2
#align is_radical.squarefree IsRadical.squarefree

variable [GCDMonoid R]

theorem Squarefree.isRadical {x : R} (hx : Squarefree x) : IsRadical x :=
  (isRadical_iff_pow_one_lt 2 one_lt_two).2 fun y hy =>
    And.right <|
      (dvd_gcd_iff x x y).1
        (by
          by_cases gcd x y = 0
          · rw [h]
            apply dvd_zero
          replace hy := ((dvd_gcd_iff x x _).2 ⟨dvd_rfl, hy⟩).trans gcd_pow_right_dvd_pow_gcd
          obtain ⟨z, hz⟩ := gcd_dvd_left x y
          nth_rw 1 [hz] at hy⊢
          rw [pow_two, mul_dvd_mul_iff_left h] at hy
          obtain ⟨w, hw⟩ := hy
          exact (hx z ⟨w, by rwa [mul_right_comm, ← hw]⟩).mul_right_dvd.2 dvd_rfl)
#align squarefree.is_radical Squarefree.isRadical

theorem isRadical_iff_squarefree_or_zero {x : R} : IsRadical x ↔ Squarefree x ∨ x = 0 :=
  ⟨fun hx => (em <| x = 0).elim Or.inr fun h => Or.inl <| hx.squarefree h,
    Or.rec Squarefree.isRadical <| by
      rintro rfl
      rw [zero_isRadical_iff]
      infer_instance⟩
#align is_radical_iff_squarefree_or_zero isRadical_iff_squarefree_or_zero

theorem isRadical_iff_squarefree_of_ne_zero {x : R} (h : x ≠ 0) : IsRadical x ↔ Squarefree x :=
  ⟨IsRadical.squarefree h, Squarefree.isRadical⟩
#align is_radical_iff_squarefree_of_ne_zero isRadical_iff_squarefree_of_ne_zero

end IsRadical

namespace UniqueFactorizationMonoid

variable [CancelCommMonoidWithZero R] [UniqueFactorizationMonoid R]

theorem squarefree_iff_nodup_normalizedFactors [NormalizationMonoid R] [DecidableEq R] {x : R}
    (x0 : x ≠ 0) : Squarefree x ↔ Multiset.Nodup (normalizedFactors x) := by
  have drel : DecidableRel (Dvd.dvd : R → R → Prop) := by classical infer_instance
  rw [multiplicity.squarefree_iff_multiplicity_le_one, Multiset.nodup_iff_count_le_one]
  haveI := nontrivial_of_ne x 0 x0
  constructor <;> intro h a
  · by_cases hmem : a ∈ normalizedFactors x
    · have ha := irreducible_of_normalized_factor _ hmem
      rcases h a with (h | h)
      · rw [← normalize_normalized_factor _ hmem]
        rw [multiplicity_eq_count_normalizedFactors ha x0] at h
        assumption_mod_cast
      · have := ha.1
        contradiction
    · simp [Multiset.count_eq_zero_of_not_mem hmem]
  · rw [or_iff_not_imp_right]
    intro hu
    by_cases h0 : a = 0
    · simp [h0, x0]
    rcases WfDvdMonoid.exists_irreducible_factor hu h0 with ⟨b, hib, hdvd⟩
    apply le_trans (multiplicity.multiplicity_le_multiplicity_of_dvd_left hdvd)
    rw [multiplicity_eq_count_normalizedFactors hib x0]
    specialize h (normalize b)
    assumption_mod_cast
#align unique_factorization_monoid.squarefree_iff_nodup_normalized_factors UniqueFactorizationMonoid.squarefree_iff_nodup_normalizedFactors

theorem dvd_pow_iff_dvd_of_squarefree {x y : R} {n : ℕ} (hsq : Squarefree x) (h0 : n ≠ 0) :
    x ∣ y ^ n ↔ x ∣ y := by
  classical
    haveI := UniqueFactorizationMonoid.toGCDMonoid R
    exact ⟨hsq.isRadical n y, fun h => h.pow h0⟩
#align unique_factorization_monoid.dvd_pow_iff_dvd_of_squarefree UniqueFactorizationMonoid.dvd_pow_iff_dvd_of_squarefree

end UniqueFactorizationMonoid


import data.real.basic data.set.intervals topology.basic analysis.exponential
local attribute [instance] classical.prop_decidable

-- * Example 5: y(x) = (η e^{κx}-1)/κ (when x ≤ ξ) and (η e^{κx}-e^{κ(x-ξ)})/κ (when x > ξ) (assuming κ nonzero) is continuous on ℝ.

-- NB. I've gotten started with a simpler warm-up exercise, using the
-- absolute value function instead of the one mentioned in the
-- headline.  In the end the treatment of the two functions will be
-- similar.

open real

-- Only one of these will unfold properly
noncomputable def fake_abs : ℝ → ℝ := λ x, if x < 0 then -x else x

lemma fake_abs_is_abs : fake_abs = (λ x, abs x)  :=
begin
unfold fake_abs abs,
-- Goal is now:
-- ⊢ (λ (x : ℝ), ite (x ≤ 0) (-x) x) = λ (x : ℝ), max x (-x)
funext,
by_cases x < 0,
-- Goal is now:
-- ⊢ ite (x < 0) (-x) x = max x (-x)
simp [if_pos h],
-- * used sorry to sketch out all of the "have" steps here, getting the skeleton of the proof established
have he : -x > 0, from neg_pos_of_neg h,
have hl : -x > x, from lt_trans h he,
have hm : max x (-x) = -x, from max_eq_right_of_lt hl,
exact hm.symm,
simp [if_neg h],
-- Goal is now:
-- ⊢ x = max x (-x)
-- this intermediate step was harder than I would have thought
have he : 0 ≤ x, from begin simp at h, exact h, end,
have hl : -x ≤ 0, from neg_nonpos_of_nonneg he,
have hll : -x ≤ x, from le_trans hl he,
have hm : max x (-x) = x, from max_eq_left hll,
exact hm.symm,
end

lemma continuous_fake_abs : continuous fake_abs := begin
unfold fake_abs,
apply continuous_if _ _ _,
intro,
intro,
-- I don't know how to do this part...
sorry,
--- but the rest is then routine.
refine continuous_neg _,
exact continuous_id,
exact continuous_id,
end

lemma continuous_abs : continuous (λ (x:ℝ), abs x) := begin
rw ←fake_abs_is_abs,
exact continuous_fake_abs,
end


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

! This file was ported from Lean 3 source module algebra.homology.single
! leanprover-community/mathlib commit 324a7502510e835cdbd3de1519b6c66b51fb2467
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Homology.Homology

/-!
# Chain complexes supported in a single degree

We define `single V j c : V ⥤ homological_complex V c`,
which constructs complexes in `V` of shape `c`, supported in degree `j`.

Similarly `single₀ V : V ⥤ chain_complex V ℕ` is the special case for
`ℕ`-indexed chain complexes, with the object supported in degree `0`,
but with better definitional properties.

In `to_single₀_equiv` we characterize chain maps to a `ℕ`-indexed complex concentrated in degree 0;
they are equivalent to `{ f : C.X 0 ⟶ X // C.d 1 0 ≫ f = 0 }`.
(This is useful translating between a projective resolution and
an augmented exact complex of projectives.)
-/

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

universe v u

variable (V : Type u) [Category.{v} V] [HasZeroMorphisms V] [HasZeroObject V]

namespace HomologicalComplex

variable {ι : Type _} [DecidableEq ι] (c : ComplexShape ι)

attribute [local instance] has_zero_object.has_zero

/-- The functor `V ⥤ homological_complex V c` creating a chain complex supported in a single degree.

See also `chain_complex.single₀ : V ⥤ chain_complex V ℕ`,
which has better definitional properties,
if you are working with `ℕ`-indexed complexes.
-/
@[simps]
def single (j : ι) : V ⥤ HomologicalComplex V c
    where
  obj A :=
    { pt := fun i => if i = j then A else 0
      d := fun i j => 0 }
  map A B f :=
    {
      f := fun i =>
        if h : i = j then
          eqToHom
              (by
                dsimp
                rw [if_pos h]) ≫
            f ≫
              eqToHom
                (by
                  dsimp
                  rw [if_pos h])
        else 0 }
  map_id' A := by
    ext
    dsimp
    split_ifs with h
    · subst h
      simp
    · rw [if_neg h]
      simp
  map_comp' A B C f g := by
    ext
    dsimp
    split_ifs with h
    · subst h
      simp
    · simp
#align homological_complex.single HomologicalComplex.single

/-- The object in degree `j` of `(single V c h).obj A` is just `A`.
-/
@[simps]
def singleObjXSelf (j : ι) (A : V) : ((single V c j).obj A).pt j ≅ A :=
  eqToIso (by simp)
#align homological_complex.single_obj_X_self HomologicalComplex.singleObjXSelf

@[simp]
theorem single_map_f_self (j : ι) {A B : V} (f : A ⟶ B) :
    ((single V c j).map f).f j = (singleObjXSelf V c j A).Hom ≫ f ≫ (singleObjXSelf V c j B).inv :=
  by
  simp
  rfl
#align homological_complex.single_map_f_self HomologicalComplex.single_map_f_self

instance (j : ι) : Faithful (single V c j)
    where map_injective' X Y f g w := by
    have := congr_hom w j
    dsimp at this
    simp only [dif_pos] at this
    rw [← is_iso.inv_comp_eq, inv_eq_to_hom, eq_to_hom_trans_assoc, eq_to_hom_refl,
      category.id_comp, ← is_iso.comp_inv_eq, category.assoc, inv_eq_to_hom, eq_to_hom_trans,
      eq_to_hom_refl, category.comp_id] at this
    exact this

instance (j : ι) : Full (single V c j)
    where
  preimage X Y f := eqToHom (by simp) ≫ f.f j ≫ eqToHom (by simp)
  witness' X Y f := by
    ext i
    dsimp
    split_ifs
    · subst h
      simp
    · symm
      apply zero_of_target_iso_zero
      dsimp
      rw [if_neg h]

end HomologicalComplex

open HomologicalComplex

namespace ChainComplex

attribute [local instance] has_zero_object.has_zero

/-- `chain_complex.single₀ V` is the embedding of `V` into `chain_complex V ℕ`
as chain complexes supported in degree 0.

This is naturally isomorphic to `single V _ 0`, but has better definitional properties.
-/
def single₀ : V ⥤ ChainComplex V ℕ
    where
  obj X :=
    { pt := fun n =>
        match n with
        | 0 => X
        | n + 1 => 0
      d := fun i j => 0 }
  map X Y f :=
    {
      f := fun n =>
        match n with
        | 0 => f
        | n + 1 => 0 }
  map_id' X := by
    ext n
    cases n
    rfl
    dsimp
    unfold_aux
    simp
  map_comp' X Y Z f g := by
    ext n
    cases n
    rfl
    dsimp
    unfold_aux
    simp
#align chain_complex.single₀ ChainComplex.single₀

@[simp]
theorem single₀_obj_x_0 (X : V) : ((single₀ V).obj X).pt 0 = X :=
  rfl
#align chain_complex.single₀_obj_X_0 ChainComplex.single₀_obj_x_0

@[simp]
theorem single₀_obj_x_succ (X : V) (n : ℕ) : ((single₀ V).obj X).pt (n + 1) = 0 :=
  rfl
#align chain_complex.single₀_obj_X_succ ChainComplex.single₀_obj_x_succ

@[simp]
theorem single₀_obj_x_d (X : V) (i j : ℕ) : ((single₀ V).obj X).d i j = 0 :=
  rfl
#align chain_complex.single₀_obj_X_d ChainComplex.single₀_obj_x_d

@[simp]
theorem single₀_obj_x_dTo (X : V) (j : ℕ) : ((single₀ V).obj X).dTo j = 0 :=
  by
  rw [d_to_eq ((single₀ V).obj X) rfl]
  simp
#align chain_complex.single₀_obj_X_d_to ChainComplex.single₀_obj_x_dTo

@[simp]
theorem single₀_obj_x_dFrom (X : V) (i : ℕ) : ((single₀ V).obj X).dFrom i = 0 :=
  by
  cases i
  · rw [d_from_eq_zero]
    simp
  · rw [d_from_eq ((single₀ V).obj X) rfl]
    simp
#align chain_complex.single₀_obj_X_d_from ChainComplex.single₀_obj_x_dFrom

@[simp]
theorem single₀_map_f_0 {X Y : V} (f : X ⟶ Y) : ((single₀ V).map f).f 0 = f :=
  rfl
#align chain_complex.single₀_map_f_0 ChainComplex.single₀_map_f_0

@[simp]
theorem single₀_map_f_succ {X Y : V} (f : X ⟶ Y) (n : ℕ) : ((single₀ V).map f).f (n + 1) = 0 :=
  rfl
#align chain_complex.single₀_map_f_succ ChainComplex.single₀_map_f_succ

section

variable [HasEqualizers V] [HasCokernels V] [HasImages V] [HasImageMaps V]

/-- Sending objects to chain complexes supported at `0` then taking `0`-th homology
is the same as doing nothing.
-/
noncomputable def homologyFunctor0Single₀ : single₀ V ⋙ homologyFunctor V _ 0 ≅ 𝟭 V :=
  NatIso.ofComponents (fun X => homology.congr _ _ (by simp) (by simp) ≪≫ homologyZeroZero)
    fun X Y f => by
    ext
    dsimp [homologyFunctor]
    simp
#align chain_complex.homology_functor_0_single₀ ChainComplex.homologyFunctor0Single₀

/-- Sending objects to chain complexes supported at `0` then taking `(n+1)`-st homology
is the same as the zero functor.
-/
noncomputable def homologyFunctorSuccSingle₀ (n : ℕ) :
    single₀ V ⋙ homologyFunctor V _ (n + 1) ≅ 0 :=
  NatIso.ofComponents
    (fun X =>
      homology.congr _ _ (by simp) (by simp) ≪≫
        homologyZeroZero ≪≫ (Functor.zero_obj _).isoZero.symm)
    fun X Y f => (functor.zero_obj _).eq_of_tgt _ _
#align chain_complex.homology_functor_succ_single₀ ChainComplex.homologyFunctorSuccSingle₀

end

variable {V}

/-- Morphisms from a `ℕ`-indexed chain complex `C`
to a single object chain complex with `X` concentrated in degree 0
are the same as morphisms `f : C.X 0 ⟶ X` such that `C.d 1 0 ≫ f = 0`.
-/
@[simps]
def toSingle₀Equiv (C : ChainComplex V ℕ) (X : V) :
    (C ⟶ (single₀ V).obj X) ≃ { f : C.pt 0 ⟶ X // C.d 1 0 ≫ f = 0 }
    where
  toFun f :=
    ⟨f.f 0, by
      rw [← f.comm 1 0]
      simp⟩
  invFun f :=
    { f := fun i =>
        match i with
        | 0 => f.1
        | n + 1 => 0
      comm' := fun i j h =>
        by
        rcases i with (_ | _ | i) <;> cases j <;> unfold_aux <;>
          simp only [comp_zero, zero_comp, single₀_obj_X_d]
        · rw [C.shape, zero_comp]
          simp
        · exact f.2.symm
        · rw [C.shape, zero_comp]
          simp [i.succ_succ_ne_one.symm] }
  left_inv f := by
    ext i
    rcases i with ⟨⟩
    · rfl
    · ext
  right_inv := by tidy
#align chain_complex.to_single₀_equiv ChainComplex.toSingle₀Equiv

@[ext]
theorem to_single₀_ext {C : ChainComplex V ℕ} {X : V} (f g : C ⟶ (single₀ V).obj X)
    (h : f.f 0 = g.f 0) : f = g :=
  (toSingle₀Equiv C X).Injective
    (by
      ext
      exact h)
#align chain_complex.to_single₀_ext ChainComplex.to_single₀_ext

/-- Morphisms from a single object chain complex with `X` concentrated in degree 0
to a `ℕ`-indexed chain complex `C` are the same as morphisms `f : X → C.X`.
-/
@[simps]
def fromSingle₀Equiv (C : ChainComplex V ℕ) (X : V) : ((single₀ V).obj X ⟶ C) ≃ (X ⟶ C.pt 0)
    where
  toFun f := f.f 0
  invFun f :=
    { f := fun i =>
        match i with
        | 0 => f
        | n + 1 => 0
      comm' := fun i j h => by
        cases i <;> cases j <;> unfold_aux <;>
          simp only [shape, ComplexShape.down_Rel, Nat.one_ne_zero, not_false_iff, comp_zero,
            zero_comp, Nat.succ_ne_zero, single₀_obj_X_d] }
  left_inv f := by
    ext i
    cases i
    · rfl
    · ext
  right_inv g := rfl
#align chain_complex.from_single₀_equiv ChainComplex.fromSingle₀Equiv

variable (V)

/-- `single₀` is the same as `single V _ 0`. -/
def single₀IsoSingle : single₀ V ≅ single V _ 0 :=
  NatIso.ofComponents
    (fun X =>
      { Hom := { f := fun i => by cases i <;> simpa using 𝟙 _ }
        inv := { f := fun i => by cases i <;> simpa using 𝟙 _ }
        hom_inv_id' := by
          ext (_ | i) <;>
            · dsimp
              simp
        inv_hom_id' := by
          ext (_ | i)
          · apply category.id_comp
          · apply has_zero_object.to_zero_ext })
    fun X Y f => by
    ext (_ | i) <;>
      · dsimp
        simp
#align chain_complex.single₀_iso_single ChainComplex.single₀IsoSingle

instance : Faithful (single₀ V) :=
  Faithful.of_iso (single₀IsoSingle V).symm

instance : Full (single₀ V) :=
  Full.ofIso (single₀IsoSingle V).symm

end ChainComplex

namespace CochainComplex

attribute [local instance] has_zero_object.has_zero

/-- `cochain_complex.single₀ V` is the embedding of `V` into `cochain_complex V ℕ`
as cochain complexes supported in degree 0.

This is naturally isomorphic to `single V _ 0`, but has better definitional properties.
-/
def single₀ : V ⥤ CochainComplex V ℕ
    where
  obj X :=
    { pt := fun n =>
        match n with
        | 0 => X
        | n + 1 => 0
      d := fun i j => 0 }
  map X Y f :=
    {
      f := fun n =>
        match n with
        | 0 => f
        | n + 1 => 0 }
  map_id' X := by
    ext n
    cases n
    rfl
    dsimp
    unfold_aux
    simp
  map_comp' X Y Z f g := by
    ext n
    cases n
    rfl
    dsimp
    unfold_aux
    simp
#align cochain_complex.single₀ CochainComplex.single₀

@[simp]
theorem single₀_obj_x_0 (X : V) : ((single₀ V).obj X).pt 0 = X :=
  rfl
#align cochain_complex.single₀_obj_X_0 CochainComplex.single₀_obj_x_0

@[simp]
theorem single₀_obj_x_succ (X : V) (n : ℕ) : ((single₀ V).obj X).pt (n + 1) = 0 :=
  rfl
#align cochain_complex.single₀_obj_X_succ CochainComplex.single₀_obj_x_succ

@[simp]
theorem single₀_obj_x_d (X : V) (i j : ℕ) : ((single₀ V).obj X).d i j = 0 :=
  rfl
#align cochain_complex.single₀_obj_X_d CochainComplex.single₀_obj_x_d

@[simp]
theorem single₀_obj_x_dFrom (X : V) (j : ℕ) : ((single₀ V).obj X).dFrom j = 0 :=
  by
  rw [d_from_eq ((single₀ V).obj X) rfl]
  simp
#align cochain_complex.single₀_obj_X_d_from CochainComplex.single₀_obj_x_dFrom

@[simp]
theorem single₀_obj_x_dTo (X : V) (i : ℕ) : ((single₀ V).obj X).dTo i = 0 :=
  by
  cases i
  · rw [d_to_eq_zero]
    simp
  · rw [d_to_eq ((single₀ V).obj X) rfl]
    simp
#align cochain_complex.single₀_obj_X_d_to CochainComplex.single₀_obj_x_dTo

@[simp]
theorem single₀_map_f_0 {X Y : V} (f : X ⟶ Y) : ((single₀ V).map f).f 0 = f :=
  rfl
#align cochain_complex.single₀_map_f_0 CochainComplex.single₀_map_f_0

@[simp]
theorem single₀_map_f_succ {X Y : V} (f : X ⟶ Y) (n : ℕ) : ((single₀ V).map f).f (n + 1) = 0 :=
  rfl
#align cochain_complex.single₀_map_f_succ CochainComplex.single₀_map_f_succ

section

variable [HasEqualizers V] [HasCokernels V] [HasImages V] [HasImageMaps V]

/-- Sending objects to cochain complexes supported at `0` then taking `0`-th homology
is the same as doing nothing.
-/
noncomputable def homologyFunctor0Single₀ : single₀ V ⋙ homologyFunctor V _ 0 ≅ 𝟭 V :=
  NatIso.ofComponents (fun X => homology.congr _ _ (by simp) (by simp) ≪≫ homologyZeroZero)
    fun X Y f => by
    ext
    dsimp [homologyFunctor]
    simp
#align cochain_complex.homology_functor_0_single₀ CochainComplex.homologyFunctor0Single₀

/-- Sending objects to cochain complexes supported at `0` then taking `(n+1)`-st homology
is the same as the zero functor.
-/
noncomputable def homologyFunctorSuccSingle₀ (n : ℕ) :
    single₀ V ⋙ homologyFunctor V _ (n + 1) ≅ 0 :=
  NatIso.ofComponents
    (fun X =>
      homology.congr _ _ (by simp) (by simp) ≪≫
        homologyZeroZero ≪≫ (Functor.zero_obj _).isoZero.symm)
    fun X Y f => (functor.zero_obj _).eq_of_tgt _ _
#align cochain_complex.homology_functor_succ_single₀ CochainComplex.homologyFunctorSuccSingle₀

end

variable {V}

/-- Morphisms from a single object cochain complex with `X` concentrated in degree 0
to a `ℕ`-indexed cochain complex `C`
are the same as morphisms `f : X ⟶ C.X 0` such that `f ≫ C.d 0 1 = 0`.
-/
def fromSingle₀Equiv (C : CochainComplex V ℕ) (X : V) :
    ((single₀ V).obj X ⟶ C) ≃ { f : X ⟶ C.pt 0 // f ≫ C.d 0 1 = 0 }
    where
  toFun f :=
    ⟨f.f 0, by
      rw [f.comm 0 1]
      simp⟩
  invFun f :=
    { f := fun i =>
        match i with
        | 0 => f.1
        | n + 1 => 0
      comm' := fun i j h =>
        by
        rcases j with (_ | _ | j) <;> cases i <;> unfold_aux <;>
          simp only [comp_zero, zero_comp, single₀_obj_X_d]
        · convert comp_zero
          rw [C.shape]
          simp
        · exact f.2
        · convert comp_zero
          rw [C.shape]
          simp only [ComplexShape.up_Rel, zero_add]
          exact (Nat.one_lt_succ_succ j).Ne }
  left_inv f := by
    ext i
    rcases i with ⟨⟩
    · rfl
    · ext
  right_inv := by tidy
#align cochain_complex.from_single₀_equiv CochainComplex.fromSingle₀Equiv

variable (V)

/-- `single₀` is the same as `single V _ 0`. -/
def single₀IsoSingle : single₀ V ≅ single V _ 0 :=
  NatIso.ofComponents
    (fun X =>
      { Hom := { f := fun i => by cases i <;> simpa using 𝟙 _ }
        inv := { f := fun i => by cases i <;> simpa using 𝟙 _ }
        hom_inv_id' := by
          ext (_ | i) <;>
            · dsimp
              simp
        inv_hom_id' := by
          ext (_ | i)
          · apply category.id_comp
          · apply has_zero_object.to_zero_ext })
    fun X Y f => by
    ext (_ | i) <;>
      · dsimp
        simp
#align cochain_complex.single₀_iso_single CochainComplex.single₀IsoSingle

instance : Faithful (single₀ V) :=
  Faithful.of_iso (single₀IsoSingle V).symm

instance : Full (single₀ V) :=
  Full.ofIso (single₀IsoSingle V).symm

end CochainComplex


import data.rat.defs
import data.nat.parity
import tactic.basic

open nat

noncomputable theory -- definitions are allowed to not compute in this file
open_locale classical -- use classical logic in this file

/-!
## Structures and Classes

In this session we will discuss structures together,
and then you can solve the exercises yourself.

Before we start, run the following in a terminal:
```
  cd /path/to/lftcm2020/
  git pull
  leanproject get-mathlib-cache
```
If `git pull` didn't work because you edited one of the files in the repository,
first copy the files to a backup version and then run `git checkout -- .`
(this will remove all changes to files you edited, so be careful!)

### Declaring a Structure

Structures are a way to bundle information together.

For example, the first example below makes a new structure
  `even_natural_number`, which consists of pairs, where the first
  component is a natural number, and the second component is a
  proof that the natural number is even. These are called the *fields* of the structure.
-/
structure even_natural_number : Type :=
  (n : ℕ)
  (even_n : even n)

/-! We can also group propositions together, for example this is a proposition
  stating that `n` is an even cube greater than 100.
  Note that this is a property of a natural number, while the previous structure
  was a natural number with a property "bundled" together. -/
structure is_even_cube_above_100 (n : ℕ) : Prop :=
  (even : even n)
  (is_cube : ∃ k, n = k^3)
  (gt_100 : n > 100)

/-! Here we give the upper bounds for a function `f`. We can omit the type of the structure. -/
structure bounds (f : ℕ → ℕ) :=
  (bound : ℕ)
  (le_bound : ∀ (n : ℕ), f n ≤ bound)

/-! You can use `#print` to print the type and all fields of a structure. -/
#print even_natural_number
#print is_even_cube_above_100
#print bounds

/-!
  ### Exercise 1
  * Define a structure of eventually constant sequences `ℕ → ℕ`. The first field will be
    `seq : ℕ → ℕ`, and the second field will be the statement that `seq` is eventually constant.
  * Define a structure of a type with 2 points that are unequal.
    (hint: omit the type of the structure, Lean might complain if you give it explicitly)

  Lean will not tell you if you got the right definition, but it will complain if you make a syntax
  error. If you are unsure, ask a mentor to check whether your solution is correct.
-/

/-! ### Projections of a structure -/

/-! The field names are declared in the namespace of the structure.
  This means that their names have the form `<structure_name>.<field_name>`. -/
example (n : ℕ) (hn : is_even_cube_above_100 n) : n > 100 :=
is_even_cube_above_100.gt_100 hn

/-! You can also `open` the namespace, to use the abbreviated form.
  We put this `open` command inside a section, so that the namespace
  is closed at the end of the `section`. -/
section
open is_even_cube_above_100
example (n : ℕ) (hn : is_even_cube_above_100 n) : n > 100 :=
gt_100 hn
end

/-! Another useful technique is to use *projection notation*. Instead of writing
`is_even_cube_above_100.even hn` we can write `hn.even`.

  Lean will look at the type of `hn` and see that it is `is_even_cube_above_100 n`.
  Then it looks for the lemma with the name `is_even_cube_above_100.even` and apply it to `hn`. -/
example (n : ℕ) (hn : is_even_cube_above_100 n) : even n :=
hn.even

example (n : ℕ) (hn : is_even_cube_above_100 n) : even n ∧ ∃ k, n = k^3 :=
⟨ hn.even, hn.is_cube ⟩

/-! You can also use `.1`, `.2`, `.3`, ... for the fields of a structure. -/
example (n : ℕ) (hn : is_even_cube_above_100 n) : even n ∧ n > 100 ∧ (∃ k, n = k^3) :=
⟨ hn.1, hn.3, hn.2 ⟩

/-! We could have alternatively stated `is_even_cube_above_100`
  as a conjunction of three statements, as below.
  That gives the same proposition, but doesn't give a name to the three components. -/
def is_even_cube_above_100' (n : ℕ) : Prop :=
even n ∧ (∃ k, n = k^3) ∧ n > 100

/-! If we have a structure that mixes data (elements of types, like `ℕ`, `ℝ`, and so on) and
  properties of the data, we can alternatively declare them using *subtypes*.
  This consists of pairs of a natural number and a proof that the natural number is even. -/
def even_natural_number' : Type :=
{ n : ℕ // even n }

/-! The notation for subtypes is almost the same as the notation for set comprehension.
 Note that `//` is used for subtypes, and `|` is used for sets. -/
def set_of_even_natural_numbers : set ℕ :=
{ n : ℕ | even n }

/-! We can construct objects of a structure using the *anonymous constructor* `⟨...⟩`.
  This can construct an object of any structure, including conjunctions,
  existential statements and subtypes. -/
example : even_natural_number → even_natural_number' :=
λ n, ⟨n.1, n.2⟩

example (n : ℕ) : is_even_cube_above_100 n → is_even_cube_above_100' n :=
λ hn, ⟨hn.even, hn.is_cube, hn.gt_100⟩

/-! An alternative way is to use the *structure notation*. The syntax for this is
  ```
    { structure_name . field1_name := value, field2_name := value, ... }
  ```
  You can prove the fields in any order you want.
-/
example : even_natural_number' → even_natural_number :=
λ n,
{ even_natural_number .
  n      := n.1,
  even_n := n.2 }

/-! The structure name is optional if the structure in question is clear from context. -/
example (n : ℕ) : is_even_cube_above_100' n → is_even_cube_above_100 n :=
λ ⟨h1n, h2n, h3n⟩,
{ even    := h1n,
  is_cube := h2n,
  gt_100  := h3n }

/-!
  ### Exercise 2
  * Define `bounds` (given above) again, but now using a the subtype notation `{ _ : _ // _ }`.
  * Define functions back and forth from the structure `bounds` given above and `bounds` given here.
    Try different variations using the anonymous constructor and the projection notation.
-/
#print bounds

def bounds' (f : ℕ → ℕ) : Type :=
sorry

example (f : ℕ → ℕ) : bounds f → bounds' f :=
sorry

/- In the example below, replace the `sorry` by an underscore `_`.
  A small yellow lightbulb will appear. Click it, and then select
  `Generate skeleton for the structure under construction`.
  This will automatically give an outline of the structure for you. -/
example (f : ℕ → ℕ) : bounds' f → bounds f :=
λ n, sorry

/-! Before you continue, watch the second pre-recorded video. -/

/-! ### Classes

Classes are special kind of types or propositions that Lean will automatically find inhabitants for.

You can declare a class by giving it the `@[class]` attribute.

As an example, in this section, we will implement square root on natural numbers, that can only be
applied to natural numbers that are squares. -/
@[class] def is_nat_square (n : ℕ) : Prop := ∃k : ℕ, k^2 = n

namespace is_nat_square

/-! Hypotheses with a class as type should be written in square brackets `[...]`.
This tells Lean that they are implicit, and Lean will try to fill them in automatically.

We define the square root as the (unique) number `k` such that `k^2 = n`. Such `k` exists by the
`is_nat_square n` hypothesis. -/
def sqrt (n : ℕ) [hn : is_nat_square n] : ℕ := classical.some hn

prefix `√`:(max+1) := sqrt -- notation for `sqrt`

/-! The following is the defining property of `√n`. Note that when we write `√n`,
Lean will automatically insert the implicit argument `hn` it found it the context.
This is called *type-class inference*.
We mark this lemma with the `@[simp]` attribute to tell `simp` to simplify using this lemma. -/
@[simp] lemma square_sqrt (n : ℕ) [hn : is_nat_square n] : (√n) ^ 2 = n :=
classical.some_spec hn

/-! ### Exercise:
  Fill in all `sorry`s in the remainder of this section.
-/

/-! Prove this lemma. Again we mark it `@[simp]` so that `simp` can simplify
  equalities involving `√`. Also, hypotheses in square brackets do not need a name.

  Hint: use `pow_left_inj` -/
@[simp] lemma sqrt_eq_iff (n k : ℕ) [is_nat_square n] : √n = k ↔ n = k^2 :=
begin
  sorry
end

/-! To help type-class inference, we have to tell it that some numbers are always squares.
  Here we show that `n^2` is always a square. We mark it as `instance`, which is like
  `lemma` or `def`, except that it is automatically used by type-class inference. -/
instance square_square (n : ℕ) : is_nat_square (n^2) :=
⟨n, rfl⟩

lemma sqrt_square (n : ℕ) : √(n ^ 2) = n :=
by simp

/-! Instances can depend on other instances: here we show that if `n` and `m` are squares, then
`n * m` is one, too.

When writing `√n`, Lean will use a simple search algorithm to find a proof that `n` is a square, by
repeatedly applying previously declared instances, and arguments in the local context. -/
instance square_mul (n m : ℕ) [is_nat_square n] [is_nat_square m] : is_nat_square (n*m) :=
⟨√n * √m, by simp [mul_pow]⟩

/-! Hint: use `mul_pow` -/
#check mul_pow
lemma sqrt_mul (n m : ℕ) [is_nat_square n] [is_nat_square m] : √(n * m) = √n * √m :=
begin
  sorry
end

/-! Note that Lean automatically inserts the proof that `n * m ^ 2` is a square,
  using the previously declared instances. -/
example (n m : ℕ) [is_nat_square n] : √(n * m ^ 2) = √n * m :=
begin
  sorry
end

/-! Hint: use `nat.le_mul_self` and `pow_two` -/
#check nat.le_mul_self
#check pow_two
lemma sqrt_le (n : ℕ) [is_nat_square n] : √n ≤ n :=
begin
  sorry
end

end is_nat_square

/- At this point, feel free do the remaining exercises in any order. -/

/-! ### Exercise: Bijections and equivalences -/

section bijections

open function

variables {α β : Type*}

/-
An important structure is the type of equivalences, which gives an equivalence (bijection)
between two types:
```
structure equiv (α β : Type*) :=
(to_fun    : α → β)
(inv_fun   : β → α)
(left_inv  : left_inverse inv_fun to_fun)
(right_inv : right_inverse inv_fun to_fun)
```
In this section we show that this is the same as the bijections from `α` to `β`.
-/
#print equiv

structure bijection (α β : Type*) :=
  (to_fun : α → β)
  (injective : injective to_fun)
  (surjective : surjective to_fun)

/- We declare a *coercion*. This allows us to treat `f` as a function if `f : bijection α β`. -/
instance : has_coe_to_fun (bijection α β) (λ _, α → β) :=
⟨λ f, f.to_fun⟩

/-! To show that two bijections are equal, it is sufficient that the underlying functions are
  equal on all inputs. We mark it as `@[ext]` so that we can later use the tactic `ext` to show that
  two bijections are equal. -/
@[ext] def bijection.ext {f g : bijection α β} (hfg : ∀ x, f x = g x) : f = g :=
by { cases f, cases g, congr, ext, exact hfg x }

/-! This lemma allows `simp` to reduce the application of a bijection to an argument. -/
@[simp] lemma coe_mk {f : α → β} {h1f : injective f} {h2f : surjective f} {x : α} :
  { bijection . to_fun := f, injective := h1f, surjective := h2f } x = f x := rfl

/- There is a lemma in the library that almost states this.
  You can use the tactic `suggest` to get suggested lemmas from Lean
  (the one you want has `bijective` in the name). -/
def equiv_of_bijection (f : bijection α β) : α ≃ β :=
begin
  sorry
end

def bijection_of_equiv (f : α ≃ β) : bijection α β :=
sorry

/-! Show that bijections are the same (i.e. equivalent) to equivalences. -/
def bijection_equiv_equiv : bijection α β ≃ (α ≃ β) :=
sorry

end bijections

/-! ### Exercise: Bundled groups -/

/-! Below is a possible definition of a group in Lean.
  It's not the definition we use use in mathlib. The actual definition uses classes,
  and will be explained in detail in the next session. -/

structure Group :=
  (G : Type*)
  (op : G → G → G)
  (infix (name := my_mul) * := op) -- temporary notation `*` for `op`, just inside this structure declaration
  (op_assoc' : ∀ (x y z : G), (x * y) * z = x * (y * z))
  (id : G)
  (notation 1 := id) -- temporary notation `1` for `id`, just inside this structure declaration
  (id_op' : ∀ (x : G), 1 * x = x)
  (inv : G → G)
  (postfix (name := my_inv) ⁻¹ := inv) -- temporary notation `⁻¹` for `inv`, just inside this structure declaration
  (op_left_inv' : ∀ (x : G), x⁻¹ * x = 1)

/-! You can use the `extend` command to define a structure that adds fields
  to one or more existing structures. -/
structure CommGroup extends Group :=
  (infix (name := my_mul) * := op)
  (op_comm : ∀ (x y : G), x * y = y * x)

/- Here is an example: the rationals form a group under addition. -/
def rat_Group : Group :=
{ G := ℚ,
  op := (+), -- you can put parentheses around an infix operation to talk about the operation itself.
  op_assoc' := add_assoc,
  id := 0,
  id_op' := zero_add,
  inv := λ x, -x,
  op_left_inv' := neg_add_self }

/-- You can extend an object of a structure by using the structure notation and using
  `..<existing object>`. -/
def rat_CommGroup : CommGroup :=
{ G := ℚ, op_comm := add_comm, ..rat_Group }

namespace Group

variables {G : Group} /- Let `G` be a group -/

/- The following line declares that if `G : Group`, then we can also view `G` as a type. -/
instance : has_coe_to_sort Group (Type*) := ⟨Group.G⟩
/- The following lines declare the notation `*`, `⁻¹` and `1` for the fields of `Group`. -/
instance : has_mul G := ⟨G.op⟩
instance : has_inv G := ⟨G.inv⟩
instance : has_one G := ⟨G.id⟩

/- the axioms for groups are satisfied -/
lemma op_assoc (x y z : G) : (x * y) * z = x * (y * z) := G.op_assoc' x y z

lemma id_op (x : G) : 1 * x = x := G.id_op' x

lemma op_left_inv (x : G) : x⁻¹ * x = 1 := G.op_left_inv' x

/- Use the axioms `op_assoc`, `id_op` and `op_left_inv` to prove the following lemma.
  The fields `op_assoc'`, `id_op'` and `op_left_inv'` should not be used directly, nor can you use
  any lemmas from the library about `mul`. -/
lemma eq_id_of_op_eq_self {G : Group} {x : G} : x * x = x → x = 1 :=
begin
  sorry
end

/- Apply the previous lemma to show that `⁻¹` is also a right-sided inverse. -/
lemma op_right_inv {G : Group} (x : G) : x * x⁻¹ = 1 :=
begin
  sorry
end

/- we can prove that `1` is also a right identity. -/
lemma op_id {G : Group} (x : G) : x * 1 = x :=
begin
  sorry
end

/-!
  However, it is inconvenient to use this group instance directly.
  One reason is that to use these group operations we now have to write
  `(x y : rat_Group)` instead of `(x y : ℚ)`.
  That's why in Lean we use classes for algebraic structures,
  explained in the next lecture.
-/

/- show that the cartesian product of two groups is a group. The underlying type will be `G × H`. -/

def prod_Group (G H : Group) : Group :=
sorry

end Group

/-! ### Exercise: Pointed types -/

structure pointed_type :=
(type : Type*)
(point : type)

namespace pointed_type
variables {A B : pointed_type}

/- The following line declares that if `A : pointed_type`, then we can also view `A` as a type. -/
instance : has_coe_to_sort pointed_type (Type* ):= ⟨pointed_type.type⟩

/- The product of two pointed types is a pointed type.
  The `@[simps point]` is a hint to `simp` that it can unfold the point of this definition. -/
@[simps point]
def prod (A B : pointed_type) : pointed_type :=
{ type := A × B,
  point := (A.point, B.point) }

end pointed_type

structure pointed_map (A B : pointed_type) :=
(to_fun : A → B)
(to_fun_point : to_fun A.point = B.point)

namespace pointed_map

infix ` →. `:25 := pointed_map

variables {A B C D : pointed_type}
variables {h : C →. D} {g : B →. C} {f f₁ f₂ : A →. B}

instance : has_coe_to_fun (A →. B) (λ _, A → B) := ⟨pointed_map.to_fun⟩

@[simp] lemma coe_mk {f : A → B} {hf : f A.point = B.point} {x : A} :
  { pointed_map . to_fun := f, to_fun_point := hf } x = f x := rfl
@[simp] lemma coe_point : f A.point = B.point := f.to_fun_point

@[ext] protected lemma ext (hf₁₂ : ∀ x, f₁ x = f₂ x) : f₁ = f₂ :=
begin
  sorry
end

/-! Below we show that pointed types form a category. -/

def comp (g : B →. C) (f : A →. B) : A →. C :=
sorry

def id : A →. A :=
sorry

/-! You can use projection notation for any declaration declared in the same namespace as the
  structure. For example, `g.comp f` means `pointed_map.comp g f` -/
lemma comp_assoc : h.comp (g.comp f) = (h.comp g).comp f :=
sorry

lemma id_comp : f.comp id = f :=
sorry

lemma comp_id : id.comp f = f :=
sorry

/-! Below we show that `A.prod B` (that is, `pointed_type.prod A B`) is a product in the category of
  pointed types. -/

def fst : A.prod B →. A :=
sorry

def snd : A.prod B →. B :=
sorry

def pair (f : C →. A) (g : C →. B) : C →. A.prod B :=
sorry

lemma fst_pair (f : C →. A) (g : C →. B) : fst.comp (f.pair g) = f :=
sorry

lemma snd_pair (f : C →. A) (g : C →. B) : snd.comp (f.pair g) = g :=
sorry

lemma pair_unique (f : C →. A) (g : C →. B) (u : C →. A.prod B) (h1u : fst.comp u = f)
  (h2u : snd.comp u = g) : u = f.pair g :=
begin
  sorry
end

end pointed_map

/-! As an advanced exercise, you can show that the category of pointed type has coproducts.
  For this we need quotients, the basic interface is given with the declarations
  `quot r`: the quotient of the equivalence relation generated by relation `r` on `A`
  `quot.mk r : A → quot r`,
  `quot.sound`
  `quot.lift` (see below)
  -/

#print quot
#print quot.mk
#print quot.sound
#print quot.lift

open sum

/-! We want to define the coproduct of pointed types `A` and `B` as the coproduct `A ⊕ B` of the
  underlying type, identifying the two basepoints.

  First define a relation that *only* relates `inl A.point ~ inr B.point`.
-/
def coprod_rel (A B : pointed_type) : (A ⊕ B) → (A ⊕ B) → Prop :=
sorry

namespace pointed_type

-- @[simps point]

def coprod (A B : pointed_type) : pointed_type :=
sorry
end pointed_type

namespace pointed_map

variables {A B C D : pointed_type}

def inl : A →. A.coprod B :=
sorry

def inr : B →. A.coprod B :=
sorry

def elim (f : A →. C) (g : B →. C) : A.coprod B →. C :=
sorry

lemma elim_comp_inl (f : A →. C) (g : B →. C) : (f.elim g).comp inl = f :=
sorry

lemma elim_comp_inr (f : A →. C) (g : B →. C) : (f.elim g).comp inr = g :=
sorry

lemma elim_unique (f : A →. C) (g : B →. C) (u : A.coprod B →. C) (h1u : u.comp inl = f)
  (h2u : u.comp inr = g) : u = f.elim g :=
begin
  sorry
end

end pointed_map


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Eric Wieser
-/
import data.matrix.basis
import ring_theory.tensor_product

/-!
We show `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)`.
-/

universes u v w

open_locale tensor_product
open_locale big_operators

open tensor_product
open algebra.tensor_product
open matrix

variables {R : Type u} [comm_semiring R]
variables {A : Type v} [semiring A] [algebra R A]
variables {n : Type w}

variables (R A n)
namespace matrix_equiv_tensor

/--
(Implementation detail).
The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
as an `R`-bilinear map.
-/
def to_fun_bilinear : A →ₗ[R] matrix n n R →ₗ[R] matrix n n A :=
(algebra.lsmul R (matrix n n A)).to_linear_map.compl₂ (algebra.linear_map R A).map_matrix

@[simp] lemma to_fun_bilinear_apply (a : A) (m : matrix n n R) :
  to_fun_bilinear R A n a m = a • m.map (algebra_map R A) := rfl

/--
(Implementation detail).
The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
as an `R`-linear map.
-/
def to_fun_linear : A ⊗[R] matrix n n R →ₗ[R] matrix n n A :=
tensor_product.lift (to_fun_bilinear R A n)

variables [decidable_eq n] [fintype n]

/--
The function `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`, as an algebra homomorphism.
-/
def to_fun_alg_hom : (A ⊗[R] matrix n n R) →ₐ[R] matrix n n A :=
alg_hom_of_linear_map_tensor_product
(to_fun_linear R A n)
begin
  intros,
  simp_rw [to_fun_linear, lift.tmul, to_fun_bilinear_apply, mul_eq_mul, matrix.map_mul],
  ext,
  dsimp,
  simp_rw [matrix.mul_apply, matrix.map, pi.smul_apply, smul_eq_mul, finset.mul_sum,
    _root_.mul_assoc, algebra.left_comm],
end
begin
  intros,
  simp_rw [to_fun_linear, lift.tmul, to_fun_bilinear_apply,
    matrix.map_one (algebra_map R A) (map_zero _) (map_one _), algebra_map_smul,
    algebra.algebra_map_eq_smul_one],
end

@[simp] lemma to_fun_alg_hom_apply (a : A) (m : matrix n n R) :
  to_fun_alg_hom R A n (a ⊗ₜ m) = a • m.map (algebra_map R A) :=
by simp [to_fun_alg_hom, alg_hom_of_linear_map_tensor_product, to_fun_linear]

/--
(Implementation detail.)

The bare function `matrix n n A → A ⊗[R] matrix n n R`.
(We don't need to show that it's an algebra map, thankfully --- just that it's an inverse.)
-/
def inv_fun (M : matrix n n A) : A ⊗[R] matrix n n R :=
∑ (p : n × n), M p.1 p.2 ⊗ₜ (std_basis_matrix p.1 p.2 1)

@[simp] lemma inv_fun_zero : inv_fun R A n 0 = 0 :=
by simp [inv_fun]

@[simp] lemma inv_fun_add (M N : matrix n n A) :
  inv_fun R A n (M + N) = inv_fun R A n M + inv_fun R A n N :=
by simp [inv_fun, add_tmul, finset.sum_add_distrib]

@[simp] lemma inv_fun_smul (a : A) (M : matrix n n A) :
  inv_fun R A n (a • M) = (a ⊗ₜ 1) * inv_fun R A n M :=
by simp [inv_fun,finset.mul_sum]

@[simp] lemma inv_fun_algebra_map (M : matrix n n R) :
  inv_fun R A n (M.map (algebra_map R A)) = 1 ⊗ₜ M :=
begin
  dsimp [inv_fun],
  simp only [algebra.algebra_map_eq_smul_one, smul_tmul, ←tmul_sum, mul_boole],
  congr,
  conv_rhs {rw matrix_eq_sum_std_basis M},
  convert finset.sum_product, simp,
end

lemma right_inv (M : matrix n n A) : (to_fun_alg_hom R A n) (inv_fun R A n M) = M :=
begin
  simp only [inv_fun, alg_hom.map_sum, std_basis_matrix, apply_ite ⇑(algebra_map R A), smul_eq_mul,
    mul_boole, to_fun_alg_hom_apply, ring_hom.map_zero, ring_hom.map_one, matrix.map, pi.smul_def],
  convert finset.sum_product, apply matrix_eq_sum_std_basis,
end

lemma left_inv (M : A ⊗[R] matrix n n R) : inv_fun R A n (to_fun_alg_hom R A n M) = M :=
begin
  induction M using tensor_product.induction_on with a m x y hx hy,
  { simp, },
  { simp, },
  { simp [alg_hom.map_sum, hx, hy], },
end

/--
(Implementation detail)

The equivalence, ignoring the algebra structure, `(A ⊗[R] matrix n n R) ≃ matrix n n A`.
-/
def equiv : (A ⊗[R] matrix n n R) ≃ matrix n n A :=
{ to_fun := to_fun_alg_hom R A n,
  inv_fun := inv_fun R A n,
  left_inv := left_inv R A n,
  right_inv := right_inv R A n, }

end matrix_equiv_tensor

variables [fintype n] [decidable_eq n]

/--
The `R`-algebra isomorphism `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)`.
-/
def matrix_equiv_tensor : matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R) :=
alg_equiv.symm { ..(matrix_equiv_tensor.to_fun_alg_hom R A n), ..(matrix_equiv_tensor.equiv R A n) }

open matrix_equiv_tensor

@[simp] lemma matrix_equiv_tensor_apply (M : matrix n n A) :
  matrix_equiv_tensor R A n M =
    ∑ (p : n × n), M p.1 p.2 ⊗ₜ (std_basis_matrix p.1 p.2 1) :=
rfl

@[simp] lemma matrix_equiv_tensor_apply_std_basis (i j : n) (x : A):
  matrix_equiv_tensor R A n (std_basis_matrix i j x) =
    x ⊗ₜ (std_basis_matrix i j 1) :=
begin
  have t : ∀ (p : n × n), (i = p.1 ∧ j = p.2) ↔ (p = (i, j)) := by tidy,
  simp [ite_tmul, t, std_basis_matrix],
end

@[simp] lemma matrix_equiv_tensor_apply_symm (a : A) (M : matrix n n R) :
  (matrix_equiv_tensor R A n).symm (a ⊗ₜ M) =
    λ i j, a * algebra_map R A (M i j) :=
begin
  simp [matrix_equiv_tensor, to_fun_alg_hom, alg_hom_of_linear_map_tensor_product, to_fun_linear],
  refl,
end


import algebra.big_operators.intervals number_theory.divisors

/-! # IMO 2006 N3 -/

namespace IMOSL
namespace IMO2006N3

open finset

section extra_lemmas

private lemma exists_sup_fn_fin (f : ℕ → ℕ) : ∀ c : ℕ, ∃ K : ℕ, ∀ n : ℕ, n < c → f n ≤ K
| 0 := ⟨0, λ n h, absurd h (nat.not_lt_zero n)⟩
| (c+1) := begin
  cases exists_sup_fn_fin c with K h,
  refine ⟨max K (f c), λ n h0, _⟩,
  rw [nat.lt_succ_iff, le_iff_eq_or_lt] at h0,
  rcases h0 with rfl | h0,
  exacts [le_max_right K (f n), le_trans (h n h0) (le_max_left K (f c))]
end

private lemma exists_lt_card_divisor (c : ℕ) : ∃ n : ℕ, c < n.divisors.card :=
  ⟨2 ^ c, by rw [nat.divisors_prime_pow nat.prime_two, card_map, card_range, nat.lt_succ_iff]⟩

end extra_lemmas

private def g (n : ℕ) : ℕ := (range n).sum (λ x, n / (x + 1))

@[nolint doc_blame] def f (n : ℕ) : ℚ := ((g n : ℤ) : ℚ) / ((n : ℤ) : ℚ)

private lemma g_succ (n : ℕ) : g n.succ = g n + n.succ.divisors.card :=
  by rw [nat.divisors, ← nat.cast_id (filter _ _).card, ← sum_boole, sum_Ico_eq_sum_range,
    nat.add_sub_cancel, sum_range_succ, add_comm 1 n, if_pos $ dvd_refl _, ← add_assoc,
    g, g, ← sum_add_distrib, sum_range_succ, nat.div_self n.succ_pos, add_left_inj];
  exact sum_congr rfl (λ x _, by rw [add_comm, nat.succ_div])

private lemma g_sum : ∀ n : ℕ, g n = (range n).sum (λ x, x.succ.divisors.card)
| 0 := rfl
| (n+1) := by rw [g_succ, sum_range_succ, ← g_sum]

private lemma two_le_card_divisors {n : ℕ} (h : 2 ≤ n) : 2 ≤ n.divisors.card :=
begin
  rw nat.succ_le_iff at h,
  rw ← card_doubleton (ne_of_lt h),
  refine card_le_of_subset (λ c h0, _),
  rw nat.mem_divisors; rw [mem_insert, mem_singleton] at h0,
  rcases h0 with rfl | rfl,
  exacts [⟨one_dvd n, ne_of_gt $ pos_of_gt h⟩, ⟨dvd_refl c, ne_of_gt $ pos_of_gt h⟩]
end

private lemma two_mul_lt : ∀ {n : ℕ}, 6 ≤ n → 2 * n < g n :=
begin
  refine nat.le_induction _ (λ n h h0, _),
  rw g; iterate 5 { rw sum_range_succ },
  rw [sum_range_one, zero_add]; norm_num,
  rw [mul_add_one, g_succ],
  refine add_lt_add_of_lt_of_le h0 (two_le_card_divisors _),
  exact nat.succ_le_succ (le_trans (nat.succ_le_succ $ nat.zero_le 5) h)
end

private lemma card_divisors_prime {p : ℕ} (hp : p.prime) : p.divisors.card = 2 :=
  by rw [nat.prime.divisors hp, card_doubleton hp.ne_one.symm]

/-- Final solution, part 1 -/
theorem final_solution_part1 : {n : ℕ | f n < f n.succ}.infinite :=
begin
  ---- Use unboundedness and pick a suitable number
  refine set.infinite_of_not_bdd_above _,
  rintros ⟨N, h⟩; rw mem_upper_bounds at h,
  obtain ⟨c, h0, h1⟩ : ∃ c : ℕ, N.succ < c ∧ ∀ n : ℕ, n < c → n.divisors.card < c.divisors.card :=
  begin
    obtain ⟨K, h0⟩ := exists_sup_fn_fin (λ x, x.divisors.card) N.succ.succ,
    have h1 := exists_lt_card_divisor K,
    refine ⟨nat.find h1, _, λ n h2, lt_of_le_of_lt _ (nat.find_spec h1)⟩,
    rw nat.lt_find_iff; intros n h2,
    exact not_lt_of_le (h0 n $ nat.lt_succ_of_le h2),
    replace h2 := nat.find_min h1 h2,
    rwa not_lt at h2
  end,

  ---- Change `c` to `c.succ`, and then prove that the new value of `c` works
  obtain ⟨c, rfl⟩ : ∃ n : ℕ, c = n.succ :=
    nat.exists_eq_succ_of_ne_zero (ne_of_gt $ pos_of_gt h0),
  revert h0; rw [imp_false, not_lt]; refine nat.succ_le_succ (h c _),
  rw [set.mem_set_of_eq, f, f],
  clear h; rcases eq_or_ne c 0 with rfl | h,
  rw [int.coe_nat_zero, int.cast_zero, div_zero, g, sum_range_one,
      zero_add, nat.div_one, int.coe_nat_one, int.cast_one, div_one],
  exact one_pos,
  rw [rat.div_lt_div_iff_mul_lt_mul, ← nat.cast_mul, ← nat.cast_mul,
      nat.cast_lt, g_succ, nat.mul_succ, add_mul, add_lt_add_iff_left,
      mul_comm, ← smul_eq_mul, nsmul_eq_sum_const, g_sum],
  refine sum_lt_sum_of_nonempty (nonempty_range_iff.mpr h) (λ i h0, h1 _ _),
  rw mem_range at h0; exact nat.succ_le_succ h0,
  rwa [int.coe_nat_pos, zero_lt_iff],
  rw int.coe_nat_pos; exact c.succ_pos
end

/-- Final solution, part 2 -/
theorem final_solution_part2 : {n : ℕ | f n.succ < f n}.infinite :=
begin
  ---- Use unboundedness and pick a suitable prime
  refine set.infinite_of_not_bdd_above _,
  rintros ⟨N, h⟩; rw mem_upper_bounds at h,
  rcases (max 7 (N + 2)).exists_infinite_primes with ⟨p, h1, h0⟩,
  rw max_le_iff at h1; cases h1 with h1 h2,
  obtain ⟨n, rfl⟩ : ∃ n : ℕ, p = n.succ := nat.exists_eq_succ_of_ne_zero h0.ne_zero,
  rw [nat.succ_le_succ_iff, nat.succ_le_iff] at h2,
  revert h2; rw [imp_false, not_lt]; apply h,

  ---- Now prove that `f(n + 1) < f(n)` (here `n + 1` is prime)
  rw nat.succ_le_succ_iff at h1,
  rw [set.mem_set_of_eq, f, f, rat.div_lt_div_iff_mul_lt_mul, ← nat.cast_mul, ← nat.cast_mul,
      nat.cast_lt, g_succ, card_divisors_prime h0, add_mul, nat.mul_succ, add_lt_add_iff_left],
  exact two_mul_lt h1,
  rw int.coe_nat_pos; exact n.succ_pos,
  rw int.coe_nat_pos; exact lt_of_lt_of_le (nat.succ_pos 5) h1
end

end IMO2006N3
end IMOSL


/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo, Yaël Dillies, Moritz Doll
-/
import analysis.locally_convex.basic
import data.real.pointwise
import data.real.sqrt
import topology.algebra.filter_basis
import topology.algebra.module.locally_convex

/-!
# Seminorms

This file defines seminorms.

A seminorm is a function to the reals which is positive-semidefinite, absolutely homogeneous, and
subadditive. They are closely related to convex sets and a topological vector space is locally
convex if and only if its topology is induced by a family of seminorms.

## Main declarations

For a module over a normed ring:
* `seminorm`: A function to the reals that is positive-semidefinite, absolutely homogeneous, and
  subadditive.
* `norm_seminorm 𝕜 E`: The norm on `E` as a seminorm.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

seminorm, locally convex, LCTVS
-/

open normed_field set
open_locale big_operators nnreal pointwise topological_space

variables {R R' 𝕜 E F G ι : Type*}

/-- A seminorm on a module over a normed ring is a function to the reals that is positive
semidefinite, positive homogeneous, and subadditive. -/
structure seminorm (𝕜 : Type*) (E : Type*) [semi_normed_ring 𝕜] [add_monoid E] [has_scalar 𝕜 E] :=
(to_fun    : E → ℝ)
(smul'     : ∀ (a : 𝕜) (x : E), to_fun (a • x) = ∥a∥ * to_fun x)
(triangle' : ∀ x y : E, to_fun (x + y) ≤ to_fun x + to_fun y)

namespace seminorm

section semi_normed_ring
variables [semi_normed_ring 𝕜]

section add_monoid
variables [add_monoid E]

section has_scalar
variables [has_scalar 𝕜 E]

instance fun_like : fun_like (seminorm 𝕜 E) E (λ _, ℝ) :=
{ coe := seminorm.to_fun, coe_injective' := λ f g h, by cases f; cases g; congr' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/
instance : has_coe_to_fun (seminorm 𝕜 E) (λ _, E → ℝ) := ⟨λ p, p.to_fun⟩

@[ext] lemma ext {p q : seminorm 𝕜 E} (h : ∀ x, (p : E → ℝ) x = q x) : p = q := fun_like.ext p q h

instance : has_zero (seminorm 𝕜 E) :=
⟨{ to_fun    := 0,
  smul'     := λ _ _, (mul_zero _).symm,
  triangle' := λ _ _, eq.ge (zero_add _) }⟩

@[simp] lemma coe_zero : ⇑(0 : seminorm 𝕜 E) = 0 := rfl

@[simp] lemma zero_apply (x : E) : (0 : seminorm 𝕜 E) x = 0 := rfl

instance : inhabited (seminorm 𝕜 E) := ⟨0⟩

variables (p : seminorm 𝕜 E) (c : 𝕜) (x y : E) (r : ℝ)

protected lemma smul : p (c • x) = ∥c∥ * p x := p.smul' _ _
protected lemma triangle : p (x + y) ≤ p x + p y := p.triangle' _ _

/-- Any action on `ℝ` which factors through `ℝ≥0` applies to a seminorm. -/
instance [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] :
  has_scalar R (seminorm 𝕜 E) :=
{ smul := λ r p,
  { to_fun := λ x, r • p x,
    smul' := λ _ _, begin
      simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul],
      rw [p.smul, mul_left_comm],
    end,
    triangle' := λ _ _, begin
      simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul],
      exact (mul_le_mul_of_nonneg_left (p.triangle _ _) (nnreal.coe_nonneg _)).trans_eq
        (mul_add _ _ _),
    end } }

instance [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]
  [has_scalar R' ℝ] [has_scalar R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ]
  [has_scalar R R'] [is_scalar_tower R R' ℝ] :
  is_scalar_tower R R' (seminorm 𝕜 E) :=
{ smul_assoc := λ r a p, ext $ λ x, smul_assoc r a (p x) }

lemma coe_smul [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]
  (r : R) (p : seminorm 𝕜 E) : ⇑(r • p) = r • p := rfl

@[simp] lemma smul_apply [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]
  (r : R) (p : seminorm 𝕜 E) (x : E) : (r • p) x = r • p x := rfl

instance : has_add (seminorm 𝕜 E) :=
{ add := λ p q,
  { to_fun := λ x, p x + q x,
    smul' := λ a x, by rw [p.smul, q.smul, mul_add],
    triangle' := λ _ _, has_le.le.trans_eq (add_le_add (p.triangle _ _) (q.triangle _ _))
      (add_add_add_comm _ _ _ _) } }

lemma coe_add (p q : seminorm 𝕜 E) : ⇑(p + q) = p + q := rfl

@[simp] lemma add_apply (p q : seminorm 𝕜 E) (x : E) : (p + q) x = p x + q x := rfl

instance : add_monoid (seminorm 𝕜 E) :=
fun_like.coe_injective.add_monoid _ rfl coe_add (λ p n, coe_smul n p)

instance : ordered_cancel_add_comm_monoid (seminorm 𝕜 E) :=
fun_like.coe_injective.ordered_cancel_add_comm_monoid _ rfl coe_add (λ p n, coe_smul n p)

instance [monoid R] [mul_action R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] :
  mul_action R (seminorm 𝕜 E) :=
fun_like.coe_injective.mul_action _ coe_smul

variables (𝕜 E)

/-- `coe_fn` as an `add_monoid_hom`. Helper definition for showing that `seminorm 𝕜 E` is
a module. -/
@[simps]
def coe_fn_add_monoid_hom : add_monoid_hom (seminorm 𝕜 E) (E → ℝ) := ⟨coe_fn, coe_zero, coe_add⟩

lemma coe_fn_add_monoid_hom_injective : function.injective (coe_fn_add_monoid_hom 𝕜 E) :=
show @function.injective (seminorm 𝕜 E) (E → ℝ) coe_fn, from fun_like.coe_injective

variables {𝕜 E}

instance [monoid R] [distrib_mul_action R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] :
  distrib_mul_action R (seminorm 𝕜 E) :=
(coe_fn_add_monoid_hom_injective 𝕜 E).distrib_mul_action _ coe_smul

instance [semiring R] [module R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] :
  module R (seminorm 𝕜 E) :=
(coe_fn_add_monoid_hom_injective 𝕜 E).module R _ coe_smul

-- TODO: define `has_Sup` too, from the skeleton at
-- https://github.com/leanprover-community/mathlib/pull/11329#issuecomment-1008915345
noncomputable instance : has_sup (seminorm 𝕜 E) :=
{ sup := λ p q,
  { to_fun := p ⊔ q,
    triangle' := λ x y, sup_le
      ((p.triangle x y).trans $ add_le_add le_sup_left le_sup_left)
      ((q.triangle x y).trans $ add_le_add le_sup_right le_sup_right),
    smul' := λ x v, (congr_arg2 max (p.smul x v) (q.smul x v)).trans $
      (mul_max_of_nonneg _ _ $ norm_nonneg x).symm } }

@[simp] lemma coe_sup (p q : seminorm 𝕜 E) : ⇑(p ⊔ q) = p ⊔ q := rfl
lemma sup_apply (p q : seminorm 𝕜 E) (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl

lemma smul_sup [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]
  (r : R) (p q : seminorm 𝕜 E) :
  r • (p ⊔ q) = r • p ⊔ r • q :=
have real.smul_max : ∀ x y : ℝ, r • max x y = max (r • x) (r • y),
from λ x y, by simpa only [←smul_eq_mul, ←nnreal.smul_def, smul_one_smul ℝ≥0 r (_ : ℝ)]
                     using mul_max_of_nonneg x y (r • 1 : ℝ≥0).prop,
ext $ λ x, real.smul_max _ _

instance : partial_order (seminorm 𝕜 E) :=
  partial_order.lift _ fun_like.coe_injective

lemma le_def (p q : seminorm 𝕜 E) : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl
lemma lt_def (p q : seminorm 𝕜 E) : p < q ↔ (p : E → ℝ) < q := iff.rfl

noncomputable instance : semilattice_sup (seminorm 𝕜 E) :=
function.injective.semilattice_sup _ fun_like.coe_injective coe_sup

end has_scalar

section smul_with_zero
variables [smul_with_zero 𝕜 E] (p : seminorm 𝕜 E)

@[simp]
protected lemma zero : p 0 = 0 :=
calc p 0 = p ((0 : 𝕜) • 0) : by rw zero_smul
...      = 0 : by rw [p.smul, norm_zero, zero_mul]

end smul_with_zero
end add_monoid

section module
variables [add_comm_group E] [add_comm_group F] [add_comm_group G]
variables [module 𝕜 E] [module 𝕜 F] [module 𝕜 G]
variables [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]

/-- Composition of a seminorm with a linear map is a seminorm. -/
def comp (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) : seminorm 𝕜 E :=
{ to_fun := λ x, p(f x),
  smul' := λ _ _, (congr_arg p (f.map_smul _ _)).trans (p.smul _ _),
  triangle' := λ _ _, eq.trans_le (congr_arg p (f.map_add _ _)) (p.triangle _ _) }

lemma coe_comp (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) : ⇑(p.comp f) = p ∘ f := rfl

@[simp] lemma comp_apply (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (x : E) : (p.comp f) x = p (f x) := rfl

@[simp] lemma comp_id (p : seminorm 𝕜 E) : p.comp linear_map.id = p :=
ext $ λ _, rfl

@[simp]

@[simp] lemma zero_comp (f : E →ₗ[𝕜] F) : (0 : seminorm 𝕜 F).comp f = 0 :=
ext $ λ _, rfl

lemma comp_comp (p : seminorm 𝕜 G) (g : F →ₗ[𝕜] G) (f : E →ₗ[𝕜] F) :
  p.comp (g.comp f) = (p.comp g).comp f :=
ext $ λ _, rfl

lemma add_comp (p q : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) : (p + q).comp f = p.comp f + q.comp f :=
ext $ λ _, rfl

lemma comp_triangle (p : seminorm 𝕜 F) (f g : E →ₗ[𝕜] F) : p.comp (f + g) ≤ p.comp f + p.comp g :=
λ _, p.triangle _ _

lemma smul_comp (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (c : R) : (c • p).comp f = c • (p.comp f) :=
ext $ λ _, rfl

lemma comp_mono {p : seminorm 𝕜 F} {q : seminorm 𝕜 F} (f : E →ₗ[𝕜] F) (hp : p ≤ q) :
  p.comp f ≤ q.comp f := λ _, hp _

/-- The composition as an `add_monoid_hom`. -/
@[simps] def pullback (f : E →ₗ[𝕜] F) : add_monoid_hom (seminorm 𝕜 F) (seminorm 𝕜 E) :=
⟨λ p, p.comp f, zero_comp f, λ p q, add_comp p q f⟩

section norm_one_class
variables [norm_one_class 𝕜] (p : seminorm 𝕜 E) (x y : E) (r : ℝ)

@[simp]
protected lemma neg : p (-x) = p x :=
calc p (-x) = p ((-1 : 𝕜) • x) : by rw neg_one_smul
...         = p x : by rw [p.smul, norm_neg, norm_one, one_mul]

protected lemma sub_le : p (x - y) ≤ p x + p y :=
calc
  p (x - y)
      = p (x + -y) : by rw sub_eq_add_neg
  ... ≤ p x + p (-y) : p.triangle x (-y)
  ... = p x + p y : by rw p.neg

lemma nonneg : 0 ≤ p x :=
have h: 0 ≤ 2 * p x, from
calc 0 = p (x + (- x)) : by rw [add_neg_self, p.zero]
...    ≤ p x + p (-x)  : p.triangle _ _
...    = 2 * p x : by rw [p.neg, two_mul],
nonneg_of_mul_nonneg_left h zero_lt_two

lemma sub_rev : p (x - y) = p (y - x) := by rw [←neg_sub, p.neg]

/-- The direct path from 0 to y is shorter than the path with x "inserted" in between. -/
lemma le_insert : p y ≤ p x + p (x - y) :=
calc p y = p (x - (x - y)) : by rw sub_sub_cancel
... ≤ p x + p (x - y) : p.sub_le _ _

/-- The direct path from 0 to x is shorter than the path with y "inserted" in between. -/
lemma le_insert' : p x ≤ p y + p (x - y) := by { rw sub_rev, exact le_insert _ _ _ }

instance : order_bot (seminorm 𝕜 E) := ⟨0, nonneg⟩

@[simp] lemma coe_bot : ⇑(⊥ : seminorm 𝕜 E) = 0 := rfl

lemma bot_eq_zero : (⊥ : seminorm 𝕜 E) = 0 := rfl

lemma smul_le_smul {p q : seminorm 𝕜 E} {a b : ℝ≥0} (hpq : p ≤ q) (hab : a ≤ b) :
  a • p ≤ b • q :=
begin
  simp_rw [le_def, pi.le_def, coe_smul],
  intros x,
  simp_rw [pi.smul_apply, nnreal.smul_def, smul_eq_mul],
  exact mul_le_mul hab (hpq x) (nonneg p x) (nnreal.coe_nonneg b),
end

lemma finset_sup_apply (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) :
  s.sup p x = ↑(s.sup (λ i, ⟨p i x, nonneg (p i) x⟩) : ℝ≥0) :=
begin
  induction s using finset.cons_induction_on with a s ha ih,
  { rw [finset.sup_empty, finset.sup_empty, coe_bot, _root_.bot_eq_zero, pi.zero_apply,
        nonneg.coe_zero] },
  { rw [finset.sup_cons, finset.sup_cons, coe_sup, sup_eq_max, pi.sup_apply, sup_eq_max,
        nnreal.coe_max, subtype.coe_mk, ih] }
end

lemma finset_sup_le_sum (p : ι → seminorm 𝕜 E) (s : finset ι) : s.sup p ≤ ∑ i in s, p i :=
begin
  classical,
  refine finset.sup_le_iff.mpr _,
  intros i hi,
  rw [finset.sum_eq_sum_diff_singleton_add hi, le_add_iff_nonneg_left],
  exact bot_le,
end

lemma finset_sup_apply_le {p : ι → seminorm 𝕜 E} {s : finset ι} {x : E} {a : ℝ} (ha : 0 ≤ a)
  (h : ∀ i, i ∈ s → p i x ≤ a) : s.sup p x ≤ a :=
begin
  lift a to ℝ≥0 using ha,
  rw [finset_sup_apply, nnreal.coe_le_coe],
  exact finset.sup_le h,
end

lemma finset_sup_apply_lt {p : ι → seminorm 𝕜 E} {s : finset ι} {x : E} {a : ℝ} (ha : 0 < a)
  (h : ∀ i, i ∈ s → p i x < a) : s.sup p x < a :=
begin
  lift a to ℝ≥0 using ha.le,
  rw [finset_sup_apply, nnreal.coe_lt_coe, finset.sup_lt_iff],
  { exact h },
  { exact nnreal.coe_pos.mpr ha },
end

end norm_one_class
end module
end semi_normed_ring

section semi_normed_comm_ring
variables [semi_normed_comm_ring 𝕜] [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F]

lemma comp_smul (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (c : 𝕜) :
  p.comp (c • f) = ∥c∥₊ • p.comp f :=
ext $ λ _, by rw [comp_apply, smul_apply, linear_map.smul_apply, p.smul, nnreal.smul_def,
  coe_nnnorm, smul_eq_mul, comp_apply]

lemma comp_smul_apply (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (c : 𝕜) (x : E) :
  p.comp (c • f) x = ∥c∥ * p (f x) := p.smul _ _

end semi_normed_comm_ring

section normed_field
variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E]

private lemma bdd_below_range_add (x : E) (p q : seminorm 𝕜 E) :
  bdd_below (range (λ (u : E), p u + q (x - u))) :=
by { use 0, rintro _ ⟨x, rfl⟩, exact add_nonneg (p.nonneg _) (q.nonneg _) }

noncomputable instance : has_inf (seminorm 𝕜 E) :=
{ inf := λ p q,
  { to_fun := λ x, ⨅ u : E, p u + q (x-u),
    triangle' := λ x y, begin
      refine le_cinfi_add_cinfi (λ u v, _),
      apply cinfi_le_of_le (bdd_below_range_add _ _ _) (v+u), dsimp only,
      convert add_le_add (p.triangle v u) (q.triangle (y-v) (x-u)) using 1,
      { rw show x + y - (v + u) = y - v + (x - u), by abel },
      { abel },
    end,
    smul' := λ a x, begin
      obtain rfl | ha := eq_or_ne a 0,
      { simp_rw [norm_zero, zero_mul, zero_smul, zero_sub, seminorm.neg],
        refine cinfi_eq_of_forall_ge_of_forall_gt_exists_lt
          (λ i, add_nonneg (p.nonneg _) (q.nonneg _))
          (λ x hx, ⟨0, by rwa [p.zero, q.zero, add_zero]⟩) },
      simp_rw [real.mul_infi_of_nonneg (norm_nonneg a), mul_add, ←p.smul, ←q.smul, smul_sub],
      refine function.surjective.infi_congr ((•) a⁻¹ : E → E) (λ u, ⟨a • u, inv_smul_smul₀ ha u⟩)
        (λ u, _),
      rw smul_inv_smul₀ ha,
    end } }

@[simp] lemma inf_apply (p q : seminorm 𝕜 E) (x : E) : (p ⊓ q) x = ⨅ u : E, p u + q (x-u) := rfl

noncomputable instance : lattice (seminorm 𝕜 E) :=
{ inf := (⊓),
  inf_le_left := λ p q x, begin
    apply cinfi_le_of_le (bdd_below_range_add _ _ _) x,
    simp only [sub_self, seminorm.zero, add_zero],
  end,
  inf_le_right := λ p q x, begin
    apply cinfi_le_of_le (bdd_below_range_add _ _ _) (0:E),
    simp only [sub_self, seminorm.zero, zero_add, sub_zero],
  end,
  le_inf := λ a b c hab hac x,
    le_cinfi $ λ u, le_trans (a.le_insert' _ _) (add_le_add (hab _) (hac _)),
  ..seminorm.semilattice_sup }

lemma smul_inf [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]
  (r : R) (p q : seminorm 𝕜 E) :
  r • (p ⊓ q) = r • p ⊓ r • q :=
begin
  ext,
  simp_rw [smul_apply, inf_apply, smul_apply, ←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def,
    smul_eq_mul, real.mul_infi_of_nonneg (subtype.prop _), mul_add],
end

end normed_field

/-! ### Seminorm ball -/

section semi_normed_ring
variables [semi_normed_ring 𝕜]

section add_comm_group
variables [add_comm_group E]

section has_scalar
variables [has_scalar 𝕜 E] (p : seminorm 𝕜 E)

/-- The ball of radius `r` at `x` with respect to seminorm `p` is the set of elements `y` with
`p (y - x) < `r`. -/
def ball (x : E) (r : ℝ) := { y : E | p (y - x) < r }

variables {x y : E} {r : ℝ}

@[simp] lemma mem_ball : y ∈ ball p x r ↔ p (y - x) < r := iff.rfl

lemma mem_ball_zero : y ∈ ball p 0 r ↔ p y < r := by rw [mem_ball, sub_zero]

lemma ball_zero_eq : ball p 0 r = { y : E | p y < r } := set.ext $ λ x, p.mem_ball_zero

@[simp] lemma ball_zero' (x : E) (hr : 0 < r) : ball (0 : seminorm 𝕜 E) x r = set.univ :=
begin
  rw [set.eq_univ_iff_forall, ball],
  simp [hr],
end

lemma ball_smul (p : seminorm 𝕜 E) {c : nnreal} (hc : 0 < c) (r : ℝ) (x : E) :
  (c • p).ball x r = p.ball x (r / c) :=
by { ext, rw [mem_ball, mem_ball, smul_apply, nnreal.smul_def, smul_eq_mul, mul_comm,
  lt_div_iff (nnreal.coe_pos.mpr hc)] }

lemma ball_sup (p : seminorm 𝕜 E) (q : seminorm 𝕜 E) (e : E) (r : ℝ) :
  ball (p ⊔ q) e r = ball p e r ∩ ball q e r :=
by simp_rw [ball, ←set.set_of_and, coe_sup, pi.sup_apply, sup_lt_iff]

lemma ball_finset_sup' (p : ι → seminorm 𝕜 E) (s : finset ι) (H : s.nonempty) (e : E) (r : ℝ) :
  ball (s.sup' H p) e r = s.inf' H (λ i, ball (p i) e r) :=
begin
  induction H using finset.nonempty.cons_induction with a a s ha hs ih,
  { classical, simp },
  { rw [finset.sup'_cons hs, finset.inf'_cons hs, ball_sup, inf_eq_inter, ih] },
end

lemma ball_mono {p : seminorm 𝕜 E} {r₁ r₂ : ℝ} (h : r₁ ≤ r₂) : p.ball x r₁ ⊆ p.ball x r₂ :=
λ _ (hx : _ < _), hx.trans_le h

lemma ball_antitone {p q : seminorm 𝕜 E} (h : q ≤ p) : p.ball x r ⊆ q.ball x r :=
λ _, (h _).trans_lt

lemma ball_add_ball_subset (p : seminorm 𝕜 E) (r₁ r₂ : ℝ) (x₁ x₂ : E):
  p.ball (x₁ : E) r₁ + p.ball (x₂ : E) r₂ ⊆ p.ball (x₁ + x₂) (r₁ + r₂) :=
begin
  rintros x ⟨y₁, y₂, hy₁, hy₂, rfl⟩,
  rw [mem_ball, add_sub_comm],
  exact (p.triangle _ _).trans_lt (add_lt_add hy₁ hy₂),
end

end has_scalar

section module

variables [module 𝕜 E]
variables [add_comm_group F] [module 𝕜 F]

lemma ball_comp (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (x : E) (r : ℝ) :
  (p.comp f).ball x r = f ⁻¹' (p.ball (f x) r) :=
begin
  ext,
  simp_rw [ball, mem_preimage, comp_apply, set.mem_set_of_eq, map_sub],
end

section norm_one_class
variables [norm_one_class 𝕜] (p : seminorm 𝕜 E)

@[simp] lemma ball_bot {r : ℝ} (x : E) (hr : 0 < r) : ball (⊥ : seminorm 𝕜 E) x r = set.univ :=
ball_zero' x hr

/-- Seminorm-balls at the origin are balanced. -/
lemma balanced_ball_zero (r : ℝ) : balanced 𝕜 (ball p 0 r) :=
begin
  rintro a ha x ⟨y, hy, hx⟩,
  rw [mem_ball_zero, ←hx, p.smul],
  calc _ ≤ p y : mul_le_of_le_one_left (p.nonneg _) ha
  ...    < r   : by rwa mem_ball_zero at hy,
end

lemma ball_finset_sup_eq_Inter (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) {r : ℝ} (hr : 0 < r) :
  ball (s.sup p) x r = ⋂ (i ∈ s), ball (p i) x r :=
begin
  lift r to nnreal using hr.le,
  simp_rw [ball, Inter_set_of, finset_sup_apply, nnreal.coe_lt_coe,
    finset.sup_lt_iff (show ⊥ < r, from hr), ←nnreal.coe_lt_coe, subtype.coe_mk],
end

lemma ball_finset_sup (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) {r : ℝ}
  (hr : 0 < r) : ball (s.sup p) x r = s.inf (λ i, ball (p i) x r) :=
begin
  rw finset.inf_eq_infi,
  exact ball_finset_sup_eq_Inter _ _ _ hr,
end

lemma ball_smul_ball (p : seminorm 𝕜 E) (r₁ r₂ : ℝ) :
  metric.ball (0 : 𝕜) r₁ • p.ball 0 r₂ ⊆ p.ball 0 (r₁ * r₂) :=
begin
  rw set.subset_def,
  intros x hx,
  rw set.mem_smul at hx,
  rcases hx with ⟨a, y, ha, hy, hx⟩,
  rw [←hx, mem_ball_zero, seminorm.smul],
  exact mul_lt_mul'' (mem_ball_zero_iff.mp ha) (p.mem_ball_zero.mp hy) (norm_nonneg a) (p.nonneg y),
end

@[simp] lemma ball_eq_emptyset (p : seminorm 𝕜 E) {x : E} {r : ℝ} (hr : r ≤ 0) : p.ball x r = ∅ :=
begin
  ext,
  rw [seminorm.mem_ball, set.mem_empty_eq, iff_false, not_lt],
  exact hr.trans (p.nonneg _),
end

end norm_one_class
end module
end add_comm_group
end semi_normed_ring

section normed_field
variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] (p : seminorm 𝕜 E) {A B : set E}
  {a : 𝕜} {r : ℝ} {x : E}

lemma smul_ball_zero {p : seminorm 𝕜 E} {k : 𝕜} {r : ℝ} (hk : 0 < ∥k∥) :
  k • p.ball 0 r = p.ball 0 (∥k∥ * r) :=
begin
  ext,
  rw [set.mem_smul_set, seminorm.mem_ball_zero],
  split; intro h,
  { rcases h with ⟨y, hy, h⟩,
    rw [←h, seminorm.smul],
    rw seminorm.mem_ball_zero at hy,
    exact (mul_lt_mul_left hk).mpr hy },
  refine ⟨k⁻¹ • x, _, _⟩,
  { rw [seminorm.mem_ball_zero, seminorm.smul, norm_inv, ←(mul_lt_mul_left hk),
      ←mul_assoc, ←(div_eq_mul_inv ∥k∥ ∥k∥), div_self (ne_of_gt hk), one_mul],
    exact h},
  rw [←smul_assoc, smul_eq_mul, ←div_eq_mul_inv, div_self (norm_pos_iff.mp hk), one_smul],
end

lemma ball_zero_absorbs_ball_zero (p : seminorm 𝕜 E) {r₁ r₂ : ℝ} (hr₁ : 0 < r₁) :
  absorbs 𝕜 (p.ball 0 r₁) (p.ball 0 r₂) :=
begin
  by_cases hr₂ : r₂ ≤ 0,
  { rw ball_eq_emptyset p hr₂, exact absorbs_empty },
  rw [not_le] at hr₂,
  rcases exists_between hr₁ with ⟨r, hr, hr'⟩,
  refine ⟨r₂/r, div_pos hr₂ hr, _⟩,
  simp_rw set.subset_def,
  intros a ha x hx,
  have ha' : 0 < ∥a∥ := lt_of_lt_of_le (div_pos hr₂ hr) ha,
  rw [smul_ball_zero ha', p.mem_ball_zero],
  rw p.mem_ball_zero at hx,
  rw div_le_iff hr at ha,
  exact hx.trans (lt_of_le_of_lt ha ((mul_lt_mul_left ha').mpr hr')),
end

/-- Seminorm-balls at the origin are absorbent. -/
protected lemma absorbent_ball_zero (hr : 0 < r) : absorbent 𝕜 (ball p (0 : E) r) :=
begin
  rw absorbent_iff_nonneg_lt,
  rintro x,
  have hxr : 0 ≤ p x/r := div_nonneg (p.nonneg _) hr.le,
  refine ⟨p x/r, hxr, λ a ha, _⟩,
  have ha₀ : 0 < ∥a∥ := hxr.trans_lt ha,
  refine ⟨a⁻¹ • x, _, smul_inv_smul₀ (norm_pos_iff.1 ha₀) x⟩,
  rwa [mem_ball_zero, p.smul, norm_inv, inv_mul_lt_iff ha₀, ←div_lt_iff hr],
end

/-- Seminorm-balls containing the origin are absorbent. -/
protected lemma absorbent_ball (hpr : p x < r) : absorbent 𝕜 (ball p x r) :=
begin
  refine (p.absorbent_ball_zero $ sub_pos.2 hpr).subset (λ y hy, _),
  rw p.mem_ball_zero at hy,
  exact p.mem_ball.2 ((p.sub_le _ _).trans_lt $ add_lt_of_lt_sub_right hy),
end

lemma symmetric_ball_zero (r : ℝ) (hx : x ∈ ball p 0 r) : -x ∈ ball p 0 r :=
balanced_ball_zero p r (-1) (by rw [norm_neg, norm_one]) ⟨x, hx, by rw [neg_smul, one_smul]⟩

@[simp]
lemma neg_ball (p : seminorm 𝕜 E) (r : ℝ) (x : E) :
  -ball p x r = ball p (-x) r :=
by { ext, rw [mem_neg, mem_ball, mem_ball, ←neg_add', sub_neg_eq_add, p.neg], }

@[simp]
lemma smul_ball_preimage (p : seminorm 𝕜 E) (y : E) (r : ℝ) (a : 𝕜) (ha : a ≠ 0) :
  ((•) a) ⁻¹' p.ball y r = p.ball (a⁻¹ • y) (r / ∥a∥) :=
set.ext $ λ _, by rw [mem_preimage, mem_ball, mem_ball,
  lt_div_iff (norm_pos_iff.mpr ha), mul_comm, ←p.smul, smul_sub, smul_inv_smul₀ ha]

end normed_field

section convex
variables [normed_field 𝕜] [add_comm_group E] [normed_space ℝ 𝕜] [module 𝕜 E]

section has_scalar
variables [has_scalar ℝ E] [is_scalar_tower ℝ 𝕜 E] (p : seminorm 𝕜 E)

/-- A seminorm is convex. Also see `convex_on_norm`. -/
protected lemma convex_on : convex_on ℝ univ p :=
begin
  refine ⟨convex_univ, λ x y _ _ a b ha hb hab, _⟩,
  calc p (a • x + b • y) ≤ p (a • x) + p (b • y) : p.triangle _ _
    ... = ∥a • (1 : 𝕜)∥ * p x + ∥b • (1 : 𝕜)∥ * p y
        : by rw [←p.smul, ←p.smul, smul_one_smul, smul_one_smul]
    ... = a * p x + b * p y
        : by rw [norm_smul, norm_smul, norm_one, mul_one, mul_one, real.norm_of_nonneg ha,
            real.norm_of_nonneg hb],
end

end has_scalar

section module
variables [module ℝ E] [is_scalar_tower ℝ 𝕜 E] (p : seminorm 𝕜 E) (x : E) (r : ℝ)

/-- Seminorm-balls are convex. -/
lemma convex_ball : convex ℝ (ball p x r) :=
begin
  convert (p.convex_on.translate_left (-x)).convex_lt r,
  ext y,
  rw [preimage_univ, sep_univ, p.mem_ball, sub_eq_add_neg],
  refl,
end

end module
end convex
end seminorm

/-! ### The norm as a seminorm -/

section norm_seminorm
variables (𝕜 E) [normed_field 𝕜] [semi_normed_group E] [normed_space 𝕜 E] {r : ℝ}

/-- The norm of a seminormed group as a seminorm. -/
def norm_seminorm : seminorm 𝕜 E := ⟨norm, norm_smul, norm_add_le⟩

@[simp] lemma coe_norm_seminorm : ⇑(norm_seminorm 𝕜 E) = norm := rfl

@[simp] lemma ball_norm_seminorm : (norm_seminorm 𝕜 E).ball = metric.ball :=
by { ext x r y, simp only [seminorm.mem_ball, metric.mem_ball, coe_norm_seminorm, dist_eq_norm] }

variables {𝕜 E} {x : E}

/-- Balls at the origin are absorbent. -/
lemma absorbent_ball_zero (hr : 0 < r) : absorbent 𝕜 (metric.ball (0 : E) r) :=
by { rw ←ball_norm_seminorm 𝕜, exact (norm_seminorm _ _).absorbent_ball_zero hr }

/-- Balls containing the origin are absorbent. -/
lemma absorbent_ball (hx : ∥x∥ < r) : absorbent 𝕜 (metric.ball x r) :=
by { rw ←ball_norm_seminorm 𝕜, exact (norm_seminorm _ _).absorbent_ball hx }

/-- Balls at the origin are balanced. -/
lemma balanced_ball_zero [norm_one_class 𝕜] : balanced 𝕜 (metric.ball (0 : E) r) :=
by { rw ←ball_norm_seminorm 𝕜, exact (norm_seminorm _ _).balanced_ball_zero r }

end norm_seminorm


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

Define squash type (aka propositional truncation) using quotients.
This definition is slightly better than defining the squash type ∥A∥ as (nonempty A).
If we define it using (nonempty A), then we can only lift functions A → B to ∥A∥ → B
when B is a proposition. With quotients, we can lift to any B type that is a subsingleton
(i.e., has at most one element).
-/
open quot

private definition eqv {A : Type} (a b : A) : Prop := true
local infix ~ := eqv

private lemma eqv_refl {A : Type} : ∀ a : A, a ~ a :=
λ a, trivial

private lemma eqv_symm {A : Type} : ∀ a b : A, a ~ b → b ~ a :=
λ a b h, trivial

private lemma eqv_trans {A : Type} : ∀ a b c : A, a ~ b → b ~ c → a ~ c :=
λ a b c h₁ h₂, trivial

definition squash_setoid (A : Type) : setoid A :=
setoid.mk (@eqv A) (mk_equivalence (@eqv A) (@eqv_refl A) (@eqv_symm A) (@eqv_trans A))

definition squash (A : Type) : Type :=
quot (squash_setoid A)

namespace squash
local attribute squash_setoid [instance]

notation `∥`:0 A `∥` := squash A

definition mk {A : Type} (a : A) : ∥A∥ :=
⟦a⟧

protected definition irrelevant {A : Type} : ∀ a b : ∥A∥, a = b :=
λ a b, quot.induction_on₂ a b (λ a b, quot.sound trivial)

definition lift {A B : Type} [h : subsingleton B] (f : A → B) : ∥A∥ → B :=
λ s, quot.lift_on s f (λ a₁ a₂ r, subsingleton.elim (f a₁) (f a₂))
end squash

open squash decidable

definition decidable_eq_squash [instance] (A : Type) : decidable_eq ∥A∥ :=
λ a b, inl (squash.irrelevant a b)

definition subsingleton_squash [instance] (A : Type) : subsingleton ∥A∥ :=
subsingleton.intro (@squash.irrelevant A)


import data.list
import data.vector2

-- To mathlib: data.vector2.
namespace vector

lemma nth_repeat {α : Type*} {n : ℕ} (x : α) :
∀ (i : fin n), vector.nth (vector.repeat x n) i = x :=
λ i, by rw vector.nth_eq_nth_le; dsimp [vector.repeat]; rw list.nth_le_repeat

def fin_range (n : ℕ) : vector (fin n) n :=
⟨list.fin_range n, list.length_fin_range n⟩

@[simp] lemma fin_range_zero : fin_range 0 = vector.nil := rfl

-- vector.has_mem ?
@[simp] lemma mem_fin_range {n : ℕ} (a : fin n) : a ∈ (fin_range n).to_list :=
list.mem_fin_range a

-- Define pairwise and
-- lemma nodup_fin_range (n : ℕ) : (fin_range n).nodup := list.nodup_fin_range n

-- @[simp] lemma length_fin_range (n : ℕ) : (fin_range n).length = n := list.length_fin_range n

-- @[simp] lemma fin_range_eq_nil {n : ℕ} : fin_range n = [] ↔ n = 0 := list.fin_range_eq_nil n

end vector


import missing.linear_algebra.matrix.ldl
import schur_complement
import subadditivity

/- In this file we prove properties needed for the log-det-atom.
We follow the proof in the Mosek documentation:
https://docs.mosek.com/modeling-cookbook/sdo.html#log-determinant -/

namespace matrix
open_locale matrix
open_locale big_operators
variables {n : Type} [fintype n] [linear_order n] [locally_finite_order_bot n]
variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {A : matrix n n ℝ} (hA : A.pos_def)

noncomputable instance LDL.invertible_diag : invertible (LDL.diag hA) :=
begin
  rw LDL.diag_eq_lower_inv_conj,
  refine @invertible_mul _ _ _ _ (@invertible_mul _ _ _ _ _ hA.invertible) _,
end

@[simp] lemma pos_semidef_zero : matrix.pos_semidef (0 : matrix n n 𝕜) :=
by simp [pos_semidef]

lemma log_det_atom.feasibility_pos_def {D Z : matrix n n ℝ}
  (hD : D = LDL.diag hA)
  (hZ : Z = LDL.diag hA ⬝ (LDL.lower hA)ᵀ) :
  (from_blocks D Z Zᵀ A).pos_semidef :=
begin
  have h_D_eq : D = Z ⬝ A⁻¹ ⬝ Zᴴ,
    calc D = D ⬝ D⁻¹ ⬝ D : by rw [hD, matrix.mul_inv_of_invertible, matrix.one_mul]
       ... = D ⬝ (LDL.lower_inv hA ⬝ A ⬝ (LDL.lower_inv hA)ᵀ)⁻¹ ⬝ Dᵀ
        : by erw [hD, LDL.diag, diagonal_transpose, ← LDL.diag, LDL.diag_eq_lower_inv_conj]; refl
       ... = D ⬝ (LDL.lower hA)ᵀ ⬝ A⁻¹ ⬝ (D ⬝ (LDL.lower hA)ᵀ)ᵀ
        : by simp only [hD, LDL.lower, transpose_mul, transpose_transpose, transpose_nonsing_inv,
            matrix.mul_assoc, matrix.mul_inv_rev]
       ... = Z ⬝ A⁻¹ ⬝ Zᴴ
        : by rw [hZ, hD]; refl,
  haveI := hA.invertible,
  erw pos_semidef.from_blocks₂₂ _ _ hA,
  simp [h_D_eq]
end

def to_upper_tri {m α : Type*} [linear_order m] [has_zero α] (A : matrix m m α) : matrix m m α :=
λ i j, if i ≤ j then A i j else 0

lemma upper_triangular_to_upper_tri (A : matrix n n ℝ) : A.to_upper_tri.upper_triangular :=
begin
  intros i j hij,
  unfold to_upper_tri,
  rw [if_neg],
  simpa using hij,
end

lemma upper_triangular.to_upper_tri_eq {A : matrix n n ℝ} (hA : upper_triangular A) :
  A.to_upper_tri = A :=
begin
  ext i j,
  by_cases i ≤ j,
  simp [to_upper_tri, h],
  simp [to_upper_tri, h, hA (lt_of_not_ge h)]
end

lemma log_det_atom.feasibility_pos_def' {D Z Y : matrix n n ℝ}
  (hY : Y = LDL.diag hA ⬝ (LDL.lower hA)ᵀ)
  (hD : D = diagonal Y.diag)
  (hZ : Z = Y.to_upper_tri) :
  (from_blocks D Z Zᵀ A).pos_semidef :=
begin
  have hY_tri : upper_triangular Y,
  { rw [hY],
    apply upper_triangular.mul,
    apply block_triangular_diagonal,
    apply lower_triangular.transpose,
    apply LDL.lower_triangular_lower },
  haveI := hA.invertible,
  rw [hZ, hY_tri.to_upper_tri_eq],
  apply log_det_atom.feasibility_pos_def _ _ hY,
  simp [hD, hY, LDL.diag],
end

lemma LDL.diag_entries_pos {A : matrix n n ℝ} (hA: A.pos_def) (i : n) :
  0 < LDL.diag_entries hA i :=
begin
  have : (LDL.lower_inv hA).det ≠ 0, by simp [LDL.det_lower_inv hA],
  have : LDL.lower_inv hA i ≠ 0,
    from λ h, this (matrix.det_eq_zero_of_row_eq_zero i (λ j, congr_fun h j)),
  exact hA.2 (LDL.lower_inv hA i) this,
end

lemma log_det_atom.solution_eq_atom {A : matrix n n ℝ} (hA: A.pos_def) :
  (∑ i, real.log (LDL.diag_entries hA i)) = real.log (A.det) :=
begin
  conv { to_rhs, rw [(LDL.lower_conj_diag hA).symm] },
  have := real.log_prod finset.univ (LDL.diag_entries hA)
    (λ i _, ne_of_gt (LDL.diag_entries_pos hA i)),
  simp [LDL.diag, this.symm]
end

lemma log_det_atom.feasibility_exp {A : matrix n n ℝ} (hA: A.pos_def) (i : n) :
  LDL.diag_entries hA i ≤ ((LDL.diag hA) ⬝ ((LDL.lower hA)ᵀ)).diag i :=
by simp [LDL.diag]

lemma is_hermitian₁₁_of_is_hermitian_to_block
  {A B C D : matrix n n ℝ} (h : (from_blocks A B C D).is_hermitian) :
  is_hermitian A :=
by { ext i j, simpa using congr_fun (congr_fun h (sum.inl i)) (sum.inl j) }

lemma is_hermitian₂₂_of_is_hermitian_to_block
  {A B C D : matrix n n ℝ} (h : (from_blocks A B C D).is_hermitian) :
  is_hermitian D :=
by { ext i j, simpa using congr_fun (congr_fun h (sum.inr i)) (sum.inr j) }

lemma pos_semidef₁₁_of_pos_semidef_to_block
  {A B C D : matrix n n ℝ}
  (h_posdef : (from_blocks A B C D).pos_semidef) :
  pos_semidef A :=
⟨is_hermitian₁₁_of_is_hermitian_to_block h_posdef.1,
  λ x, by simpa [matrix.from_blocks_mul_vec, star] using h_posdef.2 (sum.elim x 0)⟩

lemma pos_semidef₂₂_of_pos_semidef_to_block
  {A B C D : matrix n n ℝ}
  (h_posdef : (from_blocks A B C D).pos_semidef) :
  pos_semidef D :=
⟨is_hermitian₂₂_of_is_hermitian_to_block h_posdef.1,
  λ x, by simpa [matrix.from_blocks_mul_vec, star] using h_posdef.2 (sum.elim 0 x)⟩

lemma log_det_atom.optimality_D_posdef {t : n → ℝ} {Y Z D : matrix n n ℝ} (ht : ∀ i, (t i).exp ≤ Y.diag i)
  (hD : D = matrix.diagonal (Y.diag)) (hZ : Z = Y.to_upper_tri)
  (h_posdef : (from_blocks D Z Zᵀ A).pos_semidef) :
  D.pos_def :=
begin
  have h_D_psd : D.pos_semidef := pos_semidef₁₁_of_pos_semidef_to_block h_posdef,
  show D.pos_def,
  { rw [h_D_psd.pos_def_iff_det_ne_zero, hD, det_diagonal, finset.prod_ne_zero_iff],
    exact λ i _, ne_of_gt (lt_of_lt_of_le ((t i).exp_pos) (ht i)) },
end

lemma log_det_atom.optimality_Ddet_le_Adet {t : n → ℝ} {Y Z D : matrix n n ℝ} (ht : ∀ i, (t i).exp ≤ Y.diag i)
  (hD : D = matrix.diagonal (Y.diag)) (hZ : Z = Y.to_upper_tri)
  (h_posdef : (from_blocks D Z Zᵀ A).pos_semidef) :
  D.det ≤ A.det :=
begin
  by_cases h_nonempty : nonempty n,
  { have h_D_pd : D.pos_def, from log_det_atom.optimality_D_posdef ht hD hZ h_posdef,
    haveI h_D_invertible : invertible D := h_D_pd.invertible,
    have h_Zdet : Z.det = D.det,
    { rw [hZ, det_of_upper_triangular (upper_triangular_to_upper_tri Y), hD, det_diagonal],
      simp [to_upper_tri], },
    have h_ZDZ_semidef : (Zᴴ ⬝ D⁻¹ ⬝ Z).pos_semidef,
    from pos_semidef.conj_transpose_mul_mul D⁻¹ Z h_D_pd.nonsingular_inv.pos_semidef,
    have h_AZDZ_semidef : (A - Zᴴ ⬝ D⁻¹ ⬝ Z).pos_semidef,
      from (pos_semidef.from_blocks₁₁ Z A h_D_pd).1 h_posdef,
    show D.det ≤ A.det,
    { apply le_of_add_le_of_nonneg_left _ h_AZDZ_semidef.det_nonneg,
      simpa [h_Zdet] using det_add_det_le_det_add _ _ h_ZDZ_semidef h_AZDZ_semidef } },
  { haveI h_empty := not_nonempty_iff.1 h_nonempty,
    simp only [matrix.det_is_empty] }
end

lemma log_det_atom.cond_elim {t : n → ℝ} {Y Z D : matrix n n ℝ} (ht : ∀ i, (t i).exp ≤ Y.diag i)
  (hD : D = matrix.diagonal (Y.diag)) (hZ : Z = Y.to_upper_tri)
  (h_posdef : (from_blocks D Z Zᵀ A).pos_semidef) :
  A.pos_def :=
begin
  have h_D_pd : D.pos_def, from log_det_atom.optimality_D_posdef ht hD hZ h_posdef,
  have h_A_psd : A.pos_semidef := pos_semidef₂₂_of_pos_semidef_to_block h_posdef,
  have h_Ddet_le_Adet : D.det ≤ A.det := log_det_atom.optimality_Ddet_le_Adet ht hD hZ h_posdef,
  have h_Adet_pos : 0 < A.det, from lt_of_lt_of_le h_D_pd.det_pos h_Ddet_le_Adet,
  rw h_A_psd.pos_def_iff_det_ne_zero,
  apply ne_of_gt h_Adet_pos
end

lemma log_det_atom.optimality {t : n → ℝ} {Y Z D : matrix n n ℝ} (ht : ∀ i, (t i).exp ≤ Y.diag i)
  (hD : D = matrix.diagonal (Y.diag)) (hZ : Z = Y.to_upper_tri)
  (h_posdef : (from_blocks D Z Zᵀ A).pos_semidef) :
  ∑ i, t i ≤ real.log A.det :=
begin
  have h_A_pd : A.pos_def, from log_det_atom.cond_elim ht hD hZ h_posdef,
  have h_Ddet_le_Adet : D.det ≤ A.det := log_det_atom.optimality_Ddet_le_Adet ht hD hZ h_posdef,
  have h_Adet_pos: 0 < A.det, from h_A_pd.det_pos,
  rw [←real.exp_le_exp, real.exp_sum, real.exp_log h_Adet_pos],
  apply le_trans (finset.prod_le_prod (λ i _, le_of_lt ((t i).exp_pos)) (λ i _, ht i)),
  convert h_Ddet_le_Adet,
  simp [hD]
end

end matrix