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

/-!
# Down-compressions

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

This file defines down-compression.

Down-compressing `𝒜 : finset (finset α)` along `a : α` means removing `a` from the elements of `𝒜`,
when the resulting set is not already in `𝒜`.

## Main declarations

* `finset.non_member_subfamily`: `𝒜.non_member_subfamily a` is the subfamily of sets not containing
  `a`.
* `finset.member_subfamily`: `𝒜.member_subfamily a` is the image of the subfamily of sets containing
  `a` under removing `a`.
* `down.compression`: Down-compression.

## Notation

`𝓓 a 𝒜` is notation for `down.compress a 𝒜` in locale `set_family`.

## References

* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf

## Tags

compression, down-compression
-/

variables {α : Type*} [decidable_eq α] {𝒜 ℬ : finset (finset α)} {s : finset α} {a : α}

namespace finset

/-- Elements of `𝒜` that do not contain `a`. -/
def non_member_subfamily (a : α) (𝒜 : finset (finset α)) : finset (finset α) :=
𝒜.filter $ λ s, a ∉ s

/-- Image of the elements of `𝒜` which contain `a` under removing `a`. Finsets that do not contain
`a` such that `insert a s ∈ 𝒜`. -/
def member_subfamily (a : α) (𝒜 : finset (finset α)) : finset (finset α) :=
(𝒜.filter $ λ s, a ∈ s).image $ λ s, erase s a

@[simp] lemma mem_non_member_subfamily : s ∈ 𝒜.non_member_subfamily a ↔ s ∈ 𝒜 ∧ a ∉ s := mem_filter
@[simp] lemma mem_member_subfamily : s ∈ 𝒜.member_subfamily a ↔ insert a s ∈ 𝒜 ∧ a ∉ s :=
begin
  simp_rw [member_subfamily, mem_image, mem_filter],
  refine ⟨_, λ h, ⟨insert a s, ⟨h.1, mem_insert_self _ _⟩, erase_insert h.2⟩⟩,
  rintro ⟨s, hs, rfl⟩,
  rw insert_erase hs.2,
  exact ⟨hs.1, not_mem_erase _ _⟩,
end

lemma non_member_subfamily_inter (a : α) (𝒜 ℬ : finset (finset α)) :
  (𝒜 ∩ ℬ).non_member_subfamily a = 𝒜.non_member_subfamily a ∩ ℬ.non_member_subfamily a :=
filter_inter_distrib _ _ _

lemma member_subfamily_inter (a : α) (𝒜 ℬ : finset (finset α)) :
  (𝒜 ∩ ℬ).member_subfamily a = 𝒜.member_subfamily a ∩ ℬ.member_subfamily a :=
