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

! This file was ported from Lean 3 source module data.nat.squarefree
! leanprover-community/mathlib commit 10b4e499f43088dd3bb7b5796184ad5216648ab1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Squarefree
import Mathbin.Data.Nat.Factorization.PrimePow
import Mathbin.Data.Nat.PrimeNormNum
import Mathbin.RingTheory.Int.Basic

/-!
# Lemmas about squarefreeness of natural numbers
A number is squarefree when it is not divisible by any squares except the squares of units.

## Main Results
 - `nat.squarefree_iff_nodup_factors`: A positive natural number `x` is squarefree iff
  the list `factors x` has no duplicate factors.

## Tags
squarefree, multiplicity

-/

namespace Nat

theorem squarefree_iff_nodup_factors {n : ℕ} (h0 : n ≠ 0) : Squarefree n ↔ n.factors.Nodup :=
  by
  rw [UniqueFactorizationMonoid.squarefree_iff_nodup_normalizedFactors h0, Nat.factors_eq]
  simp
#align nat.squarefree_iff_nodup_factors Nat.squarefree_iff_nodup_factors

theorem squarefree_iff_prime_squarefree {n : ℕ} : Squarefree n ↔ ∀ x, Prime x → ¬x * x ∣ n :=
  squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible ⟨_, prime_two⟩
#align nat.squarefree_iff_prime_squarefree Nat.squarefree_iff_prime_squarefree

