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

/-!
# 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.ghas_one A`
* `direct_sum.ghas_mul A`
* `direct_sum.gmonoid A`
* `direct_sum.gcomm_monoid A`

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

* `direct_sum.has_one`
* `direct_sum.mul_zero_class`, `direct_sum.distrib`
* `direct_sum.semiring`, `direct_sum.ring`
* `direct_sum.comm_semiring`, `direct_sum.comm_ring`

the base ring `A 0` with:

* `direct_sum.grade_zero.has_one`
* `direct_sum.grade_zero.mul_zero_class`, `direct_sum.grade_zero.distrib`
* `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:

* (nothing)
* `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)

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 sums of subobjects

Additionally, this module provides helper functions to construct `gmonoid` and `gcomm_monoid`
instances for:

* `A : ι → submonoid S`:
  `direct_sum.ghas_one.of_add_submonoids`, `direct_sum.ghas_mul.of_add_submonoids`,
  `direct_sum.gmonoid.of_add_submonoids`, `direct_sum.gcomm_monoid.of_add_submonoids`.
* `A : ι → subgroup S`:
  `direct_sum.ghas_one.of_add_subgroups`, `direct_sum.ghas_mul.of_add_subgroups`,
  `direct_sum.gmonoid.of_add_subgroups`, `direct_sum.gcomm_monoid.of_add_subgroups`.
* `A : ι → submodule S`:
  `direct_sum.ghas_one.of_submodules`, `direct_sum.ghas_mul.of_submodules`,
  `direct_sum.gmonoid.of_submodules`, `direct_sum.gcomm_monoid.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
-/
variables {ι : Type*} [decidable_eq ι]

namespace direct_sum

open_locale direct_sum

/-! ### Typeclasses -/
section defs

variables (A : ι → Type*)

/-- A graded version of `has_one`, which must be of grade 0. -/
class ghas_one [has_zero ι] :=
(one : A 0)

/-- A graded version of `has_mul` that also subsumes `distrib` and `mul_zero_class` by requiring
the multiplication be an `add_monoid_hom`. Multiplication combines grades additively, like
`add_monoid_algebra`. -/
class ghas_mul [has_add ι] [Π i, add_comm_monoid (A i)] :=
(mul {i j} : A i →+ A j →+ A (i + j))

variables {A}

/-- `direct_sum.ghas_one` implies a `has_one (Σ i, A i)`, although this is only used as an instance
locally to define notation in `direct_sum.gmonoid`. -/
def ghas_one.to_sigma_has_one [has_zero ι] [ghas_one A] : has_one (Σ i, A i) := ⟨⟨_, ghas_one.one⟩⟩

/-- `direct_sum.ghas_mul` implies a `has_mul (Σ i, A i)`, although this is only used as an instance
locally to define notation in `direct_sum.gmonoid`. -/
def ghas_mul.to_sigma_has_mul [has_add ι] [Π i, add_comm_monoid (A i)] [ghas_mul A] :
  has_mul (Σ i, A i) :=
⟨λ (x y : Σ i, A i), ⟨_, ghas_mul.mul x.snd y.snd⟩⟩

end defs

section defs

variables (A : ι → Type*)

local attribute [instance] ghas_one.to_sigma_has_one
local attribute [instance] ghas_mul.to_sigma_has_mul

/-- A graded version of `monoid`. -/
class gmonoid [add_monoid ι] [Π i, add_comm_monoid (A i)] extends ghas_mul A, ghas_one A :=
(one_mul (a : Σ i, A i) : 1 * a = a)
(mul_one (a : Σ i, A i) : a * 1 = a)
(mul_assoc (a : Σ i, A i) (b : Σ i, A i) (c : Σ i, A i) : a * b * c = a * (b * c))

/-- A graded version of `comm_monoid`. -/
class gcomm_monoid [add_comm_monoid ι] [Π i, add_comm_monoid (A i)] extends gmonoid A :=
(mul_comm (a : Σ i, A i) (b : Σ i, A i) : a * b = b * a)

end defs

/-! ### Shorthands for creating the above typeclasses -/

section shorthands

variables {R : Type*}

/-! #### From `add_submonoid`s -/

/-- Build a `ghas_one` instance for a collection of `add_submonoid`s. -/
@[simps one]
def ghas_one.of_add_submonoids [semiring R] [has_zero ι]
  (carriers : ι → add_submonoid R)
  (one_mem : (1 : R) ∈ carriers 0) :
  ghas_one (λ i, carriers i) :=
{ one := ⟨1, one_mem⟩ }

-- `@[simps]` doesn't generate a useful lemma, so we state one manually below.
/-- Build a `ghas_mul` instance for a collection of `add_submonoids`. -/
def ghas_mul.of_add_submonoids [semiring R] [has_add ι]
  (carriers : ι → add_submonoid R)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : R) ∈ carriers (i + j)) :
  ghas_mul (λ i, carriers i) :=
{ mul := λ i j,
  { to_fun := λ a,
    { to_fun := λ b, ⟨(a * b : R), mul_mem a b⟩,
      map_add' := λ _ _, subtype.ext (mul_add _ _ _),
      map_zero' := subtype.ext (mul_zero _), },
    map_add' := λ _ _, add_monoid_hom.ext $ λ _, subtype.ext (add_mul _ _ _),
    map_zero' := add_monoid_hom.ext $ λ _, subtype.ext (zero_mul _) }, }

-- `@[simps]` doesn't generate this well
@[simp] lemma ghas_mul.of_add_submonoids_mul [semiring R] [has_add ι]
  (carriers : ι → add_submonoid R) (mul_mem) {i j} (a : carriers i) (b : carriers j) :
  @ghas_mul.mul _ _ _ _ _ (ghas_mul.of_add_submonoids carriers mul_mem) i j a b =
    ⟨a * b, mul_mem a b⟩ := rfl

/-- Build a `gmonoid` instance for a collection of `add_submonoid`s. -/
@[simps to_ghas_one to_ghas_mul]
def gmonoid.of_add_submonoids [semiring R] [add_monoid ι]
  (carriers : ι → add_submonoid R)
  (one_mem : (1 : R) ∈ carriers 0)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : R) ∈ carriers (i + j)) :
  gmonoid (λ i, carriers i) :=
{ one_mul := λ ⟨i, a, h⟩, sigma.subtype_ext (zero_add _) (one_mul _),
  mul_one := λ ⟨i, a, h⟩, sigma.subtype_ext (add_zero _) (mul_one _),
  mul_assoc := λ ⟨i, a, ha⟩ ⟨j, b, hb⟩ ⟨k, c, hc⟩,
    sigma.subtype_ext (add_assoc _ _ _) (mul_assoc _ _ _),
  ..ghas_one.of_add_submonoids carriers one_mem,
  ..ghas_mul.of_add_submonoids carriers mul_mem }

/-- Build a `gcomm_monoid` instance for a collection of `add_submonoid`s. -/
@[simps to_gmonoid]
def gcomm_monoid.of_add_submonoids [comm_semiring R] [add_comm_monoid ι]
  (carriers : ι → add_submonoid R)
  (one_mem : (1 : R) ∈ carriers 0)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : R) ∈ carriers (i + j)) :
  gcomm_monoid (λ i, carriers i) :=
{ mul_comm := λ ⟨i, a, ha⟩ ⟨j, b, hb⟩, sigma.subtype_ext (add_comm _ _) (mul_comm _ _),
  ..gmonoid.of_add_submonoids carriers one_mem mul_mem}

/-! #### From `add_subgroup`s -/

/-- Build a `ghas_one` instance for a collection of `add_subgroup`s. -/
@[simps one]
def ghas_one.of_add_subgroups [ring R] [has_zero ι]
  (carriers : ι → add_subgroup R)
  (one_mem : (1 : R) ∈ carriers 0) :
  ghas_one (λ i, carriers i) :=
ghas_one.of_add_submonoids (λ i, (carriers i).to_add_submonoid) one_mem

-- `@[simps]` doesn't generate a useful lemma, so we state one manually below.
/-- Build a `ghas_mul` instance for a collection of `add_subgroup`s. -/
def ghas_mul.of_add_subgroups [ring R] [has_add ι]
  (carriers : ι → add_subgroup R)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : R) ∈ carriers (i + j)) :
  ghas_mul (λ i, carriers i) :=
ghas_mul.of_add_submonoids (λ i, (carriers i).to_add_submonoid) mul_mem

-- `@[simps]` doesn't generate this well
@[simp] lemma ghas_mul.of_add_subgroups_mul [ring R] [has_add ι]
  (carriers : ι → add_subgroup R) (mul_mem) {i j} (a : carriers i) (b : carriers j) :
  @ghas_mul.mul _ _ _ _ _ (ghas_mul.of_add_subgroups carriers mul_mem) i j a b =
    ⟨a * b, mul_mem a b⟩ := rfl

/-- Build a `gmonoid` instance for a collection of `add_subgroup`s. -/
@[simps to_ghas_one to_ghas_mul]
def gmonoid.of_add_subgroups [ring R] [add_monoid ι]
  (carriers : ι → add_subgroup R)
  (one_mem : (1 : R) ∈ carriers 0)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : R) ∈ carriers (i + j)) :
  gmonoid (λ i, carriers i) :=
gmonoid.of_add_submonoids (λ i, (carriers i).to_add_submonoid) one_mem mul_mem

/-- Build a `gcomm_monoid` instance for a collection of `add_subgroup`s. -/
@[simps to_gmonoid]
def gcomm_monoid.of_add_subgroups [comm_ring R] [add_comm_monoid ι]
  (carriers : ι → add_subgroup R)
  (one_mem : (1 : R) ∈ carriers 0)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : R) ∈ carriers (i + j)) :
  gcomm_monoid (λ i, carriers i) :=
gcomm_monoid.of_add_submonoids (λ i, (carriers i).to_add_submonoid) one_mem mul_mem

/-! #### From `submodules`s -/

variables {A : Type*}

/-- Build a `ghas_one` instance for a collection of `submodule`s. -/
@[simps one]
def ghas_one.of_submodules
  [comm_semiring R] [semiring A] [algebra R A] [has_zero ι]
  (carriers : ι → submodule R A)
  (one_mem : (1 : A) ∈ carriers 0) :
  ghas_one (λ i, carriers i) :=
ghas_one.of_add_submonoids (λ i, (carriers i).to_add_submonoid) one_mem

-- `@[simps]` doesn't generate a useful lemma, so we state one manually below.
/-- Build a `ghas_mul` instance for a collection of `submodule`s. -/
def ghas_mul.of_submodules
  [comm_semiring R] [semiring A] [algebra R A] [has_add ι]
  (carriers : ι → submodule R A)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : A) ∈ carriers (i + j)) :
  ghas_mul (λ i, carriers i) :=
ghas_mul.of_add_submonoids (λ i, (carriers i).to_add_submonoid) mul_mem

-- `@[simps]` doesn't generate this well
@[simp] lemma ghas_mul.of_submodules_mul
  [comm_semiring R] [semiring A] [algebra R A] [has_add ι]
  (carriers : ι → submodule R A) (mul_mem) {i j} (a : carriers i) (b : carriers j) :
  @ghas_mul.mul _ _ _ _ _ (ghas_mul.of_submodules carriers mul_mem) i j a b =
    ⟨a * b, mul_mem a b⟩ := rfl

/-- Build a `gmonoid` instance for a collection of `submodules`s. -/
@[simps to_ghas_one to_ghas_mul]
def gmonoid.of_submodules
  [comm_semiring R] [semiring A] [algebra R A] [add_monoid ι]
  (carriers : ι → submodule R A)
  (one_mem : (1 : A) ∈ carriers 0)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : A) ∈ carriers (i + j)) :
  gmonoid (λ i, carriers i) :=
gmonoid.of_add_submonoids (λ i, (carriers i).to_add_submonoid) one_mem mul_mem

/-- Build a `gcomm_monoid` instance for a collection of `submodules`s. -/
@[simps to_gmonoid]
def gcomm_monoid.of_submodules
  [comm_semiring R] [comm_semiring A] [algebra R A] [add_comm_monoid ι]
  (carriers : ι → submodule R A)
  (one_mem : (1 : A) ∈ carriers 0)
  (mul_mem : ∀ ⦃i j⦄ (gi : carriers i) (gj : carriers j), (gi * gj : A) ∈ carriers (i + j)) :
  gcomm_monoid (λ i, carriers i) :=
gcomm_monoid.of_add_submonoids (λ i, (carriers i).to_add_submonoid) one_mem mul_mem

end shorthands

variables (A : ι → Type*)

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

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

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

end one

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

open add_monoid_hom (map_zero map_add flip_apply coe_comp comp_hom_apply_apply)

/-- 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 ghas_mul.mul

instance : has_mul (⨁ i, A i) :=
{ mul := λ a b, mul_hom A a b }

instance : mul_zero_class (⨁ i, A i) :=
{ mul := (*),
  zero := 0,
  zero_mul := λ a, by { unfold has_mul.mul, simp only [map_zero, add_monoid_hom.zero_apply]},
  mul_zero := λ a, by { unfold has_mul.mul, simp only [map_zero] } }

instance : distrib (⨁ i, A i) :=
{ mul := (*),
  add := (+),
  left_distrib := λ a b c, by { unfold has_mul.mul, simp only [map_add]},
  right_distrib := λ a b c, by { unfold has_mul.mul, simp only [map_add, add_monoid_hom.add_apply]}}

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) (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],
end

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

end mul

section semiring
variables [Π i, add_comm_monoid (A i)] [add_monoid ι] [gmonoid 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 dfinsupp.single_eq_of_sigma_eq (gmonoid.one_mul ⟨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 dfinsupp.single_eq_of_sigma_eq (gmonoid.mul_one ⟨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 dfinsupp.single_eq_of_sigma_eq (gmonoid.mul_assoc ⟨ai, ax⟩ ⟨bi, bx⟩ ⟨ci, cx⟩),
end

/-- The `semiring` structure derived from `gmonoid 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,
  ..direct_sum.mul_zero_class A,
  ..direct_sum.distrib A,
  ..direct_sum.add_comm_monoid _ _, }