begin
  unfold member_subfamily,
  rw [filter_inter_distrib, image_inter_of_inj_on _ _ ((erase_inj_on' _).mono _)],
  rw [←coe_union, ←filter_union, coe_filter],
  exact set.inter_subset_right _ _,
end

lemma non_member_subfamily_union (a : α) (𝒜 ℬ : finset (finset α)) :
  (𝒜 ∪ ℬ).non_member_subfamily a = 𝒜.non_member_subfamily a ∪ ℬ.non_member_subfamily a :=
filter_union _ _ _

lemma member_subfamily_union (a : α) (𝒜 ℬ : finset (finset α)) :
  (𝒜 ∪ ℬ).member_subfamily a = 𝒜.member_subfamily a ∪ ℬ.member_subfamily a :=
by simp_rw [member_subfamily, filter_union, image_union]

lemma card_member_subfamily_add_card_non_member_subfamily (a : α) (𝒜 : finset (finset α)) :
  (𝒜.member_subfamily a).card + (𝒜.non_member_subfamily a).card = 𝒜.card :=
begin
  rw [member_subfamily, non_member_subfamily, card_image_of_inj_on,
    filter_card_add_filter_neg_card_eq_card],
  exact (erase_inj_on' _).mono (λ s hs, (mem_filter.1 hs).2),
end

lemma member_subfamily_union_non_member_subfamily (a : α) (𝒜 : finset (finset α)) :
  𝒜.member_subfamily a ∪ 𝒜.non_member_subfamily a = 𝒜.image (λ s, s.erase a) :=
begin
  ext s,
  simp only [mem_union, mem_member_subfamily, mem_non_member_subfamily, mem_image, exists_prop],
  split,
  { rintro (h | h),
    { exact ⟨_, h.1, erase_insert h.2⟩ },
    { exact ⟨_, h.1, erase_eq_of_not_mem h.2⟩ } },
  { rintro ⟨s, hs, rfl⟩,
    by_cases ha : a ∈ s,
    { exact or.inl ⟨by rwa insert_erase ha, not_mem_erase _ _⟩ },
    { exact or.inr ⟨by rwa erase_eq_of_not_mem ha, not_mem_erase _ _⟩ } }
end

@[simp] lemma member_subfamily_member_subfamily : (𝒜.member_subfamily a).member_subfamily a = ∅ :=
by { ext, simp }

@[simp] lemma member_subfamily_non_member_subfamily :
  (𝒜.non_member_subfamily a).member_subfamily a = ∅ :=
by { ext, simp }

@[simp] lemma non_member_subfamily_member_subfamily :
  (𝒜.member_subfamily a).non_member_subfamily a = 𝒜.member_subfamily a :=
by { ext, simp }

@[simp] lemma non_member_subfamily_non_member_subfamily :
  (𝒜.non_member_subfamily a).non_member_subfamily a = 𝒜.non_member_subfamily a :=
by { ext, simp }

end finset

open finset

-- The namespace is here to distinguish from other compressions.
namespace down

/-- `a`-down-compressing `𝒜` means removing `a` from the elements of `𝒜` that contain it, when the
resulting finset is not already in `𝒜`. -/
def compression (a : α) (𝒜 : finset (finset α)) : finset (finset α) :=
(𝒜.filter $ λ s, erase s a ∈ 𝒜).disj_union ((𝒜.image $ λ s, erase s a).filter $ λ s, s ∉ 𝒜) $
  disjoint_left.2 $ λ s h₁ h₂, (mem_filter.1 h₂).2 (mem_filter.1 h₁).1

localized "notation (name := down.compression) `𝓓 ` := down.compression" in finset_family

/-- `a` is in the down-compressed family iff it's in the original and its compression is in the
original, or it's not in the original but it's the compression of something in the original. -/
lemma mem_compression : s ∈ 𝓓 a 𝒜 ↔ s ∈ 𝒜 ∧ s.erase a ∈ 𝒜 ∨ s ∉ 𝒜 ∧ insert a s ∈ 𝒜 :=
begin
  simp_rw [compression, mem_disj_union, mem_filter, mem_image, and_comm (s ∉ 𝒜)],
  refine or_congr_right' (and_congr_left $ λ hs,
    ⟨_, λ h, ⟨_, h, erase_insert $ insert_ne_self.1 $ ne_of_mem_of_not_mem h hs⟩⟩),
  rintro ⟨t, ht, rfl⟩,
  rwa insert_erase (erase_ne_self.1 (ne_of_mem_of_not_mem ht hs).symm),
end

lemma erase_mem_compression (hs : s ∈ 𝒜) : s.erase a ∈ 𝓓 a 𝒜 :=
begin
  simp_rw [mem_compression, erase_idem, and_self],
  refine (em _).imp_right (λ h, ⟨h, _⟩),
  rwa insert_erase (erase_ne_self.1 (ne_of_mem_of_not_mem hs h).symm),
end

-- This is a special case of `erase_mem_compression` once we have `compression_idem`.
lemma erase_mem_compression_of_mem_compression : s ∈ 𝓓 a 𝒜 → s.erase a ∈ 𝓓 a 𝒜 :=
begin
  simp_rw [mem_compression, erase_idem],
  refine or.imp (λ h, ⟨h.2, h.2⟩) (λ h, _),
  rwa [erase_eq_of_not_mem (insert_ne_self.1 $ ne_of_mem_of_not_mem h.2 h.1)],
end

lemma mem_compression_of_insert_mem_compression (h : insert a s ∈ 𝓓 a 𝒜) : s ∈ 𝓓 a 𝒜 :=
begin
  by_cases ha : a ∈ s,
  { rwa insert_eq_of_mem ha at h },
  { rw ←erase_insert ha,
    exact erase_mem_compression_of_mem_compression h }
end

/-- Down-compressing a family is idempotent. -/
@[simp] lemma compression_idem (a : α) (𝒜 : finset (finset α)) : 𝓓 a (𝓓 a 𝒜) = 𝓓 a 𝒜 :=
begin
  ext s,
  refine mem_compression.trans ⟨_, λ h, or.inl ⟨h, erase_mem_compression_of_mem_compression h⟩⟩,
  rintro (h | h),
  { exact h.1 },
  { cases h.1 (mem_compression_of_insert_mem_compression h.2) }
end

/-- Down-compressing a family doesn't change its size. -/
@[simp] lemma card_compression (a : α) (𝒜 : finset (finset α)) : (𝓓 a 𝒜).card = 𝒜.card :=
begin
  rw [compression, card_disj_union, image_filter, card_image_of_inj_on ((erase_inj_on' _).mono $
    λ s hs, _), ←card_disjoint_union, filter_union_filter_neg_eq],
  { exact disjoint_filter_filter_neg _ _ _ },
  rw [mem_coe, mem_filter] at hs,
  exact not_imp_comm.1 erase_eq_of_not_mem (ne_of_mem_of_not_mem hs.1 hs.2).symm,
end

end down


namespace weekday_example

inductive weekday
| sunday | monday | tuesday | wednesday
| thursday | friday | saturday

open weekday

def next : weekday → weekday
| sunday := monday
| monday := tuesday
| tuesday := wednesday
| wednesday := thursday
| thursday := friday
| friday := saturday
| saturday := sunday

lemma next_sunday_is_monday : next sunday = monday := rfl

end weekday_example

namespace list_example

universe u

inductive list (α : Type u)
| nil {} : list
| cons (a : α) (l : list) : list

@[pattern]
def list.nil' (α : Type u) : list α := list.nil

def length {α : Type u} : list α → ℕ
| (list.nil' .(α)) := 0
| (list.cons a l) := 1 + length l

def cs {α : Type} (l : list α) := list.cons l

#check cs 3 (cs 4 (cs 5 list.nil))
#check [3, 4, 5]

end list_example

namespace nat_example

inductive nat
| zero
| succ (n : nat) : nat

constants (α : Sort)

#check nat
#check nat.rec -- ?M_1 nat.zero → (Π (n : nat), ?M_1 n → ?M_1 n.succ) → Π (n : nat), ?M_1 n
#check nat.rec _ _ -- Π (n : nat), ?M_1 n
#check nat.zero -- nat
#check nat.succ -- nat

#check nat.rec_on -- Π (n : nat), ?M_1 nat.zero → (Π (n : nat), ?M_1 n → ?M_1 n.succ) → ?M_1 n
#check nat.cases_on -- Π (n : nat), ?M_1 nat.zero → (Π (n : nat), ?M_1 n.succ) → ?M_1 n
#check nat.no_confusion_type -- Sort u_1 → nat → nat → Sort u_1
#check @nat.no_confusion -- Π {P : Sort u_1} {v1 v2 : nat}, v1 = v2 → nat.no_confusion_type P v1 v2
#check nat.brec_on -- Π (n : nat), (Π (n : nat), nat.below ?M_1 n → ?M_1 n) → ?M_1 n
#check nat.below -- (nat → Sort u_1) → nat → Sort (max 1 u_1)
#check nat.ibelow -- (nat → Prop) → nat → Prop
#check nat.sizeof -- nat → ℕ

end nat_example

namespace equation_compiler

open nat

def sub2 : ℕ → ℕ
| zero            := 0
| (succ zero)     := 0
| (succ (succ a)) := a

set_option trace.simplify.rewrite true

lemma helper : ∀ n k : nat, n < k.succ → n < k ∨ n = k
| 0 0 := begin -- example of backward proof
    have H : ∀ a : Prop, a → (true → a), {
      intro a,
      rw true_implies_iff a,
      sorry,
    },
    have zero_less_one : 0 < 1, sorry,
    simp only [zero_less_one],
    apply H, -- example of one step backward (changing goal)
    --   goal changed from
    --   ⊢ true → 0 < 0 ∨ 0 = 0 to
    --   ⊢ 0 < 0 ∨ 0 = 0     <<<<<<< move backward from (true → a) to (a)
    --   using ∀ a : Prop, a → (true → a)
    right,
    refl,
    -- simp,
    -- [eq_self_iff_true]: 0 = 0 ==> true
    -- [or_true]: 0 < 0 ∨ true ==> true
    -- [implies_true_iff]: 0 < 1 → true ==> true
  end
| n k := begin sorry, end

lemma helper₂ (n : ℕ) : ¬ n < 0 :=
match n with
| 0 :=
  begin
    have h : 0 < 0 → false, {
      sorry,
    },
    sorry,
  end
| (nat.succ n) := sorry
end

lemma property₁ : ∀ n : ℕ, n < 2 → sub2 n = 0 :=
begin
  intros n h,
  type_check helper n 1,
  have H_helper := helper n 1,
  have h_or : n < 1 ∨ n = 1 := H_helper h,
  clear H_helper h,
  cases h_or with n_lt_1 n_eq_1,
  { -- n < 1 => n < 0 ∨ n = 0
    type_check helper n 0 n_lt_1, -- n < 0 ∨ n = 0
    have h_or := helper n 0 n_lt_1,
    clear n_lt_1,
    cases h_or with n_lt_0 n_eq_0,
    { -- n < 0 => contradiction
      type_check lt.base 0,
      type_check lt.step (nat.lt.base 0),
      exfalso,
      have not_n_less_0 := helper₂ n,
      apply not_n_less_0,
      assumption, -- exact n_lt_0,
    },
    { -- n = 0
      rw n_eq_0,
      refl,
    },
  },
  { -- n = 1
    rw n_eq_1,
    refl,
  }
end

#print property₁

end equation_compiler


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/
import category_theory.limits.shapes.images
import category_theory.limits.constructions.epi_mono

/-!
# Preserving images

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

In this file, we show that if a functor preserves span and cospan, then it preserves images.
-/

noncomputable theory

namespace category_theory

namespace preserves_image

open category_theory
open category_theory.limits

universes u₁ u₂ v₁ v₂

variables {A : Type u₁} {B : Type u₂} [category.{v₁} A] [category.{v₂} B]
variables [has_equalizers A] [has_images A]
variables [strong_epi_category B] [has_images B]
variables (L : A ⥤ B)
variables [Π {X Y Z : A} (f : X ⟶ Z) (g : Y ⟶ Z), preserves_limit (cospan f g) L]
variables [Π {X Y Z : A} (f : X ⟶ Y) (g : X ⟶ Z), preserves_colimit (span f g) L]

/--
If a functor preserves span and cospan, then it preserves images.
-/
@[simps] def iso {X Y : A} (f : X ⟶ Y) : image (L.map f) ≅ L.obj (image f) :=
let aux1 : strong_epi_mono_factorisation (L.map f) :=
{ I := L.obj (limits.image f),
  m := L.map $ limits.image.ι _,
  m_mono := preserves_mono_of_preserves_limit _ _,
  e := L.map $ factor_thru_image _,
  e_strong_epi := @@strong_epi_of_epi _ _ _ $ preserves_epi_of_preserves_colimit L _,
  fac' := by rw [←L.map_comp, limits.image.fac] } in
is_image.iso_ext (image.is_image (L.map f)) aux1.to_mono_is_image

@[reassoc] lemma factor_thru_image_comp_hom {X Y : A} (f : X ⟶ Y) :
  factor_thru_image (L.map f) ≫ (iso L f).hom =
  L.map (factor_thru_image f) :=
by simp

@[reassoc] lemma hom_comp_map_image_ι {X Y : A} (f : X ⟶ Y) :
  (iso L f).hom ≫ L.map (image.ι f) = image.ι (L.map f) :=
by simp

@[reassoc] lemma inv_comp_image_ι_map {X Y : A} (f : X ⟶ Y) :
  (iso L f).inv ≫ image.ι (L.map f) = L.map (image.ι f) :=
by simp

end preserves_image

end category_theory


lemma mul_assoc (a b c : mynat) : (a * b) * c = a * (b * c) :=
begin
induction c with k Pk,
repeat { rw mul_zero },
repeat { rw mul_succ },
rw mul_add,
rw Pk,
refl,
end


import data.real.basic algebra.group_power algebra.group algebra.ring
open function

variable RH : Prop

local attribute [instance] classical.prop_decidable

noncomputable def f : ℝ → ℝ := λ x, if x = 0 then 0 else x⁻¹

theorem Q1002i : bijective f :=
begin
rw f,
unfold bijective,
unfold injective,
unfold surjective,
split,
sorry,
end

def f1 : ℤ → ℤ := λ n, 2*n + 1
theorem Q1002ii : injective f1 :=
begin
rw f1,
unfold injective,
simp,
intros,
apply (domain.mul_left_inj (show (2 : ℤ) ≠ 0, from sorry)).1,
assumption,
end

def f2 : ℝ → ℝ := λ x, x^3
theorem Q1002iii : bijective f2 :=
begin
rw f2,
unfold bijective,
unfold injective,
unfold surjective,
split,
intros,
have h : a₁^3 - a₂^3 = (a₁ - a₂)*(a₁^2 + a₁*a₂ + a₂^2), from sorry,
sorry,
end

noncomputable def f3 : ℝ → ℝ := if RH = tt then λ x, x^3 else λ x, -x
theorem Q1002iv (x : ℤ) (f4 : ℤ → ℤ) : bijective f3 :=
begin
unfold bijective,
unfold injective,
unfold surjective,
sorry
end

def f4 : ℤ → ℤ := λ n, n^3 - 2*n^2 + 2*n - 1
theorem Q1002v : injective f4 :=
begin
rw f4,
unfold injective,
simp,
sorry,
end


import linear_algebra.basic
import algebra.group.hom
import group_representation
universe variables u v w w'
open group
open linear_map
open linear_equiv
open submodule
open linear_map.general_linear_group

namespace irreductible_representation
variables {G : Type u} {R : Type v} {M : Type w} {M' : Type w'}
  [group G] [ring R] [add_comm_group M] [module R M] [add_comm_group M'] [module R M']

variables (ρ : group_representation G R M)
structure sub_rep (ρ : group_representation G R M) :=
(p : submodule R M)
(stability : ∀ g : G, ∀ x : p, ( ⟦ ρ ⟧  g) x ∈ p )
instance has_coe : has_coe(sub_rep ρ) (submodule R M) := ⟨ λ ρ', ρ'.p⟩
def is_trivial_sub_rep  (ρ : group_representation G R M) (ρ' : sub_rep ρ) :=  (ρ'.p = ⊤) ∨ (ρ'.p = ⊥)
def Irreductible (ρ : group_representation G R M) := ∀ (ρ' : sub_rep ρ), is_trivial_sub_rep  ρ ρ'
/-
     I don't know if it's ok theorem the hypothesis m≠ 0 stress me it's not a good condition (trivial ring problem)
-/
theorem lemme_de_Schur' (ρ : group_representation G R M)(ρ' :group_representation G R M')
[hyp : Irreductible ρ][hyp' : Irreductible ρ'] (f : ρ ⟶₁ ρ') (𝓁 : R)(m0 : M) (not_zero : f.linear_map m0 ≠ 0) :
group_representation.equiv ρ ρ'
:= { f := { to_fun := f.linear_map,
  add := f.linear_map.add,
  smul := f.linear_map.smul,
  inv_fun := sorry,
  left_inv := sorry,
  right_inv := sorry},
  commute := sorry, }

-- theorem lemme_de_Schur (ρ : group_representation G R M)(ρ' :group_representation G R M)
-- [hyp : Irreductible ρ][hyp' : Irreductible ρ'] (f : ρ ⟶₁ ρ') (𝓁 : R)(m0 : M)(m0 ≠ 0)
--  (spectral : f.linear_map m0 = 𝓁  • m0) :    ∀ m : M, f.linear_map m = 𝓁 • m :=
-- begin
--           -- we need lemma !
--           sorry,
-- end
end irreductible_representation


example (P Q : Type) : (P → Q) → ((Q → empty) → (P → empty)) :=
begin
intros f g p,
exact g(f(p)),
end


import analysis.analytic.basic
import hp.tactic.hp_interactive
import examples.analysis
universe u

namespace examples

variables {X Y: Type} [met_space X] [met_space Y] {A B : set X}

-- term-mode proof
example {A B : set X} : is_open A → is_open B → is_open (A ∪ B)
| oa ob y (or.inl h₁) := let ⟨ε, h₂, h₃⟩ := (oa y h₁) in ⟨ε, h₂, λ x h₄, or.inl $ h₃ x h₄⟩
| oa ob y (or.inr h₁) := let ⟨ε, h₂, h₃⟩ := (ob y h₁) in ⟨ε, h₂, λ x h₄, or.inr $ h₃ x h₄⟩

example {A B : set X} : is_open A → is_open B → is_open (A ∪ B) :=
begin
  assume A_open B_open,
  assume y : X,
  assume : y ∈ A ∪ B,
  cases ‹y ∈ A ∪ B›,
  { -- in the case that y ∈ A
    obtain ⟨ε, ε_pos, h_ε⟩ : ∃ ε, (ε > 0) ∧ ∀ x, dist x y < ε → x ∈ A,
      apply ‹is_open A›,
      apply ‹y ∈ A›,
    use [ε, ε_pos],
    assume x : X,
    assume : dist x y < ε,
    apply or.inl,
    finish,
  }, { -- in the case that y ∈ B
    obtain ⟨ε, ε_pos, h_ε⟩ : ∃ ε, (ε > 0) ∧ ∀ x, dist x y < ε → x ∈ B,
      apply ‹is_open B›,
      apply ‹y ∈ B›,
    use [ε, ε_pos],
    assume x : X,
    assume : dist x y < ε,
    apply or.inr,
    finish,
  }
end

-- humanproof writeup
example {A B : set X} : is_open A → is_open B → is_open (A ∪ B) :=
begin [hp]
  unroll,
  unroll at T₁,
  cases H₁,

  apply (@x_sub_x_union_y) at T₁,
  apply H at T₂,
  apply H₂ at T₃,
  apply H₃,

  apply (@y_sub_x_union_y) at T₁,

  apply H₀ at T₄,
  apply H₂ at T₅,
  apply H₄,

end

end examples


/-
Copyright (c) 2020 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Calle Sönne
-/

import topology.category.CompHaus.basic
import topology.connected
import topology.subset_properties
import topology.locally_constant.basic
import category_theory.adjunction.reflective
import category_theory.monad.limits
import category_theory.Fintype

/-!
# The category of Profinite Types

We construct the category of profinite topological spaces,
often called profinite sets -- perhaps they could be called
profinite types in Lean.

The type of profinite topological spaces is called `Profinite`. It has a category
instance and is a fully faithful subcategory of `Top`. The fully faithful functor
is called `Profinite_to_Top`.

## Implementation notes

A profinite type is defined to be a topological space which is
compact, Hausdorff and totally disconnected.

## TODO

0. Link to category of projective limits of finite discrete sets.
1. finite coproducts
2. Clausen/Scholze topology on the category `Profinite`.

## Tags

profinite

-/

universe u

open category_theory
open_locale topology

/-- The type of profinite topological spaces. -/
structure Profinite :=
(to_CompHaus : CompHaus)
[is_totally_disconnected : totally_disconnected_space to_CompHaus]

namespace Profinite

/--
Construct a term of `Profinite` from a type endowed with the structure of a
compact, Hausdorff and totally disconnected topological space.
-/
def of (X : Type*) [topological_space X] [compact_space X] [t2_space X]
  [totally_disconnected_space X] : Profinite := ⟨⟨⟨X⟩⟩⟩

instance : inhabited Profinite := ⟨Profinite.of pempty⟩

instance category : category Profinite := induced_category.category to_CompHaus
instance concrete_category : concrete_category Profinite := induced_category.concrete_category _
instance has_forget₂ : has_forget₂ Profinite Top := induced_category.has_forget₂ _

instance : has_coe_to_sort Profinite Type* := ⟨λ X, X.to_CompHaus⟩
instance {X : Profinite} : totally_disconnected_space X := X.is_totally_disconnected

-- We check that we automatically infer that Profinite sets are compact and Hausdorff.
example {X : Profinite} : compact_space X := infer_instance
example {X : Profinite} : t2_space X := infer_instance

@[simp]
lemma coe_to_CompHaus {X : Profinite} : (X.to_CompHaus : Type*) = X :=
rfl

@[simp] lemma coe_id (X : Profinite) : (𝟙 X : X → X) = id := rfl

@[simp] lemma coe_comp {X Y Z : Profinite} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g : X → Z) = g ∘ f := rfl

end Profinite

/-- The fully faithful embedding of `Profinite` in `CompHaus`. -/
@[simps, derive [full, faithful]]
def Profinite_to_CompHaus : Profinite ⥤ CompHaus := induced_functor _

/-- The fully faithful embedding of `Profinite` in `Top`. This is definitionally the same as the
obvious composite. -/
@[simps, derive [full, faithful]]
def Profinite.to_Top : Profinite ⥤ Top := forget₂ _ _

@[simp] lemma Profinite.to_CompHaus_to_Top :
  Profinite_to_CompHaus ⋙ CompHaus_to_Top = Profinite.to_Top :=
rfl

section Profinite

/--
(Implementation) The object part of the connected_components functor from compact Hausdorff spaces
to Profinite spaces, given by quotienting a space by its connected components.
See: https://stacks.math.columbia.edu/tag/0900
-/
-- Without explicit universe annotations here, Lean introduces two universe variables and
-- unhelpfully defines a function `CompHaus.{max u₁ u₂} → Profinite.{max u₁ u₂}`.
def CompHaus.to_Profinite_obj (X : CompHaus.{u}) : Profinite.{u} :=
{ to_CompHaus :=
  { to_Top := Top.of (connected_components X),
    is_compact := quotient.compact_space,
    is_hausdorff := connected_components.t2 },
  is_totally_disconnected := connected_components.totally_disconnected_space }

/--
(Implementation) The bijection of homsets to establish the reflective adjunction of Profinite
spaces in compact Hausdorff spaces.
-/
def Profinite.to_CompHaus_equivalence (X : CompHaus.{u}) (Y : Profinite.{u}) :
  (CompHaus.to_Profinite_obj X ⟶ Y) ≃ (X ⟶ Profinite_to_CompHaus.obj Y) :=
{ to_fun := λ f, f.comp ⟨quotient.mk', continuous_quotient_mk⟩,
  inv_fun := λ g,
    { to_fun := continuous.connected_components_lift g.2,
      continuous_to_fun := continuous.connected_components_lift_continuous g.2},
  left_inv := λ f, continuous_map.ext $ connected_components.surjective_coe.forall.2 $ λ a, rfl,
  right_inv := λ f, continuous_map.ext $ λ x, rfl }

/--
The connected_components functor from compact Hausdorff spaces to profinite spaces,
left adjoint to the inclusion functor.
-/
def CompHaus.to_Profinite : CompHaus ⥤ Profinite :=
adjunction.left_adjoint_of_equiv Profinite.to_CompHaus_equivalence (λ _ _ _ _ _, rfl)

lemma CompHaus.to_Profinite_obj' (X : CompHaus) :
  ↥(CompHaus.to_Profinite.obj X) = connected_components X := rfl

/-- Finite types are given the discrete topology. -/
def Fintype.bot_topology (A : Fintype) : topological_space A := ⊥

section discrete_topology

local attribute [instance] Fintype.bot_topology

local attribute [instance]
lemma Fintype.discrete_topology (A : Fintype) : discrete_topology A := ⟨rfl⟩

/-- The natural functor from `Fintype` to `Profinite`, endowing a finite type with the
discrete topology. -/
@[simps] def Fintype.to_Profinite : Fintype ⥤ Profinite :=
{ obj := λ A, Profinite.of A,
  map := λ _ _ f, ⟨f⟩ }

end discrete_topology

end Profinite

namespace Profinite

-- TODO the following construction of limits could be generalised
-- to allow diagrams in lower universes.

/-- An explicit limit cone for a functor `F : J ⥤ Profinite`, defined in terms of
`Top.limit_cone`. -/
def limit_cone {J : Type u} [small_category J] (F : J ⥤ Profinite.{u}) :
  limits.cone F :=
{ X :=
  { to_CompHaus := (CompHaus.limit_cone.{u u} (F ⋙ Profinite_to_CompHaus)).X,
    is_totally_disconnected :=
    begin
      change totally_disconnected_space ↥{u : Π (j : J), (F.obj j) | _},
      exact subtype.totally_disconnected_space,
    end },
  π := { app := (CompHaus.limit_cone.{u u} (F ⋙ Profinite_to_CompHaus)).π.app } }

/-- The limit cone `Profinite.limit_cone F` is indeed a limit cone. -/
def limit_cone_is_limit {J : Type u} [small_category J] (F : J ⥤ Profinite.{u}) :
  limits.is_limit (limit_cone F) :=
{ lift := λ S, (CompHaus.limit_cone_is_limit.{u u} (F ⋙ Profinite_to_CompHaus)).lift
    (Profinite_to_CompHaus.map_cone S),
  uniq' := λ S m h,
    (CompHaus.limit_cone_is_limit.{u u} _).uniq (Profinite_to_CompHaus.map_cone S) _ h }

/-- The adjunction between CompHaus.to_Profinite and Profinite.to_CompHaus -/
def to_Profinite_adj_to_CompHaus : CompHaus.to_Profinite ⊣ Profinite_to_CompHaus :=
adjunction.adjunction_of_equiv_left _ _

/-- The category of profinite sets is reflective in the category of compact hausdroff spaces -/
instance to_CompHaus.reflective : reflective Profinite_to_CompHaus :=
{ to_is_right_adjoint := ⟨CompHaus.to_Profinite, Profinite.to_Profinite_adj_to_CompHaus⟩ }

noncomputable
instance to_CompHaus.creates_limits : creates_limits Profinite_to_CompHaus :=
monadic_creates_limits _

noncomputable
instance to_Top.reflective : reflective Profinite.to_Top :=
reflective.comp Profinite_to_CompHaus CompHaus_to_Top

noncomputable
instance to_Top.creates_limits : creates_limits Profinite.to_Top :=
monadic_creates_limits _

instance has_limits : limits.has_limits Profinite :=
has_limits_of_has_limits_creates_limits Profinite.to_Top

instance has_colimits : limits.has_colimits Profinite :=
has_colimits_of_reflective Profinite_to_CompHaus

noncomputable
instance forget_preserves_limits : limits.preserves_limits (forget Profinite) :=
by apply limits.comp_preserves_limits Profinite.to_Top (forget Top)

variables {X Y : Profinite.{u}} (f : X ⟶ Y)

/-- Any morphism of profinite spaces is a closed map. -/
lemma is_closed_map : is_closed_map f :=
CompHaus.is_closed_map _

/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
lemma is_iso_of_bijective (bij : function.bijective f) : is_iso f :=
begin
  haveI := CompHaus.is_iso_of_bijective (Profinite_to_CompHaus.map f) bij,
  exact is_iso_of_fully_faithful Profinite_to_CompHaus _
end

/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
noncomputable def iso_of_bijective (bij : function.bijective f) : X ≅ Y :=
by letI := Profinite.is_iso_of_bijective f bij; exact as_iso f

instance forget_reflects_isomorphisms : reflects_isomorphisms (forget Profinite) :=
⟨by introsI A B f hf; exact Profinite.is_iso_of_bijective _ ((is_iso_iff_bijective f).mp hf)⟩

/-- Construct an isomorphism from a homeomorphism. -/
@[simps hom inv] def iso_of_homeo (f : X ≃ₜ Y) : X ≅ Y :=
{ hom := ⟨f, f.continuous⟩,
  inv := ⟨f.symm, f.symm.continuous⟩,
  hom_inv_id' := by { ext x, exact f.symm_apply_apply x },
  inv_hom_id' := by { ext x, exact f.apply_symm_apply x } }

/-- Construct a homeomorphism from an isomorphism. -/
@[simps] def homeo_of_iso (f : X ≅ Y) : X ≃ₜ Y :=
{ to_fun := f.hom,
  inv_fun := f.inv,
  left_inv := λ x, by { change (f.hom ≫ f.inv) x = x, rw [iso.hom_inv_id, coe_id, id.def] },
  right_inv := λ x, by { change (f.inv ≫ f.hom) x = x, rw [iso.inv_hom_id, coe_id, id.def] },
  continuous_to_fun := f.hom.continuous,
  continuous_inv_fun := f.inv.continuous }

/-- The equivalence between isomorphisms in `Profinite` and homeomorphisms
of topological spaces. -/
@[simps] def iso_equiv_homeo : (X ≅ Y) ≃ (X ≃ₜ Y) :=
{ to_fun := homeo_of_iso,
  inv_fun := iso_of_homeo,
  left_inv := λ f, by { ext, refl },
  right_inv := λ f, by { ext, refl } }

lemma epi_iff_surjective {X Y : Profinite.{u}} (f : X ⟶ Y) : epi f ↔ function.surjective f :=
begin
  split,
  { contrapose!,
    rintros ⟨y, hy⟩ hf, resetI,
    let C := set.range f,
    have hC : is_closed C := (is_compact_range f.continuous).is_closed,
    let U := Cᶜ,
    have hyU : y ∈ U,
    { refine set.mem_compl _, rintro ⟨y', hy'⟩, exact hy y' hy' },
    have hUy : U ∈ 𝓝 y := hC.compl_mem_nhds hyU,
    obtain ⟨V, hV, hyV, hVU⟩ := is_topological_basis_clopen.mem_nhds_iff.mp hUy,
    classical,
    let Z := of (ulift.{u} $ fin 2),
    let g : Y ⟶ Z := ⟨(locally_constant.of_clopen hV).map ulift.up, locally_constant.continuous _⟩,
    let h : Y ⟶ Z := ⟨λ _, ⟨1⟩, continuous_const⟩,
    have H : h = g,
    { rw ← cancel_epi f,
      ext x, dsimp [locally_constant.of_clopen],
      rw if_neg, { refl },
      refine mt (λ α, hVU α) _,
      simp only [set.mem_range_self, not_true, not_false_iff, set.mem_compl_iff], },
    apply_fun (λ e, (e y).down) at H,
    dsimp [locally_constant.of_clopen] at H,
    rw if_pos hyV at H,
    exact top_ne_bot H },
  { rw ← category_theory.epi_iff_surjective,
    apply (forget Profinite).epi_of_epi_map }
end

lemma mono_iff_injective {X Y : Profinite.{u}} (f : X ⟶ Y) : mono f ↔ function.injective f :=
begin
  split,
  { intro h,
    haveI : limits.preserves_limits Profinite_to_CompHaus := infer_instance,
    haveI : mono (Profinite_to_CompHaus.map f) := infer_instance,
    rwa ← CompHaus.mono_iff_injective },
  { rw ← category_theory.mono_iff_injective,
    apply (forget Profinite).mono_of_mono_map }
end

end Profinite


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.group_action.defs
import Mathlib.group_theory.group_action.group
import Mathlib.group_theory.coset
import Mathlib.PostPort

universes u v u_1 w

namespace Mathlib

/-!
# Basic properties of group actions
-/

namespace mul_action

/-- The orbit of an element under an action. -/
def orbit (α : Type u) {β : Type v} [monoid α] [mul_action α β] (b : β) : set β :=
  set.range fun (x : α) => x • b

theorem mem_orbit_iff {α : Type u} {β : Type v} [monoid α] [mul_action α β] {b₁ : β} {b₂ : β} :
    b₂ ∈ orbit α b₁ ↔ ∃ (x : α), x • b₁ = b₂ :=
  iff.rfl

@[simp] theorem mem_orbit {α : Type u} {β : Type v} [monoid α] [mul_action α β] (b : β) (x : α) :
    x • b ∈ orbit α b :=
  Exists.intro x rfl

@[simp] theorem mem_orbit_self {α : Type u} {β : Type v} [monoid α] [mul_action α β] (b : β) :
    b ∈ orbit α b :=
  sorry

/-- The stabilizer of an element under an action, i.e. what sends the element to itself. Note
that this is a set: for the group stabilizer see `stabilizer`. -/
def stabilizer_carrier (α : Type u) {β : Type v} [monoid α] [mul_action α β] (b : β) : set α :=
  set_of fun (x : α) => x • b = b

@[simp] theorem mem_stabilizer_iff {α : Type u} {β : Type v} [monoid α] [mul_action α β] {b : β}
    {x : α} : x ∈ stabilizer_carrier α b ↔ x • b = b :=
  iff.rfl

/-- The set of elements fixed under the whole action. -/
def fixed_points (α : Type u) (β : Type v) [monoid α] [mul_action α β] : set β :=
  set_of fun (b : β) => ∀ (x : α), x • b = b

/-- `fixed_by g` is the subfield of elements fixed by `g`. -/
def fixed_by (α : Type u) (β : Type v) [monoid α] [mul_action α β] (g : α) : set β :=
  set_of fun (x : β) => g • x = x

theorem fixed_eq_Inter_fixed_by (α : Type u) (β : Type v) [monoid α] [mul_action α β] :
    fixed_points α β = set.Inter fun (g : α) => fixed_by α β g :=
  sorry

@[simp] theorem mem_fixed_points {α : Type u} (β : Type v) [monoid α] [mul_action α β] {b : β} :
    b ∈ fixed_points α β ↔ ∀ (x : α), x • b = b :=
  iff.rfl

@[simp] theorem mem_fixed_by {α : Type u} (β : Type v) [monoid α] [mul_action α β] {g : α} {b : β} :
    b ∈ fixed_by α β g ↔ g • b = b :=
  iff.rfl

theorem mem_fixed_points' {α : Type u} (β : Type v) [monoid α] [mul_action α β] {b : β} :
    b ∈ fixed_points α β ↔ ∀ (b' : β), b' ∈ orbit α b → b' = b :=
  sorry

/-- The stabilizer of a point `b` as a submonoid of `α`. -/
def stabilizer.submonoid (α : Type u) {β : Type v} [monoid α] [mul_action α β] (b : β) :
    submonoid α :=
  submonoid.mk (stabilizer_carrier α b) (one_smul α b) sorry

end mul_action

namespace mul_action

/-- The stabilizer of an element under an action, i.e. what sends the element to itself.
A subgroup. -/
def stabilizer (α : Type u) {β : Type v} [group α] [mul_action α β] (b : β) : subgroup α :=
  subgroup.mk (submonoid.carrier sorry) sorry sorry sorry

theorem orbit_eq_iff {α : Type u} {β : Type v} [group α] [mul_action α β] {a : β} {b : β} :
    orbit α a = orbit α b ↔ a ∈ orbit α b :=
  sorry

/-- The stabilizer of a point `b` as a subgroup of `α`. -/
def stabilizer.subgroup (α : Type u) {β : Type v} [group α] [mul_action α β] (b : β) : subgroup α :=
  subgroup.mk (submonoid.carrier (stabilizer.submonoid α b)) sorry sorry sorry

@[simp] theorem mem_orbit_smul (α : Type u) {β : Type v} [group α] [mul_action α β] (g : α)
    (a : β) : a ∈ orbit α (g • a) :=
  sorry

@[simp] theorem smul_mem_orbit_smul (α : Type u) {β : Type v} [group α] [mul_action α β] (g : α)
    (h : α) (a : β) : g • a ∈ orbit α (h • a) :=
  sorry

/-- The relation "in the same orbit". -/
def orbit_rel (α : Type u) (β : Type v) [group α] [mul_action α β] : setoid β :=
  setoid.mk (fun (a b : β) => a ∈ orbit α b) sorry

/-- Action on left cosets. -/
def mul_left_cosets {α : Type u} [group α] (H : subgroup α) (x : α)
    (y : quotient_group.quotient H) : quotient_group.quotient H :=
  quotient.lift_on' y (fun (y : α) => quotient_group.mk (x * y)) sorry

protected instance quotient {α : Type u} [group α] (H : subgroup α) :
    mul_action α (quotient_group.quotient H) :=
  mk sorry sorry

@[simp] theorem quotient.smul_mk {α : Type u} [group α] (H : subgroup α) (a : α) (x : α) :
    a • quotient_group.mk x = quotient_group.mk (a * x) :=
  rfl

@[simp] theorem quotient.smul_coe {α : Type u_1} [comm_group α] (H : subgroup α) (a : α) (x : α) :
    a • ↑x = ↑(a * x) :=
  rfl

protected instance mul_left_cosets_comp_subtype_val {α : Type u} [group α] (H : subgroup α)
    (I : subgroup α) : mul_action (↥I) (quotient_group.quotient H) :=
  comp_hom (quotient_group.quotient H) (subgroup.subtype I)

/-- The canonical map from the quotient of the stabilizer to the set. -/
def of_quotient_stabilizer (α : Type u) {β : Type v} [group α] [mul_action α β] (x : β)
    (g : quotient_group.quotient (stabilizer α x)) : β :=
  quotient.lift_on' g (fun (_x : α) => _x • x) sorry

@[simp] theorem of_quotient_stabilizer_mk (α : Type u) {β : Type v} [group α] [mul_action α β]
    (x : β) (g : α) : of_quotient_stabilizer α x (quotient_group.mk g) = g • x :=
  rfl

theorem of_quotient_stabilizer_mem_orbit (α : Type u) {β : Type v} [group α] [mul_action α β]
    (x : β) (g : quotient_group.quotient (stabilizer α x)) :
    of_quotient_stabilizer α x g ∈ orbit α x :=
  quotient.induction_on' g fun (g : α) => Exists.intro g rfl

theorem of_quotient_stabilizer_smul (α : Type u) {β : Type v} [group α] [mul_action α β] (x : β)
    (g : α) (g' : quotient_group.quotient (stabilizer α x)) :
    of_quotient_stabilizer α x (g • g') = g • of_quotient_stabilizer α x g' :=
  quotient.induction_on' g' fun (_x : α) => mul_smul g _x x

theorem injective_of_quotient_stabilizer (α : Type u) {β : Type v} [group α] [mul_action α β]
    (x : β) : function.injective (of_quotient_stabilizer α x) :=
  sorry

/-- Orbit-stabilizer theorem. -/
def orbit_equiv_quotient_stabilizer (α : Type u) {β : Type v} [group α] [mul_action α β] (b : β) :
    ↥(orbit α b) ≃ quotient_group.quotient (stabilizer α b) :=
  equiv.symm
    (equiv.of_bijective
      (fun (g : quotient_group.quotient (stabilizer α b)) =>
        { val := of_quotient_stabilizer α b g, property := of_quotient_stabilizer_mem_orbit α b g })
      sorry)

@[simp] theorem orbit_equiv_quotient_stabilizer_symm_apply (α : Type u) {β : Type v} [group α]
    [mul_action α β] (b : β) (a : α) :
    ↑(coe_fn (equiv.symm (orbit_equiv_quotient_stabilizer α b)) ↑a) = a • b :=
  rfl

end mul_action

theorem list.smul_sum {α : Type u} {β : Type v} [monoid α] [add_monoid β] [distrib_mul_action α β]
    {r : α} {l : List β} : r • list.sum l = list.sum (list.map (has_scalar.smul r) l) :=
  add_monoid_hom.map_list_sum (const_smul_hom β r) l

theorem multiset.smul_sum {α : Type u} {β : Type v} [monoid α] [add_comm_monoid β]
    [distrib_mul_action α β] {r : α} {s : multiset β} :
    r • multiset.sum s = multiset.sum (multiset.map (has_scalar.smul r) s) :=
  add_monoid_hom.map_multiset_sum (const_smul_hom β r) s

theorem finset.smul_sum {α : Type u} {β : Type v} {γ : Type w} [monoid α] [add_comm_monoid β]
    [distrib_mul_action α β] {r : α} {f : γ → β} {s : finset γ} :
    (r • finset.sum s fun (x : γ) => f x) = finset.sum s fun (x : γ) => r • f x :=
  add_monoid_hom.map_sum (const_smul_hom β r) f s

end Mathlib


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

! This file was ported from Lean 3 source module data.holor
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Module.Pi
import Mathbin.Algebra.BigOperators.Basic

/-!
# Basic properties of holors

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

Holors are indexed collections of tensor coefficients. Confusingly,
they are often called tensors in physics and in the neural network
community.

A holor is simply a multidimensional array of values. The size of a
holor is specified by a `list ℕ`, whose length is called the dimension
of the holor.

The tensor product of `x₁ : holor α ds₁` and `x₂ : holor α ds₂` is the
holor given by `(x₁ ⊗ x₂) (i₁ ++ i₂) = x₁ i₁ * x₂ i₂`. A holor is "of
rank at most 1" if it is a tensor product of one-dimensional holors.
The CP rank of a holor `x` is the smallest N such that `x` is the sum
of N holors of rank at most 1.

Based on the tensor library found in <https://www.isa-afp.org/entries/Deep_Learning.html>

## References

* <https://en.wikipedia.org/wiki/Tensor_rank_decomposition>
-/

universe u

open List

open BigOperators

#print HolorIndex /-
/-- `holor_index ds` is the type of valid index tuples used to identify an entry of a holor
of dimensions `ds`. -/
def HolorIndex (ds : List ℕ) : Type :=
  { is : List ℕ // Forall₂ (· < ·) is ds }
#align holor_index HolorIndex
-/

namespace HolorIndex

variable {ds₁ ds₂ ds₃ : List ℕ}

#print HolorIndex.take /-
def take : ∀ {ds₁ : List ℕ}, HolorIndex (ds₁ ++ ds₂) → HolorIndex ds₁
  | ds, is => ⟨List.take (length ds) is.1, forall₂_take_append is.1 ds ds₂ is.2⟩
#align holor_index.take HolorIndex.take
-/

#print HolorIndex.drop /-
def drop : ∀ {ds₁ : List ℕ}, HolorIndex (ds₁ ++ ds₂) → HolorIndex ds₂
  | ds, is => ⟨List.drop (length ds) is.1, forall₂_drop_append is.1 ds ds₂ is.2⟩
#align holor_index.drop HolorIndex.drop
-/

#print HolorIndex.cast_type /-
theorem cast_type (is : List ℕ) (eq : ds₁ = ds₂) (h : Forall₂ (· < ·) is ds₁) :
    (cast (congr_arg HolorIndex Eq) ⟨is, h⟩).val = is := by subst Eq <;> rfl
#align holor_index.cast_type HolorIndex.cast_type
-/

#print HolorIndex.assocRight /-
def assocRight : HolorIndex (ds₁ ++ ds₂ ++ ds₃) → HolorIndex (ds₁ ++ (ds₂ ++ ds₃)) :=
  cast (congr_arg HolorIndex (append_assoc ds₁ ds₂ ds₃))
#align holor_index.assoc_right HolorIndex.assocRight
-/

#print HolorIndex.assocLeft /-
def assocLeft : HolorIndex (ds₁ ++ (ds₂ ++ ds₃)) → HolorIndex (ds₁ ++ ds₂ ++ ds₃) :=
  cast (congr_arg HolorIndex (append_assoc ds₁ ds₂ ds₃).symm)
#align holor_index.assoc_left HolorIndex.assocLeft
-/

#print HolorIndex.take_take /-
theorem take_take : ∀ t : HolorIndex (ds₁ ++ ds₂ ++ ds₃), t.assocRight.take = t.take.take
  | ⟨is, h⟩ =>
    Subtype.eq <| by
      simp [assoc_right, take, cast_type, List.take_take, Nat.le_add_right, min_eq_left]
#align holor_index.take_take HolorIndex.take_take
-/

#print HolorIndex.drop_take /-
theorem drop_take : ∀ t : HolorIndex (ds₁ ++ ds₂ ++ ds₃), t.assocRight.drop.take = t.take.drop
  | ⟨is, h⟩ => Subtype.eq (by simp [assoc_right, take, drop, cast_type, List.drop_take])
#align holor_index.drop_take HolorIndex.drop_take
-/

#print HolorIndex.drop_drop /-
theorem drop_drop : ∀ t : HolorIndex (ds₁ ++ ds₂ ++ ds₃), t.assocRight.drop.drop = t.drop
  | ⟨is, h⟩ => Subtype.eq (by simp [add_comm, assoc_right, drop, cast_type, List.drop_drop])
#align holor_index.drop_drop HolorIndex.drop_drop
-/

end HolorIndex

#print Holor /-
/-- Holor (indexed collections of tensor coefficients) -/
def Holor (α : Type u) (ds : List ℕ) :=
  HolorIndex ds → α
#align holor Holor
-/

namespace Holor

variable {α : Type} {d : ℕ} {ds : List ℕ} {ds₁ : List ℕ} {ds₂ : List ℕ} {ds₃ : List ℕ}

instance [Inhabited α] : Inhabited (Holor α ds) :=
  ⟨fun t => default⟩

instance [Zero α] : Zero (Holor α ds) :=
  ⟨fun t => 0⟩

instance [Add α] : Add (Holor α ds) :=
  ⟨fun x y t => x t + y t⟩

instance [Neg α] : Neg (Holor α ds) :=
  ⟨fun a t => -a t⟩

instance [AddSemigroup α] : AddSemigroup (Holor α ds) := by
  refine_struct { add := (· + ·).. } <;> pi_instance_derive_field

instance [AddCommSemigroup α] : AddCommSemigroup (Holor α ds) := by
  refine_struct { add := (· + ·).. } <;> pi_instance_derive_field

instance [AddMonoid α] : AddMonoid (Holor α ds) := by
  refine_struct
      { zero := (0 : Holor α ds)
        add := (· + ·)
        nsmul := fun n x i => n • x i } <;>
    pi_instance_derive_field

instance [AddCommMonoid α] : AddCommMonoid (Holor α ds) := by
  refine_struct
      { zero := (0 : Holor α ds)
        add := (· + ·)
        nsmul := AddMonoid.nsmul } <;>
    pi_instance_derive_field

instance [AddGroup α] : AddGroup (Holor α ds) := by
  refine_struct
      { zero := (0 : Holor α ds)
        add := (· + ·)
        nsmul := AddMonoid.nsmul
        zsmul := fun n x i => n • x i } <;>
    pi_instance_derive_field

instance [AddCommGroup α] : AddCommGroup (Holor α ds) := by
  refine_struct
      { zero := (0 : Holor α ds)
        add := (· + ·)
        nsmul := AddMonoid.nsmul
        zsmul := SubNegMonoid.zsmul } <;>
    pi_instance_derive_field

-- scalar product
instance [Mul α] : SMul α (Holor α ds) :=
  ⟨fun a x => fun t => a * x t⟩

instance [Semiring α] : Module α (Holor α ds) :=
  Pi.module _ _ _

#print Holor.mul /-
/-- The tensor product of two holors. -/
def mul [s : Mul α] (x : Holor α ds₁) (y : Holor α ds₂) : Holor α (ds₁ ++ ds₂) := fun t =>
  x t.take * y t.drop
#align holor.mul Holor.mul
-/

-- mathport name: «expr ⊗ »
local infixl:70 " ⊗ " => mul

#print Holor.cast_type /-
theorem cast_type (eq : ds₁ = ds₂) (a : Holor α ds₁) :
    cast (congr_arg (Holor α) Eq) a = fun t => a (cast (congr_arg HolorIndex Eq.symm) t) := by
  subst Eq <;> rfl
#align holor.cast_type Holor.cast_type
-/

#print Holor.assocRight /-
def assocRight : Holor α (ds₁ ++ ds₂ ++ ds₃) → Holor α (ds₁ ++ (ds₂ ++ ds₃)) :=
  cast (congr_arg (Holor α) (append_assoc ds₁ ds₂ ds₃))
#align holor.assoc_right Holor.assocRight
-/

#print Holor.assocLeft /-
def assocLeft : Holor α (ds₁ ++ (ds₂ ++ ds₃)) → Holor α (ds₁ ++ ds₂ ++ ds₃) :=
  cast (congr_arg (Holor α) (append_assoc ds₁ ds₂ ds₃).symm)
#align holor.assoc_left Holor.assocLeft
-/

/- warning: holor.mul_assoc0 -> Holor.mul_assoc0 is a dubious translation:
lean 3 declaration is
  forall {α : Type} {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} {ds₃ : List.{0} Nat} [_inst_1 : Semigroup.{0} α] (x : Holor.{0} α ds₁) (y : Holor.{0} α ds₂) (z : Holor.{0} α ds₃), Eq.{1} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂) ds₃)) (Holor.mul α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂) ds₃ (Semigroup.toHasMul.{0} α _inst_1) (Holor.mul α ds₁ ds₂ (Semigroup.toHasMul.{0} α _inst_1) x y) z) (Holor.assocLeft α ds₁ ds₂ ds₃ (Holor.mul α ds₁ (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₂ ds₃) (Semigroup.toHasMul.{0} α _inst_1) x (Holor.mul α ds₂ ds₃ (Semigroup.toHasMul.{0} α _inst_1) y z)))
but is expected to have type
  forall {α : Type} {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} {ds₃ : List.{0} Nat} [_inst_1 : Semigroup.{0} α] (x : Holor.{0} α ds₁) (y : Holor.{0} α ds₂) (z : Holor.{0} α ds₃), Eq.{1} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂) ds₃)) (Holor.mul α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂) ds₃ (Semigroup.toMul.{0} α _inst_1) (Holor.mul α ds₁ ds₂ (Semigroup.toMul.{0} α _inst_1) x y) z) (Holor.assocLeft α ds₁ ds₂ ds₃ (Holor.mul α ds₁ (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₂ ds₃) (Semigroup.toMul.{0} α _inst_1) x (Holor.mul α ds₂ ds₃ (Semigroup.toMul.{0} α _inst_1) y z)))
Case conversion may be inaccurate. Consider using '#align holor.mul_assoc0 Holor.mul_assoc0ₓ'. -/
theorem mul_assoc0 [Semigroup α] (x : Holor α ds₁) (y : Holor α ds₂) (z : Holor α ds₃) :
    x ⊗ y ⊗ z = (x ⊗ (y ⊗ z)).assocLeft :=
  funext fun t : HolorIndex (ds₁ ++ ds₂ ++ ds₃) =>
    by
    rw [assoc_left]
    unfold mul
    rw [mul_assoc]
    rw [← HolorIndex.take_take, ← HolorIndex.drop_take, ← HolorIndex.drop_drop]
    rw [cast_type]
    rfl
    rw [append_assoc]
#align holor.mul_assoc0 Holor.mul_assoc0

/- warning: holor.mul_assoc -> Holor.mul_assoc is a dubious translation:
lean 3 declaration is
  forall {α : Type} {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} {ds₃ : List.{0} Nat} [_inst_1 : Semigroup.{0} α] (x : Holor.{0} α ds₁) (y : Holor.{0} α ds₂) (z : Holor.{0} α ds₃), HEq.{1} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂) ds₃)) (Holor.mul α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂) ds₃ (Semigroup.toHasMul.{0} α _inst_1) (Holor.mul α ds₁ ds₂ (Semigroup.toHasMul.{0} α _inst_1) x y) z) (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₂ ds₃))) (Holor.mul α ds₁ (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₂ ds₃) (Semigroup.toHasMul.{0} α _inst_1) x (Holor.mul α ds₂ ds₃ (Semigroup.toHasMul.{0} α _inst_1) y z))
but is expected to have type
  forall {α : Type} {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} {ds₃ : List.{0} Nat} [_inst_1 : Semigroup.{0} α] (x : Holor.{0} α ds₁) (y : Holor.{0} α ds₂) (z : Holor.{0} α ds₃), HEq.{1} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂) ds₃)) (Holor.mul α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂) ds₃ (Semigroup.toMul.{0} α _inst_1) (Holor.mul α ds₁ ds₂ (Semigroup.toMul.{0} α _inst_1) x y) z) (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₂ ds₃))) (Holor.mul α ds₁ (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₂ ds₃) (Semigroup.toMul.{0} α _inst_1) x (Holor.mul α ds₂ ds₃ (Semigroup.toMul.{0} α _inst_1) y z))
