/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Heather Macbeth
-/
import topology.continuous_function.weierstrass
import data.is_R_or_C.basic

/-!
# The Stone-Weierstrass theorem

If a subalgebra `A` of `C(X, ℝ)`, where `X` is a compact topological space,
separates points, then it is dense.

We argue as follows.

* In any subalgebra `A` of `C(X, ℝ)`, if `f ∈ A`, then `abs f ∈ A.topological_closure`.
  This follows from the Weierstrass approximation theorem on `[-‖f‖, ‖f‖]` by
  approximating `abs` uniformly thereon by polynomials.
* This ensures that `A.topological_closure` is actually a sublattice:
  if it contains `f` and `g`, then it contains the pointwise supremum `f ⊔ g`
  and the pointwise infimum `f ⊓ g`.
* Any nonempty sublattice `L` of `C(X, ℝ)` which separates points is dense,
  by a nice argument approximating a given `f` above and below using separating functions.
  For each `x y : X`, we pick a function `g x y ∈ L` so `g x y x = f x` and `g x y y = f y`.
  By continuity these functions remain close to `f` on small patches around `x` and `y`.
  We use compactness to identify a certain finitely indexed infimum of finitely indexed supremums
  which is then close to `f` everywhere, obtaining the desired approximation.
* Finally we put these pieces together. `L = A.topological_closure` is a nonempty sublattice
  which separates points since `A` does, and so is dense (in fact equal to `⊤`).

We then prove the complex version for self-adjoint subalgebras `A`, by separately approximating
the real and imaginary parts using the real subalgebra of real-valued functions in `A`
(which still separates points, by taking the norm-square of a separating function).

## Future work

Extend to cover the case of subalgebras of the continuous functions vanishing at infinity,
on non-compact spaces.

-/

noncomputable theory

namespace continuous_map

variables {X : Type*} [topological_space X] [compact_space X]
open_locale polynomial

/--
Turn a function `f : C(X, ℝ)` into a continuous map into `set.Icc (-‖f‖) (‖f‖)`,
thereby explicitly attaching bounds.
-/
def attach_bound (f : C(X, ℝ)) : C(X, set.Icc (-‖f‖) (‖f‖)) :=
{ to_fun := λ x, ⟨f x, ⟨neg_norm_le_apply f x, apply_le_norm f x⟩⟩ }

@[simp] lemma attach_bound_apply_coe (f : C(X, ℝ)) (x : X) : ((attach_bound f) x : ℝ) = f x := rfl

lemma polynomial_comp_attach_bound (A : subalgebra ℝ C(X, ℝ)) (f : A) (g : ℝ[X]) :
  (g.to_continuous_map_on (set.Icc (-‖f‖) ‖f‖)).comp (f : C(X, ℝ)).attach_bound =
    polynomial.aeval f g :=
begin
  ext,
  simp only [continuous_map.coe_comp, function.comp_app,
    continuous_map.attach_bound_apply_coe,
    polynomial.to_continuous_map_on_apply,
    polynomial.aeval_subalgebra_coe,
    polynomial.aeval_continuous_map_apply,
    polynomial.to_continuous_map_apply],
end

/--
Given a continuous function `f` in a subalgebra of `C(X, ℝ)`, postcomposing by a polynomial
gives another function in `A`.

This lemma proves something slightly more subtle than this:
we take `f`, and think of it as a function into the restricted target `set.Icc (-‖f‖) ‖f‖)`,
and then postcompose with a polynomial function on that interval.
This is in fact the same situation as above, and so also gives a function in `A`.
-/
lemma polynomial_comp_attach_bound_mem (A : subalgebra ℝ C(X, ℝ)) (f : A) (g : ℝ[X]) :
  (g.to_continuous_map_on (set.Icc (-‖f‖) ‖f‖)).comp (f : C(X, ℝ)).attach_bound ∈ A :=
begin
  rw polynomial_comp_attach_bound,
  apply set_like.coe_mem,
end

theorem comp_attach_bound_mem_closure
  (A : subalgebra ℝ C(X, ℝ)) (f : A) (p : C(set.Icc (-‖f‖) (‖f‖), ℝ)) :
  p.comp (attach_bound f) ∈ A.topological_closure :=
begin
  -- `p` itself is in the closure of polynomials, by the Weierstrass theorem,
  have mem_closure : p ∈ (polynomial_functions (set.Icc (-‖f‖) (‖f‖))).topological_closure :=
    continuous_map_mem_polynomial_functions_closure _ _ p,
  -- and so there are polynomials arbitrarily close.
  have frequently_mem_polynomials := mem_closure_iff_frequently.mp mem_closure,
  -- To prove `p.comp (attached_bound f)` is in the closure of `A`,
  -- we show there are elements of `A` arbitrarily close.
  apply mem_closure_iff_frequently.mpr,
  -- To show that, we pull back the polynomials close to `p`,
  refine ((comp_right_continuous_map ℝ (attach_bound (f : C(X, ℝ)))).continuous_at p).tendsto
    .frequently_map _ _ frequently_mem_polynomials,
  -- but need to show that those pullbacks are actually in `A`.
  rintros _ ⟨g, ⟨-,rfl⟩⟩,
  simp only [set_like.mem_coe, alg_hom.coe_to_ring_hom, comp_right_continuous_map_apply,
    polynomial.to_continuous_map_on_alg_hom_apply],
  apply polynomial_comp_attach_bound_mem,
end

theorem abs_mem_subalgebra_closure (A : subalgebra ℝ C(X, ℝ)) (f : A) :
  (f : C(X, ℝ)).abs ∈ A.topological_closure :=
