/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andreas Swerdlow
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.deprecated.subring
import Mathlib.algebra.group_with_zero.power
import Mathlib.PostPort

universes u_1 l u_2

namespace Mathlib

class is_subfield {F : Type u_1} [field F] (S : set F) extends is_subring S where
  inv_mem : ∀ {x : F}, x ∈ S → x⁻¹ ∈ S

protected instance is_subfield.field {F : Type u_1} [field F] (S : set F) [is_subfield S] :
    field ↥S :=
  let cr_inst : comm_ring ↥S := subset.comm_ring;
  field.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry
    comm_ring.mul sorry comm_ring.one sorry sorry sorry sorry sorry
    (fun (x : ↥S) => { val := ↑x⁻¹, property := sorry }) sorry sorry sorry

theorem is_subfield.pow_mem {F : Type u_1} [field F] {a : F} {n : ℤ} {s : set F} [is_subfield s]
    (h : a ∈ s) : a ^ n ∈ s :=
  int.cases_on n (fun (n : ℕ) => is_submonoid.pow_mem h)
    fun (n : ℕ) => is_subfield.inv_mem (is_submonoid.pow_mem h)

protected instance univ.is_subfield {F : Type u_1} [field F] : is_subfield set.univ :=
  is_subfield.mk fun (x : F) (ᾰ : x ∈ set.univ) => trivial

/- note: in the next two declarations, if we let type-class inference figure out the instance
  `ring_hom.is_subring_preimage` then that instance only applies when particular instances of
  `is_add_subgroup _` and `is_submonoid _` are chosen (which are not the default ones).
  If we specify it explicitly, then it doesn't complain. -/

protected instance preimage.is_subfield {F : Type u_1} [field F] {K : Type u_2} [field K]
    (f : F →+* K) (s : set K) [is_subfield s] : is_subfield (⇑f ⁻¹' s) :=
  is_subfield.mk
    fun (a : F) (ha : coe_fn f a ∈ s) =>
      (fun (this : coe_fn f (a⁻¹) ∈ s) => this)
        (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f (a⁻¹) ∈ s)) (ring_hom.map_inv f a)))
          (is_subfield.inv_mem ha))

protected instance image.is_subfield {F : Type u_1} [field F] {K : Type u_2} [field K] (f : F →+* K)
    (s : set F) [is_subfield s] : is_subfield (⇑f '' s) :=
  is_subfield.mk fun (a : K) (_x : a ∈ ⇑f '' s) => sorry

protected instance range.is_subfield {F : Type u_1} [field F] {K : Type u_2} [field K]
    (f : F →+* K) : is_subfield (set.range ⇑f) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_subfield (set.range ⇑f))) (Eq.symm set.image_univ)))
    (image.is_subfield f set.univ)

namespace field

/-- `field.closure s` is the minimal subfield that includes `s`. -/
def closure {F : Type u_1} [field F] (S : set F) : set F :=
  set_of
    fun (x : F) =>
      ∃ (y : F), ∃ (H : y ∈ ring.closure S), ∃ (z : F), ∃ (H : z ∈ ring.closure S), y / z = x

theorem ring_closure_subset {F : Type u_1} [field F] {S : set F} : ring.closure S ⊆ closure S :=
  fun (x : F) (hx : x ∈ ring.closure S) =>
    Exists.intro x
      (Exists.intro hx (Exists.intro 1 (Exists.intro is_submonoid.one_mem (div_one x))))

protected instance closure.is_submonoid {F : Type u_1} [field F] {S : set F} :
    is_submonoid (closure S) :=
  sorry

protected instance closure.is_subfield {F : Type u_1} [field F] {S : set F} :
    is_subfield (closure S) :=
  sorry

theorem mem_closure {F : Type u_1} [field F] {S : set F} {a : F} (ha : a ∈ S) : a ∈ closure S :=
  ring_closure_subset (ring.mem_closure ha)

theorem subset_closure {F : Type u_1} [field F] {S : set F} : S ⊆ closure S :=
  fun (_x : F) => mem_closure

theorem closure_subset {F : Type u_1} [field F] {S : set F} {T : set F} [is_subfield T]
    (H : S ⊆ T) : closure S ⊆ T :=
  sorry

theorem closure_subset_iff {F : Type u_1} [field F] (s : set F) (t : set F) [is_subfield t] :
    closure s ⊆ t ↔ s ⊆ t :=
  { mp := set.subset.trans subset_closure, mpr := closure_subset }

theorem closure_mono {F : Type u_1} [field F] {s : set F} {t : set F} (H : s ⊆ t) :
    closure s ⊆ closure t :=
  closure_subset (set.subset.trans H subset_closure)

end field

theorem is_subfield_Union_of_directed {F : Type u_1} [field F] {ι : Type u_2} [hι : Nonempty ι]
    (s : ι → set F) [∀ (i : ι), is_subfield (s i)]
    (directed : ∀ (i j : ι), ∃ (k : ι), s i ⊆ s k ∧ s j ⊆ s k) :
    is_subfield (set.Union fun (i : ι) => s i) :=
  sorry

protected instance is_subfield.inter {F : Type u_1} [field F] (S₁ : set F) (S₂ : set F)
    [is_subfield S₁] [is_subfield S₂] : is_subfield (S₁ ∩ S₂) :=
  is_subfield.mk
    fun (x : F) (hx : x ∈ S₁ ∩ S₂) =>
      { left := is_subfield.inv_mem (and.left hx), right := is_subfield.inv_mem (and.right hx) }

protected instance is_subfield.Inter {F : Type u_1} [field F] {ι : Sort u_2} (S : ι → set F)
    [h : ∀ (y : ι), is_subfield (S y)] : is_subfield (set.Inter S) :=
  is_subfield.mk
    fun (x : F) (hx : x ∈ set.Inter S) =>
      iff.mpr set.mem_Inter fun (y : ι) => is_subfield.inv_mem (iff.mp set.mem_Inter hx y)

end Mathlib


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.direct_sum.algebra
import algebra.monoid_algebra.basic
import data.finsupp.to_dfinsupp

/-!
# Conversion between `add_monoid_algebra` and homogenous `direct_sum`

This module provides conversions between `add_monoid_algebra` and `direct_sum`.
The latter is essentially a dependent version of the former.

Note that since `direct_sum.has_mul` combines indices additively, there is no equivalent to
`monoid_algebra`.

## Main definitions

* `add_monoid_algebra.to_direct_sum : add_monoid_algebra M ι → (⨁ i : ι, M)`
* `direct_sum.to_add_monoid_algebra : (⨁ i : ι, M) → add_monoid_algebra M ι`
* Bundled equiv versions of the above:
  * `add_monoid_algebra_equiv_direct_sum : add_monoid_algebra M ι ≃ (⨁ i : ι, M)`
  * `add_monoid_algebra_add_equiv_direct_sum : add_monoid_algebra M ι ≃+ (⨁ i : ι, M)`
  * `add_monoid_algebra_ring_equiv_direct_sum R : add_monoid_algebra M ι ≃+* (⨁ i : ι, M)`
  * `add_monoid_algebra_alg_equiv_direct_sum R : add_monoid_algebra A ι ≃ₐ[R] (⨁ i : ι, A)`

## Theorems

The defining feature of these operations is that they map `finsupp.single` to
`direct_sum.of` and vice versa:

* `add_monoid_algebra.to_direct_sum_single`
* `direct_sum.to_add_monoid_algebra_of`

as well as preserving arithmetic operations.

For the bundled equivalences, we provide lemmas that they reduce to
`add_monoid_algebra.to_direct_sum`:

* `add_monoid_algebra_add_equiv_direct_sum_apply`
* `add_monoid_algebra_lequiv_direct_sum_apply`
* `add_monoid_algebra_add_equiv_direct_sum_symm_apply`
* `add_monoid_algebra_lequiv_direct_sum_symm_apply`

## Implementation notes

This file largely just copies the API of `data/finsupp/to_dfinsupp`, and reuses the proofs.
Recall that `add_monoid_algebra M ι` is defeq to `ι →₀ M` and `⨁ i : ι, M` is defeq to
`Π₀ i : ι, M`.

Note that there is no `add_monoid_algebra` equivalent to `finsupp.single`, so many statements
still involve this definition.
-/

variables {ι : Type*} {R : Type*} {M : Type*} {A : Type*}

open_locale direct_sum

/-! ### Basic definitions and lemmas -/
section defs

/-- Interpret a `add_monoid_algebra` as a homogenous `direct_sum`. -/
def add_monoid_algebra.to_direct_sum [semiring M] (f : add_monoid_algebra M ι) : ⨁ i : ι, M :=
finsupp.to_dfinsupp f

section
variables [decidable_eq ι] [semiring M]

@[simp] lemma add_monoid_algebra.to_direct_sum_single (i : ι) (m : M) :
  add_monoid_algebra.to_direct_sum (finsupp.single i m) = direct_sum.of _ i m :=
finsupp.to_dfinsupp_single i m

variables [Π m : M, decidable (m ≠ 0)]

/-- Interpret a homogenous `direct_sum` as a `add_monoid_algebra`. -/
def direct_sum.to_add_monoid_algebra (f : ⨁ i : ι, M) :
  add_monoid_algebra M ι :=
dfinsupp.to_finsupp f

@[simp] lemma direct_sum.to_add_monoid_algebra_of (i : ι) (m : M) :
  (direct_sum.of _ i m : ⨁ i : ι, M).to_add_monoid_algebra = finsupp.single i m :=
dfinsupp.to_finsupp_single i m

@[simp] lemma add_monoid_algebra.to_direct_sum_to_add_monoid_algebra (f : add_monoid_algebra M ι) :
  f.to_direct_sum.to_add_monoid_algebra = f :=
finsupp.to_dfinsupp_to_finsupp f

@[simp] lemma direct_sum.to_add_monoid_algebra_to_direct_sum (f : ⨁ i : ι, M) :
  f.to_add_monoid_algebra.to_direct_sum = f :=
dfinsupp.to_finsupp_to_dfinsupp f

end

end defs

/-! ### Lemmas about arithmetic operations -/
section lemmas

namespace add_monoid_algebra

@[simp] lemma to_direct_sum_zero [semiring M] :
  (0 : add_monoid_algebra M ι).to_direct_sum = 0 := finsupp.to_dfinsupp_zero

@[simp] lemma to_direct_sum_add [semiring M] (f g : add_monoid_algebra M ι) :
  (f + g).to_direct_sum = f.to_direct_sum + g.to_direct_sum := finsupp.to_dfinsupp_add _ _

@[simp] lemma to_direct_sum_mul [decidable_eq ι] [add_monoid ι] [semiring M]
  (f g : add_monoid_algebra M ι) :
  (f * g).to_direct_sum = f.to_direct_sum * g.to_direct_sum :=
begin
  let to_hom : add_monoid_algebra M ι →+ (⨁ i : ι, M) :=
    ⟨to_direct_sum, to_direct_sum_zero, to_direct_sum_add⟩,
  show to_hom (f * g) = to_hom f * to_hom g,
  revert f g,
  rw add_monoid_hom.map_mul_iff,
  ext xi xv yi yv : 4,
  dsimp only [add_monoid_hom.comp_apply, add_monoid_hom.compl₂_apply,
    add_monoid_hom.compr₂_apply, add_monoid_hom.mul_apply, add_equiv.coe_to_add_monoid_hom,
    finsupp.single_add_hom_apply],
  simp only [add_monoid_algebra.single_mul_single, to_hom, add_monoid_hom.coe_mk,
      add_monoid_algebra.to_direct_sum_single, direct_sum.of_mul_of, has_mul.ghas_mul_mul]
end

end add_monoid_algebra

namespace direct_sum
variables [decidable_eq ι]

@[simp] lemma to_add_monoid_algebra_zero [semiring M] [Π m : M, decidable (m ≠ 0)] :
  to_add_monoid_algebra 0 = (0 : add_monoid_algebra M ι) := dfinsupp.to_finsupp_zero

@[simp] lemma to_add_monoid_algebra_add [semiring M] [Π m : M, decidable (m ≠ 0)]
  (f g : ⨁ i : ι, M) :
  (f + g).to_add_monoid_algebra = to_add_monoid_algebra f + to_add_monoid_algebra g :=
dfinsupp.to_finsupp_add _ _

@[simp] lemma to_add_monoid_algebra_mul [add_monoid ι] [semiring M] [Π m : M, decidable (m ≠ 0)]
  (f g : ⨁ i : ι, M) :
  (f * g).to_add_monoid_algebra = to_add_monoid_algebra f * to_add_monoid_algebra g :=
begin
  apply_fun add_monoid_algebra.to_direct_sum,
  { simp },
  { apply function.left_inverse.injective,
    apply add_monoid_algebra.to_direct_sum_to_add_monoid_algebra }
end

end direct_sum

end lemmas

/-! ### Bundled `equiv`s -/

section equivs

/-- `add_monoid_algebra.to_direct_sum` and `direct_sum.to_add_monoid_algebra` together form an
equiv. -/
@[simps {fully_applied := ff}]
def add_monoid_algebra_equiv_direct_sum [decidable_eq ι] [semiring M] [Π m : M, decidable (m ≠ 0)] :
  add_monoid_algebra M ι ≃ (⨁ i : ι, M) :=
{ to_fun := add_monoid_algebra.to_direct_sum, inv_fun := direct_sum.to_add_monoid_algebra,
  ..finsupp_equiv_dfinsupp }

/-- The additive version of `add_monoid_algebra.to_add_monoid_algebra`. Note that this is
`noncomputable` because `add_monoid_algebra.has_add` is noncomputable. -/
@[simps {fully_applied := ff}]
def add_monoid_algebra_add_equiv_direct_sum
  [decidable_eq ι] [semiring M] [Π m : M, decidable (m ≠ 0)] :
  add_monoid_algebra M ι ≃+ (⨁ i : ι, M) :=
{ to_fun := add_monoid_algebra.to_direct_sum, inv_fun := direct_sum.to_add_monoid_algebra,
  map_add' := add_monoid_algebra.to_direct_sum_add,
  .. add_monoid_algebra_equiv_direct_sum}