Case conversion may be inaccurate. Consider using '#align holor.mul_assoc Holor.mul_assocₓ'. -/
theorem mul_assoc [Semigroup α] (x : Holor α ds₁) (y : Holor α ds₂) (z : Holor α ds₃) :
    HEq (mul (mul x y) z) (mul x (mul y z)) := by simp [cast_hEq, mul_assoc0, assoc_left]
#align holor.mul_assoc Holor.mul_assoc

/- warning: holor.mul_left_distrib -> Holor.mul_left_distrib is a dubious translation:
lean 3 declaration is
  forall {α : Type} {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} [_inst_1 : Distrib.{0} α] (x : Holor.{0} α ds₁) (y : Holor.{0} α ds₂) (z : Holor.{0} α ds₂), Eq.{1} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.mul α ds₁ ds₂ (Distrib.toHasMul.{0} α _inst_1) x (HAdd.hAdd.{0, 0, 0} (Holor.{0} α ds₂) (Holor.{0} α ds₂) (Holor.{0} α ds₂) (instHAdd.{0} (Holor.{0} α ds₂) (Holor.hasAdd α ds₂ (Distrib.toHasAdd.{0} α _inst_1))) y z)) (HAdd.hAdd.{0, 0, 0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (instHAdd.{0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.hasAdd α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂) (Distrib.toHasAdd.{0} α _inst_1))) (Holor.mul α ds₁ ds₂ (Distrib.toHasMul.{0} α _inst_1) x y) (Holor.mul α ds₁ ds₂ (Distrib.toHasMul.{0} α _inst_1) x z))