begin
  let M := ‖f‖,
  let f' := attach_bound (f : C(X, ℝ)),
  let abs : C(set.Icc (-‖f‖) (‖f‖), ℝ) :=
  { to_fun := λ x : set.Icc (-‖f‖) (‖f‖), |(x : ℝ)| },
  change (abs.comp f') ∈ A.topological_closure,
  apply comp_attach_bound_mem_closure,
end

theorem inf_mem_subalgebra_closure (A : subalgebra ℝ C(X, ℝ)) (f g : A) :
  (f : C(X, ℝ)) ⊓ (g : C(X, ℝ)) ∈ A.topological_closure :=
begin
  rw inf_eq,
  refine A.topological_closure.smul_mem
    (A.topological_closure.sub_mem
      (A.topological_closure.add_mem (A.le_topological_closure f.property)
          (A.le_topological_closure g.property)) _) _,
  exact_mod_cast abs_mem_subalgebra_closure A _,
end

theorem inf_mem_closed_subalgebra (A : subalgebra ℝ C(X, ℝ)) (h : is_closed (A : set C(X, ℝ)))
  (f g : A) : (f : C(X, ℝ)) ⊓ (g : C(X, ℝ)) ∈ A :=
begin
  convert inf_mem_subalgebra_closure A f g,
  apply set_like.ext',
  symmetry,
  erw closure_eq_iff_is_closed,
  exact h,
end

theorem sup_mem_subalgebra_closure (A : subalgebra ℝ C(X, ℝ)) (f g : A) :
  (f : C(X, ℝ)) ⊔ (g : C(X, ℝ)) ∈ A.topological_closure :=
begin
  rw sup_eq,
  refine A.topological_closure.smul_mem
    (A.topological_closure.add_mem
      (A.topological_closure.add_mem (A.le_topological_closure f.property)
          (A.le_topological_closure g.property)) _) _,
  exact_mod_cast abs_mem_subalgebra_closure A _,
end

theorem sup_mem_closed_subalgebra (A : subalgebra ℝ C(X, ℝ)) (h : is_closed (A : set C(X, ℝ)))
  (f g : A) : (f : C(X, ℝ)) ⊔ (g : C(X, ℝ)) ∈ A :=
begin
  convert sup_mem_subalgebra_closure A f g,
  apply set_like.ext',
  symmetry,
  erw closure_eq_iff_is_closed,
  exact h,
end

open_locale topology

-- Here's the fun part of Stone-Weierstrass!
theorem sublattice_closure_eq_top
  (L : set C(X, ℝ)) (nA : L.nonempty)
  (inf_mem : ∀ f g ∈ L, f ⊓ g ∈ L) (sup_mem : ∀ f g ∈ L, f ⊔ g ∈ L)
  (sep : L.separates_points_strongly) :
  closure L = ⊤ :=
begin
  -- We start by boiling down to a statement about close approximation.
  apply eq_top_iff.mpr,
  rintros f -,
  refine filter.frequently.mem_closure
    ((filter.has_basis.frequently_iff metric.nhds_basis_ball).mpr (λ ε pos, _)),
  simp only [exists_prop, metric.mem_ball],

  -- It will be helpful to assume `X` is nonempty later,
  -- so we get that out of the way here.
  by_cases nX : nonempty X,
  swap,
  exact ⟨nA.some, (dist_lt_iff pos).mpr (λ x, false.elim (nX ⟨x⟩)), nA.some_spec⟩,

  /-
  The strategy now is to pick a family of continuous functions `g x y` in `A`
  with the property that `g x y x = f x` and `g x y y = f y`
  (this is immediate from `h : separates_points_strongly`)
  then use continuity to see that `g x y` is close to `f` near both `x` and `y`,
  and finally using compactness to produce the desired function `h`
  as a maximum over finitely many `x` of a minimum over finitely many `y` of the `g x y`.
  -/
  dsimp [set.separates_points_strongly] at sep,

  let g : X → X → L := λ x y, (sep f x y).some,
  have w₁ : ∀ x y, g x y x = f x := λ x y, (sep f x y).some_spec.1,
  have w₂ : ∀ x y, g x y y = f y := λ x y, (sep f x y).some_spec.2,

  -- For each `x y`, we define `U x y` to be `{z | f z - ε < g x y z}`,
  -- and observe this is a neighbourhood of `y`.
  let U : X → X → set X := λ x y, {z | f z - ε < g x y z},
  have U_nhd_y : ∀ x y, U x y ∈ 𝓝 y,
  { intros x y,
    refine is_open.mem_nhds _ _,
    { apply is_open_lt; continuity, },
    { rw [set.mem_set_of_eq, w₂],
      exact sub_lt_self _ pos, }, },

  -- Fixing `x` for a moment, we have a family of functions `λ y, g x y`
  -- which on different patches (the `U x y`) are greater than `f z - ε`.
  -- Taking the supremum of these functions
  -- indexed by a finite collection of patches which cover `X`
  -- will give us an element of `A` that is globally greater than `f z - ε`
  -- and still equal to `f x` at `x`.

  -- Since `X` is compact, for every `x` there is some finset `ys t`
  -- so the union of the `U x y` for `y ∈ ys x` still covers everything.
  let ys : Π x, finset X := λ x, (compact_space.elim_nhds_subcover (U x) (U_nhd_y x)).some,
  let ys_w : ∀ x, (⋃ y ∈ ys x, U x y) = ⊤ :=
    λ x, (compact_space.elim_nhds_subcover (U x) (U_nhd_y x)).some_spec,

  have ys_nonempty : ∀ x, (ys x).nonempty :=
    λ x, set.nonempty_of_union_eq_top_of_nonempty _ _ nX (ys_w x),

  -- Thus for each `x` we have the desired `h x : A` so `f z - ε < h x z` everywhere
  -- and `h x x = f x`.
  let h : Π x, L := λ x,
    ⟨(ys x).sup' (ys_nonempty x) (λ y, (g x y : C(X, ℝ))),
      finset.sup'_mem _ sup_mem _ _ _ (λ y _, (g x y).2)⟩,
  have lt_h : ∀ x z, f z - ε < h x z,
  { intros x z,
    obtain ⟨y, ym, zm⟩ := set.exists_set_mem_of_union_eq_top _ _ (ys_w x) z,
    dsimp [h],
    simp only [coe_fn_coe_base', subtype.coe_mk, sup'_coe, finset.sup'_apply, finset.lt_sup'_iff],
    exact ⟨y, ym, zm⟩ },
  have h_eq : ∀ x, h x x = f x,
  { intro x, simp only [coe_fn_coe_base'] at w₁, simp [coe_fn_coe_base', w₁], },

  -- For each `x`, we define `W x` to be `{z | h x z < f z + ε}`,
  let W : Π x, set X := λ x, {z | h x z < f z + ε},
  -- This is still a neighbourhood of `x`.
  have W_nhd : ∀ x, W x ∈ 𝓝 x,
  { intros x,
    refine is_open.mem_nhds _ _,
    { apply is_open_lt; continuity, },
    { dsimp only [W, set.mem_set_of_eq],
      rw h_eq,
      exact lt_add_of_pos_right _ pos}, },

  -- Since `X` is compact, there is some finset `ys t`
  -- so the union of the `W x` for `x ∈ xs` still covers everything.
  let xs : finset X := (compact_space.elim_nhds_subcover W W_nhd).some,
  let xs_w : (⋃ x ∈ xs, W x) = ⊤ :=
    (compact_space.elim_nhds_subcover W W_nhd).some_spec,
  have xs_nonempty : xs.nonempty := set.nonempty_of_union_eq_top_of_nonempty _ _ nX xs_w,

  -- Finally our candidate function is the infimum over `x ∈ xs` of the `h x`.
  -- This function is then globally less than `f z + ε`.
  let k : (L : Type*) :=
    ⟨xs.inf' xs_nonempty (λ x, (h x : C(X, ℝ))),
      finset.inf'_mem _ inf_mem _ _ _ (λ x _, (h x).2)⟩,

  refine ⟨k.1, _, k.2⟩,

  -- We just need to verify the bound, which we do pointwise.
  rw dist_lt_iff pos,
  intro z,

  -- We rewrite into this particular form,
  -- so that simp lemmas about inequalities involving `finset.inf'` can fire.
  rw [(show ∀ a b ε : ℝ, dist a b < ε ↔ a < b + ε ∧ b - ε < a,
    by { intros, simp only [← metric.mem_ball, real.ball_eq_Ioo, set.mem_Ioo, and_comm], })],

  fsplit,
  { dsimp [k],
    simp only [finset.inf'_lt_iff, continuous_map.inf'_apply],
    exact set.exists_set_mem_of_union_eq_top _ _ xs_w z, },
  { dsimp [k],
    simp only [finset.lt_inf'_iff, continuous_map.inf'_apply],
    intros x xm,
    apply lt_h, },
end

/--
The **Stone-Weierstrass Approximation Theorem**,
that a subalgebra `A` of `C(X, ℝ)`, where `X` is a compact topological space,
is dense if it separates points.
-/
theorem subalgebra_topological_closure_eq_top_of_separates_points
  (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points) :
  A.topological_closure = ⊤ :=
begin
  -- The closure of `A` is closed under taking `sup` and `inf`,
  -- and separates points strongly (since `A` does),
  -- so we can apply `sublattice_closure_eq_top`.
  apply set_like.ext',
  let L := A.topological_closure,
  have n : set.nonempty (L : set C(X, ℝ)) :=
    ⟨(1 : C(X, ℝ)), A.le_topological_closure A.one_mem⟩,
  convert sublattice_closure_eq_top
    (L : set C(X, ℝ)) n
    (λ f fm g gm, inf_mem_closed_subalgebra L A.is_closed_topological_closure ⟨f, fm⟩ ⟨g, gm⟩)
    (λ f fm g gm, sup_mem_closed_subalgebra L A.is_closed_topological_closure ⟨f, fm⟩ ⟨g, gm⟩)
    (subalgebra.separates_points.strongly
      (subalgebra.separates_points_monotone (A.le_topological_closure) w)),
  { simp, },
end

/--
An alternative statement of the Stone-Weierstrass theorem.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is a uniform limit of elements of `A`.
-/
theorem continuous_map_mem_subalgebra_closure_of_separates_points
  (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points)
  (f : C(X, ℝ)) :
  f ∈ A.topological_closure :=
begin
  rw subalgebra_topological_closure_eq_top_of_separates_points A w,
  simp,
end

/--
An alternative statement of the Stone-Weierstrass theorem,
for those who like their epsilons.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is within any `ε > 0` of some element of `A`.
-/
theorem exists_mem_subalgebra_near_continuous_map_of_separates_points
  (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points)
  (f : C(X, ℝ)) (ε : ℝ) (pos : 0 < ε) :
  ∃ (g : A), ‖(g : C(X, ℝ)) - f‖ < ε :=
begin
  have w := mem_closure_iff_frequently.mp
    (continuous_map_mem_subalgebra_closure_of_separates_points A w f),
  rw metric.nhds_basis_ball.frequently_iff at w,
  obtain ⟨g, H, m⟩ := w ε pos,
  rw [metric.mem_ball, dist_eq_norm] at H,
  exact ⟨⟨g, m⟩, H⟩,
end

/--
An alternative statement of the Stone-Weierstrass theorem,
for those who like their epsilons and don't like bundled continuous functions.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is within any `ε > 0` of some element of `A`.
-/
theorem exists_mem_subalgebra_near_continuous_of_separates_points
  (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points)
  (f : X → ℝ) (c : continuous f) (ε : ℝ) (pos : 0 < ε) :
  ∃ (g : A), ∀ x, ‖g x - f x‖ < ε :=
begin
  obtain ⟨g, b⟩ := exists_mem_subalgebra_near_continuous_map_of_separates_points A w ⟨f, c⟩ ε pos,
  use g,
  rwa norm_lt_iff _ pos at b,
end

end continuous_map

section is_R_or_C
open is_R_or_C

-- Redefine `X`, since for the next few lemmas it need not be compact
variables {𝕜 : Type*} {X : Type*} [is_R_or_C 𝕜] [topological_space X]

namespace continuous_map

/-- A real subalgebra of `C(X, 𝕜)` is `conj_invariant`, if it contains all its conjugates. -/
def conj_invariant_subalgebra (A : subalgebra ℝ C(X, 𝕜)) : Prop :=
A.map (conj_ae.to_alg_hom.comp_left_continuous ℝ conj_cle.continuous) ≤ A

lemma mem_conj_invariant_subalgebra {A : subalgebra ℝ C(X, 𝕜)} (hA : conj_invariant_subalgebra A)
  {f : C(X, 𝕜)} (hf : f ∈ A) :
  (conj_ae.to_alg_hom.comp_left_continuous ℝ conj_cle.continuous) f ∈ A :=
hA ⟨f, hf, rfl⟩

/-- If a set `S` is conjugation-invariant, then its `𝕜`-span is conjugation-invariant. -/
lemma subalgebra_conj_invariant {S : set C(X, 𝕜)}
  (hS : ∀ f, f ∈ S → (conj_ae.to_alg_hom.comp_left_continuous ℝ conj_cle.continuous) f ∈ S) :
  conj_invariant_subalgebra ((algebra.adjoin 𝕜 S).restrict_scalars ℝ) :=
begin
  rintros _ ⟨f, hf, rfl⟩,
  change _ ∈ ((algebra.adjoin 𝕜 S).restrict_scalars ℝ),
  change _ ∈ ((algebra.adjoin 𝕜 S).restrict_scalars ℝ) at hf,
  rw subalgebra.mem_restrict_scalars at hf ⊢,
  apply algebra.adjoin_induction hf,
  { exact λ g hg, algebra.subset_adjoin (hS g hg), },
  { exact λ c, subalgebra.algebra_map_mem _ (star_ring_end 𝕜 c) },
  { intros f g hf hg,
    convert subalgebra.add_mem _ hf hg,
    exact alg_hom.map_add _ f g },
  { intros f g hf hg,
    convert subalgebra.mul_mem _ hf hg,
    exact alg_hom.map_mul _ f g, }
end

end continuous_map

open continuous_map

/-- If a conjugation-invariant subalgebra of `C(X, 𝕜)` separates points, then the real subalgebra
of its purely real-valued elements also separates points. -/
lemma subalgebra.separates_points.is_R_or_C_to_real {A : subalgebra 𝕜 C(X, 𝕜)}
  (hA : A.separates_points) (hA' : conj_invariant_subalgebra (A.restrict_scalars ℝ)) :
  ((A.restrict_scalars ℝ).comap
    (of_real_am.comp_left_continuous ℝ continuous_of_real)).separates_points :=
begin
  intros x₁ x₂ hx,
  -- Let `f` in the subalgebra `A` separate the points `x₁`, `x₂`
  obtain ⟨_, ⟨f, hfA, rfl⟩, hf⟩ := hA hx,
  let F : C(X, 𝕜) := f - const _ (f x₂),
  -- Subtract the constant `f x₂` from `f`; this is still an element of the subalgebra
  have hFA : F ∈ A,
  { refine A.sub_mem hfA (@eq.subst _ (∈ A) _ _ _ $ A.smul_mem A.one_mem $ f x₂),
    ext1, simp only [coe_smul, coe_one, pi.smul_apply,
      pi.one_apply, algebra.id.smul_eq_mul, mul_one, const_apply] },
  -- Consider now the function `λ x, |f x - f x₂| ^ 2`
  refine ⟨_, ⟨(⟨is_R_or_C.norm_sq, continuous_norm_sq⟩ : C(𝕜, ℝ)).comp F, _, rfl⟩, _⟩,
  { -- This is also an element of the subalgebra, and takes only real values
    rw [set_like.mem_coe, subalgebra.mem_comap],
    convert (A.restrict_scalars ℝ).mul_mem (mem_conj_invariant_subalgebra hA' hFA) hFA,
    ext1,
    rw [mul_comm],
    exact (is_R_or_C.mul_conj _).symm },
  { -- And it also separates the points `x₁`, `x₂`
    have : f x₁ - f x₂ ≠ 0 := sub_ne_zero.mpr hf,
    simpa only [comp_apply, coe_sub, coe_const, pi.sub_apply,
      coe_mk, sub_self, map_zero, ne.def, norm_sq_eq_zero] using this },
end

variables [compact_space X]

/--
The Stone-Weierstrass approximation theorem, `is_R_or_C` version,
that a subalgebra `A` of `C(X, 𝕜)`, where `X` is a compact topological space and `is_R_or_C 𝕜`,
is dense if it is conjugation-invariant and separates points.
-/
theorem continuous_map.subalgebra_is_R_or_C_topological_closure_eq_top_of_separates_points
  (A : subalgebra 𝕜 C(X, 𝕜)) (hA : A.separates_points)
  (hA' : conj_invariant_subalgebra (A.restrict_scalars ℝ)) :
  A.topological_closure = ⊤ :=
begin
  rw algebra.eq_top_iff,
  -- Let `I` be the natural inclusion of `C(X, ℝ)` into `C(X, 𝕜)`
  let I : C(X, ℝ) →ₗ[ℝ] C(X, 𝕜) := of_real_clm.comp_left_continuous ℝ X,
  -- The main point of the proof is that its range (i.e., every real-valued function) is contained
  -- in the closure of `A`
  have key : I.range ≤ (A.to_submodule.restrict_scalars ℝ).topological_closure,
  { -- Let `A₀` be the subalgebra of `C(X, ℝ)` consisting of `A`'s purely real elements; it is the
    -- preimage of `A` under `I`.  In this argument we only need its submodule structure.
    let A₀ : submodule ℝ C(X, ℝ) := (A.to_submodule.restrict_scalars ℝ).comap I,
    -- By `subalgebra.separates_points.complex_to_real`, this subalgebra also separates points, so
    -- we may apply the real Stone-Weierstrass result to it.
    have SW : A₀.topological_closure = ⊤,
    { have := subalgebra_topological_closure_eq_top_of_separates_points _
                (hA.is_R_or_C_to_real hA'),
      exact congr_arg subalgebra.to_submodule this },
    rw [← submodule.map_top, ← SW],
    -- So it suffices to prove that the image under `I` of the closure of `A₀` is contained in the
    -- closure of `A`, which follows by abstract nonsense
    have h₁ := A₀.topological_closure_map ((@of_real_clm 𝕜 _).comp_left_continuous_compact X),
    have h₂ := (A.to_submodule.restrict_scalars ℝ).map_comap_le I,
    exact h₁.trans (submodule.topological_closure_mono h₂) },
  -- In particular, for a function `f` in `C(X, 𝕜)`, the real and imaginary parts of `f` are in the
  -- closure of `A`
  intros f,
  let f_re : C(X, ℝ) := (⟨is_R_or_C.re, is_R_or_C.re_clm.continuous⟩ : C(𝕜, ℝ)).comp f,
  let f_im : C(X, ℝ) := (⟨is_R_or_C.im, is_R_or_C.im_clm.continuous⟩ : C(𝕜, ℝ)).comp f,
  have h_f_re : I f_re ∈ A.topological_closure := key ⟨f_re, rfl⟩,
  have h_f_im : I f_im ∈ A.topological_closure := key ⟨f_im, rfl⟩,
  -- So `f_re + I • f_im` is in the closure of `A`
  convert A.topological_closure.add_mem h_f_re (A.topological_closure.smul_mem h_f_im is_R_or_C.I),
  -- And this, of course, is just `f`
  ext,
  apply eq.symm,
  simp [I, mul_comm is_R_or_C.I _],
end

end is_R_or_C


namespace my_bool

inductive mybool : Type
| mytt : mybool
| myff : mybool

/-
We declare mybool to be an
inductively defined type:
a value of type, Type.

The set of values of this
type that can be constructed
is defined by the available
constructors.

Here there are just two,
mytt and myff, neither having
any arguments, so these are
the only two values of this
type: mytt and myff.
-/

-- We open the mybool namespace
open mybool

#check mytt

/-
With this data type in hand,
we can now define an "algebra"
involving such values. This will
be out little implementation of
Boolean algebra.

First we'll define the unary
functions involving values of
this type only. Then we'll do
a few binary functions, leaving
you a few more as exercises.
-/

/- Unary Operations -/

-- id_mybool returns what it's given
def id_mybool (b: mybool) : mybool := b

-- true_mybool always returns true
def true_mybool (b: mybool) := mytt

-- false_mybool always returns false
def false_mybool (b: mybool) := myff

-- not_mybool returns the other value
def not_mybool : mybool → mybool
| mytt := myff
| myff := mytt

#check not_mybool

def or_mybool : mybool → mybool → mybool
| myff myff := myff
| _ _ := mytt

def and_mybool (b1 b2 : mybool) : mybool :=
match b1, b2 with
    | mytt, mytt := mytt
    | _, _ := myff
end

theorem demorgan1 : ∀ b1 b2 : mybool,
    not_mybool
        (and_mybool b1 b2)
    =
    or_mybool
        (not_mybool b1)
        (not_mybool b2) :=
begin
    intros,
    cases b1,
    cases b2,
    repeat {trivial},
end

theorem demorgan2 : ∀ b1 b2 : mybool,
    not_mybool
        (or_mybool b1 b2)
    =
    and_mybool
        (not_mybool b1)
        (not_mybool b2) :=
begin
    intros,
    cases b1,
    cases b2,
    repeat {trivial},
    cases b2,
    repeat {trivial},
end

end my_bool


import data.finset.basic
import data.fintype.basic

-- A decidable predicate on finsets has the quorum assumption if, whenever
-- two finsets satisfy the predicate, they intersect.
class quorum_assumption {pid_t : Type} [decidable_eq pid_t]
                        (p : finset pid_t → Prop) [decidable_pred p] :=
  (intersect : (∀ (q1 q2 : finset pid_t), p q1 → p q2 → (q1 ∩ q2).nonempty))

-- For any pid_t which is a fintype, the majority predicate satisfies the quorum
-- assumption.
def majority (pid_t : Type) [fintype pid_t] (q: finset pid_t) :=
  q.card + q.card > fintype.card pid_t

variables {pid_t : Type} [fintype pid_t] [decidable_eq pid_t]

instance : decidable_pred (majority pid_t) :=
begin
intro q,
unfold majority,
exact nat.decidable_lt (fintype.card pid_t) (q.card + q.card)
end

lemma majorities_intersect :
  ∀ (q1 q2 : finset pid_t), majority pid_t q1 → majority pid_t q2 → (q1 ∩ q2).nonempty :=
begin
intros q1 q2 h1 h2,
apply finset.card_pos.mp,
unfold majority at h1 h2,
have card_sum_gt : q1.card + q2.card > fintype.card pid_t,
by {
  cases decidable.em (q1.card < q2.card),
  { calc q1.card + q2.card > q1.card + q1.card : nat.add_lt_add_left h q1.card
                       ... > fintype.card pid_t : h1 },
  rw not_lt at h,
  calc q1.card + q2.card ≥ q2.card + q2.card : nat.add_le_add_right h q2.card
                     ... > fintype.card pid_t : h2
},
have card_union_le : (q1 ∪ q2).card ≤ fintype.card pid_t,
by {
  rw ← finset.card_univ,
  apply finset.card_le_of_subset,
  intros x unused,
  exact finset.mem_univ x
},
clear h1 h2,
have inclusion_exclusion := finset.card_union_add_card_inter q1 q2,
have key :=
  calc fintype.card pid_t + 0 = fintype.card pid_t : nat.add_zero (fintype.card pid_t)
                          ... < q1.card + q2.card : card_sum_gt
                          ... = (q1 ∪ q2).card + (q1 ∩ q2).card : eq.symm inclusion_exclusion
                          ... ≤ fintype.card pid_t + (q1 ∩ q2).card :
                                             nat.add_le_add_right card_union_le (q1 ∩ q2).card,
exact lt_of_add_lt_add_left key
end

instance : quorum_assumption (majority pid_t) := { intersect := majorities_intersect }


import tactic
import data.real.basic

def injective {X Y} (f : X → Y)
    := ∀ x₁ x₂, f x₁ = f x₂ → x₁ = x₂

def range {X Y} (f : X → Y)
    := { y | ∃ x, f x = y }

/--
Type of pairs (k,p) where k
is a natural number and p is a witness to the proof that k < n.
-/
def finite_subset (n : ℕ) := Σ' k, k < n

def lift_finite (m n : ℕ) (p : m < n) : finite_subset m → finite_subset n
    := λ k, ⟨k.1, lt.trans k.2 p⟩

#print nat.sub_le

#print nat.lt_succ_of_le

#print nat.sub_lt_succ

#print nat.

lemma pred_exists (n : ℕ) (p: n > 0) : exists k, nat.succ k = n
:=
begin
/-
    start with k:ℤ set k=n-1 but k>= 0 so k :ℕ

let k:ℤ := n-1,
let k_ge_zero : k ≥ 0 :=
begin
    sorry,
end,
-/
induction n with d hd,
{linarith,},
{
    existsi d,
  refl}
end

lemma succ_greater_than_nat (n : ℕ) : nat.succ n > n
:=
begin
rw nat.succ_eq_add_one,
linarith,
/-
--exact nat.less_than_or_equal,
induction n with d hd,
{exact nat.zero_lt_one,
},
{
    rw nat.succ_eq_add_one,
    simp,
    sorry,
--    nat.less_than_or_equal
--    exact nat.lt_of_succ_lt,
}
-/
end

/--
Pigeonhole principle, induction on n
-/
theorem pigeonhole_principle
    (n m : ℕ)
    (f : finite_subset n → finite_subset m)
: (n > m) → ¬(injective f)
:= begin
    intros n_gt_m f_injective,

    induction n with d hd,

    linarith, -- case d=0

    let g := f∘ (lift_finite d (d+1) (succ_greater_than_nat d)),

    let hd' := hd g,

    /-
    induction m with d hd,
    {
         cases pred_exists n n_gt_m with k hk,
         let n_gt_k := succ_greater_than_nat k,
         rw hk at n_gt_k,
         let fk := f ⟨k, n_gt_k⟩,
         let fk2 := fk.2,
         linarith,
    },

    {
        let n_gt_d : n>d :=
        begin
            exact lt.trans (succ_greater_than_nat d)  n_gt_m,
        end,

        sorry
    },

    -/
end

#print pigeonhole_principle


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Julian Kuelshammer, Heather Macbeth
-/

import data.polynomial.derivative
import tactic.ring

/-!
# Chebyshev polynomials

The Chebyshev polynomials are two families of polynomials indexed by `ℕ`,
with integral coefficients.

## Main definitions

* `polynomial.chebyshev.T`: the Chebyshev polynomials of the first kind.
* `polynomial.chebyshev.U`: the Chebyshev polynomials of the second kind.

## Main statements

* The formal derivative of the Chebyshev polynomials of the first kind is a scalar multiple of the
  Chebyshev polynomials of the second kind.
* `polynomial.chebyshev.mul_T`, the product of the `m`-th and `(m + k)`-th Chebyshev polynomials of
  the first kind is the sum of the `(2 * m + k)`-th and `k`-th Chebyshev polynomials of the first
  kind.
* `polynomial.chebyshev.T_mul`, the `(m * n)`-th Chebyshev polynomial of the first kind is the
  composition of the `m`-th and `n`-th Chebyshev polynomials of the first kind.

## Implementation details

Since Chebyshev polynomials have interesting behaviour over the complex numbers and modulo `p`,
we define them to have coefficients in an arbitrary commutative ring, even though
technically `ℤ` would suffice.
The benefit of allowing arbitrary coefficient rings, is that the statements afterwards are clean,
and do not have `map (int.cast_ring_hom R)` interfering all the time.

## References

[Lionel Ponton, _Roots of the Chebyshev polynomials: A purely algebraic approach_]
[ponton2020chebyshev]

## TODO

* Redefine and/or relate the definition of Chebyshev polynomials to `linear_recurrence`.
* Add explicit formula involving square roots for Chebyshev polynomials
* Compute zeroes and extrema of Chebyshev polynomials.
* Prove that the roots of the Chebyshev polynomials (except 0) are irrational.
* Prove minimax properties of Chebyshev polynomials.
-/

noncomputable theory
namespace polynomial.chebyshev

open polynomial

variables (R S : Type*) [comm_ring R] [comm_ring S]

/-- `T n` is the `n`-th Chebyshev polynomial of the first kind -/
noncomputable def T : ℕ → polynomial R
| 0       := 1
| 1       := X
| (n + 2) := 2 * X * T (n + 1) - T n

@[simp] lemma T_zero : T R 0 = 1 := rfl
@[simp] lemma T_one : T R 1 = X := rfl
lemma T_two : T R 2 = 2 * X ^ 2 - 1 :=
by simp only [T, sub_left_inj, sq, mul_assoc]
@[simp] lemma T_add_two (n : ℕ) :
  T R (n + 2) = 2 * X * T R (n + 1) - T R n :=
by rw T

lemma T_of_two_le (n : ℕ) (h : 2 ≤ n) :
  T R n = 2 * X * T R (n - 1) - T R (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact T_add_two R n
end

variables {R S}

lemma map_T (f : R →+* S) :
  ∀ (n : ℕ), map f (T R n) = T S n
| 0       := by simp only [T_zero, map_one]
| 1       := by simp only [T_one, map_X]
| (n + 2) :=
begin
  simp only [T_add_two, map_mul, map_sub, map_X, bit0, map_add, map_one],
  rw [map_T (n + 1), map_T n],
end

variables (R S)

/-- `U n` is the `n`-th Chebyshev polynomial of the second kind -/
noncomputable def U : ℕ → polynomial R
| 0       := 1
| 1       := 2 * X
| (n + 2) := 2 * X * U (n + 1) - U n

@[simp] lemma U_zero : U R 0 = 1 := rfl
@[simp] lemma U_one : U R 1 = 2 * X := rfl

@[simp] lemma U_add_two (n : ℕ) :
  U R (n + 2) = 2 * X * U R (n + 1) - U R n :=
by rw U

lemma U_of_two_le (n : ℕ) (h : 2 ≤ n) :
  U R n = 2 * X * U R (n - 1) - U R (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact U_add_two R n
end

lemma U_eq_X_mul_U_add_T :
  ∀ (n : ℕ), U R (n+1) = X * U R n + T R (n+1)
| 0        := by { simp only [U_zero, U_one, T_one], ring }
| 1        := by { simp only [U_one, T_two, U_two], ring }
| (n + 2)  :=
  calc U R (n + 2 + 1) = 2 * X * (X * U R (n + 1) + T R (n + 2)) - (X * U R n + T R (n + 1)) :
            by simp only [U_add_two, U_eq_X_mul_U_add_T n, U_eq_X_mul_U_add_T (n + 1)]
  ... = X * (2 * X * U R (n + 1) - U R n) + (2 * X * T R (n + 2) - T R (n + 1)) : by ring
  ... = X * U R (n + 2) + T R (n + 2 + 1) : by simp only [U_add_two, T_add_two]

lemma T_eq_U_sub_X_mul_U (n : ℕ) :
  T R (n+1) = U R (n+1) - X * U R n :=
by rw [U_eq_X_mul_U_add_T, add_comm (X * U R n), add_sub_cancel]

lemma T_eq_X_mul_T_sub_pol_U :
  ∀ (n : ℕ), T R (n+2) = X * T R (n+1) - (1 - X ^ 2) * U R n
| 0        := by { simp only [T_one, T_two, U_zero], ring }
| 1        := by { simp only [T_add_two, T_zero, T_add_two,
                              U_one, T_one], ring }
| (n + 2)  :=
calc T R (n + 2 + 2)
    = 2 * X * T R (n + 2 + 1) - T R (n + 2) : T_add_two _ _
... = 2 * X * (X * T R (n + 2) - (1 - X ^ 2) * U R (n + 1))
      - (X * T R (n + 1) - (1 - X ^ 2) * U R n) : by simp only [T_eq_X_mul_T_sub_pol_U]
... = X * (2 * X * T R (n + 2) -  T R (n + 1)) - (1 - X ^ 2) * (2 * X * U R (n + 1) - U R n) :
            by ring
... = X * T R (n + 2 + 1) - (1 - X ^ 2) * U R (n + 2) : by rw [T_add_two _ (n + 1), U_add_two]

lemma one_sub_X_sq_mul_U_eq_pol_in_T (n : ℕ) :
  (1 - X ^ 2) * U R n = X * T R (n + 1) - T R (n + 2) :=
by rw [T_eq_X_mul_T_sub_pol_U, ←sub_add, sub_self, zero_add]

variables {R S}

@[simp] lemma map_U (f : R →+* S) :
  ∀ (n : ℕ), map f (U R n) = U S n
| 0       := by simp only [U_zero, map_one]
| 1       :=
begin
  simp only [U_one, map_X, map_mul, map_add, map_one],
  change map f (1+1) * X = 2 * X,
  simpa only [map_add, map_one]
end
| (n + 2) :=
begin
  simp only [U_add_two, map_mul, map_sub, map_X, bit0, map_add, map_one],
  rw [map_U (n + 1), map_U n],
end

lemma T_derivative_eq_U :
  ∀ (n : ℕ), derivative (T R (n + 1)) = (n + 1) * U R n
| 0        := by simp only [T_one, U_zero, derivative_X, nat.cast_zero, zero_add, mul_one]
| 1        := by { simp only [T_two, U_one, derivative_sub, derivative_one, derivative_mul,
                              derivative_X_pow, nat.cast_one, nat.cast_two],
                    norm_num }
| (n + 2)  :=
  calc derivative (T R (n + 2 + 1))
      = 2 * T R (n + 2) + 2 * X * derivative (T R (n + 1 + 1)) - derivative (T R (n + 1)) :
              by simp only [T_add_two _ (n + 1), derivative_sub, derivative_mul, derivative_X,
                            derivative_bit0, derivative_one, bit0_zero, zero_mul, zero_add, mul_one]
  ... = 2 * (U R (n + 1 + 1) - X * U R (n + 1)) + 2 * X * ((n + 1 + 1) * U R (n + 1))
        - (n + 1) * U R n : by rw_mod_cast [T_derivative_eq_U, T_derivative_eq_U,
                                            T_eq_U_sub_X_mul_U]
  ... = (n + 1) * (2 * X * U R (n + 1) - U R n) + 2 * U R (n + 2) : by ring
  ... = (n + 1) * U R (n + 2) + 2 * U R (n + 2) : by rw U_add_two
  ... = (n + 2 + 1) * U R (n + 2) : by ring
  ... = (↑(n + 2) + 1) * U R (n + 2) : by norm_cast

lemma one_sub_X_sq_mul_derivative_T_eq_poly_in_T (n : ℕ) :
  (1 - X ^ 2)  * (derivative (T R (n+1))) =
    (n + 1) * (T R n - X * T R (n+1)) :=
  calc
  (1 - X ^ 2)  * (derivative (T R (n+1))) = (1 - X ^ 2 ) * ((n + 1) * U R n) :
            by rw T_derivative_eq_U
  ... = (n + 1) * ((1 - X ^ 2) * U R n) : by ring
  ... = (n + 1) * (X * T R (n + 1) - (2 * X * T R (n + 1) - T R n)) :
            by rw [one_sub_X_sq_mul_U_eq_pol_in_T, T_add_two]
  ... = (n + 1) * (T R n - X * T R (n+1)) : by ring

lemma add_one_mul_T_eq_poly_in_U (n : ℕ) :
  ((n : polynomial R) + 1) * T R (n+1) =
    X * U R n - (1 - X ^ 2) * derivative ( U R n) :=
begin
  have h : derivative (T R (n + 2)) = (U R (n + 1) - X * U R n) + X * derivative (T R (n + 1))
                                      + 2 * X * U R n - (1 - X ^ 2) * derivative (U R n),
  { conv_lhs { rw T_eq_X_mul_T_sub_pol_U },
  simp only [derivative_sub, derivative_mul, derivative_X, derivative_one, derivative_X_pow,
  one_mul, T_derivative_eq_U],
  rw [T_eq_U_sub_X_mul_U, nat.cast_bit0, nat.cast_one],
  ring },
  calc ((n : polynomial R) + 1) * T R (n + 1)
      = ((n : polynomial R) + 1 + 1) * (X * U R n + T R (n + 1))
        - X * ((n + 1) * U R n) - (X * U R n + T R (n + 1)) : by ring
  ... = derivative (T R (n + 2)) - X * derivative (T R (n + 1)) - U R (n + 1) :
            by rw [←U_eq_X_mul_U_add_T, ←T_derivative_eq_U, ←nat.cast_one, ←nat.cast_add,
                  nat.cast_one, ←T_derivative_eq_U (n + 1)]
  ... = (U R (n + 1) - X * U R n) + X * derivative (T R (n + 1))
        + 2 * X * U R n - (1 - X ^ 2) * derivative (U R n)
        - X * derivative (T R (n + 1)) - U R (n + 1) : by rw h
  ... = X * U R n - (1 - X ^ 2) * derivative (U R n) : by ring,
end

variables (R)

/-- The product of two Chebyshev polynomials is the sum of two other Chebyshev polynomials. -/
lemma mul_T :
  ∀ m : ℕ, ∀ k,
  2 * T R m * T R (m + k) = T R (2 * m + k) + T R k
| 0 := by simp [two_mul, add_mul]
| 1 := by simp [add_comm]
| (m + 2) := begin
  intros k,
  -- clean up the `T` nat indices in the goal
  suffices : 2 * T R (m + 2) * T R (m + k + 2) = T R (2 * m + k + 4) + T R k,
  { have h_nat₁ : 2 * (m + 2) + k = 2 * m + k + 4 := by ring,
    have h_nat₂ : m + 2 + k = m + k + 2 := by simp [add_comm, add_assoc],
    simpa [h_nat₁, h_nat₂] using this },
  -- clean up the `T` nat indices in the inductive hypothesis applied to `m + 1` and
  -- `k + 1`
  have H₁ : 2 * T R (m + 1) * T R (m + k + 2) = T R (2 * m + k + 3) + T R (k + 1),
  { have h_nat₁ : m + 1 + (k + 1) = m + k + 2 := by ring,
    have h_nat₂ : 2 * (m + 1) + (k + 1) = 2 * m + k + 3 := by ring,
    simpa [h_nat₁, h_nat₂] using mul_T (m + 1) (k + 1) },
  -- clean up the `T` nat indices in the inductive hypothesis applied to `m` and `k + 2`
  have H₂ : 2 * T R m * T R (m + k + 2) = T R (2 * m + k + 2) + T R (k + 2),
  { have h_nat₁ : 2 * m + (k + 2) = 2 * m + k + 2 := by simp [add_assoc],
    have h_nat₂ : m + (k + 2) = m + k + 2 := by simp [add_assoc],
    simpa [h_nat₁, h_nat₂] using mul_T m (k + 2) },
  -- state the `T` recurrence relation for a few useful indices
  have h₁ := T_add_two R m,
  have h₂ := T_add_two R (2 * m + k + 2),
  have h₃ := T_add_two R k,
  -- the desired identity is an appropriate linear combination of H₁, H₂, h₁, h₂, h₃
  -- it would be really nice here to have a linear algebra tactic!!
  apply_fun (λ p, 2 * X * p) at H₁,
  apply_fun (λ p, 2 * T R (m + k + 2) * p) at h₁,
  have e₁ := congr (congr_arg has_add.add H₁) h₁,
  have e₂ := congr (congr_arg has_sub.sub e₁) H₂,
  have e₃ := congr (congr_arg has_sub.sub e₂) h₂,
  have e₄ := congr (congr_arg has_sub.sub e₃) h₃,
  rw ← sub_eq_zero at e₄ ⊢,
  rw ← e₄,
  ring,
end

/-- The `(m * n)`-th Chebyshev polynomial is the composition of the `m`-th and `n`-th -/
lemma T_mul :
  ∀ m : ℕ, ∀ n : ℕ, T R (m * n) = (T R m).comp (T R n)
| 0 := by simp
| 1 := by simp
| (m + 2) := begin
  intros n,
  have : 2 * T R n * T R ((m + 1) * n) = T R ((m + 2) * n) + T R (m * n),
  { convert mul_T R n (m * n); ring },
  simp [this, T_mul m, ← T_mul (m + 1)]
end

end polynomial.chebyshev


section ex1

theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro,
  exact hp,
  apply and.intro,
  exact hq,
  exact hp,
end

theorem test' (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro hp,
  exact and.intro hq hp,
end

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    apply or.elim (and.right h),
      intro hq,
      apply or.inl,
      apply and.intro,
        exact and.left h,
      exact hq,
    intro hr,
    apply or.inr,
    apply and.intro,
      exact and.left h,
    exact hr,
  intro h,
  apply or.elim h,
    intro hpq,
    apply and.intro,
      exact and.left hpq,
    apply or.inl,
    exact and.right hpq,
  intro hpr,
  apply and.intro,
    exact and.left hpr,
  apply or.inr,
  exact and.right hpr,
end

example (α : Type*) : α → α :=
begin
  intro a,
  exact a,
end

end ex1


/-
Copyright (c) 2020. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning, Patrick Massot

! This file was ported from Lean 3 source module tactic.group
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Tactic.Ring
import Mathlib.Tactic.FailIfNoProgress
import Mathlib.Algebra.Group.Commutator

/-!
# `group` tactic

Normalizes expressions in the language of groups. The basic idea is to use the simplifier
to put everything into a product of group powers (`zpow` which takes a group element and an
integer), then simplify the exponents using the `ring` tactic. The process needs to be repeated
since `ring` can normalize an exponent to zero, leading to a factor that can be removed
before collecting exponents again. The simplifier step also uses some extra lemmas to avoid
some `ring` invocations.

## Tags

group_theory
-/

namespace Mathlib.Tactic.Group

open Lean
open Lean.Meta
open Lean.Parser.Tactic
open Lean.Elab.Tactic

-- The next three lemmas are not general purpose lemmas, they are intended for use only by
-- the `group` tactic.
@[to_additive]
theorem zpow_trick {G : Type _} [Group G] (a b : G) (n m : ℤ) :
    a * b ^ n * b ^ m = a * b ^ (n + m) := by rw [mul_assoc, ← zpow_add]
#align tactic.group.zpow_trick Mathlib.Tactic.Group.zpow_trick
#align tactic.group.zsmul_trick Mathlib.Tactic.Group.zsmul_trick

@[to_additive]
theorem zpow_trick_one {G : Type _} [Group G] (a b : G) (m : ℤ) :
    a * b * b ^ m = a * b ^ (m + 1) := by rw [mul_assoc, mul_self_zpow]
#align tactic.group.zpow_trick_one Mathlib.Tactic.Group.zpow_trick_one
#align tactic.group.zsmul_trick_zero Mathlib.Tactic.Group.zsmul_trick_zero

@[to_additive]
theorem zpow_trick_one' {G : Type _} [Group G] (a b : G) (n : ℤ) :
    a * b ^ n * b = a * b ^ (n + 1) := by rw [mul_assoc, mul_zpow_self]
#align tactic.group.zpow_trick_one' Mathlib.Tactic.Group.zpow_trick_one'
#align tactic.group.zsmul_trick_zero' Mathlib.Tactic.Group.zsmul_trick_zero'

/-- Auxiliary tactic for the `group` tactic. Calls the simplifier only. -/
syntax (name := aux_group₁) "aux_group₁" (ppSpace location)? : tactic

macro_rules
| `(tactic| aux_group₁ $[at $location]?) =>
  `(tactic| simp (config := {decide := false}) only
    [commutatorElement_def, mul_one, one_mul,
      ←zpow_neg_one, ←zpow_ofNat, ←zpow_mul,
      Int.ofNat_add, Int.ofNat_mul,
      Int.mul_neg_eq_neg_mul_symm, Int.neg_mul_eq_neg_mul_symm, neg_neg,
      one_zpow, zpow_zero, zpow_one, mul_zpow_neg_one,
      ←mul_assoc,
      ←zpow_add, ←zpow_add_one, ←zpow_one_add, zpow_trick, zpow_trick_one, zpow_trick_one',
      tsub_self, sub_self, add_neg_self, neg_add_self]
  $[at $location]?)

/-- Auxiliary tactic for the `group` tactic. Calls `ring_nf` to normalize exponents. -/
syntax (name := aux_group₂) "aux_group₂" (ppSpace location)? : tactic

macro_rules
| `(tactic| aux_group₂ $[at $location]?) =>
  `(tactic| ring_nf $[at $location]?)

/-- Tactic for normalizing expressions in multiplicative groups, without assuming
commutativity, using only the group axioms without any information about which group
is manipulated.

(For additive commutative groups, use the `abel` tactic instead.)

Example:
```lean
example {G : Type} [group G] (a b c d : G) (h : c = (a*b^2)*((b*b)⁻¹*a⁻¹)*d) : a*c*d⁻¹ = a :=
begin
  group at h, -- normalizes `h` which becomes `h : c = d`
  rw h,       -- the goal is now `a*d*d⁻¹ = a`
  group,      -- which then normalized and closed
end
```
-/
syntax (name := group) "group" (ppSpace location)? : tactic

macro_rules
| `(tactic| group $[$loc]?) =>
  `(tactic| repeat (fail_if_no_progress (aux_group₁ $[$loc]? <;> aux_group₂ $[$loc]?)))


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import data.fintype.perm
import group_theory.perm.sign
import logic.equiv.option

/-!
# Permutations of `option α`

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

@[simp] lemma equiv.option_congr_one {α : Type*} : (1 : perm α).option_congr = 1 :=
equiv.option_congr_refl

@[simp] lemma equiv.option_congr_swap {α : Type*} [decidable_eq α] (x y : α) :
  option_congr (swap x y) = swap (some x) (some y) :=
begin
  ext (_ | i),
  { simp [swap_apply_of_ne_of_ne] },
  { by_cases hx : i = x,
    simp [hx, swap_apply_of_ne_of_ne],
    by_cases hy : i = y;
    simp [hx, hy, swap_apply_of_ne_of_ne], }
end

@[simp] lemma equiv.option_congr_sign {α : Type*} [decidable_eq α] [fintype α] (e : perm α) :
  perm.sign e.option_congr = perm.sign e :=
begin
  apply perm.swap_induction_on e,
  { simp [perm.one_def] },
  { intros f x y hne h,
    simp [h, hne, perm.mul_def, ←equiv.option_congr_trans] }
end

@[simp] lemma map_equiv_remove_none {α : Type*} [decidable_eq α] (σ : perm (option α)) :
  (remove_none σ).option_congr = swap none (σ none) * σ :=
begin
  ext1 x,
  have : option.map ⇑(remove_none σ) x = (swap none (σ none)) (σ x),
  { cases x,
    { simp },
    { cases h : σ (some x),
      { simp [remove_none_none _ h], },
      { have hn : σ (some x) ≠ none := by simp [h],
        have hσn : σ (some x) ≠ σ none := σ.injective.ne (by simp),
        simp [remove_none_some _ ⟨_, h⟩, ←h, swap_apply_of_ne_of_ne hn hσn] } } },
  simpa using this,
end

/-- Permutations of `option α` are equivalent to fixing an
`option α` and permuting the remaining with a `perm α`.
The fixed `option α` is swapped with `none`. -/
@[simps] def equiv.perm.decompose_option {α : Type*} [decidable_eq α] :
  perm (option α) ≃ option α × perm α :=
{ to_fun := λ σ, (σ none, remove_none σ),
  inv_fun := λ i, swap none i.1 * i.2.option_congr,
  left_inv := λ σ, by simp,
  right_inv := λ ⟨x, σ⟩, begin
    have : remove_none (swap none x * σ.option_congr) = σ :=
      equiv.option_congr_injective (by simp [←mul_assoc]),
    simp [←perm.eq_inv_iff_eq, this],
  end }

lemma equiv.perm.decompose_option_symm_of_none_apply {α : Type*} [decidable_eq α]
  (e : perm α) (i : option α) :
  equiv.perm.decompose_option.symm (none, e) i = i.map e :=
by simp

lemma equiv.perm.decompose_option_symm_sign {α : Type*} [decidable_eq α] [fintype α] (e : perm α) :
  perm.sign (equiv.perm.decompose_option.symm (none, e)) = perm.sign e :=
by simp

/-- The set of all permutations of `option α` can be constructed by augmenting the set of
permutations of `α` by each element of `option α` in turn. -/
lemma finset.univ_perm_option {α : Type*} [decidable_eq α] [fintype α] :
  @finset.univ (perm $ option α) _ =
    (finset.univ : finset $ option α × perm α).map equiv.perm.decompose_option.symm.to_embedding :=
(finset.univ_map_equiv_to_embedding _).symm


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bryan Gin-ge Chen, Yaël Dillies

! This file was ported from Lean 3 source module algebra.ring.boolean_ring
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.PunitInstances
import Mathbin.Tactic.Abel
import Mathbin.Tactic.Ring
import Mathbin.Order.Hom.Lattice

/-!
# Boolean rings

A Boolean ring is a ring where multiplication is idempotent. They are equivalent to Boolean
algebras.

## Main declarations

* `boolean_ring`: a typeclass for rings where multiplication is idempotent.
* `boolean_ring.to_boolean_algebra`: Turn a Boolean ring into a Boolean algebra.
* `boolean_algebra.to_boolean_ring`: Turn a Boolean algebra into a Boolean ring.
* `as_boolalg`: Type-synonym for the Boolean algebra associated to a Boolean ring.
* `as_boolring`: Type-synonym for the Boolean ring associated to a Boolean algebra.

## Implementation notes

We provide two ways of turning a Boolean algebra/ring into a Boolean ring/algebra:
* Instances on the same type accessible in locales `boolean_algebra_of_boolean_ring` and
  `boolean_ring_of_boolean_algebra`.
* Type-synonyms `as_boolalg` and `as_boolring`.

At this point in time, it is not clear the first way is useful, but we keep it for educational
purposes and because it is easier than dealing with
`of_boolalg`/`to_boolalg`/`of_boolring`/`to_boolring` explicitly.

## Tags

boolean ring, boolean algebra
-/

variable {α β γ : Type _}

/-- A Boolean ring is a ring where multiplication is idempotent. -/
class BooleanRing (α) extends Ring α where
  mul_self : ∀ a : α, a * a = a
#align boolean_ring BooleanRing

section BooleanRing

variable [BooleanRing α] (a b : α)

instance : IsIdempotent α (· * ·) :=
  ⟨BooleanRing.mul_self⟩

@[simp]
theorem mul_self : a * a = a :=
  BooleanRing.mul_self _
#align mul_self mul_self

@[simp]
theorem add_self : a + a = 0 :=
  by
  have : a + a = a + a + (a + a) :=
    calc
      a + a = (a + a) * (a + a) := by rw [mul_self]
      _ = a * a + a * a + (a * a + a * a) := by rw [add_mul, mul_add]
      _ = a + a + (a + a) := by rw [mul_self]

  rwa [self_eq_add_left] at this
#align add_self add_self

@[simp]
theorem neg_eq : -a = a :=
  calc
    -a = -a + 0 := by rw [add_zero]
    _ = -a + -a + a := by rw [← neg_add_self, add_assoc]
    _ = a := by rw [add_self, zero_add]

#align neg_eq neg_eq

theorem add_eq_zero : a + b = 0 ↔ a = b :=
  calc
    a + b = 0 ↔ a = -b := add_eq_zero_iff_eq_neg
    _ ↔ a = b := by rw [neg_eq]

#align add_eq_zero add_eq_zero

@[simp]
theorem mul_add_mul : a * b + b * a = 0 :=
  by
  have : a + b = a + b + (a * b + b * a) :=
    calc
      a + b = (a + b) * (a + b) := by rw [mul_self]
      _ = a * a + a * b + (b * a + b * b) := by rw [add_mul, mul_add, mul_add]
      _ = a + a * b + (b * a + b) := by simp only [mul_self]
      _ = a + b + (a * b + b * a) := by abel

  rwa [self_eq_add_right] at this
#align mul_add_mul mul_add_mul

@[simp]
theorem sub_eq_add : a - b = a + b := by rw [sub_eq_add_neg, add_right_inj, neg_eq]
#align sub_eq_add sub_eq_add

@[simp]
theorem mul_one_add_self : a * (1 + a) = 0 := by rw [mul_add, mul_one, mul_self, add_self]
#align mul_one_add_self mul_one_add_self

-- Note [lower instance priority]
instance (priority := 100) BooleanRing.toCommRing : CommRing α :=
  { (inferInstance : BooleanRing α) with mul_comm := fun a b => by rw [← add_eq_zero, mul_add_mul] }
#align boolean_ring.to_comm_ring BooleanRing.toCommRing

end BooleanRing

instance : BooleanRing PUnit :=
  ⟨fun _ => Subsingleton.elim _ _⟩

/-! ### Turning a Boolean ring into a Boolean algebra -/

section RingToAlgebra

/-- Type synonym to view a Boolean ring as a Boolean algebra. -/
def AsBoolalg (α : Type _) :=
  α
#align as_boolalg AsBoolalg

/-- The "identity" equivalence between `as_boolalg α` and `α`. -/
def toBoolalg : α ≃ AsBoolalg α :=
  Equiv.refl _
#align to_boolalg toBoolalg

/-- The "identity" equivalence between `α` and `as_boolalg α`. -/
def ofBoolalg : AsBoolalg α ≃ α :=
  Equiv.refl _
#align of_boolalg ofBoolalg

@[simp]
theorem toBoolalg_symm_eq : (@toBoolalg α).symm = ofBoolalg :=
  rfl
#align to_boolalg_symm_eq toBoolalg_symm_eq

@[simp]
theorem ofBoolalg_symm_eq : (@ofBoolalg α).symm = toBoolalg :=
  rfl
#align of_boolalg_symm_eq ofBoolalg_symm_eq

@[simp]
theorem toBoolalg_ofBoolalg (a : AsBoolalg α) : toBoolalg (ofBoolalg a) = a :=
  rfl
#align to_boolalg_of_boolalg toBoolalg_ofBoolalg

@[simp]
theorem ofBoolalg_toBoolalg (a : α) : ofBoolalg (toBoolalg a) = a :=
  rfl
#align of_boolalg_to_boolalg ofBoolalg_toBoolalg

@[simp]
theorem toBoolalg_inj {a b : α} : toBoolalg a = toBoolalg b ↔ a = b :=
  Iff.rfl
#align to_boolalg_inj toBoolalg_inj

@[simp]
theorem ofBoolalg_inj {a b : AsBoolalg α} : ofBoolalg a = ofBoolalg b ↔ a = b :=
  Iff.rfl
#align of_boolalg_inj ofBoolalg_inj

instance [Inhabited α] : Inhabited (AsBoolalg α) :=
  ‹Inhabited α›

variable [BooleanRing α] [BooleanRing β] [BooleanRing γ]

namespace BooleanRing

/-- The join operation in a Boolean ring is `x + y + x * y`. -/
def hasSup : Sup α :=
  ⟨fun x y => x + y + x * y⟩
#align boolean_ring.has_sup BooleanRing.hasSup

/-- The meet operation in a Boolean ring is `x * y`. -/
def hasInf : Inf α :=
  ⟨(· * ·)⟩
#align boolean_ring.has_inf BooleanRing.hasInf

scoped[-- Note [lower instance priority]
BooleanAlgebraOfBooleanRing] attribute [instance] BooleanRing.hasSup

scoped[BooleanAlgebraOfBooleanRing] attribute [instance] BooleanRing.hasInf

theorem sup_comm (a b : α) : a ⊔ b = b ⊔ a :=
  by
  dsimp only [(· ⊔ ·)]
  ring
#align boolean_ring.sup_comm BooleanRing.sup_comm

theorem inf_comm (a b : α) : a ⊓ b = b ⊓ a :=
  by
  dsimp only [(· ⊓ ·)]
  ring
#align boolean_ring.inf_comm BooleanRing.inf_comm

theorem sup_assoc (a b c : α) : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) :=
  by
  dsimp only [(· ⊔ ·)]
  ring
#align boolean_ring.sup_assoc BooleanRing.sup_assoc

theorem inf_assoc (a b c : α) : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) :=
  by
  dsimp only [(· ⊓ ·)]
  ring
#align boolean_ring.inf_assoc BooleanRing.inf_assoc

theorem sup_inf_self (a b : α) : a ⊔ a ⊓ b = a :=
  by
  dsimp only [(· ⊔ ·), (· ⊓ ·)]
  assoc_rw [mul_self, add_self, add_zero]
#align boolean_ring.sup_inf_self BooleanRing.sup_inf_self

theorem inf_sup_self (a b : α) : a ⊓ (a ⊔ b) = a :=
  by
  dsimp only [(· ⊔ ·), (· ⊓ ·)]
  rw [mul_add, mul_add, mul_self, ← mul_assoc, mul_self, add_assoc, add_self, add_zero]
#align boolean_ring.inf_sup_self BooleanRing.inf_sup_self

theorem le_sup_inf_aux (a b c : α) : (a + b + a * b) * (a + c + a * c) = a + b * c + a * (b * c) :=
  calc
    (a + b + a * b) * (a + c + a * c) =
        a * a + b * c + a * (b * c) + (a * b + a * a * b) + (a * c + a * a * c) +
          (a * b * c + a * a * b * c) :=
      by ring
    _ = a + b * c + a * (b * c) := by simp only [mul_self, add_self, add_zero]

#align boolean_ring.le_sup_inf_aux BooleanRing.le_sup_inf_aux

theorem le_sup_inf (a b c : α) : (a ⊔ b) ⊓ (a ⊔ c) ⊔ (a ⊔ b ⊓ c) = a ⊔ b ⊓ c :=
  by
  dsimp only [(· ⊔ ·), (· ⊓ ·)]
  rw [le_sup_inf_aux, add_self, mul_self, zero_add]
#align boolean_ring.le_sup_inf BooleanRing.le_sup_inf

/-- The Boolean algebra structure on a Boolean ring.

The data is defined so that:
* `a ⊔ b` unfolds to `a + b + a * b`
* `a ⊓ b` unfolds to `a * b`
* `a ≤ b` unfolds to `a + b + a * b = b`
* `⊥` unfolds to `0`
* `⊤` unfolds to `1`
* `aᶜ` unfolds to `1 + a`
* `a \ b` unfolds to `a * (1 + b)`
-/
def toBooleanAlgebra : BooleanAlgebra α :=
  {
    Lattice.mk' sup_comm sup_assoc inf_comm inf_assoc sup_inf_self
      inf_sup_self with
    le_sup_inf := le_sup_inf
    top := 1
    le_top := fun a => show a + 1 + a * 1 = 1 by assoc_rw [mul_one, add_comm, add_self, add_zero]
    bot := 0
    bot_le := fun a => show 0 + a + 0 * a = a by rw [MulZeroClass.zero_mul, zero_add, add_zero]
    compl := fun a => 1 + a
    inf_compl_le_bot := fun a =>
      show a * (1 + a) + 0 + a * (1 + a) * 0 = 0 by norm_num [mul_add, mul_self, add_self]
    top_le_sup_compl := fun a =>
      by
      change
        1 + (a + (1 + a) + a * (1 + a)) + 1 * (a + (1 + a) + a * (1 + a)) =
          a + (1 + a) + a * (1 + a)
      norm_num [mul_add, mul_self]
      rw [← add_assoc, add_self] }
#align boolean_ring.to_boolean_algebra BooleanRing.toBooleanAlgebra

scoped[BooleanAlgebraOfBooleanRing] attribute [instance] BooleanRing.toBooleanAlgebra

end BooleanRing

instance : BooleanAlgebra (AsBoolalg α) :=
  @BooleanRing.toBooleanAlgebra α _

@[simp]
theorem ofBoolalg_top : ofBoolalg (⊤ : AsBoolalg α) = 1 :=
  rfl
#align of_boolalg_top ofBoolalg_top

@[simp]
theorem ofBoolalg_bot : ofBoolalg (⊥ : AsBoolalg α) = 0 :=
  rfl
#align of_boolalg_bot ofBoolalg_bot

@[simp]
theorem ofBoolalg_sup (a b : AsBoolalg α) :
    ofBoolalg (a ⊔ b) = ofBoolalg a + ofBoolalg b + ofBoolalg a * ofBoolalg b :=
  rfl
#align of_boolalg_sup ofBoolalg_sup

@[simp]
theorem ofBoolalg_inf (a b : AsBoolalg α) : ofBoolalg (a ⊓ b) = ofBoolalg a * ofBoolalg b :=
  rfl
#align of_boolalg_inf ofBoolalg_inf

@[simp]
theorem ofBoolalg_compl (a : AsBoolalg α) : ofBoolalg (aᶜ) = 1 + ofBoolalg a :=
  rfl
#align of_boolalg_compl ofBoolalg_compl

@[simp]
theorem ofBoolalg_sdiff (a b : AsBoolalg α) : ofBoolalg (a \ b) = ofBoolalg a * (1 + ofBoolalg b) :=
  rfl
#align of_boolalg_sdiff ofBoolalg_sdiff

private theorem of_boolalg_symm_diff_aux (a b : α) : (a + b + a * b) * (1 + a * b) = a + b :=
  calc
    (a + b + a * b) * (1 + a * b) = a + b + (a * b + a * b * (a * b)) + (a * (b * b) + a * a * b) :=
      by ring
    _ = a + b := by simp only [mul_self, add_self, add_zero]

#align of_boolalg_symm_diff_aux of_boolalg_symm_diff_aux

@[simp]
theorem ofBoolalg_symmDiff (a b : AsBoolalg α) : ofBoolalg (a ∆ b) = ofBoolalg a + ofBoolalg b :=
  by
  rw [symmDiff_eq_sup_sdiff_inf]
  exact of_boolalg_symm_diff_aux _ _
#align of_boolalg_symm_diff ofBoolalg_symmDiff

@[simp]
theorem ofBoolalg_mul_ofBoolalg_eq_left_iff {a b : AsBoolalg α} :
    ofBoolalg a * ofBoolalg b = ofBoolalg a ↔ a ≤ b :=
  @inf_eq_left (AsBoolalg α) _ _ _
#align of_boolalg_mul_of_boolalg_eq_left_iff ofBoolalg_mul_ofBoolalg_eq_left_iff

@[simp]
theorem toBoolalg_zero : toBoolalg (0 : α) = ⊥ :=
  rfl
#align to_boolalg_zero toBoolalg_zero

@[simp]
theorem toBoolalg_one : toBoolalg (1 : α) = ⊤ :=
  rfl
#align to_boolalg_one toBoolalg_one

@[simp]
theorem toBoolalg_mul (a b : α) : toBoolalg (a * b) = toBoolalg a ⊓ toBoolalg b :=
  rfl
#align to_boolalg_mul toBoolalg_mul

-- `to_boolalg_add` simplifies the LHS but this lemma is eligible to `dsimp`
@[simp, nolint simp_nf]
theorem toBoolalg_add_add_mul (a b : α) : toBoolalg (a + b + a * b) = toBoolalg a ⊔ toBoolalg b :=
  rfl
#align to_boolalg_add_add_mul toBoolalg_add_add_mul

@[simp]
theorem toBoolalg_add (a b : α) : toBoolalg (a + b) = toBoolalg a ∆ toBoolalg b :=
  (ofBoolalg_symmDiff _ _).symm
#align to_boolalg_add toBoolalg_add

/-- Turn a ring homomorphism from Boolean rings `α` to `β` into a bounded lattice homomorphism
from `α` to `β` considered as Boolean algebras. -/
@[simps]
protected def RingHom.asBoolalg (f : α →+* β) : BoundedLatticeHom (AsBoolalg α) (AsBoolalg β)
    where
  toFun := toBoolalg ∘ f ∘ ofBoolalg
  map_sup' a b := by
    dsimp
    simp_rw [map_add f, map_mul f]
    rfl
  map_inf' := f.map_mul'
  map_top' := f.map_one'
  map_bot' := f.map_zero'
#align ring_hom.as_boolalg RingHom.asBoolalg

@[simp]
theorem RingHom.asBoolalg_id : (RingHom.id α).AsBoolalg = BoundedLatticeHom.id _ :=
  rfl
#align ring_hom.as_boolalg_id RingHom.asBoolalg_id

@[simp]
theorem RingHom.asBoolalg_comp (g : β →+* γ) (f : α →+* β) :
    (g.comp f).AsBoolalg = g.AsBoolalg.comp f.AsBoolalg :=
  rfl
#align ring_hom.as_boolalg_comp RingHom.asBoolalg_comp

end RingToAlgebra

/-! ### Turning a Boolean algebra into a Boolean ring -/

section AlgebraToRing

/-- Type synonym to view a Boolean ring as a Boolean algebra. -/
def AsBoolring (α : Type _) :=
  α
#align as_boolring AsBoolring

/-- The "identity" equivalence between `as_boolring α` and `α`. -/
def toBoolring : α ≃ AsBoolring α :=
  Equiv.refl _
#align to_boolring toBoolring

/-- The "identity" equivalence between `α` and `as_boolring α`. -/
def ofBoolring : AsBoolring α ≃ α :=
  Equiv.refl _
#align of_boolring ofBoolring

@[simp]
theorem toBoolring_symm_eq : (@toBoolring α).symm = ofBoolring :=
  rfl
#align to_boolring_symm_eq toBoolring_symm_eq

@[simp]
theorem ofBoolring_symm_eq : (@ofBoolring α).symm = toBoolring :=
  rfl
#align of_boolring_symm_eq ofBoolring_symm_eq

@[simp]
theorem toBoolring_ofBoolring (a : AsBoolring α) : toBoolring (ofBoolring a) = a :=
  rfl
#align to_boolring_of_boolring toBoolring_ofBoolring

@[simp]
theorem ofBoolring_toBoolring (a : α) : ofBoolring (toBoolring a) = a :=
  rfl
#align of_boolring_to_boolring ofBoolring_toBoolring

@[simp]
theorem toBoolring_inj {a b : α} : toBoolring a = toBoolring b ↔ a = b :=
  Iff.rfl
#align to_boolring_inj toBoolring_inj

@[simp]
theorem ofBoolring_inj {a b : AsBoolring α} : ofBoolring a = ofBoolring b ↔ a = b :=
  Iff.rfl
#align of_boolring_inj ofBoolring_inj

instance [Inhabited α] : Inhabited (AsBoolring α) :=
  ‹Inhabited α›

-- See note [reducible non-instances]
/-- Every generalized Boolean algebra has the structure of a non unital commutative ring with the
following data:

* `a + b` unfolds to `a ∆ b` (symmetric difference)
* `a * b` unfolds to `a ⊓ b`
* `-a` unfolds to `a`
* `0` unfolds to `⊥`
-/
@[reducible]
def GeneralizedBooleanAlgebra.toNonUnitalCommRing [GeneralizedBooleanAlgebra α] :
    NonUnitalCommRing α where
  add := (· ∆ ·)
  add_assoc := symmDiff_assoc
  zero := ⊥
  zero_add := bot_symmDiff
  add_zero := symmDiff_bot
  zero_mul _ := bot_inf_eq
  mul_zero _ := inf_bot_eq
  neg := id
  add_left_neg := symmDiff_self
  add_comm := symmDiff_comm
  mul := (· ⊓ ·)
  mul_assoc _ _ _ := inf_assoc
  mul_comm _ _ := inf_comm
  left_distrib := inf_symmDiff_distrib_left
  right_distrib := inf_symmDiff_distrib_right
#align generalized_boolean_algebra.to_non_unital_comm_ring GeneralizedBooleanAlgebra.toNonUnitalCommRing

instance [GeneralizedBooleanAlgebra α] : NonUnitalCommRing (AsBoolring α) :=
  @GeneralizedBooleanAlgebra.toNonUnitalCommRing α _

variable [BooleanAlgebra α] [BooleanAlgebra β] [BooleanAlgebra γ]

-- See note [reducible non-instances]
/-- Every Boolean algebra has the structure of a Boolean ring with the following data:

* `a + b` unfolds to `a ∆ b` (symmetric difference)
* `a * b` unfolds to `a ⊓ b`
* `-a` unfolds to `a`
* `0` unfolds to `⊥`
* `1` unfolds to `⊤`
-/
@[reducible]
def BooleanAlgebra.toBooleanRing : BooleanRing α :=
  {
    GeneralizedBooleanAlgebra.toNonUnitalCommRing with
    one := ⊤
    one_mul := fun _ => top_inf_eq
    mul_one := fun _ => inf_top_eq
    mul_self := fun b => inf_idem }
#align boolean_algebra.to_boolean_ring BooleanAlgebra.toBooleanRing

scoped[BooleanRingOfBooleanAlgebra]
  attribute [instance] GeneralizedBooleanAlgebra.toNonUnitalCommRing BooleanAlgebra.toBooleanRing

instance : BooleanRing (AsBoolring α) :=
  @BooleanAlgebra.toBooleanRing α _

@[simp]
theorem ofBoolring_zero : ofBoolring (0 : AsBoolring α) = ⊥ :=
  rfl
#align of_boolring_zero ofBoolring_zero

@[simp]
theorem ofBoolring_one : ofBoolring (1 : AsBoolring α) = ⊤ :=
  rfl
#align of_boolring_one ofBoolring_one

-- `sub_eq_add` proves this lemma but it is eligible for `dsimp`
@[simp, nolint simp_nf]
theorem ofBoolring_neg (a : AsBoolring α) : ofBoolring (-a) = ofBoolring a :=
  rfl
#align of_boolring_neg ofBoolring_neg

@[simp]
theorem ofBoolring_add (a b : AsBoolring α) : ofBoolring (a + b) = ofBoolring a ∆ ofBoolring b :=
  rfl
#align of_boolring_add ofBoolring_add

-- `sub_eq_add` simplifies the LHS but this lemma is eligible for `dsimp`
@[simp, nolint simp_nf]
theorem ofBoolring_sub (a b : AsBoolring α) : ofBoolring (a - b) = ofBoolring a ∆ ofBoolring b :=
  rfl
#align of_boolring_sub ofBoolring_sub

@[simp]
theorem ofBoolring_mul (a b : AsBoolring α) : ofBoolring (a * b) = ofBoolring a ⊓ ofBoolring b :=
  rfl
#align of_boolring_mul ofBoolring_mul

@[simp]
theorem ofBoolring_le_ofBoolring_iff {a b : AsBoolring α} :
    ofBoolring a ≤ ofBoolring b ↔ a * b = a :=
  inf_eq_left.symm
#align of_boolring_le_of_boolring_iff ofBoolring_le_ofBoolring_iff

@[simp]
theorem toBoolring_bot : toBoolring (⊥ : α) = 0 :=
  rfl
#align to_boolring_bot toBoolring_bot

@[simp]
theorem toBoolring_top : toBoolring (⊤ : α) = 1 :=
  rfl
#align to_boolring_top toBoolring_top

@[simp]
theorem toBoolring_inf (a b : α) : toBoolring (a ⊓ b) = toBoolring a * toBoolring b :=
  rfl
#align to_boolring_inf toBoolring_inf

@[simp]
theorem toBoolring_symmDiff (a b : α) : toBoolring (a ∆ b) = toBoolring a + toBoolring b :=
  rfl
#align to_boolring_symm_diff toBoolring_symmDiff

/-- Turn a bounded lattice homomorphism from Boolean algebras `α` to `β` into a ring homomorphism
from `α` to `β` considered as Boolean rings. -/
@[simps]
protected def BoundedLatticeHom.asBoolring (f : BoundedLatticeHom α β) :
    AsBoolring α →+* AsBoolring β
    where
  toFun := toBoolring ∘ f ∘ ofBoolring
  map_zero' := f.map_bot'
  map_one' := f.map_top'
  map_add' := map_symm_diff' f
  map_mul' := f.map_inf'
#align bounded_lattice_hom.as_boolring BoundedLatticeHom.asBoolring

@[simp]
theorem BoundedLatticeHom.asBoolring_id : (BoundedLatticeHom.id α).AsBoolring = RingHom.id _ :=
  rfl
#align bounded_lattice_hom.as_boolring_id BoundedLatticeHom.asBoolring_id

@[simp]
theorem BoundedLatticeHom.asBoolring_comp (g : BoundedLatticeHom β γ) (f : BoundedLatticeHom α β) :
    (g.comp f).AsBoolring = g.AsBoolring.comp f.AsBoolring :=
  rfl
#align bounded_lattice_hom.as_boolring_comp BoundedLatticeHom.asBoolring_comp

end AlgebraToRing

/-! ### Equivalence between Boolean rings and Boolean algebras -/

/-- Order isomorphism between `α` considered as a Boolean ring considered as a Boolean algebra and
`α`. -/
@[simps]
def OrderIso.asBoolalgAsBoolring (α : Type _) [BooleanAlgebra α] : AsBoolalg (AsBoolring α) ≃o α :=
  ⟨ofBoolalg.trans ofBoolring, fun a b =>
    ofBoolring_le_ofBoolring_iff.trans ofBoolalg_mul_ofBoolalg_eq_left_iff⟩
#align order_iso.as_boolalg_as_boolring OrderIso.asBoolalgAsBoolring

/-- Ring isomorphism between `α` considered as a Boolean algebra considered as a Boolean ring and
`α`. -/
@[simps]
def RingEquiv.asBoolringAsBoolalg (α : Type _) [BooleanRing α] : AsBoolring (AsBoolalg α) ≃+* α :=
  { ofBoolring.trans ofBoolalg with
    map_mul' := fun a b => rfl
    map_add' := ofBoolalg_symmDiff }
#align ring_equiv.as_boolring_as_boolalg RingEquiv.asBoolringAsBoolalg

open Bool

instance : BooleanRing Bool where
  add := xor
  add_assoc := xor_assoc
  zero := false
  zero_add := Bool.false_xor
  add_zero := Bool.xor_false
  neg := id
  sub := xor
  sub_eq_add_neg _ _ := rfl
  add_left_neg := Bool.xor_self
  add_comm := xor_comm
  one := true
  mul := and
  mul_assoc := and_assoc
  one_mul := Bool.true_and
  mul_one := Bool.and_true
  left_distrib := and_xor_distrib_left
  right_distrib := and_xor_distrib_right
  mul_self := Bool.and_self


import data.list
import data.finset
import order
import lib.list.defs

variable {α : Type*}

section list_in

def list.in_superset {l : list α}
  {S T : finset α} (h : S ⊆ T) : l.in S → l.in T :=
λ l_in_S a al, h (l_in_S _ al)

def list.subset_in {l1 l2 : list α} {S : finset α}
  (h : l1 ⊆ l2) (h_l2 : l2.in S) : l1.in S :=
  λ a ha, h_l2 a (h ha)

@[simp]
theorem list.nil_in {S : finset α} : [].in S :=
  by rw list.in; simp

@[simp]
theorem list.cons_in
  {a : α} {l : list α} {S : finset α} :
  (a :: l).in S ↔ a ∈ S ∧ l.in S :=
  by simp [list.in]; exact finset.insert_subset

@[simp]
theorem list.append_in
  {l1 l2 : list α} {S : finset α} :
  (l1 ++ l2).in S ↔ l1.in S ∧ l2.in S :=
begin
  split,
  { intro h, split,
    intros a al1, apply h, exact list.mem_append_left l2 al1,
    intros a al2, apply h, exact list.mem_append_right l1 al2 },
  { intros h a al12, cases h with h1 h2,
    simp at al12, cases al12 with al1 al2,
    exact h1 _ al1, exact h2 _ al2, },
end

@[simp]
theorem list.reverse_in
  {l : list α} {S : finset α} : l.reverse.in S ↔ l.in S :=
by simp [list.in]

end list_in

@[simp]
theorem list.reverse_last' {l : list α} :
  l.reverse.last' = l.head' :=
by cases l; simp

@[simp]
theorem list.reverse_head' {l : list α} :
  l.reverse.head' = l.last' :=
begin convert (list.reverse_last').symm, simp end

section mirror

variable [linear_order α]

open order_dual

@[simp] theorem list.mirror_nil : ([] : list α).mirror = [] := rfl

@[simp] theorem list.mirror_singleton {a : α} :
  [a].mirror = [to_dual a] := rfl

@[simp] theorem list.mirror_cons {a : α} {l : list α} :
  (a :: l).mirror = l.mirror ++ [to_dual a] :=
by simp [list.mirror]

@[simp] theorem list.mirror_append {l1 l2 : list α} :
  (l1 ++ l2).mirror = l2.mirror ++ l1.mirror :=
by simp [list.mirror]

@[simp] theorem list.of_mirror_nil : ([] : list αᵒᵈ).of_mirror = [] := rfl

@[simp] theorem list.of_mirror_mirror {l : list αᵒᵈ} :
  l.of_mirror.mirror = l :=
begin
  induction l with a l ih, simp,
  rw [list.of_mirror, list.mirror]; simp,
  rw [list.of_mirror, list.mirror] at ih; simp at ih,
  exact ih
end

@[simp] theorem finset.of_mirror_mirror {S : finset αᵒᵈ} :
  S.of_mirror.mirror = S :=
begin
  rw [finset.of_mirror, finset.mirror]; simp,
  rw finset.image_image, convert finset.image_id,
  apply_instance,
end

@[simp] theorem list.mirror_length {l : list α} :
  l.mirror.length = l.length := by rw [list.mirror]; simp

theorem list.chain'_mirror {l : list α} :
  list.chain' (<) l.mirror ↔ list.chain' (<) l :=
begin
  rw [list.mirror, list.chain'_reverse, list.chain'_map, flip],
  simp,
end

theorem list.mirror_last' {l : list α} :
  l.mirror.last' = option.map to_dual l.head' :=
by rw [list.mirror]; cases l; simp; tauto

theorem list.mirror_head' {l : list α} :
  l.mirror.head' = option.map to_dual l.last' :=
begin
  rw [list.mirror, list.reverse_head'],
  -- quick-and-dirty proof
  induction l with a l ih, simp,
  simp, cases l with b l, simp,
  simp, simp at ih, exact ih,
end

theorem list.of_mirror_last' {l : list αᵒᵈ} :
  l.of_mirror.last' = option.map of_dual l.head' :=
by rw [list.of_mirror]; cases l; simp; tauto

theorem list.of_mirror_head' {l : list αᵒᵈ} :
  l.of_mirror.head' = option.map of_dual l.last' :=
begin
  rw [list.of_mirror, list.reverse_head'],
  -- quick-and-dirty proof
  induction l with a l ih, simp,
  simp, cases l with b l, simp,
  simp, simp at ih, exact ih,
end

theorem list.mirror_mem_last' {a : α} {l : list α} :
  to_dual a ∈ l.mirror.last' ↔ a ∈ l.head' :=
by rw [list.mirror]; cases l; simp

theorem list.mirror_mem_head' {a : α} {l : list α} :
  to_dual a ∈ l.mirror.head' ↔ a ∈ l.last'  :=
begin
  rw [list.mirror, list.reverse_head'],
  -- quick-and-dirty proof
  induction l with a l ih, simp,
  simp, cases l with b l, simp,
  simp, simp at ih, exact ih,
end

@[simp]
theorem list.mirror_in {l : list α} {S : finset α} :
  l.mirror.in S.mirror ↔ l.in S :=
begin
  rw list.mirror, simp, split,
  { simp [list.in, finset.mirror, has_subset.subset] },
  { simp [list.in, finset.mirror] }
end

@[simp]
theorem finset.mem_mirror {a : α} {S : finset α} :
  to_dual a ∈ S.mirror ↔ a ∈ S := by simp [finset.mirror]

@[simp]
theorem finset.mirror_card {S : finset α} :
  S.mirror.card = S.card :=
begin
  rw finset.mirror,
  apply S.card_image_of_injective,
  intros a b, simp,
end

end mirror

@[simp]
theorem list.init_singleton (a : α) : [a].init = [] := by rw list.init

@[simp]
theorem list.last'_cons_append_cons (a b : α) (l1 l2 : list α) :
  (a :: (l1 ++ b :: l2)).last' = (b :: l2).last' :=
by revert a; induction l1 with c l1 ih; simp; intro; exact ih c

def list.take_head' {a : α} : ∀ {l : list α} (h : a ∈ l.head'),
  Σ' t, l = a :: t
| [] h := by simp at h; exfalso; assumption
| (b :: t) h := ⟨t, by simp at ⊢ h; assumption⟩

def list.take_head : ∀ {l : list α}, l ≠ [] →
  Σ' (h1 : α) (t : list α), l = h1 :: t
| [] h := absurd rfl h
| (h1 :: t) _ := ⟨h1, t, rfl⟩

def list.take_head2 : ∀ {l : list α}, 2 ≤ l.length →
  Σ' (h1 h2 : α) (t : list α), l = h1 :: h2 :: t
| [] h := absurd h (of_to_bool_ff rfl)
| [a] h := absurd h (of_to_bool_ff rfl)
| (a :: b :: t) _ := ⟨a, b, t, rfl⟩

def list.take_head3 : ∀ {l : list α}, 3 ≤ l.length →
  Σ' (h1 h2 h3 : α) (t : list α), l = h1 :: h2 :: h3 :: t
| [] h := absurd h (of_to_bool_ff rfl)
| [a] h := absurd h (of_to_bool_ff rfl)
| [a, b] h := absurd h (of_to_bool_ff rfl)
| (a :: b :: c :: t) _ := ⟨a, b, c, t, rfl⟩

def list.take_last' {a : α} : ∀ {l : list α} (h : a ∈ l.last'),
  Σ' l', l = l' ++ [a]
| [] h := by simp at h; exfalso; assumption
| [a] h := ⟨[], by simp at ⊢ h; assumption⟩
| (b :: c :: t) h :=
  let h' : a ∈ (c :: t).last' := by
    simp only [option.mem_def, list.last'_cons_cons]; exact h in
  let ⟨l'', hl''⟩ := list.take_last' h' in
  ⟨b :: l'', by
    simp only [true_and, list.cons_append, eq_self_iff_true]; exact hl''⟩

def list.take_last : ∀ {l : list α}, l ≠ [] →
  Σ' (e1 : α) (m : list α), l = m ++ [e1]
| [] h := absurd rfl h
| [a] h := ⟨a, [], rfl⟩
| (a :: b :: rest) _ :=
  let h : b :: rest ≠ [] := λ h, list.no_confusion h in
  let ⟨e1, m', eq_l'⟩ := list.take_last h in
  ⟨e1, a :: m', congr_arg (list.cons a) eq_l'⟩

def list.take_last2 : ∀ {l : list α}, 2 ≤ l.length →
  Σ' (e1 e2 : α) (m : list α), l = m ++ [e1, e2]
| [] h := absurd h (of_to_bool_ff rfl)
| [a] h := absurd h (of_to_bool_ff rfl)
| [a, b] h := ⟨a, b, [], rfl⟩
| (a :: b :: c :: t) _ :=
  let h : 2 ≤ (b :: c :: t).length :=
    (2 : ℕ).le_add_left (list.length t) in
  let ⟨e1, e2, m', eq_l'⟩ := list.take_last2 h in
  ⟨e1, e2, a :: m', congr_arg (list.cons a) eq_l'⟩

def list.take_last3 : ∀ {l : list α}, 3 ≤ l.length →
  Σ' (e1 e2 e3 : α) (m : list α), l = m ++ [e1, e2, e3]
| [] h := absurd h (of_to_bool_ff rfl)
| [a] h := absurd h (of_to_bool_ff rfl)
| [a, b] h := absurd h (of_to_bool_ff rfl)
| [a, b, c] h := ⟨a, b, c, [], rfl⟩
| (a :: b :: c :: d :: t) _ :=
  let h : 3 ≤ (b :: c :: d :: t).length :=
    (3 : ℕ).le_add_left (list.length t) in
  let ⟨e1, e2, e3, m', eq_l'⟩ := list.take_last3 h in
  ⟨e1, e2, e3, a :: m', congr_arg (list.cons a) eq_l'⟩


/- Question 6 on John Britnell's handout
   for M1F group project on 18/10/18.
   Formalised by Kevin Buzzard, with many
   thanks to Gabriel Ebner for showing him
   how to do it.
-/

inductive fml
| atom (i : ℕ)
| imp (a b : fml)
| not (a : fml)

open fml

infixr ` →' `:50 := imp -- right associative

prefix `¬' `:40 := fml.not

inductive prf : fml → Type
| axk (p q) : prf (p →' q →' p)
| axs (p q r) : prf $ (p →' q →' r) →' (p →' q) →' (p →' r)
| axX (p q) : prf $ ((¬' q) →' (¬' p)) →' p →' q
| mp {p q} : prf (p →' q) → prf p → prf q -- bracket change

open prf

/-
-- example usage:

lemma p_of_p_of_p_of_q (p q : fml) : prf $ (p →' q) →' (p →' p) :=
begin
  apply mp (axs p q p),
  exact (axk p q)
end

-- or just

lemma p_of_p_of_p_of_q' (p q : fml) : prf $ (p →' q) →' (p →' p) :=
mp (axs p q p) (axk p q)
-/

theorem transitivity {p q r : fml} (HPQ : prf $ p →' q) (HQR : prf $ q →' r) : prf $ p →' r :=
begin
  have HQRPQR := axk (q →' r) p,
  have HPQR := mp HQRPQR HQR,
  have HPQPR := mp (axs p q r ) HPQR,
  exact mp HPQPR HPQ,
end

lemma Q6a (p : fml) : prf $ p →' p :=
begin
  have r : fml, exact p,
  have q := r →' p,
  have HPQP := axk p (r →' p),
  have HPQPP := mp (axs p (r →' p) p) HPQP,
  apply mp HPQPP,
  have HPRP := axk p r,
  -- How do I change (p →' q) into (p →' r →' p)?
  exact HPRP,
end

lemma contra_twice (p : fml) : prf $ ((¬' ¬' ¬' ¬' p) →' (¬' ¬' p)) →' ((¬' ¬' p) →' p) :=
begin
  have H1 := axX (¬' p) (¬' ¬' ¬' p),
  have H2 := axX (¬' ¬' p) p,
  exact transitivity H1 H2,
end

lemma PPQPQ (p q : fml) (HPPQ : prf (p →' (p →' q))) : prf $ (p →' q) :=
begin
  apply mp (mp (axs p p q) HPPQ),
  exact Q6a p,
end

lemma nnPP (p : fml) : prf $ (¬' ¬' p) →' p :=
begin
  have H1 := axk (¬' ¬' p) (¬' ¬' ¬' ¬' p),
  have H2 := transitivity H1 (contra_twice p),
  exact PPQPQ (¬' ¬' p) p H2,
end

theorem Q6b (p : fml) : prf $ p →' ¬' ¬' p :=
begin
  have H1 := nnPP (¬' p),
  exact mp (axX p (¬' ¬' p)) H1,
end


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import init.data.sigma.basic init.meta
universes u v
namespace psigma
section
  variables {α : Sort u} {β : α → Sort v}
  variable  (r  : α → α → Prop)
  variable  (s  : ∀ a, β a → β a → Prop)

  -- Lexicographical order based on r and s
  inductive lex : psigma β → psigma β → Prop
  | left  : ∀ {a₁ : α} (b₁ : β a₁) {a₂ : α} (b₂ : β a₂), r a₁ a₂ → lex ⟨a₁, b₁⟩ ⟨a₂, b₂⟩
  | right : ∀ (a : α)  {b₁ b₂ : β a}, s a b₁ b₂ → lex ⟨a, b₁⟩ ⟨a, b₂⟩
end

section
  open well_founded tactic
  parameters {α : Sort u} {β : α → Sort v}
  parameters {r  : α → α → Prop} {s : Π a : α, β a → β a → Prop}
  local infix `≺`:50 := lex r s

  lemma lex_accessible {a} (aca : acc r a) (acb : ∀ a, well_founded (s a))
                     : ∀ (b : β a), acc (lex r s) ⟨a, b⟩ :=
  acc.rec_on aca
    (λ xa aca (iha : ∀ y, r y xa → ∀ b : β y, acc (lex r s) ⟨y, b⟩),
      λ b : β xa, acc.rec_on (well_founded.apply (acb xa) b)
        (λ xb acb
          (ihb : ∀ (y : β xa), s xa y xb → acc (lex r s) ⟨xa, y⟩),
          acc.intro ⟨xa, xb⟩ (λ p (lt : p ≺ ⟨xa, xb⟩),
            have aux : xa = xa → xb == xb → acc (lex r s) p, from
              @psigma.lex.rec_on α β r s (λ p₁ p₂, p₂.1 = xa → p₂.2 == xb → acc (lex r s) p₁)
                                 p ⟨xa, xb⟩ lt
                (λ (a₁ : α) (b₁ : β a₁) (a₂ : α) (b₂ : β a₂) (h : r a₁ a₂) (eq₂ : a₂ = xa) (eq₃ : b₂ == xb),
                  begin subst eq₂, exact iha a₁ h b₁ end)
                (λ (a : α) (b₁ b₂ : β a) (h : s a b₁ b₂) (eq₂ : a = xa) (eq₃ : b₂ == xb),
                  begin
                    subst eq₂,
                    have new_eq₃ := eq_of_heq eq₃,
                    subst new_eq₃,
                    exact ihb b₁ h
                  end),
            aux rfl (heq.refl xb))))

  -- The lexicographical order of well founded relations is well-founded
  lemma lex_wf (ha : well_founded r) (hb : ∀ x, well_founded (s x)) : well_founded (lex r s) :=
  well_founded.intro $ λ ⟨a, b⟩, lex_accessible (well_founded.apply ha a) hb b
end

section
  parameters {α : Sort u} {β : Sort v}

  def lex_ndep (r : α → α → Prop) (s : β → β → Prop) :=
  lex r (λ a : α, s)

  lemma lex_ndep_wf {r  : α → α → Prop} {s : β → β → Prop} (ha : well_founded r)
    (hb : well_founded s) : well_founded (lex_ndep r s) :=
  well_founded.intro $ λ ⟨a, b⟩, lex_accessible (well_founded.apply ha a) (λ x, hb) b
end

section
  variables {α : Sort u} {β : Sort v}
  variable  (r  : α → α → Prop)
  variable  (s  : β → β → Prop)

  -- Reverse lexicographical order based on r and s
  inductive rev_lex : @psigma α (λ a, β) → @psigma α (λ a, β) → Prop
  | left  : ∀ {a₁ a₂ : α} (b : β), r a₁ a₂ → rev_lex ⟨a₁, b⟩ ⟨a₂, b⟩
  | right : ∀ (a₁ : α) {b₁ : β} (a₂ : α) {b₂ : β}, s b₁ b₂ → rev_lex ⟨a₁, b₁⟩ ⟨a₂, b₂⟩
end

section
  open well_founded tactic
  parameters {α : Sort u} {β : Sort v}
  parameters {r  : α → α → Prop} {s : β → β → Prop}
  local infix `≺`:50 := rev_lex r s

  lemma rev_lex_wf (ha : well_founded r) (hb : well_founded s) : well_founded (rev_lex r s) :=
  well_founded.intro $ λ ⟨a, b⟩, rev_lex_accessible (apply hb b) (well_founded.apply ha) a
end

section
  def skip_left (α : Type u) {β : Type v} (s : β → β → Prop) :
    @psigma α (λ a, β) → @psigma α (λ a, β) → Prop :=
  rev_lex empty_relation s

  lemma skip_left_wf (α : Type u) {β : Type v} {s : β → β → Prop} (hb : well_founded s) :
    well_founded (skip_left α s) :=
  rev_lex_wf empty_wf hb

  lemma mk_skip_left {α : Type u} {β : Type v} {b₁ b₂ : β} {s : β → β → Prop}
                   (a₁ a₂ : α) (h : s b₁ b₂) : skip_left α s ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ :=
  rev_lex.right _ _ h
end

instance has_well_founded {α : Type u} {β : α → Type v} [s₁ : has_well_founded α] [s₂ : ∀ a, has_well_founded (β a)] : has_well_founded (psigma β) :=
{r := lex s₁.r (λ a, (s₂ a).r), wf := lex_wf s₁.wf (λ a, (s₂ a).wf)}

end psigma


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.intervals.basic
import Mathlib.data.equiv.mul_add
import Mathlib.algebra.pointwise
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# (Pre)images of intervals

In this file we prove a bunch of trivial lemmas like “if we add `a` to all points of `[b, c]`,
then we get `[a + b, a + c]`”. For the functions `x ↦ x ± a`, `x ↦ a ± x`, and `x ↦ -x` we prove
lemmas about preimages and images of all intervals. We also prove a few lemmas about images under
`x ↦ a * x`, `x ↦ x * a` and `x ↦ x⁻¹`.

-/

namespace set

/-!
### Preimages under `x ↦ a + x`
-/

@[simp] theorem preimage_const_add_Ici {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a + x) ⁻¹' Ici b = Ici (b - a) :=
  ext fun (x : G) => iff.symm sub_le_iff_le_add'

@[simp] theorem preimage_const_add_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a + x) ⁻¹' Ioi b = Ioi (b - a) :=
  ext fun (x : G) => iff.symm sub_lt_iff_lt_add'

@[simp] theorem preimage_const_add_Iic {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a + x) ⁻¹' Iic b = Iic (b - a) :=
  ext fun (x : G) => iff.symm le_sub_iff_add_le'

@[simp] theorem preimage_const_add_Iio {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a + x) ⁻¹' Iio b = Iio (b - a) :=
  ext fun (x : G) => iff.symm lt_sub_iff_add_lt'

@[simp] theorem preimage_const_add_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a + x) ⁻¹' Icc b c = Icc (b - a) (c - a) := sorry

@[simp] theorem preimage_const_add_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a + x) ⁻¹' Ico b c = Ico (b - a) (c - a) := sorry

@[simp] theorem preimage_const_add_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a + x) ⁻¹' Ioc b c = Ioc (b - a) (c - a) := sorry

@[simp] theorem preimage_const_add_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a + x) ⁻¹' Ioo b c = Ioo (b - a) (c - a) := sorry

/-!
### Preimages under `x ↦ x + a`
-/

@[simp] theorem preimage_add_const_Ici {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x + a) ⁻¹' Ici b = Ici (b - a) :=
  ext fun (x : G) => iff.symm sub_le_iff_le_add

@[simp] theorem preimage_add_const_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x + a) ⁻¹' Ioi b = Ioi (b - a) :=
  ext fun (x : G) => iff.symm sub_lt_iff_lt_add

@[simp] theorem preimage_add_const_Iic {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x + a) ⁻¹' Iic b = Iic (b - a) :=
  ext fun (x : G) => iff.symm le_sub_iff_add_le

@[simp] theorem preimage_add_const_Iio {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x + a) ⁻¹' Iio b = Iio (b - a) :=
  ext fun (x : G) => iff.symm lt_sub_iff_add_lt

@[simp] theorem preimage_add_const_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x + a) ⁻¹' Icc b c = Icc (b - a) (c - a) := sorry

@[simp] theorem preimage_add_const_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x + a) ⁻¹' Ico b c = Ico (b - a) (c - a) := sorry

@[simp] theorem preimage_add_const_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x + a) ⁻¹' Ioc b c = Ioc (b - a) (c - a) := sorry

@[simp] theorem preimage_add_const_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x + a) ⁻¹' Ioo b c = Ioo (b - a) (c - a) := sorry

/-!
### Preimages under `x ↦ -x`
-/

@[simp] theorem preimage_neg_Ici {G : Type u} [ordered_add_comm_group G] (a : G) : -Ici a = Iic (-a) :=
  ext fun (x : G) => le_neg

@[simp] theorem preimage_neg_Iic {G : Type u} [ordered_add_comm_group G] (a : G) : -Iic a = Ici (-a) :=
  ext fun (x : G) => neg_le

@[simp] theorem preimage_neg_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) : -Ioi a = Iio (-a) :=
  ext fun (x : G) => lt_neg

@[simp] theorem preimage_neg_Iio {G : Type u} [ordered_add_comm_group G] (a : G) : -Iio a = Ioi (-a) :=
  ext fun (x : G) => neg_lt

@[simp] theorem preimage_neg_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : -Icc a b = Icc (-b) (-a) := sorry

@[simp] theorem preimage_neg_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : -Ico a b = Ioc (-b) (-a) := sorry

@[simp] theorem preimage_neg_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : -Ioc a b = Ico (-b) (-a) := sorry

@[simp] theorem preimage_neg_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : -Ioo a b = Ioo (-b) (-a) := sorry

/-!
### Preimages under `x ↦ x - a`
-/

@[simp] theorem preimage_sub_const_Ici {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x - a) ⁻¹' Ici b = Ici (b + a) := sorry

@[simp] theorem preimage_sub_const_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x - a) ⁻¹' Ioi b = Ioi (b + a) := sorry

@[simp] theorem preimage_sub_const_Iic {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x - a) ⁻¹' Iic b = Iic (b + a) := sorry

@[simp] theorem preimage_sub_const_Iio {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x - a) ⁻¹' Iio b = Iio (b + a) := sorry

@[simp] theorem preimage_sub_const_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x - a) ⁻¹' Icc b c = Icc (b + a) (c + a) := sorry

@[simp] theorem preimage_sub_const_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x - a) ⁻¹' Ico b c = Ico (b + a) (c + a) := sorry

@[simp] theorem preimage_sub_const_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x - a) ⁻¹' Ioc b c = Ioc (b + a) (c + a) := sorry

@[simp] theorem preimage_sub_const_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x - a) ⁻¹' Ioo b c = Ioo (b + a) (c + a) := sorry

/-!
### Preimages under `x ↦ a - x`
-/

@[simp] theorem preimage_const_sub_Ici {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a - x) ⁻¹' Ici b = Iic (a - b) :=
  ext fun (x : G) => le_sub

@[simp] theorem preimage_const_sub_Iic {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a - x) ⁻¹' Iic b = Ici (a - b) :=
  ext fun (x : G) => sub_le

@[simp] theorem preimage_const_sub_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a - x) ⁻¹' Ioi b = Iio (a - b) :=
  ext fun (x : G) => lt_sub

@[simp] theorem preimage_const_sub_Iio {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a - x) ⁻¹' Iio b = Ioi (a - b) :=
  ext fun (x : G) => sub_lt

@[simp] theorem preimage_const_sub_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a - x) ⁻¹' Icc b c = Icc (a - c) (a - b) := sorry

@[simp] theorem preimage_const_sub_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a - x) ⁻¹' Ico b c = Ioc (a - c) (a - b) := sorry

