/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.hom.aut
import group_theory.group_action.units

/-!
# Group actions applied to various types of group

This file contains lemmas about `smul` on `group_with_zero`, and `group`.
-/

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

section mul_action

/-- `monoid.to_mul_action` is faithful on cancellative monoids. -/
@[to_additive /-" `add_monoid.to_add_action` is faithful on additive cancellative monoids. "-/]
instance right_cancel_monoid.to_has_faithful_scalar [right_cancel_monoid α] :
  has_faithful_scalar α α :=
⟨λ x y h, mul_right_cancel (h 1)⟩

section group
variables [group α] [mul_action α β]

@[simp, to_additive] lemma inv_smul_smul (c : α) (x : β) : c⁻¹ • c • x = x :=
by rw [smul_smul, mul_left_inv, one_smul]

@[simp, to_additive] lemma smul_inv_smul (c : α) (x : β) : c • c⁻¹ • x = x :=
by rw [smul_smul, mul_right_inv, one_smul]

/-- Given an action of a group `α` on `β`, each `g : α` defines a permutation of `β`. -/
@[to_additive, simps] def mul_action.to_perm (a : α) : equiv.perm β :=
⟨λ x, a • x, λ x, a⁻¹ • x, inv_smul_smul a, smul_inv_smul a⟩

/-- Given an action of an additive group `α` on `β`, each `g : α` defines a permutation of `β`. -/
add_decl_doc add_action.to_perm

/-- `mul_action.to_perm` is injective on faithful actions. -/
@[to_additive] lemma mul_action.to_perm_injective [has_faithful_scalar α β] :
  function.injective (mul_action.to_perm : α → equiv.perm β) :=
