-- BMO2 2020 problem 4.

-- Choices made for formalization: we index the sequence starting at 0
-- rather than at 1 as in the original problem.

import analysis.normed.field.basic
import data.polynomial
import data.real.cardinality
import data.real.sqrt
import tactic.basic
import tactic.linarith
import tactic.ring_exp
import topology.instances.real

noncomputable theory
open_locale classical

open real

-- Next term in sequence.
def p4_seq_next (x y : ℝ) : ℝ := (y * y - 1) / x

-- Condition that sequence satisfies recurrence.
def p4_recurrence (b : ℕ → ℝ) : Prop :=
∀ n : ℕ, b (n + 2) = p4_seq_next (b n) (b (n + 1))

-- Condition that terms are nonzero.
def p4_nonzero (b : ℕ → ℝ) : Prop := ∀ n : ℕ, b n ≠ 0

-- Function we will show is an invariant (the same for all pairs of
-- consecutive terms).
def p4_invar (x y : ℝ) : ℝ := ((y - x) * (y - x) - 1) / (x * y)

-- Induction step to show this is an invariant.
theorem invar_step (x y : ℝ) (hx : x ≠ 0) (hy : y ≠ 0) (hz : p4_seq_next x y ≠ 0) :
  p4_invar y (p4_seq_next x y) = p4_invar x y :=
begin
  unfold p4_invar p4_seq_next,
  unfold p4_seq_next at hz,
  have hzz : (y * y - 1) / x * x ≠ 0 := mul_ne_zero hz hx,
  rw [div_mul_cancel _ hx] at hzz,
  field_simp,
  ring,
end

-- This is an invariant.
theorem p4_is_invar (b : ℕ → ℝ) (hrec : p4_recurrence b) (hnz : p4_nonzero b) :
  ∀ n : ℕ, p4_invar (b n) (b (n + 1)) = p4_invar (b 0) (b 1) :=
begin
  intro n,
  induction n with k hk,
  { refl },
  { rw [← hk, nat.succ_eq_add_one, add_assoc, (show 1 + 1 = 2, by norm_num),
        hrec k],
    have hz : p4_seq_next (b k) (b (k + 1)) ≠ 0,
    { rw ← hrec k, exact hnz (k + 2) },
    exact invar_step (b k) (b (k + 1)) (hnz k) (hnz (k + 1)) hz, },
end

-- The invariant is negative.
theorem invar_lt_zero (k : ℝ) (h1 : 1 < k) (h2 : k < 2) : p4_invar 1 k < 0 :=
begin
  unfold p4_invar,
  rw [one_mul, (show (k - 1) * (k - 1) - 1 = (k - 2) * k, by ring),
      mul_div_cancel _ (show k ≠ 0, by linarith)],
  linarith,
end