/-- The ring version of `add_monoid_algebra.to_add_monoid_algebra`. Note that this is
`noncomputable` because `add_monoid_algebra.has_add` is noncomputable. -/
@[simps {fully_applied := ff}]
def add_monoid_algebra_ring_equiv_direct_sum
  [decidable_eq ι] [add_monoid ι] [semiring M]
  [Π m : M, decidable (m ≠ 0)] :
  add_monoid_algebra M ι ≃+* ⨁ i : ι, M :=
{ to_fun := add_monoid_algebra.to_direct_sum, inv_fun := direct_sum.to_add_monoid_algebra,
  map_mul' := add_monoid_algebra.to_direct_sum_mul,
  ..(add_monoid_algebra_add_equiv_direct_sum : add_monoid_algebra M ι ≃+ ⨁ i : ι, M) }

/-- The algebra version of `add_monoid_algebra.to_add_monoid_algebra`. Note that this is
`noncomputable` because `add_monoid_algebra.has_add` is noncomputable. -/
@[simps {fully_applied := ff}]
def add_monoid_algebra_alg_equiv_direct_sum
  [decidable_eq ι] [add_monoid ι] [comm_semiring R] [semiring A] [algebra R A]
  [Π m : A, decidable (m ≠ 0)] :
  add_monoid_algebra A ι ≃ₐ[R] ⨁ i : ι, A :=
{ to_fun := add_monoid_algebra.to_direct_sum, inv_fun := direct_sum.to_add_monoid_algebra,
  commutes' := λ r, add_monoid_algebra.to_direct_sum_single _ _,
  ..(add_monoid_algebra_ring_equiv_direct_sum : add_monoid_algebra A ι ≃+* ⨁ i : ι, A) }

end equivs


prelude
import init.core init.system.io init.data.ordering

universes u v w

inductive Rbcolor
| red | black

inductive Rbnode (α : Type u) (β : α → Type v)
| leaf  {}                                                                        : Rbnode
| Node  (c : Rbcolor) (lchild : Rbnode) (key : α) (val : β key) (rchild : Rbnode) : Rbnode

instance Rbcolor.DecidableEq : DecidableEq Rbcolor :=
{decEq := fun a b => Rbcolor.casesOn a
  (Rbcolor.casesOn b (isTrue rfl) (isFalse (fun h => Rbcolor.noConfusion h)))
  (Rbcolor.casesOn b (isFalse (fun h => Rbcolor.noConfusion h)) (isTrue rfl))}

namespace Rbnode
variable {α : Type u} {β : α → Type v} {σ : Type w}

open Rbcolor

def depth (f : Nat → Nat → Nat) : Rbnode α β → Nat
| leaf               => 0
| Node _ l _ _ r     => (f (depth l) (depth r)) + 1

protected def min : Rbnode α β → Option (Sigma (fun k => β k))
| leaf                  => none
| Node _ leaf k v _     => some ⟨k, v⟩
| Node _ l k v _        => min l

protected def max : Rbnode α β → Option (Sigma (fun k => β k))
| leaf                  => none
| Node _ _ k v leaf     => some ⟨k, v⟩
| Node _ _ k v r        => max r

@[specialize] def fold (f : ∀ (k : α), β k → σ → σ) : Rbnode α β → σ → σ
| leaf, b               => b
| Node _ l k v r,     b => fold r (f k v (fold l b))

@[specialize] def revFold (f : ∀ (k : α), β k → σ → σ) : Rbnode α β → σ → σ
| leaf, b               => b
| Node _ l k v r,     b => revFold l (f k v (revFold r b))

@[specialize] def all (p : ∀ (k : α), β k → Bool) : Rbnode α β → Bool
| leaf                 => true
| Node _ l k v r       => p k v && all l && all r

@[specialize] def any (p : ∀ (k : α), β k → Bool) : Rbnode α β → Bool
| leaf               => false
| Node _ l k v r     => p k v || any l || any r

def isRed : Rbnode α β → Bool
| Node red _ _ _ _   => true
| _                  => false

def rotateLeft : ∀ (n : Rbnode α β), n ≠ leaf → Rbnode α β
| n@(Node hc hl hk hv (Node red xl xk xv xr)), _ =>
  if !isRed hl
  then (Node hc (Node red hl hk hv xl) xk xv xr)
  else n
| leaf, h => absurd rfl h
| e, _    => e

theorem ifNodeNodeNeLeaf {c : Prop} [Decidable c] {l1 l2 : Rbnode α β} {c1 k1 v1 r1 c2 k2 v2 r2} : (if c then Node c1 l1 k1 v1 r1 else Node c2 l2 k2 v2 r2) ≠ leaf :=
fun h => if hc : c
then have h1 : (if c then Node c1 l1 k1 v1 r1 else Node c2 l2 k2 v2 r2) = Node c1 l1 k1 v1 r1 from ifPos hc;
     Rbnode.noConfusion (Eq.trans h1.symm h)
else have h1 : (if c then Node c1 l1 k1 v1 r1 else Node c2 l2 k2 v2 r2) = Node c2 l2 k2 v2 r2 from ifNeg hc;
     Rbnode.noConfusion (Eq.trans h1.symm h)

theorem rotateLeftNeLeaf : ∀ (n : Rbnode α β) (h : n ≠ leaf), rotateLeft n h ≠ leaf
| Node _ hl _ _ (Node red _ _ _ _),   _, h  => ifNodeNodeNeLeaf h
| leaf, h, _                                => absurd rfl h
| Node _ _ _ _ (Node black _ _ _ _),   _, h => Rbnode.noConfusion h

def rotateRight : ∀ (n : Rbnode α β), n ≠ leaf → Rbnode α β
| n@(Node hc (Node red xl xk xv xr) hk hv hr), _ =>
  if isRed xl
  then (Node hc xl xk xv (Node red xr hk hv hr))
  else n
| leaf, h => absurd rfl h
| e, _    => e

theorem rotateRightNeLeaf : ∀ (n : Rbnode α β) (h : n ≠ leaf), rotateRight n h ≠ leaf
| Node _ (Node red _ _ _ _) _ _ _,   _, h   => ifNodeNodeNeLeaf h
| leaf, h, _                                => absurd rfl h
| Node _ (Node black _ _ _ _) _ _ _,   _, h => Rbnode.noConfusion h

def flip : Rbcolor → Rbcolor
| red   => black
| black => red

def flipColor : Rbnode α β → Rbnode α β
| Node c l k v r   => Node (flip c) l k v r
| leaf             => leaf

def flipColors : ∀ (n : Rbnode α β), n ≠ leaf → Rbnode α β
| n@(Node c l k v r), _ =>
  if isRed l ∧ isRed r
  then Node (flip c) (flipColor l) k v (flipColor r)
  else n
| leaf, h => absurd rfl h

def fixup (n : Rbnode α β) (h : n ≠ leaf) : Rbnode α β :=
let n₁ := rotateLeft n h;
let h₁ := (rotateLeftNeLeaf n h);
let n₂ := rotateRight n₁ h₁;
let h₂ := (rotateRightNeLeaf n₁ h₁);
flipColors n₂ h₂

def setBlack : Rbnode α β → Rbnode α β
| Node red l k v r   => Node black l k v r
| n                  => n

section insert
variable (lt : α → α → Prop) [DecidableRel lt]

def ins (x : α) (vx : β x) : Rbnode α β → Rbnode α β
| leaf             => Node red leaf x vx leaf
| Node c l k v r   =>
  if lt x k then fixup (Node c (ins l) k v r) (fun h => Rbnode.noConfusion h)
  else if lt k x then fixup (Node c l k v (ins r)) (fun h => Rbnode.noConfusion h)
  else Node c l x vx r

def insert (t : Rbnode α β) (k : α) (v : β k) : Rbnode α β :=
setBlack (ins lt k v t)

end insert

section membership
variable (lt : α → α → Prop)

variable [DecidableRel lt]

def findCore : Rbnode α β → ∀ (k : α), Option (Sigma (fun k => β k))
| leaf,                 x => none
| Node _ a ky vy b,   x =>
  (match cmpUsing lt x ky with
   | Ordering.lt => findCore a x
   | Ordering.Eq => some ⟨ky, vy⟩
   | Ordering.gt => findCore b x)

def find {β : Type v} : Rbnode α (fun _ => β) → α → Option β
| leaf,                 x => none
| Node _ a ky vy b,   x =>
  (match cmpUsing lt x ky with
   | Ordering.lt => find a x
   | Ordering.Eq => some vy
   | Ordering.gt => find b x)

def lowerBound : Rbnode α β → α → Option (Sigma β) → Option (Sigma β)
| leaf,                 x, lb => lb
| Node _ a ky vy b,   x, lb =>
  (match cmpUsing lt x ky with
   | Ordering.lt => lowerBound a x lb
   | Ordering.Eq => some ⟨ky, vy⟩
   | Ordering.gt => lowerBound b x (some ⟨ky, vy⟩))

end membership

