import data.real.basic tactic

namespace OSN2015_P4

-- We represent a function ℝ+ → ℝ+ as a function ℝ → ℝ that takes positive values at positive inputs
def fn_pos (f : ℝ → ℝ) := ∀ x : ℝ, 0 < x -> 0 < f x
def fn_eq (f g : ℝ → ℝ) (c : ℝ) (_ : 0 < c) := ∀ x y : ℝ, 0 < x → 0 < y → f(g x * y + f x) = (y + c) * f x

---- Part a: We generalize, replacing 2015 by an arbitrary positive real number c
lemma lem1_1 : ∀ (f g : ℝ → ℝ) (c : ℝ) (X : 0 < c) (_ : fn_pos f) (_ : fn_pos g),
  fn_eq f g c X → ∀ x y : ℝ, 0 < x → f x < y → f y = f x * (g x)⁻¹ * y + (c - f x * (g x)⁻¹) * f x :=
begin
  intros f g c X h h0 h1 x y h2 h3,
  have h4 := (h0 x h2),
  calc f y = f(g x * ((y - f x) * (g x)⁻¹) + f x) : _
  ... = ((y - f x) * (g x)⁻¹ + c) * f x : _
  ... = f x * (g x)⁻¹ * y + (c - f x * (g x)⁻¹) * f x : by ring,
  { apply congr_arg,
    rw [mul_comm, mul_assoc, (mul_comm _ (g x)), mul_inv_cancel, mul_one, sub_add_cancel],
    apply (ne_of_gt h4), },
  { rwa h1,
    apply real.mul_pos,
    { rwa sub_pos, },
    { rwa inv_pos, }, },
end

lemma lem1_2 : ∀ a b c d : ℝ, (∃ M : ℝ, ∀ y : ℝ, M < y → a * y + b = c * y + d) → a = c ∧ b = d :=
begin
  intros a b c d h,
  cases h with M h,
  have h1 : M < M + 1 := by norm_num,
  have h2 : M < M + 2 := by norm_num,
  have h3 := (h (M + 1) h1),
  have h4 : a = c,
  { calc a = (a * (M + 2) + b) - (a * (M + 1) + b) : by ring
    ... = (c * (M + 2) + d) - (c * (M + 1) + d) : by rw [h3, (h (M + 2) h2)]
    ... = c : by ring, },
  rw [h4, add_right_inj] at h3,
  split; assumption,
end

lemma lem1_3 : ∀ (f g : ℝ → ℝ) (c : ℝ) (X : 0 < c), fn_pos f → fn_pos g → fn_eq f g c X →
  ∃ m1 m2 : ℝ, ∀ a : ℝ, 0 < a → f a * (g a)⁻¹ = m1 ∧ (c - m1) * f a = m2 :=
begin
  intros f g c X h h0 h1,
  suffices : (∃ m1 m2 : ℝ, ∀ a : ℝ, 0 < a → f a * (g a)⁻¹ = m1 ∧ (c - f a * (g a)⁻¹) * f a = m2),
  { cases this with m1 this,
    cases this with m2 this,
    use [m1, m2],
    intros a h2,
    split,
    exact and.left (this a h2),
    rwa ← and.left (this a h2),
    exact and.right (this a h2), },
  use [f 1 * (g 1)⁻¹, (c - f 1 * (g 1)⁻¹) * f 1],
  intros a h2,
  apply lem1_2; use [max (f 1) (f a)],
  intros y h3,
  rw [←lem1_1 f g c X h h0 h1 1 y zero_lt_one, ←lem1_1 f g c X h h0 h1 a y h2],
  all_goals {apply lt_of_le_of_lt _ h3},
  exact le_max_right (f 1) (f a),
  exact le_max_left (f 1) (f a),
end

theorem osn2015_4a : ∀ (f g : ℝ → ℝ) (c : ℝ) (X : 0 < c), fn_pos f → fn_pos g → fn_eq f g c X →
  ∀ x : ℝ, 0 < x → f x = c * g x :=
begin
  intros f g c X h h0 h1,
  cases (lem1_3 f g c X h h0 h1) with m1 h2; cases h2 with m2 h2,

  suffices : (m1 = c),
  { intros x h3,
    rw [← this, ← and.left (h2 x h3), mul_assoc, inv_mul_cancel, mul_one],
    apply ne_of_gt,
    exact (h0 x h3), },

  suffices : (∃ a b : ℝ, 0 < a ∧ 0 < b ∧ f a ≠ f b),
  { cases this with a this; cases this with b this,
    have h3 := and.right (h2 a (and.left this)),
    rw [← and.right (h2 b (and.left (and.right this))), ← sub_eq_zero, ← mul_sub] at h3,
    rw [mul_eq_zero, sub_eq_zero, sub_eq_zero] at h3,
    cases h3,
    { rw h3, },
    { have h4 := and.right (and.right this),
      contradiction, }, },

  use [g 1 * 1 + f 1, g 1 * 2 + f 1],
  repeat {split},
  -- For the two inequalities
  any_goals {
    apply add_pos,
    apply mul_pos,
    apply h0,
    any_goals { apply h, },
    all_goals { norm_num, },
  },

  rw [h1, h1],
  norm_num,
  apply ne_of_gt,
  apply h,
  all_goals { norm_num, },
end

---- Part b: to implement the solution, we need to provide a proof that 0 < 2015
---- Also note that in this solution, f and g are defined on ℝ, not just on ℝ+
lemma zero_lt_2015 : 0 < (2015 : ℝ) :=
begin
  by norm_num,
end

theorem osn2015_4b : fn_eq (λ x, 2015 * max x 1) (λ x, max x 1) 2015 zero_lt_2015 :=
begin
  intros x y h h0,
  simp,
  rw [mul_comm (y + 2015), mul_assoc, mul_comm 2015 (max x 1), ← mul_add],
  apply congr_arg,
  apply max_eq_left,
  have h1 : 1 ≤ max x 1 * 1 := by rw mul_one; apply le_max_right,
  apply le_trans h1,
  rw mul_le_mul_left,
  { apply le_of_lt,
    apply lt_trans _ (lt_add_of_pos_left 2015 h0),
    norm_num, },
  { rw mul_one at h1,
    exact lt_of_lt_of_le zero_lt_one h1, },
end

end OSN2015_P4


-- Exercise 1
-- Define the function Do_Twice, as described in Section 2.4.
def double_ (a : ℕ) : ℕ := a + a
def double : ℕ → ℕ := λ x, x + x
def square : ℕ → ℕ := λ x, x * x

def times2plus1 : ℕ → ℕ := λ x, x * 2 + 1

def do_twice_ (f : ℕ → ℕ) (x : ℕ) : ℕ := f (f x)
def do_twice : (ℕ → ℕ) → ℕ → ℕ := λ f x, f (f x)
def do_three_times : (ℕ → ℕ) → ℕ → ℕ := λ f x, f (f (f x))

#check do_twice
#reduce do_three_times square 2 -- 256
#reduce do_twice square 2 -- 16

def quadruple : ℕ → ℕ := λ x, do_twice double x

#reduce quadruple 2 -- 8

-- Do_Twice
-- if (f: (ℕ → ℕ) → (ℕ → ℕ)) is a function that applies
-- (g : ℕ → ℕ) on its argument x A times,
-- then (Do_Twice f g) applies g on its argument A² times.
def Do_Twice (f : (ℕ → ℕ) → (ℕ → ℕ)) (x : ℕ → ℕ) : ℕ → ℕ := f (f x)
def Do_Twice_ : ((ℕ → ℕ) → (ℕ → ℕ)) → (ℕ → ℕ) → (ℕ → ℕ) :=
    λ f x, f (f x)

-- Another version of Do_Twice
-- if (f: (ℕ → ℕ) → (ℕ → ℕ))
-- is a function that applies (g : ℕ → ℕ) on its argument A times,
-- then (Do_Twice f g) applies g on its argument 2A times.
def Do_Twice' : ((ℕ → ℕ) → (ℕ → ℕ)) → (ℕ → ℕ) → (ℕ → ℕ) :=
    λ f g x, f g (f g x)
def Do_Twice'_ (f: (ℕ → ℕ) → (ℕ → ℕ)) (g: ℕ → ℕ) (x : ℕ) : ℕ :=
    f g (f g x)

-- count the number of ℕ → ℕ being applied, you'll find that there're 3^2=9 of them.
#reduce Do_Twice do_three_times

-- count the number of ℕ → ℕ being applied, you'll find that there're 3*2=6 of them.
#reduce Do_Twice' do_three_times

#reduce Do_Twice do_twice double 2 -- 32
#eval Do_Twice do_twice times2plus1 2 -- 47
#eval Do_Twice do_three_times times2plus1 2 -- 1535
#eval (((((((((2*2)+1)*2+1)*2+1)*2+1)*2+1)*2+1)*2+1)*2+1)*2+1 -- 1535 : (x*2+1) being applied (3^3=9) times
#eval Do_Twice do_twice square 2 -- 65536

#reduce do_three_times square 2 -- 256
#eval Do_Twice' do_three_times square 2 -- 18446744073709551616
#eval (((((2^2)^2)^2)^2)^2)^2 -- 18446744073709551616
#eval Do_Twice do_twice square 2 -- 65536

-- Exercise 2
-- Define the functions curry and uncurry, as described in Section 2.4.
def compose (α β γ : Type) (g : β → γ) (f : α → β) (x : α) : γ := g (f x)

def curry (α β γ : Type): (α × β → γ) → α → β → γ := λ f a b, f (a, b)

def uncurry (α β γ : Type): (α → β → γ) → α × β → γ := λ f ⟨a, b⟩, f a b

-- Exercise 3
-- Above, we used the example vec α n for vectors of elements
-- of type α of length n. Declare a constant vec_add that could
-- represent a function that adds two vectors of natural numbers
-- of the same length, and a constant vec_reverse that can represent
-- a function that reverses its argument.
-- Use implicit arguments for parameters that can be inferred.
-- Declare some variables and check some expressions involving
-- the constants that you have declared.

universe u
constant vec : Type u → ℕ → Type u

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

constant vec_add :
    Π {m : ℕ},  vec ℕ m → vec ℕ m → vec ℕ m

constant vec_reverse :
    Π {α : Type u} {m : ℕ}, vec α m → vec α m

variable vecA : vec ℕ 4
variable vecB : vec ℕ 4
variable vecC : vec ℕ 5
#check vec_add vecA vecB
#check vec_reverse vecA
#check vec_add (vec.cons 1 vecA) vecC

-- Exercise 4
-- Similarly, declare a constant matrix so that matrix α m n could
-- represent the type of m by n matrices. Declare some constants
-- to represent functions on this type, such as matrix addition and
-- multiplication, and (using vec) multiplication of a matrix by a vector.
-- Once again, declare some variables and check some expressions involving
-- the constants that you have declared.

constant matrix : Type u → ℕ → ℕ → Type u

namespace matrix
    constant empty : Π α : Type u, matrix α 0 0
    constant add :
        Π {α : Type u} {m n : ℕ},
            matrix α m n → matrix α m n → matrix α m n
    constant multiply :
        Π {α : Type u} {m n p: ℕ},
            matrix α m n → matrix α n p → matrix α m p
    constant multiply_by_vec :
        Π {α : Type u} {m n: ℕ},
            matrix α m n → vec α n → vec α m
end matrix

variable matA : matrix ℕ 5 4
variable matB : matrix ℕ 4 3
variable matC : matrix ℕ 4 3

#check matrix.add matB matC
#check matrix.multiply matA matB
#check matrix.multiply_by_vec matA vecA


