import identities2_3

open finset
open_locale big_operators

lemma aux1 (f : ℕ → ℕ → ℝ) (s : finset ℕ) (sj : finset ℕ) (snat : finset ℕ) (s ⊆ snat) (j : ℕ) :
 ite (j ∈ sj) (Sum (f j) s) 0 = Sum (λ k, f j k * (ite (j ∈ sj ∧ k ∈ s) 1 0)) snat :=
begin

  have h1 : Sum (λ k, ((ite (j ∈ sj ∧ k ∈ s) (f j k) 0))) snat = Sum (λ k, f j k * (ite (j ∈ sj ∧ k ∈ s) 1 0)) snat,
  { apply congr, apply congr, refl, apply funext, intro x, exact (mul_boole (j ∈ sj ∧ x ∈ s) (f j x)).symm, refl, },
  rw ← h1,
  unfold Sum,

  have h2 : ∑ (k : ℕ) in snat, ite (j ∈ sj ∧ k ∈ s) (f j k) 0 =
  ite (j ∈ sj) (∑ (k : ℕ) in snat, ite (k ∈ s) (f j k) 0) 0,
  { rw ← boole_mul, rw mul_sum, apply congr, refl, apply funext, intro k, rw mul_comm, rw mul_boole,
  rw ite_and, },
  rw h2,

  rw sum_ite,
  rw sum_const_zero,
  rw add_zero,
  have h3 : filter (λ (x : ℕ), x ∈ s) snat = s,
  { exact inf_eq_right.mpr H, },
  rw h3,

end

lemma aux2 (f : ℕ → ℕ → ℝ) (sk : finset ℕ) (sj : finset ℕ) (s : finset ℕ) (H1 : sj ⊆ s) ( H2 : sk ⊆ s) :
Sum (λ j, Sum (λ k, f j k) sk) sj = Sum (λ j, Sum (λ k, f j k * (ite (j ∈ sj ∧ k ∈ sk) 1 0)) s) s :=
begin

  have h1 : Sum (λ j, Sum (λ k, f j k * (ite (j ∈ sj ∧ k ∈ sk) 1 0)) s) s =
  Sum (λ j, ite (j ∈ sj) (Sum (f j) sk) 0) s,
  { apply congr, apply congr, refl, apply funext, intro j, rw aux1, exact s, exact H2, refl,},
  rw h1,

  unfold Sum,
  rw sum_ite,
  rw sum_const_zero,
  rw add_zero,

  have h2 : filter (λ (x : ℕ), x ∈ sj) s = sj,
  { exact inf_eq_right.mpr H1,},
  rw h2,

end

lemma id227a (f : ℕ → ℕ → ℝ) (sk : finset ℕ) (sj : finset ℕ) (s : finset ℕ) (h1 : sk ⊆ s) (h2 : sj ⊆ s) :
Sum (λ j, Sum (λ k, f j k * (ite (j ∈ sj ∧ k ∈ sk) 1 0)) s) s =
∑ x in (sj.product sk), f x.fst x.snd :=
begin
  rw ← aux2,
  unfold Sum,
  rw ← sum_product.symm,
  exact h2,
  exact h1,
end

lemma id227b (f : ℕ → ℕ → ℝ) (sk : finset ℕ) (sj : finset ℕ) (s : finset ℕ) :
Sum (λ j, Sum (λ k, f j k * (ite (j ∈ sj ∧ k ∈ sk) 1 0)) s) s =
Sum (λ k, Sum (λ j, f j k * (ite (j ∈ sj ∧ k ∈ sk) 1 0)) s) s :=
begin
  unfold Sum,
  exact sum_comm,
end

lemma id228 (fa : ℕ → ℝ) (fb : ℕ → ℝ) (sk : finset ℕ) (sj : finset ℕ) :
∑ p in (sj.product sk), fa p.fst * fb p.snd = Sum fa sj * Sum fb sk :=
begin
  unfold Sum,
  rw sum_mul_sum,
end

lemma id229a (f : ℕ → ℕ → ℝ) (sk : finset ℕ) (sj : finset ℕ) :
Sum (λ j, Sum (λ k, f j k) sk) sj = ∑ p in (sj.product sk), f p.fst p.snd :=
begin
  unfold Sum,
  rw ← sum_product.symm,
end

lemma id229b (f : ℕ → ℕ → ℝ) (sk : finset ℕ) (sj : finset ℕ) :
Sum (λ j, Sum (λ k, f j k) sk) sj = Sum (λ k, Sum (λ j, f j k) sj) sk :=
begin
  exact sum_comm,
end

lemma id230 (f : ℕ → ℕ → ℝ) (sk sj a b  : finset ℕ) (sk' sj': ℕ → finset ℕ)
(ht : ∀ j, a = sk' j) (hp : ∀ k, b = sj' k)
(h : ∀ j k, (ite (j ∈ sj) 1 0) * (ite (k ∈ (a)) 1 0) = (ite (k ∈ sk) 1 0) * (ite (j ∈ (b)) 1 0)) :
Sum (λ j, Sum (λ k, f j k) (a)) sj = Sum (λ k, Sum (λ j, f j k) (b)) sk :=
begin

  have h4 : sj ⊆ (sk ∪ sj ∪ a ∪ b) ∧ sk ⊆ (sk ∪ sj ∪ a ∪ b) ∧ a ⊆ (sk ∪ sj ∪ a ∪ b) ∧ b ⊆ (sk ∪ sj ∪ a ∪ b),
  { split, rw union_assoc, rw union_assoc, rw union_comm, rw union_assoc,
  apply (subset_union_left sj), split, rw union_assoc, rw union_assoc,
  apply (subset_union_left sk), split, rw union_assoc, rw union_assoc, rw union_comm,
  rw union_assoc, rw union_comm, rw union_assoc, rw union_assoc, apply (subset_union_left a),
  rw union_comm, apply (subset_union_left b), },

  rw aux2 f a sj,
  apply eq.symm,
  rw id229b,
  rw aux2 f sk b,

  have h2 : ∀ x y, ite (y ∈ b ∧ x ∈ sk) 1 0 = ite (y ∈ b) 1 0 * ite (x ∈ sk) 1 0,
  { intros x y, rw ← ite_mul_zero_left, rw one_mul, rw ← ite_and, },
  have h3 : ∀ x y, ite (y ∈ sj ∧ x ∈ a) 1 0 = ite (y ∈ sj) 1 0 * ite (x ∈ a) 1 0,
  { intros x y, rw ← ite_mul_zero_left, rw one_mul, rw ← ite_and, },

  repeat {rw Sum},
  apply sum_congr, refl, intros q i,
  repeat {rw Sum},
  apply sum_congr, refl, intros w i2,

  apply mul_eq_mul_left_iff.mpr,
  left,

  have h1 : ((ite (q ∈ sj ∧ w ∈ (a)) 1 0)) =
  ((ite (q ∈ (b) ∧ w ∈ sk) 1 0) ),
  { rw (h2 w q), rw (h3 w q), rw (h q w), rw mul_comm, },

  apply eq.symm,
  exact_mod_cast h1,

  exact h4.right.right.right,
  exact h4.right.left,
  exact h4.left,
  exact h4.right.right.left,

end

lemma id231a (j : ℕ) (k : ℕ) (n : ℕ) :
ite (1 ≤ j ∧ j ≤ n) 1 0 * ite (j ≤ k ∧ k ≤ n) 1 0 = ite (1 ≤ j ∧ j ≤ k ∧ k ≤ n) 1 0 :=
begin

  have h1 : (j ≤ k ∧ k ≤ n) → j ≤ n, { intro g, apply le_trans g.left g.right, },
  have h2 : (1 ≤ j ∧ j ≤ k ∧ k ≤ n) ↔ (1 ≤ j ∧ j ≤ n) ∧ (j ≤ k ∧ k ≤ n),
  { rw iff_def, split, intro i, split, split, exact i.left, apply h1, exact i.right,
  exact i.right, intro i, split, exact i.left.left, exact i.right, },

  rw ← ite_mul_zero_left,
  rw one_mul,
  rw ← ite_and,
  apply eq.symm,

  by_cases (1 ≤ j ∧ j ≤ k ∧ k ≤ n),
  { rw if_pos, rw if_pos, rw ← h2, exact h, exact h, },
  rw if_neg,
  rw if_neg,
  rw not_iff_not_of_iff h2.symm,
  exact h,
  exact h,

end

lemma id231b (j : ℕ) (k : ℕ) (n : ℕ) :
ite (1 ≤ k ∧ k ≤ n) 1 0 * ite (1 ≤ j ∧ j ≤ k) 1 0 = ite (1 ≤ j ∧ j ≤ k ∧ k ≤ n) 1 0 :=
begin

  rw ← ite_mul_zero_left,
  rw one_mul,
  rw ← ite_and,

  have h1 : ((1 ≤ k ∧ k ≤ n) ∧ 1 ≤ j ∧ j ≤ k) ↔ (1 ≤ j ∧ j ≤ k ∧ k ≤ n),
  { rw iff_def, split, intro i, split, exact i.right.left, split, exact i.right.right,
  exact i.left.right, intro i, split, split, apply le_trans, exact i.left, exact i.right.left,
  exact i.right.right, split, exact i.left, exact i.right.left, },

  by_cases (1 ≤ j ∧ j ≤ k ∧ k ≤ n),
  { rw if_pos, rw if_pos, exact h, exact h1.mpr h, },
  rw if_neg,
  rw if_neg,
  exact h,
  rw not_iff_not_of_iff h1,
  exact h,

end

lemma id232a (f : ℕ → ℕ → ℝ) (n : ℕ) (s s2 : finset ℕ) (hs : s = range (n+1) \ (range 1))
(h : ∀ j , s2 = (range (n+1) \ range j)) ( sp = (filter (λ (p:ℕ × ℕ), (p.fst ≤ p.snd)) (s.product s))) :
Sum (λ j, Sum (λ k, (f j k)) s2) s =
∑ p in sp, f p.fst p.snd :=
begin

  rw H,
  rw sum_filter,
  rw aux2,
  rw sum_product,
  rw Sum,
  apply sum_congr,
  refl, intros x i,
  apply sum_congr,
  refl, intros y i2, simp,
  rw hs, rw (h x), simp,

  have h1 : ∀ (x : ℕ), ¬ x = 0 → 1 ≤ x, {intros x i2, apply le_of_not_lt, rw hs at i,
  simp at i, rw not_lt, apply nat.succ_le_of_lt, rw ← gt_iff_lt, exact pos_iff_ne_zero.mpr i2, },

  by_cases (x ≤ y),
  { rw if_pos, rw if_pos, exact h, rw hs at i, simp at i, split, split, exact i.left,
  exact (h1 x i.right), rw hs at i2, simp at i2, split, exact i2.left, exact h, },
  rw if_neg, rw if_neg, exact h, rw not_and, intro i3, rw not_and, intro i4, exact h,

  simp,
  rw hs, rw h,
  exact subset.refl (range (n + 1) \ range 1),

end

lemma id232b (f : ℕ → ℕ → ℝ) (n : ℕ) (s s1 s2 : finset ℕ) (hs1 : ∀ j, s1 = (range (n+1)\range j))
(hs2 : ∀ k, s2 = (range (k+1)\(range 1))) (hs : s = (range (n+1) \ (range 1))) :
Sum (λ j, Sum (λ k, f j k) s1) s =
Sum (λ k, Sum (λ j, f j k) s2) s :=
begin

  rw id230,
  intros j, exact (hs1 j), intro k, exact (hs2 k),

  intros j k,

  have ha : ((j < n + 1 ∧ 1 ≤ j) ∧ k < n + 1 ∧ j ≤ k) ↔ ((1 ≤ j ∧ j ≤ n) ∧ j ≤ k ∧ k ≤ n),
  { split, intro i, split, split, exact i.left.right, apply nat.le_of_lt_succ,
  exact i.left.left, split, exact i.right.right, apply nat.le_of_lt_succ, exact i.right.left,
  intro i, split, split, apply nat.lt_succ_of_le, exact i.left.right, exact i.left.left, split,
  apply nat.lt_succ_of_le, exact i.right.right, exact i.right.left, },

  have hb : ((k < n + 1 ∧ 1 ≤ k) ∧ j < k + 1 ∧ 1 ≤ j) ↔ ((1 ≤ k ∧ k ≤ n) ∧ 1 ≤ j ∧ j ≤ k),
  { split, intro i, split, split, exact i.left.right, apply nat.le_of_lt_succ, exact i.left.left,
  split, exact i.right.right, apply nat.le_of_lt_succ, exact i.right.left, intro i, split, split,
  apply nat.lt_succ_of_le, exact i.left.right, exact i.left.left, split, apply nat.lt_succ_of_le,
  exact i.right.right, exact i.right.left, },

  have h1 : ite (j ∈ range (n + 1) \ range 1) 1 0 * ite (k ∈ range (n + 1) \ range j) 1 0 =
  ite (1 ≤ j ∧ j ≤ k ∧ k ≤ n) 1 0,
  { rw ← id231a, norm_num, rw ← ite_and, rw ← ite_and, by_cases ((1 ≤ j ∧ j ≤ n) ∧ j ≤ k ∧ k ≤ n),
  { rw if_pos, rw if_pos, exact h, rw ha, exact h, }, rw if_neg, rw if_neg, exact h,
  rw (not_iff_not.mpr ha), exact h, },
  rw hs, rw hs1, rw hs2,
  rw h1,

  have h2 : ite (k ∈ range (n + 1) \ range 1) 1 0 * ite (j ∈ range (k + 1) \ range 1) 1 0 =
  ite (1 ≤ j ∧ j ≤ k ∧ k ≤ n) 1 0,
  { rw ← id231b, norm_num,  rw ← ite_and, rw ← ite_and, by_cases ((1 ≤ k ∧ k ≤ n) ∧ 1 ≤ j ∧ j ≤ k),
  { rw if_pos, rw if_pos,exact h, rw hb, exact h, }, rw if_neg, rw if_neg, exact h,
  rw (not_iff_not.mpr hb), exact h, },
  rw h2,

