/-
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
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.times_cont_diff
import Mathlib.geometry.manifold.charted_space
import Mathlib.PostPort

universes u_1 u_2 u_3 l u_4 u v v' w w' u_6 u_8 u_7 u_5

namespace Mathlib

/-!
# Smooth manifolds (possibly with boundary or corners)

A smooth manifold is a manifold modelled on a normed vector space, or a subset like a
half-space (to get manifolds with boundaries) for which the changes of coordinates are smooth maps.
We define a model with corners as a map `I : H → E` embedding nicely the topological space `H` in
the vector space `E` (or more precisely as a structure containing all the relevant properties).
Given such a model with corners `I` on `(E, H)`, we define the groupoid of local
homeomorphisms of `H` which are smooth when read in `E` (for any regularity `n : with_top ℕ`).
With this groupoid at hand and the general machinery of charted spaces, we thus get the notion
of `C^n` manifold with respect to any model with corners `I` on `(E, H)`. We also introduce a
specific type class for `C^∞` manifolds as these are the most commonly used.

## Main definitions

* `model_with_corners 𝕜 E H` :
  a structure containing informations on the way a space `H` embeds in a
  model vector space E over the field `𝕜`. This is all that is needed to
  define a smooth manifold with model space `H`, and model vector space `E`.
* `model_with_corners_self 𝕜 E` :
  trivial model with corners structure on the space `E` embedded in itself by the identity.
* `times_cont_diff_groupoid n I` :
  when `I` is a model with corners on `(𝕜, E, H)`, this is the groupoid of local homeos of `H`
  which are of class `C^n` over the normed field `𝕜`, when read in `E`.
* `smooth_manifold_with_corners I M` :
  a type class saying that the charted space `M`, modelled on the space `H`, has `C^∞` changes of
  coordinates with respect to the model with corners `I` on `(𝕜, E, H)`. This type class is just
  a shortcut for `has_groupoid M (times_cont_diff_groupoid ∞ I)`.
* `ext_chart_at I x`:
  in a smooth manifold with corners with the model `I` on `(E, H)`, the charts take values in `H`,
  but often we may want to use their `E`-valued version, obtained by composing the charts with `I`.
  Since the target is in general not open, we can not register them as local homeomorphisms, but
  we register them as local equivs. `ext_chart_at I x` is the canonical such local equiv around `x`.

As specific examples of models with corners, we define (in the file `real_instances.lean`)
* `model_with_corners_self ℝ (euclidean_space (fin n))` for the model space used to define
  `n`-dimensional real manifolds without boundary (with notation `𝓡 n` in the locale `manifold`)
* `model_with_corners ℝ (euclidean_space (fin n)) (euclidean_half_space n)` for the model space
  used to define `n`-dimensional real manifolds with boundary (with notation `𝓡∂ n` in the locale
  `manifold`)
* `model_with_corners ℝ (euclidean_space (fin n)) (euclidean_quadrant n)` for the model space used
  to define `n`-dimensional real manifolds with corners

With these definitions at hand, to invoke an `n`-dimensional real manifold without boundary,
one could use

  `variables {n : ℕ} {M : Type*} [topological_space M] [charted_space (euclidean_space (fin n)) M]
   [smooth_manifold_with_corners (𝓡 n) M]`.

However, this is not the recommended way: a theorem proved using this assumption would not apply
for instance to the tangent space of such a manifold, which is modelled on
`(euclidean_space (fin n)) × (euclidean_space (fin n))` and not on `euclidean_space (fin (2 * n))`!
In the same way, it would not apply to product manifolds, modelled on
`(euclidean_space (fin n)) × (euclidean_space (fin m))`.
The right invocation does not focus on one specific construction, but on all constructions sharing
the right properties, like

  `variables {E : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
  {I : model_with_corners ℝ E E} [I.boundaryless]
  {M : Type*} [topological_space M] [charted_space E M] [smooth_manifold_with_corners I M]`

Here, `I.boundaryless` is a typeclass property ensuring that there is no boundary (this is for
instance the case for `model_with_corners_self`, or products of these). Note that one could consider
as a natural assumption to only use the trivial model with corners `model_with_corners_self ℝ E`,
but again in product manifolds the natural model with corners will not be this one but the product
one (and they are not defeq as `(λp : E × F, (p.1, p.2))` is not defeq to the identity). So, it is
important to use the above incantation to maximize the applicability of theorems.

## Implementation notes

We want to talk about manifolds modelled on a vector space, but also on manifolds with
boundary, modelled on a half space (or even manifolds with corners). For the latter examples,
we still want to define smooth functions, tangent bundles, and so on. As smooth functions are
well defined on vector spaces or subsets of these, one could take for model space a subtype of a
vector space. With the drawback that the whole vector space itself (which is the most basic
example) is not directly a subtype of itself: the inclusion of `univ : set E` in `set E` would
show up in the definition, instead of `id`.

A good abstraction covering both cases it to have a vector
space `E` (with basic example the Euclidean space), a model space `H` (with basic example the upper
half space), and an embedding of `H` into `E` (which can be the identity for `H = E`, or
`subtype.val` for manifolds with corners). We say that the pair `(E, H)` with their embedding is a
model with corners, and we encompass all the relevant properties (in particular the fact that the
image of `H` in `E` should have unique differentials) in the definition of `model_with_corners`.

We concentrate on `C^∞` manifolds: all the definitions work equally well for `C^n` manifolds, but
later on it is a pain to carry all over the smoothness parameter, especially when one wants to deal
with `C^k` functions as there would be additional conditions `k ≤ n` everywhere. Since one deals
almost all the time with `C^∞` (or analytic) manifolds, this seems to be a reasonable choice that
one could revisit later if needed. `C^k` manifolds are still available, but they should be called
using `has_groupoid M (times_cont_diff_groupoid k I)` where `I` is the model with corners.

I have considered using the model with corners `I` as a typeclass argument, possibly `out_param`, to
get lighter notations later on, but it did not turn out right, as on `E × F` there are two natural
model with corners, the trivial (identity) one, and the product one, and they are not defeq and one
needs to indicate to Lean which one we want to use.
This means that when talking on objects on manifolds one will most often need to specify the model
with corners one is using. For instance, the tangent bundle will be `tangent_bundle I M` and the
derivative will be `mfderiv I I' f`, instead of the more natural notations `tangent_bundle 𝕜 M` and
`mfderiv 𝕜 f` (the field has to be explicit anyway, as some manifolds could be considered both as
real and complex manifolds).
-/

/-! ### Models with corners. -/

/-- A structure containing informations on the way a space `H` embeds in a
model vector space `E` over the field `𝕜`. This is all what is needed to
define a smooth manifold with model space `H`, and model vector space `E`.
-/
structure model_with_corners (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] (E : Type u_2)
    [normed_group E] [normed_space 𝕜 E] (H : Type u_3) [topological_space H]
    extends local_equiv H E where
  source_eq : local_equiv.source _to_local_equiv = set.univ
  unique_diff' : unique_diff_on 𝕜 (set.range (local_equiv.to_fun _to_local_equiv))
  continuous_to_fun :
    autoParam (continuous (local_equiv.to_fun _to_local_equiv))
      (Lean.Syntax.ident Lean.SourceInfo.none
        (String.toSubstring "Mathlib.tactic.interactive.continuity'")
        (Lean.Name.mkStr
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
            "interactive")
          "continuity'")
        [])
  continuous_inv_fun :
    autoParam (continuous (local_equiv.inv_fun _to_local_equiv))
      (Lean.Syntax.ident Lean.SourceInfo.none
        (String.toSubstring "Mathlib.tactic.interactive.continuity'")
        (Lean.Name.mkStr
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
            "interactive")
          "continuity'")
        [])

/-- A vector space is a model with corners. -/
def model_with_corners_self (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] (E : Type u_2)
    [normed_group E] [normed_space 𝕜 E] : model_with_corners 𝕜 E E :=
  model_with_corners.mk (local_equiv.mk id id set.univ set.univ sorry sorry sorry sorry) sorry sorry

protected instance model_with_corners.has_coe_to_fun {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H] :
    has_coe_to_fun (model_with_corners 𝕜 E H) :=
  has_coe_to_fun.mk (fun (e : model_with_corners 𝕜 E H) => H → E)
    fun (e : model_with_corners 𝕜 E H) => local_equiv.to_fun (model_with_corners.to_local_equiv e)

/-- The inverse to a model with corners, only registered as a local equiv. -/
protected def model_with_corners.symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) : local_equiv E H :=
  local_equiv.symm (model_with_corners.to_local_equiv I)

/- Register a few lemmas to make sure that `simp` puts expressions in normal form -/

@[simp] theorem model_with_corners.to_local_equiv_coe {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) : ⇑(model_with_corners.to_local_equiv I) = ⇑I :=
  rfl

@[simp] theorem model_with_corners.mk_coe {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H] (e : local_equiv H E)
    (a : local_equiv.source e = set.univ) (b : unique_diff_on 𝕜 (set.range (local_equiv.to_fun e)))
    (c :
      autoParam (continuous (local_equiv.to_fun e))
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.tactic.interactive.continuity'")
          (Lean.Name.mkStr
            (Lean.Name.mkStr
              (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
              "interactive")
            "continuity'")
          []))
    (d :
      autoParam (continuous (local_equiv.inv_fun e))
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.tactic.interactive.continuity'")
          (Lean.Name.mkStr
            (Lean.Name.mkStr
              (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
              "interactive")
            "continuity'")
          [])) :
    ⇑(model_with_corners.mk e a b) = ⇑e :=
  rfl

@[simp] theorem model_with_corners.to_local_equiv_coe_symm {𝕜 : Type u_1}
    [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3}
    [topological_space H] (I : model_with_corners 𝕜 E H) :
    ⇑(local_equiv.symm (model_with_corners.to_local_equiv I)) = ⇑(model_with_corners.symm I) :=
  rfl

@[simp] theorem model_with_corners.mk_coe_symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (e : local_equiv H E) (a : local_equiv.source e = set.univ)
    (b : unique_diff_on 𝕜 (set.range (local_equiv.to_fun e)))
    (c :
      autoParam (continuous (local_equiv.to_fun e))
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.tactic.interactive.continuity'")
          (Lean.Name.mkStr
            (Lean.Name.mkStr
              (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
              "interactive")
            "continuity'")
          []))
    (d :
      autoParam (continuous (local_equiv.inv_fun e))
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.tactic.interactive.continuity'")
          (Lean.Name.mkStr
            (Lean.Name.mkStr
              (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
              "interactive")
            "continuity'")
          [])) :
    ⇑(model_with_corners.symm (model_with_corners.mk e a b)) = ⇑(local_equiv.symm e) :=
  rfl

theorem model_with_corners.unique_diff {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) : unique_diff_on 𝕜 (set.range ⇑I) :=
  model_with_corners.unique_diff' I

protected theorem model_with_corners.continuous {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) : continuous ⇑I :=
  model_with_corners.continuous_to_fun I

theorem model_with_corners.continuous_symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) : continuous ⇑(model_with_corners.symm I) :=
  model_with_corners.continuous_inv_fun I

/-- In the trivial model with corners, the associated local equiv is the identity. -/
@[simp] theorem model_with_corners_self_local_equiv (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜]
    (E : Type u_2) [normed_group E] [normed_space 𝕜 E] :
    model_with_corners.to_local_equiv (model_with_corners_self 𝕜 E) = local_equiv.refl E :=
  rfl

@[simp] theorem model_with_corners_self_coe (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜]
    (E : Type u_2) [normed_group E] [normed_space 𝕜 E] : ⇑(model_with_corners_self 𝕜 E) = id :=
  rfl

