import tactic.linear_combination
import data.real.basic

/-! ### Simple Cases with ℤ and two or less equations -/

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by linear_combination (h1, 1)

example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
  2*x + 4 = -6 :=
by linear_combination (h1, 2)

example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by linear_combination (h1, 1) (h2, -2)

example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
  2*x + 4 - y = -16 :=
by linear_combination (h1, 2) (h2, -1)

example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by linear_combination (h2, -1) (h1, 2)

example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  11*y = -11 :=
by linear_combination (h1, -2) (h2, 3)

example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y = 11 :=
by linear_combination (h1, 2) (h2, -3)

example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y = 11 + 1 - 1 :=
by linear_combination (h1, 2) (h2, -3)

example (x y : ℤ) (h1 : 10 = 3*x + 2*y) (h2 : 3 = 2*x + 5*y) :
  11 + 1 - 1 = -11*y :=
by linear_combination (h1, 2) (h2, -3)

/-! ### More complicated cases with two equations -/

example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by linear_combination (h1, 2) (h2, -1)

example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y + 1 = 11 + 1 :=
by linear_combination (h1, 2) (h2, -3)

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
  b = 2 / 3 :=
by linear_combination (ha, 1/6) (hab, 1/3)

/-! ### Cases with more than 2 equations -/

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
  b = 2 / 3 :=
by linear_combination (ha, 1/6) (hab, 1/3) (hignore, 0)

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  -3*x - 3*y - 4*z = 2 :=
by linear_combination (ha, 1) (hb, -1) (hc, -2)

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  6*x = -10 :=
by linear_combination (ha, 1) (hb, 4) (hc, -3)

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  10 = 6*-x :=
by linear_combination (ha, 1) (hb, 4) (hc, -3)

example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
    (h3 : x + y + 5*z + 5*w = 3) :
  x + 2.2*y + 2*z - 5*w = -8.5 :=
by linear_combination (h1, 2) (h2, 1) (h3, -2)

example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
by linear_combination (h1, 2) (h2, -1) (h3, 3) (h4, -3)

example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
  6 - 3*c + 3*a + 3*d = 2*b - d + 12 - 3*a :=
by linear_combination (h2, 2) (h3, -1) (h1, 3) (h4, -3)

/-! ### Cases with arbitrary coefficients -/

example (a b : ℤ) (h : a = b) :
  a * a = a * b :=
by linear_combination (h, a)

example (a b c : ℤ) (h : a = b) :
  a * c = b * c :=
by linear_combination (h, c)

example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
  c * a + b = c * b + 1 :=
by linear_combination (h1, c) (h2, 1)

example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
by linear_combination (h1, x*y) (h2, 2)

example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
  c * (a*f - b*e) = 0 :=
by linear_combination (h1, e) (h2, a)

/-! ### Cases that explicitly use a linear_combination_config -/

example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y + 1 = 11 + 1 :=
by linear_combination (h1, 2) (h2, -3) {normalization_tactic := `[ring]}

example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y + 1 = 11 + 1 :=
by linear_combination (h1, 2) (h2, -3) {normalization_tactic := `[ring1]}

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
  b = 2 / 3 :=
by linear_combination (ha, 1/6) (hab, 1/3) {normalization_tactic := `[ring_nf]}

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by linear_combination (h1, 1) {normalization_tactic := `[simp]}

/-! ### Cases that have linear_combination skip normalization -/

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
  b = 2 / 3 :=
begin
  linear_combination (ha, 1/6) (hab, 1/3) {normalize := ff},
  linarith
end

example (x y : ℤ) (h1 : x = -3) (h2 : y = 10) :
  2*x = -6 :=
begin
  linear_combination (h1, 2) {normalize := ff},
  simp,
  norm_cast
end

/-! ### Cases that should fail -/

-- This should fail because there are no hypotheses given
example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
begin
  success_if_fail {linear_combination},
  linear_combination (h1, 1) (h2, -2)
end

-- This should fail because the second coefficient has a different type than
--   the equations it is being combined with.  This was a design choice for the
--   sake of simplicity, but the tactic could potentially be modified to allow
--   this behavior.
example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y + 2*x = 1 :=
begin
  success_if_fail {linear_combination (h1, 1) (h2, (0 : ℝ))},
  linear_combination (h1, 1)
end

-- This should fail because the second coefficient has a different type than
--   the equations it is being combined with.  This was a design choice for the
--   sake of simplicity, but the tactic could potentially be modified to allow
--   this behavior.
example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y + 2*x = 1 :=
begin
  success_if_fail {linear_combination (h1, 1) (h2, (0 : ℕ))},
  linear_combination (h1, 1)
end

-- This should fail because the coefficients are incorrect.  They should instead
--   be -2 and 3, respectively.
example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  11*y = -11 :=
begin
  success_if_fail {linear_combination (h1, 2) (h2, -3)},
  linear_combination (h1, -2) (h2, 3)
end

-- This fails because the linear_combination tactic requires the equations
--   and coefficients to use a type that fulfills the add_group condition,
--   and ℕ does not.
example (a b : ℕ) (h1 : a = 3) :
  a = 3 :=
begin
  success_if_fail {linear_combination (h1, (1 : ℕ))},
  exact h1
end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_119
  (d e : ℝ)
  (h₀ : 2 * d = 17 * e - 8)
  (h₁ : 2 * e = d - 9) :
  e = 2 :=
begin
  linarith,
end


/-
Copyright (c) 2020 Thomas Browning, Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning, Patrick Lutz
-/

import field_theory.adjoin
import field_theory.is_alg_closed.basic
import field_theory.separable
import ring_theory.integral_domain

/-!
# Primitive Element Theorem

In this file we prove the primitive element theorem.

## Main results

- `exists_primitive_element`: a finite separable extension `E / F` has a primitive element, i.e.
  there is an `α : E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.

## Implementation notes

In declaration names, `primitive_element` abbreviates `adjoin_simple_eq_top`:
it stands for the statement `F⟮α⟯ = (⊤ : subalgebra F E)`. We did not add an extra
declaration `is_primitive_element F α := F⟮α⟯ = (⊤ : subalgebra F E)` because this
requires more unfolding without much obvious benefit.

## Tags

primitive element, separable field extension, separable extension, intermediate field, adjoin,
exists_adjoin_simple_eq_top

-/

noncomputable theory
open_locale classical polynomial

open finite_dimensional polynomial intermediate_field

namespace field

section primitive_element_finite
variables (F : Type*) [field F] (E : Type*) [field E] [algebra F E]

/-! ### Primitive element theorem for finite fields -/

/-- **Primitive element theorem** assuming E is finite. -/
lemma exists_primitive_element_of_fintype_top [fintype E] : ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  obtain ⟨α, hα⟩ := is_cyclic.exists_generator (units E),
  use α,
  apply eq_top_iff.mpr,
  rintros x -,
  by_cases hx : x = 0,
  { rw hx,
    exact F⟮α.val⟯.zero_mem },
  { obtain ⟨n, hn⟩ := set.mem_range.mp (hα (units.mk0 x hx)),
    rw (show x = α^n, by { norm_cast, rw [hn, units.coe_mk0] }),
    exact zpow_mem (mem_adjoin_simple_self F ↑α) n, },
end

/-- Primitive element theorem for finite dimensional extension of a finite field. -/
theorem exists_primitive_element_of_fintype_bot [fintype F] [finite_dimensional F E] :
  ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  haveI : fintype E := fintype_of_fintype F E,
  exact exists_primitive_element_of_fintype_top F E,
end

end primitive_element_finite

/-! ### Primitive element theorem for infinite fields -/

section primitive_element_inf

variables {F : Type*} [field F] [infinite F] {E : Type*} [field E] (ϕ : F →+* E) (α β : E)

lemma primitive_element_inf_aux_exists_c (f g : F[X]) :
  ∃ c : F, ∀ (α' ∈ (f.map ϕ).roots) (β' ∈ (g.map ϕ).roots), -(α' - α)/(β' - β) ≠ ϕ c :=
begin
  let sf := (f.map ϕ).roots,
  let sg := (g.map ϕ).roots,
  let s := (sf.bind (λ α', sg.map (λ β', -(α' - α) / (β' - β)))).to_finset,
  let s' := s.preimage ϕ (λ x hx y hy h, ϕ.injective h),
  obtain ⟨c, hc⟩ := infinite.exists_not_mem_finset s',
  simp_rw [finset.mem_preimage, multiset.mem_to_finset, multiset.mem_bind, multiset.mem_map] at hc,
  push_neg at hc,
  exact ⟨c, hc⟩,
end

variables (F) [algebra F E]

-- This is the heart of the proof of the primitive element theorem. It shows that if `F` is
-- infinite and `α` and `β` are separable over `F` then `F⟮α, β⟯` is generated by a single element.
lemma primitive_element_inf_aux [is_separable F E] :
  ∃ γ : E, F⟮α, β⟯ = F⟮γ⟯ :=
begin
  have hα := is_separable.is_integral F α,
  have hβ := is_separable.is_integral F β,
  let f := minpoly F α,
  let g := minpoly F β,
  let ιFE := algebra_map F E,
  let ιEE' := algebra_map E (splitting_field (g.map ιFE)),
  obtain ⟨c, hc⟩ := primitive_element_inf_aux_exists_c (ιEE'.comp ιFE) (ιEE' α) (ιEE' β) f g,
  let γ := α + c • β,
  suffices β_in_Fγ : β ∈ F⟮γ⟯,
  { use γ,
    apply le_antisymm,
    { rw adjoin_le_iff,
      have α_in_Fγ : α ∈ F⟮γ⟯,
      { rw ← add_sub_cancel α (c • β),
        exact F⟮γ⟯.sub_mem (mem_adjoin_simple_self F γ) (F⟮γ⟯.to_subalgebra.smul_mem β_in_Fγ c) },
      exact λ x hx, by cases hx; cases hx; cases hx; assumption },
    { rw adjoin_le_iff,
      change {γ} ⊆ _,
      rw set.singleton_subset_iff,
      have α_in_Fαβ : α ∈ F⟮α, β⟯ := subset_adjoin F {α, β} (set.mem_insert α {β}),
      have β_in_Fαβ : β ∈ F⟮α, β⟯ := subset_adjoin F {α, β} (set.mem_insert_of_mem α rfl),
      exact F⟮α,β⟯.add_mem α_in_Fαβ (F⟮α, β⟯.smul_mem β_in_Fαβ) } },
  let p := euclidean_domain.gcd ((f.map (algebra_map F F⟮γ⟯)).comp
    (C (adjoin_simple.gen F γ) - (C ↑c * X))) (g.map (algebra_map F F⟮γ⟯)),
  let h := euclidean_domain.gcd ((f.map ιFE).comp (C γ - (C (ιFE c) * X))) (g.map ιFE),
  have map_g_ne_zero : g.map ιFE ≠ 0 := map_ne_zero (minpoly.ne_zero hβ),
  have h_ne_zero : h ≠ 0 :=  mt euclidean_domain.gcd_eq_zero_iff.mp
    (not_and.mpr (λ _, map_g_ne_zero)),
  suffices p_linear : p.map (algebra_map F⟮γ⟯ E) = (C h.leading_coeff) * (X - C β),
  { have finale : β = algebra_map F⟮γ⟯ E (-p.coeff 0 / p.coeff 1),
    { rw [ring_hom.map_div, ring_hom.map_neg, ←coeff_map, ←coeff_map, p_linear],
      simp [mul_sub, coeff_C, mul_div_cancel_left β (mt leading_coeff_eq_zero.mp h_ne_zero)] },
    rw finale,
    exact subtype.mem (-p.coeff 0 / p.coeff 1) },
  have h_sep : h.separable := separable_gcd_right _ (is_separable.separable F β).map,
  have h_root : h.eval β = 0,
  { apply eval_gcd_eq_zero,
    { rw [eval_comp, eval_sub, eval_mul, eval_C, eval_C, eval_X, eval_map, ←aeval_def,
          ←algebra.smul_def, add_sub_cancel, minpoly.aeval] },
    { rw [eval_map, ←aeval_def, minpoly.aeval] } },
  have h_splits : splits ιEE' h := splits_of_splits_gcd_right ιEE' map_g_ne_zero
    (splitting_field.splits _),
  have h_roots : ∀ x ∈ (h.map ιEE').roots, x = ιEE' β,
  { intros x hx,
    rw mem_roots_map h_ne_zero at hx,
    specialize hc ((ιEE' γ) - (ιEE' (ιFE c)) * x) (begin
      have f_root := root_left_of_root_gcd hx,
      rw [eval₂_comp, eval₂_sub, eval₂_mul,eval₂_C, eval₂_C, eval₂_X, eval₂_map] at f_root,
      exact (mem_roots_map (minpoly.ne_zero hα)).mpr f_root,
    end),
    specialize hc x (begin
      rw [mem_roots_map (minpoly.ne_zero hβ), ←eval₂_map],
      exact root_right_of_root_gcd hx,
    end),
    by_contradiction a,
    apply hc,
    apply (div_eq_iff (sub_ne_zero.mpr a)).mpr,
    simp only [algebra.smul_def, ring_hom.map_add, ring_hom.map_mul, ring_hom.comp_apply],
    ring },
  rw ← eq_X_sub_C_of_separable_of_root_eq h_sep h_root h_splits h_roots,
  transitivity euclidean_domain.gcd (_ : E[X]) (_ : E[X]),
  { dsimp only [p],
    convert (gcd_map (algebra_map F⟮γ⟯ E)).symm },
  { simpa [map_comp, polynomial.map_map, ←is_scalar_tower.algebra_map_eq, h] },
end

end primitive_element_inf

variables (F E : Type*) [field F] [field E]
variables [algebra F E] [finite_dimensional F E]

section separable_assumption

variable [is_separable F E]

/-- Primitive element theorem: a finite separable field extension `E` of `F` has a
  primitive element, i.e. there is an `α ∈ E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.-/