@[simp] theorem preimage_const_sub_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a - x) ⁻¹' Ioc b c = Ico (a - c) (a - b) := sorry

@[simp] theorem preimage_const_sub_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a - x) ⁻¹' Ioo b c = Ioo (a - c) (a - b) := sorry

/-!
### Images under `x ↦ a + x`
-/

@[simp] theorem image_const_add_Ici {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a + x) '' Ici b = Ici (a + b) := sorry

@[simp] theorem image_const_add_Iic {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a + x) '' Iic b = Iic (a + b) := sorry

@[simp] theorem image_const_add_Iio {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a + x) '' Iio b = Iio (a + b) := sorry

@[simp] theorem image_const_add_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a + x) '' Ioi b = Ioi (a + b) := sorry

@[simp] theorem image_const_add_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a + x) '' Icc b c = Icc (a + b) (a + c) := sorry

@[simp] theorem image_const_add_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a + x) '' Ico b c = Ico (a + b) (a + c) := sorry

@[simp] theorem image_const_add_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a + x) '' Ioc b c = Ioc (a + b) (a + c) := sorry

@[simp] theorem image_const_add_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a + x) '' Ioo b c = Ioo (a + b) (a + c) := sorry

/-!
### Images under `x ↦ x + a`
-/

@[simp] theorem image_add_const_Ici {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x + a) '' Ici b = Ici (a + b) := sorry