end semiring

section comm_semiring

variables [Π i, add_comm_monoid (A i)] [add_comm_monoid ι] [gcomm_monoid 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 dfinsupp.single_eq_of_sigma_eq (gcomm_monoid.mul_comm ⟨ai, ax⟩ ⟨bi, bx⟩),
end

/-- The `comm_semiring` structure derived from `gcomm_monoid 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 ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gmonoid A]

/-- The `ring` derived from `gmonoid A`. -/
instance ring : ring (⨁ i, A i) := {
  one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.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_monoid A]

/-- The `comm_ring` derived from `gcomm_monoid 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 ι] [ghas_one A] [Π i, add_comm_monoid (A i)]

/-- `1 : A 0` is the value provided in `direct_sum.ghas_one.one`. -/
@[nolint unused_arguments]
instance grade_zero.has_one : has_one (A 0) :=
⟨ghas_one.one⟩

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

end one

section mul
variables [add_monoid ι] [Π i, add_comm_monoid (A i)] [ghas_mul A]

/-- `(•) : A 0 → A i → A i` is the value provided in `direct_sum.ghas_mul.mul`, composed with
an `eq.rec` to turn `A (0 + i)` into `A i`.
-/
instance grade_zero.has_scalar (i : ι) : has_scalar (A 0) (A i) :=
{ smul := λ x y, (zero_add i).rec (ghas_mul.mul x y) }

/-- `(*) : A 0 → A 0 → A 0` is the value provided in `direct_sum.ghas_mul.mul`, composed with
an `eq.rec` to turn `A (0 + 0)` into `A 0`.
-/
instance grade_zero.has_mul : has_mul (A 0) :=
{ mul := (•) }

@[simp]lemma grade_zero.smul_eq_mul (a b : A 0) : a • b = a * b := rfl

@[simp] lemma of_zero_smul {i} (a : A 0) (b : A i) : of _ _ (a • b) = of _ _ a * of _ _ b :=
begin
  rw of_mul_of,
  dsimp [has_mul.mul, direct_sum.of, dfinsupp.single_add_hom_apply],
  congr' 1,
  rw zero_add,
  apply eq_rec_heq,
end

@[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.mul_zero_class : mul_zero_class (A 0) :=
function.injective.mul_zero_class (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_mul A)

instance grade_zero.distrib : distrib (A 0) :=
function.injective.distrib (of A 0) dfinsupp.single_injective
  (of A 0).map_add (of_zero_mul A)

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 ι] [gmonoid A]

/-- The `semiring` structure derived from `gmonoid 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` 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 `gmonoid 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_monoid A]

/-- The `comm_semiring` structure derived from `gcomm_monoid 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)

end comm_semiring

section ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gmonoid A]

/-- The `ring` derived from `gmonoid 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

end ring

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

/-- The `comm_ring` derived from `gcomm_monoid 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

end comm_ring

end grade_zero

end direct_sum

/-! ### Concrete instances -/

namespace submodule

variables {R A : Type*} [comm_semiring R]

/-- A direct sum of powers of a submodule of an algebra has a multiplicative structure. -/
instance nat_power_direct_sum_gmonoid [semiring A] [algebra R A] (S : submodule R A) :
  direct_sum.gmonoid (λ i : ℕ, ↥(S ^ i)) :=