(show function.injective (equiv.to_fun ∘ mul_action.to_perm), from smul_left_injective').of_comp

variables (α) (β)

/-- Given an action of a group `α` on a set `β`, each `g : α` defines a permutation of `β`. -/
@[simps]
def mul_action.to_perm_hom : α →* equiv.perm β :=
{ to_fun := mul_action.to_perm,
  map_one' := equiv.ext $ one_smul α,
  map_mul' := λ u₁ u₂, equiv.ext $ mul_smul (u₁:α) u₂ }

/-- Given an action of a additive group `α` on a set `β`, each `g : α` defines a permutation of
`β`. -/
@[simps]
def add_action.to_perm_hom (α : Type*) [add_group α] [add_action α β] :
  α →+ additive (equiv.perm β) :=
{ to_fun := λ a, additive.of_mul $ add_action.to_perm a,
  map_zero' := equiv.ext $ zero_vadd α,
  map_add' := λ a₁ a₂, equiv.ext $ add_vadd a₁ a₂ }

/-- The tautological action by `equiv.perm α` on `α`.

This generalizes `function.End.apply_mul_action`.-/
instance equiv.perm.apply_mul_action (α : Type*) : mul_action (equiv.perm α) α :=
{ smul := λ f a, f a,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] protected lemma equiv.perm.smul_def {α : Type*} (f : equiv.perm α) (a : α) : f • a = f a :=
rfl

/-- `equiv.perm.apply_mul_action` is faithful. -/
instance equiv.perm.apply_has_faithful_scalar (α : Type*) : has_faithful_scalar (equiv.perm α) α :=
⟨λ x y, equiv.ext⟩

variables {α} {β}

@[to_additive] lemma inv_smul_eq_iff {a : α} {x y : β} : a⁻¹ • x = y ↔ x = a • y :=
(mul_action.to_perm a).symm_apply_eq

@[to_additive] lemma eq_inv_smul_iff {a : α} {x y : β} : x = a⁻¹ • y ↔ a • x = y :=
(mul_action.to_perm a).eq_symm_apply

lemma smul_inv [group β] [smul_comm_class α β β] [is_scalar_tower α β β] (c : α) (x : β) :
  (c • x)⁻¹ = c⁻¹ • x⁻¹  :=
by rw [inv_eq_iff_mul_eq_one, smul_mul_smul, mul_right_inv, mul_right_inv, one_smul]

lemma smul_zpow [group β] [smul_comm_class α β β] [is_scalar_tower α β β]
  (c : α) (x : β) (p : ℤ) :
  (c • x) ^ p = c ^ p • x ^ p :=
by { cases p; simp [smul_pow, smul_inv] }

@[simp] lemma commute.smul_right_iff [has_mul β] [smul_comm_class α β β] [is_scalar_tower α β β]
  {a b : β} (r : α) :
  commute a (r • b) ↔ commute a b :=
⟨λ h, inv_smul_smul r b ▸ h.smul_right r⁻¹, λ h, h.smul_right r⟩

@[simp] lemma commute.smul_left_iff [has_mul β] [smul_comm_class α β β] [is_scalar_tower α β β]
  {a b : β} (r : α) :
  commute (r • a) b ↔ commute a b :=
by rw [commute.symm_iff, commute.smul_right_iff, commute.symm_iff]

@[to_additive] protected lemma mul_action.bijective (g : α) : function.bijective (λ b : β, g • b) :=
(mul_action.to_perm g).bijective

@[to_additive] protected lemma mul_action.injective (g : α) : function.injective (λ b : β, g • b) :=
(mul_action.bijective g).injective

@[to_additive] lemma smul_left_cancel (g : α) {x y : β} (h : g • x = g • y) : x = y :=
mul_action.injective g h

@[simp, to_additive] lemma smul_left_cancel_iff (g : α) {x y : β} : g • x = g • y ↔ x = y :=
(mul_action.injective g).eq_iff

@[to_additive] lemma smul_eq_iff_eq_inv_smul (g : α) {x y : β} :
  g • x = y ↔ x = g⁻¹ • y :=
(mul_action.to_perm g).apply_eq_iff_eq_symm_apply

end group

/-- `monoid.to_mul_action` is faithful on nontrivial cancellative monoids with zero. -/
instance cancel_monoid_with_zero.to_has_faithful_scalar [cancel_monoid_with_zero α] [nontrivial α] :
  has_faithful_scalar α α :=
⟨λ x y h, mul_left_injective₀ one_ne_zero (h 1)⟩

section gwz
variables [group_with_zero α] [mul_action α β]

@[simp]
lemma inv_smul_smul₀ {c : α} (hc : c ≠ 0) (x : β) : c⁻¹ • c • x = x :=
inv_smul_smul (units.mk0 c hc) x

@[simp]
lemma smul_inv_smul₀ {c : α} (hc : c ≠ 0) (x : β) : c • c⁻¹ • x = x :=
smul_inv_smul (units.mk0 c hc) x

lemma inv_smul_eq_iff₀ {a : α} (ha : a ≠ 0) {x y : β} : a⁻¹ • x = y ↔ x = a • y :=
(mul_action.to_perm (units.mk0 a ha)).symm_apply_eq

lemma eq_inv_smul_iff₀ {a : α} (ha : a ≠ 0) {x y : β} : x = a⁻¹ • y ↔ a • x = y :=
(mul_action.to_perm (units.mk0 a ha)).eq_symm_apply

@[simp] lemma commute.smul_right_iff₀ [has_mul β] [smul_comm_class α β β] [is_scalar_tower α β β]
  {a b : β} {c : α} (hc : c ≠ 0) :
  commute a (c • b) ↔ commute a b :=
commute.smul_right_iff (units.mk0 c hc)

@[simp] lemma commute.smul_left_iff₀ [has_mul β] [smul_comm_class α β β] [is_scalar_tower α β β]
  {a b : β} {c : α} (hc : c ≠ 0) :
  commute (c • a) b ↔ commute a b :=
commute.smul_left_iff (units.mk0 c hc)

end gwz

end mul_action

section distrib_mul_action

section group
variables [group α] [add_monoid β] [distrib_mul_action α β]

variables (β)

/-- Each element of the group defines an additive monoid isomorphism.

This is a stronger version of `mul_action.to_perm`. -/
@[simps {simp_rhs := tt}]
def distrib_mul_action.to_add_equiv (x : α) : β ≃+ β :=
{ .. distrib_mul_action.to_add_monoid_hom β x,
  .. mul_action.to_perm_hom α β x }

variables (α β)

/-- Each element of the group defines an additive monoid isomorphism.

This is a stronger version of `mul_action.to_perm_hom`. -/
@[simps]
def distrib_mul_action.to_add_aut : α →* add_aut β :=
{ to_fun := distrib_mul_action.to_add_equiv β,
  map_one' := add_equiv.ext (one_smul _),
  map_mul' := λ a₁ a₂, add_equiv.ext (mul_smul _ _) }

variables {α β}

theorem smul_eq_zero_iff_eq (a : α) {x : β} : a • x = 0 ↔ x = 0 :=
⟨λ h, by rw [← inv_smul_smul a x, h, smul_zero], λ h, h.symm ▸ smul_zero _⟩

theorem smul_ne_zero_iff_ne (a : α) {x : β} : a • x ≠ 0 ↔ x ≠ 0 :=
not_congr $ smul_eq_zero_iff_eq a

end group

section gwz
variables [group_with_zero α] [add_monoid β] [distrib_mul_action α β]

theorem smul_eq_zero_iff_eq' {a : α} (ha : a ≠ 0) {x : β} : a • x = 0 ↔ x = 0 :=
smul_eq_zero_iff_eq (units.mk0 a ha)

theorem smul_ne_zero_iff_ne' {a : α} (ha : a ≠ 0) {x : β} : a • x ≠ 0 ↔ x ≠ 0 :=
smul_ne_zero_iff_ne (units.mk0 a ha)

end gwz

end distrib_mul_action

section mul_distrib_mul_action
variables [group α] [monoid β] [mul_distrib_mul_action α β]

variables (β)

/-- Each element of the group defines a multiplicative monoid isomorphism.

This is a stronger version of `mul_action.to_perm`. -/
@[simps {simp_rhs := tt}]
def mul_distrib_mul_action.to_mul_equiv (x : α) : β ≃* β :=
{ .. mul_distrib_mul_action.to_monoid_hom β x,
  .. mul_action.to_perm_hom α β x }

variables (α β)

/-- Each element of the group defines an multiplicative monoid isomorphism.

This is a stronger version of `mul_action.to_perm_hom`. -/
@[simps]
def mul_distrib_mul_action.to_mul_aut : α →* mul_aut β :=
{ to_fun := mul_distrib_mul_action.to_mul_equiv β,
  map_one' := mul_equiv.ext (one_smul _),
  map_mul' := λ a₁ a₂, mul_equiv.ext (mul_smul _ _) }

variables {α β}

end mul_distrib_mul_action

section arrow

/-- If `G` acts on `A`, then it acts also on `A → B`, by `(g • F) a = F (g⁻¹ • a)`. -/
@[simps] def arrow_action {G A B : Type*} [group G] [mul_action G A] : mul_action G (A → B) :=
{ smul := λ g F a, F (g⁻¹ • a),
  one_smul := by { intro, simp only [one_inv, one_smul] },
  mul_smul := by { intros, simp only [mul_smul, mul_inv_rev] } }

local attribute [instance] arrow_action

/-- When `B` is a monoid, `arrow_action` is additionally a `mul_distrib_mul_action`. -/
def arrow_mul_distrib_mul_action {G A B : Type*} [group G] [mul_action G A] [monoid B] :
  mul_distrib_mul_action G (A → B) :=
{ smul_one := λ g, rfl,
  smul_mul := λ g f₁ f₂, rfl }

local attribute [instance] arrow_mul_distrib_mul_action

/-- Given groups `G H` with `G` acting on `A`, `G` acts by
  multiplicative automorphisms on `A → H`. -/
@[simps] def mul_aut_arrow {G A H} [group G] [mul_action G A] [monoid H] : G →* mul_aut (A → H) :=
mul_distrib_mul_action.to_mul_aut _ _

end arrow

namespace is_unit

section mul_action
variables [monoid α] [mul_action α β]

@[to_additive] lemma smul_left_cancel {a : α} (ha : is_unit a) {x y : β} :
  a • x = a • y ↔ x = y :=
let ⟨u, hu⟩ := ha in hu ▸ smul_left_cancel_iff u

end mul_action

section distrib_mul_action
variables [monoid α] [add_monoid β] [distrib_mul_action α β]

@[simp] theorem smul_eq_zero {u : α} (hu : is_unit u) {x : β} :
  u • x = 0 ↔ x = 0 :=
exists.elim hu $ λ u hu, hu ▸ smul_eq_zero_iff_eq u

end distrib_mul_action

end is_unit

@[simp] lemma is_unit_smul_iff [group α] [monoid β] [mul_action α β]
  [smul_comm_class α β β] [is_scalar_tower α β β] {g : α} {m : β} :
  is_unit (g • m) ↔ is_unit m :=
⟨λ h, inv_smul_smul g m ▸ h.smul g⁻¹, is_unit.smul g⟩


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.algebra.basic
import topology.locally_constant.basic

/-!
# Algebraic structure on locally constant functions

This file puts algebraic structure (`add_group`, etc)
on the type of locally constant functions.

-/

namespace locally_constant

variables {X Y : Type*} [topological_space X]

@[to_additive] instance [has_one Y] : has_one (locally_constant X Y) :=
{ one := const X 1 }

@[simp, to_additive] lemma coe_one [has_one Y] : ⇑(1 : locally_constant X Y) = (1 : X → Y) := rfl

@[to_additive] lemma one_apply [has_one Y] (x : X) : (1 : locally_constant X Y) x = 1 := rfl

@[to_additive] instance [has_inv Y] : has_inv (locally_constant X Y) :=
{ inv := λ f, ⟨f⁻¹ , f.is_locally_constant.inv⟩ }

@[simp, to_additive] lemma coe_inv [has_inv Y] (f : locally_constant X Y) : ⇑(f⁻¹) = f⁻¹ := rfl

@[to_additive]

@[to_additive] instance [has_mul Y] : has_mul (locally_constant X Y) :=
{ mul := λ f g, ⟨f * g, f.is_locally_constant.mul g.is_locally_constant⟩ }

@[simp, to_additive] lemma coe_mul [has_mul Y] (f g : locally_constant X Y) :
  ⇑(f * g) = f * g :=
rfl

@[to_additive] lemma mul_apply [has_mul Y] (f g : locally_constant X Y) (x : X) :
  (f * g) x = f x * g x := rfl

@[to_additive] instance [mul_one_class Y] : mul_one_class (locally_constant X Y) :=
{ one_mul := by { intros, ext, simp only [mul_apply, one_apply, one_mul] },
  mul_one := by { intros, ext, simp only [mul_apply, one_apply, mul_one] },
  .. locally_constant.has_one,
  .. locally_constant.has_mul }

/-- `coe_fn` is a `monoid_hom`. -/
@[to_additive "`coe_fn` is an `add_monoid_hom`.", simps]
def coe_fn_monoid_hom [mul_one_class Y] : locally_constant X Y →* (X → Y) :=
{ to_fun   := coe_fn,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

/-- The constant-function embedding, as a multiplicative monoid hom. -/
@[to_additive "The constant-function embedding, as an additive monoid hom.", simps]
def const_monoid_hom [mul_one_class Y] : Y →* locally_constant X Y :=
{ to_fun   := const X,
  map_one' := rfl,
  map_mul' := λ _ _, rfl, }

instance [mul_zero_class Y] : mul_zero_class (locally_constant X Y) :=
{ zero_mul := by { intros, ext, simp only [mul_apply, zero_apply, zero_mul] },
  mul_zero := by { intros, ext, simp only [mul_apply, zero_apply, mul_zero] },
  .. locally_constant.has_zero,
  .. locally_constant.has_mul }

instance [mul_zero_one_class Y] : mul_zero_one_class (locally_constant X Y) :=
{ .. locally_constant.mul_zero_class, .. locally_constant.mul_one_class }

@[to_additive] instance [has_div Y] : has_div (locally_constant X Y) :=
{ div := λ f g, ⟨f / g, f.is_locally_constant.div g.is_locally_constant⟩ }

@[to_additive] lemma coe_div [has_div Y] (f g : locally_constant X Y) :
  ⇑(f / g) = f / g := rfl

@[to_additive] lemma div_apply [has_div Y] (f g : locally_constant X Y) (x : X) :
  (f / g) x = f x / g x := rfl

@[to_additive] instance [semigroup Y] : semigroup (locally_constant X Y) :=
{ mul_assoc := by { intros, ext, simp only [mul_apply, mul_assoc] },
  .. locally_constant.has_mul }

instance [semigroup_with_zero Y] : semigroup_with_zero (locally_constant X Y) :=
{ .. locally_constant.mul_zero_class,
  .. locally_constant.semigroup }

@[to_additive] instance [comm_semigroup Y] : comm_semigroup (locally_constant X Y) :=
{ mul_comm := by { intros, ext, simp only [mul_apply, mul_comm] },
  .. locally_constant.semigroup }

@[to_additive] instance [monoid Y] : monoid (locally_constant X Y) :=
{ mul := (*),
  .. locally_constant.semigroup, .. locally_constant.mul_one_class }

@[to_additive] instance [comm_monoid Y] : comm_monoid (locally_constant X Y) :=
{ .. locally_constant.comm_semigroup, .. locally_constant.monoid }

@[to_additive] instance [group Y] : group (locally_constant X Y) :=
{ mul_left_inv := by { intros, ext, simp only [mul_apply, inv_apply, one_apply, mul_left_inv] },
  div_eq_mul_inv := by { intros, ext, simp only [mul_apply, inv_apply, div_apply, div_eq_mul_inv] },
  .. locally_constant.monoid, .. locally_constant.has_inv, .. locally_constant.has_div }

@[to_additive] instance [comm_group Y] : comm_group (locally_constant X Y) :=
{ .. locally_constant.comm_monoid, .. locally_constant.group }

instance [distrib Y] : distrib (locally_constant X Y) :=
{ left_distrib := by { intros, ext, simp only [mul_apply, add_apply, mul_add] },
  right_distrib := by { intros, ext, simp only [mul_apply, add_apply, add_mul] },
  .. locally_constant.has_add, .. locally_constant.has_mul }

instance [non_unital_non_assoc_semiring Y] : non_unital_non_assoc_semiring (locally_constant X Y) :=
{ .. locally_constant.add_comm_monoid, .. locally_constant.has_mul,
  .. locally_constant.distrib, .. locally_constant.mul_zero_class }

instance [non_unital_semiring Y] : non_unital_semiring (locally_constant X Y) :=
{ .. locally_constant.semigroup, .. locally_constant.non_unital_non_assoc_semiring }

instance [non_assoc_semiring Y] : non_assoc_semiring (locally_constant X Y) :=
{ .. locally_constant.mul_one_class, .. locally_constant.non_unital_non_assoc_semiring }

/-- The constant-function embedding, as a ring hom.  -/
@[simps] def const_ring_hom [non_assoc_semiring Y] : Y →+* locally_constant X Y :=
{ to_fun    := const X,
  .. const_monoid_hom,
  .. const_add_monoid_hom, }

instance [semiring Y] : semiring (locally_constant X Y) :=
{ .. locally_constant.add_comm_monoid, .. locally_constant.monoid,
  .. locally_constant.distrib, .. locally_constant.mul_zero_class }

instance [comm_semiring Y] : comm_semiring (locally_constant X Y) :=
{ .. locally_constant.semiring, .. locally_constant.comm_monoid }

instance [ring Y] : ring (locally_constant X Y) :=
{ .. locally_constant.semiring, .. locally_constant.add_comm_group }

instance [comm_ring Y] : comm_ring (locally_constant X Y) :=
{ .. locally_constant.comm_semiring, .. locally_constant.ring }

variables {R : Type*}

instance [has_scalar R Y] : has_scalar R (locally_constant X Y) :=
{ smul := λ r f,
  { to_fun := r • f,
    is_locally_constant := ((is_locally_constant f).comp ((•) r) : _), } }

@[simp] lemma coe_smul [has_scalar R Y] (r : R) (f : locally_constant X Y) : ⇑(r • f) = r • f := rfl

lemma smul_apply [has_scalar R Y] (r : R) (f : locally_constant X Y) (x : X) :
  (r • f) x = r • (f x) :=
rfl

instance [monoid R] [mul_action R Y] : mul_action R (locally_constant X Y) :=
function.injective.mul_action _ coe_injective (λ _ _, rfl)

instance [monoid R] [add_monoid Y] [distrib_mul_action R Y] :
  distrib_mul_action R (locally_constant X Y) :=
function.injective.distrib_mul_action coe_fn_add_monoid_hom coe_injective (λ _ _, rfl)

instance [semiring R] [add_comm_monoid Y] [module R Y] : module R (locally_constant X Y) :=
function.injective.module R coe_fn_add_monoid_hom coe_injective (λ _ _, rfl)

section algebra

variables [comm_semiring R] [semiring Y] [algebra R Y]

instance : algebra R (locally_constant X Y) :=
{ to_ring_hom := const_ring_hom.comp $ algebra_map R Y,
  commutes'   := by { intros, ext, exact algebra.commutes' _ _, },
  smul_def'   := by { intros, ext, exact algebra.smul_def' _ _, }, }

@[simp] lemma coe_algebra_map (r : R) :
  ⇑(algebra_map R (locally_constant X Y) r) = algebra_map R (X → Y) r :=
rfl

end algebra

end locally_constant


import data.int.basic

inductive mynat : Type
  | O : mynat
  | S : mynat → mynat

/-!
# Understanding no confusion

This is my attempt to understand `no_confusion`.
-/

open mynat

example : mynat := O

example : mynat := O.S

/-
## Zero is not the successor of a natural number

-/

namespace zero_ne_S

/-
First, we'll give a very direct proof that 0 ≠ 1. Idea: find a predicate `Q : mynat → Prop`
such that `Q(O)` is easily proved but for which `Q(O.S)` is equal to `O ≠ O.S`.

If we assume (for a contradiction), `h : O = O.S`, then substituting `h` into a proof of `Q(O)`
gives a proof of `Q(O.S)`. That is, we'll have proved `O ≠ O.S` on the assumption `O = O.S`,
giving a contradiction.
-/

def P : mynat → Prop
| O      := true
| (S k)  := false

def Q (y : mynat) : Prop := O = y → P y

lemma QO : Q(O) := λ h, trivial

example : Q(O.S) = (O ≠ O.S) := rfl

lemma zero_ne_one : O ≠ S(O) :=
assume h : O = S(O),
have h₂ : O ≠ S(O), from (@eq.subst _ Q _ _ h QO),
show false, from h₂ h

lemma S_ne_zero (m : mynat) : O ≠ S(m) :=
assume h : O = S(m),
have h₂ : O ≠ S(m), from @eq.subst _ Q _ _ h QO,
show false, from h₂ h

end zero_ne_S

/-
## The successor function is injective
-/

/- The injectivity of `S` can be proved using the built-in `mynat.no_confusion` -/

example {a b : mynat} : S(a) = S(b) → a = b :=
assume h : S(a) = S(b),
mynat.no_confusion h id

/-
In the proof above, `mynat.no_confusion h` is a term of type `(a = b → a = b) → (a = b)`. Can
we do something similar, from scratch?
-/

namespace succ_inj

def P : mynat → mynat → Prop
| (S a) (S b) := a = b
| _     _     := true

def snc {m n : mynat} (h : m = n) : P m n :=
have h₂ : P m m, from mynat.cases_on m trivial (λ k, rfl),
h ▸ h₂

lemma succ_inj (m n : mynat) (h : S m = S n) : m = n :=
have h₁ : S(m) = S(m) → P (S m) (S m),  from λ _, rfl,
have h₂ : S(m) = S(n) → P (S m) (S n),  from h ▸ h₁,
have h₃ : P (S m) (S n),                from h₂ h,
show m = n,                             from h₃

end succ_inj

/-
## Alternative injectivity proof

The next proof of injectivity of succ is closer to the construction of `no_confusion`.
-/

namespace hidden

def P : mynat → mynat → Prop
| (S a) (S b) := (a = b → a = b) → a = b
| _     _     := true

def C (m : mynat) := λ (x : mynat), S(m) = x → P (S m) x

lemma S_inj (m n : mynat) (h : S m = S n) : m = n :=
have h₁ : S(m) = S(m) → P (S m) (S m),  from λ k h, rfl,
have h₂ : S(m) = S(n) → P (S m) (S n),  from
  @eq.subst _ (C m) _ _ h h₁,
have h₃ : P (S m) (S n),                from h₂ h,
show m = n,                             from h₃ id

end hidden

/-
## A home-spun `no_confusion` function

We'll write a function that is extensionally equal to `mynat.no_confusion_type`

We want a function `nct` that takes `T : Sort u` (think of `T : Prop` for the moment) and two
natural numbers `m` and `n` so that `nct T m n` is:

`T → T`,                if `m = n = O`,
`(a = b → T) → T`,      if `m = S a` and `n = S b`
`T`,                    otherwise
-/

namespace no_confusion_simple

universe u

def nct (T : Sort u) : mynat → mynat → Sort u
| O     O     := T → T
| (S a) (S b) := (a = b → T) → T
| _     _     := T

/-
We now write a function `nc`, such that if `h : a = b`, then `nc T h` is a term of type `nct T a b`.

Thus, if `h : 3 = 4`, then `nct T h` is a term of type `nct T 3 4` and hence of type
`(2 = 3 → T) → T`.
-/

/-
The functions `foo` and `nct_self` do the same thing, they take
`T : Sort u`, `m : mynat`, `h : m = m` and return a term of type `nct T m m`.

The argument `h : m = m` may seem redundant, as it follows by reflexivity. However, we'll later
substitute `n` for the second `m`, making the argument `m = n`.
-/

def foo (T : Sort u) (m : mynat) :=
λ (_ : m = m), @mynat.cases_on (λ v, nct T v v) m id (λ _ α, α rfl)

def nct_self (T : Sort u) (m : mynat) (h : m = m) : nct T m m :=
match m with
| O     :=  show T → T, from id
| (S a) :=  show (a = a → T) → T, from
            assume h₂ : a = a → T,
            show T, from h₂ rfl
end

/-
The `nc` function is our equivalent to `no_confusion`. It constructs a term of type `nct T m n`,
given a term `h : m = n`.
-/

def nc (T : Sort u) {m n : mynat} (h : m = n) : nct T m n :=
let C := λ x, m = x → nct T m x in
have h₁ : m = m → nct T m m, from nct_self T m,
have h₂ : m = n → nct T m n := (@eq.rec _ m C h₁) n h,
show nct T m n, from h₂ h

/-
Using `nc`, we prove the injectivity of `S`.
-/

lemma S_inj (m n : mynat) (h : S m = S n) : m = n := (nc (m = n) h) id

end no_confusion_simple

/-
## A more complicated version of no_confusion
-/

namespace no_confusion_complicated

universe u

@[reducible]
protected def mynat.no_confusion_type' : Π (P : Sort u) (v₁ v₂ : mynat), Sort u :=
λ P v₁ v₂,
/-
In general, if `u` and `v` are type universes and if `P : Sort u` and `Q : Sort v`, then
`P → Q : Sort (imax u v)`. In the special case where `u` and `v` are equal, then
`imax u v = u`, so `P → Q : Sort u`.
Further, if `u = 0`, so `Sort u = Prop`, then `imax u v` is `v`.
This kind of construction appears thrice below:

1.  `P → P`. As `P : Sort u`, `P → P : Sort u`.
2.  `α = α₁ → P`, where `α α₁ : mynat`. Now `α = α₁ : Prop`, so `α = α₁ → P : Sort (imax 0 u)`
    That is, `α = α₁ → P : Sort u`.
3.  `(α = α₁ → P) → P`. As seen above, `α = α₁ → P : Sort u`, whence `(α = α₁ → P) → P : Sort u`.

Initially, it might be simplest to consider the special case `P : Prop`.
-/
have h₁ : Sort u := @mynat.cases_on (λ _, Sort u) v₂ (P → P) (λ _, P),
/-
So `h₁` is `P → P` if `v₂ = 0` and is `P` otherwise.
-/
have h₂ : mynat → Sort u := λ α₁, @mynat.cases_on (λ _, Sort u) v₂ P (λ α₂, (α₁ = α₂ → P) → P),
/-
So `h₂` is a function of `a` that gives `P` if `v₂ = 0` and gives `(a = k → P) → P` if `v₂ = S k`.
-/
@mynat.cases_on (λ _, Sort u) v₁ h₁ h₂
/-
So `mynat.no_confusion_type'` is `h₁` if `v₁ = 0`. Otherwise, if `v₁ = S a`, it is `h₂ a`.
-/

section testing_no_confusion_type'

variable P : Sort u

/-
`mynat.no_confunsion_type'` takes three arguments. The first argument is a type. Let's fix `P` as
this first argument. It then takes two arguments `v₁` and `v₂`, each of type `mynat`.

1. If `v₁` is `O` (the base case), then
  * if `v₂` is `O`, then the return value is `P → P`,
  * otherwise, the return value is `P`,
2. If `v₁` is `S α₁`, then
  * if `v₂` is `O`, then the return value is `P`,
  * if `v₂` is `S α₂`, then the return value is `(α₁ = α₂ → P) → P`.

We see this in practice in the following examples.

NOTE the importance of the parentheses around the right side of each equation below!
-/
example : mynat.no_confusion_type' P O O = (P → P) := rfl

example : mynat.no_confusion_type' P O O.S = P := rfl

example : mynat.no_confusion_type' P O.S O = P := rfl

example : mynat.no_confusion_type' P O.S O.S.S = ((O = O.S → P) → P) := rfl

example : mynat.no_confusion_type' P O.S O.S = ((O = O → P) → P) := rfl

example : mynat.no_confusion_type' P O.S.S O.S.S = ((O.S = O.S → P) → P) := rfl

end testing_no_confusion_type'

/--
`mynat.no_confusion'` takes (implicitly) a type `P : Sort u` and `v₁ v₂ : mynat`.
Explicitly, it takes `h : v₁ = v₂` and returns a term of type `mynat.no_confusion_type' P v₁ v₂`

The mechanism for producing such a term is quite clever. The idea is to construct a term `h₂` of
type `v₁ = v₂ → mynat.no_confusion_type' P v₁ v₂` and then apply this term to `h`.

The term `h₂` is the result of substituting some occurrences of `v₁` in the expression
`v₁ = v₁ → mynat.no_confusion_type' P v₁ v₁` with `v₂`, using `eq.rec`.

The inputs to `eq.rec` are (1) a motive `C` and (2) a term of type `C v₁`. Here,

1.  `C` is `λ x, v₁ = x → mynat.no_confusion_type' P v₁ x`.
2.  To write a term of type `C v₁` is to assume a term of type `v₁ = v₁` (which isn't of any use,
    but needs to be done anyway) and then derive a term of type `mynat.no_confusion_type' P v₁ v₁`.
    From the examples above, we can see that there are two further subcases:
    * If `v₁` is `O`, then we need a term of type `P → P`. But `id` is such a term.
    * If `v₁` is `S α`, then we need a term of type `(α = α → P) → P`. But `λ _ α, α rfl` is
      such a term.
-/
@[reducible]
protected def mynat.no_confusion' :
  Π {P : Sort u} {v₁ v₂ : mynat}, v₁ = v₂ → mynat.no_confusion_type' P v₁ v₂ :=
λ P v₁ v₂ h,
let C := λ x, v₁ = x → mynat.no_confusion_type' P v₁ x in
let Cv₁ := (λ _ : v₁ = v₁,
  @mynat.cases_on (λ v, mynat.no_confusion_type' P v v) v₁ id (λ _ α, α rfl)) in
have h₂ : v₁ = v₂ → mynat.no_confusion_type' P v₁ v₂ :=
  @eq.rec _ v₁ C Cv₁ v₂ h,
h₂ h

lemma zero_ne_one' : O ≠ O.S := λ h, mynat.no_confusion' h

lemma zero_ne_S (m : mynat) : O ≠ S m := λ h, mynat.no_confusion' h

lemma one_ne_two : O.S ≠ O.S.S :=
λ (h : O.S = O.S.S),
have h₂ : (O = O.S → false) → false, from mynat.no_confusion' h,
h₂ zero_ne_S.zero_ne_one

lemma two_ne_three : O.S.S ≠ O.S.S.S :=
λ (h : O.S.S = O.S.S.S),
have h₂ : (O.S = O.S.S → false) → false, from mynat.no_confusion' h,
h₂ one_ne_two

def foo : ℤ → ℤ :=
have h : 0 = 0, from rfl,
@nat.no_confusion _ _ _ h

def foo2 : (0 = 0 → ℕ) → ℕ :=
have h : 1 = 1, from rfl,
@nat.no_confusion _ _ _ h

def myid {P} : P → P := @nat.no_confusion P 0 0 rfl

example {P : Type*} : @myid P = @id P := funext (λ _, rfl)

end no_confusion_complicated

/-
## No confusion for integers
-/

inductive myint : Type
| f : ℕ → myint
| g : ℕ → myint

/-
Let `n` be natural number. We'll think of `f(n)` as the integer `n` and of `g(n)` as the
integer `-(1 + n)`.

We'll show `f` is injective.
-/

namespace myint

open myint

/-
## Using built in
We'll start by using the built in `myint.no_confusion` function to prove that `f` is injective.
-/

namespace built_in

universe u

variables (T : Sort u) (a b : ℕ)

example : myint.no_confusion_type T (f a) (f b) = ((a = b → T) → T) := rfl

example (m n : ℕ) (h : f(m) = f(n)) : ((m = n → T) → T) := @myint.no_confusion T _ _ h

lemma f_inj {m n : ℕ} (h : f(m) = f(n)) : m = n := myint.no_confusion h id

end built_in

/-
## Showing injectivity from scratch
-/

namespace f_inj_from_scratch

def P : myint → myint → Prop
| (f a) (f b) := a = b
| _     _     := true

lemma f_inj {m n : ℕ} (h : f(m) = f(n)) : m = n :=
show P (f m) (f n), from
have h₂ : P (f m) (f m), from @rfl _ _,
h ▸ h₂

end f_inj_from_scratch

end myint


-- import definition of prime number
import data.nat.prime

open nat

-- the claim that there are infinitely many primes
example : ∀ n, ∃ p, n ≤ p ∧ nat.prime p :=
exists_infinite_primes -- use the existing proof in Lean's maths library


-- La composición de funciones biyectivas es biyectiva
-- ===================================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar que la composición de dos funciones
-- biyectivas es una función biyectiva.
-- ----------------------------------------------------

import tactic

open function

variables {X Y Z : Type}
variable  {f : X → Y}
variable  {g : Y → Z}

-- 1ª demostración
example
  (hf : bijective f)
  (hg : bijective g)
  : bijective (g ∘ f) :=
begin
  split,
  { apply injective.comp,
    { exact hg.left, },
    { exact hf.left, }},
  { apply surjective.comp,
    { exact hg.right, },
    { exact hf.right, }},
end

-- 2ª demostración
example
  (hf : bijective f)
  (hg : bijective g)
  : bijective (g ∘ f) :=
begin
  split,
  { exact injective.comp hg.1 hf.1, },
  { exact surjective.comp hg.2 hf.2, },
end

-- 3ª demostración
example
  (hf : bijective f)
  (hg : bijective g)
  : bijective (g ∘ f) :=
⟨injective.comp  hg.1 hf.1,
 surjective.comp hg.2 hf.2⟩

-- 4ª demostración
example
  (hf : bijective f)
  (hg : bijective g)
  : bijective (g ∘ f) :=
have giny : injective g, from hg.left,
have gsupr : surjective g, from hg.right,
have finy : injective f, from hf.left,
have fsupr : surjective f, from hf.right,
show bijective (g ∘ f),
  from and.intro (injective.comp giny finy)
                 (surjective.comp gsupr fsupr)

-- 5ª demostración
example
  (hf : bijective f)
  (hg : bijective g)
  : bijective (g ∘ f) :=
-- by library_search
bijective.comp hg hf

-- 6ª demostración
example :
  bijective f → bijective g → bijective (g ∘ f) :=
begin
  rintros ⟨f_iny,f_supr⟩ ⟨g_iny,g_supr⟩,
  exact ⟨injective.comp  g_iny f_iny,
         surjective.comp g_supr f_supr⟩,
end

-- 7ª demostración
example :
  bijective f → bijective g → bijective (g ∘ f) :=
begin
  rintros ⟨f_iny,f_supr⟩ ⟨g_iny,g_supr⟩,
  exact ⟨g_iny.comp f_iny,
         g_supr.comp f_supr⟩,
end

-- 8ª demostración
example :
  bijective f → bijective g → bijective (g ∘ f)
| ⟨f_iny,f_supr⟩ ⟨g_iny,g_supr⟩ :=
  ⟨g_iny.comp f_iny, g_supr.comp f_supr⟩

-- 9ª demostración
example :
  bijective f → bijective g → bijective (g ∘ f) :=
λ ⟨f_iny,f_supr⟩ ⟨g_iny,g_supr⟩,
  ⟨g_iny.comp f_iny, g_supr.comp f_supr⟩


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import ring_theory.ideal.basic
import data.polynomial.basic

/-!
# Induction on polynomials

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

This file contains lemmas dealing with different flavours of induction on polynomials.
See also `data/polynomial/inductions.lean` (with an `s`!).

The main result is `polynomial.induction_on`.
-/

noncomputable theory

open finsupp finset

namespace polynomial
open_locale polynomial
universes u v w x y z
variables {R : Type u} {S : Type v} {T : Type w} {ι : Type x} {k : Type y} {A : Type z}
  {a b : R} {m n : ℕ}

section semiring
variables [semiring R] {p q r : R[X]}

@[elab_as_eliminator] protected lemma induction_on {M : R[X] → Prop} (p : R[X])
  (h_C : ∀a, M (C a))
  (h_add : ∀p q, M p → M q → M (p + q))
  (h_monomial : ∀(n : ℕ) (a : R), M (C a * X^n) → M (C a * X^(n+1))) :
  M p :=
begin
  have A : ∀{n:ℕ} {a}, M (C a * X^n),
  { assume n a,
    induction n with n ih,
    { simp only [pow_zero, mul_one, h_C] },
    { exact h_monomial _ _ ih } },
  have B : ∀ (s : finset ℕ), M (s.sum (λ (n : ℕ), C (p.coeff n) * X ^ n)),
  { apply finset.induction,
    { convert h_C 0, exact C_0.symm },
    { assume n s ns ih, rw sum_insert ns, exact h_add _ _ A ih, } },
  rw [← sum_C_mul_X_pow_eq p, polynomial.sum],
  exact B _
end

/--
To prove something about polynomials,
it suffices to show the condition is closed under taking sums,
and it holds for monomials.
-/
@[elab_as_eliminator] protected lemma induction_on' {M : R[X] → Prop} (p : R[X])
  (h_add : ∀p q, M p → M q → M (p + q))
  (h_monomial : ∀(n : ℕ) (a : R), M (monomial n a)) :
  M p :=
polynomial.induction_on p (h_monomial 0) h_add
(λ n a h, by { rw C_mul_X_pow_eq_monomial at ⊢, exact h_monomial _ _ })

open submodule polynomial set
variables {f : R[X]} {I : ideal R[X]}

/--  If the coefficients of a polynomial belong to an ideal, then that ideal contains
the ideal spanned by the coefficients of the polynomial. -/
lemma span_le_of_C_coeff_mem (cf : ∀ (i : ℕ), C (f.coeff i) ∈ I) :
  ideal.span {g | ∃ i, g = C (f.coeff i)} ≤ I :=
begin
  simp only [@eq_comm _ _ (C _)] {single_pass := tt},
  exact (ideal.span_le.trans range_subset_iff).mpr cf,
end

lemma mem_span_C_coeff : f ∈ ideal.span {g : R[X] | ∃ i : ℕ, g = C (coeff f i)} :=
begin
  let p := ideal.span {g : R[X] | ∃ i : ℕ, g = C (coeff f i)},
  nth_rewrite 0 (sum_C_mul_X_pow_eq f).symm,
  refine submodule.sum_mem _ (λ n hn, _),
  dsimp,
  have : C (coeff f n) ∈ p, by { apply subset_span, simp },
  have : (monomial n (1 : R)) • C (coeff f n) ∈ p := p.smul_mem _ this,
  convert this using 1,
  simp only [monomial_mul_C, one_mul, smul_eq_mul],
  rw ← C_mul_X_pow_eq_monomial,
end

lemma exists_C_coeff_not_mem : f ∉ I → ∃ i : ℕ, C (coeff f i) ∉ I :=
not.imp_symm $ λ cf, span_le_of_C_coeff_mem (not_exists_not.mp cf) mem_span_C_coeff

end semiring

end polynomial


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.set.finite
import order.atoms

/-!
# Atoms, Coatoms, Simple Lattices, and Finiteness

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

This module contains some results on atoms and simple lattices in the finite context.

## Main results
  * `finite.to_is_atomic`, `finite.to_is_coatomic`: Finite partial orders with bottom resp. top
    are atomic resp. coatomic.

-/

variables {α β : Type*}

namespace is_simple_order
section decidable_eq

/- It is important that `is_simple_order` is the last type-class argument of this instance,
so that type-class inference fails quickly if it doesn't apply. -/
@[priority 200]
instance {α} [decidable_eq α] [has_le α] [bounded_order α] [is_simple_order α] : fintype α :=
fintype.of_equiv bool equiv_bool.symm

end decidable_eq
end is_simple_order

namespace fintype
namespace is_simple_order
variables [partial_order α] [bounded_order α] [is_simple_order α] [decidable_eq α]

lemma univ : (finset.univ : finset α) = {⊤, ⊥} :=
begin
  change finset.map _ (finset.univ : finset bool) = _,
  rw fintype.univ_bool,
  simp only [finset.map_insert, function.embedding.coe_fn_mk, finset.map_singleton],
  refl,
end

lemma card : fintype.card α = 2 :=
(fintype.of_equiv_card _).trans fintype.card_bool

end is_simple_order
end fintype

namespace bool

instance : is_simple_order bool :=
⟨λ a, begin
  rw [← finset.mem_singleton, or.comm, ← finset.mem_insert,
      top_eq_tt, bot_eq_ff, ← fintype.univ_bool],
  apply finset.mem_univ,
end⟩

end bool

section fintype

open finset

@[priority 100]  -- see Note [lower instance priority]
instance finite.to_is_coatomic [partial_order α] [order_top α] [finite α] : is_coatomic α :=
begin
  refine is_coatomic.mk (λ b, or_iff_not_imp_left.2 (λ ht, _)),
  obtain ⟨c, hc, hmax⟩ := set.finite.exists_maximal_wrt id { x : α | b ≤ x ∧ x ≠ ⊤ }
    (set.to_finite _) ⟨b, le_rfl, ht⟩,
  refine ⟨c, ⟨hc.2, λ y hcy, _⟩, hc.1⟩,
  by_contra hyt,
  obtain rfl : c = y := hmax y ⟨hc.1.trans hcy.le, hyt⟩ hcy.le,
  exact (lt_self_iff_false _).mp hcy
end

@[priority 100]  -- see Note [lower instance priority]
instance finite.to_is_atomic [partial_order α] [order_bot α] [finite α] : is_atomic α :=
is_coatomic_dual_iff_is_atomic.mp finite.to_is_coatomic

end fintype


/- LoVe Demo 4: Functional Programming -/

import .lovelib

namespace LoVe

/- Example: Lists -/

def reverse {α : Type} : list α → list α
| []        := []
| (x :: xs) := reverse xs ++ [x]

#check list.reverse

lemma reverse_append {α : Type} :
  ∀xs ys : list α, reverse (xs ++ ys) = reverse ys ++ reverse xs
| []        ys := by simp [reverse]
| (x :: xs) ys := by simp [reverse, reverse_append xs]

lemma reverse_reverse {α : Type} :
  ∀xs : list α, reverse (reverse xs) = xs
| []        := by refl
| (x :: xs) :=
  by simp [reverse, reverse_append, reverse_reverse xs]

def map {α β : Type} (f : α → β) : list α → list β
| []        := []
| (x :: xs) := f x :: map xs

def map₂ {α β : Type} : (α → β) → list α → list β
| _ []        := []
| f (x :: xs) := f x :: map₂ f xs

#check list.map

lemma map_ident {α : Type} :
  ∀xs : list α, map (λx, x) xs = xs
| []        := by refl
| (x :: xs) := by simp [map, map_ident xs]

lemma map_ident₂ {α : Type} :
  ∀xs : list α, map (λx, x) xs = xs
| []        := by refl
| (x :: xs) :=
  have ih : map (λx, x) xs = xs := map_ident₂ xs,
  begin
    rw map,
    rw ih
  end

lemma map_ident₃ {α : Type} :
  ∀xs : list α, xs = map (λx, x) xs
| []        := by refl
| (x :: xs) :=
  have ih : _ := map_ident₃ xs,
  by rw [map, ←ih]

lemma map_comp {α β γ : Type} (f : α → β) (g : β → γ) :
  ∀xs : list α, map (λx, g (f x)) xs = map g (map f xs)
| []        := by refl
| (x :: xs) := by simp [map, map_comp xs]

lemma map_append {α β : Type} (f : α → β) :
  ∀xs ys : list α, map f (xs ++ ys) = map f xs ++ map f ys
| []        ys := by refl
| (x :: xs) ys := by simp [map, map_append xs]

lemma map_reverse {α β : Type} (f : α → β) :
  ∀xs : list α, map f (reverse xs) = reverse (map f xs)
| []        := by refl
| (x :: xs) :=
  by simp [map, reverse, map_append, map_reverse xs]

def length {α : Type} : list α → ℕ
| []        := 0
| (x :: xs) := length xs + 1

#check list.length

def bcount {α : Type} (p : α → bool) : list α → ℕ
| []        := 0
| (x :: xs) :=
  match p x with
  | tt := bcount xs + 1
  | ff := bcount xs
  end

def bfilter {α : Type} (p : α → bool) : list α → list α
| []        := []
| (x :: xs) :=
  match p x with
  | tt := x :: bfilter xs
  | ff := bfilter xs
  end

def nth {α : Type} : list α → ℕ → option α
| []        _       := none
| (x :: _)  0       := some x
| (_ :: xs) (n + 1) := nth xs n

#check list.nth

lemma exists_nth {α : Type} :
  ∀(xs : list α) (n : ℕ), n < length xs → ∃a, nth xs n = some a
| []        _       h :=
  false.elim (not_le_of_gt h (nat.zero_le _))
| (x :: _)  0       _ := ⟨x, rfl⟩
| (_ :: xs) (n + 1) h :=
  have n_lt : n < length xs := lt_of_add_lt_add_right h,
  have ih : ∃a, nth xs n = some a := exists_nth xs n n_lt,
  by simp [nth, ih]

lemma lt_length_of_nth_some {α : Type} (a : α) :
  ∀(xs : list α) (n : ℕ), nth xs n = some a → n < length xs
| []        _       h := by contradiction
| (_ :: xs) 0       _ :=
  show 0 < length xs + 1, from
    lt_add_of_le_of_pos (nat.zero_le _) zero_lt_one
| (_ :: xs) (n + 1) h :=
  have ih : nth xs n = some a,
    by simp [nth] at h; assumption,
  show n + 1 < length xs + 1, from
    add_lt_add_right (lt_length_of_nth_some _ _ ih) 1

def tail {α : Type} (xs : list α) : list α :=
match xs with
| []      := []
| _ :: xs := xs
end

#check list.tail

def head {α : Type} (xs : list α) : option α :=
match xs with
| []     := none
| x :: _ := some x
end

#check list.head

def zip {α β : Type} : list α → list β → list (α × β)
| (x :: xs) (y :: ys) := (x, y) :: zip xs ys
| []        _         := []
| (_ :: _)  []        := []

#check list.zip

lemma map_zip {α α' β β' : Type} (f : α → α') (g : β → β') :
  ∀xs ys, map (λp : α × β, (f p.1, g p.2)) (zip xs ys) =
    zip (map f xs) (map g ys)
| (x :: xs) (y :: ys) :=
  begin
    simp [zip, map],
    exact (map_zip _ _)
  end
| []        _         := by refl
| (_ :: _)  []        := by refl

lemma min_add_add (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
have l + m ≤ l + n ↔ m ≤ n :=
begin
  rw add_comm l,
  rw add_comm l,
  apply nat.add_le_add_iff_le_right
end,
by by_cases m ≤ n; simp [min, *]

lemma length_zip {α β : Type} :
  ∀(xs : list α) (ys : list β),
    length (zip xs ys) = min (length xs) (length ys)
| (x :: xs) (y :: ys) :=
  by simp [zip, length, length_zip xs ys, min_add_add]
| []        _         := by refl
| (_ :: _)  []        := by refl

lemma injection_example {α : Type} (x y : α) (xs ys : list α)
    (h : list.cons x xs = list.cons y ys) :
  x = y ∧ xs = ys :=
begin
  cases h,
  apply and.intro,
  { refl },
  { refl }
end

lemma distinctness_example {α : Type} (x y : α) (xs ys : list α)
    (h : [] = y :: ys) :
  false :=
by cases h

/- Example: Binary Trees -/

inductive btree (α : Type) : Type
| empty {} : btree
| node     : α → btree → btree → btree

export btree (empty node)

def t0 : btree ℕ := node 0 empty empty
def t1 : btree ℕ := node 1 empty empty
def t2 : btree ℕ := node 2 t0 t1

def mirror {α : Type} : btree α → btree α
| empty        := empty
| (node a l r) := node a (mirror r) (mirror l)

lemma mirror_eq_empty_iff {α : Type} :
  ∀t : btree α, mirror t = empty ↔ t = empty
| empty        := by refl
| (node _ _ _) := by simp [mirror]

lemma mirror_mirror {α : Type} :
  ∀t : btree α, mirror (mirror t) = t
| empty        := by refl
| (node a l r) :=
  begin
    simp [mirror],
    apply and.intro,
    { apply mirror_mirror l },
    { apply mirror_mirror r }
  end

/- Example: Colors -/

structure rgb :=
(red green blue : ℕ)

structure rgba extends rgb :=
(alpha : ℕ)

#print rgb
#print rgba

#reduce rgb.mk 0xff 0xcc 0xff
#reduce ({red := 0xff, green := 0xcc, blue := 0xff} : rgb)
#reduce ({red := 0xff, green := 0xcc, blue := 0xff,
  alpha := 0x7f} : rgba)

def red : rgb := {red := 0xff, green := 0x00, blue := 0x00}
def semitransparent_red : rgba := {alpha := 0x7f, ..red}
def green : rgb := ⟨0x00, 0xff, 0x00⟩

#print red
#print semitransparent_red
#print green

def shuffle (c : rgb) : rgb :=
{red := c.green, green := c.blue, blue := c.red}

lemma shuffle_shuffle_shuffle (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
by cases c; refl

end LoVe


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Type class hierarchy for Boolean algebras.
-/
import order.bounded_lattice
set_option old_structure_cmd true

namespace lattice
universes u
variables {α : Type u} {w x y z : α}

/-- A boolean algebra is a bounded distributive lattice with a
  complementation operation `-` such that `x ⊓ - x = ⊥` and `x ⊔ - x = ⊤`.
  This is a generalization of (classical) logic of propositions, or
  the powerset lattice. -/
class boolean_algebra α extends bounded_distrib_lattice α, has_neg α, has_sub α :=
(inf_neg_eq_bot : ∀x:α, x ⊓ - x = ⊥)
(sup_neg_eq_top : ∀x:α, x ⊔ - x = ⊤)
(sub_eq : ∀x y:α, x - y = x ⊓ - y)

section boolean_algebra
variables [boolean_algebra α]

@[simp] theorem inf_neg_eq_bot : x ⊓ - x = ⊥ :=
boolean_algebra.inf_neg_eq_bot x

@[simp] theorem neg_inf_eq_bot : - x ⊓ x = ⊥ :=
eq.trans inf_comm inf_neg_eq_bot

@[simp] theorem sup_neg_eq_top : x ⊔ - x = ⊤ :=
boolean_algebra.sup_neg_eq_top x

@[simp] theorem neg_sup_eq_top : - x ⊔ x = ⊤ :=
eq.trans sup_comm sup_neg_eq_top

theorem sub_eq : x - y = x ⊓ - y :=
boolean_algebra.sub_eq x y

theorem neg_unique (i : x ⊓ y = ⊥) (s : x ⊔ y = ⊤) : - x = y :=
calc -x = -x ⊓ (x ⊔ y)    : by simp [s]
    ... = -x ⊓ x ⊔ -x ⊓ y : inf_sup_left
    ... = y ⊓ x ⊔ y ⊓ -x  : by simp [i, inf_comm]
    ... = y ⊓ (x ⊔ -x)    : inf_sup_left.symm
    ... = y               : by simp

@[simp] theorem neg_top : - ⊤ = (⊥:α) :=
neg_unique (by simp) (by simp)

@[simp] theorem neg_bot : - ⊥ = (⊤:α) :=
neg_unique (by simp) (by simp)

@[simp] theorem neg_neg : - (- x) = x :=
neg_unique (by simp) (by simp)

theorem neg_eq_neg_of_eq (h : - x = - y) : x = y :=
have - - x = - - y,
  from congr_arg has_neg.neg h,
by simp [neg_neg] at this; assumption

@[simp] theorem neg_eq_neg_iff : - x = - y ↔ x = y :=
⟨neg_eq_neg_of_eq, congr_arg has_neg.neg⟩

@[simp] theorem neg_inf : - (x ⊓ y) = -x ⊔ -y :=
neg_unique -- TODO: try rsimp if it supports custom lemmas
  (calc (x ⊓ y) ⊓ (- x ⊔ - y) = (y ⊓ (x ⊓ - x)) ⊔ (x ⊓ (y ⊓ - y)) : by rw [inf_sup_left]; ac_refl
                          ... = ⊥ : by simp)
  (calc (x ⊓ y) ⊔ (- x ⊔ - y) = (- y ⊔ (x ⊔ - x)) ⊓ (- x ⊔ (y ⊔ - y)) : by rw [sup_inf_right]; ac_refl
                          ... = ⊤ : by simp)

@[simp] theorem neg_sup : - (x ⊔ y) = -x ⊓ -y :=
begin [smt] eblast_using [neg_neg, neg_inf] end

theorem neg_le_neg (h : y ≤ x) : - x ≤ - y :=
le_of_inf_eq $
  calc -x ⊓ -y = - (x ⊔ y) : neg_sup.symm
           ... = -x        : congr_arg has_neg.neg $ sup_of_le_left h

theorem neg_le_neg_iff_le : - y ≤ - x ↔ x ≤ y :=
⟨assume h, by have h := neg_le_neg h; simp at h; assumption,
  neg_le_neg⟩

theorem le_neg_of_le_neg (h : y ≤ - x) : x ≤ - y :=
have - (- x) ≤ - y, from neg_le_neg h,
by simp at this; assumption

theorem neg_le_of_neg_le (h : - y ≤ x) : - x ≤ y :=
have - x ≤ - (- y), from neg_le_neg h,
by simp at this; assumption

theorem neg_le_iff_neg_le : y ≤ - x ↔ x ≤ - y :=
⟨le_neg_of_le_neg, le_neg_of_le_neg⟩

theorem sup_sub_same : x ⊔ (y - x) = x ⊔ y :=
by simp [sub_eq, sup_inf_left]

theorem sub_eq_left (h : x ⊓ y = ⊥) : x - y = x :=
calc x - y = (x ⊓ -y) ⊔ (x ⊓ y) : by simp [h, sub_eq]
  ... = (-y ⊓ x) ⊔ (y ⊓ x) : by simp [inf_comm]
  ... = (-y ⊔ y) ⊓ x : inf_sup_right.symm
  ... = x : by simp

theorem sub_le_sub (h₁ : w ≤ y) (h₂ : z ≤ x) : w - x ≤ y - z :=
by rw [sub_eq, sub_eq]; from inf_le_inf h₁ (neg_le_neg h₂)

end boolean_algebra

end lattice


/-
Copyright (c) 2020 Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jalex Stark, Scott Morrison, Eric Wieser, Oliver Nash

! This file was ported from Lean 3 source module data.matrix.basis
! leanprover-community/mathlib commit 320df450e9abeb5fc6417971e75acb6ae8bc3794
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Matrix.Basic
import Mathbin.LinearAlgebra.Matrix.Trace

/-!
# Matrices with a single non-zero element.

This file provides `matrix.std_basis_matrix`. The matrix `matrix.std_basis_matrix i j c` has `c`
at position `(i, j)`, and zeroes elsewhere.
-/

variable {l m n : Type _}

variable {R α : Type _}

namespace Matrix

open Matrix

open BigOperators

variable [DecidableEq l] [DecidableEq m] [DecidableEq n]

variable [Semiring α]

/-- `std_basis_matrix i j a` is the matrix with `a` in the `i`-th row, `j`-th column,
and zeroes elsewhere.
-/
def stdBasisMatrix (i : m) (j : n) (a : α) : Matrix m n α := fun i' j' =>
  if i = i' ∧ j = j' then a else 0
#align matrix.std_basis_matrix Matrix.stdBasisMatrix

@[simp]
theorem smul_stdBasisMatrix (i : m) (j : n) (a b : α) :
    b • stdBasisMatrix i j a = stdBasisMatrix i j (b • a) :=
  by
  unfold std_basis_matrix
  ext
  simp
#align matrix.smul_std_basis_matrix Matrix.smul_stdBasisMatrix

@[simp]
theorem stdBasisMatrix_zero (i : m) (j : n) : stdBasisMatrix i j (0 : α) = 0 :=
  by
  unfold std_basis_matrix
  ext
  simp
#align matrix.std_basis_matrix_zero Matrix.stdBasisMatrix_zero

theorem stdBasisMatrix_add (i : m) (j : n) (a b : α) :
    stdBasisMatrix i j (a + b) = stdBasisMatrix i j a + stdBasisMatrix i j b :=
  by
  unfold std_basis_matrix; ext
  split_ifs with h <;> simp [h]
#align matrix.std_basis_matrix_add Matrix.stdBasisMatrix_add

theorem matrix_eq_sum_std_basis [Fintype m] [Fintype n] (x : Matrix m n α) :
    x = ∑ (i : m) (j : n), stdBasisMatrix i j (x i j) :=
  by
  ext; symm
  iterate 2 rw [Finset.sum_apply]
  convert Fintype.sum_eq_single i _
  · simp [std_basis_matrix]
  · intro j hj
    simp [std_basis_matrix, hj]
#align matrix.matrix_eq_sum_std_basis Matrix.matrix_eq_sum_std_basis

-- TODO: tie this up with the `basis` machinery of linear algebra
-- this is not completely trivial because we are indexing by two types, instead of one
-- TODO: add `std_basis_vec`
theorem std_basis_eq_basis_mul_basis (i : m) (j : n) :
    stdBasisMatrix i j 1 = vecMulVec (fun i' => ite (i = i') 1 0) fun j' => ite (j = j') 1 0 :=
  by
  ext
  norm_num [std_basis_matrix, vec_mul_vec]
  exact ite_and _ _ _ _
#align matrix.std_basis_eq_basis_mul_basis Matrix.std_basis_eq_basis_mul_basis

-- todo: the old proof used fintypes, I don't know `finsupp` but this feels generalizable
@[elab_as_elim]
protected theorem induction_on' [Fintype m] [Fintype n] {P : Matrix m n α → Prop} (M : Matrix m n α)
    (h_zero : P 0) (h_add : ∀ p q, P p → P q → P (p + q))
    (h_std_basis : ∀ (i : m) (j : n) (x : α), P (stdBasisMatrix i j x)) : P M :=
  by
  rw [matrix_eq_sum_std_basis M, ← Finset.sum_product']
  apply Finset.sum_induction _ _ h_add h_zero
  · intros
    apply h_std_basis
#align matrix.induction_on' Matrix.induction_on'

@[elab_as_elim]
protected theorem induction_on [Fintype m] [Fintype n] [Nonempty m] [Nonempty n]
    {P : Matrix m n α → Prop} (M : Matrix m n α) (h_add : ∀ p q, P p → P q → P (p + q))
    (h_std_basis : ∀ i j x, P (stdBasisMatrix i j x)) : P M :=
  Matrix.induction_on' M
    (by
      inhabit m
      inhabit n
      simpa using h_std_basis default default 0)
    h_add h_std_basis
#align matrix.induction_on Matrix.induction_on

namespace StdBasisMatrix

section

variable (i : m) (j : n) (c : α) (i' : m) (j' : n)

@[simp]
theorem apply_same : stdBasisMatrix i j c i j = c :=
  if_pos (And.intro rfl rfl)
#align matrix.std_basis_matrix.apply_same Matrix.stdBasisMatrix.apply_same

@[simp]
theorem apply_of_ne (h : ¬(i = i' ∧ j = j')) : stdBasisMatrix i j c i' j' = 0 :=
  by
  simp only [std_basis_matrix, and_imp, ite_eq_right_iff]
  tauto
#align matrix.std_basis_matrix.apply_of_ne Matrix.stdBasisMatrix.apply_of_ne

@[simp]
theorem apply_of_row_ne {i i' : m} (hi : i ≠ i') (j j' : n) (a : α) :
    stdBasisMatrix i j a i' j' = 0 := by simp [hi]
#align matrix.std_basis_matrix.apply_of_row_ne Matrix.stdBasisMatrix.apply_of_row_ne

@[simp]
theorem apply_of_col_ne (i i' : m) {j j' : n} (hj : j ≠ j') (a : α) :
    stdBasisMatrix i j a i' j' = 0 := by simp [hj]
#align matrix.std_basis_matrix.apply_of_col_ne Matrix.stdBasisMatrix.apply_of_col_ne

end

section

variable (i j : n) (c : α) (i' j' : n)

@[simp]
theorem diag_zero (h : j ≠ i) : diag (stdBasisMatrix i j c) = 0 :=
  funext fun k => if_neg fun ⟨e₁, e₂⟩ => h (e₂.trans e₁.symm)
#align matrix.std_basis_matrix.diag_zero Matrix.stdBasisMatrix.diag_zero

@[simp]
theorem diag_same : diag (stdBasisMatrix i i c) = Pi.single i c :=
  by
  ext j
  by_cases hij : i = j <;> try rw [hij] <;> simp [hij]
#align matrix.std_basis_matrix.diag_same Matrix.stdBasisMatrix.diag_same

variable [Fintype n]

@[simp]
theorem trace_zero (h : j ≠ i) : trace (stdBasisMatrix i j c) = 0 := by simp [trace, h]
#align matrix.std_basis_matrix.trace_zero Matrix.stdBasisMatrix.trace_zero

@[simp]
theorem trace_eq : trace (stdBasisMatrix i i c) = c := by simp [trace]
#align matrix.std_basis_matrix.trace_eq Matrix.stdBasisMatrix.trace_eq

@[simp]
theorem mul_left_apply_same (b : n) (M : Matrix n n α) :
    (stdBasisMatrix i j c ⬝ M) i b = c * M j b := by simp [mul_apply, std_basis_matrix]
#align matrix.std_basis_matrix.mul_left_apply_same Matrix.stdBasisMatrix.mul_left_apply_same

@[simp]
theorem mul_right_apply_same (a : n) (M : Matrix n n α) :
    (M ⬝ stdBasisMatrix i j c) a j = M a i * c := by simp [mul_apply, std_basis_matrix, mul_comm]
#align matrix.std_basis_matrix.mul_right_apply_same Matrix.stdBasisMatrix.mul_right_apply_same

@[simp]
theorem mul_left_apply_of_ne (a b : n) (h : a ≠ i) (M : Matrix n n α) :
    (stdBasisMatrix i j c ⬝ M) a b = 0 := by simp [mul_apply, h.symm]
#align matrix.std_basis_matrix.mul_left_apply_of_ne Matrix.stdBasisMatrix.mul_left_apply_of_ne

@[simp]
theorem mul_right_apply_of_ne (a b : n) (hbj : b ≠ j) (M : Matrix n n α) :
    (M ⬝ stdBasisMatrix i j c) a b = 0 := by simp [mul_apply, hbj.symm]
#align matrix.std_basis_matrix.mul_right_apply_of_ne Matrix.stdBasisMatrix.mul_right_apply_of_ne

@[simp]
theorem mul_same (k : n) (d : α) :
    stdBasisMatrix i j c ⬝ stdBasisMatrix j k d = stdBasisMatrix i k (c * d) :=
  by
  ext (a b)
  simp only [mul_apply, std_basis_matrix, boole_mul]
  by_cases h₁ : i = a <;> by_cases h₂ : k = b <;> simp [h₁, h₂]
#align matrix.std_basis_matrix.mul_same Matrix.stdBasisMatrix.mul_same

@[simp]
theorem mul_of_ne {k l : n} (h : j ≠ k) (d : α) : stdBasisMatrix i j c ⬝ stdBasisMatrix k l d = 0 :=
  by
  ext (a b)
  simp only [mul_apply, boole_mul, std_basis_matrix]
  by_cases h₁ : i = a <;> simp [h₁, h, h.symm]
#align matrix.std_basis_matrix.mul_of_ne Matrix.stdBasisMatrix.mul_of_ne

end

end StdBasisMatrix

end Matrix


import algebra.ordered_group

section
variables {G : Type*} [ordered_add_comm_group G] (a b c d : G)

lemma sub_lt_sub_iff_add_lt_add : a - b < c - d ↔ a + d < c + b :=
calc a - b < c - d ↔ a - b + b + d < c - d + b + d : by rw [← add_lt_add_iff_right b, ← add_lt_add_iff_right d]
               ... ↔ a + d < c + b                 : by rw [sub_add_cancel, add_right_comm, sub_add_cancel]

end


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import analysis.normed_space.exponential

/-! # The exponential map from selfadjoint to unitary
In this file, we establish various propreties related to the map `λ a, exp ℂ A (I • a)` between the
subtypes `self_adjoint A` and `unitary A`.

## TODO

* Show that any exponential unitary is path-connected in `unitary A` to `1 : unitary A`.
* Prove any unitary whose distance to `1 : unitary A` is less than `1` can be expressed as an
  exponential unitary.
* A unitary is in the path component of `1` if and only if it is a finite product of exponential
  unitaries.
-/

section star

variables {A : Type*}
[normed_ring A] [normed_algebra ℂ A] [star_ring A] [has_continuous_star A] [complete_space A]
[star_module ℂ A]

open complex

/-- The map from the selfadjoint real subspace to the unitary group. This map only makes sense
over ℂ. -/
@[simps]
noncomputable def self_adjoint.exp_unitary (a : self_adjoint A) : unitary A :=
⟨exp ℂ (I • a), exp_mem_unitary_of_mem_skew_adjoint _ (a.prop.smul_mem_skew_adjoint conj_I)⟩

open self_adjoint

lemma commute.exp_unitary_add {a b : self_adjoint A} (h : commute (a : A) (b : A)) :
  exp_unitary (a + b) = exp_unitary a * exp_unitary b :=
begin
  ext,
  have hcomm : commute (I • (a : A)) (I • (b : A)),
  calc _ = _ : by simp only [h.eq, algebra.smul_mul_assoc, algebra.mul_smul_comm],
  simpa only [exp_unitary_coe, add_subgroup.coe_add, smul_add] using exp_add_of_commute hcomm,
end

lemma commute.exp_unitary {a b : self_adjoint A} (h : commute (a : A) (b : A)) :
  commute (exp_unitary a) (exp_unitary b) :=
calc (exp_unitary a) * (exp_unitary b) = (exp_unitary b) * (exp_unitary a)
  : by rw [←h.exp_unitary_add, ←h.symm.exp_unitary_add, add_comm]

end star


/-
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.unit_interval
import topology.algebra.ordered.proj_Icc
import topology.continuous_function.basic
import topology.compact_open

/-!
# Homotopy between functions

In this file, we define a homotopy between two functions `f₀` and `f₁`. First we define `homotopy`
between the two functions, with no restrictions on the intermediate maps. Then, as in the
formalisation in HOL-Analysis, we define `homotopy_with f₀ f₁ P`, for homotopies between `f₀` and
`f₁`, where the intermediate maps satisfy the predicate `P`. Finally, we define
`homotopy_rel f₀ f₁ S`, for homotopies between `f₀` and `f₁` which are fixed on `S`.

## Definitions

* `homotopy f₀ f₁` is the type of homotopies between `f₀` and `f₁`.
* `homotopy_with f₀ f₁ P` is the type of homotopies between `f₀` and `f₁`, where the intermediate
  maps satisfy the predicate `P`.
* `homotopy_rel f₀ f₁ S` is the type of homotopies between `f₀` and `f₁` which are fixed on `S`.

For each of the above, we have

* `refl f`, which is the constant homotopy from `f` to `f`.
* `symm F`, which reverses the homotopy `F`. For example, if `F : homotopy f₀ f₁`, then
  `F.symm : homotopy f₁ f₀`.
* `trans F G`, which concatenates the homotopies `F` and `G`. For example, if `F : homotopy f₀ f₁`
  and `G : homotopy f₁ f₂`, then `F.trans G : homotopy f₀ f₂`.

We also define the relations

* `homotopic f₀ f₁` is defined to be `nonempty (homotopy f₀ f₁)`
* `homotopic_with f₀ f₁ P` is defined to be `nonempty (homotopy_with f₀ f₁ P)`
* `homotopic_rel f₀ f₁ P` is defined to be `nonempty (homotopy_rel f₀ f₁ P)`

and for `homotopic` and `homotopic_rel`, we also define the `setoid` and `quotient` in `C(X, Y)` by
these relations.

## References

- [HOL-Analysis formalisation](https://isabelle.in.tum.de/library/HOL/HOL-Analysis/Homotopy.html)
-/

noncomputable theory

universes u v w

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

open_locale unit_interval

namespace continuous_map

/--
The type of homotopies between two functions.
-/
structure homotopy (f₀ f₁ : C(X, Y)) extends C(I × X, Y) :=
(to_fun_zero : ∀ x, to_fun (0, x) = f₀ x)
(to_fun_one : ∀ x, to_fun (1, x) = f₁ x)

namespace homotopy

section

variables {f₀ f₁ : C(X, Y)}

instance : has_coe_to_fun (homotopy f₀ f₁) (λ _, I × X → Y) := ⟨λ F, F.to_fun⟩

lemma coe_fn_injective : @function.injective (homotopy f₀ f₁) (I × X → Y) coe_fn :=
begin
  rintros ⟨⟨F, _⟩, _⟩ ⟨⟨G, _⟩, _⟩ h,
  congr' 2,
end

@[ext]
lemma ext {F G : homotopy f₀ f₁} (h : ∀ x, F x = G x) : F = G :=
coe_fn_injective $ funext 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.apply (F : homotopy f₀ f₁) : I × X → Y := F

initialize_simps_projections homotopy (to_continuous_map_to_fun -> apply, -to_continuous_map)

@[continuity]
protected lemma continuous (F : homotopy f₀ f₁) : continuous F := F.continuous_to_fun

@[simp]
lemma apply_zero (F : homotopy f₀ f₁) (x : X) : F (0, x) = f₀ x := F.to_fun_zero x

@[simp]
lemma apply_one (F : homotopy f₀ f₁) (x : X) : F (1, x) = f₁ x := F.to_fun_one x

@[simp]
lemma coe_to_continuous_map (F : homotopy f₀ f₁) : ⇑F.to_continuous_map = F := rfl

/--
Currying a homotopy to a continuous function fron `I` to `C(X, Y)`.
-/
def curry (F : homotopy f₀ f₁) : C(I, C(X, Y)) := F.to_continuous_map.curry

@[simp]
lemma curry_apply (F : homotopy f₀ f₁) (t : I) (x : X) : F.curry t x = F (t, x) := rfl

/--
Continuously extending a curried homotopy to a function from `ℝ` to `C(X, Y)`.
-/
def extend (F : homotopy f₀ f₁) : C(ℝ, C(X, Y)) := F.curry.Icc_extend zero_le_one

lemma extend_apply_of_le_zero (F : homotopy f₀ f₁) {t : ℝ} (ht : t ≤ 0) (x : X) :
  F.extend t x = f₀ x :=
begin
  rw [←F.apply_zero],
  exact continuous_map.congr_fun (set.Icc_extend_of_le_left (@zero_le_one ℝ _) F.curry ht) x,
end

lemma extend_apply_of_one_le (F : homotopy f₀ f₁) {t : ℝ} (ht : 1 ≤ t) (x : X) :
  F.extend t x = f₁ x :=
begin
  rw [←F.apply_one],
  exact continuous_map.congr_fun (set.Icc_extend_of_right_le (@zero_le_one ℝ _) F.curry ht) x,
end

@[simp]
lemma extend_apply_coe (F : homotopy f₀ f₁) (t : I) (x : X) : F.extend t x = F (t, x) :=
continuous_map.congr_fun (set.Icc_extend_coe (@zero_le_one ℝ _) F.curry t) x

@[simp]
lemma extend_apply_of_mem_I (F : homotopy f₀ f₁) {t : ℝ} (ht : t ∈ I) (x : X) :
  F.extend t x = F (⟨t, ht⟩, x) :=
continuous_map.congr_fun (set.Icc_extend_of_mem (@zero_le_one ℝ _) F.curry ht) x

lemma congr_fun {F G : homotopy f₀ f₁} (h : F = G) (x : I × X) : F x = G x :=
continuous_map.congr_fun (congr_arg _ h) x

lemma congr_arg (F : homotopy f₀ f₁) {x y : I × X} (h : x = y) : F x = F y :=
F.to_continuous_map.congr_arg h

end

/--
Given a continuous function `f`, we can define a `homotopy f f` by `F (t, x) = f x`
-/
@[simps]
def refl (f : C(X, Y)) : homotopy f f :=
{ to_fun := λ x, f x.2,
  to_fun_zero := λ _, rfl,
  to_fun_one := λ _, rfl }

instance : inhabited (homotopy (continuous_map.id : C(X, X)) continuous_map.id) :=
⟨homotopy.refl continuous_map.id⟩

/--
Given a `homotopy f₀ f₁`, we can define a `homotopy f₁ f₀` by reversing the homotopy.
-/
@[simps]
def symm {f₀ f₁ : C(X, Y)} (F : homotopy f₀ f₁) : homotopy f₁ f₀ :=
{ to_fun := λ x, F (σ x.1, x.2),
  to_fun_zero := by norm_num,
  to_fun_one := by norm_num }

@[simp]
lemma symm_symm {f₀ f₁ : C(X, Y)} (F : homotopy f₀ f₁) : F.symm.symm = F :=
by { ext, simp }

/--
Given `homotopy f₀ f₁` and `homotopy f₁ f₂`, we can define a `homotopy f₀ f₂` by putting the first
homotopy on `[0, 1/2]` and the second on `[1/2, 1]`.
-/
def trans {f₀ f₁ f₂ : C(X, Y)} (F : homotopy f₀ f₁) (G : homotopy f₁ f₂) :
  homotopy f₀ f₂ :=
{ to_fun := λ x, if (x.1 : ℝ) ≤ 1/2 then F.extend (2 * x.1) x.2 else G.extend (2 * x.1 - 1) x.2,
  continuous_to_fun := begin
    refine continuous_if_le (continuous_induced_dom.comp continuous_fst) continuous_const
      (F.continuous.comp (by continuity)).continuous_on
      (G.continuous.comp (by continuity)).continuous_on _,
    rintros x hx,
    norm_num [hx],
  end,
  to_fun_zero := λ x, by norm_num,
  to_fun_one := λ x, by norm_num }

lemma trans_apply {f₀ f₁ f₂ : C(X, Y)} (F : homotopy f₀ f₁) (G : homotopy f₁ f₂)
  (x : I × X) : (F.trans G) x =
  if h : (x.1 : ℝ) ≤ 1/2 then
    F (⟨2 * x.1, (unit_interval.mul_pos_mem_iff zero_lt_two).2 ⟨x.1.2.1, h⟩⟩, x.2)
  else
    G (⟨2 * x.1 - 1, unit_interval.two_mul_sub_one_mem_iff.2 ⟨(not_le.1 h).le, x.1.2.2⟩⟩, x.2) :=
show ite _ _ _ = _,
by split_ifs; { rw [extend, continuous_map.coe_Icc_extend, set.Icc_extend_of_mem], refl }

lemma symm_trans {f₀ f₁ f₂ : C(X, Y)} (F : homotopy f₀ f₁) (G : homotopy f₁ f₂) :
  (F.trans G).symm = G.symm.trans F.symm :=
begin
  ext x,
  simp only [symm_apply, trans_apply],
  split_ifs with h₁ h₂,
  { change (x.1 : ℝ) ≤ _ at h₂,
    change (1 : ℝ) - x.1 ≤ _ at h₁,
    have ht : (x.1 : ℝ) = 1/2,
    { linarith },
    norm_num [ht] },
  { congr' 2,
    apply subtype.ext,
    simp only [unit_interval.coe_symm_eq, subtype.coe_mk],
    linarith },
  { congr' 2,
    apply subtype.ext,
    simp only [unit_interval.coe_symm_eq, subtype.coe_mk],
    linarith },
  { change ¬ (x.1 : ℝ) ≤ _ at h,
    change ¬ (1 : ℝ) - x.1 ≤ _ at h₁,
    exfalso, linarith }
end

/--
Casting a `homotopy f₀ f₁` to a `homotopy g₀ g₁` where `f₀ = g₀` and `f₁ = g₁`.
-/
@[simps]
def cast {f₀ f₁ g₀ g₁ : C(X, Y)} (F : homotopy f₀ f₁) (h₀ : f₀ = g₀) (h₁ : f₁ = g₁) :
  homotopy g₀ g₁ :=
{ to_fun := F,
  to_fun_zero := by simp [←h₀],
  to_fun_one := by simp [←h₁] }

/--
If we have a `homotopy f₀ f₁` and a `homotopy g₀ g₁`, then we can compose them and get a
`homotopy (g₀.comp f₀) (g₁.comp f₁)`.
-/
@[simps]
def hcomp {f₀ f₁ : C(X, Y)} {g₀ g₁ : C(Y, Z)} (F : homotopy f₀ f₁) (G : homotopy g₀ g₁) :
  homotopy (g₀.comp f₀) (g₁.comp f₁) :=
{ to_fun := λ x, G (x.1, F x),
  to_fun_zero := by simp,
  to_fun_one := by simp }

end homotopy

/--
Given continuous maps `f₀` and `f₁`, we say `f₀` and `f₁` are homotopic if there exists a
`homotopy f₀ f₁`.
-/
def homotopic (f₀ f₁ : C(X, Y)) : Prop :=
nonempty (homotopy f₀ f₁)

namespace homotopic

@[refl]
lemma refl (f : C(X, Y)) : homotopic f f := ⟨homotopy.refl f⟩

@[symm]
lemma symm ⦃f g : C(X, Y)⦄ (h : homotopic f g) : homotopic g f := h.map homotopy.symm

@[trans]

lemma hcomp {f₀ f₁ : C(X, Y)} {g₀ g₁ : C(Y, Z)} (h₀ : homotopic f₀ f₁) (h₁ : homotopic g₀ g₁) :
  homotopic (g₀.comp f₀) (g₁.comp f₁) :=
h₀.map2 homotopy.hcomp h₁

lemma equivalence : equivalence (@homotopic X Y _ _) := ⟨refl, symm, trans⟩

end homotopic

/--
The type of homotopies between `f₀ f₁ : C(X, Y)`, where the intermediate maps satisfy the predicate
`P : C(X, Y) → Prop`
-/
structure homotopy_with (f₀ f₁ : C(X, Y)) (P : C(X, Y) → Prop) extends homotopy f₀ f₁ :=
(prop' : ∀ t, P ⟨λ x, to_fun (t, x),
  continuous.comp continuous_to_fun (continuous_const.prod_mk continuous_id')⟩)

namespace homotopy_with

section

variables {f₀ f₁ : C(X, Y)} {P : C(X, Y) → Prop}

instance : has_coe_to_fun (homotopy_with f₀ f₁ P) (λ _, I × X → Y) := ⟨λ F, F.to_fun⟩

lemma coe_fn_injective : @function.injective (homotopy_with f₀ f₁ P) (I × X → Y) coe_fn :=
begin
  rintros ⟨⟨⟨F, _⟩, _⟩, _⟩ ⟨⟨⟨G, _⟩, _⟩, _⟩ h,
  congr' 3,
end

@[ext]
lemma ext {F G : homotopy_with f₀ f₁ P} (h : ∀ x, F x = G x) : F = G :=
coe_fn_injective $ funext 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.apply (F : homotopy_with f₀ f₁ P) : I × X → Y := F

initialize_simps_projections homotopy_with
  (to_homotopy_to_continuous_map_to_fun -> apply, -to_homotopy_to_continuous_map)

@[continuity]
protected lemma continuous (F : homotopy_with f₀ f₁ P) : continuous F := F.continuous_to_fun

@[simp]
lemma apply_zero (F : homotopy_with f₀ f₁ P) (x : X) : F (0, x) = f₀ x := F.to_fun_zero x

@[simp]
lemma apply_one (F : homotopy_with f₀ f₁ P) (x : X) : F (1, x) = f₁ x := F.to_fun_one x

@[simp]
lemma coe_to_continuous_map (F : homotopy_with f₀ f₁ P) : ⇑F.to_continuous_map = F := rfl

@[simp]
lemma coe_to_homotopy (F : homotopy_with f₀ f₁ P) : ⇑F.to_homotopy = F := rfl

lemma prop (F : homotopy_with f₀ f₁ P) (t : I) : P (F.to_homotopy.curry t) := F.prop' t

lemma extend_prop (F : homotopy_with f₀ f₁ P) (t : ℝ) : P (F.to_homotopy.extend t) :=
begin
  by_cases ht₀ : 0 ≤ t,
  { by_cases ht₁ : t ≤ 1,
    { convert F.prop ⟨t, ht₀, ht₁⟩,
      ext,
      rw [F.to_homotopy.extend_apply_of_mem_I ⟨ht₀, ht₁⟩, F.to_homotopy.curry_apply] },
    { convert F.prop 1,
      ext,
      rw [F.to_homotopy.extend_apply_of_one_le (le_of_not_le ht₁), F.to_homotopy.curry_apply,
          F.to_homotopy.apply_one] } },
  { convert F.prop 0,
    ext,
    rw [F.to_homotopy.extend_apply_of_le_zero (le_of_not_le ht₀), F.to_homotopy.curry_apply,
        F.to_homotopy.apply_zero] }
end

end

variable {P : C(X, Y) → Prop}

/--
Given a continuous function `f`, and a proof `h : P f`, we can define a `homotopy_with f f P` by
`F (t, x) = f x`
-/
@[simps]
def refl (f : C(X, Y)) (hf : P f) : homotopy_with f f P :=
{ prop' := λ t, by { convert hf, cases f, refl },
  ..homotopy.refl f }

instance : inhabited (homotopy_with (continuous_map.id : C(X, X)) continuous_map.id (λ f, true)) :=
⟨homotopy_with.refl _ trivial⟩

/--
Given a `homotopy_with f₀ f₁ P`, we can define a `homotopy_with f₁ f₀ P` by reversing the homotopy.
-/
@[simps]
def symm {f₀ f₁ : C(X, Y)} (F : homotopy_with f₀ f₁ P) : homotopy_with f₁ f₀ P :=
{ prop' := λ t, by simpa using F.prop (σ t),
  ..F.to_homotopy.symm }

@[simp]
lemma symm_symm {f₀ f₁ : C(X, Y)} (F : homotopy_with f₀ f₁ P) : F.symm.symm = F :=
ext $ homotopy.congr_fun $ homotopy.symm_symm _

/--
Given `homotopy_with f₀ f₁ P` and `homotopy_with f₁ f₂ P`, we can define a `homotopy_with f₀ f₂ P`
by putting the first homotopy on `[0, 1/2]` and the second on `[1/2, 1]`.
-/
def trans {f₀ f₁ f₂ : C(X, Y)} (F : homotopy_with f₀ f₁ P) (G : homotopy_with f₁ f₂ P) :
  homotopy_with f₀ f₂ P :=
{ prop' := λ t, begin
    simp only [homotopy.trans],
    change P ⟨λ _, ite ((t : ℝ) ≤ _) _ _, _⟩,
    split_ifs,
    { exact F.extend_prop _ },
    { exact G.extend_prop _ }
  end,
  ..F.to_homotopy.trans G.to_homotopy }

lemma trans_apply {f₀ f₁ f₂ : C(X, Y)} (F : homotopy_with f₀ f₁ P) (G : homotopy_with f₁ f₂ P)
  (x : I × X) : (F.trans G) x =
  if h : (x.1 : ℝ) ≤ 1/2 then
    F (⟨2 * x.1, (unit_interval.mul_pos_mem_iff zero_lt_two).2 ⟨x.1.2.1, h⟩⟩, x.2)
  else
    G (⟨2 * x.1 - 1, unit_interval.two_mul_sub_one_mem_iff.2 ⟨(not_le.1 h).le, x.1.2.2⟩⟩, x.2) :=
homotopy.trans_apply _ _ _

lemma symm_trans {f₀ f₁ f₂ : C(X, Y)} (F : homotopy_with f₀ f₁ P) (G : homotopy_with f₁ f₂ P) :
  (F.trans G).symm = G.symm.trans F.symm :=
ext $ homotopy.congr_fun $ homotopy.symm_trans _ _

/--
Casting a `homotopy_with f₀ f₁ P` to a `homotopy_with g₀ g₁ P` where `f₀ = g₀` and `f₁ = g₁`.
-/
@[simps]
def cast {f₀ f₁ g₀ g₁ : C(X, Y)} (F : homotopy_with f₀ f₁ P) (h₀ : f₀ = g₀) (h₁ : f₁ = g₁) :
  homotopy_with g₀ g₁ P :=
{ prop' := F.prop,
  ..F.to_homotopy.cast h₀ h₁ }

end homotopy_with

/--
Given continuous maps `f₀` and `f₁`, we say `f₀` and `f₁` are homotopic with respect to the
predicate `P` if there exists a `homotopy_with f₀ f₁ P`.
-/
def homotopic_with (f₀ f₁ : C(X, Y)) (P : C(X, Y) → Prop) : Prop :=
nonempty (homotopy_with f₀ f₁ P)

namespace homotopic_with

variable {P : C(X, Y) → Prop}

@[refl]
lemma refl (f : C(X, Y)) (hf : P f) : homotopic_with f f P :=
⟨homotopy_with.refl f hf⟩

@[symm]
lemma symm ⦃f g : C(X, Y)⦄ (h : homotopic_with f g P) : homotopic_with g f P := ⟨h.some.symm⟩

@[trans]
lemma trans ⦃f g h : C(X, Y)⦄ (h₀ : homotopic_with f g P) (h₁ : homotopic_with g h P) :
  homotopic_with f h P :=
⟨h₀.some.trans h₁.some⟩

end homotopic_with

/--
A `homotopy_rel f₀ f₁ S` is a homotopy between `f₀` and `f₁` which is fixed on the points in `S`.
-/
abbreviation homotopy_rel (f₀ f₁ : C(X, Y)) (S : set X) :=
homotopy_with f₀ f₁ (λ f, ∀ x ∈ S, f x = f₀ x ∧ f x = f₁ x)

namespace homotopy_rel

section

variables {f₀ f₁ : C(X, Y)} {S : set X}

lemma eq_fst (F : homotopy_rel f₀ f₁ S) (t : I) {x : X} (hx : x ∈ S) :
  F (t, x) = f₀ x := (F.prop t x hx).1

lemma eq_snd (F : homotopy_rel f₀ f₁ S) (t : I) {x : X} (hx : x ∈ S) :
  F (t, x) = f₁ x := (F.prop t x hx).2

lemma fst_eq_snd (F : homotopy_rel f₀ f₁ S) {x : X} (hx : x ∈ S) :
  f₀ x = f₁ x := F.eq_fst 0 hx ▸ F.eq_snd 0 hx

end

variables {f₀ f₁ f₂ : C(X, Y)} {S : set X}

/--
Given a map `f : C(X, Y)` and a set `S`, we can define a `homotopy_rel f f S` by setting
`F (t, x) = f x` for all `t`. This is defined using `homotopy_with.refl`, but with the proof
filled in.
-/
@[simps]
def refl (f : C(X, Y)) (S : set X) : homotopy_rel f f S :=
homotopy_with.refl f (λ x hx, ⟨rfl, rfl⟩)

/--
Given a `homotopy_rel f₀ f₁ S`, we can define a `homotopy_rel f₁ f₀ S` by reversing the homotopy.
-/
@[simps]
def symm (F : homotopy_rel f₀ f₁ S) : homotopy_rel f₁ f₀ S :=
{ prop' := λ t x hx, by simp [F.eq_snd _ hx, F.fst_eq_snd hx],
  ..homotopy_with.symm F }

@[simp]
lemma symm_symm (F : homotopy_rel f₀ f₁ S) : F.symm.symm = F :=
homotopy_with.symm_symm F

/--
Given `homotopy_rel f₀ f₁ S` and `homotopy_rel f₁ f₂ S`, we can define a `homotopy_rel f₀ f₂ S`
by putting the first homotopy on `[0, 1/2]` and the second on `[1/2, 1]`.
-/
def trans (F : homotopy_rel f₀ f₁ S) (G : homotopy_rel f₁ f₂ S) : homotopy_rel f₀ f₂ S :=
{ prop' := λ t, begin
    intros x hx,
    simp only [homotopy.trans],
    change (⟨λ _, ite ((t : ℝ) ≤ _) _ _, _⟩ : C(X, Y)) _ = _ ∧ _ = _,
    split_ifs,
    { simp [(homotopy_with.extend_prop F (2 * t) x hx).1, F.fst_eq_snd hx, G.fst_eq_snd hx] },
    { simp [(homotopy_with.extend_prop G (2 * t - 1) x hx).1, F.fst_eq_snd hx, G.fst_eq_snd hx] },
  end,
  ..homotopy.trans F.to_homotopy G.to_homotopy }

lemma trans_apply (F : homotopy_rel f₀ f₁ S) (G : homotopy_rel f₁ f₂ S)
  (x : I × X) : (F.trans G) x =
  if h : (x.1 : ℝ) ≤ 1/2 then
    F (⟨2 * x.1, (unit_interval.mul_pos_mem_iff zero_lt_two).2 ⟨x.1.2.1, h⟩⟩, x.2)
  else
    G (⟨2 * x.1 - 1, unit_interval.two_mul_sub_one_mem_iff.2 ⟨(not_le.1 h).le, x.1.2.2⟩⟩, x.2) :=
homotopy.trans_apply _ _ _

lemma symm_trans (F : homotopy_rel f₀ f₁ S) (G : homotopy_rel f₁ f₂ S) :
  (F.trans G).symm = G.symm.trans F.symm :=
homotopy_with.ext $ homotopy.congr_fun $ homotopy.symm_trans _ _

/--
Casting a `homotopy_rel f₀ f₁ S` to a `homotopy_rel g₀ g₁ S` where `f₀ = g₀` and `f₁ = g₁`.
-/
@[simps]
def cast {f₀ f₁ g₀ g₁ : C(X, Y)} (F : homotopy_rel f₀ f₁ S) (h₀ : f₀ = g₀) (h₁ : f₁ = g₁) :
  homotopy_rel g₀ g₁ S :=
{ prop' := λ t x hx, by { simpa [←h₀, ←h₁] using F.prop t x hx },
  ..homotopy.cast F.to_homotopy h₀ h₁ }

end homotopy_rel

/--
Given continuous maps `f₀` and `f₁`, we say `f₀` and `f₁` are homotopic relative to a set `S` if
there exists a `homotopy_rel f₀ f₁ S`.
-/
def homotopic_rel (f₀ f₁ : C(X, Y)) (S : set X) : Prop :=
nonempty (homotopy_rel f₀ f₁ S)

namespace homotopic_rel

variable {S : set X}

@[refl]
lemma refl (f : C(X, Y)) : homotopic_rel f f S := ⟨homotopy_rel.refl f S⟩

@[symm]
lemma symm ⦃f g : C(X, Y)⦄ (h : homotopic_rel f g S) : homotopic_rel g f S :=
  h.map homotopy_rel.symm

@[trans]
lemma trans ⦃f g h : C(X, Y)⦄ (h₀ : homotopic_rel f g S) (h₁ : homotopic_rel g h S) :
  homotopic_rel f h S :=
h₀.map2 homotopy_rel.trans h₁

lemma equivalence : equivalence (λ f g : C(X, Y), homotopic_rel f g S) :=
⟨refl, symm, trans⟩

end homotopic_rel

end continuous_map


-- import data.set
import tactic
import data.real.basic

-- dEAduction imports
import structures2
import compute
import utils

-- import definitions
-- import notations_definitions

-- General principles :
-- Type should be defined as parameters, in order to be implicit everywhere
-- other parameters are implicit in definitions, i.e. defined using '{}' (e.g. {A : set X} )
-- but explicit everywhere else, i.e. defined using '()' (e.g. (A : set X) )
-- each definition must be an iff statement (since it will be called with 'rw' or 'symp_rw')

local attribute [instance] classical.prop_decidable

---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course

notation [parsing_only] P ` and ` Q := P ∧ Q
notation [parsing_only]  P ` or ` Q := P ∨ Q
notation [parsing_only]  ` not ` P := ¬ P
notation [parsing_only]  P ` implies ` Q := P → Q
notation [parsing_only]  P ` iff ` Q := P ↔ Q

notation [parsing_only]  x ` in ` A := x ∈ A
notation [parsing_only]  A ` cap ` B := A ∩ B
notation [parsing_only]  A ` cup ` B := A ∪ B
notation [parsing_only]  A ` subset ` B := A ⊆ B
notation [parsing_only]  `emptyset` := ∅

notation [parsing_only] P ` et ` Q := P ∧ Q
notation [parsing_only]  P ` ou ` Q := P ∨ Q
notation [parsing_only]  ` non ` P := ¬ P
notation [parsing_only]  P ` implique ` Q := P → Q
notation [parsing_only]  P ` ssi ` Q := P ↔ Q

notation [parsing_only]  x ` dans ` A := x ∈ A
notation [parsing_only]  x ` appartient ` A := x ∈ A
notation [parsing_only]  A ` inter ` B := A ∩ B
notation [parsing_only]  A ` intersection ` B := A ∩ B
notation [parsing_only]  A ` union ` B := A ∪ B
notation [parsing_only]  A ` inclus ` B := A ⊆ B
notation [parsing_only]  `vide` := ∅

notation f `⟮` A `⟯` := f '' A
notation f `⁻¹⟮` A `⟯` := f  ⁻¹' A
notation [parsing_only] f `inverse` A := f  ⁻¹' A
notation g `∘` f := set.composition g f

open set

------------------
-- COURSE TITLE --
------------------
namespace maths_approfondies
/- dEAduction
PrettyName
    1M003 : mathématiques approfondies
-/

namespace nombres_reels
/- dEAduction
PrettyName
    Chapitre 1 : Nombres réels
-/

namespace majorants_minorants
/- dEAduction
PrettyName
    Majorants, minorants
-/

def majorant (E: set ℝ) (M: ℝ) := ∀ x ∈ E, x ≤ M
notation M ` est_un_majorant_de ` E := majorant E M
def minorant (E: set ℝ) (m: ℝ) := ∀ x ∈ E, m ≤ x
notation M ` est_un_minorant_de ` E := minorant E M
def est_majore (E: set ℝ) := ∃ M, majorant E M
def est_minore (E: set ℝ) := ∃ m, minorant E m
def est_borne (E: set ℝ) := (est_majore E) ∧ (est_minore E)
notation E ` est_borné` := est_borne E
notation E ` est_majoré` := est_majore E
notation E ` est_minoré` := est_minore E

------------------------
-- lemma DEFS A ECRIRE
------------------------
namespace definitions

lemma definition.majorant
(E: set ℝ) (M: ℝ) :
majorant E M ↔  ∀ x ∈ E, x ≤ M
:=
/- dEAduction
PrettyName
    Majorant
-/
begin
    sorry
end

lemma definition.minorant
(E: set ℝ) (m: ℝ) :
minorant E m ↔  ∀ x ∈ E, m ≤ x
:=
/- dEAduction
PrettyName
    Minorant
-/
begin
    sorry
end

lemma definition.est_majore
(E: set ℝ) :
est_majore E ↔ ∃ M, majorant E M
:=
/- dEAduction
PrettyName
    Partie majorée
-/
begin
    sorry
end

lemma definition.est_minore
(E: set ℝ) :
est_minore E ↔ ∃ m, minorant E m
:=
/- dEAduction
PrettyName
    Partie minorée
-/
begin
    sorry
end

lemma definition.est_borne
(E: set ℝ) :
est_borne E ↔  (est_majore E) ∧ (est_minore E)
:=
/- dEAduction
PrettyName
    Partie bornée
-/
begin
    sorry
end

-- notation `|`x`|`:= @abs ℝ _ x  -- valeur absolue sur ℝ

lemma theorem.est_borne
(E: set ℝ) :
est_borne E ↔ ( ∃ M, ∀ x:ℝ, x ∈ E → |x| ≤ M )
:=
/- dEAduction
PrettyName
    Caractérisation pratique d'une partie bornée
-/
begin
    sorry
end

end definitions

namespace exercices

-- def interval_ferme (a b:ℝ) := {x:ℝ // a ≤ x ∧ x ≤ b }
notation `[` a `,`b `]` := Icc (a:ℝ) (b:ℝ)
notation [parsing_only] `]` a `,`b `[` := Ioo (a:ℝ) (b:ℝ)

lemma definition.intervalle_ferme {a b x : ℝ} :
x ∈ [a, b] ↔ (a ≤ x and x ≤ b)
:=
begin
    sorry
end

lemma definition.intervalle_ouvert {a b x : ℝ} :
x ∈ Ioo a b ↔ (a < x and x < b)
:=
begin
    sorry
end
lemma exercise.exemple_ensemble_borne :
est_borne [(0:ℝ),1]
:=
/- dEAduction
PrettyName
    L'intervalle [0,1] est borné
-/
begin
    sorry
end

lemma exercise.exemple_ensemble_borne_2 (a b : ℝ):
est_borne [a,b]
:=
/- dEAduction
PrettyName
    L'intervalle [a,b] est borné
-/
begin
    sorry
end

lemma essai2 (a: ℝ) (x ≤ (a:ℝ)) : x ≤ (a+1)
:=
begin
    linarith,
end

lemma exercise.R_non_borne :
¬ est_borne (set.univ)
:=
/- dEAduction
PrettyName
    ℝ n'est pas borné
-/
begin
    sorry
end

end exercices

end majorants_minorants

namespace borne_sup
/- dEAduction
PrettyName
    Borne supérieure
-/
open majorants_minorants

def borne_sup (E: set ℝ) (M: ℝ) := (majorant E M) ∧ (∀ m, majorant E m → M ≤ m)
def borne_inf (E: set ℝ) (M: ℝ) := (minorant E M) ∧ (∀ m, minorant E m → m ≤ M)
notation M ` =Sup ` E := borne_sup E M
notation M ` =Inf ` E := borne_inf E M

------------------------
-- lemma DEFS A ECRIRE
------------------------

lemma definition.borne_superieure
(E: set ℝ) (M: ℝ) :
borne_sup E M ↔  (majorant E M) ∧ (∀ m, majorant E m → M ≤ m)
:=
begin
    refl,
end

lemma definition.borne_inferieure
(E: set ℝ) (M: ℝ) :
borne_inf E M ↔  (minorant E M) ∧ (∀ m, minorant E m → m ≤ M)
:=
begin
    refl,
end

-- theorem admis : Axiome de la borne supérieure
lemma theorem.borne_superieure :
∀ E : set ℝ, est_majore E → ∃ M, borne_sup E M
:=
begin
    sorry
end

lemma definition.oppose_ensemble
(E F : set ℝ) :
F = -E ↔ (∀ x, x ∈ F ↔ -x ∈ E)
:=
/- dEAduction
PrettyName
    Opposé d'une partie de ℝ
-/
begin
    sorry
end

lemma exercise.oppose_minore
(E F : set ℝ) (H: F = -E): est_minore E ↔ est_majore (F)
:=
/- dEAduction
PrettyName
    L'opposé d'une partie minorée est majorée, et réciproquement
-/
begin
    sorry
end

lemma exercise.essai
(x:ℝ) (E F : set ℝ) (H1: x ∈ E) (H2: (∀ x, x ∈ F ↔ -x ∈ E)) :
est_majore E → est_minore (F)
:=
begin
    sorry
end

lemma exercise.axiome_borne_inf
(E : set ℝ) : est_minore E → ∃ M, borne_inf E M
:=
/- dEAduction
PrettyName
    "Axiome de la borne inférieure"
-/
begin
    sorry
end

namespace exercices

-- exo 8 a b c d
lemma exercise.plus_petit_que_tout_positif_I :
∀x:ℝ, ((∀ ε>0, x< ε) → x ≤ 0) :=
/- dEAduction
PrettyName
    1M003 exercice 1.8 (a)
-/

begin
    -- intro x,
    -- intro H1,
    -- by_contradiction,
    -- let   ε := x/2,
    -- have H2 : ε = x/2, refl,
    -- have H3: ε>0, by linarith,
    -- have H4 := H1 ε H3,
    -- linarith,   -- OK
    todo
end

lemma exercise.plus_petit_que_tout_positif_II :
not (∀x:ℝ, ((∀ ε>0, x< ε) → x < 0)) :=
/- dEAduction
PrettyName
    1M003 exercice 1.8 (b)
-/
begin
    sorry,
    -- push_neg,
    -- use 0, split,
    -- intro ε, intro H,
    -- no_meta_vars,
    -- linarith,
    -- linarith,  -- OK
end

lemma exercise.inf_positive :
not (∀ A : set ℝ, ∀ m:ℝ,
((borne_inf A m) ∧ (∀ x ∈ A, x > (0:ℝ))) → m >0)
:=
/- dEAduction
PrettyName
    1M003 exercice 1.8 (c)
-/
begin
    -- push_neg,
    -- use {x:ℝ | x >0 },
    sorry
end

lemma exercise.inf_negative
(A: set ℝ) (m:ℝ) (H: borne_inf A m):
(∀ ε>(0:ℝ), ∃ a ∈ A, a  < ε) → m  ≤ 0
:=
/- dEAduction
PrettyName
    1M003 exercice 1.8 (d)
-/
begin
    sorry,
    -- intro H1,
    -- by_contradiction H2,
    -- push_neg at H2,
    -- rw definition.borne_inferieure at H,
    -- cases H with Ha Hb,
    -- specialize H1 m,
    -- specialize H1 H2,
    -- rcases H1 with ⟨ a, ⟨ H3, H4 ⟩ ⟩,
    -- rw majorants_minorants.definitions.definition.minorant at Ha,
    -- specialize Ha a,
    -- specialize Ha H3,
    -- linarith, -- OK
end

end exercices

end borne_sup

end nombres_reels

namespace analyse

namespace suites
-- NB : dans le cours, suites complexes, mais ici on se limite aux suites réelles

-- limite

-- ex : 1/n tend vers 0

-- unicite

-- (-1)^n diverge

-- suite bornée

-- convergente implique bornee

-- limite d'une somme, d'un produit, de l'inverse

-- Passage à la limite dans les inégalités larges

-- Théorème des gendarmes

-- corollaire : existence d'une suite convergeant vers la borne inf.

-- une suite croissante majorée converge (vers la borne sup de ses valeurs)

-- limites infinies. Une partie non majorée contient une suite qui tend vers +∞
-- Une suite croissante non majorée tend vers +∞

-- suites adjacentes, convergence

-- sous-suites

-- BW

-- une suite bornée CV ssi elle admet une unique valeur d'adhérence

namespace exercices

-- exo 3 : CV de l'inverse (avec un lemme)

-- toute suite convergente de nombres entiers est stationnaire

-- Une suite CV vers l ssi les deux suites extraites d'ordre pair et impair CV vers l

-- une suite bornee divergente a au moins deux valeurs d'adhérence

-- théorème de Cesaro

-- Suites de Cauchy : CV → Cauchy ; Cauchy → bornée ; Cauchy → sous-suite CV : Cauchy → CV.

end exercices

end suites

namespace continuite

end continuite

end analyse

end maths_approfondies

end course


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Oliver Nash
-/
import data.finset.card

/-!
# Finsets in product types

This file defines finset constructions on the product type `α × β`. Beware not to confuse with the
`finset.prod` operation which computes the multiplicative product.

## Main declarations

* `finset.product`: Turns `s : finset α`, `t : finset β` into their product in `finset (α × β)`.
* `finset.diag`: For `s : finset α`, `s.diag` is the `finset (α × α)` of pairs `(a, a)` with
  `a ∈ s`.
* `finset.off_diag`: For `s : finset α`, `s.off_diag` is the `finset (α × α)` of pairs `(a, b)` with
  `a, b ∈ s` and `a ≠ b`.
-/

open multiset

variables {α β γ : Type*}

namespace finset

/-! ### prod -/
section prod
variables {s s' : finset α} {t t' : finset β}

/-- `product s t` is the set of pairs `(a, b)` such that `a ∈ s` and `b ∈ t`. -/
protected def product (s : finset α) (t : finset β) : finset (α × β) := ⟨_, nodup_product s.2 t.2⟩

@[simp] lemma product_val : (s.product t).1 = s.1.product t.1 := rfl

@[simp] lemma mem_product {p : α × β} : p ∈ s.product t ↔ p.1 ∈ s ∧ p.2 ∈ t := mem_product

@[simp, norm_cast] lemma coe_product (s : finset α) (t : finset β) :
  (s.product t : set (α × β)) = (s : set α) ×ˢ (t : set β) :=
set.ext $ λ x, finset.mem_product

lemma subset_product [decidable_eq α] [decidable_eq β] {s : finset (α × β)} :
  s ⊆ (s.image prod.fst).product (s.image prod.snd) :=
λ p hp, mem_product.2 ⟨mem_image_of_mem _ hp, mem_image_of_mem _ hp⟩

lemma product_subset_product (hs : s ⊆ s') (ht : t ⊆ t') : s.product t ⊆ s'.product t' :=
λ ⟨x,y⟩ h, mem_product.2 ⟨hs (mem_product.1 h).1, ht (mem_product.1 h).2⟩

lemma product_subset_product_left (hs : s ⊆ s') : s.product t ⊆ s'.product t :=
product_subset_product hs (subset.refl _)

lemma product_subset_product_right (ht : t ⊆ t') : s.product t ⊆ s.product t' :=
product_subset_product (subset.refl _) ht

lemma product_eq_bUnion [decidable_eq α] [decidable_eq β] (s : finset α) (t : finset β) :
  s.product t = s.bUnion (λa, t.image $ λb, (a, b)) :=
ext $ λ ⟨x, y⟩, by simp only [mem_product, mem_bUnion, mem_image, exists_prop, prod.mk.inj_iff,
  and.left_comm, exists_and_distrib_left, exists_eq_right, exists_eq_left]

lemma product_eq_bUnion_right [decidable_eq α] [decidable_eq β] (s : finset α) (t : finset β) :
  s.product t = t.bUnion (λ b, s.image $ λ a, (a, b)) :=
ext $ λ ⟨x, y⟩, by simp only [mem_product, mem_bUnion, mem_image, exists_prop, prod.mk.inj_iff,
  and.left_comm, exists_and_distrib_left, exists_eq_right, exists_eq_left]

/-- See also `finset.sup_product_left`. -/
@[simp] lemma product_bUnion [decidable_eq γ] (s : finset α) (t : finset β) (f : α × β → finset γ) :
  (s.product t).bUnion f = s.bUnion (λ a, t.bUnion (λ b, f (a, b))) :=
by { classical, simp_rw [product_eq_bUnion, bUnion_bUnion, image_bUnion] }

@[simp] lemma card_product (s : finset α) (t : finset β) : card (s.product t) = card s * card t :=
multiset.card_product _ _

lemma filter_product (p : α → Prop) (q : β → Prop) [decidable_pred p] [decidable_pred q] :
  (s.product t).filter (λ (x : α × β), p x.1 ∧ q x.2) = (s.filter p).product (t.filter q) :=
by { ext ⟨a, b⟩, simp only [mem_filter, mem_product],
     exact and_and_and_comm (a ∈ s) (b ∈ t) (p a) (q b) }

lemma filter_product_card (s : finset α) (t : finset β)
  (p : α → Prop) (q : β → Prop) [decidable_pred p] [decidable_pred q] :
  ((s.product t).filter (λ (x : α × β), p x.1 ↔ q x.2)).card =
  (s.filter p).card * (t.filter q).card + (s.filter (not ∘ p)).card * (t.filter (not ∘ q)).card :=
begin
  classical,
  rw [← card_product, ← card_product, ← filter_product, ← filter_product, ← card_union_eq],
  { apply congr_arg, ext ⟨a, b⟩, simp only [filter_union_right, mem_filter, mem_product],
    split; intros h; use h.1,
    simp only [function.comp_app, and_self, h.2, em (q b)],
    cases h.2; { try { simp at h_1 }, simp [h_1] } },
  { rw disjoint_iff, change _ ∩ _ = ∅, ext ⟨a, b⟩, rw mem_inter,
    simp only [and_imp, mem_filter, not_and, not_not, function.comp_app, iff_false, mem_product,
     not_mem_empty], intros, assumption }
end

lemma empty_product (t : finset β) : (∅ : finset α).product t = ∅ := rfl

lemma product_empty (s : finset α) : s.product (∅ : finset β) = ∅ :=
eq_empty_of_forall_not_mem (λ x h, (finset.mem_product.1 h).2)

lemma nonempty.product (hs : s.nonempty) (ht : t.nonempty) : (s.product t).nonempty :=
let ⟨x, hx⟩ := hs, ⟨y, hy⟩ := ht in ⟨(x, y), mem_product.2 ⟨hx, hy⟩⟩

lemma nonempty.fst (h : (s.product t).nonempty) : s.nonempty :=
let ⟨xy, hxy⟩ := h in ⟨xy.1, (mem_product.1 hxy).1⟩

lemma nonempty.snd (h : (s.product t).nonempty) : t.nonempty :=
let ⟨xy, hxy⟩ := h in ⟨xy.2, (mem_product.1 hxy).2⟩

@[simp] lemma nonempty_product : (s.product t).nonempty ↔ s.nonempty ∧ t.nonempty :=
⟨λ h, ⟨h.fst, h.snd⟩, λ h, h.1.product h.2⟩

@[simp] lemma product_eq_empty {s : finset α} {t : finset β} : s.product t = ∅ ↔ s = ∅ ∨ t = ∅ :=
by rw [←not_nonempty_iff_eq_empty, nonempty_product, not_and_distrib, not_nonempty_iff_eq_empty,
  not_nonempty_iff_eq_empty]

@[simp] lemma singleton_product {a : α} :
  ({a} : finset α).product t = t.map ⟨prod.mk a, prod.mk.inj_left _⟩ :=
by { ext ⟨x, y⟩, simp [and.left_comm, eq_comm] }

@[simp] lemma product_singleton {b : β} :
  s.product {b} = s.map ⟨λ i, (i, b), prod.mk.inj_right _⟩ :=
by { ext ⟨x, y⟩, simp [and.left_comm, eq_comm] }

lemma singleton_product_singleton {a : α} {b : β} :
  ({a} : finset α).product ({b} : finset β) = {(a, b)} :=
by simp only [product_singleton, function.embedding.coe_fn_mk, map_singleton]

@[simp] lemma union_product [decidable_eq α] [decidable_eq β] :
  (s ∪ s').product t = s.product t ∪ s'.product t :=
by { ext ⟨x, y⟩, simp only [or_and_distrib_right, mem_union, mem_product] }

@[simp] lemma product_union [decidable_eq α] [decidable_eq β] :
  s.product (t ∪ t') = s.product t ∪ s.product t' :=
by { ext ⟨x, y⟩, simp only [and_or_distrib_left, mem_union, mem_product] }

end prod

section diag
variables (s : finset α) [decidable_eq α]

/-- Given a finite set `s`, the diagonal, `s.diag` is the set of pairs of the form `(a, a)` for
`a ∈ s`. -/
def diag := (s.product s).filter (λ (a : α × α), a.fst = a.snd)

/-- Given a finite set `s`, the off-diagonal, `s.off_diag` is the set of pairs `(a, b)` with `a ≠ b`
for `a, b ∈ s`. -/
def off_diag := (s.product s).filter (λ (a : α × α), a.fst ≠ a.snd)

@[simp] lemma mem_diag (x : α × α) : x ∈ s.diag ↔ x.1 ∈ s ∧ x.1 = x.2 :=
by { simp only [diag, mem_filter, mem_product], split; intros h;
     simp only [h, and_true, eq_self_iff_true, and_self], rw ←h.2, exact h.1 }

@[simp] lemma mem_off_diag (x : α × α) : x ∈ s.off_diag ↔ x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2 :=
by { simp only [off_diag, mem_filter, mem_product], split; intros h;
     simp only [h, ne.def, not_false_iff, and_self] }

@[simp] lemma diag_card : (diag s).card = s.card :=
begin
  suffices : diag s = s.image (λ a, (a, a)),
  { rw this, apply card_image_of_inj_on, exact λ x1 h1 x2 h2 h3, (prod.mk.inj h3).1 },
  ext ⟨a₁, a₂⟩, rw mem_diag, split; intros h; rw finset.mem_image at *,
  { use [a₁, h.1, prod.mk.inj_iff.mpr ⟨rfl, h.2⟩] },
  { rcases h with ⟨a, h1, h2⟩, have h := prod.mk.inj h2, rw [←h.1, ←h.2], use h1 },
end

@[simp] lemma off_diag_card : (off_diag s).card = s.card * s.card - s.card :=
begin
  suffices : (diag s).card + (off_diag s).card = s.card * s.card,
  { nth_rewrite 2 ← s.diag_card, simp only [diag_card] at *, rw tsub_eq_of_eq_add_rev, rw this },
  rw ← card_product,
  apply filter_card_add_filter_neg_card_eq_card,
end

@[simp] lemma diag_empty : (∅ : finset α).diag = ∅ := rfl

@[simp] lemma off_diag_empty : (∅ : finset α).off_diag = ∅ := rfl

@[simp] lemma diag_union_off_diag : s.diag ∪ s.off_diag = s.product s :=
filter_union_filter_neg_eq _ _

@[simp] lemma disjoint_diag_off_diag : disjoint s.diag s.off_diag := disjoint_filter_filter_neg _ _

end diag
end finset


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.star.basic
import algebra.algebra.subalgebra.basic

/-!
# Star subalgebras

A *-subalgebra is a subalgebra of a *-algebra which is closed under *.

The centralizer of a *-closed set is a *-subalgebra.
-/

universes u v

set_option old_structure_cmd true

/-- A *-subalgebra is a subalgebra of a *-algebra which is closed under *. -/
structure star_subalgebra (R : Type u) (A : Type v) [comm_semiring R] [star_ring R]
  [semiring A] [star_ring A] [algebra R A] [star_module R A] extends subalgebra R A : Type v :=
(star_mem' {a} : a ∈ carrier → star a ∈ carrier)

namespace star_subalgebra

/--
Forgetting that a *-subalgebra is closed under *.
-/
add_decl_doc star_subalgebra.to_subalgebra

variables (R : Type u) (A : Type v) [comm_semiring R] [star_ring R]
  [semiring A] [star_ring A] [algebra R A] [star_module R A]

instance : set_like (star_subalgebra R A) A :=
⟨star_subalgebra.carrier, λ p q h, by cases p; cases q; congr'⟩

instance : has_top (star_subalgebra R A) :=
⟨{ star_mem' := by tidy, ..(⊤ : subalgebra R A) }⟩

instance : inhabited (star_subalgebra R A) := ⟨⊤⟩

section centralizer
variables {A}

/-- The centralizer, or commutant, of a *-closed set as star subalgebra. -/
def centralizer
  (s : set A) (w : ∀ (a : A), a ∈ s → star a ∈ s) : star_subalgebra R A :=
{ star_mem' := λ x xm y hy, by simpa using congr_arg star (xm _ (w _ hy)).symm,
  ..subalgebra.centralizer R s, }

@[simp]
lemma coe_centralizer (s : set A) (w : ∀ (a : A), a ∈ s → star a ∈ s) :
  (centralizer R s w : set A) = s.centralizer := rfl

lemma mem_centralizer_iff {s : set A} {w} {z : A} :
  z ∈ centralizer R s w ↔ ∀ g ∈ s, g * z = z * g :=
iff.rfl

lemma centralizer_le (s t : set A)
  (ws : ∀ (a : A), a ∈ s → star a ∈ s) (wt : ∀ (a : A), a ∈ t → star a ∈ t) (h : s ⊆ t) :
  centralizer R t wt ≤ centralizer R s ws :=
set.centralizer_subset h

end centralizer

end star_subalgebra


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import topology.basic
import order.omega_complete_partial_order

/-!
# Scott Topological Spaces

A type of topological spaces whose notion
of continuity is equivalent to continuity in ωCPOs.

## Reference

 * https://ncatlab.org/nlab/show/Scott+topology

-/

open omega_complete_partial_order
open_locale classical

universes u
namespace Scott

/-- `x` is an `ω`-Sup of a chain `c` if it is the least upper bound of the range of `c`. -/
def is_ωSup {α : Type u} [preorder α] (c : chain α) (x : α) : Prop :=
(∀ i, c i ≤ x) ∧ (∀ y, (∀ i, c i ≤ y) → x ≤ y)

lemma is_ωSup_iff_is_lub {α : Type u} [preorder α] {c : chain α} {x : α} :
  is_ωSup c x ↔ is_lub (set.range c) x :=
by simp [is_ωSup, is_lub, is_least, upper_bounds, lower_bounds]

variables (α : Type u) [omega_complete_partial_order α]
local attribute [irreducible] set

/-- The characteristic function of open sets is monotone and preserves
the limits of chains. -/
def is_open (s : set α) : Prop :=
continuous' (λ x, x ∈ s)

theorem is_open_univ : is_open α set.univ :=
⟨λ x y h, by simp only [set.mem_univ]; refl',
  by convert @complete_lattice.top_continuous α Prop _ _; ext; simp ⟩

theorem is_open.inter (s t : set α) : is_open α s → is_open α t → is_open α (s ∩ t) :=
begin
  simp only [is_open, exists_imp_distrib, continuous'],
  intros h₀ h₁ h₂ h₃,
  rw ← set.inf_eq_inter,
  let s' : α →ₘ Prop := ⟨λ x, x ∈ s, h₀⟩,
  let t' : α →ₘ Prop := ⟨λ x, x ∈ t, h₂⟩,
  split,
  { change omega_complete_partial_order.continuous (s' ⊓ t'),
    haveI : is_total Prop (≤) := ⟨ @le_total Prop _ ⟩,
    apply complete_lattice.inf_continuous; assumption },
  { intros x y h, apply and_implies;
    solve_by_elim [h₀ h, h₂ h], }
end

theorem is_open_sUnion : ∀s, (∀t∈s, is_open α t) → is_open α (⋃₀ s) :=
begin
  introv h₀,
  suffices : is_open α ({ x | Sup (flip (∈) '' s) x }),
  { convert this, ext,
    simp only [set.sUnion, Sup, set.mem_image, set.mem_set_of_eq, supr,
               conditionally_complete_lattice.Sup, exists_exists_and_eq_and,
               complete_lattice.Sup, exists_prop, set.mem_range,
               set_coe.exists, eq_iff_iff, subtype.coe_mk],
    tauto, },
  dsimp [is_open] at *,
  apply complete_lattice.Sup_continuous' _,
  introv ht, specialize h₀ { x | f x } _,
  { simp only [flip, set.mem_image] at *,
    rcases ht with ⟨x,h₀,h₁⟩, subst h₁,
    simpa, },
  { simpa using h₀ }
end

end Scott

/-- A Scott topological space is defined on preorders
such that their open sets, seen as a function `α → Prop`,
preserves the joins of ω-chains  -/
@[reducible]
def Scott (α : Type u) := α

instance Scott.topological_space (α : Type u) [omega_complete_partial_order α] :
  topological_space (Scott α) :=
{ is_open := Scott.is_open α,
  is_open_univ := Scott.is_open_univ α,
  is_open_inter := Scott.is_open.inter α,
  is_open_sUnion := Scott.is_open_sUnion α }

section not_below
variables {α : Type*} [omega_complete_partial_order α] (y : Scott α)

/-- `not_below` is an open set in `Scott α` used
to prove the monotonicity of continuous functions -/
def not_below := { x | ¬ x ≤ y }

lemma not_below_is_open : is_open (not_below y) :=
begin
  have h : monotone (not_below y),
  { intros x y' h,
    simp only [not_below, set_of, le_Prop_eq],
    intros h₀ h₁, apply h₀ (le_trans h h₁) },
  existsi h, rintros c,
  apply eq_of_forall_ge_iff, intro z,
  rw ωSup_le_iff,
  simp only [ωSup_le_iff, not_below, set.mem_set_of_eq, le_Prop_eq, preorder_hom.coe_fun_mk,
             chain.map_coe, function.comp_app, exists_imp_distrib, not_forall],
end

end not_below

open Scott (hiding is_open)
open omega_complete_partial_order

lemma is_ωSup_ωSup {α} [omega_complete_partial_order α] (c : chain α) :
  is_ωSup c (ωSup c) :=
begin
  split,
  { apply le_ωSup, },
  { apply ωSup_le, },
end

lemma Scott_continuous_of_continuous {α β}
  [omega_complete_partial_order α]
  [omega_complete_partial_order β]
  (f : Scott α → Scott β) (hf : continuous f) :
  omega_complete_partial_order.continuous' f :=
begin
  simp only [continuous_def, (⁻¹')] at hf,
  have h : monotone f,
  { intros x y h,
    cases (hf {x | ¬ x ≤ f y} (not_below_is_open _)) with hf hf', clear hf',
    specialize hf h, simp only [set.preimage, set_of, (∈), set.mem, le_Prop_eq] at hf,
    by_contradiction H, apply hf H (le_refl (f y)) },
  existsi h, intro c,
  apply eq_of_forall_ge_iff, intro z,
  specialize (hf _ (not_below_is_open z)),
  cases hf, specialize hf_h c,
  simp only [not_below, preorder_hom.coe_fun_mk, eq_iff_iff, set.mem_set_of_eq] at hf_h,
  rw [← not_iff_not],
  simp only [ωSup_le_iff, hf_h, ωSup, supr, Sup, complete_lattice.Sup, complete_semilattice_Sup.Sup,
    exists_prop, set.mem_range, preorder_hom.coe_fun_mk, chain.map_coe, function.comp_app,
    eq_iff_iff, not_forall],
  tauto,
end

lemma continuous_of_Scott_continuous {α β}
  [omega_complete_partial_order α]
  [omega_complete_partial_order β]
  (f : Scott α → Scott β) (hf : omega_complete_partial_order.continuous' f) :
  continuous f :=
begin
  rw continuous_def,
  intros s hs,
  change continuous' (s ∘ f),
  cases hs with hs hs',
  cases hf with hf hf',
  apply continuous.of_bundled,
  apply continuous_comp _ _ hf' hs',
end