@[simp] theorem image_add_const_Iic {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x + a) '' Iic b = Iic (a + b) := sorry

@[simp] theorem image_add_const_Iio {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x + a) '' Iio b = Iio (a + b) := sorry

@[simp] theorem image_add_const_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x + a) '' Ioi b = Ioi (a + b) := sorry

@[simp] theorem image_add_const_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x + a) '' Icc b c = Icc (a + b) (a + c) := sorry

@[simp] theorem image_add_const_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x + a) '' Ico b c = Ico (a + b) (a + c) := sorry

@[simp] theorem image_add_const_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x + a) '' Ioc b c = Ioc (a + b) (a + c) := sorry

@[simp] theorem image_add_const_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x + a) '' Ioo b c = Ioo (a + b) (a + c) := sorry

/-!
### Images under `x ↦ -x`
-/

theorem image_neg_Ici {G : Type u} [ordered_add_comm_group G] (a : G) : Neg.neg '' Ici a = Iic (-a) := sorry

theorem image_neg_Iic {G : Type u} [ordered_add_comm_group G] (a : G) : Neg.neg '' Iic a = Ici (-a) := sorry

theorem image_neg_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) : Neg.neg '' Ioi a = Iio (-a) := sorry

theorem image_neg_Iio {G : Type u} [ordered_add_comm_group G] (a : G) : Neg.neg '' Iio a = Ioi (-a) := sorry

