-- old
#exit

import data.set.finite
import tactic
import finiteness.is_finite

-- def is_fintype

/- Avigad's notes on dealing with finite sums and cardinality -/

noncomputable theory

open_locale classical

namespace set

variables {α : Type*} {β : Type*}

attribute [class] finite infinite

section

variable [add_comm_monoid β]

def sum (s : set α) (f : α → β) : β :=
if h : finite s then h.to_finset.sum f else 0

def sum_zero_of_not_finite {s : set α} (h : ¬ finite s) (f : α → β) : sum s f = 0 :=
dif_neg h

def sum_zero_of_infinite {s : set α} [infinite s] (f : α → β) : sum s f = 0 :=
dif_neg (show infinite s, by apply_instance)

def sum_def_of_finite {s : set α} [h : finite s] (f : α → β) : sum s f = h.to_finset.sum f :=
dif_pos h

lemma sum_ext {s t : set α} {f₁ f₂ : α → β} (h₀ : s = t) (h₁ : ∀ x ∈ t, f₁ x = f₂ x) :
  sum s f₁ = sum t f₂ :=
if h' : finite s then
  begin
    haveI h'' : finite t := by rw [←h₀]; assumption,
    rw [sum, sum, dif_pos h', dif_pos h''],
    apply finset.sum_congr,
    { ext, simp only [finite.mem_to_finset, h₀] },
    intro x, rw [finite.mem_to_finset], apply h₁
  end
else
  begin
    haveI h'' : ¬ finite t := by rw [←h₀]; assumption,
    rw [sum, sum, dif_neg h', dif_neg h'']
  end
end

def card (s : set α) : ℕ :=
s.sum (λ x, 1)

lemma card_zero_of_not_finite {s : set α} (h : ¬ finite s) : card s = 0 :=
dif_neg h

lemma card_def_of_finite' {s : set α} [h : finite s] : card s = h.to_finset.sum (λ x, 1) :=
dif_pos h

lemma card_def_of_finite {s : set α} [h : finite s] : card s = finset.card (h.to_finset) :=
by rw [card_def_of_finite', finset.card_eq_sum_ones]

lemma finite_or_infinite (s : set α) : finite s ∨ infinite s := classical.em _

instance set.finite.fintype' {α : Type*} {s : set α} [s.finite] : fintype s :=
set.finite.fintype $ by apply_instance

instance finite_inter {α : Type*} {s t : set α} [s.finite] : (s ∩ t).finite :=
finite.subset (by apply_instance : finite s) $ inter_subset_left _ _

lemma to_finset_inter' {α : Type*} (s t : set α) [s.finite] [t.finite] :
  (s ∩ t).to_finset = s.to_finset ∩ t.to_finset :=
by ext; simp

/-- Two sets are disjoint iff they are disjoint as finsets. -/
lemma disjoint_finset_iff_disjoint {α : Type*} {s t : set α} [finite s] [finite t]:
  disjoint s t ↔ disjoint s.to_finset t.to_finset :=
begin
  rw [disjoint, disjoint, le_bot_iff, le_bot_iff],
  change _ ∩ _ = ∅ ↔ _ ∩ _ = ∅,
  rw ←set.to_finset_inter',
  split,
  { intro h, simp_rw h, ext, simp },
  { intro h, ext, rw ←set.mem_to_finset, rw h, simp }
end

lemma Union_to_finset_eq_bind {ι α : Type*} [fintype ι] [fintype α] (f : ι → set α) :
  (⋃ i : ι, f i).to_finset = (finset.univ : finset ι).bind(λ i, (f i).to_finset) := by ext; simp

universe v

lemma foo (s : set α) [finite s] (β : Type v) [add_comm_monoid β] (f : α → β) :
  s.to_finset.sum f = finset.univ.sum (λ (a : s), f a.1) :=
begin
  symmetry,
  convert finset.sum_subtype_of_mem _ _,
  { ext x,
    cases x with x hx,
    simp [hx]
  },
  by apply_instance,
  simp
end

lemma card_sUnion (s : set (set α)) [finite s] (h1 : ∀ a ∈ s, finite a)
    (h2 : ∀ a ∈ s, ∀ b ∈ s, a ≠ b → a ∩ b = ∅) :
  card s.sUnion = s.sum (λ a, card a) :=
begin
  haveI : finite s.sUnion := finite.sUnion (by apply_instance) h1,
  simp_rw ←subset_empty_iff at h2,
  change ∀ a ∈ s, ∀ b ∈ s, a ≠ b → disjoint a b at h2,
  let t : s → finset α := λ x, (@set.to_finset _ x.1 (set.finite.fintype (h1 x.1 x.2))),
  have h : ∀ (x : s), x ∈ (finset.univ : finset s) → ∀ (y : s), y ∈ (finset.univ : finset s) → x ≠ y → disjoint (t x) (t y),
  { rintros ⟨a, ha⟩ h4 ⟨b, hb⟩ h3 h,
    have h' : a ≠ b, rintro rfl, apply h, refl,
    rw ←disjoint_finset_iff_disjoint,
    convert h2 a ha b hb h' },
  convert @finset.card_bind s α _ (finset.univ : finset s) t h,
  { rw card_def_of_finite,
    apply congr_arg,
    ext x,
    rw finset.mem_bind,
    show x ∈ to_finset _ ↔ _,
    rw mem_to_finset,
    rw mem_sUnion,
    finish },
  rw sum_def_of_finite,
  change s.to_finset.sum _ = _,
  rw foo s _ (λ a : set α, a.card),
  congr',
  ext x,
  cases x with S hS,
  dsimp [t],
  haveI := h1 S hS,
  exact @card_def_of_finite _ S _,
end

lemma sum_linear [comm_semiring β] (s : set α) (c : β) (f : α → β) :
  s.sum (λx, c * f x) = c * s.sum f :=
begin
  casesI finite_or_infinite s,
  { rw [sum_def_of_finite, sum_def_of_finite],
    exact (finite.to_finset h).sum_hom (has_mul.mul c) },
  { simp [sum_zero_of_not_finite h, card_zero_of_not_finite h] }
end

lemma sum_const (s : set α) (c : ℕ):
  s.sum (λx, c) = c * card s :=
begin
  unfold card,
  rw ←sum_linear s c (λ a, 1),
  simp
end

lemma card_image_of_inj_on' {s : set α} [finite s] {f : α → β}
  (h : ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → f x = f y → x = y) :
    card (f '' s) = card s :=
begin
  haveI : finite (f '' s) := by {
    rw finite_image_iff, assumption,
    exact h },
  rw card_def_of_finite,
  rw card_def_of_finite,
  have h' : ∀ (x : α), x ∈ _inst_1.to_finset → ∀ (y : α), y ∈ _inst_1.to_finset → f x = f y → x = y,
    intros x hx y hy,
    change x ∈ to_finset _ at hx,
    change y ∈ to_finset _ at hy,
    rw mem_to_finset at hx hy,
  exact h x hx y hy,
  convert finset.card_image_of_inj_on h',
  ext x,simp
end

end set


/-
Copyright (c) 2022 Jon Eugster. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jon Eugster
-/
import algebra.char_p.algebra
import algebra.char_p.local_ring
import ring_theory.ideal.quotient
import tactic.field_simp

/-!
# Equal and mixed characteristic

In commutative algebra, some statments are simpler when working over a `ℚ`-algebra `R`, in which
case one also says that the ring has "equal characteristic zero". A ring that is not a
`ℚ`-algebra has either positive characteristic or there exists a prime ideal `I ⊂ R` such that
the quotient `R ⧸ I` has positive characteristic `p > 0`. In this case one speaks of
"mixed characteristic `(0, p)`", where `p` is only unique if `R` is local.

Examples of mixed characteristic rings are `ℤ` or the `p`-adic integers/numbers.

This file provides the main theorem `split_by_characteristic` that splits any proposition `P` into
the following three cases:

1) Positive characteristic: `char_p R p` (where `p ≠ 0`)
2) Equal characteristic zero: `algebra ℚ R`
3) Mixed characteristic: `mixed_char_zero R p` (where `p` is prime)

## Main definitions

- `mixed_char_zero` : A ring has mixed characteristic `(0, p)` if it has characteristic zero
  and there exists an ideal such that the quotient `R ⧸ I` has characteristic `p`.

## Main results

- `split_equal_mixed_char` : Split a statement into equal/mixed characteristic zero.

This main theorem has the following three corollaries which include the positive
characteristic case for convenience:

- `split_by_characteristic` : Generally consider positive char `p ≠ 0`.
- `split_by_characteristic_domain` : In a domain we can assume that `p` is prime.
- `split_by_characteristic_local_ring` : In a local ring we can assume that `p` is a prime power.

## TODO

- Relate mixed characteristic in a local ring to p-adic numbers [number_theory.padics].

-/

variables (R : Type*) [comm_ring R]

/-!
### Mixed characteristic
-/

/--
A ring of characteristic zero is of "mixed characteristic `(0, p)`" if there exists an ideal
such that the quotient `R ⧸ I` has caracteristic `p`.

**Remark:** For `p = 0`, `mixed_char R 0` is a meaningless definition as `R ⧸ ⊥ ≅ R` has by
definition always characteristic zero.
One could require `(I ≠ ⊥)` in the definition, but then `mixed_char R 0` would mean something
like `ℤ`-algebra of extension degree `≥ 1` and would be completely independent from
whether something is a `ℚ`-algebra or not (e.g. `ℚ[X]` would satisfy it but `ℚ` wouldn't).
-/
class mixed_char_zero (p : ℕ) : Prop :=
[to_char_zero : char_zero R]
(char_p_quotient : ∃ (I : ideal R), (I ≠ ⊤) ∧ char_p (R ⧸ I) p)

namespace mixed_char_zero

/--
Reduction to `p` prime: When proving any statement `P` about mixed characteristic rings we
can always assume that `p` is prime.
-/
lemma reduce_to_p_prime {P : Prop} :
  (∀ p > 0, mixed_char_zero R p → P) ↔
  (∀ (p : ℕ), p.prime → mixed_char_zero R p → P) :=
begin
  split,
  { intros h q q_prime q_mixed_char,
    exact h q (nat.prime.pos q_prime) q_mixed_char },
  { intros h q q_pos q_mixed_char,
    rcases q_mixed_char.char_p_quotient with ⟨I, hI_ne_top, hI_char⟩,

    -- Krull's Thm: There exists a prime ideal `P` such that `I ≤ P`
    rcases ideal.exists_le_maximal I hI_ne_top with ⟨M, hM_max, h_IM⟩,
    resetI, -- make `hI_char : char_p (R ⧸ I) q` an instance.

    let r := ring_char (R ⧸ M),
    have r_pos : r ≠ 0,
    { have q_zero := congr_arg (ideal.quotient.factor I M h_IM) (char_p.cast_eq_zero (R ⧸ I) q),
      simp only [map_nat_cast, map_zero] at q_zero,
      apply ne_zero_of_dvd_ne_zero (ne_of_gt q_pos),
      exact (char_p.cast_eq_zero_iff (R ⧸ M) r q).mp q_zero },
    have r_prime : nat.prime r :=
      or_iff_not_imp_right.1 (char_p.char_is_prime_or_zero (R ⧸ M) r) r_pos,
    apply h r r_prime,
    haveI : char_zero R := q_mixed_char.to_char_zero,
    exact ⟨⟨M, hM_max.ne_top, ring_char.of_eq rfl⟩⟩ }
end

/--
Reduction to `I` prime ideal: When proving statements about mixed characteristic rings,
after we reduced to `p` prime, we can assume that the ideal `I` in the definition is maximal.
-/
lemma reduce_to_maximal_ideal {p : ℕ} (hp : nat.prime p) :
  (∃ (I : ideal R), (I ≠ ⊤) ∧ char_p (R ⧸ I) p) ↔
  (∃ (I : ideal R), (I.is_maximal) ∧ char_p (R ⧸ I) p) :=
begin
  split,
  { intro g,
    rcases g with ⟨I, ⟨hI_not_top, hI⟩⟩,

    -- Krull's Thm: There exists a prime ideal `M` such that `I ≤ M`.
    rcases ideal.exists_le_maximal I hI_not_top with ⟨M, ⟨hM_max, hM⟩⟩,

    use M,
    split,
    exact hM_max,
    { cases char_p.exists (R ⧸ M) with r hr,
      convert hr,
      resetI, -- make `hr : char_p (R ⧸ M) r` an instance.

      have r_dvd_p : r ∣ p,
      { rw ←char_p.cast_eq_zero_iff (R ⧸ M) r p,
        convert congr_arg (ideal.quotient.factor I M hM) (char_p.cast_eq_zero (R ⧸ I) p) },
      symmetry,
      apply (nat.prime.eq_one_or_self_of_dvd hp r r_dvd_p).resolve_left,
      exact char_p.char_ne_one (R ⧸ M) r }},
  { rintro ⟨I, hI_max, hI⟩,
    use I,
    exact ⟨ideal.is_maximal.ne_top hI_max, hI⟩ }
end

end mixed_char_zero

/-!
### Equal characteristic zero

A commutative ring `R` has "equal characteristic zero" if it satisfies one of the following
equivalent properties:

1) `R` is a `ℚ`-algebra.
2) The quotient `R ⧸ I` has characteristic zero for any proper ideal `I ⊂ R`.
3) `R` has characteristic zero and does not have mixed characteristic for any prime `p`.

We show `(1) ↔ (2) ↔ (3)`, and most of the following is concerned with constructing
an explicit algebra map `ℚ →+* R` (given by `x ↦ (x.num : R) /ₚ ↑x.pnat_denom`)
for the direction `(1) ← (2)`.

Note: Property `(2)` is denoted as `equal_char_zero` in the statement names below.
-/
section equal_char_zero

/--
`ℚ`-algebra implies equal characteristic.
-/
@[nolint unused_arguments] -- argument `[nontrivial R]` is used in the first line of the proof.
lemma Q_algebra_to_equal_char_zero [nontrivial R] [algebra ℚ R] :
  ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I) :=
begin
  haveI : char_zero R := algebra_rat.char_zero R,
  intros I hI,
  constructor,
  intros a b h_ab,
  contrapose! hI,
  -- `↑a - ↑b` is a unit contained in `I`, which contradicts `I ≠ ⊤`.
  refine I.eq_top_of_is_unit_mem _ (is_unit.map (algebra_map ℚ R) (is_unit.mk0 (a - b : ℚ) _)),
  { simpa only [← ideal.quotient.eq_zero_iff_mem, map_sub, sub_eq_zero, map_nat_cast] },
  simpa only [ne.def, sub_eq_zero] using (@nat.cast_injective ℚ _ _).ne hI
end

section construction_of_Q_algebra

/-- Internal: Not intended to be used outside this local construction. -/
lemma equal_char_zero.pnat_coe_is_unit [h : fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I))]
  (n : ℕ+) : is_unit (n : R) :=
begin
  -- `n : R` is a unit iff `(n)` is not a proper ideal in `R`.
  rw ← ideal.span_singleton_eq_top,
  -- So by contrapositive, we should show the quotient does not have characteristic zero.
  apply not_imp_comm.mp (h.elim (ideal.span {n})),
  unfreezingI { intro h_char_zero },
  -- In particular, the image of `n` in the quotient should be nonzero.
  apply (h_char_zero.cast_injective).ne n.ne_zero,
  -- But `n` generates the ideal, so its image is clearly zero.
  rw [←map_nat_cast (ideal.quotient.mk _), nat.cast_zero, ideal.quotient.eq_zero_iff_mem],
  exact ideal.subset_span (set.mem_singleton _)
end

/-- Internal: Not intended to be used outside this local construction. -/
noncomputable instance equal_char_zero.pnat_has_coe_units
  [fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I))] : has_coe_t ℕ+ Rˣ :=
⟨λn, (equal_char_zero.pnat_coe_is_unit R n).unit⟩

/-- Internal: Not intended to be used outside this local construction. -/
lemma equal_char_zero.pnat_coe_units_eq_one [fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I))] :
  ((1 : ℕ+) : Rˣ) = 1 :=
