import for_mathlib.mod_forms2
import mod_forms.holomorphic_functions
import analysis.complex.removable_singularity
import analysis.complex.upper_half_plane.basic
import analysis.complex.upper_half_plane.topology
import number_theory.modular
import group_theory.index
import mod_forms.Eisenstein_Series.Eisen_is_holo

/-!
# q-expansions of periodic functions

We show that if `f : ℂ → ℂ` satisfies `f(z + h) = f(z)`, for some nonzero real `h`, then
there is a well-defined `F` such that `f(z) = F(exp(2 * π * I * z / h))` for all `z`;
and if `f` is holomorphic at some `z`, then `F` is holomorphic at `q = exp (2 * π * I * z / h)`.

We also show (using Riemann's removable singularity theorem) that if `f` is holomorphic and bounded
for all sufficiently large `im z`, then `F` extends to a holomorphic function on a neighbourhood of
`0`. As a consequence, if `f` tends to zero as `im z → ∞`, then in fact it decays *exponentially*
to zero.
-/

open modular_form complex filter asymptotics
open_locale real topology manifold filter

noncomputable theory

abbreviation ℝ_pos := {u : ℝ // 0 < u}

instance : has_one ℝ_pos := by { use 1, }

/-- Function-theoretic lemma, maybe move this elsewhere? -/
lemma bound_holo_fcn (g : ℂ → ℂ) (hg : differentiable_at ℂ g 0) (hg' : g 0 = 0):
  is_O (𝓝 0) g id  :=
begin
  replace hg := hg.has_deriv_at.is_O_sub, simp_rw [hg', sub_zero] at hg, exact hg,
end

section Q_and_Z

variables (h : ℝ_pos)

def Q (z : ℂ) : ℂ := exp ( 2 * π * I * z / h )

def Z (q : ℂ) : ℂ := h / (2 * π * I) * log q

lemma log_exp' (z : ℂ) : ∃ (n : ℤ), log (exp z) = z + n * (2 * π * I) :=
begin
  rw [←exp_eq_exp_iff_exists_int, exp_log], exact exp_ne_zero z,
end

lemma QZ_eq_id (q : ℂ) (hq : q ≠ 0) : Q h (Z h q) = q :=
begin
  dsimp only [Q, Z],
  suffices : 2 * ↑π * I * (↑h / (2 * ↑π * I) * log q) / ↑h = log q,
  { rw this, exact exp_log hq },
  have : (h : ℂ) ≠ 0 := of_real_ne_zero.mpr h.2.ne',
  field_simp [two_pi_I_ne_zero, this], ring,
end

lemma abs_Q_eq (z : ℂ) : abs (Q h z) = real.exp(-2 * π * im z / h) :=
begin
  dsimp only [Q], rw abs_exp, congr,
  rw [div_eq_mul_inv, mul_comm],
  have : (↑h)⁻¹ = (↑((h : ℝ)⁻¹) : ℂ) := by simp, rw this,
  rw of_real_mul_re,
  have : 2 * ↑π * I * z = (↑(2 * π) * z) * I := by { simp, ring, },
  rw [this, mul_I_re, of_real_mul_im], field_simp [h.2.ne'],
end

lemma im_Z_eq (q : ℂ) (hq : q ≠ 0) : im (Z h q) = -h / (2 * π) * real.log (abs q) :=
begin
  dsimp only [Z],
  have : ↑h / (2 * ↑π * I) * log q = -↑h / (2 * ↑π) * log q * I,
  { field_simp [of_real_ne_zero.mpr real.pi_pos.ne', two_pi_I_ne_zero], ring_nf, simp, },
  rw [this, mul_I_im],
  have : -↑h / (2 * ↑π) * log q = ↑(-↑h / (2 * π)) * log q := by simp,
  rw [this, of_real_mul_re, log_re],
end

lemma ZQ_eq_mod_period (z : ℂ) : ∃ (m : ℤ), Z h (Q h z) = z + m * h :=
begin
  dsimp only [Q, Z],
  have t := log_exp' ( 2 * ↑π * I * z / ↑h ),
  cases t with m t, use m, rw t,
  have : (h:ℂ) ≠ 0 := of_real_ne_zero.mpr h.2.ne',
  field_simp [two_pi_I_ne_zero], ring,
end

lemma abs_q_lt_iff (A : ℝ) (z : ℂ) : abs (Q h z) < real.exp(-2 * π * A / h) ↔ A < im z :=
begin
  rw [abs_Q_eq, real.exp_lt_exp],
  split,
  { intro hz, rw div_lt_div_right at hz, swap, exact h.2,
    have : (-2) * π < 0 := by simpa using real.pi_pos,
    rwa mul_lt_mul_left_of_neg this at hz, },
  { intro hz, rw div_lt_div_right, swap, exact h.2,
    have : (-2) * π < 0 := by simpa using real.pi_pos,
    rwa mul_lt_mul_left_of_neg this, },
end

-- Filter stuff

def at_I_inf' : filter ℂ := at_top.comap im

lemma at_I_inf'_mem (S : set ℂ) : S ∈ at_I_inf' ↔ (∃ A : ℝ, ∀ z : ℂ, A < im z → z ∈ S) :=
begin
  rw [at_I_inf', mem_comap', mem_at_top_sets],
  simp, split,
  { intro h, cases h with a h, use a,
    intros z hz, specialize h (im z) hz.le, apply h, refl },
  { intro h, cases h with A h, use A + 1,
    intros b hb x hx, apply (h x), rw hx, linarith, }
end

lemma Z_tendsto : tendsto (Z h) (𝓝[{0}ᶜ] 0) at_I_inf' :=
begin
  rw [tendsto, map_le_iff_le_comap, comap],
  intros S h, simp_rw at_I_inf'_mem at h, obtain ⟨T, ⟨A, hA⟩, hT⟩ := h,
  simp_rw [metric.mem_nhds_within_iff, metric.ball, dist_eq, sub_zero],
  use real.exp(-2 * π * A / h), split, apply real.exp_pos,
  intro q, dsimp, rintro ⟨u1, u2⟩,
  rw [←(QZ_eq_id h _ u2), abs_q_lt_iff] at u1, specialize hA (Z h q) u1,
  apply hT, exact hA,
end

lemma Q_tendsto : tendsto (Q h) at_I_inf' (𝓝 0) :=
begin
  rw [tendsto_zero_iff_norm_tendsto_zero],
  simp_rw [norm_eq_abs,abs_Q_eq],
  have : set.range im ∈ at_top,
  { suffices : set.range im = ⊤, { rw this, apply univ_mem, },
    ext1, simp only [set.mem_range, set.top_eq_univ, set.mem_univ, iff_true],
    use I * x, simp, },
  have := (@tendsto_comap'_iff ℝ ℝ ℂ (λ y, real.exp ((-2) * π * y / ↑h)) at_top (𝓝 0) im this).mpr,
  apply this, refine real.tendsto_exp_at_bot.comp _,
  apply tendsto.at_bot_div_const h.2,
  apply tendsto.neg_const_mul_at_top, { simpa using real.pi_pos }, exact tendsto_id,
end

end Q_and_Z

section periodic_on_C

variables (h : ℝ_pos) (f : ℂ → ℂ) (hf : ∀ (w : ℂ), f(w + h) = f(w))

def cusp_fcn_0 : ℂ → ℂ := λ q, f (Z h q)

def cusp_fcn : ℂ → ℂ := function.update (cusp_fcn_0 h f) 0 (lim (𝓝[≠] (0:ℂ)) (cusp_fcn_0 h f))

lemma cusp_fcn_eq_of_nonzero (q : ℂ) (hq : q ≠ 0) :
  (cusp_fcn h f) q = (cusp_fcn_0 h f) q :=
begin
  rw [cusp_fcn, function.update], split_ifs,
  { exfalso, exact hq h_1 },
  { refl },
end

lemma update_twice :
  cusp_fcn h f = function.update (cusp_fcn h f) 0 (lim (𝓝[≠] (0:ℂ)) (cusp_fcn h f)) :=
begin
  ext1 q, rw function.update, split_ifs,
  { rw [cusp_fcn, function.update], split_ifs,
    congr' 1, rw [lim, lim], congr' 1,
    apply map_congr, apply eventually_eq_nhds_within_of_eq_on,
    intros r hr, simp at hr,
    rw function.update, split_ifs, refl,},
  { refl, },
end

include hf

private lemma is_periodic_aux (z : ℂ) (m : ℕ) : f (z + m * h) = f z :=
begin
  induction m with m hm generalizing z, simp,
  rw [nat.succ_eq_add_one, nat.cast_add, nat.cast_one, add_mul, ←add_assoc, one_mul],
  rw hf (z + m * h), exact hm z,
end

lemma is_periodic (z : ℂ) (m : ℤ) : f (z + m * h) = f z :=
begin
  cases m, { exact is_periodic_aux h f hf z m },
  simp only [neg_add_rev, int.cast_neg_succ_of_nat],
  convert (is_periodic_aux h f hf (z - (m+1) * h) (m+1)).symm,
  { simp, ring }, { simp },
end

lemma eq_cusp_fcn (z : ℂ) : f z = (cusp_fcn h f) (Q h z) :=
begin
  have : (cusp_fcn h f) (Q h z) = (cusp_fcn_0 h f) (Q h z),
  { rw cusp_fcn, rw function.update, split_ifs,
    { exfalso, have : Q h z ≠ 0 := by apply exp_ne_zero, exact this h_1, },
    { refl } },
  rw this,
  dsimp only [cusp_fcn_0],
  obtain ⟨m, hm⟩ := ZQ_eq_mod_period h z,
  rw hm, exact (is_periodic h f hf z m).symm,
end

end periodic_on_C

section holo_on_C

variables (h : ℝ_pos) (f : ℂ → ℂ) (hf : ∀ (w : ℂ), f(w + h) = f(w))
include hf

lemma cusp_fcn_diff_at (z : ℂ) (hol_z : differentiable_at ℂ f z) :
  differentiable_at ℂ (cusp_fcn h f) (Q h z) :=
begin
  let q := Q h z,
  have qdiff : has_strict_deriv_at (Q h) (q * (2 * π * I / h)) z,
  { apply has_strict_deriv_at.cexp,
    apply has_strict_deriv_at.div_const,
    have : 2 * ↑π * I = (2 * ↑π * I) * 1 := by ring,
    conv begin congr, skip, rw this, end,
    exact has_strict_deriv_at.const_mul _ (has_strict_deriv_at_id _) },
  -- Now show that the q-map has a differentiable local inverse at z, say L : ℂ → ℂ, with L(q) = z.
  have diff_ne : (q * (2 * π * I / h)) ≠ 0,
  { apply mul_ne_zero, apply exp_ne_zero, apply div_ne_zero,
    exact two_pi_I_ne_zero, simpa using h.2.ne', },
  let L := (qdiff.local_inverse (Q h) _ z) diff_ne,
  have diff_L : differentiable_at ℂ L q := (qdiff.to_local_inverse diff_ne).differentiable_at,
  have hL : (Q h) ∘ L =ᶠ[𝓝 q] (id : ℂ → ℂ),
  { exact (qdiff.has_strict_fderiv_at_equiv diff_ne).eventually_right_inverse },
  --Thus, if F = cusp_expansion f, we have F(q') = f(L(q')) for q' near q.
  --Since L is differentiable at q, and f is diffble at L(q) [ = z], we conclude
  --that F is differentiable at q.
  have hF := eventually_eq.fun_comp hL (cusp_fcn h f), dsimp at hF,
  have : (cusp_fcn h f) ∘ (Q h) ∘ L = f ∘ L := by { ext1 z, exact (eq_cusp_fcn h f hf (L z)).symm },
  rw this at hF,
  have : z = L(q),
  { have hL2 : (L ∘ (Q h)) =ᶠ[𝓝 z] (id : ℂ → ℂ),
    { exact (qdiff.has_strict_fderiv_at_equiv diff_ne).eventually_left_inverse },
    replace hL2 := eventually_eq.eq_of_nhds hL2, dsimp at hL2, rw hL2, },
  rw this at hol_z,
  exact (differentiable_at.comp q hol_z diff_L).congr_of_eventually_eq hF.symm,
end

lemma F_diff_near_zero (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) :
  ∀ᶠ (q : ℂ) in 𝓝[≠] 0, differentiable_at ℂ (cusp_fcn h f) q :=
begin
  refine ((Z_tendsto h).eventually h_hol).mp _,
  apply eventually_nhds_within_of_forall, intros q hq h_diff,
  rw ←(QZ_eq_id _ _ hq), exact cusp_fcn_diff_at _ _ hf _ h_diff,
end

end holo_on_C

section holo_at_inf_C

variables (h : ℝ_pos) (f : ℂ → ℂ) (hf : ∀ (w : ℂ), f(w + h) = f(w))
include hf

lemma F_bound (h_bd : is_O at_I_inf' f (1 : ℂ → ℂ) ) : is_O (𝓝[≠] (0 : ℂ)) (cusp_fcn h f) (1 : ℂ → ℂ)  :=
begin
  refine is_O.congr' (h_bd.comp_tendsto $ Z_tendsto h) _ (by refl) ,
  apply eventually_nhds_within_of_forall, intros q hq,
  rw cusp_fcn_eq_of_nonzero _ _ _ hq, refl,
end

lemma F_diff_at_zero (h_bd : is_O at_I_inf' f (1 : ℂ → ℂ) )
  (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) :
  differentiable_at ℂ (cusp_fcn h f) 0 :=
begin
  obtain ⟨c, t⟩ := (F_bound _ _ hf h_bd).bound,
  replace t := (F_diff_near_zero h f hf h_hol).and t,
  simp only [norm_eq_abs, pi.one_apply, absolute_value.map_one, mul_one] at t,
  obtain ⟨S, hS1, hS2, hS3⟩ := eventually_nhds_iff.mp (eventually_nhds_within_iff.mp t),
  have h_diff : differentiable_on ℂ (cusp_fcn h f) (S \ {0}),
  { intros x hx, apply differentiable_at.differentiable_within_at,
    exact (hS1 x ((set.mem_diff _).mp hx).1  ((set.mem_diff _).mp hx).2).1, },
  have hF_bd : bdd_above (norm ∘ (cusp_fcn h f) '' (S \ {0})),
  { use c, rw mem_upper_bounds, simp, intros y q hq hq2 hy, rw ←hy, exact (hS1 q hq hq2).2 },
  have := differentiable_on_update_lim_of_bdd_above (is_open.mem_nhds hS2 hS3) h_diff hF_bd,
  rw ←update_twice at this,
  exact this.differentiable_at (is_open.mem_nhds hS2 hS3),
end

/-- If `f` is periodic, and holomorphic and bounded near `I∞`, then it tends to a limit at `I∞`,
and this limit is the value of its cusp function at 0. -/
theorem tendsto_at_I_inf (h_bd : is_O at_I_inf' f (1 : ℂ → ℂ) )
  (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) :
  tendsto f at_I_inf' (𝓝 $ cusp_fcn h f 0) :=
begin
  suffices : tendsto (cusp_fcn h f) (𝓝[≠] 0) (𝓝 $ cusp_fcn h f 0),
  { have t2 : f = (cusp_fcn h f) ∘ (Q h) := by { ext1, apply eq_cusp_fcn h f hf },
    conv begin congr, rw t2, end,
    apply tendsto.comp, exact this,
    apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within,
    exact Q_tendsto h, apply eventually_of_forall, intro q, apply exp_ne_zero, },
  exact tendsto_nhds_within_of_tendsto_nhds (F_diff_at_zero _ _ hf h_bd h_hol).continuous_at.tendsto
end

lemma cusp_fcn_zero_of_zero_at_inf (h_bd : is_o at_I_inf' f (1 : ℂ → ℂ) )
  (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) : cusp_fcn h f 0 = 0 :=
begin
  rw [cusp_fcn, function.update], split_ifs, swap, tauto,
  suffices : tendsto (cusp_fcn_0 h f) (𝓝[{0}ᶜ] 0) (𝓝 (0:ℂ)),
  { exact tendsto.lim_eq this },
  have : is_o (𝓝[≠] (0 : ℂ)) (cusp_fcn h f) 1 ,
  { refine is_o.congr' (h_bd.comp_tendsto $ Z_tendsto h) _ (by refl) ,
    apply eventually_nhds_within_of_forall, intros q hq, rw cusp_fcn_eq_of_nonzero _ _ _ hq, refl },
  have : is_o (𝓝[≠] (0 : ℂ)) (cusp_fcn_0 h f) 1,
  { refine is_o.congr' this _ (by refl), apply eventually_nhds_within_of_forall,
    apply cusp_fcn_eq_of_nonzero, },
  simpa using this.tendsto_div_nhds_zero,
end

/-- Main theorem of this file: if `f` is periodic, holomorphic near `I∞`, and tends to zero
at `I∞`, then in fact it tends to zero exponentially fast. -/
theorem exp_decay_of_zero_at_inf (h_bd : is_o at_I_inf' f (1 : ℂ → ℂ) )
  (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) :
  is_O at_I_inf' f (λ z:ℂ, real.exp (-2 * π * im z / h))  :=
begin
  have F0 := cusp_fcn_zero_of_zero_at_inf _ _ hf h_bd h_hol,
  have : f = λ z:ℂ, (cusp_fcn h f) (Q h z) := by { ext1 z, apply eq_cusp_fcn _ _ hf,},
  conv begin congr, skip, rw this, skip, funext, rw [←(abs_Q_eq h), ←norm_eq_abs], end,
  apply is_O.norm_right,
  exact (bound_holo_fcn _ (F_diff_at_zero _ _ hf h_bd.is_O h_hol) F0).comp_tendsto (Q_tendsto h),
end

end holo_at_inf_C

/-! Now we prove corresponding results about modular forms. -/

local notation `ℍ` := upper_half_plane
local notation `SL(` n `, ` R `)`:= matrix.special_linear_group (fin n) R

instance : has_vadd ℝ ℍ :=
begin
  split, intros h z, refine ⟨z + h, _⟩, dsimp at *,
  suffices : 0 < complex.im (z + h), { exact this },
  rw [complex.add_im, complex.of_real_im, add_zero], exact z.2,
end

/-! Tedious checks that notions of holomorphic, bounded, etc are compatible with extension-by-0--/

section modform_equivs

variables {f : ℍ → ℂ} {k : ℤ}

lemma modform_bound_aux (C : ℝ) (g : ℂ → ℂ) (hc : 0 ≤ C)
  (h_bd : is_O_with C  upper_half_plane.at_im_infty f (λ z:ℍ, g z)) : is_O_with C at_I_inf'
  (extend_by_zero f) g  :=
begin
  rw is_O_with_iff at h_bd ⊢,
  apply eventually_of_mem,
  show {z : ℂ | complex.abs (extend_by_zero f z) ≤ C * complex.abs(g z)} ∈ at_I_inf',
  { rw at_I_inf'_mem,
    rw [upper_half_plane.at_im_infty, eventually_iff_exists_mem] at h_bd, obtain ⟨v, hv, h_bd⟩ := h_bd,
    rw [mem_comap', mem_at_top_sets] at hv, cases hv with a hv, use a,
   intros z hz, specialize hv (im z) (hz.le), dsimp at hv,
   rw extend_by_zero, dsimp, split_ifs,
   swap, { rw absolute_value.map_zero, refine mul_nonneg hc _, apply absolute_value.nonneg, },
   specialize h_bd ⟨z, h⟩,
   specialize h_bd (hv _), refl, exact h_bd },
  { dsimp, intros x hx, linarith, },
end

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

lemma modform_bounded ( f : modular_form ⊤ k) :
  is_O at_I_inf' (extend_by_zero f) (1 : ℂ → ℂ)  :=
begin
  have bd := f.bdd_at_infty' (1 : SL(2, ℤ)),

  have : f.to_fun ∣[k, (1 : SL(2, ℤ))] = f, by {apply slash_action.slash_one },
  rw [this, upper_half_plane.is_bounded_at_im_infty] at bd,
  rw bounded_at_filter at bd,
  obtain ⟨c, c_pos, bd⟩ := bd.exists_nonneg,
  rw at_I_inf',
  apply (modform_bound_aux c 1 c_pos _).is_O,
  simp,
  rw is_O_with at *,
  simp at *,
  exact bd,

end

lemma cuspform_vanish_infty (f : cusp_form ⊤ k) :
  is_o at_I_inf' (extend_by_zero f) (1 : ℂ → ℂ)  :=
begin
  have bd := f.zero_at_infty' (1 : SL(2, ℤ)),
  have : f.to_fun ∣[k, (1 : SL(2, ℤ))] = f, by {apply  slash_action.slash_one },
  rw [this, upper_half_plane.is_zero_at_im_infty] at bd,
  have : is_o upper_half_plane.at_im_infty f (1 : ℍ → ℂ)  := by { apply is_o_of_tendsto, simp, simpa using bd },
  rw is_o at *, exact (λ c hc, modform_bound_aux c 1 hc.le (this hc)),
end

lemma modform_periodic  ( f : modular_form ⊤ k) (w : ℂ) :
  (extend_by_zero f)(w + 1) = (extend_by_zero f)(w) :=
begin
  by_cases hw : 0 < im w,
  { rw (extend_by_zero_eq_of_mem f w hw),
    have : 0 < im (w + 1), {rw [add_im, one_im, add_zero], exact hw },
    rw (extend_by_zero_eq_of_mem f _ this),
    have t := Eisenstein_series.mod_form_periodic k f ⟨ w, hw ⟩ 1,
    rw Eisenstein_series.smul_expl at t, convert t, simp },
  { have : extend_by_zero f w = 0,
    { rw extend_by_zero, simp, intro bad, exfalso, exact hw bad },
    rw this,
    have : extend_by_zero f (w + 1) = 0,
    { rw extend_by_zero, simp, intro bad, exfalso,
      have : 0 < im (w + 1) := by tauto,
      rw [add_im, one_im, add_zero] at this,
      exact hw this, },
    exact this }
end

lemma modform_hol ( f : modular_form ⊤ k) (z : ℂ) (hz : 0 < im z):
  differentiable_at ℂ (extend_by_zero f) z :=
begin
  have hf_hol := Eisenstein_series.mdiff_to_holo (Eisenstein_series.hol_extn f) f.holo',
  rw ←is_holomorphic_on_iff_differentiable_on at hf_hol,
  exact (hf_hol z hz).differentiable_at ((is_open_iff_mem_nhds.mp upper_half_plane_is_open) z hz),
end

lemma modform_hol_infty ( f : modular_form ⊤ k) :
  ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ (extend_by_zero f) z :=
begin
  refine eventually_of_mem (_ : upper_half_plane.upper_half_space ∈ at_I_inf') _,
  { rw at_I_inf'_mem, use 0, tauto, },
  { intros x hx, exact modform_hol f x hx },
end

end modform_equivs

section modforms

def unit_disc_sset := {z : ℂ | z.abs <  1}

lemma unit_disc_is_open : is_open unit_disc_sset := is_open_Iio.preimage complex.continuous_abs

local notation `𝔻` := ( ⟨unit_disc_sset, unit_disc_is_open⟩ : topological_space.opens ℂ)

variables (f : ℍ → ℂ) (k : ℤ)

--lemma q_in_D (z : ℍ) : abs (Q 1 z) < 1 := by { convert (abs_q_lt_iff 1 0 z).mpr z.2, simp }

lemma z_in_H (q : 𝔻) (hq : (q:ℂ) ≠ 0) : 0 < im (Z 1 q) :=
begin
  rw im_Z_eq 1 q hq,
  apply mul_pos_of_neg_of_neg,
  { exact div_neg_of_neg_of_pos (neg_lt_zero.mpr zero_lt_one) real.two_pi_pos },
  rw real.log_neg_iff, exact q.2,
  apply absolute_value.pos, exact hq,
end

def cusp_fcn_H : ℂ → ℂ := (cusp_fcn 1 $ extend_by_zero f)

lemma eq_cusp_fcn_H (z : ℍ) ( f : modular_form ⊤ k) :
  f z = (cusp_fcn_H f) (Q 1 z):=
begin
  have t := eq_cusp_fcn 1 (extend_by_zero f) (modform_periodic f) z,
  rw cusp_fcn_H, convert t,
  rw extend_by_zero_eq_of_mem f _ _, { simp }, { cases z, tauto, },
end

lemma cusp_fcn_diff  ( f : modular_form ⊤ k)
  (q : 𝔻) : differentiable_at ℂ (cusp_fcn_H f) q :=
begin
  by_cases hq : (q:ℂ) = 0,
  { rw hq, exact F_diff_at_zero 1 (extend_by_zero f) (modform_periodic f)
    (modform_bounded f) (modform_hol_infty f) },
  { have t := cusp_fcn_diff_at 1 (extend_by_zero f) (modform_periodic f) _
    (modform_hol f _ $ z_in_H q hq),
    rw (QZ_eq_id 1 q hq) at t, rw cusp_fcn_H, exact t },
end

def cusp_form_to_mod_form (f : cusp_form ⊤ k) : modular_form ⊤ k :=
{ to_fun := f.to_fun,
  slash_action_eq' := f.slash_action_eq',
  holo':= f.holo',
  bdd_at_infty' := by {intro A, have := (f.zero_at_infty' A).bounded_at_filter, convert this, }

}

instance : has_coe (cusp_form ⊤ k) (modular_form ⊤ k) :=
{coe := cusp_form_to_mod_form  _}

lemma cusp_fcn_vanish ( f : cusp_form ⊤ k) : cusp_fcn_H f 0 = 0 :=
begin

  exact cusp_fcn_zero_of_zero_at_inf 1 (extend_by_zero f) (modform_periodic (f : modular_form ⊤ k))
    (cuspform_vanish_infty f) (modform_hol_infty (f : modular_form ⊤ k)),
end

lemma exp_decay_of_cuspform  (f : cusp_form ⊤ k) :
 is_O upper_half_plane.at_im_infty f (λ z:ℍ, real.exp (-2 * π * im z))  :=
begin
  obtain ⟨C, hC⟩ := (exp_decay_of_zero_at_inf 1 (extend_by_zero f) (modform_periodic (f : modular_form ⊤ k))
    (cuspform_vanish_infty f) (modform_hol_infty (f : modular_form ⊤ k))).is_O_with,
  rw is_O, use C,
  rw [is_O_with_iff, eventually_iff] at hC ⊢,
  rw at_I_inf'_mem at hC, rw upper_half_plane.at_im_infty_mem,
  obtain ⟨A, hC⟩ := hC, use A + 1, intros z hz, specialize hC z,
  have : A < im z, by {simp, linarith}, specialize hC this, dsimp at hC ⊢,
  rw [extend_by_zero_eq_of_mem] at hC, swap, exact z.2,
  have : ((1 : ℝ_pos) : ℝ) = (1 : ℝ) := by refl,
 simp only [subtype.coe_eta, div_one] at hC, exact hC,
end

end modforms

section petersson
open_locale modular_form

/- Bound on abs(f z) for large values of z -/
lemma pet_bounded_large  {k : ℤ} (f : cusp_form ⊤ k) :
  ∃ (A C : ℝ), ∀ (z : ℍ), (A ≤ im z) → (pet_self f k) z ≤ C :=
begin
  -- first get bound for large values of im z
  have h1 := exp_decay_of_cuspform _ f,
  have : is_O upper_half_plane.at_im_infty (λ (z : ℍ), real.exp ((-2) * π * z.im)) (λ (z : ℍ), 1 / (z.im) ^ ((k : ℝ) / 2)) ,
  {
    apply is_o.is_O, apply is_o_of_tendsto,
    { intros x hx, exfalso,
      contrapose! hx, apply one_div_ne_zero,
      refine (real.rpow_pos_of_pos x.2 _).ne', },
    rw [upper_half_plane.at_im_infty],
    let F := λ (y : ℝ), real.exp ((-2) * π * y) / (1 / y ^ ( (k:ℝ) / 2)),
    apply (@tendsto_comap'_iff _ _ _ F _ _ _ _).mpr,
    { have := tendsto_rpow_mul_exp_neg_mul_at_top_nhds_0 ((k : ℝ) / 2) (2 * π) real.two_pi_pos,
      refine tendsto.congr' _ this, apply eventually_of_mem (Ioi_mem_at_top (0:ℝ)),
      intros y hy, dsimp [F], rw [div_div_eq_mul_div, div_one, mul_comm], congr' 1,
      simp only [neg_mul] },
    { convert Ioi_mem_at_top (0:ℝ), ext1, rw set.mem_range,
      split, { rintro ⟨y, hy⟩, rw ←hy, exact y.2 },
      { intro h, use x * I,
        { rw mul_I_im, exact h },
        { rw upper_half_plane.im,
          simp only [subtype.coe_mk, mul_im, of_real_re, I_im, mul_one,
            I_re, mul_zero, add_zero]} } } },
  obtain ⟨C1, h1'⟩ := (h1.trans this).bound,
  rw [eventually_iff, upper_half_plane.at_im_infty_mem] at h1', cases h1' with A h1',
  dsimp at h1', refine ⟨A, C1 ^ 2, _⟩,
  intros z hz, specialize h1' z hz, rw pet_self, dsimp,
  have : (im z) ^ k = ((im z) ^ ((k : ℝ) / 2)) ^ 2,
  { rw [←real.rpow_int_cast, ←real.rpow_nat_cast, ←real.rpow_mul],
    swap, exact z.2.le, congr' 1, simp, },
  rw [←upper_half_plane.coe_im, this, ←mul_pow],
  rw sq_le_sq,
  have e : 0 < z.im ^ ((k : ℝ) / 2) := by { apply real.rpow_pos_of_pos, exact z.2, },
  have : abs (f z) * (im z) ^ ((k : ℝ) / 2) ≤ C1,
  { rw [div_eq_inv_mul, mul_one, _root_.abs_inv, mul_comm] at h1',
    have h1'' := mul_le_mul_of_nonneg_right h1' _, refine le_trans h1'' _,
    simp,
    { rw _root_.abs_of_nonneg,
      swap, apply real.rpow_nonneg_of_nonneg, exact z.2.le,
      conv begin to_lhs, congr, rw mul_comm, end, rw mul_assoc,
      suffices : (z.im ^ ((k : ℝ) / 2))⁻¹ * z.im ^ ((k : ℝ) / 2) = 1,
      { rw this, simp, },
      apply inv_mul_cancel, exact e.ne' },
    exact e.le, },
  apply abs_le_abs, { exact this, },
  have aux : -(abs (f z) * ↑z.im ^ ((k:ℝ) / 2)) ≤ abs (f z) * ↑z.im ^ ((k:ℝ) / 2),
  { simp, apply mul_nonneg, apply absolute_value.nonneg, exact e.le },
  exact le_trans aux this,
end

end petersson


/-
Copyright (c) 2021 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers

! This file was ported from Lean 3 source module linear_algebra.orientation
! leanprover-community/mathlib commit ce11c3c2a285bbe6937e26d9792fda4e51f3fe1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Ray
import Mathbin.LinearAlgebra.Determinant

/-!
# Orientations of modules

This file defines orientations of modules.

## Main definitions

* `orientation` is a type synonym for `module.ray` for the case where the module is that of
alternating maps from a module to its underlying ring.  An orientation may be associated with an
alternating map or with a basis.

* `module.oriented` is a type class for a choice of orientation of a module that is considered
the positive orientation.

## Implementation notes

`orientation` is defined for an arbitrary index type, but the main intended use case is when
that index type is a `fintype` and there exists a basis of the same cardinality.

## References

* https://en.wikipedia.org/wiki/Orientation_(vector_space)

-/

noncomputable section

open BigOperators

section OrderedCommSemiring

variable (R : Type _) [StrictOrderedCommSemiring R]

variable (M : Type _) [AddCommMonoid M] [Module R M]

variable {N : Type _} [AddCommMonoid N] [Module R N]

variable (ι : Type _)

/-- An orientation of a module, intended to be used when `ι` is a `fintype` with the same
cardinality as a basis. -/
abbrev Orientation :=
  Module.Ray R (AlternatingMap R M R ι)
#align orientation Orientation

/-- A type class fixing an orientation of a module. -/
class Module.Oriented where
  positiveOrientation : Orientation R M ι
#align module.oriented Module.Oriented

export Module.Oriented (positiveOrientation)

variable {R M}

/-- An equivalence between modules implies an equivalence between orientations. -/
def Orientation.map (e : M ≃ₗ[R] N) : Orientation R M ι ≃ Orientation R N ι :=
  Module.Ray.map <| AlternatingMap.domLcongr R R ι R e
#align orientation.map Orientation.map

@[simp]
theorem Orientation.map_apply (e : M ≃ₗ[R] N) (v : AlternatingMap R M R ι) (hv : v ≠ 0) :
    Orientation.map ι e (rayOfNeZero _ v hv) =
      rayOfNeZero _ (v.compLinearMap e.symm) (mt (v.comp_linearEquiv_eq_zero_iff e.symm).mp hv) :=
  rfl
#align orientation.map_apply Orientation.map_apply

@[simp]
theorem Orientation.map_refl : (Orientation.map ι <| LinearEquiv.refl R M) = Equiv.refl _ := by
  rw [Orientation.map, AlternatingMap.domLcongr_refl, Module.Ray.map_refl]
#align orientation.map_refl Orientation.map_refl

@[simp]
theorem Orientation.map_symm (e : M ≃ₗ[R] N) :
    (Orientation.map ι e).symm = Orientation.map ι e.symm :=
  rfl
#align orientation.map_symm Orientation.map_symm

/-- A module is canonically oriented with respect to an empty index type. -/
instance (priority := 100) IsEmpty.oriented [Nontrivial R] [IsEmpty ι] : Module.Oriented R M ι
    where positiveOrientation :=
    rayOfNeZero R (AlternatingMap.constLinearEquivOfIsEmpty 1) <|
      AlternatingMap.constLinearEquivOfIsEmpty.Injective.Ne (by simp)
#align is_empty.oriented IsEmpty.oriented

@[simp]
theorem Orientation.map_positiveOrientation_of_isEmpty [Nontrivial R] [IsEmpty ι] (f : M ≃ₗ[R] N) :
    Orientation.map ι f positiveOrientation = positiveOrientation :=
  rfl
#align orientation.map_positive_orientation_of_is_empty Orientation.map_positiveOrientation_of_isEmpty

@[simp]
theorem Orientation.map_of_isEmpty [IsEmpty ι] (x : Orientation R M ι) (f : M ≃ₗ[R] M) :
    Orientation.map ι f x = x :=
  by
  induction' x using Module.Ray.ind with g hg
  rw [Orientation.map_apply]
  congr
  ext i
  rw [AlternatingMap.compLinearMap_apply]
  congr
#align orientation.map_of_is_empty Orientation.map_of_isEmpty

end OrderedCommSemiring

section OrderedCommRing

variable {R : Type _} [StrictOrderedCommRing R]

variable {M N : Type _} [AddCommGroup M] [AddCommGroup N] [Module R M] [Module R N]

@[simp]
protected theorem Orientation.map_neg {ι : Type _} (f : M ≃ₗ[R] N) (x : Orientation R M ι) :
    Orientation.map ι f (-x) = -Orientation.map ι f x :=
  Module.Ray.map_neg _ x
#align orientation.map_neg Orientation.map_neg

namespace Basis

variable {ι : Type _}

/-- The value of `orientation.map` when the index type has the cardinality of a basis, in terms
of `f.det`. -/
theorem map_orientation_eq_det_inv_smul [Finite ι] (e : Basis ι R M) (x : Orientation R M ι)
    (f : M ≃ₗ[R] M) : Orientation.map ι f x = f.det⁻¹ • x :=
  by
  cases nonempty_fintype ι
  letI := Classical.decEq ι
  induction' x using Module.Ray.ind with g hg
  rw [Orientation.map_apply, smul_rayOfNeZero, ray_eq_iff, Units.smul_def,
    (g.comp_linear_map ↑f.symm).eq_smul_basis_det e, g.eq_smul_basis_det e,
    AlternatingMap.compLinearMap_apply, AlternatingMap.smul_apply, Basis.det_comp, Basis.det_self,
    mul_one, smul_eq_mul, mul_comm, mul_smul, LinearEquiv.coe_inv_det]
#align basis.map_orientation_eq_det_inv_smul Basis.map_orientation_eq_det_inv_smul

variable [Fintype ι] [DecidableEq ι]

/-- The orientation given by a basis. -/
protected def orientation [Nontrivial R] (e : Basis ι R M) : Orientation R M ι :=
  rayOfNeZero R _ e.det_ne_zero
#align basis.orientation Basis.orientation

theorem orientation_map [Nontrivial R] (e : Basis ι R M) (f : M ≃ₗ[R] N) :
    (e.map f).Orientation = Orientation.map ι f e.Orientation := by
  simp_rw [Basis.orientation, Orientation.map_apply, Basis.det_map']
#align basis.orientation_map Basis.orientation_map

/-- The orientation given by a basis derived using `units_smul`, in terms of the product of those
units. -/
theorem orientation_unitsSmul [Nontrivial R] (e : Basis ι R M) (w : ι → Units R) :
    (e.units_smul w).Orientation = (∏ i, w i)⁻¹ • e.Orientation :=
  by
  rw [Basis.orientation, Basis.orientation, smul_rayOfNeZero, ray_eq_iff,
    e.det.eq_smul_basis_det (e.units_smul w), det_units_smul_self, Units.smul_def, smul_smul]
  norm_cast
  simp
#align basis.orientation_units_smul Basis.orientation_unitsSmul

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `congrm #[[expr ray_of_ne_zero _ _ _]] -/
@[simp]
theorem orientation_isEmpty [Nontrivial R] [IsEmpty ι] (b : Basis ι R M) :
    b.Orientation = positiveOrientation :=
  by
  trace
    "./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `congrm #[[expr ray_of_ne_zero _ _ _]]"
  convert b.det_is_empty
#align basis.orientation_is_empty Basis.orientation_isEmpty

end Basis

end OrderedCommRing

section LinearOrderedCommRing

variable {R : Type _} [LinearOrderedCommRing R]

variable {M : Type _} [AddCommGroup M] [Module R M]

variable {ι : Type _}

namespace Orientation

/-- A module `M` over a linearly ordered commutative ring has precisely two "orientations" with
respect to an empty index type. (Note that these are only orientations of `M` of in the conventional
mathematical sense if `M` is zero-dimensional.) -/
theorem eq_or_eq_neg_of_isEmpty [Nontrivial R] [IsEmpty ι] (o : Orientation R M ι) :
    o = positiveOrientation ∨ o = -positiveOrientation :=
  by
  induction' o using Module.Ray.ind with x hx
  dsimp [positive_orientation]
  simp only [ray_eq_iff, sameRay_neg_swap]
  rw [sameRay_or_sameRay_neg_iff_not_linearIndependent]
  intro h
  let a : R := alternating_map.const_linear_equiv_of_is_empty.symm x
  have H : LinearIndependent R ![a, 1] :=
    by
    convert h.map' (↑alternating_map.const_linear_equiv_of_is_empty.symm) (LinearEquiv.ker _)
    ext i
    fin_cases i <;> simp [a]
  rw [linearIndependent_iff'] at H
  simpa using H Finset.univ ![1, -a] (by simp [Fin.sum_univ_succ]) 0 (by simp)
#align orientation.eq_or_eq_neg_of_is_empty Orientation.eq_or_eq_neg_of_isEmpty

end Orientation

namespace Basis

variable [Fintype ι] [DecidableEq ι]

/-- The orientations given by two bases are equal if and only if the determinant of one basis
with respect to the other is positive. -/
theorem orientation_eq_iff_det_pos (e₁ e₂ : Basis ι R M) :
    e₁.Orientation = e₂.Orientation ↔ 0 < e₁.det e₂ :=
  calc
    e₁.Orientation = e₂.Orientation ↔ SameRay R e₁.det e₂.det := ray_eq_iff _ _
    _ ↔ SameRay R (e₁.det e₂ • e₂.det) e₂.det := by rw [← e₁.det.eq_smul_basis_det e₂]
    _ ↔ 0 < e₁.det e₂ := sameRay_smul_left_iff_of_ne e₂.det_ne_zero (e₁.isUnit_det e₂).NeZero

#align basis.orientation_eq_iff_det_pos Basis.orientation_eq_iff_det_pos

/-- Given a basis, any orientation equals the orientation given by that basis or its negation. -/
theorem orientation_eq_or_eq_neg (e : Basis ι R M) (x : Orientation R M ι) :
    x = e.Orientation ∨ x = -e.Orientation :=
  by
  induction' x using Module.Ray.ind with x hx
  rw [← x.map_basis_ne_zero_iff e] at hx
  rwa [Basis.orientation, ray_eq_iff, neg_rayOfNeZero, ray_eq_iff, x.eq_smul_basis_det e,
    sameRay_neg_smul_left_iff_of_ne e.det_ne_zero hx, sameRay_smul_left_iff_of_ne e.det_ne_zero hx,
    lt_or_lt_iff_ne, ne_comm]
#align basis.orientation_eq_or_eq_neg Basis.orientation_eq_or_eq_neg

/-- Given a basis, an orientation equals the negation of that given by that basis if and only
if it does not equal that given by that basis. -/
theorem orientation_ne_iff_eq_neg (e : Basis ι R M) (x : Orientation R M ι) :
    x ≠ e.Orientation ↔ x = -e.Orientation :=
  ⟨fun h => (e.orientation_eq_or_eq_neg x).resolve_left h, fun h =>
    h.symm ▸ (Module.Ray.ne_neg_self e.Orientation).symm⟩
#align basis.orientation_ne_iff_eq_neg Basis.orientation_ne_iff_eq_neg

/-- Composing a basis with a linear equiv gives the same orientation if and only if the
determinant is positive. -/
theorem orientation_comp_linearEquiv_eq_iff_det_pos (e : Basis ι R M) (f : M ≃ₗ[R] M) :
    (e.map f).Orientation = e.Orientation ↔ 0 < (f : M →ₗ[R] M).det := by
  rw [orientation_map, e.map_orientation_eq_det_inv_smul, units_inv_smul, units_smul_eq_self_iff,
    LinearEquiv.coe_det]
#align basis.orientation_comp_linear_equiv_eq_iff_det_pos Basis.orientation_comp_linearEquiv_eq_iff_det_pos

/-- Composing a basis with a linear equiv gives the negation of that orientation if and only if
the determinant is negative. -/
theorem orientation_comp_linearEquiv_eq_neg_iff_det_neg (e : Basis ι R M) (f : M ≃ₗ[R] M) :
    (e.map f).Orientation = -e.Orientation ↔ (f : M →ₗ[R] M).det < 0 := by
  rw [orientation_map, e.map_orientation_eq_det_inv_smul, units_inv_smul, units_smul_eq_neg_iff,
    LinearEquiv.coe_det]
#align basis.orientation_comp_linear_equiv_eq_neg_iff_det_neg Basis.orientation_comp_linearEquiv_eq_neg_iff_det_neg

/-- Negating a single basis vector (represented using `units_smul`) negates the corresponding
orientation. -/
@[simp]
theorem orientation_neg_single [Nontrivial R] (e : Basis ι R M) (i : ι) :
    (e.units_smul (Function.update 1 i (-1))).Orientation = -e.Orientation :=
  by
  rw [orientation_units_smul, Finset.prod_update_of_mem (Finset.mem_univ _)]
  simp
#align basis.orientation_neg_single Basis.orientation_neg_single

/-- Given a basis and an orientation, return a basis giving that orientation: either the original
basis, or one constructed by negating a single (arbitrary) basis vector. -/
def adjustToOrientation [Nontrivial R] [Nonempty ι] (e : Basis ι R M) (x : Orientation R M ι) :
    Basis ι R M :=
  haveI := Classical.decEq (Orientation R M ι)
  if e.orientation = x then e else e.units_smul (Function.update 1 (Classical.arbitrary ι) (-1))
#align basis.adjust_to_orientation Basis.adjustToOrientation

/-- `adjust_to_orientation` gives a basis with the required orientation. -/
@[simp]
theorem orientation_adjustToOrientation [Nontrivial R] [Nonempty ι] (e : Basis ι R M)
    (x : Orientation R M ι) : (e.adjustToOrientation x).Orientation = x :=
  by
  rw [adjust_to_orientation]
  split_ifs with h
  · exact h
  · rw [orientation_neg_single, eq_comm, ← orientation_ne_iff_eq_neg, ne_comm]
    exact h
#align basis.orientation_adjust_to_orientation Basis.orientation_adjustToOrientation

/-- Every basis vector from `adjust_to_orientation` is either that from the original basis or its
negation. -/
theorem adjustToOrientation_apply_eq_or_eq_neg [Nontrivial R] [Nonempty ι] (e : Basis ι R M)
    (x : Orientation R M ι) (i : ι) :
    e.adjustToOrientation x i = e i ∨ e.adjustToOrientation x i = -e i :=
  by
  rw [adjust_to_orientation]
  split_ifs with h
  · simp
  · by_cases hi : i = Classical.arbitrary ι <;> simp [units_smul_apply, hi]
#align basis.adjust_to_orientation_apply_eq_or_eq_neg Basis.adjustToOrientation_apply_eq_or_eq_neg

theorem det_adjustToOrientation [Nontrivial R] [Nonempty ι] (e : Basis ι R M)
    (x : Orientation R M ι) :
    (e.adjustToOrientation x).det = e.det ∨ (e.adjustToOrientation x).det = -e.det :=
  by
  dsimp [Basis.adjustToOrientation]
  split_ifs
  · left
    rfl
  · right
    simp [e.det_units_smul, ← Units.coe_prod, Finset.prod_update_of_mem]
#align basis.det_adjust_to_orientation Basis.det_adjustToOrientation

@[simp]
theorem abs_det_adjustToOrientation [Nontrivial R] [Nonempty ι] (e : Basis ι R M)
    (x : Orientation R M ι) (v : ι → M) : |(e.adjustToOrientation x).det v| = |e.det v| := by
  cases' e.det_adjust_to_orientation x with h h <;> simp [h]
#align basis.abs_det_adjust_to_orientation Basis.abs_det_adjustToOrientation

end Basis

end LinearOrderedCommRing

section LinearOrderedField

variable {R : Type _} [LinearOrderedField R]

variable {M : Type _} [AddCommGroup M] [Module R M]

variable {ι : Type _}

namespace Orientation

variable [Fintype ι] [_i : FiniteDimensional R M]

open FiniteDimensional

include _i

/-- If the index type has cardinality equal to the finite dimension, any two orientations are
equal or negations. -/
theorem eq_or_eq_neg (x₁ x₂ : Orientation R M ι) (h : Fintype.card ι = finrank R M) :
    x₁ = x₂ ∨ x₁ = -x₂ :=
  by
  have e := (fin_basis R M).reindex (Fintype.equivFinOfCardEq h).symm
  letI := Classical.decEq ι
  rcases e.orientation_eq_or_eq_neg x₁ with (h₁ | h₁) <;>
      rcases e.orientation_eq_or_eq_neg x₂ with (h₂ | h₂) <;>
    simp [h₁, h₂]
#align orientation.eq_or_eq_neg Orientation.eq_or_eq_neg

/-- If the index type has cardinality equal to the finite dimension, an orientation equals the
negation of another orientation if and only if they are not equal. -/
theorem ne_iff_eq_neg (x₁ x₂ : Orientation R M ι) (h : Fintype.card ι = finrank R M) :
    x₁ ≠ x₂ ↔ x₁ = -x₂ :=
  ⟨fun hn => (eq_or_eq_neg x₁ x₂ h).resolve_left hn, fun he =>
    he.symm ▸ (Module.Ray.ne_neg_self x₂).symm⟩
#align orientation.ne_iff_eq_neg Orientation.ne_iff_eq_neg

/-- The value of `orientation.map` when the index type has cardinality equal to the finite
dimension, in terms of `f.det`. -/
theorem map_eq_det_inv_smul (x : Orientation R M ι) (f : M ≃ₗ[R] M)
    (h : Fintype.card ι = finrank R M) : Orientation.map ι f x = f.det⁻¹ • x :=
  haveI e := (fin_basis R M).reindex (Fintype.equivFinOfCardEq h).symm
  e.map_orientation_eq_det_inv_smul x f
#align orientation.map_eq_det_inv_smul Orientation.map_eq_det_inv_smul

omit _i

/-- If the index type has cardinality equal to the finite dimension, composing an alternating
map with the same linear equiv on each argument gives the same orientation if and only if the
determinant is positive. -/
theorem map_eq_iff_det_pos (x : Orientation R M ι) (f : M ≃ₗ[R] M)
    (h : Fintype.card ι = finrank R M) : Orientation.map ι f x = x ↔ 0 < (f : M →ₗ[R] M).det :=
  by
  cases isEmpty_or_nonempty ι
  · have H : finrank R M = 0 := by
      refine' h.symm.trans _
      convert Fintype.card_of_isEmpty
      infer_instance
    simp [LinearMap.det_eq_one_of_finrank_eq_zero H]
  have H : 0 < finrank R M := by
    rw [← h]
    exact Fintype.card_pos
  haveI : FiniteDimensional R M := finite_dimensional_of_finrank H
  rw [map_eq_det_inv_smul _ _ h, units_inv_smul, units_smul_eq_self_iff, LinearEquiv.coe_det]
#align orientation.map_eq_iff_det_pos Orientation.map_eq_iff_det_pos

/-- If the index type has cardinality equal to the finite dimension, composing an alternating
map with the same linear equiv on each argument gives the negation of that orientation if and
only if the determinant is negative. -/
theorem map_eq_neg_iff_det_neg (x : Orientation R M ι) (f : M ≃ₗ[R] M)
    (h : Fintype.card ι = finrank R M) : Orientation.map ι f x = -x ↔ (f : M →ₗ[R] M).det < 0 :=
  by
  cases isEmpty_or_nonempty ι
  · have H : finrank R M = 0 := by
      refine' h.symm.trans _
      convert Fintype.card_of_isEmpty
      infer_instance
    simp [LinearMap.det_eq_one_of_finrank_eq_zero H, Module.Ray.ne_neg_self x]
  have H : 0 < finrank R M := by
    rw [← h]
    exact Fintype.card_pos
  haveI : FiniteDimensional R M := finite_dimensional_of_finrank H
  rw [map_eq_det_inv_smul _ _ h, units_inv_smul, units_smul_eq_neg_iff, LinearEquiv.coe_det]
#align orientation.map_eq_neg_iff_det_neg Orientation.map_eq_neg_iff_det_neg

include _i

/-- If the index type has cardinality equal to the finite dimension, a basis with the given
orientation. -/
def someBasis [Nonempty ι] [DecidableEq ι] (x : Orientation R M ι)
    (h : Fintype.card ι = finrank R M) : Basis ι R M :=
  ((finBasis R M).reindex (Fintype.equivFinOfCardEq h).symm).adjustToOrientation x
#align orientation.some_basis Orientation.someBasis

/-- `some_basis` gives a basis with the required orientation. -/
@[simp]
theorem someBasis_orientation [Nonempty ι] [DecidableEq ι] (x : Orientation R M ι)
    (h : Fintype.card ι = finrank R M) : (x.someBasis h).Orientation = x :=
  Basis.orientation_adjustToOrientation _ _
#align orientation.some_basis_orientation Orientation.someBasis_orientation

end Orientation

end LinearOrderedField


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

Natural homomorphism from the natural numbers into a monoid with one.
-/
import data.nat.cast algebra.group algebra.field

/-- Typeclass for monoids with characteristic zero.
  (This is usually stated on fields but it makes sense for any additive monoid with 1.) -/
class char_zero (α : Type*) [add_monoid α] [has_one α] : Prop :=
(cast_inj : ∀ {m n : ℕ}, (m : α) = n ↔ m = n)

theorem char_zero_of_inj_zero {α : Type*} [add_monoid α] [has_one α]
  (add_left_cancel : ∀ a b c : α, a + b = a + c → b = c)
  (H : ∀ n:ℕ, (n:α) = 0 → n = 0) : char_zero α :=
⟨λ m n, ⟨suffices ∀ {m n : ℕ}, (m:α) = n → m ≤ n,
  from λ h, le_antisymm (this h) (this h.symm),
  λ m n h, (le_total m n).elim id $ λ h2, le_of_eq $ begin
    cases nat.le.dest h2 with k e,
    suffices : k = 0, {rw [← e, this, add_zero]},
    apply H, apply add_left_cancel n,
    rw [← nat.cast_add, e, add_zero, h]
  end,
congr_arg _⟩⟩

theorem add_group.char_zero_of_inj_zero {α : Type*} [add_group α] [has_one α]
  (H : ∀ n:ℕ, (n:α) = 0 → n = 0) : char_zero α :=
char_zero_of_inj_zero (@add_left_cancel _ _) H

theorem ordered_cancel_comm_monoid.char_zero_of_inj_zero {α : Type*}
  [ordered_cancel_comm_monoid α] [has_one α]
  (H : ∀ n:ℕ, (n:α) = 0 → n = 0) : char_zero α :=
char_zero_of_inj_zero (@add_left_cancel _ _) H

instance linear_ordered_semiring.to_char_zero {α : Type*}
  [linear_ordered_semiring α] : char_zero α :=
ordered_cancel_comm_monoid.char_zero_of_inj_zero $
λ n h, nat.eq_zero_of_le_zero $
  (@nat.cast_le α _ _ _).1 (le_of_eq h)

namespace nat
variables {α : Type*} [add_monoid α] [has_one α] [char_zero α]

@[simp] theorem cast_inj {m n : ℕ} : (m : α) = n ↔ m = n :=
char_zero.cast_inj _

theorem cast_injective : function.injective (coe : ℕ → α)
| m n := cast_inj.1

@[simp] theorem cast_eq_zero {n : ℕ} : (n : α) = 0 ↔ n = 0 :=
by rw [← cast_zero, cast_inj]

@[simp] theorem cast_ne_zero {n : ℕ} : (n : α) ≠ 0 ↔ n ≠ 0 :=
not_congr cast_eq_zero

end nat

lemma two_ne_zero' {α : Type*} [add_monoid α] [has_one α] [char_zero α] : (2:α) ≠ 0 :=
have ((2:ℕ):α) ≠ 0, from nat.cast_ne_zero.2 dec_trivial,
by rwa [nat.cast_succ, nat.cast_one] at this

section
variables {α : Type*} [domain α] [char_zero α]

lemma add_self_eq_zero {a : α} : a + a = 0 ↔ a = 0 :=
by simp only [(two_mul a).symm, mul_eq_zero, two_ne_zero', false_or]

lemma bit0_eq_zero {a : α} : bit0 a = 0 ↔ a = 0 := add_self_eq_zero
end

section
variables {α : Type*} [division_ring α] [char_zero α]

@[simp] lemma half_add_self (a : α) : (a + a) / 2 = a :=
by rw [← mul_two, mul_div_cancel a two_ne_zero']

@[simp] lemma add_halves' (a : α) : a / 2 + a / 2 = a :=
by rw [← add_div, half_add_self]

lemma sub_half (a : α) : a - a / 2 = a / 2 :=
by rw [sub_eq_iff_eq_add, add_halves']

lemma half_sub (a : α) : a / 2 - a = - (a / 2) :=
by rw [← neg_sub, sub_half]

end


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Reid Barton, Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.limits.over
! leanprover-community/mathlib commit 3e0dd193514c9380edc69f1da92e80c02713c41d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Over
import Mathbin.CategoryTheory.Adjunction.Opposites
import Mathbin.CategoryTheory.Limits.Preserves.Basic
import Mathbin.CategoryTheory.Limits.Shapes.Pullbacks
import Mathbin.CategoryTheory.Limits.Creates
import Mathbin.CategoryTheory.Limits.Comma

/-!
# Limits and colimits in the over and under categories

Show that the forgetful functor `forget X : over X ⥤ C` creates colimits, and hence `over X` has
any colimits that `C` has (as well as the dual that `forget X : under X ⟶ C` creates limits).

Note that the folder `category_theory.limits.shapes.constructions.over` further shows that
`forget X : over X ⥤ C` creates connected limits (so `over X` has connected limits), and that
`over X` has `J`-indexed products if `C` has `J`-indexed wide pullbacks.

TODO: If `C` has binary products, then `forget X : over X ⥤ C` has a right adjoint.
-/

noncomputable section

universe v u

-- morphism levels before object levels. See note [category_theory universes].
open CategoryTheory CategoryTheory.Limits

variable {J : Type v} [SmallCategory J]

variable {C : Type u} [Category.{v} C]

variable {X : C}

namespace CategoryTheory.Over

instance hasColimit_of_hasColimit_comp_forget (F : J ⥤ Over X) [i : HasColimit (F ⋙ forget X)] :
    HasColimit F :=
  @CostructuredArrow.hasColimit _ _ _ _ i _
#align category_theory.over.has_colimit_of_has_colimit_comp_forget CategoryTheory.Over.hasColimit_of_hasColimit_comp_forget

instance [HasColimitsOfShape J C] : HasColimitsOfShape J (Over X) where

instance [HasColimits C] : HasColimits (Over X) :=
  ⟨inferInstance⟩

instance createsColimits : CreatesColimits (forget X) :=
  CostructuredArrow.createsColimits
#align category_theory.over.creates_colimits CategoryTheory.Over.createsColimits

-- We can automatically infer that the forgetful functor preserves and reflects colimits.
example [HasColimits C] : PreservesColimits (forget X) :=
  inferInstance

example : ReflectsColimits (forget X) :=
  inferInstance

theorem epi_left_of_epi [HasPushouts C] {f g : Over X} (h : f ⟶ g) [Epi h] : Epi h.left :=
  CostructuredArrow.epi_left_of_epi _
#align category_theory.over.epi_left_of_epi CategoryTheory.Over.epi_left_of_epi

theorem epi_iff_epi_left [HasPushouts C] {f g : Over X} (h : f ⟶ g) : Epi h ↔ Epi h.left :=
  CostructuredArrow.epi_iff_epi_left _
#align category_theory.over.epi_iff_epi_left CategoryTheory.Over.epi_iff_epi_left

section

variable [HasPullbacks C]

open Tactic

/-- When `C` has pullbacks, a morphism `f : X ⟶ Y` induces a functor `over Y ⥤ over X`,
by pulling back a morphism along `f`. -/
@[simps]
def pullback {X Y : C} (f : X ⟶ Y) : Over Y ⥤ Over X
    where
  obj g := Over.mk (pullback.snd : pullback g.Hom f ⟶ X)
  map g h k :=
    Over.homMk (pullback.lift (pullback.fst ≫ k.left) pullback.snd (by simp [pullback.condition]))
      (by tidy)
#align category_theory.over.pullback CategoryTheory.Over.pullback

/-- `over.map f` is left adjoint to `over.pullback f`. -/
def mapPullbackAdj {A B : C} (f : A ⟶ B) : Over.map f ⊣ pullback f :=
  Adjunction.mkOfHomEquiv
    {
      homEquiv := fun g h =>
        { toFun := fun X =>
            Over.homMk (pullback.lift X.left g.Hom (Over.w X)) (pullback.lift_snd _ _ _)
          invFun := fun Y => by
            refine' over.hom_mk _ _
            refine' Y.left ≫ pullback.fst
            dsimp
            rw [← over.w Y, category.assoc, pullback.condition, category.assoc]; rfl
          left_inv := fun X => by
            ext
            dsimp
            simp
          right_inv := fun Y => by
            ext; dsimp
            simp only [pullback.lift_fst]
            dsimp
            rw [pullback.lift_snd, ← over.w Y]
            rfl } }
#align category_theory.over.map_pullback_adj CategoryTheory.Over.mapPullbackAdj

/-- pullback (𝟙 A) : over A ⥤ over A is the identity functor. -/
def pullbackId {A : C} : pullback (𝟙 A) ≅ 𝟭 _ :=
  Adjunction.rightAdjointUniq (mapPullbackAdj _) (Adjunction.id.ofNatIsoLeft Over.mapId.symm)
#align category_theory.over.pullback_id CategoryTheory.Over.pullbackId

/-- pullback commutes with composition (up to natural isomorphism). -/
def pullbackComp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : pullback (f ≫ g) ≅ pullback g ⋙ pullback f :=
  Adjunction.rightAdjointUniq (mapPullbackAdj _)
    (((mapPullbackAdj _).comp (mapPullbackAdj _)).ofNatIsoLeft (Over.mapComp _ _).symm)
#align category_theory.over.pullback_comp CategoryTheory.Over.pullbackComp

instance pullbackIsRightAdjoint {A B : C} (f : A ⟶ B) : IsRightAdjoint (pullback f) :=
  ⟨_, mapPullbackAdj f⟩
#align category_theory.over.pullback_is_right_adjoint CategoryTheory.Over.pullbackIsRightAdjoint

end

end CategoryTheory.Over

namespace CategoryTheory.Under

instance hasLimit_of_hasLimit_comp_forget (F : J ⥤ Under X) [i : HasLimit (F ⋙ forget X)] :
    HasLimit F :=
  @StructuredArrow.hasLimit _ _ _ _ i _
#align category_theory.under.has_limit_of_has_limit_comp_forget CategoryTheory.Under.hasLimit_of_hasLimit_comp_forget

instance [HasLimitsOfShape J C] : HasLimitsOfShape J (Under X) where

instance [HasLimits C] : HasLimits (Under X) :=
  ⟨inferInstance⟩

theorem mono_right_of_mono [HasPullbacks C] {f g : Under X} (h : f ⟶ g) [Mono h] : Mono h.right :=
  StructuredArrow.mono_right_of_mono _
#align category_theory.under.mono_right_of_mono CategoryTheory.Under.mono_right_of_mono

theorem mono_iff_mono_right [HasPullbacks C] {f g : Under X} (h : f ⟶ g) : Mono h ↔ Mono h.right :=
  StructuredArrow.mono_iff_mono_right _
#align category_theory.under.mono_iff_mono_right CategoryTheory.Under.mono_iff_mono_right

instance createsLimits : CreatesLimits (forget X) :=
  StructuredArrow.createsLimits
#align category_theory.under.creates_limits CategoryTheory.Under.createsLimits

-- We can automatically infer that the forgetful functor preserves and reflects limits.
example [HasLimits C] : PreservesLimits (forget X) :=
  inferInstance

example : ReflectsLimits (forget X) :=
  inferInstance

section

variable [HasPushouts C]

/-- When `C` has pushouts, a morphism `f : X ⟶ Y` induces a functor `under X ⥤ under Y`,
by pushing a morphism forward along `f`. -/
@[simps]
def pushout {X Y : C} (f : X ⟶ Y) : Under X ⥤ Under Y
    where
  obj g := Under.mk (pushout.inr : Y ⟶ pushout g.Hom f)
  map g h k :=
    Under.homMk (pushout.desc (k.right ≫ pushout.inl) pushout.inr (by simp [← pushout.condition]))
      (by tidy)
#align category_theory.under.pushout CategoryTheory.Under.pushout

end

end CategoryTheory.Under


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

/- Tactic : left and right
## Summary
`left` and `right` work on the goal, and they change
`⊢ P ∨ Q` to `⊢ P` and `⊢ Q` respectively.
## Details
The tactics `left` and `right` work on a goal which is a type with
two constructors, the classic example being `P ∨ Q`.
To prove `P ∨ Q` it suffices to either prove `P` or prove `Q`,
and once you know which one you are going for you can change
the goal with `left` or `right` to the appropriate choice.
-/

/-
We have seen how to prove a goal of the form `P ∧ Q`, now you will learn how to prove
a goal of the form `P ∨ Q`, which means that either `P` holds or `Q` holds.
In this case, you will have to decide whether you can prove `P` or `Q`. The `left` and `right`
tactics will allow you to change the goal to ⊢ P or ⊢ Q accordingly.
-/

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

/- Lemma : no-side-bar
Example of the usage of left and right
-/
lemma left_right_example (A B C : Ω) (h : C ∈ line_through A B) :
A = C ∨ collinear ({A, B, C} : set Ω) :=
begin
  right,
  use line_through A B,
  intros P hP,
  cases hP,
  {
    rw hP,
    exact line_through_left A B
  },
  cases hP,
  {
    rw hP,
    exact line_through_right A B,
  },
  {
    cases hP,
    exact h,
  }

end


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

! This file was ported from Lean 3 source module algebra.big_operators.nat_antidiagonal
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finset.NatAntidiagonal
import Mathbin.Algebra.BigOperators.Basic

/-!
# Big operators for `nat_antidiagonal`

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

This file contains theorems relevant to big operators over `finset.nat.antidiagonal`.
-/

open BigOperators

variable {M N : Type _} [CommMonoid M] [AddCommMonoid N]

namespace Finset

namespace Nat

/- warning: finset.nat.prod_antidiagonal_succ -> Finset.Nat.prod_antidiagonal_succ is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : CommMonoid.{u1} M] {n : Nat} {f : (Prod.{0, 0} Nat Nat) -> M}, Eq.{succ u1} M (Finset.prod.{u1, 0} M (Prod.{0, 0} Nat Nat) _inst_1 (Finset.Nat.antidiagonal (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (fun (p : Prod.{0, 0} Nat Nat) => f p)) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (MulOneClass.toHasMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_1)))) (f (Prod.mk.{0, 0} Nat Nat (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (Finset.prod.{u1, 0} M (Prod.{0, 0} Nat Nat) _inst_1 (Finset.Nat.antidiagonal n) (fun (p : Prod.{0, 0} Nat Nat) => f (Prod.mk.{0, 0} Nat Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Prod.fst.{0, 0} Nat Nat p) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (Prod.snd.{0, 0} Nat Nat p)))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : CommMonoid.{u1} M] {n : Nat} {f : (Prod.{0, 0} Nat Nat) -> M}, Eq.{succ u1} M (Finset.prod.{u1, 0} M (Prod.{0, 0} Nat Nat) _inst_1 (Finset.Nat.antidiagonal (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (fun (p : Prod.{0, 0} Nat Nat) => f p)) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (MulOneClass.toMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_1)))) (f (Prod.mk.{0, 0} Nat Nat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (Finset.prod.{u1, 0} M (Prod.{0, 0} Nat Nat) _inst_1 (Finset.Nat.antidiagonal n) (fun (p : Prod.{0, 0} Nat Nat) => f (Prod.mk.{0, 0} Nat Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Prod.fst.{0, 0} Nat Nat p) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (Prod.snd.{0, 0} Nat Nat p)))))
Case conversion may be inaccurate. Consider using '#align finset.nat.prod_antidiagonal_succ Finset.Nat.prod_antidiagonal_succₓ'. -/
theorem prod_antidiagonal_succ {n : ℕ} {f : ℕ × ℕ → M} :
    (∏ p in antidiagonal (n + 1), f p) = f (0, n + 1) * ∏ p in antidiagonal n, f (p.1 + 1, p.2) :=
  by rw [antidiagonal_succ, prod_cons, Prod_map]; rfl
#align finset.nat.prod_antidiagonal_succ Finset.Nat.prod_antidiagonal_succ

/- warning: finset.nat.sum_antidiagonal_succ -> Finset.Nat.sum_antidiagonal_succ is a dubious translation:
lean 3 declaration is
  forall {N : Type.{u1}} [_inst_2 : AddCommMonoid.{u1} N] {n : Nat} {f : (Prod.{0, 0} Nat Nat) -> N}, Eq.{succ u1} N (Finset.sum.{u1, 0} N (Prod.{0, 0} Nat Nat) _inst_2 (Finset.Nat.antidiagonal (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (fun (p : Prod.{0, 0} Nat Nat) => f p)) (HAdd.hAdd.{u1, u1, u1} N N N (instHAdd.{u1} N (AddZeroClass.toHasAdd.{u1} N (AddMonoid.toAddZeroClass.{u1} N (AddCommMonoid.toAddMonoid.{u1} N _inst_2)))) (f (Prod.mk.{0, 0} Nat Nat (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (Finset.sum.{u1, 0} N (Prod.{0, 0} Nat Nat) _inst_2 (Finset.Nat.antidiagonal n) (fun (p : Prod.{0, 0} Nat Nat) => f (Prod.mk.{0, 0} Nat Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Prod.fst.{0, 0} Nat Nat p) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (Prod.snd.{0, 0} Nat Nat p)))))
but is expected to have type
  forall {N : Type.{u1}} [_inst_2 : AddCommMonoid.{u1} N] {n : Nat} {f : (Prod.{0, 0} Nat Nat) -> N}, Eq.{succ u1} N (Finset.sum.{u1, 0} N (Prod.{0, 0} Nat Nat) _inst_2 (Finset.Nat.antidiagonal (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (fun (p : Prod.{0, 0} Nat Nat) => f p)) (HAdd.hAdd.{u1, u1, u1} N N N (instHAdd.{u1} N (AddZeroClass.toAdd.{u1} N (AddMonoid.toAddZeroClass.{u1} N (AddCommMonoid.toAddMonoid.{u1} N _inst_2)))) (f (Prod.mk.{0, 0} Nat Nat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (Finset.sum.{u1, 0} N (Prod.{0, 0} Nat Nat) _inst_2 (Finset.Nat.antidiagonal n) (fun (p : Prod.{0, 0} Nat Nat) => f (Prod.mk.{0, 0} Nat Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Prod.fst.{0, 0} Nat Nat p) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (Prod.snd.{0, 0} Nat Nat p)))))
Case conversion may be inaccurate. Consider using '#align finset.nat.sum_antidiagonal_succ Finset.Nat.sum_antidiagonal_succₓ'. -/
theorem sum_antidiagonal_succ {n : ℕ} {f : ℕ × ℕ → N} :
    (∑ p in antidiagonal (n + 1), f p) = f (0, n + 1) + ∑ p in antidiagonal n, f (p.1 + 1, p.2) :=
  @prod_antidiagonal_succ (Multiplicative N) _ _ _
#align finset.nat.sum_antidiagonal_succ Finset.Nat.sum_antidiagonal_succ

#print Finset.Nat.prod_antidiagonal_swap /-
@[to_additive]
theorem prod_antidiagonal_swap {n : ℕ} {f : ℕ × ℕ → M} :
    (∏ p in antidiagonal n, f p.symm) = ∏ p in antidiagonal n, f p :=
  by
  nth_rw 2 [← map_swap_antidiagonal]
  rw [Prod_map]
  rfl
#align finset.nat.prod_antidiagonal_swap Finset.Nat.prod_antidiagonal_swap
#align finset.nat.sum_antidiagonal_swap Finset.Nat.sum_antidiagonal_swap
-/

/- warning: finset.nat.prod_antidiagonal_succ' -> Finset.Nat.prod_antidiagonal_succ' is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : CommMonoid.{u1} M] {n : Nat} {f : (Prod.{0, 0} Nat Nat) -> M}, Eq.{succ u1} M (Finset.prod.{u1, 0} M (Prod.{0, 0} Nat Nat) _inst_1 (Finset.Nat.antidiagonal (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (fun (p : Prod.{0, 0} Nat Nat) => f p)) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (MulOneClass.toHasMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_1)))) (f (Prod.mk.{0, 0} Nat Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))) (Finset.prod.{u1, 0} M (Prod.{0, 0} Nat Nat) _inst_1 (Finset.Nat.antidiagonal n) (fun (p : Prod.{0, 0} Nat Nat) => f (Prod.mk.{0, 0} Nat Nat (Prod.fst.{0, 0} Nat Nat p) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Prod.snd.{0, 0} Nat Nat p) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : CommMonoid.{u1} M] {n : Nat} {f : (Prod.{0, 0} Nat Nat) -> M}, Eq.{succ u1} M (Finset.prod.{u1, 0} M (Prod.{0, 0} Nat Nat) _inst_1 (Finset.Nat.antidiagonal (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (fun (p : Prod.{0, 0} Nat Nat) => f p)) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (MulOneClass.toMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_1)))) (f (Prod.mk.{0, 0} Nat Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))) (Finset.prod.{u1, 0} M (Prod.{0, 0} Nat Nat) _inst_1 (Finset.Nat.antidiagonal n) (fun (p : Prod.{0, 0} Nat Nat) => f (Prod.mk.{0, 0} Nat Nat (Prod.fst.{0, 0} Nat Nat p) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Prod.snd.{0, 0} Nat Nat p) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))))
Case conversion may be inaccurate. Consider using '#align finset.nat.prod_antidiagonal_succ' Finset.Nat.prod_antidiagonal_succ'ₓ'. -/
theorem prod_antidiagonal_succ' {n : ℕ} {f : ℕ × ℕ → M} :
    (∏ p in antidiagonal (n + 1), f p) = f (n + 1, 0) * ∏ p in antidiagonal n, f (p.1, p.2 + 1) :=
  by
  rw [← prod_antidiagonal_swap, prod_antidiagonal_succ, ← prod_antidiagonal_swap]
  rfl
#align finset.nat.prod_antidiagonal_succ' Finset.Nat.prod_antidiagonal_succ'

/- warning: finset.nat.sum_antidiagonal_succ' -> Finset.Nat.sum_antidiagonal_succ' is a dubious translation:
lean 3 declaration is
  forall {N : Type.{u1}} [_inst_2 : AddCommMonoid.{u1} N] {n : Nat} {f : (Prod.{0, 0} Nat Nat) -> N}, Eq.{succ u1} N (Finset.sum.{u1, 0} N (Prod.{0, 0} Nat Nat) _inst_2 (Finset.Nat.antidiagonal (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (fun (p : Prod.{0, 0} Nat Nat) => f p)) (HAdd.hAdd.{u1, u1, u1} N N N (instHAdd.{u1} N (AddZeroClass.toHasAdd.{u1} N (AddMonoid.toAddZeroClass.{u1} N (AddCommMonoid.toAddMonoid.{u1} N _inst_2)))) (f (Prod.mk.{0, 0} Nat Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))) (Finset.sum.{u1, 0} N (Prod.{0, 0} Nat Nat) _inst_2 (Finset.Nat.antidiagonal n) (fun (p : Prod.{0, 0} Nat Nat) => f (Prod.mk.{0, 0} Nat Nat (Prod.fst.{0, 0} Nat Nat p) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Prod.snd.{0, 0} Nat Nat p) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))))))
but is expected to have type
  forall {N : Type.{u1}} [_inst_2 : AddCommMonoid.{u1} N] {n : Nat} {f : (Prod.{0, 0} Nat Nat) -> N}, Eq.{succ u1} N (Finset.sum.{u1, 0} N (Prod.{0, 0} Nat Nat) _inst_2 (Finset.Nat.antidiagonal (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (fun (p : Prod.{0, 0} Nat Nat) => f p)) (HAdd.hAdd.{u1, u1, u1} N N N (instHAdd.{u1} N (AddZeroClass.toAdd.{u1} N (AddMonoid.toAddZeroClass.{u1} N (AddCommMonoid.toAddMonoid.{u1} N _inst_2)))) (f (Prod.mk.{0, 0} Nat Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))) (Finset.sum.{u1, 0} N (Prod.{0, 0} Nat Nat) _inst_2 (Finset.Nat.antidiagonal n) (fun (p : Prod.{0, 0} Nat Nat) => f (Prod.mk.{0, 0} Nat Nat (Prod.fst.{0, 0} Nat Nat p) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Prod.snd.{0, 0} Nat Nat p) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))))
Case conversion may be inaccurate. Consider using '#align finset.nat.sum_antidiagonal_succ' Finset.Nat.sum_antidiagonal_succ'ₓ'. -/
theorem sum_antidiagonal_succ' {n : ℕ} {f : ℕ × ℕ → N} :
    (∑ p in antidiagonal (n + 1), f p) = f (n + 1, 0) + ∑ p in antidiagonal n, f (p.1, p.2 + 1) :=
  @prod_antidiagonal_succ' (Multiplicative N) _ _ _
#align finset.nat.sum_antidiagonal_succ' Finset.Nat.sum_antidiagonal_succ'

#print Finset.Nat.prod_antidiagonal_subst /-
@[to_additive]
theorem prod_antidiagonal_subst {n : ℕ} {f : ℕ × ℕ → ℕ → M} :
    (∏ p in antidiagonal n, f p n) = ∏ p in antidiagonal n, f p (p.1 + p.2) :=
  prod_congr rfl fun p hp => by rw [nat.mem_antidiagonal.1 hp]
#align finset.nat.prod_antidiagonal_subst Finset.Nat.prod_antidiagonal_subst
#align finset.nat.sum_antidiagonal_subst Finset.Nat.sum_antidiagonal_subst
-/

#print Finset.Nat.prod_antidiagonal_eq_prod_range_succ_mk /-
@[to_additive]
theorem prod_antidiagonal_eq_prod_range_succ_mk {M : Type _} [CommMonoid M] (f : ℕ × ℕ → M)
    (n : ℕ) : (∏ ij in Finset.Nat.antidiagonal n, f ij) = ∏ k in range n.succ, f (k, n - k) :=
  by
  convert Prod_map _ ⟨fun i => (i, n - i), fun x y h => (Prod.mk.inj h).1⟩ _
  rfl
#align finset.nat.prod_antidiagonal_eq_prod_range_succ_mk Finset.Nat.prod_antidiagonal_eq_prod_range_succ_mk
#align finset.nat.sum_antidiagonal_eq_sum_range_succ_mk Finset.Nat.sum_antidiagonal_eq_sum_range_succ_mk
-/

#print Finset.Nat.prod_antidiagonal_eq_prod_range_succ /-
/-- This lemma matches more generally than `finset.nat.prod_antidiagonal_eq_prod_range_succ_mk` when
using `rw ←`. -/
@[to_additive
      "This lemma matches more generally than\n`finset.nat.sum_antidiagonal_eq_sum_range_succ_mk` when using `rw ←`."]
theorem prod_antidiagonal_eq_prod_range_succ {M : Type _} [CommMonoid M] (f : ℕ → ℕ → M) (n : ℕ) :
    (∏ ij in Finset.Nat.antidiagonal n, f ij.1 ij.2) = ∏ k in range n.succ, f k (n - k) :=
  prod_antidiagonal_eq_prod_range_succ_mk _ _
#align finset.nat.prod_antidiagonal_eq_prod_range_succ Finset.Nat.prod_antidiagonal_eq_prod_range_succ
#align finset.nat.sum_antidiagonal_eq_sum_range_succ Finset.Nat.sum_antidiagonal_eq_sum_range_succ
-/

end Nat

end Finset


axiom P : Prop → Prop

@[congr]
axiom P_congr (a b : Prop) (h : a ↔ b) : P a ↔ P b

theorem ex1 {p q : Prop} (h : p ↔ q) (h' : P q) : P p := by
  simp [h]
  assumption

#print ex1

theorem ex2 {p q : Prop} (h : p = q) (h' : P q) : P p := by
  simp [h]
  assumption

#print ex2


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Adds the ordering, and instantiates the rationals as an ordered field.
-/
import data.int algebra.ordered_field algebra.group_power data.rat.basic
open quot eq.ops

/- the ordering on representations -/

namespace prerat
section int_notation
open int

variables {a b : prerat}

definition pos (a : prerat) : Prop := num a > 0

definition nonneg (a : prerat) : Prop := num a ≥ 0

theorem pos_of_int (a : ℤ) : pos (of_int a) ↔ (a > 0) :=
!iff.rfl

theorem nonneg_of_int (a : ℤ) : nonneg (of_int a) ↔ (a ≥ 0) :=
!iff.rfl

theorem pos_eq_pos_of_equiv {a b : prerat} (H1 : a ≡ b) : pos a = pos b :=
propext (iff.intro (num_pos_of_equiv H1) (num_pos_of_equiv H1⁻¹))

theorem nonneg_eq_nonneg_of_equiv (H : a ≡ b) : nonneg a = nonneg b :=
have H1 : (0 = num a) = (0 = num b),
  from propext (iff.intro
    (assume H2, eq.symm (num_eq_zero_of_equiv H H2⁻¹))
    (assume H2, eq.symm (num_eq_zero_of_equiv H⁻¹ H2⁻¹))),
calc
  nonneg a = (pos a ∨ 0 = num a) : propext !le_iff_lt_or_eq
       ... = (pos b ∨ 0 = num a) : pos_eq_pos_of_equiv H
       ... = (pos b ∨ 0 = num b) : H1
       ... = nonneg b            : propext !le_iff_lt_or_eq

theorem nonneg_zero : nonneg zero := le.refl 0

theorem nonneg_add (H1 : nonneg a) (H2 : nonneg b) : nonneg (add a b) :=
show num a * denom b + num b * denom a ≥ 0,
  from add_nonneg
    (mul_nonneg H1 (le_of_lt (denom_pos b)))
    (mul_nonneg H2 (le_of_lt (denom_pos a)))

theorem nonneg_antisymm (H1 : nonneg a) (H2 : nonneg (neg a)) : a ≡ zero :=
have H3 : num a = 0, from le.antisymm (nonpos_of_neg_nonneg H2) H1,
equiv_zero_of_num_eq_zero H3

theorem nonneg_total (a : prerat) : nonneg a ∨ nonneg (neg a) :=
or.elim (le.total 0 (num a))
  (suppose 0 ≤ num a, or.inl this)
  (suppose 0 ≥ num a, or.inr (neg_nonneg_of_nonpos this))

theorem nonneg_of_pos (H : pos a) : nonneg a := le_of_lt H

theorem ne_zero_of_pos (H : pos a) : ¬ a ≡ zero :=
assume H', ne_of_gt H (num_eq_zero_of_equiv_zero H')

theorem pos_of_nonneg_of_ne_zero (H1 : nonneg a) (H2 : ¬ a ≡ zero) : pos a :=
have num a ≠ 0, from suppose num a = 0, H2 (equiv_zero_of_num_eq_zero this),
lt_of_le_of_ne H1 (ne.symm this)

theorem nonneg_mul (H1 : nonneg a) (H2 : nonneg b) : nonneg (mul a b) :=
mul_nonneg H1 H2

theorem pos_mul (H1 : pos a) (H2 : pos b) : pos (mul a b) :=
mul_pos H1 H2

end int_notation
end prerat

local attribute prerat.setoid [instance]

/- The ordering on the rationals.

   The definitions of pos and nonneg are kept private, because they are only meant for internal
   use. Users should use a > 0 and a ≥ 0 instead of pos and nonneg.
-/

namespace rat
open nat int
variables {a b c : ℚ}

/- transfer properties of pos and nonneg -/

private definition pos (a : ℚ) : Prop :=
quot.lift prerat.pos @prerat.pos_eq_pos_of_equiv a

private definition nonneg (a : ℚ) : Prop :=
quot.lift prerat.nonneg @prerat.nonneg_eq_nonneg_of_equiv a

private theorem pos_of_int (a : ℤ) : (a > 0) ↔ pos (of_int a) :=
prerat.pos_of_int a

private theorem nonneg_of_int (a : ℤ) : (a ≥ 0) ↔ nonneg (of_int a) :=
prerat.nonneg_of_int a

private theorem nonneg_zero : nonneg 0 := prerat.nonneg_zero

private theorem nonneg_add : nonneg a → nonneg b → nonneg (a + b) :=
quot.induction_on₂ a b @prerat.nonneg_add

private theorem nonneg_antisymm : nonneg a → nonneg (-a) → a = 0 :=
quot.induction_on a
  (take u, assume H1 H2,
    quot.sound (prerat.nonneg_antisymm H1 H2))

private theorem nonneg_total (a : ℚ) : nonneg a ∨ nonneg (-a) :=
quot.induction_on a @prerat.nonneg_total

private theorem nonneg_of_pos : pos a → nonneg a :=
quot.induction_on a @prerat.nonneg_of_pos

private theorem ne_zero_of_pos : pos a → a ≠ 0 :=
quot.induction_on a (take u, assume H1 H2, prerat.ne_zero_of_pos H1 (quot.exact H2))

private theorem pos_of_nonneg_of_ne_zero : nonneg a → ¬ a = 0 → pos a :=
quot.induction_on a
  (take u,
   assume h : nonneg ⟦u⟧,
   suppose ⟦u⟧ ≠ (rat.of_num 0),
   have ¬ (prerat.equiv u prerat.zero), from assume H, this (quot.sound H),
   prerat.pos_of_nonneg_of_ne_zero h this)

private theorem nonneg_mul : nonneg a → nonneg b → nonneg (a * b) :=
quot.induction_on₂ a b @prerat.nonneg_mul

private theorem pos_mul : pos a → pos b → pos (a * b) :=
quot.induction_on₂ a b @prerat.pos_mul

private definition decidable_pos (a : ℚ) : decidable (pos a) :=
quot.rec_on_subsingleton a (take u, int.decidable_lt 0 (prerat.num u))

/- define order in terms of pos and nonneg -/

protected definition lt (a b : ℚ) : Prop := pos (b - a)
protected definition le (a b : ℚ) : Prop := nonneg (b - a)

definition rat_has_lt [instance] [priority rat.prio] : has_lt rat :=
has_lt.mk rat.lt

definition rat_has_le [instance] [priority rat.prio] : has_le rat :=
has_le.mk rat.le

protected lemma lt_def (a b : ℚ) : (a < b) = pos (b - a) :=
rfl

protected lemma le_def (a b : ℚ) : (a ≤ b) = nonneg (b - a) :=
rfl

theorem of_int_lt_of_int_iff (a b : ℤ) : of_int a < of_int b ↔ a < b :=
iff.symm (calc
  a < b ↔ b - a > 0                 : iff.symm !sub_pos_iff_lt
    ... ↔ pos (of_int (b - a))      : iff.symm !pos_of_int
    ... ↔ pos (of_int b - of_int a) : !of_int_sub ▸ iff.rfl
    ... ↔ of_int a < of_int b       : iff.rfl)

theorem of_int_lt_of_int_of_lt {a b : ℤ} (H : a < b) : of_int a < of_int b :=
iff.mpr !of_int_lt_of_int_iff H

theorem lt_of_of_int_lt_of_int {a b : ℤ} (H : of_int a < of_int b) : a < b :=
iff.mp !of_int_lt_of_int_iff H

theorem of_int_le_of_int_iff (a b : ℤ) : of_int a ≤ of_int b ↔ (a ≤ b) :=
iff.symm (calc
  a ≤ b ↔ b - a ≥ 0                    : iff.symm !sub_nonneg_iff_le
    ... ↔ nonneg (of_int (b - a))      : iff.symm !nonneg_of_int
    ... ↔ nonneg (of_int b - of_int a) : !of_int_sub ▸ iff.rfl
    ... ↔ of_int a ≤ of_int b          : iff.rfl)

theorem of_int_le_of_int_of_le {a b : ℤ} (H : a ≤ b) : of_int a ≤ of_int b :=
iff.mpr !of_int_le_of_int_iff H

theorem le_of_of_int_le_of_int {a b : ℤ} (H : of_int a ≤ of_int b) : a ≤ b :=
iff.mp !of_int_le_of_int_iff H

theorem of_nat_lt_of_nat_iff (a b : ℕ) : of_nat a < of_nat b ↔ a < b :=
by rewrite [*of_nat_eq, of_int_lt_of_int_iff, int.of_nat_lt_of_nat_iff]

theorem of_nat_lt_of_nat_of_lt {a b : ℕ} (H : a < b) : of_nat a < of_nat b :=
iff.mpr !of_nat_lt_of_nat_iff H

theorem lt_of_of_nat_lt_of_nat {a b : ℕ} (H : of_nat a < of_nat b) : a < b :=
iff.mp !of_nat_lt_of_nat_iff H

theorem of_nat_le_of_nat_iff (a b : ℕ) : of_nat a ≤ of_nat b ↔ a ≤ b :=
by rewrite [*of_nat_eq, of_int_le_of_int_iff, int.of_nat_le_of_nat_iff]

theorem of_nat_le_of_nat_of_le {a b : ℕ} (H : a ≤ b) : of_nat a ≤ of_nat b :=
iff.mpr !of_nat_le_of_nat_iff H

theorem le_of_of_nat_le_of_nat {a b : ℕ} (H : of_nat a ≤ of_nat b) : a ≤ b :=
iff.mp !of_nat_le_of_nat_iff H

theorem of_nat_nonneg (a : ℕ) : (of_nat a ≥ 0) :=
of_nat_le_of_nat_of_le !nat.zero_le

protected theorem le_refl (a : ℚ) : a ≤ a :=
by rewrite [rat.le_def, sub_self]; apply nonneg_zero

protected theorem le_trans (H1 : a ≤ b) (H2 : b ≤ c) : a ≤ c :=
have H3 : nonneg (c - b + (b - a)), from nonneg_add H2 H1,
begin
  revert H3,
  rewrite [rat.sub.def, add.assoc, sub_eq_add_neg, neg_add_cancel_left],
  intro H3, apply H3
end

protected theorem le_antisymm (H1 : a ≤ b) (H2 : b ≤ a) : a = b :=
have H3 : nonneg (-(a - b)), from !neg_sub⁻¹ ▸ H1,
have H4 : a - b = 0, from nonneg_antisymm H2 H3,
eq_of_sub_eq_zero H4

protected theorem le_total (a b : ℚ) : a ≤ b ∨ b ≤ a :=
or.elim (nonneg_total (b - a))
  (assume H, or.inl H)
  (assume H, or.inr begin rewrite neg_sub at H, exact H end)

protected theorem le_by_cases {P : Prop} (a b : ℚ) (H : a ≤ b → P) (H2 : b ≤ a → P) : P :=
  or.elim (!rat.le_total) H H2

protected theorem lt_iff_le_and_ne (a b : ℚ) : a < b ↔ a ≤ b ∧ a ≠ b :=
iff.intro
  (assume H : a < b,
    have b - a ≠ 0, from ne_zero_of_pos H,
    have a ≠ b, from ne.symm (assume H', this (H' ▸ !sub_self)),
    and.intro (nonneg_of_pos H) this)
  (assume H : a ≤ b ∧ a ≠ b,
    obtain aleb aneb, from H,
    have b - a ≠ 0, from (assume H', aneb (eq_of_sub_eq_zero H')⁻¹),
    pos_of_nonneg_of_ne_zero aleb this)

protected theorem le_iff_lt_or_eq (a b : ℚ) : a ≤ b ↔ a < b ∨ a = b :=
iff.intro
  (assume h : a ≤ b,
    decidable.by_cases
      (suppose a = b, or.inr this)
      (suppose a ≠ b, or.inl (iff.mpr !rat.lt_iff_le_and_ne (and.intro h this))))
  (suppose a < b ∨ a = b,
    or.elim this
      (suppose a < b, and.left (iff.mp !rat.lt_iff_le_and_ne this))
      (suppose a = b, this ▸ !rat.le_refl))

private theorem to_nonneg : a ≥ 0 → nonneg a :=
by intros; rewrite -(sub_zero a); eassumption

protected theorem add_le_add_left (H : a ≤ b) (c : ℚ) : c + a ≤ c + b :=
have c + b - (c + a) = b - a,
  by rewrite [sub.def, neg_add, -add.assoc, add.comm c, add_neg_cancel_right],
show nonneg (c + b - (c + a)), from this⁻¹ ▸ H

protected theorem mul_nonneg (H1 : a ≥ (0 : ℚ)) (H2 : b ≥ (0 : ℚ)) : a * b ≥ (0 : ℚ) :=
have nonneg (a * b), from nonneg_mul (to_nonneg H1) (to_nonneg H2),
begin rewrite -(sub_zero (a*b)) at this, exact this end

private theorem to_pos : a > 0 → pos a :=
by intros; rewrite -(sub_zero a); eassumption

protected theorem mul_pos (H1 : a > (0 : ℚ)) (H2 : b > (0 : ℚ)) : a * b > (0 : ℚ) :=
have pos (a * b), from pos_mul (to_pos H1) (to_pos H2),
begin rewrite -(sub_zero (a*b)) at this, exact this end

definition decidable_lt [instance] : decidable_rel rat.lt :=
take a b, decidable_pos (b - a)

protected theorem le_of_lt  (H : a < b) : a ≤ b := iff.mpr !rat.le_iff_lt_or_eq (or.inl H)

protected theorem lt_irrefl (a : ℚ) : ¬ a < a :=
take Ha,
  let Hand := (iff.mp !rat.lt_iff_le_and_ne) Ha in
  (and.right Hand) rfl

protected theorem not_le_of_gt (H : a < b) : ¬ b ≤ a :=
assume Hba,
  let Heq := rat.le_antisymm (rat.le_of_lt H) Hba in
  !rat.lt_irrefl (Heq ▸ H)

protected theorem lt_of_lt_of_le  (Hab : a < b) (Hbc : b ≤ c) : a < c :=
let Hab' := rat.le_of_lt Hab in
let Hac := rat.le_trans Hab' Hbc in
  (iff.mpr !rat.lt_iff_le_and_ne) (and.intro Hac
    (assume Heq, rat.not_le_of_gt (Heq ▸ Hab) Hbc))

protected theorem lt_of_le_of_lt  (Hab : a ≤ b) (Hbc : b < c) : a < c :=
let Hbc' := rat.le_of_lt Hbc in
let Hac := rat.le_trans Hab Hbc' in
  (iff.mpr !rat.lt_iff_le_and_ne) (and.intro Hac
    (assume Heq, rat.not_le_of_gt (Heq⁻¹ ▸ Hbc) Hab))

protected theorem zero_lt_one : (0 : ℚ) < 1 := trivial

protected theorem add_lt_add_left (H : a < b) (c : ℚ) : c + a < c + b :=
let H' := rat.le_of_lt H in
(iff.mpr (rat.lt_iff_le_and_ne _ _)) (and.intro (rat.add_le_add_left H' _)
                                  (take Heq, let Heq' := add_left_cancel Heq in
                                   !rat.lt_irrefl (Heq' ▸ H)))

protected definition discrete_linear_ordered_field [trans_instance] :
    discrete_linear_ordered_field rat :=
⦃discrete_linear_ordered_field,
 rat.discrete_field,
 le_refl          := rat.le_refl,
 le_trans         := @rat.le_trans,
 le_antisymm      := @rat.le_antisymm,
 le_total         := @rat.le_total,
 le_of_lt         := @rat.le_of_lt,
 lt_irrefl        := rat.lt_irrefl,
 lt_of_lt_of_le   := @rat.lt_of_lt_of_le,
 lt_of_le_of_lt   := @rat.lt_of_le_of_lt,
 le_iff_lt_or_eq  := @rat.le_iff_lt_or_eq,
 add_le_add_left  := @rat.add_le_add_left,
 mul_nonneg       := @rat.mul_nonneg,
 mul_pos          := @rat.mul_pos,
 decidable_lt     := @decidable_lt,
 zero_lt_one      := rat.zero_lt_one,
 add_lt_add_left  := @rat.add_lt_add_left⦄

theorem of_nat_abs (a : ℤ) : abs (of_int a) = of_nat (int.nat_abs a) :=
have ∀ n : ℕ, of_int (int.neg_succ_of_nat n) = - of_nat (nat.succ n), from λ n, rfl,
int.induction_on a
  (take b, abs_of_nonneg !of_nat_nonneg)
  (take b, by rewrite [this, abs_neg, abs_of_nonneg !of_nat_nonneg])

theorem eq_zero_of_nonneg_of_forall_lt {x : ℚ} (xnonneg : x ≥ 0) (H : ∀ ε, ε > 0 → x < ε) :
  x = 0 :=
  decidable.by_contradiction
    (suppose x ≠ 0,
      have x > 0, from lt_of_le_of_ne xnonneg (ne.symm this),
      have x < x, from H x this,
      show false, from !lt.irrefl this)

theorem eq_zero_of_nonneg_of_forall_le {x : ℚ} (xnonneg : x ≥ 0) (H : ∀ ε, ε > 0 → x ≤ ε) :
  x = 0 :=
have H' : ∀ ε, ε > 0 → x < ε, from
  take ε, suppose h₁ : ε > 0,
  have ε / 2 > 0, from div_pos_of_pos_of_pos h₁ two_pos,
  have x ≤ ε / 2, from H _ this,
  show x < ε, from lt_of_le_of_lt this (div_two_lt_of_pos h₁),
eq_zero_of_nonneg_of_forall_lt xnonneg H'

theorem eq_zero_of_forall_abs_le {x : ℚ} (H : ∀ ε, ε > 0 → abs x ≤ ε) :
  x = 0 :=
decidable.by_contradiction
  (suppose x ≠ 0,
    have abs x = 0, from eq_zero_of_nonneg_of_forall_le !abs_nonneg H,
    show false, from `x ≠ 0` (eq_zero_of_abs_eq_zero this))

theorem eq_of_forall_abs_sub_le {x y : ℚ} (H : ∀ ε, ε > 0 → abs (x - y) ≤ ε) :
  x = y :=
have x - y = 0, from eq_zero_of_forall_abs_le H,
eq_of_sub_eq_zero this

section
  open int

  theorem num_nonneg_of_nonneg {q : ℚ} (H : q ≥ 0) : num q ≥ 0 :=
  have of_int (num q) ≥ of_int 0,
    begin
      rewrite [-mul_denom],
      apply rat.mul_nonneg H,
      rewrite [-of_int_zero, of_int_le_of_int_iff],
      exact int.le_of_lt !denom_pos
    end,
  show num q ≥ 0, from le_of_of_int_le_of_int this

  theorem num_pos_of_pos {q : ℚ} (H : q > 0) : num q > 0 :=
  have of_int (num q) > of_int 0,
    begin
      rewrite [-mul_denom],
      apply rat.mul_pos H,
      rewrite [-of_int_zero, of_int_lt_of_int_iff],
      exact !denom_pos
    end,
  show num q > 0, from lt_of_of_int_lt_of_int this

  theorem num_neg_of_neg {q : ℚ} (H : q < 0) : num q < 0 :=
  have of_int (num q) < of_int 0,
    begin
      rewrite [-mul_denom],
      apply mul_neg_of_neg_of_pos H,
      change of_int (denom q) > of_int 0,
      xrewrite [of_int_lt_of_int_iff],
      exact !denom_pos
    end,
  show num q < 0, from lt_of_of_int_lt_of_int this

  theorem num_nonpos_of_nonpos {q : ℚ} (H : q ≤ 0) : num q ≤ 0 :=
  have of_int (num q) ≤ of_int 0,
    begin
      rewrite [-mul_denom],
      apply mul_nonpos_of_nonpos_of_nonneg H,
      change of_int (denom q) ≥ of_int 0,
      xrewrite [of_int_le_of_int_iff],
      exact int.le_of_lt !denom_pos
    end,
  show num q ≤ 0, from le_of_of_int_le_of_int this
end

definition ubound : ℚ → ℕ := λ a : ℚ, nat.succ (int.nat_abs (num a))

theorem ubound_ge (a : ℚ) : of_nat (ubound a) ≥ a :=
have h : abs a * abs (of_int (denom a)) = abs (of_int (num a)), from
  !abs_mul ▸ !mul_denom ▸ rfl,
have of_int (denom a) > 0, from of_int_lt_of_int_of_lt !denom_pos,
have 1 ≤ abs (of_int (denom a)), begin
    rewrite (abs_of_pos this),
    apply of_int_le_of_int_of_le,
    apply denom_pos
  end,
have abs a ≤ abs (of_int (num a)), from
  le_of_mul_le_of_ge_one (h ▸ !le.refl) !abs_nonneg this,
calc
    a ≤ abs a                                   : le_abs_self
  ... ≤ abs (of_int (num a))                    : this
  ... ≤ abs (of_int (num a)) + 1                : le_add_of_nonneg_right trivial
  ... = of_nat (int.nat_abs (num a)) + 1        : of_nat_abs
  ... = of_nat (nat.succ (int.nat_abs (num a))) : of_nat_add

theorem ubound_pos (a : ℚ) : ubound a > 0 :=
!nat.succ_pos

open nat

theorem binary_nat_bound (a : ℕ) : of_nat a ≤ 2^a :=
  nat.induction_on a (zero_le_one)
   (take n : nat, assume Hn,
    calc
     of_nat (nat.succ n) = (of_nat n) + 1 : of_nat_add
       ... ≤ 2^n + 1           : add_le_add_right Hn
       ... ≤ 2^n + (2:rat)^n   : add_le_add_left (pow_ge_one_of_ge_one two_ge_one _)
       ... = 2^(succ n)        : pow_two_add)

theorem binary_bound (a : ℚ) : ∃ n : ℕ, a ≤ 2^n :=
  exists.intro (ubound a) (calc
      a ≤ of_nat (ubound a) : ubound_ge
    ... ≤ 2^(ubound a) : binary_nat_bound)

end rat


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import measure_theory.function.lp_space
import analysis.normed_space.lattice_ordered_group

/-!
# Order related properties of Lp spaces

### Results

- `Lp E p μ` is an `ordered_add_comm_group` when `E` is a `normed_lattice_add_comm_group`.

### TODO

- move definitions of `Lp.pos_part` and `Lp.neg_part` to this file, and define them as
  `has_pos_part.pos` and `has_pos_part.neg` given by the lattice structure.

-/

open topological_space measure_theory lattice_ordered_comm_group
open_locale ennreal

variables {α E : Type*} {m : measurable_space α} {μ : measure α} {p : ℝ≥0∞}

namespace measure_theory
namespace Lp

section order
variables [normed_lattice_add_comm_group E]

lemma coe_fn_le (f g : Lp E p μ) : f ≤ᵐ[μ] g ↔ f ≤ g :=
by rw [← subtype.coe_le_coe, ← ae_eq_fun.coe_fn_le, ← coe_fn_coe_base, ← coe_fn_coe_base]

lemma coe_fn_nonneg (f : Lp E p μ) : 0 ≤ᵐ[μ] f ↔ 0 ≤ f :=
begin
  rw ← coe_fn_le,
  have h0 := Lp.coe_fn_zero E p μ,
  split; intro h; filter_upwards [h, h0] with _ _ h2,
  { rwa h2, },
  { rwa ← h2, },
end

instance : covariant_class (Lp E p μ) (Lp E p μ) (+) (≤) :=
begin
  refine ⟨λ f g₁ g₂ hg₁₂, _⟩,
  rw ← coe_fn_le at hg₁₂ ⊢,
  filter_upwards [coe_fn_add f g₁, coe_fn_add f g₂, hg₁₂] with _ h1 h2 h3,
  rw [h1, h2, pi.add_apply, pi.add_apply],
  exact add_le_add le_rfl h3,
end

instance : ordered_add_comm_group (Lp E p μ) :=
{ add_le_add_left := λ f g, add_le_add_left,
  ..subtype.partial_order _, ..add_subgroup.to_add_comm_group _}

lemma _root_.measure_theory.mem_ℒp.sup {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) :
  mem_ℒp (f ⊔ g) p μ :=
mem_ℒp.mono' (hf.norm.add hg.norm) (hf.1.sup hg.1)
  (filter.eventually_of_forall (λ x, norm_sup_le_add (f x) (g x)))

lemma _root_.measure_theory.mem_ℒp.inf {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) :
  mem_ℒp (f ⊓ g) p μ :=
mem_ℒp.mono' (hf.norm.add hg.norm) (hf.1.inf hg.1)
  (filter.eventually_of_forall (λ x, norm_inf_le_add (f x) (g x)))

lemma _root_.measure_theory.mem_ℒp.abs {f : α → E} (hf : mem_ℒp f p μ)  :
  mem_ℒp (|f|) p μ :=
hf.sup hf.neg

instance : lattice (Lp E p μ) :=
subtype.lattice (λ f g hf hg, by { rw mem_Lp_iff_mem_ℒp at *,
    exact (mem_ℒp_congr_ae (ae_eq_fun.coe_fn_sup _ _)).mpr (hf.sup hg), })
  (λ f g hf hg, by { rw mem_Lp_iff_mem_ℒp at *,
    exact (mem_ℒp_congr_ae (ae_eq_fun.coe_fn_inf _ _)).mpr (hf.inf hg),})

lemma coe_fn_sup (f g : Lp E p μ) : ⇑(f ⊔ g) =ᵐ[μ] ⇑f ⊔ ⇑g :=
ae_eq_fun.coe_fn_sup _ _

lemma coe_fn_inf (f g : Lp E p μ) : ⇑(f ⊓ g) =ᵐ[μ] ⇑f ⊓ ⇑g :=
ae_eq_fun.coe_fn_inf _ _

lemma coe_fn_abs (f : Lp E p μ) : ⇑|f| =ᵐ[μ] λ x, |f x| :=
ae_eq_fun.coe_fn_abs _

noncomputable
instance [fact (1 ≤ p)] : normed_lattice_add_comm_group (Lp E p μ) :=
{ add_le_add_left := λ f g, add_le_add_left,
  solid := λ f g hfg, begin
    rw ← coe_fn_le at hfg,
    simp_rw [Lp.norm_def, ennreal.to_real_le_to_real (Lp.snorm_ne_top f) (Lp.snorm_ne_top g)],
    refine snorm_mono_ae _,
    filter_upwards [hfg, Lp.coe_fn_abs f, Lp.coe_fn_abs g] with x hx hxf hxg,
    rw [hxf, hxg] at hx,
    exact solid hx,
  end,
  ..Lp.lattice, ..Lp.normed_group, }

end order

end Lp
end measure_theory


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang

! This file was ported from Lean 3 source module ring_theory.ring_hom.finite_type
! leanprover-community/mathlib commit 64fc7238fb41b1a4f12ff05e3d5edfa360dd768c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.LocalProperties
import Mathbin.RingTheory.Localization.InvSubmonoid

/-!

# The meta properties of finite-type ring homomorphisms.

The main result is `ring_hom.finite_is_local`.

-/

namespace RingHom

open Pointwise

theorem finiteType_stableUnderComposition : StableUnderComposition @FiniteType :=
  by
  introv R hf hg
  exact hg.comp hf
#align ring_hom.finite_type_stable_under_composition RingHom.finiteType_stableUnderComposition

theorem finiteType_holdsForLocalizationAway : HoldsForLocalizationAway @FiniteType :=
  by
  introv R _
  skip
  suffices Algebra.FiniteType R S by
    change Algebra.FiniteType _ _
    convert this
    ext
    rw [Algebra.smul_def]
    rfl
  exact IsLocalization.finiteType_of_monoid_fg (Submonoid.powers r) S
#align ring_hom.finite_type_holds_for_localization_away RingHom.finiteType_holdsForLocalizationAway

theorem finiteType_ofLocalizationSpanTarget : OfLocalizationSpanTarget @FiniteType :=
  by
  -- Setup algebra intances.
  rw [of_localization_span_target_iff_finite]
  introv R hs H
  skip
  classical
    letI := f.to_algebra
    replace H : ∀ r : s, Algebra.FiniteType R (Localization.Away (r : S))
    · intro r
      convert H r
      ext
      rw [Algebra.smul_def]
      rfl
    replace H := fun r => (H r).1
    constructor
    -- Suppose `s : finset S` spans `S`, and each `Sᵣ` is finitely generated as an `R`-algebra.
    -- Say `t r : finset Sᵣ` generates `Sᵣ`. By assumption, we may find `lᵢ` such that
    -- `∑ lᵢ * sᵢ = 1`. I claim that all `s` and `l` and the numerators of `t` and generates `S`.
    choose t ht using H
    obtain ⟨l, hl⟩ :=
      (Finsupp.mem_span_iff_total S (s : Set S) 1).mp
        (show (1 : S) ∈ Ideal.span (s : Set S) by
          rw [hs]
          trivial)
    let sf := fun x : s => IsLocalization.finsetIntegerMultiple (Submonoid.powers (x : S)) (t x)
    use s.attach.bUnion sf ∪ s ∪ l.support.image l
    rw [eq_top_iff]
    -- We need to show that every `x` falls in the subalgebra generated by those elements.
    -- Since all `s` and `l` are in the subalgebra, it suffices to check that `sᵢ ^ nᵢ • x` falls in
    -- the algebra for each `sᵢ` and some `nᵢ`.
    rintro x -
    apply Subalgebra.mem_of_span_eq_top_of_smul_pow_mem _ (s : Set S) l hl _ _ x _
    · intro x hx
      apply Algebra.subset_adjoin
      rw [Finset.coe_union, Finset.coe_union]
      exact Or.inl (Or.inr hx)
    · intro i
      by_cases h : l i = 0
      · rw [h]
        exact zero_mem _
      apply Algebra.subset_adjoin
      rw [Finset.coe_union, Finset.coe_image]
      exact Or.inr (Set.mem_image_of_mem _ (finsupp.mem_support_iff.mpr h))
    · intro r
      rw [Finset.coe_union, Finset.coe_union, Finset.coe_bunionᵢ]
      -- Since all `sᵢ` and numerators of `t r` are in the algebra, it suffices to show that the
      -- image of `x` in `Sᵣ` falls in the `R`-adjoin of `t r`, which is of course true.
      obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ :=
        IsLocalization.exists_smul_mem_of_mem_adjoin (Submonoid.powers (r : S)) x (t r)
          (Algebra.adjoin R _) _ _ _
      · exact ⟨n₂, hn₂⟩
      · intro x hx
        apply Algebra.subset_adjoin
        refine' Or.inl (Or.inl ⟨_, ⟨r, rfl⟩, _, ⟨s.mem_attach r, rfl⟩, hx⟩)
      · rw [Submonoid.powers_eq_closure, Submonoid.closure_le, Set.singleton_subset_iff]
        apply Algebra.subset_adjoin
        exact Or.inl (Or.inr r.2)
      · rw [ht]
        trivial
#align ring_hom.finite_type_of_localization_span_target RingHom.finiteType_ofLocalizationSpanTarget

theorem finiteType_is_local : PropertyIsLocal @FiniteType :=
  ⟨localization_finiteType, finiteType_ofLocalizationSpanTarget, finiteType_stableUnderComposition,
    finiteType_holdsForLocalizationAway⟩
#align ring_hom.finite_type_is_local RingHom.finiteType_is_local

theorem finiteType_respectsIso : RingHom.RespectsIso @RingHom.FiniteType :=
  RingHom.finiteType_is_local.RespectsIso
#align ring_hom.finite_type_respects_iso RingHom.finiteType_respectsIso

end RingHom