import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- For each $n$, let $\mathbf A_n$ be the formula:
  -- $\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$
  let A : ℕ → L.Formula := λ n, L.exists (L.var 1) (L.exists (L.var 2) (L.exists (L.var 3) (L.exists (L.var 4) (L.exists (L.var 5) (L.exists (L.var 6) (L.exists (L.var 7) (L.exists (L.var 8) (L.exists (L.var 9) (L.exists (L.var 10) (L.exists (L.var 11) (L.exists (L.var 12) (L.exists (L.var 13) (L.exists (L.var 14) (L.exists (L.var 15) (L.exists (L.var 16) (L.exists (L.var 17) (L.exists (L.var 18) (L.exists (L.var 19) (L.exists (L.var 20) (L.exists (L.var 21) (L.exists (L.var 22) (L.exists (L.var 23) (L.exists (L.var 24) (L.exists (L.var 25) (L.exists (L.var 26) (L.exists (L.var 27) (L.exists (L.var 28) (L.exists (L.var 29) (L.exists (L.var 30) (L.exists (L.var 31) (L.exists (L.var 32) (L.exists (L.var 33) (L.exists (L.var 34) (L.exists (L.var 35) (L.exists (L.var 36) (L.exists (L.var 37) (L.exists (L.var 38) (L.exists (L.var 39) (L.exists (L.var 40) (L.exists (L.var 41) (L.exists (L.var 42) (L.exists (L.var 43) (L.exists (L.var 44) (L.exists (L.var 45) (L.exists (L.var 46) (L.exists (L.var 47) (L.exists (L.var 48) (L.exists (L.var 49) (L.exists (L.var 50) (L.exists (L.var 51) (L.exists (L.var 52) (L.exists (L.var 53) (L.exists (L.var 54) (L.exists (L.var 55) (L.exists (L.var 56) (L.exists (L.var 57) (L.exists (L.var 58) (L.exists (L.var 59) (L.exists (L.var 60) (L.exists (L.var 61) (L.exists (L.var 62) (L.exists (L.var 63) (L.exists (L.var 64) (L.exists (L.var 65) (L.exists (L.var 66) (L.exists (L.var 67) (L.exists (L.var 68) (L.exists (L.var 69) (L.exists (L.var 70) (L.exists (L.var 71) (L.exists (L.var 72) (L.exists (L.var 73) (L.exists (L.var 74) (L.exists (L.var 75) (L.exists (L.var 76) (L.exists (L.var 77) (L.exists (L.var 78) (L.exists (L.var 79) (L.exists (L.var 80) (L.exists (L.var 81) (L.exists (L.var 82) (L.exists (L.var 83) (L.exists (L.var 84) (L.exists (L.var 85) (L.exists (L.var 86) (L.exists (L.var 87) (L.exists (L.var 88) (L.exists (L.var 89) (L.exists (L.var 90) (L.exists (L.var 91) (L.exists (L.var 92) (L.exists (L.var 93) (L.exists (L.var 94) (L.exists (L.var 95) (L.exists (L.var 96) (L.exists (L.var 97) (L.exists (L.var 98) (L.exists (L.var 99) (L.exists (L.var 100) (L.exists (L.var 101) (L.exists (L.var 102) (L.exists (L.var 103) (L.exists (L.var 104) (L.exists (L.var 105) (L.exists (L.var 106) (L.exists (L.var 107) (L.exists (L.var 108) (L.exists (L.var 109) (L.exists (L.var 110) (L.exists (L.var 111) (L.exists (L.var 112) (L.exists (L.var 113) (L.exists (L.var 114) (L.exists (L.var 115) (L.exists (L.var 116) (L.exists (L.var 117) (L.exists (L.var 118) (L.exists (L.var 119) (L.exists (L.var 120) (L.exists (L.var 121) (L.exists (L.var 122) (L.exists (L.var 123) (L.exists (L.var 124) (L.exists (L.var 125) (L.exists (L.var 126) (L.exists (L.var 127) (L.exists (L.var 128) (L.exists (L.var 129) (L.exists (L.var 130) (L.exists (L.var 131) (L.exists (L.var 132) (L.exists (L.var 133) (L.exists (L.var 134) (L.exists (L.var 135) (L.exists (L.var 136) (L.exists (L.var 137) (L.exists (L.var 138) (L.exists (L.var 139) (L.exists (L.var 140) (L.exists (L.var 141) (L.exists (L.var 142) (L.exists (L.var 143) (L.exists (L.var 144) (L.exists (L.var 145) (L.exists (L.var 146) (L.exists (L.var 147) (L.exists (L.var 148) (L.exists (L.var 149) (L.exists (L.var 150) (L.exists (L.var 151) (L.exists (L.var 152) (L.exists (L.var 153) (L.exists (L.var 154) (L.exists (L.var 155) (L.exists (L.var 156) (L.exists (L.var 157) (L.exists (L.var 158) (L.exists (L.var 159) (L.exists (L.var 160) (L.exists (L.var 161) (L.exists (L.var 162) (L.exists (L.var 163) (L.exists (L.var 164) (L.exists (L.var 165) (L.exists (L.var 166) (L.exists (L.var 167) (L.exists (L.var 168) (L.exists (L.var 169) (L.exists (L.var 170) (L.exists (L.var 171) (L.exists (L.var 172) (L.
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- For each $n$, let $\mathbf A_n$ be the formula:
  let A := λ n : ℕ, ∃ x₁ x₂ (xs : fin n → L.S), ∀ i j : fin n, (i ≠ j) → (x₁ ≠ x₂),
  -- Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.
  have h1 : ∀ n : ℕ, ∀ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin → F.Model.satisfies m (A n), from by auto [fintype.card_pos_iff, exists_fin_iff_finite, exists_fin_iff_finite, exists_fin_iff_finite, exists_fin_iff_finite],
  -- Take:
  -- $$\Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i$$
  let Γ := F.set ∪ (⋃ n : ℕ, A n),
  -- Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.
  have h2 : ∀ (Γ' : set L.Formula) [finite Γ'], Γ' ⊆ Γ → ∃ (m : F.Model), ∀ (φ : L.Formula), φ ∈ Γ' → F.Model.satisfies m φ, from by auto [fintype.card_pos_iff, exists_fin_iff_finite, exists_fin_iff_finite, exists_fin_iff_finite, exists_fin_iff_finite, h],
  -- From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.
  have h3 : ∃ (m : F.Model), ∀ (φ : L.Formula), φ ∈ Γ → F.Model.satisfies m φ, from by auto [h2],
  -- But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.
  have h4 : ∃ (M : F.Model), infinite M, from by auto [h3, h1],
  -- So $F$ has an infinite model.
  show ∃ (M : F.Model), infinite M, from h4,
end

--OUTPUT 3
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- For each $n$, let $\mathbf A_n$ be the formula:
  let A_n : L.formula := ∃' (x : L.sort), (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠ x) ∧ (x ≠
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- For each $n$, let $\mathbf A_n$ be the formula:
  let A := λ n : ℕ, ∃ (x1 : L.sort) (x2 : L.sort) (x3 : L.sort) (x4 : L.sort) (x5 : L.sort) (x6 : L.sort) (x7 : L.sort) (x8 : L.sort) (x9 : L.sort) (x10 : L.sort) (x11 : L.sort) (x12 : L.sort) (x13 : L.sort) (x14 : L.sort) (x15 : L.sort) (x16 : L.sort) (x17 : L.sort) (x18 : L.sort) (x19 : L.sort) (x20 : L.sort) (x21 : L.sort) (x22 : L.sort) (x23 : L.sort) (x24 : L.sort) (x25 : L.sort) (x26 : L.sort) (x27 : L.sort) (x28 : L.sort) (x29 : L.sort) (x30 : L.sort) (x31 : L.sort) (x32 : L.sort) (x33 : L.sort) (x34 : L.sort) (x35 : L.sort) (x36 : L.sort) (x37 : L.sort) (x38 : L.sort) (x39 : L.sort) (x40 : L.sort),
  (∀ (x : L.sort), x ≠ x1) ∧ (∀ (x : L.sort), x ≠ x2) ∧ (∀ (x : L.sort), x ≠ x3) ∧ (∀ (x : L.sort), x ≠ x4) ∧ (∀ (x : L.sort), x ≠ x5) ∧ (∀ (x : L.sort), x ≠ x6) ∧ (∀ (x : L.sort), x ≠ x7) ∧ (∀ (x : L.sort), x ≠ x8) ∧ (∀ (x : L.sort), x ≠ x9) ∧ (∀ (x : L.sort), x ≠ x10) ∧ (∀ (x : L.sort), x ≠ x11) ∧ (∀ (x : L.sort), x ≠ x12) ∧ (∀ (x : L.sort), x ≠ x13) ∧ (∀ (x : L.sort), x ≠ x14) ∧ (∀ (x : L.sort), x ≠ x15) ∧ (∀ (x : L.sort), x ≠ x16) ∧ (∀ (x : L.sort), x ≠ x17) ∧ (∀ (x : L.sort), x ≠ x18) ∧ (∀ (x : L.sort), x ≠ x19) ∧ (∀ (x : L.sort), x ≠ x20) ∧ (∀ (x : L.sort), x ≠ x21) ∧ (∀ (x : L.sort), x ≠ x22) ∧ (∀ (x : L.sort), x ≠ x23) ∧ (∀ (x : L.sort), x ≠ x24) ∧ (∀ (x : L.sort), x ≠ x25) ∧ (∀ (x : L.sort), x ≠ x26) ∧ (∀ (x : L.sort), x ≠ x27) ∧ (∀ (x : L.sort), x ≠ x28) ∧ (∀ (x : L.sort), x ≠ x29) ∧ (∀ (x : L.sort), x ≠ x30) ∧ (∀ (x : L.sort), x ≠ x31) ∧ (∀ (x : L.sort), x ≠ x32) ∧ (∀ (x : L.sort), x ≠ x33) ∧ (∀ (x : L.sort), x ≠ x34) ∧ (∀ (x : L.sort), x ≠ x35) ∧ (∀ (x : L.sort), x ≠ x36) ∧ (∀ (x : L.sort), x ≠ x37) ∧ (∀ (x : L.sort), x ≠ x38) ∧ (∀ (x : L.sort), x ≠ x39) ∧ (∀ (x : L.sort), x ≠ x40),
  -- Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.
  have h1 : ∀ (n : ℕ) (M : F.Model) (h : (A n) M), n ≤ @fintype.card M (fintype.of_finset (M.universe)), from by auto [fintype.card_le_of_subset],
  have h2 : ∀ (n : ℕ) (M : F.Model) (h : (A n) M), infinite M, from by auto [h1, h],
  have h3 : ∀ (n : ℕ), (A n) ∈ F.Theory, from by auto [exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_imp_nonempty, exists_
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- For each $n$, let $\mathbf A_n$ be the formula:
  let A : ℕ → L.formula := λ n, ∃ (x₁ : L.sort) (x₂ : L.sort) (x₃ : L.sort) (x₄ : L.sort) (x₅ : L.sort) (x₆ : L.sort) (x₇ : L.sort) (x₈ : L.sort) (x₉ : L.sort) (x₁₀ : L.sort) (x₁₁ : L.sort) (x₁₂ : L.sort) (x₁₃ : L.sort) (x₁₄ : L.sort) (x₁₅ : L.sort) (x₁₆ : L.sort) (x₁₇ : L.sort) (x₁₈ : L.sort) (x₁₉ : L.sort) (x₂₀ : L.sort) (x₂₁ : L.sort) (x₂₂ : L.sort) (x₂₃ : L.sort) (x₂₄ : L.sort) (x₂₅ : L.sort) (x₂₆ : L.sort) (x₂₇ : L.sort) (x₂₈ : L.sort) (x₂₉ : L.sort) (x₃₀ : L.sort) (x₃₁ : L.sort) (x₃₂ : L.sort) (x₃₃ : L.sort) (x₃₄ : L.sort) (x₃₅ : L.sort) (x₃₆ : L.sort) (x₃₇ : L.sort) (x₃₈ : L.sort) (x₃₉ : L.sort) (x₄₀ : L.sort) (x₄₁ : L.sort) (x₄₂ : L.sort) (x₄₃ : L.sort) (x₄₄ : L.sort) (x₄₅ : L.sort) (x₄₆ : L.sort) (x₄₇ : L.sort) (x₄₈ : L.sort) (x₄₉ : L.sort) (x₅₀ : L.sort) (x₅₁ : L.sort) (x₅₂ : L.sort) (x₅₃ : L.sort) (x₅₄ : L.sort) (x₅₅ : L.sort) (x₅₆ : L.sort) (x₅₇ : L.sort) (x₅₈ : L.sort) (x₅₉ : L.sort) (x₆₀ : L.sort) (x₆₁ : L.sort) (x₆₂ : L.sort) (x₆₃ : L.sort) (x₆₄ : L.sort) (x₆₅ : L.sort) (x₆₆ : L.sort) (x₆₇ : L.sort) (x₆₈ : L.sort) (x₆₉ : L.sort) (x₇₀ : L.sort) (x₇₁ : L.sort) (x₇₂ : L.sort) (x₇₃ : L.sort) (x₇₄ : L.sort) (x₇₅ : L.sort) (x₇₆ : L.sort) (x₇₇ : L.sort) (x₇₈ : L.sort) (x₇₉ : L.sort) (x₈₀ : L.sort) (x₈₁ : L.sort) (x₈₂ : L.sort) (x₈₃ : L.sort) (x₈₄ : L.sort) (x₈₅ : L.sort) (x₈₆ : L.sort) (x₈₇ : L.sort) (x₈₈ : L.sort) (x₈₉ : L.sort) (x₉₀ : L.sort) (x₉₁ : L.sort) (x₉₂ : L.sort) (x₉₃ : L.sort) (x₉₄ : L.sort) (x₉₅ : L.sort) (x₉₆ : L.sort) (x₉₇ : L.sort) (x₉₈ : L.sort) (x₉₉ : L.sort) (x₁₀₀ : L.sort) (x₁₀₁ : L.sort) (x₁₀₂ : L.sort) (x₁₀₃ : L.sort) (x₁₀₄ : L.sort) (x₁₀₅ : L.sort) (x₁₀₆ : L.sort) (x₁₀₇ : L.sort) (x₁₀₈ : L.sort) (x₁₀₉ : L.sort) (x₁₁₀ : L.sort) (x₁₁₁ : L.sort) (x₁₁₂ : L.sort) (x₁₁₃ : L.sort) (x₁₁₄ : L.sort) (x₁₁₅ : L.sort) (x₁₁₆ : L.sort) (x₁₁₇ : L.sort) (x₁₁₈ : L.sort) (x₁₁₉ : L.sort) (x₁₂₀ : L.sort) (x₁₂₁ : L.sort) (x₁₂₂ : L.sort) (x₁₂₃ : L.sort) (x₁₂₄ : L.sort) (x₁₂₅ : L.sort) (x₁₂₆ : L.sort) (x₁₂₇ : L.sort) (x₁₂₈ : L.sort) (x₁₂₉ : L.sort) (x₁₃₀ : L.sort) (x₁₃₁ : L.sort) (x₁₃₂ : L.sort) (x₁₃₃ : L.sort) (x₁₃₄ : L.sort) (x₁₃₅ : L.sort) (x₁₃₆ : L.sort) (x₁₃₇ : L.sort) (x₁₃₈ : L.sort) (x₁₃₉ : L.sort) (x₁₄₀ : L.sort) (x₁₄₁ : L.sort) (x₁₄₂ : L.sort) (x₁₄
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- for each $n$, let $\mathbf A_n$ be the formula:
  let A : ℕ → L.formula,
  -- $\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$
  have A_def : ∀ n : ℕ, A n = L.exists (λ i : fin n, L.ne (L.var i) (L.var (fin.succ i))), from by auto [L.exists, L.ne],

  -- Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.
  have A_iff : ∀ (n : ℕ) (M : F.Model), M ⊨ A n ↔ n ≤ fintype.card M, from by auto [A_def, F.exists, F.ne, F.iff_iff_eq],

  -- Take:
  let Γ : L.Theory,
  -- $$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$
  have Γ_def : Γ = L.Theory.mk (F.formulas ∪ (⋃ i : ℕ, {A i})) (F.axioms ∪ (⋃ i : ℕ, {A i})), from by auto [L.Theory.mk],

  -- Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.
  have h1 : ∀ (Γ' : L.Theory) [hΓ' : finite Γ'], ∃ (M : F.Model), M ⊨ Γ', from
  begin
    assume (Γ' : L.Theory) [hΓ' : finite Γ'],
    -- let $n$ be the largest $n$ such that $A_n \in \Gamma'$
    let n : ℕ,
    have n_def : n = finset.max (finset.image A (finset.to_finset Γ'.formulas)), from by auto [finset.max],

    -- then $\Gamma'$ is satisfiable in a model of size $n + 1$
    have h1 : ∃ (M : F.Model), M ⊨ Γ', from
    begin
      -- let $M$ be a model of size $n + 1$
      let M : F.Model,
      have M_def : M = classical.some (h (n+1)), from by auto [h, classical.some_spec],

      -- then $M$ satisfies $\Gamma'$
      have h1 : M ⊨ Γ', from
      begin
        -- $M$ satisfies $F$
        have h1 : M ⊨ F, from by auto [F.Theory.mk, Γ_def],
        -- $M$ satisfies $A_n$
        have h2 : M ⊨ A n, from by auto [A_iff, M_def, n_def, finset.max_mem, finset.to_finset_nonempty, finset.mem_image, finset.mem_to_finset, finset.to_finset_subset, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_finset_to_set, finset.to_f
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Overflow theorem
Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size. Then $F$ has an infinite model.
`proof`
For each $n$, let $\mathbf A_n$ be the formula:

$\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$

Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.

Take:
$$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$

Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.

From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.

But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.

So $F$ has an infinite model.

QED
-/
theorem  overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.nat.basic
import Mathlib.Lean3Lib.init.data.prod

universes u l v

namespace Mathlib

inductive acc {α : Sort u} (r : α → α → Prop) : α → Prop
where
| intro : ∀ (x : α), (∀ (y : α), r y x → acc r y) → acc r x

namespace acc

def inv {α : Sort u} {r : α → α → Prop} {x : α} {y : α} (h₁ : acc r x) (h₂ : r y x) : acc r y :=
  acc.rec_on h₁
    (fun (x₁ : α) (ac₁ : ∀ (y : α), r y x₁ → acc r y) (ih : ∀ (y_1 : α), r y_1 x₁ → r y y_1 → acc r y) (h₂ : r y x₁) =>
      ac₁ y h₂)
    h₂

end acc

/-- A relation `r : α → α → Prop` is well-founded when `∀ x, (∀ y, r y x → P y → P x) → P x` for all predicates `P`.
Once you know that a relation is well_founded, you can use it to define fixpoint functions on `α`.-/
structure well_founded {α : Sort u} (r : α → α → Prop)
  intro ::
where (apply : ∀ (a : α), acc r a)

class has_well_founded (α : Sort u)
where
  r : α → α → Prop
  wf : well_founded r

namespace well_founded

def recursion {α : Sort u} {r : α → α → Prop} (hwf : well_founded r) {C : α → Sort v} (a : α) (h : (x : α) → ((y : α) → r y x → C y) → C x) : C a :=
  acc.rec_on (apply hwf a) fun (x₁ : α) (ac₁ : ∀ (y : α), r y x₁ → acc r y) (ih : (y : α) → r y x₁ → C y) => h x₁ ih

theorem induction {α : Sort u} {r : α → α → Prop} (hwf : well_founded r) {C : α → Prop} (a : α) (h : ∀ (x : α), (∀ (y : α), r y x → C y) → C x) : C a :=
  recursion hwf a h

def fix_F {α : Sort u} {r : α → α → Prop} {C : α → Sort v} (F : (x : α) → ((y : α) → r y x → C y) → C x) (x : α) (a : acc r x) : C x :=
  acc.rec_on a fun (x₁ : α) (ac₁ : ∀ (y : α), r y x₁ → acc r y) (ih : (y : α) → r y x₁ → C y) => F x₁ ih

theorem fix_F_eq {α : Sort u} {r : α → α → Prop} {C : α → Sort v} (F : (x : α) → ((y : α) → r y x → C y) → C x) (x : α) (acx : acc r x) : fix_F F x acx = F x fun (y : α) (p : r y x) => fix_F F y (acc.inv acx p) := sorry

/-- Well-founded fixpoint -/
def fix {α : Sort u} {C : α → Sort v} {r : α → α → Prop} (hwf : well_founded r) (F : (x : α) → ((y : α) → r y x → C y) → C x) (x : α) : C x :=
  fix_F F x sorry

/-- Well-founded fixpoint satisfies fixpoint equation -/
theorem fix_eq {α : Sort u} {C : α → Sort v} {r : α → α → Prop} (hwf : well_founded r) (F : (x : α) → ((y : α) → r y x → C y) → C x) (x : α) : fix hwf F x = F x fun (y : α) (h : r y x) => fix hwf F y :=
  fix_F_eq F x (apply hwf x)

end well_founded

/-- Empty relation is well-founded -/
def empty_wf {α : Sort u} : well_founded empty_relation :=
  well_founded.intro fun (a : α) => acc.intro a fun (b : α) (lt : False) => False._oldrec lt

/- Subrelation of a well-founded relation is well-founded -/

namespace subrelation

def accessible {α : Sort u} {r : α → α → Prop} {Q : α → α → Prop} (h₁ : subrelation Q r) {a : α} (ac : acc r a) : acc Q a :=
  acc.rec_on ac
    fun (x : α) (ax : ∀ (y : α), r y x → acc r y) (ih : ∀ (y : α), r y x → acc Q y) =>
      acc.intro x fun (y : α) (lt : Q y x) => ih y (h₁ lt)

def wf {α : Sort u} {r : α → α → Prop} {Q : α → α → Prop} (h₁ : subrelation Q r) (h₂ : well_founded r) : well_founded Q :=
  well_founded.intro fun (a : α) => accessible h₁ (well_founded.apply h₂ a)

end subrelation

-- The inverse image of a well-founded relation is well-founded

namespace inv_image

def accessible {α : Sort u} {β : Sort v} {r : β → β → Prop} (f : α → β) {a : α} (ac : acc r (f a)) : acc (inv_image r f) a :=
  acc_aux f ac a rfl

def wf {α : Sort u} {β : Sort v} {r : β → β → Prop} (f : α → β) (h : well_founded r) : well_founded (inv_image r f) :=
  well_founded.intro fun (a : α) => accessible f (well_founded.apply h (f a))

end inv_image

-- The transitive closure of a well-founded relation is well-founded

namespace tc

def accessible {α : Sort u} {r : α → α → Prop} {z : α} (ac : acc r z) : acc (tc r) z :=
  acc.rec_on ac
    fun (x : α) (acx : ∀ (y : α), r y x → acc r y) (ih : ∀ (y : α), r y x → acc (tc r) y) =>
      acc.intro x
        fun (y : α) (rel : tc r y x) =>
          tc.rec_on rel
            (fun (a b : α) (rab : r a b) (acx : ∀ (y : α), r y b → acc r y) (ih : ∀ (y : α), r y b → acc (tc r) y) =>
              ih a rab)
            (fun (a b c : α) (rab : tc r a b) (rbc : tc r b c)
              (ih₁ : (∀ (y : α), r y b → acc r y) → (∀ (y : α), r y b → acc (tc r) y) → acc (tc r) a)
              (ih₂ : (∀ (y : α), r y c → acc r y) → (∀ (y : α), r y c → acc (tc r) y) → acc (tc r) b)
              (acx : ∀ (y : α), r y c → acc r y) (ih : ∀ (y : α), r y c → acc (tc r) y) => acc.inv (ih₂ acx ih) rab)
            acx ih

def wf {α : Sort u} {r : α → α → Prop} (h : well_founded r) : well_founded (tc r) :=
  well_founded.intro fun (a : α) => accessible (well_founded.apply h a)

end tc

/-- less-than is well-founded -/
def nat.lt_wf : well_founded nat.lt :=
  well_founded.intro
    (Nat.rec (acc.intro 0 fun (n : ℕ) (h : n < 0) => absurd h (nat.not_lt_zero n))
      fun (n : ℕ) (ih : acc Less n) =>
        acc.intro (Nat.succ n)
          fun (m : ℕ) (h : m < Nat.succ n) =>
            or.elim (nat.eq_or_lt_of_le (nat.le_of_succ_le_succ h)) (fun (e : m = n) => eq.substr e ih) (acc.inv ih))

def measure {α : Sort u} : (α → ℕ) → α → α → Prop :=
  inv_image Less

def measure_wf {α : Sort u} (f : α → ℕ) : well_founded (measure f) :=
  inv_image.wf f nat.lt_wf

def sizeof_measure (α : Sort u) [SizeOf α] : α → α → Prop :=
  measure sizeof

def sizeof_measure_wf (α : Sort u) [SizeOf α] : well_founded (sizeof_measure α) :=
  measure_wf sizeof

protected instance has_well_founded_of_has_sizeof (α : Sort u) [SizeOf α] : has_well_founded α :=
  has_well_founded.mk (sizeof_measure α) (sizeof_measure_wf α)

namespace prod

inductive lex {α : Type u} {β : Type v} (ra : α → α → Prop) (rb : β → β → Prop) : α × β → α × β → Prop
where
| left : ∀ {a₁ : α} (b₁ : β) {a₂ : α} (b₂ : β), ra a₁ a₂ → lex ra rb (a₁, b₁) (a₂, b₂)
| right : ∀ (a : α) {b₁ b₂ : β}, rb b₁ b₂ → lex ra rb (a, b₁) (a, b₂)

inductive rprod {α : Type u} {β : Type v} (ra : α → α → Prop) (rb : β → β → Prop) : α × β → α × β → Prop
where
| intro : ∀ {a₁ : α} {b₁ : β} {a₂ : α} {b₂ : β}, ra a₁ a₂ → rb b₁ b₂ → rprod ra rb (a₁, b₁) (a₂, b₂)

def lex_accessible {α : Type u} {β : Type v} {ra : α → α → Prop} {rb : β → β → Prop} {a : α} (aca : acc ra a) (acb : ∀ (b : β), acc rb b) (b : β) : acc (lex ra rb) (a, b) :=
  acc.rec_on aca
    fun (xa : α) (aca : ∀ (y : α), ra y xa → acc ra y) (iha : ∀ (y : α), ra y xa → ∀ (b : β), acc (lex ra rb) (y, b))
      (b : β) =>
      acc.rec_on (acb b)
        fun (xb : β) (acb : ∀ (y : β), rb y xb → acc rb y) (ihb : ∀ (y : β), rb y xb → acc (lex ra rb) (xa, y)) =>
          acc.intro (xa, xb)
            fun (p : α × β) (lt : lex ra rb p (xa, xb)) =>
              (fun (aux : xa = xa → xb = xb → acc (lex ra rb) p) => aux rfl rfl)
                (lex.rec_on lt
                  (fun (a₁ : α) (b₁ : β) (a₂ : α) (b₂ : β) (h : ra a₁ a₂) (eq₂ : a₂ = xa) (eq₃ : b₂ = xb) =>
                    iha a₁ (eq.rec_on eq₂ h) b₁)
                  fun (a : α) (b₁ b₂ : β) (h : rb b₁ b₂) (eq₂ : a = xa) (eq₃ : b₂ = xb) =>
                    eq.rec_on (Eq.symm eq₂) (ihb b₁ (eq.rec_on eq₃ h)))

def lex_wf {α : Type u} {β : Type v} {ra : α → α → Prop} {rb : β → β → Prop} (ha : well_founded ra) (hb : well_founded rb) : well_founded (lex ra rb) :=
  well_founded.intro
    fun (p : α × β) =>
      cases_on p fun (a : α) (b : β) => lex_accessible (well_founded.apply ha a) (well_founded.apply hb) b

def rprod_sub_lex {α : Type u} {β : Type v} {ra : α → α → Prop} {rb : β → β → Prop} (a : α × β) (b : α × β) : rprod ra rb a b → lex ra rb a b :=
  fun (h : rprod ra rb a b) =>
    rprod.rec_on h fun (a₁ : α) (b₁ : β) (a₂ : α) (b₂ : β) (h₁ : ra a₁ a₂) (h₂ : rb b₁ b₂) => lex.left b₁ b₂ h₁

def rprod_wf {α : Type u} {β : Type v} {ra : α → α → Prop} {rb : β → β → Prop} (ha : well_founded ra) (hb : well_founded rb) : well_founded (rprod ra rb) :=
  subrelation.wf rprod_sub_lex (lex_wf ha hb)

protected instance has_well_founded {α : Type u} {β : Type v} [s₁ : has_well_founded α] [s₂ : has_well_founded β] : has_well_founded (α × β) :=
  has_well_founded.mk (lex has_well_founded.r has_well_founded.r) sorry


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import logic.equiv.basic
import tactic.basic

/-!
# Monad

## Attributes

 * ext
 * functor_norm
 * monad_norm

## Implementation Details

Set of rewrite rules and automation for monads in general and
`reader_t`, `state_t`, `except_t` and `option_t` in particular.

The rewrite rules for monads are carefully chosen so that `simp with
functor_norm` will not introduce monadic vocabulary in a context where
applicatives would do just fine but will handle monadic notation
already present in an expression.

In a context where monadic reasoning is desired `simp with monad_norm`
will translate functor and applicative notation into monad notation
and use regular `functor_norm` rules as well.

## Tags

functor, applicative, monad, simp

-/

mk_simp_attribute monad_norm none with functor_norm

attribute [ext] reader_t.ext state_t.ext except_t.ext option_t.ext
attribute [functor_norm]   bind_assoc pure_bind bind_pure
attribute [monad_norm] seq_eq_bind_map
universes u v

@[monad_norm]
lemma map_eq_bind_pure_comp
  (m : Type u → Type v) [monad m] [is_lawful_monad m] {α β : Type u} (f : α → β) (x : m α) :
  f <$> x = x >>= pure ∘ f := by rw bind_pure_comp_eq_map

/-- run a `state_t` program and discard the final state -/
def state_t.eval {m : Type u → Type v} [functor m] {σ α} (cmd : state_t σ m α) (s : σ) : m α :=
prod.fst <$> cmd.run s

universes u₀ u₁ v₀ v₁

/-- reduce the equivalence between two state monads to the equivalence between
their respective function spaces -/
def state_t.equiv {m₁ : Type u₀ → Type v₀} {m₂ : Type u₁ → Type v₁}
  {α₁ σ₁ : Type u₀} {α₂ σ₂ : Type u₁} (F : (σ₁ → m₁ (α₁ × σ₁)) ≃ (σ₂ → m₂ (α₂ × σ₂))) :
  state_t σ₁ m₁ α₁ ≃ state_t σ₂ m₂ α₂ :=
{ to_fun := λ ⟨f⟩, ⟨F f⟩,
  inv_fun := λ ⟨f⟩, ⟨F.symm f⟩,
  left_inv := λ ⟨f⟩, congr_arg state_t.mk $ F.left_inv _,
  right_inv := λ ⟨f⟩, congr_arg state_t.mk $ F.right_inv _ }

/-- reduce the equivalence between two reader monads to the equivalence between
their respective function spaces -/
def reader_t.equiv {m₁ : Type u₀ → Type v₀} {m₂ : Type u₁ → Type v₁}
  {α₁ ρ₁ : Type u₀} {α₂ ρ₂ : Type u₁} (F : (ρ₁ → m₁ α₁) ≃ (ρ₂ → m₂ α₂)) :
  reader_t ρ₁ m₁ α₁ ≃ reader_t ρ₂ m₂ α₂ :=
{ to_fun := λ ⟨f⟩, ⟨F f⟩,
  inv_fun := λ ⟨f⟩, ⟨F.symm f⟩,
  left_inv := λ ⟨f⟩, congr_arg reader_t.mk $ F.left_inv _,
  right_inv := λ ⟨f⟩, congr_arg reader_t.mk $ F.right_inv _ }


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.group.inj_surj
import data.list.big_operators
import data.list.prod_monoid
import data.list.range
import group_theory.group_action.defs
import group_theory.submonoid.basic
import data.set_like.basic
import data.sigma.basic

/-!
# Additively-graded multiplicative structures

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

* `graded_monoid.ghas_one A`
* `graded_monoid.ghas_mul A`
* `graded_monoid.gmonoid A`
* `graded_monoid.gcomm_monoid A`

With the `sigma_graded` locale open, these respectively imbue:

* `has_one (graded_monoid A)`
* `has_mul (graded_monoid A)`
* `monoid (graded_monoid A)`
* `comm_monoid (graded_monoid A)`

the base type `A 0` with:

* `graded_monoid.grade_zero.has_one`
* `graded_monoid.grade_zero.has_mul`
* `graded_monoid.grade_zero.monoid`
* `graded_monoid.grade_zero.comm_monoid`

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

* (nothing)
* `graded_monoid.grade_zero.has_scalar (A 0)`
* `graded_monoid.grade_zero.mul_action (A 0)`
* (nothing)

For now, these typeclasses are primarily used in the construction of `direct_sum.ring` and the rest
of that file.

## Dependent graded products

This also introduces `list.dprod`, which takes the (possibly non-commutative) product of a list
of graded elements of type `A i`. This definition primarily exist to allow `graded_monoid.mk`
and `direct_sum.of` to be pulled outside a product, such as in `graded_monoid.mk_list_dprod` and
`direct_sum.of_list_dprod`.

## Internally graded monoids

In addition to the above typeclasses, in the most frequent case when `A` is an indexed collection of
`set_like` subobjects (such as `add_submonoid`s, `add_subgroup`s, or `submodule`s), this file
provides the `Prop` typeclasses:

* `set_like.has_graded_one A` (which provides the obvious `graded_monoid.ghas_one A` instance)
* `set_like.has_graded_mul A` (which provides the obvious `graded_monoid.ghas_mul A` instance)
* `set_like.graded_monoid A` (which provides the obvious `graded_monoid.gmonoid A` and
  `graded_monoid.gcomm_monoid A` instances)
* `set_like.is_homogeneous A` (which says that `a` is homogeneous iff `a ∈ A i` for some `i : ι`)

Strictly this last class is unecessary as it has no fields not present in its parents, but it is
included for convenience. Note that there is no need for `graded_ring` or similar, as all the
information it would contain is already supplied by `graded_monoid` when `A` is a collection
of additively-closed set_like objects such as `submodules`. These constructions are explored in
`algebra.direct_sum.internal`.

This file also contains the definition of `set_like.homogeneous_submonoid A`, which is, as the name
suggests, the submonoid consisting of all the homogeneous elements.

## tags

graded monoid
-/

set_option old_structure_cmd true

variables {ι : Type*}

/-- A type alias of sigma types for graded monoids. -/
def graded_monoid (A : ι → Type*) := sigma A

namespace graded_monoid

instance {A : ι → Type*} [inhabited ι] [inhabited (A default)]: inhabited (graded_monoid A) :=
sigma.inhabited

/-- Construct an element of a graded monoid. -/
def mk {A : ι → Type*} : Π i, A i → graded_monoid A := sigma.mk

/-! ### Typeclasses -/
section defs

variables (A : ι → Type*)

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

/-- `ghas_one` implies `has_one (graded_monoid A)` -/
instance ghas_one.to_has_one [has_zero ι] [ghas_one A] : has_one (graded_monoid A) :=
⟨⟨_, ghas_one.one⟩⟩

/-- A graded version of `has_mul`. Multiplication combines grades additively, like
`add_monoid_algebra`. -/
class ghas_mul [has_add ι] :=
(mul {i j} : A i → A j → A (i + j))

/-- `ghas_mul` implies `has_mul (graded_monoid A)`. -/
instance ghas_mul.to_has_mul [has_add ι] [ghas_mul A] :
  has_mul (graded_monoid A) :=
⟨λ (x y : graded_monoid A), ⟨_, ghas_mul.mul x.snd y.snd⟩⟩

lemma mk_mul_mk [has_add ι] [ghas_mul A] {i j} (a : A i) (b : A j) :
  mk i a * mk j b = mk (i + j) (ghas_mul.mul a b) :=
rfl

namespace gmonoid

variables {A} [add_monoid ι] [ghas_mul A] [ghas_one A]

/-- A default implementation of power on a graded monoid, like `npow_rec`.
`gmonoid.gnpow` should be used instead. -/
def gnpow_rec : Π (n : ℕ) {i}, A i → A (n • i)
| 0 i a := cast (congr_arg A (zero_nsmul i).symm) ghas_one.one
| (n + 1) i a := cast (congr_arg A (succ_nsmul i n).symm) (ghas_mul.mul a $ gnpow_rec _ a)

@[simp] lemma gnpow_rec_zero (a : graded_monoid A) : graded_monoid.mk _ (gnpow_rec 0 a.snd) = 1 :=
sigma.ext (zero_nsmul _) (heq_of_cast_eq _ rfl).symm

/-- Tactic used to autofill `graded_monoid.gmonoid.gnpow_zero'` when the default
`graded_monoid.gmonoid.gnpow_rec` is used. -/
meta def apply_gnpow_rec_zero_tac : tactic unit := `[apply graded_monoid.gmonoid.gnpow_rec_zero]

@[simp] lemma gnpow_rec_succ (n : ℕ) (a : graded_monoid A) :
  (graded_monoid.mk _ $ gnpow_rec n.succ a.snd) = a * ⟨_, gnpow_rec n a.snd⟩ :=
sigma.ext (succ_nsmul _ _) (heq_of_cast_eq _ rfl).symm

/-- Tactic used to autofill `graded_monoid.gmonoid.gnpow_succ'` when the default
`graded_monoid.gmonoid.gnpow_rec` is used. -/
meta def apply_gnpow_rec_succ_tac : tactic unit := `[apply graded_monoid.gmonoid.gnpow_rec_succ]

end gmonoid

/-- A graded version of `monoid`.

Like `monoid.npow`, this has an optional `gmonoid.gnpow` field to allow definitional control of
natural powers of a graded monoid. -/
class gmonoid [add_monoid ι]  extends ghas_mul A, ghas_one A :=
(one_mul (a : graded_monoid A) : 1 * a = a)
(mul_one (a : graded_monoid A) : a * 1 = a)
(mul_assoc (a b c : graded_monoid A) : a * b * c = a * (b * c))
(gnpow : Π (n : ℕ) {i}, A i → A (n • i) := gmonoid.gnpow_rec)
(gnpow_zero' : Π (a : graded_monoid A), graded_monoid.mk _ (gnpow 0 a.snd) = 1
  . gmonoid.apply_gnpow_rec_zero_tac)
(gnpow_succ' : Π (n : ℕ) (a : graded_monoid A),
  (graded_monoid.mk _ $ gnpow n.succ a.snd) = a * ⟨_, gnpow n a.snd⟩
  . gmonoid.apply_gnpow_rec_succ_tac)

/-- `gmonoid` implies a `monoid (graded_monoid A)`. -/
instance gmonoid.to_monoid [add_monoid ι] [gmonoid A] :
  monoid (graded_monoid A) :=
{ one := (1), mul := (*),
  npow := λ n a, graded_monoid.mk _ (gmonoid.gnpow n a.snd),
  npow_zero' := λ a, gmonoid.gnpow_zero' a,
  npow_succ' := λ n a, gmonoid.gnpow_succ' n a,
  one_mul := gmonoid.one_mul, mul_one := gmonoid.mul_one, mul_assoc := gmonoid.mul_assoc }

lemma mk_pow [add_monoid ι] [gmonoid A] {i} (a : A i) (n : ℕ) :
  mk i a ^ n = mk (n • i) (gmonoid.gnpow _ a) :=
begin
  induction n with n,
  { rw [pow_zero],
    exact (gmonoid.gnpow_zero' ⟨_, a⟩).symm, },
  { rw [pow_succ, n_ih, mk_mul_mk],
    exact (gmonoid.gnpow_succ' n ⟨_, a⟩).symm, },
end

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

/-- `gcomm_monoid` implies a `comm_monoid (graded_monoid A)`, although this is only used as an
instance locally to define notation in `gmonoid` and similar typeclasses. -/
instance gcomm_monoid.to_comm_monoid [add_comm_monoid ι] [gcomm_monoid A] :
  comm_monoid (graded_monoid A) :=
{ mul_comm := gcomm_monoid.mul_comm, ..gmonoid.to_monoid A }

end defs

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

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

section grade_zero

variables (A : ι → Type*)

section one
variables [has_zero ι] [ghas_one A]

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

end one

section mul
variables [add_monoid ι] [ghas_mul A]

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

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

variables {A}

@[simp] lemma mk_zero_smul {i} (a : A 0) (b : A i) : mk _ (a • b) = mk _ a * mk _ b :=
sigma.ext (zero_add _).symm $ eq_rec_heq _ _

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

end mul

section monoid
variables [add_monoid ι] [gmonoid A]

/-- The `monoid` structure derived from `gmonoid A`. -/
instance grade_zero.monoid : monoid (A 0) :=
function.injective.monoid (mk 0) sigma_mk_injective rfl mk_zero_smul

end monoid

section monoid
variables [add_comm_monoid ι] [gcomm_monoid A]

/-- The `comm_monoid` structure derived from `gcomm_monoid A`. -/
instance grade_zero.comm_monoid : comm_monoid (A 0) :=
function.injective.comm_monoid (mk 0) sigma_mk_injective rfl mk_zero_smul

end monoid

section mul_action
variables [add_monoid ι] [gmonoid A]

/-- `graded_monoid.mk 0` is a `monoid_hom`, using the `graded_monoid.grade_zero.monoid` structure.
-/
def mk_zero_monoid_hom : A 0 →* (graded_monoid A) :=
{ to_fun := mk 0, map_one' := rfl, map_mul' := mk_zero_smul }

/-- Each grade `A i` derives a `A 0`-action structure from `gmonoid A`. -/
instance grade_zero.mul_action {i} : mul_action (A 0) (A i) :=
begin
  letI := mul_action.comp_hom (graded_monoid A) (mk_zero_monoid_hom A),
  exact function.injective.mul_action (mk i) sigma_mk_injective mk_zero_smul,
end

end mul_action

end grade_zero

end graded_monoid

/-! ### Dependent products of graded elements -/

section dprod

variables {α : Type*} {A : ι → Type*} [add_monoid ι] [graded_monoid.gmonoid A]

/-- The index used by `list.dprod`. Propositionally this is equal to `(l.map fι).sum`, but
definitionally it needs to have a different form to avoid introducing `eq.rec`s in `list.dprod`. -/
def list.dprod_index (l : list α) (fι : α → ι) : ι :=
l.foldr (λ i b, fι i + b) 0

@[simp] lemma list.dprod_index_nil (fι : α → ι) : ([] : list α).dprod_index fι = 0 := rfl
@[simp] lemma list.dprod_index_cons (a : α) (l : list α) (fι : α → ι) :
  (a :: l).dprod_index fι = fι a + l.dprod_index fι := rfl

lemma list.dprod_index_eq_map_sum (l : list α) (fι : α → ι) :
  l.dprod_index fι = (l.map fι).sum :=
begin
  dunfold list.dprod_index,
  induction l,
  { simp, },
  { simp [l_ih], },
end

/-- A dependent product for graded monoids represented by the indexed family of types `A i`.
This is a dependent version of `(l.map fA).prod`.

For a list `l : list α`, this computes the product of `fA a` over `a`, where each `fA` is of type
`A (fι a)`. -/
def list.dprod (l : list α) (fι : α → ι) (fA : Π a, A (fι a)) :
  A (l.dprod_index fι) :=
l.foldr_rec_on _ _ graded_monoid.ghas_one.one (λ i x a ha, graded_monoid.ghas_mul.mul (fA a) x)

@[simp] lemma list.dprod_nil (fι : α → ι) (fA : Π a, A (fι a)) :
  (list.nil : list α).dprod fι fA = graded_monoid.ghas_one.one := rfl

-- the `( : _)` in this lemma statement results in the type on the RHS not being unfolded, which
-- is nicer in the goal view.
@[simp] lemma list.dprod_cons (fι : α → ι) (fA : Π a, A (fι a)) (a : α) (l : list α) :
  (a :: l).dprod fι fA = (graded_monoid.ghas_mul.mul (fA a) (l.dprod fι fA) : _) := rfl

lemma graded_monoid.mk_list_dprod (l : list α) (fι : α → ι) (fA : Π a, A (fι a)) :
  graded_monoid.mk _ (l.dprod fι fA) = (l.map (λ a, graded_monoid.mk (fι a) (fA a))).prod :=
begin
  induction l,
  { simp, refl  },
  { simp [←l_ih, graded_monoid.mk_mul_mk, list.prod_cons],
    refl, },
end

/-- A variant of `graded_monoid.mk_list_dprod` for rewriting in the other direction. -/
lemma graded_monoid.list_prod_map_eq_dprod (l : list α) (f : α → graded_monoid A) :
  (l.map f).prod = graded_monoid.mk _ (l.dprod (λ i, (f i).1) (λ i, (f i).2)) :=
begin
  rw [graded_monoid.mk_list_dprod, graded_monoid.mk],
  simp_rw sigma.eta,
end

lemma graded_monoid.list_prod_of_fn_eq_dprod {n : ℕ} (f : fin n → graded_monoid A) :
  (list.of_fn f).prod =
    graded_monoid.mk _ ((list.fin_range n).dprod (λ i, (f i).1) (λ i, (f i).2)) :=
by rw [list.of_fn_eq_map, graded_monoid.list_prod_map_eq_dprod]

end dprod

/-! ### Concrete instances -/
section

variables (ι) {R : Type*}

@[simps one]
instance has_one.ghas_one [has_zero ι] [has_one R] : graded_monoid.ghas_one (λ i : ι, R) :=
{ one := 1 }

@[simps mul]
instance has_mul.ghas_mul [has_add ι] [has_mul R] : graded_monoid.ghas_mul (λ i : ι, R) :=
{ mul := λ i j, (*) }

/-- If all grades are the same type and themselves form a monoid, then there is a trivial grading
structure. -/
@[simps gnpow]
instance monoid.gmonoid [add_monoid ι] [monoid R] : graded_monoid.gmonoid (λ i : ι, R) :=
{ one_mul := λ a, sigma.ext (zero_add _) (heq_of_eq (one_mul _)),
  mul_one := λ a, sigma.ext (add_zero _) (heq_of_eq (mul_one _)),
  mul_assoc := λ a b c, sigma.ext (add_assoc _ _ _) (heq_of_eq (mul_assoc _ _ _)),
  gnpow := λ n i a, a ^ n,
  gnpow_zero' := λ a, sigma.ext (zero_nsmul _) (heq_of_eq (monoid.npow_zero' _)),
  gnpow_succ' := λ n ⟨i, a⟩, sigma.ext (succ_nsmul _ _) (heq_of_eq (monoid.npow_succ' _ _)),
  ..has_one.ghas_one ι,
  ..has_mul.ghas_mul ι }

/-- If all grades are the same type and themselves form a commutative monoid, then there is a
trivial grading structure. -/
instance comm_monoid.gcomm_monoid [add_comm_monoid ι] [comm_monoid R] :
  graded_monoid.gcomm_monoid (λ i : ι, R) :=
{ mul_comm := λ a b, sigma.ext (add_comm _ _) (heq_of_eq (mul_comm _ _)),
  ..monoid.gmonoid ι }

/-- When all the indexed types are the same, the dependent product is just the regular product. -/
@[simp] lemma list.dprod_monoid {α} [add_monoid ι] [monoid R] (l : list α) (fι : α → ι)
  (fA : α → R) :
  (l.dprod fι fA : (λ i : ι, R) _) = ((l.map fA).prod : _) :=
begin
  induction l,
  { rw [list.dprod_nil, list.map_nil, list.prod_nil], refl },
  { rw [list.dprod_cons, list.map_cons, list.prod_cons, l_ih], refl },
end

end

/-! ### Shorthands for creating instance of the above typeclasses for collections of subobjects -/

section subobjects

variables {R : Type*}

/-- A version of `graded_monoid.ghas_one` for internally graded objects. -/
class set_like.has_graded_one {S : Type*} [set_like S R] [has_one R] [has_zero ι]
  (A : ι → S) : Prop :=
(one_mem : (1 : R) ∈ A 0)

instance set_like.ghas_one {S : Type*} [set_like S R] [has_one R] [has_zero ι] (A : ι → S)
  [set_like.has_graded_one A] : graded_monoid.ghas_one (λ i, A i) :=
{ one := ⟨1, set_like.has_graded_one.one_mem⟩ }

@[simp] lemma set_like.coe_ghas_one {S : Type*} [set_like S R] [has_one R] [has_zero ι] (A : ι → S)
  [set_like.has_graded_one A] : ↑(@graded_monoid.ghas_one.one _ (λ i, A i) _ _) = (1 : R) := rfl

/-- A version of `graded_monoid.ghas_one` for internally graded objects. -/
class set_like.has_graded_mul {S : Type*} [set_like S R] [has_mul R] [has_add ι]
  (A : ι → S) : Prop :=
(mul_mem : ∀ ⦃i j⦄ {gi gj}, gi ∈ A i → gj ∈ A j → gi * gj ∈ A (i + j))

instance set_like.ghas_mul {S : Type*} [set_like S R] [has_mul R] [has_add ι] (A : ι → S)
  [set_like.has_graded_mul A] :
  graded_monoid.ghas_mul (λ i, A i) :=
{ mul := λ i j a b, ⟨(a * b : R), set_like.has_graded_mul.mul_mem a.prop b.prop⟩ }

@[simp] lemma set_like.coe_ghas_mul {S : Type*} [set_like S R] [has_mul R] [has_add ι] (A : ι → S)
  [set_like.has_graded_mul A] {i j : ι} (x : A i) (y : A j) :
    ↑(@graded_monoid.ghas_mul.mul _ (λ i, A i) _ _ _ _ x y) = (x * y : R) := rfl

/-- A version of `graded_monoid.gmonoid` for internally graded objects. -/
class set_like.graded_monoid {S : Type*} [set_like S R] [monoid R] [add_monoid ι]
  (A : ι → S) extends set_like.has_graded_one A, set_like.has_graded_mul A : Prop

namespace set_like.graded_monoid
variables {S : Type*} [set_like S R] [monoid R] [add_monoid ι]
variables {A : ι → S} [set_like.graded_monoid A]

lemma pow_mem (n : ℕ) {r : R} {i : ι} (h : r ∈ A i) : r ^ n ∈ A (n • i) :=
begin
  induction n,
  { rw [pow_zero, zero_nsmul], exact one_mem },
  { rw [pow_succ', succ_nsmul'], exact mul_mem n_ih h },
end

lemma list_prod_map_mem {ι'} (l : list ι') (i : ι' → ι) (r : ι' → R) (h : ∀ j ∈ l, r j ∈ A (i j)) :
  (l.map r).prod ∈ A (l.map i).sum :=
begin
  induction l,
  { rw [list.map_nil, list.map_nil, list.prod_nil, list.sum_nil],
    exact one_mem },
  { rw [list.map_cons, list.map_cons, list.prod_cons, list.sum_cons],
    exact mul_mem (h _ $ list.mem_cons_self _ _) (l_ih $ λ j hj, h _ $ list.mem_cons_of_mem _ hj) },
end

lemma list_prod_of_fn_mem {n} (i : fin n → ι) (r : fin n → R) (h : ∀ j, r j ∈ A (i j)) :
  (list.of_fn r).prod ∈ A (list.of_fn i).sum :=
begin
  rw [list.of_fn_eq_map, list.of_fn_eq_map],
  exact list_prod_map_mem _ _ _ (λ _ _, h _),
end

end set_like.graded_monoid

/-- Build a `gmonoid` instance for a collection of subobjects. -/
instance set_like.gmonoid {S : Type*} [set_like S R] [monoid R] [add_monoid ι] (A : ι → S)
  [set_like.graded_monoid A] :
  graded_monoid.gmonoid (λ i, A i) :=
{ one_mul := λ ⟨i, a, h⟩, sigma.subtype_ext (zero_add _) (one_mul _),
  mul_one := λ ⟨i, a, h⟩, sigma.subtype_ext (add_zero _) (mul_one _),
  mul_assoc := λ ⟨i, a, ha⟩ ⟨j, b, hb⟩ ⟨k, c, hc⟩,
    sigma.subtype_ext (add_assoc _ _ _) (mul_assoc _ _ _),
  gnpow := λ n i a, ⟨a ^ n, set_like.graded_monoid.pow_mem n a.prop⟩,
  gnpow_zero' := λ n, sigma.subtype_ext (zero_nsmul _) (pow_zero _),
  gnpow_succ' := λ n a, sigma.subtype_ext (succ_nsmul _ _) (pow_succ _ _),
  ..set_like.ghas_one A,
  ..set_like.ghas_mul A }

@[simp] lemma set_like.coe_gnpow {S : Type*} [set_like S R] [monoid R] [add_monoid ι] (A : ι → S)
  [set_like.graded_monoid A] {i : ι} (x : A i) (n : ℕ) :
    ↑(@graded_monoid.gmonoid.gnpow _ (λ i, A i) _ _ n _ x) = (x ^ n : R) := rfl

/-- Build a `gcomm_monoid` instance for a collection of subobjects. -/
instance set_like.gcomm_monoid {S : Type*} [set_like S R] [comm_monoid R] [add_comm_monoid ι]
  (A : ι → S) [set_like.graded_monoid A] :
  graded_monoid.gcomm_monoid (λ i, A i) :=
{ mul_comm := λ ⟨i, a, ha⟩ ⟨j, b, hb⟩, sigma.subtype_ext (add_comm _ _) (mul_comm _ _),
  ..set_like.gmonoid A}

section dprod
open set_like set_like.graded_monoid
variables {α S : Type*} [set_like S R] [monoid R] [add_monoid ι]

/-- Coercing a dependent product of subtypes is the same as taking the regular product of the
coercions. -/
@[simp] lemma set_like.coe_list_dprod (A : ι → S) [set_like.graded_monoid A]
  (fι : α → ι) (fA : Π a, A (fι a)) (l : list α) :
  ↑(l.dprod fι fA : (λ i, ↥(A i)) _) = (list.prod (l.map (λ a, fA a)) : R) :=
begin
  induction l,
  { rw [list.dprod_nil, coe_ghas_one, list.map_nil, list.prod_nil] },
  { rw [list.dprod_cons, coe_ghas_mul, list.map_cons, list.prod_cons, l_ih], },
end

include R

/-- A version of `list.coe_dprod_set_like` with `subtype.mk`. -/
lemma set_like.list_dprod_eq (A : ι → S) [set_like.graded_monoid A]
  (fι : α → ι) (fA : Π a, A (fι a)) (l : list α) :
  (l.dprod fι fA : (λ i, ↥(A i)) _) =
    ⟨list.prod (l.map (λ a, fA a)), (l.dprod_index_eq_map_sum fι).symm ▸
      list_prod_map_mem l _ _ (λ i hi, (fA i).prop)⟩ :=
subtype.ext $ set_like.coe_list_dprod _ _ _ _

end dprod

end subobjects

section homogeneous_elements

variables {R S : Type*} [set_like S R]

/-- An element `a : R` is said to be homogeneous if there is some `i : ι` such that `a ∈ A i`. -/
def set_like.is_homogeneous (A : ι → S) (a : R) : Prop := ∃ i, a ∈ A i

lemma set_like.is_homogeneous_one [has_zero ι] [has_one R]
  (A : ι → S) [set_like.has_graded_one A] : set_like.is_homogeneous A (1 : R) :=
⟨0, set_like.has_graded_one.one_mem⟩

lemma set_like.is_homogeneous.mul [has_add ι] [has_mul R] {A : ι → S}
  [set_like.has_graded_mul A] {a b : R} :
  set_like.is_homogeneous A a → set_like.is_homogeneous A b → set_like.is_homogeneous A (a * b)
| ⟨i, hi⟩ ⟨j, hj⟩ := ⟨i + j, set_like.has_graded_mul.mul_mem hi hj⟩

/-- When `A` is a `set_like.graded_monoid A`, then the homogeneous elements forms a submonoid. -/
def set_like.homogeneous_submonoid [add_monoid ι] [monoid R]
  (A : ι → S) [set_like.graded_monoid A] : submonoid R :=
{ carrier := { a | set_like.is_homogeneous A a },
  one_mem' := set_like.is_homogeneous_one A,
  mul_mem' := λ a b, set_like.is_homogeneous.mul }

end homogeneous_elements


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison
-/
import category_theory.products.basic
import category_theory.types

/-!
The hom functor, sending `(X, Y)` to the type `X ⟶ Y`.
-/

universes v u

open opposite
open category_theory

namespace category_theory.functor

variables (C : Type u) [category.{v} C]

/-- `functor.hom` is the hom-pairing, sending `(X, Y)` to `X ⟶ Y`, contravariant in `X` and
covariant in `Y`. -/
definition hom : Cᵒᵖ × C ⥤ Type v :=
{ obj       := λ p, unop p.1 ⟶ p.2,
  map       := λ X Y f, λ h, f.1.unop ≫ h ≫ f.2 }

@[simp] lemma hom_obj (X : Cᵒᵖ × C) : (hom C).obj X = (unop X.1 ⟶ X.2) := rfl
@[simp] lemma hom_pairing_map {X Y : Cᵒᵖ × C} (f : X ⟶ Y) :
  (hom C).map f = λ h, f.1.unop ≫ h ≫ f.2 := rfl

end category_theory.functor


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison
-/
import category_theory.eq_to_hom
import category_theory.functor.const
import data.prod.basic

/-!
# Cartesian products of categories

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

We define the category instance on `C × D` when `C` and `D` are categories.

We define:
* `sectl C Z` : the functor `C ⥤ C × D` given by `X ↦ ⟨X, Z⟩`
* `sectr Z D` : the functor `D ⥤ C × D` given by `Y ↦ ⟨Z, Y⟩`
* `fst`       : the functor `⟨X, Y⟩ ↦ X`
* `snd`       : the functor `⟨X, Y⟩ ↦ Y`
* `swap`      : the functor `C × D ⥤ D × C` given by `⟨X, Y⟩ ↦ ⟨Y, X⟩`
    (and the fact this is an equivalence)

We further define `evaluation : C ⥤ (C ⥤ D) ⥤ D` and `evaluation_uncurried : C × (C ⥤ D) ⥤ D`,
and products of functors and natural transformations, written `F.prod G` and `α.prod β`.
-/

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

/--
`prod C D` gives the cartesian product of two categories.

See <https://stacks.math.columbia.edu/tag/001K>.
-/
@[simps {not_recursive := []}] -- the generates simp lemmas like `id_fst` and `comp_snd`
instance prod : category.{max v₁ v₂} (C × D) :=
{ hom     := λ X Y, ((X.1) ⟶ (Y.1)) × ((X.2) ⟶ (Y.2)),
  id      := λ X, ⟨ 𝟙 (X.1), 𝟙 (X.2) ⟩,
  comp    := λ _ _ _ f g, (f.1 ≫ g.1, f.2 ≫ g.2) }

/-- Two rfl lemmas that cannot be generated by `@[simps]`. -/
@[simp]

lemma is_iso_prod_iff {P Q : C} {S T : D} {f : (P, S) ⟶ (Q, T)} :
  is_iso f ↔ is_iso f.1 ∧ is_iso f.2 :=
begin
  split,
  { rintros ⟨g, hfg, hgf⟩,
    simp at hfg hgf,
    rcases hfg with ⟨hfg₁, hfg₂⟩,
    rcases hgf with ⟨hgf₁, hgf₂⟩,
    exact ⟨⟨⟨g.1, hfg₁, hgf₁⟩⟩, ⟨⟨g.2, hfg₂, hgf₂⟩⟩⟩ },
  { rintros ⟨⟨g₁, hfg₁, hgf₁⟩, ⟨g₂, hfg₂, hgf₂⟩⟩,
    dsimp at hfg₁ hgf₁ hfg₂ hgf₂,
    refine ⟨⟨(g₁, g₂), _, _⟩⟩; { simp; split; assumption } }
end

section
variables {C D}

/-- The isomorphism between `(X.1, X.2)` and `X`. -/
@[simps]
def prod.eta_iso (X : C × D) : (X.1, X.2) ≅ X := { hom := (𝟙 _, 𝟙 _), inv := (𝟙 _, 𝟙 _) }

/-- Construct an isomorphism in `C × D` out of two isomorphisms in `C` and `D`. -/
@[simps]
def iso.prod {P Q : C} {S T : D} (f : P ≅ Q) (g : S ≅ T) : (P, S) ≅ (Q, T) :=
{ hom := (f.hom, g.hom),
  inv := (f.inv, g.inv), }

end

end

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₁) [category.{v₁} D]
/--
`prod.category.uniform C D` is an additional instance specialised so both factors have the same
universe levels. This helps typeclass resolution.
-/
instance uniform_prod : category (C × D) := category_theory.prod C D
end

-- Next we define the natural functors into and out of product categories. For now this doesn't
-- address the universal properties.
namespace prod

/-- `sectl C Z` is the functor `C ⥤ C × D` given by `X ↦ (X, Z)`. -/
@[simps] def sectl
  (C : Type u₁) [category.{v₁} C] {D : Type u₂} [category.{v₂} D] (Z : D) : C ⥤ C × D :=
{ obj := λ X, (X, Z),
  map := λ X Y f, (f, 𝟙 Z) }

/-- `sectr Z D` is the functor `D ⥤ C × D` given by `Y ↦ (Z, Y)` . -/
@[simps] def sectr
  {C : Type u₁} [category.{v₁} C] (Z : C) (D : Type u₂) [category.{v₂} D] : D ⥤ C × D :=
{ obj := λ X, (Z, X),
  map := λ X Y f, (𝟙 Z, f) }

variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

/-- `fst` is the functor `(X, Y) ↦ X`. -/
@[simps] def fst : C × D ⥤ C :=
{ obj := λ X, X.1,
  map := λ X Y f, f.1 }

/-- `snd` is the functor `(X, Y) ↦ Y`. -/
@[simps] def snd : C × D ⥤ D :=
{ obj := λ X, X.2,
  map := λ X Y f, f.2 }

/-- The functor swapping the factors of a cartesian product of categories, `C × D ⥤ D × C`. -/
@[simps] def swap : C × D ⥤ D × C :=
{ obj := λ X, (X.2, X.1),
  map := λ _ _ f, (f.2, f.1) }

/--
Swapping the factors of a cartesion product of categories twice is naturally isomorphic
to the identity functor.
-/
@[simps] def symmetry : swap C D ⋙ swap D C ≅ 𝟭 (C × D) :=
{ hom := { app := λ X, 𝟙 X },
  inv := { app := λ X, 𝟙 X } }

/--
The equivalence, given by swapping factors, between `C × D` and `D × C`.
-/
@[simps]
def braiding : C × D ≌ D × C :=
equivalence.mk (swap C D) (swap D C)
  (nat_iso.of_components (λ X, eq_to_iso (by simp)) (by tidy))
  (nat_iso.of_components (λ X, eq_to_iso (by simp)) (by tidy))

instance swap_is_equivalence : is_equivalence (swap C D) :=
(by apply_instance : is_equivalence (braiding C D).functor)

end prod

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

/--
The "evaluation at `X`" functor, such that
`(evaluation.obj X).obj F = F.obj X`,
which is functorial in both `X` and `F`.
-/
@[simps] def evaluation : C ⥤ (C ⥤ D) ⥤ D :=
{ obj := λ X,
  { obj := λ F, F.obj X,
    map := λ F G α, α.app X, },
  map := λ X Y f,
  { app := λ F, F.map f,
    naturality' := λ F G α, eq.symm (α.naturality f) } }

/--
The "evaluation of `F` at `X`" functor,
as a functor `C × (C ⥤ D) ⥤ D`.
-/
@[simps] def evaluation_uncurried : C × (C ⥤ D) ⥤ D :=
{ obj := λ p, p.2.obj p.1,
  map := λ x y f, (x.2.map f.1) ≫ (f.2.app y.1),
  map_comp' := λ X Y Z f g,
  begin
    cases g, cases f, cases Z, cases Y, cases X,
    simp only [prod_comp, nat_trans.comp_app, functor.map_comp, category.assoc],
    rw [←nat_trans.comp_app, nat_trans.naturality, nat_trans.comp_app,
        category.assoc, nat_trans.naturality],
  end }

variables {C}

/-- The constant functor followed by the evalutation functor is just the identity. -/
@[simps] def functor.const_comp_evaluation_obj (X : C) :
  functor.const C ⋙ (evaluation C D).obj X ≅ 𝟭 D :=
nat_iso.of_components (λ Y, iso.refl _) (λ Y Z f, by simp)

end

variables {A : Type u₁} [category.{v₁} A]
          {B : Type u₂} [category.{v₂} B]
          {C : Type u₃} [category.{v₃} C]
          {D : Type u₄} [category.{v₄} D]

namespace functor
/-- The cartesian product of two functors. -/
@[simps] def prod (F : A ⥤ B) (G : C ⥤ D) : A × C ⥤ B × D :=
{ obj := λ X, (F.obj X.1, G.obj X.2),
  map := λ _ _ f, (F.map f.1, G.map f.2) }

/- Because of limitations in Lean 3's handling of notations, we do not setup a notation `F × G`.
   You can use `F.prod G` as a "poor man's infix", or just write `functor.prod F G`. -/

/-- Similar to `prod`, but both functors start from the same category `A` -/
@[simps] def prod' (F : A ⥤ B) (G : A ⥤ C) : A ⥤ (B × C) :=
{ obj := λ a, (F.obj a, G.obj a),
  map := λ x y f, (F.map f, G.map f), }

/-- The product `F.prod' G` followed by projection on the first component is isomorphic to `F` -/
@[simps]
def prod'_comp_fst (F : A ⥤ B) (G : A ⥤ C) : (F.prod' G) ⋙ (category_theory.prod.fst B C) ≅ F :=
nat_iso.of_components (λ X, iso.refl _) (λ X Y f, by simp)

/-- The product `F.prod' G` followed by projection on the second component is isomorphic to `G` -/
@[simps]
def prod'_comp_snd (F : A ⥤ B) (G : A ⥤ C) : (F.prod' G) ⋙ (category_theory.prod.snd B C) ≅ G :=
nat_iso.of_components (λ X, iso.refl _) (λ X Y f, by simp)

section
variable (C)

/-- The diagonal functor. -/
def diag : C ⥤ C × C := (𝟭 C).prod' (𝟭 C)

@[simp] lemma diag_obj (X : C) : (diag C).obj X = (X, X) := rfl

@[simp] lemma diag_map {X Y : C} (f : X ⟶ Y) : (diag C).map f = (f, f) := rfl

end

end functor

namespace nat_trans

/-- The cartesian product of two natural transformations. -/
@[simps] def prod {F G : A ⥤ B} {H I : C ⥤ D} (α : F ⟶ G) (β : H ⟶ I) :
  F.prod H ⟶ G.prod I :=
{ app         := λ X, (α.app X.1, β.app X.2),
  naturality' := λ X Y f,
  begin
    cases X, cases Y,
    simp only [functor.prod_map, prod.mk.inj_iff, prod_comp],
    split; rw naturality
  end }

/- Again, it is inadvisable in Lean 3 to setup a notation `α × β`;
   use instead `α.prod β` or `nat_trans.prod α β`. -/

end nat_trans

/-- `F.flip` composed with evaluation is the same as evaluating `F`. -/
@[simps]
def flip_comp_evaluation (F : A ⥤ B ⥤ C) (a) :
  F.flip ⋙ (evaluation _ _).obj a ≅ F.obj a :=
nat_iso.of_components (λ b, eq_to_iso rfl) $ by tidy

variables (A B C)

/-- The forward direction for `functor_prod_functor_equiv` -/
@[simps] def prod_functor_to_functor_prod : (A ⥤ B) × (A ⥤ C) ⥤ A ⥤ B × C :=
{ obj := λ F, F.1.prod' F.2,
  map := λ F G f, { app := λ X, (f.1.app X, f.2.app X) } }

/-- The backward direction for `functor_prod_functor_equiv` -/
@[simps] def functor_prod_to_prod_functor : (A ⥤ B × C) ⥤ (A ⥤ B) × (A ⥤ C) :=
{ obj := λ F, ⟨F ⋙ (category_theory.prod.fst B C), F ⋙ (category_theory.prod.snd B C)⟩,
  map := λ F G α,
  ⟨{ app := λ X, (α.app X).1,
     naturality' := λ X Y f,
     by simp only [functor.comp_map, prod.fst_map, ←prod_comp_fst, α.naturality] },
   { app := λ X, (α.app X).2,
     naturality' := λ X Y f,
     by simp only [functor.comp_map, prod.snd_map, ←prod_comp_snd, α.naturality] }⟩ }

/-- The unit isomorphism for `functor_prod_functor_equiv` -/
@[simps] def functor_prod_functor_equiv_unit_iso :
  𝟭 _ ≅ prod_functor_to_functor_prod A B C ⋙ functor_prod_to_prod_functor A B C :=
nat_iso.of_components
  (λ F, (((functor.prod'_comp_fst _ _).prod (functor.prod'_comp_snd _ _)).trans
  (prod.eta_iso F)).symm) (λ F G α, by {tidy})

/-- The counit isomorphism for `functor_prod_functor_equiv` -/
@[simps] def functor_prod_functor_equiv_counit_iso :
  functor_prod_to_prod_functor A B C ⋙ prod_functor_to_functor_prod A B C ≅ 𝟭 _ :=
nat_iso.of_components
  (λ F, nat_iso.of_components (λ X, prod.eta_iso (F.obj X)) (by tidy)) (by tidy)

/-- The equivalence of categories between `(A ⥤ B) × (A ⥤ C)` and `A ⥤ (B × C)` -/
@[simps] def functor_prod_functor_equiv : ((A ⥤ B) × (A ⥤ C)) ≌ (A ⥤ (B × C)) :=
{ functor := prod_functor_to_functor_prod A B C,
  inverse := functor_prod_to_prod_functor A B C,
  unit_iso := functor_prod_functor_equiv_unit_iso A B C,
  counit_iso := functor_prod_functor_equiv_counit_iso A B C }

end category_theory