begin
  apply units.ext,
  rw units.coe_one,
  change ((equal_char_zero.pnat_coe_is_unit R 1).unit : R) = 1,
  rw is_unit.unit_spec (equal_char_zero.pnat_coe_is_unit R 1),
  rw [coe_coe, pnat.one_coe, nat.cast_one],
end

/-- Internal: Not intended to be used outside this local construction. -/
lemma equal_char_zero.pnat_coe_units_coe_eq_coe
  [fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I))] (n : ℕ+) :
  ((n : Rˣ) : R) = ↑n :=
begin
  change ((equal_char_zero.pnat_coe_is_unit R n).unit : R) = ↑n,
  simp only [is_unit.unit_spec],
end

/--
Equal characteristic implies `ℚ`-algebra.
-/
noncomputable def equal_char_zero_to_Q_algebra (h : ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I)) :
  algebra ℚ R :=
by haveI : fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I)) := ⟨h⟩; exact
ring_hom.to_algebra
  { to_fun := λ x, x.num /ₚ ↑(x.pnat_denom),
    map_zero' := by simp [divp],
    map_one' := by simp [equal_char_zero.pnat_coe_units_eq_one],
    map_mul' :=
    begin
      intros a b,
      field_simp,
      repeat { rw equal_char_zero.pnat_coe_units_coe_eq_coe R },
      transitivity (↑((a * b).num * (a.denom) * (b.denom)) : R),
      { simp_rw [int.cast_mul, int.cast_coe_nat, coe_coe, rat.coe_pnat_denom],
        ring },
      rw rat.mul_num_denom' a b,
      simp
    end,
    map_add' :=
    begin
      intros a b,
      field_simp,
      repeat { rw equal_char_zero.pnat_coe_units_coe_eq_coe R },
      transitivity (↑((a + b).num * a.denom * b.denom) : R),
      { simp_rw [int.cast_mul, int.cast_coe_nat, coe_coe, rat.coe_pnat_denom],
        ring },
      rw rat.add_num_denom' a b,
      simp
    end }

end construction_of_Q_algebra

end equal_char_zero

/--
Not mixed characteristic implies equal characteristic.
-/
lemma not_mixed_char_to_equal_char_zero [char_zero R] (h : ∀ p > 0, ¬mixed_char_zero R p) :
  ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I) :=
begin
  intros I hI_ne_top,
  apply char_p.char_p_to_char_zero _,
  cases char_p.exists (R ⧸ I) with p hp,
  cases p,
  { exact hp },
  { have h_mixed : mixed_char_zero R p.succ := ⟨⟨I, ⟨hI_ne_top, hp⟩⟩⟩,
    exact absurd h_mixed (h p.succ p.succ_pos) }
end

/--
Equal characteristic implies not mixed characteristic.
-/
lemma equal_char_zero_to_not_mixed_char (h : ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I)) :
  ∀ p > 0, ¬mixed_char_zero R p :=
begin
  intros p p_pos,
  by_contradiction hp_mixed_char,
  rcases hp_mixed_char.char_p_quotient with ⟨I, hI_ne_top, hI_p⟩,
  replace hI_zero : char_p (R ⧸ I) 0 := @char_p.of_char_zero _ _ (h I hI_ne_top),
  exact absurd (char_p.eq (R ⧸ I) hI_p hI_zero) (ne_of_gt p_pos),
end

/--
A ring of characteristic zero has equal characteristic iff it does not
have mixed characteristic for any `p`.
-/
lemma equal_char_zero_iff_not_mixed_char [char_zero R] :
  (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I)) ↔ (∀ p > 0, ¬mixed_char_zero R p) :=
⟨equal_char_zero_to_not_mixed_char R, not_mixed_char_to_equal_char_zero R⟩

/--
A ring is a `ℚ`-algebra iff it has equal characteristic zero.
-/
theorem Q_algebra_iff_equal_char_zero [nontrivial R] :
  nonempty (algebra ℚ R) ↔ ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I) :=
begin
  split,
  { intro h_alg,
    haveI h_alg' : algebra ℚ R := h_alg.some,
    apply Q_algebra_to_equal_char_zero },
  { intro h,
    apply nonempty.intro,
    exact equal_char_zero_to_Q_algebra R h }
end

/--
A ring of characteristic zero is not a `ℚ`-algebra iff it has mixed characteristic for some `p`.
-/
theorem not_Q_algebra_iff_not_equal_char_zero [char_zero R] :
  is_empty (algebra ℚ R) ↔ (∃ p > 0, mixed_char_zero R p) :=
begin
  rw ←not_iff_not,
  push_neg,
  rw [not_is_empty_iff, ←equal_char_zero_iff_not_mixed_char],
  apply Q_algebra_iff_equal_char_zero,
end

/-!
# Splitting statements into different characteristic

Statements to split a proof by characteristic. There are 3 theorems here that are very
similar. They only differ in the assumptions we can make on the positive characteristic
case:
Generally we need to consider all `p ≠ 0`, but if `R` is a local ring, we can assume
that `p` is a prime power. And if `R` is a domain, we can even assume that `p` is prime.
-/
section main_statements

variable {P : Prop}

/--
Split a `Prop` in characteristic zero into equal and mixed characteristic.
-/
theorem split_equal_mixed_char [char_zero R]
  (h_equal : algebra ℚ R → P)
  (h_mixed : ∀ (p : ℕ), (nat.prime p → mixed_char_zero R p → P)) : P :=
begin
  by_cases h : ∃ p > 0, mixed_char_zero R p,
  { rcases h with ⟨p, ⟨H, hp⟩⟩,
    rw ←mixed_char_zero.reduce_to_p_prime at h_mixed,
    exact h_mixed p H hp },
  { apply h_equal,
    rw [←not_Q_algebra_iff_not_equal_char_zero, not_is_empty_iff] at h,
    exact h.some },
end

example (n : ℕ) (h : n ≠ 0) :0 < n := zero_lt_iff.mpr h

/-- Split any `Prop` over `R` into the three cases:
- positive characteristic.
- equal characteristic zero.
- mixed characteristic `(0, p)`.
-/
theorem split_by_characteristic
  (h_pos : ∀ (p : ℕ), (p ≠ 0 → char_p R p → P))
  (h_equal : algebra ℚ R → P)
  (h_mixed : ∀ (p : ℕ), (nat.prime p → mixed_char_zero R p → P)) : P :=
begin
  cases char_p.exists R with p p_char,
  by_cases p = 0,
  { rw h at p_char,
    resetI, -- make `p_char : char_p R 0` an instance.
    haveI h0 : char_zero R := char_p.char_p_to_char_zero R,
    exact split_equal_mixed_char R h_equal h_mixed },
  exact h_pos p h p_char,
end

/-- In a `is_domain R`, split any `Prop` over `R` into the three cases:
- *prime* characteristic.
- equal characteristic zero.
- mixed characteristic `(0, p)`.
-/
theorem split_by_characteristic_domain [is_domain R]
  (h_pos : ∀ (p : ℕ), (nat.prime p → char_p R p → P))
  (h_equal : algebra ℚ R → P)
  (h_mixed : ∀ (p : ℕ), (nat.prime p → mixed_char_zero R p → P)) : P :=
begin
  refine split_by_characteristic R _ h_equal h_mixed,
  introsI p p_pos p_char,
  have p_prime : nat.prime p :=
    or_iff_not_imp_right.mp (char_p.char_is_prime_or_zero R p) p_pos,
  exact h_pos p p_prime p_char,
end

/-- In a `local_ring R`, split any `Prop` over `R` into the three cases:
- *prime power* characteristic.
- equal characteristic zero.
- mixed characteristic `(0, p)`.
-/
theorem split_by_characteristic_local_ring [local_ring R]
  (h_pos : ∀ (p : ℕ), (is_prime_pow p → char_p R p → P))
  (h_equal : algebra ℚ R → P)
  (h_mixed : ∀ (p : ℕ), (nat.prime p → mixed_char_zero R p → P)) : P :=
begin
  refine split_by_characteristic R _ h_equal h_mixed,
  introsI p p_pos p_char,
  have p_ppow : is_prime_pow (p : ℕ) :=
    or_iff_not_imp_left.mp (char_p_zero_or_prime_power R p) p_pos,
  exact h_pos p p_ppow p_char,
end

end main_statements


lemma lt_aux_two (a b : mynat) : succ a ≤ b → a ≤ b ∧ ¬ (b ≤ a) :=
begin
intro h1,
split,
have g := le_succ_self a,
exact le_trans _ _ _ g h1,
intro h2,
have g := le_trans _ _ _ h1 h2,
exact not_succ_le_self a g,
end


import lambda_calculus.utlc.basic
import lambda_calculus.utlc.reduction
import lambda_calculus.utlc.eta.basic
import logic.relation

namespace lambda_calculus
namespace utlc
namespace η

theorem step_church_rosser {a b c :utlc}: a →η b → a →η c →
  ∃ d, relation.refl_gen has_η_reduction.step b d
    ∧ c ↠η d :=
begin
  induction a generalizing b c,
  all_goals { simp },
  { intros hab hac,
    cases lambda_step_cases hab with x hab,
    cases hab with hab hab,
    all_goals { cases lambda_step_cases hac with y hac },
    all_goals { cases hac with hac hac },
    { cases a_ih hab.right hac.right with z ih,
      use Λ z,
      rw [hab.left, hac.left],
      refine ⟨ lambda_refl_reduction_step_lambda ih.left, lambda_reduction_lambda ih.right ⟩ },
    { rw [hab.left, hac.left],
      rw [hac.right] at hab,
      cases x,
      all_goals { simp [has_η_reduction.step, and_assoc] at hab },
      any_goals { contradiction },
      simp,
      have h: x_f.uses 0 = 0,
      { rw [← reduction_step_uses hab.right.right, shift_uses_self] },
      cases shift_of_uses_zero h with x' hx,
      use x',
      rw [hab.right.left, hx],
      split,
      apply relation.refl_gen.single,
      apply lambda_step_head,
      apply relation.refl_trans_gen.single,
      apply reduction_step_shift 0,
      rw [← hx],
      apply hab.right.right },
    { rw [hab.left, hac.left],
      rw [hab.right] at hac,
      cases y,
      all_goals { simp [has_η_reduction.step, and_assoc] at hac },
      any_goals { contradiction },
      simp,
      have h: y_f.uses 0 = 0,
      { rw [← reduction_step_uses hac.right.right, shift_uses_self] },
      cases shift_of_uses_zero h with y' hy,
      use y',
      rw [hac.right.left, hy],
      split,
      apply relation.refl_gen.single,
      apply reduction_step_shift 0,
      rw [← hy],
      apply hac.right.right,
      apply relation.refl_trans_gen.single,
      apply lambda_step_head },
    { simp [hac.right, ← hac.left] at hab,
      use x,
      simp [hab],
      exact ⟨ by refl, by refl ⟩ } },
  { intros hab hac,
    rcases dot_step_cases hab with ⟨x, y, bxy, hab⟩,
    cases hab with hab hab,
    all_goals { rcases dot_step_cases hac with ⟨x', y', cxy, hac⟩ },
    all_goals { cases hac with hac hac },
    { cases a_ih_f hab.right hac.right with d ih,
      use d·y,
      rw [bxy, cxy, hac.left, ← hab.left],
      refine ⟨ dot_refl_reduction_step_dot_left ih.left _, dot_reduction_dot_left ih.right ⟩
    },
    { use x·y',
      rw [bxy, cxy, hab.left, hac.left],
      refine ⟨ dot_refl_reduction_step_dot_right _ _, dot_reduction_dot_left _ ⟩,
      apply relation.refl_gen.single,
      apply hac.right,
      apply relation.refl_trans_gen.single,
      apply hab.right },
    { use x'·y,
      rw [bxy, cxy, hab.left, hac.left],
      refine ⟨ dot_refl_reduction_step_dot_left _ _, dot_reduction_dot_right _ ⟩,
      apply relation.refl_gen.single,
      apply hac.right,
      apply relation.refl_trans_gen.single,
      apply hab.right },
    { cases a_ih_g hab.right hac.right with d ih,
      use x·d,
      rw [bxy, cxy, hac.left, hab.left],
      refine ⟨ dot_refl_reduction_step_dot_right ih.left _, dot_reduction_dot_right ih.right ⟩
    }
  }
end

theorem church_rosser {a b c :utlc}: a ↠η b → a ↠η c → b ≡η c :=
  relation.church_rosser @step_church_rosser

@[refl]
theorem equiv_refl (f : utlc): f ≡η f :=
  ⟨f, relation.refl_trans_gen.refl, relation.refl_trans_gen.refl⟩

@[symm]
theorem equiv_symm {a b: utlc}: a ≡η b → b ≡η a :=
begin
  apply relation.symmetric_join
end

@[trans]
theorem equiv_trans {a b c : utlc}: a ≡η b → b ≡η c → a ≡η c :=
begin
  apply relation.transitive_join,
  apply relation.refl_trans_gen.trans,
  apply @church_rosser,
end

theorem reduced_reduction_inj {f g: utlc}: reduced f → f ↠η g → f = g :=
begin
  intros hf p,
  induction p with x y hx hy fx,
  { refl },
  rw [←fx] at *,
  exfalso,
  apply (reduced_iff_not_reduction _).mp hf _ hy
end

theorem reduced_equiv_inj {f g: utlc}: reduced f → reduced g → f ≡η g → f = g :=
begin
  intros hf hg p,
  cases p with x p,
  rw [reduced_reduction_inj hf p.left, reduced_reduction_inj hg p.right]
end

end η
end utlc
end lambda_calculus


import data.pnat.basic data.setoid.basic

inductive spread (α : Type*)
| zero : spread
| ps : α → spread
| ng : α → spread

namespace spread

instance {α : Type*} : has_zero (spread α) := ⟨zero⟩

lemma zero_def {α : Type*} : (0 : spread α) = zero := rfl

instance {α : Type*} [has_one α] : has_one (spread α) := ⟨ps 1⟩

lemma one_def {α : Type*} [has_one α] : (1 : spread α) = ps 1 := rfl

def is_sub {α : Type*} [add_comm_semigroup α] (x y : α) : spread α → Prop
| zero := x = y
| (ps z) := x = y + z
| (ng z) := x + z = y

lemma is_sub_unique {α : Type*} [add_comm_semigroup α]
 (hp : ∀ {x y : α}, x + y ≠ x)
 (hc : ∀ {x y z : α}, x + y = x + z → y = z)
 {x y : α} {z₀ z₁ : spread α} (h₀ : is_sub x y z₀) (h₁ : is_sub x y z₁) : z₀ = z₁ :=
begin
  cases z₀; cases z₁; dsimp[is_sub] at h₀ h₁,
  { refl, },
  { rw[h₀] at h₁, exact (hp h₁.symm).elim },
  { rw[h₀] at h₁, exact (hp h₁).elim },
  { rw[h₁] at h₀, exact (hp h₀.symm).elim },
  { rw[h₀] at h₁, rw[hc h₁] },
  { rw[h₀, add_assoc] at h₁, exact (hp h₁).elim },
  { rw[h₁] at h₀, exact (hp h₀).elim },
  { rw[h₁, add_assoc] at h₀, exact (hp h₀).elim },
  { rw[← h₁] at h₀, rw[hc h₀]}
end

def neg {α : Type*} : (spread α) → (spread α)
| zero := zero
| (ps x) := ng x
| (ng x) := ps x

instance {α : Type*} : has_neg (spread α) := ⟨neg⟩

lemma is_sub_swap {α : Type*} [add_comm_semigroup α] {x y : α} {z : spread α}:
 is_sub y x z ↔ is_sub x y (neg z) :=
begin
 cases z; dsimp[neg, is_sub]; exact comm
end

@[simp]
def mul {α : Type*} [has_mul α] : (spread α) → (spread α) → (spread α)
| (zero)  _     := zero
| (ps x) (zero) := zero
| (ps x) (ps y) := ps (x * y)
| (ps x) (ng y) := ng (x * y)
| (ng x) (zero) := zero
| (ng x) (ps y) := ng (x * y)
| (ng x) (ng y) := ps (x * y)

