import data.real.basic

/-
One of the earliest kind of proofs one encounters while learning mathematics is proving by
a calculation. It may not sound like a proof, but this is actually using lemmas expressing
properties of operations on numbers. It also uses the fundamental property of equality: if two
mathematical objects A and B are equal then, in any statement involving A, one can replace A
by B. This operation is called rewriting, and the Lean "tactic" for this is `rw`.

In the following exercises, we will use the following two lemmas:
  mul_assoc a b c : a * b * c = a * (b * c)
  mul_comm a b : a*b = b*a

Hence the command
  rw mul_assoc a b c,
will replace a*b*c by a*(b*c) in the current goal.

In order to replace backward, we use
  rw ← mul_assoc a b c,
replacing a*(b*c) by a*b*c in the current goal.

Of course we don't want to constantly invoke those lemmas, and we will eventually introduce
more powerful solutions.
-/

-- Uncomment the following line if you want to see parentheses around subexpressions.
-- set_option pp.parens true

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc b a c,
end

-- 0001
example (a b c : ℝ) : (c * b) * a = b * (a * c) :=
begin
  rw mul_comm,
  rw ← mul_assoc,
  rw mul_comm,
  -- `finish,` -- slow
  -- `ring,` -- Finish him!
end

-- 0002
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ← mul_assoc,
  rw ← mul_assoc,
  rw mul_comm a b,
end

/-
Now let's return to the preceding example to experiment with what happens
if we don't give arguments to mul_assoc or mul_comm.
For instance, you can start the next proof with
  rw ← mul_assoc,
Try to figure out what happens.
-/

-- 0003
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  sorry -- already did that
end

/-
We can also perform rewriting in an assumption of the local context, using for instance
  rw mul_comm a b at hyp,
in order to replace a*b by b*a in assumption hyp.

The next example will use a third lemma:
  two_mul a : 2*a = a + a

Also we use the `exact` tactic, which allows to provide a direct proof term.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  rw hyp' at hyp,
  rw mul_comm d a at hyp,
  rw ← two_mul (a*d) at hyp,
  rw ← mul_assoc 2 a d at hyp,
  exact hyp, -- Our assumption hyp is now exactly what we have to prove
end

/-
And the next one can use:
  sub_self x : x - x = 0
-/

-- 0004
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  rw hyp' at hyp,
  rw mul_comm at hyp,
  calc
    c   = a*b - a*b : hyp
    ... = 0 : sub_self (a*b),
end

