/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import number_theory.padics.padic_integers
import topology.continuous_function.compact
import topology.continuous_function.locally_constant

/-!
# p-adic measure theory

This file defines p-adic distributions and measure on the space of locally constant functions
from a profinite space to a normed ring. We then use the measure to construct the p-adic integral.
In fact, we prove that this integral is linearly and continuously extended on `C(X, A`.

## Main definitions and theorems
 * `exists_finset_clopen`
 * `measures`
 * `integral`

## Implementation notes
TODO (optional)

## References
Introduction to Cyclotomic Fields, Washington (Chapter 12)

## Tags
p-adic L-function, p-adic integral, measure, totally disconnected, locally constant, compact,
Hausdorff
-/

variables (X : Type*) [topological_space X]
variables (A : Type*) [normed_comm_ring A]

/-- The A-linear injective map from `locally_constant X A` to `C(X, A)` -/
abbreviation inclusion : locally_constant X A →ₗ[A] C(X, A) :=
locally_constant.to_continuous_map_linear_map A

variable {X}
variables [compact_space X]

namespace set
lemma diff_inter_eq_empty {α : Type*} (a : set α) {b c : set α} (h : c ⊆ b) :
  a \ b ∩ c = ∅ :=
begin
  ext x,
  simp only [and_imp, mem_empty_eq, mem_inter_eq, not_and, mem_diff, iff_false],
  intro _,
  exact mt (@h x),
end

lemma diff_inter_mem_sUnion {α : Type*} {s : set (set α)} (a y : set α) (h : y ∈ s) :
  (a \ ⋃₀ s) ∩ y = ∅ :=
diff_inter_eq_empty a $ subset_sUnion_of_mem h

end set

namespace is_clopen

lemma is_closed_sUnion {H : Type*} [topological_space H]
  {s : finset(set H)} (hs : ∀ x ∈ s, is_closed x) :
  is_closed ⋃₀ (s : set(set H)) :=
by { simpa only [← is_open_compl_iff, set.compl_sUnion, set.sInter_image] using is_open_bInter
    (finset.finite_to_set s) (λ i hi, _), apply is_open_compl_iff.2 (hs i hi), }

lemma is_clopen_sUnion {H : Type*} [topological_space H]
  (s : finset(set H)) (hs : ∀ x ∈ s, is_clopen x) :
  is_clopen ⋃₀ (s : set(set H)) :=
⟨is_open_sUnion (λ t ht, (hs t ht).1), is_closed_sUnion (λ t ht, (hs t ht).2) ⟩

/-- The finite union of clopen sets is clopen. -/
lemma clopen_finite_Union {H : Type*} [topological_space H]
  (s : finset(set H)) (hs : ∀ x ∈ s, is_clopen x) :
  is_clopen ⋃₀ (s : set(set H)) :=
  by { rw set.sUnion_eq_bUnion, apply is_clopen_bUnion hs, }

/-- Given a finite set of clopens, one can find a finite disjoint set of clopens contained in
  it. -/
lemma clopen_Union_disjoint {H : Type*} [topological_space H]
  (s : finset(set H)) (hs : ∀ x ∈ s, is_clopen x) :
  ∃ (t : finset (set H)),
  (∀ (x ∈ (t : set (set H))), is_clopen x) ∧
  ⋃₀ (s : set(set H)) = ⋃₀ (t : set(set H)) ∧
  (∀ (x : set H) (hx : x ∈ t), ∃ z ∈ s, x ⊆ z) ∧
  ∀ (x y : set H) (hx : x ∈ t) (hy : y ∈ t) (h : x ≠ y), x ∩ y = ∅ :=