instance {α : Type*} [has_mul α] : has_mul (spread α) := ⟨mul⟩

instance {α : Type*} [comm_monoid α] : comm_monoid (spread α) := {
  one_mul := λ a, begin
    change mul 1 a = a, rw[one_def], cases a; simp[one_mul]
  end,
  mul_one := λ a, begin
    change mul a 1 = a, rw[one_def], cases a; simp[mul_one]
  end,
  mul_comm := λ a b, begin
    change mul a b = mul b a, cases a; cases b; simp[mul_comm],
  end,
  mul_assoc := λ a b c, begin
    change mul (mul a b) c = mul a (mul b c),
    cases a; cases b; cases c; simp[mul_assoc],
  end,
  .. (by { apply_instance } : has_one (spread α)),
  .. (by { apply_instance } : has_mul (spread α))
}

section add

variables {α : Type*} [add_comm_semigroup α]
variables (hp : ∀ {x y : α}, x + y ≠ x)
variables (hc : ∀ {x y z : α}, x + y = x + z → y = z)

def is_add : (spread α) → (spread α) → (spread α) → Prop
| (zero) (zero) (zero) := true
| (zero) (zero) (ps z) := false
| (zero) (zero) (ng z) := false
| (zero) (ps y) (zero) := false
| (zero) (ps y) (ps z) := (y = z)
| (zero) (ps y) (ng z) := false
| (zero) (ng y) (zero) := false
| (zero) (ng y) (ps z) := false
| (zero) (ng y) (ng z) := (y = z)
| (ps x) (zero) (zero) := false
| (ps x) (zero) (ps z) := (x = z)
| (ps x) (zero) (ng z) := false
| (ps x) (ps y) (zero) := false
| (ps x) (ps y) (ps z) := (x + y = z)
| (ps x) (ps y) (ng z) := false
| (ps x) (ng y) (zero) := (x = y)
| (ps x) (ng y) (ps z) := (y + z = x)
| (ps x) (ng y) (ng z) := (x + z = y)
| (ng x) (zero) (zero) := false
| (ng x) (zero) (ps z) := false
| (ng x) (zero) (ng z) := (x = z)
| (ng x) (ps y) (zero) := (x = y)
| (ng x) (ps y) (ps z) := (x + z = y)
| (ng x) (ps y) (ng z) := (y + z = x)
| (ng x) (ng y) (zero) := false
| (ng x) (ng y) (ps z) := false
| (ng x) (ng y) (ng z) := (x + y = z)

include hp hc

lemma is_add_unique {a b c₀ c₁ : spread α}
 (h₀ : is_add a b c₀) (h₁ : is_add a b c₁) : c₀ = c₁ :=
begin
 cases a; cases b;
 cases c₀; dsimp[is_add] at h₀;
 try { exfalso, assumption };
 cases c₁; dsimp[is_add] at h₁;
 try { exfalso, assumption };
 try { match_hyp h₀ : _ = _,
       fail_if_success { match_hyp h₀ : _ = _ + _},
       fail_if_success { match_hyp h₀ : _ + _ = _},
       cases h₀ };
 try { match_hyp h₁ : _ = _,
       fail_if_success { match_hyp h₁ : _ = _ + _},
       fail_if_success { match_hyp h₁ : _ + _ = _},
       cases h₁ };
  try { refl };
  try { exact (hp h₀).elim };
  try { exact (hp h₁).elim };
  try { rw[← h₀] at h₁, rw[hc h₁] };
  try { rw[← h₀, add_assoc] at h₁, exact (hp h₁).elim, };
  try { rw[← h₀, ← h₁] }
end

omit hp hc

lemma is_add_zero (a a' : spread α) :
 is_add a zero a' ↔ a = a' :=
begin
 split,
 { cases a; cases a'; dsimp[is_add]; intro h;
   try { exfalso, assumption }; try { cases h ; refl }
 },{
  intro h, cases h, cases a; dsimp[is_add]; trivial
 }
end

lemma is_zero_add (a a' : spread α) :
 is_add zero a a' ↔ a = a' :=
begin
 split,
 { cases a; cases a'; dsimp[is_add]; intro h;
   try { exfalso, assumption }; try { cases h ; refl }
 },{
  intro h, cases h, cases a; dsimp[is_add]; trivial
 }
end

include hp

lemma is_add_neg (a z : spread α) : is_add a (- a) z ↔ z = zero :=
begin
 change is_add a (neg a) z ↔ z = zero,
 split,
 { cases a; cases z; intro h; dsimp[neg, is_add] at h;
   try { replace h := hp h };
   try { exfalso, assumption };
   try { refl }
 },
 { intro h, rw[h],
   change is_add a (neg a) zero, cases a; dsimp[neg, is_add]; trivial
 }
end

omit hp

lemma is_add_comm (a b ab : spread α) :
 is_add a b ab ↔ is_add b a ab :=
begin
 cases a; cases b; cases ab; dsimp[is_add];
 try { trivial };
 try { rw[add_comm b a] };
 try { exact comm }
end

include hp hc

lemma is_add_assoc {a b c ab bc abc : spread α}
 (hab : is_add a b ab) (hbc : is_add b c bc) (habc : is_add ab c abc) :
 is_add a bc abc :=
begin
 have hp₁ : ∀ {x y : α}, y + x ≠ x :=
   λ x y h, by { rw[add_comm] at h, exact hp h},
 have hp₂ : ∀ {x y z : α}, x + (y + z) ≠ y :=
   λ x y z h, by { rw[add_comm x, add_assoc] at h, exact hp h },
 have hc₁ : ∀ { x y z : α}, x + y = z + x → y = z :=
   λ x y z h, by { rw[add_comm z x] at h, exact hc h },
 have hc₂ : ∀ { w x y z : α}, w + x = y + (w + z) → x = y + z :=
   λ w x y z h, by { rw[add_comm y, add_assoc, add_comm z] at h, exact hc h },
 cases a; cases b; cases c;
 try { rw[is_add_zero] at * }; try { rw[is_zero_add] at * };
 try { match_hyp habc : _ = _, cases habc };
 try { match_hyp hbc : _ = _, cases hbc };
 try { match_hyp hab : _ = _, cases hab };
 try { rw[is_add_zero] at * }; try { rw[is_zero_add] at * };
 try { rw[is_add_unique @hp @hc hab habc] };
 try { rw[is_add_unique @hp @hc hbc habc] };
 try { exact is_add_unique @hp @hc hbc habc };
 try { refl }; try { assumption };
 cases ab; dsimp[is_add] at hab; try { exfalso, assumption };
 try { rw[is_add_zero] at * }; try { rw[is_zero_add] at * };
 rw[← hab] at *;
 cases bc; dsimp[is_add] at hbc; try { exfalso, assumption };
 try { rw[is_add_zero] at * }; try { rw[is_zero_add] at * };
 rw[← hbc] at *;
 cases abc;
 try { dsimp[is_add] at habc };
 try { exfalso, assumption };
 try { injection habc with habc'; replace habc := habc' };
 try { dsimp[is_add] };
 rw[← habc] at *;
 repeat { rw[add_assoc] at * };
 try { rw[add_comm], done };
 try { exact (hp₁ habc).elim };
 try { exact (hp₁ habc.symm).elim };
 try { exact (hp₂ habc).elim };
 try { exact (hp₂ habc.symm).elim };
 try { rw[hc₁ habc] };
 try { rw[hc₁ habc.symm] };
 try { rw[hc₁ hbc] };
 try { rw[hc₁ hbc.symm] };
 try { rw[(hc₁ hbc).symm, add_comm], done };
 try { rw[hc₂ habc] };
 try { rw[hc₂ habc.symm] };
 try { rw[hc₂ hbc] };
 try { rw[add_comm b, add_assoc, add_comm b] };
 try { rw[add_comm c, add_assoc, add_comm _ c] }
end

omit hp hc

@[simp]
def add₀ (s : α → α → spread α) :
  spread α → spread α → spread α
| (zero) (zero) := zero
| (zero) (ps a) := ps a
| (zero) (ng b) := ng b
| (ps a) (zero) := ps a
| (ps a) (ps b) := ps (a + b)
| (ps a) (ng b) := s a b
| (ng a) (zero) := ng a
| (ng a) (ps b) := s b a
| (ng a) (ng b) := ng (a + b)

include hp hc

lemma add₀_is_add
 (s : α → α → spread α)
 (hs : ∀ a b : α, is_sub a b (s a b)) :
  ∀ (a b : spread α), is_add a b (add₀ s a b) :=
begin
 have hs' : ∀ {x y : α} {z : spread α} (h : is_sub x y z),
   is_add (ps x) (ng y) z :=
 λ x y z, begin
  cases z; dsimp[is_sub, is_add]; intro h; rw[h]
 end,
 intros a b,
 cases a; cases b; dsimp[add₀, is_add];
 try { refl }; try { trivial },
 { exact hs' (hs a b) },
 { rw[is_add_comm], exact hs' (hs b a) }
end

lemma add₀_is_add'
 (hp : ∀ {x y : α}, x + y ≠ x)
 (hc : ∀ {x y z : α}, x + y = x + z → y = z)
 (s : α → α → spread α)
 (hs : ∀ a b : α, is_sub a b (s a b))
 {a b c : spread α} :
 is_add a b c ↔ c = add₀ s a b :=
begin
 have h : is_add a b (add₀ s a b) := add₀_is_add @hp @hc s hs a b,
 split,
 { intro h', exact is_add_unique @hp @hc h' h },
 { intro h', rw[h'], exact h }
end

end add

section mul

variables {α : Type*} [add_comm_semigroup α] [comm_monoid α]
variable (hp : ∀ {x y : α}, x + y ≠ x)
variable (hc : ∀ {x y z : α}, x + y = x + z → y = z)
variables (s : α → α → spread α) (hs : ∀ a b : α, is_sub a b (s a b))
variable (hd : ∀ a b c : α, a * (b + c) = a * b + a * c)

include hd

lemma mul_ps_is_sub
 (x : α) {y z : α} {u : spread α} (h : is_sub y z u) :
 is_sub (x * y) (x * z) (mul (ps x) u) :=
begin
 cases u; dsimp[is_sub] at h; dsimp[mul, is_sub],
 { rw[h] }, { rw[h,hd] }, { rw[← h, hd] }
end

lemma mul_ng_is_sub
 (x : α) {y z : α} {u : spread α} (h : is_sub y z u) :
 is_sub (x * z) (x * y) (mul (ng x) u) :=
begin
 cases u; dsimp[is_sub] at h; dsimp[mul, is_sub],
 { rw[h] }, { rw[h,hd] }, { rw[← h, hd] }
end

omit hd
include s hs hp hc hd

lemma mul_add₀ (a b c : spread α) :
  a * (add₀ s b c) = add₀ s (a * b) (a * c) :=
begin
    change mul a (add₀ s b c) = add₀ s (mul a b) (mul a c),
    cases a; cases b; cases c;
    dsimp[add₀, mul]; try { rw[hd] }; try { refl },
    { have := (mul_ps_is_sub hd a (hs b c)),
      exact is_sub_unique @hp @hc this (hs (a * b) (a * c)) },
    { have := (mul_ps_is_sub hd a (hs c b)),
      exact is_sub_unique @hp @hc this (hs (a * c) (a * b)) },
    { have := (mul_ng_is_sub hd a (hs b c)),
      exact is_sub_unique @hp @hc this (hs (a * c) (a * b)) },
    { have := (mul_ng_is_sub hd a (hs c b)),
      exact is_sub_unique @hp @hc this (hs (a * b) (a * c)) },
end

lemma add₀_mul (a b c : spread α) :
  (add₀ s a b) * c = add₀ s (a * c) (b * c) :=
  by { repeat { rw[mul_comm _ c] }, apply mul_add₀ @hp @hc s hs hd }

variable (α)

def comm_ring₀ : comm_ring (spread α) := {
   add := add₀ s,
   zero_add := λ a, by { cases a; refl },
   add_zero := λ a, by { cases a; refl },
   add_left_neg := λ a, begin
    have hu := @is_sub_unique α (by apply_instance) @hp @hc,
    cases a,
    { refl },
    { have hz : is_sub a a zero := rfl, exact hu (hs a a) hz },
    { have hz : is_sub a a zero := rfl, exact hu (hs a a) hz }
   end,
   add_comm := λ a b, begin
     cases a; cases b; change add₀ s _ _ = add₀ s _ _;
     dsimp[add₀]; try { rw add_comm a b }; refl
   end,
   add_assoc := λ a b c, begin
    change add₀ s (add₀ s a b) c = add₀ s a (add₀ s b c),
    set ab := add₀ s a b with hab,
    set bc := add₀ s b c with hbc,
    set abc := add₀ s ab c with habc,
    have hab'  := (add₀_is_add' @hp @hc s hs).mpr hab,
    have hbc'  := (add₀_is_add' @hp @hc s hs).mpr hbc,
    have habc' := (add₀_is_add' @hp @hc s hs).mpr habc,
    rw[← add₀_is_add' @hp @hc s hs],
    exact is_add_assoc @hp @hc hab' hbc' habc',
   end,
   left_distrib := λ a b c, begin
    apply mul_add₀ @hp @hc s hs hd,
   end,
   right_distrib := λ a b c, begin
    apply add₀_mul @hp @hc s hs hd,
   end,
   .. (by apply_instance : has_neg (spread α)),
   .. (by apply_instance : has_zero (spread α)),
   .. (by apply_instance : comm_monoid (spread α))
 }

end mul

section le

variables {α : Type*} [linear_order α]

@[simp]
def le : (spread α) → (spread α) → Prop
| (zero) (zero) := true
| (zero) (ps y) := true
| (zero) (ng y) := false
| (ps x) (zero) := false
| (ps x) (ps y) := (x ≤ y)
| (ps x) (ng y) := false
| (ng x) (zero) := true
| (ng x) (ps y) := true
| (ng x) (ng y) := (y ≤ x)

instance : has_le (spread α) := ⟨le⟩

instance : linear_order (spread α) := {
  le_refl := λ a, begin
   cases a with a, trivial, exact (le_refl a), exact (le_refl a)
  end,
  le_trans := λ a b c hab hbc, begin
   cases a; cases b; cases c;
   try { cases hab }; try { cases hbc }; try { trivial };
   try { exact le_trans hab hbc };
   try { exact le_trans hbc hab }
  end,
  le_antisymm := λ a b hab hba, begin
   cases a; cases b;
   try { cases hab }; try { cases hba };
   try { cases (le_antisymm (hab : a ≤ b) (hba : b ≤ a)) };
   try { cases (le_antisymm (hab : b ≤ a) (hba : a ≤ b)) };
   refl,
  end,
  le_total := λ a b, begin
   cases a; cases b;
   try { cases (le_total a b) with h };
   try { left, trivial }; try { right, trivial };
   try { left, assumption }; try { right, assumption }
  end,
  decidable_le := λ a b, begin
   cases a; cases b;
   try { exact decidable.true }; try { exact decidable.false };
   try { exact (by apply_instance : decidable (a ≤ b)) };
   try { exact (by apply_instance : decidable (b ≤ a)) },
  end,
  .. (by { apply_instance } : has_le (spread α))
}

end le

end spread

@[derive decidable_eq]
structure prat_f : Type :=
(num : pnat) (den : pnat)

namespace prat_f

@[ext]
lemma ext {x y : prat_f} (hn : x.num = y.num) (hd : x.den = y.den) : x = y :=
begin
 cases x with a b, cases y with c d, cases (hn : a = c), cases (hd : b = d), refl
end

def one' (a : pnat) : prat_f := ⟨a,a⟩

instance : comm_monoid prat_f := {
  one := ⟨1,1⟩,
  mul := λ x y,⟨x.num * y.num, x.den * y.den⟩,
  one_mul := λ x, begin
    ext1, exact one_mul x.num, exact one_mul x.den,
  end,
  mul_one := λ x, begin
    ext1, exact mul_one x.num, exact mul_one x.den,
  end,
  mul_comm := λ x y, begin
   ext1, exact mul_comm x.num y.num, exact mul_comm x.den y.den
  end,
  mul_assoc := λ x y z, begin
   ext1, exact mul_assoc _ _ _,  exact mul_assoc _ _ _
  end
}

instance : has_inv prat_f := ⟨λ x, ⟨x.den, x.num⟩⟩

lemma inv_inv (x : prat_f) : (x⁻¹)⁻¹ = x := by { ext1; refl }

lemma inv_mul (x y : prat_f) : (x * y)⁻¹ = x⁻¹ * y⁻¹ := by { ext1; refl }

instance : add_comm_semigroup prat_f := {
  add := λ x y, ⟨x.num * y.den + x.den * y.num, x.den * y.den⟩,
  add_comm := λ x y, begin
   cases x with a b, cases y with c d,
   ext1,
   { change a * d + b * c = c * b + d * a, rw[add_comm, mul_comm b c, mul_comm a d] },
   { exact mul_comm b d }
  end,
  add_assoc := λ x y z, begin
   cases x with a b, cases y with c d, cases z with e f,
   ext1,
   { change (a * d + b * c) * f + (b * d) * e  = a * (d * f) + b * (c * f + d * e),
     rw[add_mul, mul_add, ← add_assoc, ← mul_assoc, ← mul_assoc, ← mul_assoc]
   },{
     exact mul_assoc b d f
   }
  end
}

lemma add_def (x y : prat_f) :
  x + y = ⟨x.num * y.den + x.den * y.num, x.den * y.den⟩ := rfl

lemma add_def' (a b c d : pnat) :
  (prat_f.mk a b) + (prat_f.mk c d) = (prat_f.mk (a * d + b * c) (b * d)) :=
   by { rw[add_def] }

lemma num_add (x y : prat_f) : (x + y).num = x.num * y.den + x.den * y.num := rfl

lemma den_add (x y : prat_f) : (x + y).den = x.den * y.den := rfl

lemma mul_add (x y z : prat_f) : x * (y + z) * (one' x.den) = x * y + x * z :=
begin
  cases x with a b, cases y with c d, cases z with e f,
  ext1,
  { change a * (c * f + d * e) * b = (a * c) * (b * f) + (b * d) * (a * e),
    rw[mul_add, add_mul, mul_comm b f, mul_comm d e, mul_comm (b * d) (a * e), mul_comm b d],
    repeat { rw[← mul_assoc] },
  },{
    change b * (d * f) * b = (b * d) * (b * f),
    rw[mul_comm b f],
    repeat { rw[← mul_assoc] }
  }
end

instance : preorder prat_f := {
  le := λ x y, x.num * y.den ≤ y.num * x.den,
  le_refl := λ x, le_refl _,
  le_trans := begin
    rintro ⟨a,b⟩ ⟨c,d⟩ ⟨e,f⟩ (hxy : a * d ≤ c * b) (hyz : c * f ≤ e * d),
    change a * f ≤ e * b,
    replace hxy := (mul_le_mul_iff_right f).mpr hxy,
    replace hyz := (mul_le_mul_iff_left b).mpr hyz,
    rw[← mul_assoc b c f, mul_comm b c] at hyz,
    have hxz := le_trans hxy hyz,
    rw[mul_assoc a d f, mul_comm d f, ← mul_assoc, ← mul_assoc, mul_comm b e] at hxz,
    exact (mul_le_mul_iff_right d).mp hxz,
  end
}

instance : decidable_rel ((≤) : prat_f → prat_f → Prop) :=
  by { apply_instance }

lemma add_le_add_iff_left (x : prat_f) {y z : prat_f} : x + y ≤ x + z ↔ y ≤ z :=
begin
 cases x with a b, cases y with c d, cases z with e f,
 change (a * d + b * c) * (b * f) ≤ (a * f + b * e) * (b * d) ↔ c * f ≤ e * d,
 rw[add_mul, add_mul, mul_comm b d, mul_assoc a f (d * b), mul_comm f (d * b)],
 repeat { rw[mul_assoc] },
 rw[add_le_add_iff_left, mul_le_mul_iff_left, mul_comm b f],
 repeat { rw[← mul_assoc] },
 rw[mul_le_mul_iff_right]
end

lemma mul_le_mul_iff_left (x : prat_f) {y z : prat_f} : x * y ≤ x * z ↔ y ≤ z :=
begin
 cases x with a b, cases y with c d, cases z with e f,
 change (a * c) * (b * f) ≤ (a * e) * (b * d) ↔ c * f ≤ e * d,
 rw[mul_comm b f, mul_comm b d, mul_assoc a c, mul_assoc a e, ← mul_assoc c, ← mul_assoc e],
 rw[mul_le_mul_iff_left a, mul_le_mul_iff_right b],
end

def fraceq : setoid prat_f := {
 r := λ x y, x.num * y.den = y.num * x.den,
 iseqv := begin
   split,
   { intro x, refl },
   split,
   { rintro x y (h : x.num * y.den = y.num * x.den), exact h.symm },
   { rintro ⟨a,b⟩ ⟨c,d⟩ ⟨e,f⟩ (hxy : a * d = c * b) (hyz : c * f = e * d),
     change a * f = e * b,
     replace hxy : (a * d) * f = (c * b) * f := congr_fun (congr_arg (*) hxy) f,
     replace hyz : b * (c * f) = b * (e * d) := congr_arg ((*) b) hyz,
     rw[← mul_assoc b c f, mul_comm b c] at hyz,
     have hxz := hxy.trans hyz,
     rw[mul_assoc a d f, mul_comm d f, ← mul_assoc, ← mul_assoc, mul_comm b e] at hxz,
     exact (mul_left_inj d).mp hxz,
   }
 end
}

lemma fraceq.rel_def (x y : prat_f) : fraceq.rel x y ↔ x.num * y.den = y.num * x.den :=
  by { refl }

instance : decidable_rel fraceq.rel := λ x y, by { rw[fraceq.rel_def], apply_instance }

lemma mul_lift {x₀ y₀ x₁ y₁ : prat_f} (hx : fraceq.rel x₀ x₁) (hy : fraceq.rel y₀ y₁) :
  fraceq.rel (x₀ * y₀) (x₁ * y₁) :=
begin
  cases x₀ with a₀ b₀, cases x₁ with a₁ b₁,
  cases y₀ with c₀ d₀, cases y₁ with c₁ d₁,
  change a₀ * b₁ = a₁ * b₀ at hx,
  change c₀ * d₁ = c₁ * d₀ at hy,
  change (a₀ * c₀) * (b₁ * d₁) = (a₁ * c₁) * (b₀ * d₀),
  rw[mul_assoc a₀ c₀, ← mul_assoc c₀, mul_comm c₀,mul_assoc b₁, ← mul_assoc a₀],
  rw[hx, hy, mul_assoc a₁, ← mul_assoc b₀, mul_comm b₀ c₁],
  repeat { rw[mul_assoc] }
end

lemma add_lift {x₀ y₀ x₁ y₁ : prat_f} (hx : fraceq.rel x₀ x₁) (hy : fraceq.rel y₀ y₁) :
  fraceq.rel (x₀ + y₀) (x₁ + y₁) :=
begin
  cases x₀ with a₀ b₀, cases x₁ with a₁ b₁,
  cases y₀ with c₀ d₀, cases y₁ with c₁ d₁,
  change a₀ * b₁ = a₁ * b₀ at hx,
  change c₀ * d₁ = c₁ * d₀ at hy,
  change (a₀ * d₀ + b₀ * c₀) * (b₁ * d₁) = (a₁ * d₁ + b₁ * c₁) * (b₀ * d₀),
  rw[add_mul, add_mul],
  rw[mul_assoc a₀ d₀, ← mul_assoc d₀, mul_comm d₀ b₁,mul_assoc b₁, ← mul_assoc a₀, hx],
  rw[mul_assoc b₀ c₀, ← mul_assoc c₀, mul_comm c₀ b₁,mul_assoc b₁, hy],
  rw[mul_comm d₀ d₁, mul_assoc a₁ b₀, ← mul_assoc b₀, mul_comm b₀ d₁],
  rw[mul_comm b₀, mul_assoc b₁, mul_assoc c₁, mul_comm d₀ b₀],
  repeat { rw[mul_assoc] }
end

lemma le_lift {x₀ y₀ x₁ y₁ : prat_f} (hx : fraceq.rel x₀ x₁) (hy : fraceq.rel y₀ y₁) :
  x₀ ≤ y₀ ↔ x₁ ≤ y₁ :=
begin
  cases x₀ with a₀ b₀, cases x₁ with a₁ b₁,
  cases y₀ with c₀ d₀, cases y₁ with c₁ d₁,
  change a₀ * b₁ = a₁ * b₀ at hx,
  change c₀ * d₁ = c₁ * d₀ at hy,
  change (a₀ * d₀ ≤ c₀ * b₀) ↔ (a₁ * d₁ ≤ c₁ * b₁),
  conv { to_lhs, rw[← mul_le_mul_iff_right (b₁ * d₁)],
         rw[mul_assoc a₀, ← mul_assoc d₀, mul_comm d₀ b₁, mul_assoc b₁, ← mul_assoc a₀, hx],
         rw[mul_comm c₀, mul_assoc b₀ c₀, ← mul_assoc c₀ b₁, mul_comm c₀ b₁], },
  conv { to_rhs, rw[← mul_le_mul_iff_right (b₀ * d₀)],
         rw[mul_comm _ (b₀ * d₀), mul_assoc c₁ b₁, mul_comm b₁, mul_comm b₀],
         rw[mul_assoc d₀ b₀ b₁, ← mul_assoc c₁, ← hy],
         rw[mul_comm d₀ b₀, mul_comm (b₀ * d₀), mul_assoc a₁, ← mul_assoc d₁, mul_comm d₁ b₀],
         rw[mul_assoc b₀, mul_comm d₁ d₀, mul_comm (c₀ * d₁)], },
  repeat { rw[mul_assoc] },
end

lemma mul_one' (x : prat_f) (n : pnat): fraceq.rel x (x * (one' n)) :=
begin
  cases x with a b,
  change a * (b * n) = (a * n) * b,
  rw[mul_comm b n, mul_assoc],