/-
What is written in the two preceding example is very far away from what we would write on
paper. Let's now see how to get a more natural layout.
Inside each pair of curly braces below, the goal is to prove equality with the preceding line.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b : by { rw hyp }
  ... = d*a + a*d  : by { rw hyp' }
  ... = a*d + a*d  : by { rw mul_comm d a }
  ... = 2*(a*d)    : by { rw two_mul }
  ... = 2*a*d      : by { rw mul_assoc },
end

/-
Let's note there is no comma at the end of each line of calculation. `calc` is really one
command, and the comma comes only after it's fully done.

From a practical point of view, when writing such a proof, it is convenient to:
* pause the tactic state view update in VScode by clicking the Pause icon button
  in the top right corner of the Lean Goal buffer
* write the full calculation, ending each line with ": by {}"
* resume tactic state update by clicking the Play icon button and fill in proofs between
  curly braces.

Let's return to the other example using this method.
-/

-- 0005
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  calc
  c   = b*a - d : hyp
  ... = b*a - a*b : by { rw hyp' }
  -- ... = a*b - a*b : by { rw mul_comm }
  -- ... = 0 : sub_self (a*b), -- Tada!
  ... = 0 : by { rw mul_comm, exact sub_self (a*b)},
end

/-
The preceding proofs have exhausted our supply of "mul_comm" patience. Now it's time
to get the computer to work harder. The `ring` tactic will prove any goal that follows by
applying only the axioms of commutative (semi-)rings, in particular commutativity and
associativity of addition and multiplication, as well as distributivity.

We also note that curly braces are not necessary when we write a single tactic proof, so
let's get rid of them.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b   : by rw hyp
     ... = d*a + a*d : by rw hyp'
     ... = 2*a*d     : by ring,
end

/-
Of course we can use `ring` outside of `calc`. Let's do the next one in one line.
-/

-- 0006
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  by ring,
end

/-
This is too much fun. Let's do it again.
-/

-- 0007
example (a b : ℝ) : (a + b) + a = 2*a + b := by ring

/-
Maybe this is cheating. Let's try to do the next computation without ring.
We could use:
pow_two x : x^2 = x*x
mul_sub a b c : a*(b-c) = a*b - a*c
add_mul a b c : (a+b)*c = a*c + b*c
add_sub a b c : a + (b - c) = (a + b) - c
sub_sub a b c : a - b - c = a - (b + c)
add_zero a : a + 0 = a
-/

-- 0008
example (a b : ℝ) : (a + b)*(a - b) = a^2 - b^2 :=
begin
  calc
  (a + b)*(a - b) = (a + b)*a - (a + b)*b : by rw mul_sub
  ...             = a*a + b*a - a*b - b*b : by { repeat {rw add_mul}, rw sub_sub }
  ...             = a^2 + b*a - a*b - b^2 : by { repeat {rw pow_two }}
  ...             = a^2 - b^2 : by { rw mul_comm, rw ← add_sub,
  rw sub_self, rw add_zero },
end

/- Let's stick to ring in the end. -/


theorem absorb_right_or: ∀(P : Prop), P ∨ true :=
begin
  assume P,
  exact or.inr true.intro
end

theorem absorb_right_or': ∀(P : Prop), P ∨ true :=
  λ(P), or.inr true.intro

theorem absorb_left_or: ∀(P : Prop), true ∨ P :=
begin
  assume P,
  exact or.inl true.intro
end

theorem wet'' :
  ∀(R S W: Prop),
    (R ∨ S) → (R → W) → (S → W) → W :=
begin
  assume R S W,
  assume pf_R_or_S,
  assume pf_R_to_W,
  assume pf_S_to_W,
  exact or.elim pf_R_or_S pf_R_to_W pf_S_to_W,
end

theorem wet''' :
  ∀(R S W: Prop),
    (R ∨ S) → (R → W) → (S → W) → W :=
begin
  assume R S W,
  assume pf_R_or_S,
  assume pf_R_to_W,
  assume pf_S_to_W,
  cases pf_R_or_S with pf_R pf_S,
    -- case R
    exact pf_R_to_W pf_R,
    -- case S
    exact pf_S_to_W pf_S,
end

theorem id_right_or: ∀(P: Prop), P ∨ false ↔ P :=
begin
  assume P,
  split,
    -- P ∨ false → P
    assume pf_P_or_false,
    cases pf_P_or_false with pf_P pf_false,
      -- pf_P
      assumption,
      -- pf_false
      exact false.elim pf_false,
    -- P → P ∨ false
    assume pf_P,
    exact or.inl pf_P,
end

theorem id_left_or: ∀(P: Prop), false ∨ P ↔ P :=
begin
  assume P,
  split,
    -- false ∨ P → P
    assume pf_false_or_P,
    cases pf_false_or_P with pf_false pf_P,
      -- pf_false
      exact false.elim pf_false,
      -- pf_P
      assumption,
    -- P → false ∨ P
    assume pf_P,
    exact or.intro_right false pf_P,
end

theorem disjunctiveSyllogism:
  ∀(P Q: Prop), P ∨ Q → ¬Q → P :=
begin
  assume P Q,
  assume pfPOrQ,
  assume pfNotQ,
  cases pfPOrQ with pfP pfQ, -- now by cases
    assumption, -- case where p is true,
    exact false.elim (pfNotQ pfQ), -- or q true
end

axiom em: ∀(P: Prop), P ∨ ¬P

theorem DeMorganOne: ∀(P Q: Prop), ¬(P ∨ Q) ↔ ¬P ∧ ¬Q :=
begin
  assume P Q,
  split,
    -- ¬(P ∨ Q) → ¬P ∧ ¬Q
    assume pf_not__P_or_Q,
    split,
      -- prove ¬P
      cases (em P) with pf_P pf_not_P,
        -- pf_P
        have pf_P_or_Q: P ∨ Q := or.inl pf_P,
        exact false.elim (pf_not__P_or_Q pf_P_or_Q),
        -- pf_not_P
        assumption,
      -- prove ¬Q
      cases (em Q) with pf_Q pf_not_Q,
        -- pf_Q
        have pf_P_or_Q: P ∨ Q := or.inr pf_Q,
        exact false.elim (pf_not__P_or_Q pf_P_or_Q),
        -- pf_not_Q,
        assumption,
    -- ¬P ∧ ¬Q → ¬(P ∨ Q)
    assume pf_not_P_and_not_Q,
    assume pf_P_or_Q,
    cases pf_P_or_Q with pf_P pf_Q,
      -- pf_P
      have pf_not_P: ¬P := pf_not_P_and_not_Q.left,
      exact pf_not_P pf_P,
      -- pf_Q
      have pf_not_Q: ¬Q := pf_not_P_and_not_Q.right,
      exact pf_not_Q pf_Q,
end

theorem DeMorganTwo: ∀(P Q: Prop), ¬(P ∧ Q) ↔ ¬P ∨ ¬Q :=
begin
  assume P Q,
  split,
    -- ¬(P ∧ Q) → ¬P ∨ ¬Q
    assume pf_not__P_and_Q,
    cases (em P) with pf_P pf_not_P,
      -- pf_P
      cases (em Q) with pf_Q pf_not_Q,
        -- pf_Q
        have pf_P_and_Q := and.intro pf_P pf_Q,
        exact false.elim (pf_not__P_and_Q pf_P_and_Q),
        -- pf_not_Q
        exact or.inr pf_not_Q,
      -- pf_not_P
      exact or.inl pf_not_P,
    -- ¬P ∨ ¬Q → ¬(P ∧ Q)
    assume pf_not_P_or_not_Q,
    assume pf_P_and_Q,
    cases pf_not_P_or_not_Q with pf_not_P pf_not_Q,
      -- pf_not_P
      have pf_P := pf_P_and_Q.left,
      exact pf_not_P pf_P,
      -- pf_not_Q
      have pf_Q := pf_P_and_Q.right,
      exact pf_not_Q pf_Q,
end

-- Is disjunction reflexive?
-- Is A ∨ A true?
-- No
example: ¬∀(A: Prop), A ∨ A :=
begin
  assume pf_forall,
  have pf_false_or_false := pf_forall false,
  cases pf_false_or_false,
    assumption, assumption,
end

-- Is disjunction symmetric?
-- Does A ∨ B imply B ∨ A?
example: ∀(A B: Prop),
  (A ∨ B) → (B ∨ A) :=
begin
  assume A B,
  assume pf_A_or_B,
  cases pf_A_or_B with pf_A pf_B,
    exact or.inr pf_A,
    exact or.inl pf_B,
end

-- Is disjunction associative?
-- Are (A ∨ B) ∨ C and A ∨ (B ∨ C) the same?
example: ∀(A B C: Prop),
  (A ∨ B) ∨ C ↔ A ∨ (B ∨ C) :=
begin
  assume A B C,
  split,
    -- (A ∨ B) ∨ C → A ∨ (B ∨ C)
    assume pf_A_or_B__or_C,
    cases pf_A_or_B__or_C with pf_A_or_B pf_C,
      -- pf_A_or_B
      cases pf_A_or_B with pf_A pf_B,
        -- pf_A
        exact or.inl pf_A,
        -- pf_B
        have pf_B_or_C: B ∨ C := or.inl pf_B,
        exact or.inr pf_B_or_C,
      -- pf_C
      have pf_B_or_C: B ∨ C := or.inr pf_C,
      exact or.inr pf_B_or_C,
    -- A ∨ (B ∨ C) → (A ∨ B) ∨ C
    assume pf_A_or__B_or_C,
    cases pf_A_or__B_or_C with pf_A pf_B_or_C,
      -- pf_A
      have pf_A_or_B := or.intro_left B pf_A,
      exact or.inl pf_A_or_B,
      -- pf_B_or_C
      cases pf_B_or_C with pf_B pf_C,
        -- pf_B
        have pf_A_or_B := or.intro_right A pf_B,
        exact or.inl pf_A_or_B,
        -- pf_C
        exact or.inr pf_C,
end

-- Is disjunction transitive?
-- Does (A ∨ B) and (B ∨ C) imply (A ∨ C)?
-- No
example: ¬∀(A B C: Prop),
  (A ∨ B) → (B ∨ C) → (A ∨ C) :=
begin
  assume pf_forall,
  have pf_falseness := pf_forall false true false,
  have pf_f_or_t := or.intro_right false true.intro,
  have pf_t_or_f := or.intro_left false true.intro,
  have pf_f_or_f := (pf_falseness pf_f_or_t) pf_t_or_f,
  cases pf_f_or_f with pf_f pf_f,
    assumption, assumption,
end

-- Distribution over ∧
example: ∀(A B C: Prop),
  A ∨ (B ∧ C) ↔ (A ∨ B) ∧ (A ∨ C) :=
begin
  assume A B C,
  split,
    -- A ∨ (B ∧ C) → (A ∨ B) ∧ (A ∨ C)
    assume pf_A_or__B_and_C,
    cases pf_A_or__B_and_C with pf_A pf_B_and_C,
      -- pf_A
      have pf_A_or_B: A ∨ B := or.inl pf_A,
      have pf_A_or_C := or.intro_left C pf_A,
      exact and.intro pf_A_or_B pf_A_or_C,
      -- pf_B_and_C
      have pf_C := pf_B_and_C.left,
      have pf_A_or_B: A ∨ B := or.inr pf_C,
      have pf_B := pf_B_and_C.right,
      have pf_A_or_C: A ∨ C := or.inr pf_B,
      exact and.intro pf_A_or_B pf_A_or_C,
    -- (A ∨ B) ∧ (A ∨ C) → A ∨ (B ∧ C)
    assume pf_A_or_B__and__A_or_C,
    cases pf_A_or_B__and__A_or_C.left with pf_A pf_B,
      -- pf_A
      exact or.inl pf_A,
      -- pf_B
      cases pf_A_or_B__and__A_or_C.right with pf_A pf_C,
        -- pf_A
        exact or.inl pf_A,
        -- pf_C
        have pf_B_and_C := and.intro pf_B pf_C,
        exact or.inr pf_B_and_C,
end

-- Distribution over ∨
example: ∀(A B C: Prop),
  A ∧ (B ∨ C) ↔ (A ∧ B) ∨ (A ∧ C) :=
begin
  assume A B C,
  split,
    -- A ∧ (B ∨ C) → (A ∧ B) ∨ (A ∧ C)
    assume pf_A__and_B_or_C,
    cases pf_A__and_B_or_C.right with pf_B pf_C,
      -- B
      have pf_A := pf_A__and_B_or_C.left,
      have pf_A_and_B := and.intro pf_A pf_B,
      exact or.inl pf_A_and_B,
      -- C
      have pf_A := pf_A__and_B_or_C.left,
      have pf_A_and_C := and.intro pf_A pf_C,
      exact or.inr pf_A_and_C,
    -- (A ∧ B) ∨ (A ∧ C) → A ∧ (B ∨ C)
    assume pf_A_and_B__or__A_and_C,
    cases pf_A_and_B__or__A_and_C with pf_A_and_B pf_A_and_C,
      -- A ∧ B
      have pf_B := pf_A_and_B.right,
      have pf_B_or_C: B ∨ C := or.inl pf_B,
      have pf_A := pf_A_and_B.left,
      exact and.intro pf_A pf_B_or_C,
      -- A ∧ C
      have pf_C := pf_A_and_C.right,
      have pf_B_or_C: B ∨ C := or.inr pf_C,
      have pf_A := pf_A_and_C.left,
      exact and.intro pf_A pf_B_or_C,
end


/-
Copyright (c) 2022 Flemming Hermansen.
Released under Apache 2.0 license as described in
https://www.apache.org/licenses/LICENSE-2.0
Authors: Flemming Hermansen
-/

import algebra.algebra.basic
import order.boolean_algebra

/-
This file prove that the idempotent elements in a commutative ring
constitute a Boolean algebra.

idempotent_cri (A) [cr : comm_ring A] := { a : A // a * a = a}
subtype that contains all the idempotent elements from A.

instance boolean_algebra_comm_ring_idempotents [comm_ring A] : boolean_algebra (idempotent_cri A)
The main result telling that elements of subtype 'idempotent_cri A'
can be used as elements in a Boolean algebra.

-/

section comm_ring_idempotents

variables  {A : Type*} [comm_ring A]

variables {B : Type*} [boolean_algebra B]

open_locale classical

noncomputable theory

def idempotent_cri (A) [cr : comm_ring A] := { a : A // a * a = a}

namespace idempotent_cri

instance coe_idempotent_cri : has_coe (idempotent_cri (A)) A := ⟨λ (e : idempotent_cri (A)), e.val⟩

instance inhabited_idempotent_cri : inhabited (idempotent_cri A) := ⟨⟨1, mul_one 1⟩⟩

def property' (e : idempotent_cri A) : (↑e : A) * ↑e = ↑e := by exact e.property.

def property'' (e : idempotent_cri A) : (e.val : A) * e.val = e.val := by exact e.property.

@[simp, reducible]
def prop_inf_cri [hr : comm_ring A] (a : idempotent_cri A) (b : idempotent_cri A) :
((a.val : A) * b.val) * (a.val * b.val)  = (a.val * b.val) :=
begin
    simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
    simp only [mul_comm _ b.val,  ← mul_assoc, b.property''], -- idempotent b
    simp only [mul_comm _ a.val,  ← mul_assoc, a.property''], -- idempotent a
end

@[simp, reducible]
def inf_cri [hr : comm_ring A] (a : idempotent_cri A) (b : idempotent_cri A) : idempotent_cri A :=
begin
  exact ⟨ a * b,
  begin
    simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
    simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- idempotent b
    simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- idempotent a
  end ⟩
end

@[simp, reducible]
def sup_cri [hr : comm_ring A] (a : idempotent_cri A) (b : idempotent_cri A) :
idempotent_cri A :=
begin
  exact ⟨ ↑a + ↑b - ↑a * ↑b,
  begin
     simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
    simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- idempotent b
    simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- idempotent a
    ring,
  end ⟩,
end

@[simp, reducible]
def le_cri [hr : comm_ring A] (a : idempotent_cri A) (b : idempotent_cri A) :=
(↑a : A) * ↑b = ↑a

@[simp, reducible]
def lt_cri [hr : comm_ring A] (a : idempotent_cri A) (b : idempotent_cri A) :=
(↑a : A) * ↑b = ↑a ∧ (¬(↑a : A)= ↑b)

@[simp, reducible]
def top_cri [hr : comm_ring A] : idempotent_cri A := ⟨ 1, by ring ⟩

@[simp, reducible]
def bot_cri [hr : comm_ring A] : idempotent_cri A := ⟨ 0, by ring ⟩

@[simp, reducible]
def compl_cri [hr : comm_ring A] (a : idempotent_cri A) : idempotent_cri A :=
 ⟨ 1 - ↑a,
by {simp only [sub_mul, mul_sub, mul_one, one_mul, a.property'], ring} ⟩

@[simp, reducible]
def sdiff_cri [hr : comm_ring A] (a b: idempotent_cri A) : idempotent_cri A :=
begin
  exact ⟨ ↑a - ↑a * ↑b,
  begin
    simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
    simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- idempotent b
    simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- idempotent a
    ring,
  end ⟩,
end

@[simp]
instance has_le_comm_ring_idempotents [comm_ring A] : has_le (idempotent_cri A) :=
{ le := le_cri }

@[simp]
instance has_sup_comm_ring_idempotents [comm_ring A] : has_sup (idempotent_cri A) :=
{ sup := sup_cri }

@[simp]
instance has_inf_comm_ring_idempotents [comm_ring A] : has_inf (idempotent_cri A) :=
{ inf := inf_cri }

@[simp]
instance has_top_comm_ring_idempotents [comm_ring A] : has_top (idempotent_cri A) :=
{ top := top_cri }

@[simp]
instance has_bot_comm_ring_idempotents [comm_ring A] : has_bot (idempotent_cri A) :=
{ bot := bot_cri }

@[simp, reducible]
instance has_compl_comm_ring_idempotents [comm_ring A] : has_compl (idempotent_cri A) :=
{ compl := compl_cri }

@[simp]
instance has_sdiff_comm_ring_idempotents [comm_ring A] : has_sdiff (idempotent_cri A) :=
{ sdiff := sdiff_cri }

lemma sup_assoc_cri [comm_ring A] (a b c: idempotent_cri A) : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) :=
begin
  unfold has_sup.sup, simp, ring_nf,
end

lemma sup_comm_cri [comm_ring A] (a b : idempotent_cri A) : a ⊔ b  = b ⊔ a :=
begin
  unfold has_sup.sup, apply subtype.eq, ring_nf,
end

lemma inf_assoc_cri [comm_ring A] (a b c: idempotent_cri A) : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) :=
begin
  unfold has_inf.inf, apply subtype.eq, simp {proj := tt}, ring,
end

lemma inf_comm_cri [comm_ring A] (a b : idempotent_cri A) : a ⊓ b  = b ⊓ a :=
begin
  unfold has_inf.inf, apply subtype.eq, ring_nf,
end

set_option pp.coercions true.

lemma tt [comm_ring A] (a : idempotent_cri A) : ↑ a = a.val := by refl

lemma sup_inf_self_cri [comm_ring A] (a b : idempotent_cri A) : a ⊔ a ⊓ b = a :=
begin
  unfold has_inf.inf, unfold has_sup.sup,-- apply subtype.eq, --simp {proj := tt},
  rw inf_cri, rw sup_cri, apply subtype.eq, simp  {proj := true},
    simp  only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
      ← mul_assoc], -- flatten expression
    simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- idempotent a
    simp,
end

lemma inf_sup_self_cri [comm_ring A] (a b : idempotent_cri A) : a ⊓ (a ⊔ b) = a :=
begin
  unfold has_inf.inf, unfold has_sup.sup sup_cri, apply subtype.eq, simp {proj := true},
       simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
    simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- idempotent b
    simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- idempotent a
    simp,
end

@[simp]
def inf_sup_le_cri [comm_ring A] (a b c : idempotent_cri A) :
  a ⊓ (b ⊔ c) ≤ a ⊓ b ⊔ a ⊓ c :=
begin
  unfold has_sup.sup has_inf.inf has_le.le inf_cri sup_cri le_cri,
  simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- idempotent b
  simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- idempotent a
  simp only [mul_comm _ ↑c,  ← mul_assoc, c.property'], -- idempotent c
  ring,
end

lemma le_sup_inf_cri [comm_ring A] (a b c : idempotent_cri A) :
(a ⊔ b) ⊓ (a ⊔ c) ≤ a ⊔ b ⊓ c :=
begin
  unfold has_sup.sup has_inf.inf has_le.le inf_cri sup_cri le_cri,
  simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- idempotent b
  simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- idempotent a
  simp only [mul_comm _ ↑c,  ← mul_assoc, c.property'], -- idempotent c
  ring,
end

lemma le_sup_left_cri [comm_ring A] (a b : idempotent_cri A) : a ≤ a ⊔ b :=
begin
  unfold has_sup.sup has_le.le compl_cri sup_cri le_cri,
  simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- sort, reflatten, a * a = a
  ring,
end

lemma sdiff_eq_cri [comm_ring A] (a b : idempotent_cri A) :
a \ b = a ⊓ bᶜ :=
begin
  apply subtype.eq, unfold has_inf.inf has_sdiff.sdiff has_compl.compl compl_cri,
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- sort, reflatten, b * b = b
  simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- sort, reflatten, a * a = a
  ring_nf,
end

lemma top_le_sup_compl_cri [comm_ring A] (a : idempotent_cri A) :
⊤ ≤ a ⊔ aᶜ :=
begin
  unfold has_sup.sup has_compl.compl has_top.top has_le.le compl_cri sup_cri le_cri,
  simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- sort, reflatten, a * a = a
  ring,
end

lemma inf_compl_le_bot_cri [comm_ring A] (a : idempotent_cri A) :
a ⊓ aᶜ ≤ ⊥ :=
begin
  unfold has_inf.inf has_compl.compl has_bot.bot has_le.le compl_cri sup_cri le_cri,
  simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- sort, reflatten, a * a = a
  ring,
end

lemma le_antisym_cri [comm_ring A] (a b : idempotent_cri A) : a ≤ b → b ≤ a → a = b :=
begin
  unfold has_le.le le_cri,
  intros hab hba,
  rw mul_comm at hab, rw hab at hba,
  apply subtype.eq, exact hba,
end

lemma sup_le_cri [comm_ring A] (a b c : idempotent_cri A) : a ≤ c → b ≤ c → a ⊔ b ≤ c :=
begin
  unfold has_le.le has_sup.sup sup_cri le_cri,
  intros hac hbc,
  simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
    mul_assoc], -- flatten expression
  rw hac, rw hbc,
end

lemma le_inf_cri [comm_ring A] (a b c : idempotent_cri A) : a ≤ b → a ≤ c → a ≤ b ⊓ c :=
begin
  unfold has_le.le has_inf.inf, simp only [inf_cri, le_cri],
  intros haba haca,
  simp {proj := true},
  simp only [ ← mul_assoc], -- flatten expression
  rw haba, rw haca,
end

lemma le_top_cri [comm_ring A] (a : idempotent_cri A) : a ≤ ⊤ :=
begin
  unfold has_le.le has_top.top le_cri,
  simp {proj := true},
end

lemma bot_le_cri [comm_ring A] (a : idempotent_cri A) : ⊥ ≤ a :=
begin
  unfold has_le.le has_bot.bot le_cri,
  simp {proj := true},
end

lemma le_sup_right_cri [comm_ring A] (a b : idempotent_cri A) : b ≤ a ⊔ b :=
begin
  unfold has_le.le has_sup.sup le_cri sup_cri,
  simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- sort, reflatten, a * a = a
  ring,
end

lemma inf_inf_sdiff_cri [comm_ring A] (a b : idempotent_cri A) : a ⊓ b ⊓ a \ b = ⊥ :=
begin
  unfold has_inf.inf has_sdiff.sdiff inf_cri sdiff_cri,
  apply subtype.eq, simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- sort, reflatten, b * b = b
  simp only [mul_comm _ ↑a,  ← mul_assoc, b.property'], -- sort, reflatten, a * a = a
  ring_nf,
end

lemma inf_le_left_cri [comm_ring A] (a b : idempotent_cri A) : a ⊓ b ≤ a :=
begin
  unfold has_le.le has_inf.inf inf_cri le_cri,
  simp {proj := true},
  simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- sort, reflatten, a * a = a
end

lemma inf_le_right_cri [comm_ring A] (a b : idempotent_cri A) : a ⊓ b ≤ b :=
begin
  unfold has_le.le has_inf.inf inf_cri le_cri,
  simp {proj := true},
  simp only [mul_assoc, b.property'], -- flatten, b * b = b
end

lemma sup_inf_sdiff_cri [comm_ring A] (a b : idempotent_cri A) : a ⊓ b ⊔ a \ b = a :=
begin
  unfold has_inf.inf has_sup.sup has_sdiff.sdiff sup_cri inf_cri sdiff_cri,
  simp {proj := true},
  simp only [sub_mul, mul_sub, add_mul, mul_add, -- distributative
     ← mul_assoc], -- flatten expression
  simp only [mul_comm _ ↑a,  ← mul_assoc, a.property'], -- sort, reflatten, a * a = a
  simp only [mul_comm _ ↑b,  ← mul_assoc, b.property'], -- sort, reflatten, b * b = b
  simp {proj := true},
end

lemma le_reflexive_cri [comm_ring A] (a : idempotent_cri A) : a ≤ a :=
begin
  unfold has_le.le le_cri, rw a.property',
end

lemma le_trans_cri [comm_ring A] (a b c : idempotent_cri A) : a ≤ b → b ≤ c → a ≤ c :=
begin  unfold has_le.le le_cri, intros h1 h2,
  rw ← h1, rw mul_assoc, rw h2,
end

lemma lt_iff_le_not_le_cri [comm_ring A] (a b : idempotent_cri A) :
  ( a ≤ b ∧ (¬a.val = b.val)) ↔ a ≤ b ∧ ¬b ≤ a :=
  begin unfold has_lt.lt has_le.le le_cri,
    split,
    -- ->
    intros h, cases h with hle hne,
    split, assumption,
    intros b_nle_a,
    simp at hne {proj := true},
    rw ← hle at hne, rw mul_comm at hne,
    contradiction,
    -- <-
    intros h,
    cases h with aleb bnlea,
    split, assumption,
    rw mul_comm at aleb,
    simp {proj := true},
    rw ← aleb,
    intros h_contra,
    rw h_contra at bnlea,
    contradiction,
  end

@[priority 100]  -- see Note [lower instance priority]
instance boolean_algebra_comm_ring_idempotents [comm_ring A] :
boolean_algebra (idempotent_cri A) :=
{ sup := sup_cri,
  le := le_cri,
  lt := lt_cri,
  le_refl :=le_reflexive_cri,
  le_trans := le_trans_cri,
  lt_iff_le_not_le := lt_iff_le_not_le_cri,
  le_antisymm := le_antisym_cri,
  le_sup_left := le_sup_left_cri,
  le_sup_right := le_sup_right_cri,
  sup_le := sup_le_cri,
  inf := inf_cri,
  inf_le_left := inf_le_left_cri,
  inf_le_right := inf_le_right_cri,
  le_inf := le_inf_cri,
  le_sup_inf := le_sup_inf_cri,
  sdiff := sdiff_cri,
  bot := bot_cri,
  -- The following fields have been removed in the latest version of Mathlib
  -- sup_inf_sdiff := sup_inf_sdiff_cri,
  -- inf_inf_sdiff := inf_inf_sdiff_cri,
  compl := compl_cri,
  top := top_cri,
  inf_compl_le_bot := inf_compl_le_bot_cri,
  top_le_sup_compl := top_le_sup_compl_cri,
  le_top := le_top_cri,
  bot_le := bot_le_cri,
  sdiff_eq := sdiff_eq_cri }

@[reducible]
def simp_inf_cri [hr : comm_ring A] (a b : idempotent_cri A) :
(a ⊓ b) = (⟨ a.val * b.val, prop_inf_cri a b ⟩ :  idempotent_cri A) :=
begin
  let ee := (⟨ a.val * b.val, prop_inf_cri a b ⟩ :  idempotent_cri A),
  have inf_eq : (a ⊓ b) = ee, by refl,
  exact inf_eq,
end

lemma bot_of_inf_sdiff_self {B : Type*} [boolean_algebra B] (e e': B)
: e ⊓ (e'\e) = ⊥ :=
begin
  rw sdiff_eq,
  conv { to_lhs, congr, skip, rw inf_comm },
  rw ← inf_assoc, rw inf_compl_eq_bot, rw bot_inf_eq,
end

end idempotent_cri

end comm_ring_idempotents


-- La composición de funciones inyectivas es inyectiva
-- ===================================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar que la composición de dos funciones
-- inyectivas es una función inyectiva.
-- ----------------------------------------------------

import tactic

open function

variables {X Y Z : Type}
variable  {f : X → Y}
variable  {g : Y → Z}

-- 1ª demostración
example
  (Hf : injective f)
  (Hg : injective g)
  : injective (g ∘ f) :=
begin
  intros x y h,
  apply Hf,
  apply Hg,
  exact h,
end

-- 2ª demostración
example
  (Hf : injective f)
  (Hg : injective g)
  : injective (g ∘ f) :=
begin
  intros x y h,
  apply Hf,
  exact Hg h,
end

-- 3ª demostración
example
  (Hf : injective f)
  (Hg : injective g)
  : injective (g ∘ f) :=
begin
  intros x y h,
  exact Hf (Hg h),
end

-- 4ª demostración
example
  (Hf : injective f)
  (Hg : injective g)
  : injective (g ∘ f) :=
λ x y h, Hf (Hg h)

-- 5ª demostración
example
  (Hf : injective f)
  (Hg : injective g)
  : injective (g ∘ f) :=
assume x y,
assume h1 : (g ∘ f) x = (g ∘ f) y,
have h2 : f x = f y, from Hg h1,
show x = y, from Hf h2

-- 6ª demostración
example
  (Hf : injective f)
  (Hg : injective g)
  : injective (g ∘ f) :=
assume x y,
assume h1 : (g ∘ f) x = (g ∘ f) y,
show x = y, from Hf (Hg h1)

-- 7ª demostración
example
  (Hf : injective f)
  (Hg : injective g)
  : injective (g ∘ f) :=
assume x y,
assume h1 : (g ∘ f) x = (g ∘ f) y,
Hf (Hg h1)

-- 8ª demostración
example
  (Hf : injective f)
  (Hg : injective g)
  : injective (g ∘ f) :=
λ x y h1, Hf (Hg h1)

-- 9ª demostración
example
  (Hg : injective g)
  (Hf : injective f)
  : injective (g ∘ f) :=
-- by library_search
injective.comp Hg Hf

-- 10ª demostración
example
  (Hg : injective g)
  (Hf : injective f)
  : injective (g ∘ f) :=
-- by hint
by tauto


open classical

theorem double_neg_elim: ∀ { P }, ¬¬P → P :=
begin
  assume P : Prop,
  assume pfNotNotP : ¬¬P,
  cases em P with pfP pfnP,
    show P, from pfP,

    have f: false := pfNotNotP pfnP,
    show P, from false.elim f
end

theorem double_neg_elim': ∀ {P}, (P ∨ ¬P) → ¬¬P → P :=
begin
    assume P: Prop,
    assume h: P ∨ ¬P,
    assume notnotP: ¬¬P,
    cases h with a b,
        show P, from a,
        show P, from false.elim (notnotP b),
end

theorem p_b_c' : ∀ P: Prop, (¬P → false) → P := λ P nnP, double_neg_elim nnP

theorem proof_by_contrapositive:
    ∀ P Q : Prop, (¬ Q → ¬ P) → (P → Q) :=
    begin
        assume P Q: Prop,
        assume nqnp: (¬ Q → ¬ P),
        assume p : P,
        have nnq : ¬ Q → false :=
            begin
                assume nq : ¬Q,
                have np : ¬P := nqnp nq,
                show false, from np p
            end,
        show Q, from double_neg_elim nnq
    end

theorem proof_by_contrapositive':
    ∀ P Q : Prop, (¬ Q → ¬ P) → (P → Q) :=
    begin
        assume P Q: Prop,
        assume nqnp: (¬ Q → ¬ P),
        assume p : P,
        have nnq : ¬ Q → false :=
            λ nq : ¬Q, nqnp nq p,
        show Q, from double_neg_elim nnq
    end

theorem proof_by_contrapositive''''':
    ∀ P Q : Prop, (¬ Q → ¬ P) → (P → Q) :=
    begin
        assume (P Q: Prop) (nqnp: ¬ Q → ¬ P) (p: P),
        exact double_neg_elim (λ nq : ¬Q, nqnp nq p)
    end

theorem proof_by_contrapositive'''':
    ∀ P Q : Prop, (¬ Q → ¬ P) → (P → Q) :=
    begin
        assume P Q: Prop,
        assume nqnp: (¬ Q → ¬ P),
        assume p : P,
        exact double_neg_elim (λ nq : ¬Q, nqnp nq p)
    end

theorem proof_by_contrapositive'': ∀ P Q : Prop, (¬ Q → ¬ P) → (P → Q) :=
    λ (P Q : Prop) (nqnp : ¬ Q → ¬ P) (p: P),
        double_neg_elim (λ nq : ¬ Q, nqnp nq p)

theorem proof_by_contrapositive''': ∀ P Q : Prop, (¬ Q → ¬ P) → (P → Q) :=
    λ P Q nqnp p, double_neg_elim (λ nq, nqnp nq p)

theorem z: ∀ { a }, ¬¬a → a :=
λ a b,
begin
  cases em a with c d,
    exact c,
    exact false.elim (b d)
end

variable k: Prop
#check em k
#check or.by_cases
#check or.cases_on

theorem double_neg_elim'': ∀ {a}, ¬¬a → a :=
λ a b, or.cases_on (em a) (λ a, a) (λ c, false.elim (b c))

example {P: Prop} (a: ¬¬P) : double_neg_elim a = double_neg_elim'' a := rfl

theorem j: ∀ a b : Prop, (¬ b → ¬ a) → (a → b) :=
    λ a b c d, z (λ e, c e d)

variables P Q: Prop
variable q : Q -- proof of Q
example : P → Q := λ p : P, q
example : P → Q := assume p : P, q

-- def prime (p : ℕ) := p ≥ 2 ∧ ∀ n, n | p → n = 1 ∨ n = p


/-
Copyright (c) 2021 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey
-/
import algebra.periodic
import data.nat.count
import data.nat.interval

/-!
# Periodic Functions on ℕ

This file identifies a few functions on `ℕ` which are periodic, and also proves a lemma about
periodic predicates which helps determine their cardinality when filtering intervals over them.
-/

namespace nat

open nat function

lemma periodic_gcd (a : ℕ) : periodic (gcd a) a :=
by simp only [forall_const, gcd_add_self_right, eq_self_iff_true, periodic]

lemma periodic_coprime (a : ℕ) : periodic (coprime a) a :=
by simp only [coprime_add_self_right, forall_const, iff_self, eq_iff_iff, periodic]

lemma periodic_mod (a : ℕ) : periodic (λ n, n % a) a :=
by simp only [forall_const, eq_self_iff_true, add_mod_right, periodic]

lemma _root_.function.periodic.map_mod_nat {α : Type*} {f : ℕ → α} {a : ℕ} (hf : periodic f a) :
  ∀ n, f (n % a) = f n :=
λ n, by conv_rhs { rw [← nat.mod_add_div n a, mul_comm, ← nat.nsmul_eq_mul, hf.nsmul] }

section multiset
open multiset

/-- An interval of length `a` filtered over a periodic predicate of period `a` has cardinality
equal to the number naturals below `a` for which `p a` is true. -/
lemma filter_multiset_Ico_card_eq_of_periodic (n a : ℕ) (p : ℕ → Prop) [decidable_pred p]
  (pp : periodic p a) :
  (filter p (Ico n (n+a))).card = a.count p :=
begin
  rw [count_eq_card_filter_range, finset.card, finset.filter_val, finset.range_coe,
    ←multiset_Ico_map_mod n, ←map_count_true_eq_filter_card, ←map_count_true_eq_filter_card,
    map_map, function.comp],
  simp only [pp.map_mod_nat],
end

end multiset

section finset
open finset

/-- An interval of length `a` filtered over a periodic predicate of period `a` has cardinality
equal to the number naturals below `a` for which `p a` is true. -/
lemma filter_Ico_card_eq_of_periodic (n a : ℕ) (p : ℕ → Prop) [decidable_pred p]
  (pp : periodic p a) :
  ((Ico n (n + a)).filter p).card = a.count p :=
filter_multiset_Ico_card_eq_of_periodic n a p pp

end finset

end nat


/-
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 1 : "implies" (`→`)

We learn about propositions, and implications `P → Q` between them. You can get
this arrow by typing `\to` or `\r`. Mathematicians usually write the
implication arrow as `P ⇒ Q` but Lean prefers a single arrow.

## The absolute basics

`P : Prop` means that `P` is a true-false statement. `h : P` means
that `h` is a proof that `P` is true, or you can regard `h` as an
assumption that `P` is true; logically these are the same. Stuff above
the `⊢` symbol is your assumptions. The statement to the right of it is
the goal. Your job is to prove the goal from the assumptions.

## Tactics you will need

To solve the levels on this sheet you will need to know how to use the
following tactics:

* `intro`
* `exact`
* `apply`

You can read the descriptions of these tactics in Part C of the course
notes.

## Worked examples

Click around in the proofs to see the tactic state (on the right) change.
The tactic is implemented and the state changes just before the comma.
I will use the following conventions: variables with capital
letters like `P`, `Q`, `R` denote propositions
(i.e. true/false statements) and variables whose names begin
with `h` like `h1` or `hP` are proofs or hypotheses.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.
variables (P Q R : Prop)

-- Here are some examples of `intro`, `exact` and `apply` being used.

-- Assume that `P` and `Q` and `R` are all true. Deduce that `P` is true.
example (hP : P) (hQ : Q) (hR : R) : P :=
begin
  exact hP,
end

-- Assume `Q` is true. Prove that `P → Q`.
example (hQ : Q) : P → Q :=
begin
  intro fish,
  exact hQ,
end

-- Assume `P → Q` and `P` is true. Deduce `Q`.
example (h : P → Q) (hP : P) : Q :=
begin
  apply h,
  exact hP,
end

/-

## Examples for you to try

Delete the `sorry`s and replace them with comma-separated tactic proofs
using `intro`, `exact` and `apply`.

-/

/-- Every proposition implies itself. -/
example : P → P :=
begin
  intro banana,
  exact banana,
end

/-

Note that `→` is not associative: in general `P → (Q → R)` and `(P → Q) → R`
might not be equivalent. This is like subtraction on numbers -- in general
`a - (b - c)` and `(a - b) - c` might not be equal.

So if we write `P → Q → R` then we'd better know what this means.
The convention in Lean is that it means `P → (Q → R)`. If you think
about it, this means that to deduce `R` you will need to prove both `P`
and `Q`. In general to prove `P1 → P2 → P3 → ... Pn` you can assume
`P1`, `P2`,...,`P(n-1)` and then you have to prove `Pn`.

So the next level is asking you prove that `P → (Q → P)`.

-/
example : P → Q → P :=
begin
  intro hP,
  intro hQ,
  assumption,
end

/-- If we know `P`, and we also know `P → Q`, we can deduce `Q`.
This is called "Modus Ponens" by logicians. -/
example : P → (P → Q) → Q :=
begin
  intros hP hPQ,
  apply hPQ,
  exact hP,
end

/-- `→` is transitive. That is, if `P → Q` and `Q → R` are true, then
  so is `P → R`. -/
example : (P → Q) → (Q → R) → (P → R) :=
begin
  intros hPQ hQR hP,
  apply hQR,
  apply hPQ,
  exact hP,
end

-- If `h : P → Q → R` with goal `⊢ R` and you `apply h`, you'll get
-- two goals! Note that tactics operate on only the first goal.
example : (P → Q → R) → (P → Q) → (P → R) :=
begin
  intros hPQR hPQ hP,
  apply hPQR,
  { exact hP },
  { apply hPQ,
    exact hP }
end

/-

Here are some harder puzzles. If you're not into logic puzzles
and you feel like you understand `intro`, `exact` and `apply`
then you can just skip these and move onto the next sheet
in this section, where you'll learn some more tactics.

-/

variables (S T : Prop)

example : (P → R) → (S → Q) → (R → T) → (Q → R) → S → T :=
begin
  intros hPR hSQ hRT hQR hS,
  apply hRT,
  clear hPR,
  apply hQR,
  apply hSQ,
  exact hS,
end

example : (P → Q) → ((P → Q) → P) → Q :=
begin
  intros hPQ hPQP,
  apply hPQ,
  apply hPQP,
  exact hPQ,
end

example : ((P → Q) → R) → ((Q → R) → P) → ((R → P) → Q) → P :=
begin
  intros h1 h2 h3,
  apply h2,
  intro hQ,
  apply h1,
  intro hP,
  exact hQ,
end

example : ((Q → P) → P) → (Q → R) → (R → P) → P :=
begin
  intros h1 h2 h3,
  apply h1,
  intro hQ,
  apply h3,
  apply h2,
  exact hQ,
end

example : (((P → Q) → Q) → Q) → (P → Q) :=
begin
  intros h1 hP,
  apply h1,
  intro hPQ,
  exact hPQ hP,
end

example :
  (((P → Q → Q) → ((P → Q) → Q)) → R) →
  ((((P → P) → Q) → (P → P → Q)) → R) →
  (((P → P → Q) → ((P → P) → Q)) → R) → R :=
begin
  intros h1 h2 h3,
  apply h2,
  intros h1 hP h2,
  apply h1,
  intro hP,
  exact h2,
end


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.asymptotics.asymptotics
import analysis.normed_space.ordered

/-!
# Asymptotic equivalence

In this file, we define the relation `is_equivalent u v l`, which means that `u-v` is little o of
`v` along the filter `l`.

Unlike `is_[oO]` relations, this one requires `u` and `v` to have the same codomain `β`. While the
definition only requires `β` to be a `normed_group`, most interesting properties require it to be a
`normed_field`.

## Notations

We introduce the notation `u ~[l] v := is_equivalent u v l`, which you can use by opening the
`asymptotics` locale.

## Main results

If `β` is a `normed_group` :

- `_ ~[l] _` is an equivalence relation
- Equivalent statements for `u ~[l] const _ c` :
  - If `c ≠ 0`, this is true iff `tendsto u l (𝓝 c)` (see `is_equivalent_const_iff_tendsto`)
  - For `c = 0`, this is true iff `u =ᶠ[l] 0` (see `is_equivalent_zero_iff_eventually_zero`)

If `β` is a `normed_field` :

- Alternative characterization of the relation (see `is_equivalent_iff_exists_eq_mul`) :

  `u ~[l] v ↔ ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v`

- Provided some non-vanishing hypothesis, this can be seen as `u ~[l] v ↔ tendsto (u/v) l (𝓝 1)`
  (see `is_equivalent_iff_tendsto_one`)
- For any constant `c`, `u ~[l] v` implies `tendsto u l (𝓝 c) ↔ tendsto v l (𝓝 c)`
  (see `is_equivalent.tendsto_nhds_iff`)
- `*` and `/` are compatible with `_ ~[l] _` (see `is_equivalent.mul` and `is_equivalent.div`)

If `β` is a `normed_linear_ordered_field` :

- If `u ~[l] v`, we have `tendsto u l at_top ↔ tendsto v l at_top`
  (see `is_equivalent.tendsto_at_top_iff`)

-/

namespace asymptotics

open filter function
open_locale topological_space

section normed_group

variables {α β : Type*} [normed_group β]

/-- Two functions `u` and `v` are said to be asymptotically equivalent along a filter `l` when
    `u x - v x = o(v x)` as x converges along `l`. -/
def is_equivalent (u v : α → β) (l : filter α) := is_o (u - v) v l

localized "notation u ` ~[`:50 l:50 `] `:0 v:50 := asymptotics.is_equivalent u v l" in asymptotics

variables {u v w : α → β} {l : filter α}

lemma is_equivalent.is_o (h : u ~[l] v) : is_o (u - v) v l := h

lemma is_equivalent.is_O (h : u ~[l] v) : is_O u v l :=
(is_O.congr_of_sub h.is_O.symm).mp (is_O_refl _ _)

lemma is_equivalent.is_O_symm (h : u ~[l] v) : is_O v u l :=
begin
  convert h.is_o.right_is_O_add,
  ext,
  simp
end

@[refl] lemma is_equivalent.refl : u ~[l] u :=
begin
  rw [is_equivalent, sub_self],
  exact is_o_zero _ _
end

@[symm] lemma is_equivalent.symm (h : u ~[l] v) : v ~[l] u :=
(h.is_o.trans_is_O h.is_O_symm).symm

@[trans] lemma is_equivalent.trans (huv : u ~[l] v) (hvw : v ~[l] w) : u ~[l] w :=
(huv.is_o.trans_is_O hvw.is_O).triangle hvw.is_o

lemma is_equivalent.congr_left {u v w : α → β} {l : filter α} (huv : u ~[l] v)
  (huw : u =ᶠ[l] w) : w ~[l] v :=
is_o.congr' (huw.sub (eventually_eq.refl _ _)) (eventually_eq.refl _ _) huv

lemma is_equivalent.congr_right {u v w : α → β} {l : filter α} (huv : u ~[l] v)
  (hvw : v =ᶠ[l] w) : u ~[l] w :=
(huv.symm.congr_left hvw).symm

lemma is_equivalent_zero_iff_eventually_zero : u ~[l] 0 ↔ u =ᶠ[l] 0 :=
begin
  rw [is_equivalent, sub_zero],
  exact is_o_zero_right_iff
end

lemma is_equivalent_zero_iff_is_O_zero : u ~[l] 0 ↔ is_O u (0 : α → β) l :=
begin
  refine ⟨is_equivalent.is_O, λ h, _⟩,
  rw [is_equivalent_zero_iff_eventually_zero, eventually_eq_iff_exists_mem],
  exact ⟨{x : α | u x = 0}, is_O_zero_right_iff.mp h, λ x hx, hx⟩,
end

lemma is_equivalent_const_iff_tendsto {c : β} (h : c ≠ 0) : u ~[l] const _ c ↔ tendsto u l (𝓝 c) :=
begin
  rw [is_equivalent, is_o_const_iff h],
  split; intro h;
  [ { have := h.sub tendsto_const_nhds, rw zero_sub (-c) at this },
    { have := h.sub tendsto_const_nhds, rw ← sub_self c} ];
  convert this; try { ext }; simp
end

lemma is_equivalent.tendsto_const {c : β} (hu : u ~[l] const _ c) : tendsto u l (𝓝 c) :=
begin
  rcases (em $ c = 0) with ⟨rfl, h⟩,
  { exact (tendsto_congr' $ is_equivalent_zero_iff_eventually_zero.mp hu).mpr tendsto_const_nhds },
  { exact (is_equivalent_const_iff_tendsto h).mp hu }
end

lemma is_equivalent.tendsto_nhds_iff {c : β} (huv : u ~[l] v) :
  tendsto u l (𝓝 c) ↔ tendsto v l (𝓝 c) := ⟨huv.tendsto_nhds, huv.symm.tendsto_nhds⟩

lemma is_equivalent.add_is_o (huv : u ~[l] v) (hwv : is_o w v l) : (w + u) ~[l] v :=
begin
  rw is_equivalent at *,
  convert hwv.add huv,
  ext,
  simp [add_sub],
end

lemma is_o.is_equivalent (huv : is_o (u - v) v l) : u ~[l] v := huv

lemma is_equivalent.neg (huv : u ~[l] v) : (λ x, - u x) ~[l] (λ x, - v x) :=
begin
  rw is_equivalent,
  convert huv.is_o.neg_left.neg_right,
  ext,
  simp,
end

end normed_group

open_locale asymptotics

section normed_field

variables {α β : Type*} [normed_field β] {t u v w : α → β} {l : filter α}

lemma is_equivalent_iff_exists_eq_mul : u ~[l] v ↔
  ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v :=
begin
  rw [is_equivalent, is_o_iff_exists_eq_mul],
  split; rintros ⟨φ, hφ, h⟩; [use (φ + 1), use (φ - 1)]; split,
  { conv in (𝓝 _) { rw ← zero_add (1 : β) },
    exact hφ.add (tendsto_const_nhds) },
  { convert h.add (eventually_eq.refl l v); ext; simp [add_mul] },
  { conv in (𝓝 _) { rw ← sub_self (1 : β) },
    exact hφ.sub (tendsto_const_nhds) },
  { convert h.sub (eventually_eq.refl l v); ext; simp [sub_mul] }
end

lemma is_equivalent.exists_eq_mul (huv : u ~[l] v) :
  ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v :=
is_equivalent_iff_exists_eq_mul.mp huv

lemma is_equivalent_of_tendsto_one (hz : ∀ᶠ x in l, v x = 0 → u x = 0)
  (huv : tendsto (u/v) l (𝓝 1)) : u ~[l] v :=
begin
  rw is_equivalent_iff_exists_eq_mul,
  refine ⟨u/v, huv, hz.mono $ λ x hz', (div_mul_cancel_of_imp hz').symm⟩,
end

lemma is_equivalent_of_tendsto_one' (hz : ∀ x, v x = 0 → u x = 0) (huv : tendsto (u/v) l (𝓝 1)) :
  u ~[l] v :=
is_equivalent_of_tendsto_one (eventually_of_forall hz) huv

lemma is_equivalent_iff_tendsto_one (hz : ∀ᶠ x in l, v x ≠ 0) :
  u ~[l] v ↔ tendsto (u/v) l (𝓝 1) :=
begin
  split,
  { intro hequiv,
    have := hequiv.is_o.tendsto_0,
    simp only [pi.sub_apply, sub_div] at this,
    have key : tendsto (λ x, v x / v x) l (𝓝 1),
    { exact (tendsto_congr' $ hz.mono $ λ x hnz, @div_self _ _ (v x) hnz).mpr tendsto_const_nhds },
    convert this.add key,
    { ext, simp },
    { norm_num } },
  { exact is_equivalent_of_tendsto_one (hz.mono $ λ x hnvz hz, (hnvz hz).elim) }
end

end normed_field

section smul

lemma is_equivalent.smul {α E 𝕜 : Type*} [normed_field 𝕜] [normed_group E]
  [normed_space 𝕜 E] {a b : α → 𝕜} {u v : α → E} {l : filter α} (hab : a ~[l] b) (huv : u ~[l] v) :
  (λ x, a x • u x) ~[l] (λ x, b x • v x) :=
begin
  rcases hab.exists_eq_mul with ⟨φ, hφ, habφ⟩,
  have : (λ (x : α), a x • u x) - (λ (x : α), b x • v x) =ᶠ[l] λ x, b x • ((φ x • u x) - v x),
  { convert (habφ.comp₂ (•) $ eventually_eq.refl _ u).sub (eventually_eq.refl _ (λ x, b x • v x)),
    ext,
    rw [pi.mul_apply, mul_comm, mul_smul, ← smul_sub] },
  refine (is_o_congr this.symm $ eventually_eq.rfl).mp ((is_O_refl b l).smul_is_o _),

  rcases huv.is_O.exists_pos with ⟨C, hC, hCuv⟩,
  rw is_equivalent at *,
  rw is_o_iff at *,
  rw is_O_with at hCuv,
  simp only [metric.tendsto_nhds, dist_eq_norm] at hφ,
  intros c hc,
  specialize hφ ((c/2)/C) (div_pos (by linarith) hC),
  specialize huv (show 0 < c/2, by linarith),
  refine hφ.mp (huv.mp $ hCuv.mono $ λ x hCuvx huvx hφx, _),

  have key :=
    calc ∥φ x - 1∥ * ∥u x∥
            ≤ (c/2) / C * ∥u x∥ : mul_le_mul_of_nonneg_right hφx.le (norm_nonneg $ u x)
        ... ≤ (c/2) / C * (C*∥v x∥) : mul_le_mul_of_nonneg_left hCuvx (div_pos (by linarith) hC).le
        ... = c/2 * ∥v x∥ : by {field_simp [hC.ne.symm], ring},

  calc ∥((λ (x : α), φ x • u x) - v) x∥
          = ∥(φ x - 1) • u x + (u x - v x)∥ : by simp [sub_smul, sub_add]
      ... ≤ ∥(φ x - 1) • u x∥ + ∥u x - v x∥ : norm_add_le _ _
      ... = ∥φ x - 1∥ * ∥u x∥ + ∥u x - v x∥ : by rw norm_smul
      ... ≤ c / 2 * ∥v x∥ + ∥u x - v x∥ : add_le_add_right key _
      ... ≤ c / 2 * ∥v x∥ + c / 2 * ∥v x∥ : add_le_add_left huvx _
      ... = c * ∥v x∥ : by ring,
end

end smul

section mul_inv

variables {α β : Type*} [normed_field β] {t u v w : α → β} {l : filter α}

lemma is_equivalent.mul (htu : t ~[l] u) (hvw : v ~[l] w) : t * v ~[l] u * w :=
htu.smul hvw

lemma is_equivalent.inv (huv : u ~[l] v) : (λ x, (u x)⁻¹) ~[l] (λ x, (v x)⁻¹) :=
begin
  rw is_equivalent_iff_exists_eq_mul at *,
  rcases huv with ⟨φ, hφ, h⟩,
  rw ← inv_one,
  refine ⟨λ x, (φ x)⁻¹, tendsto.inv₀ hφ (by norm_num) , _⟩,
  convert h.inv,
  ext,
  simp [mul_inv₀]
end

lemma is_equivalent.div (htu : t ~[l] u) (hvw : v ~[l] w) :
  (λ x, t x / v x) ~[l] (λ x, u x / w x) :=
by simpa only [div_eq_mul_inv] using htu.mul hvw.inv

end mul_inv

section normed_linear_ordered_field

variables {α β : Type*} [normed_linear_ordered_field β] {u v : α → β} {l : filter α}

lemma is_equivalent.tendsto_at_top [order_topology β] (huv : u ~[l] v) (hu : tendsto u l at_top) :
  tendsto v l at_top :=
let ⟨φ, hφ, h⟩ := huv.symm.exists_eq_mul in
tendsto.congr' h.symm ((mul_comm u φ) ▸ (hu.at_top_mul zero_lt_one hφ))

lemma is_equivalent.tendsto_at_top_iff [order_topology β] (huv : u ~[l] v) :
  tendsto u l at_top ↔ tendsto v l at_top := ⟨huv.tendsto_at_top, huv.symm.tendsto_at_top⟩

lemma is_equivalent.tendsto_at_bot [order_topology β] (huv : u ~[l] v) (hu : tendsto u l at_bot) :
  tendsto v l at_bot :=
begin
  convert tendsto_neg_at_top_at_bot.comp
    (huv.neg.tendsto_at_top $ tendsto_neg_at_bot_at_top.comp hu),
  ext,
  simp
end

lemma is_equivalent.tendsto_at_bot_iff [order_topology β] (huv : u ~[l] v) :
  tendsto u l at_bot ↔ tendsto v l at_bot := ⟨huv.tendsto_at_bot, huv.symm.tendsto_at_bot⟩

end normed_linear_ordered_field

end asymptotics

open filter asymptotics
open_locale asymptotics

variables {α β : Type*} [normed_group β]

lemma filter.eventually_eq.is_equivalent {u v : α → β} {l : filter α} (h : u =ᶠ[l] v) : u ~[l] v :=
is_o.congr' h.sub_eq.symm (eventually_eq.refl _ _) (is_o_zero v l)


import algebra.group_power
import data.nat.gcd
import data.nat.modeq
import number_theory.pell

attribute [elab_as_eliminator] nat.strong_induction_on
attribute [refl] dvd_refl
attribute [trans] dvd_trans
attribute [symm] nat.coprime.symm

open nat

lemma nat.gcd_add_mul_left (a b n : ℕ) : gcd (a + b * n) b = gcd a b :=
by rw [nat.gcd_comm, gcd_rec, add_mul_mod_self_left, ← gcd_rec, nat.gcd_comm]

lemma nat.gcd_add_mul_right (a b n : ℕ) : gcd (a + n * b) b = gcd a b :=
by rw [nat.gcd_comm, gcd_rec, add_mul_mod_self_right, ← gcd_rec, nat.gcd_comm]

lemma nat.gcd_add (a b : ℕ) : gcd (a + b) b = gcd a b :=
by rw [← nat.gcd_add_mul_left a b 1, mul_one]

@[elab_as_eliminator]
lemma nat.mod_rec (m n : ℕ) {X : Sort*} {C : ℕ → X}
  (H : ∀ n, C n = C (n+m)) :
  C n = C (n%m) :=
have H1 : ∀ q r, C (r + m * q) = C r,
  from λ q, nat.rec_on q (λ r, by rw [mul_zero]; refl) $ λ n ih r,
    by rw [mul_succ, ← add_assoc, ← H, ih],
by conv in (C n) { rw [← mod_add_div n m, H1] }

def nat.mod_add (a b m : ℕ) : (a % m + b % m) % m = (a + b) % m :=
nat.modeq.modeq_add (nat.mod_mod _ _) (nat.mod_mod _ _)

-- modeq
-- needs data.nat.modeq

-- #check 2 ≡ 5 [MOD 5] -- notation

instance nonsquare_five : zsqrtd.nonsquare 5 :=
⟨λ n, nat.cases_on n dec_trivial $ λ n,
  nat.cases_on n dec_trivial $ λ n,
  nat.cases_on n dec_trivial $ λ n,
  ne_of_lt $ calc 5 < 3 * 3 : dec_trivial
    ... ≤ 3 * (n+3) : nat.mul_le_mul_left _ (nat.le_add_left _ _)
    ... ≤ (n+3) * (n+3) : nat.mul_le_mul_right _ (nat.le_add_left _ _)⟩

@[simp] lemma is_ring_hom.map_int {α : Type*} {β : Type*}
  [ring α] [ring β] (f : α → β)
  [is_ring_hom f] (i : ℤ) : f i = i :=
int.induction_on i
  (is_ring_hom.map_zero f)
  (λ j H, by simp [is_ring_hom.map_add f, is_ring_hom.map_one f, H]; exact H)
  (λ j H, by simp_rw [int.cast_sub, is_ring_hom.map_sub f, H, int.cast_one, is_ring_hom.map_one f])

@[simp] lemma units.neg_coe {α : Type*} [ring α] (x : units α) : ((-x : units α) : α) = -↑x :=
rfl


-- topological spaces from first principles.

import tactic

open set

class topological_space (X : Type) :=
(is_open        : set X → Prop)
(is_open_univ   : is_open univ)
(is_open_inter  : ∀ (U V : set X), is_open U → is_open V → is_open (U ∩ V))
(is_open_sUnion : ∀ (𝒞 : set (set X)), (∀U ∈ 𝒞, is_open U) → is_open (⋃₀ 𝒞))

namespace topological_space

variables {X : Type} [topological_space X]

variable {ι : Type}

lemma is_open_Union {f : ι → set X} (h : ∀i, is_open (f i)) : is_open (⋃i, f i) :=
begin
  apply is_open_sUnion,
  intros U,
  intro hU,
  cases hU with i hi,
  dsimp at hi,
  rw ←hi,
  apply h,
end

-- remember `U : set X` means "U is a subset of X", or "U is a set of terms of X"
variables (U V : set X)

lemma is_open_union (h₁ : is_open U) (h₂ : is_open V) : is_open (U ∪ V) :=
begin
  let 𝒞 : set (set X) := {U, V},
  have h𝒞 : ∀ U ∈ 𝒞, is_open U,
  { intros W hW,
    rcases hW with rfl | ⟨_, _⟩; assumption},
  convert is_open_sUnion 𝒞 h𝒞,
  simp only [sUnion_singleton, sUnion_insert]
end

lemma is_open_empty : is_open (∅ : set X) :=
begin
  let 𝒞 : set (set X) := ∅,
  have h𝒞 : ∀ U ∈ 𝒞, is_open U,
    rintro U ⟨⟩,
  convert is_open_sUnion 𝒞 h𝒞,
  apply sUnion_empty.symm,
end

/-- A set is closed if its complement is open -/
def is_closed (U : set X) : Prop := is_open Uᶜ

end topological_space

open topological_space

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

/-- A function between topological spaces is continuous if the preimage
  of every open set is open. -/
def continuous (f : X → Y) := ∀U, is_open U → is_open (f ⁻¹' U)

theorem continuous_id : continuous (id : X → X) :=
begin
  intros U hU,
--  have h1 : U = id '' U := rfl, -- fails
--  have h2 : U = id ⁻¹' U := rfl, -- works
  exact hU,
end

variables {Z : Type} [topological_space Z]

theorem continuous.comp {g : Y → Z} {f : X → Y} (hg : continuous g) (hf : continuous f) :
continuous (g ∘ f) :=
--λ U hU, hf (g⁻¹' U) $ hg _ hU
begin
  intros U hU,
--  change is_open (f⁻¹' (g⁻¹' U)),
  apply hf (g⁻¹' U),
  apply hg,
  assumption,
end


/-
Copyright (c) 2014 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Floris van Doorn, Jeremy Avigad
Distance function on the natural numbers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.basic
import Mathlib.PostPort

namespace Mathlib

namespace nat

/- distance -/

/-- Distance (absolute value of difference) between natural numbers. -/
def dist (n : ℕ) (m : ℕ) : ℕ :=
  n - m + (m - n)

theorem dist.def (n : ℕ) (m : ℕ) : dist n m = n - m + (m - n) :=
  rfl

theorem dist_comm (n : ℕ) (m : ℕ) : dist n m = dist m n := sorry

@[simp] theorem dist_self (n : ℕ) : dist n n = 0 := sorry

theorem eq_of_dist_eq_zero {n : ℕ} {m : ℕ} (h : dist n m = 0) : n = m := sorry

theorem dist_eq_zero {n : ℕ} {m : ℕ} (h : n = m) : dist n m = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (dist n m = 0)) h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (dist m m = 0)) (dist_self m))) (Eq.refl 0))

theorem dist_eq_sub_of_le {n : ℕ} {m : ℕ} (h : n ≤ m) : dist n m = m - n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (dist n m = m - n)) (dist.def n m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (n - m + (m - n) = m - n)) (sub_eq_zero_of_le h)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 + (m - n) = m - n)) (zero_add (m - n)))) (Eq.refl (m - n))))