/-
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 6 : "or" (∨`)

We learn about how to manipulate `P ∨ Q` in Lean.

## Tactics

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

* `left` and `right`
* `cases` (new functionality)

### The `left` and `right` tactics.

If your goal is `⊢ P ∨ Q` then `left,` will change it to `⊢ P`
and `right,` will change it to `⊢ Q`.

### The `cases` tactic again

If we have `h : P ∨ Q` as a hypothesis then `cases h with hP hQ`
will turn your goal into two goals, one with `hP : P` as a hypothesis
and the other with `hQ : Q`.

-/

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

variables (P Q R S : Prop)

example : P → P ∨ Q :=
begin
  sorry
end

example : Q → P ∨ Q :=
begin
  sorry,
end

example : P ∨ Q → (P → R) → (Q → R) → R :=
begin
  sorry
end

-- symmetry of `or`
example : P ∨ Q → Q ∨ P :=
begin
  sorry
end

-- associativity of `or`
example : (P ∨ Q) ∨ R ↔ P ∨ (Q ∨ R) :=
begin
  sorry,
end

example : (P → R) → (Q → S) → P ∨ Q → R ∨ S :=
begin
  sorry,
end

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

example : (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S) :=
begin
  sorry,
end

-- de Morgan's laws
example : ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q :=
begin
  sorry
end

example : ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q :=
begin
  sorry
end


/-
Copyright (c) 2022 Antoine Labelle. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Antoine Labelle
-/
import representation_theory.fdRep
import linear_algebra.trace
import representation_theory.invariants

/-!
# Characters of representations

This file introduces characters of representation and proves basic lemmas about how characters
behave under various operations on representations.

# TODO
* Once we have the monoidal closed structure on `fdRep k G` and a better API for the rigid
structure, `char_dual` and `char_lin_hom` should probably be stated in terms of `Vᘁ` and `ihom V W`.
-/

noncomputable theory

universes u

open category_theory linear_map category_theory.monoidal_category representation finite_dimensional
open_locale big_operators

variables {k : Type u} [field k]

namespace fdRep

section monoid

variables {G : Type u} [monoid G]

/-- The character of a representation `V : fdRep k G` is the function associating to `g : G` the
trace of the linear map `V.ρ g`.-/
def character (V : fdRep k G) (g : G) := linear_map.trace k V (V.ρ g)

lemma char_mul_comm (V : fdRep k G) (g : G) (h : G) : V.character (h * g) = V.character (g * h) :=
by simp only [trace_mul_comm, character, map_mul]

@[simp] lemma char_one  (V : fdRep k G) : V.character 1 = finite_dimensional.finrank k V :=
by simp only [character, map_one, trace_one]

/-- The character is multiplicative under the tensor product. -/
@[simp] lemma char_tensor (V W : fdRep k G) : (V ⊗ W).character = V.character * W.character :=
by { ext g, convert trace_tensor_product' (V.ρ g) (W.ρ g) }

/-- The character of isomorphic representations is the same. -/
lemma char_iso  {V W : fdRep k G} (i : V ≅ W) : V.character = W.character :=
by { ext g, simp only [character, fdRep.iso.conj_ρ i], exact (trace_conj' (V.ρ g) _).symm }

end monoid

section group

variables {G : Type u} [group G]

/-- The character of a representation is constant on conjugacy classes. -/
@[simp] lemma char_conj (V : fdRep k G) (g : G) (h : G) :
  V.character (h * g * h⁻¹) = V.character g :=
by rw [char_mul_comm, inv_mul_cancel_left]

@[simp] lemma char_dual (V : fdRep k G) (g : G) : (of (dual V.ρ)).character g = V.character g⁻¹ :=
  trace_transpose' (V.ρ g⁻¹)

@[simp] lemma char_lin_hom (V W : fdRep k G) (g : G) :
  (of (lin_hom V.ρ W.ρ)).character g = (V.character g⁻¹) * (W.character g) :=
by rw [←char_iso (dual_tensor_iso_lin_hom _ _), char_tensor, pi.mul_apply, char_dual]

variables [fintype G] [invertible (fintype.card G : k)]

theorem average_char_eq_finrank_invariants (V : fdRep k G) :
  ⅟(fintype.card G : k) • ∑ g : G, V.character g = finrank k (invariants V.ρ) :=
by { rw ←(is_proj_average_map V.ρ).trace, simp [character, group_algebra.average, _root_.map_sum], }

end group

section orthogonality

variables {G : Group.{u}} [is_alg_closed k]

open_locale classical

variables [fintype G] [invertible (fintype.card G : k)]

/-- Orthogonality of characters for irreducible representations of finite group over an
algebraically closed field whose characteristic doesn't divide the order of the group. -/
lemma char_orthonormal (V W : fdRep k G) [simple V] [simple W] :
  ⅟(fintype.card G : k) • ∑ g : G, V.character g * W.character g⁻¹ =
  if nonempty (V ≅ W) then ↑1 else ↑0 :=
begin
  -- First, we can rewrite the summand `V.character g * W.character g⁻¹` as the character
  -- of the representation `V ⊗ W* ≅ Hom(W, V)` applied to `g`.
  conv in (V.character _ * W.character _)
  { rw [mul_comm, ←char_dual, ←pi.mul_apply, ←char_tensor],
    rw [char_iso (fdRep.dual_tensor_iso_lin_hom W.ρ V)], } ,

  -- The average over the group of the character of a representation equals the dimension of the
  -- space of invariants.
  rw average_char_eq_finrank_invariants,
  rw [show (of (lin_hom W.ρ V.ρ)).ρ = lin_hom W.ρ V.ρ, from fdRep.of_ρ (lin_hom W.ρ V.ρ)],

  -- The space of invariants of `Hom(W, V)` is the subspace of `G`-equivariant linear maps,
  -- `Hom_G(W, V)`.
  rw (lin_hom.invariants_equiv_fdRep_hom W V).finrank_eq,

  -- By Schur's Lemma, the dimension of `Hom_G(W, V)` is `1` is `V ≅ W` and `0` otherwise.
  rw_mod_cast [finrank_hom_simple_simple W V, iso.nonempty_iso_symm],
end

end orthogonality

end fdRep


/-
# Proposition world.

## Level 5 : `P → (Q → P)`.

In this level, our goal is to construct an implication, like in level 2.

```
⊢ P → (Q → P)
```

So $P$ and $Q$ are propositions, and our goal is to prove
that $P\implies(Q\implies P)$.
We don't know whether $P$, $Q$ are true or false, so initially
this seems like a bit of a tall order. But let's give it a go. Delete
the `sorry` and let's think about how to proceed.

Our goal is `P → X` for some true/false statement $X$, and if our
goal is to construct an implication then we almost always want to use the
`intro` tactic from level 2, Lean's version of "assume $P$", or more precisely
"assume $p$ is a proof of $P$". So let's start with

`intro p,`

and we then find ourselves in this state:

```
P Q : Prop,
p : P
⊢ Q → P
```

We now have a proof $p$ of $P$ and we are supposed to be constructing
a proof of $Q\implies P$. So let's assume that $Q$ is true and try
and prove that $P$ is true. We assume $Q$ like this:

`intro q,`

and now we have to prove $P$, but have a proof handy:

`exact p,`
-/

/- Lemma : no-side-bar
For any propositions $P$ and $Q$, we always have
$P\implies(Q\implies P)$.
-/
example (P Q : Prop) : P → (Q → P) :=
begin
  intro p,
  intro q,
  exact p,

end

/-
A mathematician would treat the proposition $P\implies(Q\implies P)$
as the same as the proposition $P\land Q\implies P$,
because to give a proof of either of these is just to give a method which takes
a proof of $P$ and a proof of $Q$, and returns a proof of $P$. Thinking of the
goal as $P\land Q\implies P$ we see why it is provable.

## Did you notice?

I wrote `P → (Q → P)` but Lean just writes `P → Q → P`. This is because
computer scientists adopt the convention that `→` is *right associative*,
which is a fancy way of saying "when we write `P → Q → R`, we mean `P → (Q → R)`.
Mathematicians would never dream of writing something as ambiguous as
$P\implies Q\implies R$ (they are not really interested in proving abstract
propositions, they would rather work with concrete ones such as Fermat's Last Theorem),
so they do not have a convention for where the brackets go. It's important to
remember Lean's convention though, or else you will get confused. If your goal
is `P → Q → R` then you need to know whether `intro h` will create `h : P` or `h : P → Q`.
Make sure you understand which one.
-/


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.big_operators.intervals
import algebra.geom_sum
import data.nat.bitwise
import data.nat.log
import data.nat.parity
import ring_theory.int.basic

/-!
# Natural number multiplicity

This file contains lemmas about the multiplicity function (the maximum prime power dividing a
number) when applied to naturals, in particular calculating it for factorials and binomial
coefficients.

## Multiplicity calculations

* `nat.multiplicity_factorial`: Legendre's Theorem. The multiplicity of `p` in `n!` is
  `n/p + ... + n/p^b` for any `b` such that `n/p^(b + 1) = 0`.
* `nat.multiplicity_factorial_mul`: The multiplicity of `p` in `(p * n)!` is `n` more than that of
  `n!`.
* `nat.multiplicity_choose`: The multiplicity of `p` in `n.choose k` is the number of carries when
  `k` and`n - k` are added in base `p`.

## Other declarations

* `nat.multiplicity_eq_card_pow_dvd`: The multiplicity of `m` in `n` is the number of positive
  natural numbers `i` such that `m ^ i` divides `n`.
* `nat.multiplicity_two_factorial_lt`: The multiplicity of `2` in `n!` is strictly less than `n`.
* `nat.prime.multiplicity_something`: Specialization of `multiplicity.something` to a prime in the
  naturals. Avoids having to provide `p ≠ 1` and other trivialities, along with translating between
  `prime` and `nat.prime`.

## Tags

Legendre, p-adic
-/

open finset nat multiplicity
open_locale big_operators nat

namespace nat

/-- The multiplicity of `m` in `n` is the number of positive natural numbers `i` such that `m ^ i`
divides `n`. This set is expressed by filtering `Ico 1 b` where `b` is any bound greater than
`log m n`. -/
lemma multiplicity_eq_card_pow_dvd {m n b : ℕ} (hm : m ≠ 1) (hn : 0 < n) (hb : log m n < b):
  multiplicity m n = ↑((finset.Ico 1 b).filter (λ i, m ^ i ∣ n)).card :=
calc
  multiplicity m n = ↑(Ico 1 $ ((multiplicity m n).get (finite_nat_iff.2 ⟨hm, hn⟩) + 1)).card
    : by simp
... = ↑((finset.Ico 1 b).filter (λ i, m ^ i ∣ n)).card
    : congr_arg coe $ congr_arg card $ finset.ext $ λ i,
      begin
        rw [mem_filter, mem_Ico, mem_Ico, lt_succ_iff, ←@enat.coe_le_coe i, enat.coe_get,
          ←pow_dvd_iff_le_multiplicity, and.right_comm],
        refine (and_iff_left_of_imp (λ h, _)).symm,
        cases m,
        { rw [zero_pow, zero_dvd_iff] at h,
          exact (hn.ne' h.2).elim,
          { exact h.1 } },
        exact ((pow_le_iff_le_log (succ_lt_succ $ nat.pos_of_ne_zero $ succ_ne_succ.1 hm) hn).1 $
          le_of_dvd hn h.2).trans_lt hb,
      end

namespace prime

lemma multiplicity_mul {p m n : ℕ} (hp : p.prime) :
  multiplicity p (m * n) = multiplicity p m + multiplicity p n :=
multiplicity.mul $ prime_iff.mp hp

lemma multiplicity_pow {p m n : ℕ} (hp : p.prime) :
  multiplicity p (m ^ n) = n • (multiplicity p m) :=
multiplicity.pow $ prime_iff.mp hp

lemma multiplicity_self {p : ℕ} (hp : p.prime) : multiplicity p p = 1 :=
multiplicity_self (prime_iff.mp hp).not_unit hp.ne_zero

lemma multiplicity_pow_self {p n : ℕ} (hp : p.prime) : multiplicity p (p ^ n) = n :=
multiplicity_pow_self hp.ne_zero (prime_iff.mp hp).not_unit n

/-- **Legendre's Theorem**

The multiplicity of a prime in `n!` is the sum of the quotients `n / p ^ i`. This sum is expressed
over the finset `Ico 1 b` where `b` is any bound greater than `log p n`. -/
lemma multiplicity_factorial {p : ℕ} (hp : p.prime) :
  ∀ {n b : ℕ}, log p n < b → multiplicity p n! = (∑ i in Ico 1 b, n / p ^ i : ℕ)
| 0     b hb := by simp [Ico, hp.multiplicity_one]
| (n+1) b hb :=
  calc multiplicity p (n+1)! = multiplicity p n! + multiplicity p (n+1) :
    by rw [factorial_succ, hp.multiplicity_mul, add_comm]
  ... = (∑ i in Ico 1 b, n / p ^ i : ℕ) + ((finset.Ico 1 b).filter (λ i, p ^ i ∣ n+1)).card :
    by rw [multiplicity_factorial ((log_le_log_of_le $ le_succ _).trans_lt hb),
      ← multiplicity_eq_card_pow_dvd hp.ne_one (succ_pos _) hb]
  ... = (∑ i in Ico 1 b, (n / p ^ i + if p^i ∣ n+1 then 1 else 0) : ℕ) :
    by { rw [sum_add_distrib, sum_boole], simp }
  ... = (∑ i in Ico 1 b, (n + 1) / p ^ i : ℕ) :
    congr_arg coe $ finset.sum_congr rfl $ λ _ _, (succ_div _ _).symm

/-- The multiplicity of `p` in `(p * (n + 1))!` is one more than the sum
  of the multiplicities of `p` in `(p * n)!` and `n + 1`. -/
lemma multiplicity_factorial_mul_succ {n p : ℕ} (hp : p.prime) :
  multiplicity p (p * (n + 1))! = multiplicity p (p * n)! + multiplicity p (n + 1) + 1 :=
begin
  have hp' := prime_iff.mp hp,
  have h0 : 2 ≤ p := hp.two_le,
  have h1 : 1 ≤ p * n + 1 := nat.le_add_left _ _,
  have h2 : p * n + 1 ≤ p * (n + 1), linarith,
  have h3 : p * n + 1 ≤ p * (n + 1) + 1, linarith,
  have hm : multiplicity p (p * n)! ≠ ⊤,
  { rw [ne.def, eq_top_iff_not_finite, not_not, finite_nat_iff],
    exact ⟨hp.ne_one, factorial_pos _⟩ },
  revert hm,
  have h4 : ∀ m ∈ Ico (p * n + 1) (p * (n + 1)), multiplicity p m = 0,
  { intros m hm, apply multiplicity_eq_zero_of_not_dvd,
    rw [← exists_lt_and_lt_iff_not_dvd _ (pos_iff_ne_zero.mpr hp.ne_zero)], rw [mem_Ico] at hm,
    exact ⟨n, lt_of_succ_le hm.1, hm.2⟩ },
  simp_rw [← prod_Ico_id_eq_factorial, multiplicity.finset.prod hp', ← sum_Ico_consecutive _ h1 h3,
    add_assoc], intro h,
  rw [enat.add_left_cancel_iff h, sum_Ico_succ_top h2, multiplicity.mul hp',
    hp.multiplicity_self, sum_congr rfl h4, sum_const_zero, zero_add,
    add_comm (1 : enat)]
end

/-- The multiplicity of `p` in `(p * n)!` is `n` more than that of `n!`. -/
lemma multiplicity_factorial_mul {n p : ℕ} (hp : p.prime) :
  multiplicity p (p * n)! = multiplicity p n! + n :=
begin
  induction n with n ih,
  { simp },
  { simp only [succ_eq_add_one, multiplicity.mul, hp, prime_iff.mp hp, ih,
      multiplicity_factorial_mul_succ, ←add_assoc, nat.cast_one, nat.cast_add, factorial_succ],
    congr' 1,
    rw [add_comm, add_assoc] }
end

/-- A prime power divides `n!` iff it is at most the sum of the quotients `n / p ^ i`.
  This sum is expressed over the set `Ico 1 b` where `b` is any bound greater than `log p n` -/
lemma pow_dvd_factorial_iff {p : ℕ} {n r b : ℕ} (hp : p.prime) (hbn : log p n < b) :
   p ^ r ∣ n! ↔ r ≤ ∑ i in Ico 1 b, n / p ^ i :=
by rw [← enat.coe_le_coe, ← hp.multiplicity_factorial hbn, ← pow_dvd_iff_le_multiplicity]

lemma multiplicity_factorial_le_div_pred {p : ℕ} (hp : p.prime) (n : ℕ) :
  multiplicity p n! ≤ (n/(p - 1) : ℕ) :=
begin
  rw [hp.multiplicity_factorial (lt_succ_self _), enat.coe_le_coe],
  exact nat.geom_sum_Ico_le hp.two_le _ _,
end

lemma multiplicity_choose_aux {p n b k : ℕ} (hp : p.prime) (hkn : k ≤ n) :
  ∑ i in finset.Ico 1 b, n / p ^ i =
  ∑ i in finset.Ico 1 b, k / p ^ i + ∑ i in finset.Ico 1 b, (n - k) / p ^ i +
  ((finset.Ico 1 b).filter (λ i, p ^ i ≤ k % p ^ i + (n - k) % p ^ i)).card :=
calc ∑ i in finset.Ico 1 b, n / p ^ i
    = ∑ i in finset.Ico 1 b, (k + (n - k)) / p ^ i :
    by simp only [add_tsub_cancel_of_le hkn]
... = ∑ i in finset.Ico 1 b, (k / p ^ i + (n - k) / p ^ i +
      if p ^ i ≤ k % p ^ i + (n - k) % p ^ i then 1 else 0) :
    by simp only [nat.add_div (pow_pos hp.pos _)]
... = _ : by simp [sum_add_distrib, sum_boole]

/-- The multiplicity of `p` in `choose n k` is the number of carries when `k` and `n - k`
  are added in base `p`. The set is expressed by filtering `Ico 1 b` where `b`
  is any bound greater than `log p n`. -/
lemma multiplicity_choose {p n k b : ℕ} (hp : p.prime) (hkn : k ≤ n) (hnb : log p n < b) :
  multiplicity p (choose n k) =
  ((Ico 1 b).filter (λ i, p ^ i ≤ k % p ^ i + (n - k) % p ^ i)).card :=
have h₁ : multiplicity p (choose n k) + multiplicity p (k! * (n - k)!) =
    ((finset.Ico 1 b).filter (λ i, p ^ i ≤ k % p ^ i + (n - k) % p ^ i)).card +
    multiplicity p (k! * (n - k)!),
  begin
    rw [← hp.multiplicity_mul, ← mul_assoc, choose_mul_factorial_mul_factorial hkn,
        hp.multiplicity_factorial hnb, hp.multiplicity_mul,
        hp.multiplicity_factorial ((log_le_log_of_le hkn).trans_lt hnb),
        hp.multiplicity_factorial (lt_of_le_of_lt (log_le_log_of_le tsub_le_self) hnb),
        multiplicity_choose_aux hp hkn],
    simp [add_comm],
  end,
(enat.add_right_cancel_iff
  (enat.ne_top_iff_dom.2 $
    by exact finite_nat_iff.2
      ⟨ne_of_gt hp.one_lt, mul_pos (factorial_pos k) (factorial_pos (n - k))⟩)).1
  h₁

/-- A lower bound on the multiplicity of `p` in `choose n k`. -/
lemma multiplicity_le_multiplicity_choose_add {p : ℕ} (hp : p.prime) (n k : ℕ) :
  multiplicity p n ≤ multiplicity p (choose n k) + multiplicity p k :=
if hkn : n < k then by simp [choose_eq_zero_of_lt hkn]
else if hk0 : k = 0 then by simp [hk0]
else if hn0 : n = 0 then by cases k; simp [hn0, *] at *
else begin
  rw [multiplicity_choose hp (le_of_not_gt hkn) (lt_succ_self _),
    multiplicity_eq_card_pow_dvd (ne_of_gt hp.one_lt) (nat.pos_of_ne_zero hk0)
      (lt_succ_of_le (log_le_log_of_le (le_of_not_gt hkn))),
    multiplicity_eq_card_pow_dvd (ne_of_gt hp.one_lt) (nat.pos_of_ne_zero hn0) (lt_succ_self _),
    ← nat.cast_add, enat.coe_le_coe],
  calc ((Ico 1 (log p n).succ).filter (λ i, p ^ i ∣ n)).card
      ≤ ((Ico 1 (log p n).succ).filter (λ i, p ^ i ≤ k % p ^ i + (n - k) % p ^ i) ∪
        (Ico 1 (log p n).succ).filter (λ i, p ^ i ∣ k) ).card :
    card_le_of_subset $ λ i, begin
      have := @le_mod_add_mod_of_dvd_add_of_not_dvd k (n - k) (p ^ i),
      simp [add_tsub_cancel_of_le (le_of_not_gt hkn)] at * {contextual := tt},
      tauto
    end
  ... ≤ ((Ico 1 (log p n).succ).filter (λ i, p ^ i ≤ k % p ^ i + (n - k) % p ^ i)).card +
        ((Ico 1 (log p n).succ).filter (λ i, p ^ i ∣ k)).card :
    card_union_le _ _
end

lemma multiplicity_choose_prime_pow {p n k : ℕ} (hp : p.prime)
  (hkn : k ≤ p ^ n) (hk0 : 0 < k) :
  multiplicity p (choose (p ^ n) k) + multiplicity p k = n :=
le_antisymm
  (have hdisj : disjoint
      ((Ico 1 n.succ).filter (λ i, p ^ i ≤ k % p ^ i + (p ^ n - k) % p ^ i))
      ((Ico 1 n.succ).filter (λ i, p ^ i ∣ k)),
    by simp [disjoint_right, *, dvd_iff_mod_eq_zero, nat.mod_lt _ (pow_pos hp.pos _)]
        {contextual := tt},
  begin
    rw [multiplicity_choose hp hkn (lt_succ_self _),
      multiplicity_eq_card_pow_dvd (ne_of_gt hp.one_lt) hk0
        (lt_succ_of_le (log_le_log_of_le hkn)),
      ← nat.cast_add, enat.coe_le_coe, log_pow hp.one_lt,
      ← card_disjoint_union hdisj, filter_union_right],
    have filter_le_Ico := (Ico 1 n.succ).card_filter_le _,
    rwa card_Ico 1 n.succ at filter_le_Ico,
  end)
  (by rw [← hp.multiplicity_pow_self];
    exact multiplicity_le_multiplicity_choose_add hp _ _)

end prime

lemma multiplicity_two_factorial_lt : ∀ {n : ℕ} (h : n ≠ 0), multiplicity 2 n! < n :=
begin
  have h2 := prime_iff.mp prime_two,
  refine binary_rec _ _,
  { contradiction },
  { intros b n ih h,
    by_cases hn : n = 0,
    { subst hn, simp at h, simp [h, one_right h2.not_unit, enat.zero_lt_one] },
    have : multiplicity 2 (2 * n)! < (2 * n : ℕ),
    { rw [prime_two.multiplicity_factorial_mul],
      refine (enat.add_lt_add_right (ih hn) (enat.coe_ne_top _)).trans_le _,
      rw [two_mul], norm_cast },
    cases b,
    { simpa [bit0_eq_two_mul n] },
    { suffices : multiplicity 2 (2 * n + 1) + multiplicity 2 (2 * n)! < ↑(2 * n) + 1,
      { simpa [succ_eq_add_one, multiplicity.mul, h2, prime_two, nat.bit1_eq_succ_bit0,
          bit0_eq_two_mul n] },
      rw [multiplicity_eq_zero_of_not_dvd (two_not_dvd_two_mul_add_one n), zero_add],
      refine this.trans _, exact_mod_cast lt_succ_self _ }}
end

end nat


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

import tactic

/-

# Prove that for all positive integers n we have that
# 169 | 3^{3n+3}-26n-27

This is the fourth question in Sierpinski's book "250 elementary problems
in number theory".

Proof: note that n=0 also works :-) In general use induction on n.

Base case n=0 works fine.

Inductive step: we assume `169 ∣ 3^{3d+3}-26d-27`
So it divides 27 times this
which is `3^{3(d+1)+3}-26*27*d-27*27`
and we want it to divide `3^{3(d+1)+3}-26(d+1)-27`

so we're done if it divides the difference, which is
`-26d-26-27+26*27d+27*27`
which is `26*26n+26*26 = 13*13*something`
-/

-- The statement has subtraction in, so we use integers.
example (n : ℕ) (hn : 0 < n) : -- remark; not going to use hn
(169 : ℤ) ∣ 3^(3*n+3)-26*n-27 :=
begin
  clear hn, -- told you
  sorry,
end


/-
Copyright (c) 2023 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import crypto_foundations.primitives.symm_enc
import computational_monads.constructions.repeat
import computational_monads.coercions.instances

import data.vector.zip

/-!
# Symmetric-Key Encryption Schemes

This file defines the one time pad encryption scheme,
and proves that it satisfies perfect secrecy.
-/

open oracle_comp oracle_spec

def one_time_pad (n : ℕ) : symm_enc_alg (vector bool n) (vector bool n) (vector bool n) :=
{ keygen := λ _, oracle_comp.repeat coin n,
  encrypt := λ ⟨m, k⟩, vector.zip_with bxor m k,
  decrypt := λ ⟨c, k⟩, vector.zip_with bxor c k,
  complete := λ m k _, (vector.ext (λ i, by simp only [vector.zip_with_nth, bool.bxor_assoc,
    bxor_self, bool.bxor_ff_right]) : vector.zip_with bxor (vector.zip_with bxor m k) k = m) }

namespace one_time_pad

variables {n : ℕ}

@[simp] lemma keygen_apply (u : unit) :
  (one_time_pad n).keygen u = oracle_comp.repeat coin n := rfl

@[simp] lemma encrypt_apply (m k : vector bool n) :
  (one_time_pad n).encrypt (m, k) = m.zip_with bxor k := rfl

@[simp] lemma decrypt_apply (c k : vector bool n) :
  (one_time_pad n).decrypt (c, k) = c.zip_with bxor k := rfl

theorem perfect_secrecy (n : ℕ) : (one_time_pad n).perfect_secrecy :=
begin
  refine ((one_time_pad n).perfect_secrecy_iff_of_equal_card rfl rfl).2 ⟨λ v, _, λ m c, _⟩,
  { calc ⁅= v | (one_time_pad n).keygen ()⁆ = (list.map ⁅coin⁆ v.to_list).prod :
        by rw [keygen_apply, eval_dist_repeat_apply, vector.to_list_map, eval_dist_coe_sub_spec]
      ... = 2⁻¹ ^ (list.map ⁅coin⁆ v.to_list).length :
        list.prod_eq_pow_card _ 2⁻¹ (λ x hx, let ⟨y, hy⟩ := list.mem_map.1 hx in
          by simp only [← hy.2, eval_dist_query, pmf.uniform_of_fintype_apply, coin_spec_range,
            fintype.card_bool, nat.cast_bit0, algebra_map.coe_one])
      ... = (fintype.card (vector bool n))⁻¹ : by simp_rw [card_vector, fintype.card_bool,
        nat.cast_pow, nat.cast_two, ennreal.inv_pow, list.length_map, vector.to_list_length] },
  { refine ⟨vector.zip_with bxor m c, ⟨_, _⟩, λ k hk, _⟩,
    { simp only [keygen_apply, mem_support_repeat_iff_forall, support_coe_sub_spec, coin,
        support_query, set.top_eq_univ, set.mem_univ, imp_true_iff] },
    { exact vector.ext (λ i, by simp only [encrypt_apply, vector.zip_with_nth,
        ← bool.bxor_assoc, bxor_self, bool.bxor_ff_left]) },
    { exact vector.ext (λ i, by simp only [hk.2.symm, ← bool.bxor_assoc, encrypt_apply,
        vector.zip_with_nth, bxor_self, bool.bxor_ff_left]) } }
end

end one_time_pad


/-
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
Subtraction on the natural numbers, as well as min, max, and distance.
-/
import .order
open eq.ops

namespace nat

/- subtraction -/

protected theorem sub_zero [simp] (n : ℕ) : n - 0 = n :=
rfl

theorem sub_succ [simp] (n m : ℕ) : n - succ m = pred (n - m) :=
rfl

protected theorem zero_sub [simp] (n : ℕ) : 0 - n = 0 :=
nat.induction_on n (by simp) (by simp)

theorem succ_sub_succ [simp] (n m : ℕ) : succ n - succ m = n - m :=
succ_sub_succ_eq_sub n m

protected theorem sub_self [simp] (n : ℕ) : n - n = 0 :=
nat.induction_on n (by simp) (by simp)

local attribute nat.add_succ [simp]

protected theorem add_sub_add_right [simp] (n k m : ℕ) : (n + k) - (m + k) = n - m :=
nat.induction_on k (by simp) (by simp)

protected theorem add_sub_add_left [simp] (k n m : ℕ) : (k + n) - (k + m) = n - m :=
nat.induction_on k (by simp) (by simp)

protected theorem add_sub_cancel [simp] (n m : ℕ) : n + m - m = n :=
nat.induction_on m (by simp) (by simp)

protected theorem add_sub_cancel_left [simp] (n m : ℕ) : n + m - n = m :=
nat.induction_on n (by simp) (by simp)

protected theorem sub_sub [simp] (n m k : ℕ) : (: n - m - k :) = (: n - (m + k) :) :=
nat.induction_on k (by simp) (by simp)

theorem succ_sub_sub_succ [simp] (n m k : ℕ) : succ n - m - succ k = n - m - k :=
by simp

theorem sub_self_add [simp] (n m : ℕ) : n - (n + m) = 0 :=
by inst_simp

protected theorem sub.right_comm (m n k : ℕ) : m - n - k = m - k - n :=
by simp

theorem sub_one (n : ℕ) : n - 1 = pred n :=
rfl

theorem succ_sub_one [simp] (n : ℕ) : succ n - 1 = n :=
rfl

local attribute nat.succ_mul nat.mul_succ [simp]

/- interaction with multiplication -/

theorem mul_pred_left [simp] (n m : ℕ) : pred n * m = n * m - m :=
nat.induction_on n (by simp) (by simp)

theorem mul_pred_right [simp] (n m : ℕ) : n * pred m = n * m - n :=
by inst_simp

protected theorem mul_sub_right_distrib [simp] (n m k : ℕ) : (n - m) * k = n * k - m * k :=
nat.induction_on m (by simp) (by simp)

protected theorem mul_sub_left_distrib [simp] (n m k : ℕ) : n * (m - k) = n * m - n * k :=
by inst_simp

protected theorem mul_self_sub_mul_self_eq (a b : nat) : a * a - b * b = (a + b) * (a - b) :=
by rewrite [nat.mul_sub_left_distrib, *right_distrib, mul.comm b a, add.comm (a*a) (a*b),
            nat.add_sub_add_left]

local attribute succ_eq_add_one right_distrib left_distrib [simp]

theorem succ_mul_succ_eq (a : nat) : succ a * succ a = a*a + a + a + 1 :=
by simp

/- interaction with inequalities -/

theorem succ_sub {m n : ℕ} : m ≥ n → succ m - n  = succ (m - n) :=
sub_induction n m
  (take k, assume H : 0 ≤ k, rfl)
   (take k,
    assume H : succ k ≤ 0,
    absurd H !not_succ_le_zero)
  (take k l,
    assume IH : k ≤ l → succ l - k = succ (l - k),
    take H : succ k ≤ succ l,
    calc
      succ (succ l) - succ k = succ l - k             : succ_sub_succ
                         ... = succ (l - k)           : IH (le_of_succ_le_succ H)
                         ... = succ (succ l - succ k) : succ_sub_succ)

theorem sub_eq_zero_of_le {n m : ℕ} (H : n ≤ m) : n - m = 0 :=
obtain (k : ℕ) (Hk : n + k = m), from le.elim H, Hk ▸ !sub_self_add

theorem add_sub_of_le {n m : ℕ} : n ≤ m → n + (m - n) = m :=
sub_induction n m
  (take k,
    assume H : 0 ≤ k,
    calc
      0 + (k - 0) = k - 0 : zero_add
              ... = k     : nat.sub_zero)
  (take k, assume H : succ k ≤ 0, absurd H !not_succ_le_zero)
  (take k l,
    assume IH : k ≤ l → k + (l - k) = l,
    take H : succ k ≤ succ l,
    calc
      succ k + (succ l - succ k) = succ k + (l - k)   : succ_sub_succ
                             ... = succ (k + (l - k)) : succ_add
                             ... = succ l             : IH (le_of_succ_le_succ H))

theorem add_sub_of_ge {n m : ℕ} (H : n ≥ m) : n + (m - n) = n :=
calc
  n + (m - n) = n + 0 : sub_eq_zero_of_le H
          ... = n     : add_zero

protected theorem sub_add_cancel {n m : ℕ} : n ≥ m → n - m + m = n :=
!add.comm ▸ !add_sub_of_le

theorem sub_add_of_le {n m : ℕ} : n ≤ m → n - m + m = m :=
!add.comm ▸ add_sub_of_ge

theorem sub.cases {P : ℕ → Prop} {n m : ℕ} (H1 : n ≤ m → P 0) (H2 : ∀k, m + k = n -> P k)
  : P (n - m) :=
or.elim !le.total
  (assume H3 : n ≤ m, (sub_eq_zero_of_le H3)⁻¹ ▸ (H1 H3))
  (assume H3 : m ≤ n, H2 (n - m) (add_sub_of_le H3))

theorem exists_sub_eq_of_le {n m : ℕ} (H : n ≤ m) : ∃k, m - k = n :=
obtain (k : ℕ) (Hk : n + k = m), from le.elim H,
exists.intro k
  (calc
    m - k = n + k - k : by rewrite Hk
      ... = n         : nat.add_sub_cancel)

protected theorem add_sub_assoc {m k : ℕ} (H : k ≤ m) (n : ℕ) : n + m - k = n + (m - k) :=
have l1 : k ≤ m → n + m - k = n + (m - k), from
  sub_induction k m
    (by simp)
    (take k : ℕ, assume H : succ k ≤ 0, absurd H !not_succ_le_zero)
    (take k m,
      assume IH : k ≤ m → n + m - k = n + (m - k),
      take H : succ k ≤ succ m,
      calc
        n + succ m - succ k = succ (n + m) - succ k : add_succ
                        ... = n + m - k             : succ_sub_succ
                        ... = n + (m - k)           : IH (le_of_succ_le_succ H)
                        ... = n + (succ m - succ k) : succ_sub_succ),
l1 H

theorem le_of_sub_eq_zero {n m : ℕ} : n - m = 0 → n ≤ m :=
sub.cases
  (assume H1 : n ≤ m, assume H2 : 0 = 0, H1)
  (take k : ℕ,
    assume H1 : m + k = n,
    assume H2 : k = 0,
    have H3 : n = m, from !add_zero ▸ H2 ▸ H1⁻¹,
    H3 ▸ !le.refl)

theorem sub_sub.cases {P : ℕ → ℕ → Prop} {n m : ℕ} (H1 : ∀k, n = m + k -> P k 0)
  (H2 : ∀k, m = n + k → P 0 k) : P (n - m) (m - n) :=
or.elim !le.total
  (assume H3 : n ≤ m,
    (sub_eq_zero_of_le H3)⁻¹ ▸  (H2 (m - n) (add_sub_of_le H3)⁻¹))
  (assume H3 : m ≤ n,
    (sub_eq_zero_of_le H3)⁻¹ ▸ (H1 (n - m) (add_sub_of_le H3)⁻¹))

protected theorem sub_eq_of_add_eq {n m k : ℕ} (H : n + m = k) : k - n = m :=
have H2 : k - n + n = m + n, from
  calc
    k - n + n = k     : nat.sub_add_cancel (le.intro H)
          ... = n + m : H⁻¹
          ... = m + n : !add.comm,
add.right_cancel H2

protected theorem eq_sub_of_add_eq {a b c : ℕ} (H : a + c = b) : a = b - c :=
(nat.sub_eq_of_add_eq (!add.comm ▸ H))⁻¹

protected theorem sub_eq_of_eq_add {a b c : ℕ} (H : a = c + b) : a - b = c :=
nat.sub_eq_of_add_eq (!add.comm ▸ H⁻¹)

protected theorem sub_le_sub_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n - k ≤ m - k :=
obtain (l : ℕ) (Hl : n + l = m), from le.elim H,
or.elim !le.total
  (assume H2 : n ≤ k, (sub_eq_zero_of_le H2)⁻¹ ▸ !zero_le)
  (assume H2 : k ≤ n,
    have H3 : n - k + l = m - k, from
      calc
        n - k + l = l + (n - k) : by simp
              ... = l + n - k   : nat.add_sub_assoc H2 l
              ... = m - k       : by simp,
    le.intro H3)

protected theorem sub_le_sub_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k - m ≤ k - n :=
obtain (l : ℕ) (Hl : n + l = m), from le.elim H,
sub.cases
  (assume H2 : k ≤ m, !zero_le)
  (take m' : ℕ,
    assume Hm : m + m' = k,
    have H3 : n ≤ k, from le.trans H (le.intro Hm),
    have H4 : m' + l + n = k - n + n, by simp,
    le.intro (add.right_cancel H4))

protected theorem sub_pos_of_lt {m n : ℕ} (H : m < n) : n - m > 0 :=
have H1 : n = n - m + m, from (nat.sub_add_cancel (le_of_lt H))⁻¹,
have H2 : 0 + m < n - m + m, begin rewrite [zero_add, -H1], exact H end,
!lt_of_add_lt_add_right H2

protected theorem lt_of_sub_pos {m n : ℕ} (H : n - m > 0) : m < n :=
lt_of_not_ge
  (take H1 : m ≥ n,
    have H2 : n - m = 0, from sub_eq_zero_of_le H1,
    !lt.irrefl (H2 ▸ H))

protected theorem lt_of_sub_lt_sub_right {n m k : ℕ} (H : n - k < m - k) : n < m :=
lt_of_not_ge
  (assume H1 : m ≤ n,
    have H2 : m - k ≤ n - k, from nat.sub_le_sub_right H1 _,
    not_le_of_gt H H2)

protected theorem lt_of_sub_lt_sub_left {n m k : ℕ} (H : n - m < n - k) : k < m :=
lt_of_not_ge
  (assume H1 : m ≤ k,
    have H2 : n - k ≤ n - m, from nat.sub_le_sub_left H1 _,
    not_le_of_gt H H2)

protected theorem sub_lt_sub_add_sub (n m k : ℕ) : n - k ≤ (n - m) + (m - k) :=
sub.cases
  (assume H : n ≤ m, (zero_add (m - k))⁻¹ ▸ nat.sub_le_sub_right H k)
  (take mn : ℕ,
    assume Hmn : m + mn = n,
    sub.cases
      (assume H : m ≤ k,
        have   H2 : n - k ≤ n - m, from nat.sub_le_sub_left H n,
        have H3 : n - k ≤ mn, from nat.sub_eq_of_add_eq Hmn ▸ H2,
        show   n - k ≤ mn + 0,  begin rewrite add_zero, assumption end)
      (take km : ℕ,
        assume Hkm : k + km = m,
        have H : k + (mn + km) = n, from
          calc
            k + (mn + km) = k + km + mn  : by simp
                      ... = m + mn       : Hkm
                      ... = n            : Hmn,
        have H2 : n - k = mn + km, from nat.sub_eq_of_add_eq H,
        H2 ▸ !le.refl))

protected theorem sub_lt_self {m n : ℕ} (H1 : m > 0) (H2 : n > 0) : m - n < m :=
calc
  m - n = succ (pred m) - n             : succ_pred_of_pos H1
    ... = succ (pred m) - succ (pred n) : succ_pred_of_pos H2
    ... = pred m - pred n               : succ_sub_succ
    ... ≤ pred m                        : sub_le
    ... < succ (pred m)                 : lt_succ_self
    ... = m                             : succ_pred_of_pos H1

protected theorem le_sub_of_add_le {m n k : ℕ} (H : m + k ≤ n) : m ≤ n - k :=
calc
  m = m + k - k : nat.add_sub_cancel
    ... ≤ n - k : nat.sub_le_sub_right H k

protected theorem lt_sub_of_add_lt {m n k : ℕ} (H : m + k < n) (H2 : k ≤ n) : m < n - k :=
lt_of_succ_le (nat.le_sub_of_add_le (calc
    succ m + k = succ (m + k) : succ_add_eq_succ_add
           ... ≤ n            : succ_le_of_lt H))

protected theorem sub_lt_of_lt_add {v n m : nat} (h₁ : v < n + m) (h₂ : n ≤ v) : v - n < m :=
have succ v ≤ n + m,   from succ_le_of_lt h₁,
have succ (v - n) ≤ m, from
  calc succ (v - n) = succ v - n : succ_sub h₂
        ...     ≤ n + m - n      : nat.sub_le_sub_right this n
        ...     = m              : nat.add_sub_cancel_left,
lt_of_succ_le this

/- distance -/

definition dist [reducible] (n m : ℕ) := (n - m) + (m - n)

theorem dist.comm (n m : ℕ) : dist n m = dist m n :=
by simp

theorem dist_self (n : ℕ) : dist n n = 0 :=
by simp

theorem eq_of_dist_eq_zero {n m : ℕ} (H : dist n m = 0) : n = m :=
have H2 : n - m = 0, from eq_zero_of_add_eq_zero_right H,
have H3 : n ≤ m, from le_of_sub_eq_zero H2,
have H4 : m - n = 0, from eq_zero_of_add_eq_zero_left H,
have H5 : m ≤ n, from le_of_sub_eq_zero H4,
le.antisymm H3 H5

theorem dist_eq_zero {n m : ℕ} (H : n = m) : dist n m = 0 :=
by substvars; rewrite [↑dist, *nat.sub_self, add_zero]

theorem dist_eq_sub_of_le {n m : ℕ} (H : n ≤ m) : dist n m = m - n :=
calc
  dist n m = 0 + (m - n) : {sub_eq_zero_of_le H}
       ... = m - n       : zero_add

theorem dist_eq_sub_of_lt {n m : ℕ} (H : n < m) : dist n m = m - n :=
dist_eq_sub_of_le (le_of_lt H)

theorem dist_eq_sub_of_ge {n m : ℕ} (H : n ≥ m) : dist n m = n - m :=
!dist.comm ▸ dist_eq_sub_of_le H

theorem dist_eq_sub_of_gt {n m : ℕ} (H : n > m) : dist n m = n - m :=
dist_eq_sub_of_ge (le_of_lt H)

theorem dist_zero_right (n : ℕ) : dist n 0 = n :=
dist_eq_sub_of_ge !zero_le ⬝ !nat.sub_zero

theorem dist_zero_left (n : ℕ) : dist 0 n = n :=
dist_eq_sub_of_le !zero_le ⬝ !nat.sub_zero

theorem dist.intro {n m k : ℕ} (H : n + m = k) : dist k n = m :=
calc
  dist k n = k - n : dist_eq_sub_of_ge (le.intro H)
           ... = m : nat.sub_eq_of_add_eq H

theorem dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m :=
calc
  dist (n + k) (m + k) = ((n+k) - (m+k)) + ((m+k)-(n+k)) : rfl
                   ... = (n - m) + ((m + k) - (n + k))   : nat.add_sub_add_right
                   ... = (n - m) + (m - n)               : nat.add_sub_add_right

theorem dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m :=
begin rewrite [add.comm k n, add.comm k m]; apply dist_add_add_right end

theorem dist_add_eq_of_ge {n m : ℕ} (H : n ≥ m) : dist n m + m = n :=
calc
  dist n m + m = n - m + m : {dist_eq_sub_of_ge H}
           ... = n         : nat.sub_add_cancel H

theorem dist_eq_intro {n m k l : ℕ} (H : n + m = k + l) : dist n k = dist l m :=
calc
  dist n k = dist (n + m) (k + m) : dist_add_add_right
       ... = dist (k + l) (k + m) : H
       ... = dist l m             : dist_add_add_left

theorem dist_sub_eq_dist_add_left {n m : ℕ} (H : n ≥ m) (k : ℕ) :
  dist (n - m) k = dist n (k + m) :=
have H2 : n - m + (k + m) = k + n, from
  calc
    n - m + (k + m) = n - m + m + k   : by simp
                ... = n + k           : nat.sub_add_cancel H
                ... = k + n           : by simp,
dist_eq_intro H2

theorem dist_sub_eq_dist_add_right {k m : ℕ} (H : k ≥ m) (n : ℕ) :
  dist n (k - m) = dist (n + m) k :=
dist.comm (k - m) n ▸ dist.comm k (n + m) ▸ dist_sub_eq_dist_add_left H n

theorem dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k :=
have (n - m) + (m - k) + ((k - m) + (m - n)) = (n - m) + (m - n) + ((m - k) + (k - m)), by simp,
this ▸ add_le_add !nat.sub_lt_sub_add_sub !nat.sub_lt_sub_add_sub

theorem dist_add_add_le_add_dist_dist (n m k l : ℕ) : dist (n + m) (k + l) ≤ dist n k + dist m l :=
have H : dist (n + m) (k + m) + dist (k + m) (k + l) = dist n k + dist m l,
  by rewrite [dist_add_add_left, dist_add_add_right],
by rewrite -H; apply dist.triangle_inequality

theorem dist_mul_right (n k m : ℕ) : dist (n * k) (m * k) = dist n m * k :=
have ∀ n m, dist n m = n - m + (m - n), from take n m, rfl,
by rewrite [this, this n m, right_distrib, *nat.mul_sub_right_distrib]

theorem dist_mul_left (k n m : ℕ) : dist (k * n) (k * m) = k * dist n m :=
begin rewrite [mul.comm k n, mul.comm k m, dist_mul_right, mul.comm] end

theorem dist_mul_dist (n m k l : ℕ) : dist n m * dist k l = dist (n * k + m * l) (n * l + m * k) :=
have aux : ∀k l, k ≥ l → dist n m * dist k l = dist (n * k + m * l) (n * l + m * k), from
  take k l : ℕ,
  assume H : k ≥ l,
  have H2 : m * k ≥ m * l, from !mul_le_mul_left H,
  have H3 : n * l + m * k ≥ m * l, from le.trans H2 !le_add_left,
  calc
    dist n m * dist k l = dist n m * (k - l)       : dist_eq_sub_of_ge H
      ... = dist (n * (k - l)) (m * (k - l))       : dist_mul_right
      ... = dist (n * k - n * l) (m * k - m * l)   : by rewrite [*nat.mul_sub_left_distrib]
      ... = dist (n * k) (m * k - m * l + n * l)   : dist_sub_eq_dist_add_left (!mul_le_mul_left H)
      ... = dist (n * k) (n * l + (m * k - m * l)) : add.comm
      ... = dist (n * k) (n * l + m * k - m * l)   : nat.add_sub_assoc H2 (n * l)
      ... = dist (n * k + m * l) (n * l + m * k)   : dist_sub_eq_dist_add_right H3 _,
or.elim !le.total
  (assume H : k ≤ l, !dist.comm ▸ !dist.comm ▸ aux l k H)
  (assume H : l ≤ k, aux k l H)

lemma dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j :=
or.elim (lt_or_ge i j)
  (suppose i < j,
    by rewrite [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this])
  (suppose i ≥ j,
    by rewrite [max_eq_left this , min_eq_right this, dist_eq_sub_of_ge this])

lemma dist_succ {i j : nat} : dist (succ i) (succ j) = dist i j :=
by rewrite [↑dist, *succ_sub_succ]

lemma dist_le_max {i j : nat} : dist i j ≤ max i j :=
begin rewrite dist_eq_max_sub_min, apply sub_le end

lemma dist_pos_of_ne {i j : nat} : i ≠ j → dist i j > 0 :=
assume Pne, lt.by_cases
  (suppose i < j, begin rewrite [dist_eq_sub_of_lt this], apply nat.sub_pos_of_lt this end)
  (suppose i = j, by contradiction)
  (suppose i > j, begin rewrite [dist_eq_sub_of_gt this], apply nat.sub_pos_of_lt this end)

end nat


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.finset.card
import data.multiset.nat_antidiagonal

/-!
# Antidiagonals in ℕ × ℕ as finsets

This file defines the antidiagonals of ℕ × ℕ as finsets: the `n`-th antidiagonal is the finset of
pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more
generally for sums going from `0` to `n`.

## Notes

This refines files `data.list.nat_antidiagonal` and `data.multiset.nat_antidiagonal`.
-/

namespace finset
namespace nat

/-- The antidiagonal of a natural number `n` is
    the finset of pairs `(i, j)` such that `i + j = n`. -/
def antidiagonal (n : ℕ) : finset (ℕ × ℕ) :=
⟨multiset.nat.antidiagonal n, multiset.nat.nodup_antidiagonal n⟩

/-- A pair (i, j) is contained in the antidiagonal of `n` if and only if `i + j = n`. -/
@[simp] lemma mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
  x ∈ antidiagonal n ↔ x.1 + x.2 = n :=
by rw [antidiagonal, mem_def, multiset.nat.mem_antidiagonal]

/-- The cardinality of the antidiagonal of `n` is `n + 1`. -/
@[simp] lemma card_antidiagonal (n : ℕ) : (antidiagonal n).card = n+1 :=
by simp [antidiagonal]

/-- The antidiagonal of `0` is the list `[(0, 0)]` -/
@[simp] lemma antidiagonal_zero : antidiagonal 0 = {(0, 0)} :=
rfl

lemma antidiagonal_succ {n : ℕ} :
  antidiagonal (n + 1) = insert (0, n + 1) ((antidiagonal n).map
  (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ (function.embedding.refl _))) :=
begin
  apply eq_of_veq,
  rw [insert_val_of_not_mem, map_val],
  { apply multiset.nat.antidiagonal_succ },
  { intro con, rcases mem_map.1 con with ⟨⟨a,b⟩, ⟨h1, h2⟩⟩,
    simp only [prod.mk.inj_iff, function.embedding.coe_prod_map, prod.map_mk] at h2,
    apply nat.succ_ne_zero a h2.1, }
end

lemma antidiagonal_succ' {n : ℕ} :
  antidiagonal (n + 1) = insert (n + 1, 0) ((antidiagonal n).map
  (function.embedding.prod_map (function.embedding.refl _) ⟨nat.succ, nat.succ_injective⟩)) :=
begin
  apply eq_of_veq,
  rw [insert_val_of_not_mem, map_val],
  { apply multiset.nat.antidiagonal_succ' },
  { simp },
end

lemma antidiagonal_succ_succ' {n : ℕ} :
  antidiagonal (n + 2) = insert (0, n + 2) (insert (n + 2, 0) ((antidiagonal n).map
  (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ ⟨nat.succ, nat.succ_injective⟩))) :=
by { rw [antidiagonal_succ, antidiagonal_succ', map_insert, map_map], refl }

lemma map_swap_antidiagonal {n : ℕ} :
  (antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩ = antidiagonal n :=
eq_of_veq $ by simp [antidiagonal, multiset.nat.map_swap_antidiagonal]

/-- A point in the antidiagonal is determined by its first co-ordinate. -/
lemma antidiagonal_congr {n : ℕ} {p q : ℕ × ℕ} (hp : p ∈ antidiagonal n)
  (hq : q ∈ antidiagonal n) : p = q ↔ p.fst = q.fst :=
begin
  refine ⟨congr_arg prod.fst, (λ h, prod.ext h ((add_right_inj q.fst).mp _))⟩,
  rw mem_antidiagonal at hp hq,
  rw [hq, ← h, hp],
end

lemma antidiagonal.fst_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) :
  kl.1 ≤ n :=
begin
  rw le_iff_exists_add,
  use kl.2,
  rwa [mem_antidiagonal, eq_comm] at hlk
end

lemma antidiagonal.snd_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) :
  kl.2 ≤ n :=
begin
  rw le_iff_exists_add,
  use kl.1,
  rwa [mem_antidiagonal, eq_comm, add_comm] at hlk
end

lemma filter_fst_eq_antidiagonal (n m : ℕ) :
  filter (λ x : ℕ × ℕ, x.fst = m) (antidiagonal n) = if m ≤ n then {(m, n - m)} else ∅ :=
begin
  ext ⟨x, y⟩,
  simp only [mem_filter, nat.mem_antidiagonal],
  split_ifs with h h,
  { simp [and_comm, eq_tsub_iff_add_eq_of_le h, add_comm] {contextual := tt} },
  { rw not_le at h,
    simp only [not_mem_empty, iff_false, not_and],
    exact λ hn, ne_of_lt (lt_of_le_of_lt (le_self_add.trans hn.le) h) }
end

lemma filter_snd_eq_antidiagonal (n m : ℕ) :
  filter (λ x : ℕ × ℕ, x.snd = m) (antidiagonal n) = if m ≤ n then {(n - m, m)} else ∅ :=
begin
  have : (λ (x : ℕ × ℕ), x.snd = m) ∘ prod.swap = (λ (x : ℕ × ℕ), x.fst = m),
  { ext, simp },
  rw ←map_swap_antidiagonal,
  simp [map_filter, this, filter_fst_eq_antidiagonal, apply_ite (finset.map _)]
end

section equiv_prod

/-- The disjoint union of antidiagonals `Σ (n : ℕ), antidiagonal n` is equivalent to the product
    `ℕ × ℕ`. This is such an equivalence, obtained by mapping `(n, (k, l))` to `(k, l)`. -/
@[simps] def sigma_antidiagonal_equiv_prod : (Σ (n : ℕ), antidiagonal n) ≃ ℕ × ℕ :=
{ to_fun := λ x, x.2,
  inv_fun := λ x, ⟨x.1 + x.2, x, mem_antidiagonal.mpr rfl⟩,
  left_inv :=
    begin
      rintros ⟨n, ⟨k, l⟩, h⟩,
      rw mem_antidiagonal at h,
      exact sigma.subtype_ext h rfl,
    end,
  right_inv := λ x, rfl }

end equiv_prod

end nat

end finset


-- Estructuras algebraicas
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio. Importar las librerías
-- + data.rat.basic (que contiene los números racionales) y
-- + tactic (que contiene las tácticas)
-- ----------------------------------------------------------------------

import data.rat.basic
import tactic

-- ---------------------------------------------------------------------
-- Ejercicio. Iniciar el espacio de nombres lftcm (para evitar
-- conflictos de nombres) de forma que cuando se defina `group` su
-- nombre será `lftcm.group`.
-- ----------------------------------------------------------------------

namespace lftcm

-- Comentario sobre notación de clases de tipos:
-- + Para definir un término de tipo `has_mul G` hay que definir una
--   función `has_mul.mul : G → G → G`.
-- + La notación `g * h` representa `has_mul.mul g h`.
-- + `has_mul` es una clase.
-- + Al escribir `[has_mul G]` se dispone de una multiplicación llamada
--   `*` que verifica los axiomas de grupo.
-- + Al escribir `[has_one G]` se dispone de un elemento neutro
--   `has_one.one : G` que se representa por `1`.
-- + Al escribir `[has_inv G]` se dispone de una operación
--   `has_inv.inv : G → G` de forma que `inv g` es el inverso de `g` y
--    se representa por `g⁻¹`

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los grupos
-- ----------------------------------------------------------------------

class group (G : Type) extends has_mul G, has_one G, has_inv G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

-- ---------------------------------------------------------------------
-- Ejercicio. Iniciar el espacio de nombres group.
-- ----------------------------------------------------------------------

namespace group

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar G como una variable sobre grupos
-- ----------------------------------------------------------------------

variables {G : Type} [group G]

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar a, b y c elementos de G.
-- ----------------------------------------------------------------------

variables  (a b c : G)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    a * b = a * c
-- entonces
--    b = c
-- ----------------------------------------------------------------------

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

lemma mul_left_cancel
  (Habac : a * b = a * c)
  : b = c :=
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw mul_left_inv
    ... = a⁻¹ * (a * b) : by rw mul_assoc
    ... = a⁻¹ * (a * c) : by rw Habac
    ... = (a⁻¹ * a) * c : by rw mul_assoc
    ... = 1 * c         : by rw mul_left_inv
    ... = c             : by rw one_mul

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

lemma mul_left_cancel2
  (Habac : a * b = a * c)
  : b = c :=
begin
  rw ←one_mul b,
  rw ←mul_left_inv a,
  rw mul_assoc,
  rw Habac,
  rw ←mul_assoc,
  rw mul_left_inv,
  rw one_mul,
end

-- Prueba
-- ======

/-
G : Type,
_inst_1 : group G,
a b c : G,
Habac : a * b = a * c
⊢ b = c
  >> rw ←one_mul b,
⊢ 1 * b = c
  >> rw ←mul_left_inv a,
⊢ (a⁻¹ * a) * b = c
  >> rw mul_assoc,
⊢ a⁻¹ * (a * b) = c
  >> rw Habac,
⊢ a⁻¹ * (a * c) = c
  >> rw ←mul_assoc,
⊢ (a⁻¹ * a) * c = c
  >> rw mul_left_inv,
⊢ 1 * c = c
  >> rw one_mul,
no goals
-/

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

lemma mul_left_cancel3
  (Habac : a * b = a * c)
  : b = c :=
begin
  rw [←one_mul b, ←mul_left_inv a, mul_assoc, Habac, ←mul_assoc,
      mul_left_inv, one_mul],
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    x = a⁻¹ * y
-- entonces
--    a * x = y
-- ----------------------------------------------------------------------

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

lemma mul_eq_of_eq_inv_mul
  {a x y : G}
  (h : x = a⁻¹ * y)
  : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  rw ←mul_assoc,
  rw mul_left_inv,
  rw one_mul,
  exact h,
end

-- Prueba
-- ======

/-
G : Type,
_inst_1 : group G,
a x y : G,
h : x = a⁻¹ * y
⊢ a * x = y
  >> apply mul_left_cancel a⁻¹,
⊢ a⁻¹ * (a * x) = a⁻¹ * y
  >> rw ←mul_assoc,
⊢ (a⁻¹ * a) * x = a⁻¹ * y
  >> rw mul_left_inv,
⊢ 1 * x = a⁻¹ * y
  >> rw one_mul,
⊢ x = a⁻¹ * y
  >> exact h,
no goals
-/

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

lemma mul_eq_of_eq_inv_mul2
  {a x y : G}
  (h : x = a⁻¹ * y)
  : a * x = y :=
mul_left_cancel a⁻¹ _ _ $ by rwa [←mul_assoc, mul_left_inv, one_mul]

-- Comentario: La táctica `rwa hs` rescribe la conclusión con las reglas
-- de hs y al final aplica assumption.

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar los axiomas y one_mul mul_left_inv como reglas de
-- simplificación.
-- ----------------------------------------------------------------------

attribute [simp] one_mul mul_left_inv

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar, y declarar como regla de simplificación, que el
-- 1 es elemento neutro por la derecha.
-- ----------------------------------------------------------------------

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

example
  (a : G)
  : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  apply eq.symm,
  exact mul_left_inv a,
end

-- Prueba
-- ======

/-
G : Type,
_inst_1 : group G,
a : G
⊢ a * 1 = a
  >> apply mul_eq_of_eq_inv_mul,
⊢ 1 = a⁻¹ * a
  >> apply eq.symm,
⊢ a⁻¹ * a = 1
  >> exact mul_left_inv a,
no goals
-/

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

example
  (a : G)
  : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  simp,
end

-- Prueba
-- ======

/-
G : Type,
_inst_1 : group G,
a : G
⊢ a * 1 = a
  >> apply mul_eq_of_eq_inv_mul
⊢ 1 = a⁻¹ * a
  >> simp,
no goals
-/

-- Comentario: El simplificador demuestra que `1 = a⁻¹ * a` porque se ha
-- declarado mul_left_inv como regla de simplificación

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

@[simp]
theorem mul_one
  (a : G)
  : a * 1 = a :=
mul_eq_of_eq_inv_mul $ by simp

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar, y declarar como regla de simplificación, que
--    a * a⁻¹ = 1
-- ----------------------------------------------------------------------

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

example
  (a : G)
  : a * a⁻¹ = 1 :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw mul_one,
end

-- Prueba
-- ======

/-
G : Type,
_inst_1 : group G,
a : G
⊢ a * a⁻¹ = 1
  >> apply mul_eq_of_eq_inv_mul,
⊢ a⁻¹ = a⁻¹ * 1
  >> rw mul_one,
no goals
-/

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

@[simp]
theorem mul_right_inv
  (a : G)
  : a * a⁻¹ = 1 :=
begin
  apply mul_eq_of_eq_inv_mul,
  simp
end

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

example
  (a : G)
  : a * a⁻¹ = 1 :=
mul_eq_of_eq_inv_mul $ by simp

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que el inverso de 1 es 1.
-- ----------------------------------------------------------------------

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  apply mul_left_cancel (1 : G),
  simp,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    a⁻¹⁻¹ = a
-- ----------------------------------------------------------------------

@[simp] lemma inv_inv (a : G) : a⁻¹⁻¹ = a :=
begin
  apply mul_left_cancel a⁻¹,
  simp,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar la propiedad asociativa como regla de
-- simplificación.
-- ----------------------------------------------------------------------

attribute [simp] mul_assoc

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    a⁻¹ * (a * b) = b
-- ----------------------------------------------------------------------

@[simp] lemma inv_mul_cancel_left
  (a b : G)
  : a⁻¹ * (a * b) = b :=
begin
  rw ←mul_assoc,
  simp,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    a * (a⁻¹ * b) = b
-- ----------------------------------------------------------------------

@[simp] lemma mul_inv_cancel_left (a b : G) : a * (a⁻¹ * b) = b :=
begin
  rw ←mul_assoc,
  simp,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (a * b)⁻¹ = b⁻¹ * a⁻¹
-- ----------------------------------------------------------------------

@[simp] lemma mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  apply mul_left_cancel (a * b),
  rw mul_right_inv,
  simp,
end

-- Prueba
-- ======

/-
G : Type,
_inst_1 : group G,
a b : G
⊢ (a * b)⁻¹ = b⁻¹ * a⁻¹
  apply mul_left_cancel (a * b),
⊢ (a * b) * (a * b)⁻¹ = (a * b) * (b⁻¹ * a⁻¹)
  rw mul_right_inv,
⊢ 1 = a * b * (b⁻¹ * a⁻¹)
  simp,
no goals
-/

-- Comentario: Con las reglas de simplificación de grupo que se han
-- añadido se tiene un sistema de reescritura normalizador confluente;
-- es decir, el simplificador transforma cualquier expresión de grupo en
-- su forma canónica.

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    ((a * b)⁻¹ * a * 1⁻¹⁻¹⁻¹ * b⁻¹ * b * b * 1 * 1⁻¹)⁻¹
--    = (c⁻¹⁻¹ * d * d⁻¹ * 1⁻¹⁻¹ * c⁻¹⁻¹⁻¹)⁻¹⁻¹
-- ----------------------------------------------------------------------

example
  (a b c d : G)
  : ((a * b)⁻¹ * a * 1⁻¹⁻¹⁻¹ * b⁻¹ * b * b * 1 * 1⁻¹)⁻¹
    = (c⁻¹⁻¹ * d * d⁻¹ * 1⁻¹⁻¹ * c⁻¹⁻¹⁻¹)⁻¹⁻¹ :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el producto de dos grupos.
-- ----------------------------------------------------------------------

instance (G : Type) [group G] (H : Type) [group H] : group (G × H) :=
{ mul := λ k l, (k.1*l.1, k.2*l.2),
  one := (1,1),
  inv := λ k, (k.1⁻¹, k.2⁻¹),
  mul_assoc :=
  begin
    rintros ⟨a1,a2⟩ ⟨b1,b2⟩ ⟨c1,c2⟩,
    ext;
    simp,
  end,
  one_mul :=
  begin
    rintros ⟨a1,a2⟩,
    ext;
    simp,
  end,
  mul_left_inv :=
  begin
    rintros ⟨a1,a2⟩,
    ext;
    simp
  end }

-- Prueba de mul_assoc
-- ===================

/-
G : Type,
_inst_2 : group G,
H : Type,
_inst_3 : group H
⊢ ∀ (a b c : G × H), a * b * c = a * (b * c)
    >> rintros ⟨a1,a2⟩ ⟨b1,b2⟩ ⟨c1,c2⟩,
a1 : G,
a2 : H,
b1 : G,
b2 : H,
c1 : G,
c2 : H
⊢ (a1, a2) * (b1, b2) * (c1, c2) = (a1, a2) * ((b1, b2) * (c1, c2))
    >> ext;
⊢ ((a1, a2) * (b1, b2) * (c1, c2)).fst = ((a1, a2) * ((b1, b2) * (c1,c2))).fst
⊢ ((a1, a2) * (b1, b2) * (c1, c2)).snd = ((a1, a2) * ((b1, b2) * (c1, c2))).snd
    >> simp,
no goals
-/

-- Prueba de one_mul
-- =================

/-
G : Type,
_inst_2 : group G,
H : Type,
_inst_3 : group H
⊢ ∀ (a : G × H), 1 * a = a
  >> rintros ⟨a1,a2⟩,
a1 : G,
a2 : H
⊢ 1 * (a1, a2) = (a1, a2)
  >> ext;
⊢ (1 * (a1, a2)).fst = (a1, a2).fst
⊢ (1 * (a1, a2)).snd = (a1, a2).snd
  >> simp,
no goals
-/

-- Prueba de mul_left_inv
-- ======================

/-
G : Type,
_inst_2 : group G,
H : Type,
_inst_3 : group H
⊢ ∀ (a : G × H), a⁻¹ * a = 1
  >> rintros ⟨a1,a2⟩,
a1 : G,
a2 : H
⊢ (a1, a2)⁻¹ * (a1, a2) = 1
  >> ext;
⊢ ((a1, a2)⁻¹ * (a1, a2)).fst = 1.fst
⊢ ((a1, a2)⁻¹ * (a1, a2)).snd = 1.snd
  >> simp
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si G, H y K son grupos, entonces G × H × K
-- también lo es.
-- ----------------------------------------------------------------------

example (G H K : Type) [group G] [group H] [group K] : group (G × H × K) :=
by apply_instance

-- ---------------------------------------------------------------------
-- Ejercicio. Cerrar el espacio de nombres group.
-- ----------------------------------------------------------------------

end group

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el tipo mu2 con dos elementos p1 y m1 (que
-- representarán a +1 y -1).
-- ----------------------------------------------------------------------

inductive mu2
| p1 : mu2
| m1 : mu2

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el espacio de nombres mu2.
-- ----------------------------------------------------------------------

namespace mu2

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la igualdad en mu2 es decidible.
-- ----------------------------------------------------------------------

attribute [derive decidable_eq] mu2

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que mu2 es un tipo finito.
-- ----------------------------------------------------------------------

instance : fintype mu2 :=
⟨⟨[mu2.p1, mu2.m1], by simp⟩,
 λ x, by cases x; simp⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    mul : mu2 → mu2 → mu2
-- tal que (mul x y) es el producto de x por y.
-- ----------------------------------------------------------------------

def mul : mu2 → mu2 → mu2
| p1 p1 := p1
| p1 m1 := m1
| m1 p1 := m1
| m1 m1 := p1

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar mu2 una instancia de has_mul con la operación mul.
-- ----------------------------------------------------------------------

instance : has_mul mu2 := ⟨mul⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Definir one como p1.
-- ----------------------------------------------------------------------

def one : mu2 := p1

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar mu2 una instancia de has_one con elemento neutro
-- one.
-- ----------------------------------------------------------------------

instance : has_one mu2 := ⟨one⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    inv : mu2 → mu2
-- como la identidad.
-- ----------------------------------------------------------------------

def inv : mu2 → mu2 := id

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar mu2 una instancia de has_inv con inv.
-- ----------------------------------------------------------------------

instance : has_inv mu2 := ⟨inv⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    p1 * m1 * m1 = p1⁻¹ * p1
-- ----------------------------------------------------------------------

example : p1 * m1 * m1 = p1⁻¹ * p1 := rfl

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar mu2 una instancia de group.
-- ----------------------------------------------------------------------

instance : group mu2 :=
begin
  refine_struct { mul := mul, one := one, inv := inv },
  all_goals {exact dec_trivial}
end

-- ---------------------------------------------------------------------
-- Ejercicio. Cerrar el espacio de nombre mu2.
-- ----------------------------------------------------------------------

end mu2

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los monoides (ver
-- https://bit.ly/30NfvAZ )
-- ----------------------------------------------------------------------

class monoid (M : Type) extends has_mul M, has_one M :=
(mul_assoc : ∀ (a b c : M), a * b * c = a * (b * c))
(one_mul : ∀ (a : M), 1 * a = a)
(mul_one : ∀ (a : M), a * 1 = a)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los grupos conmutativos con sumas.
-- ----------------------------------------------------------------------

class add_comm_group (A : Type) extends has_add A, has_zero A, has_neg A :=
(add_assoc : ∀ (a b c : A), a + b + c = a + (b + c))
(zero_add : ∀ (a : A), 0 + a = a)
(add_left_neg : ∀ (a : A), -a + a = 0)
(add_comm : ∀ a b : A, a + b = b + a)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la resta en los grupos conmutativos con sumas.
-- ----------------------------------------------------------------------

instance (A : Type) [add_comm_group A] : has_sub A :=
⟨λ a b, a + -b⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los anillos.
-- ----------------------------------------------------------------------

class ring (R : Type) extends monoid R, add_comm_group R :=
(mul_add : ∀ (a b c : R), a * (b + c) = a * b + a * c)
(add_mul : ∀ (a b c : R), (a + b) * c = a * c + b * c)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los anillos conmutativos.
-- ----------------------------------------------------------------------

class comm_ring (R : Type) extends ring R :=
(mul_comm : ∀ a b : R, a * b = b * a)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los tipos con una multiplicación por
-- un escalar.
-- ----------------------------------------------------------------------

class has_scalar (R : Type) (M : Type) :=
(smul : R → M → M)

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar • como la multiplicación por un escalar.
-- ----------------------------------------------------------------------

infixr ` • `:73 := has_scalar.smul

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los módulos (ver
-- https://bit.ly/3hBPZW7 )
-- ----------------------------------------------------------------------

class module (R : Type) [ring R] (M : Type) [add_comm_group M]
extends has_scalar R M :=
(smul_add : ∀(r : R) (x y : M), r • (x + y) = r • x + r • y)
(add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x)
(mul_smul : ∀ (r s : R) (x : M), (r * s) • x = r • s • x)
(one_smul : ∀ x : M, (1 : R) • x = x)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los cuerpos.
-- ----------------------------------------------------------------------

class field (K : Type) extends comm_ring K, has_inv K :=
(zero_ne_one : (0 : K) ≠ 1)
(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1)
(inv_zero : (0 : K)⁻¹ = 0)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los espacios vectoriales.
-- ----------------------------------------------------------------------

def vector_space (K : Type) [field K] (V : Type) [add_comm_group V] :=
module K V

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que los racionales son un cuerpo.
-- ----------------------------------------------------------------------

instance : field ℚ :=
{ mul := (*),
  one := 1,
  mul_assoc := rat.mul_assoc,
  one_mul := rat.one_mul,
  mul_one := rat.mul_one,
  add := (+),
  zero := 0,
  neg := has_neg.neg,
  add_assoc := rat.add_assoc,
  zero_add := rat.zero_add,
  add_left_neg := rat.add_left_neg,
  add_comm := rat.add_comm,
  mul_add := rat.mul_add,
  add_mul := rat.add_mul,
  mul_comm := rat.mul_comm,
  inv := has_inv.inv,
  zero_ne_one := rat.zero_ne_one,
  mul_inv_cancel := rat.mul_inv_cancel,
  inv_zero := inv_zero
  }

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar A como un grupo conmutativo con suma.
-- ----------------------------------------------------------------------

variables {A : Type} [add_comm_group A]

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar a, b y c como variables sobre elementos de A.
-- ----------------------------------------------------------------------

variables (a b c : A)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    a + b = a + c
-- entonces
--    b = c
-- ----------------------------------------------------------------------

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

example
  (Habac : a + b = a + c)
  : b = c :=
calc b = 0 + b        : (add_comm_group.zero_add b).symm
   ... = (-a + a) + b : congr_arg (+ b) (add_comm_group.add_left_neg a).symm
   ... = -a + (a + b) : add_comm_group.add_assoc (-a) a b
   ... = -a + (a + c) : congr_arg ((+) (-a)) Habac
   ... = (-a + a) + c : (add_comm_group.add_assoc (-a) a c).symm
   ... = 0 + c        : congr_arg (+ c) (add_comm_group.add_left_neg a)
   ... = c            : add_comm_group.zero_add c

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

lemma add_comm_group.add_left_cancel
  (Habac : a + b = a + c)
  : b = c :=
begin
  rw ←add_comm_group.zero_add b,
  rw ←add_comm_group.add_left_neg a,
  rw add_comm_group.add_assoc,
  rw Habac,
  rw ←add_comm_group.add_assoc,
  rw add_comm_group.add_left_neg,
  rw add_comm_group.zero_add,
end

-- Prueba
-- ======

/-
A : Type,
_inst_1 : add_comm_group A,
a b c : A,
Habac : a + b = a + c
⊢ b = c
  >> rw ←add_comm_group.zero_add b,
⊢ 0 + b = c
  >> rw ←add_comm_group.add_left_neg a,
⊢ (-a + a) + b = c
  >> rw add_comm_group.add_assoc,
⊢ -a + (a + b) = c
  >> rw Habac,
⊢ -a + (a + c) = c
  >> rw ←add_comm_group.add_assoc,
⊢ (-a + a) + c = c
  >> rw add_comm_group.add_left_neg,
⊢ 0 + c = c
  >> rw add_comm_group.zero_add,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    a + -a = 0
-- ----------------------------------------------------------------------

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

example :
  a + -a = 0 :=
calc a + -a
     = -a + a : add_comm_group.add_comm a (-a)
 ... = 0      : add_comm_group.add_left_neg a

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

example :
  a + -a = 0 :=
calc a + -a
     = -a + a : by rw add_comm_group.add_comm
 ... = 0      : by rw add_comm_group.add_left_neg

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

lemma add_comm_group.add_right_neg :
  a + -a = 0 :=
begin
  rw add_comm_group.add_comm,
  rw add_comm_group.add_left_neg,
end

-- Prueba
-- ======

/-
A : Type,
_inst_1 : add_comm_group A,
a : A
⊢ a + -a = 0
  >> rw add_comm_group.add_comm,
⊢ -a + a = 0
  >> rw add_comm_group.add_left_neg,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    a - b = a + -b
-- ----------------------------------------------------------------------

lemma add_comm_group.sub_eq_add_neg :
  a - b = a + -b :=
rfl

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    a - a = 0
-- ----------------------------------------------------------------------

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

example :
  a - a = 0 :=
calc a - a
     = a + (-a) : add_comm_group.sub_eq_add_neg a a
 ... = -a + a   : add_comm_group.add_comm a (-a)
 ... = 0        : add_comm_group.add_left_neg a

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

example :
  a - a = 0 :=
calc a - a
     = a + (-a) : by rw add_comm_group.sub_eq_add_neg
 ... = -a + a   : by rw add_comm_group.add_comm
 ... = 0        : by rw add_comm_group.add_left_neg

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

example :
  a - a = 0 :=
by rw [add_comm_group.sub_eq_add_neg,
       add_comm_group.add_comm,
       add_comm_group.add_left_neg]

-- 4ª demostración
-- ===============

lemma add_comm_group.sub_self :
  a - a = 0 :=
begin
  rw add_comm_group.sub_eq_add_neg,
  rw add_comm_group.add_comm,
  rw add_comm_group.add_left_neg,
end

-- Prueba
-- ======

/-
A : Type,
_inst_1 : add_comm_group A,
a : A
⊢ a - a = 0
  >> rw add_comm_group.sub_eq_add_neg,
⊢ a + -a = 0
  >> rw add_comm_group.add_comm,
⊢ -a + a = 0
  >> rw add_comm_group.add_left_neg,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    a + b = 0
-- entonces
--    -a = b
-- ----------------------------------------------------------------------

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

example
  (h : a + b = 0)
  : -a = b :=
calc -a
     = 0 + (-a)       : (add_comm_group.zero_add (-a)).symm
 ... = (a + b) + (-a) : congr_arg (+ (-a)) h.symm
 ... = (b + a) + (-a) : congr_arg (+ (-a)) (add_comm_group.add_comm a b)
 ... = b + (a + (-a)) : add_comm_group.add_assoc b a (-a)
 ... = b + 0          : congr_arg ((+) b) (add_comm_group.add_right_neg a)
 ... = 0 + b          : add_comm_group.add_comm b 0
 ... = b              : add_comm_group.zero_add b

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

example
  (h : a + b = 0)
  : -a = b :=
calc -a
     = 0 + (-a)       : by rw add_comm_group.zero_add
 ... = (a + b) + (-a) : by rw h.symm
 ... = (b + a) + (-a) : congr_arg (+ (-a)) (add_comm_group.add_comm a b)
 ... = b + (a + (-a)) : by rw add_comm_group.add_assoc
 ... = b + 0          : congr_arg ((+) b) (add_comm_group.add_right_neg a)
 ... = 0 + b          : by rw add_comm_group.add_comm
 ... = b              : by rw add_comm_group.zero_add

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

lemma add_comm_group.neg_eq_of_add_eq_zero
  (h : a + b = 0)
  : -a = b :=
begin
  apply add_comm_group.add_left_cancel a,
  rw h,
  rw add_comm_group.add_right_neg,
end

-- Prueba
-- ======

/-
A : Type,
_inst_1 : add_comm_group A,
a b : A,
h : a + b = 0
⊢ -a = b
  >> apply add_comm_group.add_left_cancel a,
⊢ a + -a = a + b
  >> rw h,
⊢ a + -a = 0
  >> rw add_comm_group.add_right_neg,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    a + 0 = a
-- ----------------------------------------------------------------------

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

example : a + 0 = a :=
calc a + 0
     = 0 + a : add_comm_group.add_comm a 0
 ... = a     : add_comm_group.zero_add a

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

example : a + 0 = a :=
calc a + 0
     = 0 + a : by rw add_comm_group.add_comm
 ... = a     : by rw add_comm_group.zero_add

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

example : a + 0 = a :=
begin
  rw add_comm_group.add_comm,
  rw add_comm_group.zero_add,
end

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

lemma add_comm_group.add_zero : a + 0 = a :=
by rw [add_comm_group.add_comm,
       add_comm_group.zero_add]

-- Prueba
-- ======

/-
A : Type,
_inst_1 : add_comm_group A,
a : A
⊢ a + 0 = a
  >> rw add_comm_group.add_comm,
⊢ 0 + a = a
  >> rw add_comm_group.zero_add,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar R como una variable implícita sobre los anillos.
-- ----------------------------------------------------------------------

variables {R : Type} [ring R]

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que, para todo r de R,
--    r * 0 = 0
-- ----------------------------------------------------------------------

lemma ring.mul_zero
  (r : R)
  : r * 0 = 0 :=
begin
  apply add_comm_group.add_left_cancel (r * 0),
  rw ←ring.mul_add,
  rw add_comm_group.add_zero,
  rw add_comm_group.add_zero,
end

-- Prueba
-- ======

/-
R : Type,
_inst_2 : ring R,
r : R
⊢ r * 0 = 0
  >> apply add_comm_group.add_left_cancel (r * 0),
⊢ r * 0 + r * 0 = r * 0 + 0
  >> rw ←ring.mul_add,
⊢ r * (0 + 0) = r * 0 + 0
  >> rw add_comm_group.add_zero,
⊢ r * 0 = r * 0 + 0
  >> rw add_comm_group.add_zero,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que, para todo a y b de R,
--    a * -b = -(a * b)
-- ----------------------------------------------------------------------

lemma ring.mul_neg
  (a b : R) :
  a * -b = -(a * b) :=
begin
  symmetry,
  apply add_comm_group.neg_eq_of_add_eq_zero,
  rw ←ring.mul_add,
  rw add_comm_group.add_right_neg,
  rw ring.mul_zero,
end

-- Prueba
-- ======

/-
R : Type,
_inst_2 : ring R,
a b : R
⊢ a * -b = -(a * b)
  >> symmetry,
⊢ -(a * b) = a * -b
  >> apply add_comm_group.neg_eq_of_add_eq_zero,
⊢ a * b + a * -b = 0
  >> rw ←ring.mul_add,
⊢ a * (b + -b) = 0
  >> rw add_comm_group.add_right_neg,
⊢ a * 0 = 0
  >> rw ring.mul_zero,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Sea R un anillo conmutativo. Demostrar que, para todo r, a
-- y b de R,
--    r * (a - b) = r * a - r * b
-- ----------------------------------------------------------------------

lemma ring.mul_sub
  (R : Type)
  [comm_ring R]
  (r a b : R) :
  r * (a - b) = r * a - r * b :=
begin
  rw add_comm_group.sub_eq_add_neg,
  rw ring.mul_add,
  rw ring.mul_neg,
  refl,
end

-- Prueba
-- ======

/-
R : Type,
_inst_3 : comm_ring R,
r a b : R
⊢ r * (a - b) = r * a - r * b
  >> rw add_comm_group.sub_eq_add_neg,
⊢ r * (a + -b) = r * a - r * b
  >> rw ring.mul_add,
⊢ r * a + r * -b = r * a - r * b
  >> rw ring.mul_neg,
⊢ r * a + -(r * b) = r * a - r * b
  >> refl,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Sea R un anillo conmutativo. Demostrar que, para todo r, a
-- y b de R,
--    (a - b) * r = a * r - b * r
-- ----------------------------------------------------------------------

lemma comm_ring.sub_mul
  (R : Type)
  [comm_ring R]
  (r a b : R)
  : (a - b) * r = a * r - b * r :=
begin
  rw comm_ring.mul_comm (a - b),
  rw comm_ring.mul_comm a,
  rw comm_ring.mul_comm b,
  apply ring.mul_sub,
end

-- Prueba
-- ======

/-
R : Type,
_inst_3 : comm_ring R,
r a b : R
⊢ (a - b) * r = a * r - b * r
  >> rw comm_ring.mul_comm (a - b),
⊢ r * (a - b) = a * r - b * r
  >> rw comm_ring.mul_comm a,
⊢ r * (a - b) = r * a - b * r
  >> rw comm_ring.mul_comm b,
⊢ r * (a - b) = r * a - r * b
  >> apply ring.mul_sub,
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Cerrar el espacio de nombres lftcm.
-- ----------------------------------------------------------------------

end lftcm

------------------------------------------------------------------------
-- § Referencia                                                       --
------------------------------------------------------------------------

-- Basado en la teoría algebraic_hierarchy.lean de Kevin Buzzard que se
-- encuentra en https://bit.ly/32S8vFr y se comenta en el vídeo
-- "Building an algebraic hierarchy" que se encuentra en
-- https://youtu.be/ATlAQPAtiTY


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

! This file was ported from Lean 3 source module number_theory.primes_congruent_one
! leanprover-community/mathlib commit 55d224c38461be1e8e4363247dd110137c24a4ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.PrimeFin
import Mathbin.RingTheory.Polynomial.Cyclotomic.Eval

/-!
# Primes congruent to one

We prove that, for any positive `k : ℕ`, there are infinitely many primes `p` such that
`p ≡ 1 [MOD k]`.
-/

namespace Nat

open Polynomial Nat Filter

open Nat

/-- For any positive `k : ℕ` there exists an arbitrarily large prime `p` such that
`p ≡ 1 [MOD k]`. -/
theorem exists_prime_gt_modEq_one {k : ℕ} (n : ℕ) (hk0 : k ≠ 0) :
    ∃ p : ℕ, Nat.Prime p ∧ n < p ∧ p ≡ 1 [MOD k] :=
  by
  rcases(one_le_iff_ne_zero.2 hk0).eq_or_lt with (rfl | hk1)
  · rcases exists_infinite_primes (n + 1) with ⟨p, hnp, hp⟩
    exact ⟨p, hp, hnp, modeq_one⟩
  let b := k * n !
  have hgt : 1 < (eval (↑b) (cyclotomic k ℤ)).natAbs :=
    by
    rcases le_iff_exists_add'.1 hk1.le with ⟨k, rfl⟩
    have hb : 2 ≤ b := le_mul_of_le_of_one_le hk1 n.factorial_pos
    calc
      1 ≤ b - 1 := le_tsub_of_add_le_left hb
      _ < (eval (b : ℤ) (cyclotomic (k + 1) ℤ)).natAbs :=
        sub_one_lt_nat_abs_cyclotomic_eval hk1 (succ_le_iff.1 hb).ne'

  let p := min_fac (eval (↑b) (cyclotomic k ℤ)).natAbs
  haveI hprime : Fact p.prime := ⟨min_fac_prime (ne_of_lt hgt).symm⟩
  have hroot : is_root (cyclotomic k (ZMod p)) (cast_ring_hom (ZMod p) b) :=
    by
    rw [is_root.def, ← map_cyclotomic_int k (ZMod p), eval_map, coe_cast_ring_hom, ← Int.cast_ofNat,
      ← Int.coe_castRingHom, eval₂_hom, Int.coe_castRingHom, ZMod.int_cast_zmod_eq_zero_iff_dvd _ _]
    apply Int.dvd_natAbs.1
    exact_mod_cast min_fac_dvd (eval (↑b) (cyclotomic k ℤ)).natAbs
  have hpb : ¬p ∣ b :=
    hprime.1.coprime_iff_not_dvd.1 (coprime_of_root_cyclotomic hk0.bot_lt hroot).symm
  refine' ⟨p, hprime.1, not_le.1 fun habs => _, _⟩
  · exact hpb (dvd_mul_of_dvd_right (dvd_factorial (min_fac_pos _) habs) _)
  · have hdiv : orderOf (b : ZMod p) ∣ p - 1 :=
      ZMod.orderOf_dvd_card_sub_one (mt (CharP.cast_eq_zero_iff _ _ _).1 hpb)
    haveI : NeZero (k : ZMod p) :=
      NeZero.of_not_dvd (ZMod p) fun hpk => hpb (dvd_mul_of_dvd_left hpk _)
    have : k = orderOf (b : ZMod p) := (is_root_cyclotomic_iff.mp hroot).eq_orderOf
    rw [← this] at hdiv
    exact ((modeq_iff_dvd' hprime.1.Pos).2 hdiv).symm
#align nat.exists_prime_gt_modeq_one Nat.exists_prime_gt_modEq_one

theorem frequently_atTop_modEq_one {k : ℕ} (hk0 : k ≠ 0) :
    ∃ᶠ p in atTop, Nat.Prime p ∧ p ≡ 1 [MOD k] :=
  by
  refine' frequently_at_top.2 fun n => _
  obtain ⟨p, hp⟩ := exists_prime_gt_modeq_one n hk0
  exact ⟨p, ⟨hp.2.1.le, hp.1, hp.2.2⟩⟩
#align nat.frequently_at_top_modeq_one Nat.frequently_atTop_modEq_one

/-- For any positive `k : ℕ` there are infinitely many primes `p` such that `p ≡ 1 [MOD k]`. -/
theorem infinite_setOf_prime_modEq_one {k : ℕ} (hk0 : k ≠ 0) :
    Set.Infinite { p : ℕ | Nat.Prime p ∧ p ≡ 1 [MOD k] } :=
  frequently_atTop_iff_infinite.1 (frequently_atTop_modEq_one hk0)
#align nat.infinite_set_of_prime_modeq_one Nat.infinite_setOf_prime_modEq_one

end Nat


/- by Li Xiang, Laraia Thomas, Pratt Johns Joe, Yu Ella -/
/- GNU General Public License v3.0 -/

import tactic
noncomputable theory

/- 1 Basic Definitions-/

/- There are two ways to define the equivalence relation -/
/- Approach I: Set Theory-/

def is_refl_set {X:Type}(S: set (X× X)):=
∀ a: X, (a,a)∈ S

def is_symm_set {X:Type}(S: set (X× X)):=
∀ a b:X, (a,b)∈ S→ (b,a)∈S

def is_trans_set {X:Type}(S:set (X× X)):=
∀ a b c:X, (a,b)∈ S→ (b,c)∈ S→ (a,c)∈ S

def is_equiv_set {X:Type}(S:set (X× X)):=
is_refl_set S ∧ is_symm_set S
∧ is_trans_set S

def equiv_class_set {X:Type}(S:set (X× X))(a:X):=
{x:X | (x,a)∈ S}

def quotient_set {X:Type}(S:set (X× X)):=
{e:set X | ∃ a:X, e=equiv_class_set S a}

/- Approach II: Type Theory-/
/- I will use this approach in the follwing files. -/

def is_refl_type {X:Type}(S: X→ X→ Prop):= -- Def 1 --
∀ a:X, S a a

def is_symm_type {X:Type}(S: X→ X→ Prop):= -- Def 2 --
∀ a b:X, S a b→ S b a

def is_trans_type {X:Type}(S:X→ X→ Prop):= -- Def 3 --
∀ a b c:X, S a b→ S b c→ S a c

def is_equiv_type {X:Type}(S:X→ X→ Prop):= -- Def 4--
is_refl_type S ∧ is_symm_type S
∧ is_trans_type S

def equiv_class_type {X:Type}(S:X→ X→ Prop)(a:X):= -- Def 5 --
{x:X | S x a}

def quotient_type {X:Type}(S:X→ X→ Prop):= --Def 6 --
{e:set X | ∃ a:X, e=equiv_class_type S a}

/- 2 Properties -/

def convert_to_set(X:Type):set X:={x:X | true}

lemma in_equiv_class {X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(a:X):
a∈ equiv_class_type S a:= -- Lemma 7 --
begin
  cases h with p q,
  apply p a,
end

lemma equiv_class_is_subset{X:Type}(S:X→ X→ Prop)(a:X):
(equiv_class_type S a)⊆convert_to_set(X)
:= -- Lemma 8 --
begin
  intros x f,
  rw convert_to_set,
  rw set.mem_set_of_eq,
  cc,
end

lemma equiv_iff_same_class {X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(a:X)(b:X):
S a b ↔ equiv_class_type S a=equiv_class_type S b
:=  -- Lemma 9 --
begin
  have rfl:=h.1,
  have sym:=h.2.1,
  have tran:=h.2.2,
  split,

  /- → -/
  intro f,
  --cases h with rfl st,
  --cases st with sym tran,
  rw set.subset.antisymm_iff,
  split,
  /- → ⊆-/
  intros x g,
  apply tran x a b g f,
  /- → ⊇ -/
  intros x g,
  have t:=sym a b f,
  apply tran x b a g t,

  /- ← -/
  intro f,
  have u:=in_equiv_class h a,
  rw f at u,
  exact u,
end

lemma equiv_iff_class_intersect{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(a:X)(b:X):
S a b ↔ (equiv_class_type S a ∩ equiv_class_type S b).nonempty
:= --Lemma 10 --
begin
  have rfl:=h.1,
  have sym:=h.2.1,
  have tran:=h.2.2,
  split,

  /- → -/
  intro f,
  rw set.nonempty,
  use a,
  rw set.mem_inter_eq,
  split,
  have t:=in_equiv_class h a,
  exact t,
  exact f,

  /- ← -/
  intro f,
  cases f with x fx,
  rw set.mem_inter_eq at fx,
  cases fx with fxp fxq,
  have t:=sym x a fxp,
  apply tran a x b t fxq,
end

lemma same_class_iff_intersect{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(a:X)(b:X): -- Lemma 11 --
equiv_class_type S a = equiv_class_type S b ↔
(equiv_class_type S a ∩ equiv_class_type S b).nonempty:=
begin
  have p:=equiv_iff_same_class h a b,
  have q:=equiv_iff_class_intersect h a b,
  rw p at q,
  exact q,
end

lemma contrapose_iff {P:Prop}{Q:Prop}:(P↔Q)↔(¬P↔¬Q):=
begin
  split,
  intro f,
  cc,
  intro f,
  split,
  cc,
  cc,
end

lemma equiv_class_disjoint{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(a:X)(b:X):
equiv_class_type S a ≠ equiv_class_type S b ↔
(equiv_class_type S a ∩ equiv_class_type S b)=∅
:= -- Lemma 12 --
begin
  have q:=same_class_iff_intersect h a b,
  rw contrapose_iff at q,
  rw set.not_nonempty_iff_eq_empty at q,
  cc,
end

lemma equiv_class_union{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S):
(⋃ (ind:X), (equiv_class_type S ind))=convert_to_set(X)
:= -- Lemma 13 --
begin
  rw set.subset.antisymm_iff,
  split,

  /- ⊆ -/
  intros x f,
  rw convert_to_set,
  rw set.mem_set_of_eq,
  cc,

  /- ⊇ -/
  intros x f,
  have t:=in_equiv_class h x,
  rw set.mem_Union,
  use x,
  exact t,
end

/- 3 Canonical Map and Section -/

lemma equiv_class_type_in_quotient_type{X:Type}
(S:X→ X→ Prop)(a:X):
equiv_class_type S a ∈ quotient_type S:= -- Lemma 14 --
begin
  use a,
end

def can{X:Type}(S:X→ X→ Prop):X→ quotient_type S:= -- Def 15 --
λa,⟨equiv_class_type S a, equiv_class_type_in_quotient_type S a⟩

lemma in_can{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(a:X):
a∈ (can S a).val:=
begin
  exact in_equiv_class h a,
end

lemma can_be_repres{X:Type}{S:X→ X→ Prop}
(e:quotient_type S):∃ a:X, e.val=equiv_class_type S a
:= -- Lemma 16 pre --
begin
  have t:=subtype.mem e,
  cases t with a ta,
  use a,
  exact ta,
end

lemma equiv_class_nonempty{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(e:quotient_type S):e.val.nonempty
:= -- Lemma 16 --
begin
  rw set.nonempty_def,
  have t:=can_be_repres e,
  cases t with a ta,
  use a,
  rw ta,
  apply in_equiv_class h a,
end

def particular_sec{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S):quotient_type S→ X:= -- Def 17 --
λe, set.nonempty.some (equiv_class_nonempty h e)

def can_sec{X:Type}{S:X→ X→ Prop}(sec:(quotient_type S)→ X):
quotient_type S→ quotient_type S := -- Def 18 --
λe, can S (sec e)

lemma sec_equiv{X:Type}{S:X→ X→ Prop}(h: is_equiv_type S)
{sec:(quotient_type S)→ X}{sec':(quotient_type S)→ X}
(hs: can_sec sec=id)(hs': can_sec sec'=id)(e:quotient_type S):
S (sec e) (sec' e):= -- Lemma 19 --
begin
  rw equiv_iff_same_class h,
  unfold can_sec at *,
  have t:=(congr_fun (eq.symm hs) e).symm,
  have u:=(congr_fun (eq.symm hs') e).symm,
  unfold can at *,
  rw ← t at u,
  simp at *,
  symmetry,
  exact u,
end

lemma par_sec_in{X:Type}{S:X→ X→ Prop}(h: is_equiv_type S)
(x:quotient_type S):
(particular_sec h x) ∈ x.val:= -- Lemma 20 --
begin
  unfold particular_sec,
  exact (equiv_class_nonempty h x).some_mem,
end

@[simp] lemma can_par_sec_id{X:Type}{S:X→ X→ Prop}(h: is_equiv_type S):
can_sec (particular_sec h)=id:= -- Lemma 21 --
begin
  unfold can_sec,
  ext1,
  unfold id,
  ext1,
  unfold can,
  simp,
  have t:=in_equiv_class h (particular_sec h x),
  have u:=par_sec_in h x,
  have v:∃a:X, x.val=equiv_class_type S a:=can_be_repres x,
  cases v with a,
  simp at *,
  rw v_h at *,
  have ne_empty:((equiv_class_type S (particular_sec h x))∩
  (equiv_class_type S a)).nonempty:=begin
    rw set.nonempty_def,
    use particular_sec h x,
    simp,
    split,
    exact t,
    exact u,
  end,
  rw same_class_iff_intersect h _ _,
  exact ne_empty,
end

@[simp] lemma can_par_sec{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(e:quotient_type S):
can_sec (particular_sec h) e=e:= -- Lemma 21' --
begin
  rw can_par_sec_id,
  rwa id,
end

@[simp] lemma can_par_sec_expand{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(e:quotient_type S):
can S (particular_sec h e)=e:= -- Lemma 21'' --
begin
  have t:can S(particular_sec h e)=can_sec (particular_sec h) e:=
    by unfold can_sec,
  rw t,
  exact can_par_sec h e,
end

lemma par_sec_can{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(a:X):
S (particular_sec h (can S a)) a:= -- Lemma 22 --
begin
  have t:=par_sec_in h (can S a),
  unfold can at t,
  unfold equiv_class_type at t,
  simp at *,
  exact t,
end

lemma equiv_iff_same_image_under_can{X:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(a:X)(b:X):
S a b ↔ can S a=can S b:= -- Lemma 23 --
begin
  unfold can,
  simp,
  exact equiv_iff_same_class h a b,
end

/- 4 Operations -/

def induced_op_by_sec{X:Type}{Y:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(sec:(quotient_type S)→ X)(op:X→ Y):
quotient_type S→ Y:= -- Def 24, one argument --
λ e, op (sec e)

def induced_op{X:Type}{Y:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(op:X→ Y):= -- Def 25, one argument --
induced_op_by_sec h (particular_sec h) op

def op_is_well_defined{X:Type}{Y:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(op:X→ Y):= -- Def 26, one argument --
∀ a b:X, S a b → op a=op b

lemma op_reduction{X:Type}{Y:Type}{S:X→ X→ Prop}
{h: is_equiv_type S}{op:X→ Y}
(hw: op_is_well_defined h op)
{e :quotient_type S}{a:X}{c:Y}
(h1: can S a=e)(ho: op a=c):
induced_op h op e=c:= -- Lemma 27, one argument --
begin
  unfold induced_op,
  unfold induced_op_by_sec,
  rw ← h1,
  have t:=par_sec_can h a,
  have u:=hw _ _ t,
  rw u,
  exact ho,
end

def induced_op2_by_sec{X:Type}{Y:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(sec:(quotient_type S)→ X)(op:X→ X→ Y):
quotient_type S→ quotient_type S→ Y:= -- Def 24', two arguments --
λe1,λe2, op (sec e1) (sec e2)

def induced_op2{X:Type}{Y:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(op:X→ X→ Y):= -- Def 25', two arguments --
induced_op2_by_sec h (particular_sec h) op

def op2_is_well_defined{X:Type}{Y:Type}{S:X→ X→ Prop}
(h: is_equiv_type S)(op:X→ X→ Y):= -- Def 26', two arguments --
∀ a b c d:X, S a c→ S b d→ op a b=op c d

lemma op2_reduction{X:Type}{Y:Type}{S:X→ X→ Prop}
{h: is_equiv_type S}{op:X→ X→ Y}
(hw: op2_is_well_defined h op)
{e1 e2 :quotient_type S}{a b:X}{c:Y}
(h1: can S a=e1)(h2:can S b=e2)(ho: op a b=c):
induced_op2 h op e1 e2=c:= -- Lemma 27', two arguments --
begin
  unfold induced_op2,
  unfold induced_op2_by_sec,
  rw ← h1,
  rw ← h2,
  have t1:=par_sec_can h a,
  have t2:=par_sec_can h b,
  have u:=hw _ _ _ _ t1 t2,
  rw u,
  exact ho,
end

/- 5 Partition -/

lemma Enonempty{X:Type}{S:X→ X→ Prop}(h: is_equiv_type S):
∀ e∈ quotient_type S, (e:set X).nonempty:=
begin
  intros e f,
  unfold quotient_type at f,
  simp at *,
  cases f with a,
  use a,
  rw f_h,
  exact in_equiv_class h a,
end

lemma Ecover{X:Type}{S:X→ X→ Prop}(h: is_equiv_type S):
∀ a:X, ∃ e ∈ quotient_type S, a ∈ e:=
begin
  intro a,
  use (equiv_class_type S a),
  split,
  exact equiv_class_type_in_quotient_type _ _,
  exact in_equiv_class h a,
end

lemma Edisjoint{X:Type}{S:X→ X→ Prop}(h: is_equiv_type S):
∀ e1 e2 ∈ quotient_type S, (e1 ∩ e2 : set X).nonempty → e1=e2:=
begin
  intros e1 e2 f g s,
  unfold quotient_type at *,
  simp at *,
  cases f with a,
  cases g with b,
  rw f_h at *,
  rw g_h at *,
  rw (same_class_iff_intersect h a b),
  exact s,
end


import data.real.basic data.set.basic

namespace M1F

def is_ub (b : ℝ) (S : set ℝ) := ∀ s ∈ S, s ≤ b

-- in _root_ already
def is_lub (l : ℝ) (S : set ℝ) :=
  is_ub l S ∧ ∀ b : ℝ, is_ub b S → l ≤ b

lemma Q2b (S : set ℝ) (l₁ l₂ : ℝ) (h₁ : is_lub l₁ S)
  (h₂ : is_lub l₂ S) : l₁ = l₂ :=
begin
  have hub₁ : is_ub l₁ S := h₁.1,
  have hub₂ : is_ub l₂ S := h₂.1,
  have h12 : l₁ ≤ l₂ := h₁.2 l₂ hub₂,
  have h21 : l₂ ≤ l₁ := h₂.2 l₁ hub₁,
  exact le_antisymm h12 h21
end

lemma Q2ci (S T : set ℝ) (a b : ℝ) (hS : is_lub a S)
  (hT : is_lub b T) :
is_lub (max a b) (S ∪ T) :=
begin
  split,
  { intro u,
    intro hu,
    cases hu with hs ht,
    { apply le_trans _ (le_max_left a b),
      exact hS.1 _ hs
    },
     { apply le_trans _ (le_max_right a b),
      exact hT.1 _ ht
    }
  },
  { intro x,
    intro hx,
    apply max_le,
    {
      apply hS.2,
      intros s hs,
      apply hx,
      left,
      assumption
    },
    {
      apply hT.2,
      intros t ht,
      apply hx,
      right,
      assumption
    }
  }
end

-- preparatory lemmas for c(ii)
open set
lemma ub_singleton_iff {a b : ℝ} : is_ub a {b} ↔ b ≤ a :=
⟨λ h, h _ $ mem_singleton b, λ h c hc, (mem_singleton_iff.1 hc).symm ▸ h⟩

lemma lub_singleton (a : ℝ) : is_lub a {a} :=
⟨ub_singleton_iff.2 $ le_refl a, λ b, ub_singleton_iff.1⟩

lemma set.mem_pair {a b c : ℝ} : c ∈ ({a, b} : set ℝ) ↔ c = a ∨ c = b :=
⟨λ h, h.rec or.inr (λ H, or.inl $ mem_singleton_iff.1 H), λ h, or.elim h
(λ h, by simp [h]) (λ h, by simp [h])⟩

lemma ub_pair {a b c : ℝ} : is_ub c {a, b} ↔ max a b ≤ c :=
⟨λ h, max_le (h _ $ by simp) (h _ $ by simp),
 λ h s hs, begin cases set.mem_pair.1 hs with h2 h2; rw h2,
   exact le_trans (le_max_left _ _) h,
   exact le_trans (le_max_right _ _) h, end⟩

lemma lub_pair {a b : ℝ} : is_lub (max a b) {a, b} :=
⟨ub_pair.2 $ le_refl _,λ _, ub_pair.1⟩

lemma Q2cii :
∃ (S : set ℝ) (T : set ℝ) (a b : ℝ),
is_lub a S ∧ is_lub b T ∧
  ∃ x : ℝ, is_lub x (S ∩ T) ∧ x ≠ min a b :=
begin
  -- S
  use {1, 2},
  -- T
  use {1, 3},
  -- a
  use 2,
  -- b
  use 3,
  -- 2 is LUB of {1, 2}
  split, convert lub_pair, norm_num,
  -- 3 is LUB of {1, 3}
  split, convert lub_pair, norm_num,
  -- 1 is LUB of the intersection
  use 1,
  split,
  { -- {1, 2} ∩ {1, 3} = {1}
    convert lub_singleton 1,
    ext,
    split,
      intro h, cases h with h1 h2,
      cases h1, rw h1 at h2, revert h2, norm_num,
      assumption,
    intro h, rw mem_singleton_iff at h, rw h,
    simp,
  },
  norm_num
end

lemma Q2di (S : ℕ → set ℝ) (s : ℝ) (hs : is_lub s (Union S))
  (b : ℕ → ℝ) (h : ∀ n, is_lub (b n) (S n))
  : is_lub s (set.range b) :=
begin
  split,
  {
    intros t h2,
    rcases mem_range.1 h2 with ⟨n, rfl⟩,
    apply (h n).2,
    intros t ht,
    apply hs.1,
    rw mem_Union,
    use n,
    exact ht
  },
  {
    intros c hc,
    apply hs.2,
    intros s hs,
    rw mem_Union at hs,
    cases hs with n hn,
    apply le_trans ((h n).1 _ hn),
    apply hc,
    use n
  }
end

end M1F