end

end prat_f

def prat_r := quotient prat_f.fraceq

namespace prat_r

local attribute [instance] prat_f.fraceq

instance : ordered_comm_monoid prat_r := {
  one := quotient.mk' 1,
  mul := quotient.map₂ (*) (λ x₀ x₁ hx y₀ y₁ hy, prat_f.mul_lift hx hy),
  one_mul := λ x, begin rcases x, change quot.mk setoid.r (1 * x) = _, rw[one_mul] end,
  mul_one := λ x, begin rcases x, change quot.mk setoid.r (x * 1) = _, rw[mul_one] end,
  mul_comm := λ x y, begin
    rcases x, rcases y,
    change quot.mk setoid.r (x * y) = quot.mk setoid.r (y * x),
    rw[mul_comm x y]
  end,
  mul_assoc := λ x y z, begin
    rcases x, rcases y, rcases z,
    change quot.mk setoid.r ((x * y) * z) = quot.mk setoid.r (x * (y * z)),
    rw[mul_assoc]
  end,
  le := quotient.lift₂ (≤) (λ x₀ y₀ x₁ y₁ hx hy, (begin
    rw[← iff_eq_eq], exact prat_f.le_lift hx hy
    end)),
  le_refl := by { rintro ⟨x⟩, exact le_refl x },
  le_trans := by { rintro ⟨x⟩ ⟨y⟩ ⟨z⟩ (hxy : x ≤ y) (hyz : y ≤ z), exact le_trans hxy hyz },
  le_antisymm := begin
    rintro ⟨⟨a,b⟩⟩ ⟨⟨c,d⟩⟩ (hxy : a * d ≤ c * b) (hyx : c * b ≤ a * d),
    have h : prat_f.fraceq.rel ⟨a,b⟩ ⟨c,d⟩ := le_antisymm hxy hyx,
    exact quot.sound h
  end,
  mul_le_mul_left := begin
    rintro ⟨x⟩ ⟨y⟩ (hxy : x ≤ y) ⟨z⟩,
    exact (prat_f.mul_le_mul_iff_left z).mpr hxy
  end
}

instance : add_comm_semigroup prat_r := {
  add := quotient.map₂ (+) (λ x₀ x₁ hx y₀ y₁ hy, prat_f.add_lift hx hy),
  add_comm := λ x y, begin
    rcases x, rcases y,
    change quot.mk setoid.r (x + y) = quot.mk setoid.r (y + x),
    rw[add_comm x y]
  end,
  add_assoc := λ x y z, begin
    rcases x, rcases y, rcases z,
    change quot.mk setoid.r ((x + y) + z) = quot.mk setoid.r (x + (y + z)),
    rw[add_assoc]
  end
}

instance : add_left_cancel_semigroup prat_r := {
  add_left_cancel := begin
    rintro ⟨x⟩ ⟨y⟩ ⟨z⟩ h,
    change quot.mk setoid.r (x + y) = quot.mk setoid.r (x + z) at h,
    replace h := quotient.exact h, apply quot.sound,
    rcases x with ⟨a,b⟩, rcases y with ⟨c,d⟩, rcases z with ⟨e,f⟩,
    change c * f = e * d,
    change (a * d + b * c)  * (b * f) = (a * f + b * e) * (b * d) at h,
    rw[mul_comm b f, mul_comm b d, ← mul_assoc, ← mul_assoc] at h,
    replace h := mul_right_cancel h,
    rw[add_mul, add_mul, mul_assoc a f d, mul_comm f d, ← mul_assoc a d f] at h,
    replace h := _root_.add_left_cancel h,
    rw[mul_assoc, mul_assoc] at h,
    exact mul_left_cancel h
  end,
  .. (by apply_instance : add_comm_semigroup prat_r)
}

lemma mul_add (x y z : prat_r) : x * (y + z) = (x * y) + (x * z) :=
begin
  rcases x, rcases y, rcases z,
  change quot.mk setoid.r (x * (y + z)) = quot.mk setoid.r ((x * y) + (x * z)),
  rw[← prat_f.mul_add],
  apply quot.sound,
  change prat_f.fraceq.rel _ _,
  apply prat_f.mul_one'
end

lemma add_mul (x y z : prat_r) : (x + y) * z = (x * z) + (y * z) :=
  by { rw[mul_comm (x + y), mul_comm x, mul_comm y, mul_add] }

instance : linear_order prat_r := {
  le_total := begin
    rintro ⟨⟨a,b⟩⟩ ⟨⟨c,d⟩⟩,
    change a * d ≤ c * b ∨ c * b ≤ a * d,
    apply le_total
  end,
  decidable_le := λ x y, begin
    apply quotient.rec_on_subsingleton₂ x y,
    { intros u v, change decidable (u ≤ v), apply_instance },
    { intros u v, change subsingleton (decidable (u ≤ v)), apply_instance }
  end,
  .. (by { apply_instance } : ordered_comm_monoid prat_r)
}

lemma lt_add_right (x y : prat_r) : x < x + y :=
begin
 apply lt_of_not_ge, intro h,
 rcases x with ⟨x⟩, rcases y with ⟨y⟩, change x + y ≤ x at h,
 rcases x with ⟨a,b⟩, rcases y with ⟨c,d⟩,
 change (a * d + b * c) * b ≤ a * (b * d) at h,
 rw[_root_.add_mul, mul_assoc a d b, mul_comm d b] at h,
 exact (not_le_of_gt (pnat.lt_add_right (a * (b * d)) (b * c * b))) h,
end

end prat_r

def rat_r := spread prat_r

#check spread.comm_ring₀ prat_r
 (λ x y, ne_of_gt (prat_r.lt_add_right x y))
 (λ x y z h, add_left_cancel h)


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

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_37
  (x y : ℝ)
  (h₀ : x + y = 7)
  (h₁ : 3 * x + y = 45) :
  x^2 - y^2 = 217 :=
