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

! This file was ported from Lean 3 source module order.succ_pred.relation
! leanprover-community/mathlib commit 9aba7801eeecebb61f58a5763c2b6dd1b47dc6ef
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.SuccPred.Basic

/-!
# Relations on types with a `SuccOrder`

This file contains properties about relations on types with a `SuccOrder`
and their closure operations (like the transitive closure).
-/

open Function Order Relation Set

section PartialSucc

variable {α : Type _} [PartialOrder α] [SuccOrder α] [IsSuccArchimedean α]

/-- For `n ≤ m`, `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ succ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_succ_of_le (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ico n m, r i (succ i))
    (hnm : n ≤ m) : ReflTransGen r n m := by
  revert h; refine' Succ.rec _ _ hnm
  · intro _
    exact ReflTransGen.refl
  · intro m hnm ih h
    have : ReflTransGen r n m := ih fun i hi => h i ⟨hi.1, hi.2.trans_le <| le_succ m⟩
    cases' (le_succ m).eq_or_lt with hm hm
    · rwa [← hm]
    exact this.tail (h m ⟨hnm, hm⟩)
#align refl_trans_gen_of_succ_of_le reflTransGen_of_succ_of_le

/-- For `m ≤ n`, `(n, m)` is in the reflexive-transitive closure of `~` if `succ i ~ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_succ_of_ge (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ico m n, r (succ i) i)
    (hmn : m ≤ n) : ReflTransGen r n m := by
  rw [← reflTransGen_swap]
  exact reflTransGen_of_succ_of_le (swap r) h hmn
#align refl_trans_gen_of_succ_of_ge reflTransGen_of_succ_of_ge

/-- For `n < m`, `(n, m)` is in the transitive closure of a relation `~` if `i ~ succ i`
  for all `i` between `n` and `m`. -/
theorem transGen_of_succ_of_lt (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ico n m, r i (succ i))
    (hnm : n < m) : TransGen r n m :=
  (reflTransGen_iff_eq_or_transGen.mp <| reflTransGen_of_succ_of_le r h hnm.le).resolve_left
    hnm.ne'
#align trans_gen_of_succ_of_lt transGen_of_succ_of_lt

/-- For `m < n`, `(n, m)` is in the transitive closure of a relation `~` if `succ i ~ i`
  for all `i` between `n` and `m`. -/
theorem transGen_of_succ_of_gt (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ico m n, r (succ i) i)
    (hmn : m < n) : TransGen r n m :=
  (reflTransGen_iff_eq_or_transGen.mp <| reflTransGen_of_succ_of_ge r h hmn.le).resolve_left
    hmn.ne
#align trans_gen_of_succ_of_gt transGen_of_succ_of_gt

end PartialSucc

section LinearSucc

variable {α : Type _} [LinearOrder α] [SuccOrder α] [IsSuccArchimedean α]

/-- `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ succ i` and `succ i ~ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_succ (r : α → α → Prop) {n m : α} (h1 : ∀ i ∈ Ico n m, r i (succ i))
    (h2 : ∀ i ∈ Ico m n, r (succ i) i) : ReflTransGen r n m :=
  (le_total n m).elim (reflTransGen_of_succ_of_le r h1) <| reflTransGen_of_succ_of_ge r h2
#align refl_trans_gen_of_succ reflTransGen_of_succ

/-- For `n ≠ m`,`(n, m)` is in the transitive closure of a relation `~` if `i ~ succ i` and
  `succ i ~ i` for all `i` between `n` and `m`. -/
theorem transGen_of_succ_of_ne (r : α → α → Prop) {n m : α} (h1 : ∀ i ∈ Ico n m, r i (succ i))
    (h2 : ∀ i ∈ Ico m n, r (succ i) i) (hnm : n ≠ m) : TransGen r n m :=
  (reflTransGen_iff_eq_or_transGen.mp (reflTransGen_of_succ r h1 h2)).resolve_left hnm.symm
#align trans_gen_of_succ_of_ne transGen_of_succ_of_ne

/-- `(n, m)` is in the transitive closure of a reflexive relation `~` if `i ~ succ i` and
  `succ i ~ i` for all `i` between `n` and `m`. -/
theorem transGen_of_succ_of_reflexive (r : α → α → Prop) {n m : α} (hr : Reflexive r)
    (h1 : ∀ i ∈ Ico n m, r i (succ i)) (h2 : ∀ i ∈ Ico m n, r (succ i) i) : TransGen r n m := by
  rcases eq_or_ne m n with (rfl | hmn); · exact TransGen.single (hr m)
  exact transGen_of_succ_of_ne r h1 h2 hmn.symm
#align trans_gen_of_succ_of_reflexive transGen_of_succ_of_reflexive

end LinearSucc

section PartialPred

variable {α : Type _} [PartialOrder α] [PredOrder α] [IsPredArchimedean α]

/-- For `m ≤ n`, `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ pred i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_pred_of_ge (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ioc m n, r i (pred i))
    (hnm : m ≤ n) : ReflTransGen r n m :=
  @reflTransGen_of_succ_of_le αᵒᵈ _ _ _ r n m (fun x hx => h x ⟨hx.2, hx.1⟩) hnm
#align refl_trans_gen_of_pred_of_ge reflTransGen_of_pred_of_ge

/-- For `n ≤ m`, `(n, m)` is in the reflexive-transitive closure of `~` if `pred i ~ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_pred_of_le (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ioc n m, r (pred i) i)
    (hmn : n ≤ m) : ReflTransGen r n m :=
  @reflTransGen_of_succ_of_ge αᵒᵈ _ _ _ r n m (fun x hx => h x ⟨hx.2, hx.1⟩) hmn
#align refl_trans_gen_of_pred_of_le reflTransGen_of_pred_of_le

/-- For `m < n`, `(n, m)` is in the transitive closure of a relation `~` for `n ≠ m` if `i ~ pred i`
  for all `i` between `n` and `m`. -/
theorem transGen_of_pred_of_gt (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ioc m n, r i (pred i))
    (hnm : m < n) : TransGen r n m :=
  @transGen_of_succ_of_lt αᵒᵈ _ _ _ r _ _ (fun x hx => h x ⟨hx.2, hx.1⟩) hnm
#align trans_gen_of_pred_of_gt transGen_of_pred_of_gt

/-- For `n < m`, `(n, m)` is in the transitive closure of a relation `~` for `n ≠ m` if `pred i ~ i`
  for all `i` between `n` and `m`. -/
theorem transGen_of_pred_of_lt (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ioc n m, r (pred i) i)
    (hmn : n < m) : TransGen r n m :=
  @transGen_of_succ_of_gt αᵒᵈ _ _ _ r _ _ (fun x hx => h x ⟨hx.2, hx.1⟩) hmn
#align trans_gen_of_pred_of_lt transGen_of_pred_of_lt

end PartialPred

section LinearPred

variable {α : Type _} [LinearOrder α] [PredOrder α] [IsPredArchimedean α]

/-- `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ pred i` and `pred i ~ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_pred (r : α → α → Prop) {n m : α} (h1 : ∀ i ∈ Ioc m n, r i (pred i))
    (h2 : ∀ i ∈ Ioc n m, r (pred i) i) : ReflTransGen r n m :=
  @reflTransGen_of_succ αᵒᵈ _ _ _ r n m (fun x hx => h1 x ⟨hx.2, hx.1⟩) fun x hx =>
    h2 x ⟨hx.2, hx.1⟩
#align refl_trans_gen_of_pred reflTransGen_of_pred

/-- For `n ≠ m`, `(n, m)` is in the transitive closure of a relation `~` if `i ~ pred i` and
  `pred i ~ i` for all `i` between `n` and `m`. -/
theorem transGen_of_pred_of_ne (r : α → α → Prop) {n m : α} (h1 : ∀ i ∈ Ioc m n, r i (pred i))
    (h2 : ∀ i ∈ Ioc n m, r (pred i) i) (hnm : n ≠ m) : TransGen r n m :=
  @transGen_of_succ_of_ne αᵒᵈ _ _ _ r n m (fun x hx => h1 x ⟨hx.2, hx.1⟩)
    (fun x hx => h2 x ⟨hx.2, hx.1⟩) hnm
#align trans_gen_of_pred_of_ne transGen_of_pred_of_ne

/-- `(n, m)` is in the transitive closure of a reflexive relation `~` if `i ~ pred i` and
  `pred i ~ i` for all `i` between `n` and `m`. -/
theorem transGen_of_pred_of_reflexive (r : α → α → Prop) {n m : α} (hr : Reflexive r)
    (h1 : ∀ i ∈ Ioc m n, r i (pred i)) (h2 : ∀ i ∈ Ioc n m, r (pred i) i) : TransGen r n m :=
  @transGen_of_succ_of_reflexive αᵒᵈ _ _ _ r n m hr (fun x hx => h1 x ⟨hx.2, hx.1⟩) fun x hx =>
    h2 x ⟨hx.2, hx.1⟩
#align trans_gen_of_pred_of_reflexive transGen_of_pred_of_reflexive

end LinearPred


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov
-/
import algebra.module.submodule

/-!
# The lattice structure on `submodule`s

This file defines the lattice structure on submodules, `submodule.complete_lattice`, with `⊥`
defined as `{0}` and `⊓` defined as intersection of the underlying carrier.
If `p` and `q` are submodules of a module, `p ≤ q` means that `p ⊆ q`.

Many results about operations on this lattice structure are defined in `linear_algebra/basic.lean`,
most notably those which use `span`.

## Implementation notes

This structure should match the `add_submonoid.complete_lattice` structure, and we should try
to unify the APIs where possible.

-/

variables {R : Type*} {M : Type*}

section add_comm_monoid
variables [semiring R] [add_comm_monoid M] [module R M]
variables {p q : submodule R M}

namespace submodule