direct_sum.gmonoid.of_submodules _
  (by { rw [←one_le, pow_zero], exact le_rfl })
  (λ i j p q, by { rw pow_add, exact submodule.mul_mem_mul p.prop q.prop })

/-- A direct sum of powers of a submodule of a commutative algebra has a commutative multiplicative
structure. -/
instance nat_power_direct_sum_gcomm_monoid [comm_semiring A] [algebra R A] (S : submodule R A) :
  direct_sum.gcomm_monoid (λ i : ℕ, ↥(S ^ i)) :=
direct_sum.gcomm_monoid.of_submodules _
  (by { rw [←one_le, pow_zero], exact le_rfl })
  (λ i j p q, by { rw pow_add, exact submodule.mul_mem_mul p.prop q.prop })

end submodule


import ..geom.geom3d

open_locale affine

section foo

universes u
#check add_maps

abbreviation geom3d_frame :=
    (mk_prod_spc (mk_prod_spc geom1d_std_space geom1d_std_space) geom1d_std_space).frame_type
abbreviation geom3d_space (f : geom3d_frame) := spc real_scalar f
noncomputable def geom3d_std_frame :=
    (mk_prod_spc (mk_prod_spc geom1d_std_space geom1d_std_space) geom1d_std_space).frame
noncomputable def geom3d_std_space : geom3d_space geom3d_std_frame :=
    (mk_prod_spc (mk_prod_spc geom1d_std_space geom1d_std_space) geom1d_std_space)

--@[reducible, elab_with_expected_type]
/-
def geom3d_std_frame : geom3d_frame := (let eqpf :
  (add_maps
    (add_maps
      (λi : fin 1, LENGTH) (λi : fin 1, LENGTH)) (λi : fin 1, LENGTH)) =
        LENGTH :=
    by simp * in
  (eq.rec_on eqpf (mk_prod_spc (mk_prod_spc geom1d_std_space geom1d_std_space) geom1d_std_space).fm) : fm real_scalar 3 LENGTH)
-/

/-
def ppp := mk_prod_spc (mk_prod_spc geom1d_std_space geom1d_std_space) geom1d_std_space

#check (merge_prod_fm (merge_prod_fm geom1d_std_frame geom1d_std_frame) geom1d_std_frame)

example : ppp.fm = geom3d_std_frame :=

#check spc.rec_on

#check @spc.rec_on real_scalar _ _ (λ dim, λ id_vec, λf, λ sp,)

#check eq.rec

#check homogeneous

def geom3d_std_space : geom3d_space (_ : geom3d_frame) :=
    begin
        let v : spc real_scalar (_ : fm real_scalar (1 + 1 + 1) (add_maps (add_maps ↑LENGTH ↑LENGTH) ↑LENGTH)) :=
            mk_prod_spc (mk_prod_spc geom1d_std_space geom1d_std_space) geom1d_std_space,
        let f := v.fm,
        let : v.frame_type = fm real_scalar (1 + 1 + 1) (add_maps (add_maps ↑LENGTH ↑LENGTH) ↑LENGTH) := rfl,
        let : v.frame_type = geom3d_frame := begin
            let eqf : (add_maps
    (add_maps
      (λi : fin 1, LENGTH) (λi : fin 1, LENGTH)) (λi : fin 1, LENGTH)) = (λ i:fin 3, LENGTH) := by simp *,
            simp *,
            refl
        end,
        let h : fm real_scalar (1 + 1 + 1) (add_maps (add_maps ↑LENGTH ↑LENGTH) ↑LENGTH) = geom3d_frame
            := begin simp *,
                refl
            end,
        let fm_ := v.fm,
        simp * at v,
        let fm_g : geom3d_frame := eq.rec fm_ (begin

        end),
        let vg : geom3d_space geom3d_frame := eq.rec v (by cc)
        let : v.fm = geom3d_std_frame := rfl,

        exact v,
    end
-/

structure position3d {f : geom3d_frame} (s : geom3d_space f ) extends point s
@[ext] lemma position3d.ext : ∀  {f : geom3d_frame} {s : geom3d_space f } (x y : position3d s),
    x.to_point = y.to_point → x = y :=
    begin
        intros f s x y e,
        cases x,
        cases y,
        simp *,
        have h₁ : ({to_point := x} : position3d s).to_point = x := rfl,
        simp [h₁] at e,
        exact e
    end

noncomputable def position3d.coords {f : geom3d_frame} {s : geom3d_space f } (t :position3d s) :=
    t.to_point.coords

noncomputable def position3d.x {f : geom3d_frame} {s : geom3d_space f } (t :position3d s) : real_scalar :=
    (t.to_point.coords 0).coord

noncomputable def position3d.y {f : geom3d_frame} {s : geom3d_space f } (t :position3d s) : real_scalar :=
    (t.to_point.coords 1).coord

noncomputable def position3d.z {f : geom3d_frame} {s : geom3d_space f } (t :position3d s) : real_scalar :=
    (t.to_point.coords 2).coord

@[simp]
def mk_position3d' {f : geom3d_frame} (s : geom3d_space f ) (p : point s) : position3d s := position3d.mk p
@[simp]
noncomputable def mk_position3d {f : geom3d_frame} (s : geom3d_space f ) (k₁ k₂ k₃ : real_scalar) : position3d s := position3d.mk (mk_point s ⟨[k₁,k₂,k₃],rfl⟩)

@[simp]
noncomputable def mk_position3d'' {f1 f2 f3 : geom1d_frame } { s1 : geom1d_space f1} {s2 : geom1d_space f2} { s3 : geom1d_space f3}
    (p1 : position1d s1) (p2 : position1d s2) (p3 : position1d s3 )
    : position3d (mk_prod_spc (mk_prod_spc s1 s2) s3) :=
    ⟨mk_point_prod (mk_point_prod p1.to_point p2.to_point) p3.to_point⟩

structure displacement3d {f : geom3d_frame} (s : geom3d_space f ) extends vectr s
@[ext] lemma displacement3d.ext : ∀  {f : geom3d_frame} {s : geom3d_space f } (x y : displacement3d s),
    x.to_vectr = y.to_vectr → x = y :=
    begin
        intros f s x y e,
        cases x,
        cases y,
        simp *,
        have h₁ : ({to_vectr := x} : displacement3d s).to_vectr = x := rfl,
        simp [h₁] at e,
        exact e
    end

def displacement3d.frame {f : geom3d_frame} {s : geom3d_space f } (d :displacement3d s) :=
    f

noncomputable def displacement3d.coords {f : geom3d_frame} {s : geom3d_space f } (d :displacement3d s) :=
    d.to_vectr.coords

@[simp]
def mk_displacement3d' {f : geom3d_frame} (s : geom3d_space f ) (v : vectr s) : displacement3d s := displacement3d.mk v
@[simp]
noncomputable def mk_displacement3d  {f : geom3d_frame} (s : geom3d_space f ) (k₁ k₂ k₃ : real_scalar) : displacement3d s := displacement3d.mk (mk_vectr s ⟨[k₁,k₂,k₃],rfl⟩)

@[simp]
noncomputable def mk_displacement3d'' {f1 f2 f3 : geom1d_frame } { s1 : geom1d_space f1} {s2 : geom1d_space f2} { s3 : geom1d_space f3}
    (p1 : displacement1d s1) (p2 : displacement1d s2) (p3 : displacement1d s3 )
    : displacement3d (mk_prod_spc (mk_prod_spc s1 s2) s3) :=
    ⟨mk_vectr_prod (mk_vectr_prod p1.to_vectr p2.to_vectr) p3.to_vectr⟩

@[simp]
noncomputable def mk_geom3d_frame {parent : geom3d_frame} {s : spc real_scalar parent} (p : position3d s)
    (v0 : displacement3d s) (v1 : displacement3d s) (v2 : displacement3d s)
    : geom3d_frame :=
    (mk_frame p.to_point ⟨(λi, if i = 0 then v0.to_vectr else if i = 1 then v1.to_vectr else v2.to_vectr),sorry,sorry⟩)

@[simp]
noncomputable def mk_geom3d_space (fr : geom3d_frame) := mk_space fr

end foo

section bar

/-
    *************************************
    Instantiate module real_scalar (vector real_scalar)
    *************************************
-/

namespace geom3d
variables {f : geom3d_frame} {s : geom3d_space f }
@[simp]
noncomputable def add_displacement3d_displacement3d (v3 v2 : displacement3d s) : displacement3d s :=
    mk_displacement3d' s (v3.to_vectr + v2.to_vectr)
