import complete_binary_tree
import data.nat.log

set_option trace.simplify.rewrite true
set_option trace.simp_lemmas true

open tree

variable {α : Type}
variable a: α
variables s t: tree α

/-
# Almost Complete Binary Trees

## Definition
-/

def acomplete : tree α → Prop
| t := height t - min_height t <= 1

/-
Lemma 4.6 from __Functional Algorithms, Verified!__
-/
lemma acomplete_optimal :acomplete s ∧ size s <= size t → height s <= height t :=
begin
  intro h1,
  have h2: 2 <= 2, by trivial,
  by_cases complete s,
  { have h3: 2 ^ height s <= 2 ^height t, from calc
      2 ^ height s = size1 s : by simp [size1_if_complete s, *]
      ... <= size1 t : by simp [*, size1_size]
      ... <= 2 ^height t : by simp [size1_height],
    simp [iff.elim_left (nat.pow_le_iff_le_right h2) h3] },
  have h3: 2 ^ min_height s < 2 ^ height t, from calc
    2 ^ min_height s < size1 s : by simp [min_height_size1_if_incomplete s, *]
    ... <= size1 t : by simp [*, size1_size]
    ... <= 2 ^ height t: by simp [size1_height],
  have: min_height s < height t, from iff.elim_left (nat.pow_lt_iff_lt_right h2) h3,
  rw acomplete at h1,
  have: height s - min_height s ≤ 1 , from h1.left,
  have: ¬ min_height s = height s, from iff.elim_left (iff_false_left h) (complete_iff_height s),
  have: min_height s <= height s, from min_height_le_height s,
  have: min_height s < height s, by simp [has_le.le.lt_of_ne, *],
  have: 0 < height s - min_height s, by simp [*, nat.sub_pos_of_lt],
  have: height s - min_height s = 1, by linarith,
  have: min_height s + 1 = height s, by linarith,
  linarith,
end

/-
Used for lemma 4.7
-/
lemma lt_le_sub_one {a b: ℕ }: a < b → a <= b - 1 :=
begin
  cases b,
  { simp *},
  intro h,
  have h1: a.succ ≤ b.succ, from nat.succ_le_of_lt h,
  apply nat.le_of_succ_le_succ h1,
end

/-
Used for lemma 4.7
-/
lemma sub_one_div_add_eq_add_one_div {n : ℕ }:
  ¬ n = 0 →  ((n-1)/2) + 1 = (n + 1) / 2 :=
begin
  have h1: 0 < 2, by simp,
  cases n,
  { simp * at *},
  intro h,
  simp [nat.succ_eq_add_one],
  apply eq.symm,
  calc
    (n + 1 + 1) / 2 = (n + 2 * 1) / 2 : by ring
    ... = n / 2  + 1: by apply nat.add_mul_div_left n 1 h1
end

/-
Used for lemma 4.7
-/
lemma lt_clog_of_pow_lt {m n : ℕ}: 2 ^ m < n → m < nat.clog 2 n :=
begin
  intro h,
  have h1: 0 < 2, by simp,
  induction' m,
  { have: 2 <= n, by linarith,
    simp [* , nat.clog_pos] },
  have h2: 2 ^ m.succ = 2 ^ m * 2, by ring,
  rw h2 at h,
  have : 2 ^ m > 0, by simp,
  have h3: 2 ^ m ≤ (n-1)/2 ↔ (2 ^ m) * 2 ≤ (n-1), from nat.le_div_iff_mul_le (2 ^ m) (n-1) h1,
  have h4: 2 ^ m * 2 ≤ n - 1, from lt_le_sub_one h,
  have : 1 < n, by linarith,
  have h5: ¬ n = 0, by linarith,
  have : 2 ^ m < (n+1) / 2, by calc
    2 ^ m <= (n-1) / 2: iff.elim_right h3 h4
    ... < ((n-1) / 2) + 1 : by simp
    ... = (n+1) / 2 : sub_one_div_add_eq_add_one_div h5,
  have ih': 2 ^ m < ((n+1)/2) → m < nat.clog 2 ((n+1) / 2), from ih ,
  rw nat.clog,
  simp [*, ← nat.add_one],
end

/-
Lemma 4.7 from __Functional Algorithms, Verified!__
This lemma is not verified in Isabelle.
-/
lemma acomplete_height :acomplete t → height t = nat.clog 2 (size1 t) :=
begin
  by_cases complete t,
  { have: size1 t = 2 ^height t, from size1_if_complete t h,
    simp [*, nat.clog_pow] },
  intro h1,
  rw acomplete at h1,
  have: min_height t <= height t, from min_height_le_height t,
  have: ¬ min_height t = height t, from iff.elim_left (iff_false_left h) (complete_iff_height t),
  have: min_height t < height t, by simp [has_le.le.lt_of_ne, *],
  have h2: height t = min_height t + 1, by linarith,
  have h3: size1 t <= 2 ^ height t, from size1_height t,
  rw h2 at h3,
  simp [nat.le_pow_iff_clog_le] at h3,
  have h4: 2 ^ min_height t < size1 t, from min_height_size1_if_incomplete t h,
  have : min_height t < nat.clog 2 (size1 t), from lt_clog_of_pow_lt h4,
  linarith,
end

/-
Used for lemma 4.8
-/
lemma gt_log_of_lt_pow {m n: ℕ } (h: 1 <= n) : n < 2 ^ m → m > nat.log 2 n :=
begin
  induction' m,
  { intro,
    linarith },
  intro h1,
  have h2: n / 2 < 2 ^ m, from begin
    have h3: n < 2 ^ m * 2, by calc
      n < 2 ^ m.succ: h1
      ... = 2 ^ m * 2 : by ring,
    have h4: 0 < 2, by simp,
    have: n / 2 < 2 ^ m ↔ n < 2 ^ m * 2, from nat.div_lt_iff_lt_mul n (2 ^ m) h4,
    exact iff.elim_right this h3,
  end,
  rw nat.log,
  split_ifs,
  { have : 2 <= n, from h_1.left,
    have h3: 1 <= n/2, from begin
      have h1: 0 < 2, by simp,
      have h2: 1 ≤ n / 2 ↔ 1 * 2 ≤ n, from nat.le_div_iff_mul_le 1 n h1,
      simp at h2,
      cc,
    end,
    have ih': m > nat.log 2 (n/2), from ih h3 h2,
    simp only [nat.succ_eq_add_one],
    linarith },
  simp,
end

/-
Lemma 4.8 from __Functional Algorithms, Verified!__
This lemma is not verified in Isabelle.
-/
lemma acomplete_min_height: acomplete t → min_height t = nat.log 2 (size1 t) :=
begin
  by_cases complete t,
  { have: size1 t = 2 ^height t, from size1_if_complete t h,
    have: min_height t = height t, from iff.elim_left (complete_iff_height t) h,
    simp [*, nat.log_pow] },
  intro h1,
  rw acomplete at h1,
  have: min_height t <= height t, from min_height_le_height t,
  have: ¬ min_height t = height t, from iff.elim_left (iff_false_left h) (complete_iff_height t),
  have: min_height t < height t, by simp [has_le.le.lt_of_ne, *],
  have h2: height t = min_height t + 1, by linarith,
  have h3: 2 ^ min_height t <= size1 t, from min_height_size1 t,
  have h4: nat.log 2 (2 ^ min_height t) <= nat.log 2 (size1 t), from nat.log_le_log_of_le h3,
  have : 1 < 2, by simp,
  have h5: size1 t <= 2 ^ height t, from size1_height t,
  have h6: nat.log 2 (size1 t) <= nat.log 2 (2 ^ height t), from nat.log_le_log_of_le h5,
  simp [*, nat.log_pow] at h4 h6,
  have h7: size1 t < 2 ^ height t, by apply has_le.le.lt_of_ne h5 (iff.elim_left (iff_false_left h) (complete_iff_size1 t)),
  have: nat.log 2 (size1 t) < height t, from gt_log_of_lt_pow (trans (nat.one_le_two_pow (min_height t)) h3) h7,
  linarith ,
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.inner_product_space.pi_L2
import analysis.special_functions.sqrt

/-!
# Calculus in inner product spaces

In this file we prove that the inner product and square of the norm in an inner space are
infinitely `ℝ`-smooth. In order to state these results, we need a `normed_space ℝ E`
instance. Though we can deduce this structure from `inner_product_space 𝕜 E`, this instance may be
not definitionally equal to some other “natural” instance. So, we assume `[normed_space ℝ E]`.

We also prove that functions to a `euclidean_space` are (higher) differentiable if and only if
their components are. This follows from the corresponding fact for finite product of normed spaces,
and from the equivalence of norms in finite dimensions.

## TODO

The last part of the file should be generalized to `pi_Lp`.
-/

noncomputable theory

open is_R_or_C real filter
open_locale big_operators classical topology

section deriv_inner

variables {𝕜 E F : Type*} [is_R_or_C 𝕜]
variables [normed_add_comm_group E] [inner_product_space 𝕜 E]
variables [normed_add_comm_group F] [inner_product_space ℝ F]
local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

variables (𝕜) [normed_space ℝ E]

/-- Derivative of the inner product. -/
def fderiv_inner_clm (p : E × E) : E × E →L[ℝ] 𝕜 := is_bounded_bilinear_map_inner.deriv p

@[simp] lemma fderiv_inner_clm_apply (p x : E × E) :
  fderiv_inner_clm 𝕜 p x = ⟪p.1, x.2⟫ + ⟪x.1, p.2⟫ := rfl

lemma cont_diff_inner {n} : cont_diff ℝ n (λ p : E × E, ⟪p.1, p.2⟫) :=
is_bounded_bilinear_map_inner.cont_diff

lemma cont_diff_at_inner {p : E × E} {n} :
  cont_diff_at ℝ n (λ p : E × E, ⟪p.1, p.2⟫) p :=
cont_diff_inner.cont_diff_at

lemma differentiable_inner : differentiable ℝ (λ p : E × E, ⟪p.1, p.2⟫) :=
is_bounded_bilinear_map_inner.differentiable_at

variables {G : Type*} [normed_add_comm_group G] [normed_space ℝ G]
  {f g : G → E} {f' g' : G →L[ℝ] E} {s : set G} {x : G} {n : ℕ∞}

include 𝕜

lemma cont_diff_within_at.inner (hf : cont_diff_within_at ℝ n f s x)
  (hg : cont_diff_within_at ℝ n g s x) :
  cont_diff_within_at ℝ n (λ x, ⟪f x, g x⟫) s x :=
cont_diff_at_inner.comp_cont_diff_within_at x (hf.prod hg)

lemma cont_diff_at.inner (hf : cont_diff_at ℝ n f x)
  (hg : cont_diff_at ℝ n g x) :
  cont_diff_at ℝ n (λ x, ⟪f x, g x⟫) x :=
hf.inner 𝕜 hg

lemma cont_diff_on.inner (hf : cont_diff_on ℝ n f s) (hg : cont_diff_on ℝ n g s) :
  cont_diff_on ℝ n (λ x, ⟪f x, g x⟫) s :=
λ x hx, (hf x hx).inner 𝕜 (hg x hx)

lemma cont_diff.inner (hf : cont_diff ℝ n f) (hg : cont_diff ℝ n g) :
  cont_diff ℝ n (λ x, ⟪f x, g x⟫) :=
cont_diff_inner.comp (hf.prod hg)

lemma has_fderiv_within_at.inner (hf : has_fderiv_within_at f f' s x)
  (hg : has_fderiv_within_at g g' s x) :
  has_fderiv_within_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm 𝕜 (f x, g x)).comp $ f'.prod g') s x :=
(is_bounded_bilinear_map_inner.has_fderiv_at (f x, g x)).comp_has_fderiv_within_at x (hf.prod hg)

lemma has_strict_fderiv_at.inner (hf : has_strict_fderiv_at f f' x)
  (hg : has_strict_fderiv_at g g' x) :
  has_strict_fderiv_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm 𝕜 (f x, g x)).comp $ f'.prod g') x :=
(is_bounded_bilinear_map_inner.has_strict_fderiv_at (f x, g x)).comp x (hf.prod hg)

lemma has_fderiv_at.inner (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) :
  has_fderiv_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm 𝕜 (f x, g x)).comp $ f'.prod g') x :=
(is_bounded_bilinear_map_inner.has_fderiv_at (f x, g x)).comp x (hf.prod hg)

lemma has_deriv_within_at.inner {f g : ℝ → E} {f' g' : E} {s : set ℝ} {x : ℝ}
  (hf : has_deriv_within_at f f' s x) (hg : has_deriv_within_at g g' s x) :
  has_deriv_within_at (λ t, ⟪f t, g t⟫) (⟪f x, g'⟫ + ⟪f', g x⟫) s x :=
by simpa using (hf.has_fderiv_within_at.inner 𝕜 hg.has_fderiv_within_at).has_deriv_within_at

lemma has_deriv_at.inner {f g : ℝ → E} {f' g' : E} {x : ℝ} :
  has_deriv_at f f' x →  has_deriv_at g g' x →
  has_deriv_at (λ t, ⟪f t, g t⟫) (⟪f x, g'⟫ + ⟪f', g x⟫) x :=
by simpa only [← has_deriv_within_at_univ] using has_deriv_within_at.inner 𝕜

lemma differentiable_within_at.inner (hf : differentiable_within_at ℝ f s x)
  (hg : differentiable_within_at ℝ g s x) :
  differentiable_within_at ℝ (λ x, ⟪f x, g x⟫) s x :=
((differentiable_inner _).has_fderiv_at.comp_has_fderiv_within_at x
  (hf.prod hg).has_fderiv_within_at).differentiable_within_at

lemma differentiable_at.inner (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) :
  differentiable_at ℝ (λ x, ⟪f x, g x⟫) x :=
(differentiable_inner _).comp x (hf.prod hg)

lemma differentiable_on.inner (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s) :
  differentiable_on ℝ (λ x, ⟪f x, g x⟫) s :=
λ x hx, (hf x hx).inner 𝕜 (hg x hx)

lemma differentiable.inner (hf : differentiable ℝ f) (hg : differentiable ℝ g) :
  differentiable ℝ (λ x, ⟪f x, g x⟫) :=
λ x, (hf x).inner 𝕜 (hg x)

lemma fderiv_inner_apply (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) (y : G) :
  fderiv ℝ (λ t, ⟪f t, g t⟫) x y = ⟪f x, fderiv ℝ g x y⟫ + ⟪fderiv ℝ f x y, g x⟫ :=
by { rw [(hf.has_fderiv_at.inner 𝕜 hg.has_fderiv_at).fderiv], refl }

lemma deriv_inner_apply {f g : ℝ → E} {x : ℝ} (hf : differentiable_at ℝ f x)
  (hg : differentiable_at ℝ g x) :
  deriv (λ t, ⟪f t, g t⟫) x = ⟪f x, deriv g x⟫ + ⟪deriv f x, g x⟫ :=
(hf.has_deriv_at.inner 𝕜 hg.has_deriv_at).deriv

lemma cont_diff_norm_sq : cont_diff ℝ n (λ x : E, ‖x‖ ^ 2) :=
begin
  simp only [sq, ← @inner_self_eq_norm_mul_norm 𝕜],
  exact (re_clm : 𝕜 →L[ℝ] ℝ).cont_diff.comp (cont_diff_id.inner 𝕜 cont_diff_id)
end

lemma cont_diff.norm_sq (hf : cont_diff ℝ n f) :
  cont_diff ℝ n (λ x, ‖f x‖ ^ 2) :=
(cont_diff_norm_sq 𝕜).comp hf