but is expected to have type
  forall {α : Type} {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} [_inst_1 : Distrib.{0} α] (x : Holor.{0} α ds₁) (y : Holor.{0} α ds₂) (z : Holor.{0} α ds₂), Eq.{1} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.mul α ds₁ ds₂ (Distrib.toMul.{0} α _inst_1) x (HAdd.hAdd.{0, 0, 0} (Holor.{0} α ds₂) (Holor.{0} α ds₂) (Holor.{0} α ds₂) (instHAdd.{0} (Holor.{0} α ds₂) (Holor.instAddHolor α ds₂ (Distrib.toAdd.{0} α _inst_1))) y z)) (HAdd.hAdd.{0, 0, 0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (instHAdd.{0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.instAddHolor α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂) (Distrib.toAdd.{0} α _inst_1))) (Holor.mul α ds₁ ds₂ (Distrib.toMul.{0} α _inst_1) x y) (Holor.mul α ds₁ ds₂ (Distrib.toMul.{0} α _inst_1) x z))
Case conversion may be inaccurate. Consider using '#align holor.mul_left_distrib Holor.mul_left_distribₓ'. -/
theorem mul_left_distrib [Distrib α] (x : Holor α ds₁) (y : Holor α ds₂) (z : Holor α ds₂) :
    x ⊗ (y + z) = x ⊗ y + x ⊗ z :=
  funext fun t =>
    left_distrib (x (HolorIndex.take t)) (y (HolorIndex.drop t)) (z (HolorIndex.drop t))
