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


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura

Theorems that require decidability hypotheses are in the namespace "decidable".
Classical versions are in the namespace "classical".

Note: in the presence of automation, this whole file may be unnecessary. On the other hand,
maybe it is useful for writing automation.
-/
import data.prod tactic.cache

/-
    miscellany

    TODO: move elsewhere
-/

section miscellany

variables {α : Type*} {β : Type*}

@[reducible] def hidden {a : α} := a

def empty.elim {C : Sort*} : empty → C.

instance : subsingleton empty := ⟨λa, a.elim⟩

instance : decidable_eq empty := λa, a.elim

@[priority 0] instance decidable_eq_of_subsingleton
  {α} [subsingleton α] : decidable_eq α
| a b := is_true (subsingleton.elim a b)

/- Add an instance to "undo" coercion transitivity into a chain of coercions, because
   most simp lemmas are stated with respect to simple coercions and will not match when
   part of a chain. -/
@[simp] theorem coe_coe {α β γ} [has_coe α β] [has_coe_t β γ]
  (a : α) : (a : γ) = (a : β) := rfl

@[simp] theorem coe_fn_coe_trans
  {α β γ} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_fun γ]
  (x : α) : @coe_fn α _ x = @coe_fn β _ x := rfl

@[simp] theorem coe_fn_coe_base
  {α β} [has_coe α β] [has_coe_to_fun β]
  (x : α) : @coe_fn α _ x = @coe_fn β _ x := rfl

@[simp] theorem coe_sort_coe_trans
  {α β γ} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_sort γ]
  (x : α) : @coe_sort α _ x = @coe_sort β _ x := rfl

@[simp] theorem coe_sort_coe_base
  {α β} [has_coe α β] [has_coe_to_sort β]
  (x : α) : @coe_sort α _ x = @coe_sort β _ x := rfl

/-- `pempty` is the universe-polymorphic analogue of `empty`. -/
@[derive decidable_eq]
inductive {u} pempty : Sort u

def pempty.elim {C : Sort*} : pempty → C.

instance subsingleton_pempty : subsingleton pempty := ⟨λa, a.elim⟩

lemma congr_arg_heq {α} {β : α → Sort*} (f : ∀ a, β a) : ∀ {a₁ a₂ : α}, a₁ = a₂ → f a₁ == f a₂
| a _ rfl := heq.rfl

lemma plift.down_inj {α : Sort*} : ∀ (a b : plift α), a.down = b.down → a = b
| ⟨a⟩ ⟨b⟩ rfl := rfl

end miscellany

/-
    propositional connectives
-/

@[simp] theorem false_ne_true : false ≠ true
| h := h.symm ▸ trivial

section propositional
variables {a b c d : Prop}

/- implies -/

theorem iff_of_eq (e : a = b) : a ↔ b := e ▸ iff.rfl

theorem iff_iff_eq : (a ↔ b) ↔ a = b := ⟨propext, iff_of_eq⟩

@[simp] theorem imp_self : (a → a) ↔ true := iff_true_intro id

theorem imp_intro {α β} (h : α) (h₂ : β) : α := h

theorem imp_false : (a → false) ↔ ¬ a := iff.rfl

theorem imp_and_distrib {α} : (α → b ∧ c) ↔ (α → b) ∧ (α → c) :=
⟨λ h, ⟨λ ha, (h ha).left, λ ha, (h ha).right⟩,
 λ h ha, ⟨h.left ha, h.right ha⟩⟩

@[simp] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) :=
iff.intro (λ h ha hb, h ⟨ha, hb⟩) (λ h ⟨ha, hb⟩, h ha hb)

theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) :=
iff_iff_implies_and_implies _ _

theorem iff_def' : (a ↔ b) ↔ (b → a) ∧ (a → b) :=
iff_def.trans and.comm

@[simp] theorem imp_true_iff {α : Sort*} : (α → true) ↔ true :=
iff_true_intro $ λ_, trivial

@[simp] theorem imp_iff_right (ha : a) : (a → b) ↔ b :=
⟨λf, f ha, imp_intro⟩

/- not -/

theorem not.elim {α : Sort*} (H1 : ¬a) (H2 : a) : α := absurd H2 H1

@[reducible] theorem not.imp {a b : Prop} (H2 : ¬b) (H1 : a → b) : ¬a := mt H1 H2

theorem not_not_of_not_imp : ¬(a → b) → ¬¬a :=
mt not.elim

theorem not_of_not_imp {α} : ¬(α → b) → ¬b :=
mt imp_intro

theorem dec_em (p : Prop) [decidable p] : p ∨ ¬p := decidable.em p

theorem by_contradiction {p} [decidable p] : (¬p → false) → p :=
decidable.by_contradiction

@[simp] theorem not_not [decidable a] : ¬¬a ↔ a :=
iff.intro by_contradiction not_not_intro

theorem of_not_not [decidable a] : ¬¬a → a :=
by_contradiction

theorem of_not_imp [decidable a] (h : ¬ (a → b)) : a :=
by_contradiction (not_not_of_not_imp h)

theorem not.imp_symm [decidable a] (h : ¬a → b) (hb : ¬b) : a :=
by_contradiction $ hb ∘ h

theorem not_imp_comm [decidable a] [decidable b] : (¬a → b) ↔ (¬b → a) :=
⟨not.imp_symm, not.imp_symm⟩

theorem imp.swap : (a → b → c) ↔ (b → a → c) :=
⟨function.swap, function.swap⟩

theorem imp_not_comm : (a → ¬b) ↔ (b → ¬a) :=
imp.swap

/- and -/

theorem not_and_of_not_left (b : Prop) : ¬a → ¬(a ∧ b) :=
mt and.left

theorem not_and_of_not_right (a : Prop) {b : Prop} : ¬b → ¬(a ∧ b) :=
mt and.right

theorem and.imp_left (h : a → b) : a ∧ c → b ∧ c :=
and.imp h id

theorem and.imp_right (h : a → b) : c ∧ a → c ∧ b :=
and.imp id h

lemma and.right_comm : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b :=
by simp [and.left_comm, and.comm]

lemma and.rotate : a ∧ b ∧ c ↔ b ∧ c ∧ a :=
by simp [and.left_comm, and.comm]

theorem and_not_self_iff (a : Prop) : a ∧ ¬ a ↔ false :=
iff.intro (assume h, (h.right) (h.left)) (assume h, h.elim)

theorem not_and_self_iff (a : Prop) : ¬ a ∧ a ↔ false :=
iff.intro (assume ⟨hna, ha⟩, hna ha) false.elim

theorem and_iff_left_of_imp {a b : Prop} (h : a → b) : (a ∧ b) ↔ a :=
iff.intro and.left (λ ha, ⟨ha, h ha⟩)

theorem and_iff_right_of_imp {a b : Prop} (h : b → a) : (a ∧ b) ↔ b :=
iff.intro and.right (λ hb, ⟨h hb, hb⟩)

lemma and.congr_right_iff : (a ∧ b ↔ a ∧ c) ↔ (a → (b ↔ c)) :=
⟨λ h ha, by simp [ha] at h; exact h, and_congr_right⟩

/- or -/

theorem or_of_or_of_imp_of_imp (h₁ : a ∨ b) (h₂ : a → c) (h₃ : b → d) : c ∨ d :=
or.imp h₂ h₃ h₁

