/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import from_mathlib.filter
import from_mathlib.ring_seminorm

/-!
# seminorm_from_const

In this file, we prove [BGR, Proposition 1.3.2/2] : starting from a power-multiplicative seminorm
on a commutative ring `R` and a nonzero `c : R`, we create a new power-multiplicative seminorm for
which `c` is multiplicative.

## Main Definitions

* `seminorm_from_const'` : the real-valued function sending `x ∈ R` to the limit of
  `(f (x * c^n))/((f c)^n)`.
* `seminorm_from_const` : the function `seminorm_from_const'` is a `ring_seminorm` on `R`.

## Main Results
* `seminorm_from_const_is_nonarchimedean` : the function `seminorm_from_const' hf1 hc hpm`
  is nonarchimedean when f is nonarchimedean.
* `seminorm_from_const_is_pow_mul` : the function `seminorm_from_const' hf1 hc hpm`
  is power-multiplicative.
* `seminorm_from_const_c_is_mul` : for every `x : R`, `seminorm_from_const' hf1 hc hpm (c * x)`
  equals the product `seminorm_from_const' hf1 hc hpm c * seminorm_from_const' hf1 hc hpm x`.

## References
* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert]

## Tags

seminorm_from_const, seminorm, nonarchimedean
-/

noncomputable theory

open_locale topology

section ring

variables {R : Type*} [comm_ring R] (c : R) (f : ring_seminorm R) (hf1 : f 1 ≤ 1)
  (hc : 0 ≠ f c) (hpm : is_pow_mul f)

/-- For a ring seminorm `f` on `R` and `c ∈ R`, the sequence given by `(f (x * c^n))/((f c)^n)`. -/
def seminorm_from_const_seq (x : R) : ℕ → ℝ :=
λ n, (f (x * c^n))/((f c)^n)

/-- The terms in the sequence `seminorm_from_const_seq c f x` are nonnegative. -/
lemma seminorm_from_const_seq_nonneg (x : R) (n : ℕ) : 0 ≤ seminorm_from_const_seq c f x n :=
div_nonneg (map_nonneg f (x * c ^ n)) (pow_nonneg (map_nonneg f c) n)

/-- The image of `seminorm_from_const_seq c f x` is bounded below by zero. -/
lemma seminorm_from_const_is_bounded (x : R) :
  bdd_below (set.range (seminorm_from_const_seq c f x)) :=
begin
  use 0,
  rw mem_lower_bounds,
  intros r hr,
  obtain ⟨n, hn⟩ := hr,
  rw ← hn,
  exact seminorm_from_const_seq_nonneg c f x n,
end

variable {f}

/-- `seminorm_from_const_seq c f 0` is the constant sequence zero. -/
lemma seminorm_from_const_seq_zero (hf : f 0 = 0) :
  seminorm_from_const_seq c f 0 = 0 :=
begin
  simp only [seminorm_from_const_seq],
  ext n,
  rw [zero_mul, hf, zero_div],
  refl,
end

variable {c}

include hc hpm

/-- If `1 ≤ n`, then `seminorm_from_const_seq c f 1 n = 1`. -/
lemma seminorm_from_const_seq_one (n : ℕ) (hn : 1 ≤ n) :
  seminorm_from_const_seq c f 1 n = 1 :=
begin
  simp only [seminorm_from_const_seq],
  rw [one_mul, hpm _ hn, div_self (pow_ne_zero n (ne.symm hc))],
end

include hf1

/-- `seminorm_from_const_seq c f x` is antitone. -/
lemma seminorm_from_const_seq_antitone (x : R) :
  antitone (seminorm_from_const_seq c f x) :=
begin
  intros m n hmn,
  simp only [seminorm_from_const_seq],
  nth_rewrite 0 ← nat.add_sub_of_le hmn,
  rw [pow_add, ← mul_assoc],
  have hc_pos : 0 < f c := lt_of_le_of_ne (map_nonneg f _) hc,
  apply le_trans ((div_le_div_right (pow_pos hc_pos _)).mpr (map_mul_le_mul f _ _)),
  by_cases heq : m = n,
  { have : n - m = 0,
    { rw heq, exact nat.sub_self n, },
    rw [this, heq, div_le_div_right (pow_pos hc_pos _), pow_zero],
    conv_rhs{rw ← mul_one (f (x * c ^ n))},
    exact mul_le_mul_of_nonneg_left hf1 (map_nonneg f _) },
  { have h1 : 1 ≤ n - m,
    { rw [nat.one_le_iff_ne_zero, ne.def, nat.sub_eq_zero_iff_le, not_le],
    exact lt_of_le_of_ne hmn heq,},
    rw [hpm c h1, mul_div_assoc, div_eq_mul_inv, pow_sub₀ _ (ne.symm hc) hmn, mul_assoc,
      mul_comm (f c ^ m)⁻¹, ← mul_assoc (f c ^ n), mul_inv_cancel (pow_ne_zero n (ne.symm hc)),
      one_mul, div_eq_mul_inv] }
end

/-- The real-valued function sending `x ∈ R` to the limit of `(f (x * c^n))/((f c)^n)`. -/
def seminorm_from_const' (x : R) : ℝ :=
classical.some (real.tendsto_of_is_bounded_antitone (seminorm_from_const_is_bounded c f x)
  (seminorm_from_const_seq_antitone hf1 hc hpm x))

/-- We prove that `seminorm_from_const' hf1 hc hpm x` is the limit of the sequence
  `seminorm_from_const_seq c f x` as `n` tends to infinity. -/