#align holor.mul_left_distrib Holor.mul_left_distrib

/- warning: holor.mul_right_distrib -> Holor.mul_right_distrib is a dubious translation:
lean 3 declaration is
  forall {α : Type} {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} [_inst_1 : Distrib.{0} α] (x : Holor.{0} α ds₁) (y : Holor.{0} α ds₁) (z : Holor.{0} α ds₂), Eq.{1} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.mul α ds₁ ds₂ (Distrib.toHasMul.{0} α _inst_1) (HAdd.hAdd.{0, 0, 0} (Holor.{0} α ds₁) (Holor.{0} α ds₁) (Holor.{0} α ds₁) (instHAdd.{0} (Holor.{0} α ds₁) (Holor.hasAdd α ds₁ (Distrib.toHasAdd.{0} α _inst_1))) x y) z) (HAdd.hAdd.{0, 0, 0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (instHAdd.{0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.hasAdd α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂) (Distrib.toHasAdd.{0} α _inst_1))) (Holor.mul α ds₁ ds₂ (Distrib.toHasMul.{0} α _inst_1) x z) (Holor.mul α ds₁ ds₂ (Distrib.toHasMul.{0} α _inst_1) y z))
but is expected to have type
  forall {α : Type} {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} [_inst_1 : Distrib.{0} α] (x : Holor.{0} α ds₁) (y : Holor.{0} α ds₁) (z : Holor.{0} α ds₂), Eq.{1} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.mul α ds₁ ds₂ (Distrib.toMul.{0} α _inst_1) (HAdd.hAdd.{0, 0, 0} (Holor.{0} α ds₁) (Holor.{0} α ds₁) (Holor.{0} α ds₁) (instHAdd.{0} (Holor.{0} α ds₁) (Holor.instAddHolor α ds₁ (Distrib.toAdd.{0} α _inst_1))) x y) z) (HAdd.hAdd.{0, 0, 0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (instHAdd.{0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.instAddHolor α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂) (Distrib.toAdd.{0} α _inst_1))) (Holor.mul α ds₁ ds₂ (Distrib.toMul.{0} α _inst_1) x z) (Holor.mul α ds₁ ds₂ (Distrib.toMul.{0} α _inst_1) y z))
Case conversion may be inaccurate. Consider using '#align holor.mul_right_distrib Holor.mul_right_distribₓ'. -/
theorem mul_right_distrib [Distrib α] (x : Holor α ds₁) (y : Holor α ds₁) (z : Holor α ds₂) :
    (x + y) ⊗ z = x ⊗ z + y ⊗ z :=
  funext fun t => add_mul (x (HolorIndex.take t)) (y (HolorIndex.take t)) (z (HolorIndex.drop t))
#align holor.mul_right_distrib Holor.mul_right_distrib

/- warning: holor.zero_mul -> Holor.zero_mul is a dubious translation:
lean 3 declaration is
  forall {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} {α : Type} [_inst_1 : Ring.{0} α] (x : Holor.{0} α ds₂), Eq.{1} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.mul α ds₁ ds₂ (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) (OfNat.ofNat.{0} (Holor.{0} α ds₁) 0 (OfNat.mk.{0} (Holor.{0} α ds₁) 0 (Zero.zero.{0} (Holor.{0} α ds₁) (Holor.hasZero α ds₁ (MulZeroClass.toHasZero.{0} α (NonUnitalNonAssocSemiring.toMulZeroClass.{0} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))))))))) x) (OfNat.ofNat.{0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) 0 (OfNat.mk.{0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) 0 (Zero.zero.{0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.hasZero α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂) (MulZeroClass.toHasZero.{0} α (NonUnitalNonAssocSemiring.toMulZeroClass.{0} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1)))))))))
but is expected to have type
  forall {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} {α : Type} [_inst_1 : Ring.{0} α] (x : Holor.{0} α ds₂), Eq.{1} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.mul α ds₁ ds₂ (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) (OfNat.ofNat.{0} (Holor.{0} α ds₁) 0 (Zero.toOfNat0.{0} (Holor.{0} α ds₁) (Holor.instZeroHolor α ds₁ (MonoidWithZero.toZero.{0} α (Semiring.toMonoidWithZero.{0} α (Ring.toSemiring.{0} α _inst_1)))))) x) (OfNat.ofNat.{0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) 0 (Zero.toOfNat0.{0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.instZeroHolor α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂) (MonoidWithZero.toZero.{0} α (Semiring.toMonoidWithZero.{0} α (Ring.toSemiring.{0} α _inst_1))))))
Case conversion may be inaccurate. Consider using '#align holor.zero_mul Holor.zero_mulₓ'. -/
@[simp]
theorem zero_mul {α : Type} [Ring α] (x : Holor α ds₂) : (0 : Holor α ds₁) ⊗ x = 0 :=
  funext fun t => MulZeroClass.zero_mul (x (HolorIndex.drop t))
#align holor.zero_mul Holor.zero_mul

/- warning: holor.mul_zero -> Holor.mul_zero is a dubious translation:
lean 3 declaration is
  forall {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} {α : Type} [_inst_1 : Ring.{0} α] (x : Holor.{0} α ds₁), Eq.{1} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.mul α ds₁ ds₂ (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) x (OfNat.ofNat.{0} (Holor.{0} α ds₂) 0 (OfNat.mk.{0} (Holor.{0} α ds₂) 0 (Zero.zero.{0} (Holor.{0} α ds₂) (Holor.hasZero α ds₂ (MulZeroClass.toHasZero.{0} α (NonUnitalNonAssocSemiring.toMulZeroClass.{0} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1)))))))))) (OfNat.ofNat.{0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) 0 (OfNat.mk.{0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) 0 (Zero.zero.{0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂)) (Holor.hasZero α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) ds₁ ds₂) (MulZeroClass.toHasZero.{0} α (NonUnitalNonAssocSemiring.toMulZeroClass.{0} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1)))))))))
but is expected to have type
  forall {ds₁ : List.{0} Nat} {ds₂ : List.{0} Nat} {α : Type} [_inst_1 : Ring.{0} α] (x : Holor.{0} α ds₁), Eq.{1} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.mul α ds₁ ds₂ (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) x (OfNat.ofNat.{0} (Holor.{0} α ds₂) 0 (Zero.toOfNat0.{0} (Holor.{0} α ds₂) (Holor.instZeroHolor α ds₂ (MonoidWithZero.toZero.{0} α (Semiring.toMonoidWithZero.{0} α (Ring.toSemiring.{0} α _inst_1))))))) (OfNat.ofNat.{0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) 0 (Zero.toOfNat0.{0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂)) (Holor.instZeroHolor α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) ds₁ ds₂) (MonoidWithZero.toZero.{0} α (Semiring.toMonoidWithZero.{0} α (Ring.toSemiring.{0} α _inst_1))))))
Case conversion may be inaccurate. Consider using '#align holor.mul_zero Holor.mul_zeroₓ'. -/
@[simp]
theorem mul_zero {α : Type} [Ring α] (x : Holor α ds₁) : x ⊗ (0 : Holor α ds₂) = 0 :=
  funext fun t => MulZeroClass.mul_zero (x (HolorIndex.take t))
#align holor.mul_zero Holor.mul_zero

/- warning: holor.mul_scalar_mul -> Holor.mul_scalar_mul is a dubious translation:
lean 3 declaration is
  forall {α : Type} {ds : List.{0} Nat} [_inst_1 : Monoid.{0} α] (x : Holor.{0} α (List.nil.{0} Nat)) (y : Holor.{0} α ds), Eq.{1} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (List.nil.{0} Nat) ds)) (Holor.mul α (List.nil.{0} Nat) ds (MulOneClass.toHasMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) x y) (SMul.smul.{0, 0} α (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (List.nil.{0} Nat) ds)) (Holor.hasSmul α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (List.nil.{0} Nat) ds) (MulOneClass.toHasMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1))) (x (Subtype.mk.{1} (List.{0} Nat) (fun (is : List.{0} Nat) => List.Forall₂.{0, 0} Nat Nat (LT.lt.{0} Nat Nat.hasLt) is (List.nil.{0} Nat)) (List.nil.{0} Nat) (List.Forall₂.nil.{0, 0} Nat Nat (LT.lt.{0} Nat Nat.hasLt)))) y)