theorem dist_eq_sub_of_le_right {n : ℕ} {m : ℕ} (h : m ≤ n) : dist n m = n - m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (dist n m = n - m)) (dist_comm n m))) (dist_eq_sub_of_le h)

theorem dist_tri_left (n : ℕ) (m : ℕ) : m ≤ dist n m + n :=
  le_trans (nat.le_sub_add m n) (add_le_add_right (le_add_left (m - n) (n - m)) n)

theorem dist_tri_right (n : ℕ) (m : ℕ) : m ≤ n + dist n m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m ≤ n + dist n m)) (add_comm n (dist n m)))) (dist_tri_left n m)

theorem dist_tri_left' (n : ℕ) (m : ℕ) : n ≤ dist n m + m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n ≤ dist n m + m)) (dist_comm n m))) (dist_tri_left m n)

theorem dist_tri_right' (n : ℕ) (m : ℕ) : n ≤ m + dist n m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n ≤ m + dist n m)) (dist_comm n m))) (dist_tri_right m n)

theorem dist_zero_right (n : ℕ) : dist n 0 = n :=
  Eq.trans (dist_eq_sub_of_le_right (zero_le n)) (nat.sub_zero n)

theorem dist_zero_left (n : ℕ) : dist 0 n = n :=
  Eq.trans (dist_eq_sub_of_le (zero_le n)) (nat.sub_zero n)