theorem or_of_or_of_imp_left (h₁ : a ∨ c) (h : a → b) : b ∨ c :=
or.imp_left h h₁

theorem or_of_or_of_imp_right (h₁ : c ∨ a) (h : a → b) : c ∨ b :=
or.imp_right h h₁

theorem or.elim3 (h : a ∨ b ∨ c) (ha : a → d) (hb : b → d) (hc : c → d) : d :=
or.elim h ha (assume h₂, or.elim h₂ hb hc)

theorem or_imp_distrib : (a ∨ b → c) ↔ (a → c) ∧ (b → c) :=
⟨assume h, ⟨assume ha, h (or.inl ha), assume hb, h (or.inr hb)⟩,
  assume ⟨ha, hb⟩, or.rec ha hb⟩

theorem or_iff_not_imp_left [decidable a] : a ∨ b ↔ (¬ a → b) :=
⟨or.resolve_left, λ h, dite _ or.inl (or.inr ∘ h)⟩

theorem or_iff_not_imp_right [decidable b] : a ∨ b ↔ (¬ b → a) :=
or.comm.trans or_iff_not_imp_left

theorem not_imp_not [decidable a] : (¬ a → ¬ b) ↔ (b → a) :=
⟨assume h hb, by_contradiction $ assume na, h na hb, mt⟩

/- distributivity -/

theorem and_or_distrib_left : a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) :=
⟨λ ⟨ha, hbc⟩, hbc.imp (and.intro ha) (and.intro ha),
 or.rec (and.imp_right or.inl) (and.imp_right or.inr)⟩

theorem or_and_distrib_right : (a ∨ b) ∧ c ↔ (a ∧ c) ∨ (b ∧ c) :=
(and.comm.trans and_or_distrib_left).trans (or_congr and.comm and.comm)

theorem or_and_distrib_left : a ∨ (b ∧ c) ↔ (a ∨ b) ∧ (a ∨ c) :=
⟨or.rec (λha, and.intro (or.inl ha) (or.inl ha)) (and.imp or.inr or.inr),
 and.rec $ or.rec (imp_intro ∘ or.inl) (or.imp_right ∘ and.intro)⟩

theorem and_or_distrib_right : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) :=
(or.comm.trans or_and_distrib_left).trans (and_congr or.comm or.comm)

/- iff -/

theorem iff_of_true (ha : a) (hb : b) : a ↔ b :=
⟨λ_, hb, λ _, ha⟩

theorem iff_of_false (ha : ¬a) (hb : ¬b) : a ↔ b :=
⟨ha.elim, hb.elim⟩

theorem iff_true_left (ha : a) : (a ↔ b) ↔ b :=
⟨λ h, h.1 ha, iff_of_true ha⟩

theorem iff_true_right (ha : a) : (b ↔ a) ↔ b :=
iff.comm.trans (iff_true_left ha)

theorem iff_false_left (ha : ¬a) : (a ↔ b) ↔ ¬b :=
⟨λ h, mt h.2 ha, iff_of_false ha⟩

theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b :=
iff.comm.trans (iff_false_left ha)

theorem not_or_of_imp [decidable a] (h : a → b) : ¬ a ∨ b :=
if ha : a then or.inr (h ha) else or.inl ha

theorem imp_iff_not_or [decidable a] : (a → b) ↔ (¬ a ∨ b) :=
⟨not_or_of_imp, or.neg_resolve_left⟩

theorem imp_or_distrib [decidable a] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
by simp [imp_iff_not_or, or.comm, or.left_comm]

theorem imp_or_distrib' [decidable b] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
by by_cases b; simp [h, or_iff_right_of_imp ((∘) false.elim)]

theorem not_imp_of_and_not : a ∧ ¬ b → ¬ (a → b)
| ⟨ha, hb⟩ h := hb $ h ha

@[simp] theorem not_imp [decidable a] : ¬(a → b) ↔ a ∧ ¬b :=
⟨λ h, ⟨of_not_imp h, not_of_not_imp h⟩, not_imp_of_and_not⟩

-- for monotonicity
lemma imp_imp_imp
  (h₀ : c → a) (h₁ : b → d) :
  (a → b) → (c → d) :=
assume (h₂ : a → b),
h₁ ∘ h₂ ∘ h₀

theorem peirce (a b : Prop) [decidable a] : ((a → b) → a) → a :=
if ha : a then λ h, ha else λ h, h ha.elim

theorem peirce' {a : Prop} (H : ∀ b : Prop, (a → b) → a) : a := H _ id