end

lemma id233 (f : ℕ → ℝ) (n : ℕ) (s : finset ℕ) (hs : s = range (n+1) \ (range 1))
 ( sp = (filter (λ (p:ℕ × ℕ), (p.fst ≤ p.snd)) (s.product s))):
∑ p in sp, f p.fst * f p.snd = (1/2) * ((Sum f s)^2 + Sum (f^2) s) :=
begin

  have h1 : ∑ (p : ℕ × ℕ) in filter (λ (p : ℕ × ℕ), p.fst ≤ p.snd) (s.product s),
  f p.fst * f p.snd = ∑ (p : ℕ × ℕ) in filter (λ (p : ℕ × ℕ), p.fst ≥ p.snd)
  (s.product s), f p.fst * f p.snd,
  { simp, rw sum_filter, rw sum_filter, rw sum_product, rw sum_product, simp, rw sum_comm,
  apply congr, refl, apply funext, intro x, apply congr, refl, apply funext, intro y, rw mul_comm, },

  have h2 : ∑ (p : ℕ × ℕ) in filter (λ (p : ℕ × ℕ), p.fst ≤ p.snd) (s.product s),
  f p.fst * f p.snd + ∑ (p : ℕ × ℕ) in filter (λ (p : ℕ × ℕ), p.fst ≤ p.snd) (s.product s),
  f p.fst * f p.snd = ∑ (p : ℕ × ℕ) in filter (λ (p : ℕ × ℕ), p.fst ≤ p.snd) (s.product s),
  f p.fst * f p.snd + ∑ (p : ℕ × ℕ) in filter (λ (p : ℕ × ℕ), p.fst ≥ p.snd)
  (s.product s), f p.fst * f p.snd,
  { rw h1, },

  have h3 : filter (λ (p : ℕ × ℕ), p.fst ≤ p.snd) (s.product s) =
  filter (λ (p : ℕ × ℕ), p.fst <  p.snd) (s.product s) ∪
  filter (λ (p : ℕ × ℕ), p.fst = p.snd) (s.product s),
  { rw filter_union_right, apply filter_congr, intros x i, exact le_iff_lt_or_eq, },

  have h4 : filter (λ (p : ℕ × ℕ), p.fst ≥ p.snd) (s.product s) =
  filter (λ (p : ℕ × ℕ), p.fst > p.snd) (s.product s) ∪
  filter (λ (p : ℕ × ℕ), p.fst = p.snd) (s.product s),
  { rw filter_union_right, apply filter_congr, intros x i, rw ge_iff_le, rw gt_iff_lt,
  rw le_iff_lt_or_eq, split, intro i2, apply (or.elim i2), intro i3, left, exact i3,
  intro i3, right, exact i3.symm, intro i2, apply (or.elim i2), intro i3, left, exact i3,
  intro i3, right, exact i3.symm, },

  have h5 : ∀ (a:ℕ × ℕ) , (a.fst < a.snd ∨ a.fst = a.snd) ∨ a.fst > a.snd ↔ true,
  { intros a, rw ← le_iff_lt_or_eq, simp, exact le_or_lt a.fst a.snd, },

  have h6 : filter (λ (a : ℕ × ℕ), (a.fst < a.snd ∨ a.fst = a.snd)
  ∨ a.fst > a.snd) (s.product s) = filter (λ (a : ℕ × ℕ), true) (s.product s),
  { apply filter_congr, intros x i, exact (h5 x), },

  have h7 : 2 * ∑ p in sp, f p.fst * f p.snd = ∑ p in s.product s, f p.fst * f p.snd
  + ∑ p in (filter (λ (p:ℕ × ℕ), (p.fst = p.snd)) (s.product s)), f p.fst * f p.snd,

  {  rw H, rw two_mul, rw h2, rw h3, rw h4, rw sum_union, rw sum_union, rw ← add_assoc,
  rw add_right_cancel_iff, rw ← sum_union, rw ← sum_union, rw ← filter_or, rw ← filter_or,
  rw h6, rw filter_true, simp, split, rw disjoint_filter, intros x i i2, exact asymm i2,
  rw disjoint_filter, intros x i i2, norm_num, exact (eq.symm i2).ge, repeat {rw disjoint_filter,
  intros x i i2, apply ne_of_lt, exact i2,}, rw disjoint_filter, intros x i i2, apply ne_of_gt,
  exact i2, },

  rw mul_comm,
  rw ← div_eq_iff,
  rw div_div_eq_mul_div,
  rw div_one,
  rw mul_comm,
  rw h7,
  rw id228,
  rw ← pow_two,
  rw add_left_cancel_iff,

  have h8 : ∑ (p : ℕ × ℕ) in filter (λ (p : ℕ × ℕ), p.fst = p.snd)
  (s.product s), f p.fst * f p.snd = ∑ (p : ℕ × ℕ) in filter (λ (p : ℕ × ℕ), p.fst = p.snd)
  (s.product s), (f p.fst)^2,
  { rw sum_filter, rw sum_filter, apply congr, refl, apply funext, intro x, rw pow_two,
   by_cases (x.fst = x.snd), { rw if_pos, rw if_pos, rw ← h, exact h, exact h, },
   rw if_neg, rw if_neg, exact h, exact h, },

  rw h8,
  unfold Sum,
  rw sum_filter,
  rw ← sum_product.symm,
  simp,
  exact sum_extend_by_zero s (λ (i : ℕ), f i ^ 2),
  norm_num,
end

lemma id234 (fa fb : ℕ → ℝ) (n : ℕ) (s : finset ℕ) --(sp : finset ℕ × ℕ)
(hs : s = range (n+1) \ {0}) (sp = (filter (λ (p:ℕ × ℕ), (p.fst < p.snd)) (s.product s))) :
Sum fa s * Sum fb s = n * Sum (fa * fb) s -
∑ p in sp, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) :=
begin
  have h1 : ∑ p in sp, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) =
  ∑ p in sp, (fa p.fst - fa p.snd) * ((fb p.fst) - (fb p.snd)),
  { apply congr, refl, apply funext, intro x, ring, },

  have h2 : ∑ p in sp, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) =
  ∑ p in (filter (λ (p:ℕ × ℕ), (p.fst > p.snd)) (s.product s)),
  (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)),
  { rw h1, rw H, simp, rw sum_filter, rw sum_product, simp, rw sum_comm, rw sum_filter,
  rw sum_product, },

  have h3 : 2 * ∑ p in sp, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) =
  ∑ p in sp, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) +
  ∑ p in (filter (λ (p:ℕ × ℕ), (p.fst > p.snd)) (s.product s)),
  (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)),
  {rw two_mul, rw ← h2,},

  have h5 :  ∑ p in (filter (λ (p:ℕ × ℕ), (p.fst = p.snd)) (s.product s)),
  (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) = 0,
  { rw sum_eq_zero, intros x i, rw mul_eq_zero, left, rw sub_eq_zero, apply congr, refl,
  rw mem_filter at i, apply eq.symm, exact i.right,},

  have h4a : s.product s = filter (λ (a : ℕ × ℕ), true) (s.product s),
  { simp, },

  have h4b : ∀ (a b : ℕ), a < b ∨ a = b ∨ a > b, {exact trichotomous, },

  have h4: 2 * ∑ p in sp, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) =
  ∑ p in s.product s, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) -
  ∑ p in (filter (λ (p:ℕ × ℕ), (p.fst = p.snd)) (s.product s)),
  (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)),
  { rw h3, apply eq.symm, rw sub_eq_iff_eq_add', rw ← sum_union, rw H, rw ← sum_union,
  rw ← filter_or, rw ← filter_or, apply congr, apply congr, refl, rw h4a, rw filter_filter,
  apply filter_congr, intros x i, simp, rw ← gt_iff_lt, exact or.left_comm.mp (h4b x.fst x.snd),
  refl, rw ← filter_or, rw disjoint_filter, intros x i i2 i3, apply or.elim i3,
  intro i4, linarith, intro i4, linarith, rw H, rw disjoint_filter, intros x i i2 i3,
  linarith, },

  rw h5 at h4,
  rw sub_zero at h4,

  have h6a : ∑ p in s.product s, fa p.fst * fb p.snd =
  ∑ p in s.product s, fa p.snd * fb p.fst,
  { rw sum_product, rw sum_comm, rw sum_product, },

  have h6b : ∑ p in s.product s, fa p.fst * fb p.fst =
   ∑ p in s.product s, fa p.snd * fb p.snd,
   { rw sum_product, rw sum_comm, rw sum_product, },

  have h6 : ∑ p in s.product s, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) =
  2*n * Sum (fa * fb) s - 2 * Sum fa s * Sum fb s,
  {calc
  ∑ p in s.product s, (fa p.snd - fa p.fst) * ((fb p.snd) - (fb p.fst)) =
  ∑ p in s.product s, fa p.fst * fb p.fst - ∑ p in s.product s, fa p.fst * fb p.snd -
  ∑ p in s.product s, fa p.snd * fb p.fst + ∑ p in s.product s, fa p.snd * fb p.snd :
  by { rw ← sum_sub_distrib, rw ← sum_sub_distrib, rw ← sum_add_distrib, apply congr, refl,
  apply funext, intro x, ring, }
  ...                 = 2 * ∑ p in s.product s, fa p.snd * fb p.snd -
  2 * ∑ p in s.product s, fa p.fst * fb p.snd :
  by {rw h6a, rw sub_sub, rw ← two_mul, rw h6b, ring, }
  ...                 = 2 * ∑ p in s.product s, fa p.snd * fb p.snd - 2 * Sum fa s * Sum fb s :
  by {simp, rw mul_assoc, rw id228, }
  ...                 = 2*n * Sum (fa * fb) s - 2 * Sum fa s * Sum fb s :
  by { rw mul_assoc, rw mul_assoc, rw ← mul_sub, rw ← mul_sub, simp, rw sum_product,
  rw Sum, simp, left, rw hs, rw card_sdiff, norm_num, norm_num, },
  },

  rw ← h4 at h6,
  repeat {rw mul_assoc at h6},
  rw ← mul_sub at h6,
  rw mul_eq_mul_left_iff at h6,
  apply or.elim h6,
  { intro i, apply eq.symm, rw sub_eq_iff_eq_add', rw ← sub_eq_iff_eq_add, exact i.symm, },
  norm_num,

end

lemma id235 (fa : ℕ → ℝ) (fp : ℕ → ℕ) (sj sk : finset ℕ) (hp : ∀ j ∈ sj, fp j ∈ sk) :
Sum (λ j, fa (fp j)) sj = Sum (λ k, fa k * card (filter (λ j, fp j = k) sj)) sk :=
begin
  have h1 : ∀ k, Sum (λ j, ite (fp j = k) 1 0 ) sj = card (filter (λ j, fp j = k) sj),
  { intro k, rw Sum, rw sum_ite, rw add_comm, rw sum_eq_zero, rw zero_add,
  rw sum_const, simp, intros x i, refl, },

  have h2 : Sum (λ k, fa k * card (filter (λ j, fp j = k) sj)) sk =
  Sum (λ k, fa k * Sum (λ j, ite (fp j = k) 1 0 ) sj ) sk,
  { apply congr, apply congr, refl, apply funext, intro x, simp, left, exact (h1 x).symm,
  refl, },

  rw h2,

  have h3 : Sum (λ k, fa k * Sum (λ j, ite (fp j = k) 1 0 ) sj ) sk =
  Sum (λ k, Sum (λ j, fa k * ite (fp j = k) 1 0 ) sj ) sk,
  { apply congr, apply congr, refl, apply funext, intro x, rw SumDistr, refl, },

  rw h3,
  rw id229b,

  have h4 : ∀ x, (λ (j : ℕ), fa (fp j)) x = fa (fp x), {exact congr_fun rfl,},
  have h5 : ∀ x, (λ (k : ℕ), Sum (λ (j : ℕ), fa j * ite (fp k = j) 1 0) sk) x =
   Sum (λ (j : ℕ), fa j * ite (fp x = j) 1 0) sk, { exact congr_fun rfl,},

  apply sum_congr, refl, intros x hj, rw h4, rw h5, rw Sum,
  rw sum_mul_boole,

  rw if_pos, apply hp, exact hj,

end

lemma id236 (n : ℕ) :
Sum (λ k, Sum (λ j, 1/j) (range (k+1)\{0})) (range n) =
n * Sum (λ j, 1/j) (range (n+1)\{0}) - n :=
begin

  induction n with n ih,
  { simp, rw Sum, rw sum_empty,  },
  change n.succ with (n+1),
  have h1 : range (n + 1) = range n ∪ {n}, { rw range_add_one, rw union_comm, refl,},
  rw h1,
  rw Sum,
  rw sum_union,
  rw ← Sum,
  rw ih,
  rw sum_singleton,
  have h2 : range (n + 1 + 1) = range (n+1) ∪ {n+1},
  { rw range_add_one, rw union_comm,  refl,},
  have h3 : {n+1} \ {0} = {n+1}, { rw sdiff_singleton_eq_erase, refl, },
  rw h2,
  rw Sum, rw Sum,
  rw union_sdiff_distrib,
  rw sum_union,
  rw h3,
  rw sum_singleton,
  rw add_comm,
  rw add_sub,
  --have h4 : ∑ (k : ℕ) in range (n + 1) \ {0}, 1 / ↑k +
  -- ↑n * ∑ (k : ℕ) in range (n + 1) \ {0}, 1 / ↑k = (n + 1) *
  -- ∑ (k : ℕ) in range (n + 1) \ {0}, 1 / ↑k,
  --{ rw add_mul, rw one_mul, rw add_comm, simp, },
  rw mul_comm ↑(n + 1),
  rw add_mul,
  rw div_mul_cancel,
  simp,
  --rw mul_comm (∑ (x : ℕ) in range (n + 1) \ {0}, (↑x)⁻¹),
  ring,
  exact (nat.add n 0).cast_add_one_ne_zero,
  rw disjoint_iff_inter_eq_empty,
  rw inter_sdiff,
  rw sdiff_singleton_eq_erase,
  simp,
  simp,

end


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

! This file was ported from Lean 3 source module data.erased
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Equiv.Defs

/-!
# A type for VM-erased data

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

This file defines a type `erased α` which is classically isomorphic to `α`,
but erased in the VM. That is, at runtime every value of `erased α` is
represented as `0`, just like types and proofs.
-/

universe u

#print Erased /-
/-- `erased α` is the same as `α`, except that the elements
  of `erased α` are erased in the VM in the same way as types
  and proofs. This can be used to track data without storing it
  literally. -/
def Erased (α : Sort u) : Sort max 1 u :=
  Σ's : α → Prop, ∃ a, (fun b => a = b) = s
#align erased Erased
-/

namespace Erased

#print Erased.mk /-
/-- Erase a value. -/
@[inline]
def mk {α} (a : α) : Erased α :=
  ⟨fun b => a = b, a, rfl⟩
#align erased.mk Erased.mk
-/

#print Erased.out /-
/-- Extracts the erased value, noncomputably. -/
noncomputable def out {α} : Erased α → α
  | ⟨s, h⟩ => Classical.choose h
#align erased.out Erased.out
-/

#print Erased.OutType /-
/-- Extracts the erased value, if it is a type.

Note: `(mk a).out_type` is not definitionally equal to `a`.
-/
@[reducible]
def OutType (a : Erased (Sort u)) : Sort u :=
  out a
#align erased.out_type Erased.OutType
-/

#print Erased.out_proof /-
/-- Extracts the erased value, if it is a proof. -/
theorem out_proof {p : Prop} (a : Erased p) : p :=
  out a
#align erased.out_proof Erased.out_proof
-/

#print Erased.out_mk /-
@[simp]
theorem out_mk {α} (a : α) : (mk a).out = a :=
  by
  let h; show Classical.choose h = a
  have := Classical.choose_spec h
  exact cast (congr_fun this a).symm rfl
#align erased.out_mk Erased.out_mk
-/

#print Erased.mk_out /-
@[simp]
theorem mk_out {α} : ∀ a : Erased α, mk (out a) = a
  | ⟨s, h⟩ => by simp [mk] <;> congr <;> exact Classical.choose_spec h
#align erased.mk_out Erased.mk_out
-/

#print Erased.out_inj /-
@[ext]
theorem out_inj {α} (a b : Erased α) (h : a.out = b.out) : a = b := by simpa using congr_arg mk h
#align erased.out_inj Erased.out_inj
-/

#print Erased.equiv /-
/-- Equivalence between `erased α` and `α`. -/
noncomputable def equiv (α) : Erased α ≃ α :=
  ⟨out, mk, mk_out, out_mk⟩
#align erased.equiv Erased.equiv
-/

instance (α : Type u) : Repr (Erased α) :=
  ⟨fun _ => "erased"⟩

instance (α : Type u) : ToString (Erased α) :=
  ⟨fun _ => "erased"⟩

unsafe instance (α : Type u) : has_to_format (Erased α) :=
  ⟨fun _ => ("erased" : format)⟩

#print Erased.choice /-
/-- Computably produce an erased value from a proof of nonemptiness. -/
def choice {α} (h : Nonempty α) : Erased α :=
  mk (Classical.choice h)
#align erased.choice Erased.choice
-/

#print Erased.nonempty_iff /-
@[simp]
theorem nonempty_iff {α} : Nonempty (Erased α) ↔ Nonempty α :=
  ⟨fun ⟨a⟩ => ⟨a.out⟩, fun ⟨a⟩ => ⟨mk a⟩⟩
#align erased.nonempty_iff Erased.nonempty_iff
-/

instance {α} [h : Nonempty α] : Inhabited (Erased α) :=
  ⟨choice h⟩

#print Erased.bind /-
/-- `(>>=)` operation on `erased`.

This is a separate definition because `α` and `β` can live in different
universes (the universe is fixed in `monad`).
-/
def bind {α β} (a : Erased α) (f : α → Erased β) : Erased β :=
  ⟨fun b => (f a.out).1 b, (f a.out).2⟩
#align erased.bind Erased.bind
-/

/- warning: erased.bind_eq_out -> Erased.bind_eq_out is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} (a : Erased.{u1} α) (f : α -> (Erased.{u2} β)), Eq.{max 1 u2} (Erased.{u2} β) (Erased.bind.{u1, u2} α β a f) (f (Erased.out.{u1} α a))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} (a : Erased.{u2} α) (f : α -> (Erased.{u1} β)), Eq.{max 1 u1} (Erased.{u1} β) (Erased.bind.{u2, u1} α β a f) (f (Erased.out.{u2} α a))
Case conversion may be inaccurate. Consider using '#align erased.bind_eq_out Erased.bind_eq_outₓ'. -/
@[simp]
theorem bind_eq_out {α β} (a f) : @bind α β a f = f a.out := by
  delta bind bind._proof_1 <;> cases f a.out <;> rfl
