/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import number_theory.padics.padic_integers
import topology.metric_space.cau_seq_filter
import analysis.specific_limits
import data.polynomial.identities
import topology.algebra.polynomial

/-!
# Hensel's lemma on ℤ_p

This file proves Hensel's lemma on ℤ_p, roughly following Keith Conrad's writeup:
<http://www.math.uconn.edu/~kconrad/blurbs/gradnumthy/hensel.pdf>

Hensel's lemma gives a simple condition for the existence of a root of a polynomial.

The proof and motivation are described in the paper
[R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019].

## References

* <http://www.math.uconn.edu/~kconrad/blurbs/gradnumthy/hensel.pdf>
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/Hensel%27s_lemma>

## Tags

p-adic, p adic, padic, p-adic integer
-/

noncomputable theory

open_locale classical topological_space

-- We begin with some general lemmas that are used below in the computation.

lemma padic_polynomial_dist {p : ℕ} [fact p.prime] (F : polynomial ℤ_[p]) (x y : ℤ_[p]) :
  ∥F.eval x - F.eval y∥ ≤ ∥x - y∥ :=
let ⟨z, hz⟩ := F.eval_sub_factor x y in calc
  ∥F.eval x - F.eval y∥ = ∥z∥ * ∥x - y∥ : by simp [hz]
    ... ≤ 1 * ∥x - y∥ : mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (norm_nonneg _)
    ... = ∥x - y∥ : by simp

open filter metric

private lemma comp_tendsto_lim {p : ℕ} [fact p.prime] {F : polynomial ℤ_[p]}
  (ncs : cau_seq ℤ_[p] norm) :
  tendsto (λ i, F.eval (ncs i)) at_top (𝓝 (F.eval ncs.lim)) :=
F.continuous_at.tendsto.comp ncs.tendsto_limit

section
parameters {p : ℕ} [fact p.prime] {ncs : cau_seq ℤ_[p] norm} {F : polynomial ℤ_[p]} {a : ℤ_[p]}
           (ncs_der_val : ∀ n, ∥F.derivative.eval (ncs n)∥ = ∥F.derivative.eval a∥)
include ncs_der_val

private lemma ncs_tendsto_const :
  tendsto (λ i, ∥F.derivative.eval (ncs i)∥) at_top (𝓝 ∥F.derivative.eval a∥) :=
by convert tendsto_const_nhds; ext; rw ncs_der_val

private lemma ncs_tendsto_lim :
  tendsto (λ i, ∥F.derivative.eval (ncs i)∥) at_top (𝓝 (∥F.derivative.eval ncs.lim∥)) :=
tendsto.comp (continuous_iff_continuous_at.1 continuous_norm _) (comp_tendsto_lim _)

private lemma norm_deriv_eq : ∥F.derivative.eval ncs.lim∥ = ∥F.derivative.eval a∥ :=
tendsto_nhds_unique ncs_tendsto_lim ncs_tendsto_const

end

section
parameters {p : ℕ} [fact p.prime] {ncs : cau_seq ℤ_[p] norm} {F : polynomial ℤ_[p]}
           (hnorm : tendsto (λ i, ∥F.eval (ncs i)∥) at_top (𝓝 0))
include hnorm

private lemma tendsto_zero_of_norm_tendsto_zero : tendsto (λ i, F.eval (ncs i)) at_top (𝓝 0) :=
tendsto_iff_norm_tendsto_zero.2 (by simpa using hnorm)

lemma limit_zero_of_norm_tendsto_zero : F.eval ncs.lim = 0 :=
tendsto_nhds_unique (comp_tendsto_lim _) tendsto_zero_of_norm_tendsto_zero

end

section hensel
open nat

parameters {p : ℕ} [fact p.prime] {F : polynomial ℤ_[p]} {a : ℤ_[p]}
           (hnorm : ∥F.eval a∥ < ∥F.derivative.eval a∥^2) (hnsol : F.eval a ≠ 0)
include hnorm

/-- `T` is an auxiliary value that is used to control the behavior of the polynomial `F`. -/
private def T : ℝ := ∥(F.eval a / (F.derivative.eval a)^2 : ℚ_[p])∥

private lemma deriv_sq_norm_pos : 0 < ∥F.derivative.eval a∥ ^ 2 :=
lt_of_le_of_lt (norm_nonneg _) hnorm

private lemma deriv_sq_norm_ne_zero : ∥F.derivative.eval a∥^2 ≠ 0 := ne_of_gt deriv_sq_norm_pos

private lemma deriv_norm_ne_zero : ∥F.derivative.eval a∥ ≠ 0 :=
λ h, deriv_sq_norm_ne_zero (by simp [*, sq])

private lemma deriv_norm_pos : 0 < ∥F.derivative.eval a∥ :=
lt_of_le_of_ne (norm_nonneg _) (ne.symm deriv_norm_ne_zero)

private lemma deriv_ne_zero : F.derivative.eval a ≠ 0 := mt norm_eq_zero.2 deriv_norm_ne_zero

private lemma T_def : T = ∥F.eval a∥ / ∥F.derivative.eval a∥^2 :=
calc T = ∥F.eval a∥ / ∥((F.derivative.eval a)^2 : ℚ_[p])∥ : normed_field.norm_div _ _
   ... = ∥F.eval a∥ / ∥(F.derivative.eval a)^2∥ : by simp [norm, padic_int.norm_def]
   ... = ∥F.eval a∥ / ∥(F.derivative.eval a)∥^2 : by simp

private lemma T_lt_one : T < 1 :=
let h := (div_lt_one deriv_sq_norm_pos).2 hnorm in
by rw T_def; apply h

private lemma T_pow {n : ℕ} (hn : n > 0) : T ^ n < 1 :=
have T ^ n ≤ T ^ 1,
from pow_le_pow_of_le_one (norm_nonneg _) (le_of_lt T_lt_one) (succ_le_of_lt hn),
lt_of_le_of_lt (by simpa) T_lt_one

private lemma T_pow' (n : ℕ) : T ^ (2 ^ n) < 1 := (T_pow (pow_pos (by norm_num) _))

private lemma T_pow_nonneg (n : ℕ) : 0 ≤ T ^ n := pow_nonneg (norm_nonneg _) _

/-- We will construct a sequence of elements of ℤ_p satisfying successive values of `ih`. -/
private def ih (n : ℕ) (z : ℤ_[p]) : Prop :=
∥F.derivative.eval z∥ = ∥F.derivative.eval a∥ ∧ ∥F.eval z∥ ≤ ∥F.derivative.eval a∥^2 * T ^ (2^n)