@[simp]
noncomputable def smul_displacement3d (k : real_scalar) (v : displacement3d s) : displacement3d s :=
    mk_displacement3d' s (k • v.to_vectr)
@[simp]
noncomputable def neg_displacement3d (v : displacement3d s) : displacement3d s :=
    mk_displacement3d' s ((-1 : real_scalar) • v.to_vectr)
@[simp]
noncomputable def sub_displacement3d_displacement3d (v3 v2 : displacement3d s) : displacement3d s :=    -- v3-v2
    add_displacement3d_displacement3d v3 (neg_displacement3d v2)

noncomputable instance has_add_displacement3d : has_add (displacement3d s) := ⟨ add_displacement3d_displacement3d ⟩
lemma add_assoc_displacement3d : ∀ a b c : displacement3d s, a + b + c = a + (b + c) := begin
    intros,
    ext,
    dsimp only [has_add.add],
    dsimp only [add_displacement3d_displacement3d, has_add.add],
    dsimp only [add_vectr_vectr, has_add.add],
    dsimp only [add_vec_vec, mk_displacement3d', mk_vectr'],
    simp only [add_assoc],
end
noncomputable instance add_semigroup_displacement3d : add_semigroup (displacement3d s) := ⟨ add_displacement3d_displacement3d, add_assoc_displacement3d⟩
@[simp]
noncomputable def displacement3d_zero  := mk_displacement3d s 0 0 0
noncomputable instance : inhabited (displacement3d s) := ⟨displacement3d_zero⟩
noncomputable instance has_zero_displacement3d : has_zero (displacement3d s) := ⟨displacement3d_zero⟩