#align erased.bind_eq_out Erased.bind_eq_out

#print Erased.join /-
/-- Collapses two levels of erasure.
-/
def join {α} (a : Erased (Erased α)) : Erased α :=
  bind a id
#align erased.join Erased.join
-/

#print Erased.join_eq_out /-
@[simp]
theorem join_eq_out {α} (a) : @join α a = a.out :=
  bind_eq_out _ _
#align erased.join_eq_out Erased.join_eq_out
-/

#print Erased.map /-
/-- `(<$>)` operation on `erased`.

This is a separate definition because `α` and `β` can live in different
universes (the universe is fixed in `functor`).
-/
def map {α β} (f : α → β) (a : Erased α) : Erased β :=
  bind a (mk ∘ f)
#align erased.map Erased.map
-/

/- warning: erased.map_out -> Erased.map_out is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} {f : α -> β} (a : Erased.{u1} α), Eq.{u2} β (Erased.out.{u2} β (Erased.map.{u1, u2} α β f a)) (f (Erased.out.{u1} α a))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} {f : α -> β} (a : Erased.{u2} α), Eq.{u1} β (Erased.out.{u1} β (Erased.map.{u2, u1} α β f a)) (f (Erased.out.{u2} α a))
Case conversion may be inaccurate. Consider using '#align erased.map_out Erased.map_outₓ'. -/
@[simp]
theorem map_out {α β} {f : α → β} (a : Erased α) : (a.map f).out = f a.out := by simp [map]
#align erased.map_out Erased.map_out

instance : Monad Erased where
  pure := @mk
  bind := @bind
  map := @map

#print Erased.pure_def /-
@[simp]
theorem pure_def {α} : (pure : α → Erased α) = @mk _ :=
  rfl
#align erased.pure_def Erased.pure_def
-/

#print Erased.bind_def /-
@[simp]
theorem bind_def {α β} : ((· >>= ·) : Erased α → (α → Erased β) → Erased β) = @bind _ _ :=
  rfl
#align erased.bind_def Erased.bind_def
-/

#print Erased.map_def /-
@[simp]
theorem map_def {α β} : ((· <$> ·) : (α → β) → Erased α → Erased β) = @map _ _ :=
  rfl
#align erased.map_def Erased.map_def
-/

instance : LawfulMonad Erased := by refine' { .. } <;> intros <;> ext <;> simp

end Erased


import Smt

theorem modus_ponens' (p q : Prop) (hp : p) (hpq : p → q) : q := by
  smt [hp, hpq]


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

section /- Basic definitions -/

class RSMul (χ α : Type u) where
  smul : χ → α → χ

class HasUnion (α : Type u) where
  union : α → α → α

class HasIncluded (α : Type u) where
  included : α → α → Prop

class HasWithout (α : Type u) where
  without : α → α → α

class HasVehicle (α β : Type u) where
  vehicle : α → β

infix:70 " • " => RSMul.smul
infixl:60 " ∪ " => HasUnion.union
infix:50 " ⊆ " => HasIncluded.included
infixl:65 " \\ " => HasWithout.without
notation:max "𝒱 " a:arg => HasVehicle.vehicle a

end

section /- Miscellaneous basic definitions and theorems -/

def contrapose {p q : Prop} : (p → q) → (¬ q → ¬ p) := λ h₁ h₂ h₃ => h₂ (h₁ h₃)

theorem or_comm {P Q : Prop} : P ∨ Q ↔ Q ∨ P := by
  apply Iff.intro <;> intro h <;> cases h
    <;> first
    | apply Or.inl; assumption
    | apply Or.inr; assumption

theorem or_assoc {p q r : Prop} : (p ∨ q) ∨ r ↔ p ∨ q ∨ r := Iff.intro
  (λ h => by cases h with
    | inl h => cases h <;> simp_all
    | inr h => simp_all)
  (λ h => by cases h with
    | inl h => simp_all
    | inr h => cases h <;> simp_all)

theorem eq_of_eq_true_iff_eq_true {a b : Bool} (h : a = true ↔ b = true) : a = b := by
  cases a <;> cases b
  rfl
  exact h.2 rfl
  exact (h.1 rfl).symm
  rfl

theorem Prod.eq {α : Type u} {a b c d : α} (h₁ : a = c) (h₂ : b = d) :
  (a, b) = (c, d) := h₁ ▸ h₂ ▸ rfl