theorem exists_primitive_element : ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  rcases is_empty_or_nonempty (fintype F) with F_inf|⟨⟨F_finite⟩⟩,
  { let P : intermediate_field F E → Prop := λ K, ∃ α : E, F⟮α⟯ = K,
    have base : P ⊥ := ⟨0, adjoin_zero⟩,
    have ih : ∀ (K : intermediate_field F E) (x : E), P K → P ↑K⟮x⟯,
    { intros K β hK,
      cases hK with α hK,
      rw [←hK, adjoin_simple_adjoin_simple],
      haveI : infinite F := is_empty_fintype.mp F_inf,
      cases primitive_element_inf_aux F α β with γ hγ,
      exact ⟨γ, hγ.symm⟩ },
    exact induction_on_adjoin P base ih ⊤ },
  { exactI exists_primitive_element_of_fintype_bot F E }
end

/-- Alternative phrasing of primitive element theorem:
a finite separable field extension has a basis `1, α, α^2, ..., α^n`.

See also `exists_primitive_element`. -/
noncomputable def power_basis_of_finite_of_separable : power_basis F E :=
let α := (exists_primitive_element F E).some,
    pb := (adjoin.power_basis (is_separable.is_integral F α)) in
have e : F⟮α⟯ = ⊤ := (exists_primitive_element F E).some_spec,
pb.map ((intermediate_field.equiv_of_eq e).trans intermediate_field.top_equiv)

end separable_assumption

