/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.trigonometric.basic
import topology.algebra.order.proj_Icc

/-!
# Inverse trigonometric functions.

See also `analysis.special_functions.trigonometric.arctan` for the inverse tan function.
(This is delayed as it is easier to set up after developing complex trigonometric functions.)

Basic inequalities on trigonometric functions.
-/

noncomputable theory
open_locale classical topology filter
open set filter

open_locale real

namespace real

/-- Inverse of the `sin` function, returns values in the range `-π / 2 ≤ arcsin x ≤ π / 2`.
It defaults to `-π / 2` on `(-∞, -1)` and to `π / 2` to `(1, ∞)`. -/
@[pp_nodot] noncomputable def arcsin : ℝ → ℝ :=
coe ∘ Icc_extend (neg_le_self zero_le_one) sin_order_iso.symm

lemma arcsin_mem_Icc (x : ℝ) : arcsin x ∈ Icc (-(π / 2)) (π / 2) := subtype.coe_prop _

@[simp] lemma range_arcsin : range arcsin = Icc (-(π / 2)) (π / 2) :=
by { rw [arcsin, range_comp coe], simp [Icc] }

lemma arcsin_le_pi_div_two (x : ℝ) : arcsin x ≤ π / 2 := (arcsin_mem_Icc x).2

lemma neg_pi_div_two_le_arcsin (x : ℝ) : -(π / 2) ≤ arcsin x := (arcsin_mem_Icc x).1

lemma arcsin_proj_Icc (x : ℝ) :
  arcsin (proj_Icc (-1) 1 (neg_le_self zero_le_one) x) = arcsin x :=
by rw [arcsin, function.comp_app, Icc_extend_coe, function.comp_app, Icc_extend]

lemma sin_arcsin' {x : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) : sin (arcsin x) = x :=
by simpa [arcsin, Icc_extend_of_mem _ _ hx, -order_iso.apply_symm_apply]
  using subtype.ext_iff.1 (sin_order_iso.apply_symm_apply ⟨x, hx⟩)