lemma cont_diff_within_at.norm_sq (hf : cont_diff_within_at ℝ n f s x) :
  cont_diff_within_at ℝ n (λ y, ‖f y‖ ^ 2) s x :=
(cont_diff_norm_sq 𝕜).cont_diff_at.comp_cont_diff_within_at x hf

lemma cont_diff_at.norm_sq (hf : cont_diff_at ℝ n f x) :
  cont_diff_at ℝ n (λ y, ‖f y‖ ^ 2) x :=
hf.norm_sq 𝕜

lemma cont_diff_at_norm {x : E} (hx : x ≠ 0) : cont_diff_at ℝ n norm x :=
have ‖id x‖ ^ 2 ≠ 0, from pow_ne_zero _ (norm_pos_iff.2 hx).ne',
by simpa only [id, sqrt_sq, norm_nonneg] using (cont_diff_at_id.norm_sq 𝕜).sqrt this

lemma cont_diff_at.norm (hf : cont_diff_at ℝ n f x) (h0 : f x ≠ 0) :
  cont_diff_at ℝ n (λ y, ‖f y‖) x :=
(cont_diff_at_norm 𝕜 h0).comp x hf

lemma cont_diff_at.dist (hf : cont_diff_at ℝ n f x) (hg : cont_diff_at ℝ n g x)
  (hne : f x ≠ g x) :
  cont_diff_at ℝ n (λ y, dist (f y) (g y)) x :=
by { simp only [dist_eq_norm], exact (hf.sub hg).norm 𝕜 (sub_ne_zero.2 hne) }

lemma cont_diff_within_at.norm (hf : cont_diff_within_at ℝ n f s x) (h0 : f x ≠ 0) :
  cont_diff_within_at ℝ n (λ y, ‖f y‖) s x :=
(cont_diff_at_norm 𝕜 h0).comp_cont_diff_within_at x hf

lemma cont_diff_within_at.dist (hf : cont_diff_within_at ℝ n f s x)
  (hg : cont_diff_within_at ℝ n g s x) (hne : f x ≠ g x) :
  cont_diff_within_at ℝ n (λ y, dist (f y) (g y)) s x :=
by { simp only [dist_eq_norm], exact (hf.sub hg).norm 𝕜 (sub_ne_zero.2 hne) }

lemma cont_diff_on.norm_sq (hf : cont_diff_on ℝ n f s) :
  cont_diff_on ℝ n (λ y, ‖f y‖ ^ 2) s :=
(λ x hx, (hf x hx).norm_sq 𝕜)

lemma cont_diff_on.norm (hf : cont_diff_on ℝ n f s) (h0 : ∀ x ∈ s, f x ≠ 0) :
  cont_diff_on ℝ n (λ y, ‖f y‖) s :=
λ x hx, (hf x hx).norm 𝕜 (h0 x hx)

lemma cont_diff_on.dist (hf : cont_diff_on ℝ n f s)
  (hg : cont_diff_on ℝ n g s) (hne : ∀ x ∈ s, f x ≠ g x) :
  cont_diff_on ℝ n (λ y, dist (f y) (g y)) s :=
λ x hx, (hf x hx).dist 𝕜 (hg x hx) (hne x hx)

lemma cont_diff.norm (hf : cont_diff ℝ n f) (h0 : ∀ x, f x ≠ 0) :
  cont_diff ℝ n (λ y, ‖f y‖) :=
cont_diff_iff_cont_diff_at.2 $ λ x, hf.cont_diff_at.norm 𝕜 (h0 x)

lemma cont_diff.dist (hf : cont_diff ℝ n f) (hg : cont_diff ℝ n g)
  (hne : ∀ x, f x ≠ g x) :
  cont_diff ℝ n (λ y, dist (f y) (g y)) :=
cont_diff_iff_cont_diff_at.2 $
  λ x, hf.cont_diff_at.dist 𝕜 hg.cont_diff_at (hne x)

omit 𝕜
lemma has_strict_fderiv_at_norm_sq (x : F) :
  has_strict_fderiv_at (λ x, ‖x‖ ^ 2) (bit0 (innerSL ℝ x)) x :=
begin
  simp only [sq, ← @inner_self_eq_norm_mul_norm ℝ],
  convert (has_strict_fderiv_at_id x).inner ℝ (has_strict_fderiv_at_id x),
  ext y,
  simp [bit0, real_inner_comm],
end
include 𝕜

lemma differentiable_at.norm_sq (hf : differentiable_at ℝ f x) :
  differentiable_at ℝ (λ y, ‖f y‖ ^ 2) x :=
((cont_diff_at_id.norm_sq 𝕜).differentiable_at le_rfl).comp x hf

lemma differentiable_at.norm (hf : differentiable_at ℝ f x) (h0 : f x ≠ 0) :
  differentiable_at ℝ (λ y, ‖f y‖) x :=
((cont_diff_at_norm 𝕜 h0).differentiable_at le_rfl).comp x hf

lemma differentiable_at.dist (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x)
  (hne : f x ≠ g x) :
  differentiable_at ℝ (λ y, dist (f y) (g y)) x :=
by { simp only [dist_eq_norm], exact (hf.sub hg).norm 𝕜 (sub_ne_zero.2 hne) }

lemma differentiable.norm_sq (hf : differentiable ℝ f) : differentiable ℝ (λ y, ‖f y‖ ^ 2) :=
λ x, (hf x).norm_sq 𝕜

lemma differentiable.norm (hf : differentiable ℝ f) (h0 : ∀ x, f x ≠ 0) :
  differentiable ℝ (λ y, ‖f y‖) :=
λ x, (hf x).norm 𝕜 (h0 x)

lemma differentiable.dist (hf : differentiable ℝ f) (hg : differentiable ℝ g)
  (hne : ∀ x, f x ≠ g x) :
  differentiable ℝ (λ y, dist (f y) (g y)) :=
λ x, (hf x).dist 𝕜 (hg x) (hne x)

lemma differentiable_within_at.norm_sq (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ y, ‖f y‖ ^ 2) s x :=
((cont_diff_at_id.norm_sq 𝕜).differentiable_at le_rfl).comp_differentiable_within_at x hf

lemma differentiable_within_at.norm (hf : differentiable_within_at ℝ f s x) (h0 : f x ≠ 0) :
  differentiable_within_at ℝ (λ y, ‖f y‖) s x :=
((cont_diff_at_id.norm 𝕜 h0).differentiable_at le_rfl).comp_differentiable_within_at x hf

lemma differentiable_within_at.dist (hf : differentiable_within_at ℝ f s x)
  (hg : differentiable_within_at ℝ g s x) (hne : f x ≠ g x) :
  differentiable_within_at ℝ (λ y, dist (f y) (g y)) s x :=
by { simp only [dist_eq_norm], exact (hf.sub hg).norm 𝕜 (sub_ne_zero.2 hne) }

lemma differentiable_on.norm_sq (hf : differentiable_on ℝ f s) :
  differentiable_on ℝ (λ y, ‖f y‖ ^ 2) s :=
λ x hx, (hf x hx).norm_sq 𝕜

lemma differentiable_on.norm (hf : differentiable_on ℝ f s) (h0 : ∀ x ∈ s, f x ≠ 0) :
  differentiable_on ℝ (λ y, ‖f y‖) s :=
λ x hx, (hf x hx).norm 𝕜 (h0 x hx)

lemma differentiable_on.dist (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s)
  (hne : ∀ x ∈ s, f x ≠ g x) :
  differentiable_on ℝ (λ y, dist (f y) (g y)) s :=
λ x hx, (hf x hx).dist 𝕜 (hg x hx) (hne x hx)

end deriv_inner

section pi_like

open continuous_linear_map

variables {𝕜 ι H : Type*} [is_R_or_C 𝕜] [normed_add_comm_group H] [normed_space 𝕜 H]
  [fintype ι] {f : H → euclidean_space 𝕜 ι} {f' : H →L[𝕜] euclidean_space 𝕜 ι} {t : set H} {y : H}

lemma differentiable_within_at_euclidean :
  differentiable_within_at 𝕜 f t y ↔ ∀ i, differentiable_within_at 𝕜 (λ x, f x i) t y :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_differentiable_within_at_iff, differentiable_within_at_pi],
  refl
end

lemma differentiable_at_euclidean :
  differentiable_at 𝕜 f y ↔ ∀ i, differentiable_at 𝕜 (λ x, f x i) y :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_differentiable_at_iff, differentiable_at_pi],
  refl
end

lemma differentiable_on_euclidean :
  differentiable_on 𝕜 f t ↔ ∀ i, differentiable_on 𝕜 (λ x, f x i) t :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_differentiable_on_iff, differentiable_on_pi],
  refl
end

lemma differentiable_euclidean :
  differentiable 𝕜 f ↔ ∀ i, differentiable 𝕜 (λ x, f x i) :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_differentiable_iff, differentiable_pi],
  refl
end

lemma has_strict_fderiv_at_euclidean :
  has_strict_fderiv_at f f' y ↔ ∀ i, has_strict_fderiv_at (λ x, f x i)
    (euclidean_space.proj i ∘L f') y :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_has_strict_fderiv_at_iff, has_strict_fderiv_at_pi'],
  refl
end

lemma has_fderiv_within_at_euclidean :
  has_fderiv_within_at f f' t y ↔ ∀ i, has_fderiv_within_at (λ x, f x i)
    (euclidean_space.proj i ∘L f') t y :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_has_fderiv_within_at_iff, has_fderiv_within_at_pi'],
  refl
end

lemma cont_diff_within_at_euclidean {n : ℕ∞} :
  cont_diff_within_at 𝕜 n f t y ↔ ∀ i, cont_diff_within_at 𝕜 n (λ x, f x i) t y :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_cont_diff_within_at_iff, cont_diff_within_at_pi],
  refl
end

lemma cont_diff_at_euclidean {n : ℕ∞} :
  cont_diff_at 𝕜 n f y ↔ ∀ i, cont_diff_at 𝕜 n (λ x, f x i) y :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_cont_diff_at_iff, cont_diff_at_pi],
  refl
end

lemma cont_diff_on_euclidean {n : ℕ∞} :
  cont_diff_on 𝕜 n f t ↔ ∀ i, cont_diff_on 𝕜 n (λ x, f x i) t :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_cont_diff_on_iff, cont_diff_on_pi],
  refl
end

lemma cont_diff_euclidean {n : ℕ∞} :
  cont_diff 𝕜 n f ↔ ∀ i, cont_diff 𝕜 n (λ x, f x i) :=
begin
  rw [← (euclidean_space.equiv ι 𝕜).comp_cont_diff_iff, cont_diff_pi],
  refl
end

end pi_like

section diffeomorph_unit_ball

open metric (hiding mem_nhds_iff)

variables {n : ℕ∞} {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E]

lemma cont_diff_homeomorph_unit_ball :
  cont_diff ℝ n $ λ (x : E), (homeomorph_unit_ball x : E) :=
