/-
 -----------------------------------------------------------
  Uniform distributions over zmod q, bitvecs, and finite groups
 -----------------------------------------------------------
-/

import to_mathlib

variables (G : Type) [fintype G] [group G] [decidable_eq G]

noncomputable theory

def uniform_bitvec (n : ℕ) : pmf (bitvec n) :=
  pmf.of_multiset (bitvec.fintype n).elems.val (bitvec.multiset_ne_zero n)

def uniform_grp : pmf G :=
  pmf.of_multiset (fintype.elems G).val (group.multiset_ne_zero G)

def uniform_zmod (n : ℕ) [fact (0 < n)] : pmf (zmod n) := uniform_grp (zmod n)

def uniform_2 : pmf (zmod 2) := uniform_zmod 2

lemma uniform_grp_prob :
  ∀ (g : G), (uniform_grp G) g = 1 / multiset.card (fintype.elems G).val :=
begin
  intro g,
  have h1 : ⇑(uniform_grp G) = (λ (a : G),
    (multiset.count a (fintype.elems G).val : nnreal) / multiset.card (fintype.elems G).val) :=
  begin
    ext,
    simp [uniform_grp, pmf.of_multiset, coe_fn],
    simp [has_coe_to_fun.coe],
    congr,
  end,
  have h2 : (uniform_grp G) g =
    multiset.count g (fintype.elems G).val / multiset.card (fintype.elems G).val :=
  begin
    exact congr_fun h1 g,
  end,
  rw h2,
  have h3 : multiset.count g (fintype.elems G).val = 1 := multiset.count_univ g,
  rw h3,
  simp,
end

lemma uniform_zmod_prob {n : ℕ} [fact (0 < n)] :
  ∀ (a : zmod n), (uniform_zmod n) a = 1/n :=
begin
  intro a,
  simp [uniform_zmod],
  have h1 := uniform_grp_prob (zmod n) a,
  have h2 : multiset.card (fintype.elems (zmod n)).val = n := zmod.card n,
  rw h2 at h1,
  rw inv_eq_one_div (n : nnreal),
  exact h1,
end


import Mathlib.Logic.Basic

variable {P L : Type}

class Geometry (P : Type _) where
  line : Type _
  incidence : Membership P line

attribute [instance] Geometry.incidence

namespace Geometry
variable {p q r s: P}

def collinear [Geometry P] (p q r : P) : Prop :=
  ∃ l : line P, p ∈ l ∧ q ∈ l ∧ r ∈ l

def isQuadrangle [Geometry P] (p q r s : P) : Prop :=
    ¬ collinear p q r
  ∧ ¬ collinear p q s
  ∧ ¬ collinear p r s
  ∧ ¬ collinear q r s

instance dual [Geometry P] : Geometry (line P) where
  line := P
  incidence := ⟨fun l p => p ∈ l⟩

theorem triangle_rotate [Geometry P] : ¬ collinear p q r -> ¬ collinear q r p := by
  simp[collinear]
  intro triangle_pqr l hq hr hp
  apply triangle_pqr <;> assumption

theorem quadrangle_rotate [Geometry P] : isQuadrangle p q r s -> isQuadrangle q r s p := by
  intro ⟨triangle_pqr, triangle_pqs, triangle_prs, triangle_qrs⟩
  exact ⟨triangle_qrs, triangle_rotate triangle_pqr, triangle_rotate triangle_pqs, triangle_rotate triangle_prs⟩

end Geometry

class ProjectivePlane (P : Type _) extends Geometry P :=
  exists_connecting_line : ∀ p q : P, ∃ l : line, p ∈ l ∧ q ∈ l
  exists_intersection_point : ∀ l m : line, ∃ p : P, p ∈ l ∧ p ∈ m
  point_line_uniq : ∀ {p q : P} {l m : line}, p ∈ l → q ∈ l → p ∈ m → q ∈ m → p = q ∨ l = m
  exists_quadrangle : ∃ (p q r s : P), Geometry.isQuadrangle p q r s

namespace ProjectivePlane
open Geometry
open Classical

variable {p q r s : P}

noncomputable def connectingLine [ProjectivePlane P] (p q : P) : line P := Exists.choose <| exists_connecting_line p q

infix:75 " ⊔ " => connectingLine

@[simp] theorem connectingLine_left [ProjectivePlane P] : ∀ (p q : P),  p ∈ p ⊔ q := by
    intro p q
    exact (Exists.choose_spec (exists_connecting_line p q)).left

@[simp] theorem connectingLine_right [ProjectivePlane P] : ∀ (p q : P),  q ∈ p ⊔ q := by
    intro p q
    exact (Exists.choose_spec (exists_connecting_line p q)).right

theorem connectingLine_uniq [ProjectivePlane P] : ∀ {p q : P} {l : line P}, p ≠ q → p ∈ l → q ∈ l → l = p ⊔ q := by
  intro p q l hpq hpl hql
  let m := p ⊔ q
  have hpm : p ∈ m := by simp
  have hqm : q ∈ m := by simp
  have h : p = q ∨ l = m := point_line_uniq hpl hql hpm hqm
  cases h with
  | inl hpq' => contradiction
  | inr h' => assumption

theorem connectingLine_comm [ProjectivePlane P] : ∀ (p q: P), p ⊔ q = q ⊔ p := fun p q =>
  byCases
    (fun h : q = p => by rw[h])
    (fun hpq : q ≠ p => by
      apply connectingLine_uniq <;> (simp ; try assumption)
    )

noncomputable def intersectionPoint [ProjectivePlane P] (l m : line P) : P := Exists.choose <| exists_intersection_point l m

infix:75 " ⊓ " => intersectionPoint

@[simp] theorem intersectionPoint_left [ProjectivePlane P] : ∀ (l m : line P),  l ⊓ m ∈ l := by
    intro l m
    exact (Exists.choose_spec (exists_intersection_point l m)).left

@[simp] theorem intersectionPoint_right [ProjectivePlane P] : ∀ (l m : line P),  l ⊓ m ∈ m := by
  intro l m
  exact (Exists.choose_spec (exists_intersection_point l m)).right

theorem intersectionPoint_uniq [ProjectivePlane P] : ∀ {l m : line P} {p : P}, l ≠ m → p ∈ l → p ∈ m → p = l ⊓ m := by
  intro l m p hlm hpl hpm
  let q :=  l ⊓ m
  have hql : q ∈ l := by simp
  have hqm : q ∈ m := by simp
  have h : p = q ∨ l = m := point_line_uniq hpl hql hpm hqm
  cases h with
  | inl h' => exact h'
  | inr hlm' => contradiction

theorem intersectionPoint_comm [ProjectivePlane P] : ∀ (l m : line P), l ⊓ m = m ⊓ l := fun l m =>
  byCases
    (fun h : m = l => by rw[h])
    (fun hpq : m ≠ l => by
      apply intersectionPoint_uniq <;> (simp ; try assumption)
    )

theorem triangle_lines_unequal [ProjectivePlane P] : ¬ collinear p q r -> (p ⊔ q) ≠ (q ⊔ r) ∧ (p ⊔ q) ≠ (r ⊔ p) ∧ (q ⊔ r) ≠ (r ⊔ p) := by
  intro hnc
  apply And.intro
  . intro h
    simp[collinear] at hnc
    apply hnc (p ⊔ q)
    . simp
    . simp
    . simp[h]
  . apply And.intro
    . intro h
      simp[collinear] at hnc
      apply (hnc (p ⊔ q))
      . simp
      . simp
      . simp[h]
    . intro h
      simp[collinear] at hnc
      apply (hnc (q ⊔ r))
      . simp[h]
      . simp
      . simp[h]

theorem dual_triangle [ProjectivePlane P] : ¬ collinear p q r -> ¬ collinear (p ⊔ q) (q ⊔ r) (r ⊔ p) := by
  let a := p ⊔ q
  let b := q ⊔ r
  intro hnc
  simp[collinear]
  -- assume there is a point s such on all three lines
  intro s hpq hqr hrp

  -- s must be equal to q because it is on a and b
  have hsq : s = q := by
    have diff_lines : a ≠ b := (triangle_lines_unequal hnc).left
    have hsq': s = q ∨ a = b := by
      apply point_line_uniq <;> (simp ; try assumption)
    cases hsq' with
    | inl it => exact it
    | inr not_it => contradiction

  -- that means p q r are collinear -> contradiction
  have c : collinear p q r := by
   exists (r ⊔ p)
   rw[hsq] at hrp
   simp
   assumption

  contradiction

theorem dual_quadrangle_part [ProjectivePlane P] : isQuadrangle p q r s -> ¬ collinear (p ⊔ q) (q ⊔ r) (r ⊔ s) := by
  intro ⟨triangle_pqr, _, _, triangle_qrs⟩
  let a := p ⊔ q
  let b := q ⊔ r
  let c := r ⊔ s

  let t := a ⊓ c

  have t_is_not_q : q ≠ t := by
      intro h
      -- if q = t = (p ⊔ q) ⊓ (r ⊔ s), then r ⊔ s contains q and hence q, r, s are collinear
      have : collinear q r s := by
        simp[collinear]
        rw[h]
        exists c
        apply And.intro
        . simp
        . apply And.intro
          . simp
          . simp
      contradiction

  have t_is_not_r : r ≠ t := by
    intro h
    have : collinear p q r := by
     simp[collinear]
     rw[h]
     exists a
     apply And.intro
     . simp
     . apply And.intro
       . simp
       . simp
    contradiction

  have a_is_q_t : a = q ⊔ t := by
      apply connectingLine_uniq
      . assumption
      . simp
      . simp

  have c_is_r_t : c = r ⊔ t := by
    apply connectingLine_uniq
    . assumption
    . simp
    . simp

  have triangle_tqr :  ¬ collinear t q r := by
    simp[collinear]
    -- assume there is a line l containing q, r, t
    intro l htl hql hrl

    -- l = a because l contains both q and t
    have l_is_a : l = a := by
      rw[a_is_q_t]
      apply connectingLine_uniq <;> assumption
    rw[l_is_a] at hrl
    -- a = l contains p, q, r
    have : collinear p q r := by
      simp[collinear]
      exists a
      apply And.intro
      . simp
      . apply And.intro
        . simp
        . assumption
    contradiction

  have : ¬ collinear a b c := by
    rw[a_is_q_t, c_is_r_t, connectingLine_comm]
    apply dual_triangle
    assumption

  assumption

theorem dual_quadrangle [ProjectivePlane P] : isQuadrangle p q r s -> isQuadrangle (p ⊔ q) (q ⊔ r) (r ⊔ s) (s ⊔ p) := by
  intro ⟨triangle_pqr, triangle_pqs, triangle_prs, triangle_qrs⟩
  let a := p ⊔ q
  let b := q ⊔ r
  let c := r ⊔ s
  let d := s ⊔ p

  have triangle_abc : ¬ collinear a b c := by
    apply dual_quadrangle_part
    exact ⟨triangle_pqr, triangle_pqs, triangle_prs, triangle_qrs⟩

  have triangle_abd : ¬ collinear a b d := by
    apply triangle_rotate
    apply dual_quadrangle_part
    apply quadrangle_rotate
    apply quadrangle_rotate
    apply quadrangle_rotate
    exact ⟨triangle_pqr, triangle_pqs, triangle_prs, triangle_qrs⟩

  have triangle_acd : ¬ collinear a c d := by
    apply triangle_rotate
    apply triangle_rotate
    apply dual_quadrangle_part
    apply quadrangle_rotate
    apply quadrangle_rotate
    exact ⟨triangle_pqr, triangle_pqs, triangle_prs, triangle_qrs⟩

  have triangle_bcd : ¬ collinear b c d := by
    apply dual_quadrangle_part
    apply quadrangle_rotate
    exact ⟨triangle_pqr, triangle_pqs, triangle_prs, triangle_qrs⟩

  exact ⟨triangle_abc, triangle_abd, triangle_acd, triangle_bcd⟩

instance dual [inst : ProjectivePlane P] : ProjectivePlane (line P) where
  line := P
  incidence := ⟨fun l p => p ∈ l⟩
  exists_connecting_line := inst.exists_intersection_point
  exists_intersection_point := inst.exists_connecting_line
  point_line_uniq := by
    intros
    rw[or_comm]
    apply inst.point_line_uniq <;> assumption
  exists_quadrangle :=
    match inst.exists_quadrangle with
    | ⟨p, q, r, s, prf⟩ => ⟨ (p ⊔ q), (q ⊔ r), (r ⊔ s), (s ⊔ p), dual_quadrangle prf⟩

theorem dual_involution [h : ProjectivePlane P] :
  let h' : ProjectivePlane (line (line P)) := inferInstance
  h' = h := by rfl
end ProjectivePlane

namespace Fano
open Geometry

inductive Points where
  | p1
  | p2
  | p3
  | p4
  | p5
  | p6
  | p7
deriving DecidableEq, Repr

inductive Lines where
  | l1
  | l2
  | l3
  | l4
  | l5
  | l6
  | l7
deriving DecidableEq, Repr

def Lines.points : Lines → List Points
  | .l1 => [.p1, .p2, .p4]
  | .l2 => [.p2, .p3, .p5]
  | .l3 => [.p3, .p4, .p6]
  | .l4 => [.p4, .p5, .p7]
  | .l5 => [.p5, .p6, .p1]
  | .l6 => [.p6, .p7, .p2]
  | .l7 => [.p7, .p1, .p3]

instance FanoMembership : Membership Points Lines where
  mem p l := p ∈ l.points

instance FanoGeometry : Geometry Points where
line := Lines
incidence := FanoMembership

attribute [local simp] line

instance (p : Points) (l : Lines) : Decidable (p ∈ l) := by
  cases l <;> rw [FanoMembership] <;> simp <;> infer_instance

instance (P : Points → Prop) [∀ p, Decidable (P p)] : Decidable (∀ p, P p) :=
  if h : P .p1 ∧ P .p2 ∧ P .p3 ∧ P .p4 ∧ P .p5 ∧ P .p6 ∧ P .p7 then
    isTrue <| by
      repeat
        try rename_i h
        cases h
      intro p
      cases p <;> assumption
  else
    isFalse <| by
      intro H
      apply h
      repeat
        try constructor <;> try apply H

instance (P : Points → Prop) [∀ p, Decidable (P p)] : Decidable (∃ p, P p) :=
  if h : ∀ p, ¬ P p then
    isFalse <| by simp [not_exists, h]
  else
    isTrue <| by
      simp [not_forall, not_not] at h
      exact h