/-- A technical finiteness result. -/
noncomputable def fintype.subtype_prod {E : Type*} {X : set E} (hX : X.finite) {L : Type*}
  (F : E → multiset L) : fintype (Π x : X, {l : L // l ∈ F x}) :=
by { classical, letI : fintype X := set.finite.fintype hX, exact pi.fintype}

variables (K : Type*) [field K] [algebra F K]

variables (E F)

/-- Function from Hom_K(E,L) to pi type Π (x : basis), roots of min poly of x -/
-- Marked as `noncomputable!` since this definition takes multiple seconds to compile,
-- and isn't very computable in practice (since neither `finrank` nor `fin_basis` are).
noncomputable! def roots_of_min_poly_pi_type (φ : E →ₐ[F] K)
  (x : set.range (finite_dimensional.fin_basis F E : _ → E)) :
  {l : K // l ∈ (((minpoly F x.1).map (algebra_map F K)).roots : multiset K)} :=
⟨φ x, begin
  rw [polynomial.mem_roots_map (minpoly.ne_zero_of_finite_field_extension F x.val),
    ← polynomial.alg_hom_eval₂_algebra_map, ← φ.map_zero],
  exact congr_arg φ (minpoly.aeval F (x : E)),
end⟩

lemma aux_inj_roots_of_min_poly : function.injective (roots_of_min_poly_pi_type F E K) :=
begin
  intros f g h,
  suffices : (f : E →ₗ[F] K) = g,
  { rw linear_map.ext_iff at this,
    ext x, exact this x },
  rw function.funext_iff at h,
  apply linear_map.ext_on (finite_dimensional.fin_basis F E).span_eq,
  rintro e he,
  have := (h ⟨e, he⟩),
  apply_fun subtype.val at this,
  exact this,
end

/-- Given field extensions `E/F` and `K/F`, with `E/F` finite, there are finitely many `F`-algebra
  homomorphisms `E →ₐ[K] K`. -/
noncomputable instance : fintype (E →ₐ[F] K) :=
let n := finite_dimensional.finrank F E in
begin
  let B : basis (fin n) F E := finite_dimensional.fin_basis F E,
  let X := set.range (B : fin n → E),
  have hX : X.finite := set.finite_range ⇑B,
  refine @fintype.of_injective _ _
    (fintype.subtype_prod hX (λ e, ((minpoly F e).map (algebra_map F K)).roots)) _
    (aux_inj_roots_of_min_poly F E K),
end

end field

@[simp] lemma alg_hom.card (F E K : Type*) [field F] [field E] [field K] [is_alg_closed K]
  [algebra F E] [finite_dimensional F E] [is_separable F E] [algebra F K] :
  fintype.card (E →ₐ[F] K) = finrank F E :=
begin
  convert (alg_hom.card_of_power_basis (field.power_basis_of_finite_of_separable F E)
    (is_separable.separable _ _) (is_alg_closed.splits_codomain _)).trans
    (power_basis.finrank _).symm,
  apply_instance,
end


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

! This file was ported from Lean 3 source module algebra.homology.differential_object
! leanprover-community/mathlib commit b535c2d5d996acd9b0554b76395d9c920e186f4f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Homology.HomologicalComplex
import Mathbin.CategoryTheory.DifferentialObject

/-!
# Homological complexes are differential graded objects.

We verify that a `homological_complex` indexed by an `add_comm_group` is
essentially the same thing as a differential graded object.

This equivalence is probably not particularly useful in practice;
it's here to check that definitions match up as expected.
-/

open CategoryTheory

open CategoryTheory.Limits

open Classical

noncomputable section

namespace HomologicalComplex

variable {β : Type _} [AddCommGroup β] {b : β}

variable {V : Type _} [Category V] [HasZeroMorphisms V]

/-- Since `eq_to_hom` only preserves the fact that `X.X i = X.X j` but not `i = j`, this definition
is used to aid the simplifier. -/
abbrev CategoryTheory.DifferentialObject.xEqToHom
    (X : DifferentialObject (GradedObjectWithShift b V)) {i j : β} (h : i = j) : X.pt i ⟶ X.pt j :=
  eqToHom (congr_arg X.pt h)
#align category_theory.differential_object.X_eq_to_hom CategoryTheory.DifferentialObject.xEqToHom

@[simp]
theorem CategoryTheory.DifferentialObject.xEqToHom_refl
    (X : DifferentialObject (GradedObjectWithShift b V)) (i : β) : X.xEqToHom (refl i) = 𝟙 _ :=
  rfl
#align category_theory.differential_object.X_eq_to_hom_refl CategoryTheory.DifferentialObject.xEqToHom_refl

@[simp, reassoc.1]
theorem eq_to_hom_d (X : DifferentialObject (GradedObjectWithShift b V)) {x y : β} (h : x = y) :
    X.xEqToHom h ≫ X.d y =
      X.d x ≫
        X.xEqToHom
          (by
            cases h
            rfl) :=
  by
  cases h
  dsimp
  simp
#align homological_complex.eq_to_hom_d HomologicalComplex.eq_to_hom_d

@[simp, reassoc.1]
theorem d_eqToHom (X : HomologicalComplex V (ComplexShape.up' b)) {x y z : β} (h : y = z) :
    X.d x y ≫ eqToHom (congr_arg X.pt h) = X.d x z :=
  by
  cases h
  simp
#align homological_complex.d_eq_to_hom HomologicalComplex.d_eqToHom

@[simp, reassoc.1]
theorem eq_to_hom_f' {X Y : DifferentialObject (GradedObjectWithShift b V)} (f : X ⟶ Y) {x y : β}
    (h : x = y) : X.xEqToHom h ≫ f.f y = f.f x ≫ Y.xEqToHom h :=
  by
  cases h
  simp
#align homological_complex.eq_to_hom_f' HomologicalComplex.eq_to_hom_f'

variable (b V)

attribute [local reducible] graded_object.has_shift

/-- The functor from differential graded objects to homological complexes.
-/
@[simps]
def dgoToHomologicalComplex :
    DifferentialObject (GradedObjectWithShift b V) ⥤ HomologicalComplex V (ComplexShape.up' b)
    where
  obj X :=
    { pt := fun i => X.pt i
      d := fun i j =>
        if h : i + b = j then X.d i ≫ X.xEqToHom (show i + (1 : ℤ) • b = j by simp [h]) else 0
      shape' := fun i j w => by
        dsimp at w
        convert dif_neg w
      d_comp_d' := fun i j k hij hjk => by
        dsimp at hij hjk; substs hij hjk
        have : X.d i ≫ X.d _ = _ := (congr_fun X.d_squared i : _)
        reassoc! this
        simp [this] }
  map X Y f :=
    { f := f.f
      comm' := fun i j h => by
        dsimp at h⊢
        subst h
        have : f.f i ≫ Y.d i = X.d i ≫ f.f (i + 1 • b) := (congr_fun f.comm i).symm
        reassoc! this
        simp only [category.comp_id, eq_to_hom_refl, dif_pos rfl, this, category.assoc,
          eq_to_hom_f'] }
#align homological_complex.dgo_to_homological_complex HomologicalComplex.dgoToHomologicalComplex

/-- The functor from homological complexes to differential graded objects.
-/
@[simps]
def homologicalComplexToDgo :
    HomologicalComplex V (ComplexShape.up' b) ⥤ DifferentialObject (GradedObjectWithShift b V)
    where
  obj X :=
    { pt := fun i => X.pt i
      d := fun i => X.d i (i + 1 • b)
      d_squared' := by
        ext i
        dsimp
        simp }
  map X Y f :=
    { f := f.f
      comm' := by
        ext i
        dsimp
        simp }
#align homological_complex.homological_complex_to_dgo HomologicalComplex.homologicalComplexToDgo

/-- The unit isomorphism for `dgo_equiv_homological_complex`.
-/
@[simps]
def dgoEquivHomologicalComplexUnitIso :
    𝟭 (DifferentialObject (GradedObjectWithShift b V)) ≅
      dgoToHomologicalComplex b V ⋙ homologicalComplexToDgo b V :=
  NatIso.ofComponents
    (fun X =>
      { Hom := { f := fun i => 𝟙 (X.pt i) }
        inv := { f := fun i => 𝟙 (X.pt i) } })
    (by tidy)
#align homological_complex.dgo_equiv_homological_complex_unit_iso HomologicalComplex.dgoEquivHomologicalComplexUnitIso

/-- The counit isomorphism for `dgo_equiv_homological_complex`.
-/
@[simps]
def dgoEquivHomologicalComplexCounitIso :
    homologicalComplexToDgo b V ⋙ dgoToHomologicalComplex b V ≅
      𝟭 (HomologicalComplex V (ComplexShape.up' b)) :=
  NatIso.ofComponents
    (fun X =>
      { Hom :=
          { f := fun i => 𝟙 (X.pt i)
            comm' := fun i j h => by
              dsimp at h⊢; subst h
              delta homological_complex_to_dgo
              simp }
        inv :=
          { f := fun i => 𝟙 (X.pt i)
            comm' := fun i j h => by
              dsimp at h⊢; subst h
              delta homological_complex_to_dgo
              simp } })
    (by tidy)
#align homological_complex.dgo_equiv_homological_complex_counit_iso HomologicalComplex.dgoEquivHomologicalComplexCounitIso

/-- The category of differential graded objects in `V` is equivalent
to the category of homological complexes in `V`.
-/
@[simps]
def dgoEquivHomologicalComplex :
    DifferentialObject (GradedObjectWithShift b V) ≌ HomologicalComplex V (ComplexShape.up' b)
    where
  Functor := dgoToHomologicalComplex b V
  inverse := homologicalComplexToDgo b V
  unitIso := dgoEquivHomologicalComplexUnitIso b V
  counitIso := dgoEquivHomologicalComplexCounitIso b V
#align homological_complex.dgo_equiv_homological_complex HomologicalComplex.dgoEquivHomologicalComplex

end HomologicalComplex


/-
Copyright (c) 2022 George Peter Banyard, Yaël Dillies, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: George Peter Banyard, Yaël Dillies, Kyle Miller
-/
import combinatorics.simple_graph.connectivity

/-!
# Graph products

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

This file defines the box product of graphs and other product constructions. The box product of `G`
and `H` is the graph on the product of the vertices such that `x` and `y` are related iff they agree
on one component and the other one is related via either `G` or `H`. For example, the box product of
two edges is a square.

## Main declarations

* `simple_graph.box_prod`: The box product.

## Notation

* `G □ H`: The box product of `G` and `H`.

## TODO

Define all other graph products!
-/

variables {α β γ : Type*}

namespace simple_graph
variables {G : simple_graph α} {H : simple_graph β} {I : simple_graph γ} {a a₁ a₂ : α} {b b₁ b₂ : β}
  {x y : α × β}

/-- Box product of simple graphs. It relates `(a₁, b)` and `(a₂, b)` if `G` relates `a₁` and `a₂`,
and `(a, b₁)` and `(a, b₂)` if `H` relates `b₁` and `b₂`. -/
def box_prod (G : simple_graph α) (H : simple_graph β) : simple_graph (α × β) :=
{ adj := λ x y, G.adj x.1 y.1 ∧ x.2 = y.2 ∨ H.adj x.2 y.2 ∧ x.1 = y.1,
  symm := λ x y, by simp [and_comm, or_comm, eq_comm, adj_comm],
  loopless := λ x, by simp }

infix ` □ `:70 := box_prod

@[simp] lemma box_prod_adj :
  (G □ H).adj x y ↔ G.adj x.1 y.1 ∧ x.2 = y.2 ∨ H.adj x.2 y.2 ∧ x.1 = y.1 := iff.rfl

@[simp] lemma box_prod_adj_left : (G □ H).adj (a₁, b) (a₂, b) ↔ G.adj a₁ a₂ :=
by rw [box_prod_adj, and_iff_left rfl, or_iff_left (λ h : H.adj b b ∧ _, h.1.ne rfl)]

@[simp] lemma box_prod_adj_right : (G □ H).adj (a, b₁) (a, b₂) ↔ H.adj b₁ b₂ :=
by rw [box_prod_adj, and_iff_left rfl, or_iff_right (λ h : G.adj a a ∧ _, h.1.ne rfl)]

lemma box_prod_neighbor_set (x : α × β) :
  (G □ H).neighbor_set x = ((G.neighbor_set x.1) ×ˢ {x.2}) ∪ ({x.1} ×ˢ (H.neighbor_set x.2)) :=
begin
  ext ⟨a',b'⟩,
  simp only [mem_neighbor_set, set.mem_union, box_prod_adj, set.mem_prod, set.mem_singleton_iff],
  simp only [eq_comm, and_comm],
end

variables (G H I)

/-- The box product is commutative up to isomorphism. `equiv.prod_comm` as a graph isomorphism. -/
@[simps] def box_prod_comm : G □ H ≃g H □ G := ⟨equiv.prod_comm _ _, λ x y, or_comm _ _⟩

/-- The box product is associative up to isomorphism. `equiv.prod_assoc` as a graph isomorphism. -/
@[simps] def box_prod_assoc : (G □ H) □ I ≃g G □ (H □ I) :=
⟨equiv.prod_assoc _ _ _, λ x y, by simp only [box_prod_adj, equiv.prod_assoc_apply,
  or_and_distrib_right, or_assoc, prod.ext_iff, and_assoc, @and.comm (x.1.1 = _)]⟩

/-- The embedding of `G` into `G □ H` given by `b`. -/
@[simps] def box_prod_left (b : β) : G ↪g G □ H :=
{ to_fun := λ a, (a , b),
  inj' := λ a₁ a₂, congr_arg prod.fst,
  map_rel_iff' := λ a₁ a₂, box_prod_adj_left }

/-- The embedding of `H` into `G □ H` given by `a`. -/
@[simps] def box_prod_right (a : α) : H ↪g G □ H :=
{ to_fun := prod.mk a,
  inj' := λ b₁ b₂, congr_arg prod.snd,
  map_rel_iff' := λ b₁ b₂, box_prod_adj_right }

namespace walk
variables {G}

/-- Turn a walk on `G` into a walk on `G □ H`. -/
protected def box_prod_left (b : β) : G.walk a₁ a₂ → (G □ H).walk (a₁, b) (a₂, b) :=
walk.map (G.box_prod_left H b).to_hom

variables (G) {H}

/-- Turn a walk on `H` into a walk on `G □ H`. -/
protected def box_prod_right (a : α) : H.walk b₁ b₂ → (G □ H).walk (a, b₁) (a, b₂) :=
walk.map (G.box_prod_right H a).to_hom

variables {G}

/-- Project a walk on `G □ H` to a walk on `G` by discarding the moves in the direction of `H`. -/
def of_box_prod_left [decidable_eq β] [decidable_rel G.adj] :
  Π {x y : α × β}, (G □ H).walk x y → G.walk x.1 y.1
| _ _ nil := nil
| x z (cons h w) := or.by_cases h (λ hG, w.of_box_prod_left.cons hG.1)
    (λ hH, show G.walk x.1 z.1, by rw hH.2; exact w.of_box_prod_left)

/-- Project a walk on `G □ H` to a walk on `H` by discarding the moves in the direction of `G`. -/
def of_box_prod_right [decidable_eq α] [decidable_rel H.adj] :
  Π {x y : α × β}, (G □ H).walk x y → H.walk x.2 y.2
| _ _ nil := nil
| x z (cons h w) := (or.symm h).by_cases (λ hH, w.of_box_prod_right.cons hH.1)
  (λ hG, show H.walk x.2 z.2, by rw hG.2; exact w.of_box_prod_right)

@[simp] lemma of_box_prod_left_box_prod_left [decidable_eq β] [decidable_rel G.adj] :
  ∀ {a₁ a₂ : α} (w : G.walk a₁ a₂), (w.box_prod_left H b).of_box_prod_left = w
| _ _ nil := rfl
| _ _ (cons' x y z h w) := begin
  rw [walk.box_prod_left, map_cons, of_box_prod_left, or.by_cases, dif_pos, ←walk.box_prod_left,
    of_box_prod_left_box_prod_left],
  exacts [rfl, ⟨h, rfl⟩],
end

@[simp]

end walk

variables {G H}

protected lemma preconnected.box_prod (hG : G.preconnected) (hH : H.preconnected) :
  (G □ H).preconnected :=
begin
  rintro x y,
  obtain ⟨w₁⟩ := hG x.1 y.1,
  obtain ⟨w₂⟩ := hH x.2 y.2,
  rw [←@prod.mk.eta _ _ x, ←@prod.mk.eta _ _ y],
  exact ⟨(w₁.box_prod_left _ _).append (w₂.box_prod_right _ _)⟩,
end

protected lemma preconnected.of_box_prod_left [nonempty β] (h : (G □ H).preconnected) :
  G.preconnected :=
begin
  classical,
  rintro a₁ a₂,
  obtain ⟨w⟩ := h (a₁, classical.arbitrary _) (a₂, classical.arbitrary _),
  exact ⟨w.of_box_prod_left⟩,
end

protected lemma preconnected.of_box_prod_right [nonempty α] (h : (G □ H).preconnected) :
  H.preconnected :=
begin
  classical,
  rintro b₁ b₂,
  obtain ⟨w⟩ := h (classical.arbitrary _, b₁) (classical.arbitrary _, b₂),
  exact ⟨w.of_box_prod_right⟩,
end

protected lemma connected.box_prod (hG : G.connected) (hH : H.connected) : (G □ H).connected :=
by { haveI := hG.nonempty, haveI := hH.nonempty, exact ⟨hG.preconnected.box_prod hH.preconnected⟩ }

protected lemma connected.of_box_prod_left (h : (G □ H).connected) : G.connected :=
by { haveI := (nonempty_prod.1 h.nonempty).1, haveI := (nonempty_prod.1 h.nonempty).2,
  exact ⟨h.preconnected.of_box_prod_left⟩ }

protected lemma connected.of_box_prod_right (h : (G □ H).connected) : H.connected :=
by { haveI := (nonempty_prod.1 h.nonempty).1, haveI := (nonempty_prod.1 h.nonempty).2,
  exact ⟨h.preconnected.of_box_prod_right⟩ }

@[simp] lemma box_prod_connected : (G □ H).connected ↔ G.connected ∧ H.connected :=
⟨λ h, ⟨h.of_box_prod_left, h.of_box_prod_right⟩, λ h, h.1.box_prod h.2⟩

instance box_prod_fintype_neighbor_set (x : α × β)
  [fintype (G.neighbor_set x.1)] [fintype (H.neighbor_set x.2)] :
  fintype ((G □ H).neighbor_set x) :=
fintype.of_equiv
  ((G.neighbor_finset x.1 ×ˢ {x.2}).disj_union ({x.1} ×ˢ H.neighbor_finset x.2)
      $ finset.disjoint_product.mpr $ or.inl $ neighbor_finset_disjoint_singleton _ _)
  ((equiv.refl _).subtype_equiv $ λ y, begin
    simp_rw [finset.mem_disj_union, finset.mem_product, finset.mem_singleton,
          mem_neighbor_finset, mem_neighbor_set, equiv.refl_apply, box_prod_adj],
    simp only [eq_comm, and_comm],
  end)

lemma box_prod_neighbor_finset (x : α × β)
  [fintype (G.neighbor_set x.1)] [fintype (H.neighbor_set x.2)] [fintype ((G □ H).neighbor_set x)] :
  (G □ H).neighbor_finset x =
    (G.neighbor_finset x.1 ×ˢ {x.2}).disj_union ({x.1} ×ˢ H.neighbor_finset x.2)
      (finset.disjoint_product.mpr $ or.inl $ neighbor_finset_disjoint_singleton _ _) :=
begin
  -- swap out the fintype instance for the canonical one
  letI : fintype ((G □ H).neighbor_set x) := simple_graph.box_prod_fintype_neighbor_set _,
  refine eq.trans _ finset.attach_map_val,
  convert (finset.map_map _ (function.embedding.subtype _) finset.univ),
end

lemma box_prod_degree (x : α × β)
  [fintype (G.neighbor_set x.1)] [fintype (H.neighbor_set x.2)] [fintype ((G □ H).neighbor_set x)] :
  (G □ H).degree x = G.degree x.1 + H.degree x.2 :=
begin
  rw [degree, degree, degree, box_prod_neighbor_finset, finset.card_disj_union],
  simp_rw [finset.card_product, finset.card_singleton, mul_one, one_mul],
end

end simple_graph


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.products
import topology.sheaves.sheaf_condition.pairwise_intersections

/-!
# The sheaf condition in terms of an equalizer of products

Here we set up the machinery for the "usual" definition of the sheaf condition,
e.g. as in https://stacks.math.columbia.edu/tag/0072
in terms of an equalizer diagram where the two objects are
`∏ F.obj (U i)` and `∏ F.obj (U i) ⊓ (U j)`.

We show that this sheaf condition is equivalent to the `pairwise_intersections` sheaf condition when
the presheaf is valued in a category with products, and thereby equivalent to the default sheaf
condition.
-/

universes v' v u

noncomputable theory

open category_theory
open category_theory.limits
open topological_space
open opposite
open topological_space.opens

namespace Top

variables {C : Type u} [category.{v} C] [has_products.{v'} C]
variables {X : Top.{v'}} (F : presheaf C X) {ι : Type v'} (U : ι → opens X)

namespace presheaf

namespace sheaf_condition_equalizer_products

/-- The product of the sections of a presheaf over a family of open sets. -/
def pi_opens : C := ∏ (λ i : ι, F.obj (op (U i)))
/--
The product of the sections of a presheaf over the pairwise intersections of
a family of open sets.
-/
def pi_inters : C := ∏ (λ p : ι × ι, F.obj (op (U p.1 ⊓ U p.2)))

/--
The morphism `Π F.obj (U i) ⟶ Π F.obj (U i) ⊓ (U j)` whose components
are given by the restriction maps from `U i` to `U i ⊓ U j`.
-/
def left_res : pi_opens F U ⟶ pi_inters.{v'} F U :=
pi.lift (λ p : ι × ι, pi.π _ p.1 ≫ F.map (inf_le_left (U p.1) (U p.2)).op)

/--
The morphism `Π F.obj (U i) ⟶ Π F.obj (U i) ⊓ (U j)` whose components
are given by the restriction maps from `U j` to `U i ⊓ U j`.
-/
def right_res : pi_opens F U ⟶ pi_inters.{v'} F U :=
pi.lift (λ p : ι × ι, pi.π _ p.2 ≫ F.map (inf_le_right (U p.1) (U p.2)).op)

/--
The morphism `F.obj U ⟶ Π F.obj (U i)` whose components
are given by the restriction maps from `U j` to `U i ⊓ U j`.
-/
def res : F.obj (op (supr U)) ⟶ pi_opens.{v'} F U :=
pi.lift (λ i : ι, F.map (topological_space.opens.le_supr U i).op)

@[simp, elementwise]
lemma res_π (i : ι) : res F U ≫ limit.π _ ⟨i⟩ = F.map (opens.le_supr U i).op :=
by rw [res, limit.lift_π, fan.mk_π_app]

@[elementwise]
lemma w : res F U ≫ left_res F U = res F U ≫ right_res F U :=
begin
  dsimp [res, left_res, right_res],
  ext,
  simp only [limit.lift_π, limit.lift_π_assoc, fan.mk_π_app, category.assoc],
  rw [←F.map_comp],
  rw [←F.map_comp],
  congr,
end

/--
The equalizer diagram for the sheaf condition.
-/
@[reducible]
def diagram : walking_parallel_pair ⥤ C :=
parallel_pair (left_res.{v'} F U) (right_res F U)

/--
The restriction map `F.obj U ⟶ Π F.obj (U i)` gives a cone over the equalizer diagram
for the sheaf condition. The sheaf condition asserts this cone is a limit cone.
-/
def fork : fork.{v} (left_res F U) (right_res F U) := fork.of_ι _ (w F U)

@[simp]
lemma fork_X : (fork F U).X = F.obj (op (supr U)) := rfl

@[simp]
lemma fork_ι : (fork F U).ι = res F U := rfl
@[simp]
lemma fork_π_app_walking_parallel_pair_zero :
  (fork F U).π.app walking_parallel_pair.zero = res F U := rfl
@[simp]
lemma fork_π_app_walking_parallel_pair_one :
  (fork F U).π.app walking_parallel_pair.one = res F U ≫ left_res F U := rfl

variables {F} {G : presheaf C X}

/-- Isomorphic presheaves have isomorphic `pi_opens` for any cover `U`. -/
@[simp]
def pi_opens.iso_of_iso (α : F ≅ G) : pi_opens F U ≅ pi_opens.{v'} G U :=
pi.map_iso (λ X, α.app _)

/-- Isomorphic presheaves have isomorphic `pi_inters` for any cover `U`. -/
@[simp]
def pi_inters.iso_of_iso (α : F ≅ G) : pi_inters F U ≅ pi_inters.{v'} G U :=
pi.map_iso (λ X, α.app _)

/-- Isomorphic presheaves have isomorphic sheaf condition diagrams. -/
def diagram.iso_of_iso (α : F ≅ G) : diagram F U ≅ diagram.{v'} G U :=
nat_iso.of_components
  begin rintro ⟨⟩, exact pi_opens.iso_of_iso U α, exact pi_inters.iso_of_iso U α end
  begin
    rintro ⟨⟩ ⟨⟩ ⟨⟩,
    { simp, },
    { ext, simp [left_res], },
    { ext, simp [right_res], },
    { simp, },
  end.

/--
If `F G : presheaf C X` are isomorphic presheaves,
then the `fork F U`, the canonical cone of the sheaf condition diagram for `F`,
is isomorphic to `fork F G` postcomposed with the corresponding isomorphism between
sheaf condition diagrams.
-/
def fork.iso_of_iso (α : F ≅ G) :
  fork F U ≅ (cones.postcompose (diagram.iso_of_iso U α).inv).obj (fork G U) :=
begin
  fapply fork.ext,
  { apply α.app, },
  { ext,
    dunfold fork.ι, -- Ugh, `simp` can't unfold abbreviations.
    simp [res, diagram.iso_of_iso], }
end

end sheaf_condition_equalizer_products

/--
The sheaf condition for a `F : presheaf C X` requires that the morphism
`F.obj U ⟶ ∏ F.obj (U i)` (where `U` is some open set which is the union of the `U i`)
is the equalizer of the two morphisms
`∏ F.obj (U i) ⟶ ∏ F.obj (U i) ⊓ (U j)`.
-/
def is_sheaf_equalizer_products (F : presheaf.{v' v u} C X) : Prop :=
∀ ⦃ι : Type v'⦄ (U : ι → opens X), nonempty (is_limit (sheaf_condition_equalizer_products.fork F U))

/-!
The remainder of this file shows that the equalizer_products sheaf condition is equivalent
to the pariwise_intersections sheaf condition.
-/

namespace sheaf_condition_pairwise_intersections

open category_theory.pairwise category_theory.pairwise.hom

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_functor_obj (c : cone ((diagram U).op ⋙ F)) :
  cone (sheaf_condition_equalizer_products.diagram F U) :=
{ X := c.X,
  π :=
  { app := λ Z,
      walking_parallel_pair.cases_on Z
        (pi.lift (λ (i : ι), c.π.app (op (single i))))
        (pi.lift (λ (b : ι × ι), c.π.app (op (pair b.1 b.2)))),
    naturality' := λ Y Z f,
    begin
      cases Y; cases Z; cases f,
      { ext i, dsimp,
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app, category_theory.functor.map_id,
          category.assoc],
        dsimp,
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app], },
      { ext ⟨i, j⟩, dsimp [sheaf_condition_equalizer_products.left_res],
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        have h := c.π.naturality (quiver.hom.op (hom.left i j)),
        dsimp at h,
        simpa using h, },
      { ext ⟨i, j⟩, dsimp [sheaf_condition_equalizer_products.right_res],
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        have h := c.π.naturality (quiver.hom.op (hom.right i j)),
        dsimp at h,
        simpa using h, },
      { ext i, dsimp,
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app, category_theory.functor.map_id,
          category.assoc],
        dsimp,
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app], },
    end, }, }

section
local attribute [tidy] tactic.case_bash

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_functor :
  limits.cone ((diagram U).op ⋙ F) ⥤
    limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
{ obj := λ c, cone_equiv_functor_obj F U c,
  map := λ c c' f,
  { hom := f.hom,
    w' := λ j, begin
      cases j;
      { ext, simp only [limits.fan.mk_π_app, limits.cone_morphism.w,
        limits.limit.lift_π, category.assoc, cone_equiv_functor_obj_π_app], },
    end }, }.

end

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_inverse_obj
  (c : limits.cone (sheaf_condition_equalizer_products.diagram F U)) :
  limits.cone ((diagram U).op ⋙ F) :=
{ X := c.X,
  π :=
  { app :=
    begin
      intro x,
      induction x using opposite.rec,
      rcases x with (⟨i⟩|⟨i,j⟩),
      { exact c.π.app (walking_parallel_pair.zero) ≫ pi.π _ i, },
      { exact c.π.app (walking_parallel_pair.one) ≫ pi.π _ (i, j), }
    end,
    naturality' :=
    begin
      intros x y f,
      induction x using opposite.rec,
      induction y using opposite.rec,
      have ef : f = f.unop.op := rfl,
      revert ef,
      generalize : f.unop = f',
      rintro rfl,
      rcases x with ⟨i⟩|⟨⟩; rcases y with ⟨⟩|⟨j,j⟩; rcases f' with ⟨⟩,
      { dsimp, erw [F.map_id], simp, },
      { dsimp, simp only [category.id_comp, category.assoc],
        have h := c.π.naturality (walking_parallel_pair_hom.left),
        dsimp [sheaf_condition_equalizer_products.left_res] at h,
        simp only [category.id_comp] at h,
        have h' := h =≫ pi.π _ (i, j),
        rw h',
        simp only [category.assoc, limit.lift_π, fan.mk_π_app],
        refl, },
      { dsimp, simp only [category.id_comp, category.assoc],
        have h := c.π.naturality (walking_parallel_pair_hom.right),
        dsimp [sheaf_condition_equalizer_products.right_res] at h,
        simp only [category.id_comp] at h,
        have h' := h =≫ pi.π _ (j, i),
        rw h',
        simp,
        refl, },
      { dsimp, erw [F.map_id], simp, },
    end, }, }

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_inverse :
  limits.cone (sheaf_condition_equalizer_products.diagram F U) ⥤
    limits.cone ((diagram U).op ⋙ F) :=
{ obj := λ c, cone_equiv_inverse_obj F U c,
  map := λ c c' f,
  { hom := f.hom,
    w' :=
    begin
      intro x,
      induction x using opposite.rec,
      rcases x with (⟨i⟩|⟨i,j⟩),
      { dsimp,
        dunfold fork.ι,
        rw [←(f.w walking_parallel_pair.zero), category.assoc], },
      { dsimp,
        rw [←(f.w walking_parallel_pair.one), category.assoc], },
    end }, }.

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_unit_iso_app
  (c : cone ((diagram U).op ⋙ F)) :
  (𝟭 (cone ((diagram U).op ⋙ F))).obj c ≅
    (cone_equiv_functor F U ⋙ cone_equiv_inverse F U).obj c :=
{ hom :=
  { hom := 𝟙 _,
    w' := λ j, begin
      induction j using opposite.rec, rcases j;
      { dsimp, simp only [limits.fan.mk_π_app, category.id_comp, limits.limit.lift_π], }
    end, },
  inv :=
  { hom := 𝟙 _,
    w' := λ j, begin
      induction j using opposite.rec, rcases j;
      { dsimp, simp only [limits.fan.mk_π_app, category.id_comp, limits.limit.lift_π], }
    end },
  hom_inv_id' := begin
    ext,
    simp only [category.comp_id, limits.cone.category_comp_hom, limits.cone.category_id_hom],
  end,
  inv_hom_id' := begin
    ext,
    simp only [category.comp_id, limits.cone.category_comp_hom, limits.cone.category_id_hom],
  end, }

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_unit_iso :
  𝟭 (limits.cone ((diagram U).op ⋙ F)) ≅
    cone_equiv_functor F U ⋙ cone_equiv_inverse F U :=
nat_iso.of_components (cone_equiv_unit_iso_app F U) (by tidy)

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_counit_iso :
  cone_equiv_inverse F U ⋙ cone_equiv_functor F U ≅
    𝟭 (limits.cone (sheaf_condition_equalizer_products.diagram F U)) :=
nat_iso.of_components (λ c,
{ hom :=
  { hom := 𝟙 _,
    w' :=
    begin
      rintro ⟨_|_⟩,
      { ext ⟨j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
      { ext ⟨i,j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
    end },
  inv :=
  { hom := 𝟙 _,
    w' :=
    begin
      rintro ⟨_|_⟩,
      { ext ⟨j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
      { ext ⟨i,j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
    end, },
  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, })
(λ c d f, by { ext, dsimp, simp only [category.comp_id, category.id_comp], })

/--
Cones over `diagram U ⋙ F` are the same as a cones over the usual sheaf condition equalizer diagram.
-/
@[simps]
def cone_equiv :
  limits.cone ((diagram U).op ⋙ F) ≌ limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
{ functor := cone_equiv_functor F U,
  inverse := cone_equiv_inverse F U,
  unit_iso := cone_equiv_unit_iso F U,
  counit_iso := cone_equiv_counit_iso F U, }

local attribute [reducible]
  sheaf_condition_equalizer_products.res
  sheaf_condition_equalizer_products.left_res

/--
If `sheaf_condition_equalizer_products.fork` is an equalizer,
then `F.map_cone (cone U)` is a limit cone.
-/
def is_limit_map_cone_of_is_limit_sheaf_condition_fork
  (P : is_limit (sheaf_condition_equalizer_products.fork F U)) :
  is_limit (F.map_cone (cocone U).op) :=
is_limit.of_iso_limit ((is_limit.of_cone_equiv (cone_equiv F U).symm).symm P)
{ hom :=
  { hom := 𝟙 _,
    w' :=
    begin
      intro x,
      induction x using opposite.rec,
      rcases x with ⟨⟩,
      { dsimp, simp, refl, },
      { dsimp,
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        rw ←F.map_comp,
        refl, }
    end },
  inv :=
  { hom := 𝟙 _,
    w' :=
    begin
      intro x,
      induction x using opposite.rec,
      rcases x with ⟨⟩,
      { dsimp, simp, refl, },
      { dsimp,
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        rw ←F.map_comp,
        refl, }
    end },
  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, }

/--
If `F.map_cone (cone U)` is a limit cone,
then `sheaf_condition_equalizer_products.fork` is an equalizer.
-/
def is_limit_sheaf_condition_fork_of_is_limit_map_cone
  (Q : is_limit (F.map_cone (cocone U).op)) :
  is_limit (sheaf_condition_equalizer_products.fork F U) :=
is_limit.of_iso_limit ((is_limit.of_cone_equiv (cone_equiv F U)).symm Q)
{ hom :=
  { hom := 𝟙 _,
    w' :=
    begin
      rintro ⟨⟩,
      { dsimp, simp, refl, },
      { dsimp, ext ⟨i, j⟩,
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        rw ←F.map_comp,
        refl, }
    end },
  inv :=
  { hom := 𝟙 _,
    w' :=
    begin
      rintro ⟨⟩,
      { dsimp, simp, refl, },
      { dsimp, ext ⟨i, j⟩,
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        rw ←F.map_comp,
        refl, }
    end },
  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, }

end sheaf_condition_pairwise_intersections

open sheaf_condition_pairwise_intersections

/--
The sheaf condition in terms of an equalizer diagram is equivalent
to the default sheaf condition.
-/
lemma is_sheaf_iff_is_sheaf_equalizer_products (F : presheaf C X) :
  F.is_sheaf ↔ F.is_sheaf_equalizer_products :=
(is_sheaf_iff_is_sheaf_pairwise_intersections F).trans $
iff.intro (λ h ι U, ⟨is_limit_sheaf_condition_fork_of_is_limit_map_cone F U (h U).some⟩)
  (λ h ι U, ⟨is_limit_map_cone_of_is_limit_sheaf_condition_fork F U (h U).some⟩)

end presheaf

end Top


/- intro tactic variants -/

example (p q : α → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x := by
  intro h
  match h with
  | Exists.intro w (And.intro hp hq) => exact Exists.intro w (And.intro hq hp)

example (p q : α → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x := by
  intro (Exists.intro _ (And.intro hp hq))
  exact Exists.intro _ (And.intro hq hp)

example (p q : α → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x := by
  intro ⟨_, hp, hq⟩
  exact ⟨_, hq, hp⟩

example (α : Type) (p q : α → Prop) : (∃ x, p x ∨ q x) → ∃ x, q x ∨ p x := by
  intro
    | ⟨_, .inl h⟩ => exact ⟨_, .inr h⟩
    | ⟨_, .inr h⟩ => exact ⟨_, .inl h⟩


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

! This file was ported from Lean 3 source module group_theory.group_action.sub_mul_action.pointwise
! leanprover-community/mathlib commit 2bbc7e3884ba234309d2a43b19144105a753292e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.GroupAction.SubMulAction

/-!
# Pointwise monoid structures on sub_mul_action

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

This file provides `sub_mul_action.monoid` and weaker typeclasses, which show that `sub_mul_action`s
inherit the same pointwise multiplications as sets.

To match `submodule.idem_semiring`, we do not put these in the `pointwise` locale.

-/

open Pointwise

variable {R M : Type _}

namespace SubMulAction

section One

variable [Monoid R] [MulAction R M] [One M]

instance : One (SubMulAction R M)
    where one :=
    { carrier := Set.range fun r : R => r • (1 : M)
      smul_mem' := fun r m ⟨r', hr'⟩ => hr' ▸ ⟨r * r', mul_smul _ _ _⟩ }

#print SubMulAction.coe_one /-
theorem coe_one : ↑(1 : SubMulAction R M) = Set.range fun r : R => r • (1 : M) :=
  rfl
#align sub_mul_action.coe_one SubMulAction.coe_one
-/

#print SubMulAction.mem_one /-
@[simp]
theorem mem_one {x : M} : x ∈ (1 : SubMulAction R M) ↔ ∃ r : R, r • 1 = x :=
  Iff.rfl
#align sub_mul_action.mem_one SubMulAction.mem_one
-/

#print SubMulAction.subset_coe_one /-
theorem subset_coe_one : (1 : Set M) ⊆ (1 : SubMulAction R M) := fun x hx =>
  ⟨1, (one_smul _ _).trans hx.symm⟩
#align sub_mul_action.subset_coe_one SubMulAction.subset_coe_one
-/

end One

section Mul

variable [Monoid R] [MulAction R M] [Mul M] [IsScalarTower R M M]

instance : Mul (SubMulAction R M)
    where mul p q :=
    { carrier := Set.image2 (· * ·) p q
      smul_mem' := fun r m ⟨m₁, m₂, hm₁, hm₂, h⟩ =>
        h ▸ smul_mul_assoc r m₁ m₂ ▸ Set.mul_mem_mul (p.smul_mem _ hm₁) hm₂ }

/- warning: sub_mul_action.coe_mul -> SubMulAction.coe_mul is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {M : Type.{u2}} [_inst_1 : Monoid.{u1} R] [_inst_2 : MulAction.{u1, u2} R M _inst_1] [_inst_3 : Mul.{u2} M] [_inst_4 : IsScalarTower.{u1, u2, u2} R M M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2) (Mul.toSMul.{u2} M _inst_3) (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)] (p : SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (q : SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)), Eq.{succ u2} (Set.{u2} M) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))))) (HMul.hMul.{u2, u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (instHMul.{u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SubMulAction.hasMul.{u1, u2} R M _inst_1 _inst_2 _inst_3 _inst_4)) p q)) (HMul.hMul.{u2, u2, u2} (Set.{u2} M) (Set.{u2} M) (Set.{u2} M) (instHMul.{u2} (Set.{u2} M) (Set.mul.{u2} M _inst_3)) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))))) p) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))))) q))
but is expected to have type
  forall {R : Type.{u2}} {M : Type.{u1}} [_inst_1 : Monoid.{u2} R] [_inst_2 : MulAction.{u2, u1} R M _inst_1] [_inst_3 : Mul.{u1} M] [_inst_4 : IsScalarTower.{u2, u1, u1} R M M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2) (Mul.toSMul.{u1} M _inst_3) (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)] (p : SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (q : SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)), Eq.{succ u1} (Set.{u1} M) (SetLike.coe.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (HMul.hMul.{u1, u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (instHMul.{u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SubMulAction.instMulSubMulActionToSMul.{u2, u1} R M _inst_1 _inst_2 _inst_3 _inst_4)) p q)) (HMul.hMul.{u1, u1, u1} (Set.{u1} M) (Set.{u1} M) (Set.{u1} M) (instHMul.{u1} (Set.{u1} M) (Set.mul.{u1} M _inst_3)) (SetLike.coe.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) p) (SetLike.coe.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) q))
Case conversion may be inaccurate. Consider using '#align sub_mul_action.coe_mul SubMulAction.coe_mulₓ'. -/
@[norm_cast]
theorem coe_mul (p q : SubMulAction R M) : ↑(p * q) = (p * q : Set M) :=
  rfl
#align sub_mul_action.coe_mul SubMulAction.coe_mul

/- warning: sub_mul_action.mem_mul -> SubMulAction.mem_mul is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {M : Type.{u2}} [_inst_1 : Monoid.{u1} R] [_inst_2 : MulAction.{u1, u2} R M _inst_1] [_inst_3 : Mul.{u2} M] [_inst_4 : IsScalarTower.{u1, u2, u2} R M M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2) (Mul.toSMul.{u2} M _inst_3) (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)] {p : SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)} {q : SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)} {x : M}, Iff (Membership.Mem.{u2, u2} M (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SetLike.hasMem.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))) x (HMul.hMul.{u2, u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (instHMul.{u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SubMulAction.hasMul.{u1, u2} R M _inst_1 _inst_2 _inst_3 _inst_4)) p q)) (Exists.{succ u2} M (fun (y : M) => Exists.{succ u2} M (fun (z : M) => And (Membership.Mem.{u2, u2} M (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SetLike.hasMem.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))) y p) (And (Membership.Mem.{u2, u2} M (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SetLike.hasMem.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))) z q) (Eq.{succ u2} M (HMul.hMul.{u2, u2, u2} M M M (instHMul.{u2} M _inst_3) y z) x)))))
but is expected to have type
  forall {R : Type.{u2}} {M : Type.{u1}} [_inst_1 : Monoid.{u2} R] [_inst_2 : MulAction.{u2, u1} R M _inst_1] [_inst_3 : Mul.{u1} M] [_inst_4 : IsScalarTower.{u2, u1, u1} R M M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2) (Mul.toSMul.{u1} M _inst_3) (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)] {p : SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)} {q : SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)} {x : M}, Iff (Membership.mem.{u1, u1} M (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SetLike.instMembership.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2))) x (HMul.hMul.{u1, u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (instHMul.{u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SubMulAction.instMulSubMulActionToSMul.{u2, u1} R M _inst_1 _inst_2 _inst_3 _inst_4)) p q)) (Exists.{succ u1} M (fun (y : M) => Exists.{succ u1} M (fun (z : M) => And (Membership.mem.{u1, u1} M (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SetLike.instMembership.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2))) y p) (And (Membership.mem.{u1, u1} M (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SetLike.instMembership.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2))) z q) (Eq.{succ u1} M (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M _inst_3) y z) x)))))