/-- The set `{0}` is the bottom element of the lattice of submodules. -/
instance : has_bot (submodule R M) :=
⟨{ carrier := {0}, smul_mem' := by simp { contextual := tt }, .. (⊥ : add_submonoid M)}⟩

instance inhabited' : inhabited (submodule R M) := ⟨⊥⟩

@[simp] lemma bot_coe : ((⊥ : submodule R M) : set M) = {0} := rfl
@[simp] lemma bot_to_add_submonoid : (⊥ : submodule R M).to_add_submonoid = ⊥ := rfl

section
variables (R)
@[simp] lemma mem_bot {x : M} : x ∈ (⊥ : submodule R M) ↔ x = 0 := set.mem_singleton_iff
end

instance unique_bot : unique (⊥ : submodule R M) :=
⟨infer_instance, λ x, subtype.ext $ (mem_bot R).1 x.mem⟩

lemma nonzero_mem_of_bot_lt {I : submodule R M} (bot_lt : ⊥ < I) : ∃ a : I, a ≠ 0 :=
begin
  have h := (set_like.lt_iff_le_and_exists.1 bot_lt).2,
  tidy,
end

instance : order_bot (submodule R M) :=
{ bot := ⊥,
  bot_le := λ p x, by simp {contextual := tt},
  ..set_like.partial_order }

protected lemma eq_bot_iff (p : submodule R M) : p = ⊥ ↔ ∀ x ∈ p, x = (0 : M) :=
⟨ λ h, h.symm ▸ λ x hx, (mem_bot R).mp hx,
  λ h, eq_bot_iff.mpr (λ x hx, (mem_bot R).mpr (h x hx)) ⟩

protected lemma ne_bot_iff (p : submodule R M) : p ≠ ⊥ ↔ ∃ x ∈ p, x ≠ (0 : M) :=
by { haveI := classical.prop_decidable, simp_rw [ne.def, p.eq_bot_iff, not_forall] }

/-- The universal set is the top element of the lattice of submodules. -/
instance : has_top (submodule R M) :=
⟨{ carrier := set.univ, smul_mem' := λ _ _ _, trivial, .. (⊤ : add_submonoid M)}⟩

@[simp] lemma top_coe : ((⊤ : submodule R M) : set M) = set.univ := rfl

@[simp] lemma top_to_add_submonoid : (⊤ : submodule R M).to_add_submonoid = ⊤ := rfl

@[simp] lemma mem_top {x : M} : x ∈ (⊤ : submodule R M) := trivial

instance : order_top (submodule R M) :=
{ top := ⊤,
  le_top := λ p x _, trivial,
  ..set_like.partial_order }

lemma eq_top_iff' {p : submodule R M} : p = ⊤ ↔ ∀ x, x ∈ p :=
eq_top_iff.trans ⟨λ h x, h trivial, λ h x _, h x⟩

instance : has_Inf (submodule R M) :=
⟨λ S, {
  carrier   := ⋂ s ∈ S, (s : set M),
  zero_mem' := by simp,
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩

private lemma Inf_le' {S : set (submodule R M)} {p} : p ∈ S → Inf S ≤ p :=
set.bInter_subset_of_mem

private lemma le_Inf' {S : set (submodule R M)} {p} : (∀q ∈ S, p ≤ q) → p ≤ Inf S :=
set.subset_bInter

instance : has_inf (submodule R M) :=
⟨λ p q, {
  carrier   := p ∩ q,
  zero_mem' := by simp,
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩

instance : complete_lattice (submodule R M) :=
{ sup          := λ a b, Inf {x | a ≤ x ∧ b ≤ x},
  le_sup_left  := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, ha,
  le_sup_right := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, hb,
  sup_le       := λ a b c h₁ h₂, Inf_le' ⟨h₁, h₂⟩,
  inf          := (⊓),
  le_inf       := λ a b c, set.subset_inter,
  inf_le_left  := λ a b, set.inter_subset_left _ _,
  inf_le_right := λ a b, set.inter_subset_right _ _,
  Sup          := λtt, Inf {t | ∀t'∈tt, t' ≤ t},
  le_Sup       := λ s p hs, le_Inf' $ λ q hq, hq _ hs,
  Sup_le       := λ s p hs, Inf_le' hs,
  Inf          := Inf,
  le_Inf       := λ s a, le_Inf',
  Inf_le       := λ s a, Inf_le',
  ..submodule.order_top,
  ..submodule.order_bot }

@[simp] theorem inf_coe : (p ⊓ q : set M) = p ∩ q := rfl

@[simp] theorem mem_inf {p q : submodule R M} {x : M} :
  x ∈ p ⊓ q ↔ x ∈ p ∧ x ∈ q := iff.rfl

@[simp] theorem Inf_coe (P : set (submodule R M)) : (↑(Inf P) : set M) = ⋂ p ∈ P, ↑p := rfl

@[simp] theorem infi_coe {ι} (p : ι → submodule R M) :
  (↑⨅ i, p i : set M) = ⋂ i, ↑(p i) :=
by rw [infi, Inf_coe]; ext a; simp; exact
⟨λ h i, h _ i rfl, λ h i x e, e ▸ h _⟩

@[simp] lemma mem_Inf {S : set (submodule R M)} {x : M} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p :=
set.mem_bInter_iff

@[simp] theorem mem_infi {ι} (p : ι → submodule R M) {x} :
  x ∈ (⨅ i, p i) ↔ ∀ i, x ∈ p i :=
by rw [← set_like.mem_coe, infi_coe, set.mem_Inter]; refl

lemma mem_sup_left {S T : submodule R M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

lemma mem_sup_right {S T : submodule R M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

lemma mem_supr_of_mem {ι : Sort*} {b : M} {p : ι → submodule R M} (i : ι) (h : b ∈ p i) :
  b ∈ (⨆i, p i) :=
have p i ≤ (⨆i, p i) := le_supr p i,
@this b h

/-! Note that `submodule.mem_supr` is provided in `linear_algebra/basic.lean`. -/

lemma mem_Sup_of_mem {S : set (submodule R M)} {s : submodule R M}
  (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

end submodule

section nat_submodule

/-- An additive submonoid is equivalent to a ℕ-submodule. -/
def add_submonoid.to_nat_submodule : add_submonoid M ≃o submodule ℕ M :=
{ to_fun := λ S,
  { smul_mem' := λ r s hs, S.nsmul_mem hs _, ..S },
  inv_fun := submodule.to_add_submonoid,
  left_inv := λ ⟨S, _, _⟩, rfl,
  right_inv := λ ⟨S, _, _, _⟩, rfl,
  map_rel_iff' := λ a b, iff.rfl }

@[simp]
lemma add_submonoid.to_nat_submodule_symm :
  ⇑(add_submonoid.to_nat_submodule.symm : _ ≃o add_submonoid M) = submodule.to_add_submonoid := rfl

@[simp]
lemma add_submonoid.coe_to_nat_submodule (S : add_submonoid M) :
  (S.to_nat_submodule : set M) = S := rfl

@[simp]
lemma add_submonoid.to_nat_submodule_to_add_submonoid (S : add_submonoid M) :
  S.to_nat_submodule.to_add_submonoid = S :=
add_submonoid.to_nat_submodule.symm_apply_apply S

@[simp]
lemma submodule.to_add_submonoid_to_nat_submodule (S : submodule ℕ M) :
  S.to_add_submonoid.to_nat_submodule = S :=
add_submonoid.to_nat_submodule.apply_symm_apply S

end nat_submodule

end add_comm_monoid


import Lean4Axiomatic.Natural.Order

/-!
# Natural number multiplication
-/

namespace Lean4Axiomatic.Natural

open Signed (Positive)

/-!
## Axioms
-/

/--
Definition of multiplication, and properties that it must satisfy.

All other properties of multiplication can be derived from these.
-/
class Multiplication (ℕ : Type) [Core ℕ] [Addition ℕ] :=
  /-- Definition of and syntax for multiplication. -/
  mulOp : Mul ℕ

  /-- Multiplying by zero on the left always gives zero. -/
  zero_mul {m : ℕ} : 0 * m ≃ 0

  /--
  Take a product and increment the left-hand factor. This gives the same result
  as adding a copy of the right-hand factor to the original product.
  -/
  step_mul {n m : ℕ} : step n * m ≃ (n * m) + m

attribute [instance] Multiplication.mulOp

export Multiplication (mulOp step_mul zero_mul)

/-!
## Derived properties
-/

variable {ℕ : Type}
variable [Core ℕ]
variable [Axioms ℕ]
variable [Addition ℕ]
variable [Sign ℕ]
variable [Order ℕ]
variable [Multiplication ℕ]

/--
Multiplying by zero on the right always gives zero.

Intuition: the multiplication `count * value` is defined as `count` copies of
`value` added together. So `n * 0` is `n` copies of `0` added together, which
by properties of addition must always give `0`.
-/
theorem mul_zero {n : ℕ} : n * 0 ≃ 0 := by
  apply ind_on (motive := λ x => x * 0 ≃ 0) n
  case zero =>
    show 0 * 0 ≃ 0
    exact zero_mul
  case step =>
    intro n (ih : n * 0 ≃ 0)
    show step n * 0 ≃ 0
    calc
      step n * 0 ≃ _ := step_mul
      n * 0 + 0  ≃ _ := AA.substL ih
      0 + 0      ≃ _ := Addition.zero_add
      0          ≃ _ := Rel.refl

instance mul_absorbing : AA.Absorbing (α := ℕ) 0 (· * ·) := {
  absorbingL := AA.AbsorbingOn.mk zero_mul
  absorbingR := AA.AbsorbingOn.mk mul_zero
}

/--
Take a product and increment the right-hand factor. This gives the same result
as adding a copy of the left-hand factor to the original product.

This is a key lemma towards proving the commutativity of multiplication. Even
though multiplication is defined as `count * value`, this result shows that it
works just as well to swap the roles of `count` and `value`.

Intuition: `n` copies of `step m` added together can be rearranged into the sum
of `n` copies of `m`, plus the sum of `n` copies of `1`. Since adding `n`
copies of `1` together is just `n`, the whole result is `n * m + n`.
-/
theorem mul_step {n m : ℕ} : n * step m ≃ n * m + n := by
  apply ind_on (motive := λ x => x * step m ≃ x * m + x) n
  case zero =>
    show 0 * step m ≃ 0 * m + 0
    calc
      0 * step m ≃ _ := zero_mul
      0          ≃ _ := Rel.symm Addition.zero_add
      0 + 0      ≃ _ := AA.substL (Rel.symm zero_mul)
      0 * m + 0  ≃ _ := Rel.refl
  case step =>
    intro n (ih : n * step m ≃ n * m + n)
    show step n * step m ≃ step n * m + step n
    calc
      step n * step m        ≃ _ := step_mul
      n * step m + step m    ≃ _ := AA.substL ih
      (n * m + n) + step m   ≃ _ := add_step
      step ((n * m + n) + m) ≃ _ := AA.subst₁ AA.assoc
      step (n * m + (n + m)) ≃ _ := AA.subst₁ (AA.substR AA.comm)
      step (n * m + (m + n)) ≃ _ := AA.subst₁ (Rel.symm AA.assoc)
      step ((n * m + m) + n) ≃ _ := AA.subst₁ (AA.substL (Rel.symm step_mul))
      step (step n * m + n)  ≃ _ := Rel.symm add_step
      step n * m + step n    ≃ _ := Rel.refl

/--
The order of the factors in a product doesn't matter.

Intuition: combine the results from `mul_zero` and `mul_step`.
-/
theorem mul_comm {n m : ℕ} : n * m ≃ m * n := by
  apply ind_on (motive := λ x => x * m ≃ m * x) n
  case zero =>
    show 0 * m ≃ m * 0
    calc
      0 * m ≃ _ := zero_mul
      0     ≃ _ := Rel.symm mul_zero
      m * 0 ≃ _ := Rel.refl
  case step =>
    intro n (ih : n * m ≃ m * n)
    show step n * m ≃ m * step n
    calc
      step n * m ≃ _ := step_mul
      n * m + m  ≃ _ := AA.substL ih
      m * n + m  ≃ _ := Rel.symm mul_step
      m * step n ≃ _ := Rel.refl

instance mul_commutative : AA.Commutative (α := ℕ) (· * ·) := {
  comm := mul_comm
}

/--
Multiplication by a fixed value as the right-hand operand preserves equality.

Intuition: addition preserves equality; multiplication is repeated addition.
-/
theorem subst_mul_eq {n₁ n₂ m : ℕ} : n₁ ≃ n₂ → n₁ * m ≃ n₂ * m := by
  apply ind_on (motive := λ x => ∀ y, x ≃ y → x * m ≃ y * m) n₁
  case zero =>
    intro n₂
    show 0 ≃ n₂ → 0 * m ≃ n₂ * m
    apply cases_on (motive := λ y => 0 ≃ y → 0 * m ≃ y * m)
    case zero =>
      intro (_ : 0 ≃ (0 : ℕ))
      show 0 * m ≃ 0 * m
      exact Rel.refl
    case step =>
      intro n₂ (_ : 0 ≃ step n₂)
      exact absurd (Rel.symm ‹0 ≃ step n₂›) step_neqv_zero
  case step =>
    intro n₁ (ih : ∀ y, n₁ ≃ y → n₁ * m ≃ y * m) n₂
    show step n₁ ≃ n₂ → step n₁ * m ≃ n₂ * m
    apply cases_on (motive := λ y => step n₁ ≃ y → step n₁ * m ≃ y * m)
    case zero =>
      intro (_ : step n₁ ≃ 0)
      exact absurd ‹step n₁ ≃ 0› step_neqv_zero
    case step =>
      intro n₂ (_ : step n₁ ≃ step n₂)
      show step n₁ * m ≃ step n₂ * m
      have : n₁ ≃ n₂ := AA.inject ‹step n₁ ≃ step n₂›
      have : n₁ * m ≃ n₂ * m := ih n₂ ‹n₁ ≃ n₂›
      calc
        step n₁ * m  ≃ _ := step_mul
        (n₁ * m) + m ≃ _ := AA.substL ‹n₁ * m ≃ n₂ * m›
        (n₂ * m) + m ≃ _ := Rel.symm step_mul
        step n₂ * m  ≃ _ := Rel.refl

def mul_substL_eq
    : AA.SubstitutiveOn Hand.L (α := ℕ) (· * ·) AA.tc (· ≃ ·) (· ≃ ·)
    := {
  subst₂ := λ (_ : True) => subst_mul_eq
}

instance mul_substitutive_eq
    : AA.Substitutive₂ (α := ℕ) (· * ·) AA.tc (· ≃ ·) (· ≃ ·)
    := {
  substitutiveL := mul_substL_eq
  substitutiveR := AA.substR_from_substL_swap (rS := (· ≃ ·)) mul_substL_eq
}

/--
A product is zero iff at least one of its factors is zero.

Intuition
- forwards: if one factor is nonzero, then the product is a nonempty sum that
  results in zero. By `Addition.zero_sum_split`, the terms of the sum must be
  zero.
- backwards: by `Base.zero_mul` or `Derived.mul_zero`.
-/
theorem mul_split_zero {n m : ℕ} : n * m ≃ 0 ↔ n ≃ 0 ∨ m ≃ 0 := by
  apply Iff.intro
  · show n * m ≃ 0 → n ≃ 0 ∨ m ≃ 0
    apply cases_on (motive := λ x => x * m ≃ 0 → x ≃ 0 ∨ m ≃ 0) n
    case zero =>
      intro (_ : 0 * m ≃ 0)
      show 0 ≃ 0 ∨ m ≃ 0
      exact Or.inl Rel.refl
    case step =>
      intro n (_ : step n * m ≃ 0)
      show step n ≃ 0 ∨ m ≃ 0
      apply Or.inr
      show m ≃ 0
      have : n * m + m ≃ 0 := calc
        n * m + m  ≃ _ := Rel.symm step_mul
        step n * m ≃ _ := ‹step n * m ≃ 0›
        0          ≃ _ := Rel.refl
      have ⟨_, (_ : m ≃ 0)⟩ := zero_sum_split ‹n * m + m ≃ 0›
      exact ‹m ≃ 0›
  · intro (_ : n ≃ 0 ∨ m ≃ 0)
    show n * m ≃ 0
    apply Or.elim ‹n ≃ 0 ∨ m ≃ 0›
    · intro (_ : n ≃ 0)
      show n * m ≃ 0
      calc
        n * m ≃ _ := AA.substL ‹n ≃ 0›
        0 * m ≃ _ := zero_mul
        0     ≃ _ := Rel.refl
    · intro (_ : m ≃ 0)
      show n * m ≃ 0
      calc
        n * m ≃ _ := AA.substR ‹m ≃ 0›
        n * 0 ≃ _ := mul_zero
        0     ≃ _ := Rel.refl

/--
The product of positive natural numbers is positive.

Intuition: reframe positive as nonzero, then contradict with
`Derived.mul_split_zero`.
-/
theorem mul_positive {n m : ℕ}
    : Positive n → Positive m → Positive (n * m) := by
  intro (_ : Positive n) (_ : Positive m)
  show Positive (n * m)
  have : n ≄ 0 := Signed.positive_defn.mp ‹Positive n›
  have : m ≄ 0 := Signed.positive_defn.mp ‹Positive m›
  apply Signed.positive_defn.mpr
  show n * m ≄ 0
  intro (_ : n * m ≃ 0)
  show False
  have : n ≃ 0 ∨ m ≃ 0 := mul_split_zero.mp ‹n * m ≃ 0›
  apply Or.elim ‹n ≃ 0 ∨ m ≃ 0›
  · intro (_ : n ≃ 0)
    show False
    exact absurd ‹n ≃ 0› ‹n ≄ 0›
  · intro (_ : m ≃ 0)
    show False
    exact absurd ‹m ≃ 0› ‹m ≄ 0›

/--
Multiplication on the left distributes over addition.

**Intuition**: Viewing `a * b` as the sum of `a` copies of `b`, this theorem
says that the sum of `n` copies of `m + k` is the same as the sum of `n` copies
of `m` added to the sum of `n` copies of `k`. Using the commutativity and
associativity of addition to rearrange the sums shows this is clearly true.
-/
theorem mul_distribL_add {n m k : ℕ} : n * (m + k) ≃ n * m + n * k := by
  apply ind_on (motive := λ x => x * (m + k) ≃ x * m + x * k) n
  case zero =>
    show 0 * (m + k) ≃ 0 * m + 0 * k
    calc
      0 * (m + k)   ≃ _ := zero_mul
      0             ≃ _ := Rel.symm Addition.zero_add
      0 + 0         ≃ _ := AA.substL (Rel.symm zero_mul)
      0 * m + 0     ≃ _ := AA.substR (Rel.symm zero_mul)
      0 * m + 0 * k ≃ _ := Rel.refl
  case step =>
    intro n (ih : n * (m + k) ≃ n * m + n * k)
    show step n * (m + k) ≃ step n * m + step n * k
    calc
      step n * (m + k)          ≃ _ := step_mul
      n * (m + k) + (m + k)     ≃ _ := AA.substL ih
      n * m + n * k + (m + k)   ≃ _ := AA.assoc
      n * m + (n * k + (m + k)) ≃ _ := AA.substR (Rel.symm AA.assoc)
      n * m + ((n * k + m) + k) ≃ _ := AA.substR (AA.substL AA.comm)
      n * m + ((m + n * k) + k) ≃ _ := AA.substR AA.assoc
      n * m + (m + (n * k + k)) ≃ _ := Rel.symm AA.assoc
      (n * m + m) + (n * k + k) ≃ _ := AA.substL (Rel.symm step_mul)
      step n * m + (n * k + k)  ≃ _ := AA.substR (Rel.symm step_mul)
      step n * m + step n * k   ≃ _ := Rel.refl

def mul_distributiveL : AA.DistributiveOn Hand.L (α := ℕ) (· * ·) (· + ·) :=
  AA.DistributiveOn.mk mul_distribL_add

instance mul_distributive : AA.Distributive (α := ℕ) (· * ·) (· + ·) := {
  distributiveL := mul_distributiveL
  distributiveR := AA.distributiveR_from_distributiveL mul_distributiveL
}

/--
The grouping of the factors in a product doesn't matter.

**Intuition**: Imagine a collection of identical objects arranged into a
rectangle `n * m` objects long and `k` objects high. Partition this into `m`
smaller rectangles having length `n` and height `k`. Clearly the number of
objects remains the same in both arrangements.
-/
instance mul_associative : AA.Associative (α := ℕ) (· * ·) := by
  constructor
  intro n m k
  show (n * m) * k ≃ n * (m * k)
  apply ind_on (motive := λ x => (x * m) * k ≃ x * (m * k))
  case zero =>
    show (0 * m) * k ≃ 0 * (m * k)
    calc
      (0 * m) * k ≃ _ := AA.substL zero_mul
      0 * k       ≃ _ := zero_mul
      0           ≃ _ := Rel.symm zero_mul
      0 * (m * k) ≃ _ := Rel.refl
  case step =>
    intro n (ih : (n * m) * k ≃ n * (m * k))
    show (step n * m) * k ≃ step n * (m * k)
    calc
      (step n * m) * k    ≃ _ := AA.substL step_mul
      (n * m + m) * k     ≃ _ := AA.distribR
      (n * m) * k + m * k ≃ _ := AA.substL ih
      n * (m * k) + m * k ≃ _ := Rel.symm step_mul
      step n * (m * k)    ≃ _ := Rel.refl

/--
Multiplication on the right by a positive natural number preserves the strict
ordering of any two natural numbers.

**Proof intuition**: two strictly ordered natural numbers have a positive
difference between them. Multiplying them by another positive natural number
also multiplies their difference, which remains positive.
-/
theorem subst_mul_lt
    {n₁ n₂ m : ℕ} : Positive m → n₁ < n₂ → n₁ * m < n₂ * m := by
  intro (_ : Positive m) (_ : n₁ < n₂)
  show n₁ * m < n₂ * m
  have ⟨(d : ℕ), (_ : Positive d), (_ : n₂ ≃ n₁ + d)⟩ :=
    lt_defn_add.mp ‹n₁ < n₂›
  have : n₂ * m ≃ n₁ * m + d * m := calc
    n₂ * m         ≃ _ := AA.substL ‹n₂ ≃ n₁ + d›
    (n₁ + d) * m   ≃ _ := AA.distribR
    n₁ * m + d * m ≃ _ := Rel.refl
  have : Positive (d * m) := mul_positive ‹Positive d› ‹Positive m›
  exact lt_defn_add.mpr
    ⟨d * m, ‹Positive (d * m)›, ‹n₂ * m ≃ n₁ * m + d * m›⟩

def mul_substL_lt
    : AA.SubstitutiveOn Hand.L (α := ℕ) (· * ·) Positive (· < ·) (· < ·)
    := {
  subst₂ := subst_mul_lt
}

instance mul_substitutive_lt
    : AA.Substitutive₂ (α := ℕ) (· * ·) Positive (· < ·) (· < ·)
    := {
  substitutiveL := mul_substL_lt
  substitutiveR := AA.substR_from_substL_swap (rS := (· ≃ ·)) mul_substL_lt
}

/--
Multiplication on the left by a nonzero natural number is an injection.

**Proof intuition**: If one of the right-hand factors is greater than the other,
then multiplying them both by a nonzero (i.e., positive) natural number will
preserve their ordering (by `mul_substitutive_lt`), contradicting the hypothesis
that the products are equal. Thus the right-hand factors must be equal.
-/
def mul_cancelL
    : AA.CancellativeOn Hand.L (α := ℕ) (· * ·) (· ≄ 0) (· ≃ ·) (· ≃ ·)
    := by
  apply AA.CancellativeOn.mk
  intro x y₁ y₂ (_ : x ≄ 0) (_ : x * y₁ ≃ x * y₂)
  show y₁ ≃ y₂
  have : Positive x := Signed.positive_defn.mpr ‹x ≄ 0›
  have notTwoOfThree := (trichotomy (x * y₁) (x * y₂)).atMostOne
  match (trichotomy y₁ y₂).atLeastOne with
  | AA.OneOfThree.first (_ : y₁ < y₂) =>
    have : x * y₁ < x * y₂ := AA.substRC ‹Positive x› ‹y₁ < y₂›
    have twoOfThree :=
      AA.TwoOfThree.oneAndTwo
        (γ := x * y₁ > x * y₂) ‹x * y₁ < x * y₂› ‹x * y₁ ≃ x * y₂›
    exact absurd twoOfThree notTwoOfThree
  | AA.OneOfThree.second (_ : y₁ ≃ y₂) =>
    exact ‹y₁ ≃ y₂›
  | AA.OneOfThree.third (_ : y₁ > y₂) =>
    have : y₂ < y₁ := ‹y₁ > y₂›
    have : x * y₂ < x * y₁ := AA.substRC ‹Positive x› ‹y₂ < y₁›
    have twoOfThree :=
      AA.TwoOfThree.twoAndThree
        (α := x * y₁ < x * y₂) ‹x * y₁ ≃ x * y₂› ‹x * y₂ < x * y₁›
    exact absurd twoOfThree notTwoOfThree

instance mul_cancellative
    : AA.Cancellative (α := ℕ) (· * ·) (· ≄ 0) (· ≃ ·) (· ≃ ·)
    := {
  cancellativeL := mul_cancelL
  cancellativeR := AA.cancelR_from_cancelL mul_cancelL
}

/--
The natural number `1` is a left multiplicative identity element.

**Property intuition**: A sum of a single instance of a number should be equal
to that number.

**Proof intuition**: Expand the definition of multiplication into addition to
see that multiplying by one is the same as adding zero.
-/
theorem mul_identL {n : ℕ} : 1 * n ≃ n := calc
  1 * n      ≃ _ := AA.substL Literals.literal_step
  step 0 * n ≃ _ := step_mul
  0 * n + n  ≃ _ := AA.substL zero_mul
  0 + n      ≃ _ := AA.identL
  n          ≃ _ := Rel.refl

def mul_identityL : AA.IdentityOn Hand.L (α := ℕ) 1 (· * ·) := {
  ident := mul_identL
}

instance mul_identity : AA.Identity (α := ℕ) 1 (· * ·) := {
  identityL := mul_identityL
  identityR := AA.identityR_from_identityL mul_identityL
}

/--
Zero is the only natural number less than one.

This is a lemma to help with the proof of `sqrt1` below.
-/
theorem zero_lt_one {n : ℕ} : n < 1 ↔ n ≃ 0 := by
  apply Iff.intro
  case mp =>
    intro (_ : n < 1)
    show n ≃ 0
    have : n < step 0 := AA.substRFn literal_step ‹n < 1›
    have : n < 0 ∨ n ≃ 0 := lt_split ‹n < step 0›
    match ‹n < 0 ∨ n ≃ 0› with
    | Or.inl (_ : n < 0) => exact absurd ‹n < 0› lt_zero
    | Or.inr (_ : n ≃ 0) => exact ‹n ≃ 0›
  case mpr =>
    intro (_ : n ≃ 0)
    show n < 1
    have : (0 : ℕ) < step 0 := lt_step
    have : n < step 0 := AA.substLFn (Rel.symm ‹n ≃ 0›) ‹(0 : ℕ) < step 0›
    have : n < 1 := AA.substRFn (Rel.symm literal_step) ‹n < step 0›
    exact ‹n < 1›

/--
The only square root of unity in the natural numbers is `1`.

**Property and proof intuition**: It can only be one, because zero squared is
zero, and squaring any natural number greater than one always produces a larger
result.
-/
theorem sqrt1 {n : ℕ} : n * n ≃ 1 ↔ n ≃ 1 := by
  apply Iff.intro
  case mp =>
    intro (_ : n * n ≃ 1)
    show n ≃ 1
    have tri : AA.ExactlyOneOfThree (n < 1) (n ≃ 1) (n > 1) := trichotomy n 1
    match tri.atLeastOne with
    | AA.OneOfThree.first (_ : n < 1) =>
      apply False.elim
      show False
      have : n ≃ 0 := zero_lt_one.mp ‹n < 1›
      have : step 0 ≃ 0 := calc
        step 0  ≃ _ := Rel.symm literal_step
        1       ≃ _ := Rel.symm ‹n * n ≃ 1›
        n * n   ≃ _ := AA.substL ‹n ≃ 0›
        0 * n   ≃ _ := AA.absorbL
        0       ≃ _ := Rel.refl
      exact absurd ‹step (0 : ℕ) ≃ 0› step_neqv_zero
    | AA.OneOfThree.second (_ : n ≃ 1) =>
      exact ‹n ≃ 1›
    | AA.OneOfThree.third (_ : n > 1) =>
      apply False.elim
      show False
      apply tri.atMostOne
      show AA.TwoOfThree (n < 1) (n ≃ 1) (n > 1)
      have : step 0 < n := AA.substLFn literal_step ‹1 < n›
      have : 0 < n := Rel.trans lt_step ‹step 0 < n›
      have : Positive n := lt_zero_pos.mpr ‹0 < n›
      have : 1 * n < n * n := AA.substLC ‹Positive n› ‹1 < n›
      have : n < n * n := AA.substLFn AA.identL ‹1 * n < n * n›
      have : n < 1 := AA.substRFn ‹n * n ≃ 1› ‹n < n * n›
      exact AA.TwoOfThree.oneAndThree ‹n < 1› ‹n > 1›
  case mpr =>
    intro (_ : n ≃ 1)
    show n * n ≃ 1
    calc
      n * n ≃ _ := AA.substL ‹n ≃ 1›
      1 * n ≃ _ := AA.identL
      n     ≃ _ := ‹n ≃ 1›
      1     ≃ _ := Rel.refl

end Lean4Axiomatic.Natural


-- combinatorial maps

--import data.multiset
import data.list.perm
import data.fintype.basic
import data.equiv.basic
import group_theory.perm.cycles
import myequiv
import tactic

namespace maps

open function
open equiv

universe u

-- A two-dimension combinatorial map is a collection D of darts, a
-- permutation σ whose orbits correspond to vertices, and a
-- fixed-point-free involution τ whose orbits correspond to edges.  We
-- think of σ as giving the next dart counterclockwise around an edge,
-- and τ as giving the opposite dart of an edge. (Note: this
-- definition excludes disjoint isolated vertices.)
--
-- We only care about the case where the orbits of σ are finite, but
-- we do not require it in the definition.
structure cmap (D : Type u) :=
(σ : perm D) (τ : perm D) (τ_inv : involutive τ) (τ_fp_free : ¬has_fixed_point τ)

namespace cmap
variables {D D' : Type u}

-- The next dart counter-clockwise around a face
@[simp] def ϕ (m : cmap D) : perm D := equiv.trans m.σ.symm m.τ

-- We only will care about the case of equivalences, but in this
-- definition a homomorphism of combinatorial maps is sort of like a
-- branched covering map of surfaces branched over the vertices.
def hom (m : cmap D) (m' : cmap D') (f : D → D') :=
(f ∘ m.σ = m'.σ ∘ f) ∧ (f ∘ m.τ = m'.τ ∘ f)

lemma hom_inv_is_hom (m : cmap D) (m' : cmap D') (f : equiv D D') (h : hom m m' f) : hom m' m f.symm :=
begin
  split,
  calc f.symm ∘ m'.σ = f.symm ∘ m'.σ ∘ id : by refl
                 ... = f.symm ∘ m'.σ ∘ (f ∘ f.symm) : by rw ←self_comp_symm
                 ... = f.symm ∘ (m'.σ ∘ f) ∘ f.symm : by refl
                 ... = f.symm ∘ (f ∘ m.σ) ∘ f.symm : by rw ← h.1
                 ... = (f.symm ∘ f) ∘ m.σ ∘ f.symm : by refl
                 ... = id ∘ m.σ ∘ f.symm : by rw symm_comp_self
                 ... = m.σ ∘ f.symm : by refl,
  calc f.symm ∘ m'.τ = f.symm ∘ m'.τ ∘ id : by refl
                 ... = f.symm ∘ m'.τ ∘ (f ∘ f.symm) : by rw ←self_comp_symm
                 ... = f.symm ∘ (m'.τ ∘ f) ∘ f.symm : by refl
                 ... = f.symm ∘ (f ∘ m.τ) ∘ f.symm : by rw ← h.2
                 ... = (f.symm ∘ f) ∘ m.τ ∘ f.symm : by refl
                 ... = id ∘ m.τ ∘ f.symm : by rw symm_comp_self
                 ... = m.τ ∘ f.symm : by refl,
end

-- In light of `hom_inv_is_hom`, we define an equivalence of maps as
-- an equivalence of their dart sets that is a homomorphism.
def equiv_maps (m : cmap D) (m' : cmap D') (f : equiv D D') := hom m m' f

-- We define the opposite of a map to be the one which reverses the identities of the darts on each edge
def opp (m : cmap D) : cmap D := ⟨equiv.trans (equiv.trans m.τ m.σ) m.τ, m.τ, m.τ_inv, m.τ_fp_free⟩

-- Form the dual map.  This swaps the roles of vertices and faces
def dual (m : cmap D) : cmap D := ⟨m.ϕ, m.τ, m.τ_inv, m.τ_fp_free⟩

lemma double_dual_is_opp (m : cmap D) : m.dual.dual = m.opp :=
begin
  cases m, dsimp [opp, dual], congr,
  calc (m_σ.symm.trans m_τ).symm = m_τ.symm.trans m_σ.symm.symm : by rw equiv.symm_trans_eq_trans_sym
                             ... = m_τ.symm.trans m_σ : by rw equiv.symm_symm
                             ... = m_τ.trans m_σ : by rw equiv.symm_involution m_τ m_τ_inv,
end

-- The opposite of a map (and hence the double dual) is equivalent to the original map.
lemma double_dual (m : cmap D) : ∃ (f : equiv D D), hom m m.opp f :=
begin
  use m.τ,
  split,
  calc m.τ ∘ m.σ = m.τ ∘ m.σ ∘ id : by refl
             ... = m.τ ∘ m.σ ∘ (m.τ ∘ m.τ) : by rw ←equiv.involution_comp_involution m.τ m.τ_inv
             ... = m.opp.σ ∘ m.τ : by refl,
  refl,
end

-- A "dual homomorphism" is a homomorphism that sends vertices to
-- faces and faces to vertices.  The entire point of this definition
-- is purely for `dual_dequiv`.
def dhom (m : cmap D) (m' : cmap D') (f : D → D') :=
(f ∘ m.σ = m'.ϕ ∘ f) ∧ (f ∘ m.τ = m'.τ ∘ f)

-- This is a dhom from a map to its dual.  See `dual_dequiv`.
def to_dual (m : cmap D) : D → D := m.τ

-- A map and its dual are dual equivalent (hence the name)
lemma dual_dequiv (m : cmap D) : dhom m m.dual (to_dual m) :=
begin
  split, ext, simp [dual, to_dual],
  refl,
end

@[reducible] def vertex_setoid (m : cmap D) := perm.psetoid m.σ
@[reducible] def edge_setoid (m : cmap D) := perm.psetoid m.τ
@[reducible] def face_setoid (m : cmap D) := perm.psetoid m.ϕ

@[reducible] def vertices (m : cmap D) := quotient (vertex_setoid m)
@[reducible] def edges (m : cmap D) := quotient (edge_setoid m)
@[reducible] def faces (m : cmap D) := quotient (face_setoid m)

-- The vertex at the dart
@[reducible] def dart_vertex (m : cmap D) (d : D) : m.vertices := @quotient.mk _ (vertex_setoid m) d
-- The edge on the the dart
@[reducible] def dart_edge (m : cmap D) (d : D) : m.edges := @quotient.mk _ (edge_setoid m) d
-- The face to the left of the dart.  That is, the one traced out by `m.ϕ`
@[reducible] def dart_face (m : cmap D) (d : D) : m.faces := @quotient.mk _ (face_setoid m) d

-- The degree of a vertex is the number of incident darts.
def vertices.deg {m : cmap D} [fintype D] [decidable_eq D] (v : m.vertices) : ℕ := begin
  dsimp [vertices] at v, induction v,
  exact fintype.card {d | perm.same_cycle m.σ v d},
  simp, congr, ext, change m.σ.same_cycle v_a v_b at v_p,
  split, intro sc1, exact perm.same_cycle.trans _ (perm.same_cycle.symm _ v_p) sc1,
  intro sc2, exact perm.same_cycle.trans _ v_p sc2,
end

def vertices.darts {m : cmap D} (v : m.vertices) := {d : D | m.dart_vertex d = v}

instance vertices.darts.fintype {m : cmap D} [fintype D] [decidable_eq D] (v : m.vertices) : fintype v.darts :=
begin
  induction v,
  change fintype {d : D | @quotient.mk _ (vertex_setoid m) d = @quotient.mk _ (vertex_setoid m) v},
  simp,
  change fintype {d : D | perm.same_cycle m.σ d v},
  apply_instance,
  have h : ∀ d, m.σ.same_cycle d v_a ↔ m.σ.same_cycle d v_b, {
    sorry,
  },
  suggest,
end

def vertices.deg {m : cmap D} [fintype D] [decidable_eq D] (v : m.vertices) : ℕ := fintype.card v.darts

-- Apply m.σ to a dart at a vertex, yielding another dart at the same vertex
def vertices.σ {m : cmap D} (v : m.vertices) : perm v.darts :=
begin
  let f : v.darts → v.darts, {
    rintro ⟨d, hd⟩,
    refine ⟨m.σ d, _⟩,
    simp [vertices.darts] at ⊢ hd,
    rw ←hd, dsimp [dart_vertex],
    apply quotient.sound,
    change perm.same_cycle _ _ _,
    rw ←perm.same_cycle_apply,
  },
  let g : v.darts → v.darts, {
    rintro ⟨d, hd⟩,
    refine ⟨m.σ.symm d, _⟩,
    simp [vertices.darts] at ⊢ hd,
    rw ←hd, dsimp [dart_vertex],
    apply quotient.sound,
    change perm.same_cycle _ _ _,
    rw ←perm.same_cycle_inv_apply,
    rw perm.inv_def,
  },
  use [f,g],
  rintro ⟨d,h⟩, simp [f,g],
  rintro ⟨d,h⟩, simp [f,g],
end

-- Apply m.σ to a dart at a vertex, yielding another dart at the same vertex
def vertices.σ {m : cmap D} (v : m.vertices) (d : v.darts) : v.darts :=
begin
  cases d, refine ⟨m.σ d_val, _⟩,
  simp [vertices.darts] at ⊢ d_property,
  rw ← d_property, dsimp [dart_vertex],
  apply quotient.sound,
  change perm.same_cycle _ _ _,
  rw ←perm.same_cycle_apply,
end

def faces.darts {m : cmap D} (f : m.faces) := {d : D | m.dart_face d = f}

def faces.σ {m : cmap D} (f : m.faces) (d : f.darts) : f.darts :=

def dart_between.helper {m : cmap D} [decidable_eq D] (v : m.vertices) : ℕ → v.darts → v.darts → v.darts → Prop
| 0 _ _ _ := false
| (n+1) dlo dhi d := if dlo = dhi then true else dart_between.helper n (v.σ dlo) dhi d

-- Given three darts dlo, dhi, and d around a given vertex, determines
-- whether d is between dlo and dhi (inclusive), going counterclockwise.
def dart_between {m : cmap D} [fintype D] [decidable_eq D] (v : m.vertices) (dlo dhi d : v.darts) : Prop :=
dart_between.helper v v.deg dlo dhi d

--def vertices.darts_from {m : cmap D} [fintype D] [decidable_eq D] (v : m.vertices) {d : D} (h : v = m.dart_vertex d) : list D :=
--(list.range v.deg).m

-- The number of sides of a given face
def faces.sides {m : cmap D} [fintype D] [decidable_eq D] (f : m.faces) : ℕ := begin
  dsimp [faces] at f, induction f,
  exact fintype.card {d | perm.same_cycle m.ϕ f d},
  simp, congr, ext, change m.ϕ.same_cycle f_a f_b at f_p,
  split, intro sc1, exact perm.same_cycle.trans _ (perm.same_cycle.symm _ f_p) sc1,
  intro sc2, exact perm.same_cycle.trans _ f_p sc2,
end

def dual_vertex_face_equiv (m : cmap D) : m.faces ≃ m.dual.vertices :=
begin
  let f : m.faces → m.dual.vertices := begin
    intro x, induction x, exact m.dual.dart_vertex x,
    change perm.same_cycle _ _ _ at x_p,
    simpa,
  end,
  let g : m.dual.vertices → m.faces := begin
    intro x, induction x, exact m.dart_face x,
    change perm.same_cycle _ _ _ at x_p,
    simpa,
  end,
  use [f, g],
  intro x, induction x, refl, refl,
  intro x, induction x, refl, refl,
end

def dual_edge_edge_equiv (m : cmap D) : m.edges ≃ m.dual.edges :=
begin
  use [id, id],
  intro x, induction x, refl, refl,
  intro x, induction x, refl, refl,
end

-- def opp_vertex_equiv_vertex (m : cmap D) : m.vertices ≃ m.opp.vertices :=
-- ⟨begin
--   dsimp [vertices],
--   intro v, induction v, exact dart_vertex m.opp (m.τ v),
--   simp [dart_vertex],
--   apply quot.sound,
--   simp [perm.same_cycle, opp],
--   rcases v_p with ⟨i,eq⟩, use i, unfold_coes,
-- --  calc (((m.τ.trans m.σ).trans m.τ) ^ i) (m.τ v_a)
-- --         = (m.τ.trans (m.σ ^ i).trans m.τ.symm) (m.τ v_a)
-- --     ... = (m.τ.trans (m.σ ^ i).trans m.τ.symm) (m.τ v_a)
-- end,sorry,sorry,sorry⟩

-- def dual_vertex_face_equiv (m : cmap D) : m.vertices ≃ m.dual.faces :=
-- begin
--   refine ⟨_,_,_,_⟩,
--   dsimp [vertices,faces,dual,vertex_setoid,face_setoid],
-- end

def euler_characteristic (m : cmap D) [fintype D] [decidable_eq D] : ℤ :=
↑(fintype.card m.vertices) - ↑(fintype.card m.edges) + ↑(fintype.card m.faces)

inductive path (m : cmap D) : m.vertices → m.vertices → Type u
| refl {v : m.vertices} : path v v
| edge (d : D) : path (m.dart_vertex d) (m.dart_vertex (m.τ d))
| join {u v w : m.vertices} : path u v → path v w → path u w

def path.symm {m : cmap D} : ∀ {v w : m.vertices}, path m v w → path m w v
| _ _ path.refl := path.refl
| _ _ (path.join p₁ p₂) := path.join p₂.symm p₁.symm
| _ _ (path.edge d) :=
begin
  have h : m.dart_vertex d = m.dart_vertex (m.τ (m.τ d)), rw m.τ_inv d,
  rw h,
  exact path.edge (m.τ d),
end

def path.length {m : cmap D} : ∀{v w : m.vertices}, path m v w → ℕ
| _ _ path.refl := 0
| _ _ (path.edge d) := 1
| _ _ (path.join p1 p2) := p1.length + p2.length

def connected (m : cmap D) (v w : m.vertices) : Prop := nonempty (path m v w)

def connected.setoid (m : cmap D) : setoid m.vertices :=
⟨connected m,
  (λ x, ⟨path.refl⟩),
  (λ x y r, nonempty.rec_on r (λ r', ⟨path.symm r'⟩)),
  (λ x y z r₁ r₂, nonempty.rec_on r₁ (λ r₁', nonempty.rec_on r₂ (λ r₂', ⟨path.join r₁' r₂'⟩)))⟩

def π₀ (m : cmap D) := quotient (connected.setoid m)

def disk (m : cmap D) (v : m.vertices) (n : ℕ) : set m.vertices := {w : m.vertices | ∃ (p : path m v w), p.length ≤ n}

lemma disk.subset (m : cmap D) (v : m.vertices) {n₁ n₂ : ℕ} (h : n₁ ≤ n₂) : m.disk v n₁ ⊆ m.disk v n₂ :=
begin
  rintros v ⟨p, plen⟩,
  exact ⟨p, by linarith⟩,
end

lemma disk.finite_bound (m : cmap D) [fintype D] [decidable_eq D] {v w : m.vertices} (h : m.connected v w)
: w ∈ m.disk v (fintype.card D) :=
begin
  unfreezeI,
  rcases h with ⟨p⟩,
  let lengths := {n | n ≤ p.length ∧ ∃ (q : m.path v w), n = q.length},
  have len_in : p.length ∈ lengths, {
    split, linarith,
    use p,
  },
  have Asup := well_founded.has_min nat.lt_wf lengths ⟨p.length, len_in⟩,
  rcases Asup with ⟨m, m_in, Asup⟩,
  rcases m_in.2 with ⟨q, qlen⟩,
  have hup : q.length ≤ fintype.card D, {
    by_contradiction, push_neg at a,
--    rw qlen at a,
    sorry, --pigeonhole principle
  },
  exact ⟨q, hup⟩,
end

instance disk.decidable_pred (m : cmap D) [fintype D] [decidable_eq D] (v : m.vertices) (n : ℕ) : decidable_pred (m.disk v n) :=
begin
  intro w,
  dunfold disk,

end

-- this is the statement that you can do graph searches
instance connected.decidable_rel (m : cmap D) [fintype D] [decidable_eq D] : decidable_rel (connected m) :=
begin
  intros v w,
  let d := m.disk v (fintype.card D),
end

instance π₀.fintype (m : cmap D) [fintype D] [decidable_eq D] : fintype (π₀ m) :=
begin
  have h : decidable_rel (connected.setoid m).r, {
    change decidable_rel (connected m), apply_instance,
  },
  apply @quotient.fintype _ _ (connected.setoid m) h,
end

-- The zeroth Betti number is the number of connected components
def b₀ (m : cmap D) [fintype D] [decidable_eq D] : ℕ := fintype.card (π₀ m)

--def genus (m : cmap D) [fintype D] [decidable_eq D] : ℕ := m.b₀ - m.euler_characteristic/2

end cmap

end maps


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.homology.single
import tactic.linarith

/-!
# Augmentation and truncation of `ℕ`-indexed (co)chain complexes.
-/

noncomputable theory

open category_theory
open category_theory.limits
open homological_complex

universes v u

variables {V : Type u} [category.{v} V]

namespace chain_complex

/--
The truncation of a `ℕ`-indexed chain complex,
deleting the object at `0` and shifting everything else down.
-/
@[simps]
def truncate [has_zero_morphisms V] : chain_complex V ℕ ⥤ chain_complex V ℕ :=
{ obj := λ C,
  { X := λ i, C.X (i+1),
    d := λ i j, C.d (i+1) (j+1),
    shape' := λ i j w, by { apply C.shape, simpa }, },
  map := λ C D f,
  { f := λ i, f.f (i+1), }, }

/--
There is a canonical chain map from the truncation of a chain map `C` to
the "single object" chain complex consisting of the truncated object `C.X 0` in degree 0.
The components of this chain map are `C.d 1 0` in degree 0, and zero otherwise.
-/
def truncate_to [has_zero_object V] [has_zero_morphisms V] (C : chain_complex V ℕ) :
  truncate.obj C ⟶ (single₀ V).obj (C.X 0) :=
(to_single₀_equiv (truncate.obj C) (C.X 0)).symm ⟨C.d 1 0, by tidy⟩

-- PROJECT when `V` is abelian (but not generally?)
-- `[∀ n, exact (C.d (n+2) (n+1)) (C.d (n+1) n)] [epi (C.d 1 0)]` iff `quasi_iso (C.truncate_to)`

variables [has_zero_morphisms V]

/--
We can "augment" a chain complex by inserting an arbitrary object in degree zero
(shifting everything else up), along with a suitable differential.
-/
def augment (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
  chain_complex V ℕ :=
{ X := λ i, match i with
  | 0 := X
  | (i+1) := C.X i
  end,
  d := λ i j, match i, j with
  | 1, 0 := f
  | (i+1), (j+1) := C.d i j
  | _, _ := 0
  end,
  shape' := λ i j s, begin
    simp at s,
    rcases i with _|_|i; cases j; unfold_aux; try { simp },
    { simpa using s, },
    { rw [C.shape], simpa [← ne.def, nat.succ_ne_succ] using s },
  end,
  d_comp_d' := λ i j k hij hjk, begin
    rcases i with _|_|i; rcases j with _|_|j; cases k; unfold_aux; try { simp },
    cases i,
    { exact w, },
    { rw [C.shape, zero_comp],
      simpa using i.succ_succ_ne_one.symm },
  end, }

@[simp] lemma augment_X_zero (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
  (augment C f w).X 0 = X := rfl

@[simp]

@[simp] lemma augment_d_one_zero
  (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
  (augment C f w).d 1 0 = f := rfl

@[simp] lemma augment_d_succ_succ
  (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) (i j : ℕ) :
  (augment C f w).d (i+1) (j+1) = C.d i j :=
by { dsimp [augment], rcases i with _|i, refl, refl, }

/--
Truncating an augmented chain complex is isomorphic (with components the identity)
to the original complex.
-/
def truncate_augment (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
  truncate.obj (augment C f w) ≅ C :=
{ hom :=
  { f := λ i, 𝟙 _, },
  inv :=
  { f := λ i, by { exact 𝟙 _, },
    comm' := λ i j, by { cases j; { dsimp, simp, }, }, },
  hom_inv_id' := by { ext i, cases i; { dsimp, simp, }, },
  inv_hom_id' := by { ext i, cases i; { dsimp, simp, }, }, }.

@[simp] lemma truncate_augment_hom_f
  (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) (i : ℕ) :
  (truncate_augment C f w).hom.f i = 𝟙 (C.X i) := rfl
@[simp] lemma truncate_augment_inv_f
  (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) (i : ℕ) :
  (truncate_augment C f w).inv.f i = 𝟙 ((truncate.obj (augment C f w)).X i) :=
rfl

@[simp] lemma chain_complex_d_succ_succ_zero (C : chain_complex V ℕ) (i : ℕ) :
  C.d (i+2) 0 = 0 :=
by { rw C.shape, simpa using i.succ_succ_ne_one.symm }

/--
Augmenting a truncated complex with the original object and morphism is isomorphic
(with components the identity) to the original complex.
-/
def augment_truncate (C : chain_complex V ℕ) :
  augment (truncate.obj C) (C.d 1 0) (C.d_comp_d _ _ _) ≅ C :=
{ hom :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { rcases i with _|_|i; cases j; { dsimp, simp, }, }, },
  inv :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { rcases i with _|_|i; cases j; { dsimp, simp, }, }, },
  hom_inv_id' := by { ext i, cases i; { dsimp, simp, }, },
  inv_hom_id' := by { ext i, cases i; { dsimp, simp, }, }, }.

@[simp] lemma augment_truncate_hom_f_zero (C : chain_complex V ℕ) :
  (augment_truncate C).hom.f 0 = 𝟙 (C.X 0) :=
rfl
@[simp] lemma augment_truncate_hom_f_succ (C : chain_complex V ℕ) (i : ℕ) :
  (augment_truncate C).hom.f (i+1) = 𝟙 (C.X (i+1)) :=
rfl
@[simp] lemma augment_truncate_inv_f_zero (C : chain_complex V ℕ) :
  (augment_truncate C).inv.f 0 = 𝟙 (C.X 0) :=
rfl
@[simp] lemma augment_truncate_inv_f_succ (C : chain_complex V ℕ) (i : ℕ) :
  (augment_truncate C).inv.f (i+1) = 𝟙 (C.X (i+1)) :=
rfl

/--
A chain map from a chain complex to a single object chain complex in degree zero
can be reinterpreted as a chain complex.

Ths is the inverse construction of `truncate_to`.
-/
def to_single₀_as_complex
  [has_zero_object V] (C : chain_complex V ℕ) (X : V) (f : C ⟶ (single₀ V).obj X) :
  chain_complex V ℕ :=
let ⟨f, w⟩ := to_single₀_equiv C X f in augment C f w

end chain_complex

namespace cochain_complex

/--
The truncation of a `ℕ`-indexed cochain complex,
deleting the object at `0` and shifting everything else down.
-/
@[simps]
def truncate [has_zero_morphisms V] : cochain_complex V ℕ ⥤ cochain_complex V ℕ :=
{ obj := λ C,
  { X := λ i, C.X (i+1),
    d := λ i j, C.d (i+1) (j+1),
    shape' := λ i j w, by { apply C.shape, simpa }, },
  map := λ C D f,
  { f := λ i, f.f (i+1), }, }

/--
There is a canonical chain map from the truncation of a cochain complex `C` to
the "single object" cochain complex consisting of the truncated object `C.X 0` in degree 0.
The components of this chain map are `C.d 0 1` in degree 0, and zero otherwise.
-/
def to_truncate [has_zero_object V] [has_zero_morphisms V] (C : cochain_complex V ℕ) :
  (single₀ V).obj (C.X 0) ⟶ truncate.obj C :=
(from_single₀_equiv (truncate.obj C) (C.X 0)).symm ⟨C.d 0 1, by tidy⟩

variables [has_zero_morphisms V]

/--
We can "augment" a cochain complex by inserting an arbitrary object in degree zero
(shifting everything else up), along with a suitable differential.
-/
def augment (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) :
  cochain_complex V ℕ :=
{ X := λ i, match i with
  | 0 := X
  | (i+1) := C.X i
  end,
  d := λ i j, match i, j with
  | 0, 1 := f
  | (i+1), (j+1) := C.d i j
  | _, _ := 0
  end,
  shape' := λ i j s, begin
    simp at s,
    rcases j with _|_|j; cases i; unfold_aux; try { simp },
    { simpa using s, },
    { rw [C.shape], simp only [complex_shape.up_rel], contrapose! s, rw ←s },
  end,
  d_comp_d' := λ i j k hij hjk, begin
    rcases k with _|_|k; rcases j with _|_|j; cases i; unfold_aux; try { simp },
    cases k,
    { exact w, },
    { rw [C.shape, comp_zero],
      simp only [nat.nat_zero_eq_zero, complex_shape.up_rel, zero_add],
      exact (nat.one_lt_succ_succ _).ne },
  end, }

@[simp] lemma augment_X_zero
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) :
  (augment C f w).X 0 = X := rfl

@[simp] lemma augment_X_succ
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) (i : ℕ) :
  (augment C f w).X (i+1) = C.X i := rfl

@[simp] lemma augment_d_zero_one
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) :
  (augment C f w).d 0 1 = f := rfl

@[simp] lemma augment_d_succ_succ
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) (i j : ℕ) :
  (augment C f w).d (i+1) (j+1) = C.d i j :=
rfl

/--
Truncating an augmented cochain complex is isomorphic (with components the identity)
to the original complex.
-/
def truncate_augment (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) :
  truncate.obj (augment C f w) ≅ C :=
{ hom :=
  { f := λ i, 𝟙 _, },
  inv :=
  { f := λ i, by { exact 𝟙 _, },
    comm' := λ i j, by { cases j; { dsimp, simp, }, }, },
  hom_inv_id' := by { ext i, cases i; { dsimp, simp, }, },
  inv_hom_id' := by { ext i, cases i; { dsimp, simp, }, }, }.

@[simp] lemma truncate_augment_hom_f
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) (i : ℕ) :
  (truncate_augment C f w).hom.f i = 𝟙 (C.X i) := rfl
@[simp] lemma truncate_augment_inv_f
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) (i : ℕ) :
  (truncate_augment C f w).inv.f i = 𝟙 ((truncate.obj (augment C f w)).X i) :=
rfl

@[simp] lemma cochain_complex_d_succ_succ_zero (C : cochain_complex V ℕ) (i : ℕ) :
  C.d 0 (i+2) = 0 :=
by { rw C.shape, simp only [complex_shape.up_rel, zero_add], exact (nat.one_lt_succ_succ _).ne }

/--
Augmenting a truncated complex with the original object and morphism is isomorphic
(with components the identity) to the original complex.
-/
def augment_truncate (C : cochain_complex V ℕ) :
  augment (truncate.obj C) (C.d 0 1) (C.d_comp_d _ _ _) ≅ C :=
{ hom :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { rcases j with _|_|j; cases i; { dsimp, simp, }, }, },
  inv :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { rcases j with _|_|j; cases i; { dsimp, simp, }, }, },
  hom_inv_id' := by { ext i, cases i; { dsimp, simp, }, },
  inv_hom_id' := by { ext i, cases i; { dsimp, simp, }, }, }.

@[simp] lemma augment_truncate_hom_f_zero (C : cochain_complex V ℕ) :
  (augment_truncate C).hom.f 0 = 𝟙 (C.X 0) :=
rfl
@[simp] lemma augment_truncate_hom_f_succ (C : cochain_complex V ℕ) (i : ℕ) :
  (augment_truncate C).hom.f (i+1) = 𝟙 (C.X (i+1)) :=
rfl
@[simp] lemma augment_truncate_inv_f_zero (C : cochain_complex V ℕ) :
  (augment_truncate C).inv.f 0 = 𝟙 (C.X 0) :=
rfl
@[simp] lemma augment_truncate_inv_f_succ (C : cochain_complex V ℕ) (i : ℕ) :
  (augment_truncate C).inv.f (i+1) = 𝟙 (C.X (i+1)) :=
rfl

/--
A chain map from a single object cochain complex in degree zero to a cochain complex
can be reinterpreted as a cochain complex.

Ths is the inverse construction of `to_truncate`.
-/
def from_single₀_as_complex
  [has_zero_object V] (C : cochain_complex V ℕ) (X : V) (f : (single₀ V).obj X ⟶ C) :
  cochain_complex V ℕ :=
let ⟨f, w⟩ := from_single₀_equiv C X f in augment C f w

end cochain_complex


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.group_with_zero.commute
import algebra.hom.units
import group_theory.group_action.units

/-!
# Further lemmas about units in a `monoid_with_zero` or a `group_with_zero`.

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

-/

variables {α M₀ G₀ M₀' G₀' F F' : Type*}

variables [monoid_with_zero M₀]

section group_with_zero
variables [group_with_zero G₀] {a b c : G₀}

@[simp] lemma div_self (h : a ≠ 0) : a / a = 1 := h.is_unit.div_self

lemma eq_mul_inv_iff_mul_eq₀ (hc : c ≠ 0) : a = b * c⁻¹ ↔ a * c = b :=
hc.is_unit.eq_mul_inv_iff_mul_eq

lemma eq_inv_mul_iff_mul_eq₀ (hb : b ≠ 0) : a = b⁻¹ * c ↔ b * a = c :=
hb.is_unit.eq_inv_mul_iff_mul_eq

lemma inv_mul_eq_iff_eq_mul₀ (ha : a ≠ 0) : a⁻¹ * b = c ↔ b = a * c :=
ha.is_unit.inv_mul_eq_iff_eq_mul

lemma mul_inv_eq_iff_eq_mul₀ (hb : b ≠ 0) : a * b⁻¹ = c ↔ a = c * b :=
hb.is_unit.mul_inv_eq_iff_eq_mul

lemma mul_inv_eq_one₀ (hb : b ≠ 0) : a * b⁻¹ = 1 ↔ a = b := hb.is_unit.mul_inv_eq_one
lemma inv_mul_eq_one₀ (ha : a ≠ 0) : a⁻¹ * b = 1 ↔ a = b := ha.is_unit.inv_mul_eq_one

lemma mul_eq_one_iff_eq_inv₀ (hb : b ≠ 0) : a * b = 1 ↔ a = b⁻¹ := hb.is_unit.mul_eq_one_iff_eq_inv
lemma mul_eq_one_iff_inv_eq₀ (ha : a ≠ 0) : a * b = 1 ↔ a⁻¹ = b := ha.is_unit.mul_eq_one_iff_inv_eq

@[simp] lemma div_mul_cancel (a : G₀) (h : b ≠ 0) : a / b * b = a := h.is_unit.div_mul_cancel _
@[simp] lemma mul_div_cancel (a : G₀) (h : b ≠ 0) : a * b / b = a := h.is_unit.mul_div_cancel _

lemma mul_one_div_cancel (h : a ≠ 0) : a * (1 / a) = 1 := h.is_unit.mul_one_div_cancel
lemma one_div_mul_cancel (h : a ≠ 0) : (1 / a) * a = 1 := h.is_unit.one_div_mul_cancel

lemma div_left_inj' (hc : c ≠ 0) : a / c = b / c ↔ a = b := hc.is_unit.div_left_inj

@[field_simps] lemma div_eq_iff (hb : b ≠ 0) : a / b = c ↔ a = c * b := hb.is_unit.div_eq_iff
@[field_simps] lemma eq_div_iff (hb : b ≠ 0) : c = a / b ↔ c * b = a := hb.is_unit.eq_div_iff

lemma div_eq_iff_mul_eq (hb : b ≠ 0) : a / b = c ↔ c * b = a := hb.is_unit.div_eq_iff.trans eq_comm
lemma eq_div_iff_mul_eq (hc : c ≠ 0) : a = b / c ↔ a * c = b := hc.is_unit.eq_div_iff

lemma div_eq_of_eq_mul (hb : b ≠ 0) : a = c * b → a / b = c := hb.is_unit.div_eq_of_eq_mul
lemma eq_div_of_mul_eq (hc : c ≠ 0) : a * c = b → a = b / c := hc.is_unit.eq_div_of_mul_eq

lemma div_eq_one_iff_eq (hb : b ≠ 0) : a / b = 1 ↔ a = b := hb.is_unit.div_eq_one_iff_eq

lemma div_mul_left (hb : b ≠ 0) : b / (a * b) = 1 / a := hb.is_unit.div_mul_left

lemma mul_div_mul_right (a b : G₀) (hc : c ≠ 0) : (a * c) / (b * c) = a / b :=
hc.is_unit.mul_div_mul_right _ _

lemma mul_mul_div (a : G₀) (hb : b ≠ 0) : a = a * b * (1 / b) := (hb.is_unit.mul_mul_div _).symm

lemma div_div_div_cancel_right (a : G₀) (hc : c ≠ 0) : (a / c) / (b / c) = a / b :=
by rw [div_div_eq_mul_div, div_mul_cancel _ hc]

lemma div_mul_div_cancel (a : G₀) (hc : c ≠ 0) : (a / c) * (c / b) = a / b :=
by rw [← mul_div_assoc, div_mul_cancel _ hc]

lemma div_mul_cancel_of_imp {a b : G₀} (h : b = 0 → a = 0) : a / b * b = a :=
classical.by_cases (λ hb : b = 0, by simp [*]) (div_mul_cancel a)

lemma mul_div_cancel_of_imp {a b : G₀} (h : b = 0 → a = 0) : a * b / b = a :=
classical.by_cases (λ hb : b = 0, by simp [*]) (mul_div_cancel a)

@[simp] theorem divp_mk0 (a : G₀) {b : G₀} (hb : b ≠ 0) :
  a /ₚ units.mk0 b hb = a / b :=
divp_eq_div _ _

end group_with_zero

section comm_group_with_zero -- comm
variables [comm_group_with_zero G₀] {a b c d : G₀}

lemma div_mul_right (b : G₀) (ha : a ≠ 0) : a / (a * b) = 1 / b := ha.is_unit.div_mul_right _

lemma mul_div_cancel_left_of_imp {a b : G₀} (h : a = 0 → b = 0) : a * b / a = b :=
by rw [mul_comm, mul_div_cancel_of_imp h]

lemma mul_div_cancel_left (b : G₀) (ha : a ≠ 0) : a * b / a = b := ha.is_unit.mul_div_cancel_left _

lemma mul_div_cancel_of_imp' {a b : G₀} (h : b = 0 → a = 0) : b * (a / b) = a :=
by rw [mul_comm, div_mul_cancel_of_imp h]

lemma mul_div_cancel' (a : G₀) (hb : b ≠ 0) : b * (a / b) = a := hb.is_unit.mul_div_cancel' _

lemma mul_div_mul_left (a b : G₀) (hc : c ≠ 0) : (c * a) / (c * b) = a / b :=
hc.is_unit.mul_div_mul_left _ _

lemma mul_eq_mul_of_div_eq_div (a : G₀) {b : G₀} (c : G₀) {d : G₀} (hb : b ≠ 0) (hd : d ≠ 0)
  (h : a / b = c / d) : a * d = c * b :=
by rw [←mul_one a, ←div_self hb, ←mul_comm_div, h, div_mul_eq_mul_div, div_mul_cancel _ hd]

@[field_simps] lemma div_eq_div_iff (hb : b ≠ 0) (hd : d ≠ 0) : a / b = c / d ↔ a * d = c * b :=
hb.is_unit.div_eq_div_iff hd.is_unit

lemma div_div_cancel' (ha : a ≠ 0) : a / (a / b) = b := ha.is_unit.div_div_cancel

lemma div_div_cancel_left' (ha : a ≠ 0) : a / b / a = b⁻¹ := ha.is_unit.div_div_cancel_left

lemma div_helper (b : G₀) (h : a ≠ 0) : 1 / (a * b) * a = 1 / b :=
by rw [div_mul_eq_mul_div, one_mul, div_mul_right _ h]

end comm_group_with_zero

section monoid_with_zero
variables [group_with_zero G₀] [nontrivial M₀]
  [monoid_with_zero M₀'] [monoid_with_zero_hom_class F G₀ M₀]
  [monoid_with_zero_hom_class F' G₀ M₀'] (f : F) {a : G₀}
include M₀

lemma map_ne_zero : f a ≠ 0 ↔ a ≠ 0 :=
⟨λ hfa ha, hfa $ ha.symm ▸ map_zero f, λ ha, ((is_unit.mk0 a ha).map f).ne_zero⟩

@[simp] lemma map_eq_zero : f a = 0 ↔ a = 0 := not_iff_not.1 (map_ne_zero f)

omit M₀
include M₀'

lemma eq_on_inv₀ (f g : F') (h : f a = g a) : f a⁻¹ = g a⁻¹ :=
begin
  rcases eq_or_ne a 0 with rfl|ha,
  { rw [inv_zero, map_zero, map_zero] },
  { exact (is_unit.mk0 a ha).eq_on_inv f g h }
end

end monoid_with_zero

section group_with_zero

variables [group_with_zero G₀] [group_with_zero G₀'] [monoid_with_zero_hom_class F G₀ G₀']
  (f : F) (a b : G₀)
include G₀'

/-- A monoid homomorphism between groups with zeros sending `0` to `0` sends `a⁻¹` to `(f a)⁻¹`. -/
@[simp] lemma map_inv₀ : f a⁻¹ = (f a)⁻¹ :=
begin
  by_cases h : a = 0, by simp [h],
  apply eq_inv_of_mul_eq_one_left,
  rw [← map_mul, inv_mul_cancel h, map_one]
end

@[simp] lemma map_div₀ : f (a / b) = f a / f b := map_div' f (map_inv₀ f) a b

end group_with_zero

/-- We define the inverse as a `monoid_with_zero_hom` by extending the inverse map by zero
on non-units. -/
noncomputable
def monoid_with_zero.inverse {M : Type*} [comm_monoid_with_zero M] :
  M →*₀ M :=
{ to_fun := ring.inverse,
  map_zero' := ring.inverse_zero _,
  map_one' := ring.inverse_one _,
  map_mul' := λ x y, (ring.mul_inverse_rev x y).trans (mul_comm _ _) }

@[simp]
lemma monoid_with_zero.coe_inverse {M : Type*} [comm_monoid_with_zero M] :
  (monoid_with_zero.inverse : M → M) = ring.inverse := rfl

@[simp]
lemma monoid_with_zero.inverse_apply {M : Type*} [comm_monoid_with_zero M] (a : M) :
  monoid_with_zero.inverse a = ring.inverse a := rfl

/-- Inversion on a commutative group with zero, considered as a monoid with zero homomorphism. -/
def inv_monoid_with_zero_hom {G₀ : Type*} [comm_group_with_zero G₀] : G₀ →*₀ G₀ :=
{ map_zero' := inv_zero,
  ..inv_monoid_hom }

namespace units
variables [group_with_zero G₀]
variables {a b : G₀}

@[simp] lemma smul_mk0 {α : Type*} [has_smul G₀ α] {g : G₀} (hg : g ≠ 0) (a : α) :
  (mk0 g hg) • a = g • a :=
rfl

end units


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.algebra.module
import linear_algebra.multilinear.basic

/-!
# Continuous multilinear maps

We define continuous multilinear maps as maps from `Π(i : ι), M₁ i` to `M₂` which are multilinear
and continuous, by extending the space of multilinear maps with a continuity assumption.
Here, `M₁ i` and `M₂` are modules over a ring `R`, and `ι` is an arbitrary type, and all these
spaces are also topological spaces.

## Main definitions

* `continuous_multilinear_map R M₁ M₂` is the space of continuous multilinear maps from
  `Π(i : ι), M₁ i` to `M₂`. We show that it is an `R`-module.

## Implementation notes

We mostly follow the API of multilinear maps.

## Notation

We introduce the notation `M [×n]→L[R] M'` for the space of continuous `n`-multilinear maps from
`M^n` to `M'`. This is a particular case of the general notion (where we allow varying dependent
types as the arguments of our continuous multilinear maps), but arguably the most important one,
especially when defining iterated derivatives.
-/

open function fin set
open_locale big_operators

universes u v w w₁ w₁' w₂ w₃ w₄
variables {R : Type u} {ι : Type v} {n : ℕ} {M : fin n.succ → Type w} {M₁ : ι → Type w₁}
  {M₁' : ι → Type w₁'} {M₂ : Type w₂} {M₃ : Type w₃} {M₄ : Type w₄} [decidable_eq ι]

/-- Continuous multilinear maps over the ring `R`, from `Πi, M₁ i` to `M₂` where `M₁ i` and `M₂`
are modules over `R` with a topological structure. In applications, there will be compatibility
conditions between the algebraic and the topological structures, but this is not needed for the
definition. -/
structure continuous_multilinear_map (R : Type u) {ι : Type v} (M₁ : ι → Type w₁) (M₂ : Type w₂)
  [decidable_eq ι] [semiring R] [∀i, add_comm_monoid (M₁ i)] [add_comm_monoid M₂]
  [∀i, module R (M₁ i)] [module R M₂] [∀i, topological_space (M₁ i)] [topological_space M₂]
  extends multilinear_map R M₁ M₂ :=
(cont : continuous to_fun)

notation M `[×`:25 n `]→L[`:25 R `] ` M' := continuous_multilinear_map R (λ (i : fin n), M) M'

namespace continuous_multilinear_map

section semiring

variables [semiring R]
[Πi, add_comm_monoid (M i)] [Πi, add_comm_monoid (M₁ i)] [Πi, add_comm_monoid (M₁' i)]
  [add_comm_monoid M₂] [add_comm_monoid M₃] [add_comm_monoid M₄] [Π i, module R (M i)]
  [Π i, module R (M₁ i)]  [Π i, module R (M₁' i)] [module R M₂]
  [module R M₃] [module R M₄]
  [Π i, topological_space (M i)] [Π i, topological_space (M₁ i)] [Π i, topological_space (M₁' i)]
  [topological_space M₂] [topological_space M₃] [topological_space M₄]
(f f' : continuous_multilinear_map R M₁ M₂)

instance : has_coe_to_fun (continuous_multilinear_map R M₁ M₂) (λ _, (Π i, M₁ i) → M₂) :=
⟨λ f, f.to_fun⟩

@[continuity] lemma coe_continuous : continuous (f : (Π i, M₁ i) → M₂) := f.cont

@[simp] lemma coe_coe : (f.to_multilinear_map : (Π i, M₁ i) → M₂) = f := rfl

theorem to_multilinear_map_inj :
  function.injective (continuous_multilinear_map.to_multilinear_map :
    continuous_multilinear_map R M₁ M₂ → multilinear_map R M₁ M₂)
| ⟨f, hf⟩ ⟨g, hg⟩ rfl := rfl

@[ext] theorem ext {f f' : continuous_multilinear_map R M₁ M₂} (H : ∀ x, f x = f' x) : f = f' :=
to_multilinear_map_inj $ multilinear_map.ext H

@[simp] lemma map_add (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
  f (update m i (x + y)) = f (update m i x) + f (update m i y) :=
f.map_add' m i x y

@[simp] lemma map_smul (m : Πi, M₁ i) (i : ι) (c : R) (x : M₁ i) :
  f (update m i (c • x)) = c • f (update m i x) :=
f.map_smul' m i c x

lemma map_coord_zero {m : Πi, M₁ i} (i : ι) (h : m i = 0) : f m = 0 :=
f.to_multilinear_map.map_coord_zero i h

@[simp] lemma map_zero [nonempty ι] : f 0 = 0 :=
f.to_multilinear_map.map_zero

instance : has_zero (continuous_multilinear_map R M₁ M₂) :=
⟨{ cont := continuous_const, ..(0 : multilinear_map R M₁ M₂) }⟩

instance : inhabited (continuous_multilinear_map R M₁ M₂) := ⟨0⟩

@[simp] lemma zero_apply (m : Πi, M₁ i) : (0 : continuous_multilinear_map R M₁ M₂) m = 0 := rfl

section has_continuous_add
variable [has_continuous_add M₂]

instance : has_add (continuous_multilinear_map R M₁ M₂) :=
⟨λ f f', ⟨f.to_multilinear_map + f'.to_multilinear_map, f.cont.add f'.cont⟩⟩

@[simp] lemma add_apply (m : Πi, M₁ i) : (f + f') m = f m + f' m := rfl

@[simp] lemma to_multilinear_map_add (f g : continuous_multilinear_map R M₁ M₂) :
  (f + g).to_multilinear_map = f.to_multilinear_map + g.to_multilinear_map :=
rfl

instance add_comm_monoid : add_comm_monoid (continuous_multilinear_map R M₁ M₂) :=
to_multilinear_map_inj.add_comm_monoid _ rfl (λ _ _, rfl)

/-- Evaluation of a `continuous_multilinear_map` at a vector as an `add_monoid_hom`. -/
def apply_add_hom (m : Π i, M₁ i) : continuous_multilinear_map R M₁ M₂ →+ M₂ :=
⟨λ f, f m, rfl, λ _ _, rfl⟩

@[simp] lemma sum_apply {α : Type*} (f : α → continuous_multilinear_map R M₁ M₂)
  (m : Πi, M₁ i) {s : finset α} : (∑ a in s, f a) m = ∑ a in s, f a m :=
(apply_add_hom m).map_sum f s

end has_continuous_add

/-- If `f` is a continuous multilinear map, then `f.to_continuous_linear_map m i` is the continuous
linear map obtained by fixing all coordinates but `i` equal to those of `m`, and varying the
`i`-th coordinate. -/
def to_continuous_linear_map (m : Πi, M₁ i) (i : ι) : M₁ i →L[R] M₂ :=
{ cont := f.cont.comp (continuous_const.update i continuous_id),
  .. f.to_multilinear_map.to_linear_map m i }

/-- The cartesian product of two continuous multilinear maps, as a continuous multilinear map. -/
def prod (f : continuous_multilinear_map R M₁ M₂) (g : continuous_multilinear_map R M₁ M₃) :
  continuous_multilinear_map R M₁ (M₂ × M₃) :=
{ cont := f.cont.prod_mk g.cont,
  .. f.to_multilinear_map.prod g.to_multilinear_map }

@[simp] lemma prod_apply
  (f : continuous_multilinear_map R M₁ M₂) (g : continuous_multilinear_map R M₁ M₃) (m : Πi, M₁ i) :
  (f.prod g) m = (f m, g m) := rfl

/-- Combine a family of continuous multilinear maps with the same domain and codomains `M' i` into a
continuous multilinear map taking values in the space of functions `Π i, M' i`. -/
def pi {ι' : Type*} {M' : ι' → Type*} [Π i, add_comm_monoid (M' i)] [Π i, topological_space (M' i)]
  [Π i, module R (M' i)] (f : Π i, continuous_multilinear_map R M₁ (M' i)) :
  continuous_multilinear_map R M₁ (Π i, M' i) :=
{ cont := continuous_pi $ λ i, (f i).coe_continuous,
  to_multilinear_map := multilinear_map.pi (λ i, (f i).to_multilinear_map) }

@[simp] lemma coe_pi {ι' : Type*} {M' : ι' → Type*} [Π i, add_comm_monoid (M' i)]
  [Π i, topological_space (M' i)] [Π i, module R (M' i)]
  (f : Π i, continuous_multilinear_map R M₁ (M' i)) :
  ⇑(pi f) = λ m j, f j m :=
rfl

lemma pi_apply {ι' : Type*} {M' : ι' → Type*} [Π i, add_comm_monoid (M' i)]
  [Π i, topological_space (M' i)] [Π i, module R (M' i)]
  (f : Π i, continuous_multilinear_map R M₁ (M' i)) (m : Π i, M₁ i) (j : ι') :
  pi f m j = f j m :=
rfl

/-- If `g` is continuous multilinear and `f` is a collection of continuous linear maps,
then `g (f₁ m₁, ..., fₙ mₙ)` is again a continuous multilinear map, that we call
`g.comp_continuous_linear_map f`. -/
def comp_continuous_linear_map
  (g : continuous_multilinear_map R M₁' M₄) (f : Π i : ι, M₁ i →L[R] M₁' i) :
  continuous_multilinear_map R M₁ M₄ :=
{ cont := g.cont.comp $ continuous_pi $ λj, (f j).cont.comp $ continuous_apply _,
  .. g.to_multilinear_map.comp_linear_map (λ i, (f i).to_linear_map) }

@[simp] lemma comp_continuous_linear_map_apply (g : continuous_multilinear_map R M₁' M₄)
  (f : Π i : ι, M₁ i →L[R] M₁' i) (m : Π i, M₁ i) :
  g.comp_continuous_linear_map f m = g (λ i, f i $ m i) :=
rfl

/-- Composing a continuous multilinear map with a continuous linear map gives again a
continuous multilinear map. -/
def _root_.continuous_linear_map.comp_continuous_multilinear_map
  (g : M₂ →L[R] M₃) (f : continuous_multilinear_map R M₁ M₂) :
  continuous_multilinear_map R M₁ M₃ :=
{ cont := g.cont.comp f.cont,
  .. g.to_linear_map.comp_multilinear_map f.to_multilinear_map }

@[simp] lemma _root_.continuous_linear_map.comp_continuous_multilinear_map_coe (g : M₂ →L[R] M₃)
  (f : continuous_multilinear_map R M₁ M₂) :
  ((g.comp_continuous_multilinear_map f) : (Πi, M₁ i) → M₃) =
  (g : M₂ → M₃) ∘ (f : (Πi, M₁ i) → M₂) :=
by { ext m, refl }

/-- `continuous_multilinear_map.pi` as an `equiv`. -/
@[simps]
def pi_equiv {ι' : Type*} {M' : ι' → Type*} [Π i, add_comm_monoid (M' i)]
  [Π i, topological_space (M' i)] [Π i, module R (M' i)] :
  (Π i, continuous_multilinear_map R M₁ (M' i)) ≃
  continuous_multilinear_map R M₁ (Π i, M' i) :=
{ to_fun := continuous_multilinear_map.pi,
  inv_fun := λ f i, (continuous_linear_map.proj i : _ →L[R] M' i).comp_continuous_multilinear_map f,
  left_inv := λ f, by { ext, refl },
  right_inv := λ f, by { ext, refl } }

/-- In the specific case of continuous multilinear maps on spaces indexed by `fin (n+1)`, where one
can build an element of `Π(i : fin (n+1)), M i` using `cons`, one can express directly the
additivity of a multilinear map along the first variable. -/
lemma cons_add (f : continuous_multilinear_map R M M₂) (m : Π(i : fin n), M i.succ) (x y : M 0) :
  f (cons (x+y) m) = f (cons x m) + f (cons y m) :=
f.to_multilinear_map.cons_add m x y

/-- In the specific case of continuous multilinear maps on spaces indexed by `fin (n+1)`, where one
can build an element of `Π(i : fin (n+1)), M i` using `cons`, one can express directly the
multiplicativity of a multilinear map along the first variable. -/
lemma cons_smul
  (f : continuous_multilinear_map R M M₂) (m : Π(i : fin n), M i.succ) (c : R) (x : M 0) :
  f (cons (c • x) m) = c • f (cons x m) :=
f.to_multilinear_map.cons_smul m c x

lemma map_piecewise_add (m m' : Πi, M₁ i) (t : finset ι) :
  f (t.piecewise (m + m') m') = ∑ s in t.powerset, f (s.piecewise m m') :=
f.to_multilinear_map.map_piecewise_add _ _ _

/-- Additivity of a continuous multilinear map along all coordinates at the same time,
writing `f (m + m')` as the sum  of `f (s.piecewise m m')` over all sets `s`. -/
lemma map_add_univ [fintype ι] (m m' : Πi, M₁ i) :
  f (m + m') = ∑ s : finset ι, f (s.piecewise m m') :=
f.to_multilinear_map.map_add_univ _ _

section apply_sum

open fintype finset

variables {α : ι → Type*} [fintype ι] (g : Π i, α i → M₁ i) (A : Π i, finset (α i))

/-- If `f` is continuous multilinear, then `f (Σ_{j₁ ∈ A₁} g₁ j₁, ..., Σ_{jₙ ∈ Aₙ} gₙ jₙ)` is the
sum of `f (g₁ (r 1), ..., gₙ (r n))` where `r` ranges over all functions with `r 1 ∈ A₁`, ...,
`r n ∈ Aₙ`. This follows from multilinearity by expanding successively with respect to each
coordinate. -/

lemma map_sum_finset  :
  f (λ i, ∑ j in A i, g i j) = ∑ r in pi_finset A, f (λ i, g i (r i)) :=
f.to_multilinear_map.map_sum_finset _ _

/-- If `f` is continuous multilinear, then `f (Σ_{j₁} g₁ j₁, ..., Σ_{jₙ} gₙ jₙ)` is the sum of
`f (g₁ (r 1), ..., gₙ (r n))` where `r` ranges over all functions `r`. This follows from
multilinearity by expanding successively with respect to each coordinate. -/
lemma map_sum [∀ i, fintype (α i)] :
  f (λ i, ∑ j, g i j) = ∑ r : Π i, α i, f (λ i, g i (r i)) :=
f.to_multilinear_map.map_sum _

end apply_sum

section restrict_scalar

variables (R) {A : Type*} [semiring A] [has_scalar R A] [Π (i : ι), module A (M₁ i)]
  [module A M₂] [∀ i, is_scalar_tower R A (M₁ i)] [is_scalar_tower R A M₂]

/-- Reinterpret an `A`-multilinear map as an `R`-multilinear map, if `A` is an algebra over `R`
and their actions on all involved modules agree with the action of `R` on `A`. -/
def restrict_scalars (f : continuous_multilinear_map A M₁ M₂) :
  continuous_multilinear_map R M₁ M₂ :=
{ to_multilinear_map := f.to_multilinear_map.restrict_scalars R,
  cont := f.cont }

@[simp] lemma coe_restrict_scalars (f : continuous_multilinear_map A M₁ M₂) :
  ⇑(f.restrict_scalars R) = f := rfl

end restrict_scalar

end semiring

section ring

variables [ring R] [∀i, add_comm_group (M₁ i)] [add_comm_group M₂]
[∀i, module R (M₁ i)] [module R M₂] [∀i, topological_space (M₁ i)] [topological_space M₂]
(f f' : continuous_multilinear_map R M₁ M₂)

@[simp] lemma map_sub (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
  f (update m i (x - y)) = f (update m i x) - f (update m i y) :=
f.to_multilinear_map.map_sub _ _ _ _

section topological_add_group
variable [topological_add_group M₂]

instance : has_neg (continuous_multilinear_map R M₁ M₂) :=
⟨λ f, {cont := f.cont.neg, ..(-f.to_multilinear_map)}⟩

@[simp] lemma neg_apply (m : Πi, M₁ i) : (-f) m = - (f m) := rfl

instance : has_sub (continuous_multilinear_map R M₁ M₂) :=
⟨λ f g, { cont := f.cont.sub g.cont, .. (f.to_multilinear_map - g.to_multilinear_map) }⟩

@[simp] lemma sub_apply (m : Πi, M₁ i) : (f - f') m = f m - f' m := rfl

instance : add_comm_group (continuous_multilinear_map R M₁ M₂) :=
to_multilinear_map_inj.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)

end topological_add_group

end ring

section comm_semiring

variables [comm_semiring R]
[∀i, add_comm_monoid (M₁ i)] [add_comm_monoid M₂]
[∀i, module R (M₁ i)] [module R M₂]
[∀i, topological_space (M₁ i)] [topological_space M₂]
(f : continuous_multilinear_map R M₁ M₂)

lemma map_piecewise_smul (c : ι → R) (m : Πi, M₁ i) (s : finset ι) :
  f (s.piecewise (λ i, c i • m i) m) = (∏ i in s, c i) • f m :=
f.to_multilinear_map.map_piecewise_smul _ _ _

/-- Multiplicativity of a continuous multilinear map along all coordinates at the same time,
writing `f (λ i, c i • m i)` as `(∏ i, c i) • f m`. -/
lemma map_smul_univ [fintype ι] (c : ι → R) (m : Πi, M₁ i) :
  f (λ i, c i • m i) = (∏ i, c i) • f m :=
f.to_multilinear_map.map_smul_univ _ _

variables {R' A : Type*} [comm_semiring R'] [semiring A] [algebra R' A]
  [Π i, module A (M₁ i)] [module R' M₂] [module A M₂] [is_scalar_tower R' A M₂]
  [topological_space R'] [has_continuous_smul R' M₂]

instance : has_scalar R' (continuous_multilinear_map A M₁ M₂) :=
⟨λ c f, { cont := continuous_const.smul f.cont, .. c • f.to_multilinear_map }⟩

@[simp] lemma smul_apply (f : continuous_multilinear_map A M₁ M₂) (c : R') (m : Πi, M₁ i) :
  (c • f) m = c • f m := rfl

@[simp] lemma to_multilinear_map_smul (c : R') (f : continuous_multilinear_map A M₁ M₂) :
  (c • f).to_multilinear_map = c • f.to_multilinear_map :=
rfl

instance {R''} [comm_semiring R''] [has_scalar R' R''] [algebra R'' A]
  [module R'' M₂] [is_scalar_tower R'' A M₂] [is_scalar_tower R' R'' M₂]
  [topological_space R''] [has_continuous_smul R'' M₂]:
  is_scalar_tower R' R'' (continuous_multilinear_map A M₁ M₂) :=
⟨λ c₁ c₂ f, ext $ λ x, smul_assoc _ _ _⟩

variable [has_continuous_add M₂]

/-- The space of continuous multilinear maps over an algebra over `R` is a module over `R`, for the
pointwise addition and scalar multiplication. -/
instance : module R' (continuous_multilinear_map A M₁ M₂) :=
{ one_smul := λ f, ext $ λ x, one_smul _ _,
  mul_smul := λ c₁ c₂ f, ext $ λ x, mul_smul _ _ _,
  smul_zero := λ r, ext $ λ x, smul_zero _,
  smul_add := λ r f₁ f₂, ext $ λ x, smul_add _ _ _,
  add_smul := λ r₁ r₂ f, ext $ λ x, add_smul _ _ _,
  zero_smul := λ f, ext $ λ x, zero_smul _ _ }

/-- Linear map version of the map `to_multilinear_map` associating to a continuous multilinear map
the corresponding multilinear map. -/
@[simps] def to_multilinear_map_linear :
  (continuous_multilinear_map A M₁ M₂) →ₗ[R'] (multilinear_map A M₁ M₂) :=
{ to_fun    := λ f, f.to_multilinear_map,
  map_add'  := λ f g, rfl,
  map_smul' := λ c f, rfl }

/-- `continuous_multilinear_map.pi` as a `linear_equiv`. -/
@[simps {simp_rhs := tt}]
def pi_linear_equiv {ι' : Type*} {M' : ι' → Type*}
  [Π i, add_comm_monoid (M' i)] [Π i, topological_space (M' i)] [∀ i, has_continuous_add (M' i)]
  [Π i, module R' (M' i)] [Π i, module A (M' i)] [∀ i, is_scalar_tower R' A (M' i)]
  [Π i, has_continuous_smul R' (M' i)] :
  -- typeclass search doesn't find this instance, presumably due to struggles converting
  -- `Π i, module R (M' i)` to `Π i, has_scalar R (M' i)` in dependent arguments.
  let inst : has_continuous_smul R' (Π i, M' i) := pi.has_continuous_smul in
  (Π i, continuous_multilinear_map A M₁ (M' i)) ≃ₗ[R']
    continuous_multilinear_map A M₁ (Π i, M' i) :=
{ map_add' := λ x y, rfl,
  map_smul' := λ c x, rfl,
  .. pi_equiv }

end comm_semiring

end continuous_multilinear_map


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import data.rat.cast
import algebra.big_operators.basic

/-! # Casting lemmas for rational numbers involving sums and products

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

open_locale big_operators

variables {ι α : Type*}

namespace rat

section with_div_ring
variables [division_ring α] [char_zero α]

@[simp, norm_cast]

@[simp, norm_cast] lemma cast_multiset_sum (s : multiset ℚ) : (↑(s.sum) : α) = (s.map coe).sum :=
map_multiset_sum (rat.cast_hom α) _

@[simp, norm_cast] lemma cast_sum (s : finset ι) (f : ι → ℚ) :
  (↑(∑ i in s, f i) : α) = ∑ i in s, f i :=
map_sum (rat.cast_hom α) _ _

@[simp, norm_cast] lemma cast_list_prod (s : list ℚ) : (↑(s.prod) : α) = (s.map coe).prod :=
map_list_prod (rat.cast_hom α) _

end with_div_ring

section field
variables [field α] [char_zero α]

@[simp, norm_cast] lemma cast_multiset_prod (s : multiset ℚ) : (↑(s.prod) : α) = (s.map coe).prod :=
map_multiset_prod (rat.cast_hom α) _

@[simp, norm_cast] lemma cast_prod (s : finset ι) (f : ι → ℚ) :
  (↑(∏ i in s, f i) : α) = ∏ i in s, f i :=
map_prod (rat.cast_hom α) _ _

end field

end rat


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Gabriel Ebner

! This file was ported from Lean 3 source module data.int.cast.defs
! leanprover-community/mathlib commit acebd8d49928f6ed8920e502a6c90674e75bd441
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Cast.Defs

/-!
# Cast of integers

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

This file defines the *canonical* homomorphism from the integers into an
additive group with a one (typically a `ring`).  In additive groups with a one
element, there exists a unique such homomorphism and we store it in the
`int_cast : ℤ → R` field.

Preferentially, the homomorphism is written as a coercion.

## Main declarations

* `int.cast`: Canonical homomorphism `ℤ → R`.
* `add_group_with_one`: Type class for `int.cast`.
-/

universe u

attribute [simp] Int.ofNat_eq_coe

#print Int.castDef /-
/-- Default value for `add_group_with_one.int_cast`. -/
protected def Int.castDef {R : Type u} [NatCast R] [Neg R] : ℤ → R
  | (n : ℕ) => n
  | -[n+1] => -(n + 1 : ℕ)
#align int.cast_def Int.castDef
-/

#print IntCast /-
/-- Type class for the canonical homomorphism `ℤ → R`.
-/
class IntCast (R : Type u) where
  intCast : ℤ → R
#align has_int_cast IntCast
-/

#print AddGroupWithOne /-
/-- An `add_group_with_one` is an `add_group` with a `1`.
It also contains data for the unique homomorphisms `ℕ → R` and `ℤ → R`.
-/
@[protect_proj]
class AddGroupWithOne (R : Type u) extends IntCast R, AddGroup R, AddMonoidWithOne R where
  intCast := Int.castDef
  intCast_ofNat :
    ∀ n : ℕ, int_cast n = (n : R) := by
    intros
    rfl
  intCast_negSucc :
    ∀ n : ℕ, int_cast (-(n + 1 : ℕ)) =
        -((n + 1 : ℕ) : R) := by
    intros
    rfl
#align add_group_with_one AddGroupWithOne
-/

#print AddCommGroupWithOne /-
/-- An `add_comm_group_with_one` is an `add_group_with_one` satisfying `a + b = b + a`. -/
@[protect_proj]
class AddCommGroupWithOne (R : Type u) extends AddCommGroup R, AddGroupWithOne R,
  AddCommMonoidWithOne R
#align add_comm_group_with_one AddCommGroupWithOne
-/

#print Int.cast /-
/-- Canonical homomorphism from the integers to any ring(-like) structure `R` -/
protected def Int.cast {R : Type u} [IntCast R] (i : ℤ) : R :=
  IntCast.intCast i
#align int.cast Int.cast
-/

open Nat

namespace Int

variable {R : Type u} [AddGroupWithOne R]

-- see Note [coercion into rings]
instance (priority := 900) castCoe {R} [IntCast R] : CoeTC ℤ R :=
  ⟨Int.cast⟩
#align int.cast_coe Int.castCoe

/- warning: int.cast_of_nat clashes with int.cast_coe_nat -> Int.cast_ofNatₓ
Case conversion may be inaccurate. Consider using '#align int.cast_of_nat Int.cast_ofNatₓₓ'. -/
#print Int.cast_ofNatₓ /-
theorem cast_ofNat (n : ℕ) : (ofNat n : R) = n :=
  AddGroupWithOne.intCast_ofNat n
#align int.cast_of_nat Int.cast_ofNatₓ
-/

end Int