import analysis.special_functions.integrals
import data.nat.basic
import data.nat.prime
import data.nat.prime_norm_num
import data.real.basic
import data.matrix.basic
import measure_theory.measure.measure_space
import measure_theory.integral.interval_integral
import number_theory.bernoulli
import number_theory.bernoulli_polynomials
import number_theory.von_mangoldt
import number_theory.well_approximable
import probability.probability_mass_function.basic
import tactic

open nat real ennreal finset measure_theory interval_integral nat.arithmetic_function
open_locale nat ennreal interval measure_theory polynomial big_operators arithmetic_function

example {a b : ℕ} (h : a < b) : a + 1 ≤ b :=
begin
  library_search!,
end

example : ¬ nat.prime 0 :=
begin
  exact nat.not_prime_zero,
end

example : nat.prime 17 :=
begin
  norm_num,
end

namespace polynomial

example {Y : ℚ[X]} : (Y + 1).aeval ((X : ℚ[X]) ^ 2) = Y ^ 2 + 2 * Y + 1 :=
begin
  simp,
  ring_nf,
end

example {x : ℚ} : eval x (1 - (X : ℚ[X])) = 1 - x :=
begin
  rw [eval_sub, eval_one, eval_X],
end

example {x : ℚ} {n : ℕ}: eval x ((-1 : ℚ[X])^n) = (-1) ^ n :=
begin
  show_term {simp,},
end

example {n : ℕ} : ((-1 : ℤ) ^ n) * ((-1) ^ n) = 1 :=
begin
  rw [← mul_pow, neg_one_mul, neg_neg, one_pow],
end

example {n : ℚ} : n - n = 0 :=
begin
  library_search!,
end

