/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

In the standard library we cannot assume the univalence axiom.
We say two types are equivalent if they are isomorphic.

Two equivalent types have the same cardinality.
-/
import data.sum data.nat
open function

structure equiv [class] (A B : Type) :=
  (to_fun    : A → B)
  (inv_fun   : B → A)
  (left_inv  : left_inverse inv_fun to_fun)
  (right_inv : right_inverse inv_fun to_fun)

namespace equiv
definition perm [reducible] (A : Type) := equiv A A

infix ` ≃ `:50 := equiv

definition fn {A B : Type} (e : equiv A B) : A → B :=
@equiv.to_fun A B e

infixr ` ∙ `:100 := fn

definition inv {A B : Type} [e : equiv A B] : B → A :=
@equiv.inv_fun A B e

lemma eq_of_to_fun_eq {A B : Type} : ∀ {e₁ e₂ : equiv A B}, fn e₁ = fn e₂ → e₁ = e₂
| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) h :=
  have f₁ = f₂, from h,
  have g₁ = g₂, from funext (λ x,
    have f₁ (g₁ x) = f₂ (g₂ x), from eq.trans (r₁ x) (eq.symm (r₂ x)),
    have f₁ (g₁ x) = f₁ (g₂ x),   begin subst f₂, exact this end,
    show g₁ x = g₂ x,             from injective_of_left_inverse l₁ this),
  by congruence; repeat assumption

protected definition refl [refl] (A : Type) : A ≃ A :=
mk (@id A) (@id A) (λ x, rfl) (λ x, rfl)

protected definition symm [symm] {A B : Type} : A ≃ B → B ≃ A
| (mk f g h₁ h₂) := mk g f h₂ h₁

protected definition trans [trans] {A B C : Type} : A ≃ B → B ≃ C → A ≃ C
| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) :=
  mk (f₂ ∘ f₁) (g₁ ∘ g₂)
   (show ∀ x, g₁ (g₂ (f₂ (f₁ x))) = x, by intros; rewrite [l₂, l₁]; reflexivity)
   (show ∀ x, f₂ (f₁ (g₁ (g₂ x))) = x, by intros; rewrite [r₁, r₂]; reflexivity)

abbreviation id {A : Type} := equiv.refl A

namespace ops
  postfix ⁻¹ := equiv.symm
  postfix ⁻¹ := equiv.inv
  notation e₁ ∘ e₂  := equiv.trans e₂ e₁
end ops
open equiv.ops

lemma id_apply {A : Type} (x : A) : id ∙ x = x :=
rfl

lemma comp_apply {A B C : Type} (g : B ≃ C) (f : A ≃ B) (x : A) : (g ∘ f) ∙ x = g ∙ f ∙ x :=
begin cases g, cases f, esimp end

lemma inverse_apply_apply {A B : Type} : ∀ (e : A ≃ B) (x : A), e⁻¹ ∙ e ∙ x = x
| (mk f₁ g₁ l₁ r₁) x := begin unfold [equiv.symm, fn], rewrite l₁ end

lemma eq_iff_eq_of_injective {A B : Type} {f : A → B} (inj : injective f) (a b : A) : f a = f b ↔ a = b :=
iff.intro
  (suppose f a = f b, inj this)
  (suppose a = b,     by rewrite this)

lemma apply_eq_iff_eq {A B : Type} : ∀ (f : A ≃ B) (x y : A), f ∙ x = f ∙ y ↔ x = y
| (mk f₁ g₁ l₁ r₁) x y := eq_iff_eq_of_injective (injective_of_left_inverse l₁) x y

lemma apply_eq_iff_eq_inverse_apply {A B : Type} : ∀ (f : A ≃ B) (x : A) (y : B), f ∙ x = y ↔ x = f⁻¹ ∙ y
| (mk f₁ g₁ l₁ r₁) x y :=
  begin
    esimp, unfold [equiv.symm, fn], apply iff.intro,
    suppose f₁ x = y, by subst y; rewrite l₁,
    suppose x = g₁ y, by subst x; rewrite r₁
  end

definition false_equiv_empty : empty ≃ false :=
mk (λ e, empty.rec _ e) (λ h, false.rec _ h) (λ e, empty.rec _ e) (λ h, false.rec _ h)

definition arrow_congr [congr] {A₁ B₁ A₂ B₂ : Type} : A₁ ≃ A₂ → B₁ ≃ B₂ → (A₁ → B₁) ≃ (A₂ → B₂)
| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) :=
  mk
   (λ (h : A₁ → B₁) (a : A₂), f₂ (h (g₁ a)))
   (λ (h : A₂ → B₂) (a : A₁), g₂ (h (f₁ a)))
   (λ h, funext (λ a, by rewrite [l₁, l₂]; reflexivity))
   (λ h, funext (λ a, by rewrite [r₁, r₂]; reflexivity))

section
open unit
definition arrow_unit_equiv_unit [simp] (A : Type) : (A → unit) ≃ unit :=
mk (λ f, star) (λ u, (λ f, star))
   (λ f, funext (λ x, by cases (f x); reflexivity))
   (λ u, by cases u; reflexivity)

definition unit_arrow_equiv [simp] (A : Type) : (unit → A) ≃ A :=
mk (λ f, f star) (λ a, (λ u, a))
   (λ f, funext (λ x, by cases x; reflexivity))
   (λ u, rfl)

definition empty_arrow_equiv_unit [simp] (A : Type) : (empty → A) ≃ unit :=
mk (λ f, star) (λ u, λ e, empty.rec _ e)
   (λ f, funext (λ x, empty.rec _ x))
   (λ u, by cases u; reflexivity)

definition false_arrow_equiv_unit [simp] (A : Type) : (false → A) ≃ unit :=
calc (false → A) ≃ (empty → A) : arrow_congr false_equiv_empty !equiv.refl
             ... ≃ unit        : empty_arrow_equiv_unit
end

definition prod_congr [congr] {A₁ B₁ A₂ B₂ : Type} : A₁ ≃ A₂ → B₁ ≃ B₂ → (A₁ × B₁) ≃ (A₂ × B₂)
| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) :=
  mk
    (λ p, match p with (a₁, b₁) := (f₁ a₁, f₂ b₁) end)
    (λ p, match p with (a₂, b₂) := (g₁ a₂, g₂ b₂) end)
    (λ p, begin cases p, esimp, rewrite [l₁, l₂], reflexivity end)
    (λ p, begin cases p, esimp, rewrite [r₁, r₂], reflexivity end)

definition prod_comm [simp] (A B : Type) : (A × B) ≃ (B × A) :=
mk (λ p, match p with (a, b) := (b, a) end)
   (λ p, match p with (b, a) := (a, b) end)
   (λ p, begin cases p, esimp end)
   (λ p, begin cases p, esimp end)

definition prod_assoc [simp] (A B C : Type) : ((A × B) × C) ≃ (A × (B × C)) :=
mk (λ t, match t with ((a, b), c) := (a, (b, c)) end)
   (λ t, match t with (a, (b, c)) := ((a, b), c) end)
   (λ t, begin cases t with ab c, cases ab, esimp end)
   (λ t, begin cases t with a bc, cases bc, esimp end)

section
open unit prod.ops
definition prod_unit_right [simp] (A : Type) : (A × unit) ≃ A :=
mk (λ p, p.1)
   (λ a, (a, star))
   (λ p, begin cases p with a u, cases u, esimp end)
   (λ a, rfl)

definition prod_unit_left [simp] (A : Type) : (unit × A) ≃ A :=
calc (unit × A) ≃ (A × unit) : prod_comm
            ... ≃ A          : prod_unit_right

definition prod_empty_right [simp] (A : Type) : (A × empty) ≃ empty :=
mk (λ p, empty.rec _ p.2) (λ e, empty.rec _ e) (λ p, empty.rec _ p.2)  (λ e, empty.rec _ e)

definition prod_empty_left [simp] (A : Type) : (empty × A) ≃ empty :=
calc (empty × A) ≃ (A × empty) : prod_comm
             ... ≃ empty       : prod_empty_right
end

section
open sum
definition sum_congr [congr] {A₁ B₁ A₂ B₂ : Type} : A₁ ≃ A₂ → B₁ ≃ B₂ → (A₁ + B₁) ≃ (A₂ + B₂)
| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) :=
  mk
   (λ s, match s with inl a₁ := inl (f₁ a₁) | inr b₁ := inr (f₂ b₁) end)
   (λ s, match s with inl a₂ := inl (g₁ a₂) | inr b₂ := inr (g₂ b₂) end)
   (λ s, begin cases s, {esimp, rewrite l₁, reflexivity}, {esimp, rewrite l₂, reflexivity} end)
   (λ s, begin cases s, {esimp, rewrite r₁, reflexivity}, {esimp, rewrite r₂, reflexivity} end)

open bool unit
definition bool_equiv_unit_sum_unit : bool ≃ (unit + unit) :=
mk (λ b, match b with tt := inl star | ff := inr star end)
   (λ s, match s with inl star := tt | inr star := ff end)
   (λ b, begin cases b, esimp, esimp end)
   (λ s, begin cases s with u u, {cases u, esimp}, {cases u, esimp} end)

definition sum_comm [simp] (A B : Type) : (A + B) ≃ (B + A) :=
mk (λ s, match s with inl a := inr a | inr b := inl b end)
   (λ s, match s with inl b := inr b | inr a := inl a end)
   (λ s, begin cases s, esimp, esimp end)
   (λ s, begin cases s, esimp, esimp end)

definition sum_assoc [simp] (A B C : Type) : ((A + B) + C) ≃ (A + (B + C)) :=
mk (λ s, match s with inl (inl a) := inl a | inl (inr b) := inr (inl b) | inr c := inr (inr c) end)
   (λ s, match s with inl a := inl (inl a) | inr (inl b) := inl (inr b) | inr (inr c) := inr c end)
   (λ s, begin cases s with ab c, cases ab, repeat esimp end)
   (λ s, begin cases s with a bc, esimp, cases bc, repeat esimp end)

definition sum_empty_right [simp] (A : Type) : (A + empty) ≃ A :=
mk (λ s, match s with inl a := a | inr e := empty.rec _ e end)
   (λ a, inl a)
   (λ s, begin cases s with a e, esimp, exact empty.rec _ e end)
   (λ a, rfl)

definition sum_empty_left [simp] (A : Type) : (empty + A) ≃ A :=
calc (empty + A) ≃ (A + empty) : sum_comm
          ...    ≃ A           : sum_empty_right
end

section
open prod.ops
definition arrow_prod_equiv_prod_arrow (A B C : Type) : (C → A × B) ≃ ((C → A) × (C → B)) :=
mk (λ f, (λ c, (f c).1, λ c, (f c).2))
   (λ p, λ c, (p.1 c, p.2 c))
   (λ f, funext (λ c, begin esimp, cases f c, esimp end))
   (λ p, begin cases p, esimp end)

definition arrow_arrow_equiv_prod_arrow (A B C : Type) : (A → B → C) ≃ (A × B → C) :=
mk (λ f, λ p, f p.1 p.2)
   (λ f, λ a b, f (a, b))
   (λ f, rfl)
   (λ f, funext (λ p, begin cases p, esimp end))

open sum
definition sum_arrow_equiv_prod_arrow (A B C : Type) : ((A + B) → C) ≃ ((A → C) × (B → C)) :=
mk (λ f, (λ a, f (inl a), λ b, f (inr b)))
   (λ p, (λ s, match s with inl a := p.1 a | inr b := p.2 b end))
   (λ f, funext (λ s, begin cases s, esimp, esimp end))
   (λ p, begin cases p, esimp end)

definition sum_prod_distrib (A B C : Type) : ((A + B) × C) ≃ ((A × C) + (B × C)) :=
mk (λ p, match p with (inl a, c) := inl (a, c) | (inr b, c) := inr (b, c) end)
   (λ s, match s with inl (a, c) := (inl a, c) | inr (b, c) := (inr b, c) end)
   (λ p, begin cases p with ab c, cases ab, repeat esimp end)
   (λ s, begin cases s with ac bc, cases ac, esimp, cases bc, esimp end)

definition prod_sum_distrib (A B C : Type) : (A × (B + C)) ≃ ((A × B) + (A × C)) :=
calc (A × (B + C)) ≃ ((B + C) × A)       : prod_comm
             ...   ≃ ((B × A) + (C × A)) : sum_prod_distrib
             ...   ≃ ((A × B) + (A × C)) : sum_congr !prod_comm !prod_comm

definition bool_prod_equiv_sum (A : Type) : (bool × A) ≃ (A + A) :=
calc (bool × A) ≃ ((unit + unit) × A)       : prod_congr bool_equiv_unit_sum_unit !equiv.refl
        ...     ≃ (A × (unit + unit))       : prod_comm
        ...     ≃ ((A × unit) + (A × unit)) : prod_sum_distrib
        ...     ≃ (A + A)                   : sum_congr !prod_unit_right !prod_unit_right
end

section
open sum nat unit prod.ops
definition nat_equiv_nat_sum_unit : nat ≃ (nat + unit) :=
mk (λ n, match n with zero := inr star | succ a := inl a end)
   (λ s, match s with inl n := succ n | inr star := zero end)
   (λ n, begin cases n, repeat esimp end)
   (λ s, begin cases s with a u, esimp, {cases u, esimp} end)

definition nat_sum_unit_equiv_nat [simp] : (nat + unit) ≃ nat :=
equiv.symm nat_equiv_nat_sum_unit

definition nat_prod_nat_equiv_nat [simp] : (nat × nat) ≃ nat :=
mk (λ p, mkpair p.1 p.2)
   (λ n, unpair n)
   (λ p, begin cases p, apply unpair_mkpair end)
   (λ n, mkpair_unpair n)

definition nat_sum_bool_equiv_nat [simp] : (nat + bool) ≃ nat :=
calc (nat + bool) ≃ (nat + (unit + unit)) : sum_congr !equiv.refl bool_equiv_unit_sum_unit
             ...  ≃ ((nat + unit) + unit) : sum_assoc
             ...  ≃ (nat + unit)          : sum_congr nat_sum_unit_equiv_nat !equiv.refl
             ...  ≃ nat                   : nat_sum_unit_equiv_nat

