/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.monoid.canonical.defs
! leanprover-community/mathlib commit de87d5053a9fe5cbde723172c0fb7e27e7436473
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.BoundedOrder
import Mathlib.Order.MinMax
import Mathlib.Algebra.NeZero
import Mathlib.Algebra.Order.Monoid.Defs

/-!
# Canonically ordered monoids
-/

universe u

variable {α : Type u}

/-- An `OrderCommMonoid` with one-sided 'division' in the sense that
if `a ≤ b`, there is some `c` for which `a * c = b`. This is a weaker version
of the condition on canonical orderings defined by `CanonicallyOrderedMonoid`. -/
class ExistsMulOfLE (α : Type u) [Mul α] [LE α] : Prop where
  /-- For `a ≤ b`, `a` left divides `b` -/
  exists_mul_of_le : ∀ {a b : α}, a ≤ b → ∃ c : α, b = a * c
#align has_exists_mul_of_le ExistsMulOfLE

/-- An `OrderAddCommMonoid` with one-sided 'subtraction' in the sense that
if `a ≤ b`, then there is some `c` for which `a + c = b`. This is a weaker version
of the condition on canonical orderings defined by `CanonicallyOrderedAddMonoid`. -/
class ExistsAddOfLE (α : Type u) [Add α] [LE α] : Prop where
  /-- For `a ≤ b`, there is a `c` so `b = a + c`. -/
  exists_add_of_le : ∀ {a b : α}, a ≤ b → ∃ c : α, b = a + c
#align has_exists_add_of_le ExistsAddOfLE

attribute [to_additive] ExistsMulOfLE

export ExistsMulOfLE (exists_mul_of_le)

export ExistsAddOfLE (exists_add_of_le)

-- See note [lower instance priority]
@[to_additive]
instance (priority := 100) Group.existsMulOfLE (α : Type u) [Group α] [LE α] : ExistsMulOfLE α :=
  ⟨fun {a b} _ => ⟨a⁻¹ * b, (mul_inv_cancel_left _ _).symm⟩⟩
#align group.has_exists_mul_of_le Group.existsMulOfLE
#align add_group.has_exists_add_of_le AddGroup.existsAddOfLE

section MulOneClass

variable [MulOneClass α] [Preorder α] [ContravariantClass α α (· * ·) (· < ·)] [ExistsMulOfLE α]
  {a b : α}

@[to_additive]
theorem exists_one_lt_mul_of_lt' (h : a < b) : ∃ c, 1 < c ∧ a * c = b := by
  obtain ⟨c, rfl⟩ := exists_mul_of_le h.le
  exact ⟨c, one_lt_of_lt_mul_right h, rfl⟩
#align exists_one_lt_mul_of_lt' exists_one_lt_mul_of_lt'
#align exists_pos_add_of_lt' exists_pos_add_of_lt'

end MulOneClass

section ExistsMulOfLE

variable [LinearOrder α] [DenselyOrdered α] [Monoid α] [ExistsMulOfLE α]
  [CovariantClass α α (· * ·) (· < ·)] [ContravariantClass α α (· * ·) (· < ·)] {a b : α}