-- f(g(x))
example {f g : ℚ[X]} : aeval g f = f.comp g :=
begin
  simp [aeval, comp, eval₂_ring_hom'],
  exact rfl,
end

example {f g : ℚ[X]} : aeval g f = f.comp g :=
begin
  exact rfl,
end

example {f g : ℚ[X]} : (aeval g f).derivative = (aeval g f.derivative) * g.derivative :=
begin
  change (f.comp g).derivative = f.derivative.comp g * g.derivative,
  rw [derivative_comp, mul_comm],
end

example {a b c d : ℚ[X]} : a * b * (c * d) = a * b * c * d :=
begin
  ring,
end

example {A B C D : Type} (f : A → B → C → D) (g : A → B) (x : A) (z : C) : D :=
begin
  exact f x (g x) z,
end

example {n : ℕ} {q : ℚ} : (-1) ^ n * (bernoulli n).eval 0 = (bernoulli n).eval 1 :=
begin
  simp, -- (-1) ^ n * bernoulli n = bernoulli' n, but as numbers, not polynomials
  rw [_root_.bernoulli, ← mul_assoc, ← mul_pow, mul_neg_one, neg_neg, one_pow, one_mul],
end

example {a b c : ℚ[X]} : a * b * c = b * a * c :=
begin
  show_term {simp},
end

example {n : ℕ} : n = (2 ^ 2000) + 1 :=
begin
  norm_num,
end

example {q : ℚ} : q = q.num * (1 / q.denom) :=
begin
  rcases q with ⟨m, n, n_pos, mn_coprime⟩,
  simp,
  rw [eq_comm, mul_inv_eq_iff_eq_mul₀, rat.mul_denom_eq_num],
  -- hint,
end

example {α : Type*} {x y : α} : x = y ↔ y = x :=
begin
  library_search!,
end

example {x y : ℚ} (h : -x = -y) : x = y :=
begin
  library_search!,
end

example : true :=
begin
  let real_basis := basis.of_vector_space ℚ ℝ,
  let real_index_set : set ℝ := basis.of_vector_space_index ℚ ℝ,

  -- we prove that the set is nonempty
  have real_index_set_nonempty : real_index_set.nonempty,
  { rw ← set.nonempty_coe_sort, exact real_basis.index_nonempty, },
  let real_basis_vec₁ := set.nonempty.some real_index_set_nonempty,

  -- we prove that the set is infinite
  have real_index_set_infinite : real_index_set.infinite,
  {
    -- TODO: Add proof by showing that for a transcendental x,
    -- 1, x, x^2, ... are linearly independent, so any basis is infinite
    sorry,
  },

  -- then we can choose some basis vectors
  let real_index_nat_embedding := set.infinite.nat_embedding real_index_set real_index_set_infinite,
  let real_basis_vec₀ := real_index_nat_embedding 0,
  let real_basis_vec₁ := real_index_nat_embedding 1,

  -- they are not equal
  have real_basis_vec₀_ne_real_basis_vec₁: real_basis_vec₀ ≠ real_basis_vec₁,
  {
    by_contradiction,
    linarith [real_index_nat_embedding.injective h],
  },

  let f_map : real_index_set → ℝ := λ index, real_basis_vec₁,
  let f := real_basis.constr ℝ f_map,

  -- verifies cauchy's
  have : ∀ x y, f (x + y) = f x + f y,
  { intros x y, apply f.map_add', },

  -- verifies non-linear
  let x₀ : ℝ := real_basis real_basis_vec₀,
  let x₁ : ℝ := real_basis real_basis_vec₁,
  have : ∃ x, f x ≠ x * f 1,
  {
    by_contradiction,
    push_neg at h,
    have h₀ := h x₀,
    have h₁ := h x₁,
    conv_lhs at h₀ { simp only [f, x₀, basis.constr_basis, f_map] },
    conv_lhs at h₁ { simp only [f, x₀, basis.constr_basis, f_map] },
    rw [h₁, mul_eq_mul_right_iff] at h₀,
    cases h₀,
    {
      simp only [x₀, x₁] at h₀,
      exact real_basis_vec₀_ne_real_basis_vec₁.symm (real_basis.injective h₀),
    },
    {
      rw linear_map.map_eq_zero_iff at h₀,
      linarith,
    }
  }
end

example {a b b' c : ℝ} (hc : c ≠ 0) (h : a = b * c) (h' : a = b' * c) : b = b' :=
begin
  rw [h, mul_eq_mul_right_iff] at h',
  exact (or_iff_left hc).1 h',
end

example {P Q : Prop} (h : P ∨ Q) (h' : ¬Q) : P :=
begin
  library_search!,
end

example : ite (1 = 1) 2 3 = 2 :=
begin
  dec_trivial,
end

example : ↑(↑(3 : ℤ) / ↑(2 : ℤ) : ℚ).denom = (2 : ℤ) :=
begin
  rw rat.denom_div_eq_of_coprime; norm_num,
end

example {a b c : ℚ} : a / b * c = a * c / b :=
begin
  simp only [div_eq_mul_inv, mul_assoc, mul_comm b⁻¹ c],
end

example {q : ℚ} {c : ℤ}
  (h : ↑q.denom ∣ q.num * c)
  (h' : coprime q.denom q.num.nat_abs)
: ↑q.denom ∣ c :=
begin
  exact int.dvd_of_dvd_mul_right_of_gcd_one h h',
end

example {a b : ℤ} : (a : ℚ) * (b : ℚ) = ↑(a * b) :=
begin
  rw int.cast_mul,
end

example {a b c : ℤ} (h : a ∣ c) : a ∣ b * c :=
begin
  exact dvd_mul_of_dvd_right h b,
end

example {a b c : ℕ} (h : a ∣ b) : a ∣ b.lcm c :=
begin
  exact dvd_trans h (nat.dvd_lcm_left _ _),
end

example {P Q : Prop} (h : ¬P ↔ ¬Q) : P ↔ Q :=
iff.trans (iff.trans not_not.symm (not_iff_not_of_iff h)) not_not

example {P Q : Prop} (h : P ↔ Q) (h' : Q) : P := (iff.symm h).1 h'

example {P Q : Prop} (h': P) : P ↔ Q :=
begin
  rw [iff_true_intro h', true_iff],
end

example {α : Type*} [non_assoc_ring α] (m n : ℤ) : ((m * n : ℤ) : α) = m * n :=
begin
  refine int.induction_on' m 0 _ _ _,
  { simp },
  { intros _ ih, simp [add_mul, ih] },
  { intros _ ih, simp [sub_mul, ih] },
end

example {α : Type*} [division_ring α] [char_zero α] (q : ℚ) :
(q : α) = ↑q.num / ↑q.denom :=
begin
  conv_lhs { rw ← rat.num_div_denom q },
  rw [rat.cast_div, rat.cast_coe_int, rat.cast_coe_nat],
end

example {f : ℕ+ → ℚ} (h : summable f): summable (λ n : ℕ+, f n * n / n) :=
begin
  -- simp_rw looks inside binders like λ
  -- You have to provide the full statement, hence the `show ∀ ...` then `_`
  simp_rw [← mul_div, div_self ((show ∀ n : ℕ+, (n : ℚ) ≠ 0, by simp) _), mul_one, h],
end

end polynomial

example {n : ℕ} {S : finset ℕ} (h : S = filter nat.prime (Icc 1 n)):
S.sum (λ p, ite (nat.prime p) 1 0) = S.sum (λ p, 1) :=
begin
  -- rw finset.sum_congr,
  simp,
  -- show_term { squeeze_simp [h] },
end

-- Approach 1, using `conv`
example {n : ℕ} : ∫ x : ℝ in 0..1, (-x) ^ n = (-1) ^ n * 1 / (n + 1) :=
begin
  conv {
    to_lhs,
    congr,
    funext,
    rw [neg_pow, mul_comm],
  },
  norm_num [mul_div, mul_comm],
end

-- Approach 2, using `conv` but smarter
example {n : ℕ} : ∫ x : ℝ in 0..1, (-x) ^ n = (-1) ^ n * 1 / (n + 1) :=
begin
  conv in (_ ^ _) { rw neg_pow, },
  norm_num [mul_div],
end

-- Approach 3, using `simp only` with `ctx`
example {n : ℕ} : ∫ x : ℝ in 0..1, (-x) ^ n = (-1) ^ n * 1 / (n + 1) :=
begin
  simp only [neg_pow] { single_pass := tt },
  norm_num [mul_div],
end

example {n : ℕ} : ∑ x in range (n + 1), (↑(n - x) : ℝ) = ∑ x in range (n + 1), (↑n - ↑x) :=
begin
  -- I want to cast ↑(n - x) into ↑n - ↑x, using the assumption that x ∈ range (n + 1)
  -- But this isn't really possible, so I have to use sum_congr
  apply sum_congr rfl,
  intros x hx,
  -- And then extract the condition here
  rw mem_range_succ_iff at hx,
  rw nat.cast_sub hx,
end

example {n : ℕ} : ∃ (N : ℕ), (N : ℝ) = (Icc 1 (n * 2 + 1)).lcm coe * ∑ (x : ℕ) in range (n + 1), (n.choose x) * (-1) ^ (n - x) / (↑(n - x) + ↑n + 1) :=
begin
  -- Key: use `apply_congr` instead of plain `congr` to include "local information"
  conv in (finset.sum _ _) {
    apply_congr,
    skip,
    rw [nat.cast_sub (mem_range_succ_iff.1 H), ← add_sub_right_comm],
  },
  sorry,
end

#eval ((nat.prime 3) : bool)
#eval ((nat.prime (2^32 + 15)) : bool)

example {n : ℕ} : ∃ N : ℕ, ↑N = (n : ℝ) :=
begin
  squeeze_simp,
end

example {n : ℕ} : even n ∨ odd n :=
begin
  -- strong induction on n
  induction n using nat.strong_induction_on with k hk,
  -- handle n = 0
  by_cases h₀ : k = 0,
  { left, use 0, rwa add_zero, },
  -- handle n = 1
  by_cases h₁ : k = 1,
  { right, use 0, rwa [mul_zero, zero_add], },
  { -- first use induction hypothesis on (n - 2)
    -- by proving 2 ≤ n
    have h : 2 ≤ k,
    { omega, },
    -- and prove n - 2 < n, i.e. we can use strong induction
    have h' : k - 2 < k,
    { omega, },
    -- that way we can subtract
    specialize hk (k - 2) h',
    -- now depending on whether (k - 2) is even or odd
    -- we split into cases
    cases hk,
    -- even case, meaning k - 2 = 2k'
    { cases hk with k' hk', left, use k' + 1, linarith, },
    -- odd case, meaning k - 2 = 2k' + 1
    { cases hk with k' hk', right, use k' + 1, linarith, },
  }
end

example {k : ℕ} (h : k ≠ 0) (h' : k ≠ 1) : 2 ≤ k :=
begin
  rcases k with _|_|_;
  simpa <|> simp [nat.succ_le_succ_iff],
end

example {k : ℕ} : volume {x : ℝ | 0 ≤ x ∧ x ≤ 1} = 1 :=
begin
  rwa [← set.Icc, volume_Icc, tsub_zero, ennreal.of_real_one],
end

-- lim (x → ∞) (1 / x) = 0
example {f : ℝ → ℝ} (h : f = λ x, 1 / x) : filter.tendsto f filter.at_top (nhds 0) :=
begin
  rw [h, filter.tendsto_at_top'],
  intros s hs,
  -- Rephrase nhds as open ball
  rw _root_.mem_nhds_iff at hs,
  -- Get an instance of open ball
  rcases hs with ⟨t, ⟨H, ⟨ht, ht'⟩⟩⟩,
  -- t ∈ nhds 0
  replace ht := is_open_iff_mem_nhds.1 ht 0 ht',
  -- find (-ε, ε) within t
  rcases mem_nhds_iff_exists_Ioo_subset.1 ht with ⟨l, ⟨r, ⟨h₁, h₂⟩⟩⟩,
  -- prove that 0 < r
  rw [set.Ioo, set.mem_set_of_eq] at h₁,
  -- finish proof that ∀ b ≥ 2 / r, 1 / b < r
  use 2 / r,
  intros b hb,
  rw ge_iff_le at hb,
  have b_pos : 0 < b,
  { exact lt_of_lt_of_le (div_pos zero_lt_two h₁.2) hb, },
  rw [div_le_iff h₁.2, mul_comm, ← div_le_iff b_pos] at hb,
  have h' : 1 / b < r,
  { have : 1 / b ≤ r / 2, by { simpa [le_div_iff (zero_lt_two' ℝ), mul_comm, ← mul_div_assoc], },
    linarith, },
  calc 1 / b ∈ set.Ioo 0 r : by { rw [set.Ioo, set.mem_set_of_eq], split,
                                  exact div_pos zero_lt_one b_pos, linarith, }
         ... ⊆ set.Ioo l r : by { apply set.Ioo_subset_Ioo_left, linarith [h₁.1], }
         ... ⊆ t           : h₂
         ... ⊆ s           : H,
end

-- Proof by Kevin Buzzard
example {f : ℝ → ℝ} (h : f = λ x, 1 / x) : filter.tendsto f filter.at_top (nhds 0) :=
begin
  rw [h, filter.tendsto_at_top'],
  intros s hs,
  -- Rephrase nhds as open ball
  rw _root_.mem_nhds_iff at hs,
  -- Get an instance of open ball
  rcases hs with ⟨t, ⟨H, ⟨ht, ht'⟩⟩⟩,
  -- Then there is an open interval inside
  rcases is_open.exists_Ioo_subset ht (by {use 0, exact ht'}) with ⟨l, ⟨h, ⟨hlh, hlh'⟩⟩⟩,
  -- ???
  rw is_open_iff_mem_nhds at ht,
  specialize ht _ ht',
  rw metric.mem_nhds_iff at ht,
  rcases ht with ⟨ε, hεpos, hε⟩,
  use 1 / ε + 37,
  intros b hb,
  replace hb := lt_of_lt_of_le (lt_add_of_pos_right _ (by norm_num)) hb,
  have hbpos : 0 < b := lt_trans (one_div_pos.2 hεpos) hb,
  rw one_div_lt hεpos at hb,
  apply H,
  apply hε,
  rw [mem_ball_zero_iff, real.norm_eq_abs],
  rwa abs_eq_self.2,
  all_goals {positivity},
end

example : ∃ (n : ℕ), 10 < n ∧ n < 20 :=
begin
  -- rw and_comm,
  -- simp_rw [and_comm],
  simp only [and_comm _] { single_pass := tt },
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Joey van Langen, Casper Putz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.apply_fun
import Mathlib.data.equiv.ring
import Mathlib.data.zmod.basic
import Mathlib.linear_algebra.basis
import Mathlib.ring_theory.integral_domain
import Mathlib.field_theory.separable
import Mathlib.PostPort

universes u_2 u_1

namespace Mathlib

/-!
# Finite fields

This file contains basic results about finite fields.
Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

See `ring_theory.integral_domain` for the fact that the unit group of a finite field is a
cyclic group, as well as the fact that every finite integral domain is a field (`field_of_integral_domain`).

## Main results

1. `card_units`: The unit group of a finite field is has cardinality `q - 1`.
2. `sum_pow_units`: The sum of `x^i`, where `x` ranges over the units of `K`, is
   - `q-1` if `q-1 ∣ i`
   - `0`   otherwise
3. `finite_field.card`: The cardinality `q` is a power of the characteristic of `K`.
   See `card'` for a variant.

## Notation

Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

-/

namespace finite_field

/-- The cardinality of a field is at most `n` times the cardinality of the image of a degree `n`
  polynomial -/
theorem card_image_polynomial_eval {R : Type u_2} [integral_domain R] [DecidableEq R] [fintype R]
    {p : polynomial R} (hp : 0 < polynomial.degree p) :
    fintype.card R ≤
        polynomial.nat_degree p *
          finset.card (finset.image (fun (x : R) => polynomial.eval x p) finset.univ) :=
  sorry

/-- If `f` and `g` are quadratic polynomials, then the `f.eval a + g.eval b = 0` has a solution. -/
theorem exists_root_sum_quadratic {R : Type u_2} [integral_domain R] [fintype R] {f : polynomial R}
    {g : polynomial R} (hf2 : polynomial.degree f = bit0 1) (hg2 : polynomial.degree g = bit0 1)
    (hR : fintype.card R % bit0 1 = 1) :
    ∃ (a : R), ∃ (b : R), polynomial.eval a f + polynomial.eval b g = 0 :=
  sorry

theorem card_units {K : Type u_1} [field K] [fintype K] :
    fintype.card (units K) = fintype.card K - 1 :=
  sorry

theorem prod_univ_units_id_eq_neg_one {K : Type u_1} [field K] [fintype K] :
    (finset.prod finset.univ fun (x : units K) => x) = -1 :=
  sorry

theorem pow_card_sub_one_eq_one {K : Type u_1} [field K] [fintype K] (a : K) (ha : a ≠ 0) :
    a ^ (fintype.card K - 1) = 1 :=
  sorry

theorem pow_card {K : Type u_1} [field K] [fintype K] (a : K) : a ^ fintype.card K = a := sorry

theorem card (K : Type u_1) [field K] [fintype K] (p : ℕ) [char_p K p] :
    ∃ (n : ℕ+), nat.prime p ∧ fintype.card K = p ^ ↑n :=
  sorry

theorem card' {K : Type u_1} [field K] [fintype K] :
    ∃ (p : ℕ), ∃ (n : ℕ+), nat.prime p ∧ fintype.card K = p ^ ↑n :=
  sorry

@[simp] theorem cast_card_eq_zero (K : Type u_1) [field K] [fintype K] : ↑(fintype.card K) = 0 :=
  sorry

theorem forall_pow_eq_one_iff (K : Type u_1) [field K] [fintype K] (i : ℕ) :
    (∀ (x : units K), x ^ i = 1) ↔ fintype.card K - 1 ∣ i :=
  sorry

/-- The sum of `x ^ i` as `x` ranges over the units of a finite field of cardinality `q`
is equal to `0` unless `(q - 1) ∣ i`, in which case the sum is `q - 1`. -/
theorem sum_pow_units (K : Type u_1) [field K] [fintype K] (i : ℕ) :
    (finset.sum finset.univ fun (x : units K) => ↑x ^ i) = ite (fintype.card K - 1 ∣ i) (-1) 0 :=
  sorry

/-- The sum of `x ^ i` as `x` ranges over a finite field of cardinality `q`
is equal to `0` if `i < q - 1`. -/
theorem sum_pow_lt_card_sub_one {K : Type u_1} [field K] [fintype K] (i : ℕ)
    (h : i < fintype.card K - 1) : (finset.sum finset.univ fun (x : K) => x ^ i) = 0 :=
  sorry

theorem frobenius_pow {K : Type u_1} [field K] [fintype K] {p : ℕ} [fact (nat.prime p)] [char_p K p]
    {n : ℕ} (hcard : fintype.card K = p ^ n) : frobenius K p ^ n = 1 :=
  sorry

theorem expand_card {K : Type u_1} [field K] [fintype K] (f : polynomial K) :
    coe_fn (polynomial.expand K (fintype.card K)) f = f ^ fintype.card K :=
  sorry

end finite_field

namespace zmod

theorem sum_two_squares (p : ℕ) [hp : fact (nat.prime p)] (x : zmod p) :
    ∃ (a : zmod p), ∃ (b : zmod p), a ^ bit0 1 + b ^ bit0 1 = x :=
  sorry

end zmod

namespace char_p

theorem sum_two_squares (R : Type u_1) [integral_domain R] (p : ℕ) [fact (0 < p)] [char_p R p]
    (x : ℤ) : ∃ (a : ℕ), ∃ (b : ℕ), ↑a ^ bit0 1 + ↑b ^ bit0 1 = ↑x :=
  sorry

end char_p

/-- The Fermat-Euler totient theorem. `nat.modeq.pow_totient` is an alternative statement
  of the same theorem. -/
@[simp] theorem zmod.pow_totient {n : ℕ} [fact (0 < n)] (x : units (zmod n)) :
    x ^ nat.totient n = 1 :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (x ^ nat.totient n = 1)) (Eq.symm (zmod.card_units_eq_totient n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ^ fintype.card (units (zmod n)) = 1)) (pow_card_eq_one x)))
      (Eq.refl 1))

/-- The Fermat-Euler totient theorem. `zmod.pow_totient` is an alternative statement
  of the same theorem. -/
theorem nat.modeq.pow_totient {x : ℕ} {n : ℕ} (h : nat.coprime x n) :
    nat.modeq n (x ^ nat.totient n) 1 :=
  sorry

namespace zmod

/-- A variation on Fermat's little theorem. See `zmod.pow_card_sub_one_eq_one` -/
@[simp] theorem pow_card {p : ℕ} [fact (nat.prime p)] (x : zmod p) : x ^ p = x :=
  eq.mp (Eq._oldrec (Eq.refl (x ^ fintype.card (zmod p) = x)) (card p)) (finite_field.pow_card x)

@[simp] theorem frobenius_zmod (p : ℕ) [hp : fact (nat.prime p)] :
    frobenius (zmod p) p = ring_hom.id (zmod p) :=
  sorry

@[simp] theorem card_units (p : ℕ) [fact (nat.prime p)] : fintype.card (units (zmod p)) = p - 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (fintype.card (units (zmod p)) = p - 1)) finite_field.card_units))
    (eq.mpr (id (Eq._oldrec (Eq.refl (fintype.card (zmod p) - 1 = p - 1)) (card p)))
      (Eq.refl (p - 1)))

/-- Fermat's Little Theorem: for every unit `a` of `zmod p`, we have `a ^ (p - 1) = 1`. -/
theorem units_pow_card_sub_one_eq_one (p : ℕ) [fact (nat.prime p)] (a : units (zmod p)) :
    a ^ (p - 1) = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (p - 1) = 1)) (Eq.symm (card_units p))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ fintype.card (units (zmod p)) = 1)) (pow_card_eq_one a)))
      (Eq.refl 1))

/-- Fermat's Little Theorem: for all nonzero `a : zmod p`, we have `a ^ (p - 1) = 1`. -/
theorem pow_card_sub_one_eq_one {p : ℕ} [fact (nat.prime p)] {a : zmod p} (ha : a ≠ 0) :
    a ^ (p - 1) = 1 :=
  eq.mp (Eq._oldrec (Eq.refl (a ^ (fintype.card (zmod p) - 1) = 1)) (card p))
    (finite_field.pow_card_sub_one_eq_one a ha)

theorem expand_card {p : ℕ} [fact (nat.prime p)] (f : polynomial (zmod p)) :
    coe_fn (polynomial.expand (zmod p) p) f = f ^ p :=
  sorry

end Mathlib


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime p x) : (x : ℤ_[p]) ∈ units ℤ_[p] :=
begin
  -- Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
  have h1 : ¬ (x : ℤ_[p]) ∈ units ℤ_[p] → ¬ nat.coprime p x, from by auto [nat.coprime_iff_not_dvd],
  -- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$.
  have h2 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p])^2 = 1, from by auto [units_iff_norm_one],
  -- Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
  have h3 : (x : ℤ_[p])^2 ≤ 1, from by auto [norm_le_one],
  -- But this must imply that $p | x$.
  have h4 : ¬ (x : ℤ_[p])^2 = 1 → p ∣ x, from by auto [norm_eq_one_iff_dvd],
  -- This completes our proof.
  show (x : ℤ_[p]) ∈ units ℤ_[p], from by auto [h1, h2, h3, h4, h]
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.adjunction.basic
import category_theory.conj
import category_theory.yoneda

/-!
# Mate of natural transformations

This file establishes the bijection between the 2-cells

         L₁                  R₁
      C --→ D             C ←-- D
    G ↓  ↗  ↓ H         G ↓  ↘  ↓ H
      E --→ F             E ←-- F
         L₂                  R₂

where `L₁ ⊣ R₁` and `L₂ ⊣ R₂`, and shows that in the special case where `G,H` are identity then the
bijection preserves and reflects isomorphisms (i.e. we have bijections `(L₂ ⟶ L₁) ≃ (R₁ ⟶ R₂)`, and
if either side is an iso then the other side is as well).

On its own, this bijection is not particularly useful but it includes a number of interesting cases
as specializations.

For instance, this generalises the fact that adjunctions are unique (since if `L₁ ≅ L₂` then we
deduce `R₁ ≅ R₂`).
Another example arises from considering the square representing that a functor `H` preserves
products, in particular the morphism `HA ⨯ H- ⟶ H(A ⨯ -)`. Then provided `(A ⨯ -)` and `HA ⨯ -` have
left adjoints (for instance if the relevant categories are cartesian closed), the transferred
natural transformation is the exponential comparison morphism: `H(A ^ -) ⟶ HA ^ H-`.
Furthermore if `H` has a left adjoint `L`, this morphism is an isomorphism iff its mate
`L(HA ⨯ -) ⟶ A ⨯ L-` is an isomorphism, see
https://ncatlab.org/nlab/show/Frobenius+reciprocity#InCategoryTheory.
This also relates to Grothendieck's yoga of six operations, though this is not spelled out in
mathlib: https://ncatlab.org/nlab/show/six+operations.
-/
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

namespace category_theory
open category

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

section square

variables {E : Type u₃} {F : Type u₄} [category.{v₃} E] [category.{v₄} F]

variables {G : C ⥤ E} {H : D ⥤ F} {L₁ : C ⥤ D} {R₁ : D ⥤ C} {L₂ : E ⥤ F} {R₂ : F ⥤ E}
variables (adj₁ : L₁ ⊣ R₁) (adj₂ : L₂ ⊣ R₂)

include adj₁ adj₂

/--
Suppose we have a square of functors (where the top and bottom are adjunctions `L₁ ⊣ R₁` and
`L₂ ⊣ R₂` respectively).

      C ↔ D
    G ↓   ↓ H
      E ↔ F

Then we have a bijection between natural transformations `G ⋙ L₂ ⟶ L₁ ⋙ H` and
`R₁ ⋙ G ⟶ H ⋙ R₂`.
This can be seen as a bijection of the 2-cells:

         L₁                  R₁
      C --→ D             C ←-- D
    G ↓  ↗  ↓ H         G ↓  ↘  ↓ H
      E --→ F             E ←-- F
         L₂                  R₂

Note that if one of the transformations is an iso, it does not imply the other is an iso.
-/
def transfer_nat_trans : (G ⋙ L₂ ⟶ L₁ ⋙ H) ≃ (R₁ ⋙ G ⟶ H ⋙ R₂) :=
{ to_fun := λ h,
  { app := λ X, adj₂.unit.app _ ≫ R₂.map (h.app _ ≫ H.map (adj₁.counit.app _)),
    naturality' := λ X Y f,
    begin
      dsimp,
      rw [assoc, ← R₂.map_comp, assoc, ← H.map_comp, ← adj₁.counit_naturality, H.map_comp,
          ←functor.comp_map L₁, ←h.naturality_assoc],
      simp,
    end },
  inv_fun := λ h,
  { app := λ X, L₂.map (G.map (adj₁.unit.app _) ≫ h.app _) ≫ adj₂.counit.app _,
  naturality' := λ X Y f,
  begin
    dsimp,
    rw [← L₂.map_comp_assoc, ← G.map_comp_assoc, ← adj₁.unit_naturality, G.map_comp_assoc,
        ← functor.comp_map, h.naturality],
    simp,
  end },
  left_inv := λ h,
  begin
    ext X,
    dsimp,
    simp only [L₂.map_comp, assoc, adj₂.counit_naturality, adj₂.left_triangle_components_assoc,
      ←functor.comp_map G L₂, h.naturality_assoc, functor.comp_map L₁, ←H.map_comp,
      adj₁.left_triangle_components],
    dsimp,
    simp, -- See library note [dsimp, simp].
  end,
  right_inv := λ h,
  begin
    ext X,
    dsimp,
    simp [-functor.comp_map, ←functor.comp_map H, functor.comp_map R₁, -nat_trans.naturality,
      ←h.naturality, -functor.map_comp, ←functor.map_comp_assoc G, R₂.map_comp],
  end }

lemma transfer_nat_trans_counit (f : G ⋙ L₂ ⟶ L₁ ⋙ H) (Y : D) :
  L₂.map ((transfer_nat_trans adj₁ adj₂ f).app _) ≫ adj₂.counit.app _ =
    f.app _ ≫ H.map (adj₁.counit.app Y) :=
by { erw functor.map_comp, simp }

lemma unit_transfer_nat_trans (f : G ⋙ L₂ ⟶ L₁ ⋙ H) (X : C) :
  G.map (adj₁.unit.app X) ≫ (transfer_nat_trans adj₁ adj₂ f).app _ =
    adj₂.unit.app _ ≫ R₂.map (f.app _) :=
begin
  dsimp [transfer_nat_trans],
  rw [←adj₂.unit_naturality_assoc, ←R₂.map_comp, ← functor.comp_map G L₂, f.naturality_assoc,
    functor.comp_map, ← H.map_comp],
  dsimp, simp, -- See library note [dsimp, simp]
end

end square

section self

variables {L₁ L₂ L₃ : C ⥤ D} {R₁ R₂ R₃ : D ⥤ C}
variables (adj₁ : L₁ ⊣ R₁) (adj₂ : L₂ ⊣ R₂) (adj₃ : L₃ ⊣ R₃)

/--
Given two adjunctions `L₁ ⊣ R₁` and `L₂ ⊣ R₂` both between categories `C`, `D`, there is a
bijection between natural transformations `L₂ ⟶ L₁` and natural transformations `R₁ ⟶ R₂`.
This is defined as a special case of `transfer_nat_trans`, where the two "vertical" functors are
identity.
TODO: Generalise to when the two vertical functors are equivalences rather than being exactly `𝟭`.

Furthermore, this bijection preserves (and reflects) isomorphisms, i.e. a transformation is an iso
iff its image under the bijection is an iso, see eg `category_theory.transfer_nat_trans_self_iso`.
This is in contrast to the general case `transfer_nat_trans` which does not in general have this
property.
-/
def transfer_nat_trans_self : (L₂ ⟶ L₁) ≃ (R₁ ⟶ R₂) :=
calc (L₂ ⟶ L₁) ≃ _         : (iso.hom_congr L₂.left_unitor L₁.right_unitor).symm
           ... ≃ _         : transfer_nat_trans adj₁ adj₂
           ... ≃ (R₁ ⟶ R₂) : R₁.right_unitor.hom_congr R₂.left_unitor

lemma transfer_nat_trans_self_counit (f : L₂ ⟶ L₁) (X) :
  L₂.map ((transfer_nat_trans_self adj₁ adj₂ f).app _) ≫ adj₂.counit.app X =
    f.app _ ≫ adj₁.counit.app X :=
begin
  dsimp [transfer_nat_trans_self],
  rw [id_comp, comp_id],
  have := transfer_nat_trans_counit adj₁ adj₂ (L₂.left_unitor.hom ≫ f ≫ L₁.right_unitor.inv) X,
  dsimp at this,
  rw this,
  simp,
end

lemma unit_transfer_nat_trans_self (f : L₂ ⟶ L₁) (X) :
  adj₁.unit.app _ ≫ (transfer_nat_trans_self adj₁ adj₂ f).app _ =
    adj₂.unit.app X ≫ functor.map _ (f.app _) :=
begin
  dsimp [transfer_nat_trans_self],
  rw [id_comp, comp_id],
  have := unit_transfer_nat_trans adj₁ adj₂ (L₂.left_unitor.hom ≫ f ≫ L₁.right_unitor.inv) X,
  dsimp at this,
  rw this,
  simp
end

@[simp]
lemma transfer_nat_trans_self_id : transfer_nat_trans_self adj₁ adj₁ (𝟙 _) = 𝟙 _ :=
by { ext, dsimp [transfer_nat_trans_self, transfer_nat_trans], simp }
  -- See library note [dsimp, simp]

@[simp]
lemma transfer_nat_trans_self_symm_id :
  (transfer_nat_trans_self adj₁ adj₁).symm (𝟙 _) = 𝟙 _ :=
by { rw equiv.symm_apply_eq, simp }

lemma transfer_nat_trans_self_comp (f g) :
  transfer_nat_trans_self adj₁ adj₂ f ≫ transfer_nat_trans_self adj₂ adj₃ g =
    transfer_nat_trans_self adj₁ adj₃ (g ≫ f) :=
begin
  ext,
  dsimp [transfer_nat_trans_self, transfer_nat_trans],
  simp only [id_comp, comp_id],
  rw [←adj₃.unit_naturality_assoc, ←R₃.map_comp, g.naturality_assoc, L₂.map_comp, assoc,
    adj₂.counit_naturality, adj₂.left_triangle_components_assoc, assoc],
end

lemma transfer_nat_trans_self_symm_comp (f g) :
  (transfer_nat_trans_self adj₂ adj₁).symm f ≫ (transfer_nat_trans_self adj₃ adj₂).symm g =
    (transfer_nat_trans_self adj₃ adj₁).symm (g ≫ f) :=
by { rw [equiv.eq_symm_apply, ← transfer_nat_trans_self_comp _ adj₂], simp }

lemma transfer_nat_trans_self_comm {f g} (gf : g ≫ f = 𝟙 _) :
  transfer_nat_trans_self adj₁ adj₂ f ≫ transfer_nat_trans_self adj₂ adj₁ g = 𝟙 _ :=
by rw [transfer_nat_trans_self_comp, gf, transfer_nat_trans_self_id]

lemma transfer_nat_trans_self_symm_comm {f g} (gf : g ≫ f = 𝟙 _) :
  (transfer_nat_trans_self adj₁ adj₂).symm f ≫ (transfer_nat_trans_self adj₂ adj₁).symm g = 𝟙 _ :=
by rw [transfer_nat_trans_self_symm_comp, gf, transfer_nat_trans_self_symm_id]

/--
If `f` is an isomorphism, then the transferred natural transformation is an isomorphism.
The converse is given in `transfer_nat_trans_self_of_iso`.
-/
instance transfer_nat_trans_self_iso (f : L₂ ⟶ L₁) [is_iso f] :
  is_iso (transfer_nat_trans_self adj₁ adj₂ f) :=
⟨⟨transfer_nat_trans_self adj₂ adj₁ (inv f),
  ⟨transfer_nat_trans_self_comm _ _ (by simp), transfer_nat_trans_self_comm _ _ (by simp)⟩⟩⟩

/--
If `f` is an isomorphism, then the un-transferred natural transformation is an isomorphism.
The converse is given in `transfer_nat_trans_self_symm_of_iso`.
-/
instance transfer_nat_trans_self_symm_iso (f : R₁ ⟶ R₂) [is_iso f] :
  is_iso ((transfer_nat_trans_self adj₁ adj₂).symm f) :=
⟨⟨(transfer_nat_trans_self adj₂ adj₁).symm (inv f),
  ⟨transfer_nat_trans_self_symm_comm _ _ (by simp),
   transfer_nat_trans_self_symm_comm _ _ (by simp)⟩⟩⟩

/--
If `f` is a natural transformation whose transferred natural transformation is an isomorphism,
then `f` is an isomorphism.
The converse is given in `transfer_nat_trans_self_iso`.
-/
lemma transfer_nat_trans_self_of_iso (f : L₂ ⟶ L₁) [is_iso (transfer_nat_trans_self adj₁ adj₂ f)] :
  is_iso f :=
begin
  suffices :
    is_iso ((transfer_nat_trans_self adj₁ adj₂).symm (transfer_nat_trans_self adj₁ adj₂ f)),
  { simpa using this },
  apply_instance,
end

/--
If `f` is a natural transformation whose un-transferred natural transformation is an isomorphism,
then `f` is an isomorphism.
The converse is given in `transfer_nat_trans_self_symm_iso`.
-/

end self

end category_theory


import ring_theory.fractional_ideal
import ring_theory.discrete_valuation_ring
import linear_algebra.basic
universes u
open_locale classical
variables (R : Type u) [integral_domain R] (R' : Type u) [comm_ring R']

/-
`local_id_is_id` and the other lemmas probably belong in
`ring_theory/integral_domains` or whatever

For integral domains…
`local_id_is_id` asserts that for any submodule `S` that does not contain `0` induces an `integral_domain` on an `integral_domain`.
`local_at_prime_of_id_is_id` is the same, with the localization being at a prime
`lt_add_nonmem` proves that whenever a ∉ I, I < I+(a)
`zero_prime` is a proof that (0) is a prime ideal
`nonzero_mem_of_gt_bot` is whenever I ≠ ⊥, there exists a nonzero element of I
`ideal_mul_eq_zero` is that whenever I * J = ⊥, either I = ⊥ or J = ⊥.
-/

theorem local_id_is_id (S : submonoid R) (zero_non_mem : ((0 : R) ∉  S)) {f : localization_map S (localization S)} :
  is_integral_domain (localization S) :=
begin
  split,
    {--nontrivial localization (pair ne)
      use f.to_fun 1,
      use f.to_fun 0,
      intro one_eq_zero,
      have h2 := (localization_map.eq_iff_exists f).1 one_eq_zero,
      cases h2 with c h2,
      rw [zero_mul, one_mul] at h2,
      rw ← h2 at zero_non_mem,
      exact zero_non_mem c.property },
    { exact mul_comm },
    {--bulk
      intros x y mul_eq_zero,
      cases f.surj' x with a akey,
      cases f.surj' y with b bkey,
      have h1 : x * (f.to_fun( a.snd)) * y * (f.to_fun(b.snd))= 0,
      { rw [mul_assoc x, ← mul_comm y, ← mul_assoc, mul_eq_zero], simp },
      rw [akey, mul_assoc, bkey, ← f.map_mul', ← f.map_zero'] at h1,
      rw f.eq_iff_exists' at h1,
      cases h1 with c h1,
      rw [zero_mul, mul_comm] at h1,
      have h2 := eq_zero_or_eq_zero_of_mul_eq_zero h1,
      cases h2 with c_eq_zero h2,
      { exfalso,
        rw ← c_eq_zero at zero_non_mem,
        exact zero_non_mem c.property },
      replace h2 := eq_zero_or_eq_zero_of_mul_eq_zero h2,
      cases h2 with a_eq_zero b_eq_zero,
      { left, rw a_eq_zero at akey,
        exact localization_map.eq_zero_of_fst_eq_zero f akey rfl },
      { right, rw b_eq_zero at bkey,
        exact localization_map.eq_zero_of_fst_eq_zero f bkey rfl },
    },
end

instance local_at_prime_of_id_is_id (P : ideal R) (hp_prime : P.is_prime) :
  integral_domain (localization.at_prime P) :=
begin
  have zero_non_mem : (0 : R) ∉ P.prime_compl,
  { have := ideal.zero_mem P, simpa },
  have h1 := local_id_is_id R P.prime_compl zero_non_mem,
  exact is_integral_domain.to_integral_domain (localization.at_prime P) h1,
  exact localization.of (ideal.prime_compl P),
end

lemma lt_add_nonmem (I : ideal R') (a ∉ I) : I < I+ideal.span{a} :=
begin
  have blah : ∀ (x y : ideal R'), x ≤ x ⊔ y,
  { intros x y, simp only [le_sup_left],},
  split, exact blah I (ideal.span{a}),
  have blah2 : ∀ (x y z : ideal R'),  x ⊔ y ≤ z → x ≤ z → y ≤ z,
  { intros x y z, simp only [sup_le_iff], tauto,},
  have h : I ≤ I, exact le_refl I,
  rw ideal.add_eq_sup,
  intro bad,
  have h1 := blah2 I (ideal.span{a}) I bad h,
  have h2 : a ∈ ideal.span{a},
  { rw ideal.mem_span_singleton', use 1, rw one_mul,},
  have : ∀ (x ∈ ideal.span{a}), x ∈ I, simpa only [],
  exact H (this a h2),
end

--
lemma zero_prime : (⊥ : ideal R).is_prime :=
begin

  split,
  {
    intro,
    have h1 := (ideal.eq_top_iff_one) (⊥ : ideal R) ,
    rw h1 at a,
    have : 1 = (0 : R), tauto,
    simpa,
  },
  {
    intros,
    have h1 : x * y = 0, tauto,
    have x_or_y0 : x = 0 ∨ y = 0,
    exact zero_eq_mul.mp (eq.symm h1),
    tauto,
  },
end

lemma nonzero_mem_of_neq_bot (I : ideal R') (gt_bot : ⊥ < I) : ∃ a : I, a ≠ 0 :=
begin
  have h := (submodule.lt_iff_le_and_exists.1 gt_bot).2,
  clear gt_bot,
  rcases h with ⟨ x, hx, key ⟩,
  use [x, hx],
  simp only [submodule.mem_bot] at key,
  simpa only [ne.def, submodule.mk_eq_zero],
end

lemma ideal_mul_eq_zero {I J : ideal R} : (I * J = ⊥) ↔ I = ⊥ ∨ J = ⊥ :=
begin
  have hJ : inhabited J, by exact submodule.inhabited J,
  have j := inhabited.default J, clear hJ,
  split, swap,
  { intros,
    cases a,
    {rw [← ideal.mul_bot J, a, ideal.mul_comm],},
    {rw [← ideal.mul_bot I, a, ideal.mul_comm],},
  },
  intro hij,
  by_cases J = ⊥,
  right, exact h,
  left,
  rw submodule.eq_bot_iff,
  intros i hi,
  rcases J.ne_bot_iff.1 h with ⟨ j', hj, ne0⟩,
  rw submodule.eq_bot_iff at hij,
  specialize hij (i * j'),
  have := eq_zero_or_eq_zero_of_mul_eq_zero ( hij (ideal.mul_mem_mul hi hj)),
  cases this, assumption, exfalso, exact ne0 this,
end

theorem set_has_maximal_iff_noetherian {X : Type u} [add_comm_group X] [module R' X] : (∀(a : set $ submodule R' X), a.nonempty → ∃ (M ∈ a), ∀ (I ∈ a), M ≤ I → I=M) ↔ is_noetherian R' X :=
begin
  split; intro h,
  { split,
    intro I,
    let S := {J | J ≤ I ∧ J.fg},
    have h2 : S.nonempty, { use (⊥ : submodule R' X), convert submodule.fg_bot, simp },
    rcases h S h2 with ⟨ M, ⟨hMI, ⟨Mgen, hMgen⟩⟩, max⟩,
    rw submodule.fg_def,
    contrapose! max,
    have : ∃ x ∈ I, x ∉ M,
    { have := max ↑Mgen (finset.finite_to_set Mgen),
      contrapose! this,
      rw hMgen, ext, tauto },
    rcases this with ⟨x, hxI, hxM⟩,
    use submodule.span R' (↑Mgen ∪ {x}), split,
    { split,
      { suffices : (↑Mgen : set X) ∪ {x} ⊆ I, { convert submodule.span_mono this, simp },
        have : (↑Mgen : set X) ⊆ M, { convert submodule.subset_span, cc },
        apply set.union_subset, { exact set.subset.trans this hMI }, { simp [hxI] } },
      { rw submodule.fg_def, use (↑Mgen ∪ {x}), split, { split, apply_instance,}, refl } },
    split,
    { rw ← hMgen, convert submodule.span_mono _, simp },
    { contrapose! hxM, rw ← hxM, apply submodule.subset_span, exact (↑Mgen : set X).mem_union_right rfl,} },
  { rintros A ⟨a, ha⟩,
    rw is_noetherian_iff_well_founded at h,
    rw rel_embedding.well_founded_iff_no_descending_seq at h,
    by_contra hyp,
    push_neg at hyp,
    apply h,
    constructor,
    have h' : ∀ (M : submodule R' X), M ∈ A → (∃ (I : submodule R' X), I ∈ A ∧ M < I),
    {
      intros m mina,
      rcases hyp m mina with ⟨I, iina, mlei, mneqi⟩,
      use I, split, exact iina, split, exact mlei, intro ilem, apply mneqi, exact le_antisymm ilem mlei,
    },
    have h'' : ∀ M : A, ∃ I : A, (M : submodule R' X) < I,
    { rintros ⟨M, M_in⟩,
      rcases h' M M_in with ⟨I, I_in, hMI⟩,
      exact ⟨⟨I, I_in⟩, hMI⟩ },
    let f : ℕ → A := λ n, nat.rec_on n ⟨a, ha⟩ (λ n M, classical.some (h'' M)),
    exact rel_embedding.nat_gt (coe ∘ f) (λ n, classical.some_spec (h'' $ f n)),
  },
end


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

! This file was ported from Lean 3 source module category_theory.abelian.images
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Shapes.Kernels

/-!
# The abelian image and coimage.

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

In an abelian category we usually want the image of a morphism `f` to be defined as
`kernel (cokernel.π f)`, and the coimage to be defined as `cokernel (kernel.ι f)`.

We make these definitions here, as `abelian.image f` and `abelian.coimage f`
(without assuming the category is actually abelian),
and later relate these to the usual categorical notions when in an abelian category.

There is a canonical morphism `coimage_image_comparison : abelian.coimage f ⟶ abelian.image f`.
Later we show that this is always an isomorphism in an abelian category,
and conversely a category with (co)kernels and finite products in which this morphism
is always an isomorphism is an abelian category.
-/

noncomputable section

universe v u

open CategoryTheory

open CategoryTheory.Limits

namespace CategoryTheory.Abelian

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

variable {P Q : C} (f : P ⟶ Q)

section Image

#print CategoryTheory.Abelian.image /-
/-- The kernel of the cokernel of `f` is called the (abelian) image of `f`. -/
protected abbrev image : C :=
  kernel (cokernel.π f)
#align category_theory.abelian.image CategoryTheory.Abelian.image
-/

#print CategoryTheory.Abelian.image.ι /-
/-- The inclusion of the image into the codomain. -/
protected abbrev image.ι : Abelian.image f ⟶ Q :=
  kernel.ι (cokernel.π f)
#align category_theory.abelian.image.ι CategoryTheory.Abelian.image.ι
-/

#print CategoryTheory.Abelian.factorThruImage /-
/-- There is a canonical epimorphism `p : P ⟶ image f` for every `f`. -/
protected abbrev factorThruImage : P ⟶ Abelian.image f :=
  kernel.lift (cokernel.π f) f <| cokernel.condition f
#align category_theory.abelian.factor_thru_image CategoryTheory.Abelian.factorThruImage
-/

#print CategoryTheory.Abelian.image.fac /-
/-- `f` factors through its image via the canonical morphism `p`. -/
@[simp, reassoc.1]
protected theorem image.fac : Abelian.factorThruImage f ≫ image.ι f = f :=
  kernel.lift_ι _ _ _
#align category_theory.abelian.image.fac CategoryTheory.Abelian.image.fac
-/

#print CategoryTheory.Abelian.mono_factorThruImage /-
instance mono_factorThruImage [Mono f] : Mono (Abelian.factorThruImage f) :=
  mono_of_mono_fac <| image.fac f
#align category_theory.abelian.mono_factor_thru_image CategoryTheory.Abelian.mono_factorThruImage
-/

end Image

section Coimage

#print CategoryTheory.Abelian.coimage /-
/-- The cokernel of the kernel of `f` is called the (abelian) coimage of `f`. -/
protected abbrev coimage : C :=
  cokernel (kernel.ι f)
#align category_theory.abelian.coimage CategoryTheory.Abelian.coimage
-/

#print CategoryTheory.Abelian.coimage.π /-
/-- The projection onto the coimage. -/
protected abbrev coimage.π : P ⟶ Abelian.coimage f :=
  cokernel.π (kernel.ι f)
#align category_theory.abelian.coimage.π CategoryTheory.Abelian.coimage.π
-/

#print CategoryTheory.Abelian.factorThruCoimage /-
/-- There is a canonical monomorphism `i : coimage f ⟶ Q`. -/
protected abbrev factorThruCoimage : Abelian.coimage f ⟶ Q :=
  cokernel.desc (kernel.ι f) f <| kernel.condition f
#align category_theory.abelian.factor_thru_coimage CategoryTheory.Abelian.factorThruCoimage
-/

#print CategoryTheory.Abelian.coimage.fac /-
/-- `f` factors through its coimage via the canonical morphism `p`. -/
protected theorem coimage.fac : coimage.π f ≫ Abelian.factorThruCoimage f = f :=
  cokernel.π_desc _ _ _
#align category_theory.abelian.coimage.fac CategoryTheory.Abelian.coimage.fac
-/

#print CategoryTheory.Abelian.epi_factorThruCoimage /-
instance epi_factorThruCoimage [Epi f] : Epi (Abelian.factorThruCoimage f) :=
  epi_of_epi_fac <| coimage.fac f
#align category_theory.abelian.epi_factor_thru_coimage CategoryTheory.Abelian.epi_factorThruCoimage
-/

end Coimage

#print CategoryTheory.Abelian.coimageImageComparison /-
/-- The canonical map from the abelian coimage to the abelian image.
In any abelian category this is an isomorphism.

Conversely, any additive category with kernels and cokernels and
in which this is always an isomorphism, is abelian.

See <https://stacks.math.columbia.edu/tag/0107>
-/
def coimageImageComparison : Abelian.coimage f ⟶ Abelian.image f :=
  cokernel.desc (kernel.ι f) (kernel.lift (cokernel.π f) f (by simp)) <|
    by
    ext
    simp
#align category_theory.abelian.coimage_image_comparison CategoryTheory.Abelian.coimageImageComparison
-/

#print CategoryTheory.Abelian.coimageImageComparison' /-
/-- An alternative formulation of the canonical map from the abelian coimage to the abelian image.
-/
def coimageImageComparison' : Abelian.coimage f ⟶ Abelian.image f :=
  kernel.lift (cokernel.π f) (cokernel.desc (kernel.ι f) f (by simp))
    (by
      ext
      simp)
#align category_theory.abelian.coimage_image_comparison' CategoryTheory.Abelian.coimageImageComparison'
-/

#print CategoryTheory.Abelian.coimageImageComparison_eq_coimageImageComparison' /-
theorem coimageImageComparison_eq_coimageImageComparison' :
    coimageImageComparison f = coimageImageComparison' f :=
  by
  ext
  simp [coimage_image_comparison, coimage_image_comparison']
#align category_theory.abelian.coimage_image_comparison_eq_coimage_image_comparison' CategoryTheory.Abelian.coimageImageComparison_eq_coimageImageComparison'
-/

#print CategoryTheory.Abelian.coimage_image_factorisation /-
@[simp, reassoc.1]
theorem coimage_image_factorisation : coimage.π f ≫ coimageImageComparison f ≫ image.ι f = f := by
  simp [coimage_image_comparison]
#align category_theory.abelian.coimage_image_factorisation CategoryTheory.Abelian.coimage_image_factorisation
-/

end CategoryTheory.Abelian


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import algebra.star.subalgebra
import topology.algebra.algebra
import topology.algebra.star

/-!
# Topological star (sub)algebras

A topological star algebra over a topological semiring `R` is a topological semiring with a
compatible continuous scalar multiplication by elements of `R` and a continuous star operation.
We reuse typeclass `has_continuous_smul` for topological algebras.

## Results

This is just a minimal stub for now!

The topological closure of a star subalgebra is still a star subalgebra,
which as a star algebra is a topological star algebra.
-/

open classical set topological_space
open_locale classical

namespace star_subalgebra

section topological_star_algebra
variables {R A B : Type*} [comm_semiring R] [star_ring R]
variables [topological_space A] [semiring A] [algebra R A] [star_ring A] [star_module R A]

instance [topological_space R] [has_continuous_smul R A] (s : star_subalgebra R A) :
  has_continuous_smul R s :=
s.to_subalgebra.has_continuous_smul

instance [topological_semiring A] (s : star_subalgebra R A) : topological_semiring s :=
s.to_subalgebra.topological_semiring

/-- The `star_subalgebra.inclusion` of a star subalgebra is an `embedding`. -/
lemma embedding_inclusion {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂) :
  embedding (inclusion h) :=
{ induced := eq.symm induced_compose,
  inj := subtype.map_injective h function.injective_id }

/-- The `star_subalgebra.inclusion` of a closed star subalgebra is a `closed_embedding`. -/
lemma closed_embedding_inclusion {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂)
  (hS₁ : is_closed (S₁ : set A)) :
  closed_embedding (inclusion h) :=
{ closed_range := is_closed_induced_iff.2
    ⟨S₁, hS₁, by { convert (set.range_subtype_map id _).symm, rw set.image_id, refl }⟩,
  .. embedding_inclusion h }

variables [topological_semiring A] [has_continuous_star A]
variables [topological_space B] [semiring B] [algebra R B] [star_ring B
]
/-- The closure of a star subalgebra in a topological star algebra as a star subalgebra. -/
def topological_closure (s : star_subalgebra R A) :
  star_subalgebra R A :=
{ carrier := closure (s : set A),
  star_mem' := λ a ha, map_mem_closure continuous_star ha (λ x, (star_mem : x ∈ s → star x ∈ s)),
  .. s.to_subalgebra.topological_closure }

@[simp] lemma topological_closure_coe (s : star_subalgebra R A) :
  (s.topological_closure : set A) = closure (s : set A) :=
rfl

lemma le_topological_closure (s : star_subalgebra R A) : s ≤ s.topological_closure :=
subset_closure

lemma is_closed_topological_closure (s : star_subalgebra R A) :
  is_closed (s.topological_closure : set A) :=
is_closed_closure

instance {A : Type*} [uniform_space A] [complete_space A] [semiring A] [star_ring A]
  [topological_semiring A] [has_continuous_star A] [algebra R A] [star_module R A]
  {S : star_subalgebra R A} : complete_space S.topological_closure :=
is_closed_closure.complete_space_coe

lemma topological_closure_minimal {s t : star_subalgebra R A} (h : s ≤ t)
  (ht : is_closed (t : set A)) : s.topological_closure ≤ t :=
closure_minimal h ht

lemma topological_closure_mono : monotone (topological_closure : _ → star_subalgebra R A) :=
λ S₁ S₂ h, topological_closure_minimal (h.trans $ le_topological_closure S₂)
  (is_closed_topological_closure S₂)

/-- If a star subalgebra of a topological star algebra is commutative, then so is its topological
closure. See note [reducible non-instances]. -/
@[reducible]
def comm_semiring_topological_closure [t2_space A] (s : star_subalgebra R A)
  (hs : ∀ (x y : s), x * y = y * x) : comm_semiring s.topological_closure :=
s.to_subalgebra.comm_semiring_topological_closure hs

/-- If a star subalgebra of a topological star algebra is commutative, then so is its topological
closure. See note [reducible non-instances]. -/
@[reducible]
def comm_ring_topological_closure {R A} [comm_ring R] [star_ring R] [topological_space A] [ring A]
  [algebra R A] [star_ring A] [star_module R A] [topological_ring A] [has_continuous_star A]
  [t2_space A] (s : star_subalgebra R A) (hs : ∀ (x y : s), x * y = y * x) :
  comm_ring s.topological_closure :=
s.to_subalgebra.comm_ring_topological_closure hs

/-- Continuous `star_alg_hom`s from the the topological closure of a `star_subalgebra` whose
compositions with the `star_subalgebra.inclusion` map agree are, in fact, equal. -/
lemma _root_.star_alg_hom.ext_topological_closure [t2_space B] {S : star_subalgebra R A}
  {φ ψ : S.topological_closure →⋆ₐ[R] B} (hφ : continuous φ) (hψ : continuous ψ)
  (h : φ.comp (inclusion (le_topological_closure S))
    = ψ.comp (inclusion (le_topological_closure S))) :
  φ = ψ :=
begin
  rw fun_like.ext'_iff,
  have : dense (set.range $ inclusion (le_topological_closure S)),
  { refine embedding_subtype_coe.to_inducing.dense_iff.2 (λ x, _),
    convert (show ↑x ∈ closure (S : set A), from x.prop),
    rw ←set.range_comp,
    exact set.ext (λ y, ⟨by { rintro ⟨y, rfl⟩, exact y.prop }, λ hy, ⟨⟨y, hy⟩, rfl⟩⟩), },
  refine continuous.ext_on this hφ hψ _,
  rintro _ ⟨x, rfl⟩,
  simpa only using fun_like.congr_fun h x,
end

lemma _root_.star_alg_hom_class.ext_topological_closure [t2_space B] {F : Type*}
  {S : star_subalgebra R A} [star_alg_hom_class F R S.topological_closure B] {φ ψ : F}
  (hφ : continuous φ) (hψ : continuous ψ)
  (h : ∀ x : S, φ ((inclusion (le_topological_closure S) x))
    = ψ ((inclusion (le_topological_closure S)) x)) :
  φ = ψ :=
begin
  have : (φ : S.topological_closure →⋆ₐ[R] B) = (ψ : S.topological_closure →⋆ₐ[R] B),
  { refine star_alg_hom.ext_topological_closure hφ hψ (star_alg_hom.ext _);
    simpa only [star_alg_hom.coe_comp, star_alg_hom.coe_coe] using h },
  simpa only [fun_like.ext'_iff, star_alg_hom.coe_coe],
end

end topological_star_algebra

end star_subalgebra

section elemental

open star_subalgebra

variables (R : Type*) {A B : Type*} [comm_semiring R] [star_ring R]
variables [topological_space A] [semiring A] [star_ring A] [topological_semiring A]
variables [has_continuous_star A] [algebra R A] [star_module R A]
variables [topological_space B] [semiring B] [star_ring B] [algebra R B]

/-- The topological closure of the subalgebra generated by a single element. -/
def elemental_star_algebra (x : A) : star_subalgebra R A :=
(adjoin R ({x} : set A)).topological_closure

namespace elemental_star_algebra

lemma self_mem (x : A) : x ∈ elemental_star_algebra R x :=
set_like.le_def.mp (le_topological_closure _) (self_mem_adjoin_singleton R x)

lemma star_self_mem (x : A) : star x ∈ elemental_star_algebra R x :=
star_mem $ self_mem R x

/-- The `elemental_star_algebra` generated by a normal element is commutative. -/
instance [t2_space A] {x : A} [is_star_normal x] : comm_semiring (elemental_star_algebra R x) :=
star_subalgebra.comm_semiring_topological_closure _ mul_comm

/-- The `elemental_star_algebra` generated by a normal element is commutative. -/
instance {R A} [comm_ring R] [star_ring R] [topological_space A] [ring A] [algebra R A]
  [star_ring A] [star_module R A] [topological_ring A] [has_continuous_star A] [t2_space A]
  {x : A} [is_star_normal x] : comm_ring (elemental_star_algebra R x) :=
star_subalgebra.comm_ring_topological_closure _ mul_comm

protected

instance {A : Type*} [uniform_space A] [complete_space A] [semiring A] [star_ring A]
  [topological_semiring A] [has_continuous_star A] [algebra R A] [star_module R A] (x : A) :
  complete_space (elemental_star_algebra R x) :=
is_closed_closure.complete_space_coe

lemma le_of_is_closed_of_mem {S : star_subalgebra R A} (hS : is_closed (S : set A)) {x : A}
  (hx : x ∈ S) : elemental_star_algebra R x ≤ S :=
topological_closure_minimal (adjoin_le $ set.singleton_subset_iff.2 hx) hS

/-- The coercion from an elemental algebra to the full algebra as a `closed_embedding`. -/
lemma closed_embedding_coe (x : A) : closed_embedding (coe : elemental_star_algebra R x → A) :=
{ induced := rfl,
  inj := subtype.coe_injective,
  closed_range :=
  begin
    convert elemental_star_algebra.is_closed R x,
    exact set.ext (λ y, ⟨by {rintro ⟨y, rfl⟩, exact y.prop}, λ hy, ⟨⟨y, hy⟩, rfl⟩⟩),
  end }

lemma star_alg_hom_class_ext [t2_space B] {F : Type*} {a : A}
  [star_alg_hom_class F R (elemental_star_algebra R a) B] {φ ψ : F} (hφ : continuous φ)
  (hψ : continuous ψ) (h : φ ⟨a, self_mem R a⟩ = ψ ⟨a, self_mem R a⟩) :
  φ = ψ :=
begin
  refine star_alg_hom_class.ext_topological_closure hφ hψ (λ x, adjoin_induction' x _ _ _ _ _),
  exacts [λ y hy, by simpa only [set.mem_singleton_iff.mp hy] using h,
    λ r, by simp only [alg_hom_class.commutes],
    λ x y hx hy, by simp only [map_add, hx, hy],
    λ x y hx hy, by simp only [map_mul, hx, hy],
    λ x hx, by simp only [map_star, hx]],
end

end elemental_star_algebra

end elemental


/-
Copyright (c) 2019 Johannes Hölzl, Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Zhouhang Zhou
-/
import measure_theory.integral.lebesgue
import order.filter.germ
import topology.continuous_function.algebra
import measure_theory.function.strongly_measurable.basic

/-!

# Almost everywhere equal functions

We build a space of equivalence classes of functions, where two functions are treated as identical
if they are almost everywhere equal. We form the set of equivalence classes under the relation of
being almost everywhere equal, which is sometimes known as the `L⁰` space.
To use this space as a basis for the `L^p` spaces and for the Bochner integral, we consider
equivalence classes of strongly measurable functions (or, equivalently, of almost everywhere
strongly measurable functions.)

See `l1_space.lean` for `L¹` space.

## Notation

* `α →ₘ[μ] β` is the type of `L⁰` space, where `α` is a measurable space, `β` is a topological
  space, and `μ` is a measure on `α`. `f : α →ₘ β` is a "function" in `L⁰`.
  In comments, `[f]` is also used to denote an `L⁰` function.

  `ₘ` can be typed as `\_m`. Sometimes it is shown as a box if font is missing.

## Main statements

* The linear structure of `L⁰` :
    Addition and scalar multiplication are defined on `L⁰` in the natural way, i.e.,
    `[f] + [g] := [f + g]`, `c • [f] := [c • f]`. So defined, `α →ₘ β` inherits the linear structure
    of `β`. For example, if `β` is a module, then `α →ₘ β` is a module over the same ring.

    See `mk_add_mk`,  `neg_mk`,     `mk_sub_mk`,  `smul_mk`,
        `add_to_fun`, `neg_to_fun`, `sub_to_fun`, `smul_to_fun`

* The order structure of `L⁰` :
    `≤` can be defined in a similar way: `[f] ≤ [g]` if `f a ≤ g a` for almost all `a` in domain.
    And `α →ₘ β` inherits the preorder and partial order of `β`.

    TODO: Define `sup` and `inf` on `L⁰` so that it forms a lattice. It seems that `β` must be a
    linear order, since otherwise `f ⊔ g` may not be a measurable function.

## Implementation notes

* `f.to_fun`     : To find a representative of `f : α →ₘ β`, use the coercion `(f : α → β)`, which
                 is implemented as `f.to_fun`.
                 For each operation `op` in `L⁰`, there is a lemma called `coe_fn_op`,
                 characterizing, say, `(f op g : α → β)`.
* `ae_eq_fun.mk` : To constructs an `L⁰` function `α →ₘ β` from an almost everywhere strongly
                 measurable function `f : α → β`, use `ae_eq_fun.mk`
* `comp`         : Use `comp g f` to get `[g ∘ f]` from `g : β → γ` and `[f] : α →ₘ γ` when `g` is
                 continuous. Use `comp_measurable` if `g` is only measurable (this requires the
                 target space to be second countable).
* `comp₂`        : Use `comp₂ g f₁ f₂ to get `[λ a, g (f₁ a) (f₂ a)]`.
                 For example, `[f + g]` is `comp₂ (+)`

## Tags

function space, almost everywhere equal, `L⁰`, ae_eq_fun

-/

noncomputable theory
open_locale classical ennreal topology

open set filter topological_space ennreal emetric measure_theory function
variables {α β γ δ : Type*} [measurable_space α] {μ ν : measure α}

namespace measure_theory

section measurable_space
variables [topological_space β]

variable (β)

/-- The equivalence relation of being almost everywhere equal for almost everywhere strongly
measurable functions. -/
def measure.ae_eq_setoid (μ : measure α) : setoid { f : α → β // ae_strongly_measurable f μ } :=
⟨λ f g, (f : α → β) =ᵐ[μ] g, λ f, ae_eq_refl f, λ f g, ae_eq_symm, λ f g h, ae_eq_trans⟩

variable (α)

/-- The space of equivalence classes of almost everywhere strongly measurable functions, where two
    strongly measurable functions are equivalent if they agree almost everywhere, i.e.,
    they differ on a set of measure `0`.  -/
def ae_eq_fun (μ : measure α) : Type* := quotient (μ.ae_eq_setoid β)

variables {α β}

notation α ` →ₘ[`:25 μ `] ` β := ae_eq_fun α β μ

end measurable_space

namespace ae_eq_fun
variables [topological_space β] [topological_space γ] [topological_space δ]

/-- Construct the equivalence class `[f]` of an almost everywhere measurable function `f`, based
    on the equivalence relation of being almost everywhere equal. -/
def mk {β : Type*} [topological_space β]
  (f : α → β) (hf : ae_strongly_measurable f μ) : α →ₘ[μ] β := quotient.mk' ⟨f, hf⟩

/-- A measurable representative of an `ae_eq_fun` [f] -/
instance : has_coe_to_fun (α →ₘ[μ] β) (λ _, α → β) :=
⟨λ f, ae_strongly_measurable.mk _ (quotient.out' f : {f : α → β // ae_strongly_measurable f μ}).2⟩

protected lemma strongly_measurable (f : α →ₘ[μ] β) : strongly_measurable f :=
ae_strongly_measurable.strongly_measurable_mk _

protected lemma ae_strongly_measurable (f : α →ₘ[μ] β) : ae_strongly_measurable f μ :=
f.strongly_measurable.ae_strongly_measurable

protected lemma measurable [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
  (f : α →ₘ[μ] β) : measurable f :=
ae_strongly_measurable.measurable_mk _

protected lemma ae_measurable [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
  (f : α →ₘ[μ] β) :
  ae_measurable f μ :=
f.measurable.ae_measurable

@[simp] lemma quot_mk_eq_mk (f : α → β) (hf) :
  (quot.mk (@setoid.r _ $ μ.ae_eq_setoid β) ⟨f, hf⟩ : α →ₘ[μ] β) = mk f hf :=
rfl

@[simp] lemma mk_eq_mk {f g : α → β} {hf hg} :
  (mk f hf : α →ₘ[μ] β) = mk g hg ↔ f =ᵐ[μ] g :=
quotient.eq'

@[simp] lemma mk_coe_fn (f : α →ₘ[μ] β) : mk f f.ae_strongly_measurable = f :=
begin
  conv_rhs { rw ← quotient.out_eq' f },
  set g : {f : α → β // ae_strongly_measurable f μ} := quotient.out' f with hg,
  have : g = ⟨g.1, g.2⟩ := subtype.eq rfl,
  rw [this, ← mk, mk_eq_mk],
  exact (ae_strongly_measurable.ae_eq_mk _).symm,
end

@[ext] lemma ext {f g : α →ₘ[μ] β} (h : f =ᵐ[μ] g) : f = g :=
by rwa [← f.mk_coe_fn, ← g.mk_coe_fn, mk_eq_mk]

lemma ext_iff {f g : α →ₘ[μ] β} : f = g ↔ f =ᵐ[μ] g :=
⟨λ h, by rw h, λ h, ext h⟩

lemma coe_fn_mk (f : α → β) (hf) : (mk f hf : α →ₘ[μ] β) =ᵐ[μ] f :=
begin
  apply (ae_strongly_measurable.ae_eq_mk _).symm.trans,
  exact @quotient.mk_out' _ (μ.ae_eq_setoid β) (⟨f, hf⟩ : {f // ae_strongly_measurable f μ})
end

@[elab_as_eliminator]

@[elab_as_eliminator]
lemma induction_on₂ {α' β' : Type*} [measurable_space α'] [topological_space β']
  {μ' : measure α'}
  (f : α →ₘ[μ] β) (f' : α' →ₘ[μ'] β') {p : (α →ₘ[μ] β) → (α' →ₘ[μ'] β') → Prop}
  (H : ∀ f hf f' hf', p (mk f hf) (mk f' hf')) :
  p f f' :=
induction_on f $ λ f hf, induction_on f' $ H f hf

@[elab_as_eliminator]
lemma induction_on₃ {α' β' : Type*} [measurable_space α'] [topological_space β']
  {μ' : measure α'}
  {α'' β'' : Type*} [measurable_space α''] [topological_space β'']
  {μ'' : measure α''}
  (f : α →ₘ[μ] β) (f' : α' →ₘ[μ'] β') (f'' : α'' →ₘ[μ''] β'')
  {p : (α →ₘ[μ] β) → (α' →ₘ[μ'] β') → (α'' →ₘ[μ''] β'') → Prop}
  (H : ∀ f hf f' hf' f'' hf'', p (mk f hf) (mk f' hf') (mk f'' hf'')) :
  p f f' f'' :=
induction_on f $ λ f hf, induction_on₂ f' f'' $ H f hf

/-- Given a continuous function `g : β → γ`, and an almost everywhere equal function `[f] : α →ₘ β`,
    return the equivalence class of `g ∘ f`, i.e., the almost everywhere equal function
    `[g ∘ f] : α →ₘ γ`. -/
def comp (g : β → γ) (hg : continuous g) (f : α →ₘ[μ] β) : α →ₘ[μ] γ :=
quotient.lift_on' f (λ f, mk (g ∘ (f : α → β)) (hg.comp_ae_strongly_measurable f.2)) $
  λ f f' H, mk_eq_mk.2 $ H.fun_comp g

@[simp] lemma comp_mk (g : β → γ) (hg : continuous g)
  (f : α → β) (hf) :
  comp g hg (mk f hf : α →ₘ[μ] β) = mk (g ∘ f) (hg.comp_ae_strongly_measurable hf) :=
rfl

lemma comp_eq_mk (g : β → γ) (hg : continuous g) (f : α →ₘ[μ] β) :
  comp g hg f = mk (g ∘ f) (hg.comp_ae_strongly_measurable f.ae_strongly_measurable) :=
by rw [← comp_mk g hg f f.ae_strongly_measurable, mk_coe_fn]

lemma coe_fn_comp (g : β → γ) (hg : continuous g) (f : α →ₘ[μ] β) :
  comp g hg f =ᵐ[μ] g ∘ f :=
by { rw [comp_eq_mk], apply coe_fn_mk }

section comp_measurable

variables [measurable_space β] [pseudo_metrizable_space β] [borel_space β]
  [measurable_space γ] [pseudo_metrizable_space γ] [opens_measurable_space γ]
  [second_countable_topology γ]

/-- Given a measurable function `g : β → γ`, and an almost everywhere equal function `[f] : α →ₘ β`,
    return the equivalence class of `g ∘ f`, i.e., the almost everywhere equal function
    `[g ∘ f] : α →ₘ γ`. This requires that `γ` has a second countable topology. -/
def comp_measurable
  (g : β → γ) (hg : measurable g) (f : α →ₘ[μ] β) : α →ₘ[μ] γ :=
quotient.lift_on' f (λ f', mk (g ∘ (f' : α → β))
  (hg.comp_ae_measurable f'.2.ae_measurable).ae_strongly_measurable) $
  λ f f' H, mk_eq_mk.2 $ H.fun_comp g

@[simp] lemma comp_measurable_mk (g : β → γ) (hg : measurable g)
  (f : α → β) (hf : ae_strongly_measurable f μ) :
  comp_measurable g hg (mk f hf : α →ₘ[μ] β) =
    mk (g ∘ f) (hg.comp_ae_measurable hf.ae_measurable).ae_strongly_measurable :=
rfl

lemma comp_measurable_eq_mk (g : β → γ) (hg : measurable g) (f : α →ₘ[μ] β) :
  comp_measurable g hg f =
    mk (g ∘ f) (hg.comp_ae_measurable f.ae_measurable).ae_strongly_measurable :=
by rw [← comp_measurable_mk g hg f f.ae_strongly_measurable, mk_coe_fn]

lemma coe_fn_comp_measurable (g : β → γ) (hg : measurable g) (f : α →ₘ[μ] β) :
  comp_measurable g hg f =ᵐ[μ] g ∘ f :=
by { rw [comp_measurable_eq_mk], apply coe_fn_mk }

end comp_measurable

/-- The class of `x ↦ (f x, g x)`. -/
def pair (f : α →ₘ[μ] β) (g : α →ₘ[μ] γ) : α →ₘ[μ] β × γ :=
quotient.lift_on₂' f g (λ f g, mk (λ x, (f.1 x, g.1 x)) (f.2.prod_mk g.2)) $
  λ f g f' g' Hf Hg, mk_eq_mk.2 $ Hf.prod_mk Hg

@[simp] lemma pair_mk_mk (f : α → β) (hf) (g : α → γ) (hg) :
  (mk f hf : α →ₘ[μ] β).pair (mk g hg) = mk (λ x, (f x, g x)) (hf.prod_mk hg) :=
rfl

lemma pair_eq_mk (f : α →ₘ[μ] β) (g : α →ₘ[μ] γ) :
  f.pair g = mk (λ x, (f x, g x)) (f.ae_strongly_measurable.prod_mk g.ae_strongly_measurable) :=
by simp only [← pair_mk_mk, mk_coe_fn]

lemma coe_fn_pair (f : α →ₘ[μ] β) (g : α →ₘ[μ] γ) :
  f.pair g =ᵐ[μ] (λ x, (f x, g x)) :=
by { rw pair_eq_mk, apply coe_fn_mk }

/-- Given a continuous function `g : β → γ → δ`, and almost everywhere equal functions
    `[f₁] : α →ₘ β` and `[f₂] : α →ₘ γ`, return the equivalence class of the function
    `λ a, g (f₁ a) (f₂ a)`, i.e., the almost everywhere equal function
    `[λ a, g (f₁ a) (f₂ a)] : α →ₘ γ` -/
def comp₂ (g : β → γ → δ)
  (hg : continuous (uncurry g)) (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) : α →ₘ[μ] δ :=
comp _ hg (f₁.pair f₂)

@[simp] lemma comp₂_mk_mk
  (g : β → γ → δ) (hg : continuous (uncurry g)) (f₁ : α → β) (f₂ : α → γ) (hf₁ hf₂) :
  comp₂ g hg (mk f₁ hf₁ : α →ₘ[μ] β) (mk f₂ hf₂) =
    mk (λ a, g (f₁ a) (f₂ a)) (hg.comp_ae_strongly_measurable (hf₁.prod_mk hf₂)) :=
rfl

lemma comp₂_eq_pair
  (g : β → γ → δ) (hg : continuous (uncurry g)) (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
  comp₂ g hg f₁ f₂ = comp _ hg (f₁.pair f₂) :=
rfl

lemma comp₂_eq_mk
  (g : β → γ → δ) (hg : continuous (uncurry g)) (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
  comp₂ g hg f₁ f₂ = mk (λ a, g (f₁ a) (f₂ a)) (hg.comp_ae_strongly_measurable
    (f₁.ae_strongly_measurable.prod_mk f₂.ae_strongly_measurable)) :=
by rw [comp₂_eq_pair, pair_eq_mk, comp_mk]; refl

lemma coe_fn_comp₂
  (g : β → γ → δ) (hg : continuous (uncurry g)) (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
  comp₂ g hg f₁ f₂ =ᵐ[μ] λ a, g (f₁ a) (f₂ a) :=
by { rw comp₂_eq_mk, apply coe_fn_mk }

section

variables
  [measurable_space β] [pseudo_metrizable_space β] [borel_space β] [second_countable_topology β]
  [measurable_space γ] [pseudo_metrizable_space γ] [borel_space γ] [second_countable_topology γ]
  [measurable_space δ] [pseudo_metrizable_space δ] [opens_measurable_space δ]
  [second_countable_topology δ]

/-- Given a measurable function `g : β → γ → δ`, and almost everywhere equal functions
    `[f₁] : α →ₘ β` and `[f₂] : α →ₘ γ`, return the equivalence class of the function
    `λ a, g (f₁ a) (f₂ a)`, i.e., the almost everywhere equal function
    `[λ a, g (f₁ a) (f₂ a)] : α →ₘ γ`. This requires `δ` to have second-countable topology. -/
def comp₂_measurable (g : β → γ → δ)
  (hg : measurable (uncurry g)) (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) : α →ₘ[μ] δ :=
comp_measurable _ hg (f₁.pair f₂)

@[simp] lemma comp₂_measurable_mk_mk
  (g : β → γ → δ) (hg : measurable (uncurry g)) (f₁ : α → β) (f₂ : α → γ) (hf₁ hf₂) :
  comp₂_measurable g hg (mk f₁ hf₁ : α →ₘ[μ] β) (mk f₂ hf₂) =
  mk (λ a, g (f₁ a) (f₂ a))
    (hg.comp_ae_measurable (hf₁.ae_measurable.prod_mk hf₂.ae_measurable)).ae_strongly_measurable :=
rfl

lemma comp₂_measurable_eq_pair
  (g : β → γ → δ) (hg : measurable (uncurry g)) (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
  comp₂_measurable g hg f₁ f₂ = comp_measurable _ hg (f₁.pair f₂) :=
rfl

lemma comp₂_measurable_eq_mk
  (g : β → γ → δ) (hg : measurable (uncurry g)) (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
  comp₂_measurable g hg f₁ f₂ = mk (λ a, g (f₁ a) (f₂ a)) (hg.comp_ae_measurable
    (f₁.ae_measurable.prod_mk f₂.ae_measurable)).ae_strongly_measurable :=
by rw [comp₂_measurable_eq_pair, pair_eq_mk, comp_measurable_mk]; refl

lemma coe_fn_comp₂_measurable
  (g : β → γ → δ) (hg : measurable (uncurry g)) (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
  comp₂_measurable g hg f₁ f₂ =ᵐ[μ] λ a, g (f₁ a) (f₂ a) :=
by { rw comp₂_measurable_eq_mk, apply coe_fn_mk }

end

/-- Interpret `f : α →ₘ[μ] β` as a germ at `μ.ae` forgetting that `f` is almost everywhere
    strongly measurable. -/
def to_germ (f : α →ₘ[μ] β) : germ μ.ae β :=
quotient.lift_on' f (λ f, ((f : α → β) : germ μ.ae β)) $ λ f g H, germ.coe_eq.2 H

@[simp] lemma mk_to_germ (f : α → β) (hf) : (mk f hf : α →ₘ[μ] β).to_germ = f := rfl

lemma to_germ_eq (f : α →ₘ[μ] β) : f.to_germ = (f : α → β) :=
by rw [← mk_to_germ, mk_coe_fn]

lemma to_germ_injective : injective (to_germ : (α →ₘ[μ] β) → germ μ.ae β) :=
λ f g H, ext $ germ.coe_eq.1 $ by rwa [← to_germ_eq, ← to_germ_eq]

lemma comp_to_germ (g : β → γ) (hg : continuous g) (f : α →ₘ[μ] β) :
  (comp g hg f).to_germ = f.to_germ.map g :=
induction_on f $ λ f hf, by simp

lemma comp_measurable_to_germ [measurable_space β] [borel_space β] [pseudo_metrizable_space β]
  [pseudo_metrizable_space γ] [second_countable_topology γ] [measurable_space γ]
  [opens_measurable_space γ] (g : β → γ) (hg : measurable g) (f : α →ₘ[μ] β) :
  (comp_measurable g hg f).to_germ = f.to_germ.map g :=
induction_on f $ λ f hf, by simp

lemma comp₂_to_germ (g : β → γ → δ) (hg : continuous (uncurry g))
  (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
  (comp₂ g hg f₁ f₂).to_germ = f₁.to_germ.map₂ g f₂.to_germ :=
induction_on₂ f₁ f₂ $ λ f₁ hf₁ f₂ hf₂, by simp

lemma comp₂_measurable_to_germ
  [pseudo_metrizable_space β] [second_countable_topology β] [measurable_space β] [borel_space β]
  [pseudo_metrizable_space γ] [second_countable_topology γ] [measurable_space γ] [borel_space γ]
  [pseudo_metrizable_space δ] [second_countable_topology δ] [measurable_space δ]
  [opens_measurable_space δ] (g : β → γ → δ) (hg : measurable (uncurry g))
  (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
  (comp₂_measurable g hg f₁ f₂).to_germ = f₁.to_germ.map₂ g f₂.to_germ :=
induction_on₂ f₁ f₂ $ λ f₁ hf₁ f₂ hf₂, by simp

/-- Given a predicate `p` and an equivalence class `[f]`, return true if `p` holds of `f a`
    for almost all `a` -/
def lift_pred (p : β → Prop) (f : α →ₘ[μ] β) : Prop := f.to_germ.lift_pred p

/-- Given a relation `r` and equivalence class `[f]` and `[g]`, return true if `r` holds of
    `(f a, g a)` for almost all `a` -/
def lift_rel (r : β → γ → Prop) (f : α →ₘ[μ] β) (g : α →ₘ[μ] γ) : Prop :=
f.to_germ.lift_rel r g.to_germ

lemma lift_rel_mk_mk {r : β → γ → Prop} {f : α → β} {g : α → γ} {hf hg} :
  lift_rel r (mk f hf : α →ₘ[μ] β) (mk g hg) ↔ ∀ᵐ a ∂μ, r (f a) (g a) :=
iff.rfl

lemma lift_rel_iff_coe_fn {r : β → γ → Prop} {f : α →ₘ[μ] β} {g : α →ₘ[μ] γ} :
  lift_rel r f g ↔ ∀ᵐ a ∂μ, r (f a) (g a) :=
by rw [← lift_rel_mk_mk, mk_coe_fn, mk_coe_fn]

section order

instance [preorder β] : preorder (α →ₘ[μ] β) := preorder.lift to_germ

@[simp] lemma mk_le_mk [preorder β] {f g : α → β} (hf hg) :
  (mk f hf : α →ₘ[μ] β) ≤ mk g hg ↔ f ≤ᵐ[μ] g :=
iff.rfl

@[simp, norm_cast] lemma coe_fn_le [preorder β] {f g : α →ₘ[μ] β} :
  (f : α → β) ≤ᵐ[μ] g ↔ f ≤ g :=
lift_rel_iff_coe_fn.symm

instance [partial_order β] : partial_order (α →ₘ[μ] β) :=
partial_order.lift to_germ to_germ_injective

section lattice

section sup
variables [semilattice_sup β] [has_continuous_sup β]

instance : has_sup (α →ₘ[μ] β) :=
{ sup := λ f g, ae_eq_fun.comp₂ (⊔) continuous_sup f g }

lemma coe_fn_sup (f g : α →ₘ[μ] β) : ⇑(f ⊔ g) =ᵐ[μ] λ x, f x ⊔ g x :=
coe_fn_comp₂ _ _ _ _

protected lemma le_sup_left (f g : α →ₘ[μ] β) : f ≤ f ⊔ g :=
by { rw ← coe_fn_le, filter_upwards [coe_fn_sup f g] with _ ha, rw ha, exact le_sup_left, }

protected lemma le_sup_right (f g : α →ₘ[μ] β) : g ≤ f ⊔ g :=
by { rw ← coe_fn_le, filter_upwards [coe_fn_sup f g] with _ ha, rw ha, exact le_sup_right, }

protected lemma sup_le (f g f' : α →ₘ[μ] β) (hf : f ≤ f') (hg : g ≤ f') : f ⊔ g ≤ f' :=
begin
  rw ← coe_fn_le at hf hg ⊢,
  filter_upwards [hf, hg, coe_fn_sup f g] with _ haf hag ha_sup,
  rw ha_sup,
  exact sup_le haf hag,
end

end sup

section inf
variables [semilattice_inf β] [has_continuous_inf β]

instance : has_inf (α →ₘ[μ] β) :=
{ inf := λ f g, ae_eq_fun.comp₂ (⊓) continuous_inf f g }

lemma coe_fn_inf (f g : α →ₘ[μ] β) : ⇑(f ⊓ g) =ᵐ[μ] λ x, f x ⊓ g x :=
coe_fn_comp₂ _ _ _ _

protected lemma inf_le_left (f g : α →ₘ[μ] β) : f ⊓ g ≤ f :=
by { rw ← coe_fn_le, filter_upwards [coe_fn_inf f g] with _ ha, rw ha, exact inf_le_left, }

protected lemma inf_le_right (f g : α →ₘ[μ] β) : f ⊓ g ≤ g :=
by { rw ← coe_fn_le, filter_upwards [coe_fn_inf f g] with _ ha, rw ha, exact inf_le_right, }

protected lemma le_inf (f' f g : α →ₘ[μ] β) (hf : f' ≤ f) (hg : f' ≤ g) : f' ≤ f ⊓ g :=
begin
  rw ← coe_fn_le at hf hg ⊢,
  filter_upwards [hf, hg, coe_fn_inf f g] with _ haf hag ha_inf,
  rw ha_inf,
  exact le_inf haf hag,
end

end inf

instance [lattice β] [topological_lattice β] : lattice (α →ₘ[μ] β) :=
{ sup           := has_sup.sup,
  le_sup_left   := ae_eq_fun.le_sup_left,
  le_sup_right  := ae_eq_fun.le_sup_right,
  sup_le        := ae_eq_fun.sup_le,
  inf           := has_inf.inf,
  inf_le_left   := ae_eq_fun.inf_le_left,
  inf_le_right  := ae_eq_fun.inf_le_right,
  le_inf        := ae_eq_fun.le_inf,
  ..ae_eq_fun.partial_order}

end lattice

end order

variable (α)
/-- The equivalence class of a constant function: `[λ a:α, b]`, based on the equivalence relation of
    being almost everywhere equal -/
def const (b : β) : α →ₘ[μ] β := mk (λ a:α, b) ae_strongly_measurable_const

lemma coe_fn_const (b : β) : (const α b : α →ₘ[μ] β) =ᵐ[μ] function.const α b :=
coe_fn_mk _ _

variable {α}

instance [inhabited β] : inhabited (α →ₘ[μ] β) := ⟨const α default⟩

@[to_additive] instance [has_one β] : has_one (α →ₘ[μ] β) := ⟨const α 1⟩
@[to_additive] lemma one_def [has_one β] :
  (1 : α →ₘ[μ] β) = mk (λ a:α, 1) ae_strongly_measurable_const := rfl
@[to_additive] lemma coe_fn_one [has_one β] : ⇑(1 : α →ₘ[μ] β) =ᵐ[μ] 1 := coe_fn_const _ _
@[simp, to_additive] lemma one_to_germ [has_one β] : (1 : α →ₘ[μ] β).to_germ = 1 := rfl

-- Note we set up the scalar actions before the `monoid` structures in case we want to
-- try to override the `nsmul` or `zsmul` fields in future.
section has_smul

variables {𝕜 𝕜' : Type*}
variables [has_smul 𝕜 γ] [has_continuous_const_smul 𝕜 γ]
variables [has_smul 𝕜' γ] [has_continuous_const_smul 𝕜' γ]

instance : has_smul 𝕜 (α →ₘ[μ] γ) :=
⟨λ c f, comp ((•) c) (continuous_id.const_smul c) f⟩

@[simp] lemma smul_mk (c : 𝕜) (f : α → γ) (hf : ae_strongly_measurable f μ) :
  c • (mk f hf : α →ₘ[μ] γ) = mk (c • f) (hf.const_smul _) :=
rfl

lemma coe_fn_smul (c : 𝕜) (f : α →ₘ[μ] γ) : ⇑(c • f) =ᵐ[μ] c • f := coe_fn_comp _ _ _

lemma smul_to_germ (c : 𝕜) (f : α →ₘ[μ] γ) : (c • f).to_germ = c • f.to_germ :=
comp_to_germ _ _ _

instance [smul_comm_class 𝕜 𝕜' γ] : smul_comm_class 𝕜 𝕜' (α →ₘ[μ] γ) :=
⟨λ a b f, induction_on f $ λ f hf, by simp_rw [smul_mk, smul_comm]⟩

instance [has_smul 𝕜 𝕜'] [is_scalar_tower 𝕜 𝕜' γ] : is_scalar_tower 𝕜 𝕜' (α →ₘ[μ] γ) :=
⟨λ a b f, induction_on f $ λ f hf, by simp_rw [smul_mk, smul_assoc]⟩

instance [has_smul 𝕜ᵐᵒᵖ γ] [is_central_scalar 𝕜 γ] : is_central_scalar 𝕜 (α →ₘ[μ] γ) :=
⟨λ a f, induction_on f $ λ f hf, by simp_rw [smul_mk, op_smul_eq_smul]⟩

end has_smul

section has_mul
variables [has_mul γ] [has_continuous_mul γ]

@[to_additive]
instance : has_mul (α →ₘ[μ] γ) := ⟨comp₂ (*) continuous_mul⟩

@[simp, to_additive] lemma mk_mul_mk (f g : α → γ) (hf : ae_strongly_measurable f μ)
  (hg : ae_strongly_measurable g μ) :
  (mk f hf : α →ₘ[μ] γ) * (mk g hg) = mk (f * g) (hf.mul hg) :=
rfl

@[to_additive] lemma coe_fn_mul (f g : α →ₘ[μ] γ) : ⇑(f * g) =ᵐ[μ] f * g := coe_fn_comp₂ _ _ _ _

@[simp, to_additive] lemma mul_to_germ (f g : α →ₘ[μ] γ) :
  (f * g).to_germ = f.to_germ * g.to_germ :=
comp₂_to_germ _ _ _ _

end has_mul

instance [add_monoid γ] [has_continuous_add γ] : add_monoid (α →ₘ[μ] γ) :=
to_germ_injective.add_monoid to_germ zero_to_germ add_to_germ (λ _ _, smul_to_germ _ _)

instance [add_comm_monoid γ] [has_continuous_add γ] : add_comm_monoid (α →ₘ[μ] γ) :=
to_germ_injective.add_comm_monoid to_germ zero_to_germ add_to_germ (λ _ _, smul_to_germ _ _)

section monoid
variables [monoid γ] [has_continuous_mul γ]

instance : has_pow (α →ₘ[μ] γ) ℕ := ⟨λ f n, comp _ (continuous_pow n) f⟩

@[simp] lemma mk_pow (f : α → γ) (hf) (n : ℕ) :
  (mk f hf : α →ₘ[μ] γ) ^ n =
    mk (f ^ n) ((_root_.continuous_pow n).comp_ae_strongly_measurable hf) :=
rfl

lemma coe_fn_pow (f : α →ₘ[μ] γ) (n : ℕ) : ⇑(f ^ n) =ᵐ[μ] f ^ n :=
coe_fn_comp _ _ _

@[simp] lemma pow_to_germ (f : α →ₘ[μ] γ) (n : ℕ) :
  (f ^ n).to_germ = f.to_germ ^ n :=
comp_to_germ _ _ _

@[to_additive]
instance : monoid (α →ₘ[μ] γ) :=
to_germ_injective.monoid to_germ one_to_germ mul_to_germ pow_to_germ

/-- `ae_eq_fun.to_germ` as a `monoid_hom`. -/
@[to_additive "`ae_eq_fun.to_germ` as an `add_monoid_hom`.", simps]
def to_germ_monoid_hom : (α →ₘ[μ] γ) →* μ.ae.germ γ :=
{ to_fun := to_germ,
  map_one' := one_to_germ,
  map_mul' := mul_to_germ }

end monoid

@[to_additive]
instance [comm_monoid γ] [has_continuous_mul γ] : comm_monoid (α →ₘ[μ] γ) :=
to_germ_injective.comm_monoid to_germ one_to_germ mul_to_germ pow_to_germ

section group
variables [group γ] [topological_group γ]

section inv

@[to_additive] instance : has_inv (α →ₘ[μ] γ) := ⟨comp has_inv.inv continuous_inv⟩

@[simp, to_additive] lemma inv_mk (f : α → γ) (hf) : (mk f hf : α →ₘ[μ] γ)⁻¹ = mk f⁻¹ hf.inv := rfl

@[to_additive] lemma coe_fn_inv (f : α →ₘ[μ] γ) : ⇑(f⁻¹) =ᵐ[μ] f⁻¹ := coe_fn_comp _ _ _

@[to_additive] lemma inv_to_germ (f : α →ₘ[μ] γ) : (f⁻¹).to_germ = f.to_germ⁻¹ := comp_to_germ _ _ _

end inv

section div

@[to_additive] instance : has_div (α →ₘ[μ] γ) := ⟨comp₂ has_div.div continuous_div'⟩

@[simp, to_additive] lemma mk_div (f g : α → γ)
  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
  mk (f / g) (hf.div hg) = (mk f hf : α →ₘ[μ] γ) / (mk g hg) :=
rfl

@[to_additive] lemma coe_fn_div (f g : α →ₘ[μ] γ) : ⇑(f / g) =ᵐ[μ] f / g := coe_fn_comp₂ _ _ _ _

@[to_additive] lemma div_to_germ (f g : α →ₘ[μ] γ) : (f / g).to_germ = f.to_germ / g.to_germ :=
comp₂_to_germ _ _ _ _

end div

section zpow

instance has_int_pow : has_pow (α →ₘ[μ] γ) ℤ :=
⟨λ f n, comp _ (continuous_zpow n) f⟩

@[simp] lemma mk_zpow (f : α → γ) (hf) (n : ℤ) :
  (mk f hf : α →ₘ[μ] γ) ^ n = mk (f ^ n) ((continuous_zpow n).comp_ae_strongly_measurable hf) :=
rfl

lemma coe_fn_zpow (f : α →ₘ[μ] γ) (n : ℤ) : ⇑(f ^ n) =ᵐ[μ] f ^ n :=
coe_fn_comp _ _ _

@[simp] lemma zpow_to_germ (f : α →ₘ[μ] γ) (n : ℤ) :
  (f ^ n).to_germ = f.to_germ ^ n :=
comp_to_germ _ _ _

end zpow

end group

instance [add_group γ] [topological_add_group γ] :
  add_group (α →ₘ[μ] γ) :=
to_germ_injective.add_group to_germ zero_to_germ add_to_germ neg_to_germ sub_to_germ
  (λ _ _, smul_to_germ _ _) (λ _ _, smul_to_germ _ _)

instance [add_comm_group γ] [topological_add_group γ] :
  add_comm_group (α →ₘ[μ] γ) :=
to_germ_injective.add_comm_group to_germ zero_to_germ add_to_germ neg_to_germ sub_to_germ
  (λ _ _, smul_to_germ _ _) (λ _ _, smul_to_germ _ _)

@[to_additive]
instance [group γ] [topological_group γ] : group (α →ₘ[μ] γ) :=
to_germ_injective.group _ one_to_germ mul_to_germ inv_to_germ div_to_germ pow_to_germ zpow_to_germ

@[to_additive]
instance [comm_group γ] [topological_group γ] : comm_group (α →ₘ[μ] γ) :=
to_germ_injective.comm_group _
  one_to_germ mul_to_germ inv_to_germ div_to_germ pow_to_germ zpow_to_germ

section module

variables {𝕜 : Type*}

instance [monoid 𝕜] [mul_action 𝕜 γ] [has_continuous_const_smul 𝕜 γ] :
  mul_action 𝕜 (α →ₘ[μ] γ) :=
to_germ_injective.mul_action to_germ smul_to_germ

instance [monoid 𝕜] [add_monoid γ] [has_continuous_add γ]
  [distrib_mul_action 𝕜 γ] [has_continuous_const_smul 𝕜 γ] :
  distrib_mul_action 𝕜 (α →ₘ[μ] γ) :=
to_germ_injective.distrib_mul_action (to_germ_add_monoid_hom : (α →ₘ[μ] γ) →+ _)
  (λ c : 𝕜, smul_to_germ c)

instance [semiring 𝕜] [add_comm_monoid γ] [has_continuous_add γ] [module 𝕜 γ]
  [has_continuous_const_smul 𝕜 γ] :
  module 𝕜 (α →ₘ[μ] γ) :=
to_germ_injective.module 𝕜 (to_germ_add_monoid_hom : (α →ₘ[μ] γ) →+ _) smul_to_germ

end module

open ennreal

/-- For `f : α → ℝ≥0∞`, define `∫ [f]` to be `∫ f` -/
def lintegral (f : α →ₘ[μ] ℝ≥0∞) : ℝ≥0∞ :=
quotient.lift_on' f (λ f, ∫⁻ a, (f : α → ℝ≥0∞) a ∂μ) (assume f g, lintegral_congr_ae)

@[simp] lemma lintegral_mk (f : α → ℝ≥0∞) (hf) :
  (mk f hf : α →ₘ[μ] ℝ≥0∞).lintegral = ∫⁻ a, f a ∂μ := rfl

lemma lintegral_coe_fn (f : α →ₘ[μ] ℝ≥0∞) : ∫⁻ a, f a ∂μ = f.lintegral :=
by rw [← lintegral_mk, mk_coe_fn]

@[simp] lemma lintegral_zero : lintegral (0 : α →ₘ[μ] ℝ≥0∞) = 0 := lintegral_zero

@[simp] lemma lintegral_eq_zero_iff {f : α →ₘ[μ] ℝ≥0∞} : lintegral f = 0 ↔ f = 0 :=
induction_on f $ λ f hf, (lintegral_eq_zero_iff' hf.ae_measurable).trans mk_eq_mk.symm

lemma lintegral_add (f g : α →ₘ[μ] ℝ≥0∞) : lintegral (f + g) = lintegral f + lintegral g :=
induction_on₂ f g $ λ f hf g hg, by simp [lintegral_add_left' hf.ae_measurable]

lemma lintegral_mono {f g : α →ₘ[μ] ℝ≥0∞} : f ≤ g → lintegral f ≤ lintegral g :=
induction_on₂ f g $ λ f hf g hg hfg, lintegral_mono_ae hfg

section abs

lemma coe_fn_abs {β} [topological_space β] [lattice β] [topological_lattice β]
  [add_group β] [topological_add_group β]
  (f : α →ₘ[μ] β) :
  ⇑|f| =ᵐ[μ] λ x, |f x| :=
begin
  simp_rw abs_eq_sup_neg,
  filter_upwards [ae_eq_fun.coe_fn_sup f (-f), ae_eq_fun.coe_fn_neg f] with x hx_sup hx_neg,
  rw [hx_sup, hx_neg, pi.neg_apply],
end

end abs

section pos_part

variables [linear_order γ] [order_closed_topology γ] [has_zero γ]

/-- Positive part of an `ae_eq_fun`. -/
def pos_part (f : α →ₘ[μ] γ) : α →ₘ[μ] γ :=
comp (λ x, max x 0) (continuous_id.max continuous_const) f

@[simp] lemma pos_part_mk (f : α → γ) (hf) :
  pos_part (mk f hf : α →ₘ[μ] γ) =
    mk (λ x, max (f x) 0) ((continuous_id.max continuous_const).comp_ae_strongly_measurable hf) :=
rfl

lemma coe_fn_pos_part (f : α →ₘ[μ] γ) : ⇑(pos_part f) =ᵐ[μ] (λ a, max (f a) 0) :=
coe_fn_comp _ _ _

end pos_part

end ae_eq_fun

end measure_theory

namespace continuous_map

open measure_theory

variables [topological_space α] [borel_space α] (μ)
variables [topological_space β] [second_countable_topology_either α β] [pseudo_metrizable_space β]

/-- The equivalence class of `μ`-almost-everywhere measurable functions associated to a continuous
map. -/
def to_ae_eq_fun (f : C(α, β)) : α →ₘ[μ] β :=
ae_eq_fun.mk f f.continuous.ae_strongly_measurable

lemma coe_fn_to_ae_eq_fun (f : C(α, β)) : f.to_ae_eq_fun μ =ᵐ[μ] f :=
ae_eq_fun.coe_fn_mk f _

variables [group β] [topological_group β]

/-- The `mul_hom` from the group of continuous maps from `α` to `β` to the group of equivalence
classes of `μ`-almost-everywhere measurable functions. -/
@[to_additive "The `add_hom` from the group of continuous maps from `α` to `β` to the group of
equivalence classes of `μ`-almost-everywhere measurable functions."]
def to_ae_eq_fun_mul_hom : C(α, β) →* α →ₘ[μ] β :=
{ to_fun := continuous_map.to_ae_eq_fun μ,
  map_one' := rfl,
  map_mul' := λ f g, ae_eq_fun.mk_mul_mk _ _
    f.continuous.ae_strongly_measurable g.continuous.ae_strongly_measurable }

variables {𝕜 : Type*} [semiring 𝕜]
variables [topological_space γ] [pseudo_metrizable_space γ] [add_comm_group γ]
  [module 𝕜 γ] [topological_add_group γ] [has_continuous_const_smul 𝕜 γ]
  [second_countable_topology_either α γ]

/-- The linear map from the group of continuous maps from `α` to `β` to the group of equivalence
classes of `μ`-almost-everywhere measurable functions. -/
def to_ae_eq_fun_linear_map : C(α, γ) →ₗ[𝕜] α →ₘ[μ] γ :=
{ map_smul' := λ c f, ae_eq_fun.smul_mk c f f.continuous.ae_strongly_measurable,
  .. to_ae_eq_fun_add_hom μ }

end continuous_map

-- Guard against import creep
assert_not_exists inner_product_space


import algebra.group data.zmod.basic

universes u v

variables (N : Type u) (K : Type v) [group N] [group K]

structure linear_group_action : Type (max u v) :=
(smul : K → N → N)
(one_smul' : ∀ n, smul 1 n = n)
(mul_smul' : ∀ k₁ k₂ n, smul (k₁ * k₂) n = smul k₁ (smul k₂ n))
(smul_mul' : ∀ k n₁ n₂, smul k (n₁ * n₂) = smul k n₁ * smul k n₂)

instance : has_coe_to_fun (linear_group_action N K) :=
⟨_, linear_group_action.smul⟩

variables {N K} (φ : linear_group_action N K)
include φ

namespace linear_group_action
theorem one_smul (n) : φ 1 n = n := φ.one_smul' n
theorem mul_smul (k₁ k₂ n) : φ (k₁ * k₂) n = φ k₁ (φ k₂ n) := φ.mul_smul' k₁ k₂ n
theorem smul_mul (k n₁ n₂) : φ k (n₁ * n₂) = φ k n₁ * φ k n₂ := φ.smul_mul' k n₁ n₂
theorem is_group_hom (k) : is_group_hom (φ k) := ⟨φ.smul_mul k⟩
theorem smul_one (k) : φ k 1 = 1 := @@is_group_hom.one _ _ _ (φ.is_group_hom k)
theorem smul_inv (k n) : φ k n⁻¹ = (φ k n)⁻¹ := @@is_group_hom.inv _ _ _ (φ.is_group_hom k) n
end linear_group_action

def semidirect_product : Type (max u v) :=
N × K

instance : group (semidirect_product φ) :=
{ mul := λ x1 x2, (x1.1 * φ x1.2 x2.1, x1.2 * x2.2),
  mul_assoc := λ x1 x2 x3,
    show (_ * _ * φ (_ * _) _, _ * _ * _) =
      (_ * φ _ (_ * _), _ * (_ * _)),
    by simp only [φ.smul_mul, φ.mul_smul, mul_assoc],
  one := (1, 1),
  one_mul := λ ⟨n, k⟩, show (1 * φ 1 n, 1 * k) = (n, k),
    by simp only [φ.one_smul, one_mul],
  mul_one := λ ⟨n, k⟩, show (n * φ k 1, k * 1) = (n, k),
    by simp only [φ.smul_one, mul_one],
  inv := λ x, (φ x.2⁻¹ x.1⁻¹, x.2⁻¹),
  mul_left_inv := λ x, show (φ _ _ * φ x.2⁻¹ _, x.2⁻¹ * x.2) = ((1:N), (1:K)),
    by rw [← φ.smul_mul, inv_mul_self, inv_mul_self, φ.smul_one] }

omit φ
variables (n : ℕ+)

def cyclic : Type :=
multiplicative $ zmod n

instance : comm_group (cyclic n) :=
multiplicative.comm_group

def cyclic.g : cyclic n :=
(1 : zmod n)

instance : fintype (cyclic n) :=
zmod.fintype n

def dihedral2.aux : linear_group_action (cyclic n) (cyclic 2) :=
{ smul := λ k n, has_inv.inv^[k.val] n,
  one_smul' := λ _, rfl,
  mul_smul' := λ k₁ k₂ n, match k₁, k₂ with
    | ⟨0, _⟩, ⟨0, _⟩ := rfl
    | ⟨0, _⟩, ⟨1, _⟩ := rfl
    | ⟨0, _⟩, ⟨k₂+2, hk₂⟩ := absurd hk₂ dec_trivial
    | ⟨1, _⟩, ⟨0, _⟩ := rfl
    | ⟨1, _⟩, ⟨1, _⟩ := (inv_inv n).symm
    | ⟨1, _⟩, ⟨k₂+2, hk₂⟩ := absurd hk₂ dec_trivial
    | ⟨k₁+2, hk₁⟩, ⟨_, _⟩ := absurd hk₁ dec_trivial
    end,
  smul_mul' := λ k n₁ n₂, match k with
    | ⟨0, _⟩ := rfl
    | ⟨1, _⟩ := mul_inv n₁ n₂
    | ⟨k+2, hk⟩ := absurd hk dec_trivial
    end }

@[reducible] def dihedral2 : Type :=
semidirect_product $ dihedral2.aux n

instance : fintype (dihedral2 n) := prod.fintype _ _
instance : decidable_eq (dihedral2 n) := prod.decidable_eq

variables {n}
def ρ : dihedral2 n := (cyclic.g n, 1)
def σ : dihedral2 n := ⟨1, cyclic.g 2⟩
variables (n)

theorem rho_mul_sigma : (ρ * σ : dihedral2 n) = σ * ρ⁻¹ :=
prod.ext (show cyclic.g n * 1 = 1 * (cyclic.g n)⁻¹⁻¹, by rw [mul_one, one_mul, inv_inv]) rfl

theorem sigma_mul_sigma : (σ * σ : dihedral2 n) = 1 :=
prod.ext (show (1 * 1⁻¹ : cyclic n) = 1, by rw [one_inv, mul_one]) rfl

instance dihedral2.comm_group_1 : comm_group (dihedral2 1) :=
{ mul_comm := dec_trivial,
  .. (infer_instance : group (dihedral2 1)) }

instance dihedral2.comm_group_2 : comm_group (dihedral2 2) :=
{ mul_comm := dec_trivial,
  .. (infer_instance : group (dihedral2 2)) }

lemma dihedral_non_abelian {n:ℕ+} (h: 3 ≤ ↑n) : ∃ (g h : dihedral2 n), ¬(g*h = h*g) :=
⟨ρ, σ, λ H, have (1 + 0 : zmod n) = 0 - 1 := (prod.ext_iff.1 H).1,
have ↑n ∣ 2, by rwa [zero_sub, add_zero, eq_neg_iff_add_eq_zero,
  ← nat.cast_one, ← nat.cast_add, zmod.eq_zero_iff_dvd_nat] at this,
not_le_of_lt (nat.lt_of_succ_le h) $ nat.le_of_dvd dec_trivial this⟩


inductive LazyList (α : Type u)
| nil : LazyList α
| cons (hd : α) (tl : LazyList α) : LazyList α
| delayed (t : Thunk (LazyList α)) : LazyList α

namespace LazyList
def length : LazyList α → Nat
| nil        => 0
| cons _ as  => length as + 1
| delayed as => length as.get

def force : LazyList α → Option (α × LazyList α)
| delayed as => force as.get
| nil        => none
| cons a as  => some (a,as)
end LazyList

def rotate (f : LazyList τ) (r : List τ) (a : LazyList τ)
  (h : f.length + 1 = r.length) : LazyList τ :=
  match r with
  | List.nil => False.elim (by simp_arith [LazyList.length] at h)
  | y::r' =>
  match f.force with
  | none =>  LazyList.cons y a
  | some (x, f') => LazyList.cons x (rotate f' r' (LazyList.cons y a) (sorry))

theorem rotate_inv {F : LazyList τ} {R : List τ} : (h : F.length + 1 = R.length) → (rotate F R nil h).length = F.length + R.length := by
  match F with
  | LazyList.nil => intro h; unfold rotate; sorry
  | LazyList.cons Fh Ft => sorry
  | LazyList.delayed Ft => sorry

theorem LazyList.ind {α : Type u} {motive : LazyList α → Sort v}
        (nil : motive LazyList.nil)
        (cons : (hd : α) → (tl : LazyList α) → motive tl → motive (LazyList.cons hd tl))
        (delayed : (t : Thunk (LazyList α)) → motive t.get → motive (LazyList.delayed t))
        (t : LazyList α) : motive t :=
  match t with
  | LazyList.nil => nil
  | LazyList.cons h t => cons h t (ind nil cons delayed t)
  | LazyList.delayed t => delayed t (ind nil cons delayed t.get)
-- Remark: Lean used well-founded recursion behind the scenes to define LazyList.ind

theorem rotate_inv' {F : LazyList τ} {R : List τ} : (h : F.length + 1 = R.length) → (rotate F R nil h).length = F.length + R.length := by
  induction F using LazyList.ind with
  | nil => intro h; unfold rotate; sorry
  | cons h t ih => trace_state; sorry
  | delayed t => trace_state; sorry