inductive WellFormed (lt : α → α → Prop) : Rbnode α β → Prop
| leafWff : WellFormed leaf
| insertWff {n n' : Rbnode α β} {k : α} {v : β k} [DecidableRel lt] : WellFormed n → n' = insert lt n k v → WellFormed n'

end Rbnode

open Rbnode

/- TODO(Leo): define dRbmap -/

def Rbmap (α : Type u) (β : Type v) (lt : α → α → Prop) : Type (max u v) :=
{t : Rbnode α (fun _ => β) // t.WellFormed lt }

@[inline] def mkRbmap (α : Type u) (β : Type v) (lt : α → α → Prop) : Rbmap α β lt :=
⟨leaf, WellFormed.leafWff lt⟩

namespace Rbmap
variable {α : Type u} {β : Type v} {σ : Type w} {lt : α → α → Prop}

def depth (f : Nat → Nat → Nat) (t : Rbmap α β lt) : Nat :=
t.val.depth f

@[inline] def fold (f : α → β → σ → σ) : Rbmap α β lt → σ → σ
| ⟨t, _⟩, b => t.fold f b

@[inline] def revFold (f : α → β → σ → σ) : Rbmap α β lt → σ → σ
| ⟨t, _⟩, b => t.revFold f b

@[inline] def empty : Rbmap α β lt → Bool
| ⟨leaf, _⟩ => true
| _         => false

@[specialize] def toList : Rbmap α β lt → List (α × β)
| ⟨t, _⟩ => t.revFold (fun k v ps => (k, v)::ps) []

@[inline] protected def min : Rbmap α β lt → Option (α × β)
| ⟨t, _⟩ =>
  match t.min with
  | some ⟨k, v⟩ => some (k, v)
  | none        => none

@[inline] protected def max : Rbmap α β lt → Option (α × β)
| ⟨t, _⟩ =>
  match t.max with
  | some ⟨k, v⟩ => some (k, v)
  | none        => none

instance [Repr α] [Repr β] : Repr (Rbmap α β lt) :=
⟨fun t => "rbmapOf " ++ repr t.toList⟩

variable [DecidableRel lt]

def insert : Rbmap α β lt → α → β → Rbmap α β lt
| ⟨t, w⟩,   k, v => ⟨t.insert lt k v, WellFormed.insertWff w rfl⟩

@[specialize] def ofList : List (α × β) → Rbmap α β lt
| []          => mkRbmap _ _ _
| ⟨k,v⟩::xs   => (ofList xs).insert k v

def findCore : Rbmap α β lt → α → Option (Sigma (fun (k : α) => β))
| ⟨t, _⟩, x => t.findCore lt x

def find : Rbmap α β lt → α → Option β
| ⟨t, _⟩, x => t.find lt x

/-- (lowerBound k) retrieves the kv pair of the largest key smaller than or equal to `k`,
    if it exists. -/
def lowerBound : Rbmap α β lt → α → Option (Sigma (fun (k : α) => β))
| ⟨t, _⟩, x => t.lowerBound lt x none

@[inline] def contains (t : Rbmap α β lt) (a : α) : Bool :=
(t.find a).isSome

def fromList (l : List (α × β)) (lt : α → α → Prop) [DecidableRel lt] : Rbmap α β lt :=
l.foldl (fun r p => r.insert p.1 p.2) (mkRbmap α β lt)

@[inline] def all : Rbmap α β lt → (α → β → Bool) → Bool
| ⟨t, _⟩, p => t.all p

@[inline] def any : Rbmap α β lt → (α → β → Bool) → Bool
| ⟨t, _⟩, p => t.any p

end Rbmap

def rbmapOf {α : Type u} {β : Type v} (l : List (α × β)) (lt : α → α → Prop) [DecidableRel lt] : Rbmap α β lt :=
Rbmap.fromList l lt

/- Test -/

@[reducible] def map : Type := Rbmap Nat Bool Less.Less

def mkMapAux : Nat → map → map
| 0, m => m
| n+1,   m => mkMapAux n (m.insert n (n % 10 = 0))

def mkMap (n : Nat) :=
mkMapAux n (mkRbmap Nat Bool Less.Less)

def main (xs : List String) : IO UInt32 :=
let m := mkMap xs.head.toNat;
let v := Rbmap.fold (fun (k : Nat) (v : Bool) (r : Nat) => if v then r + 1 else r) m 0;
IO.println (toString v) *>
pure 0


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.equalizers
import Mathlib.PostPort

universes v u l u₂

namespace Mathlib

/-!
# Split coequalizers

We define what it means for a triple of morphisms `f g : X ⟶ Y`, `π : Y ⟶ Z` to be a split
coequalizer: there is a section `s` of `π` and a section `t` of `g`, which additionally satisfy
`t ≫ f = π ≫ s`.

In addition, we show that every split coequalizer is a coequalizer
(`category_theory.is_split_coequalizer.is_coequalizer`) and absolute
(`category_theory.is_split_coequalizer.map`)

A pair `f g : X ⟶ Y` has a split coequalizer if there is a `Z` and `π : Y ⟶ Z` making `f,g,π` a
split coequalizer.
A pair `f g : X ⟶ Y` has a `G`-split coequalizer if `G f, G g` has a split coequalizer.

These definitions and constructions are useful in particular for the monadicity theorems.

## TODO

Dualise to split equalizers.
-/

namespace category_theory

/--
A split coequalizer diagram consists of morphisms

      f   π
    X ⇉ Y → Z
      g

satisfying `f ≫ π = g ≫ π` together with morphisms

      t   s
    X ← Y ← Z

satisfying `s ≫ π = 𝟙 Z`, `t ≫ g = 𝟙 Y` and `t ≫ f = π ≫ s`.

The name "coequalizer" is appropriate, since any split coequalizer is a coequalizer, see
`category_theory.is_split_coequalizer.is_coequalizer`.
Split coequalizers are also absolute, since a functor preserves all the structure above.
-/
structure is_split_coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    {Z : C} (π : Y ⟶ Z)
    where
  right_section : Z ⟶ Y
  left_section : Y ⟶ X
  condition : f ≫ π = g ≫ π
  right_section_π : right_section ≫ π = 𝟙
  left_section_bottom : left_section ≫ g = 𝟙
  left_section_top : left_section ≫ f = π ≫ right_section

protected instance is_split_coequalizer.inhabited {C : Type u} [category C] {X : C} :
    Inhabited (is_split_coequalizer 𝟙 𝟙 𝟙) :=
  { default := is_split_coequalizer.mk 𝟙 𝟙 sorry sorry sorry sorry }

theorem is_split_coequalizer.condition_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {Z : C} {π : Y ⟶ Z} (c : is_split_coequalizer f g π) {X' : C} (f' : Z ⟶ X') :
    f ≫ π ≫ f' = g ≫ π ≫ f' :=
  sorry

@[simp] theorem is_split_coequalizer.right_section_π_assoc {C : Type u} [category C] {X : C} {Y : C}
    {f : X ⟶ Y} {g : X ⟶ Y} {Z : C} {π : Y ⟶ Z} (c : is_split_coequalizer f g π) {X' : C}
    (f' : Z ⟶ X') : is_split_coequalizer.right_section c ≫ π ≫ f' = f' :=
  sorry

/-- Split coequalizers are absolute: they are preserved by any functor. -/
@[simp] theorem is_split_coequalizer.map_left_section {C : Type u} [category C] {D : Type u₂}
    [category D] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {Z : C} {π : Y ⟶ Z}
    (q : is_split_coequalizer f g π) (F : C ⥤ D) :
    is_split_coequalizer.left_section (is_split_coequalizer.map q F) =
        functor.map F (is_split_coequalizer.left_section q) :=
  Eq.refl (is_split_coequalizer.left_section (is_split_coequalizer.map q F))

/-- A split coequalizer clearly induces a cofork. -/
@[simp] theorem is_split_coequalizer.as_cofork_X {C : Type u} [category C] {X : C} {Y : C}
    {f : X ⟶ Y} {g : X ⟶ Y} {Z : C} {h : Y ⟶ Z} (t : is_split_coequalizer f g h) :
    limits.cocone.X (is_split_coequalizer.as_cofork t) = Z :=
  Eq.refl Z

/--
The cofork induced by a split coequalizer is a coequalizer, justifying the name. In some cases it
is more convenient to show a given cofork is a coequalizer by showing it is split.
-/
def is_split_coequalizer.is_coequalizer {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {Z : C} {h : Y ⟶ Z} (t : is_split_coequalizer f g h) :
    limits.is_colimit (is_split_coequalizer.as_cofork t) :=
  limits.cofork.is_colimit.mk' (is_split_coequalizer.as_cofork t)
    fun (s : limits.cofork f g) =>
      { val := is_split_coequalizer.right_section t ≫ limits.cofork.π s, property := sorry }

/--
The pair `f,g` is a split pair if there is a `h : Y ⟶ Z` so that `f, g, h` forms a split coequalizer
in `C`.
-/
class has_split_coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) where
  splittable : Exists fun {Z : C} => ∃ (h : Y ⟶ Z), Nonempty (is_split_coequalizer f g h)

/--
The pair `f,g` is a `G`-split pair if there is a `h : G Y ⟶ Z` so that `G f, G g, h` forms a split
coequalizer in `D`.
-/
def functor.is_split_pair {C : Type u} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {X : C}
    {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  has_split_coequalizer (functor.map G f) (functor.map G g)

/-- Get the coequalizer object from the typeclass `is_split_pair`. -/
def has_split_coequalizer.coequalizer_of_split {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_split_coequalizer f g] : C :=
  Exists.some (has_split_coequalizer.splittable f g)

/-- Get the coequalizer morphism from the typeclass `is_split_pair`. -/
def has_split_coequalizer.coequalizer_π {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_split_coequalizer f g] : Y ⟶ has_split_coequalizer.coequalizer_of_split f g :=
  Exists.some sorry

/-- The coequalizer morphism `coequalizer_ι` gives a split coequalizer on `f,g`. -/
def has_split_coequalizer.is_split_coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_split_coequalizer f g] :
    is_split_coequalizer f g (has_split_coequalizer.coequalizer_π f g) :=
  Classical.choice sorry

/-- If `f, g` is split, then `G f, G g` is split. -/
protected instance map_is_split_pair {C : Type u} [category C] {D : Type u₂} [category D]
    (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_split_coequalizer f g] :
    has_split_coequalizer (functor.map G f) (functor.map G g) :=
  has_split_coequalizer.mk
    (Exists.intro (functor.obj G (has_split_coequalizer.coequalizer_of_split f g))
      (Exists.intro (functor.map G (has_split_coequalizer.coequalizer_π f g))
        (Nonempty.intro
          (is_split_coequalizer.map (has_split_coequalizer.is_split_coequalizer f g) G))))

namespace limits

/-- If a pair has a split coequalizer, it has a coequalizer. -/
protected instance has_coequalizer_of_has_split_coequalizer {C : Type u} [category C] {X : C}
    {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_split_coequalizer f g] : has_coequalizer f g :=
  has_colimit.mk
    (colimit_cocone.mk
      (is_split_coequalizer.as_cofork (has_split_coequalizer.is_split_coequalizer f g))
      (is_split_coequalizer.is_coequalizer (has_split_coequalizer.is_split_coequalizer f g)))

end Mathlib


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Eric Wieser
-/
import algebra.group.prod
import group_theory.group_action.defs

/-!
# Prod instances for additive and multiplicative actions

This file defines instances for binary product of additive and multiplicative actions and provides
scalar multiplication as a homomorphism from `α × β` to `β`.

## Main declarations

* `smul_mul_hom`/`smul_monoid_hom`: Scalar multiplication bundled as a multiplicative/monoid
  homomorphism.

## See also

* `group_theory.group_action.pi`
* `group_theory.group_action.sigma`
* `group_theory.group_action.sum`
-/

variables {M N P α β : Type*}

namespace prod

section

variables [has_smul M α] [has_smul M β] [has_smul N α] [has_smul N β] (a : M) (x : α × β)

@[to_additive prod.has_vadd] instance : has_smul M (α × β) := ⟨λa p, (a • p.1, a • p.2)⟩

@[simp, to_additive] theorem smul_fst : (a • x).1 = a • x.1 := rfl
@[simp, to_additive] theorem smul_snd : (a • x).2 = a • x.2 := rfl
@[simp, to_additive] theorem smul_mk (a : M) (b : α) (c : β) : a • (b, c) = (a • b, a • c) := rfl
@[to_additive] theorem smul_def (a : M) (x : α × β) : a • x = (a • x.1, a • x.2) := rfl
@[simp, to_additive] theorem smul_swap : (a • x).swap = a • x.swap := rfl

instance [has_smul M N] [is_scalar_tower M N α] [is_scalar_tower M N β] :
  is_scalar_tower M N (α × β) :=
⟨λ x y z, mk.inj_iff.mpr ⟨smul_assoc _ _ _, smul_assoc _ _ _⟩⟩

@[to_additive] instance [smul_comm_class M N α] [smul_comm_class M N β] :
  smul_comm_class M N (α × β) :=
{ smul_comm := λ r s x, mk.inj_iff.mpr ⟨smul_comm _ _ _, smul_comm _ _ _⟩ }

instance [has_smul Mᵐᵒᵖ α] [has_smul Mᵐᵒᵖ β] [is_central_scalar M α] [is_central_scalar M β] :
  is_central_scalar M (α × β) :=
⟨λ r m, prod.ext (op_smul_eq_smul _ _) (op_smul_eq_smul _ _)⟩

@[to_additive]
instance has_faithful_smul_left [has_faithful_smul M α] [nonempty β] :
  has_faithful_smul M (α × β) :=
⟨λ x y h, let ⟨b⟩ := ‹nonempty β› in eq_of_smul_eq_smul $ λ a : α, by injection h (a, b)⟩

@[to_additive]
instance has_faithful_smul_right [nonempty α] [has_faithful_smul M β] :
  has_faithful_smul M (α × β) :=
⟨λ x y h, let ⟨a⟩ := ‹nonempty α› in eq_of_smul_eq_smul $ λ b : β, by injection h (a, b)⟩

end

@[to_additive]
instance smul_comm_class_both [has_mul N] [has_mul P] [has_smul M N] [has_smul M P]
  [smul_comm_class M N N] [smul_comm_class M P P] :
  smul_comm_class M (N × P) (N × P) :=
⟨λ c x y, by simp [smul_def, mul_def, mul_smul_comm]⟩

instance is_scalar_tower_both [has_mul N] [has_mul P] [has_smul M N] [has_smul M P]
  [is_scalar_tower M N N] [is_scalar_tower M P P] :
  is_scalar_tower M (N × P) (N × P) :=
⟨λ c x y, by simp [smul_def, mul_def, smul_mul_assoc]⟩

@[to_additive] instance {m : monoid M} [mul_action M α] [mul_action M β] : mul_action M (α × β) :=
{ mul_smul  := λ a₁ a₂ p, mk.inj_iff.mpr ⟨mul_smul _ _ _, mul_smul _ _ _⟩,
  one_smul  := λ ⟨b, c⟩, mk.inj_iff.mpr ⟨one_smul _ _, one_smul _ _⟩ }

instance {R M N : Type*} {r : monoid R} [add_monoid M] [add_monoid N]
  [distrib_mul_action R M] [distrib_mul_action R N] : distrib_mul_action R (M × N) :=
{ smul_add  := λ a p₁ p₂, mk.inj_iff.mpr ⟨smul_add _ _ _, smul_add _ _ _⟩,
  smul_zero := λ a, mk.inj_iff.mpr ⟨smul_zero _, smul_zero _⟩ }

instance {R M N : Type*} {r : monoid R} [monoid M] [monoid N]
  [mul_distrib_mul_action R M] [mul_distrib_mul_action R N] : mul_distrib_mul_action R (M × N) :=
{ smul_mul  := λ a p₁ p₂, mk.inj_iff.mpr ⟨smul_mul' _ _ _, smul_mul' _ _ _⟩,
  smul_one := λ a, mk.inj_iff.mpr ⟨smul_one _, smul_one _⟩ }

end prod

/-! ### Scalar multiplication as a homomorphism -/

section bundled_smul

/-- Scalar multiplication as a multiplicative homomorphism. -/
@[simps]
def smul_mul_hom [monoid α] [has_mul β] [mul_action α β] [is_scalar_tower α β β]
  [smul_comm_class α β β] :
  (α × β) →ₙ* β :=
{ to_fun := λ a, a.1 • a.2,
  map_mul' := λ a b, (smul_mul_smul _ _ _ _).symm }

/-- Scalar multiplication as a monoid homomorphism. -/
@[simps]
def smul_monoid_hom [monoid α] [mul_one_class β] [mul_action α β] [is_scalar_tower α β β]
  [smul_comm_class α β β] :
  α × β →* β :=
{ map_one' := one_smul _ _,
  .. smul_mul_hom }

end bundled_smul


/- Introduces renaming and substitution on terms and values. -/
import sesh.term

/- The type of renaming functions which transport indices
   from one precontext to another. -/
def ren_fn (γ δ) := Π (A: tp), γ ∋ A → δ ∋ A

namespace ren_fn
open debrujin_idx

/- A renaming function which moves every index/variable up once. -/
@[reducible]
def lift_once {γ: precontext} (B: tp): ren_fn γ (B::γ) := (λ A, @SVar γ A B)

@[reducible]
def lift_over (γ: precontext) (A B: tp): ren_fn (A::γ) (A::B::γ)
| _ (ZVar _ _) := ZVar _ _
| _ (SVar _ x) := SVar _ (SVar _ x)

@[reducible]
def lift_over_two (γ: precontext) (A B C: tp): ren_fn (A::B::γ) (A::B::C::γ)
| _ (ZVar _ _) := ZVar _ _
| _ (SVar _ (ZVar _ _)) := SVar _ (ZVar _ _)
| _ (SVar _ (SVar _ x)) := SVar _ (SVar _ (SVar _ x))

/- The extended ren_fn is identical, but has an extended precontext in the type. -/
def ext {γ δ} (ρ: ren_fn γ δ) (A: tp): ren_fn (A::γ) (A::δ)
| _ (ZVar _ B) := (ZVar _ B)
| B (SVar C x) := SVar C (ρ B x)

@[simp] lemma ext_zvar {γ δ} {ρ: ren_fn γ δ} {A: tp}
  : ext ρ A _ (ZVar _ A) = (ZVar _ A) := by refl

@[unfold_] lemma ext_svar {γ δ} {ρ: ren_fn γ δ} {A B: tp} {x: γ ∋ B}
  : ext ρ A B (SVar A x) = SVar A (ρ B x) := by refl

end ren_fn

namespace term

/- Applies the renaming ρ to a term M. The resulting term
   is the same one and has the same type, but its context
   is Γ times the identity matrix. This has the effect of
   simply appending one or more zero-resourced bindings to
   Γ, and since we treat those as non-existent, the context
   is essentially the same. -/
def rename: Π {γ δ: precontext} {Γ: context γ} {A: tp}
  (ρ: ren_fn γ δ)
  (Δ: context δ)
  (M: term Γ A)
  (h: auto_param (Δ = Γ ⊛ (λ B x, matrix.identity δ B $ ρ B x)) ``solve_context),
  term Δ A
/- In most cases we have to carry through a proof
   that the context of the resulting term is the right
   one. In cases where variable bindings are introduced,
   the body under the binder also has to be `convert`ed
   by constructing a proof that the lifted context is still
   the right one. -/
| _ _ _ _ ρ _ (Var Γ x _) h  := Var _ (ρ _ x)
| _ _ _ _ ρ _ (Abs e) h := Abs (rename (ρ.ext _) _ e)
| _ _ _ _ ρ _ (App _ M N _) h := App _ (rename ρ _ M) (rename ρ _ N)
| _ _ _ _ _ _ (Unit _ _) h := Unit _
| _ _ _ _ ρ _ (LetUnit _ M N _) h := LetUnit _ (rename ρ _ M) (rename ρ _ N)
| _ _ _ _ ρ _ (Pair _ M N _) h := Pair _ (rename ρ _ M) (rename ρ _ N)
| _ δ _ _ ρ _ (LetPair Γ M N _) h := LetPair
  _
  (rename ρ _ M)
  (rename ((ρ.ext _).ext _) _ N)
| _ δ _ _ ρ _ (Case Γ L M N _) h := Case
  _
  (rename ρ _ L)
  (rename (ρ.ext _) _ M)
  (rename (ρ.ext _) _ N)
| _ _ _ _ ρ _ (Send _ M N _) h := Send _ (rename ρ _ M) (rename ρ _ N)
| _ _ _ _ ρ _ (Inl B e) h := Inl B (rename ρ _ e)
| _ _ _ _ ρ _ (Inr A e) h := Inr A (rename ρ _ e)
| _ _ _ _ ρ _ (Fork e) h := Fork (rename ρ _ e)
| _ _ _ _ ρ _ (Recv e) h := Recv (rename ρ _ e)
| _ _ _ _ ρ _ (Wait e) h := Wait (rename ρ _ e)

def lift_once {γ: precontext} {Γ: context γ} {A: tp}
  (M: term Γ A)
  (B: tp)
  : term (⟦0⬝B⟧::Γ) A :=
rename (ren_fn.lift_once B) _ M

end term

namespace value

lemma rename:
  ∀ {γ δ}
    {Γ: context γ} {A: tp}
    {V: term Γ A}
  (h: value V)
  (ρ: ren_fn γ δ),
  value (term.rename ρ _ V (by solve_context))
| _ _ _ _ _ (VVar _ x _) ρ := VVar _ (ρ _ x)
| _ _ _ _ _ (VAbs M) ρ :=
  VAbs $ term.rename (ρ.ext _) _ M
| _ _ _ _ _ (VUnit _ _) ρ := VUnit _
| _ _ _ _ _ (VPair _ _ hM hN) ρ :=
  VPair
    _ (by solve_context)
    (hM.rename ρ)
    (hN.rename ρ)
| _ _ _ _ _ (VInl B hM) ρ := VInl B (hM.rename ρ)
| _ _ _ _ _ (VInr B hM) ρ := VInr B (hM.rename ρ)

end value

/- For every variable x in γ, (σ _ x) where (σ: sub_fn Ξ) returns
   the term which should be substituted into that variable. The
   resource requirements of that term can be extracted out of
   the matrix Ξ. -/
def sub_fn {γ δ} (Ξ: matrix γ δ) :=
  Π (A: tp) (x: γ ∋ A), term (Ξ A x) A

namespace sub_fn
open debrujin_idx
open term

/- Extends the substitution given by Ξ into one over contexts extended with T. -/
def ext {γ δ} {Ξ: matrix γ δ} (σ: sub_fn Ξ) (A: tp)
  : sub_fn (Ξ.ext A)
| _ (ZVar _ A) := Var _ (ZVar _ A)
| B (SVar _ x) := rename (ren_fn.lift_once A) _ (σ B x)

end sub_fn

namespace term
open debrujin_idx

/- Applies simultaneous substitution, replacing all variables
   in a term with whatever the matrix Ξ contains. -/
def subst
  : Π {γ δ} {Γ: context γ} {Ξ: matrix γ δ} {A}
    (σ: sub_fn Ξ)
    (Δ: context δ)
    (M: term Γ A)
    (h: auto_param (Δ = Γ ⊛ Ξ) ``solve_context),
    term Δ A
| _ _ _ _ _ σ _ (Var _ x _) _ := cast (by solve_context) $ σ _ x
| _ _ _ _ _ σ _ (Abs M) _ := Abs $ subst (σ.ext _) _ M
| _ _ _ _ _ σ _ (App _ M N _) _ := App _ (subst σ _ M) (subst σ _ N)
| _ _ _ _ _ σ _ (Unit _ _) _ := Unit _
| _ _ _ _ _ σ _ (LetUnit _ M N _) _ := LetUnit _ (subst σ _ M) (subst σ _ N)
| _ _ _ _ _ σ _ (Pair _ M N _) _ := Pair _ (subst σ _ M) (subst σ _ N)
| _ _ Γ Ξ _ σ _ (LetPair _ M N _) _ :=
  LetPair
    _
    (subst σ _ M)
    (subst ((σ.ext _).ext _) _ N)
| _ _ _ _ _ σ _ (Case _ L M N _) _ := Case
  _
  (subst σ _ L)
  (subst (σ.ext _) _ M)
  (subst (σ.ext _) _ N)
| _ _ _ _ _ σ _ (Send _ M N _) _ := Send _ (subst σ _ M) (subst σ _ N)
| _ _ _ _ _ σ _ (Inl B M) _ := Inl B (subst σ _ M)
| _ _ _ _ _ σ _ (Inr A M) _ := Inr A (subst σ _ M)
| _ _ _ _ _ σ _ (Fork M) _ := Fork (subst σ _ M)
| _ _ _ _ _ σ _ (Recv M) _ := Recv (subst σ _ M)
| _ _ _ _ _ σ _ (Wait M) _ := Wait (subst σ _ M)

def ssub_mat {γ} (Γ: context γ) (A: tp)
  : matrix (A::γ) γ
| _ (ZVar _ _) := Γ
| B (SVar _ x) := matrix.identity γ B x

def ssub_sub {γ} {A: tp} (Γ: context γ) (M: term Γ A)
  : sub_fn (ssub_mat Γ A)
| _ (ZVar _ _) := M
| _ (SVar _ x) := Var _ x (begin unfold ssub_mat, simp end)

def ssubst {γ} {Γ Γ': context γ} {A B: tp} {π: mult}
  (Δ: context γ)
  (e: term (⟦π⬝B⟧::Γ) A) -- The term being sub'd into requires π Bs
  (s: term Γ' B) -- The sub'd term requires Γ'
  (_: auto_param (Δ = Γ + π•Γ') ``solve_context)
  -------------------
  : term Δ A := subst (ssub_sub Γ' s) _ e
  (begin
    simp with unfold_, unfold ssub_mat, solve_context,
  end)

def dsub_mat {γ} (Γ₁ Γ₂: context γ) (A B: tp)
  : matrix (A::B::γ) γ
| _ (ZVar _ _) := Γ₁
| _ (SVar _ $ ZVar _ _) := Γ₂
| C (SVar _ $ SVar _ x) := matrix.identity γ C x

def dsub_sub {γ} {A B: tp} (Γ₁ Γ₂: context γ) (M: term Γ₁ A) (N: term Γ₂ B)
  : sub_fn (dsub_mat Γ₁ Γ₂ A B)
| _ (ZVar _ _) := M
| _ (SVar _ $ ZVar _ _) := N
| _ (SVar _ $ SVar _ x) := Var _ x (begin unfold dsub_mat, simp end)

def dsubst {γ} {Γ Γ₁ Γ₂: context γ} {A B₁ B₂: tp} {π₁ π₂: mult}
  (Δ: context γ)
  (e: term (⟦π₁⬝B₁⟧::⟦π₂⬝B₂⟧::Γ) A)
  (s₁: term Γ₁ B₁)
  (s₂: term Γ₂ B₂)
  (_: auto_param (Δ = Γ + π₁•Γ₁ + π₂•Γ₂) ``solve_context)
  ----------------
  : term Δ A :=
    subst (dsub_sub Γ₁ Γ₂ s₁ s₂) _ e
    (begin
      simp with unfold_, unfold dsub_mat, solve_context,
    end)

end term


namespace melting_point.set

universe u

theorem union.comm {α : Type u} (a b : set α) : a ∪ b = b ∪ a :=
begin funext x, apply propext, apply or.comm end

theorem inter.comm {α : Type u} (a b : set α) : a ∩ b = b ∩ a :=
begin funext x, apply propext, apply and.comm end

theorem union.empty {α : Type u} (a : set α) : a ∪ ∅ = a := begin
  funext x, apply propext, split,
  { intro h, cases h, exact h, cases h },
  { apply or.inl }
end

theorem inter.empty {α : Type u} (a : set α) : a ∩ ∅ = ∅ := begin
  funext x, apply propext, split; intro h,
  { cases h with a b, cases b },
  { cases h }
end

theorem union.univ {α : Type u} (a : set α) : a ∪ set.univ = set.univ := begin
  funext x, apply propext, split; intro h,
  { cases h; trivial },
  { apply or.inr, assumption }
end

theorem inter.univ {α : Type u} (a : set α) : a ∩ set.univ = a := begin
  funext x, apply propext, split; intro h,
  { cases h with n m, exact n },
  { split, exact h, trivial }
end

theorem union.id {α : Type u} (a : set α) : a ∪ a = a := begin
  funext x, apply propext, split,
  { intro h, cases h with a b, exact a, exact b },
  { intro h, apply or.inl, exact h }
end

theorem inter.id {α : Type u} (a : set α) : a ∩ a = a := begin
  funext x, apply propext, split,
  { intro h, cases h with a b, exact a },
  { intro h, split, repeat { exact h } }
end

def countable {α : Type u} (s : set α) :=
∃ (f : subtype s → ℕ), function.injective f

end melting_point.set


example (x y z : Prop) (f : x → y → z) (xp : x) (yp : y) : z := by
  specialize f xp yp
  assumption

example (B C : Prop) (f : forall (A : Prop), A → C) (x : B) : C := by
  specialize f _ x
  exact f

example (B C : Prop) (f : forall {A : Prop}, A → C) (x : B) : C := by
  specialize f x
  exact f

example (B C : Prop) (f : forall {A : Prop}, A → C) (x : B) : C := by
  specialize @f _ x
  exact f

example (X : Type) [Add X] (f : forall {A : Type} [Add A], A → A → A) (x : X) : X := by
  specialize f x x
  assumption

def ex (f : Nat → Nat → Nat) : Nat := by
  specialize f _ _
  exact 10
  exact 2
  exact f

example : ex (· - ·) = 8 :=
  rfl


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/

import tactic.rcases

universe u
variables {α β γ : Type u}

example (x : α × β × γ) : true :=
begin
  rcases x with ⟨a, b, c⟩,
  { guard_hyp a : α,
    guard_hyp b : β,
    guard_hyp c : γ,
    trivial }
end

example (x : α × β × γ) : true :=
begin
  rcases x with ⟨a, ⟨-, c⟩⟩,
  { guard_hyp a : α,
    success_if_fail { guard_hyp x_snd_fst : β },
    guard_hyp c : γ,
    trivial }
end

example (x : (α × β) × γ) : true :=
begin
  rcases x with ⟨⟨a:α, b⟩, c⟩,
  { guard_hyp a : α,
    guard_hyp b : β,
    guard_hyp c : γ,
    trivial }
end

example : inhabited α × option β ⊕ γ → true :=
begin
  rintro (⟨⟨a⟩, _ | b⟩ | c),
  { guard_hyp a : α, trivial },
  { guard_hyp a : α, guard_hyp b : β, trivial },
  { guard_hyp c : γ, trivial }
end

example : cond ff ℕ ℤ → cond tt ℤ ℕ → (ℕ ⊕ unit) → true :=
begin
  rintro (x y : ℤ) (z | u),
  { guard_hyp x : ℤ, guard_hyp y : ℤ, guard_hyp z : ℕ, trivial },
  { guard_hyp x : ℤ, guard_hyp y : ℤ, guard_hyp u : unit, trivial }
end

example (x y : ℕ) (h : x = y) : true :=
begin
  rcases x with _|⟨⟩|z,
  { guard_hyp h : nat.zero = y, trivial },
  { guard_hyp h : nat.succ nat.zero = y, trivial },
  { guard_hyp z : ℕ,
    guard_hyp h : z.succ.succ = y, trivial },
end

-- from equiv.sum_empty
example (s : α ⊕ empty) : true :=
begin
  rcases s with _ | ⟨⟨⟩⟩,
  { guard_hyp s : α, trivial }
end

example : true :=
begin
  obtain ⟨n : ℕ, h : n = n, -⟩ : ∃ n : ℕ, n = n ∧ true,
  { existsi 0, simp },
  guard_hyp n : ℕ,
  guard_hyp h : n = n,
  success_if_fail {assumption},
  trivial
end

example : true :=
begin
  obtain : ∃ n : ℕ, n = n ∧ true,
  { existsi 0, simp },
  trivial
end

example : true :=
begin
  obtain (h : true) | ⟨⟨⟩⟩ : true ∨ false,
  { left, trivial },
  guard_hyp h : true,
  trivial
end

example : true :=
begin
  obtain h | ⟨⟨⟩⟩ : true ∨ false := or.inl trivial,
  guard_hyp h : true,
  trivial
end

example : true :=
begin
  obtain ⟨h, h2⟩ := and.intro trivial trivial,
  guard_hyp h : true,
  guard_hyp h2 : true,
  trivial
end

example : true :=
begin
  success_if_fail {obtain ⟨h, h2⟩},
  trivial
end

example (x y : α × β) : true :=
begin
  rcases ⟨x, y⟩ with ⟨⟨a, b⟩, c, d⟩,
  { guard_hyp a : α,
    guard_hyp b : β,
    guard_hyp c : α,
    guard_hyp d : β,
    trivial }
end

example (x y : α ⊕ β) : true :=
begin
  obtain ⟨a|b, c|d⟩ := ⟨x, y⟩,
  { guard_hyp a : α, guard_hyp c : α, trivial },
  { guard_hyp a : α, guard_hyp d : β, trivial },
  { guard_hyp b : β, guard_hyp c : α, trivial },
  { guard_hyp b : β, guard_hyp d : β, trivial },
end

example {i j : ℕ} : (Σ' x, i ≤ x ∧ x ≤ j) → i ≤ j :=
begin
  intro h,
  rcases h' : h with ⟨x,h₀,h₁⟩,
  guard_hyp h' : h = ⟨x,h₀,h₁⟩,
  apply le_trans h₀ h₁,
end

protected def set.foo {α β} (s : set α) (t : set β) : set (α × β) := ∅

example {α} (V : set α) (w : true → ∃ p, p ∈ (V.foo V) ∩ (V.foo V)) : true :=
begin
  obtain ⟨a, h⟩ : ∃ p, p ∈ (V.foo V) ∩ (V.foo V) := w trivial,
  trivial,
end

example (n : ℕ) : true :=
begin
  obtain one_lt_n | n_le_one : 1 < n + 1 ∨ n + 1 ≤ 1 := nat.lt_or_ge 1 (n + 1),
  trivial, trivial,
end

example (n : ℕ) : true :=
begin
  obtain one_lt_n | (n_le_one : n + 1 ≤ 1) := nat.lt_or_ge 1 (n + 1),
  trivial, trivial,
end

example (h : ∃ x : ℕ, x = x ∧ 1 = 1) : true :=
begin
  rcases h with ⟨-, _⟩,
  (do lc ← tactic.local_context, guard lc.empty),
  trivial
end

example (h : ∃ x : ℕ, x = x ∧ 1 = 1) : true :=
begin
  rcases h with ⟨-, _, h⟩,
  (do lc ← tactic.local_context, guard (lc.length = 1)),
  guard_hyp h : 1 = 1,
  trivial
end

example (h : true ∨ true ∨ true) : true :=
begin
  rcases h with -|-|-,
  iterate 3 {
    (do lc ← tactic.local_context, guard lc.empty),
    trivial },
end

example : bool → false → true
| ff := by rintro ⟨⟩
| tt := by rintro ⟨⟩

open tactic
meta def test_rcases_hint (s : string) (num_goals : ℕ) (depth := 5) : tactic unit :=
do change `(true),
  h ← get_local `h,
  pat ← rcases_hint ```(h) depth,
  p ← pp pat,
  guard (p.to_string = s) <|> fail format!"got '{p.to_string}', expected: '{s}'",
  gs ← get_goals,
  guard (gs.length = num_goals) <|> fail format!"there are {gs.length} goals remaining",
  all_goals triv $> ()

example {α} (h : ∃ x : α, x = x) := by test_rcases_hint "⟨h_w, ⟨⟩⟩" 1
example (h : true ∨ true ∨ true) := by test_rcases_hint "⟨⟨⟩⟩ | ⟨⟨⟩⟩ | ⟨⟨⟩⟩" 3
example (h : ℕ) := by test_rcases_hint "_ | _ | h" 3 2
example {p} (h : (p ∧ p) ∨ (p ∧ p)) :=
by test_rcases_hint "⟨h_left, h_right⟩ | ⟨h_left, h_right⟩" 2
example {p} (h : (p ∧ p) ∨ (p ∧ (p ∨ p))) :=
by test_rcases_hint "⟨h_left, h_right⟩ | ⟨h_left, h_right | h_right⟩" 3
example {p} (h : p ∧ (p ∨ p)) :=
by test_rcases_hint "⟨h_left, h_right | h_right⟩" 2
example (h : 0 < 2) := by test_rcases_hint "_ | ⟨_, _ | ⟨_, ⟨⟩⟩⟩" 1
example (h : 3 < 2) := by test_rcases_hint "_ | ⟨_, _ | ⟨_, ⟨⟩⟩⟩" 0
example (h : 3 < 0) := by test_rcases_hint "⟨⟩" 0
example (h : false) := by test_rcases_hint "⟨⟩" 0
example (h : true) := by test_rcases_hint "⟨⟩" 1
example {α} (h : list α) := by test_rcases_hint "_ | ⟨h_hd, _ | ⟨h_tl_hd, h_tl_tl⟩⟩" 3 2
example {α} (h : (α ⊕ α) × α) := by test_rcases_hint "⟨h_fst | h_fst, h_snd⟩" 2 2

inductive foo (α : Type) : ℕ → Type
| zero : foo 0
| one (m) : α → foo m

example {α} (h : foo α 0) : true := by test_rcases_hint "_ | ⟨_, h_ᾰ⟩" 2
example {α} (h : foo α 1) : true := by test_rcases_hint "_ | ⟨_, h_ᾰ⟩" 1
example {α n} (h : foo α n) : true := by test_rcases_hint "_ | ⟨n, h_ᾰ⟩" 2 1

example {α} (V : set α) (h : ∃ p, p ∈ (V.foo V) ∩ (V.foo V)) :=
by test_rcases_hint "⟨⟨h_w_fst, h_w_snd⟩, ⟨⟩⟩" 0


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import category_theory.natural_transformation
import category_theory.isomorphism

/-!
# The category of functors and natural transformations between two fixed categories.

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

We provide the category instance on `C ⥤ D`, with morphisms the natural transformations.

## Universes

If `C` and `D` are both small categories at the same universe level,
this is another small category at that level.
However if `C` and `D` are both large categories at the same universe level,
this is a small category at the next higher level.
-/

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ u₁ u₂ u₃

open nat_trans category category_theory.functor

variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

local attribute [simp] vcomp_app
/--
`functor.category C D` gives the category structure on functors and natural transformations
between categories `C` and `D`.

Notice that if `C` and `D` are both small categories at the same universe level,
this is another small category at that level.
However if `C` and `D` are both large categories at the same universe level,
this is a small category at the next higher level.
-/
instance functor.category : category.{(max u₁ v₂)} (C ⥤ D) :=
{ hom     := λ F G, nat_trans F G,
  id      := λ F, nat_trans.id F,
  comp    := λ _ _ _ α β, vcomp α β }

variables {C D} {E : Type u₃} [category.{v₃} E]
variables {F G H I : C ⥤ D}

namespace nat_trans

@[simp] lemma vcomp_eq_comp (α : F ⟶ G) (β : G ⟶ H) : vcomp α β = α ≫ β := rfl

lemma vcomp_app' (α : F ⟶ G) (β : G ⟶ H) (X : C) :
  (α ≫ β).app X = (α.app X) ≫ (β.app X) := rfl

lemma congr_app {α β : F ⟶ G} (h : α = β) (X : C) : α.app X = β.app X := by rw h
@[simp] lemma id_app (F : C ⥤ D) (X : C) : (𝟙 F : F ⟶ F).app X = 𝟙 (F.obj X) := rfl
@[simp] lemma comp_app {F G H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) (X : C) :
  (α ≫ β).app X = α.app X ≫ β.app X := rfl

lemma app_naturality {F G : C ⥤ (D ⥤ E)} (T : F ⟶ G) (X : C) {Y Z : D} (f : Y ⟶ Z) :
  ((F.obj X).map f) ≫ ((T.app X).app Z) = ((T.app X).app Y) ≫ ((G.obj X).map f) :=
(T.app X).naturality f

lemma naturality_app {F G : C ⥤ (D ⥤ E)} (T : F ⟶ G) (Z : D) {X Y : C} (f : X ⟶ Y) :
  ((F.map f).app Z) ≫ ((T.app Y).app Z) = ((T.app X).app Z) ≫ ((G.map f).app Z) :=
congr_fun (congr_arg app (T.naturality f)) Z

/-- A natural transformation is a monomorphism if each component is. -/
lemma mono_of_mono_app (α : F ⟶ G) [∀ (X : C), mono (α.app X)] : mono α :=
⟨λ H g h eq, by { ext X, rw [←cancel_mono (α.app X), ←comp_app, eq, comp_app] }⟩

/-- A natural transformation is an epimorphism if each component is. -/

/-- `hcomp α β` is the horizontal composition of natural transformations. -/
@[simps] def hcomp {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) : (F ⋙ H) ⟶ (G ⋙ I) :=
{ app         := λ X : C, (β.app (F.obj X)) ≫ (I.map (α.app X)),
  naturality' := λ X Y f,
  begin
    rw [functor.comp_map, functor.comp_map, ←assoc, naturality, assoc,
        ←map_comp I, naturality, map_comp, assoc]
  end }

infix ` ◫ `:80 := hcomp

@[simp] lemma hcomp_id_app {H : D ⥤ E} (α : F ⟶ G) (X : C) : (α ◫ 𝟙 H).app X = H.map (α.app X) :=
  by {dsimp, simp} -- See note [dsimp, simp].

lemma id_hcomp_app {H : E ⥤ C} (α : F ⟶ G) (X : E) : (𝟙 H ◫ α).app X = α.app _ := by simp

-- Note that we don't yet prove a `hcomp_assoc` lemma here: even stating it is painful, because we
-- need to use associativity of functor composition. (It's true without the explicit associator,
-- because functor composition is definitionally associative,
-- but relying on the definitional equality causes bad problems with elaboration later.)

lemma exchange {I J K : D ⥤ E} (α : F ⟶ G) (β : G ⟶ H)
  (γ : I ⟶ J) (δ : J ⟶ K) : (α ≫ β) ◫ (γ ≫ δ) = (α ◫ γ) ≫ (β ◫ δ) :=
by ext; simp

end nat_trans
open nat_trans
namespace functor

/-- Flip the arguments of a bifunctor. See also `currying.lean`. -/
@[simps] protected def flip (F : C ⥤ (D ⥤ E)) : D ⥤ (C ⥤ E) :=
{ obj := λ k,
  { obj := λ j, (F.obj j).obj k,
    map := λ j j' f, (F.map f).app k,
    map_id' := λ X, begin rw category_theory.functor.map_id, refl end,
    map_comp' := λ X Y Z f g, by rw [map_comp, ←comp_app] },
  map := λ c c' f,
  { app := λ j, (F.obj j).map f } }.

end functor

@[simp, reassoc] lemma map_hom_inv_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) :
  (F.map e.hom).app Z ≫ (F.map e.inv).app Z = 𝟙 _ :=
by simp [← nat_trans.comp_app, ← functor.map_comp]

@[simp, reassoc] lemma map_inv_hom_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) :
  (F.map e.inv).app Z ≫ (F.map e.hom).app Z = 𝟙 _ :=
by simp [← nat_trans.comp_app, ← functor.map_comp]

end category_theory


import ...for_mathlib.manifolds
import geometry.manifold.cont_mdiff_mfderiv

noncomputable theory

open_locale manifold classical big_operators
open set

universe u

/-!
## Reminder on updating the exercises

These instructions are now available at:
https://leanprover-community.github.io/lftcm2020/exercises.html

To get a new copy of the exercises,
run the following commands in your terminal:

```
leanproject get lftcm2020
cp -r lftcm2020/src/exercises_sources/ lftcm2020/src/my_exercises
code lftcm2020
```

To update your exercise files, run the following commands:

```
cd /path/to/lftcm2020
git pull
leanproject get-mathlib-cache
```

Don’t forget to copy the updated files to `src/my_exercises`.

-/

/-!
## An overview of manifolds in Lean, discussing design decisions

Warning: there are sorries in this section, they are not supposed to be filled! The exercises sections
start later, and there you will have plenty of sorries to fill.

What is a manifold?

1) allow field other than `ℝ` or `ℂ`?
2) allow infinite dimension?
3) allow boundary?
4) allow model space depending on the point of the manifold?

Bourbaki: 2, 4 (and just definitions and statements, no proofs!)
Lean: 1, 2, 3

Perelman geometrization theorem : any compact connected irreducible 3-manifold can
be cut along tori into finitely many pieces, each of which has a _geometric structure_ of
finite volume, i.e., it is locally like a model space, with changes of coordinates given
locally by the action of a Lie group

Typical dynamics theorem : let `M` be a compact manifold, and `f : M → M` a map with property
such and such. Then ...

Or : Consider a hyperbolic surface of genus `g`, and a random geodesic of length `T`. How many
times does it typically self-intersect?

Manifold in Lean:

* charted space structure, i.e., set of local homeos to a model space. This is data, fixed
  once and for all (and a typeclass)
* compatibility condition, i.e., the change of coordinates should belong to some subgroup
  of the group of local homeos of the model space. This is Prop (and a typeclass). The same
  manifold can be at the same time an analytic manifold, a smooth manifold and a topological
  manifold (with the same fixed atlas).
* A charted space is a smooth manifold (with corners) if it is compatible with the smooth
  groupoid on the model space. To cover uniformly both situations with and without boundary,
  the smooth groupoid is with respect to a map `I : H → E` (think of `H` as the half-space and
  `E` the full space), which is the identity in the boundaryless situation, the inclusion in
  the half-space situation. This map `I` is called a _model with corners_. The most standard ones
  (identity in `ℝ^n` and inclusion of half-space in `ℝ^n`) have dedicated notations:
  `𝓡 n` and `𝓡∂ n`.
-/

#check charted_space (euclidean_half_space 1) (Icc (0 : ℝ) 1)
#check has_groupoid (Icc (0 : ℝ) 1) (cont_diff_groupoid ∞ (𝓡∂ 1))
#check smooth_manifold_with_corners (𝓡∂ 1) (Icc (0 : ℝ) 1)

-- atlases are not maximal in general

#check (cont_diff_groupoid ∞ (𝓡∂ 1)).maximal_atlas (Icc (0 : ℝ) 1)

-- let's try to put a smooth manifold structure on the sphere
-- (we don't have submanifolds yet, but it's coming in the near future)

@[derive topological_space]
definition sphere (n : ℕ) : Type := metric.sphere (0 : euclidean_space ℝ (fin (n+1))) 1

instance (n : ℕ) : has_coe (sphere n) (euclidean_space ℝ (fin (n+1))) := ⟨subtype.val⟩

instance (n : ℕ) : charted_space (euclidean_space ℝ (fin n)) (sphere n) :=
{ atlas            := begin sorry end,
  chart_at         := begin sorry end,
  mem_chart_source := begin sorry end,
  chart_mem_atlas  := begin sorry end }

instance (n : ℕ) : smooth_manifold_with_corners (𝓡 n) (sphere n) :=
{ compatible := begin
    assume e e' he he',
    sorry
  end }

-- smooth functions

def inc (n : ℕ) : sphere n → euclidean_space ℝ (fin (n+1)) :=
λ p : sphere n, (p : euclidean_space ℝ (fin (n+1)))

lemma inc_smooth (n : ℕ) : cont_mdiff (𝓡 n) (𝓡 (n+1)) ∞ (inc n) :=
begin
  rw cont_mdiff_iff,
  split,
  { exact continuous_subtype_coe, },
  { assume x y,
    sorry }
end

lemma inc_continuous (n : ℕ) : continuous (inc n) :=
(inc_smooth n).continuous

lemma inc_mdifferentiable (n : ℕ) : mdifferentiable (𝓡 n) (𝓡 (n+1)) (inc n) :=
(inc_smooth n).mdifferentiable le_top

-- tangent space and tangent bundles

example (n : ℕ) (p : sphere n) (v : tangent_space (𝓡 n) p) :
  tangent_bundle (𝓡 n) (sphere n) :=
⟨p, v⟩

-- tangent map, derivatives

example (n : ℕ) : cont_mdiff ((𝓡 n).prod (𝓡 n)) ((𝓡 (n+1)).prod (𝓡 (n+1))) ∞
  (tangent_map (𝓡 n) (𝓡 (n+1)) (inc n)) :=
(inc_smooth n).cont_mdiff_tangent_map le_top

example (n : ℕ) (f : sphere n → sphere (n^2)) (p : sphere n) (v : tangent_space (𝓡 n) p) :
  mfderiv (𝓡 n) (𝓡 (n^2)) f p v = (tangent_map (𝓡 n) (𝓡 (n^2)) f ⟨p, v⟩).2 :=
rfl

/- Can you express the sphere eversion theorem, i.e., the fact that there is a smooth isotopy
of immersions between the canonical embedding of the sphere `S^2` and `ℝ^3`, and the antipodal
embedding?

Note that we haven't defined immersions in mathlib, but you can jut require that the fiber
derivative is injective everywhere, which is easy to express if you know that the derivative
of a function `f` from a manifold of dimension `2` to a manifold of dimension `3` at a point `x` is
`mfderiv (𝓡 2) (𝓡 3) f x`.

Don't forget to require the global smoothness of the map! You may need to know that the interval
`[0,1]`, called `Icc (0 : ℝ) 1` in Lean, already has a manifold (with boundary!) structure,
where the corresponding model with corners is called `𝓡∂ 1`.
-/
theorem sphere_eversion :
  ∃ f : (Icc (0 : ℝ) 1) × sphere 2 → euclidean_space ℝ (fin 3),
  cont_mdiff ((𝓡∂ 1).prod (𝓡 2)) (𝓡 3) ∞ f
  ∧ ∀ (t : (Icc (0 : ℝ) 1)), ∀ (p : sphere 2),
    function.injective (mfderiv (𝓡 2) (𝓡 3) (f ∘ λ y, (t, y)) p)
  ∧ ∀ (p : sphere 2), f (0, p) = p
  ∧ ∀ (p : sphere 2), f (1, p) = - p :=
sorry

/- Dicussing three (controversial?) design decisions

#### Local homeos

What is a local homeo `f` between an open subset of `E` and an open subset of `F`?
1) a map defined on a subtype: `f x` only makes sense for `x : f.source`
2) a map defined on the whole space `E`, but taking values in `option F = F ∪ {junk}`, with
  `f x = junk` when `x ∉ f.source`
3) a map defined on the whole space `E`, taking values in `F`, and we don't care about its values
  outside of `f.source`.

Just like division by zero! But worse:

* issue with 1): you keep intersecting chart domains. But the subtype `u ∩ v` is not the same as
  the subtype `v ∩ u`, so you keep adding casts everywhere
* issue with 2): if you want to say that a chart is smooth, then you define to define smooth functions
  between `option E` and `option F` when `E` and `F` are vector spaces. All notions need to be
  redefined with `option`.
* issue with 3): it works perfectly well, but it makes mathematicians unhappy/uneasy (and it is *not*
  equivalent to 1) or 2) when one of the spaces is empty)

I picked 3)

#### Tangent vectors

What is a tangent vector (for a manifold `M` modelled on a vector space `E`)?
1) An equivalence class of germs of curves
2) A derivation
3) Physicist point of view: I don't know what a tangent vector is, but I know in charts.
  Mathematician's interpretation: equivalence class of `(e, v)` where `e` is a chart at `x`, `v` a vector
  in the vector space, and `(e, v) ∼ (e', v')` if `D(e' ∘ e ⁻¹) v = v'`
4) ...

Issues:
1) Pictures are pretty, but this doesn't bring anything compared to 3) when you go down to details.
   And what about boundaries, where you can only have a half-curve
2) Need partitions of unity to show that this is local and coincides with the usual point of view.
   Doesn't work well in finite smoothness, nor in complex manifolds
3) Fine, works in all situations, but requires a lot of work to define the equivalence classes,
   the topology, check that the topology is compatible with the vector space structure, and so on.
   In a vector space, the tangent space is not defeq to the vector space itself
4) Pick one favorite chart at `x`, say `e_x`, and *define* the tangent space at `x` to be `E`,
   but "seen" in the chart `e_x` (this will show up in the definition of the derivative : the
   derivative of `f : M → M'` at `x` is defined to be the derivative of the map
   `e_{f x} ∘ f ∘ e_x⁻¹`). Works perfectly fine, but makes mathematicians unhappy/uneasy.
   (Axiom of choice? In fact we put the choice of `e_x` in the *definition* of charted spaces,
   so not further choice)

I picked 4)

#### Smooth functions in manifolds with boundary

Usual definition of smooth functions in a half space: extend to a smooth function a little bit
beyond the boundary, so one only really needs to speak of smooth functions in open subsets of
vector spaces.

When you define the derivative, you will need to check that it does not depend on the choice
of the extension. Even worse when you want to define the tangent bundle: choose an open extension
of your manifold with boundary, and then check that the restriction of the tangent bundle does
not depend on the choice of the extension. Very easy when handwaving, nightmare to formalize.
(What is the extension of the manifold with boundary? Another type?)

Instead, if you define derivatives in (non-open) domains, you can talk of smooth functions in
domains, and do everything without extending. Need to know this early enough: when starting to
define derivatives, you should already think of manifolds with boundaries! That's what we did
in mathlib.

Difficulty: if a domain `s` is too small (think `s = ℝ ⊆ ℝ^2`), the values of `f` on `s` do not
prescribe uniquely a derivative, so `fderiv_within_at ℝ f s x` may behave badly: the derivative of
a sum might be different from sum of derivatives, as there is an arbitrary choice to be made.
This does not happen with the half-space, as it is large enough: derivatives within domains only
work well if the tangent directions span the whole space. Predicate `unique_diff_on` for sets
in vector spaces. You won't find this in books!
-/

/-! ## Exercises -/

/-! ### Local homeomorphisms

Local homeomorphisms are globally defined maps with a globally defined "inverse", but the only
relevant set is the *source*, which should be mapped homeomorphically to the *target*.
-/

-- set up a simple helper simp lemma to simplify our life later.
@[simp] lemma neg_mem_Ioo_minus_one_one (x : ℝ) : -x ∈ Ioo (-1 : ℝ) 1 ↔ x ∈ Ioo (-1 : ℝ) 1 :=
begin
  sorry
end

/- Define a local homeomorphism from `ℝ` to `ℝ` which is just `x ↦ -x`, but on `(-1, 1)`. In
Lean, the interval `(-1, 1)` is denoted by `Ioo (-1 : ℝ) 1` (where `o` stands for _open_). -/

def my_first_local_homeo : local_homeomorph ℝ ℝ :=
{ to_fun := λ x, -x,
  inv_fun := λ x, -x,
  source := Ioo (-1) 1,
  target := sorry,
  map_source' :=
  begin
    sorry
  end,
  map_target' :=
  begin
    sorry
  end,
  left_inv' :=
  begin
    sorry
  end,
  right_inv' :=
  begin
    sorry
  end,
  open_source := sorry,
  open_target := sorry,
  continuous_to_fun := sorry,
  continuous_inv_fun := sorry }

/- Two simple lemmas that will prove useful below. You can leave them sorried if you like. -/

lemma ne_3_of_mem_Ioo {x : ℝ} (h : x ∈ Ioo (-1 : ℝ) 1) : x ≠ 3 :=
begin
  sorry
end

lemma neg_ne_3_of_mem_Ioo {x : ℝ} (h : x ∈ Ioo (-1 : ℝ) 1) : -x ≠ 3 :=
begin
sorry
end

/- Now, define a second local homeomorphism which is almost like the previous one.  You may find the
following lemma useful for `continuous_to_fun`: -/
#check continuous_on.congr

def my_second_local_homeo : local_homeomorph ℝ ℝ :=
{ to_fun := λ x, if x = 3 then 0 else - x,
  inv_fun := λ x, -x,
  source := Ioo (-1) 1,
  target := sorry,
  map_source' := sorry,
  map_target' := sorry,
  left_inv' := sorry,
  right_inv' := sorry,
  open_source := sorry,
  open_target := sorry,
  continuous_to_fun :=
  begin
    sorry
  end,
  continuous_inv_fun := sorry }

/- Although the two above local homeos are the same for all practical purposes as they coincide
where relevant, they are not *equal*: -/

lemma my_first_local_homeo_ne_my_second_local_homeo :
  my_first_local_homeo ≠ my_second_local_homeo :=
begin
  sorry
end

/- The right equivalence relation for local homeos is not equality, but `eq_on_source`.
Indeed, the two local homeos we have defined above coincide from this point of view. -/

#check local_homeomorph.eq_on_source

lemma eq_on_source_my_first_local_homeo_my_second_local_homeo :
  local_homeomorph.eq_on_source my_first_local_homeo my_second_local_homeo :=
begin
  sorry
end

/-! ### An example of a charted space structure on `ℝ`

A charted space is a topological space together with a set of local homeomorphisms to a model space,
whose sources cover the whole space. For instance, `ℝ` is already endowed with a charted space
structure with model space `ℝ`, where the unique chart is the identity:
-/

#check charted_space_self ℝ

/- For educational purposes only, we will put another charted space structure on `ℝ` using the
local homeomorphisms we have constructed above. To avoid using too much structure of `ℝ` (and to
avoid confusing Lean), we will work with a copy of `ℝ`, on which we will only register the
topology. -/

@[derive topological_space]
def myℝ : Type := ℝ

instance : charted_space ℝ myℝ :=
{ atlas := { local_homeomorph.refl ℝ, my_first_local_homeo },
  chart_at := λ x, if x ∈ Ioo (-1 : ℝ) 1 then my_first_local_homeo else local_homeomorph.refl ℝ,
  mem_chart_source :=
  begin
  sorry
  end,
  chart_mem_atlas :=
  begin
    sorry
  end }

/- Now come more interesting bits. We have endowed `myℝ` with a charted space structure, with charts
taking values in `ℝ`. We want to say that this is a smooth structure, i.e., the changes of
coordinates are smooth. In Lean, this is written with `has_groupoid`. A groupoid is a set
of local homeomorphisms of the model space (for example, local homeos that are smooth on their
domain). A charted space admits the groupoid as a structure groupoid if all the changes of
coordinates belong to the groupoid.

There is a difficulty that the definitions are set up to be able to also speak of smooth manifolds
with boundary or with corners, so the name of the smooth groupoid on `ℝ` has the slightly strange
name `cont_diff_groupoid ∞ (model_with_corners_self ℝ ℝ)`. To avoid typing again and again
`model_with_corners_self ℝ ℝ`, let us introduce a shortcut
-/

abbreviation 𝓡1 := model_with_corners_self ℝ ℝ

/- In the library, there are such shortcuts for manifolds modelled on `ℝ^n`, denoted with `𝓡 n`,
but for `n = 1` this does not coincide with the above one, as `ℝ^1` (a.k.a. `fin 1 → ℝ`) is not
the same as `ℝ`! Still, since they are of the same nature, the notation we have just introduced
is very close, compare `𝓡1` with `𝓡 1` (and try not to get confused): -/

instance smooth_myℝ : has_groupoid myℝ (cont_diff_groupoid ∞ 𝓡1) :=
begin
  -- in theory, we should prove that all compositions of charts are diffeos, i.e., they are smooth
  -- and their inverse are smooth. For symmetry reasons, it suffices to check one direction
  apply has_groupoid_of_pregroupoid,
  -- take two charts `e` and `e'`
  assume e e' he he',
  -- if next line is a little bit slow for your taste, you can replace `simp` with `squeeze_simp`
  -- and then follow the advice
  simp [atlas] at he he',
  dsimp,
  -- to continue, some hints:
  -- (1) don't hesitate to use the fact that the restriction of a smooth function to a
  -- subset is still smooth there (`cont_diff.cont_diff_on`)
  -- (2) hopefully, there is a theorem saying that the negation function is smooth.
  -- you can either try to guess its name, or hope that `suggest` will help you there.
  sorry
end

/- The statement of the previous instance is not very readable. There is a shortcut notation: -/

instance : smooth_manifold_with_corners 𝓡1 myℝ := { .. smooth_myℝ }

/- We will now study a very simple map from `myℝ` to `ℝ`, the identity. -/

def my_map : myℝ → ℝ := λ x, x

/- The map `my_map` is a map going from the type `myℝ` to the type `ℝ`. From the point of view of
the kernel of Lean, it is just the identity, but from the point of view of structures on `myℝ`
and `ℝ` it might not be trivial, as we have registered different instances on these two types. -/

/- The continuity should be trivial, as the topologies on `myℝ` and `ℝ` are definitionally the
same. So `continuous_id` might help. -/

lemma continuous_my_map : continuous my_map :=
sorry

/- Smoothness should not be obvious, though, as the manifold structures are not the same: the atlas
on `myℝ` has two elements, while the atlas on `ℝ` has one single element.
Note that `myℝ` is not a vector space, nor a normed space, so one can not ask whether `my_map`
is smooth in the usual sense (as a map between vector spaces): -/

-- lemma cont_diff_my_map : cont_diff ℝ ∞ my_map := sorry

/- does not make sense (try uncommenting it!) However, we can ask whether `my_map` is a smooth
map between manifolds, i.e., whether it is smooth when read in the charts. When we mention the
smoothness of a map, we should always specify explicitly the model with corners we are using,
because there might be several around (think of a complex manifold that you may want to consider
as a real manifold, to talk about functions which are real-smooth but not holomorphic) -/

lemma cont_mdiff_my_map : cont_mdiff 𝓡1 𝓡1 ∞ my_map :=
begin
  -- put things in a nicer form. The simpset `mfld_simps` registers many simplification rules for
  -- manifolds. `simp` is used heavily in manifold files to bring everything into manageable form.
  rw cont_mdiff_iff,
  simp only [continuous_my_map] with mfld_simps,
  -- simp has erased the chart in the target, as it knows that the only chart in the manifold `ℝ`
  -- is the identity.
  assume x y,
  sorry
end

/- Now, let's go to tangent bundles. We have a smooth manifold, so its tangent bundle should also
be a smooth manifold. -/

-- the type `tangent_bundle 𝓡1 myℝ` makes sense
#check tangent_bundle 𝓡1 myℝ

/- The tangent space above a point of `myℝ` is just a one-dimensional vector space (identified with `ℝ`).
So, one can prescribe an element of the tangent bundle as a pair (more on this below) -/
example : tangent_bundle 𝓡1 myℝ := ⟨(4 : ℝ), 0⟩

/- Construct the smooth manifold structure on the tangent bundle. Hint: the answer is a one-liner,
and this instance is not really needed. -/
instance tangent_bundle_myℝ : smooth_manifold_with_corners (𝓡1.prod 𝓡1) (tangent_bundle 𝓡1 myℝ) :=
sorry

/-
NB: the model space for the tangent bundle to a product manifold or a tangent space is not
`ℝ × ℝ`, but a copy called `model_prod ℝ ℝ`. Otherwise, `ℝ × ℝ` would have two charted space
structures with model `ℝ × ℝ`, the identity one and the product one, which are not definitionally
equal. And this would be bad.
-/
#check tangent_bundle.charted_space 𝓡1 myℝ

/- A smooth map between manifolds induces a map between their tangent bundles. In `mathlib` this is
called the `tangent_map` (you might instead know it as the "differential" or "pushforward" of the
map).  Let us check that the `tangent_map` of `my_map` is smooth. -/
lemma cont_mdiff_tangent_map_my_map :
  cont_mdiff (𝓡1.prod 𝓡1) (𝓡1.prod 𝓡1) ∞ (tangent_map 𝓡1 𝓡1 my_map) :=
begin
  -- hopefully, there is a theorem providing the general result, i.e. the tangent map to a smooth
  -- map is smooth.
  -- you can either try to guess its name, or hope that `suggest` will help you there.
  sorry
end

/- (Harder question) Can you show that this tangent bundle is homeomorphic to `ℝ × ℝ`? You could
try to build the homeomorphism by hand, using `tangent_map 𝓡1 𝓡1 my_map` in one direction and a
similar map in the other direction, but it is probably more efficient to use one of the charts of
the tangent bundle.

Remember, the model space for `tangent_bundle 𝓡1 myℝ` is `model_prod ℝ ℝ`, not `ℝ × ℝ`. But the
topologies on `model_prod ℝ ℝ` and `ℝ × ℝ` are the same, so it is by definition good enough to
construct a homeomorphism with `model_prod ℝ ℝ`.
 -/

def my_homeo : tangent_bundle 𝓡1 myℝ ≃ₜ (ℝ × ℝ) :=
begin
  sorry
end

/- Up to now, we have never used the definition of the tangent bundle, and this corresponds to
the usual mathematical practice: one doesn't care if the tangent space is defined using germs of
curves, or spaces of derivations, or whatever equivalent definition. Instead, one relies all the
time on functoriality (i.e., a smooth map has a well defined derivative, and they compose well,
together with the fact that the tangent bundle to a vector space is the product).

If you want to know more about the internals of the tangent bundle in mathlib, you can browse
through the next section, but it is maybe wiser to skip it on first reading, as it is not needed
to use the library
-/

section you_should_probably_skip_this

/- If `M` is a manifold modelled on a vector space `E`, then the underlying type for the tangent
bundle is just `Σ (x : M), tangent_space x M` (i.e., the disjoint union of the tangent spaces,
indexed by `x` -- this is a basic object in dependent type theory). And `tangent_space x M`
is just (a copy of) `E` by definition. -/

lemma tangent_bundle_myℝ_is_prod : tangent_bundle 𝓡1 myℝ = Σ (x : myℝ), ℝ :=
sorry

/- This means that you can specify a point in the tangent bundle as a pair `⟨x, v⟩`.
However, in general, a tangent bundle is not trivial: the topology on `tangent_bundle 𝓡1 myℝ` is *not*
the product topology. Instead, the tangent space at a point `x` is identified with `ℝ` through some
preferred chart at `x`, called `chart_at ℝ x`, but the way they are glued together depends on the
manifold and the charts.

In vector spaces, the tangent space is canonically the product space, with the same topology, as
there is only one chart so there is no strange gluing at play. The fact that the canonical map
from the sigma type to the product type (called `equiv.sigma_equiv_prod`) is a homeomorphism is
given in the library by `tangent_bundle_model_space_homeomorph` (note that this is a definition,
constructing the homeomorphism, instead of a proposition asserting that `equiv.sigma_equiv_prod`
is a homeomorphism, because we use bundled homeomorphisms in mathlib).

Let us register the identification explicitly, as a homeomorphism. You can use the relevant fields
of `tangent_bundle_model_space_homeomorph` to fill the nontrivial fields here.
-/

def tangent_bundle_vector_space_triv (E : Type u) [normed_add_comm_group E] [normed_space ℝ E] :
  tangent_bundle (model_with_corners_self ℝ E) E ≃ₜ E × E :=
{ to_fun := λ p, (p.1, p.2),
  inv_fun := λ p, ⟨p.1, p.2⟩,
  left_inv := sorry,
  right_inv := sorry,
  continuous_to_fun := begin
    sorry
  end,
  continuous_inv_fun :=
  begin
    sorry
  end }

/- Even though the tangent bundle to `myℝ` is trivial abstractly, with this construction the
tangent bundle is *not* the product space with the product topology, as we have used various charts
so the gluing is not trivial. The following exercise unfolds the definition to see what is going on.
It is not a reasonable exercise, in the sense that one should never ever do this when working
with a manifold! -/

lemma crazy_formula_after_identifications (x : ℝ) (v : ℝ) :
  let p : tangent_bundle 𝓡1 myℝ := ⟨(3 : ℝ), 0⟩ in
  chart_at (model_prod ℝ ℝ) p ⟨x, v⟩ = if x ∈ Ioo (-1 : ℝ) 1 then (x, -v) else (x, v) :=
begin
  -- this exercise is not easy (and shouldn't be: you are not supposed to use the library like this!)
  -- if you really want to do this, you should unfold as much as you can using simp and dsimp, until you
  -- are left with a statement speaking of derivatives of real functions, without any manifold code left.
  sorry
end

end you_should_probably_skip_this

/-!
### The language of manifolds

In this paragraph, we will try to write down interesting statements of theorems, without proving them. The
goal here is that Lean should not complain on the statement, but the proof should be sorried.
-/

/- Here is a first example, already filled up, to show you how diffeomorphisms are currently named
(we will probably introduce an abbreviation, but this hasn't been done yet).
Don't try to fill the sorried proof! -/

/-- Two zero-dimensional connected manifolds are diffeomorphic. -/
theorem diffeomorph_of_zero_dim_connected
  (M M' : Type*) [topological_space M] [topological_space M']
  [charted_space (euclidean_space ℝ (fin 0)) M] [charted_space (euclidean_space ℝ (fin 0)) M']
  [connected_space M] [connected_space M'] :
  nonempty (structomorph (cont_diff_groupoid ∞ (𝓡 0)) M M') :=
sorry

/- Do you think that this statement is correct? (note that we have not assumed that our manifolds
are smooth, nor that they are separated, but this is maybe automatic in zero dimension).

Now, write down a version of this theorem in dimension 1, replacing the first sorry with meaningful content
(and adding what is needed before the colon).
Don't try to fill the sorried proof! -/

/-- Two one-dimensional smooth compact connected manifolds are diffeomorphic. -/
theorem diffeomorph_of_one_dim_compact_connected

  :
  sorry
:= sorry

/- You will definitely need to require smoothness and separation in this case, as it is wrong otherwise.
Note that Lean won't complain if you don't put these assumptions, as the theorem would still make
sense, but it would just turn out to be wrong.

The previous statement is not really satisfactory: we would instead like to express that any such
manifold is diffeomorphic to the circle. The trouble is that we don't have the circle as a smooth
manifold yet. Since we have cheated and introduced it (with sorries) at the beginning of the tutorial,
let's cheat again and use it to reformulate the previous statement.
-/

-- the next result is not trivial, leave it sorried (but you can work on it if you don't like
-- manifolds and prefer topology -- then please PR it to mathlib!).
instance connected_sphere (n : ℕ) : connected_space (sphere (n+1)) := sorry

/- The next two instances are easier to prove, you can prove them or leave them sorried
as you like. For the second one, you may need to use facts of the library such as -/
#check is_compact_iff_compact_space
#check metric.is_compact_iff_is_closed_bounded

instance (n : ℕ) : t2_space (sphere n) :=
begin
  sorry
end

instance (n : ℕ) : compact_space (sphere n) :=
begin
  sorry
end

/- Now, you can prove that any one-dimensional compact connected manifold is diffeomorphic to
the circle. Here, you should fill the `sorry` (but luckily you may use
`diffeomorph_of_one_dim_compact_connected`). -/
theorem diffeomorph_circle_of_one_dim_compact_connected
  (M : Type*) [topological_space M] [charted_space (euclidean_space ℝ (fin 1)) M]
  [connected_space M] [compact_space M] [t2_space M] [smooth_manifold_with_corners (𝓡 1) M] :
  nonempty (structomorph (cont_diff_groupoid ∞ (𝓡 1)) M (sphere 1)) :=
sorry

/- What about trying to say that there are uncountably many different smooth structures on `ℝ⁴`?
(see https://en.wikipedia.org/wiki/Exotic_R4). The library is not really designed with this in mind,
as in general we only work with one differentiable structure on a space, but it is perfectly
capable of expressing this fact if one uses the `@` version of some definitions.

Don't try to fill the sorried proof!
-/

theorem exotic_ℝ4 :
  sorry
  :=
sorry

/-!
### Smooth functions on `[0, 1]`

In this paragraph, you will prove several (math-trivial but Lean-nontrivial) statements on the smooth
structure of `[0,1]`. These facts should be Lean-trivial, but they are not (yet) since there is essentially
nothing in this direction for now in the library.

The goal is as much to be able to write the statements as to prove them. Most of the necessary vocabulary
has been introduced above, so don't hesitate to browse the file if you are stuck. Additionally, you will
need the notion of a smooth function on a subset: it is `cont_diff_on` for functions between vector
spaces and `cont_mdiff_on` for functions between manifolds.

Try to formulate the next math statements in Lean, and prove them (but see below for hints):

Lemma cont_mdiff_g : the inclusion `g` of `[0, 1]` in `ℝ` is smooth.

Lemma msmooth_of_smooth : Consider a function `f : ℝ → [0, 1]`, which is smooth in the usual sense as a function
from `ℝ` to `ℝ` on a set `s`. Then it is manifold-smooth on `s`.

Definition : construct a function `f` from `ℝ` to `[0,1]` which is the identity on `[0, 1]`.

Theorem : the tangent bundle to `[0, 1]` is homeomorphic to `[0, 1] × ℝ`

Hint for the last theorem: don't try to unfold the definition of the tangent bundle, it will only get you
into trouble. Instead, use the derivatives of the maps `f` and `g`, and rely on functoriality
to check that they are inverse to each other. (This advice is slightly misleading as these derivatives
do not go between the right spaces, so you will need to massage them a little bit).

A global advice: don't hesitate to use and abuse `simp`, it is the main workhorse in this
area of mathlib.
-/

/- After doing the exercise myself, I realized it was (way!) too hard. So I will give at least the statements
of the lemmas, to guide you a little bit more. To let you try the original version if you want,
I have left a big blank space to avoid spoilers. -/

def g : Icc (0 : ℝ) 1 → ℝ := subtype.val

-- smoothness results for `euclidean_space` are expressed for general `L^p` spaces
-- (as `euclidean_space` has the `L^2` norm), in:
#check pi_Lp.cont_diff_coord
#check pi_Lp.cont_diff_on_iff_coord

lemma cont_mdiff_g : cont_mdiff (𝓡∂ 1) 𝓡1 ∞ g :=
begin
  sorry
end

lemma msmooth_of_smooth {f : ℝ → Icc (0 : ℝ) 1} {s : set ℝ} (h : cont_diff_on ℝ ∞ (λ x, (f x : ℝ)) s) :
  cont_mdiff_on 𝓡1 (𝓡∂ 1) ∞ f s :=
begin
  sorry
end

/- A function from `ℝ` to `[0,1]` which is the identity on `[0,1]`. -/
def f : ℝ → Icc (0 : ℝ) 1 :=
λ x, ⟨max (min x 1) 0, by simp [le_refl, zero_le_one]⟩

lemma cont_mdiff_on_f : cont_mdiff_on 𝓡1 (𝓡∂ 1) ∞ f (Icc 0 1) :=
begin
  sorry
end

lemma fog : f ∘ g = id :=
begin
  sorry
end

lemma gof : ∀ x ∈ Icc (0 : ℝ) 1, g (f x) = x :=
begin
  sorry
end

def G : tangent_bundle (𝓡∂ 1) (Icc (0 : ℝ) 1) → (Icc (0 : ℝ) 1) × ℝ :=
λ p, (p.1, ((tangent_bundle_vector_space_triv ℝ) (tangent_map (𝓡∂ 1) 𝓡1 g p)).2)

lemma continuous_G : continuous G :=
begin
  sorry
end

def F : (Icc (0 : ℝ) 1) × ℝ → tangent_bundle (𝓡∂ 1) (Icc (0 : ℝ) 1) :=
λ p, tangent_map_within 𝓡1 (𝓡∂ 1) f (Icc 0 1)
  ((tangent_bundle_vector_space_triv ℝ).symm (p.1, p.2))

lemma continuous_F : continuous F :=
begin
  sorry
end

lemma FoG : F ∘ G = id :=
begin
  sorry
end

lemma GoF : G ∘ F = id :=
begin
  sorry
end

def my_tangent_homeo : tangent_bundle (𝓡∂ 1) (Icc (0 : ℝ) 1) ≃ₜ (Icc (0 : ℝ) 1) × ℝ :=
sorry

/-!
### Further things to do

1) can you prove `diffeomorph_of_zero_dim_connected` or `connected_sphere`?

2) Try to express and then prove the local inverse theorem in real manifolds: if a map between
real manifolds (without boundary, modelled on a complete vector space) is smooth, then it is
a local homeomorphism around each point. We already have versions of this statement in mathlib
for functions between vector spaces, but this is very much a work in progress.

3) What about trying to prove `diffeomorph_of_one_dim_compact_connected`? (I am not sure mathlib
is ready for this, as the proofs I am thinking of are currently a little bit too high-powered.
If you manage to do it, you should absolutely PR it!)

4) Why not contribute to the proof of `sphere_eversion`? You can have a look at
https://leanprover-community.github.io/sphere-eversion/ to learn more about this project
by Patrick Massot.
-/


#check 1.2
#check 1.2 + 2.3
#check 1.0
#eval 1.2 + 2.3
#check 1.
#check 3.1416

theorem ex : 31416e-4 = 3.1416 :=
  rfl

#eval 3.4e-100 * 1e98

#eval 12.3e90 * 1E-90
#eval 3.00e-100 * 1e100
#eval 3.00e-100 * 1.e100
#eval 3.00e-100 * 1.0e100


/-
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, Mario Carneiro, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.monoid.type_tags
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Group.TypeTags
import Mathbin.Algebra.Order.Monoid.Cancel.Defs
import Mathbin.Algebra.Order.Monoid.Canonical.Defs

/-! # Ordered monoid structures on `multiplicative α` and `additive α`.

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

universe u

variable {α : Type u}

instance : ∀ [LE α], LE (Multiplicative α) :=
  id

instance : ∀ [LE α], LE (Additive α) :=
  id

instance : ∀ [LT α], LT (Multiplicative α) :=
  id

instance : ∀ [LT α], LT (Additive α) :=
  id

instance : ∀ [Preorder α], Preorder (Multiplicative α) :=
  id

instance : ∀ [Preorder α], Preorder (Additive α) :=
  id

instance : ∀ [PartialOrder α], PartialOrder (Multiplicative α) :=
  id

instance : ∀ [PartialOrder α], PartialOrder (Additive α) :=
  id

instance : ∀ [LinearOrder α], LinearOrder (Multiplicative α) :=
  id

instance : ∀ [LinearOrder α], LinearOrder (Additive α) :=
  id

instance [LE α] : ∀ [OrderBot α], OrderBot (Multiplicative α) :=
  id

instance [LE α] : ∀ [OrderBot α], OrderBot (Additive α) :=
  id

instance [LE α] : ∀ [OrderTop α], OrderTop (Multiplicative α) :=
  id

instance [LE α] : ∀ [OrderTop α], OrderTop (Additive α) :=
  id

instance [LE α] : ∀ [BoundedOrder α], BoundedOrder (Multiplicative α) :=
  id

instance [LE α] : ∀ [BoundedOrder α], BoundedOrder (Additive α) :=
  id

instance [OrderedAddCommMonoid α] : OrderedCommMonoid (Multiplicative α) :=
  { Multiplicative.partialOrder, Multiplicative.commMonoid with
    mul_le_mul_left := @OrderedAddCommMonoid.add_le_add_left α _ }

instance [OrderedCommMonoid α] : OrderedAddCommMonoid (Additive α) :=
  { Additive.partialOrder, Additive.addCommMonoid with
    add_le_add_left := @OrderedCommMonoid.mul_le_mul_left α _ }

instance [OrderedCancelAddCommMonoid α] : OrderedCancelCommMonoid (Multiplicative α) :=
  { Multiplicative.orderedCommMonoid with
    le_of_mul_le_mul_left := @OrderedCancelAddCommMonoid.le_of_add_le_add_left α _ }

instance [OrderedCancelCommMonoid α] : OrderedCancelAddCommMonoid (Additive α) :=
  { Additive.orderedAddCommMonoid with
    le_of_add_le_add_left := @OrderedCancelCommMonoid.le_of_mul_le_mul_left α _ }

instance [LinearOrderedAddCommMonoid α] : LinearOrderedCommMonoid (Multiplicative α) :=
  { Multiplicative.linearOrder, Multiplicative.orderedCommMonoid with }

instance [LinearOrderedCommMonoid α] : LinearOrderedAddCommMonoid (Additive α) :=
  { Additive.linearOrder, Additive.orderedAddCommMonoid with }

instance [Add α] [LE α] [ExistsAddOfLE α] : ExistsMulOfLE (Multiplicative α) :=
  ⟨@exists_add_of_le α _ _ _⟩

instance [Mul α] [LE α] [ExistsMulOfLE α] : ExistsAddOfLE (Additive α) :=
  ⟨@exists_mul_of_le α _ _ _⟩

instance [CanonicallyOrderedAddMonoid α] : CanonicallyOrderedMonoid (Multiplicative α) :=
  { Multiplicative.orderedCommMonoid, Multiplicative.orderBot, Multiplicative.existsMulOfLE with
    le_self_mul := @le_self_add α _ }

instance [CanonicallyOrderedMonoid α] : CanonicallyOrderedAddMonoid (Additive α) :=
  { Additive.orderedAddCommMonoid, Additive.orderBot, Additive.existsAddOfLE with
    le_self_add := @le_self_mul α _ }

instance [CanonicallyLinearOrderedAddMonoid α] :
    CanonicallyLinearOrderedMonoid (Multiplicative α) :=
  { Multiplicative.canonicallyOrderedMonoid, Multiplicative.linearOrder with }

instance [CanonicallyLinearOrderedMonoid α] : CanonicallyLinearOrderedAddMonoid (Additive α) :=
  { Additive.canonicallyOrderedAddMonoid, Additive.linearOrder with }

namespace Additive

variable [Preorder α]

#print Additive.ofMul_le /-
@[simp]
theorem ofMul_le {a b : α} : ofMul a ≤ ofMul b ↔ a ≤ b :=
  Iff.rfl
#align additive.of_mul_le Additive.ofMul_le
-/

#print Additive.ofMul_lt /-
@[simp]
theorem ofMul_lt {a b : α} : ofMul a < ofMul b ↔ a < b :=
  Iff.rfl
#align additive.of_mul_lt Additive.ofMul_lt
-/

#print Additive.toMul_le /-
@[simp]
theorem toMul_le {a b : Additive α} : toMul a ≤ toMul b ↔ a ≤ b :=
  Iff.rfl
#align additive.to_mul_le Additive.toMul_le
-/

#print Additive.toMul_lt /-
@[simp]
theorem toMul_lt {a b : Additive α} : toMul a < toMul b ↔ a < b :=
  Iff.rfl
#align additive.to_mul_lt Additive.toMul_lt
-/

end Additive

namespace Multiplicative

variable [Preorder α]

#print Multiplicative.ofAdd_le /-
@[simp]
theorem ofAdd_le {a b : α} : ofAdd a ≤ ofAdd b ↔ a ≤ b :=
  Iff.rfl
#align multiplicative.of_add_le Multiplicative.ofAdd_le
-/

#print Multiplicative.ofAdd_lt /-
@[simp]
theorem ofAdd_lt {a b : α} : ofAdd a < ofAdd b ↔ a < b :=
  Iff.rfl
#align multiplicative.of_add_lt Multiplicative.ofAdd_lt
-/

#print Multiplicative.toAdd_le /-
@[simp]
theorem toAdd_le {a b : Multiplicative α} : toAdd a ≤ toAdd b ↔ a ≤ b :=
  Iff.rfl
#align multiplicative.to_add_le Multiplicative.toAdd_le
-/

#print Multiplicative.toAdd_lt /-
@[simp]
theorem toAdd_lt {a b : Multiplicative α} : toAdd a < toAdd b ↔ a < b :=
  Iff.rfl
#align multiplicative.to_add_lt Multiplicative.toAdd_lt
-/

end Multiplicative


import .free_group group_theory.subgroup

variables {ι : Type*} [decidable_eq ι]

open free_group  subgroup function

lemma mul_aux_mem (S : Π i, subgroup (C∞ )) : ∀ (l₁ l₂ : list (Σ i : ι, C∞ ))
  (h₁ : ∀ a : Σ i : ι, C∞ , a ∈ l₁ → a.2 ∈ S a.1)
  (h₂ : ∀ a : Σ i : ι, C∞ , a ∈ l₂ → a.2 ∈ S a.1)
  {i : ι} {a : C∞ } (ha : (⟨i, a⟩ : Σ i : ι, C∞ ) ∈ coprod.pre.mul_aux l₁ l₂),
  a ∈ S i
| []           l₂      := by simp [coprod.pre.mul_aux]
| (⟨j, b⟩::l₁) []      := begin
    assume h₁ _ i a ha,
    simp only [coprod.pre.mul_aux, list.mem_reverse, list.mem_cons_iff] at ha,
    rcases ha with ⟨rfl, hab⟩ | hia,
    { rw [heq_iff_eq] at hab,
      subst hab,
      exact h₁ ⟨i, a⟩ (list.mem_cons_self _ _) },
    { exact h₁ ⟨i, a⟩ (list.mem_cons_of_mem _ hia) }
  end
| (⟨j, b⟩::l₁) (⟨k, c⟩::l₂) := begin
  assume h₁ h₂ i a ha,
  simp only [coprod.pre.mul_aux] at ha,
  split_ifs at ha,
  { exact mul_aux_mem _ _
      (λ d hd, h₁ d (list.mem_cons_of_mem _ hd))
      (λ d hd, h₂ d (list.mem_cons_of_mem _ hd))
      ha },
  { dsimp at h,
    subst j,
    simp only [list.reverse_core_eq, list.mem_append, list.mem_cons_iff,
      list.mem_reverse, cast_eq] at ha,
    simp only [cast_eq] at *,
    rcases ha with ha | ⟨rfl, h, h⟩ | ha,
    { exact h₁ ⟨i, a⟩ (list.mem_cons_of_mem _ ha) },
    { exact subgroup.mul_mem _
        (h₁ ⟨i, b⟩ (list.mem_cons_self _ _))
        (h₂ ⟨i, c⟩ (list.mem_cons_self _ _)) },
    { exact h₂ ⟨i, a⟩ (list.mem_cons_of_mem _ ha) } },
  { clear_aux_decl,
    simp only [list.reverse_core_eq, list.mem_append, list.mem_cons_iff,
      list.mem_reverse] at ha,
    rcases ha with ha | ⟨rfl, hab⟩ | ⟨rfl, hab⟩ | ha,
    { exact h₁ ⟨i, a⟩ (list.mem_cons_of_mem _ ha) },
    { rw [heq_iff_eq] at hab,
      subst hab,
      exact h₁ ⟨i, a⟩ (list.mem_cons_self _ _) },
    { rw [heq_iff_eq] at hab,
      subst hab,
      exact h₂ ⟨i, a⟩ (list.mem_cons_self _ _) },
    { exact h₂ ⟨i, a⟩ (list.mem_cons_of_mem _ ha) } }
end

def blah (S : Π i, subgroup (C∞ )) : subgroup (free_group ι) :=
{ carrier  := { w : free_group ι | ∀ (a : Σ i : ι, C∞ ), a ∈ w.to_list → a.2 ∈ S a.1 },
  one_mem' := λ a h, h.elim,
  mul_mem' := begin
    rintros ⟨l₁, hl₁⟩ ⟨l₂, hl₂⟩ h₁ h₂ ⟨i, a⟩ h,
    exact mul_aux_mem S l₁.reverse l₂ (by simpa using h₁) (by simpa using h₂) h
  end,
  inv_mem' := begin
    rintros ⟨l, hl⟩ h i hi,
    dsimp at *,
    replace hi : i ∈ (l.map _).reverse := hi,
    rw [← inv_mem_iff],
    simp at hi,
    rcases hi with ⟨j, a, ha, rfl⟩,
    simp,
    exact h _ ha
  end }

lemma mem_blah (S : Π i, subgroup (C∞ )) (w : free_group ι) :
  w ∈ blah S ↔ ∀ (a : Σ i : ι, C∞ ), a ∈ w.to_list → a.2 ∈ S a.1 := iff.rfl

variable {S : Π i : ι, subgroup C∞}

@[simp] lemma of'_mem_blah_iff {i : ι} {a : C∞ } : of' i a ∈ blah S ↔ a ∈ S i :=
begin
  simp only [mem_blah, of', coprod.to_list_of],
  split_ifs,
  { simp [*, subgroup.one_mem] },
  { simp only [list.mem_singleton],
    split,
    { exact λ h, h ⟨i, a⟩ rfl },
    { assume ha j hj,
      subst j,
      exact ha } }
end

lemma blah_eq_supr : blah S = ⨆ i, (S i).map (of' i) :=
le_antisymm
  (λ w hw, begin
    cases w with l hl,
    induction l with i l ih,
    { simp [subgroup.one_mem] },
    { rw [coprod.cons_eq_of_mul],
      refine subgroup.mul_mem _ _ _,
      { exact (le_supr (λ i, (S i).map begin show C∞  →* free_group ι, from of' i end) i.1 : _)
        (mem_map.2 ⟨i.2, hw _ (list.mem_cons_self _ _), rfl⟩) },
      { exact ih _ (λ j hj, hw _ (list.mem_cons_of_mem _ hj)) } }
  end)
  (supr_le (λ i a ha, begin
    rw [mem_map] at ha,
    rcases ha with ⟨a, ha, rfl⟩,
    simp only [of', coprod.to_list_of, mem_blah],
    split_ifs,
    { simp },
    { simp only [list.mem_singleton],
      assume a ha,
      subst a,
      exact ha }
  end))

lemma range_lift' {G : Type*} [group G] (f : Π i : ι, C∞ →* G) :
  (free_group.lift' f).range = ⨆ i : ι, (f i).range :=
le_antisymm
  begin
    rintros w,
    rw [monoid_hom.mem_range],
    rintros ⟨w, rfl⟩,
    refine free_group.rec_on' w _ _ _,
    { simp [subgroup.one_mem] },
    { assume i n,
      rw [lift'_of'],
      refine le_supr (λ i : ι,(f i).range) i _,
      erw [monoid_hom.mem_range],
      use [n, rfl] },
    { assume i n w ih₁ ih₂,
      simp only [lift'_of', monoid_hom.map_mul] at *,
      exact subgroup.mul_mem _ ih₁ ih₂ }
  end
  (supr_le begin
    assume i w,
    rw [monoid_hom.mem_range],
    rintros ⟨n, rfl⟩,
    rw [monoid_hom.mem_range],
    use of' i n,
    simp,
  end)

/-- `closure_var` is the group closure of a set of variables -/
def closure_var (T : set ι) : subgroup (free_group ι) :=
blah (λ i, ⨆ (h : i ∈ T), ⊤)

instance decidable_blah [Π i : ι, decidable_pred (∈ S i)] : decidable_pred (∈ blah S) :=
λ w, show decidable (∀ (a : Σ i : ι, C∞ ), a ∈ w.to_list → a.2 ∈ S a.1),
  by apply_instance

instance decidable_closure_var (T : set ι) [decidable_pred T] : decidable_pred (∈ closure_var T) :=
λ w, decidable_of_iff (list.all w.to_list (λ i, i.1 ∈ T)) sorry

lemma mem_supr_of_mem {G : Type*} [group G] {ι : Type*} {S : ι → subgroup G} (i : ι) :
  ∀ {x : G}, x ∈ S i → x ∈ supr S :=
show S i ≤ supr S, from le_supr _ _

lemma range_lift {G : Type*} [group G] (f : ι → G) :
  (free_group.lift f).range = subgroup.closure (set.range f) :=
begin
  simp only [free_group.lift, range_lift', subgroup.range_gpowers_hom,
    gpowers_eq_closure],
  refine le_antisymm _ _,
  { exact supr_le (λ x, closure_mono (λ y, by simp {contextual := tt})) },
  { refine (closure_le _).2 _,
    rw [set.range_eq_Union],
    refine set.Union_subset (λ i x hx, _),
    rw [subgroup.mem_coe],
    exact mem_supr_of_mem i (subgroup.subset_closure hx) }
end