import tactic.find data.nat.prime algebra.group_power tactic.ring data.set.finite
  .disjoint_finset data.int.modeq
universes u v
variables {α : Type u} {β : Type v}

open nat finset equiv int.modeq nat int
local attribute [instance, priority 0] classical.prop_decidable

lemma int.mod_two_eq_zero_or_one (n : ℤ) : n % 2 = 0 ∨ n % 2 = 1 :=
have h : n % 2 < 2 := abs_of_nonneg (show (2 : ℤ) ≥ 0, from dec_trivial) ▸ int.mod_lt _ dec_trivial,
have h₁ : n % 2 ≥ 0 := int.mod_nonneg _ dec_trivial,
match (n % 2), h, h₁ with
| (0 : ℕ)     := λ _ _, or.inl rfl
| (1 : ℕ)     := λ _ _, or.inr rfl
| (k + 2 : ℕ) := λ h _, absurd h dec_trivial
| -[1+ a]     := λ _ h₁, absurd h₁ dec_trivial
end

lemma nat.sub_le_self (a b : ℕ) : a - b ≤ a := nat.sub_le_sub_left _ (zero_le _)

lemma nat.div_mul_le (a) {b} (hb : 0 < b) : a / b * b ≤ a :=
have h : 0 + a / b * b ≤ a % b + a / b * b := add_le_add (zero_le _) (le_refl _),
by rwa [zero_add, mul_comm, nat.mod_add_div, mul_comm] at h

lemma int.coe_nat_nonneg (n : ℕ) : (0 : ℤ) ≤ n := int.coe_nat_le.2 (zero_le _)

lemma nat.mul_pow (a b n : ℕ) : (a * b) ^ n = a ^ n * b ^ n :=
by induction n; simp [*, nat.pow_succ, mul_comm, mul_assoc, mul_left_comm]

lemma nat.dvd_of_pow_dvd_pow : ∀ {a b n : ℕ}, 0 < n → a ^ n ∣ b ^ n → a ∣ b
| a 0     := λ n hn h, dvd_zero _
| a (b+1) := λ n hn h,
let d := nat.gcd a (b + 1) in
have hd : nat.gcd a (b + 1) = d := rfl,
  match d, hd with
  | 0 := λ hd, (eq_zero_of_gcd_eq_zero_right hd).symm ▸ dvd_zero _
  | 1 := λ hd,
    begin
      have h₁ : a ^ n = 1 := coprime.eq_one_of_dvd (coprime.pow n n hd) h,
      have := pow_dvd_pow a hn,
      rw [nat.pow_one, h₁] at this,
      exact dvd.trans this (one_dvd _),
    end
  | (d+2) := λ hd,
    have (b+1) / (d+2) < (b+1) := div_lt_self dec_trivial dec_trivial,
    have ha : a = (d+2) * (a / (d+2)) :=
      by rw [← hd, nat.mul_div_cancel' (gcd_dvd_left _ _)],
    have hb : (b+1) = (d+2) * ((b+1) / (d+2)) :=
      by rw [← hd, nat.mul_div_cancel' (gcd_dvd_right _ _)],
    have a / (d+2) ∣ (b+1) / (d+2) := nat.dvd_of_pow_dvd_pow hn $ dvd_of_mul_dvd_mul_left
      (show (d + 2) ^ n > 0, from pos_pow_of_pos _ dec_trivial)
      (by rwa [← nat.mul_pow, ← nat.mul_pow, ← ha, ← hb]),
    by rw [ha, hb];
    exact mul_dvd_mul_left _ this
  end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf psigma.snd⟩]}

lemma int.nat_abs_pow (a : ℤ) (n : ℕ) : a.nat_abs ^ n = (a ^ n).nat_abs :=
by induction n; simp [*, nat.pow_succ, _root_.pow_succ, nat_abs_mul, mul_comm]

lemma int.dvd_of_pow_dvd_pow {a b : ℤ} {n : ℕ} (hn : 0 < n) (h : a ^ n ∣ b ^ n) : a ∣ b :=
begin
  rw [← nat_abs_dvd, ← dvd_nat_abs, ← int.nat_abs_pow, ← int.nat_abs_pow, int.coe_nat_dvd] at h,
  rw [← nat_abs_dvd, ← dvd_nat_abs, int.coe_nat_dvd],
  exact nat.dvd_of_pow_dvd_pow hn h
end

@[simp] lemma int.mod_mod (a b : ℤ) : a % b % b = a % b :=
or.cases_on (classical.em (b = 0)) (by simp {contextual := tt})
(λ h, int.mod_abs (a % b) b ▸ int.mod_eq_of_lt (int.mod_nonneg _ h) (int.mod_lt _ h))

lemma nat.pow_two (n : ℕ) : n ^ 2 = n * n := by simp [nat.pow_succ, nat.pow_zero]

lemma nat.cast_div [division_ring α] [char_zero α] {n m : ℕ} (h : n ∣ m) (hn : n ≠ 0) :
    ((m / n : ℕ) : α) = (m : α) / n :=
eq.symm ((div_eq_iff_mul_eq (by rwa nat.cast_ne_zero)).2 (by rw [← nat.cast_mul, nat.div_mul_cancel h]))

lemma nat.cast_div_le [linear_ordered_field α] {n m : ℕ} (hm : 0 < m) : ((n / m : ℕ) : α) ≤ (n / m : α) :=
le_of_mul_le_mul_right
  (calc ((n / m : ℕ) : α) * m ≤ n : by rw [← nat.cast_mul, nat.cast_le]; exact nat.div_mul_le _ hm
    ... =  (n / m : α) * m : (div_mul_cancel (n : α) (ne_of_lt (nat.cast_lt.2 hm)).symm).symm)
  (nat.cast_lt.2 hm)

lemma nat.prime.eq_two_or_odd {p : ℕ} (hp : prime p) : p = 2 ∨ p % 2 = 1 :=
or.cases_on (nat.mod_two_eq_zero_or_one p)
  (λ h, or.inl (or.resolve_left (hp.2 _ (nat.dvd_of_mod_eq_zero h)) dec_trivial).symm)
  or.inr

lemma nat.prime.odd_iff_ge_three {p : ℕ} (hp : prime p) : p % 2 = 1 ↔ 3 ≤ p :=
⟨λ hpo, succ_le_of_lt (lt_of_le_of_ne hp.1 (λ h, by rw ← h at hpo; exact absurd hpo dec_trivial)),
λ hp3, or.cases_on (mod_two_eq_zero_or_one p)
  (λ h, or.cases_on (hp.2 _ (nat.dvd_of_mod_eq_zero h)) (λ h2, absurd h2 dec_trivial)
    (λ h1, by rw ← h1 at hp3; exact absurd hp3 dec_trivial)) id⟩

lemma int.cast_div [division_ring α] [char_zero α] {i j : ℤ} (h : j ∣ i) (hj : j ≠ 0) :
  ((i / j : ℤ) : α) = (i : α) / j :=
eq.symm ((div_eq_iff_mul_eq (by rwa int.cast_ne_zero)).2 (by rw [← int.cast_mul, int.div_mul_cancel h]))

lemma int.add_div {i j : ℤ} (k : ℤ) (h : j ∣ i) (hk : j ≠ 0) :
  i / j + k / j = (i + k) / j :=
(domain.mul_left_inj hk).1
(let ⟨m, hm⟩ := exists_eq_mul_left_of_dvd h in
by rw [hm, mul_add, add_comm _ k, int.add_mul_div_right _ _ hk,
    int.mul_div_cancel _ hk, mul_add, add_comm])

private lemma mul_self_mod_injective_of_le_half_prime_aux {p : ℕ} (hp : prime p) (hpo : p % 2 = 1)
  (a b : fin (succ (p / 2))) (h₁ :a.1 ≤ b.1) (h : (a.1 : ℕ) * a.1 ≡ b.1 * b.1 [MOD p]) :
  a = b :=
begin
  have : ∀ i j : ℤ, i * i - j * j = (i - j) * (i + j) := λ i j, by ring,
  have h₃ : p ∣ b.val - a.val ∨ p ∣ b.val + a.val := by
    rwa [nat.modeq.modeq_iff_dvd, int.coe_nat_mul, int.coe_nat_mul, this, ← int.coe_nat_sub h₁,
      ← int.coe_nat_add, ← int.coe_nat_mul, int.coe_nat_dvd, hp.dvd_mul] at h,
  by_contra hab,
  have hab' := fin.vne_of_ne hab,
  cases h₃ with h₃ h₃,
  { have : p < p :=
      calc p ≤ b.1 - a.1 : le_of_dvd (nat.pos_of_ne_zero (λ h₂, hab'
          (le_antisymm h₁ (nat.sub_eq_zero_iff_le.1 h₂)))) h₃
          ... ≤ b.1   : nat.sub_le_sub_left _ (zero_le _)
          ... ≤ p / 2 : le_of_lt_succ b.2
          ... < p     : nat.div_lt_self hp.pos (lt_succ_self _),
    exact lt_irrefl _ this },
  { have : 0 < b.1 + a.1,
    { cases a.1,
      exact nat.pos_of_ne_zero hab'.symm,
      exact succ_pos _ },
    have : p < p :=
      calc p ≤ b.1 + a.1 :  le_of_dvd this h₃
          ... ≤ p / 2 + p / 2 : add_le_add (le_of_lt_succ b.2) (le_of_lt_succ a.2)
          ... < p : by conv {to_rhs, rw [← nat.mod_add_div p 2, hpo, add_comm, two_mul]};
          exact lt_succ_self _,
    exact lt_irrefl _ this }
end

lemma mul_self_mod_injective_of_le_half_prime {p : ℕ} (hp : prime p) (hpo : p % 2 = 1) : function.injective
  (λ a : fin (succ (p / 2)), (a.1 : ℕ) * a.1 % p) :=
λ a b h, (le_total a.1 b.1).elim (λ h₁, mul_self_mod_injective_of_le_half_prime_aux hp hpo a b h₁ h)
 (λ h₁, eq.symm (mul_self_mod_injective_of_le_half_prime_aux hp hpo b a h₁ h.symm))

lemma neg_mul_self_mod_add_one_injective_of_le_half_prime {p : ℕ} (hp : prime p) (hpo : p % 2 = 1) :
  function.injective (λ a : fin (succ (p / 2)), ((-(((a.1 : ℕ) * a.1) + 1 : ℕ) : ℤ) % p).to_nat) :=
λ ⟨x, hx⟩ ⟨y, hy⟩ (hxy : int.to_nat _ = int.to_nat _),
have hp0 : (p : ℤ) ≠ 0 := λ (h : (p : ℤ) = (0 : ℕ)),
    by have := hp.pos; rw int.coe_nat_inj h at this; exact lt_irrefl _ this,
begin
  rw [← int.coe_nat_eq_coe_nat_iff, int.to_nat_of_nonneg (int.mod_nonneg _ hp0),
      int.to_nat_of_nonneg (int.mod_nonneg _ hp0)] at hxy,
  have := int.dvd_of_mod_eq_zero (int.mod_eq_mod_iff_mod_sub_eq_zero.1 hxy),
  rw [sub_neg_eq_add, add_comm, ← sub_eq_add_neg] at this,
  exact mul_self_mod_injective_of_le_half_prime hp hpo
    (nat.modeq.modeq_add_cancel_right rfl (nat.modeq.modeq_iff_dvd.2 this)),
end

