import tactic.linarith
import tactic.induction
import data.nat.basic
import data.list.sort
open nat

/- This lemma applies the strong induction principle on the lenght of a list. -/
@[elab_as_eliminator]
lemma list.strong_length_induction {α} {C : list α → Sort*}
  (rec : ∀ xs : list α, (∀ ys : list α, ys.length < xs.length → C ys) → C xs) :
  ∀ xs, C xs
| xs := rec xs (λ ys len, list.strong_length_induction ys)
using_well_founded { rel_tac := λ _ _, `[ exact ⟨_, measure_wf list.length ⟩]}

/- The function split takes a list α, splits it and returns the two halves in a tuple. -/
def split {α : Type} : list α → list α × list α
| xs := (list.take (xs.length/2) xs, list.drop (xs.length/2) xs)

/- This lemma proves that the first split half of a list, using the function split, is smaller in length than the original list. -/
lemma split_dec_fst {α : Type} : ∀ (x x' : α) (xs : list α),
  (split (x :: x' :: xs)).fst.length < (x :: x' :: xs).length
:=
begin
  intros x x' xs,
  simp [split],
  ring_nf,
  exact div_lt_self' (xs.length + 1) 0,
end

lemma split_dec_snd {α : Type} : ∀ (x x' : α) (xs : list α),
  ((split (x :: x' :: xs)).snd).length < ((x :: x' :: xs).length)
:=
begin
  intros x x' xs,
  rw split,
  simp,
  ring_nf,
  apply nat.sub_lt_self,
  linarith,
  norm_num,
end

/- This lemma proves that concatenating the two split halves of a list produces
   a permutation of the original list. -/
lemma split_preserves {α : Type} : ∀ (xs : list α),
  (split xs).fst ++ (split xs).snd ~ xs
:=
begin
  intros xs,
  simp [split]
end

/- The merge function takes two lists and recursively merges them into one ordered list. -/
def merge {α : Type} (lt : α → α → bool) : list α → list α → list α
| [] a              := a
| (h1::t1) []       := h1::t1
| (h1::t1) (h2::t2) :=
  if lt h1 h2
    then (h1 :: (merge t1 (h2::t2)))
    else (h2 :: (merge (h1::t1) t2))

/- This lemma proves that merging two lists together produces a list that is a permutation
   of the two input lists concatenated together. -/
lemma merge_preserves {α : Type} (lt : α → α → bool) : ∀ (as bs : list α),
  merge lt as bs ~ as ++ bs
| [] bs :=
begin
  rw merge,
  simp,
end
| (a :: as) [] :=
begin
  rw merge,
  simp,
end
| (a :: as) (b :: bs) :=
begin
  rw merge,
  by_cases hab: (lt a b : Prop),
  {
    rw [if_pos hab],
    simp,
    apply merge_preserves as (b :: bs),
  },
  {
    rw [if_neg hab],
    transitivity,
    swap,
    {
      apply list.perm_append_comm,
    },
    {
      simp,
      transitivity,
      {
        apply merge_preserves,
      },
      {
        apply list.perm_append_comm,
      }
    }
  }
end

/- The function mergeSort -/
def mergeSort {α : Type} (lt : α -> α -> bool) : list α → list α
| []             := []
| [a]            := [a]
| (a :: b :: xs) :=
  let p  := split (a :: b :: xs) in
  let as := p.fst in
  let bs := p.snd in
  let h1 : as.length < (a :: b :: xs).length := split_dec_fst _ _ _ in
  let h2 : bs.length < (a :: b :: xs).length := split_dec_snd _ _ _ in
  merge lt (mergeSort as) (mergeSort bs)
  using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf list.length⟩] }

/- This lemma proves that sorting a list using mergeSort produces a permutation
   of that list. -/
lemma mergeSort_preserves {α : Type} (lt : α -> α -> bool) : ∀ (xs : list α),
  mergeSort lt xs ~ xs
:=
begin
  intros unsorted,
  induction unsorted using list.strong_length_induction with xs ih,
  simp at ih,
  cases xs,
  case nil {
    rw mergeSort
  },
  case cons: x xs {
    cases xs,
    case nil {
      rw mergeSort,
    },
    case cons: x' xs {
      simp [mergeSort],
      transitivity,
      {
        apply merge_preserves,
      },
      {
        transitivity,
        {
          apply list.perm.append _ _,
          swap 3,
          apply ih,
          apply split_dec_fst,
          swap,
          apply ih,
          apply split_dec_snd,
        },
        {
          apply split_preserves,
        }
      }
    },
  },
end

/- This function transforms function lt to a decidable Prop. -/
def r {α : Type} (lt : α → α → bool) : α → α → Prop :=
  λ x y, lt x y = tt

/- This lemma proves that if we merge two lists using merge, all elements of
   the returned list belonged to either of the two original lists. -/
lemma element_of_merge {α : Type} (lt : α → α → bool):
 ∀ (x : α) (as bs: list α), x ∈ merge lt as bs → x ∈ as ∨ x ∈ bs
| x [] as :=
begin
  intros hx,
  rw merge at hx,
  tauto,
end
| x (a :: as) [] :=
begin
  intros has,
  rw merge at has,
  tauto,
end
| x (a :: as) (b :: bs) :=
begin
  intros hab,
  rw merge at hab,
  by_cases hf : (lt a b : Prop),
  {
    rw [if_pos hf] at hab,
    cases hab,
    {
      left,
      left,
      exact hab,
    },
    {
      have h' := element_of_merge _ _ _ hab,
      clear element_of_merge,
      cases h',
      {
        left,
        right,
        exact h',
      },
      {
        right,
        exact h',
      }
    }
  },
  {
    rw [if_neg hf] at hab,
    cases hab,
    {
      right,
      exact or.inl hab,
    },
    {
      have h' := element_of_merge _ _ _ hab,
      clear element_of_merge,
      cases h',
      {
        left,
        exact h',
      },
      {
        right,
        exact or.inr h',
      }
    }
  },
end

/- This lemma proves that, given two sorted lists, the list returned by merging
   the two lists together using merge is sorted as well. -/
lemma merge_sorted {α : Type} (lt : α → α → bool) (tr : transitive (r lt))
(ng : ∀ x y, ¬ r lt y x → r lt x y) : ∀ (as bs: list α),
  list.sorted (r lt) as →
  list.sorted (r lt) bs →
  list.sorted (r lt) (merge lt as bs)
| [] bs :=
  begin
    intros hn hbs,
    rw merge,
    exact hbs,
  end
| (a :: as) [] :=
  begin
    intros has hn,
    rw merge,
    exact has,
  end
| (a :: as) (b :: bs) :=
  begin
    intros has hbs,
    have haq : ∀ q, q ∈ as → r lt a q,
    {
      intros q hq,
      rw list.sorted at has,
      rw list.pairwise_cons at has,
      cases has with has_l has_r,
      apply has_l _ hq,
    },
    have hbq : ∀ q, q ∈ bs → r lt b q,
    {
      intros q hq,
      rw list.sorted at hbs,
      rw list.pairwise_cons at hbs,
      cases hbs with hbs_l hbs_r,
      apply hbs_l _ hq,
    },
    rw merge,
    by_cases hf : (lt a b : Prop),
    {
      rw [if_pos hf],
      simp,
      split,
      {
        intros d hm,
        have had := element_of_merge lt d as (b :: bs) hm,
        cases had,
        {
          rw list.sorted at has,
          rw list.pairwise_cons at has,
          cases has with has_l has_r,
          apply has_l _ had,
        },
        {
          simp at had,
          cases had,
          {
            subst had,
            exact hf,
          },
          {
            apply tr,
            {
              exact hf,
            },
            {
              simp at hbs,
              cases hbs with hbs_l hbs_r,
              apply hbs_l,
              exact had,
            }
          }
        }
      },
      {
        apply merge_sorted,
        {
          rw list.sorted at has,
          cases has with _ _ hpas' hpas,
          exact hpas,
        },
        {
          exact hbs,
        }
      }
    },
    {
      rw [if_neg hf],
      simp,
      split,
      {
        intros k hk,
        have hk' := element_of_merge _ _ _ _ hk,
        cases hk',
        {
          cases hk',
          {
            subst hk',
            exact ng b k hf,
          },
          {
            have fak := haq _ hk',
            have fba := ng _ _ hf,
            apply tr fba fak,
          }
        },
        {
          apply hbq _,
          exact hk',
        }
      },
      {
        apply merge_sorted,
        {
          exact has,
        },
        {
          rw list.sorted at hbs,
          cases hbs with _ _ hpbs' hpbs,
          exact hpbs,
        }
      }
    },
  end

/- This lemma proves that mergeSort returns a sorted list. -/
lemma mergeSort_sorts {α : Type} (lt : α → α → bool) (tr : transitive (r lt))
  (ng : ∀ x y, ¬ r lt y x → r lt x y) : ∀ (xs : list α),
  list.sorted (r lt) (mergeSort lt xs)
:=
begin
  intros xs,
  induction xs using list.strong_length_induction with xs ih,
  simp at ih,
  cases xs,
  case nil {
    simp [mergeSort],
  },
  case cons: x xs {
    cases xs,
    case nil {
      simp [mergeSort],
    },
    case cons: x' xs {
      simp [mergeSort],
      apply merge_sorted lt; try { assumption },
      {
        apply ih,
        apply split_dec_fst,
      },
      {
        apply ih,
        apply split_dec_snd,
      }
    }
  },
end


/-
Copyright (c) 2015 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Jeremy Avigad

The square root function.
-/
import .ivt
open analysis real classical topology
noncomputable theory

private definition sqr_lb (x : ℝ) : ℝ := 0

private theorem sqr_lb_is_lb (x : ℝ) (H : x ≥ 0) : (sqr_lb x) * (sqr_lb x) ≤ x :=
  by rewrite [↑sqr_lb, zero_mul]; assumption

private definition sqr_ub (x : ℝ) : ℝ := x + 1

private theorem sqr_ub_is_ub (x : ℝ) (H : x ≥ 0) : (sqr_ub x) * (sqr_ub x) ≥ x :=
  begin
    rewrite [↑sqr_ub, left_distrib, mul_one, right_distrib, one_mul, {x + 1}add.comm, -*add.assoc],
    apply le_add_of_nonneg_left,
    repeat apply add_nonneg,
    apply mul_nonneg,
    repeat assumption,
    apply zero_le_one
  end

private theorem lb_le_ub (x : ℝ) (H : x ≥ 0) : sqr_lb x ≤ sqr_ub x :=
  begin
    rewrite [↑sqr_lb, ↑sqr_ub],
    apply add_nonneg,
    assumption,
    apply zero_le_one
  end

private lemma sqr_cts : continuous (λ x : ℝ, x * x) := continuous_mul_of_continuous continuous_id continuous_id

definition sqrt (x : ℝ) : ℝ :=
  if H : x ≥ 0 then
    some (intermediate_value_incr_weak sqr_cts (lb_le_ub x H) (sqr_lb_is_lb x H) (sqr_ub_is_ub x H))
  else 0

private theorem sqrt_spec {x : ℝ} (H : x ≥ 0) : sqrt x * sqrt x = x ∧ sqrt x ≥ 0 :=
  begin
    rewrite [↑sqrt, dif_pos H],
    note Hs := some_spec (intermediate_value_incr_weak sqr_cts (lb_le_ub x H)
                           (sqr_lb_is_lb x H) (sqr_ub_is_ub x H)),
    cases Hs with Hs1 Hs2,
    cases Hs2 with Hs2a Hs2b,
    exact and.intro Hs2b Hs1
  end

theorem sqrt_mul_self {x : ℝ} (H : x ≥ 0) : sqrt x * sqrt x = x := and.left (sqrt_spec H)

theorem sqrt_nonneg (x : ℝ) : sqrt x ≥ 0 :=
if H : x ≥ 0 then and.right (sqrt_spec H) else by rewrite [↑sqrt, dif_neg H]; exact le.refl 0

theorem sqrt_squared {x : ℝ} (H : x ≥ 0) : (sqrt x)^2 = x :=
by krewrite [pow_two, sqrt_mul_self H]

theorem sqrt_zero : sqrt (0 : ℝ) = 0 :=
have sqrt 0 * sqrt 0 = 0, from sqrt_mul_self !le.refl,
or.elim (eq_zero_or_eq_zero_of_mul_eq_zero this) (λ H, H) (λ H, H)

theorem sqrt_squared_of_nonneg {x : ℝ} (H : x ≥ 0) : sqrt (x^2) = x :=
have sqrt (x^2)^2 = x^2, from sqrt_squared (squared_nonneg x),
eq_of_squared_eq_squared_of_nonneg (sqrt_nonneg (x^2)) H this

theorem sqrt_squared' (x : ℝ) : sqrt (x^2) = abs x :=
have x^2 = (abs x)^2, by krewrite [+pow_two, -abs_mul, abs_mul_self],
using this, by rewrite [this, sqrt_squared_of_nonneg (abs_nonneg x)]

theorem sqrt_mul {x y : ℝ} (Hx : x ≥ 0) (Hy : y ≥ 0) : sqrt (x * y) = sqrt x * sqrt y :=
have (sqrt (x * y))^2 = (sqrt x * sqrt y)^2, from calc
  (sqrt (x * y))^2 = x * y                   : by rewrite [sqrt_squared (mul_nonneg Hx Hy)]
               ... = (sqrt x)^2 * (sqrt y)^2 : by rewrite [sqrt_squared Hx, sqrt_squared Hy]
               ... = (sqrt x * sqrt y)^2     : by krewrite [*pow_two]; rewrite [*mul.assoc,
                                                           mul.left_comm (sqrt y)],
eq_of_squared_eq_squared_of_nonneg !sqrt_nonneg (mul_nonneg !sqrt_nonneg !sqrt_nonneg) this


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov,
Neil Strickland, Aaron Anderson

! This file was ported from Lean 3 source module algebra.group_with_zero.divisibility
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.GroupWithZero.Basic
import Mathbin.Algebra.Divisibility.Units

/-!
# Divisibility in groups with zero.

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

Lemmas about divisibility in groups and monoids with zero.

-/

variable {α : Type _}

section SemigroupWithZero

variable [SemigroupWithZero α] {a : α}

/- warning: eq_zero_of_zero_dvd -> eq_zero_of_zero_dvd is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemigroupWithZero.{u1} α] {a : α}, (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (SemigroupWithZero.toMulZeroClass.{u1} α _inst_1))))) a) -> (Eq.{succ u1} α a (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (SemigroupWithZero.toMulZeroClass.{u1} α _inst_1))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemigroupWithZero.{u1} α] {a : α}, (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (SemigroupWithZero.toZero.{u1} α _inst_1))) a) -> (Eq.{succ u1} α a (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (SemigroupWithZero.toZero.{u1} α _inst_1))))
Case conversion may be inaccurate. Consider using '#align eq_zero_of_zero_dvd eq_zero_of_zero_dvdₓ'. -/
theorem eq_zero_of_zero_dvd (h : 0 ∣ a) : a = 0 :=
  Dvd.elim h fun c H' => H'.trans (MulZeroClass.zero_mul c)
#align eq_zero_of_zero_dvd eq_zero_of_zero_dvd

/- warning: zero_dvd_iff -> zero_dvd_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemigroupWithZero.{u1} α] {a : α}, Iff (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (SemigroupWithZero.toMulZeroClass.{u1} α _inst_1))))) a) (Eq.{succ u1} α a (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (SemigroupWithZero.toMulZeroClass.{u1} α _inst_1))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemigroupWithZero.{u1} α] {a : α}, Iff (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (SemigroupWithZero.toZero.{u1} α _inst_1))) a) (Eq.{succ u1} α a (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (SemigroupWithZero.toZero.{u1} α _inst_1))))
Case conversion may be inaccurate. Consider using '#align zero_dvd_iff zero_dvd_iffₓ'. -/
/-- Given an element `a` of a commutative semigroup with zero, there exists another element whose
    product with zero equals `a` iff `a` equals zero. -/
@[simp]
theorem zero_dvd_iff : 0 ∣ a ↔ a = 0 :=
  ⟨eq_zero_of_zero_dvd, fun h => by
    rw [h]
    use 0
    simp⟩
#align zero_dvd_iff zero_dvd_iff

/- warning: dvd_zero -> dvd_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemigroupWithZero.{u1} α] (a : α), Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α _inst_1)) a (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (SemigroupWithZero.toMulZeroClass.{u1} α _inst_1)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemigroupWithZero.{u1} α] (a : α), Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α _inst_1)) a (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (SemigroupWithZero.toZero.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align dvd_zero dvd_zeroₓ'. -/
@[simp]
theorem dvd_zero (a : α) : a ∣ 0 :=
  Dvd.intro 0 (by simp)
#align dvd_zero dvd_zero

end SemigroupWithZero

/- warning: mul_dvd_mul_iff_left -> mul_dvd_mul_iff_left is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CancelMonoidWithZero.{u1} α] {a : α} {b : α} {c : α}, (Ne.{succ u1} α a (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1)))))))) -> (Iff (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1)))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulZeroClass.toHasMul.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1))))) a b) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulZeroClass.toHasMul.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1))))) a c)) (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1)))) b c))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CancelMonoidWithZero.{u1} α] {a : α} {b : α} {c : α}, (Ne.{succ u1} α a (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1))))) -> (Iff (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1)))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulZeroClass.toMul.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1))))) a b) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulZeroClass.toMul.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1))))) a c)) (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α (CancelMonoidWithZero.toMonoidWithZero.{u1} α _inst_1)))) b c))
Case conversion may be inaccurate. Consider using '#align mul_dvd_mul_iff_left mul_dvd_mul_iff_leftₓ'. -/
/-- Given two elements `b`, `c` of a `cancel_monoid_with_zero` and a nonzero element `a`,
 `a*b` divides `a*c` iff `b` divides `c`. -/
theorem mul_dvd_mul_iff_left [CancelMonoidWithZero α] {a b c : α} (ha : a ≠ 0) :
    a * b ∣ a * c ↔ b ∣ c :=
  exists_congr fun d => by rw [mul_assoc, mul_right_inj' ha]
#align mul_dvd_mul_iff_left mul_dvd_mul_iff_left

/- warning: mul_dvd_mul_iff_right -> mul_dvd_mul_iff_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} α] {a : α} {b : α} {c : α}, (Ne.{succ u1} α c (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1))))))))) -> (Iff (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1))))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulZeroClass.toHasMul.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1)))))) a c) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulZeroClass.toHasMul.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1)))))) b c)) (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1))))) a b))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} α] {a : α} {b : α} {c : α}, (Ne.{succ u1} α c (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (CommMonoidWithZero.toZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1))))) -> (Iff (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1))))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulZeroClass.toMul.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1)))))) a c) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulZeroClass.toMul.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1)))))) b c)) (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α (CommMonoidWithZero.toMonoidWithZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α _inst_1))))) a b))
Case conversion may be inaccurate. Consider using '#align mul_dvd_mul_iff_right mul_dvd_mul_iff_rightₓ'. -/
/-- Given two elements `a`, `b` of a commutative `cancel_monoid_with_zero` and a nonzero
  element `c`, `a*c` divides `b*c` iff `a` divides `b`. -/
theorem mul_dvd_mul_iff_right [CancelCommMonoidWithZero α] {a b c : α} (hc : c ≠ 0) :
    a * c ∣ b * c ↔ a ∣ b :=
  exists_congr fun d => by rw [mul_right_comm, mul_left_inj' hc]
#align mul_dvd_mul_iff_right mul_dvd_mul_iff_right

section CommMonoidWithZero

variable [CommMonoidWithZero α]

#print DvdNotUnit /-
/-- `dvd_not_unit a b` expresses that `a` divides `b` "strictly", i.e. that `b` divided by `a`
is not a unit. -/
def DvdNotUnit (a b : α) : Prop :=
  a ≠ 0 ∧ ∃ x, ¬IsUnit x ∧ b = a * x
#align dvd_not_unit DvdNotUnit
-/

#print dvdNotUnit_of_dvd_of_not_dvd /-
theorem dvdNotUnit_of_dvd_of_not_dvd {a b : α} (hd : a ∣ b) (hnd : ¬b ∣ a) : DvdNotUnit a b :=
  by
  constructor
  · rintro rfl
    exact hnd (dvd_zero _)
  · rcases hd with ⟨c, rfl⟩
    refine' ⟨c, _, rfl⟩
    rintro ⟨u, rfl⟩
    simpa using hnd
#align dvd_not_unit_of_dvd_of_not_dvd dvdNotUnit_of_dvd_of_not_dvd
-/

end CommMonoidWithZero

#print dvd_and_not_dvd_iff /-
theorem dvd_and_not_dvd_iff [CancelCommMonoidWithZero α] {x y : α} :
    x ∣ y ∧ ¬y ∣ x ↔ DvdNotUnit x y :=
  ⟨fun ⟨⟨d, hd⟩, hyx⟩ =>
    ⟨fun hx0 => by simpa [hx0] using hyx,
      ⟨d, mt isUnit_iff_dvd_one.1 fun ⟨e, he⟩ => hyx ⟨e, by rw [hd, mul_assoc, ← he, mul_one]⟩,
        hd⟩⟩,
    fun ⟨hx0, d, hdu, hdx⟩ =>
    ⟨⟨d, hdx⟩, fun ⟨e, he⟩ =>
      hdu
        (isUnit_of_dvd_one _
          ⟨e,
            mul_left_cancel₀ hx0 <| by
              conv =>
                  lhs
                  rw [he, hdx] <;>
                simp [mul_assoc]⟩)⟩⟩
#align dvd_and_not_dvd_iff dvd_and_not_dvd_iff
-/

section MonoidWithZero

variable [MonoidWithZero α]

/- warning: ne_zero_of_dvd_ne_zero -> ne_zero_of_dvd_ne_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : MonoidWithZero.{u1} α] {p : α} {q : α}, (Ne.{succ u1} α q (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α _inst_1))))))) -> (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α _inst_1))) p q) -> (Ne.{succ u1} α p (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α _inst_1)))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : MonoidWithZero.{u1} α] {p : α} {q : α}, (Ne.{succ u1} α q (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α _inst_1)))) -> (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (MonoidWithZero.toSemigroupWithZero.{u1} α _inst_1))) p q) -> (Ne.{succ u1} α p (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α _inst_1))))
Case conversion may be inaccurate. Consider using '#align ne_zero_of_dvd_ne_zero ne_zero_of_dvd_ne_zeroₓ'. -/
theorem ne_zero_of_dvd_ne_zero {p q : α} (h₁ : q ≠ 0) (h₂ : p ∣ q) : p ≠ 0 :=
  by
  rcases h₂ with ⟨u, rfl⟩
  exact left_ne_zero_of_mul h₁
#align ne_zero_of_dvd_ne_zero ne_zero_of_dvd_ne_zero

end MonoidWithZero


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Anatole Dedecker
-/
import topology.separation

/-!
# Extending a function from a subset

The main definition of this file is `extend_from A f` where `f : X → Y`
and `A : set X`. This defines a new function `g : X → Y` which maps any
`x₀ : X` to the limit of `f` as `x` tends to `x₀`, if such a limit exists.

This is analoguous to the way `dense_inducing.extend` "extends" a function
`f : X → Z` to a function `g : Y → Z` along a dense inducing `i : X → Y`.

The main theorem we prove about this definition is `continuous_on_extend_from`
which states that, for `extend_from A f` to be continuous on a set `B ⊆ closure A`,
it suffices that `f` converges within `A` at any point of `B`, provided that
`f` is a function to a regular space.

-/

noncomputable theory

open_locale topological_space
open filter set

variables {X Y : Type*} [topological_space X] [topological_space Y]

/-- Extend a function from a set `A`. The resulting function `g` is such that
at any `x₀`, if `f` converges to some `y` as `x` tends to `x₀` within `A`,
then `g x₀` is defined to be one of these `y`. Else, `g x₀` could be anything. -/
def extend_from (A : set X) (f : X → Y) : X → Y :=
λ x, @@lim _ ⟨f x⟩ (𝓝[A] x) f

/-- If `f` converges to some `y` as `x` tends to `x₀` within `A`,
then `f` tends to `extend_from A f x` as `x` tends to `x₀`. -/
lemma tendsto_extend_from {A : set X} {f : X → Y} {x : X}
  (h : ∃ y, tendsto f (𝓝[A] x) (𝓝 y)) : tendsto f (𝓝[A] x) (𝓝 $ extend_from A f x) :=
tendsto_nhds_lim h

lemma extend_from_eq [t2_space Y] {A : set X} {f : X → Y} {x : X} {y : Y} (hx : x ∈ closure A)
  (hf : tendsto f (𝓝[A] x) (𝓝 y)) : extend_from A f x = y :=
begin
  haveI := mem_closure_iff_nhds_within_ne_bot.mp hx,
  exact tendsto_nhds_unique (tendsto_nhds_lim ⟨y, hf⟩) hf,
end

lemma extend_from_extends [t2_space Y] {f : X → Y} {A : set X} (hf : continuous_on f A) :
  ∀ x ∈ A, extend_from A f x = f x :=
λ x x_in, extend_from_eq (subset_closure x_in) (hf x x_in)

/-- If `f` is a function to a regular space `Y` which has a limit within `A` at any
point of a set `B ⊆ closure A`, then `extend_from A f` is continuous on `B`. -/
lemma continuous_on_extend_from [regular_space Y] {f : X → Y} {A B : set X} (hB : B ⊆ closure A)
  (hf : ∀ x ∈ B, ∃ y, tendsto f (𝓝[A] x) (𝓝 y)) : continuous_on (extend_from A f) B :=
begin
  set φ := extend_from A f,
  intros x x_in,
  suffices : ∀ V' ∈ 𝓝 (φ x), is_closed V' → φ ⁻¹' V' ∈ 𝓝[B] x,
    by simpa [continuous_within_at, (closed_nhds_basis _).tendsto_right_iff],
  intros V' V'_in V'_closed,
  obtain ⟨V, V_in, V_op, hV⟩ : ∃ V ∈ 𝓝 x, is_open V ∧ V ∩ A ⊆ f ⁻¹' V',
  { have := tendsto_extend_from (hf x x_in),
    rcases (nhds_within_basis_open x A).tendsto_left_iff.mp this V' V'_in with ⟨V, ⟨hxV, V_op⟩, hV⟩,
    use [V, mem_nhds_sets V_op hxV, V_op, hV] },
  suffices : ∀ y ∈ V ∩ B, φ y ∈ V',
    from mem_sets_of_superset (inter_mem_inf_sets V_in $ mem_principal_self B) this,
  rintros y ⟨hyV, hyB⟩,
  haveI := mem_closure_iff_nhds_within_ne_bot.mp (hB hyB),
  have limy : tendsto f (𝓝[A] y) (𝓝 $ φ y) := tendsto_extend_from (hf y hyB),
  have hVy : V ∈ 𝓝 y := mem_nhds_sets V_op hyV,
  have : V ∩ A ∈ (𝓝[A] y),
    by simpa [inter_comm] using inter_mem_nhds_within _ hVy,
  exact V'_closed.mem_of_tendsto limy (mem_sets_of_superset this hV)
end

/-- If a function `f` to a regular space `Y` has a limit within a
dense set `A` for any `x`, then `extend_from A f` is continuous. -/
lemma continuous_extend_from [regular_space Y] {f : X → Y} {A : set X} (hA : dense A)
  (hf : ∀ x, ∃ y, tendsto f (𝓝[A] x) (𝓝 y)) : continuous (extend_from A f) :=
begin
  rw continuous_iff_continuous_on_univ,
  exact continuous_on_extend_from (λ x _, hA x) (by simpa using hf)
end


/-
Copyright (c) 2021 Yury Kudriashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudriashov, Malo Jaffré
-/
import analysis.convex.function

/-!
# Slopes of convex functions

This file relates convexity/concavity of functions in a linearly ordered field and the monotonicity
of their slopes.

The main use is to show convexity/concavity from monotonicity of the derivative.
-/

variables {𝕜 : Type*} [linear_ordered_field 𝕜] {s : set 𝕜} {f : 𝕜 → 𝕜}

/-- If `f : 𝕜 → 𝕜` is convex, then for any three points `x < y < z` the slope of the secant line of
`f` on `[x, y]` is less than the slope of the secant line of `f` on `[x, z]`. -/
lemma convex_on.slope_mono_adjacent (hf : convex_on 𝕜 s f)
  {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) :
  (f y - f x) / (y - x) ≤ (f z - f y) / (z - y) :=
begin
  have hxz := hxy.trans hyz,
  rw ←sub_pos at hxy hxz hyz,
  suffices : f y / (y - x) + f y / (z - y) ≤ f x / (y - x) + f z / (z - y),
  { ring_nf at this ⊢, linarith },
  set a := (z - y) / (z - x),
  set b := (y - x) / (z - x),
  have hy : a • x + b • z = y, by { field_simp, rw div_eq_iff; [ring, linarith] },
  have key, from
    hf.2 hx hz
      (show 0 ≤ a, by apply div_nonneg; linarith)
      (show 0 ≤ b, by apply div_nonneg; linarith)
      (show a + b = 1, by { field_simp, rw div_eq_iff; [ring, linarith] }),
  rw hy at key,
  replace key := mul_le_mul_of_nonneg_left key hxz.le,
  field_simp [hxy.ne', hyz.ne', hxz.ne', mul_comm (z - x) _] at key ⊢,
  rw div_le_div_right,
  { linarith },
  { nlinarith }
end

/-- If `f : 𝕜 → 𝕜` is concave, then for any three points `x < y < z` the slope of the secant line of
`f` on `[x, y]` is greater than the slope of the secant line of `f` on `[x, z]`. -/
lemma concave_on.slope_anti_adjacent (hf : concave_on 𝕜 s f) {x y z : 𝕜} (hx : x ∈ s)
  (hz : z ∈ s) (hxy : x < y) (hyz : y < z) :
  (f z - f y) / (z - y) ≤ (f y - f x) / (y - x) :=
begin
  rw [←neg_le_neg_iff, ←neg_sub_neg (f x), ←neg_sub_neg (f y)],
  simp_rw [←pi.neg_apply, ←neg_div, neg_sub],
  exact convex_on.slope_mono_adjacent hf.neg hx hz hxy hyz,
end

/-- If `f : 𝕜 → 𝕜` is strictly convex, then for any three points `x < y < z` the slope of the
secant line of `f` on `[x, y]` is strictly less than the slope of the secant line of `f` on
`[x, z]`. -/
lemma strict_convex_on.slope_strict_mono_adjacent (hf : strict_convex_on 𝕜 s f)
  {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) :
  (f y - f x) / (y - x) < (f z - f y) / (z - y) :=
begin
  have hxz := hxy.trans hyz,
  have hxz' := hxz.ne,
  rw ←sub_pos at hxy hxz hyz,
  suffices : f y / (y - x) + f y / (z - y) < f x / (y - x) + f z / (z - y),
  { ring_nf at this ⊢, linarith },
  set a := (z - y) / (z - x),
  set b := (y - x) / (z - x),
  have hy : a • x + b • z = y, by { field_simp, rw div_eq_iff; [ring, linarith] },
  have key, from
    hf.2 hx hz hxz' (div_pos hyz hxz) (div_pos hxy hxz)
      (show a + b = 1, by { field_simp, rw div_eq_iff; [ring, linarith] }),
  rw hy at key,
  replace key := mul_lt_mul_of_pos_left key hxz,
  field_simp [hxy.ne', hyz.ne', hxz.ne', mul_comm (z - x) _] at key ⊢,
  rw div_lt_div_right,
  { linarith },
  { nlinarith }
end

/-- If `f : 𝕜 → 𝕜` is strictly concave, then for any three points `x < y < z` the slope of the
secant line of `f` on `[x, y]` is strictly greater than the slope of the secant line of `f` on
`[x, z]`. -/
lemma strict_concave_on.slope_anti_adjacent (hf : strict_concave_on 𝕜 s f)
  {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) :
  (f z - f y) / (z - y) < (f y - f x) / (y - x) :=
begin
  rw [←neg_lt_neg_iff, ←neg_sub_neg (f x), ←neg_sub_neg (f y)],
  simp_rw [←pi.neg_apply, ←neg_div, neg_sub],
  exact strict_convex_on.slope_strict_mono_adjacent hf.neg hx hz hxy hyz,
end

/-- If for any three points `x < y < z`, the slope of the secant line of `f : 𝕜 → 𝕜` on `[x, y]` is
less than the slope of the secant line of `f` on `[x, z]`, then `f` is convex. -/
lemma convex_on_of_slope_mono_adjacent (hs : convex 𝕜 s)
  (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z →
    (f y - f x) / (y - x) ≤ (f z - f y) / (z - y)) :
  convex_on 𝕜 s f :=
linear_order.convex_on_of_lt hs
begin
  assume x z hx hz hxz a b ha hb hab,
  let y := a * x + b * z,
  have hxy : x < y,
  { rw [← one_mul x, ← hab, add_mul],
    exact add_lt_add_left ((mul_lt_mul_left hb).2 hxz) _ },
  have hyz : y < z,
  { rw [← one_mul z, ← hab, add_mul],
    exact add_lt_add_right ((mul_lt_mul_left ha).2 hxz) _ },
  have : (f y - f x) * (z - y) ≤ (f z - f y) * (y - x),
    from (div_le_div_iff (sub_pos.2 hxy) (sub_pos.2 hyz)).1 (hf hx hz hxy hyz),
  have hxz : 0 < z - x, from sub_pos.2 (hxy.trans hyz),
  have ha : (z - y) / (z - x) = a,
  { rw [eq_comm, ← sub_eq_iff_eq_add'] at hab,
    simp_rw [div_eq_iff hxz.ne', y, ←hab], ring },
  have hb : (y - x) / (z - x) = b,
  { rw [eq_comm, ← sub_eq_iff_eq_add] at hab,
    simp_rw [div_eq_iff hxz.ne', y, ←hab], ring },
  rwa [sub_mul, sub_mul, sub_le_iff_le_add', ← add_sub_assoc, le_sub_iff_add_le, ← mul_add,
    sub_add_sub_cancel, ← le_div_iff hxz, add_div, mul_div_assoc, mul_div_assoc, mul_comm (f x),
    mul_comm (f z), ha, hb] at this,
end

/-- If for any three points `x < y < z`, the slope of the secant line of `f : 𝕜 → 𝕜` on `[x, y]` is
greater than the slope of the secant line of `f` on `[x, z]`, then `f` is concave. -/
lemma concave_on_of_slope_anti_adjacent (hs : convex 𝕜 s)
  (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z →
    (f z - f y) / (z - y) ≤ (f y - f x) / (y - x)) : concave_on 𝕜 s f :=
begin
  rw ←neg_convex_on_iff,
  refine convex_on_of_slope_mono_adjacent hs (λ x y z hx hz hxy hyz, _),
  rw ←neg_le_neg_iff,
  simp_rw [←neg_div, neg_sub, pi.neg_apply, neg_sub_neg],
  exact hf hx hz hxy hyz,
end

/-- If for any three points `x < y < z`, the slope of the secant line of `f : 𝕜 → 𝕜` on `[x, y]` is
strictly less than the slope of the secant line of `f` on `[x, z]`, then `f` is strictly convex. -/
lemma strict_convex_on_of_slope_strict_mono_adjacent (hs : convex 𝕜 s)
  (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z →
    (f y - f x) / (y - x) < (f z - f y) / (z - y)) :
  strict_convex_on 𝕜 s f :=
linear_order.strict_convex_on_of_lt hs
begin
  assume x z hx hz hxz a b ha hb hab,
  let y := a * x + b * z,
  have hxy : x < y,
  { rw [← one_mul x, ← hab, add_mul],
    exact add_lt_add_left ((mul_lt_mul_left hb).2 hxz) _ },
  have hyz : y < z,
  { rw [← one_mul z, ← hab, add_mul],
    exact add_lt_add_right ((mul_lt_mul_left ha).2 hxz) _ },
  have : (f y - f x) * (z - y) < (f z - f y) * (y - x),
    from (div_lt_div_iff (sub_pos.2 hxy) (sub_pos.2 hyz)).1 (hf hx hz hxy hyz),
  have hxz : 0 < z - x, from sub_pos.2 (hxy.trans hyz),
  have ha : (z - y) / (z - x) = a,
  { rw [eq_comm, ← sub_eq_iff_eq_add'] at hab,
    simp_rw [div_eq_iff hxz.ne', y, ←hab], ring },
  have hb : (y - x) / (z - x) = b,
  { rw [eq_comm, ← sub_eq_iff_eq_add] at hab,
    simp_rw [div_eq_iff hxz.ne', y, ←hab], ring },
  rwa [sub_mul, sub_mul, sub_lt_iff_lt_add', ← add_sub_assoc, lt_sub_iff_add_lt, ← mul_add,
    sub_add_sub_cancel, ← lt_div_iff hxz, add_div, mul_div_assoc, mul_div_assoc, mul_comm (f x),
    mul_comm (f z), ha, hb] at this,
end

/-- If for any three points `x < y < z`, the slope of the secant line of `f : 𝕜 → 𝕜` on `[x, y]` is
strictly greater than the slope of the secant line of `f` on `[x, z]`, then `f` is strictly concave.
-/
lemma strict_concave_on_of_slope_strict_anti_adjacent (hs : convex 𝕜 s)
  (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z →
    (f z - f y) / (z - y) < (f y - f x) / (y - x)) : strict_concave_on 𝕜 s f :=
begin
  rw ←neg_strict_convex_on_iff,
  refine strict_convex_on_of_slope_strict_mono_adjacent hs (λ x y z hx hz hxy hyz, _),
  rw ←neg_lt_neg_iff,
  simp_rw [←neg_div, neg_sub, pi.neg_apply, neg_sub_neg],
  exact hf hx hz hxy hyz,
end

/-- A function `f : 𝕜 → 𝕜` is convex iff for any three points `x < y < z` the slope of the secant
line of `f` on `[x, y]` is less than the slope of the secant line of `f` on `[x, z]`. -/
lemma convex_on_iff_slope_mono_adjacent :
  convex_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y z : 𝕜⦄, x ∈ s → z ∈ s → x < y → y < z →
      (f y - f x) / (y - x) ≤ (f z - f y) / (z - y) :=
⟨λ h, ⟨h.1, λ x y z, h.slope_mono_adjacent⟩, λ h, convex_on_of_slope_mono_adjacent h.1 h.2⟩

/-- A function `f : 𝕜 → 𝕜` is concave iff for any three points `x < y < z` the slope of the secant
line of `f` on `[x, y]` is greater than the slope of the secant line of `f` on `[x, z]`. -/
lemma concave_on_iff_slope_anti_adjacent :
  concave_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y z : 𝕜⦄, x ∈ s → z ∈ s → x < y → y < z →
      (f z - f y) / (z - y) ≤ (f y - f x) / (y - x) :=
⟨λ h, ⟨h.1, λ x y z, h.slope_anti_adjacent⟩, λ h, concave_on_of_slope_anti_adjacent h.1 h.2⟩

/-- A function `f : 𝕜 → 𝕜` is strictly convex iff for any three points `x < y < z` the slope of
the secant line of `f` on `[x, y]` is strictly less than the slope of the secant line of `f` on
`[x, z]`. -/
lemma strict_convex_on_iff_slope_strict_mono_adjacent :
  strict_convex_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y z : 𝕜⦄, x ∈ s → z ∈ s → x < y → y < z →
      (f y - f x) / (y - x) < (f z - f y) / (z - y) :=
⟨λ h, ⟨h.1, λ x y z, h.slope_strict_mono_adjacent⟩,
  λ h, strict_convex_on_of_slope_strict_mono_adjacent h.1 h.2⟩

/-- A function `f : 𝕜 → 𝕜` is strictly concave iff for any three points `x < y < z` the slope of
the secant line of `f` on `[x, y]` is strictly greater than the slope of the secant line of `f` on
`[x, z]`. -/
lemma strict_concave_on_iff_slope_strict_anti_adjacent :
  strict_concave_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y z : 𝕜⦄, x ∈ s → z ∈ s → x < y → y < z →
      (f z - f y) / (z - y) < (f y - f x) / (y - x) :=
⟨λ h, ⟨h.1, λ x y z, h.slope_anti_adjacent⟩,
  λ h, strict_concave_on_of_slope_strict_anti_adjacent h.1 h.2⟩


import tactic -- for the tactics
import ring_theory.ideal.operations -- for the ideals (including product of ideals)

-- universe variable
universe u

-- let R be a ring in universe u
variables (R : Type u) [comm_ring R]

-- let V be a vector space over R (i.e. a module over R) (also in universe u)
variables (V : Type u) [add_comm_group V] [module R V]

-- the R-linear identity isomorphism `V ≃ₗ[R] V`
#check linear_equiv.refl R V --  V ≃ₗ[R] V

-- Note that this isn't the true-false statement "V is isomorphic to V",
-- it's the actual identity isomorphism V ≃ V.

namespace submodule

-- This function is in Mathlib as of Feb 2022 but
-- I don't want to change the version of mathlib
-- in the project, which I made in Jan 2022

/-- A dependent version of `submodule.span_induction`. -/
lemma span_induction'' {R : Type*} [semiring R] {M : Type*} [add_comm_monoid M] [module R M]
  {s : set M} {p : Π x, x ∈ span R s → Prop}
  (Hs : ∀ x (h : x ∈ s), p x (subset_span h))
  (H0 : p 0 (submodule.zero_mem _))
  (H1 : ∀ x hx y hy, p x hx → p y hy → p (x + y) (submodule.add_mem _ ‹_› ‹_›))
  (H2 : ∀ (a : R) x hx, p x hx → p (a • x) (submodule.smul_mem _ _ ‹_›)) {x} (hx : x ∈ span R s) :
  p x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ span R s) (hc : p x hx), hc),
  refine span_induction hx (λ m hm, ⟨subset_span hm, Hs m hm⟩) ⟨zero_mem _, H0⟩
    (λ x y hx hy, exists.elim hx $ λ hx' hx, exists.elim hy $ λ hy' hy,
    ⟨add_mem _ hx' hy', H1 _ _ _ _ hx hy⟩) (λ r x hx, exists.elim hx $ λ hx' hx,
    ⟨smul_mem _ _ hx', H2 r _ _ hx⟩)
end

end submodule

namespace ideal

/-- The equivalence relation "we're isomorphic as R-modules" on the ideals of R. -/
def s (R : Type u) [comm_ring R] : setoid (ideal R) :=
{ r := λ I J, nonempty (I ≃ₗ[R] J),
  iseqv := begin
    refine ⟨_, _, _⟩,
    { intro K,
      exact nonempty.intro (linear_equiv.refl R K) },
    { rintros I J ⟨hIJ⟩,
      exact nonempty.intro hIJ.symm },
    { rintros I J K ⟨hIJ⟩ ⟨hJK⟩,
      exact nonempty.intro (hIJ.trans hJK) },
  end }

-- The below stuff (the next 150 lines seems to be missing from mathlib; it's basic facts about
-- how isomorphism of ideals plays with multiplication of ideals.
-- It's quite advanced Lean I guess :-/ (I found it a pain to write)

variable {R}

/-- The R-linear map `J*I → K*I` induced by a linear map `e : J → K` of ideals. -/
def linear_map.rmul (I : ideal R) {J K : ideal R} (e : J →ₗ[R] K) :
  (J * I : ideal R) →ₗ[R] (K * I : ideal R) :=
{ to_fun := λ x, ⟨e ⟨x.1, mul_le_right x.2⟩, begin
    cases x with x hx,
    have h2 : x ∈ J := mul_le_right hx,
    rw (show mul_le_right hx = h2, from rfl),
    dsimp,
    rw submodule.mul_eq_span_mul_set at hx,
    revert h2,
    refine submodule.span_induction'' _ _ _ _ hx,
    { rintro x_1 ⟨r, s, hr, hs, rfl⟩ h2,
      simp only [mul_comm r s, mul_comm K I],
      convert mul_mem_mul hs (e ⟨r, hr⟩).2,
      have := e.map_smul s ⟨r, hr⟩,
      apply_fun subtype.val at this,
      exact this },
    { intro _,
      convert (K * I).zero_mem, -- simp, simp doesn't give an error
      have := e.map_zero,
      apply_fun subtype.val at this,
      exact this },
    { rintros a ha b hb,
      rw ← submodule.mul_eq_span_mul_set at ha hb,
      intros haKI hbKI,
      have haJ := (mul_le_right ha),
      have hbJ := (mul_le_right hb),
      specialize haKI haJ,
      specialize hbKI hbJ,
      rintro _,
      have := e.map_add ⟨a, haJ⟩ ⟨b, hbJ⟩,
      apply_fun subtype.val at this,
      convert (K * I).add_mem haKI hbKI },
    { rintros r b hb,
      rw ← submodule.mul_eq_span_mul_set at hb,
      intros hbKI,
      have hbJ := (mul_le_right hb),
      specialize hbKI hbJ,
      rintro _,
      have := e.map_smul r ⟨b, hbJ⟩,
      apply_fun subtype.val at this,
      convert (K * I).smul_mem r hbKI },
  end⟩,
  map_add' := begin
    rintros ⟨a, ha⟩ ⟨b, hb⟩,
    apply subtype.ext,
    have := e.map_add ⟨a, mul_le_right ha⟩ ⟨b, mul_le_right hb⟩,
    apply_fun subtype.val at this,
    exact this,
  end,
  map_smul' := begin
    rintros r ⟨a, ha⟩,
    apply subtype.ext,
    have := e.map_smul r ⟨a, mul_le_right ha⟩,
    apply_fun subtype.val at this,
    exact this,
  end }

def linear_equiv.rmul (I : ideal R) {J K : ideal R} (e : J ≃ₗ[R] K) :
  (J * I : ideal R) ≃ₗ[R] (K * I : ideal R) :=
{ inv_fun := linear_map.rmul I e.symm.to_linear_map,
  left_inv := begin
    intro x,
    simp [linear_map.rmul],
  end,
  right_inv := begin
    rintro ⟨x, hx⟩,
    simp [linear_map.rmul],
  end,
  ..linear_map.rmul I e.to_linear_map }

def linear_map.lmul (I : ideal R) {J K : ideal R} (e : J →ₗ[R] K) :
  (I * J : ideal R) →ₗ[R] (I * K : ideal R) :=
{ to_fun := λ x, ⟨e ⟨x.1, mul_le_left x.2⟩, begin
    cases x with x hx,
    have h2 : x ∈ J := mul_le_left hx,
    rw (show mul_le_left hx = h2, from rfl),
    dsimp,
    rw submodule.mul_eq_span_mul_set at hx,
    revert h2,
    refine submodule.span_induction'' _ _ _ _ hx,
    { rintro x_1 ⟨r, s, hr, hs, rfl⟩ h2,
      convert mul_mem_mul hr (e ⟨s, hs⟩).2,
      have := e.map_smul r ⟨s, hs⟩,
      apply_fun subtype.val at this,
      exact this },
    { intro _,
      convert (I * K).zero_mem, -- simp, simp doesn't give an error
      have := e.map_zero,
      apply_fun subtype.val at this,
      exact this },
    { rintros a ha b hb,
      rw ← submodule.mul_eq_span_mul_set at ha hb,
      intros haKI hbKI,
      have haJ := (mul_le_left ha),
      have hbJ := (mul_le_left hb),
      specialize haKI haJ,
      specialize hbKI hbJ,
      rintro _,
      have := e.map_add ⟨a, haJ⟩ ⟨b, hbJ⟩,
      apply_fun subtype.val at this,
      convert (I * K).add_mem haKI hbKI },
    { rintros r b hb,
      rw ← submodule.mul_eq_span_mul_set at hb,
      intros hbKI,
      have hbJ := (mul_le_left hb),
      specialize hbKI hbJ,
      rintro _,
      have := e.map_smul r ⟨b, hbJ⟩,
      apply_fun subtype.val at this,
      convert (I * K).smul_mem r hbKI },
  end⟩,
  map_add' := begin
    rintros ⟨a, ha⟩ ⟨b, hb⟩,
    apply subtype.ext,
    have := e.map_add ⟨a, mul_le_left ha⟩ ⟨b, mul_le_left hb⟩,
    apply_fun subtype.val at this,
    exact this,
  end,
  map_smul' := begin
    rintros r ⟨a, ha⟩,
    apply subtype.ext,
    have := e.map_smul r ⟨a, mul_le_left ha⟩,
    apply_fun subtype.val at this,
    exact this,
  end }

def linear_equiv.lmul (I : ideal R) {J K : ideal R} (e : J ≃ₗ[R] K) :
  (I * J : ideal R) ≃ₗ[R] (I * K : ideal R) :=
{ inv_fun := linear_map.lmul I e.symm.to_linear_map,
  left_inv := begin
    intro x,
    simp [linear_map.lmul],
  end,
  right_inv := begin
    rintro ⟨x, hx⟩,
    simp [linear_map.lmul],
  end,
  ..linear_map.lmul I e.to_linear_map }

variable (R)

/-- Being isomorphic is a congruence relation on ideals (i.e., it plays well with `*`) -/
def con : con (ideal R) :=
{ mul' := begin
    rintros I J K L ⟨eIJ⟩ ⟨eKL⟩,
    refine ⟨_⟩,
    refine (ideal.linear_equiv.rmul K eIJ).trans (linear_equiv.lmul J eKL),
  end,
  ..ideal.s R }

/-- The ideal-theoretic Picard monoid of a ring, defined as isomorphism classes of ideals. -/
abbreviation Picard_monoid := (con R).quotient

-- and because we used `con.quotient` the quotient
-- gets a monoid instance automatically
instance : monoid (Picard_monoid R) := infer_instance

/-- The ideal-theoretic definition of the Picard group -/
abbreviation Picard_group := units (Picard_monoid R)

-- the Picard group of a commutative ring is a group
instance : group (ideal.Picard_group R) := by apply_instance

end ideal


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky
-/
import algebra.tropical.lattice
import algebra.big_operators.basic
import data.list.min_max

/-!

# Tropicalization of finitary operations

This file provides the "big-op" or notation-based finitary operations on tropicalized types.
This allows easy conversion between sums to Infs and prods to sums. Results here are important
for expressing that evaluation of tropical polynomials are the minimum over a finite piecewise
collection of linear functions.

## Main declarations

* `untrop_sum`

## Implementation notes

No concrete (semi)ring is used here, only ones with inferrable order/lattice structure, to support
real, rat, ereal, and others (erat is not yet defined).

Minima over `list α` are defined as producing a value in `with_top α` so proofs about lists do not
directly transfer to minima over multisets or finsets.

-/

open_locale big_operators

variables {R S : Type*}

open tropical finset

lemma list.trop_sum [add_monoid R] (l : list R) : trop l.sum = list.prod (l.map trop) :=
begin
  induction l with hd tl IH,
  { simp },
  { simp [←IH] }
end

lemma multiset.trop_sum [add_comm_monoid R] (s : multiset R) :
  trop s.sum = multiset.prod (s.map trop) :=
quotient.induction_on s (by simpa using list.trop_sum)

lemma trop_sum [add_comm_monoid R] (s : finset S) (f : S → R) :
  trop (∑ i in s, f i) = ∏ i in s, trop (f i) :=
begin
  cases s,
  convert multiset.trop_sum _,
  simp
end

lemma list.untrop_prod [add_monoid R] (l : list (tropical R)) :
  untrop l.prod = list.sum (l.map untrop) :=
begin
  induction l with hd tl IH,
  { simp },
  { simp [←IH] }
end

lemma multiset.untrop_prod [add_comm_monoid R] (s : multiset (tropical R)) :
  untrop s.prod = multiset.sum (s.map untrop) :=
quotient.induction_on s (by simpa using list.untrop_prod)

lemma untrop_prod [add_comm_monoid R] (s : finset S) (f : S → tropical R) :
  untrop (∏ i in s, f i) = ∑ i in s, untrop (f i) :=
begin
  cases s,
  convert multiset.untrop_prod _,
  simp
end

lemma list.trop_minimum [linear_order R] (l : list R) :
  trop l.minimum = list.sum (l.map (trop ∘ coe)) :=
begin
  induction l with hd tl IH,
  { simp },
  { simp [list.minimum_cons, ←IH] }
end

lemma multiset.trop_inf [linear_order R] [order_top R] (s : multiset R) :
  trop s.inf = multiset.sum (s.map trop) :=
begin
  induction s using multiset.induction with s x IH,
  { simp },
  { simp [←IH] }
end

lemma finset.trop_inf [linear_order R] [order_top R] (s : finset S) (f : S → R) :
  trop (s.inf f) = ∑ i in s, trop (f i) :=
begin
  cases s,
  convert multiset.trop_inf _,
  simp
end

lemma trop_Inf_image [conditionally_complete_linear_order R] (s : finset S)
  (f : S → with_top R) : trop (Inf (f '' s)) = ∑ i in s, trop (f i) :=
begin
  rcases s.eq_empty_or_nonempty with rfl|h,
  { simp only [set.image_empty, coe_empty, sum_empty, with_top.cInf_empty, trop_top] },
  rw [←inf'_eq_cInf_image _ h, inf'_eq_inf, s.trop_inf],
end

lemma trop_infi [conditionally_complete_linear_order R] [fintype S] (f : S → with_top R) :
  trop (⨅ (i : S), f i) = ∑ (i : S), trop (f i) :=
by rw [infi, ←set.image_univ, ←coe_univ, trop_Inf_image]

lemma multiset.untrop_sum [linear_order R] [order_top R] (s : multiset (tropical R)) :
  untrop s.sum = multiset.inf (s.map untrop) :=
begin
  induction s using multiset.induction with s x IH,
  { simp },
  { simpa [←IH] }
end

lemma finset.untrop_sum' [linear_order R] [order_top R] (s : finset S)
  (f : S → tropical R) : untrop (∑ i in s, f i) = s.inf (untrop ∘ f) :=
begin
  cases s,
  convert multiset.untrop_sum _,
  simpa
end

lemma untrop_sum_eq_Inf_image [conditionally_complete_linear_order R] (s : finset S)
  (f : S → tropical (with_top R)) :
  untrop (∑ i in s, f i) = Inf (untrop ∘ f '' s) :=
begin
  rcases s.eq_empty_or_nonempty with rfl|h,
  { simp only [set.image_empty, coe_empty, sum_empty, with_top.cInf_empty, untrop_zero] },
  rw [←inf'_eq_cInf_image _ h, inf'_eq_inf, finset.untrop_sum'],
end

lemma untrop_sum [conditionally_complete_linear_order R] [fintype S]
  (f : S → tropical (with_top R)) :
  untrop (∑ i : S, f i) = ⨅ i : S, untrop (f i) :=
by rw [infi, ←set.image_univ, ←coe_univ, untrop_sum_eq_Inf_image]

/-- Note we cannot use `i ∈ s` instead of `i : s` here
as it is simply not true on conditionally complete lattices! -/
lemma finset.untrop_sum [conditionally_complete_linear_order R] (s : finset S)
  (f : S → tropical (with_top R)) : untrop (∑ i in s, f i) = ⨅ i : s, untrop (f i) :=
by simpa [←untrop_sum] using sum_attach.symm


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

! This file was ported from Lean 3 source module number_theory.primorial
! leanprover-community/mathlib commit 3e32bc908f617039c74c06ea9a897e30c30803c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Associated
import Mathbin.Data.Nat.Choose.Sum
import Mathbin.Data.Nat.Choose.Dvd
import Mathbin.Data.Nat.Parity
import Mathbin.Data.Nat.Prime

/-!
# Primorial

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

This file defines the primorial function (the product of primes less than or equal to some bound),
and proves that `primorial n ≤ 4 ^ n`.

## Notations

We use the local notation `n#` for the primorial of `n`: that is, the product of the primes less
than or equal to `n`.
-/

open Finset

open Nat

open BigOperators Nat

#print primorial /-
/-- The primorial `n#` of `n` is the product of the primes less than or equal to `n`.
-/
def primorial (n : ℕ) : ℕ :=
  ∏ p in filter Nat.Prime (range (n + 1)), p
#align primorial primorial
-/

-- mathport name: «expr #»
local notation x "#" => primorial x

#print primorial_pos /-
theorem primorial_pos (n : ℕ) : 0 < n# :=
  prod_pos fun p hp => (mem_filter.1 hp).2.Pos
#align primorial_pos primorial_pos
-/

#print primorial_succ /-
theorem primorial_succ {n : ℕ} (hn1 : n ≠ 1) (hn : Odd n) : (n + 1)# = n# :=
  by
  refine' prod_congr _ fun _ _ => rfl
  rw [range_succ, filter_insert, if_neg fun h => odd_iff_not_even.mp hn _]
  exact h.even_sub_one <| mt succ.inj hn1
#align primorial_succ primorial_succ
-/

#print primorial_add /-
theorem primorial_add (m n : ℕ) :
    (m + n)# = m# * ∏ p in filter Nat.Prime (Ico (m + 1) (m + n + 1)), p :=
  by
  rw [primorial, primorial, ← Ico_zero_eq_range, ← prod_union, ← filter_union, Ico_union_Ico_eq_Ico]
  exacts[zero_le _, add_le_add_right (Nat.le_add_right _ _) _,
    disjoint_filter_filter <| Ico_disjoint_Ico_consecutive _ _ _]
#align primorial_add primorial_add
-/

#print primorial_add_dvd /-
theorem primorial_add_dvd {m n : ℕ} (h : n ≤ m) : (m + n)# ∣ m# * choose (m + n) m :=
  calc
    (m + n)# = m# * ∏ p in filter Nat.Prime (Ico (m + 1) (m + n + 1)), p := primorial_add _ _
    _ ∣ m# * choose (m + n) m :=
      mul_dvd_mul_left _ <|
        prod_primes_dvd _ (fun k hk => (mem_filter.1 hk).2.Prime) fun p hp =>
          by
          rw [mem_filter, mem_Ico] at hp
          exact
            hp.2.dvd_choose_add hp.1.1 (h.trans_lt (m.lt_succ_self.trans_le hp.1.1))
              (Nat.lt_succ_iff.1 hp.1.2)

#align primorial_add_dvd primorial_add_dvd
-/

#print primorial_add_le /-
theorem primorial_add_le {m n : ℕ} (h : n ≤ m) : (m + n)# ≤ m# * choose (m + n) m :=
  le_of_dvd (mul_pos (primorial_pos _) (choose_pos <| Nat.le_add_right _ _)) (primorial_add_dvd h)
#align primorial_add_le primorial_add_le
-/

#print primorial_le_4_pow /-
theorem primorial_le_4_pow (n : ℕ) : n# ≤ 4 ^ n :=
  by
  induction' n using Nat.strong_induction_on with n ihn
  cases n; · rfl
  rcases n.even_or_odd with (⟨m, rfl⟩ | ho)
  · rcases m.eq_zero_or_pos with (rfl | hm)
    · decide
    calc
      (m + m + 1)# = (m + 1 + m)# := by rw [add_right_comm]
      _ ≤ (m + 1)# * choose (m + 1 + m) (m + 1) := (primorial_add_le m.le_succ)
      _ = (m + 1)# * choose (2 * m + 1) m := by rw [choose_symm_add, two_mul, add_right_comm]
      _ ≤ 4 ^ (m + 1) * 4 ^ m :=
        (mul_le_mul' (ihn _ <| succ_lt_succ <| (lt_add_iff_pos_left _).2 hm)
          (choose_middle_le_pow _))
      _ ≤ 4 ^ (m + m + 1) := by rw [← pow_add, add_right_comm]

  · rcases Decidable.eq_or_ne n 1 with (rfl | hn)
    · decide
    ·
      calc
        (n + 1)# = n# := primorial_succ hn ho
        _ ≤ 4 ^ n := (ihn n n.lt_succ_self)
        _ ≤ 4 ^ (n + 1) := pow_le_pow_of_le_right four_pos n.le_succ

#align primorial_le_4_pow primorial_le_4_pow
-/


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

Given a finite poset `P`, we define `upper P` to be the set of
subsets `U ⊆ P` that are closed upwards.  We order this by
*reverse* inclusion, to ensure that the map
`u : p ↦ {x : p ≤ x}` is a morphism of posets.  We prove that
`upper P` is a bounded distributive lattice with this order.
-/

import poset.basic order.bounded order.lattice

universes uP uQ uR uS

variables (P : Type uP) [decidable_eq P] [fintype P]
variables [partial_order P] [decidable_rel (has_le.le : P → P → Prop)]

namespace poset

variable {P}
def is_upper : finset P → Prop :=
 λ (U : finset P), ∀ (p₀ p₁ : P), (p₀ ≤ p₁) → (p₀ ∈ U) → (p₁ ∈ U)
variable (P)

instance is_upper_decidable (U : finset P) : decidable (is_upper U) :=
  by { dsimp[is_upper], apply_instance }

lemma is_upper_empty : is_upper (@finset.empty P) :=
 λ p₀ p₁ hp hU, (finset.not_mem_empty p₀ hU).elim

lemma is_upper_univ : is_upper (@finset.univ P _) :=
  λ p₀ p₁ hp hU, (finset.mem_univ p₁)

variable {P}

lemma is_upper_union (U V : finset P) (hU : is_upper U) (hV : is_upper V) :
  is_upper (U ∪ V) :=
   λ p₀ p₁ hp hpUV,
  begin
   rcases (finset.mem_union.mp hpUV) with hpU | hpV,
   {exact finset.mem_union_left  V (hU p₀ p₁ hp hpU)},
   {exact finset.mem_union_right U (hV p₀ p₁ hp hpV)},
  end

lemma is_upper_inter (U V : finset P) (hU : is_upper U) (hV : is_upper V) :
  is_upper (U ∩ V) :=
   λ p₀ p₁ hp hpUV,
  begin
   replace hpUV := finset.mem_inter.mp  hpUV,
   apply finset.mem_inter.mpr,
   split,
   {exact (hU p₀ p₁ hp hpUV.left)},
   {exact (hV p₀ p₁ hp hpUV.right)},
  end

def distrib (U V W : finset P) :
 U ∩ (V ∪ W) ⊆ (U ∩ V) ∪ (U ∩ W) :=
begin
 intros A h,
 rw[finset.mem_inter,finset.mem_union] at h,
 rw[finset.mem_union,finset.mem_inter,finset.mem_inter],
 rcases h with ⟨hU,hV | hW⟩,
 exact or.inl ⟨hU,hV⟩,
 exact or.inr ⟨hU,hW⟩
end

variable (P)

def upper := { U : finset P // is_upper U }

namespace upper

instance : fintype (upper P) :=
by {dsimp [upper], apply_instance}

/-- To print an upper set, ignore the upperness property and
  just print the underlying set.
-/
instance [has_repr P] : has_repr (upper P) := ⟨λ U, repr U.val⟩

variable {P}
def els (U : upper P) : Type* := {p // p ∈ U.val}
variable (P)

instance els_order (U : upper P) : partial_order U.els :=
by { unfold els, apply_instance }

instance : has_mem P (upper P) := ⟨λ p  U, p ∈ U.val⟩

/-- Two upper sets are equal iff they have the same elements. -/
@[ext] lemma ext (U₀ U₁ : upper P) :
  (∀ (p : P), p ∈ U₀ ↔ p ∈ U₁) → U₀ = U₁ :=
begin
  intro h,
  apply subtype.eq,
  ext p,
  exact h p
end

/-- upper P has a natural structure as a bounded distributive lattice.
-/
instance dl : distrib_lattice (upper P) := {
  le := λ U V, V.val ⊆ U.val,
  le_refl := λ U, le_refl U.val,
  le_antisymm := λ U V (h0 : V.val ⊆ U.val) (h1 : U.val ⊆ V.val),
                   begin apply subtype.eq, exact le_antisymm h1 h0, end,
  le_trans := λ U V W (h0 : V.val ⊆ U.val) (h1 : W.val ⊆ V.val),
                 @le_trans (finset P) _ W.val V.val U.val h1 h0,
  inf := λ U V, ⟨U.val ∪ V.val,
                is_upper_union U.val V.val U.property V.property⟩,
  sup := λ U V, ⟨U.val ∩ V.val,
                is_upper_inter U.val V.val U.property V.property⟩,
  le_sup_left  := λ U V,finset.inter_subset_left  U.val V.val,
  le_sup_right := λ U V,finset.inter_subset_right U.val V.val,
  sup_le := λ U V W
             (U_le_W : W.val ⊆ U.val)
             (V_le_W : W.val ⊆ V.val),
             finset.subset_inter U_le_W V_le_W,
  inf_le_left  := λ U V,finset.subset_union_left  U.val V.val,
  inf_le_right := λ U V,finset.subset_union_right U.val V.val,
  le_inf := λ U V W
             (U_le_V : V.val ⊆ U.val)
             (U_le_W : W.val ⊆ U.val),
             finset.union_subset U_le_V U_le_W,
  le_sup_inf := λ U V W A h,
    distrib U.val V.val W.val h,
}

instance bo : bounded_order (upper P) := {
  bot := ⟨finset.univ,is_upper_univ P⟩,
  top := ⟨finset.empty,is_upper_empty P⟩,
  bot_le := λ U,finset.subset_univ U.val,
  le_top := λ U,finset.empty_subset U.val
}

variable {P}

lemma mem_bot (p : P) : p ∈ (⊥ : upper P) := finset.mem_univ p

lemma not_mem_top (p : P) : p ∉ (⊤ : upper P) := finset.not_mem_empty p

lemma mem_inf {U V : upper P} (p : P) : p ∈ U ⊓ V ↔ (p ∈ U ∨ p ∈ V) :=
  finset.mem_union

lemma mem_sup {U V : upper P} (p : P) : p ∈ U ⊔ V ↔ (p ∈ U ∧ p ∈ V) :=
  finset.mem_inter

/-
 We embed `P` in `upper P` using the map `u : A ↦ { B : A ⊆ B }`
-/

def u : poset.hom P (upper P) :=
 ⟨λ p, ⟨finset.univ.filter (λ q, p ≤ q),
  begin intros q r hqr hpq,
   replace hpq := (finset.mem_filter.mp hpq).right,
   exact finset.mem_filter.mpr ⟨finset.mem_univ r,le_trans hpq hqr⟩,
  end
 ⟩, λ p₀ p₁ h q q_in_up₀,
  begin
   have : p₀ ≤ q := le_trans h (finset.mem_filter.mp q_in_up₀).right,
   exact finset.mem_filter.mpr ⟨finset.mem_univ q, this⟩
  end⟩

lemma mem_u (p q : P) : p ∈ (@u P _ _ _ _ q) ↔ q ≤ p :=
begin
  change p ∈ finset.filter _ _ ↔ q ≤ p,
  simp [finset.mem_filter, finset.mem_univ]
end

end upper

end poset


import topology.instances.real

/-!
# Some helpful lemmas for (products of) intervals.
-/

variables {X : Type _} [topological_space X]

lemma frontier_snd_le (a : ℝ) : frontier {x : X × ℝ | x.snd ≤ a} = (set.univ : set X).prod {a} :=
calc frontier {x : X × ℝ | x.snd ≤ a}
      = frontier ((set.univ : set X).prod (set.Iic a)) :
        congr_arg _ $ by { ext, simp }
  ... = (set.univ : set X).prod {a} :
        by rw [frontier_univ_prod_eq, frontier_Iic]

lemma mem_frontier_snd_le (a : ℝ) (y : X × ℝ) : y ∈ frontier {x : X × ℝ | x.snd ≤ a} ↔ y.2 = a :=
begin
  rw frontier_snd_le,
  split,
  { rintros ⟨-, ha⟩,
    rwa set.mem_singleton_iff at ha },
  { intro ha,
    split,
    { simp },
    { simp [ha] } }
end

lemma frontier_fst_le (a : ℝ) : frontier {x : ℝ × X | x.fst ≤ a} = ({a} : set ℝ).prod (set.univ) :=
calc frontier {x : ℝ × X | x.fst ≤ a}
      = frontier ((set.Iic a).prod set.univ) : congr_arg _ $ by { ext, simp }
  ... = ({a} : set ℝ).prod (set.univ) : by rw [frontier_prod_univ_eq, frontier_Iic]

lemma mem_frontier_fst_le (a : ℝ) (y : ℝ × X) : y ∈ frontier {x : ℝ × X | x.fst ≤ a} ↔ y.1 = a :=
begin
  rw frontier_fst_le,
  split,
  { rintros ⟨ha, -⟩,
    rwa set.mem_singleton_iff at ha },
  { intro ha,
    split,
    { simp [ha] },
    { simp } }
end


theorem le_of_succ_le_succ (a b : mynat) : succ a ≤ succ b → a ≤ b :=
begin
intro h,
cases h with d hd,
use d,
apply succ_inj,
rw ← succ_add,
exact hd,
end


/-
Copyright (c) 2021 Gabriel Moise. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Gabriel Moise.
-/

import data.complex.basic
import data.complex.module
import data.fintype.basic
import data.real.basic
import linear_algebra.matrix

/-!
# Symmetric Matrices
This module defines symmetric matrices, together with key properties about their eigenvalues & eigenvectors.
It uses a more restrictive definition of eigenvalues & eigenvectors, together with helping lemmas for vector-matrix
operations and tools for complex numbers/vectors.
TODO : make the eigen-definitions consistent with the ones already defined in linear_algebra.eigenspace
## Main definitions
* `vec_conj x` - the complex conjugate of a complex vector `x`
* `vec_re x` - the vector containing the real parts of elements from x
* `vec_im x` - the vector containing the imaginary parts of elements from x
* `has_eigenpair M μ x` - matrix `M` has non-zero eigenvector `x` with corresponding eigenvalue `μ`
* `has_eigenvector M x` - matrix `M` has non-zero eigenvector `x`
* `has_eigenvalue M μ`  - matrix `M` has eigenvalue `μ`
* `symm_matrix M` - `M` is a symmetric matrix
## Main statements
1. If x is an eigenvector of matrix M, then a • x is an eigenvector of M, for any non-zero a : ℂ.
2. If there are two eigenvectors of M that have the same correspoding eigenvalue, then any linear combination of them
is also an eigenvector of M with the same eigenvalue μ.
3. All eigenvalues of a symmetric real matrix M are real.
4. For every real eigenvalue of a symmetric matrix M, there exists a corresponding real-valued eigenvector.
5. If v and w are eigenvectors of a symmetric matrix M with different eigenvalues, then v and w are orthogonal.
## References
<https://www.doc.ic.ac.uk/~ae/papers/lecture05.pdf>
<https://sharmaeklavya2.github.io/theoremdep/nodes/linear-algebra/eigenvectors/real-matrix-with-real-eigenvalue-has-real-eigenvectors.html>
-/

open_locale matrix big_operators complex_conjugate
open fintype finset matrix complex

set_option trace.simplify.rewrite true

universes u
variables {α : Type u}
variables {m n : Type*} [fintype m] [fintype n]

lemma name1 (f : n → α) : (λ x : n, f x) = f :=
begin
  ext,
  refl,
end

lemma vec_eq_unfold (x y : n → α) : (λ i : n, x i) = (λ i : n, y i) ↔ ∀ i : n, x i = y i :=
begin
  split,
  { intros hyp i, exact congr_fun hyp i },
  { intro hyp, ext, apply hyp }
end

-- ## Coercions
instance : has_coe (n → ℝ) (n → ℂ) := ⟨λ x, (λ i, ⟨x i, 0⟩)⟩
instance : has_coe (matrix m n ℝ) (matrix m n ℂ) := ⟨λ M, (λ i j, ⟨M i j, 0⟩)⟩

-- ## Lemmas on ℂ

lemma conj_of_zero_im {μ : ℂ} (H_im : μ.im = 0) : conj μ = μ :=
by { ext; simp only [conj_re, conj_im, H_im, neg_zero] }

lemma sum_complex_re {x : n → ℂ} : (∑ i : n, x i).re = ∑ i : n, (x i).re := by exact complex.re_lm.map_sum

lemma sum_complex_im {x : n → ℂ} : (∑ i : n, x i).im = ∑ i : n, (x i).im := by exact complex.im_lm.map_sum

-- The real and complex parts of a complex vector
def vec_re (x : n → ℂ) : n → ℝ := λ i : n, (x i).re
def vec_im (x : n → ℂ) : n → ℝ := λ i : n, (x i).im

-- Defining the complex conjugate of a complex vector
section vec_conj

def vec_conj (x : n → ℂ) : n → ℂ := λ i : n, conj (x i)

-- (μ • x)* = μ* • x*
lemma vec_conj_smul (μ : ℂ) (x : n → ℂ) :
  vec_conj (μ • x) = (conj μ) • (vec_conj x) :=
by {  ext i; rw vec_conj; rw vec_conj; simp }

-- ↑A i j = ↑(A i j)
lemma coe_matrix_coe_elem (i : m) (j : n) (A : matrix m n ℝ) : (A : matrix m n ℂ) i j = ↑(A i j) := by exact rfl

-- (A ⬝ x)* = A ⬝ x*
lemma vec_conj_mul_vec [decidable_eq n] [nonempty n] (A : matrix m n ℝ) (x : n → ℂ) :
  vec_conj ((A : matrix m n ℂ).mul_vec x) = (A : matrix m n ℂ).mul_vec (vec_conj x) :=
begin
  ext,
  simp only [vec_conj, mul_vec, dot_product, conj_re, coe_matrix_coe_elem, sum_complex_re, mul_re, of_real_im, zero_mul],
  simp only [vec_conj, mul_vec, dot_product, conj_im, coe_matrix_coe_elem, sum_complex_im, mul_im, add_zero, of_real_im,
    zero_mul, sum_neg_distrib, mul_neg_eq_neg_mul_symm]
end

lemma vec_norm_sq_zero {x : n → ℂ} (H_dot : dot_product (vec_conj x) x = 0) : x = 0 :=
begin
  unfold dot_product at H_dot,
  simp only [vec_conj, mul_comm, mul_conj, complex.ext_iff, sum_complex_re, zero_re, of_real_re] at H_dot,
  cases H_dot with H_re H_im,
  have key : ∑ i in (univ : finset n), norm_sq (x i) = 0 ↔ ∀ i ∈ (univ : finset n), norm_sq(x i) = 0,
  { apply sum_eq_zero_iff_of_nonneg, intros i h_univ, exact norm_sq_nonneg (x i) },
  simp only [forall_prop_of_true, mem_univ, monoid_with_zero_hom.map_eq_zero] at key,
  rw key at H_re,
  ext i;
  { specialize H_re i, simp only [H_re, pi.zero_apply] }
end

lemma coe_vec_re (x : n → ℂ) {i : n} : (vec_re x : n → ℂ) i = ((x i).re : ℂ) :=
by simpa only [vec_re]

lemma vec_add_conj_eq_two_re (x : n → ℂ) : x + vec_conj x = (2 : ℂ) • (vec_re x : n → ℂ) :=
begin
  ext,
  { simp [vec_conj, coe_vec_re x], linarith },
  { simp [vec_conj, coe_vec_re x] }
end

lemma vec_conj_add_zero {x : n → ℂ} (H : x + vec_conj x = 0) : vec_re x = 0 :=
begin
  rw [vec_add_conj_eq_two_re, smul_eq_zero] at H,
  cases H with H_20 H_x,
  { exfalso, simp at H_20, assumption }, -- 2 = 0
  { rw function.funext_iff at H_x,
    ext i,
    specialize H_x i,
    rw coe_vec_re at H_x,
    simp only [of_real_eq_zero, pi.zero_apply] at H_x,
    simp only [vec_re, H_x, pi.zero_apply] }
end

end vec_conj

namespace matrix

variables (M : matrix n n ℝ)

def Coe (M : matrix m n ℝ) := (M : matrix m n ℂ)

/--
## Matrix definitions
Let `M` be a square real matrix. An `eigenvector` of `M` is a complex vector `x` with `M ⬝ x = μ • x`
for some `μ ∈ ℂ`, which is called the `eigenvalue` of `M` corresponding to the `eigenvector x`.
-/
def has_eigenpair (μ : ℂ) (x : n → ℂ) : Prop :=
  x ≠ 0 ∧ (mul_vec M.Coe x = μ • x)

def has_eigenvector (x : n → ℂ) : Prop :=
  ∃ μ : ℂ, M.has_eigenpair μ x

def has_eigenvalue (μ : ℂ) : Prop :=
  ∃ x : n → ℂ, M.has_eigenpair μ x

def symm_matrix : Prop := M = Mᵀ

-- ## Matrix : Helping lemmas

-- (↑M)ᵀ = ↑Mᵀ
lemma coe_transpose_matrix : (M.Coe)ᵀ = (Mᵀ).Coe := by { unfold Coe, ext, tidy }

-- ↑M i j = ↑(M i j)
lemma coe_matrix_coe_elem (i j : n) : (M.Coe) i j = ↑(M i j) := by exact rfl

-- (M x)* = M x*
lemma vec_conj_mul_vec_re (x : n → ℂ) :
  vec_conj (mul_vec M.Coe x) = mul_vec (M.Coe) (vec_conj x) :=
begin
  ext ;
  simp only [vec_conj, mul_vec, dot_product, coe_matrix_coe_elem],
  { simp only [sum_complex_re, of_real_im, zero_mul, conj_re, mul_re] },
  { simp only [sum_complex_im, add_zero, of_real_im, zero_mul,
               sum_neg_distrib, conj_im, mul_neg_eq_neg_mul_symm, mul_im] },
end

lemma symm_matrix_coe (H_symm : symm_matrix M) : (M.Coe) = (M.Coe)ᵀ :=
begin
  unfold symm_matrix at H_symm,
  rw [coe_transpose_matrix, ← H_symm]
end

-- vᵀ (M w) = (vᵀ M)ᵀ w
lemma dot_product_mul_vec_vec_mul (v w : n → ℂ) :
  dot_product v (mul_vec M.Coe w) = dot_product (vec_mul v M.Coe) w :=
begin
  have key : vec_mul v M.Coe = λ j, dot_product v (λ i, M.Coe i j),
  { ext ; unfold vec_mul },
  rw [key, dot_product_assoc],
  ext ; simp only [dot_product, mul_vec],
end

-- 1. If x is an eigenvector of M, then a • x is an eigenvector of M, for any non-zero a : ℂ.
theorem has_eigenvector_smul (a : ℂ) (x : n → ℂ) (H_na : a ≠ 0) (H_eigenvector : has_eigenvector M x) :
  has_eigenvector M (a • x) :=
begin
  rcases H_eigenvector with ⟨μ, ⟨H_nx, H_mul⟩⟩,
  use μ, -- corresponding eigenvalue μ
  split,
  { intro hyp, rw smul_eq_zero at hyp, tauto }, -- a • x ≠ 0
  calc (M.Coe).mul_vec (a • x)
      = a • M.Coe.mul_vec x : -- M ⬝ (a • x) = a • (M ⬝ x)
  by { rw mul_vec_smul_assoc }
  ... = a • (μ • x) :                 -- ... = a • (μ • x)
  by { rw H_mul }
  ... = μ • (a • x) :                 -- ... = μ • (a • x)
  by { simp only [smul_smul, mul_comm] }
end

-- 2. If there are two eigenvectors that have the same correspoding eigenvalue μ,
-- then any non-zero linear combination of them is also an eigenvector with the same eigenvalue μ.
theorem has_eigenpair_linear (a b : ℂ) (v w : n → ℂ) (μ : ℂ) (H_ne : a • v + b • w ≠ 0)
(H₁ : has_eigenpair M μ v) (H₂ : has_eigenpair M μ w) : has_eigenpair M μ (a • v + b • w) :=
begin
  rcases H₁ with ⟨H₁₁, H₁₂⟩,
  rcases H₂ with ⟨H₂₁, H₂₂⟩,
  use H_ne, -- a • v + b • w ≠ 0
  calc M.Coe.mul_vec (a • v + b • w) -- M ⬝ (a • v + b • w) = M ⬝ (a • v) + M ⬝ (b • w)
      = M.Coe.mul_vec(a • v) + M.Coe.mul_vec(b • w) :
  by { ext ; simp only [mul_vec, pi.add_apply, dot_product_add] }
  ... = a • M.Coe.mul_vec v + b • M.Coe.mul_vec w :  -- ... = a • (M ⬝ v) + b • (M ⬝ w)
  by { ext ; simp only [mul_vec, algebra.id.smul_eq_mul,
                        dot_product_smul, pi.add_apply, pi.smul_apply] }
  ... = a • (μ • v) + b • (μ • w) :                  -- ... = a • (μ • v) + b • (μ • w)
  by { rw [H₁₂, H₂₂] }
  ... = μ • (a • v + b • w) :                        -- ... = μ • (a • v + b • w)
  by { simp only [smul_smul, mul_comm, smul_add] }
end

-- 3. All eigenvalues of a symmetric real matrix M are real.
theorem symm_matrix_real_eigenvalues (H_symm : symm_matrix M) :
  ∀ (μ : ℂ), has_eigenvalue M μ → μ.im = 0 :=
begin
  -- (1) M ⬝ x = μ • x
  rintro μ ⟨x, ⟨H_x, H_eq₁⟩⟩,
  -- (2) M ⬝ x* = μ* • x*
  have H_eq₂ : mul_vec M.Coe (vec_conj x) = (conj μ) • (vec_conj x),
  { rw [← vec_conj_smul μ x, ← M.vec_conj_mul_vec_re x, H_eq₁] },
  -- (3) μ ((x*)ᵀ x) = μ* ((x*)ᵀ x)
  have H_eq₃ : μ * (dot_product (vec_conj x) x) = conj μ * dot_product (vec_conj x) x,

  calc μ * dot_product (vec_conj x) x
      = dot_product (vec_conj x) (μ • x) :    -- μ ((x*)ᵀ x) = (x*)ᵀ (μ x)
  by { simp [dot_product, vec_conj, ← mul_assoc, mul_comm], rw mul_sum, simp [mul_assoc]}
  ... = dot_product (vec_conj x) (M.Coe.mul_vec x) :  -- ... = (x*)ᵀ (M x)
  by { rw ← H_eq₁ }
  ... = dot_product (M.Coe.vec_mul (vec_conj x)) x :  -- ... = ((x*)ᵀ M) x
  by { rw dot_product_mul_vec }
  ... = dot_product (M.Coeᵀ.mul_vec (vec_conj x)) x : -- ... = (Mᵀ x*)ᵀ x
  by { rw ← mul_vec_transpose M.Coe (vec_conj x) }
  ... = dot_product (M.Coe.mul_vec (vec_conj x)) x :  -- ... = (M x*)ᵀ x
  by { have H : M.Coe = M.Coeᵀ, apply symm_matrix_coe, exact H_symm, rw ← H }
  ... = dot_product (conj μ • vec_conj x) x :         -- ... = (μ* x*)ᵀ x
  by { rw H_eq₂ }
  ... = conj μ * dot_product (vec_conj x) x :         -- ... = μ* ((x*)ᵀ x)
  by { simp },

  -- (4) (μ - μ*) ((x*)ᵀ x) = 0
  have H_eq₄ : (μ - conj μ) * dot_product (vec_conj x) x = 0,
  { rw sub_mul, simp only [H_eq₃, sub_self] },
  -- μ - μ* = 0 ∨ (x*)ᵀ x = 0
  rw mul_eq_zero at H_eq₄,
  cases H_eq₄ with H_μ H_prod,
  { rw [sub_eq_zero, eq_comm, eq_conj_iff_real] at H_μ,
    cases H_μ with r H_r,
    rw [H_r, of_real_im] }, -- μ - μ* = 0
  { exfalso,
    exact H_x (vec_norm_sq_zero H_prod) }, -- (x*)ᵀ x = 0
end

-- 4. For every real eigenvalue of a symmetric matrix M, there exists a corresponding real-valued eigenvector.
theorem symm_matrix_real_eigenvectors (H_symm : symm_matrix M) (μ : ℂ) (H_eigenvalue : has_eigenvalue M μ) :
  ∃ x : n → ℂ, has_eigenpair M μ x ∧ vec_im x = 0 :=
begin
  -- We know that μ ∈ ℝ from before.
  have H_μ : μ.im = 0,
  { apply M.symm_matrix_real_eigenvalues H_symm μ H_eigenvalue },
  rcases H_eigenvalue with ⟨x, ⟨H_nx, H_mul⟩⟩,
  by_cases H_re : vec_re x = 0,
  -- 1) I • x will be used
  { use (I • x),
    split,
    -- 1.1) I • x is an eigenvector
    { split,
      -- 1.1.1) I • x ≠ 0
      { intro hyp, rw smul_eq_zero at hyp,
        have H_nI : I ≠ 0, { exact I_ne_zero },
        tauto },
      -- 1.1.2) M (I • x) = μ • (I • x)
      { simp only [mul_vec_smul_assoc, H_mul, smul_smul, mul_comm] } },
    -- 1.2) I • x ∈ ℝⁿ
    { ext i,
      simp only [vec_re, vec_eq_unfold] at H_re,
      simp only [vec_im, algebra.id.smul_eq_mul, I_re, one_mul,
                 I_im, zero_mul, mul_im, zero_add, pi.smul_apply],
      exact H_re i } },
  -- 2) x + x* will be used
  { use (x + vec_conj x),
    split,
    -- 2.1) x + x* is an eigenvector
    { split,
      -- 2.1.1) x + x* ≠ 0
      { intro hyp, exact H_re (vec_conj_add_zero hyp) },
      -- 2.1.2) M (x + x*) = μ • (x + x*)
      { calc M.Coe.mul_vec (x + vec_conj x)
            = M.Coe.mul_vec x + M.Coe.mul_vec (vec_conj x) :
        by { apply mul_vec_add } -- M (x + x*) = M x + M x*
        ... = M.Coe.mul_vec x + vec_conj (M.Coe.mul_vec x) :
        by { rw ← M.vec_conj_mul_vec_re x }     -- ... = M x + (M x)*
        ... = μ • x + vec_conj (μ • x) :
        by { rw H_mul }                         -- ... = μ • x + (μ • x)*
        ... = μ • x + (conj μ) • (vec_conj x) :
        by { rw vec_conj_smul }                 -- ... = μ • x + μ* • x*
        ... = μ • x + μ • (vec_conj x) :
        by { rw conj_of_zero_im H_μ }           -- ... = μ • x + μ • x*
        ... = μ • (x + vec_conj x) :
        by { simp only [smul_add] } } },        -- ... = μ • (x + x*)
    -- 2.2) x + x* ∈ ℝⁿ
    { ext, simp [vec_add_conj_eq_two_re, vec_im, coe_vec_re] } }