instance (P : Lines → Prop) [∀ l, Decidable (P l)] : Decidable (∀ l, P l) :=
  if h : P .l1 ∧ P .l2 ∧ P .l3 ∧ P .l4 ∧ P .l5 ∧ P .l6 ∧ P .l7 then
    isTrue <| by
      repeat
        try rename_i h
        cases h
      intro l
      cases l <;> assumption
  else
    isFalse <| by
      intro H
      apply h
      repeat
        try constructor <;> try apply H

instance (P : Lines → Prop) [∀ l, Decidable (P l)] : Decidable (∃ l, P l) :=
  if h : ∀ l, ¬ P l then
    isFalse <| by simp [not_exists, h]
  else
    isTrue <| by
      simp [not_forall, not_not] at h
      exact h

def Fano.exists_connecting_line : ∀ (p q : Points), ∃ l : Lines, p ∈ l ∧ q ∈ l := by
  decide

def Fano.exists_intersection_point : ∀ (l m : Lines), ∃ p : Points, p ∈ l ∧ p ∈ m := by
  decide

theorem Fano.quadrangle1236 : Geometry.isQuadrangle Points.p1 Points.p2 Points.p3 Points.p6 :=
  ⟨by simp[collinear], by simp[collinear], by simp[collinear], by simp[collinear]⟩

theorem Fano.point_line_uniq : ∀ {p q : Points} {l m : Lines}, p ∈ l -> q ∈ l -> p ∈ m -> q ∈ m -> p = q ∨ l = m := by
  decide

instance : ProjectivePlane Points where
  exists_connecting_line := Fano.exists_connecting_line
  exists_intersection_point := Fano.exists_intersection_point
  exists_quadrangle := ⟨.p1, .p2, .p3, .p6, Fano.quadrangle1236⟩
  point_line_uniq := Fano.point_line_uniq


import data.real.basic
-- import data.set.basic
-- import tactic.ring

universe u

-- test for reals
example (x : ℝ) : (1 - x) + x = 1 := by ring

-- test for set theory
example {α : Type} (A B : set α) : A ∪ B = B ∪ A := set.union_comm A B
-- example {α : Type} (A B : set α) : A ∪ B = B ∪ A := by finish

constant α : Type u
notation `S` := set.univ

#check @set.subset_empty_iff
example : ∀ (A : set α), A ∪ -A = set.univ := set.union_compl_self
example : ∀ (A : set α), A ⊆ ∅ ↔ A = ∅ := λ s, set.subset_empty_iff
example : ∀ (A B : set α), A ⊆ B → A ∪ B \ A = B := λ a b, set.union_diff_cancel

#check set.inter_compl_self

lemma s.union_comm : ∀ {A B : set α}, A ∪ B = B ∪ A := set.union_comm
lemma s.union_with_complement : ∀ {A : set α}, A ∪ -A = set.univ := set.union_compl_self
lemma s.intersection_with_complement : ∀ {A : set α}, A ∩ -A = ∅ := set.inter_compl_self
lemma s.union_empty : ∀ (A : set α), A ∪ ∅ = A := set.union_empty
lemma s.inter_empty : ∀ (A : set α), A ∩ ∅ = ∅ := set.inter_empty
lemma s.inter_univ : ∀ (A : set α), A ∩ S = A := set.inter_univ
lemma s.diff_eq : ∀ (A B : set α), A \ B = A ∩ -B := set.diff_eq
lemma s.not_univ : -@set.univ α = ∅ := sorry
lemma s.inter_distrib : ∀ (A B C : set α), A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) := sorry
-- A = A ∩ -B ∪ A ∩ B = A ∩ (-B ∪ B) = A ∩ S = A

#check set.union_empty
#check @set.union_diff_cancel

namespace prob
constant P : set α → ℝ
-- ********** axioms of probability **********
axiom a1 : ∀ A : set α, P A ≥ 0
axiom a2 : P set.univ = 1
axiom a3 : ∀ A B : set α, A ∩ B = ∅ → P (A ∪ B) = P A + P B
-- axiom a2_2 : P ∅ = 0
-- ********** axioms of probability **********

