/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import data.bitvec.core
import data.fin.basic
import tactic.monotonicity
import tactic.norm_num

namespace bitvec

instance (n : ℕ) : preorder (bitvec n) :=
preorder.lift bitvec.to_nat

/-- convert `fin` to `bitvec` -/
def of_fin {n : ℕ} (i : fin $ 2^n) : bitvec n :=
bitvec.of_nat _ i.val

lemma of_fin_val {n : ℕ} (i : fin $ 2^n) : (of_fin i).to_nat = i.val :=
by rw [of_fin,to_nat_of_nat,nat.mod_eq_of_lt]; apply i.is_lt

/-- convert `bitvec` to `fin` -/
def to_fin {n : ℕ} (i : bitvec n) : fin $ 2^n :=
i.to_nat

lemma add_lsb_eq_twice_add_one {x b} :
  add_lsb x b = 2 * x + cond b 1 0 :=
by simp [add_lsb,two_mul]

lemma to_nat_eq_foldr_reverse {n : ℕ} (v : bitvec n) :
  v.to_nat = v.to_list.reverse.foldr (flip add_lsb) 0 :=
by rw [list.foldr_reverse, flip]; refl

lemma to_nat_lt {n : ℕ} (v : bitvec n) : v.to_nat < 2^n :=
begin
  suffices : v.to_nat + 1 ≤ 2 ^ n, { simpa },
  rw to_nat_eq_foldr_reverse,
  cases v with xs h,
  dsimp [bitvec.to_nat,bits_to_nat],
  rw ← list.length_reverse at h,
  generalize_hyp : xs.reverse = ys at ⊢ h, clear xs,
  induction ys generalizing n,
  { simp [← h] },
  { simp only [←h, pow_add, flip, list.length, list.foldr, pow_one],
    rw [add_lsb_eq_twice_add_one],
    transitivity 2 * list.foldr (λ (x : bool) (y : ℕ), add_lsb y x) 0 ys_tl + 2 * 1,
    { ac_mono, rw two_mul, mono, cases ys_hd; simp },
    { rw ← left_distrib, ac_mono,
      exact ys_ih rfl, norm_num } }
end

lemma add_lsb_div_two {x b} : add_lsb x b / 2 = x :=
by cases b; simp only [nat.add_mul_div_left, add_lsb, ←two_mul, add_comm, nat.succ_pos',
                       nat.mul_div_right, gt_iff_lt, zero_add, cond]; norm_num

lemma to_bool_add_lsb_mod_two {x b} : to_bool (add_lsb x b % 2 = 1) = b :=
by cases b; simp only [to_bool_iff, nat.add_mul_mod_self_left, add_lsb, ←two_mul, add_comm,
                       bool.to_bool_false, nat.mul_mod_right, zero_add, cond, zero_ne_one]; norm_num

lemma of_nat_to_nat  {n : ℕ} (v : bitvec n) : bitvec.of_nat _ v.to_nat = v :=
begin
  cases v with xs h,
  ext1,
  change vector.to_list _ = xs,
  dsimp [bitvec.to_nat,bits_to_nat],
  rw ← list.length_reverse at h,
  rw [← list.reverse_reverse xs,list.foldl_reverse],
  generalize_hyp : xs.reverse = ys at ⊢ h, clear xs,
  induction ys generalizing n,
  { cases h, simp [bitvec.of_nat] },
  { simp only [←nat.succ_eq_add_one, list.length] at h, subst n,
    simp only [bitvec.of_nat, vector.to_list_cons, vector.to_list_nil, list.reverse_cons,
      vector.to_list_append, list.foldr],
    erw [add_lsb_div_two, to_bool_add_lsb_mod_two],
    congr, apply ys_ih, refl }
end

lemma to_fin_val {n : ℕ} (v : bitvec n) : (to_fin v : ℕ) = v.to_nat :=
by rw [to_fin, fin.coe_of_nat_eq_mod, nat.mod_eq_of_lt]; apply to_nat_lt

lemma to_fin_le_to_fin_of_le {n} {v₀ v₁ : bitvec n} (h : v₀ ≤ v₁) : v₀.to_fin ≤ v₁.to_fin :=
show (v₀.to_fin : ℕ) ≤ v₁.to_fin,
by rw [to_fin_val,to_fin_val]; exact h

lemma of_fin_le_of_fin_of_le {n : ℕ} {i j : fin (2^n)} (h : i ≤ j) : of_fin i ≤ of_fin j :=
show (bitvec.of_nat n i).to_nat ≤ (bitvec.of_nat n j).to_nat,
by { simp only [to_nat_of_nat, nat.mod_eq_of_lt, fin.is_lt], exact h }

lemma to_fin_of_fin {n} (i : fin $ 2^n) : (of_fin i).to_fin = i :=
fin.eq_of_veq (by simp [to_fin_val, of_fin, to_nat_of_nat, nat.mod_eq_of_lt, i.is_lt])

lemma of_fin_to_fin {n} (v : bitvec n) : of_fin (to_fin v) = v :=
by dsimp [of_fin]; rw [to_fin_val, of_nat_to_nat]

end bitvec


import mynat.definition
import mynat.add

lemma zero_add (n : mynat) : 0 + n = n :=
begin
induction n with d hd,
rw add_zero,
refl,
rw add_succ,
rw hd,
refl,
end


import Mathlib.Order.Basic
import Mathlib.Init.Set
import Mathlib.Init.Function

open Function

class Lattice (α : Type u) extends PartialOrder α, Sup α, Inf α where
  sup_ub_left (a b : α) : a ≤ a ⊔ b
  sup_ub_right (a b : α) : b ≤ a ⊔ b
  sup_lub (a b c : α) : a ≤ c → b ≤ c → a ⊔ b ≤ c
  inf_lb_left (a b : α) : a ⊓ b ≤ a
  inf_lb_right (a b : α) : a ⊓ b ≤ b
  inf_glb (a b c : α) : a ≤ b → a ≤ c → a ≤ b ⊓ c

class Top (α : Type u) where
  top : α

notation "⊤" => Top.top

class Bot (α : Type u) where
  bot : α

notation "⊥" => Bot.bot

class CompleteLattice (α : Type u) extends Lattice α, Top α, Bot α where
  le_top : ∀ (a : α), a ≤ ⊤
  bot_le : ∀ (a : α), ⊥ ≤ a
  supr : Set α → α
  infi : Set α → α
  supr_ub  : ∀ (s : Set α) (a : α), a ∈ s → a ≤ supr s
  supr_lub : ∀ (s : Set α) (a : α), (∀ (b : α), b ∈ s → b ≤ a) → supr s ≤ a
  infi_lb  : ∀ (s : Set α) (a : α), a ∈ s → infi s ≤ a
  infi_glb : ∀ (s : Set α) (a : α), (∀ (b : α), b ∈ s → a ≤ b) → a ≤ infi s

def monotone_pre [Preorder α] [Preorder β] (f : α → β) :=
  ∀ {a b}, a ≤ b → f a ≤ f b

def monotone_latt [Lattice α] [Lattice β] (f : α → β) :=
  ∀ {a b}, f a ⊔ f b ≤ f (a ⊔ b)

theorem monotone_pre_latt [Lattice α] [Lattice β] (f : α → β) (h : monotone_pre f) : monotone_latt f :=
  fun {a b} =>
  have haab : f a ≤ f (a ⊔ b) := h (Lattice.sup_ub_left a b)
  have habb : f b ≤ f (a ⊔ b) := h (Lattice.sup_ub_right a b)
  show f a ⊔ f b ≤ f (a ⊔ b) from Lattice.sup_lub (f a) (f b) (f (a ⊔ b)) haab habb

theorem monotone_pre_latt3 [Lattice α] [Lattice β] (f : α → β) (h : monotone_pre f) : monotone_latt f := by
  intro a b
  repeat (any_goals (first | apply Lattice.sup_lub | apply h | apply Lattice.sup_ub_left | apply Lattice.sup_ub_right))

def galoisConnection {α β} [PartialOrder α] [PartialOrder β]
  (l : α → β) (u : β → α) := ∀ a b,  l a ≤ b ↔ a ≤ u b

/-
Interesting features:
  - calc
  - by assumption, ‹a ≤ b›
  - any_goals, first
  - split
  - other tactics?
-/

#check {1,2} ⊆  ({1,2,3} : Set ℕ)

instance {α : Type u} : CompleteLattice (Set α) :=
{ le := (· ⊆ ·)
  sup := (· ∪ ·)
  inf := (· ∩ ·)
  top := Set.univ
  bot := {}
  supr := fun ss x => ∃s ∈ ss, s x
  infi := fun ss x => ∀s ∈ ss, s x
  le_refl := fun a b x => x
  le_trans := fun a b c s1 s2 x p => s2 (s1 p)
  lt_iff_le_not_le := by sorry
  le_antisymm := by sorry
  sup_lub := by sorry
  sup_ub_left := by sorry
  sup_ub_right := by sorry
  inf_glb := by sorry
  inf_lb_left := by sorry
  inf_lb_right := by sorry
  le_top := by sorry
  bot_le := by sorry
  supr_ub := by sorry
  supr_lub := by sorry
  infi_glb := by sorry
  infi_lb := by sorry
  }


import Init.Data.Nat
import SOS.Dyadic

inductive Poly
| C : Dyadic → Poly
| X : Fin 3 → Poly
| Mul : Poly → Poly → Poly
| Add : Poly → Poly → Poly

namespace Poly

syntax "X[" term "]" : term
syntax "C[" term "]" : term
macro_rules
  | `(C[$c]) => `(C $c)
  | `(X[$n]) => `(X $n)

def toString : Poly → String
| C f => ToString.toString f
| X i => s!"x{i}"
| Mul p q => s!"{toString p} * {toString q}"
| Add p q => s!"{toString p} + {toString q}"

instance : ToString Poly where
  toString := toString

-- instance : Repr Poly where
--   reprPrec p n := toString p

instance : OfNat Poly n where
  ofNat := C[0]

instance : HAdd Poly Poly Poly where
  hAdd := Add

instance : HMul Poly Poly Poly where
  hMul := Mul

def Eval (v : Fin 3 → Dyadic) : Poly → Dyadic
| C f => f
| X i => v i
| Mul p q => (Eval v p) * (Eval v q)
| Add p q => (Eval v p) + (Eval v q)

def Reduce : Poly → Poly
| C f => C f
| X i => X i
| Mul (C f) (C g) => C (f * g)
| Mul (X i) (C f) => Mul (C f) (X i)
| Mul (X i) (X j) => if i ≤ j then Mul (X i) (X j) else Mul (X j) (X i)
| Mul (Add p q) r => Add (Mul (Reduce p) (Reduce r)) (Mul (Reduce q) (Reduce r))
| Mul p (Add q r) => Add (Mul (Reduce p) (Reduce q)) (Mul (Reduce p) (Reduce r))
| Mul p q => Mul (Reduce p) (Reduce q)
| Add p q => Add (Reduce p) (Reduce q)

instance : HasLessEq Poly where
  LessEq p q := ∀ (v : Fin 3 → Dyadic), Eval v p ≤ Eval v q

theorem mul_same_nonneg (p : Poly) : 0 ≤ p * p := by
  intro v; simp [Eval] at *; exact Dyadic.mul_same_nonneg _

theorem add_nonneg_of_nonneg {p q : Poly} (hp : 0 ≤ p) (hq : 0 ≤ q) : 0 ≤ p + q := by
  intro v; simp [Eval] at *; exact Dyadic.add_nonneg_of_nonneg (hp v) (hq v)

end Poly

inductive SOSPoly
| Sqr : Poly → SOSPoly
| Add : SOSPoly → SOSPoly → SOSPoly

namespace SOSPoly

def ToPoly : SOSPoly → Poly
| Sqr p => Poly.Mul p p
| Add p q => Poly.Add (ToPoly p) (ToPoly q)

theorem sos_nonneg (s : SOSPoly) : 0 ≤ ToPoly s := by
  induction s;
  { simp [ToPoly]; exact Poly.mul_same_nonneg _ }
  { simp [ToPoly]; exact Poly.add_nonneg_of_nonneg (by assumption) (by assumption) }

end SOSPoly


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module geometry.manifold.charted_space
! leanprover-community/mathlib commit bcfa726826abd57587355b4b5b7e78ad6527b7e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.LocalHomeomorph

/-!
# Charted spaces

A smooth manifold is a topological space `M` locally modelled on a euclidean space (or a euclidean
half-space for manifolds with boundaries, or an infinite dimensional vector space for more general
notions of manifolds), i.e., the manifold is covered by open subsets on which there are local
homeomorphisms (the charts) going to a model space `H`, and the changes of charts should be smooth
maps.

In this file, we introduce a general framework describing these notions, where the model space is an
arbitrary topological space. We avoid the word *manifold*, which should be reserved for the
situation where the model space is a (subset of a) vector space, and use the terminology
*charted space* instead.

If the changes of charts satisfy some additional property (for instance if they are smooth), then
`M` inherits additional structure (it makes sense to talk about smooth manifolds). There are
therefore two different ingredients in a charted space:
* the set of charts, which is data
* the fact that changes of charts belong to some group (in fact groupoid), which is additional Prop.