theorem not_iff_not [decidable a] [decidable b] : (¬ a ↔ ¬ b) ↔ (a ↔ b) :=
by rw [@iff_def (¬ a), @iff_def' a]; exact and_congr not_imp_not not_imp_not

theorem not_iff_comm [decidable a] [decidable b] : (¬ a ↔ b) ↔ (¬ b ↔ a) :=
by rw [@iff_def (¬ a), @iff_def (¬ b)]; exact and_congr not_imp_comm imp_not_comm

theorem not_iff [decidable a] [decidable b] : ¬ (a ↔ b) ↔ (¬ a ↔ b) :=
by split; intro h; [split, skip]; intro h'; [by_contradiction,intro,skip];
   try { refine h _; simp [*] }; rw [h',not_iff_self] at h; exact h

theorem iff_not_comm [decidable a] [decidable b] : (a ↔ ¬ b) ↔ (b ↔ ¬ a) :=
by rw [@iff_def a, @iff_def b]; exact and_congr imp_not_comm not_imp_comm

theorem iff_iff_and_or_not_and_not [decidable b] : (a ↔ b) ↔ (a ∧ b) ∨ (¬ a ∧ ¬ b) :=
by { split; intro h,
     { rw h; by_cases b; [left,right]; split; assumption },
     { cases h with h h; cases h; split; intro; { contradiction <|> assumption } } }

@[simp] theorem not_and_not_right [decidable b] : ¬(a ∧ ¬b) ↔ (a → b) :=
⟨λ h ha, h.imp_symm $ and.intro ha, λ h ⟨ha, hb⟩, hb $ h ha⟩

@[inline] def decidable_of_iff (a : Prop) (h : a ↔ b) [D : decidable a] : decidable b :=
decidable_of_decidable_of_iff D h

@[inline] def decidable_of_iff' (b : Prop) (h : a ↔ b) [D : decidable b] : decidable a :=
decidable_of_decidable_of_iff D h.symm

def decidable_of_bool : ∀ (b : bool) (h : b ↔ a), decidable a
| tt h := is_true (h.1 rfl)
| ff h := is_false (mt h.2 bool.ff_ne_tt)

/- de morgan's laws -/

theorem not_and_of_not_or_not (h : ¬ a ∨ ¬ b) : ¬ (a ∧ b)
| ⟨ha, hb⟩ := or.elim h (absurd ha) (absurd hb)

theorem not_and_distrib [decidable a] : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
⟨λ h, if ha : a then or.inr (λ hb, h ⟨ha, hb⟩) else or.inl ha, not_and_of_not_or_not⟩

theorem not_and_distrib' [decidable b] : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
⟨λ h, if hb : b then or.inl (λ ha, h ⟨ha, hb⟩) else or.inr hb, not_and_of_not_or_not⟩

@[simp] theorem not_and : ¬ (a ∧ b) ↔ (a → ¬ b) := and_imp

theorem not_and' : ¬ (a ∧ b) ↔ b → ¬a :=
not_and.trans imp_not_comm

theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
⟨λ h, ⟨λ ha, h (or.inl ha), λ hb, h (or.inr hb)⟩,
 λ ⟨h₁, h₂⟩ h, or.elim h h₁ h₂⟩

theorem or_iff_not_and_not [decidable a] [decidable b] : a ∨ b ↔ ¬ (¬a ∧ ¬b) :=
by rw [← not_or_distrib, not_not]

theorem and_iff_not_or_not [decidable a] [decidable b] : a ∧ b ↔ ¬ (¬ a ∨ ¬ b) :=
by rw [← not_and_distrib, not_not]

end propositional

/- equality -/

section equality
variables {α : Sort*} {a b : α}

@[simp] theorem heq_iff_eq : a == b ↔ a = b :=
⟨eq_of_heq, heq_of_eq⟩

theorem proof_irrel_heq {p q : Prop} (hp : p) (hq : q) : hp == hq :=
have p = q, from propext ⟨λ _, hq, λ _, hp⟩,
by subst q; refl

theorem ne_of_mem_of_not_mem {α β} [has_mem α β] {s : β} {a b : α}
  (h : a ∈ s) : b ∉ s → a ≠ b :=
mt $ λ e, e ▸ h

theorem eq_equivalence : equivalence (@eq α) :=
⟨eq.refl, @eq.symm _, @eq.trans _⟩

lemma heq_of_eq_mp :
  ∀ {α β : Sort*} {a : α} {a' : β} (e : α = β) (h₂ : (eq.mp e a) = a'), a == a'
| α ._ a a' rfl h := eq.rec_on h (heq.refl _)

lemma rec_heq_of_heq {β} {C : α → Sort*} {x : C a} {y : β} (eq : a = b) (h : x == y) :
  @eq.rec α a C x b eq == y :=
by subst eq; exact h

@[simp] lemma {u} eq_mpr_heq {α β : Sort u} (h : β = α) (x : α) : eq.mpr h x == x :=
by subst h; refl
end equality

/-
  quantifiers
-/

section quantifiers
variables {α : Sort*} {p q : α → Prop} {b : Prop}

def Exists.imp := @exists_imp_exists

theorem forall_swap {α β} {p : α → β → Prop} : (∀ x y, p x y) ↔ ∀ y x, p x y :=
⟨function.swap, function.swap⟩

theorem exists_swap {α β} {p : α → β → Prop} : (∃ x y, p x y) ↔ ∃ y x, p x y :=
⟨λ ⟨x, y, h⟩, ⟨y, x, h⟩, λ ⟨y, x, h⟩, ⟨x, y, h⟩⟩

@[simp] theorem exists_imp_distrib : ((∃ x, p x) → b) ↔ ∀ x, p x → b :=
⟨λ h x hpx, h ⟨x, hpx⟩, λ h ⟨x, hpx⟩, h x hpx⟩

--theorem forall_not_of_not_exists (h : ¬ ∃ x, p x) : ∀ x, ¬ p x :=
--forall_imp_of_exists_imp h

theorem not_exists_of_forall_not (h : ∀ x, ¬ p x) : ¬ ∃ x, p x :=
exists_imp_distrib.2 h

@[simp] theorem not_exists : (¬ ∃ x, p x) ↔ ∀ x, ¬ p x :=
exists_imp_distrib

theorem not_forall_of_exists_not : (∃ x, ¬ p x) → ¬ ∀ x, p x
| ⟨x, hn⟩ h := hn (h x)

theorem not_forall {p : α → Prop}
    [decidable (∃ x, ¬ p x)] [∀ x, decidable (p x)] :
  (¬ ∀ x, p x) ↔ ∃ x, ¬ p x :=
⟨not.imp_symm $ λ nx x, nx.imp_symm $ λ h, ⟨x, h⟩,
 not_forall_of_exists_not⟩

@[simp] theorem not_forall_not [decidable (∃ x, p x)] :
  (¬ ∀ x, ¬ p x) ↔ ∃ x, p x :=
by haveI := decidable_of_iff (¬ ∃ x, p x) not_exists;
   exact not_iff_comm.1 not_exists

@[simp] theorem not_exists_not [∀ x, decidable (p x)] :
  (¬ ∃ x, ¬ p x) ↔ ∀ x, p x :=
by simp

@[simp] theorem forall_true_iff : (α → true) ↔ true :=
iff_true_intro (λ _, trivial)

-- Unfortunately this causes simp to loop sometimes, so we
-- add the 2 and 3 cases as simp lemmas instead
theorem forall_true_iff' (h : ∀ a, p a ↔ true) : (∀ a, p a) ↔ true :=
iff_true_intro (λ _, of_iff_true (h _))

@[simp] theorem forall_2_true_iff {β : α → Sort*} : (∀ a, β a → true) ↔ true :=
forall_true_iff' $ λ _, forall_true_iff

@[simp] theorem forall_3_true_iff {β : α → Sort*} {γ : Π a, β a → Sort*} :
  (∀ a (b : β a), γ a b → true) ↔ true :=
forall_true_iff' $ λ _, forall_2_true_iff

@[simp] theorem forall_const (α : Sort*) [inhabited α] : (α → b) ↔ b :=
⟨λ h, h (arbitrary α), λ hb x, hb⟩

@[simp] theorem exists_const (α : Sort*) [inhabited α] : (∃ x : α, b) ↔ b :=
⟨λ ⟨x, h⟩, h, λ h, ⟨arbitrary α, h⟩⟩

theorem forall_and_distrib : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
⟨λ h, ⟨λ x, (h x).left, λ x, (h x).right⟩, λ ⟨h₁, h₂⟩ x, ⟨h₁ x, h₂ x⟩⟩

theorem exists_or_distrib : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
⟨λ ⟨x, hpq⟩, hpq.elim (λ hpx, or.inl ⟨x, hpx⟩) (λ hqx, or.inr ⟨x, hqx⟩),
 λ hepq, hepq.elim (λ ⟨x, hpx⟩, ⟨x, or.inl hpx⟩) (λ ⟨x, hqx⟩, ⟨x, or.inr hqx⟩)⟩

@[simp] theorem exists_and_distrib_left {q : Prop} {p : α → Prop} :
  (∃x, q ∧ p x) ↔ q ∧ (∃x, p x) :=
⟨λ ⟨x, hq, hp⟩, ⟨hq, x, hp⟩, λ ⟨hq, x, hp⟩, ⟨x, hq, hp⟩⟩

@[simp] theorem exists_and_distrib_right {q : Prop} {p : α → Prop} :
  (∃x, p x ∧ q) ↔ (∃x, p x) ∧ q :=
by simp [and_comm]

@[simp] theorem forall_eq {a' : α} : (∀a, a = a' → p a) ↔ p a' :=
⟨λ h, h a' rfl, λ h a e, e.symm ▸ h⟩

@[simp] theorem exists_eq {a' : α} : ∃ a, a = a' := ⟨_, rfl⟩

@[simp] theorem exists_eq_left {a' : α} : (∃ a, a = a' ∧ p a) ↔ p a' :=
⟨λ ⟨a, e, h⟩, e ▸ h, λ h, ⟨_, rfl, h⟩⟩

@[simp] theorem exists_eq_right {a' : α} : (∃ a, p a ∧ a = a') ↔ p a' :=
(exists_congr $ by exact λ a, and.comm).trans exists_eq_left

@[simp] theorem forall_eq' {a' : α} : (∀a, a' = a → p a) ↔ p a' :=
by simp [@eq_comm _ a']

@[simp] theorem exists_eq_left' {a' : α} : (∃ a, a' = a ∧ p a) ↔ p a' :=
by simp [@eq_comm _ a']

@[simp] theorem exists_eq_right' {a' : α} : (∃ a, p a ∧ a' = a) ↔ p a' :=
by simp [@eq_comm _ a']

theorem forall_or_of_or_forall (h : b ∨ ∀x, p x) (x) : b ∨ p x :=
h.imp_right $ λ h₂, h₂ x

theorem forall_or_distrib_left {q : Prop} {p : α → Prop} [decidable q] :
  (∀x, q ∨ p x) ↔ q ∨ (∀x, p x) :=
⟨λ h, if hq : q then or.inl hq else or.inr $ λ x, (h x).resolve_left hq,
  forall_or_of_or_forall⟩

@[simp] theorem exists_prop {p q : Prop} : (∃ h : p, q) ↔ p ∧ q :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, h₂⟩, λ ⟨h₁, h₂⟩, ⟨h₁, h₂⟩⟩

@[simp] theorem exists_false : ¬ (∃a:α, false) := assume ⟨a, h⟩, h

theorem Exists.fst {p : b → Prop} : Exists p → b
| ⟨h, _⟩ := h

theorem Exists.snd {p : b → Prop} : ∀ h : Exists p, p h.fst
| ⟨_, h⟩ := h

@[simp] theorem forall_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∀ h' : p, q h') ↔ q h :=
@forall_const (q h) p ⟨h⟩

@[simp] theorem exists_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∃ h' : p, q h') ↔ q h :=
@exists_const (q h) p ⟨h⟩

@[simp] theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬ p) : (∀ h' : p, q h') ↔ true :=
iff_true_intro $ λ h, hn.elim h

@[simp] theorem exists_prop_of_false {p : Prop} {q : p → Prop} : ¬ p → ¬ (∃ h' : p, q h') :=
mt Exists.fst

end quantifiers

/- classical versions -/

namespace classical
variables {α : Sort*} {p : α → Prop}

local attribute [instance] prop_decidable

protected theorem not_forall : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := not_forall

protected theorem forall_or_distrib_left {q : Prop} {p : α → Prop} :
  (∀x, q ∨ p x) ↔ q ∨ (∀x, p x) :=
forall_or_distrib_left

theorem cases {p : Prop → Prop} (h1 : p true) (h2 : p false) : ∀a, p a :=
assume a, cases_on a h1 h2

theorem or_not {p : Prop} : p ∨ ¬ p :=
by_cases or.inl or.inr

protected theorem or_iff_not_imp_left {p q : Prop} : p ∨ q ↔ (¬ p → q) :=
or_iff_not_imp_left

protected theorem or_iff_not_imp_right {p q : Prop} : q ∨ p ↔ (¬ p → q) :=
or_iff_not_imp_right

protected lemma not_not {p : Prop} : ¬¬p ↔ p := not_not

/- use shortened names to avoid conflict when classical namespace is open -/
noncomputable theorem dec (p : Prop) : decidable p := by apply_instance
noncomputable theorem dec_pred (p : α → Prop) : decidable_pred p := by apply_instance
noncomputable theorem dec_rel (p : α → α → Prop) : decidable_rel p := by apply_instance
noncomputable theorem dec_eq (α : Sort*) : decidable_eq α := by apply_instance

@[elab_as_eliminator]
noncomputable def {u} exists_cases {C : Sort u} (H0 : C) (H : ∀ a, p a → C) : C :=
if h : ∃ a, p a then H (classical.some h) (classical.some_spec h) else H0

lemma some_spec2 {α : Type*} {p : α → Prop} {h : ∃a, p a}
  (q : α → Prop) (hpq : ∀a, p a → q a) : q (some h) :=
hpq _ $ some_spec _

end classical

@[elab_as_eliminator]
noncomputable def {u} exists.classical_rec_on
 {α} {p : α → Prop} (h : ∃ a, p a) {C : Sort u} (H : ∀ a, p a → C) : C :=
H (classical.some h) (classical.some_spec h)

/-
   bounded quantifiers
-/

section bounded_quantifiers
variables {α : Sort*} {r p q : α → Prop} {P Q : ∀ x, p x → Prop} {b : Prop}

theorem bex_def : (∃ x (h : p x), q x) ↔ ∃ x, p x ∧ q x :=
⟨λ ⟨x, px, qx⟩, ⟨x, px, qx⟩, λ ⟨x, px, qx⟩, ⟨x, px, qx⟩⟩

theorem bex.elim {b : Prop} : (∃ x h, P x h) → (∀ a h, P a h → b) → b
| ⟨a, h₁, h₂⟩ h' := h' a h₁ h₂

theorem bex.intro (a : α) (h₁ : p a) (h₂ : P a h₁) : ∃ x (h : p x), P x h :=
⟨a, h₁, h₂⟩

theorem ball_congr (H : ∀ x h, P x h ↔ Q x h) :
  (∀ x h, P x h) ↔ (∀ x h, Q x h) :=
forall_congr $ λ x, forall_congr (H x)

theorem bex_congr (H : ∀ x h, P x h ↔ Q x h) :
  (∃ x h, P x h) ↔ (∃ x h, Q x h) :=
exists_congr $ λ x, exists_congr (H x)

theorem ball.imp_right (H : ∀ x h, (P x h → Q x h))
  (h₁ : ∀ x h, P x h) (x h) : Q x h :=
H _ _ $ h₁ _ _

theorem bex.imp_right (H : ∀ x h, (P x h → Q x h)) :
  (∃ x h, P x h) → ∃ x h, Q x h
| ⟨x, h, h'⟩ := ⟨_, _, H _ _ h'⟩

theorem ball.imp_left (H : ∀ x, p x → q x)
  (h₁ : ∀ x, q x → r x) (x) (h : p x) : r x :=
h₁ _ $ H _ h

theorem bex.imp_left (H : ∀ x, p x → q x) :
  (∃ x (_ : p x), r x) → ∃ x (_ : q x), r x
| ⟨x, hp, hr⟩ := ⟨x, H _ hp, hr⟩

theorem ball_of_forall (h : ∀ x, p x) (x) (_ : q x) : p x :=
h x

theorem forall_of_ball (H : ∀ x, p x) (h : ∀ x, p x → q x) (x) : q x :=
h x $ H x

theorem bex_of_exists (H : ∀ x, p x) : (∃ x, q x) → ∃ x (_ : p x), q x
| ⟨x, hq⟩ := ⟨x, H x, hq⟩

theorem exists_of_bex : (∃ x (_ : p x), q x) → ∃ x, q x
| ⟨x, _, hq⟩ := ⟨x, hq⟩

@[simp] theorem bex_imp_distrib : ((∃ x h, P x h) → b) ↔ (∀ x h, P x h → b) :=
by simp

theorem not_bex : (¬ ∃ x h, P x h) ↔ ∀ x h, ¬ P x h :=
bex_imp_distrib

theorem not_ball_of_bex_not : (∃ x h, ¬ P x h) → ¬ ∀ x h, P x h
| ⟨x, h, hp⟩ al := hp $ al x h

theorem not_ball [decidable (∃ x h, ¬ P x h)] [∀ x h, decidable (P x h)] :
  (¬ ∀ x h, P x h) ↔ (∃ x h, ¬ P x h) :=
⟨not.imp_symm $ λ nx x h, nx.imp_symm $ λ h', ⟨x, h, h'⟩,
 not_ball_of_bex_not⟩

theorem ball_true_iff (p : α → Prop) : (∀ x, p x → true) ↔ true :=
iff_true_intro (λ h hrx, trivial)

theorem ball_and_distrib : (∀ x h, P x h ∧ Q x h) ↔ (∀ x h, P x h) ∧ (∀ x h, Q x h) :=
iff.trans (forall_congr $ λ x, forall_and_distrib) forall_and_distrib

theorem bex_or_distrib : (∃ x h, P x h ∨ Q x h) ↔ (∃ x h, P x h) ∨ (∃ x h, Q x h) :=
iff.trans (exists_congr $ λ x, exists_or_distrib) exists_or_distrib

end bounded_quantifiers

namespace classical
local attribute [instance] prop_decidable

theorem not_ball {α : Sort*} {p : α → Prop} {P : Π (x : α), p x → Prop} :
  (¬ ∀ x h, P x h) ↔ (∃ x h, ¬ P x h) := _root_.not_ball

end classical

section nonempty
universes u v w
variables {α : Type u} {β : Type v} {γ : α → Type w}

attribute [simp] nonempty_of_inhabited

lemma exists_true_iff_nonempty {α : Sort*} : (∃a:α, true) ↔ nonempty α :=
iff.intro (λ⟨a, _⟩, ⟨a⟩) (λ⟨a⟩, ⟨a, trivial⟩)

@[simp] lemma nonempty_Prop {p : Prop} : nonempty p ↔ p :=
iff.intro (assume ⟨h⟩, h) (assume h, ⟨h⟩)

lemma not_nonempty_iff_imp_false {p : Prop} : ¬ nonempty α ↔ α → false :=
⟨λ h a, h ⟨a⟩, λ h ⟨a⟩, h a⟩

@[simp] lemma nonempty_sigma : nonempty (Σa:α, γ a) ↔ (∃a:α, nonempty (γ a)) :=
iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)

@[simp] lemma nonempty_subtype {α : Sort u} {p : α → Prop} : nonempty (subtype p) ↔ (∃a:α, p a) :=
iff.intro (assume ⟨⟨a, h⟩⟩, ⟨a, h⟩) (assume ⟨a, h⟩, ⟨⟨a, h⟩⟩)

@[simp] lemma nonempty_prod : nonempty (α × β) ↔ (nonempty α ∧ nonempty β) :=
iff.intro (assume ⟨⟨a, b⟩⟩, ⟨⟨a⟩, ⟨b⟩⟩) (assume ⟨⟨a⟩, ⟨b⟩⟩, ⟨⟨a, b⟩⟩)

@[simp] lemma nonempty_pprod {α : Sort u} {β : Sort v} :
  nonempty (pprod α β) ↔ (nonempty α ∧ nonempty β) :=
iff.intro (assume ⟨⟨a, b⟩⟩, ⟨⟨a⟩, ⟨b⟩⟩) (assume ⟨⟨a⟩, ⟨b⟩⟩, ⟨⟨a, b⟩⟩)

@[simp] lemma nonempty_sum : nonempty (α ⊕ β) ↔ (nonempty α ∨ nonempty β) :=
iff.intro
  (assume ⟨h⟩, match h with sum.inl a := or.inl ⟨a⟩ | sum.inr b := or.inr ⟨b⟩ end)
  (assume h, match h with or.inl ⟨a⟩ := ⟨sum.inl a⟩ | or.inr ⟨b⟩ := ⟨sum.inr b⟩ end)

@[simp] lemma nonempty_psum {α : Sort u} {β : Sort v} :
  nonempty (psum α β) ↔ (nonempty α ∨ nonempty β) :=
iff.intro
  (assume ⟨h⟩, match h with psum.inl a := or.inl ⟨a⟩ | psum.inr b := or.inr ⟨b⟩ end)
  (assume h, match h with or.inl ⟨a⟩ := ⟨psum.inl a⟩ | or.inr ⟨b⟩ := ⟨psum.inr b⟩ end)

@[simp] lemma nonempty_psigma {α : Sort u} {β : α → Sort v} :
  nonempty (psigma β) ↔ (∃a:α, nonempty (β a)) :=
iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)

@[simp] lemma nonempty_empty : ¬ nonempty empty :=
assume ⟨h⟩, h.elim

@[simp] lemma nonempty_ulift : nonempty (ulift α) ↔ nonempty α :=
iff.intro (assume ⟨⟨a⟩⟩, ⟨a⟩) (assume ⟨a⟩, ⟨⟨a⟩⟩)

@[simp] lemma nonempty_plift {α : Sort u} : nonempty (plift α) ↔ nonempty α :=
iff.intro (assume ⟨⟨a⟩⟩, ⟨a⟩) (assume ⟨a⟩, ⟨⟨a⟩⟩)

@[simp] lemma nonempty.forall {α : Sort u} {p : nonempty α → Prop} :
  (∀h:nonempty α, p h) ↔ (∀a, p ⟨a⟩) :=
iff.intro (assume h a, h _) (assume h ⟨a⟩, h _)

@[simp] lemma nonempty.exists {α : Sort u} {p : nonempty α → Prop} :
  (∃h:nonempty α, p h) ↔ (∃a, p ⟨a⟩) :=
iff.intro (assume ⟨⟨a⟩, h⟩, ⟨a, h⟩) (assume ⟨a, h⟩, ⟨⟨a⟩, h⟩)

lemma classical.nonempty_pi {α : Sort u} {β : α → Sort v} :
  nonempty (Πa:α, β a) ↔ (∀a:α, nonempty (β a)) :=
iff.intro (assume ⟨f⟩ a, ⟨f a⟩) (assume f, ⟨assume a, classical.choice $ f a⟩)

-- inhabited_of_nonempty already exists, in core/init/classical.lean, but the
-- assumption is not [...], which makes it unsuitable for some applications
noncomputable def classical.inhabited_of_nonempty' {α : Sort u} [h : nonempty α] : inhabited α :=
⟨classical.choice h⟩

-- `nonempty` cannot be a `functor`, because `functor` is restricted to Types.
lemma nonempty.map {α : Sort u} {β : Sort v} (f : α → β) : nonempty α → nonempty β
| ⟨h⟩ := ⟨f h⟩

end nonempty


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lucas Allen, Scott Morrison
-/
import tactic.interactive
import tactic.converter.interactive

/-!
## Introduce the `apply_congr` conv mode tactic.

`apply_congr` will apply congruence lemmas inside `conv` mode.
It is particularly useful when the automatically generated congruence lemmas
are not of the optimal shape. An example, described in the doc-string is
rewriting inside the operand of a `finset.sum`.
-/

open tactic

namespace conv.interactive
open interactive interactive.types lean.parser

local postfix (name := parser.optional) `?`:9001 := optional

/--
Apply a congruence lemma inside `conv` mode.

When called without an argument `apply_congr` will try applying all lemmas marked with `@[congr]`.
Otherwise `apply_congr e` will apply the lemma `e`.

Recall that a goal that appears as `∣ X` in `conv` mode
represents a goal of `⊢ X = ?m`,
i.e. an equation with a metavariable for the right hand side.

To successfully use `apply_congr e`, `e` will need to be an equation
(possibly after function arguments),
which can be unified with a goal of the form `X = ?m`.
The right hand side of `e` will then determine the metavariable,
and `conv` will subsequently replace `X` with that right hand side.

As usual, `apply_congr` can create new goals;
any of these which are _not_ equations with a metavariable on the right hand side
will be hard to deal with in `conv` mode.
Thus `apply_congr` automatically calls `intros` on any new goals,
and fails if they are not then equations.

In particular it is useful for rewriting inside the operand of a `finset.sum`,
as it provides an extra hypothesis asserting we are inside the domain.

For example:

```lean
example (f g : ℤ → ℤ) (S : finset ℤ) (h : ∀ m ∈ S, f m = g m) :
  finset.sum S f = finset.sum S g :=
begin
  conv_lhs
  { -- If we just call `congr` here, in the second goal we're helpless,
    -- because we are only given the opportunity to rewrite `f`.
    -- However `apply_congr` uses the appropriate `@[congr]` lemma,
    -- so we get to rewrite `f x`, in the presence of the crucial `H : x ∈ S` hypothesis.
    apply_congr,
    skip,
    simp [h, H], }
end
```

In the above example, when the `apply_congr` tactic is called it gives the hypothesis `H : x ∈ S`
which is then used to rewrite the `f x` to `g x`.
-/
meta def apply_congr (q : parse texpr?) : conv unit :=
do
  congr_lemmas ← match q with
  -- If the user specified a lemma, use that one,
  | some e := do
    gs ← get_goals,
    e ← to_expr e, -- to_expr messes with the goals? (see tests)
    set_goals gs,
    return [e]
  -- otherwise, look up everything tagged `@[congr]`
  | none := do
    congr_lemma_names ← attribute.get_instances `congr,
    congr_lemma_names.mmap mk_const
  end,
  -- For every lemma:
  congr_lemmas.any_of (λ n,
    -- Call tactic.eapply
    seq' (tactic.eapply n >> tactic.skip)
    -- and then call `intros` on each resulting goal, and require that afterwards it's an equation.
        (tactic.intros >> (do `(_ = _) ← target, tactic.skip)))