theorem t1 (A : set α) : P (-A) = 1 - P A :=
begin
  have h₁ : P (A ∪ -A) = P A + P (-A) := a3 A (-A) s.intersection_with_complement,
  rw [s.union_with_complement, a2] at h₁,
  rw h₁,
  exact eq.symm (add_sub_cancel' (P A) (P (-A))),
end

theorem t2 : ∀ A : set α, P A ≤ 1 :=
begin
  sorry,
end

theorem t3 : P ∅ = 0 :=
begin
  have h₁ := t1 S,
  rw s.not_univ at h₁,
  rw [h₁, a2],
  exact sub_self 1,
end

lemma lemma1 (A B : set α) : P (A ∪ B) = P (A \ B) + P (A ∩ B) + P (B \ A) := sorry

lemma lemma2 (A B : set α) : P A = P (A \ B) + P (A ∩ B) :=
begin
  have h₀ : (A \ B) ∩ (A ∩ B) = ∅ := by {
  calc (A \ B) ∩ (A ∩ B) = (A ∩ -B) ∩ (A ∩ B) : by rw s.diff_eq
                     ... = (A ∩ -B) ∩ (B ∩ A) : by rw set.inter_comm A B
                     ... = A ∩ -B ∩ B ∩ A     : by rw ←set.inter_assoc
                     ... = A ∩ (-B ∩ B) ∩ A   : by rw set.inter_assoc A
                     ... = A ∩ (B ∩ -B) ∩ A   : by rw set.inter_comm _ B
                     ... = A ∩ ∅ ∩ A          : by rw s.intersection_with_complement
                     ... = A ∩ (∅ ∩ A)        : by rw set.inter_assoc
                     ... = ∅ ∩ A ∩ A          : by rw set.inter_comm
                     ... = ∅ ∩ (A ∩ A)        : by rw set.inter_assoc
                     ... = A ∩ A ∩ ∅          : by rw set.inter_comm
                     ... = ∅                  : s.inter_empty (A ∩ A)
  },
  have h₀ : (A \ B) ∩ (A ∩ B) = ∅ := by {
    rw s.diff_eq,
    rw set.inter_comm A B,
    rw ←set.inter_assoc,
    rw set.inter_assoc A,
    rw set.inter_comm _ B,             -- A ∩ (B ∩ -B) ∩ A = ∅
    rw s.intersection_with_complement, -- A ∩ ∅ ∩ A = ∅
    rw set.inter_assoc,                -- A ∩ (∅ ∩ A) = ∅
    rw set.inter_comm,                 -- ∅ ∩ A ∩ A = ∅
    rw set.inter_assoc,                -- ∅ ∩ (A ∩ A) = ∅
    rw set.inter_comm,                 -- A ∩ A ∩ ∅ = ∅
    exact s.inter_empty _,             -- ∅ = ∅
  },
  -- A = A ∩ -B ∪ A ∩ B = A ∩ (-B ∪ B) = A ∩ S = A
  have h𝔸 : A = A \ B ∪ A ∩ B := by {
    rw s.diff_eq,
    rw ←s.inter_distrib,
    rw s.union_comm,
    rw s.union_with_complement,
    rw s.inter_univ,
  },
  have h₁ := a3 (A \ B) (A ∩ B) h₀,
  rw ←h𝔸 at h₁,
  exact h₁,
end

theorem t4 (A B : set α) : P (A ∪ B) = P A + P B - P (A ∩ B) :=
begin
  have h₁ : P A = P (A \ B) + P (A ∩ B) := lemma2 A B,
  have h₂ : P B = P (B \ A) + P (B ∩ A) := lemma2 B A,
  rw set.inter_comm at h₂,
  rw [h₁, h₂],
  ring, -- simplify expression using P (A ∩ B) - P (A ∩ B) = 0,
        -- idea: make config of computable object (in beginning of proof) to auto-check this
        -- use relational-tactic-keywords instead of one-way tactic methods
  rw ←add_assoc,
  exact lemma1 A B,
end

theorem t5 (A B : set α) : A ⊆ B → P A ≤ P B :=
begin
  have h₁ : P (B \ A) ≥ 0 := sorry, -- use a1
  -- have h₂ :
  sorry,
end

end prob


/-
Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pierre-Alexandre Bazin
-/
import algebra.module.torsion
import ring_theory.dedekind_domain.ideal

/-!
# Modules over a Dedekind domain

Over a Dedekind domain, a `I`-torsion module is the internal direct sum of its `p i ^ e i`-torsion
submodules, where `I = ∏ i, p i ^ e i` is its unique decomposition in prime ideals.
Therefore, as any finitely generated torsion module is `I`-torsion for some `I`, it is an internal
direct sum of its `p i ^ e i`-torsion submodules for some prime ideals `p i` and numbers `e i`.
-/

universes u v
open_locale big_operators

variables {R : Type u} [comm_ring R] [is_domain R] {M : Type v} [add_comm_group M] [module R M]

open_locale direct_sum

namespace submodule
variables [is_dedekind_domain R]
open unique_factorization_monoid

/--Over a Dedekind domain, a `I`-torsion module is the internal direct sum of its `p i ^ e i`-
torsion submodules, where `I = ∏ i, p i ^ e i` is its unique decomposition in prime ideals.-/
lemma is_internal_prime_power_torsion_of_is_torsion_by_ideal {I : ideal R} (hI : I ≠ ⊥)
  (hM : module.is_torsion_by_set R M I) :
  ∃ (P : finset $ ideal R) [decidable_eq P] [∀ p ∈ P, prime p] (e : P → ℕ),
  by exactI direct_sum.is_internal (λ p : P, torsion_by_set R M (p ^ e p : ideal R)) :=
begin
  classical,
  let P := factors I,
  have prime_of_mem := λ p (hp : p ∈ P.to_finset), prime_of_factor p (multiset.mem_to_finset.mp hp),
  refine ⟨P.to_finset, infer_instance, prime_of_mem, λ i, P.count i, _⟩,
  apply @torsion_by_set_is_internal _ _ _ _ _ _ _ _ (λ p, p ^ P.count p) _,
  { convert hM,
    rw [← finset.inf_eq_infi, is_dedekind_domain.inf_prime_pow_eq_prod,
      ← finset.prod_multiset_count, ← associated_iff_eq],
    { exact factors_prod hI },
    { exact prime_of_mem }, { exact λ _ _ _ _ ij, ij } },
  { intros p hp q hq pq, dsimp,
    rw irreducible_pow_sup,
    { suffices : (normalized_factors _).count p = 0,
      { rw [this, zero_min, pow_zero, ideal.one_eq_top] },
      { rw [multiset.count_eq_zero, normalized_factors_of_irreducible_pow
          (prime_of_mem q hq).irreducible, multiset.mem_replicate],
        exact λ H, pq $ H.2.trans $ normalize_eq q } },
    { rw ← ideal.zero_eq_bot, apply pow_ne_zero, exact (prime_of_mem q hq).ne_zero },
    { exact (prime_of_mem p hp).irreducible } }
end

/--A finitely generated torsion module over a Dedekind domain is an internal direct sum of its
`p i ^ e i`-torsion submodules for some prime ideals `p i` and numbers `e i`.-/
theorem is_internal_prime_power_torsion [module.finite R M] (hM : module.is_torsion R M) :
  ∃ (P : finset $ ideal R) [decidable_eq P] [∀ p ∈ P, prime p] (e : P → ℕ),
  by exactI direct_sum.is_internal (λ p : P, torsion_by_set R M (p ^ e p : ideal R)) :=
begin
  obtain ⟨I, hI, hM'⟩ := is_torsion_by_ideal_of_finite_of_is_torsion hM,
  refine is_internal_prime_power_torsion_of_is_torsion_by_ideal _ hM',
  rw ←set.nonempty_iff_ne_empty at hI, rw submodule.ne_bot_iff,
  obtain ⟨x, H, hx⟩ := hI, exact ⟨x, H, non_zero_divisors.ne_zero hx⟩
end

end submodule


import data.real.basic
-- this is a proof that ∀ vectors a, b ∈ ℝ³,
-- (a × b) ⬝ a = 0 ∧ (a × b) ⬝ b = 0

def dot: ℝ × ℝ × ℝ → ℝ × ℝ × ℝ → ℝ := λ ⟨a, b, c⟩ ⟨d, e, f⟩, a*d + b*e + c*f
def cross: ℝ × ℝ × ℝ → ℝ × ℝ × ℝ → ℝ × ℝ × ℝ := λ ⟨a, b, c⟩ ⟨d, e, f⟩, ⟨b*f - c*e, c*d - a*f, a*e - b*d⟩

variables m n p j k l : ℝ
#check dot (cross (m, n, p) (j, k, l)) (j, k, l)

theorem cross' (a b c d e f: ℝ) : cross (a, b, c) (d, e, f) = (b*f - c*e, c*d - a*f, a*e - b*d) := rfl
theorem dot' (a b c d e f: ℝ) : dot (a, b, c) (d, e, f) = a*d + b*e + c*f := rfl

local attribute [simp] mul_comm mul_assoc mul_right_comm

theorem proof1 : ∀ {a b c d e f: ℝ}, dot (cross (a, b, c) (d, e, f)) (a, b, c) = 0 :=
assume a b c d e f,
calc
    dot (cross (a, b, c) (d, e, f)) (a, b, c) = dot (b*f - c*e, c*d - a*f, a*e - b*d) (a, b, c) : by rw cross'
    ... = (b*f - c*e)*a + (c*d - a*f)*b + (a*e - b*d)*c : by rw dot'
    ... = b*f*a - c*e*a + (c*d*b - a*f*b) + (a*e*c - b*d*c) : by repeat {rw sub_mul}
    ... = 0 : by simp
#check proof1

theorem proof2 : ∀ {a b c d e f: ℝ}, dot (cross (a, b, c) (d, e, f)) (d, e, f) = 0 :=
assume a b c d e f,
calc
    dot (cross (a, b, c) (d, e, f)) (d, e, f) = dot (b*f - c*e, c*d - a*f, a*e - b*d) (d, e, f) : by rw cross'
    ... = (b*f - c*e)*d + (c*d - a*f)*e + (a*e - b*d)*f : by rw dot'
    ... = b*f*d - c*e*d + (c*d*e - a*f*e) + (a*e*f - b*d*f) : by repeat {rw sub_mul}
    ... = a * (e * f) + (c * (d * e) + (-(a * (e * f)) + -(c * (d * e)))) : by simp
    ... = a * (e * f) + (c * (d * e) + -(a * (e * f)) + -(c * (d * e))) : by rw add_assoc
    ... = 0 : by simp
#check proof2

example (a b c d e f: ℝ) :
     dot (cross (a, b, c) (d, e, f)) (a, b, c) = 0 ∧ dot (cross (a, b, c) (d, e, f)) (d, e, f) = 0 :=
    and.intro proof1 proof2


import algebra.group algebra.group_power

variables {G: Type*}

-- if (a * b) ^ n = a ^ n * b ^ n for three consecutive integers, G is abelian.
-- (the `rw`s  should really be re-written in calc so that it's human-readable.)
def Q_04h (G: Type*) [group G] (k: ℕ): Prop :=
  ∀ a b: G, (a * b) ^ k = a ^ k * b ^ k

lemma Q_04a [group G]: ∀ n: ℕ, ∀ a b: G,
  (a * b) ^ (n + 1) = a * (b * a) ^ n * b
| 0 :=
  λ a b, by rw [ zero_add, pow_one, pow_zero, mul_one ]
| (nat.succ r) :=
  λ a b, by rw [ pow_succ, Q_04a, pow_succ,
                 ←mul_assoc, ←mul_assoc,
                 ←mul_assoc, ←mul_assoc ]

lemma Q_04b [group G]: ∀ n: ℕ,
  (Q_04h G n) ∧ (Q_04h G (n + 1))
  → (∀ a b: G, (a * b) ^ n = (b * a) ^ n)
| 0 :=
  λ ⟨h1, h2⟩ a b, by rw [ pow_zero, pow_zero ]
| (nat.succ r) :=
  λ ⟨h1, h2⟩ a b,
  let h1' := h1 a b in
  let h2' := h2 a b in
  begin
    rw [
      Q_04a,
      pow_succ a (nat.succ r),
      pow_succ' b (nat.succ r),
      ←mul_assoc, mul_assoc a _ (b ^ nat.succ r),
      ←h1
    ] at h2',

    exact mul_left_cancel (mul_right_cancel h2'.symm)
  end

theorem Q_04 [hG: group G] (n: ℕ):
  (Q_04h G n) ∧ (Q_04h G (n + 1)) ∧ (Q_04h G (n + 2))
  → comm_group G :=
λ ⟨h1, ⟨h2, h3⟩⟩, {
  mul_comm := λ a b, begin
    have t0, from Q_04b n ⟨h1, h2⟩,
    have t1, from Q_04b (n + 1) ⟨h2, h3⟩ a b,
    rw [ pow_succ, pow_succ, Q_04b n ⟨h1, h2⟩ ] at t1,
    exact mul_right_cancel t1,
  end,
  .. hG
}


-- source: mathlib/test/simp_rw.lean
import tactic.simp_rw

set_option trace.simplify.rewrite true
-- `simp_rw` can perform rewrites under binders:
example : (λ (x y : ℕ), x + y) = (λ x y, y + x) := by simp [add_comm]
example : (λ (x y : ℕ), x + y) = (λ x y, y + x) := by simp_rw [add_comm]

-- `simp_rw` can apply reverse rules:
example (f : ℕ → ℕ) {a b c : ℕ} (ha : f b = a) (hc : f b = c) :
  a = c := by simp_rw [←ha, hc]

-- `simp_rw` performs rewrites in the given order
-- example {α β : Type} {f : α → β} {t : set β} :
--   (∀ s, f ∈ s ⊆ t) = ∀ s : set α, ∀ x ∈ s, x ∈ f t :=

-- `simp_rw` applies rewrite rules multiple times:
example (a b c d : ℕ) : a + (b + (c + d)) = ((d + c) + b) + a := by simp [add_comm]
example (a b c d : ℕ) : a + (b + (c + d)) = ((d + c) + b) + a := by simp_rw [add_comm]


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import data.real.basic
import data.set.basic
import data.set.finite

/-!
# IMO 2008 Q2
(a) Prove that
          ```x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 ≥ 1```
for all real numbers x, y, z, each different from 1, and satisfying xyz = 1.

(b) Prove that equality holds above for infinitely many triples of rational numbers x, y, z, each
different from 1, and satisfying xyz = 1.

# Solution
(a) Since xyz = 1, we can apply the substitution x = a/b, y = b/c, z = c/a.
Then we define m = c-b, n = b-a and rewrite the inequality as LHS - 1 ≥ 0
using c, m and n. We factor LHS - 1 as a square, which finishes the proof.

(b) We present a set W of rational triples. We prove that W is a subset of the
set of rational solutions to the equation, and that W is infinite.
-/

lemma subst_abc (x y z : ℝ) (h : x*y*z = 1) :
  ∃ a b c : ℝ, a ≠ 0 ∧ b ≠ 0 ∧ c ≠ 0 ∧ x = a/b ∧ y = b/c ∧ z = c /a :=
begin
  use x, use 1, use 1/y,
  have h₁ : x ≠ 0,              { intro p, rw p at h, simp at h, exact h },
  have h₂ : (1 : ℝ) ≠ (0 : ℝ),  exact one_ne_zero,
  have hy_ne_zero : y ≠ 0,      { intro p, rw p at h, simp at h, exact h },
  have h₃ : 1/y ≠ 0,            exact one_div_ne_zero hy_ne_zero,
  have h₄ : x = x / 1,          exact (div_one x).symm,
  have h₅ : y = 1 / (1 / y),    exact (one_div_one_div y).symm,
  have h₆ : z = 1 / y / x,      { field_simp, linarith [h] },
  exact ⟨h₁, h₂, h₃, h₄, h₅, h₆⟩,
end

theorem imo2008_q2a (x y z : ℝ) (h : x*y*z = 1) (hx : x ≠ 1) (hy : y ≠ 1) (hz : z ≠ 1) :
  x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 ≥ 1 :=
begin
  rcases (subst_abc _ _ _ h) with ⟨a, b, c, ha, hb, hc, hx₂, hy₂, hz₂⟩,

  let m := c-b,
  let n := b-a,

  have hm_abc : m = c - b,          exact rfl,
  have hn_abc : n = b - a,          exact rfl,
  have ha_cmn : a = c - m - n,      linarith,
  have hb_cmn : b = c - m,          linarith,
  have hab_mn : (a-b)^2 = n^2,      { rw [ha_cmn, hb_cmn], ring },
  have hbc_mn : (b-c)^2 = m^2,      rw hb_cmn, ring,
  have hca_mn : (c-a)^2 = (m+n)^2,  rw ha_cmn, ring,

  have hm_ne_zero : m ≠ 0,
  { rw hm_abc, rw hy₂ at hy, intro p, apply hy, field_simp, linarith },

  have hn_ne_zero : n ≠ 0,
  { rw hn_abc, rw hx₂ at hx, intro p, apply hx, field_simp, linarith },

  have hmn_ne_zero : m + n ≠ 0,
  { rw hm_abc, rw hn_abc, rw hz₂ at hz, intro p, apply hz, field_simp, linarith },

  have key : x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 - 1 ≥ 0,

  calc  x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 - 1
      = (a/b)^2 / (a/b-1)^2 + (b/c)^2 / (b/c-1)^2 + (c/a)^2 / (c/a-1)^2 - 1 :
        by rw [hx₂, hy₂, hz₂]
  ... = a^2/(a-b)^2 + b^2/(b-c)^2 + c^2/(c-a)^2 - 1 :
        by field_simp [div_sub_one hb, div_sub_one hc, div_sub_one ha]
  ... = (c-m-n)^2/n^2 + (c-m)^2/m^2 + c^2/(m+n)^2 - 1 :
        by rw [hab_mn, hbc_mn, hca_mn, ha_cmn, hb_cmn]
  ... = ( (c*(m^2+n^2+m*n) - m*(m+n)^2) / (m*n*(m+n)) )^2 :
        by { ring_nf, field_simp, ring }
  ... ≥ 0 :
        by exact pow_two_nonneg _ ,

  linarith [key],
end

def rational_solutions := { s : ℚ×ℚ×ℚ | ∃ (x y z : ℚ), s = (x, y, z) ∧
  x ≠ 1 ∧ y ≠ 1 ∧ z ≠ 1 ∧ x*y*z = 1 ∧ x^2/(x-1)^2 + y^2/(y-1)^2 + z^2/(z-1)^2 = 1 }

theorem imo2008_q2b : set.infinite rational_solutions :=
begin
  let W := { s : ℚ×ℚ×ℚ | ∃ (x y z : ℚ), s = (x, y, z) ∧
    ∃ t : ℚ, t > 0 ∧ x = -(t+1)/t^2 ∧ y = t/(t+1)^2 ∧ z = -t*(t+1)},

  have hW_sub_S : W ⊆ rational_solutions,
  { intros s hs_in_W,
    rw rational_solutions,
    simp at hs_in_W ⊢,
    rcases hs_in_W with ⟨x, y, z, hs_xyz, ht⟩,
    rcases ht with ⟨t, ht_gt_zero, hx_t, hy_t, hz_t⟩,
    use x, use y, use z,

    have ht_ne_zero : t ≠ 0, exact ne_of_gt ht_gt_zero,
    have ht1_ne_zero : t+1 ≠ 0, linarith[ht_gt_zero],

    have key_gt_zero : t^2 + t + 1 > 0, linarith[pow_pos ht_gt_zero 2, ht_gt_zero],
    have key_ne_zero : t^2 + t + 1 ≠ 0, exact ne_of_gt key_gt_zero,

    have h₂ : x ≠ 1, { rw hx_t, field_simp, linarith[key_gt_zero] },
    have h₃ : y ≠ 1, { rw hy_t, field_simp, linarith[key_gt_zero] },
    have h₄ : z ≠ 1, { rw hz_t, linarith[key_gt_zero] },

    have h₅ : x*y*z = 1, { rw [hx_t, hy_t, hz_t], field_simp, ring },

    have h₆ : x^2/(x-1)^2 + y^2/(y-1)^2 + z^2/(z-1)^2 = 1,
    { have hx1 : (x - 1)^2 = (t^2 + t + 1)^2/t^4,
      { field_simp, rw hx_t, field_simp, ring },
      have hy1 : (y - 1)^2 = (t^2 + t + 1)^2/(t+1)^4,
      { field_simp, rw hy_t, field_simp, ring },
      have hz1 : (z - 1)^2 = (t^2 + t + 1)^2,
      { rw hz_t, ring },
      calc  x^2/(x-1)^2 + y^2/(y-1)^2 + z^2/(z-1)^2
          = (x^2*t^4 + y^2*(t+1)^4 + z^2)/(t^2 + t + 1)^2 :
            by { rw [hx1, hy1, hz1], field_simp }
      ... = 1 :
            by { rw [hx_t, hy_t, hz_t], field_simp, ring } },

    exact ⟨hs_xyz, h₂, h₃, h₄, h₅, h₆⟩,
  },

  have hW_inf : set.infinite W,
  { let g : ℚ×ℚ×ℚ → ℚ := (λs, -s.2.2),
    let Z := g '' W,

    have hZ_not_bdd : ¬bdd_above Z,
    { rw not_bdd_above_iff,
      intro q,
      let t : ℚ := max (q+1) 1,
      use t*(t+1),
      let x : ℚ := (-1 + -t)/t^2,
      let y : ℚ := t/(t+1)^2,
      let z : ℚ := -t*(t+1),
      have hz_def : z = -t*(t+1), exact rfl,

      split,
      { simp, use x, use y, use z, split,
        { use x, use y, use z, split,
          { split, refl, split, refl, refl },
          { use t, split,
            { simp, right, exact zero_lt_one },
            { split, refl, split, refl, linarith[hz_def] } } },
        { have hg_eval : g(x, y, z) = -z, exact rfl,
          rw hg_eval, linarith[hz_def] } },
      { calc q < q + 1    : by { linarith }
           ... ≤ t        : by { exact le_max_left (q + 1) 1 }
           ... ≤ t+t^2    : by { linarith [pow_two_nonneg t] }
           ... = t*(t+1)  : by { ring } },
    },

    have hZ_inf : set.infinite Z,
    { intro h, apply hZ_not_bdd, exact set.finite.bdd_above h },

    exact set.infinite_of_infinite_image g hZ_inf,
  },

  exact set.infinite_mono hW_sub_S hW_inf,
end


import tactic.interactive tactic.ring

inductive is_even : ℕ → Prop
| zero : is_even 0
| step {n} : is_even n → is_even (n + 2)

example : is_even 4 :=
begin
repeat { apply is_even.step },
apply is_even.zero,
end

example : ¬ is_even 5 :=
begin
intro even_five,
cases even_five with _ even_three,
cases even_three with _ even_one,
cases even_one,
end

lemma even_if_double {n} : is_even (2*n) :=
begin
induction n with d hd,
{ exact is_even.zero },
{ show is_even (2 * (d + 1)),
  rw mul_add,
  apply is_even.step,
  assumption,
 },
end

lemma double_if_even {n} : is_even n → ∃ m, n = 2*m :=
begin
intro h, induction h with d Hd ih,
{ use 0,
  refl
},
{ cases ih with n Hn,
  use (n + 1),
  rw Hn,
  refl,
 }
end

lemma even_iff_double {n} : is_even n ↔ ∃ m, n = 2*m :=
begin
split, apply double_if_even,
intro h, cases h with d Hd, rw Hd,
  apply even_if_double
end

inductive is_odd : ℕ → Prop
| one : is_odd 1
| step {n} : is_odd n → is_odd (n + 2)

lemma odd_iff_double_add_one {n} : is_odd n ↔ ∃ m, n = 2*m + 1 :=
sorry

lemma even_of_not_odd : ∀ n,
¬ is_odd n → is_even n
| 0 h := is_even.zero
| 1 h := begin exfalso, apply h, constructor end
| (n+2) h :=
  have ih : _, from even_of_not_odd n,
  begin
  constructor,
  apply ih,
  intro hn,
  apply h,
  constructor, assumption,
  end

#print even_of_not_odd

lemma not_odd_of_even : ∀ n, is_even n → ¬ is_odd n :=
begin
intros n h,
induction h with m m hm,
{intro h, cases h},
{intro h, apply hm, cases h, assumption},
end

lemma even_iff_not_odd : ∀ n, is_even n ↔ ¬ is_odd n :=
begin
intro n, split, apply not_odd_of_even, apply even_of_not_odd
end

lemma odd_square (n : ℕ) : is_odd n → is_odd (n*n) :=
begin
simp [odd_iff_double_add_one],
intro m,
intros  h,
use 2*m + 2*m*m, subst h, ring,
end

lemma even_square (n : ℕ) : is_even (n*n) → is_even n :=
begin
conv in (is_even (n*n)) { simp [even_iff_not_odd] },
simp [even_iff_not_odd],
intros h1 h2, apply h1,
apply odd_square, assumption
end

set_option pp.all true
#check (7 : ℤ)


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import set_theory.cardinal.basic

/-!
# Denumerability of ℚ

This file proves that ℚ is infinite, denumerable, and deduces that it has cardinality `omega`.
-/

namespace rat
open denumerable

instance : infinite ℚ :=
infinite.of_injective (coe : ℕ → ℚ) nat.cast_injective

private def denumerable_aux : ℚ ≃ { x : ℤ × ℕ // 0 < x.2 ∧ x.1.nat_abs.coprime x.2 } :=
{ to_fun := λ x, ⟨⟨x.1, x.2⟩, x.3, x.4⟩,
  inv_fun := λ x, ⟨x.1.1, x.1.2, x.2.1, x.2.2⟩,
  left_inv := λ ⟨_, _, _, _⟩, rfl,
  right_inv := λ ⟨⟨_, _⟩, _, _⟩, rfl }

/-- **Denumerability of the Rational Numbers** -/
instance : denumerable ℚ :=
begin
  let T := { x : ℤ × ℕ // 0 < x.2 ∧ x.1.nat_abs.coprime x.2 },
  letI : infinite T := infinite.of_injective _ denumerable_aux.injective,
  letI : encodable T := subtype.encodable,
  letI : denumerable T := of_encodable_of_infinite T,
  exact denumerable.of_equiv T denumerable_aux
end

end rat

open_locale cardinal

lemma cardinal.mk_rat : #ℚ = ℵ₀ := by simp


/-
Copyright (c) 2021 Stuart Presnell. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stuart Presnell
-/
import data.nat.prime
import data.nat.mul_ind

/-!
# Prime factorizations

 `n.factorization` is the finitely supported function `ℕ →₀ ℕ`
 mapping each prime factor of `n` to its multiplicity in `n`.  For example, since 2000 = 2^4 * 5^3,
  * `factorization 2000 2` is 4
  * `factorization 2000 5` is 3
  * `factorization 2000 k` is 0 for all other `k : ℕ`.

## TODO

* As discussed in this Zulip thread:
https://leanprover.zulipchat.com/#narrow/stream/217875/topic/Multiplicity.20in.20the.20naturals
We have lots of disparate ways of talking about the multiplicity of a prime
in a natural number, including `factors.count`, `padic_val_nat`, `multiplicity`,
and the material in `data/pnat/factors`.  Move some of this material to this file,
prove results about the relationships between these definitions,
and (where appropriate) choose a uniform canonical way of expressing these ideas.

* Moreover, the results here should be generalised to an arbitrary unique factorization monoid
with a normalization function, and then deduplicated.  The basics of this have been started in
`ring_theory/unique_factorization_domain`.

-/

open nat finset list finsupp
open_locale big_operators

namespace nat

/-- `n.factorization` is the finitely supported function `ℕ →₀ ℕ`
 mapping each prime factor of `n` to its multiplicity in `n`. -/
noncomputable def factorization (n : ℕ) : ℕ →₀ ℕ := (n.factors : multiset ℕ).to_finsupp

@[simp] lemma factorization_prod_pow_eq_self {n : ℕ} (hn : n ≠ 0) : n.factorization.prod pow = n :=
begin
  simp only [←prod_to_multiset, factorization, multiset.coe_prod, multiset.to_finsupp_to_multiset],
  exact prod_factors hn.bot_lt,
end

lemma factorization_eq_count {n p : ℕ} : n.factorization p = n.factors.count p :=
by simp [factorization]
-- TODO: As part of the unification mentioned in the TODO above,
-- consider making this a [simp] lemma from `n.factors.count` to `n.factorization`

/-- Every nonzero natural number has a unique prime factorization -/
lemma factorization_inj : set.inj_on factorization { x : ℕ | x ≠ 0 } :=
λ a ha b hb h, eq_of_count_factors_eq
  (zero_lt_iff.mpr ha) (zero_lt_iff.mpr hb) (λ p, by simp [←factorization_eq_count, h])

@[simp] lemma factorization_zero : factorization 0 = 0  :=
by simp [factorization]

@[simp] lemma factorization_one : factorization 1 = 0 :=
by simp [factorization]

/-- The support of `n.factorization` is exactly `n.factors.to_finset` -/
@[simp] lemma support_factorization {n : ℕ} :
  n.factorization.support = n.factors.to_finset :=
by simpa [factorization, multiset.to_finsupp_support]

lemma factor_iff_mem_factorization {n p : ℕ} : p ∈ n.factorization.support ↔ p ∈ n.factors :=
by simp only [support_factorization, list.mem_to_finset]

lemma prime_of_mem_factorization {n p : ℕ} : p ∈ n.factorization.support → p.prime :=
(@prime_of_mem_factors n p) ∘ (@factor_iff_mem_factorization n p).mp

lemma pos_of_mem_factorization {n p : ℕ} : p ∈ n.factorization.support → 0 < p :=
(@prime.pos p) ∘ (@prime_of_mem_factorization n p)

lemma factorization_eq_zero_of_non_prime (n p : ℕ) (hp : ¬p.prime) : n.factorization p = 0 :=
not_mem_support_iff.1 (mt prime_of_mem_factorization hp)

/-- The only numbers with empty prime factorization are `0` and `1` -/
lemma factorization_eq_zero_iff (n : ℕ) : n.factorization = 0 ↔ n = 0 ∨ n = 1 :=
by simp [factorization, add_equiv.map_eq_zero_iff, multiset.coe_eq_zero]

/-- For nonzero `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/
@[simp] lemma factorization_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a * b).factorization = a.factorization + b.factorization :=
by { ext p, simp only [add_apply, factorization_eq_count,
  count_factors_mul_of_pos (zero_lt_iff.mpr ha) (zero_lt_iff.mpr hb)] }

/-- For any `p`, the power of `p` in `n^k` is `k` times the power in `n` -/
lemma factorization_pow {n k : ℕ} :
  factorization (n^k) = k • n.factorization :=
by { ext p, simp [factorization_eq_count, factors_count_pow] }

/-- The only prime factor of prime `p` is `p` itself, with multiplicity `1` -/
@[simp] lemma prime.factorization {p : ℕ} (hp : prime p) :
  p.factorization = single p 1 :=
begin
  ext q,
  rw [factorization_eq_count, factors_prime hp, single_apply, count_singleton', if_congr eq_comm];
  refl,
end

/-- For prime `p` the only prime factor of `p^k` is `p` with multiplicity `k` -/
@[simp] lemma prime.factorization_pow {p k : ℕ} (hp : prime p) :
  factorization (p^k) = single p k :=
by simp [factorization_pow, hp.factorization]

/-- For any `p : ℕ` and any function `g : α → ℕ` that's non-zero on `S : finset α`,
the power of `p` in `S.prod g` equals the sum over `x ∈ S` of the powers of `p` in `g x`.
Generalises `factorization_mul`, which is the special case where `S.card = 2` and `g = id`. -/
lemma factorization_prod {α : Type*} {S : finset α} {g : α → ℕ} (hS : ∀ x ∈ S, g x ≠ 0) :
  (S.prod g).factorization = S.sum (λ x, (g x).factorization) :=
begin
  classical,
  ext p,
  apply finset.induction_on' S, { simp },
  { intros x T hxS hTS hxT IH,
    have hT : T.prod g ≠ 0 := prod_ne_zero_iff.mpr (λ x hx, hS x (hTS hx)),
    simp [prod_insert hxT, sum_insert hxT, ←IH, factorization_mul (hS x hxS) hT] }
end

/-! ### Factorizations of pairs of coprime numbers -/

/-- The prime factorizations of coprime `a` and `b` are disjoint -/
lemma factorization_disjoint_of_coprime {a b : ℕ} (hab : coprime a b) :
  disjoint a.factorization.support b.factorization.support :=
by simpa only [support_factorization]
  using disjoint_to_finset_iff_disjoint.mpr (coprime_factors_disjoint hab)

/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/
lemma factorization_mul_of_coprime {a b : ℕ} (hab : coprime a b) :
  (a * b).factorization = a.factorization + b.factorization :=
begin
  ext q,
  simp only [finsupp.coe_add, add_apply, factorization_eq_count, count_factors_mul_of_coprime hab],
end

/-- For coprime `a` and `b` the prime factorization `a * b` is the union of those of `a` and `b` -/
lemma factorization_mul_support_of_coprime {a b : ℕ} (hab : coprime a b) :
  (a * b).factorization.support = a.factorization.support ∪ b.factorization.support :=
begin
  rw factorization_mul_of_coprime hab,
  exact support_add_eq (factorization_disjoint_of_coprime hab),
end

lemma factorization_mul_support {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a * b).factorization.support = a.factorization.support ∪ b.factorization.support :=
begin
  ext q,
  simp only [finset.mem_union, factor_iff_mem_factorization],
  rw mem_factors_mul ha hb,
end

/-- For any multiplicative function `f` with `f 1 = 1` and any `n > 0`,
we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
lemma multiplicative_factorization {β : Type*} [comm_monoid β] (f : ℕ → β)
  (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf : f 1 = 1) :
  ∀ {n : ℕ}, n ≠ 0 → f n = n.factorization.prod (λ p k, f (p ^ k)) :=
begin
  apply' nat.rec_on_pos_prime_coprime,
  { intros p k hp hk hpk, simp [prime.factorization_pow hp, finsupp.prod_single_index _, hf] },
  { simp },
  { rintros -, rw [factorization_one, hf], simp },
  { intros a b _ _ hab ha hb hab_pos,
    rw [h_mult a b hab, ha (left_ne_zero_of_mul hab_pos), hb (right_ne_zero_of_mul hab_pos),
        factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint],
    convert (factorization_disjoint_of_coprime hab) },
end

/-- For any multiplicative function `f` with `f 1 = 1` and `f 0 = 1`,
we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
lemma multiplicative_factorization' {β : Type*} [comm_monoid β] (f : ℕ → β)
  (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf0 : f 0 = 1) (hf1 : f 1 = 1) :
  ∀ {n : ℕ}, f n = n.factorization.prod (λ p k, f (p ^ k)) :=
begin
  apply' nat.rec_on_pos_prime_coprime,
  { intros p k hp hk, simp only [hp.factorization_pow], rw prod_single_index _, simp [hf1] },
  { simp [hf0] },
  { rw [factorization_one, hf1], simp },
  { intros a b _ _ hab ha hb,
    rw [h_mult a b hab, ha, hb, factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint],
    convert (factorization_disjoint_of_coprime hab) },
end

/-! ### Factorization and divisibility -/

lemma factorization_le_iff_dvd {d n : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) :
  d.factorization ≤ n.factorization ↔ d ∣ n :=
begin
  split,
  { intro hdn,
    set K := n.factorization - d.factorization with hK,
    use K.prod pow,
    rw [←factorization_prod_pow_eq_self hn, ←factorization_prod_pow_eq_self hd,
        ←finsupp.prod_add_index pow_zero pow_add, hK, add_tsub_cancel_of_le hdn] },
  { rintro ⟨c, rfl⟩, rw factorization_mul hd (right_ne_zero_of_mul hn), simp },
end

lemma prime_pow_dvd_iff_le_factorization (p k n : ℕ) (pp : prime p) (hn : n ≠ 0) :
  p ^ k ∣ n ↔ k ≤ n.factorization p :=
by rw [←factorization_le_iff_dvd (pow_pos pp.pos k).ne' hn, pp.factorization_pow, single_le_iff]

lemma exists_factorization_lt_of_lt {a b : ℕ} (ha : a ≠ 0) (hab : a < b) :
  ∃ p : ℕ, a.factorization p < b.factorization p :=
begin
  have hb : b ≠ 0 := (ha.bot_lt.trans hab).ne',
  contrapose! hab,
  rw [←finsupp.le_def, factorization_le_iff_dvd hb ha] at hab,
  exact le_of_dvd ha.bot_lt hab,
end

@[simp]
lemma div_factorization_eq_tsub_of_dvd {d n : ℕ} (hn : n ≠ 0) (h : d ∣ n) :
  (n / d).factorization = n.factorization - d.factorization :=
begin
  have hd : d ≠ 0 := ne_zero_of_dvd_ne_zero hn h,
  cases dvd_iff_exists_eq_mul_left.mp h with c hc,
  have hc_pos : c ≠ 0, { subst hc, exact left_ne_zero_of_mul hn },
  rw [hc, nat.mul_div_cancel c hd.bot_lt, factorization_mul hc_pos hd, add_tsub_cancel_right],
end

lemma dvd_iff_div_factorization_eq_tsub (d n : ℕ) (hd : d ≠ 0) (hdn : d ≤ n) :
  d ∣ n ↔ (n / d).factorization = n.factorization - d.factorization :=
begin
  have hn : n ≠ 0 := (lt_of_lt_of_le hd.bot_lt hdn).ne.symm,
  refine ⟨div_factorization_eq_tsub_of_dvd hn, _⟩,
  { rcases eq_or_lt_of_le hdn with rfl | hd_lt_n, { simp },
    have h1 : n / d ≠ 0 := λ H, nat.lt_asymm hd_lt_n ((nat.div_eq_zero_iff hd.bot_lt).mp H),
    intros h,
    rw dvd_iff_le_div_mul n d,
    by_contra h2,
    cases (exists_factorization_lt_of_lt (mul_ne_zero h1 hd) (not_le.mp h2)) with p hp,
    rwa [factorization_mul h1 hd, add_apply, ←lt_tsub_iff_right, h, tsub_apply,
      lt_self_iff_false] at hp },
end

lemma pow_factorization_dvd (p d : ℕ) : p ^ d.factorization p ∣ d :=
begin
  rcases eq_or_ne d 0 with rfl | hd, { simp },
  by_cases pp : prime p,
  { rw prime_pow_dvd_iff_le_factorization p _ d pp hd },
  { rw factorization_eq_zero_of_non_prime d p pp, simp },
end

lemma dvd_iff_prime_pow_dvd_dvd {n d : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) :
  d ∣ n ↔ ∀ p k : ℕ, prime p → p^k ∣ d → p^k ∣ n :=
begin
  split,
  { exact λ h p k pp hpkd, dvd_trans hpkd h },
  { intros h,
    rw [←factorization_le_iff_dvd hd hn, finsupp.le_def],
    intros p,
    by_cases pp : prime p, swap,
    { rw factorization_eq_zero_of_non_prime d p pp, exact zero_le' },
    rw ←prime_pow_dvd_iff_le_factorization p _ n pp hn,
    exact h p _ pp (pow_factorization_dvd p _) },
end

end nat


-- Unicidad_del_limite_de_las_sucesiones_convergentes.lean
-- Unicidad del límite de las sucesiones convergentes
-- José A. Alonso Jiménez
-- Sevilla, 12 de julio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, una sucesión u₀, u₁, u₂, ... se puede representar mediante
-- una función (u : ℕ → ℝ) de forma que u(n) es uₙ.
--
-- Se define que a es el límite de la sucesión u, por
--    def limite : (ℕ → ℝ) → ℝ → Prop :=
--    λ u a, ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - a| < ε
-- donde se usa la notación |x| para el valor absoluto de x
--    notation `|`x`|` := abs x
--
-- Demostrar que cada sucesión tiene como máximo un límite.
-- ---------------------------------------------------------------------

import data.real.basic

variables {u : ℕ → ℝ}
variables {a b : ℝ}

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

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

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

lemma aux
  (ha : limite u a)
  (hb : limite u b)
  : b ≤ a :=
begin
  by_contra h,
  set ε := b - a with hε,
  cases ha (ε/2) (by linarith) with A hA,
  cases hb (ε/2) (by linarith) with B hB,
  set N := max A B with hN,
  have hAN : A ≤ N := le_max_left A B,
  have hBN : B ≤ N := le_max_right A B,
  specialize hA N hAN,
  specialize hB N hBN,
  rw abs_lt at hA hB,
  linarith,
end

example
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
le_antisymm (aux hb ha) (aux ha hb)

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

example
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
begin
  by_contra h,
  wlog hab : a < b,
  { have : a < b ∨ a = b ∨ b < a := lt_trichotomy a b,
    tauto },
  set ε := b - a with hε,
  specialize ha (ε/2),
  have hε2 : ε/2 > 0 := by linarith,
  specialize ha hε2,
  cases ha with A hA,
  cases hb (ε/2) (by linarith) with B hB,
  set N := max A B with hN,
  have hAN : A ≤ N := le_max_left A B,
  have hBN : B ≤ N := le_max_right A B,
  specialize hA N hAN,
  specialize hB N hBN,
  rw abs_lt at hA hB,
  linarith,
end

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

example
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
begin
  by_contra h,
  wlog hab : a < b,
  { have : a < b ∨ a = b ∨ b < a := lt_trichotomy a b,
    tauto },
  set ε := b - a with hε,
  cases ha (ε/2) (by linarith) with A hA,
  cases hb (ε/2) (by linarith) with B hB,
  set N := max A B with hN,
  have hAN : A ≤ N := le_max_left A B,
  have hBN : B ≤ N := le_max_right A B,
  specialize hA N hAN,
  specialize hB N hBN,
  rw abs_lt at hA hB,
  linarith,
end


/-
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.

# 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:
https://www.ma.imperial.ac.uk/~buzzard/xena/formalising-mathematics-2023/Part_B/equality.html

## 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
  sorry
end

example : false → ¬ true :=
begin
  sorry
end

example : ¬ false → true :=
begin
  sorry
end

example : true → ¬ false :=
begin
  sorry
end

example : false → ¬ P :=
begin
  sorry
end

example : P → ¬ P → false :=
begin
  sorry
end

example : P → ¬ (¬ P) :=
begin
  sorry
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  sorry
end

example : ¬ ¬ false → false :=
begin
  sorry
end

example : ¬ ¬ P → P :=
begin
  sorry
end

example : (¬ Q → ¬ P) → (P → Q) :=
begin
  sorry,
end


/-
Copyright (c) 2022 Hans Parshall. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hans Parshall
-/
import analysis.matrix
import analysis.normed_space.basic
import data.complex.is_R_or_C
import linear_algebra.unitary_group

/-!
# Unitary matrices

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

open_locale big_operators matrix

variables {𝕜 n E : Type*}

namespace matrix
variables [fintype n] [semi_normed_group E] [star_add_monoid E] [normed_star_group E]

local attribute [instance] matrix.semi_normed_group

@[simp] lemma entrywise_sup_norm_star_eq_norm (M : matrix n n E) : ∥star M∥ = ∥M∥ :=
begin
  refine le_antisymm (by simp [matrix.norm_le_iff, M.norm_entry_le_entrywise_sup_norm]) _,
  refine ((matrix.norm_le_iff (norm_nonneg _)).mpr (λ i j, _)).trans
    (congr_arg _ M.star_eq_conj_transpose).ge,
  exact (normed_star_group.norm_star).symm.le.trans Mᴴ.norm_entry_le_entrywise_sup_norm
end

@[priority 100] -- see Note [lower instance priority]
instance to_normed_star_group : normed_star_group (matrix n n E) :=
⟨matrix.entrywise_sup_norm_star_eq_norm⟩

end matrix

section entrywise_sup_norm
variables [is_R_or_C 𝕜] [fintype n] [decidable_eq n]

lemma entry_norm_bound_of_unitary {U : matrix n n 𝕜} (hU : U ∈ matrix.unitary_group n 𝕜) (i j : n):
  ∥U i j∥ ≤ 1 :=
begin
  -- 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),
  { apply multiset.single_le_sum,
    { intros 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, 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,
  { simp only [matrix.mul_apply, matrix.conj_transpose_apply, ←star_ring_end_apply,
               is_R_or_C.mul_conj, is_R_or_C.norm_sq_eq_def', is_R_or_C.of_real_pow] },
  -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ, real part
  have re_diag_eq_norm_sum : is_R_or_C.re ((U ⬝ Uᴴ) i i) = ∑ (x : n), ∥ U i x ∥^2,
  { rw is_R_or_C.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, from unitary.mul_star_self_of_mem hU,
  have diag_eq_one : is_R_or_C.re ((U ⬝ Uᴴ) i i) = 1,
  { simp only [mul_eq_one, eq_self_iff_true, matrix.one_apply_eq, is_R_or_C.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,
end

local attribute [instance] matrix.normed_group

/-- The entrywise sup norm of a unitary matrix is at most 1. -/
lemma entrywise_sup_norm_bound_of_unitary {U : matrix n n 𝕜} (hU : U ∈ matrix.unitary_group n 𝕜) :
  ∥ U ∥ ≤ 1 :=
begin
  simp_rw pi_norm_le_iff zero_le_one,
  intros i j,
  exact entry_norm_bound_of_unitary hU _ _
end

end entrywise_sup_norm


/-
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, Yuyang Zhao
-/
import algebra.order.monoid.lemmas
import algebra.order.zero_le_one
import data.nat.cast.defs

/-!
# Order of numerials in an `add_monoid_with_one`.

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

variable {α : Type*}

open function

lemma lt_add_one [has_one α] [add_zero_class α] [partial_order α] [zero_le_one_class α]
  [ne_zero (1 : α)] [covariant_class α α (+) (<)] (a : α) : a < a + 1 :=
lt_add_of_pos_right _ zero_lt_one

lemma lt_one_add [has_one α] [add_zero_class α] [partial_order α] [zero_le_one_class α]
  [ne_zero (1 : α)] [covariant_class α α (swap (+)) (<)] (a : α) : a < 1 + a :=
lt_add_of_pos_left _ zero_lt_one

variable [add_monoid_with_one α]

lemma zero_le_two [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] :
  (0 : α) ≤ 2 :=
add_nonneg zero_le_one zero_le_one

lemma zero_le_three [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] :
  (0 : α) ≤ 3 :=
add_nonneg zero_le_two zero_le_one

lemma zero_le_four [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] :
  (0 : α) ≤ 4 :=
add_nonneg zero_le_two zero_le_two

lemma one_le_two [has_le α] [zero_le_one_class α] [covariant_class α α (+) (≤)] :
  (1 : α) ≤ 2 :=
calc 1 = 1 + 0 : (add_zero 1).symm
   ... ≤ 1 + 1 : add_le_add_left zero_le_one _

lemma one_le_two' [has_le α] [zero_le_one_class α] [covariant_class α α (swap (+)) (≤)] :
  (1 : α) ≤ 2 :=
calc 1 = 0 + 1 : (zero_add 1).symm
   ... ≤ 1 + 1 : add_le_add_right zero_le_one _

section
variables [partial_order α] [zero_le_one_class α] [ne_zero (1 : α)]

section
variables [covariant_class α α (+) (≤)]

/-- See `zero_lt_two'` for a version with the type explicit. -/
@[simp] lemma zero_lt_two : (0 : α) < 2 := zero_lt_one.trans_le one_le_two
/-- See `zero_lt_three'` for a version with the type explicit. -/
@[simp] lemma zero_lt_three : (0 : α) < 3 := lt_add_of_lt_of_nonneg zero_lt_two zero_le_one
/-- See `zero_lt_four'` for a version with the type explicit. -/
@[simp] lemma zero_lt_four : (0 : α) < 4 := lt_add_of_lt_of_nonneg zero_lt_two zero_le_two

variables (α)

/-- See `zero_lt_two` for a version with the type implicit. -/
lemma zero_lt_two' : (0 : α) < 2 := zero_lt_two
/-- See `zero_lt_three` for a version with the type implicit. -/
lemma zero_lt_three' : (0 : α) < 3 := zero_lt_three
/-- See `zero_lt_four` for a version with the type implicit. -/
lemma zero_lt_four' : (0 : α) < 4 := zero_lt_four

instance zero_le_one_class.ne_zero.two : ne_zero (2 : α) := ⟨zero_lt_two.ne'⟩
instance zero_le_one_class.ne_zero.three : ne_zero (3 : α) := ⟨zero_lt_three.ne'⟩
instance zero_le_one_class.ne_zero.four : ne_zero (4 : α) := ⟨zero_lt_four.ne'⟩

end

lemma one_lt_two [covariant_class α α (+) (<)] : (1 : α) < 2 := lt_add_one _

end

alias zero_lt_two ← two_pos
alias zero_lt_three ← three_pos
alias zero_lt_four ← four_pos


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

import data.mv_polynomial.basic

/-!
## Counit morphisms for multivariate polynomials

One may consider the ring of multivariate polynomials `mv_polynomial A R` with coefficients in `R`
and variables indexed by `A`. If `A` is not just a type, but an algebra over `R`,
then there is a natural surjective algebra homomorphism `mv_polynomial A R →ₐ[R] A`
obtained by `X a ↦ a`.

### Main declarations

* `mv_polynomial.acounit R A` is the natural surjective algebra homomorphism
  `mv_polynomial A R →ₐ[R] A` obtained by `X a ↦ a`
* `mv_polynomial.counit` is an “absolute” variant with `R = ℤ`
* `mv_polynomial.counit_nat` is an “absolute” variant with `R = ℕ`

-/

namespace mv_polynomial
open function

variables (A B R : Type*) [comm_semiring A] [comm_semiring B] [comm_ring R] [algebra A B]

/-- `mv_polynomial.acounit A B` is the natural surjective algebra homomorphism
`mv_polynomial B A →ₐ[A] B` obtained by `X a ↦ a`.

See `mv_polynomial.counit` for the “absolute” variant with `A = ℤ`,
and `mv_polynomial.counit_nat` for the “absolute” variant with `A = ℕ`. -/
noncomputable def acounit : mv_polynomial B A →ₐ[A] B :=
aeval id

variables {B}

@[simp] lemma acounit_X (b : B) : acounit A B (X b) = b := aeval_X _ b

variables {A} (B)

@[simp] lemma acounit_C (a : A) : acounit A B (C a) = algebra_map A B a := aeval_C _ a

variables (A)

lemma acounit_surjective : surjective (acounit A B) := λ b, ⟨X b, acounit_X A b⟩

/-- `mv_polynomial.counit R` is the natural surjective ring homomorphism
`mv_polynomial R ℤ →+* R` obtained by `X r ↦ r`.

See `mv_polynomial.acounit` for a “relative” variant for algebras over a base ring,
and `mv_polynomial.counit_nat` for the “absolute” variant with `R = ℕ`. -/
noncomputable def counit : mv_polynomial R ℤ →+* R :=
acounit ℤ R

/-- `mv_polynomial.counit_nat A` is the natural surjective ring homomorphism
`mv_polynomial A ℕ →+* A` obtained by `X a ↦ a`.

See `mv_polynomial.acounit` for a “relative” variant for algebras over a base ring
and `mv_polynomial.counit` for the “absolute” variant with `A = ℤ`. -/
noncomputable def counit_nat : mv_polynomial A ℕ →+* A :=
acounit ℕ A

lemma counit_surjective : surjective (counit R) := acounit_surjective ℤ R
lemma counit_nat_surjective : surjective (counit_nat A) := acounit_surjective ℕ A

variables {R A}

@[simp] lemma counit_X (r : R) : counit R (X r) = r := acounit_X _ _
@[simp] lemma counit_nat_X (a : A) : counit_nat A (X a) = a := acounit_X _ _

end mv_polynomial


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

! This file was ported from Lean 3 source module data.int.dvd.pow
! leanprover-community/mathlib commit b3f25363ae62cb169e72cd6b8b1ac97bacf21ca7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Int.Dvd.Basic
import Mathlib.Data.Nat.Pow

/-!
# Basic lemmas about the divisibility relation in `ℤ` involving powers.
-/

open Nat

namespace Int

set_option linter.deprecated false in
@[simp]
theorem sign_pow_bit1 (k : ℕ) : ∀ n : ℤ, n.sign ^ bit1 k = n.sign
  | (_ + 1 : ℕ) => one_pow (bit1 k)
  | 0 => zero_pow (Nat.zero_lt_bit1 k)
  | -[_+1] => (neg_pow_bit1 1 k).trans (congr_arg (fun x => -x) (one_pow (bit1 k)))
-- #align int.sign_pow_bit1 Int.sign_pow_bit1

theorem pow_dvd_of_le_of_pow_dvd {p m n : ℕ} {k : ℤ} (hmn : m ≤ n) (hdiv : ↑(p ^ n) ∣ k) :
    ↑(p ^ m) ∣ k := by
  induction k with
  | ofNat k =>
    apply Int.coe_nat_dvd.2
    apply Nat.pow_dvd_of_le_of_pow_dvd hmn
    apply Int.coe_nat_dvd.1 hdiv
  | negSucc k =>
    show ↑(p ^ m) ∣ -(↑(k + 1) : ℤ)
    apply dvd_neg_of_dvd
    apply Int.coe_nat_dvd.2
    apply Nat.pow_dvd_of_le_of_pow_dvd hmn
    apply Int.coe_nat_dvd.1
    apply dvd_of_dvd_neg
    exact hdiv
-- #align int.pow_dvd_of_le_of_pow_dvd Int.pow_dvd_of_le_of_pow_dvd

theorem dvd_of_pow_dvd {p k : ℕ} {m : ℤ} (hk : 1 ≤ k) (hpk : ↑(p ^ k) ∣ m) : ↑p ∣ m := by
  rw [← pow_one p] ; exact pow_dvd_of_le_of_pow_dvd hk hpk
-- #align int.dvd_of_pow_dvd Int.dvd_of_pow_dvd

end Int


import tactic.push_neg
import .src_11_lem_reductio

variables p q r : Prop

namespace mth1001

section contrapositive
/-
Recall that the contrapositive of the statement `p → q` is the statement `¬q → ¬p`.

Lean has a tactic `contrapose` that turns any goal of the form `p → q` into its contrapositive.
-/

example (h : ¬q → ¬p) : p → q :=
begin
  contrapose,
  exact h,
end

/-
Below, `contrapose` replaces `¬q → ¬p` with its contrapositve, `¬¬p → ¬¬q`. We simplify this
expression using our result `not_not` which asserts `¬¬a ↔ a`, for any proposition `a`.
-/
example (h : p → q) : ¬q → ¬p :=
begin
  contrapose,
  rw [not_not, not_not],
  exact h,
end

/-
Instead of `not_not`, we can use the tactic `push_neg`, a big bag of tricks used to push a negation
inside the goal.
-/
example (h : p → q) : ¬q → ¬p :=
begin
  contrapose,
  push_neg,
  exact h,
end

-- Exercise 069:
/-
Using only the tactics `push_neg`, `intro`, and `exact`, prove the following,
which we've seen as `not_and_of_not_or_not`.
-/
example : (¬p ∨ ¬ q) → ¬(p ∧ q) :=
begin
  sorry
end

-- Exercise 070:
-- We can use `contrapose` to reprove `not_or_not_of_not_and`. Don't use `push_neg` in this example.
example : ¬(p ∧ q) → ¬p ∨ ¬q :=
begin
  contrapose,
  rw not_not,
  intro h,
  have h₁ : p ↔ ¬¬p, from not_not.symm,
  sorry
end

/-
The above result is proved easily using the combination of `contrapose` and `push_neg`. In fact,
this is such a commmon combination that Lean offers it as the single tactic `contrapose!`.
-/

example : (¬q → ¬p) → (p → q) :=
begin
  intro h,
  contrapose!,
  exact h,
end

-- Exercise 071:
example : ¬(p ∧ q) → ¬p ∨ ¬q :=
begin
  contrapose!,
  sorry
end

/-
A typical first step in proving a goal `p → q` is implication introduction, applying the tactic
`intro h₁` (say) to introduce the premise `h₁ : p` and changing the goal to `q`.

Sometimes, it's useful to go in the other direction. In the following example, the goal is `q`
while there are premises `h₁ : p` and `h₂ : ¬q → ¬p`.

The `revert` tactic 'puts back' the premise `h₁ : p`, transforming the goal into `p → q` and
removing `h₁`. After reversion, the goal is amenable to the `contrapose` tactic.
-/
example (h₁ : p) (h₂ : ¬q → ¬p) : q :=
begin
  revert h₁,
  contrapose,
  exact h₂,
end

-- Exercise 072:
-- Prove the following using `revert`, `apply`, and `not_or_not_of_not_and`.
example (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
begin
  sorry
end

/-
An alternative to `revert` is to use `contrapose` with the name of a premise. At the point of
application in the proof below, the goal is `q` and `h₁` is the assertion `h₁ : p`. Focussing just
on this premise and the goal, we have to prove `p → q`. The contrapositive is `¬q → ¬p`.
The application `contrapose h₁` replaces the goal with `¬p` and replaces `h₁` with `h₁ : ¬q`.
-/
example (h₁ : p) (h₂ : ¬q → ¬p) : q :=
begin
  contrapose h₁,
  exact h₂ h₁,
end

-- Exercise 073:
-- Prove the following using the `revert`, `rw`, `apply`, `exact`, `contrapose`, tactics with
-- the results `not_not` and `not_and_not_of_not_or`.
example (h : ¬(p ∧ q) ) : ¬p ∨ ¬q :=
begin
  have k : ¬(¬¬p ∧ ¬¬q),
  { sorry, },
  sorry
end

end contrapositive

/-
SUMMARY:

* The contrapositive of `p → q` is `¬q → ¬p`.
* The `contrapose` tactic changes a goal into its contrapositive.
* Given `⊢ q` and `h : p`, `contrapose h` produces `⊢ ¬p` and `h : ¬q`.
* The `push_neg` tactic pushes a negation into a goal or premise.
* `contrapose!` is a combination of `contrapose` and `push_neg`.
* The `revert` tactic puts a premise back into the goal.
-/

end mth1001


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

/-!
# Modular Lattices
This file defines Modular Lattices, a kind of lattice useful in algebra.
For examples, look to the subobject lattices of abelian groups, submodules, and ideals, or consider
any distributive lattice.

## Main Definitions
- `is_modular_lattice` defines a modular lattice to be one such that
  `x ≤ z → (x ⊔ y) ⊓ z ≤ x ⊔ (y ⊓ z)`
- `inf_Icc_order_iso_Icc_sup` gives an order isomorphism between the intervals
  `[a ⊓ b, a]` and `[b, a ⊔ b]`.
  This corresponds to the diamond (or second) isomorphism theorems of algebra.

## Main Results
- `is_modular_lattice_iff_inf_sup_inf_assoc`:
  Modularity is equivalent to the `inf_sup_inf_assoc`: `(x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z`
- `distrib_lattice.is_modular_lattice`: Distributive lattices are modular.

## To do
- Relate atoms and coatoms in modular lattices

-/

variable {α : Type*}

/-- A modular lattice is one with a limited associativity between `⊓` and `⊔`. -/
class is_modular_lattice α [lattice α] : Prop :=
(sup_inf_le_assoc_of_le : ∀ {x : α} (y : α) {z : α}, x ≤ z → (x ⊔ y) ⊓ z ≤ x ⊔ (y ⊓ z))

section is_modular_lattice
variables [lattice α] [is_modular_lattice α ]

theorem sup_inf_assoc_of_le {x : α} (y : α) {z : α} (h : x ≤ z) :
  (x ⊔ y) ⊓ z = x ⊔ (y ⊓ z) :=
le_antisymm (is_modular_lattice.sup_inf_le_assoc_of_le y h)
  (le_inf (sup_le_sup_left inf_le_left _) (sup_le h inf_le_right))

theorem is_modular_lattice.inf_sup_inf_assoc {x y z : α} :
  (x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z :=
(sup_inf_assoc_of_le y inf_le_right).symm

lemma inf_sup_assoc_of_le {x : α} (y : α) {z : α} (h : z ≤ x) :
  (x ⊓ y) ⊔ z = x ⊓ (y ⊔ z) :=
by rw [inf_comm, sup_comm, ← sup_inf_assoc_of_le y h, inf_comm, sup_comm]

instance : is_modular_lattice (order_dual α) :=
⟨λ x y z xz, le_of_eq (by { rw [inf_comm, sup_comm, eq_comm, inf_comm, sup_comm],
  convert sup_inf_assoc_of_le (order_dual.of_dual y) (order_dual.dual_le.2 xz) })⟩

theorem is_modular_lattice.sup_inf_sup_assoc {x y z : α} :
  (x ⊔ z) ⊓ (y ⊔ z) = ((x ⊔ z) ⊓ y) ⊔ z :=
@is_modular_lattice.inf_sup_inf_assoc (order_dual α) _ _ _ _ _

/-- The diamond isomorphism between the intervals `[a ⊓ b, a]` and `[b, a ⊔ b]` -/
def inf_Icc_order_iso_Icc_sup (a b : α) : set.Icc (a ⊓ b) a ≃o set.Icc b (a ⊔ b) :=
{ to_fun := λ x, ⟨x ⊔ b, ⟨le_sup_right, sup_le_sup_right x.prop.2 b⟩⟩,
  inv_fun := λ x, ⟨a ⊓ x, ⟨inf_le_inf_left a x.prop.1, inf_le_left⟩⟩,
  left_inv := λ x, subtype.ext (by { change a ⊓ (↑x ⊔ b) = ↑x,
    rw [sup_comm, ← inf_sup_assoc_of_le _ x.prop.2, sup_eq_right.2 x.prop.1] }),
  right_inv := λ x, subtype.ext (by { change a ⊓ ↑x ⊔ b = ↑x,
    rw [inf_comm, inf_sup_assoc_of_le _ x.prop.1, inf_eq_left.2 x.prop.2] }),
  map_rel_iff' := λ x y, begin
    simp only [subtype.mk_le_mk, equiv.coe_fn_mk, and_true, le_sup_right],
    rw [← subtype.coe_le_coe],
    refine ⟨λ h, _, λ h, sup_le_sup_right h _⟩,
    rw [← sup_eq_right.2 x.prop.1, inf_sup_assoc_of_le _ x.prop.2, sup_comm,
      ← sup_eq_right.2 y.prop.1, inf_sup_assoc_of_le _ y.prop.2, @sup_comm _ _ b],
    exact inf_le_inf_left _ h
  end }
end is_modular_lattice

namespace is_compl
variables [bounded_lattice α] [is_modular_lattice α]

/-- The diamond isomorphism between the intervals `set.Iic a` and `set.Ici b`. -/
def Iic_order_iso_Ici {a b : α} (h : is_compl a b) : set.Iic a ≃o set.Ici b :=
(order_iso.set_congr (set.Iic a) (set.Icc (a ⊓ b) a) (h.inf_eq_bot.symm ▸ set.Icc_bot.symm)).trans $
  (inf_Icc_order_iso_Icc_sup a b).trans
  (order_iso.set_congr (set.Icc b (a ⊔ b)) (set.Ici b) (h.sup_eq_top.symm ▸ set.Icc_top))

end is_compl

theorem is_modular_lattice_iff_inf_sup_inf_assoc [lattice α] :
  is_modular_lattice α ↔ ∀ (x y z : α), (x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z :=
⟨λ h, @is_modular_lattice.inf_sup_inf_assoc _ _ h, λ h, ⟨λ x y z xz, by rw [← inf_eq_left.2 xz, h]⟩⟩

namespace distrib_lattice

@[priority 100]
instance [distrib_lattice α] : is_modular_lattice α :=
⟨λ x y z xz, by rw [inf_sup_right, inf_eq_left.2 xz]⟩

end distrib_lattice

theorem disjoint.disjoint_sup_right_of_disjoint_sup_left
  [bounded_lattice α] [is_modular_lattice α] {a b c : α}
  (h : disjoint a b) (hsup : disjoint (a ⊔ b) c) :
  disjoint a (b ⊔ c) :=
begin
  rw [disjoint, ← h.eq_bot, sup_comm],
  apply le_inf inf_le_left,
  apply (inf_le_inf_right (c ⊔ b) le_sup_right).trans,
  rw [sup_comm, is_modular_lattice.sup_inf_sup_assoc, hsup.eq_bot, bot_sup_eq]
end

namespace is_modular_lattice

variables [bounded_lattice α] [is_modular_lattice α] {a : α}

instance is_modular_lattice_Iic : is_modular_lattice (set.Iic a) :=
⟨λ x y z xz, (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩

instance is_modular_lattice_Ici : is_modular_lattice (set.Ici a) :=
⟨λ x y z xz, (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩

section is_complemented
variables [is_complemented α]

instance is_complemented_Iic : is_complemented (set.Iic a) :=
⟨λ ⟨x, hx⟩, ⟨⟨(classical.some (exists_is_compl x)) ⊓ a, set.mem_Iic.2 inf_le_right⟩, begin
    split,
    { change x ⊓ (classical.some _ ⊓ a) ≤ ⊥, -- improve lattice subtype API
      rw ← inf_assoc,
      exact le_trans inf_le_left (classical.some_spec (exists_is_compl x)).1 },
    { change a ≤ x ⊔ (classical.some _ ⊓ a), -- improve lattice subtype API
      rw [← sup_inf_assoc_of_le _ (set.mem_Iic.1 hx),
          top_le_iff.1 (classical.some_spec (exists_is_compl x)).2, top_inf_eq] }
  end⟩⟩

instance is_complemented_Ici : is_complemented (set.Ici a) :=
⟨λ ⟨x, hx⟩, ⟨⟨(classical.some (exists_is_compl x)) ⊔ a, set.mem_Ici.2 le_sup_right⟩, begin
    split,
    { change x ⊓ (classical.some _ ⊔ a) ≤ a, -- improve lattice subtype API
      rw [← inf_sup_assoc_of_le _ (set.mem_Ici.1 hx),
          le_bot_iff.1 (classical.some_spec (exists_is_compl x)).1, bot_sup_eq] },
    { change ⊤ ≤ x ⊔ (classical.some _ ⊔ a), -- improve lattice subtype API
      rw ← sup_assoc,
      exact le_trans (classical.some_spec (exists_is_compl x)).2 le_sup_left }
  end⟩⟩

end is_complemented

end is_modular_lattice


#print "------------------------------------------------"
#print "Section 2.8 Dependent Types" -- (page 16 in new ed)

/- It is clear that `cons α` should have type
            α → list α → list α
   But what type should `cons` itself have? A first guess might be
            Type → α → list α → list α
   But on reflection, we see this does not make sense: the α in this expression
   does not refer to anything, whereas it should refer to the argument of type Type.

   In other words, assuming `α : Type` is the first argument to the function, the
   type of the next two elements are `α` and `list α`. These types *depend* on the
   first argument `α`.

   This is an instance of a `Pi` type, or dependent function type.
   If we are given `α : Type` and `β : α → Type`, then we think of β as
   a family of types indexed by α. That is, we have a type `β a` for each `a : α`.
   The type
            Π x : α, β x
   denotes the type of functions f such that, for each `a : α`,
   `f a` is an element of `β a`.

   Note that `Π x : α, β` makes sense for any expression `β : Type`.
   When the value of β happens to depend on x, then `Π x : α, β` denotes a
   *dependent* function type. When β doesn't depend on x, then `Π x : α, β`
   is the same as the type `α → β`.

   Indeed, in dependent type theory (and in Lean), the `Pi` construction is
   fundamental, and `α → β` is just notation for `Π x : α, β` when β doesn't
   depend on α.
-/

namespace page25
  #print "----- page17, new ed-------------------"
  universe u
  constant list : Type u → Type u   -- N.B. we don't just want `list : Type → Type`
  constant cons : Π (α : Type u), α → list α → list α
  constant nil : Π (α : Type u), list α
  constant head : Π (α : Type u), list α → α
  constant tail : Π (α : Type u), list α → list α
  constant append : Π (α : Type u), list α → list α → list α

  #check list
  #check @cons
  #check @nil
  #check @head
  #check @tail
  #check @append

end page25

namespace page18 --(new edition)
  universe u
  constant vec : Type u → ℕ → Type u

  namespace vec
    constant empty : Π (α : Type u), vec α 0
    constant cons : Π (α : Type u) (n : ℕ), α → vec α n → vec α (n+1)
    constant append : Π (α : Type u) (n m : ℕ), vec α n → vec α m → vec α (n+m)
  end vec
end page18

/- One more important and illustrative example of dependent types, the
   *Sigma types*, `Σ x : α, β x`, sometimes known as *dependent products*.

   `Σ x : α, β x` denotes the type of pairs `sigma.mk a b` where `a : α` and `b : β a`.
-/

/- Pi types Π x : α, β x generalize the notion of a function type α → β by
   allowing β to depend on α.

   Sigma types `Σ x : α, β x` generalize the cartesian product `α × β` in the same way;
   in the expression sigma.mk a b, the type of the second element, `b : β a`, depends
   on the first element, `a : α`.
-/

namespace page27
  #print "----- page18, new ed-------------------"
  variable α : Type
  variable β : α → Type
  variable a : α
  variable b : β a

  #check sigma.mk a b          -- (a, b) : Σ (a : α), β a
  #check (sigma.mk a b).1      -- (a, b).fst : α
  #check (sigma.mk a b).2      -- β (sigma.fst (sigma.mk a b))

  #reduce (sigma.mk a b).1
  #reduce (sigma.mk a b).2
end page27

/- `(sigma.mk a b).1` and `(sigma.mk a b).2` are short for
   `sigma.fst (sigma.mk a b)` and `sigma.snd (sigma.mk a b)`,
   and these reduce to a and b, respectively.
   (cf. 3rd to last line of output below)
-/

/- Section 2.8 output
                list : Type u_1 → Type u_1
                cons : Π {T : Type u_1}, T → list T → list T
                nil : Π {T : Type u_1}, list T
                head : Π {α : Type u_1} [_inst_1 : inhabited α], list α → α
                tail : Π {α : Type u_1}, list α → list α
                append : Π {α : Type u_1} [c : has_append α], α → α → α
                ⟨a, b⟩ : Σ (a : α), β a
                ⟨a, b⟩.fst : α
                ⟨a, b⟩.snd : (λ (a : α), β a) (⟨a, b⟩.fst)
                a
                b
-/

#print "------------------------------------------------"
#print "Section 2.9 Implicit Arguments"
/- Lean allows us to specify that this argument should, by default, be left implicit.
   This is done by putting the arguments in curly braces. -/
namespace implicits
  universe u
  def ident {α : Type u} (x : α) := x
  variables α β : Type u
  variables (a : α) (b : β)
  #check ident
  #check ident a
  #check ident b

  /- This makes the first argument to ident implicit. Notationally, this hides the specification
     of the type, making it look as though ident simply takes an argument of any type. -/

  /- Sometimes, however, we may find ourselves in a situation where we have declared an
     argument to a function to be implicit, but now want to provide the argument explicitly. -/

  #check @id
  #check @id α
  #check @id β
  #check @id α a
  #check @id β b

  /- Notice that the first #check command now gives the type of the identifier, id, without
     inserting placeholders. Moreover, the output indicates that the first argument is
     implicit. -/

end implicits

/- Section 2.9 output
                ident : ?M_1 → ?M_1
                ident a : α
                ident b : β
                id : Π {α : Sort u_1}, α → α
                id : α → α
                id : β → β
                id a : α
                id b : β
-/


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import number_theory.padics.padic_numbers
import ring_theory.valuation.integers
import topology.metric_space.cau_seq_filter
import topology.algebra.valued_field
import spectral_norm_unique
import normed_valued

/-!
# The `p`-adic complex numbers.

In this file we define the field `ℂ_[p]` of `p`-adic complex numbers and we give it both a normed
field and a valued field structure, induced by the unique extension of the `p`-adic norm to `ℂ_[p]`.

## Main Definitions

* `padic_complex` : the type of `p`-adic complex numbers.
* `padic_complex_integers` : the ring of integers of `ℂ_[p]`.

## Main Results

* `padic_complex.norm_extends` : the norm on `ℂ_[p]` extends the norm on `Q_p_alg p`, and hence
  the norm on `ℚ_[p]`.
* `padic_complex.is_nonarchimedean` : The norm on `ℂ_[p]` is nonarchimedean.

## Notation

We introduce the notation `ℂ_[p]` for the `p`-adic complex numbers, and `𝓞_ℂ_[p]` for its ring of
integers.

## Tags

p-adic, p adic, padic, norm, valuation, cauchy, completion, p-adic completion
-/

noncomputable theory

open rank_one_valuation

open_locale nnreal

variables (p : ℕ) [fact (nat.prime p)]

/-- `Q_p_alg p` is the algebraic closure of `ℚ_[p]`. -/
@[reducible] def Q_p_alg : Type* := algebraic_closure ℚ_[p]

/-- `Q_p_alg p` is an algebraic extension of `ℚ_[p]`. -/
lemma Q_p_alg.is_algebraic : algebra.is_algebraic ℚ_[p] (Q_p_alg p) :=
algebraic_closure.is_algebraic _

instance : has_coe ℚ_[p] (Q_p_alg p) := ⟨algebra_map ℚ_[p] (Q_p_alg p)⟩

protected lemma coe_eq : (coe : ℚ_[p] → (Q_p_alg p)) = algebra_map ℚ_[p] (Q_p_alg p) := rfl

namespace Q_p_alg

/-- `Q_p_alg p` is a normed field, where the norm is the `p`-adic norm, that is, the spectral norm
induced by the `p`-adic norm on `ℚ_[p]`. -/
instance normed_field : normed_field (Q_p_alg p) :=
@spectral_norm_to_normed_field ℚ_[p] _ _ _ _ padic.complete_space (Q_p_alg.is_algebraic p)
  padic_norm_e.nonarchimedean

/-- The norm on `Q_p_alg p` is nonarchimedean. -/
lemma is_nonarchimedean : is_nonarchimedean (norm : (Q_p_alg p) → ℝ) :=
spectral_norm_is_nonarchimedean (Q_p_alg.is_algebraic p) (padic_norm_e.nonarchimedean)

/-- The norm on `Q_p_alg p` is the spectral norm induced by the `p`-adic norm on `ℚ_[p]`. -/
lemma norm_def (x : Q_p_alg p) : ‖ x ‖ = spectral_norm ℚ_[p] (Q_p_alg p) x := rfl

/-- The norm on `Q_p_alg p` extends the `p`-adic norm on `ℚ_[p]`. -/
lemma Q_p.norm_extends (x : ℚ_[p]) : ‖ (x : Q_p_alg p) ‖ = ‖ x ‖ :=
spectral_alg_norm_extends (Q_p_alg.is_algebraic p) _ (padic_norm_e.nonarchimedean)

/-- `Q_p_alg p` is a valued field, with the valuation corresponding to the `p`-adic norm. -/
instance valued_field : valued (Q_p_alg p) ℝ≥0 :=
normed_field.to_valued (Q_p_alg.is_nonarchimedean p)

/-- The valuation of `x : Q_p_alg p` agrees with its `ℝ≥0`-valued norm. -/
lemma v_def (x : Q_p_alg p) : valued.v x = ‖ x ‖₊ := rfl

/-- The coercion of the valuation of `x : Q_p_alg p` to `ℝ` agrees with its norm. -/
lemma v_def_coe (x : Q_p_alg p) :
  ((valued.v x : ℝ≥0) : ℝ) = spectral_norm ℚ_[p] (Q_p_alg p) x := rfl

/-- The valuation of `p : Q_p_alg p` is `1/p`. -/
lemma valuation_p (p : ℕ) [fact p.prime] : valued.v (p : Q_p_alg p) = 1/(p : ℝ≥0) :=
begin
  rw [← map_nat_cast (algebra_map  ℚ_[p] (Q_p_alg p)), ← coe_eq],
  ext,
  rw [v_def_coe, coe_eq, spectral_norm_extends,padic_norm_e.norm_p, one_div, nonneg.coe_inv,
    nnreal.coe_nat_cast],
end

end Q_p_alg

/-- `ℂ_[p]` is the field of `p`-adic complex numbers, that is, the completion of `Q_p_alg p` with
respect to the `p`-adic norm. -/
def padic_complex := uniform_space.completion (Q_p_alg p)

notation `ℂ_[`p`]` := padic_complex p

namespace padic_complex

/-- The `p`-adic complex numbers have a field structure. -/
instance : field ℂ_[p] := uniform_space.completion.field

/-- The `p`-adic complex numbers are inhabited. -/
instance : inhabited ℂ_[p] := ⟨0⟩

/-- `ℂ_[p]` is a valued field, where the valuation is the one extending that on `Q_p_alg p`. -/
instance valued_field : valued (ℂ_[p]) ℝ≥0 := valued.valued_completion

/-- `ℂ_[p]` is a complete space. -/
instance complete_space : complete_space (ℂ_[p]) := uniform_space.completion.complete_space _

instance : has_coe_t (Q_p_alg p) ℂ_[p] := uniform_space.completion.has_coe_t _

/-- The valuation on `ℂ_[p]` extends the valuation on `Q_p_alg p`. -/
lemma valuation_extends (x : Q_p_alg p) : valued.v (x : ℂ_[p]) = valued.v x :=
valued.extension_extends _

/-- `ℂ_[p]` is an algebra over `Q_p_alg p`. -/
instance : algebra (Q_p_alg p) ℂ_[p] := uniform_space.completion.algebra' _

lemma coe_eq : (coe : (Q_p_alg p) → ℂ_[p]) = algebra_map (Q_p_alg p) ℂ_[p] := rfl

lemma coe_zero : ((0 : Q_p_alg p) : ℂ_[p]) = 0 := rfl

/-- The valuation of `p : ℂ_[p]` is `1/p`. -/
lemma valuation_p (p : ℕ) [fact p.prime] : valued.v (p : ℂ_[p]) = 1/(p : ℝ≥0) :=
by rw [← map_nat_cast (algebra_map _ _), ← coe_eq, valuation_extends, Q_p_alg.valuation_p]

/-- The valuation on `ℂ_[p]` has rank one. -/
instance : is_rank_one (padic_complex.valued_field p).v :=
{ hom := monoid_with_zero_hom.id ℝ≥0,
  strict_mono := strict_mono_id,
  nontrivial  :=
  begin
    use p,
    haveI hp : nat.prime p := _inst_1.elim,
    simp only [valuation_p, one_div, ne.def, inv_eq_zero, nat.cast_eq_zero,
      inv_eq_one, nat.cast_eq_one],
    exact ⟨hp.ne_zero, hp.ne_one⟩,
  end }

/-- `ℂ_[p]` is a normed field, where the norm corresponds to the extension of the `p`-adic
  valuation.-/
instance : normed_field ℂ_[p] := valued_field.to_normed_field

/-- The norm on `ℂ_[p]` agrees with the valuation. -/
lemma norm_def : (norm : ℂ_[p] → ℝ) = rank_one_valuation.norm_def := rfl

/-- The norm on `ℂ_[p]` extends the norm on `Q_p_alg p`. -/
lemma norm_extends (x : Q_p_alg p) : ‖ (x : ℂ_[p]) ‖ = ‖ x ‖ :=
begin
  by_cases hx : x = 0,
  { rw [hx, coe_zero, norm_zero, norm_zero] },
  { simp only [norm_def, rank_one_valuation.norm_def, valuation_extends,
      monoid_with_zero_hom.coe_mk],
    refl }
end

/-- The `ℝ≥0`-valued norm on `ℂ_[p]` extends that on `Q_p_alg p`. -/
lemma nnnorm_extends (x : Q_p_alg p) : ‖ (x : ℂ_[p]) ‖₊ = ‖ x ‖₊ :=
by { ext, exact norm_extends p x }

/-- The norm on `ℂ_[p]` is nonarchimedean. -/
lemma is_nonarchimedean : is_nonarchimedean (norm : ℂ_[p] → ℝ) :=
begin
  intros x y,
  apply uniform_space.completion.induction_on₂ x y,
  { exact is_closed_le (continuous.comp continuous_norm continuous_add) (continuous.max
      (continuous.comp (@continuous_norm ℂ_[p] _) (continuous.fst continuous_id))
      (continuous.comp (@continuous_norm ℂ_[p] _) (continuous.snd continuous_id))) },
  { intros a b,
    simp only [← uniform_space.completion.coe_add, norm_extends],
    exact Q_p_alg.is_nonarchimedean p a b }
end

end padic_complex

/-- We define `𝓞_ℂ_[p]` as the subring elements of `ℂ_[p]` with valuation `≤ 1`. -/
def padic_complex_integers : subring ℂ_[p] := (padic_complex.valued_field p).v.integer

notation `𝓞_ℂ_[`p`]` := padic_complex_integers p

/-- `𝓞_ℂ_[p]` is the ring of integers of `ℂ_[p]`. -/
lemma padic_complex.integers : valuation.integers (padic_complex.valued_field p).v  𝓞_ℂ_[p] :=
valuation.integer.integers _


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov

! This file was ported from Lean 3 source module order.monotone.extension
! leanprover-community/mathlib commit 422e70f7ce183d2900c586a8cda8381e788a0c62
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.ConditionallyCompleteLattice.Basic

/-!
# Extension of a monotone function from a set to the whole space

In this file we prove that if a function is monotone and is bounded on a set `s`, then it admits a
monotone extension to the whole space.
-/

open Set

variable {α β : Type _} [LinearOrder α] [ConditionallyCompleteLinearOrder β] {f : α → β} {s : Set α}
  {a b : α}

/-- If a function is monotone and is bounded on a set `s`, then it admits a monotone extension to
the whole space. -/
theorem MonotoneOn.exists_monotone_extension (h : MonotoneOn f s) (hl : BddBelow (f '' s))
    (hu : BddAbove (f '' s)) : ∃ g : α → β, Monotone g ∧ EqOn f g s := by
  classical
    /- The extension is defined by `f x = f a` for `x ≤ a`, and `f x` is the supremum of the values
      of `f`  to the left of `x` for `x ≥ a`. -/
    rcases hl with ⟨a, ha⟩
    have hu' : ∀ x, BddAbove (f '' (Iic x ∩ s)) := fun x =>
      hu.mono (image_subset _ (inter_subset_right _ _))
    let g : α → β := fun x => if Disjoint (Iic x) s then a else supₛ (f '' (Iic x ∩ s))
    have hgs : EqOn f g s := by
      intro x hx
      simp only []
      have : IsGreatest (Iic x ∩ s) x := ⟨⟨right_mem_Iic, hx⟩, fun y hy => hy.1⟩
      rw [if_neg this.nonempty.not_disjoint,
        ((h.mono <| inter_subset_right _ _).map_isGreatest this).csupₛ_eq]
    refine' ⟨g, fun x y hxy => _, hgs⟩
    by_cases hx : Disjoint (Iic x) s <;> by_cases hy : Disjoint (Iic y) s <;>
      simp only [if_pos, if_neg, not_false_iff, *, refl]
    · rcases not_disjoint_iff_nonempty_inter.1 hy with ⟨z, hz⟩
      exact le_csupₛ_of_le (hu' _) (mem_image_of_mem _ hz) (ha <| mem_image_of_mem _ hz.2)
    · exact (hx <| hy.mono_left <| Iic_subset_Iic.2 hxy).elim
    · rw [not_disjoint_iff_nonempty_inter] at hx hy
      refine' csupₛ_le_csupₛ (hu' _) (hx.image _) (image_subset _ _)
      exact inter_subset_inter_left _ (Iic_subset_Iic.2 hxy)
#align monotone_on.exists_monotone_extension MonotoneOn.exists_monotone_extension

/-- If a function is antitone and is bounded on a set `s`, then it admits an antitone extension to
the whole space. -/
theorem AntitoneOn.exists_antitone_extension (h : AntitoneOn f s) (hl : BddBelow (f '' s))
    (hu : BddAbove (f '' s)) : ∃ g : α → β, Antitone g ∧ EqOn f g s :=
  h.dual_right.exists_monotone_extension hu hl
#align antitone_on.exists_antitone_extension AntitoneOn.exists_antitone_extension


-- Church numerals

-- Another way of doing nat.

-- The church nat, chℕ (happy to change the name) is a pi type
-- and not a structure. So proofs are not done by induction!
--import data.equiv

def chℕ := Π X : Type, (X → X) → X → X
namespace chnat

open nat
-- map from normal nats
def of_nat : ℕ → chℕ
| 0 := λ X f x, x
| (succ n) := λ X f x, f (of_nat n X f x)
-- can I close nat now?

-- examples of chnats
def c0 := of_nat 0
def c1 := of_nat 1
def c2 := of_nat 2
def c3 := of_nat 3

-- now we have some constants.

-- what is zero?
example (X f x) : c0 X f x = x := rfl
-- what is one?
example (X f x) : c1 X f x = f x := rfl
-- what is two?
example (X f x) : c2 X f x = f (f x) := rfl
-- what is three?
example (X f x) : c3 X f x = f (f (f x)) := rfl
-- and so on

-- we can go back from chℕ to ℕ
definition to_nat : chℕ → ℕ := λ m, m ℕ nat.succ 0 -- there is a beauty here
-- it is almost as if the structure ℕ were built to be fed into chℕ
-- Why does this happen? KB doesn't understand

-- that definition needs to be moved if we can't prove functoriality wrt succ

example : to_nat c3 = 3 := rfl

-- exercise: define succ
def succ :chℕ → chℕ := λ n X f x, f (n X f x) -- KB can do this one
-- no notation

--unit tests -- KB can pass these
example : succ c0 = c1 := rfl
example : succ c2 = c3 := rfl

example (n : ℕ) : of_nat (nat.succ n) = succ (of_nat n) := rfl

--KB can't do this one. Is it unprovable? If so, move definition of to_nat much further down.
example (m : chℕ) : to_nat (succ m) = nat.succ (to_nat m) := rfl
--Kenny can do this one, lol.

-- exercise : define add
def add : chℕ → chℕ → chℕ := λ m n X f x, n X f (m X f x) -- KB can do this
instance : has_add chℕ := ⟨add⟩ -- now we have + notation

example : c2 + c1 = c3 := rfl
-- KB didn't do this one yet but feels it should be true.
theorem of_nat.add (m n : ℕ) : of_nat (m + n) = of_nat m + of_nat n :=
begin
  induction n with n ih,
  { refl },
  { simp [of_nat, ih], simp [(+), add] }
end

-- exercise : define mul
def mul : chℕ → chℕ → chℕ := λ m n X f, n X (m X f) -- KB can do this
instance : has_mul chℕ := ⟨mul⟩ -- incantation to give us *

-- KB can do this one
example : c1 + c2 + c3 = c2 * c3 := rfl
-- KB didn't try this one
theorem of_nat.mul (m n : ℕ) : of_nat (m * n) = of_nat m * of_nat n :=
begin
  induction n with n ih,
  { refl },
  { rw nat.mul_comm at ih,
    rw [nat.mul_succ, nat.mul_comm, of_nat.add, of_nat, ih],
    dsimp [(*), mul, (+), add],
    refl }
end

-- exercise : define pow
def pow : chℕ → chℕ → chℕ := λ m n X, n (X → X) (m X) -- KB can do this one
-- instance : has_pow chℕ := ⟨pow⟩ -- doesn't seem to work

-- KB can do this
example : pow c2 c3 + c1 = pow c3 c2 := rfl
-- KB didn't try this
example (m n : ℕ) : of_nat (nat.pow m n) = pow (of_nat m) (of_nat n) :=
begin
  induction n with n ih,
  { refl },
  { unfold nat.pow,
    unfold of_nat,
    rw [of_nat.mul, ih],
    unfold pow,
    dsimp [(*), mul],
    refl }
end

-- exercise : define Ackermann
def ack : chℕ → chℕ → chℕ :=
λ m n X, m ((((X → X) → (X → X)) → (X → X) → (X → X)) → ((X → X) → X → X))
  (λ m_ih n f, n
    (λ n_ih x, m_ih sorry f x) -- n_ih represents f
-- composed with itself Ack(m,n) times, but I need
-- to convert it to a church numeral in "sorry".
    (λ x, m_ih id f x))
  (λ n f, n
    (λ n_ih x, f (n_ih x))
    (λ x, f x))
  (n (X → X)) -- KB didn't try this one
-- Is it possible?
-- Kenny : I don't think it is possible, since you need to
-- recursively build a Type 1 function, whereas chℕ only
-- permits recursion on Type 0 stuff.

-- if it's possible, prove it agrees with usual ackermnann
-- example : ack m n = ack (of_nat m) (of_nat n) := sorry

-- question : Is this provable? KB couldn't do this one
theorem add_comm (m n : chℕ) : m + n = n + m := sorry

-- KB thinks this might be chℕ's free theorem
-- KB can't prove it
theorem free_chnat : ∀ (A B : Type), ∀ f : A → B,
∀ r : chℕ, ∀ a : A, r (A → B) (λ g,f) f a  = r (A → B) (λ g,g) f a
 := sorry

structure equiv' (α : Sort*) (β : Sort*) :=
(to_fun    : α → β)
(inv_fun   : β → α)
(left_inv  : ∀ (x : α), inv_fun (to_fun x) = x)
(right_inv : ∀ (y : β), to_fun (inv_fun y) = y)

-- is ℕ equiv to chℕ ?

theorem ij : ∀ n : ℕ, to_nat (of_nat n) = n := begin
intro n,
induction n with d Hd,refl,
unfold of_nat,
unfold to_nat,
unfold to_nat at Hd,
rw Hd,
end

-- KB can't do this one
theorem ji : ∀ c : chℕ, of_nat (to_nat c) = c := sorry
-- Can someone write down an uncomputable counterexample?

-- so KB can't do this either
definition ℕ_is_chℕ : equiv' ℕ chℕ := sorry

-- idle question
theorem is_it_true (X : Type) (f : X → X) (x : X) : f x = x := sorry

end chnat


import tools.super .card
open classical nat function set tactic

section
-- some facts about sets in the old library

parameter {X : Type}

-- theorem ext {a b : set X} (H : ∀x, x ∈ a ↔ x ∈ b) : a = b := funext (λ x, propext (H x))

-- theorem not_mem_empty (x : X) : ¬ (x ∈ (∅ : set X)) := λ H, H

-- theorem eq_empty_of_forall_not_mem {s : set X} (H : ∀ x, x ∉ s) : s = ∅ :=
-- set.ext (λ x, iff.intro (λ xs, absurd xs (H x)) (λ xe, absurd xe (set.not_mem_empty _)))

-- theorem exists_mem_of_ne_empty {s : set X} (H : s ≠ ∅) : ∃ x, x ∈ s :=
-- by_contradiction (λ H', H (eq_empty_of_forall_not_mem (forall_not_of_not_exists H')))

end

section
-- the least number principle.

def complete_induction_on (n : ℕ) {p : ℕ → Prop} (h : ∀ n, (∀ m < n, p m) → p n) : p n :=
suffices ∀ n, ∀ m < n, p m, from this (succ n) _ (lt_succ_self n),
take n,
nat.rec_on n
  (take m, suppose m < 0, absurd this (not_lt_zero m))
  (take n,
    assume ih : ∀ m < n, p m,
    take m,
    suppose m < succ n,
    or.elim (lt_or_eq_of_le (le_of_lt_succ this))
      (ih m)
      (suppose m = n,
        begin rw this, apply h, exact ih end))

lemma wf_aux {A : set ℕ} (n : ℕ) : n ∈ A → ∃ a, a ∈ A ∧ ∀ b,  b ∈  A → a ≤ b :=
@complete_induction_on n (λ x, x ∈ A → ∃ a, a ∈  A ∧ ∀ b, b ∈ A → a ≤ b)
(λ k ih h, by_cases
(suppose ∃ m, m ∈ A ∧ m <k, let ⟨m, Hmem, Hlt⟩ := this in ih m Hlt Hmem)
(λ Hn, have ∀ m, m ∈  A →  ¬ m < k, by super, ⟨k,h,(λ m h, le_of_not_gt $ this m h)⟩))

theorem wf_of_le (S : set ℕ) (H : S ≠ ∅) : ∃ a, a ∈ S ∧ ∀ b, b ∈ S → a ≤ b :=
let ⟨n,Hn⟩ := exists_mem_of_ne_empty H in wf_aux n Hn

noncomputable definition least (S : set ℕ) (H : S ≠ ∅) : ℕ := some (wf_of_le S H)

theorem least_is_mem (S : set ℕ) (H : S ≠ ∅) : least S H ∈ S :=
let ⟨bound, Ha⟩ := some_spec (wf_of_le S H) in bound

theorem minimality {S : set ℕ} (neq : S ≠ ∅): ∀ x, x ∈ S → least S neq ≤ x :=
λ x Hx, let ⟨bound, Ha⟩ := some_spec (wf_of_le S neq) in Ha x Hx

end

lemma nonzero_card_of_finite {A : Type} {S : set A} (H : card S ≠ 0) : finite S :=
by_contradiction
(suppose ¬ finite S,
have card S = 0, from card_of_not_finite this,
H this)

lemma mem_not_in_diff {A : Type} {S : set A} {a : A} : a ∉ S \ insert a (∅ : set A) :=
assume h,
have a ∉ insert a (∅ : set A), from not_mem_of_mem_diff h,
this (mem_singleton a)

lemma insert_of_diff_singleton {A : Type} {S : set A} {a : A} (H : a ∈ S) : insert a (S \ insert a (∅ : set A)) = S :=
begin
apply eq_of_subset_of_subset,
intros x h, apply or.elim h, intro h1, simp [H, h1], -- simp,
intro hr, apply and.left hr,
intros x h', cases (decidable.em (x ∈ insert a (∅ : set A))),
apply or.inl, apply eq_of_mem_singleton, assumption,
apply or.inr, apply and.intro, repeat {assumption}
end

-- lemma union_of_diff_singleton {A : Type} {S : set A} {a : A} (H : a ∈ S)
--   : S \ (insert a (∅ : set A)) ∪ (insert a (∅ : set A)) = S :=
-- begin
-- apply eq_of_subset_of_subset,
--   intros x h, apply or.elim h, intro hl, apply and.left hl,
--   intro hr, have h : x = a, from (mem_singleton_iff x a)^.mp hr,
--   rewrite h, simp,
--   intros x h', cases (decidable.em (x ∈ insert a (∅ : set A))),
--   apply or.inr, simp, apply or.inl, apply and.intro, repeat {simp}
-- end

-- lemma finite_singleton {A : Type} {a : A} : finite '{a} :=
-- have carda : card '{a} = 1, from card_singleton a,
-- have (1:ℕ) ≠ 0, from dec_trivial,
-- have card '{a} ≠ 0, by+ rewrite -carda at this;exact this,
-- nonzero_card_of_finite this

-- lemma sub_of_eq {A : Type} {S T: set A} (H : S = T) : S ⊆ T :=
-- have T ⊆ T, from subset.refl T,
-- by+ rewrite -H at this{1};exact this

-- theorem ne_empty_of_mem' {X : Type} {s : set X} {x : X} (H : x ∈ s) : s ≠ ∅ :=
-- begin intro Hs, rewrite Hs at H, apply not_mem_empty _ H end --this is on github


/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Linear

namespace Nat

theorem nextPowerOfTwo_dec {n power : Nat} (h₁ : power > 0) (h₂ : power < n) : n - power * 2 < n - power := by
  have : power * 2 = power + power := by simp_arith
  rw [this, Nat.sub_add_eq]
  exact Nat.sub_lt (Nat.zero_lt_sub_of_lt h₂) h₁

def nextPowerOfTwo (n : Nat) : Nat :=
  go 1 (by decide)
where
  go (power : Nat) (h : power > 0) : Nat :=
    if power < n then
      go (power * 2) (Nat.mul_pos h (by decide))
    else
      power
termination_by go p h => n - p
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption

def isPowerOfTwo (n : Nat) := ∃ k, n = 2 ^ k

theorem one_isPowerOfTwo : isPowerOfTwo 1 :=
  ⟨0, by decide⟩

theorem mul2_isPowerOfTwo_of_isPowerOfTwo (h : isPowerOfTwo n) : isPowerOfTwo (n * 2) :=
  have ⟨k, h⟩ := h
  ⟨k+1, by simp [h, Nat.pow_succ]⟩

theorem pos_of_isPowerOfTwo (h : isPowerOfTwo n) : n > 0 := by
  have ⟨k, h⟩ := h
  rw [h]
  apply Nat.pos_pow_of_pos
  decide

theorem isPowerOfTwo_nextPowerOfTwo (n : Nat) : n.nextPowerOfTwo.isPowerOfTwo := by
  apply isPowerOfTwo_go
  apply one_isPowerOfTwo
where
  isPowerOfTwo_go (power : Nat) (h₁ : power > 0) (h₂ : power.isPowerOfTwo) : (nextPowerOfTwo.go n power h₁).isPowerOfTwo := by
    unfold nextPowerOfTwo.go
    split
    . exact isPowerOfTwo_go (power*2) (Nat.mul_pos h₁ (by decide)) (Nat.mul2_isPowerOfTwo_of_isPowerOfTwo h₂)
    . assumption
termination_by isPowerOfTwo_go p _ _ => n - p
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption

end Nat