Case conversion may be inaccurate. Consider using '#align sub_mul_action.mem_mul SubMulAction.mem_mulₓ'. -/
theorem mem_mul {p q : SubMulAction R M} {x : M} : x ∈ p * q ↔ ∃ y z, y ∈ p ∧ z ∈ q ∧ y * z = x :=
  Set.mem_mul
#align sub_mul_action.mem_mul SubMulAction.mem_mul

end Mul

section MulOneClass

variable [Monoid R] [MulAction R M] [MulOneClass M] [IsScalarTower R M M] [SMulCommClass R M M]

instance : MulOneClass (SubMulAction R M)
    where
  mul := (· * ·)
  one := 1
  mul_one a := by
    ext
    simp only [mem_mul, mem_one, mul_smul_comm, exists_and_left, exists_exists_eq_and, mul_one]
    constructor
    · rintro ⟨y, hy, r, rfl⟩
      exact smul_mem _ _ hy
    · intro hx
      exact ⟨x, hx, 1, one_smul _ _⟩
  one_mul a := by
    ext
    simp only [mem_mul, mem_one, smul_mul_assoc, exists_and_left, exists_exists_eq_and, one_mul]
    refine' ⟨_, fun hx => ⟨1, x, hx, one_smul _ _⟩⟩
    rintro ⟨r, y, hy, rfl⟩
    exact smul_mem _ _ hy