lemma sin_arcsin {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : sin (arcsin x) = x :=
sin_arcsin' ⟨hx₁, hx₂⟩

lemma arcsin_sin' {x : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) : arcsin (sin x) = x :=
inj_on_sin (arcsin_mem_Icc _) hx $ by rw [sin_arcsin (neg_one_le_sin _) (sin_le_one _)]

lemma arcsin_sin {x : ℝ} (hx₁ : -(π / 2) ≤ x) (hx₂ : x ≤ π / 2) : arcsin (sin x) = x :=
arcsin_sin' ⟨hx₁, hx₂⟩

lemma strict_mono_on_arcsin : strict_mono_on arcsin (Icc (-1) 1) :=
(subtype.strict_mono_coe _).comp_strict_mono_on $
  sin_order_iso.symm.strict_mono.strict_mono_on_Icc_extend _

lemma monotone_arcsin : monotone arcsin :=
(subtype.mono_coe _).comp $ sin_order_iso.symm.monotone.Icc_extend _

lemma inj_on_arcsin : inj_on arcsin (Icc (-1) 1) := strict_mono_on_arcsin.inj_on

lemma arcsin_inj {x y : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) (hy₁ : -1 ≤ y) (hy₂ : y ≤ 1) :
  arcsin x = arcsin y ↔ x = y :=
inj_on_arcsin.eq_iff ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩

@[continuity]
lemma continuous_arcsin : continuous arcsin :=
continuous_subtype_coe.comp sin_order_iso.symm.continuous.Icc_extend'

lemma continuous_at_arcsin {x : ℝ} : continuous_at arcsin x :=
continuous_arcsin.continuous_at

lemma arcsin_eq_of_sin_eq {x y : ℝ} (h₁ : sin x = y) (h₂ : x ∈ Icc (-(π / 2)) (π / 2)) :
  arcsin y = x :=
begin
  subst y,
  exact inj_on_sin (arcsin_mem_Icc _) h₂ (sin_arcsin' (sin_mem_Icc x))
end

@[simp] lemma arcsin_zero : arcsin 0 = 0 :=
arcsin_eq_of_sin_eq sin_zero ⟨neg_nonpos.2 pi_div_two_pos.le, pi_div_two_pos.le⟩

@[simp] lemma arcsin_one : arcsin 1 = π / 2 :=
arcsin_eq_of_sin_eq sin_pi_div_two $ right_mem_Icc.2 (neg_le_self pi_div_two_pos.le)

lemma arcsin_of_one_le {x : ℝ} (hx : 1 ≤ x) : arcsin x = π / 2 :=
by rw [← arcsin_proj_Icc, proj_Icc_of_right_le _ hx, subtype.coe_mk, arcsin_one]

lemma arcsin_neg_one : arcsin (-1) = -(π / 2) :=
arcsin_eq_of_sin_eq (by rw [sin_neg, sin_pi_div_two]) $
  left_mem_Icc.2 (neg_le_self pi_div_two_pos.le)

lemma arcsin_of_le_neg_one {x : ℝ} (hx : x ≤ -1) : arcsin x = -(π / 2) :=
by rw [← arcsin_proj_Icc, proj_Icc_of_le_left _ hx, subtype.coe_mk, arcsin_neg_one]

@[simp] lemma arcsin_neg (x : ℝ) : arcsin (-x) = -arcsin x :=
begin
  cases le_total x (-1) with hx₁ hx₁,
  { rw [arcsin_of_le_neg_one hx₁, neg_neg, arcsin_of_one_le (le_neg.2 hx₁)] },
  cases le_total 1 x with hx₂ hx₂,
  { rw [arcsin_of_one_le hx₂, arcsin_of_le_neg_one (neg_le_neg hx₂)] },
  refine arcsin_eq_of_sin_eq _ _,
  { rw [sin_neg, sin_arcsin hx₁ hx₂] },
  { exact ⟨neg_le_neg (arcsin_le_pi_div_two _), neg_le.2 (neg_pi_div_two_le_arcsin _)⟩ }
end

lemma arcsin_le_iff_le_sin {x y : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) (hy : y ∈ Icc (-(π / 2)) (π / 2)) :
  arcsin x ≤ y ↔ x ≤ sin y :=
by rw [← arcsin_sin' hy, strict_mono_on_arcsin.le_iff_le hx (sin_mem_Icc _), arcsin_sin' hy]

lemma arcsin_le_iff_le_sin' {x y : ℝ} (hy : y ∈ Ico (-(π / 2)) (π / 2)) :
  arcsin x ≤ y ↔ x ≤ sin y :=
begin
  cases le_total x (-1) with hx₁ hx₁,
  { simp [arcsin_of_le_neg_one hx₁, hy.1, hx₁.trans (neg_one_le_sin _)] },
  cases lt_or_le 1 x with hx₂ hx₂,
  { simp [arcsin_of_one_le hx₂.le, hy.2.not_le, (sin_le_one y).trans_lt hx₂] },
  exact arcsin_le_iff_le_sin ⟨hx₁, hx₂⟩ (mem_Icc_of_Ico hy)
end

lemma le_arcsin_iff_sin_le {x y : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) (hy : y ∈ Icc (-1 : ℝ) 1) :
  x ≤ arcsin y ↔ sin x ≤ y :=
by rw [← neg_le_neg_iff, ← arcsin_neg,
  arcsin_le_iff_le_sin ⟨neg_le_neg hy.2, neg_le.2 hy.1⟩ ⟨neg_le_neg hx.2, neg_le.2 hx.1⟩,
  sin_neg, neg_le_neg_iff]

lemma le_arcsin_iff_sin_le' {x y : ℝ} (hx : x ∈ Ioc (-(π / 2)) (π / 2)) :
  x ≤ arcsin y ↔ sin x ≤ y :=
by rw [← neg_le_neg_iff, ← arcsin_neg, arcsin_le_iff_le_sin' ⟨neg_le_neg hx.2, neg_lt.2 hx.1⟩,
  sin_neg, neg_le_neg_iff]

lemma arcsin_lt_iff_lt_sin {x y : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) (hy : y ∈ Icc (-(π / 2)) (π / 2)) :
  arcsin x < y ↔ x < sin y :=
not_le.symm.trans $ (not_congr $ le_arcsin_iff_sin_le hy hx).trans not_le

lemma arcsin_lt_iff_lt_sin' {x y : ℝ} (hy : y ∈ Ioc (-(π / 2)) (π / 2)) :
  arcsin x < y ↔ x < sin y :=
not_le.symm.trans $ (not_congr $ le_arcsin_iff_sin_le' hy).trans not_le

lemma lt_arcsin_iff_sin_lt {x y : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) (hy : y ∈ Icc (-1 : ℝ) 1) :
  x < arcsin y ↔ sin x < y :=
not_le.symm.trans $ (not_congr $ arcsin_le_iff_le_sin hy hx).trans not_le

lemma lt_arcsin_iff_sin_lt' {x y : ℝ} (hx : x ∈ Ico (-(π / 2)) (π / 2)) :
  x < arcsin y ↔ sin x < y :=
not_le.symm.trans $ (not_congr $ arcsin_le_iff_le_sin' hx).trans not_le

lemma arcsin_eq_iff_eq_sin {x y : ℝ} (hy : y ∈ Ioo (-(π / 2)) (π / 2)) :
  arcsin x = y ↔ x = sin y :=
by simp only [le_antisymm_iff, arcsin_le_iff_le_sin' (mem_Ico_of_Ioo hy),
  le_arcsin_iff_sin_le' (mem_Ioc_of_Ioo hy)]

@[simp] lemma arcsin_nonneg {x : ℝ} : 0 ≤ arcsin x ↔ 0 ≤ x :=
(le_arcsin_iff_sin_le' ⟨neg_lt_zero.2 pi_div_two_pos, pi_div_two_pos.le⟩).trans $ by rw [sin_zero]

@[simp] lemma arcsin_nonpos {x : ℝ} : arcsin x ≤ 0 ↔ x ≤ 0 :=
neg_nonneg.symm.trans $ arcsin_neg x ▸ arcsin_nonneg.trans neg_nonneg

@[simp] lemma arcsin_eq_zero_iff {x : ℝ} : arcsin x = 0 ↔ x = 0 :=
by simp [le_antisymm_iff]

@[simp] lemma zero_eq_arcsin_iff {x} : 0 = arcsin x ↔ x = 0 :=
eq_comm.trans arcsin_eq_zero_iff

@[simp] lemma arcsin_pos {x : ℝ} : 0 < arcsin x ↔ 0 < x :=
lt_iff_lt_of_le_iff_le arcsin_nonpos

@[simp] lemma arcsin_lt_zero {x : ℝ} : arcsin x < 0 ↔ x < 0 :=
lt_iff_lt_of_le_iff_le arcsin_nonneg

@[simp] lemma arcsin_lt_pi_div_two {x : ℝ} : arcsin x < π / 2 ↔ x < 1 :=
(arcsin_lt_iff_lt_sin' (right_mem_Ioc.2 $ neg_lt_self pi_div_two_pos)).trans $
  by rw sin_pi_div_two

@[simp] lemma neg_pi_div_two_lt_arcsin {x : ℝ} : -(π / 2) < arcsin x ↔ -1 < x :=
(lt_arcsin_iff_sin_lt' $ left_mem_Ico.2 $ neg_lt_self pi_div_two_pos).trans $
  by rw [sin_neg, sin_pi_div_two]

@[simp] lemma arcsin_eq_pi_div_two {x : ℝ} : arcsin x = π / 2 ↔ 1 ≤ x :=
⟨λ h, not_lt.1 $ λ h', (arcsin_lt_pi_div_two.2 h').ne h, arcsin_of_one_le⟩

@[simp] lemma pi_div_two_eq_arcsin {x} : π / 2 = arcsin x ↔ 1 ≤ x :=
eq_comm.trans arcsin_eq_pi_div_two

@[simp] lemma pi_div_two_le_arcsin {x} : π / 2 ≤ arcsin x ↔ 1 ≤ x :=
(arcsin_le_pi_div_two x).le_iff_eq.trans pi_div_two_eq_arcsin

@[simp] lemma arcsin_eq_neg_pi_div_two {x : ℝ} : arcsin x = -(π / 2) ↔ x ≤ -1 :=
⟨λ h, not_lt.1 $ λ h', (neg_pi_div_two_lt_arcsin.2 h').ne' h, arcsin_of_le_neg_one⟩

@[simp] lemma neg_pi_div_two_eq_arcsin {x} : -(π / 2) = arcsin x ↔ x ≤ -1 :=
eq_comm.trans arcsin_eq_neg_pi_div_two

@[simp] lemma arcsin_le_neg_pi_div_two {x} : arcsin x ≤ -(π / 2) ↔ x ≤ -1 :=
(neg_pi_div_two_le_arcsin x).le_iff_eq.trans arcsin_eq_neg_pi_div_two

@[simp]

lemma maps_to_sin_Ioo : maps_to sin (Ioo (-(π / 2)) (π / 2)) (Ioo (-1) 1) :=
λ x h, by rwa [mem_Ioo, ← arcsin_lt_pi_div_two, ← neg_pi_div_two_lt_arcsin,
  arcsin_sin h.1.le h.2.le]

/-- `real.sin` as a `local_homeomorph` between `(-π / 2, π / 2)` and `(-1, 1)`. -/
@[simp] def sin_local_homeomorph : local_homeomorph ℝ ℝ :=
{ to_fun := sin,
  inv_fun := arcsin,
  source := Ioo (-(π / 2)) (π / 2),
  target := Ioo (-1) 1,
  map_source' := maps_to_sin_Ioo,
  map_target' := λ y hy, ⟨neg_pi_div_two_lt_arcsin.2 hy.1, arcsin_lt_pi_div_two.2 hy.2⟩,
  left_inv' := λ x hx, arcsin_sin hx.1.le hx.2.le,
  right_inv' := λ y hy, sin_arcsin hy.1.le hy.2.le,
  open_source := is_open_Ioo,
  open_target := is_open_Ioo,
  continuous_to_fun := continuous_sin.continuous_on,
  continuous_inv_fun := continuous_arcsin.continuous_on }

lemma cos_arcsin_nonneg (x : ℝ) : 0 ≤ cos (arcsin x) :=
cos_nonneg_of_mem_Icc ⟨neg_pi_div_two_le_arcsin _, arcsin_le_pi_div_two _⟩

-- The junk values for `arcsin` and `sqrt` make this true even outside `[-1, 1]`.
lemma cos_arcsin (x : ℝ) : cos (arcsin x) = sqrt (1 - x ^ 2) :=
begin
  by_cases hx₁ : -1 ≤ x, swap,
  { rw not_le at hx₁,
    rw [arcsin_of_le_neg_one hx₁.le, cos_neg, cos_pi_div_two, sqrt_eq_zero_of_nonpos],
    nlinarith },
  by_cases hx₂ : x ≤ 1, swap,
  { rw not_le at hx₂,
    rw [arcsin_of_one_le hx₂.le, cos_pi_div_two, sqrt_eq_zero_of_nonpos],
    nlinarith },
  have : sin (arcsin x) ^ 2 + cos (arcsin x) ^ 2 = 1 := sin_sq_add_cos_sq (arcsin x),
  rw [← eq_sub_iff_add_eq', ← sqrt_inj (sq_nonneg _) (sub_nonneg.2 (sin_sq_le_one (arcsin x))),
    sq, sqrt_mul_self (cos_arcsin_nonneg _)] at this,
  rw [this, sin_arcsin hx₁ hx₂],
end

-- The junk values for `arcsin` and `sqrt` make this true even outside `[-1, 1]`.
lemma tan_arcsin (x : ℝ) : tan (arcsin x) = x / sqrt (1 - x ^ 2) :=
begin
  rw [tan_eq_sin_div_cos, cos_arcsin],
  by_cases hx₁ : -1 ≤ x, swap,
  { have h : sqrt (1 - x ^ 2) = 0, { exact sqrt_eq_zero_of_nonpos (by nlinarith) }, rw h, simp },
  by_cases hx₂ : x ≤ 1, swap,
  { have h : sqrt (1 - x ^ 2) = 0, { exact sqrt_eq_zero_of_nonpos (by nlinarith) }, rw h, simp },
  rw sin_arcsin hx₁ hx₂
end

/-- Inverse of the `cos` function, returns values in the range `0 ≤ arccos x` and `arccos x ≤ π`.
  It defaults to `π` on `(-∞, -1)` and to `0` to `(1, ∞)`. -/
@[pp_nodot] noncomputable def arccos (x : ℝ) : ℝ :=
π / 2 - arcsin x

lemma arccos_eq_pi_div_two_sub_arcsin (x : ℝ) : arccos x = π / 2 - arcsin x := rfl

lemma arcsin_eq_pi_div_two_sub_arccos (x : ℝ) : arcsin x = π / 2 - arccos x :=
by simp [arccos]

lemma arccos_le_pi (x : ℝ) : arccos x ≤ π :=
by unfold arccos; linarith [neg_pi_div_two_le_arcsin x]

lemma arccos_nonneg (x : ℝ) : 0 ≤ arccos x :=
by unfold arccos; linarith [arcsin_le_pi_div_two x]

@[simp] lemma arccos_pos {x : ℝ} : 0 < arccos x ↔ x < 1 :=
by simp [arccos]

lemma cos_arccos {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : cos (arccos x) = x :=
by rw [arccos, cos_pi_div_two_sub, sin_arcsin hx₁ hx₂]

lemma arccos_cos {x : ℝ} (hx₁ : 0 ≤ x) (hx₂ : x ≤ π) : arccos (cos x) = x :=
by rw [arccos, ← sin_pi_div_two_sub, arcsin_sin]; simp [sub_eq_add_neg]; linarith

lemma strict_anti_on_arccos : strict_anti_on arccos (Icc (-1) 1) :=
λ x hx y hy h, sub_lt_sub_left (strict_mono_on_arcsin hx hy h) _

lemma arccos_inj_on : inj_on arccos (Icc (-1) 1) := strict_anti_on_arccos.inj_on

lemma arccos_inj {x y : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) (hy₁ : -1 ≤ y) (hy₂ : y ≤ 1) :
  arccos x = arccos y ↔ x = y :=
arccos_inj_on.eq_iff ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩

@[simp] lemma arccos_zero : arccos 0 = π / 2 := by simp [arccos]

@[simp] lemma arccos_one : arccos 1 = 0 := by simp [arccos]

@[simp] lemma arccos_neg_one : arccos (-1) = π := by simp [arccos, add_halves]

@[simp] lemma arccos_eq_zero {x} : arccos x = 0 ↔ 1 ≤ x :=
by simp [arccos, sub_eq_zero]

@[simp] lemma arccos_eq_pi_div_two {x} : arccos x = π / 2 ↔ x = 0 :=
by simp [arccos]

@[simp] lemma arccos_eq_pi {x} : arccos x = π ↔ x ≤ -1 :=
by rw [arccos, sub_eq_iff_eq_add, ← sub_eq_iff_eq_add', div_two_sub_self, neg_pi_div_two_eq_arcsin]

lemma arccos_neg (x : ℝ) : arccos (-x) = π - arccos x :=
by rw [← add_halves π, arccos, arcsin_neg, arccos, add_sub_assoc, sub_sub_self, sub_neg_eq_add]

lemma arccos_of_one_le {x : ℝ} (hx : 1 ≤ x) : arccos x = 0 :=
by rw [arccos, arcsin_of_one_le hx, sub_self]

lemma arccos_of_le_neg_one {x : ℝ} (hx : x ≤ -1) : arccos x = π :=
by rw [arccos, arcsin_of_le_neg_one hx, sub_neg_eq_add, add_halves']

-- The junk values for `arccos` and `sqrt` make this true even outside `[-1, 1]`.
lemma sin_arccos (x : ℝ) : sin (arccos x) = sqrt (1 - x ^ 2) :=
begin
  by_cases hx₁ : -1 ≤ x, swap,
  { rw not_le at hx₁,
    rw [arccos_of_le_neg_one hx₁.le, sin_pi, sqrt_eq_zero_of_nonpos],
    nlinarith },
  by_cases hx₂ : x ≤ 1, swap,
  { rw not_le at hx₂,
    rw [arccos_of_one_le hx₂.le, sin_zero, sqrt_eq_zero_of_nonpos],
    nlinarith },
  rw [arccos_eq_pi_div_two_sub_arcsin, sin_pi_div_two_sub, cos_arcsin]
end

@[simp] lemma arccos_le_pi_div_two {x} : arccos x ≤ π / 2 ↔ 0 ≤ x := by simp [arccos]

@[simp] lemma arccos_lt_pi_div_two {x : ℝ} : arccos x < π / 2 ↔ 0 < x := by simp [arccos]

@[simp] lemma arccos_le_pi_div_four {x} : arccos x ≤ π / 4 ↔ sqrt 2 / 2 ≤ x :=
by { rw [arccos, ← pi_div_four_le_arcsin], split; { intro, linarith } }

@[continuity]
lemma continuous_arccos : continuous arccos := continuous_const.sub continuous_arcsin

-- The junk values for `arccos` and `sqrt` make this true even outside `[-1, 1]`.
lemma tan_arccos (x : ℝ) : tan (arccos x) = sqrt (1 - x ^ 2) / x :=
by rw [arccos, tan_pi_div_two_sub, tan_arcsin, inv_div]

-- The junk values for `arccos` and `sqrt` make this true even for `1 < x`.
lemma arccos_eq_arcsin {x : ℝ} (h : 0 ≤ x) :
  arccos x = arcsin (sqrt (1 - x ^ 2)) :=
(arcsin_eq_of_sin_eq (sin_arccos _)
  ⟨(left.neg_nonpos_iff.2 (div_nonneg pi_pos.le (by norm_num))).trans (arccos_nonneg _),
   arccos_le_pi_div_two.2 h⟩).symm

-- The junk values for `arcsin` and `sqrt` make this true even for `1 < x`.
lemma arcsin_eq_arccos {x : ℝ} (h : 0 ≤ x) :
  arcsin x = arccos (sqrt (1 - x ^ 2)) :=
begin
  rw [eq_comm, ← cos_arcsin],
  exact arccos_cos (arcsin_nonneg.2 h)
    ((arcsin_le_pi_div_two _).trans (div_le_self pi_pos.le one_le_two))
end

end real


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Manuel Candales
-/
import analysis.inner_product_space.basic
import analysis.special_functions.trigonometric.inverse

/-!
# Angles between vectors

This file defines unoriented angles in real inner product spaces.

## Main definitions

* `inner_product_geometry.angle` is the undirected angle between two vectors.

-/

assert_not_exists has_fderiv_at
assert_not_exists conformal_at

noncomputable theory
open real set
open_locale big_operators
open_locale real
open_locale real_inner_product_space

namespace inner_product_geometry

variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V] {x y : V}

/-- The undirected angle between two vectors. If either vector is 0,
this is π/2. See `orientation.oangle` for the corresponding oriented angle
definition. -/
def angle (x y : V) : ℝ := real.arccos (⟪x, y⟫ / (‖x‖ * ‖y‖))

lemma continuous_at_angle {x : V × V} (hx1 : x.1 ≠ 0) (hx2 : x.2 ≠ 0) :
  continuous_at (λ y : V × V, angle y.1 y.2) x :=
real.continuous_arccos.continuous_at.comp $ continuous_inner.continuous_at.div
  ((continuous_norm.comp continuous_fst).mul (continuous_norm.comp continuous_snd)).continuous_at
  (by simp [hx1, hx2])

lemma angle_smul_smul {c : ℝ} (hc : c ≠ 0) (x y : V) :
  angle (c • x) (c • y) = angle x y :=
have c * c ≠ 0, from mul_ne_zero hc hc,
by rw [angle, angle, real_inner_smul_left, inner_smul_right, norm_smul, norm_smul, real.norm_eq_abs,
  mul_mul_mul_comm _ (‖x‖), abs_mul_abs_self, ← mul_assoc c c, mul_div_mul_left _ _ this]

@[simp] lemma _root_.linear_isometry.angle_map {E F : Type*}
  [normed_add_comm_group E] [normed_add_comm_group F]
  [inner_product_space ℝ E] [inner_product_space ℝ F] (f : E →ₗᵢ[ℝ] F) (u v : E) :
  angle (f u) (f v) = angle u v :=
by rw [angle, angle, f.inner_map_map, f.norm_map, f.norm_map]

@[simp, norm_cast] lemma _root_.submodule.angle_coe {s : submodule ℝ V} (x y : s) :
  angle (x : V) (y : V) = angle x y :=
s.subtypeₗᵢ.angle_map x y

/-- The cosine of the angle between two vectors. -/
lemma cos_angle (x y : V) : real.cos (angle x y) = ⟪x, y⟫ / (‖x‖ * ‖y‖) :=
real.cos_arccos (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
                (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2

/-- The angle between two vectors does not depend on their order. -/
lemma angle_comm (x y : V) : angle x y = angle y x :=
begin
  unfold angle,
  rw [real_inner_comm, mul_comm]
end

/-- The angle between the negation of two vectors. -/
@[simp] lemma angle_neg_neg (x y : V) : angle (-x) (-y) = angle x y :=
begin
  unfold angle,
  rw [inner_neg_neg, norm_neg, norm_neg]
end

/-- The angle between two vectors is nonnegative. -/
lemma angle_nonneg (x y : V) : 0 ≤ angle x y :=
real.arccos_nonneg _

/-- The angle between two vectors is at most π. -/
lemma angle_le_pi (x y : V) : angle x y ≤ π :=
real.arccos_le_pi _

/-- The angle between a vector and the negation of another vector. -/
lemma angle_neg_right (x y : V) : angle x (-y) = π - angle x y :=
begin
  unfold angle,
  rw [←real.arccos_neg, norm_neg, inner_neg_right, neg_div]
end

/-- The angle between the negation of a vector and another vector. -/
lemma angle_neg_left (x y : V) : angle (-x) y = π - angle x y :=
by rw [←angle_neg_neg, neg_neg, angle_neg_right]

/-- The angle between the zero vector and a vector. -/
@[simp] lemma angle_zero_left (x : V) : angle 0 x = π / 2 :=
begin
  unfold angle,
  rw [inner_zero_left, zero_div, real.arccos_zero]
end

/-- The angle between a vector and the zero vector. -/
@[simp] lemma angle_zero_right (x : V) : angle x 0 = π / 2 :=
begin
  unfold angle,
  rw [inner_zero_right, zero_div, real.arccos_zero]
end

/-- The angle between a nonzero vector and itself. -/
@[simp] lemma angle_self {x : V} (hx : x ≠ 0) : angle x x = 0 :=
begin
  unfold angle,
  rw [←real_inner_self_eq_norm_mul_norm, div_self (inner_self_ne_zero.2 hx : ⟪x, x⟫ ≠ 0),
    real.arccos_one]
end

/-- The angle between a nonzero vector and its negation. -/
@[simp] lemma angle_self_neg_of_nonzero {x : V} (hx : x ≠ 0) : angle x (-x) = π :=
by rw [angle_neg_right, angle_self hx, sub_zero]

/-- The angle between the negation of a nonzero vector and that
vector. -/
@[simp] lemma angle_neg_self_of_nonzero {x : V} (hx : x ≠ 0) : angle (-x) x = π :=
by rw [angle_comm, angle_self_neg_of_nonzero hx]

/-- The angle between a vector and a positive multiple of a vector. -/
@[simp] lemma angle_smul_right_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
  angle x (r • y) = angle x y :=
begin
  unfold angle,
  rw [inner_smul_right, norm_smul, real.norm_eq_abs, abs_of_nonneg (le_of_lt hr), ←mul_assoc,
      mul_comm _ r, mul_assoc, mul_div_mul_left _ _ (ne_of_gt hr)]
end

/-- The angle between a positive multiple of a vector and a vector. -/
@[simp] lemma angle_smul_left_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
  angle (r • x) y = angle x y :=
by rw [angle_comm, angle_smul_right_of_pos y x hr, angle_comm]

/-- The angle between a vector and a negative multiple of a vector. -/
@[simp] lemma angle_smul_right_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
  angle x (r • y) = angle x (-y) :=
by rw [←neg_neg r, neg_smul, angle_neg_right, angle_smul_right_of_pos x y (neg_pos_of_neg hr),
       angle_neg_right]

/-- The angle between a negative multiple of a vector and a vector. -/
@[simp] lemma angle_smul_left_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
  angle (r • x) y = angle (-x) y :=
by rw [angle_comm, angle_smul_right_of_neg y x hr, angle_comm]

/-- The cosine of the angle between two vectors, multiplied by the
product of their norms. -/
lemma cos_angle_mul_norm_mul_norm (x y : V) : real.cos (angle x y) * (‖x‖ * ‖y‖) = ⟪x, y⟫ :=
begin
  rw [cos_angle, div_mul_cancel_of_imp],
  simp [or_imp_distrib] { contextual := tt },
end

/-- The sine of the angle between two vectors, multiplied by the
product of their norms. -/
lemma sin_angle_mul_norm_mul_norm (x y : V) : real.sin (angle x y) * (‖x‖ * ‖y‖) =
    real.sqrt (⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫) :=
begin
  unfold angle,
  rw [real.sin_arccos,
      ←real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
      ←real.sqrt_mul' _ (mul_self_nonneg _), sq,
      real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
      real_inner_self_eq_norm_mul_norm,
      real_inner_self_eq_norm_mul_norm],
  by_cases h : (‖x‖ * ‖y‖) = 0,
  { rw [(show ‖x‖ * ‖x‖ * (‖y‖ * ‖y‖) = (‖x‖ * ‖y‖) * (‖x‖ * ‖y‖), by ring), h, mul_zero, mul_zero,
        zero_sub],
    cases eq_zero_or_eq_zero_of_mul_eq_zero h with hx hy,
    { rw norm_eq_zero at hx,
      rw [hx, inner_zero_left, zero_mul, neg_zero] },
    { rw norm_eq_zero at hy,
      rw [hy, inner_zero_right, zero_mul, neg_zero] } },
  { field_simp [h], ring_nf }
end

/-- The angle between two vectors is zero if and only if they are
nonzero and one is a positive multiple of the other. -/
lemma angle_eq_zero_iff {x y : V} : angle x y = 0 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), 0 < r ∧ y = r • x) :=
begin
  rw [angle, ← real_inner_div_norm_mul_norm_eq_one_iff, real.arccos_eq_zero, has_le.le.le_iff_eq,
    eq_comm],
  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2
end

/-- The angle between two vectors is π if and only if they are nonzero
and one is a negative multiple of the other. -/
lemma angle_eq_pi_iff {x y : V} : angle x y = π ↔ (x ≠ 0 ∧ ∃ (r : ℝ), r < 0 ∧ y = r • x) :=
begin
  rw [angle, ← real_inner_div_norm_mul_norm_eq_neg_one_iff, real.arccos_eq_pi, has_le.le.le_iff_eq],
  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
end

/-- If the angle between two vectors is π, the angles between those
vectors and a third vector add to π. -/
lemma angle_add_angle_eq_pi_of_angle_eq_pi {x y : V} (z : V) (h : angle x y = π) :
  angle x z + angle y z = π :=
begin
  rcases angle_eq_pi_iff.1 h with ⟨hx, ⟨r, ⟨hr, rfl⟩⟩⟩,
  rw [angle_smul_left_of_neg x z hr, angle_neg_left, add_sub_cancel'_right]
end

/-- Two vectors have inner product 0 if and only if the angle between
them is π/2. -/
lemma inner_eq_zero_iff_angle_eq_pi_div_two (x y : V) : ⟪x, y⟫ = 0 ↔ angle x y = π / 2 :=
iff.symm $ by simp [angle, or_imp_distrib] { contextual := tt }

/-- If the angle between two vectors is π, the inner product equals the negative product
of the norms. -/
lemma inner_eq_neg_mul_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ⟪x, y⟫ = - (‖x‖ * ‖y‖) :=
by simp [← cos_angle_mul_norm_mul_norm, h]

/-- If the angle between two vectors is 0, the inner product equals the product of the norms. -/
lemma inner_eq_mul_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ⟪x, y⟫ = ‖x‖ * ‖y‖ :=
by simp [← cos_angle_mul_norm_mul_norm, h]

/-- The inner product of two non-zero vectors equals the negative product of their norms
if and only if the angle between the two vectors is π. -/
lemma inner_eq_neg_mul_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ⟪x, y⟫ = - (‖x‖ * ‖y‖) ↔ angle x y = π :=
begin
  refine ⟨λ h, _, inner_eq_neg_mul_norm_of_angle_eq_pi⟩,
  have h₁ : (‖x‖ * ‖y‖) ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne',
  rw [angle, h, neg_div, div_self h₁, real.arccos_neg_one],
end

/-- The inner product of two non-zero vectors equals the product of their norms
if and only if the angle between the two vectors is 0. -/
lemma inner_eq_mul_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ⟪x, y⟫ = ‖x‖ * ‖y‖ ↔ angle x y = 0 :=
begin
  refine ⟨λ h, _, inner_eq_mul_norm_of_angle_eq_zero⟩,
  have h₁ : (‖x‖ * ‖y‖) ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne',
  rw [angle, h, div_self h₁, real.arccos_one],
end

/-- If the angle between two vectors is π, the norm of their difference equals
the sum of their norms. -/
lemma norm_sub_eq_add_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ‖x - y‖ = ‖x‖ + ‖y‖ :=
begin
  rw ← sq_eq_sq (norm_nonneg (x - y)) (add_nonneg (norm_nonneg x) (norm_nonneg y)),
  rw [norm_sub_pow_two_real, inner_eq_neg_mul_norm_of_angle_eq_pi h],
  ring,
end

/-- If the angle between two vectors is 0, the norm of their sum equals
the sum of their norms. -/
lemma norm_add_eq_add_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ‖x + y‖ = ‖x‖ + ‖y‖ :=
begin
  rw ← sq_eq_sq (norm_nonneg (x + y)) (add_nonneg (norm_nonneg x) (norm_nonneg y)),
  rw [norm_add_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h],
  ring,
end

/-- If the angle between two vectors is 0, the norm of their difference equals
the absolute value of the difference of their norms. -/
lemma norm_sub_eq_abs_sub_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) :
  ‖x - y‖ = |‖x‖ - ‖y‖| :=
begin
  rw [← sq_eq_sq (norm_nonneg (x - y)) (abs_nonneg (‖x‖ - ‖y‖)),
      norm_sub_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h, sq_abs (‖x‖ - ‖y‖)],
  ring,
end

/-- The norm of the difference of two non-zero vectors equals the sum of their norms
if and only the angle between the two vectors is π. -/
lemma norm_sub_eq_add_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ‖x - y‖ = ‖x‖ + ‖y‖ ↔ angle x y = π :=
begin
  refine ⟨λ h, _, norm_sub_eq_add_norm_of_angle_eq_pi⟩,
  rw ← inner_eq_neg_mul_norm_iff_angle_eq_pi hx hy,
  obtain ⟨hxy₁, hxy₂⟩ := ⟨norm_nonneg (x - y), add_nonneg (norm_nonneg x) (norm_nonneg y)⟩,
  rw [← sq_eq_sq hxy₁ hxy₂, norm_sub_pow_two_real] at h,
  calc ⟪x, y⟫ = (‖x‖ ^ 2 + ‖y‖ ^ 2 - (‖x‖ + ‖y‖) ^ 2) / 2 : by linarith
  ...         = -(‖x‖ * ‖y‖) : by ring,
end

/-- The norm of the sum of two non-zero vectors equals the sum of their norms
if and only the angle between the two vectors is 0. -/
lemma norm_add_eq_add_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ‖x + y‖ = ‖x‖ + ‖y‖ ↔ angle x y = 0 :=
begin
  refine ⟨λ h, _, norm_add_eq_add_norm_of_angle_eq_zero⟩,
  rw ← inner_eq_mul_norm_iff_angle_eq_zero hx hy,
  obtain ⟨hxy₁, hxy₂⟩ := ⟨norm_nonneg (x + y), add_nonneg (norm_nonneg x) (norm_nonneg y)⟩,
  rw [← sq_eq_sq hxy₁ hxy₂, norm_add_pow_two_real] at h,
  calc ⟪x, y⟫ = ((‖x‖ + ‖y‖) ^ 2 - ‖x‖ ^ 2 - ‖y‖ ^ 2)/ 2 : by linarith
  ...         = ‖x‖ * ‖y‖ : by ring,
end

/-- The norm of the difference of two non-zero vectors equals the absolute value
of the difference of their norms if and only the angle between the two vectors is 0. -/
lemma norm_sub_eq_abs_sub_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ‖x - y‖ = |‖x‖ - ‖y‖| ↔ angle x y = 0 :=
begin
  refine ⟨λ h, _, norm_sub_eq_abs_sub_norm_of_angle_eq_zero⟩,
  rw ← inner_eq_mul_norm_iff_angle_eq_zero hx hy,
  have h1 : ‖x - y‖ ^ 2 = (‖x‖ - ‖y‖) ^ 2, { rw h, exact sq_abs (‖x‖ - ‖y‖) },
  rw norm_sub_pow_two_real at h1,
  calc ⟪x, y⟫ = ((‖x‖ + ‖y‖) ^ 2 - ‖x‖ ^ 2 - ‖y‖ ^ 2)/ 2 : by linarith
  ...         = ‖x‖ * ‖y‖ : by ring,
end

/-- The norm of the sum of two vectors equals the norm of their difference if and only if
the angle between them is π/2. -/
lemma norm_add_eq_norm_sub_iff_angle_eq_pi_div_two (x y : V) :
  ‖x + y‖ = ‖x - y‖ ↔ angle x y = π / 2 :=
begin
  rw [← sq_eq_sq (norm_nonneg (x + y)) (norm_nonneg (x - y)),
      ← inner_eq_zero_iff_angle_eq_pi_div_two x y, norm_add_pow_two_real, norm_sub_pow_two_real],
  split; intro h; linarith,
end

/-- The cosine of the angle between two vectors is 1 if and only if the angle is 0. -/
lemma cos_eq_one_iff_angle_eq_zero : cos (angle x y) = 1 ↔ angle x y = 0 :=
begin
  rw ← cos_zero,
  exact inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩ (left_mem_Icc.2 pi_pos.le),
end

/-- The cosine of the angle between two vectors is 0 if and only if the angle is π / 2. -/
lemma cos_eq_zero_iff_angle_eq_pi_div_two : cos (angle x y) = 0 ↔ angle x y = π / 2 :=
begin
  rw ← cos_pi_div_two,
  apply inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩,
  split; linarith [pi_pos],
end

/-- The cosine of the angle between two vectors is -1 if and only if the angle is π. -/
lemma cos_eq_neg_one_iff_angle_eq_pi : cos (angle x y) = -1 ↔ angle x y = π :=
begin
  rw ← cos_pi,
  exact inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩ (right_mem_Icc.2 pi_pos.le),
end

/-- The sine of the angle between two vectors is 0 if and only if the angle is 0 or π. -/
lemma sin_eq_zero_iff_angle_eq_zero_or_angle_eq_pi :
  sin (angle x y) = 0 ↔ angle x y = 0 ∨ angle x y = π :=
by rw [sin_eq_zero_iff_cos_eq, cos_eq_one_iff_angle_eq_zero, cos_eq_neg_one_iff_angle_eq_pi]

/-- The sine of the angle between two vectors is 1 if and only if the angle is π / 2. -/
lemma sin_eq_one_iff_angle_eq_pi_div_two : sin (angle x y) = 1 ↔ angle x y = π / 2 :=
begin
  refine ⟨λ h, _, λ h, by rw [h, sin_pi_div_two]⟩,
  rw [←cos_eq_zero_iff_angle_eq_pi_div_two, ←abs_eq_zero, abs_cos_eq_sqrt_one_sub_sin_sq, h],
  simp,
end

end inner_product_geometry


import data.vector .list

variables {α : Type} {k m n : nat}

open tactic

namespace vector

def zero [has_zero α] (m) : vector α m :=
vector.repeat 0 m

instance has_zero [has_zero α] : has_zero (vector α m) := ⟨zero m⟩

lemma zero_succ [has_zero α] {m} :
  (0 : vector α (m+1)) = (0 : α)::(0 : vector α m) := rfl

def neg [has_neg α] (v : vector α m) : vector α m :=
⟨v.val.neg, eq.trans (list.length_neg _) v.property⟩

instance has_neg [has_neg α]: has_neg (vector α m) := ⟨neg⟩

lemma val_neg [has_neg α] (v : vector α k) :
  (-v).val = list.neg v.val := rfl

def add [has_add α] (v w : vector α k) : vector α k :=
⟨ list.add v.val w.val,
  calc (list.add (v.val) (w.val)).length
      = max (list.length (v.val)) (list.length (w.val)) : list.length_add
  ... = v.val.length :
        begin
          apply max_eq_left (le_of_eq _),
          apply eq.trans w.property v.property.symm
        end
  ... = k : v.property ⟩

instance has_add [has_add α] : has_add (vector α k) := ⟨add⟩

lemma val_add [has_add α] (v w : vector α k) :
  (v + w).val = list.add v.val w.val := rfl

lemma add_assoc [add_group α] (a b c : vector α m) :
  a + b + c = a + (b + c) :=
begin apply subtype.eq, simp only [val_add], apply list.add_assoc end

lemma val_zero_equiv_nil [has_zero α] {m} :
  (@zero α _ m).val ≃ [] :=
begin
  intro k, simp only [zero, repeat, list.get_nil],
  cases list.mem_get_or_get_eq_zero k (list.repeat (0 : α) m),
  apply list.eq_of_mem_repeat h, exact h
end

lemma zero_add [add_group α] (a : vector α m) : 0 + a = a :=
begin
  apply subtype.eq, simp only [val_add], apply list.eq_of_equiv,
  { apply list.length_add_eq_length_right
    (zero m).property a.property },
  { apply list.equiv_trans
    (list.add_equiv_add val_zero_equiv_nil list.equiv_refl)
    (list.equiv_of_eq list.nil_add) }
end

lemma add_zero [add_group α] (a : vector α m) : a + 0 = a :=
begin
  apply subtype.eq, simp only [val_add], apply list.eq_of_equiv,
  { apply list.length_add_eq_length_left
    a.property (zero m).property },
  { apply list.equiv_trans
    (list.add_equiv_add list.equiv_refl val_zero_equiv_nil)
    (list.equiv_of_eq list.add_nil) }
end

lemma add_left_neg [add_group α] (a : vector α m) : -a + a = 0 :=
begin
  apply subtype.eq, simp only [val_neg, val_add],
  apply list.eq_of_equiv,
  { rw list.length_add_eq_length_left _ a.property,
    rw list.length_neg,
    apply eq.trans a.property (zero m).property.symm,
    rw list.length_neg, apply a.property },
  { apply list.equiv_trans list.add_left_neg
    (list.equiv_symm val_zero_equiv_nil) }
end

instance add_group [add_group α] : add_group (vector α m) :=
{ add := add,
  add_assoc := add_assoc,
  zero := zero m,
  zero_add := zero_add,
  add_zero := add_zero,
  neg := neg,
  add_left_neg := add_left_neg }

def dot_prod [ring α] (v w : vector α k) : α :=
list.dot_prod v.val w.val

infix `⬝` := dot_prod

--def zero_dot_prod [ring α] (v : vector α k) : 0 ⬝ v = 0 := sorry
--def dot_prod_zero [ring α] (v : vector α k) : v ⬝ 0 = 0 := sorry

def sum [add_monoid α] : ∀ {k}, vector α k → α
| 0     _ := 0
| (k+1) v := v.head + @sum k v.tail

end vector

/- (mk_meta_vector k) returns the expr of a vector of length k,
   where the expr of each entry is a metavariable. -/
meta def mk_meta_vector (αx : expr) : nat → tactic expr
| 0     := to_expr ``(@vector.nil %%αx)
| (k+1) :=
  do x ← mk_meta_var αx,
     vx ← mk_meta_vector k,
     to_expr ``(@vector.cons %%αx %%`(k) %%x %%vx)

/- (vector₂.mk_meta m n) returns the expr of an m × n vector₂,
   where the expr of each entry is a metavariable. -/
meta def mk_meta_vector₂ (αx : expr) : nat → nat → tactic expr
| 0     n := to_expr ``(@vector.nil (vector %%αx %%`(n)))
| (m+1) n :=
  do v₁x ← mk_meta_vector αx n,
     v₂x ← mk_meta_vector₂ m n,
     to_expr ``(@vector.cons (vector %%αx %%`(n)) %%`(m) %%v₁x %%v₂x)

def vector₂ (α : Type) (m n : nat) : Type := vector (vector α n) m


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.intervals.basic
import Mathlib.algebra.ordered_group
import Mathlib.PostPort

universes u u_1 w v

namespace Mathlib

/-!

# Upper / lower bounds

In this file we define:

* `upper_bounds`, `lower_bounds` : the set of upper bounds (resp., lower bounds) of a set;
* `bdd_above s`, `bdd_below s` : the set `s` is bounded above (resp., below), i.e., the set of upper
  (resp., lower) bounds of `s` is nonempty;
* `is_least s a`, `is_greatest s a` : `a` is a least (resp., greatest) element of `s`;
  for a partial order, it is unique if exists;
* `is_lub s a`, `is_glb s a` : `a` is a least upper bound (resp., a greatest lower bound)
  of `s`; for a partial order, it is unique if exists.

We also prove various lemmas about monotonicity, behaviour under `∪`, `∩`, `insert`, and provide
formulas for `∅`, `univ`, and intervals.
-/

/-!
### Definitions
-/

/-- The set of upper bounds of a set. -/
/-- The set of lower bounds of a set. -/
def upper_bounds {α : Type u} [preorder α] (s : set α) : set α :=
  set_of fun (x : α) => ∀ {a : α}, a ∈ s → a ≤ x

def lower_bounds {α : Type u} [preorder α] (s : set α) : set α :=
  set_of fun (x : α) => ∀ {a : α}, a ∈ s → x ≤ a

/-- A set is bounded above if there exists an upper bound. -/
/-- A set is bounded below if there exists a lower bound. -/
def bdd_above {α : Type u} [preorder α] (s : set α) :=
  set.nonempty (upper_bounds s)

def bdd_below {α : Type u} [preorder α] (s : set α) :=
  set.nonempty (lower_bounds s)

/-- `a` is a least element of a set `s`; for a partial order, it is unique if exists. -/
/-- `a` is a greatest element of a set `s`; for a partial order, it is unique if exists -/
def is_least {α : Type u} [preorder α] (s : set α) (a : α) :=
  a ∈ s ∧ a ∈ lower_bounds s

def is_greatest {α : Type u} [preorder α] (s : set α) (a : α) :=
  a ∈ s ∧ a ∈ upper_bounds s

/-- `a` is a least upper bound of a set `s`; for a partial order, it is unique if exists. -/
/-- `a` is a greatest lower bound of a set `s`; for a partial order, it is unique if exists. -/
def is_lub {α : Type u} [preorder α] (s : set α) : α → Prop :=
  is_least (upper_bounds s)

def is_glb {α : Type u} [preorder α] (s : set α) : α → Prop :=
  is_greatest (lower_bounds s)

theorem mem_upper_bounds {α : Type u} [preorder α] {s : set α} {a : α} : a ∈ upper_bounds s ↔ ∀ (x : α), x ∈ s → x ≤ a :=
  iff.rfl

theorem mem_lower_bounds {α : Type u} [preorder α] {s : set α} {a : α} : a ∈ lower_bounds s ↔ ∀ (x : α), x ∈ s → a ≤ x :=
  iff.rfl

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` such that `x`
is not greater than or equal to `y`. This version only assumes `preorder` structure and uses
`¬(y ≤ x)`. A version for linear orders is called `not_bdd_above_iff`. -/
theorem not_bdd_above_iff' {α : Type u} [preorder α] {s : set α} : ¬bdd_above s ↔ ∀ (x : α), ∃ (y : α), ∃ (H : y ∈ s), ¬y ≤ x := sorry

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` such that `x`
is not less than or equal to `y`. This version only assumes `preorder` structure and uses
`¬(x ≤ y)`. A version for linear orders is called `not_bdd_below_iff`. -/
theorem not_bdd_below_iff' {α : Type u} [preorder α] {s : set α} : ¬bdd_below s ↔ ∀ (x : α), ∃ (y : α), ∃ (H : y ∈ s), ¬x ≤ y :=
  not_bdd_above_iff'

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` that is greater
than `x`. A version for preorders is called `not_bdd_above_iff'`. -/
theorem not_bdd_above_iff {α : Type u_1} [linear_order α] {s : set α} : ¬bdd_above s ↔ ∀ (x : α), ∃ (y : α), ∃ (H : y ∈ s), x < y := sorry

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` that is less
than `x`. A version for preorders is called `not_bdd_below_iff'`. -/
theorem not_bdd_below_iff {α : Type u_1} [linear_order α] {s : set α} : ¬bdd_below s ↔ ∀ (x : α), ∃ (y : α), ∃ (H : y ∈ s), y < x :=
  not_bdd_above_iff

/-!
### Monotonicity
-/

theorem upper_bounds_mono_set {α : Type u} [preorder α] {s : set α} {t : set α} (hst : s ⊆ t) : upper_bounds t ⊆ upper_bounds s :=
  fun (b : α) (hb : b ∈ upper_bounds t) (x : α) (h : x ∈ s) => hb (hst h)

theorem lower_bounds_mono_set {α : Type u} [preorder α] {s : set α} {t : set α} (hst : s ⊆ t) : lower_bounds t ⊆ lower_bounds s :=
  fun (b : α) (hb : b ∈ lower_bounds t) (x : α) (h : x ∈ s) => hb (hst h)

theorem upper_bounds_mono_mem {α : Type u} [preorder α] {s : set α} {a : α} {b : α} (hab : a ≤ b) : a ∈ upper_bounds s → b ∈ upper_bounds s :=
  fun (ha : a ∈ upper_bounds s) (x : α) (h : x ∈ s) => le_trans (ha h) hab

theorem lower_bounds_mono_mem {α : Type u} [preorder α] {s : set α} {a : α} {b : α} (hab : a ≤ b) : b ∈ lower_bounds s → a ∈ lower_bounds s :=
  fun (hb : b ∈ lower_bounds s) (x : α) (h : x ∈ s) => le_trans hab (hb h)

theorem upper_bounds_mono {α : Type u} [preorder α] {s : set α} {t : set α} (hst : s ⊆ t) {a : α} {b : α} (hab : a ≤ b) : a ∈ upper_bounds t → b ∈ upper_bounds s :=
  fun (ha : a ∈ upper_bounds t) => upper_bounds_mono_set hst (upper_bounds_mono_mem hab ha)

theorem lower_bounds_mono {α : Type u} [preorder α] {s : set α} {t : set α} (hst : s ⊆ t) {a : α} {b : α} (hab : a ≤ b) : b ∈ lower_bounds t → a ∈ lower_bounds s :=
  fun (hb : b ∈ lower_bounds t) => lower_bounds_mono_set hst (lower_bounds_mono_mem hab hb)

/-- If `s ⊆ t` and `t` is bounded above, then so is `s`. -/
theorem bdd_above.mono {α : Type u} [preorder α] {s : set α} {t : set α} (h : s ⊆ t) : bdd_above t → bdd_above s :=
  set.nonempty.mono (upper_bounds_mono_set h)

/-- If `s ⊆ t` and `t` is bounded below, then so is `s`. -/
theorem bdd_below.mono {α : Type u} [preorder α] {s : set α} {t : set α} (h : s ⊆ t) : bdd_below t → bdd_below s :=
  set.nonempty.mono (lower_bounds_mono_set h)

/-- If `a` is a least upper bound for sets `s` and `p`, then it is a least upper bound for any
set `t`, `s ⊆ t ⊆ p`. -/
theorem is_lub.of_subset_of_superset {α : Type u} [preorder α] {a : α} {s : set α} {t : set α} {p : set α} (hs : is_lub s a) (hp : is_lub p a) (hst : s ⊆ t) (htp : t ⊆ p) : is_lub t a :=
  { left := upper_bounds_mono_set htp (and.left hp),
    right := lower_bounds_mono_set (upper_bounds_mono_set hst) (and.right hs) }

/-- If `a` is a greatest lower bound for sets `s` and `p`, then it is a greater lower bound for any
set `t`, `s ⊆ t ⊆ p`. -/
theorem is_glb.of_subset_of_superset {α : Type u} [preorder α] {a : α} {s : set α} {t : set α} {p : set α} (hs : is_glb s a) (hp : is_glb p a) (hst : s ⊆ t) (htp : t ⊆ p) : is_glb t a :=
  is_lub.of_subset_of_superset hs hp hst htp

theorem is_least.mono {α : Type u} [preorder α] {s : set α} {t : set α} {a : α} {b : α} (ha : is_least s a) (hb : is_least t b) (hst : s ⊆ t) : b ≤ a :=
  and.right hb a (hst (and.left ha))

theorem is_greatest.mono {α : Type u} [preorder α] {s : set α} {t : set α} {a : α} {b : α} (ha : is_greatest s a) (hb : is_greatest t b) (hst : s ⊆ t) : a ≤ b :=
  and.right hb a (hst (and.left ha))

theorem is_lub.mono {α : Type u} [preorder α] {s : set α} {t : set α} {a : α} {b : α} (ha : is_lub s a) (hb : is_lub t b) (hst : s ⊆ t) : a ≤ b :=
  is_least.mono hb ha (upper_bounds_mono_set hst)

theorem is_glb.mono {α : Type u} [preorder α] {s : set α} {t : set α} {a : α} {b : α} (ha : is_glb s a) (hb : is_glb t b) (hst : s ⊆ t) : b ≤ a :=
  is_greatest.mono hb ha (lower_bounds_mono_set hst)

/-!
### Conversions
-/

theorem is_least.is_glb {α : Type u} [preorder α] {s : set α} {a : α} (h : is_least s a) : is_glb s a :=
  { left := and.right h, right := fun (b : α) (hb : b ∈ lower_bounds s) => hb (and.left h) }

theorem is_greatest.is_lub {α : Type u} [preorder α] {s : set α} {a : α} (h : is_greatest s a) : is_lub s a :=
  { left := and.right h, right := fun (b : α) (hb : b ∈ upper_bounds s) => hb (and.left h) }

theorem is_lub.upper_bounds_eq {α : Type u} [preorder α] {s : set α} {a : α} (h : is_lub s a) : upper_bounds s = set.Ici a := sorry

theorem is_glb.lower_bounds_eq {α : Type u} [preorder α] {s : set α} {a : α} (h : is_glb s a) : lower_bounds s = set.Iic a :=
  is_lub.upper_bounds_eq h

theorem is_least.lower_bounds_eq {α : Type u} [preorder α] {s : set α} {a : α} (h : is_least s a) : lower_bounds s = set.Iic a :=
  is_glb.lower_bounds_eq (is_least.is_glb h)

theorem is_greatest.upper_bounds_eq {α : Type u} [preorder α] {s : set α} {a : α} (h : is_greatest s a) : upper_bounds s = set.Ici a :=
  is_lub.upper_bounds_eq (is_greatest.is_lub h)

theorem is_lub_le_iff {α : Type u} [preorder α] {s : set α} {a : α} {b : α} (h : is_lub s a) : a ≤ b ↔ b ∈ upper_bounds s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b ↔ b ∈ upper_bounds s)) (is_lub.upper_bounds_eq h))) (iff.refl (a ≤ b))

theorem le_is_glb_iff {α : Type u} [preorder α] {s : set α} {a : α} {b : α} (h : is_glb s a) : b ≤ a ↔ b ∈ lower_bounds s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b ≤ a ↔ b ∈ lower_bounds s)) (is_glb.lower_bounds_eq h))) (iff.refl (b ≤ a))

