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

! This file was ported from Lean 3 source module analysis.calculus.darboux
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.LocalExtr

/-!
# Darboux's theorem

In this file we prove that the derivative of a differentiable function on an interval takes all
intermediate values. The proof is based on the
[Wikipedia](https://en.wikipedia.org/wiki/Darboux%27s_theorem_(analysis)) page about this theorem.
-/

open Filter Set

open Topology Classical

variable {a b : ℝ} {f f' : ℝ → ℝ}

/-- **Darboux's theorem**: if `a ≤ b` and `f' a < m < f' b`, then `f' c = m` for some
`c ∈ [a, b]`. -/
theorem exists_hasDerivWithinAt_eq_of_gt_of_lt (hab : a ≤ b)
    (hf : ∀ x ∈ Icc a b, HasDerivWithinAt f (f' x) (Icc a b) x) {m : ℝ} (hma : f' a < m)
    (hmb : m < f' b) : m ∈ f' '' Icc a b :=
  by
  have hab' : a < b := by
    refine' lt_of_le_of_ne hab fun hab' => _
    subst b
    exact lt_asymm hma hmb
  set g : ℝ → ℝ := fun x => f x - m * x
  have hg : ∀ x ∈ Icc a b, HasDerivWithinAt g (f' x - m) (Icc a b) x :=
    by
    intro x hx
    simpa using (hf x hx).sub ((hasDerivWithinAt_id x _).const_mul m)
  obtain ⟨c, cmem, hc⟩ : ∃ c ∈ Icc a b, IsMinOn g (Icc a b) c
  exact
    is_compact_Icc.exists_forall_le (nonempty_Icc.2 <| hab) fun x hx => (hg x hx).ContinuousWithinAt
  have cmem' : c ∈ Ioo a b := by
    cases' eq_or_lt_of_le cmem.1 with hac hac
    -- Show that `c` can't be equal to `a`
    · subst c
      refine'
        absurd (sub_nonneg.1 <| nonneg_of_mul_nonneg_right _ (sub_pos.2 hab')) (not_le_of_lt hma)
      have : b - a ∈ posTangentConeAt (Icc a b) a :=
        mem_posTangentConeAt_of_segment_subset (segment_eq_Icc hab ▸ subset.refl _)
      simpa [-sub_nonneg, -ContinuousLinearMap.map_sub] using
        hc.localize.has_fderiv_within_at_nonneg (hg a (left_mem_Icc.2 hab)) this
    cases' eq_or_lt_of_le cmem.2 with hbc hbc
    -- Show that `c` can't be equal to `b`
    · subst c
      refine'
        absurd (sub_nonpos.1 <| nonpos_of_mul_nonneg_right _ (sub_lt_zero.2 hab'))
          (not_le_of_lt hmb)
      have : a - b ∈ posTangentConeAt (Icc a b) b :=
        mem_posTangentConeAt_of_segment_subset (by rw [segment_symm, segment_eq_Icc hab])
      simpa [-sub_nonneg, -ContinuousLinearMap.map_sub] using
        hc.localize.has_fderiv_within_at_nonneg (hg b (right_mem_Icc.2 hab)) this
    exact ⟨hac, hbc⟩
  use c, cmem
  rw [← sub_eq_zero]
  have : Icc a b ∈ 𝓝 c := by rwa [← mem_interior_iff_mem_nhds, interior_Icc]
  exact (hc.is_local_min this).hasDerivAt_eq_zero ((hg c cmem).HasDerivAt this)
#align exists_has_deriv_within_at_eq_of_gt_of_lt exists_hasDerivWithinAt_eq_of_gt_of_lt

/-- **Darboux's theorem**: if `a ≤ b` and `f' a > m > f' b`, then `f' c = m` for some `c ∈ [a, b]`.
-/
theorem exists_hasDerivWithinAt_eq_of_lt_of_gt (hab : a ≤ b)
    (hf : ∀ x ∈ Icc a b, HasDerivWithinAt f (f' x) (Icc a b) x) {m : ℝ} (hma : m < f' a)
    (hmb : f' b < m) : m ∈ f' '' Icc a b :=
  let ⟨c, cmem, hc⟩ :=
    exists_hasDerivWithinAt_eq_of_gt_of_lt hab (fun x hx => (hf x hx).neg) (neg_lt_neg hma)
      (neg_lt_neg hmb)
  ⟨c, cmem, neg_injective hc⟩
#align exists_has_deriv_within_at_eq_of_lt_of_gt exists_hasDerivWithinAt_eq_of_lt_of_gt

/-- **Darboux's theorem**: the image of a convex set under `f'` is a convex set. -/
theorem convex_image_hasDerivAt {s : Set ℝ} (hs : Convex ℝ s)
    (hf : ∀ x ∈ s, HasDerivAt f (f' x) x) : Convex ℝ (f' '' s) :=
  by
  refine' ord_connected.convex ⟨_⟩
  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ m ⟨hma, hmb⟩
  cases' eq_or_lt_of_le hma with hma hma
  · exact hma ▸ mem_image_of_mem f' ha
  cases' eq_or_lt_of_le hmb with hmb hmb
  · exact hmb.symm ▸ mem_image_of_mem f' hb
  cases' le_total a b with hab hab
  · have : Icc a b ⊆ s := hs.ord_connected.out ha hb
    rcases exists_hasDerivWithinAt_eq_of_gt_of_lt hab
        (fun x hx => (hf x <| this hx).HasDerivWithinAt) hma hmb with
      ⟨c, cmem, hc⟩
    exact ⟨c, this cmem, hc⟩
  · have : Icc b a ⊆ s := hs.ord_connected.out hb ha
    rcases exists_hasDerivWithinAt_eq_of_lt_of_gt hab
        (fun x hx => (hf x <| this hx).HasDerivWithinAt) hmb hma with
      ⟨c, cmem, hc⟩
    exact ⟨c, this cmem, hc⟩
#align convex_image_has_deriv_at convex_image_hasDerivAt

/-- If the derivative of a function is never equal to `m`, then either
it is always greater than `m`, or it is always less than `m`. -/
theorem deriv_forall_lt_or_forall_gt_of_forall_ne {s : Set ℝ} (hs : Convex ℝ s)
    (hf : ∀ x ∈ s, HasDerivAt f (f' x) x) {m : ℝ} (hf' : ∀ x ∈ s, f' x ≠ m) :
    (∀ x ∈ s, f' x < m) ∨ ∀ x ∈ s, m < f' x :=
  by
  contrapose! hf'
  rcases hf' with ⟨⟨b, hb, hmb⟩, ⟨a, ha, hma⟩⟩
  exact
    (convex_image_hasDerivAt hs hf).OrdConnected.out (mem_image_of_mem f' ha)
      (mem_image_of_mem f' hb) ⟨hma, hmb⟩
#align deriv_forall_lt_or_forall_gt_of_forall_ne deriv_forall_lt_or_forall_gt_of_forall_ne


/-
Copyright (c) 2022 Michael Blyth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Blyth

! This file was ported from Lean 3 source module linear_algebra.projective_space.subspace
! 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.LinearAlgebra.ProjectiveSpace.Basic

/-!
# Subspaces of Projective Space

In this file we define subspaces of a projective space, and show that the subspaces of a projective
space form a complete lattice under inclusion.

## Implementation Details

A subspace of a projective space ℙ K V is defined to be a structure consisting of a subset of
ℙ K V such that if two nonzero vectors in V determine points in ℙ K V which are in the subset, and
the sum of the two vectors is nonzero, then the point determined by the sum of the two vectors is
also in the subset.

## Results

- There is a Galois insertion between the subsets of points of a projective space
  and the subspaces of the projective space, which is given by taking the span of the set of points.
- The subspaces of a projective space form a complete lattice under inclusion.

# Future Work
- Show that there is a one-to-one order-preserving correspondence between subspaces of a
  projective space and the submodules of the underlying vector space.
-/

variable (K V : Type _) [Field K] [AddCommGroup V] [Module K V]

namespace Projectivization

/-- A subspace of a projective space is a structure consisting of a set of points such that:
If two nonzero vectors determine points which are in the set, and the sum of the two vectors is
nonzero, then the point determined by the sum is also in the set. -/
@[ext]
structure Subspace where
  carrier : Set (ℙ K V)
  mem_add' (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
    mk K v hv ∈ carrier → mk K w hw ∈ carrier → mk K (v + w) hvw ∈ carrier
#align projectivization.subspace Projectivization.Subspace

namespace Subspace

variable {K V}

instance : SetLike (Subspace K V) (ℙ K V)
    where
  coe := carrier
  coe_injective' A B := by
    cases A
    cases B
    simp

@[simp]
theorem mem_carrier_iff (A : Subspace K V) (x : ℙ K V) : x ∈ A.carrier ↔ x ∈ A :=
  Iff.refl _
#align projectivization.subspace.mem_carrier_iff Projectivization.Subspace.mem_carrier_iff

theorem mem_add (T : Subspace K V) (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
    Projectivization.mk K v hv ∈ T →
      Projectivization.mk K w hw ∈ T → Projectivization.mk K (v + w) hvw ∈ T :=
  T.mem_add' v w hv hw hvw
#align projectivization.subspace.mem_add Projectivization.Subspace.mem_add

/-- The span of a set of points in a projective space is defined inductively to be the set of points
which contains the original set, and contains all points determined by the (nonzero) sum of two
nonzero vectors, each of which determine points in the span. -/
inductive spanCarrier (S : Set (ℙ K V)) : Set (ℙ K V)
  | of (x : ℙ K V) (hx : x ∈ S) : span_carrier x
  |
  mem_add (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
    span_carrier (Projectivization.mk K v hv) →
      span_carrier (Projectivization.mk K w hw) → span_carrier (Projectivization.mk K (v + w) hvw)
#align projectivization.subspace.span_carrier Projectivization.Subspace.spanCarrier

/-- The span of a set of points in projective space is a subspace. -/
def span (S : Set (ℙ K V)) : Subspace K V
    where
  carrier := spanCarrier S
  mem_add' v w hv hw hvw := spanCarrier.mem_add v w hv hw hvw
#align projectivization.subspace.span Projectivization.Subspace.span

/-- The span of a set of points contains the set of points. -/
theorem subset_span (S : Set (ℙ K V)) : S ⊆ span S := fun x hx => spanCarrier.of _ hx
#align projectivization.subspace.subset_span Projectivization.Subspace.subset_span

/-- The span of a set of points is a Galois insertion between sets of points of a projective space
and subspaces of the projective space. -/
def gi : GaloisInsertion (span : Set (ℙ K V) → Subspace K V) coe
    where
  choice S hS := span S
  gc A B :=
    ⟨fun h => le_trans (subset_span _) h, by
      intro h x hx
      induction hx
      · apply h
        assumption
      · apply B.mem_add
        assumption'⟩
  le_l_u S := subset_span _
  choice_eq _ _ := rfl
#align projectivization.subspace.gi Projectivization.Subspace.gi

/-- The span of a subspace is the subspace. -/
@[simp]
theorem span_coe (W : Subspace K V) : span ↑W = W :=
  GaloisInsertion.l_u_eq gi W
#align projectivization.subspace.span_coe Projectivization.Subspace.span_coe

/-- The infimum of two subspaces exists. -/
instance hasInf : Inf (Subspace K V) :=
  ⟨fun A B =>
    ⟨A ⊓ B, fun v w hv hw hvw h1 h2 =>
      ⟨A.mem_add _ _ hv hw _ h1.1 h2.1, B.mem_add _ _ hv hw _ h1.2 h2.2⟩⟩⟩
#align projectivization.subspace.has_inf Projectivization.Subspace.hasInf

/- warning: projectivization.subspace.has_Inf clashes with projectivization.subspace.has_inf -> Projectivization.Subspace.hasInf
warning: projectivization.subspace.has_Inf -> Projectivization.Subspace.hasInf is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} {V : Type.{u2}} [_inst_1 : Field.{u1} K] [_inst_2 : AddCommGroup.{u2} V] [_inst_3 : Module.{u1, u2} K V (Ring.toSemiring.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))) (AddCommGroup.toAddCommMonoid.{u2} V _inst_2)], InfSet.{u2} (Projectivization.Subspace.{u1, u2} K V _inst_1 _inst_2 _inst_3)
but is expected to have type
  forall {K : Type.{u1}} {V : Type.{u2}} [_inst_1 : Field.{u1} K] [_inst_2 : AddCommGroup.{u2} V] [_inst_3 : Module.{u1, u2} K V (Ring.toSemiring.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))) (AddCommGroup.toAddCommMonoid.{u2} V _inst_2)], Inf.{u2} (Projectivization.Subspace.{u1, u2} K V _inst_1 _inst_2 _inst_3)
Case conversion may be inaccurate. Consider using '#align projectivization.subspace.has_Inf Projectivization.Subspace.hasInfₓ'. -/
/-- Infimums of arbitrary collections of subspaces exist. -/
instance hasInf : InfSet (Subspace K V) :=
  ⟨fun A =>
    ⟨infₛ (coe '' A), fun v w hv hw hvw h1 h2 t =>
      by
      rintro ⟨s, hs, rfl⟩
      exact s.mem_add v w hv hw _ (h1 s ⟨s, hs, rfl⟩) (h2 s ⟨s, hs, rfl⟩)⟩⟩
#align projectivization.subspace.has_Inf Projectivization.Subspace.hasInf

/-- The subspaces of a projective space form a complete lattice. -/
instance : CompleteLattice (Subspace K V) :=
  { (inferInstance : Inf _),
    completeLatticeOfInf (Subspace K V)
      (by
        refine' fun s => ⟨fun a ha x hx => hx _ ⟨a, ha, rfl⟩, fun a ha x hx E => _⟩
        rintro ⟨E, hE, rfl⟩
        exact ha hE hx) with
    inf_le_left := fun A B x hx => hx.1
    inf_le_right := fun A B x hx => hx.2
    le_inf := fun A B C h1 h2 x hx => ⟨h1 hx, h2 hx⟩ }

instance subspaceInhabited : Inhabited (Subspace K V) where default := ⊤
#align projectivization.subspace.subspace_inhabited Projectivization.Subspace.subspaceInhabited

/-- The span of the empty set is the bottom of the lattice of subspaces. -/
@[simp]
theorem span_empty : span (∅ : Set (ℙ K V)) = ⊥ :=
  gi.gc.l_bot
#align projectivization.subspace.span_empty Projectivization.Subspace.span_empty

/-- The span of the entire projective space is the top of the lattice of subspaces. -/
@[simp]
theorem span_univ : span (Set.univ : Set (ℙ K V)) = ⊤ :=
  by
  rw [eq_top_iff, SetLike.le_def]
  intro x hx
  exact subset_span _ (Set.mem_univ x)
#align projectivization.subspace.span_univ Projectivization.Subspace.span_univ

/-- The span of a set of points is contained in a subspace if and only if the set of points is
contained in the subspace. -/
theorem span_le_subspace_iff {S : Set (ℙ K V)} {W : Subspace K V} : span S ≤ W ↔ S ⊆ W :=
  gi.gc S W
#align projectivization.subspace.span_le_subspace_iff Projectivization.Subspace.span_le_subspace_iff

/-- If a set of points is a subset of another set of points, then its span will be contained in the
span of that set. -/
@[mono]
theorem monotone_span : Monotone (span : Set (ℙ K V) → Subspace K V) :=
  gi.gc.monotone_l
#align projectivization.subspace.monotone_span Projectivization.Subspace.monotone_span

theorem subset_span_trans {S T U : Set (ℙ K V)} (hST : S ⊆ span T) (hTU : T ⊆ span U) :
    S ⊆ span U :=
  gi.gc.le_u_l_trans hST hTU
#align projectivization.subspace.subset_span_trans Projectivization.Subspace.subset_span_trans

/-- The supremum of two subspaces is equal to the span of their union. -/
theorem span_union (S T : Set (ℙ K V)) : span (S ∪ T) = span S ⊔ span T :=
  (@gi K V _ _ _).gc.l_sup
#align projectivization.subspace.span_union Projectivization.Subspace.span_union

/-- The supremum of a collection of subspaces is equal to the span of the union of the
collection. -/
theorem span_unionᵢ {ι} (s : ι → Set (ℙ K V)) : span (⋃ i, s i) = ⨆ i, span (s i) :=
  (@gi K V _ _ _).gc.l_supᵢ
#align projectivization.subspace.span_Union Projectivization.Subspace.span_unionᵢ

/-- The supremum of a subspace and the span of a set of points is equal to the span of the union of
the subspace and the set of points. -/
theorem sup_span {S : Set (ℙ K V)} {W : Subspace K V} : W ⊔ span S = span (W ∪ S) := by
  rw [span_union, span_coe]
#align projectivization.subspace.sup_span Projectivization.Subspace.sup_span

theorem span_sup {S : Set (ℙ K V)} {W : Subspace K V} : span S ⊔ W = span (S ∪ W) := by
  rw [span_union, span_coe]
#align projectivization.subspace.span_sup Projectivization.Subspace.span_sup

/-- A point in a projective space is contained in the span of a set of points if and only if the
point is contained in all subspaces of the projective space which contain the set of points. -/
theorem mem_span {S : Set (ℙ K V)} (u : ℙ K V) : u ∈ span S ↔ ∀ W : Subspace K V, S ⊆ W → u ∈ W :=
  by
  simp_rw [← span_le_subspace_iff]
  exact ⟨fun hu W hW => hW hu, fun W => W (span S) (le_refl _)⟩
#align projectivization.subspace.mem_span Projectivization.Subspace.mem_span

/-- The span of a set of points in a projective space is equal to the infimum of the collection of
subspaces which contain the set. -/
theorem span_eq_infₛ {S : Set (ℙ K V)} : span S = infₛ { W | S ⊆ W } :=
  by
  ext
  simp_rw [mem_carrier_iff, mem_span x]
  refine' ⟨fun hx => _, fun hx W hW => _⟩
  · rintro W ⟨T, ⟨hT, rfl⟩⟩
    exact hx T hT
  · exact (@infₛ_le _ _ { W : Subspace K V | S ⊆ ↑W } W hW) x hx
#align projectivization.subspace.span_eq_Inf Projectivization.Subspace.span_eq_infₛ

/-- If a set of points in projective space is contained in a subspace, and that subspace is
contained in the span of the set of points, then the span of the set of points is equal to
the subspace. -/
theorem span_eq_of_le {S : Set (ℙ K V)} {W : Subspace K V} (hS : S ⊆ W) (hW : W ≤ span S) :
    span S = W :=
  le_antisymm (span_le_subspace_iff.mpr hS) hW
#align projectivization.subspace.span_eq_of_le Projectivization.Subspace.span_eq_of_le

/-- The spans of two sets of points in a projective space are equal if and only if each set of
points is contained in the span of the other set. -/
theorem span_eq_span_iff {S T : Set (ℙ K V)} : span S = span T ↔ S ⊆ span T ∧ T ⊆ span S :=
  ⟨fun h => ⟨h ▸ subset_span S, h.symm ▸ subset_span T⟩, fun h =>
    le_antisymm (span_le_subspace_iff.2 h.1) (span_le_subspace_iff.2 h.2)⟩
#align projectivization.subspace.span_eq_span_iff Projectivization.Subspace.span_eq_span_iff

end Subspace

end Projectivization


import subgroup.torsion

open_locale classical

namespace mygroup

open mygroup mygroup.subgroup mygroup.quotient group_hom function set

/-- A group is nontrivial if and only if it top is not equal to its bot -/
def group.nontrivial (G : Type) [group G] : Prop := (⊥ : subgroup G) ≠ ⊤

@[simp] lemma group.nontrivial_def {G : Type} [group G] :
  group.nontrivial G ↔ (⊥ : subgroup G) ≠ ⊤ := iff.rfl

-- Some lemmas about pushing top and bot over isomorphisms
lemma subgroup.map_bot_eq_bot {G H : Type} [group G] [group H]
  (φ : G →* H) : subgroup.map φ (⊥ : subgroup G) = (⊥ : subgroup H) :=
begin
  ext, rw [mem_map, mem_bot_iff],
  split,
    { rintro ⟨_, hx, rfl⟩,
      rw mem_bot_iff at hx,
      subst hx,
      exact map_one _ },
    { rintro rfl,
      exact ⟨1, mem_bot_iff.2 rfl, map_one _⟩ }
end

/-- Everything is a member of top -/
lemma subgroup.mem_top {G : Type} [group G] (g : G) : g ∈ (⊤ : subgroup G) :=
begin
  change g ∈ ((⊤ : subgroup G) : set G),
  rw ← singleton_subset_iff,
  change {g} ≤ ((⊤ : subgroup G) : set G),
  rw ← subgroup.closure_le, simp,
end

lemma subgroup.map_top_eq_top {G H : Type} [group G] [group H]
  (φ : G →* H) (hφ : surjective φ) :
  subgroup.map φ (⊤ : subgroup G) = (⊤ : subgroup H) :=
begin
  ext, split; intro,
    { exact subgroup.mem_top _ },
    { rw mem_map,
      rcases hφ x with ⟨x, rfl⟩,
      refine ⟨x, subgroup.mem_top _, rfl⟩ }
end

/-- Nontrivial is a group property, that is it translates over group isomorphisms -/
lemma subgroup.nontrivial_of_iso_nontrivial {G H : Type} [group G] [group H]
  (φ : G ≅ H) : group.nontrivial G → group.nontrivial H :=
begin
  intros hG h,
  apply hG,
  rw [← subgroup.map_top_eq_top (iso_symm φ).1 (iso_symm φ).2.2,
      ← subgroup.map_bot_eq_bot (iso_symm φ).1, h],
end

/-- Everything is in top -/
lemma normal.mem_top {G : Type} [group G] (g : G) : g ∈ (⊤ : normal G) :=
begin
  rw [← normal.mem_carrier, ← singleton_subset_iff],
  change {g} ≤ ((⊤ : normal G) : set G),
  rw ← normal.closure_le, simp,
end

namespace composition

variables {G : Type} [group G]

-- def subgroup.le_hom {A B : subgroup G} (hAB : A ≤ B) : A →* B :=
--   monoid_hom.mk' (λ a, ⟨a.1, hAB a.2⟩) (λ _ _, rfl)

-- def subgroup.normal_pair {A B : subgroup G} (hAB : A ≤ B) : Prop :=
--   (monoid_hom.range (subgroup.le_hom hAB)).normal

-- @[simp] lemma subgroup.normal_pair_def {A B : subgroup G} (hAB : A ≤ B) :
--   subgroup.normal_pair hAB ↔ (monoid_hom.range (subgroup.le_hom hAB)).normal := iff.rfl

-- def subgroup.normal_pair' (A B : subgroup G): Prop :=
--   (monoid_hom.range (subgroup.le_hom (show A ⊓ B ≤ B, by exact inf_le_right))).normal

variables (H : subgroup G) (N : normal G)

/-- A group is simple if and only if it is nontrivial and all its normal subgroups
  are either top or bot -/
def is_simple (G : Type) [group G] :=
  group.nontrivial G ∧ ∀ N : normal G, N = ⊥ ∨ N = ⊤

@[simp] lemma is_simple_def (G : Type) [group G] : is_simple G ↔
  group.nontrivial G ∧ ∀ N : normal G, N = ⊥ ∨ N = ⊤ := iff.rfl

lemma comap_eq_bot {G H : Type} [group G] [group H] {φ : G →* H} {N : normal H}
  (h : normal.comap φ N = (⊥ : normal G)) (hsur : surjective φ) : N = ⊥ :=
begin
  rw eq_bot_iff at h ⊢,
  intros n hn, erw normal.mem_carrier at hn ⊢,
  rcases hsur n with ⟨x, rfl⟩,
  rw ← normal.mem_comap at hn,
  rw [normal.mem_bot_iff.1 (h hn), map_one],
  exact (⊥ : normal H).one_mem'
end

lemma comap_eq_top {G H : Type} [group G] [group H] {φ : G →* H} {N : normal H}
  (h : normal.comap φ N = (⊤ : normal G)) (hsur : surjective φ) : N = ⊤ :=
begin
  rw eq_top_iff at h ⊢,
  intros n _, erw normal.mem_carrier,
  rcases hsur n with ⟨x, rfl⟩,
  exact(normal.mem_comap _).1 (h (normal.mem_top x))
end

/-- `is_simple` is a group property, that is, it translates over group
  isomorphisms -/
lemma is_simple_of_iso {G H : Type} [group G] [group H]
  (φ : G ≅ H) : is_simple G → is_simple H :=
begin
  refine λ hG, ⟨subgroup.nontrivial_of_iso_nontrivial φ hG.1, _⟩,
  intro N, rcases hG.2 (normal.comap φ.1 N) with hN | hN,
    { left, exact comap_eq_bot hN φ.2.2 },
    { right, exact comap_eq_top hN φ.2.2 }
end

/-- A normal subgroup is maximal if and only if the quotient group by it is
  simple -/
def is_maximal {N : normal G} (hN : N ≠ ⊤) : Prop := is_simple (G /ₘ N)

@[simp] lemma is_maximal_def {N : normal G} (hN : N ≠ ⊤) :
  is_maximal hN ↔ is_simple (G /ₘ N) := iff.rfl

-- If N < M, then by the correspondence theorem, there is a proper normal
-- subgroup in G / N which contradicts the is_simple hypothesis

/-- There is no proper subgroup containing a maximal subgroup -/
theorem maximal_is_max {N : normal G} (hproper : N ≠ ⊤) (h : is_maximal hproper) :
  ∀ M : normal G, N < M → M = ⊤ :=
begin
  intros M hM,
  rw [is_maximal_def, is_simple_def] at h,
  rcases h with ⟨h₁, h₂⟩,
  cases h₂ ((normal_of_quotient_order_iso N).to_equiv ⟨M, le_of_lt hM⟩),
    { exfalso, refine not_le_of_lt hM _,
      change (⟨M, le_of_lt hM⟩ : { H // N ≤ H }) ≤ ⟨N, le_refl _⟩,
      rw [(normal_of_quotient_order_iso N).ord', h],
      exact bot_le },
    { rw eq_top_iff,
      change (⟨⊤, le_top⟩ : { H // N ≤ H }) ≤ ⟨M, le_of_lt hM⟩,
      rw [(normal_of_quotient_order_iso N).ord', h],
      exact le_top }
end

/-- An alternative version of `maximal_is_max` that requires `≤` instead of `<` -/
theorem maximal_is_max' {N : normal G} (hproper : N ≠ ⊤) (h : is_maximal hproper) :
  ∀ M : normal G, N ≤ M → M = N ∨ M = ⊤ :=
begin
  intros M hM,
  rcases le_iff_lt_or_eq.1 hM with hlt | rfl,
    { exact or.inr (maximal_is_max hproper h _ hlt) },
    { exact or.inl rfl }
end

def is_conj_mem (A B : subgroup G) : Prop := ∀ a ∈ A, ∀ g ∈ B, g * a * g⁻¹ ∈ A

@[simp] lemma is_conj_mem_def (A B : subgroup G) :
  is_conj_mem A B ↔ ∀ a ∈ A, ∀ g ∈ B, g * a * g⁻¹ ∈ A := iff.rfl

def normal.𝒾 {G : Type} [group G] {A B : subgroup G} (hle : A ≤ B)
  (h : is_conj_mem A B) : normal B :=
{ carrier := { a | a.1 ∈ A },
  one_mem' := A.one_mem',
  mul_mem' := λ _ _ ha hb, A.mul_mem' ha hb,
  inv_mem' := λ _ h, A.inv_mem' h,
  conj_mem' := λ _ hs x, h _ hs _ x.2 }

lemma normal.mem_𝒾 {G : Type} [group G] {A B : subgroup G} (hle : A ≤ B)
  (h : is_conj_mem A B) {g : G} (hg : g ∈ B) :
  (⟨g, hg⟩ : B) ∈ normal.𝒾 hle h ↔ g ∈ A := iff.rfl

lemma normal.inclusion_inv {G : Type} [group G] {A B : subgroup G} (hle : A ≤ B)
  {g : G} (hg : g ∈ B) : (⟨g, hg⟩⁻¹ : B) = ⟨g⁻¹, B.inv_mem' hg⟩ := rfl

lemma normal.inclusion_mul {G : Type} [group G] {A B : subgroup G} (hle : A ≤ B)
  {g h : G} (hg : g ∈ B) (hh : h ∈ B) :
  (⟨g, hg⟩ : B) * (⟨h, hh⟩ : B) = ⟨g * h, B.mul_mem' hg hh⟩ := rfl

attribute [simp] normal.mem_𝒾 normal.inclusion_inv normal.inclusion_mul

-- `chain_prop A B` means `∀ a ∈ A, g ∈ B, g * a * g⁻¹ ∈ A`
def chain_prop (A B : subgroup G) : Prop :=
  ∃ (hle : A ≤ B) (H : is_conj_mem A B), is_simple $ B /ₘ (normal.𝒾 hle H)

@[simp] lemma chain_prop_def {A B : subgroup G} :
  chain_prop A B ↔
  ∃ (hle : A ≤ B) (H : is_conj_mem A B), is_simple $ B /ₘ (normal.𝒾 hle H) := iff.rfl

-- def chain_prop (A B : normal G) : Prop :=
--   ∃ (hle : A ≤ B), is_simple $ B /ₘ (normal.𝒾 hle)

-- @[simp] lemma chain_prop_def {A B : normal G} :
--   chain_prop A B ↔
--   ∃ (hle : A ≤ B), is_simple $ B /ₘ (normal.𝒾 hle) := iff.rfl

instance normal.inhabited : inhabited $ subgroup G := ⟨ ⊥ ⟩

/-- Chain is a nonempty list of subgroups such that subsequent subgroups
  satisfies `chain_prop`, and furthermore, it begins with bot and ends with top -/
structure chain (G : Type) [group G] :=
(carrier    : list (subgroup G))
(nonempty   : carrier ≠ list.nil)
(chain_prop : carrier.chain' chain_prop)
(chain_head : carrier.head = ⊥)
(chain_last : carrier.last nonempty = ⊤)

lemma is_conj_mem_bot : is_conj_mem H ⊥ := λ _ _ _ hg, by simpa [mem_bot_iff.1 hg]

lemma is_conj_mem_bot' : is_conj_mem ⊥ H := λ _ ha _ _,
  by simp [mem_bot_iff.1 ha, one_mem]

def to_top : G →* (⊤ : subgroup G) := ⟨λ g, ⟨g, subgroup.mem_top _⟩, by tidy⟩
def to_top_iso : G ≅ (⊤ : subgroup G) := ⟨to_top, by tidy⟩

def top_div_bot_iso :
  (⊤ : subgroup G) ≅ (⊤ : subgroup G) /ₘ (normal.𝒾
    (@le_top _ _ (⊥ : subgroup G)) (is_conj_mem_bot' _)) :=
{ is_bijective :=
    begin
      refine ⟨_, by tidy⟩,
      rintros ⟨x₁, _⟩ ⟨x₂, _⟩ hx, dsimp at hx,
      rw [← coe_eq_mk, ← coe_eq_mk, mk_eq'] at hx,
      rw @normal.inclusion_inv _ _ (⊥ : subgroup G) _ bot_le at hx,
      erw @normal.inclusion_mul _ _ (⊥ : subgroup G) _ bot_le at hx,
      erw [normal.mem_𝒾, mem_bot_iff] at hx,
      congr, rw ← group.inv_eq_of_mul_eq_one hx,
      exact group.inv_inv _,
    end ..
    quotient.mk (normal.𝒾 (@le_top _ _ (⊥ : subgroup G)) (is_conj_mem_bot' _)) }

def top_div_bot_iso' :
  G ≅ (⊤ : subgroup G) /ₘ (normal.𝒾
    (@le_top _ _ (⊥ : subgroup G)) (is_conj_mem_bot' _)) :=
  group_hom.iso_comp to_top_iso top_div_bot_iso

def trivial_chain (h : is_simple G) : chain G :=
{ carrier := [⊥, ⊤],
  nonempty := by simp,
  chain_prop :=
    begin
      simp only [and_true, is_simple_def, list.chain'_singleton,
                 bot_le, chain_prop_def, exists_prop_of_true, ne.def,
                 list.chain'_cons, group.nontrivial_def],
      exact ⟨is_conj_mem_bot' _, is_simple_of_iso top_div_bot_iso' h⟩,
    end,
  chain_head := by simp,
  chain_last := by simp }

-- example [fintype G] : ∀ (n = fintype.card G), ∃ c : chain G, true :=
-- begin
--   intro n, apply nat.strong_induction_on n,
--   rintros k hk₁ rfl,
--   by_cases is_simple G,
--     sorry,
--     sorry
-- end

-- instance [fintype G] : inhabited $ chain G := ⟨ sorry ⟩

end composition

end mygroup


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

import algebra.ring_quot
import linear_algebra.tensor_algebra
import linear_algebra.exterior_algebra
import linear_algebra.quadratic_form.basic

/-!
# Clifford Algebras

We construct the Clifford algebra of a module `M` over a commutative ring `R`, equipped with
a quadratic_form `Q`.

## Notation

The Clifford algebra of the `R`-module `M` equipped with a quadratic_form `Q` is denoted as
`clifford_algebra Q`.

Given a linear morphism `f : M → A` from a module `M` to another `R`-algebra `A`, such that
`cond : ∀ m, f m * f m = algebra_map _ _ (Q m)`, there is a (unique) lift of `f` to an `R`-algebra
morphism, which is denoted `clifford_algebra.lift Q f cond`.

The canonical linear map `M → clifford_algebra Q` is denoted `clifford_algebra.ι Q`.

## Theorems

The main theorems proved ensure that `clifford_algebra Q` satisfies the universal property
of the Clifford algebra.
1. `ι_comp_lift` is the fact that the composition of `ι Q` with `lift Q f cond` agrees with `f`.
2. `lift_unique` ensures the uniqueness of `lift Q f cond` with respect to 1.

Additionally, when `Q = 0` an `alg_equiv` to the `exterior_algebra` is provided as `as_exterior`.

## Implementation details

The Clifford algebra of `M` is constructed as a quotient of the tensor algebra, as follows.
1. We define a relation `clifford_algebra.rel Q` on `tensor_algebra R M`.
   This is the smallest relation which identifies squares of elements of `M` with `Q m`.
2. The Clifford algebra is the quotient of the tensor algebra by this relation.

This file is almost identical to `linear_algebra/exterior_algebra.lean`.
-/

variables {R : Type*} [comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables (Q : quadratic_form R M)

variable {n : ℕ}

namespace clifford_algebra
open tensor_algebra

/-- `rel` relates each `ι m * ι m`, for `m : M`, with `Q m`.

The Clifford algebra of `M` is defined as the quotient modulo this relation.
-/
inductive rel : tensor_algebra R M → tensor_algebra R M → Prop
| of (m : M) : rel (ι R m * ι R m) (algebra_map R _ (Q m))

end clifford_algebra

/--
The Clifford algebra of an `R`-module `M` equipped with a quadratic_form `Q`.
-/
@[derive [inhabited, ring, algebra R]]
def clifford_algebra := ring_quot (clifford_algebra.rel Q)

namespace clifford_algebra

/--
The canonical linear map `M →ₗ[R] clifford_algebra Q`.
-/
def ι : M →ₗ[R] clifford_algebra Q :=
(ring_quot.mk_alg_hom R _).to_linear_map.comp (tensor_algebra.ι R)

/-- As well as being linear, `ι Q` squares to the quadratic form -/
@[simp]
theorem ι_sq_scalar (m : M) : ι Q m * ι Q m = algebra_map R _ (Q m) :=
begin
  erw [←alg_hom.map_mul, ring_quot.mk_alg_hom_rel R (rel.of m), alg_hom.commutes],
  refl,
end

variables {Q} {A : Type*} [semiring A] [algebra R A]

@[simp]
theorem comp_ι_sq_scalar (g : clifford_algebra Q →ₐ[R] A) (m : M) :
  g (ι Q m) * g (ι Q m) = algebra_map _ _ (Q m) :=
by rw [←alg_hom.map_mul, ι_sq_scalar, alg_hom.commutes]

variables (Q)

/--
Given a linear map `f : M →ₗ[R] A` into an `R`-algebra `A`, which satisfies the condition:
`cond : ∀ m : M, f m * f m = Q(m)`, this is the canonical lift of `f` to a morphism of `R`-algebras
from `clifford_algebra Q` to `A`.
-/
@[simps symm_apply]
def lift :
  {f : M →ₗ[R] A // ∀ m, f m * f m = algebra_map _ _ (Q m)} ≃ (clifford_algebra Q →ₐ[R] A) :=
{ to_fun := λ f,
  ring_quot.lift_alg_hom R ⟨tensor_algebra.lift R (f : M →ₗ[R] A),
    (λ x y (h : rel Q x y), by
    { induction h,
      rw [alg_hom.commutes, alg_hom.map_mul, tensor_algebra.lift_ι_apply, f.prop], })⟩,
  inv_fun := λ F, ⟨F.to_linear_map.comp (ι Q), λ m, by rw [
    linear_map.comp_apply, alg_hom.to_linear_map_apply, comp_ι_sq_scalar]⟩,
  left_inv := λ f, by { ext,
    simp only [ι, alg_hom.to_linear_map_apply, function.comp_app, linear_map.coe_comp,
               subtype.coe_mk, ring_quot.lift_alg_hom_mk_alg_hom_apply,
               tensor_algebra.lift_ι_apply] },
  right_inv := λ F, by { ext,
    simp only [ι, alg_hom.comp_to_linear_map, alg_hom.to_linear_map_apply, function.comp_app,
               linear_map.coe_comp, subtype.coe_mk, ring_quot.lift_alg_hom_mk_alg_hom_apply,
               tensor_algebra.lift_ι_apply] } }

variables {Q}

@[simp]
theorem ι_comp_lift (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = algebra_map _ _ (Q m)) :
  (lift Q ⟨f, cond⟩).to_linear_map.comp (ι Q) = f :=
(subtype.mk_eq_mk.mp $ (lift Q).symm_apply_apply ⟨f, cond⟩)

@[simp]
theorem lift_ι_apply (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = algebra_map _ _ (Q m)) (x) :
  lift Q ⟨f, cond⟩ (ι Q x) = f x :=
(linear_map.ext_iff.mp $ ι_comp_lift f cond) x

@[simp]
theorem lift_unique (f : M →ₗ[R] A) (cond : ∀ m : M, f m * f m = algebra_map _ _ (Q m))
  (g : clifford_algebra Q →ₐ[R] A) :
  g.to_linear_map.comp (ι Q) = f ↔ g = lift Q ⟨f, cond⟩ :=
begin
  convert (lift Q).symm_apply_eq,
  rw lift_symm_apply,
  simp only,
end

attribute [irreducible] clifford_algebra ι lift

@[simp]
theorem lift_comp_ι (g : clifford_algebra Q →ₐ[R] A) :
  lift Q ⟨g.to_linear_map.comp (ι Q), comp_ι_sq_scalar _⟩ = g :=
begin
  convert (lift Q).apply_symm_apply g,
  rw lift_symm_apply,
  refl,
end

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext {A : Type*} [semiring A] [algebra R A] {f g : clifford_algebra Q →ₐ[R] A} :
  f.to_linear_map.comp (ι Q) = g.to_linear_map.comp (ι Q) → f = g :=
begin
  intro h,
  apply (lift Q).symm.injective,
  rw [lift_symm_apply, lift_symm_apply],
  simp only [h],
end

/-- If `C` holds for the `algebra_map` of `r : R` into `clifford_algebra Q`, the `ι` of `x : M`,
and is preserved under addition and muliplication, then it holds for all of `clifford_algebra Q`.
-/
-- This proof closely follows `tensor_algebra.induction`
@[elab_as_eliminator]
lemma induction {C : clifford_algebra Q → Prop}
  (h_grade0 : ∀ r, C (algebra_map R (clifford_algebra Q) r))
  (h_grade1 : ∀ x, C (ι Q x))
  (h_mul : ∀ a b, C a → C b → C (a * b))
  (h_add : ∀ a b, C a → C b → C (a + b))
  (a : clifford_algebra Q) :
  C a :=
begin
  -- the arguments are enough to construct a subalgebra, and a mapping into it from M
  let s : subalgebra R (clifford_algebra Q) :=
  { carrier := C,
    mul_mem' := h_mul,
    add_mem' := h_add,
    algebra_map_mem' := h_grade0, },
  let of : { f : M →ₗ[R] s // ∀ m, f m * f m = algebra_map _ _ (Q m) } :=
  ⟨(ι Q).cod_restrict s.to_submodule h_grade1,
    λ m, subtype.eq $ ι_sq_scalar Q m ⟩,
  -- the mapping through the subalgebra is the identity
  have of_id : alg_hom.id R (clifford_algebra Q) = s.val.comp (lift Q of),
  { ext,
    simp [of], },
  -- finding a proof is finding an element of the subalgebra
  convert subtype.prop (lift Q of a),
  exact alg_hom.congr_fun of_id a,
end

/-- A Clifford algebra with a zero quadratic form is isomorphic to an `exterior_algebra` -/
def as_exterior : clifford_algebra (0 : quadratic_form R M) ≃ₐ[R] exterior_algebra R M :=
alg_equiv.of_alg_hom
  (clifford_algebra.lift 0 ⟨(exterior_algebra.ι R),
    by simp only [forall_const, ring_hom.map_zero,
                  exterior_algebra.ι_sq_zero, quadratic_form.zero_apply]⟩)
  (exterior_algebra.lift R ⟨(ι (0 : quadratic_form R M)),
    by simp only [forall_const, ring_hom.map_zero,
                  quadratic_form.zero_apply, ι_sq_scalar]⟩)
  (exterior_algebra.hom_ext $ linear_map.ext $
    by simp only [alg_hom.comp_to_linear_map, linear_map.coe_comp,
                  function.comp_app, alg_hom.to_linear_map_apply,
                  exterior_algebra.lift_ι_apply, clifford_algebra.lift_ι_apply,
                  alg_hom.to_linear_map_id, linear_map.id_comp, eq_self_iff_true, forall_const])
  (clifford_algebra.hom_ext $ linear_map.ext $
    by simp only [alg_hom.comp_to_linear_map, linear_map.coe_comp,
                  function.comp_app, alg_hom.to_linear_map_apply,
                  clifford_algebra.lift_ι_apply, exterior_algebra.lift_ι_apply,
                  alg_hom.to_linear_map_id, linear_map.id_comp, eq_self_iff_true, forall_const])

/-- The symmetric product of vectors is a scalar -/
lemma ι_mul_ι_add_swap (a b : M) :
  ι Q a * ι Q b + ι Q b * ι Q a = algebra_map R _ (quadratic_form.polar Q a b) :=
calc  ι Q a * ι Q b + ι Q b * ι Q a
    = ι Q (a + b) * ι Q (a + b) - ι Q a * ι Q a - ι Q b * ι Q b :
        by { rw [(ι Q).map_add, mul_add, add_mul, add_mul], abel, }
... = algebra_map R _ (Q (a + b)) - algebra_map R _ (Q a) - algebra_map R _ (Q b) :
        by rw [ι_sq_scalar, ι_sq_scalar, ι_sq_scalar]
... = algebra_map R _ (Q (a + b) - Q a - Q b) :
        by rw [←ring_hom.map_sub, ←ring_hom.map_sub]
... = algebra_map R _ (quadratic_form.polar Q a b) : rfl

section map

variables {M₁ M₂ M₃ : Type*}
variables [add_comm_group M₁] [add_comm_group M₂] [add_comm_group M₃]
variables [module R M₁] [module R M₂] [module R M₃]
variables (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) (Q₃ : quadratic_form R M₃)

/-- Any linear map that preserves the quadratic form lifts to an `alg_hom` between algebras.

See `clifford_algebra.equiv_of_isometry` for the case when `f` is a `quadratic_form.isometry`. -/
def map (f : M₁ →ₗ[R] M₂) (hf : ∀ m, Q₂ (f m) = Q₁ m) :
  clifford_algebra Q₁ →ₐ[R] clifford_algebra Q₂ :=
clifford_algebra.lift Q₁ ⟨(clifford_algebra.ι Q₂).comp f,
  λ m, (ι_sq_scalar _ _).trans $ ring_hom.congr_arg _ $ hf m⟩

@[simp]
lemma map_comp_ι (f : M₁ →ₗ[R] M₂) (hf) :
  (map Q₁ Q₂ f hf).to_linear_map.comp (ι Q₁) = (ι Q₂).comp f :=
ι_comp_lift _ _

@[simp]
lemma map_apply_ι (f : M₁ →ₗ[R] M₂) (hf) (m : M₁):
  map Q₁ Q₂ f hf (ι Q₁ m) = ι Q₂ (f m) :=
lift_ι_apply _ _ m

@[simp]
lemma map_id :
  map Q₁ Q₁ (linear_map.id : M₁ →ₗ[R] M₁) (λ m, rfl) = alg_hom.id R (clifford_algebra Q₁) :=
by { ext m, exact map_apply_ι _ _ _ _ m }

@[simp]
lemma map_comp_map (f : M₂ →ₗ[R] M₃) (hf) (g : M₁ →ₗ[R] M₂) (hg) :
  (map Q₂ Q₃ f hf).comp (map Q₁ Q₂ g hg) = map Q₁ Q₃ (f.comp g) (λ m, (hf _).trans $ hg m) :=
begin
  ext m,
  dsimp only [linear_map.comp_apply, alg_hom.comp_apply, alg_hom.to_linear_map_apply,
    alg_hom.id_apply],
  rw [map_apply_ι, map_apply_ι, map_apply_ι, linear_map.comp_apply],
end

variables {Q₁ Q₂ Q₃}

/-- Two `clifford_algebra`s are equivalent as algebras if their quadratic forms are
equivalent. -/
@[simps apply]
def equiv_of_isometry (e : Q₁.isometry Q₂) :
  clifford_algebra Q₁ ≃ₐ[R] clifford_algebra Q₂ :=
alg_equiv.of_alg_hom
  (map Q₁ Q₂ e e.map_app)
  (map Q₂ Q₁ e.symm e.symm.map_app)
  ((map_comp_map _ _ _ _ _ _ _).trans $ begin
    convert map_id _ using 2,
    ext m,
    exact e.to_linear_equiv.apply_symm_apply m,
  end)
  ((map_comp_map _ _ _ _ _ _ _).trans $ begin
    convert map_id _ using 2,
    ext m,
    exact e.to_linear_equiv.symm_apply_apply m,
  end)

@[simp]
lemma equiv_of_isometry_symm (e : Q₁.isometry Q₂) :
  (equiv_of_isometry e).symm = equiv_of_isometry e.symm := rfl

@[simp]
lemma equiv_of_isometry_trans (e₁₂ : Q₁.isometry Q₂) (e₂₃ : Q₂.isometry Q₃) :
  (equiv_of_isometry e₁₂).trans (equiv_of_isometry e₂₃) = equiv_of_isometry (e₁₂.trans e₂₃) :=
by { ext x, exact alg_hom.congr_fun (map_comp_map Q₁ Q₂ Q₃ _ _ _ _) x }

@[simp]
lemma equiv_of_isometry_refl :
  (equiv_of_isometry $ quadratic_form.isometry.refl Q₁) = alg_equiv.refl :=
by { ext x, exact alg_hom.congr_fun (map_id Q₁) x }

end map

end clifford_algebra

namespace tensor_algebra

variables {Q}

/-- The canonical image of the `tensor_algebra` in the `clifford_algebra`, which maps
`tensor_algebra.ι R x` to `clifford_algebra.ι Q x`. -/
def to_clifford : tensor_algebra R M →ₐ[R] clifford_algebra Q :=
tensor_algebra.lift R (clifford_algebra.ι Q)

@[simp] lemma to_clifford_ι (m : M) : (tensor_algebra.ι R m).to_clifford = clifford_algebra.ι Q m :=
by simp [to_clifford]

end tensor_algebra


import tactic
import group_theory.quotient_group

variable (α : Type*) -- "Let α be a set."
variables (R : setoid α)

-- The "usual" construction of a quotient of α by R.
def Q : Type* :=
{ S : set α | ∃ x : α, S = { y : α | R.rel x y } }

def π : α → Q α R :=
λ a : α, ⟨{ b | R.rel a b }, begin
  change ∃ t, _,
  refine ⟨a, _⟩,
  refl,
end⟩

theorem π_surjective : function.surjective (π α R) :=
begin
  change ∀ q : _, ∃ a : α, _,
  intros q,
  obtain ⟨S, a, ha⟩ := q,
  use a,
  unfold π,
  apply subtype.ext,
  change {b : α | R.rel a b} = S,
  symmetry,
  assumption,
end

noncomputable def desc_to_Q
  (β : Type*)
  (f : α → β)
  (hf : ∀ a b : α, R.rel a b → f a = f b) :
  Q α R → β :=
λ q, f q.2.some

lemma desc_to_Q_spec
  (β : Type*)
  (f : α → β)
  (hf : ∀ a b : α, R.rel a b → f a = f b)
  (a : α)
  (q : Q α R)
  (ha : π α R a = q) :
  desc_to_Q α R β f hf q = f a :=
begin
  let a' : α := q.2.some,
  have ha' : q.1 = { b : α | R.rel a' b } := q.2.some_spec,
  have : desc_to_Q α R β f hf q = f a' := rfl,
  rewrite [this], clear this,
  apply hf,
  rewrite [← ha] at ha',
  unfold π at ha',
  change {b : α | R.rel a b} = _ at ha',
  suffices : a ∈ { b : α | R.rel a' b },
  { exact this },
  rewrite [← ha'],
  apply setoid.refl,
end

theorem universal_property_of_Q
  (β : Type*)
  (f : α → β)
  (hf : ∀ a b : α, R.rel a b → f a = f b) :
  (desc_to_Q α R β f hf) ∘ π α R = f ∧
  ∀ (h : Q α R → β), h ∘ π α R = f → h =  (desc_to_Q α R β f hf) :=
begin
  let g := (desc_to_Q α R β f hf),
  have hg : g ∘ π α R = f,
  { apply funext, intros x,
    dsimp,
    apply desc_to_Q_spec,
    refl },
  split,
  { exact hg },
  { intros h H,
    apply funext, intros q,
    obtain ⟨a,ha⟩ := π_surjective α R q,
    rewrite [← ha],
    change (h ∘ π α R ) a = (g ∘ π α R ) a,
    rewrite [H, hg] }
end

example : Type* := quotient R
example : α → quotient R := quotient.mk'
example (β : Type*) (f : α → β) (hf : ∀ a b : α, R.rel a b → f a = f b) :
  quotient R → β :=
λ q, quotient.lift_on' q f hf
example (β : Type*) (f : α → β) (hf : ∀ a b : α, R.rel a b → f a = f b) :
  ∃! (g : quotient R → β), g ∘ quotient.mk' = f :=
⟨λ q, quotient.lift_on' q f hf, by { ext, refl }, λ h H,
  by { ext ⟨x⟩, dsimp at H, convert congr_fun H x }⟩

noncomputable example : Q α R ≃ quotient R :=
{ to_fun := desc_to_Q _ _ _ quotient.mk' $ λ {x y : α}, quotient.eq_rel.mpr,
  inv_fun := λ q, quotient.lift_on' q (π _ _) sorry,
  left_inv := sorry,
  right_inv := sorry }

  example (G : Type*) [group G] (N : subgroup G) [subgroup.normal N] :
    (G ⧸ N) = quotient _ := rfl


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.witt_vector.frobenius
import Mathlib.ring_theory.witt_vector.verschiebung
import Mathlib.ring_theory.witt_vector.mul_p
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
## Identities between operations on the ring of Witt vectors

In this file we derive common identities between the Frobenius and Verschiebung operators.

## Main declarations

* `frobenius_verschiebung`: the composition of Frobenius and Verschiebung is multiplication by `p`
* `verschiebung_mul_frobenius`: the “projection formula”: `V(x * F y) = V x * y`
-/

namespace witt_vector

/-- The composition of Frobenius and Verschiebung is multiplication by `p`. -/
theorem frobenius_verschiebung {p : ℕ} {R : Type u_1} [fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) : coe_fn frobenius (coe_fn verschiebung x) = x * ↑p := sorry

/-- Verschiebung is the same as multiplication by `p` on the ring of Witt vectors of `zmod p`. -/
theorem verschiebung_zmod {p : ℕ} [fact (nat.prime p)] (x : witt_vector p (zmod p)) : coe_fn verschiebung x = x * ↑p := sorry

theorem coeff_p_pow {p : ℕ} {R : Type u_1} [fact (nat.prime p)] [comm_ring R] [char_p R p] (i : ℕ) : coeff (↑p ^ i) i = 1 := sorry

/-- The “projection formula” for Frobenius and Verschiebung. -/
theorem verschiebung_mul_frobenius {p : ℕ} {R : Type u_1} [fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) (y : witt_vector p R) : coe_fn verschiebung (x * coe_fn frobenius y) = coe_fn verschiebung x * y := sorry


/-
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

end Mathlib


-- need the real numbers
import data.real.basic
-- need the tactics
import tactic

/-

# Limits

We develop a theory of limits of sequences a₀, a₁, a₂, … of reals,
following the way is it traditionally done in a first year undergraduate
mathematics course.

## Overview of the file

This file contains the basic definition of the limit of a sequence, and
proves basic properties about it.

The `data.real.basic` import imports the definition and basic
properties of the real numbers, including, for example,
the absolute value function `abs : ℝ → ℝ`, and the proof
that `ℝ` is a complete totally ordered archimedean field.
To get `ℝ` in Lean, type `\R`.

We define the predicate `is_limit (a : ℕ → ℝ) (l : ℝ)` to mean that `aₙ → l`
in the usual way:

`∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε`

We then develop the basic theory of limits.

## Main theorems

variables (a b c : ℕ → ℝ) (c l m : ℝ)
* `is_limit_const : is_limit (λ n, c) c`
* `is_limit_subsingleton (hl : is_limit a l) (hm : is_limit a m) : l = m`
* `is_limit_add (h1 : is_limit a l) (h2 : is_limit b m) : is_limit (a + b) (l + m)`
* `is_limit_mul (h1 : is_limit a l) (h2 : is_limit b m) : is_limit (a * b) (l * m)`
* `is_limit_le_of_le (hl : is_limit a l) (hm : is_limit b m) (hle : ∀ n, a n ≤ b n) : l ≤ m`
* `sandwich (ha : is_limit a l) (hc : is_limit c l)
    (hab : ∀ n, a n ≤ b n) (hbc : ∀ n, b n ≤ c n) : is_limit b l`

-/

namespace xena

-- the maths starts here.

-- We introduce the usual mathematical notation for absolute value
local notation `|` x `|` := abs x

-- We model a sequence a₀, a₁, a₂,... of real numbers as a function
-- from ℕ := {0,1,2,...} to ℝ, sending n to aₙ . So in the below
-- definition of the limit of a sequence, a : ℕ → ℝ is the sequence.

/-- `l` is the limit of the sequence `a` of reals -/
definition is_limit (a : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε

/-
Note that `is_limit` is not a *function* (ℕ → ℝ) → ℝ! It is
a _binary relation_ on (ℕ → ℝ) and ℝ, i.e. it's a function which
takes as input a sequence and a candidate limit, and returns the
true-false statement saying that the sequence converges to the limit.

The reason we can't use a "limit" function, which takes in a sequence
and returns its limit, is twofold:
(1) some sequences (like 0, 1, 0, 1, 0, 1,…) don't have
a limit at all, and
(2) at this point in the development, some sequences might in theory have more
than one limit (and if we were working with a non-Hausdorff topological space
rather than `ℝ` this could of course actually happen, although we will see
below that it can't happen here).
-/

/-
Let's start with a warmup : the constant sequence with value c tends to c.
Before we start though, I need to talk about this weird `λ` notation
which functional programmers use.

### λ notation for functions

This is a lot less scary than it looks. The notation `λ n, f n`
in Lean just means what we mathematicians would call `f` or `f(x)`.
Literally, it means "the function sending `n` to `f n`, with this
added twist that we don't need to write the brackets (although `λ n, f(n)`
would also work fine). Another way of rewriting it in a more familiar
manner: `λ n, f n` is the function `n ↦ f n`. So, for example, `λ n, 2 * n`
is just the function `f(x)=2*x`. It's sometimes called "anonymous function notation"
because we do not need to introduce a name for the function if we use
lambda notation.

So you need to know a trick here. What happens if we have such a
function defined by lambda notation, and then we actually try to
evaluate it! You have to know how to change `(λ n, f n) (37)`
into `f(37)` (or, as Lean would call it, `f 37`). Computer scientists
call this transformation "beta reduction". In Lean, beta reduction is true
definitionally, so if you are using `apply` or `intro` or other
tactics which work up to definitional equality then you might not
even have to change it at all. But if your goal contains an "evaluated λ"
like `⊢ (λ n, f n) 37` and you have a hypothesis `h1 : f 37 = 100` then
`rw h1` will fail, because `rw` is pickier and only worked up to syntactic
equality. So you need to know the trick to change this goal to `f 37`,
which is the tactic `dsimp only`. It works on hypotheses too -- `dsimp only at h`
will remove an evaluated `λ` from hypothesis `h`.

We will now prove that the limit of a constant sequence `aₙ = c` is `c`.
The definition of the constant sequence is `λ n, c`, the function sending
every `n` to `c`. I have given you the proof. Step through it by moving your
cursor through it line by line and watch the tactic state changing.

-/

/-- The limit of a constant sequence is the constant. -/
lemma is_limit_const (c : ℝ) : is_limit (λ n, c) c :=
begin
  -- is_limit a l is *by definition* "∀ ε, ε > 0 → ..." so we
  -- can just start with `intros`.
  intros ε εpos,
  -- we need to come up with some N such that n ≥ N implies |c - c| < ε.
  -- We have some flexibility here :-)
  use 37,
  -- Now assume n is a natural which is at least 37, but we may as
  -- well just forget the fact that n ≥ 37 because we're not going to use it.
  rintro n -,
  -- Now we have an "unreduced lambda term" in the goal, so let's
  -- beta reduce it.
  dsimp only,
  -- the simplifier is bound to know that `c - c = 0`
  simp,
  -- finally, `a > b` is *definitionally* `b < a`, and the `exact`
  -- tactic works up to definitional equality.
  exact εpos,
end

/-

I am going to walk you through the next proof as well. It's a proof
that if `aₙ → l` and `aₙ → m` then `l = m`. Here is how it is stated
in Lean:

```
theorem is_limit_subsingleton {a : ℕ → ℝ} {l m : ℝ} (hl : is_limit a l)
(hm : is_limit a m) : l = m := ...
```

Before we go through this proof, I think it's time I explained these
squiggly brackets properly. How come I've written `{a : ℕ → ℝ}`
and not `(a : ℕ → ℝ)`?

### Squiggly brackets {} in function inputs, and dependent functions.

`is_limit_subsingleton` is a proof that a sequence can have at most one limit.
It is also a function. Learning to think about proofs as functions is
an important skill for proving the theorems in this workshop. So let's
talk a bit about how a proof can be a function.

In Lean's dependent type theory, there are types and terms, and every term has
a unique type. Types and terms are used to unify two ideas which mathematicians
usually regard as completely different: that of sets and elements,
and that of theorems and proofs. Let's take a close look at what exactly this
function `is_limit_subsingleton` does.

Let's take a closer look at `is_limit_subsingleton` (the theorem is stated
20 lines above here). It is a function with five inputs. The first input
is a sequence `a : ℕ → ℝ`. The second and third are real numbers `l` and `m`.
The fourth input is a proof that `a(n)` tends to `l`, and the fifth is a proof that
`a(n)` tends to `m`. The output of the function (after the colon) is a proof
that `l = m`. This is how Lean thinks about proofs internally, and it's
important that you internalise this point of view because you will be treating
proofs as functions and evaluating them on inputs to get other proofs
quite a bit today. If you still think it's a bit weird having proofs as inputs
and outputs to functions, just think of a true-false statement (e.g. a theorem
statement) as being a set, and the elements of that set are the proofs of
the theorem. For example `2 + 2 = 5` is a set with no elements, because
there are no proofs of this theorem (assuming that mathematics is consistent).

Now if you think about these inputs carefully, and you think about your mental
model of a function, you may realised that there is something else a bit fishy
going on here. Usually you would think of a function with five inputs
as a function from `A × B × C × D × E` to `X`, where `A`, `B`, `C`, `D` and `E`
are all sets. The first three inputs `a` (of type `ℕ → ℝ`) and `l` and `m`
(of type `ℝ`) are uncontroversial: we can just set `A = ℕ → ℝ` and `B = C = ℝ`.
But the fourth input to `is_limit_singleton` is an element
of the set of proofs of `is_limit a l`, the statement that `a(n)` tends to `l`,
and in particular this set itself *depends on the first two inputs*.
The set `D` itself is a function of `a` and `l` -- the actual inputs themselves,
rather than the sets `A` and `B` that they belong to. The same is true
for the set `E`, which is a function of `a` and `m`. This slightly bizarre
set-up has the even more bizarre consequence that actually, if Lean knows the
fourth and fifth inputs (in this case, proofs of `is_limit a l` and `is_limit a m`)
then it *does not actually even need to know what the first three inputs are*,
because Lean can work them out from the *type* of the fourth and fifth inputs.

In summary then, the five inputs to this functions are:
`a` of type `ℕ → ℝ`,
`l` and `m` of type `ℝ`,
`h1` of type `is_limit a l`
`h2` of type `is_limit a m`.

In particular, if we know the fourth and fifth inputs `h1` and `h2`,
then by looking at the types of these terms, we can actually work out
what the first three inputs *have to be* in order to make everything make sense.

This is why we put the first three inputs in `{}` brackets. This means
"these inputs are part of the function, but Lean's *unification system*
(the part of the system which checks that everything has the right type)
will work them out automatically, so we will not trouble the user by
asking for them". In short, if we ever run this function of five inputs,
we can just give `h1` and `h2` and let Lean figure out the first three
inputs itself. In general if a function input has `{}` brackets then
the user does not have to supply those inputs, the user can trust the
system to fill them in automatically.

That's quite enough about the statement! Let's get back to mathematics
and I will talk you through the proof. Step through the proof line
by line and watch the tactic state change.
-/

theorem is_limit_subsingleton {a : ℕ → ℝ} {l m : ℝ} (hl : is_limit a l)
(hm : is_limit a m) : l = m :=
begin
  -- There are several ways to prove this, but let's prove it
  -- by contradiction. Let's assume `h : l ≠ m` and prove `false`.
  by_contra h,
  -- The idea is that if `ε = |l - m|` then the sequence `a` will
  -- eventually be within `ε/2` of `l` and `ε/2` of `m`, which
  -- will be a contradiction. To make life easier let's break
  -- the symmetry and assume WLOG that `l < m`, because then
  -- we can just let `ε` be `m - l`.
  wlog hlm : l < m,
  -- Lean checks that everything is symmetric in `l` and `m` so
  -- this tactic succeeds, but asks us to prove that either
  -- `l < m` or `m < l`. We now have two goals so let's
  -- put a `{` `}` pair to get back to one goal.
  { -- now we just have the one easy goal `l < m ∨ m < l`.
    -- First we note that the reals are totally ordered so
    -- we can add `l < m ∨ l = m ∨ m < l` to the list of
    -- hypotheses with the `have` tactic:
    have : l < m ∨ l = m ∨ m < l := lt_trichotomy l m,
    -- Now the result follows from pure logic.
    tauto },
  -- Now let's define ε to be m - l.
  set ε := m - l with hε,
  -- Mathematically, the plan is to now find big natural numbers `L` and `M`
  -- such that `n ≥ L → |a n - l| < ε/2`, and `n ≥ M → |a n - m| < ε/2`,
  -- and then set `n = max L M` to get a contradiction. How do we do this
  -- in Lean?

  -- Well, let's think about `hl` as a function. Its type is
  -- `is_limit a l` which is definitionally `∀ ε, ε > 0 → ...`.
  -- So `hl` is a function which wants as an input a real number
  -- and a proof that it is positive. Let's first give `hl` the
  -- real number `ε/2` once and for all (it's the only time we'll
  -- be using `hl` in the proof so we can change its definition)
  specialize hl (ε/2),
  -- Now `hl` is a function which wants a proof by `ε/2>0` as its input.
  -- Mathematically, this is obvious: `ε/2=(m-l)/2` and `l < m`.
  -- Lean's `linarith` (linear arithmetic) tactic can solve this sort of goal:
  have hε2 : ε/2 > 0 := by linarith,
  -- Now we can specialize `hl` further:
  specialize hl hε2,
  -- Now `hl` isn't a function any more. In the lingo, it's an inductive
  -- type rather than a pi type.
  -- `hl : ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → |a n - l| < ε / 2`
  -- `hl` is now a made from a pair of pieces of information: first a natural
  -- number `N`, and second a proof of some fact about `N`. We can take
  -- `hl` apart into these two pieces with the `cases` tactic:
  cases hl with L hL,
  -- Now `L` is the natural and `hL` is a proof of a theorem about it:
  -- `hL : ∀ (n : ℕ), n ≥ L → |a n - l| < ε / 2`

  -- We now need to do the same thing with `hm`. Let's just do it all in one
  -- go. Check that you understand why this one line does the same sort of thing
  -- as the four lines above.
  cases hm (ε/2) (by linarith) with M hM,

  -- Now let's get back to the maths proof. Let N be the max of L and M.
  set N := max L M with hN,
  -- Let's record here the fact that `L ≤ N` and `M ≤ N`. I found
  -- these proofs by using `library_search` and then clicking on "Try this!".
  -- For example
  -- `have hLN : L ≤ N := by library_search`,
  have hLN : L ≤ N := le_max_left L M,
  have hMN : M ≤ N := le_max_right L M,
  -- We're going to set `n = N` in `hL` and `hM`. Again I'm thinking
  -- of these things as functions.
  specialize hL N hLN,
  specialize hM N hMN,
  -- It looks like we should be done now: everything should follow
  -- now from chasing inequalities. We need to give Lean one more hint
  -- though, because `linarith` doesn't know anything about the `abs` function;
  -- we need to know that |x|<ε/2 is the same as `-ε/2 < x ∧ x < ε/2`.
  -- This theorem is called `abs_lt` ("absolute value is less than").
  rw abs_lt at hL hM,
  -- As a challenge, can you now look at the tactic state and finish the proof
  -- on paper? Lean's `linarith` tactic can see its way through the inequality
  -- maze. Let's finish this proof and talk about `linarith` and another
  -- high-powered tactic, `ring`.
  linarith,
end

/-

Two quick comments on some other new things in the above proof:

1) We will be using `max` a lot in this workshop. `max A B` is
the max of `A` and `B`. `max` is a definition, not a theorem, so
that means that there will be an API associated with it, i.e.
a list of little theorems which make `max` possible to use.
We just saw the two important theorems which we'll be using:
`le_max_left A B : A ≤ max A B` and
`le_max-right A B : B ≤ max A B`.

There are other cool functions in the `max` API, for example
`max_le : A ≤ C → B ≤ C → max A B ≤ C`. The easiest way to
find your way around the `max` API is to *guess* what the names
of the theorems are! For example what do you think
`max A B < C ↔ A < C ∧ B < C` is called?
If you can't work it out, then cheat by running

```
example (A B C : ℝ) : max A B < C ↔ A < C ∧ B < C :=
begin
  library_search
end
```

2) `specialize` is a tactic which changes a function by fixing once and
for all the first inputs. For example, say `f : A → B → C → D` is a function.
Because `→` is right associative in Lean, `f` is a function which wants
an input from `A`, and then spits out a function which wants an input
from `B`, and spits out a function which wants an input from `C` and
spits out an element of `D`. So really it's just a function which takes
three inputs, one from `A`, one from `B` and one from `C`, and spits
out something in `D`. This is what computer scientists call "currying".

Now say I have `a : A` and I want this to be my first input to `f`, and I never
want to run `f` again with any other inputs from `A`. Then

`specialize f a`

will feed `a` into `f` and then rename `f` to be the resulting new
function `B → C → D`.
-/

-- Before we go on, I need to explain two more high-powered tactics.

/-
## `linarith` and `ring`

`linarith` and `ring` are two high-powered tactics. It's important
to know their "scope".

### `ring`

Let's start with `ring`. The `ring` tactic
will prove any goal which can be deduced from the axioms of
a commutative ring (or even a commutative semiring like `ℕ`). For
example if `(x y : ℝ)` and the goal is `(x+y)^3=x^3+3*x^2*y+3*x*y^2+y^3`
then `ring` will close this goal. In the proof of `is_limit_add`
below in my solutions file, I use `ring` to prove
`a n + b n - (l + m) = (a n - l) + (b n - m)` and to prove `ε/2 + ε/2 = ε`.
Note that `ring` will get confused if it sees `λ` terms and so on, it
works up to syntactic equality. `ring` wants to see a clean statement
about elements of a ring involving only `+`, `-` and `*`. Note also that
`ring` does not look at hypotheses -- it works on the goal only.
So for example `ring` will not solve this goal directly:

```
a b c : ℝ
ha : a = b + c
⊢ 2 * a = b + b + c + c
```

To solve this goal you need to do `rw ha` and then `ring`.

### `linarith`

`linarith` solves linear inequalities. For example it will solve this goal:

```
a b c : ℝ
hab : a ≤ b
hbc : b < c
⊢ a ≤ c + 1
```

Note that it will not do your logic for you though. For example it will
not solve this goal:

```
a b c : ℝ
hab : a ≤ b
hbc : a ≤ b → b < c
⊢ a ≤ c + 1
```

even though `b < c` is "obviously true because of `hab`", `linarith` can't see it.
The *one* thing it can see through is `∧` in hypotheses: it will solve this goal.

```
a b c : ℝ
h : a ≤ b ∧ b < c
⊢ a ≤ c + 1
```

However it will not see through `∧` in goals; it will not solve this.

```
a b c : ℝ
h : a ≤ b ∧ b < c
⊢ a ≤ c + 1 ∧ a ≤ c + 1
```

To solve this goal, use `split; linarith`. The semicolon means "apply the
next tactic to all goals created by the previous tactic".

If you're unsure whether `linarith` can see an inequality, just isolate
it as a hypothesis or goal all by itself. Then `linarith` can definitely see it.

-/

/-

## convert

While we're here, here is an explanation of one more high-powered tactic.

If your goal is `⊢ P` and you have a hypothesis `h : P'` where `P` and `P'`
only differ slightly, then `convert h'` will replace the goal with new goals asking
for justification that all the places where `P` and `P'` differ are equal.
Here's an example:

-/

example (a b : ℝ) (h : a * 2 = b + 1) : a + a = b - (-1) :=
begin
  -- rw `h` won't work because we don't have a complete match on either
  -- side of the equality.
  convert h,
  -- now two goals: `a + a = a * 2` and `b - -1 = b + 1`
  { ring },
  { ring }
end

/-

An example where things can go a bit wrong is below. Uncomment the `convert h`
line to see a failure, and then you'll understand the fix.
-/
example (a b : ℝ) (h : a * 2 = b + 1) : a + a = 1 + b :=
begin
  -- uncomment this to see something unfortunate happen:
  -- convert h,

  convert h using 1, -- change to 2 or more to see the unfortunate thing again
  { ring },
  { ring }
end

/-

OK it's time to actually do some mathematics! Why don't we start by
looking at what happens when we change a sequence or limit by adding a constant.
-/

lemma is_limit_add_const {a : ℕ → ℝ} {l : ℝ} (c : ℝ) (ha : is_limit a l) :
  is_limit (λ i, a i + c) (l + c) :=
begin
  sorry
end

lemma is_limit_add_const_iff {a : ℕ → ℝ} {l : ℝ} (c : ℝ) :
  is_limit a l ↔ is_limit (λ i, a i + c) (l + c) :=
begin
  sorry,
end

lemma is_limit_iff_is_limit_sub_eq_zero (a : ℕ → ℝ) (l : ℝ) :
  is_limit a l ↔ is_limit (λ i, a i - l) 0 :=
begin
  sorry,
end

/-

We now prove that if aₙ → l and bₙ → m then aₙ + bₙ → l + m.

Here is the proof that I recommend you formalise:
choose L large enough so that n ≥ L implies |aₙ - l|<ε/2
choose M large enough so that n ≥ M implies |bₙ - m|<ε/2
Now N := max M₁ M₂ works.
Some extra things you may need to know:
`pi.add_apply a b : (a + b) n = a n + b n`
`abs_add x y : |x + y| ≤ |x| + |y|`
Good luck!

-/

theorem is_limit_add {a b : ℕ → ℝ} {l m : ℝ}
  (h1 : is_limit a l) (h2 : is_limit b m) :
  is_limit (a + b) (l + m) :=
begin
  sorry,
end

-- We have proved `is_limit` behaves well under `+`. If we also
-- prove that it behaves well under scalar multiplication, we can
-- deduce that it's linear. So let's do this next.

-- Helpful things:
-- `abs_pos : 0 < |a| ↔ a ≠ 0`
-- `div_pos : 0 < a → 0 < b → 0 < a / b`
-- `abs_mul x y : |x * y| = |x| * |y|`
-- `lt_div_iff' : 0 < c → (a < b / c ↔ c * a < b)`
-- I typically find these things myself with a combination of
-- the "guess the name of the lemma" game (and ctrl-space), and `library_search`

-- A hint for starting:
-- It might be worth dealing with `c = 0` as a special case. You
-- can start with
-- `by_cases hc : c = 0`

lemma is_limit_mul_const_left {a : ℕ → ℝ} {l c : ℝ} (h : is_limit a l) :
  is_limit (λ n, c * (a n)) (c * l) :=
begin
  sorry,
end

-- This should just be a couple of lines now.
lemma is_limit_linear (a : ℕ → ℝ) (b : ℕ → ℝ) (α β c d : ℝ)
    (ha : is_limit a α) (hb : is_limit b β) :
    is_limit ( λ n, c * (a n) + d * (b n) ) (c * α + d * β) :=
begin
  sorry,
end

-- We need the below result to prove that product of limits is limit
-- of products.
-- Rather than using `√ε`, just choose `N` large enough such that `|a n| ≤ ε`
-- and `|b n| ≤ 1` if `n ≥ N`; this will work.

lemma is_limit_mul_eq_zero_of_is_limit_eq_zero {a : ℕ → ℝ} {b : ℕ → ℝ}
  (ha : is_limit a 0) (hb : is_limit b 0) : is_limit (a * b) 0 :=
begin
  sorry,
end

-- The limit of the product is the product of the limits.
-- If aₙ → l and bₙ → m then aₙ * bₙ → l * m.
-- Here's the proof I recommend. Start with
-- `suffices : is_limit (λ i, (a i - l) * (b i - m) + (l * (b i - m)) + m * (a i - l)) 0,`
-- (note: this multiplies out to `a i * b i - l * m`)
-- and then prove that all three terms in the sum tend to zero.
theorem is_limit_mul (a : ℕ → ℝ) (b : ℕ → ℝ) (l m : ℝ)
  (h1 : is_limit a l) (h2 : is_limit b m) :
  is_limit (a * b) (l * m) :=
begin
  sorry,
end

-- If aₙ → l and bₙ → m, and aₙ ≤ bₙ for all n, then l ≤ m
theorem is_limit_le_of_le (a : ℕ → ℝ) (b : ℕ → ℝ)
  (l : ℝ) (m : ℝ) (hl : is_limit a l) (hm : is_limit b m)
  (hle : ∀ n, a n ≤ b n) : l ≤ m :=
begin
  sorry,
end

-- sandwich
theorem sandwich (a b c : ℕ → ℝ)
  (l : ℝ) (ha : is_limit a l) (hc : is_limit c l)
  (hab : ∀ n, a n ≤ b n) (hbc : ∀ n, b n ≤ c n) : is_limit b l :=
begin
  sorry,
end

-- Let's make a new definition.
definition is_bounded (a : ℕ → ℝ) := ∃ B, ∀ n, |a n| ≤ B

-- Now try this:
lemma tendsto_bounded_mul_zero {a : ℕ → ℝ} {b : ℕ → ℝ}
  (hA : is_bounded a) (hB : is_limit b 0)
  : is_limit (a*b) 0 :=
begin
  sorry,
end

-- we can make more definitions
def is_cauchy (a : ℕ → ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ m ≥ N, ∀ n ≥ N, |a m - a n| < ε

-- and of course one can go on and on and on

end xena

-- Take a look at `Part_A_limits_appendix.lean` to see some rather
-- shorter proofs! We will talk about these proofs next week. Perhaps
-- you can try and investigate what is going on, by hovering on things
-- like `tendsto`. Hint: filters.