begin
  suffices : cont_diff ℝ n (λ x, (1 + ‖x‖^2).sqrt⁻¹), { exact this.smul cont_diff_id, },
  have h : ∀ (x : E), 0 < 1 + ‖x‖ ^ 2 := λ x, by positivity,
  refine cont_diff.inv _ (λ x, real.sqrt_ne_zero'.mpr (h x)),
  exact (cont_diff_const.add $ cont_diff_norm_sq ℝ).sqrt (λ x, (h x).ne.symm),
end

lemma cont_diff_on_homeomorph_unit_ball_symm
  {f : E → E} (h : ∀ y (hy : y ∈ ball (0 : E) 1), f y = homeomorph_unit_ball.symm ⟨y, hy⟩) :
  cont_diff_on ℝ n f $ ball 0 1 :=
begin
  intros y hy,
  apply cont_diff_at.cont_diff_within_at,
  have hf : f =ᶠ[𝓝 y] λ y, (1 - ‖(y : E)‖^2).sqrt⁻¹ • (y : E),
  { rw eventually_eq_iff_exists_mem,
    refine ⟨ball (0 : E) 1, mem_nhds_iff.mpr ⟨ball (0 : E) 1, set.subset.refl _, is_open_ball, hy⟩,
      λ z hz, _⟩,
    rw h z hz,
    refl, },
  refine cont_diff_at.congr_of_eventually_eq _ hf,
  suffices : cont_diff_at ℝ n (λy, (1 - ‖(y : E)‖^2).sqrt⁻¹) y, { exact this.smul cont_diff_at_id },
  have h : 0 < 1 - ‖(y : E)‖^2, by rwa [mem_ball_zero_iff, ← _root_.abs_one, ← abs_norm_eq_norm,
    ← sq_lt_sq, one_pow, ← sub_pos] at hy,
  refine cont_diff_at.inv _ (real.sqrt_ne_zero'.mpr h),
  refine cont_diff_at.comp _ (cont_diff_at_sqrt h.ne.symm) _,
  exact cont_diff_at_const.sub (cont_diff_norm_sq ℝ).cont_diff_at,
end

end diffeomorph_unit_ball


import data.real.basic
import topology.metric_space.basic
import tactic

class has_wmap (α : Type*) :=
(wmap : ℝ → α → α → α)

export has_wmap (wmap)

instance : has_wmap ℝ :=
⟨λ a x y, (1 - a) * x + a * y⟩

class whyperbolic_space (X : Type*) extends has_wmap X, metric_space X :=
(dist_conv : ∀ {a : ℝ} (x y z : X), 0 ≤ a → a ≤ 1 →
  dist z (wmap a x y) ≤ (1 - a) * (dist z x) + a * (dist z y))
(same_points : ∀ {a b : ℝ} (x y : X), 0 ≤ a → a ≤ 1 → 0 ≤ b → b ≤ 1 →
  dist (wmap a x y) (wmap b x y) = (abs $ a - b) * (dist x y))
(w_antisymm : ∀ {a : ℝ} (x y : X), 0 ≤ a → a ≤ 1 →
  wmap a x y = wmap (1 - a) y x)
(same_coeff : ∀ {a : ℝ} (x y z w : X),  0 ≤ a → a ≤ 1 →
  dist (wmap a x z) (wmap a y w) ≤ (1 - a) * (dist x y) + a * (dist z w))

namespace whyperbolic_space

-- def convex (C : set X) : Prop := ∀ x y : X, x ∈ C → y ∈ C → ∀ a : ℝ, 0 ≤ a → a ≤ 1 → wmap a x y ∈ C

section basic_lemmas

  variables {X : Type*} [whyperbolic_space X]
  variables {a b : ℝ} {x y z w : X}  (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (hb0 : 0 ≤ b) (hb1 : b ≤ 1)

  include ha0 ha1

    lemma dist_self_wmap : dist x (wmap a x y) = a * (dist x y) ∧ dist y (wmap a x y) = (1 - a) * (dist x y) :=
    begin
      have hx := @whyperbolic_space.dist_conv _ _ _ x y x ha0 ha1,
      have hy := @whyperbolic_space.dist_conv _ _ _ x y y ha0 ha1,
      rw [dist_self x, mul_zero, zero_add] at hx,
      rw [dist_self y, mul_zero, add_zero, dist_comm y x] at hy,
      have hxy := add_le_add hx hy,
      have : a * dist x y + (1 - a) * dist x y = dist x y := by linarith,
      rw this at hxy, clear this,
      have htriangle := dist_triangle_right x y (wmap a x y),
      split;
      { have := antisymm htriangle hxy, linarith, },
    end

    @[simp]
    lemma dist_self_wmap_left : dist x (wmap a x y) = a * (dist x y) :=
    and.left $ dist_self_wmap ha0 ha1

    @[simp]
    lemma dist_self_wmap_right : dist y (wmap a x y) = (1 - a) * (dist x y) :=
    and.right $ dist_self_wmap ha0 ha1

    @[simp]
    lemma wmap_self : wmap a x x = x :=
    begin
      have htriangle := whyperbolic_space.dist_conv x x x ha0 ha1,
      rw [dist_self, mul_zero, mul_zero, add_zero] at htriangle,
      exact eq.symm (dist_le_zero.mp htriangle),
    end

    lemma wmap_same_coeff_same_firt : dist (wmap a x y) (wmap a x z) ≤  a * (dist y z) :=
    begin
      have := whyperbolic_space.same_coeff x x y z ha0 ha1,
      rw [dist_self, mul_zero, zero_add] at this,
      exact this,
    end

  omit ha0 ha1

  @[simp]
  lemma wmap_zero : wmap 0 x y = x :=
  begin
    have : dist x (wmap 0 x y) = 0 * dist x y := dist_self_wmap_left rfl.ge zero_le_one,
    rw [zero_mul] at this,
    exact (dist_eq_zero.mp this).symm,
  end

  @[simp]
  lemma wmap_one : wmap 1 x y = y :=
  begin
    have : dist y (wmap 1 x y) = (1 - 1) * (dist x y) := dist_self_wmap_right zero_le_one rfl.ge,
    rw [sub_self, zero_mul] at this,
    exact (dist_eq_zero.mp this).symm,
  end

  include ha0 ha1 hb0 hb1

    lemma dist_wmap : dist (wmap a x z) (wmap b y w) ≤ (1 - a) * (dist x y) + a * (dist z w) + (abs $ a - b) * (dist y w) :=
    begin
      set s := (wmap a x z),
      set t := (wmap b y w),
      have h₁ := dist_triangle s (wmap a y w) t,
      have this := same_points y w ha0 ha1 hb0 hb1,
      rw this at h₁, clear this,
      have : dist s (wmap a y w) ≤ (1 - a) * dist x y + a * dist z w := same_coeff _ _ _ _ ha0 ha1,
      linarith,
    end

    lemma dist_wmap_same_first : dist (wmap a x z) (wmap b x w) ≤ a * (dist z w) + (abs $ a - b) * (dist x w) :=
    begin
      have := @dist_wmap _ _ _ _ x x z w ha0 ha1 hb0 hb1,
      rw [dist_self] at this,
      linarith,
    end

  omit ha0 ha1 hb0 hb1

end basic_lemmas

end whyperbolic_space


open nat

def even : ℕ → Prop
| 0        := true
| (succ n) := ¬ (even n)

lemma even_6 : even 6 :=
begin
  unfold even,
  simp
end

def infinitely_many_even_integers : ∀ n : ℕ, ∃ m ≥ n, even m :=
begin
intro n,
by_cases (even n), -- This doesn't work: we need to show that `even` is decidable.
admit
end

instance parity_decidable : decidable_pred even :=
begin
unfold decidable_pred,
intro n,
induction n,
{
    unfold even,
    exact decidable.true -- I found this by grepping for "decidable" in lean/library/, finding lots in init/logic.lean, and noticing the instance called `decidable.true` there
},
{
  cases ih_1,
  {
    unfold even,
    exact decidable.is_true a_1
  },
  {
    unfold even,
    refine decidable.is_false _,
    cc -- This is a horrible hack, because I ran out of time working out the name of (p → ¬¬p).
  }
}
end

-- set_option pp.all true

def infinitely_many_even_integers_2 : ∀ n : ℕ, ∃ m ≥ n, even m :=
begin
intro n,
by_cases (even n),
{
  existsi n,
  existsi _,
  assumption,
  unfold ge,
},
{
  existsi (n+1),
  existsi _,
  unfold even,
  assumption,
  -- how do we obtain a proof that n + 1 ≥ n? This is pretty gross.
  unfold ge,
  unfold has_le.le,
  exact less_than_or_equal.step (less_than_or_equal.refl n),
}
end


import subgroup.definitions group.group_powers
import for_mathlib.finsum -- breaks many things

noncomputable theory

/-
An API for subgroups

Mathematician-friendly

Let G be a group. The type of subgroups of G is `subgroup G`.
In other words, if `H : subgroup G` then H is a subgroup of G.
The three basic facts you need to know about H are:

H.one_mem : (1 : G) ∈ H
H.mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H
H.inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H

Subgroups of a group form what is known as a *lattice*.
This is a partially ordered set with a sensible notion of
max and min (and even sup and inf).
-/

-- This entire project takes place in the `mygroup` namespace
namespace mygroup

variables {G : Type} [group G]

namespace lagrange

variables {H : subgroup G}

lemma self_mem_coset (a : G) (H : subgroup G): a ∈ a ⋆ H :=
  ⟨1, H.one_mem, (group.mul_one a).symm⟩

/-- Two cosets `a ⋆ H`, `b ⋆ H` are equal if and only if `b⁻¹ * a ∈ H` -/
theorem lcoset_eq {a b : G} :
  a ⋆ H = b ⋆ H ↔ b⁻¹ * a ∈ H :=
begin
  split; intro h,
    { replace h : a ∈ b ⋆ H, rw ←h, exact self_mem_coset a H,
      rcases h with ⟨g, hg₀, hg₁⟩,
      rw hg₁, simp [←group.mul_assoc, hg₀] },
    { ext, split; intro hx,
        { rcases hx with ⟨g, hg₀, hg₁⟩, rw hg₁,
          exact ⟨b⁻¹ * a * g, H.mul_mem h hg₀, by simp [←group.mul_assoc]⟩ },
        { rcases hx with ⟨g, hg₀, hg₁⟩, rw hg₁,
          refine ⟨a⁻¹ * b * g, H.mul_mem _ hg₀, by simp [←group.mul_assoc]⟩,
          convert H.inv_mem h, simp } }
end

-- A corollary of this is a ⋆ H = H iff a ∈ H

/-- The coset of `H`, `1 ⋆ H` equals `H` -/
theorem lcoset_of_one : 1 ⋆ H = H :=
begin
  ext, split; intro hx,
    { rcases hx with ⟨h, hh₀, hh₁⟩,
      rwa [hh₁, group.one_mul] },
    { exact ⟨x, hx, (group.one_mul x).symm⟩ }
end

/-- A left coset `a ⋆ H` equals `H` if and only if `a ∈ H` -/
theorem lcoset_of_mem {a : G} :
  a ⋆ H = H ↔ a ∈ H := by rw [←lcoset_of_one, lcoset_eq]; simp

/-- Two left cosets `a ⋆ H` and `b ⋆ H` are equal if they are not disjoint -/
theorem lcoset_digj {a b c : G} (ha : c ∈ a ⋆ H) (hb : c ∈ b ⋆ H) :
  a ⋆ H = b ⋆ H :=
begin
  rcases ha with ⟨g₀, hg₀, hca⟩,
  rcases hb with ⟨g₁, hg₁, hcb⟩,
  rw lcoset_eq, rw (show a = c * g₀⁻¹, by simp [hca, group.mul_assoc]),
  rw (show b⁻¹ = g₁ * c⁻¹,
    by rw (show b = c * g₁⁻¹, by simp [hcb, group.mul_assoc]); simp),
  suffices : g₁ * g₀⁻¹ ∈ H,
    { rw [group.mul_assoc, ←@group.mul_assoc _ _ c⁻¹],
      simp [this] },
  exact H.mul_mem hg₁ (H.inv_mem hg₀)
end

-- Now we would like to prove that all lcosets have the same order

open function

private def aux_map (a : G) (H : subgroup G) : H → a ⋆ H :=
  λ h, ⟨a * h, h, h.2, rfl⟩

private lemma aux_map_biject {a : G} : bijective $ aux_map a H :=
begin
  split,
    { intros x y hxy,
      suffices : (x : G) = y,
        { ext, assumption },
        { simp [aux_map] at hxy, assumption } },
    { rintro ⟨y, y_prop⟩,
      rcases y_prop with ⟨h, hh₀, hh₁⟩,
      refine ⟨⟨h, hh₀⟩, by simp [aux_map, hh₁]⟩ }
end

/-- There is a bijection between `H` and its left cosets -/
theorem lcoset_equiv {a : G} : H ≃ a ⋆ H :=
equiv.of_bijective (aux_map a H) aux_map_biject

-- We are going to use fincard which maps a fintype to its fintype.card
-- and maps to 0 otherwise

open fincard

/-- The cardinality of `H` equals its left cosets-/
lemma eq_card_of_lcoset {a : G} : fincard H = fincard (a ⋆ H) :=
  fincard.of_equiv lcoset_equiv

/-- The cardinality of all left cosets are equal -/
theorem card_of_lcoset_eq {a b : G} :
  fincard (a ⋆ H) = fincard (b ⋆ H) := by iterate 2 { rw ←eq_card_of_lcoset }

-- The rest of the proof will requires quotient

end lagrange

namespace normal

lemma mem_normal {x} {N : normal G} :
  x ∈ N ↔ ∃ (g : G) (n ∈ N), x = g * n * g⁻¹ :=
begin
  split; intro h,
    { exact ⟨1, x, h, by simp⟩ },
    { rcases h with ⟨g, n, hn, rfl⟩,
      exact conj_mem _ _ hn _ }
end

lemma mem_normal' {x} {N : normal G} :
  x ∈ N ↔ ∃ (g : G) (n ∈ N), x = g⁻¹ * n * g :=
begin
  rw mem_normal,
  split; rintro ⟨g, n, hn, rfl⟩;
    { exact ⟨g⁻¹, n, hn, by simp⟩ }
end

-- Some equivalent definitions for normal groups from wikipedia

open subgroup

-- Any two elements commute regarding the normal subgroup membership relation
lemma comm_mem_of_normal {K : normal G}
  {g k : G} (h : g * k ∈ K) : k * g ∈ K :=
begin
  suffices : k * (g * k) * k⁻¹ ∈ K,
    { simp [group.mul_assoc] at this, assumption },
  refine normal.conj_mem _ _ h _
end

def normal_of_mem_comm {K : subgroup G}
  (h : ∀ g k : G, g * k ∈ K → k * g ∈ K) : normal G :=
{ conj_mem' :=
  begin
    intros n hn g,
    suffices : g * (n * g⁻¹) ∈ K,
      { rwa ←group.mul_assoc at this },
    refine h _ _ _, simpa [group.mul_assoc]
  end, .. K } -- The .. tells Lean that we use K for the unfilled fields

-- If K is a normal subgroup of the group G, then the sets of left and right
-- cosets of K in the G coincide
lemma nomal_coset_eq {K : normal G} :
  ∀ g : G, g ⋆ (K : subgroup G) = (K : subgroup G) ⋆ g :=
begin
  -- dsimp,
  -- Without the dsimp it displays weridly,
  -- dsimp not required if we write out right_coset g K however?
  intros g,
  ext, split; intro hx,
    { rcases hx with ⟨k, hk, rfl⟩,
      refine ⟨_, K.2 k hk g, _⟩,
      simp [group.mul_assoc] },
    { rcases hx with ⟨k, hk, rfl⟩,
      refine ⟨_, K.2 k hk g⁻¹, _⟩,
      simp [←group.mul_assoc] }
end

def normal_of_coset_eq {K : subgroup G}
  (h : ∀ g : G, g ⋆ K = K ⋆ g) : normal G :=
{ conj_mem' :=
  begin
    intros n hn g,
    have : ∃ s ∈ K ⋆ g, s = g * n,
      { refine ⟨g * n, _, rfl⟩,
        rw ←h, exact ⟨n, hn, rfl⟩ },
    rcases this with ⟨s, ⟨l, hl₁, hl₂⟩, hs₂⟩,
    rw [←hs₂, hl₂],
    simpa [group.mul_assoc]
  end, .. K}

-- If K is normal then if x ∈ g K and y ∈ h K then x * y ∈ (g * h) K
lemma prod_in_coset_of_normal {K : normal G} {x y g h : G}
  (hx : x ∈ g ⋆ K) (hy : y ∈ h ⋆ K) : x * y ∈ (g * h) ⋆ K :=
begin
  rcases hx with ⟨k₀, hx₁, rfl⟩,
  rcases hy with ⟨k₁, hy₁, rfl⟩,
  refine ⟨h⁻¹ * k₀ * h * k₁, _, _⟩,
    { refine K.1.3 _ hy₁,
      convert K.2 _ hx₁ _, exact (group.inv_inv _).symm },
    { iterate 2 { rw group.mul_assoc },
      rw group.mul_left_cancel_iff g _ _,
      simp [←group.mul_assoc] }
end

def normal_of_prod_in_coset {K : subgroup G}
  (h : ∀ x y g h : G, x ∈ g ⋆ K → y ∈ h ⋆ K → x * y ∈ (g * h) ⋆ K) : normal G :=
{ conj_mem' :=
  begin
    intros n hn g,
    rcases h (g * n) (g⁻¹ * n) g g⁻¹
      ⟨n, hn, rfl⟩ ⟨n, hn, rfl⟩ with ⟨m, hm₀, hm₁⟩,
    rw [←group.mul_right_cancel_iff n⁻¹,
        group.mul_assoc, group.mul_assoc, group.mul_assoc] at hm₁,
    suffices : g * n * g⁻¹ = m * n⁻¹,
      rw this, exact K.mul_mem hm₀ (K.inv_mem hn),
    simp [←group.mul_assoc] at hm₁; assumption
  end, .. K }

end normal

end mygroup


import data.list.basic tactic.linarith
import list.lemmas.long_lemmas

open list

/--Two lists are equal except one entry differs by at most d-/
structure list.modify (A : list ℤ) (B : list ℤ) (d : ℤ) :=
(n : ℕ) --entry in which the lists differ
(ha : n < A.length)
(hb : n < B.length)
(heq : A.remove_nth n = B.remove_nth n) --lists are equal otherwise
(bound : abs (A.nth_le n ha - B.nth_le n hb) ≤ d) -- differing entries differ by at most d

/--reflexivity of list.modify for non-empty lists-/
def list.modify_refl {L : list ℤ } {d : ℤ} (h : 0 < length L) (p : 0 ≤ d): list.modify L L d :=
{ n := 0, -- can choose an arbitrary entry in the list, as they differ by 0 everywhere
  ha := h,
  hb := h,
  heq := by refl,
  bound := begin
           cases L with m M,
             -- L = nil
             exfalso, -- contradicts h : 0 < length L
             exact nat.not_succ_le_zero 0 h,
           -- L = (m :: M)
           rw nth_le, -- get goal abs(m-m) ≤ d
           simp only [abs_zero, add_right_neg, sub_eq_add_neg], -- left side is zero
           exact p,
           end
}

/--Two lists that are equal except one entry differs by at most d have equal length-/
theorem eq_size_of_modify_list {l1 l2 : list ℤ } {d : ℤ} (h : list.modify l1 l2 d) : l1.length = l2.length :=
begin
  -- split list.modify condition into its fields
  cases h,
  -- as the lists below are equal by h_heq, their length must be equal
  have P : length(remove_nth l1 h_n) = length(remove_nth l2 h_n),
    rw h_heq, --which is h.heq
    rw length_remove_nth l1 h_n h_ha at P, /- lemma says, if n < length L , then length (remove_nth L n) =
                                              length L - 1    for any list L, natural number n -/
    rw length_remove_nth l2 h_n h_hb at P,
  --need this for finish to work
  have Q : ¬ h_n < 0,
    simp, -- follows as h.n is a natural number
  /- Now  P gives the result by cancelling -1 on both sides, but this
     only works if both lists have length > 0. Hence split into easy cases
     and let Lean do the rest by itself-/
  cases l1, dsimp at h_ha,
  exfalso, finish,
  cases l2, dsimp at h_hb,
  exfalso, finish,
  finish,
  end

/--Two lists that are equal except one entry differs by at most d are element-
wise equal in all entries except the one at which they differ-/
theorem list.modify_same {A : list ℤ} {B : list ℤ} {d : ℤ}
  (h : list.modify A B d) (m : ℕ) (hmA : m < A.length) (hmB : m < B.length)
  (hmn : h.n ≠ m) : A.nth_le m hmA = B.nth_le m hmB :=
begin
  have H : length A = length B,
    exact eq_size_of_modify_list h,-- exactly the conclusion of the theorem above

  cases h,

  /- rewrite to put h.heq in the form
     take h_n A ++ tail (drop h_n A) = take h_n B ++ tail (drop h_n B) -/
  rw remove_nth_eq_nth_tail at h_heq,
  rw modify_nth_tail_eq_take_drop at h_heq,
  rw remove_nth_eq_nth_tail at h_heq,
  rw modify_nth_tail_eq_take_drop at h_heq,
  /- from this we want to derive that take h_n A = take h_n B and
     tail (drop h_n A) = tail (drop h_n B) ,
     because we will formuate nth_le through head, take and drop later-/
  have p : length (tail (drop h_n A)) = length (tail (drop h_n B)), rw length_tail,
    rw length_tail,
    rw length_drop,
    rw length_drop,
    rw H,
  have h_eq_left : take h_n A = take h_n B ,
    exact append_inj_right' h_heq p,
  have h_eq_right : tail (drop h_n A) = tail (drop h_n B),
    exact append_inj_left' h_heq p,

  rw ← head_reverse_take, rw ← head_reverse_take, --get rid of nth_le

  -- state of first goal : head (reverse (take (m + 1) A)) = head (reverse (take (m + 1) B))

  /-now we need to consider where the lists could have been modified in
    relation to m+1 so we can show both sides give the same entry and it is not the
    modified one-/
  have m_cases : (m+1) ≤ h_n ∨ h_n < (m+1) ,
    exact le_or_lt (m + 1) h_n,

  cases m_cases,
  -- (m+1) ≤ h_n
  rw take_aux_2 m_cases h_eq_left, --solves goal as both sides will be the same
                                   --(for the lemma, see list.lemmas.long_lemmas)

  -- h_n < (m+1)

  /-this time h_eq_right will give the result, because we will use the
    lemma take_drop_head_eq (see list.lemmas.long_lemmas)
    But first we need the necessary assumptions for take_drop_head_eq,
    which will be h1 and hmA/hmB-/
  rw nat.lt_iff_add_one_le at hmA,
  rw nat.lt_iff_add_one_le at hmB,

  have h1 : 1 ≤ m,
  cases m,
    -- m = 0 => goal : 1 ≤ 0
    exfalso,
    have hn_0 : h_n = 0,
      rw nat.lt_add_one_iff at m_cases, -- for all a, b in ℕ, a < b + 1 ↔ a ≤ b
      exact nat.eq_zero_of_le_zero m_cases, -- for all n in ℕ, if n ≤ 0 then n = 0
    exact false.elim (hmn hn_0), --hypotheses exactly contradict each other

    -- goal : 1 ≤ nat.succ m
    exact dec_trivial,

  --now we have all we need to use take_drop_head_eq
  rw take_drop_head_eq h1 hmA,
  rw take_drop_head_eq h1 hmB,

  -- from h_eq_right we can derive the following, which soves the main goal
  have P : tail (drop (m - 1) A) = tail (drop (m - 1) B),
  {
   rw tail_drop, --(see list.lemmas.simple)
   rw tail_drop,
   rw tail_drop at h_eq_right,
   rw tail_drop at h_eq_right,
   -- we want to use drop_lemma. For that we need the following hypothesis
   have h2 : nat.succ h_n ≤ nat.succ (m-1),
     rw nat.succ_le_succ_iff, -- for all m, n in ℕ, succ m ≤ succ n ↔ m ≤ n
     rw nat.lt_add_one_iff at m_cases, -- for all a, b in ℕ, a < b + 1 ↔ a ≤ b
     apply nat.le_pred_of_lt, -- for all m, n in ℕ, if m < n, then m ≤ n - 1
     exact lt_of_le_of_ne' m_cases hmn, -- for all a, b in ℕ, if a ≤ b and a ≠ b, then a < b

   exact drop_aux_2 h2 h_eq_right, --(for the lemma, see list.lemmas.long_lemmas)
  },
  rw P,

  refl, -- trivial assumption needed for modify_nth_tail_eq_take_drop in line 75

  refl, -- same trivial assumption needed for modify_nth_tail_eq_take_drop in line 77

end

/--symmetry of list.modify-/
def list.modify.symm (A B : list ℤ) (d : ℤ)
(m : list.modify A B d) : list.modify B A d :=
{ n := m.n, -- still differ in the same place
  ha := m.hb,
  hb := m.ha,
  heq := m.heq.symm, -- by symmetry of = in m.heq
  bound := by rw [←neg_sub, abs_neg]; exact m.bound -- as abs(a-b) = abs(b-a) for integers a,b
}

/--If you remove the same entry, that is not the modified one from
both modified lists, you get a modified list-/
def list.modify_remove_nth {L1 : list ℤ} {L2 : list ℤ} {d : ℤ}
  (h : list.modify L1 L2 d)  (m : ℕ) (h_neq : m ≠ h.n):
  list.modify (remove_nth L1 m) (remove_nth L2 m) d:=
begin
/-if index m is not in the list, then remove_nth L m = L, for any list L, so
  we can separate into the cases m < length L1 and length L1 ≤ m-/
by_cases hm : m < length L1,
swap, -- we solve the second goal first, because it is easier

-- ¬ (m < length L1)
{push_neg at hm, -- ¬ (m < length L1) is defined as length L1 ≤ m
 have x1 : remove_nth L1 m = L1,
   exact remove_nth_large_n L1 hm,
 rw x1,
 rw (eq_size_of_modify_list h) at hm,
 have x2 : remove_nth L2 m = L2,
   exact remove_nth_large_n L2 hm,
 rw x2,
 exact h,
},

-- m < length L1

/-this time we actually need to prove the existence of all 5 fields of
  list.modify-/
have hlength : length L1 = length L2, -- will need this to get heq
  exact eq_size_of_modify_list h,
cases h, --split h into fields
/-the entry at which the lists differ depends on h_n, where L1 and L2 differ.
  If m is less than h_n, then removing m shifts the index they differ in one
  space to the front. Otherwise, as we assume m ≠ h_n, they also differ in index h_n-/
by_cases hi : m < h_n,
-- m < h_n
{split, --split list.modify goal into a goal for each field
 swap 3,-- swap order of goals, so we can fix n first

 -- FIELD n
{exact (h_n - 1)}, -- as said before, the index is one before h_n

-- FIELD heq
{rw remove_nth_remove_nth, --(see list.lemmas.long_lemmas)
 split_ifs with ite1, --split if-then-else into cases
 /- if-case (named ite1): m < h_n - 1 + 1
    => first goal : remove_nth (remove_nth L1 (h_n - 1 + 1)) m = remove_nth (remove_nth L2 m) (h_n - 1)-/
    {rw nat.sub_add_cancel, -- h_n - 1 + 1 = h_n, if 1 ≤ h_n
      rw h_heq,
      rw remove_nth_remove_nth,
      split_ifs with ite2,
      /- if-case (named ite2): h_n < m + 1
        contradicts hi : m < h_n-/
      exfalso,
      exact nat.lt_le_antisymm ite2 hi, -- a < b and b ≤ a together imply false
      /- else-case (named ite2): ¬ (h_n < m + 1)-/
      refl, -- solves new first goal : remove_nth (remove_nth L2 m) (h_n - 1) = remove_nth (remove_nth L2 m) (h_n - 1)
      exact le_of_lt h_hb, -- gives h_n ≤ length L2, necessary first assumption for second remove_nth_remove_nth
      --new first goal : m + 1 ≤ length L2 (second necessary assumption for second remove_nt_remove_nth)
      rw ← hlength,
      exact hm, -- m < length L1 is definitionally equivalent to m + 1 ≤ length L1
      exact nat.one_le_of_lt hi,  },-- assumption needed for nat.sub_add_cancel, because 0-1 = 0 in ℕ
  /- else-case (named ite1): ¬ (m < h_n - 1 + 1)
    contradicts hi-/
    {
      exfalso,
    rw nat.sub_add_cancel at ite1,
    exact false.elim (ite1 hi),
    exact nat.one_le_of_lt hi,
      },

    {exact le_of_lt hm, },/- lemma says : for all a,b of the same type, a < b implies a ≤ b
                             line proves first necessary assumtion for first remove_nt_remove_nth-/

    --prove second necessary assumption for first remove_nt_remove_nth
    {rw nat.sub_add_cancel,
    exact le_of_lt h_ha,
    exact nat.one_le_of_lt hi,}, -- assumption needed for nat.sub_add_cancel
    },

-- FIELD bound
{have p2 : h_n-1 < h_n, /- will be needed in line 276/277 (proving it here makes this
                           hypothesis hold universally inside these {}-brackets)-/
   cases h_n,
     -- h_n = 0
     exfalso, -- contradicts hi as m ∈ ℕ
     exact nat.not_succ_le_zero m hi,
   -- nat.succ h_n
   exact lt_add_one (nat.succ h_n - 1), -- lemma says: for all a, a < a + 1
 rw nth_le_remove_nth, --(see list.lemmas.long_lemmas)
 rw nth_le_remove_nth,
 split_ifs with ite, --split if-then-else into cases
    /- if-case (named ite): m ≤ h_n - 1
        => first goal : abs (nth_le L1 (h_n - 1 + 1) ?m_1 - nth_le L2 (h_n - 1 + 1) ?m_2) ≤ d
        That is true by h_bound and as h_n - 1 + 1 = h_n-/
    convert h_bound using 1,
    have x : h_n - 1 + 1 = h_n,
      apply nat.sub_add_cancel,
      exact nat.one_le_of_lt hi,
    simp only [x], /- simp only because proofs of existence of indices for nth_le
                      need to be rewritten at the same time -/

    -- proofs of some necessary hypotheses through convert
    rw nat.sub_add_cancel,
    exact h_ha,
    exact nat.one_le_of_lt hi,
    rw ← hlength,
    rw nat.sub_add_cancel,
    exact h_ha,
    exact nat.one_le_of_lt hi,
 /- else-case (named ite): ¬ (m ≤ h_n - 1)
    contradicts hi-/
 exfalso,
 have p : m ≤ h_n -1,
   exact nat.le_pred_of_lt hi, -- lemma says : forall m,n in ℕ, if m < n, then m ≤ n - 1
 exact false.elim (ite p),

 -- proof of some necessary hypotheses from nth_le_remove_nth
 exact lt.trans p2 h_hb,
 exact lt.trans p2 h_ha,

 },

 -- FIELD ha
{rw length_remove_nth,
 cases h_n,
  --h_n = 0
   exfalso,
   exact nat.not_succ_le_zero m hi,
 -- nat.succ h_n
 rw nat.succ_eq_add_one,
 rw nat.add_sub_cancel,
 exact nat.lt_pred_iff.mpr h_ha, -- lemma says: for all n, m in ℕ, n < pred m ↔ succ n < m
 exact hm,
},

-- FIELD hb
{rw length_remove_nth,
 rw ← hlength,
 cases h_n,
   --h_n = 0
   exfalso,
   exact nat.not_succ_le_zero m hi,
 -- nat.succ h_n
 rw nat.succ_eq_add_one,
 rw nat.add_sub_cancel,
 exact nat.lt_pred_iff.mpr h_ha,
 rw ← hlength,
 exact hm,
 },},

 -- hi becomes ¬ (m < h_n)
{have hx : h_n < m, -- because of hi and our initial assumption that m ≠ h_n
   push_neg at hi,
   exact lt_of_le_of_ne hi (ne.symm h_neq),

 split, --split list.modify goal into a goal for each field
 swap 3, -- swap order of goals, so we can fix n first

-- FIELD n
{exact h_n}, /- now we remove an element after h_n, so the position
                of h_n does not change in relation to the beginning of the list-/

-- FIELD heq
{rw remove_nth_remove_nth,
 split_ifs with ite1, --split if-then-else into cases
 /- if-case (named ite1): m < h_n + 1
    contradicts hx-/
 {exfalso,
  exact nat.lt_le_antisymm ite1 hx,
  },
  /- else-case (named ite1): ¬ (m ≤ h_n + 1)
    => first goal : remove_nth (remove_nth L1 h_n) (m - 1) =
                    remove_nth (remove_nth L2 m) h_n
    True by h_heq and changing order of element removal again-/
 {rw h_heq,
 rw remove_nth_remove_nth,
 split_ifs with ite2,
   /- if-case (named ite2): h_n < m - 1 + 1
      => first goal : remove_nth (remove_nth L2 (m - 1 + 1)) h_n =
                      remove_nth (remove_nth L2 m) h_n
    True as 1 ≤ m because of hx abd h_n being a natural number-/
  {rw nat.sub_add_cancel,
  exact nat.one_le_of_lt hx}, -- proves necessary hypothesis for nat.sub_add_cancel
   /- else-case (named ite1): ¬ (h_n < m - 1 + 1)
    contradicts hx-/
  {exfalso,
  rw nat.sub_add_cancel at ite2,
  exact false.elim (ite2 hx),
  exact nat.one_le_of_lt hx, -- proves necessary hypothesis for nat.sub_add_cancel
 },
 -- prove necessary hypotheses for remove_nth_remove_nth
 exact le_of_lt h_hb,
 rw ← hlength,
 rw nat.sub_add_cancel,
 exact le_of_lt hm,
 exact nat.one_le_of_lt hx,
 },
 exact le_of_lt hm,
 exact h_ha,},

 -- FIELD bound
 /- true because the h_n-th element of (remove_nth L1 m) is also
    the h_n-th element of L1 (similarly for L2)-/
  {rw nth_le_remove_nth,
 rw nth_le_remove_nth,
 split_ifs with ite, --split if-then-else into cases
  /- if-case (named ite): m ≤ h_n - 1
     contradicts hx-/
   exfalso,
   exact nat.lt_le_antisymm hx ite,
  /- else-case (named ite): ¬ (m ≤ h_n)
      => first goal : abs (nth_le L1 h_n ?m_1 - nth_le L2 h_n ?m_2) ≤ d
     That is just h_bound-/
 convert h_bound using 1,
-- prove necessary hypotheses for remove_nth_remove_nth
 rw ← hlength,
 exact lt_of_le_of_lt hx hm,
 exact lt_of_le_of_lt hx hm,},

-- FIELD ha
{rw length_remove_nth, /- lemma says, if n < length L , then length (remove_nth L n) = length L - 1
                                      for any list L, natural number n -/
   have p2 : m ≤ length L1 - 1,
     exact nat.le_pred_of_lt hm,
   exact lt_of_lt_of_le hx p2,

   exact hm, --necessary hypothesis for length_remove_nth
},

-- FIELD hb
{rw length_remove_nth,
 rw ← hlength,
 have p2 : m ≤ length L1 - 1,
    exact nat.le_pred_of_lt hm,
 exact lt_of_lt_of_le hx p2,
 --necessary hypothesis for length_remove_nth
 rw ← hlength,
 exact hm,
 },},

end


import tactic --hide
lemma not_iff_imp_false (P : Prop) : ¬ P ↔ P → false := iff.rfl -- hide

/-Hint : Hint
Try using `rw not_iff_imp_false,`.
-/

/-Lemma
If $P$ is a logical statement then $P \implies ¬ ¬P$.
-/
lemma P_not_not_P (P : Prop) : P → ¬ (¬ P) :=
begin
  intro P,
  rw not_iff_imp_false,
  intro hp,
  apply hp,
  exact P,

end


import Mathlib.analysis.normed_space.basic
import Mathlib.topology.local_homeomorph

namespace Mathlib

open filter
open set

namespace asymptotics

macro "∀ᶠ " xs:Lean.explicitBinders " in " l:term "," b:term : term => do
  `($(← Lean.expandExplicitBinders `filter.eventually xs b) $l)

macro "∥ " x:term " ∥" : term => `(norm $x)

-- TODO: Type* syntax
variable {α : Type} {β : Type} {E : Type} {F : Type} {G : Type}
  {E' : Type} {F' : Type} {G' : Type} {R : Type} {R' : Type}

variable [has_norm E] [has_norm F] [has_norm G] [normed_group E'] [normed_group F']
  [normed_group G'] [normed_ring R] [normed_ring R']
  {c c' : ℝ} {f : α → E} {g : α → F} {k : α → G} {f' : α → E'} {g' : α → F'} {k' : α → G'}
  {l l' : filter α}

section defs

def is_O_with (c : ℝ) (f : α → E) (g : α → F) (l : filter α) : Prop :=
  ∀ᶠ x in l, ∥f x∥ ≤ c * ∥g x∥

theorem is_O_with_iff {c : real} {f : α → E} {g : α → F} {l : filter α} :
    is_O_with c f g l ↔ ∀ᶠ x in l, ∥f x∥ ≤ c * ∥g x∥ :=
  iff.rfl

theorem is_O_with.of_bound {c : real} {f : α → E} {g : α → F} {l : filter α}
  (h : ∀ᶠ x in l, ∥f x∥ ≤ c * ∥g x∥) : is_O_with c f g l :=
  h

def is_O (f : α → E) (g : α → F) (l : filter α) : Prop :=
  ∃ c : ℝ, is_O_with c f g l

theorem is_O_iff_is_O_with {f : α → E} {g : α → F} {l : filter α} :
    is_O f g l ↔ ∃ c : ℝ, is_O_with c f g l :=
  iff.rfl

theorem is_O_iff {f : α → E} {g : α → F} {l : filter α} :
    is_O f g l ↔ ∃ c : ℝ, ∀ᶠ x in l, ∥f x∥ ≤ c * ∥g x∥ :=
  iff.rfl

theorem is_O.of_bound (c : ℝ) {f : α → E} {g : α → F} {l : filter α}
    (h : ∀ᶠ x in l, ∥f x∥ ≤ c * ∥g x∥) : is_O f g l :=
  ⟨c, h⟩

def is_o (f : α → E) (g : α → F) (l : filter α) : Prop :=
  ∀ (c : ℝ), 0 < c → is_O_with c f g l

theorem is_o_iff_forall_is_O_with {f : α → E} {g : α → F} {l : filter α} :
    is_o f g l ↔ ∀ (c : ℝ), 0 < c → is_O_with c f g l :=
  iff.rfl

theorem is_o_iff {f : α → E} {g : α → F} {l : filter α} :
    is_o f g l ↔ ∀ (c : ℝ), 0 < c → ∀ᶠ x in l, ∥f x∥ ≤ c * ∥g x∥
  := iff.rfl

theorem is_o.def {f : α → E} {g : α → F} {l : filter α} (h : is_o f g l) {c : ℝ} (hc : 0 < c) :
    ∀ᶠ x in l, ∥f x∥ ≤ c * ∥g x∥ :=
  h _ hc

theorem is_o.def' {f : α → E} {g : α → F} {l : filter α} (h : is_o f g l) {c : ℝ} (hc : 0 < c) :
    is_O_with c f g l :=
  h _ hc

end defs

theorem is_O_with.is_O (h : is_O_with c f g l) : is_O f g l := ⟨c, h⟩

theorem is_o.is_O_with (hgf : is_o f g l) : is_O_with 1 f g l := hgf _ zero_lt_one

theorem is_o.is_O (hgf : is_o f g l) : is_O f g l := hgf.is_O_with.is_O

end asymptotics
end Mathlib


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.measure_space
import Mathlib.measure_theory.borel_space
import Mathlib.topology.opens
import Mathlib.topology.compacts
import Mathlib.PostPort

universes w

namespace Mathlib

/-!
# Contents

In this file we work with *contents*. A content `λ` is a function from a certain class of subsets
(such as the the compact subsets) to `ennreal` (or `ℝ≥0`) that is
* additive: If `K₁` and `K₂` are disjoint sets in the domain of `λ`,
  then `λ(K₁ ∪ K₂) = λ(K₁) + λ(K₂)`;
* subadditive: If `K₁` and `K₂` are in the domain of `λ`, then `λ(K₁ ∪ K₂) ≤ λ(K₁) + λ(K₂)`;
* monotone: If `K₁ ⊆ K₂` are in the domain of `λ`, then `λ(K₁) ≤ λ(K₂)`.

We show that:
* Given a content `λ` on compact sets, we get a countably subadditive map that vanishes at `∅`.
  In Halmos (1950) this is called the *inner content* `λ*` of `λ`.
* Given an inner content, we define an outer measure.

We don't explicitly define the type of contents.
In this file we only work on contents on compact sets, and inner contents on open sets, and both
contents and inner contents map into the extended nonnegative reals. However, in other applications
other choices can be made, and it is not a priori clear what the best interface should be.

## Main definitions
* `measure_theory.inner_content`: define an inner content from an content
* `measure_theory.outer_measure.of_content`: construct an outer measure from a content

## References

* Paul Halmos (1950), Measure Theory, §53
* https://en.wikipedia.org/wiki/Content_(measure_theory)
-/

namespace measure_theory

/-- Constructing the inner content of a content. From a content defined on the compact sets, we
  obtain a function defined on all open sets, by taking the supremum of the content of all compact
  subsets. -/
def inner_content {G : Type w} [topological_space G] (μ : topological_space.compacts G → ennreal)
    (U : topological_space.opens G) : ennreal :=
  supr fun (K : topological_space.compacts G) => supr fun (h : subtype.val K ⊆ ↑U) => μ K

theorem le_inner_content {G : Type w} [topological_space G]
    {μ : topological_space.compacts G → ennreal} (K : topological_space.compacts G)
    (U : topological_space.opens G) (h2 : subtype.val K ⊆ ↑U) : μ K ≤ inner_content μ U :=
  le_supr_of_le K (le_supr (fun (h2 : subtype.val K ⊆ ↑U) => μ K) h2)

theorem inner_content_le {G : Type w} [topological_space G]
    {μ : topological_space.compacts G → ennreal}
    (h : ∀ (K₁ K₂ : topological_space.compacts G), subtype.val K₁ ⊆ subtype.val K₂ → μ K₁ ≤ μ K₂)
    (U : topological_space.opens G) (K : topological_space.compacts G) (h2 : ↑U ⊆ subtype.val K) :
    inner_content μ U ≤ μ K :=
  bsupr_le
    fun (K' : topological_space.compacts G) (hK' : subtype.val K' ⊆ ↑U) =>
      h K' K (set.subset.trans hK' h2)

theorem inner_content_of_is_compact {G : Type w} [topological_space G]
    {μ : topological_space.compacts G → ennreal}
    (h : ∀ (K₁ K₂ : topological_space.compacts G), subtype.val K₁ ⊆ subtype.val K₂ → μ K₁ ≤ μ K₂)
    {K : set G} (h1K : is_compact K) (h2K : is_open K) :
    inner_content μ { val := K, property := h2K } = μ { val := K, property := h1K } :=
  sorry

theorem inner_content_empty {G : Type w} [topological_space G]
    {μ : topological_space.compacts G → ennreal} (h : μ ⊥ = 0) : inner_content μ ∅ = 0 :=
  sorry

/-- This is "unbundled", because that it required for the API of `induced_outer_measure`. -/
theorem inner_content_mono {G : Type w} [topological_space G]
    {μ : topological_space.compacts G → ennreal} {U : set G} {V : set G} (hU : is_open U)
    (hV : is_open V) (h2 : U ⊆ V) :
    inner_content μ { val := U, property := hU } ≤ inner_content μ { val := V, property := hV } :=
  supr_le_supr
    fun (K : topological_space.compacts G) =>
      supr_le_supr_const
        fun (hK : subtype.val K ⊆ ↑{ val := U, property := hU }) => set.subset.trans hK h2

theorem inner_content_exists_compact {G : Type w} [topological_space G]
    {μ : topological_space.compacts G → ennreal} {U : topological_space.opens G}
    (hU : inner_content μ U < ⊤) {ε : nnreal} (hε : 0 < ε) :
    ∃ (K : topological_space.compacts G), subtype.val K ⊆ ↑U ∧ inner_content μ U ≤ μ K + ↑ε :=
  sorry

/-- The inner content of a supremum of opens is at most the sum of the individual inner
contents. -/
theorem inner_content_Sup_nat {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} (h1 : μ ⊥ = 0)
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
    (U : ℕ → topological_space.opens G) :
    inner_content μ (supr fun (i : ℕ) => U i) ≤ tsum fun (i : ℕ) => inner_content μ (U i) :=
  sorry

/-- The inner content of a union of sets is at most the sum of the individual inner contents.
  This is the "unbundled" version of `inner_content_Sup_nat`.
  It required for the API of `induced_outer_measure`. -/
theorem inner_content_Union_nat {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} (h1 : μ ⊥ = 0)
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂) {U : ℕ → set G}
    (hU : ∀ (i : ℕ), is_open (U i)) :
    inner_content μ { val := set.Union fun (i : ℕ) => U i, property := is_open_Union hU } ≤
        tsum fun (i : ℕ) => inner_content μ { val := U i, property := hU i } :=
  sorry

theorem inner_content_comap {G : Type w} [topological_space G]
    {μ : topological_space.compacts G → ennreal} (f : G ≃ₜ G)
    (h :
      ∀ {K : topological_space.compacts G},
        μ (topological_space.compacts.map (⇑f) (homeomorph.continuous f) K) = μ K)
    (U : topological_space.opens G) :
    inner_content μ (topological_space.opens.comap (homeomorph.continuous f) U) =
        inner_content μ U :=
  sorry

theorem is_mul_left_invariant_inner_content {G : Type w} [topological_space G] [group G]
    [topological_group G] {μ : topological_space.compacts G → ennreal}
    (h :
      ∀ (g : G) {K : topological_space.compacts G},
        μ (topological_space.compacts.map (fun (b : G) => g * b) (continuous_mul_left g) K) = μ K)
    (g : G) (U : topological_space.opens G) :
    inner_content μ (topological_space.opens.comap (continuous_mul_left g) U) = inner_content μ U :=
  sorry

-- @[to_additive] (fails for now)

theorem inner_content_pos_of_is_mul_left_invariant {G : Type w} [topological_space G] [t2_space G]
    [group G] [topological_group G] {μ : topological_space.compacts G → ennreal} (h1 : μ ⊥ = 0)
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
    (h3 :
      ∀ (g : G) {K : topological_space.compacts G},
        μ (topological_space.compacts.map (fun (b : G) => g * b) (continuous_mul_left g) K) = μ K)
    (K : topological_space.compacts G) (hK : 0 < μ K) (U : topological_space.opens G)
    (hU : set.nonempty ↑U) : 0 < inner_content μ U :=
  sorry

theorem inner_content_mono' {G : Type w} [topological_space G]
    {μ : topological_space.compacts G → ennreal} {U : set G} {V : set G} (hU : is_open U)
    (hV : is_open V) (h2 : U ⊆ V) :
    inner_content μ { val := U, property := hU } ≤ inner_content μ { val := V, property := hV } :=
  supr_le_supr
    fun (K : topological_space.compacts G) =>
      supr_le_supr_const
        fun (hK : subtype.val K ⊆ ↑{ val := U, property := hU }) => set.subset.trans hK h2

namespace outer_measure

/-- Extending a content on compact sets to an outer measure on all sets. -/
def of_content {G : Type w} [topological_space G] [t2_space G]
    (μ : topological_space.compacts G → ennreal) (h1 : μ ⊥ = 0) : outer_measure G :=
  induced_outer_measure
    (fun (U : set G) (hU : is_open U) => inner_content μ { val := U, property := hU }) is_open_empty
    (inner_content_empty h1)

theorem of_content_opens {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
    (U : topological_space.opens G) : coe_fn (of_content μ h1) ↑U = inner_content μ U :=
  induced_outer_measure_eq' (fun (_x : ℕ → set G) => is_open_Union) (inner_content_Union_nat h1 h2)
    inner_content_mono (subtype.property U)

theorem of_content_le {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
    (h : ∀ (K₁ K₂ : topological_space.compacts G), subtype.val K₁ ⊆ subtype.val K₂ → μ K₁ ≤ μ K₂)
    (U : topological_space.opens G) (K : topological_space.compacts G) (hUK : ↑U ⊆ subtype.val K) :
    coe_fn (of_content μ h1) ↑U ≤ μ K :=
  has_le.le.trans (eq.le (of_content_opens h2 U)) (inner_content_le h U K hUK)

theorem le_of_content_compacts {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
    (K : topological_space.compacts G) : μ K ≤ coe_fn (of_content μ h1) (subtype.val K) :=
  sorry

theorem of_content_eq_infi {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂) (A : set G) :
    coe_fn (of_content μ h1) A =
        infi
          fun (U : set G) =>
            infi
              fun (hU : is_open U) =>
                infi fun (h : A ⊆ U) => inner_content μ { val := U, property := hU } :=
  induced_outer_measure_eq_infi is_open_Union (inner_content_Union_nat h1 h2) inner_content_mono A

theorem of_content_interior_compacts {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
    (h3 : ∀ (K₁ K₂ : topological_space.compacts G), subtype.val K₁ ⊆ subtype.val K₂ → μ K₁ ≤ μ K₂)
    (K : topological_space.compacts G) :
    coe_fn (of_content μ h1) (interior (subtype.val K)) ≤ μ K :=
  le_trans (le_of_eq (of_content_opens h2 (topological_space.opens.interior (subtype.val K))))
    (inner_content_le h3 (topological_space.opens.interior (subtype.val K)) K interior_subset)

theorem of_content_exists_compact {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
    {U : topological_space.opens G} (hU : coe_fn (of_content μ h1) ↑U < ⊤) {ε : nnreal}
    (hε : 0 < ε) :
    ∃ (K : topological_space.compacts G),
        subtype.val K ⊆ ↑U ∧
          coe_fn (of_content μ h1) ↑U ≤ coe_fn (of_content μ h1) (subtype.val K) + ↑ε :=
  sorry

theorem of_content_exists_open {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂) {A : set G}
    (hA : coe_fn (of_content μ h1) A < ⊤) {ε : nnreal} (hε : 0 < ε) :
    ∃ (U : topological_space.opens G),
        A ⊆ ↑U ∧ coe_fn (of_content μ h1) ↑U ≤ coe_fn (of_content μ h1) A + ↑ε :=
  sorry

theorem of_content_preimage {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂) (f : G ≃ₜ G)
    (h :
      ∀ {K : topological_space.compacts G},
        μ (topological_space.compacts.map (⇑f) (homeomorph.continuous f) K) = μ K)
    (A : set G) : coe_fn (of_content μ h1) (⇑f ⁻¹' A) = coe_fn (of_content μ h1) A :=
  sorry

theorem is_mul_left_invariant_of_content {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂) [group G]
    [topological_group G]
    (h :
      ∀ (g : G) {K : topological_space.compacts G},
        μ (topological_space.compacts.map (fun (b : G) => g * b) (continuous_mul_left g) K) = μ K)
    (g : G) (A : set G) :
    coe_fn (of_content μ h1) ((fun (h : G) => g * h) ⁻¹' A) = coe_fn (of_content μ h1) A :=
  sorry

theorem of_content_caratheodory {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂) (A : set G) :
    measurable_space.is_measurable' (outer_measure.caratheodory (of_content μ h1)) A ↔
        ∀ (U : topological_space.opens G),
          coe_fn (of_content μ h1) (↑U ∩ A) + coe_fn (of_content μ h1) (↑U \ A) ≤
            coe_fn (of_content μ h1) ↑U :=
  sorry

-- @[to_additive] (fails for now)

theorem of_content_pos_of_is_mul_left_invariant {G : Type w} [topological_space G] [t2_space G]
    {μ : topological_space.compacts G → ennreal} {h1 : μ ⊥ = 0}
    (h2 : ∀ (K₁ K₂ : topological_space.compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂) [group G]
    [topological_group G]
    (h3 :
      ∀ (g : G) {K : topological_space.compacts G},
        μ (topological_space.compacts.map (fun (b : G) => g * b) (continuous_mul_left g) K) = μ K)
    (K : topological_space.compacts G) (hK : 0 < μ K) {U : set G} (h1U : is_open U)
    (h2U : set.nonempty U) : 0 < coe_fn (of_content μ h1) U :=
  sorry

end Mathlib


-- Eliminación de la implicación en Lean
-- =====================================

-- Demostrar que si se tiene (P → Q) y P,
-- entonces se tiene Q.

import tactic
variables (P Q : Prop)

-- 1ª demostración
example
  (h1 : P → Q)
  (h2 : P)
  : Q :=
begin
  apply h1,
  exact h2,
end

-- 2ª demostración
example
  (h1 : P → Q)
  (h2 : P)
  : Q :=
begin
  exact h1 h2,
end

-- 3ª demostración
example
  (h1 : P → Q)
  (h2 : P)
  : Q :=
by exact h1 h2

-- 4ª demostración
example
  (h1 : P → Q)
  (h2 : P)
  : Q :=
h1 h2

-- 5ª demostración
example
  (h1 : P → Q)
  (h2 : P)
  : Q :=
by tauto

-- 6ª demostración
example
  (h1 : P → Q)
  (h2 : P)
  : Q :=
by finish

-- 7ª demostración
example
  (h1 : P → Q)
  (h2 : P)
  : Q :=
by solve_by_elim


import smt2

lemma negation_of_conj :
    forall (P Q : Prop),
        not (P ∧ Q) ↔ not P ∨ not Q :=
by intros; z3 "d1.log"

lemma negation_of_disj :
    forall (P Q : Prop),
        ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q :=
begin
    intros, z3
end

#print negation_of_conj
#print negation_of_disj


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

! This file was ported from Lean 3 source module algebra.free_algebra
! leanprover-community/mathlib commit 6623e6af705e97002a9054c1c05a980180276fc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Subalgebra.Basic
import Mathlib.Algebra.MonoidAlgebra.Basic
import Mathlib.Algebra.Free

/-!
# Free Algebras

Given a commutative semiring `R`, and a type `X`, we construct the free unital, associative
`R`-algebra on `X`.

## Notation

1. `FreeAlgebra R X` is the free algebra itself. It is endowed with an `R`-algebra structure.
2. `FreeAlgebra.ι R` is the function `X → FreeAlgebra R X`.
3. Given a function `f : X → A` to an R-algebra `A`, `lift R f` is the lift of `f` to an
  `R`-algebra morphism `FreeAlgebra R X → A`.

## Theorems

1. `ι_comp_lift` states that the composition `(lift R f) ∘ (ι R)` is identical to `f`.
2. `lift_unique` states that whenever an R-algebra morphism `g : FreeAlgebra R X → A` is
  given whose composition with `ι R` is `f`, then one has `g = lift R f`.
3. `hom_ext` is a variant of `lift_unique` in the form of an extensionality theorem.
4. `lift_comp_ι` is a combination of `ι_comp_lift` and `lift_unique`. It states that the lift
  of the composition of an algebra morphism with `ι` is the algebra morphism itself.
5. `equivMonoidAlgebraFreeMonoid : FreeAlgebra R X ≃ₐ[R] MonoidAlgebra R (FreeMonoid X)`
6. An inductive principle `induction`.

## Implementation details

We construct the free algebra on `X` as a quotient of an inductive type `FreeAlgebra.Pre` by an
inductively defined relation `FreeAlgebra.Rel`. Explicitly, the construction involves three steps:
1. We construct an inductive type `FreeAlgebra.Pre R X`, the terms of which should be thought
  of as representatives for the elements of `FreeAlgebra R X`.
  It is the free type with maps from `R` and `X`, and with two binary operations `add` and `mul`.
2. We construct an inductive relation `FreeAlgebra.Rel R X` on `FreeAlgebra.Pre R X`.
  This is the smallest relation for which the quotient is an `R`-algebra where addition resp.
  multiplication are induced by `add` resp. `mul` from 1., and for which the map from `R` is the
  structure map for the algebra.
3. The free algebra `FreeAlgebra R X` is the quotient of `FreeAlgebra.Pre R X` by
  the relation `FreeAlgebra.Rel R X`.
-/

variable (R : Type _) [CommSemiring R]

variable (X : Type _)

namespace FreeAlgebra

/-- This inductive type is used to express representatives of the free algebra.
-/
inductive Pre
  | of : X → Pre
  | of_scalar : R → Pre
  | add : Pre → Pre → Pre
  | mul : Pre → Pre → Pre
#align free_algebra.pre FreeAlgebra.Pre

namespace Pre

instance : Inhabited (Pre R X) := ⟨of_scalar 0⟩

-- Note: These instances are only used to simplify the notation.
/-- Coercion from `X` to `Pre R X`. Note: Used for notation only. -/
def hasCoeGenerator : Coe X (Pre R X) := ⟨of⟩
#align free_algebra.pre.has_coe_generator FreeAlgebra.Pre.hasCoeGenerator

/-- Coercion from `R` to `Pre R X`. Note: Used for notation only. -/
def hasCoeSemiring : Coe R (Pre R X) := ⟨of_scalar⟩
#align free_algebra.pre.has_coe_semiring FreeAlgebra.Pre.hasCoeSemiring

/-- Multiplication in `Pre R X` defined as `Pre.mul`. Note: Used for notation only. -/
def hasMul : Mul (Pre R X) := ⟨mul⟩
#align free_algebra.pre.has_mul FreeAlgebra.Pre.hasMul

/-- Addition in `Pre R X` defined as `Pre.add`. Note: Used for notation only. -/
def hasAdd : Add (Pre R X) := ⟨add⟩
#align free_algebra.pre.has_add FreeAlgebra.Pre.hasAdd

/-- Zero in `Pre R X` defined as the image of `0` from `R`. Note: Used for notation only. -/
def hasZero : Zero (Pre R X) := ⟨of_scalar 0⟩
#align free_algebra.pre.has_zero FreeAlgebra.Pre.hasZero

/-- One in `Pre R X` defined as the image of `1` from `R`. Note: Used for notation only. -/
def hasOne : One (Pre R X) := ⟨of_scalar 1⟩
#align free_algebra.pre.has_one FreeAlgebra.Pre.hasOne

/-- Scalar multiplication defined as multiplication by the image of elements from `R`.
Note: Used for notation only.
-/
def hasSmul : SMul R (Pre R X) := ⟨fun r m ↦ mul (of_scalar r) m⟩
#align free_algebra.pre.has_smul FreeAlgebra.Pre.hasSmul

end Pre

attribute [local instance] Pre.hasCoeGenerator Pre.hasCoeSemiring Pre.hasMul Pre.hasAdd
  Pre.hasZero Pre.hasOne Pre.hasSmul

/-- Given a function from `X` to an `R`-algebra `A`, `lift_fun` provides a lift of `f` to a function
from `Pre R X` to `A`. This is mainly used in the construction of `FreeAlgebra.lift`.
-/
-- Porting note: recOn was replaced to preserve computability, see lean4#2049
def liftFun {A : Type _} [Semiring A] [Algebra R A] (f : X → A) :
    Pre R X → A
  | .of t => f t
  | .add a b => liftFun f a + liftFun f b
  | .mul a b => liftFun f a * liftFun f b
  | .of_scalar c => algebraMap _ _ c
#align free_algebra.lift_fun FreeAlgebra.liftFun

/-- An inductively defined relation on `Pre R X` used to force the initial algebra structure on
the associated quotient.
-/
inductive Rel : Pre R X → Pre R X → Prop-- force `of_scalar` to be a central semiring morphism

  | add_scalar {r s : R} : Rel (↑(r + s)) (↑r + ↑s)
  | mul_scalar {r s : R} : Rel (↑(r * s)) (↑r * ↑s)
  | central_scalar {r : R} {a : Pre R X} : Rel (r * a) (a * r)-- commutative additive semigroup

  | add_assoc {a b c : Pre R X} : Rel (a + b + c) (a + (b + c))
  | add_comm {a b : Pre R X} : Rel (a + b) (b + a)
  | zero_add {a : Pre R X} : Rel (0 + a) a-- multiplicative monoid

  | mul_assoc {a b c : Pre R X} : Rel (a * b * c) (a * (b * c))
  | one_mul {a : Pre R X} : Rel (1 * a) a
  | mul_one {a : Pre R X} : Rel (a * 1) a-- distributivity

  | left_distrib {a b c : Pre R X} : Rel (a * (b + c)) (a * b + a * c)
  | right_distrib {a b c : Pre R X} :
      Rel ((a + b) * c) (a * c + b * c)-- other relations needed for semiring

  | MulZeroClass.zero_mul {a : Pre R X} : Rel (0 * a) 0
  | MulZeroClass.mul_zero {a : Pre R X} : Rel (a * 0) 0-- compatibility

  | add_compat_left {a b c : Pre R X} : Rel a b → Rel (a + c) (b + c)
  | add_compat_right {a b c : Pre R X} : Rel a b → Rel (c + a) (c + b)
  | mul_compat_left {a b c : Pre R X} : Rel a b → Rel (a * c) (b * c)
  | mul_compat_right {a b c : Pre R X} : Rel a b → Rel (c * a) (c * b)
#align free_algebra.rel FreeAlgebra.Rel

end FreeAlgebra

/-- The free algebra for the type `X` over the commutative semiring `R`.
-/
def FreeAlgebra :=
  Quot (FreeAlgebra.Rel R X)
#align free_algebra FreeAlgebra

namespace FreeAlgebra

attribute [local instance] Pre.hasCoeGenerator Pre.hasCoeSemiring Pre.hasMul Pre.hasAdd
  Pre.hasZero Pre.hasOne Pre.hasSmul

instance : Semiring (FreeAlgebra R X) where
  add := Quot.map₂ (· + ·) (fun _ _ _ ↦ Rel.add_compat_right) fun _ _ _ ↦ Rel.add_compat_left
  add_assoc := by
    rintro ⟨⟩ ⟨⟩ ⟨⟩
    exact Quot.sound Rel.add_assoc
  zero := Quot.mk _ 0
  zero_add := by
    rintro ⟨⟩
    exact Quot.sound Rel.zero_add
  add_zero := by
    rintro ⟨⟩
    change Quot.mk _ _ = _
    rw [Quot.sound Rel.add_comm, Quot.sound Rel.zero_add]
  add_comm := by
    rintro ⟨⟩ ⟨⟩
    exact Quot.sound Rel.add_comm
  mul := Quot.map₂ (· * ·) (fun _ _ _ ↦ Rel.mul_compat_right) fun _ _ _ ↦ Rel.mul_compat_left
  mul_assoc := by
    rintro ⟨⟩ ⟨⟩ ⟨⟩
    exact Quot.sound Rel.mul_assoc
  one := Quot.mk _ 1
  one_mul := by
    rintro ⟨⟩
    exact Quot.sound Rel.one_mul
  mul_one := by
    rintro ⟨⟩
    exact Quot.sound Rel.mul_one
  left_distrib := by
    rintro ⟨⟩ ⟨⟩ ⟨⟩
    exact Quot.sound Rel.left_distrib
  right_distrib := by
    rintro ⟨⟩ ⟨⟩ ⟨⟩
    exact Quot.sound Rel.right_distrib
  zero_mul := by
    rintro ⟨⟩
    exact Quot.sound Rel.MulZeroClass.zero_mul
  mul_zero := by
    rintro ⟨⟩
    exact Quot.sound Rel.MulZeroClass.mul_zero

instance : Inhabited (FreeAlgebra R X) :=
  ⟨0⟩

instance : SMul R (FreeAlgebra R X) where
  smul r := Quot.map ((· * ·) ↑r) fun _ _ ↦ Rel.mul_compat_right

instance : Algebra R (FreeAlgebra R X) where
  toFun r := Quot.mk _ r
  map_one' := rfl
  map_mul' _ _ := Quot.sound Rel.mul_scalar
  map_zero' := rfl
  map_add' _ _ := Quot.sound Rel.add_scalar
  commutes' _ := by
    rintro ⟨⟩
    exact Quot.sound Rel.central_scalar
  smul_def' _ _ := rfl

instance {S : Type _} [CommRing S] : Ring (FreeAlgebra S X) :=
  Algebra.semiringToRing S

variable {X}

/-- The canonical function `X → FreeAlgebra R X`.
-/
irreducible_def ι : X → FreeAlgebra R X := fun m ↦ Quot.mk _ m
#align free_algebra.ι FreeAlgebra.ι

@[simp]

variable {A : Type _} [Semiring A] [Algebra R A]

/-- Internal definition used to define `lift` -/
private def liftAux (f : X → A) : FreeAlgebra R X →ₐ[R] A where
  toFun a :=
    Quot.liftOn a (liftFun _ _ f) fun a b h ↦
      by
      induction' h
      · exact (algebraMap R A).map_add _ _
      · exact (algebraMap R A).map_mul _ _
      · apply Algebra.commutes
      · change _ + _ + _ = _ + (_ + _)
        rw [add_assoc]
      · change _ + _ = _ + _
        rw [add_comm]
      · change algebraMap _ _ _ + liftFun R X f _ = liftFun R X f _
        simp
      · change _ * _ * _ = _ * (_ * _)
        rw [mul_assoc]
      · change algebraMap _ _ _ * liftFun R X f _ = liftFun R X f _
        simp
      · change liftFun R X f _ * algebraMap _ _ _ = liftFun R X f _
        simp
      · change _ * (_ + _) = _ * _ + _ * _
        rw [left_distrib]
      · change (_ + _) * _ = _ * _ + _ * _
        rw [right_distrib]
      · change algebraMap _ _ _ * _ = algebraMap _ _ _
        simp
      · change _ * algebraMap _ _ _ = algebraMap _ _ _
        simp
      repeat
        change liftFun R X f _ + liftFun R X f _ =  _
        simp only [*]
        rfl
      repeat
        change liftFun R X f _ * liftFun R X f _ = _
        simp only [*]
        rfl
  map_one' := by
    change algebraMap _ _ _ = _
    simp
  map_mul' := by
    rintro ⟨⟩ ⟨⟩
    rfl
  map_zero' := by
    dsimp
    change algebraMap _ _ _ = _
    simp
  map_add' := by
    rintro ⟨⟩ ⟨⟩
    rfl
  commutes' := by tauto
-- Porting note: removed #align declaration since it is a private lemma

/-- Given a function `f : X → A` where `A` is an `R`-algebra, `lift R f` is the unique lift
of `f` to a morphism of `R`-algebras `FreeAlgebra R X → A`.
-/
@[irreducible]
def lift : (X → A) ≃ (FreeAlgebra R X →ₐ[R] A) :=
  { toFun := liftAux R
    invFun := fun F ↦ F ∘ ι R
    left_inv := fun f ↦ by
      ext
      simp only [Function.comp_apply, ι_def]
      rfl
    right_inv := fun F ↦ by
      ext t
      rcases t with ⟨x⟩
      induction x
      case of =>
        change ((F : FreeAlgebra R X → A) ∘ ι R) _ = _
        simp only [Function.comp_apply, ι_def]
      case of_scalar x =>
        change algebraMap _ _ x = F (algebraMap _ _ x)
        rw [AlgHom.commutes F _]
      case add a b ha hb =>
        -- Porting note: it is necessary to declare fa and fb explicitely otherwise Lean refuses
        -- to consider `Quot.mk (Rel R X) ·` as element of FreeAlgebra R X
        let fa : FreeAlgebra R X := Quot.mk (Rel R X) a
        let fb : FreeAlgebra R X := Quot.mk (Rel R X) b
        change liftAux R (F ∘ ι R) (fa + fb) = F (fa + fb)
        rw [AlgHom.map_add, AlgHom.map_add, ha, hb]
      case mul a b ha hb =>
        let fa : FreeAlgebra R X := Quot.mk (Rel R X) a
        let fb : FreeAlgebra R X := Quot.mk (Rel R X) b
        change liftAux R (F ∘ ι R) (fa * fb) = F (fa * fb)
        rw [AlgHom.map_mul, AlgHom.map_mul, ha, hb] }
#align free_algebra.lift FreeAlgebra.lift

@[simp]
theorem liftAux_eq (f : X → A) : liftAux R f = lift R f := by
  rw [lift]
  rfl
#align free_algebra.lift_aux_eq FreeAlgebra.liftAux_eq

@[simp]
theorem lift_symm_apply (F : FreeAlgebra R X →ₐ[R] A) : (lift R).symm F = F ∘ ι R := by
  rw [lift]
  rfl
#align free_algebra.lift_symm_apply FreeAlgebra.lift_symm_apply

variable {R}

@[simp]
theorem ι_comp_lift (f : X → A) : (lift R f : FreeAlgebra R X → A) ∘ ι R = f := by
  ext
  rw [Function.comp_apply, ι_def, lift]
  rfl
#align free_algebra.ι_comp_lift FreeAlgebra.ι_comp_lift

@[simp]
theorem lift_ι_apply (f : X → A) (x) : lift R f (ι R x) = f x := by
  rw [ι_def, lift]
  rfl
#align free_algebra.lift_ι_apply FreeAlgebra.lift_ι_apply

@[simp]
theorem lift_unique (f : X → A) (g : FreeAlgebra R X →ₐ[R] A) :
    (g : FreeAlgebra R X → A) ∘ ι R = f ↔ g = lift R f := by
  rw [← (lift R).symm_apply_eq, lift]
  rfl
#align free_algebra.lift_unique FreeAlgebra.lift_unique

/-!
Since we have set the basic definitions as `@[Irreducible]`, from this point onwards one
should only use the universal properties of the free algebra, and consider the actual implementation
as a quotient of an inductive type as completely hidden. -/

-- Marking `FreeAlgebra` irreducible makes `Ring` instances inaccessible on quotients.
-- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/algebra.2Esemiring_to_ring.20breaks.20semimodule.20typeclass.20lookup/near/212580241
-- For now, we avoid this by not marking it irreducible.
@[simp]
theorem lift_comp_ι (g : FreeAlgebra R X →ₐ[R] A) : lift R ((g : FreeAlgebra R X → A) ∘ ι R) = g :=
  by
  rw [← lift_symm_apply]
  exact (lift R).apply_symm_apply g
#align free_algebra.lift_comp_ι FreeAlgebra.lift_comp_ι

/-- See note [partially-applied ext lemmas]. -/
@[ext high]
theorem hom_ext {f g : FreeAlgebra R X →ₐ[R] A}
    (w : (f : FreeAlgebra R X → A) ∘ ι R = (g : FreeAlgebra R X → A) ∘ ι R) : f = g := by
  rw [← lift_symm_apply, ← lift_symm_apply] at w
  exact (lift R).symm.injective w
#align free_algebra.hom_ext FreeAlgebra.hom_ext

/-- The free algebra on `X` is "just" the monoid algebra on the free monoid on `X`.

This would be useful when constructing linear maps out of a free algebra,
for example.
-/
noncomputable def equivMonoidAlgebraFreeMonoid :
    FreeAlgebra R X ≃ₐ[R] MonoidAlgebra R (FreeMonoid X) :=
  AlgEquiv.ofAlgHom (lift R fun x ↦ (MonoidAlgebra.of R (FreeMonoid X)) (FreeMonoid.of x))
    ((MonoidAlgebra.lift R (FreeMonoid X) (FreeAlgebra R X)) (FreeMonoid.lift (ι R)))
    (by
      apply MonoidAlgebra.algHom_ext; intro x
      refine FreeMonoid.recOn x ?_ ?_
      · simp
        rfl
      · intro x y ih
        simp at ih
        simp [ih])
    (by
      ext
      simp)
#align free_algebra.equiv_monoid_algebra_free_monoid FreeAlgebra.equivMonoidAlgebraFreeMonoid

instance [Nontrivial R] : Nontrivial (FreeAlgebra R X) :=
  equivMonoidAlgebraFreeMonoid.surjective.nontrivial

section

/-- The left-inverse of `algebraMap`. -/
def algebraMapInv : FreeAlgebra R X →ₐ[R] R :=
  lift R (0 : X → R)
#align free_algebra.algebra_map_inv FreeAlgebra.algebraMapInv

theorem algebraMap_leftInverse :
    Function.LeftInverse algebraMapInv (algebraMap R <| FreeAlgebra R X) := fun x ↦ by
  simp [algebraMapInv]
#align free_algebra.algebra_map_left_inverse FreeAlgebra.algebraMap_leftInverse

@[simp]
theorem algebraMap_inj (x y : R) :
    algebraMap R (FreeAlgebra R X) x = algebraMap R (FreeAlgebra R X) y ↔ x = y :=
  algebraMap_leftInverse.injective.eq_iff
#align free_algebra.algebra_map_inj FreeAlgebra.algebraMap_inj

@[simp]
theorem algebraMap_eq_zero_iff (x : R) : algebraMap R (FreeAlgebra R X) x = 0 ↔ x = 0 :=
  map_eq_zero_iff (algebraMap _ _) algebraMap_leftInverse.injective
#align free_algebra.algebra_map_eq_zero_iff FreeAlgebra.algebraMap_eq_zero_iff

@[simp]
theorem algebraMap_eq_one_iff (x : R) : algebraMap R (FreeAlgebra R X) x = 1 ↔ x = 1 :=
  map_eq_one_iff (algebraMap _ _) algebraMap_leftInverse.injective
#align free_algebra.algebra_map_eq_one_iff FreeAlgebra.algebraMap_eq_one_iff

-- this proof is copied from the approach in `FreeAbelianGroup.of_injective`
theorem ι_injective [Nontrivial R] : Function.Injective (ι R : X → FreeAlgebra R X) :=
  fun x y hoxy ↦
  by_contradiction <| by
    classical exact fun hxy : x ≠ y ↦
        let f : FreeAlgebra R X →ₐ[R] R := lift R fun z ↦ if x = z then (1 : R) else 0
        have hfx1 : f (ι R x) = 1 := (lift_ι_apply _ _).trans <| if_pos rfl
        have hfy1 : f (ι R y) = 1 := hoxy ▸ hfx1
        have hfy0 : f (ι R y) = 0 := (lift_ι_apply _ _).trans <| if_neg hxy
        one_ne_zero <| hfy1.symm.trans hfy0
#align free_algebra.ι_injective FreeAlgebra.ι_injective

@[simp]
theorem ι_inj [Nontrivial R] (x y : X) : ι R x = ι R y ↔ x = y :=
  ι_injective.eq_iff
#align free_algebra.ι_inj FreeAlgebra.ι_inj

@[simp]
theorem ι_ne_algebraMap [Nontrivial R] (x : X) (r : R) : ι R x ≠ algebraMap R _ r := fun h ↦ by
  let f0 : FreeAlgebra R X →ₐ[R] R := lift R 0
  let f1 : FreeAlgebra R X →ₐ[R] R := lift R 1
  have hf0 : f0 (ι R x) = 0 := lift_ι_apply _ _
  have hf1 : f1 (ι R x) = 1 := lift_ι_apply _ _
  rw [h, f0.commutes, Algebra.id.map_eq_self] at hf0
  rw [h, f1.commutes, Algebra.id.map_eq_self] at hf1
  exact zero_ne_one (hf0.symm.trans hf1)
#align free_algebra.ι_ne_algebra_map FreeAlgebra.ι_ne_algebraMap

@[simp]
theorem ι_ne_zero [Nontrivial R] (x : X) : ι R x ≠ 0 :=
  ι_ne_algebraMap x 0
#align free_algebra.ι_ne_zero FreeAlgebra.ι_ne_zero

@[simp]
theorem ι_ne_one [Nontrivial R] (x : X) : ι R x ≠ 1 :=
  ι_ne_algebraMap x 1
#align free_algebra.ι_ne_one FreeAlgebra.ι_ne_one

end

end FreeAlgebra

/- There is something weird in the above namespace that breaks the typeclass resolution of
`CoeSort` below. Closing it and reopening it fixes it... -/
namespace FreeAlgebra

/-- An induction principle for the free algebra.

If `C` holds for the `algebraMap` of `r : R` into `FreeAlgebra R X`, the `ι` of `x : X`, and is
preserved under addition and muliplication, then it holds for all of `FreeAlgebra R X`.
-/
@[elab_as_elim]
theorem induction {C : FreeAlgebra R X → Prop}
    (h_grade0 : ∀ r, C (algebraMap R (FreeAlgebra R X) r)) (h_grade1 : ∀ x, C (ι R x))
    (h_mul : ∀ a b, C a → C b → C (a * b)) (h_add : ∀ a b, C a → C b → C (a + b))
    (a : FreeAlgebra R X) : C a := by
  -- the arguments are enough to construct a subalgebra, and a mapping into it from X
  let s : Subalgebra R (FreeAlgebra R X) :=
    { carrier := C
      mul_mem' := h_mul _ _
      add_mem' := h_add _ _
      algebraMap_mem' := h_grade0 }
  let of : X → s := Subtype.coind (ι R) h_grade1
  -- the mapping through the subalgebra is the identity
  have of_id : AlgHom.id R (FreeAlgebra R X) = s.val.comp (lift R of) :=
    by
    ext
    simp [Subtype.coind]
  -- finding a proof is finding an element of the subalgebra
  suffices : a = lift R of a
  · rw [this]
    exact Subtype.prop (lift R of a)
  simp [AlgHom.ext_iff] at of_id
  exact of_id a
#align free_algebra.induction FreeAlgebra.induction

end FreeAlgebra


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

! This file was ported from Lean 3 source module algebra.order.absolute_value
! leanprover-community/mathlib commit fc2ed6f838ce7c9b7c7171e58d78eaf7b438fb0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupWithZero.Units.Lemmas
import Mathlib.Algebra.Order.Field.Defs
import Mathlib.Algebra.Order.Hom.Basic
import Mathlib.Algebra.Order.Ring.Abs
import Mathlib.Algebra.Ring.Commute
import Mathlib.Algebra.Ring.Regular

/-!
# Absolute values

This file defines a bundled type of absolute values `AbsoluteValue R S`.

## Main definitions

 * `AbsoluteValue R S` is the type of absolute values on `R` mapping to `S`.
 * `AbsoluteValue.abs` is the "standard" absolute value on `S`, mapping negative `x` to `-x`.
 * `AbsoluteValue.toMonoidWithZeroHom`: absolute values mapping to a
   linear ordered field preserve `0`, `*` and `1`
 * `IsAbsoluteValue`: a type class stating that `f : β → α` satisfies the axioms of an absolute
   value
-/

/-- `AbsoluteValue R S` is the type of absolute values on `R` mapping to `S`:
the maps that preserve `*`, are nonnegative, positive definite and satisfy the triangle equality. -/
structure AbsoluteValue (R S : Type _) [Semiring R] [OrderedSemiring S] extends R →ₙ* S where
  /-- The absolute value is nonnegative -/
  nonneg' : ∀ x, 0 ≤ toFun x
  /-- The absolute value is positive definitive -/
  eq_zero' : ∀ x, toFun x = 0 ↔ x = 0
  /-- The absolute value satisfies the triangle inequality -/
  add_le' : ∀ x y, toFun (x + y) ≤ toFun x + toFun y
#align absolute_value AbsoluteValue

namespace AbsoluteValue

-- Porting note: Removing nolints.
-- attribute [nolint doc_blame] AbsoluteValue.toMulHom

section OrderedSemiring

section Semiring

variable {R S : Type _} [Semiring R] [OrderedSemiring S] (abv : AbsoluteValue R S)

instance zeroHomClass : ZeroHomClass (AbsoluteValue R S) R S where
  coe f := f.toFun
  coe_injective' f g h := by
    obtain ⟨⟨_, _⟩, _⟩ := f
    obtain ⟨⟨_, _⟩, _⟩ := g
    congr
  map_zero f := (f.eq_zero' _).2 rfl
#align absolute_value.zero_hom_class AbsoluteValue.zeroHomClass

instance mulHomClass : MulHomClass (AbsoluteValue R S) R S :=
  { AbsoluteValue.zeroHomClass with map_mul := fun f => f.map_mul' }
#align absolute_value.mul_hom_class AbsoluteValue.mulHomClass

instance nonnegHomClass : NonnegHomClass (AbsoluteValue R S) R S :=
  { AbsoluteValue.zeroHomClass with map_nonneg := fun f => f.nonneg' }
#align absolute_value.nonneg_hom_class AbsoluteValue.nonnegHomClass

instance subadditiveHomClass : SubadditiveHomClass (AbsoluteValue R S) R S :=
  { AbsoluteValue.zeroHomClass with map_add_le_add := fun f => f.add_le' }
#align absolute_value.subadditive_hom_class AbsoluteValue.subadditiveHomClass

@[simp]
theorem coe_mk (f : R →ₙ* S) {h₁ h₂ h₃} : (AbsoluteValue.mk f h₁ h₂ h₃ : R → S) = f :=
  rfl
#align absolute_value.coe_mk AbsoluteValue.coe_mk

@[ext]
theorem ext ⦃f g : AbsoluteValue R S⦄ : (∀ x, f x = g x) → f = g :=
  FunLike.ext _ _
#align absolute_value.ext AbsoluteValue.ext

/-- See Note [custom simps projection]. -/
def Simps.apply (f : AbsoluteValue R S) : R → S := f
#align absolute_value.simps.apply AbsoluteValue.Simps.apply

initialize_simps_projections AbsoluteValue (toFun → apply)

-- Porting note:
-- These helper instances are unhelpful in Lean 4, so omitting:
-- /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
-- directly. -/
-- instance : CoeFun (AbsoluteValue R S) fun f => R → S :=
--   FunLike.hasCoeToFun

@[simp]
theorem coe_toMulHom : abv.toMulHom = abv :=
  rfl
#align absolute_value.coe_to_mul_hom AbsoluteValue.coe_toMulHom

protected theorem nonneg (x : R) : 0 ≤ abv x :=
  abv.nonneg' x
#align absolute_value.nonneg AbsoluteValue.nonneg

@[simp]
protected theorem eq_zero {x : R} : abv x = 0 ↔ x = 0 :=
  abv.eq_zero' x
#align absolute_value.eq_zero AbsoluteValue.eq_zero

protected theorem add_le (x y : R) : abv (x + y) ≤ abv x + abv y :=
  abv.add_le' x y
#align absolute_value.add_le AbsoluteValue.add_le

-- Porting note: Removed since `map_mul` proves the theorem
--@[simp]
--protected theorem map_mul (x y : R) : abv (x * y) = abv x * abv y := map_mul _ _ _
  --abv.map_mul' x y
#align absolute_value.map_mul map_mul

protected theorem ne_zero_iff {x : R} : abv x ≠ 0 ↔ x ≠ 0 :=
  abv.eq_zero.not
#align absolute_value.ne_zero_iff AbsoluteValue.ne_zero_iff

protected theorem pos {x : R} (hx : x ≠ 0) : 0 < abv x :=
  lt_of_le_of_ne (abv.nonneg x) (Ne.symm <| mt abv.eq_zero.mp hx)
#align absolute_value.pos AbsoluteValue.pos

@[simp]
protected theorem pos_iff {x : R} : 0 < abv x ↔ x ≠ 0 :=
  ⟨fun h₁ => mt abv.eq_zero.mpr h₁.ne', abv.pos⟩
#align absolute_value.pos_iff AbsoluteValue.pos_iff

protected theorem ne_zero {x : R} (hx : x ≠ 0) : abv x ≠ 0 :=
  (abv.pos hx).ne'
#align absolute_value.ne_zero AbsoluteValue.ne_zero

theorem map_one_of_isLeftRegular (h : IsLeftRegular (abv 1)) : abv 1 = 1 :=
  h <| by simp [← map_mul]
#align absolute_value.map_one_of_is_regular AbsoluteValue.map_one_of_isLeftRegular

-- Porting note: Removed since `map_zero` proves the theorem
--@[simp]
--protected theorem map_zero : abv 0 = 0 := map_zero _
  --abv.eq_zero.2 rfl
#align absolute_value.map_zero map_zero

end Semiring

section Ring

variable {R S : Type _} [Ring R] [OrderedSemiring S] (abv : AbsoluteValue R S)

protected theorem sub_le (a b c : R) : abv (a - c) ≤ abv (a - b) + abv (b - c) := by
  simpa [sub_eq_add_neg, add_assoc] using abv.add_le (a - b) (b - c)
#align absolute_value.sub_le AbsoluteValue.sub_le

@[simp (high)]
theorem map_sub_eq_zero_iff (a b : R) : abv (a - b) = 0 ↔ a = b :=
  abv.eq_zero.trans sub_eq_zero
#align absolute_value.map_sub_eq_zero_iff AbsoluteValue.map_sub_eq_zero_iff

end Ring

end OrderedSemiring

section OrderedRing

section Semiring

section IsDomain

-- all of these are true for `NoZeroDivisors S`; but it doesn't work smoothly with the
-- `IsDomain`/`CancelMonoidWithZero` API
variable {R S : Type _} [Semiring R] [OrderedRing S] (abv : AbsoluteValue R S)

variable [IsDomain S] [Nontrivial R]

@[simp (high)]
protected theorem map_one : abv 1 = 1 :=
  abv.map_one_of_isLeftRegular (isRegular_of_ne_zero <| abv.ne_zero one_ne_zero).left
#align absolute_value.map_one AbsoluteValue.map_one

instance : MonoidWithZeroHomClass (AbsoluteValue R S) R S :=
  { AbsoluteValue.mulHomClass with map_zero := fun f => map_zero f, map_one := fun f => f.map_one }

/-- Absolute values from a nontrivial `R` to a linear ordered ring preserve `*`, `0` and `1`. -/
def toMonoidWithZeroHom : R →*₀ S :=
  abv
#align absolute_value.to_monoid_with_zero_hom AbsoluteValue.toMonoidWithZeroHom

@[simp]
theorem coe_toMonoidWithZeroHom : ⇑abv.toMonoidWithZeroHom = abv :=
  rfl
#align absolute_value.coe_to_monoid_with_zero_hom AbsoluteValue.coe_toMonoidWithZeroHom

/-- Absolute values from a nontrivial `R` to a linear ordered ring preserve `*` and `1`. -/
def toMonoidHom : R →* S :=
  abv
#align absolute_value.to_monoid_hom AbsoluteValue.toMonoidHom

@[simp]
theorem coe_toMonoidHom : ⇑abv.toMonoidHom = abv :=
  rfl
#align absolute_value.coe_to_monoid_hom AbsoluteValue.coe_toMonoidHom

-- Porting note: Removed since `map_zero` proves the theorem
--@[simp]
--protected theorem map_pow (a : R) (n : ℕ) : abv (a ^ n) = abv a ^ n := map_pow _ _ _
  --abv.toMonoidHom.map_pow a n
#align absolute_value.map_pow map_pow

end IsDomain

end Semiring

section Ring

variable {R S : Type _} [Ring R] [OrderedRing S] (abv : AbsoluteValue R S)

protected theorem le_sub (a b : R) : abv a - abv b ≤ abv (a - b) :=
  sub_le_iff_le_add.2 <| by simpa using abv.add_le (a - b) b
#align absolute_value.le_sub AbsoluteValue.le_sub

end Ring

end OrderedRing

section OrderedCommRing

variable {R S : Type _} [Ring R] [OrderedCommRing S] (abv : AbsoluteValue R S)

variable [NoZeroDivisors S]

@[simp]
protected theorem map_neg (a : R) : abv (-a) = abv a := by
  by_cases ha : a = 0; · simp [ha]
  refine'
    (mul_self_eq_mul_self_iff.mp (by rw [← map_mul abv, neg_mul_neg, map_mul abv])).resolve_right _
  exact ((neg_lt_zero.mpr (abv.pos ha)).trans (abv.pos (neg_ne_zero.mpr ha))).ne'
#align absolute_value.map_neg AbsoluteValue.map_neg

protected theorem map_sub (a b : R) : abv (a - b) = abv (b - a) := by rw [← neg_sub, abv.map_neg]
#align absolute_value.map_sub AbsoluteValue.map_sub

end OrderedCommRing

section LinearOrderedRing

variable {R S : Type _} [Semiring R] [LinearOrderedRing S] (abv : AbsoluteValue R S)

/-- `AbsoluteValue.abs` is `abs` as a bundled `AbsoluteValue`. -/
@[simps]
protected def abs : AbsoluteValue S S where
  toFun := abs
  nonneg' := abs_nonneg
  eq_zero' _ := abs_eq_zero
  add_le' := abs_add
  map_mul' := abs_mul
#align absolute_value.abs AbsoluteValue.abs
#align absolute_value.abs_apply AbsoluteValue.abs_apply
#align absolute_value.abs_to_mul_hom_apply AbsoluteValue.abs_apply

instance : Inhabited (AbsoluteValue S S) :=
  ⟨AbsoluteValue.abs⟩

end LinearOrderedRing

section LinearOrderedCommRing

variable {R S : Type _} [Ring R] [LinearOrderedCommRing S] (abv : AbsoluteValue R S)

theorem abs_abv_sub_le_abv_sub (a b : R) : abs (abv a - abv b) ≤ abv (a - b) :=
  abs_sub_le_iff.2 ⟨abv.le_sub _ _, by rw [abv.map_sub]; apply abv.le_sub⟩
#align absolute_value.abs_abv_sub_le_abv_sub AbsoluteValue.abs_abv_sub_le_abv_sub

end LinearOrderedCommRing

end AbsoluteValue

-- Porting note: Removed [] in fields, see
-- leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/Infer.20kinds.20are.20unsupported

/-- A function `f` is an absolute value if it is nonnegative, zero only at 0, additive, and
multiplicative.
See also the type `AbsoluteValue` which represents a bundled version of absolute values.
-/
class IsAbsoluteValue {S} [OrderedSemiring S] {R} [Semiring R] (f : R → S) : Prop where
  /-- The absolute value is nonnegative -/
  abv_nonneg' : ∀ x, 0 ≤ f x
  /-- The absolute value is positive definitive -/
  abv_eq_zero' : ∀ {x}, f x = 0 ↔ x = 0
  /-- The absolute value satisfies the triangle inequality -/
  abv_add' : ∀ x y, f (x + y) ≤ f x + f y
  /-- The absolute value is multiplicative -/
  abv_mul' : ∀ x y, f (x * y) = f x * f y
#align is_absolute_value IsAbsoluteValue

namespace IsAbsoluteValue

section OrderedSemiring

variable {S : Type _} [OrderedSemiring S]

variable {R : Type _} [Semiring R] (abv : R → S) [IsAbsoluteValue abv]

lemma abv_nonneg (x) : 0 ≤ abv x := abv_nonneg' x
#align is_absolute_value.abv_nonneg IsAbsoluteValue.abv_nonneg

lemma abv_eq_zero {x} : abv x = 0 ↔ x = 0 := abv_eq_zero'
#align is_absolute_value.abv_eq_zero IsAbsoluteValue.abv_eq_zero

lemma abv_add (x y) : abv (x + y) ≤ abv x + abv y := abv_add' x y
#align is_absolute_value.abv_add IsAbsoluteValue.abv_add

lemma abv_mul (x y) : abv (x * y) = abv x * abv y := abv_mul' x y
#align is_absolute_value.abv_mul IsAbsoluteValue.abv_mul

/-- A bundled absolute value is an absolute value. -/
instance _root_.AbsoluteValue.isAbsoluteValue (abv : AbsoluteValue R S) :
    IsAbsoluteValue abv where
  abv_nonneg' := abv.nonneg
  abv_eq_zero' := abv.eq_zero
  abv_add' := abv.add_le
  abv_mul' := abv.map_mul
#align absolute_value.is_absolute_value AbsoluteValue.isAbsoluteValue

/-- Convert an unbundled `IsAbsoluteValue` to a bundled `AbsoluteValue`. -/
@[simps]
def toAbsoluteValue : AbsoluteValue R S where
  toFun := abv
  add_le' := abv_add'
  eq_zero' _ := abv_eq_zero'
  nonneg' := abv_nonneg'
  map_mul' := abv_mul'
#align is_absolute_value.to_absolute_value IsAbsoluteValue.toAbsoluteValue
#align is_absolute_value.to_absolute_value_apply IsAbsoluteValue.toAbsoluteValue_apply
#align is_absolute_value.to_absolute_value_to_mul_hom_apply IsAbsoluteValue.toAbsoluteValue_apply

theorem abv_zero : abv 0 = 0 :=
  map_zero (toAbsoluteValue abv)
#align is_absolute_value.abv_zero IsAbsoluteValue.abv_zero

theorem abv_pos {a : R} : 0 < abv a ↔ a ≠ 0 :=
  (toAbsoluteValue abv).pos_iff
#align is_absolute_value.abv_pos IsAbsoluteValue.abv_pos

end OrderedSemiring

section LinearOrderedRing

variable {S : Type _} [LinearOrderedRing S]

instance abs_isAbsoluteValue : IsAbsoluteValue (abs : S → S) :=
  AbsoluteValue.abs.isAbsoluteValue
#align is_absolute_value.abs_is_absolute_value IsAbsoluteValue.abs_isAbsoluteValue

end LinearOrderedRing

section OrderedRing

variable {S : Type _} [OrderedRing S]

section Semiring

variable {R : Type _} [Semiring R] (abv : R → S) [IsAbsoluteValue abv]

variable [IsDomain S]

theorem abv_one [Nontrivial R] : abv 1 = 1 :=
  (toAbsoluteValue abv).map_one
#align is_absolute_value.abv_one IsAbsoluteValue.abv_one

/-- `abv` as a `MonoidWithZeroHom`. -/
def abvHom [Nontrivial R] : R →*₀ S :=
  (toAbsoluteValue abv).toMonoidWithZeroHom
#align is_absolute_value.abv_hom IsAbsoluteValue.abvHom

theorem abv_pow [Nontrivial R] (abv : R → S) [IsAbsoluteValue abv] (a : R) (n : ℕ) :
    abv (a ^ n) = abv a ^ n :=
  map_pow (toAbsoluteValue abv) a n
#align is_absolute_value.abv_pow IsAbsoluteValue.abv_pow

end Semiring

section Ring

variable {R : Type _} [Ring R] (abv : R → S) [IsAbsoluteValue abv]

theorem abv_sub_le (a b c : R) : abv (a - c) ≤ abv (a - b) + abv (b - c) := by
  simpa [sub_eq_add_neg, add_assoc] using abv_add abv (a - b) (b - c)
#align is_absolute_value.abv_sub_le IsAbsoluteValue.abv_sub_le

theorem sub_abv_le_abv_sub (a b : R) : abv a - abv b ≤ abv (a - b) :=
  (toAbsoluteValue abv).le_sub a b
#align is_absolute_value.sub_abv_le_abv_sub IsAbsoluteValue.sub_abv_le_abv_sub

end Ring

end OrderedRing

section OrderedCommRing

variable {S : Type _} [OrderedCommRing S]

section Ring

variable {R : Type _} [Ring R] (abv : R → S) [IsAbsoluteValue abv]

variable [NoZeroDivisors S]

theorem abv_neg (a : R) : abv (-a) = abv a :=
  (toAbsoluteValue abv).map_neg a
#align is_absolute_value.abv_neg IsAbsoluteValue.abv_neg

theorem abv_sub (a b : R) : abv (a - b) = abv (b - a) :=
  (toAbsoluteValue abv).map_sub a b
#align is_absolute_value.abv_sub IsAbsoluteValue.abv_sub

end Ring

end OrderedCommRing

section LinearOrderedCommRing

variable {S : Type _} [LinearOrderedCommRing S]

section Ring

variable {R : Type _} [Ring R] (abv : R → S) [IsAbsoluteValue abv]

theorem abs_abv_sub_le_abv_sub (a b : R) : abs (abv a - abv b) ≤ abv (a - b) :=
  (toAbsoluteValue abv).abs_abv_sub_le_abv_sub a b
#align is_absolute_value.abs_abv_sub_le_abv_sub IsAbsoluteValue.abs_abv_sub_le_abv_sub

end Ring

end LinearOrderedCommRing

section LinearOrderedField

variable {S : Type _} [LinearOrderedSemifield S]

section Semiring

variable {R : Type _} [Semiring R] [Nontrivial R] (abv : R → S) [IsAbsoluteValue abv]

theorem abv_one' : abv 1 = 1 :=
  (toAbsoluteValue abv).map_one_of_isLeftRegular <|
    (isRegular_of_ne_zero <| (toAbsoluteValue abv).ne_zero one_ne_zero).left
#align is_absolute_value.abv_one' IsAbsoluteValue.abv_one'

/-- An absolute value as a monoid with zero homomorphism, assuming the target is a semifield. -/
def abvHom' : R →*₀ S :=
  ⟨⟨abv, abv_zero abv⟩, abv_one' abv, abv_mul abv⟩
#align is_absolute_value.abv_hom' IsAbsoluteValue.abvHom'

end Semiring

section DivisionSemiring

variable {R : Type _} [DivisionSemiring R] (abv : R → S) [IsAbsoluteValue abv]

theorem abv_inv (a : R) : abv a⁻¹ = (abv a)⁻¹ :=
  map_inv₀ (abvHom' abv) a
#align is_absolute_value.abv_inv IsAbsoluteValue.abv_inv

theorem abv_div (a b : R) : abv (a / b) = abv a / abv b :=
  map_div₀ (abvHom' abv) a b
#align is_absolute_value.abv_div IsAbsoluteValue.abv_div

end DivisionSemiring

end LinearOrderedField

end IsAbsoluteValue