but is expected to have type
  forall {α : Type} {ds : List.{0} Nat} [_inst_1 : Monoid.{0} α] (x : Holor.{0} α (List.nil.{0} Nat)) (y : Holor.{0} α ds), Eq.{1} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) (List.nil.{0} Nat) ds)) (Holor.mul α (List.nil.{0} Nat) ds (MulOneClass.toMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) x y) (HSMul.hSMul.{0, 0, 0} α (Holor.{0} α ds) (Holor.{0} α ds) (instHSMul.{0, 0} α (Holor.{0} α ds) (Holor.instSMulHolor α ds (MulOneClass.toMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)))) (x (Subtype.mk.{1} (List.{0} Nat) (fun (is : List.{0} Nat) => List.Forall₂.{0, 0} Nat Nat (fun (x._@.Mathlib.Data.Holor._hyg.27 : Nat) (x._@.Mathlib.Data.Holor._hyg.29 : Nat) => LT.lt.{0} Nat instLTNat x._@.Mathlib.Data.Holor._hyg.27 x._@.Mathlib.Data.Holor._hyg.29) is (List.nil.{0} Nat)) (List.nil.{0} Nat) (List.Forall₂.nil.{0, 0} Nat Nat (fun (x._@.Mathlib.Data.Holor._hyg.27 : Nat) (x._@.Mathlib.Data.Holor._hyg.29 : Nat) => LT.lt.{0} Nat instLTNat x._@.Mathlib.Data.Holor._hyg.27 x._@.Mathlib.Data.Holor._hyg.29)))) y)
Case conversion may be inaccurate. Consider using '#align holor.mul_scalar_mul Holor.mul_scalar_mulₓ'. -/
theorem mul_scalar_mul [Monoid α] (x : Holor α []) (y : Holor α ds) :
    x ⊗ y = x ⟨[], Forall₂.nil⟩ • y := by simp [mul, SMul.smul, HolorIndex.take, HolorIndex.drop]
#align holor.mul_scalar_mul Holor.mul_scalar_mul

#print Holor.slice /-
-- holor slices
/-- A slice is a subholor consisting of all entries with initial index i. -/
def slice (x : Holor α (d :: ds)) (i : ℕ) (h : i < d) : Holor α ds := fun is : HolorIndex ds =>
  x ⟨i :: is.1, Forall₂.cons h is.2⟩
#align holor.slice Holor.slice
-/

#print Holor.unitVec /-
/-- The 1-dimensional "unit" holor with 1 in the `j`th position. -/
def unitVec [Monoid α] [AddMonoid α] (d : ℕ) (j : ℕ) : Holor α [d] := fun ti =>
  if ti.1 = [j] then 1 else 0
#align holor.unit_vec Holor.unitVec
-/

#print Holor.holor_index_cons_decomp /-
theorem holor_index_cons_decomp (p : HolorIndex (d :: ds) → Prop) :
    ∀ t : HolorIndex (d :: ds),
      (∀ i is, ∀ h : t.1 = i :: is, p ⟨i :: is, by rw [← h]; exact t.2⟩) → p t
  | ⟨[], hforall₂⟩, hp => absurd (forall₂_nil_left_iff.1 hforall₂) (cons_ne_nil d ds)
  | ⟨i :: is, hforall₂⟩, hp => hp i is rfl
#align holor.holor_index_cons_decomp Holor.holor_index_cons_decomp
-/

#print Holor.slice_eq /-
/-- Two holors are equal if all their slices are equal. -/
theorem slice_eq (x : Holor α (d :: ds)) (y : Holor α (d :: ds)) (h : slice x = slice y) : x = y :=
  funext fun t : HolorIndex (d :: ds) =>
    holor_index_cons_decomp (fun t => x t = y t) t fun i is hiis =>
      have hiisdds : Forall₂ (· < ·) (i :: is) (d :: ds) := by rw [← hiis]; exact t.2
      have hid : i < d := (forall₂_cons.1 hiisdds).1
      have hisds : Forall₂ (· < ·) is ds := (forall₂_cons.1 hiisdds).2
      calc
        x ⟨i :: is, _⟩ = slice x i hid ⟨is, hisds⟩ := congr_arg (fun t => x t) (Subtype.eq rfl)
        _ = slice y i hid ⟨is, hisds⟩ := by rw [h]
        _ = y ⟨i :: is, _⟩ := congr_arg (fun t => y t) (Subtype.eq rfl)

#align holor.slice_eq Holor.slice_eq
-/

/- warning: holor.slice_unit_vec_mul -> Holor.slice_unit_vec_mul is a dubious translation:
lean 3 declaration is
  forall {α : Type} {d : Nat} {ds : List.{0} Nat} [_inst_1 : Ring.{0} α] {i : Nat} {j : Nat} (hid : LT.lt.{0} Nat Nat.hasLt i d) (x : Holor.{0} α ds), Eq.{1} (Holor.{0} α (List.append.{0} Nat (List.nil.{0} Nat) ds)) (Holor.slice α d (List.append.{0} Nat (List.nil.{0} Nat) ds) (Holor.mul α (List.cons.{0} Nat d (List.nil.{0} Nat)) ds (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) (Holor.unitVec α (Ring.toMonoid.{0} α _inst_1) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (AddCommGroupWithOne.toAddGroupWithOne.{0} α (Ring.toAddCommGroupWithOne.{0} α _inst_1)))) d j) x) i hid) (ite.{1} (Holor.{0} α (List.append.{0} Nat (List.nil.{0} Nat) ds)) (Eq.{1} Nat i j) (Nat.decidableEq i j) x (OfNat.ofNat.{0} (Holor.{0} α (List.append.{0} Nat (List.nil.{0} Nat) ds)) 0 (OfNat.mk.{0} (Holor.{0} α (List.append.{0} Nat (List.nil.{0} Nat) ds)) 0 (Zero.zero.{0} (Holor.{0} α (List.append.{0} Nat (List.nil.{0} Nat) ds)) (Holor.hasZero α (List.append.{0} Nat (List.nil.{0} Nat) ds) (MulZeroClass.toHasZero.{0} α (NonUnitalNonAssocSemiring.toMulZeroClass.{0} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))))))))))
but is expected to have type
  forall {α : Type} {d : Nat} {ds : List.{0} Nat} [_inst_1 : Ring.{0} α] {i : Nat} {j : Nat} (hid : LT.lt.{0} Nat instLTNat i d) (x : Holor.{0} α ds), Eq.{1} (Holor.{0} α (List.append.{0} Nat (List.nil.{0} Nat) ds)) (Holor.slice α d (List.append.{0} Nat (List.nil.{0} Nat) ds) (Holor.mul α (List.cons.{0} Nat d (List.nil.{0} Nat)) ds (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) (Holor.unitVec α (MonoidWithZero.toMonoid.{0} α (Semiring.toMonoidWithZero.{0} α (Ring.toSemiring.{0} α _inst_1))) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (Ring.toAddGroupWithOne.{0} α _inst_1))) d j) x) i hid) (ite.{1} (Holor.{0} α ds) (Eq.{1} Nat i j) (instDecidableEqNat i j) x (OfNat.ofNat.{0} (Holor.{0} α ds) 0 (Zero.toOfNat0.{0} (Holor.{0} α ds) (Holor.instZeroHolor α ds (MonoidWithZero.toZero.{0} α (Semiring.toMonoidWithZero.{0} α (Ring.toSemiring.{0} α _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align holor.slice_unit_vec_mul Holor.slice_unit_vec_mulₓ'. -/
theorem slice_unit_vec_mul [Ring α] {i : ℕ} {j : ℕ} (hid : i < d) (x : Holor α ds) :
    slice (unitVec d j ⊗ x) i hid = if i = j then x else 0 :=
  funext fun t : HolorIndex ds =>
    if h : i = j then by simp [slice, mul, HolorIndex.take, unit_vec, HolorIndex.drop, h]
    else by simp [slice, mul, HolorIndex.take, unit_vec, HolorIndex.drop, h] <;> rfl
#align holor.slice_unit_vec_mul Holor.slice_unit_vec_mul

#print Holor.slice_add /-
theorem slice_add [Add α] (i : ℕ) (hid : i < d) (x : Holor α (d :: ds)) (y : Holor α (d :: ds)) :
    slice x i hid + slice y i hid = slice (x + y) i hid :=
  funext fun t => by simp [slice, (· + ·)]
#align holor.slice_add Holor.slice_add
-/

#print Holor.slice_zero /-
theorem slice_zero [Zero α] (i : ℕ) (hid : i < d) : slice (0 : Holor α (d :: ds)) i hid = 0 :=
  rfl
#align holor.slice_zero Holor.slice_zero
-/

/- warning: holor.slice_sum -> Holor.slice_sum is a dubious translation:
lean 3 declaration is
  forall {α : Type} {d : Nat} {ds : List.{0} Nat} [_inst_1 : AddCommMonoid.{0} α] {β : Type} (i : Nat) (hid : LT.lt.{0} Nat Nat.hasLt i d) (s : Finset.{0} β) (f : β -> (Holor.{0} α (List.cons.{0} Nat d ds))), Eq.{1} (Holor.{0} α ds) (Finset.sum.{0, 0} (Holor.{0} α ds) β (Holor.addCommMonoid α ds _inst_1) s (fun (x : β) => Holor.slice α d ds (f x) i hid)) (Holor.slice α d ds (Finset.sum.{0, 0} (Holor.{0} α (List.cons.{0} Nat d ds)) β (Holor.addCommMonoid α (List.cons.{0} Nat d ds) _inst_1) s (fun (x : β) => f x)) i hid)
but is expected to have type
  forall {α : Type} {d : Nat} {ds : List.{0} Nat} [_inst_1 : AddCommMonoid.{0} α] {β : Type} (i : Nat) (hid : LT.lt.{0} Nat instLTNat i d) (s : Finset.{0} β) (f : β -> (Holor.{0} α (List.cons.{0} Nat d ds))), Eq.{1} (Holor.{0} α ds) (Finset.sum.{0, 0} (Holor.{0} α ds) β (Holor.instAddCommMonoidHolor α ds _inst_1) s (fun (x : β) => Holor.slice α d ds (f x) i hid)) (Holor.slice α d ds (Finset.sum.{0, 0} (Holor.{0} α (List.cons.{0} Nat d ds)) β (Holor.instAddCommMonoidHolor α (List.cons.{0} Nat d ds) _inst_1) s (fun (x : β) => f x)) i hid)
Case conversion may be inaccurate. Consider using '#align holor.slice_sum Holor.slice_sumₓ'. -/
theorem slice_sum [AddCommMonoid α] {β : Type} (i : ℕ) (hid : i < d) (s : Finset β)
    (f : β → Holor α (d :: ds)) : (∑ x in s, slice (f x) i hid) = slice (∑ x in s, f x) i hid :=
  by
  letI := Classical.decEq β
  refine' Finset.induction_on s _ _
  · simp [slice_zero]
  · intro _ _ h_not_in ih
    rw [Finset.sum_insert h_not_in, ih, slice_add, Finset.sum_insert h_not_in]
#align holor.slice_sum Holor.slice_sum

/- warning: holor.sum_unit_vec_mul_slice -> Holor.sum_unit_vec_mul_slice is a dubious translation:
lean 3 declaration is
  forall {α : Type} {d : Nat} {ds : List.{0} Nat} [_inst_1 : Ring.{0} α] (x : Holor.{0} α (List.cons.{0} Nat d ds)), Eq.{1} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (List.cons.{0} Nat d (List.nil.{0} Nat)) ds)) (Finset.sum.{0, 0} (Holor.{0} α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (List.cons.{0} Nat d (List.nil.{0} Nat)) ds)) (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) (Holor.addCommMonoid α (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (List.cons.{0} Nat d (List.nil.{0} Nat)) ds) (AddCommGroup.toAddCommMonoid.{0} α (NonUnitalNonAssocRing.toAddCommGroup.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))))) (Finset.attach.{0} Nat (Finset.range d)) (fun (i : Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) => Holor.mul α (List.cons.{0} Nat d (List.nil.{0} Nat)) ds (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) (Holor.unitVec α (Ring.toMonoid.{0} α _inst_1) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (AddCommGroupWithOne.toAddGroupWithOne.{0} α (Ring.toAddCommGroupWithOne.{0} α _inst_1)))) d ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (HasLiftT.mk.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (CoeTCₓ.coe.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeBase.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeSubtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d)))))) i)) (Holor.slice α d ds x ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (HasLiftT.mk.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (CoeTCₓ.coe.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeBase.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeSubtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d)))))) i) (Nat.succ_le_of_lt ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (HasLiftT.mk.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (CoeTCₓ.coe.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeBase.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeSubtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d)))))) i) d (Iff.mp (Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (HasLiftT.mk.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (CoeTCₓ.coe.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeBase.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeSubtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d)))))) i) (Finset.range d)) (LT.lt.{0} Nat Nat.hasLt ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (HasLiftT.mk.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (CoeTCₓ.coe.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeBase.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeSubtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d)))))) i) d) (Finset.mem_range d ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (HasLiftT.mk.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (CoeTCₓ.coe.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeBase.{1, 1} (Subtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d))) Nat (coeSubtype.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d)))))) i)) (Subtype.prop.{1} Nat (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range d)) i)))))) x