lemma modeq_two_square_self (a : ℤ) : a * a ≡ a [ZMOD 2] :=
or.cases_on (int.mod_two_eq_zero_or_one a)
  (λ h, have h' : a ≡ 0 [ZMOD 2] := h,
    ((show a * a ≡ 0 * 0 [ZMOD 2], from modeq_mul h' h').trans h'.symm))
  (λ h, @eq.subst _ (λ b, a * a ≡ b [ZMOD 2]) _ _ (mul_one a)
    (int.modeq.modeq_mul rfl h))

lemma sum_two_squares_of_sum_two_squares_two_mul {n a b : ℤ} (h : a * a + b * b = 2 * n) :
    ∃ c d : ℤ, c * c + d * d = n :=
have hs : a * a + b * b ≡ 0 [ZMOD 2] := int.modeq.modeq_zero_iff.2 (h.symm ▸ dvd_mul_right _ _),
have hadd : (2 : ℤ) ∣ a + b := int.modeq.modeq_zero_iff.1 (int.modeq.trans
    (int.modeq.modeq_add (modeq_two_square_self _).symm (modeq_two_square_self _).symm) hs),
have hsub : (2 : ℤ) ∣ a - b :=
begin
  have : a - b = (a + b) + 2 * -b := by ring,
  rw this,
  exact dvd_add hadd (dvd_mul_right _ _),
end,
have h2 : (2 : ℤ) ≠ 0 := by norm_num,
⟨(a + b) / 2, (a - b) / 2,
  (domain.mul_left_inj h2).1
    (calc 2 * (((a + b) / 2) * ((a + b) / 2) + (a - b) / 2 * ((a - b) / 2))
        = (a + b) * ((a + b) / 2) + (a - b) * ((a - b) / 2) :
          by rw [mul_add (2 : ℤ), ← mul_assoc, ← mul_assoc, int.mul_div_cancel' hadd,
           int.mul_div_cancel' hsub]
    ... = a * a + b * b :
      (domain.mul_right_inj h2).1
        (by simp only [add_mul, mul_assoc _ _ (2 : ℤ), int.div_mul_cancel hadd,
              int.div_mul_cancel hsub]; ring)
    ... = 2 * n : h ▸ by simp [nat.pow_succ, int.coe_nat_mul, int.coe_nat_add])⟩

open finset function

lemma surjective_of_injective_of_equiv [fintype α] {f : α → β} (e : α ≃ β)
    (hinj : injective f) : surjective f :=
by haveI : fintype β := fintype.of_equiv _ e; exact
λ x, have h₁ : image f univ = univ := eq_of_subset_of_card_le (subset_univ _)
  ((card_image_of_injective univ hinj).symm ▸ show fintype.card β ≤ fintype.card α,
    from fintype.card_congr e ▸ le_refl _),
have h₂ : x ∈ image f univ := h₁.symm ▸ mem_univ _,
exists_of_bex (mem_image.1 h₂)

lemma injective_of_surjective_of_equiv [fintype α] {f : α → β} (e : α ≃ β)
    (hsurj : surjective f) : injective f :=
by haveI : fintype β := fintype.of_equiv _ e; exact
injective_of_has_left_inverse ⟨surj_inv hsurj,
  left_inverse_of_surjective_of_right_inverse (surjective_of_injective_of_equiv
    e.symm (injective_surj_inv hsurj)) (right_inverse_surj_inv hsurj)⟩

lemma bla12 {p : ℕ} (hp : prime p) (hpo : p % 2 = 1) :
  ∃ a b : fin (succ (p / 2)), p ∣ a.1 * a.1 + b.1 * b.1 + 1 :=
have hp0 : (p : ℤ) ≠ 0 := (ne_of_lt (int.coe_nat_lt.2 hp.pos)).symm,
let s := image (λ a : fin (succ (p / 2)), a.val * a.val % p) univ in
let t := image (λ a : fin (succ (p / 2)),
  to_nat (-↑(a.val * a.val + 1) % ↑p)) univ in
have hs : card s = fintype.card _ := card_image_of_injective
  univ (mul_self_mod_injective_of_le_half_prime hp hpo),
have ht : card t = fintype.card _:= card_image_of_injective
  univ (neg_mul_self_mod_add_one_injective_of_le_half_prime hp hpo),
have hsp : s ⊆ range p :=
  λ x hx, let ⟨y, hy₁, hy₂⟩ := mem_image.1 hx in
  hy₂ ▸ mem_range.2 (mod_lt _ hp.pos),
have htp : t ⊆ range p :=
  λ x hx, let ⟨y, hy₁, hy₂⟩ := mem_image.1 hx in
  hy₂ ▸ mem_range.2 (int.coe_nat_lt.1 (by rw int.to_nat_of_nonneg (int.mod_nonneg _ hp0);
    exact int.mod_lt_of_pos _ (int.coe_nat_lt.2 hp.pos))),
have hd : ¬ finset.disjoint s t := λ h, begin
  have := card_le_of_subset (union_subset hsp htp),
  rw fintype.card_fin at hs ht,
  rw [card_disjoint_union h, hs, ht, card_range, ← two_mul, ← one_add, mul_add] at this,
  conv at this { to_rhs, rw [← nat.mod_add_div p 2] },
  exact not_lt_of_ge (le_of_add_le_add_right this) (mod_lt _ (succ_pos _)),
end,
let ⟨n, hn⟩ := classical.not_forall.1 hd in
begin
  rw [not_imp, not_imp] at hn,
  rcases (mem_image.1 hn.1  ) with ⟨a, _, ha⟩,
  rcases (mem_image.1 hn.2.1) with ⟨b, _, hb⟩,
  existsi [a, b],
  rw [← int.coe_nat_dvd, add_assoc, int.coe_nat_add, ← sub_neg_eq_add,
      int.dvd_iff_mod_eq_zero, ← int.mod_eq_mod_iff_mod_sub_eq_zero, ← int.coe_nat_mod,
      ← int.to_nat_of_nonneg (int.mod_nonneg _ hp0), hb, ha]
end

private def mod_sub_half (n m : ℤ) : ℤ := if ((n % m : ℤ) : ℚ) ≤ m / 2 then (n : ℤ) % m else n % m - m

private lemma mod_sub_half_modeq {n m : ℤ} (hm : 0 < m) : mod_sub_half n m ≡ n [ZMOD m] :=
or.cases_on (classical.em (((n % m : ℤ) : ℚ) ≤ m / 2)) (λ h, begin
  rw [mod_sub_half, if_pos h],
  exact int.mod_mod _ _,
end)
(λ h, begin
  rw [mod_sub_half, if_neg h],
  conv {to_rhs, skip, rw ← sub_zero (n : ℤ)},
  exact int.modeq.modeq_sub (int.mod_mod _ _) (int.modeq.modeq_zero_iff.2 (dvd_refl _)),
end)

private lemma mod_sub_half_square {n m : ℤ} (hm : 0 < m) : mod_sub_half n m * mod_sub_half n m ≡ n * n [ZMOD m] :=
int.modeq.modeq_mul (mod_sub_half_modeq hm) (mod_sub_half_modeq hm)

private lemma mod_sub_half_eq_zero {n m : ℤ} (hm : 0 < m) (h : mod_sub_half n m * mod_sub_half n m = 0) :
    n * n ≡ 0 [ZMOD (m * m)] :=
have h : _ := eq_zero_of_mul_self_eq_zero h,
modeq_zero_iff.2 (mul_dvd_mul
  (modeq_zero_iff.1 (h ▸ (mod_sub_half_modeq hm).symm))
  (modeq_zero_iff.1 (h ▸ (mod_sub_half_modeq hm).symm)))

private lemma mod_sub_half_le {n m : ℤ} (hm : 0 < m) : ((abs (mod_sub_half n m) : ℤ) : ℚ) ≤ m / 2 :=
have hm0 : (m : ℤ) ≠ 0 := (ne_of_lt hm).symm,
begin
  cases classical.em (((n % m : ℤ) : ℚ) ≤ m / 2) with h h,
  { rwa [mod_sub_half, if_pos h, abs_of_nonneg (int.mod_nonneg (n : ℤ) hm0)] },
  { have hmn : (n : ℤ) % m - m < 0 := sub_neg_of_lt (trans_rel_left _
      (int.mod_lt _ hm0) (abs_of_pos hm)),
    rw [mod_sub_half, if_neg h, abs_of_neg hmn, neg_sub, int.cast_sub,
      sub_le_iff_le_add, ← sub_le_iff_le_add', sub_half],
    exact le_of_lt (lt_of_not_ge h) }
end

private lemma mod_sub_half_square_le {n m : ℤ} (hm : 0 < m) :
  ((mod_sub_half n m * mod_sub_half n m : ℤ) : ℚ) ≤ ((m * m) / 4) :=
calc ((mod_sub_half n m * mod_sub_half n m : ℤ) : ℚ) =
  ((abs (mod_sub_half n m) : ℤ) : ℚ) * ((abs (mod_sub_half n m) : ℤ) : ℚ) :
      by rw [← int.cast_mul, ← abs_mul, abs_mul_self]
   ... ≤ (m / 2) * (m / 2) : mul_self_le_mul_self (int.cast_nonneg.2 (abs_nonneg _)) (mod_sub_half_le hm)
   ... = m * m / 4 : by rw [div_mul_div, (show (2 : ℚ) * 2 = 4, from rfl)]

private lemma mod_sub_half_lt_of_odd {n m : ℤ} (hm : 0 < m) (hmo : m % 2 = 1) :
  ((abs (mod_sub_half n m) : ℤ) : ℚ) < m / 2 :=
let h := (@int.cast_nonneg ℚ _ _).2 (abs_nonneg (mod_sub_half n m)) in
have h2 : (2 : ℚ) ≠ 0 := by norm_num,
lt_of_le_of_ne (mod_sub_half_le hm)
(λ h, begin
  rw [← domain.mul_left_inj h2, mul_div_cancel' _ h2, (show (2 : ℚ) = ((2 : ℤ) : ℚ), from rfl),
    ← int.cast_mul, int.cast_inj] at h,
  have h2m : 2 ∣ m := h ▸ dvd_mul_right _ _,
  exact absurd ((int.mod_eq_zero_of_dvd h2m).symm.trans hmo) dec_trivial
end)

lemma four_squares_mul_four_squares {α : Type*} [comm_ring α] (a b c d w x y z : α) :
  (a * a + b * b +  c * c + d * d)  * (w * w + x * x +  y * y + z * z)  =
  (a * x - w * b + (d * y - z * c)) * (a * x - w * b + (d * y - z * c)) +
  (a * y - w * c + (b * z - x * d)) * (a * y - w * c + (b * z - x * d)) +
  (a * z - w * d + (c * x - y * b)) * (a * z - w * d + (c * x - y * b)) +
  (a * w + b * x +  c * y + d * z)  * (a * w + b * x +  c * y + d * z)  :=
by ring

lemma dvd_mul_sub_add_mul_sub {m a b c d w x y z : ℤ}
  (haw : w ≡ a [ZMOD m]) (hbx : x ≡ b [ZMOD m])
  (hcy : y ≡ c [ZMOD m]) (hdz : z ≡ d [ZMOD m]) :
  m ∣ (a * x - w * b + (d * y - z * c)) :=
dvd_add (modeq_iff_dvd.1 (modeq_mul haw hbx.symm)) (modeq_iff_dvd.1 (modeq_mul hdz hcy.symm))

lemma int.even_add_even {a b : ℤ} (ha : a % 2 = 0) (hb : b % 2 = 0) : (a + b) % 2 = 0 :=
show a + b ≡ 0 + 0 [ZMOD 2], from int.modeq.modeq_add ha hb

lemma int.odd_add_odd {a b : ℤ} (ha : a % 2 = 1) (hb : b % 2 = 1) : (a + b) % 2 = 0 :=
show a + b ≡ 1 + 1 [ZMOD 2], from int.modeq.modeq_add ha hb

lemma even_sum_four_squares {n a b c d : ℤ}
  (H : a * a + b * b + c * c + d * d = 2 * n) :
  ∃ w x y z, w * w + x * x + y * y + z * z = 2 * n ∧
  w * w + x * x ≡ 0 [ZMOD 2] ∧ y * y + z * z ≡ 0 [ZMOD 2] :=
have h' : a * a + b * b + c * c + d * d ≡ 0 [ZMOD 2] :=
  modeq_zero_iff.2 (H.symm ▸ dvd_mul_right _ _),
or.cases_on (int.mod_two_eq_zero_or_one (a * a))
  (λ ha, or.cases_on (int.mod_two_eq_zero_or_one (b * b))
    (λ hb, ⟨a, b, c, d, H, int.even_add_even ha hb,
      modeq_add_cancel_left (show a * a + b * b ≡ 0 [ZMOD 2], from int.even_add_even ha hb)
        (int.modeq.trans (by simp) h')⟩)
    (λ hb, or.cases_on (int.mod_two_eq_zero_or_one (c * c))
      (λ hc, ⟨a, c, b, d, by simp [H.symm], int.even_add_even ha hc,
        modeq_add_cancel_left (show a * a + c * c ≡ 0 [ZMOD 2], from int.even_add_even ha hc)
          (int.modeq.trans (by simp) h')⟩)
      (λ hc, ⟨a, d, b, c, by simp [H.symm],
        modeq_add_cancel_left (show b * b + c * c ≡ 0 [ZMOD 2], from int.odd_add_odd hb hc)
          (int.modeq.trans (by simp) h'),
        int.odd_add_odd hb hc⟩)))
  (λ ha, or.cases_on (int.mod_two_eq_zero_or_one (b * b))
    (λ hb, or.cases_on (int.mod_two_eq_zero_or_one (c * c))
      (λ hc, ⟨b, c, a, d, by simp [H.symm], int.even_add_even hb hc,
        modeq_add_cancel_left (show b * b + c * c ≡ 0 [ZMOD 2], from int.even_add_even hb hc)
          (int.modeq.trans (by simp) h')⟩)
      (λ hc, ⟨a, c, b, d, by simp [H.symm], int.odd_add_odd ha hc,
        modeq_add_cancel_left (show a * a + c * c ≡ 0 [ZMOD 2], from int.odd_add_odd ha hc)
          (int.modeq.trans (by simp) h')⟩))
    (λ hb, ⟨a, b, c, d, by simp [H.symm], int.odd_add_odd ha hb,
      modeq_add_cancel_left (show a * a + b * b ≡ 0 [ZMOD 2], from int.odd_add_odd ha hb)
        (int.modeq.trans (by simp) h')⟩))

private lemma sum_four_squares_of_sum_four_squares_two_mul {n a b c d : ℤ}
  (h : a * a + b * b + c * c + d * d = 2 * n) :
  ∃ a' b' c' d', a' * a' + b' * b' + c' * c' + d' * d' = n :=
let ⟨a, b, c, d, h, hab, hcd⟩ := even_sum_four_squares h in
let ⟨k, hk⟩ := exists_eq_mul_right_of_dvd (modeq_zero_iff.1 hab) in
let ⟨l, hl⟩ := exists_eq_mul_right_of_dvd (modeq_zero_iff.1 hcd) in
let ⟨a', b', hab'⟩ := sum_two_squares_of_sum_two_squares_two_mul hk in
let ⟨c', d', hcd'⟩ := sum_two_squares_of_sum_two_squares_two_mul hl in
⟨a', b', c', d', (domain.mul_left_inj (show (2 : ℤ) ≠ 0, by norm_num)).1
  (h ▸ by rw [add_assoc, hab', hcd', mul_add, ← hk, ← hl, ← add_assoc])⟩

section odd_primes
variables {p : ℕ} (hp : prime p) (hpo : p % 2 = 1)
include hp hpo

lemma bla14 {p : ℕ} (hp : prime p) (hpo : p % 2 = 1) {a b : fin (succ (p / 2))} : a.1 * a.1 + b.1 * b.1 + 1 < p * p :=
have hf : ∀ {a : fin (succ (p / 2))}, (a.1 : ℚ) ≤ p / 2 := λ a,
  calc (a.1 : ℚ) ≤ ((p / 2 : ℕ) : ℚ) : nat.cast_le.2 (le_of_lt_succ a.2)
           ... ≤ (p / 2 : ℚ) : nat.cast_div_le dec_trivial,
have hp2 : 0 ≤ (p : ℚ) / 2 := div_nonneg (nat.cast_nonneg _) (by norm_num),
have h20 : (2 : ℚ) ≠ 0 := by norm_num,
(@nat.cast_lt ℚ _ _ _).1 $
calc ((a.1 * a.1 + b.1 * b.1 + 1 : ℕ) : ℚ) = (a.1 : ℚ) * a.1 + b.1 * b.1 + 1 :
      by simp [nat.cast_mul, nat.cast_add]
  ... ≤ (p / 2) * (p / 2) + (p / 2) * (p / 2) + 1 : add_le_add (add_le_add
      (mul_le_mul hf hf (nat.cast_nonneg _) hp2)
      (mul_le_mul hf hf (nat.cast_nonneg _) hp2)) (le_refl _)
  ... = ((p : ℚ) * p) / 2 + 1 : by rw [div_mul_div, div_add_div_same, ← mul_two, mul_div_mul_right _ h20 h20]
  ... < ((p * p : ℕ) : ℚ) : add_lt_of_lt_sub_left
    (begin
      rw [nat.cast_mul, sub_half, one_lt_div_iff_lt (show (0 : ℚ) < 2, by norm_num)],
      exact calc (2 : ℚ) < 3 * 3 : by norm_num
        ... ≤ (p : ℚ) * (p : ℚ) : mul_self_le_mul_self (by norm_num) (nat.cast_le.2 (hp.odd_iff_ge_three.1 hpo)),
    end)

private lemma exists_sum_four_squares_dvd_prime :
  ∃ (m : ℕ) (a b c d : ℤ), a * a + b * b + c * c + d * d = m * p ∧ m < p ∧ 0 < m :=
let ⟨a, b, hab⟩ := bla12 hp hpo in
  let ⟨m, hm⟩ := exists_eq_mul_left_of_dvd hab in
  ⟨m, a.1, b.1, 1, 0,
    by rw [← int.coe_nat_mul m, ← hm];
      simp,
    lt_of_mul_lt_mul_right
      (by rw ← hm; exact bla14 hp hpo)
      (nat.zero_le p),
    pos_of_mul_pos_right
    (by rw [← hm, add_assoc]; exact succ_pos _)
    (nat.zero_le p)⟩

private lemma sum_four_squares_odd_prime :
  ∃ a b c d : ℤ, a * a + b * b + c * c + d * d = p :=
let h := exists_sum_four_squares_dvd_prime hp hpo in
let m := nat.find h in
let ⟨a, b, c, d, (habcd : (_ : ℤ) = (↑m : ℤ) * p), (hmp : m < p), (hm0 : 0 < m)⟩ :=
    nat.find_spec h in
have hm0' : (0 : ℤ) < m := int.coe_nat_lt.2 hm0,
have h₂ : ∃ r : ℤ, mod_sub_half a m * mod_sub_half a m + mod_sub_half b m * mod_sub_half b m +
    mod_sub_half c m * mod_sub_half c m + mod_sub_half d m * mod_sub_half d m = m * r :=
  exists_eq_mul_right_of_dvd (modeq_zero_iff.1 $
    int.modeq.trans (show _ ≡ m * p [ZMOD m], from
      by rw ← habcd; exact modeq_add (modeq_add (modeq_add
      (mod_sub_half_square hm0') (mod_sub_half_square hm0')) (mod_sub_half_square hm0'))
      (mod_sub_half_square hm0'))
    (show (m : ℤ) * p ≡ 0 [ZMOD m], from modeq_zero_iff.2 (dvd_mul_right m p))),
let ⟨r', hr'⟩ := h₂ in
have hr0 : (0 : ℤ) ≤ r' := @nonneg_of_mul_nonneg_left _ _ (↑m : ℤ) r'
  (hr' ▸ add_nonneg (add_nonneg (add_nonneg (mul_self_nonneg _) (mul_self_nonneg _))
    (mul_self_nonneg _)) (mul_self_nonneg _))
  hm0',
let r := r'.nat_abs in
have hr : mod_sub_half a ↑m * mod_sub_half a ↑m + mod_sub_half b ↑m *
  mod_sub_half b ↑m + mod_sub_half c ↑m * mod_sub_half c ↑m +
  mod_sub_half d ↑m * mod_sub_half d ↑m = ((m * r : ℕ) : ℤ) :=
  show _ = ((_ * r'.nat_abs : ℕ) : ℤ), by rwa [int.coe_nat_mul, int.nat_abs_of_nonneg hr0],
have h₁ : m = 1 := by_contradiction $ λ h₁,
  or.cases_on (mod_two_eq_zero_or_one m)
    (λ hm2, let ⟨k, hk⟩ := exists_eq_mul_right_of_dvd (dvd_of_mod_eq_zero hm2) in
      have hk0 : 0 < k := pos_of_mul_pos_left (show 0 < 2 * k, from hk ▸ hm0)
        (zero_le _),
      have hkm : k < m := hk.symm ▸ (lt_mul_iff_one_lt_left hk0).2 (lt_succ_self _),
      begin
        rw [hk, int.coe_nat_mul, mul_assoc] at habcd,
        rcases sum_four_squares_of_sum_four_squares_two_mul habcd with ⟨a', b', c', d', habcd'⟩,
        exact nat.find_min h hkm ⟨a', b', c', d', habcd', lt_trans hkm hmp, hk0⟩,
      end)
    (λ hm2, have hm2' : (m : ℤ) % (2 : ℕ) = 1 :=
        by rw [← int.coe_nat_mod, hm2, int.coe_nat_one],
      have add_quarters : ∀ q : ℚ, q = q / 4 + q / 4 + q / 4 + q / 4 := λ q,
        by rw [← (show ((2 : ℚ) * 2 = 4), by norm_num), ← div_div_eq_div_mul,
          add_halves, add_assoc, add_halves, add_halves],
      have hrm : r < m := lt_of_mul_lt_mul_left
        (begin
          rw [← int.coe_nat_lt, ← hr, ← @int.cast_lt ℚ],
          simp only [int.cast_add, int.cast_coe_nat, nat.cast_mul, nat.cast_add],
          rw [add_quarters ((m : ℚ) * m)],
          refine add_lt_add_of_lt_of_le (add_lt_add_of_lt_of_le
            (add_lt_add_of_lt_of_le _ (mod_sub_half_square_le hm0'))
            (mod_sub_half_square_le hm0')) (mod_sub_half_square_le hm0'),
          rw [← (show (2 : ℚ) * 2 = 4, by norm_num), ← div_mul_div, ← abs_mul_self, abs_mul, int.cast_mul],
          exact mul_self_lt_mul_self (int.cast_nonneg.2 (abs_nonneg _)) (mod_sub_half_lt_of_odd hm0' hm2'),
        end)
        (nat.zero_le m),
      have hmodeq : mod_sub_half a m * mod_sub_half a m + mod_sub_half b m * mod_sub_half b m
          + mod_sub_half c m * mod_sub_half c m + mod_sub_half d m * mod_sub_half d m ≡
          a * a + b * b + c * c + d * d [ZMOD m] :=
        modeq_add (modeq_add (modeq_add (mod_sub_half_square hm0') (mod_sub_half_square hm0'))
          (mod_sub_half_square hm0')) (mod_sub_half_square hm0'),
      have hdvd : (m : ℤ) ∣ a * a + b * b + c * c + d * d := habcd.symm ▸ dvd_mul_right _ _,
      have hdvd₁ : (m : ℤ) ∣ _ := modeq_zero_iff.1 ((modeq.trans hmodeq) (modeq_zero_iff.2 hdvd)),
      have hr0 : r ≠ 0 := λ h, begin
        rw [h, mul_zero, int.coe_nat_zero] at hr,
        simp only [int.nat_abs_mul_self.symm, (int.coe_nat_add _ _).symm] at hr,
        have hd := eq_zero_of_add_eq_zero (int.coe_nat_inj hr),
        have hc := eq_zero_of_add_eq_zero hd.1,
        have hab := eq_zero_of_add_eq_zero hc.1,
        simp only [(int.coe_nat_eq_coe_nat_iff _ _).symm, int.nat_abs_mul_self] at hab hc hd,
        have h : a * a + b * b + c * c + d * d ≡ 0 + 0 + 0 + 0 [ZMOD (m * m)] :=
          modeq_add (modeq_add (modeq_add (mod_sub_half_eq_zero hm0' hab.1)
            (mod_sub_half_eq_zero hm0' hab.2))
            (mod_sub_half_eq_zero hm0' hc.2)) (mod_sub_half_eq_zero hm0' hd.2),
        have : m ∣ p := dvd_of_mul_dvd_mul_left hm0
          (by rw [← int.coe_nat_dvd, int.coe_nat_mul, int.coe_nat_mul, ← habcd];
            exact modeq_zero_iff.1 h),
        cases hp.2 _ this with he he,
        { contradiction },
        { rw he at hmp,
          exact lt_irrefl _ hmp }
      end,
      have hk : _ := four_squares_mul_four_squares a b c d (mod_sub_half a m)
        (mod_sub_half b m) (mod_sub_half c m) (mod_sub_half d m),
      have ha : _ := @mod_sub_half_modeq a _ hm0',
      have hb : _ := @mod_sub_half_modeq b _ hm0',
      have hc : _ := @mod_sub_half_modeq c _ hm0',
      have hd : _ := @mod_sub_half_modeq d _ hm0',
      let ⟨a', ha'⟩ := exists_eq_mul_right_of_dvd
          (dvd_mul_sub_add_mul_sub ha hb hc hd) in
      let ⟨b', hb'⟩ := exists_eq_mul_right_of_dvd
          (dvd_mul_sub_add_mul_sub ha hc hd hb) in
      let ⟨c', hc'⟩ := exists_eq_mul_right_of_dvd
          (dvd_mul_sub_add_mul_sub ha hd hb hc) in
      have hm4 : ∀ i j : ℤ, (m : ℤ) * i * (m * j) = (m * m) * (i * j) :=
        λ i j, by simp [mul_comm, mul_assoc, mul_left_comm],
      begin
        rw [hr, habcd, ha', hb', hc', int.coe_nat_mul, hm4, hm4, hm4, hm4,
          ← mul_add, ← mul_add] at hk,
        have hk' := sub_eq_iff_eq_add'.2 hk,
        have hd₁ : (m : ℤ) * m ∣ ((a * mod_sub_half a ↑m + b * mod_sub_half b ↑m +
          c * mod_sub_half c ↑m + d * mod_sub_half d ↑m).nat_abs *
            (a * mod_sub_half a ↑m + b * mod_sub_half b ↑m +
            c * mod_sub_half c ↑m + d * mod_sub_half d ↑m).nat_abs : ℕ) :=
          by rw [int.nat_abs_mul_self, ← hk', ← mul_sub];
          exact dvd_mul_right _ _,
        have hd' : (m : ℤ) ∣ (a * mod_sub_half a ↑m + b * mod_sub_half b ↑m +
            c * mod_sub_half c ↑m + d * mod_sub_half d ↑m) :=
          dvd_nat_abs.1 (int.coe_nat_dvd.2 begin
            rw [← int.coe_nat_mul, ← nat.pow_two, ← nat.pow_two, int.coe_nat_dvd] at hd₁,
            exact nat.dvd_of_pow_dvd_pow dec_trivial hd₁,
          end),
        cases exists_eq_mul_right_of_dvd hd' with d' hd',
        have habcd' : a' * a' + b' * b' + c' * c' + d' * d' = ↑r * ↑p :=
          (domain.mul_left_inj (ne_of_lt (mul_pos hm0' hm0')).symm).1 begin
            rw [mul_comm (r : ℤ), hk, hd'],
            ring,
          end,
        exact nat.find_min h hrm ⟨a', b', c', d', habcd', lt_trans hrm hmp,
          nat.pos_of_ne_zero (λ h, by rw h at hr0; contradiction)⟩,
      end),
⟨a, b, c, d, by rw [habcd, h₁]; simp⟩

end odd_primes

lemma sum_four_squares_int : ∀ n : ℕ, ∃ a b c d : ℤ, a * a + b * b + c * c + d * d = n
| 0 := ⟨0, 0, 0, 0, rfl⟩
| 1 := ⟨1, 0, 0, 0, rfl⟩
| n@(k+2) :=
have hm : prime (min_fac n) := min_fac_prime dec_trivial,
have n / min_fac n < n := factors_lemma,
let ⟨a, b, c, d, h₁⟩ := show ∃ a b c d : ℤ, a * a + b * b + c * c + d * d = min_fac n,
  from or.cases_on hm.eq_two_or_odd
    (λ h2, h2.symm ▸ ⟨1, 1, 0, 0, rfl⟩)
    (sum_four_squares_odd_prime hm) in
let ⟨w, x, y, z, h₂⟩ := sum_four_squares_int (n / min_fac n) in
⟨a * x - w * b + (d * y - z * c),
 a * y - w * c + (b * z - x * d),
 a * z - w * d + (c * x - y * b),
 a * w + b * x +  c * y + d * z,
  by rw [← four_squares_mul_four_squares, h₁, h₂, ← int.coe_nat_mul,
      int.coe_nat_eq_coe_nat_iff, nat.mul_div_cancel' (min_fac_dvd _)]⟩

lemma sum_four_squares (n : ℕ) : ∃ a b c d : ℕ, a * a + b * b + c * c + d * d = n :=
let ⟨a, b, c, d, h⟩ := sum_four_squares_int n in
⟨a.nat_abs, b.nat_abs, c.nat_abs, d.nat_abs,
  int.coe_nat_inj (h ▸ by simp only [int.coe_nat_add, int.nat_abs_mul_self])⟩


import tuto_lib

set_option pp.beta true
set_option pp.coercions false

/-
This is the final file in the series. Here we use everything covered
in previous files to prove a couple of famous theorems from
elementary real analysis. Of course they all have more general versions
in mathlib.

As usual, keep in mind the following:

  abs_le {x y : ℝ} : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

  ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

  le_max_left p q : p ≤ max p q

  le_max_right p q : q ≤ max p q

as well as a lemma from the previous file:

  le_of_le_add_all : (∀ ε > 0, y ≤ x + ε) →  y ≤ x

Let's start with a variation on a known exercise.
-/

-- 0071
lemma le_lim {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∃ N, ∀ n ≥ N, y ≤ u n) : y ≤ x :=
begin
  unfold seq_limit at hu,
  cases ineg with N hN,
  by_contradiction H,
  push_neg at H,
  specialize hu ((y-x)/2) (by linarith),
  cases hu with N' hN',
  specialize hN (max N N') (le_max_left N N'),
  specialize hN' (max N N') (le_max_right N N'),
  rw abs_le at hN',
  linarith,
end

/-
Let's now return to the result proved in the `00_` file of this series,
and prove again the sequential characterization of upper bounds (with a slighly
different proof).

For this, and other exercises below, we'll need many things that we proved in previous files,
and a couple of extras.

From the 5th file:

  limit_const (x : ℝ) : seq_limit (λ n, x) x

  squeeze (lim_u : seq_limit u l) (lim_w : seq_limit w l)
    (hu : ∀ n, u n ≤ v n) (hw : ∀ n, v n ≤ w n)  : seq_limit v l

From the 8th:

  def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

  def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

  lt_sup (hx : is_sup A x) : ∀ y, y < x → ∃ a ∈ A, y < a :=

You can also use:

  nat.one_div_pos_of_nat {n : ℕ} : 0 < 1 / (n + 1 : ℝ)

  inv_succ_le_all :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε

and their easy consequences:

  limit_of_sub_le_inv_succ (h : ∀ n, |u n - x| ≤ 1/(n+1)) : seq_limit u x

  limit_const_add_inv_succ (x : ℝ) : seq_limit (λ n, x + 1/(n+1)) x

  limit_const_sub_inv_succ (x : ℝ) : seq_limit (λ n, x - 1/(n+1)) x

The structure of the proof is offered. It features a new tactic:
`choose` which invokes the axiom of choice (observing the tactic state before and
after using it should be enough to understand everything).
-/

-- 0072
lemma is_sup_iff (A : set ℝ) (x : ℝ) :
(is_sup A x) ↔ (upper_bound A x ∧ ∃ u : ℕ → ℝ, seq_limit u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    {
      exact h.left,
    },
    { have : ∀ n : ℕ, ∃ a ∈ A, x - 1/(n+1) < a,
      { intros n,
        have : 1/(n+1 : ℝ) > 0,
          exact nat.one_div_pos_of_nat,
        cases h with ha hb,
        by_contradiction H,
        push_neg at H,
        specialize hb (x - 1/(n+1)),
        have key : x ≤ x - 1/(n+1),
        apply hb,
        exact H,
        linarith,
      },
      choose u hu using this,
      use u,
      split,
      apply limit_of_sub_le_inv_succ,
      intros n,
      specialize hu n,
      rw abs_le,
      split,
      linarith,
      cases hu with ha hb,
      cases h with hx hy,
      specialize hx (u n) (ha),
      linarith,
      intros n,
      specialize hu n,
      exact hu.left,
  } },
  { rintro ⟨maj, u, limu, u_in⟩,
    split,
    exact maj,
    intros y hy,
    by_contradiction H,
    push_neg at H,
    specialize limu ((x-y)/2) (by linarith),
    cases limu with N hN,
    specialize hN N (by linarith),
    specialize hy (u N) (u_in N),
    rw abs_le at hN,
    linarith,
  },
end

/-- Continuity of a function at a point  -/
def continuous_at_pt (f : ℝ → ℝ) (x₀ : ℝ) : Prop :=
∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - f x₀| ≤ ε

variables {f : ℝ → ℝ} {x₀ : ℝ} {u : ℕ → ℝ}

-- 0073
lemma seq_continuous_of_continuous (hf : continuous_at_pt f x₀)
  (hu : seq_limit u x₀) : seq_limit (f ∘ u) (f x₀) :=
begin
  intros ε ε_pos,
  specialize hf ε ε_pos,
  cases hf with δ ha,
  cases ha with hδ h,
  unfold seq_limit at hu,
  specialize hu δ hδ,
  cases hu with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  specialize h (u n),
  apply h,
  exact hN,
end

-- 0074
example :
  (∀ u : ℕ → ℝ, seq_limit u x₀ → seq_limit (f ∘ u) (f x₀)) →
  continuous_at_pt f x₀ :=
begin
  contrapose!,
  intro h,
  unfold continuous_at_pt at h,
  push_neg at h,
  cases h with ε hh,
  cases hh with ε_pos hε,
  have key : ∀ n : ℕ, ∃x, |x - x₀| ≤ 1/(n+1 : ℝ) ∧ ε < |f x - f x₀|,
  { intros n,
  have key₁ : 0 < (1/(n + 1 : ℝ)),
  exact nat.one_div_pos_of_nat,
  exact hε (1/(n+1)) (key₁), },
  choose u hu using key,
  use u,
  split,
  {unfold seq_limit,
  intros ε₂ ε₂_pos,
  have key₃ : ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε,
  {exact inv_succ_le_all,},
  specialize key₃ ε₂ ε₂_pos,
  cases key₃ with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  specialize hu n,
  linarith, },
  unfold seq_limit,
  push_neg,
  use ε,
  split,
  exact ε_pos,
  intros N,
  use N,
  split,
  linarith,
  specialize hu N,
  linarith,
end

/-
Recall from the 6th file:

  def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m

  def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
    ∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a

  id_le_extraction : extraction φ → ∀ n, n ≤ φ n

and from the 8th file:

  def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

  not_seq_limit_of_tendstoinfinity : tendsto_infinity u → ∀ l, ¬ seq_limit u l
-/

variables {φ : ℕ → ℕ}

-- 0075
lemma subseq_tendstoinfinity
  (h : tendsto_infinity u) (hφ : extraction φ) :
tendsto_infinity (u ∘ φ) :=
begin
  sorry
end

-- 0076
lemma squeeze_infinity {u v : ℕ → ℝ} (hu : tendsto_infinity u)
(huv : ∀ n, u n ≤ v n) : tendsto_infinity v :=
begin
  sorry
end

/-
We will use segments: Icc a b := { x | a ≤ x ∧ x ≤ b }
The notation stands for Interval-closed-closed. Variations exist with
o or i instead of c, where o stands for open and i for infinity.

We will use the following version of Bolzano-Weierstrass

  bolzano_weierstrass (h : ∀ n, u n ∈ [a, b]) :
    ∃ c ∈ [a, b], cluster_point u c

as well as the obvious

  seq_limit_id : tendsto_infinity (λ n, n)
-/
open set

-- 0077
lemma bdd_above_segment {f : ℝ → ℝ} {a b : ℝ} (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ M, ∀ x ∈ Icc a b, f x ≤ M :=
begin
  sorry
end

/-
In the next exercise, we can use:

  abs_neg x : |-x| = |x|
-/

-- 0078
lemma continuous_opposite {f : ℝ → ℝ} {x₀ : ℝ} (h : continuous_at_pt f x₀) :
  continuous_at_pt (λ x, -f x) x₀ :=
begin
  sorry
end

/-
Now let's combine the two exercises above
-/

-- 0079
lemma bdd_below_segment {f : ℝ → ℝ} {a b : ℝ} (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ m, ∀ x ∈ Icc a b, m ≤ f x :=
begin
  sorry
end

/-
Remember from the 5th file:

 unique_limit : seq_limit u l → seq_limit u l' → l = l'

and from the 6th one:

  subseq_tendsto_of_tendsto (h : seq_limit u l) (hφ : extraction φ) :
    seq_limit (u ∘ φ) l

We now admit the following version of the least upper bound theorem
(that cannot be proved without discussing the construction of real numbers
or admitting another strong theorem).

sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ Icc a b) :
  ∃ x ∈ Icc a b, is_sup A x

In the next exercise, it can be useful to prove inclusions of sets of real number.
By definition, A ⊆ B means : ∀ x, x ∈ A → x ∈ B.
Hence one can start a proof of A ⊆ B by `intros x x_in`,
which brings `x : ℝ` and `x_in : x ∈ A` in the local context,
and then prove `x ∈ B`.

Note also the use of
  {x | P x}
which denotes the set of x satisfying predicate P.

Hence `x' ∈ { x | P x} ↔ P x'`, by definition.
-/

-- 0080
example {a b : ℝ} (hab : a ≤ b) (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ x₀ ∈ Icc a b, ∀ x ∈ Icc a b, f x ≤ f x₀ :=
begin
  sorry
end

lemma stupid {a b x : ℝ} (h : x ∈ Icc a b) (h' : x ≠ b) : x < b :=
lt_of_le_of_ne h.right h'

/-
And now the final boss...
-/

def I := (Icc 0 1 : set ℝ) -- the type ascription makes sure 0 and 1 are real numbers here

-- 0081
example (f : ℝ → ℝ) (hf : ∀ x, continuous_at_pt f x) (h₀ : f 0 < 0) (h₁ : f 1 > 0) :
∃ x₀ ∈ I, f x₀ = 0 :=
begin
  let A := { x | x ∈ I ∧ f x < 0},
  have ex_x₀ : ∃ x₀ ∈ I, is_sup A x₀,
  {
    sorry
  },
  rcases ex_x₀ with ⟨x₀, x₀_in, x₀_sup⟩,
  use [x₀, x₀_in],
  have : f x₀ ≤ 0,
  {
    sorry
  },
  have x₀_1: x₀ < 1,
  {
    sorry
  },
  have : f x₀ ≥ 0,
  { have in_I : ∃ N : ℕ, ∀ n ≥ N, x₀ + 1/(n+1) ∈ I,
    { have : ∃ N : ℕ, ∀ n≥ N, 1/(n+1 : ℝ) ≤ 1-x₀,
      {
        sorry
      },
      sorry
    },
    have not_in : ∀ n : ℕ, x₀ + 1/(n+1) ∉ A,
    -- By definition, x ∉ A means ¬ (x ∈ A).
    {
      sorry
    },
    dsimp [A] at not_in,
    sorry
  },
  linarith,
end


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.subgroup.mul_opposite
import group_theory.submonoid.pointwise
import group_theory.group_action.conj_act

/-! # Pointwise instances on `subgroup` and `add_subgroup`s

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

This file provides the actions

* `subgroup.pointwise_mul_action`
* `add_subgroup.pointwise_mul_action`

which matches the action of `mul_action_set`.

These actions are available in the `pointwise` locale.

## Implementation notes

The pointwise section of this file is almost identical to `group_theory/submonoid/pointwise.lean`.
Where possible, try to keep them in sync.
-/

open set
open_locale pointwise

variables {α G A S : Type*}

@[simp, to_additive]
lemma inv_coe_set [has_involutive_inv G] [set_like S G] [inv_mem_class S G] {H : S} :
  (H : set G)⁻¹ = H :=
set.ext $ λ _, inv_mem_iff

variables [group G] [add_group A] {s : set G}

namespace subgroup

@[simp, to_additive] lemma inv_subset_closure (S : set G) : S⁻¹ ⊆ closure S :=
λ s hs, by { rw [set_like.mem_coe, ←subgroup.inv_mem_iff], exact subset_closure (mem_inv.mp hs) }

@[to_additive]
lemma closure_to_submonoid (S : set G) : (closure S).to_submonoid = submonoid.closure (S ∪ S⁻¹) :=
begin
  refine le_antisymm (λ x hx, _) (submonoid.closure_le.2 _),
  { refine closure_induction hx (λ x hx, submonoid.closure_mono (subset_union_left S S⁻¹)
      (submonoid.subset_closure hx)) (submonoid.one_mem _) (λ x y hx hy, submonoid.mul_mem _ hx hy)
      (λ x hx, _),
    rwa [←submonoid.mem_closure_inv, set.union_inv, inv_inv, set.union_comm] },
  { simp only [true_and, coe_to_submonoid, union_subset_iff, subset_closure, inv_subset_closure] }
end

@[to_additive] lemma closure_induction_left {p : G → Prop} {x : G}
  (h : x ∈ closure s) (H1 : p 1) (Hmul : ∀ (x ∈ s) y, p y → p (x * y))
  (Hinv : ∀ (x ∈ s) y, p y → p (x⁻¹ * y)) : p x :=
let key := (closure_to_submonoid s).le in submonoid.closure_induction_left (key h) H1 $
  λ x hx, hx.elim (Hmul x) $ λ hx y hy, (congr_arg _ $ inv_inv x).mp $ Hinv x⁻¹ hx y hy

@[to_additive] lemma closure_induction_right {p : G → Prop} {x : G}
  (h : x ∈ closure s) (H1 : p 1) (Hmul : ∀ x (y ∈ s), p x → p (x * y))
  (Hinv : ∀ x (y ∈ s), p x → p (x * y⁻¹)) : p x :=
let key := (closure_to_submonoid s).le in submonoid.closure_induction_right (key h) H1 $
  λ x y hy, hy.elim (Hmul x y) $ λ hy hx, (congr_arg _ $ inv_inv y).mp $ Hinv x y⁻¹ hy hx

@[simp, to_additive] lemma closure_inv (s : set G) : closure s⁻¹ = closure s :=
by simp only [← to_submonoid_eq, closure_to_submonoid, inv_inv, union_comm]

/-- An induction principle for closure membership. If `p` holds for `1` and all elements of
`k` and their inverse, and is preserved under multiplication, then `p` holds for all elements of
the closure of `k`. -/
@[to_additive "An induction principle for additive closure membership. If `p` holds for `0` and all
elements of `k` and their negation, and is preserved under addition, then `p` holds for all
elements of the additive closure of `k`."]
lemma closure_induction'' {p : G → Prop} {x} (h : x ∈ closure s) (Hk : ∀ x ∈ s, p x)
  (Hk_inv : ∀ x ∈ s, p x⁻¹) (H1 : p 1) (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
closure_induction_left h H1 (λ x hx y hy, Hmul x y (Hk x hx) hy) $ λ x hx y,
  Hmul x⁻¹ y $ Hk_inv x hx

/-- An induction principle for elements of `⨆ i, S i`.
If `C` holds for `1` and all elements of `S i` for all `i`, and is preserved under multiplication,
then it holds for all elements of the supremum of `S`. -/
@[elab_as_eliminator, to_additive /-" An induction principle for elements of `⨆ i, S i`.
If `C` holds for `0` and all elements of `S i` for all `i`, and is preserved under addition,
then it holds for all elements of the supremum of `S`. "-/]
lemma supr_induction {ι : Sort*} (S : ι → subgroup G) {C : G → Prop} {x : G} (hx : x ∈ ⨆ i, S i)
  (hp : ∀ i (x ∈ S i), C x)
  (h1 : C 1)
  (hmul : ∀ x y, C x → C y → C (x * y)) : C x :=
begin
  rw supr_eq_closure at hx,
  refine closure_induction'' hx (λ x hx, _) (λ x hx, _) h1 hmul,
  { obtain ⟨i, hi⟩ := set.mem_Union.mp hx,
    exact hp _ _ hi, },
  { obtain ⟨i, hi⟩ := set.mem_Union.mp hx,
    exact hp _ _ (inv_mem hi), },
end

/-- A dependent version of `subgroup.supr_induction`. -/
@[elab_as_eliminator, to_additive /-"A dependent version of `add_subgroup.supr_induction`. "-/]
lemma supr_induction' {ι : Sort*} (S : ι → subgroup G) {C : Π x, (x ∈ ⨆ i, S i) → Prop}
  (hp : ∀ i (x ∈ S i), C x (mem_supr_of_mem i ‹_›))
  (h1 : C 1 (one_mem _))
  (hmul : ∀ x y hx hy, C x hx → C y hy → C (x * y) (mul_mem ‹_› ‹_›))
  {x : G} (hx : x ∈ ⨆ i, S i) : C x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ ⨆ i, S i) (hc : C x hx), hc),
  refine supr_induction S hx (λ i x hx, _) _ (λ x y, _),
  { exact ⟨_, hp _ _ hx⟩ },
  { exact ⟨_, h1⟩ },
  { rintro ⟨_, Cx⟩ ⟨_, Cy⟩,
    refine ⟨_, hmul _ _ _ _ Cx Cy⟩ },
end

@[to_additive]
lemma closure_mul_le (S T : set G) : closure (S * T) ≤ closure S ⊔ closure T :=
Inf_le $ λ x ⟨s, t, hs, ht, hx⟩, hx ▸ (closure S ⊔ closure T).mul_mem
    (set_like.le_def.mp le_sup_left $ subset_closure hs)
    (set_like.le_def.mp le_sup_right $ subset_closure ht)

@[to_additive]
lemma sup_eq_closure (H K : subgroup G) : H ⊔ K = closure (H * K) :=
le_antisymm
  (sup_le
    (λ h hh, subset_closure ⟨h, 1, hh, K.one_mem, mul_one h⟩)
    (λ k hk, subset_closure ⟨1, k, H.one_mem, hk, one_mul k⟩))
  (by conv_rhs { rw [← closure_eq H, ← closure_eq K] }; apply closure_mul_le)

@[to_additive]
private def mul_normal_aux (H N : subgroup G) [hN : N.normal] : subgroup G :=
{ carrier := (H : set G) * N,
  one_mem' := ⟨1, 1, H.one_mem, N.one_mem, by rw mul_one⟩,
  mul_mem' := λ a b ⟨h, n, hh, hn, ha⟩ ⟨h', n', hh', hn', hb⟩,
    ⟨h * h', h'⁻¹ * n * h' * n',
    H.mul_mem hh hh', N.mul_mem (by simpa using hN.conj_mem _ hn h'⁻¹) hn',
    by simp [← ha, ← hb, mul_assoc]⟩,
  inv_mem' := λ x ⟨h, n, hh, hn, hx⟩,
    ⟨h⁻¹, h * n⁻¹ * h⁻¹, H.inv_mem hh, hN.conj_mem _ (N.inv_mem hn) h,
    by rw [mul_assoc h, inv_mul_cancel_left, ← hx, mul_inv_rev]⟩ }

/-- The carrier of `H ⊔ N` is just `↑H * ↑N` (pointwise set product) when `N` is normal. -/
@[to_additive "The carrier of `H ⊔ N` is just `↑H + ↑N` (pointwise set addition)
when `N` is normal."]
lemma mul_normal (H N : subgroup G) [N.normal] : (↑(H ⊔ N) : set G) = H * N :=
set.subset.antisymm
  (show H ⊔ N ≤ mul_normal_aux H N,
    by { rw sup_eq_closure, apply Inf_le _, dsimp, refl })
  ((sup_eq_closure H N).symm ▸ subset_closure)

@[to_additive]
private def normal_mul_aux (N H : subgroup G) [hN : N.normal] : subgroup G :=
{ carrier := (N : set G) * H,
  one_mem' := ⟨1, 1, N.one_mem, H.one_mem, by rw mul_one⟩,
  mul_mem' := λ a b ⟨n, h, hn, hh, ha⟩ ⟨n', h', hn', hh', hb⟩,
    ⟨n * (h * n' * h⁻¹), h * h',
    N.mul_mem hn (hN.conj_mem _ hn' _), H.mul_mem hh hh',
    by simp [← ha, ← hb, mul_assoc]⟩,
  inv_mem' := λ x ⟨n, h, hn, hh, hx⟩,
    ⟨h⁻¹ * n⁻¹ * h, h⁻¹,
    by simpa using hN.conj_mem _ (N.inv_mem hn) h⁻¹, H.inv_mem hh,
    by rw [mul_inv_cancel_right, ← mul_inv_rev, hx]⟩ }

/-- The carrier of `N ⊔ H` is just `↑N * ↑H` (pointwise set product) when `N` is normal. -/
@[to_additive "The carrier of `N ⊔ H` is just `↑N + ↑H` (pointwise set addition)
when `N` is normal."]
lemma normal_mul (N H : subgroup G) [N.normal] : (↑(N ⊔ H) : set G) = N * H :=
set.subset.antisymm
  (show N ⊔ H ≤ normal_mul_aux N H,
    by { rw sup_eq_closure, apply Inf_le _, dsimp, refl })
  ((sup_eq_closure N H).symm ▸ subset_closure)

@[to_additive] lemma mul_inf_assoc (A B C : subgroup G) (h : A ≤ C) :
  (A : set G) * ↑(B ⊓ C) = (A * B) ⊓ C :=
begin
  ext,
  simp only [coe_inf, set.inf_eq_inter, set.mem_mul, set.mem_inter_iff],
  split,
  { rintros ⟨y, z, hy, ⟨hzB, hzC⟩, rfl⟩,
    refine ⟨_, mul_mem (h hy) hzC⟩,
    exact ⟨y, z, hy, hzB, rfl⟩ },
  rintros ⟨⟨y, z, hy, hz, rfl⟩, hyz⟩,
  refine ⟨y, z, hy, ⟨hz, _⟩, rfl⟩,
  suffices : y⁻¹ * (y * z) ∈ C, { simpa },
  exact mul_mem (inv_mem (h hy)) hyz
end

@[to_additive] lemma inf_mul_assoc (A B C : subgroup G) (h : C ≤ A) :
  ((A ⊓ B : subgroup G) : set G) * C = A ⊓ (B * C) :=
begin
  ext,
  simp only [coe_inf, set.inf_eq_inter, set.mem_mul, set.mem_inter_iff],
  split,
  { rintros ⟨y, z, ⟨hyA, hyB⟩, hz, rfl⟩,
    refine ⟨A.mul_mem hyA (h hz), _⟩,
    exact ⟨y, z, hyB, hz, rfl⟩ },
  rintros ⟨hyz, y, z, hy, hz, rfl⟩,
  refine ⟨y, z, ⟨_, hy⟩, hz, rfl⟩,
  suffices : (y * z) * z⁻¹ ∈ A, { simpa },
  exact mul_mem hyz (inv_mem (h hz))
end

instance sup_normal (H K : subgroup G) [hH : H.normal] [hK : K.normal] : (H ⊔ K).normal :=
{ conj_mem := λ n hmem g,
  begin
    change n ∈ ↑(H ⊔ K) at hmem,
    change g * n * g⁻¹ ∈ ↑(H ⊔ K),
    rw [normal_mul, set.mem_mul] at *,
    rcases hmem with ⟨h, k, hh, hk, rfl⟩,
    refine ⟨g * h * g⁻¹, g * k * g⁻¹, hH.conj_mem h hh g, hK.conj_mem k hk g, _⟩,
    simp
  end }

@[to_additive] lemma smul_opposite_image_mul_preimage {H : subgroup G} (g : G) (h : H.opposite)
  (s : set G) : (λ y, h • y) '' (has_mul.mul g ⁻¹' s) = has_mul.mul g ⁻¹' ((λ y, h • y) '' s) :=
by { ext x, cases h, simp [(•), mul_assoc] }

/-! ### Pointwise action -/

section monoid
variables [monoid α] [mul_distrib_mul_action α G]

/-- The action on a subgroup corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (subgroup G) :=
{ smul := λ a S, S.map (mul_distrib_mul_action.to_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] subgroup.pointwise_mul_action" in pointwise
open_locale pointwise

lemma pointwise_smul_def {a : α} (S : subgroup G) :
  a • S = S.map (mul_distrib_mul_action.to_monoid_End _ _ a) := rfl

@[simp] lemma coe_pointwise_smul (a : α) (S : subgroup G) : ↑(a • S) = a • (S : set G) := rfl

@[simp] lemma pointwise_smul_to_submonoid (a : α) (S : subgroup G) :
  (a • S).to_submonoid = a • S.to_submonoid := rfl

lemma smul_mem_pointwise_smul (m : G) (a : α) (S : subgroup G) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set G))

lemma mem_smul_pointwise_iff_exists (m : G) (a : α) (S : subgroup G) :
  m ∈ a • S ↔ ∃ (s : G), s ∈ S ∧ a • s = m :=
(set.mem_smul_set : m ∈ a • (S : set G) ↔ _)

@[simp] lemma smul_bot (a : α) : a • (⊥ : subgroup G) = ⊥ := map_bot _
lemma smul_sup (a : α) (S T : subgroup G) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _

instance pointwise_central_scalar [mul_distrib_mul_action αᵐᵒᵖ G] [is_central_scalar α G] :
  is_central_scalar α (subgroup G) :=
⟨λ a S, congr_arg (λ f, S.map f) $ monoid_hom.ext $ by exact op_smul_eq_smul _⟩

lemma conj_smul_le_of_le {P H : subgroup G} (hP : P ≤ H) (h : H) :
  mul_aut.conj (h : G) • P ≤ H :=
begin
  rintro - ⟨g, hg, rfl⟩,
  exact H.mul_mem (H.mul_mem h.2 (hP hg)) (H.inv_mem h.2),
end

lemma conj_smul_subgroup_of {P H : subgroup G} (hP : P ≤ H) (h : H) :
  mul_aut.conj h • P.subgroup_of H = (mul_aut.conj (h : G) • P).subgroup_of H :=
begin
  refine le_antisymm _ _,
  { rintro - ⟨g, hg, rfl⟩,
    exact ⟨g, hg, rfl⟩ },
  { rintro p ⟨g, hg, hp⟩,
    exact ⟨⟨g, hP hg⟩, hg, subtype.ext hp⟩ },
end

end monoid

section group
variables [group α] [mul_distrib_mul_action α G]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : subgroup G} {x : G} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : subgroup G} {x : G} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : subgroup G} {x : G} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : subgroup G} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : α} {S T : subgroup G} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : α} {S T : subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

@[simp] lemma smul_inf (a : α) (S T : subgroup G) : a • (S ⊓ T) = a • S ⊓ a • T :=
by simp [set_like.ext_iff, mem_pointwise_smul_iff_inv_smul_mem]

/-- Applying a `mul_distrib_mul_action` results in an isomorphic subgroup -/
@[simps] def equiv_smul (a : α) (H : subgroup G) : H ≃* (a • H : subgroup G) :=
(mul_distrib_mul_action.to_mul_equiv G a).subgroup_map H

lemma subgroup_mul_singleton {H : subgroup G} {h : G} (hh : h ∈ H) :
  (H : set G) * {h} = H :=
begin
  refine le_antisymm _ (λ h' hh',
    ⟨h' * h⁻¹, h, H.mul_mem hh' (H.inv_mem hh), rfl, inv_mul_cancel_right h' h⟩),
  rintros _ ⟨h', h, hh', rfl : _ = _, rfl⟩,
  exact H.mul_mem hh' hh,
end

lemma singleton_mul_subgroup {H : subgroup G} {h : G} (hh : h ∈ H) :
  {h} * (H : set G) = H :=
begin
  refine le_antisymm _ (λ h' hh', ⟨h, h⁻¹ * h', rfl, H.mul_mem (H.inv_mem hh) hh',
    mul_inv_cancel_left h h'⟩),
  rintros _ ⟨h, h', rfl : _ = _, hh', rfl⟩,
  exact H.mul_mem hh hh',
end

lemma normal.conj_act {G : Type*} [group G] {H : subgroup G} (hH : H.normal ) (g : conj_act G) :
  g • H = H :=
begin
  ext,
  split,
  { intro h,
    have := hH.conj_mem (g⁻¹ • x) _ (conj_act.of_conj_act g),
    rw subgroup.mem_pointwise_smul_iff_inv_smul_mem at h,
    dsimp at *,
    rw conj_act.smul_def at *,
    simp only [conj_act.of_conj_act_inv, conj_act.of_conj_act_to_conj_act, inv_inv] at *,
    convert this,
    simp only [←mul_assoc, mul_right_inv, one_mul, mul_inv_cancel_right],
    rw subgroup.mem_pointwise_smul_iff_inv_smul_mem at h,
    exact h},
  { intro h,
    rw [subgroup.mem_pointwise_smul_iff_inv_smul_mem, conj_act.smul_def],
    apply hH.conj_mem,
    exact h}
end

@[simp] lemma smul_normal (g : G) (H : subgroup G) [h : normal H] : mul_aut.conj g • H = H :=
h.conj_act g

end group

section group_with_zero
variables [group_with_zero α] [mul_distrib_mul_action α G]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : subgroup G)
  (x : G) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set G) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : subgroup G) (x : G) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set G) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : subgroup G) (x : G) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set G) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end subgroup

namespace add_subgroup

section monoid
variables [monoid α] [distrib_mul_action α A]

/-- The action on an additive subgroup corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (add_subgroup A) :=
{ smul := λ a S, S.map (distrib_mul_action.to_add_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] add_subgroup.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : add_subgroup A) : ↑(a • S) = a • (S : set A) := rfl

@[simp] lemma pointwise_smul_to_add_submonoid (a : α) (S : add_subgroup A) :
  (a • S).to_add_submonoid = a • S.to_add_submonoid := rfl

lemma smul_mem_pointwise_smul (m : A) (a : α) (S : add_subgroup A) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set A))

lemma mem_smul_pointwise_iff_exists (m : A) (a : α) (S : add_subgroup A) :
  m ∈ a • S ↔ ∃ (s : A), s ∈ S ∧ a • s = m :=
(set.mem_smul_set : m ∈ a • (S : set A) ↔ _)

instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ A] [is_central_scalar α A] :
  is_central_scalar α (add_subgroup A) :=
⟨λ a S, congr_arg (λ f, S.map f) $ add_monoid_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : add_subgroup A} {x : A} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : add_subgroup A} {x : A} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : add_subgroup A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : add_subgroup A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_le_iff {a : α} {S T : add_subgroup A} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma le_pointwise_smul_iff {a : α} {S T : add_subgroup A} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A)
  (x : A) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set A) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A) (x : A) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set A) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A) (x : A) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set A) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end add_subgroup


import mod_forms.Eisenstein_Series.Eisenstein_series
import for_mathlib.unform_limits_of_holomorphic
import for_mathlib.mod_forms2
import geometry.manifold.mfderiv

universes u v w

open complex upper_half_plane

open_locale big_operators nnreal classical filter

local notation `ℍ` := upper_half_plane

local notation `ℍ'`:=(⟨upper_half_plane.upper_half_space, upper_half_plane_is_open⟩: open_subs)
local notation `SL2Z`:=matrix.special_linear_group (fin 2) ℤ
local notation `SL(` n `, ` R `)` := matrix.special_linear_group (fin n) R
noncomputable theory

namespace Eisenstein_series

lemma eisen_square_diff_on (k : ℤ)  (hkn : k ≠ 0) (n : ℕ) :
  is_holomorphic_on (λ (z : ℍ'), eisen_square k n z) :=
begin
  rw ← is_holomorphic_on_iff_differentiable_on,
  have h1 : extend_by_zero (λ (z : ℍ'), eisen_square k n z) =
    λ x : ℂ, ∑ y in (Square n), (extend_by_zero (λ z : ℍ', Eise k z y)) x,
  { simp_rw eisen_square,
    funext z,
    simp only [extend_by_zero, finset.sum_dite_irrel, finset.sum_const_zero] },
  simp only [ne.def] at *,
  rw h1,
  apply differentiable_on.sum,
  intros i hi,
  apply Eise'_has_diff_within_at k i hkn,
end

def eisen_square' (k : ℤ) (n: ℕ) : ℍ' → ℂ:=
λ (z : ℍ'), ∑ x in (finset.range n), eisen_square k x z

lemma eisen_square'_diff_on (k : ℤ)  (hkn : k ≠ 0) (n : ℕ) :
  is_holomorphic_on (eisen_square' k n ) :=
begin
  rw ← is_holomorphic_on_iff_differentiable_on,
  have h1 : extend_by_zero (eisen_square' k n) =
    λ x : ℂ, ∑ y in (finset.range n), (extend_by_zero (λ z : ℍ', eisen_square k y z)) x,
  { simp_rw eisen_square',
    simp only [extend_by_zero, finset.sum_dite_irrel, finset.sum_const_zero] },
  rw h1,
  apply differentiable_on.sum,
  exact λ i hi, (is_holomorphic_on_iff_differentiable_on _ _).mpr (eisen_square_diff_on k hkn i),
end

variables (A B : ℝ)

lemma Eisen_partial_tends_to_uniformly_on_ball (k: ℕ) (h : 3 ≤ k) (z : ℍ') : ∃ (A B ε : ℝ),
  0 < ε ∧ metric.closed_ball z ε ⊆ (upper_half_space_slice A B)  ∧  0 < B ∧ ε < B ∧
  (tendsto_uniformly_on (eisen_square' k) (Eisenstein_series_of_weight_ k)
  filter.at_top (metric.closed_ball z ε)) :=
begin
  have h1:= closed_ball_in_slice z,
  obtain ⟨A, B, ε, hε, hB, hball, hA, hεB⟩ := h1,
  use A,
  use B,
  use ε,
  simp only [hε, hB, hball, hεB, true_and],
  have hz: z ∈ (upper_half_space_slice A B), by {apply hball, simp  [hε .le],},
  have hu:= (Eisen_partial_tends_to_uniformly k h A B hA hB),
  have hu2:
    tendsto_uniformly_on (Eisen_par_sum_slice k A B ) (Eisenstein_series_restrict k A B)
    filter.at_top (metric.closed_ball ⟨z, hz⟩ ε), by {apply hu.tendsto_uniformly_on},
  clear hu,
  simp_rw Eisenstein_series_restrict at *,
  simp_rw metric.tendsto_uniformly_on_iff at *,
  simp_rw Eisen_par_sum_slice at *,
  simp_rw Eisen_square_slice at *,
  simp_rw eisen_square',
  simp only [filter.eventually_at_top, abs_of_real, gt_iff_lt, ge_iff_le, nonempty_of_inhabited,
  metric.mem_closed_ball, subtype.forall, set_coe.forall, upper_half_plane.coe_im,
  subtype.coe_mk, subtype.val_eq_coe, coe_coe, upper_half_plane.coe_re] at *,
  intros δ hδ,
  have hu3:= hu2 δ hδ,
  clear hu2,
  obtain ⟨a, ha⟩:=hu3,
  use a,
  intros b hb x hx,
  have hxx: x ∈ upper_half_space_slice A B,
  by {apply hball, simp only [hx, metric.mem_closed_ball],},
  have hxu := upper_half_plane.im_pos x,
  have ha2:= ha b hb x hxx,
  apply ha2,
  apply hx,
end

lemma Eisen_partial_tends_to_uniformly_on_ball' (k: ℕ) (h : 3 ≤ k) (z : ℍ') : ∃ (A B ε : ℝ),
  0 < ε ∧ metric.closed_ball z ε ⊆ (upper_half_space_slice A B)  ∧  0 < B ∧ ε < B ∧
  (tendsto_uniformly_on ( λ n, extend_by_zero ( eisen_square' k n))
  (extend_by_zero (Eisenstein_series_of_weight_ k))
  filter.at_top (metric.closed_ball z ε)   ) :=
begin
  have H := Eisen_partial_tends_to_uniformly_on_ball k h z,
  obtain ⟨A, B, ε, hε, hball, hB, hεB, hunif⟩ :=H,
  use A,
  use B,
  use ε,
  simp only [hε, hball, hB, hεB, true_and],
  simp_rw metric.tendsto_uniformly_on_iff at *,
  intros ε' hε',
  have h2:= hunif ε' hε',
  simp only [filter.eventually_at_top, gt_iff_lt, ge_iff_le, metric.mem_closed_ball] at *,
  obtain ⟨a, ha⟩:= h2,
  use a,
  have Hba:= ball_in_upper_half z A B ε hB hε hεB hball,
  intros b hb x hx,
  have hxx : x ∈ ℍ'.1, by {apply Hba, simp [hx],},
  have hf:= ext_by_zero_apply ℍ' (Eisenstein_series_of_weight_ k) ⟨x, hxx⟩,
  let F: ℕ → ℍ' → ℂ := λ n,  eisen_square' k n,
  have hFb:= ext_by_zero_apply ℍ' (F b) ⟨x, hxx⟩,
  simp only [topological_space.opens.mem_coe, subtype.coe_mk, subtype.val_eq_coe] at *,
  rw hf,
  rw hFb,
  apply ha b hb ⟨x, hxx⟩ hx,
end
/--The extension of a function from `ℍ` to `ℍ'`-/
def hol_extn (f : ℍ → ℂ) : ℍ' → ℂ := λ (z : ℍ'), (f (z : ℍ))

local notation `↑ₕ` := hol_extn

instance : has_coe (ℍ → ℂ) (ℍ' → ℂ) := ⟨λ f, hol_extn f ⟩

lemma Eisenstein_is_holomorphic' (k: ℕ) (hk : 3 ≤ k):
  is_holomorphic_on (↑ₕ(Eisenstein_series_of_weight_ k)):=
begin
  rw ←  is_holomorphic_on_iff_differentiable_on,
  apply diff_on_diff,
  intro x,
  have H:= Eisen_partial_tends_to_uniformly_on_ball' k hk x,
  obtain ⟨A, B, ε, hε, hball, hB, hεB, hunif⟩ :=H,
  use ε,
  have hball2: metric.closed_ball ↑x ε ⊆ ℍ'.1,
  by {apply ball_in_upper_half x A B ε hB hε hεB hball,},
  split,
  apply hε,
  split,
  intros w hw,
  have hwa : w ∈ ℍ'.1,
  by { apply hball2, simp, simp at hw, apply le_trans hw.le, field_simp, },
  apply hwa,
  have hkn : (k : ℤ) ≠ 0, by {norm_cast, linarith,},
  let F: ℕ → ℂ → ℂ := λ n, extend_by_zero ( eisen_square' k n),
  have hdiff : ∀ (n : ℕ), differentiable_on ℂ (F n) (metric.closed_ball x ε),
  by {intro n,
  have := eisen_square'_diff_on k hkn n,
  rw ← is_holomorphic_on_iff_differentiable_on at this,
  simp_rw F,
  apply this.mono,
  apply hball2,},
  apply uniform_of_diff_circle_int_is_diff F (extend_by_zero (Eisenstein_series_of_weight_ k)) x hε
  hdiff hunif,
end

lemma Eisenstein_is_holomorphic (k: ℤ) (hk : 3 ≤ k):
  is_holomorphic_on (↑ₕ(Eisenstein_series_of_weight_ k)):=
begin
have :  ∃ (n : ℕ), (n : ℤ) = k , by {have hk': 0 ≤ k, by {linarith}, exact can_lift.prf k hk' },
obtain ⟨n, hn⟩ := this,
have hn3 : 3 ≤ n, by {linarith},
have :=  Eisenstein_is_holomorphic' n hn3,
convert this,
apply hn.symm,
end

def my_vadd : ℤ → ℍ → ℍ :=
λ n, λ (z : ℍ), ⟨z.1+n, by {simp, apply z.2},⟩

instance : has_vadd ℤ ℍ := {
vadd:= my_vadd
}

lemma my_add_im (n : ℤ) (z : ℍ) : (my_vadd n z).im = z.im :=
begin
  simp_rw my_vadd,
  simp only [subtype.val_eq_coe],
  simp_rw upper_half_plane.im,
  simp only [add_zero, int_cast_im, add_im, subtype.coe_mk],
end

lemma my_add_re (n : ℤ) (z : ℍ) : (my_vadd n z).re = z.re + n :=
begin
  simp_rw my_vadd,
  simp only [subtype.val_eq_coe],
  simp_rw upper_half_plane.re,
  simp only [int_cast_re, add_re, subtype.coe_mk],
end

lemma zero_vadd' (z : ℍ) : my_vadd (0: ℤ) z = z :=
begin
  simp_rw my_vadd,
  simp only [add_zero, int.cast_zero, subtype.coe_eta, subtype.val_eq_coe],
end

lemma add_vadd'  (n m : ℤ) (z : ℍ): my_vadd (n+m) z = my_vadd n (my_vadd m z)   :=
begin
  simp_rw my_vadd,
  simp only [int.cast_add, subtype.val_eq_coe],
  abel,
end

instance : add_action ℤ ℍ :={
  zero_vadd := by {apply zero_vadd',},
  add_vadd := by {apply add_vadd',},
}

def Tn (n : ℤ) : matrix  (fin 2) (fin 2 ) ℤ := ![![1, n], ![0, 1]]

lemma Tndet (n : ℤ) : matrix.det (Tn(n)) = 1 :=
begin
  simp_rw Tn,
  rw matrix.det_fin_two,
  simp only [matrix.head_cons, mul_one, sub_zero, matrix.cons_val_one, mul_zero,
  matrix.cons_val_zero],
end

lemma coe_aux (γ : SL2Z) :
 ∀ i j, ((γ : matrix.GL_pos (fin 2) ℝ) i j : ℝ) = ((γ i j : ℤ) : ℝ) :=
begin

  intros i j,
  have := modular_group.mat_vals  γ i j,
  simp [of_real_int_cast, subtype.val_eq_coe, matrix.general_linear_group.coe_fn_eq_coe, coe_coe] at *,
  rw ←this,
  cases j, cases i, cases γ, dsimp at *, solve_by_elim,

end

def TN (n : ℤ) : SL2Z := ⟨Tn (n), Tndet n⟩

lemma TN00 (n : ℤ) : (TN n)  0 0 = 1 :=
begin
refl,
end

lemma TN01 (n : ℤ) : (TN n)  0 1 = n :=
begin
refl
end

lemma TN10 (n : ℤ) : (TN n) 1 0 = 0 :=
begin
refl
end

lemma TN11 (n : ℤ) : (TN n) 1 1 = 1 :=
begin
  refl,
end

lemma mod_form_periodic (k : ℤ)
  ( f : (slash_invariant_form (⊤ : subgroup SL2Z) k)) :
  ∀ (z : ℍ) (n : ℤ), f( ((TN n) : matrix.GL_pos (fin 2) ℝ)  • z ) = f(z) :=
begin
  have h := slash_invariant_form.slash_action_eqn' k ⊤ f,
  simp only [slash_invariant_form.slash_action_eqn', coe_coe],
  intros z n,
  have htop : (TN n) ∈ (⊤ : subgroup SL2Z), by {simp,},
  have H:= h ⟨(TN n), htop⟩ z,
  simp only [subgroup.coe_mk] at H,
  have hoo' : (TN n)  1 0 = 0, by {refl,},
  have h11' : (TN n)  1 1 = 1, by {refl,},
  simp at *,
  simp_rw hoo' at H,
  simp_rw h11' at H,
  simp [int.cast_zero, one_mul, zero_mul, int.cast_one, zero_add, one_zpow] at H,
  apply H,
end

lemma smul_expl (n : ℤ) (z : ℍ) : (((TN n) : matrix.GL_pos (fin 2) ℝ)  • z ) = n +ᵥ z :=
begin
  simp [coe_coe],
  have := upper_half_plane.coe_smul ((TN n) : matrix.GL_pos (fin 2) ℝ) z,
  have h1:= (TN00 n),
  have h2:= (TN01 n),
  have h3:= (TN10 n),
  have h4:= (TN11 n),
  ext,
  simp  [upper_half_plane.num, upper_half_plane.denom, eq_self_iff_true, coe_coe,
  upper_half_plane.coe_smul, upper_half_plane.coe_re] at *,
  simp_rw [h1, h2, h3,h4],
  simp  [int_cast_re, one_mul, of_real_zero, zero_mul, add_re, of_real_int_cast, zero_add,
  of_real_one, div_one, upper_half_plane.coe_re],
  convert (my_add_re n z).symm,
  simp  [upper_half_plane.num, upper_half_plane.denom, eq_self_iff_true,
  upper_half_plane.coe_im, coe_coe, upper_half_plane.coe_smul] at *,
  simp_rw [h1, h2, h3,h4],
  simp [add_zero, one_mul, of_real_zero, int_cast_im, zero_mul, add_im, of_real_int_cast,
  zero_add, upper_half_plane.coe_im, of_real_one, div_one],
  convert (my_add_im n z).symm,
end

lemma abs_floor_sub (r : ℝ) :  |(r - (int.floor r))| < 1 :=
begin
simp only [int.self_sub_floor],
rw _root_.abs_of_nonneg (int.fract_nonneg r),
apply (int.fract_lt_one r),
end

lemma upp_half_translation (z : ℍ) : ∃ (n : ℤ),
  (((TN n) : matrix.GL_pos (fin 2) ℝ)  • z) ∈ (upper_half_space_slice 1 z.1.2) :=
begin
  let n:= (int.floor z.1.1),
  use -n,
  have:= smul_expl (-n) z,
  simp_rw this,
  simp only [abs_of_real, ge_iff_le, slice_mem, upper_half_plane.coe_im, subtype.val_eq_coe,
  upper_half_plane.coe_re],
  have him := my_add_im (-n) z,
  have hre := my_add_re (-n) z,
  split,
  have h1: (-n +ᵥ z).re = (my_vadd (-n) z).re, by {refl,},
  rw h1,
  rw hre,
  simp,
  apply (abs_floor_sub z.1.1).le,
  have h2: (-n +ᵥ z).im = (my_vadd (-n) z).im, by {refl,},
  rw h2,
  rw him,
  apply le_abs_self,
end

lemma eis_bound_by_real_eis (k : ℕ) (z : ℍ) (hk : 3 ≤ k) :
  complex.abs (Eisenstein_series_of_weight_ k z) ≤ (real_Eisenstein_series_of_weight_ k z) :=
begin
  simp_rw Eisenstein_series_of_weight_,
  simp_rw real_Eisenstein_series_of_weight_,
  simp_rw real_Eise,
  simp_rw Eise,
  apply abs_tsum',
  have := real_eise_is_summable k z hk,
  simp_rw real_Eise at this,
  simp only [one_div, complex.abs_pow, abs_inv, norm_eq_abs, zpow_coe_nat] at *,
  apply this,
end

lemma Eisenstein_is_bounded' (k: ℕ) (hk : 3 ≤ k) :
  upper_half_plane.is_bounded_at_im_infty (Eisenstein_series_of_weight_ k) :=
begin
  simp only [upper_half_plane.bounded_mem, subtype.forall, upper_half_plane.coe_im],
  let M : ℝ := 8 / rfunct (lbpoint 1 2 $ by linarith) ^ k * Riemann_zeta (k - 1),
  use [M, 2],
  intros z hz,
  obtain ⟨n, hn⟩ := upp_half_translation z,
  have := (mod_form_periodic k (Eisenstein_is_slash_inv ⊤ k) z n),
  have hf : (Eisenstein_is_slash_inv ⊤ k) z = Eisenstein_series_of_weight_  k z, by {refl,},
  rw hf at this,
  rw ← this,
  let Z := (((TN n) : matrix.GL_pos (fin 2) ℝ) • z),
  apply le_trans (eis_bound_by_real_eis k Z hk),
  have hZ : Z ∈ upper_half_space_slice 1 2,
  { simp_rw [Z, smul_expl n z] at *,
    simp only [abs_of_real, slice_mem, upper_half_plane.coe_im, subtype.val_eq_coe,
      upper_half_plane.coe_re] at hn ⊢,
    refine ⟨hn.1, _⟩,
    have hadd : (n +ᵥ z).im = (my_vadd n z).im := by { refl },
    rw [hadd, my_add_im n z],
    apply le_trans hz,
    apply le_abs_self,},
  convert Real_Eisenstein_bound_unifomly_on_stip k hk 1 2 (by linarith) ⟨Z, hZ⟩,
end

lemma Eisenstein_is_bounded (k: ℤ) (hk : 3 ≤ k) :
  upper_half_plane.is_bounded_at_im_infty (Eisenstein_series_of_weight_ k) :=
begin
have :  ∃ (n : ℕ), (n : ℤ) = k , by {have hk': 0 ≤ k, by {linarith}, exact can_lift.prf k hk' },
obtain ⟨n, hn⟩ := this,
have hn3 : 3 ≤ n, by {linarith},
have :=  Eisenstein_is_bounded' n hn3,
convert this,
apply hn.symm,
end

variable (f : ℍ' → ℂ)

open_locale classical topology manifold

instance : inhabited ℍ' :=
begin
let  x := (⟨complex.I, by {simp,} ⟩ : ℍ),
apply inhabited.mk x,
end

lemma ext_chart (z : ℍ') : (extend_by_zero f) z = (f ∘ ⇑((chart_at ℂ z).symm)) z :=
begin
simp_rw chart_at,
simp_rw extend_by_zero,
simp,
have :=  (local_homeomorph.subtype_restr_coe  (local_homeomorph.refl ℂ) ℍ').symm,
congr,
simp_rw local_homeomorph.subtype_restr,
simp,
have hf:= topological_space.opens.local_homeomorph_subtype_coe_coe ℍ',
simp_rw ← hf,
apply symm,
apply local_homeomorph.left_inv,
simp only [topological_space.opens.local_homeomorph_subtype_coe_source],
end

lemma holo_to_mdiff (f : ℍ' → ℂ) (hf : is_holomorphic_on f ) : mdifferentiable 𝓘(ℂ) 𝓘(ℂ) f :=
begin
rw ← is_holomorphic_on_iff_differentiable_on at hf,
simp_rw mdifferentiable,
 simp only [mdifferentiable_at, differentiable_within_at_univ] with mfld_simps,
intro x,
split,
have hc:= hf.continuous_on,
simp at hc,
rw continuous_on_iff_continuous_restrict at hc,
have hcc:= hc.continuous_at,
convert hcc,
funext y,
simp_rw extend_by_zero,
simp_rw set.restrict,
simp [y.2],
rw ← dite_eq_ite,
rw dif_pos,
apply y.2,
have hfx := hf x x.2,
have hH: ℍ'.1 ∈ 𝓝 (((chart_at ℂ x) x)), by {simp_rw metric.mem_nhds_iff, simp,
simp_rw chart_at, simp, have:= upper_half_plane_is_open, rw metric.is_open_iff at this,
have ht:= this x.1 x.2, simp at ht, exact ht,},
apply differentiable_on.differentiable_at _ hH,
apply differentiable_on.congr hf,
intros y hy,
have HH:= ext_chart f (⟨y,hy⟩ : ℍ'),
simp at HH,
simp only [function.comp_app],
simp_rw HH,
congr,
end

lemma mdiff_to_holo (f : ℍ' → ℂ) (hf :  (mdifferentiable 𝓘(ℂ) 𝓘(ℂ) f) ) : is_holomorphic_on f :=
begin
rw ← is_holomorphic_on_iff_differentiable_on,
simp_rw mdifferentiable at hf,
simp only [mdifferentiable_at, differentiable_within_at_univ] with mfld_simps at hf,
simp_rw differentiable_on,
intros x hx,
have hff:= (hf ⟨x, hx⟩).2,
apply differentiable_at.differentiable_within_at,
simp_rw differentiable_at at *,
obtain ⟨g, hg⟩:= hff,
refine ⟨g,_⟩,
apply has_fderiv_at.congr_of_eventually_eq hg,
simp_rw filter.eventually_eq_iff_exists_mem,
refine  ⟨ℍ', _⟩,
split,
simp_rw metric.mem_nhds_iff, simp,
simp_rw chart_at, simp,
have:= upper_half_plane_is_open,
rw metric.is_open_iff at this,
have ht:= this x hx,
simp at ht,
exact ht,
simp_rw set.eq_on,
intros y hy,
apply ext_chart f (⟨y,hy⟩ : ℍ'),
end

lemma mdiff_iff_holo (f : ℍ' → ℂ) : (mdifferentiable 𝓘(ℂ) 𝓘(ℂ) f) ↔ is_holomorphic_on f :=
begin
split,
apply mdiff_to_holo f,
apply holo_to_mdiff f,
end

example (k : ℤ) (hk : 0 ≤ k) : ∃ (n : ℕ), (n : ℤ) = k :=
begin
exact can_lift.prf k hk,

end

local notation f `∣[`:73 k:0, A `]` :72 := slash_action.map ℂ k A f

lemma Eisenstein_series_is_mdiff (k : ℤ) (hk : 3 ≤ k) :
mdifferentiable 𝓘(ℂ, ℂ) 𝓘(ℂ, ℂ) (↑ₕ (Eisenstein_is_slash_inv ⊤ ↑k)) :=
begin
  have := Eisenstein_is_holomorphic k hk,
  have h2 := (mdiff_iff_holo (↑ₕ((Eisenstein_is_slash_inv ⊤ k).to_fun))).2 this,
  convert h2,
end

lemma Eisenstein_series_is_bounded (k : ℤ) (hk : 3 ≤ k) (A: SL(2, ℤ)) :
  is_bounded_at_im_infty ((↑ₕ(Eisenstein_is_slash_inv ⊤ k))∣[k ,A]) :=
begin
rw hol_extn,
simp_rw (Eisenstein_is_slash_inv ⊤ k).2,
have := Eisenstein_is_bounded k hk,
convert this,
have hr:= (Eisenstein_is_slash_inv ⊤ k).2 ⟨A, by {tauto}⟩,
have hr2: (Eisenstein_is_slash_inv ⊤ k).to_fun = Eisenstein_series_of_weight_ k, by {refl},
rw hr2 at hr,
convert hr,
end

def Eisenstein_series_is_modular_form (k : ℤ) (hk : 3 ≤ k) :
 modular_form  ⊤ k :=
{ to_fun :=  ↑ₕ(Eisenstein_is_slash_inv ⊤ k),
  slash_action_eq' := by {convert (Eisenstein_is_slash_inv ⊤ k).2},
  holo' := Eisenstein_series_is_mdiff k hk,
  bdd_at_infty' := λ A, Eisenstein_series_is_bounded k hk A}

end Eisenstein_series


import .love07_metaprogramming_demo

/- # LoVe Exercise 7: Metaprogramming -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: A Term Exploder

In this exercise, we develop a string format for the `expr` metatype. By
default, there is no `has_repr` instance to print a nice string. For example: -/

#eval (expr.app (expr.var 0) (expr.var 1) : expr)   -- result: `[external]`
#eval (`(λx : ℕ, x + x) : expr)                     -- result: `[external]`

/- 1.1. Define a metafunction `expr.repr` that converts an `expr` into a
`string`. It is acceptable to leave out some fields from the `expr`
constructors, such as the level `l` of a sort, the binder information `bi` of
a `λ` or `∀` binder, and the arguments of the `macro` constructor.

Hint: Use `name.to_string` to convert a name to a string, and `repr` for other
types that belong to the `has_repr` type class. -/

-- enter your definition here

/- We register `expr.repr` in the `has_repr` type class, so that we can use
`repr` without qualification in the future, and so that it is available to
`#eval`. We need the `meta` keyword in front of the command we enter. -/

meta instance expr.has_repr : has_repr expr :=
{ repr := expr.repr }

/- 1.2. Test your setup. -/

#eval (expr.app (expr.var 0) (expr.var 1) : expr)
#eval (`(λx : ℕ, x + x) : expr)

/- 1.3. Compare your answer with `expr.to_raw_fmt`. -/

#check expr.to_raw_fmt

/- ## Question 2: `destruct_and` on Steroids

Recall from the lecture that `destruct_and` fails on easy goals such as -/

lemma abc_ac₂ (a b c : Prop) (h : a ∧ b ∧ c) :
  a ∧ c :=
sorry

/- We will now address this by developing a new tactic called `destro_and`,
which applies both **des**truction and in**tro**duction rules for conjunction.
It will also go automatically through the hypotheses instead of taking an
argument. We will develop it in three steps.

2.1. Develop a tactic `intro_ands` that replaces all goals of the form
`a ∧ b` with two new goals `a` and `b` systematically, until all top-level
conjunctions are gone.

For this, we can use tactics such as `tactic.repeat` (which repeatedly applies a
tactic on all goals and subgoals until the tactic fails on each of the goal) and
`tactic.applyc` (which can be used to apply a rule, in connection with backtick
quoting). -/

meta def intro_ands : tactic unit :=
sorry

lemma abcd_bd (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
begin
  intro_ands,
  /- The proof state should be as follows:

  2 goals
  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ d -/
  repeat { sorry }
end

lemma abcd_bacb (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
begin
  intro_ands,
  /- The proof state should be as follows:

  4 goals
  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ a

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ c

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b -/
  repeat { sorry }
end

/- 2.2. Develop a tactic `destruct_ands` that replaces hypotheses of the form
`h : a ∧ b` by two new hypotheses `h_left : a` and `h_right : b` systematically,
until all top-level conjunctions are gone.

Here is imperative-style pseudocode that you can follow:

1. Retrieve the list of hypotheses from the context. This is provided by the
   metaconstant `local_context`.

2. Find the first hypothesis (= term) with a type (= proposition) of the form
   `_ ∧ _`. Here, you can use the `list.mfirst` function, in conjunction with
   pattern matching. You can use `infer_type` to query the type of a term.

3. Perform a case split on the first found hypothesis. This can be achieved
   using the `cases` metafunction.

4. Repeat.

The above procedure might fail if there exists no hypotheses of the required
form. Make sure to handle this failure gracefully, for example using
`tactic.try` or `<|> pure ()`. -/

meta def destruct_ands : tactic unit :=
sorry

lemma abcd_bd₂ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
begin
  destruct_ands,
  /- The proof state should be as follows:

  a b c d : Prop,
  h_left : a,
  h_right_right : d,
  h_right_left_left : b,
  h_right_left_right : c
  ⊢ b ∧ d -/
  sorry
end

/- 2.3. Combine the two tactics developed above and `tactic.assumption` to
implement the desired `destro_and` tactic. -/

meta def destro_and : tactic unit :=
sorry

lemma abcd_bd₃ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
by destro_and

lemma abcd_bacb₂ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
by destro_and

lemma abd_bacb (a b c d : Prop) (h : a ∧ b ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
begin
  destro_and,
  /- The proof state should be roughly as follows:

  a b c d : Prop,
  h_left : a,
  h_right_left : b,
  h_right_right : d
  ⊢ c -/
  sorry   -- unprovable
end

/- 2.4. Provide some more examples for `destro_and` to convince yourself that
it works as expected also on more complicated examples. -/

-- enter your examples here

/- ## Question 3 (**optional**): A Theorem Finder

We will implement a function that allows us to find theorems by constants
appearing in their statements. So given a list of constant names, the function
will list all theorems in which all these constants appear.

You can use the following metaconstants:

* `declaration` contains all data (name, type, value) associated with a
  declaration understood broadly (e.g., axiom, lemma, constant, etc.).

* `tactic.get_env` gives us access to the `environment`, a metatype that lists
  all `declaration`s (including all theorems).

* `environment.fold` allows us to walk through the environment and collect data.

* `expr.fold` allows us to walk through an expression and collect data.

3.1 (**optional**). Write a metafunction that checks whether an expression
contains a specific constant.

You can use `expr.fold` to walk through the expression, `||` and `ff` for
Booleans, and `expr.is_constant_of` to check whether an expression is a
constant. -/

meta def term_contains (e : expr) (nam : name) : bool :=
sorry

/- 3.2 (**optional**). Write a metafunction that checks whether an expression
contains **all** constants in a list.

You can use `list.band` (Boolean and). -/

meta def term_contains_all (nams : list name) (e : expr) : bool :=
sorry

/- 3.3 (**optional**). Produce the list of all theorems that contain all
constants `nams` in their statement.

`environment.fold` allows you to walk over the list of declarations. With
`declaration.type`, you get the type of a theorem, and with
`declaration.to_name` you get the name. -/

meta def list_constants (nams : list name) (e : environment) : list name :=
sorry

/- Finally, we develop a tactic that uses the above metafunctions to log all
found theorems: -/

meta def find_constants (nams : list name) : tactic unit :=
do
  env ← tactic.get_env,
  list.mmap' tactic.trace (list_constants nams env)

/- We test the solution. -/

run_cmd find_constants []   -- lists all theorems
run_cmd find_constants [`list.map, `function.comp]

end LoVe


/-
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
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.dynamics.fixed_points.basic
import Mathlib.topology.separation
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Topological properties of fixed points

Currently this file contains two lemmas:

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

## TODO

fixed points, iterates
-/

/-- If the iterates `f^[n] x` converge to `y` and `f` is continuous at `y`,
then `y` is a fixed point for `f`. -/
theorem is_fixed_pt_of_tendsto_iterate {α : Type u_1} [topological_space α] [t2_space α] {f : α → α} {x : α} {y : α} (hy : filter.tendsto (fun (n : ℕ) => nat.iterate f n x) filter.at_top (nhds y)) (hf : continuous_at f y) : function.is_fixed_pt f y := sorry

/-- The set of fixed points of a continuous map is a closed set. -/
theorem is_closed_fixed_points {α : Type u_1} [topological_space α] [t2_space α] {f : α → α} (hf : continuous f) : is_closed (function.fixed_points f) :=
  is_closed_eq hf continuous_id


import data.fintype

universe u

example {G : Type u} [group G] [fintype G] [decidable_eq G] (x : G) : ∃ n : ℕ, x ^ (n + 1) = 1 :=
begin
    -- The above means
    -- G is a type in some universe, is a group, has finite terms, equality of terms is "doable"...

    let f : fin (fintype.card G) → G := λ n , x ^ (n.1 + 1),
    -- fintype.card G takes fintype G and returns its cardinality
    -- x : fin n means x is a pair (k, Hk) where k : ℕ, Hk : k < n

    by_cases H : function.injective f ,
    cases nonempty_of_trunc (fintype.equiv_fin G), -- ???

    have H1 : function.surjective f, from
    (fintype.injective_iff_surjective_of_equiv val.symm ).1 H,
    -- fintype.blah : α, β same cardinality, f : α → β, then f inj ↔ f surj,
    have H2 : ∃ n : fin (fintype.card G), f n = 1, from H1 1,
    cases H2 with n Hn, -- Extracts n and pf that f n = 1 from H2
    use [n.1, Hn], -- 'use' only accepts term mode pfs

    unfold function.injective at H, -- Unfolds definition of 'injective' in H
    simp [not_forall] at H, -- Tells Lean '¬ ∀ → ∃' at H
    rcases H with ⟨m, n, H1, H2⟩, -- Extracts m, n, pf of f m = f n, m ≠ n from H
    cases lt_or_gt_of_ne H2,
      -- Breaks m ≠ n into m < n ∨ m > n becuz we don't have WLOG m < n working

      -- Pf of result when m < n
      -- Gist: x^((n - m - 1) + 1) = 1 , n - m - 1 is the number we looking for.
      have H01 : x^(n.1-m.1) * x^(m.1+1) = 1 * x^(m.1+1), from
      -- H01 is preparation for H02 to cancel x^(m.1 + 1) on both sides.
      -- Reminder: it'm n.1, m.1 becuz n, m : (number, pf)
      calc x^(n.1-m.1) * x^(m.1+1)
            = x^(n.1 - m.1 + (m.1+1))   : (pow_add x _ _).symm
        ... = x^(n.1+1)               : by rw [←add_assoc, nat.sub_add_cancel (le_of_lt h)]
        ... = x^(m.1+1)               : H1.symm
        ... = 1 * x^(m.1+1)           : (one_mul _).symm ,
      have H02 : x^(n.1 - m.1) = 1, from mul_right_cancel H01,
      have H03 : x^(n.1 - m.1 - 1 + 1) = 1, by rwa [nat.sub_add_cancel (nat.sub_pos_of_lt h)],
      -- 'rwa' rewrites then matches goal with an existing hypothesis, in this case H02.
      use [n.1 - m.1 - 1, H03], /- Tells Lean H03 is a pf that n.1 - m.1 - 1 satisfies
      the ∃ statement we are after. -/

      -- Repeated pf with m > n
      have H01 : x^(m.1-n.1) * x^(n.1+1) = 1 * x^(n.1+1), from
      calc x^(m.1-n.1) * x^(n.1+1)
            = x^(m.1 - n.1 + (n.1+1))   : (pow_add x _ _).symm
        ... = x^(m.1+1)               : by rw [← add_assoc, nat.sub_add_cancel (le_of_lt h)]
        ... = x^(n.1+1)               : H1
        ... = 1 * x^(n.1+1)           : (one_mul _).symm ,
      have H02 : x^(m.1 - n.1) = 1, from mul_right_cancel H01,
      have H03 : x^(m.1 - n.1 - 1 + 1) = 1, by rwa [nat.sub_add_cancel (nat.sub_pos_of_lt h)],
      use [m.1 - n.1 - 1, H03],
      /- Note - How to swap n'm & m'm (For Mac OS / ):
      0. Press Option-Command-F. This opens the Replace window.
      1. Highlight section. In this case lines 47 to 55.
      2. Press button to the right of ->. This restrict changes to the highlighted section.
      3. Type \bn\n into top box. This locates all 'isolated' n's.
      4. Type t into bottom box, then Command-Enter. This replaces all n's with t's.
      5. Now repeat step 3,4 to replace all m with n's.
      6. Repeat step 3,4 to replace all t's with m's. -/
end

-- Lemmas used
#check @fintype.injective_iff_surjective_of_equiv
#check @fintype.equiv_fin
#print function.surjective
#check @eq.subst
#check @lt_or_gt_of_ne
#check sub_add_cancel
#check @sub_pos_of_lt