/-- If `s` has a least upper bound, then it is bounded above. -/
theorem is_lub.bdd_above {α : Type u} [preorder α] {s : set α} {a : α} (h : is_lub s a) : bdd_above s :=
  Exists.intro a (and.left h)

/-- If `s` has a greatest lower bound, then it is bounded below. -/
theorem is_glb.bdd_below {α : Type u} [preorder α] {s : set α} {a : α} (h : is_glb s a) : bdd_below s :=
  Exists.intro a (and.left h)

/-- If `s` has a greatest element, then it is bounded above. -/
theorem is_greatest.bdd_above {α : Type u} [preorder α] {s : set α} {a : α} (h : is_greatest s a) : bdd_above s :=
  Exists.intro a (and.right h)

/-- If `s` has a least element, then it is bounded below. -/
theorem is_least.bdd_below {α : Type u} [preorder α] {s : set α} {a : α} (h : is_least s a) : bdd_below s :=
  Exists.intro a (and.right h)

theorem is_least.nonempty {α : Type u} [preorder α] {s : set α} {a : α} (h : is_least s a) : set.nonempty s :=
  Exists.intro a (and.left h)

theorem is_greatest.nonempty {α : Type u} [preorder α] {s : set α} {a : α} (h : is_greatest s a) : set.nonempty s :=
  Exists.intro a (and.left h)