but is expected to have type
  forall {α : Type} {d : Nat} {ds : List.{0} Nat} [_inst_1 : Ring.{0} α] (x : Holor.{0} α (List.cons.{0} Nat d ds)), Eq.{1} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) (List.cons.{0} Nat d (List.nil.{0} Nat)) ds)) (Finset.sum.{0, 0} (Holor.{0} α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) (List.cons.{0} Nat d (List.nil.{0} Nat)) ds)) (Subtype.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d))) (Holor.instAddCommMonoidHolor α (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) (List.cons.{0} Nat d (List.nil.{0} Nat)) ds) (NonUnitalNonAssocSemiring.toAddCommMonoid.{0} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))))) (Finset.attach.{0} Nat (Finset.range d)) (fun (i : Subtype.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d))) => Holor.mul α (List.cons.{0} Nat d (List.nil.{0} Nat)) ds (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) (Holor.unitVec α (MonoidWithZero.toMonoid.{0} α (Semiring.toMonoidWithZero.{0} α (Ring.toSemiring.{0} α _inst_1))) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (Ring.toAddGroupWithOne.{0} α _inst_1))) d (Subtype.val.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d)) i)) (Holor.slice α d ds x (Subtype.val.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d)) i) (Nat.succ_le_of_lt (Subtype.val.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d)) i) d (Iff.mp (Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) (Subtype.val.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d)) i) (Finset.range d)) (LT.lt.{0} Nat instLTNat (Subtype.val.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d)) i) d) (Finset.mem_range d (Subtype.val.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d)) i)) (Subtype.prop.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range d)) i)))))) x
Case conversion may be inaccurate. Consider using '#align holor.sum_unit_vec_mul_slice Holor.sum_unit_vec_mul_sliceₓ'. -/
/-- The original holor can be recovered from its slices by multiplying with unit vectors and
summing up. -/
@[simp]
theorem sum_unit_vec_mul_slice [Ring α] (x : Holor α (d :: ds)) :
    (∑ i in (Finset.range d).attach,
        unitVec d i ⊗ slice x i (Nat.succ_le_of_lt (Finset.mem_range.1 i.Prop))) =
      x :=
  by
  apply slice_eq _ _ _
  ext (i hid)
  rw [← slice_sum]
  simp only [slice_unit_vec_mul hid]
  rw [Finset.sum_eq_single (Subtype.mk i <| Finset.mem_range.2 hid)]
  · simp
  · intro (b : { x // x ∈ Finset.range d })(hb : b ∈ (Finset.range d).attach)(hbi : b ≠ ⟨i, _⟩)
    have hbi' : i ≠ b := by simpa only [Ne.def, Subtype.ext_iff, Subtype.coe_mk] using hbi.symm
    simp [hbi']
  · intro (hid' : Subtype.mk i _ ∉ Finset.attach (Finset.range d))
    exfalso
    exact absurd (Finset.mem_attach _ _) hid'
#align holor.sum_unit_vec_mul_slice Holor.sum_unit_vec_mul_slice

#print Holor.CPRankMax1 /-
-- CP rank
/-- `cprank_max1 x` means `x` has CP rank at most 1, that is,
  it is the tensor product of 1-dimensional holors. -/
inductive CPRankMax1 [Mul α] : ∀ {ds}, Holor α ds → Prop
  | nil (x : Holor α []) : cprank_max1 x
  | cons {d} {ds} (x : Holor α [d]) (y : Holor α ds) : cprank_max1 y → cprank_max1 (x ⊗ y)
#align holor.cprank_max1 Holor.CPRankMax1
-/

#print Holor.CPRankMax /-
/-- `cprank_max N x` means `x` has CP rank at most `N`, that is,
  it can be written as the sum of N holors of rank at most 1. -/
inductive CPRankMax [Mul α] [AddMonoid α] : ℕ → ∀ {ds}, Holor α ds → Prop
  | zero {ds} : cprank_max 0 (0 : Holor α ds)
  |
  succ (n) {ds} (x : Holor α ds) (y : Holor α ds) :
    CPRankMax1 x → cprank_max n y → cprank_max (n + 1) (x + y)
#align holor.cprank_max Holor.CPRankMax
-/

/- warning: holor.cprank_max_nil -> Holor.cprankMax_nil is a dubious translation:
lean 3 declaration is
  forall {α : Type} [_inst_1 : Monoid.{0} α] [_inst_2 : AddMonoid.{0} α] (x : Holor.{0} α (List.nil.{0} Nat)), Holor.CPRankMax α (MulOneClass.toHasMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))) (List.nil.{0} Nat) x
but is expected to have type
  forall {α : Type} [_inst_1 : Monoid.{0} α] [_inst_2 : AddMonoid.{0} α] (x : Holor.{0} α (List.nil.{0} Nat)), Holor.CPRankMax α (MulOneClass.toMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)) (List.nil.{0} Nat) x
Case conversion may be inaccurate. Consider using '#align holor.cprank_max_nil Holor.cprankMax_nilₓ'. -/
theorem cprankMax_nil [Monoid α] [AddMonoid α] (x : Holor α nil) : CPRankMax 1 x :=
  by
  have h := CPRankMax.succ 0 x 0 (CPRankMax1.nil x) CPRankMax.zero
  rwa [add_zero x, zero_add] at h
#align holor.cprank_max_nil Holor.cprankMax_nil

/- warning: holor.cprank_max_1 -> Holor.cprankMax_1 is a dubious translation:
lean 3 declaration is
  forall {α : Type} {ds : List.{0} Nat} [_inst_1 : Monoid.{0} α] [_inst_2 : AddMonoid.{0} α] {x : Holor.{0} α ds}, (Holor.CPRankMax1 α (MulOneClass.toHasMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) ds x) -> (Holor.CPRankMax α (MulOneClass.toHasMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))) ds x)
but is expected to have type
  forall {α : Type} {ds : List.{0} Nat} [_inst_1 : Monoid.{0} α] [_inst_2 : AddMonoid.{0} α] {x : Holor.{0} α ds}, (Holor.CPRankMax1 α (MulOneClass.toMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) ds x) -> (Holor.CPRankMax α (MulOneClass.toMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)) ds x)
Case conversion may be inaccurate. Consider using '#align holor.cprank_max_1 Holor.cprankMax_1ₓ'. -/
theorem cprankMax_1 [Monoid α] [AddMonoid α] {x : Holor α ds} (h : CPRankMax1 x) : CPRankMax 1 x :=
  by
  have h' := CPRankMax.succ 0 x 0 h CPRankMax.zero
  rwa [zero_add, add_zero] at h'
#align holor.cprank_max_1 Holor.cprankMax_1

/- warning: holor.cprank_max_add -> Holor.cprankMax_add is a dubious translation:
lean 3 declaration is
  forall {α : Type} {ds : List.{0} Nat} [_inst_1 : Monoid.{0} α] [_inst_2 : AddMonoid.{0} α] {m : Nat} {n : Nat} {x : Holor.{0} α ds} {y : Holor.{0} α ds}, (Holor.CPRankMax α (MulOneClass.toHasMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 m ds x) -> (Holor.CPRankMax α (MulOneClass.toHasMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 n ds y) -> (Holor.CPRankMax α (MulOneClass.toHasMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) m n) ds (HAdd.hAdd.{0, 0, 0} (Holor.{0} α ds) (Holor.{0} α ds) (Holor.{0} α ds) (instHAdd.{0} (Holor.{0} α ds) (Holor.hasAdd α ds (AddZeroClass.toHasAdd.{0} α (AddMonoid.toAddZeroClass.{0} α _inst_2)))) x y))
but is expected to have type
  forall {α : Type} {ds : List.{0} Nat} [_inst_1 : Monoid.{0} α] [_inst_2 : AddMonoid.{0} α] {m : Nat} {n : Nat} {x : Holor.{0} α ds} {y : Holor.{0} α ds}, (Holor.CPRankMax α (MulOneClass.toMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 m ds x) -> (Holor.CPRankMax α (MulOneClass.toMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 n ds y) -> (Holor.CPRankMax α (MulOneClass.toMul.{0} α (Monoid.toMulOneClass.{0} α _inst_1)) _inst_2 (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) m n) ds (HAdd.hAdd.{0, 0, 0} (Holor.{0} α ds) (Holor.{0} α ds) (Holor.{0} α ds) (instHAdd.{0} (Holor.{0} α ds) (Holor.instAddHolor α ds (AddZeroClass.toAdd.{0} α (AddMonoid.toAddZeroClass.{0} α _inst_2)))) x y))
Case conversion may be inaccurate. Consider using '#align holor.cprank_max_add Holor.cprankMax_addₓ'. -/
theorem cprankMax_add [Monoid α] [AddMonoid α] :
    ∀ {m : ℕ} {n : ℕ} {x : Holor α ds} {y : Holor α ds},
      CPRankMax m x → CPRankMax n y → CPRankMax (m + n) (x + y)
  | 0, n, x, y, cprank_max.zero, hy => by simp [hy]
  | m + 1, n, _, y, cprank_max.succ k x₁ x₂ hx₁ hx₂, hy =>
    by
    simp only [add_comm, add_assoc]
    apply cprank_max.succ
    · assumption
    · exact cprank_max_add hx₂ hy
#align holor.cprank_max_add Holor.cprankMax_add

/- warning: holor.cprank_max_mul -> Holor.cprankMax_mul is a dubious translation:
lean 3 declaration is
  forall {α : Type} {d : Nat} {ds : List.{0} Nat} [_inst_1 : Ring.{0} α] (n : Nat) (x : Holor.{0} α (List.cons.{0} Nat d (List.nil.{0} Nat))) (y : Holor.{0} α ds), (Holor.CPRankMax α (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (AddCommGroupWithOne.toAddGroupWithOne.{0} α (Ring.toAddCommGroupWithOne.{0} α _inst_1)))) n ds y) -> (Holor.CPRankMax α (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (AddCommGroupWithOne.toAddGroupWithOne.{0} α (Ring.toAddCommGroupWithOne.{0} α _inst_1)))) n (Append.append.{0} (List.{0} Nat) (List.hasAppend.{0} Nat) (List.cons.{0} Nat d (List.nil.{0} Nat)) ds) (Holor.mul α (List.cons.{0} Nat d (List.nil.{0} Nat)) ds (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) x y))
but is expected to have type
  forall {α : Type} {d : Nat} {ds : List.{0} Nat} [_inst_1 : Ring.{0} α] (n : Nat) (x : Holor.{0} α (List.cons.{0} Nat d (List.nil.{0} Nat))) (y : Holor.{0} α ds), (Holor.CPRankMax α (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (Ring.toAddGroupWithOne.{0} α _inst_1))) n ds y) -> (Holor.CPRankMax α (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (Ring.toAddGroupWithOne.{0} α _inst_1))) n (HAppend.hAppend.{0, 0, 0} (List.{0} Nat) (List.{0} Nat) (List.{0} Nat) (instHAppend.{0} (List.{0} Nat) (List.instAppendList.{0} Nat)) (List.cons.{0} Nat d (List.nil.{0} Nat)) ds) (Holor.mul α (List.cons.{0} Nat d (List.nil.{0} Nat)) ds (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) x y))
Case conversion may be inaccurate. Consider using '#align holor.cprank_max_mul Holor.cprankMax_mulₓ'. -/
theorem cprankMax_mul [Ring α] :
    ∀ (n : ℕ) (x : Holor α [d]) (y : Holor α ds), CPRankMax n y → CPRankMax n (x ⊗ y)
  | 0, x, _, cprank_max.zero => by simp [MulZeroClass.mul_zero x, cprank_max.zero]
  | n + 1, x, _, cprank_max.succ k y₁ y₂ hy₁ hy₂ =>
    by
    rw [mul_left_distrib]
    rw [Nat.add_comm]
    apply cprank_max_add
    · exact cprank_max_1 (cprank_max1.cons _ _ hy₁)
    · exact cprank_max_mul k x y₂ hy₂
#align holor.cprank_max_mul Holor.cprankMax_mul

/- warning: holor.cprank_max_sum -> Holor.cprankMax_sum is a dubious translation:
lean 3 declaration is
  forall {α : Type} {ds : List.{0} Nat} [_inst_1 : Ring.{0} α] {β : Type.{u1}} {n : Nat} (s : Finset.{u1} β) (f : β -> (Holor.{0} α ds)), (forall (x : β), (Membership.Mem.{u1, u1} β (Finset.{u1} β) (Finset.hasMem.{u1} β) x s) -> (Holor.CPRankMax α (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (AddCommGroupWithOne.toAddGroupWithOne.{0} α (Ring.toAddCommGroupWithOne.{0} α _inst_1)))) n ds (f x))) -> (Holor.CPRankMax α (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (AddCommGroupWithOne.toAddGroupWithOne.{0} α (Ring.toAddCommGroupWithOne.{0} α _inst_1)))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (Finset.card.{u1} β s) n) ds (Finset.sum.{0, u1} (Holor.{0} α ds) β (Holor.addCommMonoid α ds (AddCommGroup.toAddCommMonoid.{0} α (NonUnitalNonAssocRing.toAddCommGroup.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))))) s (fun (x : β) => f x)))
but is expected to have type
  forall {α : Type} {ds : List.{0} Nat} [_inst_1 : Ring.{0} α] {β : Type.{u1}} {n : Nat} (s : Finset.{u1} β) (f : β -> (Holor.{0} α ds)), (forall (x : β), (Membership.mem.{u1, u1} β (Finset.{u1} β) (Finset.instMembershipFinset.{u1} β) x s) -> (Holor.CPRankMax α (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (Ring.toAddGroupWithOne.{0} α _inst_1))) n ds (f x))) -> (Holor.CPRankMax α (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (Ring.toAddGroupWithOne.{0} α _inst_1))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (Finset.card.{u1} β s) n) ds (Finset.sum.{0, u1} (Holor.{0} α ds) β (Holor.instAddCommMonoidHolor α ds (NonUnitalNonAssocSemiring.toAddCommMonoid.{0} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))))) s (fun (x : β) => f x)))