theorem image_neg_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : Neg.neg '' Icc a b = Icc (-b) (-a) := sorry

theorem image_neg_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : Neg.neg '' Ico a b = Ioc (-b) (-a) := sorry

theorem image_neg_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : Neg.neg '' Ioc a b = Ico (-b) (-a) := sorry

theorem image_neg_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : Neg.neg '' Ioo a b = Ioo (-b) (-a) := sorry

/-!
### Images under `x ↦ a - x`
-/

@[simp] theorem image_const_sub_Ici {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a - x) '' Ici b = Iic (a - b) := sorry

@[simp] theorem image_const_sub_Iic {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a - x) '' Iic b = Ici (a - b) := sorry

@[simp] theorem image_const_sub_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a - x) '' Ioi b = Iio (a - b) := sorry

@[simp] theorem image_const_sub_Iio {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => a - x) '' Iio b = Ioi (a - b) := sorry

@[simp] theorem image_const_sub_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a - x) '' Icc b c = Icc (a - c) (a - b) := sorry

@[simp] theorem image_const_sub_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a - x) '' Ico b c = Ioc (a - c) (a - b) := sorry

@[simp] theorem image_const_sub_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a - x) '' Ioc b c = Ico (a - c) (a - b) := sorry

@[simp] theorem image_const_sub_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => a - x) '' Ioo b c = Ioo (a - c) (a - b) := sorry