/-!
### Union and intersection
-/

@[simp] theorem upper_bounds_union {α : Type u} [preorder α] {s : set α} {t : set α} : upper_bounds (s ∪ t) = upper_bounds s ∩ upper_bounds t := sorry

@[simp] theorem lower_bounds_union {α : Type u} [preorder α] {s : set α} {t : set α} : lower_bounds (s ∪ t) = lower_bounds s ∩ lower_bounds t :=
  upper_bounds_union

theorem union_upper_bounds_subset_upper_bounds_inter {α : Type u} [preorder α] {s : set α} {t : set α} : upper_bounds s ∪ upper_bounds t ⊆ upper_bounds (s ∩ t) :=
  set.union_subset (upper_bounds_mono_set (set.inter_subset_left s t))
    (upper_bounds_mono_set (set.inter_subset_right s t))

theorem union_lower_bounds_subset_lower_bounds_inter {α : Type u} [preorder α] {s : set α} {t : set α} : lower_bounds s ∪ lower_bounds t ⊆ lower_bounds (s ∩ t) :=
  union_upper_bounds_subset_upper_bounds_inter

theorem is_least_union_iff {α : Type u} [preorder α] {a : α} {s : set α} {t : set α} : is_least (s ∪ t) a ↔ is_least s a ∧ a ∈ lower_bounds t ∨ a ∈ lower_bounds s ∧ is_least t a := sorry

theorem is_greatest_union_iff {α : Type u} [preorder α] {s : set α} {t : set α} {a : α} : is_greatest (s ∪ t) a ↔ is_greatest s a ∧ a ∈ upper_bounds t ∨ a ∈ upper_bounds s ∧ is_greatest t a :=
  is_least_union_iff

/-- If `s` is bounded, then so is `s ∩ t` -/
theorem bdd_above.inter_of_left {α : Type u} [preorder α] {s : set α} {t : set α} (h : bdd_above s) : bdd_above (s ∩ t) :=
  bdd_above.mono (set.inter_subset_left s t) h

/-- If `t` is bounded, then so is `s ∩ t` -/
theorem bdd_above.inter_of_right {α : Type u} [preorder α] {s : set α} {t : set α} (h : bdd_above t) : bdd_above (s ∩ t) :=
  bdd_above.mono (set.inter_subset_right s t) h

/-- If `s` is bounded, then so is `s ∩ t` -/
theorem bdd_below.inter_of_left {α : Type u} [preorder α] {s : set α} {t : set α} (h : bdd_below s) : bdd_below (s ∩ t) :=
  bdd_below.mono (set.inter_subset_left s t) h

/-- If `t` is bounded, then so is `s ∩ t` -/
theorem bdd_below.inter_of_right {α : Type u} [preorder α] {s : set α} {t : set α} (h : bdd_below t) : bdd_below (s ∩ t) :=
  bdd_below.mono (set.inter_subset_right s t) h

/-- If `s` and `t` are bounded above sets in a `semilattice_sup`, then so is `s ∪ t`. -/
theorem bdd_above.union {γ : Type w} [semilattice_sup γ] {s : set γ} {t : set γ} : bdd_above s → bdd_above t → bdd_above (s ∪ t) := sorry

/-- The union of two sets is bounded above if and only if each of the sets is. -/
theorem bdd_above_union {γ : Type w} [semilattice_sup γ] {s : set γ} {t : set γ} : bdd_above (s ∪ t) ↔ bdd_above s ∧ bdd_above t := sorry

theorem bdd_below.union {γ : Type w} [semilattice_inf γ] {s : set γ} {t : set γ} : bdd_below s → bdd_below t → bdd_below (s ∪ t) :=
  bdd_above.union

/--The union of two sets is bounded above if and only if each of the sets is.-/
theorem bdd_below_union {γ : Type w} [semilattice_inf γ] {s : set γ} {t : set γ} : bdd_below (s ∪ t) ↔ bdd_below s ∧ bdd_below t :=
  bdd_above_union

/-- If `a` is the least upper bound of `s` and `b` is the least upper bound of `t`,
then `a ⊔ b` is the least upper bound of `s ∪ t`. -/
theorem is_lub.union {γ : Type w} [semilattice_sup γ] {a : γ} {b : γ} {s : set γ} {t : set γ} (hs : is_lub s a) (ht : is_lub t b) : is_lub (s ∪ t) (a ⊔ b) := sorry

/-- If `a` is the greatest lower bound of `s` and `b` is the greatest lower bound of `t`,
then `a ⊓ b` is the greatest lower bound of `s ∪ t`. -/
theorem is_glb.union {γ : Type w} [semilattice_inf γ] {a₁ : γ} {a₂ : γ} {s : set γ} {t : set γ} (hs : is_glb s a₁) (ht : is_glb t a₂) : is_glb (s ∪ t) (a₁ ⊓ a₂) :=
  is_lub.union hs ht

/-- If `a` is the least element of `s` and `b` is the least element of `t`,
then `min a b` is the least element of `s ∪ t`. -/
theorem is_least.union {γ : Type w} [linear_order γ] {a : γ} {b : γ} {s : set γ} {t : set γ} (ha : is_least s a) (hb : is_least t b) : is_least (s ∪ t) (min a b) := sorry

/-- If `a` is the greatest element of `s` and `b` is the greatest element of `t`,
then `max a b` is the greatest element of `s ∪ t`. -/
theorem is_greatest.union {γ : Type w} [linear_order γ] {a : γ} {b : γ} {s : set γ} {t : set γ} (ha : is_greatest s a) (hb : is_greatest t b) : is_greatest (s ∪ t) (max a b) := sorry

/-!
### Specific sets

#### Unbounded intervals
-/

theorem is_least_Ici {α : Type u} [preorder α] {a : α} : is_least (set.Ici a) a :=
  { left := set.left_mem_Ici, right := fun (x : α) => id }

theorem is_greatest_Iic {α : Type u} [preorder α] {a : α} : is_greatest (set.Iic a) a :=
  { left := set.right_mem_Iic, right := fun (x : α) => id }

theorem is_lub_Iic {α : Type u} [preorder α] {a : α} : is_lub (set.Iic a) a :=
  is_greatest.is_lub is_greatest_Iic

theorem is_glb_Ici {α : Type u} [preorder α] {a : α} : is_glb (set.Ici a) a :=
  is_least.is_glb is_least_Ici

theorem upper_bounds_Iic {α : Type u} [preorder α] {a : α} : upper_bounds (set.Iic a) = set.Ici a :=
  is_lub.upper_bounds_eq is_lub_Iic