-- The invariant is greater than -1.  (Actually -4 is all that's needed.)
theorem invar_gt_m1 (k : ℝ) (h1 : 1 < k) (h2 : k < 2) : -1 < p4_invar 1 k :=
begin
  unfold p4_invar,
  rw [one_mul, (show (k - 1) * (k - 1) - 1 = (k - 2) * k, by ring),
      mul_div_cancel _ (show k ≠ 0, by linarith)],
  linarith,
end

-- Rearranged expression using invariant, in form more suited to
-- inequalities.
theorem invar_rearranged (x y : ℝ) (hx : x ≠ 0) (hy : y ≠ 0) :
  (1 + (p4_invar x y) / 4) * ((x - y) * (x - y)) +
   (-((p4_invar x y) / 4)) * ((x + y) * (x + y)) = 1 :=
begin
  unfold p4_invar,
  field_simp,
  ring,
end

-- Bounds on two variables, given such a sum of squares.
theorem square_bounds_1 (a b x y : ℝ) (ha : 0 < a) (hb : 0 < b)
  (hs : a * (x * x) + b * (y * y) = 1) : abs x ≤ sqrt (1 / a) :=
begin
  apply le_sqrt_of_sq_le,
  rw [(show abs x ^ 2 = abs x * abs x, by ring), abs_mul_abs_self],
  have hb2 : 0 ≤ b * (y * y) := mul_nonneg (le_of_lt hb) (mul_self_nonneg y),
  have hs2 : a * (x * x) ≤ 1, { linarith },
  rw mul_comm at hs2,
  rw le_div_iff ha,
  exact hs2,
end

theorem square_bounds_2 (a b x y : ℝ) (ha : 0 < a) (hb : 0 < b)
  (hs : a * (x * x) + b * (y * y) = 1) : abs y ≤ sqrt (1 / b) :=
begin
  rw add_comm at hs,
  exact square_bounds_1 b a y x hb ha hs,
end

-- Bounds on x, given the invariant.
theorem bounds_using_invar_1 (x y : ℝ) (hx : x ≠ 0) (hy : y ≠ 0)
  (ha : 0 < (1 + (p4_invar x y) / 4)) (hb : 0 < (-((p4_invar x y) / 4))) :
  abs x ≤ (sqrt (1 / (1 + (p4_invar x y) / 4)) + sqrt (1 / (-((p4_invar x y) / 4)))) / 2 :=
begin
  have hi : (1 + (p4_invar x y) / 4) * ((x - y) * (x - y)) +
             (-((p4_invar x y) / 4)) * ((x + y) * (x + y)) = 1 := invar_rearranged x y hx hy,
  have haxmy : abs (x - y) ≤ sqrt (1 / (1 + (p4_invar x y) / 4)) :=
    square_bounds_1 _ _ _ _ ha hb hi,
  have haxpy : abs (x + y) ≤ sqrt (1 / (-((p4_invar x y) / 4))) :=
    square_bounds_2 _ _ _ _ ha hb hi,
  have hxmy : (x - y) ≤ sqrt (1 / (1 + (p4_invar x y) / 4)) := le_trans (le_abs_self _) haxmy,
  have hxpy : (x + y) ≤ sqrt (1 / (-((p4_invar x y) / 4))) := le_trans (le_abs_self _) haxpy,
  rw abs_le,
  refine ⟨_, by linarith⟩,
  rw ← abs_neg at haxmy,
  have hmxmy : -(x - y) ≤ sqrt (1 / (1 + (p4_invar x y) / 4)) := le_trans (le_abs_self _) haxmy,
  rw ← abs_neg at haxpy,
  have hmxpy : -(x + y) ≤ sqrt (1 / (-((p4_invar x y) / 4))) := le_trans (le_abs_self _) haxpy,
  linarith,
end

-- The first part of the problem.
theorem p4_part_1 (b : ℕ → ℝ) (hrec : p4_recurrence b) (hnz : p4_nonzero b)
    (k : ℝ) (h1 : 1 < k) (h2 : k < 2) (hb0 : b 0 = 1) (hb1 : b 1 = k) :
  ∃ B : ℝ, ∀ n : ℕ, -B ≤ b n ∧ b n ≤ B :=
begin
  have habs : ∃ B : ℝ, ∀ n : ℕ, abs (b n) ≤ B,
    { use (sqrt (1 / (1 + (p4_invar 1 k) / 4)) + sqrt (1 / (-((p4_invar 1 k) / 4)))) / 2,
      intro n,
      have hinvar : p4_invar (b n) (b (n + 1)) = p4_invar (b 0) (b 1) := p4_is_invar b hrec hnz n,
      rw [hb0, hb1] at hinvar,
      rw ←hinvar,
      have ha : 0 < (1 + (p4_invar (b n) (b (n + 1))) / 4),
      { rw hinvar,
        have hgt : -1 < p4_invar 1 k := invar_gt_m1 k h1 h2,
        linarith, },
      have hb : 0 < (-((p4_invar (b n) (b (n + 1)) / 4))),
      { rw hinvar,
        have hlt : p4_invar 1 k < 0 := invar_lt_zero k h1 h2,
        linarith, },
      exact bounds_using_invar_1 (b n) (b (n + 1)) (hnz n) (hnz (n + 1)) ha hb, },
  cases habs with B hB,
  use B,
  intro n,
  have hBb : abs (b n) ≤ B := hB n,
  split,
  { rw ← abs_neg at hBb,
    have hBb2 : -b n ≤ B := le_trans (le_abs_self _) hBb,
    linarith, },
  { exact le_trans (le_abs_self _) hBb },
end

-- Terms of the sequence, as functions of k.
noncomputable def p4_term : ℕ → ℝ → ℝ
| 0 := λ k, 1
| 1 := λ k, k
| (nat.succ (nat.succ n)) := λ k, p4_seq_next (p4_term n k) (p4_term (nat.succ n) k)

-- These functions do give the terms.
theorem p4_terms (b : ℕ → ℝ) (hrec : p4_recurrence b) (k : ℝ)
    (hb0 : b 0 = 1) (hb1 : b 1 = k) : ∀ n : ℕ, b n = p4_term n k :=
begin
  intro n,
  induction n using nat.case_strong_induction_on with m hm,
  { exact hb0 },
  { cases m,
    { exact hb1 },
    { unfold p4_term,
      rw [nat.succ_eq_add_one, nat.succ_eq_add_one, add_assoc,
          (show 1 + 1 = 2, by norm_num), hrec m, hm m (nat.le_succ _),
          hm (m + 1) (show m + 1 ≤ nat.succ m, by rw nat.succ_eq_add_one)] } }
end

-- These functions have the expected value for k = 2.
theorem p4_terms_at_2 : ∀ n : ℕ, p4_term n (2 : ℝ) = n + 1 :=
begin
  intro n,
  induction n using nat.case_strong_induction_on with m hm,
  { unfold p4_term,
    norm_num },
  { cases m,
    { unfold p4_term,
      norm_num },
    { unfold p4_term,
      rw [nat.succ_eq_add_one, nat.succ_eq_add_one, hm m (nat.le_succ _),
          hm (m + 1) (show m + 1 ≤ nat.succ m, by rw nat.succ_eq_add_one),
          p4_seq_next],
      push_cast,
      have hm1 : (↑m : ℝ) + 1 ≠ 0,
      { norm_cast,
        exact dec_trivial },
      field_simp,
      ring } }
end

-- These functions are continuous at k = 2.
theorem p4_terms_continuous : ∀ n : ℕ, continuous_at (p4_term n) (2 : ℝ) :=
begin
  intro n,
  induction n using nat.case_strong_induction_on with m hm,
  { unfold p4_term,
    exact continuous_at_const },
  { cases m,
    { unfold p4_term,
      exact continuous_at_id },
    { unfold p4_term,
      unfold p4_seq_next,
      apply continuous_at.div,
      { simp_rw sub_eq_add_neg,
        apply continuous_at.add,
        { apply continuous_at.mul,
          { exact hm (nat.succ m) (by refl), },
          { exact hm (nat.succ m) (by refl), } },
        { exact continuous_at_const } },
      { exact hm m (nat.le_succ m) },
      { rw p4_terms_at_2 m,
        norm_cast,
        exact dec_trivial } } }
end

-- These functions have values close to n + 1 near k = 2.
theorem p4_terms_close :
  ∀ n : ℕ, ∀ ε > 0, ∃ δ > 0, ∀ x : ℝ, abs (x - 2) < δ → abs (p4_term n x - p4_term n 2) < ε :=
begin
  intro n,
  have h : continuous_at (p4_term n) (2 : ℝ) := p4_terms_continuous n,
  unfold continuous_at at h,
  rw metric.tendsto_nhds_nhds at h,
  exact h,
end

-- The second part of the problem, in terms of p4_term rather than the
-- original recurrence, finding an interval of values and with an
-- explicit term number.

theorem p4_part_2_terms_interval :
  ∃ (kb : ℝ) (h1 : 1 ≤ kb) (h2 : kb < 2), ∀ k : ℝ, kb < k → k < 2 → 2020 < (p4_term 2020) k :=
begin
  have h : ∃ δ > 0, ∀ x : ℝ, abs (x - 2) < δ → abs (p4_term 2020 x - p4_term 2020 2) < 1 :=
    p4_terms_close 2020 1 (by norm_num),
  rcases h with ⟨d, ⟨hd, hh⟩⟩,
  have he : ∃ (e : ℝ) (heg0 : e > 0) (hel1 : e ≤ 1), ∀ x : ℝ,
    abs (x - 2) < e → abs (p4_term 2020 x - p4_term 2020 2) < 1,
  { by_cases hdlt : d ≤ 1,
    { use [d, hd, hdlt],
      exact hh },
    { use [1, (show (1 : ℝ) > 0, by norm_num), (show (1 : ℝ) ≤ 1, by norm_num)],
      intros x h12,
      apply hh x,
      linarith } },
  rcases he with ⟨e, ⟨heg0, ⟨hel1, he⟩⟩⟩,
  use [2 - e, (by linarith), (by linarith)],
  intros k hklb hkub,
  have hkx : abs (p4_term 2020 k - p4_term 2020 2) < 1,
  { apply he k,
    rw [← abs_neg _, neg_sub, abs_of_pos (show 2 - k > 0, by linarith)],
    linarith },
  rw p4_terms_at_2 2020 at hkx,
  norm_cast at hkx,
  rw (show 2020 + 1 = 2021, by norm_num) at hkx,
  rw ←abs_neg at hkx,
  have hc : -(p4_term 2020 k - ↑2021) ≤ abs (-(p4_term 2020 k - ↑2021)) := le_abs_self _,
  have hcc : -(p4_term 2020 k - ↑2021) < 1, { linarith },
  rw neg_sub at hcc,
  norm_cast at hcc,
  linarith,
end

-- Having found an interval, we now need to show it contains a real
-- such that all the terms are nonzero.  A natural informal proof is:
-- each b_n is a rational function of k, except for at finitely many
-- points where a previous term was zero, and none of those functions
-- is the constant 0 (because of the values at 2), so each b_n has
-- only finitely many k for which it is zero, so there are only
-- countably many such k in total, but there are uncountably many k in
-- the interval.  As mathlib does not have the concept of rational
-- function, we define a pair of numerator and denominator
-- polynomials.  (In fact the terms are polynomials in k, but that is
-- not needed for this proof.)

-- Terms of the sequence, as numerators and denominators of polynomials in k.
noncomputable def p4_term_poly : ℕ → ((polynomial ℝ) × (polynomial ℝ))
| 0 := ⟨polynomial.C 1, polynomial.C 1⟩
| 1 := ⟨polynomial.X, polynomial.C 1⟩
| (nat.succ (nat.succ n)) :=
  ⟨((p4_term_poly (nat.succ n)).fst * (p4_term_poly (nat.succ n)).fst -
    (p4_term_poly (nat.succ n)).snd * (p4_term_poly (nat.succ n)).snd) *
   (p4_term_poly n).snd,
   (p4_term_poly (nat.succ n)).snd * (p4_term_poly (nat.succ n)).snd * (p4_term_poly n).fst⟩

theorem p4_term_poly_num (n : ℕ) : (p4_term_poly (nat.succ (nat.succ n))).fst =
    ((p4_term_poly (nat.succ n)).fst * (p4_term_poly (nat.succ n)).fst -
      (p4_term_poly (nat.succ n)).snd * (p4_term_poly (nat.succ n)).snd) *
        (p4_term_poly n).snd :=
begin
  unfold p4_term_poly
end

theorem p4_term_poly_den (n : ℕ) : (p4_term_poly (nat.succ (nat.succ n))).snd =
  (p4_term_poly (nat.succ n)).snd * (p4_term_poly (nat.succ n)).snd * (p4_term_poly n).fst :=
begin
  unfold p4_term_poly
end

-- Terms are given by those rational functions, if no prior term was
-- zero.
theorem p4_terms_poly (k : ℝ) : ∀ n : ℕ, (∀ m : ℕ, m < n → p4_term m k ≠ 0) →
    p4_term n k = polynomial.eval k (p4_term_poly n).fst /
        polynomial.eval k (p4_term_poly n).snd :=
begin
  intro n,
  induction n using nat.case_strong_induction_on with t ht,
  { intro hm,
    unfold p4_term p4_term_poly,
    simp },
  { intro hm,
    cases t,
    { unfold p4_term p4_term_poly,
      simp },
    { unfold p4_term,
      rw [p4_term_poly_num, p4_term_poly_den],
      have hmm : ∀ (m : ℕ), m < nat.succ t → p4_term m k ≠ 0,
      { intros m hmlt,
        exact hm m (lt_trans hmlt (nat.lt_succ_self _)) },
      have hmmm : ∀ (m : ℕ), m < t → p4_term m k ≠ 0,
      { intros m hmlt,
        exact hmm m (lt_trans hmlt (nat.lt_succ_self _)) },
      have ht1 := ht t (nat.le_succ t) hmmm,
      have ht2 := ht (nat.succ t) (by refl) hmm,
      rw [ht1, ht2],
      unfold p4_seq_next,
      have ht1a : polynomial.eval k (p4_term_poly t).fst ≠ 0,
      { intro hz,
        rw [hz, zero_div] at ht1,
        exact hmm t (nat.lt_succ_self _) ht1 },
      have ht1b : polynomial.eval k (p4_term_poly t).snd ≠ 0,
      { intro hz,
        rw [hz, div_zero] at ht1,
        exact hmm t (nat.lt_succ_self _) ht1 },
      have ht2a : polynomial.eval k (p4_term_poly (nat.succ t)).fst ≠ 0,
      { intro hz,
        rw [hz, zero_div] at ht2,
        exact hm (nat.succ t) (nat.lt_succ_self _) ht2 },
      have ht2b : polynomial.eval k (p4_term_poly (nat.succ t)).snd ≠ 0,
      { intro hz,
        rw [hz, div_zero] at ht2,
        exact hm (nat.succ t) (nat.lt_succ_self _) ht2 },
      field_simp } }
end

-- The numerator and denominator polynomials are not identically zero.
theorem p4_poly_ne_zero : ∀ n : ℕ, ((p4_term_poly n).fst) ≠ 0 ∧ ((p4_term_poly n).snd) ≠ 0 :=
begin
  have h2 : ∀ m : ℕ, p4_term m (2 : ℝ) = polynomial.eval 2 (p4_term_poly m).fst /
        polynomial.eval 2 (p4_term_poly m).snd,
  { intro m,
    apply p4_terms_poly,
    intros m1 hm1,
    rw p4_terms_at_2,
    norm_cast,
    simp },
  intro n,
  split,
  { intro h,
    have h2n := h2 n,
    rw [h, p4_terms_at_2, polynomial.eval_zero, zero_div] at h2n,
    norm_cast at h2n },
  { intro h,
    have h2n := h2 n,
    rw [h, p4_terms_at_2, polynomial.eval_zero, div_zero] at h2n,
    norm_cast at h2n }
end

-- There exists a finite set of k for which some term up to n is zero.
theorem p4_finset_zero  (n : ℕ) :
  ∃ s : finset ℝ, (∀ k : ℝ, (∃ m : ℕ, m ≤ n ∧ p4_term m k = 0) → k ∈ s) :=
begin
  induction n with t ht,
  { use ∅,
    intros k h,
    exfalso,
    rcases h with ⟨m, ⟨hm0, hmt⟩⟩,
    have hm00 : m = 0, { linarith },
    rw hm00 at hmt,
    unfold p4_term at hmt,
    norm_num at hmt },
  { cases ht with st hst,
    use st ∪ (polynomial.roots ((p4_term_poly (nat.succ t)).fst)).to_finset ∪
             (polynomial.roots ((p4_term_poly (nat.succ t)).snd)).to_finset,
    rintros k ⟨m, hmlt, hm0⟩,
    by_cases hx : ∃ (q : ℕ), (q ≤ t ∧ p4_term q k = 0),
    { apply finset.mem_union_left,
      apply finset.mem_union_left,
      exact hst k hx },
    { by_cases hmlet : m ≤ t,
      { exfalso,
        apply hx,
        use m,
        split,
        { exact hmlet },
        { exact hm0 } },
      { have hmt : m = nat.succ t,
        { rw [←lt_iff_not_le, ←nat.succ_le_iff] at hmlet,
          linarith },
        have hterm : p4_term m k = polynomial.eval k (p4_term_poly m).fst /
          polynomial.eval k (p4_term_poly m).snd,
        { apply p4_terms_poly,
          intros m1 hm1 hm10,
          apply hx,
          use m1,
          split,
          { rw hmt at hm1,
            rw ←nat.lt_succ_iff,
            exact hm1 },
          { exact hm10 } },
        { have hn0 : (p4_term_poly (nat.succ t)).fst ≠ 0 := (p4_poly_ne_zero (nat.succ t)).left,
          have hd0 : (p4_term_poly (nat.succ t)).snd ≠ 0 := (p4_poly_ne_zero (nat.succ t)).right,
          by_cases hden : polynomial.eval k (p4_term_poly m).snd = 0,
          { apply finset.mem_union_right,
            rw [multiset.mem_to_finset, polynomial.mem_roots hd0],
            unfold polynomial.is_root,
            rw ← hmt,
            exact hden },
          { rw [hterm, div_eq_zero_iff] at hm0,
            apply finset.mem_union_left,
            apply finset.mem_union_right,
            rw [multiset.mem_to_finset, polynomial.mem_roots hn0],
            unfold polynomial.is_root,
            rw ← hmt,
            exact or.resolve_right hm0 hden } } } } }
end

-- There exists a countable set of k for which some term up to n is zero.
theorem p4_countableset_zero (n : ℕ) :
  ∃ s : set ℝ, s.countable ∧ (∀ k : ℝ, (∃ m : ℕ, m ≤ n ∧ p4_term m k = 0) → k ∈ s) :=
begin
  cases p4_finset_zero n with fs hfs,
  use (↑fs),
  split,
  { apply set.finite.countable,
    exact finset.finite_to_set fs },
  { intros k h,
    rw finset.mem_coe,
    revert h,
    revert k,
    exact hfs }
end

-- That countable set.
def p4_countableset_zero_set (n : ℕ) := classical.some (p4_countableset_zero n)

-- Its defining property.
theorem p4_countableset_zero_set_prop (n : ℕ) :
  (p4_countableset_zero_set n).countable ∧
    (∀ k : ℝ, (∃ m : ℕ, m ≤ n ∧ p4_term m k = 0) → k ∈ (p4_countableset_zero_set n)) :=
classical.some_spec (p4_countableset_zero n)

-- There exists a countable set of k for which some term is zero.
theorem p4_countable_zero : ∃ s : set ℝ,
    s.countable ∧ (∀ k : ℝ, (∃ m : ℕ, p4_term m k = 0) → k ∈ s) :=
begin
  use ⋃ n : ℕ, p4_countableset_zero_set n,
  split,
  { apply set.countable_Union,
    intro n,
    exact (p4_countableset_zero_set_prop n).left },
  { intros k h,
    rw set.mem_Union,
    cases h with m hm,
    use m,
    apply (p4_countableset_zero_set_prop m).right k,
    use m,
    split,
    { refl },
    { exact hm } },
end

-- That countable set.
def p4_countable_zero_set := classical.some p4_countable_zero

-- Its defining property.
theorem p4_countable_zero_set_prop:
  set.countable p4_countable_zero_set ∧
    (∀ k : ℝ, (∃ m : ℕ, p4_term m k = 0) → k ∈ p4_countable_zero_set) :=
classical.some_spec p4_countable_zero

-- An open interval of reals is uncountable.
lemma not_countable_Ioo_real {k1 k2 : ℝ} (h : k1 < k2) :
  ¬ set.countable (set.Ioo k1 k2) :=
begin
  rw [←cardinal.le_aleph_0_iff_set_countable, not_le, cardinal.mk_Ioo_real h],
  exact cardinal.cantor _
end

-- Any open interval of reals contains one not in that set.
theorem interval_open_not_in_set (k1 k2 : ℝ) (h : k1 < k2) :
  ∃ k : ℝ, k ∈ set.Ioo k1 k2 ∧ ¬ k ∈ p4_countable_zero_set :=
begin
  have hns : ¬ set.Ioo k1 k2 ⊆ p4_countable_zero_set,
  { intro hsub,
    exact not_countable_Ioo_real h
      (set.countable.mono hsub p4_countable_zero_set_prop.left) },
  rw set.not_subset at hns,
  rcases hns with ⟨k, ⟨hk1, hk2⟩⟩,
  exact ⟨k, hk1, hk2⟩
end

-- The actual result that a suitable value is in the interval.

theorem p4_interval_terms_nonzero (kb : ℝ) (h1 : 1 ≤ kb) (h2 : kb < 2) :
  ∃ (k : ℝ) (h1 : kb < k) (h2 : k < 2), ∀ n : ℕ, p4_term n k ≠ 0 :=
begin
  rcases interval_open_not_in_set kb 2 h2 with ⟨k, ⟨hk1, hk2⟩⟩,
  erw set.mem_set_of_eq at hk1,
  cases hk1 with hk1a hk1b,
  use [k, hk1a, hk1b],
  intros n hz,
  have hex : ∃ m : ℕ, p4_term m k = 0,
  { use n,
    exact hz },
  exact hk2 (p4_countable_zero_set_prop.right k hex)
end

-- The second part of the problem, in terms of p4_term rather than the
-- original recurrence and with an explicit term number.
theorem p4_part_2_terms : ∃ (k : ℝ) (h1 : 1 < k) (h2 : k < 2),
  2020 < (p4_term 2020) k ∧ ∀ n : ℕ, p4_term n k ≠ 0 :=
begin
  rcases p4_part_2_terms_interval with ⟨kb, ⟨h1, ⟨h2, hkb⟩⟩⟩,
  rcases p4_interval_terms_nonzero kb h1 h2 with ⟨k, ⟨hk1, ⟨hk2, hk⟩⟩⟩,
  use [k, (by linarith), hk2],
  split,
  { exact hkb k hk1 hk2 },
  { exact hk },
end

-- The second part of the original problem.
theorem p4_part_2 : ∃ (k : ℝ) (h1 : 1 < k) (h2 : k < 2),
  ∀ b : ℕ → ℝ, b 0 = 1 → b 1 = k → (p4_recurrence b) →
    ((∃ n : ℕ, 2020 < b n) ∧ (∀ n : ℕ, b n ≠ 0)) :=
begin
  have hterms : ∃ (k : ℝ) (h1 : 1 < k) (h2 : k < 2),
    2020 < (p4_term 2020) k ∧ ∀ n : ℕ, p4_term n k ≠ 0 := p4_part_2_terms,
  rcases hterms with ⟨k, ⟨h1, ⟨h2, hterms⟩⟩⟩,
  use [k, h1, h2],
  intros b hb0 hb1 hrec,
  split,
  { use 2020,
    rw p4_terms b hrec k hb0 hb1 2020,
     exact hterms.1 },
  { intro n,
    rw p4_terms b hrec k hb0 hb1 n,
    exact hterms.2 n }
end


import tactic

open_locale classical

variables (X : Type) (x : X) (A B : set X)

open set

/-- Humans want these -/
example (a : X) : a ∈ (univ : set X) := mem_univ a
example (a : X) : ¬ (a ∈ (∅ : set X)) := not_false
example (a : X) (P : X → Prop) : a ∈ {b : X | P b} ↔ P a := iff.rfl

/-- Humans want these -/
example : x ∈ A ∪ B ↔ x ∈ A ∨ x ∈ B := iff.rfl -- let's call it mem_union_iff
example : x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B := iff.rfl -- let's called it mem_inter_iff
example : A = B ↔ ∀ x : X, x ∈ A ↔ x ∈ B := ext_iff
example : A ⊆ B ↔ ∀ x : X, x ∈ A → x ∈ B := iff_of_eq subset_def --iff.rfl avoids eq.rec
-- call it subset_iff?

variables (ι : Type) (f : ι → set X)

/-- Humans want these -/
example (a : X) : (a ∈ ⋃(i : ι), f i) ↔ ∃ (i : ι), a ∈ f i := mem_Union
example (a : X) : (a ∈ ⋂(i : ι), f i) ↔ ∀ (i : ι), a ∈ f i := mem_Inter


import data.set.basic data.finset

variable α: Type*
variables A B C: set α

open set

-- requires classical logic?
theorem Q8: (A - B) ∪ (B - A) = (A ∪ B) - (A ∩ B) :=
ext $ λ x,
  ⟨λ hl,
    ⟨or.elim hl
      (λ hab, or.inl hab.1)
      (λ hba, or.inr hba.1),
     λ ⟨ha, hb⟩, or.elim hl
      (λ hab, hab.2 hb)
      (λ hba, hba.2 ha)⟩,
   λ hr, classical.by_cases
    (λ ha, or.inl ⟨ha, λ hb, hr.2 ⟨ha, hb⟩⟩)
    (λ hn, or.inr
      ⟨or.elim hr.1
        (λ ha, false.elim (hn ha))
        (λ hb, hb),
       hn⟩)⟩


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl
-/
import algebra.algebra.pi
import algebra.algebra.restrict_scalars
import analysis.normed.field.basic
import data.real.sqrt
import topology.algebra.module.basic

/-!
# Normed spaces

In this file we define (semi)normed spaces and algebras. We also prove some theorems
about these definitions.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {ι : Type*}

open filter metric function set
open_locale topology big_operators nnreal ennreal uniformity pointwise

section seminormed_add_comm_group

section prio
set_option extends_priority 920
-- Here, we set a rather high priority for the instance `[normed_space α β] : module α β`
-- to take precedence over `semiring.to_module` as this leads to instance paths with better
-- unification properties.
/-- A normed space over a normed field is a vector space endowed with a norm which satisfies the
equality `‖c • x‖ = ‖c‖ ‖x‖`. We require only `‖c • x‖ ≤ ‖c‖ ‖x‖` in the definition, then prove
`‖c • x‖ = ‖c‖ ‖x‖` in `norm_smul`.

Note that since this requires `seminormed_add_comm_group` and not `normed_add_comm_group`, this
typeclass can be used for "semi normed spaces" too, just as `module` can be used for
"semi modules". -/
class normed_space (α : Type*) (β : Type*) [normed_field α] [seminormed_add_comm_group β]
  extends module α β :=
(norm_smul_le : ∀ (a:α) (b:β), ‖a • b‖ ≤ ‖a‖ * ‖b‖)
end prio

variables [normed_field α] [seminormed_add_comm_group β]

-- note: while these are currently strictly weaker than the versions without `le`, they will cease
-- to be if we eventually generalize `normed_space` from `normed_field α` to `normed_ring α`.
section le

lemma norm_smul_le [normed_space α β] (r : α) (x : β) : ‖r • x‖ ≤ ‖r‖ * ‖x‖ :=
normed_space.norm_smul_le _ _

lemma nnnorm_smul_le [normed_space α β] (s : α) (x : β) : ‖s • x‖₊ ≤ ‖s‖₊ * ‖x‖₊ :=
norm_smul_le s x

lemma dist_smul_le [normed_space α β] (s : α) (x y : β) : dist (s • x) (s • y) ≤ ‖s‖ * dist x y :=
by simpa only [dist_eq_norm, ←smul_sub] using norm_smul_le _ _

lemma nndist_smul_le [normed_space α β] (s : α) (x y : β) :
  nndist (s • x) (s • y) ≤ ‖s‖₊ * nndist x y :=
dist_smul_le s x y

end le

@[priority 100] -- see Note [lower instance priority]
instance normed_space.has_bounded_smul [normed_space α β] : has_bounded_smul α β :=
{ dist_smul_pair' := λ x y₁ y₂,
    by simpa [dist_eq_norm, smul_sub] using norm_smul_le x (y₁ - y₂),
  dist_pair_smul' := λ x₁ x₂ y,
    by simpa [dist_eq_norm, sub_smul] using norm_smul_le (x₁ - x₂) y }

-- Shortcut instance, as otherwise this will be found by `normed_space.to_module` and be
-- noncomputable.
instance : module ℝ ℝ := by apply_instance

instance normed_field.to_normed_space : normed_space α α :=
{ norm_smul_le := λ a b, norm_mul_le a b }

lemma norm_smul [normed_space α β] (s : α) (x : β) : ‖s • x‖ = ‖s‖ * ‖x‖ :=
begin
  by_cases h : s = 0,
  { simp [h] },
  { refine le_antisymm (norm_smul_le s x) _,
    calc ‖s‖ * ‖x‖ = ‖s‖ * ‖s⁻¹ • s • x‖     : by rw [inv_smul_smul₀ h]
               ... ≤ ‖s‖ * (‖s⁻¹‖ * ‖s • x‖) :
      mul_le_mul_of_nonneg_left (norm_smul_le _ _) (norm_nonneg _)
               ... = ‖s • x‖                 :
      by rw [norm_inv, ← mul_assoc, mul_inv_cancel (mt norm_eq_zero.1 h), one_mul] }
end

lemma norm_zsmul (α) [normed_field α] [normed_space α β] (n : ℤ) (x : β) :
  ‖n • x‖ = ‖(n : α)‖ * ‖x‖ :=
by rw [← norm_smul, ← int.smul_one_eq_coe, smul_assoc, one_smul]

@[simp] lemma abs_norm_eq_norm (z : β) : |‖z‖| = ‖z‖ :=
  (abs_eq (norm_nonneg z)).mpr (or.inl rfl)

lemma inv_norm_smul_mem_closed_unit_ball [normed_space ℝ β] (x : β) :
  ‖x‖⁻¹ • x ∈ closed_ball (0 : β) 1 :=
by simp only [mem_closed_ball_zero_iff, norm_smul, norm_inv, norm_norm, ← div_eq_inv_mul,
  div_self_le_one]

lemma dist_smul₀ [normed_space α β] (s : α) (x y : β) : dist (s • x) (s • y) = ‖s‖ * dist x y :=
by simp only [dist_eq_norm, (norm_smul _ _).symm, smul_sub]

lemma nnnorm_smul [normed_space α β] (s : α) (x : β) : ‖s • x‖₊ = ‖s‖₊ * ‖x‖₊ :=
nnreal.eq $ norm_smul s x

lemma nndist_smul₀ [normed_space α β] (s : α) (x y : β) :
  nndist (s • x) (s • y) = ‖s‖₊ * nndist x y :=
nnreal.eq $ dist_smul₀ s x y

lemma lipschitz_with_smul [normed_space α β] (s : α) : lipschitz_with ‖s‖₊ ((•) s : β → β) :=
lipschitz_with_iff_dist_le_mul.2 $ λ x y, by rw [dist_smul₀, coe_nnnorm]

lemma norm_smul_of_nonneg [normed_space ℝ β] {t : ℝ} (ht : 0 ≤ t) (x : β) :
  ‖t • x‖ = t * ‖x‖ := by rw [norm_smul, real.norm_eq_abs, abs_of_nonneg ht]

variables {E : Type*} [seminormed_add_comm_group E] [normed_space α E]
variables {F : Type*} [seminormed_add_comm_group F] [normed_space α F]

theorem eventually_nhds_norm_smul_sub_lt (c : α) (x : E) {ε : ℝ} (h : 0 < ε) :
  ∀ᶠ y in 𝓝 x, ‖c • (y - x)‖ < ε :=
have tendsto (λ y, ‖c • (y - x)‖) (𝓝 x) (𝓝 0),
  from ((continuous_id.sub continuous_const).const_smul _).norm.tendsto' _ _ (by simp),
this.eventually (gt_mem_nhds h)

lemma filter.tendsto.zero_smul_is_bounded_under_le {f : ι → α} {g : ι → E} {l : filter ι}
  (hf : tendsto f l (𝓝 0)) (hg : is_bounded_under (≤) l (norm ∘ g)) :
  tendsto (λ x, f x • g x) l (𝓝 0) :=
hf.op_zero_is_bounded_under_le hg (•) norm_smul_le

lemma filter.is_bounded_under.smul_tendsto_zero {f : ι → α} {g : ι → E} {l : filter ι}
  (hf : is_bounded_under (≤) l (norm ∘ f)) (hg : tendsto g l (𝓝 0)) :
  tendsto (λ x, f x • g x) l (𝓝 0) :=
hg.op_zero_is_bounded_under_le hf (flip (•)) (λ x y, (norm_smul_le y x).trans_eq (mul_comm _ _))

theorem closure_ball [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) :
  closure (ball x r) = closed_ball x r :=
begin
  refine subset.antisymm closure_ball_subset_closed_ball (λ y hy, _),
  have : continuous_within_at (λ c : ℝ, c • (y - x) + x) (Ico 0 1) 1 :=
    ((continuous_id.smul continuous_const).add continuous_const).continuous_within_at,
  convert this.mem_closure _ _,
  { rw [one_smul, sub_add_cancel] },
  { simp [closure_Ico zero_ne_one, zero_le_one] },
  { rintros c ⟨hc0, hc1⟩,
    rw [mem_ball, dist_eq_norm, add_sub_cancel, norm_smul, real.norm_eq_abs,
      abs_of_nonneg hc0, mul_comm, ← mul_one r],
    rw [mem_closed_ball, dist_eq_norm] at hy,
    replace hr : 0 < r, from ((norm_nonneg _).trans hy).lt_of_ne hr.symm,
    apply mul_lt_mul'; assumption }
end

theorem frontier_ball [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) :
  frontier (ball x r) = sphere x r :=
begin
  rw [frontier, closure_ball x hr, is_open_ball.interior_eq],
  ext x, exact (@eq_iff_le_not_lt ℝ _ _ _).symm
end

theorem interior_closed_ball [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) :
  interior (closed_ball x r) = ball x r :=
begin
  cases hr.lt_or_lt with hr hr,
  { rw [closed_ball_eq_empty.2 hr, ball_eq_empty.2 hr.le, interior_empty] },
  refine subset.antisymm _ ball_subset_interior_closed_ball,
  intros y hy,
  rcases (mem_closed_ball.1 $ interior_subset hy).lt_or_eq with hr|rfl, { exact hr },
  set f : ℝ → E := λ c : ℝ, c • (y - x) + x,
  suffices : f ⁻¹' closed_ball x (dist y x) ⊆ Icc (-1) 1,
  { have hfc : continuous f := (continuous_id.smul continuous_const).add continuous_const,
    have hf1 : (1:ℝ) ∈ f ⁻¹' (interior (closed_ball x $ dist y x)), by simpa [f],
    have h1 : (1:ℝ) ∈ interior (Icc (-1:ℝ) 1) :=
      interior_mono this (preimage_interior_subset_interior_preimage hfc hf1),
    contrapose h1,
    simp },
  intros c hc,
  rw [mem_Icc, ← abs_le, ← real.norm_eq_abs, ← mul_le_mul_right hr],
  simpa [f, dist_eq_norm, norm_smul] using hc
end

theorem frontier_closed_ball [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) :
  frontier (closed_ball x r) = sphere x r :=
by rw [frontier, closure_closed_ball, interior_closed_ball x hr,
  closed_ball_diff_ball]

instance {E : Type*} [normed_add_comm_group E] [normed_space ℚ E] (e : E) :
  discrete_topology $ add_subgroup.zmultiples e :=
begin
  rcases eq_or_ne e 0 with rfl | he,
  { rw [add_subgroup.zmultiples_zero_eq_bot], apply_instance, },
  { rw [discrete_topology_iff_open_singleton_zero, is_open_induced_iff],
    refine ⟨metric.ball 0 (‖e‖), metric.is_open_ball, _⟩,
    ext ⟨x, hx⟩,
    obtain ⟨k, rfl⟩ := add_subgroup.mem_zmultiples_iff.mp hx,
    rw [mem_preimage, mem_ball_zero_iff, add_subgroup.coe_mk, mem_singleton_iff,
      subtype.ext_iff, add_subgroup.coe_mk, add_subgroup.coe_zero, norm_zsmul ℚ k e,
      int.norm_cast_rat, int.norm_eq_abs, ← int.cast_abs, mul_lt_iff_lt_one_left
      (norm_pos_iff.mpr he), ← @int.cast_one ℝ _, int.cast_lt, int.abs_lt_one_iff, smul_eq_zero,
      or_iff_left he], },
end

/-- A (semi) normed real vector space is homeomorphic to the unit ball in the same space.
This homeomorphism sends `x : E` to `(1 + ‖x‖²)^(- ½) • x`.

In many cases the actual implementation is not important, so we don't mark the projection lemmas
`homeomorph_unit_ball_apply_coe` and `homeomorph_unit_ball_symm_apply` as `@[simp]`.

See also `cont_diff_homeomorph_unit_ball` and `cont_diff_on_homeomorph_unit_ball_symm` for
smoothness properties that hold when `E` is an inner-product space. -/
@[simps { attrs := [] }]
noncomputable def homeomorph_unit_ball [normed_space ℝ E] :
  E ≃ₜ ball (0 : E) 1 :=
{ to_fun := λ x, ⟨(1 + ‖x‖^2).sqrt⁻¹ • x, begin
    have : 0 < 1 + ‖x‖ ^ 2, by positivity,
    rw [mem_ball_zero_iff, norm_smul, real.norm_eq_abs, abs_inv, ← div_eq_inv_mul,
      div_lt_one (abs_pos.mpr $ real.sqrt_ne_zero'.mpr this), ← abs_norm_eq_norm x, ← sq_lt_sq,
      abs_norm_eq_norm, real.sq_sqrt this.le],
    exact lt_one_add _,
  end⟩,
  inv_fun := λ y, (1 - ‖(y : E)‖^2).sqrt⁻¹ • (y : E),
  left_inv := λ x,
  by field_simp [norm_smul, smul_smul, (zero_lt_one_add_norm_sq x).ne',
    real.sq_sqrt (zero_lt_one_add_norm_sq x).le, ← real.sqrt_div (zero_lt_one_add_norm_sq x).le],
  right_inv := λ y,
  begin
    have : 0 < 1 - ‖(y : E)‖ ^ 2 :=
      by nlinarith [norm_nonneg (y : E), (mem_ball_zero_iff.1 y.2 : ‖(y : E)‖ < 1)],
    field_simp [norm_smul, smul_smul, this.ne', real.sq_sqrt this.le, ← real.sqrt_div this.le],
  end,
  continuous_to_fun :=
  begin
    suffices : continuous (λ x, (1 + ‖x‖^2).sqrt⁻¹), from (this.smul continuous_id).subtype_mk _,
    refine continuous.inv₀ _ (λ x, real.sqrt_ne_zero'.mpr (by positivity)),
    continuity,
  end,
  continuous_inv_fun :=
  begin
    suffices : ∀ (y : ball (0 : E) 1), (1 - ‖(y : E)‖ ^ 2).sqrt ≠ 0, { continuity, },
    intros y,
    rw real.sqrt_ne_zero',
    nlinarith [norm_nonneg (y : E), (mem_ball_zero_iff.1 y.2 : ‖(y : E)‖ < 1)],
  end }

@[simp] lemma coe_homeomorph_unit_ball_apply_zero [normed_space ℝ E] :
  (homeomorph_unit_ball (0 : E) : E) = 0 :=
by simp [homeomorph_unit_ball]

open normed_field

instance : normed_space α (ulift E) :=
{ norm_smul_le := λ s x, (norm_smul_le s x.down : _),
  ..ulift.normed_add_comm_group,
  ..ulift.module' }

/-- The product of two normed spaces is a normed space, with the sup norm. -/
instance prod.normed_space : normed_space α (E × F) :=
{ norm_smul_le := λ s x, by simp [prod.norm_def, norm_smul_le, mul_max_of_nonneg],
  ..prod.normed_add_comm_group,
  ..prod.module }

/-- The product of finitely many normed spaces is a normed space, with the sup norm. -/
instance pi.normed_space {E : ι → Type*} [fintype ι] [∀i, seminormed_add_comm_group (E i)]
  [∀i, normed_space α (E i)] : normed_space α (Πi, E i) :=
{ norm_smul_le := λ a f, begin
    simp_rw [←coe_nnnorm, ←nnreal.coe_mul, nnreal.coe_le_coe, pi.nnnorm_def, nnreal.mul_finset_sup],
    exact finset.sup_mono_fun (λ _ _, norm_smul_le _ _),
  end }

instance mul_opposite.normed_space : normed_space α Eᵐᵒᵖ :=
{ norm_smul_le := λ s x, norm_smul_le s x.unop,
  ..mul_opposite.normed_add_comm_group,
  ..mul_opposite.module _ }

/-- A subspace of a normed space is also a normed space, with the restriction of the norm. -/
instance submodule.normed_space {𝕜 R : Type*} [has_smul 𝕜 R] [normed_field 𝕜] [ring R]
  {E : Type*} [seminormed_add_comm_group E] [normed_space 𝕜 E] [module R E]
  [is_scalar_tower 𝕜 R E] (s : submodule R E) :
  normed_space 𝕜 s :=
{ norm_smul_le := λc x, norm_smul_le c (x : E) }

/-- If there is a scalar `c` with `‖c‖>1`, then any element with nonzero norm can be
moved by scalar multiplication to any shell of width `‖c‖`. Also recap information on the norm of
the rescaling element that shows up in applications. -/
lemma rescale_to_shell_semi_normed_zpow {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E}
  (hx : ‖x‖ ≠ 0) :
  ∃ n : ℤ, c ^ n ≠ 0 ∧ ‖c ^ n • x‖ < ε ∧ (ε / ‖c‖ ≤ ‖c ^ n • x‖) ∧ (‖c ^ n‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖) :=
begin
  have xεpos : 0 < ‖x‖/ε := div_pos ((ne.symm hx).le_iff_lt.1 (norm_nonneg x)) εpos,
  rcases exists_mem_Ico_zpow xεpos hc with ⟨n, hn⟩,
  have cpos : 0 < ‖c‖ := lt_trans (zero_lt_one : (0 :ℝ) < 1) hc,
  have cnpos : 0 < ‖c^(n+1)‖ := by { rw norm_zpow, exact lt_trans xεpos hn.2 },
  refine ⟨-(n+1), _, _, _, _⟩,
  show c ^ (-(n + 1)) ≠ 0, from zpow_ne_zero _ (norm_pos_iff.1 cpos),
  show ‖c ^ (-(n + 1)) • x‖ < ε,
  { rw [norm_smul, zpow_neg, norm_inv, ← div_eq_inv_mul, div_lt_iff cnpos, mul_comm, norm_zpow],
    exact (div_lt_iff εpos).1 (hn.2) },
  show ε / ‖c‖ ≤ ‖c ^ (-(n + 1)) • x‖,
  { rw [zpow_neg, div_le_iff cpos, norm_smul, norm_inv, norm_zpow, zpow_add₀ (ne_of_gt cpos),
        zpow_one, mul_inv_rev, mul_comm, ← mul_assoc, ← mul_assoc, mul_inv_cancel (ne_of_gt cpos),
        one_mul, ← div_eq_inv_mul, le_div_iff (zpow_pos_of_pos cpos _), mul_comm],
    exact (le_div_iff εpos).1 hn.1 },
  show ‖c ^ (-(n + 1))‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖,
  { rw [zpow_neg, norm_inv, inv_inv, norm_zpow, zpow_add₀ cpos.ne', zpow_one, mul_right_comm,
      ← div_eq_inv_mul],
    exact mul_le_mul_of_nonneg_right hn.1 (norm_nonneg _) }
end

/-- If there is a scalar `c` with `‖c‖>1`, then any element with nonzero norm can be
moved by scalar multiplication to any shell of width `‖c‖`. Also recap information on the norm of
the rescaling element that shows up in applications. -/
lemma rescale_to_shell_semi_normed {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E}
  (hx : ‖x‖ ≠ 0) : ∃d:α, d ≠ 0 ∧ ‖d • x‖ < ε ∧ (ε/‖c‖ ≤ ‖d • x‖) ∧ (‖d‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖) :=
let ⟨n, hn⟩ := rescale_to_shell_semi_normed_zpow hc εpos hx in ⟨_, hn⟩

end seminormed_add_comm_group

/-- A linear map from a `module` to a `normed_space` induces a `normed_space` structure on the
domain, using the `seminormed_add_comm_group.induced` norm.

See note [reducible non-instances] -/
@[reducible]
def normed_space.induced {F : Type*} (α β γ : Type*) [normed_field α] [add_comm_group β]
  [module α β] [seminormed_add_comm_group γ] [normed_space α γ] [linear_map_class F α β γ]
  (f : F) : @normed_space α β _ (seminormed_add_comm_group.induced β γ f) :=
{ norm_smul_le := λ a b, by {unfold norm, exact (map_smul f a b).symm ▸ norm_smul_le a (f b) } }

section normed_add_comm_group

variables [normed_field α]
variables {E : Type*} [normed_add_comm_group E] [normed_space α E]
variables {F : Type*} [normed_add_comm_group F] [normed_space α F]

open normed_field

/-- While this may appear identical to `normed_space.to_module`, it contains an implicit argument
involving `normed_add_comm_group.to_seminormed_add_comm_group` that typeclass inference has trouble
inferring.

Specifically, the following instance cannot be found without this `normed_space.to_module'`:
```lean
example
  (𝕜 ι : Type*) (E : ι → Type*)
  [normed_field 𝕜] [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] :
  Π i, module 𝕜 (E i) := by apply_instance
```

[This Zulip thread](https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Typeclass.20resolution.20under.20binders/near/245151099)
gives some more context. -/
@[priority 100]
instance normed_space.to_module' : module α F := normed_space.to_module

section surj

variables (E) [normed_space ℝ E] [nontrivial E]

lemma exists_norm_eq {c : ℝ} (hc : 0 ≤ c) : ∃ x : E, ‖x‖ = c :=
begin
  rcases exists_ne (0 : E) with ⟨x, hx⟩,
  rw ← norm_ne_zero_iff at hx,
  use c • ‖x‖⁻¹ • x,
  simp [norm_smul, real.norm_of_nonneg hc, hx]
end

@[simp] lemma range_norm : range (norm : E → ℝ) = Ici 0 :=
subset.antisymm (range_subset_iff.2 norm_nonneg) (λ _, exists_norm_eq E)

lemma nnnorm_surjective : surjective (nnnorm : E → ℝ≥0) :=
λ c, (exists_norm_eq E c.coe_nonneg).imp $ λ x h, nnreal.eq h

@[simp] lemma range_nnnorm : range (nnnorm : E → ℝ≥0) = univ :=
(nnnorm_surjective E).range_eq

end surj

/-- If `E` is a nontrivial topological module over `ℝ`, then `E` has no isolated points.
This is a particular case of `module.punctured_nhds_ne_bot`. -/
instance real.punctured_nhds_module_ne_bot
  {E : Type*} [add_comm_group E] [topological_space E] [has_continuous_add E] [nontrivial E]
  [module ℝ E] [has_continuous_smul ℝ E] (x : E) :
  ne_bot (𝓝[≠] x) :=
module.punctured_nhds_ne_bot ℝ E x

theorem interior_closed_ball' [normed_space ℝ E] [nontrivial E] (x : E) (r : ℝ) :
  interior (closed_ball x r) = ball x r :=
begin
  rcases eq_or_ne r 0 with rfl|hr,
  { rw [closed_ball_zero, ball_zero, interior_singleton] },
  { exact interior_closed_ball x hr }
end

theorem frontier_closed_ball' [normed_space ℝ E] [nontrivial E] (x : E) (r : ℝ) :
  frontier (closed_ball x r) = sphere x r :=
by rw [frontier, closure_closed_ball, interior_closed_ball' x r, closed_ball_diff_ball]

variables {α}

lemma rescale_to_shell_zpow {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E} (hx : x ≠ 0) :
  ∃ n : ℤ, c ^ n ≠ 0 ∧ ‖c ^ n • x‖ < ε ∧ (ε / ‖c‖ ≤ ‖c ^ n • x‖) ∧ (‖c ^ n‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖) :=
rescale_to_shell_semi_normed_zpow hc εpos (mt norm_eq_zero.1 hx)

/-- If there is a scalar `c` with `‖c‖>1`, then any element can be moved by scalar multiplication to
any shell of width `‖c‖`. Also recap information on the norm of the rescaling element that shows
up in applications. -/
lemma rescale_to_shell {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E} (hx : x ≠ 0) :
  ∃d:α, d ≠ 0 ∧ ‖d • x‖ < ε ∧ (ε/‖c‖ ≤ ‖d • x‖) ∧ (‖d‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖) :=
rescale_to_shell_semi_normed hc εpos (mt norm_eq_zero.1 hx)

end normed_add_comm_group

section nontrivially_normed_space

variables (𝕜 E : Type*) [nontrivially_normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E]
  [nontrivial E]

include 𝕜

/-- If `E` is a nontrivial normed space over a nontrivially normed field `𝕜`, then `E` is unbounded:
for any `c : ℝ`, there exists a vector `x : E` with norm strictly greater than `c`. -/
lemma normed_space.exists_lt_norm (c : ℝ) : ∃ x : E, c < ‖x‖ :=
begin
  rcases exists_ne (0 : E) with ⟨x, hx⟩,
  rcases normed_field.exists_lt_norm 𝕜 (c / ‖x‖) with ⟨r, hr⟩,
  use r • x,
  rwa [norm_smul, ← div_lt_iff],
  rwa norm_pos_iff
end

protected lemma normed_space.unbounded_univ : ¬bounded (univ : set E) :=
λ h, let ⟨R, hR⟩ := bounded_iff_forall_norm_le.1 h, ⟨x, hx⟩ := normed_space.exists_lt_norm 𝕜 E R
in hx.not_le (hR x trivial)

/-- A normed vector space over a nontrivially normed field is a noncompact space. This cannot be
an instance because in order to apply it, Lean would have to search for `normed_space 𝕜 E` with
unknown `𝕜`. We register this as an instance in two cases: `𝕜 = E` and `𝕜 = ℝ`. -/
protected lemma normed_space.noncompact_space : noncompact_space E :=
⟨λ h, normed_space.unbounded_univ 𝕜 _ h.bounded⟩

@[priority 100]
instance nontrivially_normed_field.noncompact_space : noncompact_space 𝕜 :=
normed_space.noncompact_space 𝕜 𝕜

omit 𝕜

@[priority 100]
instance real_normed_space.noncompact_space [normed_space ℝ E] : noncompact_space E :=
normed_space.noncompact_space ℝ E

end nontrivially_normed_space

section normed_algebra

/-- A normed algebra `𝕜'` over `𝕜` is normed module that is also an algebra.

See the implementation notes for `algebra` for a discussion about non-unital algebras. Following
the strategy there, a non-unital *normed* algebra can be written as:
```lean
variables [normed_field 𝕜] [non_unital_semi_normed_ring 𝕜']
variables [normed_module 𝕜 𝕜'] [smul_comm_class 𝕜 𝕜' 𝕜'] [is_scalar_tower 𝕜 𝕜' 𝕜']
```
-/
class normed_algebra (𝕜 : Type*) (𝕜' : Type*) [normed_field 𝕜] [semi_normed_ring 𝕜']
  extends algebra 𝕜 𝕜' :=
(norm_smul_le : ∀ (r : 𝕜) (x : 𝕜'), ‖r • x‖ ≤ ‖r‖ * ‖x‖)

variables {𝕜 : Type*} (𝕜' : Type*) [normed_field 𝕜] [semi_normed_ring 𝕜'] [normed_algebra 𝕜 𝕜']

@[priority 100]
instance normed_algebra.to_normed_space : normed_space 𝕜 𝕜' :=
{ norm_smul_le := normed_algebra.norm_smul_le }

/-- While this may appear identical to `normed_algebra.to_normed_space`, it contains an implicit
argument involving `normed_ring.to_semi_normed_ring` that typeclass inference has trouble inferring.

Specifically, the following instance cannot be found without this `normed_space.to_module'`:
```lean
example
  (𝕜 ι : Type*) (E : ι → Type*)
  [normed_field 𝕜] [Π i, normed_ring (E i)] [Π i, normed_algebra 𝕜 (E i)] :
  Π i, module 𝕜 (E i) := by apply_instance
```

See `normed_space.to_module'` for a similar situation. -/
@[priority 100]
instance normed_algebra.to_normed_space' {𝕜'} [normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] :
  normed_space 𝕜 𝕜' := by apply_instance

lemma norm_algebra_map (x : 𝕜) : ‖algebra_map 𝕜 𝕜' x‖ = ‖x‖ * ‖(1 : 𝕜')‖ :=
begin
  rw algebra.algebra_map_eq_smul_one,
  exact norm_smul _ _,
end

lemma nnnorm_algebra_map (x : 𝕜) : ‖algebra_map 𝕜 𝕜' x‖₊ = ‖x‖₊ * ‖(1 : 𝕜')‖₊ :=
subtype.ext $ norm_algebra_map 𝕜' x

@[simp] lemma norm_algebra_map' [norm_one_class 𝕜'] (x : 𝕜) : ‖algebra_map 𝕜 𝕜' x‖ = ‖x‖ :=
by rw [norm_algebra_map, norm_one, mul_one]

@[simp] lemma nnnorm_algebra_map' [norm_one_class 𝕜'] (x : 𝕜) : ‖algebra_map 𝕜 𝕜' x‖₊ = ‖x‖₊ :=
subtype.ext $ norm_algebra_map' _ _

section nnreal

variables [norm_one_class 𝕜'] [normed_algebra ℝ 𝕜']

@[simp] lemma norm_algebra_map_nnreal (x : ℝ≥0) : ‖algebra_map ℝ≥0 𝕜' x‖ = x :=
(norm_algebra_map' 𝕜' (x : ℝ)).symm ▸ real.norm_of_nonneg x.prop

@[simp] lemma nnnorm_algebra_map_nnreal (x : ℝ≥0) : ‖algebra_map ℝ≥0 𝕜' x‖₊ = x :=
subtype.ext $ norm_algebra_map_nnreal 𝕜' x

end nnreal

variables (𝕜 𝕜')

/-- In a normed algebra, the inclusion of the base field in the extended field is an isometry. -/
lemma algebra_map_isometry [norm_one_class 𝕜'] : isometry (algebra_map 𝕜 𝕜') :=
begin
  refine isometry.of_dist_eq (λx y, _),
  rw [dist_eq_norm, dist_eq_norm, ← ring_hom.map_sub, norm_algebra_map'],
end

instance normed_algebra.id : normed_algebra 𝕜 𝕜 :=
{ .. normed_field.to_normed_space,
  .. algebra.id 𝕜}

/-- Any normed characteristic-zero division ring that is a normed_algebra over the reals is also a
normed algebra over the rationals.

Phrased another way, if `𝕜` is a normed algebra over the reals, then `algebra_rat` respects that
norm. -/
instance normed_algebra_rat {𝕜} [normed_division_ring 𝕜] [char_zero 𝕜] [normed_algebra ℝ 𝕜] :
  normed_algebra ℚ 𝕜 :=
{ norm_smul_le := λ q x,
    by rw [←smul_one_smul ℝ q x, rat.smul_one_eq_coe, norm_smul, rat.norm_cast_real], }

instance punit.normed_algebra : normed_algebra 𝕜 punit :=
{ norm_smul_le := λ q x, by simp only [punit.norm_eq_zero, mul_zero] }

instance : normed_algebra 𝕜 (ulift 𝕜') :=
{ ..ulift.normed_space }

/-- The product of two normed algebras is a normed algebra, with the sup norm. -/
instance prod.normed_algebra {E F : Type*} [semi_normed_ring E] [semi_normed_ring F]
  [normed_algebra 𝕜 E] [normed_algebra 𝕜 F] :
  normed_algebra 𝕜 (E × F) :=
{ ..prod.normed_space }

/-- The product of finitely many normed algebras is a normed algebra, with the sup norm. -/
instance pi.normed_algebra {E : ι → Type*} [fintype ι]
  [Π i, semi_normed_ring (E i)] [Π i, normed_algebra 𝕜 (E i)] :
  normed_algebra 𝕜 (Π i, E i) :=
{ .. pi.normed_space,
  .. pi.algebra _ E }

instance mul_opposite.normed_algebra {E : Type*} [semi_normed_ring E] [normed_algebra 𝕜 E] :
  normed_algebra 𝕜 Eᵐᵒᵖ :=
{ ..mul_opposite.normed_space }

end normed_algebra

/-- A non-unital algebra homomorphism from an `algebra` to a `normed_algebra` induces a
`normed_algebra` structure on the domain, using the `semi_normed_ring.induced` norm.

See note [reducible non-instances] -/
@[reducible]
def normed_algebra.induced {F : Type*} (α β γ : Type*) [normed_field α] [ring β]
  [algebra α β] [semi_normed_ring γ] [normed_algebra α γ] [non_unital_alg_hom_class F α β γ]
  (f : F) : @normed_algebra α β _ (semi_normed_ring.induced β γ f) :=
{ norm_smul_le := λ a b, by {unfold norm, exact (map_smul f a b).symm ▸ norm_smul_le a (f b) } }

instance subalgebra.to_normed_algebra {𝕜 A : Type*} [semi_normed_ring A] [normed_field 𝕜]
  [normed_algebra 𝕜 A] (S : subalgebra 𝕜 A) : normed_algebra 𝕜 S :=
@normed_algebra.induced _ 𝕜 S A _ (subring_class.to_ring S) S.algebra _ _ _ S.val

section restrict_scalars

variables (𝕜 : Type*) (𝕜' : Type*) [normed_field 𝕜] [normed_field 𝕜'] [normed_algebra 𝕜 𝕜']
(E : Type*) [seminormed_add_comm_group E] [normed_space 𝕜' E]

instance {𝕜 : Type*} {𝕜' : Type*} {E : Type*} [I : seminormed_add_comm_group E] :
  seminormed_add_comm_group (restrict_scalars 𝕜 𝕜' E) := I

instance {𝕜 : Type*} {𝕜' : Type*} {E : Type*} [I : normed_add_comm_group E] :
  normed_add_comm_group (restrict_scalars 𝕜 𝕜' E) := I

/-- If `E` is a normed space over `𝕜'` and `𝕜` is a normed algebra over `𝕜'`, then
`restrict_scalars.module` is additionally a `normed_space`. -/
instance : normed_space 𝕜 (restrict_scalars 𝕜 𝕜' E) :=
{ norm_smul_le := λ c x, (norm_smul_le (algebra_map 𝕜 𝕜' c) (_ : E)).trans_eq $
    by rw norm_algebra_map',
  ..restrict_scalars.module 𝕜 𝕜' E }

/--
The action of the original normed_field on `restrict_scalars 𝕜 𝕜' E`.
This is not an instance as it would be contrary to the purpose of `restrict_scalars`.
-/
-- If you think you need this, consider instead reproducing `restrict_scalars.lsmul`
-- appropriately modified here.
def module.restrict_scalars.normed_space_orig {𝕜 : Type*} {𝕜' : Type*} {E : Type*}
  [normed_field 𝕜'] [seminormed_add_comm_group E] [I : normed_space 𝕜' E] :
  normed_space 𝕜' (restrict_scalars 𝕜 𝕜' E) := I

/-- Warning: This declaration should be used judiciously.
Please consider using `is_scalar_tower` and/or `restrict_scalars 𝕜 𝕜' E` instead.

This definition allows the `restrict_scalars.normed_space` instance to be put directly on `E`
rather on `restrict_scalars 𝕜 𝕜' E`. This would be a very bad instance; both because `𝕜'` cannot be
inferred, and because it is likely to create instance diamonds.
-/
def normed_space.restrict_scalars : normed_space 𝕜 E :=
restrict_scalars.normed_space _ 𝕜' _

end restrict_scalars


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

! This file was ported from Lean 3 source module measure_theory.function.special_functions.arctan
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Trigonometric.Arctan
import Mathbin.MeasureTheory.Constructions.BorelSpace

/-!
# Measurability of arctan

-/

namespace Real

@[measurability]
theorem measurable_arctan : Measurable arctan :=
  continuous_arctan.Measurable
#align real.measurable_arctan Real.measurable_arctan

end Real

section RealComposition

open Real

variable {α : Type _} {m : MeasurableSpace α} {f : α → ℝ} (hf : Measurable f)

@[measurability]
theorem Measurable.arctan : Measurable fun x => arctan (f x) :=
  measurable_arctan.comp hf
#align measurable.arctan Measurable.arctan

end RealComposition


import tactic.finish

namespace hidden

set_option trace.simplify.rewrite true
/-
bᵢ is Elementary braid, it is a crossing of two ropes i_th rope and (i+1)_th rope:
  bᵢ is counterclockwise crossing (if look from up (begining) to down (ending of braid))
  bᵢ⁻¹ is clockwise crossing

Properties of braid group:
G1. Associativity: ∀ a b c, a ∘ (b ∘ c) = (a ∘ b) ∘ c
G2. Identity: ∃! e, ∀ a, a ∘ e = e ∘ a = e
G3: Inverse: ∀ a, ∃! x, a ∘ x = x ∘ a = e
1. Trivial: bᵢ⁻¹ bᵢ = bᵢ bᵢ⁻¹ = e (it actually lemma from G3: Inverse)
2. Distant commutativity: if |i-j| ≥ 2 then bᵢ bⱼ = bⱼ bᵢ
3. Relation of Artin: bᵢ bᵢ₊₁ bᵢ = bᵢ₊₁ bᵢ bᵢ₊₁

Example:
b₃⁻¹ (b₂ b₃ b₂) b₃⁻¹ =
[by Artin relation]
(b₃⁻¹ b₃) b₂ (b₃ b₃⁻¹) =
[by Trivial]
e b₂ e =
[by id: λ x, e x = x]
b₂
-/

constant β : Type -- β is type of elementary rope crossing
constant B : ℕ → β -- Elementary braid (rope crossing)
constant e : β -- Identity braid

constant mul : β → β → β
constant inv : β → β

noncomputable instance : has_mul β := ⟨mul⟩
noncomputable instance : has_inv β := ⟨inv⟩

noncomputable def pow : β → ℕ → β
| a 0 := e
| a (nat.succ n) := (pow a n) * a

noncomputable def pow_right : β → ℕ → β
| a 0 := e
| a (nat.succ n) := a * (pow_right a n)

noncomputable def pow_right' : β → ℕ → β
| a 0 := e
| a 1 := a
| a (nat.succ n) := a * (pow_right' a n)
noncomputable instance : has_pow β _ := ⟨pow⟩

-- Prove to pow ~ pow_right

variables {a b c d : β}
variables {i j k : ℕ}

local notation `b0` := B 0
local notation `b1` := B 1
local notation `b2` := B 2
local notation `b3` := B 3
local notation `b4` := B 4
local notation `b5` := B 5
local notation `b6` := B 6
local notation `b7` := B 7
local notation `b8` := B 8
local notation `b9` := B 9

namespace braid

-- axiom b_zero : B 0 = e
-- Group axioms:
axiom assoc : a * b * c = a * (b * c)
-- axiom id.left : e * a = a
axiom id.right : a * e = a
axiom inv : a * a⁻¹ = e

-- Group lemmas:
lemma inv_left : a⁻¹ * a = e := by {
    rw ←@inv a,
    rw ←@id.right (a⁻¹ * a),
    rw ←@inv a⁻¹,
    rw ←@assoc (a⁻¹ * a) a⁻¹ a⁻¹⁻¹,
    -- simp only [assoc, id.right, inv],
    rw @assoc a⁻¹,
    rw @inv a,
    rw @id.right a⁻¹,
    rw @inv a⁻¹,
    -- exact @inv a⁻¹,
  }

lemma id.left : e * a = a := by rw [←@inv a, assoc, inv_left, id.right]

lemma mul_left  (h : a = b) (x : β) : x * a = x * b := sorry
lemma mul_right (h : a = b) (x : β) : a * x = b * x := sorry

lemma id_unique : a * b = a ↔ b = e := by {
    split; assume h,
      have H := mul_left h a⁻¹,
      rw ←assoc at H,
      rw inv_left at H,
      rw id.left at H,
      exact H,
    subst h,
    exact id.right,
  }
--
lemma inv_unique : a * b = e ↔ b = a⁻¹ := by {
    split; assume h,
      have H := mul_left h a⁻¹,
      rw [←assoc, inv_left, id.right, id.left] at H,
      exact H,
      -- have H := mul_right h b⁻¹,
      -- rw [assoc, inv, id.right, id.left] at H,
    rw [h, inv],
  }
--
lemma inv_inv : a⁻¹⁻¹ = a := by {
  conv { to_rhs, rw ←@id.right a },
  rw [←@inv a⁻¹, ←assoc, inv, id.left],
}
--
/-
  (a * b)⁻¹ = x
  e = (a * b) * x : from mul_left (a * b)
  e = a * (b * x) : from assoc
  a⁻¹ = b * x     : from mul_left a⁻¹
  b⁻¹ * a⁻¹ = x   : from mul_left b⁻¹
-/
lemma inv_two : (a * b)⁻¹ = b⁻¹ * a⁻¹ := by {
  have h : a * b * b⁻¹ * a⁻¹ = e :=
    by rw [@assoc a b b⁻¹, inv, id.right, inv],
  calc (a * b)⁻¹ = (a * b)⁻¹ * e                    : (@id.right (a * b)⁻¹).symm
             ... = (a * b)⁻¹ * (a * b * b⁻¹ * a⁻¹)  : by rw h
             ... = (a * b)⁻¹ * (a * b) * b⁻¹ * a⁻¹  : by
                                                  conv { to_rhs,
                                                  rw [@assoc _ _ b⁻¹, @assoc _ _ a⁻¹] }
             ... = e * b⁻¹ * a⁻¹  : by rw inv_left
             ... = b⁻¹ * a⁻¹  : by { rw assoc, exact id.left },
  -- use this patern for building calc step by step:
  --         ... = _ : _
}

-- Power operation
example : a ^ 2 = a * a := by {
  dsimp [(^)],
  unfold pow,
  rw id.left,
}

example : (a⁻¹) ^ 2 = (a ^ 2)⁻¹ := by {
  dsimp [(^)],
  unfold pow,
  rw [id.left, id.left],
  exact inv_two.symm,
}

example (n : ℕ) : pow a n = pow_right a n := by {
  induction n with n ih,
  { refl },
  rw [pow, pow_right, ←ih],
  have H : ∀ m, pow a m * a = a * pow a m,
  {
    assume n,
    induction n with n ih,
    { rw [pow, id.left, id.right] },
    rw [pow, ←assoc, ih],
  },
  exact H n,
}

example (n : ℕ) : pow a n = pow_right' a n := by {
  induction n with n ih,
    refl,
  rw pow,
  by_cases 1 < n,
  all_goals {sorry},
}

example : (a * a)⁻¹ = a⁻¹ * a⁻¹ := @inv_two a a
-- Alternative for calc tactic:
example : (a * b * c)⁻¹ = c⁻¹ * (a * b)⁻¹ := inv_two
example : c⁻¹ * (a * b)⁻¹ = c⁻¹ * b⁻¹ * a⁻¹ := by rw [inv_two, assoc]
example : (a * b * c)⁻¹ = c⁻¹ * b⁻¹ * a⁻¹ := eq.trans inv_two (by rw [inv_two, assoc])

example : (a * b * c)⁻¹ = c⁻¹ * b⁻¹ * a⁻¹ := calc
          (a * b * c)⁻¹ = c⁻¹ * (a * b)⁻¹ : by exact inv_two
                    ... = c⁻¹ * b⁻¹ * a⁻¹ : by rw [inv_two, assoc]

example : (a * b * c)⁻¹ = c⁻¹ * b⁻¹ * a⁻¹ := by {
  apply eq.trans inv_two,
  rw assoc,
  -- needs to be automated! It is not too easy to see what's going on.
  -- Create equivalence classes of associativity => we can clean out "rw assoc" from proof
  apply mul_left,
  rw inv_two,
  -- have h5 : (a * b)⁻¹ = b⁻¹ * a⁻¹ := sorry,
  -- have h6 := mul_left h5 c⁻¹,
  -- have h := @inv_two a b,
  -- -- try to using eq.subst function (also known as '▸' substitution) instead of rewrite tactic.
  -- have h2 : (a * b)⁻¹ = a, sorry,
  -- type_check h,
  -- have h3 : a = b⁻¹ * a⁻¹ := h ▸ h2.symm,
  -- -- try to use pattern: have h3 : a = b⁻¹ * a⁻¹ := h ▸ _,
  -- rewrite h,
  -- exact assoc.symm,
}

example (h : b = a) : a = b := h ▸ (eq.refl b)
example (h₁ : b = a) (h₂ : b * b = c) : a * a = c := by { rw ←h₁, exact h₂ }
example (h₁ : b = a) (h₂ : b * b = c) : a * a = c := h₁ ▸ h₂ -- b = a ▸ b * b = c -> a * a = c
example (h₁ : b = a) (h₂ : b * b = c) : a * a = c := by {
  -- have h₃ := h₁ ▸ h₂, -- did not work because the expected type must be known
  have h₃ : a * a = c := h₁ ▸ h₂, -- type a * a = c and now it's known
  exact h₃,
}

lemma two_mul_example (m n : ℕ) :
  2 * m + n = m + n + m :=
calc  2 * m + n
    = (m + m) + n :
    by rewrite two_mul
... = m + n + m :
    by cc

-- Braid axioms:
axiom dist_comm : i.succ < j → B i * B j = B j * B i
-- axiom dist_comm' (h : i.succ < j) : B i * B j = B j * B i
axiom artin : B i * B i.succ * B i = B i.succ * B i * B i.succ

open nat
-- Braid lemmas:
lemma triv : (B i) * (B i)⁻¹ = e := inv

lemma inv_left₂ : a⁻¹ * a = e := by {
    -- rw ←@inv a, -- ⊢ a⁻¹ * a = a * a⁻¹
    -- rw (@inv a).symm,
    -- type_check (@id x),
    have m_left := λ x, (@id x).1.symm,
    have m_right := λ x, (@id x).2.symm,
    -- conv {
    --   trace_lhs,
    --   to_lhs,
    -- },
    -- rw m_left a⁻¹,
    -- rw ←@inv (a⁻¹ * a),
    rw (@inv a).symm,
    conv {
      to_lhs,
      rw m_left a⁻¹,
      rw ←@inv a,
    },
    conv {
      to_rhs,
      rw m_right a⁻¹,
    },
    -- how to ⊢ a * a⁻¹ * a⁻¹ * a = a * (a⁻¹ * e) -> ⊢ a * a⁻¹ * a⁻¹ * a = a * (a⁻¹ * a⁻¹) * a
  }

lemma inv_left₃ : a⁻¹ * a = e := by {
    have h := mul_right (@inv a) a,
    have h2 : e * a = a * e, from sorry,
    rw h2 at h,
    -- rw assoc at h,
    have h3 := (mul_left h a⁻¹),
    rw ←assoc at h3,
    rw ←@assoc a⁻¹ a e at h3,
    sorry,
  }

lemma inv_left₄ : a⁻¹ * a = e := by {
    have h1 := eq.refl a⁻¹,
    have h2 : a⁻¹ * e = a⁻¹, from sorry, clear h1,
    rw ←h2,
    rw ←@inv a,
    rw ←@assoc a⁻¹,
    rw @assoc (a⁻¹ * a),
  }
lemma inv_left₅ : a⁻¹ * a = e := by {
  have h1 := eq.refl a⁻¹,
  have h2 : a⁻¹ * e = a⁻¹, from sorry, clear h1,
  have h3 : a⁻¹ * (a * a⁻¹) = a⁻¹, rw inv, exact h2,
  -- ⊢ a⁻¹ * a = e
  -- ⊢ a⁻¹ * a * a⁻¹ = e * a⁻¹
  -- ⊢ a⁻¹ * a * a⁻¹ = a⁻¹ by id.left
  -- ⊢ a⁻¹ * e = a⁻¹ by inv: a * a⁻¹ = e
  -- ⊢ a⁻¹ = a⁻¹ by id.right
  sorry,
}

lemma inv_comm (h_comm : a * b = b * a) : a⁻¹ * b⁻¹ = b⁻¹ * a⁻¹ := by {
  have h₁ := mul_left h_comm a⁻¹,
  rw ←assoc at h₁,
  rw inv_left at h₁,
  rw id.left at h₁,
  have h₂ := mul_left h₁ b⁻¹,
  rw inv_left at h₂,
  rw ←assoc at h₂,
  rw ←assoc at h₂,
  have h₃ := mul_right (mul_right h₂ a⁻¹) b⁻¹,
  rw id.left at h₃,
  rw assoc at h₃,
  rw assoc at h₃,
  sorry, -- make branching between rewrite rules atomatic (we can compute graph of decisions)
}
-- h_comm : B i * B j = B j * B i
-- ⊢ (B i)⁻¹ * (B j)⁻¹ = (B j)⁻¹ * (B i)⁻¹

lemma dist_comm_inv :
i.succ < j → (B i)⁻¹ * (B j)⁻¹ = (B j)⁻¹ * (B i)⁻¹ := by {
  assume h_lt,
  have h_comm := @dist_comm i j h_lt,
  apply inv_comm h_comm,
}

example : b0 * b2 = b2 * b0 :=
  begin
    -- simp [dist_comm, lt.base, lt.step], -- not works
    -- rw dist_comm, simp [dist_comm, lt.base], -- but this works
    -- simp [dist_comm, lt.base]; simp [dist_comm, lt.base, id, inv], -- not works
    repeat { rw dist_comm, simp [lt.base], }, -- ok
  end

example : e * e = e := id.left -- or id.right
example : a * (e * a) = a * a := by rw id.left
example : a * e * a = a * a := by rw id.right
example : a * e * a * e = a * a := by rw [id.right, id.right]

example : a * b * b⁻¹ * a⁻¹ = e := by rw [@assoc a b b⁻¹, inv, id.right, inv] -- proof with id.right
example : a * b * b⁻¹ * a⁻¹ = e := by simp [id.right, inv, assoc]
example : a * b * b⁻¹ * a⁻¹ = e := by rw [@assoc a b b⁻¹, inv, @assoc a e a⁻¹, id.left, inv] -- proof with id.left
example : a * b * b⁻¹ * a⁻¹ = e := by simp [id.left, inv, assoc]
example : b0 * b2 * b2⁻¹ * b0⁻¹ = e := by rw [@assoc b0 b2 b2⁻¹, triv, id.right, triv]

example : b2 * b0 = b0 * b2 := (λ h, (dist_comm h).symm) (lt.base 1)
example : b0 * b2 = b2 * b0 := dist_comm (lt.base 1)
example : b1 * b3 = b3 * b1 := dist_comm (lt.base 2)
example : b0 * b3 = b3 * b0 := dist_comm (lt.step (lt.base 1))
example (h : i ≥ 2) : (B 0 * B i) = (B i * B 0) := dist_comm h
example : i ≥ 2 → (B 0 * B i) = (B i * B 0) := λ h, dist_comm h

-- base state:
example : b0 * b1 * b0 = b1 * b0 * b1 := @artin 0
example : (b0 * b1) = (b1 * b0) * b1 * b0⁻¹ := by {
  -- 1. (b0 * b1) = (b1 * b0) * b1 * b0⁻¹
  -- 2. (b1 * b0⁻¹) = (b0⁻¹ * b1) * b0⁻¹ * b1⁻¹

  -- 1. (b0 * b1) = (b1 * b0) * (b0⁻¹ * b1) * b0⁻¹ * b1⁻¹ by subst 2.
  -- 1. (b0 * b1) = (b1 * b1) * b0⁻¹ * b1⁻¹               by id
  -- 1. (b0 * b1) = (b1 * b1) * (b1 * b1⁻¹) * b0⁻¹ * b1⁻¹ by id
  -- 1. (b0 * b1) = (b1 * b1) * b1 * b0⁻¹ * b1⁻¹ * b0⁻¹   by artin
    sorry,
  }
-- second state:
example : b1 * b0 * b1 = b0 * b1 * b0 := (@artin 0).symm
example : (b1 * b0) = (b0 * b1) * b0 * b1⁻¹ := by {
    sorry,
  }

/-
b0 b1 b2 b1
b0 b2 b1 b2 : from artin 1
b2 b0 b1 b2 : from dist_comm 0 2 (⊢ 1 < 2) =  dist_comm 0 2 (lt.base 1)
-/
example : b0 * b1 * b2 * b1 * b2⁻¹ * b1⁻¹ * b0⁻¹ = b2 := by
  rw [
    @assoc b0,
    @assoc b0,
    @artin 1, -- from artin 1
    ←@assoc b0,
    ←@assoc b0,
    @dist_comm 0 2 (lt.base 1), -- from dist_comm 0 2 (⊢ 1 < 2)
    @assoc (b2 * b0 * b1),
    triv,
    id.right,
    @assoc (b2 * b0),
    triv,
    id.right,
    @assoc b2,
    triv,
    id.right
  ]

example : b0 * b1 * b2 * b1 * b2⁻¹ * b1⁻¹ * b0⁻¹ = b2 := by {
    -- backtracking example
    -- rw @assoc b0, rw dist_comm, -- => ⊢ 1.succ < 2 => one of goals is not provable
    -- rw @assoc (b0 * b1), rw dist_comm, -- => ⊢ 1 < 1 => is not provable
    -- rw [@assoc b0, @assoc b0], rw dist_comm, -- => ⊢ 1 < 1 => is not provable
    -- simp [@assoc (b0), @assoc (b0), artin], rw dist_comm, -- ⊢ 1.succ.succ < 1 => not provable
    rw [@assoc (b0), @assoc (b0), artin, ← @assoc b0, ← @assoc b0],
    rw dist_comm, -- ⊢ 1 < 2 is provable! by lt.base 1
    any_goals { simp [lt.base, triv, id.right, assoc], },
  }

namespace helping_stuff
#check lt.trans (lt.base 0) (lt.base 1) = lt.step (lt.base 0) -- 0 < 1, 1 < 2 = 0 < 2 [by lt.trans]
example : 0 < 1 ∧ 1 < 2 → 0 < 2 := λ h, lt.trans h.left h.right
example : 0 < 1 → 0 < 2 := @lt.step 0 1
example : 0 < 2 := lt.trans (lt.base 0) (lt.base 1)
example : 0 < 2 := @lt.step 0 1 (lt.base 0)
example (a : Prop) : (a → true) ↔ true := iff.intro (λ _, trivial) (λ _ _, trivial)
end helping_stuff

end braid
end hidden


theorem ex1 (a : α) (b : List α) : (a::b = []) = False :=
  by simp

theorem ex2 (a : α) (b : List α) : (a::b = []) = False :=
  by simp

theorem ex3 (x : Nat) : (if Nat.succ x = 0 then 1 else 2) = 2 :=
  by simp

theorem ex4 (x : Nat) : (if 10 = 0 then 1 else 2) = 2 :=
  by simp

theorem ex5 : (10 = 20) = False :=
  by simp

#print ex5

theorem ex6 : (if "hello" = "world" then 1 else 2) = 2 :=
  by simp

#print ex6

theorem ex7 : (if "hello" = "world" then 1 else 2) = 2 := by
  simp (config := { decide := false })
  simp

theorem ex8 : (10 + 2000 = 20) = False :=
  by simp

def fact : Nat → Nat
  | 0 => 1
  | x+1 => (x+1) * fact x

theorem ex9 : (if fact 100 > 10 then true else false) = true :=
  by simp


/-
Copyright © 2021 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri

! This file was ported from Lean 3 source module data.bundle
! leanprover-community/mathlib commit 9aba7801eeecebb61f58a5763c2b6dd1b47dc6ef
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Module.Basic

/-!
# Bundle
Basic data structure to implement fiber bundles, vector bundles (maybe fibrations?), etc. This file
should contain all possible results that do not involve any topology.

We represent a bundle `E` over a base space `B` as a dependent type `E : B → Type _`.

We provide a type synonym of `Σ x, E x` as `Bundle.TotalSpace E`, to be able to endow it with
a topology which is not the disjoint union topology `Sigma.TopologicalSpace`. In general, the
constructions of fiber bundles we will make will be of this form.

## Main Definitions

* `Bundle.TotalSpace` the total space of a bundle.
* `Bundle.TotalSpace.proj` the projection from the total space to the base space.
* `Bundle.totalSpaceMk` the constructor for the total space.

## References
- https://en.wikipedia.org/wiki/Bundle_(mathematics)
-/

namespace Bundle

variable {B : Type _} (E : B → Type _)

/-- `Bundle.TotalSpace E` is the total space of the bundle `Σ x, E x`.
This type synonym is used to avoid conflicts with general sigma types.
-/
def TotalSpace :=
  Σx, E x
#align bundle.total_space Bundle.TotalSpace

instance [Inhabited B] [Inhabited (E default)] : Inhabited (TotalSpace E) :=
  ⟨⟨default, default⟩⟩

variable {E}

/-- `bundle.TotalSpace.proj` is the canonical projection `Bundle.TotalSpace E → B` from the
total space to the base space. -/
@[simp, reducible]
def TotalSpace.proj : TotalSpace E → B :=
  Sigma.fst
#align bundle.total_space.proj Bundle.TotalSpace.proj

-- this notation won't be used in the pretty-printer
set_option quotPrecheck false in
/-- The canonical projection defining a bundle. -/
scoped notation "π" E => @Bundle.TotalSpace.proj _ E

/-- Constructor for the total space of a bundle. -/
@[simp, reducible]
def totalSpaceMk (b : B) (a : E b) : Bundle.TotalSpace E :=
  ⟨b, a⟩
#align bundle.total_space_mk Bundle.totalSpaceMk

theorem TotalSpace.proj_mk {x : B} {y : E x} : (totalSpaceMk x y).proj = x :=
  rfl
#align bundle.total_space.proj_mk Bundle.TotalSpace.proj_mk

theorem sigma_mk_eq_totalSpaceMk {x : B} {y : E x} : Sigma.mk x y = totalSpaceMk x y :=
  rfl
#align bundle.sigma_mk_eq_total_space_mk Bundle.sigma_mk_eq_totalSpaceMk

theorem TotalSpace.mk_cast {x x' : B} (h : x = x') (b : E x) :
    totalSpaceMk x' (cast (congr_arg E h) b) = totalSpaceMk x b := by
  subst h
  rfl
#align bundle.total_space.mk_cast Bundle.TotalSpace.mk_cast

theorem TotalSpace.eta (z : TotalSpace E) : totalSpaceMk z.proj z.2 = z :=
  Sigma.eta z
#align bundle.total_space.eta Bundle.TotalSpace.eta

instance {x : B} : CoeTC (E x) (TotalSpace E) :=
  ⟨totalSpaceMk x⟩

-- porting note: removed simp attribute, variable as head symbol
theorem coe_fst (x : B) (v : E x) : (v : TotalSpace E).fst = x :=
  rfl
#align bundle.coe_fst Bundle.coe_fst

-- porting note: removed simp attribute, variable as head symbol
theorem coe_snd {x : B} {y : E x} : (y : TotalSpace E).snd = y :=
  rfl
#align bundle.coe_snd Bundle.coe_snd

-- porting note: removed `to_total_space_coe`, syntactic tautology
#noalign bundle.to_total_space_coe

-- mathport name: «expr ×ᵇ »
/-- The direct sum of two bundles. -/
notation:100 -- notation for the direct sum of two bundles over the same base
E₁ " ×ᵇ " E₂ => fun x => E₁ x × E₂ x

/-- `Bundle.Trivial B F` is the trivial bundle over `B` of fiber `F`. -/
def Trivial (B : Type _) (F : Type _) : B → Type _ :=
  Function.const B F
#align bundle.trivial Bundle.Trivial

instance {F : Type _} [Inhabited F] {b : B} : Inhabited (Bundle.Trivial B F b) :=
  ⟨(default : F)⟩

/-- The trivial bundle, unlike other bundles, has a canonical projection on the fiber. -/
def Trivial.projSnd (B : Type _) (F : Type _) : TotalSpace (Bundle.Trivial B F) → F :=
  Sigma.snd
#align bundle.trivial.proj_snd Bundle.Trivial.projSnd

section Pullback

variable {B' : Type _}

/-- The pullback of a bundle `E` over a base `B` under a map `f : B' → B`, denoted by `Pullback f E`
or `f *ᵖ E`,  is the bundle over `B'` whose fiber over `b'` is `E (f b')`. -/
-- porting note: `has_nonempty_instance` linter not found
--  @[nolint has_nonempty_instance]
def Pullback (f : B' → B) (E : B → Type _) := fun x => E (f x)
#align bundle.pullback Bundle.Pullback

-- mathport name: «expr *ᵖ »
@[inherit_doc]
notation f " *ᵖ " E => Pullback f E

/-- Natural embedding of the total space of `f *ᵖ E` into `B' × TotalSpace E`. -/
@[simp]
def pullbackTotalSpaceEmbedding (f : B' → B) : TotalSpace (f *ᵖ E) → B' × TotalSpace E := fun z =>
  (z.proj, totalSpaceMk (f z.proj) z.2)
#align bundle.pullback_total_space_embedding Bundle.pullbackTotalSpaceEmbedding

/-- The base map `f : B' → B` lifts to a canonical map on the total spaces. -/
def Pullback.lift (f : B' → B) : TotalSpace (f *ᵖ E) → TotalSpace E := fun z =>
  totalSpaceMk (f z.proj) z.2
#align bundle.pullback.lift Bundle.Pullback.lift

@[simp]
theorem Pullback.proj_lift (f : B' → B) (x : TotalSpace (f *ᵖ E)) :
    (Pullback.lift f x).proj = f x.1 :=
  rfl
#align bundle.pullback.proj_lift Bundle.Pullback.proj_lift

@[simp]
theorem Pullback.lift_mk (f : B' → B) (x : B') (y : E (f x)) :
    Pullback.lift f (totalSpaceMk x y) = totalSpaceMk (f x) y :=
  rfl
#align bundle.pullback.lift_mk Bundle.Pullback.lift_mk

theorem pullbackTotalSpaceEmbedding_snd (f : B' → B) (x : TotalSpace (f *ᵖ E)) :
    (pullbackTotalSpaceEmbedding f x).2 = Pullback.lift f x :=
  rfl
#align bundle.pullback_total_space_embedding_snd Bundle.pullbackTotalSpaceEmbedding_snd

end Pullback

section FiberStructures

variable [∀ x, AddCommMonoid (E x)]

@[simp]
theorem coe_snd_map_apply (x : B) (v w : E x) :
    (↑(v + w) : TotalSpace E).snd = (v : TotalSpace E).snd + (w : TotalSpace E).snd :=
  rfl
#align bundle.coe_snd_map_apply Bundle.coe_snd_map_apply

variable (R : Type _) [Semiring R] [∀ x, Module R (E x)]

@[simp]
theorem coe_snd_map_smul (x : B) (r : R) (v : E x) :
    (↑(r • v) : TotalSpace E).snd = r • (v : TotalSpace E).snd :=
  rfl
#align bundle.coe_snd_map_smul Bundle.coe_snd_map_smul

end FiberStructures

section TrivialInstances

variable {F : Type _} {R : Type _} [Semiring R] (b : B)

instance [AddCommMonoid F] : AddCommMonoid (Bundle.Trivial B F b) :=
  ‹AddCommMonoid F›

instance [AddCommGroup F] : AddCommGroup (Bundle.Trivial B F b) :=
  ‹AddCommGroup F›

instance [AddCommMonoid F] [Module R F] : Module R (Bundle.Trivial B F b) :=
  ‹Module R F›


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Square root of natural numbers

An efficient binary implementation of a (`sqrt n`) function that
returns `s` such that
```
s*s ≤ n ≤ s*s + s + s
```
-/

namespace nat

theorem sqrt_aux_dec {b : ℕ} (h : b ≠ 0) : shiftr b (bit0 1) < b := sorry

/-- Auxiliary function for `nat.sqrt`. See e.g.
<https://en.wikipedia.org/wiki/Methods_of_computing_square_roots#Binary_numeral_system_(base_2)> -/
def sqrt_aux : ℕ → ℕ → ℕ → ℕ :=
  sorry

/-- `sqrt n` is the square root of a natural number `n`. If `n` is not a
  perfect square, it returns the largest `k:ℕ` such that `k*k ≤ n`. -/
def sqrt (n : ℕ) : ℕ :=
  sorry

theorem sqrt_aux_0 (r : ℕ) (n : ℕ) : sqrt_aux 0 r n = r := sorry

theorem sqrt_aux_1 {r : ℕ} {n : ℕ} {b : ℕ} (h : b ≠ 0) {n' : ℕ} (h₂ : r + b + n' = n) : sqrt_aux b r n = sqrt_aux (shiftr b (bit0 1)) (div2 r + b) n' := sorry

theorem sqrt_aux_2 {r : ℕ} {n : ℕ} {b : ℕ} (h : b ≠ 0) (h₂ : n < r + b) : sqrt_aux b r n = sqrt_aux (shiftr b (bit0 1)) (div2 r) n := sorry

theorem sqrt_le (n : ℕ) : sqrt n * sqrt n ≤ n :=
  and.left (sqrt_is_sqrt n)

theorem lt_succ_sqrt (n : ℕ) : n < Nat.succ (sqrt n) * Nat.succ (sqrt n) :=
  and.right (sqrt_is_sqrt n)

theorem sqrt_le_add (n : ℕ) : n ≤ sqrt n * sqrt n + sqrt n + sqrt n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n ≤ sqrt n * sqrt n + sqrt n + sqrt n)) (Eq.symm (succ_mul (sqrt n) (sqrt n)))))
    (le_of_lt_succ (lt_succ_sqrt n))

theorem le_sqrt {m : ℕ} {n : ℕ} : m ≤ sqrt n ↔ m * m ≤ n :=
  { mp := fun (h : m ≤ sqrt n) => le_trans (mul_self_le_mul_self h) (sqrt_le n),
    mpr := fun (h : m * m ≤ n) => le_of_lt_succ (iff.mpr mul_self_lt_mul_self_iff (lt_of_le_of_lt h (lt_succ_sqrt n))) }

theorem sqrt_lt {m : ℕ} {n : ℕ} : sqrt m < n ↔ m < n * n :=
  lt_iff_lt_of_le_iff_le le_sqrt

theorem sqrt_le_self (n : ℕ) : sqrt n ≤ n :=
  le_trans (le_mul_self (sqrt n)) (sqrt_le n)

theorem sqrt_le_sqrt {m : ℕ} {n : ℕ} (h : m ≤ n) : sqrt m ≤ sqrt n :=
  iff.mpr le_sqrt (le_trans (sqrt_le m) h)

theorem sqrt_eq_zero {n : ℕ} : sqrt n = 0 ↔ n = 0 := sorry

theorem eq_sqrt {n : ℕ} {q : ℕ} : q = sqrt n ↔ q * q ≤ n ∧ n < (q + 1) * (q + 1) := sorry

theorem le_three_of_sqrt_eq_one {n : ℕ} (h : sqrt n = 1) : n ≤ bit1 1 :=
  le_of_lt_succ (iff.mp sqrt_lt (eq.mpr (id (Eq._oldrec (Eq.refl (sqrt n < bit0 1)) h)) (of_as_true trivial)))

theorem sqrt_lt_self {n : ℕ} (h : 1 < n) : sqrt n < n :=
  iff.mpr sqrt_lt
    (eq.mp (Eq._oldrec (Eq.refl (n * 1 < n * n)) (mul_one n)) (nat.mul_lt_mul_of_pos_left h (lt_of_succ_lt h)))

theorem sqrt_pos {n : ℕ} : 0 < sqrt n ↔ 0 < n :=
  le_sqrt

theorem sqrt_add_eq (n : ℕ) {a : ℕ} (h : a ≤ n + n) : sqrt (n * n + a) = n := sorry

theorem sqrt_eq (n : ℕ) : sqrt (n * n) = n :=
  sqrt_add_eq n (zero_le (n + n))

theorem sqrt_succ_le_succ_sqrt (n : ℕ) : sqrt (Nat.succ n) ≤ Nat.succ (sqrt n) := sorry

theorem exists_mul_self (x : ℕ) : (∃ (n : ℕ), n * n = x) ↔ sqrt x * sqrt x = x := sorry

theorem sqrt_mul_sqrt_lt_succ (n : ℕ) : sqrt n * sqrt n < n + 1 :=
  iff.mpr lt_succ_iff (sqrt_le n)

theorem succ_le_succ_sqrt (n : ℕ) : n + 1 ≤ (sqrt n + 1) * (sqrt n + 1) :=
  le_of_pred_lt (lt_succ_sqrt (Nat.pred (n + 1)))

/-- There are no perfect squares strictly between m² and (m+1)² -/
theorem not_exists_sq {n : ℕ} {m : ℕ} (hl : m * m < n) (hr : n < (m + 1) * (m + 1)) : ¬∃ (t : ℕ), t * t = n := sorry


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.instances.ereal
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Rat.Encodable
import Mathlib.Data.Real.EReal
import Mathlib.Topology.Algebra.Order.MonotoneContinuity
import Mathlib.Topology.Instances.ENNReal

/-!
# Topological structure on `EReal`

We endow `EReal` with the order topology, and prove basic properties of this topology.

## Main results

* `Real.toEReal : ℝ → EReal` is an open embedding
* `ENNReal.toEReal : ℝ≥0∞ → EReal` is a closed embedding
* The addition on `EReal` is continuous except at `(⊥, ⊤)` and at `(⊤, ⊥)`.
* Negation is a homeomorphism on `EReal`.

## Implementation

Most proofs are adapted from the corresponding proofs on `ℝ≥0∞`.
-/

noncomputable section

open Classical Set Filter Metric TopologicalSpace Topology
open scoped ENNReal NNReal BigOperators Filter

variable {α : Type _} [TopologicalSpace α]

namespace EReal

instance : TopologicalSpace EReal := Preorder.topology EReal
instance : OrderTopology EReal := ⟨rfl⟩
instance : T5Space EReal := inferInstance
instance : T2Space EReal := inferInstance

lemma denseRange_ratCast : DenseRange (fun r : ℚ ↦ ((r : ℝ) : EReal)) :=
  dense_of_exists_between fun _ _ h => exists_range_iff.2 <| exists_rat_btwn_of_lt h

instance : SecondCountableTopology EReal :=
  have : SeparableSpace EReal := ⟨⟨_, countable_range _, denseRange_ratCast⟩⟩
  .of_separableSpace_orderTopology _

/-! ### Real coercion -/

theorem embedding_coe : Embedding ((↑) : ℝ → EReal) :=
  coe_strictMono.embedding_of_ordConnected <| by rw [range_coe_eq_Ioo]; exact ordConnected_Ioo
#align ereal.embedding_coe EReal.embedding_coe

theorem openEmbedding_coe : OpenEmbedding ((↑) : ℝ → EReal) :=
  ⟨embedding_coe, by simp only [range_coe_eq_Ioo, isOpen_Ioo]⟩
#align ereal.open_embedding_coe EReal.openEmbedding_coe

@[norm_cast]
theorem tendsto_coe {α : Type _} {f : Filter α} {m : α → ℝ} {a : ℝ} :
    Tendsto (fun a => (m a : EReal)) f (𝓝 ↑a) ↔ Tendsto m f (𝓝 a) :=
  embedding_coe.tendsto_nhds_iff.symm
#align ereal.tendsto_coe EReal.tendsto_coe

theorem _root_.continuous_coe_real_ereal : Continuous ((↑) : ℝ → EReal) :=
  embedding_coe.continuous
#align continuous_coe_real_ereal continuous_coe_real_ereal

theorem continuous_coe_iff {f : α → ℝ} : (Continuous fun a => (f a : EReal)) ↔ Continuous f :=
  embedding_coe.continuous_iff.symm
#align ereal.continuous_coe_iff EReal.continuous_coe_iff

theorem nhds_coe {r : ℝ} : 𝓝 (r : EReal) = (𝓝 r).map (↑) :=
  (openEmbedding_coe.map_nhds_eq r).symm
#align ereal.nhds_coe EReal.nhds_coe

theorem nhds_coe_coe {r p : ℝ} :
    𝓝 ((r : EReal), (p : EReal)) = (𝓝 (r, p)).map fun p : ℝ × ℝ => (↑p.1, ↑p.2) :=
  ((openEmbedding_coe.prod openEmbedding_coe).map_nhds_eq (r, p)).symm
#align ereal.nhds_coe_coe EReal.nhds_coe_coe

theorem tendsto_toReal {a : EReal} (ha : a ≠ ⊤) (h'a : a ≠ ⊥) :
    Tendsto EReal.toReal (𝓝 a) (𝓝 a.toReal) := by
  lift a to ℝ using ⟨ha, h'a⟩
  rw [nhds_coe, tendsto_map'_iff]
  exact tendsto_id
#align ereal.tendsto_to_real EReal.tendsto_toReal

theorem continuousOn_toReal : ContinuousOn EReal.toReal ({⊥, ⊤}ᶜ : Set EReal) := fun _a ha =>
  ContinuousAt.continuousWithinAt (tendsto_toReal (mt Or.inr ha) (mt Or.inl ha))
#align ereal.continuous_on_to_real EReal.continuousOn_toReal

/-- The set of finite `EReal` numbers is homeomorphic to `ℝ`. -/
def neBotTopHomeomorphReal : ({⊥, ⊤}ᶜ : Set EReal) ≃ₜ ℝ where
  toEquiv := neTopBotEquivReal
  continuous_toFun := continuousOn_iff_continuous_restrict.1 continuousOn_toReal
  continuous_invFun := continuous_coe_real_ereal.subtype_mk _
#align ereal.ne_bot_top_homeomorph_real EReal.neBotTopHomeomorphReal

/-! ### ennreal coercion -/

theorem embedding_coe_ennreal : Embedding ((↑) : ℝ≥0∞ → EReal) :=
  coe_ennreal_strictMono.embedding_of_ordConnected <| by
    rw [range_coe_ennreal]; exact ordConnected_Ici
#align ereal.embedding_coe_ennreal EReal.embedding_coe_ennreal

theorem closedEmbedding_coe_ennreal : ClosedEmbedding ((↑) : ℝ≥0∞ → EReal) :=
  ⟨embedding_coe_ennreal, by rw [range_coe_ennreal]; exact isClosed_Ici⟩

@[norm_cast]
theorem tendsto_coe_ennreal {α : Type _} {f : Filter α} {m : α → ℝ≥0∞} {a : ℝ≥0∞} :
    Tendsto (fun a => (m a : EReal)) f (𝓝 ↑a) ↔ Tendsto m f (𝓝 a) :=
  embedding_coe_ennreal.tendsto_nhds_iff.symm
#align ereal.tendsto_coe_ennreal EReal.tendsto_coe_ennreal

theorem _root_.continuous_coe_ennreal_ereal : Continuous ((↑) : ℝ≥0∞ → EReal) :=
  embedding_coe_ennreal.continuous
#align continuous_coe_ennreal_ereal continuous_coe_ennreal_ereal

theorem continuous_coe_ennreal_iff {f : α → ℝ≥0∞} :
    (Continuous fun a => (f a : EReal)) ↔ Continuous f :=
  embedding_coe_ennreal.continuous_iff.symm
#align ereal.continuous_coe_ennreal_iff EReal.continuous_coe_ennreal_iff

/-! ### Neighborhoods of infinity -/

theorem nhds_top : 𝓝 (⊤ : EReal) = ⨅ (a) (_h : a ≠ ⊤), 𝓟 (Ioi a) :=
  nhds_top_order.trans <| by simp only [lt_top_iff_ne_top]
#align ereal.nhds_top EReal.nhds_top

nonrec theorem nhds_top_basis : (𝓝 (⊤ : EReal)).HasBasis (fun _ : ℝ ↦ True) (Ioi ·) := by
  refine nhds_top_basis.to_hasBasis (fun x hx => ?_) fun _ _ ↦ ⟨_, coe_lt_top _, Subset.rfl⟩
  rcases exists_rat_btwn_of_lt hx with ⟨y, hxy, -⟩
  exact ⟨_, trivial, Ioi_subset_Ioi hxy.le⟩

theorem nhds_top' : 𝓝 (⊤ : EReal) = ⨅ a : ℝ, 𝓟 (Ioi ↑a) := nhds_top_basis.eq_infᵢ
#align ereal.nhds_top' EReal.nhds_top'

theorem mem_nhds_top_iff {s : Set EReal} : s ∈ 𝓝 (⊤ : EReal) ↔ ∃ y : ℝ, Ioi (y : EReal) ⊆ s :=
  nhds_top_basis.mem_iff.trans <| by simp only [true_and]
#align ereal.mem_nhds_top_iff EReal.mem_nhds_top_iff

theorem tendsto_nhds_top_iff_real {α : Type _} {m : α → EReal} {f : Filter α} :
    Tendsto m f (𝓝 ⊤) ↔ ∀ x : ℝ, ∀ᶠ a in f, ↑x < m a :=
  nhds_top_basis.tendsto_right_iff.trans <| by simp only [true_implies, mem_Ioi]
#align ereal.tendsto_nhds_top_iff_real EReal.tendsto_nhds_top_iff_real

theorem nhds_bot : 𝓝 (⊥ : EReal) = ⨅ (a) (_h : a ≠ ⊥), 𝓟 (Iio a) :=
  nhds_bot_order.trans <| by simp only [bot_lt_iff_ne_bot]
#align ereal.nhds_bot EReal.nhds_bot

theorem nhds_bot_basis : (𝓝 (⊥ : EReal)).HasBasis (fun _ : ℝ ↦ True) (Iio ·) := by
  refine nhds_bot_basis.to_hasBasis (fun x hx => ?_) fun _ _ ↦ ⟨_, bot_lt_coe _, Subset.rfl⟩
  rcases exists_rat_btwn_of_lt hx with ⟨y, -, hxy⟩
  exact ⟨_, trivial, Iio_subset_Iio hxy.le⟩

theorem nhds_bot' : 𝓝 (⊥ : EReal) = ⨅ a : ℝ, 𝓟 (Iio ↑a) :=
  nhds_bot_basis.eq_infᵢ
#align ereal.nhds_bot' EReal.nhds_bot'

theorem mem_nhds_bot_iff {s : Set EReal} : s ∈ 𝓝 (⊥ : EReal) ↔ ∃ y : ℝ, Iio (y : EReal) ⊆ s :=
  nhds_bot_basis.mem_iff.trans <| by simp only [true_and]
#align ereal.mem_nhds_bot_iff EReal.mem_nhds_bot_iff

theorem tendsto_nhds_bot_iff_real {α : Type _} {m : α → EReal} {f : Filter α} :
    Tendsto m f (𝓝 ⊥) ↔ ∀ x : ℝ, ∀ᶠ a in f, m a < x :=
  nhds_bot_basis.tendsto_right_iff.trans <| by simp only [true_implies, mem_Iio]
#align ereal.tendsto_nhds_bot_iff_real EReal.tendsto_nhds_bot_iff_real

/-! ### Continuity of addition -/

theorem continuousAt_add_top_coe (a : ℝ) :
    ContinuousAt (fun p : EReal × EReal => p.1 + p.2) (⊤, a) := by
  simp only [ContinuousAt, tendsto_nhds_top_iff_real, top_add_coe]
  refine fun r ↦ ((lt_mem_nhds (coe_lt_top (r - (a - 1)))).prod_nhds
    (lt_mem_nhds <| EReal.coe_lt_coe_iff.2 <| sub_one_lt _)).mono fun _ h ↦ ?_
  simpa only [← coe_add, sub_add_cancel] using add_lt_add h.1 h.2
#align ereal.continuous_at_add_top_coe EReal.continuousAt_add_top_coe

theorem continuousAt_add_coe_top (a : ℝ) :
    ContinuousAt (fun p : EReal × EReal => p.1 + p.2) (a, ⊤) := by
  simpa only [add_comm, (· ∘ ·), ContinuousAt, Prod.swap]
    using Tendsto.comp (continuousAt_add_top_coe a) (continuous_swap.tendsto ((a : EReal), ⊤))
#align ereal.continuous_at_add_coe_top EReal.continuousAt_add_coe_top

theorem continuousAt_add_top_top : ContinuousAt (fun p : EReal × EReal => p.1 + p.2) (⊤, ⊤) := by
  simp only [ContinuousAt, tendsto_nhds_top_iff_real, top_add_top]
  refine fun r ↦ ((lt_mem_nhds (coe_lt_top 0)).prod_nhds
    (lt_mem_nhds <| coe_lt_top r)).mono fun _ h ↦ ?_
  simpa only [coe_zero, zero_add] using add_lt_add h.1 h.2
#align ereal.continuous_at_add_top_top EReal.continuousAt_add_top_top

theorem continuousAt_add_bot_coe (a : ℝ) :
    ContinuousAt (fun p : EReal × EReal => p.1 + p.2) (⊥, a) := by
  simp only [ContinuousAt, tendsto_nhds_bot_iff_real, bot_add]
  refine fun r ↦ ((gt_mem_nhds (bot_lt_coe (r - (a + 1)))).prod_nhds
    (gt_mem_nhds <| EReal.coe_lt_coe_iff.2 <| lt_add_one _)).mono fun _ h ↦ ?_
  simpa only [← coe_add, sub_add_cancel] using add_lt_add h.1 h.2
#align ereal.continuous_at_add_bot_coe EReal.continuousAt_add_bot_coe

theorem continuousAt_add_coe_bot (a : ℝ) :
    ContinuousAt (fun p : EReal × EReal => p.1 + p.2) (a, ⊥) := by
  simpa only [add_comm, (· ∘ ·), ContinuousAt, Prod.swap]
    using Tendsto.comp (continuousAt_add_bot_coe a) (continuous_swap.tendsto ((a : EReal), ⊥))
#align ereal.continuous_at_add_coe_bot EReal.continuousAt_add_coe_bot

theorem continuousAt_add_bot_bot : ContinuousAt (fun p : EReal × EReal => p.1 + p.2) (⊥, ⊥) := by
  simp only [ContinuousAt, tendsto_nhds_bot_iff_real, bot_add]
  refine fun r ↦ ((gt_mem_nhds (bot_lt_coe 0)).prod_nhds
    (gt_mem_nhds <| bot_lt_coe r)).mono fun _ h ↦ ?_
  simpa only [coe_zero, zero_add] using add_lt_add h.1 h.2
#align ereal.continuous_at_add_bot_bot EReal.continuousAt_add_bot_bot

/-- The addition on `EReal` is continuous except where it doesn't make sense (i.e., at `(⊥, ⊤)`
and at `(⊤, ⊥)`). -/
theorem continuousAt_add {p : EReal × EReal} (h : p.1 ≠ ⊤ ∨ p.2 ≠ ⊥) (h' : p.1 ≠ ⊥ ∨ p.2 ≠ ⊤) :
    ContinuousAt (fun p : EReal × EReal => p.1 + p.2) p := by
  rcases p with ⟨x, y⟩
  induction x using EReal.rec <;> induction y using EReal.rec
  · exact continuousAt_add_bot_bot
  · exact continuousAt_add_bot_coe _
  · simp at h'
  · exact continuousAt_add_coe_bot _
  · exact continuousAt_add_coe_coe _ _
  · exact continuousAt_add_coe_top _
  · simp at h
  · exact continuousAt_add_top_coe _
  · exact continuousAt_add_top_top
#align ereal.continuous_at_add EReal.continuousAt_add

/-! ### Negation -/

instance : ContinuousNeg EReal := ⟨negOrderIso.continuous⟩

/-- Negation on `EReal` as a homeomorphism -/
@[deprecated Homeomorph.neg]
def negHomeo : EReal ≃ₜ EReal :=
  negOrderIso.toHomeomorph
#align ereal.neg_homeo EReal.negHomeo

@[deprecated continuous_neg]
protected theorem continuous_neg : Continuous fun x : EReal => -x :=
  continuous_neg
#align ereal.continuous_neg EReal.continuous_neg

end EReal


/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import data.real.basic
import number_theory.function_field
import ring_theory.tensor_product
import function_field
import topology.metric_space.basic

/-!
# The ring of adèles of a function field
We define the ring of finite adèles and the ring of adèles of a function field, both of which are
topological commutative rings.

## Main definitions
- `function_field.A_F_f` : The finite adèle ring of the function field `F`.
- `function_field.A_F`   : The adèle ring of the function field `F`.
- `function_field.inj_F_f` : The map from `K` to `A_F_f k F` sending `k ∈ K ↦ (k)_v`
- `function_field.inj_F` :  The map from `K` to `A_F k F` sending `k ∈ K ↦ ((k)_v, 1 ⊗ k)`.

## Main results
- `function_field.inj_F_f.injective` : The map `inj_F_f` is injective.
- `function_field.inj_F_f.ring_hom` : The injection `inj_F_f` is a ring homomorphism from `K` to
  `A_F_f k F`. Hence we can regard `K` as a subring of `A_F_f k F`.
- `function_field.inj_F.injective` : The map `inj_F` is injective.
- `function_field.inj_F.ring_hom` : The injection `inj_F` is a ring homomorphism from `K` to
  `A_F k F`. Hence we can regard `K` as a subring of `A_F k F`.

## References
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]

## Tags
adèle ring, function field
-/

noncomputable theory

open function

open_locale tensor_product polynomial

namespace function_field
/-! ### The adèle ring of a function field
We define the (finite) adèle ring of a function field `F`, with its topological ring structure. -/
variables (k F : Type) [field k] [field F] [algebra (polynomial k) F] [algebra (ratfunc k) F]
  [function_field k F] [is_scalar_tower (polynomial k) (ratfunc k) F]
  [is_separable (ratfunc k) F]

instance : algebra (ratfunc k) (kt_infty k) := ring_hom.to_algebra
  (@uniform_space.completion.coe_ring_hom (ratfunc k) _ (usq' k) (trq' k) (ugq' k))

/-- The finite adèle ring of `F`.-/
def A_F_f := finite_adele_ring' (ring_of_integers k F) F
/-- The finite adèle ring of `F`.-/
def A_F := (A_F_f k F) × ((kt_infty k) ⊗[ratfunc k] F)

open_locale big_operators

/-- `F` is isomorphic to `k(t)^(dim_(F_q(t))(F))`. -/
def linear_equiv.kt_basis :
  (fin (finite_dimensional.finrank (ratfunc k) F) → (ratfunc k)) ≃ₗ[(ratfunc k)] F :=
linear_equiv.symm (basis.equiv_fun (finite_dimensional.fin_basis (ratfunc k) F))

/-- The natural linear map from `k((t⁻¹))^n` to `k((t⁻¹)) ⊗[k(t)] k(t)^n`. -/
def linear_map.kt_inftyn_to_kt_infty_tensor_ktn (n : ℕ):
  (fin n → (kt_infty k)) →ₗ[(kt_infty k)]
    ((kt_infty k) ⊗[(ratfunc k)] (fin n→ (ratfunc k))) :=
{ to_fun    := λ x, ∑ (m : fin n), tensor_product.mk _ _ _ (x m)
    (λ m : (fin n), (1 : (ratfunc k))),
  map_add'  := λ x y, by simp only [map_add, tensor_product.mk_apply, pi.add_apply,
    linear_map.add_apply, finset.sum_add_distrib],
  map_smul' := λ r x, begin
    simp only [tensor_product.mk_apply, ring_hom.id_apply, pi.smul_apply, finset.smul_sum], refl,
end, }

/-- The linear map from `k((t⁻¹)) ⊗[k(t)] k(t)^(dim_(F_q(t))(F))` to `k((t⁻¹)) ⊗[k(t)] F`
obtained as a base change of `linear_equiv.kt_basis`. -/
def linear_map.base_change : ((kt_infty k) ⊗[ratfunc k]
  (fin (finite_dimensional.finrank (ratfunc k) F) → ratfunc k)) →ₗ[kt_infty k]
    ((kt_infty k) ⊗[ratfunc k] F) :=
linear_map.base_change (kt_infty k) (linear_equiv.kt_basis k F).to_linear_map

/-- The resulting linear map from `k((t⁻¹))^(dim_(F_q(t))(F))` to `k((t⁻¹)) ⊗[k(t)] F`. -/
def linear_map.kt_inftyn_to_kt_infty_tensor_F : (fin (finite_dimensional.finrank (ratfunc k) F) →
  (kt_infty k)) →ₗ[kt_infty k] ((kt_infty k) ⊗[ratfunc k] F) :=
linear_map.comp (linear_map.base_change k F) (linear_map.kt_inftyn_to_kt_infty_tensor_ktn k _)

instance : comm_ring (A_F_f k F) := finite_adele_ring'.comm_ring (ring_of_integers k F) F
instance : comm_ring (A_F k F) := prod.comm_ring
instance : inhabited (A_F_f k F) := ⟨0⟩
instance : inhabited (A_F k F) := ⟨0⟩
instance : topological_space (A_F_f k F) :=
finite_adele_ring'.topological_space (ring_of_integers k F) F
instance : topological_ring (A_F_f k F) :=
finite_adele_ring'.topological_ring (ring_of_integers k F) F
/-- The topological ring structure on the infinite places of `F`. -/
def infinite_adeles.ring_topology : ring_topology ((kt_infty k) ⊗[ratfunc k] F) :=
ring_topology.coinduced (linear_map.kt_inftyn_to_kt_infty_tensor_F k F)
instance : topological_space ((kt_infty k) ⊗[ratfunc k] F) :=
(infinite_adeles.ring_topology k F).to_topological_space
instance : topological_ring ((kt_infty k) ⊗[ratfunc k] F) :=
(infinite_adeles.ring_topology k F).to_topological_ring
instance : topological_space (A_F k F) := prod.topological_space
instance : topological_ring (A_F k F) := prod.topological_ring

lemma algebra_map_injective :
  function.injective ⇑(algebra_map k[X] (ring_of_integers k F)) :=
begin
  have hinj : function.injective ⇑(algebra_map k[X] F),
  { rw is_scalar_tower.algebra_map_eq k[X] (ratfunc k) F,
    exact function.injective.comp ((algebra_map (ratfunc k) F).injective)
      (is_fraction_ring.injective k[X] (ratfunc k)), },
  rw [ring_hom.injective_iff_ker_eq_bot, ring_hom.ker_eq_bot_iff_eq_zero],
  intros p hp,
  rw [← subtype.coe_inj, subalgebra.coe_zero] at hp,
  rw [ring_hom.injective_iff_ker_eq_bot, ring_hom.ker_eq_bot_iff_eq_zero] at hinj,
  exact hinj p hp,
end

/-- The ring of integers of polynomials over `k` is not a field. -/
lemma kX_not_is_field : ¬ is_field k[X] :=
begin
  nontriviality k,
  rw ring.not_is_field_iff_exists_ideal_bot_lt_and_lt_top,
  use ideal.span {polynomial.X},
  split,
  { rw [bot_lt_iff_ne_bot, ne.def, ideal.span_singleton_eq_bot],
    exact polynomial.X_ne_zero, },
  { rw [lt_top_iff_ne_top, ne.def, ideal.eq_top_iff_one, ideal.mem_span_singleton,
      polynomial.X_dvd_iff, polynomial.coeff_one_zero],
    exact one_ne_zero, }
end

/-- The ring of integers of a function field is not a field. -/
lemma not_is_field : ¬ is_field (ring_of_integers k F) :=
by simpa [← (is_integral.is_field_iff_is_field
  (is_integral_closure.is_integral_algebra k[X] F)
  (algebra_map_injective k F))] using (kX_not_is_field k)

/-- There exists a nonzero prime ideal of the ring of integers of a function field. -/
instance : inhabited (maximal_spectrum (ring_of_integers k F)) :=
begin
  set M := classical.some(ideal.exists_maximal (ring_of_integers k F)) with hM_def,
  set hM := classical.some_spec(ideal.exists_maximal (ring_of_integers k F)),
  use [M, ideal.is_maximal.is_prime hM],
  { simp only [ideal.zero_eq_bot, ne.def],
    apply ring.ne_bot_of_is_maximal_of_not_is_field hM (not_is_field k F), }
end

/-- The map from `F` to `A_F_f k F` sending `x ∈ F ↦ (x)_v`. -/
def inj_F_f : F → A_F_f k F := inj_K (ring_of_integers k F) F

lemma inj_F_f.injective : injective (inj_F_f k F) := inj_K.injective _ _

/-- The injection `inj_F_f` is a ring homomorphism from `F` to `A_F_f k F`. Hence we can regard `F`
as a subring of `A_F_f k F`. -/
def inj_F_f.ring_hom : ring_hom F (A_F_f k F) := inj_K.ring_hom (ring_of_integers k F) F

lemma inj_F_f.ring_hom.v_comp (v : maximal_spectrum (ring_of_integers k F)) (x : F) :
  ((inj_F_f.ring_hom k F) x).val v = (coe : F → v.adic_completion F) x := rfl

/-- The map from `F` to `A_F k F` sending `x ∈ F ↦ ((x)_v, 1 ⊗ x)`. -/
def inj_F : F → A_F k F := λ x, ⟨inj_F_f k F x, algebra.tensor_product.include_right x⟩

lemma inj_F.injective : injective (inj_F k F) :=
begin
  intros x y hxy,
  rw [inj_F, prod.mk.inj_iff] at hxy,
  exact inj_F_f.injective k F hxy.1,
end

/-- The injection `inj_F` is a ring homomorphism from `F` to `A_F k F`. Hence we can regard `F`
as a subring of `A_F k F`. -/
def inj_F.ring_hom : ring_hom F (A_F k F) :=
ring_hom.prod (inj_F_f.ring_hom k F)
  (@algebra.tensor_product.include_right (ratfunc k) _ (kt_infty k) _ _ F _ _ )

end function_field