theorem dist_add_add_right (n : ℕ) (k : ℕ) (m : ℕ) : dist (n + k) (m + k) = dist n m := sorry

theorem dist_add_add_left (k : ℕ) (n : ℕ) (m : ℕ) : dist (k + n) (k + m) = dist n m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (dist (k + n) (k + m) = dist n m)) (add_comm k n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (dist (n + k) (k + m) = dist n m)) (add_comm k m))) (dist_add_add_right n k m))

theorem dist_eq_intro {n : ℕ} {m : ℕ} {k : ℕ} {l : ℕ} (h : n + m = k + l) : dist n k = dist l m := sorry

protected theorem sub_lt_sub_add_sub (n : ℕ) (m : ℕ) (k : ℕ) : n - k ≤ n - m + (m - k) := sorry

theorem dist.triangle_inequality (n : ℕ) (m : ℕ) (k : ℕ) : dist n k ≤ dist n m + dist m k := sorry

theorem dist_mul_right (n : ℕ) (k : ℕ) (m : ℕ) : dist (n * k) (m * k) = dist n m * k := sorry

theorem dist_mul_left (k : ℕ) (n : ℕ) (m : ℕ) : dist (k * n) (k * m) = k * dist n m := sorry

-- TODO(Jeremy): do when we have max and minx