Case conversion may be inaccurate. Consider using '#align holor.cprank_max_sum Holor.cprankMax_sumₓ'. -/
theorem cprankMax_sum [Ring α] {β} {n : ℕ} (s : Finset β) (f : β → Holor α ds) :
    (∀ x ∈ s, CPRankMax n (f x)) → CPRankMax (s.card * n) (∑ x in s, f x) :=
  letI := Classical.decEq β
  Finset.induction_on s (by simp [cprank_max.zero])
    (by
      intro x s(h_x_notin_s : x ∉ s)ih h_cprank
      simp only [Finset.sum_insert h_x_notin_s, Finset.card_insert_of_not_mem h_x_notin_s]
      rw [Nat.right_distrib]
      simp only [Nat.one_mul, Nat.add_comm]
      have ih' : cprank_max (Finset.card s * n) (∑ x in s, f x) :=
        by
        apply ih
        intro (x : β)(h_x_in_s : x ∈ s)
        simp only [h_cprank, Finset.mem_insert_of_mem, h_x_in_s]
      exact cprank_max_add (h_cprank x (Finset.mem_insert_self x s)) ih')
#align holor.cprank_max_sum Holor.cprankMax_sum

/- warning: holor.cprank_max_upper_bound -> Holor.cprankMax_upper_bound is a dubious translation:
lean 3 declaration is
  forall {α : Type} [_inst_1 : Ring.{0} α] {ds : List.{0} Nat} (x : Holor.{0} α ds), Holor.CPRankMax α (Distrib.toHasMul.{0} α (Ring.toDistrib.{0} α _inst_1)) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (AddCommGroupWithOne.toAddGroupWithOne.{0} α (Ring.toAddCommGroupWithOne.{0} α _inst_1)))) (List.prod.{0} Nat Nat.hasMul Nat.hasOne ds) ds x
but is expected to have type
  forall {α : Type} [_inst_1 : Ring.{0} α] {ds : List.{0} Nat} (x : Holor.{0} α ds), Holor.CPRankMax α (NonUnitalNonAssocRing.toMul.{0} α (NonAssocRing.toNonUnitalNonAssocRing.{0} α (Ring.toNonAssocRing.{0} α _inst_1))) (AddMonoidWithOne.toAddMonoid.{0} α (AddGroupWithOne.toAddMonoidWithOne.{0} α (Ring.toAddGroupWithOne.{0} α _inst_1))) (List.prod.{0} Nat instMulNat (CanonicallyOrderedCommSemiring.toOne.{0} Nat Nat.canonicallyOrderedCommSemiring) ds) ds x
Case conversion may be inaccurate. Consider using '#align holor.cprank_max_upper_bound Holor.cprankMax_upper_boundₓ'. -/
theorem cprankMax_upper_bound [Ring α] : ∀ {ds}, ∀ x : Holor α ds, CPRankMax ds.Prod x
  | [], x => cprankMax_nil x
  | d :: ds, x =>
    by
    have h_summands :
      ∀ i : { x // x ∈ Finset.range d },
        CPRankMax ds.Prod (unitVec d i.1 ⊗ slice x i.1 (mem_range.1 i.2)) :=
      fun i => cprankMax_mul _ _ _ (cprank_max_upper_bound (slice x i.1 (mem_range.1 i.2)))
    have h_dds_prod : (List.cons d ds).Prod = Finset.card (Finset.range d) * Prod ds := by
      simp [Finset.card_range]
    have :
      CPRankMax (Finset.card (Finset.attach (Finset.range d)) * Prod ds)
        (∑ i in Finset.attach (Finset.range d),
          unitVec d i.val ⊗ slice x i.val (mem_range.1 i.2)) :=
      cprankMax_sum (Finset.range d).attach _ fun i _ => h_summands i
    have h_cprank_max_sum :
      CPRankMax (Finset.card (Finset.range d) * Prod ds)
        (∑ i in Finset.attach (Finset.range d),
          unitVec d i.val ⊗ slice x i.val (mem_range.1 i.2)) :=
      by rwa [Finset.card_attach] at this
    rw [← sum_unit_vec_mul_slice x]
    rw [h_dds_prod]
    exact h_cprank_max_sum
#align holor.cprank_max_upper_bound Holor.cprankMax_upper_bound

#print Holor.cprank /-
/-- The CP rank of a holor `x`: the smallest N such that
  `x` can be written as the sum of N holors of rank at most 1. -/
noncomputable def cprank [Ring α] (x : Holor α ds) : Nat :=
  @Nat.find (fun n => CPRankMax n x) (Classical.decPred _) ⟨ds.Prod, cprankMax_upper_bound x⟩
#align holor.cprank Holor.cprank
-/

#print Holor.cprank_upper_bound /-
theorem cprank_upper_bound [Ring α] : ∀ {ds}, ∀ x : Holor α ds, cprank x ≤ ds.Prod :=
  fun ds (x : Holor α ds) =>
  letI := Classical.decPred fun n : ℕ => cprank_max n x
  Nat.find_min' ⟨ds.prod, show (fun n => cprank_max n x) ds.prod from cprank_max_upper_bound x⟩
    (cprank_max_upper_bound x)
#align holor.cprank_upper_bound Holor.cprank_upper_bound
-/

end Holor


import .transition.transition

open mcrl2

variable {α : Type}
variable [comm_semigroup_with_zero α]

/- Defining the notion of bisimulation for mcrl2 processes. -/
def is_bisimulation (R : mcrl2 α → mcrl2 α → Prop) : Prop :=
(∀x y : mcrl2 α, (∀x' a, R x y → transition x a x' → ∃y', transition y a y' ∧ option.rel R x' y')) ∧ symmetric R

#print is_bisimulation
def bisim (α : Type) [comm_semigroup_with_zero α] : mcrl2 α → mcrl2 α → Prop
| x y := ∃R : mcrl2 α → mcrl2 α → Prop, (R x y) ∧ is_bisimulation R

/- Helper lemmas for proofs. -/
lemma option.rel.mono {R₁ R₂ : mcrl2 α → mcrl2 α → Prop}
(h : ∀{x y}, R₁ x y → R₂ x y) :
∀{x y}, option.rel R₁ x y → option.rel R₂ x y
| none none (option.rel.none) := by exact option.rel.none
| (some x) (some y) (option.rel.some R₁) :=
begin
  apply option.rel.some,
  apply h,
  assumption
end

lemma option.rel.refl {x₁ : option (mcrl2 α)} {R : mcrl2 α → mcrl2 α → Prop}
(h: ∀x, R x x) :
option.rel R x₁ x₁ :=
begin
  cases x₁,
  { exact option.rel.none},
  { apply option.rel.some,
    exact h x₁}
end

lemma bisim_lift_none {x y : mcrl2 α} {a : α} {R : mcrl2 α → mcrl2 α → Prop}
: is_bisimulation R → R x y → transition x a none -> transition y a none :=
begin
  intros h₁ h₂ h₃,
  cases h₁,
  specialize h₁_left x y none a h₂ h₃,
  cases h₁_left with w w_h,
  cases w_h with l r,
  cases w,
  { assumption},
  { cases r}
end

lemma bisim_lift {x y : mcrl2 α} {a : α} {x' : option (mcrl2 α)} {R : mcrl2 α → mcrl2 α → Prop}
: is_bisimulation R → R x y → transition x a x' -> ∃ y', transition y a y' ∧ option.rel R x' y' :=
begin
  intros h₁ h₂ h₃,
  cases h₁,
  specialize h₁_left x y x' a h₂ h₃,
  cases h₁_left with w h_w,
  apply exists.intro w,
  exact h_w
end

lemma bisim_symm_lift {x y a y'} {R : mcrl2 α → mcrl2 α → Prop} :
is_bisimulation R → R x y → transition y a y' → ∃ x', transition x a x' ∧ option.rel R y' x':=
begin
  intros R_bisim hRxy h,
  cases R_bisim with R_bisim R_symm,
  have hRyx: R y x, by apply R_symm; assumption,
  exact bisim_lift (and.intro R_bisim R_symm) hRyx h
end

lemma bisim_exists_lift {y a x'} {R R' : mcrl2 α → mcrl2 α → Prop}
(hR : ∀{x y}, R x y → R' x y) :
(∃y', transition y a y' ∧ option.rel R x' y') → (∃y', transition y a y' ∧ option.rel R' x' y') :=
begin
  intro h,
  apply Exists.imp _ h,
  intro y',
  rintro ⟨yay', Rx'y'⟩,
  apply and.intro,
  assumption,
  apply option.rel.mono @hR,
  assumption
end

/- Proving that bisimilarity is an equivalence relation. -/
theorem bisim_reflexive : reflexive (bisim α) :=
begin
  intro x,
  apply exists.intro (λa b, a = b),
  apply and.intro,
  { simp},
  { apply and.intro,
    { intros x' y,
      intros y' a h₁ h₂,
      apply exists.intro y',
      apply and.intro,
      { rw ←h₁,
        assumption},
      { simp,
        cases y',
        { exact option.rel.none},
        { apply option.rel.some,
          refl}}},
    { intros x' y' h,
      apply eq.symm,
      assumption}}
end

theorem bisim_symmetric : symmetric (bisim α) :=
begin
  intros x y h,
  cases h with R h,
  cases h with rxy r_bisim,
  cases r_bisim with r_bisim r_symm,
  apply exists.intro R,
  apply and.intro,
  { exact r_symm rxy},
  { exact and.intro r_bisim r_symm}
end

/- Proving transitivity via the symmetric composition of relations-/
inductive R_comp {α : Type 1} (R₁ R₂ : α → α → Prop) :
α → α → Prop
| stepl {a b} (h : ∃c, R₁ a c ∧ R₂ c b) : R_comp a b
| stepr {a b} (h : ∃c, R₁ a c ∧ R₂ c b) : R_comp b a

lemma comp_symmetric {R R' : mcrl2 α → mcrl2 α → Prop} :
symmetric (R_comp R R') :=
begin
  intros x y h,
  cases h,
  { exact R_comp.stepr h_h},
  { exact R_comp.stepl h_h}
end

lemma comp_bisim {R R' : mcrl2 α → mcrl2 α → Prop}
(hr : is_bisimulation R) (hr' : is_bisimulation R') :
is_bisimulation (R_comp R R') :=
begin
  apply and.intro,
  { intros x y x' a l r,
    cases l,
    { cases l_h with w h,
      cases h with Rx R'y,
      have h₁: ∃y', transition w a y' ∧ option.rel R x' y',
      by exact bisim_lift hr Rx r,
      cases h₁ with w' w'_h,
      cases w'_h with wa Rw',
      have h₁: ∃y', transition y a y' ∧ option.rel R' w' y',
      by exact bisim_lift hr' R'y wa,
      cases h₁ with y' h_y',
      cases h_y' with ya R'w',
      apply exists.intro y',
      apply and.intro,
      { assumption},
      { cases Rw',
        { cases R'w',
          apply option.rel.some,
          cases Rw',
          cases R'w',
          apply R_comp.stepl,
          apply exists.intro Rw'_b,
          apply and.intro,
          repeat {assumption}},
        { cases R'w',
          exact option.rel.none}}},
    { cases l_h with w h,
      cases h with Ry R'x,
      have Ry' : R w y, by exact hr.right Ry,
      have R'x' : R' x w, by exact hr'.right R'x,
      have h₁: ∃y', transition w a y' ∧ option.rel R' x' y',
      by exact bisim_lift hr' R'x' r,
      cases h₁ with w' w'_h,
      cases w'_h with wa Rw',
      have h₁: ∃y', transition y a y' ∧ option.rel R w' y',
      by exact bisim_lift hr Ry' wa,
      cases h₁ with y' h_y',
      cases h_y' with ya R'w',
      apply exists.intro y',
      apply and.intro,
      { assumption},
      { cases Rw',
          { cases R'w',
            apply option.rel.some,
            apply R_comp.stepr,
            cases Rw',
            cases R'w',
            apply exists.intro Rw'_b,
            apply and.intro,
            { apply hr.right, assumption},
            { apply hr'.right, assumption}
            },
          { cases R'w',
            exact option.rel.none}}}},
  { exact comp_symmetric}
end

theorem bisim_transitive : transitive (bisim α) :=
begin
  intros x y z h₁ h₂,
  cases h₁ with R,
  cases h₁_h with Rxy R_bisim,
  cases h₂ with R',
  cases h₂_h with R'yz R'_bisim,
  apply exists.intro (R_comp R R'),
  apply and.intro,
  { apply R_comp.stepl,
    apply exists.intro y,
    apply and.intro,
    repeat {assumption}},
  { apply comp_bisim R_bisim R'_bisim}
end

/- Defining the quotient of mcrl2'-/
@[instance] def setoid_mcrl2 : setoid (mcrl2 α) :=
{r     := bisim α,
 iseqv :=
  begin
    repeat {apply and.intro},
    { apply bisim_reflexive},
    { apply bisim_symmetric},
    { apply bisim_transitive}
  end
}

lemma setoid_iff (a b : mcrl2 α) :
a ≈ b ↔ bisim α a b :=
by refl

def mcrl2' (α : Type) [comm_semigroup_with_zero α] := quotient (@setoid_mcrl2 α _)