lemma zero_add_displacement3d : ∀ a : displacement3d s, 0 + a = a :=
begin
    intros,
    ext,
    dsimp only [has_zero.zero, has_add.add],
    dsimp only [add_displacement3d_displacement3d, displacement3d_zero, mk_displacement3d', mk_displacement3d, has_add.add],
    dsimp only [add_vectr_vectr, mk_vectr', mk_vectr, mk_vec_n, has_add.add],
    dsimp only [add_vec_vec, mk_vec, vector.nth],
    cases x,
    dsimp only [fin.mk],
    cases x_val with x',
    simp only [list.nth_le, zero_add],
    simp only [add_left_eq_self, list.nth_le],
    cases x' with x'',
    simp only [list.nth_le, zero_add],
    simp only [add_left_eq_self, list.nth_le],
    cases x'' with x''',
    simp only [list.nth_le, zero_add],
    have h₀ : x'''.succ.succ.succ = x''' + 3 := rfl,
    have h₁ : 1 + 1 + 1 = 0 + 3 := rfl,
    rw [h₀, h₁] at x_property,
    have h₂ : x'''.succ + 3 ≤ 0 + 3 := begin
        dsimp only [has_lt.lt, nat.lt] at x_property,
        dsimp only [has_le.le],
        exact x_property,
    end,
    have h₃ := (add_le_add_iff_right 3).1 h₂,
    simp only [nat.not_succ_le_zero] at h₃,
    contradiction,
end

lemma add_zero_displacement3d : ∀ a : displacement3d s, a + 0 = a :=
begin
    intros,
    ext,
    dsimp only [has_zero.zero, has_add.add],
    dsimp only [add_displacement3d_displacement3d, displacement3d_zero, mk_displacement3d', mk_displacement3d, has_add.add],
    dsimp only [add_vectr_vectr, mk_vectr', mk_vectr, mk_vec_n, has_add.add],
    dsimp only [add_vec_vec, mk_vec, vector.nth],
    cases x,
    dsimp only [fin.mk],
    cases x_val with x',
    simp only [list.nth_le, add_zero],
    simp only [add_left_eq_self, list.nth_le],
    cases x' with x'',
    simp only [list.nth_le, add_zero],
    simp only [add_left_eq_self, list.nth_le],
    cases x'' with x''',
    simp only [list.nth_le, add_zero],
    have h₀ : x'''.succ.succ.succ = x''' + 3 := rfl,
    have h₁ : 1 + 1 + 1 = 0 + 3 := rfl,
    rw [h₀, h₁] at x_property,
    have h₂ : x'''.succ + 3 ≤ 0 + 3 := begin
        dsimp only [has_lt.lt, nat.lt] at x_property,
        dsimp only [has_le.le],
        exact x_property,
    end,
    have h₃ := (add_le_add_iff_right 3).1 h₂,
    simp only [nat.not_succ_le_zero] at h₃,
    contradiction,
end

@[simp]
noncomputable def nsmul_displacement3d : ℕ → (displacement3d s) → (displacement3d s)
| nat.zero v := displacement3d_zero
--| 3 v := v
| (nat.succ n) v := (add_displacement3d_displacement3d) v (nsmul_displacement3d n v)

noncomputable instance add_monoid_displacement3d : add_monoid (displacement3d s) := ⟨
    -- add_semigroup
    add_displacement3d_displacement3d,
    add_assoc_displacement3d,
    -- has_zero
    displacement3d_zero,
    -- new structure
    @zero_add_displacement3d f s,
    add_zero_displacement3d,
    nsmul_displacement3d,
    begin
        admit
    end,
    begin
        admit
    end
⟩

noncomputable instance has_neg_displacement3d : has_neg (displacement3d s) := ⟨neg_displacement3d⟩
noncomputable instance has_sub_displacement3d : has_sub (displacement3d s) := ⟨ sub_displacement3d_displacement3d⟩
lemma sub_eq_add_neg_displacement3d : ∀ a b : displacement3d s, a - b = a + -b :=
begin
    intros,ext,
    refl,
end

noncomputable instance sub_neg_monoid_displacement3d : sub_neg_monoid (displacement3d s) :=
{
    neg := neg_displacement3d ,
    ..(show add_monoid (displacement3d s), by apply_instance)
}

lemma add_left_neg_displacement3d : ∀ a : displacement3d s, -a + a = 0 :=
begin
    intros,
    ext,
    dsimp only [has_zero.zero, has_add.add, has_neg.neg],
    dsimp only [neg_displacement3d, has_scalar.smul],
    dsimp only [add_displacement3d_displacement3d, smul_vectr, has_add.add, has_scalar.smul],
    dsimp only [add_vectr_vectr, smul_vec, mk_displacement3d', mk_vectr', has_add.add],
    dsimp only [add_vec_vec],
    simp only [neg_mul_eq_neg_mul_symm, one_mul, mk_vectr, displacement3d_zero, mk_displacement3d, add_left_neg],
    dsimp only [mk_vec_n, mk_vec, vector.nth],
    cases x,
    dsimp only [fin.mk],
    cases x_val with x',
    simp only [list.nth_le],
    simp only [add_left_eq_self, list.nth_le],
    cases x' with x'',
    simp only [list.nth_le],
    simp only [add_left_eq_self, list.nth_le],
    cases x'' with x''',
    simp only [list.nth_le],
    have h₀ : x'''.succ.succ.succ = x''' + 3 := rfl,
    have h₁ : 1 + 1 + 1 = 0 + 3 := rfl,
    rw [h₀, h₁] at x_property,
    have h₂ : x'''.succ + 3 ≤ 0 + 3 := begin
        dsimp only [has_lt.lt, nat.lt] at x_property,
        dsimp only [has_le.le],
        exact x_property,
    end,
    have h₃ := (add_le_add_iff_right 3).1 h₂,
    simp only [nat.not_succ_le_zero] at h₃,
    contradiction,
end

noncomputable instance : add_group (displacement3d s) := {
    add_left_neg := begin
        exact add_left_neg_displacement3d,
    end,
..(show sub_neg_monoid (displacement3d s), by apply_instance),

}

lemma add_comm_displacement3d : ∀ a b : displacement3d s, a + b = b + a :=
begin
    intros,
    ext,
    dsimp only [has_add.add],
    dsimp only [add_displacement3d_displacement3d, has_add.add],
    dsimp only [add_vectr_vectr, has_add.add],
    dsimp only [add_vec_vec, mk_displacement3d', mk_vectr'],
    simp only [add_comm],
end
noncomputable instance add_comm_semigroup_displacement3d : add_comm_semigroup (displacement3d s) := ⟨
    -- add_semigroup
    add_displacement3d_displacement3d,
    add_assoc_displacement3d,
    add_comm_displacement3d,
⟩

noncomputable instance add_comm_monoid_displacement3d : add_comm_monoid (displacement3d s) := {
    add_comm := begin
        exact add_comm_displacement3d
    end,
    ..(show add_monoid (displacement3d s), by apply_instance)
}

noncomputable instance has_scalar_displacement3d : has_scalar real_scalar (displacement3d s) := ⟨
smul_displacement3d,
⟩

lemma one_smul_displacement3d : ∀ b : displacement3d s, (1 : real_scalar) • b = b := begin
    intros,
    ext,
    dsimp only [has_scalar.smul],
    dsimp only [smul_displacement3d, has_scalar.smul],
    dsimp only [smul_vectr, has_scalar.smul],
    dsimp only [smul_vec, mk_displacement3d', mk_vectr'],
    simp only [one_mul],
end
lemma mul_smul_displacement3d : ∀ (x y : real_scalar) (b : displacement3d s), (x * y) • b = x • y • b :=
begin
    intros,
    cases b,
    ext,
    exact mul_assoc x y _,
end

noncomputable instance mul_action_displacement3d : mul_action real_scalar (displacement3d s) := ⟨
one_smul_displacement3d,
mul_smul_displacement3d,
⟩

lemma smul_add_displacement3d : ∀(r : real_scalar) (x y : displacement3d s), r • (x + y) = r • x + r • y := begin
    intros,
    ext,
    dsimp only [has_scalar.smul, has_add.add],
    dsimp only [smul_displacement3d, add_displacement3d_displacement3d, has_scalar.smul, has_add.add],
    dsimp only [smul_vectr, add_vectr_vectr, has_scalar.smul, has_add.add],
    dsimp only [smul_vec, add_vec_vec, mk_displacement3d', mk_vectr'],
    simp only [distrib.left_distrib],
    refl,
end
lemma smul_zero_displacement3d : ∀(r : real_scalar), r • (0 : displacement3d s) = 0 := begin
    intros,
    ext,
    dsimp only [has_scalar.smul, has_zero.zero],
    dsimp only [smul_displacement3d, displacement3d_zero, has_scalar.smul],
    dsimp only [smul_vectr, has_scalar.smul],
    dsimp only [smul_vec, mk_displacement3d', mk_vectr', mk_displacement3d, mk_vectr, mk_vec_n, mk_vec, vector.nth],
    cases x,
    dsimp only [fin.mk],
    cases x_val with x',
    simp only [list.nth_le, mul_zero],
    simp only [list.nth_le],
    cases x' with x'',
    simp only [list.nth_le, mul_zero],
    simp only [list.nth_le],
    cases x'' with x''',
    simp only [list.nth_le, mul_zero],
    have h₀ : x'''.succ.succ.succ = x''' + 3 := rfl,
    have h₁ : 1 + 1 + 1 = 0 + 3 := rfl,
    rw [h₀, h₁] at x_property,
    have h₂ : x'''.succ + 3 ≤ 0 + 3 := begin
        dsimp only [has_lt.lt, nat.lt] at x_property,
        dsimp only [has_le.le],
        exact x_property,
    end,
    have h₃ := (add_le_add_iff_right 3).1 h₂,
    simp only [nat.not_succ_le_zero] at h₃,
    contradiction,
end
noncomputable instance distrib_mul_action_K_displacement3d : distrib_mul_action real_scalar (displacement3d s) := ⟨
smul_add_displacement3d,
smul_zero_displacement3d,
⟩

-- renaming vs template due to clash with name "s" for prevailing variable
lemma add_smul_displacement3d : ∀ (a b : real_scalar) (x : displacement3d s), (a + b) • x = a • x + b • x :=
begin
  intros,
  ext,
  exact right_distrib _ _ _,
end
lemma zero_smul_displacement3d : ∀ (x : displacement3d s), (0 : real_scalar) • x = 0 := begin
    intros,
    ext,
    dsimp only [has_scalar.smul, has_zero.zero],
    dsimp only [smul_displacement3d, displacement3d_zero, has_scalar.smul],
    dsimp only [smul_vectr, has_scalar.smul],
    dsimp only [smul_vec, mk_displacement3d', mk_vectr', mk_displacement3d, mk_vectr, mk_vec_n, mk_vec, vector.nth],
    cases x_1,
    dsimp only [fin.mk],
    cases x_1_val with x',
    simp only [list.nth_le, mul_eq_zero],
    apply or.inl,
    refl,
    simp only [list.nth_le],
    cases x' with x'',
    simp only [list.nth_le, mul_eq_zero],
    apply or.inl,
    refl,
    simp only [list.nth_le],
    cases x'' with x''',
    simp only [list.nth_le, mul_eq_zero],
    apply or.inl,
    refl,
    have h₀ : x'''.succ.succ.succ = x''' + 3 := rfl,
    have h₁ : 1 + 1 + 1 = 0 + 3 := rfl,
    rw [h₀, h₁] at x_1_property,
    have h₂ : x'''.succ + 3 ≤ 0 + 3 := begin
        dsimp only [has_lt.lt, nat.lt] at x_1_property,
        dsimp only [has_le.le],
        exact x_1_property,
    end,
    have h₃ := (add_le_add_iff_right 3).1 h₂,
    simp only [nat.not_succ_le_zero] at h₃,
    contradiction,
end
noncomputable instance module_K_displacement3d : module real_scalar (displacement3d s) := ⟨ add_smul_displacement3d, zero_smul_displacement3d ⟩

noncomputable instance add_comm_group_displacement3d : add_comm_group (displacement3d s) := {
    add_comm := begin
        exact add_comm_displacement3d
    end,
..(show add_group (displacement3d s), by apply_instance)
}
noncomputable instance : module real_scalar (displacement3d s) := @geom3d.module_K_displacement3d f s

/-
    ********************
    *** Affine space ***
    ********************
-/

/-
Affine operations
-/
noncomputable instance : has_add (displacement3d s) := ⟨add_displacement3d_displacement3d⟩
noncomputable instance : has_zero (displacement3d s) := ⟨displacement3d_zero⟩
noncomputable instance : has_neg (displacement3d s) := ⟨neg_displacement3d⟩

/-
Lemmas needed to implement affine space API
-/
@[simp]
noncomputable def sub_position3d_position3d {f : geom3d_frame} {s : geom3d_space f } (p3 p2 : position3d s) : displacement3d s :=
    mk_displacement3d' s (p3.to_point -ᵥ p2.to_point)
@[simp]
noncomputable def add_position3d_displacement3d {f : geom3d_frame} {s : geom3d_space f } (p : position3d s) (v : displacement3d s) : position3d s :=
    mk_position3d' s (v.to_vectr +ᵥ p.to_point) -- reorder assumes order is irrelevant
@[simp]
noncomputable def add_displacement3d_position3d {f : geom3d_frame} {s : geom3d_space f } (v : displacement3d s) (p : position3d s) : position3d s :=
    mk_position3d' s (v.to_vectr +ᵥ p.to_point)
--@[simp]
--def aff_displacement3d_group_action : displacement3d s → position3d s → position3d s := add_displacement3d_position3d real_scalar
noncomputable instance : has_vadd (displacement3d s) (position3d s) := ⟨add_displacement3d_position3d⟩

lemma zero_displacement3d_vadd'_a3 : ∀ p : position3d s, (0 : displacement3d s) +ᵥ p = p := begin
    intros,
    ext,
    dsimp only [has_vadd.vadd, has_zero.zero],
    dsimp only [add_displacement3d_position3d, displacement3d_zero, has_vadd.vadd],
    dsimp only [add_vectr_point, has_vadd.vadd],
    dsimp only [aff_vec_group_action, add_vec_pt, mk_position3d', mk_point', mk_displacement3d, mk_vectr, mk_vec_n, mk_vec, vector.nth],
    cases x,
    dsimp only [fin.mk],
    cases x_val with x',
    simp only [list.nth_le, add_zero],
    simp only [list.nth_le],
    cases x' with x'',
    simp only [list.nth_le, add_zero],
    simp only [list.nth_le],
    cases x'' with x''',
    simp only [list.nth_le, add_zero],
    have h₀ : x'''.succ.succ.succ = x''' + 3 := rfl,
    have h₁ : 1 + 1 + 1 = 0 + 3 := rfl,
    rw [h₀, h₁] at x_property,
    have h₂ : x'''.succ + 3 ≤ 0 + 3 := begin
        dsimp only [has_lt.lt, nat.lt] at x_property,
        dsimp only [has_le.le],
        exact x_property,
    end,
    have h₃ := (add_le_add_iff_right 3).1 h₂,
    simp only [nat.not_succ_le_zero] at h₃,
    contradiction,
end
lemma displacement3d_add_assoc'_a3 : ∀ (g3 g2 : displacement3d s) (p : position3d s), g3 +ᵥ (g2 +ᵥ p) = (g3 + g2) +ᵥ p := begin
    intros,
    ext,
    dsimp only [has_add.add, has_vadd.vadd],
    dsimp only [add_displacement3d_position3d, add_displacement3d_displacement3d, has_add.add, has_vadd.vadd],
    dsimp only [add_vectr_point, add_vectr_vectr, has_add.add, has_vadd.vadd],
    dsimp only [aff_vec_group_action, add_vec_vec, add_vec_pt, mk_position3d', mk_point', mk_displacement3d', mk_vectr'],
    simp only [add_assoc, add_right_inj],
    simp only [add_comm],
end

noncomputable instance displacement3d_add_action: add_action (displacement3d s) (position3d s) :=
⟨ zero_displacement3d_vadd'_a3,
begin
    let h0 := displacement3d_add_assoc'_a3,
    intros,
    exact (h0 g₁ g₂ p).symm
end⟩
--@[simp]
--def aff_geom3d_group_sub : position3d s → position3d s → displacement3d s := sub_geom3d_position3d real_scalar
noncomputable instance position3d_has_vsub : has_vsub (displacement3d s) (position3d s) := ⟨ sub_position3d_position3d⟩

instance : nonempty (position3d s) := ⟨mk_position3d s 0 0 0⟩
noncomputable instance : inhabited (position3d s) := ⟨mk_position3d s 0 0 0⟩

lemma position3d_vsub_vadd_a3 : ∀ (p3 p2 : (position3d s)), (p3 -ᵥ p2) +ᵥ p2 = p3 := begin
    intros,
    ext,
    dsimp only [has_vsub.vsub, has_vadd.vadd],
    dsimp only [add_displacement3d_position3d, sub_position3d_position3d, has_vsub.vsub, has_vadd.vadd],
    dsimp only [add_vectr_point, aff_point_group_sub, sub_point_point, has_vsub.vsub, has_vadd.vadd],
    dsimp only [aff_vec_group_action, aff_point_group_sub, add_vec_pt, aff_pt_group_sub, sub_pt_pt, mk_position3d', mk_point', mk_displacement3d', mk_vectr'],
    simp only [add_sub_cancel'_right],
end
lemma position3d_vadd_vsub_a3 : ∀ (g : displacement3d s) (p : position3d s), g +ᵥ p -ᵥ p = g :=
begin
    intros, ext,
    repeat {
    have h0 : ((g +ᵥ p -ᵥ p) : displacement3d s).to_vectr = (g.to_vectr +ᵥ p.to_point -ᵥ p.to_point) := rfl,
    rw h0,
    simp *,
    }

end

noncomputable instance aff_geom3d_torsor : add_torsor (displacement3d s) (position3d s) :=
⟨
    begin
        exact position3d_vsub_vadd_a3,
    end,
    begin
        exact position3d_vadd_vsub_a3,
    end,
⟩

open_locale affine

noncomputable instance : affine_space (displacement3d s) (position3d s) := @geom3d.aff_geom3d_torsor f s

end geom3d -- ha ha
end bar

/-
Newer version
Tradeoff - Does not directly extend from affine equiv. Base class is an equiv on points and vectrs

Extension methods are provided to directly transform Times and Duration between frames
-/
@[ext]
structure geom3d_transform {f3 : geom3d_frame} {f2 : geom3d_frame} (sp3 : geom3d_space f3) (sp2 : geom3d_space f2)
  extends fm_tr sp3 sp2

noncomputable def geom3d_space.mk_geom3d_transform_to {f3 : geom3d_frame} (s3 : geom3d_space f3) : Π {f2 : geom3d_frame} (s2 : geom3d_space f2),
        geom3d_transform s3 s2 := --(position3d s2) ≃ᵃ[scalar] (position3d s3) :=
    λ f2 s2,
        ⟨s3.fm_tr s2⟩

noncomputable instance g3tr_inh {f3 : geom3d_frame} {f2 : geom3d_frame} (sp3 : geom3d_space f3) (sp2 : geom3d_space f2)
    : inhabited (geom3d_transform  sp3 sp2) := ⟨sp3.mk_geom3d_transform_to sp2⟩

noncomputable def geom3d_transform.symm
    {f3 : geom3d_frame} {f2 : geom3d_frame} {sp3 : geom3d_space f3} {sp2 : geom3d_space f2} (ttr : geom3d_transform sp3 sp2)
    : geom3d_transform sp2 sp3 := ⟨(ttr.1).symm⟩

noncomputable def geom3d_transform.trans
    {f3 : geom3d_frame} {f2 : geom3d_frame} {f3 : geom3d_frame} {sp3 : geom3d_space f3} {sp2 : geom3d_space f2} {sp3 : geom3d_space f3}
    (ttr : geom3d_transform sp3 sp2)
    : geom3d_transform sp2 sp3 → geom3d_transform sp3 sp3 := λttr_, ⟨(ttr.1).trans ttr_.1⟩

noncomputable def geom3d_transform.transform_position3d
    {f3 : geom3d_frame} {s3 : geom3d_space f3}
    {f2 : geom3d_frame} {s2 : geom3d_space f2}
    (tr: geom3d_transform s3 s2 ) : position3d s3 → position3d s2 :=
    λt : position3d s3,
    ⟨tr.to_fm_tr.to_equiv t.to_point⟩

noncomputable def geom3d_transform.transform_displacement3d
    {f3 : geom3d_frame} {s3 : geom3d_space f3}
    {f2 : geom3d_frame} {s2 : geom3d_space f2}
    (tr: geom3d_transform s3 s2 ) : displacement3d s3 → displacement3d s2 :=
    λd,
    let as_pt : point s3 := ⟨λi, mk_pt real_scalar (d.coords i).coord⟩ in
    let tr_pt := (tr.to_equiv as_pt) in
    ⟨⟨λi, mk_vec real_scalar (tr_pt.coords i).coord⟩⟩

variables {f : geom3d_frame} (s : geom3d_space f )

structure orientation3d extends orientation s :=
mk ::

noncomputable instance o3i : inhabited (orientation3d s) := ⟨
    ⟨mk_orientation s (λi, mk_vectr s ⟨[0,0,0],rfl⟩)⟩
⟩

noncomputable def mk_orientation3d (s1 s2 s3 s4 s5 s6 s7 s8 s9 : real_scalar)--(ax1 : displacement3d s) (ax2 : displacement3d s) (ax3 : displacement3d s)
    : orientation3d s := ⟨mk_orientation s (λi, if i.1 = 0 then (mk_displacement3d s s1 s2 s3).to_vectr else if i.1 = 1 then (mk_displacement3d s s4 s5 s6).to_vectr else (mk_displacement3d s s7 s8 s9).to_vectr )⟩

    --: orientation3d s := ⟨mk_orientation s (λi, if i.1 = 0 then ax1.to_vectr else if i.1 = 1 then ax2.to_vectr else ax3.to_vectr )⟩

--okay, i can fill in this function now...
noncomputable def mk_orientation3d_from_euler_angles (s1 s2 s3 : real_scalar)--(ax1 : displacement3d s) (ax2 : displacement3d s) (ax3 : displacement3d s)
    : orientation3d s := ⟨mk_orientation s (λi, if i.1 = 0 then (mk_displacement3d s s1 s2 s3).to_vectr else if i.1 = 1 then (mk_displacement3d s s4 s5 s6).to_vectr else (mk_displacement3d s s7 s8 s9).to_vectr )⟩

noncomputable def mk_orientation3d_from_quaternion (s1 s2 s3 s4 : real_scalar)--(ax1 : displacement3d s) (ax2 : displacement3d s) (ax3 : displacement3d s)
    : orientation3d s := mk_orientation3d s
        (2*(s1*s1 + s2*s2) - 1) (2*(s2*s3 - s1*s4)) (2*(s2*s4 + s1*s3))
        (2*(s2*s3 + s1*s4)) (2*(s1*s1 + s3*s3)) (2*(s3*s4 - s1*s2))
        (2*(s2*s4 - s1*s3)) (2*(s3*s4 + s1*s2)) (2*(s1*s1 + s1*s1 + s4*s4) - 1)
    --: orientation3d s := ⟨mk_orientation s (λi, if i.1 = 0 then ax1.to_vectr else if i.1 = 1 then ax2.to_vectr else ax3.to_vectr )⟩

noncomputable def geom3d_transform.transform_orientation
    {f3 : geom3d_frame} {s3 : geom3d_space f3}
    {f2 : geom3d_frame} {s2 : geom3d_space f2}
    (tr: geom3d_transform s3 s2 ) : orientation3d s3 → orientation3d s2 :=
    λo : orientation3d s3,
    ⟨tr.to_fm_tr.transform_orientation o.to_orientation⟩

structure rotation3d extends rotation s :=
mk ::

/-
noncomputable def mk_rotation3d (ax1 : displacement3d s) (ax2 : displacement3d s) (ax3 : displacement3d s)
    : rotation3d s := ⟨mk_rotation s (λi, if i.1 = 0 then ax1.to_vectr else if i.1 = 1 then ax2.to_vectr else ax3.to_vectr )⟩
-/
noncomputable def mk_rotation3d (s1 s2 s3 s4 s5 s6 s7 s8 s9 : real_scalar)--(ax1 : displacement3d s) (ax2 : displacement3d s) (ax3 : displacement3d s)
    : rotation3d s := ⟨mk_rotation s (λi, if i.1 = 0 then (mk_displacement3d s s1 s2 s3).to_vectr else if i.1 = 1 then (mk_displacement3d s s4 s5 s6).to_vectr else (mk_displacement3d s s7 s8 s9).to_vectr )⟩

noncomputable instance r3i : inhabited (rotation3d s) := ⟨
    mk_rotation3d s 1 1 1 1 1 1 1 1 1
⟩

noncomputable def mk_rotation3d_from_quaternion (s1 s2 s3 s4 : real_scalar)--(ax1 : displacement3d s) (ax2 : displacement3d s) (ax3 : displacement3d s)
    : rotation3d s := mk_rotation3d s
        (2*(s1*s1 + s2*s2) - 1) (2*(s2*s3 - s1*s4)) (2*(s2*s4 + s1*s3))
        (2*(s2*s3 + s1*s4)) (2*(s1*s1 + s3*s3)) (2*(s3*s4 - s1*s2))
        (2*(s2*s4 - s1*s3)) (2*(s3*s4 + s1*s2)) (2*(s1*s1 + s1*s1 + s4*s4) - 1)
    --: orientation3d s := ⟨mk_orientation s (λi, if i.1 = 0 then ax1.to_vectr else if i.1 = 1 then ax2.to_vectr else ax3.to_vectr )⟩

structure pose3d :=
mk ::
    (orientation : orientation3d s)
    (position : position3d s)

def mk_pose3d (orientation : orientation3d s)
    (position : position3d s) : pose3d s := ⟨orientation,position⟩

 noncomputable instance p3i : inhabited (pose3d s) := ⟨
    (
    mk_pose3d _
    (mk_orientation3d _ 0 0 0 0 0 0 0 0 0)
    (mk_position3d _ 0 0 0)
    )
⟩

noncomputable def geom3d_transform.transform_pose3d
    {f3 : geom3d_frame} {s3 : geom3d_space f3}
    {f2 : geom3d_frame} {s2 : geom3d_space f2}
    (tr: geom3d_transform s3 s2 ) : pose3d s3 → pose3d s2 :=
    λp :_,
    (⟨tr.transform_orientation p.orientation, tr.transform_position3d p.position⟩:pose3d s2)


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

From: https://github.com/leanprover-community/mathlib/blob/master/src/algebra/direct_sum/graded_ring.lean
-/
import group_theory.subgroup.basic
import algebra.direct_sum.basic
import algebra.big_operators.pi

import cicm2022.graded_monoid

/-!
# 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_smul (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*}

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 [decidable_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 [decidable_eq ι] [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  [decidable_eq ι] : (⨁ 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  [decidable_eq ι] : 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 [decidable_eq ι] {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 [decidable_eq ι] {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 [decidable_eq ι] [Π 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 [decidable_eq ι] [Π 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 [decidable_eq ι] [Π 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 [decidable_eq ι] [Π 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 [decidable_eq ι] [Π 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 [decidable_eq ι] [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 [decidable_eq ι] [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 [decidable_eq ι] (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 [decidable_eq ι] (n : ℕ) : of A 0 n = n :=
rfl

/-- The `semiring` structure derived from `gsemiring A`. -/
instance grade_zero.semiring [decidable_eq ι] : 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 [decidable_eq ι] : 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 [decidable_eq ι] {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 [decidable_eq ι] [Π 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 [decidable_eq ι] [Π 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 [decidable_eq ι] (n : ℤ) : of A 0 n = n :=
rfl

/-- The `ring` derived from `gsemiring A`. -/
instance grade_zero.ring [decidable_eq ι] : 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 [decidable_eq ι] [Π 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*} [decidable_eq ι] [Π 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*} [decidable_eq ι] [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 tactic.linarith

/- Tactique écrite par Mario, qui aojute au contexte que les carrés sont positifs
et que les produits de nb positifs sont positifs avant d'essayer linarith
AFER : ajouter les inverses de positifs
-/

namespace tactic

meta def find_squares : expr → tactic unit
| e@`(%%a ^ 2) := do
  find_squares a,
  try (do
    p ← mk_app ``pow_two_nonneg [a],
    t ← infer_type p,
    assertv `h t p) >> skip
| e := () <$ e.traverse (λ e, e <$ find_squares e)

meta def nra : tactic unit :=
do ls ← local_context,
  ls' ← ls.mfoldr (λ h l, do
    t ← infer_type h,
    find_squares t,
    match t with
    | `(0 ≤ %%a) := return (h :: l)
    | _ := return l
    end) [],
  target >>= find_squares,
  ls'.mmap' (λ a, ls'.mmap' $ λ b, do
    p ← mk_app ``mul_nonneg [a, b],
    t ← infer_type p,
    assertv `h t p),
  tactic.interactive.linarith none none none

example {α:Type} [linear_ordered_comm_ring α] (a b : α) : 0 ≤ a ^ 2 + b ^ 2 := by nra
end tactic


import Mathlib.Data.Nat.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Data.Int.Basic
import Mathlib.Tactic.LibrarySearch
import Mathlib.Data.Equiv.Basic
import Mathlib.Init.Data.Int.Order
import Timelib.Date.Year
import Timelib.Date.Month
import Timelib.Date.ScalarDate
import Timelib.Date.OrdinalDate
import Timelib.Date.Ymd
import Timelib.Date.Convert
import Timelib.Util

/--
Proof that `Ymd` and `Ordinal` are Equivalent using their respective conversion functions
`Ymd.toOrdinalDate` and `OrdinalDate.toYmd`
-/

theorem Ymd.is_january_month {ymd : Ymd} (h_is_month_day : (ymd.toOrdinalDate).isJanuaryDay) : ymd.month = Month.january := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
    (simp_arith [hLeap, OrdinalDate.isJanuaryDay] at h_is_month_day
     simp only [Ymd.toOrdinalDate] at h_is_month_day
     simp only [hLeap]
     split at h_is_month_day <;> (simp (config := { arith := true }) at *; try assumption)
     case _ hM =>
       simp_arith [hM] at h_is_month_day
       exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_february_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isFebruaryDay) : ymd.month = Month.february := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
    (simp_arith [hLeap, OrdinalDate.isFebruaryDay] at h_is_month_day
     simp only [Ymd.toOrdinalDate] at h_is_month_day
     simp only [hLeap]
     split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
     case _ hM =>
       have hDayLe := ymd.dayLe
       simp [hM, Month.numDays, hLeap] at hDayLe
       exact False.elim (not_le_and_ge_of_lt hDayLe (by decide) h_is_month_day.left)
     case _ hM =>
       simp_arith [hM, hLeap] at h_is_month_day
       exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_march_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isMarchDay) : ymd.month = Month.march := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
    (simp [hLeap, OrdinalDate.isMarchDay] at h_is_month_day
     simp only [Ymd.toOrdinalDate] at h_is_month_day
     simp only [hLeap]
     have hDayLe := ymd.dayLe
     split at h_is_month_day <;> (simp (config := { arith := true }) at *; try assumption)
     case _ hM =>
       simp [hM, Month.numDays, hLeap] at hDayLe
       exact False.elim (not_le_and_ge_of_lt hDayLe (by decide) h_is_month_day.left)
     case _ hM =>
       simp [hM, Month.numDays, hLeap] at hDayLe
       exact False.elim (not_le_and_ge_of_lt hDayLe (by decide) h_is_month_day.left)
     case _ hM =>
       simp_arith [hLeap] at h_is_month_day
       exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_april_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isAprilDay) : ymd.month = Month.april := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isAprilDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM => exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_may_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isMayDay) : ymd.month = Month.may := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isMayDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM => exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_june_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isJuneDay) : ymd.month = Month.june := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isJuneDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM => exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_july_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isJulyDay) : ymd.month = Month.july := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isJulyDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM => exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_august_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isAugustDay) : ymd.month = Month.august := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isAugustDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM => exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_september_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isSeptemberDay) : ymd.month = Month.september := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isSeptemberDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM => exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_october_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isOctoberDay) : ymd.month = Month.october := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isOctoberDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM => exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_november_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isNovemberDay) : ymd.month = Month.november := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isNovemberDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day.left)
   case _ hM => exact False.elim ((show ¬0 >= 1 by decide) (h_is_month_day ▸ ymd.dayGe)))

theorem Ymd.is_december_month {ymd : Ymd} (h_is_month_day : ymd.toOrdinalDate.isDecemberDay) : ymd.month = Month.december := by
  simp only [Ymd.toOrdinalDate]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [OrdinalDate.isDecemberDay, hLeap] at h_is_month_day
   simp only [Ymd.toOrdinalDate] at h_is_month_day
   simp only [hLeap]
   have h_DayLe := ymd.dayLe
   split at h_is_month_day <;> (simp (config := { arith := true }) [Month.numDays, hLeap] at *; try assumption)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day)
   case _ hM =>
     simp [hM, Month.numDays, hLeap] at h_DayLe
     exact False.elim (not_le_and_ge_of_lt h_DayLe (by decide) h_is_month_day))

theorem OrdinalDate.toYmd_right_inv (ordinal : OrdinalDate) : ordinal.toYmd.toOrdinalDate = ordinal := by
  by_cases hLeap : ordinal.year.isLeapYear <;>
  (simp [OrdinalDate.toYmd, hLeap]
   split
   case _ hJan => simp [Ymd.toOrdinalDate, hJan]
   case _ hJan =>
      split
      case _ hFeb =>
        simp [hFeb, Ymd.toOrdinalDate]
        apply OrdinalDate.eq_of_val_eq
        case h_year => simp
        case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hJan))
      case _ hFeb =>
        split
        case _ hMar =>
          simp [hMar, Ymd.toOrdinalDate, hLeap]
          apply OrdinalDate.eq_of_val_eq
          case h_year => simp
          case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hFeb))
        case _ hMar =>
          split
          case _ hApr =>
            simp [hApr, Ymd.toOrdinalDate, hLeap]
            apply OrdinalDate.eq_of_val_eq
            case h_year => simp
            case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hMar))
          case _ hApr =>
            split
            case _ hMay =>
              simp [hMay, Ymd.toOrdinalDate, hLeap]
              apply OrdinalDate.eq_of_val_eq
              case h_year => simp
              case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hApr))
            case _ hMay =>
                split
                case _ hJun =>
                  simp [hJun, Ymd.toOrdinalDate, hLeap]
                  apply OrdinalDate.eq_of_val_eq
                  case h_year => simp
                  case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hMay))
                case _ hJun =>
                  split
                  case _ hJul =>
                    simp [hJul, Ymd.toOrdinalDate, hLeap]
                    apply OrdinalDate.eq_of_val_eq
                    case h_year => simp
                    case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hJun))
                  case _ hJul =>
                    split
                    case _ hAug =>
                      simp [hAug, Ymd.toOrdinalDate, hLeap]
                      apply OrdinalDate.eq_of_val_eq
                      case h_year => simp
                      case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hJul))
                    case _ hAug =>
                      split
                      case _ hSep =>
                        simp [hSep, Ymd.toOrdinalDate, hLeap]
                        apply OrdinalDate.eq_of_val_eq
                        case h_year => simp
                        case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hAug))
                      case _ hSep =>
                        split
                        case _ hOct =>
                          simp [hOct, Ymd.toOrdinalDate, hLeap]
                          apply OrdinalDate.eq_of_val_eq
                          case h_year => simp
                          case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hSep))
                        case _ hOct =>
                          split
                          case _ hNov =>
                            simp [hNov, Ymd.toOrdinalDate, hLeap]
                            apply OrdinalDate.eq_of_val_eq
                            case h_year => simp
                            case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hOct))
                          case _ hNov =>
                            simp [hNov, Ymd.toOrdinalDate, hLeap]
                            apply OrdinalDate.eq_of_val_eq
                            case h_year => simp
                            case h_day => exact Nat.sub_add_cancel (Nat.le_of_lt (Nat.gt_of_not_le hNov)))