--theorem dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j :=

--sorry

/-
or.elim (lt_or_ge i j)
  (assume : i < j,
    by rw [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this])
  (assume : i ≥ j,
    by rw [max_eq_left this , min_eq_right this, dist_eq_sub_of_le_right this])
-/

theorem dist_succ_succ {i : ℕ} {j : ℕ} : dist (Nat.succ i) (Nat.succ j) = dist i j := sorry

theorem dist_pos_of_ne {i : ℕ} {j : ℕ} : i ≠ j → 0 < dist i j := sorry


-- textbook: List
import Init

open List

variable {α : Type}
variable (as bs cs : List α)
variable (a b c : α)

#check a :: as
#check as ++ bs

example : [] ++ as = as := nil_append as

example : (a :: as) ++ bs = a :: (as ++ bs) := cons_append a as bs
-- end: List

-- textbook: append_nil'
theorem append_nil' : as ++ [] = as := by
  induction as with
  | nil => rw [nil_append]
  | cons a as ih => rw [cons_append, ih]
-- end: append_nil'

-- textbook: append_assoc'
theorem append_assoc' : as ++ bs ++ cs = as ++ (bs ++ cs) := by
  induction as with
  | nil => rw [nil_append, nil_append]
  | cons a as ih => rw [cons_append, cons_append, ih, ←cons_append]
-- end: append_assoc'

-- textbook: reverse
theorem reverse_def : reverse as = reverseAux as [] := rfl

theorem reverseAux_nil : reverseAux [] as = as := rfl

theorem reverseAux_cons : reverseAux (a :: as) bs = reverseAux as (a :: bs) := rfl
-- end: reverse

theorem reverse_nil : reverse ([] : List α) = [] := rfl

-- textbook: reverse identities
theorem reverseAux_append : reverseAux (as ++ bs) cs = reverseAux bs (reverseAux as cs) := by
  induction as generalizing cs with
  | nil => rw [nil_append, reverseAux_nil]
  | cons a as ih => rw [cons_append, reverseAux_cons, reverseAux_cons, ih]

theorem reverseAux_append' : reverseAux as (bs ++ cs) = reverseAux as bs ++ cs := by
  induction as generalizing bs with
  | nil => rw [reverseAux_nil, reverseAux_nil]
  | cons a as ih => rw [reverseAux_cons, reverseAux_cons, ←cons_append, ih]
-- end: reverse identities

-- textbook: reverse_append
theorem reverse_append : reverse (as ++ bs) = reverse bs ++ reverse as := by
  rw [reverse_def, reverseAux_append, reverse_def, ←reverseAux_append', nil_append,
      reverse_def]
-- end: reverse_append


/-
Copyright (c) 2022 Matej Penciak. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Matej Penciak, Moritz Doll, Fabien Clery
-/

import linear_algebra.matrix.nonsingular_inverse

/-!
# The Symplectic Group

This file defines the symplectic group and proves elementary properties.

## Main Definitions

`matrix.J`: the canonical `2n × 2n` skew-symmetric matrix
`symplectic_group`: the group of symplectic matrices

## TODO
* Every symplectic matrix has determinant 1.
* For `n = 1` the symplectic group coincides with the special linear group.
-/

open_locale matrix

variables {l R : Type*}

namespace matrix

variables (l) [decidable_eq l] (R) [comm_ring R]

section J_matrix_lemmas

/-- The matrix defining the canonical skew-symmetric bilinear form. -/
def J : matrix (l ⊕ l) (l ⊕ l) R := matrix.from_blocks 0 (-1) 1 0

@[simp] lemma J_transpose : (J l R)ᵀ = - (J l R) :=
begin
  rw [J, from_blocks_transpose, ←neg_one_smul R (from_blocks _ _ _ _), from_blocks_smul,
    matrix.transpose_zero, matrix.transpose_one, transpose_neg],
  simp [from_blocks],
end

variables [fintype l]

lemma J_squared : (J l R) ⬝ (J l R) = -1 :=
begin
  rw [J, from_blocks_multiply],
  simp only [matrix.zero_mul, matrix.neg_mul, zero_add, neg_zero, matrix.one_mul, add_zero],
  rw [← neg_zero, ← matrix.from_blocks_neg, ← from_blocks_one],
end

lemma J_inv : (J l R)⁻¹ = -(J l R) :=
begin
  refine matrix.inv_eq_right_inv _,
  rw [matrix.mul_neg, J_squared],
  exact neg_neg 1,
end

lemma J_det_mul_J_det : (det (J l R)) * (det (J l R)) = 1 :=
begin
  rw [←det_mul, J_squared],
  rw [←one_smul R (-1 : matrix _ _ R)],
  rw [smul_neg, ←neg_smul, det_smul],
  simp only [fintype.card_sum, det_one, mul_one],
  apply even.neg_one_pow,
  exact even_add_self _
end

lemma is_unit_det_J : is_unit (det (J l R)) :=
is_unit_iff_exists_inv.mpr ⟨det (J l R), J_det_mul_J_det _ _⟩

end J_matrix_lemmas

variable [fintype l]