open decidable
definition nat_sum_nat_equiv_nat [simp] : (nat + nat) ≃ nat :=
mk (λ s, match s with inl n := 2*n | inr n := 2*n+1 end)
   (λ n, if even n then inl (n / 2) else inr ((n - 1) / 2))
   (λ s, begin
           have two_gt_0 : 2 > zero, from dec_trivial,
           cases s,
             {esimp, rewrite [if_pos (even_two_mul _), nat.mul_div_cancel_left _ two_gt_0]},
             {esimp, rewrite [if_neg (not_even_two_mul_plus_one _), nat.add_sub_cancel,
                              nat.mul_div_cancel_left _ two_gt_0]}
         end)
   (λ n, by_cases
          (λ h : even n,
            by rewrite [if_pos h]; esimp; rewrite [nat.mul_div_cancel' (dvd_of_even h)])
          (λ h : ¬ even n,
            begin
              rewrite [if_neg h], esimp,
              cases n,
                {exact absurd even_zero h},
                {rewrite [-(add_one a), nat.add_sub_cancel,
                          nat.mul_div_cancel' (dvd_of_even (even_of_odd_succ (odd_of_not_even h)))]}
            end))

definition prod_equiv_of_equiv_nat {A : Type} : A ≃ nat → (A × A) ≃ A :=
take e, calc
  (A × A) ≃ (nat × nat) : prod_congr e e
     ...  ≃ nat         : nat_prod_nat_equiv_nat
     ...  ≃ A           : equiv.symm e
end

section
open decidable
definition decidable_eq_of_equiv {A B : Type} [h : decidable_eq A] : A ≃ B → decidable_eq B
| (mk f g l r) :=
  take b₁ b₂, match h (g b₁) (g b₂) with
  | inl he := inl (have aux : f (g b₁) = f (g b₂), from congr_arg f he,
                   begin rewrite *r at aux, exact aux end)
  | inr hn := inr (λ b₁eqb₂, by subst b₁eqb₂; exact absurd rfl hn)
  end
end

definition inhabited_of_equiv {A B : Type} [h : inhabited A] : A ≃ B → inhabited B
| (mk f g l r) := inhabited.mk (f (inhabited.value h))

section
open subtype
definition subtype_equiv_of_subtype {A B : Type} {p : A → Prop} : A ≃ B → {a : A | p a} ≃ {b : B | p b⁻¹}
| (mk f g l r) :=
  mk (λ s, match s with tag v h := tag (f v) (eq.rec_on (eq.symm (l v)) h) end)
     (λ s, match s with tag v h := tag (g v) (eq.rec_on (eq.symm (r v)) h) end)
     (λ s, begin cases s, esimp, congruence, rewrite l, reflexivity end)
     (λ s, begin cases s, esimp, congruence, rewrite r, reflexivity end)
end

section swap
variable {A : Type}
variable [h : decidable_eq A]
include h
open decidable

definition swap_core (a b r : A) : A :=
if r = a then b
else if r = b then a
else r

lemma swap_core_swap_core (r a b : A) : swap_core a b (swap_core a b r) = r :=
by_cases
  (suppose r = a, by_cases
    (suppose r = b,   begin unfold swap_core, rewrite [if_pos `r = a`, if_pos (eq.refl b), -`r = a`, -`r = b`, if_pos (eq.refl r)] end)
    (suppose ¬ r = b,
      have b ≠ a, from assume h, begin rewrite h at this, contradiction end,
      begin unfold swap_core, rewrite [*if_pos `r = a`, if_pos (eq.refl b), if_neg `b ≠ a`, `r = a`] end))
  (suppose ¬ r = a, by_cases
    (suppose r = b,   begin unfold swap_core, rewrite [if_neg `¬ r = a`, *if_pos `r = b`, if_pos (eq.refl a), this] end)
    (suppose ¬ r = b, begin unfold swap_core, rewrite [*if_neg `¬ r = a`, *if_neg `¬ r = b`, if_neg `¬ r = a`] end))

lemma swap_core_self (r a : A) : swap_core a a r = r :=
by_cases
  (suppose r = a, begin unfold swap_core, rewrite [*if_pos this, this] end)
  (suppose r ≠ a, begin unfold swap_core, rewrite [*if_neg this] end)

lemma swap_core_comm (r a b : A) : swap_core a b r = swap_core b a r :=
by_cases
  (suppose r = a, by_cases
    (suppose r = b,   begin unfold swap_core, rewrite [if_pos `r = a`, if_pos `r = b`, -`r = a`, -`r = b`] end)
    (suppose ¬ r = b, begin unfold swap_core, rewrite [*if_pos `r = a`, if_neg `¬ r = b`] end))
  (suppose ¬ r = a, by_cases
    (suppose r = b,   begin unfold swap_core, rewrite [if_neg `¬ r = a`, *if_pos `r = b`]    end)
    (suppose ¬ r = b, begin unfold swap_core, rewrite [*if_neg `¬ r = a`, *if_neg `¬ r = b`] end))

definition swap (a b : A) : perm A :=
mk (swap_core a b)
   (swap_core a b)
   (λ x, abstract by rewrite swap_core_swap_core end)
   (λ x, abstract by rewrite swap_core_swap_core end)

lemma swap_self (a : A) : swap a a = id :=
eq_of_to_fun_eq (funext (λ x, begin unfold [swap, fn], rewrite swap_core_self end))

lemma swap_comm (a b : A) : swap a b = swap b a :=
eq_of_to_fun_eq (funext (λ x, begin unfold [swap, fn], rewrite swap_core_comm end))

lemma swap_apply_def (a b : A) (x : A) : swap a b ∙ x = if x = a then b else if x = b then a else x :=
rfl

lemma swap_apply_left (a b : A) : swap a b ∙ a = b :=
if_pos rfl

lemma swap_apply_right (a b : A) : swap a b ∙ b = a :=
by_cases
  (suppose b = a, by rewrite [swap_apply_def, this, *if_pos rfl])
  (suppose b ≠ a, by rewrite [swap_apply_def, if_pos rfl, if_neg this])

lemma swap_apply_of_ne_of_ne {a b : A} {x : A} : x ≠ a → x ≠ b → swap a b ∙ x = x :=
assume h₁ h₂, by rewrite [swap_apply_def, if_neg h₁, if_neg h₂]

lemma swap_swap (a b : A) : swap a b ∘ swap a b = id :=
eq_of_to_fun_eq (funext (λ x, begin unfold [swap, fn, equiv.trans, equiv.refl], rewrite swap_core_swap_core end))

lemma swap_comp_apply (a b : A) (π : perm A) (x : A) : (swap a b ∘ π) ∙ x = if π ∙ x = a then b else if π ∙ x = b then a else π ∙ x :=
begin cases π, reflexivity end

end swap
end equiv


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

! This file was ported from Lean 3 source module topology.category.TopCommRing
! leanprover-community/mathlib commit 9a59dcb7a2d06bf55da57b9030169219980660cd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Ring.Basic
import Mathbin.Topology.Category.Top.Basic
import Mathbin.Topology.Algebra.Ring.Basic

/-!
# Category of topological commutative rings

We introduce the category `TopCommRing` of topological commutative rings together with the relevant
forgetful functors to topological spaces and commutative rings.
-/

universe u

open CategoryTheory

/-- A bundled topological commutative ring. -/
structure TopCommRing where
  α : Type u
  [isCommRing : CommRing α]
  [isTopologicalSpace : TopologicalSpace α]
  [is_topologicalRing : TopologicalRing α]
#align TopCommRing TopCommRing

namespace TopCommRing

instance : Inhabited TopCommRing :=
  ⟨⟨PUnit⟩⟩

instance : CoeSort TopCommRing (Type u) :=
  ⟨TopCommRing.α⟩

attribute [instance] is_comm_ring is_topological_space is_topological_ring

instance : Category TopCommRing.{u}
    where
  Hom R S := { f : R →+* S // Continuous f }
  id R := ⟨RingHom.id R, by obviously⟩
  -- TODO remove obviously?
  comp R S T f g :=
    ⟨g.val.comp f.val,
      by
      -- TODO automate
      cases f;
      cases g
      dsimp; apply Continuous.comp <;> assumption⟩

instance : ConcreteCategory TopCommRing.{u}
    where
  forget :=
    { obj := fun R => R
      map := fun R S f => f.val }
  forget_faithful := { }

/-- Construct a bundled `TopCommRing` from the underlying type and the appropriate typeclasses. -/
def of (X : Type u) [CommRing X] [TopologicalSpace X] [TopologicalRing X] : TopCommRing :=
  ⟨X⟩
#align TopCommRing.of TopCommRing.of

@[simp]
theorem coe_of (X : Type u) [CommRing X] [TopologicalSpace X] [TopologicalRing X] :
    (of X : Type u) = X :=
  rfl
#align TopCommRing.coe_of TopCommRing.coe_of

instance forgetTopologicalSpace (R : TopCommRing) : TopologicalSpace ((forget TopCommRing).obj R) :=
  R.isTopologicalSpace
#align TopCommRing.forget_topological_space TopCommRing.forgetTopologicalSpace

instance forgetCommRing (R : TopCommRing) : CommRing ((forget TopCommRing).obj R) :=
  R.isCommRing
#align TopCommRing.forget_comm_ring TopCommRing.forgetCommRing

instance forget_topologicalRing (R : TopCommRing) : TopologicalRing ((forget TopCommRing).obj R) :=
  R.is_topologicalRing
#align TopCommRing.forget_topological_ring TopCommRing.forget_topologicalRing

instance hasForgetToCommRing : HasForget₂ TopCommRing CommRingCat :=
  HasForget₂.mk' (fun R => CommRingCat.of R) (fun x => rfl) (fun R S f => f.val) fun R S f =>
    HEq.rfl
#align TopCommRing.has_forget_to_CommRing TopCommRing.hasForgetToCommRing

instance forgetToCommRingTopologicalSpace (R : TopCommRing) :
    TopologicalSpace ((forget₂ TopCommRing CommRingCat).obj R) :=
  R.isTopologicalSpace
#align TopCommRing.forget_to_CommRing_topological_space TopCommRing.forgetToCommRingTopologicalSpace

/-- The forgetful functor to Top. -/
instance hasForgetToTop : HasForget₂ TopCommRing TopCat :=
  HasForget₂.mk' (fun R => TopCat.of R) (fun x => rfl) (fun R S f => ⟨⇑f.1, f.2⟩) fun R S f =>
    HEq.rfl
#align TopCommRing.has_forget_to_Top TopCommRing.hasForgetToTop

instance forgetToTopCommRing (R : TopCommRing) : CommRing ((forget₂ TopCommRing TopCat).obj R) :=
  R.isCommRing
#align TopCommRing.forget_to_Top_comm_ring TopCommRing.forgetToTopCommRing

instance forget_to_topCat_topologicalRing (R : TopCommRing) :
    TopologicalRing ((forget₂ TopCommRing TopCat).obj R) :=
  R.is_topologicalRing
#align TopCommRing.forget_to_Top_topological_ring TopCommRing.forget_to_topCat_topologicalRing

/-- The forgetful functors to `Type` do not reflect isomorphisms,
but the forgetful functor from `TopCommRing` to `Top` does.
-/
instance : ReflectsIsomorphisms (forget₂ TopCommRing.{u} TopCat.{u})
    where reflects X Y f _ := by
    skip
    -- We have an isomorphism in `Top`,
    let i_Top := as_iso ((forget₂ TopCommRing TopCat).map f)
    -- and a `ring_equiv`.
    let e_Ring : X ≃+* Y := { f.1, ((forget TopCat).mapIso i_Top).toEquiv with }
    -- Putting these together we obtain the isomorphism we're after:
    exact
      ⟨⟨⟨e_Ring.symm, i_Top.inv.2⟩,
          ⟨by
            ext x
            exact e_Ring.left_inv x, by
            ext x
            exact e_Ring.right_inv x⟩⟩⟩

end TopCommRing


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.complex.log
import analysis.special_functions.exp_deriv

/-!
# Differentiability of the complex `log` function

-/

noncomputable theory

namespace complex

open set filter

open_locale real topological_space

/-- `complex.exp` as a `local_homeomorph` with `source = {z | -π < im z < π}` and
`target = {z | 0 < re z} ∪ {z | im z ≠ 0}`. This definition is used to prove that `complex.log`
is complex differentiable at all points but the negative real semi-axis. -/
def exp_local_homeomorph : local_homeomorph ℂ ℂ :=
local_homeomorph.of_continuous_open
{ to_fun := exp,
  inv_fun := log,
  source := {z : ℂ | z.im ∈ Ioo (- π) π},
  target := {z : ℂ | 0 < z.re} ∪ {z : ℂ | z.im ≠ 0},
  map_source' :=
    begin
      rintro ⟨x, y⟩ ⟨h₁ : -π < y, h₂ : y < π⟩,
      refine (not_or_of_imp $ λ hz, _).symm,
      obtain rfl : y = 0,
      { rw exp_im at hz,
        simpa [(real.exp_pos _).ne', real.sin_eq_zero_iff_of_lt_of_lt h₁ h₂] using hz },
      rw [mem_set_of_eq, ← of_real_def, exp_of_real_re],
      exact real.exp_pos x
    end,
  map_target' := λ z h,
    suffices 0 ≤ z.re ∨ z.im ≠ 0,
      by simpa [log_im, neg_pi_lt_arg, (arg_le_pi _).lt_iff_ne, arg_eq_pi_iff, not_and_distrib],
    h.imp (λ h, le_of_lt h) id,
  left_inv' := λ x hx, log_exp hx.1 (le_of_lt hx.2),
  right_inv' := λ x hx, exp_log $ by { rintro rfl, simpa [lt_irrefl] using hx } }
continuous_exp.continuous_on is_open_map_exp (is_open_Ioo.preimage continuous_im)

lemma has_strict_deriv_at_log {x : ℂ} (h : 0 < x.re ∨ x.im ≠ 0) :
  has_strict_deriv_at log x⁻¹ x :=
have h0 :  x ≠ 0, by { rintro rfl, simpa [lt_irrefl] using h },
exp_local_homeomorph.has_strict_deriv_at_symm h h0 $
  by simpa [exp_log h0] using has_strict_deriv_at_exp (log x)

lemma has_strict_fderiv_at_log_real {x : ℂ} (h : 0 < x.re ∨ x.im ≠ 0) :
  has_strict_fderiv_at log (x⁻¹ • (1 : ℂ →L[ℝ] ℂ)) x :=
(has_strict_deriv_at_log h).complex_to_real_fderiv

lemma times_cont_diff_at_log {x : ℂ} (h : 0 < x.re ∨ x.im ≠ 0) {n : with_top ℕ} :
  times_cont_diff_at ℂ n log x :=
exp_local_homeomorph.times_cont_diff_at_symm_deriv (exp_ne_zero $ log x) h
  (has_deriv_at_exp _) times_cont_diff_exp.times_cont_diff_at

end complex

section log_deriv

open complex filter
open_locale topological_space

variables {α : Type*} [topological_space α] {E : Type*} [normed_group E] [normed_space ℂ E]

lemma has_strict_fderiv_at.clog {f : E → ℂ} {f' : E →L[ℂ] ℂ} {x : E}
  (h₁ : has_strict_fderiv_at f f' x) (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_strict_fderiv_at (λ t, log (f t)) ((f x)⁻¹ • f') x :=
(has_strict_deriv_at_log h₂).comp_has_strict_fderiv_at x h₁

lemma has_strict_deriv_at.clog {f : ℂ → ℂ} {f' x : ℂ} (h₁ : has_strict_deriv_at f f' x)
  (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_strict_deriv_at (λ t, log (f t)) (f' / f x) x :=
by { rw div_eq_inv_mul, exact (has_strict_deriv_at_log h₂).comp x h₁ }

lemma has_strict_deriv_at.clog_real {f : ℝ → ℂ} {x : ℝ} {f' : ℂ} (h₁ : has_strict_deriv_at f f' x)
  (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_strict_deriv_at (λ t, log (f t)) (f' / f x) x :=
by simpa only [div_eq_inv_mul]
  using (has_strict_fderiv_at_log_real h₂).comp_has_strict_deriv_at x h₁

lemma has_fderiv_at.clog {f : E → ℂ} {f' : E →L[ℂ] ℂ} {x : E}
  (h₁ : has_fderiv_at f f' x) (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_fderiv_at (λ t, log (f t)) ((f x)⁻¹ • f') x :=
(has_strict_deriv_at_log h₂).has_deriv_at.comp_has_fderiv_at x h₁

lemma has_deriv_at.clog {f : ℂ → ℂ} {f' x : ℂ} (h₁ : has_deriv_at f f' x)
  (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_deriv_at (λ t, log (f t)) (f' / f x) x :=
by { rw div_eq_inv_mul, exact (has_strict_deriv_at_log h₂).has_deriv_at.comp x h₁ }

lemma has_deriv_at.clog_real {f : ℝ → ℂ} {x : ℝ} {f' : ℂ} (h₁ : has_deriv_at f f' x)
  (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_deriv_at (λ t, log (f t)) (f' / f x) x :=
by simpa only [div_eq_inv_mul]
  using (has_strict_fderiv_at_log_real h₂).has_fderiv_at.comp_has_deriv_at x h₁

lemma differentiable_at.clog {f : E → ℂ} {x : E} (h₁ : differentiable_at ℂ f x)
  (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  differentiable_at ℂ (λ t, log (f t)) x :=
(h₁.has_fderiv_at.clog h₂).differentiable_at

lemma has_fderiv_within_at.clog {f : E → ℂ} {f' : E →L[ℂ] ℂ} {s : set E} {x : E}
  (h₁ : has_fderiv_within_at f f' s x) (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_fderiv_within_at (λ t, log (f t)) ((f x)⁻¹ • f') s x :=
(has_strict_deriv_at_log h₂).has_deriv_at.comp_has_fderiv_within_at x h₁

lemma has_deriv_within_at.clog {f : ℂ → ℂ} {f' x : ℂ} {s : set ℂ}
  (h₁ : has_deriv_within_at f f' s x) (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_deriv_within_at (λ t, log (f t)) (f' / f x) s x :=
by { rw div_eq_inv_mul,
     exact (has_strict_deriv_at_log h₂).has_deriv_at.comp_has_deriv_within_at x h₁ }

lemma has_deriv_within_at.clog_real {f : ℝ → ℂ} {s : set ℝ} {x : ℝ} {f' : ℂ}
  (h₁ : has_deriv_within_at f f' s x) (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_deriv_within_at (λ t, log (f t)) (f' / f x) s x :=
by simpa only [div_eq_inv_mul]
  using (has_strict_fderiv_at_log_real h₂).has_fderiv_at.comp_has_deriv_within_at x h₁

lemma differentiable_within_at.clog {f : E → ℂ} {s : set E} {x : E}
  (h₁ : differentiable_within_at ℂ f s x) (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  differentiable_within_at ℂ (λ t, log (f t)) s x :=
(h₁.has_fderiv_within_at.clog h₂).differentiable_within_at

lemma differentiable_on.clog {f : E → ℂ} {s : set E}
  (h₁ : differentiable_on ℂ f s) (h₂ : ∀ x ∈ s, 0 < (f x).re ∨ (f x).im ≠ 0) :
  differentiable_on ℂ (λ t, log (f t)) s :=
λ x hx, (h₁ x hx).clog (h₂ x hx)

lemma differentiable.clog {f : E → ℂ} (h₁ : differentiable ℂ f)
  (h₂ : ∀ x, 0 < (f x).re ∨ (f x).im ≠ 0) :
  differentiable ℂ (λ t, log (f t)) :=
λ x, (h₁ x).clog (h₂ x)

end log_deriv


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri, Yury Kudryashov
-/

import geometry.manifold.times_cont_mdiff_map

/-!
# Diffeomorphisms
This file implements diffeomorphisms.

## Definitions

* `diffeomorph I I' M M' n`:  `n`-times continuously differentiable diffeomorphism between
  `M` and `M'` with respect to I and I'; we do not introduce a separate definition for the case
  `n = ∞`; we use notation instead.
* `diffeomorph.to_homeomorph`: reinterpret a diffeomorphism as a homeomorphism.
* `continuous_linear_equiv.to_diffeomorph`: reinterpret a continuous equivalence as
  a diffeomorphism.
* `model_with_corners.trans_diffeomorph`: compose a given `model_with_corners` with a diffeomorphism
  between the old and the new target spaces. Useful, e.g, to turn any finite dimensional manifold
  into a manifold modelled on a Euclidean space.
* `diffeomorph.to_trans_diffeomorph`: the identity diffeomorphism between `M` with model `I` and `M`
  with model `I.trans_diffeomorph e`.

## Notations

* `M ≃ₘ^n⟮I, I'⟯ M'`  := `diffeomorph I J M N n`
* `M ≃ₘ⟮I, I'⟯ M'`    := `diffeomorph I J M N ⊤`
* `E ≃ₘ^n[𝕜] E'`      := `E ≃ₘ^n⟮𝓘(𝕜, E), 𝓘(𝕜, E')⟯ E'`
* `E ≃ₘ[𝕜] E'`        := `E ≃ₘ⟮𝓘(𝕜, E), 𝓘(𝕜, E')⟯ E'`

## Implementation notes

This notion of diffeomorphism is needed although there is already a notion of structomorphism
because structomorphisms do not allow the model spaces `H` and `H'` of the two manifolds to be
different, i.e. for a structomorphism one has to impose `H = H'` which is often not the case in
practice.

## Keywords

diffeomorphism, manifold
-/

open_locale manifold topological_space
open function set

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{H : Type*} [topological_space H]
{H' : Type*} [topological_space H']
{G : Type*} [topological_space G]
{I : model_with_corners 𝕜 E H} {I' : model_with_corners 𝕜 E' H'}
{J : model_with_corners 𝕜 F G}

variables {M : Type*} [topological_space M] [charted_space H M]
{M' : Type*} [topological_space M'] [charted_space H' M']
{N : Type*} [topological_space N] [charted_space G N]
{n : with_top ℕ}

section defs

variables (I I' M M' n)

/--
`n`-times continuously differentiable diffeomorphism between `M` and `M'` with respect to I and I'
-/
@[protect_proj, nolint has_inhabited_instance]
structure diffeomorph extends M ≃ M' :=
(times_cont_mdiff_to_fun  : times_cont_mdiff I I' n to_equiv)
(times_cont_mdiff_inv_fun : times_cont_mdiff I' I n to_equiv.symm)

end defs

localized "notation M ` ≃ₘ^` n:1000 `⟮`:50 I `,` J `⟯ ` N := diffeomorph I J M N n" in manifold
localized "notation M ` ≃ₘ⟮` I `,` J `⟯ ` N := diffeomorph I J M N ⊤" in manifold
localized "notation E ` ≃ₘ^` n:1000 `[`:50 𝕜 `] ` E' :=
  diffeomorph (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') E E' n" in manifold
localized "notation E ` ≃ₘ[` 𝕜 `] ` E' :=
  diffeomorph (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') E E' ⊤" in manifold

namespace diffeomorph
instance : has_coe_to_fun (M ≃ₘ^n⟮I, I'⟯ M') := ⟨λ _, M → M', λe, e.to_equiv⟩

instance : has_coe (M ≃ₘ^n⟮I, I'⟯ M') C^n⟮I, M; I', M'⟯ := ⟨λ Φ, ⟨Φ, Φ.times_cont_mdiff_to_fun⟩⟩

@[continuity] protected lemma continuous (h : M ≃ₘ^n⟮I, I'⟯ M') : continuous h :=
h.times_cont_mdiff_to_fun.continuous
protected lemma times_cont_mdiff (h : M ≃ₘ^n⟮I, I'⟯ M') : times_cont_mdiff I I' n h :=
h.times_cont_mdiff_to_fun
protected lemma times_cont_mdiff_at (h : M ≃ₘ^n⟮I, I'⟯ M') {x} : times_cont_mdiff_at I I' n h x :=
h.times_cont_mdiff.times_cont_mdiff_at
protected lemma times_cont_mdiff_within_at (h : M ≃ₘ^n⟮I, I'⟯ M') {s x} :
  times_cont_mdiff_within_at I I' n h s x :=
h.times_cont_mdiff_at.times_cont_mdiff_within_at
protected lemma times_cont_diff (h : E ≃ₘ^n[𝕜] E') : times_cont_diff 𝕜 n h :=
h.times_cont_mdiff.times_cont_diff
protected lemma smooth (h : M ≃ₘ⟮I, I'⟯ M') : smooth I I' h := h.times_cont_mdiff_to_fun
protected lemma mdifferentiable (h : M ≃ₘ^n⟮I, I'⟯ M') (hn : 1 ≤ n) : mdifferentiable I I' h :=
h.times_cont_mdiff.mdifferentiable hn
protected lemma mdifferentiable_on (h : M ≃ₘ^n⟮I, I'⟯ M') (s : set M) (hn : 1 ≤ n) :
  mdifferentiable_on I I' h s :=
(h.mdifferentiable hn).mdifferentiable_on

@[simp] lemma coe_to_equiv (h : M ≃ₘ^n⟮I, I'⟯ M') : ⇑h.to_equiv = h := rfl
@[simp, norm_cast] lemma coe_coe (h : M ≃ₘ^n⟮I, I'⟯ M') : ⇑(h : C^n⟮I, M; I', M'⟯) = h := rfl

lemma to_equiv_injective : injective (diffeomorph.to_equiv : (M ≃ₘ^n⟮I, I'⟯ M') → (M ≃ M'))
| ⟨e, _, _⟩ ⟨e', _, _⟩ rfl := rfl

@[simp] lemma to_equiv_inj {h h' : M ≃ₘ^n⟮I, I'⟯ M'} : h.to_equiv = h'.to_equiv ↔ h = h' :=
to_equiv_injective.eq_iff

/-- Coercion to function `λ h : M ≃ₘ^n⟮I, I'⟯ M', (h : M → M')` is injective. -/
lemma coe_fn_injective : injective (λ (h : M ≃ₘ^n⟮I, I'⟯ M') (x : M), h x) :=
equiv.coe_fn_injective.comp to_equiv_injective

@[ext] lemma ext {h h' : M ≃ₘ^n⟮I, I'⟯ M'} (Heq : ∀ x, h x = h' x) : h = h' :=
coe_fn_injective $ funext Heq

section

variables (M I n)

/-- Identity map as a diffeomorphism. -/
protected def refl : M ≃ₘ^n⟮I, I⟯ M :=
{ times_cont_mdiff_to_fun := times_cont_mdiff_id,
  times_cont_mdiff_inv_fun := times_cont_mdiff_id,
  to_equiv := equiv.refl M }

@[simp] lemma refl_to_equiv : (diffeomorph.refl I M n).to_equiv = equiv.refl _ := rfl
@[simp] lemma coe_refl : ⇑(diffeomorph.refl I M n) = id := rfl

end

/-- Composition of two diffeomorphisms. -/
protected def trans (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : M' ≃ₘ^n⟮I', J⟯ N) :
  M ≃ₘ^n⟮I, J⟯ N :=
{ times_cont_mdiff_to_fun  := h₂.times_cont_mdiff_to_fun.comp h₁.times_cont_mdiff_to_fun,
  times_cont_mdiff_inv_fun := h₁.times_cont_mdiff_inv_fun.comp h₂.times_cont_mdiff_inv_fun,
  to_equiv := h₁.to_equiv.trans h₂.to_equiv }

@[simp] lemma trans_refl (h : M ≃ₘ^n⟮I, I'⟯ M') : h.trans (diffeomorph.refl I' M' n) = h :=
ext $ λ _, rfl
@[simp] lemma refl_trans (h : M ≃ₘ^n⟮I, I'⟯ M') : (diffeomorph.refl I M n).trans h = h :=
ext $ λ _, rfl
@[simp] lemma coe_trans (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : M' ≃ₘ^n⟮I', J⟯ N) :
  ⇑(h₁.trans h₂) = h₂ ∘ h₁ := rfl

/-- Inverse of a diffeomorphism. -/
protected def symm (h : M ≃ₘ^n⟮I, J⟯ N) : N ≃ₘ^n⟮J, I⟯ M :=
{ times_cont_mdiff_to_fun  := h.times_cont_mdiff_inv_fun,
  times_cont_mdiff_inv_fun := h.times_cont_mdiff_to_fun,
  to_equiv := h.to_equiv.symm }

@[simp] lemma apply_symm_apply (h : M ≃ₘ^n⟮I, J⟯ N) (x : N) : h (h.symm x) = x :=
h.to_equiv.apply_symm_apply x
@[simp] lemma symm_apply_apply (h : M ≃ₘ^n⟮I, J⟯ N) (x : M) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

@[simp] lemma symm_refl : (diffeomorph.refl I M n).symm = diffeomorph.refl I M n :=
ext $ λ _, rfl
@[simp] lemma trans_symm (h : M ≃ₘ^n⟮I, J⟯ N) : h.trans h.symm = diffeomorph.refl I M n :=
ext h.symm_apply_apply
@[simp] lemma symm_trans (h : M ≃ₘ^n⟮I, J⟯ N) : h.symm.trans h = diffeomorph.refl J N n :=
ext h.apply_symm_apply
@[simp] lemma symm_trans' (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : M' ≃ₘ^n⟮I', J⟯ N) :
  (h₁.trans h₂).symm = h₂.symm.trans h₁.symm := rfl
@[simp] lemma symm_to_equiv (h : M ≃ₘ^n⟮I, J⟯ N) : h.symm.to_equiv = h.to_equiv.symm := rfl
@[simp, mfld_simps] lemma to_equiv_coe_symm (h : M ≃ₘ^n⟮I, J⟯ N) : ⇑h.to_equiv.symm = h.symm := rfl

lemma image_eq_preimage (h : M ≃ₘ^n⟮I, J⟯ N) (s : set M) : h '' s = h.symm ⁻¹' s :=
h.to_equiv.image_eq_preimage s
lemma symm_image_eq_preimage (h : M ≃ₘ^n⟮I, J⟯ N) (s : set N) : h.symm '' s = h ⁻¹' s :=
h.symm.image_eq_preimage s

@[simp, mfld_simps] lemma range_comp {α} (h : M ≃ₘ^n⟮I, J⟯ N) (f : α → M) :
  range (h ∘ f) = h.symm ⁻¹' (range f) :=
by rw [range_comp, image_eq_preimage]

@[simp] lemma image_symm_image (h : M ≃ₘ^n⟮I, J⟯ N) (s : set N) : h '' (h.symm '' s) = s :=
h.to_equiv.image_symm_image s
@[simp] lemma symm_image_image (h : M ≃ₘ^n⟮I, J⟯ N) (s : set M) : h.symm '' (h '' s) = s :=
h.to_equiv.symm_image_image s

/-- A diffeomorphism is a homeomorphism. -/
def to_homeomorph (h : M ≃ₘ^n⟮I, J⟯ N) : M ≃ₜ N :=
⟨h.to_equiv, h.continuous, h.symm.continuous⟩

@[simp] lemma to_homeomorph_to_equiv (h : M ≃ₘ^n⟮I, J⟯ N) :
  h.to_homeomorph.to_equiv = h.to_equiv :=
rfl
@[simp] lemma symm_to_homeomorph (h : M ≃ₘ^n⟮I, J⟯ N) :
  h.symm.to_homeomorph = h.to_homeomorph.symm :=
rfl

@[simp] lemma coe_to_homeomorph (h : M ≃ₘ^n⟮I, J⟯ N) : ⇑h.to_homeomorph = h := rfl
@[simp] lemma coe_to_homeomorph_symm (h : M ≃ₘ^n⟮I, J⟯ N) :
  ⇑h.to_homeomorph.symm = h.symm := rfl

@[simp] lemma times_cont_mdiff_within_at_comp_diffeomorph_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : N → M'}
  {s x} (hm : m ≤ n) :
  times_cont_mdiff_within_at I I' m (f ∘ h) s x ↔
    times_cont_mdiff_within_at J I' m f (h.symm ⁻¹' s) (h x) :=
begin
  split,
  { intro Hfh,
    rw [← h.symm_apply_apply x] at Hfh,
    simpa only [(∘), h.apply_symm_apply]
      using Hfh.comp (h x) (h.symm.times_cont_mdiff_within_at.of_le hm) (maps_to_preimage _ _) },
  { rw ← h.image_eq_preimage,
    exact λ hf, hf.comp x (h.times_cont_mdiff_within_at.of_le hm) (maps_to_image _ _) }
end

@[simp] lemma times_cont_mdiff_on_comp_diffeomorph_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : N → M'}
  {s} (hm : m ≤ n) :
  times_cont_mdiff_on I I' m (f ∘ h) s ↔ times_cont_mdiff_on J I' m f (h.symm ⁻¹' s) :=
h.to_equiv.forall_congr $ λ x, by simp only [hm, coe_to_equiv, symm_apply_apply,
  times_cont_mdiff_within_at_comp_diffeomorph_iff, mem_preimage]

@[simp] lemma times_cont_mdiff_at_comp_diffeomorph_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : N → M'} {x}
  (hm : m ≤ n) :
  times_cont_mdiff_at I I' m (f ∘ h) x ↔ times_cont_mdiff_at J I' m f (h x) :=
h.times_cont_mdiff_within_at_comp_diffeomorph_iff hm

@[simp] lemma times_cont_mdiff_comp_diffeomorph_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : N → M'}
  (hm : m ≤ n) :
  times_cont_mdiff I I' m (f ∘ h) ↔ times_cont_mdiff J I' m f :=
h.to_equiv.forall_congr $ λ x, (h.times_cont_mdiff_at_comp_diffeomorph_iff hm)

@[simp] lemma times_cont_mdiff_within_at_diffeomorph_comp_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : M' → M}
  (hm : m ≤ n) {s x} :
  times_cont_mdiff_within_at I' J m (h ∘ f) s x ↔ times_cont_mdiff_within_at I' I m f s x :=
⟨λ Hhf, by simpa only [(∘), h.symm_apply_apply]
  using (h.symm.times_cont_mdiff_at.of_le hm).comp_times_cont_mdiff_within_at _ Hhf,
  λ Hf, (h.times_cont_mdiff_at.of_le hm).comp_times_cont_mdiff_within_at _ Hf⟩

@[simp] lemma times_cont_mdiff_at_diffeomorph_comp_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : M' → M}
  (hm : m ≤ n) {x} :
  times_cont_mdiff_at I' J m (h ∘ f) x ↔ times_cont_mdiff_at I' I m f x :=
h.times_cont_mdiff_within_at_diffeomorph_comp_iff hm

@[simp] lemma times_cont_mdiff_on_diffeomorph_comp_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : M' → M}
  (hm : m ≤ n) {s} :
  times_cont_mdiff_on I' J m (h ∘ f) s ↔ times_cont_mdiff_on I' I m f s :=
forall_congr $ λ x, forall_congr $ λ hx, h.times_cont_mdiff_within_at_diffeomorph_comp_iff hm

@[simp] lemma times_cont_mdiff_diffeomorph_comp_iff {m} (h : M ≃ₘ^n⟮I, J⟯ N) {f : M' → M}
  (hm : m ≤ n) :
  times_cont_mdiff I' J m (h ∘ f) ↔ times_cont_mdiff I' I m f :=
forall_congr $ λ x, h.times_cont_mdiff_within_at_diffeomorph_comp_iff hm

lemma to_local_homeomorph_mdifferentiable (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n) :
  h.to_homeomorph.to_local_homeomorph.mdifferentiable I J :=
⟨h.mdifferentiable_on _ hn, h.symm.mdifferentiable_on _ hn⟩

variables [smooth_manifold_with_corners I M] [smooth_manifold_with_corners J N]

lemma unique_mdiff_on_image_aux (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n)
  {s : set M} (hs : unique_mdiff_on I s) :
  unique_mdiff_on J (h '' s) :=
begin
  convert hs.unique_mdiff_on_preimage (h.to_local_homeomorph_mdifferentiable hn),
  simp [h.image_eq_preimage]
end

@[simp] lemma unique_mdiff_on_image (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n) {s : set M} :
  unique_mdiff_on J (h '' s) ↔ unique_mdiff_on I s :=
⟨λ hs, h.symm_image_image s ▸ h.symm.unique_mdiff_on_image_aux hn hs,
  h.unique_mdiff_on_image_aux hn⟩

@[simp] lemma unique_mdiff_on_preimage (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n) {s : set N} :
  unique_mdiff_on I (h ⁻¹' s) ↔ unique_mdiff_on J s :=
h.symm_image_eq_preimage s ▸ h.symm.unique_mdiff_on_image hn

@[simp] lemma unique_diff_on_image (h : E ≃ₘ^n[𝕜] F) (hn : 1 ≤ n) {s : set E} :
  unique_diff_on 𝕜 (h '' s) ↔ unique_diff_on 𝕜 s :=
by simp only [← unique_mdiff_on_iff_unique_diff_on, unique_mdiff_on_image, hn]

@[simp] lemma unique_diff_on_preimage (h : E ≃ₘ^n[𝕜] F) (hn : 1 ≤ n) {s : set F} :
  unique_diff_on 𝕜 (h ⁻¹' s) ↔ unique_diff_on 𝕜 s :=
h.symm_image_eq_preimage s ▸ h.symm.unique_diff_on_image hn

end diffeomorph

namespace continuous_linear_equiv

variable (e : E ≃L[𝕜] E')

/-- A continuous linear equivalence between normed spaces is a diffeomorphism. -/
def to_diffeomorph : E ≃ₘ[𝕜] E' :=
{ times_cont_mdiff_to_fun := e.times_cont_diff.times_cont_mdiff,
  times_cont_mdiff_inv_fun := e.symm.times_cont_diff.times_cont_mdiff,
  to_equiv := e.to_linear_equiv.to_equiv }

@[simp] lemma coe_to_diffeomorph : ⇑e.to_diffeomorph = e := rfl
@[simp] lemma symm_to_diffeomorph : e.symm.to_diffeomorph = e.to_diffeomorph.symm := rfl
@[simp] lemma coe_to_diffeomorph_symm : ⇑e.to_diffeomorph.symm = e.symm := rfl

end continuous_linear_equiv

namespace model_with_corners

variables (I) (e : E ≃ₘ[𝕜] E')

/-- Apply a diffeomorphism (e.g., a continuous linear equivalence) to the model vector space. -/
def trans_diffeomorph (I : model_with_corners 𝕜 E H) (e : E ≃ₘ[𝕜] E') :
  model_with_corners 𝕜 E' H :=
{ to_local_equiv := I.to_local_equiv.trans e.to_equiv.to_local_equiv,
  source_eq := by simp,
  unique_diff' := by simp [range_comp e, I.unique_diff],
  continuous_to_fun := e.continuous.comp I.continuous,
  continuous_inv_fun := I.continuous_symm.comp e.symm.continuous }

@[simp, mfld_simps] lemma coe_trans_diffeomorph : ⇑(I.trans_diffeomorph e) = e ∘ I := rfl
@[simp, mfld_simps] lemma coe_trans_diffeomorph_symm :
  ⇑(I.trans_diffeomorph e).symm = I.symm ∘ e.symm := rfl

lemma trans_diffeomorph_range : range (I.trans_diffeomorph e) = e '' (range I) :=
range_comp e I

lemma coe_ext_chart_at_trans_diffeomorph (x : M) :
  ⇑(ext_chart_at (I.trans_diffeomorph e) x) = e ∘ ext_chart_at I x := rfl

lemma coe_ext_chart_at_trans_diffeomorph_symm (x : M) :
  ⇑(ext_chart_at (I.trans_diffeomorph e) x).symm = (ext_chart_at I x).symm ∘ e.symm := rfl

lemma ext_chart_at_trans_diffeomorph_target (x : M) :
  (ext_chart_at (I.trans_diffeomorph e) x).target = e.symm ⁻¹' (ext_chart_at I x).target :=
by simp only [range_comp e, e.image_eq_preimage, preimage_preimage] with mfld_simps

end model_with_corners

namespace diffeomorph

variables (e : E ≃ₘ[𝕜] F)

instance smooth_manifold_with_corners_trans_diffeomorph [smooth_manifold_with_corners I M] :
  smooth_manifold_with_corners (I.trans_diffeomorph e) M :=
begin
  refine smooth_manifold_with_corners_of_times_cont_diff_on  _ _ (λ e₁ e₂ h₁ h₂, _),
  refine e.times_cont_diff.comp_times_cont_diff_on
    (((times_cont_diff_groupoid ⊤ I).compatible h₁ h₂).1.comp
      e.symm.times_cont_diff.times_cont_diff_on _),
  mfld_set_tac
end

variables (I M)

/-- The identity diffeomorphism between a manifold with model `I` and the same manifold
with model `I.trans_diffeomorph e`. -/
def to_trans_diffeomorph (e : E ≃ₘ[𝕜] F) : M ≃ₘ⟮I, I.trans_diffeomorph e⟯ M :=
{ to_equiv := equiv.refl M,
  times_cont_mdiff_to_fun := λ x,
    begin
      refine times_cont_mdiff_within_at_iff.2 ⟨continuous_within_at_id, _⟩,
      refine e.times_cont_diff.times_cont_diff_within_at.congr' (λ y hy, _) _,
      { simp only [equiv.coe_refl, id, (∘), I.coe_ext_chart_at_trans_diffeomorph,
          (ext_chart_at I x).right_inv hy.1] },
      exact ⟨(ext_chart_at I x).map_source (mem_ext_chart_source I x), trivial,
        by simp only with mfld_simps⟩
    end,
  times_cont_mdiff_inv_fun := λ x,
    begin
      refine times_cont_mdiff_within_at_iff.2 ⟨continuous_within_at_id, _⟩,
      refine e.symm.times_cont_diff.times_cont_diff_within_at.congr' (λ y hy, _) _,
      { simp only [mem_inter_eq, I.ext_chart_at_trans_diffeomorph_target] at hy,
        simp only [equiv.coe_refl, equiv.refl_symm, id, (∘),
          I.coe_ext_chart_at_trans_diffeomorph_symm, (ext_chart_at I x).right_inv hy.1] },
      exact ⟨(ext_chart_at _ x).map_source (mem_ext_chart_source _ x), trivial,
        by simp only [e.symm_apply_apply, equiv.refl_symm, equiv.coe_refl] with mfld_simps⟩
    end }

variables {I M}

@[simp] lemma times_cont_mdiff_within_at_trans_diffeomorph_right {f : M' → M} {x s} :
  times_cont_mdiff_within_at I' (I.trans_diffeomorph e) n f s x ↔
    times_cont_mdiff_within_at I' I n f s x :=
(to_trans_diffeomorph I M e).times_cont_mdiff_within_at_diffeomorph_comp_iff le_top

@[simp] lemma times_cont_mdiff_at_trans_diffeomorph_right {f : M' → M} {x} :
  times_cont_mdiff_at I' (I.trans_diffeomorph e) n f x ↔ times_cont_mdiff_at I' I n f x :=
(to_trans_diffeomorph I M e).times_cont_mdiff_at_diffeomorph_comp_iff le_top

@[simp] lemma times_cont_mdiff_on_trans_diffeomorph_right {f : M' → M} {s} :
  times_cont_mdiff_on I' (I.trans_diffeomorph e) n f s ↔ times_cont_mdiff_on I' I n f s :=
(to_trans_diffeomorph I M e).times_cont_mdiff_on_diffeomorph_comp_iff le_top

@[simp] lemma times_cont_mdiff_trans_diffeomorph_right {f : M' → M} :
  times_cont_mdiff I' (I.trans_diffeomorph e) n f ↔ times_cont_mdiff I' I n f :=
(to_trans_diffeomorph I M e).times_cont_mdiff_diffeomorph_comp_iff le_top

@[simp] lemma smooth_trans_diffeomorph_right {f : M' → M} :
  smooth I' (I.trans_diffeomorph e) f ↔ smooth I' I f :=
times_cont_mdiff_trans_diffeomorph_right e

@[simp] lemma times_cont_mdiff_within_at_trans_diffeomorph_left {f : M → M'} {x s} :
  times_cont_mdiff_within_at (I.trans_diffeomorph e) I' n f s x ↔
    times_cont_mdiff_within_at I I' n f s x :=
((to_trans_diffeomorph I M e).times_cont_mdiff_within_at_comp_diffeomorph_iff le_top).symm

@[simp] lemma times_cont_mdiff_at_trans_diffeomorph_left {f : M → M'} {x} :
  times_cont_mdiff_at (I.trans_diffeomorph e) I' n f x ↔ times_cont_mdiff_at I I' n f x :=
((to_trans_diffeomorph I M e).times_cont_mdiff_at_comp_diffeomorph_iff le_top).symm

@[simp] lemma times_cont_mdiff_on_trans_diffeomorph_left {f : M → M'} {s} :
  times_cont_mdiff_on (I.trans_diffeomorph e) I' n f s ↔ times_cont_mdiff_on I I' n f s :=
((to_trans_diffeomorph I M e).times_cont_mdiff_on_comp_diffeomorph_iff le_top).symm

@[simp] lemma times_cont_mdiff_trans_diffeomorph_left {f : M → M'} :
  times_cont_mdiff (I.trans_diffeomorph e) I' n f ↔ times_cont_mdiff I I' n f :=
((to_trans_diffeomorph I M e).times_cont_mdiff_comp_diffeomorph_iff le_top).symm

@[simp] lemma smooth_trans_diffeomorph_left {f : M → M'} :
  smooth (I.trans_diffeomorph e) I' f ↔ smooth I I' f :=
e.times_cont_mdiff_trans_diffeomorph_left

end diffeomorph


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.roots_of_unity
import Mathlib.analysis.special_functions.trigonometric
import Mathlib.analysis.special_functions.pow
import Mathlib.PostPort

namespace Mathlib

/-!
# Complex roots of unity

In this file we show that the `n`-th complex roots of unity
are exactly the complex numbers `e ^ (2 * real.pi * complex.I * (i / n))` for `i ∈ finset.range n`.

## Main declarations

* `complex.mem_roots_of_unity`: the complex `n`-th roots of unity are exactly the
  complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`.
* `complex.card_roots_of_unity`: the number of `n`-th roots of unity is exactly `n`.

-/

namespace complex

theorem is_primitive_root_exp_of_coprime (i : ℕ) (n : ℕ) (h0 : n ≠ 0) (hi : nat.coprime i n) :
    is_primitive_root (exp (bit0 1 * ↑real.pi * I * (↑i / ↑n))) n :=
  sorry

theorem is_primitive_root_exp (n : ℕ) (h0 : n ≠ 0) :
    is_primitive_root (exp (bit0 1 * ↑real.pi * I / ↑n)) n :=
  sorry

theorem is_primitive_root_iff (ζ : ℂ) (n : ℕ) (hn : n ≠ 0) :
    is_primitive_root ζ n ↔
        ∃ (i : ℕ),
          ∃ (H : i < n), ∃ (hi : nat.coprime i n), exp (bit0 1 * ↑real.pi * I * (↑i / ↑n)) = ζ :=
  sorry

/-- The complex `n`-th roots of unity are exactly the
complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`. -/
theorem mem_roots_of_unity (n : ℕ+) (x : units ℂ) :
    x ∈ roots_of_unity n ℂ ↔
        ∃ (i : ℕ), ∃ (H : i < ↑n), exp (bit0 1 * ↑real.pi * I * (↑i / ↑n)) = ↑x :=
  sorry

theorem card_roots_of_unity (n : ℕ+) : fintype.card ↥(roots_of_unity n ℂ) = ↑n :=
  is_primitive_root.card_roots_of_unity (is_primitive_root_exp (↑n) (pnat.ne_zero n))

theorem card_primitive_roots (k : ℕ) (h : k ≠ 0) :
    finset.card (primitive_roots k ℂ) = nat.totient k :=
  is_primitive_root.card_primitive_roots (is_primitive_root_exp k h) (nat.pos_of_ne_zero h)

end Mathlib


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro, Neil Strickland
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.prime
import Mathlib.data.pnat.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Primality and GCD on pnat

This file extends the theory of `ℕ+` with `gcd`, `lcm` and `prime` functions, analogous to those on
`nat`.
-/

namespace nat.primes

protected instance coe_pnat : has_coe primes ℕ+ :=
  has_coe.mk fun (p : primes) => { val := ↑p, property := sorry }

theorem coe_pnat_nat (p : primes) : ↑↑p = ↑p := rfl

theorem coe_pnat_inj (p : primes) (q : primes) : ↑p = ↑q → p = q := sorry

end nat.primes

namespace pnat

/-- The greatest common divisor (gcd) of two positive natural numbers,
  viewed as positive natural number. -/
def gcd (n : ℕ+) (m : ℕ+) : ℕ+ := { val := nat.gcd ↑n ↑m, property := sorry }

/-- The least common multiple (lcm) of two positive natural numbers,
  viewed as positive natural number. -/
def lcm (n : ℕ+) (m : ℕ+) : ℕ+ := { val := nat.lcm ↑n ↑m, property := sorry }

@[simp] theorem gcd_coe (n : ℕ+) (m : ℕ+) : ↑(gcd n m) = nat.gcd ↑n ↑m := rfl

@[simp] theorem lcm_coe (n : ℕ+) (m : ℕ+) : ↑(lcm n m) = nat.lcm ↑n ↑m := rfl

theorem gcd_dvd_left (n : ℕ+) (m : ℕ+) : gcd n m ∣ n := iff.mpr dvd_iff (nat.gcd_dvd_left ↑n ↑m)

theorem gcd_dvd_right (n : ℕ+) (m : ℕ+) : gcd n m ∣ m := iff.mpr dvd_iff (nat.gcd_dvd_right ↑n ↑m)

theorem dvd_gcd {m : ℕ+} {n : ℕ+} {k : ℕ+} (hm : k ∣ m) (hn : k ∣ n) : k ∣ gcd m n :=
  iff.mpr dvd_iff (nat.dvd_gcd (iff.mp dvd_iff hm) (iff.mp dvd_iff hn))

theorem dvd_lcm_left (n : ℕ+) (m : ℕ+) : n ∣ lcm n m := iff.mpr dvd_iff (nat.dvd_lcm_left ↑n ↑m)

theorem dvd_lcm_right (n : ℕ+) (m : ℕ+) : m ∣ lcm n m := iff.mpr dvd_iff (nat.dvd_lcm_right ↑n ↑m)

theorem lcm_dvd {m : ℕ+} {n : ℕ+} {k : ℕ+} (hm : m ∣ k) (hn : n ∣ k) : lcm m n ∣ k :=
  iff.mpr dvd_iff (nat.lcm_dvd (iff.mp dvd_iff hm) (iff.mp dvd_iff hn))

theorem gcd_mul_lcm (n : ℕ+) (m : ℕ+) : gcd n m * lcm n m = n * m :=
  subtype.eq (nat.gcd_mul_lcm ↑n ↑m)

theorem eq_one_of_lt_two {n : ℕ+} : n < bit0 1 → n = 1 :=
  fun (h : n < bit0 1) =>
    le_antisymm
      (id
        (fun (h : n < 1 + 1) => eq.mp (Eq._oldrec (Eq.refl (n < 1 + 1)) (propext lt_add_one_iff)) h)
        h)
      (one_le n)

/-! ### Prime numbers -/

/-- Primality predicate for `ℕ+`, defined in terms of `nat.prime`. -/
def prime (p : ℕ+) := nat.prime ↑p

theorem prime.one_lt {p : ℕ+} : prime p → 1 < p := nat.prime.one_lt

theorem prime_two : prime (bit0 1) := nat.prime_two

theorem dvd_prime {p : ℕ+} {m : ℕ+} (pp : prime p) : m ∣ p ↔ m = 1 ∨ m = p := sorry

theorem prime.ne_one {p : ℕ+} : prime p → p ≠ 1 := sorry

@[simp] theorem not_prime_one : ¬prime 1 := nat.not_prime_one

theorem prime.not_dvd_one {p : ℕ+} : prime p → ¬p ∣ 1 :=
  fun (pp : prime p) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (¬p ∣ 1)) (propext dvd_iff))) (nat.prime.not_dvd_one pp)

theorem exists_prime_and_dvd {n : ℕ+} : bit0 1 ≤ n → ∃ (p : ℕ+), prime p ∧ p ∣ n := sorry

/-! ### Coprime numbers and gcd -/

/-- Two pnats are coprime if their gcd is 1. -/
def coprime (m : ℕ+) (n : ℕ+) := gcd m n = 1

@[simp] theorem coprime_coe {m : ℕ+} {n : ℕ+} : nat.coprime ↑m ↑n ↔ coprime m n := sorry

theorem coprime.mul {k : ℕ+} {m : ℕ+} {n : ℕ+} : coprime m k → coprime n k → coprime (m * n) k :=
  sorry

theorem coprime.mul_right {k : ℕ+} {m : ℕ+} {n : ℕ+} :
    coprime k m → coprime k n → coprime k (m * n) :=
  sorry

theorem gcd_comm {m : ℕ+} {n : ℕ+} : gcd m n = gcd n m := sorry

theorem gcd_eq_left_iff_dvd {m : ℕ+} {n : ℕ+} : m ∣ n ↔ gcd m n = m := sorry

theorem gcd_eq_right_iff_dvd {m : ℕ+} {n : ℕ+} : m ∣ n ↔ gcd n m = m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m ∣ n ↔ gcd n m = m)) gcd_comm)) gcd_eq_left_iff_dvd

theorem coprime.gcd_mul_left_cancel (m : ℕ+) {n : ℕ+} {k : ℕ+} :
    coprime k n → gcd (k * m) n = gcd m n :=
  sorry

theorem coprime.gcd_mul_right_cancel (m : ℕ+) {n : ℕ+} {k : ℕ+} :
    coprime k n → gcd (m * k) n = gcd m n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coprime k n → gcd (m * k) n = gcd m n)) (mul_comm m k)))
    (coprime.gcd_mul_left_cancel m)

theorem coprime.gcd_mul_left_cancel_right (m : ℕ+) {n : ℕ+} {k : ℕ+} :
    coprime k m → gcd m (k * n) = gcd m n :=
  sorry

theorem coprime.gcd_mul_right_cancel_right (m : ℕ+) {n : ℕ+} {k : ℕ+} :
    coprime k m → gcd m (n * k) = gcd m n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coprime k m → gcd m (n * k) = gcd m n)) (mul_comm n k)))
    (coprime.gcd_mul_left_cancel_right m)

@[simp] theorem one_gcd {n : ℕ+} : gcd 1 n = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd 1 n = 1)) (Eq.symm (propext gcd_eq_left_iff_dvd))))
    (one_dvd n)

@[simp] theorem gcd_one {n : ℕ+} : gcd n 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd n 1 = 1)) gcd_comm)) one_gcd

theorem coprime.symm {m : ℕ+} {n : ℕ+} : coprime m n → coprime n m :=
  eq.mpr (id (imp_congr_eq (coprime.equations._eqn_1 m n) (coprime.equations._eqn_1 n m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd m n = 1 → gcd n m = 1)) gcd_comm))
      (eq.mpr (id (propext imp_self)) trivial))

@[simp] theorem one_coprime {n : ℕ+} : coprime 1 n := one_gcd

@[simp] theorem coprime_one {n : ℕ+} : coprime n 1 := coprime.symm one_coprime

theorem coprime.coprime_dvd_left {m : ℕ+} {k : ℕ+} {n : ℕ+} : m ∣ k → coprime k n → coprime m n :=
  sorry

theorem coprime.factor_eq_gcd_left {a : ℕ+} {b : ℕ+} {m : ℕ+} {n : ℕ+} (cop : coprime m n)
    (am : a ∣ m) (bn : b ∣ n) : a = gcd (a * b) m :=
  sorry

theorem coprime.factor_eq_gcd_right {a : ℕ+} {b : ℕ+} {m : ℕ+} {n : ℕ+} (cop : coprime m n)
    (am : a ∣ m) (bn : b ∣ n) : a = gcd (b * a) m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = gcd (b * a) m)) (mul_comm b a)))
    (coprime.factor_eq_gcd_left cop am bn)

theorem coprime.factor_eq_gcd_left_right {a : ℕ+} {b : ℕ+} {m : ℕ+} {n : ℕ+} (cop : coprime m n)
    (am : a ∣ m) (bn : b ∣ n) : a = gcd m (a * b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = gcd m (a * b))) gcd_comm))
    (coprime.factor_eq_gcd_left cop am bn)

theorem coprime.factor_eq_gcd_right_right {a : ℕ+} {b : ℕ+} {m : ℕ+} {n : ℕ+} (cop : coprime m n)
    (am : a ∣ m) (bn : b ∣ n) : a = gcd m (b * a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = gcd m (b * a))) gcd_comm))
    (coprime.factor_eq_gcd_right cop am bn)

theorem coprime.gcd_mul (k : ℕ+) {m : ℕ+} {n : ℕ+} (h : coprime m n) :
    gcd k (m * n) = gcd k m * gcd k n :=
  sorry

theorem gcd_eq_left {m : ℕ+} {n : ℕ+} : m ∣ n → gcd m n = m := sorry

theorem coprime.pow {m : ℕ+} {n : ℕ+} (k : ℕ) (l : ℕ) (h : coprime m n) : coprime (m ^ k) (n ^ l) :=
  sorry

end Mathlib


import tactic
import group_theory.semidirect_product
import data.int.cast
import group_theory.eckmann_hilton

noncomputable theory

constant klein_bottle : Type

@[instance] protected constant
  klein_bottle.group : group klein_bottle

namespace klein_bottle

variables {α G : Type} [group G]

constant a : klein_bottle

constant b : klein_bottle

constant extend (Xa : G) (Xb : G)
  (h : Xa * Xb * Xa * Xb⁻¹ = 1)  : klein_bottle →* G

@[simp] constant extend_a (Xa : G) (Xb : G)
  (h : Xa * Xb * Xa * Xb⁻¹ = 1) : extend Xa Xb h a = Xa

@[simp] constant extend_b (Xa : G) (Xb : G)
  (h : Xa * Xb * Xa * Xb⁻¹ = 1) : extend Xa Xb h b = Xb

constant hom_ext {f g : klein_bottle →* G}
  (h1 : f a = g a) (h2 : f b = g b) : f = g

end klein_bottle

constant Cinfinity : Type

@[instance] protected constant Cinfinity.comm_group : comm_group Cinfinity

namespace Cinfinity

variables {α G : Type} [group G]

constant X : Cinfinity

constant extend (x : G) : Cinfinity →* G

@[simp] constant extend_X (x : G) : extend x X = x

@[ext] constant hom_ext {f g : Cinfinity →* G} (h : f X = g X) : f = g

end Cinfinity

def action : Cinfinity →* mul_aut Cinfinity :=
Cinfinity.extend ⟨has_inv.inv, has_inv.inv, inv_inv, inv_inv, by simp [mul_comm]⟩

example : klein_bottle ≃* Cinfinity ⋊[action] Cinfinity :=
monoid_hom.to_mul_equiv
  (klein_bottle.extend
    (semidirect_product.inl Cinfinity.X)
    (semidirect_product.inr Cinfinity.X)
    begin
      rw [mul_assoc, mul_assoc, ← mul_assoc _ _ (_⁻¹), ← map_inv, ← semidirect_product.inl_aut],
      simp [action],
    end)
  (semidirect_product.lift
    (Cinfinity.extend klein_bottle.a)
    (Cinfinity.extend klein_bottle.b)
    (λ g, begin
      dsimp [action],
      simp,

    end))
  _
  _


/-
Copyright (c) 2021 Shing Tak Lam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam
-/

import topology.homotopy.basic

/-!

# Homotopy equivalences between topological spaces

In this file, we define homotopy equivalences between topological spaces `X` and `Y` as a pair of
functions `f : C(X, Y)` and `g : C(Y, X)` such that `f.comp g` and `g.comp f` are both homotopic
to `id`.

## Main definitions

- `continuous_map.homotopy_equiv` is the type of homotopy equivalences between topological spaces.

## Notation

We introduce the notation `X ≃ₕ Y` for `continuous_map.homotopy_equiv X Y` in the `continuous_map`
locale.

-/

universes u v w

variables {X : Type u} {Y : Type v} {Z : Type w}
variables [topological_space X] [topological_space Y] [topological_space Z]

namespace continuous_map

/--
A homotopy equivalence between topological spaces `X` and `Y` are a pair of functions
`to_fun : C(X, Y)` and `inv_fun : C(Y, X)` such that `to_fun.comp inv_fun` and `inv_fun.comp to_fun`
are both homotopic to `id`.
-/
@[ext]
structure homotopy_equiv (X : Type u) (Y : Type v) [topological_space X] [topological_space Y] :=
(to_fun : C(X, Y))
(inv_fun : C(Y, X))
(left_inv : (inv_fun.comp to_fun).homotopic (continuous_map.id X))
(right_inv : (to_fun.comp inv_fun).homotopic (continuous_map.id Y))

localized "infix ` ≃ₕ `:25 := continuous_map.homotopy_equiv" in continuous_map

namespace homotopy_equiv

instance : has_coe_to_fun (homotopy_equiv X Y) (λ _, X → Y) := ⟨λ h, h.to_fun⟩

@[simp]
lemma to_fun_eq_coe (h : homotopy_equiv X Y) : (h.to_fun : X → Y) = h := rfl

@[continuity]
lemma continuous (h : homotopy_equiv X Y) : continuous h := h.to_fun.continuous

end homotopy_equiv

end continuous_map

open_locale continuous_map

namespace homeomorph

/--
Any homeomorphism is a homotopy equivalence.
-/
def to_homotopy_equiv (h : X ≃ₜ Y) : X ≃ₕ Y :=
{ to_fun := ⟨h⟩,
  inv_fun := ⟨h.symm⟩,
  left_inv := by { convert continuous_map.homotopic.refl _, ext, simp },
  right_inv := by { convert continuous_map.homotopic.refl _, ext, simp } }

@[simp]
lemma coe_to_homotopy_equiv (h : X ≃ₜ Y) : ⇑(h.to_homotopy_equiv) = h := rfl

end homeomorph

namespace continuous_map

namespace homotopy_equiv

/--
If `X` is homotopy equivalent to `Y`, then `Y` is homotopy equivalent to `X`.
-/
def symm (h : X ≃ₕ Y) : Y ≃ₕ X :=
{ to_fun := h.inv_fun,
  inv_fun := h.to_fun,
  left_inv := h.right_inv,
  right_inv := h.left_inv }

@[simp]
lemma coe_inv_fun (h : homotopy_equiv X Y) : (⇑h.inv_fun : Y → X) = ⇑h.symm := rfl

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
because it is a composition of multiple projections. -/
def simps.apply (h : X ≃ₕ Y) : X → Y := h
/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
because it is a composition of multiple projections. -/
def simps.symm_apply (h : X ≃ₕ Y) : Y → X := h.symm

initialize_simps_projections homotopy_equiv (to_fun_to_fun -> apply,
  inv_fun_to_fun -> symm_apply, -to_fun, -inv_fun)

/--
Any topological space is homotopy equivalent to itself.
-/
@[simps]
def refl (X : Type u) [topological_space X] : X ≃ₕ X :=
(homeomorph.refl X).to_homotopy_equiv

instance : inhabited (homotopy_equiv unit unit) := ⟨refl unit⟩

/--
If `X` is homotopy equivalent to `Y`, and `Y` is homotopy equivalent to `Z`, then `X` is homotopy
equivalent to `Z`.
-/
@[simps]
def trans (h₁ : X ≃ₕ Y) (h₂ : Y ≃ₕ Z) : X ≃ₕ Z :=
{ to_fun := h₂.to_fun.comp h₁.to_fun,
  inv_fun := h₁.inv_fun.comp h₂.inv_fun,
  left_inv := begin
    refine homotopic.trans _ h₁.left_inv,
    change ((h₁.inv_fun.comp h₂.inv_fun).comp (h₂.to_fun.comp h₁.to_fun)) with
      h₁.inv_fun.comp ((h₂.inv_fun.comp h₂.to_fun).comp h₁.to_fun),
    refine homotopic.hcomp _ (homotopic.refl _),
    refine homotopic.trans ((homotopic.refl _).hcomp h₂.left_inv) _,
    -- simp,
    rw continuous_map.id_comp,
  end,
  right_inv := begin
    refine homotopic.trans _ h₂.right_inv,
    change ((h₂.to_fun.comp h₁.to_fun).comp (h₁.inv_fun.comp h₂.inv_fun)) with
      h₂.to_fun.comp ((h₁.to_fun.comp h₁.inv_fun).comp h₂.inv_fun),
    refine homotopic.hcomp _ (homotopic.refl _),
    refine homotopic.trans ((homotopic.refl _).hcomp h₁.right_inv) _,
    rw id_comp,
  end }

lemma symm_trans (h₁ : X ≃ₕ Y) (h₂ : Y ≃ₕ Z) :
  (h₁.trans h₂).symm = h₂.symm.trans h₁.symm := by ext; refl

end homotopy_equiv

end continuous_map

open continuous_map

namespace homeomorph

@[simp]
lemma refl_to_homotopy_equiv (X : Type u) [topological_space X] :
  (homeomorph.refl X).to_homotopy_equiv = homotopy_equiv.refl X := rfl

@[simp]
lemma symm_to_homotopy_equiv (h : X ≃ₜ Y) :
  h.symm.to_homotopy_equiv = h.to_homotopy_equiv.symm := rfl

@[simp]
lemma trans_to_homotopy_equiv (h₀ : X ≃ₜ Y) (h₁ : Y ≃ₜ Z) :
  (h₀.trans h₁).to_homotopy_equiv = h₀.to_homotopy_equiv.trans h₁.to_homotopy_equiv := rfl

end homeomorph


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.deprecated.subgroup
import Mathlib.deprecated.group
import Mathlib.PostPort

universes u l v u_1

namespace Mathlib

/-- `S` is a subring: a set containing 1 and closed under multiplication, addition and and additive inverse. -/
class is_subring {R : Type u} [ring R] (S : set R)
extends is_add_subgroup S, is_submonoid S
where

/-- The ring structure on a subring coerced to a type. -/
def subset.ring {R : Type u} [ring R] {S : set R} [is_subring S] : ring ↥S :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg add_comm_group.sub sorry sorry
    monoid.mul sorry monoid.one sorry sorry sorry sorry

/-- The ring structure on a subring coerced to a type. -/
def subtype.ring {R : Type u} [ring R] {S : set R} [is_subring S] : ring (Subtype S) :=
  subset.ring

namespace ring_hom

protected instance is_subring_preimage {R : Type u} {S : Type v} [ring R] [ring S] (f : R →+* S) (s : set S) [is_subring s] : is_subring (⇑f ⁻¹' s) :=
  is_subring.mk

protected instance is_subring_image {R : Type u} {S : Type v} [ring R] [ring S] (f : R →+* S) (s : set R) [is_subring s] : is_subring (⇑f '' s) :=
  is_subring.mk

protected instance is_subring_set_range {R : Type u} {S : Type v} [ring R] [ring S] (f : R →+* S) : is_subring (set.range ⇑f) :=
  is_subring.mk

end ring_hom

/-- Restrict the codomain of a ring homomorphism to a subring that includes the range. -/
def ring_hom.cod_restrict {R : Type u} {S : Type v} [ring R] [ring S] (f : R →+* S) (s : set S) [is_subring s] (h : ∀ (x : R), coe_fn f x ∈ s) : R →+* ↥s :=
  ring_hom.mk (fun (x : R) => { val := coe_fn f x, property := h x }) sorry sorry sorry sorry

/-- Coersion `S → R` as a ring homormorphism-/
def is_subring.subtype {R : Type u} [ring R] (S : set R) [is_subring S] : ↥S →+* R :=
  ring_hom.mk coe sorry sorry sorry sorry

@[simp] theorem is_subring.coe_subtype {R : Type u} [ring R] {S : set R} [is_subring S] : ⇑(is_subring.subtype S) = coe :=
  rfl

/-- The commutative ring structure on a subring coerced to a type. -/
def subset.comm_ring {cR : Type u} [comm_ring cR] {S : set cR} [is_subring S] : comm_ring ↥S :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

/-- The commutative ring structure on a subring coerced to a type. -/
def subtype.comm_ring {cR : Type u} [comm_ring cR] {S : set cR} [is_subring S] : comm_ring (Subtype S) :=
  subset.comm_ring

/-- The integral domain structure on a subring of an integral domain coerced to a type. -/
def subring.domain {D : Type u_1} [integral_domain D] (S : set D) [is_subring S] : integral_domain ↥S :=
  integral_domain.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 sorry sorry

protected instance is_subring.inter {R : Type u} [ring R] (S₁ : set R) (S₂ : set R) [is_subring S₁] [is_subring S₂] : is_subring (S₁ ∩ S₂) :=
  is_subring.mk

protected instance is_subring.Inter {R : Type u} [ring R] {ι : Sort u_1} (S : ι → set R) [h : ∀ (y : ι), is_subring (S y)] : is_subring (set.Inter S) :=
  is_subring.mk

theorem is_subring_Union_of_directed {R : Type u} [ring R] {ι : Type u_1} [hι : Nonempty ι] (s : ι → set R) [∀ (i : ι), is_subring (s i)] (directed : ∀ (i j : ι), ∃ (k : ι), s i ⊆ s k ∧ s j ⊆ s k) : is_subring (set.Union fun (i : ι) => s i) :=
  is_subring.mk

namespace ring

def closure {R : Type u} [ring R] (s : set R) : set R :=
  add_group.closure (monoid.closure s)

theorem exists_list_of_mem_closure {R : Type u} [ring R] {s : set R} {a : R} (h : a ∈ closure s) : ∃ (L : List (List R)), (∀ (l : List R), l ∈ L → ∀ (x : R), x ∈ l → x ∈ s ∨ x = -1) ∧ list.sum (list.map list.prod L) = a := sorry

protected theorem in_closure.rec_on {R : Type u} [ring R] {s : set R} {C : R → Prop} {x : R} (hx : x ∈ closure s) (h1 : C 1) (hneg1 : C (-1)) (hs : ∀ (z : R), z ∈ s → ∀ (n : R), C n → C (z * n)) (ha : ∀ {x y : R}, C x → C y → C (x + y)) : C x := sorry

protected instance closure.is_subring {R : Type u} [ring R] {s : set R} : is_subring (closure s) :=
  is_subring.mk

theorem mem_closure {R : Type u} [ring R] {s : set R} {a : R} : a ∈ s → a ∈ closure s :=
  add_group.mem_closure ∘ monoid.subset_closure

theorem subset_closure {R : Type u} [ring R] {s : set R} : s ⊆ closure s :=
  fun (_x : R) => mem_closure

theorem closure_subset {R : Type u} [ring R] {s : set R} {t : set R} [is_subring t] : s ⊆ t → closure s ⊆ t :=
  add_group.closure_subset ∘ monoid.closure_subset

theorem closure_subset_iff {R : Type u} [ring R] (s : set R) (t : set R) [is_subring t] : closure s ⊆ t ↔ s ⊆ t :=
  iff.trans (add_group.closure_subset_iff (monoid.closure s) t)
    { mp := set.subset.trans monoid.subset_closure, mpr := monoid.closure_subset }

theorem closure_mono {R : Type u} [ring R] {s : set R} {t : set R} (H : s ⊆ t) : closure s ⊆ closure t :=
  closure_subset (set.subset.trans H subset_closure)

theorem image_closure {R : Type u} [ring R] {S : Type u_1} [ring S] (f : R →+* S) (s : set R) : ⇑f '' closure s = closure (⇑f '' s) := sorry


import data.int.gcd data.set.finite data.nat.prime tactic.ring

/-! # IMO 2012 N4 -/

namespace IMOSL
namespace IMO2012N4

open function
open_locale classical

def friendly (a : ℤ) := ∃ m n : ℤ, 0 < m ∧ 0 < n ∧ (m ^ 2 + n) * (n ^ 2 + m) = a * (m - n) ^ 3

private lemma friendly_1mod4 {k : ℤ} (h : 0 < k) : friendly (4 * k + 1) :=
  ⟨2 * k + 1, k, add_pos (mul_pos two_pos h) one_pos, h, by ring⟩

/- Final solution for part 1 -/
theorem final_solution_part1 (n : ℕ) :
  n ≤ fintype.card {a : fin (4 * n + 1) // friendly (a + 1)} :=
begin
  let f : fin n → {a : fin (4 * n + 1) // friendly (a + 1)} :=
    λ (j : fin n), ⟨⟨4 * (j + 1), _⟩, _⟩,
  rotate,
  { rw [nat.lt_succ_iff, mul_le_mul_left, nat.succ_le_iff],
    exacts [j.is_lt, zero_lt_four] },
  { simp; apply friendly_1mod4,
    rw [← nat.cast_one, ← nat.cast_add, nat.cast_pos]; exact (j : ℕ).succ_pos },
  suffices : injective f,
    convert fintype.card_le_of_injective f this; rw fintype.card_fin n,
  intros x y h,
  simp only [f, fin.mk_eq_mk] at h,
  rwa [mul_eq_mul_left_iff, add_left_inj, ← fin.ext_iff, or_iff_left] at h,
  exact four_ne_zero
end

/- Final solution for part 2 -/
theorem final_solution_part2 : ¬friendly 2 :=
begin
  rintros ⟨m, n, hm, hn, h⟩,
  have h0 : 0 < m - n :=
  begin
    rw lt_iff_not_le; intros h0,
    replace h := le_of_eq_of_le h
      (mul_nonpos_of_nonneg_of_nonpos zero_le_two (by rwa pow_bit1_nonpos_iff)),
    rw ← not_lt at h,
    exact h (mul_pos (add_pos (pow_pos hm 2) hn) (add_pos (pow_pos hn 2) hm))
  end,

  have h1 : ∃ s : ℤ, 0 < s ∧ (m + n - 1 + s) ^ 2 = (m + n - 1) ^ 2 + 8 * (m - n) :=
  begin
    replace h : (m ^ 2 + n + n ^ 2 + m) ^ 2 = (m - n) ^ 2 * ((m + n - 1) ^ 2 + 8 * (m - n)) :=
      by convert (congr_arg (λ x, 4 * x + (m ^ 2 + n - n ^ 2 - m) ^ 2) h); ring,
    have h1 : (m - n) ^ 2 ∣ (m ^ 2 + n + n ^ 2 + m) ^ 2 := ⟨_, h⟩,
    rw int.pow_dvd_pow_iff two_pos at h1,
    cases h1 with t h1,
    rw [h1, mul_pow, mul_right_inj' (ne_of_gt (pow_pos h0 2))] at h,
    use t - (m + n - 1),
    rw [← h, add_sub_cancel'_right, and_iff_left rfl, sub_pos],
    refine lt_of_pow_lt_pow 2 _ _,
    { rw [← mul_nonneg_iff_right_nonneg_of_pos h0, ← h1, add_assoc],
      apply add_nonneg; refine add_nonneg (sq_nonneg _) (le_of_lt _),
      exacts [hn, hm] },
    { rw [h, lt_add_iff_pos_right],
      exact mul_pos (by norm_num) h0 }
  end,

  rcases h1 with ⟨s, h1, h2⟩,
  rw [← sub_eq_iff_eq_add', sq_sub_sq, add_sub_cancel', add_right_comm, ← two_mul] at h2,
  obtain ⟨t, rfl⟩ : 2 ∣ s :=
  begin
    replace h2 : 2 ∣ (2 * (m + n - 1) + s) * s :=
      ⟨4 * (m - n), by rw [h2, ← mul_assoc, two_mul, ← bit0]⟩,
    rw [add_mul, mul_assoc, dvd_add_right ⟨_, rfl⟩, ← sq] at h2,
    exact prime.dvd_of_dvd_pow int.prime_two h2
  end,

  rw [← mul_zero (2 : ℤ), mul_lt_mul_left (two_pos : 0 < (2 : ℤ)), int.lt_iff_add_one_le,
      zero_add, le_iff_eq_or_lt, eq_comm, int.lt_iff_add_one_le, ← bit0] at h1,
  change (8 : ℤ) with (2 + 2) + (2 + 2) at h2,
  rw [← mul_add, mul_mul_mul_comm, ← two_mul, mul_comm (2 : ℤ) (2 + 2), mul_assoc (2 + 2 : ℤ),
      ← two_mul, ← sq, mul_right_inj' (pow_ne_zero 2 (two_ne_zero : (2 : ℤ) ≠ 0)), mul_comm] at h2,
  rcases h1 with rfl | h1,
  { rw [one_mul, sub_add_cancel, mul_sub, eq_sub_iff_add_eq,
        add_assoc, ← one_add_mul, two_mul, add_right_inj] at h2,
    rw [← h2, ← sub_eq_zero] at h; ring_nf at h,
    revert h; refine ne_of_gt (mul_pos (add_pos _ three_pos) (pow_pos hn 2)),
    exact mul_pos (add_pos (mul_pos (by norm_num) hn) (by norm_num)) hn },
  { revert h2; refine ne_of_gt (lt_of_le_of_lt ((mul_le_mul_right h0).mpr h1) _),
    rw mul_lt_mul_left (lt_of_lt_of_le two_pos h1),
    refine lt_of_lt_of_le _ (add_le_add_left h1 _),
    rw [bit0, sub_add_add_cancel, int.lt_add_one_iff, sub_le_iff_le_add,
        add_assoc, le_add_iff_nonneg_right, ← two_mul],
    exact mul_nonneg zero_le_two (le_of_lt hn) },
end

end IMO2012N4
end IMOSL


/-
The constraints that govern the one-step machine transition.
-/
import starkware.cairo.lean.semantics.cpu
import starkware.cairo.lean.semantics.air_encoding.constraints

variables {F : Type*} [field F]

/- from trace_data (indexed by step) -/
variables {off_op0_tilde
           off_op1_tilde
           off_dst_tilde              : F}
variable  {f_tilde                    : tilde_type F}
variables {fp ap pc                   : F}
variables {next_fp next_ap next_pc    : F}
variables {dst_addr op0_addr op1_addr : F}
variables {dst op0 op1 mul res t0 t1  : F}

/- from instruction constraints -/
variable {inst  : instruction}

/- from memory constraints -/
variable {mem : F → F}

/- from instruction constraints -/
variable h_off_dst_tilde : off_dst_tilde = ↑inst.off_dst.to_natr
variable h_off_op0_tilde : off_op0_tilde = ↑inst.off_op0.to_natr
variable h_off_op1_tilde : off_op1_tilde = ↑inst.off_op1.to_natr
variable h_flags         : ∀ i, f_tilde.to_f i = ↑(inst.flags.nth i).to_nat

/- from memory constraints -/
variable h_mem_pc       : mem pc = inst.to_nat
variable h_mem_dst_addr : mem dst_addr = dst
variable h_mem_op0_addr : mem op0_addr = op0
variable h_mem_op1_addr : mem op1_addr = op1

/- step constraints -/
variable h_dst_addr : dst_addr =
    f_tilde.f_dst_reg * fp + (1 - f_tilde.f_dst_reg) * ap + (off_dst_tilde - 2^15)

variable h_op0_addr : op0_addr =
    f_tilde.f_op0_reg * fp + (1 - f_tilde.f_op0_reg) * ap + (off_op0_tilde - 2^15)

variable h_op1_addr : op1_addr =
    f_tilde.f_op1_imm * pc + f_tilde.f_op1_ap * ap + f_tilde.f_op1_fp * fp +
    (1 - f_tilde.f_op1_imm - f_tilde.f_op1_ap - f_tilde.f_op1_fp) * op0 +
    (off_op1_tilde - 2^15)

variable h_mul : mul = op0 * op1

variable h_res : (1 - f_tilde.f_pc_jnz) * res =
    f_tilde.f_res_add * (op0 + op1) +  f_tilde.f_res_mul * mul +
    (1 - f_tilde.f_res_add - f_tilde.f_res_mul - f_tilde.f_pc_jnz) * op1

variable h_t0_eq : t0 = f_tilde.f_pc_jnz * dst

variable h_t1_eq : t1 = t0 * res

variable h_next_pc_eq :
    (t1 - f_tilde.f_pc_jnz) * (next_pc - (pc + (f_tilde.f_op1_imm + 1))) = 0

variable h_next_pc_eq' :
    t0 * (next_pc - (pc + op1)) + (1 - f_tilde.f_pc_jnz) * next_pc -
      ((1 - f_tilde.f_pc_jump_abs - f_tilde.f_pc_jump_rel - f_tilde.f_pc_jnz) *
          (pc + (f_tilde.f_op1_imm + 1)) +
        f_tilde.f_pc_jump_abs * res + f_tilde.f_pc_jump_rel * (pc + res)) = 0

variable h_opcode_call : f_tilde.f_opcode_call * (dst - fp) = 0

variable h_opcode_call' :
    f_tilde.f_opcode_call * (op0 - (pc + (f_tilde.f_op1_imm + 1))) = 0

variable h_opcode_assert_eq : f_tilde.f_opcode_assert_eq * (dst - res) = 0

variable h_next_ap :
    next_ap = ap + f_tilde.f_ap_add * res + f_tilde.f_ap_add1 + f_tilde.f_opcode_call * 2

variable h_next_fp : next_fp = f_tilde.f_opcode_ret * dst + f_tilde.f_opcode_call * (ap + 2) +
    (1 - f_tilde.f_opcode_ret - f_tilde.f_opcode_call) * fp

/-
The correctness theorems.
-/

section
include h_off_op0_tilde h_flags h_mem_op0_addr h_op0_addr

theorem op0_eq : op0 = inst.op0 mem ⟨pc, ap, fp⟩ :=
begin
  have : f_tilde.f_op0_reg = ↑(inst.op0_reg.to_nat) := h_flags _,
  rw [instruction.op0, ←h_mem_op0_addr, h_op0_addr, h_off_op0_tilde, bitvec.to_biased_16, this],
  cases inst.op0_reg; simp
end
end

section
include h_off_op0_tilde h_off_op1_tilde h_flags
include h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr

theorem op1_agrees : (inst.op1 mem ⟨pc, ap, fp⟩).agrees op1 :=
begin
  have h1 : f_tilde.f_op1_imm = ↑(inst.op1_imm.to_nat) := h_flags _,
  have h2 : f_tilde.f_op1_ap = ↑(inst.op1_ap.to_nat) := h_flags _,
  have h3 : f_tilde.f_op1_fp = ↑(inst.op1_fp.to_nat) := h_flags _,
  have h4 := @op0_eq _ _ _ _ _ _ pc _ _ _ _ h_off_op0_tilde h_flags h_mem_op0_addr h_op0_addr,
  rw [←h_mem_op1_addr, h_op1_addr, h_off_op1_tilde, instruction.op1, h1, h2, h3, h4],
  cases inst.op1_imm; cases inst.op1_fp; cases inst.op1_ap;
    simp [instruction.op1._match_1, option.agrees, bitvec.to_biased_16]
end
end

section
include h_off_op0_tilde h_off_op1_tilde h_flags
include h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr h_mul h_res

theorem res_aux_agrees : f_tilde.f_pc_jnz = ff.to_nat →
  (inst.res_aux mem ⟨pc, ap, fp⟩).agrees res :=
begin
  intro h, revert h_res, rw h, simp,
  have h1 : f_tilde.f_res_add = ↑(inst.res_add.to_nat) := h_flags _,
  have h2 : f_tilde.f_res_mul = ↑(inst.res_mul.to_nat) := h_flags _,
  have h3 := @op0_eq _ _ _ _ _ _ pc _ _ _ _ h_off_op0_tilde h_flags h_mem_op0_addr h_op0_addr,
  have h4 := op1_agrees h_off_op0_tilde h_off_op1_tilde h_flags
                 h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr,
  revert h4,
  rw [instruction.res_aux, h1, h2],
  cases inst.op1 mem _ with op1; cases inst.res_add; cases inst.res_mul;
    simp [instruction.res_aux._match_1, option.agrees];
    intros h5 h6; simp [h3, h5, h6, h_mul]
end

theorem res_agrees : (inst.res mem ⟨pc, ap, fp⟩).agrees res :=
begin
  have h1 : f_tilde.f_pc_jnz = ↑(inst.pc_jnz.to_nat) := h_flags _,
  have h2 := res_aux_agrees h_off_op0_tilde h_off_op1_tilde
                h_flags h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr h_mul h_res,
  revert h2,
  rw [instruction.res, h1],
  cases inst.pc_jump_abs; cases inst.pc_jump_rel; cases inst.pc_jnz;
    simp [instruction.res._match_1, option.agrees],
end
end

section
include h_off_dst_tilde h_flags h_mem_dst_addr h_dst_addr

theorem dst_eq : dst = inst.dst mem ⟨pc, ap, fp⟩ :=
begin
  have : f_tilde.f_dst_reg = ↑(inst.dst_reg.to_nat) := h_flags _,
  rw [instruction.dst, ←h_mem_dst_addr, h_dst_addr, h_off_dst_tilde, bitvec.to_biased_16, this],
  cases inst.dst_reg; simp
end
end

section
variable [decidable_eq F]

include h_off_dst_tilde h_off_op0_tilde h_off_op1_tilde h_flags
include h_mem_dst_addr h_mem_op0_addr h_mem_op1_addr
include h_dst_addr h_op0_addr h_op1_addr h_mul h_res
include h_t0_eq h_t1_eq h_next_pc_eq h_next_pc_eq'

theorem next_pc_agrees : (inst.next_pc mem ⟨pc, ap, fp⟩).agrees next_pc :=
begin
  have h1  : f_tilde.f_pc_jump_abs = ↑(inst.pc_jump_abs.to_nat) := h_flags _,
  have h2  : f_tilde.f_pc_jump_rel = ↑(inst.pc_jump_rel.to_nat) := h_flags _,
  have h3  : f_tilde.f_pc_jnz = ↑(inst.pc_jnz.to_nat) := h_flags _,
  have h4  : f_tilde.f_dst_reg = ↑(inst.dst_reg.to_nat) := h_flags _,
  have h5  : f_tilde.f_res_mul = ↑(inst.res_mul.to_nat) := h_flags _,
  have h6  : f_tilde.f_res_add = ↑(inst.res_add.to_nat) := h_flags _,
  have h7  : f_tilde.f_op1_imm = ↑(inst.op1_imm.to_nat) := h_flags _,
  have h8  := @dst_eq _ _ _ _ _ _ pc _ _ _ _ h_off_dst_tilde h_flags h_mem_dst_addr h_dst_addr,
  have h9  := op1_agrees h_off_op0_tilde h_off_op1_tilde h_flags
                h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr,
  have h10 := res_agrees h_off_op0_tilde h_off_op1_tilde
                h_flags h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr h_mul h_res,
  rw h_t0_eq at h_t1_eq h_next_pc_eq',
  rw h_t1_eq at h_next_pc_eq,
  revert h_next_pc_eq h_next_pc_eq' ,
  rw [instruction.next_pc, h1, h2, h3],
  cases inst.pc_jump_abs; cases inst.pc_jump_rel; cases inst.pc_jnz;
    simp [instruction.next_pc._match_1, option.agrees],
  { rw [instruction.size, h7], intro h, symmetry, exact eq_of_sub_eq_zero h },
  { intros h_next_pc_eq h_next_pc_eq',
    by_cases h : inst.dst mem ⟨pc, ap, fp⟩ = 0,
    { rw [if_pos h],
       cases h_next_pc_eq  with h' h',
      { simp [h8, h] at h',
        contradiction },
      rw [option.agrees],
      rw h7 at h',
      symmetry, exact eq_of_sub_eq_zero h'
    },
    cases h_next_pc_eq' with h' h',
    { rw h8 at h', contradiction },
    { rw [if_neg h],
      revert h9,
      cases inst.op1 mem ⟨pc, ap, fp⟩; simp [option.agrees, instruction.next_pc._match_3],
      rintro rfl,
      symmetry, exact eq_of_sub_eq_zero h' } },
  { revert h10,
    cases inst.res mem ⟨pc, ap, fp⟩;
    simp [option.agrees, instruction.next_pc._match_2],
    rintro rfl,
    intro h', symmetry, exact eq_of_sub_eq_zero h' },
  { intro h, revert h10,
    cases inst.res mem ⟨pc, ap, fp⟩; simp [option.agrees],
    rintro rfl,
    symmetry, exact eq_of_sub_eq_zero h }
end

end

section
include h_off_op0_tilde h_off_op1_tilde h_flags
include h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr h_mul h_res h_next_ap

theorem next_ap_agrees_aux (h : f_tilde.f_opcode_call = 0) :
  (inst.next_ap_aux mem ⟨pc, ap, fp⟩).agrees next_ap :=
begin
  have h1 : f_tilde.f_ap_add = ↑(inst.ap_add.to_nat) := h_flags _,
  have h2 : f_tilde.f_ap_add1 = ↑(inst.ap_add1.to_nat) := h_flags _,
  have h3 := res_agrees h_off_op0_tilde h_off_op1_tilde
                h_flags h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr h_mul h_res,
  revert h_next_ap,
  rw [instruction.next_ap_aux, h1, h2, h],
  cases inst.ap_add; cases inst.ap_add1;
    simp [instruction.next_ap_aux._match_1, option.agrees]; intro h'; rw h',
  revert h3,
  cases inst.res mem ⟨pc, ap, fp⟩; simp [option.agrees, instruction.next_ap_aux._match_2]
end
end

section
include h_off_op0_tilde h_off_op1_tilde h_flags
include h_mem_op0_addr h_mem_op1_addr
include h_op0_addr h_op1_addr h_mul h_res h_next_ap

theorem next_ap_agrees : (inst.next_ap mem ⟨pc, ap, fp⟩).agrees next_ap :=
begin
  have h1 : f_tilde.f_opcode_call = ↑(inst.opcode_call.to_nat) := h_flags _,
  have h2 : f_tilde.f_opcode_ret = ↑(inst.opcode_ret.to_nat) := h_flags _,
  have h3 : f_tilde.f_ap_add = ↑(inst.ap_add.to_nat) := h_flags _,
  have h4 : f_tilde.f_ap_add1 = ↑(inst.ap_add1.to_nat) := h_flags _,
  have h5 := next_ap_agrees_aux h_off_op0_tilde h_off_op1_tilde
                h_flags h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr h_mul h_res h_next_ap,
  revert h5,
  rw [instruction.next_ap, h1],
  cases inst.opcode_call; cases inst.opcode_ret; cases inst.opcode_assert_eq;
    simp [instruction.next_ap._match_1, option.agrees],
  revert h_next_ap, rw [h1, h3, h4],
  cases inst.ap_add; cases inst.ap_add1;
    simp [instruction.next_ap._match_2, option.agrees],
  apply eq.symm
end
end

section
include h_off_dst_tilde h_flags h_mem_dst_addr h_dst_addr h_next_fp

theorem next_fp_agrees : (inst.next_fp mem ⟨pc, ap, fp⟩).agrees next_fp :=
begin
  have h1 : f_tilde.f_opcode_call = ↑(inst.opcode_call.to_nat) := h_flags _,
  have h2 : f_tilde.f_opcode_ret = ↑(inst.opcode_ret.to_nat) := h_flags _,
  have h3  := @dst_eq _ _ _ _ _ _ pc _ _ _ _ h_off_dst_tilde h_flags h_mem_dst_addr h_dst_addr,
  revert next_fp,
  rw [instruction.next_fp, h1, h2],
  cases inst.opcode_call; cases inst.opcode_ret; cases inst.opcode_assert_eq;
    simp [instruction.next_fp._match_1, option.agrees, h3]
end
end

section
include h_off_dst_tilde h_off_op0_tilde h_off_op1_tilde h_flags
include h_mem_dst_addr h_mem_op0_addr h_mem_op1_addr
include h_dst_addr h_op0_addr h_op1_addr h_mul h_res
include h_opcode_call h_opcode_call' h_opcode_assert_eq

theorem asserts_hold : inst.asserts mem ⟨pc, ap, fp⟩ :=
begin
  have h1 : f_tilde.f_opcode_call = ↑(inst.opcode_call.to_nat) := h_flags _,
  have h2 : f_tilde.f_opcode_ret = ↑(inst.opcode_ret.to_nat) := h_flags _,
  have h3 : f_tilde.f_opcode_assert_eq = ↑(inst.opcode_assert_eq.to_nat) := h_flags _,
  have h4 : f_tilde.f_op1_imm = ↑(inst.op1_imm.to_nat) := h_flags _,
  have h5 := @dst_eq _ _ _ _ _ _ pc _ _ _ _ h_off_dst_tilde h_flags h_mem_dst_addr h_dst_addr,
  have h6 := @op0_eq _ _ _ _ _ _ pc _ _ _ _ h_off_op0_tilde h_flags h_mem_op0_addr h_op0_addr,
  have h7 := res_agrees h_off_op0_tilde h_off_op1_tilde
                h_flags h_mem_op0_addr h_mem_op1_addr h_op0_addr h_op1_addr h_mul h_res,
  revert h_opcode_call h_opcode_call' h_opcode_assert_eq,
  rw [instruction.asserts, h1, h3],
  cases inst.opcode_call; cases inst.opcode_ret; cases inst.opcode_assert_eq;
    simp [instruction.asserts._match_1, option.agrees, h3, ←h5, ←h6];
    intro h; rw [eq_of_sub_eq_zero h],
  { exact h7 },
  { simp [instruction.size, h4],
    intro h; rw [eq_of_sub_eq_zero h] }
end
end

/-
The main theorem: the constraints imply that the next state is as expected.
-/
variable [decidable_eq F]

theorem next_state_eq :
  next_state mem ⟨pc, ap, fp⟩ ⟨next_pc, next_ap, next_fp⟩ :=
⟨ inst,
  h_mem_pc,
  next_pc_agrees h_off_dst_tilde h_off_op0_tilde h_off_op1_tilde h_flags
    h_mem_dst_addr h_mem_op0_addr h_mem_op1_addr
    h_dst_addr h_op0_addr h_op1_addr h_mul h_res
    h_t0_eq h_t1_eq h_next_pc_eq h_next_pc_eq',
  next_ap_agrees h_off_op0_tilde h_off_op1_tilde h_flags
    h_mem_op0_addr h_mem_op1_addr
    h_op0_addr h_op1_addr h_mul h_res h_next_ap,
  next_fp_agrees h_off_dst_tilde h_flags h_mem_dst_addr h_dst_addr h_next_fp,
  asserts_hold h_off_dst_tilde h_off_op0_tilde h_off_op1_tilde h_flags
    h_mem_dst_addr h_mem_op0_addr h_mem_op1_addr
    h_dst_addr h_op0_addr h_op1_addr h_mul h_res
    h_opcode_call h_opcode_call' h_opcode_assert_eq ⟩

-- We can use the linter to confirm that there are no extraneous dependencies.
-- #lint


--

set_option trace.Meta.Tactic.subst true

theorem tst1 (x y z : Nat) : y = z → x = x → x = y → x = z := by
  intros h1 h2 h3
  subst x
  assumption

theorem tst2 (x y z : Nat) : y = z → x = z + y → x = z + z := by
  intros h1 h2
  subst h1
  subst h2
  exact rfl

def BV (n : Nat) : Type := { a : Array Bool // a.size = n }

theorem tst3 (n m : Nat) (v : BV n) (w : BV m) (h1 : n = m) (h2 : forall (v1 v2 : BV n), v1 = v2) : v = cast (congrArg BV h1.symm) w := by
subst h1
apply h2

theorem tst4 (n m : Nat) (v : BV n) (w : BV m) (h1 : n = m) (h2 : forall (v1 v2 : BV n), v1 = v2) : v = cast (congrArg BV h1.symm) w := by
subst n
apply h2


/-
Copyright (c) 2019 Luca Gerolla. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luca Gerolla, Kenny Lau
WIP: Basic definitions of probability theory and
(one-sided/discrete) stochastic processes
-/
import analysis.topology.continuity
import analysis.topology.topological_space
import analysis.topology.infinite_sum
import analysis.topology.topological_structures
import analysis.topology.uniform_space
import analysis.real
import analysis.metric_space
import analysis.normed_space
import data.real.basic tactic.norm_num
import data.set.basic
import analysis.measure_theory.borel_space
import analysis.measure_theory.lebesgue_measure
import analysis.measure_theory.integration
import analysis.measure_theory.measurable_space
import analysis.measure_theory.measure_space
import data.set order.galois_connection analysis.ennreal
       analysis.measure_theory.outer_measure
import Topology.Material.path
import data.set.lattice

noncomputable theory

open classical set lattice filter finset function
local attribute [instance] prop_decidable

open measure_theory
open topological_space

--local notation `meas` := measure_theory.measure

universes u v w x

section
-- Section containing prelimanary definitions for
-- later works (only ind_fun needed for next section)

variables {α : Type*} [measure_space α]
variables { μ : measure α }{ v : measure α  } {s : set α }

---- Preliminaries: Abs. cont. measures, Radon Nikodym, and indicator function (for later)

definition abs_cont ( μ : measure α  )(v : measure α ) : Prop :=
∀ (s : set α), v s = 0 → μ s = 0

-- (stronger then needed)
def finite_measure ( μ : measure α ) := μ (univ : set α) < (⊤ : ennreal)

def rad_nik_property ( μ : measure α )(v : measure α ) ( f : α → ennreal) :=
  ∀ s : set α, μ s = @lintegral α { μ := v } f

structure rad_nik_der ( μ : measure α )(v : measure α ) :=
(to_fun : α → ennreal )
(meas : measurable to_fun )
(density_rn : rad_nik_property μ v to_fun  )

def radon_nikodym_build ( h : abs_cont μ v ) ( hf : finite_measure v ) : rad_nik_der μ v :=
  sorry

theorem radon_nikodym_thm₂ ( h : abs_cont μ v ) ( hf : finite_measure v ) :
    ∃ (D : rad_nik_der μ v),  rad_nik_property μ v D.to_fun :=
begin
 existsi radon_nikodym_build h hf, exact (radon_nikodym_build h hf).3,
end

-- indicator function
def ind_fun { A : set α } { F : measurable_space α } (h : F.is_measurable A ) : simple_func α ennreal :=
{ to_fun := λ (x: α ), if x ∈ A then (1:ennreal) else (0:ennreal),

  measurable_sn :=
  begin intro a, by_cases H : a = 1 ,
  have h₂ : (λ (x : α), ite (x ∈ A) (1 : ennreal) 0) ⁻¹' {1} = A,
    unfold set.preimage, apply set.ext, intro x,
    have h₃ : ite (x ∈ A) (1:ennreal) 0 = (1:ennreal) ↔ x ∈ A,
      split_ifs, --or double cc
        exact ⟨ begin intro y, exact h_1 end, begin intro y, trivial end ⟩,
        refine ⟨ _, _ ⟩, intro y, by_contradiction,
        have j : (0:ennreal) = (1:ennreal) → false, { simp}, exact j y,
        intro y, cc,
  simp [ h₃], subst H, rw h₂, exact h,
  by_cases T : a = 0,
    { have g₁ : (λ (x : α), ite (x ∈ A) (1:ennreal) 0) ⁻¹' {a} = -A,
      ext z, simp, subst a, split_ifs; simpa,
    rw g₁, exact is_measurable.compl h,
    },
  have g₁ : (λ (x : α), ite (x ∈ A) (1:ennreal) 0) ⁻¹' {a} = ∅, ext z, simp, split_ifs; cc,
  rw g₁ , exact is_measurable.empty,
  end ,

  finite := begin unfold set.range,
  have w : {x : ennreal | ∃ (y : α), ite (y ∈ A) (1:ennreal) 0 = x} ⊆  {(1:ennreal), 0},
    intro r, rw mem_set_of_eq,
    rintro ⟨y, rfl⟩, split_ifs; simp,
  refine finite_subset _ w  ,
  simp [w],
  end,

}

end

--------------
---- Random Variables, Cond. Expectations, Stochastic and Markvov Processes
--------------

section

---- Define spaces

-- Complete separable metric space
class csm_space (β : Type*) extends metric_space β , complete_space β, separable_space β

class measurable_csm_space (β : Type*) extends csm_space β, measurable_space β

class probability_space (α : Type*) extends measure_space α :=
( univ_one : volume (univ : set α) = 1)

----

variables {β : Type*} [measurable_space β ]{γ  : Type*} [measurable_space γ ]

---- Random variables

/-  Should define this with measurable_csm_space β but
need to prove ennreal is a measurable_csm_space
-/

structure random_variable (α : Type*) [probability_space α] (β : Type*) [measurable_space β ]:=
( to_fun : α → β )
( meas : measurable to_fun )

structure real_rv (α : Type*) [probability_space α] extends random_variable α ennreal

variables {α : Type*} [probability_space α] { F : measurable_space α }

definition random_variable.comp (x : random_variable α β ) {f : β  → γ } (h : measurable f) :
  random_variable α γ  :=
{ to_fun := f ∘ x.to_fun ,
  meas := measurable.comp x.2 h,
}

lemma rv_of_simp_func (f : simple_func α ennreal ) : real_rv α :=
{ to_fun := f.to_fun,
  meas := f.measurable,
}

lemma rv_of_ind_func {A : set α } {h : is_measurable A }
{X : simple_func α ennreal} (h : X = ind_fun h) : real_rv α := rv_of_simp_func X

-- measure_of
def push_forward {α : Type*} [probability_space α] {β : Type*} [measurable_space β ] (x : random_variable α β ) : measure β :=
{ measure_of := λ s, sorry,  --(x ⁻¹' s) ,
 empty := sorry,
 mono := sorry,
 Union_nat := sorry,
 m_Union := sorry,
 trimmed := sorry,
}

definition to_prob_space {β : Type*} [measurable_space β ] (x : random_variable α β ) :
  probability_space β :=
{ μ := push_forward x,
  univ_one := begin unfold volume, sorry end,
}

-- add condition that F of probability space ≥ m₁ m₂?
definition independent (m₁ : measurable_space α )(m₂ : measurable_space α ) : Prop :=
∀ (a b : set α ) (h₁ : m₁.is_measurable a) (h₂  : m₂.is_measurable a), volume (a ∩ b) = volume a * volume b

---- Expectation and conditional expectation

def expectation (f : α → ennreal ) := lintegral f

def match_integ ( t : measurable_space α ) (f g : α → ennreal) { s : set α } ( h : t.is_measurable s ): Prop :=
lintegral (( ind_fun  h ).to_fun * f ) = lintegral (( ind_fun  h ).to_fun * g )

structure cond_exp ( X : random_variable α ennreal) ( t : measurable_space α ) :=
( to_fun : α → ennreal)
( meas : @measurable _ _ t _ to_fun)
( aver_match : ∀ (s : set α ) (h : t.is_measurable s), match_integ t X.to_fun to_fun h )

---- Stochastic process

structure stoch_process (α : Type*) [probability_space α](β : Type*) [measurable_space β ]:=
( seq : ℕ → α → β   )
( meas : ∀ n : ℕ, measurable (seq n) )

attribute [class] stoch_process

-- instance (α : Type*) [probability_space α](β : Type*) [measurable_space β ] :
--   has_coe_to_fun ( stoch_process α β ) := begin sorry end
--   --⟨ _ , stoch_process.to_fun ⟩

def stoch_process.comp {f : β  → γ } (h : measurable f) ( x : stoch_process α β ) :
  stoch_process α γ :=
{ seq := λ n , f ∘ (x.seq n) ,
  meas := λ n, measurable.comp (x.2 n) h,
}

def rv_of_stoch_proc ( x : stoch_process α β ) (n : ℕ ) : random_variable α β  :=
{ to_fun := x.seq n ,
 meas := x.meas n,
}

def rv_of_stoch_proc.comp {f : β  → γ } (h : measurable f) ( x : stoch_process α β ) (n : ℕ ) :
  random_variable α γ :=
{ to_fun :=  f ∘ (x.seq n),
  meas := measurable.comp (x.2 n) h,
}

----- Sigma algebras generated

def gen_from_rv (h : measurable_space β) ( X : random_variable α β) : measurable_space α :=
measurable_space.comap X.to_fun h

def gen_from_one_stoch ( n : ℕ ) ( x : stoch_process α β ) : measurable_space α :=
measurable_space.comap (x.seq n) infer_instance

def gen_from_stoch ( n : ℕ ) ( x : stoch_process α β  ) : measurable_space α :=
⨆ k ≤ n, measurable_space.comap (x.seq n) infer_instance

----- Markov Process

def markov_property {f : β → ennreal } ( h : measurable f) ( x : stoch_process α β ) (n : ℕ ) : Prop :=
cond_exp  ( rv_of_stoch_proc.comp h x (n+1)) ( gen_from_stoch n x ) = cond_exp (rv_of_stoch_proc.comp h x (n+1)) ( gen_from_one_stoch n x )

structure markov_process extends stoch_process α β  :=
( markov : ∀ (n :ℕ) {f : β → ennreal} (h : measurable f), markov_property h (to_stoch_process) n)

instance : measurable_space (with_top ℕ) := ⊤

-- sort out β as csm_space /
structure stopping_time {α : Type*} [probability_space α] {β : Type*} [measurable_space β ]
 ( x : stoch_process α β ) extends random_variable α (with_top ℕ)  :=
( meas_at_n : ∀ (n:ℕ), (gen_from_stoch n x).is_measurable ( to_random_variable.to_fun⁻¹' {n}) )
-- prove equivalent to ≤ n

/- structure random_variable (α : Type*) [probability_space α] (β : Type*) [measurable_space β ]:=
( to_fun : α → β )
( meas : measurable to_fun )-/

end

section

-- unbundled
structure is_measure_inv {α : Type*} [measure_space α] (f : α → α) :=
( meas : measurable f )
( inv : ∀ (s : set α) (h : measurable s), volume (f ⁻¹' s) = volume s )

structure ergodic {α β : Type*} [probability_space α] (f : α → α )
  extends is_measure_inv f :=
( ergod : ∀ (s : set α) (h : measurable s) (h₂ : (f ⁻¹' s) = s ),
  volume s = 0 ∨ volume s = 1 )

--- un bundled
/- class is_linear_map {α : Type u} {β : Type v} {γ : Type w}
  [ring α] [add_comm_group β] [add_comm_group γ] [module α β] [module α γ]
  (f : β → γ) : Prop :=
(add  : ∀x y, f (x + y) = f x + f y)
(smul : ∀c x, f (c • x) = c • f x)
-- bundled
structure linear_map {α : Type u} (β : Type v) (γ : Type w)
  [ring α] [add_comm_group β] [add_comm_group γ] [module α β] [module α γ] :=
(to_fun : β → γ)
(add  : ∀x y, to_fun (x + y) = to_fun x + to_fun y)
(smul : ∀c x, to_fun (c • x) = c • to_fun x)-/

end


/-
Copyright (c) 2021 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez

! This file was ported from Lean 3 source module data.fintype.card_embedding
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.BigOperators
import Mathbin.Logic.Equiv.Embedding

/-!
# Number of embeddings

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

This file establishes the cardinality of `α ↪ β` in full generality.
-/

-- mathport name: finset.card
local notation "|" x "|" => Finset.card x

-- mathport name: fintype.card
local notation "‖" x "‖" => Fintype.card x

open Function

open Nat BigOperators

namespace Fintype

/- warning: fintype.card_embedding_eq_of_unique -> Fintype.card_embedding_eq_of_unique is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Unique.{succ u1} α] [_inst_2 : Fintype.{u2} β] [_inst_3 : Fintype.{max u1 u2} (Function.Embedding.{succ u1, succ u2} α β)], Eq.{1} Nat (Fintype.card.{max u1 u2} (Function.Embedding.{succ u1, succ u2} α β) _inst_3) (Fintype.card.{u2} β _inst_2)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Unique.{succ u2} α] [_inst_2 : Fintype.{u1} β] [_inst_3 : Fintype.{max u2 u1} (Function.Embedding.{succ u2, succ u1} α β)], Eq.{1} Nat (Fintype.card.{max u2 u1} (Function.Embedding.{succ u2, succ u1} α β) _inst_3) (Fintype.card.{u1} β _inst_2)
Case conversion may be inaccurate. Consider using '#align fintype.card_embedding_eq_of_unique Fintype.card_embedding_eq_of_uniqueₓ'. -/
theorem card_embedding_eq_of_unique {α β : Type _} [Unique α] [Fintype β] [Fintype (α ↪ β)] :
    ‖α ↪ β‖ = ‖β‖ :=
  card_congr Equiv.uniqueEmbeddingEquivResult
#align fintype.card_embedding_eq_of_unique Fintype.card_embedding_eq_of_unique

/- warning: fintype.card_embedding_eq -> Fintype.card_embedding_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : Fintype.{u2} β] [_inst_3 : Fintype.{max u1 u2} (Function.Embedding.{succ u1, succ u2} α β)], Eq.{1} Nat (Fintype.card.{max u1 u2} (Function.Embedding.{succ u1, succ u2} α β) _inst_3) (Nat.descFactorial (Fintype.card.{u2} β _inst_2) (Fintype.card.{u1} α _inst_1))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : Fintype.{u1} β] [_inst_3 : Fintype.{max u2 u1} (Function.Embedding.{succ u2, succ u1} α β)], Eq.{1} Nat (Fintype.card.{max u2 u1} (Function.Embedding.{succ u2, succ u1} α β) _inst_3) (Nat.descFactorial (Fintype.card.{u1} β _inst_2) (Fintype.card.{u2} α _inst_1))
Case conversion may be inaccurate. Consider using '#align fintype.card_embedding_eq Fintype.card_embedding_eqₓ'. -/
-- Establishes the cardinality of the type of all injections between two finite types.
@[simp]
theorem card_embedding_eq {α β} [Fintype α] [Fintype β] [Fintype (α ↪ β)] :
    ‖α ↪ β‖ = ‖β‖.descFactorial ‖α‖ := by
  classical
    induction' ‹Fintype α› using Fintype.induction_empty_option with α₁ α₂ h₂ e ih α h ih
    · letI := Fintype.ofEquiv _ e.symm
      rw [← card_congr (Equiv.embeddingCongr e (Equiv.refl β)), ih, card_congr e]
    · rw [card_pempty, Nat.descFactorial_zero, card_eq_one_iff]
      exact ⟨embedding.of_is_empty, fun x => FunLike.ext _ _ isEmptyElim⟩
    · rw [card_option, Nat.descFactorial_succ, card_congr (embedding.option_embedding_equiv α β),
        card_sigma, ← ih]
      simp only [Fintype.card_compl_set, Fintype.card_range, Finset.sum_const, Finset.card_univ,
        smul_eq_mul, mul_comm]
#align fintype.card_embedding_eq Fintype.card_embedding_eq

/- warning: fintype.card_embedding_eq_of_infinite -> Fintype.card_embedding_eq_of_infinite is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Infinite.{succ u1} α] [_inst_2 : Fintype.{u2} β] [_inst_3 : Fintype.{max u1 u2} (Function.Embedding.{succ u1, succ u2} α β)], Eq.{1} Nat (Fintype.card.{max u1 u2} (Function.Embedding.{succ u1, succ u2} α β) _inst_3) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Infinite.{succ u2} α] [_inst_2 : Fintype.{u1} β] [_inst_3 : Fintype.{max u2 u1} (Function.Embedding.{succ u2, succ u1} α β)], Eq.{1} Nat (Fintype.card.{max u2 u1} (Function.Embedding.{succ u2, succ u1} α β) _inst_3) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))
Case conversion may be inaccurate. Consider using '#align fintype.card_embedding_eq_of_infinite Fintype.card_embedding_eq_of_infiniteₓ'. -/
/- The cardinality of embeddings from an infinite type to a finite type is zero.
This is a re-statement of the pigeonhole principle. -/
@[simp]
theorem card_embedding_eq_of_infinite {α β : Type _} [Infinite α] [Fintype β] [Fintype (α ↪ β)] :
    ‖α ↪ β‖ = 0 :=
  card_eq_zero
#align fintype.card_embedding_eq_of_infinite Fintype.card_embedding_eq_of_infinite

end Fintype