end MulOneClass

section Semigroup

variable [Monoid R] [MulAction R M] [Semigroup M] [IsScalarTower R M M]

instance : Semigroup (SubMulAction R M)
    where
  mul := (· * ·)
  mul_assoc a b c := SetLike.coe_injective (mul_assoc (_ : Set _) _ _)

end Semigroup

section Monoid

variable [Monoid R] [MulAction R M] [Monoid M] [IsScalarTower R M M] [SMulCommClass R M M]

instance : Monoid (SubMulAction R M) :=
  { SubMulAction.semigroup,
    SubMulAction.mulOneClass with
    mul := (· * ·)
    one := 1 }

/- warning: sub_mul_action.coe_pow -> SubMulAction.coe_pow is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {M : Type.{u2}} [_inst_1 : Monoid.{u1} R] [_inst_2 : MulAction.{u1, u2} R M _inst_1] [_inst_3 : Monoid.{u2} M] [_inst_4 : IsScalarTower.{u1, u2, u2} R M M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2) (Mul.toSMul.{u2} M (MulOneClass.toHasMul.{u2} M (Monoid.toMulOneClass.{u2} M _inst_3))) (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)] [_inst_5 : SMulCommClass.{u1, u2, u2} R M M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2) (Mul.toSMul.{u2} M (MulOneClass.toHasMul.{u2} M (Monoid.toMulOneClass.{u2} M _inst_3)))] (p : SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) {n : Nat}, (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{succ u2} (Set.{u2} M) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))))) (HPow.hPow.{u2, 0, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) Nat (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (instHPow.{u2, 0} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) Nat (Monoid.Pow.{u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SubMulAction.monoid.{u1, u2} R M _inst_1 _inst_2 _inst_3 _inst_4 _inst_5))) p n)) (HPow.hPow.{u2, 0, u2} (Set.{u2} M) Nat (Set.{u2} M) (instHPow.{u2, 0} (Set.{u2} M) Nat (Set.NPow.{u2} M (MulOneClass.toHasOne.{u2} M (Monoid.toMulOneClass.{u2} M _inst_3)) (MulOneClass.toHasMul.{u2} M (Monoid.toMulOneClass.{u2} M _inst_3)))) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))))) p) n))
but is expected to have type
  forall {R : Type.{u2}} {M : Type.{u1}} [_inst_1 : Monoid.{u2} R] [_inst_2 : MulAction.{u2, u1} R M _inst_1] [_inst_3 : Monoid.{u1} M] [_inst_4 : IsScalarTower.{u2, u1, u1} R M M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2) (MulAction.toSMul.{u1, u1} M M _inst_3 (Monoid.toMulAction.{u1} M _inst_3)) (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)] [_inst_5 : SMulCommClass.{u2, u1, u1} R M M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2) (MulAction.toSMul.{u1, u1} M M _inst_3 (Monoid.toMulAction.{u1} M _inst_3))] (p : SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) {n : Nat}, (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{succ u1} (Set.{u1} M) (SetLike.coe.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (HPow.hPow.{u1, 0, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) Nat (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (instHPow.{u1, 0} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) Nat (Monoid.Pow.{u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SubMulAction.instMonoidSubMulActionToSMul.{u2, u1} R M _inst_1 _inst_2 _inst_3 _inst_4 _inst_5))) p n)) (HPow.hPow.{u1, 0, u1} (Set.{u1} M) Nat (Set.{u1} M) (instHPow.{u1, 0} (Set.{u1} M) Nat (Set.NPow.{u1} M (Monoid.toOne.{u1} M _inst_3) (MulOneClass.toMul.{u1} M (Monoid.toMulOneClass.{u1} M _inst_3)))) (SetLike.coe.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) p) n))