private lemma ih_0 : ih 0 a :=
⟨ rfl, by simp [T_def, mul_div_cancel' _ (ne_of_gt (deriv_sq_norm_pos hnorm))] ⟩

private lemma calc_norm_le_one {n : ℕ} {z : ℤ_[p]} (hz : ih n z) :
         ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥ ≤ 1 :=
calc ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥
    = ∥(↑(F.eval z) : ℚ_[p])∥ / ∥(↑(F.derivative.eval z) : ℚ_[p])∥ : normed_field.norm_div _ _
... = ∥F.eval z∥ / ∥F.derivative.eval a∥ : by simp [hz.1]
... ≤ ∥F.derivative.eval a∥^2 * T^(2^n) / ∥F.derivative.eval a∥ :
  (div_le_div_right deriv_norm_pos).2 hz.2
... = ∥F.derivative.eval a∥ * T^(2^n) : div_sq_cancel (ne_of_gt deriv_norm_pos) _
... ≤ 1 : mul_le_one (padic_int.norm_le_one _) (T_pow_nonneg _) (le_of_lt (T_pow' _))

private lemma calc_deriv_dist {z z' z1 : ℤ_[p]} (hz' : z' = z - z1)
  (hz1 : ∥z1∥ = ∥F.eval z∥ / ∥F.derivative.eval a∥) {n} (hz : ih n z) :
  ∥F.derivative.eval z' - F.derivative.eval z∥ < ∥F.derivative.eval a∥ :=
calc
  ∥F.derivative.eval z' - F.derivative.eval z∥
    ≤ ∥z' - z∥ : padic_polynomial_dist _ _ _
... = ∥z1∥ : by simp only [sub_eq_add_neg, add_assoc, hz', add_add_neg_cancel'_right, norm_neg]
... = ∥F.eval z∥ / ∥F.derivative.eval a∥ : hz1
... ≤ ∥F.derivative.eval a∥^2 * T^(2^n) / ∥F.derivative.eval a∥ :
  (div_le_div_right deriv_norm_pos).2 hz.2
... = ∥F.derivative.eval a∥ * T^(2^n) : div_sq_cancel deriv_norm_ne_zero _
... < ∥F.derivative.eval a∥ :
  (mul_lt_iff_lt_one_right deriv_norm_pos).2 (T_pow (pow_pos (by norm_num) _))

private def calc_eval_z'  {z z' z1 : ℤ_[p]} (hz' : z' = z - z1) {n} (hz : ih n z)
  (h1 : ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥ ≤ 1) (hzeq : z1 = ⟨_, h1⟩) :
  {q : ℤ_[p] // F.eval z' = q * z1^2} :=
have hdzne' : (↑(F.derivative.eval z) : ℚ_[p]) ≠ 0, from
  have hdzne : F.derivative.eval z ≠ 0,
    from mt norm_eq_zero.2 (by rw hz.1; apply deriv_norm_ne_zero; assumption),
  λ h, hdzne $ subtype.ext_iff_val.2 h,
let ⟨q, hq⟩ := F.binom_expansion z (-z1) in
have ∥(↑(F.derivative.eval z) * (↑(F.eval z) / ↑(F.derivative.eval z)) : ℚ_[p])∥ ≤ 1,
  by { rw padic_norm_e.mul, exact mul_le_one (padic_int.norm_le_one _) (norm_nonneg _) h1 },
have F.derivative.eval z * (-z1) = -F.eval z, from calc
  F.derivative.eval z * (-z1)
    = (F.derivative.eval z) * -⟨↑(F.eval z) / ↑(F.derivative.eval z), h1⟩ : by rw [hzeq]
... = -((F.derivative.eval z) * ⟨↑(F.eval z) / ↑(F.derivative.eval z), h1⟩) :
  by simp [subtype.ext_iff_val]
... = -(⟨↑(F.derivative.eval z) * (↑(F.eval z) / ↑(F.derivative.eval z)), this⟩) :
  subtype.ext $ by simp
... = -(F.eval z) : by simp [mul_div_cancel' _ hdzne'],
have heq : F.eval z' = q * z1^2, by simpa [sub_eq_add_neg, this, hz'] using hq,
⟨q, heq⟩

private def calc_eval_z'_norm {z z' z1 : ℤ_[p]} {n} (hz : ih n z) {q}
  (heq : F.eval z' = q * z1^2) (h1 : ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥ ≤ 1)
  (hzeq : z1 = ⟨_, h1⟩) : ∥F.eval z'∥ ≤ ∥F.derivative.eval a∥^2 * T^(2^(n+1)) :=
calc ∥F.eval z'∥
    = ∥q∥ * ∥z1∥^2 : by simp [heq]
... ≤ 1 * ∥z1∥^2 :
  mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (pow_nonneg (norm_nonneg _) _)
... = ∥F.eval z∥^2 / ∥F.derivative.eval a∥^2 :
  by simp [hzeq, hz.1, div_pow]
... ≤ (∥F.derivative.eval a∥^2 * T^(2^n))^2 / ∥F.derivative.eval a∥^2 :
  (div_le_div_right deriv_sq_norm_pos).2 (pow_le_pow_of_le_left (norm_nonneg _) hz.2 _)
... = (∥F.derivative.eval a∥^2)^2 * (T^(2^n))^2 / ∥F.derivative.eval a∥^2 : by simp only [mul_pow]
... = ∥F.derivative.eval a∥^2 * (T^(2^n))^2 : div_sq_cancel deriv_sq_norm_ne_zero _
... = ∥F.derivative.eval a∥^2 * T^(2^(n + 1)) : by rw [←pow_mul, pow_succ' 2]

set_option eqn_compiler.zeta true

/-- Given `z : ℤ_[p]` satisfying `ih n z`, construct `z' : ℤ_[p]` satisfying `ih (n+1) z'`. We need
the hypothesis `ih n z`, since otherwise `z'` is not necessarily an integer. -/
private def ih_n {n : ℕ} {z : ℤ_[p]} (hz : ih n z) : {z' : ℤ_[p] // ih (n+1) z'} :=
have h1 : ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥ ≤ 1, from calc_norm_le_one hz,
let z1 : ℤ_[p] := ⟨_, h1⟩,
    z' : ℤ_[p] := z - z1 in
⟨ z',
  have hdist : ∥F.derivative.eval z' - F.derivative.eval z∥ < ∥F.derivative.eval a∥,
    from calc_deriv_dist rfl (by simp [z1, hz.1]) hz,
  have hfeq : ∥F.derivative.eval z'∥ = ∥F.derivative.eval a∥,
    begin
      rw [sub_eq_add_neg, ← hz.1, ←norm_neg (F.derivative.eval z)] at hdist,
      have := padic_int.norm_eq_of_norm_add_lt_right hdist,
      rwa [norm_neg, hz.1] at this
    end,
  let ⟨q, heq⟩ := calc_eval_z' rfl hz h1 rfl in
  have hnle : ∥F.eval z'∥ ≤ ∥F.derivative.eval a∥^2 * T^(2^(n+1)),
    from calc_eval_z'_norm hz heq h1 rfl,
  ⟨hfeq, hnle⟩⟩

set_option eqn_compiler.zeta false

-- why doesn't "noncomputable theory" stick here?
private noncomputable def newton_seq_aux : Π n : ℕ, {z : ℤ_[p] // ih n z}
| 0 := ⟨a, ih_0⟩
| (k+1) := ih_n (newton_seq_aux k).2

private def newton_seq (n : ℕ) : ℤ_[p] := (newton_seq_aux n).1

private lemma newton_seq_deriv_norm (n : ℕ) :
  ∥F.derivative.eval (newton_seq n)∥ = ∥F.derivative.eval a∥ :=
(newton_seq_aux n).2.1

private lemma newton_seq_norm_le (n : ℕ) :
  ∥F.eval (newton_seq n)∥ ≤ ∥F.derivative.eval a∥^2 * T ^ (2^n) :=
(newton_seq_aux n).2.2

private lemma newton_seq_norm_eq (n : ℕ) :
  ∥newton_seq (n+1) - newton_seq n∥ =
    ∥F.eval (newton_seq n)∥ / ∥F.derivative.eval (newton_seq n)∥ :=
by simp [newton_seq, newton_seq_aux, ih_n, sub_eq_add_neg, add_comm]

private lemma newton_seq_succ_dist (n : ℕ) :
  ∥newton_seq (n+1) - newton_seq n∥ ≤ ∥F.derivative.eval a∥ * T^(2^n) :=
calc ∥newton_seq (n+1) - newton_seq n∥
    = ∥F.eval (newton_seq n)∥ / ∥F.derivative.eval (newton_seq n)∥ : newton_seq_norm_eq _
... = ∥F.eval (newton_seq n)∥ / ∥F.derivative.eval a∥ : by rw newton_seq_deriv_norm
... ≤ ∥F.derivative.eval a∥^2 * T ^ (2^n) / ∥F.derivative.eval a∥ :
  (div_le_div_right deriv_norm_pos).2 (newton_seq_norm_le _)
... = ∥F.derivative.eval a∥ * T^(2^n) : div_sq_cancel (ne_of_gt deriv_norm_pos) _

include hnsol
private lemma T_pos : T > 0 :=
begin
  rw T_def,
  exact div_pos (norm_pos_iff.2 hnsol) (deriv_sq_norm_pos hnorm)
end

private lemma newton_seq_succ_dist_weak (n : ℕ) :
  ∥newton_seq (n+2) - newton_seq (n+1)∥ < ∥F.eval a∥ / ∥F.derivative.eval a∥ :=
have 2 ≤ 2^(n+1),
  from have _, from pow_le_pow (by norm_num : 1 ≤ 2) (nat.le_add_left _ _ : 1 ≤ n + 1),
    by simpa using this,
calc ∥newton_seq (n+2) - newton_seq (n+1)∥
    ≤ ∥F.derivative.eval a∥ * T^(2^(n+1)) : newton_seq_succ_dist _
... ≤ ∥F.derivative.eval a∥ * T^2 :
  mul_le_mul_of_nonneg_left (pow_le_pow_of_le_one (norm_nonneg _) (le_of_lt T_lt_one) this)
    (norm_nonneg _)
... < ∥F.derivative.eval a∥ * T^1 :
  mul_lt_mul_of_pos_left (pow_lt_pow_of_lt_one T_pos T_lt_one (by norm_num)) deriv_norm_pos
... = ∥F.eval a∥ / ∥F.derivative.eval a∥ :
  begin
    rw [T, sq, pow_one, normed_field.norm_div, ←mul_div_assoc, padic_norm_e.mul],
    apply mul_div_mul_left,
    apply deriv_norm_ne_zero; assumption
  end

private lemma newton_seq_dist_aux (n : ℕ) :
  ∀ k : ℕ, ∥newton_seq (n + k) - newton_seq n∥ ≤ ∥F.derivative.eval a∥ * T^(2^n)
| 0 := by simp [T_pow_nonneg hnorm, mul_nonneg]
| (k+1) :=
  have 2^n ≤ 2^(n+k),
    by {apply pow_le_pow, norm_num, apply nat.le_add_right},
  calc
  ∥newton_seq (n + (k + 1)) - newton_seq n∥
    = ∥newton_seq ((n + k) + 1) - newton_seq n∥ : by rw add_assoc
... = ∥(newton_seq ((n + k) + 1) - newton_seq (n+k)) + (newton_seq (n+k) - newton_seq n)∥ :
  by rw ←sub_add_sub_cancel
... ≤ max (∥newton_seq ((n + k) + 1) - newton_seq (n+k)∥) (∥newton_seq (n+k) - newton_seq n∥) :
  padic_int.nonarchimedean _ _
... ≤ max (∥F.derivative.eval a∥ * T^(2^((n + k)))) (∥F.derivative.eval a∥ * T^(2^n)) :
  max_le_max (newton_seq_succ_dist _) (newton_seq_dist_aux _)
... = ∥F.derivative.eval a∥ * T^(2^n) :
  max_eq_right $ mul_le_mul_of_nonneg_left
    (pow_le_pow_of_le_one (norm_nonneg _) (le_of_lt T_lt_one) this) (norm_nonneg _)

private lemma newton_seq_dist {n k : ℕ} (hnk : n ≤ k) :
  ∥newton_seq k - newton_seq n∥ ≤ ∥F.derivative.eval a∥ * T^(2^n) :=
have hex : ∃ m, k = n + m, from exists_eq_add_of_le hnk,
let ⟨_, hex'⟩ := hex in
by rw hex'; apply newton_seq_dist_aux; assumption

private lemma newton_seq_dist_to_a :
  ∀ n : ℕ, 0 < n → ∥newton_seq n - a∥ = ∥F.eval a∥ / ∥F.derivative.eval a∥
| 1 h := by simp [sub_eq_add_neg, add_assoc, newton_seq, newton_seq_aux, ih_n]
| (k+2) h :=
  have hlt : ∥newton_seq (k+2) - newton_seq (k+1)∥ < ∥newton_seq (k+1) - a∥,
    by rw newton_seq_dist_to_a (k+1) (succ_pos _); apply newton_seq_succ_dist_weak; assumption,
  have hne' : ∥newton_seq (k + 2) - newton_seq (k+1)∥ ≠ ∥newton_seq (k+1) - a∥, from ne_of_lt hlt,
  calc  ∥newton_seq (k + 2) - a∥
    = ∥(newton_seq (k + 2) - newton_seq (k+1)) + (newton_seq (k+1) - a)∥ : by rw ←sub_add_sub_cancel
... = max (∥newton_seq (k + 2) - newton_seq (k+1)∥) (∥newton_seq (k+1) - a∥) :
  padic_int.norm_add_eq_max_of_ne hne'
... = ∥newton_seq (k+1) - a∥ : max_eq_right_of_lt hlt
... = ∥polynomial.eval a F∥ / ∥polynomial.eval a (polynomial.derivative F)∥ :
  newton_seq_dist_to_a (k+1) (succ_pos _)

private lemma bound' : tendsto (λ n : ℕ, ∥F.derivative.eval a∥ * T^(2^n)) at_top (𝓝 0) :=
begin
  rw ←mul_zero (∥F.derivative.eval a∥),
  exact tendsto_const_nhds.mul
                    (tendsto.comp
                      (tendsto_pow_at_top_nhds_0_of_lt_1 (norm_nonneg _) (T_lt_one hnorm))
                      (nat.tendsto_pow_at_top_at_top_of_one_lt (by norm_num)))
end

private lemma bound : ∀ {ε}, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → ∥F.derivative.eval a∥ * T^(2^n) < ε :=
have mtn : ∀ n : ℕ, ∥polynomial.eval a (polynomial.derivative F)∥ * T ^ (2 ^ n) ≥ 0,
  from λ n, mul_nonneg (norm_nonneg _) (T_pow_nonneg _),
begin
  have := bound' hnorm hnsol,
  simp [tendsto, nhds] at this,
  intros ε hε,
  cases this (ball 0 ε) (mem_ball_self hε) (is_open_ball) with N hN,
  existsi N, intros n hn,
  simpa [normed_field.norm_mul, real.norm_eq_abs, abs_of_nonneg (mtn n)] using hN _ hn
end

private lemma bound'_sq : tendsto (λ n : ℕ, ∥F.derivative.eval a∥^2 * T^(2^n)) at_top (𝓝 0) :=
begin
  rw [←mul_zero (∥F.derivative.eval a∥), sq],
  simp only [mul_assoc],
  apply tendsto.mul,
  { apply tendsto_const_nhds },
  { apply bound', assumption }
end

private theorem newton_seq_is_cauchy : is_cau_seq norm newton_seq :=
begin
  intros ε hε,
  cases bound hnorm hnsol hε with N hN,
  existsi N,
  intros j hj,
  apply lt_of_le_of_lt,
  { apply newton_seq_dist _ _ hj, assumption },
  { apply hN, apply le_refl }
end

private def newton_cau_seq : cau_seq ℤ_[p] norm := ⟨_, newton_seq_is_cauchy⟩

private def soln : ℤ_[p] := newton_cau_seq.lim

private lemma soln_spec {ε : ℝ} (hε : ε > 0) :
  ∃ (N : ℕ), ∀ {i : ℕ}, i ≥ N → ∥soln - newton_cau_seq i∥ < ε :=
setoid.symm (cau_seq.equiv_lim newton_cau_seq) _ hε

private lemma soln_deriv_norm : ∥F.derivative.eval soln∥ = ∥F.derivative.eval a∥ :=
norm_deriv_eq newton_seq_deriv_norm

private lemma newton_seq_norm_tendsto_zero :
  tendsto (λ i, ∥F.eval (newton_cau_seq i)∥) at_top (𝓝 0) :=
squeeze_zero (λ _, norm_nonneg _) newton_seq_norm_le bound'_sq

private lemma newton_seq_dist_tendsto :
  tendsto (λ n, ∥newton_cau_seq n - a∥) at_top (𝓝 (∥F.eval a∥ / ∥F.derivative.eval a∥)) :=
tendsto_const_nhds.congr' $ eventually_at_top.2 ⟨1, λ _ hx, (newton_seq_dist_to_a _ hx).symm⟩

private lemma newton_seq_dist_tendsto' :
  tendsto (λ n, ∥newton_cau_seq n - a∥) at_top (𝓝 ∥soln - a∥) :=
(continuous_norm.tendsto _).comp (newton_cau_seq.tendsto_limit.sub tendsto_const_nhds)

private lemma soln_dist_to_a : ∥soln - a∥ = ∥F.eval a∥ / ∥F.derivative.eval a∥ :=
tendsto_nhds_unique newton_seq_dist_tendsto' newton_seq_dist_tendsto

private lemma soln_dist_to_a_lt_deriv : ∥soln - a∥ < ∥F.derivative.eval a∥ :=
begin
  rw [soln_dist_to_a, div_lt_iff],
  { rwa sq at hnorm },
  { apply deriv_norm_pos, assumption }
end

private lemma eval_soln : F.eval soln = 0 :=
limit_zero_of_norm_tendsto_zero newton_seq_norm_tendsto_zero

private lemma soln_unique (z : ℤ_[p]) (hev : F.eval z = 0)
  (hnlt : ∥z - a∥ < ∥F.derivative.eval a∥) :
  z = soln :=
have soln_dist : ∥z - soln∥ < ∥F.derivative.eval a∥, from calc
  ∥z - soln∥ = ∥(z - a) + (a - soln)∥ : by rw sub_add_sub_cancel
        ... ≤ max (∥z - a∥) (∥a - soln∥) : padic_int.nonarchimedean _ _
        ... < ∥F.derivative.eval a∥ : max_lt hnlt (norm_sub_rev soln a ▸ soln_dist_to_a_lt_deriv),
let h := z - soln,
    ⟨q, hq⟩ := F.binom_expansion soln h in
have (F.derivative.eval soln + q * h) * h = 0, from eq.symm (calc
  0 = F.eval (soln + h) : by simp [hev, h]
... = F.derivative.eval soln * h + q * h^2 : by rw [hq, eval_soln, zero_add]
... = (F.derivative.eval soln + q * h) * h : by rw [sq, right_distrib, mul_assoc]),
have h = 0, from by_contradiction $ λ hne,
  have F.derivative.eval soln + q * h = 0,
    from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right hne,
  have F.derivative.eval soln = (-q) * h, by simpa using eq_neg_of_add_eq_zero this,
  lt_irrefl ∥F.derivative.eval soln∥ (calc
  ∥F.derivative.eval soln∥ = ∥(-q) * h∥ : by rw this
... ≤ 1 * ∥h∥ :
  by { rw padic_int.norm_mul,
       exact mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (norm_nonneg _) }
... = ∥z - soln∥ : by simp [h]
... < ∥F.derivative.eval soln∥ : by rw soln_deriv_norm; apply soln_dist),
eq_of_sub_eq_zero (by rw ←this; refl)

end hensel

variables {p : ℕ} [fact p.prime] {F : polynomial ℤ_[p]} {a : ℤ_[p]}

private lemma a_soln_is_unique (ha : F.eval a = 0) (z' : ℤ_[p]) (hz' : F.eval z' = 0)
  (hnormz' : ∥z' - a∥ < ∥F.derivative.eval a∥) : z' = a :=
let h := z' - a,
    ⟨q, hq⟩ := F.binom_expansion a h in
have (F.derivative.eval a + q * h) * h = 0, from eq.symm (calc
  0 = F.eval (a + h) : show 0 = F.eval (a + (z' - a)), by rw add_comm; simp [hz']
... = F.derivative.eval a * h + q * h^2 : by rw [hq, ha, zero_add]
... = (F.derivative.eval a + q * h) * h : by rw [sq, right_distrib, mul_assoc]),
have h = 0, from by_contradiction $ λ hne,
  have F.derivative.eval a + q * h = 0,
    from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right hne,
  have F.derivative.eval a = (-q) * h, by simpa using eq_neg_of_add_eq_zero this,
  lt_irrefl ∥F.derivative.eval a∥ (calc
    ∥F.derivative.eval a∥ = ∥q∥*∥h∥ : by simp [this]
    ... ≤ 1*∥h∥ : mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (norm_nonneg _)
    ... < ∥F.derivative.eval a∥ : by simpa [h]),
eq_of_sub_eq_zero (by rw ←this; refl)

variable (hnorm : ∥F.eval a∥ < ∥F.derivative.eval a∥^2)
include hnorm

private lemma a_is_soln (ha : F.eval a = 0) :
  F.eval a = 0 ∧ ∥a - a∥ < ∥F.derivative.eval a∥ ∧ ∥F.derivative.eval a∥ = ∥F.derivative.eval a∥ ∧
  ∀ z', F.eval z' = 0 → ∥z' - a∥ < ∥F.derivative.eval a∥ → z' = a :=
⟨ha, by simp [deriv_ne_zero hnorm], rfl, a_soln_is_unique ha⟩

lemma hensels_lemma : ∃ z : ℤ_[p], F.eval z = 0 ∧ ∥z - a∥ < ∥F.derivative.eval a∥ ∧
  ∥F.derivative.eval z∥ = ∥F.derivative.eval a∥ ∧
  ∀ z', F.eval z' = 0 → ∥z' - a∥ < ∥F.derivative.eval a∥ → z' = z :=
if ha : F.eval a = 0 then ⟨a, a_is_soln hnorm ha⟩ else
by refine ⟨soln _ _, eval_soln _ _, soln_dist_to_a_lt_deriv _ _, soln_deriv_norm _ _,
  soln_unique _ _⟩; assumption


-- inductive player : Type | a | b | c

open list

#print nat.no_confusion_type
#print nat.no_confusion

def adjacent_pred {α : Type} (p : α -> α -> Prop) : list α -> Prop
| [] := true
| [x] := true
| (x :: y :: tail) := p x y ∧ adjacent_pred (y :: tail)

def allp : list Prop -> Prop
| [] := true
| (x::xs) := x ∧ allp xs

def is_occurrence_list {α : Type} (x : α) (xs : list α) (idxs : list ℕ) : Prop :=
  adjacent_pred nat.lt idxs ∧ allp (list.map (λ n, nth xs n = some x) idxs)

def diff_n (n : nat) := (λ x y, x + n ≤ y)
def increasing_by (n : ℕ) := adjacent_pred (diff_n n)

lemma allp_nth {α : Type} {xs : list α} {f : α -> Prop}
  : allp (list.map f xs) -> forall n (h : n < length xs), f (nth_le xs n h) :=
begin
intro,
induction xs with x xs IHxs,
intros,
cases h,
intros,
cases n with n,
unfold nth_le,
exact a.left,

unfold nth_le,
apply IHxs,
apply a.right
end

lemma adjacent_pred_nth {α : Type} {xs : list α} {p : α -> α -> Prop} :
  (adjacent_pred p xs) <->
  forall n {h1 : n < length xs} {h2 : nat.succ n < length xs},
  p (nth_le xs n h1) (nth_le xs (nat.succ n) h2) :=
begin
apply iff.intro,

intros,
revert xs,
induction n,

intros,
cases xs,
cases h1,
cases xs_tl,
unfold length at h2,
cases h2, cases h2_a,

unfold nth_le,
exact a.left,

intros,
cases xs,
cases h1,

unfold nth_le,
apply n_ih,

cases xs_tl,
cases h1, cases h1_a,
exact a.right,

--backwards
induction xs,
intros,
unfold adjacent_pred,

intros,
cases xs_tl,
unfold adjacent_pred,
unfold adjacent_pred,

split,
apply a 0,
unfold length,
apply nat.zero_lt_succ,

unfold length,
apply nat.succ_lt_succ,
apply nat.zero_lt_succ,

apply xs_ih,
intros,
apply a (nat.succ n),
apply nat.succ_lt_succ,
apply h1,
apply nat.succ_lt_succ,
apply h2,
end

lemma increasing_nth {xs : list ℕ} {k : ℕ} :
  (increasing_by k xs) -> ∀ n (H : n < length xs), (nth_le xs n H) ≥ k * n :=
begin
intros,
induction n,
unfold has_mul.mul nat.mul,
apply nat.zero_le,

unfold has_mul.mul nat.mul,
cases xs,
cases H,

unfold nth_le,
apply le_trans,

apply add_le_add_right,
apply n_ih,
apply nat.lt_of_succ_lt,
assumption,

apply le_trans,
apply adjacent_pred_nth.elim_left a,
assumption,
unfold nth_le,
end

lemma asd {n m : nat} : n ≤ m -> n = m ∨ n < m :=
begin
intro,
cases a,
apply or.inl,
refl,

apply or.inr,
apply nat.succ_le_succ,
apply a_a,
end

lemma some_length {α : Type} {x : α} {n : nat} {xs : list α} : (nth xs n = some x) -> n < length xs :=
begin
revert xs,
induction n,
intro, cases xs,
intro, cases a,

intro,
unfold length,
apply nat.zero_lt_succ,

intros, cases xs,
cases a,

unfold length,
apply nat.succ_lt_succ,
apply n_ih,
apply a,
end

set_option trace.check true

lemma nth_le_nth {α : Type} {x : α} {xs : list α} {n : nat} (h : n < length xs) :
  nth xs n = some x -> nth_le xs n h = x :=
begin
revert xs,
induction n,

intro, cases xs,
intro, cases h,

intros,
unfold nth at a,
unfold nth_le,
cases a, refl,

intros,
cases xs,
cases h,
unfold nth at a,
unfold nth_le,
apply n_ih,
assumption,
end

lemma diff2 {α : Type} (x : α) (xs : list α) (idxs : list ℕ) :
  is_occurrence_list x xs idxs ∧ adjacent_pred ne xs ->
  increasing_by 2 idxs :=
begin
intro, cases a, cases a_left,

apply adjacent_pred_nth.elim_right,

let h_ne := adjacent_pred_nth.elim_left a_right,
let h_lt := adjacent_pred_nth.elim_left a_left_left,
let h_x := allp_nth a_left_right,

intros,
unfold diff_n,

cases asd (@h_lt n h1 h2),

apply absurd (h_ne (nth_le idxs n h1)),
intro, apply a,

simp [h],

rw nth_le_nth _ (h_x n h1),
rw nth_le_nth _ (h_x (nat.succ n) h2),

apply some_length,
apply h_x,
rw h,
apply some_length,
apply h_x,

exact h,
end

lemma le_pred (n : nat) (m : nat) : n ≤ nat.succ m -> nat.pred n ≤ m :=
begin
intro,
cases n,
unfold nat.pred,
apply nat.zero_le,
unfold nat.pred,
apply nat.le_of_succ_le_succ,
assumption,
end

lemma nth_lt {α : Type} {x : α} {xs : list α} {n : nat} : list.nth xs n = option.some x -> n < length xs :=
begin
revert xs,
induction n,

intro,
cases xs,
unfold nth,
intro, cases a,

unfold nth,
intro,
unfold length,
apply nat.zero_lt_succ,

intro,
cases xs,
unfold nth,
intro, cases a,

unfold nth,
intro,
unfold length,
apply nat.succ_lt_succ,
apply n_ih,
assumption
end

theorem main {α : Type} (x : α) (xs : list α) (idxs : list ℕ) :
  is_occurrence_list x xs idxs -> adjacent_pred ne xs -> list.length xs ≥ 2 * list.length idxs - 1 :=
begin
intros,

cases idxs,
simp,
apply nat.zero_le,

let idxs := idxs_hd :: idxs_tl,
let i := length idxs_tl,

have i_le : i < length idxs,

dsimp,
apply nat.lt_succ_self,

let h2 := allp_nth a.right,

have h1 : nth_le idxs i i_le < length xs,
apply nth_lt,
apply h2, clear h2,

unfold length,
unfold has_mul.mul nat.mul,

unfold has_sub.sub nat.sub nat.pred,
apply le_trans,
tactic.swap,
apply h1,
apply nat.succ_le_succ,

apply le_trans, tactic.swap,
apply increasing_nth,
apply diff2,

split,
exact a,
exact a_1,

apply nat.mul_le_mul_left,
apply nat.le_refl,
end

theorem main2 {α : Type} (x : α) (xs : list α) (idxs : list ℕ) :
  is_occurrence_list x xs idxs -> adjacent_pred ne xs -> list.length xs = 2 * list.length idxs - 1 ->
  ∀ n (H : n < length idxs), (nth_le idxs n H) = 2 * n :=
begin
intros,
sorry
end


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import algebra.hom.group_instances
import data.pi.algebra
import data.set.function
import data.set.pairwise
import tactic.pi_instances

/-!
# Pi instances for groups and monoids

This file defines instances for group, monoid, semigroup and related structures on Pi types.
-/

universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)

namespace pi

@[to_additive]
instance semigroup [∀ i, semigroup $ f i] : semigroup (Π i : I, f i) :=
by refine_struct { mul := (*), .. }; tactic.pi_instance_derive_field

instance semigroup_with_zero [∀ i, semigroup_with_zero $ f i] :
  semigroup_with_zero (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), mul := (*), .. }; tactic.pi_instance_derive_field

@[to_additive]
instance comm_semigroup [∀ i, comm_semigroup $ f i] : comm_semigroup (Π i : I, f i) :=
by refine_struct { mul := (*), .. }; tactic.pi_instance_derive_field

@[to_additive]
instance mul_one_class [∀ i, mul_one_class $ f i] : mul_one_class (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), .. }; tactic.pi_instance_derive_field

@[to_additive]
instance monoid [∀ i, monoid $ f i] : monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := λ n x i, (x i) ^ n };
tactic.pi_instance_derive_field

-- the attributes are intentionally out of order. `smul_apply` proves `nsmul_apply`.
@[to_additive, simp]
lemma pow_apply [∀ i, monoid $ f i] (n : ℕ) : (x^n) i = (x i)^n := rfl

@[to_additive]
instance comm_monoid [∀ i, comm_monoid $ f i] : comm_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := monoid.npow };
tactic.pi_instance_derive_field

@[to_additive pi.sub_neg_monoid]
instance [Π i, div_inv_monoid $ f i] : div_inv_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), inv := has_inv.inv, div := has_div.div,
  npow := monoid.npow, zpow := λ z x i, (x i) ^ z }; tactic.pi_instance_derive_field

@[to_additive]
instance [Π i, has_involutive_inv $ f i] : has_involutive_inv (Π i, f i) :=
by refine_struct { inv := has_inv.inv }; tactic.pi_instance_derive_field

@[to_additive pi.subtraction_monoid]
instance [Π i, division_monoid $ f i] : division_monoid (Π i, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), inv := has_inv.inv, div := has_div.div,
  npow := monoid.npow, zpow := λ z x i, (x i) ^ z }; tactic.pi_instance_derive_field