/-!
### Images under `x ↦ x - a`
-/

@[simp] theorem image_sub_const_Ici {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x - a) '' Ici b = Ici (b - a) := sorry

@[simp] theorem image_sub_const_Iic {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x - a) '' Iic b = Iic (b - a) := sorry

@[simp] theorem image_sub_const_Ioi {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x - a) '' Ioi b = Ioi (b - a) := sorry

@[simp] theorem image_sub_const_Iio {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) : (fun (x : G) => x - a) '' Iio b = Iio (b - a) := sorry

@[simp] theorem image_sub_const_Icc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x - a) '' Icc b c = Icc (b - a) (c - a) := sorry

@[simp] theorem image_sub_const_Ico {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x - a) '' Ico b c = Ico (b - a) (c - a) := sorry

@[simp] theorem image_sub_const_Ioc {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x - a) '' Ioc b c = Ioc (b - a) (c - a) := sorry

@[simp] theorem image_sub_const_Ioo {G : Type u} [ordered_add_comm_group G] (a : G) (b : G) (c : G) : (fun (x : G) => x - a) '' Ioo b c = Ioo (b - a) (c - a) := sorry

/-!
### Multiplication and inverse in a field
-/

@[simp] theorem preimage_mul_const_Iio {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) ⁻¹' Iio a = Iio (a / c) :=
  ext fun (x : k) => iff.symm (lt_div_iff h)

