import .lagrange_four_square tactic.ring data.set.finite .int_gcd data.int.modeq data.int.basic data.nat.modeq data.equiv data.fintype data.nat.prime data.nat.gcd tactic.norm_num group_theory.order_of_element
universe u
local attribute [instance, priority 0] classical.prop_decidable

open int int.modeq
@[reducible]
def Z_aux (n : ℤ) : Type := ℤ

instance Zmod_setoid {n : ℤ} : setoid (Z_aux n) :=
{ r := int.modeq n,
  iseqv := ⟨int.modeq.refl, @int.modeq.symm n, @int.modeq.trans n⟩ }

def Zmod (n : ℤ) : Type := quotient (@Zmod_setoid n)

lemma setoid_eq {α : Type*} : ∀ {a b : setoid α}, a.r = b.r → a = b
| ⟨ar, ha⟩ ⟨br, hb⟩ rfl := rfl

lemma Zmod_eq_Zmod_neg (n : ℤ) : Zmod n = (Zmod (-n)) :=
by unfold Zmod Zmod_setoid; exact
congr rfl (setoid_eq (begin
  funext,
  unfold setoid.r int.modeq,
  rw [← int.mod_abs _ (- _), ← int.mod_abs _ (- _), abs_neg, ← int.mod_abs _ n, ← int.mod_abs _ n],
end))

namespace Zmod

private def add_aux {n : ℤ} (a b : Zmod n) : Zmod n :=
quotient.lift_on₂ a b (λ a b, ⟦a + b⟧) (λ a b c d hac hbd, quotient.sound (modeq_add hac hbd))

private def mul_aux {n : ℤ} (a b : Zmod n) : Zmod n :=
quotient.lift_on₂ a b (λ a b, ⟦a * b⟧) (λ a b c d hac hbd, quotient.sound (modeq_mul hac hbd))

private def neg_aux {n : ℤ} (a : Zmod n) : Zmod n :=
quotient.lift_on a (λ a, ⟦-a⟧) (λ a b hab, quotient.sound (modeq_neg hab))

instance (n : ℤ) : comm_ring (Zmod n) :=
{ add := add_aux,
  add_assoc := λ a b c, quotient.induction_on₃ a b c (λ a b c, quotient.sound (by rw add_assoc)),
  zero := ⟦0⟧,
  zero_add := λ a, quotient.induction_on a (λ a, quotient.sound (by rw zero_add)),
  add_zero := λ a, quotient.induction_on a (λ a, quotient.sound (by rw add_zero)),
  neg := neg_aux,
  add_left_neg := λ a, quotient.induction_on a (λ a, quotient.sound (by rw add_left_neg)),
  add_comm := λ a b, quotient.induction_on₂ a b (λ a b, quotient.sound (by rw add_comm)),
  mul := mul_aux,
  mul_assoc := λ a b c, quotient.induction_on₃ a b c (λ a b c, quotient.sound (by rw mul_assoc)),
  one := ⟦1⟧,
  one_mul := λ a, quotient.induction_on a (λ a, quotient.sound (by rw one_mul)),
  mul_one := λ a, quotient.induction_on a (λ a, quotient.sound (by rw mul_one)),
  left_distrib := λ a b c, quotient.induction_on₃ a b c (λ a b c, quotient.sound (by rw left_distrib)),
  right_distrib := λ a b c, quotient.induction_on₃ a b c (λ a b c, quotient.sound (by rw right_distrib)),
  mul_comm := λ a b, quotient.induction_on₂ a b (λ a b, quotient.sound (by rw mul_comm)) }

instance (n : ℤ) : has_coe ℤ (Zmod n) := ⟨quotient.mk⟩

instance Zmod_coe_nat (n : ℤ) : has_coe ℕ (Zmod n) := ⟨quotient.mk ∘ coe⟩

@[simp] lemma coe_nat_coe_int (n : ℤ) (a : ℕ) : (((a : ℕ) : ℤ) : Zmod n) = (a : Zmod n) := rfl

@[simp] lemma mk_eq_coe (n a : ℤ) : (⟦a⟧ : Zmod n) = (a : Zmod n) := rfl

@[simp] lemma coe_int_zero (n : ℤ) : ((0 : ℤ) : Zmod n) = 0 := rfl

@[simp] lemma coe_int_one (n : ℤ) :  ((1 : ℤ) : Zmod n) = 1 := rfl

@[simp] lemma coe_int_bit0 (n a : ℤ) : ((bit0 a : ℤ) : Zmod n) = bit0 (a : Zmod n) := rfl

@[simp] lemma coe_int_bit1 (n a : ℤ) : ((bit1 a : ℤ) : Zmod n) = bit1 (a : Zmod n) := rfl

lemma coe_int_add (a b n : ℤ) : ((a + b : ℤ) : Zmod n) = a + b := rfl

lemma coe_int_mul (a b n : ℤ) : ((a * b : ℤ) : Zmod n) = a * b := rfl

lemma coe_int_neg (a n : ℤ) : ((-a : ℤ) : Zmod n) = -a := rfl

@[simp] lemma coe_int_mod (a n : ℤ) : ((a % n : ℤ) : Zmod n) = a := quotient.sound (int.mod_mod _ _)

lemma coe_int_pow (a n : ℤ) (k : ℕ) : ((a ^ k : ℤ) : Zmod n) = a ^ k :=
by induction k; simp [pow_succ, *, coe_int_mul]

lemma coe_int_sub (a b n : ℤ) : ((a - b : ℤ) : Zmod n) = a - b := rfl

@[simp] lemma coe_nat_zero (n : ℤ) : ((0 : ℕ) : Zmod n) = 0 := rfl

@[simp] lemma coe_nat_one (n : ℤ) :  ((1 : ℕ) : Zmod n) = 1 := rfl

@[simp] lemma coe_nat_bit0 (n : ℤ) (a : ℕ) : ((bit0 a : ℕ) : Zmod n) = bit0 (a : Zmod n) := rfl

@[simp] lemma coe_nat_bit1 (n : ℤ) (a : ℕ) : ((bit1 a : ℕ) : Zmod n) = bit1 (a : Zmod n) := rfl

lemma coe_nat_add (a b : ℕ) (n : ℤ) : ((a + b : ℕ) : Zmod n) = a + b := rfl

lemma coe_nat_mul (a b : ℕ) (n : ℤ) : ((a * b : ℕ) : Zmod n) = a * b := rfl

lemma eq_iff_modeq_nat {n : ℤ} {a b : ℕ} : a ≡ b [MOD n.nat_abs] ↔ (a : Zmod n) = (b : Zmod n) :=
⟨λ h, quotient.sound (int.modeq.modeq_iff_dvd.2 (int.nat_abs_dvd.1 (nat.modeq.modeq_iff_dvd.1 h))),
λ h, nat.modeq.modeq_iff_dvd.2 (int.nat_abs_dvd.2 (int.modeq.modeq_iff_dvd.1 (quotient.exact h)))⟩

lemma eq_iff_modeq_int {n a b : ℤ} : a ≡ b [ZMOD n] ↔ (a : Zmod n) = b :=
⟨λ h, quotient.sound h, λ h, quotient.exact h⟩

@[simp] lemma coe_nat_mod (a n : ℕ) : ((a % n : ℕ) : Zmod n) = a := eq_iff_modeq_nat.1 (nat.mod_mod _ _)

lemma coe_nat_sub {a b : ℕ} (n : ℤ) (h : b ≤ a) : ((a - b : ℕ) : Zmod n) = a - b :=
show (((a - b : ℕ) : ℤ) : Zmod n) = a - b, by rw int.coe_nat_sub h; refl

def to_nat {n : ℤ} (a : Zmod n) : ℕ :=
quotient.lift_on a (λ a, nat_abs (a % n))
  (λ a b (hab : _ = _), or.cases_on (classical.em (n = 0))
    (λ hn, by simp * at *)
    (λ hn, int.coe_nat_inj
      (by simpa [int.nat_abs_of_nonneg (mod_nonneg a hn),
        int.nat_abs_of_nonneg (mod_nonneg b hn)])))

lemma to_nat_lt {n : ℤ} (hn : n ≠ 0) (a : Zmod n) : a.to_nat < n.nat_abs :=
quotient.induction_on a (λ a, show (a % n).nat_abs < n.nat_abs,
    from int.coe_nat_lt.1
      (by rw [int.nat_abs_of_nonneg (mod_nonneg a hn), ← abs_eq_nat_abs];
        exact mod_lt _ hn))

@[simp] lemma coe_to_nat {n : ℤ} (hn : n ≠ 0) (a : Zmod n) : (a.to_nat : Zmod n) = a :=
quotient.induction_on a (λ a : ℤ, show (((a % n).nat_abs : ℤ) : Zmod n) = a,
  by rw [nat_abs_of_nonneg (mod_nonneg _ hn), coe_int_mod])