@[to_additive pi.subtraction_comm_monoid]
instance [Π i, division_comm_monoid $ f i] : division_comm_monoid (Π i, f i) :=
{ ..pi.division_monoid, ..pi.comm_semigroup }

@[to_additive]
instance group [∀ i, group $ f i] : group (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), inv := has_inv.inv, div := has_div.div,
  npow := monoid.npow, zpow := div_inv_monoid.zpow }; tactic.pi_instance_derive_field

@[to_additive]
instance comm_group [∀ i, comm_group $ f i] : comm_group (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), inv := has_inv.inv, div := has_div.div,
  npow := monoid.npow, zpow := div_inv_monoid.zpow }; tactic.pi_instance_derive_field

@[to_additive add_left_cancel_semigroup]
instance left_cancel_semigroup [∀ i, left_cancel_semigroup $ f i] :
  left_cancel_semigroup (Π i : I, f i) :=
by refine_struct { mul := (*) }; tactic.pi_instance_derive_field

@[to_additive add_right_cancel_semigroup]
instance right_cancel_semigroup [∀ i, right_cancel_semigroup $ f i] :
  right_cancel_semigroup (Π i : I, f i) :=
by refine_struct { mul := (*) }; tactic.pi_instance_derive_field

@[to_additive add_left_cancel_monoid]
instance left_cancel_monoid [∀ i, left_cancel_monoid $ f i] :
  left_cancel_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := monoid.npow };
tactic.pi_instance_derive_field

@[to_additive add_right_cancel_monoid]
instance right_cancel_monoid [∀ i, right_cancel_monoid $ f i] :
  right_cancel_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := monoid.npow, .. };
tactic.pi_instance_derive_field

@[to_additive add_cancel_monoid]
instance cancel_monoid [∀ i, cancel_monoid $ f i] :
  cancel_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := monoid.npow };
tactic.pi_instance_derive_field

@[to_additive add_cancel_comm_monoid]
instance cancel_comm_monoid [∀ i, cancel_comm_monoid $ f i] :
  cancel_comm_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := monoid.npow };
tactic.pi_instance_derive_field

instance mul_zero_class [∀ i, mul_zero_class $ f i] :
  mul_zero_class (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), mul := (*), .. }; tactic.pi_instance_derive_field

instance mul_zero_one_class [∀ i, mul_zero_one_class $ f i] :
  mul_zero_one_class (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := (1 : Π i, f i), mul := (*), .. };
  tactic.pi_instance_derive_field

instance monoid_with_zero [∀ i, monoid_with_zero $ f i] :
  monoid_with_zero (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := (1 : Π i, f i), mul := (*),
  npow := monoid.npow }; tactic.pi_instance_derive_field

instance comm_monoid_with_zero [∀ i, comm_monoid_with_zero $ f i] :
  comm_monoid_with_zero (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := (1 : Π i, f i), mul := (*),
  npow := monoid.npow }; tactic.pi_instance_derive_field

end pi

namespace mul_hom

@[to_additive] lemma coe_mul {M N} {mM : has_mul M} {mN : comm_semigroup N}
  (f g : M →ₙ* N) :
  (f * g : M → N) = λ x, f x * g x := rfl

end mul_hom

section mul_hom

variables (f) [Π i, has_mul (f i)]