end

-- 5. If v and w are eigenvectors of a symmetric matrix M with different eigenvalues, then v and w are orthogonal.
theorem dot_product_neq_eigenvalue_zero (H_symm : symm_matrix M) (v w : n → ℂ) (μ μ' : ℂ)
(H_ne : μ ≠ μ') (H₁ : has_eigenpair M μ v) (H₂ : has_eigenpair M μ' w) : dot_product v w = 0 :=
begin
  have key : (μ - μ') * dot_product v w = 0,
  calc (μ - μ') * dot_product v w
      = μ * dot_product v w - μ' * dot_product v w :
  by { apply mul_sub_right_distrib }-- (μ - μ')vᵀ w = μ(vᵀ w) - μ'(vᵀ w)
  ... = dot_product (μ • v) w - dot_product v (μ' • w) :
  by { simp only [dot_product_smul,
       smul_dot_product]; simp }                   -- ... = (μ • v)ᵀw - vᵀ(μ' • w)
  ... = dot_product (M.Coe.mul_vec v) w - dot_product v (M.Coe.mul_vec w) :
  by { rw [H₁.2, H₂.2] }                     -- ... = (M v)ᵀw - vᵀ(M w)
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (vec_mul v M.Coe) w :
  by { rw M.dot_product_mul_vec_vec_mul v w }-- ... = (M v)ᵀw - (vᵀ M)ᵀw
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (vec_mul v M.Coeᵀ) w:
  by { rw ← symm_matrix_coe M H_symm }  -- ... = (M v)ᵀw - (vᵀ Mᵀ)ᵀw
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (mul_vec M.Coe v) w :
  by { rw ← vec_mul_transpose M.Coe v }       -- ... = (M v)ᵀw - (M v)ᵀw
  ... = 0 :
  by { simp only [sub_self] },               -- ... = 0
  rw mul_eq_zero at key,
  cases key with H_μ H_dot,
  { exfalso, rw sub_eq_zero at H_μ, exact H_ne H_μ }, -- μ - μ' = 0
  { exact H_dot } -- vᵀ w = 0
end

-- TODOs :
-- 1. positive semidefinite matrices
-- 2. eigenvalues = roots of characteristic polynomial (char_poly)
-- 3. eigendecomposition of a diagonalizable matrix

end matrix


import linear_algebra.finite_dimensional

open finite_dimensional

variables {𝕜 : Type*} [field 𝕜]
          {E : Type*} [add_comm_group E] [module 𝕜 E]
          {E' : Type*} [add_comm_group E'] [module 𝕜 E']

lemma two_le_rank_of_rank_lt_rank [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 E']
  {π : E →ₗ[𝕜] 𝕜} (hπ : π.ker ≠ ⊤) (h : finrank 𝕜 E < finrank 𝕜 E') (φ : E →ₗ[𝕜] E') :
  2 ≤ module.rank 𝕜 (E' ⧸ submodule.map φ π.ker) :=
begin
  suffices : 2 ≤ finrank 𝕜 (E' ⧸ π.ker.map φ),
  { rw ← finrank_eq_dim,
    exact_mod_cast this },
  apply le_of_add_le_add_right,
  rw submodule.finrank_quotient_add_finrank (π.ker.map φ),
  have := calc finrank 𝕜 (π.ker.map φ)
        ≤ finrank 𝕜 π.ker : finrank_map_le 𝕜 φ π.ker
    ...  < finrank 𝕜 E : submodule.finrank_lt (le_top.lt_of_ne hπ),
  linarith,
end


theorem mul_eq_zero_iff (a b : ℕ): a * b = 0 ↔ a = 0 ∨ b = 0 :=
begin
    split,
    intro h,
    apply nat.eq_zero_of_mul_eq_zero,
    exact h,

    intro f,
    cases f with a b,
    rw a,
    rw nat.zero_mul,
    rw b,
    rw nat.mul_zero,
end


--- https://www.codewars.com/kata/5d64d9c0a5aad20001b2d9f8/train/lean

import data.nat.basic
import tactic

def fsum : (ℕ → ℕ) → ℕ → ℕ :=
  λ f n, nat.rec_on n (f 0) (λ n' ihn', f (nat.succ n') + ihn')

def sq_nat : ℕ → ℕ := λ n, n ^ 2
def cb : ℕ → ℕ := λ n, n ^ 3

theorem nicomachus : ∀ n, sq_nat (fsum id n) = fsum cb n := sorry

-- https://leanprover-community.github.io/extras/calc.html
lemma example_calc_mode (a b c : ℕ) : (a + b) * c = c * b + c * a :=
begin
  --ring,
  calc (a + b) * c
      = a * c + b * c : by exact add_mul a b c
  ... = c * a + c * b : by simp [mul_comm]
  ... = c * b + c * a : by simp [add_comm],
end