@[simp] theorem preimage_mul_const_Ioi {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) ⁻¹' Ioi a = Ioi (a / c) :=
  ext fun (x : k) => iff.symm (div_lt_iff h)

@[simp] theorem preimage_mul_const_Iic {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) ⁻¹' Iic a = Iic (a / c) :=
  ext fun (x : k) => iff.symm (le_div_iff h)

@[simp] theorem preimage_mul_const_Ici {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) ⁻¹' Ici a = Ici (a / c) :=
  ext fun (x : k) => iff.symm (div_le_iff h)

@[simp] theorem preimage_mul_const_Ioo {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) ⁻¹' Ioo a b = Ioo (a / c) (b / c) := sorry

@[simp] theorem preimage_mul_const_Ioc {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) ⁻¹' Ioc a b = Ioc (a / c) (b / c) := sorry

@[simp] theorem preimage_mul_const_Ico {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) ⁻¹' Ico a b = Ico (a / c) (b / c) := sorry

@[simp] theorem preimage_mul_const_Icc {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) ⁻¹' Icc a b = Icc (a / c) (b / c) := sorry

@[simp] theorem preimage_mul_const_Iio_of_neg {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : c < 0) : (fun (x : k) => x * c) ⁻¹' Iio a = Ioi (a / c) :=
  ext fun (x : k) => iff.symm (div_lt_iff_of_neg h)