theorem lower_bounds_Ici {α : Type u} [preorder α] {a : α} : lower_bounds (set.Ici a) = set.Iic a :=
  is_glb.lower_bounds_eq is_glb_Ici

theorem bdd_above_Iic {α : Type u} [preorder α] {a : α} : bdd_above (set.Iic a) :=
  is_lub.bdd_above is_lub_Iic

theorem bdd_below_Ici {α : Type u} [preorder α] {a : α} : bdd_below (set.Ici a) :=
  is_glb.bdd_below is_glb_Ici

theorem bdd_above_Iio {α : Type u} [preorder α] {a : α} : bdd_above (set.Iio a) :=
  Exists.intro a fun (x : α) (hx : x ∈ set.Iio a) => le_of_lt hx

theorem bdd_below_Ioi {α : Type u} [preorder α] {a : α} : bdd_below (set.Ioi a) :=
  Exists.intro a fun (x : α) (hx : x ∈ set.Ioi a) => le_of_lt hx

theorem is_lub_Iio {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} : is_lub (set.Iio a) a :=
  { left := fun (x : γ) (hx : x ∈ set.Iio a) => le_of_lt hx,
    right := fun (y : γ) (hy : y ∈ upper_bounds (set.Iio a)) => le_of_forall_ge_of_dense hy }

theorem is_glb_Ioi {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} : is_glb (set.Ioi a) a :=
  is_lub_Iio

theorem upper_bounds_Iio {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} : upper_bounds (set.Iio a) = set.Ici a :=
  is_lub.upper_bounds_eq is_lub_Iio

theorem lower_bounds_Ioi {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} : lower_bounds (set.Ioi a) = set.Iic a :=
  is_glb.lower_bounds_eq is_glb_Ioi

/-!
#### Singleton
-/

theorem is_greatest_singleton {α : Type u} [preorder α] {a : α} : is_greatest (singleton a) a :=
  { left := set.mem_singleton a, right := fun (x : α) (hx : x ∈ singleton a) => le_of_eq (set.eq_of_mem_singleton hx) }

theorem is_least_singleton {α : Type u} [preorder α] {a : α} : is_least (singleton a) a :=
  is_greatest_singleton

theorem is_lub_singleton {α : Type u} [preorder α] {a : α} : is_lub (singleton a) a :=
  is_greatest.is_lub is_greatest_singleton

theorem is_glb_singleton {α : Type u} [preorder α] {a : α} : is_glb (singleton a) a :=
  is_least.is_glb is_least_singleton

theorem bdd_above_singleton {α : Type u} [preorder α] {a : α} : bdd_above (singleton a) :=
  is_lub.bdd_above is_lub_singleton

theorem bdd_below_singleton {α : Type u} [preorder α] {a : α} : bdd_below (singleton a) :=
  is_glb.bdd_below is_glb_singleton

@[simp] theorem upper_bounds_singleton {α : Type u} [preorder α] {a : α} : upper_bounds (singleton a) = set.Ici a :=
  is_lub.upper_bounds_eq is_lub_singleton

@[simp] theorem lower_bounds_singleton {α : Type u} [preorder α] {a : α} : lower_bounds (singleton a) = set.Iic a :=
  is_glb.lower_bounds_eq is_glb_singleton

/-!
#### Bounded intervals
-/

theorem bdd_above_Icc {α : Type u} [preorder α] {a : α} {b : α} : bdd_above (set.Icc a b) :=
  Exists.intro b fun (_x : α) => and.right

theorem bdd_below_Icc {α : Type u} [preorder α] {a : α} {b : α} : bdd_below (set.Icc a b) :=
  Exists.intro a fun (_x : α) => and.left

theorem bdd_above_Ico {α : Type u} [preorder α] {a : α} {b : α} : bdd_above (set.Ico a b) :=
  bdd_above.mono set.Ico_subset_Icc_self bdd_above_Icc

theorem bdd_below_Ico {α : Type u} [preorder α] {a : α} {b : α} : bdd_below (set.Ico a b) :=
  bdd_below.mono set.Ico_subset_Icc_self bdd_below_Icc

theorem bdd_above_Ioc {α : Type u} [preorder α] {a : α} {b : α} : bdd_above (set.Ioc a b) :=
  bdd_above.mono set.Ioc_subset_Icc_self bdd_above_Icc

theorem bdd_below_Ioc {α : Type u} [preorder α] {a : α} {b : α} : bdd_below (set.Ioc a b) :=
  bdd_below.mono set.Ioc_subset_Icc_self bdd_below_Icc

theorem bdd_above_Ioo {α : Type u} [preorder α] {a : α} {b : α} : bdd_above (set.Ioo a b) :=
  bdd_above.mono set.Ioo_subset_Icc_self bdd_above_Icc

theorem bdd_below_Ioo {α : Type u} [preorder α] {a : α} {b : α} : bdd_below (set.Ioo a b) :=
  bdd_below.mono set.Ioo_subset_Icc_self bdd_below_Icc

theorem is_greatest_Icc {α : Type u} [preorder α] {a : α} {b : α} (h : a ≤ b) : is_greatest (set.Icc a b) b :=
  { left := iff.mpr set.right_mem_Icc h, right := fun (x : α) => and.right }

theorem is_lub_Icc {α : Type u} [preorder α] {a : α} {b : α} (h : a ≤ b) : is_lub (set.Icc a b) b :=
  is_greatest.is_lub (is_greatest_Icc h)

theorem upper_bounds_Icc {α : Type u} [preorder α] {a : α} {b : α} (h : a ≤ b) : upper_bounds (set.Icc a b) = set.Ici b :=
  is_lub.upper_bounds_eq (is_lub_Icc h)

theorem is_least_Icc {α : Type u} [preorder α] {a : α} {b : α} (h : a ≤ b) : is_least (set.Icc a b) a :=
  { left := iff.mpr set.left_mem_Icc h, right := fun (x : α) => and.left }

theorem is_glb_Icc {α : Type u} [preorder α] {a : α} {b : α} (h : a ≤ b) : is_glb (set.Icc a b) a :=
  is_least.is_glb (is_least_Icc h)

theorem lower_bounds_Icc {α : Type u} [preorder α] {a : α} {b : α} (h : a ≤ b) : lower_bounds (set.Icc a b) = set.Iic a :=
  is_glb.lower_bounds_eq (is_glb_Icc h)

theorem is_greatest_Ioc {α : Type u} [preorder α] {a : α} {b : α} (h : a < b) : is_greatest (set.Ioc a b) b :=
  { left := iff.mpr set.right_mem_Ioc h, right := fun (x : α) => and.right }

theorem is_lub_Ioc {α : Type u} [preorder α] {a : α} {b : α} (h : a < b) : is_lub (set.Ioc a b) b :=
  is_greatest.is_lub (is_greatest_Ioc h)

theorem upper_bounds_Ioc {α : Type u} [preorder α] {a : α} {b : α} (h : a < b) : upper_bounds (set.Ioc a b) = set.Ici b :=
  is_lub.upper_bounds_eq (is_lub_Ioc h)

theorem is_least_Ico {α : Type u} [preorder α] {a : α} {b : α} (h : a < b) : is_least (set.Ico a b) a :=
  { left := iff.mpr set.left_mem_Ico h, right := fun (x : α) => and.left }

theorem is_glb_Ico {α : Type u} [preorder α] {a : α} {b : α} (h : a < b) : is_glb (set.Ico a b) a :=
  is_least.is_glb (is_least_Ico h)

theorem lower_bounds_Ico {α : Type u} [preorder α] {a : α} {b : α} (h : a < b) : lower_bounds (set.Ico a b) = set.Iic a :=
  is_glb.lower_bounds_eq (is_glb_Ico h)

theorem is_glb_Ioo {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} {b : γ} (hab : a < b) : is_glb (set.Ioo a b) a := sorry

theorem lower_bounds_Ioo {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} {b : γ} (hab : a < b) : lower_bounds (set.Ioo a b) = set.Iic a :=
  is_glb.lower_bounds_eq (is_glb_Ioo hab)

theorem is_glb_Ioc {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} {b : γ} (hab : a < b) : is_glb (set.Ioc a b) a :=
  is_glb.of_subset_of_superset (is_glb_Ioo hab) (is_glb_Icc (le_of_lt hab)) set.Ioo_subset_Ioc_self
    set.Ioc_subset_Icc_self

theorem lower_bound_Ioc {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} {b : γ} (hab : a < b) : lower_bounds (set.Ioc a b) = set.Iic a :=
  is_glb.lower_bounds_eq (is_glb_Ioc hab)

theorem is_lub_Ioo {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} {b : γ} (hab : a < b) : is_lub (set.Ioo a b) b := sorry

theorem upper_bounds_Ioo {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} {b : γ} (hab : a < b) : upper_bounds (set.Ioo a b) = set.Ici b :=
  is_lub.upper_bounds_eq (is_lub_Ioo hab)

theorem is_lub_Ico {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} {b : γ} (hab : a < b) : is_lub (set.Ico a b) b := sorry

theorem upper_bounds_Ico {γ : Type w} [linear_order γ] [densely_ordered γ] {a : γ} {b : γ} (hab : a < b) : upper_bounds (set.Ico a b) = set.Ici b :=
  is_lub.upper_bounds_eq (is_lub_Ico hab)

theorem bdd_below_iff_subset_Ici {α : Type u} [preorder α] {s : set α} : bdd_below s ↔ ∃ (a : α), s ⊆ set.Ici a :=
  iff.rfl

theorem bdd_above_iff_subset_Iic {α : Type u} [preorder α] {s : set α} : bdd_above s ↔ ∃ (a : α), s ⊆ set.Iic a :=
  iff.rfl

theorem bdd_below_bdd_above_iff_subset_Icc {α : Type u} [preorder α] {s : set α} : bdd_below s ∧ bdd_above s ↔ ∃ (a : α), ∃ (b : α), s ⊆ set.Icc a b := sorry

/-!
### Univ
-/

theorem order_top.upper_bounds_univ {γ : Type w} [order_top γ] : upper_bounds set.univ = singleton ⊤ := sorry

theorem is_greatest_univ {γ : Type w} [order_top γ] : is_greatest set.univ ⊤ := sorry

theorem is_lub_univ {γ : Type w} [order_top γ] : is_lub set.univ ⊤ :=
  is_greatest.is_lub is_greatest_univ

theorem order_bot.lower_bounds_univ {γ : Type w} [order_bot γ] : lower_bounds set.univ = singleton ⊥ :=
  order_top.upper_bounds_univ

theorem is_least_univ {γ : Type w} [order_bot γ] : is_least set.univ ⊥ :=
  is_greatest_univ

theorem is_glb_univ {γ : Type w} [order_bot γ] : is_glb set.univ ⊥ :=
  is_least.is_glb is_least_univ

theorem no_top_order.upper_bounds_univ {α : Type u} [preorder α] [no_top_order α] : upper_bounds set.univ = ∅ := sorry

theorem no_bot_order.lower_bounds_univ {α : Type u} [preorder α] [no_bot_order α] : lower_bounds set.univ = ∅ :=
  no_top_order.upper_bounds_univ

/-!
### Empty set
-/

@[simp] theorem upper_bounds_empty {α : Type u} [preorder α] : upper_bounds ∅ = set.univ := sorry

@[simp] theorem lower_bounds_empty {α : Type u} [preorder α] : lower_bounds ∅ = set.univ :=
  upper_bounds_empty

@[simp] theorem bdd_above_empty {α : Type u} [preorder α] [Nonempty α] : bdd_above ∅ := sorry

@[simp] theorem bdd_below_empty {α : Type u} [preorder α] [Nonempty α] : bdd_below ∅ := sorry

theorem is_glb_empty {γ : Type w} [order_top γ] : is_glb ∅ ⊤ := sorry

theorem is_lub_empty {γ : Type w} [order_bot γ] : is_lub ∅ ⊥ :=
  is_glb_empty

theorem is_lub.nonempty {α : Type u} [preorder α] {s : set α} {a : α} [no_bot_order α] (hs : is_lub s a) : set.nonempty s := sorry

theorem is_glb.nonempty {α : Type u} [preorder α] {s : set α} {a : α} [no_top_order α] (hs : is_glb s a) : set.nonempty s :=
  is_lub.nonempty hs

theorem nonempty_of_not_bdd_above {α : Type u} [preorder α] {s : set α} [ha : Nonempty α] (h : ¬bdd_above s) : set.nonempty s :=
  nonempty.elim ha
    fun (x : α) => Exists.imp (fun (a : α) (ha : ∃ (H : a ∈ s), ¬a ≤ x) => Exists.fst ha) (iff.mp not_bdd_above_iff' h x)

theorem nonempty_of_not_bdd_below {α : Type u} [preorder α] {s : set α} [ha : Nonempty α] (h : ¬bdd_below s) : set.nonempty s :=
  nonempty_of_not_bdd_above h

/-!
### insert
-/

/-- Adding a point to a set preserves its boundedness above. -/
@[simp] theorem bdd_above_insert {γ : Type w} [semilattice_sup γ] (a : γ) {s : set γ} : bdd_above (insert a s) ↔ bdd_above s := sorry

theorem bdd_above.insert {γ : Type w} [semilattice_sup γ] (a : γ) {s : set γ} (hs : bdd_above s) : bdd_above (insert a s) :=
  iff.mpr (bdd_above_insert a) hs

/--Adding a point to a set preserves its boundedness below.-/
@[simp] theorem bdd_below_insert {γ : Type w} [semilattice_inf γ] (a : γ) {s : set γ} : bdd_below (insert a s) ↔ bdd_below s := sorry

theorem bdd_below.insert {γ : Type w} [semilattice_inf γ] (a : γ) {s : set γ} (hs : bdd_below s) : bdd_below (insert a s) :=
  iff.mpr (bdd_below_insert a) hs

theorem is_lub.insert {γ : Type w} [semilattice_sup γ] (a : γ) {b : γ} {s : set γ} (hs : is_lub s b) : is_lub (insert a s) (a ⊔ b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_lub (insert a s) (a ⊔ b))) (set.insert_eq a s))) (is_lub.union is_lub_singleton hs)

theorem is_glb.insert {γ : Type w} [semilattice_inf γ] (a : γ) {b : γ} {s : set γ} (hs : is_glb s b) : is_glb (insert a s) (a ⊓ b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_glb (insert a s) (a ⊓ b))) (set.insert_eq a s))) (is_glb.union is_glb_singleton hs)

theorem is_greatest.insert {γ : Type w} [linear_order γ] (a : γ) {b : γ} {s : set γ} (hs : is_greatest s b) : is_greatest (insert a s) (max a b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_greatest (insert a s) (max a b))) (set.insert_eq a s)))
    (is_greatest.union is_greatest_singleton hs)

theorem is_least.insert {γ : Type w} [linear_order γ] (a : γ) {b : γ} {s : set γ} (hs : is_least s b) : is_least (insert a s) (min a b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_least (insert a s) (min a b))) (set.insert_eq a s)))
    (is_least.union is_least_singleton hs)

@[simp] theorem upper_bounds_insert {α : Type u} [preorder α] (a : α) (s : set α) : upper_bounds (insert a s) = set.Ici a ∩ upper_bounds s := sorry

@[simp] theorem lower_bounds_insert {α : Type u} [preorder α] (a : α) (s : set α) : lower_bounds (insert a s) = set.Iic a ∩ lower_bounds s := sorry

/-- When there is a global maximum, every set is bounded above. -/
@[simp] protected theorem order_top.bdd_above {γ : Type w} [order_top γ] (s : set γ) : bdd_above s :=
  Exists.intro ⊤ fun (a : γ) (ha : a ∈ s) => order_top.le_top a

/-- When there is a global minimum, every set is bounded below. -/
@[simp] protected theorem order_bot.bdd_below {γ : Type w} [order_bot γ] (s : set γ) : bdd_below s :=
  Exists.intro ⊥ fun (a : γ) (ha : a ∈ s) => order_bot.bot_le a

/-!
### Pair
-/

theorem is_lub_pair {γ : Type w} [semilattice_sup γ] {a : γ} {b : γ} : is_lub (insert a (singleton b)) (a ⊔ b) :=
  is_lub.insert a is_lub_singleton