Case conversion may be inaccurate. Consider using '#align sub_mul_action.coe_pow SubMulAction.coe_powₓ'. -/
theorem coe_pow (p : SubMulAction R M) : ∀ {n : ℕ} (hn : n ≠ 0), ↑(p ^ n) = (p ^ n : Set M)
  | 0, hn => (hn rfl).elim
  | 1, hn => by rw [pow_one, pow_one]
  | n + 2, hn => by rw [pow_succ _ (n + 1), pow_succ _ (n + 1), coe_mul, coe_pow n.succ_ne_zero]
#align sub_mul_action.coe_pow SubMulAction.coe_pow

/- warning: sub_mul_action.subset_coe_pow -> SubMulAction.subset_coe_pow is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {M : Type.{u2}} [_inst_1 : Monoid.{u1} R] [_inst_2 : MulAction.{u1, u2} R M _inst_1] [_inst_3 : Monoid.{u2} M] [_inst_4 : IsScalarTower.{u1, u2, u2} R M M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2) (Mul.toSMul.{u2} M (MulOneClass.toHasMul.{u2} M (Monoid.toMulOneClass.{u2} M _inst_3))) (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)] [_inst_5 : SMulCommClass.{u1, u2, u2} R M M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2) (Mul.toSMul.{u2} M (MulOneClass.toHasMul.{u2} M (Monoid.toMulOneClass.{u2} M _inst_3)))] (p : SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) {n : Nat}, HasSubset.Subset.{u2} (Set.{u2} M) (Set.hasSubset.{u2} M) (HPow.hPow.{u2, 0, u2} (Set.{u2} M) Nat (Set.{u2} M) (instHPow.{u2, 0} (Set.{u2} M) Nat (Set.NPow.{u2} M (MulOneClass.toHasOne.{u2} M (Monoid.toMulOneClass.{u2} M _inst_3)) (MulOneClass.toHasMul.{u2} M (Monoid.toMulOneClass.{u2} M _inst_3)))) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))))) p) n) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) M (SubMulAction.setLike.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2))))) (HPow.hPow.{u2, 0, u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) Nat (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (instHPow.{u2, 0} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) Nat (Monoid.Pow.{u2} (SubMulAction.{u1, u2} R M (MulAction.toHasSmul.{u1, u2} R M _inst_1 _inst_2)) (SubMulAction.monoid.{u1, u2} R M _inst_1 _inst_2 _inst_3 _inst_4 _inst_5))) p n))
but is expected to have type
  forall {R : Type.{u2}} {M : Type.{u1}} [_inst_1 : Monoid.{u2} R] [_inst_2 : MulAction.{u2, u1} R M _inst_1] [_inst_3 : Monoid.{u1} M] [_inst_4 : IsScalarTower.{u2, u1, u1} R M M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2) (MulAction.toSMul.{u1, u1} M M _inst_3 (Monoid.toMulAction.{u1} M _inst_3)) (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)] [_inst_5 : SMulCommClass.{u2, u1, u1} R M M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2) (MulAction.toSMul.{u1, u1} M M _inst_3 (Monoid.toMulAction.{u1} M _inst_3))] (p : SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) {n : Nat}, HasSubset.Subset.{u1} (Set.{u1} M) (Set.instHasSubsetSet.{u1} M) (HPow.hPow.{u1, 0, u1} (Set.{u1} M) Nat (Set.{u1} M) (instHPow.{u1, 0} (Set.{u1} M) Nat (Set.NPow.{u1} M (Monoid.toOne.{u1} M _inst_3) (MulOneClass.toMul.{u1} M (Monoid.toMulOneClass.{u1} M _inst_3)))) (SetLike.coe.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) p) n) (SetLike.coe.{u1, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) M (SubMulAction.instSetLikeSubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (HPow.hPow.{u1, 0, u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) Nat (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (instHPow.{u1, 0} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) Nat (Monoid.Pow.{u1} (SubMulAction.{u2, u1} R M (MulAction.toSMul.{u2, u1} R M _inst_1 _inst_2)) (SubMulAction.instMonoidSubMulActionToSMul.{u2, u1} R M _inst_1 _inst_2 _inst_3 _inst_4 _inst_5))) p n))
Case conversion may be inaccurate. Consider using '#align sub_mul_action.subset_coe_pow SubMulAction.subset_coe_powₓ'. -/
theorem subset_coe_pow (p : SubMulAction R M) : ∀ {n : ℕ}, (p ^ n : Set M) ⊆ ↑(p ^ n)
  | 0 => by
    rw [pow_zero, pow_zero]
    exact subset_coe_one
  | n + 1 => (coe_pow p n.succ_ne_zero).Superset
#align sub_mul_action.subset_coe_pow SubMulAction.subset_coe_pow

end Monoid

end SubMulAction


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

import LeanColls.AuxLemmas

namespace List

@[specialize]
def foldl' : (l : List τ) → (β → (x : τ) → x ∈ l → β) → β → β
| []   , _, acc => acc
| x::xs, f, acc =>
  have h' : ∀ {x'}, x' ∈ xs → x' ∈ x::xs := List.Mem.tail x
  foldl' xs (λ acc x h => f acc x (h' h)) (f acc x (List.Mem.head _ _))