theorem Nat.eq_of_le_of_le {a b : Nat} (h : a ≤ b) (h' : b ≤ a) : a = b :=
  match Nat.eq_or_lt_of_le h with
  | Or.inl p => p
  | Or.inr p => False.elim <| Nat.not_le_of_gt p h'

theorem Nat.le_of_le_of_le {a b c d : Nat} (h : a ≤ b) (h' : c ≤ d) : a + c ≤ b + d :=
  Nat.le_trans (Nat.add_le_add_left h' _) (Nat.add_le_add_right h _)

theorem Nat.add_ne_zero_of_r_ne_zero {a b : Nat} (h : b ≠ 0) : a + b ≠ 0 :=
  λ h' => match b with
  | 0 => h rfl
  | b + 1 => succ_ne_zero (a + b) h'

theorem Nat.add_ne_zero_of_l_ne_zero {a b : Nat} (h : a ≠ 0) : a + b ≠ 0 := by
  rw [Nat.add_comm]
  exact add_ne_zero_of_r_ne_zero h

theorem Nat.one_le_of_ne_zero {a : Nat} (h : a ≠ 0) : 1 ≤ a := match a with
  | 0 => False.elim <| h rfl
  | a + 1 => Nat.succ_le_succ (Nat.zero_le _)

theorem Nat.not_lt_self (a : Nat) : ¬ a < a := by
  intro h
  induction a with
  | zero => simp [Nat.lt] at h
  | succ a rh => exact rh <| Nat.lt_of_succ_lt_succ h

theorem Nat.lt_of_not_le {a b : Nat} (h : ¬ a ≤ b) : b < a :=
  match Nat.lt_or_ge b a with
  | Or.inl h' => h'
  | Or.inr h' => False.elim <| h h'

theorem Nat.succ_pred_of_nonzero {n : Nat} (h : n ≠ 0) : succ (pred n) = n := by
  revert h
  cases n with
  | zero => simp
  | succ n => intro; rfl

theorem Nat.lt_pred_of_succ_lt {n m : Nat} (h : succ n < m) : n < pred m := by
  apply lt_of_succ_lt_succ
  rw [succ_pred_of_nonzero]
  exact h
  intro h'
  rw [h'] at h
  exact not_lt_zero _ h

theorem Nat.zero_lt_sub {n m : Nat} (h : n < m) : 0 < m - n := by
  suffices p : ∀ k, n + k < m → k < m - n from p 0 h
  suffices p : ∀ k, n < m → n + k < m → k < m - n from λ _ => p _ h
  induction n with
  | zero => intro k _ h; rw [Nat.zero_add] at h; exact h
  | succ n rh =>
    intro k h h'
    rw [sub_succ]
    rw [succ_add] at h'
    exact lt_pred_of_succ_lt <| rh (lt_of_succ_lt h) (succ k) (lt_of_succ_lt h) h'

theorem Nat.sub_add_self {n m : Nat} (h : m ≤ n) : n - m + m = n := by
  induction m with
  | zero => rfl
  | succ m rh =>
    rw [add_succ, sub_succ, ← succ_add]
    by_cases p : n - m = 0
    focus
      have p' := zero_lt_sub h
      rw [p] at p'
      exact False.elim <| Nat.not_lt_self _ p'
    focus
      rw [succ_pred_of_nonzero p]
      apply rh
      exact Nat.le_of_lt <| Nat.lt_of_lt_of_le (Nat.lt_succ_self _) h

theorem Nat.lt_of_add_lt_add {n m : Nat} (k : Nat) (h : n + k < m + k) : n < m := by
  induction k with
  | zero => exact h
  | succ k rh =>
    apply rh ∘ lt_of_succ_lt_succ
    simp_all [add_succ]

theorem List.elem_iff_mem {α : Type u} [DecidableEq α] {x : α} {l : List α} :
  elem x l ↔ x ∈ l := Iff.intro mem_of_elem_eq_true elem_eq_true_of_mem

theorem List.mem_head_or_mem_tail {α : Type u} {x y : α} {l : List α} :
  x ∈ (y :: l) ↔ x = y ∨ x ∈ l := by
  apply Iff.intro
  focus
    intro h
    cases h with
    | head => simp
    | tail _ h => exact Or.inr h
  exact λ h => match h with
  | .inl h => h ▸ Mem.head _ _
  | .inr h => Mem.tail _ h

theorem List.mem_append {α : Type u} {x : α} {l₁ l₂ : List α} :
  x ∈ (l₁ ++ l₂) ↔ x ∈ l₁ ∨ x ∈ l₂ := by
  apply Iff.intro
  focus
    induction l₁ with
    | nil => simp [List.append]; exact Or.inr
    | cons y t h =>
      by_cases h' : x = y
      <;> simp [h', List.append, Membership.mem, Mem]
      intro p
      apply Or.inl
      apply Mem.head
      intro p
      cases p with
      | head _ _ => exact Or.inl <| Mem.head _ _
      | tail _ h' =>
        exact match h h' with
        | .inl h => Or.inl <| Mem.tail _ h
        | .inr h => Or.inr h
  focus
    intro h
    match h with
    | Or.inl h => exact mem_append_of_mem_left _ h
    | Or.inr h => exact mem_append_of_mem_right _ h

-- Replace this theorem with `List.mem_map_iff_image` ?
theorem List.mem_map {α β : Type u} {x : α} {f : α → β} {l : List α} :
  x ∈ l → (f x) ∈ (List.map f l) := by induction l with
  | nil =>
    intro h
    cases h
  | cons y t h =>
    intro h'
    cases h' with
    | head => exact Mem.head _ _
    | tail _ h' => exact Mem.tail _ <| h h'

theorem List.mem_map_iff_image {α β : Type u} {y : β} {f : α → β} {l : List α} :
  y ∈ (List.map f l) ↔ ∃ x, x ∈ l ∧ y = f x := by
  apply Iff.intro
  focus
    induction l with
    | nil =>
      intro h
      cases h
    | cons x t rh =>
      intro h
      by_cases p : y = f x
      focus
        exact ⟨ x, by simp [List.mem_head_or_mem_tail, p] ⟩
      focus
        let ⟨ z, h ⟩ := rh (by simp [map, List.mem_head_or_mem_tail, p] at h; assumption)
        apply Exists.intro z
        exact ⟨ Mem.tail _ h.1, h.2 ⟩
  focus
    exact λ ⟨ x, ⟨ h₁, h₂ ⟩ ⟩ => h₂ ▸ List.mem_map h₁

private def internal (p : α → Bool) : List α → List α → List α
  | [],    rs => rs
  | a::as, rs => match p a with
     | true  => internal p as (a::rs)
     | false => internal p as rs

private theorem append_eq (a : α) (l : List α) : a :: l = [a] ++ l := rfl

private theorem append_eq' (l : List α) : l ++ [] = l := by
  induction l with
  | nil => rfl
  | cons a l rh => rw [append_eq, List.append_assoc, rh]

private theorem internal_eq₁ (p : α → Bool) (as rs : List α) :
  internal p as rs = internal p as [] ++ rs := by
  induction as generalizing rs with
  | nil => rfl
  | cons a as rh =>
    simp only [internal]
    cases p a <;> simp only [rh rs, rh (a :: rs), rh [a]]
    rw [append_eq a rs, ← List.append_assoc]

private theorem internal_eq₂ (p : α → Bool) (as rs : List α) (a : α) :
  internal p (a :: as) rs = internal p []
    (internal p as [] ++ (if p a then [a] else []) ++ rs) := by
  induction as generalizing a rs with
  | nil =>
    simp only [internal]
    cases p a <;> simp
  | cons b as rh =>
    simp only [internal]
    cases h : p a <;> cases p b <;> conv => simp_match; simp_match
      <;> simp only [if_pos, if_neg]
      <;> simp only [internal_eq₁ _ _ rs, internal_eq₁ _ _ [b],
        internal_eq₁ _ _ (b :: rs), internal_eq₁ _ _ (a :: rs),
        internal_eq₁ _ _ (b :: a :: rs)]
      <;> simp only [append_eq a rs, append_eq b rs, append_eq b ([a] ++ rs)]
      <;> simp only [← List.append_assoc, append_eq']

private theorem List.filterAux_eq₁ (p : α → Bool) (as rs : List α) :
  filterAux p as rs = reverse (internal p as rs) := by
  induction as generalizing rs with
  | nil => rfl
  | cons a as rha =>
    induction rs
      <;> simp only [filterAux, internal]
      <;> cases p a <;> simp [rha]

private theorem List.filterAux_eq₂ (p : α → Bool) (as : List α) (a : α) :
  filterAux p (a :: as) [] = (if p a then [a] else []) ++ reverse (internal p as []) := by
  suffices h : filterAux p (a :: as) [] =
    reverse (internal p as [] ++ (if p a then [a] else [])) by
    rw [reverse_append] at h
    revert h
    cases p a <;> conv => simp_match <;> simp only [if_pos, if_neg]
      <;> exact id
  rw [filterAux_eq₁]
  simp only [internal]
  cases p a <;> conv => simp_match <;> simp only [if_pos, if_neg, internal_eq₁ _ _ [a]]
    <;> simp [append_eq', if_pos]

theorem List.filter_eq {α : Type u} {f : α → Bool} {l : List α} {a : α} :
  filter f (a :: l) = if f a then a :: filter f l else filter f l := by
  simp only [filter]
  rw [filterAux_eq₂, filterAux_eq₁]
  cases f a <;> simp only [if_pos, if_neg]
  rfl
  rw [← append_eq]

theorem List.mem_filter {α : Type u} {f : α → Bool} {l : List α} {x : α} :
  x ∈ (List.filter f l) ↔ x ∈ l ∧ f x := by
  induction l with
  | nil =>
    simp only [filter, filterAux, reverse, reverseAux]
    apply Iff.intro
    intro h; cases h
    intro h; cases h.1
  | cons y t rh =>
    by_cases p : f y
    focus
      by_cases p' : x = y
      focus
        rw [p']
        rw [p'] at rh
        rw [List.filter_eq]
        simp [mem_head_or_mem_tail, filter, filterAux, p]
      focus
        rw [List.filter_eq]
        simp only [p, mem_head_or_mem_tail, p', false_or]
        rw [← rh]
        simp [mem_head_or_mem_tail]
        simp_all
    focus
      have p : f y = false := eq_false_of_ne_true p
      apply Iff.intro
      focus
        intro h
        suffices p : x ∈ (filter f t) ∧ x ≠ y by
          simp [mem_head_or_mem_tail, p, rh.1 p.1]
        apply And.intro
        focus
          simp_all [mem_head_or_mem_tail, filter, filterAux]
        focus
          suffices h : f x by
            intro h'
            rw [h'] at h
            apply Bool.noConfusion (Eq.trans p.symm h)
          simp_all [mem_head_or_mem_tail, filter, filterAux]
      focus
        simp [mem_head_or_mem_tail, filter, filterAux, p]
        intro ⟨ hl, hr ⟩
        apply rh.2 (And.intro _ hr)
        cases hl with
        | inl hl =>
          rw [hl] at hr
          apply Bool.noConfusion (Eq.trans p.symm hr)
        | inr hl => exact hl

theorem List.length_filter (l : List α) (f : α → Bool) :
  List.length (List.filter f l) ≤ List.length l := by
  induction l with
  | nil => exact Nat.zero_le _
  | cons a t rh =>
    rw [List.filter_eq]
    by_cases p : f a = true
    exact if_pos p ▸ Nat.succ_le_succ rh
    exact if_neg p ▸ Nat.le_trans rh (Nat.le_of_lt <| Nat.lt_succ_self _)

private def strong_induction_length {α : Type u} {C : List α → Prop} (a : List α)
  (step : ∀ (x : List α),
    (∀ (y : List α), List.length y < List.length x → C y) → C x) : C a :=
  (measure List.length).wf.induction _ step

theorem List.filter_mem_length_le [DecidableEq α] {l : List α} {a : α} (h : a ∈ l) :
  List.length (List.filter (λ b => b ≠ a) l) + 1 ≤ List.length l := by
  induction l using strong_induction_length with
  | step l rh =>
    cases l with
    | nil => exact False.elim <| by cases h
    | cons b t =>
      rw [List.filter_eq]
      by_cases p : decide (b ≠ a) = true
      focus
        rw [if_pos p]
        apply Nat.succ_le_succ
        apply rh _ (Nat.lt_succ_self _)
        exact match h with
        | Mem.head _ _ => False.elim <| (of_decide_eq_true p).symm rfl
        | Mem.tail _ h => h
      focus
        rw [if_neg p]
        exact Nat.succ_le_succ <| List.length_filter _ _

def List.included {α : Type u} (l₁ l₂ : List α) := ∀ a, a ∈ l₁ → a ∈ l₂

def List.concat_map {α β : Type u} (f : α → List β) : List α → List β
| [] => []
| x :: t => List.append (f x) (concat_map f t)

end

section /- Let's define the minimim of a nonempty set in `ℕ`... -/

open Classical

set_option codegen false

private theorem rev_bounded_wf (M : Nat) : WellFounded λ m n => n < m ∧ n ≤ M ∧ m ≤ M := by
  suffices p : WellFounded λ m n => M - m < M - n ∧ n ≤ M ∧ m ≤ M by
    apply Subrelation.wf _ p
    intro m n ⟨ h, nM, mM ⟩
    apply And.intro _ ⟨ nM, mM ⟩
    apply Nat.lt_of_add_lt_add (n + m)
    conv => lhs; rw [Nat.add_comm n m, ← Nat.add_assoc]
    rw [← Nat.add_assoc]
    rw [Nat.sub_add_self nM, Nat.sub_add_self mM]
    exact Nat.add_lt_add_left h _
  suffices p : WellFounded λ m n : Nat => m < n by
    let p := InvImage.wf (λ n => M - n) p
    apply Subrelation.wf _ p
    intro m n ⟨ h, _, _ ⟩
    simp only [InvImage]
    exact h
  have p : (λ m n : Nat => m < n) = Nat.lt := by funext _ _; rfl
  rw [p]
  exact Nat.lt_wfRel.wf

def set_min (P : Nat → Prop) (h : ∃ n, P n) : Nat :=
  go 0
  where
    P' := λ n => ∃ k, k ≤ n ∧ P k
    goF (n : Nat) (f : (m : Nat) → ¬ (∃ k, k ≤ n ∧ P k) ∧ m = n + 1 → Nat) : Nat :=
      if h : ∃ k, k ≤ n ∧ P k then n else f (n + 1) ⟨ h, rfl ⟩
    go := @WellFounded.fix Nat (λ _ => Nat) _ (match h with
      | ⟨ M, hM ⟩ => by
        suffices p : WellFounded λ m n => m = n + 1 ∧ m ≤ M by
          apply Subrelation.wf _ p
          intro n m ⟨ p, h ⟩
          apply And.intro h
          apply byContradiction
          intro h'
          apply p ⟨ M, _, hM ⟩
          have h' := Nat.lt_of_not_le h'
          rw [h] at h'
          exact Nat.le_of_lt_succ h'
        suffices p : WellFounded λ m n => n < m ∧ n ≤ M ∧ m ≤ M by
          apply Subrelation.wf _ p
          intro n m ⟨ h, h' ⟩
          apply And.intro _ (And.intro _ h')
          focus
            rw [h]
            exact Nat.lt_succ_self _
          focus
            apply Nat.le_trans (Nat.le_of_lt <| Nat.lt_succ_self m)
            rw [← Nat.add_one, ← h]
            exact h'
        exact rev_bounded_wf _
        ) goF

private theorem go_eq (P : Nat → Prop) (h : ∃ n, P n) (n : Nat) (h' : ∀ k, k < n → ¬ P k) :
  set_min.go P h n = if P n then n else set_min.go P h (n + 1) := by
  simp only [set_min.go]
  rw [WellFounded.fix_eq]
  simp only [set_min.goF]
  suffices p : (∃ k, k ≤ n ∧ P k) = P n by rw [p]; rfl
  apply propext
  apply Iff.intro _ λ h => ⟨ n, Nat.le_refl _, h ⟩
  focus
    intro ⟨ k, h₁, h₂ ⟩
    suffices p : k = n by rw [p.symm]; exact h₂
    exact match Nat.eq_or_lt_of_le h₁ with
    | Or.inl h => h
    | Or.inr h => False.elim <| h' k h h₂

private theorem go_eq₂ (P : Nat → Prop) (h : ∃ n, P n) {M : Nat}
  (h' : ∀ n, n < M → ¬ P n) : set_min P h = set_min.go P h M := by
  simp only [set_min]
  induction M with
  | zero => rfl
  | succ M rh =>
    suffices p : ∀ n, n < M → ¬ P n by
      rw [rh p]
      rw [go_eq _ _ _ p]
      simp [h' M (Nat.lt_succ_self _)]
    exact λ _ h => h' _ <| Nat.lt_trans h (Nat.lt_succ_self _)

private theorem go_spec (P : Nat → Prop) (h : ∃ n, P n) (m : Nat)
  (h' : m ≤ set_min P h) : ∀ n, n < m → ¬ P n := by
  induction m with
  | zero => intro; simp [Nat.not_lt_zero]
  | succ k rh =>
    intro n
    intro h₁
    have p : k < set_min P h := h'
    specialize rh (Nat.le_of_lt p)
    rw [go_eq₂ _ _ rh, go_eq _ _ k rh] at p
    suffices p' : ¬ P k by
      match Nat.eq_or_lt_of_le <| Nat.le_of_lt_succ h₁ with
      | Or.inl h₁ => rw [h₁]; exact p'
      | Or.inr h₁ => exact rh _ h₁
    by_cases p' : P k
    focus
      apply False.elim ∘ Nat.not_lt_self k
      simp_all [p']
    focus
      exact p'

theorem eq_set_min (P : Nat → Prop) (h : ∃ n, P n) {M : Nat}
  (h₁ : P M) (h₂ : ∀ n, n < M → ¬ P n) : M = set_min P h := by
  rw [go_eq₂ _ _ h₂, go_eq _ _ _ h₂]
  simp [h₁]

theorem rev_induction (M : Nat) {C : Nat → Prop} (n : Nat)
  (ind : ∀ m, (∀ n, m < n ∧ m ≤ M ∧ n ≤ M → C n) → C m) : C n :=
  (rev_bounded_wf M).induction n ind

theorem set_min_spec₀ (P : Nat → Prop) (h : ∃ n, P n) {m : Nat}
  (h' : ∀ n, n < m → ¬ P n) : m ≤ set_min P h := match h with
  | ⟨ M, hM ⟩ => by
    apply @rev_induction M (λ m => (∀ n, n < m → ¬ P n) → m ≤ set_min P h) m _ h'
    intro m rh h'
    rw [go_eq₂ P h h', go_eq P h _ h']
    by_cases p : P m
    focus
      simp [p, Nat.le_refl]
    focus
      rw [show (if P m then m else set_min.go P h (m + 1))
        = set_min.go P h (m + 1) by simp [p]]
      apply Nat.le_trans (Nat.le_of_lt <| Nat.lt_succ_self m)
      suffices p : ∀ n, n < m + 1 → ¬ P n by
        rw [← go_eq₂ P h p]
        apply rh _ _ p
        apply And.intro (Nat.lt_succ_self m)
        suffices p : m + 1 ≤ M from
          And.intro (Nat.le_trans (Nat.le_of_lt <| Nat.lt_succ_self _) p) p
        match Nat.lt_or_ge M (m + 1) with
        | Or.inl p' =>
          apply False.elim
          match Nat.eq_or_lt_of_le <| Nat.le_of_lt_succ p' with
          | Or.inl p' =>
            apply p m <| Nat.lt_succ_self _
            rw [← p']
            exact hM
          | Or.inr p' => exact h' _ p' hM
        | Or.inr p' => exact p'
      intro n h
      match Nat.eq_or_lt_of_le <| Nat.le_of_lt_succ h with
      | Or.inl p' => rw [p']; exact p
      | Or.inr p' => exact h' _ p'

theorem set_min_spec₁ (P : Nat → Prop) (h : ∃ n, P n) : P (set_min P h) := by
  apply byContradiction
  intro h'
  suffices p : set_min P h + 1 ≤ set_min P h from Nat.not_lt_self _ p
  apply set_min_spec₀
  intro n h''
  exact match Nat.eq_or_lt_of_le <| Nat.le_of_lt_succ h'' with
  | Or.inl h'' => h'' ▸ h'
  | Or.inr h'' => go_spec P h (n + 1) h'' _ (Nat.lt_succ_self _)

theorem set_min_spec₂ (P : Nat → Prop) (h : ∃ n, P n) : ∀ n, P n → set_min P h ≤ n := by
  intro n h'
  match Nat.lt_or_ge n (set_min P h) with
  | Or.inl p =>
    apply False.elim ∘ (λ p' : ¬ P n => p' h')
    exact go_spec P h (n + 1) p _ (Nat.lt_succ_self n)
  | Or.inr p => exact p

theorem set_min_le_of_included {P Q : Nat → Prop} (hP : ∃ n, P n) (hQ : ∃ n, Q n)
  (h : ∀ n, P n → Q n) : set_min Q hQ ≤ set_min P hP := by
  apply set_min_spec₀
  intro n h' p
  apply Nat.not_lt_self _ ∘ Nat.lt_of_lt_of_le h'
  apply set_min_spec₂
  exact h _ p

end

section Algebra /- Some algebraic notions -/
/- (at the time of writing, mathlib4 isn't ready so we need to redefine everything.) -/

universe u

class One (α : Type u) where
  one : α

instance (α : Type u) [One α] : OfNat α (nat_lit 1) where
  ofNat := One.one

class Monoid (α : Type u) extends Mul α, One α where
  mul_assoc (f g h : α) : f * g * h = f * (g * h)
  one_mul (f : α) : 1 * f = f
  mul_one (f : α) : f * 1 = f

class RAction (χ : Type u) (α : Type u) [Monoid α] extends RSMul χ α where
  smul_one (x : χ) : x • (1 : α) = x
  smul_mul (x : χ) (a b : α) : (x • a) • b = x • (a * b)

instance self_action (α : Type u) [Monoid α] : RAction α α where
  smul := Mul.mul
  smul_one := Monoid.mul_one
  smul_mul := Monoid.mul_assoc

instance square_monoid (α : Type u) [m : Monoid α] : Monoid (α × α) where
  one := ⟨ 1, 1 ⟩
  mul := λ (a₁, a₂) (b₁, b₂) => (a₁ * b₁, a₂ * b₂)
  one_mul := by intro (_, _); apply Prod.eq <;> exact m.one_mul _
  mul_one := by intro (_, _); apply Prod.eq <;> exact m.mul_one _
  mul_assoc := by intro (_, _) (_, _) (_, _); apply Prod.eq <;> exact m.mul_assoc _ _ _

instance square_action (χ α : Type u) [m : Monoid α] [a : RAction χ α] :
  RAction (χ × χ) (α × α) where
  smul := λ (x₁, x₂) (a₁, a₂) => (x₁ • a₁, x₂ • a₂)
  smul_one := by intro (_, _); apply Prod.eq <;> exact a.smul_one _
  smul_mul := by
    intro (_, _) (_, _) (_, _)
    apply Prod.eq <;> exact a.smul_mul _ _ _

@[simp]
theorem mul_one {α : Type u} [Monoid α] {x : α} : x * 1 = x := Monoid.mul_one _

@[simp]
theorem one_mul {α : Type u} [Monoid α] {x : α} : 1 * x = x := Monoid.one_mul _

@[simp]
theorem smul_one {α χ : Type u} [Monoid α] [RAction χ α] {x : χ} : x • (1 : α) = x := RAction.smul_one _

end Algebra

section Fintype

private instance oid (α : Type u) : Setoid (List α) where
  r l₁ l₂ := ∀ a, a ∈ l₁ ↔ a ∈ l₂
  iseqv := {
    refl := by intros; simp_all
    symm := by intros; simp_all
    trans := by intros; simp_all
  }

def Fintype (α : Type u) := Quotient (oid α)

namespace Fintype

variable {α : Type u}

def elem [DecidableEq α] : Fintype α → α → Bool := Quotient.lift (λ l x => List.elem x l) <| by
  intro l₁ l₂ h
  funext a
  simp [HasEquiv.Equiv, Setoid.r] at h
  simp [← List.elem_iff_mem] at h
  simp only [eq_of_eq_true_iff_eq_true (h a)]

def mem : Fintype α → α → Prop := Quotient.lift (λ l x => x ∈ l) <| by
  intro _ _ h
  funext a
  exact propext <| h a

instance : Membership α (Fintype α) where
  mem a x := Fintype.mem x a

theorem elem_iff_mem [DecidableEq α] {x : α} {A : Fintype α} :
  elem A x = true ↔ x ∈ A := by
  induction A using Quotient.inductionOn with
  | h l => exact List.elem_iff_mem

end Fintype

abbrev DecidableMem α := ∀ (a : α) (x : Fintype α), Decidable (a ∈ x)

variable {α : Type u} [DecidableEq α]

namespace Fintype

def mk (l : List α) : Fintype α := Quotient.mk' l

theorem mem_mk_iff {l : List α} {x : α} : x ∈ Fintype.mk l ↔ x ∈ l := by
  suffices h : (Fintype.mem <| Fintype.mk l) = (λ x => x ∈ l) by
    apply (λ {p q : Prop} (h : p = q) => show p ↔ q by simp_all)
    let h' := congrFun h x
    simp [flip] at h'
    rw [← h']
    rfl
  rfl

def empty : Fintype α := mk []

instance : EmptyCollection (Fintype α) where
  emptyCollection := empty

instance : DecidableMem α := λ x A =>
  if p : elem A x
  then isTrue <| by rw [← elem_iff_mem]; exact p
  else isFalse <| by rw [← elem_iff_mem]; exact p

variable [DecidableMem α]

theorem not_empty_iff (a : α) : ¬ a ∈ (∅ : Fintype α) := by
  suffices p : ¬ a ∈ (mk [] : Fintype α) by assumption
  rw [mem_mk_iff]
  intro h; cases h

theorem ext {x y : Fintype α} : x = y ↔ ∀ a : α, a ∈ x ↔ a ∈ y := by
  apply @Quotient.inductionOn₂ _ _ _ _
    (λ x y : Fintype α => x = y ↔ ∀ a : α, a ∈ x ↔ a ∈ y) _ _
  intro l₁ l₂
  apply Iff.intro
  focus
    intro h _
    rw [h]
    exact Iff.intro id id
  focus
    exact λ h => Quotient.sound h

def union : Fintype α → Fintype α → Fintype α := Quotient.lift₂
  (λ l₁ l₂ => Fintype.mk (List.append l₁ l₂)) <| by
  intro _ _ _ _ h₁ h₂
  apply Quotient.sound
  intro a
  have p := h₁ a
  simp [List.mem_append, h₁ a, h₂ a]

instance : HasUnion (Fintype α) where
  union := Fintype.union

theorem union_spec (l₁ l₂ : List α) : Fintype.mk l₁ ∪ Fintype.mk l₂ = mk (List.append l₁ l₂) := rfl

theorem mem_union_iff (x y : Fintype α) (a : α) : a ∈ x ∪ y ↔ a ∈ x ∨ a ∈ y := by
  suffices h : ∀ l₁ l₂, a ∈ (mk l₁) ∪ (mk l₂) ↔ a ∈ (mk l₁) ∨ a ∈ (mk l₂)
  from @Quotient.inductionOn₂ _ _ _ _ (λ x y : Fintype α => a ∈ x ∪ y ↔ a ∈ x ∨ a ∈ y) x y h
  intro l₁ l₂
  -- I'm not really convinced by the look of this proof :/
  rw [show (a ∈ (Fintype.mk l₁) ∪ (Fintype.mk l₂)) = (a ∈ (List.append l₁ l₂)) from rfl]
  simp [List.mem_append, Fintype.mem_mk_iff]

theorem union_assoc (x y z : Fintype α) : x ∪ y ∪ z = x ∪ (y ∪ z) := by
  suffices h : ∀ l₁ l₂ l₃ : List α, (mk l₁) ∪ (mk l₂) ∪ (mk l₃)
    = (mk l₁) ∪ ((mk l₂) ∪ (mk l₃))
    --why can't I `apply Quotient.inductionOn₃ x y z` ?
  from @Quotient.inductionOn₃ _ _ _ _ _ _
      (λ x y z : Fintype α => x ∪ y ∪ z = x ∪ (y ∪ z)) x y z h
  intro l₁ l₂ l₃
  apply Quotient.sound
  intro _
  simp [List.mem_append]
  exact or_assoc

def without [DecidableMem α] : Fintype α → Fintype α → Fintype α :=
  Quotient.lift (λ l x => mk <| List.filter (λ a => ¬ a ∈ x) l) <| by
  intro l₁ l₂ h
  funext a
  rw [Fintype.ext]
  intro x
  suffices p : ∀ l₁ l₂ (x : α), (x ∈ l₁ → x ∈ l₂) →
    x ∈ (List.filter (λ b => ¬ b ∈ a) l₁)
    → x ∈ (List.filter (λ b => ¬ b ∈ a) l₂) by
    apply Iff.intro
    focus
      apply p
      rw [h]
      exact id
    focus
      apply p
      rw [h]
      exact id
  simp only [List.mem_filter]
  intro l₁ l₂ x h ⟨ hl, hr ⟩
  exact ⟨ (h hl), hr ⟩

instance : HasWithout (Fintype α) where
  without := without

def included (x y : Fintype α) := ∀ a : α, a ∈ x → a ∈ y

instance : HasIncluded (Fintype α) where
  included := included

theorem included_refl {a : Fintype α} : a ⊆ a := λ _ => id

theorem included_trans {a b c : Fintype α} (h : a ⊆ b) (h' : b ⊆ c) : a ⊆ c := λ _ => h' _ ∘ h _

theorem not_mem_empty (a : α) : ¬ a ∈ (∅ : Fintype α) := by
  suffices p : ¬ a ∈ (mk [] : Fintype α) from p
  rw [mem_mk_iff]
  intro h; cases h

theorem empty_included (a : Fintype α) : ∅ ⊆ a := λ _ => False.elim ∘ not_mem_empty _

theorem union_on_included {a b c d : Fintype α}
  (h₁ : a ⊆ b) (h₂ : c ⊆ d) : a ∪ c ⊆ b ∪ d := by
  intro x
  simp only [mem_union_iff]
  exact λ h => match h with
  | Or.inl h => Or.inl <| h₁ _ h
  | Or.inr h => Or.inr <| h₂ _ h

theorem union_included_iff {a b c : Fintype α} : a ∪ b ⊆ c ↔ a ⊆ c ∧ b ⊆ c := by
  apply Iff.intro
  focus
    intro h
    apply And.intro
      <;> apply included_trans _ h
      <;> intro x h
      <;> rw [mem_union_iff]
    apply Or.inl; assumption
    apply Or.inr; assumption
  focus
    intro h x
    rw [mem_union_iff]
    exact λ h' => match h' with
    | Or.inl h' => h.1 _ h'
    | Or.inr h' => h.2 _ h'

theorem included_union_l {a c : Fintype α} (b : Fintype α) (h : a ⊆ c) : a ⊆ b ∪ c := by
  intro x h'
  rw [mem_union_iff]
  exact Or.inr <| h _ h'

theorem included_union_r {a b : Fintype α} (c : Fintype α) (h : a ⊆ b) : a ⊆ b ∪ c := by
  intro x h'
  rw [mem_union_iff]
  exact Or.inl <| h _ h'

theorem not_mem_of_superset_not_mem {x y : Fintype α} {a : α} (h : x ⊆ y) :
  ¬ a ∈ y → ¬ a ∈ x := contrapose (h _)

theorem mem_iff_singleton_included {x : Fintype α} {a : α} : a ∈ x ↔ (Fintype.mk [a]) ⊆ x := by
  apply Iff.intro
  focus
    intro h y h'
    suffices p : y = a by rw [p]; exact h
    rw [mem_mk_iff] at h'
    cases h' <;> trivial
  focus
    intro h
    specialize h a
    apply h
    apply List.Mem.head

theorem mem_without_iff {x y : Fintype α} {a : α} : a ∈ x \ y ↔ a ∈ x ∧ ¬ a ∈ y := by
  apply @Quotient.inductionOn _ _
    (λ x : Fintype α => a ∈ x \ y ↔ a ∈ x ∧ ¬ a ∈ y) x
  intro l
  suffices p : a ∈ mk l \ y ↔
    a ∈ (List.filter (λ b => ¬ b ∈ y) l) by
    simp only [mk, Quotient.mk'] at p
    rw [p]
    rw [List.mem_filter, show Quotient.mk _ l = mk l from rfl, mem_mk_iff]
    rw [show decide ¬ a ∈ y = true ↔ ¬ a ∈ y from Iff.intro of_decide_eq_true decide_eq_true]
    exact Iff.intro id id
  exact Iff.intro id id

theorem not_mem_iff_in_without {x : Fintype α} {a : α} :
  ¬ a ∈ x ↔ x ⊆ x \ Fintype.mk [a] := by
  apply @Quotient.inductionOn _ _
    (λ x : Fintype α => ¬ a ∈ x ↔ x ⊆ x \ Fintype.mk [a]) x
  intro l
  simp only [mem_mk_iff, HasIncluded.included, included]
  apply Iff.intro
  focus
    intro h b h'
    suffices p : b ∈ (List.filter (λ c => ¬ c ∈ mk [a]) l) from p
    rw [List.mem_filter]
    apply And.intro h'
    apply decide_eq_true
    intro h''
    apply h
    suffices p : a = b by rw [p]; exact h'
    cases h'' <;> trivial
  focus
    intro h h'
    specialize h a h'
    suffices p : a ∈ (List.filter (λ c => ¬ c ∈ mk [a]) l) by
      rw [List.mem_filter] at p
      apply of_decide_eq_true p.2
      apply List.Mem.head
    exact h

theorem included_without_of_included {a b: Fintype α} (c : Fintype α) (h : a ⊆ b) :
  a \ c ⊆ b \ c := by
  intro x
  simp only [mem_without_iff]
  exact λ ⟨ hl, hr ⟩ => And.intro (h _ hl) hr

theorem union_comm (a b : Fintype α) : a ∪ b = b ∪ a := by
  rw [ext]
  intro x
  simp only [mem_union_iff]
  apply Iff.intro
    <;> intro h
    <;> cases h
    <;> first
      | apply Or.inl; assumption
      | apply Or.inr; assumption

theorem union_idempotent (a : Fintype α) : a ∪ a = a := by
  rw [ext]
  intro x
  rw [mem_union_iff]
  apply Iff.intro
  intro h; cases h <;> assumption
  exact λ h => Or.inl h

theorem different_if_not_same_element {x y : Fintype β} {a : β} (h₁ : ¬ a ∈ x) (h₂ : a ∈ y) : x ≠ y := by
  intro h
  rw [ext] at h
  exact h₁ <| (h a).2 h₂

private theorem mem_image_fold {β : Type u} (f : α → Fintype β) (l₁ : List α) (a : α)
  (h : a ∈ l₁) : f a ⊆ (List.foldr (λ a x => f a ∪ x) ∅ l₁) := by
  induction l₁ with
  | nil => cases h
  | cons x t rh =>
    simp only [List.foldr]
    by_cases p : a = x
    focus
      rw [p]
      exact included_union_r _ included_refl
    focus
      apply included_union_l
      apply rh
      cases h <;> trivial

def image {β : Type u} (f : α → Fintype β) : Fintype α → Fintype β :=
  Quotient.lift (λ l => List.foldr (λ a x => f a ∪ x) ∅ l) <| by
  suffices p : ∀ l₁ l₂, (∀ a, a ∈ l₁ → a ∈ l₂) →
    List.foldr (λ a x => f a ∪ x) ∅ l₁ ⊆ List.foldr (λ a x => f a ∪ x) ∅ l₂ by
    intro l₁ l₂ h
    rw [ext]
    intro a
    apply Iff.intro (p l₁ l₂ _ _) (p l₂ l₁ _ _) <;> first
      | intro b
        rw [h]
        exact id
  intro l₁ l₂ h
  induction l₁ with
  | nil => exact empty_included _
  | cons x t rh =>
    apply union_included_iff.2 (And.intro _ _)
    focus
      apply mem_image_fold
      apply h
      apply List.Mem.head
    focus
      apply rh
      intro a h'
      apply h
      exact List.Mem.tail _ h'

theorem in_image_of_is_image {β : Type u} {f : α → Fintype β} {a : α}
  {x : Fintype α} : a ∈ x → f a ⊆ image f x := by
  apply @Quotient.inductionOn _ _ (λ x : Fintype α => a ∈ x → f a ⊆ image f x) x
  intro l
  apply mem_image_fold

theorem image_in_of_all_in {β : Type u} {f : α → Fintype β} {x : Fintype α}
  {A : Fintype β} : (∀ a, a ∈ x → f a ⊆ A) → image f x ⊆ A := by
  apply @Quotient.inductionOn _ _
    (λ x : Fintype α => (∀ a, a ∈ x → f a ⊆ A) → image f x ⊆ A) x
  intro l h
  induction l with
  | nil => exact empty_included _
  | cons x t rh =>
    apply union_included_iff.2 (And.intro _ _)
    focus
      apply h
      suffices p : x ∈ mk (x :: t) from p
      apply List.Mem.head
    focus
      exact rh <| λ a h' => h _ <| List.Mem.tail _ h'

open Classical in
theorem mem_image_iff {β : Type u} {f : α → Fintype β} {x : Fintype α} {b : β} :
  b ∈ image f x ↔ ∃ a, a ∈ x ∧ b ∈ f a := by
  apply Iff.intro
  focus
    intro h
    apply byContradiction
    intro h'
    have h'' : ∀ a, a ∈ x → f a ⊆ image f x \ mk [b] := by
      intro a h
      apply included_trans _
        (included_without_of_included (mk [b]) (in_image_of_is_image h))
      rw [← not_mem_iff_in_without]
      intro h''
      exact h' ⟨ a, h, h'' ⟩
    suffices p : ¬ b ∈ image f x from p h
    rw [not_mem_iff_in_without]
    exact image_in_of_all_in h''
  focus
    intro ⟨ a, h, h' ⟩
    rw [mem_iff_singleton_included]
    apply included_trans _ (in_image_of_is_image h)
    rw [← mem_iff_singleton_included]
    exact h'

section Size

set_option codegen false in
def size (x : Fintype α) := set_min
  (λ n => ∃ l, n = List.length l ∧ x ⊆ mk l) <| by
  apply @Quotient.inductionOn _ _
    (λ x : Fintype α => ∃ n, ∃ l, n = List.length l ∧ x ⊆ mk l)
  exact λ l => ⟨ List.length l, l, rfl, λ _ => id ⟩

theorem size_spec (x : Fintype α) : ∃ l, size x = List.length l ∧ x ⊆ mk l :=
  set_min_spec₁ (λ n => ∃ l, n = List.length l ∧ ∀ a : α, a ∈ x → a ∈ l) _

theorem size_mk_le (l : List α) : size (mk l) ≤ List.length l :=
  set_min_spec₂ _ _ _ ⟨ l, rfl, λ _ => id ⟩

theorem size_le_of_included {x y : Fintype α} (h : x ⊆ y) : size x ≤ size y := by
  apply set_min_le_of_included ⟨ size y, size_spec y ⟩ ⟨ size x, size_spec x ⟩
  intro n ⟨ l, l_length, hl ⟩
  let ⟨ l', l'_length, hl' ⟩ := size_spec x
  apply Exists.intro l
  apply And.intro l_length
  intro a h'
  exact hl a <| h a h'

theorem length_le_size {x : Fintype α} {l : List α} (h : x ⊆ mk l) :
  size x ≤ List.length l :=
  Nat.le_trans (size_le_of_included h) (size_mk_le _)

theorem le_size_of_all_le_length {x : Fintype α} {n : Nat}
  (h : ∀ l : List α, x ⊆ mk l → n ≤ List.length l) : n ≤ size x := by
  have ⟨ l', l'_length, h' ⟩ := size_spec x
  rw [l'_length]
  exact h _ h'

theorem length_le_of_included {x : Fintype α} {l : List α} (h : x ⊆ mk l) :
  size x ≤ List.length l :=
  Nat.le_trans (size_le_of_included h) (size_mk_le l)

theorem size_union_not_contained_le {x : Fintype α} {l : List α} {a : α}
  (h₁ : mk [a] ∪ x ⊆ mk l) (h₂ : ¬ a ∈ x) : size x + 1 ≤ List.length l := by
  have p : a ∈ l := by
    rw [union_included_iff] at h₁
    apply h₁.1
    rw [mem_mk_iff]
    apply List.Mem.head
  apply Nat.le_trans _ (List.filter_mem_length_le p)
  apply Nat.add_le_add_right
  apply length_le_of_included
  intro b h'
  rw [mem_mk_iff, List.mem_filter]
  apply And.intro
  focus
    exact h₁ _ ∘ (mem_union_iff _ _ _).2 ∘ Or.inr <| h'
  focus
    apply decide_eq_true
    intro h
    apply h₂
    rw [← h]
    exact h'

theorem size_succ_of_union_not_included {x : Fintype α} {a : α} (h : ¬ a ∈ x) :
  size (mk [a] ∪ x) = size x + 1 := by
  apply Nat.eq_of_le_of_le
  focus
    have ⟨ l, l_length, hl ⟩ := size_spec x
    rw [l_length]
    have p : mk [a] ∪ x ⊆ mk [a] ∪ mk l := by
      apply union_included_iff.2 (And.intro _ _)
      exact included_union_r _ included_refl
      exact included_union_l _ hl
    apply Nat.le_trans (size_le_of_included p)
    rw [union_spec]
    apply Nat.le_trans (size_mk_le _)
    exact Nat.le_refl _
  focus
    exact le_size_of_all_le_length <| λ l h' => Nat.le_trans
      (size_union_not_contained_le h' h)
      (Nat.le_refl _)

theorem eq_of_contained_of_same_size {x y : Fintype α} (h : x ⊆ y)
  (h' : size x = size y) : x = y := by
  rw [ext]
  intro a
  apply Iff.intro (h a)
  intro a_in_y
  apply Decidable.byContradiction
  intro p
  suffices p : size x < size y from Nat.ne_of_lt p h'
  have p' : mk [a] ∪ x ⊆ y := by
    intro b h'
    match (mem_union_iff _ _ _).1 h' with
    | Or.inl h' =>
      suffices p : b = a by rw [p]; exact a_in_y
      rw [mem_mk_iff] at h'
      cases h' <;> trivial
    | Or.inr h' => exact h _ h'
  apply Nat.lt_of_lt_of_le _ (size_le_of_included p')
  rw [size_succ_of_union_not_included p]
  exact Nat.lt_succ_self _

end Size

def included_wfRel : WellFoundedRelation (Fintype α) where
  rel x y := x ⊆ y ∧ x ≠ y
  wf := by
    apply @Subrelation.wf _ (measure size).rel _ _
    focus
      exact (measure size).wf
    focus
      intro x y ⟨ h, h' ⟩
      suffices p : size x < size y from p
      apply Nat.lt_of_le_of_ne (size_le_of_included h)
      intro h''
      exact h' <| eq_of_contained_of_same_size h h''

end Fintype

end Fintype

section Finite /- A small theory of finite types -/

def finite (α : Type u) := ∃ l : List α, ∀ a : α, a ∈ l

section Subtypes /- First off, two theorems about finite types
                    with respect to subtypes. -/

theorem subtype_finite {α : Type u} (h : finite α)
  (P : α → Prop) [DecidablePred P] : finite {a // P a} :=
by
  let ⟨ l, p₁ ⟩ := h
  apply Exists.intro (List.filterMap (λ a =>
    if h : P a then Option.some ⟨ a, h ⟩ else Option.none) l)
  intro ⟨ a, p₂ ⟩
  specialize p₁ a
  induction l with
  | nil => cases p₁
  | cons x t rh =>
    cases p₁ with
    | head =>
      simp only [List.filterMap, p₂]
      apply List.Mem.head
    | tail _ p₁ =>
      by_cases h : P x
        <;> simp [h, List.filterMap, p₂, rh p₁]
      apply List.Mem.tail
      exact rh p₁

theorem finite_of_full_subtype_finite {α : Type u} {P : α → Prop}
  (full : ∀ a, P a) (h : finite {a // P a}) : finite α := by
  let ⟨ l, p₁ ⟩ := h
  apply Exists.intro (List.map (λ ⟨ a, _ ⟩ => a) l)
  intro a
  let a' : {a // P a} := ⟨ a, full a ⟩
  specialize p₁ a'
  induction l with
  | nil => cases p₁
  | cons x t rh =>
    match x with
    | ⟨ x, _ ⟩ =>
      by_cases p : a = x
      focus
        exact p ▸ List.Mem.head _ _
      focus
        simp [p] at p₁
        apply List.Mem.tail
        apply rh
        cases p₁ <;> trivial

end Subtypes

section Functions /- Now, finite types with respect to functions -/

open Classical

theorem image_finite {α β : Type u} (h : finite α) (f : α → β) : finite {b // ∃ a, b = f a} := by
  let ⟨ l, p₁ ⟩ := h
  apply Exists.intro (List.map (λ a => ⟨ f a, ⟨ a, rfl ⟩ ⟩) l)
  intro ⟨ b, ⟨ a, p₂ ⟩ ⟩
  specialize p₁ a
  induction l with
  | nil => cases p₁
  | cons x t h =>
    simp [List.map]
    rw [List.mem_head_or_mem_tail]
    rw [List.mem_head_or_mem_tail] at p₁
    exact match p₁ with
    | Or.inl p₁ => Or.inl ∘ Subtype.eq <| p₁ ▸ p₂
    | Or.inr p₁ => Or.inr <| h p₁

/- The three following declarations are private as they are completely ad-hoc.
   They are only meant to be used in the next theorem.
   It is possible to turn them into a general notion,
   but this is not my intention at the moment. -/
private noncomputable def sec {α β : Type u} (f : α → β) (b : {b // ∃ a, b = f a}) : α :=
  @epsilon _ (nonempty_of_exists b.2) (λ a => b = f a)

private def sec_image {α β : Type u} (f : α → β) : ∀ (b : {b // ∃ a, b = f a}), f (sec f b) = b := by
  intro ⟨ b, p@⟨ a, h ⟩ ⟩
  simp [sec]
  rw [← epsilon_spec p]

private def sec_codomain_full {α β : Type u} (f : α → β) (inj : ∀ x y, f x = f y → x = y)
  (a : α) : ∃ b, a = sec f b := by
  apply Exists.intro (⟨ f a, ⟨ a, rfl ⟩ ⟩)
  apply inj
  rw [sec_image f _]

theorem invimage_finite_of_inj {α β : Type u} (h : finite β)
  {f : α → β} (inj : ∀ x y, f x = f y → x = y) : finite α :=
  finite_of_full_subtype_finite
    (sec_codomain_full f inj)
    (image_finite (subtype_finite h (λ b => ∃ a, b = f a)) (sec f))

end Functions

section Sums /- Sums of finite types -/

theorem sum_finite {α β : Type u} (h₁ : finite α) (h₂ : finite β) : finite (α ⊕ β) := by
  let ⟨ l₁, h₁ ⟩ := h₁
  let ⟨ l₂, h₂ ⟩ := h₂
  apply Exists.intro (List.map Sum.inl l₁ ++ List.map Sum.inr l₂)
  intro x
  rw [List.mem_append]
  exact match x with
  | Sum.inl a => Or.inl <| List.mem_map <| h₁ a
  | Sum.inr b => Or.inr <| List.mem_map <| h₂ b

end Sums

end Finite


import .add_rules
import .fron_ralg

namespace ualg

variables {L0 : lang} {R0 : rules L0}
variables {L : lang} {R : rules L}
variables (ι : R0 →$ R) (A : ualg L0 R0)

include ι A
def fron : ualg L R := addr (ralg.fron ι.lhom A.raw) R

namespace fron
def univ : A →% (fron ι A)⦃ι⦄ :=
  (ralg.fron.univ ι.lhom A.raw).comp ((ualg.addr.univ (ralg.fron ι.lhom A.raw) R){%ι.lhom})
variable {A}
def lift {B : ualg L R} (f : A →% B⦃ι⦄) : (fron ι A) →% B := ualg.addr.lift R (ralg.fron.lift ι.lhom f)

theorem univ_comp_lift {B : ualg L R} (f : A →% B⦃ι⦄) : (univ ι A).comp ((lift ι f){%ι.lhom}) = f :=
  by apply ralg.fron.univ_comp_lift

theorem lift_unique {B : ualg L R} (f : A →% B⦃ι⦄) (g : (fron ι A) →% B) :
  (univ ι A).comp (g{%ι.lhom}) = f → g = lift ι f :=
begin
  intro hyp,
  apply ualg.addr.lift_unique,
  apply ralg.fron.lift_unique,
  assumption,
end

end fron
end ualg


import category_theory.elements
import category_theory.limits.limits
import category_theory.functor_category
import category_theory.limits.types
import category_theory.limits.functor_category
import category_theory.adjunction.opposites

namespace category_theory

open category limits
universes v₁ v₂ u₁ u₂

variables {C : Type u₁} [small_category C]

namespace colimit_adj
variables {ℰ : Type u₂} [category.{u₁} ℰ]
variables [has_colimits ℰ]
variable (A : C ⥤ ℰ)

@[simps]
def R : ℰ ⥤ (Cᵒᵖ ⥤ Type u₁) :=
{ obj := λ E,
  { obj := λ c, A.obj c.unop ⟶ E,
    map := λ c c' f k, A.map f.unop ≫ k },
  map := λ E E' k, { app := λ c f, f ≫ k } }.

private noncomputable def L_obj (P : Cᵒᵖ ⥤ Type u₁) : ℰ :=
colimit ((category_of_elements.π P).left_op ⋙ A)

def Le' (P : Cᵒᵖ ⥤ Type u₁) (E : ℰ) {c : cocone ((category_of_elements.π P).left_op ⋙ A)}
  (t : is_colimit c) : (c.X ⟶ E) ≃ (P ⟶ (R A).obj E) :=
(t.hom_iso' E).to_equiv.trans
{ to_fun := λ k,
  { app := λ c p, k.1 (opposite.op ⟨_, p⟩),
    naturality' := λ c c' f,
    begin
      ext p,
      let p' : P.elementsᵒᵖ := opposite.op ⟨c, p⟩,
      let p'' : P.elementsᵒᵖ := opposite.op ⟨c', P.map f p⟩,
      let f' : p'' ⟶ p' := has_hom.hom.op ⟨f, rfl⟩,
      apply (k.2 f').symm,
    end },
  inv_fun := λ τ,
  { val := λ p, τ.app p.unop.1 p.unop.2,
    property := λ p p' f,
    begin
      simp_rw [← f.unop.2],
      apply (congr_fun (τ.naturality f.unop.1) p'.unop.2).symm,
    end },
  left_inv :=
  begin
    rintro ⟨k₁, k₂⟩,
    ext,
    dsimp,
    congr' 1,
    simp,
  end,
  right_inv :=
  begin
    rintro ⟨_, _⟩,
    ext,
    refl,
  end }

lemma Le'_natural (P : Cᵒᵖ ⥤ Type u₁) (E₁ E₂ : ℰ) (g : E₁ ⟶ E₂)
  {c : cocone _} (t : is_colimit c) (k : c.X ⟶ E₁) :
Le' A P E₂ t (k ≫ g) = Le' A P E₁ t k ≫ (R A).map g :=
begin
  ext _ X p,
  apply (assoc _ _ _).symm,
end

noncomputable def L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ :=
adjunction.left_adjoint_of_equiv
(λ P E, Le' A P E (colimit.is_colimit _))
(λ P E E' g, Le'_natural A P E E' g _)

noncomputable def L_adjunction : L A ⊣ R A := adjunction.adjunction_of_equiv_left _ _
end colimit_adj

open colimit_adj

def right_is_id : R (yoneda : C ⥤ _) ≅ 𝟭 _ :=
nat_iso.of_components
(λ P, nat_iso.of_components (λ X, yoneda_sections_small X.unop _)
  (λ X Y f, funext $ λ x,
  begin
    apply eq.trans _ (congr_fun (x.naturality f) (𝟙 _)),
    dsimp [ulift_trivial, yoneda_lemma],
    simp only [id_comp, comp_id],
  end))
(λ _ _ _, nat_trans.ext _ _ $ funext $ λ _, funext $ λ _, rfl)

noncomputable def left_is_id : L (yoneda : C ⥤ _) ≅ 𝟭 _ :=
adjunction.left_adjoint_uniq (L_adjunction _) (adjunction.of_nat_iso_right adjunction.id right_is_id.symm)

noncomputable def main (P : Cᵒᵖ ⥤ Type u₁) :
  colimit ((category_of_elements.π P).left_op ⋙ yoneda) ≅ P :=
left_is_id.app P

-- This is a cocone with point `P`, for which the diagram consists solely of representables.
noncomputable def the_cocone (P : Cᵒᵖ ⥤ Type u₁) :
  cocone ((category_of_elements.π P).left_op ⋙ yoneda) :=
cocone.extend (colimit.cocone _) (main P).hom

lemma desc_self {J : Type v₁} {C : Type u₁} [small_category J] [category.{v₁} C]
  (F : J ⥤ C) {c : cocone F} (t : is_colimit c) : t.desc c = 𝟙 c.X :=
(t.uniq _ _ (λ j, comp_id _)).symm

lemma col_desc_self {J : Type v₁} {C : Type u₁} [small_category J] [category.{v₁} C] (F : J ⥤ C)
  [has_colimit F] : colimit.desc F (colimit.cocone F) = 𝟙 (colimit F) :=
desc_self F (colimit.is_colimit _)

noncomputable def is_a_limit (P : Cᵒᵖ ⥤ Type u₁) : is_colimit (the_cocone P) :=
begin
  apply is_colimit.of_point_iso (colimit.is_colimit ((category_of_elements.π P).left_op ⋙ yoneda)),
  change is_iso (colimit.desc _ (cocone.extend _ _)),
  rw [colimit.desc_extend, col_desc_self, id_comp],
  apply_instance,
end

end category_theory


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

! This file was ported from Lean 3 source module deprecated.ring
! leanprover-community/mathlib commit 10708587e81b68c763fcdb7505f279d52e569768
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Deprecated.Group

/-!
# Unbundled semiring and ring homomorphisms (deprecated)

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

This file is deprecated, and is no longer imported by anything in mathlib other than other
deprecated files, and test files. You should not need to import it.

This file defines predicates for unbundled semiring and ring homomorphisms. Instead of using
this file, please use `ring_hom`, defined in `algebra.hom.ring`, with notation `→+*`, for
morphisms between semirings or rings. For example use `φ : A →+* B` to represent a
ring homomorphism.

## Main Definitions

`is_semiring_hom` (deprecated), `is_ring_hom` (deprecated)

## Tags

is_semiring_hom, is_ring_hom

-/

universe u v w

variable {α : Type u}

#print IsSemiringHom /-
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`map_zero] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`map_one] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`map_add] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`map_mul] [] -/
/-- Predicate for semiring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
structure IsSemiringHom {α : Type u} {β : Type v} [Semiring α] [Semiring β] (f : α → β) : Prop where
  map_zero : f 0 = 0
  map_one : f 1 = 1
  map_add : ∀ {x y}, f (x + y) = f x + f y
  map_mul : ∀ {x y}, f (x * y) = f x * f y
#align is_semiring_hom IsSemiringHom
-/

namespace IsSemiringHom

variable {β : Type v} [Semiring α] [Semiring β]

variable {f : α → β} (hf : IsSemiringHom f) {x y : α}

#print IsSemiringHom.id /-
/-- The identity map is a semiring homomorphism. -/
theorem id : IsSemiringHom (@id α) := by refine' { .. } <;> intros <;> rfl
#align is_semiring_hom.id IsSemiringHom.id
-/

/- warning: is_semiring_hom.comp -> IsSemiringHom.comp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Semiring.{u1} α] [_inst_2 : Semiring.{u2} β] {f : α -> β}, (IsSemiringHom.{u1, u2} α β _inst_1 _inst_2 f) -> (forall {γ : Type.{u3}} [_inst_3 : Semiring.{u3} γ] {g : β -> γ}, (IsSemiringHom.{u2, u3} β γ _inst_2 _inst_3 g) -> (IsSemiringHom.{u1, u3} α γ _inst_1 _inst_3 (Function.comp.{succ u1, succ u2, succ u3} α β γ g f)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u3}} [_inst_1 : Semiring.{u2} α] [_inst_2 : Semiring.{u3} β] {f : α -> β}, (IsSemiringHom.{u2, u3} α β _inst_1 _inst_2 f) -> (forall {γ : Type.{u1}} [_inst_3 : Semiring.{u1} γ] {g : β -> γ}, (IsSemiringHom.{u3, u1} β γ _inst_2 _inst_3 g) -> (IsSemiringHom.{u2, u1} α γ _inst_1 _inst_3 (Function.comp.{succ u2, succ u3, succ u1} α β γ g f)))
Case conversion may be inaccurate. Consider using '#align is_semiring_hom.comp IsSemiringHom.compₓ'. -/
/-- The composition of two semiring homomorphisms is a semiring homomorphism. -/
theorem comp (hf : IsSemiringHom f) {γ} [Semiring γ] {g : β → γ} (hg : IsSemiringHom g) :
    IsSemiringHom (g ∘ f) :=
  { map_zero := by simpa [map_zero hf] using map_zero hg
    map_one := by simpa [map_one hf] using map_one hg
    map_add := fun x y => by simp [map_add hf, map_add hg]
    map_mul := fun x y => by simp [map_mul hf, map_mul hg] }
#align is_semiring_hom.comp IsSemiringHom.comp

#print IsSemiringHom.to_isAddMonoidHom /-
/-- A semiring homomorphism is an additive monoid homomorphism. -/
theorem to_isAddMonoidHom (hf : IsSemiringHom f) : IsAddMonoidHom f :=
  { ‹IsSemiringHom f› with }
#align is_semiring_hom.to_is_add_monoid_hom IsSemiringHom.to_isAddMonoidHom
-/

#print IsSemiringHom.to_isMonoidHom /-
/-- A semiring homomorphism is a monoid homomorphism. -/
theorem to_isMonoidHom (hf : IsSemiringHom f) : IsMonoidHom f :=
  { ‹IsSemiringHom f› with }
#align is_semiring_hom.to_is_monoid_hom IsSemiringHom.to_isMonoidHom
-/

end IsSemiringHom

#print IsRingHom /-
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`map_one] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`map_mul] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`map_add] [] -/
/-- Predicate for ring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
structure IsRingHom {α : Type u} {β : Type v} [Ring α] [Ring β] (f : α → β) : Prop where
  map_one : f 1 = 1
  map_mul : ∀ {x y}, f (x * y) = f x * f y
  map_add : ∀ {x y}, f (x + y) = f x + f y
#align is_ring_hom IsRingHom
-/

namespace IsRingHom

variable {β : Type v} [Ring α] [Ring β]

#print IsRingHom.of_semiring /-
/-- A map of rings that is a semiring homomorphism is also a ring homomorphism. -/
theorem of_semiring {f : α → β} (H : IsSemiringHom f) : IsRingHom f :=
  { H with }
#align is_ring_hom.of_semiring IsRingHom.of_semiring
-/

variable {f : α → β} (hf : IsRingHom f) {x y : α}

/- warning: is_ring_hom.map_zero -> IsRingHom.map_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (Eq.{succ u2} β (f (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))))))))) (OfNat.ofNat.{u2} β 0 (OfNat.mk.{u2} β 0 (Zero.zero.{u2} β (MulZeroClass.toHasZero.{u2} β (NonUnitalNonAssocSemiring.toMulZeroClass.{u2} β (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u2} β (NonAssocRing.toNonUnitalNonAssocRing.{u2} β (Ring.toNonAssocRing.{u2} β _inst_2)))))))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (Eq.{succ u2} β (f (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))))) (OfNat.ofNat.{u2} β 0 (Zero.toOfNat0.{u2} β (MonoidWithZero.toZero.{u2} β (Semiring.toMonoidWithZero.{u2} β (Ring.toSemiring.{u2} β _inst_2))))))
Case conversion may be inaccurate. Consider using '#align is_ring_hom.map_zero IsRingHom.map_zeroₓ'. -/
/-- Ring homomorphisms map zero to zero. -/
theorem map_zero (hf : IsRingHom f) : f 0 = 0 :=
  calc
    f 0 = f (0 + 0) - f 0 := by rw [hf.map_add] <;> simp
    _ = 0 := by simp

#align is_ring_hom.map_zero IsRingHom.map_zero

/- warning: is_ring_hom.map_neg -> IsRingHom.map_neg is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β} {x : α}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (Eq.{succ u2} β (f (Neg.neg.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α _inst_1))))) x)) (Neg.neg.{u2} β (SubNegMonoid.toHasNeg.{u2} β (AddGroup.toSubNegMonoid.{u2} β (AddGroupWithOne.toAddGroup.{u2} β (AddCommGroupWithOne.toAddGroupWithOne.{u2} β (Ring.toAddCommGroupWithOne.{u2} β _inst_2))))) (f x)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β} {x : α}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (Eq.{succ u2} β (f (Neg.neg.{u1} α (Ring.toNeg.{u1} α _inst_1) x)) (Neg.neg.{u2} β (Ring.toNeg.{u2} β _inst_2) (f x)))
Case conversion may be inaccurate. Consider using '#align is_ring_hom.map_neg IsRingHom.map_negₓ'. -/
/-- Ring homomorphisms preserve additive inverses. -/
theorem map_neg (hf : IsRingHom f) : f (-x) = -f x :=
  calc
    f (-x) = f (-x + x) - f x := by rw [hf.map_add] <;> simp
    _ = -f x := by simp [hf.map_zero]

#align is_ring_hom.map_neg IsRingHom.map_neg

/- warning: is_ring_hom.map_sub -> IsRingHom.map_sub is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β} {x : α} {y : α}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (Eq.{succ u2} β (f (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α (SubNegMonoid.toHasSub.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α _inst_1)))))) x y)) (HSub.hSub.{u2, u2, u2} β β β (instHSub.{u2} β (SubNegMonoid.toHasSub.{u2} β (AddGroup.toSubNegMonoid.{u2} β (AddGroupWithOne.toAddGroup.{u2} β (AddCommGroupWithOne.toAddGroupWithOne.{u2} β (Ring.toAddCommGroupWithOne.{u2} β _inst_2)))))) (f x) (f y)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β} {x : α} {y : α}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (Eq.{succ u2} β (f (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α (Ring.toSub.{u1} α _inst_1)) x y)) (HSub.hSub.{u2, u2, u2} β β β (instHSub.{u2} β (Ring.toSub.{u2} β _inst_2)) (f x) (f y)))
Case conversion may be inaccurate. Consider using '#align is_ring_hom.map_sub IsRingHom.map_subₓ'. -/
/-- Ring homomorphisms preserve subtraction. -/
theorem map_sub (hf : IsRingHom f) : f (x - y) = f x - f y := by
  simp [sub_eq_add_neg, hf.map_add, hf.map_neg]
#align is_ring_hom.map_sub IsRingHom.map_sub

#print IsRingHom.id /-
/-- The identity map is a ring homomorphism. -/
theorem id : IsRingHom (@id α) := by refine' { .. } <;> intros <;> rfl
#align is_ring_hom.id IsRingHom.id
-/

/- warning: is_ring_hom.comp -> IsRingHom.comp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (forall {γ : Type.{u3}} [_inst_3 : Ring.{u3} γ] {g : β -> γ}, (IsRingHom.{u2, u3} β γ _inst_2 _inst_3 g) -> (IsRingHom.{u1, u3} α γ _inst_1 _inst_3 (Function.comp.{succ u1, succ u2, succ u3} α β γ g f)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u3}} [_inst_1 : Ring.{u2} α] [_inst_2 : Ring.{u3} β] {f : α -> β}, (IsRingHom.{u2, u3} α β _inst_1 _inst_2 f) -> (forall {γ : Type.{u1}} [_inst_3 : Ring.{u1} γ] {g : β -> γ}, (IsRingHom.{u3, u1} β γ _inst_2 _inst_3 g) -> (IsRingHom.{u2, u1} α γ _inst_1 _inst_3 (Function.comp.{succ u2, succ u3, succ u1} α β γ g f)))
Case conversion may be inaccurate. Consider using '#align is_ring_hom.comp IsRingHom.compₓ'. -/
-- see Note [no instance on morphisms]
/-- The composition of two ring homomorphisms is a ring homomorphism. -/
theorem comp (hf : IsRingHom f) {γ} [Ring γ] {g : β → γ} (hg : IsRingHom g) : IsRingHom (g ∘ f) :=
  { map_add := fun x y => by simp [map_add hf] <;> rw [map_add hg] <;> rfl
    map_mul := fun x y => by simp [map_mul hf] <;> rw [map_mul hg] <;> rfl
    map_one := by simp [map_one hf] <;> exact map_one hg }
#align is_ring_hom.comp IsRingHom.comp

#print IsRingHom.to_isSemiringHom /-
/-- A ring homomorphism is also a semiring homomorphism. -/
theorem to_isSemiringHom (hf : IsRingHom f) : IsSemiringHom f :=
  { ‹IsRingHom f› with map_zero := map_zero hf }
#align is_ring_hom.to_is_semiring_hom IsRingHom.to_isSemiringHom
-/

/- warning: is_ring_hom.to_is_add_group_hom -> IsRingHom.to_isAddGroupHom is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (IsAddGroupHom.{u1, u2} α β (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α _inst_1))) (AddGroupWithOne.toAddGroup.{u2} β (AddCommGroupWithOne.toAddGroupWithOne.{u2} β (Ring.toAddCommGroupWithOne.{u2} β _inst_2))) f)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} β] {f : α -> β}, (IsRingHom.{u1, u2} α β _inst_1 _inst_2 f) -> (IsAddGroupHom.{u1, u2} α β (AddGroupWithOne.toAddGroup.{u1} α (Ring.toAddGroupWithOne.{u1} α _inst_1)) (AddGroupWithOne.toAddGroup.{u2} β (Ring.toAddGroupWithOne.{u2} β _inst_2)) f)
Case conversion may be inaccurate. Consider using '#align is_ring_hom.to_is_add_group_hom IsRingHom.to_isAddGroupHomₓ'. -/
theorem to_isAddGroupHom (hf : IsRingHom f) : IsAddGroupHom f :=
  { map_add := fun _ _ => hf.map_add }
#align is_ring_hom.to_is_add_group_hom IsRingHom.to_isAddGroupHom

end IsRingHom

variable {β : Type v} {γ : Type w} [rα : Semiring α] [rβ : Semiring β]

namespace RingHom

section

include rα rβ

#print RingHom.of /-
/-- Interpret `f : α → β` with `is_semiring_hom f` as a ring homomorphism. -/
def of {f : α → β} (hf : IsSemiringHom f) : α →+* β :=
  { MonoidHom.of hf.to_isMonoidHom, AddMonoidHom.of hf.to_isAddMonoidHom with toFun := f }
#align ring_hom.of RingHom.of
-/

/- warning: ring_hom.coe_of -> RingHom.coe_of is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [rα : Semiring.{u1} α] [rβ : Semiring.{u2} β] {f : α -> β} (hf : IsSemiringHom.{u1, u2} α β rα rβ f), Eq.{max (succ u1) (succ u2)} (α -> β) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) (fun (_x : RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) => α -> β) (RingHom.hasCoeToFun.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) (RingHom.of.{u1, u2} α β rα rβ f hf)) f
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : Semiring.{u1} α} {rβ : Semiring.{u2} β} {f : α -> β} (hf : IsSemiringHom.{u1, u2} α β rα rβ f), Eq.{max (succ u1) (succ u2)} (forall (ᾰ : α), (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : α) => β) ᾰ) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : α) => β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) α β (NonUnitalNonAssocSemiring.toMul.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α rα))) (NonUnitalNonAssocSemiring.toMul.{u2} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} β (Semiring.toNonAssocSemiring.{u2} β rβ))) (NonUnitalRingHomClass.toMulHomClass.{max u1 u2, u1, u2} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) α β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α rα)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} β (Semiring.toNonAssocSemiring.{u2} β rβ)) (RingHomClass.toNonUnitalRingHomClass.{max u1 u2, u1, u2} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ) (RingHom.instRingHomClassRingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ))))) (RingHom.of.{u1, u2} α β rα rβ f hf)) f
Case conversion may be inaccurate. Consider using '#align ring_hom.coe_of RingHom.coe_ofₓ'. -/
@[simp]
theorem coe_of {f : α → β} (hf : IsSemiringHom f) : ⇑(of hf) = f :=
  rfl
#align ring_hom.coe_of RingHom.coe_of

/- warning: ring_hom.to_is_semiring_hom -> RingHom.to_isSemiringHom is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [rα : Semiring.{u1} α] [rβ : Semiring.{u2} β] (f : RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)), IsSemiringHom.{u1, u2} α β rα rβ (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) (fun (_x : RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) => α -> β) (RingHom.hasCoeToFun.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) f)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : Semiring.{u1} α} {rβ : Semiring.{u2} β} (f : RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)), IsSemiringHom.{u1, u2} α β rα rβ (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : α) => β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) α β (NonUnitalNonAssocSemiring.toMul.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α rα))) (NonUnitalNonAssocSemiring.toMul.{u2} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} β (Semiring.toNonAssocSemiring.{u2} β rβ))) (NonUnitalRingHomClass.toMulHomClass.{max u1 u2, u1, u2} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) α β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α rα)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} β (Semiring.toNonAssocSemiring.{u2} β rβ)) (RingHomClass.toNonUnitalRingHomClass.{max u1 u2, u1, u2} (RingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ)) α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ) (RingHom.instRingHomClassRingHom.{u1, u2} α β (Semiring.toNonAssocSemiring.{u1} α rα) (Semiring.toNonAssocSemiring.{u2} β rβ))))) f)
Case conversion may be inaccurate. Consider using '#align ring_hom.to_is_semiring_hom RingHom.to_isSemiringHomₓ'. -/
theorem to_isSemiringHom (f : α →+* β) : IsSemiringHom f :=
  { map_zero := f.map_zero
    map_one := f.map_one
    map_add := f.map_add
    map_mul := f.map_mul }
#align ring_hom.to_is_semiring_hom RingHom.to_isSemiringHom

end

/- warning: ring_hom.to_is_ring_hom -> RingHom.to_isRingHom is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {γ : Type.{u2}} [_inst_1 : Ring.{u1} α] [_inst_2 : Ring.{u2} γ] (g : RingHom.{u1, u2} α γ (NonAssocRing.toNonAssocSemiring.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u2} γ (Ring.toNonAssocRing.{u2} γ _inst_2))), IsRingHom.{u1, u2} α γ _inst_1 _inst_2 (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (RingHom.{u1, u2} α γ (NonAssocRing.toNonAssocSemiring.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u2} γ (Ring.toNonAssocRing.{u2} γ _inst_2))) (fun (_x : RingHom.{u1, u2} α γ (NonAssocRing.toNonAssocSemiring.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u2} γ (Ring.toNonAssocRing.{u2} γ _inst_2))) => α -> γ) (RingHom.hasCoeToFun.{u1, u2} α γ (NonAssocRing.toNonAssocSemiring.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u2} γ (Ring.toNonAssocRing.{u2} γ _inst_2))) g)
but is expected to have type
  forall {α : Type.{u2}} {γ : Type.{u1}} [_inst_1 : Ring.{u2} α] [_inst_2 : Ring.{u1} γ] (g : RingHom.{u2, u1} α γ (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2))), IsRingHom.{u2, u1} α γ _inst_1 _inst_2 (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (RingHom.{u2, u1} α γ (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2))) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : α) => γ) _x) (MulHomClass.toFunLike.{max u2 u1, u2, u1} (RingHom.{u2, u1} α γ (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2))) α γ (NonUnitalNonAssocSemiring.toMul.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1)))) (NonUnitalNonAssocSemiring.toMul.{u1} γ (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} γ (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2)))) (NonUnitalRingHomClass.toMulHomClass.{max u2 u1, u2, u1} (RingHom.{u2, u1} α γ (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2))) α γ (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} γ (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2))) (RingHomClass.toNonUnitalRingHomClass.{max u2 u1, u2, u1} (RingHom.{u2, u1} α γ (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2))) α γ (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2)) (RingHom.instRingHomClassRingHom.{u2, u1} α γ (NonAssocRing.toNonAssocSemiring.{u2} α (Ring.toNonAssocRing.{u2} α _inst_1)) (NonAssocRing.toNonAssocSemiring.{u1} γ (Ring.toNonAssocRing.{u1} γ _inst_2)))))) g)
Case conversion may be inaccurate. Consider using '#align ring_hom.to_is_ring_hom RingHom.to_isRingHomₓ'. -/
theorem to_isRingHom {α γ} [Ring α] [Ring γ] (g : α →+* γ) : IsRingHom g :=
  IsRingHom.of_semiring g.to_isSemiringHom
#align ring_hom.to_is_ring_hom RingHom.to_isRingHom

end RingHom