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

import measure_theory.measure.regular
import measure_theory.function.simple_func_dense_lp
import topology.urysohns_lemma

/-!
# Approximation in Lᵖ by continuous functions

This file proves that bounded continuous functions are dense in `Lp E p μ`, for `1 ≤ p < ∞`, if the
domain `α` of the functions is a normal topological space and the measure `μ` is weakly regular.

The result is presented in several versions:
* `measure_theory.Lp.bounded_continuous_function_dense`: The subgroup
  `measure_theory.Lp.bounded_continuous_function` of `Lp E p μ`, the additive subgroup of
  `Lp E p μ` consisting of equivalence classes containing a continuous representative, is dense in
  `Lp E p μ`.
* `bounded_continuous_function.to_Lp_dense_range`: For finite-measure `μ`, the continuous linear
  map `bounded_continuous_function.to_Lp p μ 𝕜` from `α →ᵇ E` to `Lp E p μ` has dense range.
* `continuous_map.to_Lp_dense_range`: For compact `α` and finite-measure `μ`, the continuous linear
  map `continuous_map.to_Lp p μ 𝕜` from `C(α, E)` to `Lp E p μ` has dense range.

Note that for `p = ∞` this result is not true:  the characteristic function of the set `[0, ∞)` in
`ℝ` cannot be continuously approximated in `L∞`.

The proof is in three steps.  First, since simple functions are dense in `Lp`, it suffices to prove
the result for a scalar multiple of a characteristic function of a measurable set `s`. Secondly,
since the measure `μ` is weakly regular, the set `s` can be approximated above by an open set and
below by a closed set.  Finally, since the domain `α` is normal, we use Urysohn's lemma to find a
continuous function interpolating between these two sets.

## Related results

Are you looking for a result on "directional" approximation (above or below with respect to an
order) of functions whose codomain is `ℝ≥0∞` or `ℝ`, by semicontinuous functions?  See the
Vitali-Carathéodory theorem, in the file `measure_theory.vitali_caratheodory`.

-/

open_locale ennreal nnreal topology bounded_continuous_function
open measure_theory topological_space continuous_map

variables {α : Type*} [measurable_space α] [topological_space α] [normal_space α] [borel_space α]
variables (E : Type*) [normed_add_comm_group E]
  [second_countable_topology_either α E]
variables {p : ℝ≥0∞} [_i : fact (1 ≤ p)] (hp : p ≠ ∞) (μ : measure α)

include _i hp

namespace measure_theory.Lp

variables [normed_space ℝ E]

/-- A function in `Lp` can be approximated in `Lp` by continuous functions. -/
lemma bounded_continuous_function_dense [μ.weakly_regular] :
  (bounded_continuous_function E p μ).topological_closure = ⊤ :=