@[simp] theorem model_with_corners_self_coe_symm (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜]
    (E : Type u_2) [normed_group E] [normed_space 𝕜 E] :
    ⇑(model_with_corners.symm (model_with_corners_self 𝕜 E)) = id :=
  rfl

@[simp] theorem model_with_corners.target {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) :
    local_equiv.target (model_with_corners.to_local_equiv I) = set.range ⇑I :=
  sorry

@[simp] theorem model_with_corners.left_inv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) (x : H) : coe_fn (model_with_corners.symm I) (coe_fn I x) = x :=
  sorry

@[simp] theorem model_with_corners.left_inv' {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) : ⇑(model_with_corners.symm I) ∘ ⇑I = id :=
  funext fun (x : H) => model_with_corners.left_inv I x

@[simp] theorem model_with_corners.right_inv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {x : E} (hx : x ∈ set.range ⇑I) :
    coe_fn I (coe_fn (model_with_corners.symm I) x) = x :=
  sorry

theorem model_with_corners.image {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) (s : set H) :
    ⇑I '' s = ⇑(model_with_corners.symm I) ⁻¹' s ∩ set.range ⇑I :=
  sorry

theorem model_with_corners.unique_diff_preimage {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {s : set H} (hs : is_open s) :
    unique_diff_on 𝕜 (⇑(model_with_corners.symm I) ⁻¹' s ∩ set.range ⇑I) :=
  sorry

theorem model_with_corners.unique_diff_preimage_source {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {β : Type u_4} [topological_space β] {e : local_homeomorph H β} :
    unique_diff_on 𝕜
        (⇑(model_with_corners.symm I) ⁻¹' local_equiv.source (local_homeomorph.to_local_equiv e) ∩
          set.range ⇑I) :=
  model_with_corners.unique_diff_preimage I (local_homeomorph.open_source e)

theorem model_with_corners.unique_diff_at_image {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {x : H} : unique_diff_within_at 𝕜 (set.range ⇑I) (coe_fn I x) :=
  model_with_corners.unique_diff I (coe_fn I x) (set.mem_range_self x)

/-- Given two model_with_corners `I` on `(E, H)` and `I'` on `(E', H')`, we define the model with
corners `I.prod I'` on `(E × E', H × H')`. This appears in particular for the manifold structure on
the tangent bundle to a manifold modelled on `(E, H)`: it will be modelled on `(E × E, H × E)`. -/
def model_with_corners.prod {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {E : Type v} [normed_group E]
    [normed_space 𝕜 E] {H : Type w} [topological_space H] (I : model_with_corners 𝕜 E H)
    {E' : Type v'} [normed_group E'] [normed_space 𝕜 E'] {H' : Type w'} [topological_space H']
    (I' : model_with_corners 𝕜 E' H') : model_with_corners 𝕜 (E × E') (model_prod H H') :=
  model_with_corners.mk
    (local_equiv.mk (fun (p : model_prod H H') => (coe_fn I (prod.fst p), coe_fn I' (prod.snd p)))
      (fun (p : E × E') =>
        (coe_fn (model_with_corners.symm I) (prod.fst p),
        coe_fn (model_with_corners.symm I') (prod.snd p)))
      set.univ (set.prod (set.range ⇑I) (set.range ⇑I')) sorry sorry sorry sorry)
    sorry sorry

/-- Special case of product model with corners, which is trivial on the second factor. This shows up
as the model to tangent bundles. -/
def model_with_corners.tangent {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {E : Type v}
    [normed_group E] [normed_space 𝕜 E] {H : Type w} [topological_space H]
    (I : model_with_corners 𝕜 E H) : model_with_corners 𝕜 (E × E) (model_prod H E) :=
  model_with_corners.prod I (model_with_corners_self 𝕜 E)

@[simp] theorem model_with_corners_prod_to_local_equiv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_4} [normed_group F]
    [normed_space 𝕜 F] {H : Type u_6} [topological_space H] {G : Type u_8} [topological_space G]
    {I : model_with_corners 𝕜 E H} {J : model_with_corners 𝕜 F G} :
    model_with_corners.to_local_equiv (model_with_corners.prod I J) =
        local_equiv.prod (model_with_corners.to_local_equiv I)
          (model_with_corners.to_local_equiv J) :=
  sorry

@[simp] theorem model_with_corners_prod_coe {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E']
    [normed_space 𝕜 E'] {H : Type u_6} [topological_space H] {H' : Type u_7} [topological_space H']
    (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') :
    ⇑(model_with_corners.prod I I') = prod.map ⇑I ⇑I' :=
  rfl

@[simp] theorem model_with_corners_prod_coe_symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E']
    [normed_space 𝕜 E'] {H : Type u_6} [topological_space H] {H' : Type u_7} [topological_space H']
    (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') :
    ⇑(model_with_corners.symm (model_with_corners.prod I I')) =
        prod.map ⇑(model_with_corners.symm I) ⇑(model_with_corners.symm I') :=
  rfl

/-- Property ensuring that the model with corners `I` defines manifolds without boundary. -/
class model_with_corners.boundaryless {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H)
    where
  range_eq_univ : set.range ⇑I = set.univ

/-- The trivial model with corners has no boundary -/
protected instance model_with_corners_self_boundaryless (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜]
    (E : Type u_2) [normed_group E] [normed_space 𝕜 E] :
    model_with_corners.boundaryless (model_with_corners_self 𝕜 E) :=
  model_with_corners.boundaryless.mk
    (eq.mpr
      (id
        (Eq.trans
          ((fun (a a_1 : set E) (e_1 : a = a_1) (ᾰ ᾰ_1 : set E) (e_2 : ᾰ = ᾰ_1) =>
              congr (congr_arg Eq e_1) e_2)
            (set.range ⇑(model_with_corners_self 𝕜 E)) set.univ
            (Eq.trans
              ((fun (f f_1 : E → E) (e_1 : f = f_1) => congr_arg set.range e_1)
                (⇑(model_with_corners_self 𝕜 E)) id (model_with_corners_self_coe 𝕜 E))
              set.range_id)
            set.univ set.univ (Eq.refl set.univ))
          (propext (eq_self_iff_true set.univ))))
      trivial)

/-- If two model with corners are boundaryless, their product also is -/
protected instance model_with_corners.range_eq_univ_prod {𝕜 : Type u} [nondiscrete_normed_field 𝕜]
    {E : Type v} [normed_group E] [normed_space 𝕜 E] {H : Type w} [topological_space H]
    (I : model_with_corners 𝕜 E H) [model_with_corners.boundaryless I] {E' : Type v'}
    [normed_group E'] [normed_space 𝕜 E'] {H' : Type w'} [topological_space H']
    (I' : model_with_corners 𝕜 E' H') [model_with_corners.boundaryless I'] :
    model_with_corners.boundaryless (model_with_corners.prod I I') :=
  model_with_corners.boundaryless.mk
    (id
      (eq.mpr
        (id
          (Eq._oldrec
            (Eq.refl
              ((set.range fun (p : H × H') => (coe_fn I (prod.fst p), coe_fn I' (prod.snd p))) =
                set.univ))
            (Eq.symm set.prod_range_range_eq)))
        (eq.mpr
          (id
            (Eq._oldrec (Eq.refl (set.prod (set.range ⇑I) (set.range ⇑I') = set.univ))
              model_with_corners.boundaryless.range_eq_univ))
          (eq.mpr
            (id
              (Eq._oldrec (Eq.refl (set.prod set.univ (set.range ⇑I') = set.univ))
                model_with_corners.boundaryless.range_eq_univ))
            (eq.mpr
              (id (Eq._oldrec (Eq.refl (set.prod set.univ set.univ = set.univ)) set.univ_prod_univ))
              (Eq.refl set.univ))))))

/-! ### Smooth functions on models with corners -/

/-- Given a model with corners `(E, H)`, we define the groupoid of `C^n` transformations of `H` as
the maps that are `C^n` when read in `E` through `I`. -/
def times_cont_diff_groupoid (n : with_top ℕ) {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) : structure_groupoid H :=
  pregroupoid.groupoid
    (pregroupoid.mk
      (fun (f : H → H) (s : set H) =>
        times_cont_diff_on 𝕜 n (⇑I ∘ f ∘ ⇑(model_with_corners.symm I))
          (⇑(model_with_corners.symm I) ⁻¹' s ∩ set.range ⇑I))
      sorry sorry sorry sorry)

/-- Inclusion of the groupoid of `C^n` local diffeos in the groupoid of `C^m` local diffeos when
`m ≤ n` -/
theorem times_cont_diff_groupoid_le {m : with_top ℕ} {n : with_top ℕ} {𝕜 : Type u_1}
    [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3}
    [topological_space H] (I : model_with_corners 𝕜 E H) (h : m ≤ n) :
    times_cont_diff_groupoid n I ≤ times_cont_diff_groupoid m I :=
  sorry

/-- The groupoid of `0`-times continuously differentiable maps is just the groupoid of all
local homeomorphisms -/
theorem times_cont_diff_groupoid_zero_eq {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) : times_cont_diff_groupoid 0 I = continuous_groupoid H :=
  sorry

/-- An identity local homeomorphism belongs to the `C^n` groupoid. -/
theorem of_set_mem_times_cont_diff_groupoid (n : with_top ℕ) {𝕜 : Type u_1}
    [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3}
    [topological_space H] (I : model_with_corners 𝕜 E H) {s : set H} (hs : is_open s) :
    local_homeomorph.of_set s hs ∈ times_cont_diff_groupoid n I :=
  sorry

/-- The composition of a local homeomorphism from `H` to `M` and its inverse belongs to
the `C^n` groupoid. -/
theorem symm_trans_mem_times_cont_diff_groupoid (n : with_top ℕ) {𝕜 : Type u_1}
    [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3}
    [topological_space H] (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M]
    (e : local_homeomorph M H) :
    local_homeomorph.trans (local_homeomorph.symm e) e ∈ times_cont_diff_groupoid n I :=
  structure_groupoid.eq_on_source (times_cont_diff_groupoid n I)
    (of_set_mem_times_cont_diff_groupoid n I (local_homeomorph.open_target e))
    (local_homeomorph.trans_symm_self e)

/-- The product of two smooth local homeomorphisms is smooth. -/
theorem times_cont_diff_groupoid_prod {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H] {E' : Type u_5}
    [normed_group E'] [normed_space 𝕜 E'] {H' : Type u_6} [topological_space H']
    {I : model_with_corners 𝕜 E H} {I' : model_with_corners 𝕜 E' H'} {e : local_homeomorph H H}
    {e' : local_homeomorph H' H'} (he : e ∈ times_cont_diff_groupoid ⊤ I)
    (he' : e' ∈ times_cont_diff_groupoid ⊤ I') :
    local_homeomorph.prod e e' ∈ times_cont_diff_groupoid ⊤ (model_with_corners.prod I I') :=
  sorry

/-- The `C^n` groupoid is closed under restriction. -/
protected instance times_cont_diff_groupoid.closed_under_restriction (n : with_top ℕ) {𝕜 : Type u_1}
    [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3}
    [topological_space H] (I : model_with_corners 𝕜 E H) :
    closed_under_restriction (times_cont_diff_groupoid n I) :=
  iff.mpr (closed_under_restriction_iff_id_le (times_cont_diff_groupoid n I))
    (iff.mpr structure_groupoid.le_iff
      fun (e : local_homeomorph H H) (ᾰ : e ∈ id_restr_groupoid) =>
        Exists.dcases_on ᾰ
          fun (s : set H) (ᾰ_h : ∃ (h : is_open s), e ≈ local_homeomorph.of_set s h) =>
            Exists.dcases_on ᾰ_h
              fun (hs : is_open s) (hes : e ≈ local_homeomorph.of_set s hs) =>
                structure_groupoid.eq_on_source' (times_cont_diff_groupoid n I)
                  (local_homeomorph.of_set s hs) e (of_set_mem_times_cont_diff_groupoid n I hs) hes)

/-! ### Smooth manifolds with corners -/

/-- Typeclass defining smooth manifolds with corners with respect to a model with corners, over a
field `𝕜` and with infinite smoothness to simplify typeclass search and statements later on. -/
class smooth_manifold_with_corners {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) (M : Type u_4) [topological_space M] [charted_space H M]
    extends has_groupoid M (times_cont_diff_groupoid ⊤ I) where

theorem smooth_manifold_with_corners_of_times_cont_diff_on {𝕜 : Type u_1}
    [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3}
    [topological_space H] (I : model_with_corners 𝕜 E H) (M : Type u_4) [topological_space M]
    [charted_space H M]
    (h :
      ∀ (e e' : local_homeomorph M H),
        e ∈ charted_space.atlas H M →
          e' ∈ charted_space.atlas H M →
            times_cont_diff_on 𝕜 ⊤
              (⇑I ∘
                ⇑(local_homeomorph.trans (local_homeomorph.symm e) e') ∘
                  ⇑(model_with_corners.symm I))
              (⇑(model_with_corners.symm I) ⁻¹'
                  local_equiv.source
                    (local_homeomorph.to_local_equiv
                      (local_homeomorph.trans (local_homeomorph.symm e) e')) ∩
                set.range ⇑I)) :
    smooth_manifold_with_corners I M :=
  smooth_manifold_with_corners.mk (structure_groupoid.compatible (times_cont_diff_groupoid ⊤ I))

/-- For any model with corners, the model space is a smooth manifold -/
protected instance model_space_smooth {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    {I : model_with_corners 𝕜 E H} : smooth_manifold_with_corners I H :=
  smooth_manifold_with_corners.mk (has_groupoid.compatible (times_cont_diff_groupoid ⊤ I))

namespace smooth_manifold_with_corners

/- We restate in the namespace `smooth_manifolds_with_corners` some lemmas that hold for general
charted space with a structure groupoid, avoiding the need to specify the groupoid
`times_cont_diff_groupoid ∞ I` explicitly. -/

/-- The maximal atlas of `M` for the smooth manifold with corners structure corresponding to the
model with corners `I`. -/
def maximal_atlas {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {H : Type u_3} [topological_space H] (I : model_with_corners 𝕜 E H)
    (M : Type u_4) [topological_space M] [charted_space H M] : set (local_homeomorph M H) :=
  structure_groupoid.maximal_atlas M (times_cont_diff_groupoid ⊤ I)

theorem mem_maximal_atlas_of_mem_atlas {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    [smooth_manifold_with_corners I M] {e : local_homeomorph M H}
    (he : e ∈ charted_space.atlas H M) : e ∈ maximal_atlas I M :=
  structure_groupoid.mem_maximal_atlas_of_mem_atlas (times_cont_diff_groupoid ⊤ I) he

theorem chart_mem_maximal_atlas {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    [smooth_manifold_with_corners I M] (x : M) : charted_space.chart_at H x ∈ maximal_atlas I M :=
  structure_groupoid.chart_mem_maximal_atlas (times_cont_diff_groupoid ⊤ I) x

theorem compatible_of_mem_maximal_atlas {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    {I : model_with_corners 𝕜 E H} {M : Type u_4} [topological_space M] [charted_space H M]
    {e : local_homeomorph M H} {e' : local_homeomorph M H} (he : e ∈ maximal_atlas I M)
    (he' : e' ∈ maximal_atlas I M) :
    local_homeomorph.trans (local_homeomorph.symm e) e' ∈ times_cont_diff_groupoid ⊤ I :=
  structure_groupoid.compatible_of_mem_maximal_atlas he he'

/-- The product of two smooth manifolds with corners is naturally a smooth manifold with corners. -/
protected instance prod {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_4}
    [topological_space H] {I : model_with_corners 𝕜 E H} {H' : Type u_5} [topological_space H']
    {I' : model_with_corners 𝕜 E' H'} (M : Type u_6) [topological_space M] [charted_space H M]
    [smooth_manifold_with_corners I M] (M' : Type u_7) [topological_space M'] [charted_space H' M']
    [smooth_manifold_with_corners I' M'] :
    smooth_manifold_with_corners (model_with_corners.prod I I') (M × M') :=
  sorry

end smooth_manifold_with_corners

/-!
### Extended charts

In a smooth manifold with corners, the model space is the space `H`. However, we will also
need to use extended charts taking values in the model vector space `E`. These extended charts are
not `local_homeomorph` as the target is not open in `E` in general, but we can still register them
as `local_equiv`.
-/

/-- The preferred extended chart on a manifold with corners around a point `x`, from a neighborhood
of `x` to the model vector space. -/
@[simp] def ext_chart_at {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {H : Type u_3} [topological_space H] (I : model_with_corners 𝕜 E H)
    {M : Type u_4} [topological_space M] [charted_space H M] (x : M) : local_equiv M E :=
  local_equiv.trans (local_homeomorph.to_local_equiv (charted_space.chart_at H x))
    (model_with_corners.to_local_equiv I)

theorem ext_chart_at_source {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) :
    local_equiv.source (ext_chart_at I x) =
        local_equiv.source (local_homeomorph.to_local_equiv (charted_space.chart_at H x)) :=
  sorry

theorem ext_chart_at_open_source {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) : is_open (local_equiv.source (ext_chart_at I x)) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (is_open (local_equiv.source (ext_chart_at I x))))
        (ext_chart_at_source I x)))
    (local_homeomorph.open_source (charted_space.chart_at H x))

theorem mem_ext_chart_source {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) : x ∈ local_equiv.source (ext_chart_at I x) :=
  sorry

theorem ext_chart_at_to_inv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) : coe_fn (local_equiv.symm (ext_chart_at I x)) (coe_fn (ext_chart_at I x) x) = x :=
  sorry

theorem ext_chart_at_source_mem_nhds {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) : local_equiv.source (ext_chart_at I x) ∈ nhds x :=
  mem_nhds_sets (ext_chart_at_open_source I x) (mem_ext_chart_source I x)

theorem ext_chart_at_continuous_on {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) : continuous_on (⇑(ext_chart_at I x)) (local_equiv.source (ext_chart_at I x)) :=
  sorry

theorem ext_chart_at_continuous_at {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) : continuous_at (⇑(ext_chart_at I x)) x :=
  continuous_within_at.continuous_at (ext_chart_at_continuous_on I x x (mem_ext_chart_source I x))
    (ext_chart_at_source_mem_nhds I x)

theorem ext_chart_at_continuous_on_symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) :
    continuous_on (⇑(local_equiv.symm (ext_chart_at I x)))
        (local_equiv.target (ext_chart_at I x)) :=
  sorry

theorem ext_chart_at_target_mem_nhds_within {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) :
    local_equiv.target (ext_chart_at I x) ∈
        nhds_within (coe_fn (ext_chart_at I x) x) (set.range ⇑I) :=
  sorry

theorem ext_chart_at_coe {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {H : Type u_3} [topological_space H] (I : model_with_corners 𝕜 E H)
    {M : Type u_4} [topological_space M] [charted_space H M] (x : M) (p : M) :
    coe_fn (ext_chart_at I x) p = coe_fn I (coe_fn (charted_space.chart_at H x) p) :=
  rfl

theorem ext_chart_at_coe_symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M] (x : M)
    (p : E) :
    coe_fn (local_equiv.symm (ext_chart_at I x)) p =
        coe_fn (local_homeomorph.symm (charted_space.chart_at H x))
          (coe_fn (model_with_corners.symm I) p) :=
  rfl

theorem nhds_within_ext_chart_target_eq {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) :
    nhds_within (coe_fn (ext_chart_at I x) x) (local_equiv.target (ext_chart_at I x)) =
        nhds_within (coe_fn (ext_chart_at I x) x) (set.range ⇑I) :=
  sorry

theorem ext_chart_continuous_at_symm' {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M] (x : M)
    {x' : M} (h : x' ∈ local_equiv.source (ext_chart_at I x)) :
    continuous_at (⇑(local_equiv.symm (ext_chart_at I x))) (coe_fn (ext_chart_at I x) x') :=
  sorry

theorem ext_chart_continuous_at_symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M]
    (x : M) :
    continuous_at (⇑(local_equiv.symm (ext_chart_at I x))) (coe_fn (ext_chart_at I x) x) :=
  ext_chart_continuous_at_symm' I x (mem_ext_chart_source I x)

/-- Technical lemma ensuring that the preimage under an extended chart of a neighborhood of a point
in the source is a neighborhood of the preimage, within a set. -/
theorem ext_chart_preimage_mem_nhds_within' {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M] (x : M)
    {s : set M} {t : set M} {x' : M} (h : x' ∈ local_equiv.source (ext_chart_at I x))
    (ht : t ∈ nhds_within x' s) :
    ⇑(local_equiv.symm (ext_chart_at I x)) ⁻¹' t ∈
        nhds_within (coe_fn (ext_chart_at I x) x')
          (⇑(local_equiv.symm (ext_chart_at I x)) ⁻¹' s ∩ set.range ⇑I) :=
  sorry

/-- Technical lemma ensuring that the preimage under an extended chart of a neighborhood of the
base point is a neighborhood of the preimage, within a set. -/
theorem ext_chart_preimage_mem_nhds_within {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M] (x : M)
    {s : set M} {t : set M} (ht : t ∈ nhds_within x s) :
    ⇑(local_equiv.symm (ext_chart_at I x)) ⁻¹' t ∈
        nhds_within (coe_fn (ext_chart_at I x) x)
          (⇑(local_equiv.symm (ext_chart_at I x)) ⁻¹' s ∩ set.range ⇑I) :=
  ext_chart_preimage_mem_nhds_within' I x (mem_ext_chart_source I x) ht

/-- Technical lemma ensuring that the preimage under an extended chart of a neighborhood of a point
is a neighborhood of the preimage. -/
theorem ext_chart_preimage_mem_nhds {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M] (x : M)
    {t : set M} (ht : t ∈ nhds x) :
    ⇑(local_equiv.symm (ext_chart_at I x)) ⁻¹' t ∈ nhds (coe_fn (ext_chart_at I x) x) :=
  sorry

/-- Technical lemma to rewrite suitably the preimage of an intersection under an extended chart, to
bring it into a convenient form to apply derivative lemmas. -/
theorem ext_chart_preimage_inter_eq {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {H : Type u_3} [topological_space H]
    (I : model_with_corners 𝕜 E H) {M : Type u_4} [topological_space M] [charted_space H M] (x : M)
    {s : set M} {t : set M} :
    ⇑(local_equiv.symm (ext_chart_at I x)) ⁻¹' (s ∩ t) ∩ set.range ⇑I =
        ⇑(local_equiv.symm (ext_chart_at I x)) ⁻¹' s ∩ set.range ⇑I ∩
          ⇑(local_equiv.symm (ext_chart_at I x)) ⁻¹' t :=
  sorry

/-- In the case of the manifold structure on a vector space, the extended charts are just the
identity.-/
theorem ext_chart_model_space_eq_id (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] (x : E) :
    ext_chart_at (model_with_corners_self 𝕜 E) x = local_equiv.refl E :=
  sorry

end Mathlib


example (P Q : Prop) (p : P) (h : P → Q) : Q :=
begin
exact h(p),
end


import Cat.Fam.FunctorDefs

/-! ## Natural transformations

Natural transformations define a setoid, which is what we're defining here.
-/

namespace Cat

/-- A natural transformation -/
structure Fam.Cat.NatTrans
  (F F' : Func ℂ₁ ℂ₂)
where
  trans
    (α : ℂ₁.Obj)
  : F α ↠ F' α
  law
    {α β : ℂ₁.Obj}
    (f : α ↠ β)
  : (trans β) ⊚ (F.fmap f)
  ≈ (F'.fmap f) ⊚ (trans α)

/-- Two transformations are equivalent if they map `α` to the same `α'`. -/
abbrev Fam.Cat.NatTrans.equiv
  {F F' : Func ℂ₁ ℂ₂}
  (T T' : NatTrans F F')
: Prop :=
  ∀ (α : ℂ₁.Obj), T.trans α ≈ T'.trans α

/-- Gives access to `≈` notation (`\~~`). -/
instance instHasEquivNatTrans
  {F F' : Fam.Cat.Func ℂ₁ ℂ₂}
: HasEquiv (Fam.Cat.NatTrans F F') where
  Equiv T T' := T.equiv T'

/-- Natural transformation equivalence is reflexive. -/
theorem Fam.Cat.NatTrans.equiv.refl
  (T : NatTrans F F')
: T ≈ T :=
  by
    intro
    apply Setoid.refl

/-- Natural transformation equivalence is symmetric. -/
theorem Fam.Cat.NatTrans.equiv.symm
  {T T' : NatTrans F F'}
: T ≈ T' → T' ≈ T :=
  by
    intro h α
    apply Setoid.symm
    exact h α

/-- Natural transformation equivalence is transitive. -/
theorem Fam.Cat.NatTrans.equiv.trans
  {T T' T'' : NatTrans F F'}
: T ≈ T' → T' ≈ T'' → T ≈ T'' :=
  by
    intro h' h'' α
    apply Setoid.trans (h' α)
    exact h'' α

/-- Natural transformation equivalence is an actual equivalence. -/
def Fam.Cat.NatTrans.equiv.iseqv
  {F F' : Func ℂ₁ ℂ₂}
: @Equivalence (NatTrans F F') NatTrans.equiv :=
  ⟨refl, symm, trans⟩

/-- Natural transformations define a setoid in the Lean sense. -/
instance instZetoidNatTrans
  {F F' : Fam.Cat.Func ℂ₁ ℂ₂}
: Zetoid (Fam.Cat.NatTrans F F') where
  r :=
    Fam.Cat.NatTrans.equiv
  iseqv :=
    Fam.Cat.NatTrans.equiv.iseqv

/-- Equivalence over natural transformations is transitive. -/
instance instTransNatTransEquiv
  {F F' : Fam.Cat.Func ℂ₁ ℂ₂}
: Trans
  (Fam.Cat.NatTrans.equiv (F := F) (F' := F'))
  Fam.Cat.NatTrans.equiv
  Fam.Cat.NatTrans.equiv
:=
  ⟨Fam.Cat.NatTrans.equiv.trans⟩

/-- Equivalence over natural transformations is transitive. -/
instance instTransNatTransHasEquiv
  {F F' : Fam.Cat.Func ℂ₁ ℂ₂}
: Trans
  (instHasEquivNatTrans (F := F) (F' := F')).Equiv
  instHasEquivNatTrans.Equiv
  instHasEquivNatTrans.Equiv
:=
  instTransNatTransEquiv

/-- Setoid defined by natural transformations. -/
def Fam.Cat.NatTrans.toSetoid
  (F F' : Func ℂ₁ ℂ₂)
: Setoid :=
  ⟨NatTrans F F', instZetoidNatTrans⟩

section yoneda_map
  variable
    {ℂ : Cat.Fam.Cat}
    {α β γ : ℂ.Obj}

  /-- Composes `f` with `g`. -/
  def Fam.Cat.NatTrans.yoneMap.arrow
    (f : α ↠ β)
    (g : β ↠ γ)
  : α ↠ γ :=
    g ⊚ f

  /-- `arrow` is proper for `≈`. -/
  theorem Fam.Cat.NatTrans.yoneMap.arrow.proper
    (f : α ↠ β)
    {g g' : β ↠ γ}
  : g ≈ g' → arrow f g ≈ arrow f g' :=
    by
      intro h
      apply ℂ.congr.left
      exact h

  /-- `Morph` defined by `arrow f` -/
  def Fam.Cat.NatTrans.yoneMap
    (f : α ↠ β)
    (γ : ℂ.Obj)
  : (ℂ.Hom β γ) ⇒ (ℂ.Hom α γ) where
    map g :=
      yoneMap.arrow f g
    proper :=
      yoneMap.arrow.proper f

  /-- `yoneMap` verifies the natural transformation law. -/
  theorem Fam.Cat.NatTrans.yoneMap.natTransLaw
    (f : α ↠ β)
    {α' β' : ℂ.Obj}
    (g : α' ↠ β')
  : (yoneMap f β') ⊚ (Func.FunSET β |>.fmap g)
  ≈ (Func.FunSET α |>.fmap g) ⊚ (yoneMap f α')
  :=
    by
      intro a
      simp [yoneMap, arrow, Func.fmap, Func.FunSET, kompose, compose', Morph.app2]
      simp [SET, Comp.toCat, Morph.compose.Comp, Morph.compose]

  /-- Yoneda map `Morph` is a natural transformation. -/
  def Fam.Cat.NatTrans.yoneNatTrans
    {ℂ : Cat}
    {α β : ℂ.Obj}
    (f : α ↠ β)
  : NatTrans (Func.FunSET β) (Func.FunSET α) where
    trans γ :=
      yoneMap f γ
    law g :=
      yoneMap.natTransLaw f g

end yoneda_map

/-! ## Natural transformation composition -/
section comp
  variable
    {ℂ₁ ℂ₂ : Fam.Cat}
    {F G H : Fam.Cat.Func ℂ₁ ℂ₂}
    (T : Fam.Cat.NatTrans G H)
    (T' : Fam.Cat.NatTrans F G)

  /-- Natural transformation (vertical) composition `∘v`. -/
  @[simp]
  abbrev Fam.Cat.NatTrans.comp.raw
    (α : ℂ₁.Obj)
  : F α ↠ H α :=
    (T.trans α) ⊚ (T'.trans α)

  def Fam.Cat.NatTrans.comp
  : NatTrans F H where
    trans :=
      comp.raw T T'
    law {α β} f :=
      by
        simp [comp.raw]
        calc
          (trans T β ⊚ trans T' β) ⊚ Func.fmap F f
          ≈ trans T β ⊚ trans T' β ⊚ Func.fmap F f
          :=
            by
              apply Setoid.symm
              apply ℂ₂.compose_assoc
          _
          ≈ trans T β ⊚ Func.fmap G f ⊚ trans T' α
          :=
            T'.law f
            |> ℂ₂.congr.right _
          _
          ≈ (trans T β ⊚ Func.fmap G f) ⊚ trans T' α
          :=
            ℂ₂.compose_assoc _ _ _
          _
          ≈ (Func.fmap H f ⊚ trans T α) ⊚ trans T' α
          :=
            T.law f
            |> ℂ₂.congr.left _
          _
          ≈ Func.fmap H f ⊚ trans T α ⊚ trans T' α
          :=
            by
              apply Setoid.symm
              apply ℂ₂.compose_assoc

  infixr:67 " ∘v " =>
    Fam.Cat.NatTrans.comp.toNatTrans

  def Fam.Cat.NatTrans.comp.congr
  : Congr (NatTrans H G) (NatTrans F H) (NatTrans F G) comp where
    left _ h α :=
      ℂ₂.congr.left _ (h α)
    right _ _ _ h α :=
      ℂ₂.congr.right _ (h α)

  def Fam.Cat.NatTrans.Comp
  : Comp (Func ℂ₁ ℂ₂) (NatTrans.toSetoid) where
    comp :=
      NatTrans.comp
    congr :=
      NatTrans.comp.congr

end comp


import data.setoid.basic

universes u

inductive acc2 {α : Type u} (r : α → α → Prop) : α → Type u
| intro (x : α) (h : ∀ y, r y x → acc2 y) : acc2 x

structure ordinal : Type (u + 1) :=
( to_type : Type u )
( r : to_type → to_type → Prop )
( wf : ∀ x : to_type, acc2 r x )
( trans : transitive r )
( total : ∀ x y, r x y ∨ r y x ∨ x = y )
#print acc2.rec_on

namespace ordinal

instance : has_coe_to_sort ordinal.{u} (Type u) :=
{ coe := ordinal.to_type }

instance {α : ordinal.{u}} : linear_order α :=
{ le := λ x y, α.r x y ∨ x = y,
  le_refl := λ _, or.inr rfl,
  le_trans := λ a b c h₁ h₂,
    h₁.elim
      (λ h₁, h₂.elim (λ h₂, or.inl (α.trans h₁ h₂))
        (λ h₂, h₂ ▸ or.inl h₁))
      (λ h₁, h₁.symm ▸ h₂),
  le_antisymm := sorry,
  le_total := sorry,
  decidable_le := sorry }

end ordinal

example (A : Type u) (f : A → ordinal.{u}) : ordinal.{u} :=
{ to_type := quotient (setoid.ker f),
  r := _ }


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.subgroup.basic
import algebra.graded_monoid
import algebra.direct_sum.basic
import algebra.big_operators.pi

/-!
# Additively-graded multiplicative structures on `⨁ i, A i`

This module provides a set of heterogeneous typeclasses for defining a multiplicative structure
over `⨁ i, A i` such that `(*) : A i → A j → A (i + j)`; that is to say, `A` forms an
additively-graded ring. The typeclasses are:

* `direct_sum.gnon_unital_non_assoc_semiring A`
* `direct_sum.gsemiring A`
* `direct_sum.gring A`
* `direct_sum.gcomm_semiring A`
* `direct_sum.gcomm_ring A`

Respectively, these imbue the external direct sum `⨁ i, A i` with:

* `direct_sum.non_unital_non_assoc_semiring`, `direct_sum.non_unital_non_assoc_ring`
* `direct_sum.semiring`
* `direct_sum.ring`
* `direct_sum.comm_semiring`
* `direct_sum.comm_ring`

the base ring `A 0` with:

* `direct_sum.grade_zero.non_unital_non_assoc_semiring`,
  `direct_sum.grade_zero.non_unital_non_assoc_ring`
* `direct_sum.grade_zero.semiring`
* `direct_sum.grade_zero.ring`
* `direct_sum.grade_zero.comm_semiring`
* `direct_sum.grade_zero.comm_ring`

and the `i`th grade `A i` with `A 0`-actions (`•`) defined as left-multiplication:

* `direct_sum.grade_zero.has_scalar (A 0)`, `direct_sum.grade_zero.smul_with_zero (A 0)`
* `direct_sum.grade_zero.module (A 0)`
* (nothing)
* (nothing)
* (nothing)

Note that in the presence of these instances, `⨁ i, A i` itself inherits an `A 0`-action.

`direct_sum.of_zero_ring_hom : A 0 →+* ⨁ i, A i` provides `direct_sum.of A 0` as a ring
homomorphism.

`direct_sum.to_semiring` extends `direct_sum.to_add_monoid` to produce a `ring_hom`.

## Direct sums of subobjects

Additionally, this module provides helper functions to construct `gsemiring` and `gcomm_semiring`
instances for:

* `A : ι → submonoid S`:
  `direct_sum.gsemiring.of_add_submonoids`, `direct_sum.gcomm_semiring.of_add_submonoids`.
* `A : ι → subgroup S`:
  `direct_sum.gsemiring.of_add_subgroups`, `direct_sum.gcomm_semiring.of_add_subgroups`.
* `A : ι → submodule S`:
  `direct_sum.gsemiring.of_submodules`, `direct_sum.gcomm_semiring.of_submodules`.

If `complete_lattice.independent (set.range A)`, these provide a gradation of `⨆ i, A i`, and the
mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as
`direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`.

## tags

graded ring, filtered ring, direct sum, add_submonoid
-/

set_option old_structure_cmd true

variables {ι : Type*} [decidable_eq ι]

namespace direct_sum

open_locale direct_sum

/-! ### Typeclasses -/
section defs

variables (A : ι → Type*)

/-- A graded version of `non_unital_non_assoc_semiring`. -/
class gnon_unital_non_assoc_semiring [has_add ι] [Π i, add_comm_monoid (A i)] extends
  graded_monoid.ghas_mul A :=
(mul_zero : ∀ {i j} (a : A i), mul a (0 : A j) = 0)
(zero_mul : ∀ {i j} (b : A j), mul (0 : A i) b = 0)
(mul_add : ∀ {i j} (a : A i) (b c : A j), mul a (b + c) = mul a b + mul a c)
(add_mul : ∀ {i j} (a b : A i) (c : A j), mul (a + b) c = mul a c + mul b c)

end defs

section defs

variables (A : ι → Type*)

/-- A graded version of `semiring`. -/
class gsemiring [add_monoid ι] [Π i, add_comm_monoid (A i)] extends
  gnon_unital_non_assoc_semiring A, graded_monoid.gmonoid A :=
(nat_cast : ℕ → A 0)
(nat_cast_zero : nat_cast 0 = 0)
(nat_cast_succ : ∀ n : ℕ, nat_cast (n + 1) = nat_cast n + graded_monoid.ghas_one.one)

/-- A graded version of `comm_semiring`. -/
class gcomm_semiring [add_comm_monoid ι] [Π i, add_comm_monoid (A i)] extends
  gsemiring A, graded_monoid.gcomm_monoid A

/-- A graded version of `ring`. -/
class gring [add_monoid ι] [Π i, add_comm_group (A i)] extends gsemiring A :=
(int_cast : ℤ → A 0)
(int_cast_of_nat : ∀ n : ℕ, int_cast n = nat_cast n)
(int_cast_neg_succ_of_nat : ∀ n : ℕ, int_cast (-(n+1 : ℕ)) = -nat_cast (n+1 : ℕ))

/-- A graded version of `comm_ring`. -/
class gcomm_ring [add_comm_monoid ι] [Π i, add_comm_group (A i)] extends
  gring A, gcomm_semiring A

end defs

lemma of_eq_of_graded_monoid_eq {A : ι → Type*} [Π (i : ι), add_comm_monoid (A i)]
  {i j : ι} {a : A i} {b : A j} (h : graded_monoid.mk i a = graded_monoid.mk j b) :
  direct_sum.of A i a = direct_sum.of A j b :=
dfinsupp.single_eq_of_sigma_eq h

variables (A : ι → Type*)

/-! ### Instances for `⨁ i, A i` -/

section one
variables [has_zero ι] [graded_monoid.ghas_one A] [Π i, add_comm_monoid (A i)]

instance : has_one (⨁ i, A i) :=
{ one := direct_sum.of (λ i, A i) 0 graded_monoid.ghas_one.one }

end one

section mul
variables [has_add ι] [Π i, add_comm_monoid (A i)] [gnon_unital_non_assoc_semiring A]

open add_monoid_hom (flip_apply coe_comp comp_hom_apply_apply)

/-- The piecewise multiplication from the `has_mul` instance, as a bundled homomorphism. -/
@[simps]
def gmul_hom {i j} : A i →+ A j →+ A (i + j) :=
{ to_fun := λ a,
  { to_fun := λ b, graded_monoid.ghas_mul.mul a b,
    map_zero' := gnon_unital_non_assoc_semiring.mul_zero _,
    map_add' := gnon_unital_non_assoc_semiring.mul_add _ },
  map_zero' := add_monoid_hom.ext $ λ a, gnon_unital_non_assoc_semiring.zero_mul a,
  map_add' := λ a₁ a₂, add_monoid_hom.ext $ λ b, gnon_unital_non_assoc_semiring.add_mul _ _ _}

/-- The multiplication from the `has_mul` instance, as a bundled homomorphism. -/
def mul_hom : (⨁ i, A i) →+ (⨁ i, A i) →+ ⨁ i, A i :=
direct_sum.to_add_monoid $ λ i,
  add_monoid_hom.flip $ direct_sum.to_add_monoid $ λ j, add_monoid_hom.flip $
    (direct_sum.of A _).comp_hom.comp $ gmul_hom A

instance : non_unital_non_assoc_semiring (⨁ i, A i) :=
{ mul := λ a b, mul_hom A a b,
  zero := 0,
  add := (+),
  zero_mul := λ a, by simp only [add_monoid_hom.map_zero, add_monoid_hom.zero_apply],
  mul_zero := λ a, by simp only [add_monoid_hom.map_zero],
  left_distrib := λ a b c, by simp only [add_monoid_hom.map_add],
  right_distrib := λ a b c, by simp only [add_monoid_hom.map_add, add_monoid_hom.add_apply],
  .. direct_sum.add_comm_monoid _ _}

variables {A}

lemma mul_hom_of_of {i j} (a : A i) (b : A j) :
  mul_hom A (of _ i a) (of _ j b) = of _ (i + j) (graded_monoid.ghas_mul.mul a b) :=
begin
  unfold mul_hom,
  rw [to_add_monoid_of, flip_apply, to_add_monoid_of, flip_apply, coe_comp, function.comp_app,
      comp_hom_apply_apply, coe_comp, function.comp_app, gmul_hom_apply_apply],
end

lemma of_mul_of {i j} (a : A i) (b : A j) :
  of _ i a * of _ j b = of _ (i + j) (graded_monoid.ghas_mul.mul a b) :=
mul_hom_of_of a b

end mul

section semiring
variables [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A]

open add_monoid_hom (flip_hom coe_comp comp_hom_apply_apply flip_apply flip_hom_apply)

private lemma one_mul (x : ⨁ i, A i) : 1 * x = x :=
suffices mul_hom A 1 = add_monoid_hom.id (⨁ i, A i),
  from add_monoid_hom.congr_fun this x,
begin
  apply add_hom_ext, intros i xi,
  unfold has_one.one,
  rw mul_hom_of_of,
  exact of_eq_of_graded_monoid_eq (one_mul $ graded_monoid.mk i xi),
end

private lemma mul_one (x : ⨁ i, A i) : x * 1 = x :=
suffices (mul_hom A).flip 1 = add_monoid_hom.id (⨁ i, A i),
  from add_monoid_hom.congr_fun this x,
begin
  apply add_hom_ext, intros i xi,
  unfold has_one.one,
  rw [flip_apply, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (mul_one $ graded_monoid.mk i xi),
end

private lemma mul_assoc (a b c : ⨁ i, A i) : a * b * c = a * (b * c) :=
suffices (mul_hom A).comp_hom.comp (mul_hom A)            -- `λ a b c, a * b * c` as a bundled hom
       = (add_monoid_hom.comp_hom flip_hom $              -- `λ a b c, a * (b * c)` as a bundled hom
             (mul_hom A).flip.comp_hom.comp (mul_hom A)).flip,
  from add_monoid_hom.congr_fun (add_monoid_hom.congr_fun (add_monoid_hom.congr_fun this a) b) c,
begin
  ext ai ax bi bx ci cx : 6,
  dsimp only [coe_comp, function.comp_app, comp_hom_apply_apply, flip_apply, flip_hom_apply],
  rw [mul_hom_of_of, mul_hom_of_of, mul_hom_of_of, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (mul_assoc (graded_monoid.mk ai ax) ⟨bi, bx⟩ ⟨ci, cx⟩),
end

/-- The `semiring` structure derived from `gsemiring A`. -/
instance semiring : semiring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  one_mul := one_mul A,
  mul_one := mul_one A,
  mul_assoc := mul_assoc A,
  nat_cast := λ n, of _ _ (gsemiring.nat_cast n),
  nat_cast_zero := by rw [gsemiring.nat_cast_zero, map_zero],
  nat_cast_succ := λ n, by { rw [gsemiring.nat_cast_succ, map_add], refl },
  ..direct_sum.non_unital_non_assoc_semiring _, }

lemma of_pow {i} (a : A i) (n : ℕ) :
  of _ i a ^ n = of _ (n • i) (graded_monoid.gmonoid.gnpow _ a) :=
begin
  induction n with n,
  { exact of_eq_of_graded_monoid_eq (pow_zero $ graded_monoid.mk _ a).symm, },
  { rw [pow_succ, n_ih, of_mul_of],
    exact of_eq_of_graded_monoid_eq (pow_succ (graded_monoid.mk _ a) n).symm, },
end

lemma of_list_dprod {α} (l : list α) (fι : α → ι) (fA : Π a, A (fι a)) :
  of A _ (l.dprod fι fA) = (l.map $ λ a, of A (fι a) (fA a)).prod :=
begin
  induction l,
  { simp only [list.map_nil, list.prod_nil, list.dprod_nil],
    refl },
  { simp only [list.map_cons, list.prod_cons, list.dprod_cons, ←l_ih, direct_sum.of_mul_of],
    refl },
end

lemma list_prod_of_fn_of_eq_dprod (n : ℕ) (fι : fin n → ι) (fA : Π a, A (fι a)) :
  (list.of_fn $ λ a, of A (fι a) (fA a)).prod = of A _ ((list.fin_range n).dprod fι fA) :=
by rw [list.of_fn_eq_map, of_list_dprod]

open_locale big_operators

/-- A heavily unfolded version of the definition of multiplication -/
lemma mul_eq_sum_support_ghas_mul
  [Π (i : ι) (x : A i), decidable (x ≠ 0)] (a a' : ⨁ i, A i) :
  a * a' =
    ∑ (ij : ι × ι) in (dfinsupp.support a).product (dfinsupp.support a'),
      direct_sum.of _ _ (graded_monoid.ghas_mul.mul (a ij.fst) (a' ij.snd)) :=
begin
  change direct_sum.mul_hom _ a a' = _,
  dsimp [direct_sum.mul_hom, direct_sum.to_add_monoid, dfinsupp.lift_add_hom_apply],
  simp only [dfinsupp.sum_add_hom_apply, dfinsupp.sum, dfinsupp.finset_sum_apply,
    add_monoid_hom.coe_finset_sum, finset.sum_apply, add_monoid_hom.flip_apply,
    add_monoid_hom.comp_hom_apply_apply, add_monoid_hom.comp_apply,
    direct_sum.gmul_hom_apply_apply],
  rw finset.sum_product,
end

end semiring

section comm_semiring

variables [Π i, add_comm_monoid (A i)] [add_comm_monoid ι] [gcomm_semiring A]

private lemma mul_comm (a b : ⨁ i, A i) : a * b = b * a :=
suffices mul_hom A = (mul_hom A).flip,
  from add_monoid_hom.congr_fun (add_monoid_hom.congr_fun this a) b,
begin
  apply add_hom_ext, intros ai ax, apply add_hom_ext, intros bi bx,
  rw [add_monoid_hom.flip_apply, mul_hom_of_of, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (gcomm_semiring.mul_comm ⟨ai, ax⟩ ⟨bi, bx⟩),
end

/-- The `comm_semiring` structure derived from `gcomm_semiring A`. -/
instance comm_semiring : comm_semiring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  mul_comm := mul_comm A,
  ..direct_sum.semiring _, }

end comm_semiring

section non_unital_non_assoc_ring
variables [Π i, add_comm_group (A i)] [has_add ι] [gnon_unital_non_assoc_semiring A]

/-- The `ring` derived from `gsemiring A`. -/
instance non_assoc_ring : non_unital_non_assoc_ring (⨁ i, A i) :=
{ mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.neg,
  ..(direct_sum.non_unital_non_assoc_semiring _),
  ..(direct_sum.add_comm_group _), }

end non_unital_non_assoc_ring

section ring
variables [Π i, add_comm_group (A i)] [add_monoid ι] [gring A]

/-- The `ring` derived from `gsemiring A`. -/
instance ring : ring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.neg,
  int_cast := λ z, of _ _ (gring.int_cast z),
  int_cast_of_nat := λ z, congr_arg _ $ gring.int_cast_of_nat _,
  int_cast_neg_succ_of_nat := λ z,
    (congr_arg _ $ gring.int_cast_neg_succ_of_nat _).trans (map_neg _ _),
  ..(direct_sum.semiring _),
  ..(direct_sum.add_comm_group _), }

end ring

section comm_ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_ring A]

/-- The `comm_ring` derived from `gcomm_semiring A`. -/
instance comm_ring : comm_ring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.neg,
  ..(direct_sum.ring _),
  ..(direct_sum.comm_semiring _), }

end comm_ring

/-! ### Instances for `A 0`

The various `g*` instances are enough to promote the `add_comm_monoid (A 0)` structure to various
types of multiplicative structure.
-/

section grade_zero

section one
variables [has_zero ι] [graded_monoid.ghas_one A] [Π i, add_comm_monoid (A i)]

@[simp] lemma of_zero_one : of _ 0 (1 : A 0) = 1 := rfl

end one

section mul
variables [add_zero_class ι] [Π i, add_comm_monoid (A i)] [gnon_unital_non_assoc_semiring A]

@[simp] lemma of_zero_smul {i} (a : A 0) (b : A i) : of _ _ (a • b) = of _ _ a * of _ _ b :=
(of_eq_of_graded_monoid_eq (graded_monoid.mk_zero_smul a b)).trans (of_mul_of _ _).symm

@[simp] lemma of_zero_mul (a b : A 0) : of _ 0 (a * b) = of _ 0 a * of _ 0 b:=
of_zero_smul A a b

instance grade_zero.non_unital_non_assoc_semiring : non_unital_non_assoc_semiring (A 0) :=
function.injective.non_unital_non_assoc_semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of A 0).map_add (of_zero_mul A) (λ x n, dfinsupp.single_smul n x)

instance grade_zero.smul_with_zero (i : ι) : smul_with_zero (A 0) (A i) :=
begin
  letI := smul_with_zero.comp_hom (⨁ i, A i) (of A 0).to_zero_hom,
  refine dfinsupp.single_injective.smul_with_zero (of A i).to_zero_hom (of_zero_smul A),
end

end mul

section semiring
variables [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A]

@[simp] lemma of_zero_pow (a : A 0) : ∀ n : ℕ, of _ 0 (a ^ n) = of _ 0 a ^ n
| 0 := by rw [pow_zero, pow_zero, direct_sum.of_zero_one]
| (n + 1) := by rw [pow_succ, pow_succ, of_zero_mul, of_zero_pow]

instance : has_nat_cast (A 0) := ⟨gsemiring.nat_cast⟩

@[simp] lemma of_nat_cast (n : ℕ) : of A 0 n = n :=
rfl

/-- The `semiring` structure derived from `gsemiring A`. -/
instance grade_zero.semiring : semiring (A 0) :=
function.injective.semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (of A 0).map_nsmul (λ x n, of_zero_pow _ _ _) (of_nat_cast A)

/-- `of A 0` is a `ring_hom`, using the `direct_sum.grade_zero.semiring` structure. -/
def of_zero_ring_hom : A 0 →+* (⨁ i, A i) :=
{ map_one' := of_zero_one A, map_mul' := of_zero_mul A, ..(of _ 0) }

/-- Each grade `A i` derives a `A 0`-module structure from `gsemiring A`. Note that this results
in an overall `module (A 0) (⨁ i, A i)` structure via `direct_sum.module`.
-/
instance grade_zero.module {i} : module (A 0) (A i) :=
begin
  letI := module.comp_hom (⨁ i, A i) (of_zero_ring_hom A),
  exact dfinsupp.single_injective.module (A 0) (of A i) (λ a, of_zero_smul A a),
end

end semiring

section comm_semiring

variables [Π i, add_comm_monoid (A i)] [add_comm_monoid ι] [gcomm_semiring A]

/-- The `comm_semiring` structure derived from `gcomm_semiring A`. -/
instance grade_zero.comm_semiring : comm_semiring (A 0) :=
function.injective.comm_semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (λ x n, dfinsupp.single_smul n x) (λ x n, of_zero_pow _ _ _) (of_nat_cast A)

end comm_semiring

section ring
variables [Π i, add_comm_group (A i)] [add_zero_class ι] [gnon_unital_non_assoc_semiring A]

/-- The `non_unital_non_assoc_ring` derived from `gnon_unital_non_assoc_semiring A`. -/
instance grade_zero.non_unital_non_assoc_ring : non_unital_non_assoc_ring (A 0) :=
function.injective.non_unital_non_assoc_ring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of A 0).map_add (of_zero_mul A)
  (of A 0).map_neg (of A 0).map_sub
  (λ x n, begin
    letI : Π i, distrib_mul_action ℕ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end)
  (λ x n, begin
    letI : Π i, distrib_mul_action ℤ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end)

end ring

section ring
variables [Π i, add_comm_group (A i)] [add_monoid ι] [gring A]

instance : has_int_cast (A 0) := ⟨gring.int_cast⟩

@[simp] lemma of_int_cast (n : ℤ) : of A 0 n = n :=
rfl

/-- The `ring` derived from `gsemiring A`. -/
instance grade_zero.ring : ring (A 0) :=
function.injective.ring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (of A 0).map_neg (of A 0).map_sub
  (λ x n, begin
    letI : Π i, distrib_mul_action ℕ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end)
  (λ x n, begin
    letI : Π i, distrib_mul_action ℤ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end) (λ x n, of_zero_pow _ _ _)
  (of_nat_cast A) (of_int_cast A)

end ring

section comm_ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_ring A]

/-- The `comm_ring` derived from `gcomm_semiring A`. -/
instance grade_zero.comm_ring : comm_ring (A 0) :=
function.injective.comm_ring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (of A 0).map_neg (of A 0).map_sub
  (λ x n, begin
    letI : Π i, distrib_mul_action ℕ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end)
  (λ x n, begin
    letI : Π i, distrib_mul_action ℤ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end) (λ x n, of_zero_pow _ _ _)
  (of_nat_cast A) (of_int_cast A)

end comm_ring

end grade_zero

section to_semiring

variables {R : Type*} [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A] [semiring R]
variables {A}

/-- If two ring homomorphisms from `⨁ i, A i` are equal on each `of A i y`,
then they are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
lemma ring_hom_ext' ⦃F G : (⨁ i, A i) →+* R⦄
  (h : ∀ i, (↑F : _ →+ R).comp (of A i) = (↑G : _ →+ R).comp (of A i)) : F = G :=
ring_hom.coe_add_monoid_hom_injective $ direct_sum.add_hom_ext' h

/-- Two `ring_hom`s out of a direct sum are equal if they agree on the generators. -/
lemma ring_hom_ext ⦃f g : (⨁ i, A i) →+* R⦄ (h : ∀ i x, f (of A i x) = g (of A i x)) :
  f = g :=
ring_hom_ext' $ λ i, add_monoid_hom.ext $ h i

/-- A family of `add_monoid_hom`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
describes a `ring_hom`s on `⨁ i, A i`. This is a stronger version of `direct_sum.to_monoid`.

Of particular interest is the case when `A i` are bundled subojects, `f` is the family of
coercions such as `add_submonoid.subtype (A i)`, and the `[gsemiring A]` structure originates from
`direct_sum.gsemiring.of_add_submonoids`, in which case the proofs about `ghas_one` and `ghas_mul`
can be discharged by `rfl`. -/
@[simps]
def to_semiring
  (f : Π i, A i →+ R) (hone : f _ (graded_monoid.ghas_one.one) = 1)
  (hmul : ∀ {i j} (ai : A i) (aj : A j), f _ (graded_monoid.ghas_mul.mul ai aj) = f _ ai * f _ aj) :
  (⨁ i, A i) →+* R :=
{ to_fun := to_add_monoid f,
  map_one' := begin
    change (to_add_monoid f) (of _ 0 _) = 1,
    rw to_add_monoid_of,
    exact hone
  end,
  map_mul' := begin
    rw (to_add_monoid f).map_mul_iff,
    ext xi xv yi yv : 4,
    show to_add_monoid f (of A xi xv * of A yi yv) =
         to_add_monoid f (of A xi xv) * to_add_monoid f (of A yi yv),
    rw [of_mul_of, to_add_monoid_of, to_add_monoid_of, to_add_monoid_of],
    exact hmul _ _,
  end,
  .. to_add_monoid f}

@[simp] lemma to_semiring_of (f : Π i, A i →+ R) (hone hmul) (i : ι) (x : A i) :
  to_semiring f hone hmul (of _ i x) = f _ x :=
to_add_monoid_of f i x

@[simp] lemma to_semiring_coe_add_monoid_hom (f : Π i, A i →+ R) (hone hmul):
  (to_semiring f hone hmul : (⨁ i, A i) →+ R) = to_add_monoid f := rfl

/-- Families of `add_monoid_hom`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
are isomorphic to `ring_hom`s on `⨁ i, A i`. This is a stronger version of `dfinsupp.lift_add_hom`.
-/
@[simps]
def lift_ring_hom :
  {f : Π {i}, A i →+ R //
    f (graded_monoid.ghas_one.one) = 1 ∧
    ∀ {i j} (ai : A i) (aj : A j), f (graded_monoid.ghas_mul.mul ai aj) = f ai * f aj} ≃
    ((⨁ i, A i) →+* R) :=
{ to_fun := λ f, to_semiring f.1 f.2.1 f.2.2,
  inv_fun := λ F,
    ⟨λ i, (F : (⨁ i, A i) →+ R).comp (of _ i), begin
      simp only [add_monoid_hom.comp_apply, ring_hom.coe_add_monoid_hom],
      rw ←F.map_one,
      refl
    end, λ i j ai aj, begin
      simp only [add_monoid_hom.comp_apply, ring_hom.coe_add_monoid_hom],
      rw [←F.map_mul, of_mul_of],
    end⟩,
  left_inv := λ f, begin
    ext xi xv,
    exact to_add_monoid_of f.1 xi xv,
  end,
  right_inv := λ F, begin
    apply ring_hom.coe_add_monoid_hom_injective,
    ext xi xv,
    simp only [ring_hom.coe_add_monoid_hom_mk,
      direct_sum.to_add_monoid_of,
      add_monoid_hom.mk_coe,
      add_monoid_hom.comp_apply, to_semiring_coe_add_monoid_hom],
  end}

end to_semiring

end direct_sum

/-! ### Concrete instances -/

section uniform

variables (ι)

/-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/
instance non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring
  {R : Type*} [add_monoid ι] [non_unital_non_assoc_semiring R] :
  direct_sum.gnon_unital_non_assoc_semiring (λ i : ι, R) :=
{ mul_zero := λ i j, mul_zero,
  zero_mul := λ i j, zero_mul,
  mul_add := λ i j, mul_add,
  add_mul := λ i j, add_mul,
  ..has_mul.ghas_mul ι }

/-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/
instance semiring.direct_sum_gsemiring {R : Type*} [add_monoid ι] [semiring R] :
  direct_sum.gsemiring (λ i : ι, R) :=
{ nat_cast := λ n, n,
  nat_cast_zero := nat.cast_zero,
  nat_cast_succ := nat.cast_succ,
  ..non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring ι,
  ..monoid.gmonoid ι }

open_locale direct_sum

-- To check `has_mul.ghas_mul_mul` matches
example {R : Type*} [add_monoid ι] [semiring R] (i j : ι) (a b : R) :
  (direct_sum.of _ i a * direct_sum.of _ j b : ⨁ i, R) = direct_sum.of _ (i + j) (by exact a * b) :=
by rw [direct_sum.of_mul_of, has_mul.ghas_mul_mul]

/-- A direct sum of copies of a `comm_semiring` inherits the commutative multiplication structure.
-/
instance comm_semiring.direct_sum_gcomm_semiring {R : Type*} [add_comm_monoid ι] [comm_semiring R] :
  direct_sum.gcomm_semiring (λ i : ι, R) :=
{ ..comm_monoid.gcomm_monoid ι, ..semiring.direct_sum_gsemiring ι }

end uniform


import topology.basic
import topology.compact_open
import data.nat.prime
import data.real.basic
import data.real.irrational
import data.complex.basic
import data.fin.basic
import geometry.euclidean.basic
import analysis.inner_product_space.pi_L2
import algebra.group.defs
import algebra.field.basic
import combinatorics.configuration
import ring_theory.polynomial.basic
import group_theory.free_group
import combinatorics.simple_graph.basic
import ring_theory.integral_closure
import data.fintype.card
import category_theory.category.basic
import ring_theory.discrete_valuation_ring
import group_theory.torsion
import linear_algebra.matrix.charpoly.basic
import algebra.order.absolute_value
import analysis.convex.basic
import topology.uniform_space.uniform_convergence_topology
import topology.sequences
import analysis.normed.group.infinite_sum
import data.nat.choose.sum
import group_theory.specific_groups.cyclic
import group_theory.order_of_element
import analysis.mean_inequalities
import analysis.normed_space.banach
import topology.algebra.continuous_monoid_hom
import linear_algebra.matrix.symmetric
import analysis.inner_product_space.spectrum
import ring_theory.class_group
import ring_theory.dedekind_domain.basic
import ring_theory.principal_ideal_domain
import model_theory.satisfiability
import probability.integration
import ring_theory.simple_module
import category_theory.preadditive.schur
import representation_theory.maschke
import topology.paracompact
import combinatorics.simple_graph.coloring
--Prove that Symmetric real matrices have real eigenvalues in Lean mathlib

--OUTPUT 1
theorem symmetric_matrix_real_eigenvalues (n : ℕ) (A : matrix (fin n) (fin n) ℝ) (h : is_symmetric A) :
  ∀ i : fin n, ∃ v : ℝ, is_eigenvector A v i
| ⟨0, _⟩ :=
  begin
    apply exists.intro,
    apply (h 0 0).1,
  end
| ⟨m + 1, _⟩ :=
  begin
    have h1 : ∀ i : fin (m + 1), ∃ v : ℝ, is_eigenvector A v i := symmetric_matrix_real_eigenvalues,
    have h2 : ∃ v : ℝ, is_eigenvector A v ⟨m, _⟩ := h1 ⟨m, _⟩,
    cases h2 with v hv,
    have h3 : ∃ (v' : ℝ), is_eigenvector A v' ⟨m + 1, _⟩ :=
    begin
      apply exists.intro,
      apply is_eigenvector.mk,
      apply (h m (m + 1)).1,
      apply (hv.1).1,
      apply (hv.1).2,
    end,
    apply h3,
  end

--Prove that Symmetric real matrices have real eigenvalues in Lean mathlib
theorem symmetric_matrix_real_eigenvalues_2 (n : ℕ) (A : matrix (fin n) (fin n) ℝ) (h : is_symmetric A) :
  ∀ i : fin n, ∃ v : ℝ, is_eigenvector A v i
| ⟨0, _⟩ :=
  begin
    apply exists.intro,
    apply (h 0 0).1,
  end
| ⟨m + 1, _⟩ :=
  begin
    have h1 : ∀ i : fin (m + 1), ∃ v : ℝ, is_eigenvector A v i := symmetric_matrix_real_eigenvalues,
    have h2 : ∃ v : ℝ, is_eigenvector A v ⟨m, _⟩ := h1 ⟨m, _⟩,
    cases h2 with v hv,
    have h3 : ∃ (v' : ℝ), is_eigenvector A v' ⟨m + 1, _⟩ :=
    begin
      apply exists.intro,
      apply is_eigenvector.mk,
      apply (h m (m + 1)).1,
      apply (hv.1).1,
      apply (hv.1).2,
    end,
    apply h3,
  end

--Prove that Symmetric real matrices have real eigenvalues in Lean mathlib
theorem symmetric_matrix_real_eigenvalues_3 (n : ℕ) (A : matrix (fin n) (fin n) ℝ) (h : is_symmetric A) :
  ∀ i : fin n, ∃ v : ℝ, is_eigenvector A v i
| ⟨0, _⟩ :=
  begin
    apply exists.intro,
    apply (h 0 0).1,
  end
| ⟨m + 1, _⟩ :=
  begin
    have h1 : ∀ i : fin (m + 1), ∃ v : ℝ, is_eigenvector A v i := symmetric_matrix_real_eigenvalues,
    have h2 : ∃ v : ℝ, is_eigenvector A v ⟨m, _⟩ := h1 ⟨m, _⟩,
    cases h2 with v hv,
    have h3 : ∃ (v' : ℝ), is_eigenvector A v' ⟨m + 1, _⟩ :=
    begin
      apply exists.intro,
      apply is_eigenvector.mk,
      apply (h m (m + 1)).1,
      apply (hv.1).1,
      apply (hv.1).2,
    end,
    apply h3,
  end

--Prove that Symmetric real matrices have real eigenvalues in Lean mathlib
theorem symmetric_matrix_real_eigenvalues_4 (n : ℕ) (A : matrix (fin n) (fin n) ℝ) (h : is_symmetric A) :
  ∀ i : fin n, ∃ v : ℝ, is_eigenvector A v i
| ⟨0, _⟩ :=
  begin
    apply exists.intro,
    apply (h 0 0).1,
  end
| ⟨m + 1, _⟩ :=
  begin
    have h1 : ∀ i : fin (m + 1), ∃ v : ℝ, is_eigenvector A v i := symmetric_matrix_real_eigenvalues,
    have h2 : ∃ v : ℝ, is_eigenvector A v ⟨m, _⟩ := h1 ⟨m, _⟩,
    cases h2 with v hv,
    have h3 : ∃ (v' : ℝ), is_eigenvector A v' ⟨m + 1, _⟩ :=
    begin
      apply exists.intro,
      apply is_eigenvector.mk,
      apply (h m (m + 1)).1,
      apply (hv.1).1,
      apply (hv.1).2,
    end,
    apply h3,
  end

--Prove that Symmetric real matrices have real eigenvalues in Lean mathlib
theorem symmetric_matrix_real_eigenvalues_5 (n : ℕ) (A : matrix (fin n) (fin n) ℝ) (h : is_symmetric A) :
  ∀ i : fin n, ∃ v : ℝ, is_eigenvector A v i
| ⟨0, _⟩ :=
  begin
    apply exists.intro,
    apply (h 0 0).1,
  end
| ⟨m + 1, _⟩ :=
  begin
    have h1 : ∀ i : fin (m + 1), ∃ v : ℝ, is_eigenvector A v i := symmetric_matrix_real_eigenvalues,
    have h2 : ∃ v : ℝ, is_eigenvector A v ⟨m, _⟩ := h1 ⟨m, _⟩,
    cases h2 with v hv,
    have h3 : ∃ (v' : ℝ), is_eigenvector A v' ⟨m + 1, _⟩ :=
    begin
      apply exists.intro,
      apply is_eigenvector.mk,
      apply (h m (m + 1)).1,
      apply (hv.1).1,
      apply (hv.1).2,
    end,
    apply h3,
  end

--Prove that Symmetric real matrices have real eigenvalues in Lean mathlib
theorem symmetric_matrix_real_eigenvalues_6 (n : ℕ) (A : matrix (fin n) (fin n) ℝ) (h : is_symmetric A) :
  ∀ i : fin n, ∃ v : ℝ, is_eigenvector A v i
| ⟨0, _⟩ :=
  begin
    apply exists.intro,
    apply (h 0 0).1,
  end
| ⟨m + 1, _⟩ :=
  begin
    have h1 : ∀ i : fin (m + 1), ∃ v : ℝ, is_eigenvector A v i := symmetric_matrix_real_eigenvalues,
    have h2 : ∃ v : ℝ, is_eigenvector A v ⟨m, _⟩ := h1 ⟨m, _⟩,
    cases h2 with v hv,
    have h3 : ∃ (v' :

--OUTPUT 2
theorem symm_real_eigen (A : matrix (fin m) (fin n) ℝ) (h : symm A) : ∃ λ, is_eigen A λ :=
begin
  sorry

--OUTPUT 3
theorem symmetric_real_matrix_real_eigenvalues (n : ℕ) (A : matrix (fin n) (fin n) ℝ) (hA : symmetric A) : real_eigenvalues A = ∅ ∨ ∃ (λ : ℝ), λ ∈ real_eigenvalues A :=
begin
  sorry


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module algebra.field.power
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Field.Defs
import Mathbin.Algebra.GroupWithZero.Power
import Mathbin.Algebra.Parity

/-!
# Results about powers in fields or division rings.

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

This file exists to ensure we can define `field` with minimal imports,
so contains some lemmas about powers of elements which need imports
beyond those needed for the basic definition.
-/

variable {α : Type _}

section DivisionRing

variable [DivisionRing α] {n : ℤ}

/- warning: zpow_bit1_neg -> zpow_bit1_neg is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] (a : α) (n : Int), Eq.{succ u1} α (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) (Neg.neg.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) a) (bit1.{0} Int Int.hasOne Int.hasAdd n)) (Neg.neg.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) a (bit1.{0} Int Int.hasOne Int.hasAdd n)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] (a : α) (n : Int), Eq.{succ u1} α (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) (Neg.neg.{u1} α (Ring.toNeg.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) a) (bit1.{0} Int (NonAssocRing.toOne.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) Int.instAddInt n)) (Neg.neg.{u1} α (Ring.toNeg.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) a (bit1.{0} Int (NonAssocRing.toOne.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) Int.instAddInt n)))
Case conversion may be inaccurate. Consider using '#align zpow_bit1_neg zpow_bit1_negₓ'. -/
@[simp]
theorem zpow_bit1_neg (a : α) (n : ℤ) : (-a) ^ bit1 n = -a ^ bit1 n := by
  rw [zpow_bit1', zpow_bit1', neg_mul_neg, neg_mul_eq_mul_neg]
#align zpow_bit1_neg zpow_bit1_neg

/- warning: odd.neg_zpow -> Odd.neg_zpow is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] {n : Int}, (Odd.{0} Int Int.semiring n) -> (forall (a : α), Eq.{succ u1} α (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) (Neg.neg.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) a) n) (Neg.neg.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) a n)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] {n : Int}, (Odd.{0} Int Int.instSemiringInt n) -> (forall (a : α), Eq.{succ u1} α (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) (Neg.neg.{u1} α (Ring.toNeg.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) a) n) (Neg.neg.{u1} α (Ring.toNeg.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) a n)))
Case conversion may be inaccurate. Consider using '#align odd.neg_zpow Odd.neg_zpowₓ'. -/
theorem Odd.neg_zpow (h : Odd n) (a : α) : (-a) ^ n = -a ^ n :=
  by
  obtain ⟨k, rfl⟩ := h.exists_bit1
  exact zpow_bit1_neg _ _
#align odd.neg_zpow Odd.neg_zpow

/- warning: odd.neg_one_zpow -> Odd.neg_one_zpow is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] {n : Int}, (Odd.{0} Int Int.semiring n) -> (Eq.{succ u1} α (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) (Neg.neg.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))))))) n) (Neg.neg.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] {n : Int}, (Odd.{0} Int Int.instSemiringInt n) -> (Eq.{succ u1} α (HPow.hPow.{u1, 0, u1} α Int α (instHPow.{u1, 0} α Int (DivInvMonoid.Pow.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) (Neg.neg.{u1} α (Ring.toNeg.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (NonAssocRing.toOne.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) n) (Neg.neg.{u1} α (Ring.toNeg.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (NonAssocRing.toOne.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align odd.neg_one_zpow Odd.neg_one_zpowₓ'. -/
theorem Odd.neg_one_zpow (h : Odd n) : (-1 : α) ^ n = -1 := by rw [h.neg_zpow, one_zpow]
#align odd.neg_one_zpow Odd.neg_one_zpow

end DivisionRing


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.sites.pretopology
! leanprover-community/mathlib commit 9e7c80f638149bfb3504ba8ff48dfdbfc949fb1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Sites.Grothendieck

/-!
# Grothendieck pretopologies

Definition and lemmas about Grothendieck pretopologies.
A Grothendieck pretopology for a category `C` is a set of families of morphisms with fixed codomain,
satisfying certain closure conditions.

We show that a pretopology generates a genuine Grothendieck topology, and every topology has
a maximal pretopology which generates it.

The pretopology associated to a topological space is defined in `spaces.lean`.

## Tags

coverage, pretopology, site

## References

* [nLab, *Grothendieck pretopology*](https://ncatlab.org/nlab/show/Grothendieck+pretopology)
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]
* [Stacks, *00VG*](https://stacks.math.columbia.edu/tag/00VG)
-/

universe v u

noncomputable section

namespace CategoryTheory

open CategoryTheory Category Limits Presieve

variable {C : Type u} [Category.{v} C] [HasPullbacks C]

variable (C)

/--
A (Grothendieck) pretopology on `C` consists of a collection of families of morphisms with a fixed
target `X` for every object `X` in `C`, called "coverings" of `X`, which satisfies the following
three axioms:
1. Every family consisting of a single isomorphism is a covering family.
2. The collection of covering families is stable under pullback.
3. Given a covering family, and a covering family on each domain of the former, the composition
   is a covering family.

In some sense, a pretopology can be seen as Grothendieck topology with weaker saturation conditions,
in that each covering is not necessarily downward closed.

See: https://ncatlab.org/nlab/show/Grothendieck+pretopology, or
https://stacks.math.columbia.edu/tag/00VH, or [MM92] Chapter III, Section 2, Definition 2.
Note that Stacks calls a category together with a pretopology a site, and [MM92] calls this
a basis for a topology.
-/
@[ext]
structure Pretopology where
  coverings : ∀ X : C, Set (Presieve X)
  has_isos : ∀ ⦃X Y⦄ (f : Y ⟶ X) [IsIso f], Presieve.singleton f ∈ coverings X
  pullbacks : ∀ ⦃X Y⦄ (f : Y ⟶ X) (S), S ∈ coverings X → pullbackArrows f S ∈ coverings Y
  Transitive :
    ∀ ⦃X : C⦄ (S : Presieve X) (Ti : ∀ ⦃Y⦄ (f : Y ⟶ X), S f → Presieve Y),
      S ∈ coverings X → (∀ ⦃Y⦄ (f) (H : S f), Ti f H ∈ coverings Y) → S.bind Ti ∈ coverings X
#align category_theory.pretopology CategoryTheory.Pretopology

namespace Pretopology

instance : CoeFun (Pretopology C) fun _ => ∀ X : C, Set (Presieve X) :=
  ⟨coverings⟩

variable {C}

instance LE : LE (Pretopology C) where le K₁ K₂ := (K₁ : ∀ X : C, Set (Presieve X)) ≤ K₂

theorem le_def {K₁ K₂ : Pretopology C} : K₁ ≤ K₂ ↔ (K₁ : ∀ X : C, Set (Presieve X)) ≤ K₂ :=
  Iff.rfl
#align category_theory.pretopology.le_def CategoryTheory.Pretopology.le_def

variable (C)

instance : PartialOrder (Pretopology C) :=
  { Pretopology.LE with
    le_refl := fun K => le_def.mpr le_rfl
    le_trans := fun K₁ K₂ K₃ h₁₂ h₂₃ => le_def.mpr (le_trans h₁₂ h₂₃)
    le_antisymm := fun K₁ K₂ h₁₂ h₂₁ => Pretopology.ext _ _ (le_antisymm h₁₂ h₂₁) }

instance : OrderTop (Pretopology C) where
  top :=
    { coverings := fun _ => Set.univ
      has_isos := fun _ _ _ _ => Set.mem_univ _
      pullbacks := fun _ _ _ _ _ => Set.mem_univ _
      Transitive := fun _ _ _ _ _ => Set.mem_univ _ }
  le_top _ _ _ _ := Set.mem_univ _

instance : Inhabited (Pretopology C) :=
  ⟨⊤⟩

/-- A pretopology `K` can be completed to a Grothendieck topology `J` by declaring a sieve to be
`J`-covering if it contains a family in `K`.

See <https://stacks.math.columbia.edu/tag/00ZC>, or [MM92] Chapter III, Section 2, Equation (2).
-/
def toGrothendieck (K : Pretopology C) : GrothendieckTopology C where
  sieves X S := ∃ R ∈ K X, R ≤ (S : Presieve _)
  top_mem' X := ⟨Presieve.singleton (𝟙 _), K.has_isos _, fun _ _ _ => ⟨⟩⟩
  pullback_stable' X Y S g := by
    rintro ⟨R, hR, RS⟩
    refine' ⟨_, K.pullbacks g _ hR, _⟩
    rw [← Sieve.sets_iff_generate, Sieve.pullbackArrows_comm]
    apply Sieve.pullback_monotone
    rwa [Sieve.giGenerate.gc]
  transitive' := by
    rintro X S ⟨R', hR', RS⟩ R t
    choose t₁ t₂ t₃ using t
    refine' ⟨_, K.Transitive _ _ hR' fun _ f hf => t₂ (RS _ hf), _⟩
    rintro Y _ ⟨Z, g, f, hg, hf, rfl⟩
    apply t₃ (RS _ hg) _ hf
#align category_theory.pretopology.to_grothendieck CategoryTheory.Pretopology.toGrothendieck

theorem mem_toGrothendieck (K : Pretopology C) (X S) :
    S ∈ toGrothendieck C K X ↔ ∃ R ∈ K X, R ≤ (S : Presieve X) :=
  Iff.rfl
#align category_theory.pretopology.mem_to_grothendieck CategoryTheory.Pretopology.mem_toGrothendieck

/-- The largest pretopology generating the given Grothendieck topology.

See [MM92] Chapter III, Section 2, Equations (3,4).
-/
def ofGrothendieck (J : GrothendieckTopology C) : Pretopology C where
  coverings X R := Sieve.generate R ∈ J X
  has_isos X Y f i := J.covering_of_eq_top (by simp)
  pullbacks X Y f R hR := by
    simp only [Set.mem_def, Sieve.pullbackArrows_comm]
    apply J.pullback_stable f hR
  Transitive X S Ti hS hTi := by
    apply J.transitive hS
    intro Y f
    rintro ⟨Z, g, f, hf, rfl⟩
    rw [Sieve.pullback_comp]
    apply J.pullback_stable g
    apply J.superset_covering _ (hTi _ hf)
    rintro Y g ⟨W, h, g, hg, rfl⟩
    exact ⟨_, h, _, ⟨_, _, _, hf, hg, rfl⟩, by simp⟩
#align category_theory.pretopology.of_grothendieck CategoryTheory.Pretopology.ofGrothendieck

/-- We have a galois insertion from pretopologies to Grothendieck topologies. -/
def gi : GaloisInsertion (toGrothendieck C) (ofGrothendieck C) where
  gc K J := by
    constructor
    · intro h X R hR
      exact h _ ⟨_, hR, Sieve.le_generate R⟩
    · rintro h X S ⟨R, hR, RS⟩
      apply J.superset_covering _ (h _ hR)
      rwa [Sieve.giGenerate.gc]
  le_l_u J X S hS := ⟨S, J.superset_covering (Sieve.le_generate S.arrows) hS, le_rfl⟩
  choice x _ := toGrothendieck C x
  choice_eq _ _ := rfl
#align category_theory.pretopology.gi CategoryTheory.Pretopology.gi

/--
The trivial pretopology, in which the coverings are exactly singleton isomorphisms. This topology is
also known as the indiscrete, coarse, or chaotic topology.

See <https://stacks.math.columbia.edu/tag/07GE>
-/
def trivial : Pretopology C where
  coverings X S := ∃ (Y : _) (f : Y ⟶ X) (_ : IsIso f), S = Presieve.singleton f
  has_isos X Y f i := ⟨_, _, i, rfl⟩
  pullbacks X Y f S := by
    rintro ⟨Z, g, i, rfl⟩
    refine' ⟨pullback g f, pullback.snd, _, _⟩
    · refine' ⟨⟨pullback.lift (f ≫ inv g) (𝟙 _) (by simp), ⟨_, by aesop_cat⟩⟩⟩
      apply pullback.hom_ext
      · rw [assoc, pullback.lift_fst, ← pullback.condition_assoc]
        simp
      · simp
    · apply pullback_singleton
  Transitive := by
    rintro X S Ti ⟨Z, g, i, rfl⟩ hS
    rcases hS g (singleton_self g) with ⟨Y, f, i, hTi⟩
    refine' ⟨_, f ≫ g, _, _⟩
    · infer_instance
    -- Porting note: the next four lines were just "ext (W k)"
    apply funext
    rintro W
    apply Set.ext
    rintro k
    constructor
    · rintro ⟨V, h, k, ⟨_⟩, hh, rfl⟩
      rw [hTi] at hh
      cases hh
      apply singleton.mk
    · rintro ⟨_⟩
      refine' bind_comp g singleton.mk _
      rw [hTi]
      apply singleton.mk
#align category_theory.pretopology.trivial CategoryTheory.Pretopology.trivial

instance : OrderBot (Pretopology C) where
  bot := trivial C
  bot_le K X R := by
    rintro ⟨Y, f, hf, rfl⟩
    exact K.has_isos f

/-- The trivial pretopology induces the trivial grothendieck topology. -/
theorem toGrothendieck_bot : toGrothendieck C ⊥ = ⊥ :=
  (gi C).gc.l_bot
#align category_theory.pretopology.to_grothendieck_bot CategoryTheory.Pretopology.toGrothendieck_bot

end Pretopology

end CategoryTheory