def equiv_fin {n : ℤ} (hn : n ≠ 0) : Zmod n ≃ fin (nat_abs n) :=
{ to_fun := λ a, ⟨a.to_nat, to_nat_lt hn a⟩,
  inv_fun := λ a, ⟦a.1⟧,
  left_inv := λ a, quotient.induction_on a (λ a, quotient.sound
    (show ↑(a % n).nat_abs % n = _,
      by rw nat_abs_of_nonneg (mod_nonneg a hn);
        exact int.mod_mod _ _)),
  right_inv := λ ⟨a, ha⟩,
    have ha' : (a : ℤ) < abs n := (abs_eq_nat_abs n).symm ▸ int.coe_nat_lt.2 ha,
    fin.eq_of_veq (show ((a : ℤ) % n).to_nat = a,
      from int.coe_nat_inj
        (by rw [to_nat_of_nonneg (mod_nonneg a hn), ← mod_abs];
          exact mod_eq_of_lt (int.coe_nat_le.2 (nat.zero_le a)) ha')) }

def Zmod_fintype {n : ℤ} (hn : n ≠ 0) : fintype (Zmod n) :=
fintype.of_equiv _ (equiv_fin hn).symm

lemma card_Zmod {n : ℤ} (hn : n ≠ 0) : @fintype.card (Zmod n) (Zmod_fintype hn) = n.nat_abs :=
fintype.card_fin n.nat_abs ▸ @fintype.card_congr _ _ (Zmod_fintype hn) _ (equiv_fin hn)

private def inv_aux {n : ℤ} (a : Zmod n) : Zmod n :=
quotient.lift_on a (λ a, (⟦(nat.gcd_a (a % n).nat_abs n.nat_abs : ℤ)⟧ : Zmod n))
  (λ a b (hab : _ = _),
     by unfold nat_mod; rw hab)

instance (n : ℤ) : has_inv (Zmod n) := ⟨inv_aux⟩

@[simp] lemma int.gcd_neg (a b : ℤ) : gcd (-a) b = gcd a b :=
by unfold gcd; rw nat_abs_neg

lemma gcd_a_modeq (a b : ℕ) : (a : ℤ) * nat.gcd_a a b ≡ nat.gcd a b [ZMOD b] :=
by rw [← add_zero ((a : ℤ) * _), nat.gcd_eq_gcd_ab];
  exact int.modeq.modeq_add rfl (int.modeq.modeq_zero_iff.2 (dvd_mul_right _ _)).symm

lemma mul_inv_eq_gcd_nat (n a : ℕ) : (a : Zmod n) * a⁻¹ = nat.gcd a n :=
show (a :  Zmod n) * (nat.gcd_a (a % n) n) = nat.gcd a n, from
by rw [nat.gcd_comm, nat.gcd_rec, ← coe_nat_coe_int _ (nat.gcd _ _), ← eq_iff_modeq_int.1 (gcd_a_modeq _ _),
    coe_int_mul, coe_nat_coe_int, coe_nat_mod]

lemma mul_inv_eq_gcd_int (n a : ℤ) (hn : n ≠ 0) : (a : Zmod n) * a⁻¹ = int.gcd a n :=
have ha : (a : Zmod n) = (a % n.nat_abs).nat_abs :=
  by rw [← coe_nat_coe_int, ← abs_eq_nat_abs n, mod_abs,
    int.nat_abs_of_nonneg (int.mod_nonneg _ hn), coe_int_mod],
have h : ∀ a : ℕ, (a : ℤ) * nat.gcd_a a n.nat_abs ≡ nat.gcd a n.nat_abs [ZMOD n] :=λ a,
begin
  unfold int.modeq,
  rw [← mod_abs _ n, ← mod_abs _ n, abs_eq_nat_abs],
  exact gcd_a_modeq _ _,
end,
show (a :  Zmod n) * (nat.gcd_a (a % n).nat_abs n.nat_abs) = int.gcd a n,
begin
  rw [ha, gcd_comm, ← int.gcd_mod, int.gcd, ← mod_abs _ n, abs_eq_nat_abs, ← coe_nat_coe_int _ (nat.gcd _ _),
    ← eq_iff_modeq_int.1 (h _)],
  refl,
end

private lemma mul_inv_cancel_aux {p : ℕ} (hp : nat.prime p) {a : Zmod p} : a ≠ 0 →
    a * a⁻¹ = (1 : Zmod p) :=
quotient.induction_on a (λ (a : ℤ) ha, begin
  rw [mk_eq_coe, ne.def, ← coe_int_zero, ← eq_iff_modeq_int, modeq_zero_iff,
    ← dvd_nat_abs, ← nat_abs_dvd, int.coe_nat_dvd] at ha,
  have : gcd p a = 1 := hp.coprime_iff_not_dvd.2 ha,
  rw [mk_eq_coe, mul_inv_eq_gcd_int _ _ (ne_of_lt (int.coe_nat_lt.2 hp.pos)).symm, gcd_comm, this, coe_nat_one],
end)

def Zmod_prime_field {p : ℕ} (hp : nat.prime p) : discrete_field (Zmod p) :=
{ inv := has_inv.inv,
  zero_ne_one := λ h,
    let h : (0 : ℤ) % p = 1 % p := quotient.exact h in
    begin
      rw mod_eq_of_lt (le_refl (0 : ℤ)) (int.coe_nat_lt.2 hp.pos) at h,
      rw mod_eq_of_lt (show (0 : ℤ) ≤ 1, by norm_num) (int.coe_nat_lt.2 hp.gt_one) at h,
      exact absurd h dec_trivial,
    end,
  mul_inv_cancel := λ a ha, mul_inv_cancel_aux hp ha,
  inv_mul_cancel := λ a ha, by rw mul_comm; exact mul_inv_cancel_aux hp ha,
  has_decidable_eq := by apply_instance,
  inv_zero :=
    show ((nat.xgcd_aux (nat_abs (0 % p)) 1 0 p 0 1).2.1 : Zmod p) = 0,
    begin
      rw zero_mod,
      change nat_abs 0 with 0,
      rw nat.xgcd_zero_left,
      refl,
    end,
  ..Zmod.comm_ring p }

instance (p : {p // nat.prime p}) : discrete_field (Zmod p) := Zmod_prime_field p.2

instance (p : {p // nat.prime p}) : fintype (Zmod p) := Zmod_fintype (ne_of_lt (int.coe_nat_lt.2 p.2.pos)).symm

noncomputable lemma fintype.of_injective {α β : Type*} [fintype α] (f : β → α)
  (hf : function.injective f) : fintype β :=
by haveI := classical.dec_eq β; exact
classical.choice (or.cases_on (classical.em (nonempty β))
(λ h, by haveI : inhabited β := ⟨classical.choice h⟩; exact
⟨fintype.of_surjective (function.inv_fun f) (function.inv_fun_surjective hf)⟩)
(λ h, ⟨⟨∅, λ x, false.elim (h ⟨x⟩)⟩⟩))

noncomputable instance fintype_units {α : Type*} [fintype α] [monoid α] : fintype (units α) :=
fintype.of_injective units.val (λ x y h, units.ext h)

lemma fintype.card_pos {α : Type*} [fintype α] (a : α) : 0 < fintype.card α :=
nat.pos_of_ne_zero (λ h, begin
  have : α ≃ fin 0 := eq.rec_on h (trunc.out (fintype.equiv_fin α)),
  exact fin.elim0 (this.1 a),
end)

def units_equiv_ne_zero (p : {p // nat.prime p}) : units (Zmod p) ≃ {a : Zmod p // a ≠ 0} :=
{ to_fun := λ ⟨a, b, h₁, h₂⟩, ⟨a, λ h, by rw [h, zero_mul] at h₁; exact zero_ne_one h₁⟩,
  inv_fun := λ ⟨a, ha⟩, ⟨a, a⁻¹, mul_inv_cancel ha, inv_mul_cancel ha⟩,
  left_inv := λ ⟨a, b, h₁, h₂⟩,
    have ha : a ≠ 0 := λ h, by rw [h, zero_mul] at h₁; exact zero_ne_one h₁,
    suffices h : a⁻¹ = b, by simp! [h],
      by rw [← one_mul (a⁻¹), ← h₂, mul_assoc, mul_inv_cancel ha, mul_one],
  right_inv := λ ⟨a, ha⟩, rfl }

def equiv_univ (α : Type*) : α ≃ @set.univ α := ⟨λ x, ⟨x, trivial⟩, λ x, x.1, λ _, rfl, λ ⟨_, _⟩, rfl⟩

lemma fintype.card_ne {α : Type u} [fintype α] [decidable_eq α] (a : α) :
  @fintype.card {b | b ≠ a} (set_fintype {b | b ≠ a}) = fintype.card α - 1 :=
begin
  haveI := set_fintype {b | b ≠ a},
  haveI := set_fintype (@set.univ α),
  haveI := classical.prop_decidable,
  have ha : a ∉ {b : α | b ≠ a} := by simp [set.mem_def],
  have h2 : 1 ≤ fintype.card (@set.univ α) := fintype.card_pos ⟨a, trivial⟩,
  rw [fintype.card_congr  (equiv_univ α), eq_comm,
    nat.sub_eq_iff_eq_add, ← @set.card_insert _ _ a],
  simp [set.insert, classical.em],
  congr,
  assumption,
  assumption,
end

lemma card_units_prime {p : {p // nat.prime p}} : @fintype.card (units (Zmod p))
  (@Zmod.fintype_units _ (Zmod_fintype (ne_of_lt (int.coe_nat_lt.2 p.2.pos)).symm) _) = p - 1 :=
begin
  change (p : ℕ) with ((p : ℤ).nat_abs),
  rw [← card_Zmod (show (p : ℤ) ≠ 0, from (ne_of_lt (int.coe_nat_lt.2 p.2.pos)).symm),
    fintype.card_congr (units_equiv_ne_zero _), ← fintype.card_ne (0 : Zmod p)],
  refl,
end

lemma units.pow_coe {α : Type*} [monoid α] {a : units α} {n : ℕ} : ((a ^ n : units α ) : α) = (a : α) ^ n :=
by induction n; simp [pow_succ, *]

lemma fermat_little {p : {p // nat.prime p}} {a : Zmod p}
  (ha : a ≠ 0) : a ^ ((p : ℕ) - 1) = 1 :=
begin
  have := units.val_coe (units.mk0 _ ha),
  change (a : Zmod p) with ((units.mk0 _ ha).1 : Zmod p),
  rw [← units.val_coe, ← units.pow_coe, ← card_units_prime, pow_eq_mod_order_of,
    nat.mod_eq_zero_of_dvd (order_of_dvd_card_univ )],
  simp
end

lemma odd_sub_one_even {n : ℕ} (ho : n % 2 = 1) : 2 ∣ n - 1 :=
begin
  rw [← nat.mod_add_div n 2, ho, nat.add_sub_cancel_left],
  exact dvd_mul_right _ _
end

lemma pow_half_prime_sub_one_eq_one_or_neg_one {p : {p // nat.prime p}} (hpo : (p : ℕ) % 2 = 1) {a : Zmod p}
  (ha : a ≠ 0) : a ^ (((p : ℕ) - 1) / 2) = 1 ∨ a ^ (((p : ℕ) - 1) / 2) = -1 :=
begin
  have := fermat_little ha,
  rw [← nat.mul_div_cancel' (odd_sub_one_even hpo), pow_mul, pow_two, mul_pow] at this,
  exact (mul_self_eq_one_iff _).1 this
end

instance units_comm (α : Type*) [comm_monoid α] : comm_group (units α) :=
{ mul_comm := λ a b, units.ext
    (show ((a * b : units α) : α) = ((b * a : units α) : α),
      by simp [units.mul_coe, mul_comm]),
  ..units.group }

open finset

lemma int.coe_nat_ne_zero_of_pos {n : ℕ} : 0 < n → (n : ℤ) ≠ 0 :=
ne.symm ∘ ne_of_lt ∘ int.coe_nat_lt.2

lemma prod_finset_distinct_inv {α : Type*} [discrete_field α] {s : finset α} :
  (∀ x ∈ s, x⁻¹ ∈ s) → (∀ x ∈ s, x⁻¹ ≠ x) → s.prod id = 1 :=
finset.strong_induction_on s $ λ s ih h₁ h₂, or.cases_on (classical.em (s = ∅))
  (λ h, by simp [h])
  (λ h, have h0 : ∀ (y : α), y ∈ s → y ≠ 0 := λ y hy h,
    (show (0 : α)⁻¹ ≠ 0, from h ▸ (h₂ y hy)) (by simp),
  let ⟨x, hx⟩ := exists_mem_of_ne_empty h in
  have hxi : x⁻¹ ∈ s.erase x := mem_erase.2 ⟨h₂ x hx, h₁ x hx⟩,
  have ht : erase (erase s x) x⁻¹ ⊂ s := lt_iff_ssubset.1 (lt.trans (erase_ssubset hxi) (erase_ssubset hx)),
  have ht₁ : ∀ y ∈ erase (erase s x) x⁻¹, y⁻¹ ∈ erase (erase s x) x⁻¹ :=
    λ y hy, by rw [mem_erase, mem_erase] at *;
      exact ⟨λ h, hy.2.1 (begin
        rw [inv_eq_one_div, inv_eq_one_div, div_eq_div_iff (h0 y hy.2.2) (h0 x hx), one_mul, one_mul] at h,
        exact h.symm,
      end), λ h, hy.1 (by rw[← h, inv_eq_one_div, inv_eq_one_div, one_div_div, div_one]), h₁ y hy.2.2⟩,
  have ht₂ : ∀ y ∈ erase (erase s x) x⁻¹, y⁻¹ ≠ y := λ y hy,
    by rw [mem_erase, mem_erase] at hy;
    exact h₂ y hy.2.2,
  begin
    rw [← insert_erase hx, prod_insert (not_mem_erase _ _), ← insert_erase hxi,
      prod_insert (not_mem_erase _ _), ih _ ht ht₁ ht₂],
    simp [mul_inv_cancel (h0 x hx)],
  end)

lemma ne_neg {n : ℕ} (ho : n % 2 = 1) {a : Zmod n} (ha : a ≠ 0) : a ≠ -a :=
have hn : (n : ℤ) ≠ 0 := λ h, by rw int.coe_nat_inj h at ho; contradiction,
begin
  rw [← coe_to_nat hn a, ne.def, eq_neg_iff_add_eq_zero, ← coe_nat_add, ← coe_nat_zero,
    ← eq_iff_modeq_nat, nat.modeq.modeq_zero_iff, nat_abs_of_nat],
  refine not_exists.2 (λ x h, _),
  rw ← mul_two at h,
  have : to_nat a * 2 < n * 2 := (mul_lt_mul_right (show 2 > 0, from dec_trivial)).2
    (to_nat_lt hn _),
  rw h at this,
  cases x,
  { rw mul_zero at h,
    have := or.resolve_right (nat.eq_zero_of_mul_eq_zero h) dec_trivial,
    rw [← coe_to_nat hn a, this] at ha,
    contradiction },
  { cases x,
    { rw mul_one at h,
      rw [← h, nat.mul_mod_left] at ho,
      contradiction },
    { exact absurd (lt_of_mul_lt_mul_left this (nat.zero_le _)) dec_trivial } }
end

lemma wilson_lemma {p : {p // nat.prime p}} (hpo : (p : ℕ) % 2 = 1) :
  ((univ : finset (Zmod p)).erase 0).prod id = -1 :=
have h10 : (1 : Zmod p) ≠ 0 := by rw [← coe_nat_one, ← coe_nat_zero, ne.def,
      ← eq_iff_modeq_nat, nat.modeq.modeq_zero_iff]; exact p.2.not_dvd_one,
have h₁ : (1 : Zmod p) ∈ univ.erase (0 : Zmod p) := mem_erase.2 ⟨h10, mem_univ _⟩,
have h₂ : (-1 : Zmod p) ∈ (erase (erase univ (0 : Zmod p)) 1) :=
  mem_erase.2 ⟨ne.symm (ne_neg hpo h10),
    mem_erase.2 ⟨(by rw [ne.def, neg_eq_iff_neg_eq, neg_zero]; exact h10.symm),
      mem_univ _⟩⟩,
have h₃ : ∀ (x : Zmod ↑p), x ∈ erase (erase (erase univ (0 : Zmod p)) 1) (-1) →
    x⁻¹ ∈ erase (erase (erase univ (0 : Zmod p)) 1) (-1) := λ x hx, begin
  rw [mem_erase, mem_erase, mem_erase] at *,
  rw [ne.def, ne.def, ne.def, inv_eq_one_div, div_eq_iff_mul_eq hx.2.2.1, div_eq_iff_mul_eq hx.2.2.1,
    div_eq_iff_mul_eq hx.2.2.1, neg_mul_comm, one_mul, one_mul, zero_mul, neg_eq_iff_neg_eq],
  exact ⟨hx.1.symm, hx.2.1, h₁.1.symm, mem_univ _⟩,
end,
have h₄ : ∀ (x : Zmod ↑p), x ∈ erase (erase (erase univ (0 : Zmod p)) 1) (-1) → x⁻¹ ≠ x := λ x hx, begin
  rw [mem_erase, mem_erase, mem_erase] at hx,
  rw [ne.def, inv_eq_one_div, div_eq_iff_mul_eq hx.2.2.1, mul_self_eq_one_iff, not_or_distrib],
  exact ⟨hx.2.1, hx.1⟩
end,
begin
  rw [← insert_erase h₁, prod_insert (not_mem_erase _ _), ← insert_erase h₂,
    prod_insert (not_mem_erase _ _), prod_finset_distinct_inv h₃ h₄],
  simp,
end

lemma euler_criterion {p : {p // nat.prime p}} (hpo : (p : ℕ) % 2 = 1) {a : units (Zmod p)}
  : (∃ x, x * x = a) ↔ a ^ (((p : ℕ) - 1) / 2) = 1 :=
have h₁ : {b : units (Zmod p) | ∃ x, x * x = b} ⊆ {b | b ^ (((p : ℕ) - 1) / 2) = 1} :=
λ b ⟨x, hx⟩,
show b ^ (((p : ℕ) - 1) / 2) = 1,
begin
  rw [← hx, ← pow_two, ← pow_mul, nat.mul_div_cancel' (odd_sub_one_even hpo)],
  exact fermat_little hx0,
end,
begin

end

#eval ((12345 : Zmod 145975)⁻¹).to_nat
#eval 12345 * 3169 % 145975
end Zmod


import .composition

namespace hidden

/-
Composition. It's what ∘ does with functions. Now
we generalize to composition but in a category of
computationally embellished functions, rather than
in the catetory or ordinary functions we've been
using all along.

A pure function, f : α → β, associates objects
of type α with objects of type, β. The magic is
in how they compose: (g : β → γ) → (f : α → β) →
(α → γ), denoted as g ∘ f, pronounced "g after f,"
and defined as (g ∘ f) a = g (f a): "g after f,"
"applied to a." The output of f is "piped" to the
input of g.

Now we turn to an analogous notion of composition:
no longer of pure functions, but the compoisition
of functions that perform auxiliary computations
and and return "embellished" results, or results,
if any, in a larger context.

While a pure function, f : α → β, takes pure α
values to pure β values, a "monadic" function,
mf, takes a pure α value to an embellished β
value, of type m β, with m, being a "context"
type constructor. Thus, mf : α → m β. Results
(of type β) are now embellished: being carried
now (or not) within context-extended values of
type m β.

What does a monad do? It gives us a more powerful
version of >>, in the form of a generic function,
call bind, denoted >>=, that enables one to add
compose functions but with extra hidden processing
of "metadata" as a composition is evaluated. Monads
give us *function composition with extra effects*.
-/

/-
Let's illustrate this idea by continuing with our
dog examle above. Evaluating messy applied to a dog
will result in three function application operations.
What if we wanted a way to have the application of
a compositions of functions return both the expected
"pure" answer along with a natural number count of
the number of pure function applications that were
performed along the way. That is, the result will be
an embellished pure answer: we will get both a pure
yesno answer *and* a count of operations performed.

For example, now we'd expect the result of evaluating
(messy fido) to return not just "yes" but the pair,
"(yes, 3)," meaning yes fido's messy and oh by the
way, computing this answer took three ordinary
function applications.
-/

/-
Clearly the types of the functions that we need to
"compose" changes. Each function in the "chain"
needs to return not just the correct "pure" result
but also a natural number accounting for the call
to this function and to any other functions it might
have called. Focus on the types of these embellished
functions.
-/

universe u

def profiled_result (α : Type u) := α × ℕ

def m_breed : dogs → profiled_result breeds :=
  λ d, (breed d, 1)

def m_coat : breeds → profiled_result coats :=
  λ b, (coat b, 1)

def m_sheds : coats → profiled_result yesno :=
  λ c, (sheds c, 1)

/-
Recall that pure function compose in a very simple
way: the output of one is fed to the input of the
next.
-/

#check coat ∘ breed

/-
Our embellished functions won't compose this way.
The m_breed function, for example, takes a dog and
returns a *pair* of result, containing it's breed
and the value 1. We can't feed this pair to m_coat
because it, too, takes a pure breed value as its
argument.
-/

#check m_coat ∘ m_breed   -- type error!

/-
We need to define a new form of function composition.
Let's just write a concrete implementation of what we
need for our concrete example; then we can generalize
from there to discover the general principles that are
involved.
-/

/-
The key trick in the following implementation is to
"destructure" the pair returned by each embellished
function, and to bind names its component values. In
this way, we get a handle on both the pure result and
on the embellishment (here a count of operations). We
can then pass the pure value to the next embellished
function in line, and compose the return operation
counts (embellishments) "on the side."
-/

def messy'' : dogs → yesno × ℕ :=
λ d,
  let
    (b, n1) := m_breed d in let -- use d, get b, n1
    (c, n2) := m_coat b in let  -- use b, get  c, n2
    (s, n3) := m_sheds c in     -- use c, get s, n3
    (s, n1+n2+n3)               -- final result

-- Let's compute whether polly is messy''
open dogs
#reduce messy'' polly
-- No. And it took 3 operations to compute.

/-
Now that we've got this trick in our bag, we can
use to write a function that composes our embellished
functions. Let's start simply by composing m_coat and
m_breed to obtain a function of type dog → (coats × ℕ).

- m_breed : dogs → (breeds × ℕ)
- m_coat : breeds → (coats × ℕ)
-/

def compose_coat_breed :
  (dogs → (breeds × ℕ)) → (breeds → (coats × ℕ)) → (dogs → (coats × ℕ))
| db bc :=
  λ (d : dogs),
    let (b, c1) := db d in
    let (c, c2) := bc b in
    (c, c1+c2)

/-
We can now see that the composition of m_breed and m_coat using our
new, special case, compose-like function does two things: it computes
the desired composition of the pure functions, breed and coat, while
also combining the effects of m_breed and m_coat in an effect that is
returned along with the pure result.
-/
#reduce compose_coat_breed m_breed m_coat
#reduce (compose_coat_breed m_breed m_coat) polly

/-
Now the question is, can we generalize the approach
we've taken to the special case of composing m_coat
and m_breed? Let's start by factoring out the common
structure  of the embellished arguments: each is of
a pair type, where the second element is of type ℕ.
This is our profile_result type, polymorphic in one
type argument: the type of pure result to be returned
"in a context."

-/

#check profiled_result

def compose_coat_breed' :
  (dogs → (profiled_result breeds)) →
  (breeds → (profiled_result coats)) →
  (dogs → profiled_result coats)
| db bc :=
  λ (d : dogs),
    let (b, c1) := db d in
    let (c, c2) := bc b in
    (c, c1+c2)

/-
Next we generalize the pure argument and result types.
-/

def prof_compose {α β γ : Type} :
  (α → (profiled_result β)) →
  (β → (profiled_result γ)) →
  (α → profiled_result γ)
| f g :=
  λ (a : α),
    let (b, c1) := f a in
    let (c, c2) := g b in
    (c, c1+c2)

/-
Finally, we generalize profiled_result to any kind
of object possibly containing values of type α, which
is to say, to an object of type m α for some type
constructor, m.
-/

def m_compose'
  {α β γ : Type} (m : Type → Type):  (α → m β) → (β → m γ) → (α → m γ)
| f g :=
  λ (a : α),
    let (b, c1) := f a in   -- uh oh, m not necessarily a pair!
    let (c, c2) := g b in   -- need different implementations per m!
    (c, c1+c2)

/-
The problem is that we can no longer rely on a value of type
(m α) to be a pair, which is what we have assumed in the let
expressions up to now. If m is, say, list or option, then an
implementation of composition for pairs isn't going to work.
We need a different implementation for option, a different one,
again, for list, and so forth. Indeed, for each type builder,
m, we'll need a different implementation of the binding code,
where we bind b to the "pure" result of applying f to a then
then treat b as an argument to the rest of the computation.
-/

/-
That is, we need an overloaded definition of m_compose for
each "context-imposing" type, m. Central to this goal is an
operation that takes an effectful value, m α, understood as
the embellished value returned by a previous computation,
and a function from α → m β, the next function in line, and
that destructures the (m α) value, whatever it might be, in
order to get at any pure values and embellished values that
it might contain, and that passes the pure values on to the
next function while also handling the embellishments. That
is, we're going to need an overloaded operation, as follows.
-/

class has_bind' (m : Type → Type) :=
(bind : ∀ {α β : Type}, m α → (α → m β) → m β)

/-
Here's the standard infix notation for bind.
You can read it as "feeding" a monadic value
into a monadic function to obtain a monadic
result.
-/

local infixl ` >>= `:55 := has_bind'.bind

/-
With our abstract bind operator in hand we can
how implement a polymorphic composition operator
for monadic functions!
-/

def m_compose
  {α β γ : Type}
  {m : Type → Type} [has_bind' m]
  (f : α → m β)
  (g : β → m γ) :
  (α → m γ) :=
λ a : α,
  let mb := f a in mb >>= g

/-
To use this machinery we do need to implement
has_bind for each given type of monadic context.
Let's do this for our "profiled_result" monad.
-/
instance : has_bind' (profiled_result) :=
⟨
  λ {α β : Type } (ma : profiled_result α) a2mb,
    let (a, c1) := ma in
    let (b, c2) := a2mb a in
    (b, c1+c2)
⟩

/-
We can now see how it all works.
-/

#reduce m_compose m_breed m_coat

local infixl ` >=> `:60 := m_compose  -- the fish operator

def is_messy_prof := (m_breed >=> m_coat >=> m_sheds)

#reduce is_messy_prof fido
#reduce is_messy_prof polly

#reduce polly >>= (m_breed >=> m_coat >=> m_sheds)
/-
So the fish operator supports the feeding of
a monadic value into a composition of monadic
functions. What is doesn't support is feeding
of a pure value into such a pipeline, as the
following example shows.
-/

/-
The problem is that polly is pure but >=> expects
a monadic value. The solution is to define a new
function, one that will have to be overloaded for
each monadic type) that takes a pure value as its
argument "lifts" it to a monadic value. Then we
can use >=> to feed it into a pipeline composed
of monadic functions.
-/

class has_return' (m : Type → Type) :=
(return' : ∀ {α : Type}, α → m α)

open has_return'

instance : has_return' (profiled_result) :=
⟨
  λ α a, (a, 0)
⟩

/-
Now we can write a complete pipeline with
input fed in "from the left."
-/

#reduce (return' polly) >>= (m_breed >=> m_coat >=> m_sheds)

/-
We can now define a profiled result "monad" by defining
a monad typeclass with our overload-able bind and return
operations, to be implemented for each monadic context
type constructor, m.
-/

/-
Let's do this for the option type.
-/
instance bind_option : has_bind' (option) :=
⟨
  λ {α β : Type } (ma : option α) a2mb,
    match ma with
    | none := none
    | (some a) := a2mb a
    end
⟩

instance : has_return' (option) :=
⟨
  λ α a, some a
⟩

/-
If we insist that a monad also be an applicative, then
a further simplification is possible leading to a new
definition of monad, based on operators usually called
return and flatten. We won't have time to cover this in
in this class, but you should be able now to go learn
it on your own if you're interested.
-/

/-
So why do monads matter? By supporting composition they
enable decomposition, which is fundamental to problem
solving. They also support a broad range of effectful
styles of programming in otherwise purely functional
styles of programming. Third, they illustrate a very
beautiful point: they implement composition not in the
category of ordinary sets and functions, but in what are
called Kleisli categories. Composition is the essential
concept in category theory, and now we have a second,
and quite distinct notion of composition. This idea
puts you on a whole new path of discovery.
-/

end hidden

#check list.map id = id

#check @funext

universe u
theorem list_map_ok_1 : ∀ (T : Type u), list.map (@id T) = (@id (list T)) :=
begin
  assume T,
  apply funext,
  sorry
end

#check @applicative


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import category_theory.abelian.exact
import category_theory.preadditive.projective_resolution

/-!
# Abelian categories with enough projectives have projective resolutions

When `C` is abelian `projective.d f` and `f` are exact.
Hence, starting from an epimorphism `P ⟶ X`, where `P` is projective,
we can apply `projective.d` repeatedly to obtain a projective resolution of `X`.
-/

noncomputable theory

open category_theory
open category_theory.limits

universes v u

namespace category_theory

open category_theory.projective

variables {C : Type u} [category.{v} C]

section
variables [enough_projectives C] [abelian C]

/--
When `C` is abelian, `projective.d f` and `f` are exact.
-/
lemma exact_d_f {X Y : C} (f : X ⟶ Y) : exact (d f) f :=
(abelian.exact_iff _ _).2 $
  ⟨by simp, zero_of_epi_comp (π _) $ by rw [←category.assoc, cokernel.condition]⟩

end

namespace ProjectiveResolution

/-!
Our goal is to define `ProjectiveResolution.of Z : ProjectiveResolution Z`.
The `0`-th object in this resolution will just be `projective.over Z`,
i.e. an arbitrarily chosen projective object with a map to `Z`.
After that, we build the `n+1`-st object as `projective.syzygies`
applied to the previously constructed morphism,
and the map to the `n`-th object as `projective.d`.
-/

variables [abelian C] [enough_projectives C]

/-- Auxiliary definition for `ProjectiveResolution.of`. -/
@[simps]
def of_complex (Z : C) : chain_complex C ℕ :=
chain_complex.mk'
  (projective.over Z) (projective.syzygies (projective.π Z)) (projective.d (projective.π Z))
  (λ ⟨X, Y, f⟩, ⟨projective.syzygies f, projective.d f, (exact_d_f f).w⟩)

/--
In any abelian category with enough projectives,
`ProjectiveResolution.of Z` constructs a projective resolution of the object `Z`.
-/
@[irreducible] def of (Z : C) : ProjectiveResolution Z :=
{ complex := of_complex Z,
  π := chain_complex.mk_hom _ _ (projective.π Z) 0
    (by { simp, exact (exact_d_f (projective.π Z)).w.symm, })
    (λ n _, ⟨0, by ext⟩),
  projective := by { rintros (_|_|_|n); apply projective.projective_over, },
  exact₀ := by simpa using exact_d_f (projective.π Z),
  exact := by { rintros (_|n); { simp, apply exact_d_f, }, },
  epi := projective.π_epi Z, }

@[priority 100]
instance (Z : C) : has_projective_resolution Z :=
{ out := ⟨of Z⟩ }

@[priority 100]
instance : has_projective_resolutions C :=
{ out := λ Z, by apply_instance }

end ProjectiveResolution

end category_theory


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import ring_theory.ideal.operations

/-!
# Ideals in product rings

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

For commutative rings `R` and `S` and ideals `I ≤ R`, `J ≤ S`, we define `ideal.prod I J` as the
product `I × J`, viewed as an ideal of `R × S`. In `ideal_prod_eq` we show that every ideal of
`R × S` is of this form.  Furthermore, we show that every prime ideal of `R × S` is of the form
`p × S` or `R × p`, where `p` is a prime ideal.
-/

universes u v
variables {R : Type u} {S : Type v} [ring R] [ring S] (I I' : ideal R) (J J' : ideal S)

namespace ideal

/-- `I × J` as an ideal of `R × S`. -/
def prod : ideal (R × S) :=
{ carrier := { x | x.fst ∈ I ∧ x.snd ∈ J },
  zero_mem' := by simp,
  add_mem' :=
  begin
    rintros ⟨a₁, a₂⟩ ⟨b₁, b₂⟩ ⟨ha₁, ha₂⟩ ⟨hb₁, hb₂⟩,
    exact ⟨I.add_mem ha₁ hb₁, J.add_mem ha₂ hb₂⟩
  end,
  smul_mem' :=
  begin
    rintros ⟨a₁, a₂⟩ ⟨b₁, b₂⟩ ⟨hb₁, hb₂⟩,
    exact ⟨I.mul_mem_left _ hb₁, J.mul_mem_left _ hb₂⟩,
  end }

@[simp] lemma mem_prod {r : R} {s : S} : (⟨r, s⟩ : R × S) ∈ prod I J ↔ r ∈ I ∧ s ∈ J := iff.rfl
@[simp] lemma prod_top_top : prod (⊤ : ideal R) (⊤ : ideal S) = ⊤ := ideal.ext $ by simp

/-- Every ideal of the product ring is of the form `I × J`, where `I` and `J` can be explicitly
    given as the image under the projection maps. -/
theorem ideal_prod_eq (I : ideal (R × S)) :
  I = ideal.prod (map (ring_hom.fst R S) I) (map (ring_hom.snd R S) I) :=
begin
  apply ideal.ext,
  rintro ⟨r, s⟩,
  rw [mem_prod, mem_map_iff_of_surjective (ring_hom.fst R S) prod.fst_surjective,
    mem_map_iff_of_surjective (ring_hom.snd R S) prod.snd_surjective],
  refine ⟨λ h, ⟨⟨_, ⟨h, rfl⟩⟩, ⟨_, ⟨h, rfl⟩⟩⟩, _⟩,
  rintro ⟨⟨⟨r, s'⟩, ⟨h₁, rfl⟩⟩, ⟨⟨r', s⟩, ⟨h₂, rfl⟩⟩⟩,
  simpa using I.add_mem (I.mul_mem_left (1, 0) h₁) (I.mul_mem_left (0, 1) h₂),
end

@[simp] lemma map_fst_prod (I : ideal R) (J : ideal S) : map (ring_hom.fst R S) (prod I J) = I :=
begin
  ext,
  rw mem_map_iff_of_surjective (ring_hom.fst R S) prod.fst_surjective,
  exact ⟨by { rintro ⟨x, ⟨h, rfl⟩⟩, exact h.1 }, λ h, ⟨⟨x, 0⟩, ⟨⟨h, ideal.zero_mem _⟩, rfl⟩⟩⟩
end

@[simp] lemma map_snd_prod (I : ideal R) (J : ideal S) : map (ring_hom.snd R S) (prod I J) = J :=
begin
  ext,
  rw mem_map_iff_of_surjective (ring_hom.snd R S) prod.snd_surjective,
  exact ⟨by { rintro ⟨x, ⟨h, rfl⟩⟩, exact h.2 }, λ h, ⟨⟨0, x⟩, ⟨⟨ideal.zero_mem _, h⟩, rfl⟩⟩⟩
end

@[simp] lemma map_prod_comm_prod :
  map ((ring_equiv.prod_comm : R × S ≃+* S × R) : R × S →+* S × R) (prod I J) = prod J I :=
begin
  refine trans (ideal_prod_eq _) _,
  simp [map_map],
end

/-- Ideals of `R × S` are in one-to-one correspondence with pairs of ideals of `R` and ideals of
    `S`. -/
def ideal_prod_equiv : ideal (R × S) ≃ ideal R × ideal S :=
{ to_fun := λ I, ⟨map (ring_hom.fst R S) I, map (ring_hom.snd R S) I⟩,
  inv_fun := λ I, prod I.1 I.2,
  left_inv := λ I, (ideal_prod_eq I).symm,
  right_inv := λ ⟨I, J⟩, by simp }

@[simp] lemma ideal_prod_equiv_symm_apply (I : ideal R) (J : ideal S) :
  ideal_prod_equiv.symm ⟨I, J⟩ = prod I J := rfl

lemma prod.ext_iff {I I' : ideal R} {J J' : ideal S} : prod I J = prod I' J' ↔ I = I' ∧ J = J' :=
by simp only [←ideal_prod_equiv_symm_apply, ideal_prod_equiv.symm.injective.eq_iff, prod.mk.inj_iff]

lemma is_prime_of_is_prime_prod_top {I : ideal R} (h : (ideal.prod I (⊤ : ideal S)).is_prime) :
  I.is_prime :=
begin
  split,
  { unfreezingI { contrapose! h },
    simp [is_prime_iff, h] },
  { intros x y hxy,
    have : (⟨x, 1⟩ : R × S) * ⟨y, 1⟩ ∈ prod I ⊤,
    { rw [prod.mk_mul_mk, mul_one, mem_prod],
      exact ⟨hxy, trivial⟩ },
    simpa using h.mem_or_mem this }
end

lemma is_prime_of_is_prime_prod_top' {I : ideal S} (h : (ideal.prod (⊤ : ideal R) I).is_prime) :
  I.is_prime :=
begin
  apply @is_prime_of_is_prime_prod_top _ R,
  rw ←map_prod_comm_prod,
  exact map_is_prime_of_equiv _
end

lemma is_prime_ideal_prod_top' {I : ideal S} [h : I.is_prime] : (prod (⊤ : ideal R) I).is_prime :=
begin
  rw ←map_prod_comm_prod,
  apply map_is_prime_of_equiv _,
  exact is_prime_ideal_prod_top,
end

lemma ideal_prod_prime_aux {I : ideal R} {J : ideal S} : (ideal.prod I J).is_prime →
  I = ⊤ ∨ J = ⊤ :=
begin
  contrapose!,
  simp only [ne_top_iff_one, is_prime_iff, not_and, not_forall, not_or_distrib],
  exact λ ⟨hI, hJ⟩ hIJ, ⟨⟨0, 1⟩, ⟨1, 0⟩, by simp, by simp [hJ], by simp [hI]⟩
end

/-- Classification of prime ideals in product rings: the prime ideals of `R × S` are precisely the
    ideals of the form `p × S` or `R × p`, where `p` is a prime ideal of `R` or `S`. -/
theorem ideal_prod_prime (I : ideal (R × S)) : I.is_prime ↔
  ((∃ p : ideal R, p.is_prime ∧ I = ideal.prod p ⊤) ∨
   (∃ p : ideal S, p.is_prime ∧ I = ideal.prod ⊤ p)) :=
begin
  split,
  { rw ideal_prod_eq I,
    introsI hI,
    rcases ideal_prod_prime_aux hI with (h|h),
    { right,
      rw h at hI ⊢,
      exact ⟨_, ⟨is_prime_of_is_prime_prod_top' hI, rfl⟩⟩ },
    { left,
      rw h at hI ⊢,
      exact ⟨_, ⟨is_prime_of_is_prime_prod_top hI, rfl⟩⟩ } },
  { rintro (⟨p, ⟨h, rfl⟩⟩|⟨p, ⟨h, rfl⟩⟩),
    { exactI is_prime_ideal_prod_top },
    { exactI is_prime_ideal_prod_top' } }
end

end ideal


/-
Copyright (c) 2021 Adrián Doña Mateo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adrián Doña Mateo
-/

import algebra.big_operators
import data.pnat.basic

/-!
# IMO 2014 Q1

Let `a₀ < a₁ < a₂ < ⋯` be an infinite sequence of positive integers.
Prove that there exists a unique `n ≥ 1` such that

  `aₙ < (a₀ + a₁ + ⋯ + aₙ) / n < aₙ₊₁`.

This solutions is a translation of the official solution, which may be found as the
solution to problem A1 [here](https://www.imo-official.org/problems/IMO2014SL.pdf).
-/

open_locale big_operators

noncomputable theory

/-- The integer sequence. -/
variable (a : ℕ → ℤ)

/-- We define an auxiliary sequence `d a : ℕ+ → ℤ` by
  `d a n = (a 0 + a 1 + ⋯ + a n) - n * (a n)`. -/
def d (n : ℕ+) : ℤ := (∑ i : fin (n + 1), a i) - n * (a n)

lemma first_ineq_iff {n : ℕ+} :
  (a n : ℚ) < (↑∑ i : fin (n + 1), a i : ℚ) / n ↔ 0 < d a n :=
show _ < _ / ↑(n : ℤ) ↔ _, begin
  have : (↑(a n) : ℚ) = ↑(a n) / ↑(1 : ℤ) := by simp,
  rw [this, rat.div_lt_div_iff_mul_lt_mul (int.zero_lt_one)],
  { simp [d, mul_comm] }, simp,
end

lemma second_ineq_iff {n : ℕ+} :
  (↑∑ i : fin (n + 1), a i : ℚ) / n ≤ a (n + 1) ↔ d a (n + 1) ≤ 0 :=
show _ / ↑(n : ℤ) ≤ _ ↔ _, begin
  have : (↑(a (n + 1)) : ℚ) = ↑(a (n + 1)) / ↑(1 : ℤ) := by simp, rw this,
  simp only [rat.div_num_denom, mul_one, rat.num_one, one_mul, rat.coe_int_denom, int.coe_nat_zero,
    rat.coe_int_num, int.coe_nat_succ, zero_add, coe_coe],
  rw rat.le_def, swap,
  { norm_cast, have : 1 ≤ ↑n := pnat.one_le n, linarith }, swap,
  { exact zero_lt_one },
  simp only [d, @fin.sum_univ_cast_succ _ _ ↑(n + 1), mul_one, fin.coe_last, pnat.one_coe,
    fin.coe_cast_succ, int.coe_nat_succ, pnat.add_coe, sub_nonpos, coe_coe, add_mul, one_mul],
  rw [add_le_add_iff_right,	mul_comm], refl,
end

/-- We rephrase the original question into a question about `d a`. -/
lemma ineq_iff {n : ℕ+} :
  (a n : ℚ) < (↑∑ i : fin (n + 1), a i : ℚ) / n ∧
  (↑∑ i : fin (n + 1), a i : ℚ) / n ≤ a (n + 1)
  ↔ 0 < d a n ∧ d a (n + 1) ≤ 0 :=
⟨λ h, ⟨(first_ineq_iff a).1 h.1, (second_ineq_iff a).1 h.2⟩,
  λ h, ⟨(first_ineq_iff a).2 h.1, (second_ineq_iff a).2 h.2⟩⟩

lemma d_one : d a 1 = a 0 :=
show a 0 + (a 1 + 0) - 1 * a 1 = a 0, by simp

/-- If `a` is strictly increasing, then `d a` is strictly decreasing. -/
lemma ddes (hinc : ∀ n, a n < a (n + 1)) (n : ℕ+) : d a (n + 1) < d a n :=
lt_of_sub_neg $
  calc ((∑ i : fin (n + 2), a i) - (n + 1) * a (n + 1))
        - ((∑ i : fin (n + 1), a i) - n * a n)
      = ((∑ i : fin (n + 1), a i) + a (n + 1) - (n + 1) * a (n + 1))
        - ((∑ i : fin (n + 1), a i) - n * a n) : by simp [fin.sum_univ_cast_succ]
  ... = n * (a n - a (n + 1))                  : by ring
  ... < 0
    : mul_neg_iff.mpr (or.inl ⟨by simp, sub_neg_of_lt (hinc n)⟩)

section descending

/- In this section we prove that for any strictly descending sequence `f : ℕ+ → ℤ`
  and integer `x < f m` for some `m`, there is a unique index `n ≥ m` such that
  `f (n + 1) ≤ x < f n`. -/

variables {f : ℕ+ → ℤ} (hdes : ∀ n, f (n + 1) < f n)
include hdes

theorem lt_of_lt_of_des {n m : ℕ+} (hnm : n < m) :
  f m < f n :=
begin
  have : ∀ k : ℕ, f (n + ⟨k + 1, nat.succ_pos k⟩) < f n,
  { intro k, induction k with k ih,
    { exact hdes n },
    apply lt_trans (hdes _) ih },
  convert this (↑(m - n) - 1),
  have : 1 ≤ ↑(m - n) := (pnat.coe_le_coe 1 _).mpr (pnat.one_le _),
  simp [nat.sub_add_cancel this, pnat.add_sub_of_lt hnm],
end

theorem no_middle_term (n : ℕ+) :
  ¬ ∃ m, f (n + 1) < f m ∧ f m < f n :=
begin
  rintro ⟨m, fn1m, fmn⟩,
  rcases lt_trichotomy m n with hmn | heq | hnm,
  { linarith [lt_of_lt_of_des hdes hmn] },
  { rw heq at fmn, linarith },
  by_cases h : n + 1 < m,
  {	linarith [lt_of_lt_of_des hdes h] },
  have h : m = n + 1 := le_antisymm (le_of_not_gt h) (nat.succ_le_of_lt hnm),
  rw h at fn1m, linarith,
end

lemma term_le_of_des (x : ℤ) (m : ℕ+) (hx : x < f m) :
  ∃ k, f (m + ⟨k + 1, by linarith⟩) ≤ x :=
begin
  have : ∀ d, f (m + ⟨d + 1, by linarith⟩) < f m - d,
  { intro d, induction d with d ih,
    { simp, exact hdes m },
    simp [sub_add_eq_sub_sub],
    apply lt_of_lt_of_le _ (int.le_sub_one_of_lt ih),
    change f (m + ⟨d + 1, by linarith⟩ + 1) < _,
    exact hdes _ },
  cases int.eq_coe_of_zero_le (le_of_lt $ sub_pos_of_lt hx) with k hk,
  use k,
  apply le_trans (le_of_lt $ this k),
  linarith,
end

theorem cross_of_des (x : ℤ) (m : ℕ+) (hx : x < f m) :
  ∃ n, m ≤ n ∧ x < f n ∧ f (n + 1) ≤ x :=
begin
  let S := { k : ℕ | f (m + ⟨k + 1, by linarith⟩) ≤ x },
  rcases well_founded.has_min nat.lt_wf S (term_le_of_des hdes x m hx) with ⟨k, hk, hmin⟩,
  use m + k,
  { have : 1 ≤ ↑m := pnat.one_le m, linarith },
  split, { rw ← pnat.coe_le_coe, simp },
  split, swap, { exact hk },
  by_contradiction h,
  by_cases h1k : 1 ≤ k, swap,
  {	have : k = 0 := by linarith, simp [this] at h, linarith },
  apply (hmin (k - 1) _) _, swap,
  {	apply nat.sub_lt, linarith, norm_num },
  simp only [set.mem_set_of_eq, nat.sub_add_cancel h1k],
  exact (le_of_not_gt h),
end

theorem unique_cross_of_des (x : ℤ) (n : ℕ+) (hcross : x < f n ∧ f (n + 1) ≤ x) :
  ∀ m, x < f m ∧ f (m + 1) ≤ x → m = n :=
begin
  intros m hm,
  have : ∀ {n m}, f (n + 1) ≤ x → x < f m → m ≤ n,
  { intros n m hfn1 hfm, by_contradiction hnm,
    have h1 : f (n + 1) < f m := lt_of_le_of_lt hfn1 hfm,
    have h2 : f m < f n := lt_of_lt_of_des hdes (lt_of_not_ge hnm),
    exact no_middle_term hdes n ⟨m, h1, h2⟩ },
  exact le_antisymm (this hcross.2 hm.1) (this hm.2 hcross.1),
end

end descending

theorem imo2014q1 (hpos : ∀ n, 0 < a n) (hinc : ∀ n, a n < a (n + 1)) :
  ∃! n : ℕ+,
  (a n : ℚ) < (↑∑ i : fin (n + 1), a i) / n ∧
  (↑∑ i : fin (n + 1), a i : ℚ) / n ≤ a (n + 1) :=
begin
  rcases cross_of_des (ddes a hinc) 0 1 _ with ⟨n, _, hn⟩, swap,
  {	rw d_one, exact hpos 0 },
  use [n, (ineq_iff a).mpr hn],
  have huniq := unique_cross_of_des (ddes a hinc) 0 n hn,
  intros m hm,
  exact huniq m ((ineq_iff a).mp hm),
end


import .KT_defs algebra.order_functions
open nnf prod

namespace prod

universe u

def measure_lex {α : Sort u} : (α → ℕ × ℕ) → α → α → Prop :=
inv_image $ lex (<) (<)

def measure_lex_wf {α : Sort u} (f : α → ℕ × ℕ) : well_founded (measure_lex f) :=
inv_image.wf f (lex_wf nat.lt_wf nat.lt_wf)

end prod

namespace list
universes u
variables {α : Type u} [inhabited α] [decidable_linear_order α]

def maximum (l : list α) : α := l.foldr max l.head

theorem le_of_foldr_max : Π {a b : α} {l}, a ∈ l → a ≤ foldr max b l
| a b [] h := absurd h $ not_mem_nil _
| a b (hd::tl) h :=
begin
  cases h,
  { simp [h, le_max_left] },
  { simp [le_max_right_of_le, le_of_foldr_max h] }
end

theorem mem_of_foldr_max : Π {a : α} {l}, foldr max a l ∈ a :: l
| a [] := by simp
| a (hd::tl) :=
begin
  simp only [foldr_cons],
  have h := by exact @max_choice _ _ hd (foldr max a tl),
  cases h,
  { simp [h] },
  { rw h,
    have hmem := @mem_of_foldr_max a tl,
    cases hmem, { simp [hmem] }, { right, right, exact hmem } }
end

theorem mem_maximum : Π {l : list α}, l ≠ [] →  maximum l ∈ l
| [] h := by contradiction
| (hd::tl) h :=
begin
  dsimp [maximum],
  have hc := by exact @max_choice _ _ hd (foldr max hd tl),
  cases hc, { simp [hc] }, { simp [hc, mem_of_foldr_max] }
end

theorem le_maximum_of_mem : Π {a : α} {l}, a ∈ l → a ≤ maximum l
| a [] h := absurd h $ not_mem_nil _
| a (hd::tl) h :=
begin
  cases h,
  { rw h, apply le_of_foldr_max, simp },
  { dsimp [maximum], apply le_max_right_of_le, apply le_of_foldr_max h }
end

def maximum_cons : Π {a : α} {l}, l ≠ [] → maximum (a :: l) = max a (maximum l)
| a [] h := by contradiction
| a (hd::tl) h :=
begin
  apply le_antisymm,
  { have : a :: hd :: tl ≠ [], { simp [h] },
    have hle := mem_maximum this,
    cases hle,
    { simp [hle, le_max_left] },
    { apply le_max_right_of_le, apply le_maximum_of_mem, exact hle } },
  { have hc := by exact @max_choice _ _ a (maximum $ hd :: tl),
    cases hc,
    { simp [hc, le_maximum_of_mem] },
    { simp [hc, le_maximum_of_mem, mem_maximum h] } }
end

@[simp] def maximum_singleton : Π {a : α}, maximum [a] = a := by simp [maximum]

section
variables hdf : ∀ {a}, default α ≤ a
include hdf

def maximum_nil : Π {a : α}, max a (maximum []) = a :=
λ a, by dsimp [maximum]; apply max_eq_left; apply hdf

def maximum_cons_default : Π {a : α} {l}, maximum (a :: l) = max a (maximum l)
| a [] := begin rw maximum_nil, simp, assumption end
| a (hd::tl) :=
begin
  apply le_antisymm,
  { have : a :: hd :: tl ≠ [], { simp },
    have hle := mem_maximum this,
    cases hle,
    { rw hle, apply le_max_left },
    { apply le_max_right_of_le, apply le_maximum_of_mem, exact hle } },
  { have hc := by exact @max_choice _ _ a (maximum $ hd :: tl),
    cases hc,
    { rw hc, apply le_maximum_of_mem, simp },
    { rw hc, apply le_maximum_of_mem, right,
      have : hd :: tl ≠ [], { simp },
      exact mem_maximum this } }
end

def maximum_erase : Π {a : α} {l}, a ∈ l → maximum l = max a (maximum $ l.erase a)
| a [] h := absurd h $ not_mem_nil _
| a (hd::tl) h :=
begin
  by_cases heq : a = hd,
  { rw heq, simp, apply maximum_cons_default, assumption },
  { rw maximum_cons_default @hdf,
    rw maximum_erase (mem_of_ne_of_mem heq h),
    rw erase_cons_tail,
    rw maximum_cons_default @hdf,
    repeat {rw ←max_assoc},
    simp [max_comm],
    intro hc, rw hc at heq, contradiction }
end

def maximum_subset : Π {l₁ l₂ : list α}, l₁ ⊆ l₂ → maximum l₁ ≤ maximum l₂
| [] l₂ h := by apply hdf
| (hd::tl) l₂ h :=
begin
  rw maximum_cons_default, apply max_le,
  { apply le_maximum_of_mem, apply h, simp },
  { apply maximum_subset, rw cons_subset at h, exact h.right },
  assumption
end

def maximum_sublist {l₁ l₂ : list α} (h : l₁ <+ l₂) : maximum l₁ ≤ maximum l₂ :=
maximum_subset (by assumption) (sublist.subset h)

end

end list

open list

@[simp] def count_modal : nnf → ℕ
| (var n)    := 0
| (neg n)    := 0
| (and φ ψ)  := count_modal φ + count_modal ψ
| (or φ ψ)   := count_modal φ + count_modal ψ
| (box φ)    := count_modal φ + 1
| (dia φ)    := count_modal φ + 1

def modal_degree (Γ : list nnf) : ℕ := maximum $ Γ.map count_modal

theorem cons_degree : Π (φ : nnf) (Γ : list nnf),
modal_degree (φ :: Γ) = max (count_modal φ) (modal_degree Γ)
| φ [] := begin dsimp [modal_degree, maximum], simp, rw max_eq_left, apply zero_le end
| φ (hd::tl) := begin simp only [modal_degree], apply maximum_cons, simp end

theorem le_of_mem_degree : Π (φ : nnf) (Γ : list nnf), φ ∈ Γ → count_modal φ ≤ modal_degree Γ
| φ [] h := absurd h $ list.not_mem_nil _
| φ (hd::tl) h :=
begin
  cases h,
  {rw h, rw cons_degree, apply le_max_left},
  {rw cons_degree, apply le_max_right_of_le, apply le_of_mem_degree, exact h}
end

theorem le_degree_of_subset : Π {l₁ l₂ : list nnf}, l₁ ⊆ l₂ →
modal_degree l₁ ≤ modal_degree l₂
:=
begin
  intros,
  dsimp [modal_degree],
  apply maximum_subset,
  {exact zero_le},
  {apply map_subset _ a}
end

@[simp] def seqt_size (s : seqt) : ℕ × ℕ := (modal_degree $ s.main ++ s.hdld, node_size s.main)

instance : has_well_founded seqt :=
⟨ prod.measure_lex seqt_size, prod.measure_lex_wf seqt_size ⟩

lemma size_erase_add_eq_size_sum {φ} : Π (Γ : list nnf) (h : φ ∈ Γ), node_size (Γ.erase φ) + sizeof φ = node_size Γ
| [] h := absurd h $ not_mem_nil _
| (hd :: tl) h :=
begin
  by_cases eq : φ = hd,
  {dsimp [list.erase], rw if_pos, rw eq, apply add_comm, rw eq},
  {dsimp [list.erase], rw if_neg, dsimp, rw [add_assoc],   have : node_size (list.erase tl φ) + sizeof φ = node_size tl,
    {apply size_erase_add_eq_size_sum, cases h, contradiction, assumption},
    rw this, intro h', rw h' at eq, contradiction}
end

theorem split_lt_and_size {φ ψ} (Γ : list nnf) (h : nnf.and φ ψ ∈ Γ) :
node_size (φ :: ψ :: Γ.erase (nnf.and φ ψ)) < node_size Γ :=
begin
  dsimp [node_size],
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [←add_assoc, add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  rw [add_assoc],
  rw [nat.one_add],
  apply nat.lt_succ_self
end

theorem split_le_and_degree {φ ψ} (Γ : list nnf) (h : nnf.and φ ψ ∈ Γ) :
modal_degree (φ :: ψ :: Γ.erase (nnf.and φ ψ)) ≤ modal_degree Γ :=
begin
  rw cons_degree, rw cons_degree,
  {rw ←max_assoc, apply max_le,
  {apply max_le,
  repeat {apply le_trans, swap 3, exact count_modal (and φ ψ), simp, apply le_of_mem_degree _ _ h}},
  {apply le_degree_of_subset, apply erase_subset} }
end

theorem split_lt_and_seqt {φ ψ} (Γ : seqt) (h : nnf.and φ ψ ∈ Γ.main) :
prod.measure_lex seqt_size
(and_child Γ h) Γ :=
begin
  have hmem : and φ ψ ∈ Γ.main ++ Γ.hdld, {apply mem_append_left _ h},
  have := lt_or_eq_of_le (split_le_and_degree _ hmem),
  cases this,
  {left,
  simp only [seqt_size, and_child],  rw erase_append_left at this, rw cons_append, rw cons_append, exact this, exact h
  },
  {dsimp only [prod.measure_lex, inv_image, seqt_size], rw [erase_append_left _ h] at this, rw ←this, right,
   apply split_lt_and_size _ h}
end

theorem split_lt_or_size_left {φ ψ} (Γ : list nnf) (h : nnf.or φ ψ ∈ Γ) :
node_size (φ :: Γ.erase (nnf.or φ ψ)) < node_size Γ :=
begin
  dsimp,
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  rw [add_comm, ←add_assoc],
  apply nat.lt_add_of_pos_left,
  apply nat.succ_pos
end

theorem split_lt_or_size_right {φ ψ} (Γ : list nnf) (h : nnf.or φ ψ ∈ Γ) :
node_size (ψ :: Γ.erase (nnf.or φ ψ)) < node_size Γ :=
begin
  dsimp,
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  apply nat.lt_add_of_pos_left,
  rw nat.one_add,
  apply nat.succ_pos
end

theorem split_le_or_degree_left {φ ψ} (Γ : list nnf) (h : nnf.or φ ψ ∈ Γ) :
modal_degree (φ :: Γ.erase (nnf.or φ ψ)) ≤ modal_degree Γ :=
begin
  rw cons_degree,
  {apply max_le,
  -- works even when exact count_modal (and φ ψ). How smart `apply` is?
  repeat {apply le_trans, swap 3, exact count_modal (or φ ψ), simp, apply le_of_mem_degree (nnf.or φ ψ) _ h},
  {apply le_degree_of_subset, apply erase_subset}}
end

theorem split_le_or_degree_right {φ ψ} (Γ : list nnf) (h : nnf.or φ ψ ∈ Γ) :
modal_degree (ψ :: Γ.erase (nnf.or φ ψ)) ≤ modal_degree Γ :=
begin
  rw cons_degree,
  {apply max_le,
  repeat {apply le_trans, swap 3, exact count_modal (or φ ψ), simp, apply le_of_mem_degree (nnf.or φ ψ) _ h},
  {apply le_degree_of_subset, apply erase_subset}}
end

theorem split_lt_or_seqt_left {φ ψ} (Γ : seqt) (h : nnf.or φ ψ ∈ Γ.main) :
prod.measure_lex seqt_size (or_child_left Γ h) Γ :=
begin
  have hmem : or φ ψ ∈ Γ.main ++ Γ.hdld, {apply mem_append_left _ h},
  have := lt_or_eq_of_le (split_le_or_degree_left _ hmem),
  cases this,
  {left, simp only [seqt_size, or_child_left],  rw erase_append_left at this, rw cons_append, exact this, exact h},
  {dsimp only [prod.measure_lex, inv_image, seqt_size], rw [erase_append_left _ h] at this, rw ←this, right,
   apply split_lt_or_size_left _ h}
end

theorem split_lt_or_seqt_right {φ ψ} (Γ : seqt) (h : nnf.or φ ψ ∈ Γ.main) :
prod.measure_lex seqt_size (or_child_right Γ h) Γ :=
begin
  have hmem : or φ ψ ∈ Γ.main ++ Γ.hdld, {apply mem_append_left _ h},
  have := lt_or_eq_of_le (split_le_or_degree_right _ hmem),
  cases this,
  {left, simp only [seqt_size, or_child_right],  rw erase_append_left at this, rw cons_append, exact this, exact h},
  {dsimp only [prod.measure_lex, inv_image, seqt_size], rw [erase_append_left _ h] at this, rw ←this, right,
   apply split_lt_or_size_right _ h}
end

theorem copy_lt_size {φ} (Γ : list nnf) (h : nnf.box φ ∈ Γ) :
node_size (φ :: Γ.erase (nnf.box φ)) < node_size Γ :=
begin
  dsimp [node_size],
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [add_comm], simp [sizeof,has_sizeof.sizeof, nnf.sizeof]
end

theorem copy_eq_degree {φ} (Γ Λ: list nnf) (h : nnf.box φ ∈ Γ) :
modal_degree (φ :: Γ.erase (nnf.box φ) ++ (box φ :: Λ)) = modal_degree (Γ ++ Λ) :=
begin
  rw cons_append, rw cons_degree,
  have : count_modal φ ≤ count_modal (box φ), {simp},
  have : count_modal φ ≤ (modal_degree (list.erase Γ (box φ) ++ box φ :: Λ)), {apply le_trans, exact this, apply le_of_mem_degree, simp},
  have heq := max_eq_right this,
  rw heq,
  apply nat.le_antisymm,
  {apply le_degree_of_subset, intros x hx, rw mem_append at hx,
    cases hx,
    {rw mem_append, left, apply mem_of_mem_erase hx},
    {cases hx, rw mem_append, left, rw ←hx at h, exact h, rw mem_append, right, exact hx}},
  {apply le_degree_of_subset, intros x hx, rw mem_append at hx,
    cases hx,
    {rw mem_append, by_cases heq : x = box φ,
      {right, simp [heq]},
      {left, rw mem_erase_of_ne heq, exact hx}},
    {rw mem_append, right, simp [hx]} }
end

theorem copy_lt_seqt {φ} (Γ : seqt) (h : nnf.box φ ∈ Γ.main) :
prod.measure_lex seqt_size (box_child Γ h) Γ :=
begin
  have hmem : box φ ∈ Γ.main ++ Γ.hdld, {apply mem_append_left _ h},
  dsimp only [prod.measure_lex, inv_image, seqt_size, box_child],
  rw [copy_eq_degree], right, apply copy_lt_size,
  repeat {assumption}
end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro

Tensor product of modules over commutative rings.

-/

import group_theory.free_abelian_group
import linear_algebra.direct_sum_module

variables {R : Type*} [comm_ring R]
variables {M : Type*} {N : Type*} {P : Type*} {Q : Type*}
variables [add_comm_group M] [add_comm_group N] [add_comm_group P] [add_comm_group Q]
variables [module R M] [module R N] [module R P] [module R Q]
include R

set_option class.instance_max_depth 100

namespace linear_map

variables (R)
def mk₂ (f : M → N → P)
  (H1 : ∀ m₁ m₂ n, f (m₁ + m₂) n = f m₁ n + f m₂ n)
  (H2 : ∀ (c:R) m n, f (c • m) n = c • f m n)
  (H3 : ∀ m n₁ n₂, f m (n₁ + n₂) = f m n₁ + f m n₂)
  (H4 : ∀ (c:R) m n, f m (c • n) = c • f m n) : M →ₗ N →ₗ P :=
⟨λ m, ⟨f m, H3 m, λ c, H4 c m⟩,
λ m₁ m₂, linear_map.ext $ H1 m₁ m₂,
λ c m, linear_map.ext $ H2 c m⟩
variables {R}

@[simp] theorem mk₂_apply
  (f : M → N → P) {H1 H2 H3 H4} (m : M) (n : N) :
  (mk₂ R f H1 H2 H3 H4 : M →ₗ[R] N →ₗ P) m n = f m n := rfl

variables (f : M →ₗ[R] N →ₗ[R] P)

theorem ext₂ {f g : M →ₗ[R] N →ₗ[R] P}
  (H : ∀ m n, f m n = g m n) : f = g :=
linear_map.ext (λ m, linear_map.ext $ λ n, H m n)

def flip : N →ₗ M →ₗ P :=
mk₂ R (λ n m, f m n)
  (λ n₁ n₂ m, (f m).map_add _ _)
  (λ c n m, (f m).map_smul _ _)
  (λ n m₁ m₂, by rw f.map_add; refl)
  (λ c n m, by rw f.map_smul; refl)

@[simp] theorem flip_apply (m : M) (n : N) : flip f n m = f m n := rfl

variables {R}
theorem flip_inj {f g : M →ₗ[R] N →ₗ P} (H : flip f = flip g) : f = g :=
ext₂ $ λ m n, show flip f n m = flip g n m, by rw H

variables (R M N P)
def lflip : (M →ₗ[R] N →ₗ P) →ₗ[R] N →ₗ M →ₗ P :=
⟨flip, λ _ _, rfl, λ _ _, rfl⟩
variables {R M N P}

@[simp] theorem lflip_apply (m : M) (n : N) : lflip R M N P f n m = f m n := rfl

theorem map_zero₂ (y) : f 0 y = 0 := (flip f y).map_zero

theorem map_neg₂ (x y) : f (-x) y = -f x y := (flip f y).map_neg _

theorem map_add₂ (x₁ x₂ y) : f (x₁ + x₂) y = f x₁ y + f x₂ y := (flip f y).map_add _ _

theorem map_smul₂ (r:R) (x y) : f (r • x) y = r • f x y := (flip f y).map_smul _ _

variables (R P)
def lcomp (f : M →ₗ[R] N) : (N →ₗ P) →ₗ M →ₗ P :=
flip $ (flip id).comp f
variables {R P}

@[simp] theorem lcomp_apply (f : M →ₗ[R] N) (g : N →ₗ P) (x : M) :
  lcomp R P f g x = g (f x) := rfl

variables (R M N P)
def llcomp : (N →ₗ[R] P) →ₗ[R] (M →ₗ[R] N) →ₗ M →ₗ P :=
flip ⟨lcomp R P,
  λ f f', ext₂ $ λ g x, g.map_add _ _,
  λ c f, ext₂ $ λ g x, g.map_smul _ _⟩
variables {R M N P}

section
@[simp] theorem llcomp_apply (f : N →ₗ[R] P) (g : M →ₗ[R] N) (x : M) :
  llcomp R M N P f g x = f (g x) := rfl
end

def compl₂ (g : Q →ₗ N) : M →ₗ Q →ₗ P := (lcomp R _ g).comp f

@[simp] theorem compl₂_apply (g : Q →ₗ[R] N) (m : M) (q : Q) :
  f.compl₂ g m q = f m (g q) := rfl

def compr₂ (g : P →ₗ Q) : M →ₗ N →ₗ Q :=
linear_map.comp (llcomp R N P Q g) f

@[simp] theorem compr₂_apply (g : P →ₗ[R] Q) (m : M) (n : N) :
  f.compr₂ g m n = g (f m n) := rfl

variables (R M)
def lsmul : R →ₗ M →ₗ M :=
mk₂ R (•) add_smul (λ _ _ _, eq.symm $ smul_smul _ _ _ _) smul_add
(λ r s m, by simp only [smul_smul, smul_eq_mul, mul_comm])
variables {R M}

@[simp] theorem lsmul_apply (r : R) (m : M) : lsmul R M r m = r • m := rfl

end linear_map

variables (M N)

namespace tensor_product

section
open free_abelian_group
variables (R)
def relators : set (free_abelian_group (M × N)) :=
add_group.closure { x : free_abelian_group (M × N) |
  (∃ (m₁ m₂ : M) (n : N), x = of (m₁, n) + of (m₂, n) - of (m₁ + m₂, n)) ∨
  (∃ (m : M) (n₁ n₂ : N), x = of (m, n₁) + of (m, n₂) - of (m, n₁ + n₂)) ∨
  (∃ (r : R) (m : M) (n : N), x = of (r • m, n) - of (m, r • n)) }
end

namespace relators

instance : normal_add_subgroup (relators R M N) :=
by unfold relators; apply normal_add_subgroup_of_add_comm_group

end relators

end tensor_product

variables (R)
def tensor_product : Type* :=
quotient_add_group.quotient (tensor_product.relators R M N)
variables {R}

local infix ` ⊗ `:100 := tensor_product _
local notation M ` ⊗[`:100 R `] ` N:100 := tensor_product R M N

namespace tensor_product

section module

local attribute [instance] quotient_add_group.left_rel normal_add_subgroup.to_is_add_subgroup

instance : add_comm_group (M ⊗[R] N) := quotient_add_group.add_comm_group _

instance quotient.mk.is_add_group_hom :
  is_add_group_hom (quotient.mk : free_abelian_group (M × N) → M ⊗ N) :=
quotient_add_group.is_add_group_hom _

variables (R) {M N}
def tmul (m : M) (n : N) : M ⊗[R] N := quotient_add_group.mk $ free_abelian_group.of (m, n)
variables {R}

infix ` ⊗ₜ `:100 := tmul _
notation x ` ⊗ₜ[`:100 R `] ` y := tmul R x y

lemma add_tmul (m₁ m₂ : M) (n : N) : (m₁ + m₂) ⊗ₜ n = m₁ ⊗ₜ n + m₂ ⊗ₜ[R] n :=
eq.symm $ sub_eq_zero.1 $ eq.symm $ quotient.sound $
  group.in_closure.basic $ or.inl $ ⟨m₁, m₂, n, rfl⟩

lemma tmul_add (m : M) (n₁ n₂ : N) : m ⊗ₜ (n₁ + n₂) = m ⊗ₜ n₁ + m ⊗ₜ[R] n₂ :=
eq.symm $ sub_eq_zero.1 $ eq.symm $ quotient.sound $
  group.in_closure.basic $ or.inr $ or.inl $ ⟨m, n₁, n₂, rfl⟩

lemma smul_tmul (r : R) (m : M) (n : N) : (r • m) ⊗ₜ n = m ⊗ₜ[R] (r • n) :=
sub_eq_zero.1 $ eq.symm $ quotient.sound $
  group.in_closure.basic $ or.inr $ or.inr $ ⟨r, m, n, rfl⟩

local attribute [instance] quotient_add_group.is_add_group_hom_quotient_lift

def smul.aux (r : R) : free_abelian_group (M × N) → M ⊗[R] N :=
free_abelian_group.lift (λ (y : M × N), (r • y.1) ⊗ₜ y.2)

instance (r : R) : is_add_group_hom (smul.aux r : _ → M ⊗ N) :=
by unfold smul.aux; apply_instance

instance : has_scalar R (M ⊗ N) :=
⟨λ r, quotient_add_group.lift _ (smul.aux r) $ λ x hx, begin
  refine (is_add_group_hom.mem_ker (smul.aux r : _ → M ⊗ N)).1
    (add_group.closure_subset _ hx),
  clear hx x, rintro x (⟨m₁, m₂, n, rfl⟩ | ⟨m, n₁, n₂, rfl⟩ | ⟨q, m, n, rfl⟩);
  simp only [smul.aux, is_add_group_hom.mem_ker, -sub_eq_add_neg,
    sub_self, add_tmul, tmul_add, smul_tmul,
    smul_add, smul_smul, mul_comm, free_abelian_group.lift.of,
    free_abelian_group.lift.add, free_abelian_group.lift.sub]
end⟩

instance smul.is_add_group_hom (r : R) : is_add_group_hom ((•) r : M ⊗[R] N → M ⊗[R] N) :=
by unfold has_scalar.smul; apply_instance

protected theorem smul_add (r : R) (x y : M ⊗[R] N) :
  r • (x + y) = r • x + r • y :=
is_add_group_hom.add _ _ _

instance : module R (M ⊗ N) := module.of_core
{ smul := (•),
  smul_add := tensor_product.smul_add,
  add_smul := begin
      intros r s x,
      apply quotient_add_group.induction_on' x,
      intro z,
      symmetry,
      refine @free_abelian_group.lift.unique _ _ _ _ _ ⟨λ p q, _⟩ _ z,
      { simp [tensor_product.smul_add] },
      rintro ⟨m, n⟩,
      change (r • m) ⊗ₜ n + (s • m) ⊗ₜ n = ((r + s) • m) ⊗ₜ n,
      rw [add_smul, add_tmul]
    end,
  mul_smul := begin
      intros r s x,
      apply quotient_add_group.induction_on' x,
      intro z,
      symmetry,
      refine @free_abelian_group.lift.unique _ _ _ _ _
        ⟨λ p q, _⟩ _ z,
      { simp [tensor_product.smul_add] },
      rintro ⟨m, n⟩,
      change r • s • (m ⊗ₜ n) = ((r * s) • m) ⊗ₜ n,
      rw mul_smul, refl
    end,
  one_smul := λ x, quotient.induction_on x $ λ _,
    eq.symm $ free_abelian_group.lift.unique _ _ $ λ ⟨p, q⟩,
    by rw one_smul; refl }

@[simp] lemma tmul_smul (r : R) (x : M) (y : N) : x ⊗ₜ (r • y) = r • (x ⊗ₜ[R] y) :=
(smul_tmul _ _ _).symm

variables (R M N)
def mk : M →ₗ N →ₗ M ⊗ N :=
linear_map.mk₂ R (⊗ₜ) add_tmul (λ c m n, by rw [smul_tmul, tmul_smul]) tmul_add tmul_smul
variables {R M N}

@[simp] lemma mk_apply (m : M) (n : N) : mk R M N m n = m ⊗ₜ n := rfl

lemma zero_tmul (n : N) : (0 ⊗ₜ[R] n : M ⊗ N) = 0 := (mk R M N).map_zero₂ _
lemma tmul_zero (m : M) : (m ⊗ₜ[R] 0 : M ⊗ N) = 0 := (mk R M N _).map_zero
lemma neg_tmul (m : M) (n : N) : (-m) ⊗ₜ n = -(m ⊗ₜ[R] n) := (mk R M N).map_neg₂ _ _
lemma tmul_neg (m : M) (n : N) : m ⊗ₜ (-n) = -(m ⊗ₜ[R] n) := (mk R M N _).map_neg _

end module

local attribute [instance] quotient_add_group.left_rel normal_add_subgroup.to_is_add_subgroup

@[elab_as_eliminator]
protected theorem induction_on
  {C : (M ⊗[R] N) → Prop}
  (z : M ⊗[R] N)
  (C0 : C 0)
  (C1 : ∀ x y, C $ x ⊗ₜ[R] y)
  (Cp : ∀ x y, C x → C y → C (x + y)) : C z :=
quotient.induction_on z $ λ x, free_abelian_group.induction_on x
  C0 (λ ⟨p, q⟩, C1 p q)
  (λ ⟨p, q⟩ _, show C (-(p ⊗ₜ q)), by rw ← neg_tmul; from C1 (-p) q)
  (λ _ _, Cp _ _)

section UMP

variables {M N P Q}
variables (f : M →ₗ[R] N →ₗ[R] P)

local attribute [instance] free_abelian_group.lift.is_add_group_hom

def lift_aux : (M ⊗[R] N) → P :=
quotient_add_group.lift _
  (free_abelian_group.lift $ λ z, f z.1 z.2) $ λ x hx,
begin
  refine (is_add_group_hom.mem_ker _).1 (add_group.closure_subset _ hx),
  clear hx x, rintro x (⟨m₁, m₂, n, rfl⟩ | ⟨m, n₁, n₂, rfl⟩ | ⟨q, m, n, rfl⟩);
    simp [is_add_group_hom.mem_ker, -sub_eq_add_neg,
      f.map_add, f.map_add₂, f.map_smul, f.map_smul₂, sub_self],
end
variable {f}

local attribute [instance] quotient_add_group.left_rel normal_add_subgroup.to_is_add_subgroup

@[simp] lemma lift_aux.add (x y) : lift_aux f (x + y) = lift_aux f x + lift_aux f y :=
quotient.induction_on₂ x y $ λ m n, free_abelian_group.lift.add _ _ _

@[simp] lemma lift_aux.smul (r:R) (x) : lift_aux f (r • x) = r • lift_aux f x :=
tensor_product.induction_on _ _ x (smul_zero _).symm
  (λ p q, by rw [← tmul_smul]; simp [lift_aux, tmul])
  (λ p q ih1 ih2, by simp [@smul_add _ _ _ _ _ _ p _,
    lift_aux.add, ih1, ih2, smul_add])

variable (f)
def lift : M ⊗ N →ₗ P :=
{ to_fun := lift_aux f,
  add := lift_aux.add,
  smul := lift_aux.smul }
variable {f}

@[simp] lemma lift.tmul (x y) : lift f (x ⊗ₜ y) = f x y :=
zero_add _

@[simp] lemma lift.tmul' (x y) : (lift f).1 (x ⊗ₜ y) = f x y :=
lift.tmul _ _

theorem lift.unique {g : (M ⊗[R] N) →ₗ[R] P} (H : ∀ x y, g (x ⊗ₜ y) = f x y) :
  g = lift f :=
linear_map.ext $ λ z, begin
  apply quotient_add_group.induction_on' z,
  intro z,
  refine @free_abelian_group.lift.unique _ _ _ _ _ ⟨λ p q, _⟩ _ z,
  { simp [g.2] },
  exact λ ⟨m, n⟩, H m n
end

theorem lift_mk : lift (mk R M N) = linear_map.id :=
eq.symm $ lift.unique $ λ x y, rfl

theorem lift_compr₂ (g : P →ₗ Q) : lift (f.compr₂ g) = g.comp (lift f) :=
eq.symm $ lift.unique $ λ x y, by simp

theorem lift_mk_compr₂ (f : M ⊗ N →ₗ P) : lift ((mk R M N).compr₂ f) = f :=
by rw [lift_compr₂, lift_mk, linear_map.comp_id]

theorem ext {g h : (M ⊗[R] N) →ₗ[R] P}
  (H : ∀ x y, g (x ⊗ₜ y) = h (x ⊗ₜ y)) : g = h :=
by rw ← lift_mk_compr₂ h; exact lift.unique H

theorem mk_compr₂_inj {g h : M ⊗ N →ₗ P}
  (H : (mk R M N).compr₂ g = (mk R M N).compr₂ h) : g = h :=
by rw [← lift_mk_compr₂ g, H, lift_mk_compr₂]

example : M → N → (M → N → P) → P :=
λ m, flip $ λ f, f m

variables (R M N P)
def uncurry : (M →ₗ N →ₗ[R] P) →ₗ M ⊗ N →ₗ P :=
linear_map.flip $ lift $ (linear_map.lflip _ _ _ _).comp linear_map.id.flip
variables {R M N P}

@[simp] theorem uncurry_apply (f : M →ₗ[R] N →ₗ[R] P) (m : M) (n : N) :
  uncurry R M N P f (m ⊗ₜ n) = f m n :=
by rw [uncurry, linear_map.flip_apply, lift.tmul]; refl

variables (R M N P)
def lift.equiv : (M →ₗ N →ₗ P) ≃ₗ (M ⊗ N →ₗ P) :=
{ inv_fun := λ f, (mk R M N).compr₂ f,
  left_inv := λ f, linear_map.ext₂ $ λ m n, lift.tmul _ _,
  right_inv := λ f, ext $ λ m n, lift.tmul _ _,
  .. uncurry R M N P }

def lcurry : (M ⊗[R] N →ₗ[R] P) →ₗ[R] M →ₗ[R] N →ₗ[R] P :=
(lift.equiv R M N P).symm
variables {R M N P}

@[simp] theorem lcurry_apply (f : M ⊗[R] N →ₗ[R] P) (m : M) (n : N) :
  lcurry R M N P f m n = f (m ⊗ₜ n) := rfl

def curry (f : M ⊗ N →ₗ P) : M →ₗ N →ₗ P := lcurry R M N P f

@[simp] theorem curry_apply (f : M ⊗ N →ₗ[R] P) (m : M) (n : N) :
  curry f m n = f (m ⊗ₜ n) := rfl

end UMP

variables {M N}
protected def lid : R ⊗ M ≃ₗ M :=
linear_equiv.of_linear (lift $ linear_map.lsmul R M) (mk R R M 1)
  (linear_map.ext $ λ _, by simp)
  (ext $ λ r m, by simp; rw [← tmul_smul, ← smul_tmul, smul_eq_mul, mul_one])

protected def comm : M ⊗ N ≃ₗ N ⊗ M :=
linear_equiv.of_linear (lift (mk R N M).flip) (lift (mk R M N).flip)
  (ext $ λ m n, rfl)
  (ext $ λ m n, rfl)

open linear_map
protected def assoc : (M ⊗[R] N) ⊗[R] P ≃ₗ[R] M ⊗[R] (N ⊗[R] P) :=
begin
  refine linear_equiv.of_linear
    (lift $ lift $ comp (lcurry R _ _ _) $ mk _ _ _)
    (lift $ comp (uncurry R _ _ _) $ curry $ mk _ _ _)
    (mk_compr₂_inj $ linear_map.ext $ λ m, ext $ λ n p, _)
    (mk_compr₂_inj $ flip_inj $ linear_map.ext $ λ p, ext $ λ m n, _);
  repeat { rw lift.tmul <|> rw compr₂_apply <|> rw comp_apply <|>
    rw mk_apply <|> rw flip_apply <|> rw lcurry_apply <|>
    rw uncurry_apply <|> rw curry_apply <|> rw id_apply }
end

def map (f : M →ₗ[R] P) (g : N →ₗ Q) : M ⊗ N →ₗ P ⊗ Q :=
lift $ comp (compl₂ (mk _ _ _) g) f

@[simp] theorem map_tmul (f : M →ₗ[R] P) (g : N →ₗ[R] Q) (m : M) (n : N) :
  map f g (m ⊗ₜ n) = f m ⊗ₜ g n :=
rfl

def congr (f : M ≃ₗ[R] P) (g : N ≃ₗ[R] Q) : M ⊗ N ≃ₗ[R] P ⊗ Q :=
linear_equiv.of_linear (map f g) (map f.symm g.symm)
  (ext $ λ m n, by simp; simp only [linear_equiv.apply_symm_apply])
  (ext $ λ m n, by simp; simp only [linear_equiv.symm_apply_apply])

variables (ι₁ : Type*) (ι₂ : Type*)
variables [decidable_eq ι₁] [decidable_eq ι₂]
variables (β₁ : ι₁ → Type*) (β₂ : ι₂ → Type*)
variables [Π i₁, add_comm_group (β₁ i₁)] [Π i₂, add_comm_group (β₂ i₂)]
variables [Π i₁, module R (β₁ i₁)] [Π i₂, module R (β₂ i₂)]

def direct_sum : direct_sum ι₁ β₁ ⊗[R] direct_sum ι₂ β₂
  ≃ₗ[R] direct_sum (ι₁ × ι₂) (λ i, β₁ i.1 ⊗[R] β₂ i.2) :=
begin
  refine linear_equiv.of_linear
    (lift $ direct_sum.to_module R _ _ $ λ i₁, flip $ direct_sum.to_module R _ _ $ λ i₂,
      flip $ curry $ direct_sum.lof R (ι₁ × ι₂) (λ i, β₁ i.1 ⊗[R] β₂ i.2) (i₁, i₂))
    (direct_sum.to_module R _ _ $ λ i, map (direct_sum.lof R _ _ _) (direct_sum.lof R _ _ _))
    (linear_map.ext $ direct_sum.to_module.ext $ λ i, mk_compr₂_inj $
      linear_map.ext $ λ x₁, linear_map.ext $ λ x₂, _)
    (mk_compr₂_inj $ linear_map.ext $ direct_sum.to_module.ext $ λ i₁, linear_map.ext $ λ x₁,
      linear_map.ext $ direct_sum.to_module.ext $ λ i₂, linear_map.ext $ λ x₂, _);
  repeat { rw compr₂_apply <|> rw comp_apply <|> rw id_apply <|> rw mk_apply <|>
    rw direct_sum.to_module_lof <|> rw map_tmul <|> rw lift.tmul <|> rw flip_apply <|>
    rw curry_apply },
  cases i; refl
end

end tensor_product


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

/-!
# Extending differentiability to the boundary

We investigate how differentiable functions inside a set extend to differentiable functions
on the boundary. For this, it suffices that the function and its derivative admit limits there.
A general version of this statement is given in `has_fderiv_at_boundary_of_tendsto_fderiv`.

One-dimensional versions, in which one wants to obtain differentiability at the left endpoint or
the right endpoint of an interval, are given in
`has_deriv_at_interval_left_endpoint_of_tendsto_deriv` and
`has_deriv_at_interval_right_endpoint_of_tendsto_deriv`. These versions are formulated in terms
of the one-dimensional derivative `deriv ℝ f`.
-/

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

open filter set metric continuous_linear_map
open_locale topology
local attribute [mono] prod_mono

/-- If a function `f` is differentiable in a convex open set and continuous on its closure, and its
derivative converges to a limit `f'` at a point on the boundary, then `f` is differentiable there
with derivative `f'`. -/
theorem has_fderiv_at_boundary_of_tendsto_fderiv {f : E → F} {s : set E} {x : E} {f' : E →L[ℝ] F}
  (f_diff : differentiable_on ℝ f s) (s_conv : convex ℝ s) (s_open : is_open s)
  (f_cont : ∀y ∈ closure s, continuous_within_at f s y)
  (h : tendsto (λy, fderiv ℝ f y) (𝓝[s] x) (𝓝 f')) :
  has_fderiv_within_at f f' (closure s) x :=
begin
  classical,
  -- one can assume without loss of generality that `x` belongs to the closure of `s`, as the
  -- statement is empty otherwise
  by_cases hx : x ∉ closure s,
  { rw ← closure_closure at hx, exact has_fderiv_within_at_of_not_mem_closure hx },
  push_neg at hx,
  rw [has_fderiv_within_at, has_fderiv_at_filter, asymptotics.is_o_iff],
  /- One needs to show that `‖f y - f x - f' (y - x)‖ ≤ ε ‖y - x‖` for `y` close to `x` in `closure
  s`, where `ε` is an arbitrary positive constant. By continuity of the functions, it suffices to
  prove this for nearby points inside `s`. In a neighborhood of `x`, the derivative of `f` is
  arbitrarily close to `f'` by assumption. The mean value inequality completes the proof. -/
  assume ε ε_pos,
  obtain ⟨δ, δ_pos, hδ⟩ : ∃ δ > 0, ∀ y ∈ s, dist y x < δ → ‖fderiv ℝ f y - f'‖ < ε,
    by simpa [dist_zero_right] using tendsto_nhds_within_nhds.1 h ε ε_pos,
  set B := ball x δ,
  suffices : ∀ y ∈ B ∩ (closure s), ‖f y - f x - (f' y - f' x)‖ ≤ ε * ‖y - x‖,
    from mem_nhds_within_iff.2 ⟨δ, δ_pos, λy hy, by simpa using this y hy⟩,
  suffices : ∀ p : E × E, p ∈ closure ((B ∩ s) ×ˢ (B ∩ s)) → ‖f p.2 - f p.1 - (f' p.2 - f' p.1)‖
    ≤ ε * ‖p.2 - p.1‖,
  { rw closure_prod_eq at this,
    intros y y_in,
    apply this ⟨x, y⟩,
    have : B ∩ closure s ⊆ closure (B ∩ s), from is_open_ball.inter_closure,
    exact ⟨this ⟨mem_ball_self δ_pos, hx⟩, this y_in⟩ },
  have key : ∀ p : E × E, p ∈ (B ∩ s) ×ˢ (B ∩ s) → ‖f p.2 - f p.1 - (f' p.2 - f' p.1)‖
    ≤ ε * ‖p.2 - p.1‖,
  { rintros ⟨u, v⟩ ⟨u_in, v_in⟩,
    have conv : convex ℝ (B ∩ s) := (convex_ball _ _).inter s_conv,
    have diff : differentiable_on ℝ f (B ∩ s) := f_diff.mono (inter_subset_right _ _),
    have bound : ∀ z ∈ (B ∩ s), ‖fderiv_within ℝ f (B ∩ s) z - f'‖ ≤ ε,
    { intros z z_in,
      convert le_of_lt (hδ _ z_in.2 z_in.1),
      have op : is_open (B ∩ s) := is_open_ball.inter s_open,
      rw differentiable_at.fderiv_within _ (op.unique_diff_on z z_in),
      exact (diff z z_in).differentiable_at (is_open.mem_nhds op z_in) },
    simpa using conv.norm_image_sub_le_of_norm_fderiv_within_le' diff bound u_in v_in },
  rintros ⟨u, v⟩ uv_in,
  refine continuous_within_at.closure_le uv_in _ _ key,
  have f_cont' : ∀y ∈ closure s, continuous_within_at (f - f') s y,
  { intros y y_in,
    exact tendsto.sub (f_cont y y_in) (f'.cont.continuous_within_at) },
  all_goals { -- common start for both continuity proofs
    have : (B ∩ s) ×ˢ (B ∩ s) ⊆ s ×ˢ s, by mono ; exact inter_subset_right _ _,
    obtain ⟨u_in, v_in⟩ : u ∈ closure s ∧ v ∈ closure s,
      by simpa [closure_prod_eq] using closure_mono this uv_in,
    apply continuous_within_at.mono _ this,
    simp only [continuous_within_at] },
  rw nhds_within_prod_eq,
  { have : ∀ u v, f v - f u - (f' v - f' u) = f v - f' v - (f u - f' u) := by { intros, abel },
    simp only [this],
    exact tendsto.comp continuous_norm.continuous_at
      ((tendsto.comp (f_cont' v v_in) tendsto_snd).sub $
        tendsto.comp (f_cont' u u_in) tendsto_fst) },
  { apply tendsto_nhds_within_of_tendsto_nhds,
    rw nhds_prod_eq,
    exact tendsto_const_nhds.mul
      (tendsto.comp continuous_norm.continuous_at $ tendsto_snd.sub tendsto_fst) },
end

/-- If a function is differentiable on the right of a point `a : ℝ`, continuous at `a`, and
its derivative also converges at `a`, then `f` is differentiable on the right at `a`. -/
lemma has_deriv_at_interval_left_endpoint_of_tendsto_deriv {s : set ℝ} {e : E} {a : ℝ} {f : ℝ → E}
  (f_diff : differentiable_on ℝ f s) (f_lim : continuous_within_at f s a)
  (hs : s ∈ 𝓝[>] a)
  (f_lim' : tendsto (λx, deriv f x) (𝓝[>] a) (𝓝 e)) :
  has_deriv_within_at f e (Ici a) a :=
begin
  /- This is a specialization of `has_fderiv_at_boundary_of_tendsto_fderiv`. To be in the setting of
  this theorem, we need to work on an open interval with closure contained in `s ∪ {a}`, that we
  call `t = (a, b)`. Then, we check all the assumptions of this theorem and we apply it. -/
  obtain ⟨b, ab : a < b, sab : Ioc a b ⊆ s⟩ :=
    mem_nhds_within_Ioi_iff_exists_Ioc_subset.1 hs,
  let t := Ioo a b,
  have ts : t ⊆ s := subset.trans Ioo_subset_Ioc_self sab,
  have t_diff : differentiable_on ℝ f t := f_diff.mono ts,
  have t_conv : convex ℝ t := convex_Ioo a b,
  have t_open : is_open t := is_open_Ioo,
  have t_closure : closure t = Icc a b := closure_Ioo ab.ne,
  have t_cont : ∀y ∈ closure t, continuous_within_at f t y,
  { rw t_closure,
    assume y hy,
    by_cases h : y = a,
    { rw h, exact f_lim.mono ts },
    { have : y ∈ s := sab ⟨lt_of_le_of_ne hy.1 (ne.symm h), hy.2⟩,
      exact (f_diff.continuous_on y this).mono ts } },
  have t_diff' : tendsto (λx, fderiv ℝ f x) (𝓝[t] a) (𝓝 (smul_right 1 e)),
  { simp only [deriv_fderiv.symm],
    exact tendsto.comp
      (is_bounded_bilinear_map_smul_right : is_bounded_bilinear_map ℝ _)
        .continuous_right.continuous_at
      (tendsto_nhds_within_mono_left Ioo_subset_Ioi_self f_lim'), },
  -- now we can apply `has_fderiv_at_boundary_of_differentiable`
  have : has_deriv_within_at f e (Icc a b) a,
  { rw [has_deriv_within_at_iff_has_fderiv_within_at, ← t_closure],
    exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff' },
  exact this.nhds_within (Icc_mem_nhds_within_Ici $ left_mem_Ico.2 ab)
end

/-- If a function is differentiable on the left of a point `a : ℝ`, continuous at `a`, and
its derivative also converges at `a`, then `f` is differentiable on the left at `a`. -/
lemma has_deriv_at_interval_right_endpoint_of_tendsto_deriv {s : set ℝ} {e : E} {a : ℝ} {f : ℝ → E}
  (f_diff : differentiable_on ℝ f s) (f_lim : continuous_within_at f s a)
  (hs : s ∈ 𝓝[<] a)
  (f_lim' : tendsto (λx, deriv f x) (𝓝[<] a) (𝓝 e)) :
  has_deriv_within_at f e (Iic a) a :=
begin
  /- This is a specialization of `has_fderiv_at_boundary_of_differentiable`. To be in the setting of
  this theorem, we need to work on an open interval with closure contained in `s ∪ {a}`, that we
  call `t = (b, a)`. Then, we check all the assumptions of this theorem and we apply it. -/
  obtain ⟨b, ba, sab⟩ : ∃ b ∈ Iio a, Ico b a ⊆ s :=
    mem_nhds_within_Iio_iff_exists_Ico_subset.1 hs,
  let t := Ioo b a,
  have ts : t ⊆ s := subset.trans Ioo_subset_Ico_self sab,
  have t_diff : differentiable_on ℝ f t := f_diff.mono ts,
  have t_conv : convex ℝ t := convex_Ioo b a,
  have t_open : is_open t := is_open_Ioo,
  have t_closure : closure t = Icc b a := closure_Ioo (ne_of_lt ba),
  have t_cont : ∀y ∈ closure t, continuous_within_at f t y,
  { rw t_closure,
    assume y hy,
    by_cases h : y = a,
    { rw h, exact f_lim.mono ts },
    { have : y ∈ s := sab ⟨hy.1, lt_of_le_of_ne hy.2 h⟩,
      exact (f_diff.continuous_on y this).mono ts } },
  have t_diff' : tendsto (λx, fderiv ℝ f x) (𝓝[t] a) (𝓝 (smul_right 1 e)),
  { simp only [deriv_fderiv.symm],
    exact tendsto.comp
      (is_bounded_bilinear_map_smul_right : is_bounded_bilinear_map ℝ _)
        .continuous_right.continuous_at
      (tendsto_nhds_within_mono_left Ioo_subset_Iio_self f_lim'), },
  -- now we can apply `has_fderiv_at_boundary_of_differentiable`
  have : has_deriv_within_at f e (Icc b a) a,
  { rw [has_deriv_within_at_iff_has_fderiv_within_at, ← t_closure],
    exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff' },
  exact this.nhds_within (Icc_mem_nhds_within_Iic $ right_mem_Ioc.2 ba)
end

/-- If a real function `f` has a derivative `g` everywhere but at a point, and `f` and `g` are
continuous at this point, then `g` is also the derivative of `f` at this point. -/
lemma has_deriv_at_of_has_deriv_at_of_ne {f g : ℝ → E} {x : ℝ}
  (f_diff : ∀ y ≠ x, has_deriv_at f (g y) y)
  (hf : continuous_at f x) (hg : continuous_at g x) :
  has_deriv_at f (g x) x :=
begin
  have A : has_deriv_within_at f (g x) (Ici x) x,
  { have diff : differentiable_on ℝ f (Ioi x) :=
      λy hy, (f_diff y (ne_of_gt hy)).differentiable_at.differentiable_within_at,
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply has_deriv_at_interval_left_endpoint_of_tendsto_deriv diff hf.continuous_within_at
      self_mem_nhds_within,
    have : tendsto g (𝓝[>] x) (𝓝 (g x)) := tendsto_inf_left hg,
    apply this.congr' _,
    apply mem_of_superset self_mem_nhds_within (λy hy, _),
    exact (f_diff y (ne_of_gt hy)).deriv.symm },
  have B : has_deriv_within_at f (g x) (Iic x) x,
  { have diff : differentiable_on ℝ f (Iio x) :=
      λy hy, (f_diff y (ne_of_lt hy)).differentiable_at.differentiable_within_at,
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply has_deriv_at_interval_right_endpoint_of_tendsto_deriv diff hf.continuous_within_at
      self_mem_nhds_within,
    have : tendsto g (𝓝[<] x) (𝓝 (g x)) := tendsto_inf_left hg,
    apply this.congr' _,
    apply mem_of_superset self_mem_nhds_within (λy hy, _),
    exact (f_diff y (ne_of_lt hy)).deriv.symm },
  simpa using B.union A
end

/-- If a real function `f` has a derivative `g` everywhere but at a point, and `f` and `g` are
continuous at this point, then `g` is the derivative of `f` everywhere. -/
lemma has_deriv_at_of_has_deriv_at_of_ne' {f g : ℝ → E} {x : ℝ}
  (f_diff : ∀ y ≠ x, has_deriv_at f (g y) y)
  (hf : continuous_at f x) (hg : continuous_at g x) (y : ℝ) :
  has_deriv_at f (g y) y :=
begin
  rcases eq_or_ne y x with rfl|hne,
  { exact has_deriv_at_of_has_deriv_at_of_ne f_diff hf hg },
  { exact f_diff y hne }
end


import Mathlib.Algebra.Group.Basic

/-

# Simple type theory and its embedding into Lean

## Types

We have some collection of base types τ, σ,... and the ability to
form function types τ → σ.

While the base types are symbolic, we often use familiar types
like Int, Float, or String. Mathematical objects can also fit
here like ℝ or Set.

Using function types, we can build new types from old like
τ → (σ → τ).

Note here that parenthesis are important. ℕ → (ℚ → ℝ) differs from
(ℕ → ℚ) → ℝ. The first takes natural numbers as inputs and returns
functions whose inputs are rational numbers and whose outputs are
real numbers. The latter inputs _functions_ ℕ → ℚ and outputs ℝ.

-/

-- We have familiar types in Lean core
#check UInt64
#check Float
#check String
#check List

-- Other types are defined in libraries
#check Group
#check Monoid
#check ℕ

-- From these we can iteratively make function types
#check Float → String
#check (ℕ → ℕ) → ℕ
#check ℕ → (ℕ → ℕ)
-- #check ℕ × ℕ → ℕ
-- By convention we right associate iterated function types
#check String → (ℤ → Bool) → Prop
-- Note the lack of parenthesis

/-

## Terms

Terms are organized by their type. For example, 50.12 is a Float
and 10 (most naturally) has type ℕ

To build terms of simple type theory, we have two basic
building blocks: constants and variables. The two examples above are
constants and their meaning is fixed.

Variables behave as familiar.

One way to declare new constants in Lean is to use the axiom
keyword opaque
-/

-- This tells Lean that we have a string that
opaque s : String
#check s
-- #eval s
axiom zeus : Bool
/-
What do we know about it? Nothing. Opaque and its cousin axiom should
be avoided

We can build strings use the def keyword.
-/
def better : String := "Better"
#check better
#eval better
-- or integers
def myfav : UInt8 := 10
def legit : Bool := true
example : Float := 12395959594848494949

-- Variables can be declared using the variable keyword
variable (x : ℤ)
#check x
variable (u v w : String)
#check v

/-
These are usually called free variables. Bound variables appear
in one of the two ways to make new terms from old.

In function application, we can combine a term (f : τ → σ) and a
term (t : τ) to get a term of type σ. This is denoted by f t, eg f(t) in math.

In function abstraction, we given a variable (x: τ) and a term
(s : σ) that may involve x we can form the function that we would
usually in math denote x ↦ s(x). In a function abstraction,
the variable x is called _bound_.
-/

-- We build functions in Lean using the fun keyword
def funFun : String → ℕ := fun s => s.length
-- We can construct the variable term directly
def fancy (n : ℕ) : ℕ := 3*n+4
#check fancy
-- We can also use λ notation
def lamAbst : ℕ → String := λ s => toString s

-- We write application of function as concatentation.
#check funFun better
#eval funFun better
#reduce funFun better

-- Note that types need to match
#check funFun myfav

/- As a consequence of our associativity convention for
iterated function types, we left associate function application
by default.
-/
#check fancy fancy 5
#check fancy (fancy 5)

/-
Multivariable functions come from iterating →. Below we make a
function of two variables of type the natural numbers.
-/
def biggest : ℕ → ℕ → ℕ :=
  fun n => fun m => max n m
def biggest' : ℕ → ℕ → ℕ :=
  fun n m => max n m
def biggest'' (n m : ℕ) : ℕ := max n m

/-
Partial application of curried functions is natural from
these conventions.

Given f : σ₀ → σ₁ → σ₂ → ⋯ → σₘ and a term s : σ₀, we have
f s : σ₁ → ⋯ → σₘ
-/
#check biggest' 10

/-
We've used some existing functions in Lean to simply our
constructions above, eg length, toString, and max.

Lean possesses standard programming language constructs
which we can use to build terms directly, like if-then-else if-then-else.
-/

def goodChoice (n : Nat) : Nat :=
  if n = 37 then 37
  else if n = 73 then 73
  else 0

/-
Note that the #check command is just to check the type of a term.
It does not betray any computation on the term.

If you want to actually evaluate a function, you can use one of
two options: #eval and #reduce
-/

#eval goodChoice 10
#reduce goodChoice 37

/-
While both perform computation, there are important differences.

#reduce attempts to reduce terms to a normal form. It works within
the type checking kernel of Lean. It is generally more expensive.

#eval uses an external VM to perform quick (unverified) computation.
-/


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import measure_theory.measure.vector_measure
import measure_theory.function.ae_eq_of_integral

/-!

# Vector measure defined by an integral

Given a measure `μ` and an integrable function `f : α → E`, we can define a vector measure `v` such
that for all measurable set `s`, `v i = ∫ x in s, f x ∂μ`. This definition is useful for
the Radon-Nikodym theorem for signed measures.

## Main definitions

* `measure_theory.measure.with_densityᵥ`: the vector measure formed by integrating a function `f`
  with respect to a measure `μ` on some set if `f` is integrable, and `0` otherwise.

-/

noncomputable theory
open_locale classical measure_theory nnreal ennreal

variables {α β : Type*} {m : measurable_space α}

namespace measure_theory

open topological_space

variables {μ ν : measure α}
variables {E : Type*} [normed_group E] [normed_space ℝ E] [complete_space E]

/-- Given a measure `μ` and an integrable function `f`, `μ.with_densityᵥ f` is
the vector measure which maps the set `s` to `∫ₛ f ∂μ`. -/
def measure.with_densityᵥ {m : measurable_space α} (μ : measure α) (f : α → E) :
  vector_measure α E :=
if hf : integrable f μ then
{ measure_of' := λ s, if measurable_set s then ∫ x in s, f x ∂μ else 0,
  empty' := by simp,
  not_measurable' := λ s hs, if_neg hs,
  m_Union' := λ s hs₁ hs₂,
  begin
    convert has_sum_integral_Union hs₁ hs₂ hf.integrable_on,
    { ext n, rw if_pos (hs₁ n) },
    { rw if_pos (measurable_set.Union hs₁) }
  end }
else 0

open measure

include m

variables {f g : α → E}

lemma with_densityᵥ_apply (hf : integrable f μ) {s : set α} (hs : measurable_set s) :
  μ.with_densityᵥ f s = ∫ x in s, f x ∂μ :=
by { rw [with_densityᵥ, dif_pos hf], exact dif_pos hs }

@[simp] lemma with_densityᵥ_zero : μ.with_densityᵥ (0 : α → E) = 0 :=
by { ext1 s hs, erw [with_densityᵥ_apply (integrable_zero α E μ) hs], simp, }

@[simp] lemma with_densityᵥ_neg : μ.with_densityᵥ (-f) = -μ.with_densityᵥ f :=
begin
  by_cases hf : integrable f μ,
  { ext1 i hi,
    rw [vector_measure.neg_apply, with_densityᵥ_apply hf hi,
        ← integral_neg, with_densityᵥ_apply hf.neg hi],
    refl },
  { rw [with_densityᵥ, with_densityᵥ, dif_neg hf, dif_neg, neg_zero],
    rwa integrable_neg_iff }
end

lemma with_densityᵥ_neg' : μ.with_densityᵥ (λ x, -f x) = -μ.with_densityᵥ f :=
with_densityᵥ_neg

@[simp] lemma with_densityᵥ_add (hf : integrable f μ) (hg : integrable g μ) :
  μ.with_densityᵥ (f + g) = μ.with_densityᵥ f + μ.with_densityᵥ g :=
begin
  ext1 i hi,
  rw [with_densityᵥ_apply (hf.add hg) hi, vector_measure.add_apply,
      with_densityᵥ_apply hf hi, with_densityᵥ_apply hg hi],
  simp_rw [pi.add_apply],
  rw integral_add; rw ← integrable_on_univ,
  { exact hf.integrable_on.restrict measurable_set.univ },
  { exact hg.integrable_on.restrict measurable_set.univ }
end

lemma with_densityᵥ_add' (hf : integrable f μ) (hg : integrable g μ) :
  μ.with_densityᵥ (λ x, f x + g x) = μ.with_densityᵥ f + μ.with_densityᵥ g :=
with_densityᵥ_add hf hg

@[simp] lemma with_densityᵥ_sub (hf : integrable f μ) (hg : integrable g μ) :
  μ.with_densityᵥ (f - g) = μ.with_densityᵥ f - μ.with_densityᵥ g :=
by rw [sub_eq_add_neg, sub_eq_add_neg, with_densityᵥ_add hf hg.neg, with_densityᵥ_neg]

lemma with_densityᵥ_sub' (hf : integrable f μ) (hg : integrable g μ) :
  μ.with_densityᵥ (λ x, f x - g x) = μ.with_densityᵥ f - μ.with_densityᵥ g :=
with_densityᵥ_sub hf hg

@[simp] lemma with_densityᵥ_smul {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
  [smul_comm_class ℝ 𝕜 E] (f : α → E) (r : 𝕜) :
  μ.with_densityᵥ (r • f) = r • μ.with_densityᵥ f :=
begin
  by_cases hf : integrable f μ,
  { ext1 i hi,
    rw [with_densityᵥ_apply (hf.smul r) hi, vector_measure.smul_apply,
        with_densityᵥ_apply hf hi, ← integral_smul r f],
    refl },
  { by_cases hr : r = 0,
    { rw [hr, zero_smul, zero_smul, with_densityᵥ_zero] },
    { rw [with_densityᵥ, with_densityᵥ, dif_neg hf, dif_neg, smul_zero],
      rwa integrable_smul_iff hr f } }
end

lemma with_densityᵥ_smul' {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
  [smul_comm_class ℝ 𝕜 E] (f : α → E) (r : 𝕜) :
  μ.with_densityᵥ (λ x, r • f x) = r • μ.with_densityᵥ f :=
with_densityᵥ_smul f r

lemma measure.with_densityᵥ_absolutely_continuous (μ : measure α) (f : α → ℝ) :
  μ.with_densityᵥ f ≪ᵥ μ.to_ennreal_vector_measure :=
begin
  by_cases hf : integrable f μ,
  { refine vector_measure.absolutely_continuous.mk (λ i hi₁ hi₂, _),
    rw to_ennreal_vector_measure_apply_measurable hi₁ at hi₂,
    rw [with_densityᵥ_apply hf hi₁, measure.restrict_zero_set hi₂, integral_zero_measure] },
  { rw [with_densityᵥ, dif_neg hf],
    exact vector_measure.absolutely_continuous.zero _ }
end

/-- Having the same density implies the underlying functions are equal almost everywhere. -/
lemma integrable.ae_eq_of_with_densityᵥ_eq {f g : α → E} (hf : integrable f μ) (hg : integrable g μ)
  (hfg : μ.with_densityᵥ f = μ.with_densityᵥ g) :
  f =ᵐ[μ] g :=
begin
  refine hf.ae_eq_of_forall_set_integral_eq f g hg (λ i hi _, _),
  rw [← with_densityᵥ_apply hf hi, hfg, with_densityᵥ_apply hg hi]
end

lemma with_densityᵥ_eq.congr_ae {f g : α → E} (h : f =ᵐ[μ] g) :
  μ.with_densityᵥ f = μ.with_densityᵥ g :=
begin
  by_cases hf : integrable f μ,
  { ext i hi,
    rw [with_densityᵥ_apply hf hi, with_densityᵥ_apply (hf.congr h) hi],
    exact integral_congr_ae (ae_restrict_of_ae h) },
  { have hg : ¬ integrable g μ,
    { intro hg, exact hf (hg.congr h.symm) },
    rw [with_densityᵥ, with_densityᵥ, dif_neg hf, dif_neg hg] }
end

section signed_measure

lemma with_densityᵥ_to_real {f : α → ℝ≥0∞} (hfm : ae_measurable f μ) (hf : ∫⁻ x, f x ∂μ ≠ ∞) :
  μ.with_densityᵥ (λ x, (f x).to_real) =
  @to_signed_measure α _ (μ.with_density f) (is_finite_measure_with_density hf) :=
begin
  have hfi := integrable_to_real_of_lintegral_ne_top hfm hf,
  ext i hi,
  rw [with_densityᵥ_apply hfi hi, to_signed_measure_apply_measurable hi,
      with_density_apply _ hi, integral_to_real hfm.restrict],
  refine ae_lt_top' hfm.restrict (ne_top_of_le_ne_top hf _),
  conv_rhs { rw ← set_lintegral_univ },
  exact lintegral_mono_set (set.subset_univ _),
end

lemma with_densityᵥ_eq_with_density_pos_part_sub_with_density_neg_part
  {f : α → ℝ} (hfi : integrable f μ) :
  μ.with_densityᵥ f =
  @to_signed_measure α _ (μ.with_density (λ x, ennreal.of_real $ f x))
    (is_finite_measure_with_density_of_real hfi.2) -
  @to_signed_measure α _ (μ.with_density (λ x, ennreal.of_real $ -f x))
    (is_finite_measure_with_density_of_real hfi.neg.2) :=
begin
  ext i hi,
  rw [with_densityᵥ_apply hfi hi,
      integral_eq_lintegral_pos_part_sub_lintegral_neg_part hfi.integrable_on,
      vector_measure.sub_apply, to_signed_measure_apply_measurable hi,
      to_signed_measure_apply_measurable hi, with_density_apply _ hi, with_density_apply _ hi],
end

lemma integrable.with_densityᵥ_trim_eq_integral {m m0 : measurable_space α}
  {μ : measure α} (hm : m ≤ m0) {f : α → ℝ} (hf : integrable f μ)
  {i : set α} (hi : measurable_set[m] i) :
  (μ.with_densityᵥ f).trim hm i = ∫ x in i, f x ∂μ :=
by rw [vector_measure.trim_measurable_set_eq hm hi, with_densityᵥ_apply hf (hm _ hi)]

lemma integrable.with_densityᵥ_trim_absolutely_continuous
  {m m0 : measurable_space α} {μ : measure α} (hm : m ≤ m0) (hfi : integrable f μ) :
  (μ.with_densityᵥ f).trim hm ≪ᵥ (μ.trim hm).to_ennreal_vector_measure :=
begin
  refine vector_measure.absolutely_continuous.mk (λ j hj₁ hj₂, _),
  rw [measure.to_ennreal_vector_measure_apply_measurable hj₁, trim_measurable_set_eq hm hj₁] at hj₂,
  rw [vector_measure.trim_measurable_set_eq hm hj₁, with_densityᵥ_apply hfi (hm _ hj₁)],
  simp only [measure.restrict_eq_zero.mpr hj₂, integral_zero_measure]
end

end signed_measure

end measure_theory


lemma pow_pow (a m n : mynat) : (a ^ m) ^ n = a ^ (m * n) :=
begin
induction n with b hb,
rwa [mul_zero, pow_zero, pow_zero],
rwa [mul_succ, pow_succ, hb, pow_add],
end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_455
  (x : ℝ)
  (h₀ : 2 * (2 * (2 * (2 * x))) = 48) :
  x = 3 :=
begin
  linarith,
end