begin
  have hp₀ : 0 < p := lt_of_lt_of_le zero_lt_one _i.elim,
  have hp₀' : 0 ≤ 1 / p.to_real := div_nonneg zero_le_one ennreal.to_real_nonneg,
  have hp₀'' : 0 < p.to_real,
  { simpa [← ennreal.to_real_lt_to_real ennreal.zero_ne_top hp] using hp₀ },
  -- It suffices to prove that scalar multiples of the indicator function of a finite-measure
  -- measurable set can be approximated by continuous functions
  suffices :  ∀ (c : E) {s : set α} (hs : measurable_set s) (hμs : μ s < ⊤),
    (Lp.simple_func.indicator_const p hs hμs.ne c : Lp E p μ)
      ∈ (bounded_continuous_function E p μ).topological_closure,
  { rw add_subgroup.eq_top_iff',
    refine Lp.induction hp _ _ _ _,
    { exact this },
    { exact λ f g hf hg hfg', add_subgroup.add_mem _ },
    { exact add_subgroup.is_closed_topological_closure _ } },
  -- Let `s` be a finite-measure measurable set, let's approximate `c` times its indicator function
  intros c s hs hsμ,
  refine mem_closure_iff_frequently.mpr _,
  rw metric.nhds_basis_closed_ball.frequently_iff,
  intros ε hε,
  -- A little bit of pre-emptive work, to find `η : ℝ≥0` which will be a margin small enough for
  -- our purposes
  obtain ⟨η, hη_pos, hη_le⟩ : ∃ η, 0 < η ∧ (↑(‖bit0 (‖c‖)‖₊ * (2 * η) ^ (1 / p.to_real)) : ℝ) ≤ ε,
  { have : filter.tendsto (λ x : ℝ≥0, ‖bit0 (‖c‖)‖₊ * (2 * x) ^ (1 / p.to_real)) (𝓝 0) (𝓝 0),
    { have : filter.tendsto (λ x : ℝ≥0, 2 * x) (𝓝 0) (𝓝 (2 * 0)) := filter.tendsto_id.const_mul 2,
      convert ((nnreal.continuous_at_rpow_const (or.inr hp₀')).tendsto.comp this).const_mul _,
      simp [hp₀''.ne'] },
    let ε' : ℝ≥0 := ⟨ε, hε.le⟩,
    have hε' : 0 < ε' := by exact_mod_cast hε,
    obtain ⟨δ, hδ, hδε'⟩ :=
      nnreal.nhds_zero_basis.eventually_iff.mp (eventually_le_of_tendsto_lt hε' this),
    obtain ⟨η, hη, hηδ⟩ := exists_between hδ,
    refine ⟨η, hη, _⟩,
    exact_mod_cast hδε' hηδ },
  have hη_pos' : (0 : ℝ≥0∞) < η := ennreal.coe_pos.2 hη_pos,
  -- Use the regularity of the measure to `η`-approximate `s` by an open superset and a closed
  -- subset
  obtain ⟨u, su, u_open, μu⟩ : ∃ u ⊇ s, is_open u ∧ μ u < μ s + ↑η,
  { refine s.exists_is_open_lt_of_lt _ _,
    simpa using ennreal.add_lt_add_left hsμ.ne hη_pos' },
  obtain ⟨F, Fs, F_closed, μF⟩ : ∃ F ⊆ s, is_closed F ∧ μ s < μ F + ↑η :=
    hs.exists_is_closed_lt_add hsμ.ne hη_pos'.ne',
  have : disjoint uᶜ F := (Fs.trans su).disjoint_compl_left,
  have h_μ_sdiff : μ (u \ F) ≤ 2 * η,
  { have hFμ : μ F < ⊤ := (measure_mono Fs).trans_lt hsμ,
    refine ennreal.le_of_add_le_add_left hFμ.ne _,
    have : μ u < μ F + ↑η + ↑η,
      from μu.trans (ennreal.add_lt_add_right ennreal.coe_ne_top μF),
    convert this.le using 1,
    { rw [add_comm, ← measure_union, set.diff_union_of_subset (Fs.trans su)],
      exacts [disjoint_sdiff_self_left, F_closed.measurable_set] },
    have : (2:ℝ≥0∞) * η = η + η := by simpa using add_mul (1:ℝ≥0∞) 1 η,
    rw this,
    abel },
  -- Apply Urysohn's lemma to get a continuous approximation to the characteristic function of
  -- the set `s`
  obtain ⟨g, hgu, hgF, hg_range⟩ :=
    exists_continuous_zero_one_of_closed u_open.is_closed_compl F_closed this,
  -- Multiply this by `c` to get a continuous approximation to the function `f`; the key point is
  -- that this is pointwise bounded by the indicator of the set `u \ F`
  have g_norm : ∀ x, ‖g x‖ = g x := λ x, by rw [real.norm_eq_abs, abs_of_nonneg (hg_range x).1],
  have gc_bd : ∀ x, ‖g x • c - s.indicator (λ x, c) x‖ ≤ ‖(u \ F).indicator (λ x, bit0 ‖c‖) x‖,
  { intros x,
    by_cases hu : x ∈ u,
    { rw ← set.diff_union_of_subset (Fs.trans su) at hu,
      cases hu with hFu hF,
      { refine (norm_sub_le _ _).trans _,
        refine (add_le_add_left (norm_indicator_le_norm_self (λ x, c) x) _).trans _,
        have h₀ : g x * ‖c‖ + ‖c‖ ≤ 2 * ‖c‖,
        { nlinarith [(hg_range x).1, (hg_range x).2, norm_nonneg c] },
        have h₁ : (2:ℝ) * ‖c‖ = bit0 (‖c‖) := by simpa using add_mul (1:ℝ) 1 (‖c‖),
        simp [hFu, norm_smul, h₀, ← h₁, g_norm x] },
      { simp [hgF hF, Fs hF] } },
    { have : x ∉ s := λ h, hu (su h),
      simp [hgu hu, this] } },
  -- The rest is basically just `ennreal`-arithmetic
  have gc_snorm : snorm ((λ x, g x • c) - s.indicator (λ x, c)) p μ
    ≤ (↑(‖bit0 (‖c‖)‖₊ * (2 * η) ^ (1 / p.to_real)) : ℝ≥0∞),
  { refine (snorm_mono_ae (filter.eventually_of_forall gc_bd)).trans _,
    rw snorm_indicator_const (u_open.sdiff F_closed).measurable_set hp₀.ne' hp,
    push_cast [← ennreal.coe_rpow_of_nonneg _ hp₀'],
    exact ennreal.mul_left_mono (ennreal.monotone_rpow_of_nonneg hp₀' h_μ_sdiff) },
  have gc_cont : continuous (λ x, g x • c) := g.continuous.smul continuous_const,
  have gc_mem_ℒp : mem_ℒp (λ x, g x • c) p μ,
  { have : mem_ℒp ((λ x, g x • c) - s.indicator (λ x, c)) p μ :=
    ⟨gc_cont.ae_strongly_measurable.sub (strongly_measurable_const.indicator hs)
        .ae_strongly_measurable,
      gc_snorm.trans_lt ennreal.coe_lt_top⟩,
    simpa using this.add (mem_ℒp_indicator_const p hs c (or.inr hsμ.ne)) },
  refine ⟨gc_mem_ℒp.to_Lp _, _, _⟩,
  { rw mem_closed_ball_iff_norm,
    refine le_trans _ hη_le,
    rw [simple_func.coe_indicator_const, indicator_const_Lp, ← mem_ℒp.to_Lp_sub, Lp.norm_to_Lp],
    exact ennreal.to_real_le_coe_of_le_coe gc_snorm },
  { rw [set_like.mem_coe, mem_bounded_continuous_function_iff],
    refine ⟨bounded_continuous_function.of_normed_add_comm_group _ gc_cont (‖c‖) _, rfl⟩,
    intros x,
    have h₀ : g x * ‖c‖ ≤ ‖c‖,
    { nlinarith [(hg_range x).1, (hg_range x).2, norm_nonneg c] },
    simp [norm_smul, g_norm x, h₀] },
end

end measure_theory.Lp

variables (𝕜 : Type*) [normed_field 𝕜] [normed_algebra ℝ 𝕜] [normed_space 𝕜 E]

namespace bounded_continuous_function
open linear_map (range)

lemma to_Lp_dense_range [μ.weakly_regular] [is_finite_measure μ] :
  dense_range ⇑(to_Lp p μ 𝕜 : (α →ᵇ E) →L[𝕜] Lp E p μ) :=
begin
  haveI : normed_space ℝ E := restrict_scalars.normed_space ℝ 𝕜 E,
  rw dense_range_iff_closure_range,
  suffices : (range (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ)).to_add_subgroup.topological_closure = ⊤,
  { exact congr_arg coe this },
  simp [range_to_Lp p μ, measure_theory.Lp.bounded_continuous_function_dense E hp],
end

end bounded_continuous_function

namespace continuous_map
open linear_map (range)

lemma to_Lp_dense_range [compact_space α] [μ.weakly_regular] [is_finite_measure μ] :
  dense_range ⇑(to_Lp p μ 𝕜 : C(α, E) →L[𝕜] Lp E p μ) :=
begin
  haveI : normed_space ℝ E := restrict_scalars.normed_space ℝ 𝕜 E,
  rw dense_range_iff_closure_range,
  suffices : (range (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ)).to_add_subgroup.topological_closure = ⊤,
  { exact congr_arg coe this },
  simp [range_to_Lp p μ, measure_theory.Lp.bounded_continuous_function_dense E hp]
end

end continuous_map


theorem pnp {P: Prop}: ¬(P ↔ ¬P)
:=
begin
  intro h,
  have hnp: ¬P, {
    intro hp,
    exact h.1 hp hp
  },
  exact hnp (h.2 hnp)
end

example:
  (∀ P Q R, (P ↔ Q) ∨ (Q ↔  R) ∨ (R ↔ P))
  → ∀ P, P ∨ ¬P
:=
begin
  intros h P,
  cases h (P ∨ ¬P) ¬(P ∨ ¬P) ¬¬(P ∨ ¬P) with h1 h23, {
    exfalso,
    exact pnp h1,
  },
  cases h23 with h2 h3, {
    exfalso,
    exact pnp h2,
  }, {
    apply h3.1,
    intro H,
    have hnp: ¬P, {
      intro hp,
      apply H,
      left,
      assumption
    },
    apply H,
    right,
    assumption,
  }
end


/-
Copyright (c) 2020 James Arthur. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: James Arthur, Chris Hughes, Shing Tak Lam

! This file was ported from Lean 3 source module analysis.special_functions.arsinh
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Trigonometric.Deriv
import Mathbin.Analysis.SpecialFunctions.Log.Basic

/-!
# Inverse of the sinh function

In this file we prove that sinh is bijective and hence has an
inverse, arsinh.

## Main definitions

- `real.arsinh`: The inverse function of `real.sinh`.

- `real.sinh_equiv`, `real.sinh_order_iso`, `real.sinh_homeomorph`: `real.sinh` as an `equiv`,
  `order_iso`, and `homeomorph`, respectively.

## Main Results

- `real.sinh_surjective`, `real.sinh_bijective`: `real.sinh` is surjective and bijective;

- `real.arsinh_injective`, `real.arsinh_surjective`, `real.arsinh_bijective`: `real.arsinh` is
  injective, surjective, and bijective;

- `real.continuous_arsinh`, `real.differentiable_arsinh`, `real.cont_diff_arsinh`: `real.arsinh` is
  continuous, differentiable, and continuously differentiable; we also provide dot notation
  convenience lemmas like `filter.tendsto.arsinh` and `cont_diff_at.arsinh`.

## Tags

arsinh, arcsinh, argsinh, asinh, sinh injective, sinh bijective, sinh surjective
-/

noncomputable section

open Function Filter Set

open Topology

namespace Real

variable {x y : ℝ}

/-- `arsinh` is defined using a logarithm, `arsinh x = log (x + sqrt(1 + x^2))`. -/
@[pp_nodot]
def arsinh (x : ℝ) :=
  log (x + sqrt (1 + x ^ 2))
#align real.arsinh Real.arsinh

theorem exp_arsinh (x : ℝ) : exp (arsinh x) = x + sqrt (1 + x ^ 2) :=
  by
  apply exp_log
  rw [← neg_lt_iff_pos_add']
  calc
    -x ≤ sqrt (x ^ 2) := le_sqrt_of_sq_le (neg_pow_bit0 _ _).le
    _ < sqrt (1 + x ^ 2) := sqrt_lt_sqrt (sq_nonneg _) (lt_one_add _)

#align real.exp_arsinh Real.exp_arsinh

@[simp]
theorem arsinh_zero : arsinh 0 = 0 := by simp [arsinh]
#align real.arsinh_zero Real.arsinh_zero

@[simp]
theorem arsinh_neg (x : ℝ) : arsinh (-x) = -arsinh x :=
  by
  rw [← exp_eq_exp, exp_arsinh, exp_neg, exp_arsinh]
  apply eq_inv_of_mul_eq_one_left
  rw [neg_sq, neg_add_eq_sub, add_comm x, mul_comm, ← sq_sub_sq, sq_sqrt, add_sub_cancel]
  exact add_nonneg zero_le_one (sq_nonneg _)
#align real.arsinh_neg Real.arsinh_neg

/-- `arsinh` is the right inverse of `sinh`. -/
@[simp]
theorem sinh_arsinh (x : ℝ) : sinh (arsinh x) = x :=
  by
  rw [sinh_eq, ← arsinh_neg, exp_arsinh, exp_arsinh, neg_sq]
  field_simp
#align real.sinh_arsinh Real.sinh_arsinh

@[simp]
theorem cosh_arsinh (x : ℝ) : cosh (arsinh x) = sqrt (1 + x ^ 2) := by
  rw [← sqrt_sq (cosh_pos _).le, cosh_sq', sinh_arsinh]
#align real.cosh_arsinh Real.cosh_arsinh

/-- `sinh` is surjective, `∀ b, ∃ a, sinh a = b`. In this case, we use `a = arsinh b`. -/
theorem sinh_surjective : Surjective sinh :=
  LeftInverse.surjective sinh_arsinh
#align real.sinh_surjective Real.sinh_surjective

/-- `sinh` is bijective, both injective and surjective. -/
theorem sinh_bijective : Bijective sinh :=
  ⟨sinh_injective, sinh_surjective⟩
#align real.sinh_bijective Real.sinh_bijective

/-- `arsinh` is the left inverse of `sinh`. -/
@[simp]
theorem arsinh_sinh (x : ℝ) : arsinh (sinh x) = x :=
  rightInverse_of_injective_of_leftInverse sinh_injective sinh_arsinh x
#align real.arsinh_sinh Real.arsinh_sinh

/-- `real.sinh` as an `equiv`. -/
@[simps]
def sinhEquiv : ℝ ≃ ℝ where
  toFun := sinh
  invFun := arsinh
  left_inv := arsinh_sinh
  right_inv := sinh_arsinh
#align real.sinh_equiv Real.sinhEquiv

/-- `real.sinh` as an `order_iso`. -/
@[simps (config := { fullyApplied := false })]
def sinhOrderIso : ℝ ≃o ℝ where
  toEquiv := sinhEquiv
  map_rel_iff' := @sinh_le_sinh
#align real.sinh_order_iso Real.sinhOrderIso

/-- `real.sinh` as a `homeomorph`. -/
@[simps (config := { fullyApplied := false })]
def sinhHomeomorph : ℝ ≃ₜ ℝ :=
  sinhOrderIso.toHomeomorph
#align real.sinh_homeomorph Real.sinhHomeomorph

theorem arsinh_bijective : Bijective arsinh :=
  sinhEquiv.symm.Bijective
#align real.arsinh_bijective Real.arsinh_bijective

theorem arsinh_injective : Injective arsinh :=
  sinhEquiv.symm.Injective
#align real.arsinh_injective Real.arsinh_injective

theorem arsinh_surjective : Surjective arsinh :=
  sinhEquiv.symm.Surjective
#align real.arsinh_surjective Real.arsinh_surjective

theorem arsinh_strictMono : StrictMono arsinh :=
  sinhOrderIso.symm.StrictMono
#align real.arsinh_strict_mono Real.arsinh_strictMono

@[simp]
theorem arsinh_inj : arsinh x = arsinh y ↔ x = y :=
  arsinh_injective.eq_iff
#align real.arsinh_inj Real.arsinh_inj

@[simp]
theorem arsinh_le_arsinh : arsinh x ≤ arsinh y ↔ x ≤ y :=
  sinhOrderIso.symm.le_iff_le
#align real.arsinh_le_arsinh Real.arsinh_le_arsinh

@[simp]
theorem arsinh_lt_arsinh : arsinh x < arsinh y ↔ x < y :=
  sinhOrderIso.symm.lt_iff_lt
#align real.arsinh_lt_arsinh Real.arsinh_lt_arsinh

@[simp]
theorem arsinh_eq_zero_iff : arsinh x = 0 ↔ x = 0 :=
  arsinh_injective.eq_iff' arsinh_zero
#align real.arsinh_eq_zero_iff Real.arsinh_eq_zero_iff

@[simp]
theorem arsinh_nonneg_iff : 0 ≤ arsinh x ↔ 0 ≤ x := by rw [← sinh_le_sinh, sinh_zero, sinh_arsinh]
#align real.arsinh_nonneg_iff Real.arsinh_nonneg_iff

@[simp]
theorem arsinh_nonpos_iff : arsinh x ≤ 0 ↔ x ≤ 0 := by rw [← sinh_le_sinh, sinh_zero, sinh_arsinh]
#align real.arsinh_nonpos_iff Real.arsinh_nonpos_iff

@[simp]
theorem arsinh_pos_iff : 0 < arsinh x ↔ 0 < x :=
  lt_iff_lt_of_le_iff_le arsinh_nonpos_iff
#align real.arsinh_pos_iff Real.arsinh_pos_iff

@[simp]
theorem arsinh_neg_iff : arsinh x < 0 ↔ x < 0 :=
  lt_iff_lt_of_le_iff_le arsinh_nonneg_iff
#align real.arsinh_neg_iff Real.arsinh_neg_iff

theorem hasStrictDerivAt_arsinh (x : ℝ) : HasStrictDerivAt arsinh (sqrt (1 + x ^ 2))⁻¹ x :=
  by
  convert sinh_homeomorph.to_local_homeomorph.has_strict_deriv_at_symm (mem_univ x) (cosh_pos _).ne'
      (has_strict_deriv_at_sinh _)
  exact (cosh_arsinh _).symm
#align real.has_strict_deriv_at_arsinh Real.hasStrictDerivAt_arsinh

theorem hasDerivAt_arsinh (x : ℝ) : HasDerivAt arsinh (sqrt (1 + x ^ 2))⁻¹ x :=
  (hasStrictDerivAt_arsinh x).HasDerivAt
#align real.has_deriv_at_arsinh Real.hasDerivAt_arsinh

theorem differentiable_arsinh : Differentiable ℝ arsinh := fun x =>
  (hasDerivAt_arsinh x).DifferentiableAt
#align real.differentiable_arsinh Real.differentiable_arsinh

theorem contDiff_arsinh {n : ℕ∞} : ContDiff ℝ n arsinh :=
  sinhHomeomorph.contDiff_symm_deriv (fun x => (cosh_pos x).ne') hasDerivAt_sinh contDiff_sinh
#align real.cont_diff_arsinh Real.contDiff_arsinh

@[continuity]
theorem continuous_arsinh : Continuous arsinh :=
  sinhHomeomorph.symm.Continuous
#align real.continuous_arsinh Real.continuous_arsinh

end Real

open Real

theorem Filter.Tendsto.arsinh {α : Type _} {l : Filter α} {f : α → ℝ} {a : ℝ}
    (h : Tendsto f l (𝓝 a)) : Tendsto (fun x => arsinh (f x)) l (𝓝 (arsinh a)) :=
  (continuous_arsinh.Tendsto _).comp h
#align filter.tendsto.arsinh Filter.Tendsto.arsinh

section Continuous

variable {X : Type _} [TopologicalSpace X] {f : X → ℝ} {s : Set X} {a : X}

theorem ContinuousAt.arsinh (h : ContinuousAt f a) : ContinuousAt (fun x => arsinh (f x)) a :=
  h.arsinh
#align continuous_at.arsinh ContinuousAt.arsinh

theorem ContinuousWithinAt.arsinh (h : ContinuousWithinAt f s a) :
    ContinuousWithinAt (fun x => arsinh (f x)) s a :=
  h.arsinh
#align continuous_within_at.arsinh ContinuousWithinAt.arsinh

theorem ContinuousOn.arsinh (h : ContinuousOn f s) : ContinuousOn (fun x => arsinh (f x)) s :=
  fun x hx => (h x hx).arsinh
#align continuous_on.arsinh ContinuousOn.arsinh

theorem Continuous.arsinh (h : Continuous f) : Continuous fun x => arsinh (f x) :=
  continuous_arsinh.comp h
#align continuous.arsinh Continuous.arsinh

end Continuous

section fderiv

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] {f : E → ℝ} {s : Set E} {a : E}
  {f' : E →L[ℝ] ℝ} {n : ℕ∞}

theorem HasStrictFderivAt.arsinh (hf : HasStrictFderivAt f f' a) :
    HasStrictFderivAt (fun x => arsinh (f x)) ((sqrt (1 + f a ^ 2))⁻¹ • f') a :=
  (hasStrictDerivAt_arsinh _).comp_hasStrictFderivAt a hf
#align has_strict_fderiv_at.arsinh HasStrictFderivAt.arsinh

theorem HasFderivAt.arsinh (hf : HasFderivAt f f' a) :
    HasFderivAt (fun x => arsinh (f x)) ((sqrt (1 + f a ^ 2))⁻¹ • f') a :=
  (hasDerivAt_arsinh _).comp_hasFderivAt a hf
#align has_fderiv_at.arsinh HasFderivAt.arsinh

theorem HasFderivWithinAt.arsinh (hf : HasFderivWithinAt f f' s a) :
    HasFderivWithinAt (fun x => arsinh (f x)) ((sqrt (1 + f a ^ 2))⁻¹ • f') s a :=
  (hasDerivAt_arsinh _).comp_hasFderivWithinAt a hf
#align has_fderiv_within_at.arsinh HasFderivWithinAt.arsinh

theorem DifferentiableAt.arsinh (h : DifferentiableAt ℝ f a) :
    DifferentiableAt ℝ (fun x => arsinh (f x)) a :=
  (differentiable_arsinh _).comp a h
#align differentiable_at.arsinh DifferentiableAt.arsinh

theorem DifferentiableWithinAt.arsinh (h : DifferentiableWithinAt ℝ f s a) :
    DifferentiableWithinAt ℝ (fun x => arsinh (f x)) s a :=
  (differentiable_arsinh _).comp_differentiableWithinAt a h
#align differentiable_within_at.arsinh DifferentiableWithinAt.arsinh

theorem DifferentiableOn.arsinh (h : DifferentiableOn ℝ f s) :
    DifferentiableOn ℝ (fun x => arsinh (f x)) s := fun x hx => (h x hx).arsinh
#align differentiable_on.arsinh DifferentiableOn.arsinh

theorem Differentiable.arsinh (h : Differentiable ℝ f) : Differentiable ℝ fun x => arsinh (f x) :=
  differentiable_arsinh.comp h
#align differentiable.arsinh Differentiable.arsinh

theorem ContDiffAt.arsinh (h : ContDiffAt ℝ n f a) : ContDiffAt ℝ n (fun x => arsinh (f x)) a :=
  contDiff_arsinh.ContDiffAt.comp a h
#align cont_diff_at.arsinh ContDiffAt.arsinh

theorem ContDiffWithinAt.arsinh (h : ContDiffWithinAt ℝ n f s a) :
    ContDiffWithinAt ℝ n (fun x => arsinh (f x)) s a :=
  contDiff_arsinh.ContDiffAt.comp_contDiffWithinAt a h
#align cont_diff_within_at.arsinh ContDiffWithinAt.arsinh

theorem ContDiff.arsinh (h : ContDiff ℝ n f) : ContDiff ℝ n fun x => arsinh (f x) :=
  contDiff_arsinh.comp h
#align cont_diff.arsinh ContDiff.arsinh

theorem ContDiffOn.arsinh (h : ContDiffOn ℝ n f s) : ContDiffOn ℝ n (fun x => arsinh (f x)) s :=
  fun x hx => (h x hx).arsinh
#align cont_diff_on.arsinh ContDiffOn.arsinh

end fderiv

section deriv

variable {f : ℝ → ℝ} {s : Set ℝ} {a f' : ℝ}

theorem HasStrictDerivAt.arsinh (hf : HasStrictDerivAt f f' a) :
    HasStrictDerivAt (fun x => arsinh (f x)) ((sqrt (1 + f a ^ 2))⁻¹ • f') a :=
  (hasStrictDerivAt_arsinh _).comp a hf
#align has_strict_deriv_at.arsinh HasStrictDerivAt.arsinh

theorem HasDerivAt.arsinh (hf : HasDerivAt f f' a) :
    HasDerivAt (fun x => arsinh (f x)) ((sqrt (1 + f a ^ 2))⁻¹ • f') a :=
  (hasDerivAt_arsinh _).comp a hf
#align has_deriv_at.arsinh HasDerivAt.arsinh

theorem HasDerivWithinAt.arsinh (hf : HasDerivWithinAt f f' s a) :
    HasDerivWithinAt (fun x => arsinh (f x)) ((sqrt (1 + f a ^ 2))⁻¹ • f') s a :=
  (hasDerivAt_arsinh _).comp_hasDerivWithinAt a hf
#align has_deriv_within_at.arsinh HasDerivWithinAt.arsinh

end deriv


import data.rat.basic
import algebra.group_with_zero.power
import tactic.linarith

def reduce_float_raw'' : ℕ → ℕ
| 0 := 0
| m@(nat.succ _) :=
  if (m % 2 = 0)
  then
    have m / 2 < m, from nat.div_lt_self (nat.zero_lt_succ _) (by linarith),
    reduce_float_raw'' (m / 2)
  else m

def reduce_float_raw_aux : ℕ × ℤ → ℕ × ℤ
| ⟨0, e⟩ := ⟨0, 1⟩
| ⟨m@(nat.succ _), e⟩ :=
  have prod.lex has_lt.lt (λ (a₁ a₂ : ℤ), a₁.sizeof < a₂.sizeof) (⟨m / 2, e + 1⟩ : ℕ × ℤ) ⟨m, e⟩, from
  begin
    have h : _x.succ / 2 < _x.succ, from nat.div_lt_self (nat.zero_lt_succ _) (by linarith),
    rw prod.lex_def, left, dsimp, assumption,
  end,
  if (m % 2 = 0)
  then
    reduce_float_raw_aux ⟨m / 2, e + 1⟩
  else ⟨m, e⟩
using_well_founded { dec_tac := tactic.assumption }

lemma reduce_float_raw_aux_to_rat (m : ℕ) (e : ℤ)
: (m : ℚ) * 2 ^ e = ((reduce_float_raw_aux ⟨m, e⟩).1 : ℚ) * 2 ^ ((reduce_float_raw_aux ⟨m, e⟩).2) :=
begin
  revert e,
  apply nat.strong_induction_on m, intros n ih, cases n,
  { simp [reduce_float_raw_aux], },
  { intros e, unfold reduce_float_raw_aux,
    by_cases (n.succ % 2 = 0); split_ifs,
    { have hlt : n.succ / 2 < n.succ, from nat.div_lt_self (nat.zero_lt_succ _) (by linarith),
      have ihm2 := ih (n.succ / 2) hlt (e + 1), rw ←ihm2,
      have hn2 := nat.div_mul_cancel (nat.dvd_of_mod_eq_zero h),
      have hn2e : (↑(n.succ) * 2 ^ e : ℚ) = ↑(n.succ / 2 * 2) * 2 ^ e, { rw hn2, },
      rw hn2e, push_cast, ring, congr,
      rw [fpow_add (by norm_num : (2 : ℚ) ≠ 0), mul_comm], congr, },
    { refl, } }
end


theorem mul_pos (a b : mynat) : a ≠ 0 → b ≠ 0 → a * b ≠ 0 :=
begin
intros f h j,
cases b with b,
apply h,
refl,
cases a with a,
apply f,
refl,
rw mul_succ at j,
rw add_succ at j,
exfalso,
exact succ_ne_zero _ j,
end


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.algebra_tower
import Mathlib.linear_algebra.matrix
import Mathlib.PostPort

universes u v w

namespace Mathlib

/-!
# Tower of field extensions

In this file we prove the tower law for arbitrary extensions and finite extensions.
Suppose `L` is a field extension of `K` and `K` is a field extension of `F`.
Then `[L:F] = [L:K] [K:F]` where `[E₁:E₂]` means the `E₂`-dimension of `E₁`.

In fact we generalize it to vector spaces, where `L` is not necessarily a field,
but just a vector space over `K`.

## Implementation notes

We prove two versions, since there are two notions of dimensions: `vector_space.dim` which gives
the dimension of an arbitrary vector space as a cardinal, and `finite_dimensional.findim` which
gives the dimension of a finitely-dimensional vector space as a natural number.

## Tags

tower law

-/

/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem dim_mul_dim' (F : Type u) (K : Type v) (A : Type w) [field F] [field K] [add_comm_group A] [algebra F K] [vector_space K A] [vector_space F A] [is_scalar_tower F K A] : cardinal.lift (vector_space.dim F K) * cardinal.lift (vector_space.dim K A) = cardinal.lift (vector_space.dim F A) := sorry

/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem dim_mul_dim (F : Type u) (K : Type v) (A : Type v) [field F] [field K] [add_comm_group A] [algebra F K] [vector_space K A] [vector_space F A] [is_scalar_tower F K A] : vector_space.dim F K * vector_space.dim K A = vector_space.dim F A := sorry

namespace finite_dimensional

theorem trans (F : Type u) (K : Type v) (A : Type w) [field F] [field K] [add_comm_group A] [algebra F K] [vector_space K A] [vector_space F A] [is_scalar_tower F K A] [finite_dimensional F K] [finite_dimensional K A] : finite_dimensional F A := sorry

theorem right (F : Type u) (K : Type v) (A : Type w) [field F] [field K] [add_comm_group A] [algebra F K] [vector_space K A] [vector_space F A] [is_scalar_tower F K A] [hf : finite_dimensional F A] : finite_dimensional K A := sorry

/-- Tower law: if `A` is a `K`-algebra and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem findim_mul_findim (F : Type u) (K : Type v) (A : Type w) [field F] [field K] [add_comm_group A] [algebra F K] [vector_space K A] [vector_space F A] [is_scalar_tower F K A] [finite_dimensional F K] : findim F K * findim K A = findim F A := sorry

protected instance linear_map (F : Type u) (V : Type v) (W : Type w) [field F] [add_comm_group V] [vector_space F V] [add_comm_group W] [vector_space F W] [finite_dimensional F V] [finite_dimensional F W] : finite_dimensional F (linear_map F V W) :=
  sorry

theorem findim_linear_map (F : Type u) (V : Type v) (W : Type w) [field F] [add_comm_group V] [vector_space F V] [add_comm_group W] [vector_space F W] [finite_dimensional F V] [finite_dimensional F W] : findim F (linear_map F V W) = findim F V * findim F W := sorry

-- TODO: generalize by removing [finite_dimensional F K]

-- V = ⊕F,

-- (V →ₗ[F] K) = ((⊕F) →ₗ[F] K) = (⊕ (F →ₗ[F] K)) = ⊕K

protected instance linear_map' (F : Type u) (K : Type v) (V : Type w) [field F] [field K] [algebra F K] [finite_dimensional F K] [add_comm_group V] [vector_space F V] [finite_dimensional F V] : finite_dimensional K (linear_map F V K) :=
  right F K (linear_map F V K)

theorem findim_linear_map' (F : Type u) (K : Type v) (V : Type w) [field F] [field K] [algebra F K] [finite_dimensional F K] [add_comm_group V] [vector_space F V] [finite_dimensional F V] : findim K (linear_map F V K) = findim F V :=
  iff.mp (nat.mul_right_inj ((fun (this : 0 < findim F K) => this) findim_pos))
    (Eq.trans (Eq.trans (findim_mul_findim F K (linear_map F V K)) (findim_linear_map F V K))
      (mul_comm (findim F V) (findim F K)))


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Floris van Doorn, Gabriel Ebner, Yury Kudryashov

! This file was ported from Lean 3 source module data.nat.lattice
! leanprover-community/mathlib commit 2445c98ae4b87eabebdde552593519b9b6dc350c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.ConditionallyCompleteLattice.Finset

/-!
# Conditionally complete linear order structure on `ℕ`

In this file we

* define a `ConditionallyCcompleteLinearOrderBot` structure on `ℕ`;
* prove a few lemmas about `supᵢ`/`infᵢ`/`Set.unionᵢ`/`Set.interᵢ` and natural numbers.
-/

open Set

namespace Nat

open Classical

noncomputable instance : InfSet ℕ :=
  ⟨fun s ↦ if h : ∃ n, n ∈ s then @Nat.find (fun n ↦ n ∈ s) _ h else 0⟩

noncomputable instance : SupSet ℕ :=
  ⟨fun s ↦ if h : ∃ n, ∀ a ∈ s, a ≤ n then @Nat.find (fun n ↦ ∀ a ∈ s, a ≤ n) _ h else 0⟩

theorem infₛ_def {s : Set ℕ} (h : s.Nonempty) : infₛ s = @Nat.find (fun n ↦ n ∈ s) _ h :=
  dif_pos _
#align nat.Inf_def Nat.infₛ_def

theorem supₛ_def {s : Set ℕ} (h : ∃ n, ∀ a ∈ s, a ≤ n) :
    supₛ s = @Nat.find (fun n ↦ ∀ a ∈ s, a ≤ n) _ h :=
  dif_pos _
#align nat.Sup_def Nat.supₛ_def

theorem Set.Infinite.Nat.supₛ_eq_zero {s : Set ℕ} (h : s.Infinite) : supₛ s = 0 :=
  dif_neg fun ⟨n, hn⟩ ↦
    let ⟨k, hks, hk⟩ := h.exists_nat_lt n
    (hn k hks).not_lt hk
#align set.infinite.nat.Sup_eq_zero Nat.Set.Infinite.Nat.supₛ_eq_zero

@[simp]
theorem infₛ_eq_zero {s : Set ℕ} : infₛ s = 0 ↔ 0 ∈ s ∨ s = ∅ := by
  cases eq_empty_or_nonempty s with
  | inl h => subst h
             simp only [or_true_iff, eq_self_iff_true, iff_true_iff, infᵢ, InfSet.infₛ,
                        mem_empty_iff_false, exists_false, dif_neg, not_false_iff]
  | inr h => simp only [h.ne_empty, or_false_iff, Nat.infₛ_def, h, Nat.find_eq_zero]
#align nat.Inf_eq_zero Nat.infₛ_eq_zero

@[simp]
theorem infₛ_empty : infₛ ∅ = 0 := by
  rw [infₛ_eq_zero]
  right
  rfl
#align nat.Inf_empty Nat.infₛ_empty

@[simp]
theorem infᵢ_of_empty {ι : Sort _} [IsEmpty ι] (f : ι → ℕ) : infᵢ f = 0 := by
  rw [infᵢ_of_empty', infₛ_empty]
#align nat.infi_of_empty Nat.infᵢ_of_empty

theorem infₛ_mem {s : Set ℕ} (h : s.Nonempty) : infₛ s ∈ s := by
  rw [Nat.infₛ_def h]
  exact Nat.find_spec h
#align nat.Inf_mem Nat.infₛ_mem

theorem not_mem_of_lt_infₛ {s : Set ℕ} {m : ℕ} (hm : m < infₛ s) : m ∉ s := by
  cases eq_empty_or_nonempty s with
  | inl h => subst h; apply not_mem_empty
  | inr h => rw [Nat.infₛ_def h] at hm; exact Nat.find_min h hm
#align nat.not_mem_of_lt_Inf Nat.not_mem_of_lt_infₛ

protected theorem infₛ_le {s : Set ℕ} {m : ℕ} (hm : m ∈ s) : infₛ s ≤ m := by
  rw [Nat.infₛ_def ⟨m, hm⟩]
  exact Nat.find_min' ⟨m, hm⟩ hm
#align nat.Inf_le Nat.infₛ_le

theorem nonempty_of_pos_infₛ {s : Set ℕ} (h : 0 < infₛ s) : s.Nonempty := by
  by_contra contra
  rw [Set.not_nonempty_iff_eq_empty] at contra
  have h' : infₛ s ≠ 0 := ne_of_gt h
  apply h'
  rw [Nat.infₛ_eq_zero]
  right
  assumption
#align nat.nonempty_of_pos_Inf Nat.nonempty_of_pos_infₛ

theorem nonempty_of_infₛ_eq_succ {s : Set ℕ} {k : ℕ} (h : infₛ s = k + 1) : s.Nonempty :=
  nonempty_of_pos_infₛ (h.symm ▸ succ_pos k : infₛ s > 0)
#align nat.nonempty_of_Inf_eq_succ Nat.nonempty_of_infₛ_eq_succ

theorem eq_Ici_of_nonempty_of_upward_closed {s : Set ℕ} (hs : s.Nonempty)
    (hs' : ∀ k₁ k₂ : ℕ, k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s) : s = Ici (infₛ s) :=
  ext fun n ↦ ⟨fun H ↦ Nat.infₛ_le H, fun H ↦ hs' (infₛ s) n H (infₛ_mem hs)⟩
#align nat.eq_Ici_of_nonempty_of_upward_closed Nat.eq_Ici_of_nonempty_of_upward_closed

theorem infₛ_upward_closed_eq_succ_iff {s : Set ℕ} (hs : ∀ k₁ k₂ : ℕ, k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s)
    (k : ℕ) : infₛ s = k + 1 ↔ k + 1 ∈ s ∧ k ∉ s := by
  constructor
  · intro H
    rw [eq_Ici_of_nonempty_of_upward_closed (nonempty_of_infₛ_eq_succ _) hs, H, mem_Ici, mem_Ici]
    exact ⟨le_rfl, k.not_succ_le_self⟩;
    exact k; assumption
  · rintro ⟨H, H'⟩
    rw [infₛ_def (⟨_, H⟩ : s.Nonempty), find_eq_iff]
    exact ⟨H, fun n hnk hns ↦ H' <| hs n k (lt_succ_iff.mp hnk) hns⟩
#align nat.Inf_upward_closed_eq_succ_iff Nat.infₛ_upward_closed_eq_succ_iff

/-- This instance is necessary, otherwise the lattice operations would be derived via
`ConditionallyCompleteLinearOrderBot` and marked as noncomputable. -/
instance : Lattice ℕ :=
  LinearOrder.toLattice

noncomputable instance : ConditionallyCompleteLinearOrderBot ℕ :=
  { (inferInstance : OrderBot ℕ), (LinearOrder.toLattice : Lattice ℕ),
    (inferInstance : LinearOrder ℕ) with
    -- sup := supₛ -- Porting note: removed, unecessary?
    -- inf := infₛ -- Porting note: removed, unecessary?
    le_csupₛ := fun s a hb ha ↦ by rw [supₛ_def hb] ; revert a ha ; exact @Nat.find_spec _ _ hb
    csupₛ_le := fun s a _ ha ↦ by rw [supₛ_def ⟨a, ha⟩] ; exact Nat.find_min' _ ha
    le_cinfₛ := fun s a hs hb ↦ by
      rw [infₛ_def hs] ; exact hb (@Nat.find_spec (fun n ↦ n ∈ s) _ _)
    cinfₛ_le := fun s a _ ha ↦ by rw [infₛ_def ⟨a, ha⟩] ; exact Nat.find_min' _ ha
    csupₛ_empty := by
      simp only [supₛ_def, Set.mem_empty_iff_false, forall_const, forall_prop_of_false,
        not_false_iff, exists_const]
      apply bot_unique (Nat.find_min' _ _)
      trivial }

theorem supₛ_mem {s : Set ℕ} (h₁ : s.Nonempty) (h₂ : BddAbove s) : supₛ s ∈ s :=
  let ⟨k, hk⟩ := h₂
  h₁.cSup_mem ((finite_le_nat k).subset hk)
#align nat.Sup_mem Nat.supₛ_mem

theorem infₛ_add {n : ℕ} {p : ℕ → Prop} (hn : n ≤ infₛ { m | p m }) :
    infₛ { m | p (m + n) } + n = infₛ { m | p m } := by
  obtain h | ⟨m, hm⟩ := { m | p (m + n) }.eq_empty_or_nonempty
  · rw [h, Nat.infₛ_empty, zero_add]
    obtain hnp | hnp := hn.eq_or_lt
    · exact hnp
    suffices hp : p (infₛ { m | p m } - n + n)
    · exact (h.subset hp).elim
    rw [tsub_add_cancel_of_le hn]
    exact cinfₛ_mem (nonempty_of_pos_infₛ <| n.zero_le.trans_lt hnp)
  · have hp : ∃ n, n ∈ { m | p m } := ⟨_, hm⟩
    rw [Nat.infₛ_def ⟨m, hm⟩, Nat.infₛ_def hp]
    rw [Nat.infₛ_def hp] at hn
    exact find_add hn
#align nat.Inf_add Nat.infₛ_add

theorem infₛ_add' {n : ℕ} {p : ℕ → Prop} (h : 0 < infₛ { m | p m }) :
    infₛ { m | p m } + n = infₛ { m | p (m - n) } := by
  suffices h₁ : n ≤ infₛ {m | p (m - n)}
  convert infₛ_add h₁
  · simp_rw [add_tsub_cancel_right]
  obtain ⟨m, hm⟩ := nonempty_of_pos_infₛ h
  refine'
    le_cinfₛ ⟨m + n, _⟩ fun b hb ↦
      le_of_not_lt fun hbn ↦
        ne_of_mem_of_not_mem _ (not_mem_of_lt_infₛ h) (tsub_eq_zero_of_le hbn.le)
  · dsimp
    rwa [add_tsub_cancel_right]
  · exact hb
#align nat.Inf_add' Nat.infₛ_add'

section

variable {α : Type _} [CompleteLattice α]

theorem supᵢ_lt_succ (u : ℕ → α) (n : ℕ) : (⨆ k < n + 1, u k) = (⨆ k < n, u k) ⊔ u n := by
  simp [Nat.lt_succ_iff_lt_or_eq, supᵢ_or, supᵢ_sup_eq]
#align nat.supr_lt_succ Nat.supᵢ_lt_succ

theorem supᵢ_lt_succ' (u : ℕ → α) (n : ℕ) : (⨆ k < n + 1, u k) = u 0 ⊔ ⨆ k < n, u (k + 1) := by
  rw [← sup_supᵢ_nat_succ]
  simp
#align nat.supr_lt_succ' Nat.supᵢ_lt_succ'

theorem infᵢ_lt_succ (u : ℕ → α) (n : ℕ) : (⨅ k < n + 1, u k) = (⨅ k < n, u k) ⊓ u n :=
  @supᵢ_lt_succ αᵒᵈ _ _ _
#align nat.infi_lt_succ Nat.infᵢ_lt_succ

theorem infᵢ_lt_succ' (u : ℕ → α) (n : ℕ) : (⨅ k < n + 1, u k) = u 0 ⊓ ⨅ k < n, u (k + 1) :=
  @supᵢ_lt_succ' αᵒᵈ _ _ _
#align nat.infi_lt_succ' Nat.infᵢ_lt_succ'

end

end Nat

namespace Set

variable {α : Type _}

theorem bunionᵢ_lt_succ (u : ℕ → Set α) (n : ℕ) : (⋃ k < n + 1, u k) = (⋃ k < n, u k) ∪ u n :=
  Nat.supᵢ_lt_succ u n
#align set.bUnion_lt_succ Set.bunionᵢ_lt_succ

theorem bunionᵢ_lt_succ' (u : ℕ → Set α) (n : ℕ) : (⋃ k < n + 1, u k) = u 0 ∪ ⋃ k < n, u (k + 1) :=
  Nat.supᵢ_lt_succ' u n
#align set.bUnion_lt_succ' Set.bunionᵢ_lt_succ'

theorem binterᵢ_lt_succ (u : ℕ → Set α) (n : ℕ) : (⋂ k < n + 1, u k) = (⋂ k < n, u k) ∩ u n :=
  Nat.infᵢ_lt_succ u n
#align set.bInter_lt_succ Set.binterᵢ_lt_succ

theorem binterᵢ_lt_succ' (u : ℕ → Set α) (n : ℕ) : (⋂ k < n + 1, u k) = u 0 ∩ ⋂ k < n, u (k + 1) :=
  Nat.infᵢ_lt_succ' u n
#align set.bInter_lt_succ' Set.binterᵢ_lt_succ'

end Set


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.box_integral.partition.split
import analysis.normed_space.operator_norm
import data.set.intervals.proj_Icc

/-!
# Box additive functions

We say that a function `f : box ι → M` from boxes in `ℝⁿ` to a commutative additive monoid `M` is
*box additive* on subboxes of `I₀ : with_top (box ι)` if for any box `J`, `↑J ≤ I₀`, and a partition
`π` of `J`, `f J = ∑ J' in π.boxes, f J'`. We use `I₀ : with_top (box ι)` instead of `I₀ : box ι` to
use the same definition for functions box additive on subboxes of a box and for functions box
additive on all boxes.

Examples of box-additive functions include the measure of a box and the integral of a fixed
integrable function over a box.

In this file we define box-additive functions and prove that a function such that
`f J = f (J ∩ {x | x i < y}) + f (J ∩ {x | y ≤ x i})` is box-additive.

### Tags

rectangular box, additive function
-/

noncomputable theory
open_locale classical big_operators
open function set

namespace box_integral

variables {ι M : Type*} {n : ℕ}

/-- A function on `box ι` is called box additive if for every box `J` and a partition `π` of `J`
we have `f J = ∑ Ji in π.boxes, f Ji`. A function is called box additive on subboxes of `I : box ι`
if the same property holds for `J ≤ I`. We formalize these two notions in the same definition
using `I : with_bot (box ι)`: the value `I = ⊤` corresponds to functions box additive on the whole
space.  -/
structure box_additive_map (ι M : Type*) [add_comm_monoid M] (I : with_top (box ι)) :=
(to_fun : box ι → M)
(sum_partition_boxes' : ∀ J : box ι, ↑J ≤ I → ∀ π : prepartition J, π.is_partition →
  ∑ Ji in π.boxes, to_fun Ji = to_fun J)

localized "notation ι ` →ᵇᵃ `:25 M := box_integral.box_additive_map ι M ⊤" in box_integral
localized "notation ι ` →ᵇᵃ[`:25 I `] ` M := box_integral.box_additive_map ι M I" in box_integral

namespace box_additive_map

open box prepartition finset

variables {N : Type*} [add_comm_monoid M] [add_comm_monoid N] {I₀ : with_top (box ι)}
  {I J : box ι} {i : ι}

instance : has_coe_to_fun (ι →ᵇᵃ[I₀] M) (λ _, box ι → M) := ⟨to_fun⟩

initialize_simps_projections box_integral.box_additive_map (to_fun → apply)

@[simp] lemma to_fun_eq_coe (f : ι →ᵇᵃ[I₀] M) : f.to_fun = f := rfl

@[simp] lemma coe_mk (f h) : ⇑(mk f h : ι →ᵇᵃ[I₀] M) = f := rfl

lemma coe_injective : injective (λ (f : ι →ᵇᵃ[I₀] M) x, f x) :=
by { rintro ⟨f, hf⟩ ⟨g, hg⟩ (rfl : f = g), refl }

@[simp] lemma coe_inj {f g : ι →ᵇᵃ[I₀] M} : (f : box ι → M) = g ↔ f = g :=
coe_injective.eq_iff

lemma sum_partition_boxes (f : ι →ᵇᵃ[I₀] M) (hI : ↑I ≤ I₀) {π : prepartition I}
  (h : π.is_partition) :
  ∑ J in π.boxes, f J = f I :=
f.sum_partition_boxes' I hI π h

@[simps { fully_applied := ff }] instance : has_zero (ι →ᵇᵃ[I₀] M) :=
⟨⟨0, λ I hI π hπ, sum_const_zero⟩⟩

instance : inhabited (ι →ᵇᵃ[I₀] M) := ⟨0⟩

instance : has_add (ι →ᵇᵃ[I₀] M) :=
⟨λ f g, ⟨f + g, λ I hI π hπ,
  by simp only [pi.add_apply, sum_add_distrib, sum_partition_boxes _ hI hπ]⟩⟩

instance : add_comm_monoid (ι →ᵇᵃ[I₀] M) :=
function.injective.add_comm_monoid _ coe_injective rfl (λ _ _, rfl)

@[simp] lemma map_split_add (f : ι →ᵇᵃ[I₀] M) (hI : ↑I ≤ I₀) (i : ι) (x : ℝ) :
  (I.split_lower i x).elim 0 f + (I.split_upper i x).elim 0 f = f I :=
by rw [← f.sum_partition_boxes hI (is_partition_split I i x), sum_split_boxes]

/-- If `f` is box-additive on subboxes of `I₀`, then it is box-additive on subboxes of any
`I ≤ I₀`. -/
@[simps] def restrict (f : ι →ᵇᵃ[I₀] M) (I : with_top (box ι)) (hI : I ≤ I₀) : ι →ᵇᵃ[I] M :=
⟨f, λ J hJ, f.2 J (hJ.trans hI)⟩

/-- If `f : box ι → M` is box additive on partitions of the form `split I i x`, then it is box
additive. -/
def of_map_split_add [fintype ι] (f : box ι → M) (I₀ : with_top (box ι))
  (hf : ∀ I : box ι, ↑I ≤ I₀ → ∀ {i x}, x ∈ Ioo (I.lower i) (I.upper i) →
    (I.split_lower i x).elim 0 f + (I.split_upper i x).elim 0 f = f I) :
  ι →ᵇᵃ[I₀] M :=
begin
  refine ⟨f, _⟩,
  replace hf : ∀ I : box ι, ↑I ≤ I₀ → ∀ s, ∑ J in (split_many I s).boxes, f J = f I,
  { intros I hI s,
    induction s using finset.induction_on with a s ha ihs, { simp },
    rw [split_many_insert, inf_split, ← ihs, bUnion_boxes, sum_bUnion_boxes],
    refine finset.sum_congr rfl (λ J' hJ', _),
    by_cases h : a.2 ∈ Ioo (J'.lower a.1) (J'.upper a.1),
    { rw sum_split_boxes,
      exact hf _ ((with_top.coe_le_coe.2 $ le_of_mem _ hJ').trans hI) h },
    { rw [split_of_not_mem_Ioo h, top_boxes, finset.sum_singleton] } },
  intros I hI π hπ,
  have Hle : ∀ J ∈ π, ↑J ≤ I₀, from λ J hJ, (with_top.coe_le_coe.2 $ π.le_of_mem hJ).trans hI,
  rcases hπ.exists_split_many_le with ⟨s, hs⟩,
  rw [← hf _ hI, ← inf_of_le_right hs, inf_split_many, bUnion_boxes, sum_bUnion_boxes],
  exact finset.sum_congr rfl (λ J hJ, (hf _ (Hle _ hJ) _).symm)
end

/-- If `g : M → N` is an additive map and `f` is a box additive map, then `g ∘ f` is a box additive
map. -/
@[simps { fully_applied := ff }] def map (f : ι →ᵇᵃ[I₀] M) (g : M →+ N) :
  ι →ᵇᵃ[I₀] N :=
{ to_fun := g ∘ f,
  sum_partition_boxes' := λ I hI π hπ, by rw [← g.map_sum, f.sum_partition_boxes hI hπ] }

/-- If `f` is a box additive function on subboxes of `I` and `π₁`, `π₂` are two prepartitions of
`I` that cover the same part of `I`, then `∑ J in π₁.boxes, f J = ∑ J in π₂.boxes, f J`. -/
lemma sum_boxes_congr [fintype ι] (f : ι →ᵇᵃ[I₀] M) (hI : ↑I ≤ I₀) {π₁ π₂ : prepartition I}
  (h : π₁.Union = π₂.Union) :
  ∑ J in π₁.boxes, f J = ∑ J in π₂.boxes, f J :=
begin
  rcases exists_split_many_inf_eq_filter_of_finite {π₁, π₂} ((finite_singleton _).insert _)
    with ⟨s, hs⟩, simp only [inf_split_many] at hs,
  rcases ⟨hs _ (or.inl rfl), hs _ (or.inr rfl)⟩ with ⟨h₁, h₂⟩, clear hs,
  rw h at h₁,
  calc ∑ J in π₁.boxes, f J = ∑ J in π₁.boxes, ∑ J' in (split_many J s).boxes, f J' :
    finset.sum_congr rfl (λ J hJ, (f.sum_partition_boxes _ (is_partition_split_many _ _)).symm)
  ... = ∑ J in (π₁.bUnion (λ J, split_many J s)).boxes, f J   : (sum_bUnion_boxes _ _ _).symm
  ... = ∑ J in (π₂.bUnion (λ J, split_many J s)).boxes, f J   : by rw [h₁, h₂]
  ... = ∑ J in π₂.boxes, ∑ J' in (split_many J s).boxes, f J' : sum_bUnion_boxes _ _ _
  ... = ∑ J in π₂.boxes, f J :
    finset.sum_congr rfl (λ J hJ, (f.sum_partition_boxes _ (is_partition_split_many _ _))),
  exacts [(with_top.coe_le_coe.2 $ π₁.le_of_mem hJ).trans hI,
    (with_top.coe_le_coe.2 $ π₂.le_of_mem hJ).trans hI]
end

section to_smul

variables {E : Type*} [normed_group E] [normed_space ℝ E]

/-- If `f` is a box-additive map, then so is the map sending `I` to the scalar multiplication
by `f I` as a continuous linear map from `E` to itself. -/
def to_smul (f : ι →ᵇᵃ[I₀] ℝ) : ι →ᵇᵃ[I₀] (E →L[ℝ] E) :=
f.map (continuous_linear_map.lsmul ℝ ℝ).to_linear_map.to_add_monoid_hom

@[simp] lemma to_smul_apply (f : ι →ᵇᵃ[I₀] ℝ) (I : box ι) (x : E) : f.to_smul I x = f I • x := rfl

end to_smul

/-- Given a box `I₀` in `ℝⁿ⁺¹`, `f x : box (fin n) → G` is a family of functions indexed by a real
`x` and for `x ∈ [I₀.lower i, I₀.upper i]`, `f x` is box-additive on subboxes of the `i`-th face of
`I₀`, then `λ J, f (J.upper i) (J.face i) - f (J.lower i) (J.face i)` is box-additive on subboxes of
`I₀`. -/
@[simps] def {u} upper_sub_lower {G : Type u} [add_comm_group G]
  (I₀ : box (fin (n + 1))) (i : fin (n + 1)) (f : ℝ → box (fin n) → G)
  (fb : Icc (I₀.lower i) (I₀.upper i) → fin n →ᵇᵃ[I₀.face i] G)
  (hf : ∀ x (hx : x ∈ Icc (I₀.lower i) (I₀.upper i)) J, f x J = fb ⟨x, hx⟩ J) :
  fin (n + 1) →ᵇᵃ[I₀] G :=
of_map_split_add
  (λ J : box (fin (n + 1)), f (J.upper i) (J.face i) - f (J.lower i) (J.face i)) I₀
  begin
    intros J hJ j,
    rw with_top.coe_le_coe at hJ,
    refine i.succ_above_cases _ _ j,
    { intros x hx,
      simp only [box.split_lower_def hx, box.split_upper_def hx, update_same,
        ← with_bot.some_eq_coe, option.elim, box.face, (∘), update_noteq (fin.succ_above_ne _ _)],
      abel },
    { clear j, intros j x hx,
      have : (J.face i : with_top (box (fin n))) ≤ I₀.face i,
        from with_top.coe_le_coe.2 (face_mono hJ i),
      rw [le_iff_Icc, @box.Icc_eq_pi _ I₀] at hJ,
      rw [hf _ (hJ J.upper_mem_Icc _ trivial), hf _ (hJ J.lower_mem_Icc _ trivial),
        ← (fb _).map_split_add this j x, ← (fb _).map_split_add this j x],
      have hx' : x ∈ Ioo ((J.face i).lower j) ((J.face i).upper j) := hx,
      simp only [box.split_lower_def hx, box.split_upper_def hx,
        box.split_lower_def hx', box.split_upper_def hx',
        ← with_bot.some_eq_coe, option.elim, box.face_mk,
        update_noteq (fin.succ_above_ne _ _).symm, sub_add_comm,
        update_comp_eq_of_injective _ i.succ_above.injective j x, ← hf],
      simp only [box.face] }
  end

end box_additive_map

end box_integral


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_graph_two_colorable (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  assume h1 : two_colorable G,
  have h2 : ∃ (A B : set G), ∀ (v : G), v ∈ A ∨ v ∈ B ∧ (∀ (v1 v2 : G), v1 ∈ A ∧ v2 ∈ B → v1 -- v2 ∈ G), from by auto [h1],
  have h3 : ∀ (v1 v2 : G), v1 ∈ A ∧ v2 ∈ B → v1 -- v2 ∈ G, from by auto [h2],
  have h4 : ∀ (v1 v2 : G), v1 ∈ A ∧ v2 ∈ A → v1 -- v2 ∉ G, from by auto [h2],
  have h5 : ∀ (v1 v2 : G), v1 ∈ B ∧ v2 ∈ B → v1 -- v2 ∉ G, from by auto [h2],
  have h6 : ∀ (v1 v2 : G), v1 ∈ A ∧ v2 ∈ A → v1 -- v2 ∉ G, from by auto [h2],
  have h7 : bipartite G, from by auto [h2, h3, h4, h5, h6],

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  assume h8 : bipartite G,
  have h9 : ∃ (A B : set G), ∀ (v : G), v ∈ A ∨ v ∈ B ∧ (∀ (v1 v2 : G), v1 ∈ A ∧ v2 ∈ B → v1 -- v2 ∈ G), from by auto [h8],
  have h10 : ∀ (v1 v2 : G), v1 ∈ A ∧ v2 ∈ B → v1 -- v2 ∈ G, from by auto [h9],
  have h11 : ∀ (v1 v2 : G), v1 ∈ A ∧ v2 ∈ A → v1 -- v2 ∉ G, from by auto [h9],
  have h12 : ∀ (v1 v2 : G), v1 ∈ B ∧ v2 ∈ B → v1 -- v2 ∉ G, from by auto [h9],
  have h13 : ∀ (v1 v2 : G), v1 ∈ A ∧ v2 ∈ A → v1 -- v2 ∉ G, from by auto [h9],
  have h14 : two_colorable G, from by auto [h9, h10, h11, h12, h13],

  show two_colorable G ↔ bipartite G, from by auto [h7, h14] using [iff.intro, iff.mpr],
end

--OUTPUT 2
theorem graph_2_colorable_iff_bipartite (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- $G$ is 2-colorable, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : two_colorable G,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G, ∀ v : G, (v ∈ A ∨ v ∈ B) ∧ (∀ w : G, (v, w) ∈ E G → v ∈ A → w ∈ B) ∧ (∀ w : G, (v, w) ∈ E G → v ∈ B → w ∈ A), from by auto [h1],
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ v w : G, v ∈ A ∧ w ∈ A → (v, w) ∉ E G, from by auto [h2],
  have h4 : ∀ v w : G, v ∈ B ∧ w ∈ B → (v, w) ∉ E G, from by auto [h2],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : ∀ v w : G, (v, w) ∈ E G → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A), from by auto [h2, h3, h4],
  show two_colorable G ↔ bipartite G, from by auto [two_colorable, bipartite, h2, h5],
end

--OUTPUT 3
theorem bipartite_graph_is_two_colorable {G : Type*} [graph G] : is_bipartite G ↔ is_two_colorable G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : is_two_colorable G,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set (vertex G), is_red_set A ∧ is_blue_set B, from by auto using [h1],
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ a b : vertex G, a ∈ A ∧ b ∈ A → ¬ edge a b, from by auto using [h2],
  have h4 : ∀ a b : vertex G, a ∈ B ∧ b ∈ B → ¬ edge a b, from by auto using [h2],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : is_bipartite G, from by auto using [h2, h3, h4],
  show is_bipartite G ↔ is_two_colorable G, from by auto using [h1, h5],
end

--OUTPUT 4
theorem bipartite_graph_two_colorable (G : Type*) [graph G] : ∃ A B : set G, ∀ a b : G, a ∈ A ∧ b ∈ B → (a, b) ∈ G.edges :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : ∃ (f : G → bool), ∀ a b : G, f a = tt ∧ f b = tt → (a, b) ∉ G.edges, from by auto [two_colorable],
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A : set G, ∀ a : G, a ∈ A ↔ f a = tt, from by auto [set_of_function],
  have h3 : ∃ B : set G, ∀ b : G, b ∈ B ↔ f b = ff, from by auto [set_of_function],
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h4 : ∀ a b : G, a ∈ A ∧ b ∈ A → (a, b) ∉ G.edges, from by auto [h1, h2],
  have h5 : ∀ a b : G, a ∈ B ∧ b ∈ B → (a, b) ∉ G.edges, from by auto [h1, h3],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  show ∃ A B : set G, ∀ a b : G, a ∈ A ∧ b ∈ B → (a, b) ∈ G.edges, from by auto using [h2, h3, h4, h5]
end

--OUTPUT 5
theorem two_colorable_bipartite {G : Type*} [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : two_colorable G,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  let A : set G := {x | color x = red},
  let B : set G := {x | color x = blue},
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h2 : ∀ x y : G, x ∈ A ∧ y ∈ A → x ≠ y → ¬ edge x y, from by auto [h1],
  have h3 : ∀ x y : G, x ∈ B ∧ y ∈ B → x ≠ y → ¬ edge x y, from by auto [h1],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h4 : ∀ x y : G, edge x y → (x ∈ A ∧ y ∈ B) ∨ (x ∈ B ∧ y ∈ A), from by auto [h1],
  have h5 : bipartite G, from by auto [h4],
  show two_colorable G ↔ bipartite G, from by auto [h5],

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  assume h6 : bipartite G,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h7 : two_colorable G, from by auto [h6],
  show two_colorable G ↔ bipartite G, from by auto [h7],
end

--OUTPUT 6
theorem bipartite_graph_two_colorable {G : Type*} [graph G] : (∃ A B : set G, ∀ a : G, (a ∈ A) ∨ (a ∈ B)) ↔ (∀ a b : G, a ∈ A ∧ b ∈ B → ¬ (a -- b)) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : ∀ A B : set G, ∀ a : G, a ∈ A ∨ a ∈ B → (∀ b : G, b ∈ A → ¬ (a -- b)) ∧ (∀ b : G, b ∈ B → ¬ (a -- b)), from by auto using [graph.no_edge_same_color],

  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∀ A B : set G, ∀ a : G, a ∈ A ∨ a ∈ B → ∀ b : G, b ∈ A ∧ b ∈ B → ¬ (a -- b), from by auto [h1],

  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ A B : set G, ∀ a : G, a ∈ A ∨ a ∈ B → ∀ b : G, b ∈ A ∧ b ∈ B → ¬ (a -- b), from by auto [h2],

  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h4 : ∀ A B : set G, ∀ a : G, a ∈ A ∨ a ∈ B → ∀ b : G, b ∈ A ∧ b ∈ B → ¬ (a -- b), from by auto [h3],

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  have h5 : ∀ A B : set G, ∀ a : G, a ∈ A ∨ a ∈ B → ∀ b : G, b ∈ A ∧ b ∈ B → ¬ (a -- b), from by auto [h4],

  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h6 : ∀ A B : set G, ∀ a : G, a ∈ A ∨ a ∈ B → ∀ b : G, b ∈ A ∧ b ∈ B → ¬ (a -- b), from by auto [h5],

  -- QED
  show (∃ A B : set G, ∀ a : G, (a ∈ A) ∨ (a ∈ B)) ↔ (∀ a b : G, a ∈ A ∧ b ∈ B → ¬ (a -- b)), from by auto [h6],
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`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

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


/-
Copyright (c) 2021 Christopher Hoskin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Christopher Hoskin
-/
import algebra.group_power.basic -- Needed for squares
import algebra.order.group
import tactic.nth_rewrite

/-!
# Lattice ordered groups

Lattice ordered groups were introduced by [Birkhoff][birkhoff1942].
They form the algebraic underpinnings of vector lattices, Banach lattices, AL-space, AM-space etc.

This file develops the basic theory, concentrating on the commutative case.

## Main statements

- `pos_div_neg`: Every element `a` of a lattice ordered commutative group has a decomposition
  `a⁺-a⁻` into the difference of the positive and negative component.
- `pos_inf_neg_eq_one`: The positive and negative components are coprime.
- `abs_triangle`: The absolute value operation satisfies the triangle inequality.

It is shown that the inf and sup operations are related to the absolute value operation by a
number of equations and inequalities.

## Notations

- `a⁺ = a ⊔ 0`: The *positive component* of an element `a` of a lattice ordered commutative group
- `a⁻ = (-a) ⊔ 0`: The *negative component* of an element `a` of a lattice ordered commutative group
* `|a| = a⊔(-a)`: The *absolute value* of an element `a` of a lattice ordered commutative group

## Implementation notes

A lattice ordered commutative group is a type `α` satisfying:

* `[lattice α]`
* `[comm_group α]`
* `[covariant_class α α (*) (≤)]`

The remainder of the file establishes basic properties of lattice ordered commutative groups. A
number of these results also hold in the non-commutative case ([Birkhoff][birkhoff1942],
[Fuchs][fuchs1963]) but we have not developed that here, since we are primarily interested in vector
lattices.

## References

* [Birkhoff, Lattice-ordered Groups][birkhoff1942]
* [Bourbaki, Algebra II][bourbaki1981]
* [Fuchs, Partially Ordered Algebraic Systems][fuchs1963]
* [Zaanen, Lectures on "Riesz Spaces"][zaanen1966]
* [Banasiak, Banach Lattices in Applications][banasiak]

## Tags

lattice, ordered, group
-/

universe u

-- A linearly ordered additive commutative group is a lattice ordered commutative group
@[priority 100, to_additive] -- see Note [lower instance priority]
instance linear_ordered_comm_group.to_covariant_class (α : Type u)
  [linear_ordered_comm_group α] : covariant_class α α (*) (≤) :=
{ elim := λ a b c bc, linear_ordered_comm_group.mul_le_mul_left _ _ bc a }

variables {α : Type u} [lattice α] [comm_group α]

-- Special case of Bourbaki A.VI.9 (1)
-- c + (a ⊔ b) = (c + a) ⊔ (c + b)
@[to_additive]
lemma mul_sup [covariant_class α α (*) (≤)] (a b c : α) : c * (a ⊔ b) = (c * a) ⊔ (c * b) :=
begin
  refine le_antisymm _ (by simp),
  rw [← mul_le_mul_iff_left (c⁻¹), ← mul_assoc, inv_mul_self, one_mul],
  exact sup_le (by simp) (by simp),
end

@[to_additive]
lemma mul_inf [covariant_class α α (*) (≤)] (a b c : α) : c * (a ⊓ b) = (c * a) ⊓ (c * b) :=
begin
  refine le_antisymm (by simp) _,
  rw [← mul_le_mul_iff_left (c⁻¹), ← mul_assoc, inv_mul_self, one_mul],
  exact le_inf (by simp) (by simp),
end

-- Special case of Bourbaki A.VI.9 (2)
-- -(a ⊔ b)=(-a) ⊓ (-b)
@[to_additive]
lemma inv_sup_eq_inv_inf_inv [covariant_class α α (*) (≤)] (a b : α) : (a ⊔ b)⁻¹ = a⁻¹ ⊓ b⁻¹ :=
begin
  apply le_antisymm,
  { refine le_inf _ _,
    { rw inv_le_inv_iff, exact le_sup_left, },
    { rw inv_le_inv_iff, exact le_sup_right, } },
  { rw [← inv_le_inv_iff, inv_inv],
    refine sup_le _ _,
    { rw ← inv_le_inv_iff, simp, },
    { rw ← inv_le_inv_iff, simp, } }
end

-- -(a ⊓ b) = -a ⊔ -b
@[to_additive]
lemma inv_inf_eq_sup_inv [covariant_class α α (*) (≤)] (a b : α) : (a ⊓ b)⁻¹ = a⁻¹ ⊔ b⁻¹ :=
by rw [← inv_inv (a⁻¹ ⊔ b⁻¹), inv_sup_eq_inv_inf_inv a⁻¹ b⁻¹, inv_inv, inv_inv]

-- Bourbaki A.VI.10 Prop 7
-- a ⊓ b + (a ⊔ b) = a + b
@[to_additive]
lemma inf_mul_sup [covariant_class α α (*) (≤)] (a b : α) : a ⊓ b * (a ⊔ b) = a * b :=
calc a ⊓ b * (a ⊔ b) = a ⊓ b * ((a * b) * (b⁻¹ ⊔ a⁻¹)) :
  by { rw mul_sup b⁻¹ a⁻¹ (a * b), simp, }
... = a ⊓ b * ((a * b) * (a ⊓ b)⁻¹) : by rw [inv_inf_eq_sup_inv, sup_comm]
... = a * b                       : by rw [mul_comm, inv_mul_cancel_right]

namespace lattice_ordered_comm_group

/--
Let `α` be a lattice ordered commutative group with identity `1`. For an element `a` of type `α`,
the element `a ⊔ 1` is said to be the *positive component* of `a`, denoted `a⁺`.
-/
@[to_additive /-"
Let `α` be a lattice ordered commutative group with identity `0`. For an element `a` of type `α`,
the element `a ⊔ 0` is said to be the *positive component* of `a`, denoted `a⁺`.
"-/,
priority 100] -- see Note [lower instance priority]
instance has_one_lattice_has_pos_part : has_pos_part (α) := ⟨λ a, a ⊔ 1⟩

@[to_additive pos_part_def]
lemma m_pos_part_def (a : α) : a⁺ = a ⊔ 1 := rfl

/--
Let `α` be a lattice ordered commutative group with identity `1`. For an element `a` of type `α`,
the element `(-a) ⊔ 1` is said to be the *negative component* of `a`, denoted `a⁻`.
-/
@[to_additive /-"
Let `α` be a lattice ordered commutative group with identity `0`. For an element `a` of type `α`,
the element `(-a) ⊔ 0` is said to be the *negative component* of `a`, denoted `a⁻`.
"-/,
priority 100] -- see Note [lower instance priority]
instance has_one_lattice_has_neg_part : has_neg_part (α) := ⟨λ a, a⁻¹ ⊔ 1⟩

@[to_additive neg_part_def]
lemma m_neg_part_def (a : α) : a⁻ = a⁻¹ ⊔ 1 := rfl

@[to_additive, simp]
lemma pos_one : (1 : α)⁺ = 1 := sup_idem

@[to_additive, simp]
lemma neg_one : (1 : α)⁻ = 1 := by rw [m_neg_part_def, one_inv, sup_idem]

-- a⁻ = -(a ⊓ 0)
@[to_additive]
lemma neg_eq_inv_inf_one [covariant_class α α (*) (≤)] (a : α) : a⁻ = (a ⊓ 1)⁻¹ :=
by rw [m_neg_part_def, ← inv_inj, inv_sup_eq_inv_inf_inv, inv_inv, inv_inv, one_inv]

@[to_additive le_abs]
lemma le_mabs (a : α) : a ≤ |a| := le_sup_left

@[to_additive]
-- -a ≤ |a|
lemma inv_le_abs (a : α) : a⁻¹ ≤ |a| := le_sup_right

-- 0 ≤ a⁺
@[to_additive pos_nonneg]
lemma one_le_pos (a : α) : 1 ≤ a⁺ := le_sup_right

-- 0 ≤ a⁻
@[to_additive neg_nonneg]
lemma one_le_neg (a : α) : 1 ≤ a⁻ := le_sup_right

@[to_additive] -- pos_nonpos_iff
lemma pos_le_one_iff {a : α} : a⁺ ≤ 1 ↔ a ≤ 1 :=
by { rw [m_pos_part_def, sup_le_iff], simp, }

@[to_additive] -- neg_nonpos_iff
lemma neg_le_one_iff {a : α} : a⁻ ≤ 1 ↔ a⁻¹ ≤ 1 :=
by { rw [m_neg_part_def, sup_le_iff], simp, }

@[to_additive]
lemma pos_eq_one_iff {a : α} : a⁺ = 1 ↔ a ≤ 1 :=
by { rw le_antisymm_iff, simp only [one_le_pos, and_true], exact pos_le_one_iff, }

@[to_additive]
lemma neg_eq_one_iff' {a : α} : a⁻ = 1 ↔ a⁻¹ ≤ 1 :=
by { rw le_antisymm_iff, simp only [one_le_neg, and_true], rw neg_le_one_iff, }

@[to_additive]
lemma neg_eq_one_iff [covariant_class α α has_mul.mul has_le.le] {a : α} : a⁻ = 1 ↔ 1 ≤ a :=
by { rw le_antisymm_iff, simp only [one_le_neg, and_true], rw [neg_le_one_iff, inv_le_one'], }

@[to_additive le_pos]
lemma m_le_pos (a : α) : a ≤ a⁺ := le_sup_left

-- -a ≤ a⁻
@[to_additive]
lemma inv_le_neg (a : α) : a⁻¹ ≤ a⁻ := le_sup_left

-- Bourbaki A.VI.12
--  a⁻ = (-a)⁺
@[to_additive]
lemma neg_eq_pos_inv (a : α) : a⁻ = (a⁻¹)⁺ := rfl

-- a⁺ = (-a)⁻
@[to_additive]
lemma pos_eq_neg_inv (a : α) : a⁺ = (a⁻¹)⁻ := by simp [neg_eq_pos_inv]

-- We use this in Bourbaki A.VI.12  Prop 9 a)
-- c + (a ⊓ b) = (c + a) ⊓ (c + b)
@[to_additive]
lemma mul_inf_eq_mul_inf_mul [covariant_class α α (*) (≤)]
  (a b c : α) : c * (a ⊓ b) = (c * a) ⊓ (c * b) :=
begin
  refine le_antisymm (by simp) _,
  rw [← mul_le_mul_iff_left c⁻¹, ← mul_assoc, inv_mul_self, one_mul, le_inf_iff],
  simp,
end

-- Bourbaki A.VI.12  Prop 9 a)
-- a = a⁺ - a⁻
@[to_additive, simp]
lemma pos_div_neg [covariant_class α α (*) (≤)] (a : α) : a⁺ / a⁻ = a :=
begin
  symmetry,
  rw div_eq_mul_inv,
  apply eq_mul_inv_of_mul_eq,
  rw [m_neg_part_def, mul_sup, mul_one, mul_right_inv, sup_comm, m_pos_part_def],
end

-- Bourbaki A.VI.12  Prop 9 a)
-- a⁺ ⊓ a⁻ = 0 (`a⁺` and `a⁻` are co-prime, and, since they are positive, disjoint)
@[to_additive]
lemma pos_inf_neg_eq_one [covariant_class α α (*) (≤)] (a : α) : a⁺ ⊓ a⁻ = 1 :=
by rw [←mul_right_inj (a⁻)⁻¹, mul_inf_eq_mul_inf_mul, mul_one, mul_left_inv, mul_comm,
  ← div_eq_mul_inv, pos_div_neg, neg_eq_inv_inf_one, inv_inv]

-- Bourbaki A.VI.12 (with a and b swapped)
-- a⊔b = b + (a - b)⁺
@[to_additive]
lemma sup_eq_mul_pos_div [covariant_class α α (*) (≤)] (a b : α) : a ⊔ b = b * (a / b)⁺ :=
calc a ⊔ b = (b * (a / b)) ⊔ (b * 1) : by rw [mul_one b, div_eq_mul_inv, mul_comm a,
  mul_inv_cancel_left]
... = b * ((a / b) ⊔ 1) : by rw ← mul_sup (a / b) 1 b

-- Bourbaki A.VI.12 (with a and b swapped)
-- a⊓b = a - (a - b)⁺
@[to_additive]
lemma inf_eq_div_pos_div [covariant_class α α (*) (≤)] (a b : α) : a ⊓ b = a / (a / b)⁺ :=
calc a ⊓ b = (a * 1) ⊓ (a * (b / a)) : by { rw [mul_one a, div_eq_mul_inv, mul_comm b,
  mul_inv_cancel_left], }
... = a * (1 ⊓ (b / a))     : by rw ← mul_inf_eq_mul_inf_mul 1 (b / a) a
... = a * ((b / a) ⊓ 1)     : by rw inf_comm
... = a * ((a / b)⁻¹ ⊓ 1)   : by { rw div_eq_mul_inv, nth_rewrite 0 ← inv_inv b,
  rw [← mul_inv, mul_comm b⁻¹, ← div_eq_mul_inv], }
... = a * ((a / b)⁻¹ ⊓ 1⁻¹) : by rw one_inv
... = a / ((a / b) ⊔ 1)     : by rw [← inv_sup_eq_inv_inf_inv, ← div_eq_mul_inv]

-- Bourbaki A.VI.12 Prop 9 c)
@[to_additive le_iff_pos_le_neg_ge]
lemma m_le_iff_pos_le_neg_ge [covariant_class α α (*) (≤)] (a b : α) : a ≤ b ↔ a⁺ ≤ b⁺ ∧ b⁻ ≤ a⁻ :=
begin
  split; intro h,
  { split,
    { exact sup_le (h.trans (m_le_pos b)) (one_le_pos b), },
    { rw ← inv_le_inv_iff at h,
      exact sup_le (h.trans (inv_le_neg a)) (one_le_neg a), } },
  { rw [← pos_div_neg a, ← pos_div_neg b],
    exact div_le_div'' h.1 h.2, }
end

@[to_additive neg_abs]
lemma m_neg_abs [covariant_class α α (*) (≤)] (a : α) : |a|⁻ = 1 :=
begin
  refine le_antisymm _ _,
  { rw ← pos_inf_neg_eq_one a,
    apply le_inf,
    { rw pos_eq_neg_inv,
      exact ((m_le_iff_pos_le_neg_ge _ _).mp (inv_le_abs a)).right, },
    { exact and.right (iff.elim_left (m_le_iff_pos_le_neg_ge _ _) (le_mabs a)), } },
  { exact one_le_neg _, }
end

@[to_additive pos_abs]
lemma m_pos_abs [covariant_class α α (*) (≤)] (a : α) : |a|⁺ = |a| :=
begin
  nth_rewrite 1 ← pos_div_neg (|a|),
  rw div_eq_mul_inv,
  symmetry,
  rw [mul_right_eq_self, inv_eq_one],
  exact m_neg_abs a,
end

@[to_additive abs_nonneg]
lemma one_le_abs [covariant_class α α (*) (≤)] (a : α) : 1 ≤ |a| :=
by { rw ← m_pos_abs, exact one_le_pos _, }

-- The proof from Bourbaki A.VI.12 Prop 9 d)
-- |a| = a⁺ - a⁻
@[to_additive]
lemma pos_mul_neg [covariant_class α α (*) (≤)] (a : α) : |a| = a⁺ * a⁻ :=
begin
  refine le_antisymm _ _,
  { refine sup_le _ _,
    { nth_rewrite 0 ← mul_one a,
      exact mul_le_mul' (m_le_pos a) (one_le_neg a) },
    { nth_rewrite 0 ← one_mul (a⁻¹),
      exact mul_le_mul' (one_le_pos a) (inv_le_neg a) } },
  { rw [← inf_mul_sup, pos_inf_neg_eq_one, one_mul, ← m_pos_abs a],
    apply sup_le,
    { exact ((m_le_iff_pos_le_neg_ge _ _).mp (le_mabs a)).left, },
    { rw neg_eq_pos_inv,
      exact ((m_le_iff_pos_le_neg_ge _ _).mp (inv_le_abs a)).left, }, }
end

-- a ⊔ b - (a ⊓ b) = |b - a|
@[to_additive]
lemma sup_div_inf_eq_abs_div [covariant_class α α (*) (≤)] (a b : α) :
  (a ⊔ b) / (a ⊓ b) = |b / a| :=
begin
  rw [sup_eq_mul_pos_div, inf_comm, inf_eq_div_pos_div, div_eq_mul_inv],
  nth_rewrite 1 div_eq_mul_inv,
  rw [mul_inv_rev, inv_inv, mul_comm, ← mul_assoc, inv_mul_cancel_right, pos_eq_neg_inv (a / b)],
  nth_rewrite 1 div_eq_mul_inv,
  rw [mul_inv_rev, ← div_eq_mul_inv, inv_inv, ← pos_mul_neg],
end

-- 2•(a ⊔ b) = a + b + |b - a|
@[to_additive two_sup_eq_add_add_abs_sub]
lemma sup_sq_eq_mul_mul_abs_div [covariant_class α α (*) (≤)] (a b : α) :
  (a ⊔ b)^2 = a * b * |b / a| :=
by rw [← inf_mul_sup a b, ← sup_div_inf_eq_abs_div, div_eq_mul_inv, ← mul_assoc, mul_comm,
    mul_assoc, ← pow_two, inv_mul_cancel_left]

-- 2•(a ⊓ b) = a + b - |b - a|
@[to_additive two_inf_eq_add_sub_abs_sub]
lemma inf_sq_eq_mul_div_abs_div [covariant_class α α (*) (≤)] (a b : α) :
  (a ⊓ b)^2 = a * b / |b / a| :=
by rw [← inf_mul_sup a b, ← sup_div_inf_eq_abs_div, div_eq_mul_inv, div_eq_mul_inv,
    mul_inv_rev, inv_inv, mul_assoc, mul_inv_cancel_comm_assoc, ← pow_two]

/--
Every lattice ordered commutative group is a distributive lattice
-/
@[to_additive
  "Every lattice ordered commutative additive group is a distributive lattice"
]
def lattice_ordered_comm_group_to_distrib_lattice (α : Type u)
  [s: lattice α] [comm_group α] [covariant_class α α (*) (≤)] : distrib_lattice α :=
{ le_sup_inf :=
  begin
    intros,
    rw [← mul_le_mul_iff_left (x ⊓ (y ⊓ z)), inf_mul_sup x (y ⊓ z),
      ← inv_mul_le_iff_le_mul, le_inf_iff],
    split,
    { rw [inv_mul_le_iff_le_mul, ← inf_mul_sup x y],
      apply mul_le_mul',
      { apply inf_le_inf_left, apply inf_le_left, },
      { apply inf_le_left, } },
    { rw [inv_mul_le_iff_le_mul, ← inf_mul_sup x z],
      apply mul_le_mul',
      { apply inf_le_inf_left, apply inf_le_right, },
      { apply inf_le_right, }, }
  end,
  ..s }

-- See, e.g. Zaanen, Lectures on Riesz Spaces
-- 3rd lecture
-- |a ⊔ c - (b ⊔ c)| + |a ⊓ c-b ⊓ c| = |a - b|
@[to_additive]
theorem abs_div_sup_mul_abs_div_inf [covariant_class α α (*) (≤)] (a b c : α) :
  |(a ⊔ c) / (b ⊔ c)| * |(a ⊓ c) / (b ⊓ c)| = |a / b| :=
begin
  letI : distrib_lattice α := lattice_ordered_comm_group_to_distrib_lattice α,
  calc |(a ⊔ c) / (b ⊔ c)| * |a ⊓ c / (b ⊓ c)| =
    ((b ⊔ c ⊔ (a ⊔ c)) / ((b ⊔ c) ⊓ (a ⊔ c))) * |a ⊓ c / (b ⊓ c)| : by rw sup_div_inf_eq_abs_div
  ... = (b ⊔ c ⊔ (a ⊔ c)) / ((b ⊔ c) ⊓ (a ⊔ c)) * (((b ⊓ c) ⊔ (a ⊓ c)) / ((b ⊓ c) ⊓ (a ⊓ c))) :
    by rw sup_div_inf_eq_abs_div (b ⊓ c) (a ⊓ c)
  ... = (b ⊔ a ⊔ c) / ((b ⊓ a) ⊔ c) * (((b ⊔ a) ⊓ c) / (b ⊓ a ⊓ c)) : by
  { rw [← sup_inf_right, ← inf_sup_right, sup_assoc],
    nth_rewrite 1 sup_comm,
    rw [sup_right_idem, sup_assoc, inf_assoc],
    nth_rewrite 3 inf_comm,
    rw [inf_right_idem, inf_assoc], }
  ... = (b ⊔ a ⊔ c) * ((b ⊔ a) ⊓ c) /(((b ⊓ a) ⊔ c) * (b ⊓ a ⊓ c)) : by rw div_mul_comm
  ... = (b ⊔ a) * c / (b ⊓ a * c) :
    by rw [mul_comm, inf_mul_sup, mul_comm (b ⊓ a ⊔ c), inf_mul_sup]
  ... = (b ⊔ a) / (b ⊓ a) : by rw [div_eq_mul_inv, mul_inv_rev, mul_assoc, mul_inv_cancel_left,
      ← div_eq_mul_inv]
  ... = |a / b|           : by rw sup_div_inf_eq_abs_div
end

/--
Let `α` be a lattice ordered commutative group and let `a` be a positive element in `α`. Then `a` is
equal to its positive component `a⁺`.
-/
@[to_additive] -- pos_of_nonneg
lemma pos_of_one_le (a : α) (h : 1 ≤ a) : a⁺ = a :=
by { rw m_pos_part_def, exact sup_of_le_left h, }

-- 0 ≤ a implies a⁺ = a
@[to_additive] -- pos_of_nonpos
lemma pos_of_le_one (a : α) (h : a ≤ 1) : a⁺ = 1 :=
pos_eq_one_iff.mpr h

@[to_additive neg_of_inv_nonneg]
lemma neg_of_one_le_inv (a : α) (h : 1 ≤ a⁻¹) : a⁻ = a⁻¹ :=
by { rw neg_eq_pos_inv, exact pos_of_one_le _ h, }

@[to_additive] -- neg_of_neg_nonpos
lemma neg_of_inv_le_one (a : α) (h : a⁻¹ ≤ 1) : a⁻ = 1 :=
neg_eq_one_iff'.mpr h

@[to_additive] -- neg_of_nonpos
lemma neg_of_le_one [covariant_class α α (*) (≤)] (a : α) (h : a ≤ 1) : a⁻ = a⁻¹ :=
by { refine neg_of_one_le_inv _ _, rw one_le_inv', exact h, }

@[to_additive] -- neg_of_nonneg'
lemma neg_of_one_le [covariant_class α α (*) (≤)] (a : α) (h : 1 ≤ a) : a⁻ = 1 :=
neg_eq_one_iff.mpr h

-- 0 ≤ a implies |a| = a
@[to_additive abs_of_nonneg]
lemma mabs_of_one_le [covariant_class α α (*) (≤)] (a : α) (h : 1 ≤ a) : |a| = a :=
begin
  unfold has_abs.abs,
  rw [sup_eq_mul_pos_div, div_eq_mul_inv, inv_inv, ← pow_two, inv_mul_eq_iff_eq_mul,
    ← pow_two, pos_of_one_le],
  rw pow_two,
  apply one_le_mul h h,
end

/--
The unary operation of taking the absolute value is idempotent.
-/
@[to_additive abs_abs, simp]
lemma m_abs_abs [covariant_class α α (*) (≤)] (a : α) : | |a| | = |a| :=
mabs_of_one_le _ (one_le_abs _)

@[to_additive abs_sup_sub_sup_le_abs]
lemma mabs_sup_div_sup_le_mabs [covariant_class α α (*) (≤)] (a b c : α) :
  |(a ⊔ c) / (b ⊔ c)| ≤ |a / b| :=
begin
  apply le_of_mul_le_of_one_le_left,
  { rw abs_div_sup_mul_abs_div_inf, },
  { exact one_le_abs _, },
end

@[to_additive abs_inf_sub_inf_le_abs]
lemma mabs_inf_div_inf_le_mabs [covariant_class α α (*) (≤)] (a b c : α) :
  |(a ⊓ c) / (b ⊓ c)| ≤ |a / b| :=
begin
  apply le_of_mul_le_of_one_le_right,
  { rw abs_div_sup_mul_abs_div_inf, },
  { exact one_le_abs _, },
end

-- Commutative case, Zaanen, 3rd lecture
-- For the non-commutative case, see Birkhoff Theorem 19 (27)
-- |(a ⊔ c) - (b ⊔ c)| ⊔ |(a ⊓ c) - (b ⊓ c)| ≤ |a - b|
@[to_additive Birkhoff_inequalities]
theorem m_Birkhoff_inequalities [covariant_class α α (*) (≤)] (a b c : α) :
|(a ⊔ c) / (b ⊔ c)| ⊔ |(a ⊓ c) / (b ⊓ c)| ≤ |a / b| :=
sup_le (mabs_sup_div_sup_le_mabs a b c) (mabs_inf_div_inf_le_mabs a b c)

-- Banasiak Proposition 2.12, Zaanen 2nd lecture
/--
The absolute value satisfies the triangle inequality.
-/
@[to_additive abs_add_le]
lemma mabs_mul_le [covariant_class α α (*) (≤)] (a b : α) : |a * b| ≤ |a| * |b| :=
begin
  apply sup_le,
  { exact mul_le_mul' (le_mabs a) (le_mabs b), },
  { rw mul_inv,
    exact mul_le_mul' (inv_le_abs _) (inv_le_abs _), }
end

-- |a - b| = |b - a|
@[to_additive]
lemma abs_inv_comm (a b : α) : |a/b| = |b/a| :=
begin
  unfold has_abs.abs,
  rw [inv_div' a b, ← inv_inv (a / b), inv_div', sup_comm],
end

-- | |a| - |b| | ≤ |a - b|
@[to_additive]
lemma abs_abs_div_abs_le [covariant_class α α (*) (≤)] (a b : α) : | |a| / |b| | ≤ |a / b| :=
begin
  unfold has_abs.abs,
  rw sup_le_iff,
  split,
  { apply div_le_iff_le_mul.2,
    convert mabs_mul_le (a/b) b,
    { rw div_mul_cancel', },
    { rw div_mul_cancel', },
    { exact covariant_swap_mul_le_of_covariant_mul_le α, } },
  { rw [div_eq_mul_inv, mul_inv_rev, inv_inv, mul_inv_le_iff_le_mul, ← abs_eq_sup_inv (a / b),
      abs_inv_comm],
    convert  mabs_mul_le (b/a) a,
    { rw div_mul_cancel', },
    {rw div_mul_cancel', } },
end

end lattice_ordered_comm_group


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl, Reid Barton
-/
import category_theory.adjunction.basic
import order.galois_connection

/-!

# Preorders as categories

We install a category instance on any preorder. This is not to be confused with the category _of_
preorders, defined in `order/category/Preorder`.

We show that monotone functions between preorders correspond to functors of the associated
categories. Furthermore, galois connections correspond to adjoint functors.

## Main definitions

* `hom_of_le` and `le_of_hom` provide translations between inequalities in the preorder, and
  morphisms in the associated category.
* `monotone.functor` is the functor associated to a monotone function.
* `galois_connection.adjunction` is the adjunction associated to a galois connection.
* `Preorder_to_Cat` is the functor embedding the category of preorders into `Cat`.

-/

universes u v

namespace preorder

open category_theory

/--
The category structure coming from a preorder. There is a morphism `X ⟶ Y` if and only if `X ≤ Y`.

Because we don't allow morphisms to live in `Prop`,
we have to define `X ⟶ Y` as `ulift (plift (X ≤ Y))`.
See `category_theory.hom_of_le` and `category_theory.le_of_hom`.

See <https://stacks.math.columbia.edu/tag/00D3>.
-/
@[priority 100] -- see Note [lower instance priority]
instance small_category (α : Type u) [preorder α] : small_category α :=
{ hom  := λ U V, ulift (plift (U ≤ V)),
  id   := λ X, ⟨ ⟨ le_refl X ⟩ ⟩,
  comp := λ X Y Z f g, ⟨ ⟨ le_trans _ _ _ f.down.down g.down.down ⟩ ⟩ }

end preorder

namespace category_theory

open opposite

variables {X : Type u} [preorder X]

/--
Express an inequality as a morphism in the corresponding preorder category.
-/
def hom_of_le {x y : X} (h : x ≤ y) : x ⟶ y := ulift.up (plift.up h)

alias hom_of_le ← has_le.le.hom

@[simp] lemma hom_of_le_refl {x : X} : (le_refl x).hom = 𝟙 x := rfl
@[simp] lemma hom_of_le_comp {x y z : X} (h : x ≤ y) (k : y ≤ z) :
  h.hom ≫ k.hom = (h.trans k).hom := rfl

/--
Extract the underlying inequality from a morphism in a preorder category.
-/
lemma le_of_hom {x y : X} (h : x ⟶ y) : x ≤ y := h.down.down

alias le_of_hom ← quiver.hom.le

@[simp] lemma le_of_hom_hom_of_le {x y : X} (h : x ≤ y) : h.hom.le = h := rfl
@[simp] lemma hom_of_le_le_of_hom {x y : X} (h : x ⟶ y) : h.le.hom = h :=
by { cases h, cases h, refl, }

/-- Construct a morphism in the opposite of a preorder category from an inequality. -/
def op_hom_of_le {x y : Xᵒᵖ} (h : unop x ≤ unop y) : y ⟶ x := h.hom.op

lemma le_of_op_hom {x y : Xᵒᵖ} (h : x ⟶ y) : unop y ≤ unop x := h.unop.le

instance unique_to_top [order_top X] {x : X} : unique (x ⟶ ⊤) := by tidy
instance unique_from_bot [order_bot X] {x : X} : unique (⊥ ⟶ x) := by tidy

end category_theory

section

variables {X : Type u} {Y : Type v} [preorder X] [preorder Y]

/--
A monotone function between preorders induces a functor between the associated categories.
-/
def monotone.functor {f : X → Y} (h : monotone f) : X ⥤ Y :=
{ obj := f,
  map := λ x₁ x₂ g, (h g.le).hom }

@[simp] lemma monotone.functor_obj {f : X → Y} (h : monotone f) : h.functor.obj = f := rfl

/--
A galois connection between preorders induces an adjunction between the associated categories.
-/
def galois_connection.adjunction {l : X → Y} {u : Y → X} (gc : galois_connection l u) :
  gc.monotone_l.functor ⊣ gc.monotone_u.functor :=
category_theory.adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y, ⟨λ f, (gc.le_u f.le).hom, λ f, (gc.l_le f.le).hom, by tidy, by tidy⟩ }

end

namespace category_theory

section preorder

variables {X : Type u} {Y : Type v} [preorder X] [preorder Y]

/--
A functor between preorder categories is monotone.
-/
@[mono] lemma functor.monotone (f : X ⥤ Y) : monotone f.obj :=
λ x y hxy, (f.map hxy.hom).le

/--
An adjunction between preorder categories induces a galois connection.
-/
lemma adjunction.gc {L : X ⥤ Y} {R : Y ⥤ X} (adj : L ⊣ R) :
  galois_connection L.obj R.obj :=
λ x y, ⟨λ h, ((adj.hom_equiv x y).to_fun h.hom).le, λ h, ((adj.hom_equiv x y).inv_fun h.hom).le⟩

end preorder

section partial_order

variables {X : Type u} {Y : Type v} [partial_order X] [partial_order Y]

lemma iso.to_eq {x y : X} (f : x ≅ y) : x = y := le_antisymm f.hom.le f.inv.le

/--
A categorical equivalence between partial orders is just an order isomorphism.
-/
def equivalence.to_order_iso (e : X ≌ Y) : X ≃o Y :=
{ to_fun := e.functor.obj,
  inv_fun := e.inverse.obj,
  left_inv := λ a, (e.unit_iso.app a).to_eq.symm,
  right_inv := λ b, (e.counit_iso.app b).to_eq,
  map_rel_iff' := λ a a',
    ⟨λ h, ((equivalence.unit e).app a ≫ e.inverse.map h.hom ≫ (equivalence.unit_inv e).app a').le,
     λ (h : a ≤ a'), (e.functor.map h.hom).le⟩, }

-- `@[simps]` on `equivalence.to_order_iso` produces lemmas that fail the `simp_nf` linter,
-- so we provide them by hand:
@[simp]

@[simp]
lemma equivalence.to_order_iso_symm_apply (e : X ≌ Y) (y : Y) :
  e.to_order_iso.symm y = e.inverse.obj y := rfl

end partial_order

end category_theory


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

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

/-!
# `zmod n` and quotient groups / rings

This file relates `zmod n` to the quotient group
`quotient_add_group.quotient (add_subgroup.zmultiples n)` and to the quotient ring
`(ideal.span {n}).quotient`.

## Main definitions

 - `zmod.quotient_zmultiples_nat_equiv_zmod` and `zmod.quotient_zmultiples_equiv_zmod`:
   `zmod n` is the group quotient of `ℤ` by `n ℤ := add_subgroup.zmultiples (n)`,
   (where `n : ℕ` and `n : ℤ` respectively)
 - `zmod.quotient_span_nat_equiv_zmod` and `zmod.quotient_span_equiv_zmod`:
   `zmod n` is the ring quotient of `ℤ` by `n ℤ : ideal.span {n}`
   (where `n : ℕ` and `n : ℤ` respectively)
 - `zmod.lift n f` is the map from `zmod n` induced by `f : ℤ →+ A` that maps `n` to `0`.

## Tags

zmod, quotient group, quotient ring, ideal quotient
-/

open quotientAddGroup

open ZMod

variable (n : ℕ) {A R : Type _} [AddGroup A] [Ring R]

namespace Int

/-- `ℤ` modulo multiples of `n : ℕ` is `zmod n`. -/
def quotientZmultiplesNatEquivZmod : ℤ ⧸ AddSubgroup.zmultiples (n : ℤ) ≃+ ZMod n :=
  (quotientAddEquivOfEq (ZMod.ker_int_castAddHom _)).symm.trans <|
    quotientKerEquivOfRightInverse (Int.castAddHom (ZMod n)) coe int_cast_zmod_cast
#align int.quotient_zmultiples_nat_equiv_zmod Int.quotientZmultiplesNatEquivZmod

/-- `ℤ` modulo multiples of `a : ℤ` is `zmod a.nat_abs`. -/
def quotientZmultiplesEquivZmod (a : ℤ) : ℤ ⧸ AddSubgroup.zmultiples a ≃+ ZMod a.natAbs :=
  (quotientAddEquivOfEq (zmultiples_natAbs a)).symm.trans (quotientZmultiplesNatEquivZmod a.natAbs)
#align int.quotient_zmultiples_equiv_zmod Int.quotientZmultiplesEquivZmod

/-- `ℤ` modulo the ideal generated by `n : ℕ` is `zmod n`. -/
def quotientSpanNatEquivZmod : ℤ ⧸ Ideal.span {↑n} ≃+* ZMod n :=
  (Ideal.quotEquivOfEq (ZMod.ker_int_castRingHom _)).symm.trans <|
    RingHom.quotientKerEquivOfRightInverse <|
      show Function.RightInverse coe (Int.castRingHom (ZMod n)) from int_cast_zmod_cast
#align int.quotient_span_nat_equiv_zmod Int.quotientSpanNatEquivZmod

/-- `ℤ` modulo the ideal generated by `a : ℤ` is `zmod a.nat_abs`. -/
def quotientSpanEquivZmod (a : ℤ) : ℤ ⧸ Ideal.span ({a} : Set ℤ) ≃+* ZMod a.natAbs :=
  (Ideal.quotEquivOfEq (span_natAbs a)).symm.trans (quotientSpanNatEquivZmod a.natAbs)
#align int.quotient_span_equiv_zmod Int.quotientSpanEquivZmod

end Int

namespace AddAction

open AddSubgroup AddMonoidHom AddEquiv Function

variable {α β : Type _} [AddGroup α] (a : α) [AddAction α β] (b : β)

/-- The quotient `(ℤ ∙ a) ⧸ (stabilizer b)` is cyclic of order `minimal_period ((+ᵥ) a) b`. -/
noncomputable def zmultiplesQuotientStabilizerEquiv :
    zmultiples a ⧸ stabilizer (zmultiples a) b ≃+ ZMod (minimalPeriod ((· +ᵥ ·) a) b) :=
  (ofBijective
          (map _ (stabilizer (zmultiples a) b) (zmultiplesHom (zmultiples a) ⟨a, mem_zmultiples a⟩)
            (by
              rw [zmultiples_le, mem_comap, mem_stabilizer_iff, zmultiplesHom_apply, coe_nat_zsmul,
                ← vadd_iterate]
              exact is_periodic_pt_minimal_period ((· +ᵥ ·) a) b))
          ⟨by
            rw [← ker_eq_bot_iff, eq_bot_iff]
            refine' fun q => induction_on' q fun n hn => _
            rw [mem_bot, eq_zero_iff, Int.mem_zmultiples_iff, ←
              zsmul_vadd_eq_iff_minimal_period_dvd]
            exact (eq_zero_iff _).mp hn, fun q =>
            induction_on' q fun ⟨_, n, rfl⟩ => ⟨n, rfl⟩⟩).symm.trans
    (Int.quotientZmultiplesNatEquivZmod (minimalPeriod ((· +ᵥ ·) a) b))
#align add_action.zmultiples_quotient_stabilizer_equiv AddAction.zmultiplesQuotientStabilizerEquiv

theorem zmultiplesQuotientStabilizerEquiv_symm_apply (n : ZMod (minimalPeriod ((· +ᵥ ·) a) b)) :
    (zmultiplesQuotientStabilizerEquiv a b).symm n =
      (n : ℤ) • (⟨a, mem_zmultiples a⟩ : zmultiples a) :=
  rfl
#align add_action.zmultiples_quotient_stabilizer_equiv_symm_apply AddAction.zmultiplesQuotientStabilizerEquiv_symm_apply

end AddAction

namespace MulAction

open AddAction Subgroup AddSubgroup Function

variable {α β : Type _} [Group α] (a : α) [MulAction α β] (b : β)

attribute [local semireducible] MulOpposite

/-- The quotient `(a ^ ℤ) ⧸ (stabilizer b)` is cyclic of order `minimal_period ((•) a) b`. -/
noncomputable def zpowersQuotientStabilizerEquiv :
    zpowers a ⧸ stabilizer (zpowers a) b ≃* Multiplicative (ZMod (minimalPeriod ((· • ·) a) b)) :=
  let f := zmultiplesQuotientStabilizerEquiv (Additive.ofMul a) b
  ⟨f.toFun, f.invFun, f.left_inv, f.right_inv, f.map_add'⟩
#align mul_action.zpowers_quotient_stabilizer_equiv MulAction.zpowersQuotientStabilizerEquiv

theorem zpowersQuotientStabilizerEquiv_symm_apply (n : ZMod (minimalPeriod ((· • ·) a) b)) :
    (zpowersQuotientStabilizerEquiv a b).symm n = (⟨a, mem_zpowers a⟩ : zpowers a) ^ (n : ℤ) :=
  rfl
#align mul_action.zpowers_quotient_stabilizer_equiv_symm_apply MulAction.zpowersQuotientStabilizerEquiv_symm_apply

/-- The orbit `(a ^ ℤ) • b` is a cycle of order `minimal_period ((•) a) b`. -/
noncomputable def orbitZpowersEquiv : orbit (zpowers a) b ≃ ZMod (minimalPeriod ((· • ·) a) b) :=
  (orbitEquivQuotientStabilizer _ b).trans (zpowersQuotientStabilizerEquiv a b).toEquiv
#align mul_action.orbit_zpowers_equiv MulAction.orbitZpowersEquiv

/-- The orbit `(ℤ • a) +ᵥ b` is a cycle of order `minimal_period ((+ᵥ) a) b`. -/
noncomputable def AddAction.orbitZmultiplesEquiv {α β : Type _} [AddGroup α] (a : α) [AddAction α β]
    (b : β) : AddAction.orbit (zmultiples a) b ≃ ZMod (minimalPeriod ((· +ᵥ ·) a) b) :=
  (AddAction.orbitEquivQuotientStabilizer (zmultiples a) b).trans
    (zmultiplesQuotientStabilizerEquiv a b).toEquiv
#align add_action.orbit_zmultiples_equiv AddAction.orbitZmultiplesEquiv

attribute [to_additive orbit_zmultiples_equiv] orbit_zpowers_equiv

@[to_additive orbit_zmultiples_equiv_symm_apply]
theorem orbitZpowersEquiv_symm_apply (k : ZMod (minimalPeriod ((· • ·) a) b)) :
    (orbitZpowersEquiv a b).symm k =
      (⟨a, mem_zpowers a⟩ : zpowers a) ^ (k : ℤ) • ⟨b, mem_orbit_self b⟩ :=
  rfl
#align mul_action.orbit_zpowers_equiv_symm_apply MulAction.orbitZpowersEquiv_symm_apply
#align add_action.orbit_zmultiples_equiv_symm_apply AddAction.orbit_zmultiples_equiv_symm_apply

theorem orbitZpowersEquiv_symm_apply' (k : ℤ) :
    (orbitZpowersEquiv a b).symm k = (⟨a, mem_zpowers a⟩ : zpowers a) ^ k • ⟨b, mem_orbit_self b⟩ :=
  by
  rw [orbit_zpowers_equiv_symm_apply, ZMod.coe_int_cast]
  exact Subtype.ext (zpow_smul_mod_minimal_period _ _ k)
#align mul_action.orbit_zpowers_equiv_symm_apply' MulAction.orbitZpowersEquiv_symm_apply'

theorem AddAction.orbitZmultiplesEquiv_symm_apply' {α β : Type _} [AddGroup α] (a : α)
    [AddAction α β] (b : β) (k : ℤ) :
    (AddAction.orbitZmultiplesEquiv a b).symm k =
      k • (⟨a, mem_zmultiples a⟩ : zmultiples a) +ᵥ ⟨b, AddAction.mem_orbit_self b⟩ :=
  by
  rw [AddAction.orbit_zmultiples_equiv_symm_apply, ZMod.coe_int_cast]
  exact Subtype.ext (zsmul_vadd_mod_minimal_period _ _ k)
#align add_action.orbit_zmultiples_equiv_symm_apply' AddAction.orbitZmultiplesEquiv_symm_apply'

attribute [to_additive orbit_zmultiples_equiv_symm_apply'] orbit_zpowers_equiv_symm_apply'

@[to_additive]
theorem minimalPeriod_eq_card [Fintype (orbit (zpowers a) b)] :
    minimalPeriod ((· • ·) a) b = Fintype.card (orbit (zpowers a) b) := by
  rw [← Fintype.ofEquiv_card (orbit_zpowers_equiv a b), ZMod.card]
#align mul_action.minimal_period_eq_card MulAction.minimalPeriod_eq_card
#align add_action.minimal_period_eq_card AddAction.minimal_period_eq_card

@[to_additive]
instance minimalPeriod_pos [Finite <| orbit (zpowers a) b] :
    NeZero <| minimalPeriod ((· • ·) a) b :=
  ⟨by
    cases nonempty_fintype (orbit (zpowers a) b)
    haveI : Nonempty (orbit (zpowers a) b) := (orbit_nonempty b).to_subtype
    rw [minimal_period_eq_card]
    exact Fintype.card_ne_zero⟩
#align mul_action.minimal_period_pos MulAction.minimalPeriod_pos
#align add_action.minimal_period_pos AddAction.minimal_period_pos

end MulAction

section Group

open Subgroup

variable {α : Type _} [Group α] (a : α)

/-- See also `order_eq_card_zpowers`. -/
@[to_additive add_order_eq_card_zmultiples' "See also `add_order_eq_card_zmultiples`."]
theorem order_eq_card_zpowers' : orderOf a = Nat.card (zpowers a) :=
  by
  have := Nat.card_congr (MulAction.orbitZpowersEquiv a (1 : α))
  rwa [Nat.card_zMod, orbit_subgroup_one_eq_self, eq_comm] at this
#align order_eq_card_zpowers' order_eq_card_zpowers'
#align add_order_eq_card_zmultiples' add_order_eq_card_zmultiples'

variable {a}

@[to_additive IsOfFinAddOrder.finite_zmultiples]
theorem IsOfFinOrder.finite_zpowers (h : IsOfFinOrder a) : Finite <| zpowers a :=
  by
  rw [← orderOf_pos_iff, order_eq_card_zpowers'] at h
  exact Nat.finite_of_card_ne_zero h.ne.symm
#align is_of_fin_order.finite_zpowers IsOfFinOrder.finite_zpowers
#align is_of_fin_add_order.finite_zmultiples IsOfFinAddOrder.finite_zmultiples

end Group