theorem is_glb_pair {γ : Type w} [semilattice_inf γ] {a : γ} {b : γ} : is_glb (insert a (singleton b)) (a ⊓ b) :=
  is_glb.insert a is_glb_singleton

theorem is_least_pair {γ : Type w} [linear_order γ] {a : γ} {b : γ} : is_least (insert a (singleton b)) (min a b) :=
  is_least.insert a is_least_singleton

theorem is_greatest_pair {γ : Type w} [linear_order γ] {a : γ} {b : γ} : is_greatest (insert a (singleton b)) (max a b) :=
  is_greatest.insert a is_greatest_singleton

/-!
### (In)equalities with the least upper bound and the greatest lower bound
-/

theorem lower_bounds_le_upper_bounds {α : Type u} [preorder α] {s : set α} {a : α} {b : α} (ha : a ∈ lower_bounds s) (hb : b ∈ upper_bounds s) : set.nonempty s → a ≤ b :=
  fun (ᾰ : set.nonempty s) =>
    Exists.dcases_on ᾰ fun (ᾰ_w : α) (ᾰ_h : ᾰ_w ∈ s) => idRhs (a ≤ b) (le_trans (ha ᾰ_h) (hb ᾰ_h))

theorem is_glb_le_is_lub {α : Type u} [preorder α] {s : set α} {a : α} {b : α} (ha : is_glb s a) (hb : is_lub s b) (hs : set.nonempty s) : a ≤ b :=
  lower_bounds_le_upper_bounds (and.left ha) (and.left hb) hs

theorem is_lub_lt_iff {α : Type u} [preorder α] {s : set α} {a : α} {b : α} (ha : is_lub s a) : a < b ↔ ∃ (c : α), ∃ (H : c ∈ upper_bounds s), c < b := sorry

theorem lt_is_glb_iff {α : Type u} [preorder α] {s : set α} {a : α} {b : α} (ha : is_glb s a) : b < a ↔ ∃ (c : α), ∃ (H : c ∈ lower_bounds s), b < c :=
  is_lub_lt_iff ha

theorem is_least.unique {α : Type u} [partial_order α] {s : set α} {a : α} {b : α} (Ha : is_least s a) (Hb : is_least s b) : a = b :=
  le_antisymm (and.right Ha b (and.left Hb)) (and.right Hb a (and.left Ha))

theorem is_least.is_least_iff_eq {α : Type u} [partial_order α] {s : set α} {a : α} {b : α} (Ha : is_least s a) : is_least s b ↔ a = b :=
  { mp := is_least.unique Ha, mpr := fun (h : a = b) => h ▸ Ha }

theorem is_greatest.unique {α : Type u} [partial_order α] {s : set α} {a : α} {b : α} (Ha : is_greatest s a) (Hb : is_greatest s b) : a = b :=
  le_antisymm (and.right Hb a (and.left Ha)) (and.right Ha b (and.left Hb))

theorem is_greatest.is_greatest_iff_eq {α : Type u} [partial_order α] {s : set α} {a : α} {b : α} (Ha : is_greatest s a) : is_greatest s b ↔ a = b :=
  { mp := is_greatest.unique Ha, mpr := fun (h : a = b) => h ▸ Ha }

theorem is_lub.unique {α : Type u} [partial_order α] {s : set α} {a : α} {b : α} (Ha : is_lub s a) (Hb : is_lub s b) : a = b :=
  is_least.unique Ha Hb

theorem is_glb.unique {α : Type u} [partial_order α] {s : set α} {a : α} {b : α} (Ha : is_glb s a) (Hb : is_glb s b) : a = b :=
  is_greatest.unique Ha Hb

theorem lt_is_lub_iff {α : Type u} [linear_order α] {s : set α} {a : α} {b : α} (h : is_lub s a) : b < a ↔ ∃ (c : α), ∃ (H : c ∈ s), b < c := sorry

theorem is_glb_lt_iff {α : Type u} [linear_order α] {s : set α} {a : α} {b : α} (h : is_glb s a) : a < b ↔ ∃ (c : α), ∃ (H : c ∈ s), c < b :=
  lt_is_lub_iff h

theorem is_lub.exists_between {α : Type u} [linear_order α] {s : set α} {a : α} {b : α} (h : is_lub s a) (hb : b < a) : ∃ (c : α), ∃ (H : c ∈ s), b < c ∧ c ≤ a := sorry

theorem is_lub.exists_between' {α : Type u} [linear_order α] {s : set α} {a : α} {b : α} (h : is_lub s a) (h' : ¬a ∈ s) (hb : b < a) : ∃ (c : α), ∃ (H : c ∈ s), b < c ∧ c < a := sorry

theorem is_glb.exists_between {α : Type u} [linear_order α] {s : set α} {a : α} {b : α} (h : is_glb s a) (hb : a < b) : ∃ (c : α), ∃ (H : c ∈ s), a ≤ c ∧ c < b := sorry

theorem is_glb.exists_between' {α : Type u} [linear_order α] {s : set α} {a : α} {b : α} (h : is_glb s a) (h' : ¬a ∈ s) (hb : a < b) : ∃ (c : α), ∃ (H : c ∈ s), a < c ∧ c < b := sorry

/-!
### Least upper bound and the greatest lower bound in linear ordered additive commutative groups
-/

theorem is_glb.exists_between_self_add {α : Type u} [linear_ordered_add_comm_group α] {s : set α} {a : α} {ε : α} (h : is_glb s a) (hε : 0 < ε) : ∃ (b : α), ∃ (H : b ∈ s), a ≤ b ∧ b < a + ε :=
  is_glb.exists_between h (lt_add_of_pos_right a hε)

theorem is_glb.exists_between_self_add' {α : Type u} [linear_ordered_add_comm_group α] {s : set α} {a : α} {ε : α} (h : is_glb s a) (h₂ : ¬a ∈ s) (hε : 0 < ε) : ∃ (b : α), ∃ (H : b ∈ s), a < b ∧ b < a + ε :=
  is_glb.exists_between' h h₂ (lt_add_of_pos_right a hε)

theorem is_lub.exists_between_sub_self {α : Type u} [linear_ordered_add_comm_group α] {s : set α} {a : α} {ε : α} (h : is_lub s a) (hε : 0 < ε) : ∃ (b : α), ∃ (H : b ∈ s), a - ε < b ∧ b ≤ a :=
  is_lub.exists_between h (sub_lt_self a hε)

theorem is_lub.exists_between_sub_self' {α : Type u} [linear_ordered_add_comm_group α] {s : set α} {a : α} {ε : α} (h : is_lub s a) (h₂ : ¬a ∈ s) (hε : 0 < ε) : ∃ (b : α), ∃ (H : b ∈ s), a - ε < b ∧ b < a :=
  is_lub.exists_between' h h₂ (sub_lt_self a hε)

/-!
### Images of upper/lower bounds under monotone functions
-/

namespace monotone

theorem mem_upper_bounds_image {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α} (Ha : a ∈ upper_bounds s) : f a ∈ upper_bounds (f '' s) :=
  set.ball_image_of_ball fun (x : α) (H : x ∈ s) => Hf (Ha H)

theorem mem_lower_bounds_image {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α} (Ha : a ∈ lower_bounds s) : f a ∈ lower_bounds (f '' s) :=
  set.ball_image_of_ball fun (x : α) (H : x ∈ s) => Hf (Ha H)

/-- The image under a monotone function of a set which is bounded above is bounded above. -/
theorem map_bdd_above {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {s : set α} (hf : monotone f) : bdd_above s → bdd_above (f '' s) := sorry

/-- The image under a monotone function of a set which is bounded below is bounded below. -/
theorem map_bdd_below {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {s : set α} (hf : monotone f) : bdd_below s → bdd_below (f '' s) := sorry

/-- A monotone map sends a least element of a set to a least element of its image. -/
theorem map_is_least {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α} (Ha : is_least s a) : is_least (f '' s) (f a) :=
  { left := set.mem_image_of_mem f (and.left Ha), right := mem_lower_bounds_image Hf (and.right Ha) }

/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
theorem map_is_greatest {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α} (Ha : is_greatest s a) : is_greatest (f '' s) (f a) :=
  { left := set.mem_image_of_mem f (and.left Ha), right := mem_upper_bounds_image Hf (and.right Ha) }

theorem is_lub_image_le {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α} (Ha : is_lub s a) {b : β} (Hb : is_lub (f '' s) b) : b ≤ f a :=
  and.right Hb (f a) (mem_upper_bounds_image Hf (and.left Ha))

theorem le_is_glb_image {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α} (Ha : is_glb s a) {b : β} (Hb : is_glb (f '' s) b) : f a ≤ b :=
  and.right Hb (f a) (mem_lower_bounds_image Hf (and.left Ha))

end monotone

theorem is_glb.of_image {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y : α}, f x ≤ f y ↔ x ≤ y) {s : set α} {x : α} (hx : is_glb (f '' s) (f x)) : is_glb s x := sorry

theorem is_lub.of_image {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y : α}, f x ≤ f y ↔ x ≤ y) {s : set α} {x : α} (hx : is_lub (f '' s) (f x)) : is_lub s x :=
  is_glb.of_image (fun (x y : order_dual α) => hf) hx


import .lovelib

/-! # LoVe Homework 6: Monads

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (3 points): `map` for Monads

We will define a `map` function for monads and derive its so-called functorial
properties from the three laws.

We use Lean's definition of monads. In combination, `monad` and `is_lawful_monad`
provide the same constants, laws, and syntactic sugar as the `lawful_monad` type
class from the lecture: -/

#check monad
#check is_lawful_monad

/-! 1.1 (1 point). Define `map` on `m`. This function should not be confused
with `mmap` from the lecture's demo.

Hint: The challenge is to find a way to create a value of type `m β`. Follow the
types. Inventory all the arguments and operations available (e.g., `pure`,
`>>=`) with their types and see if you can plug them together like Lego
bricks. -/

def map {m : Type → Type} [monad m] {α β : Type} (f : α → β) (ma : m α) :
  m β := :=
sorry

/-! 1.2 (1 point). Prove the identity law for `map`.

Hint: You will need `bind_pure`. -/

lemma map_id {m : Type → Type} [monad m] [is_lawful_monad m] {α : Type}
    (ma : m α) :
  map id ma = ma :=
sorry

/-! 1.3 (1 point). Prove the composition law for `map`. -/

lemma map_map {m : Type → Type} [monad m] [is_lawful_monad m] {α β γ : Type}
    (f : α → β) (g : β → γ) (ma : m α) :
  map g (map f ma) = map (g ∘ f) ma :=
sorry

/-! ## Question 2 (6 points): Monadic Structure on Lists

`list` can be seen as a monad, similar to `option` but with several possible
outcomes. It is also similar to `set`, but the results are ordered and finite.
The code below sets `list` up as a monad. -/

namespace list

def bind {α β : Type} : list α → (α → list β) → list β
| []        f := []
| (a :: as) f := f a ++ bind as f

def pure {α : Type} (a : α) : list α :=
[a]

lemma pure_eq_singleton {α : Type} (a : α) :
  pure a = [a] :=
by refl

instance : monad list :=
{ pure := @list.pure,
  bind := @list.bind }

/-! 2.1 (2 points). Prove the following properties of `bind` under the list
constructors and the append operation.

Hint: Use `simp [(>>=)]` if you want to unfold the definition of the bind
operator. -/

lemma bind_nil {α β : Type} (f : α → list β) :
  ([] >>= f) = [] :=
sorry

lemma bind_cons {α β : Type} (f : α → list β) (a : α) (as : list α) :
  (list.cons a as >>= f) = f a ++ (as >>= f) :=
sorry

