import tutorial_world.level07_split --hide
open IncidencePlane --hide
open set --hide

/- Tactic : use

## Summary
The `use` tactic works on the goal that looks like `⊢ ∃ x, P x`, where the symbol **`∃`** is read as **"there exists"** and
**`P x`** can be understood as **"P is an element of x"**, which could also be written as **`P ∈ x`**.
In this case, the whole goal can be interpreted as **"there exists x such that P is an element of x"**.
Then, the `use` tactic is useful. If we know that an object `a` satisfies the  property `x`, then `use a`
will simplify the goal into ⊢ P a.

## Example
If your goal is `⊢ ∃ n : natural_numbers, 1 + x = x + n` then `use 1` will
turn the goal into `⊢ 1 + x = x + 1`, and the rather more unwise `use 0` will
turn it into the impossible-to-prove `⊢ 1 + x = x + 0`.
-/

/-
# Tutorial World

## Level 8: the `use` tactic.

In further proofs, we will need to prove that there exists an object satisfying certain properties.
The goal will then look like `⊢ ∃ x, P x`, where the symbol **`∃`** is read as **"there exists"** and
**`P x`** can be understood as **"P is an element of x"**, which could also be written as **`P ∈ x`**.
In this case, the whole goal can be interpreted as **"there exists x such that P is an element of x"**.
Then, the `use` tactic is useful. If we know that an object `a` satisfies the  property `x`, then `use a`
will simplify the goal into ⊢ P a.

Let's look at this level to understand it better! Delete the `sorry` to see the goal `⊢ ∃ (ℓ : Line Ω), P ∈ ℓ`.
What does this mean? You can read it as **"there exists a line ℓ that lies in the plane Ω, such that the point P is an element of the line ℓ"**.
[**Tip:** do a drawing if it feels very abstract to you.] Then, we have to
find an object **?** that satisfies the property `ℓ`, so that we can type `use ?,` to simplify the goal into
`⊢ P ∈ ?`. Now, we should take a look at our "Theorem statements" section to ask ourselves if there is any statement
that has a similar structure to the goal `⊢ P ∈ ?`. At this point, I am sure that you thought about `line_through_right`
or `line_through_left`. The statement `⊢ P ∈ line_through P Q` is very similar to that in `⊢ P ∈ ?`, isn't it?