/-- Evaluation of functions into an indexed collection of semigroups at a point is a semigroup
homomorphism.
This is `function.eval i` as a `mul_hom`. -/
@[to_additive "Evaluation of functions into an indexed collection of additive semigroups at a
point is an additive semigroup homomorphism.
This is `function.eval i` as an `add_hom`.", simps]
def pi.eval_mul_hom (i : I) : (Π i, f i) →ₙ* f i :=
{ to_fun := λ g, g i,
  map_mul' := λ x y, pi.mul_apply _ _ i, }

/-- `function.const` as a `mul_hom`. -/
@[to_additive "`function.const` as an `add_hom`.", simps]
def pi.const_mul_hom (α β : Type*) [has_mul β] : β →ₙ* (α → β) :=
{ to_fun := function.const α,
  map_mul' := λ _ _, rfl }

/-- Coercion of a `mul_hom` into a function is itself a `mul_hom`.
See also `mul_hom.eval`. -/
@[to_additive "Coercion of an `add_hom` into a function is itself a `add_hom`.
See also `add_hom.eval`. ", simps]
def mul_hom.coe_fn (α β : Type*) [has_mul α] [comm_semigroup β] : (α →ₙ* β) →ₙ* (α → β) :=
{ to_fun := λ g, g,
  map_mul' := λ x y, rfl, }

/-- Semigroup homomorphism between the function spaces `I → α` and `I → β`, induced by a semigroup
homomorphism `f` between `α` and `β`. -/
@[to_additive "Additive semigroup homomorphism between the function spaces `I → α` and `I → β`,
induced by an additive semigroup homomorphism `f` between `α` and `β`", simps]
protected def mul_hom.comp_left {α β : Type*} [has_mul α] [has_mul β] (f : α →ₙ* β)
  (I : Type*) :
  (I → α) →ₙ* (I → β) :=
{ to_fun := λ h, f ∘ h,
  map_mul' := λ _ _, by ext; simp }

end mul_hom

section monoid_hom

variables (f) [Π i, mul_one_class (f i)]

/-- Evaluation of functions into an indexed collection of monoids at a point is a monoid
homomorphism.
This is `function.eval i` as a `monoid_hom`. -/
@[to_additive "Evaluation of functions into an indexed collection of additive monoids at a
point is an additive monoid homomorphism.
This is `function.eval i` as an `add_monoid_hom`.", simps]
def pi.eval_monoid_hom (i : I) : (Π i, f i) →* f i :=
{ to_fun := λ g, g i,
  map_one' := pi.one_apply i,
  map_mul' := λ x y, pi.mul_apply _ _ i, }

/-- `function.const` as a `monoid_hom`. -/
@[to_additive "`function.const` as an `add_monoid_hom`.", simps]
def pi.const_monoid_hom (α β : Type*) [mul_one_class β] : β →* (α → β) :=
{ to_fun := function.const α,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

/-- Coercion of a `monoid_hom` into a function is itself a `monoid_hom`.

See also `monoid_hom.eval`. -/
@[to_additive "Coercion of an `add_monoid_hom` into a function is itself a `add_monoid_hom`.

See also `add_monoid_hom.eval`. ", simps]
def monoid_hom.coe_fn (α β : Type*) [mul_one_class α] [comm_monoid β] : (α →* β) →* (α → β) :=
{ to_fun := λ g, g,
  map_one' := rfl,
  map_mul' := λ x y, rfl, }

/-- Monoid homomorphism between the function spaces `I → α` and `I → β`, induced by a monoid
homomorphism `f` between `α` and `β`. -/
@[to_additive "Additive monoid homomorphism between the function spaces `I → α` and `I → β`,
induced by an additive monoid homomorphism `f` between `α` and `β`", simps]
protected def monoid_hom.comp_left {α β : Type*} [mul_one_class α] [mul_one_class β] (f : α →* β)
  (I : Type*) :
  (I → α) →* (I → β) :=
{ to_fun := λ h, f ∘ h,
  map_one' := by ext; simp,
  map_mul' := λ _ _, by ext; simp }

end monoid_hom

section single
variables [decidable_eq I]
open pi

variables (f)

/-- The one-preserving homomorphism including a single value
into a dependent family of values, as functions supported at a point.

This is the `one_hom` version of `pi.mul_single`. -/
@[to_additive zero_hom.single "The zero-preserving homomorphism including a single value
into a dependent family of values, as functions supported at a point.

This is the `zero_hom` version of `pi.single`."]
def one_hom.single [Π i, has_one $ f i] (i : I) : one_hom (f i) (Π i, f i) :=
{ to_fun := mul_single i,
  map_one' := mul_single_one i }

@[simp, to_additive]
lemma one_hom.single_apply [Π i, has_one $ f i] (i : I) (x : f i) :
  one_hom.single f i x = mul_single i x := rfl

/-- The monoid homomorphism including a single monoid into a dependent family of additive monoids,
as functions supported at a point.

This is the `monoid_hom` version of `pi.mul_single`. -/
@[to_additive "The additive monoid homomorphism including a single additive
monoid into a dependent family of additive monoids, as functions supported at a point.

This is the `add_monoid_hom` version of `pi.single`."]
def monoid_hom.single [Π i, mul_one_class $ f i] (i : I) : f i →* Π i, f i :=
{ map_mul' := mul_single_op₂ (λ _, (*)) (λ _, one_mul _) _,
  .. (one_hom.single f i) }

@[simp, to_additive]
lemma monoid_hom.single_apply [Π i, mul_one_class $ f i] (i : I) (x : f i) :
  monoid_hom.single f i x = mul_single i x := rfl

/-- The multiplicative homomorphism including a single `mul_zero_class`
into a dependent family of `mul_zero_class`es, as functions supported at a point.

This is the `mul_hom` version of `pi.single`. -/
@[simps] def mul_hom.single [Π i, mul_zero_class $ f i] (i : I) : (f i) →ₙ* (Π i, f i) :=
{ to_fun := single i,
  map_mul' := pi.single_op₂ (λ _, (*)) (λ _, zero_mul _) _, }

variables {f}

@[to_additive]
lemma pi.mul_single_mul [Π i, mul_one_class $ f i] (i : I) (x y : f i) :
  mul_single i (x * y) = mul_single i x * mul_single i y :=
(monoid_hom.single f i).map_mul x y

@[to_additive]
lemma pi.mul_single_inv [Π i, group $ f i] (i : I) (x : f i) :
  mul_single i (x⁻¹) = (mul_single i x)⁻¹ :=
(monoid_hom.single f i).map_inv x

@[to_additive]
lemma pi.single_div [Π i, group $ f i] (i : I) (x y : f i) :
  mul_single i (x / y) = mul_single i x / mul_single i y :=
(monoid_hom.single f i).map_div x y

lemma pi.single_mul [Π i, mul_zero_class $ f i] (i : I) (x y : f i) :
  single i (x * y) = single i x * single i y :=
(mul_hom.single f i).map_mul x y

/-- The injection into a pi group at different indices commutes.

For injections of commuting elements at the same index, see `commute.map` -/
@[to_additive "The injection into an additive pi group at different indices commutes.

For injections of commuting elements at the same index, see `add_commute.map`"]
lemma pi.mul_single_commute [Π i, mul_one_class $ f i] :
  pairwise (λ i j, ∀ (x : f i) (y : f j), commute (mul_single i x) (mul_single j y)) :=
begin
  intros i j hij x y, ext k,
  by_cases h1 : i = k, { subst h1, simp [hij], },
  by_cases h2 : j = k, { subst h2, simp [hij], },
  simp [h1,  h2],
end

/-- The injection into a pi group with the same values commutes. -/
@[to_additive "The injection into an additive pi group with the same values commutes."]
lemma pi.mul_single_apply_commute [Π i, mul_one_class $ f i] (x : Π i, f i) (i j : I) :
  commute (mul_single i (x i)) (mul_single j (x j)) :=
begin
  obtain rfl | hij := decidable.eq_or_ne i j,
  { refl },
  { exact pi.mul_single_commute _ _ hij _ _, },
end

@[to_additive update_eq_sub_add_single]
lemma pi.update_eq_div_mul_single [Π i, group $ f i] (g : Π (i : I), f i) (x : f i) :
  function.update g i x = g / mul_single i (g i) * mul_single i x :=
begin
  ext j,
  rcases eq_or_ne i j with rfl|h,
  { simp },
  { simp [function.update_noteq h.symm, h] }
end

@[to_additive pi.single_add_single_eq_single_add_single]
lemma pi.mul_single_mul_mul_single_eq_mul_single_mul_mul_single
  {M : Type*} [comm_monoid M] {k l m n : I} {u v : M} (hu : u ≠ 1) (hv : v ≠ 1) :
  mul_single k u * mul_single l v = mul_single m u * mul_single n v ↔
  (k = m ∧ l = n) ∨ (u = v ∧ k = n ∧ l = m) ∨ (u * v = 1 ∧ k = l ∧ m = n) :=
begin
  refine ⟨λ h, _, _⟩,
  { have hk := congr_fun h k,
    have hl := congr_fun h l,
    have hm := (congr_fun h m).symm,
    have hn := (congr_fun h n).symm,
    simp only [mul_apply, mul_single_apply, if_pos rfl] at hk hl hm hn,
    rcases eq_or_ne k m with rfl | hkm,
    { refine or.inl ⟨rfl, not_ne_iff.mp (λ hln, (hv _).elim)⟩,
      rcases eq_or_ne k l with rfl | hkl,
      { rwa [if_neg hln.symm, if_neg hln.symm, one_mul, one_mul] at hn },
      { rwa [if_neg hkl.symm, if_neg hln, one_mul, one_mul] at hl } },
    { rcases eq_or_ne m n with rfl | hmn,
      { rcases eq_or_ne k l with rfl | hkl,
        { rw [if_neg hkm.symm, if_neg hkm.symm, one_mul, if_pos rfl] at hm,
          exact or.inr (or.inr ⟨hm, rfl, rfl⟩) },
        { simpa only [if_neg hkm, if_neg hkl, mul_one] using hk } },
      { rw [if_neg hkm.symm, if_neg hmn, one_mul, mul_one] at hm,
        obtain rfl := (ite_ne_right_iff.mp (ne_of_eq_of_ne hm.symm hu)).1,
        rw [if_neg hkm, if_neg hkm, one_mul, mul_one] at hk,
        obtain rfl := (ite_ne_right_iff.mp (ne_of_eq_of_ne hk.symm hu)).1,
        exact or.inr (or.inl ⟨hk.trans (if_pos rfl), rfl, rfl⟩) } } },
  { rintros (⟨rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ | ⟨h, rfl, rfl⟩),
    { refl },
    { apply mul_comm },
    { simp_rw [←pi.mul_single_mul, h, mul_single_one] } },
end

end single

namespace function

@[simp, to_additive]
lemma update_one [Π i, has_one (f i)] [decidable_eq I] (i : I) :
  update (1 : Π i, f i) i 1 = 1 :=
update_eq_self i 1

@[to_additive]
lemma update_mul [Π i, has_mul (f i)] [decidable_eq I]
  (f₁ f₂ : Π i, f i) (i : I) (x₁ : f i) (x₂ : f i) :
  update (f₁ * f₂) i (x₁ * x₂) = update f₁ i x₁ * update f₂ i x₂ :=
funext $ λ j, (apply_update₂ (λ i, (*)) f₁ f₂ i x₁ x₂ j).symm

@[to_additive]
lemma update_inv [Π i, has_inv (f i)] [decidable_eq I]
  (f₁ : Π i, f i) (i : I) (x₁ : f i) :
  update (f₁⁻¹) i (x₁⁻¹) = (update f₁ i x₁)⁻¹ :=
funext $ λ j, (apply_update (λ i, has_inv.inv) f₁ i x₁ j).symm

@[to_additive]
lemma update_div [Π i, has_div (f i)] [decidable_eq I]
  (f₁ f₂ : Π i, f i) (i : I) (x₁ : f i) (x₂ : f i) :
  update (f₁ / f₂) i (x₁ / x₂) = update f₁ i x₁ / update f₂ i x₂ :=
funext $ λ j, (apply_update₂ (λ i, (/)) f₁ f₂ i x₁ x₂ j).symm

end function

section piecewise

@[to_additive]
lemma set.piecewise_mul [Π i, has_mul (f i)] (s : set I) [Π i, decidable (i ∈ s)]
  (f₁ f₂ g₁ g₂ : Π i, f i) :
  s.piecewise (f₁ * f₂) (g₁ * g₂) = s.piecewise f₁ g₁ * s.piecewise f₂ g₂ :=
s.piecewise_op₂ _ _ _ _ (λ _, (*))

@[to_additive]
lemma set.piecewise_inv [Π i, has_inv (f i)] (s : set I) [Π i, decidable (i ∈ s)]
  (f₁ g₁ : Π i, f i) :
  s.piecewise (f₁⁻¹) (g₁⁻¹) = (s.piecewise f₁ g₁)⁻¹ :=
s.piecewise_op f₁ g₁ (λ _ x, x⁻¹)

@[to_additive]
lemma set.piecewise_div [Π i, has_div (f i)] (s : set I) [Π i, decidable (i ∈ s)]
  (f₁ f₂ g₁ g₂ : Π i, f i) :
  s.piecewise (f₁ / f₂) (g₁ / g₂) = s.piecewise f₁ g₁ / s.piecewise f₂ g₂ :=
s.piecewise_op₂ _ _ _ _ (λ _, (/))

end piecewise

section extend

variables {ι : Type u} {η : Type v} (R : Type w) (s : ι → η)

/-- `function.extend s f 1` as a bundled hom. -/
@[to_additive function.extend_by_zero.hom "`function.extend s f 0` as a bundled hom.", simps]
noncomputable def function.extend_by_one.hom [mul_one_class R] : (ι → R) →* (η → R) :=
{ to_fun := λ f, function.extend s f 1,
  map_one' := function.extend_one s,
  map_mul' := λ f g, by { simpa using function.extend_mul s f g 1 1 } }

end extend


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.perm.sign
import data.equiv.option

/-!
# Permutations of `option α`
-/
open equiv

lemma equiv_functor.map_equiv_option_injective {α β : Type*} :
  function.injective (equiv_functor.map_equiv option : α ≃ β → option α ≃ option β) :=
equiv_functor.map_equiv.injective option option.some_injective

@[simp] lemma equiv_functor.option.map_none {α β : Type*} (e : α ≃ β) :
  equiv_functor.map e none = none :=
by simp [equiv_functor.map]

@[simp] lemma map_equiv_option_one {α : Type*} : equiv_functor.map_equiv option (1 : perm α) = 1 :=
by {ext, simp [equiv_functor.map_equiv, equiv_functor.map] }

@[simp] lemma map_equiv_option_refl {α : Type*} :
  equiv_functor.map_equiv option (equiv.refl α) = 1 := map_equiv_option_one

@[simp] lemma map_equiv_option_swap {α : Type*} [decidable_eq α] (x y : α) :
  equiv_functor.map_equiv option (swap x y) = swap (some x) (some y) :=
begin
  ext (_ | i),
  { simp [swap_apply_of_ne_of_ne] },
  { by_cases hx : i = x;
    by_cases hy : i = y;
    simp [hx, hy, swap_apply_of_ne_of_ne, equiv_functor.map] }
end

@[simp] lemma equiv_functor.option.sign {α : Type*} [decidable_eq α] [fintype α] (e : perm α) :
  perm.sign (equiv_functor.map_equiv option e) = perm.sign e :=
begin
  apply perm.swap_induction_on e,
  { simp [perm.one_def] },
  { intros f x y hne h,
    simp [h, hne, perm.mul_def, ←equiv_functor.map_equiv_trans] }
end

@[simp] lemma map_equiv_remove_none {α : Type*} [decidable_eq α] (σ : perm (option α)) :
  equiv_functor.map_equiv option (remove_none σ) = swap none (σ none) * σ :=
begin
  ext1 x,
  have : option.map ⇑(remove_none σ) x = (swap none (σ none)) (σ x),
  { cases x,
    { simp },
    { cases h : σ (some x),
      { simp [remove_none_none _ h], },
      { have hn : σ (some x) ≠ none := by simp [h],
        have hσn : σ (some x) ≠ σ none := σ.injective.ne (by simp),
        simp [remove_none_some _ ⟨_, h⟩, ←h, swap_apply_of_ne_of_ne hn hσn] } } },
  simpa using this,
end

/-- Permutations of `option α` are equivalent to fixing an
`option α` and permuting the remaining with a `perm α`.
The fixed `option α` is swapped with `none`. -/
@[simps] def equiv.perm.decompose_option {α : Type*} [decidable_eq α] :
  perm (option α) ≃ option α × perm α :=
{ to_fun := λ σ, (σ none, remove_none σ),
  inv_fun := λ i, swap none i.1 * (equiv_functor.map_equiv option i.2),
  left_inv := λ σ, by simp,
  right_inv := λ ⟨x, σ⟩, begin
    have : remove_none (swap none x * equiv_functor.map_equiv option σ) = σ :=
      equiv_functor.map_equiv_option_injective (by simp [←mul_assoc, equiv_functor.map]),
    simp [←perm.eq_inv_iff_eq, equiv_functor.map, this],
  end }

lemma equiv.perm.decompose_option_symm_of_none_apply {α : Type*} [decidable_eq α]
  (e : perm α) (i : option α) :
  equiv.perm.decompose_option.symm (none, e) i = i.map e :=
by simp [equiv_functor.map]

lemma equiv.perm.decompose_option_symm_sign {α : Type*} [decidable_eq α] [fintype α] (e : perm α) :
  perm.sign (equiv.perm.decompose_option.symm (none, e)) = perm.sign e :=
by simp

/-- The set of all permutations of `option α` can be constructed by augmenting the set of
permutations of `α` by each element of `option α` in turn. -/
lemma finset.univ_perm_option {α : Type*} [decidable_eq α] [fintype α] :
  @finset.univ (perm $ option α) _ =
    (finset.univ : finset $ option α × perm α).map equiv.perm.decompose_option.symm.to_embedding :=
(finset.univ_map_equiv_to_embedding _).symm


/-
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.smul
! leanprover-community/mathlib commit b685f506164f8d17a6404048bc4d696739c5d976
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Module.Basic
import Mathlib.Data.Set.Pairwise.Lattice
import Mathlib.Data.Set.Pointwise.Basic
import Mathlib.Tactic.ByContra

/-!
# Pointwise operations of sets

This file defines pointwise algebraic operations on sets.

## Main declarations

For sets `s` and `t` and scalar `a`:
* `s • t`: Scalar multiplication, set of all `x • y` where `x ∈ s` and `y ∈ t`.
* `s +ᵥ t`: Scalar addition, set of all `x +ᵥ y` where `x ∈ s` and `y ∈ t`.
* `s -ᵥ t`: Scalar subtraction, set of all `x -ᵥ y` where `x ∈ s` and `y ∈ t`.
* `a • s`: Scaling, set of all `a • x` where `x ∈ s`.
* `a +ᵥ s`: Translation, set of all `a +ᵥ x` where `x ∈ s`.

For `α` a semigroup/monoid, `Set α` is a semigroup/monoid.

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

## Implementation notes

* 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`.

-/

open Function

variable {F α β γ : Type _}

namespace Set

open Pointwise

/-! ### Translation/scaling of sets -/

section SMul

/-- The dilation of set `x • s` is defined as `{x • y | y ∈ s}` in locale `Pointwise`. -/
@[to_additive
      "The translation of set `x +ᵥ s` is defined as `{x +ᵥ y | y ∈ s}` in
      locale `Pointwise`."]
protected def smulSet [SMul α β] : SMul α (Set β) :=
  ⟨fun a ↦ image (a • .)⟩
#align set.has_smul_set Set.smulSet
#align set.has_vadd_set Set.vaddSet

/-- The pointwise scalar multiplication of sets `s • t` is defined as `{x • y | x ∈ s, y ∈ t}` in
locale `Pointwise`. -/
@[to_additive
      "The pointwise scalar addition of sets `s +ᵥ t` is defined as
      `{x +ᵥ y | x ∈ s, y ∈ t}` in locale `Pointwise`."]
protected def smul [SMul α β] : SMul (Set α) (Set β) :=
  ⟨image2 (. • .)⟩
#align set.has_smul Set.smul
#align set.has_vadd Set.vadd

scoped[Pointwise] attribute [instance] Set.smulSet Set.smul

scoped[Pointwise] attribute [instance] Set.vaddSet Set.vadd

section SMul

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

/- Porting note: Could `@[simp, to_additive]` be automatically changed to
`@[to_additive (attr := simp)]`?
-/
@[to_additive (attr := simp)]
theorem image2_smul : image2 SMul.smul s t = s • t :=
  rfl
#align set.image2_smul Set.image2_smul
#align set.image2_vadd Set.image2_vadd

-- @[to_additive add_image_prod] -- Porting note: bug in mathlib3
theorem image_smul_prod : (fun x : α × β ↦ x.fst • x.snd) '' s ×ˢ t = s • t :=
  image_prod _
#align set.image_smul_prod Set.image_smul_prod

@[to_additive]
theorem mem_smul : b ∈ s • t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x • y = b :=
  Iff.rfl
#align set.mem_smul Set.mem_smul
#align set.mem_vadd Set.mem_vadd

@[to_additive]
theorem smul_mem_smul : a ∈ s → b ∈ t → a • b ∈ s • t :=
  mem_image2_of_mem
#align set.smul_mem_smul Set.smul_mem_smul
#align set.vadd_mem_vadd Set.vadd_mem_vadd

@[to_additive (attr := simp)]
theorem empty_smul : (∅ : Set α) • t = ∅ :=
  image2_empty_left
#align set.empty_smul Set.empty_smul
#align set.empty_vadd Set.empty_vadd

@[to_additive (attr := simp)]
theorem smul_empty : s • (∅ : Set β) = ∅ :=
  image2_empty_right
#align set.smul_empty Set.smul_empty
#align set.vadd_empty Set.vadd_empty

@[to_additive (attr := simp)]
theorem smul_eq_empty : s • t = ∅ ↔ s = ∅ ∨ t = ∅ :=
  image2_eq_empty_iff
#align set.smul_eq_empty Set.smul_eq_empty
#align set.vadd_eq_empty Set.vadd_eq_empty

@[to_additive (attr := simp)]
theorem smul_nonempty : (s • t).Nonempty ↔ s.Nonempty ∧ t.Nonempty :=
  image2_nonempty_iff
#align set.smul_nonempty Set.smul_nonempty
#align set.vadd_nonempty Set.vadd_nonempty

@[to_additive]
theorem Nonempty.smul : s.Nonempty → t.Nonempty → (s • t).Nonempty :=
  Nonempty.image2
#align set.nonempty.smul Set.Nonempty.smul
#align set.nonempty.vadd Set.Nonempty.vadd

@[to_additive]
theorem Nonempty.of_smul_left : (s • t).Nonempty → s.Nonempty :=
  Nonempty.of_image2_left
#align set.nonempty.of_smul_left Set.Nonempty.of_smul_left
#align set.nonempty.of_vadd_left Set.Nonempty.of_vadd_left

@[to_additive]
theorem Nonempty.of_smul_right : (s • t).Nonempty → t.Nonempty :=
  Nonempty.of_image2_right
#align set.nonempty.of_smul_right Set.Nonempty.of_smul_right
#align set.nonempty.of_vadd_right Set.Nonempty.of_vadd_right

@[to_additive (attr := simp low+1)]
theorem smul_singleton : s • ({b} : Set β) = (· • b) '' s :=
  image2_singleton_right
#align set.smul_singleton Set.smul_singleton
#align set.vadd_singleton Set.vadd_singleton

@[to_additive (attr := simp low+1)]
theorem singleton_smul : ({a} : Set α) • t = a • t :=
  image2_singleton_left
#align set.singleton_smul Set.singleton_smul
#align set.singleton_vadd Set.singleton_vadd

@[to_additive (attr := simp high)]
theorem singleton_smul_singleton : ({a} : Set α) • ({b} : Set β) = {a • b} :=
  image2_singleton
#align set.singleton_smul_singleton Set.singleton_smul_singleton
#align set.singleton_vadd_singleton Set.singleton_vadd_singleton

@[to_additive (attr := mono)]
theorem smul_subset_smul : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ • t₁ ⊆ s₂ • t₂ :=
  image2_subset
#align set.smul_subset_smul Set.smul_subset_smul
#align set.vadd_subset_vadd Set.vadd_subset_vadd

@[to_additive]
theorem smul_subset_smul_left : t₁ ⊆ t₂ → s • t₁ ⊆ s • t₂ :=
  image2_subset_left
#align set.smul_subset_smul_left Set.smul_subset_smul_left
#align set.vadd_subset_vadd_left Set.vadd_subset_vadd_left

@[to_additive]
theorem smul_subset_smul_right : s₁ ⊆ s₂ → s₁ • t ⊆ s₂ • t :=
  image2_subset_right
#align set.smul_subset_smul_right Set.smul_subset_smul_right
#align set.vadd_subset_vadd_right Set.vadd_subset_vadd_right

@[to_additive]
theorem smul_subset_iff : s • t ⊆ u ↔ ∀ a ∈ s, ∀ b ∈ t, a • b ∈ u :=
  image2_subset_iff
#align set.smul_subset_iff Set.smul_subset_iff
#align set.vadd_subset_iff Set.vadd_subset_iff

@[to_additive]
theorem union_smul : (s₁ ∪ s₂) • t = s₁ • t ∪ s₂ • t :=
  image2_union_left
#align set.union_smul Set.union_smul
#align set.union_vadd Set.union_vadd

@[to_additive]
theorem smul_union : s • (t₁ ∪ t₂) = s • t₁ ∪ s • t₂ :=
  image2_union_right
#align set.smul_union Set.smul_union
#align set.vadd_union Set.vadd_union

@[to_additive]
theorem inter_smul_subset : (s₁ ∩ s₂) • t ⊆ s₁ • t ∩ s₂ • t :=
  image2_inter_subset_left
#align set.inter_smul_subset Set.inter_smul_subset
#align set.inter_vadd_subset Set.inter_vadd_subset

@[to_additive]
theorem smul_inter_subset : s • (t₁ ∩ t₂) ⊆ s • t₁ ∩ s • t₂ :=
  image2_inter_subset_right
#align set.smul_inter_subset Set.smul_inter_subset
#align set.vadd_inter_subset Set.vadd_inter_subset

@[to_additive]
theorem unionᵢ_smul_left_image : (⋃ a ∈ s, a • t) = s • t :=
  unionᵢ_image_left _
#align set.Union_smul_left_image Set.unionᵢ_smul_left_image
#align set.Union_vadd_left_image Set.unionᵢ_vadd_left_image

@[to_additive]
theorem unionᵢ_smul_right_image : (⋃ a ∈ t, (· • a) '' s) = s • t :=
  unionᵢ_image_right _
#align set.Union_smul_right_image Set.unionᵢ_smul_right_image
#align set.Union_vadd_right_image Set.unionᵢ_vadd_right_image

@[to_additive]
theorem unionᵢ_smul (s : ι → Set α) (t : Set β) : (⋃ i, s i) • t = ⋃ i, s i • t :=
  image2_unionᵢ_left _ _ _
#align set.Union_smul Set.unionᵢ_smul
#align set.Union_vadd Set.unionᵢ_vadd

@[to_additive]
theorem smul_unionᵢ (s : Set α) (t : ι → Set β) : (s • ⋃ i, t i) = ⋃ i, s • t i :=
  image2_unionᵢ_right _ _ _
#align set.smul_Union Set.smul_unionᵢ
#align set.vadd_Union Set.vadd_unionᵢ

@[to_additive]
theorem unionᵢ₂_smul (s : ∀ i, κ i → Set α) (t : Set β) :
    (⋃ (i) (j), s i j) • t = ⋃ (i) (j), s i j • t :=
  image2_unionᵢ₂_left _ _ _
#align set.Union₂_smul Set.unionᵢ₂_smul
#align set.Union₂_vadd Set.unionᵢ₂_vadd

@[to_additive]
theorem smul_unionᵢ₂ (s : Set α) (t : ∀ i, κ i → Set β) :
    (s • ⋃ (i) (j), t i j) = ⋃ (i) (j), s • t i j :=
  image2_unionᵢ₂_right _ _ _
#align set.smul_Union₂ Set.smul_unionᵢ₂
#align set.vadd_Union₂ Set.vadd_unionᵢ₂

@[to_additive]
theorem interᵢ_smul_subset (s : ι → Set α) (t : Set β) : (⋂ i, s i) • t ⊆ ⋂ i, s i • t :=
  image2_interᵢ_subset_left _ _ _
#align set.Inter_smul_subset Set.interᵢ_smul_subset
#align set.Inter_vadd_subset Set.interᵢ_vadd_subset

@[to_additive]
theorem smul_interᵢ_subset (s : Set α) (t : ι → Set β) : (s • ⋂ i, t i) ⊆ ⋂ i, s • t i :=
  image2_interᵢ_subset_right _ _ _
#align set.smul_Inter_subset Set.smul_interᵢ_subset
#align set.vadd_Inter_subset Set.vadd_interᵢ_subset

@[to_additive]
theorem interᵢ₂_smul_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₂_smul_subset Set.interᵢ₂_smul_subset
#align set.Inter₂_vadd_subset Set.interᵢ₂_vadd_subset

@[to_additive]
theorem smul_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.smul_Inter₂_subset Set.smul_interᵢ₂_subset
#align set.vadd_Inter₂_subset Set.vadd_interᵢ₂_subset

@[to_additive (attr := simp)]
theorem unionᵢ_smul_set (s : Set α) (t : Set β) : (⋃ a ∈ s, a • t) = s • t :=
  unionᵢ_image_left _
#align set.bUnion_smul_set Set.unionᵢ_smul_set
#align set.bUnion_vadd_set Set.unionᵢ_vadd_set

end SMul

section SMulSet

variable {ι : Sort _} {κ : ι → Sort _} [SMul α β] {s t t₁ t₂ : Set β} {a : α} {b : β} {x y : β}

@[to_additive (attr := simp)]
theorem image_smul : (fun x ↦ a • x) '' t = a • t :=
  rfl
#align set.image_smul Set.image_smul
#align set.image_vadd Set.image_vadd

@[to_additive]
theorem mem_smul_set : x ∈ a • t ↔ ∃ y, y ∈ t ∧ a • y = x :=
  Iff.rfl
#align set.mem_smul_set Set.mem_smul_set
#align set.mem_vadd_set Set.mem_vadd_set

@[to_additive]
theorem smul_mem_smul_set : b ∈ s → a • b ∈ a • s :=
  mem_image_of_mem _
#align set.smul_mem_smul_set Set.smul_mem_smul_set
#align set.vadd_mem_vadd_set Set.vadd_mem_vadd_set

@[to_additive (attr := simp)]
theorem smul_set_empty : a • (∅ : Set β) = ∅ :=
  image_empty _
#align set.smul_set_empty Set.smul_set_empty
#align set.vadd_set_empty Set.vadd_set_empty

@[to_additive (attr := simp)]
theorem smul_set_eq_empty : a • s = ∅ ↔ s = ∅ :=
  image_eq_empty
#align set.smul_set_eq_empty Set.smul_set_eq_empty
#align set.vadd_set_eq_empty Set.vadd_set_eq_empty

@[to_additive (attr := simp)]
theorem smul_set_nonempty : (a • s).Nonempty ↔ s.Nonempty :=
  nonempty_image_iff
#align set.smul_set_nonempty Set.smul_set_nonempty
#align set.vadd_set_nonempty Set.vadd_set_nonempty

@[to_additive (attr := simp)]
theorem smul_set_singleton : a • ({b} : Set β) = {a • b} :=
  image_singleton
#align set.smul_set_singleton Set.smul_set_singleton
#align set.vadd_set_singleton Set.vadd_set_singleton

@[to_additive]
theorem smul_set_mono : s ⊆ t → a • s ⊆ a • t :=
  image_subset _
#align set.smul_set_mono Set.smul_set_mono
#align set.vadd_set_mono Set.vadd_set_mono

@[to_additive]
theorem smul_set_subset_iff : a • s ⊆ t ↔ ∀ ⦃b⦄, b ∈ s → a • b ∈ t :=
  image_subset_iff
#align set.smul_set_subset_iff Set.smul_set_subset_iff
#align set.vadd_set_subset_iff Set.vadd_set_subset_iff

@[to_additive]
theorem smul_set_union : a • (t₁ ∪ t₂) = a • t₁ ∪ a • t₂ :=
  image_union _ _ _
#align set.smul_set_union Set.smul_set_union
#align set.vadd_set_union Set.vadd_set_union

@[to_additive]
theorem smul_set_inter_subset : a • (t₁ ∩ t₂) ⊆ a • t₁ ∩ a • t₂ :=
  image_inter_subset _ _ _
#align set.smul_set_inter_subset Set.smul_set_inter_subset
#align set.vadd_set_inter_subset Set.vadd_set_inter_subset

@[to_additive]
theorem smul_set_Union (a : α) (s : ι → Set β) : (a • ⋃ i, s i) = ⋃ i, a • s i :=
  image_unionᵢ
#align set.smul_set_Union Set.smul_set_Union
#align set.vadd_set_Union Set.vadd_set_Union

@[to_additive]
theorem smul_set_unionᵢ₂ (a : α) (s : ∀ i, κ i → Set β) :
    (a • ⋃ (i) (j), s i j) = ⋃ (i) (j), a • s i j :=
  image_unionᵢ₂ _ _
#align set.smul_set_Union₂ Set.smul_set_unionᵢ₂
#align set.vadd_set_Union₂ Set.vadd_set_unionᵢ₂

@[to_additive]
theorem smul_set_interᵢ_subset (a : α) (t : ι → Set β) : (a • ⋂ i, t i) ⊆ ⋂ i, a • t i :=
  image_interᵢ_subset _ _
#align set.smul_set_Inter_subset Set.smul_set_interᵢ_subset
#align set.vadd_set_Inter_subset Set.vadd_set_interᵢ_subset

@[to_additive]
theorem smul_set_interᵢ₂_subset (a : α) (t : ∀ i, κ i → Set β) :
    (a • ⋂ (i) (j), t i j) ⊆ ⋂ (i) (j), a • t i j :=
  image_interᵢ₂_subset _ _
#align set.smul_set_Inter₂_subset Set.smul_set_interᵢ₂_subset
#align set.vadd_set_Inter₂_subset Set.vadd_set_interᵢ₂_subset

@[to_additive]
theorem Nonempty.smul_set : s.Nonempty → (a • s).Nonempty :=
  Nonempty.image _
#align set.nonempty.smul_set Set.Nonempty.smul_set
#align set.nonempty.vadd_set Set.Nonempty.vadd_set

end SMulSet

variable {s s₁ s₂ : Set α} {t t₁ t₂ : Set β} {a : α} {b : β}

@[to_additive (attr := simp)]
theorem unionᵢ_op_smul_set [Mul α] (s t : Set α) : (⋃ a ∈ t, MulOpposite.op a • s) = s * t :=
  unionᵢ_image_right _
#align set.bUnion_op_smul_set Set.unionᵢ_op_smul_set
#align set.bUnion_op_vadd_set Set.unionᵢ_op_vadd_set

@[to_additive]
theorem range_smul_range {ι κ : Type _} [SMul α β] (b : ι → α) (c : κ → β) :
    range b • range c = range fun p : ι × κ ↦ b p.1 • c p.2 :=
  ext fun _x ↦
    ⟨fun hx ↦
      let ⟨_p, _q, ⟨i, hi⟩, ⟨j, hj⟩, hpq⟩ := Set.mem_smul.1 hx
      ⟨(i, j), hpq ▸ hi ▸ hj ▸ rfl⟩,
      fun ⟨⟨i, j⟩, h⟩ ↦ Set.mem_smul.2 ⟨b i, c j, ⟨i, rfl⟩, ⟨j, rfl⟩, h⟩⟩
#align set.range_smul_range Set.range_smul_range
#align set.range_vadd_range Set.range_vadd_range

@[to_additive]
theorem smul_set_range [SMul α β] {ι : Sort _} {f : ι → β} :
    a • range f = range fun i ↦ a • f i :=
  (range_comp _ _).symm
#align set.smul_set_range Set.smul_set_range
#align set.vadd_set_range Set.vadd_set_range

@[to_additive]
instance smulCommClass_set [SMul α γ] [SMul β γ] [SMulCommClass α β γ] :
    SMulCommClass α β (Set γ) :=
  ⟨fun _ _ ↦ Commute.set_image <| smul_comm _ _⟩
#align set.smul_comm_class_set Set.smulCommClass_set
#align set.vadd_comm_class_set Set.vaddCommClass_set

@[to_additive]
instance smulCommClass_set' [SMul α γ] [SMul β γ] [SMulCommClass α β γ] :
    SMulCommClass α (Set β) (Set γ) :=
  ⟨fun _ _ _ ↦ image_image2_distrib_right <| smul_comm _⟩
#align set.smul_comm_class_set' Set.smulCommClass_set'
#align set.vadd_comm_class_set' Set.vaddCommClass_set'

@[to_additive]
instance smulCommClass_set'' [SMul α γ] [SMul β γ] [SMulCommClass α β γ] :
    SMulCommClass (Set α) β (Set γ) :=
  haveI := SMulCommClass.symm α β γ
  SMulCommClass.symm _ _ _
#align set.smul_comm_class_set'' Set.smulCommClass_set''
#align set.vadd_comm_class_set'' Set.vaddCommClass_set''

@[to_additive]
instance smulCommClass [SMul α γ] [SMul β γ] [SMulCommClass α β γ] :
    SMulCommClass (Set α) (Set β) (Set γ) :=
  ⟨fun _ _ _ ↦ image2_left_comm smul_comm⟩
#align set.smul_comm_class Set.smulCommClass
#align set.vadd_comm_class Set.vaddCommClass

@[to_additive vAddAssocClass]
instance isScalarTower [SMul α β] [SMul α γ] [SMul β γ] [IsScalarTower α β γ] :
    IsScalarTower α β (Set γ) where
  smul_assoc a b T := by simp only [← image_smul, image_image, smul_assoc]
#align set.is_scalar_tower Set.isScalarTower
#align set.vadd_assoc_class Set.vAddAssocClass

@[to_additive vAddAssocClass']
instance isScalarTower' [SMul α β] [SMul α γ] [SMul β γ] [IsScalarTower α β γ] :
    IsScalarTower α (Set β) (Set γ) :=
  ⟨fun _ _ _ ↦ image2_image_left_comm <| smul_assoc _⟩
#align set.is_scalar_tower' Set.isScalarTower'
#align set.vadd_assoc_class' Set.vAddAssocClass'

@[to_additive vAddAssocClass'']
instance isScalarTower'' [SMul α β] [SMul α γ] [SMul β γ] [IsScalarTower α β γ] :
    IsScalarTower (Set α) (Set β) (Set γ) where
  smul_assoc _ _ _ := image2_assoc smul_assoc
#align set.is_scalar_tower'' Set.isScalarTower''
#align set.vadd_assoc_class'' Set.vAddAssocClass''

@[to_additive]
instance isCentralScalar [SMul α β] [SMul αᵐᵒᵖ β] [IsCentralScalar α β] :
    IsCentralScalar α (Set β) :=
  ⟨fun _ S ↦ (congr_arg fun f ↦ f '' S) <| funext fun _ ↦ op_smul_eq_smul _ _⟩
#align set.is_central_scalar Set.isCentralScalar
#align set.is_central_vadd Set.isCentralVAdd

/-- A multiplicative action of a monoid `α` on a type `β` gives a multiplicative action of `Set α`
on `Set β`. -/
@[to_additive
      "An additive action of an additive monoid `α` on a type `β` gives an additive action of
      `Set α` on `Set β`"]
protected def mulAction [Monoid α] [MulAction α β] : MulAction (Set α) (Set β) where
  mul_smul _ _ _ := image2_assoc mul_smul
  one_smul s := image2_singleton_left.trans <| by simp_rw [one_smul, image_id']
#align set.mul_action Set.mulAction
#align set.add_action Set.addAction

/-- A multiplicative action of a monoid on a type `β` gives a multiplicative action on `Set β`. -/
@[to_additive
      "An additive action of an additive monoid on a type `β` gives an additive action on `Set β`."]
protected def mulActionSet [Monoid α] [MulAction α β] : MulAction α (Set β) where
  mul_smul := by
    intros
    simp only [← image_smul, image_image, ← mul_smul]
  one_smul := by
    intros
    simp only [← image_smul, one_smul, image_id']
#align set.mul_action_set Set.mulActionSet
#align set.add_action_set Set.addActionSet

scoped[Pointwise] attribute [instance] Set.mulActionSet Set.addActionSet Set.mulAction Set.addAction

/-- A distributive multiplicative action of a monoid on an additive monoid `β` gives a distributive
multiplicative action on `Set β`. -/
protected def distribMulActionSet [Monoid α] [AddMonoid β] [DistribMulAction α β] :
    DistribMulAction α (Set β) where
  smul_add _ _ _ := image_image2_distrib <| smul_add _
  smul_zero _ := image_singleton.trans <| by rw [smul_zero, singleton_zero]
#align set.distrib_mul_action_set Set.distribMulActionSet

/-- A multiplicative action of a monoid on a monoid `β` gives a multiplicative action on `Set β`. -/
protected def mulDistribMulActionSet [Monoid α] [Monoid β] [MulDistribMulAction α β] :
    MulDistribMulAction α (Set β) where
  smul_mul _ _ _ := image_image2_distrib <| smul_mul' _
  smul_one _ := image_singleton.trans <| by rw [smul_one, singleton_one]
#align set.mul_distrib_mul_action_set Set.mulDistribMulActionSet

scoped[Pointwise] attribute [instance] Set.distribMulActionSet Set.mulDistribMulActionSet

instance [Zero α] [Zero β] [SMul α β] [NoZeroSMulDivisors α β] :
    NoZeroSMulDivisors (Set α) (Set β) :=
  ⟨fun {s t} h ↦ by
    by_contra' H
    have hst : (s • t).Nonempty := h.symm.subst zero_nonempty
    rw [Ne.def, ← hst.of_smul_left.subset_zero_iff, Ne.def,
      ← hst.of_smul_right.subset_zero_iff] at H
    simp only [not_subset, mem_zero] at H
    obtain ⟨⟨a, hs, ha⟩, b, ht, hb⟩ := H
    exact (eq_zero_or_eq_zero_of_smul_eq_zero <| h.subset <| smul_mem_smul hs ht).elim ha hb⟩

instance noZeroSMulDivisors_set [Zero α] [Zero β] [SMul α β] [NoZeroSMulDivisors α β] :
    NoZeroSMulDivisors α (Set β) :=
  ⟨fun {a s} h ↦ by
    by_contra' H
    have hst : (a • s).Nonempty := h.symm.subst zero_nonempty
    rw [Ne.def, Ne.def, ← hst.of_image.subset_zero_iff, not_subset] at H
    obtain ⟨ha, b, ht, hb⟩ := H
    exact (eq_zero_or_eq_zero_of_smul_eq_zero <| h.subset <| smul_mem_smul_set ht).elim ha hb⟩
#align set.no_zero_smul_divisors_set Set.noZeroSMulDivisors_set

instance [Zero α] [Mul α] [NoZeroDivisors α] : NoZeroDivisors (Set α) :=
  ⟨fun h ↦ eq_zero_or_eq_zero_of_smul_eq_zero h⟩

end SMul

section VSub

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

instance vsub : VSub (Set α) (Set β) :=
  ⟨image2 (· -ᵥ ·)⟩
#align set.has_vsub Set.vsub

@[simp]
theorem image2_vsub : (image2 VSub.vsub s t : Set α) = s -ᵥ t :=
  rfl
#align set.image2_vsub Set.image2_vsub

theorem image_vsub_prod : (fun x : β × β ↦ x.fst -ᵥ x.snd) '' s ×ˢ t = s -ᵥ t :=
  image_prod _
#align set.image_vsub_prod Set.image_vsub_prod

theorem mem_vsub : a ∈ s -ᵥ t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x -ᵥ y = a :=
  Iff.rfl
#align set.mem_vsub Set.mem_vsub

theorem vsub_mem_vsub (hb : b ∈ s) (hc : c ∈ t) : b -ᵥ c ∈ s -ᵥ t :=
  mem_image2_of_mem hb hc
#align set.vsub_mem_vsub Set.vsub_mem_vsub

@[simp]
theorem empty_vsub (t : Set β) : ∅ -ᵥ t = ∅ :=
  image2_empty_left
#align set.empty_vsub Set.empty_vsub

@[simp]
theorem vsub_empty (s : Set β) : s -ᵥ ∅ = ∅ :=
  image2_empty_right
#align set.vsub_empty Set.vsub_empty

@[simp]
theorem vsub_eq_empty : s -ᵥ t = ∅ ↔ s = ∅ ∨ t = ∅ :=
  image2_eq_empty_iff
#align set.vsub_eq_empty Set.vsub_eq_empty

@[simp]
theorem vsub_nonempty : (s -ᵥ t : Set α).Nonempty ↔ s.Nonempty ∧ t.Nonempty :=
  image2_nonempty_iff
#align set.vsub_nonempty Set.vsub_nonempty

theorem Nonempty.vsub : s.Nonempty → t.Nonempty → (s -ᵥ t : Set α).Nonempty :=
  Nonempty.image2
#align set.nonempty.vsub Set.Nonempty.vsub

theorem Nonempty.of_vsub_left : (s -ᵥ t : Set α).Nonempty → s.Nonempty :=
  Nonempty.of_image2_left
#align set.nonempty.of_vsub_left Set.Nonempty.of_vsub_left

theorem Nonempty.of_vsub_right : (s -ᵥ t : Set α).Nonempty → t.Nonempty :=
  Nonempty.of_image2_right
#align set.nonempty.of_vsub_right Set.Nonempty.of_vsub_right

@[simp low+1]
theorem vsub_singleton (s : Set β) (b : β) : s -ᵥ {b} = (· -ᵥ b) '' s :=
  image2_singleton_right
#align set.vsub_singleton Set.vsub_singleton

@[simp low+1]
theorem singleton_vsub (t : Set β) (b : β) : {b} -ᵥ t = (· -ᵥ ·) b '' t :=
  image2_singleton_left
#align set.singleton_vsub Set.singleton_vsub

@[simp high]
theorem singleton_vsub_singleton : ({b} : Set β) -ᵥ {c} = {b -ᵥ c} :=
  image2_singleton
#align set.singleton_vsub_singleton Set.singleton_vsub_singleton

@[mono]
theorem vsub_subset_vsub : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ -ᵥ t₁ ⊆ s₂ -ᵥ t₂ :=
  image2_subset
#align set.vsub_subset_vsub Set.vsub_subset_vsub

theorem vsub_subset_vsub_left : t₁ ⊆ t₂ → s -ᵥ t₁ ⊆ s -ᵥ t₂ :=
  image2_subset_left
#align set.vsub_subset_vsub_left Set.vsub_subset_vsub_left

theorem vsub_subset_vsub_right : s₁ ⊆ s₂ → s₁ -ᵥ t ⊆ s₂ -ᵥ t :=
  image2_subset_right
#align set.vsub_subset_vsub_right Set.vsub_subset_vsub_right

theorem vsub_subset_iff : s -ᵥ t ⊆ u ↔ ∀ x ∈ s, ∀ y ∈ t, x -ᵥ y ∈ u :=
  image2_subset_iff
#align set.vsub_subset_iff Set.vsub_subset_iff

theorem vsub_self_mono (h : s ⊆ t) : s -ᵥ s ⊆ t -ᵥ t :=
  vsub_subset_vsub h h
#align set.vsub_self_mono Set.vsub_self_mono

theorem union_vsub : s₁ ∪ s₂ -ᵥ t = s₁ -ᵥ t ∪ (s₂ -ᵥ t) :=
  image2_union_left
#align set.union_vsub Set.union_vsub

theorem vsub_union : s -ᵥ (t₁ ∪ t₂) = s -ᵥ t₁ ∪ (s -ᵥ t₂) :=
  image2_union_right
#align set.vsub_union Set.vsub_union

theorem inter_vsub_subset : s₁ ∩ s₂ -ᵥ t ⊆ (s₁ -ᵥ t) ∩ (s₂ -ᵥ t) :=
  image2_inter_subset_left
#align set.inter_vsub_subset Set.inter_vsub_subset

theorem vsub_inter_subset : s -ᵥ t₁ ∩ t₂ ⊆ (s -ᵥ t₁) ∩ (s -ᵥ t₂) :=
  image2_inter_subset_right
#align set.vsub_inter_subset Set.vsub_inter_subset

theorem unionᵢ_vsub_left_image : (⋃ a ∈ s, (· -ᵥ ·) a '' t) = s -ᵥ t :=
  unionᵢ_image_left _
#align set.Union_vsub_left_image Set.unionᵢ_vsub_left_image

theorem unionᵢ_vsub_right_image : (⋃ a ∈ t, (· -ᵥ a) '' s) = s -ᵥ t :=
  unionᵢ_image_right _
#align set.Union_vsub_right_image Set.unionᵢ_vsub_right_image

theorem unionᵢ_vsub (s : ι → Set β) (t : Set β) : (⋃ i, s i) -ᵥ t = ⋃ i, s i -ᵥ t :=
  image2_unionᵢ_left _ _ _
#align set.Union_vsub Set.unionᵢ_vsub

theorem vsub_unionᵢ (s : Set β) (t : ι → Set β) : (s -ᵥ ⋃ i, t i) = ⋃ i, s -ᵥ t i :=
  image2_unionᵢ_right _ _ _
#align set.vsub_Union Set.vsub_unionᵢ

theorem unionᵢ₂_vsub (s : ∀ i, κ i → Set β) (t : Set β) :
    (⋃ (i) (j), s i j) -ᵥ t = ⋃ (i) (j), s i j -ᵥ t :=
  image2_unionᵢ₂_left _ _ _
#align set.Union₂_vsub Set.unionᵢ₂_vsub

theorem vsub_unionᵢ₂ (s : Set β) (t : ∀ i, κ i → Set β) :
    (s -ᵥ ⋃ (i) (j), t i j) = ⋃ (i) (j), s -ᵥ t i j :=
  image2_unionᵢ₂_right _ _ _
#align set.vsub_Union₂ Set.vsub_unionᵢ₂

theorem interᵢ_vsub_subset (s : ι → Set β) (t : Set β) : (⋂ i, s i) -ᵥ t ⊆ ⋂ i, s i -ᵥ t :=
  image2_interᵢ_subset_left _ _ _
#align set.Inter_vsub_subset Set.interᵢ_vsub_subset

theorem vsub_interᵢ_subset (s : Set β) (t : ι → Set β) : (s -ᵥ ⋂ i, t i) ⊆ ⋂ i, s -ᵥ t i :=
  image2_interᵢ_subset_right _ _ _
#align set.vsub_Inter_subset Set.vsub_interᵢ_subset

theorem interᵢ₂_vsub_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₂_vsub_subset Set.interᵢ₂_vsub_subset

theorem vsub_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.vsub_Inter₂_subset Set.vsub_interᵢ₂_subset

end VSub

open Pointwise

@[to_additive]
theorem image_smul_comm [SMul α β] [SMul α γ] (f : β → γ) (a : α) (s : Set β) :
    (∀ b, f (a • b) = a • f b) → f '' (a • s) = a • f '' s :=
  image_comm
#align set.image_smul_comm Set.image_smul_comm
#align set.image_vadd_comm Set.image_vadd_comm

@[to_additive]
theorem image_smul_distrib [MulOneClass α] [MulOneClass β] [MonoidHomClass F α β] (f : F) (a : α)
    (s : Set α) : f '' (a • s) = f a • f '' s :=
  image_comm <| map_mul _ _
#align set.image_smul_distrib Set.image_smul_distrib
#align set.image_vadd_distrib Set.image_vadd_distrib

section SMulWithZero

variable [Zero α] [Zero β] [SMulWithZero α β] {s : Set α} {t : Set β}

/-!
Note that we have neither `SMulWithZero α (Set β)` nor `SMulWithZero (Set α) (Set β)`
because `0 * ∅ ≠ 0`.
-/

theorem smul_zero_subset (s : Set α) : s • (0 : Set β) ⊆ 0 := by simp [subset_def, mem_smul]
#align set.smul_zero_subset Set.smul_zero_subset

theorem zero_smul_subset (t : Set β) : (0 : Set α) • t ⊆ 0 := by simp [subset_def, mem_smul]
#align set.zero_smul_subset Set.zero_smul_subset

theorem Nonempty.smul_zero (hs : s.Nonempty) : s • (0 : Set β) = 0 :=
  s.smul_zero_subset.antisymm <| by simpa [mem_smul] using hs
#align set.nonempty.smul_zero Set.Nonempty.smul_zero

theorem Nonempty.zero_smul (ht : t.Nonempty) : (0 : Set α) • t = 0 :=
  t.zero_smul_subset.antisymm <| by simpa [mem_smul] using ht
#align set.nonempty.zero_smul Set.Nonempty.zero_smul

/-- A nonempty set is scaled by zero to the singleton set containing 0. -/
theorem zero_smul_set {s : Set β} (h : s.Nonempty) : (0 : α) • s = (0 : Set β) := by
  simp only [← image_smul, image_eta, zero_smul, h.image_const, singleton_zero]
#align set.zero_smul_set Set.zero_smul_set

theorem zero_smul_set_subset (s : Set β) : (0 : α) • s ⊆ 0 :=
  image_subset_iff.2 fun x _ ↦ zero_smul α x
#align set.zero_smul_set_subset Set.zero_smul_set_subset

theorem subsingleton_zero_smul_set (s : Set β) : ((0 : α) • s).Subsingleton :=
  subsingleton_singleton.anti <| zero_smul_set_subset s
#align set.subsingleton_zero_smul_set Set.subsingleton_zero_smul_set

theorem zero_mem_smul_set {t : Set β} {a : α} (h : (0 : β) ∈ t) : (0 : β) ∈ a • t :=
  ⟨0, h, smul_zero _⟩
#align set.zero_mem_smul_set Set.zero_mem_smul_set

variable [NoZeroSMulDivisors α β] {a : α}

theorem zero_mem_smul_iff :
    (0 : β) ∈ s • t ↔ (0 : α) ∈ s ∧ t.Nonempty ∨ (0 : β) ∈ t ∧ s.Nonempty := by
  constructor
  · rintro ⟨a, b, ha, hb, h⟩
    obtain rfl | rfl := eq_zero_or_eq_zero_of_smul_eq_zero h
    · exact Or.inl ⟨ha, b, hb⟩
    · exact Or.inr ⟨hb, a, ha⟩
  · rintro (⟨hs, b, hb⟩ | ⟨ht, a, ha⟩)
    · exact ⟨0, b, hs, hb, zero_smul _ _⟩
    · exact ⟨a, 0, ha, ht, smul_zero _⟩
#align set.zero_mem_smul_iff Set.zero_mem_smul_iff

theorem zero_mem_smul_set_iff (ha : a ≠ 0) : (0 : β) ∈ a • t ↔ (0 : β) ∈ t := by
  refine' ⟨_, zero_mem_smul_set⟩
  rintro ⟨b, hb, h⟩
  rwa [(eq_zero_or_eq_zero_of_smul_eq_zero h).resolve_left ha] at hb
#align set.zero_mem_smul_set_iff Set.zero_mem_smul_set_iff

end SMulWithZero

section LeftCancelSemigroup

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

@[to_additive]
theorem pairwiseDisjoint_smul_iff :
    s.PairwiseDisjoint (· • t) ↔ (s ×ˢ t).InjOn fun p ↦ p.1 * p.2 :=
  pairwiseDisjoint_image_right_iff fun _ _ ↦ mul_right_injective _
#align set.pairwise_disjoint_smul_iff Set.pairwiseDisjoint_smul_iff
#align set.pairwise_disjoint_vadd_iff Set.pairwiseDisjoint_vadd_iff

end LeftCancelSemigroup

section Group

variable [Group α] [MulAction α β] {s t A B : Set β} {a : α} {x : β}

@[to_additive (attr := simp)]
theorem smul_mem_smul_set_iff : a • x ∈ a • s ↔ x ∈ s :=
  (MulAction.injective _).mem_set_image
#align set.smul_mem_smul_set_iff Set.smul_mem_smul_set_iff
#align set.vadd_mem_vadd_set_iff Set.vadd_mem_vadd_set_iff

@[to_additive]
theorem mem_smul_set_iff_inv_smul_mem : x ∈ a • A ↔ a⁻¹ • x ∈ A :=
  show x ∈ MulAction.toPerm a '' A ↔ _ from mem_image_equiv
#align set.mem_smul_set_iff_inv_smul_mem Set.mem_smul_set_iff_inv_smul_mem
#align set.mem_vadd_set_iff_neg_vadd_mem Set.mem_vadd_set_iff_neg_vadd_mem

@[to_additive]
theorem mem_inv_smul_set_iff : x ∈ a⁻¹ • A ↔ a • x ∈ A := by
  simp only [← image_smul, mem_image, inv_smul_eq_iff, exists_eq_right]
#align set.mem_inv_smul_set_iff Set.mem_inv_smul_set_iff
#align set.mem_neg_vadd_set_iff Set.mem_neg_vadd_set_iff

@[to_additive]
theorem preimage_smul (a : α) (t : Set β) : (fun x ↦ a • x) ⁻¹' t = a⁻¹ • t :=
  ((MulAction.toPerm a).symm.image_eq_preimage _).symm
#align set.preimage_smul Set.preimage_smul
#align set.preimage_vadd Set.preimage_vadd

@[to_additive]
theorem preimage_smul_inv (a : α) (t : Set β) : (fun x ↦ a⁻¹ • x) ⁻¹' t = a • t :=
  preimage_smul (toUnits a)⁻¹ t
#align set.preimage_smul_inv Set.preimage_smul_inv
#align set.preimage_vadd_neg Set.preimage_vadd_neg

@[to_additive (attr := simp)]
theorem set_smul_subset_set_smul_iff : a • A ⊆ a • B ↔ A ⊆ B :=
  image_subset_image_iff <| MulAction.injective _
#align set.set_smul_subset_set_smul_iff Set.set_smul_subset_set_smul_iff
#align set.set_vadd_subset_set_vadd_iff Set.set_vadd_subset_set_vadd_iff

@[to_additive]
theorem set_smul_subset_iff : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
  image_subset_iff.trans <|
    iff_of_eq <| congr_arg _ <| preimage_equiv_eq_image_symm _ <| MulAction.toPerm _
#align set.set_smul_subset_iff Set.set_smul_subset_iff
#align set.set_vadd_subset_iff Set.set_vadd_subset_iff

@[to_additive]
theorem subset_set_smul_iff : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
  Iff.symm <|
    image_subset_iff.trans <|
      Iff.symm <| iff_of_eq <| congr_arg _ <| image_equiv_eq_preimage_symm _ <| MulAction.toPerm _
#align set.subset_set_smul_iff Set.subset_set_smul_iff
#align set.subset_set_vadd_iff Set.subset_set_vadd_iff

@[to_additive]
theorem smul_set_inter : a • (s ∩ t) = a • s ∩ a • t :=
  image_inter <| MulAction.injective a
#align set.smul_set_inter Set.smul_set_inter
#align set.vadd_set_inter Set.vadd_set_inter

@[to_additive]
theorem smul_set_sdiff : a • (s \ t) = a • s \ a • t :=
  image_diff (MulAction.injective a) _ _
#align set.smul_set_sdiff Set.smul_set_sdiff
#align set.vadd_set_sdiff Set.vadd_set_sdiff

@[to_additive]
theorem smul_set_symm_diff : a • s ∆ t = (a • s) ∆ (a • t) :=
  image_symm_diff (MulAction.injective a) _ _
#align set.smul_set_symm_diff Set.smul_set_symm_diff
#align set.vadd_set_symm_diff Set.vadd_set_symm_diff

@[to_additive (attr := simp)]
theorem smul_set_univ : a • (univ : Set β) = univ :=
  image_univ_of_surjective <| MulAction.surjective a
#align set.smul_set_univ Set.smul_set_univ
#align set.vadd_set_univ Set.vadd_set_univ

@[to_additive (attr := simp)]
theorem smul_univ {s : Set α} (hs : s.Nonempty) : s • (univ : Set β) = univ :=
  let ⟨a, ha⟩ := hs
  eq_univ_of_forall fun b ↦ ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul _ _⟩
#align set.smul_univ Set.smul_univ
#align set.vadd_univ Set.vadd_univ

@[to_additive]
theorem smul_inter_ne_empty_iff {s t : Set α} {x : α} :
    x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ t ∧ b ∈ s) ∧ a * b⁻¹ = x := by
  rw [← nonempty_iff_ne_empty]
  constructor
  · rintro ⟨a, h, ha⟩
    obtain ⟨b, hb, rfl⟩ := mem_smul_set.mp h
    exact ⟨x • b, b, ⟨ha, hb⟩, by simp⟩
  · rintro ⟨a, b, ⟨ha, hb⟩, rfl⟩
    exact ⟨a, mem_inter (mem_smul_set.mpr ⟨b, hb, by simp⟩) ha⟩
#align set.smul_inter_ne_empty_iff Set.smul_inter_ne_empty_iff
#align set.vadd_inter_ne_empty_iff Set.vadd_inter_ne_empty_iff

@[to_additive]
theorem smul_inter_ne_empty_iff' {s t : Set α} {x : α} :
    x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ t ∧ b ∈ s) ∧ a / b = x := by
  simp_rw [smul_inter_ne_empty_iff, div_eq_mul_inv]
#align set.smul_inter_ne_empty_iff' Set.smul_inter_ne_empty_iff'
#align set.vadd_inter_ne_empty_iff' Set.vadd_inter_ne_empty_iff'

@[to_additive]
theorem op_smul_inter_ne_empty_iff {s t : Set α} {x : αᵐᵒᵖ} :
    x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ s ∧ b ∈ t) ∧ a⁻¹ * b = MulOpposite.unop x := by
  rw [← nonempty_iff_ne_empty]
  constructor
  · rintro ⟨a, h, ha⟩
    obtain ⟨b, hb, rfl⟩ := mem_smul_set.mp h
    exact ⟨b, x • b, ⟨hb, ha⟩, by simp⟩
  · rintro ⟨a, b, ⟨ha, hb⟩, H⟩
    have : MulOpposite.op (a⁻¹ * b) = x := congr_arg MulOpposite.op H
    exact ⟨b, mem_inter (mem_smul_set.mpr ⟨a, ha, by simp [← this]⟩) hb⟩
#align set.op_smul_inter_ne_empty_iff Set.op_smul_inter_ne_empty_iff
#align set.op_vadd_inter_ne_empty_iff Set.op_vadd_inter_ne_empty_iff

@[to_additive (attr := simp)]
theorem unionᵢ_inv_smul : (⋃ g : α, g⁻¹ • s) = ⋃ g : α, g • s :=
  (Function.Surjective.supᵢ_congr _ inv_surjective) fun _ ↦ rfl
#align set.Union_inv_smul Set.unionᵢ_inv_smul
#align set.Union_neg_vadd Set.unionᵢ_neg_vadd

@[to_additive]
theorem unionᵢ_smul_eq_setOf_exists {s : Set β} : (⋃ g : α, g • s) = { a | ∃ g : α, g • a ∈ s } :=
  by simp_rw [← unionᵢ_setOf, ← unionᵢ_inv_smul, ← preimage_smul, preimage]
#align set.Union_smul_eq_set_of_exists Set.unionᵢ_smul_eq_setOf_exists
#align set.Union_vadd_eq_set_of_exists Set.unionᵢ_vadd_eq_setOf_exists

end Group

section GroupWithZero

variable [GroupWithZero α] [MulAction α β] {s t : Set β} {a : α}

@[simp]
theorem smul_mem_smul_set_iff₀ (ha : a ≠ 0) (A : Set β) (x : β) : a • x ∈ a • A ↔ x ∈ A :=
  show Units.mk0 a ha • _ ∈ _ ↔ _ from smul_mem_smul_set_iff
#align set.smul_mem_smul_set_iff₀ Set.smul_mem_smul_set_iff₀

theorem mem_smul_set_iff_inv_smul_mem₀ (ha : a ≠ 0) (A : Set β) (x : β) : x ∈ a • A ↔ a⁻¹ • x ∈ A :=
  show _ ∈ Units.mk0 a ha • _ ↔ _ from mem_smul_set_iff_inv_smul_mem
#align set.mem_smul_set_iff_inv_smul_mem₀ Set.mem_smul_set_iff_inv_smul_mem₀

theorem mem_inv_smul_set_iff₀ (ha : a ≠ 0) (A : Set β) (x : β) : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
  show _ ∈ (Units.mk0 a ha)⁻¹ • _ ↔ _ from mem_inv_smul_set_iff
#align set.mem_inv_smul_set_iff₀ Set.mem_inv_smul_set_iff₀

theorem preimage_smul₀ (ha : a ≠ 0) (t : Set β) : (fun x ↦ a • x) ⁻¹' t = a⁻¹ • t :=
  preimage_smul (Units.mk0 a ha) t
#align set.preimage_smul₀ Set.preimage_smul₀

theorem preimage_smul_inv₀ (ha : a ≠ 0) (t : Set β) : (fun x ↦ a⁻¹ • x) ⁻¹' t = a • t :=
  preimage_smul (Units.mk0 a ha)⁻¹ t
#align set.preimage_smul_inv₀ Set.preimage_smul_inv₀

@[simp]
theorem set_smul_subset_set_smul_iff₀ (ha : a ≠ 0) {A B : Set β} : a • A ⊆ a • B ↔ A ⊆ B :=
  show Units.mk0 a ha • _ ⊆ _ ↔ _ from set_smul_subset_set_smul_iff
#align set.set_smul_subset_set_smul_iff₀ Set.set_smul_subset_set_smul_iff₀

theorem set_smul_subset_iff₀ (ha : a ≠ 0) {A B : Set β} : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
  show Units.mk0 a ha • _ ⊆ _ ↔ _ from set_smul_subset_iff
#align set.set_smul_subset_iff₀ Set.set_smul_subset_iff₀

theorem subset_set_smul_iff₀ (ha : a ≠ 0) {A B : Set β} : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
  show _ ⊆ Units.mk0 a ha • _ ↔ _ from subset_set_smul_iff
#align set.subset_set_smul_iff₀ Set.subset_set_smul_iff₀

theorem smul_set_inter₀ (ha : a ≠ 0) : a • (s ∩ t) = a • s ∩ a • t :=
  show Units.mk0 a ha • _ = _ from smul_set_inter
#align set.smul_set_inter₀ Set.smul_set_inter₀

theorem smul_set_sdiff₀ (ha : a ≠ 0) : a • (s \ t) = a • s \ a • t :=
  image_diff (MulAction.injective₀ ha) _ _
#align set.smul_set_sdiff₀ Set.smul_set_sdiff₀

theorem smul_set_symm_diff₀ (ha : a ≠ 0) : a • s ∆ t = (a • s) ∆ (a • t) :=
  image_symm_diff (MulAction.injective₀ ha) _ _
#align set.smul_set_symm_diff₀ Set.smul_set_symm_diff₀

theorem smul_set_univ₀ (ha : a ≠ 0) : a • (univ : Set β) = univ :=
  image_univ_of_surjective <| MulAction.surjective₀ ha
#align set.smul_set_univ₀ Set.smul_set_univ₀

theorem smul_univ₀' {s : Set α} (hs : s.Nontrivial) : s • (univ : Set β) = univ :=
  smul_univ₀ hs.not_subset_singleton
#align set.smul_univ₀' Set.smul_univ₀'

end GroupWithZero

section Monoid

variable [Monoid α] [AddGroup β] [DistribMulAction α β] (a : α) (s : Set α) (t : Set β)

@[simp]
theorem smul_set_neg : a • -t = -(a • t) := by
  simp_rw [← image_smul, ← image_neg, image_image, smul_neg]
#align set.smul_set_neg Set.smul_set_neg

@[simp]
protected theorem smul_neg : s • -t = -(s • t) := by
  simp_rw [← image_neg]
  exact image_image2_right_comm smul_neg
#align set.smul_neg Set.smul_neg

end Monoid

section Ring

variable [Ring α] [AddCommGroup β] [Module α β] (a : α) (s : Set α) (t : Set β)

@[simp]
theorem neg_smul_set : -a • t = -(a • t) := by
  simp_rw [← image_smul, ← image_neg, image_image, neg_smul]
#align set.neg_smul_set Set.neg_smul_set

@[simp]
protected theorem neg_smul : -s • t = -(s • t) := by
  simp_rw [← image_neg]
  exact image2_image_left_comm neg_smul
#align set.neg_smul Set.neg_smul

end Ring

end Set


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import topology.basic
import topology.order
import topology.constructions
import topology.bases
import data.set.countable
import formal_ml.set

import topology.instances.nnreal
import topology.instances.ennreal
import formal_ml.topological_space
import formal_ml.nat
import formal_ml.int

/-
  This has several results related to the discrete topology (or bottom
  topology). In this topology, every set is open. In order to
  prove that every set is open, it is sufficient to prove every
  singleton set is open (see discrete_bottom_topological_space).
  Moreover, the discrete topologies on the naturals and the integers
  are also order topologies.
 -/
lemma topological_space.bot_is_open_def {α:Type*}:(@topological_space.is_open α ⊥) = (λ S:set α, true) := rfl

lemma topological_space.bot_is_open {α:Type*} {U:set α}:topological_space.is_open ⊥ U :=
begin
  rw topological_space.bot_is_open_def,
  apply true.intro,
end

lemma set.sUnion_of_element_singletons {α:Type*} {U:set α}:
    U = ⋃₀ {V:set α|∃ a∈ U, V={a}} :=
begin
      simp,
      ext,split;intros D1A,
      {
        simp,
        apply exists.intro {x},
        split,
        apply exists.intro x,
        split,
        apply D1A,
        refl,
        simp,
      },
      {
        simp at D1A,
        cases D1A with V D1A,
        cases D1A with D1A D1B,
        cases D1A with a D1A,
        cases D1A with D1A D1C,
        subst V,
        simp at D1B,
        subst x,
        apply D1A,
      },
end

lemma discrete_bottom_topological_space {α:Type*} {T:topological_space α}:(∀ a:α, @is_open α T {a}) →
    T = ⊥ :=
begin
  intro A1,
  ext U,split;intros B1,
  {
    apply topological_space.bot_is_open,
  },
  {
    rw @set.sUnion_of_element_singletons α U,
    apply is_open_sUnion,
    intros V D2,
    simp at D2,
    cases D2 with a D2,
    cases D2 with D2 D3,
    subst V,
    apply A1,
  },
end

instance nat.order_topology:order_topology ℕ  :=
begin
  apply order_topology.mk,
  have A1:nat.topological_space = ⊥ := rfl,
  symmetry,
  apply discrete_bottom_topological_space,
  intro a,
  unfold topological_space.generate_from topological_space.is_open is_open,
  cases a,
  {
    apply topological_space.generate_open.basic,
    simp,
    apply exists.intro 1,
    right,
    ext;split;intros B1;simp;simp at B1,
    {
      subst x,
       apply zero_lt_one,
    },
    {
     apply nat.zero_of_lt_one B1,
    },
  },
  {
    have C1:{a.succ}=set.Iio (a.succ.succ) ∩ set.Ioi a,
    {
      ext;split;intros C1A;simp;simp at C1A,
      {
        subst x,
        split,
        apply lt_succ,
        apply lt_succ,
      },
      {
        cases C1A with C1A C1B,
        apply le_antisymm,
        {
          apply nat.le_of_lt_succ C1A,
        },
        {
          rw nat.succ_le_iff,
          apply C1B,
        },
      },
    },
    rw C1,
    apply topological_space.generate_open.inter ,
    {
      apply topological_space.generate_open.basic,
      apply exists.intro (a.succ.succ),
      right,
      refl,
    },
    {
      apply topological_space.generate_open.basic,
      apply exists.intro (a),
      left,
      refl,
    },
  },
end

instance int.order_topology:order_topology int :=
begin
  apply order_topology.mk,
  symmetry,
  apply discrete_bottom_topological_space,
  intro a,
  have A1:{a} = set.Ioi a.pred ∩ set.Iio a.succ,
  {
    ext b,split;intros A1A;simp;simp at A1A,
    {
      subst b,
      split,
      apply int.pred_lt_self,
      apply int.lt_succ,
    },
    {
      cases A1A with A1A A1B,
      apply le_antisymm,
      rw int.lt_succ_iff at A1B,
      apply A1B,
      rw int.pred_lt_iff at A1A,
      apply A1A,
    },
  },
  rw A1,
  clear A1,
  apply topological_space.generate_open.inter ,
  {
    apply topological_space.generate_open.basic,
    apply exists.intro (a.pred),
    left,
    refl,
  },
  {
    apply topological_space.generate_open.basic,
    apply exists.intro (a.succ),
    right,
    refl,
  },
end