lemma bind_append {α β : Type} (f : α → list β) :
  ∀as as' : list α, ((as ++ as') >>= f) = (as >>= f) ++ (as' >>= f) :=
sorry

/-! 2.2 (3 points). Prove the three laws for `list`.

Hint: The simplifier cannot see through the type class definition of `pure`. You
can use `pure_eq_singleton` to unfold the definition or `show` to state the
lemma statement using `bind` and `[…]`. -/

lemma pure_bind {α β : Type} (a : α) (f : α → list β) :
  (pure a >>= f) = f a :=
sorry

lemma bind_pure {α : Type} :
  ∀as : list α, (as >>= pure) = as :=
sorry

lemma bind_assoc {α β γ : Type} (f : α → list β) (g : β → list γ) :
  ∀as : list α, ((as >>= f) >>= g) = (as >>= (λa, f a >>= g)) :=
sorry

/-! 2.3 (1 point). Prove the following `list`-specific law. -/

lemma bind_pure_comp_eq_map {α β : Type} {f : α → β} :
  ∀as : list α, (as >>= (pure ∘ f)) = list.map f as :=
sorry

end list

end LoVe


import tactic
import data.nat.digits
import logic.basic
import data.list

namespace happynumber

section definitions

-- Perfect digital invariant (a.k.a. happy function)
-- the sum of the pth (p > 0) power of digits of a natural number n in a base b > 1
def happyfunction (p : ℕ) (b : ℕ) : ℕ → ℕ
| n := ((digits b n).map (λ d, d^p)).sum

-- gets the ith iteration of the happy function w/base b, power p on natural number n
def happyfunction' (p : ℕ) (b : ℕ) (n : ℕ) : ℕ → ℕ
| 0 := n
| (i+1) := happyfunction p b (happyfunction' (i))

-- Happy number
-- a number n is b-happy iff the happy function on n w/base b, power 2 eventually equals 1
def happy (b : ℕ) (n : ℕ) : Prop := ∃ (j : ℕ), happyfunction' 2 b n j = 1

-- height of a b-happy number n is the number of iterations of the happy function to reach 1
def happyheight (b n i : ℕ) (H : happyfunction' 2 b n i ≠ 1 ∧ happyfunction' 2 b n i.succ = 1) : ℕ := i.succ

--Sad number
-- a number n is b-sad iff all iterations of the happy function on n w/base b, power 2 are not equal to 1
def sad (b : ℕ) (n : ℕ): Prop := ∀ (j : ℕ), happyfunction' 2 b n j ≠ 1

end definitions

-- one iteration of happy function
@[simp]
lemma happyfunction'_one_eq_happyfunction (p b n : ℕ) : happyfunction' p b n 1 = happyfunction p b n :=
begin
  unfold happyfunction',
end

-- commutative composition but not really bc it's technically the same function
lemma happyfunction'_comm (p b n i : ℕ) : happyfunction p b (happyfunction' p b n i) = happyfunction' p b (happyfunction p b n) i :=
begin
  rw <- happyfunction',
  induction i with k nk,
  unfold happyfunction',
  unfold happyfunction' at *,
  rw nk,
end

-- happy = not sad
lemma happy_not_sad (b n : ℕ) : happy b n ↔ ¬(sad b n) :=
begin
  split,
  intros H S,
  cases H with k Hk,
  specialize S k,
  contradiction,
  intros S,
  unfold sad at S,
  --rw <- not_exists at S,
  simp at S,
  cases S with k Sk,
  use k,
  exact Sk,
end

-- every natural number n is either happy or sad (but not both)
lemma happy_or_sad (b: ℕ) : ∀ (n : ℕ), happy b n ∨ sad b n :=
begin
  intros n,
  rw happy_not_sad,
  finish,
end

-- happy function on 1 equals 1 for any p > 0 and b > 1
lemma happyfunction_one (p : ℕ) (b : ℕ) : (b > 1) → happyfunction p b 1 = 1 :=
begin
  intros h,
  unfold happyfunction,
  have H : digits b 1 = [1],
  apply digits_of_lt,
  linarith,
  exact h,
  rw H,
  simp,
end

-- junk input. b = 0
lemma junk_zero_one (p : ℕ) : happyfunction p 0 1 = 1 :=
begin
  unfold happyfunction,
  have H : digits 0 1 = [1],
  refl,
  rw H,
  simp,
end

-- junk input. b = 1
lemma junk_one_one (p : ℕ) : happyfunction p 1 1 = 1 :=
begin
  unfold happyfunction,
  have H : digits 1 1 = [1],
  refl,
  rw H,
  simp,
end

-- just to not deal with b > 1 hypothesis
@[simp]
lemma happyfunction_one' (p : ℕ) (b : ℕ) : happyfunction p b 1 = 1 :=
begin
  have H : (b = 0) ∨ (1 = b) ∨ (1 < b),
  cases b,
  left,
  refl,
  right,
  have H := nat.succ_pos b,
  have H' : 1 ≤ b.succ,
  linarith,
  rw le_iff_eq_or_lt at H',
  exact H',
  cases H,
  rw H,
  exact junk_zero_one p,
  cases H,
  rw <- H,
  exact junk_one_one p,
  exact happyfunction_one p b H,
end

-- any iteration of the happy function on 1 equals 1
@[simp]
lemma happyfunction'_one (p : ℕ) (b : ℕ) : ∀ (i : ℕ), happyfunction' p b 1 i = 1 :=
begin
  intros i,
  induction i with k ik,
  unfold happyfunction',
  unfold happyfunction',
  rw ik,
  exact happyfunction_one' p b,
end

-- for base 10, after reaching 1, will stay 1
lemma ten_happily_ever_after (n : ℕ) (j: ℕ) : happyfunction' 2 10 n j = 1 → ∀ (i : ℕ), (j ≤ i) → happyfunction' 2 10 n i = 1 :=
begin
  intros H i hi,
  rw le_iff_exists_add at hi,
  cases hi with c hc,
  induction c with k ck generalizing i,
  { simp at hc,
    rw hc,
    exact H,
  },
  { rw nat.add_succ at hc,
    rw hc,
    unfold happyfunction',
    specialize ck (j+k),
    simp at ck,
    rw ck,
    --unfold happyfunction,
    simp,
  },
end

-- for base b, after reaching 1, will stay 1
lemma happily_ever_after (b : ℕ) (n : ℕ) (j: ℕ) : happyfunction' 2 b n j = 1 → ∀ i, (j ≤ i) → happyfunction' 2 b n i = 1 :=
begin
  intros H i hi,
  rw le_iff_exists_add at hi,
  cases hi with c hc,
  induction c with k ck generalizing i,
   { simp at hc,
     rw hc,
     exact H,
  },
  { rw nat.add_succ at hc,
    rw hc,
    unfold happyfunction',
    specialize ck (j+k),
    simp at ck,
    rw ck,
    --exact happyfunction_one' 2 b,
    simp,
  },
end

-- 1 is 10-happy
lemma ten_happy_one : happy 10 1 :=
begin
  use 0,
  unfold happyfunction',
end

-- 7 is 10-happy
lemma ten_happy_seven : happy 10 7 :=
begin
  use 5,
  unfold happyfunction',
  unfold happyfunction,
  norm_num,
end

-- happy function on 0 equals 0
@[simp]
lemma happyfunction_zero  (p : ℕ) (b : ℕ) : happyfunction p b 0 = 0 :=
begin
  unfold happyfunction,
  simp,
end

-- any iteration of the happy function on 0 equals 0
@[simp]
lemma happyfunction'_zero (p : ℕ) (b : ℕ) : ∀ (i : ℕ), happyfunction' p b 0 i = 0 :=
begin
  intros i,
  induction i with k ik,
  unfold happyfunction',
  unfold happyfunction',
  rw ik,
  --unfold happyfunction,
  simp,
end

 -- 0 is 10-sad
lemma ten_sad_zero : sad 10 0 :=
begin
  intros i hi,
  --rw happyfunction'_zero 2 10 i at hi,
  --linarith,
  simp at hi,
  exact hi,
end

-- for b=10, multiplying by 10 (adding a zero) won't make a difference
lemma ten_happyfunction_eq_times_ten (n : ℕ) : happyfunction 2 10 n = happyfunction 2 10 (10*n) :=
begin
  cases n,
  norm_num,
  have H : digits 10 (10*n.succ) = 0 :: digits 10 n.succ,
  have h₁ : 10*n.succ = 0 + 10*n.succ,
  simp,
  rw h₁,
  apply digits_add,
  linarith,
  linarith,
  right,
  exact nat.succ_pos n,
  unfold happyfunction,
  rw H,
  norm_num,
end

lemma ten_happyfunction'_eq_times_ten (n : ℕ) : ∀ (i : ℕ), (0 < i) → happyfunction' 2 10 n i = happyfunction' 2 10 (10*n) i :=
begin
  intros i i_pos,
  cases i,
  exfalso,
  linarith,
  unfold happyfunction',
  rw happyfunction'_comm,
  rw happyfunction'_comm 2 10 (10*n),
  rw ten_happyfunction_eq_times_ten,
end

-- if n is 10-happy, then n*10 is 10-happy
lemma ten_happy_times_ten (n : ℕ) : happy 10 n → happy 10 (10*n) :=
begin
  intros H,
  cases H with j Hj,
  cases j,
  use 1,
  rw happyfunction'_one_eq_happyfunction,
  unfold happyfunction' at Hj,
  rw Hj,
  rw <- ten_happyfunction_eq_times_ten,
  simp,
  use j.succ,
  rw <- ten_happyfunction'_eq_times_ten n j.succ (nat.succ_pos'),
  exact Hj,
end

-- 10^m is always a 10-happy number
lemma ten_happy_pow_ten (m : ℕ) : happy 10 (10^m) :=
begin
  use 1,
  unfold happyfunction',
  induction m with k mk,
  rw nat.pow_zero 10,
  exact happyfunction_one' 2 10,
  rw nat.pow_succ,
  rw mul_comm,
  rw <- ten_happyfunction_eq_times_ten (10^k),
  exact mk,
end

-- for b=10, permuting the digits won't make a difference
lemma ten_happyfunction_eq_permute_digits (p : ℕ) (n n' : ℕ) (P : (digits 10 n) ~ (digits 10 n')) : happyfunction p 10 n = happyfunction p 10 n' :=
begin
  unfold happyfunction,
  have h := list.perm.map (λ (d : ℕ), d^p) P,
  have h' := list.perm.sum_eq h,
  exact h',
end

lemma ten_happyfunction'_eq_permute_digits (p i : ℕ) (n n' : ℕ) (P : (digits 10 n) ~ (digits 10 n')) : happyfunction' p 10 n i = happyfunction' p 10 n' i :=
begin
  sorry
end

-- permuting a 10-happy number's digits will result in another happy number
lemma ten_happy_permute_ten_happy (n : ℕ) (H : happy 10 n) (n' : ℕ) (P : (digits 10 n) ~ (digits 10 n')) : happy 10 n' :=
begin
  sorry
end

-- references "A Set of Eight Numbers" - Arthur Porges
-- https://oeis.org/A003621/a003621.pdf
section mainTheorem

-- the base 10 digits of a number are all at most 9
-- Thanks Kevin Buzzard for digits_lt_base :)
lemma ten_digits_le_9 (n : ℕ) : ∀ (d ∈ (digits 10 n)), d ≤ 9 :=
begin
  intros d H,
  have H' := digits_lt_base (by linarith) H,
  linarith,
end

lemma sum_list_le_len_mul_ge (l : list ℕ) (m : ℕ) : (∀ n ∈ l, n ≤ m) → l.sum ≤ m*l.length :=
begin
  intros h,
  induction l,
  refl,
  rw [list.sum_cons, list.length_cons, mul_add, mul_one, add_comm],
  apply add_le_add,
  apply l_ih,
  intros n in_t_tl,
  specialize h n,
  apply h,
  right,
  exact in_t_tl,
  exact h l_hd (list.mem_cons_self l_hd l_tl),
end

lemma ne_zero_iff_digits_ne_nil (b n : ℕ) : n ≠ 0 ↔ digits b n ≠ list.nil :=
begin
  split,
  { intros hn hd,
    cases n,
    { contradiction },
    { have h := of_digits_digits b n.succ,
      rw hd at h,
      contradiction,
    },
  },
  { contrapose!,
    intros h,
    rw h,
    exact digits_zero b,
  },
end

lemma ne_zero_iff_digits_len_ne_zero (b n : ℕ) : n ≠ 0 ↔ (digits b n).length ≠ 0 :=
begin
  rw [ne_zero_iff_digits_ne_nil b n, not_iff_not],
  symmetry',
  exact list.length_eq_zero,
end