Then, why don't we type `use line_through P Q,`. If you try that, you will see that an error appears. This is
because we don't have such point called Q in this level. We only have one point! And it's called P! What does this mean?
Do we have to create a line that goes from the point P to the point P again? Exactly! You may be wondering how is
that possible if a line cannot close itself as if it was a circle... in the plane! However, it **is** possible. We have not
defined what is a plane yet! The computer doesn't know how a plane looks like! Because of this reason, you can type `use
line_through P P,` and see how the goal changes into `⊢ P ∈ line_through P P`. Now, try to finish the proof by your own! It's
only one more line of code! In case you get stuck, click on the grey box right below to look for a "Hint".

-/

/- Hint : Click here for a hint, in case you get stuck.
Because the goal is now `⊢ P ∈ line_through P P`, it shows the same structure as `line_through_left` and `line_through_right`
statements. Try any of both to finish the proof by using the `exact` tactic. Remember to type the variables that we are using
before the comma! Still bewildered? Click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma : no-side-bar
Given a point, there is always a line containing it.
-/
lemma line_containing_point (P : Ω) : ∃ ℓ : Line Ω, P ∈ ℓ :=
begin
  use line_through P P,
  exact line_through_left P P,

end


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import data.real.basic
import data.real.sqrt
import data.nat.prime
import number_theory.primes_congruent_one
import number_theory.quadratic_reciprocity

/-!
# IMO 2008 Q3
Prove that there exist infinitely many positive integers `n` such that `n^2 + 1` has a prime
divisor which is greater than `2n + √(2n)`.

# Solution
We first prove the following lemma: for every prime `p > 20`, satisfying `p ≡ 1 [MOD 4]`,
there exists `n ∈ ℕ` such that `p ∣ n^2 + 1` and `p > 2n + √(2n)`. Then the statement of the
problem follows from the fact that there exist infinitely many primes `p ≡ 1 [MOD 4]`.

To prove the lemma, notice that `p ≡ 1 [MOD 4]` implies `∃ n ∈ ℕ` such that `n^2 ≡ -1 [MOD p]`
and we can take this `n` such that `n ≤ p/2`. Let `k = p - 2n ≥ 0`. Then we have:
`k^2 + 4 = (p - 2n)^2 + 4 ≣ 4n^2 + 4 ≡ 0 [MOD p]`. Then `k^2 + 4 ≥ p` and so `k ≥ √(p - 4) > 4`.
Then `p = 2n + k ≥ 2n + √(p - 4) = 2n + √(2n + k - 4) > √(2n)` and we are done.
-/

lemma p_lemma (p : ℕ) (hpp : nat.prime p) (hp_mod_4_eq_1 : p ≡ 1 [MOD 4]) (hp_gt_20 : p > 20) :
  ∃ n : ℕ, p ∣ n^2 + 1 ∧ (p : ℝ) > 2*n + real.sqrt(2*n) :=
begin
  haveI := fact.mk hpp,
  have hp_mod_4_ne_3 : p % 4 ≠ 3, { linarith [(show p % 4 = 1, by exact hp_mod_4_eq_1)]},
  obtain ⟨y, hy⟩ := (zmod.exists_pow_two_eq_neg_one_iff_mod_four_ne_three p).mpr hp_mod_4_ne_3,

  let m := zmod.val_min_abs y,
  let n := int.nat_abs (m),

  have hnat₁ : p ∣ n^2 + 1,
  { refine int.coe_nat_dvd.mp _,
    simp only [int.nat_abs_pow_two, int.coe_nat_pow, int.coe_nat_succ, int.coe_nat_dvd.mp],
    refine (zmod.int_coe_zmod_eq_zero_iff_dvd (m^2 + 1) p).mp _,
    simp only [int.cast_pow, int.cast_add, int.cast_one, zmod.coe_val_min_abs],
    rw hy, exact add_left_neg 1 },

  have hnat₂ : n ≤ p/2 := zmod.nat_abs_val_min_abs_le y,
  have hnat₃ : p ≥ 2*n, { linarith [nat.div_mul_le_self p 2] },

  set k : ℕ := p - 2*n with hnat₄,

  have hnat₅ : p ∣ k^2 + 4,
  { cases hnat₁ with x hx,
    let p₁ := (p : ℤ), let n₁ := (n : ℤ), let k₁ := (k : ℤ), let x₁ := (x : ℤ),
    have : p₁ ∣ k₁^2 + 4,
    { use p₁ - 4*n₁ + 4*x₁,
      calc  k₁^2 + 4
          = (p₁ - 2*n₁)^2 + 4             : by rw (show k₁ = p₁ - 2*n₁, by assumption_mod_cast)
      ... = p₁^2 - 4*p₁*n₁ + 4*(n₁^2 + 1) : by ring
      ... = p₁^2 - 4*p₁*n₁ + 4*(p₁*x₁)    : by rw (show n₁^2 + 1 = p₁*x₁, by assumption_mod_cast)
      ... = p₁*(p₁ - 4*n₁ + 4*x₁)         : by ring },
    assumption_mod_cast },

  have hnat₆ : k^2 + 4 ≥ p := nat.le_of_dvd (k^2 + 3).succ_pos hnat₅,

  let p₀ := (p : ℝ), let n₀ := (n : ℝ), let k₀ := (k : ℝ),

  have hreal₁ : p₀ = 2*n₀ + k₀, { linarith [(show k₀ = p₀ - 2*n₀, by assumption_mod_cast)] },
  have hreal₂ : p₀ > 20,        { assumption_mod_cast },
  have hreal₃ : k₀^2 + 4 ≥ p₀,  { assumption_mod_cast },

  have hreal₄ : k₀ ≥ real.sqrt(p₀ - 4),
  { calc  k₀ = real.sqrt(k₀^2)    : eq.symm (real.sqrt_sqr (nat.cast_nonneg k))
    ...      ≥ real.sqrt(p₀-4)    : real.sqrt_le_sqrt (by linarith [hreal₃]) },

  have hreal₅ : k₀ > 4,
  { calc k₀ ≥ real.sqrt(p₀-4)     : hreal₄
    ...     > real.sqrt(4^2)      : (real.sqrt_lt (by linarith)).mpr (by linarith [hreal₂])
    ...     = 4                   : real.sqrt_sqr (by linarith) },

  have hreal₆ : p₀ > 2*n₀ + real.sqrt(2*n),
  { calc p₀ = 2*n₀ + k₀                   : hreal₁
    ...     ≥ 2*n₀ + real.sqrt(p₀-4)      : by linarith [hreal₄]
    ...     = 2*n₀ + real.sqrt(2*n₀+k₀-4) : by rw hreal₁
    ...     > 2*n₀ + real.sqrt(2*n₀)      : by { refine add_lt_add_left _ (2*n₀),
                                                 refine (real.sqrt_lt _).mpr _,
                                                 refine mul_nonneg zero_le_two (nat.cast_nonneg n),
                                                 linarith [hreal₅] } },

  exact ⟨n, hnat₁, hreal₆⟩,
end

theorem imo2008_q3 : ∀ N : ℕ, ∃ n : ℕ, n ≥ N ∧
  ∃ p : ℕ, nat.prime p ∧ p ∣ n^2 + 1 ∧ (p : ℝ) > 2*n + real.sqrt(2*n) :=
begin
  intro N,
  obtain ⟨p, hpp, hineq₁, hp_mod_4_eq_1⟩ := nat.exists_prime_ge_modeq_one 4 (N^2+21) zero_lt_four,
  obtain ⟨n, hnat, hreal⟩ := p_lemma p hpp hp_mod_4_eq_1 (by linarith [hineq₁, nat.zero_le (N^2)]),

  have hineq₂  : n^2 + 1 ≥ p := nat.le_of_dvd (n^2).succ_pos hnat,
  have hineq₃  : n*n ≥ N*N,  { linarith [hineq₁, hineq₂, (pow_two n), (pow_two N)] },
  have hn_ge_N : n ≥ N       := nat.mul_self_le_mul_self_iff.mpr hineq₃,

  exact ⟨n, hn_ge_N, p, hpp, hnat, hreal⟩,
end


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

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers

/-!

# The real numbers in Lean

Lean has a copy of of the real numbers. It's called `real`,
but we use the usual notation `ℝ`. Put your cursor on the `ℝ` to find
out how to type it in VS Code.

In this sheet you will prove some basic equalities and inequalities
between "numerical expressions" in Lean. A numeral is something like `37`,
and a numerical expression is something like `(37 + 6) / 4`. To make
things a bit harder, I will throw in some `∃` statements. To make
progress on an `∃` goal, use the `use` tactic.

## Tactics

New tactics you'll need to know about:

* `norm_num` (proves equalities and inequalities involving numerical expressions)
* `use` (if the goal is `∃ x, x + 37 = 42` then `use 8` will change the goal
*        to `8 + 37 = 42`, and `use 10` will change it to `10 + 37 = 42`.

-/

example : (2 : ℝ) + 2 = 4 :=
begin
  norm_num,
end

example : (2 : ℝ) + 2 ≠ 5 :=
begin
  norm_num,
end

example : (2 : ℝ) + 2 < 5 :=
begin
  norm_num,
end

example : ∃ (x : ℝ), 3 * x + 7 = 12 :=
begin
  use 5/3,
  norm_num,
end

example : ∃ (x : ℝ), 3 * x + 7 ≠ 12 :=
begin
 use 1,
 norm_num,
end

example : ∃ (x y : ℝ), 2 * x + 3 * y = 7 ∧ x + 2 * y = 4 :=
begin
  use [2,1],
  norm_num,
end


import data.real.basic

variables a b c d e: ℝ

#check mul_comm
#check mul_assoc
#check add_comm
#check add_assoc (d * e)
#check add_mul
#check mul_add
#check two_mul

-- BEGIN
example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
begin
  rw [mul_add, add_mul, add_mul],
  rw [←add_assoc, add_assoc (a * a)],
  rw [mul_comm b a, ←two_mul],
end

example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
calc
  (a + b) * (a + b)
      = a * a + b * a + (a * b + b * b) :
          by rw [mul_add, add_mul, add_mul]
  ... = a * a + (b * a + a * b) + b * b :
          by rw [←add_assoc, add_assoc (a * a)]
  ... = a * a + 2 * (a * b) + b * b     :
          by rw [mul_comm b a, ←two_mul]

example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
calc
  (a + b) * (a + b)
      = a * a + b * a + (a * b + b * b) :
    begin
      rw add_mul,
      rw [mul_add, mul_add],
      rw mul_comm b a,
    end
  ... = a * a + (b * a + a * b) + b * b : by rw [←add_assoc, add_assoc (a * a)]
  ... = a * a + 2 * (a * b) + b * b     : by rw [mul_comm a b, ←two_mul]
-- END


import MyNat.Addition
import MyNat.Multiplication
import MultiplicationWorld.Level1
import MultiplicationWorld.Level6
namespace MyNat
open MyNat

/-!
# Multiplication World

## Level 8: `mul_comm`

Finally, the boss level of multiplication world. But you are well-prepared for it -- you have
`zero_mul` and `mul_zero`, as well as `succ_mul` and `mul_succ`. After this level you can of course
throw away one of each pair if you like, but I would recommend you hold on to them, sometimes it's
convenient to have exactly the right tools to do a job.

## Lemma
Multiplication is commutative.
-/
lemma mul_comm (a b : MyNat) : a * b = b * a := by
  induction b with
  | zero =>
    rw [zero_is_0]
    rw [zero_mul]
    rw [mul_zero]
  | succ b ih =>
    rw [succ_mul]
    rw [←ih]
    rw [mul_succ]

/-!
You've now proved that the natural numbers are a commutative semiring!
That's the last collectible in Multiplication World.
-/
-- instance MyNat.comm_semiring : comm_semiring MyNat := by structure_helper
-- BUGBUG
/-!
But don't leave multiplication just yet -- prove `mul_left_comm`, the last
level of the world, and then we can beef up the power of `simp`.

On to [Level 9](./Level9.lean.md)
-/


import tactic
import data.nat.prime
import data.set.finite

open nat

private def generate_naturals_satisfying_down (pred : ℕ → Prop) [decidable_pred pred] : ℕ → list ℕ
| 0     := []
| (n+1) := if pred n
           then n :: generate_naturals_satisfying_down n
           else      generate_naturals_satisfying_down n

def generate_naturals_satisfying_under (pred : ℕ → Prop) [decidable_pred pred] (z : ℕ) : list ℕ :=
list.reverse (generate_naturals_satisfying_down pred z)

def generate_primes_under (z : ℕ) : list ℕ :=
generate_naturals_satisfying_under nat.prime z

#eval generate_primes_under 40

lemma generated_exactly_naturals_satisfying_under (pred : ℕ → Prop) [decidable_pred pred] (z : ℕ) :
  ∀ n : ℕ,  n ∈ generate_naturals_satisfying_under pred z  ↔  n < z  ∧  pred n  :=
begin
  unfold generate_naturals_satisfying_under,
  induction z with y ih,
  {
    intro n,
    unfold generate_naturals_satisfying_down,
    simp,
  },
  intro n,
  specialize ih n,
  rw list.mem_reverse at *,
  split,
  {
    intro ass,
    unfold generate_naturals_satisfying_down at ass,
    by_cases n = y,
    {
      rename h n_eq_y,
      rw n_eq_y at *,
      have y_not_in : y ∉ generate_naturals_satisfying_down pred y,
      {
        by_contradiction,
        have hyp := (ih.1 h).left,
        exact (ne_of_lt hyp) rfl,
      },
      split_ifs at ass,
      {
        split,
        {
          exact lt_add_one y,
        },
        {
          exact h,
        },
      },
      {
        exfalso,
        exact y_not_in ass,
      }
    },
    {
      rename h n_neq_y,
      have n_in : n ∈ generate_naturals_satisfying_down pred y,
      {
        split_ifs at ass,
        {
          cases ass,
          {
            exfalso,
            exact n_neq_y ass,
          },
          {
            exact ass,
          }
        },
        {
          exact ass,
        }
      },
      have hyp := ih.1 n_in,
      split,
      {
        exact nat.lt.step hyp.left,
      },
      {
        exact hyp.right,
      },
    },
  },
  {
    rintro ⟨ n_small, n_prime ⟩,
    by_cases n < y,
    {
      rename h n_lt_y,
      have hyp := ih.2 (and.intro n_lt_y n_prime),
      unfold generate_naturals_satisfying_down,
      split_ifs,
      {
        exact list.mem_cons_of_mem y hyp,
      },
      {
        exact hyp,
      },
    },
    {
      have n_eq_y := nat.eq_of_lt_succ_of_not_lt n_small h,
      clear h,
      rw n_eq_y at *,
      unfold generate_naturals_satisfying_down,
      split_ifs,
      exact list.mem_cons_self y _,
    }
  },
end

theorem generated_exactly_primes_under (z : ℕ) :
  ∀ n : ℕ,  n ∈ generate_primes_under z  ↔  n < z  ∧  nat.prime n  :=
generated_exactly_naturals_satisfying_under nat.prime z

private def is_prime_aux (n : ℕ) (k : ℕ) : ℕ → bool
| zero     := tt
| (succ d) := if (k - d) ∣ n
              then ff
              else is_prime_aux d

-- It is not really fast, but why?
def is_prime_fast (n : ℕ) : bool :=
if n > 1
then is_prime_aux n (nat.sqrt n) (nat.sqrt n - 1)
else ff

def generate_primes_under_fast (z : ℕ) : list ℕ :=
generate_naturals_satisfying_under (λ x, is_prime_fast x) z

#eval generate_primes_under_fast 40

#eval list.length $ generate_primes_under 100000
#eval list.length $ generate_primes_under_fast 100000


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

-/

import data.list.basic data.vector data.finset data.nat.choose
import data.fintype.basic
import combinatorics.shift

import tactic.squeeze
namespace combinatorics

/- @latex: defn-binseq -/
def binseq := list bool

namespace binseq

instance : has_append binseq :=
  by { dsimp[binseq], apply_instance }

def repr' : binseq → string
| [] := ""
| (ff :: u) := "0" ++ (repr' u)
| (tt :: u) := "1" ++ (repr' u)

instance : has_repr binseq :=
 ⟨λ u, if u = [] then "∅" else repr' u⟩

def of_string (s : string) : binseq :=
 s.fold [] (λ l c, if c = '0' then (l ++ [ff])
                    else (if c = '1' then (l ++ [tt]) else l))

def rank : ∀ (u : binseq), ℕ
| [] := 0
| (ff :: v) := (rank v)
| (tt :: v) := (rank v).succ

def enum_by_length : ∀ (n : ℕ), list binseq
| 0 := [[]]
| (n + 1) := ((enum_by_length n).map (list.cons ff)) ++
             ((enum_by_length n).map (list.cons tt))

def enum_by_length_and_rank : ∀ (n k : ℕ), list binseq
| 0 0 := [[]]
| 0 (k + 1) := []
| (n + 1) 0 :=
   (enum_by_length_and_rank n 0).map (list.cons ff)
| (n + 1) (k + 1) :=
   (enum_by_length_and_rank n (k + 1)).map (list.cons ff) ++
   (enum_by_length_and_rank n k).map (list.cons tt)

namespace eg

/- @latex: eg-binseq -/
def a := binseq.of_string "010110"
#eval a
#eval a.length
#eval a.rank

#eval enum_by_length 3
#eval enum_by_length_and_rank 5 3

end eg

namespace enum_by_length

lemma length (n : ℕ) : (enum_by_length n).length = 2 ^ n :=
begin
  induction n with n ih; rw[enum_by_length],
  { simp },
  { rw[list.length_append, list.length_map, list.length_map,
       ih, pow_succ, two_mul] }
end

lemma nodup (n : ℕ) : (enum_by_length n).nodup :=
begin
  induction n with n ih; rw[enum_by_length],
  { exact list.nodup_singleton _ },
  { rw[list.nodup_append], split,
    { exact list.nodup.map list.cons_injective ih },
    split,
    { exact list.nodup.map list.cons_injective ih },
    { intros u hff htt,
      rcases list.mem_map.mp hff with ⟨v,⟨mv,ev⟩⟩,
      rcases list.mem_map.mp htt with ⟨w,⟨mw,ew⟩⟩,
      injection (ev.trans ew.symm) with hb ht,
      cases hb }
  }
end

lemma mem_iff {n : ℕ} {u : binseq} : u ∈ (enum_by_length n) ↔ u.length = n :=
begin
  induction n with n ih generalizing u; rw[enum_by_length],
  { rw[list.mem_singleton], symmetry, exact list.length_eq_zero },
  { rw[list.mem_append],
    split,
    rintro (hff|htt),
    { rcases list.mem_map.mp hff with ⟨v,⟨mv,ev⟩⟩,
      rw[← ev, list.length, ih.mp mv] },
    { rcases list.mem_map.mp htt with ⟨v,⟨mv,ev⟩⟩,
      rw[← ev, list.length, ih.mp mv] },
    { intro mu,
      cases u with b v,
      {cases mu},
      {cases b; rw[list.length] at mu; replace mu := nat.succ_inj'.mp mu;
       let hu := ih.mpr mu,
       { left , apply list.mem_map.mpr, use v, exact ⟨hu,rfl⟩ },
       { right, apply list.mem_map.mpr, use v, exact ⟨hu,rfl⟩ } } } }
end

end enum_by_length

def elems_by_length (n : ℕ) : finset binseq :=
 ⟨enum_by_length n,enum_by_length.nodup n⟩

namespace elems_by_length

/- @latex: prop-binseq -/
lemma card (n : ℕ) : (elems_by_length n).card = 2 ^ n :=
  enum_by_length.length n

lemma mem_iff {n : ℕ} {u : binseq} : u ∈ (elems_by_length n) ↔ u.length = n :=
  enum_by_length.mem_iff

instance (n : ℕ) : fintype { u : binseq // u.length = n } :=
fintype.of_finset (elems_by_length n) (@elems_by_length.mem_iff n)

end elems_by_length

/- @latex: prop-binseq -/
lemma card_by_length (n : ℕ) :
  fintype.card { u : binseq // u.length = n } = 2 ^ n :=
(fintype.card_of_finset (elems_by_length n) (@elems_by_length.mem_iff n)).trans
 (elems_by_length.card n)

namespace enum_by_length_and_rank

lemma length : ∀ (n k : ℕ),
 (enum_by_length_and_rank n k).length = n.choose k :=
begin
  intro n,
  induction n with n ih_n,
  { rintro ⟨_|k⟩; simp[enum_by_length_and_rank] },
  { rintro ⟨_|k⟩; simp[enum_by_length_and_rank, nat.choose],
    { rw[ih_n, nat.choose_zero_right] },
    { rw[ih_n, ih_n, add_comm] } }
end

lemma nodup : forall (n k : ℕ) , (enum_by_length_and_rank n k).nodup :=
begin
  intro n,
  induction n with n ih; rintro ⟨_|k⟩; rw[enum_by_length_and_rank],
  { exact list.nodup_singleton _ },
  { exact list.nodup_nil},
  { have : function.injective (list.cons ff) := λ _ _ h, (list.cons_inj ff).mp h,
    exact list.nodup.map list.cons_injective (ih 0) },
  { rw[list.nodup_append], split,
    { exact list.nodup.map list.cons_injective (ih (k + 1)) },
    split,
    { exact list.nodup.map list.cons_injective (ih k) },
    { intros u hff htt,
      rcases list.mem_map.mp hff with ⟨v,⟨mv,ev⟩⟩,
      rcases list.mem_map.mp htt with ⟨w,⟨mw,ew⟩⟩,
      injection (ev.trans ew.symm) with hb ht,
      cases hb }
  }
end

lemma mem_iff {n k : ℕ} {u : binseq} :
 u ∈ (enum_by_length_and_rank n k) ↔ u.length = n ∧ u.rank = k :=
begin
  have L : ∀ (u : binseq) (x y : bool) (l : list binseq),
    x :: u ∈ l.map (list.cons y) ↔ x = y ∧ u ∈ l :=
  begin
    intros u x y l,
    rw[list.mem_map],
    split; intro h,
    { rcases h with ⟨v,⟨h_mem,h_eq⟩⟩,
      injection h_eq with hxy hvu,
      rw[← hvu],
      exact ⟨hxy.symm,h_mem⟩ },
    { use u, rw[h.left], exact ⟨h.right,rfl⟩ }
  end,
  revert n k,
  induction u with b u ih,
  { rintro ⟨_|n⟩ ⟨_|k⟩; simp [enum_by_length_and_rank, rank];
    intros; exact (nat.succ_ne_zero _).symm },
  { rintro ⟨_|n⟩ ⟨_|k⟩; cases b;
    simp only
     [enum_by_length_and_rank, list.length, rank, L,
      list.not_mem_nil, list.mem_singleton, list.mem_append,
      nat.succ_ne_zero,
      ih, nat.succ_inj', eq_self_iff_true,
      true_and, false_and, and_false, false_or, or_false, iff_self]
   }
end

end enum_by_length_and_rank

def elems_by_length_and_rank (n k : ℕ) : finset binseq :=
 ⟨enum_by_length_and_rank n k,enum_by_length_and_rank.nodup n k⟩

namespace elems_by_length_and_rank

/- @latex: prop-binseq -/
lemma card (n k : ℕ) : (elems_by_length_and_rank n k).card = n.choose k :=
  enum_by_length_and_rank.length n k

lemma mem_iff {n k : ℕ} {u : binseq} :
  u ∈ (elems_by_length_and_rank n k) ↔ u.length = n ∧ u.rank = k :=
  enum_by_length_and_rank.mem_iff

instance (n k : ℕ) : fintype { u : binseq // u.length = n ∧ u.rank = k } :=
fintype.of_finset (elems_by_length_and_rank n k)
 (@elems_by_length_and_rank.mem_iff n k)

end elems_by_length_and_rank

lemma card_by_length_and_rank (n k : ℕ) :
  fintype.card { u : binseq // u.length = n ∧ u.rank = k } = n.choose k :=
(fintype.card_of_finset (elems_by_length_and_rank n k)
  (@elems_by_length_and_rank.mem_iff n k)).trans
 (elems_by_length_and_rank.card n k)

def to_nat_list : ∀ (u : binseq), list ℕ
| [] := []
| (ff :: u) := (to_nat_list u).map nat.succ
| (tt :: u) := 0 :: ((to_nat_list u).map nat.succ)

namespace to_nat_list

lemma length (u : binseq) : u.to_nat_list.length = u.rank :=
begin
  induction u with b u ih,
  simp [to_nat_list, rank],
  cases b; simp[to_nat_list, rank, ih]
end

lemma mem_iff {u : binseq} {i : ℕ} :
 i ∈ u.to_nat_list ↔ tt ∈ u.nth i :=
begin
  revert i,
  induction u with b u ih,
  { simp [to_nat_list], },
  cases b; rintro ⟨_|i⟩ ;
  rw [to_nat_list, list.nth],
  { rw [option.mem_def, option.some_inj, list.mem_map],
    { split, { rintro ⟨k,⟨h,⟨_⟩⟩⟩ }, { rintro ⟨_⟩ } } },
  { rw [list.mem_map],
    { split,
     { rintro ⟨j,⟨hm,he⟩⟩, rw [nat.succ_inj'.mp he] at hm, exact ih.mp hm },
     { intro h, use i, exact ⟨ih.mpr h,rfl⟩ } } },
  { rw [option.mem_def, eq_self_iff_true, iff_true],
    exact list.mem_cons_self _ _ },
  { split,
    { intro h, rw [list.mem_cons_iff] at h, rcases h with ⟨⟨_⟩|h⟩,
      rcases list.mem_map.mp h with ⟨j,⟨hm,he⟩⟩,
      rw [nat.succ_inj'.mp he] at hm, exact ih.mp hm },
    { intro h, apply list.mem_cons_of_mem, apply list.mem_map_of_mem,
      exact ih.mpr h } }
end

lemma bound (u : binseq) (i : ℕ) : i ∈ u.to_nat_list → i < u.length :=
begin
  revert i,
  induction u with b u ih,
  { simp [to_nat_list] },
  { cases b; rintro ⟨_|i⟩;
    simp only [to_nat_list, list.length, nat.zero_lt_succ, imp_true_iff],
    { intro h, rcases list.mem_map.mp h with ⟨j,⟨hm,he⟩⟩,
      rw [← he],
      exact nat.succ_lt_succ (ih j hm) },
    { intro h, rw[list.mem_cons_iff] at h,
      rcases h with ⟨⟨_⟩|h⟩,
      rcases list.mem_map.mp h with ⟨j,⟨hm,he⟩⟩,
      rw [← he],
      exact nat.succ_lt_succ (ih j hm) } }
end

lemma sorted (u : binseq) : list.sorted has_lt.lt u.to_nat_list :=
begin
  induction u with b u ih,
  { exact list.sorted_nil },
  { have h : ((to_nat_list u).map nat.succ).sorted has_lt.lt :=
      list.pairwise.map nat.succ @nat.succ_lt_succ ih,
    cases b; rw[to_nat_list],
    { exact h },
    { rw [list.sorted_cons], split,
      { intros i hi, rcases list.mem_map.mp hi with ⟨j,⟨hm,he⟩⟩,
        rw[← he], exact nat.zero_lt_succ _ },
      { exact h } } }
end

lemma nodup (u : binseq) : u.to_nat_list.nodup :=
begin
  have h : ∀ i j : ℕ, i < j → i ≠ j := λ _ _ p, ne_of_lt p,
  exact list.pairwise.imp h (sorted u)
end

end to_nat_list

def to_nat_finset (u : binseq) : finset ℕ :=
  ⟨to_nat_list u, to_nat_list.nodup u⟩

namespace to_nat_finset

lemma card (u : binseq) : u.to_nat_finset.card = u.rank :=
  to_nat_list.length u

lemma mem_iff {u : binseq} {i : ℕ} : i ∈ u.to_nat_finset ↔ tt ∈ (u.nth i) :=
  to_nat_list.mem_iff

lemma bound (u : binseq) (i : ℕ) : i ∈ u.to_nat_finset → i < u.length :=
  to_nat_list.bound u i

lemma nil : to_nat_finset list.nil = ∅ :=
begin
  apply finset.eq_empty_of_forall_not_mem, intro i,
  rw [mem_iff, list.nth], exact option.not_mem_none tt
end

lemma ff_cons (u : binseq) :
 to_nat_finset (ff :: u) = (to_nat_finset u).map nat.succ_emb :=
by { rw[to_nat_finset, to_nat_finset, finset.map], congr }

lemma tt_cons (u : binseq) :
 to_nat_finset (tt :: u) = insert 0 ((to_nat_finset u).map nat.succ_emb) :=
by { rw[to_nat_finset, to_nat_finset, finset.map],
     congr, rw [to_nat_list], symmetry,
     apply list.insert_neg, intro h,
     rcases (list.mem_map.mp h) with ⟨i,⟨_,⟨_⟩⟩⟩ }

lemma cons (b : bool) (u : binseq) :
  to_nat_finset (b :: u) =
    cond b (insert 0 ((to_nat_finset u).map nat.succ_emb))
           ((to_nat_finset u).map nat.succ_emb) :=
begin
  cases b; rw[cond], apply ff_cons, apply tt_cons
end

end to_nat_finset

def to_fin_list {n : ℕ} (u : binseq) (h : u.length = n) : list (fin n) :=
begin
  have hb : ∀ i : ℕ, i ∈ u.to_nat_list → i < n :=
    λ i hi, h ▸ (to_nat_list.bound u i hi),
  exact list.pmap fin.mk u.to_nat_list hb
end

namespace to_fin_list

variables {n : ℕ} (u : binseq) (h : u.length = n)

lemma val : (u.to_fin_list h).map subtype.val = u.to_nat_list :=
begin
  rw[to_fin_list, list.map_pmap],
  have : (λ (i : ℕ) (h : i < n), (fin.mk i h).val) =
         (λ (i : ℕ) (h : i < n), id i) :=
    by { funext i h, refl },
  rw [this, list.pmap_eq_map, list.map_id]
end

lemma length : (u.to_fin_list h).length = u.rank :=
by { rw[to_fin_list, list.length_pmap, to_nat_list.length u] }

variables {u h}

lemma mem_iff {i : fin n} :
  i ∈ u.to_fin_list h ↔ u.nth_le i.val (h.symm ▸ i.is_lt) = tt :=
begin
  have hi : i.val < u.length := h.symm ▸ i.is_lt,
  have hn : u.nth i.val = some (u.nth_le i.val hi) := list.nth_le_nth _,
  rw [to_fin_list, list.mem_pmap],
  split,
  { rintro ⟨j,⟨hj,he⟩⟩,
    let ho := option.mem_def.mp (to_nat_list.mem_iff.mp hj),
    have hv : i.val = j := by { rw[← he], refl },
    rw [← hv] at ho,
    rw [ho] at hn,
    exact (option.some_inj.mp hn).symm },
  { intro hv, rw[hv] at hn, use i.val,
    use to_nat_list.mem_iff.mpr hn, apply fin.eq_of_veq, refl }
end

variables (u h)

lemma sorted : (u.to_fin_list h).sorted has_lt.lt :=
begin
  change list.pairwise _ _,
  apply list.pairwise.pmap (to_nat_list.sorted u),
  intros i hi j hj hij,
  exact hij
end

lemma nodup : (u.to_fin_list h).nodup :=
begin
  have hp : ∀ i j : (fin n), i < j → i ≠ j := λ _ _ p, ne_of_lt p,
  exact list.pairwise.imp hp (sorted u h)
end

end to_fin_list

def to_fin_finset {n : ℕ} (u : binseq) (h : u.length = n): finset (fin n) :=
  ⟨to_fin_list u h, to_fin_list.nodup u h⟩

namespace to_fin_finset

variables {n : ℕ} (u : binseq) (h : u.length = n)

lemma val :
  (to_fin_finset u h).map (fin.val_emb n) = to_nat_finset u :=
begin
  rw [to_fin_finset, finset.map, to_nat_finset, ← finset.val_inj],
  simp only [multiset.coe_map, multiset.coe_eq_coe, list.map],
  rw [← to_fin_list.val u h], refl
end

lemma card : (to_fin_finset u h).card = u.rank :=
  to_fin_list.length u h

lemma mem_iff {i : fin n} : i ∈ (to_fin_finset u h) ↔ u.nth_le i.val (h.symm ▸ i.is_lt) = tt :=
  to_fin_list.mem_iff

lemma nil (h : list.nil.length = 0) : to_fin_finset list.nil h = ∅ := rfl

lemma ff_cons :
  to_fin_finset (ff :: u) (by { rw[list.length, h] }) =
   shift (to_fin_finset u h) :=
begin
  have hi : ∀ (p : ℕ) (l m : list (fin p)),
    l.map subtype.val = m.map subtype.val → l = m :=
  begin
    intros p l m e,
    exact list.map_injective_iff.mpr
      (λ (i j : fin p) (e₀ : i.val = j.val), fin.eq_of_veq e₀) e,
  end,
  rw [to_fin_finset, to_fin_finset], congr,
  apply hi,
  rw [to_fin_list.val, to_nat_list, list.map_map],
  have : subtype.val ∘ (fin.succ_emb n) =
         nat.succ ∘ subtype.val :=
  begin
    ext ⟨i,hi⟩, unfold_coes, simp [fin.succ_emb]
  end,
  rw [this, ← list.map_map nat.succ subtype.val, to_fin_list.val]
end

lemma tt_cons :
  to_fin_finset (tt :: u) (by { rw[list.length, h] }) =
   insert (0 : fin n.succ) (shift (to_fin_finset u h)) :=
begin
  have hi : ∀ (p : ℕ) (l m : list (fin p)),
    l.map subtype.val = m.map subtype.val → l = m :=
  begin
    intros p l m e,
    exact list.map_injective_iff.mpr
      (λ (i j : fin p) (e₀ : i.val = j.val), fin.eq_of_veq e₀) e,
  end,
  rw [to_fin_finset, to_fin_finset], congr,
  have hn : (0 : fin n.succ) ∉ (to_fin_list u h).map (fin.succ_emb n) :=
  begin
    intro hm,
    rcases list.mem_map.mp hm with ⟨i,⟨_,he⟩⟩,
    exact fin.succ_ne_zero _ he,
  end,
  apply hi,
  let hh := congr_arg (list.map subtype.val) (list.insert_of_not_mem hn),
  rw [to_fin_list.val, to_nat_list],
  have : (list.insert 0 (list.map ⇑(fin.succ_emb n) (to_fin_list u h))) =
         (insert 0 (list.map ⇑(fin.succ_emb n) (to_fin_list u h))) := rfl,
  rw [this, hh, list.map, list.map_map],
  have : subtype.val ∘ (fin.succ_emb n) =
         nat.succ ∘ subtype.val :=
  begin
    ext ⟨i,hi⟩, unfold_coes, simp [fin.succ_emb]
  end,
  rw [this, ← list.map_map nat.succ subtype.val, to_fin_list.val],
  have : (0 : fin n.succ).val = 0 := rfl,
  rw [this],
end

lemma cons (b : bool) :
  to_fin_finset (b :: u) (by { rw[list.length, h] }) =
   let s := (shift (to_fin_finset u h)) in (cond b (insert 0 s) s) :=
begin
  cases b, apply ff_cons, apply tt_cons
end

end to_fin_finset

def of_fin_finset : ∀ {n : ℕ} (s : finset (fin n)), binseq
| 0 _ := []
| (n + 1) s :=
  (if (0 : (fin n.succ)) ∈ s then tt else ff) ::
          (of_fin_finset (unshift s))

namespace of_fin_finset

lemma ff_step {n : ℕ} {s : finset (fin n.succ)} (h : (0 : fin n.succ) ∉ s) :
  of_fin_finset s = ff :: (of_fin_finset (unshift s)) :=
by rw [of_fin_finset, if_neg h]

lemma tt_step {n : ℕ} {s : finset (fin n.succ)} (h : (0 : fin n.succ) ∈ s) :
  of_fin_finset s = tt :: (of_fin_finset (unshift s)) :=
by rw [of_fin_finset, if_pos h]

lemma length {n : ℕ} (s : (finset (fin n))) : (of_fin_finset s).length = n :=
begin
  induction n with n ih,
  { rw [of_fin_finset, list.length ] },
  { rw [of_fin_finset, list.length, ih] }
end

lemma rank {n : ℕ} (s : (finset (fin n))) : (of_fin_finset s).rank = s.card :=
begin
  induction n with n ih,
  { have : s = ∅ := finset.eq_empty_of_forall_not_mem (λ i, fin.elim0 i),
    rw [of_fin_finset, rank, this, finset.card_empty] },
  { rw [of_fin_finset], split_ifs; rw [rank],
    { rw [ih (unshift s)], exact (unshift_card1 h).symm },
    { rw [ih (unshift s)], exact (unshift_card0 h).symm } }
end

lemma shift {n : ℕ} (s : (finset (fin n))) :
  of_fin_finset (combinatorics.shift s) = ff :: of_fin_finset s :=
begin
  induction n with n ih,
  { have : s = ∅ := finset.eq_empty_of_forall_not_mem (λ i, fin.elim0 i),
    rw [this], refl },
  { rw [of_fin_finset],
    split_ifs,
    { exfalso, exact zero_not_mem_shift s h },
    { rw[unshift_shift] } }
end

lemma insert {n : ℕ} (s : (finset (fin n))) :
  of_fin_finset (insert (0 : fin n.succ) (combinatorics.shift s)) = tt :: of_fin_finset s :=
begin
  induction n with n ih,
  { have : s = ∅ := finset.eq_empty_of_forall_not_mem (λ i, fin.elim0 i),
    rw [this], refl },
  { rw [of_fin_finset],
    split_ifs,
    { rw[unshift_insert, unshift_shift], },
    { exfalso, exact h (finset.mem_insert_self _ _) } }
end

end of_fin_finset

lemma of_to_fin_finset {n : ℕ} (u : binseq) (h : u.length = n) :
  of_fin_finset (to_fin_finset u h) = u :=
begin
  revert u,
  induction n with n ih,
  { intro u, cases u with b u,
    { intro h, refl },
    { intro h, exfalso, exact nat.succ_ne_zero u.length h } },
  { intro u, cases u with b u,
    { intro h, exfalso, exact nat.succ_ne_zero n h.symm },
    { intro h, have hl := nat.succ_inj'.mp h,
      cases b,
      { rw [to_fin_finset.ff_cons u hl, of_fin_finset.shift, ih u hl] },
      { rw [to_fin_finset.tt_cons u hl, of_fin_finset.insert, ih u hl] } } }
end

lemma to_of_fin_finset {n : ℕ} (s : finset (fin n)) :
  to_fin_finset (of_fin_finset s) (of_fin_finset.length s) = s :=
begin
  induction n with n ih,
  { have : s = ∅ := finset.eq_empty_of_forall_not_mem (λ i, fin.elim0 i),
    rw [this], refl },
  { have he : ∀ (u₀ u₁ : binseq) (h₀ : u₀.length = n.succ) (e : u₀ = u₁),
      to_fin_finset u₀ h₀ =
      to_fin_finset u₁ ((congr_arg list.length e).symm.trans h₀) :=
    by { intros, cases e, refl },
    let t := unshift s,
    by_cases h : (0 : fin n.succ) ∈ s,
    { have : s = insert (0 : fin n.succ) (shift t) := (shift_unshift1 s h).symm,
      rw [this] at *,
      have ht := of_fin_finset.insert t,
      have hf := he (of_fin_finset (insert (0 : fin n.succ) (shift t)))
        (tt :: of_fin_finset t) _ ht,
      let hc := to_fin_finset.tt_cons (of_fin_finset t) (of_fin_finset.length t),
      rw [hf, hc, ih t] },
    { have : s = shift t := (shift_unshift0 s h).symm,
      rw [this] at *,
      have ht := of_fin_finset.shift t,
      have hf := he (of_fin_finset (shift t))
        (ff :: of_fin_finset t) _ ht,
      let hc := to_fin_finset.ff_cons (of_fin_finset t) (of_fin_finset.length t),
      rw [hf, hc, ih t] } }
end

def finset_equiv (n k : ℕ) :
 { u : binseq // u.length = n ∧ u.rank = k } ≃
 { s : finset (fin n) // s.card = k } :=
 { to_fun    := λ u, ⟨to_fin_finset u.val u.property.left,
                     (to_fin_finset.card u.val u.property.left).trans
                      u.property.right⟩,
   inv_fun   := λ s, ⟨
    of_fin_finset s.val,
    ⟨of_fin_finset.length s.val,(of_fin_finset.rank s.val).trans s.property⟩⟩,
  left_inv  := λ u, subtype.eq (of_to_fin_finset u.val u.property.left),
  right_inv := λ s, subtype.eq (to_of_fin_finset s.val) }

end binseq

end combinatorics


import data.int.gcd
import data.list.zip
open int (hiding gcd_a gcd_b gcd_eq_gcd_ab) (hiding mul_neg_eq_neg_mul_symm) euclidean_domain list

lemma zip_with_mul_map_mul_right {α : Type*} [comm_ring α] (l₁ l₂ : list α) (r : α) :
	zip_with (*) l₁ (l₂.map ((*) r)) = (zip_with (*) l₁ l₂).map ((*) r) :=
begin
	induction l₁ with x₁ tl₁ ih₁ generalizing l₂, { simp },
	induction l₂ with x₂ tl₂ ih₂, { simp },
	simp, split,
	{	rw mul_left_comm },
	exact ih₁ tl₂,
end

/- Given a list of integers x₁,...,xₙ, it produces a list of integers a₁,...,aₙ such that
x₁ * a₁ + ⋯ + xₙ * aₙ = gcd (x₁,...,xₙ). -/
def bezout_factors : list ℤ → list ℤ
| []        := []
| (x :: tl) := let g := tl.foldr gcd 0 in
  gcd_a x g :: (bezout_factors tl).map ((*) (gcd_b x g))

lemma bezout_eq_gcd : Π (l : list ℤ), (l.zip_with (*) (bezout_factors l)).sum = l.foldr gcd 0
| []        := by simp
| (x :: tl) := begin
	simp [bezout_factors, zip_with_mul_map_mul_right, sum_map_mul_left],
	show _ + _ * (map id _).sum = _,
	rw [map_id, bezout_eq_gcd tl, gcd_eq_gcd_ab, mul_comm (gcd_b _ _)],
end

#eval bezout_factors [-20, -15, -12]
#eval (zip_with (*) [-20, -15, -12] (bezout_factors [-20, -15, -12])).sum

lemma int.eq_gcd_iff (a b : ℤ) (n : ℕ) :
	a.gcd b = n ↔ ↑n ∣ a ∧ ↑n ∣ b ∧ ∀ m, m ∣ a → m ∣ b → m ∣ ↑n :=
begin
	split,
	{	rintro rfl, use [gcd_dvd_left a b, gcd_dvd_right a b],
		intros m hma hmb, apply int.dvd_gcd hma hmb },
	rintro ⟨hna, hnb, hm⟩,
	apply nat.dvd_antisymm,
	{	rw ← int.coe_nat_dvd,
		apply hm, exact gcd_dvd_left a b, exact gcd_dvd_right a b },
	rw ← int.coe_nat_dvd,
	apply int.dvd_gcd hna hnb,
end

lemma int.gcd_add_mul_self (m n k : ℤ) : m.gcd (n + k * m) = m.gcd n :=
begin
	rw int.eq_gcd_iff,
	use gcd_dvd_left m n, split,
	{	apply dvd_add, exact gcd_dvd_right m n,
		apply dvd_mul_of_dvd_right, exact gcd_dvd_left m n },
	intros a ham han,
	apply int.dvd_gcd ham,
	have hakm : a ∣ k * m := dvd_mul_of_dvd_right ham k,
	rwa ← dvd_add_left hakm,
end

lemma int.gcd_mod (a b : ℤ) : int.gcd a b = int.gcd (b % a) a :=
by rw [gcd_comm _ a, int.mod_def, sub_eq_add_neg, neg_mul_eq_mul_neg,
	mul_comm a, int.gcd_add_mul_self]

lemma int.gcd_eq_abs_gcd (a b : ℤ) : int.gcd a b = (euclidean_domain.gcd a b).nat_abs :=
gcd.induction a b (λ x, by simp) (λ a b ha ih, by rw [gcd_val, ← ih, int.gcd_mod])

def abs_bezout_factors : list ℤ → list ℤ :=
λ l, ite (0 ≤ l.foldr gcd 0) (bezout_factors l) ((bezout_factors l).map int.neg)

lemma zip_with_mul_map_neg (l₁ l₂ : list ℤ) :
	zip_with (*) l₁ (l₂.map int.neg) = (zip_with (*) l₁ l₂).map int.neg :=
begin
	induction l₁ with x₁ tl₁ ih₁ generalizing l₂, { simp },
	induction l₂ with x₂ tl₂ ih₂, { simp },
	simp, split,
	{	change _ * -_ = -_, rw [mul_neg_eq_neg_mul_symm] },
	exact ih₁ tl₂,
end

theorem abs_bezout_eq_gcd (l : list ℤ) :
	(l.zip_with (*) (abs_bezout_factors l)).sum = abs (l.foldr gcd 0) :=
begin
	simp [abs_bezout_factors],
	split_ifs,
	{	rw [bezout_eq_gcd, abs_of_nonneg h] },
	rw zip_with_mul_map_neg,
	conv in (int.neg) {change λ x : ℤ, -x},
	rw [← sum_neg, abs_of_neg (lt_of_not_ge h), bezout_eq_gcd],
end


/-
Copyright (c) 2022 Matthias Uschold. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Matthias Uschold.
-/
import topology.category.Top
import topology.algebra.monoid

/-!
# Some lemma about injective group homomorphisms

## Main Statement

- `iso_range_of_injective` : For an injective group homomorphism,
    the domain is iśomorphic to its range.

## Tags

-/

lemma iso_range_of_injective_inverse_ex
  {G H:Type*} [group G] [group H]
  (i : H →* G)
  : ∀ (x: i.range), ∃ h : H, i h = x
:= begin
  assume x,
  rw ← monoid_hom.mem_range,
  by refine set_like.coe_mem x,
end

noncomputable def iso_range_of_injective_inverse
  {G H:Type*} [group G] [group H]
  (i : H →* G)
  : i.range → H
:= (λ x, classical.some (iso_range_of_injective_inverse_ex i x))

@[simp]
lemma iso_range_of_injective_inverse_spec
  {G H:Type*} [group G] [group H]
  (i : H →* G)
  : ∀ x, i (iso_range_of_injective_inverse i x) = x
:= begin
  assume x,
  unfold iso_range_of_injective_inverse,
  exact classical.some_spec (iso_range_of_injective_inverse_ex i x),
end

@[simp]
lemma iso_range_of_injective_inverse_spec'
  {G H:Type*} [group G] [group H]
  (i : H →* G)
  : ∀ x, i.range_restrict (iso_range_of_injective_inverse i x) = x
:= begin
  assume x,
  rw ← set_like.coe_eq_coe,
  exact  iso_range_of_injective_inverse_spec i x,
end

/-- If G → H is a monoid homomorphism between groups,
    then G is isomorphic (as monoid) to the range-/
noncomputable lemma iso_range_of_injective
  {G H:Type*} [group G] [group H]
  {i : H →* G}
  (i_inj : function.injective i)
  : H ≃* i.range
:= mul_equiv.mk i.range_restrict (iso_range_of_injective_inverse i)
  (begin
    unfold function.left_inverse,
    assume x,
    apply i_inj,
    rw iso_range_of_injective_inverse_spec,
    simp,
  end)
  (begin
    unfold function.right_inverse,
    unfold function.left_inverse,
    assume x,
    simp,
  end )
  (begin
    assume x y,
    simp,
  end)

  noncomputable lemma iso_range_of_injective'
  {G H:Type*} [group G] [group H]
  {i : H →* G}
  (i_inj : function.injective i)
  : i.range ≃* H
:= (iso_range_of_injective i_inj).symm


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.basic
import Mathlib.data.multiset.nat_antidiagonal
import Mathlib.PostPort

namespace Mathlib

/-!
# The "antidiagonal" {(0,n), (1,n-1), ..., (n,0)} as a finset.
-/

namespace finset

namespace nat

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

/-- A pair (i,j) is contained in the antidiagonal of `n` if and only if `i+j=n`. -/
@[simp] theorem mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} : x ∈ antidiagonal n ↔ prod.fst x + prod.snd x = n := sorry

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

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

theorem antidiagonal_succ {n : ℕ} : antidiagonal (n + 1) =
  insert (0, n + 1)
    (map (function.embedding.prod_map (function.embedding.mk Nat.succ nat.succ_injective) (function.embedding.refl ℕ))
      (antidiagonal n)) := sorry

theorem map_swap_antidiagonal {n : ℕ} : map (function.embedding.mk prod.swap (function.right_inverse.injective prod.swap_right_inverse)) (antidiagonal n) =
  antidiagonal n := sorry


/-
Copyright (c) 2020 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import data.nat.parity
import data.zmod.basic
/-!
# Relating parity to natural numbers mod 2

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

This module provides lemmas relating `zmod 2` to `even` and `odd`.

## Tags

parity, zmod, even, odd
-/

namespace zmod

lemma eq_zero_iff_even {n : ℕ} : (n : zmod 2) = 0 ↔ even n :=
(char_p.cast_eq_zero_iff (zmod 2) 2 n).trans even_iff_two_dvd.symm

lemma eq_one_iff_odd {n : ℕ} : (n : zmod 2) = 1 ↔ odd n :=
by { rw [← @nat.cast_one (zmod 2), zmod.eq_iff_modeq_nat, nat.odd_iff, nat.modeq], norm_num }

end zmod


/-
Copyright (c) 2021 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import tactic.noncomm_ring
import field_theory.is_alg_closed.basic
import algebra.star.pointwise
/-!
# Spectrum of an element in an algebra
This file develops the basic theory of the spectrum of an element of an algebra.
This theory will serve as the foundation for spectral theory in Banach algebras.

## Main definitions

* `resolvent_set a : set R`: the resolvent set of an element `a : A` where
  `A` is an  `R`-algebra.
* `spectrum a : set R`: the spectrum of an element `a : A` where
  `A` is an  `R`-algebra.
* `resolvent : R → A`: the resolvent function is `λ r, ring.inverse (↑ₐr - a)`, and hence
  when `r ∈ resolvent R A`, it is actually the inverse of the unit `(↑ₐr - a)`.

## Main statements

* `spectrum.unit_smul_eq_smul` and `spectrum.smul_eq_smul`: units in the scalar ring commute
  (multiplication) with the spectrum, and over a field even `0` commutes with the spectrum.
* `spectrum.left_add_coset_eq`: elements of the scalar ring commute (addition) with the spectrum.
* `spectrum.unit_mem_mul_iff_mem_swap_mul` and `spectrum.preimage_units_mul_eq_swap_mul`: the
  units (of `R`) in `σ (a*b)` coincide with those in `σ (b*a)`.
* `spectrum.scalar_eq`: in a nontrivial algebra over a field, the spectrum of a scalar is
  a singleton.
* `spectrum.subset_polynomial_aeval`, `spectrum.map_polynomial_aeval_of_degree_pos`,
  `spectrum.map_polynomial_aeval_of_nonempty`: variations on the spectral mapping theorem.

## Notations

* `σ a` : `spectrum R a` of `a : A`
-/

open set

universes u v

section defs

variables (R : Type u) {A : Type v}
variables [comm_semiring R] [ring A] [algebra R A]

local notation `↑ₐ` := algebra_map R A

-- definition and basic properties

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *resolvent set* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is a unit of the
algebra `A`.  -/
def resolvent_set (a : A) : set R :=
{ r : R | is_unit (↑ₐr - a) }

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *spectrum* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is not a unit of the
algebra `A`.

The spectrum is simply the complement of the resolvent set.  -/
def spectrum (a : A) : set R :=
(resolvent_set R a)ᶜ

variable {R}
/-- Given an `a : A` where `A` is an `R`-algebra, the *resolvent* is
    a map `R → A` which sends `r : R` to `(algebra_map R A r - a)⁻¹` when
    `r ∈ resolvent R A` and `0` when `r ∈ spectrum R A`. -/
noncomputable def resolvent (a : A) (r : R) : A :=
ring.inverse (↑ₐr - a)

/-- The unit `1 - r⁻¹ • a` constructed from `r • 1 - a` when the latter is a unit. -/
@[simps]
noncomputable def is_unit.sub_inv_smul {r : Rˣ} {s : R} {a : A}
  (h : is_unit $ r • ↑ₐs  - a) : Aˣ :=
{ val := ↑ₐs - r⁻¹ • a,
  inv := r • ↑h.unit⁻¹,
  val_inv := by rw [mul_smul_comm, ←smul_mul_assoc, smul_sub, smul_inv_smul, h.mul_coe_inv],
  inv_val := by rw [smul_mul_assoc, ←mul_smul_comm, smul_sub, smul_inv_smul, h.coe_inv_mul], }

end defs

namespace spectrum
open_locale polynomial

section scalar_semiring

variables {R : Type u} {A : Type v}
variables [comm_semiring R] [ring A] [algebra R A]

local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma mem_iff {r : R} {a : A} :
  r ∈ σ a ↔ ¬ is_unit (↑ₐr - a) :=
iff.rfl

lemma not_mem_iff {r : R} {a : A} :
  r ∉ σ a ↔ is_unit (↑ₐr - a) :=
by { apply not_iff_not.mp, simp [set.not_not_mem, mem_iff] }

lemma mem_resolvent_set_of_left_right_inverse {r : R} {a b c : A}
  (h₁ : (↑ₐr - a) * b = 1) (h₂ : c * (↑ₐr - a) = 1) :
  r ∈ resolvent_set R a :=
units.is_unit ⟨↑ₐr - a, b, h₁, by rwa ←left_inv_eq_right_inv h₂ h₁⟩

lemma mem_resolvent_set_iff {r : R} {a : A} :
  r ∈ resolvent_set R a ↔ is_unit (↑ₐr - a) :=
iff.rfl

@[simp] lemma resolvent_set_of_subsingleton [subsingleton A] (a : A) :
  resolvent_set R a = set.univ :=
by simp_rw [resolvent_set, subsingleton.elim (algebra_map R A _ - a) 1, is_unit_one,
  set.set_of_true]

@[simp] lemma of_subsingleton [subsingleton A] (a : A) :
  spectrum R a = ∅ :=
by rw [spectrum, resolvent_set_of_subsingleton, set.compl_univ]

lemma resolvent_eq {a : A} {r : R} (h : r ∈ resolvent_set R a) :
  resolvent a r = ↑h.unit⁻¹ :=
ring.inverse_unit h.unit

lemma units_smul_resolvent {r : Rˣ} {s : R} {a : A} :
  r • resolvent a (s : R) = resolvent (r⁻¹ • a) (r⁻¹ • s : R) :=
begin
  by_cases h : s ∈ spectrum R a,
  { rw [mem_iff] at h,
    simp only [resolvent, algebra.algebra_map_eq_smul_one] at *,
    rw [smul_assoc, ←smul_sub],
    have h' : ¬ is_unit (r⁻¹ • (s • 1 - a)),
      from λ hu, h (by simpa only [smul_inv_smul] using is_unit.smul r hu),
    simp only [ring.inverse_non_unit _ h, ring.inverse_non_unit _ h', smul_zero] },
  { simp only [resolvent],
    have h' : is_unit (r • (algebra_map R A (r⁻¹ • s)) - a),
      { simpa [algebra.algebra_map_eq_smul_one, smul_assoc] using not_mem_iff.mp h },
    rw [←h'.coe_sub_inv_smul, ←(not_mem_iff.mp h).unit_spec, ring.inverse_unit, ring.inverse_unit,
      h'.coe_inv_sub_inv_smul],
    simp only [algebra.algebra_map_eq_smul_one, smul_assoc, smul_inv_smul], },
end

lemma units_smul_resolvent_self {r : Rˣ} {a : A} :
  r • resolvent a (r : R) = resolvent (r⁻¹ • a) (1 : R) :=
by simpa only [units.smul_def, algebra.id.smul_eq_mul, units.inv_mul]
  using @units_smul_resolvent _ _ _ _ _ r r a

/-- The resolvent is a unit when the argument is in the resolvent set. -/
lemma is_unit_resolvent {r : R} {a : A} :
  r ∈ resolvent_set R a ↔ is_unit (resolvent a r) :=
is_unit_ring_inverse.symm

lemma inv_mem_resolvent_set {r : Rˣ} {a : Aˣ} (h : (r : R) ∈ resolvent_set R (a : A)) :
  (↑r⁻¹ : R) ∈ resolvent_set R (↑a⁻¹ : A) :=
begin
  rw [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one, ←units.smul_def] at h ⊢,
  rw [is_unit.smul_sub_iff_sub_inv_smul, inv_inv, is_unit.sub_iff],
  have h₁ : (a : A) * (r • (↑a⁻¹ : A) - 1) = r • 1 - a,
  { rw [mul_sub, mul_smul_comm, a.mul_inv, mul_one], },
  have h₂ : (r • (↑a⁻¹ : A) - 1) * a = r • 1 - a,
  { rw [sub_mul, smul_mul_assoc, a.inv_mul, one_mul], },
  have hcomm : commute (a : A) (r • (↑a⁻¹ : A) - 1), { rwa ←h₂ at h₁ },
  exact (hcomm.is_unit_mul_iff.mp (h₁.symm ▸ h)).2,
end

lemma inv_mem_iff {r : Rˣ} {a : Aˣ} :
  (r : R) ∈ σ (a : A) ↔ (↑r⁻¹ : R) ∈ σ (↑a⁻¹ : A) :=
begin
  simp only [mem_iff, not_iff_not, ←mem_resolvent_set_iff],
  exact ⟨λ h, inv_mem_resolvent_set h, λ h, by simpa using inv_mem_resolvent_set h⟩,
end

lemma zero_mem_resolvent_set_of_unit (a : Aˣ) : 0 ∈ resolvent_set R (a : A) :=
by { rw [mem_resolvent_set_iff, is_unit.sub_iff], simp }

lemma ne_zero_of_mem_of_unit {a : Aˣ} {r : R} (hr : r ∈ σ (a : A)) : r ≠ 0 :=
λ hn, (hn ▸ hr) (zero_mem_resolvent_set_of_unit a)

lemma add_mem_iff {a : A} {r s : R} :
  r ∈ σ a ↔ r + s ∈ σ (↑ₐs + a) :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff],
  have h_eq : ↑ₐ(r + s) - (↑ₐs + a) = ↑ₐr - a,
    { simp, noncomm_ring },
  rw h_eq,
end

lemma smul_mem_smul_iff {a : A} {s : R} {r : Rˣ} :
  r • s ∈ σ (r • a) ↔ s ∈ σ a :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one],
  have h_eq : (r • s) • (1 : A) = r • s • 1, by simp,
  rw [h_eq, ←smul_sub, is_unit_smul_iff],
end

open_locale pointwise polynomial

theorem unit_smul_eq_smul (a : A) (r : Rˣ) :
  σ (r • a) = r • σ a :=
begin
  ext,
  have x_eq : x = r • r⁻¹ • x, by simp,
  nth_rewrite 0 x_eq,
  rw smul_mem_smul_iff,
  split,
    { exact λ h, ⟨r⁻¹ • x, ⟨h, by simp⟩⟩},
    { rintros ⟨_, _, x'_eq⟩, simpa [←x'_eq],}
end

-- `r ∈ σ(a*b) ↔ r ∈ σ(b*a)` for any `r : Rˣ`
theorem unit_mem_mul_iff_mem_swap_mul {a b : A} {r : Rˣ} :
  ↑r ∈ σ (a * b) ↔ ↑r ∈ σ (b * a) :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one],
  have coe_smul_eq : ↑r • 1 = r • (1 : A), from rfl,
  rw coe_smul_eq,
  simp only [is_unit.smul_sub_iff_sub_inv_smul],
  have right_inv_of_swap : ∀ {x y z : A} (h : (1 - x * y) * z = 1),
    (1 - y * x) * (1 + y * z * x) = 1, from λ x y z h,
      calc (1 - y * x) * (1 + y * z * x) = 1 - y * x + y * ((1 - x * y) * z) * x : by noncomm_ring
      ...                                = 1                                     : by simp [h],
  have left_inv_of_swap : ∀ {x y z : A} (h : z * (1 - x * y) = 1),
    (1 + y * z * x) * (1 - y * x) = 1, from λ x y z h,
      calc (1 + y * z * x) * (1 - y * x) = 1 - y * x + y * (z * (1 - x * y)) * x : by noncomm_ring
      ...                                = 1                                     : by simp [h],
  have is_unit_one_sub_mul_of_swap : ∀ {x y : A} (h : is_unit (1 - x * y)),
    is_unit (1 - y * x), from λ x y h, by
      { let h₁ := right_inv_of_swap h.unit.val_inv,
        let h₂ := left_inv_of_swap h.unit.inv_val,
        exact ⟨⟨1 - y * x, 1 + y * h.unit.inv * x, h₁, h₂⟩, rfl⟩, },
  have is_unit_one_sub_mul_iff_swap : ∀ {x y : A},
    is_unit (1 - x * y) ↔ is_unit (1 - y * x), by
      { intros, split, repeat {apply is_unit_one_sub_mul_of_swap}, },
  rw [←smul_mul_assoc, ←mul_smul_comm r⁻¹ b a, is_unit_one_sub_mul_iff_swap],
end

theorem preimage_units_mul_eq_swap_mul {a b : A} :
  (coe : Rˣ → R) ⁻¹' σ (a * b) = coe ⁻¹'  σ (b * a) :=
by { ext, exact unit_mem_mul_iff_mem_swap_mul, }

section star

variables [has_involutive_star R] [star_ring A] [star_module R A]

lemma star_mem_resolvent_set_iff {r : R} {a : A} :
  star r ∈ resolvent_set R a ↔ r ∈ resolvent_set R (star a) :=
by refine ⟨λ h, _, λ h, _⟩;
   simpa only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one, star_sub, star_smul,
     star_star, star_one] using is_unit.star h

protected lemma map_star (a : A) : σ (star a) = star (σ a) :=
by { ext, simpa only [set.mem_star, mem_iff, not_iff_not] using star_mem_resolvent_set_iff.symm }

end star

end scalar_semiring

section scalar_ring

variables {R : Type u} {A : Type v}
variables [comm_ring R] [ring A] [algebra R A]

local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

theorem left_add_coset_eq (a : A) (r : R) :
  left_add_coset r (σ a) = σ (↑ₐr + a) :=
by { ext, rw [mem_left_add_coset_iff, neg_add_eq_sub, add_mem_iff],
     nth_rewrite 1 ←sub_add_cancel x r, }

open polynomial

lemma exists_mem_of_not_is_unit_aeval_prod [is_domain R] {p : R[X]} {a : A} (hp : p ≠ 0)
  (h : ¬is_unit (aeval a (multiset.map (λ (x : R), X - C x) p.roots).prod)) :
  ∃ k : R, k ∈ σ a ∧ eval k p = 0 :=
begin
  rw [←multiset.prod_to_list, alg_hom.map_list_prod] at h,
  replace h := mt list.prod_is_unit h,
  simp only [not_forall, exists_prop, aeval_C, multiset.mem_to_list,
    list.mem_map, aeval_X, exists_exists_and_eq_and, multiset.mem_map, alg_hom.map_sub] at h,
  rcases h with ⟨r, r_mem, r_nu⟩,
  exact ⟨r, by rwa [mem_iff, ←is_unit.sub_iff], by rwa [←is_root.def, ←mem_roots hp]⟩
end

end scalar_ring

section scalar_field

variables {𝕜 : Type u} {A : Type v}
variables [field 𝕜] [ring A] [algebra 𝕜 A]

local notation `σ` := spectrum 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

/-- Without the assumption `nontrivial A`, then `0 : A` would be invertible. -/
@[simp] lemma zero_eq [nontrivial A] : σ (0 : A) = {0} :=
begin
  refine set.subset.antisymm _ (by simp [algebra.algebra_map_eq_smul_one, mem_iff]),
  rw [spectrum, set.compl_subset_comm],
  intros k hk,
  rw set.mem_compl_singleton_iff at hk,
  have : is_unit (units.mk0 k hk • (1 : A)) := is_unit.smul (units.mk0 k hk) is_unit_one,
  simpa [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one]
end

@[simp] theorem scalar_eq [nontrivial A] (k : 𝕜) : σ (↑ₐk) = {k} :=
begin
  have coset_eq : left_add_coset k {0} = {k}, by
    { ext, split,
      { intro hx, simp [left_add_coset] at hx, exact hx, },
      { intro hx, simp at hx, exact ⟨0, ⟨set.mem_singleton 0, by simp [hx]⟩⟩, }, },
  calc σ (↑ₐk) = σ (↑ₐk + 0)                  : by simp
    ...        = left_add_coset k (σ (0 : A)) : by rw ←left_add_coset_eq
    ...        = left_add_coset k {0}         : by rw zero_eq
    ...        = {k}                          : coset_eq,
end

@[simp] lemma one_eq [nontrivial A] : σ (1 : A) = {1} :=
calc σ (1 : A) = σ (↑ₐ1) : by simp [algebra.algebra_map_eq_smul_one]
  ...          = {1}     : scalar_eq 1

open_locale pointwise

/-- the assumption `(σ a).nonempty` is necessary and cannot be removed without
    further conditions on the algebra `A` and scalar field `𝕜`. -/
theorem smul_eq_smul [nontrivial A] (k : 𝕜) (a : A) (ha : (σ a).nonempty) :
  σ (k • a) = k • (σ a) :=
begin
  rcases eq_or_ne k 0 with rfl | h,
  { simpa [ha, zero_smul_set] },
  { exact unit_smul_eq_smul a (units.mk0 k h) },
end

theorem nonzero_mul_eq_swap_mul (a b : A) : σ (a * b) \ {0} = σ (b * a) \ {0} :=
begin
  suffices h : ∀ (x y : A), σ (x * y) \ {0} ⊆ σ (y * x) \ {0},
  { exact set.eq_of_subset_of_subset (h a b) (h b a) },
  { rintros _ _ k ⟨k_mem, k_neq⟩,
    change k with ↑(units.mk0 k k_neq) at k_mem,
    exact ⟨unit_mem_mul_iff_mem_swap_mul.mp k_mem, k_neq⟩ },
end

protected lemma map_inv (a : Aˣ) : (σ (a : A))⁻¹ = σ (↑a⁻¹ : A) :=
begin
  refine set.eq_of_subset_of_subset (λ k hk, _) (λ k hk, _),
  { rw set.mem_inv at hk,
    have : k ≠ 0,
    { simpa only [inv_inv] using inv_ne_zero (ne_zero_of_mem_of_unit hk), },
    lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr this,
    rw ←units.coe_inv k at hk,
    exact inv_mem_iff.mp hk },
  { lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr (ne_zero_of_mem_of_unit hk),
    simpa only [units.coe_inv] using inv_mem_iff.mp hk, }
end

open polynomial
/-- Half of the spectral mapping theorem for polynomials. We prove it separately
because it holds over any field, whereas `spectrum.map_polynomial_aeval_of_degree_pos` and
`spectrum.map_polynomial_aeval_of_nonempty` need the field to be algebraically closed. -/

/-- The *spectral mapping theorem* for polynomials.  Note: the assumption `degree p > 0`
is necessary in case `σ a = ∅`, for then the left-hand side is `∅` and the right-hand side,
assuming `[nontrivial A]`, is `{k}` where `p = polynomial.C k`. -/
theorem map_polynomial_aeval_of_degree_pos [is_alg_closed 𝕜] (a : A) (p : 𝕜[X])
  (hdeg : 0 < degree p) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
begin
  /- handle the easy direction via `spectrum.subset_polynomial_aeval` -/
  refine set.eq_of_subset_of_subset (λ k hk, _) (subset_polynomial_aeval a p),
  /- write `C k - p` product of linear factors and a constant; show `C k - p ≠ 0`. -/
  have hprod := eq_prod_roots_of_splits_id (is_alg_closed.splits (C k - p)),
  have h_ne : C k - p ≠ 0, from ne_zero_of_degree_gt
    (by rwa [degree_sub_eq_right_of_degree_lt (lt_of_le_of_lt degree_C_le hdeg)]),
  have lead_ne := leading_coeff_ne_zero.mpr h_ne,
  have lead_unit := (units.map (↑ₐ).to_monoid_hom (units.mk0 _ lead_ne)).is_unit,
  /- leading coefficient is a unit so product of linear factors is not a unit;
  apply `exists_mem_of_not_is_unit_aeval_prod`. -/
  have p_a_eq : aeval a (C k - p) = ↑ₐk - aeval a p,
    by simp only [aeval_C, alg_hom.map_sub, sub_left_inj],
  rw [mem_iff, ←p_a_eq, hprod, aeval_mul,
    ((commute.all _ _).map (aeval a)).is_unit_mul_iff, aeval_C] at hk,
  replace hk := exists_mem_of_not_is_unit_aeval_prod h_ne (not_and.mp hk lead_unit),
  rcases hk with ⟨r, r_mem, r_ev⟩,
  exact ⟨r, r_mem, symm (by simpa [eval_sub, eval_C, sub_eq_zero] using r_ev)⟩,
end

/-- In this version of the spectral mapping theorem, we assume the spectrum
is nonempty instead of assuming the degree of the polynomial is positive. Note: the
assumption `[nontrivial A]` is necessary for the same reason as in `spectrum.zero_eq`. -/
theorem map_polynomial_aeval_of_nonempty [is_alg_closed 𝕜] [nontrivial A] (a : A) (p : 𝕜[X])
  (hnon : (σ a).nonempty) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
begin
  refine or.elim (le_or_gt (degree p) 0) (λ h, _) (map_polynomial_aeval_of_degree_pos a p),
  { rw eq_C_of_degree_le_zero h,
    simp only [set.image_congr, eval_C, aeval_C, scalar_eq, set.nonempty.image_const hnon] },
end

variable (𝕜)
/--
Every element `a` in a nontrivial finite-dimensional algebra `A`
over an algebraically closed field `𝕜` has non-empty spectrum. -/
-- We will use this both to show eigenvalues exist, and to prove Schur's lemma.
lemma nonempty_of_is_alg_closed_of_finite_dimensional [is_alg_closed 𝕜]
  [nontrivial A] [I : finite_dimensional 𝕜 A] (a : A) :
  ∃ k : 𝕜, k ∈ σ a :=
begin
  obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := is_integral_of_noetherian (is_noetherian.iff_fg.2 I) a,
  have nu : ¬ is_unit (aeval a p), { rw [←aeval_def] at h_eval_p, rw h_eval_p, simp, },
  rw [eq_prod_roots_of_monic_of_splits_id h_mon (is_alg_closed.splits p)] at nu,
  obtain ⟨k, hk, _⟩ := exists_mem_of_not_is_unit_aeval_prod (monic.ne_zero h_mon) nu,
  exact ⟨k, hk⟩
end

end scalar_field

end spectrum

namespace alg_hom

section comm_semiring

variables {R : Type*} {A B : Type*} [comm_ring R] [ring A] [algebra R A] [ring B] [algebra R B]
local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma mem_resolvent_set_apply (φ : A →ₐ[R] B) {a : A} {r : R} (h : r ∈ resolvent_set R a) :
  r ∈ resolvent_set R (φ a) :=
by simpa only [map_sub, commutes] using h.map φ

lemma spectrum_apply_subset (φ : A →ₐ[R] B) (a : A) : σ (φ a) ⊆ σ a :=
λ _, mt (mem_resolvent_set_apply φ)

end comm_semiring

section comm_ring

variables {R : Type*} {A B : Type*} [comm_ring R] [ring A] [algebra R A] [ring B] [algebra R B]
local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma apply_mem_spectrum [nontrivial R] (φ : A →ₐ[R] R) (a : A) : φ a ∈ σ a :=
begin
  have h : ↑ₐ(φ a) - a ∈ φ.to_ring_hom.ker,
  { simp only [ring_hom.mem_ker, coe_to_ring_hom, commutes, algebra.id.map_eq_id,
               to_ring_hom_eq_coe, ring_hom.id_apply, sub_self, map_sub] },
  simp only [spectrum.mem_iff, ←mem_nonunits_iff,
             coe_subset_nonunits (φ.to_ring_hom.ker_ne_top) h],
end

end comm_ring

end alg_hom


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Johannes Hölzl

! This file was ported from Lean 3 source module dynamics.fixed_points.topology
! leanprover-community/mathlib commit d90e4e186f1d18e375dcd4e5b5f6364b01cb3e46
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Dynamics.FixedPoints.Basic
import Mathlib.Topology.Separation

/-!
# Topological properties of fixed points

Currently this file contains two lemmas:

- `isFixedPt_of_tendsto_iterate`: if `f^n(x) → y` and `f` is continuous at `y`, then `f y = y`;
- `isClosed_fixedPoints`: the set of fixed points of a continuous map is a closed set.

## TODO

fixed points, iterates
-/

variable {α : Type _} [TopologicalSpace α] [T2Space α] {f : α → α}

open Function Filter

open Topology

/-- If the iterates `f^[n] x` converge to `y` and `f` is continuous at `y`,
then `y` is a fixed point for `f`. -/
theorem isFixedPt_of_tendsto_iterate {x y : α} (hy : Tendsto (fun n => (f^[n]) x) atTop (𝓝 y))
    (hf : ContinuousAt f y) : IsFixedPt f y := by
  refine' tendsto_nhds_unique ((tendsto_add_atTop_iff_nat 1).1 _) hy
  simp only [iterate_succ' f]
  exact hf.tendsto.comp hy
#align is_fixed_pt_of_tendsto_iterate isFixedPt_of_tendsto_iterate

/-- The set of fixed points of a continuous map is a closed set. -/
theorem isClosed_fixedPoints (hf : Continuous f) : IsClosed (fixedPoints f) :=
  isClosed_eq hf continuous_id
#align is_closed_fixed_points isClosed_fixedPoints


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.degree.default
import Mathlib.data.polynomial.degree.trailing_degree
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Erase the leading term of a univariate polynomial

## Definition

* `erase_lead f`: the polynomial `f - leading term of f`

`erase_lead` serves as reduction step in an induction, shaving off one monomial from a polynomial.
The definition is set up so that it does not mention subtraction in the definition,
and thus works for polynomials over semirings as well as rings.
-/

namespace polynomial

/-- `erase_lead f` for a polynomial `f` is the polynomial obtained by
subtracting from `f` the leading term of `f`. -/
def erase_lead {R : Type u_1} [semiring R] (f : polynomial R) : polynomial R :=
  finsupp.erase (nat_degree f) f

theorem erase_lead_support {R : Type u_1} [semiring R] (f : polynomial R) :
    finsupp.support (erase_lead f) = finset.erase (finsupp.support f) (nat_degree f) :=
  sorry

-- `rfl` fails because LHS uses `nat.decidable_eq` but RHS is classical.

theorem erase_lead_coeff {R : Type u_1} [semiring R] {f : polynomial R} (i : ℕ) :
    coeff (erase_lead f) i = ite (i = nat_degree f) 0 (coeff f i) :=
  sorry

-- `rfl` fails because LHS uses `nat.decidable_eq` but RHS is classical.

@[simp] theorem erase_lead_coeff_nat_degree {R : Type u_1} [semiring R] {f : polynomial R} :
    coeff (erase_lead f) (nat_degree f) = 0 :=
  finsupp.erase_same

theorem erase_lead_coeff_of_ne {R : Type u_1} [semiring R] {f : polynomial R} (i : ℕ)
    (hi : i ≠ nat_degree f) : coeff (erase_lead f) i = coeff f i :=
  finsupp.erase_ne hi

@[simp] theorem erase_lead_zero {R : Type u_1} [semiring R] : erase_lead 0 = 0 :=
  finsupp.erase_zero (nat_degree 0)

@[simp] theorem erase_lead_add_monomial_nat_degree_leading_coeff {R : Type u_1} [semiring R]
    (f : polynomial R) : erase_lead f + coe_fn (monomial (nat_degree f)) (leading_coeff f) = f :=
  sorry

@[simp] theorem erase_lead_add_C_mul_X_pow {R : Type u_1} [semiring R] (f : polynomial R) :
    erase_lead f + coe_fn C (leading_coeff f) * X ^ nat_degree f = f :=
  sorry

@[simp] theorem self_sub_monomial_nat_degree_leading_coeff {R : Type u_1} [ring R]
    (f : polynomial R) : f - coe_fn (monomial (nat_degree f)) (leading_coeff f) = erase_lead f :=
  Eq.symm (iff.mpr eq_sub_iff_add_eq (erase_lead_add_monomial_nat_degree_leading_coeff f))

@[simp] theorem self_sub_C_mul_X_pow {R : Type u_1} [ring R] (f : polynomial R) :
    f - coe_fn C (leading_coeff f) * X ^ nat_degree f = erase_lead f :=
  sorry

theorem erase_lead_ne_zero {R : Type u_1} [semiring R] {f : polynomial R}
    (f0 : bit0 1 ≤ finset.card (finsupp.support f)) : erase_lead f ≠ 0 :=
  sorry

@[simp] theorem nat_degree_not_mem_erase_lead_support {R : Type u_1} [semiring R]
    {f : polynomial R} : ¬nat_degree f ∈ finsupp.support (erase_lead f) :=
  sorry

theorem ne_nat_degree_of_mem_erase_lead_support {R : Type u_1} [semiring R] {f : polynomial R}
    {a : ℕ} (h : a ∈ finsupp.support (erase_lead f)) : a ≠ nat_degree f :=
  sorry

theorem erase_lead_support_card_lt {R : Type u_1} [semiring R] {f : polynomial R} (h : f ≠ 0) :
    finset.card (finsupp.support (erase_lead f)) < finset.card (finsupp.support f) :=
  sorry

theorem erase_lead_card_support {R : Type u_1} [semiring R] {f : polynomial R} {c : ℕ}
    (fc : finset.card (finsupp.support f) = c) :
    finset.card (finsupp.support (erase_lead f)) = c - 1 :=
  sorry

theorem erase_lead_card_support' {R : Type u_1} [semiring R] {f : polynomial R} {c : ℕ}
    (fc : finset.card (finsupp.support f) = c + 1) :
    finset.card (finsupp.support (erase_lead f)) = c :=
  erase_lead_card_support fc

@[simp] theorem erase_lead_monomial {R : Type u_1} [semiring R] (i : ℕ) (r : R) :
    erase_lead (coe_fn (monomial i) r) = 0 :=
  sorry

@[simp] theorem erase_lead_C {R : Type u_1} [semiring R] (r : R) : erase_lead (coe_fn C r) = 0 :=
  erase_lead_monomial 0 r

@[simp] theorem erase_lead_X {R : Type u_1} [semiring R] : erase_lead X = 0 :=
  erase_lead_monomial 1 1

@[simp] theorem erase_lead_X_pow {R : Type u_1} [semiring R] (n : ℕ) : erase_lead (X ^ n) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (erase_lead (X ^ n) = 0)) (X_pow_eq_monomial n)))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (erase_lead (coe_fn (monomial n) 1) = 0)) (erase_lead_monomial n 1)))
      (Eq.refl 0))

@[simp] theorem erase_lead_C_mul_X_pow {R : Type u_1} [semiring R] (r : R) (n : ℕ) :
    erase_lead (coe_fn C r * X ^ n) = 0 :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (erase_lead (coe_fn C r * X ^ n) = 0)) (C_mul_X_pow_eq_monomial r n)))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (erase_lead (coe_fn (monomial n) r) = 0)) (erase_lead_monomial n r)))
      (Eq.refl 0))

theorem erase_lead_degree_le {R : Type u_1} [semiring R] {f : polynomial R} :
    degree (erase_lead f) ≤ degree f :=
  sorry

theorem erase_lead_nat_degree_le {R : Type u_1} [semiring R] {f : polynomial R} :
    nat_degree (erase_lead f) ≤ nat_degree f :=
  nat_degree_le_nat_degree erase_lead_degree_le

theorem erase_lead_nat_degree_lt {R : Type u_1} [semiring R] {f : polynomial R}
    (f0 : bit0 1 ≤ finset.card (finsupp.support f)) : nat_degree (erase_lead f) < nat_degree f :=
  lt_of_le_of_ne erase_lead_nat_degree_le
    (ne_nat_degree_of_mem_erase_lead_support
      (nat_degree_mem_support_of_nonzero (erase_lead_ne_zero f0)))

theorem erase_lead_nat_degree_lt_or_erase_lead_eq_zero {R : Type u_1} [semiring R]
    (f : polynomial R) : nat_degree (erase_lead f) < nat_degree f ∨ erase_lead f = 0 :=
  sorry

/-- An induction lemma for polynomials. It takes a natural number `N` as a parameter, that is
required to be at least as big as the `nat_degree` of the polynomial.  This is useful to prove
results where you want to change each term in a polynomial to something else depending on the
`nat_degree` of the polynomial itself and not on the specific `nat_degree` of each term. -/
theorem induction_with_nat_degree_le {R : Type u_1} [semiring R] {P : polynomial R → Prop} (N : ℕ)
    (P_0 : P 0) (P_C_mul_pow : ∀ (n : ℕ) (r : R), r ≠ 0 → n ≤ N → P (coe_fn C r * X ^ n))
    (P_C_add : ∀ (f g : polynomial R), nat_degree f ≤ N → nat_degree g ≤ N → P f → P g → P (f + g))
    (f : polynomial R) : nat_degree f ≤ N → P f :=
  sorry

end Mathlib


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Bhavik Mehta, Stuart Presnell

! This file was ported from Lean 3 source module data.nat.choose.basic
! leanprover-community/mathlib commit 2f3994e1b117b1e1da49bcfb67334f33460c3ce4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Factorial.Basic

/-!
# Binomial coefficients

This file defines binomial coefficients and proves simple lemmas (i.e. those not
requiring more imports).

## Main definition and results

* `Nat.choose`: binomial coefficients, defined inductively
* `Nat.choose_eq_factorial_div_factorial`: a proof that `choose n k = n! / (k! * (n - k)!)`
* `Nat.choose_symm`: symmetry of binomial coefficients
* `Nat.choose_le_succ_of_lt_half_left`: `choose n k` is increasing for small values of `k`
* `Nat.choose_le_middle`: `choose n r` is maximised when `r` is `n/2`
* `Nat.descFactorial_eq_factorial_mul_choose`: Relates binomial coefficients to the descending
  factorial. This is used to prove `Nat.choose_le_pow` and variants. We provide similar statements
  for the ascending factorial.
* `Nat.multichoose`: whereas `choose` counts combinations, `multichoose` counts multicombinations.
The fact that this is indeed the correct counting function for multisets is proved in
`Sym.card_sym_eq_multichoose` in `Data.Sym.Card`.
* `Nat.multichoose_eq` : a proof that `multichoose n k = (n + k - 1).choose k`.
This is central to the "stars and bars" technique in informal mathematics, where we switch between
counting multisets of size `k` over an alphabet of size `n` to counting strings of `k` elements
("stars") separated by `n-1` dividers ("bars").  See `Data.Sym.Card` for more detail.

## Tags

binomial coefficient, combination, multicombination, stars and bars
-/

open Nat

namespace Nat

/-- `choose n k` is the number of `k`-element subsets in an `n`-element set. Also known as binomial
coefficients. -/
def choose : ℕ → ℕ → ℕ
  | _, 0 => 1
  | 0, _ + 1 => 0
  | n + 1, k + 1 => choose n k + choose n (k + 1)
#align nat.choose Nat.choose

@[simp]
theorem choose_zero_right (n : ℕ) : choose n 0 = 1 := by cases n <;> rfl
#align nat.choose_zero_right Nat.choose_zero_right

@[simp]
theorem choose_zero_succ (k : ℕ) : choose 0 (succ k) = 0 :=
  rfl
#align nat.choose_zero_succ Nat.choose_zero_succ

theorem choose_succ_succ (n k : ℕ) : choose (succ n) (succ k) = choose n k + choose n (succ k) :=
  rfl
#align nat.choose_succ_succ Nat.choose_succ_succ

theorem choose_succ_succ' (n k : ℕ) : choose (n + 1) (k + 1) = choose n k + choose n (k + 1) :=
  rfl

theorem choose_eq_zero_of_lt : ∀ {n k}, n < k → choose n k = 0
  | _, 0, hk => absurd hk (Nat.not_lt_zero _)
  | 0, k + 1, _ => choose_zero_succ _
  | n + 1, k + 1, hk => by
    have hnk : n < k := lt_of_succ_lt_succ hk
    have hnk1 : n < k + 1 := lt_of_succ_lt hk
    rw [choose_succ_succ, choose_eq_zero_of_lt hnk, choose_eq_zero_of_lt hnk1]
#align nat.choose_eq_zero_of_lt Nat.choose_eq_zero_of_lt

@[simp]
theorem choose_self (n : ℕ) : choose n n = 1 := by
  induction n <;> simp [*, choose, choose_eq_zero_of_lt (lt_succ_self _)]
#align nat.choose_self Nat.choose_self

@[simp]
theorem choose_succ_self (n : ℕ) : choose n (succ n) = 0 :=
  choose_eq_zero_of_lt (lt_succ_self _)
#align nat.choose_succ_self Nat.choose_succ_self

@[simp]
theorem choose_one_right (n : ℕ) : choose n 1 = n := by induction n <;> simp [*, choose, add_comm]
#align nat.choose_one_right Nat.choose_one_right

-- The `n+1`-st triangle number is `n` more than the `n`-th triangle number
theorem triangle_succ (n : ℕ) : (n + 1) * (n + 1 - 1) / 2 = n * (n - 1) / 2 + n := by
  rw [← add_mul_div_left, mul_comm 2 n, ← mul_add, add_tsub_cancel_right, mul_comm]
  cases n <;> rfl; apply zero_lt_succ
#align nat.triangle_succ Nat.triangle_succ

/-- `choose n 2` is the `n`-th triangle number. -/
theorem choose_two_right (n : ℕ) : choose n 2 = n * (n - 1) / 2 := by
  induction' n with n ih
  . simp
  · rw [triangle_succ n, choose, ih]
    simp [add_comm]
#align nat.choose_two_right Nat.choose_two_right

theorem choose_eq_zero_iff {n k : ℕ} : n.choose k = 0 ↔ n < k :=
  ⟨fun h => lt_of_not_ge (mt Nat.choose_pos h.symm.not_lt), Nat.choose_eq_zero_of_lt⟩
#align nat.choose_eq_zero_iff Nat.choose_eq_zero_iff

theorem succ_mul_choose_eq : ∀ n k, succ n * choose n k = choose (succ n) (succ k) * succ k
  | 0, 0 => by decide
  | 0, k + 1 => by simp [choose]
  | n + 1, 0 => by simp [choose, mul_succ, succ_eq_add_one, add_comm]
  | n + 1, k + 1 => by
    rw [choose_succ_succ (succ n) (succ k), add_mul, ← succ_mul_choose_eq n, mul_succ, ←
      succ_mul_choose_eq n, add_right_comm, ← mul_add, ← choose_succ_succ, ← succ_mul]
#align nat.succ_mul_choose_eq Nat.succ_mul_choose_eq

theorem choose_mul_factorial_mul_factorial : ∀ {n k}, k ≤ n → choose n k * k ! * (n - k)! = n !
  | 0, _, hk => by simp [Nat.eq_zero_of_le_zero hk]
  | n + 1, 0, _ => by simp
  | n + 1, succ k, hk => by
    cases' lt_or_eq_of_le hk with hk₁ hk₁
    · have h : choose n k * k.succ ! * (n - k)! = (k + 1) * n ! := by
        rw [← choose_mul_factorial_mul_factorial (le_of_succ_le_succ hk)];
          simp [factorial_succ, mul_comm, mul_left_comm, mul_assoc]
      have h₁ : (n - k)! = (n - k) * (n - k.succ)! := by
        rw [← succ_sub_succ, succ_sub (le_of_lt_succ hk₁), factorial_succ]
      have h₂ : choose n (succ k) * k.succ ! * ((n - k) * (n - k.succ)!) = (n - k) * n ! := by
        rw [← choose_mul_factorial_mul_factorial (le_of_lt_succ hk₁)];
          simp [factorial_succ, mul_comm, mul_left_comm, mul_assoc]
      have h₃ : k * n ! ≤ n * n ! := Nat.mul_le_mul_right _ (le_of_succ_le_succ hk)
      rw [choose_succ_succ, add_mul, add_mul, succ_sub_succ, h, h₁, h₂, add_mul, tsub_mul,
        factorial_succ, ← add_tsub_assoc_of_le h₃, add_assoc, ← add_mul, add_tsub_cancel_left,
        add_comm]
    · rw [hk₁]; simp [hk₁, mul_comm, choose, tsub_self]
#align nat.choose_mul_factorial_mul_factorial Nat.choose_mul_factorial_mul_factorial

theorem choose_mul {n k s : ℕ} (hkn : k ≤ n) (hsk : s ≤ k) :
    n.choose k * k.choose s = n.choose s * (n - s).choose (k - s) :=
  have h : (n - k)! * (k - s)! * s ! ≠ 0 := by apply_rules [factorial_ne_zero, mul_ne_zero]
  mul_right_cancel₀ h <|
  calc
    n.choose k * k.choose s * ((n - k)! * (k - s)! * s !) =
        n.choose k * (k.choose s * s ! * (k - s)!) * (n - k)! :=
      by rw [mul_assoc, mul_assoc, mul_assoc, mul_assoc _ s !, mul_assoc, mul_comm (n - k)!,
        mul_comm s !]
    _ = n ! :=
      by rw [choose_mul_factorial_mul_factorial hsk, choose_mul_factorial_mul_factorial hkn]
    _ = n.choose s * s ! * ((n - s).choose (k - s) * (k - s)! * (n - s - (k - s))!) :=
      by rw [choose_mul_factorial_mul_factorial (tsub_le_tsub_right hkn _),
        choose_mul_factorial_mul_factorial (hsk.trans hkn)]
    _ = n.choose s * (n - s).choose (k - s) * ((n - k)! * (k - s)! * s !) :=
      by rw [tsub_tsub_tsub_cancel_right hsk, mul_assoc, mul_left_comm s !, mul_assoc,
        mul_comm (k - s)!, mul_comm s !, mul_right_comm, ← mul_assoc]

#align nat.choose_mul Nat.choose_mul

theorem choose_eq_factorial_div_factorial {n k : ℕ} (hk : k ≤ n) :
    choose n k = n ! / (k ! * (n - k)!) := by
  rw [← choose_mul_factorial_mul_factorial hk, mul_assoc]
  exact (mul_div_left _ (mul_pos (factorial_pos _) (factorial_pos _))).symm
#align nat.choose_eq_factorial_div_factorial Nat.choose_eq_factorial_div_factorial

theorem add_choose (i j : ℕ) : (i + j).choose j = (i + j)! / (i ! * j !) := by
  rw [choose_eq_factorial_div_factorial (Nat.le_add_left j i), add_tsub_cancel_right, mul_comm]
#align nat.add_choose Nat.add_choose

theorem add_choose_mul_factorial_mul_factorial (i j : ℕ) :
    (i + j).choose j * i ! * j ! = (i + j)! := by
  rw [← choose_mul_factorial_mul_factorial (Nat.le_add_left _ _), add_tsub_cancel_right,
    mul_right_comm]
#align nat.add_choose_mul_factorial_mul_factorial Nat.add_choose_mul_factorial_mul_factorial

theorem factorial_mul_factorial_dvd_factorial {n k : ℕ} (hk : k ≤ n) : k ! * (n - k)! ∣ n ! := by
  rw [← choose_mul_factorial_mul_factorial hk, mul_assoc]; exact dvd_mul_left _ _
#align nat.factorial_mul_factorial_dvd_factorial Nat.factorial_mul_factorial_dvd_factorial

theorem factorial_mul_factorial_dvd_factorial_add (i j : ℕ) : i ! * j ! ∣ (i + j)! := by
  suffices : i ! * (i + j - i) ! ∣ (i + j)!
  . rwa [add_tsub_cancel_left i j] at this
  exact factorial_mul_factorial_dvd_factorial (Nat.le_add_right _ _)
#align nat.factorial_mul_factorial_dvd_factorial_add Nat.factorial_mul_factorial_dvd_factorial_add

@[simp]
theorem choose_symm {n k : ℕ} (hk : k ≤ n) : choose n (n - k) = choose n k := by
  rw [choose_eq_factorial_div_factorial hk, choose_eq_factorial_div_factorial (Nat.sub_le _ _),
    tsub_tsub_cancel_of_le hk, mul_comm]
#align nat.choose_symm Nat.choose_symm

theorem choose_symm_of_eq_add {n a b : ℕ} (h : n = a + b) : Nat.choose n a = Nat.choose n b := by
  suffices : choose n (n - b) = choose n b
  . rw [h, add_tsub_cancel_right] at this; rwa [h]
  exact choose_symm (h ▸ le_add_left _ _)
#align nat.choose_symm_of_eq_add Nat.choose_symm_of_eq_add

theorem choose_symm_add {a b : ℕ} : choose (a + b) a = choose (a + b) b :=
  choose_symm_of_eq_add rfl
#align nat.choose_symm_add Nat.choose_symm_add

theorem choose_symm_half (m : ℕ) : choose (2 * m + 1) (m + 1) = choose (2 * m + 1) m := by
  apply choose_symm_of_eq_add
  rw [add_comm m 1, add_assoc 1 m m, add_comm (2 * m) 1, two_mul m]
#align nat.choose_symm_half Nat.choose_symm_half

theorem choose_succ_right_eq (n k : ℕ) : choose n (k + 1) * (k + 1) = choose n k * (n - k) := by
  have e : (n + 1) * choose n k = choose n k * (k + 1) + choose n (k + 1) * (k + 1)
  rw [← right_distrib, ← choose_succ_succ, succ_mul_choose_eq]
  rw [← tsub_eq_of_eq_add_rev e, mul_comm, ← mul_tsub, add_tsub_add_eq_tsub_right]
#align nat.choose_succ_right_eq Nat.choose_succ_right_eq

@[simp]
theorem choose_succ_self_right : ∀ n : ℕ, (n + 1).choose n = n + 1
  | 0 => rfl
  | n + 1 => by rw [choose_succ_succ, choose_succ_self_right n, choose_self]
#align nat.choose_succ_self_right Nat.choose_succ_self_right

theorem choose_mul_succ_eq (n k : ℕ) : n.choose k * (n + 1) = (n + 1).choose k * (n + 1 - k) := by
  cases k with
  | zero => simp
  | succ k =>
    obtain hk | hk := le_or_lt (k + 1) (n + 1)
    · rw [choose_succ_succ, add_mul, succ_sub_succ, ← choose_succ_right_eq, ← succ_sub_succ,
        mul_tsub, add_tsub_cancel_of_le (Nat.mul_le_mul_left _ hk)]
    · rw [choose_eq_zero_of_lt hk, choose_eq_zero_of_lt (n.lt_succ_self.trans hk), zero_mul,
        zero_mul]
#align nat.choose_mul_succ_eq Nat.choose_mul_succ_eq

theorem ascFactorial_eq_factorial_mul_choose (n k : ℕ) :
    n.ascFactorial k = k ! * (n + k).choose k := by
  rw [mul_comm]
  apply mul_right_cancel₀ (factorial_ne_zero (n + k - k))
  rw [choose_mul_factorial_mul_factorial, add_tsub_cancel_right, ← factorial_mul_ascFactorial,
    mul_comm]
  exact Nat.le_add_left k n
#align nat.asc_factorial_eq_factorial_mul_choose Nat.ascFactorial_eq_factorial_mul_choose

theorem factorial_dvd_ascFactorial (n k : ℕ) : k ! ∣ n.ascFactorial k :=
  ⟨(n + k).choose k, ascFactorial_eq_factorial_mul_choose _ _⟩
#align nat.factorial_dvd_asc_factorial Nat.factorial_dvd_ascFactorial

theorem choose_eq_asc_factorial_div_factorial (n k : ℕ) :
    (n + k).choose k = n.ascFactorial k / k ! := by
  apply mul_left_cancel₀ (factorial_ne_zero k)
  rw [← ascFactorial_eq_factorial_mul_choose]
  exact (Nat.mul_div_cancel' <| factorial_dvd_ascFactorial _ _).symm
#align nat.choose_eq_asc_factorial_div_factorial Nat.choose_eq_asc_factorial_div_factorial

theorem descFactorial_eq_factorial_mul_choose (n k : ℕ) : n.descFactorial k = k ! * n.choose k := by
  obtain h | h := Nat.lt_or_ge n k
  · rw [descFactorial_eq_zero_iff_lt.2 h, choose_eq_zero_of_lt h, mul_zero]
  rw [mul_comm]
  apply mul_right_cancel₀ (factorial_ne_zero (n - k))
  rw [choose_mul_factorial_mul_factorial h, ← factorial_mul_descFactorial h, mul_comm]
#align nat.desc_factorial_eq_factorial_mul_choose Nat.descFactorial_eq_factorial_mul_choose

theorem factorial_dvd_descFactorial (n k : ℕ) : k ! ∣ n.descFactorial k :=
  ⟨n.choose k, descFactorial_eq_factorial_mul_choose _ _⟩
#align nat.factorial_dvd_desc_factorial Nat.factorial_dvd_descFactorial

theorem choose_eq_descFactorial_div_factorial (n k : ℕ) : n.choose k = n.descFactorial k / k ! := by
  apply mul_left_cancel₀ (factorial_ne_zero k)
  rw [← descFactorial_eq_factorial_mul_choose]
  exact (Nat.mul_div_cancel' <| factorial_dvd_descFactorial _ _).symm
#align nat.choose_eq_desc_factorial_div_factorial Nat.choose_eq_descFactorial_div_factorial

/-! ### Inequalities -/

/-- Show that `Nat.choose` is increasing for small values of the right argument. -/
theorem choose_le_succ_of_lt_half_left {r n : ℕ} (h : r < n / 2) :
    choose n r ≤ choose n (r + 1) := by
  refine' le_of_mul_le_mul_right _ (lt_tsub_iff_left.mpr (lt_of_lt_of_le h (n.div_le_self 2)))
  rw [← choose_succ_right_eq]
  apply Nat.mul_le_mul_left
  rw [← Nat.lt_iff_add_one_le, lt_tsub_iff_left, ← mul_two]
  exact lt_of_lt_of_le (mul_lt_mul_of_pos_right h zero_lt_two) (n.div_mul_le_self 2)
#align nat.choose_le_succ_of_lt_half_left Nat.choose_le_succ_of_lt_half_left

/-- Show that for small values of the right argument, the middle value is largest. -/
private theorem choose_le_middle_of_le_half_left {n r : ℕ} (hr : r ≤ n / 2) :
    choose n r ≤ choose n (n / 2) :=
  decreasingInduction
    (fun _ k a =>
      (eq_or_lt_of_le a).elim (fun t => t.symm ▸ le_rfl) fun h =>
        (choose_le_succ_of_lt_half_left h).trans (k h))
    hr (fun _ => le_rfl) hr

/-- `choose n r` is maximised when `r` is `n/2`. -/
theorem choose_le_middle (r n : ℕ) : choose n r ≤ choose n (n / 2) := by
  cases' le_or_gt r n with b b
  · cases' le_or_lt r (n / 2) with a h
    · apply choose_le_middle_of_le_half_left a
    · rw [← choose_symm b]
      apply choose_le_middle_of_le_half_left
      rw [div_lt_iff_lt_mul' zero_lt_two] at h
      rw [le_div_iff_mul_le' zero_lt_two, tsub_mul, tsub_le_iff_tsub_le, mul_two,
        add_tsub_cancel_right]
      exact le_of_lt h
  · rw [choose_eq_zero_of_lt b]
    apply zero_le
#align nat.choose_le_middle Nat.choose_le_middle

/-! #### Inequalities about increasing the first argument -/

theorem choose_le_succ (a c : ℕ) : choose a c ≤ choose a.succ c := by
  cases c <;> simp [Nat.choose_succ_succ]
#align nat.choose_le_succ Nat.choose_le_succ

theorem choose_le_add (a b c : ℕ) : choose a c ≤ choose (a + b) c := by
  induction' b with b_n b_ih
  · simp
  exact le_trans b_ih (choose_le_succ (a + b_n) c)
#align nat.choose_le_add Nat.choose_le_add

theorem choose_le_choose {a b : ℕ} (c : ℕ) (h : a ≤ b) : choose a c ≤ choose b c :=
  add_tsub_cancel_of_le h ▸ choose_le_add a (b - a) c
#align nat.choose_le_choose Nat.choose_le_choose

theorem choose_mono (b : ℕ) : Monotone fun a => choose a b := fun _ _ => choose_le_choose b
#align nat.choose_mono Nat.choose_mono

/-! #### Multichoose

Whereas `choose n k` is the number of subsets of cardinality `k` from a type of cardinality `n`,
`multichoose n k` is the number of multisets of cardinality `k` from a type of cardinality `n`.

Alternatively, whereas `choose n k` counts the number of combinations,
i.e. ways to select `k` items (up to permutation) from `n` items without replacement,
`multichoose n k` counts the number of multicombinations,
i.e. ways to select `k` items (up to permutation) from `n` items with replacement.

Note that `multichoose` is *not* the multinomial coefficient, although it can be computed
in terms of multinomial coefficients. For details see https://mathworld.wolfram.com/Multichoose.html

TODO: Prove that `choose (-n) k = (-1)^k * multichoose n k`,
where `choose` is the generalized binomial coefficient.
<https://github.com/leanprover-community/mathlib/pull/15072#issuecomment-1171415738>

-/

--Porting note: `termination_by` required here where it wasn't before
/--
`multichoose n k` is the number of multisets of cardinality `k` from a type of cardinality `n`. -/
def multichoose : ℕ → ℕ → ℕ
  | _, 0 => 1
  | 0, _ + 1 => 0
  | n + 1, k + 1 =>
    multichoose n (k + 1) + multichoose (n + 1) k
  termination_by multichoose a b => (a, b)
#align nat.multichoose Nat.multichoose

@[simp]
theorem multichoose_zero_right (n : ℕ) : multichoose n 0 = 1 := by cases n <;> simp [multichoose]
#align nat.multichoose_zero_right Nat.multichoose_zero_right

@[simp]
theorem multichoose_zero_succ (k : ℕ) : multichoose 0 (k + 1) = 0 := by simp [multichoose]
#align nat.multichoose_zero_succ Nat.multichoose_zero_succ

theorem multichoose_succ_succ (n k : ℕ) :
    multichoose (n + 1) (k + 1) = multichoose n (k + 1) + multichoose (n + 1) k := by
  simp [multichoose]
#align nat.multichoose_succ_succ Nat.multichoose_succ_succ

@[simp]
theorem multichoose_one (k : ℕ) : multichoose 1 k = 1 := by
  induction' k with k IH; · simp
  simp [multichoose_succ_succ 0 k, IH]
#align nat.multichoose_one Nat.multichoose_one

@[simp]
theorem multichoose_two (k : ℕ) : multichoose 2 k = k + 1 := by
  induction' k with k IH; · simp
  rw [multichoose, IH]
  simp [add_comm, succ_eq_add_one]
#align nat.multichoose_two Nat.multichoose_two

@[simp]
theorem multichoose_one_right (n : ℕ) : multichoose n 1 = n := by
  induction' n with n IH; · simp
  simp [multichoose_succ_succ n 0, IH]
#align nat.multichoose_one_right Nat.multichoose_one_right

theorem multichoose_eq : ∀ n k : ℕ, multichoose n k = (n + k - 1).choose k
  | _, 0 => by simp
  | 0, k + 1 => by simp
  | n + 1, k + 1 => by
    have : n + (k + 1) < (n + 1) + (k + 1) := add_lt_add_right (Nat.lt_succ_self _) _
    have : (n + 1) + k < (n + 1) + (k + 1) := add_lt_add_left (Nat.lt_succ_self _) _
    erw [multichoose_succ_succ, add_comm, Nat.succ_add_sub_one, ← add_assoc, Nat.choose_succ_succ]
    simp [multichoose_eq n (k+1), multichoose_eq (n+1) k]
  termination_by multichoose_eq a b => a + b
  decreasing_by { assumption }
#align nat.multichoose_eq Nat.multichoose_eq

end Nat


/-
Copyright (c) 2021 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/
import algebra.gcd_monoid.finset
import number_theory.padics.padic_norm

/-!
# Basic results about setwise gcds on ℕ

This file proves some basic results about `finset.gcd` on `ℕ`.

## Main results
* `finset.coprime_of_div_gcd`: The elements of a set divided through by their gcd are coprime.

-/

instance : is_idempotent ℕ gcd_monoid.gcd := ⟨nat.gcd_self⟩

namespace finset

theorem coprime_of_div_gcd (s : finset ℕ) {x : ℕ} (hx : x ∈ s) (hnz : x ≠ 0) :
  s.gcd (/ (s.gcd id)) = 1 :=
begin
  rw nat.eq_one_iff_not_exists_prime_dvd,
  intros p hp hdvd,
  haveI : fact p.prime := ⟨hp⟩,
  rw dvd_gcd_iff at hdvd,
  replace hdvd : ∀ b ∈ s, s.gcd id * p ∣ b,
  { intros b hb,
    specialize hdvd b hb,
    rwa nat.dvd_div_iff at hdvd,
    apply gcd_dvd hb },
  have : s.gcd id ≠ 0 := (not_iff_not.mpr gcd_eq_zero_iff).mpr (λ h, hnz $ h x hx),
  apply @pow_succ_padic_val_nat_not_dvd p _ _ this.bot_lt,
  apply dvd_gcd,
  intros b hb,
  obtain ⟨k, rfl⟩ := hdvd b hb,
  rw [id, mul_right_comm, pow_succ', mul_dvd_mul_iff_right hp.ne_zero],
  apply dvd_mul_of_dvd_left,
  exact pow_padic_val_nat_dvd
end

end finset


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

import data.polynomial.ring_division

/-!
# "Mirror" of a univariate polynomial

In this file we define `polynomial.mirror`, a variant of `polynomial.reverse`. The difference
between `reverse` and `mirror` is that `reverse` will decrease the degree if the polynomial is
divisible by `X`. We also define `polynomial.norm2`, which is the sum of the squares of the
coefficients of a polynomial. It is also a coefficient of `p * p.mirror`.

## Main definitions

- `polynomial.mirror`
- `polynomial.norm2`

## Main results

- `polynomial.mirror_mul_of_domain`: `mirror` preserves multiplication.
- `polynomial.irreducible_of_mirror`: an irreducibility criterion involving `mirror`
- `polynomial.norm2_eq_mul_reverse_coeff`: `norm2` is a coefficient of `p * p.mirror`

-/

namespace polynomial

variables {R : Type*} [semiring R] (p : polynomial R)

section mirror

/-- mirror of a polynomial: reverses the coefficients while preserving `polynomial.nat_degree` -/
noncomputable def mirror := p.reverse * X ^ p.nat_trailing_degree

@[simp] lemma mirror_zero : (0 : polynomial R).mirror = 0 := by simp [mirror]

lemma mirror_monomial (n : ℕ) (a : R) : (monomial n a).mirror = (monomial n a) :=
begin
  classical,
  by_cases ha : a = 0,
  { rw [ha, monomial_zero_right, mirror_zero] },
  { rw [mirror, reverse, nat_degree_monomial n a, if_neg ha, nat_trailing_degree_monomial ha,
        ←C_mul_X_pow_eq_monomial, reflect_C_mul_X_pow, rev_at_le (le_refl n),
        tsub_self, pow_zero, mul_one] },
end

lemma mirror_C (a : R) : (C a).mirror = C a :=
mirror_monomial 0 a

lemma mirror_X : X.mirror = (X : polynomial R) :=
mirror_monomial 1 (1 : R)

lemma mirror_nat_degree : p.mirror.nat_degree = p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  by_cases hR : nontrivial R,
  { haveI := hR,
    rw [mirror, nat_degree_mul', reverse_nat_degree, nat_degree_X_pow,
        tsub_add_cancel_of_le p.nat_trailing_degree_le_nat_degree],
    rwa [leading_coeff_X_pow, mul_one, reverse_leading_coeff, ne, trailing_coeff_eq_zero] },
  { haveI := not_nontrivial_iff_subsingleton.mp hR,
    exact congr_arg nat_degree (subsingleton.elim p.mirror p) },
end

lemma mirror_nat_trailing_degree : p.mirror.nat_trailing_degree = p.nat_trailing_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  { rw [mirror, nat_trailing_degree_mul_X_pow ((mt reverse_eq_zero.mp) hp),
        reverse_nat_trailing_degree, zero_add] },
end

lemma coeff_mirror (n : ℕ) :
  p.mirror.coeff n = p.coeff (rev_at (p.nat_degree + p.nat_trailing_degree) n) :=
begin
  by_cases h2 : p.nat_degree < n,
  { rw [coeff_eq_zero_of_nat_degree_lt (by rwa mirror_nat_degree)],
    by_cases h1 : n ≤ p.nat_degree + p.nat_trailing_degree,
    { rw [rev_at_le h1, coeff_eq_zero_of_lt_nat_trailing_degree],
      exact (tsub_lt_iff_left h1).mpr (nat.add_lt_add_right h2 _) },
    { rw [←rev_at_fun_eq, rev_at_fun, if_neg h1, coeff_eq_zero_of_nat_degree_lt h2] } },
  rw not_lt at h2,
  rw [rev_at_le (h2.trans (nat.le_add_right _ _))],
  by_cases h3 : p.nat_trailing_degree ≤ n,
  { rw [←tsub_add_eq_add_tsub h2, ←tsub_tsub_assoc h2 h3, mirror, coeff_mul_X_pow',
        if_pos h3, coeff_reverse, rev_at_le (tsub_le_self.trans h2)] },
  rw not_le at h3,
  rw coeff_eq_zero_of_nat_degree_lt (lt_tsub_iff_right.mpr (nat.add_lt_add_left h3 _)),
  exact coeff_eq_zero_of_lt_nat_trailing_degree (by rwa mirror_nat_trailing_degree),
end

--TODO: Extract `finset.sum_range_rev_at` lemma.

lemma mirror_mirror : p.mirror.mirror = p :=
polynomial.ext (λ n, by rw [coeff_mirror, coeff_mirror,
  mirror_nat_degree, mirror_nat_trailing_degree, rev_at_invol])

lemma mirror_eq_zero : p.mirror = 0 ↔ p = 0 :=
⟨λ h, by rw [←p.mirror_mirror, h, mirror_zero], λ h, by rw [h, mirror_zero]⟩

lemma mirror_trailing_coeff : p.mirror.trailing_coeff = p.leading_coeff :=
by rw [leading_coeff, trailing_coeff, mirror_nat_trailing_degree, coeff_mirror,
  rev_at_le (nat.le_add_left _ _), add_tsub_cancel_right]

lemma mirror_leading_coeff : p.mirror.leading_coeff = p.trailing_coeff :=
by rw [←p.mirror_mirror, mirror_trailing_coeff, p.mirror_mirror]

lemma mirror_mul_of_domain {R : Type*} [ring R] [is_domain R] (p q : polynomial R) :
  (p * q).mirror = p.mirror * q.mirror :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, mirror_zero, zero_mul] },
  by_cases hq : q = 0,
  { rw [hq, mul_zero, mirror_zero, mul_zero] },
  rw [mirror, mirror, mirror, reverse_mul_of_domain, nat_trailing_degree_mul hp hq, pow_add],
  rw [mul_assoc, ←mul_assoc q.reverse],
  conv_lhs { congr, skip, congr, rw [←X_pow_mul] },
  repeat { rw [mul_assoc], },
end

lemma mirror_smul {R : Type*} [ring R] [is_domain R] (p : polynomial R) (a : R) :
  (a • p).mirror = a • p.mirror :=
by rw [←C_mul', ←C_mul', mirror_mul_of_domain, mirror_C]

lemma mirror_neg {R : Type*} [ring R] (p : polynomial R) : (-p).mirror = -(p.mirror) :=
by rw [mirror, mirror, reverse_neg, nat_trailing_degree_neg, neg_mul_eq_neg_mul]

lemma irreducible_of_mirror {R : Type*} [comm_ring R] [is_domain R] {f : polynomial R}
  (h1 : ¬ is_unit f)
  (h2 : ∀ k, f * f.mirror = k * k.mirror → k = f ∨ k = -f ∨ k = f.mirror ∨ k = -f.mirror)
  (h3 : ∀ g, g ∣ f → g ∣ f.mirror → is_unit g) : irreducible f :=
begin
  split,
  { exact h1 },
  { intros g h fgh,
    let k := g * h.mirror,
    have key : f * f.mirror = k * k.mirror,
    { rw [fgh, mirror_mul_of_domain, mirror_mul_of_domain, mirror_mirror,
          mul_assoc, mul_comm h, mul_comm g.mirror, mul_assoc, ←mul_assoc] },
    have g_dvd_f : g ∣ f,
    { rw fgh,
      exact dvd_mul_right g h },
    have h_dvd_f : h ∣ f,
    { rw fgh,
      exact dvd_mul_left h g },
    have g_dvd_k : g ∣ k,
    { exact dvd_mul_right g h.mirror },
    have h_dvd_k_rev : h ∣ k.mirror,
    { rw [mirror_mul_of_domain, mirror_mirror],
      exact dvd_mul_left h g.mirror },
    have hk := h2 k key,
    rcases hk with hk | hk | hk | hk,
    { exact or.inr (h3 h h_dvd_f (by rwa ← hk)) },
    { exact or.inr (h3 h h_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, mirror_neg, dvd_neg])) },
    { exact or.inl (h3 g g_dvd_f (by rwa ← hk)) },
    { exact or.inl (h3 g g_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, dvd_neg])) } },
end

end mirror

end polynomial


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.finite.defs

/-!
# Countable types

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

In this file we define a typeclass saying that a given `Sort*` is countable. See also `encodable`
for a version that singles out a specific encoding of elements of `α` by natural numbers.

This file also provides a few instances of this typeclass. More instances can be found in other
files.
-/

open function
universes u v
variables {α : Sort u} {β : Sort v}

/-!
### Definition and basic properties
-/

/-- A type `α` is countable if there exists an injective map `α → ℕ`. -/
@[mk_iff countable_iff_exists_injective] class countable (α : Sort u) : Prop :=
(exists_injective_nat [] : ∃ f : α → ℕ, injective f)

instance : countable ℕ := ⟨⟨id, injective_id⟩⟩

export countable (exists_injective_nat)

protected lemma function.injective.countable [countable β] {f : α → β} (hf : injective f) :
  countable α :=
let ⟨g, hg⟩ := exists_injective_nat β in ⟨⟨g ∘ f, hg.comp hf⟩⟩

protected lemma function.surjective.countable [countable α] {f : α → β} (hf : surjective f) :
  countable β :=
(injective_surj_inv hf).countable

lemma exists_surjective_nat (α : Sort u) [nonempty α] [countable α] : ∃ f : ℕ → α, surjective f :=
let ⟨f, hf⟩ := exists_injective_nat α in ⟨inv_fun f, inv_fun_surjective hf⟩

lemma countable_iff_exists_surjective [nonempty α] : countable α ↔ ∃ f : ℕ → α, surjective f :=
⟨@exists_surjective_nat _ _, λ ⟨f, hf⟩, hf.countable⟩

lemma countable.of_equiv (α : Sort*) [countable α] (e : α ≃ β) : countable β :=
e.symm.injective.countable

lemma equiv.countable_iff (e : α ≃ β) : countable α ↔ countable β :=
⟨λ h, @countable.of_equiv _ _ h e, λ h, @countable.of_equiv _ _ h e.symm⟩

instance {β : Type v} [countable β] : countable (ulift.{u} β) :=
countable.of_equiv _ equiv.ulift.symm

/-!
### Operations on `Sort*`s
-/

instance [countable α] : countable (plift α) := equiv.plift.injective.countable

@[priority 100]
instance subsingleton.to_countable [subsingleton α] : countable α :=
⟨⟨λ _, 0, λ x y h, subsingleton.elim x y⟩⟩

@[priority 500]
instance [countable α] {p : α → Prop} : countable {x // p x} := subtype.val_injective.countable

instance {n : ℕ} : countable (fin n) :=
function.injective.countable (@fin.eq_of_veq n)

@[priority 100]
instance finite.to_countable [finite α] : countable α :=
let ⟨n, ⟨e⟩⟩ := finite.exists_equiv_fin α in countable.of_equiv _ e.symm

instance : countable punit.{u} := subsingleton.to_countable

-- Since this always succeeds, there is no reason not to have this at normal priority.
-- Perhaps the `instance_priority` linter could be clever enough to notice this itself.
@[nolint instance_priority]
instance Prop.countable (p : Prop) : countable p := subsingleton.to_countable

instance bool.countable : countable bool :=
⟨⟨λ b, cond b 0 1, bool.injective_iff.2 nat.one_ne_zero⟩⟩

instance Prop.countable' : countable Prop := countable.of_equiv bool equiv.Prop_equiv_bool.symm

@[priority 500] instance [countable α] {r : α → α → Prop} : countable (quot r) :=
(surjective_quot_mk r).countable

@[priority 500] instance [countable α] {s : setoid α} : countable (quotient s) := quot.countable


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

import tactic
import analysis.normed_space.lp_space -- theory of ℓᵖ spaces

/-

# ℓᵖ spaces

The set-up : `I` is an index type, `E` is a family of `normed_add_comm_group`s
(so if `i : I` then `E i` is a type and if `v : E i` then `‖v‖` makes sense and
is a real number).

Then given `p : ℝ≥0∞` (i.e. an element `p` of `[0,∞]`) there is a theory
of ℓᵖ spaces, which is the subspace of `Π i, E i` (the product) consisting of the
sections `vᵢ` such that `∑ᵢ ‖vᵢ‖ᵖ < ∞`. For `p=∞` this means "the ‖vᵢ‖ are
bounded".

-/

open_locale ennreal -- to get notation ℝ≥0∞

variables (I : Type) (E : I → Type) [∀ i, normed_add_comm_group (E i)] (p : ℝ≥0∞)

-- Here's how to say that an element of the product of the Eᵢ is in the ℓᵖ space

example (v : Π i, E i) : Prop := mem_ℓp v p

-- Technical note: 0^0=1 and x^0=0 for x>0, so ℓ⁰ is the functions with finite support.

variable (v : Π i, E i)

example : mem_ℓp v 0 ↔ set.finite {i | v i ≠ 0} :=
begin
  exact mem_ℓp_zero_iff,
end

example : mem_ℓp v ∞ ↔ bdd_above (set.range (λ i, ‖v i‖)) :=
begin
  exact mem_ℓp_infty_iff,
end

-- The function ennreal.to_real sends x<∞ to x and ∞ to 0.
-- So `0 < p.to_real` is a way of saying `0 < p < ∞`.

example (hp : 0 < p.to_real) :
  mem_ℓp v p ↔ summable (λ i, ‖v i‖ ^ p.to_real) :=
begin
  exact mem_ℓp_gen_iff hp
end

-- It's a theorem in the library that if p ≤ q then mem_ℓp v p → mem_ℓp v q

example (q : ℝ≥0∞) (hpq : p ≤ q) : mem_ℓp v p → mem_ℓp v q :=
begin
  intro h,
  exact h.of_exponent_ge hpq,
end

-- The space of all `v` satisfying `mem_ℓp v p` is
-- called lp E p

example : Type := lp E p

-- It has a norm:

noncomputable example (v : lp E p) : ℝ := ‖v‖

-- It's a `normed_add_comm_group` if `1 ≤ p` but I've not stated this correctly.

noncomputable example (h : 1 ≤ p) : normed_add_comm_group (lp E p) :=
begin
  sorry,
end

-- `real.is_conjugate_exponent p q` means that `p,q>1` are reals and `1/p+1/q=1`

example (p q : ℝ) (hp : 1 < p) (hq : 1 < q) (hpq : 1 / p + 1 / q = 1) :
  p.is_conjugate_exponent q :=
sorry -- it's a structure

-- We have a verison of Hoelder's inequality.

example (q : ℝ≥0∞) (hpq : p.to_real.is_conjugate_exponent q.to_real) (f : lp E p)
  (g : lp E q) : ∑' (i : I), ‖f i‖ * ‖g i‖ ≤ ‖f‖ * ‖g‖ :=
begin
  have := lp.tsum_mul_le_mul_norm hpq f g,
  exact this.2,
end

-- This would be a useless theorem if `∑' (i : I), ‖f i‖ * ‖g i‖` diverged,
-- because in Lean if a sum diverges then by definition the `∑'` of it is 0.
-- So we also need this:

example (q : ℝ≥0∞) (hpq : p.to_real.is_conjugate_exponent q.to_real) (f : lp E p)
  (g : lp E q) : summable (λ i, ‖f i‖ * ‖g i‖) :=
begin
  have := lp.tsum_mul_le_mul_norm hpq f g,
  exact this.1,
end