We separate these two parts in the definition: the charted space structure is just the set of
charts, and then the different smoothness requirements (smooth manifold, orientable manifold,
contact manifold, and so on) are additional properties of these charts. These properties are
formalized through the notion of structure groupoid, i.e., a set of local homeomorphisms stable
under composition and inverse, to which the change of coordinates should belong.

## Main definitions

* `structure_groupoid H` : a subset of local homeomorphisms of `H` stable under composition,
  inverse and restriction (ex: local diffeos).
* `continuous_groupoid H` : the groupoid of all local homeomorphisms of `H`
* `charted_space H M` : charted space structure on `M` modelled on `H`, given by an atlas of
  local homeomorphisms from `M` to `H` whose sources cover `M`. This is a type class.
* `has_groupoid M G` : when `G` is a structure groupoid on `H` and `M` is a charted space
  modelled on `H`, require that all coordinate changes belong to `G`. This is a type class.
* `atlas H M` : when `M` is a charted space modelled on `H`, the atlas of this charted
  space structure, i.e., the set of charts.
* `G.maximal_atlas M` : when `M` is a charted space modelled on `H` and admitting `G` as a
  structure groupoid, one can consider all the local homeomorphisms from `M` to `H` such that
  changing coordinate from any chart to them belongs to `G`. This is a larger atlas, called the
  maximal atlas (for the groupoid `G`).
* `structomorph G M M'` : the type of diffeomorphisms between the charted spaces `M` and `M'` for
  the groupoid `G`. We avoid the word diffeomorphism, keeping it for the smooth category.

As a basic example, we give the instance
`instance charted_space_model_space (H : Type*) [topological_space H] : charted_space H H`
saying that a topological space is a charted space over itself, with the identity as unique chart.
This charted space structure is compatible with any groupoid.

Additional useful definitions:

* `pregroupoid H` : a subset of local mas of `H` stable under composition and
  restriction, but not inverse (ex: smooth maps)
* `groupoid_of_pregroupoid` : construct a groupoid from a pregroupoid, by requiring that a map and
  its inverse both belong to the pregroupoid (ex: construct diffeos from smooth maps)
* `chart_at H x` is a preferred chart at `x : M` when `M` has a charted space structure modelled on
  `H`.
* `G.compatible he he'` states that, for any two charts `e` and `e'` in the atlas, the composition
  of `e.symm` and `e'` belongs to the groupoid `G` when `M` admits `G` as a structure groupoid.
* `G.compatible_of_mem_maximal_atlas he he'` states that, for any two charts `e` and `e'` in the
  maximal atlas associated to the groupoid `G`, the composition of `e.symm` and `e'` belongs to the
  `G` if `M` admits `G` as a structure groupoid.
* `charted_space_core.to_charted_space`: consider a space without a topology, but endowed with a set
  of charts (which are local equivs) for which the change of coordinates are local homeos. Then
  one can construct a topology on the space for which the charts become local homeos, defining
  a genuine charted space structure.

## Implementation notes

The atlas in a charted space is *not* a maximal atlas in general: the notion of maximality depends
on the groupoid one considers, and changing groupoids changes the maximal atlas. With the current
formalization, it makes sense first to choose the atlas, and then to ask whether this precise atlas
defines a smooth manifold, an orientable manifold, and so on. A consequence is that structomorphisms
between `M` and `M'` do *not* induce a bijection between the atlases of `M` and `M'`: the
definition is only that, read in charts, the structomorphism locally belongs to the groupoid under
consideration. (This is equivalent to inducing a bijection between elements of the maximal atlas).
A consequence is that the invariance under structomorphisms of properties defined in terms of the
atlas is not obvious in general, and could require some work in theory (amounting to the fact
that these properties only depend on the maximal atlas, for instance). In practice, this does not
create any real difficulty.

We use the letter `H` for the model space thinking of the case of manifolds with boundary, where the
model space is a half space.

Manifolds are sometimes defined as topological spaces with an atlas of local diffeomorphisms, and
sometimes as spaces with an atlas from which a topology is deduced. We use the former approach:
otherwise, there would be an instance from manifolds to topological spaces, which means that any
instance search for topological spaces would try to find manifold structures involving a yet
unknown model space, leading to problems. However, we also introduce the latter approach,
through a structure `charted_space_core` making it possible to construct a topology out of a set of
local equivs with compatibility conditions (but we do not register it as an instance).

In the definition of a charted space, the model space is written as an explicit parameter as there
can be several model spaces for a given topological space. For instance, a complex manifold
(modelled over `ℂ^n`) will also be seen sometimes as a real manifold modelled over `ℝ^(2n)`.

## Notations

In the locale `manifold`, we denote the composition of local homeomorphisms with `≫ₕ`, and the
composition of local equivs with `≫`.
-/

noncomputable section

open Classical Topology

open Filter

universe u

variable {H : Type u} {H' : Type _} {M : Type _} {M' : Type _} {M'' : Type _}

-- mathport name: local_homeomorph.trans
/- Notational shortcut for the composition of local homeomorphisms and local equivs, i.e.,
`local_homeomorph.trans` and `local_equiv.trans`.
Note that, as is usual for equivs, the composition is from left to right, hence the direction of
the arrow. -/
scoped[Manifold] infixr:100 " ≫ₕ " => LocalHomeomorph.trans

-- mathport name: local_equiv.trans
scoped[Manifold] infixr:100 " ≫ " => LocalEquiv.trans

open Set LocalHomeomorph

/-! ### Structure groupoids-/

section Groupoid

/-! One could add to the definition of a structure groupoid the fact that the restriction of an
element of the groupoid to any open set still belongs to the groupoid.
(This is in Kobayashi-Nomizu.)
I am not sure I want this, for instance on `H × E` where `E` is a vector space, and the groupoid is
made of functions respecting the fibers and linear in the fibers (so that a charted space over this
groupoid is naturally a vector bundle) I prefer that the members of the groupoid are always
defined on sets of the form `s × E`.  There is a typeclass `closed_under_restriction` for groupoids
which have the restriction property.

The only nontrivial requirement is locality: if a local homeomorphism belongs to the groupoid
around each point in its domain of definition, then it belongs to the groupoid. Without this
requirement, the composition of structomorphisms does not have to be a structomorphism. Note that
this implies that a local homeomorphism with empty source belongs to any structure groupoid, as
it trivially satisfies this condition.

There is also a technical point, related to the fact that a local homeomorphism is by definition a
global map which is a homeomorphism when restricted to its source subset (and its values outside
of the source are not relevant). Therefore, we also require that being a member of the groupoid only
depends on the values on the source.

We use primes in the structure names as we will reformulate them below (without primes) using a
`has_mem` instance, writing `e ∈ G` instead of `e ∈ G.members`.
-/

/-- A structure groupoid is a set of local homeomorphisms of a topological space stable under
composition and inverse. They appear in the definition of the smoothness class of a manifold. -/
structure StructureGroupoid (H : Type u) [TopologicalSpace H] where
  members : Set (LocalHomeomorph H H)
  trans' : ∀ e e' : LocalHomeomorph H H, e ∈ members → e' ∈ members → e ≫ₕ e' ∈ members
  symm' : ∀ e : LocalHomeomorph H H, e ∈ members → e.symm ∈ members
  id_mem' : LocalHomeomorph.refl H ∈ members
  locality' :
    ∀ e : LocalHomeomorph H H,
      (∀ x ∈ e.source, ∃ s, IsOpen s ∧ x ∈ s ∧ e.restr s ∈ members) → e ∈ members
  eq_on_source' : ∀ e e' : LocalHomeomorph H H, e ∈ members → e' ≈ e → e' ∈ members
#align structure_groupoid StructureGroupoid

variable [TopologicalSpace H]

instance : Membership (LocalHomeomorph H H) (StructureGroupoid H) :=
  ⟨fun (e : LocalHomeomorph H H) (G : StructureGroupoid H) => e ∈ G.members⟩