theorem Ymd.toOrdinalDate_left_inv (ymd : Ymd) : ymd.toOrdinalDate.toYmd = ymd := by
  simp [OrdinalDate.toYmd]
  by_cases hLeap : ymd.year.isLeapYear <;>
  (simp [hLeap, Ymd.toOrdinalDate_year_same]
   split
   case _ hJan =>
     have h_is_month_day : ymd.toOrdinalDate.isJanuaryDay := by simp [OrdinalDate.isJanuaryDay]; exact hJan
     apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_january_month h_is_month_day), hLeap, Nat.add_sub_cancel]
   case _ hJan =>
     split
     case _ hFeb =>
         have h_is_month_day : ymd.toOrdinalDate.isFebruaryDay := by
           simp [OrdinalDate.isFebruaryDay, Year.lastDayFebruary, hLeap]
           exact And.intro (Nat.gt_of_not_le hJan) hFeb
         apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_february_month h_is_month_day), hLeap, Nat.add_sub_cancel]
     case _ hFeb =>
       split
       case _ hMar =>
         have h_is_month_day : ymd.toOrdinalDate.isMarchDay := by
           simp [OrdinalDate.isMarchDay, Year.lastDayMarch, hLeap]
           exact And.intro (Nat.gt_of_not_le hFeb) hMar
         apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_march_month h_is_month_day), hLeap, Nat.add_sub_cancel]
       case _ hMar =>
         split
         case _ hApr =>
           have h_is_month_day : ymd.toOrdinalDate.isAprilDay := by
             simp [OrdinalDate.isAprilDay, Year.lastDayApril, hLeap]
             exact And.intro (Nat.gt_of_not_le hMar) hApr
           apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_april_month h_is_month_day), hLeap, Nat.add_sub_cancel]
         case _ hApr =>
           split
           case _ hMay =>
             have h_is_month_day : ymd.toOrdinalDate.isMayDay := by
               simp [OrdinalDate.isMayDay, Year.lastDayMay, hLeap]
               exact And.intro (Nat.gt_of_not_le hApr) hMay
             apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_may_month h_is_month_day), hLeap, Nat.add_sub_cancel]
           case _ hMay =>
               split
               case _ hJun =>
                 have h_is_month_day : ymd.toOrdinalDate.isJuneDay := by
                   simp [OrdinalDate.isJuneDay, Year.lastDayJune, hLeap]
                   exact And.intro (Nat.gt_of_not_le hMay) hJun
                 apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_june_month h_is_month_day), hLeap, Nat.add_sub_cancel]
               case _ hJun =>
                 split
                 case _ hJul =>
                   have h_is_month_day : ymd.toOrdinalDate.isJulyDay := by
                     simp [OrdinalDate.isJulyDay, Year.lastDayJuly, hLeap]
                     exact And.intro (Nat.gt_of_not_le hJun) hJul
                   apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_july_month h_is_month_day), hLeap, Nat.add_sub_cancel]
                 case _ hJul =>
                   split
                   case _ hAug =>
                     have h_is_month_day : ymd.toOrdinalDate.isAugustDay := by
                       simp [OrdinalDate.isAugustDay, Year.lastDayAugust, hLeap]
                       exact And.intro (Nat.gt_of_not_le hJul) hAug
                     apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_august_month h_is_month_day), hLeap, Nat.add_sub_cancel]
                   case _ hAug =>
                     split
                     case _ hSep =>
                       have h_is_month_day : ymd.toOrdinalDate.isSeptemberDay := by
                         simp [OrdinalDate.isSeptemberDay, Year.lastDaySeptember, hLeap]
                         exact And.intro (Nat.gt_of_not_le hAug) hSep
                       apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_september_month h_is_month_day), hLeap, Nat.add_sub_cancel]
                     case _ hSep =>
                       split
                       case _ hOct =>
                         have h_is_month_day : ymd.toOrdinalDate.isOctoberDay := by
                           simp [OrdinalDate.isOctoberDay, Year.lastDayOctober, hLeap]
                           exact And.intro (Nat.gt_of_not_le hSep) hOct
                         apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_october_month h_is_month_day), hLeap, Nat.add_sub_cancel]
                       case _ hOct =>
                         split
                         case _ hNov =>
                           have h_is_month_day : ymd.toOrdinalDate.isNovemberDay := by
                             simp [OrdinalDate.isNovemberDay, Year.lastDayNovember, hLeap]
                             exact And.intro (Nat.gt_of_not_le hOct) hNov
                           apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_november_month h_is_month_day), hLeap, Nat.add_sub_cancel]
                         case _ hNov =>
                           have h_is_month_day : ymd.toOrdinalDate.isDecemberDay := by
                             simp [OrdinalDate.isDecemberDay, hLeap]
                             exact Nat.gt_of_not_le hNov
                           apply Ymd.eq_of_val_eq <;> simp [Ymd.toOrdinalDate, (Ymd.is_december_month h_is_month_day), hLeap, Nat.add_sub_cancel])