import MyNat.Definition
namespace MyNat
open MyNat
/-!

# Tutorial world

## Level 3: Peano's axioms.

The import above gives us the type `MyNat` of natural numbers. But it also gives us some other things,
which we'll take a look at now:

- a term `(0 : MyNat)`, interpreted as the `MyNat.zero`.
- a function `succ : MyNat → MyNat`, with `succ n` interpreted as "the number after n", or the successor of `n`.
- The principle of mathematical induction.

These axioms are essentially the axioms isolated by Peano which uniquely characterize the natural
numbers (you also need recursion, but you can ignore it for now). The first axiom says that 0 is a
natural number. The second says that there is a `succ` function which eats a number and spits out the
number after it, so `succ 0 = 1`, `succ 1 = 2`, and so on.

Peano's last axiom is the principle of mathematical induction. This is a deeper fact. It says that
if you have infinitely many true/false statements `P(0)`, `P(1)`, `P(2)`, and so on, and if
`P(0)` is true, and if for every natural number `d` you know that `P(d)` implies `P(succ d)`, then
`P(n)` must be true for every natural number `n`.
It's like saying that if you have a long line of dominoes, and if you knock the first one down, and
if you know that if a domino falls down then the one after it will fall down too, then you can
deduce that all the dominos will fall down. You can also think of it as saying that every natural
number can be built by starting at 0 and then applying `succ` a finite number of times.

Peano's insights were firstly that these axioms completely characterise the natural numbers, and
secondly that these axioms alone can be used to build a whole bunch of other structure on the
natural numbers, for example addition, multiplication and so on.

This world is all about seeing how far these axioms of Peano can take us.

Let's practice your use of the `rewrite` tactic in the following example. The hypothesis `h` is a proof that
`succ a = b` and you want to prove that `succ (succ a) = succ b`. In words, you're going to prove that if
`b` is the number after `a` then `succ b` is the number after `succ a`. Now here's a tricky question. If
your goal is `⊢ succ (succ a) = succ b`, and your hypothesis is `h : succ a = b`, then what will the goal
change to when we type `rewrite [h]`?

## Lemma

If `succ a = b`, then `succ (succ a) = succ b`.
-/

lemma example3 (a b : MyNat) (h : (succ a) = b) : succ (succ a) = succ b := by
  rewrite [h]
  rfl

/-!

Remember that `rewrite [h]` will look for the left hand side of `h` in the goal, and will replace it with
the right hand side. Try and figure out how the goal will change, and then try it.

The answer: Lean changed `succ a` into `b`, so the goal became `succ b = succ b`. That goal is of
the form `X = X`, so you can complete prove the proof using `rfl` which `rw` does for you.

Important note : the tactic `rewrite` expects a proof afterwards (e.g. `rewrite [h1]`).
But `rfl` is just `rfl`.

You may be wondering whether you could have just substituted in the definition of `b` and proved the
goal that way. To do that, you would want to replace the right hand side of `h` with the left hand
side. You do this in Lean by writing `rw [← h]`. You get the left-arrow by typing `\l` and then a space;
note that this is a small letter `L`, not a number `1`. You can just edit your proof and try it.

You may also be wondering why we keep writing `succ b` instead of `b + 1`. This is because we haven't
defined addition yet! On the next level, the final level of Tutorial World, we will introduce
addition, and then you'll be ready to enter Addition World.

Now you are ready for [Level4.lean](./Level4.lean.md).
-/


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