begin
  nlinarith,
end


import game.sup_inf.level01
import game.sup_inf.level02
import data.real.basic
import game.limits.Blockus_Time
import game.Completeness.Bruh2
import game.Completeness.level09
import tactic

namespace xena -- hide

/-
# Chapter 7 : Limits

## Level 16

Suppose that a sequence (a) is monotonically increasing. That is, ∀ (n : ℕ), a n ≤ a (n + 1).
Assume that the sequence is bounded above as well. That is, there exists a number x such that a n ≤ x for all n ∈ ℕ.
Prove that the sequence converges.
-/

/-
Here, we need to use the axiom of choice,
which says that given any collection of bins,
each containing at least one object,
it is possible to construct a set by arbitrarily
choosing one object from each bin, even if the collection is infinite.

-/

theorem mono_incr_seq_sup {a : ℕ → ℝ} {S : set.range a} {x : ℝ} (ha : ∀ (n : ℕ), a n ≤ a (n + 1)) (h2 : is_lub (set.range a) x) : is_limit a x :=
begin
rw is_limit,
intro ε, intro hε,

unfold_coes at S,
simp at S,
cases S with d hd,
cases hd with n₀ hn,

have Q := generate_element h2 (ε),
specialize Q hε,
unfold is_upper_bound at Q,
push_neg at Q,
cases Q with v hv,
cases hv with t ht,
unfold set.range at t,
cases t with N hN,
use N,
intro n,
intro j,
have U : a N ≤ x,
unfold is_lub at h2,
cases h2 with e he,
rw is_upper_bound at e,
specialize e (a N),

have Q : a N ∈ set.range a, by simp,
specialize e Q, exact e,

have R : a N < x + ε,
linarith,
rw ← hN at ht,

have J : x - ε < a N ∧ a N < x + ε,
split,
exact ht, exact R,
have I : |a n - x| = |x - a n|,
rw abs_eq_abs_neg,
simp,
have B : a N ≤ a n, exact thing4 ha j,
have duh1 : 0 ≤ x - a N, linarith,
have duh3 : -a n ≤ - a N, linarith,
have duh4 : x - a n ≤ x - a N, linarith,
have duh5 : |x - a n| = x - a n,
unfold abs,
simp,
unfold is_lub at h2,
cases h2 with batman robin,
unfold is_upper_bound at batman,
apply batman,
simp,
have V : |x - a n| ≤ x - a N, linarith,
rw I, rw duh5, linarith, simp,

end

end xena -- hide


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

! This file was ported from Lean 3 source module data.set.pointwise.basic
! leanprover-community/mathlib commit 517cc149e0b515d2893baa376226ed10feb319c7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupPower.Basic
import Mathlib.Algebra.Hom.Equiv.Basic
import Mathlib.Algebra.Hom.Units
import Mathlib.Data.Set.Lattice
import Mathlib.Data.Nat.Order.Basic
import Mathlib.Tactic.ScopedNS

/-!
# Pointwise operations of sets

This file defines pointwise algebraic operations on sets.

## Main declarations

For sets `s` and `t` and scalar `a`:
* `s * t`: Multiplication, set of all `x * y` where `x ∈ s` and `y ∈ t`.
* `s + t`: Addition, set of all `x + y` where `x ∈ s` and `y ∈ t`.
* `s⁻¹`: Inversion, set of all `x⁻¹` where `x ∈ s`.
* `-s`: Negation, set of all `-x` where `x ∈ s`.
* `s / t`: Division, set of all `x / y` where `x ∈ s` and `y ∈ t`.
* `s - t`: Subtraction, set of all `x - y` where `x ∈ s` and `y ∈ t`.

For `α` a semigroup/monoid, `Set α` is a semigroup/monoid.
As an unfortunate side effect, this means that `n • s`, where `n : ℕ`, is ambiguous between
pointwise scaling and repeated pointwise addition; the former has `(2 : ℕ) • {1, 2} = {2, 4}`, while
the latter has `(2 : ℕ) • {1, 2} = {2, 3, 4}`. See note [pointwise nat action].

Appropriate definitions and results are also transported to the additive theory via `to_additive`.

## Implementation notes

* The following expressions are considered in simp-normal form in a group:
  `(λ h, h * g) ⁻¹' s`, `(λ h, g * h) ⁻¹' s`, `(λ h, h * g⁻¹) ⁻¹' s`, `(λ h, g⁻¹ * h) ⁻¹' s`,
  `s * t`, `s⁻¹`, `(1 : Set _)` (and similarly for additive variants).
  Expressions equal to one of these will be simplified.
