import data.nat.prime
import algebra.big_operators
import tactic

open_locale big_operators

/- TEXT:
.. _section_infinitely_many_primes:

Infinitely Many Primes
----------------------

Let us continue our exploration of induction and recursion with another
mathematical standard: a proof that there are infinitely many primes.
One way to formulate this is as the statement that
for every natural number
:math:`n`, there is a prime number greater than :math:`n`.
To prove this, let :math:`p` be any prime factor of :math:`n! + 1`.
If :math:`p` is less than :math:`n`, it divides :math:`n!`.
Since it also divides :math:`n! + 1`, it divides 1, a contradiction.
Hence :math:`p` is greater than :math:`n`.

To formalize that proof, we need to show that any number greater than or equal
to 2 has a prime factor.
To do that, we will need to show that any natural number that is
not equal to 0 or 1 is greater-than or equal to 2.
And this brings us to a quirky feature of formalization:
it is often trivial statements like this that are among the most
annoying to formalize.
Here we consider a few ways to do it.

To start with, we can use the ``cases`` tactic and the fact that the
successor function respects the ordering on the natural numbers.
BOTH: -/
-- QUOTE:
theorem two_le {m : ℕ} (h0 : m ≠ 0) (h1 : m ≠ 1) : 2 ≤ m :=
begin
  cases m, contradiction,
  cases m, contradiction,
  repeat { apply nat.succ_le_succ },
  apply zero_le
end
-- QUOTE.

/- TEXT:
Another strategy is to use the tactic ``interval_cases``,
which automatically splits the goal into cases when
the variable in question is contained in an interval
of natural numbers or integers.
Remember that you can hover over it to see its documentation.
EXAMPLES: -/
-- QUOTE:
example {m : ℕ} (h0 : m ≠ 0) (h1 : m ≠ 1) : 2 ≤ m :=
begin
  by_contradiction h,
  push_neg at h,
  interval_cases m; contradiction
end
-- QUOTE.

/- TEXT:
Recall that the semicolon after ``interval_cases m`` means
that the next tactic is applied to each of the cases that it generates.
Yet another option is to use the tactic, ``dec_trivial``, which tries
to find a decision procedure to solve the problem.
Lean knows that you can decide the truth value of a statement that
begins with a bounded quantifier ``∀ x, x < n → ...`` or ``∃ x, x < n ∧ ...``
by deciding each of the finitely many instances.
EXAMPLES: -/
-- QUOTE:
example {m : ℕ} (h0 : m ≠ 0) (h1 : m ≠ 1) : 2 ≤ m :=
begin
  by_contradiction h,
  push_neg at h,
  revert m h h0 h1,
  dec_trivial
end
-- QUOTE.

/- TEXT:
In fact, the variant ``dec_trivial!`` will revert all the hypotheses
that contain a variable that is found in the target.
EXAMPLES: -/
-- QUOTE:
example {m : ℕ} (h : m < 2) : m = 0 ∨ m = 1 :=
by dec_trivial!
-- QUOTE.

/- TEXT:
Finally, in this case we can use the ``omega`` tactic, which is designed
to reason about linear expressions in the natural numbers.
EXAMPLES: -/
-- QUOTE:
example {m : ℕ} (h0 : m ≠ 0) (h1 : m ≠ 1) : 2 ≤ m :=
by omega
-- QUOTE.

/- TEXT:
With the theorem ``two_le`` in hand, let's start by showing that every
natural number greater than two has a prime divisor.
Mathlib contains a function ``nat.min_fac`` that
returns the smallest prime divisor,
but for the sake of learning new parts of the library,
we'll avoid using it and prove the theorem directly.

Here, ordinary induction isn't enough.
We want to use *strong induction*, which allows us to prove
that every natural number :math:`n` has a property :math:`P`
by showing that for every number :math:`n`, if :math:`P` holds
of all values less than :math:`n`, it holds at :math:`n` as well.
In Lean, this principle is called ``nat.strong_induction_on``,
and we can use the ``with`` keyword to tell the induction tactic
to use it.
Notice that when we do that, there is no base case; it is subsumed
by the general induction step.

The argument is simply as follows. Assuming :math:`n ≥ 2`,
if :math:`n` is prime, we're done. If it isn't,
then by one of the characterizations of what it means to be a prime number,
it has a nontrivial factor, :math:`m`,
and we can apply the inductive hypothesis to that.
Step through the next proof to see how that plays out.
The line ``dsimp at ih`` simplifies the expression of the
inductive hypothesis to make it more readable.
The proof still works if you delete that line.
BOTH: -/
-- QUOTE:
theorem exists_prime_factor {n : nat} (h : 2 ≤ n) :
  ∃ p : nat, p.prime ∧ p ∣ n :=
begin
  by_cases np : n.prime,
  { use [n, np, dvd_rfl] },
  induction n using nat.strong_induction_on with n ih,
  dsimp at ih,
  rw nat.prime_def_lt at np,
  push_neg at np,
  rcases np h with ⟨m, mltn, mdvdn, mne1⟩,
  have : m ≠ 0,
  { intro mz,
    rw [mz, zero_dvd_iff] at mdvdn,
    linarith },
  have mgt2 : 2 ≤ m := two_le this mne1,
  by_cases mp : m.prime,
  { use [m, mp, mdvdn] },
  rcases ih m mltn mgt2 mp with ⟨p, pp, pdvd⟩,
  use [p, pp, pdvd.trans mdvdn]
end
-- QUOTE.

/- TEXT:
We can now prove the following formulation of our theorem.
See if you can fill out the sketch.
You can use ``nat.factorial_pos``, ``nat.dvd_factorial``,
and ``nat.dvd_sub``.
BOTH: -/
-- QUOTE:
theorem primes_infinite : ∀ n, ∃ p > n, nat.prime p :=
begin
  intro n,
  have : 2 ≤ nat.factorial (n + 1) + 1,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { apply nat.succ_le_succ,
    exact nat.succ_le_of_lt (nat.factorial_pos _) },
-- BOTH:
  rcases exists_prime_factor this with ⟨p, pp, pdvd⟩,
  refine ⟨p, _, pp⟩,
  show p > n,
  by_contradiction ple, push_neg at ple,
  have : p ∣ nat.factorial (n + 1),
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { apply nat.dvd_factorial,
    apply pp.pos,
    linarith },