def foldr' : (l : List τ) → ((x : τ) → x ∈ l → β → β) → β → β
| []   , _, acc => acc
| x::xs, f, acc =>
  have h' : ∀ {x'}, x' ∈ xs → x' ∈ x::xs := List.Mem.tail x
  f x (List.Mem.head _ _) (foldr' xs (λ x h acc => f x (h' h) acc) acc)

theorem foldl_eq_foldl' (c : List τ) (f : β → τ → β) (acc : β)
  : foldl f acc c = foldl' c (λ acc x _ => f acc x) acc
  := by
  induction c generalizing acc with
  | nil => simp [foldl, foldl']
  | cons x xs ih =>
    simp [foldl, foldl']
    apply ih (f acc x)

theorem foldr_eq_foldr' (c : List τ) (f : τ → β → β) (acc : β)
  : foldr f acc c = foldr' c (λ x _ acc => f x acc) acc
  := by
  induction c with
  | nil => simp [foldr, foldr']
  | cons x xs ih =>
    simp [foldr, foldr', ih]

lemma foldl'_eq_subtypeByMemAux_foldl (l : List τ)
  (f : β → (x : τ) → x ∈ l → β) (acc : β)
  (c : List τ) (h : ∀ x, x ∈ c → x ∈ l)
  : foldl' c (fun acc x h' => f acc x (h x h')) acc
    = foldl (fun acc ⟨x,h⟩ => f acc x h) acc (subtypeByMem.aux l c h)
  := by
  induction c generalizing acc with
  | nil =>
    simp [foldl', subtypeByMem.aux, foldl]
  | cons x xs ih =>
    conv =>
      lhs
      simp [foldl']
      rw [ih]

theorem foldl'_eq_subtypeByMem_foldl (l : List τ)
  (f : β → (x : τ) → x ∈ l → β) (acc : β)
  : foldl' l f acc = foldl (fun acc ⟨x,h⟩ => f acc x h) acc l.subtypeByMem
  := by
  apply foldl'_eq_subtypeByMemAux_foldl

lemma foldr'_eq_subtypeByMemAux_foldr (l : List τ)
  (f : (x : τ) → x ∈ l → β → β) (acc : β)
  (c : List τ) (h : ∀ x, x ∈ c → x ∈ l)
  : foldr' c (fun x h' acc => f x (h x h') acc) acc
    = foldr (fun ⟨x,h⟩ acc => f x h acc) acc (subtypeByMem.aux l c h)
  := by
  induction c generalizing acc with
  | nil =>
    simp [foldr', subtypeByMem.aux]
  | cons x xs ih =>
    conv =>
      lhs
      simp [foldr']
      rw [ih]

theorem foldr'_eq_subtypeByMem_foldr (l : List τ)
  (f : (x : τ) → x ∈ l → β → β) (acc : β)
  : foldr' l f acc = foldr (fun ⟨x,h⟩ acc => f x h acc) acc l.subtypeByMem
  := by
  apply foldr'_eq_subtypeByMemAux_foldr

def map' (L : List τ) (f : (x : τ) → x ∈ L → τ') :=
  L.subtypeByMem.map (fun ⟨x,h⟩ => f x h)

@[simp]
theorem length_map' (L : List τ) (f : (x : τ) → x ∈ L → τ')
  : (L.map' f).length = L.length
  := by simp [map']

theorem map_of_subtypeByMem_eq_map' (L : List τ) (f : {x // x ∈ L} → τ')
  : L.subtypeByMem.map f = L.map' (fun x h => f ⟨x,h⟩)
  := by
  rw [map']

theorem foldr_of_map' (L : List τ) (mapf : (x : _) → _ → τ')
  (f) (acc : β)
  : foldr f acc (map' L mapf) = foldr' L (fun x h acc => f (mapf x h) acc) acc
  := by
  simp [foldr'_eq_subtypeByMem_foldr, map', foldr_map]

theorem foldr'_eq_map' (L : List τ) (f : (x : _) → _ → τ')
  : foldr' L (fun x h acc => f x h :: acc) [] = map' L f
  := by
  rw [foldr'_eq_subtypeByMem_foldr]
  rw [map']
  rw [List.foldr_eq_map]

theorem foldl'_eq_map' (L : List τ) (f : (x : _) → _ → τ')
  : foldl' L (fun acc x h => acc ++ [f x h]) [] = map' L f
  := by
  rw [foldl'_eq_subtypeByMem_foldl]
  rw [map']
  rw [List.foldl_eq_map]

def subtypeByMem_rw {L : List τ} (L') (h : L = L')
  : L.subtypeByMem = L'.subtypeByMem.map (fun ⟨x,h'⟩ => ⟨x,h.symm.subst h'⟩)
  := by
  cases h
  conv => lhs; rw [←map_id (subtypeByMem L)]

def map'_rw {L : List τ} {f : (x : τ) → x ∈ L → τ'} (L' : List τ) (h : L = L')
  : L.map' f = L'.map' (fun x h' => f x (h.symm.subst h'))
  := by
  cases h
  congr

def foldl'_rw (L : List τ) (f : β → (x : τ) → x ∈ L → β) (init) (L' : List τ) (h : L = L')
  : L.foldl' f init = L'.foldl' (fun acc x h' => f acc x (h.symm.subst h')) init
  := by
  cases h
  congr

def foldr'_rw (L : List τ) (f : (x : τ) → x ∈ L → β → β) (init) (L' : List τ) (h : L = L')
  : L.foldr' f init = L'.foldr' (fun x h' acc => f x (h.symm.subst h') acc) init
  := by
  cases h
  congr

lemma subtypeByMemAux_append {L : List τ} {L₁ L₂}
  (h : ∀ x, x ∈ L₁ ++ L₂ → x ∈ L)
  : subtypeByMem.aux L (L₁ ++ L₂) h
    = subtypeByMem.aux L L₁ (fun a ha =>
        h a (List.mem_append_left _ ha))
      ++ subtypeByMem.aux L L₂ (fun a ha =>
        h a (List.mem_append_right _ ha))
  := by
  induction L₁ with
  | nil => simp [subtypeByMem.aux]
  | cons x xs ih =>
    simp [subtypeByMem.aux]
    rw [ih]

lemma subtypeByMemAux_eq_map_subtypeByMem (L₁ L₂ : List τ) (h)
  : subtypeByMem.aux L₁ L₂ h =
    L₂.subtypeByMem.map (fun ⟨x,h'⟩ => ⟨x, h _ h'⟩)
  := by
  simp [subtypeByMem]
  suffices ∀ L hL,
    subtypeByMem.aux L₁ L (fun x h' => h _ (hL _ h'))
    = map _ (subtypeByMem.aux L₂ L hL)
    from this L₂ (by simp)
  intro L h
  induction L with
  | nil => simp [subtypeByMem.aux]
  | cons x xs ih =>
    simp [subtypeByMem.aux]
    rw [ih]

theorem subtypeByMem_append (L₁ L₂ : List τ)
  : subtypeByMem (L₁ ++ L₂) =
    L₁.subtypeByMem.map (fun ⟨x,h⟩ => ⟨x, List.mem_append_left _ h⟩)
    ++ L₂.subtypeByMem.map (fun ⟨x,h⟩ => ⟨x, List.mem_append_right _ h⟩)
  := by
  conv => lhs; simp [subtypeByMem]
  rw [subtypeByMemAux_append]
  simp [subtypeByMemAux_eq_map_subtypeByMem]

theorem mem_of_subtypeByMemAux (L : List τ) (L') (h)
  : ∀ x, x ∈ subtypeByMem.aux L L' h ↔ x.val ∈ L'
  := by
  intro x
  induction L' with
  | nil => cases x; simp [subtypeByMem.aux]
  | cons y ys ih =>
  cases x; case mk v vMem =>
  simp [subtypeByMem.aux]
  rw [ih]

theorem mem_of_subtypeByMem (L : List τ)
  : ∀ x h, ⟨x,h⟩ ∈ subtypeByMem L
  := by
  intro x h
  simp [subtypeByMem]
  rw [mem_of_subtypeByMemAux]
  exact h

theorem mem_of_map' (L : List τ) (f : (x : _) → _ → τ')
  : ∀ x, (h : x ∈ L) → f x h ∈ L.map' f
  := by
  intro x h
  simp [map', subtypeByMem]
  suffices ∀ rest h_rest, x ∈ rest → f x h ∈ map (fun ⟨x,h⟩ => f x h)
                  (subtypeByMem.aux L rest h_rest)
    from this L (by simp) h
  intro rest h_rest h_x
  induction rest with
  | nil => simp at h_x
  | cons y ys ih =>
  cases h_x
  case head =>
    simp [subtypeByMem.aux]
  case tail h_x =>
  simp [subtypeByMem.aux]
  apply Or.inr
  apply ih
  exact h_x

theorem subtypeByMem_map' (L : List τ) (f : (x : τ) → x ∈ L → τ')
  : subtypeByMem (L.map' f) = L.map' (fun x h => ⟨f x h, mem_of_map' _ _ _ h⟩)
  := by
  simp [map', subtypeByMem]
  suffices ∀ rest
    (h_rest : (x : τ) → x ∈ rest → x ∈ L)
    (h_one : (x : τ')
              → x ∈ map (fun ⟨x,h⟩ => f x h) (subtypeByMem.aux L rest h_rest)
              → x ∈ map' L f)
    (h' : (x : τ) → (h : x ∈ L) → _),
    subtypeByMem.aux (map' L f)
      (map (fun ⟨x,h⟩ => f x h) (subtypeByMem.aux L rest h_rest))
      (h_one) =
    map (fun ⟨x,h⟩ => { val := f x h, property := h' x h })
      (subtypeByMem.aux L rest h_rest)
    from this L (by simp)
      (by intro x h; simp [map', h, subtypeByMem])
      (by intro x h; simp [mem_of_map'])
  intro rest h_rest h_one h'
  induction rest with
  | nil => simp [subtypeByMem.aux]
  | cons x xs ih =>
    simp [subtypeByMem.aux, ih]

theorem foldl'_append {β : Type u} (L₁ L₂ : List τ) (f : β → (x : τ) → x ∈ L₁ ++ L₂ → β) (init)
  : foldl' (L₁ ++ L₂) f init =
    foldl' L₂ (fun acc x h => f acc x (List.mem_append_right _ h))
      (foldl' L₁ (fun acc x h => f acc x (List.mem_append_left _ h)) init)
  := by
  rw [foldl'_eq_subtypeByMem_foldl, foldl'_eq_subtypeByMem_foldl, foldl'_eq_subtypeByMem_foldl]
  simp
  rw [subtypeByMem_append]
  simp [foldl_map, foldl_append]

def sum [AddMonoid τ] : List τ → τ
| [] => 0
| x::xs => x + sum xs

theorem get_le_sum (L : List Nat) (i : Nat) (h_i : i < L.length)
  : L.get ⟨i,h_i⟩ ≤ L.sum
  := by
  induction L generalizing i with
  | nil =>
    contradiction
  | cons x xs ih =>
    match i with
    | 0 =>
      simp [get, sum]
      apply Nat.le_add_right
    | i+1 =>
      simp [get, sum]
      rw [←Nat.zero_add (get _ _)]
      apply Nat.add_le_add (Nat.zero_le x)
      apply ih

theorem sum_set (L : List Nat) (i : Nat) (w : Nat) (h_i : i < L.length)
  : sum (L.set i w) = sum L - (L.get ⟨i,h_i⟩) + w
  := by
  induction L generalizing i with
  | nil => contradiction
  | cons x xs ih =>
  match xs, i with
  | [], 0 =>
    simp [set, sum, get]
  | [], _+1 =>
    contradiction
  | y :: z, 0 =>
    simp [set, sum, get]
    rw [Nat.add_comm x, Nat.add_sub_cancel, Nat.add_comm w]
  | y :: z, i+1 =>
    simp [set, sum, get]
    rw [ih]
    generalize h : get _ _ = g
    have : g ≤ y + sum z := by
      rw [←h]
      apply get_le_sum
    clear h ih
    simp [sum]
    rw [Nat.add_sub_assoc this,
        Nat.add_assoc x]