lemma digits_ge_base_pow_len (b m : ℕ) : m ≠ 0 → m ≥ (b + 2) ^ ((digits (b + 2) m).length - 1) :=
begin
  apply nat.strong_induction_on m,
  clear m,
  intros n IH npos,
  unfold digits at IH ⊢,
  cases n,
  { contradiction, },
  { rw [digits_aux_def (b+2) (by linarith) (n.succ), list.length_cons],
    specialize IH ((n.succ)/(b+2)) (nat.div_lt_self' n b),
    cases nat.lt_or_ge n.succ (b+2),
    { rw [nat.div_eq_of_lt h, digits_aux_zero, list.length],
      exact nat.succ_pos n },
    { have geb : (n.succ / (b + 2)) ≥ 1 := nat.div_pos h (by linarith),
      specialize IH (by linarith [geb]),
      rw nat.succ_sub_one,
      have IH' := nat.mul_le_mul_left (b+2) IH,
      rw [nat.mul_comm, <- nat.pow_succ, nat.succ_eq_add_one] at IH',
      rw nat.add_comm ((digits_aux (b + 2) _ (n.succ / (b + 2))).length - 1) at IH',
      rw <- nat.add_sub_assoc at IH',
      { rw nat.add_sub_cancel_left 1 (digits_aux (b + 2) _ (n.succ / (b + 2))).length at IH',
        have IH'' := nat.div_mul_le_self n.succ (b+2),
        rw mul_comm at IH',
        exact le_trans IH' IH'' },
      { change 0 < (digits_aux (b + 2) _ (n.succ / (b + 2))).length,
        rw nat.pos_iff_ne_zero,
        rw [<- digits, <- ne_zero_iff_digits_len_ne_zero],
        linarith [geb] } },
    rwa nat.pos_iff_ne_zero }
end

lemma ten_digits_ge_base_pow_len (n : ℕ) : n ≠ 0 → n ≥ 10 ^ ((digits 10 n).length - 1) :=
begin
  exact digits_ge_base_pow_len 8 n,
end

lemma digits_one_less (b m : ℕ) : m > 0 → (digits (b+2) m).length = (digits (b+2) (m/(b+2))).length + 1 :=
begin
  intros hm,
  unfold digits,
  conv_lhs { rw digits_aux_def (b+2) (by linarith) m hm },
  rw list.length_cons,
end

-- happyfunction n is less than 81*(number of digits in n)
lemma ten_happyfunction_le (n : ℕ) : happyfunction 2 10 n ≤ 81*(digits 10 n).length :=
begin
  unfold happyfunction,
  have hdsq : ∀ dsq ∈ (list.map (λ (d : ℕ), d ^ 2) (digits 10 n)), dsq ≤ 81,
  intros dsq dsqin,
  rw list.mem_map at dsqin,
  cases dsqin with d' hd',
  cases hd' with dh sqh,
  have dle := ten_digits_le_9 n d' dh,
  rw <- sqh,
  exact nat.pow_le_pow_of_le_left dle 2,
  have hle := sum_list_le_len_mul_ge (list.map (λ (d : ℕ), d ^ 2) (digits 10 n)) 81 hdsq,
  rw list.length_map (λ (d : ℕ), d ^ 2) (digits 10 n) at hle,
  exact hle,
end

lemma helper_lt (a : ℕ) : 81*(a + 4) < 10^(a + 3) :=
begin
  induction a with k ak,
  { norm_num },
  { repeat { rw nat.succ_add },
    rw nat.mul_succ,
    rw nat.pow_succ,
    linarith,
  },
end

-- happy function on a 4 or more digit number will result in a smaller number
lemma ge_four_digits_dec (n : ℕ) : 4 ≤ (digits 10 n).length → happyfunction 2 10 n < n :=
begin
  intros hdig,
  have npos : n ≠ 0,
  rw ne_zero_iff_digits_len_ne_zero 10,
  linarith,
  have hge := digits_ge_base_pow_len 8 n npos,
  norm_num at hge,
  have hle := ten_happyfunction_le n,
  set R := (digits 10 n).length with ←h,
  suffices : 81*R < 10^(R-1),
  { linarith },
  rw le_iff_exists_add at hdig,
  cases hdig with c hc,
  rw hc,
  norm_num,
  rw [add_comm 4 c, add_comm 3 c],
  exact helper_lt c,
end

-- happy function on a 4 or more digit number will never increase the number of digits
lemma ge_four_digits_le_digits_len (n : ℕ) : 4 ≤ (digits 10 n).length → (digits 10 (happyfunction 2 10 n)).length ≤ (digits 10 n).length :=
begin
  intros h,
  have dec := ge_four_digits_dec n h,
  exact le_digits_len_le 10 (happyfunction 2 10 n) n (by linarith [dec]),
end

-- eventually, happyfunction on n is less than 4 digits long
lemma eventually_lt_four_digits (n : ℕ) : ∃ (a : ℕ), (digits 10 (happyfunction' 2 10 n a)).length < 4 :=
begin
  sorry
end

-- eventually, happyfunction on n is less than or equal to 162
lemma eventually_le (n : ℕ) : ∃ (a : ℕ), happyfunction' 2 10 n a ≤ 162 :=
begin
  sorry
end

def K : set ℕ := {4, 16, 37, 58, 89, 145, 42, 20}

lemma K_closed_under_happyfunction (n : ℕ) (H : n ∈ K) : happyfunction 2 10 n ∈ K :=
begin
  iterate 7 {
    cases H,
    rw H,
    unfold happyfunction,
    norm_num,
    right,
    simp },
  have H' := set.eq_of_mem_singleton H,
  rw H',
  unfold happyfunction,
  norm_num,
  left,
  refl,
end

lemma K_closed_under_happyfunction' (n : ℕ) (H : n ∈ K) : ∀ (i : ℕ), happyfunction' 2 10 n i ∈ K :=
begin
  intros i,
  induction i with k ik,
  unfold happyfunction',
  exact H,
  unfold happyfunction',
  exact K_closed_under_happyfunction (happyfunction' 2 10 n k) ik,
end

-- 10-Sad numbers > 0 always end in the 8 number cycle {4, 16, 37, 58, 89, 145, 42, 20}
lemma ten_sad_eightnumcycle (n : ℕ) (H : sad 10 n) : ∃ (j : ℕ), ∀ (i : ℕ), (j ≤ i) → (happyfunction' 2 10 n i) ∈ K :=
begin
  sorry
end

theorem ten_happyfunction_convergence (A : ℕ) : ∃ (n > 0),  ∀ (r ≥ n), (happyfunction' 2 10 A r = 1 ∨ happyfunction' 2 10 A r ∈ K) :=
begin
  have H := happy_or_sad 10 A,
  cases H,
  cases H with n Hn,
  use n,
  split,
  sorry
end

end mainTheorem

#print happyfunction
#eval happyfunction 2 10 999

#print happyfunction'
#eval happyfunction' 2 10 7 5

#print happy
#reduce happy 10 7

#print sad
#reduce sad 10 4

end happynumber


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

import linear_algebra.free_module.finite.rank
import linear_algebra.matrix.to_lin

/-!
# Rank of matrices

The rank of a matrix `A` is defined to be the rank of range of the linear map corresponding to `A`.
This definition does not depend on the choice of basis, see `matrix.rank_eq_finrank_range_to_lin`.

## Main declarations

* `matrix.rank`: the rank of a matrix

## TODO

* Show that `matrix.rank` is equal to the row-rank and column-rank
* Generalize away from fields

-/

open_locale matrix

namespace matrix

open finite_dimensional

variables {m n o K : Type*} [m_fin : fintype m] [fintype n] [fintype o]
variables [decidable_eq n] [decidable_eq o] [field K]
variables (A : matrix m n K)

/-- The rank of a matrix is the rank of its image. -/
noncomputable def rank : ℕ := finrank K A.to_lin'.range

@[simp] lemma rank_one : rank (1 : matrix n n K) = fintype.card n :=
by rw [rank, to_lin'_one, linear_map.range_id, finrank_top, module.free.finrank_pi]

@[simp] lemma rank_zero : rank (0 : matrix n n K) = 0 :=
by rw [rank, linear_equiv.map_zero, linear_map.range_zero, finrank_bot]

lemma rank_le_card_width : A.rank ≤ fintype.card n :=
begin
  convert le_of_add_le_left (A.to_lin'.finrank_range_add_finrank_ker).le,
  exact (module.free.finrank_pi K).symm,
end

lemma rank_le_width {m n : ℕ} (A : matrix (fin m) (fin n) K) : A.rank ≤ n :=
A.rank_le_card_width.trans $ (fintype.card_fin n).le

lemma rank_mul_le (B : matrix n o K) : (A ⬝ B).rank ≤ A.rank :=
begin
  refine linear_map.finrank_le_finrank_of_injective (submodule.of_le_injective _),
  rw [to_lin'_mul],
  exact linear_map.range_comp_le_range _ _,
end

lemma rank_unit (A : (matrix n n K)ˣ) :
  (A : matrix n n K).rank = fintype.card n :=
begin
  refine le_antisymm (rank_le_card_width A) _,
  have := rank_mul_le (A : matrix n n K) (↑A⁻¹ : matrix n n K),
  rwa [← mul_eq_mul, ← units.coe_mul, mul_inv_self, units.coe_one, rank_one] at this,
end

lemma rank_of_is_unit (A : matrix n n K) (h : is_unit A) :
  A.rank = fintype.card n :=
by { obtain ⟨A, rfl⟩ := h, exact rank_unit A }

include m_fin

lemma rank_eq_finrank_range_to_lin
  {M₁ M₂ : Type*} [add_comm_group M₁] [add_comm_group M₂]
  [module K M₁] [module K M₂] (v₁ : basis m K M₁) (v₂ : basis n K M₂) :
  A.rank = finrank K (to_lin v₂ v₁ A).range :=
begin
  let e₁ := (pi.basis_fun K m).equiv v₁ (equiv.refl _),
  let e₂ := (pi.basis_fun K n).equiv v₂ (equiv.refl _),
  have range_e₂ : (e₂ : (n → K) →ₗ[K] M₂).range = ⊤,
  { rw linear_map.range_eq_top, exact e₂.surjective },
  refine linear_equiv.finrank_eq (e₁.of_submodules _ _ _),
  rw [← linear_map.range_comp, ← linear_map.range_comp_of_range_eq_top (to_lin v₂ v₁ A) range_e₂],
  congr' 1,
  apply linear_map.pi_ext', rintro i, apply linear_map.ext_ring,
  have aux₁ := to_lin_self (pi.basis_fun K n) (pi.basis_fun K m) A i,
  have aux₂ := basis.equiv_apply (pi.basis_fun K n) i v₂,
  rw [to_lin_eq_to_lin'] at aux₁,
  rw [pi.basis_fun_apply, linear_map.coe_std_basis] at aux₁ aux₂,
  simp only [linear_map.comp_apply, e₁, e₂, linear_equiv.coe_coe, equiv.refl_apply, aux₁, aux₂,
    linear_map.coe_single, to_lin_self, linear_equiv.map_sum, linear_equiv.map_smul,
    basis.equiv_apply],
end

lemma rank_le_card_height : A.rank ≤ fintype.card m :=
(submodule.finrank_le _).trans (module.free.finrank_pi K).le

omit m_fin

lemma rank_le_height {m n : ℕ} (A : matrix (fin m) (fin n) K) : A.rank ≤ m :=
A.rank_le_card_height.trans $ (fintype.card_fin m).le

end matrix


import logic.basic

lemma or_iff_or {p p' q q' : Prop} :
  (p ↔ p') → (q ↔ q') → ((p ∨ q) ↔ (p' ∨ q')) :=
begin
  intros hp hq, rewrite hp, rewrite hq
end

lemma and_iff_and {p p' q q' : Prop} :
  (p ↔ p') → (q ↔ q') → ((p ∧ q) ↔ (p' ∧ q')) :=
begin intros hp hq, rewrite hp, rewrite hq end

lemma iff_of_left_of_right {p q : Prop} :
  p → q → (p ↔ q) :=
begin intros hp hq, constructor; intro h; assumption end

lemma iff_iff_and_or_not_and_not {p q : Prop} :
  (p ↔ q) ↔ ((p ∧ q) ∨ (¬p ∧ ¬q)) :=
begin
  constructor; intro h1,
  { apply @classical.by_cases p; intro h2,
    { left, rw ← h1, constructor; assumption },
    { right, rw ← h1, constructor; assumption } },
  { cases h1; cases h1 with hp hq,
    { constructor; intro _; assumption },
    { constructor; intro _; contradiction } }
end

lemma exists_iff_exists {α : Type} {p q : α → Prop} :
  (∀ a, p a ↔ q a) → ((∃ a, p a) ↔ ∃ a, q a) :=
begin
  intro h, constructor; intro h;
  cases h with a ha; existsi a;
  [{rw (h a).symm}, {rw h}]; assumption
end

lemma forall_iff_not_exists_not {α : Type} {p : α → Prop} :
  (∀ a, p a) ↔ (¬ ∃ a, ¬ p a) :=
begin
  rw [@not_exists_not α p (λ x, _)],
  apply classical.dec
end

lemma forall_iff_forall {α : Type} {p q : α → Prop} :
  (∀ a, p a ↔ q a) → ((∀ a, p a) ↔ ∀ a, q a) :=
begin
  intro h1, constructor; intros h2 a;
  [{rw (h1 a).symm}, {rw h1}]; apply h2
end

lemma not_not_iff {φ : Prop} : ¬¬φ ↔ φ :=
iff.intro (classical.by_contradiction) (not_not_intro)

lemma or_of_not_imp_right {p q} : (¬ q → p) → p ∨ q :=
begin
  intro h, cases (classical.em q) with hq hq,
  apply or.inr hq, apply or.inl (h hq)
end

variable {α : Type}

lemma exists_eq_and_iff {p : α → Prop} {a : α} :
  (∃ x, (x = a ∧ p x)) ↔ p a :=
begin
  constructor; intro h, cases h with a' ha',
  cases ha' with ha1' ha2', subst ha1', assumption,
  existsi a, constructor, refl, assumption
end

lemma exists_and_comm {p q : α → Prop} :
  (∃ x, p x ∧ q x) ↔ (∃ x, q x ∧ p x) :=
begin apply exists_iff_exists, intro a, apply and.comm end

lemma ite.rec {p} [hd : decidable p] {q : α → Prop} {f g : α}
  (hf : p → q f) (hg : ¬ p → q g) : q (@ite p hd α f g) :=
begin
  unfold ite, tactic.unfreeze_local_instances,
  cases hd with h h, simp, apply hg h, simp, apply hf h
end

def as_true' (c : Prop) (h : decidable c) : Prop :=
@ite _ h Prop true false

def of_as_true' {c : Prop} (h₁ : decidable c) (h₂ : as_true' c h₁) : c :=
match h₁, h₂ with
| (is_true h_c),  h₂ := h_c
| (is_false h_c), h₂ := false.elim h₂
end

lemma eq.symm' {a1 a2 : α} :
  a1 = a2 ↔ a2 = a1 :=
iff.intro eq.symm eq.symm

lemma eq_iff_eq_of_eq_of_eq {a1 a2 a3 a4 : α} :
  a1 = a3 → a2 = a4 → (a1 = a2 ↔ a3 = a4) :=
begin intros h1 h2, rw [h1, h2] end

lemma lt_iff_lt_of_eq_of_eq [has_lt α] {a1 a2 a3 a4 : α} :
  a1 = a3 → a2 = a4 → (a1 < a2 ↔ a3 < a4) :=
begin intros h1 h2, rw [h1, h2] end


/-
Give a natural deduction proof of ¬(𝐴∧𝐵) from ¬𝐴∨¬𝐵.
(You do not need to use proof by contradiction.)
-/

open classical

variables (A B : Prop)

example (h: ¬ A ∨ ¬ B) : ¬ (A ∧ B) :=
  show ¬ (A ∧ B), from or.elim(h)(
    assume hnA: ¬ A,
    -- it says you don't *have* to use proof by contradiction,
    -- but it doesn't say you *can't* ...
    by_contradiction(
      assume hnnAB: ¬¬(A ∧ B),
      have hAB: A ∧ B, -- is there an easier way to get A from ¬¬A?
      from by_contradiction(
        assume hnAB: ¬(A ∧ B),
        show false, from hnnAB(hnAB)
      ),
      have hA: A,
      from and.left hAB,
      show false, from hnA(hA)
    )
  ) (
    assume hnB: ¬ B,
    -- this is almost identical to the proof of the first branch
    -- is there a way to consolidate this somehow?
    by_contradiction(
      assume hnnAB: ¬¬(A ∧ B),
      have hAB: A ∧ B,
      from by_contradiction(
        assume hnAB: ¬(A ∧ B),
        show false, from hnnAB(hnAB)
      ),
      have hB: B,
      from and.right hAB,
      show false, from hnB(hB)
    )
  )


/-
Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp
-/
import linear_algebra.matrix.spectrum
import linear_algebra.quadratic_form.basic

/-! # Positive Definite Matrices
This file defines positive (semi)definite matrices and connects the notion to positive definiteness
of quadratic forms.
## Main definition
 * `matrix.pos_def` : a matrix `M : matrix n n 𝕜` is positive definite if it is hermitian and `xᴴMx`
   is greater than zero for all nonzero `x`.
 * `matrix.pos_semidef` : a matrix `M : matrix n n 𝕜` is positive semidefinite if it is hermitian
   and `xᴴMx` is nonnegative for all `x`.
-/

namespace matrix

variables {𝕜 : Type*} [is_R_or_C 𝕜] {m n : Type*} [fintype m] [fintype n]

open_locale matrix

/-- A matrix `M : matrix n n 𝕜` is positive definite if it is hermitian
   and `xᴴMx` is greater than zero for all nonzero `x`. -/
def pos_def (M : matrix n n 𝕜) :=
M.is_hermitian ∧ ∀ x : n → 𝕜, x ≠ 0 → 0 < is_R_or_C.re (dot_product (star x) (M.mul_vec x))

lemma pos_def.is_hermitian {M : matrix n n 𝕜} (hM : M.pos_def) : M.is_hermitian := hM.1

/-- A matrix `M : matrix n n 𝕜` is positive semidefinite if it is hermitian
   and `xᴴMx` is nonnegative for all `x`. -/
def pos_semidef (M : matrix n n 𝕜) :=
M.is_hermitian ∧ ∀ x : n → 𝕜, 0 ≤ is_R_or_C.re (dot_product (star x) (M.mul_vec x))

lemma pos_def.pos_semidef {M : matrix n n 𝕜} (hM : M.pos_def) : M.pos_semidef :=
begin
  refine ⟨hM.1, _⟩,
  intros x,
  by_cases hx : x = 0,
  { simp only [hx, zero_dot_product, star_zero, is_R_or_C.zero_re'] },
  { exact le_of_lt (hM.2 x hx) }
end

@[simp] lemma pos_semidef_submatrix_equiv {M : matrix n n 𝕜} (e : m ≃ n) :
  (M.submatrix e e).pos_semidef ↔ M.pos_semidef :=
⟨λ h, by simpa using h.submatrix e.symm, λ h, h.submatrix _⟩

lemma pos_def.transpose {M : matrix n n 𝕜} (hM : M.pos_def) : Mᵀ.pos_def :=
begin
  refine ⟨is_hermitian.transpose hM.1, λ x hx, _⟩,
  convert hM.2 (star x) (star_ne_zero.2 hx) using 2,
  rw [mul_vec_transpose, matrix.dot_product_mul_vec, star_star, dot_product_comm]
end

lemma pos_def_of_to_quadratic_form' [decidable_eq n] {M : matrix n n ℝ}
  (hM : M.is_symm) (hMq : M.to_quadratic_form'.pos_def) :
  M.pos_def :=
begin
  refine ⟨hM, λ x hx, _⟩,
  simp only [to_quadratic_form', quadratic_form.pos_def, bilin_form.to_quadratic_form_apply,
    matrix.to_bilin'_apply'] at hMq,
  apply hMq x hx,
end

lemma pos_def_to_quadratic_form' [decidable_eq n] {M : matrix n n ℝ} (hM : M.pos_def) :
  M.to_quadratic_form'.pos_def :=
begin
  intros x hx,
  simp only [to_quadratic_form', bilin_form.to_quadratic_form_apply, matrix.to_bilin'_apply'],
  apply hM.2 x hx,
end

namespace pos_def

variables {M : matrix n n ℝ} (hM : M.pos_def)
include hM

lemma det_pos [decidable_eq n] : 0 < det M :=
begin
  rw hM.is_hermitian.det_eq_prod_eigenvalues,
  apply finset.prod_pos,
  intros i _,
  rw hM.is_hermitian.eigenvalues_eq,
  apply hM.2 _ (λ h, _),
  have h_det : (hM.is_hermitian.eigenvector_matrix)ᵀ.det = 0,
    from matrix.det_eq_zero_of_row_eq_zero i (λ j, congr_fun h j),
  simpa only [h_det, not_is_unit_zero] using
    is_unit_det_of_invertible hM.is_hermitian.eigenvector_matrixᵀ,
end

end pos_def

end matrix

namespace quadratic_form

variables {n : Type*} [fintype n]

lemma pos_def_of_to_matrix'
  [decidable_eq n] {Q : quadratic_form ℝ (n → ℝ)} (hQ : Q.to_matrix'.pos_def) :
  Q.pos_def :=
begin
  rw [←to_quadratic_form_associated ℝ Q,
      ←bilin_form.to_matrix'.left_inv ((associated_hom _) Q)],
  apply matrix.pos_def_to_quadratic_form' hQ
end

lemma pos_def_to_matrix' [decidable_eq n] {Q : quadratic_form ℝ (n → ℝ)} (hQ : Q.pos_def) :
  Q.to_matrix'.pos_def :=
begin
  rw [←to_quadratic_form_associated ℝ Q,
    ←bilin_form.to_matrix'.left_inv ((associated_hom _) Q)] at hQ,
  apply matrix.pos_def_of_to_quadratic_form' (is_symm_to_matrix' Q) hQ,
end

end quadratic_form

namespace matrix

variables {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n]

/-- A positive definite matrix `M` induces a norm `‖x‖ = sqrt (re xᴴMx)`. -/
@[reducible]
noncomputable def normed_add_comm_group.of_matrix {M : matrix n n 𝕜} (hM : M.pos_def) :
  normed_add_comm_group (n → 𝕜) :=
@inner_product_space.of_core.to_normed_add_comm_group _ _ _ _ _
{ inner := λ x y, dot_product (star x) (M.mul_vec y),
  conj_symm := λ x y, by
    rw [star_dot_product, star_ring_end_apply, star_star, star_mul_vec,
      dot_product_mul_vec, hM.is_hermitian.eq],
  nonneg_re := λ x,
    begin
      by_cases h : x = 0,
      { simp [h] },
      { exact le_of_lt (hM.2 x h) }
    end,
  definite := λ x hx,
    begin
      by_contra' h,
      simpa [hx, lt_self_iff_false] using hM.2 x h,
    end,
  add_left := by simp only [star_add, add_dot_product, eq_self_iff_true, forall_const],
  smul_left := λ x y r, by rw [← smul_eq_mul, ←smul_dot_product, star_ring_end_apply, ← star_smul] }

/-- A positive definite matrix `M` induces an inner product `⟪x, y⟫ = xᴴMy`. -/
def inner_product_space.of_matrix {M : matrix n n 𝕜} (hM : M.pos_def) :
  @inner_product_space 𝕜 (n → 𝕜) _ (normed_add_comm_group.of_matrix hM) :=
inner_product_space.of_core _

end matrix