-- BOTH:
  have : p ∣ 1,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { convert nat.dvd_sub' pdvd this, simp },
-- BOTH:
  show false,
/- EXAMPLES:
    sorry
SOLUTIONS: -/
  have := nat.le_of_dvd zero_lt_one this,
  linarith [pp.two_le]
-- BOTH:
end
-- QUOTE.

/- TEXT:
Let's consider a variation of the proof above, where instead
of using the factorial function,
we suppose that we are given by a finite set
:math:`\{ p_1, \ldots, p_n \}` and we consider a prime factor of
:math:`\prod_{i = 1}^n p_i + 1`.
That prime factor has to be distinct from each
:math:`p_i`, showing that there is no finite set that contains
all the prime numbers.

Formalizing this argument requires us to reason about finite
sets. In Lean, for any type ``α``, the type ``finset α``
represents finite sets of elements of type ``α``.
Reasoning about finite sets computationally requires having
a procedure to test equality on ``α``, which is why the snippet
below includes the assumption ``[decidable_eq α]``.
For concrete data types like ``ℕ``, ``ℤ``, and ``ℚ``,
the assumption is satisfied automatically. When reasoning about
the real numbers, it can be satisfied using classical logic
and abandoning the computational interpretation.

We use the command ``open finset`` to avail ourselves of shorter names
for the relevant theorems. Unlike the case with sets,
most equivalences involving finsets do not hold definitionally,
so they need to be expanded manually using equivalances like
``finset.subset_iff``, ``finset.mem_union``, ``finset.mem_inter``,
and ``finset.mem_sdiff``. The ``ext`` tactic can still be used
to reduce show that two finite sets are equal by showing
that every element of one is an element of the other.
BOTH: -/
-- QUOTE:
open finset

-- EXAMPLES:
section
variables {α : Type*} [decidable_eq α] (r s t : finset α)

example : r ∩ (s ∪ t) ⊆ (r ∩ s) ∪ (r ∩ t) :=
begin
  rw subset_iff,
  intro x,
  rw [mem_inter, mem_union, mem_union, mem_inter, mem_inter],
  tauto
end

example : r ∩ (s ∪ t) ⊆ (r ∩ s) ∪ (r ∩ t) :=
by { simp [subset_iff], intro x, tauto }

example : (r ∩ s) ∪ (r ∩ t) ⊆ r ∩ (s ∪ t) :=
by { simp [subset_iff], intro x, tauto }

example : (r ∩ s) ∪ (r ∩ t) = r ∩ (s ∪ t) :=
by { ext x, simp, tauto }

end
-- QUOTE.

/- TEXT:
We have used a new trick: the ``tauto`` tactic (and a strengthened
version, ``tauto!``, which uses classical logic) can be used to
dispense with propositional tautologies. See if you can use
these methods to prove the two examples below.
BOTH: -/
section
variables {α : Type*} [decidable_eq α] (r s t : finset α)

-- QUOTE:
example : (r ∪ s) ∩ (r ∪ t) = r ∪ (s ∩ t) :=
/- EXAMPLES:
sorry
SOLUTIONS: -/
begin
  ext x,
  rw [mem_inter, mem_union, mem_union, mem_union, mem_inter],
  tauto
end

example : (r ∪ s) ∩ (r ∪ t) = r ∪ (s ∩ t) :=
by { ext x, simp, tauto }
-- BOTH:

example : (r \ s \ t) = r \ (s ∪ t) :=
/- EXAMPLES:
sorry
SOLUTIONS: -/
begin
  ext x,
  rw [mem_sdiff, mem_sdiff, mem_sdiff, mem_union],
  tauto
end

example : (r \ s \ t) = r \ (s ∪ t) :=
by { ext x, simp, tauto }
-- QUOTE.
-- BOTH:

end
/- TEXT:
The theorem ``finset.dvd_prod_of_mem`` tells us that if an
``n`` is an element of a finite set ``s``, then ``n`` divides
``∏ i in s, i``.
EXAMPLES: -/
-- QUOTE:
example (s : finset ℕ) (n : ℕ) (h : n ∈ s) : n ∣ (∏ i in s, i) :=
finset.dvd_prod_of_mem _ h
-- QUOTE.

/- TEXT:
We also need to know that the converse holds in the case where
``n`` is prime and ``s`` is a set of primes.
To show that, we need the following lemma, which you should
be able to prove using the theorem ``nat.prime.eq_one_or_self_of_dvd``.
BOTH: -/
-- QUOTE:
theorem nat.prime.eq_of_dvd_of_prime {p q : ℕ}
    (prime_p : nat.prime p) (prime_q : nat.prime q) (h : p ∣ q) :
  p = q :=
/- EXAMPLES:
sorry
SOLUTIONS: -/
begin
  cases prime_q.eq_one_or_self_of_dvd _ h,
  { linarith [prime_p.two_le] },
  assumption
end
-- QUOTE.
-- BOTH:

/- TEXT:
We can use this lemma to show that if a prime ``p`` divides a product of a finite
set of primes, then it divides one of them.
Mathlib provides a useful principle of induction on finite sets:
to show that a property holds of an arbitrary finite set ``s``,
show that it holds of the empty set, and show that it is preserved
when we add a single new element ``a ∉ s``.
The principle is known as ``finset.induction_on``.
When we tell the induction tactic to use it, we can also specify the names
``a`` and ``s``, the name for the assumption ``a ∉ s`` in the inductive step,
and the name of the inductive hypothesis.
The expression ``finset.insert a s`` denotes the union of ``s`` with the singleton ``a``.
The identities ``finset.prod_empty`` and ``finset.prod_insert`` then provide
the relevant rewrite rules for the product.
In the proof below, the first ``simp`` applies ``finset.prod_empty``.
Step through the beginning of the proof to see the induction unfold,
and then finish it off.
BOTH: -/
-- QUOTE:
theorem mem_of_dvd_prod_primes {s : finset ℕ} {p : ℕ} (prime_p : p.prime) :
  (∀ n ∈ s, nat.prime n) →  (p ∣ ∏ n in s, n) → p ∈ s :=
begin
  intros h₀ h₁,
  induction s using finset.induction_on with a s ans ih,
  { simp at h₁,
    linarith [prime_p.two_le] },
  simp [finset.prod_insert ans, prime_p.dvd_mul] at h₀ h₁,
  rw mem_insert,
/- EXAMPLES:
  sorry
SOLUTIONS: -/
  cases h₁ with h₁ h₁,
  { left, exact prime_p.eq_of_dvd_of_prime h₀.1 h₁ },
  right,
  exact ih h₀.2 h₁
-- BOTH:
end
-- QUOTE.

/- TEXT:
We need one last property of finite sets.
Given an element ``s : set α`` and a predicate
``P`` on ``α``, in  :numref:`Chapter %s <sets_and_functions>`
we wrote ``{ x ∈ s | P x }`` for the set of
elements of ``s`` that satisfy ``P``.
Given ``s : finset α``,
the analogous notion is written ``s.filter P``.
EXAMPLES: -/
-- QUOTE:
example (s : finset ℕ) (x : ℕ) : x ∈ s.filter nat.prime ↔ x ∈ s ∧ x.prime :=
mem_filter
-- QUOTE.

/- TEXT:
We now prove an alternative formulation of the statement that there are infinitely many
primes, namely, that given any ``s : finset ℕ``, there is a prime ``p`` that is not
an element of ``s``.
Aiming for a contradiction, we assume that all the primes are in ``s``, and then
cut down to a set ``s'`` that contains all and only the primes.
Taking the product of that set, adding one, and finding a prime factor
of the result
leads to the contradiction we are looking for.
See if you can complete the sketch below.
You can use ``finset.prod_pos`` in the proof of the first ``have``.
BOTH: -/
-- QUOTE:
theorem primes_infinite' : ∀ (s : finset nat), ∃ p, nat.prime p ∧ p ∉ s :=
begin
  intro s,
  by_contradiction h,
  push_neg at h,
  set s' := s.filter nat.prime with s'_def,
  have mem_s' : ∀ {n : ℕ}, n ∈ s' ↔ n.prime,
  { intro n,
    simp [s'_def],
    apply h },
  have : 2 ≤ (∏ i in s', i) + 1,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { apply nat.succ_le_succ,
    apply nat.succ_le_of_lt,
    apply finset.prod_pos,
    intros n ns',
    apply (mem_s'.mp ns').pos },
-- BOTH:
  rcases exists_prime_factor this with ⟨p, pp, pdvd⟩,
  have : p ∣ (∏ i in s', i),
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { apply dvd_prod_of_mem,
    rw mem_s',
    apply pp },
-- BOTH:
  have : p ∣ 1,
  { convert nat.dvd_sub' pdvd this, simp },
  show false,
/- EXAMPLES:
    sorry
SOLUTIONS: -/
  have := nat.le_of_dvd zero_lt_one this,
  linarith [pp.two_le]
-- BOTH:
end
-- QUOTE.

/- TEXT:
We have thus seen two ways of saying that there are infinitely many primes:
saying that they are not bounded by any ``n``, and saying that they are
not contained in any finite set ``s``.
The two proofs below show that these formulations are equivalent.
In the second, in order to form ``s.filter Q``, we have to assume that there
is a procedure for deciding whether or not ``Q`` holds. Lean knows that there
is a procedure for ``nat.prime``. In general, if we use classical logic
by writing ``open_locale classical``,
we can dispense with the assumption.

In mathlib, ``finset.sup s f`` denotes the supremum of the values of ``f x`` as ``x``
ranges over ``s``, returning ``0`` in the case where ``s`` is empty and
the codomain of ``f`` is ``ℕ``. In the first proof, we use ``s.sup id``,
where ``id`` is the identity function, to refer to the maximum value in ``s``.
BOTH: -/
-- QUOTE:
theorem bounded_of_ex_finset (Q : ℕ → Prop):
  (∃ s : finset ℕ, ∀ k, Q k → k ∈ s) → ∃ n, ∀ k, Q k → k < n :=
begin
  rintros ⟨s, hs⟩,
  use s.sup id + 1,
  intros k Qk,
  apply nat.lt_succ_of_le,
  show id k ≤ s.sup id,
  apply le_sup (hs k Qk)
end

theorem ex_finset_of_bounded (Q : ℕ → Prop) [decidable_pred Q] :
  (∃ n, ∀ k, Q k → k ≤ n) → (∃ s : finset ℕ, ∀ k, Q k ↔ k ∈ s) :=
begin
  rintros ⟨n, hn⟩,
  use (range (n + 1)).filter Q,
  intro k,
  simp [nat.lt_succ_iff],
  exact hn k
end
-- QUOTE.

/- TEXT:
A small variation on our second proof that there are infinitely many primes
shows that there are infinitely many primes congruent to 3 modulo 4.
The argument goes as follows.
First, notice that if the product of two numbers :math:`m` and :math:`n`
is equal to 3 modulo 4, then one of the two numbers is congruent to three modulo 4.
After all, both have to be odd, and if they are both congruent to 1 modulo 4,
so is their product.
We can use this observation to show that if some number
greater than 2 is congruent to 3 modulo 4,
then that number has a prime divisor that is also congruent to 3 modulo 4.

Now suppose there are only finitely many prime numbers congruent to 3
modulo 4, say, :math:`p_1, \ldots, p_k`.
Without loss of generality, we can assume that :math:`p_1 = 3`.
Consider the product :math:`4 \prod_{i = 2}^k p_i + 3`.
It is easy to see that this is congruent to 3 modulo 4, so it has
a prime factor :math:`p` congruent to 3 modulo 4.
It can't be the case that :math:`p = 3`; since :math:`p`
divides :math:`4 \prod_{i = 2}^k p_i + 3`, if :math:`p`
were equal to 3 then it would also divide :math:`\prod_{i = 2}^k p_i`,
which implies that :math:`p` is equal to
one of the :math:`p_i` for :math:`i = 2, \ldots, k`;
and we have excluded 3 from this list.
So :math:`p` has to be one of the other elements :math:`p_i`.
But in that case, :math:`p` divides :math:`4 \prod_{i = 2}^k p_i`
and hence 3, which contradicts the fact that it is not 3.

In Lean, the notation ``n % m``, read "``n`` modulo ``m``,"
denotes the remainder of the division of ``n`` by ``m``.
EXAMPLES: -/
-- QUOTE:
example : 27 % 4 = 3 := by norm_num
-- QUOTE.

/- TEXT:
We can then render the statment "``n`` is congruent to 3 modulo 4"
as ``n % 4 = 3``. The following example and theorems sum up
the facts about this function that we will need to use below.
The first named theorem is another illustration of reasoning by
a small number of cases.
In the second named theorem, remember that the semicolon means that
the subsequent tactic block is applied to both of the goals
that result from the application of ``two_le``.
EXAMPLES: -/
-- QUOTE:
example (n : ℕ) : (4 * n + 3) % 4 = 3 :=
by { rw [add_comm, nat.add_mul_mod_self_left], norm_num }

-- BOTH:
theorem mod_4_eq_3_or_mod_4_eq_3 {m n : ℕ} (h : m * n % 4 = 3) :
  m % 4 = 3 ∨ n % 4 = 3 :=
begin
  revert h,
  rw [nat.mul_mod],
  have : m % 4 < 4 := nat.mod_lt m (by norm_num),
  interval_cases m % 4 with hm; simp [hm],
  have : n % 4 < 4 := nat.mod_lt n (by norm_num),
  interval_cases n % 4 with hn; simp [hn]; norm_num
end

theorem two_le_of_mod_4_eq_3 {n : ℕ} (h : n % 4 = 3) : 2 ≤ n :=
by apply two_le; { intro neq, rw neq at h, norm_num at h }
-- QUOTE.

/- TEXT:
We will also need the following fact, which says that if
``m`` is a nontrivial divisor of ``n``, then so is ``n / m``.
See if you can complete the proof using ``nat.div_dvd_of_dvd``
and ``nat.div_lt_self``.
BOTH: -/
-- QUOTE:
theorem aux {m n : ℕ} (h₀ : m ∣ n) (h₁ : 2 ≤ m) (h₂ : m < n) :
  (n / m) ∣ n ∧ n / m < n :=
/- EXAMPLES:
sorry
SOLUTIONS: -/
begin
  split,
  { exact nat.div_dvd_of_dvd h₀ },
  exact nat.div_lt_self (lt_of_le_of_lt (zero_le _) h₂) h₁
end
-- QUOTE.
-- BOTH:

/- TEXT:
Now put all the pieces together to prove that any
number congruent to 3 modulo 4 has a prime divisor with that
same property.
BOTH: -/
-- QUOTE:
theorem exists_prime_factor_mod_4_eq_3 {n : nat} (h : n % 4 = 3) :
  ∃ p : nat, p.prime ∧ p ∣ n ∧ p % 4 = 3 :=
begin
  by_cases np : n.prime,
  { use [n, np, dvd_rfl, h] },
  induction n using nat.strong_induction_on with n ih,
  dsimp at ih,
  rw nat.prime_def_lt at np,
  push_neg at np,
  rcases np (two_le_of_mod_4_eq_3 h) with ⟨m, mltn, mdvdn, mne1⟩,
  have mge2 : 2 ≤ m,
  { apply two_le _ mne1,
    intro mz,
    rw [mz, zero_dvd_iff] at mdvdn, linarith },
  have neq : m * (n / m) = n := nat.mul_div_cancel' mdvdn,
  have : m % 4 = 3 ∨ (n / m) % 4 = 3,
  { apply mod_4_eq_3_or_mod_4_eq_3, rw [neq, h] },
  cases this with h1 h1,
/- EXAMPLES:
  { sorry },
  sorry
SOLUTIONS: -/
  { by_cases mp : m.prime,
    { use [m, mp, mdvdn, h1] },
    rcases ih m mltn h1 mp with ⟨p, pp, pdvd, p4eq⟩,
    use [p, pp, pdvd.trans mdvdn, p4eq] },
  obtain ⟨nmdvdn, nmltn⟩ := aux mdvdn mge2 mltn,
  by_cases nmp : (n / m).prime,
    { use [n / m, nmp, nmdvdn, h1] },
    rcases ih (n / m) nmltn h1 nmp with ⟨p, pp, pdvd, p4eq⟩,
    use [p, pp, pdvd.trans nmdvdn, p4eq]
-- BOTH:
end
-- QUOTE.

/- TEXT:
We are in the home stretch. Given a set ``s`` of prime
numbers, we need to talk about the result of removing 3 from that
set, if it is present. The function ``finset.erase`` handles that.
EXAMPLES: -/
-- QUOTE:
example (m n : ℕ) (s : finset ℕ) (h : m ∈ erase s n) : m ≠ n ∧ m ∈ s :=
by rwa mem_erase at h

example (m n : ℕ) (s : finset ℕ) (h : m ∈ erase s n) : m ≠ n ∧ m ∈ s :=
by { simp at h, assumption }
-- QUOTE.

/- TEXT:
We are now ready to prove that there are infinitely many primes
congruent to 3 modulo 4.
Fill in the missing parts below.
Our solution uses ``nat.dvd_add_iff_left`` and ``nat.dvd_sub'``
along the way.
BOTH: -/
-- QUOTE:
theorem primes_mod_4_eq_3_infinite : ∀ n, ∃ p > n, nat.prime p ∧ p % 4 = 3 :=
begin
  by_contradiction h,
  push_neg at h,
  cases h with n hn,
  have : ∃ s : finset nat, ∀ p : ℕ, p.prime ∧ p % 4 = 3 ↔ p ∈ s,
  { apply ex_finset_of_bounded,
    use n,
    contrapose! hn,
    rcases hn with ⟨p, ⟨pp, p4⟩, pltn⟩,
    exact ⟨p, pltn, pp, p4⟩ },
  cases this with s hs,
  have h₀ : 2 ≤ 4 * (∏ i in erase s 3, i) + 3,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { apply le_add_left, norm_num },
-- BOTH:
  have h₁ : (4 * (∏ i in erase s 3, i) + 3) % 4 = 3,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { rw [add_comm, nat.add_mul_mod_self_left], norm_num },
-- BOTH:
  rcases exists_prime_factor_mod_4_eq_3 h₁ with ⟨p, pp, pdvd, p4eq⟩,
  have ps : p ∈ s,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { rw ←hs p, exact ⟨pp, p4eq⟩ },
-- BOTH:
  have pne3 : p ≠ 3,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { intro peq,
    rw [peq, ←nat.dvd_add_iff_left (dvd_refl 3)] at pdvd,
    rw nat.prime_three.dvd_mul at pdvd,
    norm_num at pdvd,
    have : 3 ∈ s.erase 3,
    { apply mem_of_dvd_prod_primes nat.prime_three _ pdvd,
      intro n, simp [← hs n], tauto },
    simp at this,
    exact this },
-- BOTH:
  have : p ∣ 4 * (∏ i in erase s 3, i),
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { apply dvd_trans _ (dvd_mul_left _ _),
    apply dvd_prod_of_mem,
    simp, split; assumption },
-- BOTH:
  have : p ∣ 3,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { convert nat.dvd_sub' pdvd this, simp },
-- BOTH:
  have : p = 3,
/- EXAMPLES:
    sorry,
SOLUTIONS: -/
  { apply pp.eq_of_dvd_of_prime nat.prime_three this },
-- BOTH:
  contradiction
end
-- QUOTE.

/- TEXT:
If you managed to complete the proof, congratulations! This has been a serious
feat of formalization.
TEXT. -/

-- OMIT:

/-
Later:
o fibonacci numbers
o binomial coefficients

(The former is a good example of having more than one base case.)

TODO: mention ``local attribute`` at some point.
-/


import .finset.to_set .finite data.set
open nat classical

namespace set

variable {A : Type}

noncomputable definition card (s : set A) := finset.card (set.to_finset s)

theorem card_to_set (s : finset A) : card (finset.to_set s) = finset.card s :=
by simp [card, (to_finset_to_set s)]

theorem card_of_not_finite {s : set A} (nfins : ¬ finite s) : card s = 0 :=
by simp [card, (to_finset_of_not_finite nfins)]; apply finset.card_empty

theorem card_empty : card (∅ : set A) = 0 :=
by rw [-finset.to_set_empty, card_to_set]; apply finset.card_empty

theorem card_insert_of_mem {a : A} {s : set A} (H : a ∈ s) : card (insert a s) = card s :=
if fins : finite s then
by simp [card]; rw to_finset_insert; rw -mem_to_finset_eq at H; rw [finset.card_insert_of_mem H]
else
  (have ¬ finite (insert a s), from suppose _, absurd (finite_of_finite_insert this) fins,
by rw [card_of_not_finite fins, card_of_not_finite this])

theorem card_insert_of_not_mem {a : A} {s : set A} [finite s] (H : ¬ a ∈ s) :
  card (insert a s) = card s + 1 :=
begin
simp [card]; rw [to_finset_insert, finset.card_insert_of_not_mem], simp,
rw -mem_to_finset_eq at H, exact H
end

theorem card_insert_le (a : A) (s : set A) [finite s] :
  card (insert a s) ≤ card s + 1 :=
if H : a ∈ s then by rewrite [card_insert_of_mem H]; apply le_succ
else by rewrite [card_insert_of_not_mem H]

theorem card_singleton (a : A) : card (insert a (∅:set A)) = 1 :=
have ¬ a ∈ ∅, from not_mem_empty _,
begin rw [card_insert_of_not_mem this, card_empty] end

-- Note : have to provide the predicate explicitly.

theorem eq_empty_of_card_eq_zero {s : set A} [finite s] : card s = 0 → s = ∅ :=
@induction_on_finite _ (λ x, card x = 0 → x = ∅) s _
  (by intro H; exact rfl)
  (begin
    intros a s' fins' anins IH H,
    rewrite (card_insert_of_not_mem anins) at H,
    contradiction
  end)

theorem card_upto (n : ℕ) : card {i | i < n} = n :=
by simp [card]; rw [to_finset_upto, finset.card_upto]

-- theorem card_add_card (s₁ s₂ : set A) [finite s₁] [finite s₂] :
--   card s₁ + card s₂ = card (s₁ ∪ s₂) + card (s₁ ∩ s₂) :=
-- begin
--   rw [-to_set_to_finset s₁, -to_set_to_finset s₂],
--   rw [-finset.to_set_union, -finset.to_set_inter],
--   repeat {rw card_to_set},
--   -- apply finset.card_add_card
-- end

end set


-- Suma_con_no_negativo_es_mayor_o_igual.lean
-- Suma con no negativo es mayor o igual
-- José A. Alonso Jiménez
-- Sevilla, 14 de agosto de 2020
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar si a y b son números naturales y a es no
-- negativo, entonces b ≤ a + b
-- ----------------------------------------------------------------------

import data.real.basic
variables {a b : ℝ}

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

example
  (ha : 0 ≤ a)
  : b ≤ a + b :=
begin
  calc b = 0 + b : by rw zero_add
     ... ≤ a + b : by exact add_le_add_right ha b,
end

-- Comentario: Se ha usado el lema
-- + zero_add : 0 + a = a

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

example
  (ha : 0 ≤ a)
  : b ≤ a + b :=
begin
  calc b = 0 + b : (zero_add b).symm
     ... ≤ a + b : add_le_add_right ha b,
end

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

example
  (ha : 0 ≤ a)
  : b ≤ a + b :=
begin
  calc b = 0 + b : by ring
     ... ≤ a + b : by exact add_le_add_right ha b,
end

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

example
  (ha : 0 ≤ a)
  : b ≤ a + b :=
by simp [ha]

-- 5ª demostración
-- ===============

example
  (ha : 0 ≤ a)
  : b ≤ a + b :=
by linarith

-- 6ª demostración
-- ===============

example
  (ha : 0 ≤ a)
  : b ≤ a + b :=
by finish

-- 7ª demostración
-- ===============

example
  (ha : 0 ≤ a)
  : b ≤ a + b :=
le_add_of_nonneg_left ha

-- Comentario: Se ha usado el lema
-- + le_add_of_nonneg_left : 0 ≤ b → a ≤ b + a


structure vector (R : Type) :=
vec :: (x : R) (y : R) (z : R)

namespace vector

variables {R : Type} [comm_ring R]

def zero : vector R := vec 0 0 0

def add (a b : vector R) :=
vec (a.x + b.x) (a.y + b.y) (a.z + b.z)

def neg (a : vector R) :=
vec (-a.x) (-a.y) (-a.z)

def cross_prod (a b : vector R) :=
vec (a.y * b.z - a.z * b.y) (a.x * b.z - a.z * b.x) (a.x * b.y - a.y * b.x)

def inner_prod (a b : vector R) :=
a.x * b.x + a.y * b.y +a.z * b.z

def scalar (n : R) (a : vector R) :=
vec (n * a.x) (n * a.y) (n * a.z)

theorem vector.ext (α : Type) (a b c d e f : α) :
a = d → b = e → c = f → vec a b c = vec d e f :=
begin
  intro Had, intro Hbe, intro Hcf,
  rw [Had,Hbe,Hcf]
end

theorem vector.add_comm :
 ∀ (a b : vector R) ,
 add a b = add b a :=
begin
  intro a , intro b ,
  unfold add,
  simp
end

theorem vector.add_asso :
 ∀ (a b c : vector R) ,
 add a (add b c) = add (add a b) c :=
begin
  intro a , intro b , intro c ,
  unfold add,
  simp
end

theorem vector.inner_prod_comm :
 ∀ (a b : vector R) ,
 inner_prod a b = inner_prod b a :=
begin
  intro a ,
  intro b ,
  unfold inner_prod,
  rw [mul_comm, add_assoc, add_comm],
  rw [mul_comm, add_assoc, add_comm],
  rw mul_comm, simp
end

theorem vector.zero_zero :
 ∀ (a : vector R) ,
 add zero a = add a zero :=
begin
  intro a,
  unfold add, unfold zero,
  simp,
end

theorem vector.zero_add :
 ∀ (a : vector R) ,
 add zero a = a :=
begin
  intro a,
  unfold add, unfold zero,
  cases a with a.x a.y a.z,
  dsimp, congr,
  rw zero_add, rw zero_add, rw zero_add
end

theorem vector.add_zero :
 ∀ (a : vector R) ,
 add a zero = a :=
begin
  intro a,
  unfold add, unfold zero,
  cases a with a.x a.y a.z,
  dsimp, simp
end

theorem vector.vec_assoc :
 ∀ (a b : vector R) (n : R) ,
 scalar n (add a b) = add (scalar n a) (scalar n b) :=
begin
  intro a, intro b, intro n,
  unfold add, unfold scalar,
  dsimp, congr,
  rw mul_add, rw mul_add, rw mul_add
end

theorem vector.num_assoc :
 ∀ (a : vector R) (m n : R) ,
 scalar (m + n) a = add (scalar m a) (scalar n a) :=
begin
  intro a, intro m, intro n,
  unfold add, unfold scalar,
  dsimp, congr,
  rw add_mul, rw add_mul, rw add_mul
end

theorem vector.cross_pord_comm :
 ∀ (a b : vector R) ,
 neg (cross_prod b a) = cross_prod a b :=
begin
  intro a, intro b,
  unfold neg, unfold cross_prod,
  dsimp, congr, simp,
  rw [mul_comm, add_comm, mul_comm], simp,
  rw [mul_comm, add_comm, mul_comm], simp,
  rw [mul_comm, add_comm, mul_comm], simp,
end

theorem mul_comm1 :
 ∀ (a b c : R) ,
 a * b * c = c * a * b :=
begin
 intro a, intro b, intro c,
 rw [mul_comm, ← mul_assoc]
end

theorem mul_comm2 :
 ∀ (a b c : R) ,
 a * b * c = b * c *a :=
begin
 intro a, intro b, intro c,
 rw [mul_assoc, mul_comm]
end

theorem Jacobian_Identity :
  ∀ (a b c : vector R) ,
 add (cross_prod a (cross_prod b c)) (add (cross_prod b (cross_prod c a)) (cross_prod c (cross_prod a b))) = zero :=
begin
  intro a, intro b, intro c,
  unfold add, unfold cross_prod, unfold zero,
  dsimp, congr,
  rw [mul_add, mul_add, mul_add, mul_add, mul_add, mul_add],
  rw mul_comm, simp, rw mul_comm, simp, rw mul_comm, simp,
  rw mul_comm, simp, rw mul_comm, simp, rw mul_comm, simp,
  rw [mul_comm1, add_comm, add_assoc],
  rw [mul_comm1, add_comm, add_assoc, add_assoc],
  rw [mul_comm1, add_comm, add_assoc, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc],
  rw [mul_comm, add_comm], simp,
  rw [mul_add, mul_add, mul_add, mul_add, mul_add, mul_add],
  rw mul_comm, simp, rw mul_comm, simp, rw mul_comm, simp,
  rw mul_comm, simp, rw mul_comm, simp, rw mul_comm, simp,
  rw [mul_comm2, add_comm, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc],
  rw [mul_comm, add_comm], simp,
  rw [mul_add, mul_add, mul_add, mul_add, mul_add, mul_add],
  rw mul_comm, simp, rw mul_comm, simp, rw mul_comm, simp,
  rw mul_comm, simp, rw mul_comm, simp, rw mul_comm, simp,
  rw [mul_comm2, add_comm, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm2, add_comm, add_assoc, add_assoc],
  rw [mul_comm1, add_comm, add_assoc, add_assoc],
  rw [mul_comm1, add_comm, add_assoc, add_assoc],
  rw [mul_comm1, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc, add_assoc],
  rw [mul_comm, add_comm, add_assoc],
  rw [mul_comm, add_comm], simp,
end

end vector


import tactic
import data.int.basic

-- a rw puzzle?
example
  (p : ℕ → Prop) (n : ℕ) (hn : p n)
  (h8 : ∀ n, p n ↔ p (n + 8))
  (h3 : ∀ n, p (n + 3) ↔ p n) :
p (n + 1) :=
begin
  rw ← h3 at hn,
  rw ← h3 at hn,
  rw ← h3 at hn,
  rw h8,
  exact hn,
end

--
example : fin 0 ≠ fin 1 :=
begin
  have : ∃ b : fin 1, true,
  use 0,
  intro h,
  rw ← h at this,
  cases this with k hk,
  cases k, linarith,
end

-- when i started i thought this would be a rw puzzle, but it's not
theorem reflexive_of_symmetric_and_transitive (r : ℕ → ℕ → Prop)
  (h_symm : symmetric r) (h_trans : transitive r)
  (h_connected : ∀ x, ∃ y, r x y) :
reflexive r :=
begin
  intro x,
  have hxy := h_connected x,
  cases hxy with y hy,
  apply h_trans hy,
  apply h_symm hy,
end

lemma even_or_odd (n : ℕ) :
(∃ k, n = 2 * k) ∨ ∃ k, n = 2 * k + 1 :=
begin
  induction n with d hd,
  { use 0, simp },
  -- you should ~always do this rw after opening the successor case of induction on the naturals
  rw nat.succ_eq_add_one,
  cases hd with h_even h_odd,
  { cases h_even with k hk,
    right, use k, rw hk },
  cases h_odd with k hk,
  left, use k+1, rw hk, ring,
end

-- I don't think I can do this without coercions
example
  (p : ℤ → Prop)
  (p_succ : ∀ n, p n → p (n + 1))
  (p_pred : ∀ n, p n → p (n - 1)) :
(∀ n, p n) ↔ p 0 :=
begin
  have key1 : ∀ n, p n ↔ p (n+1),
  { intro, split; intro h,
    { apply p_succ, assumption },
    have := p_pred (n+1),
    ring at this, apply this, assumption },
  split; intro h, { apply h },
  intro n, cases n, -- rintro ⟨n⟩ also works
  { induction n with d hd, {simpa},
    rw nat.succ_eq_add_one,
    simp only [int.coe_nat_succ, int.of_nat_eq_coe],
    rwa ← key1 },
  induction n with d hd, { rw key1, simpa },
  rw nat.succ_eq_add_one,
  rw key1, simpa,
end

-- by landing in ℤ, we avoid the perils of nat subtraction
def f : ℕ → ℕ
| 0 := 0
| (n + 1) := n + 1 + f n

example : f 1 = 1 :=
begin
  unfold f,
end

example (n : ℕ) : 2 * f n = n * (n + 1) :=
begin
  induction n with d hd,
  -- base case
  { unfold f, simp },
  rw nat.succ_eq_add_one,
  unfold f, ring,
  rw hd, ring,
end

open_locale big_operators
open finset
variables {R : Type*} [comm_ring R]

example (n : ℕ) (a : R) :
(1 - a) * ∑ k in range n, a ^ k = 1 - a ^ n :=
begin
  rw mul_sum, apply sum_range_induction,
  { simp },
  intro, ring,
end

-- doing your induction "by hand"
example (n : ℕ) (a : R) :
(1 - a) * ∑ k in range n, a^k = 1 - a ^n :=
begin
  induction n with d hd,
  { simp },
  rw [sum_range_succ, mul_add, hd, nat.succ_eq_add_one],
  ring_exp,
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.uniform_space.completion
import topology.metric_space.isometry
import topology.instances.real

/-!
# The completion of a metric space

Completion of uniform spaces are already defined in `topology.uniform_space.completion`. We show
here that the uniform space completion of a metric space inherits a metric space structure,
by extending the distance to the completion and checking that it is indeed a distance, and that
it defines the same uniformity as the already defined uniform structure on the completion
-/

open set filter uniform_space uniform_space.completion
open_locale filter
noncomputable theory

universes u
variables {α : Type u} [pseudo_metric_space α]

namespace metric

/-- The distance on the completion is obtained by extending the distance on the original space,
by uniform continuity. -/
instance : has_dist (completion α) :=
⟨completion.extension₂ dist⟩

/-- The new distance is uniformly continuous. -/
protected lemma completion.uniform_continuous_dist :
  uniform_continuous (λp:completion α × completion α, dist p.1 p.2) :=
uniform_continuous_extension₂ dist

/-- The new distance is an extension of the original distance. -/
protected lemma completion.dist_eq (x y : α) : dist (x : completion α) y = dist x y :=
completion.extension₂_coe_coe uniform_continuous_dist _ _

/- Let us check that the new distance satisfies the axioms of a distance, by starting from the
properties on α and extending them to `completion α` by continuity. -/
protected lemma completion.dist_self (x : completion α) : dist x x = 0 :=
begin
  apply induction_on x,
  { refine is_closed_eq _ continuous_const,
    exact (completion.uniform_continuous_dist.continuous.comp
             (continuous.prod_mk continuous_id continuous_id : _) : _) },
  { assume a,
    rw [completion.dist_eq, dist_self] }
end

protected lemma completion.dist_comm (x y : completion α) : dist x y = dist y x :=
begin
  apply induction_on₂ x y,
  { refine is_closed_eq completion.uniform_continuous_dist.continuous _,
    exact completion.uniform_continuous_dist.continuous.comp
      (@continuous_swap (completion α) (completion α) _ _) },
  { assume a b,
    rw [completion.dist_eq, completion.dist_eq, dist_comm] }
end

protected lemma completion.dist_triangle (x y z : completion α) : dist x z ≤ dist x y + dist y z :=
begin
  apply induction_on₃ x y z,
  { refine is_closed_le _ (continuous.add _ _),
    { have : continuous (λp : completion α × completion α × completion α, (p.1, p.2.2)) :=
        continuous.prod_mk continuous_fst (continuous.comp continuous_snd continuous_snd),
      exact (completion.uniform_continuous_dist.continuous.comp this : _) },
    { have : continuous (λp : completion α × completion α × completion α, (p.1, p.2.1)) :=
        continuous.prod_mk continuous_fst (continuous_fst.comp continuous_snd),
      exact (completion.uniform_continuous_dist.continuous.comp this : _) },
    { have : continuous (λp : completion α × completion α × completion α, (p.2.1, p.2.2)) :=
        continuous.prod_mk (continuous_fst.comp continuous_snd)
                           (continuous.comp continuous_snd continuous_snd),
      exact (continuous.comp completion.uniform_continuous_dist.continuous this : _) } },
  { assume a b c,
    rw [completion.dist_eq, completion.dist_eq, completion.dist_eq],
    exact dist_triangle a b c }
end

/-- Elements of the uniformity (defined generally for completions) can be characterized in terms
of the distance. -/
protected lemma completion.mem_uniformity_dist (s : set (completion α × completion α)) :
  s ∈ uniformity (completion α) ↔ (∃ε>0, ∀{a b}, dist a b < ε → (a, b) ∈ s) :=
begin
  split,
  { /- Start from an entourage `s`. It contains a closed entourage `t`. Its pullback in α is an
    entourage, so it contains an ε-neighborhood of the diagonal by definition of the entourages
    in metric spaces. Then `t` contains an ε-neighborhood of the diagonal in `completion α`, as
    closed properties pass to the completion. -/
    assume hs,
    rcases mem_uniformity_is_closed hs with ⟨t, ht, ⟨tclosed, ts⟩⟩,
    have A : {x : α × α | (coe (x.1), coe (x.2)) ∈ t} ∈ uniformity α :=
      uniform_continuous_def.1 (uniform_continuous_coe α) t ht,
    rcases mem_uniformity_dist.1 A with ⟨ε, εpos, hε⟩,
    refine ⟨ε, εpos, λx y hxy, _⟩,
    have : ε ≤ dist x y ∨ (x, y) ∈ t,
    { apply induction_on₂ x y,
      { have : {x : completion α × completion α | ε ≤ dist (x.fst) (x.snd) ∨ (x.fst, x.snd) ∈ t}
               = {p : completion α × completion α | ε ≤ dist p.1 p.2} ∪ t, by ext; simp,
        rw this,
        apply is_closed.union _ tclosed,
        exact is_closed_le continuous_const completion.uniform_continuous_dist.continuous },
      { assume x y,
        rw completion.dist_eq,
        by_cases h : ε ≤ dist x y,
        { exact or.inl h },
        { have Z := hε (not_le.1 h),
          simp only [set.mem_set_of_eq] at Z,
          exact or.inr Z }}},
    simp only [not_le.mpr hxy, false_or, not_le] at this,
    exact ts this },
  { /- Start from a set `s` containing an ε-neighborhood of the diagonal in `completion α`. To show
    that it is an entourage, we use the fact that `dist` is uniformly continuous on
    `completion α × completion α` (this is a general property of the extension of uniformly
    continuous functions). Therefore, the preimage of the ε-neighborhood of the diagonal in ℝ
    is an entourage in `completion α × completion α`. Massaging this property, it follows that
    the ε-neighborhood of the diagonal is an entourage in `completion α`, and therefore this is
    also the case of `s`. -/
    rintros ⟨ε, εpos, hε⟩,
    let r : set (ℝ × ℝ) := {p | dist p.1 p.2 < ε},
    have : r ∈ uniformity ℝ := metric.dist_mem_uniformity εpos,
    have T := uniform_continuous_def.1 (@completion.uniform_continuous_dist α _) r this,
    simp only [uniformity_prod_eq_prod, mem_prod_iff, exists_prop,
               filter.mem_map, set.mem_set_of_eq] at T,
    rcases T with ⟨t1, ht1, t2, ht2, ht⟩,
    refine mem_of_superset ht1 _,
    have A : ∀a b : completion α, (a, b) ∈ t1 → dist a b < ε,
    { assume a b hab,
      have : ((a, b), (a, a)) ∈ set.prod t1 t2 := ⟨hab, refl_mem_uniformity ht2⟩,
      have I := ht this,
      simp [completion.dist_self, real.dist_eq, completion.dist_comm] at I,
      exact lt_of_le_of_lt (le_abs_self _) I },
    show t1 ⊆ s,
    { rintros ⟨a, b⟩ hp,
      have : dist a b < ε := A a b hp,
      exact hε this }}
end

/-- If two points are at distance 0, then they coincide. -/
protected lemma completion.eq_of_dist_eq_zero (x y : completion α) (h : dist x y = 0) : x = y :=
begin
  /- This follows from the separation of `completion α` and from the description of
  entourages in terms of the distance. -/
  have : separated_space (completion α) := by apply_instance,
  refine separated_def.1 this x y (λs hs, _),
  rcases (completion.mem_uniformity_dist s).1 hs with ⟨ε, εpos, hε⟩,
  rw ← h at εpos,
  exact hε εpos
end

/-- Reformulate `completion.mem_uniformity_dist` in terms that are suitable for the definition
of the metric space structure. -/
protected lemma completion.uniformity_dist' :
  uniformity (completion α) = (⨅ε:{ε : ℝ // 0 < ε}, 𝓟 {p | dist p.1 p.2 < ε.val}) :=
begin
  ext s, rw mem_infi_of_directed,
  { simp [completion.mem_uniformity_dist, subset_def] },
  { rintro ⟨r, hr⟩ ⟨p, hp⟩, use ⟨min r p, lt_min hr hp⟩,
    simp [lt_min_iff, (≥)] {contextual := tt} }
end

protected lemma completion.uniformity_dist :
  uniformity (completion α) = (⨅ ε>0, 𝓟 {p | dist p.1 p.2 < ε}) :=
by simpa [infi_subtype] using @completion.uniformity_dist' α _

/-- Metric space structure on the completion of a pseudo_metric space. -/
instance completion.metric_space : metric_space (completion α) :=
{ dist_self          := completion.dist_self,
  eq_of_dist_eq_zero := completion.eq_of_dist_eq_zero,
  dist_comm          := completion.dist_comm,
  dist_triangle      := completion.dist_triangle,
  to_uniform_space   := by apply_instance,
  uniformity_dist    := completion.uniformity_dist }

/-- The embedding of a metric space in its completion is an isometry. -/
lemma completion.coe_isometry : isometry (coe : α → completion α) :=
isometry_emetric_iff_metric.2 completion.dist_eq

end metric


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel, Rémy Degenne
-/
import analysis.convex.specific_functions
import data.real.conjugate_exponents

/-!
# Mean value inequalities

In this file we prove several inequalities for finite sums, including AM-GM inequality,
Young's inequality, Hölder inequality, and Minkowski inequality. Versions for integrals of some of
these inequalities are available in `measure_theory.mean_inequalities`.

## Main theorems

### AM-GM inequality:

The inequality says that the geometric mean of a tuple of non-negative numbers is less than or equal
to their arithmetic mean. We prove the weighted version of this inequality: if $w$ and $z$
are two non-negative vectors and $\sum_{i\in s} w_i=1$, then
$$
\prod_{i\in s} z_i^{w_i} ≤ \sum_{i\in s} w_iz_i.
$$
The classical version is a special case of this inequality for $w_i=\frac{1}{n}$.

We prove a few versions of this inequality. Each of the following lemmas comes in two versions:
a version for real-valued non-negative functions is in the `real` namespace, and a version for
`nnreal`-valued functions is in the `nnreal` namespace.

- `geom_mean_le_arith_mean_weighted` : weighted version for functions on `finset`s;
- `geom_mean_le_arith_mean2_weighted` : weighted version for two numbers;
- `geom_mean_le_arith_mean3_weighted` : weighted version for three numbers;
- `geom_mean_le_arith_mean4_weighted` : weighted version for four numbers.

### Young's inequality

Young's inequality says that for non-negative numbers `a`, `b`, `p`, `q` such that
$\frac{1}{p}+\frac{1}{q}=1$ we have
$$
ab ≤ \frac{a^p}{p} + \frac{b^q}{q}.
$$

This inequality is a special case of the AM-GM inequality. It is then used to prove Hölder's
inequality (see below).

### Hölder's inequality

The inequality says that for two conjugate exponents `p` and `q` (i.e., for two positive numbers
such that $\frac{1}{p}+\frac{1}{q}=1$) and any two non-negative vectors their inner product is
less than or equal to the product of the $L_p$ norm of the first vector and the $L_q$ norm of the
second vector:
$$
\sum_{i\in s} a_ib_i ≤ \sqrt[p]{\sum_{i\in s} a_i^p}\sqrt[q]{\sum_{i\in s} b_i^q}.
$$

We give versions of this result in `ℝ`, `ℝ≥0` and `ℝ≥0∞`.

There are at least two short proofs of this inequality. In our proof we prenormalize both vectors,
then apply Young's inequality to each $a_ib_i$. Another possible proof would be to deduce this
inequality from the generalized mean inequality for well-chosen vectors and weights.

### Minkowski's inequality

The inequality says that for `p ≥ 1` the function
$$
\|a\|_p=\sqrt[p]{\sum_{i\in s} a_i^p}
$$
satisfies the triangle inequality $\|a+b\|_p\le \|a\|_p+\|b\|_p$.

We give versions of this result in `real`, `ℝ≥0` and `ℝ≥0∞`.

We deduce this inequality from Hölder's inequality. Namely, Hölder inequality implies that $\|a\|_p$
is the maximum of the inner product $\sum_{i\in s}a_ib_i$ over `b` such that $\|b\|_q\le 1$. Now
Minkowski's inequality follows from the fact that the maximum value of the sum of two functions is
less than or equal to the sum of the maximum values of the summands.

## TODO

- each inequality `A ≤ B` should come with a theorem `A = B ↔ _`; one of the ways to prove them
  is to define `strict_convex_on` functions.
- generalized mean inequality with any `p ≤ q`, including negative numbers;
- prove that the power mean tends to the geometric mean as the exponent tends to zero.

-/

universes u v

open finset
open_locale classical big_operators nnreal ennreal
noncomputable theory

variables {ι : Type u} (s : finset ι)

section geom_mean_le_arith_mean

/-! ### AM-GM inequality -/

namespace real

/-- AM-GM inequality: the **geometric mean is less than or equal to the arithmetic mean**, weighted
version for real-valued nonnegative functions. -/
theorem geom_mean_le_arith_mean_weighted (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) :
  (∏ i in s, (z i) ^ (w i)) ≤ ∑ i in s, w i * z i :=
begin
  -- If some number `z i` equals zero and has non-zero weight, then LHS is 0 and RHS is nonnegative.
  by_cases A : ∃ i ∈ s, z i = 0 ∧ w i ≠ 0,
  { rcases A with ⟨i, his, hzi, hwi⟩,
    rw [prod_eq_zero his],
    { exact sum_nonneg (λ j hj, mul_nonneg (hw j hj) (hz j hj)) },
    { rw hzi, exact zero_rpow hwi } },
  -- If all numbers `z i` with non-zero weight are positive, then we apply Jensen's inequality
  -- for `exp` and numbers `log (z i)` with weights `w i`.
  { simp only [not_exists, not_and, ne.def, not_not] at A,
    have := convex_on_exp.map_sum_le hw hw' (λ i _, set.mem_univ $ log (z i)),
    simp only [exp_sum, (∘), smul_eq_mul, mul_comm (w _) (log _)] at this,
    convert this using 1; [apply prod_congr rfl, apply sum_congr rfl]; intros i hi,
    { cases eq_or_lt_of_le (hz i hi) with hz hz,
      { simp [A i hi hz.symm] },
      { exact rpow_def_of_pos hz _ } },
    { cases eq_or_lt_of_le (hz i hi) with hz hz,
      { simp [A i hi hz.symm] },
      { rw [exp_log hz] } } }
end

theorem geom_mean_weighted_of_constant (w z : ι → ℝ) (x : ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) (hx : ∀ i ∈ s, w i ≠ 0 → z i = x) :
  (∏ i in s, (z i) ^ (w i)) = x :=
calc (∏ i in s, (z i) ^ (w i)) = ∏ i in s, x ^ w i :
  begin
    refine prod_congr rfl (λ i hi, _),
    cases eq_or_ne (w i) 0 with h₀ h₀,
    { rw [h₀, rpow_zero, rpow_zero] },
    { rw hx i hi h₀ }
  end
... = x :
  begin
    rw [← rpow_sum_of_nonneg _ hw, hw', rpow_one],
    have : (∑ i in s, w i) ≠ 0,
    { rw hw', exact one_ne_zero },
    obtain ⟨i, his, hi⟩ := exists_ne_zero_of_sum_ne_zero this,
    rw ← hx i his hi,
    exact hz i his
  end

theorem geom_mean_eq_arith_mean_weighted_of_constant (w z : ι → ℝ) (x : ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) (hx : ∀ i ∈ s, w i ≠ 0 → z i = x) :
  (∏ i in s, (z i) ^ (w i)) = ∑ i in s, w i * z i :=
by rw [geom_mean_weighted_of_constant, arith_mean_weighted_of_constant]; assumption

end real

namespace nnreal

/-- The geometric mean is less than or equal to the arithmetic mean, weighted version
for `nnreal`-valued functions. -/
theorem geom_mean_le_arith_mean_weighted (w z : ι → ℝ≥0) (hw' : ∑ i in s, w i = 1) :
  (∏ i in s, (z i) ^ (w i:ℝ)) ≤ ∑ i in s, w i * z i :=
by exact_mod_cast real.geom_mean_le_arith_mean_weighted _ _ _ (λ i _, (w i).coe_nonneg)
  (by assumption_mod_cast) (λ i _, (z i).coe_nonneg)

/-- The geometric mean is less than or equal to the arithmetic mean, weighted version
for two `nnreal` numbers. -/
theorem geom_mean_le_arith_mean2_weighted (w₁ w₂ p₁ p₂ : ℝ≥0) :
  w₁ + w₂ = 1 → p₁ ^ (w₁:ℝ) * p₂ ^ (w₂:ℝ) ≤ w₁ * p₁ + w₂ * p₂ :=
by simpa only [fin.prod_univ_succ, fin.sum_univ_succ, finset.prod_empty, finset.sum_empty,
  fintype.univ_of_is_empty, fin.cons_succ, fin.cons_zero, add_zero, mul_one]
using geom_mean_le_arith_mean_weighted univ ![w₁, w₂] ![p₁, p₂]

theorem geom_mean_le_arith_mean3_weighted (w₁ w₂ w₃ p₁ p₂ p₃ : ℝ≥0) :
  w₁ + w₂ + w₃ = 1 → p₁ ^ (w₁:ℝ) * p₂ ^ (w₂:ℝ) * p₃ ^ (w₃:ℝ) ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ :=
by simpa only  [fin.prod_univ_succ, fin.sum_univ_succ, finset.prod_empty, finset.sum_empty,
  fintype.univ_of_is_empty, fin.cons_succ, fin.cons_zero, add_zero, mul_one, ← add_assoc, mul_assoc]
using geom_mean_le_arith_mean_weighted univ ![w₁, w₂, w₃] ![p₁, p₂, p₃]

theorem geom_mean_le_arith_mean4_weighted (w₁ w₂ w₃ w₄ p₁ p₂ p₃ p₄ : ℝ≥0) :
  w₁ + w₂ + w₃ + w₄ = 1 → p₁ ^ (w₁:ℝ) * p₂ ^ (w₂:ℝ) * p₃ ^ (w₃:ℝ)* p₄ ^ (w₄:ℝ) ≤
    w₁ * p₁ + w₂ * p₂ + w₃ * p₃ + w₄ * p₄ :=
by simpa only  [fin.prod_univ_succ, fin.sum_univ_succ, finset.prod_empty, finset.sum_empty,
  fintype.univ_of_is_empty, fin.cons_succ, fin.cons_zero, add_zero, mul_one, ← add_assoc, mul_assoc]
using geom_mean_le_arith_mean_weighted univ ![w₁, w₂, w₃, w₄] ![p₁, p₂, p₃, p₄]

end nnreal

namespace real

theorem geom_mean_le_arith_mean2_weighted {w₁ w₂ p₁ p₂ : ℝ} (hw₁ : 0 ≤ w₁) (hw₂ : 0 ≤ w₂)
  (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hw : w₁ + w₂ = 1) :
  p₁ ^ w₁ * p₂ ^ w₂ ≤ w₁ * p₁ + w₂ * p₂ :=
nnreal.geom_mean_le_arith_mean2_weighted ⟨w₁, hw₁⟩ ⟨w₂, hw₂⟩ ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ $
  nnreal.coe_eq.1 $ by assumption

theorem geom_mean_le_arith_mean3_weighted {w₁ w₂ w₃ p₁ p₂ p₃ : ℝ} (hw₁ : 0 ≤ w₁) (hw₂ : 0 ≤ w₂)
  (hw₃ : 0 ≤ w₃) (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hp₃ : 0 ≤ p₃) (hw : w₁ + w₂ + w₃ = 1) :
  p₁ ^ w₁ * p₂ ^ w₂ * p₃ ^ w₃ ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ :=
nnreal.geom_mean_le_arith_mean3_weighted
  ⟨w₁, hw₁⟩ ⟨w₂, hw₂⟩ ⟨w₃, hw₃⟩ ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ ⟨p₃, hp₃⟩ $ nnreal.coe_eq.1 hw

theorem geom_mean_le_arith_mean4_weighted {w₁ w₂ w₃ w₄ p₁ p₂ p₃ p₄ : ℝ} (hw₁ : 0 ≤ w₁)
  (hw₂ : 0 ≤ w₂) (hw₃ : 0 ≤ w₃) (hw₄ : 0 ≤ w₄) (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hp₃ : 0 ≤ p₃)
  (hp₄ : 0 ≤ p₄) (hw : w₁ + w₂ + w₃ + w₄ = 1) :
  p₁ ^ w₁ * p₂ ^ w₂ * p₃ ^ w₃ * p₄ ^ w₄ ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ + w₄ * p₄ :=
nnreal.geom_mean_le_arith_mean4_weighted ⟨w₁, hw₁⟩ ⟨w₂, hw₂⟩ ⟨w₃, hw₃⟩ ⟨w₄, hw₄⟩
  ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ ⟨p₃, hp₃⟩ ⟨p₄, hp₄⟩ $ nnreal.coe_eq.1 $ by assumption

end real

end geom_mean_le_arith_mean

section young

/-! ### Young's inequality -/

namespace real

/-- Young's inequality, a version for nonnegative real numbers. -/
theorem young_inequality_of_nonneg {a b p q : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b)
  (hpq : p.is_conjugate_exponent q) :
  a * b ≤ a^p / p + b^q / q :=
by simpa [← rpow_mul, ha, hb, hpq.ne_zero, hpq.symm.ne_zero, div_eq_inv_mul]
  using geom_mean_le_arith_mean2_weighted hpq.one_div_nonneg hpq.symm.one_div_nonneg
    (rpow_nonneg_of_nonneg ha p) (rpow_nonneg_of_nonneg hb q) hpq.inv_add_inv_conj

/-- Young's inequality, a version for arbitrary real numbers. -/
theorem young_inequality (a b : ℝ) {p q : ℝ} (hpq : p.is_conjugate_exponent q) :
  a * b ≤ |a|^p / p + |b|^q / q :=
calc a * b ≤ |a * b|                   : le_abs_self (a * b)
       ... = |a| * |b|                 : abs_mul a b
       ... ≤ |a|^p / p + |b|^q / q :
  real.young_inequality_of_nonneg (abs_nonneg a) (abs_nonneg b) hpq

end real

namespace nnreal

/-- Young's inequality, `ℝ≥0` version. We use `{p q : ℝ≥0}` in order to avoid constructing
witnesses of `0 ≤ p` and `0 ≤ q` for the denominators.  -/
theorem young_inequality (a b : ℝ≥0) {p q : ℝ≥0} (hp : 1 < p) (hpq : 1 / p + 1 / q = 1) :
  a * b ≤ a^(p:ℝ) / p + b^(q:ℝ) / q :=
real.young_inequality_of_nonneg a.coe_nonneg b.coe_nonneg ⟨hp, nnreal.coe_eq.2 hpq⟩

/-- Young's inequality, `ℝ≥0` version with real conjugate exponents. -/
theorem young_inequality_real (a b : ℝ≥0) {p q : ℝ} (hpq : p.is_conjugate_exponent q) :
  a * b ≤ a ^ p / real.to_nnreal p + b ^ q / real.to_nnreal q :=
begin
  nth_rewrite 0 ← real.coe_to_nnreal p hpq.nonneg,
  nth_rewrite 0 ← real.coe_to_nnreal q hpq.symm.nonneg,
  exact young_inequality a b hpq.one_lt_nnreal hpq.inv_add_inv_conj_nnreal,
end

end nnreal

namespace ennreal

/-- Young's inequality, `ℝ≥0∞` version with real conjugate exponents. -/
theorem young_inequality (a b : ℝ≥0∞) {p q : ℝ} (hpq : p.is_conjugate_exponent q) :
  a * b ≤ a ^ p / ennreal.of_real p + b ^ q / ennreal.of_real q :=
begin
  by_cases h : a = ⊤ ∨ b = ⊤,
  { refine le_trans le_top (le_of_eq _),
    repeat { rw div_eq_mul_inv },
    cases h; rw h; simp [h, hpq.pos, hpq.symm.pos], },
  push_neg at h, -- if a ≠ ⊤ and b ≠ ⊤, use the nnreal version: nnreal.young_inequality_real
  rw [←coe_to_nnreal h.left, ←coe_to_nnreal h.right, ←coe_mul,
    coe_rpow_of_nonneg _ hpq.nonneg, coe_rpow_of_nonneg _ hpq.symm.nonneg, ennreal.of_real,
    ennreal.of_real, ←@coe_div (real.to_nnreal p) _ (by simp [hpq.pos]),
    ←@coe_div (real.to_nnreal q) _ (by simp [hpq.symm.pos]), ←coe_add, coe_le_coe],
  exact nnreal.young_inequality_real a.to_nnreal b.to_nnreal hpq,
end

end ennreal

end young

section holder_minkowski

/-! ### Hölder's and Minkowski's inequalities -/

namespace nnreal

private lemma inner_le_Lp_mul_Lp_of_norm_le_one (f g : ι → ℝ≥0) {p q : ℝ}
  (hpq : p.is_conjugate_exponent q) (hf : ∑ i in s, (f i) ^ p ≤ 1) (hg : ∑ i in s, (g i) ^ q ≤ 1) :
  ∑ i in s, f i * g i ≤ 1 :=
begin
  have hp_ne_zero : real.to_nnreal p ≠ 0, from (zero_lt_one.trans hpq.one_lt_nnreal).ne.symm,
  have hq_ne_zero : real.to_nnreal q ≠ 0, from (zero_lt_one.trans hpq.symm.one_lt_nnreal).ne.symm,
  calc ∑ i in s, f i * g i
      ≤ ∑ i in s, ((f i) ^ p / real.to_nnreal p + (g i) ^ q / real.to_nnreal q) :
    finset.sum_le_sum (λ i his, young_inequality_real (f i) (g i) hpq)
  ... = (∑ i in s, (f i) ^ p) / real.to_nnreal p + (∑ i in s, (g i) ^ q) / real.to_nnreal q :
    by rw [sum_add_distrib, sum_div, sum_div]
  ... ≤ 1 / real.to_nnreal p + 1 / real.to_nnreal q :
    by { refine add_le_add _ _,
      { rwa [div_le_iff hp_ne_zero, div_mul_cancel _ hp_ne_zero], },
      { rwa [div_le_iff hq_ne_zero, div_mul_cancel _ hq_ne_zero], }, }
  ... = 1 : hpq.inv_add_inv_conj_nnreal,
end

private lemma inner_le_Lp_mul_Lp_of_norm_eq_zero (f g : ι → ℝ≥0) {p q : ℝ}
  (hpq : p.is_conjugate_exponent q) (hf : ∑ i in s, (f i) ^ p = 0) :
  ∑ i in s, f i * g i ≤ (∑ i in s, (f i) ^ p) ^ (1 / p) * (∑ i in s, (g i) ^ q) ^ (1 / q) :=
begin
  simp only [hf, hpq.ne_zero, one_div, sum_eq_zero_iff, zero_rpow, zero_mul, inv_eq_zero,
    ne.def, not_false_iff, le_zero_iff, mul_eq_zero],
  intros i his,
  left,
  rw sum_eq_zero_iff at hf,
  exact (rpow_eq_zero_iff.mp (hf i his)).left,
end

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with `ℝ≥0`-valued functions. -/
theorem inner_le_Lp_mul_Lq (f g : ι → ℝ≥0) {p q : ℝ}
  (hpq : p.is_conjugate_exponent q) :
  ∑ i in s, f i * g i ≤ (∑ i in s, (f i) ^ p) ^ (1 / p) * (∑ i in s, (g i) ^ q) ^ (1 / q) :=
begin
  by_cases hF_zero : ∑ i in s, (f i) ^ p = 0,
  { exact inner_le_Lp_mul_Lp_of_norm_eq_zero s f g hpq hF_zero, },
  by_cases hG_zero : ∑ i in s, (g i) ^ q = 0,
  { calc ∑ i in s, f i * g i
        = ∑ i in s, g i * f i : by { congr' with i, rw mul_comm, }
    ... ≤ (∑ i in s, (g i) ^ q) ^ (1 / q) * (∑ i in s, (f i) ^ p) ^ (1 / p) :
      inner_le_Lp_mul_Lp_of_norm_eq_zero s g f hpq.symm hG_zero
    ... = (∑ i in s, (f i) ^ p) ^ (1 / p) * (∑ i in s, (g i) ^ q) ^ (1 / q) : mul_comm _ _, },
  let f' := λ i, (f i) / (∑ i in s, (f i) ^ p) ^ (1 / p),
  let g' := λ i, (g i) / (∑ i in s, (g i) ^ q) ^ (1 / q),
  suffices : ∑ i in s, f' i * g' i ≤ 1,
  { simp_rw [f', g', div_mul_div_comm, ← sum_div] at this,
    rwa [div_le_iff, one_mul] at this,
    refine mul_ne_zero _ _,
    { rw [ne.def, rpow_eq_zero_iff, not_and_distrib], exact or.inl hF_zero, },
    { rw [ne.def, rpow_eq_zero_iff, not_and_distrib], exact or.inl hG_zero, }, },
  refine inner_le_Lp_mul_Lp_of_norm_le_one s f' g' hpq (le_of_eq _) (le_of_eq _),
  { simp_rw [f', div_rpow, ← sum_div, ← rpow_mul, one_div, inv_mul_cancel hpq.ne_zero, rpow_one,
      div_self hF_zero], },
  { simp_rw [g', div_rpow, ← sum_div, ← rpow_mul, one_div, inv_mul_cancel hpq.symm.ne_zero,
    rpow_one, div_self hG_zero], },
end

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. A version for `nnreal`-valued
functions. For an alternative version, convenient if the infinite sums are already expressed as
`p`-th powers, see `inner_le_Lp_mul_Lq_has_sum`. -/
theorem inner_le_Lp_mul_Lq_tsum {f g : ι → ℝ≥0} {p q : ℝ} (hpq : p.is_conjugate_exponent q)
  (hf : summable (λ i, (f i) ^ p)) (hg : summable (λ i, (g i) ^ q)) :
  summable (λ i, f i * g i) ∧
  ∑' i, f i * g i ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q) :=
begin
  have H₁ : ∀ s : finset ι, ∑ i in s, f i * g i
    ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q),
  { intros s,
    refine le_trans (inner_le_Lp_mul_Lq s f g hpq) (mul_le_mul _ _ bot_le bot_le),
    { rw nnreal.rpow_le_rpow_iff (one_div_pos.mpr hpq.pos),
      exact sum_le_tsum _ (λ _ _, zero_le _) hf },
    { rw nnreal.rpow_le_rpow_iff (one_div_pos.mpr hpq.symm.pos),
      exact sum_le_tsum _ (λ _ _, zero_le _) hg } },
  have bdd : bdd_above (set.range (λ s, ∑ i in s, f i * g i)),
  { refine ⟨(∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q), _⟩,
    rintros a ⟨s, rfl⟩,
    exact H₁ s },
  have H₂ : summable _ := (has_sum_of_is_lub _ (is_lub_csupr bdd)).summable,
  exact ⟨H₂, tsum_le_of_sum_le H₂ H₁⟩,
end

theorem summable_mul_of_Lp_Lq {f g : ι → ℝ≥0} {p q : ℝ} (hpq : p.is_conjugate_exponent q)
  (hf : summable (λ i, (f i) ^ p)) (hg : summable (λ i, (g i) ^ q)) :
  summable (λ i, f i * g i) :=
(inner_le_Lp_mul_Lq_tsum hpq hf hg).1

theorem inner_le_Lp_mul_Lq_tsum' {f g : ι → ℝ≥0} {p q : ℝ} (hpq : p.is_conjugate_exponent q)
  (hf : summable (λ i, (f i) ^ p)) (hg : summable (λ i, (g i) ^ q)) :
  ∑' i, f i * g i ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q)  :=
(inner_le_Lp_mul_Lq_tsum hpq hf hg).2

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. A version for `nnreal`-valued
functions. For an alternative version, convenient if the infinite sums are not already expressed as
`p`-th powers, see `inner_le_Lp_mul_Lq_tsum`.  -/
theorem inner_le_Lp_mul_Lq_has_sum {f g : ι → ℝ≥0} {A B : ℝ≥0} {p q : ℝ}
  (hpq : p.is_conjugate_exponent q) (hf : has_sum (λ i, (f i) ^ p) (A ^ p))
  (hg : has_sum (λ i, (g i) ^ q) (B ^ q)) :
  ∃ C, C ≤ A * B ∧ has_sum (λ i, f i * g i) C :=
begin
  obtain ⟨H₁, H₂⟩ := inner_le_Lp_mul_Lq_tsum hpq hf.summable hg.summable,
  have hA : A = (∑' (i : ι), f i ^ p) ^ (1 / p),
  { rw [hf.tsum_eq, rpow_inv_rpow_self hpq.ne_zero] },
  have hB : B = (∑' (i : ι), g i ^ q) ^ (1 / q),
  { rw [hg.tsum_eq, rpow_inv_rpow_self hpq.symm.ne_zero] },
  refine ⟨∑' i, f i * g i, _, _⟩,
  { simpa [hA, hB] using H₂ },
  { simpa only [rpow_self_rpow_inv hpq.ne_zero] using H₁.has_sum }
end

/-- For `1 ≤ p`, the `p`-th power of the sum of `f i` is bounded above by a constant times the
sum of the `p`-th powers of `f i`. Version for sums over finite sets, with `ℝ≥0`-valued functions.
-/
theorem rpow_sum_le_const_mul_sum_rpow (f : ι → ℝ≥0) {p : ℝ} (hp : 1 ≤ p) :
  (∑ i in s, f i) ^ p ≤ (card s) ^ (p - 1) * ∑ i in s, (f i) ^ p :=
begin
  cases eq_or_lt_of_le hp with hp hp,
  { simp [← hp] },
  let q : ℝ := p / (p - 1),
  have hpq : p.is_conjugate_exponent q,
  { rw real.is_conjugate_exponent_iff hp },
  have hp₁ : 1 / p * p = 1 := one_div_mul_cancel hpq.ne_zero,
  have hq : 1 / q * p = (p - 1),
  { rw [← hpq.div_conj_eq_sub_one],
    ring },
  simpa only [nnreal.mul_rpow, ← nnreal.rpow_mul, hp₁, hq, one_mul, one_rpow, rpow_one,
    pi.one_apply, sum_const, nat.smul_one_eq_coe]
    using nnreal.rpow_le_rpow (inner_le_Lp_mul_Lq s 1 f hpq.symm) hpq.nonneg,
end

/-- The `L_p` seminorm of a vector `f` is the greatest value of the inner product
`∑ i in s, f i * g i` over functions `g` of `L_q` seminorm less than or equal to one. -/
theorem is_greatest_Lp (f : ι → ℝ≥0) {p q : ℝ} (hpq : p.is_conjugate_exponent q) :
  is_greatest ((λ g : ι → ℝ≥0, ∑ i in s, f i * g i) ''
    {g | ∑ i in s, (g i)^q ≤ 1}) ((∑ i in s, (f i)^p) ^ (1 / p)) :=
begin
  split,
  { use λ i, ((f i) ^ p / f i / (∑ i in s, (f i) ^ p) ^ (1 / q)),
    by_cases hf : ∑ i in s, (f i)^p = 0,
    { simp [hf, hpq.ne_zero, hpq.symm.ne_zero] },
    { have A : p + q - q ≠ 0, by simp [hpq.ne_zero],
      have B : ∀ y : ℝ≥0, y * y^p / y = y^p,
      { refine λ y, mul_div_cancel_left_of_imp (λ h, _),
        simpa [h, hpq.ne_zero] },
      simp only [set.mem_set_of_eq, div_rpow, ← sum_div, ← rpow_mul,
        div_mul_cancel _ hpq.symm.ne_zero, rpow_one, div_le_iff hf, one_mul, hpq.mul_eq_add,
        ← rpow_sub' _ A, _root_.add_sub_cancel, le_refl, true_and, ← mul_div_assoc, B],
      rw [div_eq_iff, ← rpow_add hf, hpq.inv_add_inv_conj, rpow_one],
      simpa [hpq.symm.ne_zero] using hf } },
  { rintros _ ⟨g, hg, rfl⟩,
    apply le_trans (inner_le_Lp_mul_Lq s f g hpq),
    simpa only [mul_one] using mul_le_mul_left'
      (nnreal.rpow_le_one hg (le_of_lt hpq.symm.one_div_pos)) _ }
end

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `nnreal`-valued functions. -/
theorem Lp_add_le (f g : ι → ℝ≥0) {p : ℝ} (hp : 1 ≤ p) :
  (∑ i in s, (f i + g i) ^ p) ^ (1 / p) ≤
    (∑ i in s, (f i) ^ p) ^ (1 / p) + (∑ i in s, (g i) ^ p) ^ (1 / p) :=
begin
  -- The result is trivial when `p = 1`, so we can assume `1 < p`.
  rcases eq_or_lt_of_le hp with rfl|hp, { simp [finset.sum_add_distrib] },
  have hpq := real.is_conjugate_exponent_conjugate_exponent hp,
  have := is_greatest_Lp s (f + g) hpq,
  simp only [pi.add_apply, add_mul, sum_add_distrib] at this,
  rcases this.1 with ⟨φ, hφ, H⟩,
  rw ← H,
  exact add_le_add ((is_greatest_Lp s f hpq).2 ⟨φ, hφ, rfl⟩)
    ((is_greatest_Lp s g hpq).2 ⟨φ, hφ, rfl⟩)
end

/-- Minkowski inequality: the `L_p` seminorm of the infinite sum of two vectors is less than or
equal to the infinite sum of the `L_p`-seminorms of the summands, if these infinite sums both
exist. A version for `nnreal`-valued functions. For an alternative version, convenient if the
infinite sums are already expressed as `p`-th powers, see `Lp_add_le_has_sum_of_nonneg`. -/
theorem Lp_add_le_tsum {f g : ι → ℝ≥0} {p : ℝ} (hp : 1 ≤ p) (hf : summable (λ i, (f i) ^ p))
  (hg : summable (λ i, (g i) ^ p)) :
  summable (λ i, (f i + g i) ^ p) ∧
  (∑' i, (f i + g i) ^ p) ^ (1 / p) ≤ (∑' i, (f i) ^ p) ^ (1 / p) + (∑' i, (g i) ^ p) ^ (1 / p) :=
begin
  have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  have H₁ : ∀ s : finset ι, ∑ i in s, (f i + g i) ^ p
    ≤ ((∑' i, (f i)^p) ^ (1/p) + (∑' i, (g i)^p) ^ (1/p)) ^ p,
  { intros s,
    rw ← nnreal.rpow_one_div_le_iff pos,
    refine le_trans (Lp_add_le s f g hp) (add_le_add _ _);
    rw nnreal.rpow_le_rpow_iff (one_div_pos.mpr pos);
    refine sum_le_tsum _ (λ _ _, zero_le _) _,
    exacts [hf, hg] },
  have bdd : bdd_above (set.range (λ s, ∑ i in s, (f i + g i) ^ p)),
  { refine ⟨((∑' i, (f i)^p) ^ (1/p) + (∑' i, (g i)^p) ^ (1/p)) ^ p, _⟩,
    rintros a ⟨s, rfl⟩,
    exact H₁ s },
  have H₂ : summable _ := (has_sum_of_is_lub _ (is_lub_csupr bdd)).summable,
  refine ⟨H₂, _⟩,
  rw nnreal.rpow_one_div_le_iff pos,
  refine tsum_le_of_sum_le H₂ H₁,
end

theorem summable_Lp_add {f g : ι → ℝ≥0} {p : ℝ} (hp : 1 ≤ p) (hf : summable (λ i, (f i) ^ p))
  (hg : summable (λ i, (g i) ^ p)) :
  summable (λ i, (f i + g i) ^ p) :=
(Lp_add_le_tsum hp hf hg).1

theorem Lp_add_le_tsum' {f g : ι → ℝ≥0} {p : ℝ} (hp : 1 ≤ p) (hf : summable (λ i, (f i) ^ p))
  (hg : summable (λ i, (g i) ^ p)) :
  (∑' i, (f i + g i) ^ p) ^ (1 / p) ≤ (∑' i, (f i) ^ p) ^ (1 / p) + (∑' i, (g i) ^ p) ^ (1 / p) :=
(Lp_add_le_tsum hp hf hg).2

/-- Minkowski inequality: the `L_p` seminorm of the infinite sum of two vectors is less than or
equal to the infinite sum of the `L_p`-seminorms of the summands, if these infinite sums both
exist. A version for `nnreal`-valued functions. For an alternative version, convenient if the
infinite sums are not already expressed as `p`-th powers, see `Lp_add_le_tsum_of_nonneg`.  -/
theorem Lp_add_le_has_sum {f g : ι → ℝ≥0} {A B : ℝ≥0} {p : ℝ} (hp : 1 ≤ p)
  (hf : has_sum (λ i, (f i) ^ p) (A ^ p)) (hg : has_sum (λ i, (g i) ^ p) (B ^ p)) :
  ∃ C, C ≤ A + B ∧ has_sum (λ i, (f i + g i) ^ p) (C ^ p) :=
begin
  have hp' : p ≠ 0 := (lt_of_lt_of_le zero_lt_one hp).ne',
  obtain ⟨H₁, H₂⟩ := Lp_add_le_tsum hp hf.summable hg.summable,
  have hA : A = (∑' (i : ι), f i ^ p) ^ (1 / p) := by rw [hf.tsum_eq, rpow_inv_rpow_self hp'],
  have hB : B = (∑' (i : ι), g i ^ p) ^ (1 / p) := by rw [hg.tsum_eq, rpow_inv_rpow_self hp'],
  refine ⟨(∑' i, (f i + g i) ^ p) ^ (1 / p), _, _⟩,
  { simpa [hA, hB] using H₂ },
  { simpa only [rpow_self_rpow_inv hp'] using H₁.has_sum }
end

end nnreal

namespace real

variables (f g : ι → ℝ)  {p q : ℝ}

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with real-valued functions. -/
theorem inner_le_Lp_mul_Lq (hpq : is_conjugate_exponent p q) :
  ∑ i in s, f i * g i ≤ (∑ i in s, |f i| ^ p) ^ (1 / p) * (∑ i in s, |g i| ^ q) ^ (1 / q) :=
begin
  have := nnreal.coe_le_coe.2 (nnreal.inner_le_Lp_mul_Lq s (λ i, ⟨_, abs_nonneg (f i)⟩)
    (λ i, ⟨_, abs_nonneg (g i)⟩) hpq),
  push_cast at this,
  refine le_trans (sum_le_sum $ λ i hi, _) this,
  simp only [← abs_mul, le_abs_self]
end

/-- For `1 ≤ p`, the `p`-th power of the sum of `f i` is bounded above by a constant times the
sum of the `p`-th powers of `f i`. Version for sums over finite sets, with `ℝ`-valued functions. -/
theorem rpow_sum_le_const_mul_sum_rpow (hp : 1 ≤ p) :
  (∑ i in s, |f i|) ^ p ≤ (card s) ^ (p - 1) * ∑ i in s, |f i| ^ p :=
begin
  have := nnreal.coe_le_coe.2
    (nnreal.rpow_sum_le_const_mul_sum_rpow s (λ i, ⟨_, abs_nonneg (f i)⟩) hp),
  push_cast at this,
  exact this, -- for some reason `exact_mod_cast` can't replace this argument
end

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `real`-valued functions. -/
theorem Lp_add_le (hp : 1 ≤ p) :
  (∑ i in s, |f i + g i| ^ p) ^ (1 / p) ≤
    (∑ i in s, |f i| ^ p) ^ (1 / p) + (∑ i in s, |g i| ^ p) ^ (1 / p) :=
begin
  have := nnreal.coe_le_coe.2 (nnreal.Lp_add_le s (λ i, ⟨_, abs_nonneg (f i)⟩)
    (λ i, ⟨_, abs_nonneg (g i)⟩) hp),
  push_cast at this,
  refine le_trans (rpow_le_rpow _ (sum_le_sum $ λ i hi, _) _) this;
    simp [sum_nonneg, rpow_nonneg_of_nonneg, abs_nonneg, le_trans zero_le_one hp, abs_add,
      rpow_le_rpow]
end

variables {f g}

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with real-valued nonnegative functions. -/
theorem inner_le_Lp_mul_Lq_of_nonneg (hpq : is_conjugate_exponent p q)
  (hf : ∀ i ∈ s, 0 ≤ f i) (hg : ∀ i ∈ s, 0 ≤ g i) :
  ∑ i in s, f i * g i ≤ (∑ i in s, (f i)^p) ^ (1 / p) * (∑ i in s, (g i)^q) ^ (1 / q) :=
by convert inner_le_Lp_mul_Lq s f g hpq using 3; apply sum_congr rfl; intros i hi;
  simp only [abs_of_nonneg, hf i hi, hg i hi]

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. A version for `ℝ`-valued functions.
For an alternative version, convenient if the infinite sums are already expressed as `p`-th powers,
see `inner_le_Lp_mul_Lq_has_sum_of_nonneg`. -/
theorem inner_le_Lp_mul_Lq_tsum_of_nonneg (hpq : p.is_conjugate_exponent q) (hf : ∀ i, 0 ≤ f i)
  (hg : ∀ i, 0 ≤ g i) (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ q)) :
  summable (λ i, f i * g i) ∧
  ∑' i, f i * g i ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q) :=
begin
  lift f to (ι → ℝ≥0) using hf,
  lift g to (ι → ℝ≥0) using hg,
  norm_cast at *,
  exact nnreal.inner_le_Lp_mul_Lq_tsum hpq hf_sum hg_sum,
end

theorem summable_mul_of_Lp_Lq_of_nonneg (hpq : p.is_conjugate_exponent q) (hf : ∀ i, 0 ≤ f i)
  (hg : ∀ i, 0 ≤ g i) (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ q)) :
  summable (λ i, f i * g i) :=
(inner_le_Lp_mul_Lq_tsum_of_nonneg hpq hf hg hf_sum hg_sum).1

theorem inner_le_Lp_mul_Lq_tsum_of_nonneg' (hpq : p.is_conjugate_exponent q) (hf : ∀ i, 0 ≤ f i)
  (hg : ∀ i, 0 ≤ g i) (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ q)) :
  ∑' i, f i * g i ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q) :=
(inner_le_Lp_mul_Lq_tsum_of_nonneg hpq hf hg hf_sum hg_sum).2

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. A version for `nnreal`-valued
functions. For an alternative version, convenient if the infinite sums are not already expressed as
`p`-th powers, see `inner_le_Lp_mul_Lq_tsum_of_nonneg`.  -/
theorem inner_le_Lp_mul_Lq_has_sum_of_nonneg (hpq : p.is_conjugate_exponent q) {A B : ℝ}
  (hA : 0 ≤ A) (hB : 0 ≤ B) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i)
  (hf_sum : has_sum (λ i, (f i) ^ p) (A ^ p)) (hg_sum : has_sum (λ i, (g i) ^ q) (B ^ q)) :
  ∃ C : ℝ, 0 ≤ C ∧ C ≤ A * B ∧ has_sum (λ i, f i * g i) C :=
begin
  lift f to (ι → ℝ≥0) using hf,
  lift g to (ι → ℝ≥0) using hg,
  lift A to ℝ≥0 using hA,
  lift B to ℝ≥0 using hB,
  norm_cast at hf_sum hg_sum,
  obtain ⟨C, hC, H⟩ := nnreal.inner_le_Lp_mul_Lq_has_sum hpq hf_sum hg_sum,
  refine ⟨C, C.prop, hC, _⟩,
  norm_cast,
  exact H
end

/-- For `1 ≤ p`, the `p`-th power of the sum of `f i` is bounded above by a constant times the
sum of the `p`-th powers of `f i`. Version for sums over finite sets, with nonnegative `ℝ`-valued
functions. -/
theorem rpow_sum_le_const_mul_sum_rpow_of_nonneg (hp : 1 ≤ p) (hf : ∀ i ∈ s, 0 ≤ f i) :
  (∑ i in s, f i) ^ p ≤ (card s) ^ (p - 1) * ∑ i in s, f i ^ p :=
by convert rpow_sum_le_const_mul_sum_rpow s f hp using 2; apply sum_congr rfl; intros i hi;
  simp only [abs_of_nonneg, hf i hi]

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `ℝ`-valued nonnegative
functions. -/
theorem Lp_add_le_of_nonneg (hp : 1 ≤ p) (hf : ∀ i ∈ s, 0 ≤ f i) (hg : ∀ i ∈ s, 0 ≤ g i) :
  (∑ i in s, (f i + g i) ^ p) ^ (1 / p) ≤
    (∑ i in s, (f i) ^ p) ^ (1 / p) + (∑ i in s, (g i) ^ p) ^ (1 / p) :=
by convert Lp_add_le s f g hp using 2 ; [skip, congr' 1, congr' 1];
  apply sum_congr rfl; intros i hi; simp only [abs_of_nonneg, hf i hi, hg i hi, add_nonneg]

/-- Minkowski inequality: the `L_p` seminorm of the infinite sum of two vectors is less than or
equal to the infinite sum of the `L_p`-seminorms of the summands, if these infinite sums both
exist. A version for `ℝ`-valued functions. For an alternative version, convenient if the infinite
sums are already expressed as `p`-th powers, see `Lp_add_le_has_sum_of_nonneg`. -/
theorem Lp_add_le_tsum_of_nonneg (hp : 1 ≤ p) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i)
  (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ p)) :
  summable (λ i, (f i + g i) ^ p) ∧
  (∑' i, (f i + g i) ^ p) ^ (1 / p) ≤ (∑' i, (f i) ^ p) ^ (1 / p) + (∑' i, (g i) ^ p) ^ (1 / p) :=
begin
  lift f to (ι → ℝ≥0) using hf,
  lift g to (ι → ℝ≥0) using hg,
  norm_cast at *,
  exact nnreal.Lp_add_le_tsum hp hf_sum hg_sum,
end

theorem summable_Lp_add_of_nonneg (hp : 1 ≤ p) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i)
  (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ p)) :
  summable (λ i, (f i + g i) ^ p) :=
(Lp_add_le_tsum_of_nonneg hp hf hg hf_sum hg_sum).1

theorem Lp_add_le_tsum_of_nonneg' (hp : 1 ≤ p) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i)
  (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ p)) :
  (∑' i, (f i + g i) ^ p) ^ (1 / p) ≤ (∑' i, (f i) ^ p) ^ (1 / p) + (∑' i, (g i) ^ p) ^ (1 / p) :=
(Lp_add_le_tsum_of_nonneg hp hf hg hf_sum hg_sum).2

/-- Minkowski inequality: the `L_p` seminorm of the infinite sum of two vectors is less than or
equal to the infinite sum of the `L_p`-seminorms of the summands, if these infinite sums both
exist. A version for `ℝ`-valued functions. For an alternative version, convenient if the infinite
sums are not already expressed as `p`-th powers, see `Lp_add_le_tsum_of_nonneg`. -/
theorem Lp_add_le_has_sum_of_nonneg (hp : 1 ≤ p) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i) {A B : ℝ}
  (hA : 0 ≤ A) (hB : 0 ≤ B) (hfA : has_sum (λ i, (f i) ^ p) (A ^ p))
  (hgB : has_sum (λ i, (g i) ^ p) (B ^ p)) :
  ∃ C, 0 ≤ C ∧ C ≤ A + B ∧ has_sum (λ i, (f i + g i) ^ p) (C ^ p) :=
begin
  lift f to (ι → ℝ≥0) using hf,
  lift g to (ι → ℝ≥0) using hg,
  lift A to ℝ≥0 using hA,
  lift B to ℝ≥0 using hB,
  norm_cast at hfA hgB,
  obtain ⟨C, hC₁, hC₂⟩ := nnreal.Lp_add_le_has_sum hp hfA hgB,
  use C,
  norm_cast,
  exact ⟨zero_le _, hC₁, hC₂⟩,
end

end real

namespace ennreal

variables (f g : ι → ℝ≥0∞)  {p q : ℝ}

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with `ℝ≥0∞`-valued functions. -/
theorem inner_le_Lp_mul_Lq (hpq : p.is_conjugate_exponent q) :
  (∑ i in s, f i * g i) ≤ (∑ i in s, (f i)^p) ^ (1/p) * (∑ i in s, (g i)^q) ^ (1/q) :=
begin
  by_cases H : (∑ i in s, (f i)^p) ^ (1/p) = 0 ∨ (∑ i in s, (g i)^q) ^ (1/q) = 0,
  { replace H : (∀ i ∈ s, f i = 0) ∨ (∀ i ∈ s, g i = 0),
      by simpa [ennreal.rpow_eq_zero_iff, hpq.pos, hpq.symm.pos, asymm hpq.pos, asymm hpq.symm.pos,
                sum_eq_zero_iff_of_nonneg] using H,
    have : ∀ i ∈ s, f i * g i = 0 := λ i hi, by cases H; simp [H i hi],
    have : (∑ i in s, f i * g i) = (∑ i in s, 0) := sum_congr rfl this,
    simp [this] },
  push_neg at H,
  by_cases H' : (∑ i in s, (f i)^p) ^ (1/p) = ⊤ ∨ (∑ i in s, (g i)^q) ^ (1/q) = ⊤,
  { cases H'; simp [H', -one_div, H] },
  replace H' : (∀ i ∈ s, f i ≠ ⊤) ∧ (∀ i ∈ s, g i ≠ ⊤),
    by simpa [ennreal.rpow_eq_top_iff, asymm hpq.pos, asymm hpq.symm.pos, hpq.pos, hpq.symm.pos,
              ennreal.sum_eq_top_iff, not_or_distrib] using H',
  have := ennreal.coe_le_coe.2 (@nnreal.inner_le_Lp_mul_Lq _ s (λ i, ennreal.to_nnreal (f i))
              (λ i, ennreal.to_nnreal (g i)) _ _ hpq),
  simp [← ennreal.coe_rpow_of_nonneg, le_of_lt (hpq.pos), le_of_lt (hpq.one_div_pos),
             le_of_lt (hpq.symm.pos), le_of_lt (hpq.symm.one_div_pos)] at this,
  convert this using 1;
  [skip, congr' 2];
  [skip, skip, simp, skip, simp];
  { apply finset.sum_congr rfl (λ i hi, _), simp [H'.1 i hi, H'.2 i hi, -with_zero.coe_mul,
    with_top.coe_mul.symm] },
end

/-- For `1 ≤ p`, the `p`-th power of the sum of `f i` is bounded above by a constant times the
sum of the `p`-th powers of `f i`. Version for sums over finite sets, with `ℝ≥0∞`-valued functions.
-/
theorem rpow_sum_le_const_mul_sum_rpow (hp : 1 ≤ p) :
  (∑ i in s, f i) ^ p ≤ (card s) ^ (p - 1) * ∑ i in s, (f i) ^ p :=
begin
  cases eq_or_lt_of_le hp with hp hp,
  { simp [← hp] },
  let q : ℝ := p / (p - 1),
  have hpq : p.is_conjugate_exponent q,
  { rw real.is_conjugate_exponent_iff hp },
  have hp₁ : 1 / p * p = 1 := one_div_mul_cancel hpq.ne_zero,
  have hq : 1 / q * p = (p - 1),
  { rw [← hpq.div_conj_eq_sub_one],
    ring },
  simpa only [ennreal.mul_rpow_of_nonneg _ _ hpq.nonneg, ← ennreal.rpow_mul, hp₁, hq, coe_one,
    one_mul, one_rpow, rpow_one, pi.one_apply, sum_const, nat.smul_one_eq_coe]
    using ennreal.rpow_le_rpow (inner_le_Lp_mul_Lq s 1 f hpq.symm) hpq.nonneg,
end

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `ℝ≥0∞` valued nonnegative
functions. -/
theorem Lp_add_le (hp : 1 ≤ p) :
  (∑ i in s, (f i + g i) ^ p)^(1/p) ≤ (∑ i in s, (f i)^p) ^ (1/p) + (∑ i in s, (g i)^p) ^ (1/p) :=
begin
  by_cases H' : (∑ i in s, (f i)^p) ^ (1/p) = ⊤ ∨ (∑ i in s, (g i)^p) ^ (1/p) = ⊤,
  { cases H'; simp [H', -one_div] },
  have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  replace H' : (∀ i ∈ s, f i ≠ ⊤) ∧ (∀ i ∈ s, g i ≠ ⊤),
    by simpa [ennreal.rpow_eq_top_iff, asymm pos, pos, ennreal.sum_eq_top_iff,
              not_or_distrib] using H',
  have := ennreal.coe_le_coe.2 (@nnreal.Lp_add_le _ s (λ i, ennreal.to_nnreal (f i))
              (λ i, ennreal.to_nnreal (g i)) _  hp),
  push_cast [← ennreal.coe_rpow_of_nonneg, le_of_lt (pos), le_of_lt (one_div_pos.2 pos)] at this,
  convert this using 2;
  [skip, congr' 1, congr' 1];
  { apply finset.sum_congr rfl (λ i hi, _), simp [H'.1 i hi, H'.2 i hi] }
end

end ennreal

end holder_minkowski


import data.real.basic algebra.group_power tactic.ring

example (x : ℝ) : 2 * (x ^ 2 + 3) = 6 + 2 * x ^ 2 := by ring
example (x : ℝ) : (2 * x) ^ 2 = 4 * x ^ 2 := by ring

variable {x : ℝ}
def f : ℝ → ℝ := λ x, x^2 + 3
def g : ℝ → ℝ := λ x, 2*x

def h1 : ℝ → ℝ := g ∘ f
theorem Q1005i : h1 x = 2*x^2 + 6 :=
begin
  dsimp [h1, f, g],
  rw [mul_add],
  refl
end

def h2 : ℝ → ℝ := f ∘ g
theorem Q1005ii : h2 x = 4*x^2 + 3 :=
begin
  dsimp [h2, f, g],
  rw [mul_pow],
  refl
end

def h3 : ℝ → ℝ := λ x, f x * g x
theorem Q1005iii : h3 x = 2*x^3 + 6*x :=
begin
dsimp [h3, f, g],
ring,
end

def h4 : ℝ → ℝ := λ x, f x + g x
theorem Q1005iv : h4 x = x^2 + 2*x + 3 :=
begin
dsimp [h4, f, g],
ring,
end

def h5 : ℝ → ℝ := λ x, f (g x)
theorem Q1005v : h5 x = h2 x :=
begin
refl,
end


/-
1. Try defining other operations on the natural numbers, such as multiplication, the predecessor function (with pred 0 = 0), truncated subtraction (with n - m = 0 when m is greater than or equal to n), and exponentiation. Then try proving some of their basic properties, building on the theorems we have already proved.

Since many of these are already defined in Lean’s core library, you should work within a namespace named hide, or something like that, in order to avoid name clashes.
-/
namespace hidden
  namespace nat
    def mul (m n : nat) : nat :=
      nat.rec_on n 0 (λ n mul_m_n, m + mul_m_n)
    #reduce mul 3 6

    def pred (n : nat) : nat :=
      nat.rec_on n 0 (λ n pred_n, n)
    #reduce pred 10

    def sub (m n : nat) : nat :=
      nat.rec_on n m (λ n sub_m_n, pred sub_m_n)
    #reduce sub 5 2
    #reduce sub 2 5

    def exp (m n : nat) : nat :=
      nat.rec_on n 1 (λ n exp_m_n, mul m exp_m_n)
    #reduce exp 2 4

    theorem mul_zero (n : nat) : mul n 0 = 0 := rfl
    theorem zero_mul (n : nat) : mul 0 n = 0 :=
    nat.rec_on n
    (
      show mul 0 0 = 0, from rfl
    )
    (
      assume n,
      assume ih : mul 0 n = 0,
      show mul 0 (nat.succ n) = 0, from
        calc
          mul 0 (nat.succ n) = 0 + (mul 0 n):  rfl
                         ... = 0 + 0 : by rw ih
                         ... = 0 : rfl
    )

    theorem mul_one (n : nat) : mul n 1 = n := rfl
    theorem one_mul (n : nat) : mul 1 n = n :=
    nat.rec_on n
    (
      show mul 1 0 = 0, from rfl
    )
    (
      assume n,
      assume ih : mul 1 n = n,
      show mul 1 (nat.succ n) = nat.succ n, from
        calc
          mul 1 (nat.succ n) = 1 + (mul 1 n) : rfl
                         ... = 1 + n : by rw ih
                         ... = n + 1 : by rw nat.add_comm
                         ... = nat.succ n : rfl
    )

    theorem pred_succ (n : nat) : pred (nat.succ n) = n := rfl

    theorem zero_sub (n : nat) : sub 0 n = 0 :=
    nat.rec_on n
    (
      show sub 0 0 = 0, from rfl
    )
    (
      assume n,
      assume ih : sub 0 n = 0,
      show sub 0 (nat.succ n) = 0, from congr_arg pred ih
    )

    theorem exp_zero (n : nat) : exp n 0 = 1 := rfl
  end nat
end hidden


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

/-!

# Sets in Lean, sheet 5 : subset (`⊆`), union (`∪`) and intersection (`∩`)

In this sheet we learn how to manipulate `⊆`, `∪` and `∩` in Lean.

Here are some mathematical facts:

`A ⊆ B` is equivalent to `∀ x, x ∈ A → x ∈ B`;
`x ∈ A ∪ B` is equivalent to `x ∈ A ∨ x ∈ B`;
`x ∈ A ∩ B` is equivalent to `x ∈ A ∧ x ∈ B`.

All of these things are true *by definition* in Lean, which means
that you can switch from one to the other with `change`, or you
can just treat something on the left hand side as if it said
what it said on the right hand side.

For example if your goal is `⊢ x ∈ A ∩ B` then you could write
`change x ∈ A ∧ x ∈ B,` to change the goal to `⊢ x ∈ A ∧ x ∈ B`, but you can
also use the `split,` tactic directly, and this will immediately turn the goal
into two goals `⊢ x ∈ A` and `⊢ x ∈ B`.

## New tactics you will need

You don't need to know any new tactics to solve this sheet. I've mentioned
the `change` tactic. You don't have to use it, and if you use it your
proofs will get longer. So in return I'll tell you about two other
tactics, `rcases` and `rintro`, which you don't have to use either
but if you use them they'll make your proofs shorter.

### The `rcases` tactic

`rcases` is a souped-up version of `cases`. It has slightly different
syntax. If you have a hypothesis `h : P ∧ Q` then `cases h with hP hQ,`
and `rcases h with ⟨hP, hQ⟩,` do the same thing. However, if you
have a hypothesis `h : P ∧ Q ∧ R` then Lean interprets it as `P ∧ (Q ∧ R)`
so if you want to destruct it with `cases` you have to do

```
cases h with hP hQR,
cases hQR with hQ hR
```

You can do this all in one go with `rcases h with ⟨hP, hQ, hR⟩,`. The
name `rcases` stands for "recursive cases".

`rcases` can also be used for `or` hypotheses too; here the syntax is that if
we have
```
h : P ∨ Q
```
then `rcases h with (hP | hQ),` will turn our goal into two goals, one with
`hP : P` and the other with `hQ : Q`.

Even better, `rcases` works on `h : false`. Here there are no cases at all!
So `rcases h with ⟨⟩,` solves the goal.

### The `rintro` tactic

It's quite common to find yourself doing `intro` then `cases` or,
more generally, `intro` then `rcases`. The `rintro` tactic does
these both at once! So for example if your goal is

```
⊢ (P ∧ Q) → R
```

then `rintro ⟨hP, hQ⟩,` leaves you at

```
hP : P
hQ : Q
⊢ R
```

i.e. the same as `intro h, cases h with hP hQ,`

You can introduce more than one hypothesis at once -- `rintro` generalises
`intros` as well. For example if your goal is

```
⊢ P → Q ∧ R → S
```

then `rintro hP ⟨hQ, hR⟩,` turns it into

```
hP : P
hQ : Q
hR : R
⊢ S
```

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : A ⊆ A :=
begin
  sorry,
end

example : ∅ ⊆ A :=
begin
  sorry,
end

example : A ⊆ univ :=
begin
  sorry,
end

example : A ⊆ B → B ⊆ C → A ⊆ C :=
begin
  sorry,
end

example : A ⊆ A ∪ B :=
begin
  sorry,
end

example : A ∩ B ⊆ A :=
begin
  sorry,
end

example : A ⊆ B → A ⊆ C → A ⊆ (B ∩ C) :=
begin
  sorry,
end

example : B ⊆ A → C ⊆ A → B ∪ C ⊆ A :=
begin
  sorry,
end

example : A ⊆ B → C ⊆ D → A ∪ C ⊆ B ∪ D :=
begin
  sorry,
end

example : A ⊆ B → C ⊆ D → A ∩ C ⊆ B ∩ D :=
begin
  sorry,
end


/- LoVe Homework 6: Monads -/

import .lovelib

namespace LoVe

/- Question 2 **optional**: Monadic Structure on Lists -/

/- `list` can be seen as a monad, similar to `option` but with several possible
outcomes. It is also similar to `set`, but the results are ordered and finite.
The code below sets `list` up as a monad. -/

namespace list

protected def bind {α β : Type} : list α → (α → list β) → list β
| []        f := []
| (a :: as) f := f a ++ bind as f

protected def pure {α : Type} (a : α) : list α :=
[a]

lemma pure_eq_singleton {α : Type} (a : α) :
  pure a = [a] :=
by refl

instance : monad list :=
{ pure := @list.pure,
  bind := @list.bind }

/- 2.1 **optional**. Prove the following properties of `bind` under the empty
list (`[]`), the list constructor (`::`), and `++`. -/

@[simp] lemma bind_nil {α β : Type} (f : α → list β) :
  [] >>= f = [] :=
by refl

@[simp] lemma bind_cons {α β : Type} (f : α → list β) (a : α) (as : list α) :
  list.cons a as >>= f = f a ++ (as >>= f) :=
by refl

@[simp] lemma bind_append {α β : Type} (f : α → list β) :
  ∀as as' : list α, (as ++ as') >>= f = (as >>= f) ++ (as' >>= f)
| []        as' := by refl
| (a :: as) as' := by simp [bind_append as as']

/- 2.2 **optional**. Prove the monadic laws for `list`.

Hint: The simplifier cannot see through the type class definition of `pure`. You
can use `pure_eq_singleton` to unfold the definition or `show` to state the
lemma statement using `bind` and `[…]`. -/

lemma pure_bind {α β : Type} (a : α) (f : α → list β) :
  (pure a >>= f) = f a :=
show ([a] >>= f) = f a,
  by simp

lemma bind_pure {α : Type} :
  ∀as : list α, as >>= pure = as
| []       := by refl
| (a :: l) := by simp [pure_eq_singleton, bind_pure l]

lemma bind_assoc {α β γ : Type} (f : α → list β) (g : β → list γ) :
  ∀as : list α, (as >>= f) >>= g = as >>= (λa, f a >>= g)
| []        := by refl
| (a :: as) := by simp [bind_append, bind_assoc as]

lemma bind_pure_comp_eq_map {α β : Type} {f : α → β} :
  ∀as : list α, as >>= (pure ∘ f) = list.map f as
| []        := by refl
| (a :: as) := by simp [bind_pure_comp_eq_map as, pure_eq_singleton]

end list

end LoVe


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import algebra.group.pi
import algebra.group_power

/-!
# The group of permutations (self-equivalences) of a type `α`

This file defines the `group` structure on `equiv.perm α`.
-/
universes u v

namespace equiv

variables {α : Type u}

namespace perm

instance perm_group : group (perm α) :=
{ mul := λ f g, equiv.trans g f,
  one := equiv.refl α,
  inv := equiv.symm,
  mul_assoc := λ f g h, (trans_assoc _ _ _).symm,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_left_inv := trans_symm }

theorem mul_apply (f g : perm α) (x) : (f * g) x = f (g x) :=
equiv.trans_apply _ _ _

theorem one_apply (x) : (1 : perm α) x = x := rfl

@[simp] lemma inv_apply_self (f : perm α) (x) : f⁻¹ (f x) = x := f.symm_apply_apply x

@[simp] lemma apply_inv_self (f : perm α) (x) : f (f⁻¹ x) = x := f.apply_symm_apply x

lemma one_def : (1 : perm α) = equiv.refl α := rfl

lemma mul_def (f g : perm α) : f * g = g.trans f := rfl

lemma inv_def (f : perm α) : f⁻¹ = f.symm := rfl

@[simp] lemma coe_mul (f g : perm α) : ⇑(f * g) = f ∘ g := rfl

@[simp] lemma coe_one : ⇑(1 : perm α) = id := rfl

lemma eq_inv_iff_eq {f : perm α} {x y : α} : x = f⁻¹ y ↔ f x = y := f.eq_symm_apply

lemma inv_eq_iff_eq {f : perm α} {x y : α} : f⁻¹ x = y ↔ x = f y := f.symm_apply_eq

lemma gpow_apply_comm {α : Type*} (σ : equiv.perm α) (m n : ℤ) {x : α} :
  (σ ^ m) ((σ ^ n) x) = (σ ^ n) ((σ ^ m) x) :=
by rw [←equiv.perm.mul_apply, ←equiv.perm.mul_apply, gpow_mul_comm]

/-! Lemmas about mixing `perm` with `equiv`. Because we have multiple ways to express
`equiv.refl`, `equiv.symm`, and `equiv.trans`, we want simp lemmas for every combination.
The assumption made here is that if you're using the group structure, you want to preserve it after
simp. -/

@[simp] lemma trans_one {α : Sort*} {β : Type*} (e : α ≃ β) : e.trans (1 : perm β) = e :=
equiv.trans_refl e

@[simp] lemma mul_refl (e : perm α) : e * equiv.refl α = e := equiv.trans_refl e

@[simp] lemma one_symm : (1 : perm α).symm = 1 := equiv.refl_symm

@[simp] lemma refl_inv : (equiv.refl α : perm α)⁻¹ = 1 := equiv.refl_symm

@[simp] lemma one_trans {α : Type*} {β : Sort*} (e : α ≃ β) : (1 : perm α).trans e = e :=
equiv.refl_trans e

@[simp] lemma refl_mul (e : perm α) : equiv.refl α * e = e := equiv.refl_trans e

@[simp] lemma inv_trans (e : perm α) : e⁻¹.trans e = 1 := equiv.symm_trans e

@[simp] lemma mul_symm (e : perm α) : e * e.symm = 1 := equiv.symm_trans e

@[simp] lemma trans_inv (e : perm α) : e.trans e⁻¹ = 1 := equiv.trans_symm e

@[simp] lemma symm_mul (e : perm α) : e.symm * e = 1 := equiv.trans_symm e

/-! Lemmas about `equiv.perm.sum_congr` re-expressed via the group structure. -/

@[simp] lemma sum_congr_mul {α β : Type*} (e : perm α) (f : perm β) (g : perm α) (h : perm β) :
  sum_congr e f * sum_congr g h = sum_congr (e * g) (f * h) :=
sum_congr_trans g h e f

@[simp] lemma sum_congr_inv {α β : Type*} (e : perm α) (f : perm β) :
  (sum_congr e f)⁻¹ = sum_congr e⁻¹ f⁻¹ :=
sum_congr_symm e f

@[simp] lemma sum_congr_one {α β : Type*} :
  sum_congr (1 : perm α) (1 : perm β) = 1 :=
sum_congr_refl

/-- `equiv.perm.sum_congr` as a `monoid_hom`, with its two arguments bundled into a single `prod`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between `α` and `β`. -/
@[simps]
def sum_congr_hom (α β : Type*) :
  perm α × perm β →* perm (α ⊕ β) :=
{ to_fun := λ a, sum_congr a.1 a.2,
  map_one' := sum_congr_one,
  map_mul' := λ a b, (sum_congr_mul _ _ _ _).symm}

lemma sum_congr_hom_injective {α β : Type*} :
  function.injective (sum_congr_hom α β) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split; ext i,
  { simpa using equiv.congr_fun h (sum.inl i), },
  { simpa using equiv.congr_fun h (sum.inr i), },
end

@[simp] lemma sum_congr_swap_one {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : α) :
  sum_congr (equiv.swap i j) (1 : perm β) = equiv.swap (sum.inl i) (sum.inl j) :=
sum_congr_swap_refl i j

@[simp] lemma sum_congr_one_swap {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : β) :
  sum_congr (1 : perm α) (equiv.swap i j) = equiv.swap (sum.inr i) (sum.inr j) :=
sum_congr_refl_swap i j

/-! Lemmas about `equiv.perm.sigma_congr_right` re-expressed via the group structure. -/

@[simp] lemma sigma_congr_right_mul {α : Type*} {β : α → Type*}
  (F : Π a, perm (β a)) (G : Π a, perm (β a)) :
  sigma_congr_right F * sigma_congr_right G = sigma_congr_right (F * G) :=
sigma_congr_right_trans G F

@[simp] lemma sigma_congr_right_inv {α : Type*} {β : α → Type*} (F : Π a, perm (β a)) :
  (sigma_congr_right F)⁻¹ = sigma_congr_right (λ a, (F a)⁻¹) :=
sigma_congr_right_symm F

@[simp] lemma sigma_congr_right_one {α : Type*} {β : α → Type*} :
  (sigma_congr_right (1 : Π a, equiv.perm $ β a)) = 1 :=
sigma_congr_right_refl

/-- `equiv.perm.sigma_congr_right` as a `monoid_hom`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between fibers. -/
@[simps]
def sigma_congr_right_hom {α : Type*} (β : α → Type*) :
  (Π a, perm (β a)) →* perm (Σ a, β a) :=
{ to_fun := sigma_congr_right,
  map_one' := sigma_congr_right_one,
  map_mul' := λ a b, (sigma_congr_right_mul _ _).symm }

lemma sigma_congr_right_hom_injective {α : Type*} {β : α → Type*} :
  function.injective (sigma_congr_right_hom β) :=
begin
  intros x y h,
  ext a b,
  simpa using equiv.congr_fun h ⟨a, b⟩,
end

/-- `equiv.perm.subtype_congr` as a `monoid_hom`. -/
@[simps] def subtype_congr_hom (p : α → Prop) [decidable_pred p] :
  (perm {a // p a}) × (perm {a // ¬ p a}) →* perm α :=
{ to_fun := λ pair, perm.subtype_congr pair.fst pair.snd,
  map_one' := perm.subtype_congr.refl,
  map_mul' := λ _ _, (perm.subtype_congr.trans _ _ _ _).symm }

lemma subtype_congr_hom_injective (p : α → Prop) [decidable_pred p] :
  function.injective (subtype_congr_hom p) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split;
  ext i;
  simpa using equiv.congr_fun h i
end

/-- If `e` is also a permutation, we can write `perm_congr`
completely in terms of the group structure. -/
@[simp] lemma perm_congr_eq_mul (e p : perm α) :
  e.perm_congr p = e * p * e⁻¹ := rfl

section extend_domain

/-! Lemmas about `equiv.perm.extend_domain` re-expressed via the group structure. -/

variables {β : Type*} (e : perm α) {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p)

@[simp] lemma extend_domain_one : extend_domain 1 f = 1 :=
extend_domain_refl f

@[simp] lemma extend_domain_inv : (e.extend_domain f)⁻¹ = e⁻¹.extend_domain f := rfl

@[simp] lemma extend_domain_mul (e e' : perm α) :
  (e.extend_domain f) * (e'.extend_domain f) = (e * e').extend_domain f :=
extend_domain_trans _ _ _

end extend_domain

/-- If the permutation `f` fixes the subtype `{x // p x}`, then this returns the permutation
  on `{x // p x}` induced by `f`. -/
def subtype_perm (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x)) : perm {x // p x} :=
⟨λ x, ⟨f x, (h _).1 x.2⟩, λ x, ⟨f⁻¹ x, (h (f⁻¹ x)).2 $ by simpa using x.2⟩,
  λ _, by simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk],
  λ _, by simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk]⟩

@[simp] lemma subtype_perm_apply (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x))
  (x : {x // p x}) : subtype_perm f h x = ⟨f x, (h _).1 x.2⟩ := rfl

@[simp] lemma subtype_perm_one (p : α → Prop) (h : ∀ x, p x ↔ p ((1 : perm α) x)) :
  @subtype_perm α 1 p h = 1 :=
equiv.ext $ λ ⟨_, _⟩, rfl

/-- The inclusion map of permutations on a subtype of `α` into permutations of `α`,
  fixing the other points. -/
def of_subtype {p : α → Prop} [decidable_pred p] : perm (subtype p) →* perm α :=
{ to_fun := λ f,
  ⟨λ x, if h : p x then f ⟨x, h⟩ else x, λ x, if h : p x then f⁻¹ ⟨x, h⟩ else x,
  λ x, have h : ∀ h : p x, p (f ⟨x, h⟩), from λ h, (f ⟨x, h⟩).2,
    by { simp only [], split_ifs at *;
         simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * },
  λ x, have h : ∀ h : p x, p (f⁻¹ ⟨x, h⟩), from λ h, (f⁻¹ ⟨x, h⟩).2,
    by { simp only [], split_ifs at *;
         simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * }⟩,
  map_one' := begin ext, dsimp, split_ifs; refl, end,
  map_mul' := λ f g, equiv.ext $ λ x, begin
  by_cases h : p x,
  { have h₁ : p (f (g ⟨x, h⟩)), from (f (g ⟨x, h⟩)).2,
    have h₂ : p (g ⟨x, h⟩), from (g ⟨x, h⟩).2,
    simp only [h, h₂, coe_fn_mk, perm.mul_apply, dif_pos, subtype.coe_eta] },
  { simp only [h, coe_fn_mk, perm.mul_apply, dif_neg, not_false_iff] }
end }

lemma of_subtype_subtype_perm {f : perm α} {p : α → Prop} [decidable_pred p]
  (h₁ : ∀ x, p x ↔ p (f x)) (h₂ : ∀ x, f x ≠ x → p x) :
  of_subtype (subtype_perm f h₁) = f :=
equiv.ext $ λ x, begin
  rw [of_subtype, subtype_perm],
  by_cases hx : p x,
  { simp only [hx, coe_fn_mk, dif_pos, monoid_hom.coe_mk, subtype.coe_mk]},
  { haveI := classical.prop_decidable,
    simp only [hx, not_not.mp (mt (h₂ x) hx), coe_fn_mk, dif_neg, not_false_iff,
      monoid_hom.coe_mk] }
end

lemma of_subtype_apply_of_not_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) {x : α} (hx : ¬ p x) :
  of_subtype f x = x :=
dif_neg hx

lemma mem_iff_of_subtype_apply_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) (x : α) :
  p x ↔ p ((of_subtype f : α → α) x) :=
if h : p x then by simpa only [of_subtype, h, coe_fn_mk, dif_pos, true_iff, monoid_hom.coe_mk]
  using (f ⟨x, h⟩).2
else by simp [h, of_subtype_apply_of_not_mem f h]

@[simp] lemma subtype_perm_of_subtype {p : α → Prop} [decidable_pred p] (f : perm (subtype p)) :
  subtype_perm (of_subtype f) (mem_iff_of_subtype_apply_mem f) = f :=
equiv.ext $ λ ⟨x, hx⟩, by { dsimp [subtype_perm, of_subtype],
  simp only [show p x, from hx, dif_pos, subtype.coe_eta] }

instance perm_unique {n : Type*} [unique n] : unique (equiv.perm n) :=
{ default := 1,
  uniq := λ σ, equiv.ext (λ i, subsingleton.elim _ _) }

@[simp] lemma default_perm {n : Type*} : default (equiv.perm n) = 1 := rfl

end perm

section swap
variables [decidable_eq α]

@[simp] lemma swap_inv (x y : α) : (swap x y)⁻¹ = swap x y := rfl

@[simp] lemma swap_mul_self (i j : α) : swap i j * swap i j = 1 := swap_swap i j

lemma swap_mul_eq_mul_swap (f : perm α) (x y : α) : swap x y * f = f * swap (f⁻¹ x) (f⁻¹ y) :=
equiv.ext $ λ z, begin
  simp only [perm.mul_apply, swap_apply_def],
  split_ifs;
  simp only [perm.apply_inv_self, *, perm.eq_inv_iff_eq, eq_self_iff_true, not_true] at *
end

lemma mul_swap_eq_swap_mul (f : perm α) (x y : α) : f * swap x y = swap (f x) (f y) * f :=
by rw [swap_mul_eq_mul_swap, perm.inv_apply_self, perm.inv_apply_self]

lemma swap_apply_apply (f : perm α) (x y : α) : swap (f x) (f y) = f * swap x y * f⁻¹ :=
by rw [mul_swap_eq_swap_mul, mul_inv_cancel_right]

/-- Left-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma swap_mul_self_mul (i j : α) (σ : perm α) : equiv.swap i j * (equiv.swap i j * σ) = σ :=
by rw [←mul_assoc, swap_mul_self, one_mul]

/-- Right-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma mul_swap_mul_self (i j : α) (σ : perm α) : (σ * equiv.swap i j) * equiv.swap i j = σ :=
by rw [mul_assoc, swap_mul_self, mul_one]

/-- A stronger version of `mul_right_injective` -/
@[simp]
lemma swap_mul_involutive (i j : α) : function.involutive ((*) (equiv.swap i j)) :=
swap_mul_self_mul i j

/-- A stronger version of `mul_left_injective` -/
@[simp]
lemma mul_swap_involutive (i j : α) : function.involutive (* (equiv.swap i j)) :=
mul_swap_mul_self i j

@[simp] lemma swap_eq_one_iff {i j : α} : swap i j = (1 : perm α) ↔ i = j :=
swap_eq_refl_iff

lemma swap_mul_eq_iff {i j : α} {σ : perm α} : swap i j * σ = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_right_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, one_mul])⟩

lemma mul_swap_eq_iff {i j : α} {σ : perm α} : σ * swap i j = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_left_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, mul_one])⟩

lemma swap_mul_swap_mul_swap {x y z : α} (hwz: x ≠ y) (hxz : x ≠ z) :
  swap y z * swap x y * swap y z = swap z x :=
equiv.ext $ λ n, by { simp only [swap_apply_def, perm.mul_apply], split_ifs; cc }

end swap

end equiv