lemma seminorm_from_const_is_limit (x : R) :
  filter.tendsto ((seminorm_from_const_seq c f x)) filter.at_top
    (𝓝 (seminorm_from_const' hf1 hc hpm x)) :=
classical.some_spec (real.tendsto_of_is_bounded_antitone (seminorm_from_const_is_bounded c f x)
  (seminorm_from_const_seq_antitone hf1 hc hpm x))

/-- `seminorm_from_const' hf1 hc hpm 0 = 0`. -/
lemma seminorm_from_const_zero : seminorm_from_const' hf1 hc hpm 0 = 0 :=
tendsto_nhds_unique (seminorm_from_const_is_limit hf1 hc hpm 0)
  (by simpa [seminorm_from_const_seq_zero c (map_zero _)] using tendsto_const_nhds)

/-- `seminorm_from_const' hf1 hc hpm 1 = 1`. -/
lemma seminorm_from_const_is_norm_one_class : seminorm_from_const' hf1 hc hpm 1 = 1 :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (seminorm_from_const_is_limit hf1 hc hpm 1)
    tendsto_const_nhds,
  simp only [filter.eventually_eq, filter.eventually_at_top, ge_iff_le],
  exact ⟨1,  seminorm_from_const_seq_one hc hpm⟩,
end

/-- `seminorm_from_const' hf1 hc hpm` is submultiplicative. -/
lemma seminorm_from_const_mul (x y : R) :
  seminorm_from_const' hf1 hc hpm (x * y) ≤
    seminorm_from_const' hf1 hc hpm x * seminorm_from_const' hf1 hc hpm y :=
begin
  have hlim : filter.tendsto (λ n, seminorm_from_const_seq c f (x * y) (2 *n)) filter.at_top
    (𝓝 (seminorm_from_const' hf1 hc hpm (x * y) )),
  { refine filter.tendsto.comp (seminorm_from_const_is_limit hf1 hc hpm (x * y)) _,
    apply filter.tendsto_at_top_at_top_of_monotone,
    { intros n m hnm, simp only [mul_le_mul_left, nat.succ_pos', hnm], },
    { rintro n, use n, linarith, }},
  apply le_of_tendsto_of_tendsto' hlim (filter.tendsto.mul
    (seminorm_from_const_is_limit hf1 hc hpm x)
    (seminorm_from_const_is_limit hf1 hc hpm y)),
  intro n,
  simp only [seminorm_from_const_seq],
  rw [div_mul_div_comm, ← pow_add, two_mul, div_le_div_right
    (pow_pos (lt_of_le_of_ne (map_nonneg f _) hc) _),
    pow_add, ← mul_assoc, mul_comm (x * y), ← mul_assoc, mul_assoc, mul_comm (c^n)],
  exact map_mul_le_mul f (x * c ^ n) (y * c ^ n),
end

/-- `seminorm_from_const' hf1 hc hpm` is invariant under negation of `x`. -/
lemma seminorm_from_const_neg (x : R)  :
  seminorm_from_const' hf1 hc hpm (-x) = seminorm_from_const' hf1 hc hpm x  :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (seminorm_from_const_is_limit hf1 hc hpm (-x))
    (seminorm_from_const_is_limit hf1 hc hpm x),
  simp only [filter.eventually_eq, filter.eventually_at_top],
  use 0,
  intros n hn,
  simp only [seminorm_from_const_seq],
  rw [neg_mul, map_neg_eq_map],
end

/-- `seminorm_from_const' hf1 hc hpm` satisfies the triangle inequality. -/
lemma seminorm_from_const_add (x y : R)  :
  seminorm_from_const' hf1 hc hpm (x + y) ≤
    seminorm_from_const' hf1 hc hpm x +  seminorm_from_const' hf1 hc hpm y :=
begin
  apply le_of_tendsto_of_tendsto' (seminorm_from_const_is_limit hf1 hc hpm (x + y))
    (filter.tendsto.add (seminorm_from_const_is_limit hf1 hc hpm x)
    (seminorm_from_const_is_limit hf1 hc hpm y)),
  intro n,
  have h_add : f ((x + y) * c ^ n) ≤ (f (x * c ^ n)) + (f (y * c ^ n)),
  { rw add_mul, exact map_add_le_add f _ _ },
  simp only [seminorm_from_const_seq],
  rw div_add_div_same,
  exact (div_le_div_right (pow_pos (lt_of_le_of_ne (map_nonneg f _) hc) _)).mpr h_add,
end

/-- The function `seminorm_from_const` is a `ring_seminorm` on `R`. -/
def seminorm_from_const :
  ring_seminorm R  :=
{ to_fun    := seminorm_from_const' hf1 hc hpm,
  map_zero' := seminorm_from_const_zero hf1 hc hpm,
  add_le'   := seminorm_from_const_add hf1 hc hpm,
  neg'      := seminorm_from_const_neg hf1 hc hpm,
  mul_le'   := seminorm_from_const_mul hf1 hc hpm }

lemma seminorm_from_const_def (x : R) :
  seminorm_from_const hf1 hc hpm x =  seminorm_from_const' hf1 hc hpm x := rfl

/-- `seminorm_from_const' hf1 hc hpm 1 ≤ 1`. -/
lemma seminorm_from_const_is_norm_le_one_class :
  seminorm_from_const' hf1 hc hpm 1 ≤ 1 :=
le_of_eq (seminorm_from_const_is_norm_one_class hf1 hc hpm)

/-- The function `seminorm_from_const' hf1 hc hpm` is nonarchimedean. -/
lemma seminorm_from_const_is_nonarchimedean (hna : is_nonarchimedean f) :
  is_nonarchimedean (seminorm_from_const' hf1 hc hpm)  :=
begin
  intros x y,
  apply le_of_tendsto_of_tendsto' (seminorm_from_const_is_limit hf1 hc hpm (x + y))
    (filter.tendsto.max (seminorm_from_const_is_limit hf1 hc hpm x)
    (seminorm_from_const_is_limit hf1 hc hpm y)),
  intro n,
  have hmax : f ((x + y) * c ^ n) ≤ max (f (x * c ^ n)) (f (y * c ^ n)),
  { rw add_mul, exact hna _ _ },
  rw le_max_iff at hmax ⊢,
  cases hmax; [left, right];
  exact (div_le_div_right (pow_pos (lt_of_le_of_ne (map_nonneg f c) hc) _)).mpr hmax,
end

/-- The function `seminorm_from_const' hf1 hc hpm` is power-multiplicative. -/
lemma seminorm_from_const_is_pow_mul : is_pow_mul (seminorm_from_const' hf1 hc hpm) :=
begin
  intros x m hm,
  simp only [seminorm_from_const'],
  have hpow := filter.tendsto.pow (seminorm_from_const_is_limit hf1 hc hpm x) m,
  have hlim : filter.tendsto (λ n, seminorm_from_const_seq c f (x^m) (m*n)) filter.at_top
    (𝓝 (seminorm_from_const' hf1 hc hpm (x^m) )),
  { refine filter.tendsto.comp (seminorm_from_const_is_limit hf1 hc hpm (x^m)) _,
    apply filter.tendsto_at_top_at_top_of_monotone,
    { intros n k hnk, exact mul_le_mul_left' hnk m, },
    { rintro n, use n, exact le_mul_of_one_le_left' hm, }},
  apply tendsto_nhds_unique hlim,
  convert filter.tendsto.pow (seminorm_from_const_is_limit hf1 hc hpm x) m,
  ext n,
  simp only [seminorm_from_const_seq],
  rw [div_pow, ← hpm _ hm, ← pow_mul, mul_pow, ← pow_mul, mul_comm m n],
end

/-- The function `seminorm_from_const' hf1 hc hpm` is bounded above by `x`. -/
lemma seminorm_from_const_le_seminorm (x : R) : seminorm_from_const' hf1 hc hpm x ≤ f x :=
begin
  apply le_of_tendsto (seminorm_from_const_is_limit hf1 hc hpm x),
  simp only [filter.eventually_at_top, ge_iff_le],
  use 1,
  rintros n hn,
  apply le_trans ((div_le_div_right (pow_pos (lt_of_le_of_ne (map_nonneg f c) hc) _)).mpr
    (map_mul_le_mul _ _ _)),
  rw [hpm c hn, mul_div_assoc, div_self (pow_ne_zero n hc.symm), mul_one],
end

/-- If `x : R` is multiplicative for `f`, then `seminorm_from_const' hf1 hc hpm x = f x`. -/
lemma seminorm_from_const_apply_of_is_mul {x : R} (hx : ∀ y : R, f (x * y) = f x * f y) :
  seminorm_from_const' hf1 hc hpm x = f x :=
begin
  have hlim : filter.tendsto (seminorm_from_const_seq c f x) filter.at_top (𝓝 (f x)),
  { have hseq : seminorm_from_const_seq c f x = λ n, f x,
    { ext n,
      by_cases hn : n = 0,
      { simp only [seminorm_from_const_seq],
        rw [hn, pow_zero, pow_zero, mul_one, div_one], },
      { simp only [seminorm_from_const_seq],
        rw [hx (c ^n), hpm _ (nat.one_le_iff_ne_zero.mpr hn), mul_div_assoc,
          div_self (pow_ne_zero n hc.symm), mul_one], }},
    rw hseq,
    exact tendsto_const_nhds },
  exact tendsto_nhds_unique (seminorm_from_const_is_limit hf1 hc hpm x) hlim,
end

/-- If `x : R` is multiplicative for `f`, then it is multiplicative for
  `seminorm_from_const' hf1 hc hpm`. -/
lemma seminorm_from_const_is_mul_of_is_mul {x : R} (hx : ∀ y : R, f (x * y) = f x * f y) (y : R) :
  seminorm_from_const' hf1 hc hpm (x * y) =
    seminorm_from_const' hf1 hc hpm x * seminorm_from_const' hf1 hc hpm y :=
begin
  have hlim : filter.tendsto (seminorm_from_const_seq c f (x * y)) filter.at_top
    (𝓝 (seminorm_from_const' hf1 hc hpm x * seminorm_from_const' hf1 hc hpm y)),
  { rw seminorm_from_const_apply_of_is_mul hf1 hc hpm hx,
    have hseq : seminorm_from_const_seq c f (x * y) = λ n, f x * seminorm_from_const_seq c f y n,
    { ext n,
      simp only [seminorm_from_const_seq],
      rw [mul_assoc, hx, mul_div_assoc], },
    simpa [hseq]
      using filter.tendsto.const_mul _(seminorm_from_const_is_limit hf1 hc hpm y) },
  exact tendsto_nhds_unique (seminorm_from_const_is_limit hf1 hc hpm (x * y)) hlim,
end

/-- `seminorm_from_const' hf1 hc hpm c = f c`. -/
lemma seminorm_from_const_apply_c : seminorm_from_const' hf1 hc hpm c = f c :=
begin
  have hlim : filter.tendsto (seminorm_from_const_seq c f c) filter.at_top (𝓝 (f c)),
  { have hseq : seminorm_from_const_seq c f c = λ n, f c,
    { ext n,
      simp only [seminorm_from_const_seq],
      rw [← pow_succ, hpm _ le_add_self, pow_succ, mul_div_assoc, div_self (pow_ne_zero n hc.symm),
        mul_one], },
    rw hseq,
    exact tendsto_const_nhds },
  exact tendsto_nhds_unique (seminorm_from_const_is_limit hf1 hc hpm c) hlim,
end

/-- For every `x : R`, `seminorm_from_const' hf1 hc hpm (c * x)` equals the product
  `seminorm_from_const' hf1 hc hpm c * seminorm_from_const' hf1 hc hpm x`. -/
lemma seminorm_from_const_c_is_mul (x : R) :
  seminorm_from_const' hf1 hc hpm (c * x) =
    seminorm_from_const' hf1 hc hpm c * seminorm_from_const' hf1 hc hpm x :=
begin
  have hlim : filter.tendsto (λ n, seminorm_from_const_seq c f x (n + 1)) filter.at_top
    (𝓝 (seminorm_from_const' hf1 hc hpm x)),
  { refine filter.tendsto.comp (seminorm_from_const_is_limit hf1 hc hpm x) _,
    apply filter.tendsto_at_top_at_top_of_monotone,
    { intros n m hnm,
      exact add_le_add_right hnm 1, },
    { rintro n, use n, linarith, }},
  rw seminorm_from_const_apply_c hf1 hc hpm,
  apply tendsto_nhds_unique (seminorm_from_const_is_limit hf1 hc hpm (c * x)),
  have hterm : seminorm_from_const_seq c f (c * x) =
    (λ n, f c * (seminorm_from_const_seq c f x (n + 1))),
  { simp only [seminorm_from_const_seq],
    ext n,
    rw [mul_comm c, pow_succ, pow_succ, mul_div, div_eq_mul_inv _ (f c * f c ^ n), mul_inv,
      ← mul_assoc, mul_comm (f c), mul_assoc _ (f c), mul_inv_cancel hc.symm,
      mul_one, mul_assoc, div_eq_mul_inv] },
  simpa [hterm] using filter.tendsto.mul tendsto_const_nhds hlim,
end

end ring

section field

variables {K : Type*} [field K]

/-- If `K` is a field, the function `seminorm_from_const` is a `ring_norm` on `K`. -/
def seminorm_from_const_ring_norm_of_field {k : K} {g : ring_seminorm K} (hg1 : g 1 ≤ 1)
  (hg_k : g k ≠ 0) (hg_pm : is_pow_mul g) : ring_norm K :=
(seminorm_from_const hg1 hg_k.symm hg_pm).to_ring_norm
  (ring_seminorm.ne_zero_iff.mpr⟨k,
    by simpa [seminorm_from_const_def, seminorm_from_const_apply_c] using hg_k⟩)

lemma seminorm_from_const_ring_norm_of_field_def {k : K} {g : ring_seminorm K} (hg1 : g 1 ≤ 1)
  (hg_k : g k ≠ 0) (hg_pm : is_pow_mul g) (x : K) :
  seminorm_from_const_ring_norm_of_field hg1 hg_k hg_pm x =
    seminorm_from_const' hg1 hg_k.symm hg_pm x :=
rfl

end field


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.translations
/-!
# Recurrence Lemmas for the `continuants` Function of Continued Fractions.

## Summary

Given a generalized continued fraction `g`, for all `n ≥ 1`, we prove that the `continuants`
function indeed satisfies the following recurrences:
- `Aₙ = bₙ * Aₙ₋₁ + aₙ * Aₙ₋₂`, and
- `Bₙ = bₙ * Bₙ₋₁ + aₙ * Bₙ₋₂`.
-/

namespace generalized_continued_fraction
open generalized_continued_fraction as gcf
variables {K : Type*} {g : gcf K} {n : ℕ} [division_ring K]

lemma continuants_aux_recurrence {gp ppred pred : gcf.pair K} (nth_s_eq : g.s.nth n = some gp)
  (nth_conts_aux_eq : g.continuants_aux n = ppred)
  (succ_nth_conts_aux_eq : g.continuants_aux (n + 1) = pred) :
  g.continuants_aux (n + 2) = ⟨gp.b * pred.a + gp.a * ppred.a, gp.b * pred.b + gp.a * ppred.b⟩ :=
by simp [*, continuants_aux, next_continuants, next_denominator, next_numerator]

lemma continuants_recurrence_aux {gp ppred pred : gcf.pair K} (nth_s_eq : g.s.nth n = some gp)
  (nth_conts_aux_eq : g.continuants_aux n = ppred)
  (succ_nth_conts_aux_eq : g.continuants_aux (n + 1) = pred) :
  g.continuants (n + 1) = ⟨gp.b * pred.a + gp.a * ppred.a, gp.b * pred.b + gp.a * ppred.b⟩ :=
by simp [nth_cont_eq_succ_nth_cont_aux,
  (continuants_aux_recurrence nth_s_eq nth_conts_aux_eq succ_nth_conts_aux_eq)]

/-- Shows that `Aₙ = bₙ * Aₙ₋₁ + aₙ * Aₙ₋₂` and `Bₙ = bₙ * Bₙ₋₁ + aₙ * Bₙ₋₂`. -/
theorem continuants_recurrence {gp ppred pred : gcf.pair K}
  (succ_nth_s_eq : g.s.nth (n + 1) = some gp)
  (nth_conts_eq : g.continuants n = ppred)
  (succ_nth_conts_eq : g.continuants (n + 1) = pred) :
  g.continuants (n + 2) = ⟨gp.b * pred.a + gp.a * ppred.a, gp.b * pred.b + gp.a * ppred.b⟩ :=
begin
  rw [nth_cont_eq_succ_nth_cont_aux] at nth_conts_eq succ_nth_conts_eq,
  exact (continuants_recurrence_aux succ_nth_s_eq nth_conts_eq succ_nth_conts_eq)
end

/-- Shows that `Aₙ = bₙ * Aₙ₋₁ + aₙ * Aₙ₋₂`. -/
lemma numerators_recurrence {gp : gcf.pair K} {ppredA predA : K}
  (succ_nth_s_eq : g.s.nth (n + 1) = some gp)
  (nth_num_eq : g.numerators n = ppredA)
  (succ_nth_num_eq : g.numerators (n + 1) = predA) :
  g.numerators (n + 2) = gp.b * predA + gp.a * ppredA :=
begin
  obtain ⟨ppredConts, nth_conts_eq, ⟨rfl⟩⟩ : ∃ conts, g.continuants n = conts ∧ conts.a = ppredA,
    from exists_conts_a_of_num nth_num_eq,
  obtain ⟨predConts, succ_nth_conts_eq, ⟨rfl⟩⟩ :
    ∃ conts, g.continuants (n + 1) = conts ∧ conts.a = predA, from
      exists_conts_a_of_num succ_nth_num_eq,
  rw [num_eq_conts_a, (continuants_recurrence succ_nth_s_eq nth_conts_eq succ_nth_conts_eq)]
end

/-- Shows that `Bₙ = bₙ * Bₙ₋₁ + aₙ * Bₙ₋₂`. -/

end generalized_continued_fraction


import
  analysis.mean_inequalities
  analysis.special_functions.pow

/-! # IMO 2020 A4 (P2), Generalized Version -/

namespace IMOSL
namespace IMO2020A4

open real finset

section extra

theorem sq_sum_lt_sum_sq {n : ℕ} (h : 2 ≤ n) {x : fin n → ℝ} (h0 : ∀ k : fin n, 0 < x k) :
  univ.sum (λ i, x i ^ 2) < univ.sum x ^ 2 :=
begin
  revert x h0; refine nat.le_induction _ _ n h; clear h n,
  { intros x h,
    rw [fin.sum_univ_two, fin.sum_univ_two, add_sq', lt_add_iff_pos_right],
    exact mul_pos (mul_pos two_pos (h 0)) (h 1) },
  { intros n hn h x h0,
    replace h := @h (λ k, x (fin.cast_succ k)) (λ k, h0 _),
    rw [fin.sum_univ_cast_succ, fin.sum_univ_cast_succ, add_sq'],
    refine lt_trans (add_lt_add_right h _) (lt_add_of_pos_right _ _),
    refine mul_pos (mul_pos two_pos (sum_pos (λ k _, h0 _) _)) (h0 _),
    rw [univ_nonempty_iff, ← fin.pos_iff_nonempty],
    exact lt_of_lt_of_le two_pos hn }
end

end extra

/-- Final solution -/
theorem final_solution {n : ℕ} (h : 2 ≤ n) {a : ℝ} (h0 : 0 < a) {x : fin n → ℝ}
  (h1 : ∀ k : fin n, 0 < x k) (h2 : ∀ k : fin n, x k ≤ a) (h3 : a + univ.sum x = 1) :
  (3 - 2 * a) * (a ^ a * univ.prod (λ k, x k ^ (x k))) < 1 :=
begin
  have h32a : 0 < 3 - 2 * a :=
  begin
    suffices : a ≤ 1,
      linarith only [this],
    rw [← h3, le_add_iff_nonneg_right],
    exact sum_nonneg' (λ k, le_of_lt (h1 k))
  end,
  cases lt_or_le a (1 / 2) with h4 h4,
  refine lt_of_le_of_lt (mul_le_mul_of_nonneg_left _ (le_of_lt h32a)) (_ : _ * a < 1),

  -- If a < 1/2, then a^a ∏ x_k^{x_k} ≤ a
  { refine le_of_le_of_eq (mul_le_mul_of_nonneg_left _ _) (_ : _ * a ^ univ.sum x = a),
    rotate,
    exact le_of_lt (rpow_pos_of_pos h0 a),
    rw [← rpow_add h0, h3, rpow_one],
    rw real.rpow_sum_of_nonneg (le_of_lt h0) (λ k _, le_of_lt (h1 k)),
    apply prod_le_prod; rintros k -,
    exacts [le_of_lt (rpow_pos_of_pos (h1 k) (x k)),
            real.rpow_le_rpow (le_of_lt (h1 k)) (h2 k) (le_of_lt (h1 k))] },

  -- If a < 1/2, then (3 - 2a) a < 1
  { rw ← sub_pos,
    refine lt_of_lt_of_eq _ (by ring : (1 - a) * (1 - 2 * a) = _),
    apply mul_pos; linarith only [h4] },

  refine lt_of_lt_of_le (mul_lt_mul_of_pos_left _ h32a) (_ : _ * (a ^ 2 + (1 - a) ^ 2) ≤ 1),

  -- If a ≥ 1/2, then a^a ∏ x_k^{x_k} < a^2 + (1 - a)^2
  { set y : fin (n + 1) → ℝ := fin.cons a x with hy,
    rw [← fin.sum_cons, ← hy] at h3,
    have h5 : a ^ a * univ.prod (λ (k : fin n), x k ^ x k) = univ.prod (λ k, y k ^ y k) :=
      by simp only [y, fin.prod_univ_succ, fin.cons_zero, fin.cons_succ],
    rw h5,
    replace h5 : ∀ k : fin (n + 1), k ∈ (univ : finset (fin (n + 1))) → 0 ≤ y k :=
    begin
      rintros k -,
      rcases fin.eq_zero_or_eq_succ k with rfl | ⟨j, rfl⟩,
      simp only [y, fin.cons_zero]; exact le_of_lt h0,
      simp only [y, fin.cons_succ]; exact le_of_lt (h1 j)
    end,
    refine lt_of_le_of_lt (real.geom_mean_le_arith_mean_weighted _ y y h5 h3 h5) _,
    conv_lhs { congr, skip, funext, rw [← sq, hy] },
    rw [fin.sum_univ_succ, fin.cons_zero, real.add_lt_add_iff_left],
    simp only [fin.cons_succ, finset.sum_congr],
    refine lt_of_lt_of_eq (sq_sum_lt_sum_sq h h1) _,
    rw [hy, fin.sum_cons, ← eq_sub_iff_add_eq'] at h3,
    rw ← h3 },

  -- If a ≥ 1/2, then (3 - 2a)(a^2 + (1 - a)^2) ≤ 1
  { rw ← sub_nonneg,
    refine le_of_le_of_eq _ (by ring : 2 * (a - 1) ^ 2 * (2 * a - 1) = _),
    exact mul_nonneg (mul_nonneg zero_le_two (sq_nonneg _)) (by linarith [h4]) }
end

/-- Final solution, original version -/
theorem final_solution_original {a b c d : ℝ} (h : 0 < d) (h0 : d ≤ c) (h1 : c ≤ b) (h2 : b ≤ a)
  (h3 : a + b + c + d = 1) : (a + 2 * b + 3 * c + 4 * d) * (a ^ a * b ^ b * c ^ c * d ^ d) < 1 :=
begin
  let x : fin 3 → ℝ := ![b, c, d],
  have ha : 0 < a := by linarith only [h, h0, h1, h2],
  have h4 : ∀ k : fin 3, 0 < x k :=
    λ k, by fin_cases k; simp [x]; linarith only [h, h0, h1],
  have h5 : ∀ k : fin 3, x k ≤ a :=
    λ k, by fin_cases k; simp [x]; linarith only [h0, h1, h2],
  have h6 : a + univ.sum (λ (k : fin 3), x k) = 1 :=
    by rw [fin.sum_univ_three, ← add_assoc, ← add_assoc, ← h3]; simp [x],
  refine lt_of_le_of_lt _ (final_solution (by norm_num) ha h4 h5 h6),
  rw [fin.prod_univ_three, mul_assoc (a ^ a), mul_assoc]; simp [x],
  refine mul_le_mul_of_nonneg_right _ _,
  linarith only [h3, h0, h1],
  refine mul_nonneg _ (mul_nonneg (mul_nonneg _ _) _),
  all_goals { apply real.rpow_nonneg_of_nonneg, linarith }
end

end IMO2020A4
end IMOSL


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

! This file was ported from Lean 3 source module algebra.star.pi
! leanprover-community/mathlib commit 9abfa6f0727d5adc99067e325e15d1a9de17fd8e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Star.Basic
import Mathlib.Algebra.Ring.Pi

/-!
# `star` on pi types

We put a `Star` structure on pi types that operates elementwise, such that it describes the
complex conjugation of vectors.
-/

universe u v w

variable {I : Type u}

-- The indexing type
variable {f : I → Type v}

-- The family of types already equipped with instances
namespace Pi

instance [∀ i, Star (f i)] : Star (∀ i, f i) where star x i := star (x i)

@[simp]
theorem star_apply [∀ i, Star (f i)] (x : ∀ i, f i) (i : I) : star x i = star (x i) :=
  rfl
#align pi.star_apply Pi.star_apply

theorem star_def [∀ i, Star (f i)] (x : ∀ i, f i) : star x = fun i => star (x i) :=
  rfl
#align pi.star_def Pi.star_def

instance [∀ i, Star (f i)] [∀ i, TrivialStar (f i)] : TrivialStar (∀ i, f i)
    where star_trivial _ := funext fun _ => star_trivial _

instance [∀ i, InvolutiveStar (f i)] : InvolutiveStar (∀ i, f i)
    where star_involutive _ := funext fun _ => star_star _

instance [∀ i, Semigroup (f i)] [∀ i, StarSemigroup (f i)] : StarSemigroup (∀ i, f i)
    where star_mul _ _ := funext fun _ => star_mul _ _

instance [∀ i, AddMonoid (f i)] [∀ i, StarAddMonoid (f i)] : StarAddMonoid (∀ i, f i)
    where star_add _ _ := funext fun _ => star_add _ _

instance [∀ i, NonUnitalSemiring (f i)] [∀ i, StarRing (f i)] : StarRing (∀ i, f i)
  where star_add _ _ := funext fun _ => star_add _ _

instance {R : Type w} [∀ i, SMul R (f i)] [Star R] [∀ i, Star (f i)]
    [∀ i, StarModule R (f i)] : StarModule R (∀ i, f i)
    where star_smul r x := funext fun i => star_smul r (x i)

theorem single_star [∀ i, AddMonoid (f i)] [∀ i, StarAddMonoid (f i)] [DecidableEq I] (i : I)
    (a : f i) : Pi.single i (star a) = star (Pi.single i a) :=
  single_op (fun i => @star (f i) _) (fun _ => star_zero _) i a
#align pi.single_star Pi.single_star

end Pi

namespace Function

theorem update_star [∀ i, Star (f i)] [DecidableEq I] (h : ∀ i : I, f i) (i : I) (a : f i) :
    Function.update (star h) i (star a) = star (Function.update h i a) :=
  funext fun j => (apply_update (fun _ => star) h i a j).symm
#align function.update_star Function.update_star

theorem star_sum_elim {I J α : Type _} (x : I → α) (y : J → α) [Star α] :
    star (Sum.elim x y) = Sum.elim (star x) (star y) := by
  ext x; cases x <;> simp only [Pi.star_apply, Sum.elim_inl, Sum.elim_inr]
#align function.star_sum_elim Function.star_sum_elim

end Function


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.set.function
import data.int.order.lemmas
import data.int.bitwise
import data.nat.cast.basic
import data.nat.order.lemmas

/-!
# Miscellaneous lemmas about the integers

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

This file contains lemmas about integers, which require further imports than
`data.int.basic` or `data.int.order`.

-/

open nat

namespace int

lemma le_coe_nat_sub (m n : ℕ) :
  (m - n : ℤ) ≤ ↑(m - n : ℕ) :=
begin
  by_cases h: m ≥ n,
  { exact le_of_eq (int.coe_nat_sub h).symm },
  { simp [le_of_not_ge h, coe_nat_le] }
end

/-! ### succ and pred -/

@[simp] lemma succ_coe_nat_pos (n : ℕ) : 0 < (n : ℤ) + 1 :=
lt_add_one_iff.mpr (by simp)

/-! ### nat abs -/

variables {a b : ℤ} {n : ℕ}

lemma nat_abs_eq_iff_sq_eq {a b : ℤ} : a.nat_abs = b.nat_abs ↔ a ^ 2 = b ^ 2 :=
by { rw [sq, sq], exact nat_abs_eq_iff_mul_self_eq }

lemma nat_abs_lt_iff_sq_lt {a b : ℤ} : a.nat_abs < b.nat_abs ↔ a ^ 2 < b ^ 2 :=
by { rw [sq, sq], exact nat_abs_lt_iff_mul_self_lt }

lemma nat_abs_le_iff_sq_le {a b : ℤ} : a.nat_abs ≤ b.nat_abs ↔ a ^ 2 ≤ b ^ 2 :=
by { rw [sq, sq], exact nat_abs_le_iff_mul_self_le }

lemma nat_abs_inj_of_nonneg_of_nonneg {a b : ℤ} (ha : 0 ≤ a) (hb : 0 ≤ b) :
  nat_abs a = nat_abs b ↔ a = b :=
by rw [←sq_eq_sq ha hb, ←nat_abs_eq_iff_sq_eq]

lemma nat_abs_inj_of_nonpos_of_nonpos {a b : ℤ} (ha : a ≤ 0) (hb : b ≤ 0) :
  nat_abs a = nat_abs b ↔ a = b :=
by simpa only [int.nat_abs_neg, neg_inj]
 using nat_abs_inj_of_nonneg_of_nonneg
  (neg_nonneg_of_nonpos ha) (neg_nonneg_of_nonpos hb)

lemma nat_abs_inj_of_nonneg_of_nonpos {a b : ℤ} (ha : 0 ≤ a) (hb : b ≤ 0) :
  nat_abs a = nat_abs b ↔ a = -b :=
by simpa only [int.nat_abs_neg]
  using nat_abs_inj_of_nonneg_of_nonneg ha (neg_nonneg_of_nonpos hb)

lemma nat_abs_inj_of_nonpos_of_nonneg {a b : ℤ} (ha : a ≤ 0) (hb : 0 ≤ b) :
  nat_abs a = nat_abs b ↔ -a = b :=
by simpa only [int.nat_abs_neg]
  using nat_abs_inj_of_nonneg_of_nonneg (neg_nonneg_of_nonpos ha) hb

section intervals
open set

lemma strict_mono_on_nat_abs : strict_mono_on nat_abs (Ici 0) :=
λ a ha b hb hab, nat_abs_lt_nat_abs_of_nonneg_of_lt ha hab

lemma inj_on_nat_abs_Ici : inj_on nat_abs (Ici 0) := strict_mono_on_nat_abs.inj_on

lemma inj_on_nat_abs_Iic : inj_on nat_abs (Iic 0) := strict_anti_on_nat_abs.inj_on

end intervals

/-! ### to_nat -/

lemma to_nat_of_nonpos : ∀ {z : ℤ}, z ≤ 0 → z.to_nat = 0
| 0           _ := rfl
| (n + 1 : ℕ) h := (h.not_lt (by simp)).elim
| -[1+ n]     _ := rfl

/-! ### bitwise ops

This lemma is orphaned from `data.int.bitwise` as it also requires material from `data.int.order`.
-/

local attribute [simp] int.zero_div

@[simp] lemma div2_bit (b n) : div2 (bit b n) = n :=
begin
  rw [bit_val, div2_val, add_comm, int.add_mul_div_left, (_ : (_/2:ℤ) = 0), zero_add],
  cases b,
  { simp },
  { show of_nat _ = _, rw nat.div_eq_zero; simp },
  { cc }
end

end int


/-
M1F 2017-18 Sheet 1 Question 2 to 4 solutions.
Author : Kevin Buzzard

This file should work with any version of lean -- whether you installed it yourself
or are running the version on https://leanprover.github.io/live/latest/

-/
-- We probably need the "law of the excluded middle" for this question -- every
-- proposition is either true or false! Don't even ask me to explain what the
-- other options are, but Lean does not come with this axiom by default (blame
-- the computer scientists) and mathematicians have to add it themselves.
-- It's easy to add though. "em" for excluded middle.

axiom em (X : Prop) : X ∨ ¬ X

variables P Q R S : Prop -- A "Prop" is a proposition, that is, a true/false statement.

-- Sheet 1 Q2 is true.

theorem m1f_sheet01_q02_is_T (HQP : Q → P) (HnQnR : ¬ Q → ¬ R) : R → P :=
begin
intro HR, -- hypothesis R
cases em Q with HQ HnQ, -- Q is either true or false.
  -- Q is true in this branch.
  exact HQP HQ, -- HPQ HQ is a proof of P.

  -- Q is false in this branch
  -- HnQ is the hypothesis "not Q"
  -- HnQnR is "not Q implies not R"
  -- so HnQnR HnQ is a proof of "not R"
      -- i.e. a proof of "R implies false"
  -- but HR is a proof of R
  -- and that's enough for a contradiction.
  have HnR : ¬ R,
  exact HnQnR HnQ,
  contradiction,
end

-- Sheet 1 Q3. Prove one result and delete the other.

-- theorem m1f_sheet01_q03_is_T (HP : P) (HnQ : ¬ Q) (HnR : ¬ R) (HS : S) : (R → S) → (P → Q) :=

theorem m1f_sheet01_q03_is_F (HP : P) (HnQ : ¬ Q) (HnR : ¬ R) (HS : S) : ¬ ((R → S) → (P → Q)) :=
begin
intro H,
have HRS : R → S,
  intro HR,
  contradiction,
have HPQ : P → Q,
  exact H HRS,
have HQ : Q,
  exact HPQ HP,
-- now we have Q and not Q
contradiction,
end

-- Sheet 1 Q4.

-- Let me first make a tool which is capable of proving all three hypotheses
-- when we have the right assumptions.

meta def prove_hyps : tactic unit :=
`[
  { -- This tactic will try to prove
    -- (P → Q ∨ R) ∧ (¬ Q → R ∨ ¬ P) ∧ (Q ∧ R → ¬ P)
    apply and.intro, -- next goal is P → Q ∨ R
      intro, -- now P is a hypothesis and Q ∨ R is the goal.
      -- next line works if any of ¬ P or Q or R are true.
      contradiction <|> {left,assumption} <|> {right,assumption},
    apply and.intro, -- same story,
      intro,contradiction <|> {left,assumption} <|> {right,assumption},
    -- next line attempts to prove Q and R -> not P.
    intro HQR, --
    have Q, from HQR.left,
    have R, from HQR.right,
    -- now Q and R are assumptions and not P is the goal.
    assumption <|> contradiction
  }
]

-- I used that tool to figure out what the answer is.

-- The answer to Q4 is that all three hypotheses are true if and only if either
-- (i) P is false, or
-- (ii) P is true, and exactly one of Q and R are true.

-- It's possible to write a very long proof of this.
-- But in this case I just did a brute force case by case check,
-- using basic tactics joined together with glue I learnt about
-- in section 5.5 of Theorem Proving In Lean.

theorem m1f_sheet01_q04 : (P → (Q ∨ R)) ∧ (¬ Q → (R ∨ ¬ P)) ∧ ((Q ∧ R) → ¬ P) ↔
  (¬ P) ∨ (P ∧ Q ∧ ¬ R) ∨ (P ∧ ¬ Q ∧ R) :=
begin
cases em P with HP HnP;cases em Q with HQ HnQ;cases em R with HR HnR;apply iff.intro,
repeat {-- we'll do all eight cases automatically.
  intro hyps,
  cc, -- this does the case where hyps implies my solution
  -- now check my solution implies hyps (possibly by contradiction)
  intro hmypqr,
  { prove_hyps } <|> {
    cases hmypqr with h1 h2,
    contradiction,
    cases h2 with ha hb,
    cases ha with h3 h4,
    cases h4,
    contradiction,
    cases hb with h5 h6,
    cases h6,
    contradiction
  }
},
end


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import linear_algebra.matrix.adjugate
import linear_algebra.matrix.to_lin

/-!
# The Special Linear group $SL(n, R)$

This file defines the elements of the Special Linear group `special_linear_group n R`, consisting
of all square `R`-matrices with determinant `1` on the fintype `n` by `n`.  In addition, we define
the group structure on `special_linear_group n R` and the embedding into the general linear group
`general_linear_group R (n → R)`.

## Main definitions

 * `matrix.special_linear_group` is the type of matrices with determinant 1
 * `matrix.special_linear_group.group` gives the group structure (under multiplication)
 * `matrix.special_linear_group.to_GL` is the embedding `SLₙ(R) → GLₙ(R)`

## Notation

For `m : ℕ`, we introduce the notation `SL(m,R)` for the special linear group on the fintype
`n = fin m`, in the locale `matrix_groups`.

## Implementation notes
The inverse operation in the `special_linear_group` is defined to be the adjugate
matrix, so that `special_linear_group n R` has a group structure for all `comm_ring R`.

We define the elements of `special_linear_group` to be matrices, since we need to
compute their determinant. This is in contrast with `general_linear_group R M`,
which consists of invertible `R`-linear maps on `M`.

We provide `matrix.special_linear_group.has_coe_to_fun` for convenience, but do not state any
lemmas about it, and use `matrix.special_linear_group.coe_fn_eq_coe` to eliminate it `⇑` in favor
of a regular `↑` coercion.

## References

 * https://en.wikipedia.org/wiki/Special_linear_group

## Tags

matrix group, group, matrix inverse
-/

namespace matrix
universes u v
open_locale matrix
open linear_map

section

variables (n : Type u) [decidable_eq n] [fintype n] (R : Type v) [comm_ring R]

/-- `special_linear_group n R` is the group of `n` by `n` `R`-matrices with determinant equal to 1.
-/
def special_linear_group := { A : matrix n n R // A.det = 1 }

end

localized "notation `SL(` n `,` R `)`:= special_linear_group (fin n) R" in matrix_groups

namespace special_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]

instance has_coe_to_matrix : has_coe (special_linear_group n R) (matrix n n R) :=
⟨λ A, A.val⟩

/- In this file, Lean often has a hard time working out the values of `n` and `R` for an expression
like `det ↑A`. Rather than writing `(A : matrix n n R)` everywhere in this file which is annoyingly
verbose, or `A.val` which is not the simp-normal form for subtypes, we create a local notation
`↑ₘA`. This notation references the local `n` and `R` variables, so is not valid as a global
notation. -/
local prefix `↑ₘ`:1024 := @coe _ (matrix n n R) _

lemma ext_iff (A B : special_linear_group n R) : A = B ↔ (∀ i j, ↑ₘA i j = ↑ₘB i j) :=
subtype.ext_iff.trans matrix.ext_iff.symm

@[ext] lemma ext (A B : special_linear_group n R) : (∀ i j, ↑ₘA i j = ↑ₘB i j) → A = B :=
(special_linear_group.ext_iff A B).mpr

instance has_inv : has_inv (special_linear_group n R) :=
⟨λ A, ⟨adjugate A, by rw [det_adjugate, A.prop, one_pow]⟩⟩

instance has_mul : has_mul (special_linear_group n R) :=
⟨λ A B, ⟨A.1 ⬝ B.1, by erw [det_mul, A.2, B.2, one_mul]⟩⟩

instance has_one : has_one (special_linear_group n R) :=
⟨⟨1, det_one⟩⟩

instance : inhabited (special_linear_group n R) := ⟨1⟩

section coe_lemmas

variables (A B : special_linear_group n R)

@[simp] lemma coe_mk (A : matrix n n R) (h : det A = 1) :
  ↑(⟨A, h⟩ : special_linear_group n R) = A :=
rfl

@[simp] lemma coe_inv : ↑ₘ(A⁻¹) = adjugate A := rfl

@[simp] lemma coe_mul : ↑ₘ(A * B) = ↑ₘA ⬝ ↑ₘB := rfl

@[simp] lemma coe_one : ↑ₘ(1 : special_linear_group n R) = (1 : matrix n n R) := rfl

@[simp] lemma det_coe : det ↑ₘA = 1 := A.2

lemma det_ne_zero [nontrivial R] (g : special_linear_group n R) :
  det ↑ₘg ≠ 0 :=
by { rw g.det_coe, norm_num }

lemma row_ne_zero [nontrivial R] (g : special_linear_group n R) (i : n):
  ↑ₘg i ≠ 0 :=
λ h, g.det_ne_zero $ det_eq_zero_of_row_eq_zero i $ by simp [h]

end coe_lemmas

instance : monoid (special_linear_group n R) :=
function.injective.monoid coe subtype.coe_injective coe_one coe_mul

instance : group (special_linear_group n R) :=
{ mul_left_inv := λ A, by { ext1, simp [adjugate_mul] },
  ..special_linear_group.monoid,
  ..special_linear_group.has_inv }

/-- A version of `matrix.to_lin' A` that produces linear equivalences. -/
def to_lin' : special_linear_group n R →* (n → R) ≃ₗ[R] (n → R) :=
{ to_fun := λ A, linear_equiv.of_linear (matrix.to_lin' ↑ₘA) (matrix.to_lin' ↑ₘ(A⁻¹))
    (by rw [←to_lin'_mul, ←coe_mul, mul_right_inv, coe_one, to_lin'_one])
    (by rw [←to_lin'_mul, ←coe_mul, mul_left_inv, coe_one, to_lin'_one]),
  map_one' := linear_equiv.to_linear_map_injective matrix.to_lin'_one,
  map_mul' := λ A B, linear_equiv.to_linear_map_injective $ matrix.to_lin'_mul A B }

lemma to_lin'_apply (A : special_linear_group n R) (v : n → R) :
  special_linear_group.to_lin' A v = matrix.to_lin' ↑ₘA v := rfl

lemma to_lin'_to_linear_map (A : special_linear_group n R) :
  ↑(special_linear_group.to_lin' A) = matrix.to_lin' ↑ₘA := rfl

lemma to_lin'_symm_apply (A : special_linear_group n R) (v : n → R) :
  A.to_lin'.symm v = matrix.to_lin' ↑ₘ(A⁻¹) v := rfl

lemma to_lin'_symm_to_linear_map (A : special_linear_group n R) :
  ↑(A.to_lin'.symm) = matrix.to_lin' ↑ₘ(A⁻¹) := rfl

lemma to_lin'_injective :
  function.injective ⇑(to_lin' : special_linear_group n R →* (n → R) ≃ₗ[R] (n → R)) :=
λ A B h, subtype.coe_injective $ matrix.to_lin'.injective $
  linear_equiv.to_linear_map_injective.eq_iff.mpr h

/-- `to_GL` is the map from the special linear group to the general linear group -/
def to_GL : special_linear_group n R →* general_linear_group R (n → R) :=
(general_linear_group.general_linear_equiv _ _).symm.to_monoid_hom.comp to_lin'

lemma coe_to_GL (A : special_linear_group n R) : ↑A.to_GL = A.to_lin'.to_linear_map := rfl

variables {S : Type*} [comm_ring S]

/-- A ring homomorphism from `R` to `S` induces a group homomorphism from
`special_linear_group n R` to `special_linear_group n S`. -/
@[simps] def map (f : R →+* S) : special_linear_group n R →* special_linear_group n S :=
{ to_fun := λ g, ⟨f.map_matrix ↑g, by { rw ← f.map_det, simp [g.2] }⟩,
  map_one' := subtype.ext $ f.map_matrix.map_one,
  map_mul' := λ x y, subtype.ext $ f.map_matrix.map_mul x y }

section cast

/-- Coercion of SL `n` `ℤ` to SL `n` `R` for a commutative ring `R`. -/
instance : has_coe (special_linear_group n ℤ) (special_linear_group n R) :=
⟨λ x, map (int.cast_ring_hom R) x⟩

@[simp] lemma coe_matrix_coe (g : special_linear_group n ℤ) :
  ↑(g : special_linear_group n R)
  = (↑g : matrix n n ℤ).map (int.cast_ring_hom R) :=
map_apply_coe (int.cast_ring_hom R) g

end cast

section has_neg

variables [fact (even (fintype.card n))]

/-- Formal operation of negation on special linear group on even cardinality `n` given by negating
each element. -/
instance : has_neg (special_linear_group n R) :=
⟨λ g,
  ⟨- g, by simpa [nat.neg_one_pow_of_even (fact.out (even (fintype.card n))), g.det_coe] using
  det_smul ↑ₘg (-1)⟩⟩

@[simp] lemma coe_neg (g : special_linear_group n R) :
  ↑(- g) = - (↑g : matrix n n R) :=
rfl

@[simp] lemma coe_int_neg (g : (special_linear_group n ℤ)) :
  ↑(-g) = (-↑g : special_linear_group n R) :=
subtype.ext $ (@ring_hom.map_matrix n _ _ _ _ _ _ (int.cast_ring_hom R)).map_neg ↑g

end has_neg

-- this section should be last to ensure we do not use it in lemmas
section coe_fn_instance

/-- This instance is here for convenience, but is not the simp-normal form. -/
instance : has_coe_to_fun (special_linear_group n R) (λ _, n → n → R) :=
{ coe := λ A, A.val }

@[simp]
lemma coe_fn_eq_coe (s : special_linear_group n R) : ⇑s = ↑ₘs := rfl

end coe_fn_instance

end special_linear_group

end matrix


-- Demostrar, en la lógica intuicionista, (P → (P → Q)) → ((P → Q) → P) → Q

variables (P Q :  Prop)

example : (P → (P → Q)) → ((P → Q) → P) → Q :=
begin
  intros f g,
  let h := λ R, f R R,
  exact f (g h) (g h),
end

example : (P → (P → Q)) → ((P → Q) → P) → Q :=
begin
  intros f g,
  exact f (g (λ R, f R R)) (g (λ R, f R R)),
end

example : (P → (P → Q)) → ((P → Q) → P) → Q :=
begin
  intros f g,
  have h1 : P → Q := λ R, f R R,
  have h2 : P     := g h1,
  exact f h2 h2,
end

example : (P → (P → Q)) → ((P → Q) → P) → Q :=
λ f g, f (g (λ R, f R R)) (g (λ R, f R R))

example : (P → (P → Q)) → ((P → Q) → P) → Q :=
λ f g, let h : P → Q := λ h, f h h in h (g h)


variables A B : Prop
example : A -> not( not A /\ B) :=
assume h1 : A,
assume h2 : not A /\ B,
have h3 : not A, from and.left h2,
show false, from h3 h1


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll

! This file was ported from Lean 3 source module data.zmod.coprime
! leanprover-community/mathlib commit c085f3044fe585c575e322bfab45b3633c48d820
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Zmod.Basic
import Mathbin.RingTheory.Int.Basic

/-!
# Coprimality and vanishing

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

We show that for prime `p`, the image of an integer `a` in `zmod p` vanishes if and only if
`a` and `p` are not coprime.
-/

namespace ZMod

/- warning: zmod.eq_zero_iff_gcd_ne_one -> ZMod.eq_zero_iff_gcd_ne_one is a dubious translation:
lean 3 declaration is
  forall {a : Int} {p : Nat} [pp : Fact (Nat.Prime p)], Iff (Eq.{1} (ZMod p) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int (ZMod p) (HasLiftT.mk.{1, 1} Int (ZMod p) (CoeTCₓ.coe.{1, 1} Int (ZMod p) (Int.castCoe.{0} (ZMod p) (AddGroupWithOne.toHasIntCast.{0} (ZMod p) (AddCommGroupWithOne.toAddGroupWithOne.{0} (ZMod p) (Ring.toAddCommGroupWithOne.{0} (ZMod p) (DivisionRing.toRing.{0} (ZMod p) (Field.toDivisionRing.{0} (ZMod p) (ZMod.field p pp))))))))) a) (OfNat.ofNat.{0} (ZMod p) 0 (OfNat.mk.{0} (ZMod p) 0 (Zero.zero.{0} (ZMod p) (MulZeroClass.toHasZero.{0} (ZMod p) (NonUnitalNonAssocSemiring.toMulZeroClass.{0} (ZMod p) (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} (ZMod p) (NonAssocRing.toNonUnitalNonAssocRing.{0} (ZMod p) (Ring.toNonAssocRing.{0} (ZMod p) (DivisionRing.toRing.{0} (ZMod p) (Field.toDivisionRing.{0} (ZMod p) (ZMod.field p pp)))))))))))) (Ne.{1} Nat (Int.gcd a ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) p)) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))
but is expected to have type
  forall {a : Int} {p : Nat} [pp : Fact (Nat.Prime p)], Iff (Eq.{1} (ZMod p) (Int.cast.{0} (ZMod p) (Ring.toIntCast.{0} (ZMod p) (DivisionRing.toRing.{0} (ZMod p) (Field.toDivisionRing.{0} (ZMod p) (ZMod.instFieldZMod p pp)))) a) (OfNat.ofNat.{0} (ZMod p) 0 (Zero.toOfNat0.{0} (ZMod p) (CommMonoidWithZero.toZero.{0} (ZMod p) (CommGroupWithZero.toCommMonoidWithZero.{0} (ZMod p) (Semifield.toCommGroupWithZero.{0} (ZMod p) (Field.toSemifield.{0} (ZMod p) (ZMod.instFieldZMod p pp)))))))) (Ne.{1} Nat (Int.gcd a (Nat.cast.{0} Int instNatCastInt p)) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))
Case conversion may be inaccurate. Consider using '#align zmod.eq_zero_iff_gcd_ne_one ZMod.eq_zero_iff_gcd_ne_oneₓ'. -/
/-- If `p` is a prime and `a` is an integer, then `a : zmod p` is zero if and only if
`gcd a p ≠ 1`. -/
theorem eq_zero_iff_gcd_ne_one {a : ℤ} {p : ℕ} [pp : Fact p.Prime] :
    (a : ZMod p) = 0 ↔ a.gcd p ≠ 1 := by
  rw [Ne, Int.gcd_comm, Int.gcd_eq_one_iff_coprime,
    (Nat.prime_iff_prime_int.1 pp.1).coprime_iff_not_dvd, Classical.not_not,
    int_coe_zmod_eq_zero_iff_dvd]
#align zmod.eq_zero_iff_gcd_ne_one ZMod.eq_zero_iff_gcd_ne_one

/- warning: zmod.ne_zero_of_gcd_eq_one -> ZMod.ne_zero_of_gcd_eq_one is a dubious translation:
lean 3 declaration is
  forall {a : Int} {p : Nat}, (Nat.Prime p) -> (Eq.{1} Nat (Int.gcd a ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) p)) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) -> (Ne.{1} (ZMod p) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int (ZMod p) (HasLiftT.mk.{1, 1} Int (ZMod p) (CoeTCₓ.coe.{1, 1} Int (ZMod p) (Int.castCoe.{0} (ZMod p) (AddGroupWithOne.toHasIntCast.{0} (ZMod p) (AddCommGroupWithOne.toAddGroupWithOne.{0} (ZMod p) (Ring.toAddCommGroupWithOne.{0} (ZMod p) (CommRing.toRing.{0} (ZMod p) (ZMod.commRing p)))))))) a) (OfNat.ofNat.{0} (ZMod p) 0 (OfNat.mk.{0} (ZMod p) 0 (Zero.zero.{0} (ZMod p) (MulZeroClass.toHasZero.{0} (ZMod p) (NonUnitalNonAssocSemiring.toMulZeroClass.{0} (ZMod p) (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} (ZMod p) (NonAssocRing.toNonUnitalNonAssocRing.{0} (ZMod p) (Ring.toNonAssocRing.{0} (ZMod p) (CommRing.toRing.{0} (ZMod p) (ZMod.commRing p)))))))))))
but is expected to have type
  forall {a : Int} {p : Nat}, (Nat.Prime p) -> (Eq.{1} Nat (Int.gcd a (Nat.cast.{0} Int instNatCastInt p)) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) -> (Ne.{1} (ZMod p) (Int.cast.{0} (ZMod p) (Ring.toIntCast.{0} (ZMod p) (CommRing.toRing.{0} (ZMod p) (ZMod.commRing p))) a) (OfNat.ofNat.{0} (ZMod p) 0 (Zero.toOfNat0.{0} (ZMod p) (CommMonoidWithZero.toZero.{0} (ZMod p) (CommSemiring.toCommMonoidWithZero.{0} (ZMod p) (CommRing.toCommSemiring.{0} (ZMod p) (ZMod.commRing p)))))))
Case conversion may be inaccurate. Consider using '#align zmod.ne_zero_of_gcd_eq_one ZMod.ne_zero_of_gcd_eq_oneₓ'. -/
/-- If an integer `a` and a prime `p` satisfy `gcd a p = 1`, then `a : zmod p` is nonzero. -/
theorem ne_zero_of_gcd_eq_one {a : ℤ} {p : ℕ} (pp : p.Prime) (h : a.gcd p = 1) : (a : ZMod p) ≠ 0 :=
  mt (@eq_zero_iff_gcd_ne_one a p ⟨pp⟩).mp (Classical.not_not.mpr h)
#align zmod.ne_zero_of_gcd_eq_one ZMod.ne_zero_of_gcd_eq_one

/- warning: zmod.eq_zero_of_gcd_ne_one -> ZMod.eq_zero_of_gcd_ne_one is a dubious translation:
lean 3 declaration is
  forall {a : Int} {p : Nat}, (Nat.Prime p) -> (Ne.{1} Nat (Int.gcd a ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) p)) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) -> (Eq.{1} (ZMod p) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int (ZMod p) (HasLiftT.mk.{1, 1} Int (ZMod p) (CoeTCₓ.coe.{1, 1} Int (ZMod p) (Int.castCoe.{0} (ZMod p) (AddGroupWithOne.toHasIntCast.{0} (ZMod p) (AddCommGroupWithOne.toAddGroupWithOne.{0} (ZMod p) (Ring.toAddCommGroupWithOne.{0} (ZMod p) (CommRing.toRing.{0} (ZMod p) (ZMod.commRing p)))))))) a) (OfNat.ofNat.{0} (ZMod p) 0 (OfNat.mk.{0} (ZMod p) 0 (Zero.zero.{0} (ZMod p) (MulZeroClass.toHasZero.{0} (ZMod p) (NonUnitalNonAssocSemiring.toMulZeroClass.{0} (ZMod p) (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} (ZMod p) (NonAssocRing.toNonUnitalNonAssocRing.{0} (ZMod p) (Ring.toNonAssocRing.{0} (ZMod p) (CommRing.toRing.{0} (ZMod p) (ZMod.commRing p)))))))))))
but is expected to have type
  forall {a : Int} {p : Nat}, (Nat.Prime p) -> (Ne.{1} Nat (Int.gcd a (Nat.cast.{0} Int instNatCastInt p)) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) -> (Eq.{1} (ZMod p) (Int.cast.{0} (ZMod p) (Ring.toIntCast.{0} (ZMod p) (CommRing.toRing.{0} (ZMod p) (ZMod.commRing p))) a) (OfNat.ofNat.{0} (ZMod p) 0 (Zero.toOfNat0.{0} (ZMod p) (CommMonoidWithZero.toZero.{0} (ZMod p) (CommSemiring.toCommMonoidWithZero.{0} (ZMod p) (CommRing.toCommSemiring.{0} (ZMod p) (ZMod.commRing p)))))))
Case conversion may be inaccurate. Consider using '#align zmod.eq_zero_of_gcd_ne_one ZMod.eq_zero_of_gcd_ne_oneₓ'. -/
/-- If an integer `a` and a prime `p` satisfy `gcd a p ≠ 1`, then `a : zmod p` is zero. -/
theorem eq_zero_of_gcd_ne_one {a : ℤ} {p : ℕ} (pp : p.Prime) (h : a.gcd p ≠ 1) : (a : ZMod p) = 0 :=
  (@eq_zero_iff_gcd_ne_one a p ⟨pp⟩).mpr h
#align zmod.eq_zero_of_gcd_ne_one ZMod.eq_zero_of_gcd_ne_one

end ZMod


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Yury Kudryashov
-/
import algebra.group.defs
import algebra.group.hom
import algebra.group.type_tags
import logic.embedding

/-!
# Definitions of group actions

This file defines a hierarchy of group action type-classes on top of the previously defined
notation classes `has_scalar` and its additive version `has_vadd`:

* `mul_action M α` and its additive version `add_action G P` are typeclasses used for
  actions of multiplicative and additive monoids and groups; they extend notation classes
  `has_scalar` and `has_vadd` that are defined in `algebra.group.defs`;
* `distrib_mul_action M A` is a typeclass for an action of a multiplicative monoid on
  an additive monoid such that `a • (b + c) = a • b + a • c` and `a • 0 = 0`.

The hierarchy is extended further by `module`, defined elsewhere.

Also provided are typeclasses for faithful and transitive actions, and typeclasses regarding the
interaction of different group actions,

* `smul_comm_class M N α` and its additive version `vadd_comm_class M N α`;
* `is_scalar_tower M N α` (no additive version).

## Notation

- `a • b` is used as notation for `has_scalar.smul a b`.
- `a +ᵥ b` is used as notation for `has_vadd.vadd a b`.

## Implementation details

This file should avoid depending on other parts of `group_theory`, to avoid import cycles.
More sophisticated lemmas belong in `group_theory.group_action`.

## Tags

group action
-/

variables {M N G A B α β γ : Type*}

open function

/-!
### Faithful actions
-/

/-- Typeclass for faithful actions. -/
class has_faithful_vadd (G : Type*) (P : Type*) [has_vadd G P] : Prop :=
(eq_of_vadd_eq_vadd : ∀ {g₁ g₂ : G}, (∀ p : P, g₁ +ᵥ p = g₂ +ᵥ p) → g₁ = g₂)

/-- Typeclass for faithful actions. -/
@[to_additive has_faithful_vadd]
class has_faithful_scalar (M : Type*) (α : Type*) [has_scalar M α] : Prop :=
(eq_of_smul_eq_smul : ∀ {m₁ m₂ : M}, (∀ a : α, m₁ • a = m₂ • a) → m₁ = m₂)

export has_faithful_scalar (eq_of_smul_eq_smul) has_faithful_vadd (eq_of_vadd_eq_vadd)

@[to_additive]
lemma smul_left_injective' [has_scalar M α] [has_faithful_scalar M α] :
  function.injective ((•) : M → α → α) :=
λ m₁ m₂ h, has_faithful_scalar.eq_of_smul_eq_smul (congr_fun h)

/-- See also `monoid.to_mul_action` and `mul_zero_class.to_smul_with_zero`. -/
@[priority 910, to_additive] -- see Note [lower instance priority]
instance has_mul.to_has_scalar (α : Type*) [has_mul α] : has_scalar α α := ⟨(*)⟩

@[simp, to_additive] lemma smul_eq_mul (α : Type*) [has_mul α] {a a' : α} : a • a' = a * a' := rfl

/-- Type class for additive monoid actions. -/
@[protect_proj] class add_action (G : Type*) (P : Type*) [add_monoid G] extends has_vadd G P :=
(zero_vadd : ∀ p : P, (0 : G) +ᵥ p = p)
(add_vadd : ∀ (g₁ g₂ : G) (p : P), (g₁ + g₂) +ᵥ p = g₁ +ᵥ (g₂ +ᵥ p))

/-- Typeclass for multiplicative actions by monoids. This generalizes group actions. -/
@[protect_proj, to_additive]
class mul_action (α : Type*) (β : Type*) [monoid α] extends has_scalar α β :=
(one_smul : ∀ b : β, (1 : α) • b = b)
(mul_smul : ∀ (x y : α) (b : β), (x * y) • b = x • y • b)

/-!
### (Pre)transitive action

`M` acts pretransitively on `α` if for any `x y` there is `g` such that `g • x = y` (or `g +ᵥ x = y`
for an additive action). A transitive action should furthermore have `α` nonempty.

In this section we define typeclasses `mul_action.is_pretransitive` and
`add_action.is_pretransitive` and provide `mul_action.exists_smul_eq`/`add_action.exists_vadd_eq`,
`mul_action.surjective_smul`/`add_action.surjective_vadd` as public interface to access this
property. We do not provide typeclasses `*_action.is_transitive`; users should assume
`[mul_action.is_pretransitive M α] [nonempty α]` instead. -/

/-- `M` acts pretransitively on `α` if for any `x y` there is `g` such that `g +ᵥ x = y`.
  A transitive action should furthermore have `α` nonempty. -/
class add_action.is_pretransitive (M α : Type*) [has_vadd M α] : Prop :=
(exists_vadd_eq : ∀ x y : α, ∃ g : M, g +ᵥ x = y)

/-- `M` acts pretransitively on `α` if for any `x y` there is `g` such that `g • x = y`.
  A transitive action should furthermore have `α` nonempty. -/
@[to_additive] class mul_action.is_pretransitive (M α : Type*) [has_scalar M α] : Prop :=
(exists_smul_eq : ∀ x y : α, ∃ g : M, g • x = y)

namespace mul_action

variables (M) {α} [has_scalar M α] [is_pretransitive M α]

@[to_additive] lemma exists_smul_eq (x y : α) : ∃ m : M, m • x = y :=
is_pretransitive.exists_smul_eq x y

@[to_additive] lemma surjective_smul (x : α) : surjective (λ c : M, c • x) := exists_smul_eq M x

/-- The regular action of a group on itself is transitive. -/
@[to_additive] instance regular.is_pretransitive [group G] : is_pretransitive G G :=
⟨λ x y, ⟨y * x⁻¹, inv_mul_cancel_right _ _⟩⟩

end mul_action

/-!
### Scalar tower and commuting actions
-/

/-- A typeclass mixin saying that two additive actions on the same space commute. -/
class vadd_comm_class (M N α : Type*) [has_vadd M α] [has_vadd N α] : Prop :=
(vadd_comm : ∀ (m : M) (n : N) (a : α), m +ᵥ (n +ᵥ a) = n +ᵥ (m +ᵥ a))

/-- A typeclass mixin saying that two multiplicative actions on the same space commute. -/
@[to_additive] class smul_comm_class (M N α : Type*) [has_scalar M α] [has_scalar N α] : Prop :=
(smul_comm : ∀ (m : M) (n : N) (a : α), m • n • a = n • m • a)

export mul_action (mul_smul) add_action (add_vadd) smul_comm_class (smul_comm)
  vadd_comm_class (vadd_comm)

/--
Frequently, we find ourselves wanting to express a bilinear map `M →ₗ[R] N →ₗ[R] P` or an
equivalence between maps `(M →ₗ[R] N) ≃ₗ[R] (M' →ₗ[R] N')` where the maps have an associated ring
`R`. Unfortunately, using definitions like these requires that `R` satisfy `comm_semiring R`, and
not just `semiring R`. Using `M →ₗ[R] N →+ P` and `(M →ₗ[R] N) ≃+ (M' →ₗ[R] N')` avoids this
problem, but throws away structure that is useful for when we _do_ have a commutative (semi)ring.

To avoid making this compromise, we instead state these definitions as `M →ₗ[R] N →ₗ[S] P` or
`(M →ₗ[R] N) ≃ₗ[S] (M' →ₗ[R] N')` and require `smul_comm_class S R` on the appropriate modules. When
the caller has `comm_semiring R`, they can set `S = R` and `smul_comm_class_self` will populate the
instance. If the caller only has `semiring R` they can still set either `R = ℕ` or `S = ℕ`, and
`add_comm_monoid.nat_smul_comm_class` or `add_comm_monoid.nat_smul_comm_class'` will populate
the typeclass, which is still sufficient to recover a `≃+` or `→+` structure.

An example of where this is used is `linear_map.prod_equiv`.
-/
library_note "bundled maps over different rings"

/-- Commutativity of actions is a symmetric relation. This lemma can't be an instance because this
would cause a loop in the instance search graph. -/
@[to_additive] lemma smul_comm_class.symm (M N α : Type*) [has_scalar M α] [has_scalar N α]
  [smul_comm_class M N α] : smul_comm_class N M α :=
⟨λ a' a b, (smul_comm a a' b).symm⟩

/-- Commutativity of additive actions is a symmetric relation. This lemma can't be an instance
because this would cause a loop in the instance search graph. -/
add_decl_doc vadd_comm_class.symm

@[to_additive] instance smul_comm_class_self (M α : Type*) [comm_monoid M] [mul_action M α] :
  smul_comm_class M M α :=
⟨λ a a' b, by rw [← mul_smul, mul_comm, mul_smul]⟩

/-- An instance of `is_scalar_tower M N α` states that the multiplicative
action of `M` on `α` is determined by the multiplicative actions of `M` on `N`
and `N` on `α`. -/
class is_scalar_tower (M N α : Type*) [has_scalar M N] [has_scalar N α] [has_scalar M α] : Prop :=
(smul_assoc : ∀ (x : M) (y : N) (z : α), (x • y) • z = x • (y • z))

@[simp] lemma smul_assoc {M N} [has_scalar M N] [has_scalar N α] [has_scalar M α]
  [is_scalar_tower M N α] (x : M) (y : N) (z : α) :
  (x • y) • z = x • y • z :=
is_scalar_tower.smul_assoc x y z

instance semigroup.is_scalar_tower [semigroup α] : is_scalar_tower α α α := ⟨mul_assoc⟩

namespace has_scalar
variables [has_scalar M α]

/-- Auxiliary definition for `has_scalar.comp`, `mul_action.comp_hom`,
`distrib_mul_action.comp_hom`, `module.comp_hom`, etc. -/
@[simp, to_additive  /-" Auxiliary definition for `has_vadd.comp`, `add_action.comp_hom`, etc. "-/]
def comp.smul (g : N → M) (n : N) (a : α) : α :=
g n • a

variables (α)

/-- An action of `M` on `α` and a function `N → M` induces an action of `N` on `α`.

See note [reducible non-instances]. Since this is reducible, we make sure to go via
`has_scalar.comp.smul` to prevent typeclass inference unfolding too far. -/
@[reducible, to_additive /-" An additive action of `M` on `α` and a function `N → M` induces
  an additive action of `N` on `α` "-/]
def comp (g : N → M) : has_scalar N α :=
{ smul := has_scalar.comp.smul g }

variables {α}

/-- Given a tower of scalar actions `M → α → β`, if we use `has_scalar.comp`
to pull back both of `M`'s actions by a map `g : N → M`, then we obtain a new
tower of scalar actions `N → α → β`.

This cannot be an instance because it can cause infinite loops whenever the `has_scalar` arguments
are still metavariables.
-/
@[priority 100]
lemma comp.is_scalar_tower [has_scalar M β] [has_scalar α β] [is_scalar_tower M α β]
  (g : N → M) :
  (by haveI := comp α g; haveI := comp β g; exact is_scalar_tower N α β) :=
by exact {smul_assoc := λ n, @smul_assoc _ _ _ _ _ _ _ (g n) }

@[priority 100]
instance comp.smul_comm_class [has_scalar β α] [smul_comm_class M β α] (g : N → M) :
  (by haveI := comp α g; exact smul_comm_class N β α) :=
by exact {smul_comm := λ n, @smul_comm _ _ _ _ _ _ (g n) }

@[priority 100]
instance comp.smul_comm_class' [has_scalar β α] [smul_comm_class β M α] (g : N → M) :
  (by haveI := comp α g; exact smul_comm_class β N α) :=
by exact {smul_comm := λ _ n, @smul_comm _ _ _ _ _ _ _ (g n) }

end has_scalar

section ite
variables [has_scalar M α] (p : Prop) [decidable p]

@[to_additive] lemma ite_smul (a₁ a₂ : M) (b : α) : (ite p a₁ a₂) • b = ite p (a₁ • b) (a₂ • b) :=
by split_ifs; refl

@[to_additive] lemma smul_ite (a : M) (b₁ b₂ : α) : a • (ite p b₁ b₂) = ite p (a • b₁) (a • b₂) :=
by split_ifs; refl

end ite

section
variables [monoid M] [mul_action M α]

@[to_additive] lemma smul_smul (a₁ a₂ : M) (b : α) : a₁ • a₂ • b = (a₁ * a₂) • b :=
(mul_smul _ _ _).symm

variable (M)
@[simp, to_additive] theorem one_smul (b : α) : (1 : M) • b = b := mul_action.one_smul _

variables {M}

/-- Pullback a multiplicative action along an injective map respecting `•`.
See note [reducible non-instances]. -/
@[reducible, to_additive "Pullback an additive action along an injective map respecting `+ᵥ`."]
protected def function.injective.mul_action [has_scalar M β] (f : β → α)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_action M β :=
{ smul := (•),
  one_smul := λ x, hf $ (smul _ _).trans $ one_smul _ (f x),
  mul_smul := λ c₁ c₂ x, hf $ by simp only [smul, mul_smul] }

/-- Pushforward a multiplicative action along a surjective map respecting `•`.
See note [reducible non-instances]. -/
@[reducible, to_additive "Pushforward an additive action along a surjective map respecting `+ᵥ`."]
protected def function.surjective.mul_action [has_scalar M β] (f : α → β) (hf : surjective f)
  (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_action M β :=
{ smul := (•),
  one_smul := λ y, by { rcases hf y with ⟨x, rfl⟩, rw [← smul, one_smul] },
  mul_smul := λ c₁ c₂ y, by { rcases hf y with ⟨x, rfl⟩, simp only [← smul, mul_smul] } }

/-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →* S`.

See also `function.surjective.distrib_mul_action_left` and `function.surjective.module_left`.
-/
@[reducible, to_additive "Push forward the action of `R` on `M` along a compatible
surjective map `f : R →+ S`."]
def function.surjective.mul_action_left {R S M : Type*} [monoid R] [mul_action R M]
  [monoid S] [has_scalar S M]
  (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  mul_action S M :=
{ smul := (•),
  one_smul := λ b, by rw [← f.map_one, hsmul, one_smul],
  mul_smul := hf.forall₂.mpr $ λ a b x, by simp only [← f.map_mul, hsmul, mul_smul] }

section

variables (M)

/-- The regular action of a monoid on itself by left multiplication.

This is promoted to a module by `semiring.to_module`. -/
@[priority 910, to_additive] -- see Note [lower instance priority]
instance monoid.to_mul_action : mul_action M M :=
{ smul := (*),
  one_smul := one_mul,
  mul_smul := mul_assoc }

/-- The regular action of a monoid on itself by left addition.

This is promoted to an `add_torsor` by `add_group_is_add_torsor`. -/
add_decl_doc add_monoid.to_add_action

instance is_scalar_tower.left : is_scalar_tower M M α :=
⟨λ x y z, mul_smul x y z⟩

variables {M}

/-- Note that the `smul_comm_class α β β` typeclass argument is usually satisfied by `algebra α β`.
-/
@[to_additive]
lemma mul_smul_comm [has_mul β] [has_scalar α β] [smul_comm_class α β β] (s : α) (x y : β) :
  x * (s • y) = s • (x * y) :=
(smul_comm s x y).symm

/-- Note that the `is_scalar_tower α β β` typeclass argument is usually satisfied by `algebra α β`.
-/
lemma smul_mul_assoc [has_mul β] [has_scalar α β] [is_scalar_tower α β β] (r : α) (x y : β)  :
  (r • x) * y = r • (x * y) :=
smul_assoc r x y

/-- Note that the `is_scalar_tower M α α` and `smul_comm_class M α α` typeclass arguments are
usually satisfied by `algebra M α`. -/
lemma smul_mul_smul [has_mul α] (r s : M) (x y : α)
  [is_scalar_tower M α α] [smul_comm_class M α α] :
  (r • x) * (s • y) = (r * s) • (x * y) :=
by rw [smul_mul_assoc, mul_smul_comm, ← smul_assoc, smul_eq_mul]

end

namespace mul_action

variables (M α)

/-- Embedding of `α` into functions `M → α` induced by a multiplicative action of `M` on `α`. -/
@[to_additive] def to_fun : α ↪ (M → α) :=
⟨λ y x, x • y, λ y₁ y₂ H, one_smul M y₁ ▸ one_smul M y₂ ▸ by convert congr_fun H 1⟩

/-- Embedding of `α` into functions `M → α` induced by an additive action of `M` on `α`. -/
add_decl_doc add_action.to_fun

variables {M α}

@[simp, to_additive] lemma to_fun_apply (x : M) (y : α) : mul_action.to_fun M α y x = x • y :=
rfl

variable (α)

/-- A multiplicative action of `M` on `α` and a monoid homomorphism `N → M` induce
a multiplicative action of `N` on `α`.

See note [reducible non-instances]. -/
@[reducible, to_additive] def comp_hom [monoid N] (g : N →* M) :
  mul_action N α :=
{ smul := has_scalar.comp.smul g,
  one_smul := by simp [g.map_one, mul_action.one_smul],
  mul_smul := by simp [g.map_mul, mul_action.mul_smul] }

/-- An additive action of `M` on `α` and an additive monoid homomorphism `N → M` induce
an additive action of `N` on `α`.

See note [reducible non-instances]. -/
add_decl_doc add_action.comp_hom

end mul_action

end

section compatible_scalar

@[simp] lemma smul_one_smul {M} (N) [monoid N] [has_scalar M N] [mul_action N α] [has_scalar M α]
  [is_scalar_tower M N α] (x : M) (y : α) :
  (x • (1 : N)) • y = x • y :=
by rw [smul_assoc, one_smul]

@[simp] lemma smul_one_mul {M N} [monoid N] [has_scalar M N] [is_scalar_tower M N N] (x : M)
  (y : N) : (x • 1) * y = x • y :=
smul_one_smul N x y

@[simp, to_additive] lemma mul_smul_one {M N} [monoid N] [has_scalar M N] [smul_comm_class M N N]
  (x : M) (y : N) :
  y * (x • 1) = x • y :=
by rw [← smul_eq_mul, ← smul_comm, smul_eq_mul, mul_one]

lemma is_scalar_tower.of_smul_one_mul {M N} [monoid N] [has_scalar M N]
  (h : ∀ (x : M) (y : N), (x • (1 : N)) * y = x • y) :
  is_scalar_tower M N N :=
⟨λ x y z, by rw [← h, smul_eq_mul, mul_assoc, h, smul_eq_mul]⟩

@[to_additive] lemma smul_comm_class.of_mul_smul_one {M N} [monoid N] [has_scalar M N]
  (H : ∀ (x : M) (y : N), y * (x • (1 : N)) = x • y) : smul_comm_class M N N :=
⟨λ x y z, by rw [← H x z, smul_eq_mul, ← H, smul_eq_mul, mul_assoc]⟩

end compatible_scalar

/-- Typeclass for multiplicative actions on additive structures. This generalizes group modules. -/
class distrib_mul_action (M : Type*) (A : Type*) [monoid M] [add_monoid A]
  extends mul_action M A :=
(smul_add : ∀(r : M) (x y : A), r • (x + y) = r • x + r • y)
(smul_zero : ∀(r : M), r • (0 : A) = 0)

section
variables [monoid M] [add_monoid A] [distrib_mul_action M A]

theorem smul_add (a : M) (b₁ b₂ : A) : a • (b₁ + b₂) = a • b₁ + a • b₂ :=
distrib_mul_action.smul_add _ _ _

@[simp] theorem smul_zero (a : M) : a • (0 : A) = 0 :=
distrib_mul_action.smul_zero _

/-- Pullback a distributive multiplicative action along an injective additive monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.distrib_mul_action [add_monoid B] [has_scalar M B] (f : B →+ A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  smul_add := λ c x y, hf $ by simp only [smul, f.map_add, smul_add],
  smul_zero := λ c, hf $ by simp only [smul, f.map_zero, smul_zero],
  .. hf.mul_action f smul }

/-- Pushforward a distributive multiplicative action along a surjective additive monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.distrib_mul_action [add_monoid B] [has_scalar M B] (f : A →+ B)
  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  smul_add := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
    simp only [smul_add, ← smul, ← f.map_add] },
  smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero],
  .. hf.mul_action f smul }

/-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →* S`.

See also `function.surjective.mul_action_left` and `function.surjective.module_left`.
-/
@[reducible]
def function.surjective.distrib_mul_action_left {R S M : Type*} [monoid R] [add_monoid M]
  [distrib_mul_action R M] [monoid S] [has_scalar S M]
  (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  distrib_mul_action S M :=
{ smul := (•),
  smul_zero := hf.forall.mpr $ λ c, by rw [hsmul, smul_zero],
  smul_add := hf.forall.mpr $ λ c x y, by simp only [hsmul, smul_add],
  .. hf.mul_action_left f hsmul }

variable (A)

/-- Compose a `distrib_mul_action` with a `monoid_hom`, with action `f r' • m`.
See note [reducible non-instances]. -/
@[reducible] def distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
  distrib_mul_action N A :=
{ smul := has_scalar.comp.smul f,
  smul_zero := λ x, smul_zero (f x),
  smul_add := λ x, smul_add (f x),
  .. mul_action.comp_hom A f }

/-- Each element of the monoid defines a additive monoid homomorphism. -/
@[simps]
def distrib_mul_action.to_add_monoid_hom (x : M) : A →+ A :=
{ to_fun := (•) x,
  map_zero' := smul_zero x,
  map_add' := smul_add x }

variables (M)

/-- Each element of the monoid defines an additive monoid homomorphism. -/
@[simps]
def distrib_mul_action.to_add_monoid_End : M →* add_monoid.End A :=
{ to_fun := distrib_mul_action.to_add_monoid_hom A,
  map_one' := add_monoid_hom.ext $ one_smul M,
  map_mul' := λ x y, add_monoid_hom.ext $ mul_smul x y }

end

section
variables [monoid M] [add_group A] [distrib_mul_action M A]

@[simp] theorem smul_neg (r : M) (x : A) : r • (-x) = -(r • x) :=
eq_neg_of_add_eq_zero $ by rw [← smul_add, neg_add_self, smul_zero]

theorem smul_sub (r : M) (x y : A) : r • (x - y) = r • x - r • y :=
by rw [sub_eq_add_neg, sub_eq_add_neg, smul_add, smul_neg]

end

/-- Typeclass for multiplicative actions on multiplicative structures. This generalizes
conjugation actions. -/
class mul_distrib_mul_action (M : Type*) (A : Type*) [monoid M] [monoid A]
  extends mul_action M A :=
(smul_mul : ∀ (r : M) (x y : A), r • (x * y) = (r • x) * (r • y))
(smul_one : ∀ (r : M), r • (1 : A) = 1)

export mul_distrib_mul_action (smul_one)

section
variables [monoid M] [monoid A] [mul_distrib_mul_action M A]

theorem smul_mul' (a : M) (b₁ b₂ : A) : a • (b₁ * b₂) = (a • b₁) * (a • b₂) :=
mul_distrib_mul_action.smul_mul _ _ _

/-- Pullback a multiplicative distributive multiplicative action along an injective monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_distrib_mul_action [monoid B] [has_scalar M B] (f : B →* A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_distrib_mul_action M B :=
{ smul := (•),
  smul_mul := λ c x y, hf $ by simp only [smul, f.map_mul, smul_mul'],
  smul_one := λ c, hf $ by simp only [smul, f.map_one, smul_one],
  .. hf.mul_action f smul }

/-- Pushforward a multiplicative distributive multiplicative action along a surjective monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_distrib_mul_action [monoid B] [has_scalar M B] (f : A →* B)
  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_distrib_mul_action M B :=
{ smul := (•),
  smul_mul := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
    simp only [smul_mul', ← smul, ← f.map_mul] },
  smul_one := λ c, by simp only [← f.map_one, ← smul, smul_one],
  .. hf.mul_action f smul }

variable (A)

/-- Compose a `mul_distrib_mul_action` with a `monoid_hom`, with action `f r' • m`.
See note [reducible non-instances]. -/
@[reducible] def mul_distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
  mul_distrib_mul_action N A :=
{ smul := has_scalar.comp.smul f,
  smul_one := λ x, smul_one (f x),
  smul_mul := λ x, smul_mul' (f x),
  .. mul_action.comp_hom A f }

/-- Scalar multiplication by `r` as a `monoid_hom`. -/
def mul_distrib_mul_action.to_monoid_hom (r : M) : A →* A :=
{ to_fun := (•) r,
  map_one' := smul_one r,
  map_mul' := smul_mul' r }

variable {A}

@[simp] lemma mul_distrib_mul_action.to_monoid_hom_apply (r : M) (x : A) :
  mul_distrib_mul_action.to_monoid_hom A r x = r • x := rfl

variables (M A)

/-- Each element of the monoid defines a monoid homomorphism. -/
@[simps]
def mul_distrib_mul_action.to_monoid_End : M →* monoid.End A :=
{ to_fun := mul_distrib_mul_action.to_monoid_hom A,
  map_one' := monoid_hom.ext $ one_smul M,
  map_mul' := λ x y, monoid_hom.ext $ mul_smul x y }

end

section
variables [monoid M] [group A] [mul_distrib_mul_action M A]

@[simp] theorem smul_inv' (r : M) (x : A) : r • (x⁻¹) = (r • x)⁻¹ :=
(mul_distrib_mul_action.to_monoid_hom A r).map_inv x

theorem smul_div' (r : M) (x y : A) : r • (x / y) = (r • x) / (r • y) :=
(mul_distrib_mul_action.to_monoid_hom A r).map_div x y

end

variable (α)

/-- The monoid of endomorphisms.

Note that this is generalized by `category_theory.End` to categories other than `Type u`. -/
protected def function.End := α → α

instance : monoid (function.End α) :=
{ one := id,
  mul := (∘),
  mul_assoc := λ f g h, rfl,
  mul_one := λ f, rfl,
  one_mul := λ f, rfl, }

instance : inhabited (function.End α) := ⟨1⟩

variable {α}

/-- The tautological action by `function.End α` on `α`.

This is generalized to bundled endomorphisms by:
* `equiv.perm.apply_mul_action`
* `add_monoid.End.apply_distrib_mul_action`
* `add_aut.apply_distrib_mul_action`
* `mul_aut.apply_mul_distrib_mul_action`
* `ring_hom.apply_distrib_mul_action`
* `linear_equiv.apply_distrib_mul_action`
* `linear_map.apply_module`
* `ring_hom.apply_mul_semiring_action`
* `alg_equiv.apply_mul_semiring_action`
-/
instance function.End.apply_mul_action : mul_action (function.End α) α :=
{ smul := ($),
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] lemma function.End.smul_def (f : function.End α) (a : α) : f • a = f a := rfl

/-- `function.End.apply_mul_action` is faithful. -/
instance function.End.apply_has_faithful_scalar : has_faithful_scalar (function.End α) α :=
⟨λ x y, funext⟩

/-- The tautological action by `add_monoid.End α` on `α`.

This generalizes `function.End.apply_mul_action`. -/
instance add_monoid.End.apply_distrib_mul_action [add_monoid α] :
  distrib_mul_action (add_monoid.End α) α :=
{ smul := ($),
  smul_zero := add_monoid_hom.map_zero,
  smul_add := add_monoid_hom.map_add,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] lemma add_monoid.End.smul_def [add_monoid α] (f : add_monoid.End α) (a : α) :
  f • a = f a := rfl

/-- `add_monoid.End.apply_distrib_mul_action` is faithful. -/
instance add_monoid.End.apply_has_faithful_scalar [add_monoid α] :
  has_faithful_scalar (add_monoid.End α) α :=
⟨add_monoid_hom.ext⟩

/-- The monoid hom representing a monoid action.

When `M` is a group, see `mul_action.to_perm_hom`. -/
def mul_action.to_End_hom [monoid M] [mul_action M α] : M →* function.End α :=
{ to_fun := (•),
  map_one' := funext (one_smul M),
  map_mul' := λ x y, funext (mul_smul x y) }

/-- The monoid action induced by a monoid hom to `function.End α`

See note [reducible non-instances]. -/
@[reducible]
def mul_action.of_End_hom [monoid M] (f : M →* function.End α) : mul_action M α :=
mul_action.comp_hom α f

/-- The tautological additive action by `additive (function.End α)` on `α`. -/
instance add_action.function_End : add_action (additive (function.End α)) α :=
{ vadd := ($),
  zero_vadd := λ _, rfl,
  add_vadd := λ _ _ _, rfl }

/-- The additive monoid hom representing an additive monoid action.

When `M` is a group, see `add_action.to_perm_hom`. -/
def add_action.to_End_hom [add_monoid M] [add_action M α] : M →+ additive (function.End α) :=
{ to_fun := (+ᵥ),
  map_zero' := funext (zero_vadd M),
  map_add' := λ x y, funext (add_vadd x y) }

/-- The additive action induced by a hom to `additive (function.End α)`

See note [reducible non-instances]. -/
@[reducible]
def add_action.of_End_hom [add_monoid M] (f : M →+ additive (function.End α)) : add_action M α :=
add_action.comp_hom α f


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

import linear_algebra.pi_tensor_product
import logic.equiv.fin
import algebra.direct_sum.algebra

/-!
# Tensor power of a semimodule over a commutative semirings

We define the `n`th tensor power of `M` as the n-ary tensor product indexed by `fin n` of `M`,
`⨂[R] (i : fin n), M`. This is a special case of `pi_tensor_product`.

This file introduces the notation `⨂[R]^n M` for `tensor_power R n M`, which in turn is an
abbreviation for `⨂[R] i : fin n, M`.

## Main definitions:

* `tensor_power.ghas_one`
* `tensor_power.ghas_mul`

## TODO

Show `direct_sum.galgebra R (λ i, ⨂[R]^i M)` and `algebra R (⨁ n : ℕ, ⨂[R]^n M)`.

## Implementation notes

In this file we use `ₜ1` and `ₜ*` as local notation for the graded multiplicative structure on
tensor powers. Elsewhere, using `1` and `*` on `graded_monoid` should be preferred.
-/

open_locale tensor_product

/-- Homogenous tensor powers $M^{\otimes n}$. `⨂[R]^n M` is a shorthand for
`⨂[R] (i : fin n), M`. -/
@[reducible] protected def tensor_power (R : Type*) (n : ℕ) (M : Type*)
  [comm_semiring R] [add_comm_monoid M] [module R M] : Type* :=
⨂[R] i : fin n, M

variables {R : Type*} {M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]

localized "notation `⨂[`:100 R `]^`:80 n:max := tensor_power R n"
  in tensor_product

namespace tensor_power
open_locale tensor_product direct_sum
open pi_tensor_product

/-- As a graded monoid, `⨂[R]^i M` has a `1 : ⨂[R]^0 M`. -/
instance ghas_one : graded_monoid.ghas_one (λ i, ⨂[R]^i M) :=
{ one := tprod R fin.elim0 }

local notation `ₜ1` := @graded_monoid.ghas_one.one ℕ (λ i, ⨂[R]^i M) _ _

lemma ghas_one_def : ₜ1 = tprod R fin.elim0 := rfl

/-- A variant of `pi_tensor_prod.tmul_equiv` with the result indexed by `fin (n + m)`. -/
def mul_equiv {n m : ℕ} : (⨂[R]^n M) ⊗[R] (⨂[R]^m M) ≃ₗ[R] ⨂[R]^(n + m) M :=
(tmul_equiv R M).trans (reindex R M fin_sum_fin_equiv)

/-- As a graded monoid, `⨂[R]^i M` has a `(*) : ⨂[R]^i M → ⨂[R]^j M → ⨂[R]^(i + j) M`. -/
instance ghas_mul : graded_monoid.ghas_mul (λ i, ⨂[R]^i M) :=
{ mul := λ i j a b, mul_equiv (a ⊗ₜ b) }

local infix `ₜ*`:70 := @graded_monoid.ghas_mul.mul ℕ (λ i, ⨂[R]^i M) _ _ _ _

lemma ghas_mul_def {i j} (a : ⨂[R]^i M) (b : ⨂[R]^j M) : a ₜ* b = mul_equiv (a ⊗ₜ b) := rfl

end tensor_power


-- necessary operations
abbrev ℝ := Float

def inverse (f : α → β) : β → α := sorry
postfix:max (priority:=high) " ⁻¹ " => inverse

def derivative (f : ℝ → ℝ) : ℝ → ℝ := sorry
macro (priority:=high) " ⅆ " "(" x:ident ":=" xval:term ")" "," fval:term : term => `((derivative λ $x => $fval) $xval )

-- internal energy -------------------------------------------------------------
def U (S : ℝ) (V : ℝ) : ℝ := sorry

-- definition of temperature and pressure as functions of entropy and volume
def T_sv (s v) := ⅆ (s':=s), U s' v
def P_sv (s v) := - ⅆ (v':=v), U s v'

theorem MaxwellRelation1 (s v)
  : (ⅆ (v':=v), T_sv s v') = - (ⅆ (s':=s), P_sv s' v) :=
by
  unfold T_sv P_sv
  -- swap derivatives and we are done
  admit

-- Enthalpy --------------------------------------------------------------------

-- volume and temperature as functions of entropy and pressure
-- change of variables comming from Legandre transform
def V_sp (s p : ℝ) := (λ v => P_sv s v)⁻¹ p
def T_sp (s p : ℝ) := T_sv s (V_sp s p)

-- Enthalpy
-- H is leganre transform of U w.r.t. to V variable
def H (s p : ℝ) : ℝ := U s (T_sp s p) - p * T_sp s p

theorem enthalpy_temperature (s p) : T_sp s p = (ⅆ (s':=s), H s' p) := sorry
theorem enthalpy_volume      (s p) : V_sp s p = (ⅆ (p':=p), H s p') := sorry

theorem MaxwellRelation2 (s p)
  : (ⅆ (p':=p), T_sp s p') = (ⅆ (s':=s), V_sp s' p) :=
by
  simp only [enthalpy_temperature, enthalpy_volume]
  -- swap derivatives and we are done
  admit

-- Helmholtz -------------------------------------------------------------------

-- entropy and pressure as functions of temperature and volume
def S_tv (t v : ℝ) := (λ s => T_sv s v)⁻¹ t
def P_tv (t v : ℝ) := P_sv (S_tv t v) v

-- Helmholtz free energy
-- F is leganre transform of U w.r.t. to S variable
def F (t v : ℝ) : ℝ := U (S_tv t v) v - t * S_tv t v

theorem helmholtz_pressure (t v : ℝ) : P_tv t v = - (ⅆ (v':=v), F t v') := sorry
theorem helmholtz_entropy  (t v : ℝ) : S_tv t v = - (ⅆ (t':=t), F t' v) := sorry

theorem MaxwellRelation3 (t v)
  : (ⅆ (v':=v), S_tv t v') = (ⅆ (t':=t), P_tv t' v) :=
by
  simp only [helmholtz_pressure,helmholtz_entropy]
  -- swap derivatives and we are done
  admit