begin
  classical,
  apply finset.induction_on' s,
  { use ∅, simp only [finset.not_mem_empty, forall_false_left, set.mem_empty_eq, forall_const,
      finset.coe_empty, eq_self_iff_true, and_self], },
  { rintros a S h's hS aS ⟨t, clo, union, sub, disj⟩,
    set b := a \ ⋃₀ S with hb,
    refine ⟨insert b t, _, _, ⟨λ x hx, _, λ x y hx hy ne, _⟩⟩,
    { rintros x hx,
      simp only [finset.coe_insert, set.mem_insert_iff, finset.mem_coe] at hx,
      cases hx,
      { rw hx, apply is_clopen.diff (hs a h's) (clopen_finite_Union _ (λ y hy, (hs y (hS hy)))), },
      { apply clo x hx, }, },
    { simp only [finset.coe_insert, set.sUnion_insert], rw [←union, set.diff_union_self], },
    { simp only [finset.mem_insert] at hx, cases hx,
      { use a, rw hx, simp only [true_and, true_or, eq_self_iff_true, finset.mem_insert],
        apply set.diff_subset, },
      { rcases sub x hx with ⟨z, hz, xz⟩, refine ⟨z, _, xz⟩,
        rw finset.mem_insert, right, assumption, }, },
    { rw finset.mem_insert at hx, rw finset.mem_insert at hy,
      have : ∀ y ∈ t, b ∩ y = ∅,
      { rintros y hy, rw [hb, union], apply set.diff_inter_mem_sUnion, assumption, },
      cases hx,
      { cases hy,
        { exfalso, apply ne, rw [hx, hy], },
        { rw hx, apply this y hy, }, },
      { cases hy,
        { rw set.inter_comm, rw hy, apply this x hx, },
        { apply disj x y hx hy ne, }, }, }, },
end

end is_clopen

namespace locally_constant.density

variables (ε : ℝ)

/-- Takes an element of `A` to an `ε/4`-ball centered around it. -/
abbreviation h {A : Type*} [normed_ring A] : A → set A :=
  λ (x : A), metric.ball x (ε / 4)

/-- The set of (ε/4)-balls. -/
abbreviation S {A : Type*} [normed_ring A] : set (set A) := set.range (h ε)

variables {A} (f : C(X, A))

/-- Preimage of (ε/4)-balls. -/
abbreviation B : set(set X) := { j : set X | ∃ (U ∈ ((S ε) : set(set A))), j = f ⁻¹' U }

lemma opens {j : set X} (hj : j ∈ (B ε f)) : is_open j :=
begin
  rcases hj with ⟨hj_w, ⟨hj_h_w_w, rfl⟩, rfl⟩,
  exact continuous.is_open_preimage f.2 _ (metric.is_open_ball),
end

variable [fact (0 < ε)]
/-- `X` is covered by a union of preimage of finitely many elements of `S` under `f` -/
lemma exists_finset_univ_sub : ∃ (t : finset (set A)), set.univ ⊆ ⨆ (i : set A) (H : i ∈ t)
  (H : i ∈ ((S ε) : set(set A))), f ⁻¹' i :=
begin
  have g : (⋃₀ S ε) = (set.univ : set A),
  { rw set.sUnion_eq_univ_iff, rintros, refine ⟨metric.ball a (ε/4), _, _⟩,
    { simp only [set.mem_range, exists_apply_eq_apply], },
    { simp only [metric.mem_ball, dist_self],
      refine div_pos (fact.out _) zero_lt_four, }, },
  have g' : set.preimage f (⋃₀ S ε) = set.univ,
  { rw g, exact set.preimage_univ, },
  rw [set.preimage_sUnion, set.subset.antisymm_iff] at g',
  refine is_compact.elim_finite_subcover compact_univ _ (λ i, is_open_Union
    (λ hi, continuous.is_open_preimage (continuous_map.continuous f) i _)) g'.2,
  cases hi with y hy, rw [←hy], refine @metric.is_open_ball A _ y (ε/4),
end

/-- Choosing a finset as given in `exists_finset_univ_sub` -/
noncomputable abbreviation t : finset (set A) := classical.some (exists_finset_univ_sub ε f)

lemma exists_finset_univ_sub_prop : set.univ ⊆ ⨆ (i : set A) (H : i ∈ t ε f)
  (H : i ∈ ((S ε) : set(set A))), f ⁻¹' i := classical.some_spec (exists_finset_univ_sub ε f)

/-- If there is a finite set of sets from `S` whose preimage forms a cover for `X`,
  then the union of the preimages of all the sets from `S` also forms a cover. -/
lemma sUnion_sub_of_finset_sub : set.univ ⊆ set.sUnion (B ε f) :=
begin
  rintros x hx,
  obtain ⟨-, ⟨j, rfl⟩, -, ⟨hj, rfl⟩, -, ⟨⟨a, jS⟩, rfl⟩, fj⟩ := (exists_finset_univ_sub_prop ε f) hx,
  exact ⟨f⁻¹' j, ⟨j, ⟨_, jS⟩, rfl⟩, fj⟩,
end

variables [t2_space X] [totally_disconnected_space X]

/-- If there is a finite set of sets from `S` whose preimage forms a cover for `X`,
  then there is a cover of `X` by clopen sets, with the image of each set being
  contained in an element of `S`. -/
def set_clopen : set (set X) := {j : set X | ∃ (U : set X) (hU : U ∈ (B ε f)),
    j ∈ classical.some (topological_space.is_topological_basis.open_eq_sUnion
    (@loc_compact_Haus_tot_disc_of_zero_dim X _ _ _ _) (opens ε f hU))}

lemma mem_set_clopen {x : set X} : x ∈ (set_clopen ε f) ↔ ∃ (U : set X) (hU : U ∈ (B ε f)),
    x ∈ classical.some (topological_space.is_topological_basis.open_eq_sUnion
    (@loc_compact_Haus_tot_disc_of_zero_dim X _ _ _ _) (opens ε f hU)) := iff.rfl

/-- Elements of `set_clopen` are clopen. -/
lemma set_clopen_sub_clopen_set : (set_clopen ε f) ⊆ {s : set X | is_clopen s} :=
begin
  intros j hj,
  obtain ⟨W, hW, hj⟩ := (mem_set_clopen ε f).1 hj,
  obtain ⟨H, -⟩ := classical.some_spec (topological_space.is_topological_basis.open_eq_sUnion
    (@loc_compact_Haus_tot_disc_of_zero_dim X _ _ _ _) (opens ε f hW)),
  exact H hj,
end

/-- `set_clopen` covers X. -/
lemma univ_sub_sUnion_set_clopen : set.univ ⊆ ⋃₀ (set_clopen ε f) :=
begin
  rintros x hx, rw set.mem_sUnion,
  have f' := @loc_compact_Haus_tot_disc_of_zero_dim X _ _ _ _,
  have sUnion_sub_of_finset_sub := sUnion_sub_of_finset_sub ε f,
-- writing `f⁻¹' U` as a union of basis elements (clopen sets)
  conv at sUnion_sub_of_finset_sub { congr, skip, rw set.sUnion_eq_Union, congr, funext,
    apply_congr classical.some_spec (classical.some_spec
    (topological_space.is_topological_basis.open_eq_sUnion f' (opens ε f i.prop))), },
  rw set.Union at sUnion_sub_of_finset_sub,
  have g3 := sUnion_sub_of_finset_sub hx,
  simp only [exists_prop, set.mem_Union, set.mem_range, set_coe.exists, exists_exists_eq_and,
    set.supr_eq_Union, set.mem_set_of_eq, subtype.coe_mk] at g3,
  rcases g3 with ⟨U, hU, a, ha, xa⟩,
  refine ⟨a, _, xa⟩,
  rw mem_set_clopen,
  simp only [exists_prop, set.mem_range, exists_exists_eq_and, set.mem_set_of_eq],
  refine ⟨U, hU, ha⟩,
end

/-- The image of each element of `set_clopen` is contained in an element of `S`. -/
lemma exists_B_of_mem_clopen {x : set X} (hx : x ∈ set_clopen ε f) :
  ∃ (U : set X) (H : U ∈ B ε f), x ⊆ U :=
begin
  rcases hx with ⟨U, hU, xU⟩, refine ⟨U, hU, _⟩,
  obtain ⟨H, H1⟩ := classical.some_spec
    (topological_space.is_topological_basis.open_eq_sUnion
    (@loc_compact_Haus_tot_disc_of_zero_dim X _ _ _ _) (opens ε f hU)),
  rw H1, intros u hu, simp only [exists_prop, set.mem_set_of_eq],
  refine ⟨x, _, hu⟩,
  convert xU,
  ext, simp only [exists_prop, iff_self],
end

/-- Every element of `set_clopen` is open. -/
lemma mem_set_clopen_is_open (i : (set_clopen ε f)) : is_open (i : set X) :=
 topological_space.is_topological_basis.is_open (@loc_compact_Haus_tot_disc_of_zero_dim X _ _ _ _)
  ((set_clopen_sub_clopen_set ε f) i.2)

/-- A restatement of `univ_sub_sUnion_set_clopen`. -/
lemma cover : (set.univ : set X) ⊆ ⋃ (i : (set_clopen ε f)), ↑i :=
by { convert univ_sub_sUnion_set_clopen ε f, rw set.sUnion_eq_Union, }

/-- Obtain a finite subcover of `set_clopen` using the compactness of `X`. -/
noncomputable abbreviation s' := classical.some (is_compact.elim_finite_subcover
  (@compact_univ X _ _) _ (mem_set_clopen_is_open ε f) (cover ε f))

/-- Coercing a subset of `set_clopen` in `s'` to `set X`. -/
abbreviation s1 := λ (x : s' ε f), (x.1 : set X)

/-- The range of `s1` is finite. -/
lemma fin : (set.range (s1 ε f)).finite :=
by { apply set.finite_range _, exact plift.fintype (s' ε f), }

/-- Any element in the range of `s1` is clopen. -/
lemma is_clopen_x {x : set X} (hx : x ∈ (fin ε f).to_finset) : is_clopen x :=
begin
  simp only [set.mem_range, set_coe.exists, set.finite.mem_to_finset, finset.mem_coe] at hx,
  rcases hx with ⟨⟨⟨v, hv⟩, hw⟩, hU⟩,
  convert (set_clopen_sub_clopen_set ε f) hv,
  rw ←hU,
  delta s1,
  simp,
end

/-- If there is a finite set of sets from `S` whose preimage forms a cover for `X`,
  then there is a finset of `sets X` containing clopen sets, with the image of each set being
  contained in an element of `S`. We use `s'` to get a finite disjoint clopen cover of `X`;
  note : it is not a partition -/
noncomputable def finset_clopen : finset (set X) :=
  classical.some (is_clopen.clopen_Union_disjoint
    (set.finite.to_finset (fin ε f)) (λ x hx, (is_clopen_x ε f hx)))

/-- Elements of `finset_clopen` are clopen. -/
lemma finset_clopen_is_clopen {x : set X} (hx : x ∈ finset_clopen ε f) : is_clopen x :=
  (classical.some_spec (is_clopen.clopen_Union_disjoint (set.finite.to_finset (fin ε f))
    (λ x hx, (is_clopen_x ε f hx)))).1 x hx

/-- The image of every element of `finset_clopen` is contained in some element of `S`. -/
lemma exists_sub_S {x : set X} (hx : x ∈ finset_clopen ε f) :
  ∃ U ∈ ((S ε) : set(set A)), (set.image f x : set A) ⊆ U :=
begin
  rcases (classical.some_spec (is_clopen.clopen_Union_disjoint
    (set.finite.to_finset (fin ε f)) (λ x hx, (is_clopen_x ε f hx)))).2.2.1 x hx with ⟨z, hz, wz⟩,
  simp only [set.mem_range, set_coe.exists, set.finite.mem_to_finset, finset.mem_coe] at hz,
  -- `z'` is a lift of `x` in `V`
  rcases hz with ⟨⟨⟨z', h1⟩, h2⟩, h3⟩,
  rcases exists_B_of_mem_clopen ε f h1 with ⟨U, BU, xU⟩,
  simp only [exists_prop, exists_exists_eq_and, set.mem_set_of_eq] at BU,
  cases BU with U' h4,
  refine ⟨U', h4.1, _⟩, transitivity (set.image f z),
  { apply set.image_subset _ wz, },
  { simp only [set.image_subset_iff], rw [←h4.2, ←h3],
    delta s1,
    simp only [xU, subtype.coe_mk], },
end

/-- Showing that `finset_clopen` is a disjoint cover of `X`. -/
lemma finset_clopen_prop (a : X) : ∃! (b ∈ finset_clopen ε f), a ∈ b :=
begin
-- proving that every element `a : X` is contained in a unique element `j` of `s`
  obtain ⟨j, hj, aj⟩ : ∃ j ∈ finset_clopen ε f, a ∈ j,
  { -- `s'` covers `X`
    have ha := classical.some_spec (is_compact.elim_finite_subcover
      (@compact_univ X _ _) _ (mem_set_clopen_is_open ε f) (cover ε f)) (set.mem_univ a),
    have hs := (classical.some_spec (is_clopen.clopen_Union_disjoint
      (set.finite.to_finset (fin ε f)) (λ x hx, (is_clopen_x ε f hx)))).2.1,
    delta s1 at hs,
    suffices : a ∈ ⋃₀ (finset_clopen ε f : set(set X)),
    { simp only [exists_prop, set.mem_set_of_eq, finset.mem_coe] at this,
      cases this with j hj, refine ⟨j, hj.1, hj.2⟩, },
    { rw finset_clopen,
      rw ←hs,
      simp only [set.mem_Union, set.finite.coe_to_finset, subtype.val_eq_coe, set.sUnion_range],
      simp only [exists_prop, set.mem_Union, set_coe.exists, exists_and_distrib_right,
        subtype.coe_mk] at ha,
      -- have the element `U` of `V`, now translate it to `s`
      rcases ha with ⟨U, ⟨hU, s'U⟩, aU⟩,
      delta s',
      refine ⟨⟨⟨U, hU⟩, s'U⟩, aU⟩, }, },
  refine ⟨j, _, λ y hy, _⟩,
  { -- existence
    simp only [exists_prop, set.image_subset_iff, set.mem_range, exists_exists_eq_and,
      exists_unique_iff_exists],
    refine ⟨hj, aj⟩, },
  { -- uniqueness, coming from the disjointness of the clopen cover, `disj`
    simp only [exists_prop, exists_unique_iff_exists] at hy,
    cases hy with h1 h2,
    have disj := (classical.some_spec (is_clopen.clopen_Union_disjoint
      (set.finite.to_finset (fin ε f)) (λ x hx, (is_clopen_x ε f hx)))).2.2.2 j y hj h1,
    by_cases h : j = y,
    { rw h.symm, },
    { exfalso, specialize disj h, rw ←set.mem_empty_eq, rw ←disj,
      apply set.mem_inter aj _,
      simp only [and_true, implies_true_iff, eq_iff_true_of_subsingleton] at h2,
      exact h2, }, },
end

/-- Takes a nonempty `s` in `finset_clopen` and returns an element of it. -/
noncomputable abbreviation c' := λ (s : set X) (H : s ∈ (finset_clopen ε f) ∧ nonempty s),
  classical.choice (H.2)

/-- Any `x` in `X` must belong to a unique `s` in `finset_clopen`. `c2` takes `x` to the image of
  any element of `s` under `f`, which is the same `f x`. -/
noncomputable abbreviation c2 (f : C(X, A)) : X → A :=
λ x, f (c' ε f (classical.some (exists_of_exists_unique (finset_clopen_prop ε f x)) )
begin
  have := (exists_prop.1 (exists_of_exists_unique (classical.some_spec
    (exists_of_exists_unique (finset_clopen_prop ε f x))))),
  split,
  refine finset.mem_coe.1 (this).1,
  apply set.nonempty.to_subtype,
  refine ⟨x, this.2⟩,
end).

/-- Any element of `finset_clopen` is open. -/
lemma mem_finset_clopen_is_open {U : set X} (hU : U ∈ finset_clopen ε f) : is_open U :=
by { rw finset_clopen at hU, apply (finset_clopen_is_clopen ε f hU).1, }

/-- An equivalent version of `disj`. -/
lemma mem_finset_clopen_unique' {U V : set X} {y : X}
  (hU : U ∈ finset_clopen ε f) (hUy : y ∈ U) (hVy : y ∈ V) (hV : V ∈ finset_clopen ε f) : V = U :=
begin
  by_contra,
  have := (classical.some_spec (is_clopen.clopen_Union_disjoint
    (set.finite.to_finset (fin ε f)) (λ x hx, (is_clopen_x ε f hx)))).2.2.2 _ _ hV hU h,
  revert this,
  --change (V ∩ U) ≠ ∅,
  refine set.nonempty.ne_empty ⟨y, set.mem_inter hVy hUy⟩,
end

/-- Given `x` in `X`, there is a unique element `U` of `finset_clopen` such that `x ∈ U`. For any
  `y ∈ U`, `y` is contained in any other element `V` of `finset_clopen` containing `x`. -/
lemma mem_finset_clopen_unique {U V : set X} {x y : X}
  (U_prop : (U ∈ finset_clopen ε f ∧ x ∈ U) ∧ ∀ (y : set X), y ∈ finset_clopen ε f →
    x ∈ y → y = U) (hy : y ∈ U) (hV : V ∈ finset_clopen ε f) : x ∈ V ↔ y ∈ V :=
begin
  obtain ⟨W, hW⟩ := finset_clopen_prop ε f y,
  simp only [and_imp, exists_prop, exists_unique_iff_exists] at hW,
  split; intro h,
  { rw U_prop.2 V hV h, assumption, },
  { rw hW.2 V hV h, rw ←(hW.2 U U_prop.1.1 hy), apply U_prop.1.2, },
end

/-- `c2` is locally constant -/
lemma loc_const : is_locally_constant (c2 ε f) :=
begin
  rw is_locally_constant.iff_exists_open, rintros x,
  obtain ⟨U, hU⟩ := finset_clopen_prop ε f x,
  simp only [and_imp, exists_prop, exists_unique_iff_exists] at hU,
  refine ⟨U, mem_finset_clopen_is_open ε f hU.1.1, hU.1.2, λ x' hx', _⟩,
  delta c2,
  congr',
  swap 4, ext y, revert y, rw ←set.ext_iff, congr, -- is there a better way to do this?
  any_goals
  { ext y, simp only [exists_prop, and.congr_right_iff, exists_unique_iff_exists],
    intro hy, symmetry, apply mem_finset_clopen_unique ε f hU hx' hy, },
end

/-- Given an `f ∈ C(X, A)` and an `ε > 0`, one can find a locally constant function `b` which is in
  an ε-ball with center `f`, `b` is precisely `c2`. -/
theorem loc_const_dense' : ∃ (b : C(X, A)) (H_1 : b ∈ set.range (inclusion X A)),
  dist f b < ε := ⟨inclusion X A ⟨c2 ε f, loc_const ε f⟩, ⟨⟨c2 ε f, loc_const ε f⟩, rfl⟩,
  gt_of_gt_of_ge (half_lt_self (fact.out _))
begin
-- showing that the distance between `f` and `c2` is less than or equal to `ε/2`
  rw [dist_eq_norm, continuous_map.norm_eq_supr_norm],
  -- empty type is special case
  cases is_empty_or_nonempty X with hempty hnonempty,
  { change _ ≥ dite _ _ _,
    split_ifs with h,
    { rcases h with ⟨⟨_, x, _⟩, _⟩,
      exact (@is_empty.false _ hempty x).elim },
    exact le_of_lt (half_pos (fact.out _)) },
-- writing the distance in terms of the sup norm
  refine cSup_le _ (λ m hm, _),
  { rw set.range_nonempty_iff_nonempty, assumption, }, -- this is where `nonempty X` is needed
  { cases hm with y hy,
    simp only [continuous_map.coe_sub, locally_constant.coe_mk,
      locally_constant.to_continuous_map_linear_map_apply, pi.sub_apply,
      locally_constant.coe_continuous_map] at hy,
    rw ←hy,
    -- reduced to proving ∥f(y) - c2(y)∥ ≤ ε/2
    obtain ⟨w, wT, hw⟩ := finset_clopen_prop ε f y,
    -- `w` is the unique element of `finset_clopen` to which `y` belongs
    simp only [exists_prop, exists_unique_iff_exists] at wT,
    simp only [and_imp, exists_prop, exists_unique_iff_exists] at hw,
    have : c2 ε f y = f (c' ε f w ⟨wT.1, ⟨⟨y, wT.2⟩⟩⟩),
    -- showing that `w` is the same as the `classical.some _` used in `c2`
    { delta c2, congr',
      any_goals
      { have := classical.some_spec (exists_of_exists_unique (finset_clopen_prop ε f y)),
        simp only [exists_prop, exists_unique_iff_exists] at *,
        apply hw _ (this.1) (this.2), }, },
    rw this,
    obtain ⟨U, hU, wU⟩ := exists_sub_S ε f wT.1,
    -- `U` is a set of `A` which is an element of `S` and contains `f(w)`
    cases hU with z hz,
    -- `U` is the `ε/4`-ball centered at `z`
    have mem_U : f (c' ε f w ⟨wT.1, ⟨⟨y, wT.2⟩⟩⟩) ∈ U :=
      wU ⟨(c' ε f w ⟨wT.1, ⟨⟨y, wT.2⟩⟩⟩), subtype.coe_prop _, rfl⟩,
    have tS : f y ∈ U := wU ⟨y, wT.2, rfl⟩,
    rw [hz.symm, mem_ball_iff_norm] at *,
    conv_lhs { rw sub_eq_sub_add_sub _ _ z, },
    -- unfolding everything in terms of `z`, and then using `mem_U` and `tS`
    have : ε/2 = ε/4 + ε/4, { rw div_add_div_same, linarith, },
    rw this, apply norm_add_le_of_le (le_of_lt _) (le_of_lt tS),
    rw ←norm_neg _, simp only [mem_U, neg_sub], },
end ⟩

variable (X)
/-- The locally constant functions from `X` to `A` (viewed as a subset of C(X, A)) are dense
  in C(X, A). -/
theorem loc_const_dense : dense (set.range (inclusion X A)) :=
  λ f, begin
  rw metric.mem_closure_iff,
  rintros ε hε,
  haveI : fact (0 < ε) := fact.mk hε,
-- we have all the ingredients from `loc_const_dense'`, only need `exists_finset_univ_sub_prop`
  apply loc_const_dense' ε f,
end

end locally_constant.density

variables (X) (A)

/-- Given a profinite space `X` and a normed commutative ring `A`, a `p-adic measure` is a
  "bounded" linear map from the locally constant functions from `X` to `A` to `A` -/
def measures :=
  {φ : (locally_constant X A) →ₗ[A] A //
    ∃ K : ℝ, 0 < K ∧ ∀ f : (locally_constant X A), ∥φ f∥ ≤ K * ∥inclusion X A f∥ }

instance : has_zero (measures X A) :=
{ zero := ⟨0, ⟨1, ⟨zero_lt_one,
  λ f, by { simp only [norm_zero, one_mul, norm_nonneg, linear_map.zero_apply], } ⟩ ⟩ ⟩, }

noncomputable instance : inhabited (measures X A) := classical.inhabited_of_nonempty'

/-- Giving `locally_constant` the normed group structure induced from `C(X, A)` -/
noncomputable instance : normed_group (locally_constant X A) :=
  normed_group.induced locally_constant.to_continuous_map_add_monoid_hom
  locally_constant.to_continuous_map_injective

-- probably should be "measure"
namespace measure
open locally_constant.density

variables {X} {A}

instance : has_coe_to_fun (measures X A) _ := { coe := λ φ, φ.1, }

/-- Any measure is uniformly continuous -/
lemma uniform_continuous (φ : measures X A) : uniform_continuous ⇑φ :=
begin
  refine metric.uniform_continuous_iff.mpr (λ ε hε, _),
  obtain ⟨K, hKpos, hK⟩ := φ.prop,
  refine ⟨ε/K, div_pos hε hKpos, λ a b dab, _⟩, -- 0 < K needed here
  rw [dist_eq_norm, ←linear_map.map_sub],
  specialize hK (a - b), apply lt_of_le_of_lt hK _, rw [mul_comm, ←lt_div_iff hKpos],
  convert dab,
  change ∥inclusion X A (a - b)∥ = dist (inclusion X A a) (inclusion X A b),
  rw [dist_eq_norm, ← linear_map.map_sub],
end

lemma integral_cont (φ : measures X A) : continuous ⇑φ :=
  uniform_continuous.continuous (uniform_continuous _)

variables (X) (A)

/-- The inclusion map from `locally_constant X A` to `C(X, A)` is uniform inducing -/
lemma uni_ind : uniform_inducing (inclusion X A) := ⟨rfl⟩

variables [t2_space X] [totally_disconnected_space X]

/-- The inclusion map from `locally_constant X A` to `C(X, A)` is dense inducing -/
lemma dense_ind_inclusion : dense_inducing (inclusion X A) :=
  ⟨⟨rfl⟩, loc_const_dense X⟩

variables {X} {A}

/-- If `A` is a complete space, the extension of `measure X A` to C(X, A) → A is
  uniformly continuous -/
lemma uniform_continuous_extend [complete_space A] (φ : measures X A) :
  _root_.uniform_continuous ((dense_ind_inclusion X A).extend ⇑φ) :=
  uniform_continuous_uniformly_extend (uni_ind X A)
    (dense_inducing.dense (dense_ind_inclusion X A)) (uniform_continuous φ)

/-- The extension of `measures X A` to C(X, A) → A is continuous when `A` is a complete space -/
lemma cont [complete_space A] (φ : measures X A) :
  continuous ((dense_ind_inclusion X A).extend ⇑φ) :=
  uniform_continuous.continuous (uniform_continuous_extend φ)

/-- The extended map is additive -/
lemma map_add_extend [complete_space A] (φ : measures X A) (x y : C(X, A)) :
  (dense_ind_inclusion X A).extend ⇑⇑φ (x + y) =
  (dense_ind_inclusion X A).extend ⇑⇑φ x + (dense_ind_inclusion X A).extend ⇑⇑φ y :=
begin
  have cont := cont φ,
  have di := dense_ind_inclusion X A,
--   it is sufficient to restrict to `inclusion`, since it has dense range
  refine dense_range.induction_on₂ di.dense
    (is_closed_eq (cont.comp continuous_add)
      ((cont.comp continuous_fst).add (cont.comp continuous_snd))) (λ a b, _) x y,
--   restricting to `inclusion`
    rw [← linear_map.map_add, dense_inducing.extend_eq di (integral_cont φ)],
    simp only [dense_inducing.extend_eq di (integral_cont φ), linear_map.map_add _ a b],
end

/-- The extended map preserves smul -/
lemma map_smul_extend [complete_space A] (φ : measures X A) (m : A) (x : C(X, A)) :
  (dense_ind_inclusion X A).extend ⇑⇑φ (m • x) =
  m • (dense_ind_inclusion X A).extend ⇑⇑φ x :=
begin
  have cont := cont φ,
  have di := dense_ind_inclusion X A,
--   it is sufficient to restrict to `inclusion`, since it has dense range
  refine dense_range.induction_on di.dense x
    (is_closed_eq (cont.comp (continuous_const.smul continuous_id))
      ((continuous_const.smul continuous_id).comp cont)) (λ a, _),
--   restricting to `inclusion`
    rw [← linear_map.map_smul, dense_inducing.extend_eq di (integral_cont φ)],
    simp only [dense_inducing.extend_eq di (integral_cont φ), linear_map.map_smul _ m a],
end

/-- Given a profinite space `X` and a normed commutative ring `A`, and a `p-adic measure` φ, the
  `p-adic integral` on a locally constant function `f` from `X` to `A` is φ(f). This map can then
  be extended continuously and linearly to C(X, A), due to `loc_const_dense`. We use the dense
  inducing and uniform continuity properties of the map `inclusion X A`. -/
noncomputable def integral [complete_space A] (φ : measures X A) :
  continuous_linear_map (ring_hom.id A) C(X, A) A :=
  ⟨{ to_fun := (dense_ind_inclusion X A).extend (⇑⇑φ),
     map_add' := λ x y, map_add_extend φ x y,
     map_smul' := λ m x, map_smul_extend φ m x, },
     cont φ⟩

end measure


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Eric Wieser
-/

import linear_algebra.quadratic_form.basic

/-!
# Isometries with respect to quadratic forms

## Main definitions

* `quadratic_form.isometry`: `linear_equiv`s which map between two different quadratic forms
* `quadratic_form.equvialent`: propositional version of the above

## Main results

* `equivalent_weighted_sum_squares`: in finite dimensions, any quadratic form is equivalent to a
  parametrization of `quadratic_form.weighted_sum_squares`.
-/

variables {ι R K M M₁ M₂ M₃ V : Type*}

namespace quadratic_form

variables [semiring R]
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [module R M] [module R M₁] [module R M₂] [module R M₃]

/-- An isometry between two quadratic spaces `M₁, Q₁` and `M₂, Q₂` over a ring `R`,
is a linear equivalence between `M₁` and `M₂` that commutes with the quadratic forms. -/
@[nolint has_nonempty_instance] structure isometry
  (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) extends M₁ ≃ₗ[R] M₂ :=
(map_app' : ∀ m, Q₂ (to_fun m) = Q₁ m)

/-- Two quadratic forms over a ring `R` are equivalent
if there exists an isometry between them:
a linear equivalence that transforms one quadratic form into the other. -/
def equivalent (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) := nonempty (Q₁.isometry Q₂)

namespace isometry

variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}

instance : has_coe (Q₁.isometry Q₂) (M₁ ≃ₗ[R] M₂) := ⟨isometry.to_linear_equiv⟩

@[simp] lemma to_linear_equiv_eq_coe (f : Q₁.isometry Q₂) : f.to_linear_equiv = f := rfl

instance : has_coe_to_fun (Q₁.isometry Q₂) (λ _, M₁ → M₂) := ⟨λ f, ⇑(f : M₁ ≃ₗ[R] M₂)⟩

@[simp] lemma coe_to_linear_equiv (f : Q₁.isometry Q₂) : ⇑(f : M₁ ≃ₗ[R] M₂) = f := rfl

@[simp] lemma map_app (f : Q₁.isometry Q₂) (m : M₁) : Q₂ (f m) = Q₁ m := f.map_app' m

/-- The identity isometry from a quadratic form to itself. -/
@[refl]
def refl (Q : quadratic_form R M) : Q.isometry Q :=
{ map_app' := λ m, rfl,
  .. linear_equiv.refl R M }

/-- The inverse isometry of an isometry between two quadratic forms. -/
@[symm]
def symm (f : Q₁.isometry Q₂) : Q₂.isometry Q₁ :=
{ map_app' := by { intro m, rw ← f.map_app, congr, exact f.to_linear_equiv.apply_symm_apply m },
  .. (f : M₁ ≃ₗ[R] M₂).symm }

/-- The composition of two isometries between quadratic forms. -/
@[trans]
def trans (f : Q₁.isometry Q₂) (g : Q₂.isometry Q₃) : Q₁.isometry Q₃ :=
{ map_app' := by { intro m, rw [← f.map_app, ← g.map_app], refl },
  .. (f : M₁ ≃ₗ[R] M₂).trans (g : M₂ ≃ₗ[R] M₃) }

end isometry

namespace equivalent

variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}

@[refl]
lemma refl (Q : quadratic_form R M) : Q.equivalent Q := ⟨isometry.refl Q⟩

@[symm]
lemma symm (h : Q₁.equivalent Q₂) : Q₂.equivalent Q₁ := h.elim $ λ f, ⟨f.symm⟩

@[trans]
lemma trans (h : Q₁.equivalent Q₂) (h' : Q₂.equivalent Q₃) : Q₁.equivalent Q₃ :=
h'.elim $ h.elim $ λ f g, ⟨f.trans g⟩

end equivalent

variables [fintype ι] {v : basis ι R M}

/-- A quadratic form composed with a `linear_equiv` is isometric to itself. -/
def isometry_of_comp_linear_equiv (Q : quadratic_form R M) (f : M₁ ≃ₗ[R] M) :
  Q.isometry (Q.comp (f : M₁ →ₗ[R] M)) :=
{ map_app' :=
  begin
    intro,
    simp only [comp_apply, linear_equiv.coe_coe, linear_equiv.to_fun_eq_coe,
               linear_equiv.apply_symm_apply, f.apply_symm_apply],
  end,
  .. f.symm }

/-- A quadratic form is isometric to its bases representations. -/
noncomputable def isometry_basis_repr (Q : quadratic_form R M) (v : basis ι R M) :
  isometry Q (Q.basis_repr v) :=
isometry_of_comp_linear_equiv Q v.equiv_fun.symm

variables [field K] [invertible (2 : K)] [add_comm_group V] [module K V]

/-- Given an orthogonal basis, a quadratic form is isometric with a weighted sum of squares. -/
noncomputable def isometry_weighted_sum_squares (Q : quadratic_form K V)
  (v : basis (fin (finite_dimensional.finrank K V)) K V)
  (hv₁ : (associated Q).is_Ortho v) :
  Q.isometry (weighted_sum_squares K (λ i, Q (v i))) :=
begin
  let iso := Q.isometry_basis_repr v,
  refine ⟨iso, λ m, _⟩,
  convert iso.map_app m,
  rw basis_repr_eq_of_is_Ortho _ _ hv₁,
end

variables [finite_dimensional K V]

open bilin_form

lemma equivalent_weighted_sum_squares (Q : quadratic_form K V) :
  ∃ w : fin (finite_dimensional.finrank K V) → K, equivalent Q (weighted_sum_squares K w) :=
let ⟨v, hv₁⟩ := exists_orthogonal_basis (associated_is_symm _ Q) in
  ⟨_, ⟨Q.isometry_weighted_sum_squares v hv₁⟩⟩

lemma equivalent_weighted_sum_squares_units_of_nondegenerate'
  (Q : quadratic_form K V) (hQ : (associated Q).nondegenerate) :
  ∃ w : fin (finite_dimensional.finrank K V) → Kˣ,
    equivalent Q (weighted_sum_squares K w) :=
begin
  obtain ⟨v, hv₁⟩ := exists_orthogonal_basis (associated_is_symm _ Q),
  have hv₂ := hv₁.not_is_ortho_basis_self_of_nondegenerate hQ,
  simp_rw [is_ortho, associated_eq_self_apply] at hv₂,
  exact ⟨λ i, units.mk0 _ (hv₂ i), ⟨Q.isometry_weighted_sum_squares v hv₁⟩⟩,
end

end quadratic_form


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.free
import algebra.monoid_algebra.basic

/-!
# Free algebras

Given a semiring `R` and a type `X`, we construct the free non-unital, non-associative algebra on
`X` with coefficients in `R`, together with its universal property. The construction is valuable
because it can be used to build free algebras with more structure, e.g., free Lie algebras.

Note that elsewhere we have a construction of the free unital, associative algebra. This is called
`free_algebra`.

## Main definitions

  * `free_non_unital_non_assoc_algebra`
  * `free_non_unital_non_assoc_algebra.lift`
  * `free_non_unital_non_assoc_algebra.of`

## Implementation details

We construct the free algebra as the magma algebra, with coefficients in `R`, of the free magma on
`X`. However we regard this as an implementation detail and thus deliberately omit the lemmas
`of_apply` and `lift_apply`, and we mark `free_non_unital_non_assoc_algebra` and `lift` as
irreducible once we have established the universal property.

## Tags

free algebra, non-unital, non-associative, free magma, magma algebra, universal property,
forgetful functor, adjoint functor
-/

universes u v w

noncomputable theory

variables (R : Type u) (X : Type v) [semiring R]

/-- The free non-unital, non-associative algebra on the type `X` with coefficients in `R`. -/
@[derive [inhabited, non_unital_non_assoc_semiring, module R]]
def free_non_unital_non_assoc_algebra := monoid_algebra R (free_magma X)

namespace free_non_unital_non_assoc_algebra

variables {X}

/-- The embedding of `X` into the free algebra with coefficients in `R`. -/
def of : X → free_non_unital_non_assoc_algebra R X :=
(monoid_algebra.of_magma R _) ∘ free_magma.of

instance : is_scalar_tower R
  (free_non_unital_non_assoc_algebra R X) (free_non_unital_non_assoc_algebra R X) :=
monoid_algebra.is_scalar_tower_self R

/-- If the coefficients are commutative amongst themselves, they also commute with the algebra
multiplication. -/
instance (R : Type u) [comm_semiring R] : smul_comm_class R
  (free_non_unital_non_assoc_algebra R X) (free_non_unital_non_assoc_algebra R X) :=
monoid_algebra.smul_comm_class_self R

instance (R : Type u) [ring R] : add_comm_group (free_non_unital_non_assoc_algebra R X) :=
module.add_comm_monoid_to_add_comm_group R

variables {A : Type w} [non_unital_non_assoc_semiring A]
variables [module R A] [is_scalar_tower R A A] [smul_comm_class R A A]

/-- The functor `X ↦ free_non_unital_non_assoc_algebra R X` from the category of types to the
category of non-unital, non-associative algebras over `R` is adjoint to the forgetful functor in the
other direction. -/
def lift : (X → A) ≃ non_unital_alg_hom R (free_non_unital_non_assoc_algebra R X) A :=
free_magma.lift.trans (monoid_algebra.lift_magma R)

@[simp] lemma lift_symm_apply (F : non_unital_alg_hom R (free_non_unital_non_assoc_algebra R X) A) :
  (lift R).symm F = F ∘ (of R) :=
rfl

@[simp] lemma of_comp_lift (f : X → A) : (lift R f) ∘ (of R) = f :=
(lift R).left_inv f

@[simp] lemma lift_unique
  (f : X → A) (F : non_unital_alg_hom R (free_non_unital_non_assoc_algebra R X) A) :
  F ∘ (of R) = f ↔ F = lift R f :=
(lift R).symm_apply_eq

attribute [irreducible] of lift

@[simp] lemma lift_of_apply (f : X → A) (x) : lift R f (of R x) = f x :=
by rw [← function.comp_app (lift R f) (of R) x, of_comp_lift]

@[simp] lemma lift_comp_of (F : non_unital_alg_hom R (free_non_unital_non_assoc_algebra R X) A) :
  lift R (F ∘ (of R)) = F :=
by rw [← lift_symm_apply, equiv.apply_symm_apply]

@[ext] lemma hom_ext {F₁ F₂ : non_unital_alg_hom R (free_non_unital_non_assoc_algebra R X) A}
  (h : ∀ x, F₁ (of R x) = F₂ (of R x)) : F₁ = F₂ :=
have h' : (lift R).symm F₁ = (lift R).symm F₂, { ext, simp [h], },
(lift R).symm.injective h'

end free_non_unital_non_assoc_algebra


#check @and.intro -- and.intro : ∀ {a b : Prop}, a → b → a ∧ b

lemma proof_irrelevance {a : Prop} (h₁ h₂ : a) :
  h₁ = h₂ := rfl

/-
  In Lean, this equality is a syntactic equality up to computation, allowing us to use
the refl tactic. When viewing a proposition as a type and a proof as an element
of that type, proof irrelevance means that a proposition is either an empty type or
has exactly one inhabitant. If it is empty, it is false. If it has exactly one inhabitant,
it is true. Proof irrelevance is very helpful when reasoning about dependent types.

  An unfortunate consequence of proof irrelevance is that it prevents us from
performing rule induction by pattern matching. Induction by pattern matching
relies on a “measure”—a function to N that assigns a size to the arguments.
Without large elimination, the measure cannot be defined meaningfully.
This explains why we always use the induction tactic for rule induction.
-/


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.group.defs
import logic.nontrivial
import algebra.ne_zero

/-!
# Typeclasses for groups with an adjoined zero element

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

This file provides just the typeclass definitions, and the projection lemmas that expose their
members.

## Main definitions

* `group_with_zero`
* `comm_group_with_zero`
-/

set_option old_structure_cmd true

universe u

-- We have to fix the universe of `G₀` here, since the default argument to
-- `group_with_zero.div'` cannot contain a universe metavariable.
variables {G₀ : Type u} {M₀ M₀' G₀' : Type*}

/-- Typeclass for expressing that a type `M₀` with multiplication and a zero satisfies
`0 * a = 0` and `a * 0 = 0` for all `a : M₀`. -/
@[protect_proj, ancestor has_mul has_zero]
class mul_zero_class (M₀ : Type*) extends has_mul M₀, has_zero M₀ :=
(zero_mul : ∀ a : M₀, 0 * a = 0)
(mul_zero : ∀ a : M₀, a * 0 = 0)

section mul_zero_class

variables [mul_zero_class M₀] {a b : M₀}

@[ematch, simp] lemma zero_mul (a : M₀) : 0 * a = 0 :=
mul_zero_class.zero_mul a

@[ematch, simp] lemma mul_zero (a : M₀) : a * 0 = 0 :=
mul_zero_class.mul_zero a

end mul_zero_class

/-- A mixin for left cancellative multiplication by nonzero elements. -/
@[protect_proj] class is_left_cancel_mul_zero (M₀ : Type u) [has_mul M₀] [has_zero M₀] : Prop :=
(mul_left_cancel_of_ne_zero : ∀ {a b c : M₀}, a ≠ 0 → a * b = a * c → b = c)

section is_left_cancel_mul_zero

variables [has_mul M₀] [has_zero M₀] [is_left_cancel_mul_zero M₀] {a b c : M₀}

lemma mul_left_cancel₀ (ha : a ≠ 0) (h : a * b = a * c) : b = c :=
is_left_cancel_mul_zero.mul_left_cancel_of_ne_zero ha h

lemma mul_right_injective₀ (ha : a ≠ 0) : function.injective ((*) a) :=
λ b c, mul_left_cancel₀ ha

end is_left_cancel_mul_zero

/-- A mixin for right cancellative multiplication by nonzero elements. -/
@[protect_proj] class is_right_cancel_mul_zero (M₀ : Type u) [has_mul M₀] [has_zero M₀] : Prop :=
(mul_right_cancel_of_ne_zero : ∀ {a b c : M₀}, b ≠ 0 → a * b = c * b → a = c)

section is_right_cancel_mul_zero

variables [has_mul M₀] [has_zero M₀] [is_right_cancel_mul_zero M₀] {a b c : M₀}

lemma mul_right_cancel₀ (hb : b ≠ 0) (h : a * b = c * b) : a = c :=
is_right_cancel_mul_zero.mul_right_cancel_of_ne_zero hb h

lemma mul_left_injective₀ (hb : b ≠ 0) : function.injective (λ a, a * b) :=
λ a c, mul_right_cancel₀ hb

end is_right_cancel_mul_zero

/-- A mixin for cancellative multiplication by nonzero elements. -/
@[protect_proj] class is_cancel_mul_zero (M₀ : Type u) [has_mul M₀] [has_zero M₀]
  extends is_left_cancel_mul_zero M₀, is_right_cancel_mul_zero M₀ : Prop

section comm_semigroup_with_zero

variables [comm_semigroup M₀] [has_zero M₀]

lemma is_left_cancel_mul_zero.to_is_right_cancel_mul_zero [is_left_cancel_mul_zero M₀] :
  is_right_cancel_mul_zero M₀ :=
⟨λ a b c ha h, mul_left_cancel₀ ha $ (mul_comm _ _).trans $ (h.trans (mul_comm _ _))⟩

lemma is_right_cancel_mul_zero.to_is_left_cancel_mul_zero [is_right_cancel_mul_zero M₀] :
  is_left_cancel_mul_zero M₀ :=
⟨λ a b c ha h, mul_right_cancel₀ ha $ (mul_comm _ _).trans $ (h.trans (mul_comm _ _))⟩

lemma is_left_cancel_mul_zero.to_is_cancel_mul_zero [is_left_cancel_mul_zero M₀] :
  is_cancel_mul_zero M₀ :=
{ .. ‹is_left_cancel_mul_zero M₀›, .. is_left_cancel_mul_zero.to_is_right_cancel_mul_zero }

lemma is_right_cancel_mul_zero.to_is_cancel_mul_zero [is_right_cancel_mul_zero M₀] :
  is_cancel_mul_zero M₀ :=
{ .. ‹is_right_cancel_mul_zero M₀›, .. is_right_cancel_mul_zero.to_is_left_cancel_mul_zero }

end comm_semigroup_with_zero

/-- Predicate typeclass for expressing that `a * b = 0` implies `a = 0` or `b = 0`
for all `a` and `b` of type `G₀`. -/
class no_zero_divisors (M₀ : Type*) [has_mul M₀] [has_zero M₀] : Prop :=
(eq_zero_or_eq_zero_of_mul_eq_zero : ∀ {a b : M₀}, a * b = 0 → a = 0 ∨ b = 0)

export no_zero_divisors (eq_zero_or_eq_zero_of_mul_eq_zero)

/-- A type `S₀` is a "semigroup with zero” if it is a semigroup with zero element, and `0` is left
and right absorbing. -/
@[protect_proj, ancestor semigroup mul_zero_class]
class semigroup_with_zero (S₀ : Type*) extends semigroup S₀, mul_zero_class S₀.

/- By defining this _after_ `semigroup_with_zero`, we ensure that searches for `mul_zero_class` find
this class first. -/
/-- A typeclass for non-associative monoids with zero elements. -/
@[protect_proj, ancestor mul_one_class mul_zero_class]
class mul_zero_one_class (M₀ : Type*) extends mul_one_class M₀, mul_zero_class M₀.

/-- A type `M₀` is a “monoid with zero” if it is a monoid with zero element, and `0` is left
and right absorbing. -/
@[protect_proj, ancestor monoid mul_zero_one_class]
class monoid_with_zero (M₀ : Type*) extends monoid M₀, mul_zero_one_class M₀.

@[priority 100] -- see Note [lower instance priority]
instance monoid_with_zero.to_semigroup_with_zero (M₀ : Type*) [monoid_with_zero M₀] :
  semigroup_with_zero M₀ :=
{ ..‹monoid_with_zero M₀› }

/-- A type `M` is a `cancel_monoid_with_zero` if it is a monoid with zero element, `0` is left
and right absorbing, and left/right multiplication by a non-zero element is injective. -/
@[protect_proj, ancestor monoid_with_zero]
class cancel_monoid_with_zero (M₀ : Type*) extends monoid_with_zero M₀ :=
(mul_left_cancel_of_ne_zero : ∀ {a b c : M₀}, a ≠ 0 → a * b = a * c → b = c)
(mul_right_cancel_of_ne_zero : ∀ {a b c : M₀}, b ≠ 0 → a * b = c * b → a = c)

/-- A `cancel_monoid_with_zero` satisfies `is_cancel_mul_zero`. -/
@[priority 100]
instance cancel_monoid_with_zero.to_is_cancel_mul_zero [cancel_monoid_with_zero M₀] :
  is_cancel_mul_zero M₀ :=
{ .. ‹cancel_monoid_with_zero M₀› }

/-- A type `M` is a commutative “monoid with zero” if it is a commutative monoid with zero
element, and `0` is left and right absorbing. -/
@[protect_proj, ancestor comm_monoid monoid_with_zero]
class comm_monoid_with_zero (M₀ : Type*) extends comm_monoid M₀, monoid_with_zero M₀.

/-- A type `M` is a `cancel_comm_monoid_with_zero` if it is a commutative monoid with zero element,
 `0` is left and right absorbing,
  and left/right multiplication by a non-zero element is injective. -/
@[protect_proj, ancestor comm_monoid_with_zero cancel_monoid_with_zero]
class cancel_comm_monoid_with_zero (M₀ : Type*) extends comm_monoid_with_zero M₀ :=
(mul_left_cancel_of_ne_zero : ∀ {a b c : M₀}, a ≠ 0 → a * b = a * c → b = c)

@[priority 100]
instance cancel_comm_monoid_with_zero.to_cancel_monoid_with_zero
  [h : cancel_comm_monoid_with_zero M₀] : cancel_monoid_with_zero M₀ :=
{ .. h, .. @is_left_cancel_mul_zero.to_is_right_cancel_mul_zero M₀ _ _ { .. h } }

/-- A type `G₀` is a “group with zero” if it is a monoid with zero element (distinct from `1`)
such that every nonzero element is invertible.
The type is required to come with an “inverse” function, and the inverse of `0` must be `0`.

Examples include division rings and the ordered monoids that are the
target of valuations in general valuation theory.-/
@[protect_proj, ancestor monoid_with_zero div_inv_monoid nontrivial]
class group_with_zero (G₀ : Type u) extends
  monoid_with_zero G₀, div_inv_monoid G₀, nontrivial G₀ :=
(inv_zero : (0 : G₀)⁻¹ = 0)
(mul_inv_cancel : ∀ a:G₀, a ≠ 0 → a * a⁻¹ = 1)

section group_with_zero

variables [group_with_zero G₀]

@[simp] lemma inv_zero : (0 : G₀)⁻¹ = 0 :=
group_with_zero.inv_zero

@[simp] lemma mul_inv_cancel {a : G₀} (h : a ≠ 0) : a * a⁻¹ = 1 :=
group_with_zero.mul_inv_cancel a h

end group_with_zero

/-- A type `G₀` is a commutative “group with zero”
if it is a commutative monoid with zero element (distinct from `1`)
such that every nonzero element is invertible.
The type is required to come with an “inverse” function, and the inverse of `0` must be `0`. -/
@[protect_proj, ancestor comm_monoid_with_zero group_with_zero]
class comm_group_with_zero (G₀ : Type*) extends comm_monoid_with_zero G₀, group_with_zero G₀.

section ne_zero

attribute [field_simps] two_ne_zero three_ne_zero four_ne_zero

variables [mul_zero_one_class M₀] [nontrivial M₀] {a b : M₀}

variable (M₀)

/-- In a nontrivial monoid with zero, zero and one are different. -/
instance ne_zero.one : ne_zero (1 : M₀) :=
⟨begin
  assume h,
  rcases exists_pair_ne M₀ with ⟨x, y, hx⟩,
  apply hx,
  calc x = 1 * x : by rw [one_mul]
  ... = 0 : by rw [h, zero_mul]
  ... = 1 * y : by rw [h, zero_mul]
  ... = y : by rw [one_mul]
end⟩

variable {M₀}

/-- Pullback a `nontrivial` instance along a function sending `0` to `0` and `1` to `1`. -/
lemma pullback_nonzero [has_zero M₀'] [has_one M₀']
  (f : M₀' → M₀) (zero : f 0 = 0) (one : f 1 = 1) : nontrivial M₀' :=
⟨⟨0, 1, mt (congr_arg f) $ by { rw [zero, one], exact zero_ne_one }⟩⟩

end ne_zero

section mul_zero_class

variables [mul_zero_class M₀]

lemma mul_eq_zero_of_left {a : M₀} (h : a = 0) (b : M₀) : a * b = 0 := h.symm ▸ zero_mul b

lemma mul_eq_zero_of_right (a : M₀) {b : M₀} (h : b = 0) : a * b = 0 := h.symm ▸ mul_zero a

variables [no_zero_divisors M₀] {a b : M₀}

/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them
equals zero. -/
@[simp] theorem mul_eq_zero : a * b = 0 ↔ a = 0 ∨ b = 0 :=
⟨eq_zero_or_eq_zero_of_mul_eq_zero,
  λo, o.elim (λ h, mul_eq_zero_of_left h b) (mul_eq_zero_of_right a)⟩

/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them
equals zero. -/
@[simp] theorem zero_eq_mul : 0 = a * b ↔ a = 0 ∨ b = 0 :=
by rw [eq_comm, mul_eq_zero]

/-- If `α` has no zero divisors, then the product of two elements is nonzero iff both of them
are nonzero. -/
theorem mul_ne_zero_iff : a * b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 :=
mul_eq_zero.not.trans not_or_distrib

/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` equals zero iff so is
`b * a`. -/
theorem mul_eq_zero_comm : a * b = 0 ↔ b * a = 0 :=
mul_eq_zero.trans $ (or_comm _ _).trans mul_eq_zero.symm

/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` is nonzero iff so is
`b * a`. -/
theorem mul_ne_zero_comm : a * b ≠ 0 ↔ b * a ≠ 0 :=
mul_eq_zero_comm.not

lemma mul_self_eq_zero : a * a = 0 ↔ a = 0 := by simp
lemma zero_eq_mul_self : 0 = a * a ↔ a = 0 := by simp
lemma mul_self_ne_zero : a * a ≠ 0 ↔ a ≠ 0 := mul_self_eq_zero.not
lemma zero_ne_mul_self : 0 ≠ a * a ↔ a ≠ 0 := zero_eq_mul_self.not

end mul_zero_class


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .subst .congr .mod .prf

universe u
variables {σ : Type u} {sig : σ → ℕ} {I : Type*} (ax : I → eqn sig)
include sig ax

instance prf_congr : congruence (term_alg sig) :=
{ r := λ t u, nonempty (proof ax t u)
, iseqv :=
  mk_equivalence _
    (λ t, ⟨proof.reflexivity t⟩)
    (λ t u ⟨ptu⟩, ⟨proof.symmetry ptu⟩)
    (λ t u v ⟨ptu⟩ ⟨puv⟩, ⟨proof.transitivity ptu puv⟩),
  app := λ s ts us h,
  have nonempty (Π i : fin (sig s), proof ax (ts i) (us i)),
  from fin.choice h,
  nonempty.elim this (λ ps, ⟨proof.app s ps⟩)
}

lemma prf_congr_ax (i : I) : quotient_alg (prf_congr ax) ⊧ ax i :=
(quotient_sat (prf_congr ax)).mpr $
λ sub, ⟨proof.axm ax i sub⟩

lemma prf_exact {t u : term sig} :
(quotient_alg (prf_congr ax) ⊧ t ≡ u) → nonempty (ax ⊢ t ≡ u) :=
assume h,
let c := prf_congr ax in
let val := λ n, quotient_map c (term.var n) in
have quotient_map c t = quotient_map c u,
from calc
quotient_map c t
    = quotient_map c (subst subst.ident t) : by rw subst.subst_ident
... = eval (quotient_alg c) val t : by rw hom_eval (quotient_hom c)
... = eval (quotient_alg c) val u : h val
... = quotient_map c (subst subst.ident u) : by rw hom_eval (quotient_hom c)
... = quotient_map c u : by rw subst.subst_ident,
quotient_exact (prf_congr ax) this

theorem completeness {{t u : term sig}} : (ax ⊨ t ≡ u) → nonempty (ax ⊢ t ≡ u) :=
assume h, prf_exact ax (h (quotient_alg (prf_congr ax)) (prf_congr_ax ax))


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.localization
import Mathlib.ring_theory.int.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Gauss's Lemma

Gauss's Lemma is one of a few results pertaining to irreducibility of primitive polynomials.

## Main Results
 - `polynomial.is_primitive.irreducible_iff_irreducible_map_fraction_map`:
  A primitive polynomial is irreducible iff it is irreducible in a fraction field.
 - `polynomial.is_primitive.int.irreducible_iff_irreducible_map_cast`:
  A primitive polynomial over `ℤ` is irreducible iff it is irreducible over `ℚ`.
 - `polynomial.is_primitive.dvd_iff_fraction_map_dvd_fraction_map`:
  Two primitive polynomials divide each other iff they do in a fraction field.
 - `polynomial.is_primitive.int.dvd_iff_map_cast_dvd_map_cast`:
  Two primitive polynomials over `ℤ` divide each other if they do in `ℚ`.

-/

namespace polynomial

theorem is_primitive.is_unit_iff_is_unit_map_of_injective {R : Type u_1} [integral_domain R]
    [gcd_monoid R] {S : Type u_2} [integral_domain S] {φ : R →+* S} (hinj : function.injective ⇑φ)
    {f : polynomial R} (hf : is_primitive f) : is_unit f ↔ is_unit (map φ f) :=
  sorry

theorem is_primitive.irreducible_of_irreducible_map_of_injective {R : Type u_1} [integral_domain R]
    [gcd_monoid R] {S : Type u_2} [integral_domain S] {φ : R →+* S} (hinj : function.injective ⇑φ)
    {f : polynomial R} (hf : is_primitive f) (h_irr : irreducible (map φ f)) : irreducible f :=
  sorry

theorem is_primitive.is_unit_iff_is_unit_map {R : Type u_1} [integral_domain R] [gcd_monoid R]
    {K : Type u_2} [field K] (f : fraction_map R K) {p : polynomial R} (hp : is_primitive p) :
    is_unit p ↔ is_unit (map (localization_map.to_map f) p) :=
  is_primitive.is_unit_iff_is_unit_map_of_injective (fraction_map.injective f) hp

theorem is_unit_or_eq_zero_of_is_unit_integer_normalization_prim_part {R : Type u_1}
    [integral_domain R] [gcd_monoid R] {K : Type u_2} [field K] (f : fraction_map R K)
    {p : polynomial K} (h0 : p ≠ 0)
    (h : is_unit (prim_part (localization_map.integer_normalization f p))) : is_unit p :=
  sorry

/-- Gauss's Lemma states that a primitive polynomial is irreducible iff it is irreducible in the
  fraction field. -/
theorem is_primitive.irreducible_iff_irreducible_map_fraction_map {R : Type u_1} [integral_domain R]
    [gcd_monoid R] {K : Type u_2} [field K] (f : fraction_map R K) {p : polynomial R}
    (hp : is_primitive p) : irreducible p ↔ irreducible (map (localization_map.to_map f) p) :=
  sorry

theorem is_primitive.dvd_of_fraction_map_dvd_fraction_map {R : Type u_1} [integral_domain R]
    [gcd_monoid R] {K : Type u_2} [field K] (f : fraction_map R K) {p : polynomial R}
    {q : polynomial R} (hp : is_primitive p) (hq : is_primitive q)
    (h_dvd : map (localization_map.to_map f) p ∣ map (localization_map.to_map f) q) : p ∣ q :=
  sorry

theorem is_primitive.dvd_iff_fraction_map_dvd_fraction_map {R : Type u_1} [integral_domain R]
    [gcd_monoid R] {K : Type u_2} [field K] (f : fraction_map R K) {p : polynomial R}
    {q : polynomial R} (hp : is_primitive p) (hq : is_primitive q) :
    p ∣ q ↔ map (localization_map.to_map f) p ∣ map (localization_map.to_map f) q :=
  sorry

/-- Gauss's Lemma for `ℤ` states that a primitive integer polynomial is irreducible iff it is
  irreducible over `ℚ`. -/
theorem is_primitive.int.irreducible_iff_irreducible_map_cast {p : polynomial ℤ}
    (hp : is_primitive p) : irreducible p ↔ irreducible (map (int.cast_ring_hom ℚ) p) :=
  is_primitive.irreducible_iff_irreducible_map_fraction_map fraction_map.int.fraction_map hp

theorem is_primitive.int.dvd_iff_map_cast_dvd_map_cast (p : polynomial ℤ) (q : polynomial ℤ)
    (hp : is_primitive p) (hq : is_primitive q) :
    p ∣ q ↔ map (int.cast_ring_hom ℚ) p ∣ map (int.cast_ring_hom ℚ) q :=
  is_primitive.dvd_iff_fraction_map_dvd_fraction_map fraction_map.int.fraction_map hp hq

end Mathlib


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import measure_theory.integral.set_integral

/-!
# Integral average of a function

In this file we define `measure_theory.average μ f` (notation: `⨍ x, f x ∂μ`) to be the average
value of `f` with respect to measure `μ`. It is defined as `∫ x, f x ∂((μ univ)⁻¹ • μ)`, so it
is equal to zero if `f` is not integrable or if `μ` is an infinite measure. If `μ` is a probability
measure, then the average of any function is equal to its integral.

For the average on a set, we use `⨍ x in s, f x ∂μ` (notation for `⨍ x, f x ∂(μ.restrict s)`). For
average w.r.t. the volume, one can omit `∂volume`.

## Implementation notes

The average is defined as an integral over `(μ univ)⁻¹ • μ` so that all theorems about Bochner
integrals work for the average without modifications. For theorems that require integrability of a
function, we provide a convenience lemma `measure_theory.integrable.to_average`.

## Tags

integral, center mass, average value
-/

open measure_theory measure_theory.measure metric set filter topological_space function
open_locale topology big_operators ennreal convex

variables {α E F : Type*} {m0 : measurable_space α}
  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
  [normed_add_comm_group F] [normed_space ℝ F] [complete_space F]
  {μ : measure α} {s : set E}

/-!
### Average value of a function w.r.t. a measure

The average value of a function `f` w.r.t. a measure `μ` (notation: `⨍ x, f x ∂μ`) is defined as
`(μ univ).to_real⁻¹ • ∫ x, f x ∂μ`, so it is equal to zero if `f` is not integrable or if `μ` is an
infinite measure. If `μ` is a probability measure, then the average of any function is equal to its
integral.

-/

namespace measure_theory

variable (μ)
include m0

/-- Average value of a function `f` w.r.t. a measure `μ`, notation: `⨍ x, f x ∂μ`. It is defined as
`(μ univ).to_real⁻¹ • ∫ x, f x ∂μ`, so it is equal to zero if `f` is not integrable or if `μ` is an
infinite measure. If `μ` is a probability measure, then the average of any function is equal to its
integral.

For the average on a set, use `⨍ x in s, f x ∂μ` (defined as `⨍ x, f x ∂(μ.restrict s)`). For
average w.r.t. the volume, one can omit `∂volume`. -/
noncomputable def average (f : α → E) := ∫ x, f x ∂((μ univ)⁻¹ • μ)

notation `⨍` binders `, ` r:(scoped:60 f, f) ` ∂` μ:70 := average μ r
notation `⨍` binders `, ` r:(scoped:60 f, average volume f) := r
notation `⨍` binders ` in ` s `, ` r:(scoped:60 f, f) ` ∂` μ:70 := average (measure.restrict μ s) r
notation `⨍` binders ` in ` s `, ` r:(scoped:60 f, average (measure.restrict volume s) f) := r

@[simp] lemma average_zero : ⨍ x, (0 : E) ∂μ = 0 := by rw [average, integral_zero]

@[simp] lemma average_zero_measure (f : α → E) : ⨍ x, f x ∂(0 : measure α) = 0 :=
by rw [average, smul_zero, integral_zero_measure]

@[simp] lemma average_neg (f : α → E) : ⨍ x, -f x ∂μ = -⨍ x, f x ∂μ := integral_neg f

lemma average_eq' (f : α → E) : ⨍ x, f x ∂μ = ∫ x, f x ∂((μ univ)⁻¹ • μ) := rfl

lemma average_eq (f : α → E) : ⨍ x, f x ∂μ = (μ univ).to_real⁻¹ • ∫ x, f x ∂μ :=
by rw [average_eq', integral_smul_measure, ennreal.to_real_inv]

lemma average_eq_integral [is_probability_measure μ] (f : α → E) :
  ⨍ x, f x ∂μ = ∫ x, f x ∂μ :=
by rw [average, measure_univ, inv_one, one_smul]

@[simp] lemma measure_smul_average [is_finite_measure μ] (f : α → E) :
  (μ univ).to_real • ⨍ x, f x ∂μ = ∫ x, f x ∂μ :=
begin
  cases eq_or_ne μ 0 with hμ hμ,
  { rw [hμ, integral_zero_measure, average_zero_measure, smul_zero] },
  { rw [average_eq, smul_inv_smul₀],
    refine (ennreal.to_real_pos _ $ measure_ne_top _ _).ne',
    rwa [ne.def, measure_univ_eq_zero] }
end

lemma set_average_eq (f : α → E) (s : set α) :
  ⨍ x in s, f x ∂μ = (μ s).to_real⁻¹ • ∫ x in s, f x ∂μ :=
by rw [average_eq, restrict_apply_univ]

lemma set_average_eq' (f : α → E) (s : set α) :
  ⨍ x in s, f x ∂μ = ∫ x, f x ∂((μ s)⁻¹ • μ.restrict s) :=
by simp only [average_eq', restrict_apply_univ]

variable {μ}

lemma average_congr {f g : α → E} (h : f =ᵐ[μ] g) : ⨍ x, f x ∂μ = ⨍ x, g x ∂μ :=
by simp only [average_eq, integral_congr_ae h]

lemma average_add_measure [is_finite_measure μ] {ν : measure α} [is_finite_measure ν] {f : α → E}
  (hμ : integrable f μ) (hν : integrable f ν) :
  ⨍ x, f x ∂(μ + ν) =
    ((μ univ).to_real / ((μ univ).to_real + (ν univ).to_real)) • ⨍ x, f x ∂μ +
      ((ν univ).to_real / ((μ univ).to_real + (ν univ).to_real)) • ⨍ x, f x ∂ν :=
begin
  simp only [div_eq_inv_mul, mul_smul, measure_smul_average, ← smul_add,
    ← integral_add_measure hμ hν, ← ennreal.to_real_add (measure_ne_top μ _) (measure_ne_top ν _)],
  rw [average_eq, measure.add_apply]
end

lemma average_pair {f : α → E} {g : α → F} (hfi : integrable f μ) (hgi : integrable g μ) :
  ⨍ x, (f x, g x) ∂μ = (⨍ x, f x ∂μ, ⨍ x, g x ∂μ) :=
integral_pair hfi.to_average hgi.to_average

lemma average_union {f : α → E} {s t : set α} (hd : ae_disjoint μ s t)
  (ht : null_measurable_set t μ) (hsμ : μ s ≠ ∞) (htμ : μ t ≠ ∞)
  (hfs : integrable_on f s μ) (hft : integrable_on f t μ) :
  ⨍ x in s ∪ t, f x ∂μ =
    ((μ s).to_real / ((μ s).to_real + (μ t).to_real)) • ⨍ x in s, f x ∂μ +
      ((μ t).to_real / ((μ s).to_real + (μ t).to_real)) • ⨍ x in t, f x ∂μ :=
begin
  haveI := fact.mk hsμ.lt_top, haveI := fact.mk htμ.lt_top,
  rw [restrict_union₀ hd ht, average_add_measure hfs hft, restrict_apply_univ, restrict_apply_univ]
end

lemma average_union_mem_open_segment {f : α → E} {s t : set α} (hd : ae_disjoint μ s t)
  (ht : null_measurable_set t μ) (hs₀ : μ s ≠ 0) (ht₀ : μ t ≠ 0) (hsμ : μ s ≠ ∞) (htμ : μ t ≠ ∞)
  (hfs : integrable_on f s μ) (hft : integrable_on f t μ) :
  ⨍ x in s ∪ t, f x ∂μ ∈ open_segment ℝ (⨍ x in s, f x ∂μ) (⨍ x in t, f x ∂μ) :=
begin
  replace hs₀ : 0 < (μ s).to_real, from ennreal.to_real_pos hs₀ hsμ,
  replace ht₀ : 0 < (μ t).to_real, from ennreal.to_real_pos ht₀ htμ,
  refine mem_open_segment_iff_div.mpr ⟨(μ s).to_real, (μ t).to_real, hs₀, ht₀,
    (average_union hd ht hsμ htμ hfs hft).symm⟩
end

lemma average_union_mem_segment {f : α → E} {s t : set α} (hd : ae_disjoint μ s t)
  (ht : null_measurable_set t μ) (hsμ : μ s ≠ ∞) (htμ : μ t ≠ ∞)
  (hfs : integrable_on f s μ) (hft : integrable_on f t μ) :
  ⨍ x in s ∪ t, f x ∂μ ∈ [⨍ x in s, f x ∂μ -[ℝ] ⨍ x in t, f x ∂μ] :=
begin
  by_cases hse : μ s = 0,
  { rw ← ae_eq_empty at hse,
    rw [restrict_congr_set (hse.union eventually_eq.rfl), empty_union],
    exact right_mem_segment _ _ _ },
  { refine mem_segment_iff_div.mpr ⟨(μ s).to_real, (μ t).to_real, ennreal.to_real_nonneg,
      ennreal.to_real_nonneg, _, (average_union hd ht hsμ htμ hfs hft).symm⟩,
    calc 0 < (μ s).to_real : ennreal.to_real_pos hse hsμ
    ... ≤ _ : le_add_of_nonneg_right ennreal.to_real_nonneg }
end

lemma average_mem_open_segment_compl_self [is_finite_measure μ] {f : α → E} {s : set α}
  (hs : null_measurable_set s μ) (hs₀ : μ s ≠ 0) (hsc₀ : μ sᶜ ≠ 0) (hfi : integrable f μ) :
  ⨍ x, f x ∂μ ∈ open_segment ℝ (⨍ x in s, f x ∂μ) (⨍ x in sᶜ, f x ∂μ) :=
by simpa only [union_compl_self, restrict_univ]
  using average_union_mem_open_segment ae_disjoint_compl_right hs.compl hs₀ hsc₀
    (measure_ne_top _ _) (measure_ne_top _ _) hfi.integrable_on hfi.integrable_on

@[simp] lemma average_const [is_finite_measure μ] [h : μ.ae.ne_bot] (c : E) :
  ⨍ x, c ∂μ = c :=
by simp only [average_eq, integral_const, measure.restrict_apply, measurable_set.univ, one_smul,
  univ_inter, smul_smul, ← ennreal.to_real_inv, ← ennreal.to_real_mul, ennreal.inv_mul_cancel,
  measure_ne_top μ univ, ne.def, measure_univ_eq_zero, ae_ne_bot.1 h, not_false_iff,
  ennreal.one_to_real]

lemma set_average_const {s : set α} (hs₀ : μ s ≠ 0) (hs : μ s ≠ ∞) (c : E) :
  ⨍ x in s, c ∂μ = c :=
by simp only [set_average_eq, integral_const, measure.restrict_apply, measurable_set.univ,
  univ_inter, smul_smul, ← ennreal.to_real_inv, ← ennreal.to_real_mul,
  ennreal.inv_mul_cancel hs₀ hs, ennreal.one_to_real, one_smul]

end measure_theory


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
--import data.multiset.powerset
--import data.multiset.range
import mathlib4_experiments.Data.Multiset.Basic
import mathlib4_experiments.Data.List.Defs

/-!
# The `nodup` predicate for multisets without duplicate elements.
-/

namespace Multiset

open List

/- nodup -/

/-- `nodup s` means that `s` has no duplicates, i.e. the multiplicity of
  any element is at most 1. -/
def nodup (s : Multiset α) : Prop :=
Quot.liftOn s List.nodup (λ s t p => propext _)--propext p.nodup_iff)

/-

TO BE PORTED

@[simp] theorem coe_nodup {l : list α} : @nodup α l ↔ l.nodup := iff.rfl

@[simp] theorem nodup_zero : @nodup α 0 := pairwise.nil

@[simp] theorem nodup_cons {a : α} {s : multiset α} : nodup (a ::ₘ s) ↔ a ∉ s ∧ nodup s :=
quot.induction_on s $ λ l, nodup_cons

theorem nodup_cons_of_nodup {a : α} {s : multiset α} (m : a ∉ s) (n : nodup s) : nodup (a ::ₘ s) :=
nodup_cons.2 ⟨m, n⟩

theorem nodup_singleton : ∀ a : α, nodup (a ::ₘ 0) := nodup_singleton

theorem nodup_of_nodup_cons {a : α} {s : multiset α} (h : nodup (a ::ₘ s)) : nodup s :=
(nodup_cons.1 h).2

theorem not_mem_of_nodup_cons {a : α} {s : multiset α} (h : nodup (a ::ₘ s)) : a ∉ s :=
(nodup_cons.1 h).1

theorem nodup_of_le {s t : multiset α} (h : s ≤ t) : nodup t → nodup s :=
le_induction_on h $ λ l₁ l₂, nodup_of_sublist

theorem not_nodup_pair : ∀ a : α, ¬ nodup (a ::ₘ a ::ₘ 0) := not_nodup_pair

theorem nodup_iff_le {s : multiset α} : nodup s ↔ ∀ a : α, ¬ a ::ₘ a ::ₘ 0 ≤ s :=
quot.induction_on s $ λ l, nodup_iff_sublist.trans $ forall_congr $ λ a,
not_congr (@repeat_le_coe _ a 2 _).symm

lemma nodup_iff_ne_cons_cons {s : multiset α} : s.nodup ↔ ∀ a t, s ≠ a ::ₘ a ::ₘ t :=
nodup_iff_le.trans
  ⟨λ h a t s_eq, h a (s_eq.symm ▸ cons_le_cons a (cons_le_cons a (zero_le _))),
   λ h a le, let ⟨t, s_eq⟩ := le_iff_exists_add.mp le in
     h a t (by rwa [cons_add, cons_add, zero_add] at s_eq )⟩

theorem nodup_iff_count_le_one [decidable_eq α] {s : multiset α} : nodup s ↔ ∀ a, count a s ≤ 1 :=
quot.induction_on s $ λ l, nodup_iff_count_le_one

@[simp] theorem count_eq_one_of_mem [decidable_eq α] {a : α} {s : multiset α}
  (d : nodup s) (h : a ∈ s) : count a s = 1 :=
le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h)

lemma nodup_iff_pairwise {α} {s : multiset α} : nodup s ↔ pairwise (≠) s :=
quotient.induction_on s $ λ l, (pairwise_coe_iff_pairwise (by exact λ a b, ne.symm)).symm

lemma pairwise_of_nodup {r : α → α → Prop} {s : multiset α} :
  (∀a∈s, ∀b∈s, a ≠ b → r a b) → nodup s → pairwise r s :=
quotient.induction_on s $ assume l h hl, ⟨l, rfl, hl.imp_of_mem $ assume a b ha hb, h a ha b hb⟩

lemma forall_of_pairwise {r : α → α → Prop} (H : symmetric r) {s : multiset α}
   (hs : pairwise r s) : (∀a∈s, ∀b∈s, a ≠ b → r a b) :=
let ⟨l, hl₁, hl₂⟩ := hs in hl₁.symm ▸ list.forall_of_pairwise H hl₂

theorem nodup_add {s t : multiset α} : nodup (s + t) ↔ nodup s ∧ nodup t ∧ disjoint s t :=
quotient.induction_on₂ s t $ λ l₁ l₂, nodup_append

theorem disjoint_of_nodup_add {s t : multiset α} (d : nodup (s + t)) : disjoint s t :=
(nodup_add.1 d).2.2

theorem nodup_add_of_nodup {s t : multiset α} (d₁ : nodup s) (d₂ : nodup t) :
  nodup (s + t) ↔ disjoint s t :=
by simp [nodup_add, d₁, d₂]

theorem nodup_of_nodup_map (f : α → β) {s : multiset α} : nodup (map f s) → nodup s :=
quot.induction_on s $ λ l, nodup_of_nodup_map f

theorem nodup_map_on {f : α → β} {s : multiset α} : (∀x∈s, ∀y∈s, f x = f y → x = y) →
  nodup s → nodup (map f s) :=
quot.induction_on s $ λ l, nodup_map_on

theorem nodup_map {f : α → β} {s : multiset α} (hf : function.injective f) :
  nodup s → nodup (map f s) :=
nodup_map_on (λ x _ y _ h, hf h)

theorem inj_on_of_nodup_map {f : α → β} {s : multiset α} :
  nodup (map f s) → ∀ (x ∈ s) (y ∈ s), f x = f y → x = y :=
quot.induction_on s $ λ l, inj_on_of_nodup_map

theorem nodup_map_iff_inj_on {f : α → β} {s : multiset α} (d : nodup s) :
  nodup (map f s) ↔ (∀ (x ∈ s) (y ∈ s), f x = f y → x = y) :=
⟨inj_on_of_nodup_map, λ h, nodup_map_on h d⟩

theorem nodup_filter (p : α → Prop) [decidable_pred p] {s} : nodup s → nodup (filter p s) :=
quot.induction_on s $ λ l, nodup_filter p

@[simp] theorem nodup_attach {s : multiset α} : nodup (attach s) ↔ nodup s :=
quot.induction_on s $ λ l, nodup_attach

theorem nodup_pmap {p : α → Prop} {f : Π a, p a → β} {s : multiset α} {H}
  (hf : ∀ a ha b hb, f a ha = f b hb → a = b) : nodup s → nodup (pmap f s H) :=
quot.induction_on s (λ l H, nodup_pmap hf) H

instance nodup_decidable [decidable_eq α] (s : multiset α) : decidable (nodup s) :=
quotient.rec_on_subsingleton s $ λ l, l.nodup_decidable

theorem nodup_erase_eq_filter [decidable_eq α] (a : α) {s} : nodup s → s.erase a = filter (≠ a) s :=
quot.induction_on s $ λ l d, congr_arg coe $ nodup_erase_eq_filter a d

theorem nodup_erase_of_nodup [decidable_eq α] (a : α) {l} : nodup l → nodup (l.erase a) :=
nodup_of_le (erase_le _ _)

theorem mem_erase_iff_of_nodup [decidable_eq α] {a b : α} {l} (d : nodup l) :
  a ∈ l.erase b ↔ a ≠ b ∧ a ∈ l :=
by rw nodup_erase_eq_filter b d; simp [and_comm]

theorem mem_erase_of_nodup [decidable_eq α] {a : α} {l} (h : nodup l) : a ∉ l.erase a :=
by rw mem_erase_iff_of_nodup h; simp

theorem nodup_product {s : multiset α} {t : multiset β} : nodup s → nodup t → nodup (product s t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d₁ d₂, by simp [nodup_product d₁ d₂]

theorem nodup_sigma {σ : α → Type*} {s : multiset α} {t : Π a, multiset (σ a)} :
  nodup s → (∀ a, nodup (t a)) → nodup (s.sigma t) :=
quot.induction_on s $ assume l₁,
begin
  choose f hf using assume a, quotient.exists_rep (t a),
  rw show t = λ a, f a, from (eq.symm $ funext $ λ a, hf a),
  simpa using nodup_sigma
end

theorem nodup_filter_map (f : α → option β) {s : multiset α}
  (H : ∀ (a a' : α) (b : β), b ∈ f a → b ∈ f a' → a = a') :
  nodup s → nodup (filter_map f s) :=
quot.induction_on s $ λ l, nodup_filter_map H

theorem nodup_range (n : ℕ) : nodup (range n) := nodup_range _

theorem nodup_inter_left [decidable_eq α] {s : multiset α} (t) : nodup s → nodup (s ∩ t) :=
nodup_of_le $ inter_le_left _ _

theorem nodup_inter_right [decidable_eq α] (s) {t : multiset α} : nodup t → nodup (s ∩ t) :=
nodup_of_le $ inter_le_right _ _

@[simp] theorem nodup_union [decidable_eq α] {s t : multiset α} :
  nodup (s ∪ t) ↔ nodup s ∧ nodup t :=
⟨λ h, ⟨nodup_of_le (le_union_left _ _) h, nodup_of_le (le_union_right _ _) h⟩,
 λ ⟨h₁, h₂⟩, nodup_iff_count_le_one.2 $ λ a, by rw [count_union]; exact
   max_le (nodup_iff_count_le_one.1 h₁ a) (nodup_iff_count_le_one.1 h₂ a)⟩

@[simp] theorem nodup_powerset {s : multiset α} : nodup (powerset s) ↔ nodup s :=
⟨λ h, nodup_of_nodup_map _ (nodup_of_le (map_single_le_powerset _) h),
  quotient.induction_on s $ λ l h,
  by simp; refine list.nodup_map_on _ (nodup_sublists'.2 h); exact
  λ x sx y sy e,
    (h.sublist_ext (mem_sublists'.1 sx) (mem_sublists'.1 sy)).1
      (quotient.exact e)⟩

theorem nodup_powerset_len {n : ℕ} {s : multiset α}
  (h : nodup s) : nodup (powerset_len n s) :=
nodup_of_le (powerset_len_le_powerset _ _) (nodup_powerset.2 h)

@[simp] lemma nodup_bind {s : multiset α} {t : α → multiset β} :
  nodup (bind s t) ↔ ((∀a∈s, nodup (t a)) ∧ (s.pairwise (λa b, disjoint (t a) (t b)))) :=
have h₁ : ∀a, ∃l:list β, t a = l, from
  assume a, quot.induction_on (t a) $ assume l, ⟨l, rfl⟩,
let ⟨t', h'⟩ := classical.axiom_of_choice h₁ in
have t = λa, t' a, from funext h',
have hd : symmetric (λa b, list.disjoint (t' a) (t' b)), from assume a b h, h.symm,
quot.induction_on s $ by simp [this, list.nodup_bind, pairwise_coe_iff_pairwise hd]

theorem nodup_ext {s t : multiset α} : nodup s → nodup t → (s = t ↔ ∀ a, a ∈ s ↔ a ∈ t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d₁ d₂, quotient.eq.trans $ perm_ext d₁ d₂

theorem le_iff_subset {s t : multiset α} : nodup s → (s ≤ t ↔ s ⊆ t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d, ⟨subset_of_le, subperm_of_subset_nodup d⟩

theorem range_le {m n : ℕ} : range m ≤ range n ↔ m ≤ n :=
(le_iff_subset (nodup_range _)).trans range_subset

theorem mem_sub_of_nodup [decidable_eq α] {a : α} {s t : multiset α} (d : nodup s) :
  a ∈ s - t ↔ a ∈ s ∧ a ∉ t :=
⟨λ h, ⟨mem_of_le (sub_le_self _ _) h, λ h',
  by refine count_eq_zero.1 _ h; rw [count_sub a s t, nat.sub_eq_zero_iff_le];
     exact le_trans (nodup_iff_count_le_one.1 d _) (count_pos.2 h')⟩,
 λ ⟨h₁, h₂⟩, or.resolve_right (mem_add.1 $ mem_of_le (le_sub_add _ _) h₁) h₂⟩

lemma map_eq_map_of_bij_of_nodup (f : α → γ) (g : β → γ) {s : multiset α} {t : multiset β}
  (hs : s.nodup) (ht : t.nodup) (i : Πa∈s, β)
  (hi : ∀a ha, i a ha ∈ t) (h : ∀a ha, f a = g (i a ha))
  (i_inj : ∀a₁ a₂ ha₁ ha₂, i a₁ ha₁ = i a₂ ha₂ → a₁ = a₂)
  (i_surj : ∀b∈t, ∃a ha, b = i a ha) :
  s.map f = t.map g :=
have t = s.attach.map (λ x, i x.1 x.2),
  from (nodup_ext ht (nodup_map
      (show function.injective (λ x : {x // x ∈ s}, i x.1 x.2), from λ x y hxy,
        subtype.eq (i_inj x.1 y.1 x.2 y.2 hxy))
      (nodup_attach.2 hs))).2
    (λ x, by simp only [mem_map, true_and, subtype.exists, eq_comm, mem_attach];
      exact ⟨i_surj _, λ ⟨y, hy⟩, hy.snd.symm ▸ hi _ _⟩),
calc s.map f = s.pmap  (λ x _, f x) (λ _, id) : by rw [pmap_eq_map]
... = s.attach.map (λ x, f x.1) : by rw [pmap_eq_map_attach]
... = t.map g : by rw [this, multiset.map_map]; exact map_congr (λ x _, h _ _)

end multiset

-/


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

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

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

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

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

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

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

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

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

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

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

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

end nat

lemma two_ne_zero' {α : Type*} [add_monoid α] [has_one α] [char_zero α] : (2:α) ≠ 0 :=
by simpa using (@nat.cast_ne_zero α _ _ _ 2).2 dec_trivial

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

lemma add_self_eq_zero {a : α} : a + a = 0 ↔ a = 0 :=
by rw [← two_mul, mul_eq_zero]; simp [two_ne_zero']

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

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

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

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

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

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

end


import pq_to_group
import counit_ker_abelian

universes u1 u2 u3

section pq_like_split

variables {Q : Type u1} [power_quandle Q]

def counit_L_of (x : pq_group Q) : counit ((L_of_morph of of_is_pq_morphism) x) = x :=
begin
  induction x,
  {
    rw quot_mk_helper,
    induction x,
    {
      rw incl_unit_eq_unit,
      simp only [monoid_hom.map_one],
    },
    {
      rw ←of_def,
      refl,
    },
    {
      rw ←mul_def,
      simp only [monoid_hom.map_mul],
      rw x_ih_a,
      rw x_ih_b,
    },
    {
      rw ←inv_def,
      simp only [inv_inj, monoid_hom.map_inv],
      assumption,
    },
  },
  {refl,},
end

def left_split_fun : (pq_group (pq_group Q)) → (counit : pq_group (pq_group Q) →* (pq_group Q)).ker :=
begin
  intro x,
  fconstructor,
  exact x * ((L_of_morph of of_is_pq_morphism) (counit x))⁻¹,
  refine counit.mem_ker.mpr _,
  simp only [monoid_hom.map_mul, monoid_hom.map_inv],
  rw counit_L_of,
  simp only [mul_right_inv],
end

lemma left_split_fun_def (x : pq_group (pq_group Q)) : x * ((L_of_morph of of_is_pq_morphism) (counit x))⁻¹  = ↑(left_split_fun x) := rfl

lemma left_split_coe_commutes (x y : pq_group (pq_group Q)) : x * ↑(left_split_fun y) = ↑(left_split_fun y) * x :=
begin
  rw counit_ker_center,
end

def left_split_hom : (pq_group (pq_group Q)) →* (counit : pq_group (pq_group Q) →* (pq_group Q)).ker :=
begin
  fconstructor,
  exact left_split_fun,
  {
    unfold left_split_fun,
    simp only [one_inv, mul_one, monoid_hom.map_one],
    refl,
  },
  {
    intros a b,
    unfold left_split_fun,
    ext1,
    simp only [mul_inv_rev, monoid_hom.map_mul, subgroup.coe_mul, subtype.coe_mk],
    rw mul_assoc,
    rw ←mul_assoc b,
    rw left_split_fun_def b,
    rw ←mul_assoc,
    rw left_split_coe_commutes,
    rw left_split_coe_commutes,
    rw mul_assoc,
  },
end

theorem left_split_hom_is_left_split (x : (counit : pq_group (pq_group Q) →* (pq_group Q)).ker) : left_split_hom (↑x) = x :=
begin
  cases x with x hx,
  unfold left_split_hom,
  simp only [monoid_hom.coe_mk, subtype.coe_mk],
  unfold left_split_fun,
  ext1,
  simp only [subtype.coe_mk],
  suffices : counit x = 1,
  rw this,
  simp only [mul_one, monoid_hom.map_one],
  simp only [one_inv, mul_one],
  exact hx,
end

def pq_group_prod_ker_G : pq_group (pq_group Q) ≃* pq_group Q × (counit : pq_group (pq_group Q) →* pq_group Q).ker := {
  to_fun := λ x, ⟨counit x, left_split_hom x⟩,
  inv_fun := λ a, a.2 * (L_of_morph of of_is_pq_morphism a.1),
  left_inv := begin
    intro x,
    simp only,
    unfold left_split_hom,
    simp only [monoid_hom.coe_mk],
    unfold left_split_fun,
    simp only [subgroup.coe_mk, inv_mul_cancel_right],
  end,
  right_inv := begin
    intro x,
    cases x with x1 x2,
    simp only [monoid_hom.map_mul],
    ext1,
    {
      simp only,
      rw counit_L_of,
      simp only [mul_left_eq_self],
      cases x2 with x2 hx2,
      simp only [subtype.coe_mk],
      exact hx2,
    },
    {
      simp only,
      rw left_split_hom_is_left_split,
      simp only [mul_right_eq_self],
      unfold left_split_hom,
      simp only [monoid_hom.coe_mk],
      unfold left_split_fun,
      simp_rw counit_L_of,
      group,
      refl,
    },
  end,
  map_mul' := begin
    intros x y,
    ext1,
    simp only [monoid_hom.map_mul, prod.mk_mul_mk],
    simp only [monoid_hom.map_mul, prod.mk_mul_mk],
  end }

end pq_like_split


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : nat) : ∀ (x : ℕ), p.prime → coprime x p → is_unit ((x : ℕ) : ℤ_[p]) :=
begin
  assume x hp h1,
  have h2 : ¬(is_unit ((x : ℕ) : ℤ_[p])), from by {
    assume h : is_unit ((x : ℕ) : ℤ_[p]),
    have h3 : (p : ℤ_[p]) = 0, from by { apply nat.prime.not_dvd_one hp, },
    have h4 : (x : ℤ_[p]) = 0, from by { rw [←norm_eq_zero_iff_zero,h3,norm_eq_zero_iff_zero], },
    have h5 : (x : ℤ) = 0, from by { rw [←nat.cast_eq_zero,h4], },
    have h6 : ¬coprime x p, from by { apply nat.prime.not_coprime_iff hp, assumption, },
    show false, from h1 h6,
  },
  show ¬is_unit ((x : ℕ) : ℤ_[p]), from h2,
end

--OUTPUT 2
theorem p_adic_units (p : ℕ) (h1 : p.prime) (x : ℕ) : coprime p x → x.to_nat_p_adic_int h1.pos is_unit :=
begin
    intro h2,
    have h3 : p.to_nat_p_adic_int h1.pos.succ ≠ 0, from by {
        apply nat.succ_ne_zero,
    },
    have h4 : x.to_nat_p_adic_int h1.pos ≠ 0, from by {
        apply (nat.ne_zero_of_pos h1.pos),
    },
    have h5 : x.to_nat_p_adic_int h1.pos.succ ≠ 0, from by {
        apply nat.succ_ne_zero,
    },
    have h6 : x.to_nat_p_adic_int h1.pos.succ ≠ 1, from by {
        have h7 : p ∣ x, from by {
            have h8 : x.to_nat_p_adic_int h1.pos.succ ≠ 1, from by {
                apply (not_unit_of_not_coprime h2),
            },
            rw not_eq_iff_neq_and_neq at h8,
            apply (h8.left),
        },
        rw nat.dvd_iff_mod_eq_zero at h7,
        rw ← nat.mod_add_div at h7,
        rw ← nat.mod_lt at h7,
        rw ← nat.mod_lt at h7,
        have h8 : x.to_nat_p_adic_int h1.pos.succ = (x % p).to_nat_p_adic_int h1.pos.succ + ((x / p) % p).to_nat_p_adic_int h1.pos.succ * p.to_nat_p_adic_int h1.pos.succ, from by {
            rw ← nat.mod_add_div,
        },
        have h9 : (x % p).to_nat_p_adic_int h1.pos.succ + ((x / p) % p).to_nat_p_adic_int h1.pos.succ * p.to_nat_p_adic_int h1.pos.succ < 1, from by {
            rw h8,
            rw ← nat.mod_lt,
        },
        have h10 : (x % p).to_nat_p_adic_int h1.pos.succ + ((x / p) % p).to_nat_p_adic_int h1.pos.succ * p.to_nat_p_adic_int h1.pos.succ = 0, from by {
            rw h8,
            rw h7,
        },
        rw h10 at h9,
        rw add_zero at h9,
        have h11 : ((x / p) % p).to_nat_p_adic_int h1.pos.succ * p.to_nat_p_adic_int h1.pos.succ < 1, from by {
            rw ← nat.one_mul (p.to_nat_p_adic_int h1.pos.succ),
            exact h9,
        },
        have h12 : ((x / p) % p).to_nat_p_adic_int h1.pos.succ * p.to_nat_p_adic_int h1.pos.succ = 0, from by {
            rw ← nat.zero_mul (p.to_nat_p_adic_int h1.pos.succ) at h11,
            rw ← nat.lt_iff_not_ge at h11,
            rw not_le at h11,
            exact h11,
        },
        have h13 : ((x / p) % p).to_nat_p_adic_int h1.pos.succ = 0, from by {
            rw ← nat.mul_eq_zero at h12,
            exact h12,
        },
        have h14 : (x / p) % p = 0, from by {
            exact nat.eq_zero_of_zero_dvd ((x / p) % p),
        },
        rw h14 at h13,
        rw ← nat.zero_dvd at h13,
        exact h13,
    },
    have h7 : x.to_nat_p_adic_int h1.pos.succ = 1, from by {
        apply not_and_distrib,
        rw not_not,
        exact h6,
    },
    exact h7,
end

--OUTPUT 3
theorem p_adic_units (p : ℕ) [hp : prime p] (x : ℕ) : coprime p x → is_unit (p_adic_int.mk p x) :=
begin
  assume hx : coprime p x,
  have h1 : p_adic_int.mk p x ≠ 0, from by {
    intro h0,
    have h1 : p_adic_int.norm (p_adic_int.mk p x) = 0, from by {
      rw ← h0,
      rw p_adic_int.norm_zero,
      },
    have h2 : p_adic_int.norm (p_adic_int.mk p x) = 1, from by {
      rw h1,
      },
    have h3 : p_adic_int.norm (p_adic_int.mk p x) ≤ 1, from by {
      apply p_adic_int.norm_le_one,
      },
    have h4 : 1 ≤ p_adic_int.norm (p_adic_int.mk p x), from by {
      apply le_of_eq h2,
      },
    have h5 : p_adic_int.norm (p_adic_int.mk p x) = 1, from by {
      apply le_antisymm h4 h3,
    },
    have h6 : p_adic_int.norm (p_adic_int.mk p x) = 1, from by {
      rw h5,
    },
    have h7 : ¬ coprime p x, from by {
      apply not_coprime.one_dvd_of_p_adic_int_norm_eq_one h6,
    },
    contradiction,
    },
  have h2 : ¬ p_adic_int.norm (p_adic_int.mk p x) = 1, from by {
    intro hnorm,
    have h3 : p_adic_int.norm (p_adic_int.mk p x) ≤ 1, from by {
      apply p_adic_int.norm_le_one,
    },
    have h4 : 1 ≤ p_adic_int.norm (p_adic_int.mk p x), from by {
      apply le_of_eq hnorm,
    },
    have h5 : p_adic_int.norm (p_adic_int.mk p x) = 1, from by {
      apply le_antisymm h4 h3,
    },
    have h6 : p_adic_int.norm (p_adic_int.mk p x) = 1, from by {
      rw h5,
    },
    have h7 : ¬ coprime p x, from by {
      apply not_coprime.one_dvd_of_p_adic_int_norm_eq_one h6,
    },
    contradiction,
  },
  have h3 : p_adic_int.norm (p_adic_int.mk p x) < 1, from by {
    apply lt_of_not_ge h2,
  },
  have h4 : p_adic_int.norm (p_adic_int.mk p x) = 0, from by {
    apply le_zero_iff_eq.mp h3,
  },
  have h5 : p ∣ x, from by {
    apply p_adic_int.norm_eq_zero_iff_dvd_p.mp h4,
  },
  have h6 : ¬ coprime p x, from by {
    apply dvd_of_prime_dvd hp h5,
  },
  contradiction,
end

--OUTPUT 4
theorem p_adic_units (p : ℕ) (x : ℕ) : coprime p x → is_unit (Zp x) :=
begin
  assume h,
  have h1 : ∃ y : Zp, y * Zp.mk x = (1 : Zp), from
    begin
      use Zp.mk (x⁻¹ mod p),
      rw Zp.mul_comm,
      rw Zp.mul_mk,
      rw Zp.mk_one,
      rw Zp.mk_mul,
      rw Zp.mk_one,
      rw Zp.mod_add_div,
      rw Zp.mk_sub,
      rw Zp.mk_one,
      rw Zp.mk_zero,
      rw Zp.sub_eq_zero_of_eq,
      rw Zp.eq_iff_modeq_int,
      rw mod_eq_of_coprime,
      apply h,
    end,
    exact ⟨h1⟩,
end

--OUTPUT 5
theorem p_adic_units (p : ℕ) [prime p] (x : ℕ) : gcd x p = 1 → ∃ y : ℤ, x * y = 1 :=
begin
  assume (hgcd : gcd x p = 1),
  have hnorm : ∀ x : ℤ, (∥x∥ : ℝ) = x / p ^(nat_abs x), from
    assume (x : ℤ), by {rw p_norm_eq, rw [← of_nat_eq_nat_abs, nat_abs_of_nonneg], apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos,},
  have h1 : (x : ℤ) ≠ 0, from by {assume hx : x = 0, rw hx at hgcd, rw zgcd_zero_left at hgcd, rw hgcd at hgcd, rw gcd_zero_right at hgcd, rw hgcd at hgcd, rw gcd_zero_left at hgcd, rw hgcd at hgcd, rw gcd_zero_right at hgcd, rw hgcd at hgcd, exact dec_trivial,},
  have h2 : (p : ℤ) ≠ 0, from by {rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos,},
  have h3 : ∥x∥ < 1, from by {rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos, rw hnorm, rw hnorm, rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos,},
  have h4 : ∥x∥ ≥ 1, from by {apply le_of_lt h3,},
  have h5 : ∥x∥ = 1, from by {rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos, rw hnorm, rw hnorm, rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_le, apply le_of_lt, apply prime.pos, apply nat.cast_ne_zero, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, apply ne_of_gt, apply lt.trans zero_lt_one, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_pos, apply prime.pos, rw ← of_nat_eq_nat_abs, rw nat_abs_of_nonneg, apply nat.cast_nonneg, apply nat.cast_le.mpr, apply nat.pow_le_pow_of_le_right, apply pow_le_iff_le_right, apply nat.cast_
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem p_adic_units {p : ℕ} (h : prime p) (x : ℕ) (h1 : coprime p x) : x ∈ units ℤ_[p] :=
begin
  assume h2 : x ∉ units ℤ_[p],
  have h3 : norm_of ℤ_[p] x ≠ 1, from by {
    assume hcontra : norm_of ℤ_[p] x = 1,
    show false, from h2 (units_of_norm_eq_one ℤ_[p] x hcontra),
  },
  have h4 : norm_of ℤ_[p] x < 1, from by {
    assume hcontra : norm_of ℤ_[p] x ≥ 1,
    show false, from h3 (le_antisymm hcontra (norm_of_le_one ℤ_[p] x)),
  },
  show p ∣ x, from by {
    have h5 : ∃ (x' : ℤ), x = p * x', from exists_eq_mul_right_of_dvd p x,
    show p ∣ x, from exists.elim h5 (assume x', assume h6 : x = p * x', exists.intro x'.val (eq.subst h6 (eq.symm (mul_comm p x'.val)))),
  },
end

--OUTPUT 7
theorem p_adic_units (x : ℤ) (p : ℕ) (h: nat.prime p) : nat.coprime x p → p ∣ x → false :=
begin
  assume (h1 : nat.coprime x p) (h2 : p ∣ x),
  have h3 : p ∣ x, from h2,
  have h4 : nat.prime p, from h,
  have h5 : ¬ nat.prime p, from h4,
  have h6 : ¬ p ∣ 1, from by {rw ← dvd_iff_mod_eq_zero, rw nat.mod_self, exact nat.ne_zero_of_pos (nat.pos_of_ne_zero h5)},
  have h7 : ¬ p ∣ x, from by {rw ← dvd_iff_mod_eq_zero, rw ← nat.mod_eq_zero_iff_dvd, exact h6},
  exact absurd h3 h7,
end

--OUTPUT 8
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime x p) : nat.coprime x p ↔ (∃ y, x*y = 1) :=
begin
  have h1 : (nat.coprime x p) = (nat.prime p) ∧ (∃ y, x*y = 1), from by {
    split,
    exact h,
    sorry,
  },
  show nat.coprime x p ↔ (∃ y, x*y = 1), from by {
    split,
    assume h2 : nat.coprime x p,
    exact h1.right,
    assume h3 : (∃ y, x*y = 1),
    sorry,
  },
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
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
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
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, 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
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
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)-/


import data.complex.exponential
import algebra.polynomial.big_operators
import analysis.special_functions.trigonometric.basic

theorem AMC_2021_A_22 (a b c :ℝ)(P:ℝ → ℝ)
(hP: ∀ (x:ℝ), P x = x^3+a*x^2*b*x+c)
(hroots:(P (real.cos 2*real.pi/7) = 0)∧(P (real.cos 4*real.pi/7) = 0)∧(P (real.cos 6*real.pi/7) = 0)):
a*b*c = 1/32
:=
begin
  sorry
end


import game.world10.level3 -- hide
namespace mynat -- hide
/-

# Inequality world.

## Level 4: `zero_le`

Another easy one.
-/

/- Lemma
For all naturals $a$, $0\leq a$.
-/
lemma zero_le (a : mynat) : 0 ≤ a :=
begin [nat_num_game]
  use a,
  rw zero_add,
  refl,

end

end mynat -- hide