@[simp] theorem preimage_mul_const_Ioi_of_neg {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : c < 0) : (fun (x : k) => x * c) ⁻¹' Ioi a = Iio (a / c) :=
  ext fun (x : k) => iff.symm (lt_div_iff_of_neg h)

@[simp] theorem preimage_mul_const_Iic_of_neg {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : c < 0) : (fun (x : k) => x * c) ⁻¹' Iic a = Ici (a / c) :=
  ext fun (x : k) => iff.symm (div_le_iff_of_neg h)

@[simp] theorem preimage_mul_const_Ici_of_neg {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : c < 0) : (fun (x : k) => x * c) ⁻¹' Ici a = Iic (a / c) :=
  ext fun (x : k) => iff.symm (le_div_iff_of_neg h)

@[simp] theorem preimage_mul_const_Ioo_of_neg {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : c < 0) : (fun (x : k) => x * c) ⁻¹' Ioo a b = Ioo (b / c) (a / c) := sorry

@[simp] theorem preimage_mul_const_Ioc_of_neg {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : c < 0) : (fun (x : k) => x * c) ⁻¹' Ioc a b = Ico (b / c) (a / c) := sorry

@[simp] theorem preimage_mul_const_Ico_of_neg {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : c < 0) : (fun (x : k) => x * c) ⁻¹' Ico a b = Ioc (b / c) (a / c) := sorry

@[simp] theorem preimage_mul_const_Icc_of_neg {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : c < 0) : (fun (x : k) => x * c) ⁻¹' Icc a b = Icc (b / c) (a / c) := sorry

@[simp] theorem preimage_const_mul_Iio {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : 0 < c) : Mul.mul c ⁻¹' Iio a = Iio (a / c) :=
  ext fun (x : k) => iff.symm (lt_div_iff' h)

@[simp] theorem preimage_const_mul_Ioi {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : 0 < c) : Mul.mul c ⁻¹' Ioi a = Ioi (a / c) :=
  ext fun (x : k) => iff.symm (div_lt_iff' h)

@[simp] theorem preimage_const_mul_Iic {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : 0 < c) : Mul.mul c ⁻¹' Iic a = Iic (a / c) :=
  ext fun (x : k) => iff.symm (le_div_iff' h)

@[simp] theorem preimage_const_mul_Ici {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : 0 < c) : Mul.mul c ⁻¹' Ici a = Ici (a / c) :=
  ext fun (x : k) => iff.symm (div_le_iff' h)

@[simp] theorem preimage_const_mul_Ioo {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : Mul.mul c ⁻¹' Ioo a b = Ioo (a / c) (b / c) := sorry

@[simp] theorem preimage_const_mul_Ioc {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : Mul.mul c ⁻¹' Ioc a b = Ioc (a / c) (b / c) := sorry

@[simp] theorem preimage_const_mul_Ico {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : Mul.mul c ⁻¹' Ico a b = Ico (a / c) (b / c) := sorry

@[simp] theorem preimage_const_mul_Icc {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : Mul.mul c ⁻¹' Icc a b = Icc (a / c) (b / c) := sorry

@[simp] theorem preimage_const_mul_Iio_of_neg {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : c < 0) : Mul.mul c ⁻¹' Iio a = Ioi (a / c) := sorry

@[simp] theorem preimage_const_mul_Ioi_of_neg {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : c < 0) : Mul.mul c ⁻¹' Ioi a = Iio (a / c) := sorry

@[simp] theorem preimage_const_mul_Iic_of_neg {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : c < 0) : Mul.mul c ⁻¹' Iic a = Ici (a / c) := sorry

@[simp] theorem preimage_const_mul_Ici_of_neg {k : Type u} [linear_ordered_field k] (a : k) {c : k} (h : c < 0) : Mul.mul c ⁻¹' Ici a = Iic (a / c) := sorry

@[simp] theorem preimage_const_mul_Ioo_of_neg {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : c < 0) : Mul.mul c ⁻¹' Ioo a b = Ioo (b / c) (a / c) := sorry

@[simp] theorem preimage_const_mul_Ioc_of_neg {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : c < 0) : Mul.mul c ⁻¹' Ioc a b = Ico (b / c) (a / c) := sorry

@[simp] theorem preimage_const_mul_Ico_of_neg {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : c < 0) : Mul.mul c ⁻¹' Ico a b = Ioc (b / c) (a / c) := sorry

@[simp] theorem preimage_const_mul_Icc_of_neg {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : c < 0) : Mul.mul c ⁻¹' Icc a b = Icc (b / c) (a / c) := sorry

theorem image_mul_right_Icc' {k : Type u} [linear_ordered_field k] (a : k) (b : k) {c : k} (h : 0 < c) : (fun (x : k) => x * c) '' Icc a b = Icc (a * c) (b * c) := sorry

theorem image_mul_right_Icc {k : Type u} [linear_ordered_field k] {a : k} {b : k} {c : k} (hab : a ≤ b) (hc : 0 ≤ c) : (fun (x : k) => x * c) '' Icc a b = Icc (a * c) (b * c) := sorry

theorem image_mul_left_Icc' {k : Type u} [linear_ordered_field k] {a : k} (h : 0 < a) (b : k) (c : k) : Mul.mul a '' Icc b c = Icc (a * b) (a * c) := sorry

theorem image_mul_left_Icc {k : Type u} [linear_ordered_field k] {a : k} {b : k} {c : k} (ha : 0 ≤ a) (hbc : b ≤ c) : Mul.mul a '' Icc b c = Icc (a * b) (a * c) := sorry

/-- The image under `inv` of `Ioo 0 a` is `Ioi a⁻¹`. -/
theorem image_inv_Ioo_0_left {k : Type u} [linear_ordered_field k] {a : k} (ha : 0 < a) : has_inv.inv '' Ioo 0 a = Ioi (a⁻¹) := sorry


theorem contrapositive (P Q : Prop) :
 (P → Q) → (¬ Q → ¬ P) :=
begin
  intro HPQ,
  intro HnQ,
  dunfold not,
  intro HP,
  change Q → false at HnQ,
  apply HnQ,
  apply HPQ,
  assumption
end


import linear_algebra.affine_space.independent
--import analysis.normed_space.inner_product

/-
IMO 2006 Problem 1

Let ABC be a triangle with incentre I. A point P in the interior of the
triangle satisfies

       ∠PBA + ∠PCA = ∠PBC + ∠PCB

Show that AP ≥ AI, and that equality holds if and only if P = I.

-/

/-
theorem imo2006_q1 (t: affine.triangle ℝ (euclidean_space ℝ (fin 2))) : Prop :=
begin
  sorry
end
-/