/-- The group of symplectic matrices over a ring `R`. -/
def symplectic_group : submonoid (matrix (l ⊕ l) (l ⊕ l)  R) :=
{ carrier := { A | A ⬝ (J l R) ⬝ Aᵀ = J l R},
  mul_mem' :=
  begin
    intros a b ha hb,
    simp only [mul_eq_mul, set.mem_set_of_eq, transpose_mul] at *,
    rw [←matrix.mul_assoc, a.mul_assoc, a.mul_assoc, hb],
    exact ha,
  end,
  one_mem' := by simp }

end matrix

namespace symplectic_group

variables {l} {R} [decidable_eq l] [fintype l] [comm_ring R]

open matrix

lemma mem_iff {A : matrix (l ⊕ l) (l ⊕ l)  R} :
  A ∈ symplectic_group l R ↔ A ⬝ (J l R) ⬝ Aᵀ = J l R :=
by simp [symplectic_group]

instance coe_matrix : has_coe (symplectic_group l R) (matrix (l ⊕ l) (l ⊕ l)  R)
:= by apply_instance

section symplectic_J

variables (l) (R)

lemma J_mem : (J l R) ∈ symplectic_group l R :=
begin
  rw [mem_iff, J, from_blocks_multiply, from_blocks_transpose, from_blocks_multiply],
  simp,
end

/-- The canonical skew-symmetric matrix as an element in the symplectic group. -/
def sym_J : symplectic_group l R := ⟨J l R, J_mem l R⟩

variables {l} {R}

@[simp] lemma coe_J : ↑(sym_J l R) = J l R := rfl

end symplectic_J

variables {R} {A : matrix (l ⊕ l) (l ⊕ l) R}

lemma neg_mem (h : A ∈ symplectic_group l R) : -A ∈ symplectic_group l R :=
begin
  rw mem_iff at h ⊢,
  simp [h],
end

lemma symplectic_det (hA : A ∈ symplectic_group l R) : is_unit $ det A :=
begin
  rw is_unit_iff_exists_inv,
  use A.det,
  refine (is_unit_det_J l R).mul_left_cancel _,
  rw [mul_one],
  rw mem_iff at hA,
  apply_fun det at hA,
  simp only [det_mul, det_transpose] at hA,
  rw [mul_comm A.det, mul_assoc] at hA,
  exact hA,
end

lemma transpose_mem (hA : A ∈ symplectic_group l R) :
  Aᵀ ∈ symplectic_group l R :=
begin
  rw mem_iff at ⊢ hA,
  rw transpose_transpose,
  have huA := symplectic_det hA,
  have huAT : is_unit (Aᵀ).det :=
  begin
    rw matrix.det_transpose,
    exact huA,
  end,
  calc Aᵀ ⬝ J l R ⬝ A
      = - Aᵀ ⬝ (J l R)⁻¹ ⬝ A  : by {rw J_inv, simp}
  ... = - Aᵀ ⬝ (A ⬝ J l R ⬝ Aᵀ)⁻¹ ⬝ A : by rw hA
  ... = - (Aᵀ ⬝ (Aᵀ⁻¹ ⬝ (J l R)⁻¹)) ⬝ A⁻¹ ⬝ A : by simp only [matrix.mul_inv_rev,
                                                              matrix.mul_assoc, matrix.neg_mul]
  ... = - (J l R)⁻¹ : by rw [mul_nonsing_inv_cancel_left _ _ huAT,
                             nonsing_inv_mul_cancel_right _ _ huA]
  ... = (J l R) : by simp [J_inv]
end

@[simp] lemma transpose_mem_iff : Aᵀ ∈ symplectic_group l R ↔ A ∈ symplectic_group l R :=
⟨λ hA, by simpa using transpose_mem hA , transpose_mem⟩

lemma mem_iff' : A ∈ symplectic_group l R ↔ Aᵀ ⬝ (J l R) ⬝ A = J l R :=
by rw [←transpose_mem_iff, mem_iff, transpose_transpose]

instance : has_inv (symplectic_group l R) :=
{ inv := λ A, ⟨- (J l R) ⬝ (A : matrix (l ⊕ l) (l ⊕ l) R)ᵀ ⬝ (J l R),
  mul_mem (mul_mem (neg_mem $ J_mem _ _) $ transpose_mem A.2) $ J_mem _ _⟩ }

lemma coe_inv (A : symplectic_group l R) :
  (↑(A⁻¹) : matrix _ _ _) = - J l R ⬝ (↑A)ᵀ ⬝ J l R := rfl

lemma inv_left_mul_aux (hA : A ∈ symplectic_group l R) :
  -(J l R ⬝ Aᵀ ⬝ J l R ⬝ A) = 1 :=
calc -(J l R ⬝ Aᵀ ⬝ J l R ⬝ A)
    = - J l R ⬝ (Aᵀ ⬝ J l R ⬝ A) : by simp only [matrix.mul_assoc, matrix.neg_mul]
... = - J l R ⬝ J l R : by {rw mem_iff' at hA, rw hA}
... = (-1 : R) • (J l R ⬝ J l R) : by simp only [matrix.neg_mul, neg_smul, one_smul]
... = (-1 : R) • -1 : by rw J_squared
... = 1 : by simp only [neg_smul_neg, one_smul]

lemma coe_inv' (A : symplectic_group l R) : (↑(A⁻¹) : matrix (l ⊕ l) (l ⊕ l) R) = A⁻¹ :=
begin
  refine (coe_inv A).trans (inv_eq_left_inv _).symm,
  simp [inv_left_mul_aux, coe_inv],
end

lemma inv_eq_symplectic_inv (A : matrix (l ⊕ l) (l ⊕ l) R) (hA : A ∈ symplectic_group l R) :
  A⁻¹ = - (J l R) ⬝ Aᵀ ⬝ (J l R) :=
inv_eq_left_inv (by simp only [matrix.neg_mul, inv_left_mul_aux hA])

instance : group (symplectic_group l R) :=
{ mul_left_inv := λ A,
  begin
    apply subtype.ext,
    simp only [submonoid.coe_one, submonoid.coe_mul, matrix.neg_mul, coe_inv],
    rw [matrix.mul_eq_mul, matrix.neg_mul],
    exact inv_left_mul_aux A.2,
  end,
  .. symplectic_group.has_inv,
  .. submonoid.to_monoid _ }

end symplectic_group


/-
Copyright (c) 2023 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Jujian Zhang
-/
import tactic

import topology.subset_properties
import ring_theory.int.basic

/-!
# Proof of infinitude of prime numbers using topology

This file contains an interesting proof of infinitude of prime numbers.

Define a topology on `ℤ` by declaring a set `U` is open if and only if
for every `x ∈ U`, there exists an `1 ≤ m` such that `mk + x ∈ U` for all `k`.

Then one can see that every nonempty open set is infinite and every arithmetic
progression `{mk + a | k ∈ ℤ}` is both open and closed where `1 ≤ m`.

Then suppose there are only finitely many prime numbers, then `⋃_p {pk | k ∈ ℤ}`
is a finite union of arithmetic progression thus closed, so its complement is open.
However, the complement of `⋃_p {pk | k ∈ ℤ}` is precisely `{-1, 1}` which cannot
be open because it is nonempty but finite.
-/

open topological_space

def contains_arith_progression (U : set ℤ) : Prop :=
∀ (x : ℤ), x ∈ U → ∃ (m : ℤ), 1 ≤ m ∧ ∀ (k : ℤ), m * k + x ∈ U

lemma univ_contains_arith_progression : contains_arith_progression set.univ :=
sorry

lemma inter_contains_arith_progression (s t : set ℤ)
  (hs : contains_arith_progression s) (ht : contains_arith_progression t) :
  contains_arith_progression (s ∩ t) := sorry

lemma sUnion_contains_arith_progression (s : set (set ℤ))
  (hs : ∀ i ∈ s, contains_arith_progression i) : contains_arith_progression (⋃₀ s) :=
sorry

instance weird_top_on_int : topological_space ℤ :=
{ is_open := contains_arith_progression,
  is_open_univ := univ_contains_arith_progression,
  is_open_inter := inter_contains_arith_progression,
  is_open_sUnion := sUnion_contains_arith_progression }

lemma is_open_iff_weird (s : set ℤ) : is_open s ↔ contains_arith_progression s := iff.rfl

lemma nonempty_open_is_infinite (s : set ℤ) (hs1 : is_open s) (hs2 : s.nonempty) :
  s.infinite :=
sorry

def arith_progression (a m : ℤ) := {z : ℤ | ∃ k, m * k + a = z }

lemma arith_progression_open (a m : ℤ) (hm : 1 ≤ m) : is_open (arith_progression a m) :=
sorry

lemma arith_progression_closed (a m : ℤ) (hm : 1 ≤ m) : is_closed (arith_progression a m) :=
sorry

lemma arith_progression_clopen (a m : ℤ) (hm : 1 ≤ m) :
  is_clopen (arith_progression a m) :=
sorry

lemma seteq1 : (⋃ (p : ℕ) (hp : nat.prime p), arith_progression 0 p)ᶜ = {1, -1} :=
sorry

lemma not_closed : ¬ is_closed (⋃ (p : ℕ) (hp : nat.prime p), arith_progression 0 p) :=
sorry

lemma not_closed' : ¬ is_closed (⋃ (p : set_of nat.prime), arith_progression 0 (p : ℤ)) :=
sorry

lemma infinite_prime : (set_of nat.prime).infinite :=
sorry


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es una función de ℝ en ℝ tal que
-- para cada a, existe un x tal que f x < a, entonces f no tiene cota
-- inferior.
-- ----------------------------------------------------------------------

import data.real.basic

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_lb (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, a ≤ f x

def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a
def fn_has_lb (f : ℝ → ℝ) := ∃ a, fn_lb f a

variable f : ℝ → ℝ

example
  (h : ∀ a, ∃ x, f x < a)
  : ¬ fn_has_lb f :=
begin
  intros fnlb,
  cases fnlb with a fnlba,
  cases h a with x hx,
  have : a ≤ f x,
    from fnlba x,
  linarith,
end

-- Prueba
-- ------

-- f : ℝ → ℝ,
-- h : ∀ (a : ℝ), ∃ (x : ℝ), f x < a
-- ⊢ ¬fn_has_lb f
--    >> intros fnlb,
-- fnlb : fn_has_lb f
-- ⊢ false
--    >> cases fnlb with a fnlba,
-- a : ℝ,
-- fnlba : fn_lb f a
-- ⊢ false
--    >> cases h a with x hx,
-- x : ℝ,
-- hx : f x < a
-- ⊢ false
--    >> have : a ≤ f x,
--    >>   from fnlba x,
-- this : a ≤ f x
-- ⊢ false
--    >> linarith,
-- no goals


import tactic
import data.set.finite
import for_mathlib

/-
# Building topological spaces in Lean
-/

/-
First a little setup, we will be making definitions involving the real numbers,
the theory of which is not computable, and we'll use sets.
-/
noncomputable theory
open set

/-
Definition of a topological space
-/
@[ext]
class topological_space (X : Type) :=
  (is_open : set X → Prop)
  (univ_mem : is_open univ)
  (union : ∀ (Y : set (set X)) (h : ∀ B ∈ Y, is_open B), is_open (⋃₀ Y))
  (inter : ∀ (A B : set X) (hA : is_open A) (hB : is_open B), is_open (A ∩ B))

namespace topological_space

variables {X : Type} [topological_space X]
variables (A B : set X)

/-- The empty set is open -/
@[simp]
lemma is_open_empty : is_open (∅ : set X) :=
begin
  rw ←sUnion_empty,
  apply union,
  tauto,
end

@[simp]
lemma is_open_univ : is_open (univ : set X) := univ_mem

lemma is_open_inter (h_A: is_open A) (h_B : is_open B) : is_open (A ∩ B) :=
  inter A B h_A h_B

lemma is_open_sUnion {s : set (set X)} (h : ∀ A ∈ s, is_open A) : is_open (⋃₀ s) :=
  union s h

/-- The union of two open sets is open -/
lemma is_open_union {X : Type} [topological_space X] {U V : set X}
(hU : is_open U) (hV : is_open V): is_open (U ∪ V) :=
begin
  let I : set (set X) := {U, V},
  have H : ⋃₀ I = U ∪ V := sUnion_pair U V,
  rw ←H,
  apply is_open_sUnion,
  intros B hB,
  replace hB : B = U ∨ B = V, by tauto,
  cases hB; {rw hB, assumption},
end

/-- The intersection of a finite collection of open sets is open -/
lemma is_open_sInter {X : Type} [topological_space X] {S : set (set X)} (hfin : finite S)
(h : ∀ s ∈ S, is_open s) : is_open (sInter S) :=
begin
  revert h,
  apply finite.induction_on hfin,
  { simp },
  {
    intros U S hUS hSfin hind h,
    have h : ⋂₀ insert U S = (⋂₀ S) ∩ U,
    {
      finish,
    },
    rw h,
    apply is_open_inter;
    finish
  }
end

open set

lemma is_open_bInter {X α: Type} [topological_space X] {ι : α → set X } (S : set α)
  (hfin : finite S) (h : ∀ s ∈ S, is_open (ι s)) : is_open (⋂ (s ∈ S), ι s) :=
begin
  set Us := ι '' S with hUs,
  have H : is_open ⋂₀ Us,
  { apply is_open_sInter,
    { exact finite.image ι hfin },
    { finish } },
  have eqsets : (⋂ (s : α) (H : s ∈ S), ι s) = ⋂₀ Us,
  { finish },
  rw eqsets,
  assumption,
end

/-- The open sets of the least topology containing a collection of basic sets -/
inductive generated_open (X : Type) (g : set (set X)) : set X → Prop
| univ : generated_open univ
| generating : ∀ A : set X,  A ∈ g → generated_open A
| sUnion : ∀ τ : set(set X), (∀ t, t ∈ τ → generated_open t) →
          generated_open ⋃₀ τ
| inter : ∀ U V : set X,  generated_open U → generated_open V →
            generated_open (U ∩ V)

/-- The smallest topological space containing the collection `g` of basic sets -/
def generate_from {X : Type} (g : set (set X)) : topological_space X :=
{ is_open   := generated_open X g,
  univ_mem  := generated_open.univ,
  inter     := generated_open.inter,
  union     := generated_open.sUnion, }

def is_coarser {X : Type} (τ : topological_space X) (τ' : topological_space X) :=
  ∀ (U : set X), @is_open _ τ U → @is_open _ τ' U

/-- Given topologies τ and τ' on X, we say that τ ≤ τ' iff τ ⊆ τ' (as subsets) -/
instance top_has_le {X : Type} : has_le (topological_space X) :=
  ⟨λ τ τ', (∀ (U : set X), @is_open _ τ U → @is_open _ τ' U)⟩

/-- The topology generated from a collection of sets is the coarsest topology
  that contains those sets -/
lemma generated_open_is_coarsest {X : Type} (g : set (set X)) [τ : topological_space X]
(h : ∀ U ∈ g,  is_open U) : (generate_from g) ≤ τ :=
begin
  intros U hU,
  induction hU,
  { exact is_open_univ },
  { apply h, assumption },
  { apply is_open_sUnion; assumption },
  { apply is_open_inter; assumption },
end

end topological_space

namespace topological_space

@[simp] def is_closed {X : Type} [topological_space X] := λ (C : set X), @is_open X _ (compl C)

def mk_closed_sets
  (X : Type)
  (σ : set (set X))
  (empty_mem : ∅ ∈ σ)
  (inter : ∀ B ⊆ σ, ⋂₀ B ∈ σ)
  (union : ∀ (A B ∈ σ), A ∪ B ∈ σ) :
topological_space X := {
  is_open :=  λ U, compl U ∈ σ,
  univ_mem := by simpa,
  union :=
  begin
    intros Y hY,
    rw compl_sUnion,
    apply inter (compl '' Y),
    simpa using hY,
  end,
  inter :=
  begin
    intros A B hA hB,
    rw compl_inter,
    exact union (compl A) (compl B) hA hB,
  end
  }

end topological_space

namespace topological_space
variables {X : Type} [topological_space X]
variables (A B : set X)
open set

def is_neighborhood (x : X) := ∃ U, is_open U ∧ x ∈ U ∧ U ⊆ A

def interior := { x : X | is_neighborhood A x }

@[simp] lemma interior_subset_self : interior A ⊆ A :=
begin
  rintros x ⟨_, _⟩,
  tauto,
end

lemma interior_def' : interior A = ⋃₀ {U : set X | is_open U ∧ U ⊆ A} :=
begin
  simp only [interior, is_neighborhood, sUnion],
  ext,
  norm_num,
  tauto,
end

/--The interior of a set is open.-/
@[simp] lemma interior_is_open : is_open (interior A) :=
begin
  rw interior_def',
  apply union,
  rintros B ⟨is_open_B, _⟩,
  exact is_open_B,
end

lemma interior_maximal (hB : is_open B) (h: B ⊆ A ):  B ⊆ interior A  :=
begin
  intros x x_in_B,
  rw interior_def',
  use B,
  exact ⟨⟨hB, h⟩, x_in_B⟩,
end

/-- The interior of a set is the biggest open it contains. -/
lemma interior_is_biggest_open (hB : is_open B) : B ⊆ interior A ↔ (B ⊆ A) :=
begin
  split,
  { have := interior_subset_self A,
    tauto },
  {
    exact interior_maximal A B hB,
  }
end

/-These three properties characterize the interior-/
lemma interior_def'': is_open B ∧ B ⊆ A ∧ (∀ U, U ⊆ A → is_open U → U ⊆ B) ↔ B = interior A :=
begin
  split,
  {
    rintros ⟨is_open_B, ⟨B_subset_A, B_is_biggest_open⟩⟩,
    apply subset.antisymm,
    {
      simpa [interior_is_biggest_open A B is_open_B],
    },
    {
      intros x ha,
      exact B_is_biggest_open (interior A) (interior_subset_self A) (interior_is_open A) ha,
    },
  },
  {
    intro,
    subst B,
    exact ⟨interior_is_open A, ⟨interior_subset_self A, λ U hUA hU, interior_maximal A U hU hUA⟩⟩,
  },
end

@[simp] lemma eq_interior_iff_is_open : A = interior A ↔ is_open A :=
begin
  rw ← interior_def'',
  tauto,
end

lemma interior_empty: interior (∅: set X) = ∅ :=
begin
  apply symm,
  apply (eq_interior_iff_is_open ∅).mpr,
  simp,
end

lemma interior_univ: interior (univ: set X) = univ :=
begin
  apply symm,
  apply (eq_interior_iff_is_open univ).mpr,
  simp,
end

-- Can we simplify this proof?
@[simp] lemma interior_interior: interior (interior A) = interior A :=
begin
  exact ((eq_interior_iff_is_open (interior A)).mpr (interior_is_open A)).symm,
end

/-- A point x is an adherent point of A if every neighborhood of x intersects A.-/
def is_adherent_point (x : X) := ∀ N, is_neighborhood N x → N ∩ A ≠ ∅

/-- The closure of A is the set of all the adherent points of A -/
def closure:= {x | is_adherent_point A x}

@[simp] lemma closure_supset_self : A ⊆ closure A :=
begin
  intros x hx,
  have hhx : is_adherent_point A x,
  {
    intros B hBx hn,
    unfold is_neighborhood at hBx,
    rcases hBx with ⟨D, hD, h⟩,
    exact eq_empty_iff_forall_not_mem.mp hn x (mem_inter (h.2 h.1) hx),
  },
  exact hhx,
end

@[simp] lemma closure_eq_compl_of_interior_compl: closure A = (interior Aᶜ)ᶜ :=
begin
  ext1,
  unfold interior is_neighborhood closure is_adherent_point is_neighborhood,
  simp only [not_exists, and_imp, not_and, mem_set_of_eq, ne.def, exists_imp_distrib, mem_compl_eq],
  split,
  {
    intros hx U is_open_U x_in_U hU,
    let hhh := hx Aᶜ U is_open_U x_in_U hU,
    finish,
  },
  {
    intros hx U V is_open_V x_in_V hV hU,
    apply hx V is_open_V x_in_V,
    intros a a_in_V,
    exact inter_is_not_is_empty_intersection (hV a_in_V) hU,
  }
end

lemma closure_def' : closure A = ⋂₀ {C : set X | is_closed C ∧ A ⊆ C} :=
begin
  rw [closure_eq_compl_of_interior_compl, interior_def', compl_sUnion],
  rw compl_image_set_of,
  simp only [compl_subset_compl, is_closed],
end

@[simp]
lemma subset_closed_inclusion_closure [topological_space X] {A B : set X}  (hB : is_closed B) :
  closure A ⊆ B ↔ A ⊆ B :=
begin
  split,
  {
    have := closure_supset_self A,
    tauto,
  },
  {
    intros h x hx,
    rw closure_def' at hx,
    exact hx B ⟨hB, h⟩
  }
end

lemma subset_closed_inclusion_closure' [topological_space X] {A B : set X}  (hB : is_closed B) :
  A ⊆ B → closure A ⊆ B  := (subset_closed_inclusion_closure hB).mpr

-- Not sure if this should be simp lemma. It is now solvable by simp.
@[simp] lemma closure_is_closed: is_closed (closure A) :=
begin
  simp only [interior_is_open, compl_compl, closure_eq_compl_of_interior_compl, is_closed],
end

@[simp] lemma eq_closure_iff_is_closed: A = closure A ↔ is_closed A:=
begin
  rw ←compl_inj_iff,
  simp only [compl_compl, eq_interior_iff_is_open, closure_eq_compl_of_interior_compl, is_closed],
end

@[simp] lemma closure_closure: closure (closure A) = closure A :=
begin
  simp only [compl_compl, closure_eq_compl_of_interior_compl, interior_interior],
end

lemma interior_inter: interior (A ∩ B) = interior A ∩ interior B :=
begin
  unfold interior is_neighborhood,
  ext,
  simp only [mem_inter_eq, mem_set_of_eq, subset_inter_iff],
  split,
  {
    intro h,
    obtain ⟨U, h1⟩ :=h,
    repeat {use U, tauto},
  },
  {
    rintro ⟨ha, hb⟩,
    obtain ⟨U, ⟨h1,h2,h3⟩⟩ := ha,
    obtain ⟨V, ⟨g1,g2,g3⟩⟩ := hb,
    use U ∩ V,
    repeat {split},
    { exact inter U V h1 g1 },
    repeat {tauto},
    {
      apply subset.trans _ h3,
      apply inter_subset_left,
    },
    {
      apply subset.trans _ g3,
      apply inter_subset_right,
    }
  },
end

def is_open_map {X Y : Type} [topological_space X] [topological_space Y]
(f : X → Y) :=  ∀ (V : set X), is_open V → is_open (f '' V)

def is_closed_map {X Y : Type} [topological_space X] [topological_space Y]
(f : X → Y) :=  ∀ (V : set Y), is_closed V → is_closed (f⁻¹' V)

/-- A function f : X → Y is continuous iff the preimage of every open set is open -/
def is_continuous {X Y : Type} [topological_space X] [topological_space Y]
(f : X → Y) :=  ∀ (V : set Y), is_open V → is_open (f⁻¹' V)

/-- The identity map is continuous. -/
lemma id_is_cont {X: Type} [topological_space X]: is_continuous (λ x : X, x) :=
begin
  tauto,
end

/-- The identity map is open. -/
lemma id_is_open {X: Type} [topological_space X]: is_open_map (λ x : X, x) :=
begin
  intros V hV,
  finish,
end

/-- The identity map is closed. -/
lemma id_is_closed {X: Type} [topological_space X]: is_closed_map (λ x : X, x) :=
begin
  tauto,
end

/-- The constant map is continuous. -/
lemma const_is_cont {X Y: Type} [topological_space X] [topological_space Y] (y: Y)
: is_continuous (λ x : X, y) :=
begin
  intros V hV,
  by_cases y ∈ V,
  {
    convert univ_mem,
    ext,
    tauto,
  },
  {
    convert is_open_empty,
    ext,
    tauto,
  },
end

/-- The composition of continuous maps is continuous. -/
lemma comp_cont {X Y Z: Type} [topological_space X] [topological_space Y] [topological_space Z]
(f: X → Y) (hf: is_continuous f) (g: Y → Z) (hg: is_continuous g): is_continuous (g ∘ f) :=
begin
  intros U hU,
  specialize hg U hU,
  exact hf _ hg,
end

/-- The composition of open maps is open. -/
lemma comp_open {X Y Z: Type} [topological_space X] [topological_space Y] [topological_space Z]
(f: X → Y) (hf: is_open_map f) (g: Y → Z) (hg: is_open_map g): is_open_map (g ∘ f) :=
begin
  intros U hU,
  specialize hf U hU,
  specialize hg _ hf,
  rw image_image at hg,
  exact hg,
end

structure homeomorph (X Y : Type) [topological_space X] [topological_space Y]
  extends X ≃ Y :=
(continuous_to_fun  : is_continuous to_fun)
(continuous_inv_fun : is_continuous inv_fun) -- is_open_map to_fun

notation X `≅` Y := homeomorph X Y

 -- definir subespai i espai quocient
def top_induced (X Y : Type) [topological_space Y] (f : X → Y) : topological_space X :=
{ is_open := λ A, ∃ V, is_open V ∧ f⁻¹' V = A,
  univ_mem := ⟨univ,⟨univ_mem,by tauto⟩⟩,
  union :=
  begin
    rintros A hA,
    use ⋃₀{V : set Y | is_open V ∧ f⁻¹' V ∈ A},
    split,
    {
      rw sUnion,
      apply union,
      intros B hB,
      finish,
    },
    {
      rw preimage_sUnion,
      ext,
      norm_num,
      split,
      { tauto },
      { rintros ⟨U, hU, hx⟩,
        specialize hA U hU,
        rcases hA with ⟨V, hV, hV₂⟩,
        use V,
        rw ←hV₂ at hx hU,
        tauto },
    },
  end,
  inter :=
  begin
    intros A B hA hB,
    cases hA with U hU,
    cases hB with V hV,
    have h : f ⁻¹' (U ∩ V) = A ∩ B,
    {
      rw [← hV.2, ← hU.2],
      refl,
    },
    exact ⟨U ∩ V, inter U V hU.1 hV.1, h⟩,
  end
}

/-- La topologia quocient donada per una aplicació f : X → Y -/
def top_quotient (X Y : Type) [topological_space X] (f : X → Y) : topological_space Y :=
{ is_open := λ V, is_open (f⁻¹' V),
  univ_mem :=
  begin
    norm_num,
  end,
  union :=
  begin
    intros A hA,
    rw preimage_sUnion,
    apply union,
    rintros U ⟨hU, _⟩,
    subst U,
    apply union,
    rintros B ⟨hB, _⟩,
    subst B,
    exact hA hU hB,
  end,
  inter :=
  begin
    intros A B hA hB,
    rw preimage_inter,
    apply inter;
    assumption,
  end,
}

example (A B : set X) : A ⊆ B → interior A ⊆ interior B :=
begin
  intro h,
  apply (interior_is_biggest_open B (interior A) (interior_is_open _)).2,
  have h':= interior_subset_self A,
  tauto
end

end topological_space

-- Lemes previs de Kuratowski clausura i interior preserva inclusió,...
-- Definició de la banda de Möbius, via quocient i via subespai.
--  - demostrar que són homeomorfes.


import ..lectures.love03_forward_proofs_demo

/-! # LoVe Exercise 4: Functional Programming -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Reverse of a List

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

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

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

lemma accurev_eq_reverse_append {α : Type} :
  ∀as xs : list α, accurev as xs = reverse xs ++ as
| as []        := by refl
| as (x :: xs) := by simp [reverse, accurev, accurev_eq_reverse_append _ xs]

/-! 1.2. Derive the desired equation. -/

lemma accurev_eq_reverse {α : Type} (xs : list α) :
  accurev [] xs = reverse xs :=
by simp [accurev_eq_reverse_append]

/-! 1.3. Prove the following property.

Hint: A one-line inductionless proof is possible. -/

lemma accurev_accurev {α : Type} (xs : list α) :
  accurev [] (accurev [] xs) = xs :=
by simp [accurev_eq_reverse, reverse_reverse]

/-! 1.4. Prove the following lemma by structural induction, as a "paper" proof.
This is a good exercise to develop a deeper understanding of how structural
induction works (and is good practice for the final exam).

    lemma accurev_eq_reverse_append {α : Type} :
      ∀as xs : list α, accurev as xs = reverse xs ++ as

Guidelines for paper proofs:

We expect detailed, rigorous, mathematical proofs. You are welcome to use
standard mathematical notation or Lean structured commands (e.g., `assume`,
`have`, `show`, `calc`). You can also use tactical proofs (e.g., `intro`,
`apply`), but then please indicate some of the intermediate goals, so that we
can follow the chain of reasoning.

Major proof steps, including applications of induction and invocation of the
induction hypothesis, must be stated explicitly. For each case of a proof by
induction, you must list the inductive hypotheses assumed (if any) and the goal
to be proved. Minor proof steps corresponding to `refl`, `simp`, or `cc` need
not be justified if you think they are obvious (to humans), but you should say
which key lemmas they depend on. You should be explicit whenever you use a
function definition or an introduction rule for an inductive predicate. -/

/-! We perform the proof by structural induction on `xs` (generalizing `as`).

Case `[]`: The goal is `accurev as [] = reverse [] ++ as`. The left-hand side
is `as` by definition of `accurev`. The right-hand side is `as` by definition
of `reverse` and `++`.

Case `x :: xs`: The goal is `accurev as (x :: xs) = reverse (x :: xs) ++ as`.
The induction hypothesis is `∀as, accurev as xs = reverse xs ++ as`.

Let us simplify the goal's left-hand side:

      accurev as (x :: xs)
    = accurev (x :: as) xs        -- by definition of `accurev`
    = reverse xs ++ (x :: as)     -- by the induction hypothesis

Now let us massage the right-hand side so that it matches the simplified
left-hand side:

      reverse (x :: xs) ++ as
    = (reverse xs ++ [x]) ++ as   -- by definition of `reverse`
    = reverse xs ++ ([x] ++ as)   -- by associativity of `++`
    = reverse xs ++ (x :: as)     -- by definition of `++`

The two sides are equal. QED -/

/-! ## Question 2: Drop and Take

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

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

/-! 2.1. Define the `take` function, which returns a list consisting of the the
first `n` elements at the front of a list.

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

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

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

#eval take 2 ["a", "b", "c"]   -- expected: ["a", "b"]

/-! 2.2. Prove the following lemmas, using `induction'` or pattern matching.
Notice that they are registered as simplification rules thanks to the `@[simp]`
attribute. -/

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

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

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

Hint: Note that there are three variables in the `drop_drop` lemma (but only two
arguments to `drop`). For the third case, `←add_assoc` might be useful. -/

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

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

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

/-! ## Question 3: A Type of λ-Terms

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

    term ::= 'var' string        -- variable (e.g., `x`)
           | 'lam' string term   -- λ-expression (e.g., `λx, t`)
           | 'app' term term     -- application (e.g., `t u`) -/

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

/-! 3.2. Register a textual representation of the type `term` as an instance of
the `has_repr` type class. Make sure to supply enough parentheses to guarantee
that the output is unambiguous. -/

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

@[instance] def term.has_repr : has_repr term :=
{ repr := term.repr }

/-! 3.3. Test your textual representation. The following command should print
something like `(λx, ((y x) x))`. -/

#eval (term.lam "x" (term.app (term.app (term.var "y") (term.var "x"))
    (term.var "x")))

end LoVe


-- BOTH:
import topology.metric_space.basic

/- TEXT:
.. _proving_facts_about_algebraic_structures:

Proving Facts about Algebraic Structures
----------------------------------------

.. index:: order relation, partial order

In :numref:`proving_identities_in_algebraic_structures`,
we saw that many common identities governing the real numbers hold
in more general classes of algebraic structures,
such as commutative rings.
We can use any axioms we want to describe an algebraic structure,
not just equations.
For example, a *partial order* consists of a set with a
binary relation that is reflexive and transitive,
like ``≤`` on the real numbers.
Lean knows about partial orders:
TEXT. -/
section
-- QUOTE:
variables {α : Type*} [partial_order α]
variables x y z : α

-- EXAMPLES:
#check x ≤ y
#check (le_refl x : x ≤ x)
#check (le_trans : x ≤ y → y ≤ z → x ≤ z)
-- QUOTE.

/- TEXT:
Here we are adopting the mathlib convention of using
letters like ``α``, ``β``, and ``γ``
(entered as ``\a``, ``\b``, and ``\g``)
for arbitrary types.
The library often uses letters like ``R`` and ``G``
for the carries of algebraic structures like rings and groups,
respectively,
but in general Greek letters are used for types,
especially when there is little or no structure
associated with them.

Associated to any partial order, ``≤``,
there is also a *strict partial order*, ``<``,
which acts somewhat like ``<`` on the real numbers.
Saying that ``x`` is less than ``y`` in this order
is equivalent to saying that it is less-than-or-equal to ``y``
and not equal to ``y``.
TEXT. -/
-- QUOTE:
#check x < y
#check (lt_irrefl x : ¬ x < x)
#check (lt_trans : x < y → y < z → x < z)
#check (lt_of_le_of_lt : x ≤ y → y < z → x < z)
#check (lt_of_lt_of_le : x < y → y ≤ z → x < z)

example : x < y ↔ x ≤ y ∧ x ≠ y :=
lt_iff_le_and_ne
-- QUOTE.

end

/- TEXT:
In this example, the symbol ``∧`` stands for "and,"
the symbol ``¬`` stands for "not," and
``x ≠ y`` abbreviates ``¬ (x = y)``.
In :numref:`Chapter %s <logic>`, you will learn how to use
these logical connectives to *prove* that ``<``
has the properties indicated.

.. index:: lattice

A *lattice* is a structure that extends a partial
order with operations ``⊓`` and ``⊔`` that are
analogous to ``min`` and ``max`` on the real numbers:
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {α : Type*} [lattice α]
variables x y z : α

-- EXAMPLES:
#check x ⊓ y
#check (inf_le_left : x ⊓ y ≤ x)
#check (inf_le_right : x ⊓ y ≤ y)
#check (le_inf : z ≤ x → z ≤ y → z ≤ x ⊓ y)

#check x ⊔ y
#check (le_sup_left : x ≤ x ⊔ y)
#check (le_sup_right: y ≤ x ⊔ y)
#check (sup_le : x ≤ z → y ≤ z → x ⊔ y ≤ z)
-- QUOTE.

/- TEXT:
The characterizations of ``⊓`` and ``⊔`` justify calling them
the *greatest lower bound* and *least upper bound*, respectively.
You can type them in VS code using ``\glb`` and ``\lub``.
The symbols are also often called then *infimum* and
the *supremum*,
and mathlib refers to them as ``inf`` and ``sup`` in
theorem names.
To further complicate matters,
they are also often called *meet* and *join*.
Therefore, if you work with lattices,
you have to keep the following dictionary in mind:

* ``⊓`` is the *greatest lower bound*, *infimum*, or *meet*.

* ``⊔`` is the *least upper bound*, *supremum*, or *join*.

Some instances of lattices include:

* ``min`` and ``max`` on any total order, such as the integers or real numbers with ``≤``

* ``∩`` and ``∪`` on the collection of subsets of some domain, with the ordering ``⊆``

* ``∧`` and ``∨`` on boolean truth values, with ordering ``x ≤ y`` if either ``x`` is false or ``y`` is true

* ``gcd`` and ``lcm`` on the natural numbers (or positive natural numbers), with the divisibility ordering, ``∣``

* the collection of linear subspaces of a vector space,
  where the greatest lower bound is given by the intersection,
  the least upper bound is given by the sum of the two spaces,
  and the ordering is inclusion

* the collection of topologies on a set (or, in Lean, a type),
  where the greatest lower bound of two topologies consists of
  the topology that is generated by their union,
  the least upper bound is their intersection,
  and the ordering is reverse inclusion

You can check that, as with ``min`` / ``max`` and ``gcd`` / ``lcm``,
you can prove the commutativity and associativity of the infimum and supremum
using only their characterizing axioms,
together with ``le_refl`` and ``le_trans``.
TEXT. -/
-- QUOTE:
example : x ⊓ y = y ⊓ x := sorry
example : x ⊓ y ⊓ z = x ⊓ (y ⊓ z) := sorry
example : x ⊔ y = y ⊔ x := sorry
example : x ⊔ y ⊔ z = x ⊔ (y ⊔ z) := sorry
-- QUOTE.

-- SOLUTIONS:
example : x ⊓ y = y ⊓ x :=
begin
  apply le_antisymm,
  repeat {
    apply le_inf,
    { apply inf_le_right },
    apply inf_le_left }
end

example : x ⊓ y ⊓ z = x ⊓ (y ⊓ z) :=
begin
  apply le_antisymm,
  { apply le_inf,
    { apply le_trans,
      apply inf_le_left,
      apply inf_le_left },
    apply le_inf,
    { apply le_trans,
      apply inf_le_left,
      apply inf_le_right },
    apply inf_le_right  },
  apply le_inf,
  { apply le_inf,
    { apply inf_le_left },
    apply le_trans,
    apply inf_le_right,
    apply inf_le_left },
  apply le_trans,
  apply inf_le_right,
  apply inf_le_right
end

example : x ⊔ y = y ⊔ x :=
begin
  apply le_antisymm,
  repeat {
    apply sup_le,
    { apply le_sup_right },
    apply le_sup_left }
end

example : x ⊔ y ⊔ z = x ⊔ (y ⊔ z) :=
begin
  apply le_antisymm,
  { apply sup_le,
    { apply sup_le,
      apply le_sup_left,
      { apply le_trans,
        apply @le_sup_left _ _ y z,
        apply le_sup_right } },
    apply le_trans,
    apply @le_sup_right _ _ y z,
    apply le_sup_right },
  apply sup_le,
  { apply le_trans,
    apply @le_sup_left _ _ x y,
    apply le_sup_left },
  apply sup_le,
  { apply le_trans,
    apply @le_sup_right _ _ x y,
    apply le_sup_left },
  apply le_sup_right
end

/- TEXT:
You can find these theorems in the mathlib as ``inf_comm``, ``inf_assoc``,
``sup_comm``, and ``sup_assoc``, respectively.

Another good exercise is to prove the *absorption laws*
using only those axioms:
TEXT. -/
-- QUOTE:
theorem absorb1 : x ⊓ (x ⊔ y) = x := sorry
theorem absorb2 : x ⊔ (x ⊓ y) = x := sorry
-- QUOTE.

-- SOLUTIONS:
theorem absorb1αα : x ⊓ (x ⊔ y) = x :=
begin
  apply le_antisymm,
  { apply inf_le_left },
  apply le_inf,
  { apply le_refl },
  apply le_sup_left
end

theorem absorb2αα : x ⊔ (x ⊓ y) = x :=
begin
  apply le_antisymm,
  { apply sup_le,
    { apply le_refl },
    apply inf_le_left },
  apply le_sup_left
end

-- BOTH:
end

/- TEXT:
These can be found in mathlib with the names ``inf_sup_self`` and ``sup_inf_self``.

A lattice that satisfies the additional identities
``x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z)`` and
``x ⊔ (y ⊓ z) = (x ⊔ y) ⊓ (x ⊔ z)``
is called a *distributive lattice*. Lean knows about these too:
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {α : Type*} [distrib_lattice α]
variables x y z : α

#check (inf_sup_left : x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z))
#check (inf_sup_right : (x ⊔ y) ⊓ z = (x ⊓ z) ⊔ (y ⊓ z))
#check (sup_inf_left : x ⊔ (y ⊓ z) = (x ⊔ y) ⊓ (x ⊔ z))
#check (sup_inf_right : (x ⊓ y) ⊔ z = (x ⊔ z) ⊓ (y ⊔ z))
-- QUOTE.

end

/- TEXT:
The left and right versions are easily shown to be
equivalent, given the commutativity of ``⊓`` and ``⊔``.
It is a good exercise to show that not every lattice
is distributive
by providing an explicit description of a
nondistributive lattice with finitely many elements.
It is also a good exercise to show that in any lattice,
either distributivity law implies the other:
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {α : Type*} [lattice α]
variables a b c : α

-- EXAMPLES:
example (h : ∀ x y z : α, x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z)) :
  a ⊔ (b ⊓ c) = (a ⊔ b) ⊓ (a ⊔ c) :=
sorry

example (h : ∀ x y z : α, x ⊔ (y ⊓ z) = (x ⊔ y) ⊓ (x ⊔ z)) :
  a ⊓ (b ⊔ c) = (a ⊓ b) ⊔ (a ⊓ c) :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : ∀ x y z : α, x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z)) :
  a ⊔ (b ⊓ c) = (a ⊔ b) ⊓ (a ⊔ c) :=
by rw [h, @inf_comm _ _ (a ⊔ b), absorb1, @inf_comm _ _ (a ⊔ b), h,
    ←sup_assoc, @inf_comm _ _ c a, absorb2, inf_comm]

example (h : ∀ x y z : α, x ⊔ (y ⊓ z) = (x ⊔ y) ⊓ (x ⊔ z)) :
  a ⊓ (b ⊔ c) = (a ⊓ b) ⊔ (a ⊓ c) :=
by rw [h, @sup_comm _ _ (a ⊓ b), absorb2, @sup_comm _ _ (a ⊓ b), h,
    ←inf_assoc, @sup_comm _ _ c a, absorb1, sup_comm]

-- BOTH:
end

/- TEXT:
It is possible to combine axiomatic structures into larger ones.
For example, an *ordered ring* consists of a commutative ring together
with a partial order on the carrier
satisfying additional axioms that say that the ring operations
are compatible with the order:
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {R : Type*} [ordered_ring R]
variables a b c : R

-- EXAMPLES:
#check (add_le_add_left : a ≤ b → ∀ c, c + a ≤ c + b)
#check (mul_pos : 0 < a → 0 < b → 0 < a * b)
-- QUOTE.

/- TEXT:
:numref:`Chapter %s <logic>` will provide the means to derive the following from ``mul_pos``
and the definition of ``<``:
TEXT. -/
-- QUOTE:
#check (mul_nonneg : 0 ≤ a → 0 ≤ b → 0 ≤ a * b)
-- QUOTE.

/- TEXT:
It is then an extended exercise to show that many common facts
used to reason about arithmetic and the ordering on the real
numbers hold generically for any ordered ring.
Here are a couple of examples you can try,
using only properties of rings, partial orders, and the facts
enumerated in the last two examples:
TEXT. -/
-- QUOTE:
example : a ≤ b → 0 ≤ b - a := sorry

example : 0 ≤ b - a → a ≤ b := sorry

example (h : a ≤ b) (h' : 0 ≤ c) : a * c ≤ b * c := sorry
-- QUOTE.

-- SOLUTIONS:
theorem aux1 : a ≤ b → 0 ≤ b - a :=
begin
  intro h,
  rw [←sub_self a, sub_eq_add_neg, sub_eq_add_neg, add_comm, add_comm b],
  apply add_le_add_left h
end

theorem aux2 : 0 ≤ b - a → a ≤ b :=
begin
  intro h,
  rw [←add_zero a, ←sub_add_cancel b a, add_comm (b - a)],
  apply add_le_add_left h
end

example (h : a ≤ b) (h' : 0 ≤ c) : a * c ≤ b * c :=
begin
  have h1 : 0 ≤ (b - a) * c,
  { exact mul_nonneg (aux1 _ _ h) h' },
  rw sub_mul at h1,
  exact aux2 _ _ h1
end

-- BOTH:
end

/- TEXT:
.. index:: metric space

Finally, here is one last example.
A *metric space* consists of a set equipped with a notion of
distance, ``dist x y``,
mapping any pair of elements to a real number.
The distance function is assumed to satisfy the following axioms:
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {X : Type*} [metric_space X]
variables x y z : X

-- EXAMPLES:
#check (dist_self x : dist x x = 0)
#check (dist_comm x y : dist x y = dist y x)
#check (dist_triangle x y z : dist x z ≤ dist x y + dist y z)
-- QUOTE.

/- TEXT:
Having mastered this section,
you can show that it follows from these axioms that distances are
always nonnegative:
TEXT. -/
-- QUOTE:
example (x y : X) : 0 ≤ dist x y := sorry
-- QUOTE.

-- SOLUTIONS:
example (x y : X) : 0 ≤ dist x y :=
begin
  have : 0 ≤ dist x y + dist y x,
  { rw [←dist_self x],
    apply dist_triangle },
  linarith [dist_comm x y]
end

-- BOTH:
end

/- TEXT:
We recommend making use of the theorem ``nonneg_of_mul_nonneg_left``.
As you may have guessed, this theorem is called ``dist_nonneg`` in mathlib.
TEXT. -/