add_tactic_doc
{ name := "apply_congr",
  category := doc_category.tactic,
  decl_names := [`conv.interactive.apply_congr],
  tags := ["conv", "congruence", "rewriting"] }

end conv.interactive


def add (n m : Nat) : Nat := n + m
@[simp] theorem addZero x : add 0 x = x := by
  simp [add]

syntax "bigAdd0Seq! " num : term

macro_rules
  | `(bigAdd0Seq! $n) =>
    let n := n.toNat
    if n == 0 then
      `(0)
    else
      `(add 0 (bigAdd0Seq! $(Lean.quote (n - 1))))

set_option maxRecDepth 10000

theorem ex : bigAdd0Seq! 20 = 0 := by
  simp

#print ex


import data.real.basic
import data.fin.vec_notation
import data.fin_enum

universe u

/-!
### Dimension type classes
-/

class has_time (α : Type u) :=
[dec : decidable_eq α]
(time [] : α)
(h : [time].nodup)

class has_length (α : Type u) :=
[dec : decidable_eq α]
(length [] : α)
(h : [length].nodup)

class has_mass (α : Type u) :=
[dec : decidable_eq α]
(mass [] : α)
(h : [mass].nodup)

class has_amount_of_substance (α : Type u) :=
[dec : decidable_eq α]
(amount_of_substance [] : α)
(h : [amount_of_substance].nodup)

class has_electric_current (α : Type u) :=
[dec : decidable_eq α]
(electric_current [] : α)
(h : [electric_current].nodup)

class has_temperature (α : Type u) :=
[dec : decidable_eq α]
(temperature [] : α)
(h : [temperature].nodup)

class has_luminous_intensity (α : Type u) :=
[dec : decidable_eq α]
(luminous_intensity [] : α)
(h : [luminous_intensity].nodup)

attribute [instance] has_time.dec
attribute [instance] has_length.dec
attribute [instance] has_mass.dec
attribute [instance] has_amount_of_substance.dec
attribute [instance] has_electric_current.dec
attribute [instance] has_temperature.dec
attribute [instance] has_luminous_intensity.dec

/-!
### Def of dimensions and its properties
-/

def dimension (α : Type u) := α → ℚ

namespace dimension
def dimensionless (α) : dimension α := λ i, 0
instance {α} : has_one (dimension α) := ⟨dimension.dimensionless α⟩
instance {α} : nonempty (dimension α) := has_one.nonempty

protected noncomputable def add {α} [decidable_eq (dimension α)]: dimension α → dimension α → dimension α :=
classical.epsilon $ λ f, ∀ a b, a = b → f a b = a
protected noncomputable def sub {α} [decidable_eq (dimension α)]: dimension α → dimension α → dimension α :=
classical.epsilon $ λ f, ∀ a b, a = b → f a b = a
protected def mul {α} : dimension α → dimension α → dimension α
| a b := λ (i : α), a i + b i
protected def div {α} : dimension α → dimension α → dimension α
| a b := λ (i : α), a i - b i

protected def qpow {α} : dimension α → ℚ → dimension α
| a n := λ (i : α), n • (a i)
protected def npow {α} : dimension α → ℕ → dimension α
| a n := a.qpow ↑n
protected def zpow {α} : dimension α → ℤ → dimension α
| a n := a.qpow ↑n
protected def inv {α} : dimension α → dimension α
| a := a.zpow (-1)

noncomputable instance {α} [decidable_eq (dimension α)] : has_add (dimension α) := ⟨dimension.add⟩
noncomputable instance {α} [decidable_eq (dimension α)] : has_sub (dimension α) := ⟨dimension.sub⟩
instance {α} : has_mul (dimension α) := ⟨dimension.mul⟩
instance {α} : has_div (dimension α) := ⟨dimension.div⟩
instance {α} : has_pow (dimension α) ℕ := ⟨dimension.npow⟩
instance {α} : has_pow (dimension α) ℤ := ⟨dimension.zpow⟩
instance {α} : has_pow (dimension α) ℚ := ⟨dimension.qpow⟩
instance {α} : has_inv (dimension α) := ⟨dimension.inv⟩

--I would love to add unicode to make specific globabl notation for dimension derivatives and integrals,
--but thats more fluff than important

protected def derivative {α} : ℕ → dimension α → dimension α → dimension α
| n a b := a / (b ^ n)
protected def integral {α} : dimension α → dimension α → dimension α
| a b := a * b

@[simp] lemma add_def {α} (a b : dimension α) [decidable_eq (dimension α)] : a.add b = a + b := by refl
@[simp] lemma add_def' {α} (a : dimension α) [decidable_eq (dimension α)] : a.add a = a :=
begin
  generalize hb : a = b, symmetry' at hb,
  nth_rewrite 1 hb, revert b a hb, unfold dimension.add,
  apply classical.epsilon_spec (⟨λ a _, a, λ _ _ _, rfl⟩ :
    ∃ (f : dimension α → dimension α → dimension α), ∀ a b, a = b → f a b = a),
end
@[simp] lemma add_def'' {α} (a : dimension α) [decidable_eq (dimension α)] : a + a = a := by {rw [← add_def, add_def'],}
@[simp] lemma sub_def {α} (a b : dimension α) [decidable_eq (dimension α)] : a.sub b = a - b := by refl
@[simp] lemma sub_def' {α} (a : dimension α) [decidable_eq (dimension α)] : a.sub a = a :=
begin
  generalize hb : a = b, symmetry' at hb,
  nth_rewrite 1 hb, revert b a hb, unfold dimension.sub,
  apply classical.epsilon_spec (⟨λ a _, a, λ _ _ _, rfl⟩ :
    ∃ (f : dimension α → dimension α → dimension α), ∀ a b, a = b → f a b = a),
end
@[simp] lemma sub_def'' {α} (a : dimension α) [decidable_eq (dimension α)] : a - a = a := by {rw [← sub_def, sub_def'],}
@[simp] lemma mul_def {α} (a b : dimension α) : a.mul b = a * b := by refl
@[simp] lemma mul_def' {α} (a b : dimension α) : a * b = λ (i : α), a i + b i := by refl
@[simp] lemma div_def {α} (a b : dimension α) : a.div b = a / b := by refl
@[simp] lemma div_def' {α} (a b : dimension α) : a / b = λ (i : α), a i - b i := by refl
@[simp] lemma qpow_def {α} (a : dimension α) (b : ℚ) : a.qpow b = a^b := by refl
@[simp] lemma qpow_def' {α} (a : dimension α) (b : ℚ) : a ^ b = λ (i : α), b • (a i):= by refl
@[simp] lemma pow_def {α} (a : dimension α) (b : ℕ) : a.npow b = a^b := by refl
@[simp] lemma pow_def' {α} (a : dimension α) (b : ℕ) : a ^ b = λ (i : α), b • (a i) := by {simp, refl}
@[simp] lemma zpow_def {α} (a : dimension α) (b : ℤ) : a.zpow b = a^b := by refl
@[simp] lemma zpow_def' {α} (a : dimension α) (b : ℤ) : a ^ b = λ (i : α), b • (a i) := by {simp, refl}
@[simp] lemma inv_def {α} (a : dimension α) : a.inv = a⁻¹ := by refl
@[simp] lemma inv_def' {α} (a : dimension α) : a⁻¹ = λ (i : α), (-1 : ℤ) • (a i) := by {rw [← inv_def, dimension.inv, dimension.zpow, dimension.qpow], simp}

/-!
### Definition of the base dimensions
-/
def length (α) [has_length α] : dimension α :=
pi.single (has_length.length α) 1

def time (α) [has_time α] : dimension α :=
pi.single (has_time.time α) 1

def mass (α) [has_mass α] : dimension α :=
pi.single (has_mass.mass α) 1

def amount_of_substance (α) [has_amount_of_substance α] : dimension α :=
pi.single (has_amount_of_substance.amount_of_substance α) 1

def electric_current (α) [has_electric_current α] : dimension α :=
pi.single (has_electric_current.electric_current α) 1

def temperature (α) [has_temperature α] : dimension α :=
pi.single (has_temperature.temperature α) 1

def luminous_intensity (α) [has_luminous_intensity α] : dimension α :=
pi.single (has_luminous_intensity.luminous_intensity α) 1

protected def numbers_are_dimensionless (α : Type*) [ordered_semiring α] [nontrivial α] {β}: α → dimension β
|a := dimension.dimensionless β
instance {α} [ordered_semiring α] [nontrivial α] {β}: has_coe α (dimension β):= ⟨dimension.numbers_are_dimensionless α⟩

@[simp] lemma one_eq_dimensionless {α} : 1 = dimensionless α := rfl
@[simp] lemma dimensionless_def' {α} : dimensionless α = λ i, 0 := rfl

protected theorem mul_comm {α} (a b : dimension α) : a * b = b * a := by {simp, funext, rw add_comm}
protected theorem div_mul_comm {α} (a b c : dimension α) : a / c * b  = b / c * a := by {simp, funext, rw sub_add_comm}
protected theorem mul_assoc {α} (a b c : dimension α) : a * b * c = a * (b * c) := by {simp, funext, rw add_assoc}
protected theorem mul_one {α} (a : dimension α) : a*1 = a := by simp
protected theorem one_mul {α} (a : dimension α) : 1*a = a := by simp
protected theorem div_eq_mul_inv {α} (a b : dimension α) : a / b = a * b⁻¹ := by {simp, funext, rw sub_eq_add_neg}
protected theorem mul_left_inv {α} (a : dimension α) : a⁻¹*a = 1 := by {simp}
protected theorem mul_right_inv {α} (a : dimension α) : a*a⁻¹ = 1 := by {simp}
@[simp] protected lemma nat_numbers_are_dimensionless {α} {n : ℕ}: ↑n = (1 : dimension α) := rfl
@[simp] protected lemma int_numbers_are_dimensionless {α} {z : ℤ}: ↑z = (1 : dimension α) := rfl
@[simp] protected lemma rat_numbers_are_dimensionless {α} {q : ℚ}: ↑q = (1 : dimension α) := rfl
@[simp] protected lemma real_numbers_are_dimensionless {α} {r : ℝ}: ↑r = (1 : dimension α) := rfl

instance {α} : comm_group (dimension α) :=
begin
  refine_struct { mul := dimension.mul,
                  div := dimension.div,
                  inv := dimension.inv,
                  mul_assoc := dimension.mul_assoc,
                  one := dimensionless α,
                  npow := @npow_rec (dimension α) dimension.has_one dimension.has_mul,
                  zpow := @zpow_rec (dimension α) dimension.has_one dimension.has_mul dimension.has_inv,
                  one_mul := dimension.one_mul,
                  mul_one := dimension.mul_one,
                  mul_comm := dimension.mul_comm,
                  div_eq_mul_inv := dimension.div_eq_mul_inv,
                  mul_left_inv := dimension.mul_left_inv,},
  repeat {rintro ⟨_⟩, },
  iterate 8 {intro, refl,},
end
noncomputable theorem fun_equiv {α β c} (H : α ≃ β) : (α → c) → (β → c) :=
begin
  intros h h1,
  apply h (H.inv_fun h1),
end

noncomputable def dimension.to_tuple {α} [fintype α] [decidable_eq α] (a : dimension α) : fin (fintype.card α) → ℚ :=
begin
  have h := fintype.trunc_equiv_fin α,
  have h1 : α ≃ fin (fintype.card α) := trunc.out h,
  intro h2,
  apply fun_equiv h1 a h2,
end

/-!
### Other dimensions
-/
--physics
def velocity (α) [has_length α] [has_time α] : dimension α := length α / time α

def acceleration (α) [has_length α] [has_time α] : dimension α := length α / ((time α) ^ 2)

def force (α) [has_length α] [has_time α] [has_mass α] : dimension α := length α / ((time α) ^ 2) * mass α

theorem accel_eq_vel_div_time {α} [has_length α] [has_time α] : acceleration α = velocity α / time α :=
begin
  field_simp [velocity, acceleration],
  funext,
  ring_nf,
end

theorem force_eq_mass_mul_accel {α} [has_length α] [has_time α] [has_mass α] : force α = mass α * acceleration α :=
begin
  simp [force, acceleration],
  funext,
  ring_nf,
end

end dimension
/-!
### examples for personal understanding
-/
inductive system1
| time | length

instance : decidable_eq system1
| system1.time system1.time := is_true rfl
| system1.time system1.length := is_false (λ h, system1.no_confusion h)
| system1.length system1.time := is_false (λ h, system1.no_confusion h)
| system1.length system1.length := is_true rfl

lemma system1.time_nodup : [system1.time].nodup := by finish
lemma system1.length_nodup : [system1.length].nodup := by finish

instance : has_time system1 := {dec := system1.decidable_eq, time := system1.time, h := system1.time_nodup}
instance : has_length system1 := {dec := system1.decidable_eq, length := system1.length, h := system1.length_nodup}

lemma system1_length_to_has_length : system1.length = has_length.length system1:= by refl
lemma system1_time_to_has_time : system1.time = has_time.time system1:= by refl

--Working on cardinality to convert dimension as system1 → ℚ to fin n → ℚ for matrix
instance : fintype system1 := ⟨⟨multiset.cons system1.time (multiset.cons system1.length ∅), by simp⟩, λ x, by cases x; simp⟩

noncomputable def system1.dimension_equiv_rat_tuple : dimension system1 ≃ (fin 2 → ℚ) := equiv.arrow_congr (fintype.equiv_fin system1) (equiv.refl ℚ)

noncomputable instance : fin_enum system1 := ⟨fintype.card system1, (fintype.equiv_fin system1)⟩

theorem system1.dimension_eq_tuple (a : dimension system1) : system1.dimension_equiv_rat_tuple a = ![a system1.length, a system1.time] :=
begin

end

example (h) :   vector.nth h = ![1,2,3,4] :=
begin
  funext,

end
protected def system1.repr : system1 → string
| system1.length := "length"
| system1.time := "time"

instance : has_repr system1 := ⟨system1.repr⟩

open dimension
theorem system1.accel_eq_vel_div_time : acceleration system1 = velocity system1 / time system1 := accel_eq_vel_div_time

--This show that we index our tuple through the specific base dimension rather than the previous way of vector number

example : (dimension.time system1) system1.length = 0 :=
begin
  simp [dimension.time],
  apply pi.single_eq_of_ne,
  finish,
end

example : (dimension.length system1) * (dimension.length system1) = pi.single (has_length.length system1) 2 :=
begin
  simp [dimension.length],
  ext1,
  cases x,
  rw [pi.single_eq_of_ne, pi.single_eq_of_ne],
  iterate 4 {finish},
end

example : ((dimension.length system1) * (dimension.length system1)) system1.length = 2 :=
begin
  simp [dimension.length],
  finish,
end


import applications.topologies
import opens

/-!
The category `Sheaf` of (set-valued) sheaves on a site is defined, using the sheaf condition as
defined in `grothendieck.lean`. It's defined somewhat abstractly, but an equivalent condition
(`grothendieck.sheaf_condition'`) is given there too, which is more concrete.
-/
universes v u

noncomputable theory

namespace category_theory
namespace site_sheaf

open category limits

variables (C : Type u) [small_category C] (J : sieve_set C) [grothendieck J]

structure Sheaf :=
(P : Cᵒᵖ ⥤ Type u)
(sheaf_cond : grothendieck.sheaf_condition J P)

instance : category (Sheaf C J) := induced_category.category Sheaf.P

/--
The category of sheaves (in the Grothendieck sense) is equivalent to a special case of sheaves on
a local operator. We use this equivalence to transfer properties from the abstract topos theory
to the geometric case.
-/
def equiv_lt_sheaf : Sheaf C J ≌ sheaf (j J) :=
{ functor :=
  { obj := λ P, sheaf.mk P.P (equivalent_sheaf_conditions _ _ P.sheaf_cond),
    map := λ P Q f, f },
  inverse :=
  { obj := λ P, ⟨P.A, (equivalent_sheaf_conditions _ _).symm (get_condition P)⟩,
    map := λ P Q f, f },
  unit_iso := nat_iso.of_components (λ P, {hom := 𝟙 _, inv := 𝟙 _}) (by tidy),
  counit_iso := nat_iso.of_components (λ P, {hom := 𝟙 _, inv := 𝟙 _}) (by tidy) }

/-- The forgetful functor from sheaves to presheaves. -/
def forget_Sheaf : Sheaf C J ⥤ (Cᵒᵖ ⥤ Type u) := induced_functor _

instance : full (forget_Sheaf C J) := induced_category.full _
instance : faithful (forget_Sheaf C J) := induced_category.faithful _

/-- The sheafification functor for sheaves on a site. -/
def sheafify : (Cᵒᵖ ⥤ Type u) ⥤ Sheaf C J := sheafification (j J) ⋙ (equiv_lt_sheaf _ _).inverse

/-- The equivalence between Sheaf and sheaf commutes with their respective forgetful functors. -/
lemma forget_comm : forget_Sheaf C J = (equiv_lt_sheaf _ _).functor ⋙ sheaf.forget (j J) := rfl

/-- Sheafification is left adjoint to the inclusion into presheaves. -/
def Sheafy_adjoint : sheafify C J ⊣ forget_Sheaf C J :=
adjunction.comp _ _ (sheafification_is_adjoint (j J)) (equiv_lt_sheaf _ _).symm.to_adjunction

instance : is_right_adjoint (forget_Sheaf C J) :=
{ left := _, adj := Sheafy_adjoint C J }

/-- The category of sheaves is a reflective subcategory of presheaves -/
instance : reflective (forget_Sheaf C J) := {}.

/-- The forgetful functor creates limits. -/
instance : creates_limits (forget_Sheaf C J) :=
{ creates_limits_of_shape := λ D 𝒟,
  { creates_limit := λ K,
    begin
      change creates_limit _ ((equiv_lt_sheaf _ _).functor ⋙ sheaf.forget (j J)),
      apply_instance,
    end } }

/-- Sheafification preserves finite products -/
instance preserve_fin_prod (D : Type u) [decidable_eq D] [fintype D] : preserves_limits_of_shape (discrete D) (sheafify C J) :=
{ preserves_limit := λ K,
begin
  unfold sheafify,
  haveI := sheafification_preserves_finite_products (j J) D,
  apply_instance,
end }

/-- Sheafification preserves equalizers -/
instance preserve_equalizer : preserves_limits_of_shape walking_parallel_pair (sheafify C J) :=
{ preserves_limit := λ K,
begin
  unfold sheafify,
  haveI := sheafification_preserves_equalizers (j J),
  apply_instance,
end }

end site_sheaf

open topological_space topological_space.opens

/-- Sheaves on a space. -/
abbreviation Sh (X : Type u) [topological_space X] := site_sheaf.Sheaf (opens X) (covering X)

end category_theory


import order.conditionally_complete_lattice

open set

-- TODO: Move: conditionally_complete_lattice
private lemma le_csupr_iff.mpr
{α : Type*} {ι : Sort*} [conditionally_complete_lattice α]
{s : ι → α} {a : α} (hs : bdd_above (range s)) (h : ∀ (b : α), (∀ (i : ι), s i ≤ b) → a ≤ b)
: a ≤ supr s :=
h (supr s) (λ i, le_csupr hs i)


import  data.set.function
open  set

variables α β : Type
variables  A :set α
variables  B :set β
variable f:α → β
variable g:β → α
theorem Schroder_Bernstein:
inj_on f A ∧ inj_on g B ∧ maps_to f A B ∧ maps_to g B A → ∃ h:α → β, bij_on h A B
:=
sorry