theorem Squarefree.factorization_le_one {n : ℕ} (p : ℕ) (hn : Squarefree n) :
    n.factorization p ≤ 1 := by
  rcases eq_or_ne n 0 with (rfl | hn')
  · simp
  rw [multiplicity.squarefree_iff_multiplicity_le_one] at hn
  by_cases hp : p.prime
  · have := hn p
    simp only [multiplicity_eq_factorization hp hn', Nat.isUnit_iff, hp.ne_one, or_false_iff] at
      this
    exact_mod_cast this
  · rw [factorization_eq_zero_of_non_prime _ hp]
    exact zero_le_one
#align nat.squarefree.factorization_le_one Nat.Squarefree.factorization_le_one

theorem squarefree_of_factorization_le_one {n : ℕ} (hn : n ≠ 0) (hn' : ∀ p, n.factorization p ≤ 1) :
    Squarefree n :=
  by
  rw [squarefree_iff_nodup_factors hn, List.nodup_iff_count_le_one]
  intro a
  rw [factors_count_eq]
  apply hn'
#align nat.squarefree_of_factorization_le_one Nat.squarefree_of_factorization_le_one

theorem squarefree_iff_factorization_le_one {n : ℕ} (hn : n ≠ 0) :
    Squarefree n ↔ ∀ p, n.factorization p ≤ 1 :=
  ⟨fun p hn => Squarefree.factorization_le_one hn p, squarefree_of_factorization_le_one hn⟩
#align nat.squarefree_iff_factorization_le_one Nat.squarefree_iff_factorization_le_one

theorem Squarefree.ext_iff {n m : ℕ} (hn : Squarefree n) (hm : Squarefree m) :
    n = m ↔ ∀ p, Prime p → (p ∣ n ↔ p ∣ m) :=
  by
  refine'
    ⟨by
      rintro rfl
      simp, fun h => eq_of_factorization_eq hn.ne_zero hm.ne_zero fun p => _⟩
  by_cases hp : p.prime
  · have h₁ := h _ hp
    rw [← not_iff_not, hp.dvd_iff_one_le_factorization hn.ne_zero, not_le, lt_one_iff,
      hp.dvd_iff_one_le_factorization hm.ne_zero, not_le, lt_one_iff] at h₁
    have h₂ := squarefree.factorization_le_one p hn
    have h₃ := squarefree.factorization_le_one p hm
    rw [Nat.le_add_one_iff, le_zero_iff] at h₂ h₃
    cases h₂
    · rwa [h₂, eq_comm, ← h₁]
    · rw [h₂, h₃.resolve_left]
      rw [← h₁, h₂]
      simp only [Nat.one_ne_zero, not_false_iff]
  rw [factorization_eq_zero_of_non_prime _ hp, factorization_eq_zero_of_non_prime _ hp]
#align nat.squarefree.ext_iff Nat.Squarefree.ext_iff

theorem squarefree_pow_iff {n k : ℕ} (hn : n ≠ 1) (hk : k ≠ 0) :
    Squarefree (n ^ k) ↔ Squarefree n ∧ k = 1 :=
  by
  refine'
    ⟨fun h => _, by
      rintro ⟨hn, rfl⟩
      simpa⟩
  rcases eq_or_ne n 0 with (rfl | hn₀)
  · simpa [zero_pow hk.bot_lt] using h
  refine' ⟨h.squarefree_of_dvd (dvd_pow_self _ hk), by_contradiction fun h₁ => _⟩
  have : 2 ≤ k := k.two_le_iff.mpr ⟨hk, h₁⟩
  apply hn (Nat.isUnit_iff.1 (h _ _))
  rw [← sq]
  exact pow_dvd_pow _ this
#align nat.squarefree_pow_iff Nat.squarefree_pow_iff

theorem squarefree_and_prime_pow_iff_prime {n : ℕ} : Squarefree n ∧ IsPrimePow n ↔ Prime n :=
  by
  refine' Iff.symm ⟨fun hn => ⟨hn.Squarefree, hn.IsPrimePow⟩, _⟩
  rw [isPrimePow_nat_iff]
  rintro ⟨h, p, k, hp, hk, rfl⟩
  rw [squarefree_pow_iff hp.ne_one hk.ne'] at h
  rwa [h.2, pow_one]
#align nat.squarefree_and_prime_pow_iff_prime Nat.squarefree_and_prime_pow_iff_prime

/-- Assuming that `n` has no factors less than `k`, returns the smallest prime `p` such that
  `p^2 ∣ n`. -/
def minSqFacAux : ℕ → ℕ → Option ℕ
  | n, k =>
    if h : n < k * k then none
    else
      have : Nat.sqrt n + 2 - (k + 2) < Nat.sqrt n + 2 - k :=
        by
        rw [Nat.add_sub_add_right]
        exact Nat.minFac_lemma n k h
      if k ∣ n then
        let n' := n / k
        have : Nat.sqrt n' + 2 - (k + 2) < Nat.sqrt n + 2 - k :=
          lt_of_le_of_lt
            (Nat.sub_le_sub_right (Nat.add_le_add_right (Nat.sqrt_le_sqrt <| Nat.div_le_self _ _) _)
              _)
            this
        if k ∣ n' then some k else min_sq_fac_aux n' (k + 2)
      else min_sq_fac_aux n (k + 2)termination_by'
  ⟨_, measure_wf fun ⟨n, k⟩ => Nat.sqrt n + 2 - k⟩
#align nat.min_sq_fac_aux Nat.minSqFacAux

/-- Returns the smallest prime factor `p` of `n` such that `p^2 ∣ n`, or `none` if there is no
  such `p` (that is, `n` is squarefree). See also `squarefree_iff_min_sq_fac`. -/
def minSqFac (n : ℕ) : Option ℕ :=
  if 2 ∣ n then
    let n' := n / 2
    if 2 ∣ n' then some 2 else minSqFacAux n' 3
  else minSqFacAux n 3
#align nat.min_sq_fac Nat.minSqFac

/-- The correctness property of the return value of `min_sq_fac`.
  * If `none`, then `n` is squarefree;
  * If `some d`, then `d` is a minimal square factor of `n` -/
def MinSqFacProp (n : ℕ) : Option ℕ → Prop
  | none => Squarefree n
  | some d => Prime d ∧ d * d ∣ n ∧ ∀ p, Prime p → p * p ∣ n → d ≤ p
#align nat.min_sq_fac_prop Nat.MinSqFacProp

theorem minSqFacProp_div (n) {k} (pk : Prime k) (dk : k ∣ n) (dkk : ¬k * k ∣ n) {o}
    (H : MinSqFacProp (n / k) o) : MinSqFacProp n o :=
  by
  have : ∀ p, Prime p → p * p ∣ n → k * (p * p) ∣ n := fun p pp dp =>
    have :=
      (coprime_primes pk pp).2 fun e => by
        subst e
        contradiction
    (coprime_mul_iff_right.2 ⟨this, this⟩).mul_dvd_of_dvd_of_dvd dk dp
  cases' o with d
  · rw [min_sq_fac_prop, squarefree_iff_prime_squarefree] at H⊢
    exact fun p pp dp => H p pp ((dvd_div_iff dk).2 (this _ pp dp))
  · obtain ⟨H1, H2, H3⟩ := H
    simp only [dvd_div_iff dk] at H2 H3
    exact ⟨H1, dvd_trans (dvd_mul_left _ _) H2, fun p pp dp => H3 _ pp (this _ pp dp)⟩
#align nat.min_sq_fac_prop_div Nat.minSqFacProp_div

theorem minSqFacAux_has_prop :
    ∀ {n : ℕ} (k),
      0 < n → ∀ i, k = 2 * i + 3 → (∀ m, Prime m → m ∣ n → k ≤ m) → MinSqFacProp n (minSqFacAux n k)
  | n, k => fun n0 i e ih => by
    rw [min_sq_fac_aux]
    by_cases h : n < k * k <;> simp [h]
    · refine' squarefree_iff_prime_squarefree.2 fun p pp d => _
      have := ih p pp (dvd_trans ⟨_, rfl⟩ d)
      have := Nat.mul_le_mul this this
      exact not_le_of_lt h (le_trans this (le_of_dvd n0 d))
    have k2 : 2 ≤ k := by
      subst e
      exact by decide
    have k0 : 0 < k := lt_of_lt_of_le (by decide) k2
    have IH : ∀ n', n' ∣ n → ¬k ∣ n' → min_sq_fac_prop n' (n'.minSqFacAux (k + 2)) :=
      by
      intro n' nd' nk
      have hn' := le_of_dvd n0 nd'
      refine'
        have : Nat.sqrt n' - k < Nat.sqrt n + 2 - k :=
          lt_of_le_of_lt (Nat.sub_le_sub_right (Nat.sqrt_le_sqrt hn') _) (Nat.minFac_lemma n k h)
        @min_sq_fac_aux_has_prop n' (k + 2) (pos_of_dvd_of_pos nd' n0) (i + 1)
          (by simp [e, left_distrib]) fun m m2 d => _
      cases' Nat.eq_or_lt_of_le (ih m m2 (dvd_trans d nd')) with me ml
      · subst me
        contradiction
      apply (Nat.eq_or_lt_of_le ml).resolve_left
      intro me
      rw [← me, e] at d
      change 2 * (i + 2) ∣ n' at d
      have := ih _ prime_two (dvd_trans (dvd_of_mul_right_dvd d) nd')
      rw [e] at this
      exact absurd this (by decide)
    have pk : k ∣ n → Prime k :=
      by
      refine' fun dk => prime_def_min_fac.2 ⟨k2, le_antisymm (min_fac_le k0) _⟩
      exact ih _ (min_fac_prime (ne_of_gt k2)) (dvd_trans (min_fac_dvd _) dk)
    split_ifs with dk dkk
    · exact ⟨pk dk, (Nat.dvd_div_iff dk).1 dkk, fun p pp d => ih p pp (dvd_trans ⟨_, rfl⟩ d)⟩
    · specialize IH (n / k) (div_dvd_of_dvd dk) dkk
      exact min_sq_fac_prop_div _ (pk dk) dk (mt (Nat.dvd_div_iff dk).2 dkk) IH
    · exact IH n (dvd_refl _) dk termination_by' ⟨_, measure_wf fun ⟨n, k⟩ => Nat.sqrt n + 2 - k⟩
#align nat.min_sq_fac_aux_has_prop Nat.minSqFacAux_has_prop

theorem minSqFac_has_prop (n : ℕ) : MinSqFacProp n (minSqFac n) :=
  by
  dsimp only [min_sq_fac]; split_ifs with d2 d4
  · exact ⟨prime_two, (dvd_div_iff d2).1 d4, fun p pp _ => pp.two_le⟩
  · cases' Nat.eq_zero_or_pos n with n0 n0
    · subst n0
      cases d4 (by decide)
    refine' min_sq_fac_prop_div _ prime_two d2 (mt (dvd_div_iff d2).2 d4) _
    refine' min_sq_fac_aux_has_prop 3 (Nat.div_pos (le_of_dvd n0 d2) (by decide)) 0 rfl _
    refine' fun p pp dp => succ_le_of_lt (lt_of_le_of_ne pp.two_le _)
    rintro rfl
    contradiction
  · cases' Nat.eq_zero_or_pos n with n0 n0
    · subst n0
      cases d2 (by decide)
    refine' min_sq_fac_aux_has_prop _ n0 0 rfl _
    refine' fun p pp dp => succ_le_of_lt (lt_of_le_of_ne pp.two_le _)
    rintro rfl
    contradiction
#align nat.min_sq_fac_has_prop Nat.minSqFac_has_prop

theorem minSqFac_prime {n d : ℕ} (h : n.minSqFac = some d) : Prime d :=
  by
  have := min_sq_fac_has_prop n
  rw [h] at this
  exact this.1
#align nat.min_sq_fac_prime Nat.minSqFac_prime

theorem minSqFac_dvd {n d : ℕ} (h : n.minSqFac = some d) : d * d ∣ n :=
  by
  have := min_sq_fac_has_prop n
  rw [h] at this
  exact this.2.1
#align nat.min_sq_fac_dvd Nat.minSqFac_dvd

theorem minSqFac_le_of_dvd {n d : ℕ} (h : n.minSqFac = some d) {m} (m2 : 2 ≤ m) (md : m * m ∣ n) :
    d ≤ m := by
  have := min_sq_fac_has_prop n; rw [h] at this
  have fd := min_fac_dvd m
  exact
    le_trans (this.2.2 _ (min_fac_prime <| ne_of_gt m2) (dvd_trans (mul_dvd_mul fd fd) md))
      (min_fac_le <| lt_of_lt_of_le (by decide) m2)
#align nat.min_sq_fac_le_of_dvd Nat.minSqFac_le_of_dvd

theorem squarefree_iff_minSqFac {n : ℕ} : Squarefree n ↔ n.minSqFac = none :=
  by
  have := min_sq_fac_has_prop n
  constructor <;> intro H
  · cases' n.min_sq_fac with d
    · rfl
    cases squarefree_iff_prime_squarefree.1 H _ this.1 this.2.1
  · rwa [H] at this
#align nat.squarefree_iff_min_sq_fac Nat.squarefree_iff_minSqFac

instance : DecidablePred (Squarefree : ℕ → Prop) := fun n =>
  decidable_of_iff' _ squarefree_iff_minSqFac

theorem squarefree_two : Squarefree 2 := by rw [squarefree_iff_nodup_factors] <;> norm_num
#align nat.squarefree_two Nat.squarefree_two

open UniqueFactorizationMonoid

theorem divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) :
    (n.divisors.filterₓ Squarefree).val =
      (UniqueFactorizationMonoid.normalizedFactors n).toFinset.powerset.val.map fun x =>
        x.val.Prod :=
  by
  rw [(Finset.nodup _).ext ((Finset.nodup _).map_onₓ _)]
  · intro a
    simp only [Multiset.mem_filter, id.def, Multiset.mem_map, Finset.filter_val, ← Finset.mem_def,
      mem_divisors]
    constructor
    · rintro ⟨⟨an, h0⟩, hsq⟩
      use (UniqueFactorizationMonoid.normalizedFactors a).toFinset
      simp only [id.def, Finset.mem_powerset]
      rcases an with ⟨b, rfl⟩
      rw [mul_ne_zero_iff] at h0
      rw [UniqueFactorizationMonoid.squarefree_iff_nodup_normalizedFactors h0.1] at hsq
      rw [Multiset.toFinset_subset, Multiset.toFinset_val, hsq.dedup, ← associated_iff_eq,
        normalized_factors_mul h0.1 h0.2]
      exact ⟨Multiset.subset_of_le (Multiset.le_add_right _ _), normalized_factors_prod h0.1⟩
    · rintro ⟨s, hs, rfl⟩
      rw [Finset.mem_powerset, ← Finset.val_le_iff, Multiset.toFinset_val] at hs
      have hs0 : s.val.prod ≠ 0 :=
        by
        rw [Ne.def, Multiset.prod_eq_zero_iff]
        simp only [exists_prop, id.def, exists_eq_right]
        intro con
        apply
          not_irreducible_zero
            (irreducible_of_normalized_factor 0 (Multiset.mem_dedup.1 (Multiset.mem_of_le hs Con)))
      rw [(normalized_factors_prod h0).symm.dvd_iff_dvd_right]
      refine' ⟨⟨Multiset.prod_dvd_prod_of_le (le_trans hs (Multiset.dedup_le _)), h0⟩, _⟩
      have h :=
        UniqueFactorizationMonoid.factors_unique irreducible_of_normalized_factor
          (fun x hx =>
            irreducible_of_normalized_factor x
              (Multiset.mem_of_le (le_trans hs (Multiset.dedup_le _)) hx))
          (normalized_factors_prod hs0)
      rw [associated_eq_eq, Multiset.rel_eq] at h
      rw [UniqueFactorizationMonoid.squarefree_iff_nodup_normalizedFactors hs0, h]
      apply s.nodup
  · intro x hx y hy h
    rw [← Finset.val_inj, ← Multiset.rel_eq, ← associated_eq_eq]
    rw [← Finset.mem_def, Finset.mem_powerset] at hx hy
    apply UniqueFactorizationMonoid.factors_unique _ _ (associated_iff_eq.2 h)
    · intro z hz
      apply irreducible_of_normalized_factor z
      rw [← Multiset.mem_toFinset]
      apply hx hz
    · intro z hz
      apply irreducible_of_normalized_factor z
      rw [← Multiset.mem_toFinset]
      apply hy hz
#align nat.divisors_filter_squarefree Nat.divisors_filter_squarefree

open BigOperators

theorem sum_divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) {α : Type _} [AddCommMonoid α]
    {f : ℕ → α} :
    (∑ i in n.divisors.filterₓ Squarefree, f i) =
      ∑ i in (UniqueFactorizationMonoid.normalizedFactors n).toFinset.powerset, f i.val.Prod :=
  by
  rw [Finset.sum_eq_multiset_sum, divisors_filter_squarefree h0, Multiset.map_map,
    Finset.sum_eq_multiset_sum]
#align nat.sum_divisors_filter_squarefree Nat.sum_divisors_filter_squarefree

theorem sq_mul_squarefree_of_pos {n : ℕ} (hn : 0 < n) :
    ∃ a b : ℕ, 0 < a ∧ 0 < b ∧ b ^ 2 * a = n ∧ Squarefree a :=
  by
  let S := { s ∈ Finset.range (n + 1) | s ∣ n ∧ ∃ x, s = x ^ 2 }
  have hSne : S.nonempty := by
    use 1
    have h1 : 0 < n ∧ ∃ x : ℕ, 1 = x ^ 2 := ⟨hn, ⟨1, (one_pow 2).symm⟩⟩
    simpa [S]
  let s := Finset.max' S hSne
  have hs : s ∈ S := Finset.max'_mem S hSne
  simp only [Finset.sep_def, S, Finset.mem_filter, Finset.mem_range] at hs
  obtain ⟨hsn1, ⟨a, hsa⟩, ⟨b, hsb⟩⟩ := hs
  rw [hsa] at hn
  obtain ⟨hlts, hlta⟩ := canonically_ordered_comm_semiring.mul_pos.mp hn
  rw [hsb] at hsa hn hlts
  refine' ⟨a, b, hlta, (pow_pos_iff zero_lt_two).mp hlts, hsa.symm, _⟩
  rintro x ⟨y, hy⟩
  rw [Nat.isUnit_iff]
  by_contra hx
  refine' lt_le_antisymm _ (Finset.le_max' S ((b * x) ^ 2) _)
  · simp_rw [S, hsa, Finset.sep_def, Finset.mem_filter, Finset.mem_range]
    refine' ⟨lt_succ_iff.mpr (le_of_dvd hn _), _, ⟨b * x, rfl⟩⟩ <;> use y <;> rw [hy] <;> ring
  · convert lt_mul_of_one_lt_right hlts
        (one_lt_pow 2 x zero_lt_two (one_lt_iff_ne_zero_and_ne_one.mpr ⟨fun h => by simp_all, hx⟩))
    rw [mul_pow]
#align nat.sq_mul_squarefree_of_pos Nat.sq_mul_squarefree_of_pos

theorem sq_mul_squarefree_of_pos' {n : ℕ} (h : 0 < n) :
    ∃ a b : ℕ, (b + 1) ^ 2 * (a + 1) = n ∧ Squarefree (a + 1) :=
  by
  obtain ⟨a₁, b₁, ha₁, hb₁, hab₁, hab₂⟩ := sq_mul_squarefree_of_pos h
  refine' ⟨a₁.pred, b₁.pred, _, _⟩ <;> simpa only [add_one, succ_pred_eq_of_pos, ha₁, hb₁]
#align nat.sq_mul_squarefree_of_pos' Nat.sq_mul_squarefree_of_pos'

theorem sq_mul_squarefree (n : ℕ) : ∃ a b : ℕ, b ^ 2 * a = n ∧ Squarefree a :=
  by
  cases n
  · exact ⟨1, 0, by simp, squarefree_one⟩
  · obtain ⟨a, b, -, -, h₁, h₂⟩ := sq_mul_squarefree_of_pos (succ_pos n)
    exact ⟨a, b, h₁, h₂⟩
#align nat.sq_mul_squarefree Nat.sq_mul_squarefree

/-- `squarefree` is multiplicative. Note that the → direction does not require `hmn`
and generalizes to arbitrary commutative monoids. See `squarefree.of_mul_left` and
`squarefree.of_mul_right` above for auxiliary lemmas. -/
theorem squarefree_mul {m n : ℕ} (hmn : m.coprime n) :
    Squarefree (m * n) ↔ Squarefree m ∧ Squarefree n :=
  by
  simp only [squarefree_iff_prime_squarefree, ← sq, ← forall_and]
  refine' ball_congr fun p hp => _
  simp only [hmn.is_prime_pow_dvd_mul (hp.is_prime_pow.pow two_ne_zero), not_or]
#align nat.squarefree_mul Nat.squarefree_mul

end Nat

/-! ### Square-free prover -/

open NormNum

namespace Tactic

namespace NormNum

/-- A predicate representing partial progress in a proof of `squarefree`. -/
def SquarefreeHelper (n k : ℕ) : Prop :=
  0 < k → (∀ m, Nat.Prime m → m ∣ bit1 n → bit1 k ≤ m) → Squarefree (bit1 n)
#align tactic.norm_num.squarefree_helper Tactic.NormNum.SquarefreeHelper

theorem squarefree_bit10 (n : ℕ) (h : SquarefreeHelper n 1) : Squarefree (bit0 (bit1 n)) :=
  by
  refine' @Nat.minSqFacProp_div _ _ Nat.prime_two two_dvd_bit0 _ none _
  · rw [bit0_eq_two_mul (bit1 n), mul_dvd_mul_iff_left (two_ne_zero' ℕ)]
    exact Nat.not_two_dvd_bit1 _
  · rw [bit0_eq_two_mul, Nat.mul_div_right _ (by decide : 0 < 2)]
    refine' h (by decide) fun p pp dp => Nat.succ_le_of_lt (lt_of_le_of_ne pp.two_le _)
    rintro rfl
    exact Nat.not_two_dvd_bit1 _ dp
#align tactic.norm_num.squarefree_bit10 Tactic.NormNum.squarefree_bit10

theorem squarefree_bit1 (n : ℕ) (h : SquarefreeHelper n 1) : Squarefree (bit1 n) :=
  by
  refine' h (by decide) fun p pp dp => Nat.succ_le_of_lt (lt_of_le_of_ne pp.two_le _)
  rintro rfl; exact Nat.not_two_dvd_bit1 _ dp
#align tactic.norm_num.squarefree_bit1 Tactic.NormNum.squarefree_bit1

theorem squarefree_helper_0 {k} (k0 : 0 < k) {p : ℕ} (pp : Nat.Prime p) (h : bit1 k ≤ p) :
    bit1 (k + 1) ≤ p ∨ bit1 k = p :=
  by
  rcases lt_or_eq_of_le h with ((hp : _ + 1 ≤ _) | hp)
  · rw [bit1, bit0_eq_two_mul] at hp
    change 2 * (_ + 1) ≤ _ at hp
    rw [bit1, bit0_eq_two_mul]
    refine' Or.inl (lt_of_le_of_ne hp _)
    rintro rfl
    exact Nat.not_prime_mul (by decide) (lt_add_of_pos_left _ k0) pp
  · exact Or.inr hp
#align tactic.norm_num.squarefree_helper_0 Tactic.NormNum.squarefree_helper_0

theorem squarefreeHelper_1 (n k k' : ℕ) (e : k + 1 = k')
    (hk : Nat.Prime (bit1 k) → ¬bit1 k ∣ bit1 n) (H : SquarefreeHelper n k') :
    SquarefreeHelper n k := fun k0 ih => by
  subst e
  refine' H (Nat.succ_pos _) fun p pp dp => _
  refine' (squarefree_helper_0 k0 pp (ih p pp dp)).resolve_right fun hp => _
  subst hp; cases hk pp dp
#align tactic.norm_num.squarefree_helper_1 Tactic.NormNum.squarefreeHelper_1

theorem squarefreeHelper_2 (n k k' c : ℕ) (e : k + 1 = k') (hc : bit1 n % bit1 k = c) (c0 : 0 < c)
    (h : SquarefreeHelper n k') : SquarefreeHelper n k :=
  by
  refine' squarefree_helper_1 _ _ _ e (fun _ => _) h
  refine' mt _ (ne_of_gt c0); intro e₁
  rwa [← hc, ← Nat.dvd_iff_mod_eq_zero]
#align tactic.norm_num.squarefree_helper_2 Tactic.NormNum.squarefreeHelper_2

theorem squarefreeHelper_3 (n n' k k' c : ℕ) (e : k + 1 = k') (hn' : bit1 n' * bit1 k = bit1 n)
    (hc : bit1 n' % bit1 k = c) (c0 : 0 < c) (H : SquarefreeHelper n' k') : SquarefreeHelper n k :=
  fun k0 ih => by
  subst e
  have k0' : 0 < bit1 k := bit1_pos (Nat.zero_le _)
  have dn' : bit1 n' ∣ bit1 n := ⟨_, hn'.symm⟩
  have dk : bit1 k ∣ bit1 n := ⟨_, ((mul_comm _ _).trans hn').symm⟩
  have : bit1 n / bit1 k = bit1 n' := by rw [← hn', Nat.mul_div_cancel _ k0']
  have k2 : 2 ≤ bit1 k := Nat.succ_le_succ (bit0_pos k0)
  have pk : (bit1 k).Prime :=
    by
    refine' Nat.prime_def_minFac.2 ⟨k2, le_antisymm (Nat.minFac_le k0') _⟩
    exact ih _ (Nat.minFac_prime (ne_of_gt k2)) (dvd_trans (Nat.minFac_dvd _) dk)
  have dkk' : ¬bit1 k ∣ bit1 n' :=
    by
    rw [Nat.dvd_iff_mod_eq_zero, hc]
    exact ne_of_gt c0
  have dkk : ¬bit1 k * bit1 k ∣ bit1 n := by rwa [← Nat.dvd_div_iff dk, this]
  refine' @Nat.minSqFacProp_div _ _ pk dk dkk none _
  rw [this]
  refine' H (Nat.succ_pos _) fun p pp dp => _
  refine' (squarefree_helper_0 k0 pp (ih p pp <| dvd_trans dp dn')).resolve_right fun e => _
  subst e
  contradiction
#align tactic.norm_num.squarefree_helper_3 Tactic.NormNum.squarefreeHelper_3

theorem squarefreeHelper_4 (n k k' : ℕ) (e : bit1 k * bit1 k = k') (hd : bit1 n < k') :
    SquarefreeHelper n k := by
  cases' Nat.eq_zero_or_pos n with h h
  · subst n
    exact fun _ _ => squarefree_one
  subst e
  refine' fun k0 ih => Irreducible.squarefree (Nat.prime_def_le_sqrt.2 ⟨bit1_lt_bit1.2 h, _⟩)
  intro m m2 hm md
  obtain ⟨p, pp, hp⟩ := Nat.exists_prime_and_dvd (ne_of_gt m2)
  have :=
    (ih p pp (dvd_trans hp md)).trans
      (le_trans (Nat.le_of_dvd (lt_of_lt_of_le (by decide) m2) hp) hm)
  rw [Nat.le_sqrt] at this
  exact not_le_of_lt hd this
#align tactic.norm_num.squarefree_helper_4 Tactic.NormNum.squarefreeHelper_4

theorem not_squarefree_mul (a aa b n : ℕ) (ha : a * a = aa) (hb : aa * b = n) (h₁ : 1 < a) :
    ¬Squarefree n := by
  rw [← hb, ← ha]
  exact fun H => ne_of_gt h₁ (Nat.isUnit_iff.1 <| H _ ⟨_, rfl⟩)
#align tactic.norm_num.not_squarefree_mul Tactic.NormNum.not_squarefree_mul

/-- Given `e` a natural numeral and `a : nat` with `a^2 ∣ n`, return `⊢ ¬ squarefree e`. -/
unsafe def prove_non_squarefree (e : expr) (n a : ℕ) : tactic expr := do
  let ea := reflect a
  let eaa := reflect (a * a)
  let c ← mk_instance_cache q(Nat)
  let (c, p₁) ← prove_lt_nat c q(1) ea
  let b := n / (a * a)
  let eb := reflect b
  let (c, eaa, pa) ← prove_mul_nat c ea ea
  let (c, e', pb) ← prove_mul_nat c eaa eb
  guard (e' == e)
  return <| q(@not_squarefree_mul).mk_app [ea, eaa, eb, e, pa, pb, p₁]
#align tactic.norm_num.prove_non_squarefree tactic.norm_num.prove_non_squarefree

/-- Given `en`,`en1 := bit1 en`, `n1` the value of `en1`, `ek`,
  returns `⊢ squarefree_helper en ek`. -/
unsafe def prove_squarefree_aux :
    ∀ (ic : instance_cache) (en en1 : expr) (n1 : ℕ) (ek : expr) (k : ℕ), tactic expr
  | ic, en, en1, n1, ek, k => do
    let k1 := bit1 k
    let ek1 := q((bit1 : ℕ → ℕ)).mk_app [ek]
    if n1 < k1 * k1 then do
        let (ic, ek', p₁) ← prove_mul_nat ic ek1 ek1
        let (ic, p₂) ← prove_lt_nat ic en1 ek'
        pure <| q(squarefreeHelper_4).mk_app [en, ek, ek', p₁, p₂]
      else do
        let c := n1 % k1
        let k' := k + 1
        let ek' := reflect k'
        let (ic, p₁) ← prove_succ ic ek ek'
        if c = 0 then do
            let n1' := n1 / k1
            let n' := n1' / 2
            let en' := reflect n'
            let en1' := q((bit1 : ℕ → ℕ)).mk_app [en']
            let (ic, _, pn') ← prove_mul_nat ic en1' ek1
            let c := n1' % k1
            guard (c ≠ 0)
            let (ic, ec, pc) ← prove_div_mod ic en1' ek1 tt
            let (ic, p₀) ← prove_pos ic ec
            let p₂ ← prove_squarefree_aux ic en' en1' n1' ek' k'
            pure <| q(squarefreeHelper_3).mk_app [en, en', ek, ek', ec, p₁, pn', pc, p₀, p₂]
          else do
            let (ic, ec, pc) ← prove_div_mod ic en1 ek1 tt
            let (ic, p₀) ← prove_pos ic ec
            let p₂ ← prove_squarefree_aux ic en en1 n1 ek' k'
            pure <| q(squarefreeHelper_2).mk_app [en, ek, ek', ec, p₁, pc, p₀, p₂]
#align tactic.norm_num.prove_squarefree_aux tactic.norm_num.prove_squarefree_aux

/-- Given `n > 0` a squarefree natural numeral, returns `⊢ squarefree n`. -/
unsafe def prove_squarefree (en : expr) (n : ℕ) : tactic expr :=
  match match_numeral en with
  | match_numeral_result.one => pure q(@squarefree_one ℕ _)
  | match_numeral_result.bit0 en1 =>
    match match_numeral en1 with
    | match_numeral_result.one => pure q(Nat.squarefree_two)
    | match_numeral_result.bit1 en => do
      let ic ← mk_instance_cache q(ℕ)
      let p ← prove_squarefree_aux ic en en1 (n / 2) q((1 : ℕ)) 1
      pure <| q(squarefree_bit10).mk_app [en, p]
    | _ => failed
  | match_numeral_result.bit1 en' => do
    let ic ← mk_instance_cache q(ℕ)
    let p ← prove_squarefree_aux ic en' en n q((1 : ℕ)) 1
    pure <| q(squarefree_bit1).mk_app [en', p]
  | _ => failed
#align tactic.norm_num.prove_squarefree tactic.norm_num.prove_squarefree

/-- Evaluates the `squarefree` predicate on naturals. -/
@[norm_num]
unsafe def eval_squarefree : expr → tactic (expr × expr)
  | q(Squarefree ($(e) : ℕ)) => do
    let n ← e.toNat
    match n with
      | 0 => false_intro q(@not_squarefree_zero ℕ _ _)
      | 1 => true_intro q(@squarefree_one ℕ _)
      | _ =>
        match n with
        | some d => prove_non_squarefree e n d >>= false_intro
        | none => prove_squarefree e n >>= true_intro
  | _ => failed
#align tactic.norm_num.eval_squarefree tactic.norm_num.eval_squarefree

end NormNum

end Tactic


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que 3 divide al máximo xomún divisor de 6 y 15.
-- ----------------------------------------------------------------------

import data.real.basic
import data.nat.gcd

open nat

-- 1ª demostración
-- ===============

example : 3 ∣ gcd 6 15 :=
begin
  rw dvd_gcd_iff,
  split; norm_num,
end

-- Prueba
-- ======

/-
⊢ 3 ∣ 6.gcd 15
  rw dvd_gcd_iff,
⊢ 3 ∣ 6 ∧ 3 ∣ 15
  split; norm_num,
no goals
-/

-- Comentario: Se ha usado el lema
-- + dvd_gcd_iff: k | gcd m n ↔ k | m ∧ k | b

-- 2ª demostración
-- ===============

example : 3 ∣ gcd 6 15 :=
begin
  convert dvd_refl _,
  by norm_num,
end

-- 3ª demostración
-- ===============

example : 3 ∣ gcd 6 15 :=
by norm_num


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 3 : "not" (`¬`)

We learn about how to manipulate `¬ P` in Lean.

# Important : the definition of `¬ P`

In Lean, `¬ P` is *defined* to mean `P → false`. So `¬ P` and `P → false`
are *definitionally equal*. Check out the explanation of definitional
equality in the "equality" section of Part B of the course notes.

## Tactics

You'll need to know about the tactics from the previous sheets,
and the following tactics may also be useful:

* `change`
* `by_contra`
* `by_cases`

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : ¬ true → false :=
begin
  intro q, change true->false at q,apply q,triv,
end

example : false → ¬ true :=
begin
  intro q, by_contra, triv,
end

example : ¬ false → true :=
begin
  intro q,triv,
end

example : true → ¬ false :=
begin
  intros q w,triv,
end

example : false → ¬ P :=
begin
  intro q,change P->false,intro w,triv,
end

example : P → ¬ P → false :=
begin
  intro q, triv,
end

example : P → ¬ (¬ P) :=
begin
  intro q,change ¬ P ->false,triv,
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  intros q w e, apply w,apply q,assumption,
end

example : ¬ ¬ false → false :=
begin
  intro q, apply q,intro w,triv,
end

example : ¬ ¬ P → P :=
begin
  intro q,by_contra,apply q,triv,
end

example : (¬ Q → ¬ P) → (P → Q) :=
begin
  intro q,intro w,by_cases Q,{assumption},{by_contra, apply q,{assumption},{assumption}}
end


import data.real.basic

variables (u : ℕ → ℝ)
variables (a b x y : ℝ)

notation `|`x`|` := abs x

def limite : (ℕ → ℝ) → ℝ → Prop :=
λ u c, ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - c| ≤ ε

lemma eq_of_abs_sub_le_all
  : (∀ ε > 0, |x - y| ≤ ε) → x = y :=
begin
  intro h,
  apply eq_of_abs_sub_nonpos,
  by_contradiction H,
  push_neg at H,
  specialize h ( |x-y|/2) (by linarith),
  linarith,
end

example
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
begin
  apply eq_of_abs_sub_le_all,
  intros eps eps_pos,
  cases ha (eps/2) (by linarith) with N1 hN1,
  cases hb (eps/2) (by linarith) with N2 hN2,
  let N0:=max N1 N2,
  calc  |a-b|
      = |(a-u N0)+(u N0-b)| : by ring_nf
  ... ≤ |a-u N0| + |u N0-b| : by apply abs_add
  ... = |u N0-a| + |u N0-b| : by rw abs_sub
  ... ≤ eps                 : by linarith [hN1 N0 (le_max_left N1 N2),
                                           hN2 N0 (le_max_right N1 N2)],
end


-- -- * On propositions ----------------------------------------------------------
-- * Int [#64]
-- we can build a small logical system directly in lean
namespace ml
constant and : Prop → Prop → Prop
constant or : Prop → Prop → Prop
constant not : Prop → Prop
constant implies : Prop → Prop → Prop

variables p q r : Prop
#check and p q                      -- Prop
#check or (and p q) r               -- Prop
#check implies (and p q) (and q p)  -- Prop

constant Proof : Prop → Type

constant and_comm : Π p q : Prop,
  Proof (implies (and p q) (and q p))

#check and_comm p q      -- Proof (implies (and p q) (and q p))

end ml

-- How do we go from a Proof object to the usual proof using the objects
-- themselves? By conflating Proof p with p! instantiating p is thus tantamount
-- to proving p!

-- Some simplifications are possible, however. To start with, we can avoid
-- writing the term Proof repeatedly by conflating Proof p with p itself. In
-- other words, whenever we have p : Prop, we can interpret p as a type, namely,
-- the type of its proofs. We can then read t : p as the assertion that t is a
-- proof of p. Moreover, once we make this identification, the rules for
-- implication show that we can pass back and forth between implies p q and p →
-- q. In other words, implication between propositions p and q corresponds to
-- having a function that takes any element of p to an element of q. As a
-- result, the introduction of the connective implies is entirely redundant: we
-- can use the usual function space constructor p → q from dependent type theory
-- as our notion of implication.This is the approach followed in the Calculus of
-- Constructions, and hence in Lean as well. The fact that the rules for
-- implication in a proof system for natural deduction correspond exactly to the
-- rules governing abstraction and application for functions is an instance of
-- the Curry-Howard isomorphism, sometimes known as the propositions-as-types
-- paradigm. In fact, the type Prop is syntactic sugar for Sort 0, the very
-- bottom of the type hierarchy described in the last chapter. Moreover, Type u
-- is also just syntactic sugar for Sort (u+1). Prop has some special features,
-- but like the other type universes, it is closed under the arrow constructor:
-- if we have p q : Prop, then p → q : Prop.

-- There are at least two ways of thinking about propositions as types. To some
-- who take a constructive view of logic and mathematics, this is a faithful
-- rendering of what it means to be a proposition: a proposition p represents a
-- sort of data type, namely, a specification of the type of data that
-- constitutes a proof. A proof of p is then simply an object t : p of the right
-- type.

-- They talk about interpretations and so on what matters is the bottom line

-- To formally express a mathematical assertion in the language of dependent
-- type theory, we need to exhibit a term p : Prop. To prove that assertion, we
-- need to exhibit a term t : p. Lean’s task, as a proof assistant, is to help
-- us to construct such a term, t, and to verify that it is well-formed and has
-- the correct type.

-- ** What differs theorem from def? [#85]
-- It gives a hint to the compiler!

-- Note that the theorem command is really a version of the definition command:
-- under the propositions and types correspondence, proving the theorem p → q →
-- p is really the same as defining an element of the associated type. To the
-- kernel type checker, there is no difference between the two.

-- There are a few pragmatic differences between definitions and theorems,
-- however. In normal circumstances, it is never necessary to unfold the
-- “definition” of a theorem; by proof irrelevance, any two proofs of that
-- theorem are definitionally equal. Once the proof of a theorem is complete,
-- typically we only need to know that the proof exists; it doesn’t matter what
-- the proof is. In light of that fact, Lean tags proofs as irreducible, which
-- serves as a hint to the parser (more precisely, the elaborator) that there is
-- generally no need to unfold it when processing a file. In fact, Lean is
-- generally able to process and check proofs in parallel, since assessing the
-- correctness of one proof does not require knowing the details of another.

-- The three ways below are equivalent, but some are clearer to read

constants p q : Prop

theorem t1 : p → q → p := λ hp : p, λ hq : q, hp

#print t1

theorem t2 : p → q → p :=
assume hp : p,
assume hq : q,
hp

#print t2

theorem t3 : p → q → p :=
assume hp : p,
assume hq : q,
show p, from hp

-- assume here looks like the intro tactic
theorem t4 (hp : p) (hq : q) : p := hp
#check t4    -- p → q → p

-- the axiom kw is like constant for Prop
axiom hp : p
theorem t5 : q → p := t4 hp

-- Notice, by the way, that the original theorem t1 is true for any propositions
-- p and q, not just the particular constants declared. So it would be more
-- natural to define the theorem so that it quantifies over those, too:

theorem t6 (p q : Prop) (hp : p) (hq : q) : p := hp
#check t6 -- ∀ (p q : Prop), p → q → p

-- The type of t1 is now ∀ p q : Prop, p → q → p. We can read this as the
-- assertion “for every pair of propositions p q, we have p → q → p.” The symbol
-- ∀ is alternate syntax for Π, and later we will see how Pi types let us model
-- universal quantifiers more generally.

-- If p and q have been declared as variables, Lean will generalize them for us automatically:
variables p q : Prop

theorem t7 : p → q → p := λ (hp : p) (hq : q), hp
#check t7
-- note it is the same damn thing as t6!
variables r s : Prop

#check t7 p q                -- p → q → p
#check t7 r s                -- r → s → r
#check t7 (r → s) (s → r)    -- (r → s) → (s → r) → r → s

variable h : r → s

#check t7 (r → s) (s → r) h  -- (s → r) → r → s

theorem t8 (h₁ : q → r) (h₂ : p → q) : p → r :=
assume h₃ : p,
show r, from h₁ (h₂ h₃)

-- * Having fun with connectives [#15]
#check p → q → p ∧ q
#check ¬p → p ↔ false
#check p ∨ q → q ∨ p

-- The order of operations is as follows: unary negation ¬ binds most strongly,
-- then ∧, then ∨, then →, and finally ↔. For example, a ∧ b → c ∨ d ∧ e means
-- (a ∧ b) → (c ∨ (d ∧ e)).

--In the last chapter we observed that lambda abstraction can be viewed as an
--“introduction rule” for →. In the current setting, it shows how to “introduce”
--or establish an implication. Application can be viewed as an “elimination
--rule,” showing how to “eliminate” or use an implication in a proof.

-- ** Conjunction [#10]

-- The expression and.intro h1 h2 builds a proof of p ∧ q using
-- proofs h1 : p and h2 : q. It is common to describe and.intro as the
-- and-introduction rule. In the next example we use and.intro to create a proof
-- of p → q → p ∧ q.

-- *** example command [#12]

-- The example command states a theorem without naming it or storing it in the
-- permanent context. Essentially, it just checks that the given term has the
-- indicated type
example (hp : p) (hq : q) : p ∧ q := and.intro hp hq

#check assume (hp : p) (hq : q), and.intro hp hq

-- *** and.intro command [#33]

-- The expression and.intro h1 h2 builds a proof of p ∧ q using proofs h1 : p
-- and h2 : q. It is common to describe and.intro as the and-introduction rule.
-- In the next example we use and.intro to create a proof of p → q → p ∧ q. try
-- it!

example (hp : p) (hq : q) : p ∧ q := and.intro hp hq

#check assume (hp : p) (hq : q), and.intro hp hq

--- *** and.elim_left, and.elim_right, and abbreviations: and.left, and.right

-- The expression and.elim_left h creates a proof of p from a proof h : p ∧ q.
-- Similarly, and.elim_right h is a proof of q. They are commonly known as the
-- right and left and-elimination rules. Because they are so commonly used, the
-- standard library provides the abbreviations and.left and and.right for
-- and.elim_left and and.elim_right, respectively.

-- COOL FACT

-- Notice that and-introduction and and-elimination are similar to the pairing
-- and projection operations for the cartesian product. The difference is that
-- given hp : p and hq : q, and.intro hp hq has type p ∧ q : Prop, while pair hp
-- hq has type p × q : Type. The similarity between ∧ and × is another instance
-- of the Curry-Howard isomorphism, but in contrast to implication and the
-- function space constructor, ∧ and × are treated separately in Lean. With the
-- analogy, however, the proof we have just constructed is similar to a function
-- that swaps the elements of a pair.

-- *** EXPLAINING THE WEIRD ⟨ ⟩ notation [#34]

-- We will see in Chapter 9 that certain types in Lean are structures, which is
-- to say, the type is defined with a single canonical constructor which builds
-- an element of the type from a sequence of suitable arguments. For every p q :
-- Prop, p ∧ q is an example: the canonical way to construct an element is to
-- apply and.intro to suitable arguments hp : p and hq : q. Lean allows us to
-- use anonymous constructor notation ⟨arg1, arg2, ...⟩ in situations like
-- these, when the relevant type is an inductive type and can be inferred from
-- the context. In particular, we can often write ⟨hp, hq⟩ instead of and.intro
-- hp hq:
variables  (hp : p) (hq : q)

#check (⟨hp, hq⟩ : p ∧ q)

--- *** another syntatic sugar: h.left = and.left h
-- Lean provides another useful syntactic gadget. Given an expression e of an
-- inductive type foo (possibly applied to some arguments), the notation e.bar
-- is shorthand for foo.bar e. This provides a convenient way of accessing
-- functions without opening a namespace. For example, the following two
-- expressions mean the same thing:

variable l : list ℕ

#check list.head l
#check l.head

example (h : p ∧ q) : q ∧ p := ⟨h.right, h.left⟩

--- *** flattening right-associative constructors
example (h : p ∧ q) : q ∧ p ∧ q:= ⟨h.right, ⟨h.left, h.right⟩⟩
-- is equiv to
example (h : p ∧ q) : q ∧ p ∧ q:= ⟨h.right, h.left, h.right⟩

-- ** Disjunction [#1]

-- * or-introduction rules

-- The expression or.intro_left q hp creates a proof of p ∨ q from a proof hp :
-- p. Similarly, or.intro_right p hq creates a proof for p ∨ q using a proof hq
-- : q. These are the left and right or-introduction rules.
example (hp : p) : p ∨ q := or.intro_left q hp
example (hq : q) : p ∨ q := or.intro_right p hq

-- *** or-elimination rules [#15]

-- The or-elimination rule is slightly more complicated. The idea is that we can
-- prove r from p ∨ q, by showing that r follows from p and that r follows from
-- q. In other words, it is a proof by cases. In the expression or.elim hpq hpr
-- hqr, or.elim takes three arguments, hpq : p ∨ q, hpr : p → r and hqr : q → r,
-- and produces a proof of r. In the following example, we use or.elim to prove
-- p ∨ q → q ∨ p.
example (h : p ∨ q) : q ∨ p :=
or.elim h
  (assume hp : p,
    show q ∨ p, from or.intro_right q hp)
  (assume hq : q,
    show q ∨ p, from or.intro_left p hq)

-- *** abbreviation of or.intro left q hp = or.inl q (gotta assume hp !) [#15]

-- In most cases, the first argument of or.intro_right and or.intro_left can be
-- inferred automatically by Lean. Lean therefore provides or.inr and or.inl as
-- shorthand for or.intro_right _ and or.intro_left _. Thus the proof term above
-- could be written more concisely
-- This one sucks to read
example (h : p ∨ q) : q ∨ p := or.elim h (λ hp, or.inr hp) (λ hq, or.inl hq)

-- Because or has two constructors, we cannot use anonymous constructor
-- notation. But we can still write h.elim instead of or.elim h:
example (h : p ∨ q) : q ∨ p :=
h.elim
  (assume hp : p, or.inr hp)
  (assume hq : q, or.inl hq)
-- * Falsity [#6]

-- The connective false has a single elimination rule, false.elim, which
-- expresses the fact that anything follows from a contradiction. This rule is
-- sometimes called ex falso (short for ex falso sequitur quodlibet), or the
-- principle of explosion.

-- ** elimination rule: false.elim [#15]

-- They explain wwtf is ex falso

-- REVIEW THAT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-- The connective false has a single elimination rule, false.elim, which
-- expresses the fact that anything follows from a contradiction. This rule is
-- sometimes called ex falso (short for ex falso sequitur quodlibet), or the
-- principle of explosion.

example (hp : p) (hnp : ¬p) : q := false.elim (hnp hp)

-- ** absurd [#10]
-- The arbitrary fact, q, that follows from falsity is an implicit argument in
-- false.elim and is inferred automatically. This pattern, deriving an arbitrary
-- fact from contradictory hypotheses, is quite common, and is represented by
-- absurd.

example (hp : p) (hnp : ¬p) : q := absurd hp hnp

example (hnp : ¬p) (hq : q) (hqp : q → p) : r := absurd (hqp hq) hnp

-- ** introduction rule: true.intro [#6]

-- Incidentally, just as false has only an elimination rule, true has only an
-- introduction rule, true.intro : true, sometimes abbreviated trivial : true.
-- In other words, true is simply true, and has a canonical proof, trivial.

-- * Logical equivalence [#1]

-- ** iff.intro h₁ h₂, iff.elim_left, iff.elim_right [#15]

-- The expression iff.intro h1 h2 produces a proof of p ↔ q from h1 : p → q and
-- h2 : q → p. The expression iff.elim_left h produces a proof of p → q from h :
-- p ↔ q. Similarly, iff.elim_right h produces a proof of q → p from h : p ↔ q.
-- Here is a proof of p ∧ q ↔ q ∧ p:The expression iff.intro h1 h2 produces a
-- proof of p ↔ q from h1 : p → q and h2 : q → p. The expression iff.elim_left h
-- produces a proof of p → q from h : p ↔ q. Similarly, iff.elim_right h
-- produces a proof of q → p from h : p ↔ q. Here is a proof of p ∧ q ↔ q ∧ p:
theorem and_swap : p ∧ q ↔ q ∧ p :=
  iff.intro
  (assume h : p ∧ q,
    show q ∧ p, from and.intro (and.right h) (and.left h))
  (assume h : q ∧ p,
    show p ∧ q, from and.intro (and.right h) (and.left h))

-- ** abreviating iff.elim_ : iff.mp and iff.mpr [#22]
#check and_swap p q

-- p ∧ q ↔ q ∧ p Because they represent a form of modus
-- ponens, iff.elim_left and iff.elim_right can be abbreviated iff.mp and
-- iff.mpr, respectively. In the next example, we use that theorem to derive q ∧
-- p from p ∧ q:
variable h2 : p ∧ q

example : q ∧ p := iff.mp (and_swap p q) h2

-- THIS NOTATION IS HARD AFF

-- We can use the anonymous constructor notation to construct a proof of p ↔ q
-- from proofs of the forward and backward directions, and we can also use .
-- notation with mp and mpr. The previous examples can therefore be written
-- concisely as follows:

theorem and_swap_again : p ∧ q ↔ q ∧ p :=
⟨ λ h, ⟨h.right, h.left⟩, λ h, ⟨h.right, h.left⟩ ⟩

example (h : p ∧ q) : q ∧ p := (and_swap_again p q).mp h

-- DIGEST THAT ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

-- * Auxiliary Subgoals: have and suffices [#9]

-- NOW THIS IS FUN
example (h : p ∧ q) : q ∧ p :=

have hp : p, from and.left h, --- DIGEST THIS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
have hq : q, from and.right h, --- DIGEST THIS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
show q ∧ p, from and.intro hq hp

-- * Classical Logic: the em constructor [#62]
-- We basically need the excluded middle for lots of normal math. Constructively,
-- it is not in our toolset. For that we open the classical logic namespace

-- I USE THIS SHIT A LOT. WTF VELLEMAN

-- The introduction and elimination rules we have seen so far are all
-- constructive, which is to say, they reflect a computational understanding of
-- the logical connectives based on the propositions-as-types correspondence.
-- Ordinary classical logic adds to this the law of the excluded middle, p ∨ ¬p.
-- To use this principle, you have to open the classical namespace.

open classical

#check em p

-- One consequence of the law of the excluded middle is the principle of
-- double-negation elimination:

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p, absurd hnp h)

-- Double-negation elimination allows one to prove any proposition, p, by
-- assuming ¬p and deriving false, because that amounts to proving ¬¬p. In other
-- words, double-negation elimination allows one to carry out a proof by
-- contradiction, something which is not generally possible in constructive
-- logic.

-- TRICKy AS FUCK ⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡⇡

-- The classical axioms also give you access to additional patterns of proof
-- that can be justified by appeal to em. For example, one can carry out a proof
-- by cases or by contradiction.

example (h : ¬¬p) : p :=
by_cases
  (assume h1 : p, h1)
  (assume h1 : ¬p, absurd h1 h)

example (h : ¬¬p) : p :=
by_contradiction
  (assume h1 : ¬p,
    show false, from h h1)

example (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
or.elim (em p)
  (assume hp : p,
    or.inr
      (show ¬q, from
        assume hq : q,
        h ⟨hp, hq⟩))
  (assume hp : ¬p,
    or.inl hp)

-- * EXERCISES
-- in the supplemental file


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

! This file was ported from Lean 3 source module analysis.normed_space.star.matrix
! leanprover-community/mathlib commit 468b141b14016d54b479eb7a0fff1e360b7e3cf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Matrix
import Mathbin.Analysis.NormedSpace.Basic
import Mathbin.Data.IsROrC.Basic
import Mathbin.LinearAlgebra.UnitaryGroup

/-!
# Unitary matrices

This file collects facts about the unitary matrices over `𝕜` (either `ℝ` or `ℂ`).
-/

open BigOperators Matrix

variable {𝕜 m n E : Type _}

section EntrywiseSupNorm

variable [IsROrC 𝕜] [Fintype n] [DecidableEq n]

theorem entry_norm_bound_of_unitary {U : Matrix n n 𝕜} (hU : U ∈ Matrix.unitaryGroup n 𝕜)
    (i j : n) : ‖U i j‖ ≤ 1 :=
  by
  -- The norm squared of an entry is at most the L2 norm of its row.
  have norm_sum : ‖U i j‖ ^ 2 ≤ ∑ x, ‖U i x‖ ^ 2 :=
    by
    apply Multiset.single_le_sum
    · intro x h_x
      rw [Multiset.mem_map] at h_x
      cases' h_x with a h_a
      rw [← h_a.2]
      apply sq_nonneg
    · rw [Multiset.mem_map]
      use j
      simp only [eq_self_iff_true, Finset.mem_univ_val, and_self_iff, sq_eq_sq]
  -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ
  have diag_eq_norm_sum : (U ⬝ Uᴴ) i i = ∑ x : n, ‖U i x‖ ^ 2 := by
    simp only [Matrix.mul_apply, Matrix.conjTranspose_apply, ← starRingEnd_apply, IsROrC.mul_conj,
      IsROrC.normSq_eq_def', IsROrC.of_real_pow]
  -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ, real part
  have re_diag_eq_norm_sum : IsROrC.re ((U ⬝ Uᴴ) i i) = ∑ x : n, ‖U i x‖ ^ 2 :=
    by
    rw [IsROrC.ext_iff] at diag_eq_norm_sum
    rw [diag_eq_norm_sum.1]
    norm_cast
  -- Since U is unitary, the diagonal entries of U ⬝ Uᴴ are all 1
  have mul_eq_one : U ⬝ Uᴴ = 1 := unitary.mul_star_self_of_mem hU
  have diag_eq_one : IsROrC.re ((U ⬝ Uᴴ) i i) = 1 := by
    simp only [mul_eq_one, eq_self_iff_true, Matrix.one_apply_eq, IsROrC.one_re]
  -- Putting it all together
  rw [← sq_le_one_iff (norm_nonneg (U i j)), ← diag_eq_one, re_diag_eq_norm_sum]
  exact norm_sum
#align entry_norm_bound_of_unitary entry_norm_bound_of_unitary

attribute [local instance] Matrix.normedAddCommGroup

/-- The entrywise sup norm of a unitary matrix is at most 1. -/
theorem entrywise_sup_norm_bound_of_unitary {U : Matrix n n 𝕜} (hU : U ∈ Matrix.unitaryGroup n 𝕜) :
    ‖U‖ ≤ 1 := by
  simp_rw [pi_norm_le_iff_of_nonneg zero_le_one]
  intro i j
  exact entry_norm_bound_of_unitary hU _ _
#align entrywise_sup_norm_bound_of_unitary entrywise_sup_norm_bound_of_unitary

end EntrywiseSupNorm


/-
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
-/
import algebra.order.group.abs
import algebra.order.monoid.min_max

/-!
# `min` and `max` in linearly ordered groups.

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

section
variables {α : Type*} [group α] [linear_order α] [covariant_class α α (*) (≤)]

@[simp, to_additive] lemma max_one_div_max_inv_one_eq_self (a : α) :
  max a 1 / max a⁻¹ 1 = a :=
by { rcases le_total a 1 with h|h; simp [h] }

alias max_zero_sub_max_neg_zero_eq_self ← max_zero_sub_eq_self

end

section linear_ordered_comm_group
variables {α : Type*} [linear_ordered_comm_group α] {a b c : α}

@[to_additive min_neg_neg]
lemma min_inv_inv' (a b : α) : min (a⁻¹) (b⁻¹) = (max a b)⁻¹ :=
eq.symm $ @monotone.map_max α αᵒᵈ _ _ has_inv.inv a b $ λ a b, inv_le_inv_iff.mpr

@[to_additive max_neg_neg]
lemma max_inv_inv' (a b : α) : max (a⁻¹) (b⁻¹) = (min a b)⁻¹ :=
eq.symm $ @monotone.map_min α αᵒᵈ _ _ has_inv.inv a b $ λ a b, inv_le_inv_iff.mpr

@[to_additive min_sub_sub_right]
lemma min_div_div_right' (a b c : α) : min (a / c) (b / c) = min a b / c :=
by simpa only [div_eq_mul_inv] using min_mul_mul_right a b (c⁻¹)

@[to_additive max_sub_sub_right]
lemma max_div_div_right' (a b c : α) : max (a / c) (b / c) = max a b / c :=
by simpa only [div_eq_mul_inv] using max_mul_mul_right a b (c⁻¹)

@[to_additive min_sub_sub_left]
lemma min_div_div_left' (a b c : α) : min (a / b) (a / c) = a / max b c :=
by simp only [div_eq_mul_inv, min_mul_mul_left, min_inv_inv']

@[to_additive max_sub_sub_left]
lemma max_div_div_left' (a b c : α) : max (a / b) (a / c) = a / min b c :=
by simp only [div_eq_mul_inv, max_mul_mul_left, max_inv_inv']

end linear_ordered_comm_group

section linear_ordered_add_comm_group
variables {α : Type*} [linear_ordered_add_comm_group α] {a b c : α}

lemma max_sub_max_le_max (a b c d : α) : max a b - max c d ≤ max (a - c) (b - d) :=
begin
  simp only [sub_le_iff_le_add, max_le_iff], split,
  calc a = a - c + c : (sub_add_cancel a c).symm
  ... ≤ max (a - c) (b - d) + max c d : add_le_add (le_max_left _ _) (le_max_left _ _),
  calc b = b - d + d : (sub_add_cancel b d).symm
  ... ≤ max (a - c) (b - d) + max c d : add_le_add (le_max_right _ _) (le_max_right _ _)
end

lemma abs_max_sub_max_le_max (a b c d : α) : |max a b - max c d| ≤ max (|a - c|) (|b - d|) :=
begin
  refine abs_sub_le_iff.2 ⟨_, _⟩,
  { exact (max_sub_max_le_max _ _ _ _).trans (max_le_max (le_abs_self _) (le_abs_self _)) },
  { rw [abs_sub_comm a c, abs_sub_comm b d],
    exact (max_sub_max_le_max _ _ _ _).trans (max_le_max (le_abs_self _) (le_abs_self _)) }
end

lemma abs_min_sub_min_le_max (a b c d : α) : |min a b - min c d| ≤ max (|a - c|) (|b - d|) :=
by simpa only [max_neg_neg, neg_sub_neg, abs_sub_comm]
  using abs_max_sub_max_le_max (-a) (-b) (-c) (-d)

lemma abs_max_sub_max_le_abs (a b c : α) : |max a c - max b c| ≤ |a - b| :=
by simpa only [sub_self, abs_zero, max_eq_left (abs_nonneg _)]
  using abs_max_sub_max_le_max a c b c

end linear_ordered_add_comm_group


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

import algebra.char_p.basic
import linear_algebra.finsupp_vector_space

/-!
# Multivariate polynomials over commutative rings

This file contains basic facts about multivariate polynomials over commutative rings, for example
that the monomials form a basis.

## Main definitions

* `restrict_total_degree σ R m`: the subspace of multivariate polynomials indexed by `σ` over the
  commutative ring `R` of total degree at most `m`.
* `restrict_degree σ R m`: the subspace of multivariate polynomials indexed by `σ` over the
  commutative ring `R` such that the degree in each individual variable is at most `m`.

## Main statements

* The multivariate polynomial ring over a commutative ring of positive characteristic has positive
  characteristic.
* `basis_monomials`: shows that the monomials form a basis of the vector space of multivariate
  polynomials.

## TODO

Generalise to noncommutative (semi)rings
-/

noncomputable theory

open_locale classical

open set linear_map submodule
open_locale big_operators polynomial

universes u v
variables (σ : Type u) (R : Type v) [comm_ring R] (p m : ℕ)

namespace mv_polynomial

section char_p

instance [char_p R p] : char_p (mv_polynomial σ R) p :=
{ cast_eq_zero_iff := λ n, by rw [← C_eq_coe_nat, ← C_0, C_inj, char_p.cast_eq_zero_iff R p] }

end char_p

section homomorphism

lemma map_range_eq_map {R S : Type*} [comm_ring R] [comm_ring S] (p : mv_polynomial σ R)
  (f : R →+* S) :
  finsupp.map_range f f.map_zero p = map f p :=
begin
  -- `finsupp.map_range_finset_sum` expects `f : R →+ S`
  change finsupp.map_range (f : R →+ S) (f : R →+ S).map_zero p = map f p,
  rw [p.as_sum, finsupp.map_range_finset_sum, (map f).map_sum],
  refine finset.sum_congr rfl (assume n _, _),
  rw [map_monomial, ← single_eq_monomial, finsupp.map_range_single, single_eq_monomial,
    f.coe_add_monoid_hom],
end

end homomorphism

section degree

/-- The submodule of polynomials of total degree less than or equal to `m`.-/
def restrict_total_degree : submodule R (mv_polynomial σ R) :=
finsupp.supported _ _ {n | n.sum (λn e, e) ≤ m }

/-- The submodule of polynomials such that the degree with respect to each individual variable is
less than or equal to `m`.-/
def restrict_degree (m : ℕ) : submodule R (mv_polynomial σ R) :=
finsupp.supported _ _ {n | ∀i, n i ≤ m }

variable {R}

lemma mem_restrict_total_degree (p : mv_polynomial σ R) :
  p ∈ restrict_total_degree σ R m ↔ p.total_degree ≤ m :=
begin
  rw [total_degree, finset.sup_le_iff],
  refl
end

lemma mem_restrict_degree (p : mv_polynomial σ R) (n : ℕ) :
  p ∈ restrict_degree σ R n ↔ (∀s ∈ p.support, ∀i, (s : σ →₀ ℕ) i ≤ n) :=
begin
  rw [restrict_degree, finsupp.mem_supported],
  refl
end

lemma mem_restrict_degree_iff_sup (p : mv_polynomial σ R) (n : ℕ) :
  p ∈ restrict_degree σ R n ↔ ∀i, p.degrees.count i ≤ n :=
begin
  simp only [mem_restrict_degree, degrees, multiset.count_finset_sup, finsupp.count_to_multiset,
    finset.sup_le_iff],
  exact ⟨assume h n s hs, h s hs n, assume h s hs n, h n s hs⟩
end

variables (σ R)

/-- The monomials form a basis on `mv_polynomial σ R`. -/
def basis_monomials : basis (σ →₀ ℕ) R (mv_polynomial σ R) := finsupp.basis_single_one

@[simp] lemma coe_basis_monomials :
  (basis_monomials σ R : (σ →₀ ℕ) → mv_polynomial σ R) = λ s, monomial s 1 :=
rfl

lemma linear_independent_X : linear_independent R (X : σ → mv_polynomial σ R) :=
(basis_monomials σ R).linear_independent.comp
  (λ s : σ, finsupp.single s 1) (finsupp.single_left_injective one_ne_zero)

end degree

end mv_polynomial

/- this is here to avoid import cycle issues -/
namespace polynomial

/-- The monomials form a basis on `polynomial R`. -/
noncomputable def basis_monomials : basis ℕ R R[X] :=
finsupp.basis_single_one.map (to_finsupp_iso_alg R).to_linear_equiv.symm

@[simp] lemma coe_basis_monomials :
  (basis_monomials R : ℕ → R[X]) = λ s, monomial s 1 :=
_root_.funext $ λ n, of_finsupp_single _ _

end polynomial


import data.real.basic

variables (f : ℝ → ℝ) (a b : ℝ)

#check @lt_of_not_ge
#check @not_lt_of_gt

-- BEGIN
example (h : monotone f) (h' : f a < f b) : a < b :=
begin
  apply lt_of_not_ge,
  intro hab,
  have : f a ≥ f b,
    from h hab,
  apply not_lt_of_ge this,
  exact h',
end

example (h : a ≤ b) (h' : f b < f a) : ¬ monotone f :=
begin
  intro fmono,
  have : f a ≤ f b,
   from fmono h,
  apply not_lt_of_ge this,
  exact h',
end
-- END


import MyNat.Addition
import MyNat.Multiplication
import MultiplicationWorld.Level5
import MultiplicationWorld.Level8
namespace MyNat
open MyNat

/-!
# Multiplication World

## Level 9: `mul_left_comm`

You are equipped with

* `mul_assoc (a b c : MyNat) : (a * b) * c = a * (b * c)`
* `mul_comm (a b : MyNat) : a * b = b * a`

Re-read the docs for `rw` so you know all the tricks.
You can see them in the [Tactics section](../Tactics.lean.md) on the left.

## Lemma
For all natural numbers `a` `b` and `c`, we have `a(bc) = b(ac)`
-/
lemma mul_left_comm (a b c : MyNat) : a * (b * c) = b * (a * c) := by
  rw [←mul_assoc]
  rw [mul_comm a]
  rw [mul_assoc]

/-!
And now you can teach the `simp` tactic these new tricks:
-/
attribute [simp] mul_assoc mul_comm mul_left_comm
/-!
and all of a sudden Lean can automatically do levels which are
very boring for a human, for example:
-/
example (a b c d e : MyNat) :
  (((a*b)*c)*d)*e=(c*((b*e)*a))*d := by
  simp

/-!
If you feel like attempting Advanced Multiplication world
you'll have to do [Function World](../FunctionWorld.lean.md) and the Proposition Worlds first.
These worlds assume a certain amount of mathematical maturity
(perhaps 1st year undergraduate level).

Your other possibility is [Power World](../PowerWorld.lean.md).
-/


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

import analysis.normed_space.star.basic
import algebra.star.module
import analysis.complex.basic

/-!
# Complex normed star modules and algebras

Facts about star modules and star algebras over the complex numbers.

## Main definitions

* `star_module.mul_neg_I_lin`: multiplication by -I as a real-linear equivalence between the
  skew-adjoint and self-adjoint elements of a star module.
* `star_module.im`: the imaginary part of an element of a star module, defined via
  `skew_adjoint_part`.

-/

variables {E : Type*}

namespace star_module
open_locale complex_conjugate
open complex

variables [add_comm_group E] [star_add_monoid E] [module ℂ E] [star_module ℂ E]

/-- Multiplication by -I as a real-linear equivalence between the skew-adjoint and self-adjoint
elements of a star module. -/
@[simps] def mul_neg_I_lin : skew_adjoint E ≃ₗ[ℝ] self_adjoint E :=
{ to_fun := λ x, ⟨-I • x, by simp [self_adjoint.mem_iff]⟩,
  inv_fun := λ x, ⟨I • x, by simp [skew_adjoint.mem_iff]⟩,
  map_add' := λ x y, by { ext, simp only [add_subgroup.coe_add, smul_add, add_subgroup.coe_mk] },
  map_smul' := λ r x, by { ext, simp only [neg_smul, neg_inj, skew_adjoint.coe_smul,
    add_subgroup.coe_mk, ring_hom.id_apply, self_adjoint.coe_smul, smul_neg, smul_comm I], },
  left_inv := λ x, by simp only [neg_smul, add_subgroup.coe_mk, smul_neg, ←mul_smul, I_mul_I,
                                 neg_neg, one_smul, set_like.eta],
  right_inv := λ x, by simp only [←mul_smul, I_mul_I, add_subgroup.coe_mk, neg_mul, neg_neg,
                                  one_smul, set_like.eta] }

/-- The imaginary part of an element of a star module, as a real-linear map.  -/
@[simps] noncomputable def im : E →ₗ[ℝ] self_adjoint E :=
  mul_neg_I_lin.to_linear_map.comp (skew_adjoint_part ℝ)

/-- The real part of an element of a star module, as a real-linear map. This is simply an
abbreviation for `self_adjoint_part ℝ`. -/
@[simps] noncomputable abbreviation re : E →ₗ[ℝ] self_adjoint E := self_adjoint_part ℝ

/-- An element of a complex star module can be decomposed into self-adjoint "real" and
"imaginary" parts -/
lemma re_add_im (x : E) : (re x : E) + I • im x = x :=
by simp [←mul_smul, I_mul_I, ←smul_add, ←two_smul ℝ]

end star_module


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import solutions.section14polynomials.sheet02noetherian

/-!

# An auxiliary construction

I haven't talked about which proof of the Hilbert Basis Theorem we'll
be formalising, so let me say a bit about this here. The theorem
states that if `R` is a Noetherian (commutative) ring then so is
the polynomial ring `R[X]`. So, given an ideal `I` of `R[X]` we need
to come up with a finite set of generators, and the only tool we have
is that any ideal of `R` has a finite set of generators. So, however
this proof goes, we are going to probably be wanting to construct
ideals of `R` given an ideal of `R[X]`.

The `aux_ideal` construction is of this nature. An ideal of `R[X]`
is by definition an `R[X]`-submodule of `R[X]` so it's also
an `R`-submodule of `R[X]` (this is a bit like saying that a complex
vector space is obviously also a real vector space). The `lcoeff`
maps, taking a polynomial to its coefficient of `X^n`,  are `R`-linear
maps from `R[X]` to `R`, so we can push `R`-submodules of `R[X]` along
these maps (i.e. look at their images) to get `R`-submodules of `R`,
which is the same thing as ideals of `R`. The submodules we will push
forward are the following: given an ideal `I` of `R[X]`, and a natural
number `n`, we will consider `I` as an `R`-submodule of `R[X]`, we will
intersect it with `M R n` (the `R`-submodule of polynomials of degree
at most `n`), and we will then look at its image under `lcoeff R n`.
By definition then, the elements of `aux_ideal I n` will be the
coeficients of `X^n` of the polynomials in `I` which have degree
at most `n`, and this abstract way of describing this set shows that
it is an ideal of `R`.

Again, more briefly: if `I` is an ideal of `R[X]` and `n` is a natural,
then `aux_ideal I n` is the ideal of `R` consisting of the coefficients
of `X^n` of the elements of `I` with `nat_degree` at most `n`.

The first result we are aiming for in this file is that
`aux_ideal I n` is monotone as a function of `n`, that is, if `n ≤ m`
then `aux_ideal I n ≤ aux_ideal I m`.

-/

variables {R : Type} [comm_ring R] (I : ideal (polynomial R))

open polynomial

/-

`I.restrict_scalars R` means the ideal `I`, regarded as an `R`-submodule
of `R[X]`. The `⊓` is just intersection of submodules. The `map`
is `submodule.map` which is the function which eats a linear map
(in this case `lcoeff R n`) and outputs a function sending submodules
of the domain of the map to submodules of the codomain; the function
itself is just "image of the submodule under the linear map".

-/

/-- If `I` is an ideal of `polynomial R` then `aux_ideal I n` is the ideal of `R`
obtained by pushing forward `I ∩ {polynomials of degree ≤ n}` along the linear map `lcoeff n`
sending a polynomial to its coefficient of `X^n`.

One can imagine `aux_ideal I n` as the ideal consisting of `0` and the coefficient of `X^n`
in all of the degree `n` polynomials in `I`, but this case split definition is harder
to work with in practice. -/
noncomputable def aux_ideal (n : ℕ) :=
(I.restrict_scalars R ⊓ M R n).map (lcoeff R n)

namespace aux_ideal

/-

We're going to prove that `aux_ideal I n` is monotone for fixed `I`, i.e. it gets
bigger as `n` gets bigger.

Make sure you know a maths proof before embarking on this.

Useful API:

`I.mul_mem_right r : p ∈ I → p * r ∈ I`
`polynomial.nat_degree_mul_le : (p * q).nat_degree ≤ p.nat_degree + q.nat_degree`
`p.coeff_mul_X : (n : ℕ), (p * X).coeff (n + 1) = p.coeff n`

and note that `lcoeff R n f` is definitionally `f.coeff n`.

-/

lemma mono_aux (n : ℕ) :
  aux_ideal I n ≤ aux_ideal I (n + 1) :=
begin
  rintro r ⟨p, ⟨(hp1 : p ∈ I), (hp2 : p.nat_degree ≤ n)⟩, rfl⟩,
  refine ⟨p * X, ⟨I.mul_mem_right X hp1, _⟩, _⟩,
  { -- change (p * X).nat_degree ≤ _,
    refine le_trans (nat_degree_mul_le) _,
    refine add_le_add hp2 _,
    exact nat_degree_X_le },
  { apply p.coeff_mul_X },
end

-- this is now a one-liner
lemma mono : monotone (aux_ideal I) := monotone_nat_of_le_succ (mono_aux _)

/- Given an ideal `I` and a natural number `n`, we have been
considering the map from `I ∩ {degree ≤ n}` to `R` defined by
"take coefficient of `X^n`". The `lift` function below is
a one-sided inverse to this map. Given an element of `R`,
if it's in the image then we send it to a random preimage
in `I ∩ (degree ≤ n)` and if it's not then we just send it to 0.
Note the use of `exists.some`; the statement "I am in the image"
is definitionally equal to "there exists something in the domain
which maps to me", and `exists.some` chooses a random thing in the
image with this property.

-/

noncomputable def lift (n : ℕ) (r : R) [decidable (r ∈ aux_ideal I n)] : polynomial R :=
if hr : r ∈ aux_ideal I n then (submodule.mem_map.1 hr).some else 0

variables {n : ℕ} {r : R} [decidable (r ∈ aux_ideal I n)]

lemma lift_def (n : ℕ) (r : R) [decidable (r ∈ aux_ideal I n)] :
lift I n r = if hr : r ∈ aux_ideal I n then (submodule.mem_map.1 hr).some else 0 :=
begin
  refl,
end

variable {I}

-- you can use `dif_neg` to prove this lemma.
lemma lift_eq_zero_of_ne (hr : ¬ r ∈ aux_ideal I n) : lift I n r = 0 :=
begin
--  rw lift_def,
  exact dif_neg hr,
end

-- you need to do a case split for this one. The definition of `lift`
-- used ` (submodule.mem_map.1 hr).some` so this proof will need
-- ` (submodule.mem_map.1 hr).some_spec` somewhere. Note also `dif_pos` :-)
lemma lift_mem :
  (lift I n r) ∈ submodule.restrict_scalars R I ⊓ M R n :=
begin
  rw lift_def,
  split_ifs with hr,
  { have := (submodule.mem_map.1 hr).some_spec, -- never used `⇑(lcoeff R n) _.some = r`
    exact this.1 },
  { apply submodule.zero_mem },
end

-- this is a one-liner
lemma lift_mem_I : lift I n r ∈ I :=
begin
  exact lift_mem.1,
end

-- this is a one-liner too (thanks to definitional equality abuse)
lemma lift_nat_degree_le :
  (lift I n r).nat_degree ≤ n :=
begin
  exact lift_mem.2,
end

lemma lift_spec (hr : r ∈ aux_ideal I n) :
  lcoeff R n (lift I n r) = r :=
begin
  rw lift_def,
  rw dif_pos hr,
  have := (submodule.mem_map.1 hr).some_spec, -- used it now
  exact this.2,
end

end aux_ideal


import Aesop

/-!
Source: https://github.com/IPDSnelting/tba-2022/blob/master/TBA/AesopSort.lean
-/

variable [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)]

@[aesop safe constructors]
inductive Sorted : List α → Prop where
  | nil : Sorted []
  | single : Sorted [x]
  | cons_cons : x ≤ x' → Sorted (x' :: xs) → Sorted (x :: x' :: xs)

@[simp] def insertInOrder (a : α) : List α → List α
  | [] => [a]
  | x :: xs =>
    if a ≤ x then
      a :: x :: xs
    else
      x :: insertInOrder a xs

@[simp] def insertionSort : List α → List α
  | []      => []
  | x :: xs => insertInOrder x (insertionSort xs)

variable (antisymm : ∀ {x y : α}, ¬ (x ≤ y) → y ≤ x)

theorem sorted_insertInOrder {xs : List α} (h : Sorted xs) : Sorted (insertInOrder x xs) := by
  induction h <;> aesop

theorem sorted_insertionSort {xs : List α} : Sorted (insertionSort xs) := by
  induction xs <;> aesop (add safe sorted_insertInOrder)

inductive Perm : List α → List α → Prop where
  | nil : Perm [] []
  | cons : Perm xs xs' → Perm (x :: xs) (x :: xs')
  | swap : Perm (x :: y :: xs) (y :: x :: xs)
  | trans : Perm xs ys → Perm ys zs → Perm xs zs

attribute [aesop safe] Perm.nil
attribute [aesop unsafe] Perm.cons
attribute [aesop unsafe] Perm.swap
attribute [aesop unsafe] Perm.trans

theorem Perm.symm : Perm xs ys → Perm ys xs := by
  intro h
  induction h <;> aesop

@[aesop safe]
theorem perm_insertInOrder {xs : List α} : Perm (x :: xs) (insertInOrder x xs) := by
  induction xs <;> aesop

theorem perm_insertionSort {xs : List α} : Perm xs (insertionSort xs) := by
  induction xs with
  | nil => aesop
  | cons x xs =>
    cases xs with
    | nil => aesop
    | cons x' xs =>
      apply Perm.trans (ys := x :: insertInOrder x' xs)
      · exact Perm.cons perm_insertInOrder
      · apply Perm.trans (ys := x :: insertionSort (x' :: xs))
        · aesop (add safe Perm.cons, unsafe [cases List, Perm.symm])
        · aesop

def IsSortingAlgorithm (f : List α → List α) := ∀ xs, Perm xs (f xs) ∧ Sorted (f xs)

theorem isSortingAlgorithm_insertionSort : IsSortingAlgorithm (insertionSort (α := α)) :=
  fun _xs => ⟨perm_insertionSort, sorted_insertionSort @antisymm⟩


import algebra.parity

theorem even_times_self_is_even {n : ℕ} : -- n is a natural number
  (even n) → even (n ^ 2) := -- if n is even, then n ^ 2 is even
begin
  intro p,
  -- assume that n is even

  rw even at *,
  -- rewrite the definition of "even"

  cases p with r h,
  -- since p is a hypothesis,
  --assume such a number r exists

  use (r ^ 2 + r ^ 2),
  -- we need to find a number m
  -- such that n ^ 2 = m + m
  -- (definition of "even")
  -- let's use 2 r ^ 2

  rw h,
  -- replace n by r + r

  ring, -- simplify algebra
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.quaternion
import analysis.normed_space.inner_product

/-!
# Quaternions as a normed algebra

In this file we define the following structures on the space `ℍ := ℍ[ℝ]` of quaternions:

* inner product space;
* normed ring;
* normed space over `ℝ`.

## Notation

The following notation is available with `open_locale quaternion`:

* `ℍ` : quaternions

## Tags

quaternion, normed ring, normed space, normed algebra
-/

localized "notation `ℍ` := quaternion ℝ" in quaternion
open_locale real_inner_product_space

noncomputable theory

namespace quaternion

instance : has_inner ℝ ℍ := ⟨λ a b, (a * b.conj).re⟩

lemma inner_self (a : ℍ) : ⟪a, a⟫ = norm_sq a := rfl

lemma inner_def (a b : ℍ) : ⟪a, b⟫ = (a * b.conj).re := rfl

instance : inner_product_space ℝ ℍ :=
inner_product_space.of_core
{ inner := has_inner.inner,
  conj_sym := λ x y, by simp [inner_def, mul_comm],
  nonneg_re := λ x, norm_sq_nonneg,
  definite := λ x, norm_sq_eq_zero.1,
  add_left := λ x y z, by simp only [inner_def, add_mul, add_re],
  smul_left := λ x y r, by simp [inner_def] }

lemma norm_sq_eq_norm_sq (a : ℍ) : norm_sq a = ∥a∥ * ∥a∥ :=
by rw [← inner_self, real_inner_self_eq_norm_sq]

instance : norm_one_class ℍ :=
⟨by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_one, real.sqrt_one]⟩

@[simp] lemma norm_mul (a b : ℍ) : ∥a * b∥ = ∥a∥ * ∥b∥ :=
begin
  simp only [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_mul],
  exact real.sqrt_mul norm_sq_nonneg _
end

@[simp, norm_cast] lemma norm_coe (a : ℝ) : ∥(a : ℍ)∥ = ∥a∥ :=
by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq_coe, real.sqrt_sq_eq_abs, real.norm_eq_abs]

noncomputable instance : normed_ring ℍ :=
{ dist_eq := λ _ _, rfl,
  norm_mul := λ a b, (norm_mul a b).le }

noncomputable instance : normed_algebra ℝ ℍ :=
{ norm_algebra_map_eq := norm_coe,
  to_algebra := quaternion.algebra }

instance : has_coe ℂ ℍ := ⟨λ z, ⟨z.re, z.im, 0, 0⟩⟩

@[simp, norm_cast]

@[simp, norm_cast] lemma coe_complex_add (z w : ℂ) : ↑(z + w) = (z + w : ℍ) := by ext; simp
@[simp, norm_cast] lemma coe_complex_mul (z w : ℂ) : ↑(z * w) = (z * w : ℍ) := by ext; simp
@[simp, norm_cast] lemma coe_complex_zero : ((0 : ℂ) : ℍ) = 0 := rfl
@[simp, norm_cast] lemma coe_complex_one : ((1 : ℂ) : ℍ) = 1 := rfl
@[simp, norm_cast] lemma coe_real_complex_mul (r : ℝ) (z : ℂ) : (r • z : ℍ) = ↑r * ↑z :=
by ext; simp
@[simp, norm_cast] lemma coe_complex_coe (r : ℝ) : ((r : ℂ) : ℍ) = r := rfl

/-- Coercion `ℂ →ₐ[ℝ] ℍ` as an algebra homomorphism. -/
def of_complex : ℂ →ₐ[ℝ] ℍ :=
{ to_fun := coe,
  map_one' := rfl,
  map_zero' := rfl,
  map_add' := coe_complex_add,
  map_mul' := coe_complex_mul,
  commutes' := λ x, rfl }

@[simp] lemma coe_of_complex : ⇑of_complex = coe := rfl

end quaternion


/- LoVe Exercise 4: Functional Programming -/

import .love04_functional_programming_demo

namespace LoVe

/- Question 1: Reverse of a List -/

/- We define a new accumulator-based version of `reverse`. The first argument
serves as the accumulator. This definition is _tail-recursive_, meaning that
compilers and interpreters can easily optimize the recursion away, resulting in
more efficient code. -/

def areverse {α : Type} : list α → list α → list α
| ys []        := ys
| ys (x :: xs) := areverse (x :: ys) xs

/- 1.1. Our intention is that `areverse [] xs` should be equal to `reverse xs`.
But if we start an induction, we quickly see that the induction hypothesis is
not strong enough. Start by proving the following generalization (using pattern
matching or the `induction` tactic): -/

lemma areverse_eq_reverse_append {α : Type} :
  ∀ys xs : list α, areverse ys xs = reverse xs ++ ys
| ys []        := by refl
| ys (x :: xs) := by simp [reverse, areverse, areverse_eq_reverse_append _ xs]

/- 1.2. Derive the desired equation. -/

lemma areverse_eq_reverse {α : Type} (xs : list α) :
  areverse [] xs = reverse xs :=
by simp [areverse_eq_reverse_append]

/- 1.3. Prove the following property. Hint: A one-line inductionless proof is
 possible. -/

lemma areverse_areverse {α : Type} (xs : list α) :
  areverse [] (areverse [] xs) = xs :=
by simp [areverse_eq_reverse, reverse_reverse]

/- Question 2: Drop and Take -/

/- The `drop` function removes the first `n` elements from the front of a
list. -/

def drop {α : Type} : ℕ → list α → list α
| 0       xs        := xs
| (_ + 1) []        := []
| (m + 1) (x :: xs) := drop m xs

/- Its relative `take` returns a list consisting of the the first `n` elements
at the front of a list. -/

/- 2.1. Define `take`. -/

/- To avoid unpleasant surprises in the proofs, we recommend that you follow the
same recursion pattern as for `drop` above. -/

def take {α : Type} : ℕ → list α → list α
| 0       _         := []
| (_ + 1) []        := []
| (m + 1) (x :: xs) := x :: take m xs

#reduce take 0 [3, 7, 11]  -- expected: []
#reduce take 1 [3, 7, 11]  -- expected: [3]
#reduce take 2 [3, 7, 11]  -- expected: [3, 7]
#reduce take 3 [3, 7, 11]  -- expected: [3, 7, 11]
#reduce take 4 [3, 7, 11]  -- expected: [3, 7, 11]

-- when `#reduce` fails for some obscure reason, try `#eval`:
#eval take 2 ["a", "b", "c"]   -- expected: ["a", "b"]

/- 2.2. Prove the following lemmas. Notice that they are registered as
simplification rules thanks to the `@[simp]` attribute. -/

@[simp] lemma drop_nil {α : Type} :
  ∀n : ℕ, drop n ([] : list α) = []
| 0       := by refl
| (_ + 1) := by refl

@[simp] lemma take_nil {α : Type} :
  ∀n : ℕ, take n ([] : list α) = []
| 0       := by refl
| (_ + 1) := by refl

/- 2.3. Follow the recursion pattern of `drop` and `take` to prove the following
lemmas. In other words, for each lemma, there should be three cases, and the
third case will need to invoke the induction hypothesis.

The first case is shown for `drop_drop`. Beware of the fact that there are three
variables in the `drop_drop` lemma (but only two arguments to `drop`).

Hint: The `refl` tactic might be useful in the third case of `drop_drop`. -/

lemma drop_drop {α : Type} :
  ∀(m n : ℕ) (xs : list α), drop n (drop m xs) = drop (n + m) xs
| 0       n xs        := by refl
| (_ + 1) _ []        := by simp [drop]
| (m + 1) n (x :: xs) :=
  begin
    simp [drop, drop_drop m n xs],
    refl
  end

lemma take_take {α : Type} :
  ∀(m : ℕ) (xs : list α), take m (take m xs) = take m xs
| 0       _         := by refl
| (_ + 1) []        := by refl
| (m + 1) (x :: xs) := by simp [take, take_take m xs]

lemma take_drop {α : Type} :
  ∀(n : ℕ) (xs : list α), take n xs ++ drop n xs = xs
| 0       _         := by refl
| (_ + 1) []        := by refl
| (m + 1) (x :: xs) := by simp [take, drop, take_drop m]

/- Question 3: λ-Terms -/

/- 3.1. Define an inductive type corresponding to the untyled λ-terms, as given
by the following context-free grammar:

<lam> ::= 'var' <string>
        | 'abs' <string> <lam>
        | 'app' <lam> <lam> -/

inductive lam : Type
| var : string → lam
| abs : string → lam → lam
| app : lam → lam → lam

export lam (var abs app)

/- 3.2. Register a textual representation of the type `lam`. Make sure to supply
enough parentheses to guarantee that the output is unambiguous. -/

def lam.repr : lam → string
| (var s)   := s
| (abs s t) := "(λ" ++ s ++ ", " ++ lam.repr t ++ ")"
| (app t u) := "(" ++ lam.repr t ++ " " ++ lam.repr u ++ ")"

instance : has_repr lam :=
⟨lam.repr⟩

/- Question 4 (**optional**): Concatenation -/

/- Consider the following Lean definition of 2–3 trees as an inductive type: -/

inductive tttree (α : Type) : Type
| empty {} : tttree
| bin      : α → tttree → tttree → tttree
| ter      : α → tttree → tttree → tttree → tttree

export tttree (empty bin ter)

/- 4.1 (**optional**). Complete the following Lean definition. The `map_tree`
function should apply its argument `f` to all values of type α stored in the
tree and otherwise preserve the tree's structure. -/

def map_tttree {α β : Type} (f : α → β) : tttree α → tttree β
| empty         := empty
| (bin a l r)   := bin (f a) (map_tttree l) (map_tttree r)
| (ter a l m r) := ter (f a) (map_tttree l) (map_tttree m) (map_tttree r)

/- 4.2 (**optional**). Prove the following lemma about your definition of
`map_tree`. -/

lemma map_tttree_id {α : Type} :
  ∀t : tttree α, map_tttree (λx : α, x) t = t
| empty         := by refl
| (bin a l r)   := by simp [map_tttree, map_tttree_id l, map_tttree_id r]
| (ter a l m r) :=
  by simp [map_tttree, map_tttree_id l, map_tttree_id m, map_tttree_id r]

/- 4.3 (**optional**). Complete the following Lean definition. The `set_tree`
function should return the set of all values of type α stored in the tree. In
your answer, you may use traditional set notations regardless of whether they
are actually supported by Lean. -/

def set_tttree {α : Type} : tttree α → set α
| empty         := ∅
| (bin a l r)   := insert a (set_tttree l ∪ set_tttree r)
| (ter a l m r) := insert a (set_tttree l ∪ set_tttree m ∪ set_tttree r)

/- A _congruence rule_ is a lemma that can be used to lift an equivalence
relation between terms to the same terms occurring under a common context.
Congruence rules for equality are built into Lean's logic. In the following
example, the equivalence relation is `=`, the terms are `f` and `g`, and the
context is `map_tree … t`: -/

lemma map_tttree_congr_weak {α β : Type} (f g : α → β) (f = g) (t : tttree α) :
  map_tttree f t = map_tttree g t :=
by simp *

/- 4.4 (**optional**). The above rule is not as flexible as it could be,
because it requires `f = g`. As long as `f` and `g` are equal for all values
`x : α` stored in `t`, we have `map_tree f t = map_tree g t`, even if `f` and
`g` disagree on other `α` values. Inspired by this observation, prove the
following stronger congruence rule. -/

lemma map_tttree_congr_strong {α β : Type} (f g : α → β) :
  ∀t : tttree α, (∀x, x ∈ set_tttree t → f x = g x) →
  map_tttree f t = map_tttree g t
| empty         := by intros; refl
| (bin a l r)   :=
  begin
    intros,
    simp [map_tttree],
    apply and.intro,
    { apply a_1,
      simp [set_tttree] },
    apply and.intro,
    { apply map_tttree_congr_strong,
      intros,
      apply a_1,
      simp [set_tttree],
      cc },
    { apply map_tttree_congr_strong,
      intros,
      apply a_1,
      simp [set_tttree],
      cc },
  end
| (ter a l m r)   :=
  begin
    intros,
    simp [map_tttree],
    apply and.intro,
    { apply a_1,
      simp [set_tttree] },
    apply and.intro,
    { apply map_tttree_congr_strong,
      intros,
      apply a_1,
      simp [set_tttree],
      cc },
    apply and.intro,
    { apply map_tttree_congr_strong,
      intros,
      apply a_1,
      simp [set_tttree],
      cc },
    { apply map_tttree_congr_strong,
      intros,
      apply a_1,
      simp [set_tttree],
      cc }
  end

end LoVe


-- finset ℕ machinery for use in sums and products

import data.complex.basic
import data.finset.basic
import data.stream.defs
import order.filter.at_top_bot
open filter (at_top)
open_locale topological_space

-- Insert 0, adding 1 to existing elements
def push (N : finset ℕ) := insert 0 (finset.image (λ n, n + 1) N)

-- Subtract 1 from everything, discarding zero (left inverse of push)
def pop (N : finset ℕ) := finset.image (λ n, n - 1) (finset.erase N 0)

-- push almost cancels pop
lemma push_pop {N : finset ℕ} : push (pop N) = insert 0 N := begin
  rw [push, pop], apply finset.ext, simp,
  intro n, by_cases n0 : n = 0, { rw n0, simp },
  simp_rw or_iff_right n0,
  constructor, {
    intro h, rcases h with ⟨x,hx⟩,
    have c := nat.sub_add_cancel (nat.one_le_iff_ne_zero.mpr hx.left.left),
    rw c at hx, finish
  }, {
    intro h, existsi n,
    rw nat.sub_add_cancel (nat.one_le_iff_ne_zero.mpr n0),
    finish
  }
end

-- push is monotone
lemma push_le_push {A B : finset ℕ} : push A ≤ push B ↔ A ≤ B := begin
  simp, rw push, rw push,
  constructor, {
    intro AB, rw finset.subset_iff at ⊢ AB, intros x xA,
    have h : x+1 ∈ insert 0 (finset.image (λ (n : ℕ), n + 1) A) := by simpa,
    specialize AB h, simp at AB, assumption
  }, {
    intro AB, apply finset.insert_subset_insert, apply finset.image_mono, assumption
  }
end

-- push and products interact nicely
lemma push_prod {a : ℂ} {f : ℕ → ℂ} {N : finset ℕ} : a * N.prod f = (push N).prod (a::f) :=
  by { rw push, simp, refl }

-- The range of push is finsets containing 0
lemma push_range : set.range push = {N : finset ℕ | 0 ∈ N} := begin
  rw set.range, apply set.ext, simp, intro N, constructor, {
    intro h, rcases h with ⟨M,H⟩, rw push at H, rw ←H, exact finset.mem_insert_self 0 _
  }, {
    intro N0, existsi pop N, rw push_pop, exact finset.insert_eq_of_mem N0
  }
end

lemma push_comap_at_top : filter.comap push at_top = at_top := begin
  apply filter.comap_embedding_at_top,
  exact @push_le_push,
  intro N, existsi pop N, rw push_pop, simp, exact finset.subset_insert _ _
end

-- f ∘ push converges at_top iff f does
lemma tendsto_comp_push {A : Type} {f : finset ℕ → A} {l : filter A}
    : filter.tendsto (f ∘ push) at_top l ↔ filter.tendsto f at_top l := begin
  nth_rewrite 0 ←push_comap_at_top, apply filter.tendsto_comap'_iff,
  rw push_range,
  have h : {N : finset ℕ | 0 ∈ N} = {N : finset ℕ | {0} ≤ N} := by simp,
  rw h, exact filter.mem_at_top _
end


open tactic

variables {α : Type*}

-- TODO: write a tactic to unfold specific instances of generic notation?
theorem subset_def {s t : set α} : (s ⊆ t) = ∀ x, x ∈ s → x ∈ t := rfl
theorem union_def {s₁ s₂ : set α} : s₁ ∪ s₂ = {a | a ∈ s₁ ∨ a ∈ s₂} := rfl
theorem inter_def {s₁ s₂ : set α} : s₁ ∩ s₂ = {a | a ∈ s₁ ∧ a ∈ s₂} := rfl

theorem union_subset {s t r : set α} (sr : s ⊆ r) (tr : t ⊆ r) : s ∪ t ⊆ r :=
begin
  dsimp [subset_def, union_def] at *,
  intros x h,
  cases h; back_chaining_using_hs
end

theorem subset_inter {s t r : set α} (rs : r ⊆ s) (rt : r ⊆ t) : r ⊆ s ∩ t :=
begin
  dsimp [subset_def, inter_def] at *,
  intros x h,
  split; back_chaining_using_hs
end


import data.set classical algebra.order data.nat
open set eq.ops

namespace relations

variable {T : Type}

/- [KS]
Given a set S, a partition of S is a set X ⊆ ℘(S) (that is, a set of subsets of S) with the following properties:
1. The union of all sets in X is equal to S.
2. For any S1, S2 ∈ X with S1 ≠ S2, we have that S1 ∩ S2 = Ø (S1 and S2 are disjoint)
3. Ø ∉ X.
-/

definition pairwise_disjoint (Xs : set (set T)) := ∀ ⦃ X1 X2 : set T ⦄, X1 ∈ Xs → X2 ∈ Xs → X1 ≠ X2 → X1 ∩ X2 = ∅

structure partition (Xs : set (set T)) :=
  mk :: (cover : T → set T)
        (cover_legal : ∀ x, cover x ∈ Xs)
        (cover_spans : ∀ x, x ∈ cover x)
        (pdisjoint : pairwise_disjoint Xs)
        (ncempty : ¬ ∅ ∈ Xs)

open partition

/- [KS]
Lemma: Let S be a set and X a partition of S. Then every element u ∈ S belongs to exactly one set
Y ∈ X.
Proof: Let S be a set and X a partition of S. We will show that every element u ∈ S belongs to at least
one set Y ∈ X and to at most one set Y ∈ X.
To see that every element u ∈ S belongs to at least one set Y ∈ X, note that since X is a partition of S,
the union of all the sets in S must be equal to S. Consequently, there must be at least one set Y ∈ X
such that u ∈ Y, since otherwise the union of all sets contained in X would not be equal to S.
To see that every element u ∈ S belongs to at most one set Y ∈ X, suppose for the sake of contradiction
that u belongs to two sets Y1, Y2 ∈ X with Y1 ≠ Y2. But then x ∈ Y1 ∩ Y2, meaning that
Y1 ∩ Y2 ≠ Ø, a contradiction. We have reached a contradiction, so our assumption must have been
wrong.
Thus every element u ∈ S belongs to at most one set Y ∈ X. ■
-/

/-
definition exists_unique {A : Type} (p : A → Prop) :=
∃x, p x ∧ ∀y, p y → y = x

notation `∃!` binders `,` r:(scoped P, exists_unique P) := r

theorem exists_unique.intro {A : Type} {p : A → Prop} (w : A) (H1 : p w) (H2 : ∀y, p y → y = w) :
  ∃!x, p x :=
exists.intro w (and.intro H1 H2)

theorem exists_unique.elim {A : Type} {p : A → Prop} {b : Prop}
    (H2 : ∃!x, p x) (H1 : ∀x, p x → (∀y, p y → y = x) → b) : b :=
obtain w Hw, from H2,
H1 w (and.elim_left Hw) (and.elim_right Hw)
-/

lemma unique_set : ∀ {Xs : set (set T)}, partition Xs → ∀ (u : T), ∃! (X : set T), X ∈ Xs ∧ u ∈ X :=
  assume (Xs : set (set T)) (pXs : partition Xs) (u : T),
  show ∃! (X : set T), X ∈ Xs ∧ u ∈ X, from
  show ∃ (X : set T), (X ∈ Xs ∧ u ∈ X) ∧ (∀ Y, Y ∈ Xs ∧ u ∈ Y → Y = X), from
  let X := cover pXs u in
  have X_unique : (∀ Y, Y ∈ Xs ∧ u ∈ Y → Y = X), from
    assume (Y : set T) (Y_in_Xs_and_u_in_Y : Y ∈ Xs ∧ u ∈ Y),
    have Y_in_Xs : Y ∈ Xs, from and.left Y_in_Xs_and_u_in_Y,
    have u_in_Y : u ∈ Y, from and.right Y_in_Xs_and_u_in_Y,
    by_contradiction
      (assume (Y_neq_X : Y ≠ X),
       show false, from
       -- But then x ∈ Y1 ∩ Y2,
       have u_in_Y_cap_X : u ∈ Y ∩ X, from and.intro u_in_Y (cover_spans pXs u),
       -- meaning that Y1 ∩ Y2 ≠ Ø,
       have Y_cap_X_neq_empty : Y ∩ X ≠ ∅, from
         assume (cap_empty : Y ∩ X = ∅),
         have u_in_empty : u ∈ ∅, from cap_empty ▸ u_in_Y_cap_X,
         show false, from u_in_empty,
       -- a contradiction. We have reached a contradiction, so our assumption must have been wrong.
       absurd (pdisjoint pXs Y_in_Xs (cover_legal pXs u) Y_neq_X) Y_cap_X_neq_empty),
  -- Thus every element u ∈ S belongs to at most one set Y ∈ X. ■
  exists_unique.intro X (and.intro (cover_legal pXs u) (cover_spans pXs u)) X_unique

definition P_equiv {Xs : set (set T)} (pXs : partition Xs) (x y : T) := cover pXs x = cover pXs y

/-
To see that ~X is reflexive, we need to prove that for any u ∈ S, that u ~X u. By definition, this means
that we need to show that [u]X = [u]X, which is true because = is reflexive.
To see that ~X is symmetric, we need to show that if u ~X v, then v ~X u. By definition, this means
that we need to show that if [u]X = [v]X, then [v]X = [u]X. This is true because = is symmetric.
To see that ~X is transitive, we need to show that if u ~X v and v ~X w, then u ~X w. By definition, this
means that we need to show that if [u]X = [v]X and [v]X = [w]X, then [u]X = [w]X. This is true because
= is transitive.
-/

print definition reflexive
check reflexive
-- TODO why won't this work??
set_option formatter.hide_full_terms false

lemma P_equiv_refl : ∀ {Xs : set (set T)} (pXs : partition Xs), reflexive (P_equiv pXs) :=
  assume (Xs : set (set T)) (pXs : partition Xs),
  show reflexive (P_equiv pXs), from
  assume (u : T),
  show P_equiv pXs u u, from
  show cover pXs u = cover pXs u, from rfl

lemma P_equiv_symm : ∀ {Xs : set (set T)} (pXs : partition Xs), symmetric (P_equiv pXs) :=
  assume (Xs : set (set T)) (pXs : partition Xs),
  show symmetric (P_equiv pXs), from
  assume (u v : T),
  show P_equiv pXs u v → P_equiv pXs v u, from
  assume (uRv : cover pXs u = cover pXs v),
  show cover pXs v = cover pXs u, from uRv⁻¹

lemma P_equiv_trans : ∀ {Xs : set (set T)} (pXs : partition Xs), transitive (P_equiv pXs) :=
  assume (Xs : set (set T)) (pXs : partition Xs),
  show transitive (P_equiv pXs), from
  assume (u v w: T) (uRv : cover pXs u = cover pXs v) (vRw : cover pXs v = cover pXs w),
  show cover pXs u = cover pXs w, from vRw ▸ uRv

/- [KS]
Lemma: Let R be an equivalence relation over A, and X = { [x]R | x ∈ A }. Then ∪X = A.
Proof: Let R be an equivalence relation over A, and X = { [x]R | x ∈ A }. We will prove that ∪X ⊆ A
and A ⊆ ∪X, from which we can conclude that ∪X = A.
To show that ∪X ⊆ A, consider any x ∈ X. By definition of ∪X, since x ∈ X, this means that there is
some [y]R ∈ X such that x ∈ [y]R. By definition of [y]R, since x ∈ [y]R, this means that yRx. Since R is
a binary relation over A, this means that x ∈ A. Since our choice of x was arbitrary, this shows that if
x ∈ ∪X, then x ∈ A. Thus ∪X ⊆ A.
To show that A ⊆ ∪X, consider any x ∈ A. We will prove that x ∈ [x]R. If we can show this, then note
that since x ∈ [x]R and [x]R ∈ X, we have x ∈ X. Since our choice of x is arbitrary, this would mean
that any x ∈ A satisfies x ∈ ∪X, so A ⊆ ∪X.
So let's now prove that x ∈ [x]R. By definition, [x]R = { y ∈ A | xRy }. Since R is an equivalence relation,
R is reflexive, so xRx. Consequently, x ∈ [x]R, as required. ■
-/
print definition equivalence

definition set_of_sets (f : T → set T) : set (set T) := λ (s : set T), ∃ (u : T), s = f u
definition bigcup (Xs : set (set T)) : set T := λ (v: T), ∃ (X : set T), X ∈ Xs ∧ v ∈ X

lemma equiv_spans : ∀ {R : T → T → Prop}, equivalence R → ∀ v, v ∈ bigcup (set_of_sets R) :=
  assume (R : T → T → Prop) (R_equiv : equivalence R) (v : T),
  show ∃ (X : set T), X ∈ (set_of_sets R) ∧ v ∈ X, from
  let X := R v in
  have X_in_ssR : X ∈ set_of_sets R, from exists.intro v rfl,
  have v_in_X : v ∈ X, from and.left R_equiv v,
  exists.intro X (and.intro X_in_ssR v_in_X)

/- [KS]
Lemma: Let R be an equivalence relation over A, and X = { [x]R | x ∈ A }. Then Ø ∉ X.
Proof: Using the logic of our previous proof, we have that for any x ∈ A, that x ∈ [x]R. Consequently,
for any x ∈ A, we know [x]R ≠ Ø. Thus Ø ∉ X. ■
-/

lemma equiv_nonempty : ∀ {R : T → T → Prop}, equivalence R → ¬ ∅ ∈ set_of_sets R :=
  assume (R : T → T → Prop) (R_equiv : equivalence R) (equiv_empty : ∅ ∈ set_of_sets R),
  show false, from
  have exists_u : ∃ (u : T), ∅ = R u, from equiv_empty,
  obtain (u : T) (u_empty : ∅ = R u), from exists_u,
  have Ruu : R u u, from and.left R_equiv u,
  show false, from (congr_fun u_empty⁻¹ u) ▸ Ruu

/- [KS]
Lemma: Let R be an equivalence relation over A, and X = { [x]R | x ∈ A }. Then for any two sets [x]R,
[y]R ∈ X, if [x]R ≠ [y]R, then [x]R ∩ [y]R = Ø.
Proof: Let R be an equivalence relation over A, and X = { [x]R | x ∈ A }. We proceed by contrapositive
and show that for any [x]R, [y]R ∈ X, that if [x]R ∩ [y]R ≠ Ø, then [x]R = [y]R.
Consider any [x]R, [y]R ∈ X such that [x]R ∩ [y]R ≠ Ø. Then there must be some element w such that
w ∈ [x]R and w ∈ [y]R. By definition, this means w ∈ { z ∈ A | xRz } and w ∈ { z ∈ A | yRz }. Consequently,
xRw and yRw. Since R is symmetric, this means that xRw and wRy. Since R is transitive,
this means that xRy. By symmetry, we also have that yRx.
We will now use this fact to show that [x]R ⊆ [y]R. Without loss of generality, we can use this same
argument to show that [y]R ⊆ [x]R, from which we can conclude that [x]R = [y]R, as required.
To show that [x]R ⊆ [y]R, consider any z ∈ [x]R. This means that xRz. Since yRx and xRz, by transitivity
we have that yRz. Consequently, z ∈ [y]R. Since our choice of z was arbitrary, we have that any
z ∈ [x]R satisfies z ∈ [y]R. Thus [x]R ⊆ [y]R, as required. ■
-/

-- proved elsewhere
axiom by_contrapositive : ∀ {P Q : Prop}, (¬ Q → ¬ P) → (P → Q)
lemma nonempty_choice : ∀ ⦃X : set T⦄, X ≠ ∅ → ∃ x, x ∈ X := sorry
lemma subset_eq : ∀ ⦃ X Y : set T ⦄, X ⊆ Y → Y ⊆ X → X = Y := sorry
lemma double_negation : ∀ {P : Prop}, ¬ ¬ P → P := sorry
lemma intro_double_negation : ∀ {P : Prop}, P → ¬¬ P := sorry

print definition equivalence

definition equiv_refl ⦃R : T → T → Prop⦄ (R_equiv : equivalence R) : reflexive R := and.left R_equiv
definition equiv_symm ⦃R : T → T → Prop⦄ (R_equiv : equivalence R) : symmetric R := and.left (and.right R_equiv)
definition equiv_trans ⦃R : T → T → Prop⦄ (R_equiv : equivalence R) : transitive R := and.right (and.right R_equiv)
print definition transitive

lemma equiv_pdisjoint : ∀ {R : T → T → Prop}, equivalence R → pairwise_disjoint (set_of_sets R) :=
  assume (R : T → T → Prop) (R_equiv : equivalence R),
  show pairwise_disjoint (set_of_sets R), from
  let Xs := set_of_sets R in
  show ∀ (X1 X2 : set T), X1 ∈ Xs → X2 ∈ Xs → X1 ≠ X2 → X1 ∩ X2 = ∅, from
  assume (X1 X2 : set T) (X1_in_Xs : X1 ∈ Xs) (X2_in_Xs : X2 ∈ Xs),
  show X1 ≠ X2 → X1 ∩ X2 = ∅, from
  by_contrapositive (
    assume (X1_meets_X2 : X1 ∩ X2 ≠ ∅),
    show ¬ X1 ≠ X2, from -- annoying double negation (how to apply and change the show?)
    have X1_eq_X2 : X1 = X2, from
    obtain (x : T) (X1_x : X1 = R x), from X1_in_Xs,
    obtain (y : T) (X2_y : X2 = R y), from X2_in_Xs,
    have exists_w_in_both : ∃ w, w ∈ X1 ∧ w ∈ X2, from nonempty_choice X1_meets_X2,
    obtain (w : T) (w_in_both : w ∈ X1 ∧ w ∈ X2), from exists_w_in_both,
    have Rxw : R x w, from congr_fun X1_x w ▸ (and.left w_in_both),
    have Ryw : R y w, from congr_fun X2_y w ▸ (and.right w_in_both),
    have Rxy : R x y, from equiv_trans R_equiv Rxw (equiv_symm R_equiv Ryw),
    have X1_ss_X2 : X1 ⊆ X2, from
      assume (z : T) (z_in_X1 : z ∈ X1),
      show z ∈ X2, from
      have Rxz : R x z, from congr_fun X1_x z ▸ z_in_X1,
      have Ryz : R y z, from equiv_trans R_equiv (equiv_symm R_equiv Rxy) Rxz,
      congr_fun X2_y⁻¹ z ▸ Ryz,
    have X2_ss_X1 : X2 ⊆ X1, from
      assume (z : T) (z_in_X2 : z ∈ X2),
      show z ∈ X1, from
      have Ryz : R y z, from congr_fun X2_y z ▸ z_in_X2,
      have Rxz : R x z, from equiv_trans R_equiv Rxy Ryz,
      congr_fun X1_x⁻¹ z ▸ Rxz,
    subset_eq X1_ss_X2 X2_ss_X1,
    intro_double_negation X1_eq_X2
  )

/- [KS]
Theorem: Let R be an equivalence relation over A, and let X = { [x]R | x ∈ A }. Then X is a partition
of A.
-/

theorem equiv_partition : ∀ (R : T → T → Prop), equivalence R → partition (set_of_sets R) :=
  assume (R : T → T → Prop) (R_equiv : equivalence R),
  show partition (set_of_sets R), from
  have R_legal : ∀ x, R x ∈ set_of_sets R, from assume x, exists.intro x rfl,
  have R_spans : ∀ x, x ∈ R x, from assume x, equiv_refl R_equiv x,
  have R_pdisjoint : pairwise_disjoint (set_of_sets R), from equiv_pdisjoint R_equiv,
  have R_ncempty : ¬ ∅ ∈ set_of_sets R, from equiv_nonempty R_equiv,
  partition.mk R R_legal R_spans R_pdisjoint R_ncempty

definition asymmetric (R : T → T → Prop) := ∀ x y, R x y → ¬ R y x
definition antisymmetric (R : T → T → Prop) := ∀ x y, R x y → R y x → x = y

/- [KS]
A binary relation R over a set A is called a strict order iff R is irreflexive, asymmetric, and transitive.
-/

structure strict_order (R : T → T → Prop) :=
  mk :: (irrefl : irreflexive R)
        (asym : asymmetric R)
        (trans : transitive R)

/- [KS]
Theorem: The relation ⊂ over ℘(ℕ) is a strict order.
Proof: We show that ⊂ is irreflexive, asymmetric, and transitive.
To show that ⊂ is irreflexive, we must show that for any A ∈ ℘(ℕ) that A ⊂ A does not hold. To see
this, assume for the sake of contradiction that this is false and that there exists some A ∈ ℘(ℕ) such
that A ⊂ A. By definition of ⊂, this means that A ⊆ A and A ≠ A. But A ≠ A is impossible, since = is
reflexive. We have reached a contradiction, so our assumption must have been wrong. Thus ⊂ is irreflexive.
To show that ⊂ is asymmetric, we must show that for any A, B ∈ ℘(ℕ) that if A ⊂ B, then it is not the
case that B ⊂ A. We proceed by contradiction; assume that this statement is false and that there exist
some sets A, B ∈ ℘(ℕ) such that A ⊂ B and B ⊂ A. By definition of ⊂, this means that A ⊆ B, B ⊆ A,
but A ≠ B. Since A ⊆ B and B ⊆ A, we know that A = B, contradicting the fact that A ≠ B. We have
reached a contradiction, so our assumption must have been wrong. Thus ⊂ is asymmetric.
To show that ⊂ is transitive, we need to show that for any A, B, C ∈ ℘(ℕ), that if A ⊂ B and B ⊂ C,
then A ⊂ C. Consider any A, B, C ∈ ℘(ℕ) where A ⊂ B and B ⊂ C. By definition of ⊂, this means
that A ⊆ B, B ⊆ C, A ≠ B, and B ≠ C. We will show that A ⊂ C, meaning that A ⊆ C and A ≠ C.
Since A ⊆ B and B ⊆ C, we know that A ⊆ C. To show that A ≠ C, assume for the sake of contradiction
that A = C. Since B ⊂ C and C = A, this means that B ⊂ A. But this is impossible, because we
also know that A ⊂ B, and ⊂ is asymmetric. We have reached a contradiction, so our assumption
must have been wrong. Thus A ≠ C. Since A ⊆ C and A ≠ C, this means that A ⊂ C as required.
Since ⊂ is irreflexive, asymmetric, and transitive, it is a strict order over ℘(ℕ). ■
-/

definition strict_subset (X Y : set T) : Prop := X ⊆ Y ∧ X ≠ Y
infix `⊂`:50 := strict_subset

check strict_order
check strict_subset
theorem strict_subset_string_order : (@strict_order (set T)) (@strict_subset T) :=
  have ss_irrefl : irreflexive strict_subset, from
    assume (X : set T) (X_lt_X : X ⊆ X ∧ X ≠ X),
    absurd rfl (and.right X_lt_X),
  have ss_asym : asymmetric strict_subset, from
    assume (X Y : set T) (X_lt_Y : X ⊂ Y) (Y_lt_X : Y ⊂ X),
    have X_eq_Y : X = Y, from subset_eq (and.left X_lt_Y) (and.left Y_lt_X),
    absurd X_eq_Y (and.right X_lt_Y),
  have ss_trans : transitive strict_subset, from
    assume (X Y Z : set T) (X_lt_Y : X ⊂ Y) (Y_lt_Z : Y ⊂ Z),
    show X ⊂ Z, from
      have X_ss_Z : X ⊆ Z, from assume (x : T) (x_in_X : x ∈ X), and.left Y_lt_Z x (and.left X_lt_Y x x_in_X),
      have X_neq_Z : X ≠ Z, from
        assume (X_eq_Z : X = Z),
        have Y_ss_X : Y ⊆ X, from X_eq_Z⁻¹ ▸ (and.left Y_lt_Z),
        have X_eq_Y : X = Y, from subset_eq (and.left X_lt_Y) Y_ss_X,
        absurd X_eq_Y (and.right X_lt_Y),
    and.intro X_ss_Z X_neq_Z,
  strict_order.mk ss_irrefl ss_asym ss_trans

open nat

structure partial_order (R : T → T → Prop) :=
  mk :: (refl : reflexive R)
        (antisym : antisymmetric R)
        (trans : transitive R)

definition divides (m n : nat) := ∃ q, n = m * q
infix `∣` := divides
check 2 ∣ 8
/- [KS]
Theorem: | is a partial order over ℕ.
Proof: We will show that | is reflexive, antisymmetric, and transitive. To see that | is reflexive, we will
prove that for any n ∈ ℕ, that n | n (that there exists some q ∈ ℕ such that n = nq). So let n be any
natural number, and take q = 1. Then nq = n · 1 = n, so n | n.
To see that | is antisymmetric, we will prove that for any m, n ∈ ℕ, that if m | n and n | m, that m = n.
Consider any m, n ∈ ℕ where m | n and n | m. This means that there exists q, r ∈ ℕ such that n = mq
and m = nr. Consequently:
m = nr = (mq)r = mqr
n = mq = (nr)q = nqr
We now consider two cases. First, if m = n = 0, then we are done, since m = n. Otherwise, at least
one of m or n is nonzero; without loss of generality, assume m ≠ 0. Then since m = mqr, we know
that 1 = qr. Since q, r ∈ ℕ, this is only possible if q = r = 1. Consequently, m = nr = n · 1 = n, so
m = n, as required.
To see that | is transitive, we will prove that for any m, n, p ∈ ℕ, that if m | n and n | p, then m | p.
Consider any m, n, p ∈ ℕ where m | n and n | p; then there must exist q, r ∈ ℕ such that n = qm and
p = rn. Consequently, p = rn = r(qm) = qrm = (qr)m. Since qr ∈ ℕ, this means that there is some
k ∈ ℕ (namely, qr) such that p = km. Thus m | p, as required.
Since | is reflexive, antisymmetric, and transitive over ℕ, | is a partial order over ℕ.
-/

print definition mul

lemma mul_cancel : ∀ ⦃m n : nat⦄, m ≠ 0 → m = m * n → n = 1 := sorry
lemma mul_cancel_one_right : ∀ ⦃ m n : nat ⦄, m * n = 1 → n = 1 := sorry

theorem divides_partial_order : partial_order divides :=
  have div_refl : reflexive divides, from
    assume (n : ℕ),
    show n ∣ n, from exists.intro 1 (mul_one n)⁻¹,
  have div_antisym : antisymmetric divides, from
    assume (m n : ℕ) (m_div_n : m ∣ n) (n_div_m : n ∣ m),
    show m = n, from
      have m_neq_0 : m ≠ 0, from sorry, -- #FALSE need case analysis
      obtain (q1 : ℕ) (n_eq_mq1 : n = m * q1), from m_div_n,
      obtain (q2 : ℕ) (m_eq_nq2 : m = n * q2), from n_div_m,
      have m_eq_m_q12 : m = m * (q1 * q2), from (mul.assoc m q1 q2) ▸ n_eq_mq1 ▸ m_eq_nq2,
      have q1q2_eq_1 : q1 * q2 = 1, from mul_cancel m_neq_0 m_eq_m_q12,
      have q2_eq_1 : q2 = 1, from mul_cancel_one_right q1q2_eq_1,
      have m_eq_n1 : m = n * 1, from q2_eq_1 ▸ m_eq_nq2,
      (mul_one n) ▸ m_eq_n1,
  have div_trans : transitive divides, from
    assume (m n p : ℕ) (m_div_n : m ∣ n) (n_div_p : n ∣ p),
    show m ∣ p, from
      obtain (q1 : ℕ) (n_eq_mq1 : n = m * q1), from m_div_n,
      obtain (q2 : ℕ) (p_eq_nq2 : p = n * q2), from n_div_p,
      exists.intro (q1 * q2) (mul.assoc m q1 q2 ▸ n_eq_mq1 ▸ p_eq_nq2),
  partial_order.mk div_refl div_antisym div_trans

end relations