@[to_additive]
theorem le_of_forall_one_lt_le_mul (h : ∀ ε : α, 1 < ε → a ≤ b * ε) : a ≤ b :=
  le_of_forall_le_of_dense fun x hxb => by
    obtain ⟨ε, rfl⟩ := exists_mul_of_le hxb.le
    exact h _ ((lt_mul_iff_one_lt_right' b).1 hxb)
#align le_of_forall_one_lt_le_mul le_of_forall_one_lt_le_mul
#align le_of_forall_pos_le_add le_of_forall_pos_le_add

@[to_additive]
theorem le_of_forall_one_lt_lt_mul' (h : ∀ ε : α, 1 < ε → a < b * ε) : a ≤ b :=
  le_of_forall_one_lt_le_mul fun ε hε => (h ε hε).le
#align le_of_forall_one_lt_lt_mul' le_of_forall_one_lt_lt_mul'
#align le_of_forall_pos_lt_add' le_of_forall_pos_lt_add'

@[to_additive]
theorem le_iff_forall_one_lt_lt_mul' : a ≤ b ↔ ∀ ε, 1 < ε → a < b * ε :=
  ⟨fun h _ => lt_mul_of_le_of_one_lt h, le_of_forall_one_lt_lt_mul'⟩
#align le_iff_forall_one_lt_lt_mul' le_iff_forall_one_lt_lt_mul'
#align le_iff_forall_pos_lt_add' le_iff_forall_pos_lt_add'

end ExistsMulOfLE

/-- A canonically ordered additive monoid is an ordered commutative additive monoid
  in which the ordering coincides with the subtractibility relation,
  which is to say, `a ≤ b` iff there exists `c` with `b = a + c`.
  This is satisfied by the natural numbers, for example, but not
  the integers or other nontrivial `OrderedAddCommGroup`s. -/
class CanonicallyOrderedAddMonoid (α : Type _) extends OrderedAddCommMonoid α, Bot α where
  /-- `⊥` is the least element -/
  protected bot_le : ∀ x : α, ⊥ ≤ x
  /-- For `a ≤ b`, there is a `c` so `b = a + c`. -/
  protected exists_add_of_le : ∀ {a b : α}, a ≤ b → ∃ c, b = a + c
  /-- For any `a` and `b`, `a ≤ a + b` -/
  protected le_self_add : ∀ a b : α, a ≤ a + b
#align canonically_ordered_add_monoid CanonicallyOrderedAddMonoid

-- see Note [lower instance priority]
instance (priority := 100) CanonicallyOrderedAddMonoid.toOrderBot (α : Type u)
    [h : CanonicallyOrderedAddMonoid α] : OrderBot α :=
  { h with }
#align canonically_ordered_add_monoid.to_order_bot CanonicallyOrderedAddMonoid.toOrderBot

/-- A canonically ordered monoid is an ordered commutative monoid
  in which the ordering coincides with the divisibility relation,
  which is to say, `a ≤ b` iff there exists `c` with `b = a * c`.
  Examples seem rare; it seems more likely that the `OrderDual`
  of a naturally-occurring lattice satisfies this than the lattice
  itself (for example, dual of the lattice of ideals of a PID or
  Dedekind domain satisfy this; collections of all things ≤ 1 seem to
  be more natural that collections of all things ≥ 1).
-/
@[to_additive]
class CanonicallyOrderedMonoid (α : Type _) extends OrderedCommMonoid α, Bot α where
  /-- `⊥` is the least element -/
  protected bot_le : ∀ x : α, ⊥ ≤ x
  /-- For `a ≤ b`, there is a `c` so `b = a * c`. -/
  protected exists_mul_of_le : ∀ {a b : α}, a ≤ b → ∃ c, b = a * c
  /-- For any `a` and `b`, `a ≤ a * b` -/
  protected le_self_mul : ∀ a b : α, a ≤ a * b
#align canonically_ordered_monoid CanonicallyOrderedMonoid

-- see Note [lower instance priority]
@[to_additive existing]
instance (priority := 100) CanonicallyOrderedMonoid.toOrderBot (α : Type u)
    [h : CanonicallyOrderedMonoid α] : OrderBot α :=
  { h with }
#align canonically_ordered_monoid.to_order_bot CanonicallyOrderedMonoid.toOrderBot

-- see Note [lower instance priority]
@[to_additive]
instance (priority := 100) CanonicallyOrderedMonoid.existsMulOfLE (α : Type u)
    [h : CanonicallyOrderedMonoid α] : ExistsMulOfLE α :=
  { h with }
#align canonically_ordered_monoid.has_exists_mul_of_le CanonicallyOrderedMonoid.existsMulOfLE
#align canonically_ordered_add_monoid.has_exists_add_of_le CanonicallyOrderedAddMonoid.existsAddOfLE

section CanonicallyOrderedMonoid

variable [CanonicallyOrderedMonoid α] {a b c d : α}

@[to_additive]
theorem le_self_mul : a ≤ a * c :=
  CanonicallyOrderedMonoid.le_self_mul _ _
#align le_self_mul le_self_mul
#align le_self_add le_self_add

@[to_additive]
theorem le_mul_self : a ≤ b * a := by
  rw [mul_comm]
  exact le_self_mul
#align le_mul_self le_mul_self
#align le_add_self le_add_self

@[to_additive (attr := simp)]
theorem self_le_mul_right (a b : α) : a ≤ a * b :=
  le_self_mul
#align self_le_mul_right self_le_mul_right
#align self_le_add_right self_le_add_right

@[to_additive (attr := simp)]
theorem self_le_mul_left (a b : α) : a ≤ b * a :=
  le_mul_self
#align self_le_mul_left self_le_mul_left
#align self_le_add_left self_le_add_left

@[to_additive]
theorem le_of_mul_le_left : a * b ≤ c → a ≤ c :=
  le_self_mul.trans
#align le_of_mul_le_left le_of_mul_le_left
#align le_of_add_le_left le_of_add_le_left

@[to_additive]
theorem le_of_mul_le_right : a * b ≤ c → b ≤ c :=
  le_mul_self.trans
#align le_of_mul_le_right le_of_mul_le_right
#align le_of_add_le_right le_of_add_le_right

@[to_additive]
theorem le_mul_of_le_left : a ≤ b → a ≤ b * c :=
  le_self_mul.trans'
#align le_mul_of_le_left le_mul_of_le_left
#align le_add_of_le_left le_add_of_le_left

@[to_additive]
theorem le_mul_of_le_right : a ≤ c → a ≤ b * c :=
  le_mul_self.trans'
#align le_mul_of_le_right le_mul_of_le_right
#align le_add_of_le_right le_add_of_le_right

@[to_additive]
theorem le_iff_exists_mul : a ≤ b ↔ ∃ c, b = a * c :=
  ⟨exists_mul_of_le, by
    rintro ⟨c, rfl⟩
    exact le_self_mul⟩
#align le_iff_exists_mul le_iff_exists_mul
#align le_iff_exists_add le_iff_exists_add

@[to_additive]
theorem le_iff_exists_mul' : a ≤ b ↔ ∃ c, b = c * a := by
  simp only [mul_comm _ a, le_iff_exists_mul]
#align le_iff_exists_mul' le_iff_exists_mul'
#align le_iff_exists_add' le_iff_exists_add'

@[to_additive (attr := simp) zero_le]
theorem one_le (a : α) : 1 ≤ a :=
  le_iff_exists_mul.mpr ⟨a, (one_mul _).symm⟩
#align one_le one_le
#align zero_le zero_le

@[to_additive]
theorem bot_eq_one : (⊥ : α) = 1 :=
  le_antisymm bot_le (one_le ⊥)
#align bot_eq_one bot_eq_one
#align bot_eq_zero bot_eq_zero

@[to_additive (attr := simp)]
theorem mul_eq_one_iff : a * b = 1 ↔ a = 1 ∧ b = 1 :=
  mul_eq_one_iff' (one_le _) (one_le _)
#align mul_eq_one_iff mul_eq_one_iff
#align add_eq_zero_iff add_eq_zero_iff

@[to_additive (attr := simp)]
theorem le_one_iff_eq_one : a ≤ 1 ↔ a = 1 :=
  (one_le a).le_iff_eq
#align le_one_iff_eq_one le_one_iff_eq_one
#align nonpos_iff_eq_zero nonpos_iff_eq_zero

@[to_additive]
theorem one_lt_iff_ne_one : 1 < a ↔ a ≠ 1 :=
  (one_le a).lt_iff_ne.trans ne_comm
#align one_lt_iff_ne_one one_lt_iff_ne_one
#align pos_iff_ne_zero pos_iff_ne_zero

@[to_additive]
theorem eq_one_or_one_lt : a = 1 ∨ 1 < a :=
  (one_le a).eq_or_lt.imp_left Eq.symm
#align eq_one_or_one_lt eq_one_or_one_lt
#align eq_zero_or_pos eq_zero_or_pos

@[to_additive (attr := simp) add_pos_iff]
theorem one_lt_mul_iff : 1 < a * b ↔ 1 < a ∨ 1 < b := by
  simp only [one_lt_iff_ne_one, Ne.def, mul_eq_one_iff, not_and_or]
#align one_lt_mul_iff one_lt_mul_iff
#align add_pos_iff add_pos_iff

@[to_additive]
theorem exists_one_lt_mul_of_lt (h : a < b) : ∃ (c : _) (_ : 1 < c), a * c = b := by
  obtain ⟨c, hc⟩ := le_iff_exists_mul.1 h.le
  refine' ⟨c, one_lt_iff_ne_one.2 _, hc.symm⟩
  rintro rfl
  simp [hc, lt_irrefl] at h
#align exists_one_lt_mul_of_lt exists_one_lt_mul_of_lt
#align exists_pos_add_of_lt exists_pos_add_of_lt

@[to_additive]
theorem le_mul_left (h : a ≤ c) : a ≤ b * c :=
  calc
    a = 1 * a := by simp
    _ ≤ b * c := mul_le_mul' (one_le _) h

#align le_mul_left le_mul_left
#align le_add_left le_add_left

@[to_additive]
theorem le_mul_right (h : a ≤ b) : a ≤ b * c :=
  calc
    a = a * 1 := by simp
    _ ≤ b * c := mul_le_mul' h (one_le _)

#align le_mul_right le_mul_right
#align le_add_right le_add_right

@[to_additive]
theorem lt_iff_exists_mul [CovariantClass α α (· * ·) (· < ·)] : a < b ↔ ∃ c > 1, b = a * c := by
  rw [lt_iff_le_and_ne, le_iff_exists_mul, ←exists_and_right]
  apply exists_congr
  intro c
  rw [and_comm, and_congr_left_iff, gt_iff_lt]
  rintro rfl
  constructor
  · rw [one_lt_iff_ne_one]
    apply mt
    rintro rfl
    rw [mul_one]
  · rw [← (self_le_mul_right a c).lt_iff_ne]
    apply lt_mul_of_one_lt_right'

#align lt_iff_exists_mul lt_iff_exists_mul
#align lt_iff_exists_add lt_iff_exists_add

end CanonicallyOrderedMonoid

theorem pos_of_gt {M : Type _} [CanonicallyOrderedAddMonoid M] {n m : M} (h : n < m) : 0 < m :=
  lt_of_le_of_lt (zero_le _) h
#align pos_of_gt pos_of_gt

namespace NeZero

theorem pos {M} (a : M) [CanonicallyOrderedAddMonoid M] [NeZero a] : 0 < a :=
  (zero_le a).lt_of_ne <| NeZero.out.symm
#align ne_zero.pos NeZero.pos

theorem of_gt {M} [CanonicallyOrderedAddMonoid M] {x y : M} (h : x < y) : NeZero y :=
  of_pos <| pos_of_gt h
#align ne_zero.of_gt NeZero.of_gt

-- 1 < p is still an often-used `Fact`, due to `Nat.Prime` implying it, and it implying `Nontrivial`
-- on `ZMod`'s ring structure. We cannot just set this to be any `x < y`, else that becomes a
-- metavariable and it will hugely slow down typeclass inference.
instance (priority := 10) of_gt' [CanonicallyOrderedAddMonoid M] [One M] {y : M} [Fact (1 < y)] :
  -- Porting note: Fact.out has different type signature from mathlib3
  NeZero y := of_gt <| @Fact.out (1 < y) _
#align ne_zero.of_gt' NeZero.of_gt'

set_option linter.deprecated false in
instance bit0 {M} [CanonicallyOrderedAddMonoid M] {x : M} [NeZero x] : NeZero (bit0 x) :=
  of_pos <| bit0_pos <| NeZero.pos x
#align ne_zero.bit0 NeZero.bit0

end NeZero

/-- A canonically linear-ordered additive monoid is a canonically ordered additive monoid
    whose ordering is a linear order. -/
class CanonicallyLinearOrderedAddMonoid (α : Type _)
  extends CanonicallyOrderedAddMonoid α, LinearOrder α
#align canonically_linear_ordered_add_monoid CanonicallyLinearOrderedAddMonoid

/-- A canonically linear-ordered monoid is a canonically ordered monoid
    whose ordering is a linear order. -/
@[to_additive]
class CanonicallyLinearOrderedMonoid (α : Type _) extends CanonicallyOrderedMonoid α, LinearOrder α
#align canonically_linear_ordered_monoid CanonicallyLinearOrderedMonoid

section CanonicallyLinearOrderedMonoid

variable [CanonicallyLinearOrderedMonoid α]

-- see Note [lower instance priority]
@[to_additive]
instance (priority := 100) CanonicallyLinearOrderedMonoid.semilatticeSup : SemilatticeSup α :=
  { LinearOrder.toLattice with }
#align canonically_linear_ordered_monoid.semilattice_sup CanonicallyLinearOrderedMonoid.semilatticeSup
#align canonically_linear_ordered_add_monoid.semilattice_sup CanonicallyLinearOrderedAddMonoid.semilatticeSup

@[to_additive]
theorem min_mul_distrib (a b c : α) : min a (b * c) = min a (min a b * min a c) := by
  cases' le_total a b with hb hb
  · simp [hb, le_mul_right]
  · cases' le_total a c with hc hc
    · simp [hc, le_mul_left]
    · simp [hb, hc]
#align min_mul_distrib min_mul_distrib
#align min_add_distrib min_add_distrib

@[to_additive]
theorem min_mul_distrib' (a b c : α) : min (a * b) c = min (min a c * min b c) c := by
  simpa [min_comm _ c] using min_mul_distrib c a b
#align min_mul_distrib' min_mul_distrib'
#align min_add_distrib' min_add_distrib'

-- Porting note: no longer `@[simp]`, as `simp` can prove this.
@[to_additive]
theorem one_min (a : α) : min 1 a = 1 :=
  min_eq_left (one_le a)
#align one_min one_min
#align zero_min zero_min

-- Porting note: no longer `@[simp]`, as `simp` can prove this.
@[to_additive]
theorem min_one (a : α) : min a 1 = 1 :=
  min_eq_right (one_le a)
#align min_one min_one
#align min_zero min_zero

/-- In a linearly ordered monoid, we are happy for `bot_eq_one` to be a `@[simp]` lemma. -/
@[to_additive (attr := simp)
  "In a linearly ordered monoid, we are happy for `bot_eq_zero` to be a `@[simp]` lemma"]
theorem bot_eq_one' : (⊥ : α) = 1 :=
  bot_eq_one
#align bot_eq_one' bot_eq_one'
#align bot_eq_zero' bot_eq_zero'

end CanonicallyLinearOrderedMonoid


import tactic.norm_num
/-

M1F May exam 2018, question 4.

Solutions by Abhimanyu Pallavi Sudhir,

-/

universe u
local attribute [instance, priority 0] classical.prop_decidable

--QUESTION 4
variable {X : Type u}
variable {Y : Type u}
variable {f : X → Y}

-- Q4(a)(i)
def injectivity (g : X → Y) := ∀ x1 x2 : X, g x1 = g x2 → x1 = x2

-- Q4(a)(ii)
def surjectivity (g : X → Y) := ∀ y : Y, ∃ x : X, g x = y

-- Q4(a)(iii)
def bijectivity (g : X → Y) := injectivity g ∧ surjectivity g

-- Q4(b)(i) example
def f1 : ℕ → ℕ
    | n := n + 2

-- Q4(b)(i) proof
theorem injection : ∃ f : ℕ → ℕ, injectivity f ∧ ¬ surjectivity f :=
    begin
        have injectionf1 : injectivity f1 ∧ ¬ surjectivity f1,
            split,
            --split 1
                rw injectivity,
                change ∀ (x1 x2 : ℕ), x1 + 2 = x2 + 2 → x1 = x2,
                intros x1 x2, intro Hinjsame,
                calc x1 = x1 + 2 - 2 : by rw nat.add_sub_cancel
                    ... = x2 + 2 - 2 : by rw Hinjsame
                    ... = x2 : by rw nat.add_sub_cancel,
            --split 2
                rw surjectivity, intro Hsurj,
                change ∀ (y : ℕ), ∃ (x : ℕ), x + 2 = y at Hsurj,
                have Hsurj1 := Hsurj 1,
                cases Hsurj1 with x Hx10',
                have Hx10 : x + 1 = 0 :=
                    calc x + 1 = x + (2 - 1) : by norm_num
                           ... = (x + 2) - 1 : begin rw ←nat.add_sub_assoc, norm_num end
                           ... = 1 - 1 : by rw Hx10'
                           ... = 0 : by rw nat.sub_self,
                have Hnx10 : x + 1 ≠ 0, exact nat.add_one_ne_zero x,
                apply Hnx10, exact Hx10,
        fapply exists.intro, exact f1, exact injectionf1,
    end

-- Q4(b)(ii) example; note that
def f2 : ℕ → ℕ
    | n := n / 2

-- Q4(b)(ii) proof
theorem surjection : ∃ f : ℕ → ℕ, surjectivity f ∧ ¬ injectivity f := ---ans
    begin
        have surjectionf2 : surjectivity f2 ∧ ¬ injectivity f2,
            split,
            --split 1
                rw surjectivity,
                change ∀ (y : ℕ), ∃ (x : ℕ), x / 2 = y,
                intro y,
                fapply exists.intro, exact 2 * y,
                    calc 2 * y / 2 = (2 * y + 0) / 2 : by rw nat.add_zero
                               ... = (0 + 2 * y) / 2 : by rw nat.add_comm
                               ... = 0 / 2 + y : begin rw nat.add_mul_div_left 0 y, norm_num, end
                               ... = 0 + y : by norm_num
                               ... = y + 0 : by rw nat.add_comm
                               ... = y : by rw nat.add_zero,
            --split 2
                rw injectivity, intro Hinj,
                change ∀ (x1 x2 : ℕ), x1 / 2 = x2 / 2 → x1 = x2 at Hinj,
                have Hinjsame23 := Hinj 2 3,
                have Hn23 : 2 = 3 → false, norm_num,
                apply Hn23, apply Hinjsame23, norm_num,
        fapply exists.intro, exact f2, exact surjectionf2,
    end

-- Q4(b)(iii) proof
theorem bijections_are_injections : (∃ f : ℕ → ℕ, bijectivity f ∧ ¬ injectivity f) → false := ---ans
    begin
        intro Hf,
        cases Hf with f Hff,
        rw bijectivity at Hff,
        cases Hff with Hffis Hfffi, cases Hffis with Hffi Hffs,
        apply Hfffi, exact Hffi,
    end

-- Q4(b)(iv) proof
theorem cantor : ¬ (∃ F : ℕ → set ℕ, bijectivity F) := ---ans
    begin
        intro HE_cantor,
        cases HE_cantor with F HE_cantor_F,
        let Snm : set ℕ := {n : ℕ | ¬ (n ∈ F n)},
        rw bijectivity at HE_cantor_F, cases HE_cantor_F with HE_can_F HE_tor_F, rw surjectivity at HE_tor_F, rw injectivity at HE_can_F,
        have HE_tor_F_S := HE_tor_F Snm,
        cases HE_tor_F_S with x Hx_tor_F_S,
        cases classical.em (x ∈ Snm) with HxS HxnS,
        --case HxS
            have HnxS := HxS,
            change ¬ (x ∈ F x) at HnxS,
            rw Hx_tor_F_S at HnxS,
            apply HnxS, exact HxS,
        --case HxnS
            have HyxS := HxnS,
            change ¬ ¬ (x ∈ F x) at HyxS,
            rw Hx_tor_F_S at HyxS,
            apply HyxS, exact HxnS,
    end

-- Q4(c)
def G (f : X → Y) : set (X × Y) := { g | g.2 = f (g.1) }
def p1 (g : G f) : X := g.1.1

def injectivity' {X' Y' : Type u} (g : X' → Y') := ∀ x1 x2 : X', g x1 = g x2 → x1 = x2
def surjectivity' {X' Y' : Type u} (g : X' → Y') := ∀ y : Y', ∃ x : X', g x = y
def bijectivity' {X' Y' : Type u} (g : X' → Y') := injectivity' g ∧ surjectivity' g

theorem bij_p1 : @bijectivity' (↥(G f)) X (p1) := ---ans
    begin
        split,
            intros x1 x2 Hpx, rw [p1, p1] at Hpx,
            cases x1, cases x2, cases x1_val, cases x2_val,
            change x1_val_snd = f(x1_val_fst) at x1_property,
            change x2_val_snd = f(x2_val_fst) at x2_property,
            simp, simp at Hpx,
            have Hpfx : x1_val_snd = x2_val_snd, rw [x1_property, x2_property, Hpx],
            split, rw Hpx, rw Hpfx,
      --split,
            intro x,
            let xy : (↥(G f)) := ⟨⟨x,f x⟩, rfl⟩,
            existsi xy, refl,
    end

-- Q4(d)
def p2 (g : G f) : Y := g.1.2

theorem bij_p2_f : @bijectivity' (↥(G f)) Y (p2) → bijectivity' f := ---ans
    begin
        intro Hp,
        cases Hp with Hpi Hps, rw injectivity' at Hpi, rw surjectivity' at Hps,
        split,
            intros a b Hfx,
            let afa : (↥(G f)) := ⟨⟨a,f a⟩, rfl⟩,
            let bfb : (↥(G f)) := ⟨⟨b,f b⟩, rfl⟩,
            have Hpab : p2 afa = p2 bfb, rw [p2, p2], simp, exact Hfx,
            have Hpiab := Hpi afa bfb Hpab, simp at Hpiab, cases Hpiab with Hab Hfab,
            exact Hab,
      --split,
            intro y,
            have Hpsy := Hps y, cases Hpsy with xy Hpxy,
            rw p2 at Hpxy, cases xy, cases xy_val, change xy_val_snd = y at Hpxy,
            change xy_val_snd = f xy_val_fst at xy_property,
            existsi xy_val_fst, rw [←xy_property, Hpxy],
    end


/-
Copyright (c) 2022 Yaël Dillies, George Shakan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, George Shakan
-/
import combinatorics.double_counting
import data.finset.pointwise
import data.rat.nnrat

/-!
# The Plünnecke-Ruzsa inequality

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

This file proves Ruzsa's triangle inequality, the Plünnecke-Petridis lemma, and the Plünnecke-Ruzsa
inequality.

## Main declarations

* `finset.card_sub_mul_le_card_sub_mul_card_sub`: Ruzsa's triangle inequality, difference version.
* `finset.card_add_mul_le_card_add_mul_card_add`: Ruzsa's triangle inequality, sum version.
* `finset.pluennecke_petridis`: The Plünnecke-Petridis lemma.
* `finset.card_smul_div_smul_le`: The Plünnecke-Ruzsa inequality.

## References

* [Giorgis Petridis, *The Plünnecke-Ruzsa inequality: an overview*][petridis2014]
* [Terrence Tao, Van Vu, *Additive Combinatorics][tao-vu]
-/

open nat
open_locale nnrat pointwise

namespace finset
variables {α : Type*} [comm_group α] [decidable_eq α] {A B C : finset α}

/-- **Ruzsa's triangle inequality**. Division version. -/
@[to_additive card_sub_mul_le_card_sub_mul_card_sub
"**Ruzsa's triangle inequality**. Subtraction version."]
lemma card_div_mul_le_card_div_mul_card_div (A B C : finset α) :
  (A / C).card * B.card ≤ (A / B).card * (B / C).card :=
begin
  rw [←card_product (A / B), ←mul_one ((finset.product _ _).card)],
  refine card_mul_le_card_mul (λ b ac, ac.1 * ac.2 = b) (λ x hx, _)
    (λ x hx, card_le_one_iff.2 $ λ u v hu hv,
      ((mem_bipartite_below _).1 hu).2.symm.trans ((mem_bipartite_below _).1 hv).2),
  obtain ⟨a, c, ha, hc, rfl⟩ := mem_div.1 hx,
  refine card_le_card_of_inj_on (λ b, (a / b, b / c)) (λ b hb, _) (λ b₁ _ b₂ _ h, _),
  { rw mem_bipartite_above,
    exact ⟨mk_mem_product (div_mem_div ha hb) (div_mem_div hb hc), div_mul_div_cancel' _ _ _⟩ },
  { exact div_right_injective (prod.ext_iff.1 h).1 }
end

/-- **Ruzsa's triangle inequality**. Div-mul-mul version. -/
@[to_additive card_sub_mul_le_card_add_mul_card_add
"**Ruzsa's triangle inequality**. Sub-add-add version."]
lemma card_div_mul_le_card_mul_mul_card_mul (A B C : finset α) :
  (A / C).card * B.card ≤ (A * B).card * (B * C).card :=
begin
  rw [←div_inv_eq_mul, ←card_inv B, ←card_inv (B * C), mul_inv, ←div_eq_mul_inv],
  exact card_div_mul_le_card_div_mul_card_div _ _ _,
end

/-- **Ruzsa's triangle inequality**. Mul-div-div version. -/
@[to_additive card_add_mul_le_card_sub_mul_card_add
"**Ruzsa's triangle inequality**. Add-sub-sub version."]
lemma card_mul_mul_le_card_div_mul_card_mul (A B C : finset α) :
  (A * C).card * B.card ≤ (A / B).card * (B * C).card :=
by { rw [←div_inv_eq_mul, ←div_inv_eq_mul B], exact card_div_mul_le_card_div_mul_card_div _ _ _ }

/-- **Ruzsa's triangle inequality**. Mul-mul-div version. -/
@[to_additive card_add_mul_le_card_add_mul_card_sub
"**Ruzsa's triangle inequality**. Add-add-sub version."]
lemma card_mul_mul_le_card_mul_mul_card_div (A B C : finset α) :
  (A * C).card * B.card ≤ (A * B).card * (B / C).card :=
by { rw [←div_inv_eq_mul, div_eq_mul_inv B], exact card_div_mul_le_card_mul_mul_card_mul _ _ _ }

@[to_additive]

/-! ### Sum triangle inequality -/

-- Auxiliary lemma for Ruzsa's triangle sum inequality, and the Plünnecke-Ruzsa inequality.
@[to_additive]
private lemma mul_aux (hA : A.nonempty) (hAB : A ⊆ B)
  (h : ∀ A' ∈ B.powerset.erase ∅, ((A * C).card : ℚ≥0) / ↑(A.card) ≤ ((A' * C).card) / ↑(A'.card)) :
  ∀ A' ⊆ A, (A * C).card * A'.card ≤ (A' * C).card * A.card :=
begin
  rintro A' hAA',
  obtain rfl | hA' := A'.eq_empty_or_nonempty,
  { simp },
  have hA₀ : (0 : ℚ≥0) < A.card := cast_pos.2 hA.card_pos,
  have hA₀' : (0 : ℚ≥0) < A'.card := cast_pos.2 hA'.card_pos,
  exact_mod_cast (div_le_div_iff hA₀ hA₀').1 (h _ $ mem_erase_of_ne_of_mem hA'.ne_empty $
    mem_powerset.2 $ hAA'.trans hAB),
end

/-- **Ruzsa's triangle inequality**. Multiplication version. -/
@[to_additive card_add_mul_card_le_card_add_mul_card_add
"**Ruzsa's triangle inequality**. Addition version."]
lemma card_mul_mul_card_le_card_mul_mul_card_mul (A B C : finset α) :
  (A * C).card * B.card ≤ (A * B).card * (B * C).card :=
begin
  obtain rfl | hB := B.eq_empty_or_nonempty,
  { simp },
  have hB' : B ∈ B.powerset.erase ∅ := mem_erase_of_ne_of_mem hB.ne_empty (mem_powerset_self _),
  obtain ⟨U, hU, hUA⟩ := exists_min_image (B.powerset.erase ∅) (λ U, (U * A).card/U.card : _ → ℚ≥0)
    ⟨B, hB'⟩,
  rw [mem_erase, mem_powerset, ←nonempty_iff_ne_empty] at hU,
  refine cast_le.1 (_ : (_ : ℚ≥0) ≤ _),
  push_cast,
  refine (le_div_iff $ by exact cast_pos.2 hB.card_pos).1 _,
  rw [mul_div_right_comm, mul_comm _ B],
  refine (cast_le.2 $ card_le_card_mul_left _ hU.1).trans _,
  refine le_trans _ (mul_le_mul (hUA _ hB') (cast_le.2 $ card_le_of_subset $
    mul_subset_mul_right hU.2) (zero_le _) $ zero_le _),
  rw [←mul_div_right_comm, ←mul_assoc],
  refine (le_div_iff $ by exact cast_pos.2 hU.1.card_pos).2 _,
  exact_mod_cast mul_pluennecke_petridis C (mul_aux hU.1 hU.2 hUA),
end

/-- **Ruzsa's triangle inequality**. Add-sub-sub version. -/
lemma card_mul_mul_le_card_div_mul_card_div (A B C : finset α) :
  (A * C).card * B.card ≤ (A / B).card * (B / C).card :=
begin
  rw [div_eq_mul_inv, ←card_inv B, ←card_inv (B / C), inv_div', div_inv_eq_mul],
  exact card_mul_mul_card_le_card_mul_mul_card_mul _ _ _,
end

/-- **Ruzsa's triangle inequality**. Sub-add-sub version. -/
lemma card_div_mul_le_card_mul_mul_card_div (A B C : finset α) :
  (A / C).card * B.card ≤ (A * B).card * (B / C).card :=
by { rw [div_eq_mul_inv, div_eq_mul_inv], exact card_mul_mul_card_le_card_mul_mul_card_mul _ _ _ }

/-- **Ruzsa's triangle inequality**. Sub-sub-add version. -/
lemma card_div_mul_le_card_div_mul_card_mul (A B C : finset α) :
  (A / C).card * B.card ≤ (A / B).card * (B * C).card :=
by { rw [←div_inv_eq_mul, div_eq_mul_inv], exact card_mul_mul_le_card_div_mul_card_div _ _ _ }

lemma card_add_nsmul_le {α : Type*} [add_comm_group α] [decidable_eq α] {A B : finset α}
  (hAB : ∀ A' ⊆ A, (A + B).card * A'.card ≤ (A' + B).card * A.card) (n : ℕ) :
  ((A + n • B).card : ℚ≥0) ≤ ((A + B).card / A.card) ^ n * A.card :=
begin
  obtain rfl | hA := A.eq_empty_or_nonempty,
  { simp },
  induction n with n ih,
  { simp },
  rw [succ_nsmul, ←add_assoc, pow_succ, mul_assoc, ←mul_div_right_comm, le_div_iff, ←cast_mul],
  swap, exact (cast_pos.2 hA.card_pos),
  refine (cast_le.2 $ add_pluennecke_petridis _ hAB).trans _,
  rw cast_mul,
  exact mul_le_mul_of_nonneg_left ih (zero_le _),
end

@[to_additive]
lemma card_mul_pow_le (hAB : ∀ A' ⊆ A, (A * B).card * A'.card ≤ (A' * B).card * A.card) (n : ℕ) :
  ((A * B ^ n).card : ℚ≥0) ≤ ((A * B).card / A.card) ^ n * A.card :=
begin
  obtain rfl | hA := A.eq_empty_or_nonempty,
  { simp },
  induction n with n ih,
  { simp },
  rw [pow_succ, ←mul_assoc, pow_succ, @mul_assoc ℚ≥0, ←mul_div_right_comm, le_div_iff, ←cast_mul],
  swap, exact (cast_pos.2 hA.card_pos),
  refine (cast_le.2 $ mul_pluennecke_petridis _ hAB).trans _,
  rw cast_mul,
  exact mul_le_mul_of_nonneg_left ih (zero_le _),
end

/-- The **Plünnecke-Ruzsa inequality**. Multiplication version. Note that this is genuinely harder
than the division version because we cannot use a double counting argument. -/
@[to_additive "The **Plünnecke-Ruzsa inequality**. Addition version. Note that this is genuinely
harder than the subtraction version because we cannot use a double counting argument."]
lemma card_pow_div_pow_le (hA : A.nonempty) (B : finset α) (m n : ℕ) :
  ((B ^ m / B ^ n).card : ℚ≥0) ≤ ((A * B).card / A.card) ^ (m + n) * A.card :=
begin
  have hA' : A ∈ A.powerset.erase ∅ := mem_erase_of_ne_of_mem hA.ne_empty (mem_powerset_self _),
  obtain ⟨C, hC, hCA⟩ := exists_min_image (A.powerset.erase ∅) (λ C, (C * B).card/C.card : _ → ℚ≥0)
    ⟨A, hA'⟩,
  rw [mem_erase, mem_powerset, ←nonempty_iff_ne_empty] at hC,
  refine (mul_le_mul_right $ cast_pos.2 hC.1.card_pos).1 _,
  norm_cast,
  refine (cast_le.2 $ card_div_mul_le_card_mul_mul_card_mul _ _ _).trans _,
  push_cast,
  rw mul_comm _ C,
  refine (mul_le_mul (card_mul_pow_le (mul_aux hC.1 hC.2 hCA) _)
    (card_mul_pow_le (mul_aux hC.1 hC.2 hCA) _) (zero_le _) $ zero_le _).trans _,
  rw [mul_mul_mul_comm, ←pow_add, ←mul_assoc],
  exact mul_le_mul_of_nonneg_right (mul_le_mul (pow_le_pow_of_le_left (zero_le _) (hCA _ hA') _)
    (cast_le.2 $ card_le_of_subset hC.2) (zero_le _) $ zero_le _) (zero_le _),
end

/-- The **Plünnecke-Ruzsa inequality**. Subtraction version. -/
@[to_additive "The **Plünnecke-Ruzsa inequality**. Subtraction version."]
lemma card_pow_div_pow_le' (hA : A.nonempty) (B : finset α) (m n : ℕ) :
  ((B ^ m / B ^ n).card : ℚ≥0) ≤ ((A / B).card / A.card) ^ (m + n) * A.card :=
begin
  rw [←card_inv, inv_div', ←inv_pow, ←inv_pow, div_eq_mul_inv A],
  exact card_pow_div_pow_le hA _ _ _,
end

/-- Special case of the **Plünnecke-Ruzsa inequality**. Multiplication version. -/
@[to_additive "Special case of the **Plünnecke-Ruzsa inequality**. Addition version."]
lemma card_pow_le (hA : A.nonempty) (B : finset α) (n : ℕ) :
  ((B ^ n).card : ℚ≥0) ≤ ((A * B).card / A.card) ^ n * A.card :=
by simpa only [pow_zero, div_one] using card_pow_div_pow_le hA _ _ 0

/-- Special case of the **Plünnecke-Ruzsa inequality**. Division version. -/
@[to_additive "Special case of the **Plünnecke-Ruzsa inequality**. Subtraction version."]
lemma card_pow_le' (hA : A.nonempty) (B : finset α) (n : ℕ) :
  ((B ^ n).card : ℚ≥0) ≤ ((A / B).card / A.card) ^ n * A.card :=
by simpa only [pow_zero, div_one] using card_pow_div_pow_le' hA _ _ 0

end finset


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

import category_theory.sites.spaces
import topology.sheaves.sheaf
import category_theory.sites.dense_subsite

/-!

# The sheaf condition in terms of sites.

The theory of sheaves on sites is developed independently from sheaves on spaces in
`category_theory/sites`. In this file, we connect the two theories: We show that for a topological
space `X`, a presheaf `F : (opens X)ᵒᵖ ⥤ C` is a sheaf on the site `opens X` if and only if it is
a sheaf on `X` in the usual sense.

Recall that a presheaf `F : (opens X)ᵒᵖ ⥤ C` is called a *sheaf* on the space `X`, if for every
family of opens `U : ι → opens X`, the object `F.obj (op (supr U))` is the limit of some fork
diagram. On the other hand, `F` is called a *sheaf* on the site `opens X`, if for every open set
`U : opens X` and every presieve `R : presieve U`, the object `F.obj (op U)` is the limit of a
very similar fork diagram. In this file, we will construct the two functions `covering_of_presieve`
and `presieve_of_covering`, which translate between the two concepts. We then prove a bunch of
naturality lemmas relating the two fork diagrams to each other.

## Main statements
* `is_sheaf_sites_iff_is_sheaf_spaces`. A presheaf `F : (opens X)ᵒᵖ ⥤ C` is a sheaf on the site
  `opens X` if and only if it is a sheaf on the space `X`.
* `Sheaf_sites_eq_sheaf_spaces`. The type of sheaves on the site `opens X` is *equal* to the type
  of sheaves on the space `X`.

-/

noncomputable theory

universes u v w

namespace Top.presheaf

open category_theory topological_space Top category_theory.limits opposite
open Top.presheaf.sheaf_condition_equalizer_products

variables {C : Type u} [category.{v} C] [has_products C]
variables {X : Top.{v}} (F : presheaf C X)

/--
Given a presieve `R` on `U`, we obtain a covering family of open sets in `X`, by taking as index
type the type of dependent pairs `(V, f)`, where `f : V ⟶ U` is in `R`.
-/
def covering_of_presieve (U : opens X) (R : presieve U) : (Σ V, {f : V ⟶ U // R f}) → opens X :=
λ f, f.1

@[simp]
lemma covering_of_presieve_apply (U : opens X) (R : presieve U) (f : Σ V, {f : V ⟶ U // R f}) :
  covering_of_presieve U R f = f.1 := rfl

namespace covering_of_presieve

variables (U : opens X) (R : presieve U)

/-!
In this section, we will relate two different fork diagrams to each other.

The first one is the defining fork diagram for the sheaf condition in terms of sites, applied to
the presieve `R`. It will henceforth be called the _sites diagram_. Its objects are called
`presheaf.first_obj` and `presheaf.second_obj` and its morphisms are `presheaf.first_map` and
`presheaf.second_obj`. The fork map into this diagram is called `presheaf.fork_map`.

The second one is the defining fork diagram for the sheaf condition in terms of spaces, applied to
the family of opens `covering_of_presieve U R`. It will henceforth be called the _spaces diagram_.
Its objects are called `pi_opens` and `pi_inters` and its morphisms are `left_res` and `right_res`.
The fork map into this diagram is called `res`.

-/

/--
If `R` is a presieve in the grothendieck topology on `opens X`, the covering family associated to
`R` really is _covering_, i.e. the union of all open sets equals `U`.
-/
lemma supr_eq_of_mem_grothendieck (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
  supr (covering_of_presieve U R) = U :=
begin
  apply le_antisymm,
  { refine supr_le _,
    intro f,
    exact f.2.1.le, },
  intros x hxU,
  rw [opens.mem_coe, opens.mem_supr],
  obtain ⟨V, iVU, ⟨W, iVW, iWU, hiWU, -⟩, hxV⟩ := hR x hxU,
  exact ⟨⟨W, ⟨iWU, hiWU⟩⟩, iVW.le hxV⟩,
end

/--
The first object in the sites diagram is isomorphic to the first object in the spaces diagram.
Actually, they are even definitionally equal, but it is convenient to give this isomorphism a name.
-/
def first_obj_iso_pi_opens : presheaf.first_obj R F ≅ pi_opens F (covering_of_presieve U R) :=
eq_to_iso rfl

/--
The isomorphism `first_obj_iso_pi_opens` is compatible with canonical projections out of the
product.
-/
lemma first_obj_iso_pi_opens_π (f : Σ V, {f : V ⟶ U // R f}) :
  (first_obj_iso_pi_opens F U R).hom ≫ pi.π _ f = pi.π _ f :=
category.id_comp _

/--
The second object in the sites diagram is isomorphic to the second object in the spaces diagram.
-/
def second_obj_iso_pi_inters :
  presheaf.second_obj R F ≅ pi_inters F (covering_of_presieve U R) :=
has_limit.iso_of_nat_iso $ discrete.nat_iso $ λ i,
  F.map_iso (eq_to_iso (complete_lattice.pullback_eq_inf _ _).symm).op

/--
The isomorphism `second_obj_iso_pi_inters` is compatible with canonical projections out of the
product. Here, we have to insert an `eq_to_hom` arrow to pass from
`F.obj (op (pullback f.2.1 g.2.1))` to `F.obj (op (f.1 ⊓ g.1))`.
-/
lemma second_obj_iso_pi_inters_π (f g : Σ V, {f : V ⟶ U // R f}) :
  (second_obj_iso_pi_inters F U R).hom ≫ pi.π _ (f, g) =
  pi.π _ (f, g) ≫ F.map (eq_to_hom (complete_lattice.pullback_eq_inf f.2.1 g.2.1).symm).op :=
begin
  dunfold second_obj_iso_pi_inters,
  rw has_limit.iso_of_nat_iso_hom_π,
  refl,
end

/--
Composing the fork map of the sites diagram with the isomorphism `first_obj_iso_pi_opens` is the
same as the fork map of the spaces diagram (modulo an `eq_to_hom` arrow).
-/
lemma fork_map_comp_first_obj_iso_pi_opens_eq
  (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
  presheaf.fork_map R F ≫ (first_obj_iso_pi_opens F U R).hom =
  F.map (eq_to_hom (supr_eq_of_mem_grothendieck U R hR)).op ≫ res F (covering_of_presieve U R) :=
begin
  ext f,
  rw [category.assoc, category.assoc],
  rw first_obj_iso_pi_opens_π,
  dunfold presheaf.fork_map res,
  rw [limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app, ← F.map_comp],
  congr,
end

/--
First naturality condition. Under the isomorphisms `first_obj_iso_pi_opens` and
`second_obj_iso_pi_inters`, the map `presheaf.first_map` corresponds to `left_res`.
-/
lemma first_obj_iso_comp_left_res_eq :
  presheaf.first_map R F ≫ (second_obj_iso_pi_inters F U R).hom =
  (first_obj_iso_pi_opens F U R).hom ≫ left_res F (covering_of_presieve U R) :=
begin
  ext ⟨f, g⟩,
  rw [category.assoc, category.assoc, second_obj_iso_pi_inters_π],
  dunfold left_res presheaf.first_map,
  rw [limit.lift_π, fan.mk_π_app, limit.lift_π_assoc, fan.mk_π_app, ← category.assoc],
  erw [first_obj_iso_pi_opens_π, category.assoc, ← F.map_comp],
  refl,
end

/--
Second naturality condition. Under the isomorphisms `first_obj_iso_pi_opens` and
`second_obj_iso_pi_inters`, the map `presheaf.second_map` corresponds to `right_res`.
-/
lemma first_obj_iso_comp_right_res_eq :
  presheaf.second_map R F ≫ (second_obj_iso_pi_inters F U R).hom =
  (first_obj_iso_pi_opens F U R).hom ≫ right_res F (covering_of_presieve U R) :=
begin
  ext ⟨f, g⟩,
  dunfold right_res presheaf.second_map,
  rw [category.assoc, category.assoc, second_obj_iso_pi_inters_π, limit.lift_π, fan.mk_π_app,
    limit.lift_π_assoc, fan.mk_π_app, ← category.assoc, first_obj_iso_pi_opens_π, category.assoc,
    ← F.map_comp],
  refl,
end

/-- The natural isomorphism between the sites diagram and the spaces diagram. -/
@[simps]
def diagram_nat_iso : parallel_pair (presheaf.first_map R F) (presheaf.second_map R F) ≅
  diagram F (covering_of_presieve U R) :=
nat_iso.of_components
  (λ i, walking_parallel_pair.cases_on i
    (first_obj_iso_pi_opens F U R)
    (second_obj_iso_pi_inters F U R)) $
begin
  intros i j f,
  cases i,
  { cases j,
    { cases f, simp },
    { cases f,
      { exact first_obj_iso_comp_left_res_eq F U R, },
      { exact first_obj_iso_comp_right_res_eq F U R, } } },
  { cases j,
    { cases f, },
    { cases f, simp } },
end

/--
Postcomposing the given fork of the _sites_ diagram with the natural isomorphism between the
diagrams gives us a fork of the _spaces_ diagram. We construct a morphism from this fork to the
given fork of the _spaces_ diagram. This is shown to be an isomorphism below.
-/
@[simps]
def postcompose_diagram_fork_hom (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
  (cones.postcompose (diagram_nat_iso F U R).hom).obj (fork.of_ι _ (presheaf.w R F)) ⟶
  fork F (covering_of_presieve U R) :=
fork.mk_hom (F.map (eq_to_hom (supr_eq_of_mem_grothendieck U R hR)).op)
  (fork_map_comp_first_obj_iso_pi_opens_eq F U R hR).symm

instance is_iso_postcompose_diagram_fork_hom_hom
  (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
  is_iso (postcompose_diagram_fork_hom F U R hR).hom :=
begin rw postcompose_diagram_fork_hom_hom, apply eq_to_hom.is_iso, end

instance is_iso_postcompose_diagram_fork_hom
  (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
  is_iso (postcompose_diagram_fork_hom F U R hR) :=
cones.cone_iso_of_hom_iso _

/-- See `postcompose_diagram_fork_hom`. -/
def postcompose_diagram_fork_iso (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
  (cones.postcompose (diagram_nat_iso F U R).hom).obj (fork.of_ι _ (presheaf.w R F)) ≅
  fork F (covering_of_presieve U R) :=
as_iso (postcompose_diagram_fork_hom F U R hR)

end covering_of_presieve

lemma is_sheaf_sites_of_is_sheaf_spaces (Fsh : F.is_sheaf) :
  presheaf.is_sheaf (opens.grothendieck_topology X) F :=
begin
  rw presheaf.is_sheaf_iff_is_sheaf',
  intros U R hR,
  refine ⟨_⟩,
  apply (is_limit.of_cone_equiv (cones.postcompose_equivalence
    (covering_of_presieve.diagram_nat_iso F U R : _))).to_fun,
  apply (is_limit.equiv_iso_limit
    (covering_of_presieve.postcompose_diagram_fork_iso F U R hR)).inv_fun,
  exact (Fsh (covering_of_presieve U R)).some,
end

/--
Given a family of opens `U : ι → opens X`, we obtain a presieve on `supr U` by declaring that a
morphism `f : V ⟶ supr U` is a member of the presieve if and only if there exists an index `i : ι`
such that `V = U i`.
-/
def presieve_of_covering {ι : Type v} (U : ι → opens X) : presieve (supr U) :=
λ V f, ∃ i, V = U i

namespace presieve_of_covering

/-!
In this section, we will relate two different fork diagrams to each other.

The first one is the defining fork diagram for the sheaf condition in terms of spaces, applied to
the family of opens `U`. It will henceforth be called the _spaces diagram_. Its objects are called
`pi_opens` and `pi_inters` and its morphisms are `left_res` and `right_res`. The fork map into this
diagram is called `res`.

The second one is the defining fork diagram for the sheaf condition in terms of sites, applied to
the presieve `presieve_of_covering U`. It will henceforth be called the _sites diagram_. Its objects
are called `presheaf.first_obj` and `presheaf.second_obj` and its morphisms are `presheaf.first_map`
and `presheaf.second_obj`. The fork map into this diagram is called `presheaf.fork_map`.

-/

variables {ι : Type v} (U : ι → opens X)

/--
The sieve generated by `presieve_of_covering U` is a member of the grothendieck topology.
-/
lemma mem_grothendieck_topology :
  sieve.generate (presieve_of_covering U) ∈ opens.grothendieck_topology X (supr U) :=
begin
  intros x hx,
  obtain ⟨i, hxi⟩ := opens.mem_supr.mp hx,
  exact ⟨U i, opens.le_supr U i, ⟨U i, 𝟙 _, opens.le_supr U i, ⟨i, rfl⟩, category.id_comp _⟩, hxi⟩,
end

/--
An index `i : ι` can be turned into a dependent pair `(V, f)`, where `V` is an open set and
`f : V ⟶ supr U` is a member of `presieve_of_covering U f`.
-/
def hom_of_index (i : ι) : Σ V, {f : V ⟶ supr U // presieve_of_covering U f} :=
⟨U i, opens.le_supr U i, i, rfl⟩

/--
By using the axiom of choice, a dependent pair `(V, f)` where `f : V ⟶ supr U` is a member of
`presieve_of_covering U f` can be turned into an index `i : ι`, such that `V = U i`.
-/
def index_of_hom (f : Σ V, {f : V ⟶ supr U // presieve_of_covering U f}) : ι := f.2.2.some

lemma index_of_hom_spec (f : Σ V, {f : V ⟶ supr U // presieve_of_covering U f}) :
  f.1 = U (index_of_hom U f) := f.2.2.some_spec

/--
The canonical morphism from the first object in the sites diagram to the first object in the
spaces diagram. Note that this is *not* an isomorphism, as the product `pi_opens F U` may contain
duplicate factors, i.e. `U : ι → opens X` may not be injective.
-/
def first_obj_to_pi_opens : presheaf.first_obj (presieve_of_covering U) F ⟶ pi_opens F U :=
pi.lift (λ i, pi.π _ (hom_of_index U i))

/--
The canonical morphism from the first object in the spaces diagram to the first object in the
sites diagram. Note that this is *not* an isomorphism, as the product `pi_opens F U` may contain
duplicate factors, i.e. `U : ι → opens X` may not be injective.
-/
def pi_opens_to_first_obj : pi_opens F U ⟶
  presheaf.first_obj.{v v u} (presieve_of_covering U) F :=
pi.lift (λ f, pi.π _ (index_of_hom U f) ≫ F.map (eq_to_hom (index_of_hom_spec U f)).op)

/--
Even though `first_obj_to_pi_opens` and `pi_opens_to_first_obj` are not inverse to each other,
applying them both after a fork map `s.ι` does nothing. The intuition here is that a compatible
family `s : Π i : ι, F.obj (op (U i))` does not care about duplicate open sets:
If `U i = U j` the compatible family coincides on the intersection `U i ⊓ U j = U i = U j`,
hence `s i = s j` (module an `eq_to_hom` arrow).
-/
lemma fork_ι_comp_pi_opens_to_first_obj_to_pi_opens_eq
  (s : limits.fork (left_res F U) (right_res F U)) :
  s.ι ≫ pi_opens_to_first_obj F U ≫ first_obj_to_pi_opens F U = s.ι :=
begin
  ext j,
  dunfold first_obj_to_pi_opens pi_opens_to_first_obj,
  rw [category.assoc, category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app],
  -- The issue here is that `index_of_hom U (hom_of_index U j)` need not be equal to `j`.
  -- But `U j = U (index_of_hom U (hom_of_index U j))` and hence we obtain the following
  -- `eq_to_hom` arrow:
  have i_eq : U j ⟶ U j ⊓ U (index_of_hom U (hom_of_index U j)),
  { apply eq_to_hom, rw ← index_of_hom_spec U, exact inf_idem.symm, },
  -- Since `s` is a fork, we know that `s.ι ≫ left_res F U = s.ι ≫ right_res F U`.
  -- We compose both sides of this equality with the canonical projection at the index pair
  -- `(j, index_of_hom U (hom_of_index U j)` and the restriction along `i_eq`.
  have := congr_arg (λ f, f ≫
    pi.π (λ p : ι × ι, F.obj (op (U p.1 ⊓ U p.2))) (j, index_of_hom U (hom_of_index U j)) ≫
    F.map i_eq.op) s.condition,
  dsimp at this,
  rw [category.assoc, category.assoc] at this,
  symmetry,
  -- We claim that this is equality is our goal
  convert this using 2,
  { dunfold left_res,
    rw [limit.lift_π_assoc, fan.mk_π_app, category.assoc, ← F.map_comp],
    erw F.map_id,
    rw category.comp_id },
  { dunfold right_res,
    rw [limit.lift_π_assoc, fan.mk_π_app, category.assoc, ← F.map_comp],
    congr, }
end

/--
The canonical morphism from the second object of the spaces diagram to the second object of the
sites diagram.
-/
def pi_inters_to_second_obj : pi_inters F U ⟶
  presheaf.second_obj.{v v u} (presieve_of_covering U) F :=
pi.lift (λ f, pi.π _ (index_of_hom U f.fst, index_of_hom U f.snd) ≫
  F.map (eq_to_hom
    (by rw [complete_lattice.pullback_eq_inf, ← index_of_hom_spec U, ← index_of_hom_spec U])).op)

lemma pi_opens_to_first_obj_comp_fist_map_eq :
  pi_opens_to_first_obj F U ≫ presheaf.first_map (presieve_of_covering U) F =
  left_res F U ≫ pi_inters_to_second_obj F U :=
begin
  ext ⟨f, g⟩,
  dunfold pi_opens_to_first_obj presheaf.first_map left_res pi_inters_to_second_obj,
  rw [category.assoc, category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
    ← category.assoc, ← category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
    category.assoc, category.assoc, ← F.map_comp, ← F.map_comp],
  refl,
end

lemma pi_opens_to_first_obj_comp_second_map_eq :
  pi_opens_to_first_obj F U ≫ presheaf.second_map (presieve_of_covering U) F =
  right_res F U ≫ pi_inters_to_second_obj F U :=
begin
  ext ⟨f, g⟩,
  dunfold pi_opens_to_first_obj presheaf.second_map right_res pi_inters_to_second_obj,
  rw [category.assoc, category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
    ← category.assoc, ← category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
    category.assoc, category.assoc, ← F.map_comp, ← F.map_comp],
  refl,
end

lemma fork_map_comp_first_map_to_pi_opens_eq :
  presheaf.fork_map (presieve_of_covering U) F ≫ first_obj_to_pi_opens F U = res F U :=
begin
  ext i,
  dsimp [presheaf.fork_map, first_obj_to_pi_opens, res],
  rw [category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
    limit.lift_π, fan.mk_π_app],
  refl,
end

lemma res_comp_pi_opens_to_first_obj_eq :
  res F U ≫ pi_opens_to_first_obj F U = presheaf.fork_map (presieve_of_covering U) F :=
begin
  ext f,
  dunfold res pi_opens_to_first_obj presheaf.fork_map,
  rw [category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app, ← category.assoc,
    limit.lift_π, fan.mk_π_app, ← F.map_comp],
  congr,
end

end presieve_of_covering

open presieve_of_covering

lemma is_sheaf_spaces_of_is_sheaf_sites
  (Fsh : presheaf.is_sheaf (opens.grothendieck_topology X) F) :
  F.is_sheaf :=
begin
  intros ι U,
  rw presheaf.is_sheaf_iff_is_sheaf' at Fsh,
  -- We know that the sites diagram for `presieve_of_covering U` is a limit fork
  obtain ⟨h_limit⟩ := Fsh (supr U) (presieve_of_covering U)
    (presieve_of_covering.mem_grothendieck_topology U),
  refine ⟨fork.is_limit.mk' _ _⟩,
  -- Here, we are given an arbitrary fork of the spaces diagram and need to show that it factors
  -- uniquely through our limit fork.
  intro s,
  -- Composing `s.ι` with `pi_opens_to_first_obj F U` gives a fork of the sites diagram, which
  -- must factor through `presheaf.fork_map`.
  obtain ⟨l, hl⟩ := fork.is_limit.lift' h_limit (s.ι ≫ pi_opens_to_first_obj F U) _,
  swap,
  { rw [category.assoc, category.assoc, pi_opens_to_first_obj_comp_fist_map_eq,
    pi_opens_to_first_obj_comp_second_map_eq, ← category.assoc, ← category.assoc, s.condition] },
  -- We claim that `l` also gives a factorization of `s.ι`
  refine ⟨l, _, _⟩,
  { rw [← fork_ι_comp_pi_opens_to_first_obj_to_pi_opens_eq F U s, ← category.assoc, ← hl,
    category.assoc, fork.ι_of_ι, fork_map_comp_first_map_to_pi_opens_eq], refl },
  { intros m hm,
    apply fork.is_limit.hom_ext h_limit,
    rw [hl, fork.ι_of_ι],
    simp_rw ← res_comp_pi_opens_to_first_obj_eq,
    erw [← category.assoc, hm], },
end

lemma is_sheaf_sites_iff_is_sheaf_spaces :
  presheaf.is_sheaf (opens.grothendieck_topology X) F ↔ F.is_sheaf :=
iff.intro (is_sheaf_spaces_of_is_sheaf_sites F) (is_sheaf_sites_of_is_sheaf_spaces F)

variables (C X)

/-- Turn a sheaf on the site `opens X` into a sheaf on the space `X`. -/
@[simps]
def Sheaf_sites_to_sheaf_spaces : Sheaf (opens.grothendieck_topology X) C ⥤ sheaf C X :=
{ obj := λ F, ⟨F.1, is_sheaf_spaces_of_is_sheaf_sites F.1 F.2⟩,
  map := λ F G f, f }

/-- Turn a sheaf on the space `X` into a sheaf on the site `opens X`. -/
@[simps]
def Sheaf_spaces_to_sheaf_sites : sheaf C X ⥤ Sheaf (opens.grothendieck_topology X) C :=
{ obj := λ F, ⟨F.1, is_sheaf_sites_of_is_sheaf_spaces F.1 F.2⟩,
  map := λ F G f, f }

/--
The equivalence of categories between sheaves on the site `opens X` and sheaves on the space `X`.
-/
@[simps]
def Sheaf_spaces_equiv_sheaf_sites : Sheaf (opens.grothendieck_topology X) C ≌ sheaf C X :=
begin
  refine equivalence.mk (Sheaf_sites_to_sheaf_spaces C X) (Sheaf_spaces_to_sheaf_sites C X) _ _,
  all_goals
  { refine nat_iso.of_components (λ F, eq_to_iso (subtype.ext rfl)) (λ F G f, _),
    ext, dsimp [eq_to_hom], simp },
end

/-- The two forgetful functors are isomorphic via `Sheaf_spaces_equiv_sheaf_sites`. -/
def Sheaf_spaces_equiv_sheaf_sites_functor_forget :
  (Sheaf_spaces_equiv_sheaf_sites C X).functor ⋙ sheaf.forget C X ≅ Sheaf_to_presheaf _ _ :=
nat_iso.of_components (λ F, (iso.refl F.1))
  (λ F G f, by { erw [category.comp_id, category.id_comp], refl })

/-- The two forgetful functors are isomorphic via `Sheaf_spaces_equiv_sheaf_sites`. -/
def Sheaf_spaces_equiv_sheaf_sites_inverse_forget :
  (Sheaf_spaces_equiv_sheaf_sites C X).inverse ⋙ Sheaf_to_presheaf _ _ ≅ sheaf.forget C X :=
nat_iso.of_components (λ F, (iso.refl F.1))
  (λ F G f, by { erw [category.comp_id, category.id_comp], refl })

end Top.presheaf

namespace Top.opens

open category_theory topological_space

variables {X : Top} {ι : Type*}

lemma cover_dense_iff_is_basis [category ι] (B : ι ⥤ opens X) :
  cover_dense (opens.grothendieck_topology X) B ↔ opens.is_basis (set.range B.obj) :=
begin
  rw opens.is_basis_iff_nbhd,
  split, intros hd U x hx, rcases hd.1 U x hx with ⟨V,f,⟨i,f₁,f₂,hc⟩,hV⟩,
  exact ⟨B.obj i, ⟨i,rfl⟩, f₁.le hV, f₂.le⟩,
  intro hb, split, intros U x hx, rcases hb hx with ⟨_,⟨i,rfl⟩,hx,hi⟩,
  exact ⟨B.obj i, ⟨⟨hi⟩⟩, ⟨⟨i, 𝟙 _, ⟨⟨hi⟩⟩, rfl⟩⟩, hx⟩,
end

lemma cover_dense_induced_functor {B : ι → opens X} (h : opens.is_basis (set.range B)) :
  cover_dense (opens.grothendieck_topology X) (induced_functor B) :=
(cover_dense_iff_is_basis _).2 h

end Top.opens

namespace Top.sheaf

open category_theory topological_space Top opposite

variables {C : Type u} [category.{v} C] [limits.has_products C]
variables {X : Top.{v}} {ι : Type*} {B : ι → opens X}
variables (F : presheaf C X) (F' : sheaf C X) (h : opens.is_basis (set.range B))

/-- The empty component of a sheaf is terminal -/
def is_terminal_of_empty (F : sheaf C X) : limits.is_terminal (F.val.obj (op ∅)) :=
((presheaf.Sheaf_spaces_to_sheaf_sites C X).obj F).is_terminal_of_bot_cover ∅ (by tidy)

/-- A variant of `is_terminal_of_empty` that is easier to `apply`. -/
def is_terminal_of_eq_empty (F : X.sheaf C) {U : opens X} (h : U = ∅) :
  limits.is_terminal (F.val.obj (op U)) :=
by convert F.is_terminal_of_empty

/-- If a family `B` of open sets forms a basis of the topology on `X`, and if `F'`
    is a sheaf on `X`, then a homomorphism between a presheaf `F` on `X` and `F'`
    is equivalent to a homomorphism between their restrictions to the indexing type
    `ι` of `B`, with the induced category structure on `ι`. -/
def restrict_hom_equiv_hom :
  ((induced_functor B).op ⋙ F ⟶ (induced_functor B).op ⋙ F'.1) ≃ (F ⟶ F'.1) :=
@cover_dense.restrict_hom_equiv_hom _ _ _ _ _ _ _ _ (opens.cover_dense_induced_functor h)
  _ F ((presheaf.Sheaf_spaces_to_sheaf_sites C X).obj F')

@[simp] lemma extend_hom_app (α : ((induced_functor B).op ⋙ F ⟶ (induced_functor B).op ⋙ F'.1))
  (i : ι) : (restrict_hom_equiv_hom F F' h α).app (op (B i)) = α.app (op i) :=
by { nth_rewrite 1 ← (restrict_hom_equiv_hom F F' h).left_inv α, refl }

include h
lemma hom_ext {α β : F ⟶ F'.1} (he : ∀ i, α.app (op (B i)) = β.app (op (B i))) : α = β :=
by { apply (restrict_hom_equiv_hom F F' h).symm.injective, ext i, exact he i.unop }

end Top.sheaf


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

! This file was ported from Lean 3 source module algebra.cubic_discriminant
! leanprover-community/mathlib commit 930133160e24036d5242039fe4972407cd4f1222
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.Splits

/-!
# Cubics and discriminants

This file defines cubic polynomials over a semiring and their discriminants over a splitting field.

## Main definitions

 * `Cubic`: the structure representing a cubic polynomial.
 * `Cubic.disc`: the discriminant of a cubic polynomial.

## Main statements

 * `Cubic.disc_ne_zero_iff_roots_nodup`: the cubic discriminant is not equal to zero if and only if
    the cubic has no duplicate roots.

## References

 * https://en.wikipedia.org/wiki/Cubic_equation
 * https://en.wikipedia.org/wiki/Discriminant

## Tags

cubic, discriminant, polynomial, root
-/

noncomputable section

/-- The structure representing a cubic polynomial. -/
@[ext]
structure Cubic (R : Type _) where
  (a b c d : R)
#align cubic Cubic

namespace Cubic

open Cubic Polynomial

open Polynomial

variable {R S F K : Type _}

instance [Inhabited R] : Inhabited (Cubic R) :=
  ⟨⟨default, default, default, default⟩⟩

instance [Zero R] : Zero (Cubic R) :=
  ⟨⟨0, 0, 0, 0⟩⟩

section Basic

variable {P Q : Cubic R} {a b c d a' b' c' d' : R} [Semiring R]

/-- Convert a cubic polynomial to a polynomial. -/
def toPoly (P : Cubic R) : R[X] :=
  C P.a * X ^ 3 + C P.b * X ^ 2 + C P.c * X + C P.d
#align cubic.to_poly Cubic.toPoly

theorem C_mul_prod_X_sub_C_eq [CommRing S] {w x y z : S} :
    C w * (X - C x) * (X - C y) * (X - C z) =
      toPoly ⟨w, w * -(x + y + z), w * (x * y + x * z + y * z), w * -(x * y * z)⟩ := by
  simp only [toPoly, C_neg, C_add, C_mul]
  ring1
set_option linter.uppercaseLean3 false in
#align cubic.C_mul_prod_X_sub_C_eq Cubic.C_mul_prod_X_sub_C_eq

theorem prod_X_sub_C_eq [CommRing S] {x y z : S} :
    (X - C x) * (X - C y) * (X - C z) =
      toPoly ⟨1, -(x + y + z), x * y + x * z + y * z, -(x * y * z)⟩ := by
  rw [← one_mul <| X - C x, ← C_1, C_mul_prod_X_sub_C_eq, one_mul, one_mul, one_mul]
set_option linter.uppercaseLean3 false in
#align cubic.prod_X_sub_C_eq Cubic.prod_X_sub_C_eq

/-! ### Coefficients -/

section Coeff

private theorem coeffs : (∀ n > 3, P.toPoly.coeff n = 0) ∧ P.toPoly.coeff 3 = P.a ∧
    P.toPoly.coeff 2 = P.b ∧ P.toPoly.coeff 1 = P.c ∧ P.toPoly.coeff 0 = P.d := by
  simp only [toPoly, coeff_add, coeff_C, coeff_C_mul_X, coeff_C_mul_X_pow]
  norm_num
  intro n hn
  repeat' rw [if_neg]
  any_goals linarith only [hn]
  repeat' rw [zero_add]

@[simp]
theorem coeff_eq_zero {n : ℕ} (hn : 3 < n) : P.toPoly.coeff n = 0 :=
  coeffs.1 n hn
#align cubic.coeff_eq_zero Cubic.coeff_eq_zero

@[simp]
theorem coeff_eq_a : P.toPoly.coeff 3 = P.a :=
  coeffs.2.1
#align cubic.coeff_eq_a Cubic.coeff_eq_a

@[simp]
theorem coeff_eq_b : P.toPoly.coeff 2 = P.b :=
  coeffs.2.2.1
#align cubic.coeff_eq_b Cubic.coeff_eq_b

@[simp]
theorem coeff_eq_c : P.toPoly.coeff 1 = P.c :=
  coeffs.2.2.2.1
#align cubic.coeff_eq_c Cubic.coeff_eq_c

@[simp]
theorem coeff_eq_d : P.toPoly.coeff 0 = P.d :=
  coeffs.2.2.2.2
#align cubic.coeff_eq_d Cubic.coeff_eq_d

theorem a_of_eq (h : P.toPoly = Q.toPoly) : P.a = Q.a := by rw [← coeff_eq_a, h, coeff_eq_a]
#align cubic.a_of_eq Cubic.a_of_eq

theorem b_of_eq (h : P.toPoly = Q.toPoly) : P.b = Q.b := by rw [← coeff_eq_b, h, coeff_eq_b]
#align cubic.b_of_eq Cubic.b_of_eq

theorem c_of_eq (h : P.toPoly = Q.toPoly) : P.c = Q.c := by rw [← coeff_eq_c, h, coeff_eq_c]
#align cubic.c_of_eq Cubic.c_of_eq

theorem d_of_eq (h : P.toPoly = Q.toPoly) : P.d = Q.d := by rw [← coeff_eq_d, h, coeff_eq_d]
#align cubic.d_of_eq Cubic.d_of_eq

theorem toPoly_injective (P Q : Cubic R) : P.toPoly = Q.toPoly ↔ P = Q :=
  ⟨fun h ↦ Cubic.ext P Q (a_of_eq h) (b_of_eq h) (c_of_eq h) (d_of_eq h), congr_arg toPoly⟩
#align cubic.to_poly_injective Cubic.toPoly_injective

theorem of_a_eq_zero (ha : P.a = 0) : P.toPoly = C P.b * X ^ 2 + C P.c * X + C P.d := by
  rw [toPoly, ha, C_0, MulZeroClass.zero_mul, zero_add]
#align cubic.of_a_eq_zero Cubic.of_a_eq_zero

theorem of_a_eq_zero' : toPoly ⟨0, b, c, d⟩ = C b * X ^ 2 + C c * X + C d :=
  of_a_eq_zero rfl
#align cubic.of_a_eq_zero' Cubic.of_a_eq_zero'

theorem of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.toPoly = C P.c * X + C P.d := by
  rw [of_a_eq_zero ha, hb, C_0, MulZeroClass.zero_mul, zero_add]
#align cubic.of_b_eq_zero Cubic.of_b_eq_zero

theorem of_b_eq_zero' : toPoly ⟨0, 0, c, d⟩ = C c * X + C d :=
  of_b_eq_zero rfl rfl
#align cubic.of_b_eq_zero' Cubic.of_b_eq_zero'

theorem of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : P.toPoly = C P.d := by
  rw [of_b_eq_zero ha hb, hc, C_0, MulZeroClass.zero_mul, zero_add]
#align cubic.of_c_eq_zero Cubic.of_c_eq_zero

theorem of_c_eq_zero' : toPoly ⟨0, 0, 0, d⟩ = C d :=
  of_c_eq_zero rfl rfl rfl
#align cubic.of_c_eq_zero' Cubic.of_c_eq_zero'

theorem of_d_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 0) :
    P.toPoly = 0 := by
  rw [of_c_eq_zero ha hb hc, hd, C_0]
#align cubic.of_d_eq_zero Cubic.of_d_eq_zero

theorem of_d_eq_zero' : (⟨0, 0, 0, 0⟩ : Cubic R).toPoly = 0 :=
  of_d_eq_zero rfl rfl rfl rfl
#align cubic.of_d_eq_zero' Cubic.of_d_eq_zero'

theorem zero : (0 : Cubic R).toPoly = 0 :=
  of_d_eq_zero'
#align cubic.zero Cubic.zero

theorem toPoly_eq_zero_iff (P : Cubic R) : P.toPoly = 0 ↔ P = 0 := by
  rw [← zero, toPoly_injective]
#align cubic.to_poly_eq_zero_iff Cubic.toPoly_eq_zero_iff

private theorem ne_zero (h0 : P.a ≠ 0 ∨ P.b ≠ 0 ∨ P.c ≠ 0 ∨ P.d ≠ 0) : P.toPoly ≠ 0 := by
  contrapose! h0
  rw [(toPoly_eq_zero_iff P).mp h0]
  exact ⟨rfl, rfl, rfl, rfl⟩

theorem ne_zero_of_b_ne_zero (hb : P.b ≠ 0) : P.toPoly ≠ 0 :=
  (or_imp.mp (or_imp.mp ne_zero).2).1 hb
#align cubic.ne_zero_of_b_ne_zero Cubic.ne_zero_of_b_ne_zero

theorem ne_zero_of_c_ne_zero (hc : P.c ≠ 0) : P.toPoly ≠ 0 :=
  (or_imp.mp (or_imp.mp (or_imp.mp ne_zero).2).2).1 hc
#align cubic.ne_zero_of_c_ne_zero Cubic.ne_zero_of_c_ne_zero

theorem ne_zero_of_d_ne_zero (hd : P.d ≠ 0) : P.toPoly ≠ 0 :=
  (or_imp.mp (or_imp.mp (or_imp.mp ne_zero).2).2).2 hd
#align cubic.ne_zero_of_d_ne_zero Cubic.ne_zero_of_d_ne_zero

@[simp]
theorem leadingCoeff_of_a_ne_zero (ha : P.a ≠ 0) : P.toPoly.leadingCoeff = P.a :=
  leadingCoeff_cubic ha
#align cubic.leading_coeff_of_a_ne_zero Cubic.leadingCoeff_of_a_ne_zero

@[simp]
theorem leadingCoeff_of_a_ne_zero' (ha : a ≠ 0) : (toPoly ⟨a, b, c, d⟩).leadingCoeff = a :=
  leadingCoeff_of_a_ne_zero ha
#align cubic.leading_coeff_of_a_ne_zero' Cubic.leadingCoeff_of_a_ne_zero'

@[simp]
theorem leadingCoeff_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.toPoly.leadingCoeff = P.b := by
  rw [of_a_eq_zero ha, leadingCoeff_quadratic hb]
#align cubic.leading_coeff_of_b_ne_zero Cubic.leadingCoeff_of_b_ne_zero

@[simp]
theorem leadingCoeff_of_b_ne_zero' (hb : b ≠ 0) : (toPoly ⟨0, b, c, d⟩).leadingCoeff = b :=
  leadingCoeff_of_b_ne_zero rfl hb
#align cubic.leading_coeff_of_b_ne_zero' Cubic.leadingCoeff_of_b_ne_zero'

@[simp]
theorem leadingCoeff_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) :
    P.toPoly.leadingCoeff = P.c := by
  rw [of_b_eq_zero ha hb, leadingCoeff_linear hc]
#align cubic.leading_coeff_of_c_ne_zero Cubic.leadingCoeff_of_c_ne_zero

@[simp]
theorem leadingCoeff_of_c_ne_zero' (hc : c ≠ 0) : (toPoly ⟨0, 0, c, d⟩).leadingCoeff = c :=
  leadingCoeff_of_c_ne_zero rfl rfl hc
#align cubic.leading_coeff_of_c_ne_zero' Cubic.leadingCoeff_of_c_ne_zero'

@[simp]
theorem leadingCoeff_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) :
    P.toPoly.leadingCoeff = P.d := by
  rw [of_c_eq_zero ha hb hc, leadingCoeff_C]
#align cubic.leading_coeff_of_c_eq_zero Cubic.leadingCoeff_of_c_eq_zero

-- @[simp] -- Porting note: simp can prove this
theorem leadingCoeff_of_c_eq_zero' : (toPoly ⟨0, 0, 0, d⟩).leadingCoeff = d :=
  leadingCoeff_of_c_eq_zero rfl rfl rfl
#align cubic.leading_coeff_of_c_eq_zero' Cubic.leadingCoeff_of_c_eq_zero'

theorem monic_of_a_eq_one (ha : P.a = 1) : P.toPoly.Monic := by
  nontriviality R
  rw [Monic, leadingCoeff_of_a_ne_zero (ha ▸ one_ne_zero), ha]
#align cubic.monic_of_a_eq_one Cubic.monic_of_a_eq_one

theorem monic_of_a_eq_one' : (toPoly ⟨1, b, c, d⟩).Monic :=
  monic_of_a_eq_one rfl
#align cubic.monic_of_a_eq_one' Cubic.monic_of_a_eq_one'

theorem monic_of_b_eq_one (ha : P.a = 0) (hb : P.b = 1) : P.toPoly.Monic := by
  nontriviality R
  rw [Monic, leadingCoeff_of_b_ne_zero ha (hb ▸ one_ne_zero), hb]
#align cubic.monic_of_b_eq_one Cubic.monic_of_b_eq_one

theorem monic_of_b_eq_one' : (toPoly ⟨0, 1, c, d⟩).Monic :=
  monic_of_b_eq_one rfl rfl
#align cubic.monic_of_b_eq_one' Cubic.monic_of_b_eq_one'

theorem monic_of_c_eq_one (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 1) : P.toPoly.Monic := by
  nontriviality R
  rw [Monic, leadingCoeff_of_c_ne_zero ha hb (hc ▸ one_ne_zero), hc]
#align cubic.monic_of_c_eq_one Cubic.monic_of_c_eq_one

theorem monic_of_c_eq_one' : (toPoly ⟨0, 0, 1, d⟩).Monic :=
  monic_of_c_eq_one rfl rfl rfl
#align cubic.monic_of_c_eq_one' Cubic.monic_of_c_eq_one'

theorem monic_of_d_eq_one (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 1) :
    P.toPoly.Monic := by
  rw [Monic, leadingCoeff_of_c_eq_zero ha hb hc, hd]
#align cubic.monic_of_d_eq_one Cubic.monic_of_d_eq_one

theorem monic_of_d_eq_one' : (toPoly ⟨0, 0, 0, 1⟩).Monic :=
  monic_of_d_eq_one rfl rfl rfl rfl
#align cubic.monic_of_d_eq_one' Cubic.monic_of_d_eq_one'

end Coeff

/-! ### Degrees -/

section Degree

/-- The equivalence between cubic polynomials and polynomials of degree at most three. -/
@[simps]
def equiv : Cubic R ≃ { p : R[X] // p.degree ≤ 3 } where
  toFun P := ⟨P.toPoly, degree_cubic_le⟩
  invFun f := ⟨coeff f 3, coeff f 2, coeff f 1, coeff f 0⟩
  left_inv P := by ext <;> simp only [Subtype.coe_mk, coeffs]
  right_inv f := by
    -- Porting note: Added `simp only [Nat.zero_eq, Nat.succ_eq_add_one] <;> ring_nf`
    -- There's probably a better way to do this.
    ext (_ | _ | _ | _ | n) <;> simp only [Nat.zero_eq, Nat.succ_eq_add_one] <;> ring_nf
      <;> simp only [coeffs]
    have h3 : 3 < 4 + n := by linarith only
    rw [coeff_eq_zero h3,
      (degree_le_iff_coeff_zero (f : R[X]) 3).mp f.2 _ <| WithBot.coe_lt_coe.mpr (by exact h3)]
#align cubic.equiv Cubic.equiv

@[simp]
theorem degree_of_a_ne_zero (ha : P.a ≠ 0) : P.toPoly.degree = 3 :=
  degree_cubic ha
#align cubic.degree_of_a_ne_zero Cubic.degree_of_a_ne_zero

@[simp]
theorem degree_of_a_ne_zero' (ha : a ≠ 0) : (toPoly ⟨a, b, c, d⟩).degree = 3 :=
  degree_of_a_ne_zero ha
#align cubic.degree_of_a_ne_zero' Cubic.degree_of_a_ne_zero'

theorem degree_of_a_eq_zero (ha : P.a = 0) : P.toPoly.degree ≤ 2 := by
  simpa only [of_a_eq_zero ha] using degree_quadratic_le
#align cubic.degree_of_a_eq_zero Cubic.degree_of_a_eq_zero

theorem degree_of_a_eq_zero' : (toPoly ⟨0, b, c, d⟩).degree ≤ 2 :=
  degree_of_a_eq_zero rfl
#align cubic.degree_of_a_eq_zero' Cubic.degree_of_a_eq_zero'

@[simp]
theorem degree_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.toPoly.degree = 2 := by
  rw [of_a_eq_zero ha, degree_quadratic hb]
#align cubic.degree_of_b_ne_zero Cubic.degree_of_b_ne_zero

@[simp]
theorem degree_of_b_ne_zero' (hb : b ≠ 0) : (toPoly ⟨0, b, c, d⟩).degree = 2 :=
  degree_of_b_ne_zero rfl hb
#align cubic.degree_of_b_ne_zero' Cubic.degree_of_b_ne_zero'

theorem degree_of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.toPoly.degree ≤ 1 := by
  simpa only [of_b_eq_zero ha hb] using degree_linear_le
#align cubic.degree_of_b_eq_zero Cubic.degree_of_b_eq_zero

theorem degree_of_b_eq_zero' : (toPoly ⟨0, 0, c, d⟩).degree ≤ 1 :=
  degree_of_b_eq_zero rfl rfl
#align cubic.degree_of_b_eq_zero' Cubic.degree_of_b_eq_zero'

@[simp]
theorem degree_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) : P.toPoly.degree = 1 := by
  rw [of_b_eq_zero ha hb, degree_linear hc]
#align cubic.degree_of_c_ne_zero Cubic.degree_of_c_ne_zero

@[simp]
theorem degree_of_c_ne_zero' (hc : c ≠ 0) : (toPoly ⟨0, 0, c, d⟩).degree = 1 :=
  degree_of_c_ne_zero rfl rfl hc
#align cubic.degree_of_c_ne_zero' Cubic.degree_of_c_ne_zero'

theorem degree_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : P.toPoly.degree ≤ 0 := by
  simpa only [of_c_eq_zero ha hb hc] using degree_C_le
#align cubic.degree_of_c_eq_zero Cubic.degree_of_c_eq_zero

theorem degree_of_c_eq_zero' : (toPoly ⟨0, 0, 0, d⟩).degree ≤ 0 :=
  degree_of_c_eq_zero rfl rfl rfl
#align cubic.degree_of_c_eq_zero' Cubic.degree_of_c_eq_zero'

@[simp]
theorem degree_of_d_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d ≠ 0) :
    P.toPoly.degree = 0 := by
  rw [of_c_eq_zero ha hb hc, degree_C hd]
#align cubic.degree_of_d_ne_zero Cubic.degree_of_d_ne_zero

@[simp]
theorem degree_of_d_ne_zero' (hd : d ≠ 0) : (toPoly ⟨0, 0, 0, d⟩).degree = 0 :=
  degree_of_d_ne_zero rfl rfl rfl hd
#align cubic.degree_of_d_ne_zero' Cubic.degree_of_d_ne_zero'

@[simp]
theorem degree_of_d_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 0) :
    P.toPoly.degree = ⊥ := by
  rw [of_d_eq_zero ha hb hc hd, degree_zero]
#align cubic.degree_of_d_eq_zero Cubic.degree_of_d_eq_zero

-- @[simp] -- Porting note: simp can prove this
theorem degree_of_d_eq_zero' : (⟨0, 0, 0, 0⟩ : Cubic R).toPoly.degree = ⊥ :=
  degree_of_d_eq_zero rfl rfl rfl rfl
#align cubic.degree_of_d_eq_zero' Cubic.degree_of_d_eq_zero'

@[simp]
theorem degree_of_zero : (0 : Cubic R).toPoly.degree = ⊥ :=
  degree_of_d_eq_zero'
#align cubic.degree_of_zero Cubic.degree_of_zero

@[simp]
theorem natDegree_of_a_ne_zero (ha : P.a ≠ 0) : P.toPoly.natDegree = 3 :=
  natDegree_cubic ha
#align cubic.nat_degree_of_a_ne_zero Cubic.natDegree_of_a_ne_zero

@[simp]
theorem natDegree_of_a_ne_zero' (ha : a ≠ 0) : (toPoly ⟨a, b, c, d⟩).natDegree = 3 :=
  natDegree_of_a_ne_zero ha
#align cubic.nat_degree_of_a_ne_zero' Cubic.natDegree_of_a_ne_zero'

theorem natDegree_of_a_eq_zero (ha : P.a = 0) : P.toPoly.natDegree ≤ 2 := by
  simpa only [of_a_eq_zero ha] using natDegree_quadratic_le
#align cubic.nat_degree_of_a_eq_zero Cubic.natDegree_of_a_eq_zero

theorem natDegree_of_a_eq_zero' : (toPoly ⟨0, b, c, d⟩).natDegree ≤ 2 :=
  natDegree_of_a_eq_zero rfl
#align cubic.nat_degree_of_a_eq_zero' Cubic.natDegree_of_a_eq_zero'

@[simp]
theorem natDegree_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.toPoly.natDegree = 2 := by
  rw [of_a_eq_zero ha, natDegree_quadratic hb]
#align cubic.nat_degree_of_b_ne_zero Cubic.natDegree_of_b_ne_zero

@[simp]
theorem natDegree_of_b_ne_zero' (hb : b ≠ 0) : (toPoly ⟨0, b, c, d⟩).natDegree = 2 :=
  natDegree_of_b_ne_zero rfl hb
#align cubic.nat_degree_of_b_ne_zero' Cubic.natDegree_of_b_ne_zero'

theorem natDegree_of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.toPoly.natDegree ≤ 1 := by
  simpa only [of_b_eq_zero ha hb] using natDegree_linear_le
#align cubic.nat_degree_of_b_eq_zero Cubic.natDegree_of_b_eq_zero

theorem natDegree_of_b_eq_zero' : (toPoly ⟨0, 0, c, d⟩).natDegree ≤ 1 :=
  natDegree_of_b_eq_zero rfl rfl
#align cubic.nat_degree_of_b_eq_zero' Cubic.natDegree_of_b_eq_zero'

@[simp]
theorem natDegree_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) :
    P.toPoly.natDegree = 1 := by
  rw [of_b_eq_zero ha hb, natDegree_linear hc]
#align cubic.nat_degree_of_c_ne_zero Cubic.natDegree_of_c_ne_zero

@[simp]
theorem natDegree_of_c_ne_zero' (hc : c ≠ 0) : (toPoly ⟨0, 0, c, d⟩).natDegree = 1 :=
  natDegree_of_c_ne_zero rfl rfl hc
#align cubic.nat_degree_of_c_ne_zero' Cubic.natDegree_of_c_ne_zero'

@[simp]
theorem natDegree_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) :
    P.toPoly.natDegree = 0 := by
  rw [of_c_eq_zero ha hb hc, natDegree_C]
#align cubic.nat_degree_of_c_eq_zero Cubic.natDegree_of_c_eq_zero

-- @[simp] -- Porting note: simp can prove this
theorem natDegree_of_c_eq_zero' : (toPoly ⟨0, 0, 0, d⟩).natDegree = 0 :=
  natDegree_of_c_eq_zero rfl rfl rfl
#align cubic.nat_degree_of_c_eq_zero' Cubic.natDegree_of_c_eq_zero'

@[simp]
theorem natDegree_of_zero : (0 : Cubic R).toPoly.natDegree = 0 :=
  natDegree_of_c_eq_zero'
#align cubic.nat_degree_of_zero Cubic.natDegree_of_zero

end Degree

/-! ### Map across a homomorphism -/

section Map

variable [Semiring S] {φ : R →+* S}

/-- Map a cubic polynomial across a semiring homomorphism. -/
def map (φ : R →+* S) (P : Cubic R) : Cubic S :=
  ⟨φ P.a, φ P.b, φ P.c, φ P.d⟩
#align cubic.map Cubic.map

theorem map_toPoly : (map φ P).toPoly = Polynomial.map φ P.toPoly := by
  simp only [map, toPoly, map_C, map_X, Polynomial.map_add, Polynomial.map_mul, Polynomial.map_pow]
#align cubic.map_to_poly Cubic.map_toPoly

end Map

end Basic

section Roots

open Multiset

/-! ### Roots over an extension -/

section Extension

variable {P : Cubic R} [CommRing R] [CommRing S] {φ : R →+* S}

/-- The roots of a cubic polynomial. -/
def roots [IsDomain R] (P : Cubic R) : Multiset R :=
  P.toPoly.roots
#align cubic.roots Cubic.roots

theorem map_roots [IsDomain S] : (map φ P).roots = (Polynomial.map φ P.toPoly).roots := by
  rw [roots, map_toPoly]
#align cubic.map_roots Cubic.map_roots

theorem mem_roots_iff [IsDomain R] (h0 : P.toPoly ≠ 0) (x : R) :
    x ∈ P.roots ↔ P.a * x ^ 3 + P.b * x ^ 2 + P.c * x + P.d = 0 := by
  rw [roots, mem_roots h0, IsRoot, toPoly]
  simp only [eval_C, eval_X, eval_add, eval_mul, eval_pow]
#align cubic.mem_roots_iff Cubic.mem_roots_iff

theorem card_roots_le [IsDomain R] [DecidableEq R] : P.roots.toFinset.card ≤ 3 := by
  apply (toFinset_card_le P.toPoly.roots).trans
  by_cases hP : P.toPoly = 0
  · exact (card_roots' P.toPoly).trans (by rw [hP, natDegree_zero]; exact zero_le 3)
  · exact WithBot.coe_le_coe.1 ((card_roots hP).trans degree_cubic_le)
#align cubic.card_roots_le Cubic.card_roots_le

end Extension

variable {P : Cubic F} [Field F] [Field K] {φ : F →+* K} {x y z : K}

/-! ### Roots over a splitting field -/

section Split

theorem splits_iff_card_roots (ha : P.a ≠ 0) :
    Splits φ P.toPoly ↔ Multiset.card (map φ P).roots = 3 := by
  replace ha : (map φ P).a ≠ 0 := (_root_.map_ne_zero φ).mpr ha
  nth_rw 1 [← RingHom.id_comp φ]
  rw [roots, ← splits_map_iff, ← map_toPoly, Polynomial.splits_iff_card_roots,
    ← ((degree_eq_iff_natDegree_eq <| ne_zero_of_a_ne_zero ha).1 <| degree_of_a_ne_zero ha : _ = 3)]
#align cubic.splits_iff_card_roots Cubic.splits_iff_card_roots

theorem splits_iff_roots_eq_three (ha : P.a ≠ 0) :
    Splits φ P.toPoly ↔ ∃ x y z : K, (map φ P).roots = {x, y, z} := by
  rw [splits_iff_card_roots ha, card_eq_three]
#align cubic.splits_iff_roots_eq_three Cubic.splits_iff_roots_eq_three

theorem eq_prod_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
    (map φ P).toPoly = C (φ P.a) * (X - C x) * (X - C y) * (X - C z) := by
  rw [map_toPoly,
    eq_prod_roots_of_splits <|
      (splits_iff_roots_eq_three ha).mpr <| Exists.intro x <| Exists.intro y <| Exists.intro z h3,
    leadingCoeff_of_a_ne_zero ha, ← map_roots, h3]
  change C (φ P.a) * ((X - C x) ::ₘ (X - C y) ::ₘ {X - C z}).prod = _
  rw [prod_cons, prod_cons, prod_singleton, mul_assoc, mul_assoc]
#align cubic.eq_prod_three_roots Cubic.eq_prod_three_roots

-- Porting note: Increased heartbeat limit for `C_mul_prod_X_sub_C_eq`
set_option maxHeartbeats 500000 in
theorem eq_sum_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
    map φ P =
      ⟨φ P.a, φ P.a * -(x + y + z), φ P.a * (x * y + x * z + y * z), φ P.a * -(x * y * z)⟩ := by
  apply_fun @toPoly _ _
  · rw [eq_prod_three_roots ha h3, C_mul_prod_X_sub_C_eq]
  · exact fun P Q ↦ (toPoly_injective P Q).mp
#align cubic.eq_sum_three_roots Cubic.eq_sum_three_roots

theorem b_eq_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
    φ P.b = φ P.a * -(x + y + z) := by
  injection eq_sum_three_roots ha h3
#align cubic.b_eq_three_roots Cubic.b_eq_three_roots

theorem c_eq_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
    φ P.c = φ P.a * (x * y + x * z + y * z) := by
  injection eq_sum_three_roots ha h3
#align cubic.c_eq_three_roots Cubic.c_eq_three_roots

theorem d_eq_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
    φ P.d = φ P.a * -(x * y * z) := by
  injection eq_sum_three_roots ha h3
#align cubic.d_eq_three_roots Cubic.d_eq_three_roots

end Split

/-! ### Discriminant over a splitting field -/

section Discriminant

/-- The discriminant of a cubic polynomial. -/
def disc {R : Type _} [Ring R] (P : Cubic R) : R :=
  P.b ^ 2 * P.c ^ 2 - 4 * P.a * P.c ^ 3 - 4 * P.b ^ 3 * P.d - 27 * P.a ^ 2 * P.d ^ 2 +
    18 * P.a * P.b * P.c * P.d
#align cubic.disc Cubic.disc

theorem disc_eq_prod_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
    φ P.disc = (φ P.a * φ P.a * (x - y) * (x - z) * (y - z)) ^ 2 := by
  simp only [disc, RingHom.map_add, RingHom.map_sub, RingHom.map_mul, map_pow]
  -- Porting note: Replaced `simp only [RingHom.map_one, map_bit0, map_bit1]` with f4, f18, f27
  have f4 : φ 4 = 4 := map_natCast φ 4
  have f18 : φ 18 = 18 := map_natCast φ 18
  have f27 : φ 27 = 27 := map_natCast φ 27
  rw [f4, f18, f27, b_eq_three_roots ha h3, c_eq_three_roots ha h3, d_eq_three_roots ha h3]
  ring1
#align cubic.disc_eq_prod_three_roots Cubic.disc_eq_prod_three_roots

theorem disc_ne_zero_iff_roots_ne (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
    P.disc ≠ 0 ↔ x ≠ y ∧ x ≠ z ∧ y ≠ z := by
  rw [← _root_.map_ne_zero φ, disc_eq_prod_three_roots ha h3, pow_two]
  simp_rw [mul_ne_zero_iff, sub_ne_zero, _root_.map_ne_zero, and_self_iff, and_iff_right ha,
    and_assoc]
#align cubic.disc_ne_zero_iff_roots_ne Cubic.disc_ne_zero_iff_roots_ne

theorem disc_ne_zero_iff_roots_nodup (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
    P.disc ≠ 0 ↔ (map φ P).roots.Nodup := by
  rw [disc_ne_zero_iff_roots_ne ha h3, h3]
  change _ ↔ (x ::ₘ y ::ₘ {z}).Nodup
  rw [nodup_cons, nodup_cons, mem_cons, mem_singleton, mem_singleton]
  simp only [nodup_singleton]
  tauto
#align cubic.disc_ne_zero_iff_roots_nodup Cubic.disc_ne_zero_iff_roots_nodup

theorem card_roots_of_disc_ne_zero [DecidableEq K] (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z})
    (hd : P.disc ≠ 0) : (map φ P).roots.toFinset.card = 3 := by
  rw [toFinset_card_of_nodup <| (disc_ne_zero_iff_roots_nodup ha h3).mp hd,
    ← splits_iff_card_roots ha, splits_iff_roots_eq_three ha]
  exact ⟨x, ⟨y, ⟨z, h3⟩⟩⟩
#align cubic.card_roots_of_disc_ne_zero Cubic.card_roots_of_disc_ne_zero

end Discriminant

end Roots

end Cubic


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import analysis.special_functions.trigonometric.arctan
import geometry.euclidean.angle.unoriented.affine

/-!
# Right-angled triangles

This file proves basic geometrical results about distances and angles in (possibly degenerate)
right-angled triangles in real inner product spaces and Euclidean affine spaces.

## Implementation notes

Results in this file are generally given in a form with only those non-degeneracy conditions
needed for the particular result, rather than requiring affine independence of the points of a
triangle unnecessarily.

## References

* https://en.wikipedia.org/wiki/Pythagorean_theorem

-/

noncomputable theory
open_locale big_operators
open_locale euclidean_geometry
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]

/-- Pythagorean theorem, if-and-only-if vector angle form. -/
lemma norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
  ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ ↔ angle x y = π / 2 :=
begin
  rw norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero,
  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
end

/-- Pythagorean theorem, vector angle form. -/
lemma norm_add_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
  ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ :=
(norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h

/-- Pythagorean theorem, subtracting vectors, if-and-only-if vector angle form. -/
lemma norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
  ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ ↔ angle x y = π / 2 :=
begin
  rw norm_sub_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero,
  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
end

/-- Pythagorean theorem, subtracting vectors, vector angle form. -/
lemma norm_sub_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
  ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ :=
(norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h

/-- An angle in a right-angled triangle expressed using `arccos`. -/
lemma angle_add_eq_arccos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  angle x (x + y) = real.arccos (‖x‖ / ‖x + y‖) :=
begin
  rw [angle, inner_add_right, h, add_zero, real_inner_self_eq_norm_mul_norm],
  by_cases hx : ‖x‖ = 0, { simp [hx] },
  rw [div_mul_eq_div_div, mul_self_div_self]
end

/-- An angle in a right-angled triangle expressed using `arcsin`. -/
lemma angle_add_eq_arcsin_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
  angle x (x + y) = real.arcsin (‖y‖ / ‖x + y‖) :=
begin
  have hxy : ‖x + y‖ ^ 2 ≠ 0,
  { rw [pow_two, norm_add_sq_eq_norm_sq_add_norm_sq_real h, ne_comm],
    refine ne_of_lt _,
    rcases h0 with h0 | h0,
    { exact left.add_pos_of_pos_of_nonneg (mul_self_pos.2 (norm_ne_zero_iff.2 h0))
                                          (mul_self_nonneg _) },
    { exact left.add_pos_of_nonneg_of_pos (mul_self_nonneg _)
                                          (mul_self_pos.2 (norm_ne_zero_iff.2 h0)) } },
  rw [angle_add_eq_arccos_of_inner_eq_zero h,
      real.arccos_eq_arcsin (div_nonneg (norm_nonneg _) (norm_nonneg _)), div_pow,
      one_sub_div hxy],
  nth_rewrite 0 [pow_two],
  rw [norm_add_sq_eq_norm_sq_add_norm_sq_real h, pow_two, add_sub_cancel', ←pow_two, ←div_pow,
      real.sqrt_sq (div_nonneg (norm_nonneg _) (norm_nonneg _))]
end

/-- An angle in a right-angled triangle expressed using `arctan`. -/
lemma angle_add_eq_arctan_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
  angle x (x + y) = real.arctan (‖y‖ / ‖x‖) :=
begin
  rw [angle_add_eq_arcsin_of_inner_eq_zero h (or.inl h0), real.arctan_eq_arcsin,
      ←div_mul_eq_div_div, norm_add_eq_sqrt_iff_real_inner_eq_zero.2 h],
  nth_rewrite 2 [←real.sqrt_sq (norm_nonneg x)],
  rw [←real.sqrt_mul (sq_nonneg _), div_pow, pow_two, pow_two, mul_add, mul_one, mul_div,
      mul_comm (‖x‖ * ‖x‖), ←mul_div, div_self (mul_self_pos.2 (norm_ne_zero_iff.2 h0)).ne',
      mul_one]
end

/-- An angle in a non-degenerate right-angled triangle is positive. -/
lemma angle_add_pos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
  0 < angle x (x + y) :=
begin
  rw [angle_add_eq_arccos_of_inner_eq_zero h, real.arccos_pos,
      norm_add_eq_sqrt_iff_real_inner_eq_zero.2 h],
  by_cases hx : x = 0, { simp [hx] },
  rw [div_lt_one (real.sqrt_pos.2 (left.add_pos_of_pos_of_nonneg
                                     (mul_self_pos.2 (norm_ne_zero_iff.2 hx))
                                     (mul_self_nonneg _))), real.lt_sqrt (norm_nonneg _),
      pow_two],
  simpa [hx] using h0
end

/-- An angle in a right-angled triangle is at most `π / 2`. -/
lemma angle_add_le_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  angle x (x + y) ≤ π / 2 :=
begin
  rw [angle_add_eq_arccos_of_inner_eq_zero h, real.arccos_le_pi_div_two],
  exact div_nonneg (norm_nonneg _) (norm_nonneg _)
end

/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`. -/

/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
lemma cos_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  real.cos (angle x (x + y)) = ‖x‖ / ‖x + y‖ :=
begin
  rw [angle_add_eq_arccos_of_inner_eq_zero h,
      real.cos_arccos (le_trans (by norm_num) (div_nonneg (norm_nonneg _) (norm_nonneg _)))
                      (div_le_one_of_le _ (norm_nonneg _))],
  rw [mul_self_le_mul_self_iff (norm_nonneg _) (norm_nonneg _),
      norm_add_sq_eq_norm_sq_add_norm_sq_real h],
  exact le_add_of_nonneg_right (mul_self_nonneg _)
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
lemma sin_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
  real.sin (angle x (x + y)) = ‖y‖ / ‖x + y‖ :=
begin
  rw [angle_add_eq_arcsin_of_inner_eq_zero h h0,
      real.sin_arcsin (le_trans (by norm_num) (div_nonneg (norm_nonneg _) (norm_nonneg _)))
                      (div_le_one_of_le _ (norm_nonneg _))],
  rw [mul_self_le_mul_self_iff (norm_nonneg _) (norm_nonneg _),
      norm_add_sq_eq_norm_sq_add_norm_sq_real h],
  exact le_add_of_nonneg_left (mul_self_nonneg _)
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
lemma tan_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  real.tan (angle x (x + y)) = ‖y‖ / ‖x‖ :=
begin
  by_cases h0 : x = 0, { simp [h0] },
  rw [angle_add_eq_arctan_of_inner_eq_zero h h0, real.tan_arctan]
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side. -/
lemma cos_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  real.cos (angle x (x + y)) * ‖x + y‖ = ‖x‖ :=
begin
  rw cos_angle_add_of_inner_eq_zero h,
  by_cases hxy : ‖x + y‖ = 0,
  { have h' := norm_add_sq_eq_norm_sq_add_norm_sq_real h,
    rw [hxy, zero_mul, eq_comm, add_eq_zero_iff' (mul_self_nonneg ‖x‖) (mul_self_nonneg ‖y‖),
        mul_self_eq_zero] at h',
    simp [h'.1] },
  { exact div_mul_cancel _ hxy }
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side. -/
lemma sin_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  real.sin (angle x (x + y)) * ‖x + y‖ = ‖y‖ :=
begin
  by_cases h0 : x = 0 ∧ y = 0, { simp [h0] },
  rw not_and_distrib at h0,
  rw [sin_angle_add_of_inner_eq_zero h h0, div_mul_cancel],
  rw [←mul_self_ne_zero, norm_add_sq_eq_norm_sq_add_norm_sq_real h],
  refine (ne_of_lt _).symm,
  rcases h0 with h0 | h0,
  { exact left.add_pos_of_pos_of_nonneg (mul_self_pos.2 (norm_ne_zero_iff.2 h0))
                                        (mul_self_nonneg _) },
  { exact left.add_pos_of_nonneg_of_pos (mul_self_nonneg _)
                                        (mul_self_pos.2 (norm_ne_zero_iff.2 h0)) }
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side. -/
lemma tan_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
  real.tan (angle x (x + y)) * ‖x‖ = ‖y‖ :=
begin
  rw [tan_angle_add_of_inner_eq_zero h],
  rcases h0 with h0 | h0; simp [h0]
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse. -/
lemma norm_div_cos_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
  ‖x‖ / real.cos (angle x (x + y)) = ‖x + y‖ :=
begin
  rw cos_angle_add_of_inner_eq_zero h,
  rcases h0 with h0 | h0,
  { rw [div_div_eq_mul_div, mul_comm, div_eq_mul_inv,
        mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)] },
  { simp [h0] }
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse. -/
lemma norm_div_sin_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
  ‖y‖ / real.sin (angle x (x + y)) = ‖x + y‖ :=
begin
  rcases h0 with h0 | h0, { simp [h0] },
  rw [sin_angle_add_of_inner_eq_zero h (or.inr h0), div_div_eq_mul_div, mul_comm, div_eq_mul_inv,
        mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)]
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side. -/
lemma norm_div_tan_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
  ‖y‖ / real.tan (angle x (x + y)) = ‖x‖ :=
begin
  rw tan_angle_add_of_inner_eq_zero h,
  rcases h0 with h0 | h0,
  { simp [h0] },
  { rw [div_div_eq_mul_div, mul_comm, div_eq_mul_inv,
        mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)] }
end

/-- An angle in a right-angled triangle expressed using `arccos`, version subtracting vectors. -/
lemma angle_sub_eq_arccos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  angle x (x - y) = real.arccos (‖x‖ / ‖x - y‖) :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw [sub_eq_add_neg, angle_add_eq_arccos_of_inner_eq_zero h]
end

/-- An angle in a right-angled triangle expressed using `arcsin`, version subtracting vectors. -/
lemma angle_sub_eq_arcsin_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
  angle x (x - y) = real.arcsin (‖y‖ / ‖x - y‖) :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  nth_rewrite 1 ←neg_ne_zero at h0,
  rw [sub_eq_add_neg, angle_add_eq_arcsin_of_inner_eq_zero h h0, norm_neg]
end

/-- An angle in a right-angled triangle expressed using `arctan`, version subtracting vectors. -/
lemma angle_sub_eq_arctan_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
  angle x (x - y) = real.arctan (‖y‖ / ‖x‖) :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw [sub_eq_add_neg, angle_add_eq_arctan_of_inner_eq_zero h h0, norm_neg]
end

/-- An angle in a non-degenerate right-angled triangle is positive, version subtracting
vectors. -/
lemma angle_sub_pos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
  0 < angle x (x - y) :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw ←neg_ne_zero at h0,
  rw sub_eq_add_neg,
  exact angle_add_pos_of_inner_eq_zero h h0
end

/-- An angle in a right-angled triangle is at most `π / 2`, version subtracting vectors. -/
lemma angle_sub_le_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  angle x (x - y) ≤ π / 2 :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw sub_eq_add_neg,
  exact angle_add_le_pi_div_two_of_inner_eq_zero h
end

/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`, version subtracting
vectors. -/
lemma angle_sub_lt_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
  angle x (x - y) < π / 2 :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw sub_eq_add_neg,
  exact angle_add_lt_pi_div_two_of_inner_eq_zero h h0
end

/-- The cosine of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma cos_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  real.cos (angle x (x - y)) = ‖x‖ / ‖x - y‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw [sub_eq_add_neg, cos_angle_add_of_inner_eq_zero h]
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma sin_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
  real.sin (angle x (x - y)) = ‖y‖ / ‖x - y‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  nth_rewrite 1 ←neg_ne_zero at h0,
  rw [sub_eq_add_neg, sin_angle_add_of_inner_eq_zero h h0, norm_neg]
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma tan_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  real.tan (angle x (x - y)) = ‖y‖ / ‖x‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw [sub_eq_add_neg, tan_angle_add_of_inner_eq_zero h, norm_neg]
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side, version subtracting vectors. -/
lemma cos_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  real.cos (angle x (x - y)) * ‖x - y‖ = ‖x‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw [sub_eq_add_neg, cos_angle_add_mul_norm_of_inner_eq_zero h]
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side, version subtracting vectors. -/
lemma sin_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
  real.sin (angle x (x - y)) * ‖x - y‖ = ‖y‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw [sub_eq_add_neg, sin_angle_add_mul_norm_of_inner_eq_zero h, norm_neg]
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side, version subtracting vectors. -/
lemma tan_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
  real.tan (angle x (x - y)) * ‖x‖ = ‖y‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw ←neg_eq_zero at h0,
  rw [sub_eq_add_neg, tan_angle_add_mul_norm_of_inner_eq_zero h h0, norm_neg]
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse, version subtracting vectors. -/
lemma norm_div_cos_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
  ‖x‖ / real.cos (angle x (x - y)) = ‖x - y‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw ←neg_eq_zero at h0,
  rw [sub_eq_add_neg, norm_div_cos_angle_add_of_inner_eq_zero h h0]
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse, version subtracting vectors. -/
lemma norm_div_sin_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
  ‖y‖ / real.sin (angle x (x - y)) = ‖x - y‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw ←neg_ne_zero at h0,
  rw [sub_eq_add_neg, ←norm_neg, norm_div_sin_angle_add_of_inner_eq_zero h h0]
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side, version subtracting vectors. -/
lemma norm_div_tan_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
  ‖y‖ / real.tan (angle x (x - y)) = ‖x‖ :=
begin
  rw [←neg_eq_zero, ←inner_neg_right] at h,
  rw ←neg_ne_zero at h0,
  rw [sub_eq_add_neg, ←norm_neg, norm_div_tan_angle_add_of_inner_eq_zero h h0]
end

end inner_product_geometry

namespace euclidean_geometry

open inner_product_geometry

variables {V : Type*} {P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
include V

/-- **Pythagorean theorem**, if-and-only-if angle-at-point form. -/
lemma dist_sq_eq_dist_sq_add_dist_sq_iff_angle_eq_pi_div_two (p1 p2 p3 : P) :
  dist p1 p3 * dist p1 p3 = dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 ↔
    ∠ p1 p2 p3 = π / 2 :=
by erw [dist_comm p3 p2, dist_eq_norm_vsub V p1 p3, dist_eq_norm_vsub V p1 p2,
        dist_eq_norm_vsub V p2 p3,
        ←norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two,
        vsub_sub_vsub_cancel_right p1, ←neg_vsub_eq_vsub_rev p2 p3, norm_neg]

/-- An angle in a right-angled triangle expressed using `arccos`. -/
lemma angle_eq_arccos_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
  ∠ p₂ p₃ p₁ = real.arccos (dist p₃ p₂ / dist p₁ p₃) :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, angle_add_eq_arccos_of_inner_eq_zero h]
end

/-- An angle in a right-angled triangle expressed using `arcsin`. -/
lemma angle_eq_arcsin_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₁ ≠ p₂ ∨ p₃ ≠ p₂) : ∠ p₂ p₃ p₁ = real.arcsin (dist p₁ p₂ / dist p₁ p₃) :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [←@vsub_ne_zero V, @ne_comm _ p₃, ←@vsub_ne_zero V _ _ _ p₂, or_comm] at h0,
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, angle_add_eq_arcsin_of_inner_eq_zero h h0]
end

/-- An angle in a right-angled triangle expressed using `arctan`. -/
lemma angle_eq_arctan_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₃ ≠ p₂) : ∠ p₂ p₃ p₁ = real.arctan (dist p₁ p₂ / dist p₃ p₂) :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [ne_comm, ←@vsub_ne_zero V] at h0,
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, angle_add_eq_arctan_of_inner_eq_zero h h0]
end

/-- An angle in a non-degenerate right-angled triangle is positive. -/
lemma angle_pos_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : 0 < ∠ p₂ p₃ p₁ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [←@vsub_ne_zero V, eq_comm, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
  rw [angle, ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm],
  exact angle_add_pos_of_inner_eq_zero h h0
end

/-- An angle in a right-angled triangle is at most `π / 2`. -/
lemma angle_le_pi_div_two_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
  ∠ p₂ p₃ p₁ ≤ π / 2 :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [angle, ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm],
  exact angle_add_le_pi_div_two_of_inner_eq_zero h
end

/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`. -/
lemma angle_lt_pi_div_two_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₃ ≠ p₂) : ∠ p₂ p₃ p₁ < π / 2 :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [ne_comm, ←@vsub_ne_zero V] at h0,
  rw [angle, ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm],
  exact angle_add_lt_pi_div_two_of_inner_eq_zero h h0
end

/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
lemma cos_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
  real.cos (∠ p₂ p₃ p₁) = dist p₃ p₂ / dist p₁ p₃ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, cos_angle_add_of_inner_eq_zero h]
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
lemma sin_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₁ ≠ p₂ ∨ p₃ ≠ p₂) : real.sin (∠ p₂ p₃ p₁) = dist p₁ p₂ / dist p₁ p₃ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [←@vsub_ne_zero V, @ne_comm _ p₃, ←@vsub_ne_zero V _ _ _ p₂, or_comm] at h0,
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, sin_angle_add_of_inner_eq_zero h h0]
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
lemma tan_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
  real.tan (∠ p₂ p₃ p₁) = dist p₁ p₂ / dist p₃ p₂ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, tan_angle_add_of_inner_eq_zero h]
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side. -/
lemma cos_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
  real.cos (∠ p₂ p₃ p₁) * dist p₁ p₃ = dist p₃ p₂ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, cos_angle_add_mul_norm_of_inner_eq_zero h]
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side. -/
lemma sin_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
  real.sin (∠ p₂ p₃ p₁) * dist p₁ p₃ = dist p₁ p₂ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, sin_angle_add_mul_norm_of_inner_eq_zero h]
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side. -/
lemma tan_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₁ = p₂ ∨ p₃ ≠ p₂) : real.tan (∠ p₂ p₃ p₁) * dist p₃ p₂ = dist p₁ p₂ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [ne_comm, ←@vsub_ne_zero V, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, tan_angle_add_mul_norm_of_inner_eq_zero h h0]
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse. -/
lemma dist_div_cos_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₁ = p₂ ∨ p₃ ≠ p₂) : dist p₃ p₂ / real.cos (∠ p₂ p₃ p₁) = dist p₁ p₃ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [ne_comm, ←@vsub_ne_zero V, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, norm_div_cos_angle_add_of_inner_eq_zero h h0]
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse. -/
lemma dist_div_sin_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : dist p₁ p₂ / real.sin (∠ p₂ p₃ p₁) = dist p₁ p₃ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [eq_comm, ←@vsub_ne_zero V, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, norm_div_sin_angle_add_of_inner_eq_zero h h0]
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side. -/
lemma dist_div_tan_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
  (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : dist p₁ p₂ / real.tan (∠ p₂ p₃ p₁) = dist p₃ p₂ :=
begin
  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
  rw [eq_comm, ←@vsub_ne_zero V, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂,
      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, norm_div_tan_angle_add_of_inner_eq_zero h h0]
end

end euclidean_geometry