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

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.n_comp_gamma
! leanprover-community/mathlib commit 19d6240dcc5e5c8bd6e1e3c588b92e837af76f9e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.DoldKan.GammaCompN
import Mathbin.AlgebraicTopology.DoldKan.NReflectsIso

/-! The unit isomorphism of the Dold-Kan equivalence

In order to construct the unit isomorphism of the Dold-Kan equivalence,
we first construct natural transformations
`Γ₂N₁.nat_trans : N₁ ⋙ Γ₂ ⟶ to_karoubi (simplicial_object C)` and
`Γ₂N₂.nat_trans : N₂ ⋙ Γ₂ ⟶ 𝟭 (simplicial_object C)`.
It is then shown that `Γ₂N₂.nat_trans` is an isomorphism by using
that it becomes an isomorphism after the application of the functor
`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)`
which reflects isomorphisms.

-/

noncomputable section

open
  CategoryTheory CategoryTheory.Category CategoryTheory.Limits CategoryTheory.Idempotents SimplexCategory Opposite SimplicialObject

open Simplicial DoldKan

namespace AlgebraicTopology

namespace DoldKan

variable {C : Type _} [Category C] [Preadditive C]

theorem pInfty_comp_map_mono_eq_zero (X : SimplicialObject C) {n : ℕ} {Δ' : SimplexCategory}
    (i : Δ' ⟶ [n]) [hi : Mono i] (h₁ : Δ'.len ≠ n) (h₂ : ¬Isδ₀ i) : pInfty.f n ≫ X.map i.op = 0 :=
  by
  induction' Δ' using SimplexCategory.rec with m
  obtain ⟨k, hk⟩ :=
    Nat.exists_eq_add_of_lt
      (len_lt_of_mono i fun h => by
        rw [← h] at h₁
        exact h₁ rfl)
  simp only [len_mk] at hk
  cases k
  · change n = m + 1 at hk
    subst hk
    obtain ⟨j, rfl⟩ := eq_δ_of_mono i
    rw [is_δ₀.iff] at h₂
    have h₃ : 1 ≤ (j : ℕ) := by
      by_contra
      exact h₂ (by simpa only [Fin.ext_iff, not_le, Nat.lt_one_iff] using h)
    exact (higher_faces_vanish.of_P (m + 1) m).comp_δ_eq_zero j h₂ (by linarith)
  · simp only [Nat.succ_eq_add_one, ← add_assoc] at hk
    clear h₂ hi
    subst hk
    obtain ⟨j₁, i, rfl⟩ :=
      eq_comp_δ_of_not_surjective i fun h =>
        by
        have h' := len_le_of_epi (SimplexCategory.epi_iff_surjective.2 h)
        dsimp at h'
        linarith
    obtain ⟨j₂, i, rfl⟩ :=
      eq_comp_δ_of_not_surjective i fun h =>
        by
        have h' := len_le_of_epi (SimplexCategory.epi_iff_surjective.2 h)
        dsimp at h'
        linarith
    by_cases hj₁ : j₁ = 0
    · subst hj₁
      rw [assoc, ← SimplexCategory.δ_comp_δ'' (Fin.zero_le _)]
      simp only [op_comp, X.map_comp, assoc, P_infty_f]
      erw [(higher_faces_vanish.of_P _ _).comp_δ_eq_zero_assoc _ j₂.succ_ne_zero, zero_comp]
      rw [Fin.val_succ]
      linarith
    · simp only [op_comp, X.map_comp, assoc, P_infty_f]
      erw [(higher_faces_vanish.of_P _ _).comp_δ_eq_zero_assoc _ hj₁, zero_comp]
      by_contra
      exact
        hj₁
          (by
            simp only [Fin.ext_iff, Fin.val_zero]
            linarith)
#align algebraic_topology.dold_kan.P_infty_comp_map_mono_eq_zero AlgebraicTopology.DoldKan.pInfty_comp_map_mono_eq_zero

@[reassoc.1]
theorem Γ₀_obj_termwise_mapMono_comp_pInfty (X : SimplicialObject C) {Δ Δ' : SimplexCategory}
    (i : Δ ⟶ Δ') [Mono i] :
    Γ₀.Obj.Termwise.mapMono (AlternatingFaceMapComplex.obj X) i ≫ pInfty.f Δ.len =
      pInfty.f Δ'.len ≫ X.map i.op :=
  by
  induction' Δ using SimplexCategory.rec with n
  induction' Δ' using SimplexCategory.rec with n'
  dsimp
  -- We start with the case `i` is an identity
  by_cases n = n'
  · subst h
    simp only [SimplexCategory.eq_id_of_mono i, Γ₀.obj.termwise.map_mono_id, op_id, X.map_id]
    dsimp
    simp only [id_comp, comp_id]
  by_cases hi : is_δ₀ i
  -- The case `i = δ 0`
  · have h' : n' = n + 1 := hi.left
    subst h'
    simp only [Γ₀.obj.termwise.map_mono_δ₀' _ i hi]
    dsimp
    rw [← P_infty.comm' _ n rfl, alternating_face_map_complex.obj_d_eq]
    simp only [eq_self_iff_true, id_comp, if_true, preadditive.comp_sum]
    rw [Finset.sum_eq_single (0 : Fin (n + 2))]
    rotate_left
    · intro b hb hb'
      rw [preadditive.comp_zsmul]
      erw [P_infty_comp_map_mono_eq_zero X (SimplexCategory.δ b) h
          (by
            rw [is_δ₀.iff]
            exact hb'),
        zsmul_zero]
    · simp only [Finset.mem_univ, not_true, IsEmpty.forall_iff]
    · simpa only [hi.eq_δ₀, Fin.val_zero, pow_zero, one_zsmul]
  -- The case `i ≠ δ 0`
  · rw [Γ₀.obj.termwise.map_mono_eq_zero _ i _ hi, zero_comp]
    swap
    · by_contra h'
      exact h (congr_arg SimplexCategory.len h'.symm)
    rw [P_infty_comp_map_mono_eq_zero]
    · exact h
    · by_contra h'
      exact hi h'
#align algebraic_topology.dold_kan.Γ₀_obj_termwise_map_mono_comp_P_infty AlgebraicTopology.DoldKan.Γ₀_obj_termwise_mapMono_comp_pInfty

variable [HasFiniteCoproducts C]

namespace Γ₂N₁

/-- The natural transformation `N₁ ⋙ Γ₂ ⟶ to_karoubi (simplicial_object C)`. -/
@[simps]
def natTrans : (n₁ : SimplicialObject C ⥤ _) ⋙ Γ₂ ⟶ toKaroubi _
    where
  app X :=
    { f :=
        { app := fun Δ => (Γ₀.splitting K[X]).desc Δ fun A => pInfty.f A.1.unop.len ≫ X.map A.e.op
          naturality' := fun Δ Δ' θ =>
            by
            apply (Γ₀.splitting K[X]).hom_ext'
            intro A
            change _ ≫ (Γ₀.obj K[X]).map θ ≫ _ = _
            simp only [splitting.ι_desc_assoc, assoc, Γ₀.obj.map_on_summand'_assoc,
              splitting.ι_desc]
            erw [Γ₀_obj_termwise_map_mono_comp_P_infty_assoc X (image.ι (θ.unop ≫ A.e))]
            dsimp only [to_karoubi]
            simp only [← X.map_comp]
            congr 2
            simp only [eq_to_hom_refl, id_comp, comp_id, ← op_comp]
            exact Quiver.Hom.unop_inj (A.fac_pull θ) }
      comm := by
        apply (Γ₀.splitting K[X]).hom_ext
        intro n
        dsimp [N₁]
        simp only [← splitting.ι_summand_id, splitting.ι_desc, comp_id, splitting.ι_desc_assoc,
          assoc, P_infty_f_idem_assoc] }
  naturality' X Y f := by
    ext1
    apply (Γ₀.splitting K[X]).hom_ext
    intro n
    dsimp [N₁, to_karoubi]
    simpa only [← splitting.ι_summand_id, splitting.ι_desc, splitting.ι_desc_assoc, assoc,
      P_infty_f_idem_assoc, karoubi.comp_f, nat_trans.comp_app, Γ₂_map_f_app,
      HomologicalComplex.comp_f, alternating_face_map_complex.map_f, P_infty_f_naturality_assoc,
      nat_trans.naturality]
#align algebraic_topology.dold_kan.Γ₂N₁.nat_trans AlgebraicTopology.DoldKan.Γ₂N₁.natTrans

end Γ₂N₁

/-- The compatibility isomorphism relating `N₂ ⋙ Γ₂` and `N₁ ⋙ Γ₂`. -/
@[simps]
def compatibilityΓ₂N₁Γ₂N₂ : toKaroubi (SimplicialObject C) ⋙ n₂ ⋙ Γ₂ ≅ n₁ ⋙ Γ₂ :=
  eqToIso (Functor.congr_obj (functorExtension₁_comp_whiskeringLeft_toKaroubi _ _) (n₁ ⋙ Γ₂))
#align algebraic_topology.dold_kan.compatibility_Γ₂N₁_Γ₂N₂ AlgebraicTopology.DoldKan.compatibilityΓ₂N₁Γ₂N₂

namespace Γ₂N₂

/-- The natural transformation `N₂ ⋙ Γ₂ ⟶ 𝟭 (simplicial_object C)`. -/
def natTrans : (n₂ : Karoubi (SimplicialObject C) ⥤ _) ⋙ Γ₂ ⟶ 𝟭 _ :=
  ((whiskeringLeft _ _ _).obj _).Preimage (compatibilityΓ₂N₁Γ₂N₂.Hom ≫ Γ₂N₁.natTrans)
#align algebraic_topology.dold_kan.Γ₂N₂.nat_trans AlgebraicTopology.DoldKan.Γ₂N₂.natTrans

theorem natTrans_app_f_app (P : Karoubi (SimplicialObject C)) :
    Γ₂N₂.natTrans.app P =
      (n₂ ⋙ Γ₂).map P.decompIdI ≫
        (compatibilityΓ₂N₁Γ₂N₂.Hom ≫ Γ₂N₁.natTrans).app P.pt ≫ P.decompIdP :=
  whiskeringLeft_obj_preimage_app (compatibilityΓ₂N₁Γ₂N₂.Hom ≫ Γ₂N₁.natTrans) P
#align algebraic_topology.dold_kan.Γ₂N₂.nat_trans_app_f_app AlgebraicTopology.DoldKan.Γ₂N₂.natTrans_app_f_app

end Γ₂N₂

theorem compatibilityΓ₂N₁Γ₂N₂_natTrans (X : SimplicialObject C) :
    Γ₂N₁.natTrans.app X =
      (compatibilityΓ₂N₁Γ₂N₂.app X).inv ≫ Γ₂N₂.natTrans.app ((toKaroubi _).obj X) :=
  by
  rw [← cancel_epi (compatibility_Γ₂N₁_Γ₂N₂.app X).Hom, iso.hom_inv_id_assoc]
  exact
    congr_app
      (((whiskering_left _ _ _).obj _).image_preimage
          (compatibility_Γ₂N₁_Γ₂N₂.hom ≫ Γ₂N₁.nat_trans : _ ⟶ to_karoubi _ ⋙ 𝟭 _)).symm
      X
#align algebraic_topology.dold_kan.compatibility_Γ₂N₁_Γ₂N₂_nat_trans AlgebraicTopology.DoldKan.compatibilityΓ₂N₁Γ₂N₂_natTrans

theorem identity_n₂_objectwise (P : Karoubi (SimplicialObject C)) :
    n₂Γ₂.inv.app (n₂.obj P) ≫ n₂.map (Γ₂N₂.natTrans.app P) = 𝟙 (n₂.obj P) :=
  by
  ext n
  have eq₁ :
    (N₂Γ₂.inv.app (N₂.obj P)).f.f n =
      P_infty.f n ≫
        P.p.app (op [n]) ≫
          (Γ₀.splitting (N₂.obj P).pt).ιSummand (splitting.index_set.id (op [n])) :=
    by simp only [N₂Γ₂_inv_app_f_f, N₂_obj_p_f, assoc]
  have eq₂ :
    (Γ₀.splitting (N₂.obj P).pt).ιSummand (splitting.index_set.id (op [n])) ≫
        (N₂.map (Γ₂N₂.nat_trans.app P)).f.f n =
      P_infty.f n ≫ P.p.app (op [n]) :=
    by
    dsimp [N₂]
    simp only [Γ₂N₂.nat_trans_app_f_app, P_infty_on_Γ₀_splitting_summand_eq_self_assoc,
      functor.comp_map, compatibility_Γ₂N₁_Γ₂N₂_hom, nat_trans.comp_app, eq_to_hom_app, assoc,
      karoubi.comp_f, karoubi.eq_to_hom_f, eq_to_hom_refl, comp_id, karoubi.decomp_id_p_f,
      karoubi.comp_p_assoc, Γ₂_map_f_app, N₂_map_f_f, karoubi.decomp_id_i_f,
      Γ₂N₁.nat_trans_app_f_app]
    erw [splitting.ι_desc_assoc, assoc, assoc, splitting.ι_desc_assoc]
    dsimp [splitting.index_set.id, splitting.index_set.e]
    simp only [assoc, nat_trans.naturality, P_infty_f_naturality_assoc, app_idem_assoc,
      P_infty_f_idem_assoc]
    erw [P.X.map_id, comp_id]
  simp only [karoubi.comp_f, HomologicalComplex.comp_f, karoubi.id_eq, N₂_obj_p_f, assoc, eq₁, eq₂,
    P_infty_f_naturality_assoc, app_idem, P_infty_f_idem_assoc]
#align algebraic_topology.dold_kan.identity_N₂_objectwise AlgebraicTopology.DoldKan.identity_n₂_objectwise

theorem identity_n₂ :
    ((𝟙 (n₂ : Karoubi (SimplicialObject C) ⥤ _) ◫ n₂Γ₂.inv) ≫ Γ₂N₂.natTrans ◫ 𝟙 n₂ : n₂ ⟶ n₂) =
      𝟙 n₂ :=
  by
  ext P : 2
  dsimp
  rw [Γ₂.map_id, N₂.map_id, comp_id, id_comp, identity_N₂_objectwise P]
#align algebraic_topology.dold_kan.identity_N₂ AlgebraicTopology.DoldKan.identity_n₂

instance : IsIso (Γ₂N₂.natTrans : (n₂ : Karoubi (SimplicialObject C) ⥤ _) ⋙ _ ⟶ _) :=
  by
  have : ∀ P : karoubi (simplicial_object C), is_iso (Γ₂N₂.nat_trans.app P) :=
    by
    intro P
    have : is_iso (N₂.map (Γ₂N₂.nat_trans.app P)) :=
      by
      have h := identity_N₂_objectwise P
      erw [hom_comp_eq_id] at h
      rw [h]
      infer_instance
    exact is_iso_of_reflects_iso _ N₂
  apply nat_iso.is_iso_of_is_iso_app

instance : IsIso (Γ₂N₁.natTrans : (n₁ : SimplicialObject C ⥤ _) ⋙ _ ⟶ _) :=
  by
  have : ∀ X : simplicial_object C, is_iso (Γ₂N₁.nat_trans.app X) :=
    by
    intro X
    rw [compatibility_Γ₂N₁_Γ₂N₂_nat_trans]
    infer_instance
  apply nat_iso.is_iso_of_is_iso_app

/-- The unit isomorphism of the Dold-Kan equivalence. -/
@[simp]
def Γ₂N₂ : 𝟭 _ ≅ (n₂ : Karoubi (SimplicialObject C) ⥤ _) ⋙ Γ₂ :=
  (asIso Γ₂N₂.natTrans).symm
#align algebraic_topology.dold_kan.Γ₂N₂ AlgebraicTopology.DoldKan.Γ₂N₂

/-- The natural isomorphism `to_karoubi (simplicial_object C) ≅ N₁ ⋙ Γ₂`. -/
@[simps]
def Γ₂N₁ : toKaroubi _ ≅ (n₁ : SimplicialObject C ⥤ _) ⋙ Γ₂ :=
  (asIso Γ₂N₁.natTrans).symm
#align algebraic_topology.dold_kan.Γ₂N₁ AlgebraicTopology.DoldKan.Γ₂N₁

end DoldKan

end AlgebraicTopology


import rescale.basic
import locally_constant.Vhat

import category_theory.preadditive.additive_functor

import facts.nnreal

noncomputable theory
open_locale big_operators classical nnreal

namespace rescale

variables {N : ℝ≥0} {V : Type*}

instance [has_norm V] : has_norm (rescale N V) :=
{ norm := λ v, ∥of.symm v∥/N }

lemma norm_def [has_norm V] (v : rescale N V) : ∥v∥ = ∥of.symm v∥/N := rfl

instance [hN : fact (0 < N)] [seminormed_add_comm_group V] : seminormed_add_comm_group (rescale N V) :=
seminormed_add_comm_group.of_core (rescale N V)
{ norm_zero := show ∥(0 : V)∥/N = 0, by rw [norm_zero, zero_div],
  triangle := λ v w,
  begin
    simp only [norm_def, ← add_div],
    exact div_le_div_of_le hN.out.le (norm_add_le _ _), -- defeq abuse
  end,
  norm_neg := λ v, by { simp only [norm_def], congr' 1, exact norm_neg _ /- defeq abuse -/ } }

instance [hN : fact (0 < N)] [normed_add_comm_group V] : normed_add_comm_group (rescale N V) :=
normed_add_comm_group.of_core (rescale N V)
{ norm_eq_zero_iff := λ v,
  begin
    have aux : (N:ℝ) ≠ 0 := ne_of_gt hN.out,
    simp only [norm_def, div_eq_zero_iff, aux, or_false],
    exact norm_eq_zero -- defeq abuse
  end,
  triangle := λ v w,
  begin
    simp only [norm_def, ← add_div],
    exact div_le_div_of_le hN.out.le (norm_add_le _ _), -- defeq abuse
  end,
  norm_neg := λ v, by { simp only [norm_def], congr' 1, exact norm_neg _ /- defeq abuse -/ } }

lemma nnnorm_def [hN : fact (0 < N)] [seminormed_add_comm_group V] (v : rescale N V) :
  ∥v∥₊ = ∥of.symm v∥₊ / N := rfl

end rescale

namespace SemiNormedGroup

variables (r r₁ r₂ : ℝ≥0) [fact (0 < r₁)] [fact (0 < r₂)]

@[simps]
def rescale (r : ℝ≥0) [hr : fact (0 < r)] : SemiNormedGroup ⥤ SemiNormedGroup :=
{ obj := λ V, of $ rescale r V,
  map := λ V₁ V₂ f,
  { to_fun := λ v, @rescale.of r V₂ $ f ((@rescale.of r V₁).symm v),
    map_add' := f.map_add', -- defeq abuse
    bound' :=
    begin
      obtain ⟨C, C_pos, hC⟩ := f.bound,
      use C,
      intro v,
      have := hC ((@rescale.of r V₁).symm v),
      rw [← div_le_div_right (show 0 < (r:ℝ), from hr.1), mul_div_assoc] at this,
      exact this,
    end },
  map_id' := λ V, rfl, -- defeq abuse
  map_comp' := λ V₁ V₂ V₃ f g, rfl /- defeq abuse -/ }

instance rescale.additive [fact (0 < r)] : (rescale r).additive :=
{ map_add' := λ V W f g, rfl /- defeq abuse -/ }

lemma norm_rescale_map_le [fact (0 < r)] {V₁ V₂ : SemiNormedGroup}
  {f : V₁ ⟶ V₂} {C : ℝ} (hf : ∥f∥ ≤ C) :
  ∥(rescale r).map f∥ ≤ C :=
begin
  refine normed_add_group_hom.op_norm_le_bound _ (le_trans (norm_nonneg _) hf) (λ v, _),
  dsimp,
  erw [rescale.norm_def, rescale.norm_def, equiv.symm_apply_apply, ← mul_div_assoc],
  refine div_le_div (mul_nonneg (le_trans (norm_nonneg _) hf) (norm_nonneg _))
    (normed_add_group_hom.le_of_op_norm_le _ hf _) _ le_rfl,
  rw nnreal.coe_pos, exact ‹fact (0 < r)›.out
end

lemma rescale_map_isometry [fact (0 < r)]
  {V₁ V₂ : SemiNormedGroup} {f : V₁ ⟶ V₂} (hf : isometry f) :
  isometry ((rescale r).map f) :=
begin
  rw add_monoid_hom_class.isometry_iff_norm at hf ⊢,
  intro v,
  erw [rescale.norm_def, rescale.norm_def, hf ((@rescale.of r _).symm v)],
end

lemma rescale_exact [fact (0 < r)] {V₁ V₂ V₃ : SemiNormedGroup} (f : V₁ ⟶ V₂) (g : V₂ ⟶ V₃)
  (hfg : f.range = g.ker) :
  ((rescale r).map f).range = ((rescale r).map g).ker :=
begin
  ext x,
  calc x ∈ ((rescale r).map f).range ↔ x ∈ f.range : iff.rfl
  ... ↔ x ∈ g.ker : by rw hfg
  ... ↔ x ∈ ((rescale r).map g).ker : iff.rfl,
end

lemma rescale_exists_norm_le [fact (0 < r)] {V₁ V₂ : SemiNormedGroup} (f : V₁ ⟶ V₂) (C : ℝ≥0)
  (hf : ∀ y, ∃ x, f x = y ∧ ∥x∥ ≤ C * ∥y∥) :
  ∀ y, ∃ x, (rescale r).map f x = y ∧ ∥x∥ ≤ C * ∥y∥ :=
begin
  intro y,
  obtain ⟨x, h1, h2⟩ := hf ((@rescale.of r _).symm y),
  refine ⟨@rescale.of r _ x, h1, _⟩,
  erw [rescale.norm_def, rescale.norm_def],
  simp only [div_eq_mul_inv, ← mul_assoc, equiv.symm_apply_apply, ← coe_nnnorm],
  norm_cast, exact mul_le_mul' h2 le_rfl,
end

lemma nnnorm_to_rescale {V : SemiNormedGroup} (v : V) : ∥(@rescale.of r V) v∥ ≤ r⁻¹ * ∥v∥ :=
by { rw ← div_eq_inv_mul, refl }

def to_rescale [fact (0 < r)] : 𝟭 _ ⟶ rescale r :=
{ app := λ V,
  add_monoid_hom.mk_normed_add_group_hom'
    (add_monoid_hom.mk' (@rescale.of r V) $ λ _ _, rfl) r⁻¹ (λ v, nnnorm_to_rescale _ v),
  naturality' := λ V W f, rfl /- defeq abuse -/ }

def of_rescale [hr : fact (0 < r)] : rescale r ⟶ 𝟭 _ :=
{ app := λ V,
  add_monoid_hom.mk_normed_add_group_hom' (add_monoid_hom.mk' (@rescale.of r V) .symm $ λ _ _, rfl) r
  begin
    intro v,
    erw [rescale.nnnorm_def, mul_div_cancel' _ hr.1.ne'],
    exact le_rfl
  end,
  naturality' := λ V W f, rfl /- defeq abuse -/ }

@[simps]
def iso_rescale [fact (0 < r)] : 𝟭 _ ≅ (rescale r) :=
{ hom := to_rescale r,
  inv := of_rescale r, }

open _root_.category_theory

lemma iso_rescale_isometry [fact (0 < r)] (h : r = 1) (V : SemiNormedGroup) :
  isometry ((iso_rescale r).app V).hom :=
begin
  unfreezingI { cases h },
  dsimp only [nat_iso.app_hom, iso_rescale_hom],
  apply add_monoid_hom_class.isometry_of_norm,
  intro v,
  erw [rescale.norm_def],
  simp only [div_one, subtype.coe_mk],
  refl
end

lemma norm_to_rescale_le [fact (0 < r)] (V : SemiNormedGroup) : ∥(to_rescale r).app V∥ ≤ r⁻¹ :=
normed_add_group_hom.mk_normed_add_group_hom_norm_le _
  (inv_nonneg.2 (nnreal.zero_le_coe)) (λ v, nnnorm_to_rescale _ v)

lemma nnnorm_rescale_rescale_symm {V : SemiNormedGroup} (v : (rescale r₁).obj V) :
  ∥(@rescale.of r₂ V) ((@rescale.of r₁ V).symm v)∥₊ ≤ r₁ / r₂ * ∥v∥₊ :=
begin
  apply le_of_eq,
  show _ = r₁ / r₂ * (∥(@rescale.of r₁ V).symm v∥₊ / r₁),
  simp only [add_monoid_hom.mk'_apply, div_eq_inv_mul, rescale.nnnorm_def],
  rw [mul_assoc, mul_inv_cancel_left₀ (show r₁ ≠ 0, from ne_of_gt $ fact.out _)],
  refl
end

def scale : rescale r₁ ⟶ rescale r₂ :=
{ app := λ V,
  add_monoid_hom.mk_normed_add_group_hom'
    (add_monoid_hom.mk' (λ v, (@rescale.of r₂ V) $ (@rescale.of r₁ V).symm v) $
      λ _ _, rfl) (r₁ / r₂) (λ v, nnnorm_rescale_rescale_symm r₁ r₂ v),
  naturality' := λ V W f, rfl /- defeq abuse -/ }

lemma norm_scale_le (V : SemiNormedGroup) : ∥(scale r₁ r₂).app V∥ ≤ (r₁ / r₂) :=
normed_add_group_hom.mk_normed_add_group_hom_norm_le _ (div_nonneg (nnreal.coe_nonneg _)
    (nnreal.coe_nonneg _)) (λ v, nnnorm_rescale_rescale_symm r₁ r₂ v)

lemma scale_comm {V₁ V₂ W₁ W₂ : SemiNormedGroup}
  (f₁ : V₁ ⟶ W₁) (f₂ : V₂ ⟶ W₂) (φ : V₁ ⟶ V₂) (ψ : W₁ ⟶ W₂) (h : f₁ ≫ ψ = φ ≫ f₂) :
  (rescale r₁).map f₁ ≫ ((rescale r₁).map ψ ≫ (scale r₁ r₂).app W₂) =
  ((rescale r₁).map φ ≫ (scale r₁ r₂).app V₂) ≫ (rescale r₂).map f₂ :=
by rw [← category.assoc, ← category_theory.functor.map_comp, nat_trans.naturality,
    nat_trans.naturality, category.assoc, ← category_theory.functor.map_comp, h]

end SemiNormedGroup


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume (i j : ℤ) (hij : i ≠ j),
    have h2 : ∀ (i j : ℤ), i ≠ j → ¬ (int.fract (α * ↑i) = int.fract (α * ↑j)), from by {
      assume (i j : ℤ) (hij : i ≠ j),
      assume h3 : int.fract (α * ↑i) = int.fract (α * ↑j),
      have h4 : α = (↑i)⁻¹ * ↑(int.nat_abs (α * ↑i)) / (↑j)⁻¹ * ↑(int.nat_abs (α * ↑j)), from by {
        rw h3,
        rw int.fract_eq_div_nat_abs,
        rw int.fract_eq_div_nat_abs,
        ring,
      },
      have h5 : α * ↑j = ↑i * ↑(int.nat_abs (α * ↑i)), from by {
        rw h4,
        rw mul_assoc,
        rw mul_assoc,
        rw mul_comm (↑i) (↑j)⁻¹,
        rw mul_assoc,
        rw mul_inv_cancel,
        rw mul_one,
        ring,
      },
      have h6 : α * ↑j = ↑(int.nat_abs (α * ↑i)) * ↑i, from by {
        rw h5,
        rw mul_comm (↑i) (int.nat_abs (α * ↑i)),
      },
      have h7 : α * ↑j = ↑(int.nat_abs (α * ↑i) * i), from by {
        rw h6,
        rw int.coe_nat_mul,
      },
      have h8 : α * ↑j = ↑(int.nat_abs (α * ↑j * j)), from by {
        rw mul_comm (α * ↑j) j,
        rw int.nat_abs_mul,
        rw int.coe_nat_mul,
      },
      have h9 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i) * i, from by {
        rw h7,
        rw h8,
      },
      have h10 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h11 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h10,
      },
      have h12 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h13 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h12,
      },
      have h14 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h15 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h14,
      },
      have h16 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h17 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h16,
      },
      have h18 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h19 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h18,
      },
      have h20 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h21 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h20,
      },
      have h22 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h23 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h22,
      },
      have h24 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h25 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h24,
      },
      have h26 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h27 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h26,
      },
      have h28 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h29 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h28,
      },
      have h30 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h31 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h30,
      },
      have h32 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j : ℤ, assume h1 : i ≠ j,
    have h2 : α ≠ (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      assume h2 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j),
      have h3 : (i - j) * α = int.fract (α * ↑i) - int.fract (α * ↑j), from by {rw h2, ring},
      have h4 : int.fract (α * ↑i) = int.fract (α * ↑j), from by {rw h3, ring},
      have h5 : α * ↑i = α * ↑j, from by {rw h4, ring},
      have h6 : ↑i = ↑j, from by {apply int.irrational_mul_ne_zero hα_irrat, rw h5, ring},
      exact h1 h6,
    },
    have h3 : (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j) ∈ ℚ, from by {rw ← int.fract_eq_iff_eq_int, ring},
    show int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {apply h2, exact h3},
  },
  have h2 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {
    assume i j : ℤ, assume h2 : i ≠ j,
    have h3 : int.fract (α * ↑i) ∈ set.Icc 0 1, from by {rw ← int.fract_eq_iff_eq_int, ring},
    have h4 : int.fract (α * ↑j) ∈ set.Icc 0 1, from by {rw ← int.fract_eq_iff_eq_int, ring},
    have h5 : abs (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {rw abs_of_nonneg, rw abs_of_nonneg, apply set.subset.trans h3.1 h4.2, apply set.subset.trans h4.1 h3.2},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {rw ← abs_neg, rw ← abs_neg, apply set.subset.trans h5.1 h5.2},
  },
  have h3 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {
    assume i j : ℤ, assume h3 : i ≠ j,
    have h4 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {apply h2, exact h3},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {apply set.subset.trans h4.1 h4.2},
  },
  have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑j) - int.fract (α * ↑i)) ∈ set.Icc 0 1, from by {
    assume i j : ℤ, assume h4 : i ≠ j,
    have h5 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {apply h2, exact h4},
    have h6 : (int.fract (α * ↑j) - int.fract (α * ↑i)) ∈ set.Icc (-1) 1, from by {apply h2, exact h4},
    have h7 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {apply set.subset.trans h5.1 h5.2},
    have h8 : (int.fract (α * ↑j) - int.fract (α * ↑i)) ∈ set.Icc 0 1, from by {apply set.subset.trans h6.1 h6.2},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑j) - int.fract (α * ↑i)) ∈ set.Icc 0 1, from by {split,exact h7,exact h8},
  },
  have h5 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {
    assume i j : ℤ, assume h5 : i ≠ j,
    have h6 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {apply h2, exact h5},
    have h7 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {apply set.subset.trans h6.1 h6.2},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {split,exact h7,exact h7},
  },
  have h6 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {
    assume i j : ℤ, assume h6 : i ≠ j,
    have h7 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {apply h2, exact h6},
    have h8 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {apply set.subset.trans h7.1 h7.2},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {split,exact h8,exact h8,exact h8},
  },
  have h7 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, (i ≠ j) → (int.fract (α * ↑i) ≠ int.fract (α * ↑j)), from assume i j : ℤ,
    assume hneq : i ≠ j,
    have h1 : int.fract (α * ↑i) = int.fract (α * ↑j) → α ∈ ℚ, from assume h : int.fract (α * ↑i) = int.fract (α * ↑j),
      have h1 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from
        by {rw [h,int.fract_sub,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ m n : ℤ, (int.fract (α * ↑m)) ≠ (int.fract (α * ↑n)), from
    assume (m n : ℤ), have h1 : (int.fract (α * ↑m)) = (int.fract (α * ↑n)) → (α ∈ ℚ), from
      assume h2 : (int.fract (α * ↑m)) = (int.fract (α * ↑n)),
      have h3 : (int.fract (α * ↑m)) = (α * ↑m - int.nat_abs (α * ↑m)), from by simp,
      have h4 : (int.fract (α * ↑n)) = (α * ↑n - int.nat_abs (α * ↑n)), from by simp,
      have h5 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑n - int.nat_abs (α * ↑n)), from by {rw [h3,h4],exact h2},
      have h6 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m - int.nat_abs (α * ↑n)), from by {rw [h5],ring},
      have h7 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m - (int.nat_abs (α * ↑m) - int.nat_abs (α * ↑n))), from by {rw [h6],ring},
      have h8 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m - (α * ↑m - int.nat_abs (α * ↑n))), from by {rw [h7],ring},
      have h9 : (α * ↑m - int.nat_abs (α * ↑m)) = (int.nat_abs (α * ↑n)), from by {rw [h8],ring},
      have h10 : (α * ↑m - int.nat_abs (α * ↑m)) = (int.nat_abs (α * ↑m)), from by {rw [h9],ring},
      have h11 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m), from by {rw [h10],ring},
      have h12 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m - (α * ↑m - α * ↑n)), from by {rw [h11],ring},
      have h13 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑n), from by {rw [h12],ring},
      have h14 : (α * ↑m) = (α * ↑n), from by {rw [h13],ring},
      have h15 : (α * ↑m) = (m * α), from by {rw [mul_comm],exact h14},
      have h16 : (α * ↑n) = (n * α), from by {rw [mul_comm],exact h14},
      have h17 : (m * α) = (n * α), from by {rw [h15,h16],ring},
      have h18 : (m * α) = (α * n), from by {rw [mul_comm],exact h17},
      have h19 : (α * ↑m) = (α * ↑n), from by {rw [h15,h16],ring},
      have h20 : (α * ↑m) = (α * ↑n), from by {rw [h19],exact h18},
      have h21 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h20},
      have h22 : (α * ↑m) = (α * ↑m), from by {rw [h21],exact h18},
      have h23 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h22},
      have h24 : (α * ↑m) = (α * ↑m), from by {rw [h23],exact h18},
      have h25 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h24},
      have h26 : (α * ↑m) = (α * ↑m), from by {rw [h25],exact h18},
      have h27 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h26},
      have h28 : (α * ↑m) = (α * ↑m), from by {rw [h27],exact h18},
      have h29 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h28},
      have h30 : (α * ↑m) = (α * ↑m), from by {rw [h29],exact h18},
      have h31 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h30},
      have h32 : (α * ↑m) = (α * ↑m), from by {rw [h31],exact h18},
      have h33 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h32},
      have h34 : (α * ↑m) = (α * ↑m), from by {rw [h33],exact h18},
      have h35 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h34},
      have h36 : (α * ↑m) = (α * ↑m), from by {rw [h35],exact h18},
      have h37 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h36},
      have h38 : (α * ↑m) = (α * ↑m), from by {rw [h37],exact h18},
      have h39 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h38},
      have h40 : (α * ↑m) = (α * ↑m), from by {rw [h39],exact h18},
      have h41 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h40},
      have h42 : (α * ↑m) = (α * ↑m), from by {rw [h41],exact h18},
      have h43 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h42},
      have h44 : (α * ↑m) = (α * ↑m), from by {rw [h43],exact h18},
      have h45 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h44},
      have h46 : (α * ↑m) = (α * ↑m), from by {rw [h45],exact h18},
      have h47 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h46},
      have h48 : (α * ↑m) = (α * ↑m), from by {rw [h47],exact h18},
      have h49 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h48},
      have h50 : (α * ↑m) = (α * ↑m), from by {rw [h49],exact h18},
      have h51 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h50},
      have h52 : (α * ↑m) = (α * ↑m), from by {rw [h51],exact h18},
      have h53 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h52},
      have h54 : (α * ↑m) = (α * ↑m), from by {rw [h53],exact h18},
      have h
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    assume (i j : ℤ) (hij : i ≠ j),
    have h2 : α ≠ (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      assume h3 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j),
      have h4 : (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j) ∈ ℚ, from by {
        apply int.fract_in_rat,
        have h5 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ ℤ, from by {
          have h6 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
            rw [int.fract_sub],
            have h7 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
              rw [int.fract_sub],
              have h8 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                rw [int.fract_sub],
                have h9 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                  rw [int.fract_sub],
                  have h10 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                    rw [int.fract_sub],
                    have h11 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                      rw [int.fract_sub],
                      have h12 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                        rw [int.fract_sub],
                        have h13 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                          rw [int.fract_sub],
                          have h14 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                            rw [int.fract_sub],
                            have h15 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                              rw [int.fract_sub],
                              have h16 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                rw [int.fract_sub],
                                have h17 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                  rw [int.fract_sub],
                                  have h18 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                    rw [int.fract_sub],
                                    have h19 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                      rw [int.fract_sub],
                                      have h20 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                        rw [int.fract_sub],
                                        have h21 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                          rw [int.fract_sub],
                                          have h22 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                            rw [int.fract_sub],
                                            have h23 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                              rw [int.fract_sub],
                                              have h24 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                                rw [int.fract_sub],
                                                have h25 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                                  rw [int.fract_sub],
                                                  have h26 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                                    rw [int.fract_sub],
                                                    have h27 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                                      rw [int.fract_sub],
                                                      have h28 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from assume i j hneq,
    by {
      assume h,
      have h2 : α = (int.fract (α * ↑i) - int.fract (α * ↑j))/(i-j), from by {rw [h,int.fract_sub_fract,int.fract_mul],ring},
      have h3 : α ∈ ℚ, from by {apply quotient.exact h2},
      contradiction,
    },

  have h2 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ≠ 0, from assume i j hneq,
    by {
      assume h,
      have h2 : int.fract (α * ↑i) = int.fract (α * ↑j), from by {rw [h,sub_self]},
      contradiction,
    },

  have h3 : ∀ i j : ℤ, i ≠ j → abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from assume i j hneq,
    by {
      have h4 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
        have h5 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = int.fract (α * ↑(i-j)), from by {rw [int.fract_sub_fract,int.fract_mul], ring},
        have h6 : int.fract (α * ↑(i-j)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {apply set.mem_image_of_mem, apply set.mem_univ,},
        exact h6,
      },
      exact h4,
    },

  have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from assume i j hneq,
    by {
      have h5 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
        have h6 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) = int.fract (α * ↑(i-j)), from by {rw [int.fract_sub_fract,int.fract_mul], ring},
        have h7 : int.fract (α * ↑(i-j)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {apply set.mem_image_of_mem, apply set.mem_univ,},
        exact h7,
      },
      exact h5,
    },

  have h5 : ∀ i j : ℤ, i ≠ j → abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = (int.fract (α * ↑i)) - (int.fract (α * ↑j)), from assume i j hneq,
    by {
      have h6 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = (int.fract (α * ↑i)) - (int.fract (α * ↑j)), from by {
        have h7 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = abs ((int.fract (α * ↑j)) - (int.fract (α * ↑i))), from by {rw [abs_sub,abs_sub]},
        have h8 : abs ((int.fract (α * ↑j)) - (int.fract (α * ↑i))) = (int.fract (α * ↑j)) - (int.fract (α * ↑i)), from by {rw [abs_of_nonneg (sub_nonneg.2 (h2 i j hneq))]},
        have h9 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = (int.fract (α * ↑j)) - (int.fract (α * ↑i)), from by {rw [h7,h8]},
        have h10 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = -((int.fract (α * ↑i)) - (int.fract (α * ↑j))), from by {rw [h9,sub_eq_neg_add]},
        exact h10,
      },
      exact h6,
    },

  have h6 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ set.Icc 0 1, from assume i j hneq,
    by {
      have h7 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {
        have h8 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) = abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))), from by {rw [h5 i j hneq]},
        have h9 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ set.Icc 0 1, from by {rw [h8], apply abs_nonneg (int.fract_nonneg (α * ↑i)),},
        exact h9,
      },
      exact h7,
    },

  have h7 : ∀ i j : ℤ, i ≠ j → abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ set.Icc 0 1, from assume i j hneq,
    by {
      have h8 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ set.Icc 0 1, from by {
        have h9 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = (int.fract (α * ↑i)) - (int.fract (α * ↑j)), from by {rw [h5 i j hneq]},
        have h10 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {rw [h9], apply h6 i j hneq},
        exact h10,
      },
      exact h8,
    },

  have h8 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from assume i j hneq,
    by {
      have h9 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
        have h10 : (int.fract (α * ↑i)) - (
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

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

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

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

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


import ..mcrl2_basic.mcrl2_basic
import ..transition.par_comm
import ..add

open mcrl2

variable {α : Type}
variable [comm_semigroup_with_zero α]

/- This is where the axioms are proved for the quotient.-/

lemma mcrl2.dead_alt {x : mcrl2 α} : x + δ ≈ x :=
by exact R_add_congr (transition.alt_deadlock x)

lemma mcrl2.dead_seq {x : mcrl2 α} : δ ⬝ x ≈ δ :=
by exact R_add_congr (transition.seq_deadlock x)

lemma mcrl2.dead_parl {x : mcrl2 α} : δ |_ x ≈ δ :=
by exact R_add_congr (transition.parl_deadlock x)

lemma mcrl2.dead_comml {x : mcrl2 α} : δ ∣ x ≈ δ :=
by exact R_add_congr  (transition.comm_deadlockl x)

lemma mcrl2.dead_commr {x : mcrl2 α} : x ∣ δ ≈ δ :=
by exact R_add_congr (transition.comm_deadlockr x)

inductive R_add_par {x y : mcrl2 α} :
mcrl2 α → mcrl2 α → Prop
| basel : R_add_par x y
| baser : R_add_par y x
| par {a b} : R_add_par (a || b) (b || a)
| refl {a} : R_add_par a a

lemma R_add_par.symm {x y : mcrl2 α} :
symmetric (@R_add_par α _ x y) :=
begin
  intros x₁ y₁ h,
  cases h,
  { exact R_add_par.baser},
  { exact R_add_par.basel},
  { exact R_add_par.par},
  { assumption}
end

lemma R_add_par_refl {x y} : ∀x₁, (@R_add_par α _ x y) x₁ x₁ := by intro x₁; exact R_add_par.refl

lemma R_add_par.lift_rel  {x y} {x₁ y₁ : option (mcrl2 α)} :
option.rel (@R_add_par α _ x y) (par' x₁ y₁) (par'  y₁ x₁) :=
begin
  cases x₁,
  { cases y₁,
    { apply option.rel.none},
    { apply option.rel.some, exact R_add_par.refl}},
  { cases y₁,
    { apply option.rel.some, exact R_add_par.refl},
    { apply option.rel.some, exact R_add_par.par}}
end

lemma mcrl2.par_def {x y : mcrl2 α} : x || y ≈ x |_ y + y |_ x + x ∣ y :=
begin
  apply exists.intro R_add_par,
  apply and.intro,
  exact R_add_par.basel,
  apply and.intro,
  { intros x₁ y₁ x₁' a₁ h₁ h₂,
    cases h₁,
    { cases h₂,
      { apply exists.intro (par' h₂_x' (some y)),
        apply and.intro,
        { apply transition.altl,
          apply transition.altl,
          apply transition.parl,
          assumption},
        { cases h₂_x',
          { apply option.rel.some, exact R_add_par.refl},
          { apply option.rel.some, exact R_add_par.refl}}},
      { apply exists.intro (par' h₂_y' (some x)),
        apply and.intro,
        { apply transition.altl,
          apply transition.altr,
          apply transition.parl,
          assumption},
        { cases h₂_y',
          { apply option.rel.some, exact R_add_par.refl},
          { apply option.rel.some, exact R_add_par.par}}},
      { apply exists.intro (par' h₂_x' h₂_y'),
        apply and.intro,
        { apply transition.altr,
          apply transition.comm; assumption},
        { cases h₂_x',
          { cases h₂_y',
            { apply option.rel.none},
            { apply option.rel.some, exact R_add_par.refl}},
          { cases h₂_y',
            { apply option.rel.some, exact R_add_par.refl},
            { apply option.rel.some, exact R_add_par.refl}}}}},
    { cases h₂,
      { cases h₂_h,
        { cases h₂_h_h,
          apply exists.intro (par' h₂_h_h_x' (some y)),
          apply and.intro,
          { apply transition.par_l; assumption},
          { cases h₂_h_h_x',
            { apply option.rel.some, exact R_add_par.refl},
            { apply option.rel.some, exact R_add_par.refl}}},
        { cases h₂_h_h,
          apply exists.intro (par' (some x) h₂_h_h_x'),
          apply and.intro,
          { apply transition.par_r; assumption},
          { cases h₂_h_h_x',
            { apply option.rel.some, exact R_add_par.refl},
            { apply option.rel.some, exact R_add_par.par}}}},
      { cases h₂_h,
        apply exists.intro (par' h₂_h_x' h₂_h_y'),
        apply and.intro,
        { apply transition.par_comm; assumption},
        { cases h₂_h_x',
          { cases h₂_h_y',
            { apply option.rel.none},
            { apply option.rel.some, exact R_add_par.refl}},
          { cases h₂_h_y',
            { apply option.rel.some, exact R_add_par.refl},
            { apply option.rel.some, exact R_add_par.refl}}}}},
    { cases h₂,
      { apply exists.intro (par' (some h₁_b) h₂_x'),
        apply and.intro,
        { apply transition.par_r; assumption},
        { exact R_add_par.lift_rel}},
      { apply exists.intro (par' h₂_y' (some h₁_a)),
        apply and.intro,
        { apply transition.par_l; assumption},
        { exact R_add_par.lift_rel}},
      { apply exists.intro (par' h₂_y' h₂_x'),
        apply and.intro,
        { change comm_semigroup_with_zero.mul h₂_a h₂_b with h₂_a * h₂_b,
          rw mul_comm at *, apply transition.par_comm; assumption},
        { exact R_add_par.lift_rel}}},
    { apply exists.intro x₁',
      apply and.intro h₂,
      cases x₁',
      exact option.rel.none,
      apply option.rel.some,
      exact R_add_par.refl}},
  { exact R_add_par.symm}
end

lemma mcrl2.parl_seq_atom {a : α} {x : mcrl2 α} : (atom a) |_ x ≈ (atom a) ⬝ x :=
by exact R_add_congr (transition.parl_seq_atom a x)

lemma mcrl2.parl_seq {a : α} {x y} : (atom a) ⬝ x |_ y ≈ (atom a) ⬝ (x || y) :=
begin
  apply exists.intro R_add,
  apply and.intro R_add.basel,
  apply and.intro,
  { intros x₁ y₁ x₁' a₁ h₁ h₂,
    cases h₁,
    { cases h₂,
      cases h₂_h,
      cases h₂_h_h,
      apply exists.intro (par' ↑x ↑y),
      apply and.intro,
      { simp [transition.seq_iff],
        apply exists.intro none,
        apply and.intro rfl h₂_h_h},
      { apply option.rel.some, exact R_add.refl}},
    { cases h₂,
      cases h₂_h,
      apply exists.intro (some (x || y)),
      apply and.intro,
      { simp [transition.parl_iff],
        apply exists.intro (some x),
        apply and.intro rfl,
        simp [transition.seq_iff],
        apply exists.intro none,
        apply and.intro rfl h₂_h},
      { apply option.rel.some, exact R_add.refl}},
    { apply exists.intro x₁',
      apply and.intro h₂,
      cases x₁',
      exact option.rel.none,
      apply option.rel.some,
      exact R_add.refl}},
  { exact R_add.symm}
end

lemma mcrl2.parl_alt {x y z : mcrl2 α} : (x + y) |_ z ≈ x |_ z + y |_ z :=
by exact R_add_congr (transition.parl_alt x y z)

lemma mcrl2.comm_success {a b c : α} (h : a * b = c) : ((atom a) ∣ (atom b)) ≈ atom c :=
by exact R_add_congr (transition.comm_success a b c h)

lemma mcrl2.comm_fail {a b : α} (h : a * b = 0) : ((atom a) ∣ (atom b)) ≈ δ :=
by exact R_add_congr (transition.comm_fail a b h)

lemma mcrl2.comm_seq_distl {a b : α} {x : mcrl2 α} : (atom a ⬝ x) ∣ (atom b) ≈ ((atom a) ∣ (atom b)) ⬝ x :=
by exact R_add_congr (transition.comm_seq_distl a b x)

lemma mcrl2.comm_seq_distr {a b : α} {x : mcrl2 α} : (atom a) ∣ (atom b ⬝ x) ≈ ((atom a) ∣ (atom b)) ⬝ x :=
by exact R_add_congr (transition.comm_seq_distr a b x)

lemma mcrl2.comm_seq_dist {a b : α} {x y : mcrl2 α} : (atom a ⬝ x) ∣ (atom b ⬝ y) ≈ (atom a ∣ atom b) ⬝ (x || y) :=
by exact R_add_congr (transition.comm_seq_dist a b x y)

lemma mcrl2.comm_alt_distl {x y z : mcrl2 α} : ((x + y) ∣ z) ≈ x ∣ z + y ∣ z :=
by exact R_add_congr (transition.comm_alt_distl x y z)

lemma mcrl2.comm_alt_distr {x y z : mcrl2 α} : (x ∣ (y + z)) ≈ x ∣ y + x ∣ z :=
by exact R_add_congr (transition.comm_alt_distr x y z)


/-
Copyright (c) 2019 Scott Morrison All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.groupoid
import control.equiv_functor
import category_theory.types

/-!
# The core of a category

The core of a category `C` is the (non-full) subcategory of `C` consisting of all objects,
and all isomorphisms. We construct it as a `groupoid`.

`core.inclusion : core C ⥤ C` gives the faithful inclusion into the original category.

Any functor `F` from a groupoid `G` into `C` factors through `core C`,
but this is not functorial with respect to `F`.
-/

namespace category_theory

universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].

/-- The core of a category C is the groupoid whose morphisms are all the
isomorphisms of C. -/
@[nolint has_inhabited_instance]
def core (C : Type u₁) := C

variables {C : Type u₁} [category.{v₁} C]

instance core_category : groupoid.{v₁} (core C) :=
{ hom  := λ X Y : C, X ≅ Y,
  inv  := λ X Y f, iso.symm f,
  id   := λ X, iso.refl X,
  comp := λ X Y Z f g, iso.trans f g }

namespace core
@[simp] lemma id_hom (X : core C) : iso.hom (𝟙 X) = 𝟙 X := rfl
@[simp] lemma comp_hom {X Y Z : core C} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g).hom = f.hom ≫ g.hom :=
rfl

variables (C)

/-- The core of a category is naturally included in the category. -/
def inclusion : core C ⥤ C :=
{ obj := id,
  map := λ X Y f, f.hom }

instance : faithful (inclusion C) := {}

variables {C} {G : Type u₂} [groupoid.{v₂} G]

/-- A functor from a groupoid to a category C factors through the core of C. -/
-- Note that this function is not functorial
-- (consider the two functors from [0] to [1], and the natural transformation between them).
noncomputable
def functor_to_core (F : G ⥤ C) : G ⥤ core C :=
{ obj := λ X, F.obj X,
  map := λ X Y f, ⟨F.map f, F.map (inv f)⟩ }

/--
We can functorially associate to any functor from a groupoid to the core of a category `C`,
a functor from the groupoid to `C`, simply by composing with the embedding `core C ⥤ C`.
-/
def forget_functor_to_core : (G ⥤ core C) ⥤ (G ⥤ C) := (whiskering_right _ _ _).obj (inclusion C)
end core

/--
`of_equiv_functor m` lifts a type-level `equiv_functor`
to a categorical functor `core (Type u₁) ⥤ core (Type u₂)`.
-/
def of_equiv_functor (m : Type u₁ → Type u₂) [equiv_functor m] :
  core (Type u₁) ⥤ core (Type u₂) :=
{ obj       := m,
  map       := λ α β f, (equiv_functor.map_equiv m f.to_equiv).to_iso,
  -- These are not very pretty.
  map_id' := λ α, begin ext, exact (congr_fun (equiv_functor.map_refl _) x), end,
  map_comp' := λ α β γ f g,
  begin
    ext,
    simp only [equiv_functor.map_equiv_apply, equiv.to_iso_hom,
      function.comp_app, core.comp_hom, types_comp],
    erw [iso.to_equiv_comp, equiv_functor.map_trans],
  end, }

end category_theory


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro, Simon Hudon
-/
import data.fin.fin2
import data.typevec

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

Functors between the category of tuples of types, and the category Type

Features:

`mvfunctor n` : the type class of multivariate functors
`f <$$> x`    : notation for map

-/

universes u v w

open_locale mvfunctor

/-- multivariate functors, i.e. functor between the category of type vectors
and the category of Type -/
class mvfunctor {n : ℕ} (F : typevec n → Type*) :=
(map : Π {α β : typevec n}, (α ⟹ β) → (F α → F β))

localized "infixr (name := mvfunctor.map) ` <$$> `:100 := mvfunctor.map" in mvfunctor

variables {n : ℕ}

namespace mvfunctor

variables {α β γ : typevec.{u} n} {F : typevec.{u} n → Type v} [mvfunctor F]

/-- predicate lifting over multivariate functors -/
def liftp {α : typevec n} (p : Π i, α i → Prop) (x : F α) : Prop :=
∃ u : F (λ i, subtype (p i)), (λ i, @subtype.val _ (p i)) <$$> u = x

/-- relational lifting over multivariate functors -/
def liftr {α : typevec n} (r : Π {i}, α i → α i → Prop) (x y : F α) : Prop :=
∃ u : F (λ i, {p : α i × α i // r p.fst p.snd}),
  (λ i (t : {p : α i × α i // r p.fst p.snd}), t.val.fst) <$$> u = x ∧
  (λ i (t : {p : α i × α i // r p.fst p.snd}), t.val.snd) <$$> u = y

/-- given `x : F α` and a projection `i` of type vector `α`, `supp x i` is the set
of `α.i` contained in `x` -/
def supp {α : typevec n} (x : F α) (i : fin2 n) : set (α i) :=
{ y : α i | ∀ ⦃p⦄, liftp p x → p i y }

theorem of_mem_supp {α : typevec n} {x : F α} {p : Π ⦃i⦄, α i → Prop} (h : liftp p x) (i : fin2 n):
  ∀ y ∈ supp x i, p y :=
λ y hy, hy h

end mvfunctor

/-- laws for `mvfunctor` -/
class is_lawful_mvfunctor {n : ℕ} (F : typevec n → Type*) [mvfunctor F] : Prop :=
(id_map       : ∀ {α : typevec n} (x : F α), typevec.id <$$> x = x)
(comp_map     : ∀ {α β γ : typevec n} (g : α ⟹ β) (h : β ⟹ γ) (x : F α),
                    (h ⊚ g) <$$> x = h <$$> g <$$> x)

open nat typevec

namespace mvfunctor

export is_lawful_mvfunctor (comp_map)
open is_lawful_mvfunctor

variables {α β γ : typevec.{u} n}
variables {F : typevec.{u} n → Type v} [mvfunctor F]

variables (p : α ⟹ repeat n Prop) (r : α ⊗ α ⟹ repeat n Prop)

/-- adapt `mvfunctor.liftp` to accept predicates as arrows -/
def liftp' : F α → Prop :=
mvfunctor.liftp $ λ i x, of_repeat $ p i x

/-- adapt `mvfunctor.liftp` to accept relations as arrows -/
def liftr' : F α → F α → Prop :=
mvfunctor.liftr $ λ i x y, of_repeat $ r i $ typevec.prod.mk _ x y

variables [is_lawful_mvfunctor F]

@[simp]
lemma id_map (x : F α) :
  typevec.id <$$> x = x :=
id_map x

@[simp]
lemma id_map' (x : F α) :
  (λ i a, a) <$$> x = x :=
id_map x

lemma map_map (g : α ⟹ β) (h : β ⟹ γ) (x : F α) :
  h <$$> g <$$> x = (h ⊚ g) <$$> x :=
eq.symm $ comp_map _ _ _

section liftp'

variables (F)

lemma exists_iff_exists_of_mono {p : F α → Prop} {q : F β → Prop} (f : α ⟹ β) (g : β ⟹ α)
  (h₀ : f ⊚ g = id)
  (h₁ : ∀ u : F α, p u ↔ q (f <$$> u)) :
  (∃ u : F α, p u) ↔ (∃ u : F β, q u) :=
begin
  split; rintro ⟨u,h₂⟩; [ use f <$$> u, use g <$$> u ],
  { apply (h₁ u).mp h₂ },
  { apply (h₁ _).mpr _,
    simp only [mvfunctor.map_map,h₀,is_lawful_mvfunctor.id_map,h₂] },
end
variables {F}

lemma liftp_def (x : F α) : liftp' p x ↔ ∃ u : F (subtype_ p), subtype_val p <$$> u = x :=
exists_iff_exists_of_mono F _ _ (to_subtype_of_subtype p) (by simp [mvfunctor.map_map])

lemma liftr_def (x y : F α) :
  liftr' r x y ↔
  ∃ u : F (subtype_ r), (typevec.prod.fst ⊚ subtype_val r) <$$> u = x ∧
                        (typevec.prod.snd ⊚ subtype_val r) <$$> u = y :=
exists_iff_exists_of_mono _ _ _ (to_subtype'_of_subtype' r)
  (by simp only [map_map, comp_assoc, subtype_val_to_subtype']; simp [comp])

end liftp'

end mvfunctor

open nat

namespace mvfunctor

open typevec

section liftp_last_pred_iff
variables  {F : typevec.{u} (n+1) → Type*} [mvfunctor F] [is_lawful_mvfunctor F]
           {α : typevec.{u} n}
variables (p : α ⟹ repeat n Prop)
          (r : α ⊗ α ⟹ repeat n Prop)

open mvfunctor

variables {β : Type u}
variables (pp : β → Prop)

private def f : Π (n α), (λ (i : fin2 (n + 1)), {p_1 // of_repeat (pred_last' α pp i p_1)}) ⟹
    λ (i : fin2 (n + 1)), {p_1 : (α ::: β) i // pred_last α pp p_1}
| _ α (fin2.fs i) x := ⟨ x.val, cast (by simp only [pred_last]; erw const_iff_true) x.property ⟩
| _ α fin2.fz x := ⟨ x.val, x.property ⟩

private def g : Π (n α), (λ (i : fin2 (n + 1)), {p_1 : (α ::: β) i // pred_last α pp p_1}) ⟹
    (λ (i : fin2 (n + 1)), {p_1 // of_repeat (pred_last' α pp i p_1)})
| _ α (fin2.fs i) x := ⟨ x.val, cast (by simp only [pred_last]; erw const_iff_true) x.property ⟩
| _ α fin2.fz x := ⟨ x.val, x.property ⟩

lemma liftp_last_pred_iff {β} (p : β → Prop) (x : F (α ::: β)) :
  liftp' (pred_last' _ p) x ↔ liftp (pred_last _ p) x :=
begin
  dsimp only [liftp,liftp'],
  apply exists_iff_exists_of_mono F (f _ n α) (g _ n α),
  { ext i ⟨x,_⟩, cases i; refl },
  { intros, rw [mvfunctor.map_map,(⊚)],
    congr'; ext i ⟨x,_⟩; cases i; refl }
end

open function
variables (rr : β → β → Prop)

private def f :
  Π (n α),
    (λ (i : fin2 (n + 1)),
      {p_1 : _ × _ // of_repeat (rel_last' α rr i (typevec.prod.mk _ p_1.fst p_1.snd))}) ⟹
    λ (i : fin2 (n + 1)), {p_1 : (α ::: β) i × _ // rel_last α rr (p_1.fst) (p_1.snd)}
| _ α (fin2.fs i) x := ⟨ x.val, cast (by simp only [rel_last]; erw repeat_eq_iff_eq) x.property ⟩
| _ α fin2.fz x := ⟨ x.val, x.property ⟩

private def g :
  Π (n α), (λ (i : fin2 (n + 1)), {p_1 : (α ::: β) i × _ // rel_last α rr (p_1.fst) (p_1.snd)}) ⟹
    (λ (i : fin2 (n + 1)),
      {p_1 : _ × _ // of_repeat (rel_last' α rr i (typevec.prod.mk _ p_1.1 p_1.2))})
| _ α (fin2.fs i) x := ⟨ x.val, cast (by simp only [rel_last]; erw repeat_eq_iff_eq) x.property ⟩
| _ α fin2.fz x := ⟨ x.val, x.property ⟩

lemma liftr_last_rel_iff  (x y : F (α ::: β)) :
  liftr' (rel_last' _ rr) x y ↔ liftr (rel_last _ rr) x y :=
begin
  dsimp only [liftr,liftr'],
  apply exists_iff_exists_of_mono F (f rr _ _) (g rr _ _),
  { ext i ⟨x,_⟩ : 2, cases i; refl, },
  { intros, rw [mvfunctor.map_map,mvfunctor.map_map,(⊚),(⊚)],
    congr'; ext i ⟨x,_⟩; cases i; refl }
end

end liftp_last_pred_iff

end mvfunctor


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Joseph Myers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.affine_space.basic
import Mathlib.linear_algebra.tensor_product
import Mathlib.data.set.intervals.unordered_interval
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 l u_6 u_7 u_8 u_9 u_10 u_11 u_12

namespace Mathlib

/-!
# Affine maps

This file defines affine maps.

## Main definitions

* `affine_map` is the type of affine maps between two affine spaces with the same ring `k`.  Various
  basic examples of affine maps are defined, including `const`, `id`, `line_map` and `homothety`.

## Notations

* `P1 →ᵃ[k] P2` is a notation for `affine_map k P1 P2`;
* `affine_space V P`: a localized notation for `add_torsor V P` defined in
  `linear_algebra.affine_space.basic`.

## Implementation notes

`out_param` is used in the definition of `[add_torsor V P]` to make `V` an implicit argument
(deduced from `P`) in most cases; `include V` is needed in many cases for `V`, and type classes
using it, to be added as implicit arguments to individual lemmas.  As for modules, `k` is an
explicit argument rather than implied by `P` or `V`.

This file only provides purely algebraic definitions and results. Those depending on analysis or
topology are defined elsewhere; see `analysis.normed_space.add_torsor` and
`topology.algebra.affine`.

## References

* https://en.wikipedia.org/wiki/Affine_space
* https://en.wikipedia.org/wiki/Principal_homogeneous_space
-/

/-- An `affine_map k P1 P2` (notation: `P1 →ᵃ[k] P2`) is a map from `P1` to `P2` that
induces a corresponding linear map from `V1` to `V2`. -/
structure affine_map (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4} (P2 : Type u_5) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2]
where
  to_fun : P1 → P2
  linear : linear_map k V1 V2
  map_vadd' : ∀ (p : P1) (v : V1), to_fun (v +ᵥ p) = coe_fn linear v +ᵥ to_fun p

protected instance affine_map.has_coe_to_fun (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4} (P2 : Type u_5) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : has_coe_to_fun (affine_map k P1 P2) :=
  has_coe_to_fun.mk (fun (x : affine_map k P1 P2) => P1 → P2) affine_map.to_fun

namespace linear_map

/-- Reinterpret a linear map as an affine map. -/
def to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k] [add_comm_group V₁] [module k V₁] [add_comm_group V₂] [module k V₂] (f : linear_map k V₁ V₂) : affine_map k V₁ V₂ :=
  affine_map.mk (⇑f) f sorry

@[simp] theorem coe_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k] [add_comm_group V₁] [module k V₁] [add_comm_group V₂] [module k V₂] (f : linear_map k V₁ V₂) : ⇑(to_affine_map f) = ⇑f :=
  rfl

@[simp] theorem to_affine_map_linear {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k] [add_comm_group V₁] [module k V₁] [add_comm_group V₂] [module k V₂] (f : linear_map k V₁ V₂) : affine_map.linear (to_affine_map f) = f :=
  rfl

end linear_map

namespace affine_map

/-- Constructing an affine map and coercing back to a function
produces the same map. -/
@[simp] theorem coe_mk {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : P1 → P2) (linear : linear_map k V1 V2) (add : ∀ (p : P1) (v : V1), f (v +ᵥ p) = coe_fn linear v +ᵥ f p) : ⇑(mk f linear add) = f :=
  rfl

/-- `to_fun` is the same as the result of coercing to a function. -/
@[simp] theorem to_fun_eq_coe {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) : to_fun f = ⇑f :=
  rfl

/-- An affine map on the result of adding a vector to a point produces
the same result as the linear map applied to that vector, added to the
affine map applied to that point. -/
@[simp] theorem map_vadd {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (p : P1) (v : V1) : coe_fn f (v +ᵥ p) = coe_fn (linear f) v +ᵥ coe_fn f p :=
  map_vadd' f p v

/-- The linear map on the result of subtracting two points is the
result of subtracting the result of the affine map on those two
points. -/
@[simp] theorem linear_map_vsub {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (p1 : P1) (p2 : P1) : coe_fn (linear f) (p1 -ᵥ p2) = coe_fn f p1 -ᵥ coe_fn f p2 := sorry

/-- Two affine maps are equal if they coerce to the same function. -/
theorem ext {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] {f : affine_map k P1 P2} {g : affine_map k P1 P2} (h : ∀ (p : P1), coe_fn f p = coe_fn g p) : f = g := sorry

theorem ext_iff {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] {f : affine_map k P1 P2} {g : affine_map k P1 P2} : f = g ↔ ∀ (p : P1), coe_fn f p = coe_fn g p :=
  { mp := fun (h : f = g) (p : P1) => h ▸ rfl, mpr := ext }

theorem injective_coe_fn {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : function.injective fun (f : affine_map k P1 P2) (x : P1) => coe_fn f x := sorry

protected theorem congr_arg {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) {x : P1} {y : P1} (h : x = y) : coe_fn f x = coe_fn f y :=
  congr_arg (⇑f) h

protected theorem congr_fun {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] {f : affine_map k P1 P2} {g : affine_map k P1 P2} (h : f = g) (x : P1) : coe_fn f x = coe_fn g x :=
  h ▸ rfl

/-- Constant function as an `affine_map`. -/
def const (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p : P2) : affine_map k P1 P2 :=
  mk (function.const P1 p) 0 sorry

@[simp] theorem coe_const (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p : P2) : ⇑(const k P1 p) = function.const P1 p :=
  rfl

@[simp] theorem const_linear (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p : P2) : linear (const k P1 p) = 0 :=
  rfl

protected instance nonempty {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : Nonempty (affine_map k P1 P2) :=
  nonempty.elim add_torsor.nonempty fun (p : P2) => Nonempty.intro (const k P1 p)

/-- Construct an affine map by verifying the relation between the map and its linear part at one
base point. Namely, this function takes a map `f : P₁ → P₂`, a linear map `f' : V₁ →ₗ[k] V₂`, and
a point `p` such that for any other point `p'` we have `f p' = f' (p' -ᵥ p) +ᵥ f p`. -/
def mk' {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : P1 → P2) (f' : linear_map k V1 V2) (p : P1) (h : ∀ (p' : P1), f p' = coe_fn f' (p' -ᵥ p) +ᵥ f p) : affine_map k P1 P2 :=
  mk f f' sorry

@[simp] theorem coe_mk' {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : P1 → P2) (f' : linear_map k V1 V2) (p : P1) (h : ∀ (p' : P1), f p' = coe_fn f' (p' -ᵥ p) +ᵥ f p) : ⇑(mk' f f' p h) = f :=
  rfl

@[simp] theorem mk'_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : P1 → P2) (f' : linear_map k V1 V2) (p : P1) (h : ∀ (p' : P1), f p' = coe_fn f' (p' -ᵥ p) +ᵥ f p) : linear (mk' f f' p h) = f' :=
  rfl

/-- The set of affine maps to a vector space is an additive commutative group. -/
protected instance add_comm_group {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] : add_comm_group (affine_map k P1 V2) :=
  add_comm_group.mk (fun (f g : affine_map k P1 V2) => mk (⇑f + ⇑g) (linear f + linear g) sorry) sorry (mk 0 0 sorry)
    sorry sorry (fun (f : affine_map k P1 V2) => mk (-⇑f) (-linear f) sorry)
    (add_group.sub._default (fun (f g : affine_map k P1 V2) => mk (⇑f + ⇑g) (linear f + linear g) sorry) sorry
      (mk 0 0 sorry) sorry sorry fun (f : affine_map k P1 V2) => mk (-⇑f) (-linear f) sorry)
    sorry sorry

@[simp] theorem coe_zero {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] : ⇑0 = 0 :=
  rfl

@[simp] theorem zero_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] : linear 0 = 0 :=
  rfl

@[simp] theorem coe_add {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] (f : affine_map k P1 V2) (g : affine_map k P1 V2) : ⇑(f + g) = ⇑f + ⇑g :=
  rfl

@[simp] theorem add_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] (f : affine_map k P1 V2) (g : affine_map k P1 V2) : linear (f + g) = linear f + linear g :=
  rfl

/-- The space of affine maps from `P1` to `P2` is an affine space over the space of affine maps
from `P1` to the vector space `V2` corresponding to `P2`. -/
protected instance add_torsor {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : add_torsor (affine_map k P1 V2) (affine_map k P1 P2) :=
  add_torsor.mk
    (fun (f : affine_map k P1 V2) (g : affine_map k P1 P2) =>
      mk (fun (p : P1) => coe_fn f p +ᵥ coe_fn g p) (linear f + linear g) sorry)
    sorry sorry
    (fun (f g : affine_map k P1 P2) => mk (fun (p : P1) => coe_fn f p -ᵥ coe_fn g p) (linear f - linear g) sorry) sorry
    sorry

@[simp] theorem vadd_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 V2) (g : affine_map k P1 P2) (p : P1) : coe_fn (f +ᵥ g) p = coe_fn f p +ᵥ coe_fn g p :=
  rfl

@[simp] theorem vsub_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (g : affine_map k P1 P2) (p : P1) : coe_fn (f -ᵥ g) p = coe_fn f p -ᵥ coe_fn g p :=
  rfl

/-- `prod.fst` as an `affine_map`. -/
def fst {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : affine_map k (P1 × P2) P1 :=
  mk prod.fst (linear_map.fst k V1 V2) sorry

@[simp] theorem coe_fst {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : ⇑fst = prod.fst :=
  rfl

@[simp] theorem fst_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : linear fst = linear_map.fst k V1 V2 :=
  rfl

/-- `prod.snd` as an `affine_map`. -/
def snd {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : affine_map k (P1 × P2) P2 :=
  mk prod.snd (linear_map.snd k V1 V2) sorry

@[simp] theorem coe_snd {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : ⇑snd = prod.snd :=
  rfl

@[simp] theorem snd_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : linear snd = linear_map.snd k V1 V2 :=
  rfl

/-- Identity map as an affine map. -/
def id (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] : affine_map k P1 P1 :=
  mk id linear_map.id sorry

/-- The identity affine map acts as the identity. -/
@[simp] theorem coe_id (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] : ⇑(id k P1) = id :=
  rfl

@[simp] theorem id_linear (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] : linear (id k P1) = linear_map.id :=
  rfl

/-- The identity affine map acts as the identity. -/
theorem id_apply (k : Type u_1) {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p : P1) : coe_fn (id k P1) p = p :=
  rfl

protected instance inhabited {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] : Inhabited (affine_map k P1 P1) :=
  { default := id k P1 }

/-- Composition of affine maps. -/
def comp {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} {V3 : Type u_6} {P3 : Type u_7} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] [add_comm_group V3] [module k V3] [add_torsor V3 P3] (f : affine_map k P2 P3) (g : affine_map k P1 P2) : affine_map k P1 P3 :=
  mk (⇑f ∘ ⇑g) (linear_map.comp (linear f) (linear g)) sorry

/-- Composition of affine maps acts as applying the two functions. -/
@[simp] theorem coe_comp {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} {V3 : Type u_6} {P3 : Type u_7} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] [add_comm_group V3] [module k V3] [add_torsor V3 P3] (f : affine_map k P2 P3) (g : affine_map k P1 P2) : ⇑(comp f g) = ⇑f ∘ ⇑g :=
  rfl

/-- Composition of affine maps acts as applying the two functions. -/
theorem comp_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} {V3 : Type u_6} {P3 : Type u_7} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] [add_comm_group V3] [module k V3] [add_torsor V3 P3] (f : affine_map k P2 P3) (g : affine_map k P1 P2) (p : P1) : coe_fn (comp f g) p = coe_fn f (coe_fn g p) :=
  rfl

@[simp] theorem comp_id {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) : comp f (id k P1) = f :=
  ext fun (p : P1) => rfl

@[simp] theorem id_comp {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) : comp (id k P2) f = f :=
  ext fun (p : P1) => rfl

theorem comp_assoc {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} {V3 : Type u_6} {P3 : Type u_7} {V4 : Type u_8} {P4 : Type u_9} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] [add_comm_group V3] [module k V3] [add_torsor V3 P3] [add_comm_group V4] [module k V4] [add_torsor V4 P4] (f₃₄ : affine_map k P3 P4) (f₂₃ : affine_map k P2 P3) (f₁₂ : affine_map k P1 P2) : comp (comp f₃₄ f₂₃) f₁₂ = comp f₃₄ (comp f₂₃ f₁₂) :=
  rfl

protected instance monoid {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] : monoid (affine_map k P1 P1) :=
  monoid.mk comp comp_assoc (id k P1) id_comp comp_id

@[simp] theorem coe_mul {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (f : affine_map k P1 P1) (g : affine_map k P1 P1) : ⇑(f * g) = ⇑f ∘ ⇑g :=
  rfl

@[simp] theorem coe_one {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] : ⇑1 = id :=
  rfl

/-! ### Definition of `affine_map.line_map` and lemmas about it -/

/-- The affine map from `k` to `P1` sending `0` to `p₀` and `1` to `p₁`. -/
def line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) : affine_map k k P1 :=
  linear_map.to_affine_map (linear_map.smul_right linear_map.id (p₁ -ᵥ p₀)) +ᵥ const k k p₀

theorem coe_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) : ⇑(line_map p₀ p₁) = fun (c : k) => c • (p₁ -ᵥ p₀) +ᵥ p₀ :=
  rfl

theorem line_map_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) : coe_fn (line_map p₀ p₁) c = c • (p₁ -ᵥ p₀) +ᵥ p₀ :=
  rfl

theorem line_map_apply_module' {k : Type u_1} {V1 : Type u_2} [ring k] [add_comm_group V1] [module k V1] (p₀ : V1) (p₁ : V1) (c : k) : coe_fn (line_map p₀ p₁) c = c • (p₁ - p₀) + p₀ :=
  rfl

theorem line_map_apply_module {k : Type u_1} {V1 : Type u_2} [ring k] [add_comm_group V1] [module k V1] (p₀ : V1) (p₁ : V1) (c : k) : coe_fn (line_map p₀ p₁) c = (1 - c) • p₀ + c • p₁ := sorry

theorem line_map_apply_ring' {k : Type u_1} [ring k] (a : k) (b : k) (c : k) : coe_fn (line_map a b) c = c * (b - a) + a :=
  rfl

theorem line_map_apply_ring {k : Type u_1} [ring k] (a : k) (b : k) (c : k) : coe_fn (line_map a b) c = (1 - c) * a + c * b :=
  line_map_apply_module a b c

theorem line_map_vadd_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p : P1) (v : V1) (c : k) : coe_fn (line_map p (v +ᵥ p)) c = c • v +ᵥ p :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn (line_map p (v +ᵥ p)) c = c • v +ᵥ p)) (line_map_apply p (v +ᵥ p) c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (c • (v +ᵥ p -ᵥ p) +ᵥ p = c • v +ᵥ p)) (vadd_vsub v p))) (Eq.refl (c • v +ᵥ p)))

@[simp] theorem line_map_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) : linear (line_map p₀ p₁) = linear_map.smul_right linear_map.id (p₁ -ᵥ p₀) :=
  add_zero (linear (linear_map.to_affine_map (linear_map.smul_right linear_map.id (p₁ -ᵥ p₀))))

theorem line_map_same_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p : P1) (c : k) : coe_fn (line_map p p) c = p := sorry

@[simp] theorem line_map_same {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p : P1) : line_map p p = const k k p :=
  ext (line_map_same_apply p)

@[simp] theorem line_map_apply_zero {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) : coe_fn (line_map p₀ p₁) 0 = p₀ := sorry

@[simp] theorem line_map_apply_one {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) : coe_fn (line_map p₀ p₁) 1 = p₁ := sorry

@[simp] theorem apply_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (p₀ : P1) (p₁ : P1) (c : k) : coe_fn f (coe_fn (line_map p₀ p₁) c) = coe_fn (line_map (coe_fn f p₀) (coe_fn f p₁)) c := sorry

@[simp] theorem comp_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (p₀ : P1) (p₁ : P1) : comp f (line_map p₀ p₁) = line_map (coe_fn f p₀) (coe_fn f p₁) :=
  ext (apply_line_map f p₀ p₁)

@[simp] theorem fst_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p₀ : P1 × P2) (p₁ : P1 × P2) (c : k) : prod.fst (coe_fn (line_map p₀ p₁) c) = coe_fn (line_map (prod.fst p₀) (prod.fst p₁)) c :=
  apply_line_map fst p₀ p₁ c

@[simp] theorem snd_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p₀ : P1 × P2) (p₁ : P1 × P2) (c : k) : prod.snd (coe_fn (line_map p₀ p₁) c) = coe_fn (line_map (prod.snd p₀) (prod.snd p₁)) c :=
  apply_line_map snd p₀ p₁ c

theorem line_map_symm {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) : line_map p₀ p₁ = comp (line_map p₁ p₀) (line_map 1 0) := sorry

theorem line_map_apply_one_sub {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) : coe_fn (line_map p₀ p₁) (1 - c) = coe_fn (line_map p₁ p₀) c := sorry

@[simp] theorem line_map_vsub_left {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) : coe_fn (line_map p₀ p₁) c -ᵥ p₀ = c • (p₁ -ᵥ p₀) :=
  vadd_vsub (coe_fn (linear_map.to_affine_map (linear_map.smul_right linear_map.id (p₁ -ᵥ p₀))) c)
    (coe_fn (const k k p₀) c)

@[simp] theorem left_vsub_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) : p₀ -ᵥ coe_fn (line_map p₀ p₁) c = c • (p₀ -ᵥ p₁) := sorry

@[simp] theorem line_map_vsub_right {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) : coe_fn (line_map p₀ p₁) c -ᵥ p₁ = (1 - c) • (p₀ -ᵥ p₁) := sorry

@[simp] theorem right_vsub_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) : p₁ -ᵥ coe_fn (line_map p₀ p₁) c = (1 - c) • (p₁ -ᵥ p₀) := sorry

theorem line_map_vadd_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (v₁ : V1) (v₂ : V1) (p₁ : P1) (p₂ : P1) (c : k) : coe_fn (line_map v₁ v₂) c +ᵥ coe_fn (line_map p₁ p₂) c = coe_fn (line_map (v₁ +ᵥ p₁) (v₂ +ᵥ p₂)) c :=
  apply_line_map (fst +ᵥ snd) (v₁, p₁) (v₂, p₂) c

theorem line_map_vsub_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₁ : P1) (p₂ : P1) (p₃ : P1) (p₄ : P1) (c : k) : coe_fn (line_map p₁ p₂) c -ᵥ coe_fn (line_map p₃ p₄) c = coe_fn (line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₄)) c :=
  apply_line_map (fst -ᵥ snd) (p₁, p₃) (p₂, p₄) c

-- Why Lean fails to find this instance without a hint?

/-- Decomposition of an affine map in the special case when the point space and vector space
are the same. -/
theorem decomp {k : Type u_1} {V1 : Type u_2} {V2 : Type u_4} [ring k] [add_comm_group V1] [module k V1] [add_comm_group V2] [module k V2] (f : affine_map k V1 V2) : ⇑f = ⇑(linear f) + fun (z : V1) => coe_fn f 0 := sorry

/-- Decomposition of an affine map in the special case when the point space and vector space
are the same. -/
theorem decomp' {k : Type u_1} {V1 : Type u_2} {V2 : Type u_4} [ring k] [add_comm_group V1] [module k V1] [add_comm_group V2] [module k V2] (f : affine_map k V1 V2) : ⇑(linear f) = ⇑f - fun (z : V1) => coe_fn f 0 := sorry

theorem image_interval {k : Type u_1} [linear_ordered_field k] (f : affine_map k k k) (a : k) (b : k) : ⇑f '' set.interval a b = set.interval (coe_fn f a) (coe_fn f b) := sorry

/-- Evaluation at a point as an affine map. -/
def proj {k : Type u_1} [ring k] {ι : Type u_10} {V : ι → Type u_11} {P : ι → Type u_12} [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)] [(i : ι) → add_torsor (V i) (P i)] (i : ι) : affine_map k ((i : ι) → P i) (P i) :=
  mk (fun (f : (i : ι) → P i) => f i) (linear_map.proj i) sorry

@[simp] theorem proj_apply {k : Type u_1} [ring k] {ι : Type u_10} {V : ι → Type u_11} {P : ι → Type u_12} [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)] [(i : ι) → add_torsor (V i) (P i)] (i : ι) (f : (i : ι) → P i) : coe_fn (proj i) f = f i :=
  rfl

@[simp] theorem proj_linear {k : Type u_1} [ring k] {ι : Type u_10} {V : ι → Type u_11} {P : ι → Type u_12} [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)] [(i : ι) → add_torsor (V i) (P i)] (i : ι) : linear (proj i) = linear_map.proj i :=
  rfl

theorem pi_line_map_apply {k : Type u_1} [ring k] {ι : Type u_10} {V : ι → Type u_11} {P : ι → Type u_12} [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)] [(i : ι) → add_torsor (V i) (P i)] (f : (i : ι) → P i) (g : (i : ι) → P i) (c : k) (i : ι) : coe_fn (line_map f g) c i = coe_fn (line_map (f i) (g i)) c :=
  apply_line_map (proj i) f g c

end affine_map

namespace affine_map

/-- If `k` is a commutative ring, then the set of affine maps with codomain in a `k`-module
is a `k`-module. -/
protected instance module {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] : module k (affine_map k P1 V2) :=
  semimodule.mk sorry sorry

@[simp] theorem coe_smul {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] (c : k) (f : affine_map k P1 V2) : ⇑(c • f) = c • ⇑f :=
  rfl

/-- `homothety c r` is the homothety about `c` with scale factor `r`. -/
def homothety {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r : k) : affine_map k P1 P1 :=
  r • (id k P1 -ᵥ const k P1 c) +ᵥ const k P1 c

theorem homothety_def {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r : k) : homothety c r = r • (id k P1 -ᵥ const k P1 c) +ᵥ const k P1 c :=
  rfl

theorem homothety_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r : k) (p : P1) : coe_fn (homothety c r) p = r • (p -ᵥ c) +ᵥ c :=
  rfl

theorem homothety_eq_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r : k) (p : P1) : coe_fn (homothety c r) p = coe_fn (line_map c p) r :=
  rfl

@[simp] theorem homothety_one {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) : homothety c 1 = id k P1 := sorry

theorem homothety_mul {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r₁ : k) (r₂ : k) : homothety c (r₁ * r₂) = comp (homothety c r₁) (homothety c r₂) := sorry

@[simp] theorem homothety_zero {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) : homothety c 0 = const k P1 c := sorry

@[simp] theorem homothety_add {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r₁ : k) (r₂ : k) : homothety c (r₁ + r₂) = r₁ • (id k P1 -ᵥ const k P1 c) +ᵥ homothety c r₂ := sorry

/-- `homothety` as a multiplicative monoid homomorphism. -/
def homothety_hom {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) : k →* affine_map k P1 P1 :=
  monoid_hom.mk (homothety c) (homothety_one c) (homothety_mul c)

@[simp] theorem coe_homothety_hom {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) : ⇑(homothety_hom c) = homothety c :=
  rfl

/-- `homothety` as an affine map. -/
def homothety_affine {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) : affine_map k k (affine_map k P1 P1) :=
  mk (homothety c) (coe_fn (linear_map.flip (linear_map.lsmul k (affine_map k P1 V1))) (id k P1 -ᵥ const k P1 c)) sorry

@[simp] theorem coe_homothety_affine {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) : ⇑(homothety_affine c) = homothety c :=
  rfl