theorem StructureGroupoid.trans (G : StructureGroupoid H) {e e' : LocalHomeomorph H H} (he : e ∈ G)
    (he' : e' ∈ G) : e ≫ₕ e' ∈ G :=
  G.trans' e e' he he'
#align structure_groupoid.trans StructureGroupoid.trans

theorem StructureGroupoid.symm (G : StructureGroupoid H) {e : LocalHomeomorph H H} (he : e ∈ G) :
    e.symm ∈ G :=
  G.symm' e he
#align structure_groupoid.symm StructureGroupoid.symm

theorem StructureGroupoid.id_mem (G : StructureGroupoid H) : LocalHomeomorph.refl H ∈ G :=
  G.id_mem'
#align structure_groupoid.id_mem StructureGroupoid.id_mem

theorem StructureGroupoid.locality (G : StructureGroupoid H) {e : LocalHomeomorph H H}
    (h : ∀ x ∈ e.source, ∃ s, IsOpen s ∧ x ∈ s ∧ e.restr s ∈ G) : e ∈ G :=
  G.locality' e h
#align structure_groupoid.locality StructureGroupoid.locality

theorem StructureGroupoid.eq_on_source (G : StructureGroupoid H) {e e' : LocalHomeomorph H H}
    (he : e ∈ G) (h : e' ≈ e) : e' ∈ G :=
  G.eq_on_source' e e' he h
#align structure_groupoid.eq_on_source StructureGroupoid.eq_on_source

/-- Partial order on the set of groupoids, given by inclusion of the members of the groupoid -/
instance StructureGroupoid.partialOrder : PartialOrder (StructureGroupoid H) :=
  PartialOrder.lift StructureGroupoid.members fun a b h =>
    by
    cases a
    cases b
    dsimp at h
    induction h
    rfl
#align structure_groupoid.partial_order StructureGroupoid.partialOrder

theorem StructureGroupoid.le_iff {G₁ G₂ : StructureGroupoid H} : G₁ ≤ G₂ ↔ ∀ e, e ∈ G₁ → e ∈ G₂ :=
  Iff.rfl
#align structure_groupoid.le_iff StructureGroupoid.le_iff

/-- The trivial groupoid, containing only the identity (and maps with empty source, as this is
necessary from the definition) -/
def idGroupoid (H : Type u) [TopologicalSpace H] : StructureGroupoid H
    where
  members := {LocalHomeomorph.refl H} ∪ { e : LocalHomeomorph H H | e.source = ∅ }
  trans' e e' he he' := by
    cases he <;> simp at he he'
    · simpa only [he, refl_trans]
    · have : (e ≫ₕ e').source ⊆ e.source := sep_subset _ _
      rw [he] at this
      have : e ≫ₕ e' ∈ { e : LocalHomeomorph H H | e.source = ∅ } := eq_bot_iff.2 this
      exact (mem_union _ _ _).2 (Or.inr this)
  symm' e he := by
    cases' (mem_union _ _ _).1 he with E E
    · simp [mem_singleton_iff.mp E]
    · right
      simpa only [e.to_local_equiv.image_source_eq_target.symm, mfld_simps] using E
  id_mem' := mem_union_left _ rfl
  locality' e he := by
    cases' e.source.eq_empty_or_nonempty with h h
    · right
      exact h
    · left
      rcases h with ⟨x, hx⟩
      rcases he x hx with ⟨s, open_s, xs, hs⟩
      have x's : x ∈ (e.restr s).source :=
        by
        rw [restr_source, open_s.interior_eq]
        exact ⟨hx, xs⟩
      cases hs
      · replace hs : LocalHomeomorph.restr e s = LocalHomeomorph.refl H
        · simpa only using hs
        have : (e.restr s).source = univ := by
          rw [hs]
          simp
        change e.to_local_equiv.source ∩ interior s = univ at this
        have : univ ⊆ interior s := by
          rw [← this]
          exact inter_subset_right _ _
        have : s = univ := by rwa [open_s.interior_eq, univ_subset_iff] at this
        simpa only [this, restr_univ] using hs
      · exfalso
        rw [mem_set_of_eq] at hs
        rwa [hs] at x's
  eq_on_source' e e' he he'e := by
    cases he
    · left
      have : e = e' := by
        refine' eq_of_eq_on_source_univ (Setoid.symm he'e) _ _ <;>
            rw [Set.mem_singleton_iff.1 he] <;>
          rfl
      rwa [← this]
    · right
      change e.to_local_equiv.source = ∅ at he
      rwa [Set.mem_setOf_eq, he'e.source_eq]
#align id_groupoid idGroupoid

/-- Every structure groupoid contains the identity groupoid -/
instance : OrderBot (StructureGroupoid H)
    where
  bot := idGroupoid H
  bot_le := by
    intro u f hf
    change f ∈ {LocalHomeomorph.refl H} ∪ { e : LocalHomeomorph H H | e.source = ∅ } at hf
    simp only [singleton_union, mem_set_of_eq, mem_insert_iff] at hf
    cases hf
    · rw [hf]
      apply u.id_mem
    · apply u.locality
      intro x hx
      rw [hf, mem_empty_iff_false] at hx
      exact hx.elim

instance (H : Type u) [TopologicalSpace H] : Inhabited (StructureGroupoid H) :=
  ⟨idGroupoid H⟩

/-- To construct a groupoid, one may consider classes of local homeos such that both the function
and its inverse have some property. If this property is stable under composition,
one gets a groupoid. `pregroupoid` bundles the properties needed for this construction, with the
groupoid of smooth functions with smooth inverses as an application. -/
structure Pregroupoid (H : Type _) [TopologicalSpace H] where
  property : (H → H) → Set H → Prop
  comp :
    ∀ {f g u v},
      property f u →
        property g v → IsOpen u → IsOpen v → IsOpen (u ∩ f ⁻¹' v) → property (g ∘ f) (u ∩ f ⁻¹' v)
  id_mem : property id univ
  locality :
    ∀ {f u}, IsOpen u → (∀ x ∈ u, ∃ v, IsOpen v ∧ x ∈ v ∧ property f (u ∩ v)) → property f u
  congr : ∀ {f g : H → H} {u}, IsOpen u → (∀ x ∈ u, g x = f x) → property f u → property g u
#align pregroupoid Pregroupoid

/-- Construct a groupoid of local homeos for which the map and its inverse have some property,
from a pregroupoid asserting that this property is stable under composition. -/
def Pregroupoid.groupoid (PG : Pregroupoid H) : StructureGroupoid H
    where
  members := { e : LocalHomeomorph H H | PG.property e e.source ∧ PG.property e.symm e.target }
  trans' e e' he he' := by
    constructor
    · apply PG.comp he.1 he'.1 e.open_source e'.open_source
      apply e.continuous_to_fun.preimage_open_of_open e.open_source e'.open_source
    · apply PG.comp he'.2 he.2 e'.open_target e.open_target
      apply e'.continuous_inv_fun.preimage_open_of_open e'.open_target e.open_target
  symm' e he := ⟨he.2, he.1⟩
  id_mem' := ⟨PG.id_mem, PG.id_mem⟩
  locality' e he := by
    constructor
    · apply PG.locality e.open_source fun x xu => _
      rcases he x xu with ⟨s, s_open, xs, hs⟩
      refine' ⟨s, s_open, xs, _⟩
      convert hs.1 using 1
      dsimp [LocalHomeomorph.restr]
      rw [s_open.interior_eq]
    · apply PG.locality e.open_target fun x xu => _
      rcases he (e.symm x) (e.map_target xu) with ⟨s, s_open, xs, hs⟩
      refine' ⟨e.target ∩ e.symm ⁻¹' s, _, ⟨xu, xs⟩, _⟩
      · exact ContinuousOn.preimage_open_of_open e.continuous_inv_fun e.open_target s_open
      · rw [← inter_assoc, inter_self]
        convert hs.2 using 1
        dsimp [LocalHomeomorph.restr]
        rw [s_open.interior_eq]
  eq_on_source' e e' he ee' := by
    constructor
    · apply PG.congr e'.open_source ee'.2
      simp only [ee'.1, he.1]
    · have A := ee'.symm'
      apply PG.congr e'.symm.open_source A.2
      convert he.2
      rw [A.1]
      rfl
#align pregroupoid.groupoid Pregroupoid.groupoid

theorem mem_groupoid_of_pregroupoid {PG : Pregroupoid H} {e : LocalHomeomorph H H} :
    e ∈ PG.groupoid ↔ PG.property e e.source ∧ PG.property e.symm e.target :=
  Iff.rfl
#align mem_groupoid_of_pregroupoid mem_groupoid_of_pregroupoid

theorem groupoid_of_pregroupoid_le (PG₁ PG₂ : Pregroupoid H)
    (h : ∀ f s, PG₁.property f s → PG₂.property f s) : PG₁.groupoid ≤ PG₂.groupoid :=
  by
  refine' StructureGroupoid.le_iff.2 fun e he => _
  rw [mem_groupoid_of_pregroupoid] at he⊢
  exact ⟨h _ _ he.1, h _ _ he.2⟩
#align groupoid_of_pregroupoid_le groupoid_of_pregroupoid_le

theorem mem_pregroupoid_of_eq_on_source (PG : Pregroupoid H) {e e' : LocalHomeomorph H H}
    (he' : e ≈ e') (he : PG.property e e.source) : PG.property e' e'.source :=
  by
  rw [← he'.1]
  exact PG.congr e.open_source he'.eq_on.symm he
#align mem_pregroupoid_of_eq_on_source mem_pregroupoid_of_eq_on_source

/-- The pregroupoid of all local maps on a topological space `H` -/
@[reducible]
def continuousPregroupoid (H : Type _) [TopologicalSpace H] : Pregroupoid H
    where
  property f s := True
  comp f g u v hf hg hu hv huv := trivial
  id_mem := trivial
  locality f u u_open h := trivial
  congr f g u u_open hcongr hf := trivial
#align continuous_pregroupoid continuousPregroupoid

instance (H : Type _) [TopologicalSpace H] : Inhabited (Pregroupoid H) :=
  ⟨continuousPregroupoid H⟩

/-- The groupoid of all local homeomorphisms on a topological space `H` -/
def continuousGroupoid (H : Type _) [TopologicalSpace H] : StructureGroupoid H :=
  Pregroupoid.groupoid (continuousPregroupoid H)
#align continuous_groupoid continuousGroupoid

/-- Every structure groupoid is contained in the groupoid of all local homeomorphisms -/
instance : OrderTop (StructureGroupoid H)
    where
  top := continuousGroupoid H
  le_top u f hf := by constructor <;> exact by decide

/-- A groupoid is closed under restriction if it contains all restrictions of its element local
homeomorphisms to open subsets of the source. -/
class ClosedUnderRestriction (G : StructureGroupoid H) : Prop where
  ClosedUnderRestriction :
    ∀ {e : LocalHomeomorph H H}, e ∈ G → ∀ s : Set H, IsOpen s → e.restr s ∈ G
#align closed_under_restriction ClosedUnderRestriction

theorem closed_under_restriction' {G : StructureGroupoid H} [ClosedUnderRestriction G]
    {e : LocalHomeomorph H H} (he : e ∈ G) {s : Set H} (hs : IsOpen s) : e.restr s ∈ G :=
  ClosedUnderRestriction.closedUnderRestriction he s hs
#align closed_under_restriction' closed_under_restriction'

/-- The trivial restriction-closed groupoid, containing only local homeomorphisms equivalent to the
restriction of the identity to the various open subsets. -/
def idRestrGroupoid : StructureGroupoid H
    where
  members := { e | ∃ (s : Set H)(h : IsOpen s), e ≈ LocalHomeomorph.ofSet s h }
  trans' := by
    rintro e e' ⟨s, hs, hse⟩ ⟨s', hs', hse'⟩
    refine' ⟨s ∩ s', IsOpen.inter hs hs', _⟩
    have := LocalHomeomorph.EqOnSource.trans' hse hse'
    rwa [LocalHomeomorph.ofSet_trans_ofSet] at this
  symm' := by
    rintro e ⟨s, hs, hse⟩
    refine' ⟨s, hs, _⟩
    rw [← of_set_symm]
    exact LocalHomeomorph.EqOnSource.symm' hse
  id_mem' := ⟨univ, isOpen_univ, by simp only [mfld_simps]⟩
  locality' := by
    intro e h
    refine' ⟨e.source, e.open_source, by simp only [mfld_simps], _⟩
    intro x hx
    rcases h x hx with ⟨s, hs, hxs, s', hs', hes'⟩
    have hes : x ∈ (e.restr s).source := by
      rw [e.restr_source]
      refine' ⟨hx, _⟩
      rw [hs.interior_eq]
      exact hxs
    simpa only [mfld_simps] using LocalHomeomorph.EqOnSource.eqOn hes' hes
  eq_on_source' := by
    rintro e e' ⟨s, hs, hse⟩ hee'
    exact ⟨s, hs, Setoid.trans hee' hse⟩
#align id_restr_groupoid idRestrGroupoid

theorem idRestrGroupoid_mem {s : Set H} (hs : IsOpen s) : ofSet s hs ∈ @idRestrGroupoid H _ :=
  ⟨s, hs, by rfl⟩
#align id_restr_groupoid_mem idRestrGroupoid_mem

/-- The trivial restriction-closed groupoid is indeed `closed_under_restriction`. -/
instance closedUnderRestriction_idRestrGroupoid : ClosedUnderRestriction (@idRestrGroupoid H _) :=
  ⟨by
    rintro e ⟨s', hs', he⟩ s hs
    use s' ∩ s, IsOpen.inter hs' hs
    refine' Setoid.trans (LocalHomeomorph.EqOnSource.restr he s) _
    exact ⟨by simp only [hs.interior_eq, mfld_simps], by simp only [mfld_simps]⟩⟩
#align closed_under_restriction_id_restr_groupoid closedUnderRestriction_idRestrGroupoid

/-- A groupoid is closed under restriction if and only if it contains the trivial restriction-closed
groupoid. -/
theorem closedUnderRestriction_iff_id_le (G : StructureGroupoid H) :
    ClosedUnderRestriction G ↔ idRestrGroupoid ≤ G :=
  by
  constructor
  · intro _i
    apply structure_groupoid.le_iff.mpr
    rintro e ⟨s, hs, hes⟩
    refine' G.eq_on_source _ hes
    convert closed_under_restriction' G.id_mem hs
    change s = _ ∩ _
    rw [hs.interior_eq]
    simp only [mfld_simps]
  · intro h
    constructor
    intro e he s hs
    rw [← of_set_trans (e : LocalHomeomorph H H) hs]
    refine' G.trans _ he
    apply structure_groupoid.le_iff.mp h
    exact idRestrGroupoid_mem hs
#align closed_under_restriction_iff_id_le closedUnderRestriction_iff_id_le

/-- The groupoid of all local homeomorphisms on a topological space `H` is closed under restriction.
-/
instance : ClosedUnderRestriction (continuousGroupoid H) :=
  (closedUnderRestriction_iff_id_le _).mpr (by convert le_top)

end Groupoid

/-! ### Charted spaces -/

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`atlas] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`chartAt] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`mem_chart_source] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`chart_mem_atlas] [] -/
/-- A charted space is a topological space endowed with an atlas, i.e., a set of local
homeomorphisms taking value in a model space `H`, called charts, such that the domains of the charts
cover the whole space. We express the covering property by chosing for each `x` a member
`chart_at H x` of the atlas containing `x` in its source: in the smooth case, this is convenient to
construct the tangent bundle in an efficient way.
The model space is written as an explicit parameter as there can be several model spaces for a
given topological space. For instance, a complex manifold (modelled over `ℂ^n`) will also be seen
sometimes as a real manifold over `ℝ^(2n)`.
-/
@[ext]
class ChartedSpace (H : Type _) [TopologicalSpace H] (M : Type _) [TopologicalSpace M] where
  atlas : Set (LocalHomeomorph M H)
  chartAt : M → LocalHomeomorph M H
  mem_chart_source : ∀ x, x ∈ (chart_at x).source
  chart_mem_atlas : ∀ x, chart_at x ∈ atlas
#align charted_space ChartedSpace

export ChartedSpace ()

attribute [simp, mfld_simps] mem_chart_source chart_mem_atlas

section ChartedSpace

/-- Any space is a charted_space modelled over itself, by just using the identity chart -/
instance chartedSpaceSelf (H : Type _) [TopologicalSpace H] : ChartedSpace H H
    where
  atlas := {LocalHomeomorph.refl H}
  chartAt x := LocalHomeomorph.refl H
  mem_chart_source x := mem_univ x
  chart_mem_atlas x := mem_singleton _
#align charted_space_self chartedSpaceSelf

/-- In the trivial charted_space structure of a space modelled over itself through the identity, the
atlas members are just the identity -/
@[simp, mfld_simps]
theorem chartedSpaceSelf_atlas {H : Type _} [TopologicalSpace H] {e : LocalHomeomorph H H} :
    e ∈ atlas H H ↔ e = LocalHomeomorph.refl H := by simp [atlas, ChartedSpace.atlas]
#align charted_space_self_atlas chartedSpaceSelf_atlas

/-- In the model space, chart_at is always the identity -/
theorem chartAt_self_eq {H : Type _} [TopologicalSpace H] {x : H} :
    chartAt H x = LocalHomeomorph.refl H := by simpa using chart_mem_atlas H x
#align chart_at_self_eq chartAt_self_eq

section

variable (H) [TopologicalSpace H] [TopologicalSpace M] [ChartedSpace H M]

theorem mem_chart_target (x : M) : chartAt H x x ∈ (chartAt H x).target :=
  (chartAt H x).map_source (mem_chart_source _ _)
#align mem_chart_target mem_chart_target

theorem chart_source_mem_nhds (x : M) : (chartAt H x).source ∈ 𝓝 x :=
  (chartAt H x).open_source.mem_nhds <| mem_chart_source H x
#align chart_source_mem_nhds chart_source_mem_nhds

theorem chart_target_mem_nhds (x : M) : (chartAt H x).target ∈ 𝓝 (chartAt H x x) :=
  (chartAt H x).open_target.mem_nhds <| mem_chart_target H x
#align chart_target_mem_nhds chart_target_mem_nhds

/-- `achart H x` is the chart at `x`, considered as an element of the atlas.
Especially useful for working with `basic_smooth_vector_bundle_core` -/
def achart (x : M) : atlas H M :=
  ⟨chartAt H x, chart_mem_atlas H x⟩
#align achart achart

theorem achart_def (x : M) : achart H x = ⟨chartAt H x, chart_mem_atlas H x⟩ :=
  rfl
#align achart_def achart_def

@[simp, mfld_simps]
theorem coe_achart (x : M) : (achart H x : LocalHomeomorph M H) = chartAt H x :=
  rfl
#align coe_achart coe_achart

@[simp, mfld_simps]
theorem achart_val (x : M) : (achart H x).1 = chartAt H x :=
  rfl
#align achart_val achart_val

theorem mem_achart_source (x : M) : x ∈ (achart H x).1.source :=
  mem_chart_source H x
#align mem_achart_source mem_achart_source

open TopologicalSpace

theorem ChartedSpace.second_countable_of_countable_cover [SecondCountableTopology H] {s : Set M}
    (hs : (⋃ (x) (hx : x ∈ s), (chartAt H x).source) = univ) (hsc : s.Countable) :
    SecondCountableTopology M :=
  by
  haveI : ∀ x : M, second_countable_topology (chart_at H x).source := fun x =>
    (chart_at H x).secondCountableTopology_source
  haveI := hsc.to_encodable
  rw [bUnion_eq_Union] at hs
  exact
    second_countable_topology_of_countable_cover (fun x : s => (chart_at H (x : M)).open_source) hs
#align charted_space.second_countable_of_countable_cover ChartedSpace.second_countable_of_countable_cover

variable (M)

theorem ChartedSpace.second_countable_of_sigma_compact [SecondCountableTopology H]
    [SigmaCompactSpace M] : SecondCountableTopology M :=
  by
  obtain ⟨s, hsc, hsU⟩ :
    ∃ s, Set.Countable s ∧ (⋃ (x) (hx : x ∈ s), (chart_at H x).source) = univ :=
    countable_cover_nhds_of_sigma_compact fun x : M => chart_source_mem_nhds H x
  exact ChartedSpace.second_countable_of_countable_cover H hsU hsc
#align charted_space.second_countable_of_sigma_compact ChartedSpace.second_countable_of_sigma_compact

/-- If a topological space admits an atlas with locally compact charts, then the space itself
is locally compact. -/
theorem ChartedSpace.locally_compact [LocallyCompactSpace H] : LocallyCompactSpace M :=
  by
  have :
    ∀ x : M,
      (𝓝 x).HasBasis (fun s => s ∈ 𝓝 (chart_at H x x) ∧ IsCompact s ∧ s ⊆ (chart_at H x).target)
        fun s => (chart_at H x).symm '' s :=
    by
    intro x
    rw [← (chart_at H x).symm_map_nhds_eq (mem_chart_source H x)]
    exact
      ((compact_basis_nhds (chart_at H x x)).hasBasis_self_subset (chart_target_mem_nhds H x)).map _
  refine' locallyCompactSpace_of_hasBasis this _
  rintro x s ⟨h₁, h₂, h₃⟩
  exact h₂.image_of_continuous_on ((chart_at H x).continuousOn_symm.mono h₃)
#align charted_space.locally_compact ChartedSpace.locally_compact

/-- If a topological space admits an atlas with locally connected charts, then the space itself is
locally connected. -/
theorem ChartedSpace.locallyConnectedSpace [LocallyConnectedSpace H] : LocallyConnectedSpace M :=
  by
  let E : M → LocalHomeomorph M H := chart_at H
  refine'
    locallyConnectedSpace_of_connected_bases (fun x s => (E x).symm '' s)
      (fun x s => (IsOpen s ∧ E x x ∈ s ∧ IsConnected s) ∧ s ⊆ (E x).target) _ _
  · intro x
    simpa only [LocalHomeomorph.symm_map_nhds_eq, mem_chart_source] using
      ((LocallyConnectedSpace.open_connected_basis (E x x)).restrict_subset
            ((E x).open_target.mem_nhds (mem_chart_target H x))).map
        (E x).symm
  · rintro x s ⟨⟨-, -, hsconn⟩, hssubset⟩
    exact hsconn.is_preconnected.image _ ((E x).continuousOn_symm.mono hssubset)
#align charted_space.locally_connected_space ChartedSpace.locallyConnectedSpace

/-- If `M` is modelled on `H'` and `H'` is itself modelled on `H`, then we can consider `M` as being
modelled on `H`. -/
def ChartedSpace.comp (H : Type _) [TopologicalSpace H] (H' : Type _) [TopologicalSpace H']
    (M : Type _) [TopologicalSpace M] [ChartedSpace H H'] [ChartedSpace H' M] : ChartedSpace H M
    where
  atlas := image2 LocalHomeomorph.trans (atlas H' M) (atlas H H')
  chartAt := fun p : M => (chartAt H' p).trans (chartAt H (chartAt H' p p))
  mem_chart_source p := by simp only [mfld_simps]
  chart_mem_atlas p := ⟨chartAt H' p, chartAt H _, chart_mem_atlas H' p, chart_mem_atlas H _, rfl⟩
#align charted_space.comp ChartedSpace.comp

end

library_note "Manifold type tags"/-- For technical reasons we introduce two type tags:

* `model_prod H H'` is the same as `H × H'`;
* `model_pi H` is the same as `Π i, H i`, where `H : ι → Type*` and `ι` is a finite type.

In both cases the reason is the same, so we explain it only in the case of the product. A charted
space `M` with model `H` is a set of local charts from `M` to `H` covering the space. Every space is
registered as a charted space over itself, using the only chart `id`, in `manifold_model_space`. You
can also define a product of charted space `M` and `M'` (with model space `H × H'`) by taking the
products of the charts. Now, on `H × H'`, there are two charted space structures with model space
`H × H'` itself, the one coming from `manifold_model_space`, and the one coming from the product of
the two `manifold_model_space` on each component. They are equal, but not defeq (because the product
of `id` and `id` is not defeq to `id`), which is bad as we know. This expedient of renaming `H × H'`
solves this problem. -/

/-- Same thing as `H × H'` We introduce it for technical reasons,
see note [Manifold type tags]. -/
def ModelProd (H : Type _) (H' : Type _) :=
  H × H'
#align model_prod ModelProd

/-- Same thing as `Π i, H i` We introduce it for technical reasons,
see note [Manifold type tags]. -/
def ModelPi {ι : Type _} (H : ι → Type _) :=
  ∀ i, H i
#align model_pi ModelPi

section

attribute [local reducible] ModelProd

instance modelProdInhabited [Inhabited H] [Inhabited H'] : Inhabited (ModelProd H H') :=
  Prod.inhabited
#align model_prod_inhabited modelProdInhabited

instance (H : Type _) [TopologicalSpace H] (H' : Type _) [TopologicalSpace H'] :
    TopologicalSpace (ModelProd H H') :=
  Prod.topologicalSpace

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
-- Next lemma shows up often when dealing with derivatives, register it as simp.
@[simp, mfld_simps]
theorem modelProd_range_prod_id {H : Type _} {H' : Type _} {α : Type _} (f : H → α) :
    (range fun p : ModelProd H H' => (f p.1, p.2)) = range f ×ˢ (univ : Set H') := by
  rw [prod_range_univ_eq]
#align model_prod_range_prod_id modelProd_range_prod_id

end

section

variable {ι : Type _} {Hi : ι → Type _}

instance modelPiInhabited [∀ i, Inhabited (Hi i)] : Inhabited (ModelPi Hi) :=
  Pi.inhabited _
#align model_pi_inhabited modelPiInhabited

instance [∀ i, TopologicalSpace (Hi i)] : TopologicalSpace (ModelPi Hi) :=
  Pi.topologicalSpace

end

/-- The product of two charted spaces is naturally a charted space, with the canonical
construction of the atlas of product maps. -/
instance prodChartedSpace (H : Type _) [TopologicalSpace H] (M : Type _) [TopologicalSpace M]
    [ChartedSpace H M] (H' : Type _) [TopologicalSpace H'] (M' : Type _) [TopologicalSpace M']
    [ChartedSpace H' M'] : ChartedSpace (ModelProd H H') (M × M')
    where
  atlas := image2 LocalHomeomorph.prod (atlas H M) (atlas H' M')
  chartAt := fun x : M × M' => (chartAt H x.1).Prod (chartAt H' x.2)
  mem_chart_source x := ⟨mem_chart_source _ _, mem_chart_source _ _⟩
  chart_mem_atlas x := mem_image2_of_mem (chart_mem_atlas _ _) (chart_mem_atlas _ _)
#align prod_charted_space prodChartedSpace

section prodChartedSpace

variable [TopologicalSpace H] [TopologicalSpace M] [ChartedSpace H M] [TopologicalSpace H']
  [TopologicalSpace M'] [ChartedSpace H' M'] {x : M × M'}

@[simp, mfld_simps]
theorem prodChartedSpace_chartAt :
    chartAt (ModelProd H H') x = (chartAt H x.fst).Prod (chartAt H' x.snd) :=
  rfl
#align prod_charted_space_chart_at prodChartedSpace_chartAt

theorem chartedSpaceSelf_prod : prodChartedSpace H H H' H' = chartedSpaceSelf (H × H') :=
  by
  ext1
  · simp [prodChartedSpace, atlas]
  · ext1
    simp [chartAt_self_eq]
    rfl
#align charted_space_self_prod chartedSpaceSelf_prod

end prodChartedSpace

/-- The product of a finite family of charted spaces is naturally a charted space, with the
canonical construction of the atlas of finite product maps. -/
instance piChartedSpace {ι : Type _} [Fintype ι] (H : ι → Type _) [∀ i, TopologicalSpace (H i)]
    (M : ι → Type _) [∀ i, TopologicalSpace (M i)] [∀ i, ChartedSpace (H i) (M i)] :
    ChartedSpace (ModelPi H) (∀ i, M i)
    where
  atlas := LocalHomeomorph.pi '' Set.pi univ fun i => atlas (H i) (M i)
  chartAt f := LocalHomeomorph.pi fun i => chartAt (H i) (f i)
  mem_chart_source f i hi := mem_chart_source (H i) (f i)
  chart_mem_atlas f := mem_image_of_mem _ fun i hi => chart_mem_atlas (H i) (f i)
#align pi_charted_space piChartedSpace

@[simp, mfld_simps]
theorem piChartedSpace_chartAt {ι : Type _} [Fintype ι] (H : ι → Type _)
    [∀ i, TopologicalSpace (H i)] (M : ι → Type _) [∀ i, TopologicalSpace (M i)]
    [∀ i, ChartedSpace (H i) (M i)] (f : ∀ i, M i) :
    chartAt (ModelPi H) f = LocalHomeomorph.pi fun i => chartAt (H i) (f i) :=
  rfl
#align pi_charted_space_chart_at piChartedSpace_chartAt

end ChartedSpace

/-! ### Constructing a topology from an atlas -/

/-- Sometimes, one may want to construct a charted space structure on a space which does not yet
have a topological structure, where the topology would come from the charts. For this, one needs
charts that are only local equivs, and continuity properties for their composition.
This is formalised in `charted_space_core`. -/
@[nolint has_nonempty_instance]
structure ChartedSpaceCore (H : Type _) [TopologicalSpace H] (M : Type _) where
  atlas : Set (LocalEquiv M H)
  chartAt : M → LocalEquiv M H
  mem_chart_source : ∀ x, x ∈ (chart_at x).source
  chart_mem_atlas : ∀ x, chart_at x ∈ atlas
  open_source : ∀ e e' : LocalEquiv M H, e ∈ atlas → e' ∈ atlas → IsOpen (e.symm.trans e').source
  continuous_toFun :
    ∀ e e' : LocalEquiv M H,
      e ∈ atlas → e' ∈ atlas → ContinuousOn (e.symm.trans e') (e.symm.trans e').source
#align charted_space_core ChartedSpaceCore

namespace ChartedSpaceCore

variable [TopologicalSpace H] (c : ChartedSpaceCore H M) {e : LocalEquiv M H}

/-- Topology generated by a set of charts on a Type. -/
protected def toTopologicalSpace : TopologicalSpace M :=
  TopologicalSpace.generateFrom <|
    ⋃ (e : LocalEquiv M H) (he : e ∈ c.atlas) (s : Set H) (s_open : IsOpen s), {e ⁻¹' s ∩ e.source}
#align charted_space_core.to_topological_space ChartedSpaceCore.toTopologicalSpace

theorem open_source' (he : e ∈ c.atlas) : is_open[c.toTopologicalSpace] e.source :=
  by
  apply TopologicalSpace.GenerateOpen.basic
  simp only [exists_prop, mem_Union, mem_singleton_iff]
  refine' ⟨e, he, univ, isOpen_univ, _⟩
  simp only [Set.univ_inter, Set.preimage_univ]
#align charted_space_core.open_source' ChartedSpaceCore.open_source'

theorem open_target (he : e ∈ c.atlas) : IsOpen e.target :=
  by
  have E : e.target ∩ e.symm ⁻¹' e.source = e.target :=
    subset.antisymm (inter_subset_left _ _) fun x hx =>
      ⟨hx, LocalEquiv.target_subset_preimage_source _ hx⟩
  simpa [LocalEquiv.trans_source, E] using c.open_source e e he he
#align charted_space_core.open_target ChartedSpaceCore.open_target

/-- An element of the atlas in a charted space without topology becomes a local homeomorphism
for the topology constructed from this atlas. The `local_homeomorph` version is given in this
definition. -/
protected def localHomeomorph (e : LocalEquiv M H) (he : e ∈ c.atlas) :
    @LocalHomeomorph M H c.toTopologicalSpace _ :=
  { e with
    open_source := by convert c.open_source' he
    open_target := by convert c.open_target he
    continuous_toFun := by
      letI : TopologicalSpace M := c.to_topological_space
      rw [continuousOn_open_iff (c.open_source' he)]
      intro s s_open
      rw [inter_comm]
      apply TopologicalSpace.GenerateOpen.basic
      simp only [exists_prop, mem_Union, mem_singleton_iff]
      exact ⟨e, he, ⟨s, s_open, rfl⟩⟩
    continuous_invFun := by
      letI : TopologicalSpace M := c.to_topological_space
      apply continuousOn_open_of_generateFrom (c.open_target he)
      intro t ht
      simp only [exists_prop, mem_Union, mem_singleton_iff] at ht
      rcases ht with ⟨e', e'_atlas, s, s_open, ts⟩
      rw [ts]
      let f := e.symm.trans e'
      have : IsOpen (f ⁻¹' s ∩ f.source) := by
        simpa [inter_comm] using
          (continuousOn_open_iff (c.open_source e e' he e'_atlas)).1
            (c.continuous_to_fun e e' he e'_atlas) s s_open
      have A :
        e' ∘ e.symm ⁻¹' s ∩ (e.target ∩ e.symm ⁻¹' e'.source) =
          e.target ∩ (e' ∘ e.symm ⁻¹' s ∩ e.symm ⁻¹' e'.source) :=
        by
        rw [← inter_assoc, ← inter_assoc]
        congr 1
        exact inter_comm _ _
      simpa [LocalEquiv.trans_source, preimage_inter, preimage_comp.symm, A] using this }
#align charted_space_core.local_homeomorph ChartedSpaceCore.localHomeomorph

/-- Given a charted space without topology, endow it with a genuine charted space structure with
respect to the topology constructed from the atlas. -/
def toChartedSpace : @ChartedSpace H _ M c.toTopologicalSpace
    where
  atlas := ⋃ (e : LocalEquiv M H) (he : e ∈ c.atlas), {c.LocalHomeomorph e he}
  chartAt x := c.LocalHomeomorph (c.chartAt x) (c.chart_mem_atlas x)
  mem_chart_source x := c.mem_chart_source x
  chart_mem_atlas x := by
    simp only [mem_Union, mem_singleton_iff]
    exact ⟨c.chart_at x, c.chart_mem_atlas x, rfl⟩
#align charted_space_core.to_charted_space ChartedSpaceCore.toChartedSpace

end ChartedSpaceCore

/-! ### Charted space with a given structure groupoid -/

section HasGroupoid

variable [TopologicalSpace H] [TopologicalSpace M] [ChartedSpace H M]

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`compatible] [] -/
/-- A charted space has an atlas in a groupoid `G` if the change of coordinates belong to the
groupoid -/
class HasGroupoid {H : Type _} [TopologicalSpace H] (M : Type _) [TopologicalSpace M]
  [ChartedSpace H M] (G : StructureGroupoid H) : Prop where
  compatible : ∀ {e e' : LocalHomeomorph M H}, e ∈ atlas H M → e' ∈ atlas H M → e.symm ≫ₕ e' ∈ G
#align has_groupoid HasGroupoid

/-- Reformulate in the `structure_groupoid` namespace the compatibility condition of charts in a
charted space admitting a structure groupoid, to make it more easily accessible with dot
notation. -/
theorem StructureGroupoid.compatible {H : Type _} [TopologicalSpace H] (G : StructureGroupoid H)
    {M : Type _} [TopologicalSpace M] [ChartedSpace H M] [HasGroupoid M G]
    {e e' : LocalHomeomorph M H} (he : e ∈ atlas H M) (he' : e' ∈ atlas H M) : e.symm ≫ₕ e' ∈ G :=
  HasGroupoid.compatible G he he'
#align structure_groupoid.compatible StructureGroupoid.compatible

theorem hasGroupoid_of_le {G₁ G₂ : StructureGroupoid H} (h : HasGroupoid M G₁) (hle : G₁ ≤ G₂) :
    HasGroupoid M G₂ :=
  ⟨fun e e' he he' => hle (h.compatible he he')⟩
#align has_groupoid_of_le hasGroupoid_of_le

theorem hasGroupoid_of_pregroupoid (PG : Pregroupoid H)
    (h :
      ∀ {e e' : LocalHomeomorph M H},
        e ∈ atlas H M → e' ∈ atlas H M → PG.property (e.symm ≫ₕ e') (e.symm ≫ₕ e').source) :
    HasGroupoid M PG.groupoid :=
  ⟨fun e e' he he' => mem_groupoid_of_pregroupoid.mpr ⟨h he he', h he' he⟩⟩
#align has_groupoid_of_pregroupoid hasGroupoid_of_pregroupoid

/-- The trivial charted space structure on the model space is compatible with any groupoid -/
instance hasGroupoid_model_space (H : Type _) [TopologicalSpace H] (G : StructureGroupoid H) :
    HasGroupoid H G
    where compatible e e' he he' :=
    by
    replace he : e ∈ atlas H H := he
    replace he' : e' ∈ atlas H H := he'
    rw [chartedSpaceSelf_atlas] at he he'
    simp [he, he', StructureGroupoid.id_mem]
#align has_groupoid_model_space hasGroupoid_model_space

/-- Any charted space structure is compatible with the groupoid of all local homeomorphisms -/
instance hasGroupoid_continuousGroupoid : HasGroupoid M (continuousGroupoid H) :=
  ⟨by
    intro e e' he he'
    rw [continuousGroupoid, mem_groupoid_of_pregroupoid]
    simp only [and_self_iff]⟩
#align has_groupoid_continuous_groupoid hasGroupoid_continuousGroupoid

section MaximalAtlas

variable (M) (G : StructureGroupoid H)

/-- Given a charted space admitting a structure groupoid, the maximal atlas associated to this
structure groupoid is the set of all local charts that are compatible with the atlas, i.e., such
that changing coordinates with an atlas member gives an element of the groupoid. -/
def StructureGroupoid.maximalAtlas : Set (LocalHomeomorph M H) :=
  { e | ∀ e' ∈ atlas H M, e.symm ≫ₕ e' ∈ G ∧ e'.symm ≫ₕ e ∈ G }
#align structure_groupoid.maximal_atlas StructureGroupoid.maximalAtlas

variable {M}

/-- The elements of the atlas belong to the maximal atlas for any structure groupoid -/
theorem StructureGroupoid.subset_maximalAtlas [HasGroupoid M G] : atlas H M ⊆ G.maximalAtlas M :=
  fun e he e' he' => ⟨G.compatible he he', G.compatible he' he⟩
#align structure_groupoid.subset_maximal_atlas StructureGroupoid.subset_maximalAtlas

theorem StructureGroupoid.chart_mem_maximalAtlas [HasGroupoid M G] (x : M) :
    chartAt H x ∈ G.maximalAtlas M :=
  G.subset_maximalAtlas (chart_mem_atlas H x)
#align structure_groupoid.chart_mem_maximal_atlas StructureGroupoid.chart_mem_maximalAtlas

variable {G}

theorem mem_maximalAtlas_iff {e : LocalHomeomorph M H} :
    e ∈ G.maximalAtlas M ↔ ∀ e' ∈ atlas H M, e.symm ≫ₕ e' ∈ G ∧ e'.symm ≫ₕ e ∈ G :=
  Iff.rfl
#align mem_maximal_atlas_iff mem_maximalAtlas_iff

/-- Changing coordinates between two elements of the maximal atlas gives rise to an element
of the structure groupoid. -/
theorem StructureGroupoid.compatible_of_mem_maximalAtlas {e e' : LocalHomeomorph M H}
    (he : e ∈ G.maximalAtlas M) (he' : e' ∈ G.maximalAtlas M) : e.symm ≫ₕ e' ∈ G :=
  by
  apply G.locality fun x hx => _
  set f := chart_at H (e.symm x) with hf
  let s := e.target ∩ e.symm ⁻¹' f.source
  have hs : IsOpen s := by
    apply e.symm.continuous_to_fun.preimage_open_of_open <;> apply open_source
  have xs : x ∈ s := by
    dsimp at hx
    simp [s, hx]
  refine' ⟨s, hs, xs, _⟩
  have A : e.symm ≫ₕ f ∈ G := (mem_maximalAtlas_iff.1 he f (chart_mem_atlas _ _)).1
  have B : f.symm ≫ₕ e' ∈ G := (mem_maximalAtlas_iff.1 he' f (chart_mem_atlas _ _)).2
  have C : (e.symm ≫ₕ f) ≫ₕ f.symm ≫ₕ e' ∈ G := G.trans A B
  have D : (e.symm ≫ₕ f) ≫ₕ f.symm ≫ₕ e' ≈ (e.symm ≫ₕ e').restr s :=
    calc
      (e.symm ≫ₕ f) ≫ₕ f.symm ≫ₕ e' = e.symm ≫ₕ (f ≫ₕ f.symm) ≫ₕ e' := by simp [trans_assoc]
      _ ≈ e.symm ≫ₕ of_set f.source f.open_source ≫ₕ e' := by
        simp [eq_on_source.trans', trans_self_symm]
      _ ≈ (e.symm ≫ₕ of_set f.source f.open_source) ≫ₕ e' := by simp [trans_assoc]
      _ ≈ e.symm.restr s ≫ₕ e' := by simp [s, trans_of_set']
      _ ≈ (e.symm ≫ₕ e').restr s := by simp [restr_trans]

  exact G.eq_on_source C (Setoid.symm D)
#align structure_groupoid.compatible_of_mem_maximal_atlas StructureGroupoid.compatible_of_mem_maximalAtlas

variable (G)

/-- In the model space, the identity is in any maximal atlas. -/
theorem StructureGroupoid.id_mem_maximalAtlas : LocalHomeomorph.refl H ∈ G.maximalAtlas H :=
  G.subset_maximalAtlas <| by simp
#align structure_groupoid.id_mem_maximal_atlas StructureGroupoid.id_mem_maximalAtlas

/-- In the model space, any element of the groupoid is in the maximal atlas. -/
theorem StructureGroupoid.mem_maximalAtlas_of_mem_groupoid {f : LocalHomeomorph H H} (hf : f ∈ G) :
    f ∈ G.maximalAtlas H := by
  rintro e (rfl : e = LocalHomeomorph.refl H)
  exact ⟨G.trans (G.symm hf) G.id_mem, G.trans (G.symm G.id_mem) hf⟩
#align structure_groupoid.mem_maximal_atlas_of_mem_groupoid StructureGroupoid.mem_maximalAtlas_of_mem_groupoid

end MaximalAtlas

section Singleton

variable {α : Type _} [TopologicalSpace α]

namespace LocalHomeomorph

variable (e : LocalHomeomorph α H)

/-- If a single local homeomorphism `e` from a space `α` into `H` has source covering the whole
space `α`, then that local homeomorphism induces an `H`-charted space structure on `α`.
(This condition is equivalent to `e` being an open embedding of `α` into `H`; see
`open_embedding.singleton_charted_space`.) -/
def singletonChartedSpace (h : e.source = Set.univ) : ChartedSpace H α
    where
  atlas := {e}
  chartAt _ := e
  mem_chart_source _ := by simp only [h, mfld_simps]
  chart_mem_atlas _ := by tauto
#align local_homeomorph.singleton_charted_space LocalHomeomorph.singletonChartedSpace

@[simp, mfld_simps]
theorem singletonChartedSpace_chartAt_eq (h : e.source = Set.univ) {x : α} :
    @chartAt H _ α _ (e.singletonChartedSpace h) x = e :=
  rfl
#align local_homeomorph.singleton_charted_space_chart_at_eq LocalHomeomorph.singletonChartedSpace_chartAt_eq

theorem singletonChartedSpace_chartAt_source (h : e.source = Set.univ) {x : α} :
    (@chartAt H _ α _ (e.singletonChartedSpace h) x).source = Set.univ :=
  h
#align local_homeomorph.singleton_charted_space_chart_at_source LocalHomeomorph.singletonChartedSpace_chartAt_source

theorem singletonChartedSpace_mem_atlas_eq (h : e.source = Set.univ) (e' : LocalHomeomorph α H)
    (h' : e' ∈ (e.singletonChartedSpace h).atlas) : e' = e :=
  h'
#align local_homeomorph.singleton_charted_space_mem_atlas_eq LocalHomeomorph.singletonChartedSpace_mem_atlas_eq

/-- Given a local homeomorphism `e` from a space `α` into `H`, if its source covers the whole
space `α`, then the induced charted space structure on `α` is `has_groupoid G` for any structure
groupoid `G` which is closed under restrictions. -/
theorem singleton_hasGroupoid (h : e.source = Set.univ) (G : StructureGroupoid H)
    [ClosedUnderRestriction G] : @HasGroupoid _ _ _ _ (e.singletonChartedSpace h) G :=
  {
    compatible := by
      intro e' e'' he' he''
      rw [e.singleton_charted_space_mem_atlas_eq h e' he']
      rw [e.singleton_charted_space_mem_atlas_eq h e'' he'']
      refine' G.eq_on_source _ e.trans_symm_self
      have hle : idRestrGroupoid ≤ G := (closedUnderRestriction_iff_id_le G).mp (by assumption)
      exact structure_groupoid.le_iff.mp hle _ (idRestrGroupoid_mem _) }
#align local_homeomorph.singleton_has_groupoid LocalHomeomorph.singleton_hasGroupoid

end LocalHomeomorph

namespace OpenEmbedding

variable [Nonempty α]

/-- An open embedding of `α` into `H` induces an `H`-charted space structure on `α`.
See `local_homeomorph.singleton_charted_space` -/
def singletonChartedSpace {f : α → H} (h : OpenEmbedding f) : ChartedSpace H α :=
  (h.toLocalHomeomorph f).singletonChartedSpace (by simp)
#align open_embedding.singleton_charted_space OpenEmbedding.singletonChartedSpace

theorem singletonChartedSpace_chartAt_eq {f : α → H} (h : OpenEmbedding f) {x : α} :
    ⇑(@chartAt H _ α _ h.singletonChartedSpace x) = f :=
  rfl
#align open_embedding.singleton_charted_space_chart_at_eq OpenEmbedding.singletonChartedSpace_chartAt_eq

theorem singleton_hasGroupoid {f : α → H} (h : OpenEmbedding f) (G : StructureGroupoid H)
    [ClosedUnderRestriction G] : @HasGroupoid _ _ _ _ h.singletonChartedSpace G :=
  (h.toLocalHomeomorph f).singleton_hasGroupoid (by simp) G
#align open_embedding.singleton_has_groupoid OpenEmbedding.singleton_hasGroupoid

end OpenEmbedding

end Singleton

namespace TopologicalSpace.Opens

open TopologicalSpace

variable (G : StructureGroupoid H) [HasGroupoid M G]

variable (s : Opens M)

/-- An open subset of a charted space is naturally a charted space. -/
instance : ChartedSpace H s
    where
  atlas := ⋃ x : s, {@LocalHomeomorph.subtypeRestr _ _ _ _ (chartAt H x.1) s ⟨x⟩}
  chartAt x := @LocalHomeomorph.subtypeRestr _ _ _ _ (chartAt H x.1) s ⟨x⟩
  mem_chart_source x := by
    simp only [mfld_simps]
    exact mem_chart_source H x.1
  chart_mem_atlas x := by
    simp only [mem_Union, mem_singleton_iff]
    use x

/-- If a groupoid `G` is `closed_under_restriction`, then an open subset of a space which is
`has_groupoid G` is naturally `has_groupoid G`. -/
instance [ClosedUnderRestriction G] : HasGroupoid s G
    where compatible := by
    rintro e e' ⟨_, ⟨x, hc⟩, he⟩ ⟨_, ⟨x', hc'⟩, he'⟩
    haveI : Nonempty s := ⟨x⟩
    simp only [hc.symm, mem_singleton_iff, Subtype.val_eq_coe] at he
    simp only [hc'.symm, mem_singleton_iff, Subtype.val_eq_coe] at he'
    rw [he, he']
    convert G.eq_on_source _
        (subtype_restr_symm_trans_subtype_restr s (chart_at H x) (chart_at H x'))
    apply closed_under_restriction'
    · exact G.compatible (chart_mem_atlas H x) (chart_mem_atlas H x')
    · exact preimage_open_of_open_symm (chart_at H x) s.2

end TopologicalSpace.Opens

/-! ### Structomorphisms -/

/-- A `G`-diffeomorphism between two charted spaces is a homeomorphism which, when read in the
charts, belongs to `G`. We avoid the word diffeomorph as it is too related to the smooth category,
and use structomorph instead. -/
@[nolint has_nonempty_instance]
structure Structomorph (G : StructureGroupoid H) (M : Type _) (M' : Type _) [TopologicalSpace M]
  [TopologicalSpace M'] [ChartedSpace H M] [ChartedSpace H M'] extends Homeomorph M M' where
  mem_groupoid :
    ∀ c : LocalHomeomorph M H,
      ∀ c' : LocalHomeomorph M' H,
        c ∈ atlas H M → c' ∈ atlas H M' → c.symm ≫ₕ to_homeomorph.toLocalHomeomorph ≫ₕ c' ∈ G
#align structomorph Structomorph

variable [TopologicalSpace M'] [TopologicalSpace M''] {G : StructureGroupoid H} [ChartedSpace H M']
  [ChartedSpace H M'']

/-- The identity is a diffeomorphism of any charted space, for any groupoid. -/
def Structomorph.refl (M : Type _) [TopologicalSpace M] [ChartedSpace H M] [HasGroupoid M G] :
    Structomorph G M M :=
  { Homeomorph.refl M with
    mem_groupoid := fun c c' hc hc' =>
      by
      change LocalHomeomorph.symm c ≫ₕ LocalHomeomorph.refl M ≫ₕ c' ∈ G
      rw [LocalHomeomorph.refl_trans]
      exact HasGroupoid.compatible G hc hc' }
#align structomorph.refl Structomorph.refl

/-- The inverse of a structomorphism is a structomorphism -/
def Structomorph.symm (e : Structomorph G M M') : Structomorph G M' M :=
  { e.toHomeomorph.symm with
    mem_groupoid := by
      intro c c' hc hc'
      have : (c'.symm ≫ₕ e.to_homeomorph.to_local_homeomorph ≫ₕ c).symm ∈ G :=
        G.symm (e.mem_groupoid c' c hc' hc)
      rwa [trans_symm_eq_symm_trans_symm, trans_symm_eq_symm_trans_symm, symm_symm, trans_assoc] at
        this }
#align structomorph.symm Structomorph.symm

/-- The composition of structomorphisms is a structomorphism -/
def Structomorph.trans (e : Structomorph G M M') (e' : Structomorph G M' M'') :
    Structomorph G M M'' :=
  {/- Let c and c' be two charts in M and M''. We want to show that e' ∘ e is smooth in these
          charts, around any point x. For this, let y = e (c⁻¹ x), and consider a chart g around y.
          Then g ∘ e ∘ c⁻¹ and c' ∘ e' ∘ g⁻¹ are both smooth as e and e' are structomorphisms, so
          their composition is smooth, and it coincides with c' ∘ e' ∘ e ∘ c⁻¹ around x. -/
      -- define the atlas g around y
      Homeomorph.trans
      e.toHomeomorph e'.toHomeomorph with
    mem_groupoid := by
      intro c c' hc hc'
      refine' G.locality fun x hx => _
      let f₁ := e.to_homeomorph.to_local_homeomorph
      let f₂ := e'.to_homeomorph.to_local_homeomorph
      let f := (e.to_homeomorph.trans e'.to_homeomorph).toLocalHomeomorph
      have feq : f = f₁ ≫ₕ f₂ := Homeomorph.trans_toLocalHomeomorph _ _
      let y := (c.symm ≫ₕ f₁) x
      let g := chart_at H y
      have hg₁ := chart_mem_atlas H y
      have hg₂ := mem_chart_source H y
      let s := (c.symm ≫ₕ f₁).source ∩ c.symm ≫ₕ f₁ ⁻¹' g.source
      have open_s : IsOpen s := by
        apply (c.symm ≫ₕ f₁).continuous_toFun.preimage_open_of_open <;> apply open_source
      have : x ∈ s := by
        constructor
        · simp only [trans_source, preimage_univ, inter_univ, Homeomorph.toLocalHomeomorph_source]
          rw [trans_source] at hx
          exact hx.1
        · exact hg₂
      refine' ⟨s, open_s, this, _⟩
      let F₁ := (c.symm ≫ₕ f₁ ≫ₕ g) ≫ₕ g.symm ≫ₕ f₂ ≫ₕ c'
      have A : F₁ ∈ G := G.trans (e.mem_groupoid c g hc hg₁) (e'.mem_groupoid g c' hg₁ hc')
      let F₂ := (c.symm ≫ₕ f ≫ₕ c').restr s
      have : F₁ ≈ F₂ :=
        calc
          F₁ ≈ c.symm ≫ₕ f₁ ≫ₕ (g ≫ₕ g.symm) ≫ₕ f₂ ≫ₕ c' := by simp [F₁, trans_assoc]
          _ ≈ c.symm ≫ₕ f₁ ≫ₕ of_set g.source g.open_source ≫ₕ f₂ ≫ₕ c' := by
            simp [eq_on_source.trans', trans_self_symm g]
          _ ≈ ((c.symm ≫ₕ f₁) ≫ₕ of_set g.source g.open_source) ≫ₕ f₂ ≫ₕ c' := by simp [trans_assoc]
          _ ≈ (c.symm ≫ₕ f₁).restr s ≫ₕ f₂ ≫ₕ c' := by simp [s, trans_of_set']
          _ ≈ ((c.symm ≫ₕ f₁) ≫ₕ f₂ ≫ₕ c').restr s := by simp [restr_trans]
          _ ≈ (c.symm ≫ₕ (f₁ ≫ₕ f₂) ≫ₕ c').restr s := by simp [eq_on_source.restr, trans_assoc]
          _ ≈ F₂ := by simp [F₂, feq]

      have : F₂ ∈ G := G.eq_on_source A (Setoid.symm this)
      exact this }
#align structomorph.trans Structomorph.trans

end HasGroupoid


import algebra.group data.set data.equiv

def is_add_group_hom {α : Type*} {β : Type*} [add_group α] [add_group β] (f : α → β) : Prop :=
@is_group_hom (multiplicative α) (multiplicative β) _ _ f

attribute [class] is_add_group_hom

namespace is_add_group_hom

variables {α : Type*} {β : Type*} [add_group α] [add_group β] (f : α → β) [hf : is_add_group_hom f]

theorem mk (H : ∀ x y, f (x + y) = f x + f y) : is_add_group_hom f :=
⟨H⟩

theorem add (x y) : f (x + y) = f x + f y :=
@is_group_hom.mul (multiplicative α) (multiplicative β) _ _ f hf x y

theorem zero : f 0 = 0 :=
@is_group_hom.one (multiplicative α) (multiplicative β) _ _ f hf

theorem neg (x) : f (-x) = -f x :=
@is_group_hom.inv (multiplicative α) (multiplicative β) _ _ f hf x

def ker : set α :=
{ x | f x = 0 }

end is_add_group_hom

theorem three (A B C A' B' C' : Type*)
  [add_comm_group A] [add_comm_group A']
  [add_comm_group B] [add_comm_group B']
  [add_comm_group C] [add_comm_group C']
  (ab : A → B) [is_add_group_hom ab]
  (bc : B → C) [is_add_group_hom bc]
  (Habc : set.range ab = is_add_group_hom.ker bc)
  (fa : A ≃ A') [is_add_group_hom fa]
  (fb : B ≃ B') [is_add_group_hom fb]
  (fc : C ≃ C') [is_add_group_hom fc]

  (ab' : A' → B') [is_add_group_hom ab']
  (bc' : B' → C') [is_add_group_hom bc']
  (H1 : ∀ a, fb (ab a) = ab' (fa a))
  (H2 : ∀ b, fc (bc b) = bc' (fb b)) :

  set.range ab' = is_add_group_hom.ker bc' :=
begin
  apply set.ext,
  intro b',
  split,
  { intro hb',
    cases hb' with a' ha',
    simp [is_add_group_hom.ker],
    let a := fa.symm a',
    have ha : fa a = a',
    { simp [a] },
    rw [← ha', ← ha, ← H1, ← H2],
    have H3 : ab a ∈ is_add_group_hom.ker bc,
    { rw ← Habc, existsi a, simp },
    simp [is_add_group_hom.ker] at H3 ⊢,
    rw H3,
    apply is_add_group_hom.zero },
  { intro hb',
    let b := fb.symm b',
    have hb : fb b = b',
    { simp [b] },
    simp [is_add_group_hom.ker] at hb',
    rw [← hb, ← H2, ← is_add_group_hom.zero fc] at hb',
    replace hb' := congr_arg fc.symm hb',
    simp at hb',
    have H3 : b ∈ set.range ab,
    { rwa Habc },
    cases H3 with a ha,
    existsi fa a,
    rw ← H1,
    simp [ha] }
end


import ideal
import data.finset.basic
import tactic
import group_theory.group_action.basic

open_locale big_operators

variables {R : Type} [comm_ring R]
variable S : finset R

def ideal_gen_by  : ideal R := {
  carrier := {x : R | ∃ I : S → R, x = ∑ a : S, ((I a) * a : R)  },

  zero_mem' :=
  begin
    simp only [finset.univ_eq_attach, set.mem_set_of_eq],
    use 0,
    simp only [pi.zero_apply, zero_mul, finset.sum_const_zero],
  end,
  add_mem' :=
    begin
      simp,
      intros x y f hx g hy,
      use f + g,
      simp [hx, hy],
      ring,
      rw finset.sum_add_distrib,
    end,
  smul_mem' :=
    begin
      intros r x h,
      cases h with f hx,
      let rf : S → R := λ s, r*f(s),
      use rf,
      rw hx,
      rw [←smul_eq_mul, finset.smul_sum],
      apply finset.sum_congr rfl,
      intros a ha,
      rw [smul_eq_mul, mul_assoc],
    end
}

def fingen (I : ideal R) : Prop := ∃ S : finset R, I = ideal_gen_by S

--- See Brendan Note in ideal.lean
def add_subgroup_of_ideal (I : ideal R) : add_subgroup R := {
  carrier := I.carrier,
  zero_mem' := I.zero_mem',
  add_mem' := I.add_mem',
  neg_mem' := λ x h, by { have := I.smul_mem' (-1) h, simp at this, assumption }
}
---

lemma linear_combinations_in_ideal (I : ideal R) (S : finset R) (f: S → R): (∀ x, x ∈ S → x ∈ I) → ∑ a : S, (f a) * a ∈ I :=
begin
  intro h,
  apply add_subgroup.sum_mem (add_subgroup_of_ideal I),
  simp,
  intro,
  apply I.smul_mem',
  apply h,
  cases c,
  exact c_property,
end

lemma gen_by_subset_is_subset (I : ideal R) (S : finset R) :(∀ x, x ∈ S → x ∈ I) → ideal_gen_by S ⊆ I :=
begin
  intros h x g,
  simp [ideal_gen_by] at g,
  cases g with coeffs g,
  subst g,
  apply linear_combinations_in_ideal,
  assumption
end

def indicator_of (P : set R) [decidable_pred P] : R → R :=
  λ x, if P x then 1 else 0

theorem sum_over_subtype_is_sum_in {α G : Type} [decidable_eq α] [add_comm_monoid G] (S : finset α) (f : α → G) (g : S → G)
  : (∀ x (h : x ∈ S), g ⟨x, h⟩ = f x) → ∑ x : S, g x = ∑ x : α in S, f x :=
begin
  revert f g,
  apply finset.induction_on S,
  { simp },
  { intros a s h ih f g hfeqg,
    dsimp [coe_sort],
    rw finset.attach_insert,
    rw finset.sum_insert,
    { rw finset.sum_insert h,
      rw hfeqg,
      rw ← ih f (λ x : s, g ⟨x.val, finset.mem_insert_of_mem x.property⟩),
      { dsimp [finset.sum], apply congr_arg, apply congr_arg,
        rw @finset.image_val_of_inj_on {x // x ∈ s} {x // x ∈ insert a s},
        { simp, congr },
        { intros x hx y hy heq, cases x, cases y,
          simp at heq ⊢, assumption } },
      { intros, simp, apply_assumption } },
    { rw @finset.mem_image {x // x ∈ s} {x // x ∈ insert a s},
      intro h', cases h' with w h', cases h' with w' h', cases w,
      simp at h', rw h' at w_property, contradiction } }
end

lemma finset_subset_of_ideal_gen_by [decidable_eq R] (S : finset R) : ∀ x : R, x ∈ S → x ∈ ideal_gen_by S :=
begin
  intros x h,
  existsi (λ y : S, indicator_of (λ z, z = x) y.val),
  rewrite sum_over_subtype_is_sum_in S (λ y, indicator_of (λ z, z = x) y * y),
  { rw [← finset.insert_erase h, finset.sum_insert (finset.not_mem_erase x S)],
    rw finset.sum_eq_zero,
    { simp [indicator_of] },
    { intros, simp [indicator_of], intro, simp at H, cases H, contradiction } },
  { simp }
end

lemma gen_by_of_subset_is_subset [decidable_eq R] (S S' : finset R) : S ⊆ S' → ideal_gen_by S ⊆ ideal_gen_by S' :=
begin
  intro,
  apply gen_by_subset_is_subset (ideal_gen_by S') S,
  intros y hy, apply finset_subset_of_ideal_gen_by, apply_assumption, assumption
end


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

! This file was ported from Lean 3 source module linear_algebra.matrix.pos_def
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Matrix.Spectrum
import Mathbin.LinearAlgebra.QuadraticForm.Basic

/-! # Positive Definite Matrices
This file defines positive (semi)definite matrices and connects the notion to positive definiteness
of quadratic forms.
## Main definition
 * `matrix.pos_def` : a matrix `M : matrix n n 𝕜` is positive definite if it is hermitian and `xᴴMx`
   is greater than zero for all nonzero `x`.
 * `matrix.pos_semidef` : a matrix `M : matrix n n 𝕜` is positive semidefinite if it is hermitian
   and `xᴴMx` is nonnegative for all `x`.
-/

namespace Matrix

variable {𝕜 : Type _} [IsROrC 𝕜] {m n : Type _} [Fintype m] [Fintype n]

open Matrix

/-- A matrix `M : matrix n n 𝕜` is positive definite if it is hermitian
   and `xᴴMx` is greater than zero for all nonzero `x`. -/
def PosDef (M : Matrix n n 𝕜) :=
  M.IsHermitian ∧ ∀ x : n → 𝕜, x ≠ 0 → 0 < IsROrC.re (dotProduct (star x) (M.mulVec x))
#align matrix.pos_def Matrix.PosDef

theorem PosDef.isHermitian {M : Matrix n n 𝕜} (hM : M.PosDef) : M.IsHermitian :=
  hM.1
#align matrix.pos_def.is_hermitian Matrix.PosDef.isHermitian

/-- A matrix `M : matrix n n 𝕜` is positive semidefinite if it is hermitian
   and `xᴴMx` is nonnegative for all `x`. -/
def PosSemidef (M : Matrix n n 𝕜) :=
  M.IsHermitian ∧ ∀ x : n → 𝕜, 0 ≤ IsROrC.re (dotProduct (star x) (M.mulVec x))
#align matrix.pos_semidef Matrix.PosSemidef

theorem PosDef.posSemidef {M : Matrix n n 𝕜} (hM : M.PosDef) : M.PosSemidef :=
  by
  refine' ⟨hM.1, _⟩
  intro x
  by_cases hx : x = 0
  · simp only [hx, zero_dot_product, star_zero, IsROrC.zero_re']
  · exact le_of_lt (hM.2 x hx)
#align matrix.pos_def.pos_semidef Matrix.PosDef.posSemidef

theorem PosSemidef.submatrix {M : Matrix n n 𝕜} (hM : M.PosSemidef) (e : m ≃ n) :
    (M.submatrix e e).PosSemidef :=
  by
  refine' ⟨hM.1.submatrix e, fun x => _⟩
  have : (M.submatrix (⇑e) ⇑e).mulVec x = (M.mul_vec fun i : n => x (e.symm i)) ∘ e :=
    by
    ext i
    dsimp only [(· ∘ ·), mul_vec, dot_product]
    rw [Finset.sum_bij' (fun i _ => e i) _ _ fun i _ => e.symm i] <;>
      simp only [eq_self_iff_true, imp_true_iff, Equiv.symm_apply_apply, Finset.mem_univ,
        submatrix_apply, Equiv.apply_symm_apply]
  rw [this]
  convert hM.2 fun i => x (e.symm i) using 3
  unfold dot_product
  rw [Finset.sum_bij' (fun i _ => e i) _ _ fun i _ => e.symm i] <;>
    simp only [eq_self_iff_true, imp_true_iff, Equiv.symm_apply_apply, Finset.mem_univ,
      submatrix_apply, Equiv.apply_symm_apply, Pi.star_apply]
#align matrix.pos_semidef.submatrix Matrix.PosSemidef.submatrix

@[simp]
theorem posSemidef_submatrix_equiv {M : Matrix n n 𝕜} (e : m ≃ n) :
    (M.submatrix e e).PosSemidef ↔ M.PosSemidef :=
  ⟨fun h => by simpa using h.submatrix e.symm, fun h => h.submatrix _⟩
#align matrix.pos_semidef_submatrix_equiv Matrix.posSemidef_submatrix_equiv

theorem PosDef.transpose {M : Matrix n n 𝕜} (hM : M.PosDef) : Mᵀ.PosDef :=
  by
  refine' ⟨is_hermitian.transpose hM.1, fun x hx => _⟩
  convert hM.2 (star x) (star_ne_zero.2 hx) using 2
  rw [mul_vec_transpose, Matrix.dotProduct_mulVec, star_star, dot_product_comm]
#align matrix.pos_def.transpose Matrix.PosDef.transpose

theorem posDef_of_toQuadraticForm' [DecidableEq n] {M : Matrix n n ℝ} (hM : M.IsSymm)
    (hMq : M.toQuadraticForm'.PosDef) : M.PosDef :=
  by
  refine' ⟨hM, fun x hx => _⟩
  simp only [to_quadratic_form', QuadraticForm.PosDef, BilinForm.toQuadraticForm_apply,
    Matrix.toBilin'_apply'] at hMq
  apply hMq x hx
#align matrix.pos_def_of_to_quadratic_form' Matrix.posDef_of_toQuadraticForm'

theorem posDefToQuadraticForm' [DecidableEq n] {M : Matrix n n ℝ} (hM : M.PosDef) :
    M.toQuadraticForm'.PosDef := by
  intro x hx
  simp only [to_quadratic_form', BilinForm.toQuadraticForm_apply, Matrix.toBilin'_apply']
  apply hM.2 x hx
#align matrix.pos_def_to_quadratic_form' Matrix.posDefToQuadraticForm'

namespace PosDef

variable {M : Matrix n n ℝ} (hM : M.PosDef)

include hM

theorem det_pos [DecidableEq n] : 0 < det M :=
  by
  rw [hM.is_hermitian.det_eq_prod_eigenvalues]
  apply Finset.prod_pos
  intro i _
  rw [hM.is_hermitian.eigenvalues_eq]
  apply hM.2 _ fun h => _
  have h_det : hM.is_hermitian.eigenvector_matrixᵀ.det = 0 :=
    Matrix.det_eq_zero_of_row_eq_zero i fun j => congr_fun h j
  simpa only [h_det, not_isUnit_zero] using
    is_unit_det_of_invertible hM.is_hermitian.eigenvector_matrixᵀ
#align matrix.pos_def.det_pos Matrix.PosDef.det_pos

end PosDef

end Matrix

namespace QuadraticForm

variable {n : Type _} [Fintype n]

theorem posDefOfToMatrix' [DecidableEq n] {Q : QuadraticForm ℝ (n → ℝ)} (hQ : Q.toMatrix'.PosDef) :
    Q.PosDef :=
  by
  rw [← to_quadratic_form_associated ℝ Q, ← bilin_form.to_matrix'.left_inv ((associated_hom _) Q)]
  apply Matrix.posDefToQuadraticForm' hQ
#align quadratic_form.pos_def_of_to_matrix' QuadraticForm.posDefOfToMatrix'

theorem posDef_toMatrix' [DecidableEq n] {Q : QuadraticForm ℝ (n → ℝ)} (hQ : Q.PosDef) :
    Q.toMatrix'.PosDef :=
  by
  rw [← to_quadratic_form_associated ℝ Q, ←
    bilin_form.to_matrix'.left_inv ((associated_hom _) Q)] at hQ
  apply Matrix.posDef_of_toQuadraticForm' (is_symm_to_matrix' Q) hQ
#align quadratic_form.pos_def_to_matrix' QuadraticForm.posDef_toMatrix'

end QuadraticForm

namespace Matrix

variable {𝕜 : Type _} [IsROrC 𝕜] {n : Type _} [Fintype n]

/-- A positive definite matrix `M` induces a norm `‖x‖ = sqrt (re xᴴMx)`. -/
@[reducible]
noncomputable def NormedAddCommGroup.ofMatrix {M : Matrix n n 𝕜} (hM : M.PosDef) :
    NormedAddCommGroup (n → 𝕜) :=
  @InnerProductSpace.OfCore.toNormedAddCommGroup _ _ _ _ _
    { inner := fun x y => dotProduct (star x) (M.mulVec y)
      conj_symm := fun x y => by
        rw [star_dot_product, starRingEnd_apply, star_star, star_mul_vec, dot_product_mul_vec,
          hM.is_hermitian.eq]
      nonneg_re := fun x => by
        by_cases h : x = 0
        · simp [h]
        · exact le_of_lt (hM.2 x h)
      definite := fun x hx => by
        by_contra' h
        simpa [hx, lt_self_iff_false] using hM.2 x h
      add_left := by simp only [star_add, add_dot_product, eq_self_iff_true, forall_const]
      smul_left := fun x y r => by
        rw [← smul_eq_mul, ← smul_dot_product, starRingEnd_apply, ← star_smul] }
#align matrix.normed_add_comm_group.of_matrix Matrix.NormedAddCommGroup.ofMatrix

/-- A positive definite matrix `M` induces an inner product `⟪x, y⟫ = xᴴMy`. -/
def InnerProductSpace.ofMatrix {M : Matrix n n 𝕜} (hM : M.PosDef) :
    @InnerProductSpace 𝕜 (n → 𝕜) _ (NormedAddCommGroup.ofMatrix hM) :=
  InnerProductSpace.ofCore _
#align matrix.inner_product_space.of_matrix Matrix.InnerProductSpace.ofMatrix

end Matrix


/-
Copyright (c) 2015 Joseph Hua. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Hua
-/
import data.W.basic

/-!
# Examples of W-types

We take the view of W types as inductive types.
Given `α : Type` and `β : α → Type`, the W type determined by this data, `W_type β`, is the
inductively with constructors from `α` and arities of each constructor `a : α` given by `β a`.

This file contains `nat` and `list` as examples of W types.

## Main results
* `W_type.equiv_nat`: the construction of the naturals as a W-type is equivalent
  to `nat`
* `W_type.equiv_list`: the construction of lists on a type `γ` as a W-type is equivalent to
  `list γ`
-/

universes u v

namespace W_type

section nat

/-- The constructors for the naturals -/
inductive nat_α : Type
| zero : nat_α
| succ : nat_α

instance : inhabited nat_α := ⟨ nat_α.zero ⟩

/-- The arity of the constructors for the naturals, `zero` takes no arguments, `succ` takes one -/
def nat_β : nat_α → Type
| nat_α.zero := empty
| nat_α.succ := unit

instance : inhabited (nat_β nat_α.succ) := ⟨ () ⟩

/-- The isomorphism from the naturals to its corresponding `W_type` -/
@[simp] def nat_to : ℕ → W_type nat_β
| nat.zero := ⟨ nat_α.zero , empty.elim ⟩
| (nat.succ n) := ⟨ nat_α.succ , λ _ , nat_to n ⟩

/-- The isomorphism from the `W_type` of the naturals to the naturals -/
@[simp] def to_nat : W_type nat_β → ℕ
| (W_type.mk nat_α.zero f) := 0
| (W_type.mk nat_α.succ f) := (to_nat (f ())).succ

lemma left_inv_nat : function.left_inverse nat_to to_nat
| (W_type.mk nat_α.zero f) := by { simp, tidy }
| (W_type.mk nat_α.succ f) := by { simp, tidy }

lemma right_inv_nat : function.right_inverse nat_to to_nat
| nat.zero := rfl
| (nat.succ n) := by rw [nat_to, to_nat, right_inv_nat n]

/-- The naturals are equivalent to their associated `W_type` -/
def equiv_nat : W_type nat_β ≃ ℕ :=
{ to_fun := to_nat,
  inv_fun := nat_to,
  left_inv := left_inv_nat,
  right_inv := right_inv_nat }

/--
`nat_α` is equivalent to `bool`.
This is useful when considering the associated polynomial endofunctor
-/
@[simps] def nat_α_equiv_bool : nat_α ≃ bool :=
{ to_fun := λ c, match c with | nat_α.zero := ff | nat_α.succ := tt end,
  inv_fun := λ b, match b with | bool.tt := nat_α.succ | bool.ff := nat_α.zero end,
  left_inv := λ c, match c with | nat_α.zero := rfl | nat_α.succ := rfl end,
  right_inv := λ b, match b with | bool.tt := rfl | bool.ff := rfl end }

end nat

section list

variable (γ : Type u)

/--
The constructors for lists.
There is "one constructor `cons x` for each `x : γ`",
since we view `list γ` as
| nil : list γ
| cons x₀ : list γ → list γ
| cons x₁ : list γ → list γ
|   ⋮      γ many times
-/
inductive list_α : Type u
| nil : list_α
| cons : γ → list_α

instance : inhabited (list_α γ) := ⟨ list_α.nil ⟩

/-- The arities of each constructor for lists, `nil` takes no arguments, `cons hd` takes one -/
def list_β : list_α γ → Type u
| list_α.nil := pempty
| (list_α.cons hd) := punit

instance (hd : γ) : inhabited (list_β γ (list_α.cons hd)) := ⟨ punit.star ⟩

/-- The isomorphism from lists to the `W_type` construction of lists -/
@[simp] def list_to : list γ → W_type (list_β γ)
| list.nil := ⟨ list_α.nil, pempty.elim ⟩
| (list.cons hd tl) := ⟨ list_α.cons hd, λ _ , list_to tl ⟩

/-- The isomorphism from the `W_type` construction of lists to lists -/
@[simp] def to_list : W_type (list_β γ) → list γ
| (W_type.mk list_α.nil f) := []
| (W_type.mk (list_α.cons hd) f) := hd :: to_list (f punit.star)

lemma left_inv_list : function.left_inverse (list_to γ) (to_list _)
| (W_type.mk list_α.nil f) := by { simp, tidy }
| (W_type.mk (list_α.cons x) f) := by { simp, tidy }

lemma right_inv_list : function.right_inverse (list_to γ) (to_list _)
| list.nil := rfl
| (list.cons hd tl) := by simp [right_inv_list tl]

/-- Lists are equivalent to their associated `W_type` -/
def equiv_list : W_type (list_β γ) ≃ list γ :=
{ to_fun := to_list _,
  inv_fun := list_to _,
  left_inv := left_inv_list _,
  right_inv := right_inv_list _ }

/--
`list_α` is equivalent to `γ` with an extra point.
This is useful when considering the polynomial endofunctor associated to the `W_type`
-/
def list_α_equiv_punit_sum : list_α γ ≃ punit.{v + 1} ⊕ γ :=
{ to_fun := λ c, match c with | list_α.nil := sum.inl punit.star | list_α.cons x := sum.inr x end,
  inv_fun := sum.elim (λ _, list_α.nil) (λ x, list_α.cons x),
  left_inv := λ c, match c with | list_α.nil := rfl | list_α.cons x := rfl end,
  right_inv := λ x, match x with | sum.inl punit.star := rfl | sum.inr x := rfl end, }

end list

end W_type


-- Pruebas de A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C)
-- ==========================================

import data.set
open set

variable  {U : Type}
variables A B C : set U

-- ----------------------------------------------------
-- Ej. 1. Demostrar
--    A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C)
-- ----------------------------------------------------

-- 1ª demostración
example :
  A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
begin
  intros x h,
  cases h with ha hbc,
  cases hbc with hb hc,
  { left,
    split,
    { exact ha, },
    { exact hb, }},
  { right,
    split,
    { exact ha, },
    { exact hc, }},
end

-- 2ª demostración
example :
  A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
begin
  intros x h,
  cases h with ha hbc,
  cases hbc with hb hc,
  { left,
    split,
    { assumption, },
    { assumption, }},
  { right,
    split,
    { assumption, },
    { assumption, }},
end

-- 3ª demostración
example :
  A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
begin
  intros x h,
  cases h with ha hbc,
  cases hbc with hb hc,
  { left,
    split,
    assumption', },
  { right,
    split,
    assumption', },
end

-- 4ª demostración
example :
  A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
begin
  rintros x ⟨ha, (hb | hc)⟩,
  { left,
    split,
    assumption', },
  { right,
    split,
    assumption', },
end

-- 5ª demostración
example :
  A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
assume x,
assume h : x ∈ A ∩ (B ∪ C),
have x ∈ A, from and.left h,
have x ∈ B ∪ C, from and.right h,
or.elim (‹x ∈ B ∪ C›)
  ( assume : x ∈ B,
    have x ∈ A ∩ B, from and.intro ‹x ∈ A› ‹x ∈ B›,
    show x ∈ (A ∩ B) ∪ (A ∩ C), from or.inl this)
  ( assume : x ∈ C,
    have x ∈ A ∩ C, from and.intro ‹x ∈ A› ‹x ∈ C›,
    show x ∈ (A ∩ B) ∪ (A ∩ C), from or.inr this)

-- 6ª demostración
lemma inter_union_l1 :
  A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
assume x,
assume h : x ∈ A ∩ (B ∪ C),
have ha : x ∈ A, from and.left h,
have hbc : x ∈ B ∪ C, from and.right h,
or.elim hbc
  ( assume hb : x ∈ B,
    have hab: x ∈ A ∩ B, from and.intro ha hb,
    show x ∈ (A ∩ B) ∪ (A ∩ C), from or.inl hab)
  ( assume hc : x ∈ C,
    have hac : x ∈ A ∩ C, from and.intro ha hc,
    show x ∈ (A ∩ B) ∪ (A ∩ C), from or.inr hac)

-- ----------------------------------------------------
-- Ej. 2. Demostrar
--    (A ∩ B) ∪ (A ∩ C) ⊆ A ∩ (B ∪ C)
-- ----------------------------------------------------

-- 1ª demostración
example :
  (A ∩ B) ∪ (A ∩ C) ⊆ A ∩ (B ∪ C) :=
begin
  intros x h,
  cases h with hab hac,
  { split,
    { exact hab.left, },
    { left,
      exact hab.right, }},
  { split,
    { exact hac.left, },
    { right,
      exact hac.right, }},
end

-- 2ª demostración
example :
  (A ∩ B) ∪ (A ∩ C) ⊆ A ∩ (B ∪ C) :=
begin
  rintros x (⟨ha, hb⟩ | ⟨ha, hc⟩),
  { split,
    { exact ha, },
    { left,
      exact hb, }},
  { split,
    { exact ha, },
    { right,
      exact hc, }},
end

-- 3ª demostración
lemma inter_union_l2 :
  (A ∩ B) ∪ (A ∩ C) ⊆ A ∩ (B ∪ C) :=
assume x,
assume : x ∈ (A ∩ B) ∪ (A ∩ C),
or.elim this
  ( assume h : x ∈ A ∩ B,
    have x ∈ A, from and.left h,
    have x ∈ B, from and.right h,
    have x ∈ B ∪ C, from or.inl this,
    show x ∈ A ∩ (B ∪ C), from and.intro ‹x ∈ A› this)
  ( assume h : x ∈ A ∩ C,
    have x ∈ A, from and.left h,
    have x ∈ C, from and.right h,
    have x ∈ B ∪ C, from or.inr this,
    show x ∈ A ∩ (B ∪ C), from and.intro ‹x ∈ A› this)

-- ----------------------------------------------------
-- Ej. 3. Demostrar
--    (A ∩ B) ∪ (A ∩ C) = A ∩ (B ∪ C)
-- ----------------------------------------------------

-- 1ª demostración
example :
  A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
-- by library_search
inter_distrib_left A B C

-- 2ª demostración
theorem inter_union :
  A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
eq_of_subset_of_subset
  (inter_union_l1 A B C)
  (inter_union_l2 A B C)

-- 3ª demostración
example :
  A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  ext,
  simp,
  exact and_or_distrib_left,
end

-- 4ª demostración
example :
  A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  ext,
  exact and_or_distrib_left,
end

-- 5ª demostración
example :
  A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
ext (λ x, and_or_distrib_left)


/-
Copyright (c) 2022 Yaël Dillies, Sara Rousta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module order.upper_lower.hom
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.UpperLower.Basic
import Mathlib.Order.Hom.CompleteLattice

/-!
# `UpperSet.Ici` etc as `Sup`/`Supₛ`/`Inf`/`Infₛ`-homomorphisms

In this file we define `UpperSet.iciSupHom` etc. These functions are `UpperSet.Ici` and
`LowerSet.Iic` bundled as `SupHom`s, `InfHom`s, `SupₛHom`s, or `InfₛHom`s.
-/

variable {α : Type _}

open OrderDual

namespace UpperSet

section SemilatticeSup

variable [SemilatticeSup α]

/-- `UpperSet.Ici` as a `SupHom`. -/
def iciSupHom : SupHom α (UpperSet α) :=
  ⟨Ici, Ici_sup⟩
#align upper_set.Ici_sup_hom UpperSet.iciSupHom

@[simp]
theorem coe_iciSupHom : (iciSupHom : α → UpperSet α) = Ici :=
  rfl
#align upper_set.coe_Ici_sup_hom UpperSet.coe_iciSupHom

@[simp]
theorem iciSupHom_apply (a : α) : iciSupHom a = Ici a :=
  rfl
#align upper_set.Ici_sup_hom_apply UpperSet.iciSupHom_apply

end SemilatticeSup

variable [CompleteLattice α]

/-- `UpperSet.Ici` as a `SupₛHom`. -/
def iciSupₛHom : SupₛHom α (UpperSet α) :=
  ⟨Ici, fun s => (Ici_supₛ s).trans supₛ_image.symm⟩
-- Porting note: `ₓ` because typeclass assumption changed
#align upper_set.Ici_Sup_hom UpperSet.iciSupₛHomₓ

@[simp]
theorem coe_iciSupₛHom : (iciSupₛHom : α → UpperSet α) = Ici :=
  rfl
-- Porting note: `ₓ` because typeclass assumption changed
#align upper_set.coe_Ici_Sup_hom UpperSet.coe_iciSupₛHomₓ

@[simp]
theorem iciSupₛHom_apply (a : α) : iciSupₛHom a = Ici a :=
  rfl
-- Porting note: `ₓ` because typeclass assumption changed
#align upper_set.Ici_Sup_hom_apply UpperSet.iciSupₛHom_applyₓ

end UpperSet

namespace LowerSet

section SemilatticeInf

variable [SemilatticeInf α]

/-- `LowerSet.Iic` as an `InfHom`. -/
def iicInfHom : InfHom α (LowerSet α) :=
  ⟨Iic, Iic_inf⟩
#align lower_set.Iic_inf_hom LowerSet.iicInfHom

@[simp]
theorem coe_iicInfHom : (iicInfHom : α → LowerSet α) = Iic :=
  rfl
#align lower_set.coe_Iic_inf_hom LowerSet.coe_iicInfHom

@[simp]
theorem iicInfHom_apply (a : α) : iicInfHom a = Iic a :=
  rfl
#align lower_set.Iic_inf_hom_apply LowerSet.iicInfHom_apply

end SemilatticeInf

variable [CompleteLattice α]

/-- `LowerSet.Iic` as an `InfₛHom`. -/
def iicInfₛHom : InfₛHom α (LowerSet α) :=
  ⟨Iic, fun s => (Iic_infₛ s).trans infₛ_image.symm⟩
-- Porting note: `ₓ` because typeclass assumption changed
#align lower_set.Iic_Inf_hom LowerSet.iicInfₛHomₓ

@[simp]
theorem coe_iicInfₛHom : (iicInfₛHom : α → LowerSet α) = Iic :=
  rfl
-- Porting note: `ₓ` because typeclass assumption changed
#align lower_set.coe_Iic_Inf_hom LowerSet.coe_iicInfₛHomₓ

@[simp]
theorem iicInfₛHom_apply (a : α) : iicInfₛHom a = Iic a :=
  rfl
-- Porting note: `ₓ` because typeclass assumption changed
#align lower_set.Iic_Inf_hom_apply LowerSet.iicInfₛHom_applyₓ

end LowerSet