* We put all instances in the locale `Pointwise`, so that these instances are not available by
  default. Note that we do not mark them as reducible (as argued by note [reducible non-instances])
  since we expect the locale to be open whenever the instances are actually used (and making the
  instances reducible changes the behavior of `simp`.

## Tags

set multiplication, set addition, pointwise addition, pointwise multiplication,
pointwise subtraction
-/

library_note "pointwise nat action"/--
Pointwise monoids (`Set`, `Finset`, `Filter`) have derived pointwise actions of the form
`SMul α β → SMul α (Set β)`. When `α` is `ℕ` or `ℤ`, this action conflicts with the
nat or int action coming from `Set β` being a `Monoid` or `DivInvMonoid`. For example,
`2 • {a, b}` can both be `{2 • a, 2 • b}` (pointwise action, pointwise repeated addition,
`Set.smulSet`) and `{a + a, a + b, b + a, b + b}` (nat or int action, repeated pointwise
addition, `Set.NSMul`).

Because the pointwise action can easily be spelled out in such cases, we give higher priority to the
nat and int actions.
-/

open Function

variable {F α β γ : Type _}

namespace Set

/-! ### `0`/`1` as sets -/

section One

variable [One α] {s : Set α} {a : α}

/-- The set `1 : Set α` is defined as `{1}` in locale `Pointwise`. -/
@[to_additive "The set `0 : Set α` is defined as `{0}` in locale `Pointwise`."]
protected noncomputable def one : One (Set α) :=
  ⟨{1}⟩
#align set.has_one Set.one
#align set.has_zero Set.zero

scoped[Pointwise] attribute [instance] Set.one Set.zero

open Pointwise

@[to_additive]
theorem singleton_one : ({1} : Set α) = 1 :=
  rfl
#align set.singleton_one Set.singleton_one
#align set.singleton_zero Set.singleton_zero

@[to_additive (attr := simp)]
theorem mem_one : a ∈ (1 : Set α) ↔ a = 1 :=
  Iff.rfl
#align set.mem_one Set.mem_one
#align set.mem_zero Set.mem_zero

@[to_additive]
theorem one_mem_one : (1 : α) ∈ (1 : Set α) :=
  Eq.refl _
#align set.one_mem_one Set.one_mem_one
#align set.zero_mem_zero Set.zero_mem_zero

@[to_additive (attr := simp)]
theorem one_subset : 1 ⊆ s ↔ (1 : α) ∈ s :=
  singleton_subset_iff
#align set.one_subset Set.one_subset
#align set.zero_subset Set.zero_subset

@[to_additive]
theorem one_nonempty : (1 : Set α).Nonempty :=
  ⟨1, rfl⟩
#align set.one_nonempty Set.one_nonempty
#align set.zero_nonempty Set.zero_nonempty

@[to_additive (attr := simp)]
theorem image_one {f : α → β} : f '' 1 = {f 1} :=
  image_singleton
#align set.image_one Set.image_one
#align set.image_zero Set.image_zero

@[to_additive]
theorem subset_one_iff_eq : s ⊆ 1 ↔ s = ∅ ∨ s = 1 :=
  subset_singleton_iff_eq
#align set.subset_one_iff_eq Set.subset_one_iff_eq
#align set.subset_zero_iff_eq Set.subset_zero_iff_eq

@[to_additive]
theorem Nonempty.subset_one_iff (h : s.Nonempty) : s ⊆ 1 ↔ s = 1 :=
  h.subset_singleton_iff
#align set.nonempty.subset_one_iff Set.Nonempty.subset_one_iff
#align set.nonempty.subset_zero_iff Set.Nonempty.subset_zero_iff

/-- The singleton operation as a `OneHom`. -/
@[to_additive "The singleton operation as a `ZeroHom`."]
noncomputable def singletonOneHom : OneHom α (Set α) :=
  ⟨singleton, singleton_one⟩
#align set.singleton_one_hom Set.singletonOneHom
#align set.singleton_zero_hom Set.singletonZeroHom

@[to_additive (attr := simp)]
theorem coe_singletonOneHom : (singletonOneHom : α → Set α) = singleton :=
  rfl
#align set.coe_singleton_one_hom Set.coe_singletonOneHom
#align set.coe_singleton_zero_hom Set.coe_singletonZeroHom

end One

/-! ### Set negation/inversion -/

section Inv

/-- The pointwise inversion of set `s⁻¹` is defined as `{x | x⁻¹ ∈ s}` in locale `Pointwise`. It is
equal to `{x⁻¹ | x ∈ s}`, see `Set.image_inv`. -/
@[to_additive
      "The pointwise negation of set `-s` is defined as `{x | -x ∈ s}` in locale `Pointwise`.
      It is equal to `{-x | x ∈ s}`, see `Set.image_neg`."]
protected def inv [Inv α] : Inv (Set α) :=
  ⟨preimage Inv.inv⟩
#align set.has_inv Set.inv
#align set.has_neg Set.neg

scoped[Pointwise] attribute [instance] Set.inv Set.neg

open Pointwise

section Inv

variable {ι : Sort _} [Inv α] {s t : Set α} {a : α}

@[to_additive (attr := simp)]
theorem mem_inv : a ∈ s⁻¹ ↔ a⁻¹ ∈ s :=
  Iff.rfl
#align set.mem_inv Set.mem_inv
#align set.mem_neg Set.mem_neg

@[to_additive (attr := simp)]
theorem inv_preimage : Inv.inv ⁻¹' s = s⁻¹ :=
  rfl
#align set.inv_preimage Set.inv_preimage
#align set.neg_preimage Set.neg_preimage

@[to_additive (attr := simp)]
theorem inv_empty : (∅ : Set α)⁻¹ = ∅ :=
  rfl
#align set.inv_empty Set.inv_empty
#align set.neg_empty Set.neg_empty

@[to_additive (attr := simp)]
theorem inv_univ : (univ : Set α)⁻¹ = univ :=
  rfl
#align set.inv_univ Set.inv_univ
#align set.neg_univ Set.neg_univ

@[to_additive (attr := simp)]
theorem inter_inv : (s ∩ t)⁻¹ = s⁻¹ ∩ t⁻¹ :=
  preimage_inter
#align set.inter_inv Set.inter_inv
#align set.inter_neg Set.inter_neg

@[to_additive (attr := simp)]
theorem union_inv : (s ∪ t)⁻¹ = s⁻¹ ∪ t⁻¹ :=
  preimage_union
#align set.union_inv Set.union_inv
#align set.union_neg Set.union_neg

@[to_additive (attr := simp)]
theorem interᵢ_inv (s : ι → Set α) : (⋂ i, s i)⁻¹ = ⋂ i, (s i)⁻¹ :=
  preimage_interᵢ
#align set.Inter_inv Set.interᵢ_inv
#align set.Inter_neg Set.interᵢ_neg

@[to_additive (attr := simp)]
theorem unionᵢ_inv (s : ι → Set α) : (⋃ i, s i)⁻¹ = ⋃ i, (s i)⁻¹ :=
  preimage_unionᵢ
#align set.Union_inv Set.unionᵢ_inv
#align set.Union_neg Set.unionᵢ_neg

@[to_additive (attr := simp)]
theorem compl_inv : (sᶜ)⁻¹ = s⁻¹ᶜ :=
  preimage_compl
#align set.compl_inv Set.compl_inv
#align set.compl_neg Set.compl_neg

end Inv

section InvolutiveInv

variable [InvolutiveInv α] {s t : Set α} {a : α}

@[to_additive]
theorem inv_mem_inv : a⁻¹ ∈ s⁻¹ ↔ a ∈ s := by simp only [mem_inv, inv_inv]
#align set.inv_mem_inv Set.inv_mem_inv
#align set.neg_mem_neg Set.neg_mem_neg

@[to_additive (attr := simp)]
theorem nonempty_inv : s⁻¹.Nonempty ↔ s.Nonempty :=
  inv_involutive.surjective.nonempty_preimage
#align set.nonempty_inv Set.nonempty_inv
#align set.nonempty_neg Set.nonempty_neg

@[to_additive]
theorem Nonempty.inv (h : s.Nonempty) : s⁻¹.Nonempty :=
  nonempty_inv.2 h
#align set.nonempty.inv Set.Nonempty.inv
#align set.nonempty.neg Set.Nonempty.neg

@[to_additive (attr := simp)]
theorem image_inv : Inv.inv '' s = s⁻¹ :=
  congr_fun (image_eq_preimage_of_inverse inv_involutive.leftInverse inv_involutive.rightInverse) _
#align set.image_inv Set.image_inv
#align set.image_neg Set.image_neg

@[to_additive (attr := simp)]
noncomputable instance involutiveInv : InvolutiveInv (Set α) where
  inv := Inv.inv
  inv_inv s := by simp only [← inv_preimage, preimage_preimage, inv_inv, preimage_id']

@[to_additive (attr := simp)]
theorem inv_subset_inv : s⁻¹ ⊆ t⁻¹ ↔ s ⊆ t :=
  (Equiv.inv α).surjective.preimage_subset_preimage_iff
#align set.inv_subset_inv Set.inv_subset_inv
#align set.neg_subset_neg Set.neg_subset_neg

@[to_additive]
theorem inv_subset : s⁻¹ ⊆ t ↔ s ⊆ t⁻¹ := by rw [← inv_subset_inv, inv_inv]
#align set.inv_subset Set.inv_subset
#align set.neg_subset Set.neg_subset

@[to_additive (attr := simp)]
theorem inv_singleton (a : α) : ({a} : Set α)⁻¹ = {a⁻¹} := by rw [← image_inv, image_singleton]
#align set.inv_singleton Set.inv_singleton
#align set.neg_singleton Set.neg_singleton

@[to_additive (attr := simp)]
theorem inv_insert (a : α) (s : Set α) : (insert a s)⁻¹ = insert a⁻¹ s⁻¹ := by
  rw [insert_eq, union_inv, inv_singleton, insert_eq]
#align set.inv_insert Set.inv_insert
#align set.neg_insert Set.neg_insert

@[to_additive]
theorem inv_range {ι : Sort _} {f : ι → α} : (range f)⁻¹ = range fun i => (f i)⁻¹ := by
  rw [← image_inv]
  exact (range_comp _ _).symm
#align set.inv_range Set.inv_range
#align set.neg_range Set.neg_range

open MulOpposite

@[to_additive]
theorem image_op_inv : op '' s⁻¹ = (op '' s)⁻¹ := by
  simp_rw [← image_inv, Function.Semiconj.set_image op_inv s]
#align set.image_op_inv Set.image_op_inv
#align set.image_op_neg Set.image_op_neg

end InvolutiveInv

end Inv

open Pointwise

/-! ### Set addition/multiplication -/

section Mul

variable {ι : Sort _} {κ : ι → Sort _} [Mul α] {s s₁ s₂ t t₁ t₂ u : Set α} {a b : α}

/-- The pointwise multiplication of sets `s * t` and `t` is defined as `{x * y | x ∈ s, y ∈ t}` in
locale `Pointwise`. -/
@[to_additive
      "The pointwise addition of sets `s + t` is defined as `{x + y | x ∈ s, y ∈ t}` in locale
      `Pointwise`."]
protected def mul : Mul (Set α) :=
  ⟨image2 (· * ·)⟩
#align set.has_mul Set.mul
#align set.has_add Set.add

scoped[Pointwise] attribute [instance] Set.mul Set.add

@[to_additive (attr := simp)]
theorem image2_mul : image2 (· * ·) s t = s * t :=
  rfl
#align set.image2_mul Set.image2_mul
#align set.image2_add Set.image2_add

@[to_additive]
theorem mem_mul : a ∈ s * t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x * y = a :=
  Iff.rfl
#align set.mem_mul Set.mem_mul
#align set.mem_add Set.mem_add

@[to_additive]
theorem mul_mem_mul : a ∈ s → b ∈ t → a * b ∈ s * t :=
  mem_image2_of_mem
#align set.mul_mem_mul Set.mul_mem_mul
#align set.add_mem_add Set.add_mem_add

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[to_additive add_image_prod]
theorem image_mul_prod : (fun x : α × α => x.fst * x.snd) '' s ×ˢ t = s * t :=
  image_prod _
#align set.image_mul_prod Set.image_mul_prod
#align set.add_image_prod Set.add_image_prod

@[to_additive (attr := simp)]
theorem empty_mul : ∅ * s = ∅ :=
  image2_empty_left
#align set.empty_mul Set.empty_mul
#align set.empty_add Set.empty_add

@[to_additive (attr := simp)]
theorem mul_empty : s * ∅ = ∅ :=
  image2_empty_right
#align set.mul_empty Set.mul_empty
#align set.add_empty Set.add_empty

@[to_additive (attr := simp)]
theorem mul_eq_empty : s * t = ∅ ↔ s = ∅ ∨ t = ∅ :=
  image2_eq_empty_iff
#align set.mul_eq_empty Set.mul_eq_empty
#align set.add_eq_empty Set.add_eq_empty

@[to_additive (attr := simp)]
theorem mul_nonempty : (s * t).Nonempty ↔ s.Nonempty ∧ t.Nonempty :=
  image2_nonempty_iff
#align set.mul_nonempty Set.mul_nonempty
#align set.add_nonempty Set.add_nonempty

@[to_additive]
theorem Nonempty.mul : s.Nonempty → t.Nonempty → (s * t).Nonempty :=
  Nonempty.image2
#align set.nonempty.mul Set.Nonempty.mul
#align set.nonempty.add Set.Nonempty.add

@[to_additive]
theorem Nonempty.of_mul_left : (s * t).Nonempty → s.Nonempty :=
  Nonempty.of_image2_left
#align set.nonempty.of_mul_left Set.Nonempty.of_mul_left
#align set.nonempty.of_add_left Set.Nonempty.of_add_left

@[to_additive]
theorem Nonempty.of_mul_right : (s * t).Nonempty → t.Nonempty :=
  Nonempty.of_image2_right
#align set.nonempty.of_mul_right Set.Nonempty.of_mul_right
#align set.nonempty.of_add_right Set.Nonempty.of_add_right

@[to_additive (attr := simp)]
theorem mul_singleton : s * {b} = (· * b) '' s :=
  image2_singleton_right
#align set.mul_singleton Set.mul_singleton
#align set.add_singleton Set.add_singleton

@[to_additive (attr := simp)]
theorem singleton_mul : {a} * t = (· * ·) a '' t :=
  image2_singleton_left
#align set.singleton_mul Set.singleton_mul
#align set.singleton_add Set.singleton_add

-- Porting note: simp can prove this
@[to_additive]
theorem singleton_mul_singleton : ({a} : Set α) * {b} = {a * b} :=
  image2_singleton
#align set.singleton_mul_singleton Set.singleton_mul_singleton
#align set.singleton_add_singleton Set.singleton_add_singleton

@[to_additive (attr := mono)]
theorem mul_subset_mul : s₁ ⊆ t₁ → s₂ ⊆ t₂ → s₁ * s₂ ⊆ t₁ * t₂ :=
  image2_subset
#align set.mul_subset_mul Set.mul_subset_mul
#align set.add_subset_add Set.add_subset_add

@[to_additive]
theorem mul_subset_mul_left : t₁ ⊆ t₂ → s * t₁ ⊆ s * t₂ :=
  image2_subset_left
#align set.mul_subset_mul_left Set.mul_subset_mul_left
#align set.add_subset_add_left Set.add_subset_add_left

@[to_additive]
theorem mul_subset_mul_right : s₁ ⊆ s₂ → s₁ * t ⊆ s₂ * t :=
  image2_subset_right
#align set.mul_subset_mul_right Set.mul_subset_mul_right
#align set.add_subset_add_right Set.add_subset_add_right

@[to_additive]
theorem mul_subset_iff : s * t ⊆ u ↔ ∀ x ∈ s, ∀ y ∈ t, x * y ∈ u :=
  image2_subset_iff
#align set.mul_subset_iff Set.mul_subset_iff
#align set.add_subset_iff Set.add_subset_iff

@[to_additive]
theorem union_mul : (s₁ ∪ s₂) * t = s₁ * t ∪ s₂ * t :=
  image2_union_left
#align set.union_mul Set.union_mul
#align set.union_add Set.union_add

@[to_additive]
theorem mul_union : s * (t₁ ∪ t₂) = s * t₁ ∪ s * t₂ :=
  image2_union_right
#align set.mul_union Set.mul_union
#align set.add_union Set.add_union

@[to_additive]
theorem inter_mul_subset : s₁ ∩ s₂ * t ⊆ s₁ * t ∩ (s₂ * t) :=
  image2_inter_subset_left
#align set.inter_mul_subset Set.inter_mul_subset
#align set.inter_add_subset Set.inter_add_subset

@[to_additive]
theorem mul_inter_subset : s * (t₁ ∩ t₂) ⊆ s * t₁ ∩ (s * t₂) :=
  image2_inter_subset_right
#align set.mul_inter_subset Set.mul_inter_subset
#align set.add_inter_subset Set.add_inter_subset

@[to_additive]
theorem unionᵢ_mul_left_image : (⋃ a ∈ s, (· * ·) a '' t) = s * t :=
  unionᵢ_image_left _
#align set.Union_mul_left_image Set.unionᵢ_mul_left_image
#align set.Union_add_left_image Set.unionᵢ_add_left_image

@[to_additive]
theorem unionᵢ_mul_right_image : (⋃ a ∈ t, (· * a) '' s) = s * t :=
  unionᵢ_image_right _
#align set.Union_mul_right_image Set.unionᵢ_mul_right_image
#align set.Union_add_right_image Set.unionᵢ_add_right_image

@[to_additive]
theorem unionᵢ_mul (s : ι → Set α) (t : Set α) : (⋃ i, s i) * t = ⋃ i, s i * t :=
  image2_unionᵢ_left _ _ _
#align set.Union_mul Set.unionᵢ_mul
#align set.Union_add Set.unionᵢ_add

@[to_additive]
theorem mul_unionᵢ (s : Set α) (t : ι → Set α) : (s * ⋃ i, t i) = ⋃ i, s * t i :=
  image2_unionᵢ_right _ _ _
#align set.mul_Union Set.mul_unionᵢ
#align set.add_Union Set.add_unionᵢ

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
@[to_additive]
theorem unionᵢ₂_mul (s : ∀ i, κ i → Set α) (t : Set α) :
    (⋃ (i) (j), s i j) * t = ⋃ (i) (j), s i j * t :=
  image2_unionᵢ₂_left _ _ _
#align set.Union₂_mul Set.unionᵢ₂_mul
#align set.Union₂_add Set.unionᵢ₂_add

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
@[to_additive]
theorem mul_unionᵢ₂ (s : Set α) (t : ∀ i, κ i → Set α) :
    (s * ⋃ (i) (j), t i j) = ⋃ (i) (j), s * t i j :=
  image2_unionᵢ₂_right _ _ _
#align set.mul_Union₂ Set.mul_unionᵢ₂
#align set.add_Union₂ Set.add_unionᵢ₂

@[to_additive]
theorem interᵢ_mul_subset (s : ι → Set α) (t : Set α) : (⋂ i, s i) * t ⊆ ⋂ i, s i * t :=
  image2_interᵢ_subset_left _ _ _
#align set.Inter_mul_subset Set.interᵢ_mul_subset
#align set.Inter_add_subset Set.interᵢ_add_subset

@[to_additive]
theorem mul_interᵢ_subset (s : Set α) (t : ι → Set α) : (s * ⋂ i, t i) ⊆ ⋂ i, s * t i :=
  image2_interᵢ_subset_right _ _ _
#align set.mul_Inter_subset Set.mul_interᵢ_subset
#align set.add_Inter_subset Set.add_interᵢ_subset

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
@[to_additive]
theorem interᵢ₂_mul_subset (s : ∀ i, κ i → Set α) (t : Set α) :
    (⋂ (i) (j), s i j) * t ⊆ ⋂ (i) (j), s i j * t :=
  image2_interᵢ₂_subset_left _ _ _
#align set.Inter₂_mul_subset Set.interᵢ₂_mul_subset
#align set.Inter₂_add_subset Set.interᵢ₂_add_subset

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
@[to_additive]
theorem mul_interᵢ₂_subset (s : Set α) (t : ∀ i, κ i → Set α) :
    (s * ⋂ (i) (j), t i j) ⊆ ⋂ (i) (j), s * t i j :=
  image2_interᵢ₂_subset_right _ _ _
#align set.mul_Inter₂_subset Set.mul_interᵢ₂_subset
#align set.add_Inter₂_subset Set.add_interᵢ₂_subset

/-- The singleton operation as a `MulHom`. -/
@[to_additive "The singleton operation as an `AddHom`."]
noncomputable def singletonMulHom : α →ₙ* Set α :=
  ⟨singleton, fun _ _ => singleton_mul_singleton.symm⟩
#align set.singleton_mul_hom Set.singletonMulHom
#align set.singleton_add_hom Set.singletonAddHom

@[to_additive (attr := simp)]
theorem coe_singletonMulHom : (singletonMulHom : α → Set α) = singleton :=
  rfl
#align set.coe_singleton_mul_hom Set.coe_singletonMulHom
#align set.coe_singleton_add_hom Set.coe_singletonAddHom

@[to_additive (attr := simp)]
theorem singletonMulHom_apply (a : α) : singletonMulHom a = {a} :=
  rfl
#align set.singleton_mul_hom_apply Set.singletonMulHom_apply
#align set.singleton_add_hom_apply Set.singletonAddHom_apply

open MulOpposite

@[to_additive (attr := simp)]
theorem image_op_mul : op '' (s * t) = op '' t * op '' s :=
  image_image2_antidistrib op_mul
#align set.image_op_mul Set.image_op_mul
#align set.image_op_add Set.image_op_add

end Mul

/-! ### Set subtraction/division -/

section Div

variable {ι : Sort _} {κ : ι → Sort _} [Div α] {s s₁ s₂ t t₁ t₂ u : Set α} {a b : α}

/-- The pointwise division of sets `s / t` is defined as `{x / y | x ∈ s, y ∈ t}` in locale
`Pointwise`. -/
@[to_additive
      "The pointwise subtraction of sets `s - t` is defined as `{x - y | x ∈ s, y ∈ t}` in locale
      `Pointwise`."]
protected def div : Div (Set α) :=
  ⟨image2 (· / ·)⟩
#align set.has_div Set.div
#align set.has_sub Set.sub

scoped[Pointwise] attribute [instance] Set.div Set.sub

@[to_additive (attr := simp)]
theorem image2_div : image2 Div.div s t = s / t :=
  rfl
#align set.image2_div Set.image2_div
#align set.image2_sub Set.image2_sub

@[to_additive]
theorem mem_div : a ∈ s / t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x / y = a :=
  Iff.rfl
#align set.mem_div Set.mem_div
#align set.mem_sub Set.mem_sub

@[to_additive]
theorem div_mem_div : a ∈ s → b ∈ t → a / b ∈ s / t :=
  mem_image2_of_mem
#align set.div_mem_div Set.div_mem_div
#align set.sub_mem_sub Set.sub_mem_sub

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[to_additive sub_image_prod]
theorem image_div_prod : (fun x : α × α => x.fst / x.snd) '' s ×ˢ t = s / t :=
  image_prod _
#align set.image_div_prod Set.image_div_prod
#align set.sub_image_prod Set.sub_image_prod

@[to_additive (attr := simp)]
theorem empty_div : ∅ / s = ∅ :=
  image2_empty_left
#align set.empty_div Set.empty_div
#align set.empty_sub Set.empty_sub

@[to_additive (attr := simp)]
theorem div_empty : s / ∅ = ∅ :=
  image2_empty_right
#align set.div_empty Set.div_empty
#align set.sub_empty Set.sub_empty

@[to_additive (attr := simp)]
theorem div_eq_empty : s / t = ∅ ↔ s = ∅ ∨ t = ∅ :=
  image2_eq_empty_iff
#align set.div_eq_empty Set.div_eq_empty
#align set.sub_eq_empty Set.sub_eq_empty

@[to_additive (attr := simp)]
theorem div_nonempty : (s / t).Nonempty ↔ s.Nonempty ∧ t.Nonempty :=
  image2_nonempty_iff
#align set.div_nonempty Set.div_nonempty
#align set.sub_nonempty Set.sub_nonempty

@[to_additive]
theorem Nonempty.div : s.Nonempty → t.Nonempty → (s / t).Nonempty :=
  Nonempty.image2
#align set.nonempty.div Set.Nonempty.div
#align set.nonempty.sub Set.Nonempty.sub

@[to_additive]
theorem Nonempty.of_div_left : (s / t).Nonempty → s.Nonempty :=
  Nonempty.of_image2_left
#align set.nonempty.of_div_left Set.Nonempty.of_div_left
#align set.nonempty.of_sub_left Set.Nonempty.of_sub_left

@[to_additive]
theorem Nonempty.of_div_right : (s / t).Nonempty → t.Nonempty :=
  Nonempty.of_image2_right
#align set.nonempty.of_div_right Set.Nonempty.of_div_right
#align set.nonempty.of_sub_right Set.Nonempty.of_sub_right

@[to_additive (attr := simp)]
theorem div_singleton : s / {b} = (· / b) '' s :=
  image2_singleton_right
#align set.div_singleton Set.div_singleton
#align set.sub_singleton Set.sub_singleton

@[to_additive (attr := simp)]
theorem singleton_div : {a} / t = (· / ·) a '' t :=
  image2_singleton_left
#align set.singleton_div Set.singleton_div
#align set.singleton_sub Set.singleton_sub

-- Porting note: simp can prove this
@[to_additive]
theorem singleton_div_singleton : ({a} : Set α) / {b} = {a / b} :=
  image2_singleton
#align set.singleton_div_singleton Set.singleton_div_singleton
#align set.singleton_sub_singleton Set.singleton_sub_singleton

@[to_additive (attr := mono)]
theorem div_subset_div : s₁ ⊆ t₁ → s₂ ⊆ t₂ → s₁ / s₂ ⊆ t₁ / t₂ :=
  image2_subset
#align set.div_subset_div Set.div_subset_div
#align set.sub_subset_sub Set.sub_subset_sub

@[to_additive]
theorem div_subset_div_left : t₁ ⊆ t₂ → s / t₁ ⊆ s / t₂ :=
  image2_subset_left
#align set.div_subset_div_left Set.div_subset_div_left
#align set.sub_subset_sub_left Set.sub_subset_sub_left

@[to_additive]
theorem div_subset_div_right : s₁ ⊆ s₂ → s₁ / t ⊆ s₂ / t :=
  image2_subset_right
#align set.div_subset_div_right Set.div_subset_div_right
#align set.sub_subset_sub_right Set.sub_subset_sub_right

@[to_additive]
theorem div_subset_iff : s / t ⊆ u ↔ ∀ x ∈ s, ∀ y ∈ t, x / y ∈ u :=
  image2_subset_iff
#align set.div_subset_iff Set.div_subset_iff
#align set.sub_subset_iff Set.sub_subset_iff

@[to_additive]
theorem union_div : (s₁ ∪ s₂) / t = s₁ / t ∪ s₂ / t :=
  image2_union_left
#align set.union_div Set.union_div
#align set.union_sub Set.union_sub

@[to_additive]
theorem div_union : s / (t₁ ∪ t₂) = s / t₁ ∪ s / t₂ :=
  image2_union_right
#align set.div_union Set.div_union
#align set.sub_union Set.sub_union

@[to_additive]
theorem inter_div_subset : s₁ ∩ s₂ / t ⊆ s₁ / t ∩ (s₂ / t) :=
  image2_inter_subset_left
#align set.inter_div_subset Set.inter_div_subset
#align set.inter_sub_subset Set.inter_sub_subset

@[to_additive]
theorem div_inter_subset : s / (t₁ ∩ t₂) ⊆ s / t₁ ∩ (s / t₂) :=
  image2_inter_subset_right
#align set.div_inter_subset Set.div_inter_subset
#align set.sub_inter_subset Set.sub_inter_subset

@[to_additive]
theorem unionᵢ_div_left_image : (⋃ a ∈ s, (· / ·) a '' t) = s / t :=
  unionᵢ_image_left _
#align set.Union_div_left_image Set.unionᵢ_div_left_image
#align set.Union_sub_left_image Set.unionᵢ_sub_left_image

@[to_additive]
theorem unionᵢ_div_right_image : (⋃ a ∈ t, (· / a) '' s) = s / t :=
  unionᵢ_image_right _
#align set.Union_div_right_image Set.unionᵢ_div_right_image
#align set.Union_sub_right_image Set.unionᵢ_sub_right_image

@[to_additive]
theorem unionᵢ_div (s : ι → Set α) (t : Set α) : (⋃ i, s i) / t = ⋃ i, s i / t :=
  image2_unionᵢ_left _ _ _
#align set.Union_div Set.unionᵢ_div
#align set.Union_sub Set.unionᵢ_sub

@[to_additive]
theorem div_unionᵢ (s : Set α) (t : ι → Set α) : (s / ⋃ i, t i) = ⋃ i, s / t i :=
  image2_unionᵢ_right _ _ _
#align set.div_Union Set.div_unionᵢ
#align set.sub_Union Set.sub_unionᵢ

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
@[to_additive]
theorem unionᵢ₂_div (s : ∀ i, κ i → Set α) (t : Set α) :
    (⋃ (i) (j), s i j) / t = ⋃ (i) (j), s i j / t :=
  image2_unionᵢ₂_left _ _ _
#align set.Union₂_div Set.unionᵢ₂_div
#align set.Union₂_sub Set.unionᵢ₂_sub

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
@[to_additive]
theorem div_unionᵢ₂ (s : Set α) (t : ∀ i, κ i → Set α) :
    (s / ⋃ (i) (j), t i j) = ⋃ (i) (j), s / t i j :=
  image2_unionᵢ₂_right _ _ _
#align set.div_Union₂ Set.div_unionᵢ₂
#align set.sub_Union₂ Set.sub_unionᵢ₂

@[to_additive]
theorem interᵢ_div_subset (s : ι → Set α) (t : Set α) : (⋂ i, s i) / t ⊆ ⋂ i, s i / t :=
  image2_interᵢ_subset_left _ _ _
#align set.Inter_div_subset Set.interᵢ_div_subset
#align set.Inter_sub_subset Set.interᵢ_sub_subset

@[to_additive]
theorem div_interᵢ_subset (s : Set α) (t : ι → Set α) : (s / ⋂ i, t i) ⊆ ⋂ i, s / t i :=
  image2_interᵢ_subset_right _ _ _
#align set.div_Inter_subset Set.div_interᵢ_subset
#align set.sub_Inter_subset Set.sub_interᵢ_subset

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
@[to_additive]
theorem interᵢ₂_div_subset (s : ∀ i, κ i → Set α) (t : Set α) :
    (⋂ (i) (j), s i j) / t ⊆ ⋂ (i) (j), s i j / t :=
  image2_interᵢ₂_subset_left _ _ _
#align set.Inter₂_div_subset Set.interᵢ₂_div_subset
#align set.Inter₂_sub_subset Set.interᵢ₂_sub_subset

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
@[to_additive]
theorem div_interᵢ₂_subset (s : Set α) (t : ∀ i, κ i → Set α) :
    (s / ⋂ (i) (j), t i j) ⊆ ⋂ (i) (j), s / t i j :=
  image2_interᵢ₂_subset_right _ _ _
#align set.div_Inter₂_subset Set.div_interᵢ₂_subset
#align set.sub_Inter₂_subset Set.sub_interᵢ₂_subset

end Div

open Pointwise

/-- Repeated pointwise addition (not the same as pointwise repeated addition!) of a `Set`. See
note [pointwise nat action].-/
protected def NSMul [Zero α] [Add α] : SMul ℕ (Set α) :=
  ⟨nsmulRec⟩
#align set.has_nsmul Set.NSMul

/-- Repeated pointwise multiplication (not the same as pointwise repeated multiplication!) of a
`Set`. See note [pointwise nat action]. -/
@[to_additive existing]
protected def NPow [One α] [Mul α] : Pow (Set α) ℕ :=
  ⟨fun s n => npowRec n s⟩
#align set.has_npow Set.NPow

/-- Repeated pointwise addition/subtraction (not the same as pointwise repeated
addition/subtraction!) of a `Set`. See note [pointwise nat action]. -/
protected def ZSMul [Zero α] [Add α] [Neg α] : SMul ℤ (Set α) :=
  ⟨zsmulRec⟩
#align set.has_zsmul Set.ZSMul

/-- Repeated pointwise multiplication/division (not the same as pointwise repeated
multiplication/division!) of a `Set`. See note [pointwise nat action]. -/
@[to_additive existing]
protected def ZPow [One α] [Mul α] [Inv α] : Pow (Set α) ℤ :=
  ⟨fun s n => zpowRec n s⟩
#align set.has_zpow Set.ZPow

scoped[Pointwise] attribute [instance] Set.NSMul Set.NPow Set.ZSMul Set.ZPow

/-- `Set α` is a `Semigroup` under pointwise operations if `α` is. -/
@[to_additive "`Set α` is an `AddSemigroup` under pointwise operations if `α` is."]
protected noncomputable def semigroup [Semigroup α] : Semigroup (Set α) :=
  { Set.mul with mul_assoc := fun _ _ _ => image2_assoc mul_assoc }
#align set.semigroup Set.semigroup
#align set.add_semigroup Set.addSemigroup

section CommSemigroup

variable [CommSemigroup α] {s t : Set α}

/-- `Set α` is a `CommSemigroup` under pointwise operations if `α` is. -/
@[to_additive "`Set α` is an `AddCommSemigroup` under pointwise operations if `α` is."]
protected noncomputable def commSemigroup : CommSemigroup (Set α) :=
  { Set.semigroup with mul_comm := fun _ _ => image2_comm mul_comm }
#align set.comm_semigroup Set.commSemigroup
#align set.add_comm_semigroup Set.addCommSemigroup

@[to_additive]
theorem inter_mul_union_subset : s ∩ t * (s ∪ t) ⊆ s * t :=
  image2_inter_union_subset mul_comm
#align set.inter_mul_union_subset Set.inter_mul_union_subset
#align set.inter_add_union_subset Set.inter_add_union_subset

@[to_additive]
theorem union_mul_inter_subset : (s ∪ t) * (s ∩ t) ⊆ s * t :=
  image2_union_inter_subset mul_comm
#align set.union_mul_inter_subset Set.union_mul_inter_subset
#align set.union_add_inter_subset Set.union_add_inter_subset

end CommSemigroup

section MulOneClass

variable [MulOneClass α]

/-- `Set α` is a `MulOneClass` under pointwise operations if `α` is. -/
@[to_additive "`Set α` is an `AddZeroClass` under pointwise operations if `α` is."]
protected noncomputable def mulOneClass : MulOneClass (Set α) :=
  { Set.one, Set.mul with
    mul_one := fun s => by simp only [← singleton_one, mul_singleton, mul_one, image_id']
    one_mul := fun s => by simp only [← singleton_one, singleton_mul, one_mul, image_id'] }
#align set.mul_one_class Set.mulOneClass
#align set.add_zero_class Set.addZeroClass

scoped[Pointwise]
  attribute [instance]
    Set.mulOneClass Set.addZeroClass Set.semigroup Set.addSemigroup Set.commSemigroup
    Set.addCommSemigroup

@[to_additive]

@[to_additive]
theorem subset_mul_right {s : Set α} (t : Set α) (hs : (1 : α) ∈ s) : t ⊆ s * t := fun x hx =>
  ⟨1, x, hs, hx, one_mul _⟩
#align set.subset_mul_right Set.subset_mul_right
#align set.subset_add_right Set.subset_add_right

/-- The singleton operation as a `MonoidHom`. -/
@[to_additive "The singleton operation as an `AddMonoidHom`."]
noncomputable def singletonMonoidHom : α →* Set α :=
  { singletonMulHom, singletonOneHom with }
#align set.singleton_monoid_hom Set.singletonMonoidHom
#align set.singleton_add_monoid_hom Set.singletonAddMonoidHom

@[to_additive (attr := simp)]
theorem coe_singletonMonoidHom : (singletonMonoidHom : α → Set α) = singleton :=
  rfl
#align set.coe_singleton_monoid_hom Set.coe_singletonMonoidHom
#align set.coe_singleton_add_monoid_hom Set.coe_singletonAddMonoidHom

@[to_additive (attr := simp)]
theorem singletonMonoidHom_apply (a : α) : singletonMonoidHom a = {a} :=
  rfl
#align set.singleton_monoid_hom_apply Set.singletonMonoidHom_apply
#align set.singleton_add_monoid_hom_apply Set.singletonAddMonoidHom_apply

end MulOneClass

section Monoid

variable [Monoid α] {s t : Set α} {a : α} {m n : ℕ}

/-- `Set α` is a `Monoid` under pointwise operations if `α` is. -/
@[to_additive "`Set α` is an `AddMonoid` under pointwise operations if `α` is."]
protected noncomputable def monoid : Monoid (Set α) :=
  { Set.semigroup, Set.mulOneClass, @Set.NPow α _ _ with }
#align set.monoid Set.monoid
#align set.add_monoid Set.addMonoid

scoped[Pointwise] attribute [instance] Set.monoid Set.addMonoid

@[to_additive]
theorem pow_mem_pow (ha : a ∈ s) : ∀ n : ℕ, a ^ n ∈ s ^ n
  | 0 => by
    rw [pow_zero]
    exact one_mem_one
  | n + 1 => by
    rw [pow_succ]
    exact mul_mem_mul ha (pow_mem_pow ha _)
#align set.pow_mem_pow Set.pow_mem_pow
#align set.nsmul_mem_nsmul Set.nsmul_mem_nsmul

@[to_additive]
theorem pow_subset_pow (hst : s ⊆ t) : ∀ n : ℕ, s ^ n ⊆ t ^ n
  | 0 => by
    rw [pow_zero]
    exact Subset.rfl
  | n + 1 => by
    rw [pow_succ]
    exact mul_subset_mul hst (pow_subset_pow hst _)
#align set.pow_subset_pow Set.pow_subset_pow
#align set.nsmul_subset_nsmul Set.nsmul_subset_nsmul

@[to_additive]
theorem pow_subset_pow_of_one_mem (hs : (1 : α) ∈ s) (hn : m ≤ n) : s ^ m ⊆ s ^ n := by
  -- Porting note: `Nat.le_induction` didn't work as an induction principle in mathlib3, this was
  -- `refine nat.le_induction ...`
  induction' n, hn using Nat.le_induction with _ _ ih
  · exact Subset.rfl
  · dsimp only
    rw [pow_succ]
    exact ih.trans (subset_mul_right _ hs)
#align set.pow_subset_pow_of_one_mem Set.pow_subset_pow_of_one_mem
#align set.nsmul_subset_nsmul_of_zero_mem Set.nsmul_subset_nsmul_of_zero_mem

@[to_additive (attr := simp)]
theorem empty_pow {n : ℕ} (hn : n ≠ 0) : (∅ : Set α) ^ n = ∅ := by
  rw [← tsub_add_cancel_of_le (Nat.succ_le_of_lt <| Nat.pos_of_ne_zero hn), pow_succ, empty_mul]
#align set.empty_pow Set.empty_pow
#align set.empty_nsmul Set.empty_nsmul

@[to_additive]
theorem mul_univ_of_one_mem (hs : (1 : α) ∈ s) : s * univ = univ :=
  eq_univ_iff_forall.2 fun _ => mem_mul.2 ⟨_, _, hs, mem_univ _, one_mul _⟩
#align set.mul_univ_of_one_mem Set.mul_univ_of_one_mem
#align set.add_univ_of_zero_mem Set.add_univ_of_zero_mem

@[to_additive]
theorem univ_mul_of_one_mem (ht : (1 : α) ∈ t) : univ * t = univ :=
  eq_univ_iff_forall.2 fun _ => mem_mul.2 ⟨_, _, mem_univ _, ht, mul_one _⟩
#align set.univ_mul_of_one_mem Set.univ_mul_of_one_mem
#align set.univ_add_of_zero_mem Set.univ_add_of_zero_mem

@[to_additive (attr := simp)]
theorem univ_mul_univ : (univ : Set α) * univ = univ :=
  mul_univ_of_one_mem <| mem_univ _
#align set.univ_mul_univ Set.univ_mul_univ
#align set.univ_add_univ Set.univ_add_univ

--TODO: `to_additive` trips up on the `1 : ℕ` used in the pattern-matching.
@[simp]
theorem nsmul_univ {α : Type _} [AddMonoid α] : ∀ {n : ℕ}, n ≠ 0 → n • (univ : Set α) = univ
  | 0 => fun h => (h rfl).elim
  | 1 => fun _ => one_nsmul _
  | n + 2 => fun _ => by rw [succ_nsmul, nsmul_univ n.succ_ne_zero, univ_add_univ]
#align set.nsmul_univ Set.nsmul_univ

@[to_additive existing (attr := simp) nsmul_univ]
theorem univ_pow : ∀ {n : ℕ}, n ≠ 0 → (univ : Set α) ^ n = univ
  | 0 => fun h => (h rfl).elim
  | 1 => fun _ => pow_one _
  | n + 2 => fun _ => by rw [pow_succ, univ_pow n.succ_ne_zero, univ_mul_univ]
#align set.univ_pow Set.univ_pow

@[to_additive]
protected theorem _root_.IsUnit.set : IsUnit a → IsUnit ({a} : Set α) :=
  IsUnit.map (singletonMonoidHom : α →* Set α)
#align is_unit.set IsUnit.set
#align is_add_unit.set IsAddUnit.set

end Monoid

/-- `Set α` is a `CommMonoid` under pointwise operations if `α` is. -/
@[to_additive "`Set α` is an `AddCommMonoid` under pointwise operations if `α` is."]
protected noncomputable def commMonoid [CommMonoid α] : CommMonoid (Set α) :=
  { Set.monoid, Set.commSemigroup with }
#align set.comm_monoid Set.commMonoid
#align set.add_comm_monoid Set.addCommMonoid

scoped[Pointwise] attribute [instance] Set.commMonoid Set.addCommMonoid

open Pointwise

section DivisionMonoid

variable [DivisionMonoid α] {s t : Set α}

@[to_additive]
protected theorem mul_eq_one_iff : s * t = 1 ↔ ∃ a b, s = {a} ∧ t = {b} ∧ a * b = 1 := by
  refine' ⟨fun h => _, _⟩
  · have hst : (s * t).Nonempty := h.symm.subst one_nonempty
    obtain ⟨a, ha⟩ := hst.of_image2_left
    obtain ⟨b, hb⟩ := hst.of_image2_right
    have H : ∀ {a b}, a ∈ s → b ∈ t → a * b = (1 : α) := fun {a b} ha hb =>
      h.subset <| mem_image2_of_mem ha hb
    refine' ⟨a, b, _, _, H ha hb⟩ <;> refine' eq_singleton_iff_unique_mem.2 ⟨‹_›, fun x hx => _⟩
    · exact (eq_inv_of_mul_eq_one_left <| H hx hb).trans (inv_eq_of_mul_eq_one_left <| H ha hb)
    · exact (eq_inv_of_mul_eq_one_right <| H ha hx).trans (inv_eq_of_mul_eq_one_right <| H ha hb)
  · rintro ⟨b, c, rfl, rfl, h⟩
    rw [singleton_mul_singleton, h, singleton_one]
#align set.mul_eq_one_iff Set.mul_eq_one_iff
#align set.add_eq_zero_iff Set.add_eq_zero_iff

/-- `Set α` is a division monoid under pointwise operations if `α` is. -/
@[to_additive subtractionMonoid
    "`Set α` is a subtraction monoid under pointwise operations if `α` is."]
protected noncomputable def divisionMonoid : DivisionMonoid (Set α) :=
  { Set.monoid, Set.involutiveInv, Set.div, @Set.ZPow α _ _ _ with
    mul_inv_rev := fun s t => by
      simp_rw [← image_inv]
      exact image_image2_antidistrib mul_inv_rev
    inv_eq_of_mul := fun s t h => by
      obtain ⟨a, b, rfl, rfl, hab⟩ := Set.mul_eq_one_iff.1 h
      rw [inv_singleton, inv_eq_of_mul_eq_one_right hab]
    div_eq_mul_inv := fun s t => by
      rw [← image_id (s / t), ← image_inv]
      exact image_image2_distrib_right div_eq_mul_inv }
#align set.division_monoid Set.divisionMonoid
#align set.subtraction_monoid Set.subtractionMonoid

@[to_additive (attr := simp 500)]
theorem isUnit_iff : IsUnit s ↔ ∃ a, s = {a} ∧ IsUnit a := by
  constructor
  · rintro ⟨u, rfl⟩
    obtain ⟨a, b, ha, hb, h⟩ := Set.mul_eq_one_iff.1 u.mul_inv
    refine' ⟨a, ha, ⟨a, b, h, singleton_injective _⟩, rfl⟩
    rw [← singleton_mul_singleton, ← ha, ← hb]
    exact u.inv_mul
  · rintro ⟨a, rfl, ha⟩
    exact ha.set
#align set.is_unit_iff Set.isUnit_iff
#align set.is_add_unit_iff Set.isAddUnit_iff

end DivisionMonoid

/-- `Set α` is a commutative division monoid under pointwise operations if `α` is. -/
@[to_additive subtractionCommMonoid
      "`Set α` is a commutative subtraction monoid under pointwise operations if `α` is."]
protected noncomputable def divisionCommMonoid [DivisionCommMonoid α] :
    DivisionCommMonoid (Set α) :=
  { Set.divisionMonoid, Set.commSemigroup with }
#align set.division_comm_monoid Set.divisionCommMonoid
#align set.subtraction_comm_monoid Set.subtractionCommMonoid

/-- `Set α` has distributive negation if `α` has. -/
protected noncomputable def hasDistribNeg [Mul α] [HasDistribNeg α] : HasDistribNeg (Set α) :=
  { Set.involutiveNeg with
    neg_mul := fun _ _ => by
      simp_rw [← image_neg]
      exact image2_image_left_comm neg_mul
    mul_neg := fun _ _ => by
      simp_rw [← image_neg]
      exact image_image2_right_comm mul_neg }
#align set.has_distrib_neg Set.hasDistribNeg

scoped[Pointwise]
  attribute [instance]
    Set.divisionMonoid Set.subtractionMonoid Set.divisionCommMonoid Set.subtractionCommMonoid
    Set.hasDistribNeg

section Distrib

variable [Distrib α] (s t u : Set α)

/-!
Note that `Set α` is not a `Distrib` because `s * t + s * u` has cross terms that `s * (t + u)`
lacks.
-/

theorem mul_add_subset : s * (t + u) ⊆ s * t + s * u :=
  image2_distrib_subset_left mul_add
#align set.mul_add_subset Set.mul_add_subset

theorem add_mul_subset : (s + t) * u ⊆ s * u + t * u :=
  image2_distrib_subset_right add_mul
#align set.add_mul_subset Set.add_mul_subset

end Distrib

section MulZeroClass

variable [MulZeroClass α] {s t : Set α}

/-! Note that `Set` is not a `MulZeroClass` because `0 * ∅ ≠ 0`. -/

theorem mul_zero_subset (s : Set α) : s * 0 ⊆ 0 := by simp [subset_def, mem_mul]
#align set.mul_zero_subset Set.mul_zero_subset

theorem zero_mul_subset (s : Set α) : 0 * s ⊆ 0 := by simp [subset_def, mem_mul]
#align set.zero_mul_subset Set.zero_mul_subset

theorem Nonempty.mul_zero (hs : s.Nonempty) : s * 0 = 0 :=
  s.mul_zero_subset.antisymm <| by simpa [mem_mul] using hs
#align set.nonempty.mul_zero Set.Nonempty.mul_zero

theorem Nonempty.zero_mul (hs : s.Nonempty) : 0 * s = 0 :=
  s.zero_mul_subset.antisymm <| by simpa [mem_mul] using hs
#align set.nonempty.zero_mul Set.Nonempty.zero_mul

end MulZeroClass

section Group

variable [Group α] {s t : Set α} {a b : α}

/-! Note that `Set` is not a `Group` because `s / s ≠ 1` in general. -/

@[to_additive (attr := simp)]
theorem one_mem_div_iff : (1 : α) ∈ s / t ↔ ¬Disjoint s t := by
  simp [not_disjoint_iff_nonempty_inter, mem_div, div_eq_one, Set.Nonempty]
#align set.one_mem_div_iff Set.one_mem_div_iff
#align set.zero_mem_sub_iff Set.zero_mem_sub_iff

@[to_additive]
theorem not_one_mem_div_iff : (1 : α) ∉ s / t ↔ Disjoint s t :=
  one_mem_div_iff.not_left
#align set.not_one_mem_div_iff Set.not_one_mem_div_iff
#align set.not_zero_mem_sub_iff Set.not_zero_mem_sub_iff

alias not_one_mem_div_iff ↔ _ _root_.Disjoint.one_not_mem_div_set
#align disjoint.one_not_mem_div_set Disjoint.one_not_mem_div_set

attribute [to_additive] Disjoint.one_not_mem_div_set
#align disjoint.zero_not_mem_sub_set Disjoint.zero_not_mem_sub_set

@[to_additive]
theorem Nonempty.one_mem_div (h : s.Nonempty) : (1 : α) ∈ s / s :=
  let ⟨a, ha⟩ := h
  mem_div.2 ⟨a, a, ha, ha, div_self' _⟩
#align set.nonempty.one_mem_div Set.Nonempty.one_mem_div
#align set.nonempty.zero_mem_sub Set.Nonempty.zero_mem_sub

@[to_additive]
theorem isUnit_singleton (a : α) : IsUnit ({a} : Set α) :=
  (Group.isUnit a).set
#align set.is_unit_singleton Set.isUnit_singleton
#align set.is_add_unit_singleton Set.isAddUnit_singleton

@[to_additive (attr := simp)]
theorem isUnit_iff_singleton : IsUnit s ↔ ∃ a, s = {a} := by
  simp only [isUnit_iff, Group.isUnit, and_true_iff]
#align set.is_unit_iff_singleton Set.isUnit_iff_singleton
#align set.is_add_unit_iff_singleton Set.isAddUnit_iff_singleton

@[to_additive (attr := simp)]
theorem image_mul_left : (· * ·) a '' t = (· * ·) a⁻¹ ⁻¹' t := by
  rw [image_eq_preimage_of_inverse] <;> intro c <;> simp
#align set.image_mul_left Set.image_mul_left
#align set.image_add_left Set.image_add_left

@[to_additive (attr := simp)]
theorem image_mul_right : (· * b) '' t = (· * b⁻¹) ⁻¹' t := by
  rw [image_eq_preimage_of_inverse] <;> intro c <;> simp
#align set.image_mul_right Set.image_mul_right
#align set.image_add_right Set.image_add_right

@[to_additive]
theorem image_mul_left' : (fun b => a⁻¹ * b) '' t = (fun b => a * b) ⁻¹' t := by simp
#align set.image_mul_left' Set.image_mul_left'
#align set.image_add_left' Set.image_add_left'

@[to_additive]
theorem image_mul_right' : (· * b⁻¹) '' t = (· * b) ⁻¹' t := by simp
#align set.image_mul_right' Set.image_mul_right'
#align set.image_add_right' Set.image_add_right'

@[to_additive (attr := simp)]
theorem preimage_mul_left_singleton : (· * ·) a ⁻¹' {b} = {a⁻¹ * b} := by
  rw [← image_mul_left', image_singleton]
#align set.preimage_mul_left_singleton Set.preimage_mul_left_singleton
#align set.preimage_add_left_singleton Set.preimage_add_left_singleton

@[to_additive (attr := simp)]
theorem preimage_mul_right_singleton : (· * a) ⁻¹' {b} = {b * a⁻¹} := by
  rw [← image_mul_right', image_singleton]
#align set.preimage_mul_right_singleton Set.preimage_mul_right_singleton
#align set.preimage_add_right_singleton Set.preimage_add_right_singleton

@[to_additive (attr := simp)]
theorem preimage_mul_left_one : (· * ·) a ⁻¹' 1 = {a⁻¹} := by
  rw [← image_mul_left', image_one, mul_one]
#align set.preimage_mul_left_one Set.preimage_mul_left_one
#align set.preimage_add_left_zero Set.preimage_add_left_zero

@[to_additive (attr := simp)]
theorem preimage_mul_right_one : (· * b) ⁻¹' 1 = {b⁻¹} := by
  rw [← image_mul_right', image_one, one_mul]
#align set.preimage_mul_right_one Set.preimage_mul_right_one
#align set.preimage_add_right_zero Set.preimage_add_right_zero

@[to_additive]
theorem preimage_mul_left_one' : (fun b => a⁻¹ * b) ⁻¹' 1 = {a} := by simp
#align set.preimage_mul_left_one' Set.preimage_mul_left_one'
#align set.preimage_add_left_zero' Set.preimage_add_left_zero'

@[to_additive]
theorem preimage_mul_right_one' : (· * b⁻¹) ⁻¹' 1 = {b} := by simp
#align set.preimage_mul_right_one' Set.preimage_mul_right_one'
#align set.preimage_add_right_zero' Set.preimage_add_right_zero'

@[to_additive (attr := simp)]
theorem mul_univ (hs : s.Nonempty) : s * (univ : Set α) = univ :=
  let ⟨a, ha⟩ := hs
  eq_univ_of_forall fun b => ⟨a, a⁻¹ * b, ha, trivial, mul_inv_cancel_left _ _⟩
#align set.mul_univ Set.mul_univ
#align set.add_univ Set.add_univ

@[to_additive (attr := simp)]
theorem univ_mul (ht : t.Nonempty) : (univ : Set α) * t = univ :=
  let ⟨a, ha⟩ := ht
  eq_univ_of_forall fun b => ⟨b * a⁻¹, a, trivial, ha, inv_mul_cancel_right _ _⟩
#align set.univ_mul Set.univ_mul
#align set.univ_add Set.univ_add

end Group

section GroupWithZero

variable [GroupWithZero α] {s t : Set α}

theorem div_zero_subset (s : Set α) : s / 0 ⊆ 0 := by simp [subset_def, mem_div]
#align set.div_zero_subset Set.div_zero_subset

theorem zero_div_subset (s : Set α) : 0 / s ⊆ 0 := by simp [subset_def, mem_div]
#align set.zero_div_subset Set.zero_div_subset

theorem Nonempty.div_zero (hs : s.Nonempty) : s / 0 = 0 :=
  s.div_zero_subset.antisymm <| by simpa [mem_div] using hs
#align set.nonempty.div_zero Set.Nonempty.div_zero

theorem Nonempty.zero_div (hs : s.Nonempty) : 0 / s = 0 :=
  s.zero_div_subset.antisymm <| by simpa [mem_div] using hs
#align set.nonempty.zero_div Set.Nonempty.zero_div

end GroupWithZero

section Mul

variable [Mul α] [Mul β] [MulHomClass F α β] (m : F) {s t : Set α}

@[to_additive]
theorem image_mul : m '' (s * t) = m '' s * m '' t :=
  image_image2_distrib <| map_mul m
#align set.image_mul Set.image_mul
#align set.image_add Set.image_add

@[to_additive]
theorem preimage_mul_preimage_subset {s t : Set β} : m ⁻¹' s * m ⁻¹' t ⊆ m ⁻¹' (s * t) := by
  rintro _ ⟨_, _, _, _, rfl⟩
  exact ⟨_, _, ‹_›, ‹_›, (map_mul m _ _).symm⟩
#align set.preimage_mul_preimage_subset Set.preimage_mul_preimage_subset
#align set.preimage_add_preimage_subset Set.preimage_add_preimage_subset

end Mul

section Group

variable [Group α] [DivisionMonoid β] [MonoidHomClass F α β] (m : F) {s t : Set α}

@[to_additive]
theorem image_div : m '' (s / t) = m '' s / m '' t :=
  image_image2_distrib <| map_div m
#align set.image_div Set.image_div
#align set.image_sub Set.image_sub

@[to_additive]
theorem preimage_div_preimage_subset {s t : Set β} : m ⁻¹' s / m ⁻¹' t ⊆ m ⁻¹' (s / t) := by
  rintro _ ⟨_, _, _, _, rfl⟩
  exact ⟨_, _, ‹_›, ‹_›, (map_div m _ _).symm⟩
#align set.preimage_div_preimage_subset Set.preimage_div_preimage_subset
#align set.preimage_sub_preimage_subset Set.preimage_sub_preimage_subset

end Group

@[to_additive]
theorem bddAbove_mul [OrderedCommMonoid α] {A B : Set α} :
    BddAbove A → BddAbove B → BddAbove (A * B) := by
  rintro ⟨bA, hbA⟩ ⟨bB, hbB⟩
  use bA * bB
  rintro x ⟨xa, xb, hxa, hxb, rfl⟩
  exact mul_le_mul' (hbA hxa) (hbB hxb)
#align set.bdd_above_mul Set.bddAbove_mul
#align set.bdd_above_add Set.bddAbove_add

end Set

/-! ### Miscellaneous -/

open Set

open Pointwise

namespace Group

@[to_additive]
theorem card_pow_eq_card_pow_card_univ_aux {f : ℕ → ℕ} (h1 : Monotone f) {B : ℕ} (h2 : ∀ n, f n ≤ B)
    (h3 : ∀ n, f n = f (n + 1) → f (n + 1) = f (n + 2)) : ∀ k, B ≤ k → f k = f B := by
  have key : ∃ n : ℕ, n ≤ B ∧ f n = f (n + 1) := by
    contrapose! h2
    suffices ∀ n : ℕ, n ≤ B + 1 → n ≤ f n by exact ⟨B + 1, this (B + 1) (le_refl (B + 1))⟩
    exact fun n =>
      Nat.rec (fun _ => Nat.zero_le (f 0))
        (fun n ih h =>
          lt_of_le_of_lt (ih (n.le_succ.trans h))
            (lt_of_le_of_ne (h1 n.le_succ) (h2 n (Nat.succ_le_succ_iff.mp h))))
        n
  · obtain ⟨n, hn1, hn2⟩ := key
    replace key : ∀ k : ℕ, f (n + k) = f (n + k + 1) ∧ f (n + k) = f n := fun k =>
      Nat.rec ⟨hn2, rfl⟩ (fun k ih => ⟨h3 _ ih.1, ih.1.symm.trans ih.2⟩) k
    replace key : ∀ k : ℕ, n ≤ k → f k = f n := fun k hk =>
      (congr_arg f (add_tsub_cancel_of_le hk)).symm.trans (key (k - n)).2
    exact fun k hk => (key k (hn1.trans hk)).trans (key B hn1).symm
#align group.card_pow_eq_card_pow_card_univ_aux Group.card_pow_eq_card_pow_card_univ_aux
#align add_group.card_nsmul_eq_card_nsmul_card_univ_aux AddGroup.card_nsmul_eq_card_nsmul_card_univ_aux

end Group