/- ------------------------------------------------------------------------- -|
| @project: riemann_hypothesis                                                |
| @file:    riemann_zeta.lean                                                 |
| @author:  Brandon H. Gomes and Alex Kontorovich                                                 |
| @affil:   Rutgers University                                                |
|- ------------------------------------------------------------------------- -/

import .cauchy

/-!
-/

namespace riemann_hypothesis --——————————————————————————————————————————————————————————--
namespace riemann_zeta --————————————————————————————————————————————————————————————————--
variables {ℝ : Type*}
          [has_lift_t nat ℝ] [preorder ℝ] [has_zero ℝ] [has_one ℝ]
          [has_neg ℝ] [has_add ℝ] [has_sub ℝ] [has_mul ℝ] [has_inv ℝ]

open algebra

/--
-/
def term {α β γ}
    [has_zero α]
    [has_lt α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_lt_comm nat α]
    [has_neg β]
    (pow : Π a : α, 0 < a → β → γ)
    (s n)
    := pow ↑(nat.succ n) (nat.lift.succ_pos α _) (-s)

namespace term --——————————————————————————————————————————————————————————————————————————--

/--
`ζ` Series Term for Real Inputs

`ζₙ(σ) := (n+1) ^ -σ`
-/
def on_reals
    [has_lift_zero_same nat ℝ]
    [has_lift_lt_comm nat ℝ]
    (ℯ : ExpLog ℝ ℝ)
    (σ n)
    := term ℯ.pow σ n

/--
-/
def on_reals.nonneg
    [has_lift_zero_same nat ℝ]
    [has_lift_lt_comm nat ℝ]
    (ℯ : ExpLog ℝ ℝ)
    (σ n)
    : 0 ≤ on_reals ℯ σ n
    := le_of_lt (ExpLog.exp_positive _ _)

/--
-/
def on_reals.non_increasing
    [has_left_unit ℝ]
    [has_mul_zero_is_zero ℝ]
    [has_left_sub_distributivity ℝ]
    [has_inv_reverses_lt ℝ]
    [has_lt_pos_mul_preserves_right ℝ]
    [has_zero_sub_is_neg ℝ]
    [has_lift_lt_comm nat ℝ]
    [has_lift_zero_same nat ℝ]
    (ℯ : ExpLog ℝ ℝ)
    (σ σpos)
    : non_increasing (on_reals ℯ σ) :=
    begin
        intros _,

        rw [on_reals, on_reals, term, term],
        rw ← has_zero_sub_is_neg.eq,
        rw [ExpLog.pow_neg_exponent_inverts, ExpLog.pow_neg_exponent_inverts],

        refine le_of_lt
            (has_inv_reverses_lt.lt
                (ExpLog.pow_monotonic _ _ _ σpos
                    (has_lift_lt_comm.lt (nat.lt_succ_self _)))),
    end

/--
-/
def on_reals.rewrite.pow_reduction
    [has_left_add_distributivity ℝ]
    [has_right_add_distributivity ℝ]
    [has_left_sub_distributivity ℝ]

    [has_left_unit ℝ]
    [has_right_unit ℝ]

    [has_zero_mul_is_zero ℝ]
    [has_mul_zero_is_zero ℝ]

    [has_zero_sub_is_neg ℝ]

    [has_mul_pos ℝ]

    [has_lift_one_same nat ℝ]
    [has_lift_zero_same nat ℝ]
    [has_lift_add_comm nat ℝ]
    [has_lift_mul_comm nat ℝ]
    [has_lift_lt_comm nat ℝ]
    [has_lift_le_comm nat ℝ]

    (ℯ : ExpLog ℝ ℝ)

    (σ) (n : nat)

    : ↑(2 ^ n) * on_reals ℯ σ (2 ^ n - 1)
    = ℯ.pow (ℯ.pow ↑2 _ (1 - σ)) (ℯ.pow_positivity _ (nat.lift.succ_pos ℝ _) _) ↑n :=

    begin
        have lifted_pow2_pos : Π k : nat, 0 < (↑(2 ^ k) : ℝ),
            intros k,
            refine (lt_of_lt_of_le (nat.lift.zero_lt_one ℝ) _),
            rw one_is_lifted_one_lemma nat ℝ,
            refine has_lift_le_comm.le (nat.pow_two_ge_one _),

        rw [on_reals, term],
        rw ← ℯ.pow_id_at_one ↑(_) (lifted_pow2_pos _),

        rw ExpLog.pow_domain_irrel _
            ↑(nat.succ (2 ^ n - 1)) _ _ (lifted_pow2_pos _) _
            (by rw [nat.succ_eq_add_one, nat.sub_add_cancel (nat.pow_two_ge_one _)]),

        rw ℯ.pow_homomorphism_inv_from_neg,

        induction n with n hn,
            rw has_lift_zero_same.eq,
            rw ExpLog.pow_homomorphism_zero,

            rw ExpLog.pow_domain_irrel _ ↑(2 ^ 0) _ (1 : ℝ) _ _
                (by rw [nat.pow_zero, has_lift_one_same.eq]),

            rw ExpLog.pow_homomorphism_one,

            rw ℯ.pow_succ_reduce _
                (ℯ.pow_positivity _ (nat.lift.succ_pos ℝ _) _),

            have scaled_pow_ineq : 0 < (↑(2 ^ n) * ↑2 : ℝ),
                rw zero_is_lifted_zero_lemma nat ℝ,
                rw ← has_lift_mul_comm.eq,
                rw ← nat.pow_succ,
                refine has_lift_lt_comm.lt
                    (lt_of_lt_of_le (nat.zero_lt_one) (nat.pow_two_ge_one _)),

            rw ExpLog.pow_domain_irrel _ ↑(2 ^ n.succ) _ _ scaled_pow_ineq _
                (by rw [nat.pow_succ, has_lift_mul_comm.eq]),

            rw ℯ.pow_homomorphism_mul _
                (lifted_pow2_pos _) _ (nat.lift.succ_pos ℝ _) _,

            rw hn,
    end

end term --——————————————————————————————————————————————————————————————————————————————--

/--
`ζ` Series Partial Sum for Real Inputs
-/
def partial.on_reals
    [has_lift_zero_same nat ℝ]
    [has_lift_lt_comm nat ℝ]
    (ℯ : ExpLog ℝ ℝ)
    := partial_sum ∘ (term.on_reals ℯ)

/--
-/
def partial.on_reals.is_cauchy
    [has_add_le_add ℝ]
    [has_add_lt_add ℝ]

    [has_add_nonneg ℝ]
    [has_add_sub_assoc ℝ]
    [has_le_add_of_nonneg_of_le ℝ]
    [has_left_add_distributivity ℝ]
    [has_left_sub_distributivity ℝ]
    [has_lt_sub_neg ℝ]
    [has_mul_assoc ℝ]
    [has_pos_mul_neg_is_neg ℝ]
    [has_zero_right_add_cancel ℝ]
    [has_right_add_distributivity ℝ]

    [has_left_unit ℝ]
    [has_right_unit ℝ]

    [has_lift_one_same nat ℝ]
    [has_lift_zero_same nat ℝ]
    [has_lift_mul_comm nat ℝ]
    [has_lift_add_comm nat ℝ]
    [has_lift_lt_comm nat ℝ]
    [has_lift_le_comm nat ℝ]

    [has_sub_add_sub_cancel ℝ]
    [has_sub_self_is_zero ℝ]
    [has_sub_sub ℝ]
    [has_sub_ne_zero_of_ne ℝ]
    [has_zero_left_add_cancel ℝ]
    [has_zero_mul_is_zero ℝ]
    [has_mul_zero_is_zero ℝ]
    [has_inv_mul_right_cancel_self ℝ]
    [has_right_sub_distributivity ℝ]
    [has_add_sub_exchange ℝ]
    [has_inv_right_mul_lt_pos ℝ]
    [has_left_mul_inv_lt_neg ℝ]
    [has_zero_sub_is_neg ℝ]
    [has_inv_reverses_lt ℝ]
    [has_lt_pos_mul_preserves_right ℝ]
    [has_mul_pos ℝ]
    [has_sub_pos ℝ]

    (ℯ : ExpLog ℝ ℝ)

    (abs)
        (abs_zero abs_one abs_add abs_sub abs_mul abs_inv abs_ge_zero ge_zero_to_abs)

    (half ceil)

    (σ σ_gt_1)

    : is_cauchy abs (partial.on_reals ℯ σ) :=

    begin
        refine condensation.cauchy_test _ abs_zero abs_ge_zero abs_add ge_zero_to_abs _
            (term.on_reals.nonneg _ _)
            (term.on_reals.non_increasing _ _
                (lt_trans (nat.lift.zero_lt_one _) σ_gt_1)) _,

        rw funext (term.on_reals.rewrite.pow_reduction ℯ _),

        refine geometric.series.is_cauchy _
            abs_one abs_inv abs_sub abs_add abs_mul ge_zero_to_abs _ half ceil _ _
            (ExpLog.exp_lt_zero_is_lt_one _
                (has_pos_mul_neg_is_neg.lt
                    (ExpLog.log_gt_one_is_gt_zero _ (nat.lift.succ_pos ℝ _) _)
                    (has_lt_sub_neg.lt σ_gt_1))),

        rw one_is_lifted_one_lemma nat ℝ,

        refine has_lift_lt_comm.lt (nat.lt_succ_self _),
    end

end riemann_zeta --——————————————————————————————————————————————————————————————————————--
end riemann_hypothesis --————————————————————————————————————————————————————————————————--


import mynat.mul -- imports definition of multiplication on the natural numbers.

namespace mynat

lemma example2 (x y : mynat) (h : y = x + 7) : 2 * y = 2 * (x + 7) :=
begin [nat_num_game]
  rw h,
  refl
end

end mynat


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

import ring_theory.polynomial.cyclotomic.basic

/-!
# Not all coefficients of cyclotomic polynomials are -1, 0, or 1

We show that not all coefficients of cyclotomic polynomials are equal to `0`, `-1` or `1`, in the
theorem `not_forall_coeff_cyclotomic_neg_one_zero_one`. We prove this with the counterexample
`coeff_cyclotomic_105 : coeff (cyclotomic 105 ℤ) 7 = -2`.
-/

open nat (proper_divisors) finset

section computation

instance nat.fact_prime_five : fact (nat.prime 5) := ⟨by norm_num⟩
instance nat.fact_prime_seven : fact (nat.prime 7) := ⟨by norm_num⟩

lemma proper_divisors_15 : nat.proper_divisors 15 = {1, 3, 5} := rfl

lemma proper_divisors_21 : nat.proper_divisors 21 = {1, 3, 7} := rfl

lemma proper_divisors_35 : nat.proper_divisors 35 = {1, 5, 7} := rfl

lemma proper_divisors_105 : nat.proper_divisors 105 = {1, 3, 5, 7, 15, 21, 35} := rfl

end computation

open polynomial

lemma cyclotomic_3 : cyclotomic 3 ℤ = 1 + X + X ^ 2 :=
by simp only [cyclotomic_prime, sum_range_succ, range_one, sum_singleton, pow_zero, pow_one]

lemma cyclotomic_5 : cyclotomic 5 ℤ = 1 + X + X ^ 2 + X ^ 3 + X ^ 4 :=
by simp only [cyclotomic_prime, sum_range_succ, range_one, sum_singleton, pow_zero, pow_one]

lemma cyclotomic_7 : cyclotomic 7 ℤ = 1 + X + X ^ 2 + X ^ 3 + X ^ 4 + X ^ 5 + X ^ 6 :=
by simp only [cyclotomic_prime, sum_range_succ, range_one, sum_singleton, pow_zero, pow_one]

lemma cyclotomic_15 : cyclotomic 15 ℤ = 1 - X + X ^ 3 - X ^ 4 + X ^ 5 - X ^ 7 + X ^ 8 :=
begin
  refine ((eq_cyclotomic_iff (by norm_num) _).2 _).symm,
  rw [proper_divisors_15, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_3, cyclotomic_5],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_21 : cyclotomic 21 ℤ =
  1 - X + X ^ 3 - X ^ 4 + X ^ 6 - X ^ 8 + X ^ 9 - X ^ 11 + X ^ 12 :=
begin
  refine ((eq_cyclotomic_iff (by norm_num) _).2 _).symm,
  rw [proper_divisors_21, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_3, cyclotomic_7],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_35 : cyclotomic 35 ℤ =
  1 - X + X ^ 5 - X ^ 6 + X ^ 7 - X ^ 8 + X ^ 10 - X ^ 11 + X ^ 12 - X ^ 13 + X ^ 14 - X ^ 16 +
  X ^ 17 - X ^ 18 + X ^ 19 - X ^ 23 + X ^ 24 :=
begin
  refine ((eq_cyclotomic_iff (by norm_num) _).2 _).symm,
  rw [proper_divisors_35, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_5, cyclotomic_7],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_105 : cyclotomic 105 ℤ =
  1 + X + X ^ 2 - X ^ 5 - X ^ 6 - 2 * X ^ 7 - X ^ 8 - X ^ 9 + X ^ 12 + X ^ 13 + X ^ 14 + X ^ 15
  + X ^ 16 + X ^ 17 - X ^ 20 - X ^ 22 - X ^ 24 - X ^ 26 - X ^ 28 + X ^ 31 + X ^ 32 + X ^ 33 +
  X ^ 34 + X ^ 35 + X ^ 36 - X ^ 39 - X ^ 40 - 2 * X ^ 41 - X ^ 42 - X ^ 43 + X ^ 46 + X ^ 47 +
  X ^ 48 :=
begin
  refine ((eq_cyclotomic_iff (by norm_num) _).2 _).symm,
  rw proper_divisors_105,
  repeat {rw finset.prod_insert _},
  rw [finset.prod_singleton, cyclotomic_one, cyclotomic_3, cyclotomic_5, cyclotomic_7,
    cyclotomic_15, cyclotomic_21, cyclotomic_35],
  ring,
  repeat { norm_num }
end

lemma coeff_cyclotomic_105 : coeff (cyclotomic 105 ℤ) 7 = -2 :=
begin
  simp [cyclotomic_105, coeff_X_pow, coeff_one, coeff_X_of_ne_one, coeff_bit0_mul, coeff_bit1_mul]
end

lemma not_forall_coeff_cyclotomic_neg_one_zero_one :
  ¬∀ n i, coeff (cyclotomic n ℤ) i ∈ ({-1, 0, 1} : set ℤ) :=
begin
  intro h,
  specialize h 105 7,
  rw coeff_cyclotomic_105 at h,
  norm_num at h
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Minchao Wu, Mario Carneiro

! This file was ported from Lean 3 source module data.finset.image
! 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.Hom.Embedding
import Mathlib.Data.Fin.Basic
import Mathlib.Data.Finset.Basic
import Mathlib.Data.Int.Order.Basic

/-! # Image and map operations on finite sets

Thie file provides the finite analog of `Set.image`, along with some other similar functions.

Note there are two ways to take the image over a finset; via `Finset.image` which applies the
function then removes duplicates (requiring `DecidableEq`), or via `Finset.map` which exploits
injectivity of the function to avoid needing to deduplicate. Choosing between these is similar to
choosing between `insert` and `Finset.cons`, or between `Finset.union` and `Finset.disjUnion`.

## Main definitions

* `Finset.image`: Given a function `f : α → β`, `s.image f` is the image finset in `β`.
* `Finset.map`: Given an embedding `f : α ↪ β`, `s.map f` is the image finset in `β`.
* `Finset.subtype`: `s.subtype p` is the the finset of `Subtype p` whose elements belong to `s`.
* `Finset.fin`:`s.fin n` is the finset of all elements of `s` less than `n`.

-/

variable {α β γ : Type _}

open Multiset

open Function

namespace Finset

/-! ### map -/

section Map

open Function

/-- When `f` is an embedding of `α` in `β` and `s` is a finset in `α`, then `s.map f` is the image
finset in `β`. The embedding condition guarantees that there are no duplicates in the image. -/
def map (f : α ↪ β) (s : Finset α) : Finset β :=
  ⟨s.1.map f, s.2.map f.2⟩
#align finset.map Finset.map

@[simp]
theorem map_val (f : α ↪ β) (s : Finset α) : (map f s).1 = s.1.map f :=
  rfl
#align finset.map_val Finset.map_val

@[simp]
theorem map_empty (f : α ↪ β) : (∅ : Finset α).map f = ∅ :=
  rfl
#align finset.map_empty Finset.map_empty

variable {f : α ↪ β} {s : Finset α}

--Porting note: Lower priority because `mem_map_equiv` is better when it applies
@[simp 900]
theorem mem_map {b : β} : b ∈ s.map f ↔ ∃ a ∈ s, f a = b :=
  mem_map.trans <| by simp only [exists_prop]; rfl
#align finset.mem_map Finset.mem_map

@[simp]
theorem mem_map_equiv {f : α ≃ β} {b : β} : b ∈ s.map f.toEmbedding ↔ f.symm b ∈ s := by
  rw [mem_map]
  exact
    ⟨by
      rintro ⟨a, H, rfl⟩
      simpa, fun h => ⟨_, h, by simp⟩⟩
#align finset.mem_map_equiv Finset.mem_map_equiv

theorem mem_map' (f : α ↪ β) {a} {s : Finset α} : f a ∈ s.map f ↔ a ∈ s :=
  mem_map_of_injective f.2
#align finset.mem_map' Finset.mem_map'

theorem mem_map_of_mem (f : α ↪ β) {a} {s : Finset α} : a ∈ s → f a ∈ s.map f :=
  (mem_map' _).2
#align finset.mem_map_of_mem Finset.mem_map_of_mem

theorem forall_mem_map {f : α ↪ β} {s : Finset α} {p : ∀ a, a ∈ s.map f → Prop} :
    (∀ y (H : y ∈ s.map f), p y H) ↔ ∀ x (H : x ∈ s), p (f x) (mem_map_of_mem _ H) :=
  ⟨fun h y hy => h (f y) (mem_map_of_mem _ hy),
   fun h x hx => by
    obtain ⟨y, hy, rfl⟩ := mem_map.1 hx
    exact h _ hy⟩
#align finset.forall_mem_map Finset.forall_mem_map

theorem apply_coe_mem_map (f : α ↪ β) (s : Finset α) (x : s) : f x ∈ s.map f :=
  mem_map_of_mem f x.prop
#align finset.apply_coe_mem_map Finset.apply_coe_mem_map

@[simp, norm_cast]
theorem coe_map (f : α ↪ β) (s : Finset α) : (s.map f : Set β) = f '' s :=
  Set.ext (by simp only [mem_coe, mem_map, Set.mem_image, implies_true])
#align finset.coe_map Finset.coe_map

theorem coe_map_subset_range (f : α ↪ β) (s : Finset α) : (s.map f : Set β) ⊆ Set.range f :=
  calc
    ↑(s.map f) = f '' s := coe_map f s
    _ ⊆ Set.range f := Set.image_subset_range f ↑s

#align finset.coe_map_subset_range Finset.coe_map_subset_range

/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect.
-/
theorem map_perm {σ : Equiv.Perm α} (hs : { a | σ a ≠ a } ⊆ s) : s.map (σ : α ↪ α) = s :=
  coe_injective <| (coe_map _ _).trans <| Set.image_perm hs
#align finset.map_perm Finset.map_perm

theorem map_toFinset [DecidableEq α] [DecidableEq β] {s : Multiset α} :
    s.toFinset.map f = (s.map f).toFinset :=
  ext fun _ => by simp only [mem_map, Multiset.mem_map, exists_prop, Multiset.mem_toFinset]
#align finset.map_to_finset Finset.map_toFinset

@[simp]
theorem map_refl : s.map (Embedding.refl _) = s :=
  ext fun _ => by simpa only [mem_map, exists_prop] using exists_eq_right
#align finset.map_refl Finset.map_refl

@[simp]
theorem map_cast_heq {α β} (h : α = β) (s : Finset α) :
    HEq (s.map (Equiv.cast h).toEmbedding) s := by
  subst h
  simp
#align finset.map_cast_heq Finset.map_cast_heq

theorem map_map (f : α ↪ β) (g : β ↪ γ) (s : Finset α) : (s.map f).map g = s.map (f.trans g) :=
  eq_of_veq <| by simp only [map_val, Multiset.map_map]; rfl
#align finset.map_map Finset.map_map

theorem map_comm {β'} {f : β ↪ γ} {g : α ↪ β} {f' : α ↪ β'} {g' : β' ↪ γ}
    (h_comm : ∀ a, f (g a) = g' (f' a)) : (s.map g).map f = (s.map f').map g' := by
  simp_rw [map_map, Embedding.trans, Function.comp, h_comm]
#align finset.map_comm Finset.map_comm

theorem _root_.Function.Semiconj.finset_map {f : α ↪ β} {ga : α ↪ α} {gb : β ↪ β}
    (h : Function.Semiconj f ga gb) : Function.Semiconj (map f) (map ga) (map gb) := fun _ =>
  map_comm h
#align function.semiconj.finset_map Function.Semiconj.finset_map

theorem _root_.Function.Commute.finset_map {f g : α ↪ α} (h : Function.Commute f g) :
    Function.Commute (map f) (map g) :=
  Function.Semiconj.finset_map h
#align function.commute.finset_map Function.Commute.finset_map

@[simp]
theorem map_subset_map {s₁ s₂ : Finset α} : s₁.map f ⊆ s₂.map f ↔ s₁ ⊆ s₂ :=
  ⟨fun h x xs => (mem_map' _).1 <| h <| (mem_map' f).2 xs,
   fun h => by simp [subset_def, Multiset.map_subset_map h]⟩
#align finset.map_subset_map Finset.map_subset_map

/-- Associate to an embedding `f` from `α` to `β` the order embedding that maps a finset to its
image under `f`. -/
def mapEmbedding (f : α ↪ β) : Finset α ↪o Finset β :=
  OrderEmbedding.ofMapLEIff (map f) fun _ _ => map_subset_map
#align finset.map_embedding Finset.mapEmbedding

@[simp]
theorem map_inj {s₁ s₂ : Finset α} : s₁.map f = s₂.map f ↔ s₁ = s₂ :=
  (mapEmbedding f).injective.eq_iff
#align finset.map_inj Finset.map_inj

theorem map_injective (f : α ↪ β) : Injective (map f) :=
  (mapEmbedding f).injective
#align finset.map_injective Finset.map_injective

@[simp]
theorem mapEmbedding_apply : mapEmbedding f s = map f s :=
  rfl
#align finset.map_embedding_apply Finset.mapEmbedding_apply

theorem filter_map {p : β → Prop} [DecidablePred p] :
    (s.map f).filter p = (s.filter (p ∘ f)).map f :=
  eq_of_veq (map_filter _ _ _)
#align finset.filter_map Finset.filter_map

theorem map_filter {f : α ≃ β} {p : α → Prop} [DecidablePred p] :
    (s.filter p).map f.toEmbedding = (s.map f.toEmbedding).filter (p ∘ f.symm) := by
  simp only [filter_map, Function.comp, Equiv.toEmbedding_apply, Equiv.symm_apply_apply]
#align finset.map_filter Finset.map_filter

@[simp]
theorem disjoint_map {s t : Finset α} (f : α ↪ β) :
    Disjoint (s.map f) (t.map f) ↔ Disjoint s t := by
  simp only [disjoint_iff_ne, mem_map, exists_prop, exists_imp, and_imp]
  refine' ⟨fun h a ha b hb hab => h _ _ ha rfl _ _ hb rfl <| congr_arg _ hab, _⟩
  rintro h _ a ha rfl _ b hb rfl
  exact f.injective.ne (h _ ha _ hb)
#align finset.disjoint_map Finset.disjoint_map

theorem map_disjUnion {f : α ↪ β} (s₁ s₂ : Finset α) (h) (h' := (disjoint_map _).mpr h) :
    (s₁.disjUnion s₂ h).map f = (s₁.map f).disjUnion (s₂.map f) h' :=
  eq_of_veq <| Multiset.map_add _ _ _
#align finset.map_disj_union Finset.map_disjUnion

/-- A version of `Finset.map_disjUnion` for writing in the other direction. -/
theorem map_disjUnion' {f : α ↪ β} (s₁ s₂ : Finset α) (h') (h := (disjoint_map _).mp h') :
    (s₁.disjUnion s₂ h).map f = (s₁.map f).disjUnion (s₂.map f) h' :=
  map_disjUnion _ _ _
#align finset.map_disj_union' Finset.map_disjUnion'

theorem map_union [DecidableEq α] [DecidableEq β] {f : α ↪ β} (s₁ s₂ : Finset α) :
    (s₁ ∪ s₂).map f = s₁.map f ∪ s₂.map f :=
  coe_injective <| by simp only [coe_map, coe_union, Set.image_union]
#align finset.map_union Finset.map_union

theorem map_inter [DecidableEq α] [DecidableEq β] {f : α ↪ β} (s₁ s₂ : Finset α) :
    (s₁ ∩ s₂).map f = s₁.map f ∩ s₂.map f :=
  coe_injective <| by simp only [coe_map, coe_inter, Set.image_inter f.injective]
#align finset.map_inter Finset.map_inter

@[simp]
theorem map_singleton (f : α ↪ β) (a : α) : map f {a} = {f a} :=
  coe_injective <| by simp only [coe_map, coe_singleton, Set.image_singleton]
#align finset.map_singleton Finset.map_singleton

@[simp]
theorem map_insert [DecidableEq α] [DecidableEq β] (f : α ↪ β) (a : α) (s : Finset α) :
    (insert a s).map f = insert (f a) (s.map f) := by
  simp only [insert_eq, map_union, map_singleton]
#align finset.map_insert Finset.map_insert

@[simp]
theorem map_cons (f : α ↪ β) (a : α) (s : Finset α) (ha : a ∉ s) :
    (cons a s ha).map f = cons (f a) (s.map f) (by simpa using ha) :=
  eq_of_veq <| Multiset.map_cons f a s.val
#align finset.map_cons Finset.map_cons

@[simp]
theorem map_eq_empty : s.map f = ∅ ↔ s = ∅ :=
  ⟨fun h => eq_empty_of_forall_not_mem fun _ m => ne_empty_of_mem (mem_map_of_mem _ m) h, fun e =>
    e.symm ▸ rfl⟩
#align finset.map_eq_empty Finset.map_eq_empty

@[simp]
theorem map_nonempty : (s.map f).Nonempty ↔ s.Nonempty := by
  rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, Ne.def, map_eq_empty]
#align finset.map_nonempty Finset.map_nonempty

alias map_nonempty ↔ _ Nonempty.map
#align finset.nonempty.map Finset.Nonempty.map

theorem attach_map_val {s : Finset α} : s.attach.map (Embedding.subtype _) = s :=
  eq_of_veq <| by rw [map_val, attach_val]; exact Multiset.attach_map_val _
#align finset.attach_map_val Finset.attach_map_val

theorem disjoint_range_addLeftEmbedding (a b : ℕ) :
    Disjoint (range a) (map (addLeftEmbedding a) (range b)) := by
  refine' disjoint_iff_inf_le.mpr _
  intro k hk
  simp only [exists_prop, mem_range, inf_eq_inter, mem_map, addLeftEmbedding, mem_inter]
    at hk
  obtain ⟨a, _, ha⟩ := hk.2
  simpa [← ha] using hk.1
#align finset.disjoint_range_add_left_embedding Finset.disjoint_range_addLeftEmbedding

theorem disjoint_range_addRightEmbedding (a b : ℕ) :
    Disjoint (range a) (map (addRightEmbedding a) (range b)) := by
  refine' disjoint_iff_inf_le.mpr _
  intro k hk
  simp only [exists_prop, mem_range, inf_eq_inter, mem_map, addRightEmbedding, mem_inter]
    at hk
  obtain ⟨a, _, ha⟩ := hk.2
  simpa [← ha] using hk.1
#align finset.disjoint_range_add_right_embedding Finset.disjoint_range_addRightEmbedding

theorem map_disjUnionᵢ {f : α ↪ β} {s : Finset α} {t : β → Finset γ} {h} :
    (s.map f).disjUnionᵢ t h =
      s.disjUnionᵢ (fun a => t (f a)) fun _ ha _ hb hab =>
        h (mem_map_of_mem _ ha) (mem_map_of_mem _ hb) (f.injective.ne hab) :=
  eq_of_veq <| Multiset.bind_map _ _ _
#align finset.map_disj_Union Finset.map_disjUnionᵢ

theorem disjUnionᵢ_map {s : Finset α} {t : α → Finset β} {f : β ↪ γ} {h} :
    (s.disjUnionᵢ t h).map f =
      s.disjUnionᵢ (fun a => (t a).map f) fun a ha b hb hab =>
        disjoint_left.mpr fun x hxa hxb => by
          obtain ⟨xa, hfa, rfl⟩ := mem_map.mp hxa
          obtain ⟨xb, hfb, hfab⟩ := mem_map.mp hxb
          obtain rfl := f.injective hfab
          exact disjoint_left.mp (h ha hb hab) hfa hfb :=
  eq_of_veq <| Multiset.map_bind _ _ _
#align finset.disj_Union_map Finset.disjUnionᵢ_map

end Map

theorem range_add_one' (n : ℕ) :
    range (n + 1) = insert 0 ((range n).map ⟨fun i => i + 1, fun i j => by simp⟩) := by
  ext (⟨⟩ | ⟨n⟩) <;> simp [Nat.succ_eq_add_one, Nat.zero_lt_succ n]
#align finset.range_add_one' Finset.range_add_one'

/-! ### image -/

section Image

variable [DecidableEq β]

/-- `image f s` is the forward image of `s` under `f`. -/
def image (f : α → β) (s : Finset α) : Finset β :=
  (s.1.map f).toFinset
#align finset.image Finset.image

@[simp]
theorem image_val (f : α → β) (s : Finset α) : (image f s).1 = (s.1.map f).dedup :=
  rfl
#align finset.image_val Finset.image_val

@[simp]
theorem image_empty (f : α → β) : (∅ : Finset α).image f = ∅ :=
  rfl
#align finset.image_empty Finset.image_empty

variable {f g : α → β} {s : Finset α} {t : Finset β} {a : α} {b c : β}

@[simp]
theorem mem_image : b ∈ s.image f ↔ ∃ a ∈ s, f a = b := by
  simp only [mem_def, image_val, mem_dedup, Multiset.mem_map, exists_prop]
#align finset.mem_image Finset.mem_image

theorem mem_image_of_mem (f : α → β) {a} (h : a ∈ s) : f a ∈ s.image f :=
  mem_image.2 ⟨_, h, rfl⟩
#align finset.mem_image_of_mem Finset.mem_image_of_mem

theorem forall_image {p : β → Prop} : (∀ b ∈ s.image f, p b) ↔ ∀ a ∈ s, p (f a) := by
  simp only [mem_image, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
#align finset.forall_image Finset.forall_image

--@[simp] Porting note: removing simp, `simp` [Nonempty] can prove it
theorem mem_image_const : c ∈ s.image (const α b) ↔ s.Nonempty ∧ b = c := by
  rw [mem_image]
  simp only [exists_prop, const_apply, exists_and_right]
  rfl
#align finset.mem_image_const Finset.mem_image_const

theorem mem_image_const_self : b ∈ s.image (const α b) ↔ s.Nonempty :=
  mem_image_const.trans <| and_iff_left rfl
#align finset.mem_image_const_self Finset.mem_image_const_self

instance canLift (c) (p) [CanLift β α c p] :
    CanLift (Finset β) (Finset α) (image c) fun s => ∀ x ∈ s, p x where
  prf := by
    rintro ⟨⟨l⟩, hd : l.Nodup⟩ hl
    lift l to List α using hl
    exact ⟨⟨l, hd.of_map _⟩, ext fun a => by simp⟩
#align finset.can_lift Finset.canLift

theorem image_congr (h : (s : Set α).EqOn f g) : Finset.image f s = Finset.image g s := by
  ext
  simp_rw [mem_image, ← bex_def]
  exact bex_congr fun x hx => by rw [h hx]
#align finset.image_congr Finset.image_congr

theorem _root_.Function.Injective.mem_finset_image (hf : Injective f) :
    f a ∈ s.image f ↔ a ∈ s := by
  refine' ⟨fun h => _, Finset.mem_image_of_mem f⟩
  obtain ⟨y, hy, heq⟩ := mem_image.1 h
  exact hf heq ▸ hy
#align function.injective.mem_finset_image Function.Injective.mem_finset_image

theorem filter_mem_image_eq_image (f : α → β) (s : Finset α) (t : Finset β) (h : ∀ x ∈ s, f x ∈ t) :
    (t.filter fun y => y ∈ s.image f) = s.image f := by
  ext
  simp only [mem_filter, mem_image, decide_eq_true_eq, and_iff_right_iff_imp, forall_exists_index,
    and_imp]
  rintro x xel rfl
  exact h _ xel
#align finset.filter_mem_image_eq_image Finset.filter_mem_image_eq_image

theorem fiber_nonempty_iff_mem_image (f : α → β) (s : Finset α) (y : β) :
    (s.filter fun x => f x = y).Nonempty ↔ y ∈ s.image f := by simp [Finset.Nonempty]
#align finset.fiber_nonempty_iff_mem_image Finset.fiber_nonempty_iff_mem_image

@[simp, norm_cast]
theorem coe_image {f : α → β} : ↑(s.image f) = f '' ↑s :=
  Set.ext <| by simp only [mem_coe, mem_image, Set.mem_image, implies_true]
#align finset.coe_image Finset.coe_image

protected theorem Nonempty.image (h : s.Nonempty) (f : α → β) : (s.image f).Nonempty :=
  let ⟨a, ha⟩ := h
  ⟨f a, mem_image_of_mem f ha⟩
#align finset.nonempty.image Finset.Nonempty.image

@[simp]
theorem Nonempty.image_iff (f : α → β) : (s.image f).Nonempty ↔ s.Nonempty :=
  ⟨fun ⟨_, hy⟩ =>
    let ⟨x, hx, _⟩ := mem_image.mp hy
    ⟨x, hx⟩,
    fun h => h.image f⟩
#align finset.nonempty.image_iff Finset.Nonempty.image_iff

theorem image_toFinset [DecidableEq α] {s : Multiset α} :
    s.toFinset.image f = (s.map f).toFinset :=
  ext fun _ => by simp only [mem_image, Multiset.mem_toFinset, exists_prop, Multiset.mem_map]
#align finset.image_to_finset Finset.image_toFinset

theorem image_val_of_injOn (H : Set.InjOn f s) : (image f s).1 = s.1.map f :=
  (s.2.map_on H).dedup
#align finset.image_val_of_inj_on Finset.image_val_of_injOn

@[simp]
theorem image_id [DecidableEq α] : s.image id = s :=
  ext fun _ => by simp only [mem_image, exists_prop, id, exists_eq_right]
#align finset.image_id Finset.image_id

@[simp]
theorem image_id' [DecidableEq α] : (s.image fun x => x) = s :=
  image_id
#align finset.image_id' Finset.image_id'

theorem image_image [DecidableEq γ] {g : β → γ} : (s.image f).image g = s.image (g ∘ f) :=
  eq_of_veq <| by simp only [image_val, dedup_map_dedup_eq, Multiset.map_map]
#align finset.image_image Finset.image_image

theorem image_comm {β'} [DecidableEq β'] [DecidableEq γ] {f : β → γ} {g : α → β} {f' : α → β'}
    {g' : β' → γ} (h_comm : ∀ a, f (g a) = g' (f' a)) :
    (s.image g).image f = (s.image f').image g' := by simp_rw [image_image, comp, h_comm]
#align finset.image_comm Finset.image_comm

theorem _root_.Function.Semiconj.finset_image [DecidableEq α] {f : α → β} {ga : α → α} {gb : β → β}
    (h : Function.Semiconj f ga gb) : Function.Semiconj (image f) (image ga) (image gb) := fun _ =>
  image_comm h
#align function.semiconj.finset_image Function.Semiconj.finset_image

theorem _root_.Function.Commute.finset_image [DecidableEq α] {f g : α → α}
    (h : Function.Commute f g) : Function.Commute (image f) (image g) :=
  Function.Semiconj.finset_image h
#align function.commute.finset_image Function.Commute.finset_image

theorem image_subset_image {s₁ s₂ : Finset α} (h : s₁ ⊆ s₂) : s₁.image f ⊆ s₂.image f := by
  simp only [subset_def, image_val, subset_dedup', dedup_subset', Multiset.map_subset_map h]
#align finset.image_subset_image Finset.image_subset_image

theorem image_subset_iff : s.image f ⊆ t ↔ ∀ x ∈ s, f x ∈ t :=
  calc
    s.image f ⊆ t ↔ f '' ↑s ⊆ ↑t := by norm_cast
    _ ↔ _ := Set.image_subset_iff

#align finset.image_subset_iff Finset.image_subset_iff

theorem image_mono (f : α → β) : Monotone (Finset.image f) := fun _ _ => image_subset_image
#align finset.image_mono Finset.image_mono

theorem image_subset_image_iff {t : Finset α} (hf : Injective f) :
    s.image f ⊆ t.image f ↔ s ⊆ t := by
  simp_rw [← coe_subset]
  push_cast
  exact Set.image_subset_image_iff hf
#align finset.image_subset_image_iff Finset.image_subset_image_iff

theorem coe_image_subset_range : ↑(s.image f) ⊆ Set.range f :=
  calc
    ↑(s.image f) = f '' ↑s := coe_image
    _ ⊆ Set.range f := Set.image_subset_range f ↑s

#align finset.coe_image_subset_range Finset.coe_image_subset_range

theorem image_filter {p : β → Prop} [DecidablePred p] :
    (s.image f).filter p = (s.filter (p ∘ f)).image f :=
  ext fun b => by
    simp only [mem_filter, mem_image, exists_prop]
    exact
      ⟨by rintro ⟨⟨x, h1, rfl⟩, h2⟩; exact ⟨x, ⟨h1, h2⟩, rfl⟩,
       by rintro ⟨x, ⟨h1, h2⟩, rfl⟩; exact ⟨⟨x, h1, rfl⟩, h2⟩⟩
#align finset.image_filter Finset.image_filter

theorem image_union [DecidableEq α] {f : α → β} (s₁ s₂ : Finset α) :
    (s₁ ∪ s₂).image f = s₁.image f ∪ s₂.image f :=
  ext fun _ => by simp only [mem_image, mem_union, exists_prop, or_and_right, exists_or]
#align finset.image_union Finset.image_union

theorem image_inter_subset [DecidableEq α] (f : α → β) (s t : Finset α) :
    (s ∩ t).image f ⊆ s.image f ∩ t.image f :=
  subset_inter (image_subset_image <| inter_subset_left _ _) <|
    image_subset_image <| inter_subset_right _ _
#align finset.image_inter_subset Finset.image_inter_subset

theorem image_inter_of_injOn [DecidableEq α] {f : α → β} (s t : Finset α)
    (hf : Set.InjOn f (s ∪ t)) : (s ∩ t).image f = s.image f ∩ t.image f :=
  coe_injective <| by
    push_cast
    exact Set.image_inter_on fun a ha b hb => hf (Or.inr ha) <| Or.inl hb
#align finset.image_inter_of_inj_on Finset.image_inter_of_injOn

theorem image_inter [DecidableEq α] (s₁ s₂ : Finset α) (hf : Injective f) :
    (s₁ ∩ s₂).image f = s₁.image f ∩ s₂.image f :=
  image_inter_of_injOn _ _ <| hf.injOn _
#align finset.image_inter Finset.image_inter

@[simp]
theorem image_singleton (f : α → β) (a : α) : image f {a} = {f a} :=
  ext fun x => by simpa only [mem_image, exists_prop, mem_singleton, exists_eq_left] using eq_comm
#align finset.image_singleton Finset.image_singleton

@[simp]
theorem image_insert [DecidableEq α] (f : α → β) (a : α) (s : Finset α) :
    (insert a s).image f = insert (f a) (s.image f) := by
  simp only [insert_eq, image_singleton, image_union]
#align finset.image_insert Finset.image_insert

theorem erase_image_subset_image_erase [DecidableEq α] (f : α → β) (s : Finset α) (a : α) :
    (s.image f).erase (f a) ⊆ (s.erase a).image f := by
  simp only [subset_iff, and_imp, exists_prop, mem_image, exists_imp, mem_erase]
  rintro b hb x hx rfl
  exact ⟨_, ⟨ne_of_apply_ne f hb, hx⟩, rfl⟩
#align finset.erase_image_subset_image_erase Finset.erase_image_subset_image_erase

@[simp]
theorem image_erase [DecidableEq α] {f : α → β} (hf : Injective f) (s : Finset α) (a : α) :
    (s.erase a).image f = (s.image f).erase (f a) := by
  refine' (erase_image_subset_image_erase _ _ _).antisymm' fun b => _
  simp only [mem_image, exists_prop, mem_erase]
  rintro ⟨a', ⟨haa', ha'⟩, rfl⟩
  exact ⟨hf.ne haa', a', ha', rfl⟩
#align finset.image_erase Finset.image_erase

@[simp]
theorem image_eq_empty : s.image f = ∅ ↔ s = ∅ :=
  ⟨fun h => eq_empty_of_forall_not_mem fun _ m => ne_empty_of_mem (mem_image_of_mem _ m) h,
   fun e => e.symm ▸ rfl⟩
#align finset.image_eq_empty Finset.image_eq_empty

theorem image_sdiff [DecidableEq α] {f : α → β} (s t : Finset α) (hf : Injective f) :
    (s \ t).image f = s.image f \ t.image f :=
  coe_injective <| by
    push_cast
    exact Set.image_diff hf _ _
#align finset.image_sdiff Finset.image_sdiff

theorem image_symmDiff [DecidableEq α] {f : α → β} (s t : Finset α) (hf : Injective f) :
    (s ∆ t).image f = s.image f ∆ t.image f :=
  coe_injective <| by
    push_cast
    exact Set.image_symm_diff hf _ _
#align finset.image_symm_diff Finset.image_symmDiff

@[simp]
theorem _root_.Disjoint.of_image_finset {s t : Finset α} {f : α → β}
    (h : Disjoint (s.image f) (t.image f)) : Disjoint s t :=
  disjoint_iff_ne.2 fun _ ha _ hb =>
    ne_of_apply_ne f <| h.forall_ne_finset (mem_image_of_mem _ ha) (mem_image_of_mem _ hb)
#align disjoint.of_image_finset Disjoint.of_image_finset

theorem mem_range_iff_mem_finset_range_of_mod_eq' [DecidableEq α] {f : ℕ → α} {a : α} {n : ℕ}
    (hn : 0 < n) (h : ∀ i, f (i % n) = f i) :
    a ∈ Set.range f ↔ a ∈ (Finset.range n).image fun i => f i := by
  constructor
  · rintro ⟨i, hi⟩
    simp only [mem_image, exists_prop, mem_range]
    exact ⟨i % n, Nat.mod_lt i hn, (rfl.congr hi).mp (h i)⟩
  · rintro h
    simp only [mem_image, exists_prop, Set.mem_range, mem_range] at *
    rcases h with ⟨i, _, ha⟩
    exact ⟨i, ha⟩
#align finset.mem_range_iff_mem_finset_range_of_mod_eq' Finset.mem_range_iff_mem_finset_range_of_mod_eq'

theorem mem_range_iff_mem_finset_range_of_mod_eq [DecidableEq α] {f : ℤ → α} {a : α} {n : ℕ}
    (hn : 0 < n) (h : ∀ i, f (i % n) = f i) :
    a ∈ Set.range f ↔ a ∈ (Finset.range n).image (fun (i : ℕ) => f i) :=
  suffices (∃ i, f (i % n) = a) ↔ ∃ i, i < n ∧ f ↑i = a by simpa [h]
  have hn' : 0 < (n : ℤ) := Int.ofNat_lt.mpr hn
  Iff.intro
    (fun ⟨i, hi⟩ =>
      have : 0 ≤ i % ↑n := Int.emod_nonneg _ (ne_of_gt hn')
      ⟨Int.toNat (i % n), by
        rw [← Int.ofNat_lt, Int.toNat_of_nonneg this]; exact ⟨Int.emod_lt_of_pos i hn', hi⟩⟩)
    fun ⟨i, hi, ha⟩ =>
    ⟨i, by rw [Int.emod_eq_of_lt (Int.ofNat_zero_le _) (Int.ofNat_lt_ofNat_of_lt hi), ha]⟩
#align finset.mem_range_iff_mem_finset_range_of_mod_eq Finset.mem_range_iff_mem_finset_range_of_mod_eq

theorem range_add (a b : ℕ) : range (a + b) = range a ∪ (range b).map (addLeftEmbedding a) := by
  rw [← val_inj, union_val]
  exact Multiset.range_add_eq_union a b
#align finset.range_add Finset.range_add

@[simp]
theorem attach_image_val [DecidableEq α] {s : Finset α} : s.attach.image Subtype.val = s :=
  eq_of_veq <| by rw [image_val, attach_val, Multiset.attach_map_val, dedup_eq_self]
#align finset.attach_image_val Finset.attach_image_val
#align finset.attach_image_coe Finset.attach_image_val

@[simp]
theorem attach_insert [DecidableEq α] {a : α} {s : Finset α} :
    attach (insert a s) =
      insert (⟨a, mem_insert_self a s⟩ : { x // x ∈ insert a s })
        ((attach s).image fun x => ⟨x.1, mem_insert_of_mem x.2⟩) :=
  ext fun ⟨x, hx⟩ =>
    ⟨Or.casesOn (mem_insert.1 hx)
        (fun h : x = a => fun _ => mem_insert.2 <| Or.inl <| Subtype.eq h) fun h : x ∈ s => fun _ =>
        mem_insert_of_mem <| mem_image.2 <| ⟨⟨x, h⟩, mem_attach _ _, Subtype.eq rfl⟩,
      fun _ => Finset.mem_attach _ _⟩
#align finset.attach_insert Finset.attach_insert

theorem map_eq_image (f : α ↪ β) (s : Finset α) : s.map f = s.image f :=
  eq_of_veq (s.map f).2.dedup.symm
#align finset.map_eq_image Finset.map_eq_image

@[simp]
theorem disjoint_image {s t : Finset α} {f : α → β} (hf : Injective f) :
    Disjoint (s.image f) (t.image f) ↔ Disjoint s t := by
  -- Porting note: was `convert`
  rw [←disjoint_map ⟨_, hf⟩]
  simp [map_eq_image]
#align finset.disjoint_image Finset.disjoint_image

theorem image_const {s : Finset α} (h : s.Nonempty) (b : β) : (s.image fun _ => b) = singleton b :=
  ext fun b' => by
    simp only [mem_image, exists_prop, exists_and_right, h.bex, true_and_iff, mem_singleton,
      eq_comm]
#align finset.image_const Finset.image_const

@[simp]
theorem map_erase [DecidableEq α] (f : α ↪ β) (s : Finset α) (a : α) :
    (s.erase a).map f = (s.map f).erase (f a) := by
  simp_rw [map_eq_image]
  exact s.image_erase f.2 a
#align finset.map_erase Finset.map_erase

theorem image_bunionᵢ [DecidableEq γ] {f : α → β} {s : Finset α} {t : β → Finset γ} :
    (s.image f).bunionᵢ t = s.bunionᵢ fun a => t (f a) :=
  haveI := Classical.decEq α
  Finset.induction_on s rfl fun a s _ ih => by simp only [image_insert, bunionᵢ_insert, ih]
#align finset.image_bUnion Finset.image_bunionᵢ

theorem bunionᵢ_image [DecidableEq γ] {s : Finset α} {t : α → Finset β} {f : β → γ} :
    (s.bunionᵢ t).image f = s.bunionᵢ fun a => (t a).image f :=
  haveI := Classical.decEq α
  Finset.induction_on s rfl fun a s _ ih => by simp only [bunionᵢ_insert, image_union, ih]
#align finset.bUnion_image Finset.bunionᵢ_image

theorem image_bunionᵢ_filter_eq [DecidableEq α] (s : Finset β) (g : β → α) :
    ((s.image g).bunionᵢ fun a => s.filter fun c => g c = a) = s :=
  bunionᵢ_filter_eq_of_maps_to fun _ => mem_image_of_mem g
#align finset.image_bUnion_filter_eq Finset.image_bunionᵢ_filter_eq

theorem bunionᵢ_singleton {f : α → β} : (s.bunionᵢ fun a => {f a}) = s.image f :=
  ext fun x => by simp only [mem_bunionᵢ, mem_image, mem_singleton, eq_comm]
#align finset.bUnion_singleton Finset.bunionᵢ_singleton

end Image

/-! ### Subtype -/

section Subtype

/-- Given a finset `s` and a predicate `p`, `s.subtype p` is the finset of `subtype p` whose
elements belong to `s`. -/
protected def subtype {α} (p : α → Prop) [DecidablePred p] (s : Finset α) : Finset (Subtype p) :=
  (s.filter p).attach.map
    ⟨fun x => ⟨x.1, by simpa using (Finset.mem_filter.1 x.2).2⟩,
     fun x y H => Subtype.eq <| Subtype.mk.inj H⟩
#align finset.subtype Finset.subtype

@[simp]
theorem mem_subtype {p : α → Prop} [DecidablePred p] {s : Finset α} :
    ∀ {a : Subtype p}, a ∈ s.subtype p ↔ (a : α) ∈ s
  | ⟨a, ha⟩ => by simp [Finset.subtype, ha]
#align finset.mem_subtype Finset.mem_subtype

theorem subtype_eq_empty {p : α → Prop} [DecidablePred p] {s : Finset α} :
    s.subtype p = ∅ ↔ ∀ x, p x → x ∉ s := by simp [ext_iff, Subtype.forall, Subtype.coe_mk]
#align finset.subtype_eq_empty Finset.subtype_eq_empty

@[mono]
theorem subtype_mono {p : α → Prop} [DecidablePred p] : Monotone (Finset.subtype p) :=
  fun _ _ h _ hx => mem_subtype.2 <| h <| mem_subtype.1 hx
#align finset.subtype_mono Finset.subtype_mono

/-- `s.subtype p` converts back to `s.filter p` with
`Embedding.subtype`. -/
@[simp]
theorem subtype_map (p : α → Prop) [DecidablePred p] {s : Finset α} :
    (s.subtype p).map (Embedding.subtype _) = s.filter p := by
  ext x
  simp [@and_comm _ (_ = _), @and_left_comm _ (_ = _), @and_comm (p x) (x ∈ s)]
#align finset.subtype_map Finset.subtype_map

/-- If all elements of a `Finset` satisfy the predicate `p`,
`s.subtype p` converts back to `s` with `Embedding.subtype`. -/

/-- If a `Finset` of a subtype is converted to the main type with
`Embedding.subtype`, all elements of the result have the property of
the subtype. -/
theorem property_of_mem_map_subtype {p : α → Prop} (s : Finset { x // p x }) {a : α}
    (h : a ∈ s.map (Embedding.subtype _)) : p a :=
  by
  rcases mem_map.1 h with ⟨x, _, rfl⟩
  exact x.2
#align finset.property_of_mem_map_subtype Finset.property_of_mem_map_subtype

/-- If a `Finset` of a subtype is converted to the main type with
`Embedding.subtype`, the result does not contain any value that does
not satisfy the property of the subtype. -/
theorem not_mem_map_subtype_of_not_property {p : α → Prop} (s : Finset { x // p x }) {a : α}
    (h : ¬p a) : a ∉ s.map (Embedding.subtype _) :=
  mt s.property_of_mem_map_subtype h
#align finset.not_mem_map_subtype_of_not_property Finset.not_mem_map_subtype_of_not_property

/-- If a `Finset` of a subtype is converted to the main type with
`Embedding.subtype`, the result is a subset of the set giving the
subtype. -/
theorem map_subtype_subset {t : Set α} (s : Finset t) : ↑(s.map (Embedding.subtype _)) ⊆ t := by
  intro a ha
  rw [mem_coe] at ha
  convert property_of_mem_map_subtype s ha
#align finset.map_subtype_subset Finset.map_subtype_subset

end Subtype

/-! ### Fin -/

/-- Given a finset `s` of natural numbers and a bound `n`,
`s.fin n` is the finset of all elements of `s` less than `n`.
-/
protected def fin (n : ℕ) (s : Finset ℕ) : Finset (Fin n) :=
  (s.subtype _).map Fin.equivSubtype.symm.toEmbedding
#align finset.fin Finset.fin

@[simp]
theorem mem_fin {n} {s : Finset ℕ} : ∀ a : Fin n, a ∈ s.fin n ↔ (a : ℕ) ∈ s
  | ⟨a, ha⟩ => by simp [Finset.fin, ha, and_comm]
#align finset.mem_fin Finset.mem_fin

@[mono]
theorem fin_mono {n} : Monotone (Finset.fin n) := fun s t h x => by simpa using @h x
#align finset.fin_mono Finset.fin_mono

@[simp]
theorem fin_map {n} {s : Finset ℕ} : (s.fin n).map Fin.valEmbedding = s.filter (· < n) := by
  simp [Finset.fin, Finset.map_map]
#align finset.fin_map Finset.fin_map

theorem subset_image_iff [DecidableEq β] {s : Set α} {t : Finset β} {f : α → β} :
    ↑t ⊆ f '' s ↔ ∃ s' : Finset α, ↑s' ⊆ s ∧ s'.image f = t := by
  constructor; swap
  · rintro ⟨t, ht, rfl⟩
    rw [coe_image]
    exact Set.image_subset f ht
  intro h
  letI : CanLift β s (f ∘ (↑)) fun y => y ∈ f '' s := ⟨fun y ⟨x, hxt, hy⟩ => ⟨⟨x, hxt⟩, hy⟩⟩
  lift t to Finset s using h
  refine' ⟨t.map (Embedding.subtype _), map_subtype_subset _, _⟩
  ext y; simp
#align finset.subset_image_iff Finset.subset_image_iff

theorem range_sdiff_zero {n : ℕ} : range (n + 1) \ {0} = (range n).image Nat.succ := by
  induction' n with k hk
  · simp
  conv_rhs => rw [range_succ]
  rw [range_succ, image_insert, ← hk, insert_sdiff_of_not_mem]
  simp
#align finset.range_sdiff_zero Finset.range_sdiff_zero

end Finset

theorem Multiset.toFinset_map [DecidableEq α] [DecidableEq β] (f : α → β) (m : Multiset α) :
    (m.map f).toFinset = m.toFinset.image f :=
  Finset.val_inj.1 (Multiset.dedup_map_dedup_eq _ _).symm
#align multiset.to_finset_map Multiset.toFinset_map

namespace Equiv

/-- Given an equivalence `α` to `β`, produce an equivalence between `Finset α` and `Finset β`. -/
protected def finsetCongr (e : α ≃ β) : Finset α ≃ Finset β where
  toFun s := s.map e.toEmbedding
  invFun s := s.map e.symm.toEmbedding
  left_inv s := by simp [Finset.map_map]
  right_inv s := by simp [Finset.map_map]
#align equiv.finset_congr Equiv.finsetCongr

@[simp]
theorem finsetCongr_apply (e : α ≃ β) (s : Finset α) : e.finsetCongr s = s.map e.toEmbedding :=
  rfl
#align equiv.finset_congr_apply Equiv.finsetCongr_apply

@[simp]
theorem finsetCongr_refl : (Equiv.refl α).finsetCongr = Equiv.refl _ := by
  ext
  simp
#align equiv.finset_congr_refl Equiv.finsetCongr_refl

@[simp]
theorem finsetCongr_symm (e : α ≃ β) : e.finsetCongr.symm = e.symm.finsetCongr :=
  rfl
#align equiv.finset_congr_symm Equiv.finsetCongr_symm

@[simp]
theorem finsetCongr_trans (e : α ≃ β) (e' : β ≃ γ) :
    e.finsetCongr.trans e'.finsetCongr = (e.trans e').finsetCongr := by
  ext
  simp [-Finset.mem_map, -Equiv.trans_toEmbedding]
#align equiv.finset_congr_trans Equiv.finsetCongr_trans

theorem finsetCongr_toEmbedding (e : α ≃ β) :
    e.finsetCongr.toEmbedding = (Finset.mapEmbedding e.toEmbedding).toEmbedding :=
  rfl
#align equiv.finset_congr_to_embedding Equiv.finsetCongr_toEmbedding

end Equiv


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Jeremy Avigad
-/
prelude
import init.logic
universes u v

section
variables {α : Type u} {β : Type v}

@[simp] lemma prod.mk.eta : ∀{p : α × β}, (p.1, p.2) = p
| (a, b) := rfl

instance [inhabited α] [inhabited β] : inhabited (prod α β) :=
⟨(default, default)⟩

instance [h₁ : decidable_eq α] [h₂ : decidable_eq β] : decidable_eq (α × β)
| (a, b) (a', b') :=
  match (h₁ a a') with
  | (is_true e₁) :=
    match (h₂ b b') with
    | (is_true e₂)  := is_true (eq.rec_on e₁ (eq.rec_on e₂ rfl))
    | (is_false n₂) := is_false (assume h, prod.no_confusion h (λ e₁' e₂', absurd e₂' n₂))
    end
  | (is_false n₁) := is_false (assume h, prod.no_confusion h (λ e₁' e₂', absurd e₁' n₁))
  end

end

def {u₁ u₂ v₁ v₂} prod.map {α₁ : Type u₁} {α₂ : Type u₂} {β₁ : Type v₁} {β₂ : Type v₂}
  (f : α₁ → α₂) (g : β₁ → β₂) (x : α₁ × β₁) : α₂ × β₂ :=
(f x.1, g x.2)


/-
Copyright (c) 2015 Nathaniel Thomas. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro
-/
import algebra.big_operators.basic
import algebra.smul_with_zero
import group_theory.group_action.big_operators
import group_theory.group_action.group
import tactic.norm_num

/-!
# Modules over a ring

In this file we define

* `module R M` : an additive commutative monoid `M` is a `module` over a
  `semiring R` if for `r : R` and `x : M` their "scalar multiplication `r • x : M` is defined, and
  the operation `•` satisfies some natural associativity and distributivity axioms similar to those
  on a ring.

## Implementation notes

In typical mathematical usage, our definition of `module` corresponds to "semimodule", and the
word "module" is reserved for `module R M` where `R` is a `ring` and `M` an `add_comm_group`.
If `R` is a `field` and `M` an `add_comm_group`, `M` would be called an `R`-vector space.
Since those assumptions can be made by changing the typeclasses applied to `R` and `M`,
without changing the axioms in `module`, mathlib calls everything a `module`.

In older versions of mathlib, we had separate `semimodule` and `vector_space` abbreviations.
This caused inference issues in some cases, while not providing any real advantages, so we decided
to use a canonical `module` typeclass throughout.

## Tags

semimodule, module, vector space
-/

open function
open_locale big_operators

universes u v
variables {α R k S M M₂ M₃ ι : Type*}

/-- A module is a generalization of vector spaces to a scalar semiring.
  It consists of a scalar semiring `R` and an additive monoid of "vectors" `M`,
  connected by a "scalar multiplication" operation `r • x : M`
  (where `r : R` and `x : M`) with some natural associativity and
  distributivity axioms similar to those on a ring. -/
@[ext, protect_proj] class module (R : Type u) (M : Type v) [semiring R]
  [add_comm_monoid M] extends distrib_mul_action R M :=
(add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x)
(zero_smul : ∀x : M, (0 : R) • x = 0)

section add_comm_monoid
variables [semiring R] [add_comm_monoid M] [module R M] (r s : R) (x y : M)

/-- A module over a semiring automatically inherits a `mul_action_with_zero` structure. -/
@[priority 100] -- see Note [lower instance priority]
instance module.to_mul_action_with_zero :
  mul_action_with_zero R M :=
{ smul_zero := smul_zero,
  zero_smul := module.zero_smul,
  ..(infer_instance : mul_action R M) }

instance add_comm_monoid.nat_module : module ℕ M :=
{ one_smul := one_nsmul,
  mul_smul := λ m n a, mul_nsmul a m n,
  smul_add := λ n a b, nsmul_add a b n,
  smul_zero := nsmul_zero,
  zero_smul := zero_nsmul,
  add_smul := λ r s x, add_nsmul x r s }

theorem add_smul : (r + s) • x = r • x + s • x := module.add_smul r s x

lemma convex.combo_self {a b : R} (h : a + b = 1) (x : M) : a • x + b • x = x :=
by rw [←add_smul, h, one_smul]

variables (R)

theorem two_smul : (2 : R) • x = x + x := by rw [bit0, add_smul, one_smul]

theorem two_smul' : (2 : R) • x = bit0 x := two_smul R x

@[simp] lemma inv_of_two_smul_add_inv_of_two_smul [invertible (2 : R)] (x : M) :
  (⅟2 : R) • x + (⅟2 : R) • x = x :=
convex.combo_self inv_of_two_add_inv_of_two _

/-- Pullback a `module` structure along an injective additive monoid homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.module [add_comm_monoid M₂] [has_scalar R M₂] (f : M₂ →+ M)
  (hf : injective f) (smul : ∀ (c : R) x, f (c • x) = c • f x) :
  module R M₂ :=
{ smul := (•),
  add_smul := λ c₁ c₂ x, hf $ by simp only [smul, f.map_add, add_smul],
  zero_smul := λ x, hf $ by simp only [smul, zero_smul, f.map_zero],
  .. hf.distrib_mul_action f smul }

/-- Pushforward a `module` structure along a surjective additive monoid homomorphism. -/
protected def function.surjective.module [add_comm_monoid M₂] [has_scalar R M₂] (f : M →+ M₂)
  (hf : surjective f) (smul : ∀ (c : R) x, f (c • x) = c • f x) :
  module R M₂ :=
{ smul := (•),
  add_smul := λ c₁ c₂ x, by { rcases hf x with ⟨x, rfl⟩,
    simp only [add_smul, ← smul, ← f.map_add] },
  zero_smul := λ x, by { rcases hf x with ⟨x, rfl⟩, simp only [← f.map_zero, ← smul, zero_smul] },
  .. hf.distrib_mul_action f smul }

/-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →+* S`.

See also `function.surjective.mul_action_left` and `function.surjective.distrib_mul_action_left`.
-/
@[reducible]
def function.surjective.module_left {R S M : Type*} [semiring R] [add_comm_monoid M]
  [module R M] [semiring S] [has_scalar S M]
  (f : R →+* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  module S M :=
{ smul := (•),
  zero_smul := λ x, by rw [← f.map_zero, hsmul, zero_smul],
  add_smul := hf.forall₂.mpr (λ a b x, by simp only [← f.map_add, hsmul, add_smul]),
  .. hf.distrib_mul_action_left f.to_monoid_hom hsmul }

variables {R} (M)

/-- Compose a `module` with a `ring_hom`, with action `f s • m`.

See note [reducible non-instances]. -/
@[reducible] def module.comp_hom [semiring S] (f : S →+* R) :
  module S M :=
{ smul := has_scalar.comp.smul f,
  add_smul := λ r s x, by simp [add_smul],
  .. mul_action_with_zero.comp_hom M f.to_monoid_with_zero_hom,
  .. distrib_mul_action.comp_hom M (f : S →* R) }

variables (R) (M)

/-- `(•)` as an `add_monoid_hom`.

This is a stronger version of `distrib_mul_action.to_add_monoid_End` -/
@[simps apply_apply]
def module.to_add_monoid_End : R →+* add_monoid.End M :=
{ map_zero' := add_monoid_hom.ext $ λ r, by simp,
  map_add' := λ x y, add_monoid_hom.ext $ λ r, by simp [add_smul],
  ..distrib_mul_action.to_add_monoid_End R M }

/-- A convenience alias for `module.to_add_monoid_End` as an `add_monoid_hom`, usually to allow the
use of `add_monoid_hom.flip`. -/
def smul_add_hom : R →+ M →+ M :=
(module.to_add_monoid_End R M).to_add_monoid_hom

variables {R M}

@[simp] lemma smul_add_hom_apply (r : R) (x : M) :
  smul_add_hom R M r x = r • x := rfl

lemma module.eq_zero_of_zero_eq_one (zero_eq_one : (0 : R) = 1) : x = 0 :=
by rw [←one_smul R x, ←zero_eq_one, zero_smul]

lemma list.sum_smul {l : list R} {x : M} : l.sum • x = (l.map (λ r, r • x)).sum :=
((smul_add_hom R M).flip x).map_list_sum l

lemma multiset.sum_smul {l : multiset R} {x : M} : l.sum • x = (l.map (λ r, r • x)).sum :=
((smul_add_hom R M).flip x).map_multiset_sum l

lemma finset.sum_smul {f : ι → R} {s : finset ι} {x : M} :
  (∑ i in s, f i) • x = (∑ i in s, (f i) • x) :=
((smul_add_hom R M).flip x).map_sum f s

end add_comm_monoid

variables (R)

/-- An `add_comm_monoid` that is a `module` over a `ring` carries a natural `add_comm_group`
structure.
See note [reducible non-instances]. -/
@[reducible]
def module.add_comm_monoid_to_add_comm_group [ring R] [add_comm_monoid M] [module R M] :
  add_comm_group M :=
{ neg          := λ a, (-1 : R) • a,
  add_left_neg := λ a, show (-1 : R) • a + a = 0, by
  { nth_rewrite 1 ← one_smul _ a,
    rw [← add_smul, add_left_neg, zero_smul] },
  ..(infer_instance : add_comm_monoid M), }

variables {R}

section add_comm_group

variables (R M) [semiring R] [add_comm_group M]

instance add_comm_group.int_module : module ℤ M :=
{ one_smul := one_zsmul,
  mul_smul := λ m n a, mul_zsmul a m n,
  smul_add := λ n a b, zsmul_add a b n,
  smul_zero := zsmul_zero,
  zero_smul := zero_zsmul,
  add_smul := λ r s x, add_zsmul x r s }

/-- A structure containing most informations as in a module, except the fields `zero_smul`
and `smul_zero`. As these fields can be deduced from the other ones when `M` is an `add_comm_group`,
this provides a way to construct a module structure by checking less properties, in
`module.of_core`. -/
@[nolint has_inhabited_instance]
structure module.core extends has_scalar R M :=
(smul_add : ∀(r : R) (x y : M), r • (x + y) = r • x + r • y)
(add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x)
(mul_smul : ∀(r s : R) (x : M), (r * s) • x = r • s • x)
(one_smul : ∀x : M, (1 : R) • x = x)

variables {R M}

/-- Define `module` without proving `zero_smul` and `smul_zero` by using an auxiliary
structure `module.core`, when the underlying space is an `add_comm_group`. -/
def module.of_core (H : module.core R M) : module R M :=
by letI := H.to_has_scalar; exact
{ zero_smul := λ x, (add_monoid_hom.mk' (λ r : R, r • x) (λ r s, H.add_smul r s x)).map_zero,
  smul_zero := λ r, (add_monoid_hom.mk' ((•) r) (H.smul_add r)).map_zero,
  ..H }

end add_comm_group

/-- A variant of `module.ext` that's convenient for term-mode. -/
-- We'll later use this to show `module ℕ M` and `module ℤ M` are subsingletons.
lemma module.ext' {R : Type*} [semiring R] {M : Type*} [add_comm_monoid M] (P Q : module R M)
  (w : ∀ (r : R) (m : M), by { haveI := P, exact r • m } = by { haveI := Q, exact r • m }) :
  P = Q :=
begin
  ext,
  exact w _ _
end

section module
variables [ring R] [add_comm_group M] [module R M] (r s : R) (x y : M)

@[simp] theorem neg_smul : -r • x = - (r • x) :=
eq_neg_of_add_eq_zero_left $ by rw [← add_smul, add_left_neg, zero_smul]

@[simp] lemma neg_smul_neg : -r • -x = r • x :=
by rw [neg_smul, smul_neg, neg_neg]

@[simp] theorem units.neg_smul (u : Rˣ) (x : M) : -u • x = - (u • x) :=
by rw [units.smul_def, units.coe_neg, neg_smul, units.smul_def]

variables (R)
theorem neg_one_smul (x : M) : (-1 : R) • x = -x := by simp
variables {R}

theorem sub_smul (r s : R) (y : M) : (r - s) • y = r • y - s • y :=
by simp [add_smul, sub_eq_add_neg]

end module

/-- A module over a `subsingleton` semiring is a `subsingleton`. We cannot register this
as an instance because Lean has no way to guess `R`. -/
protected theorem module.subsingleton (R M : Type*) [semiring R] [subsingleton R]
  [add_comm_monoid M] [module R M] :
  subsingleton M :=
⟨λ x y, by rw [← one_smul R x, ← one_smul R y, subsingleton.elim (1:R) 0, zero_smul, zero_smul]⟩

/-- A semiring is `nontrivial` provided that there exists a nontrivial module over this semiring. -/
protected theorem module.nontrivial (R M : Type*) [semiring R] [nontrivial M] [add_comm_monoid M]
  [module R M] :
  nontrivial R :=
(subsingleton_or_nontrivial R).resolve_left $ λ hR, not_subsingleton M $
  by exactI module.subsingleton R M

@[priority 910] -- see Note [lower instance priority]
instance semiring.to_module [semiring R] : module R R :=
{ smul_add := mul_add,
  add_smul := add_mul,
  zero_smul := zero_mul,
  smul_zero := mul_zero }

/-- Like `semiring.to_module`, but multiplies on the right. -/
@[priority 910] -- see Note [lower instance priority]
instance semiring.to_opposite_module [semiring R] : module Rᵐᵒᵖ R :=
{ smul_add := λ r x y, add_mul _ _ _,
  add_smul := λ r x y, mul_add _ _ _,
  ..monoid_with_zero.to_opposite_mul_action_with_zero R}

/-- A ring homomorphism `f : R →+* M` defines a module structure by `r • x = f r * x`. -/
def ring_hom.to_module [semiring R] [semiring S] (f : R →+* S) : module R S :=
module.comp_hom S f

/-- The tautological action by `R →+* R` on `R`.

This generalizes `function.End.apply_mul_action`. -/
instance ring_hom.apply_distrib_mul_action [semiring R] : distrib_mul_action (R →+* R) R :=
{ smul := ($),
  smul_zero := ring_hom.map_zero,
  smul_add := ring_hom.map_add,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] protected lemma ring_hom.smul_def [semiring R] (f : R →+* R) (a : R) :
  f • a = f a := rfl

/-- `ring_hom.apply_distrib_mul_action` is faithful. -/
instance ring_hom.apply_has_faithful_smul [semiring R] : has_faithful_smul (R →+* R) R :=
⟨ring_hom.ext⟩

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [module R M]

section
variables (R)
/-- `nsmul` is equal to any other module structure via a cast. -/
lemma nsmul_eq_smul_cast (n : ℕ) (b : M) :
  n • b = (n : R) • b :=
begin
  induction n with n ih,
  { rw [nat.cast_zero, zero_smul, zero_smul] },
  { rw [nat.succ_eq_add_one, nat.cast_succ, add_smul, add_smul, one_smul, ih, one_smul], }
end
end

/-- Convert back any exotic `ℕ`-smul to the canonical instance. This should not be needed since in
mathlib all `add_comm_monoid`s should normally have exactly one `ℕ`-module structure by design.
-/
lemma nat_smul_eq_nsmul (h : module ℕ M) (n : ℕ) (x : M) :
  @has_scalar.smul ℕ M h.to_has_scalar n x = n • x :=
by rw [nsmul_eq_smul_cast ℕ n x, nat.cast_id]

/-- All `ℕ`-module structures are equal. Not an instance since in mathlib all `add_comm_monoid`
should normally have exactly one `ℕ`-module structure by design. -/
def add_comm_monoid.nat_module.unique : unique (module ℕ M) :=
{ default := by apply_instance,
  uniq := λ P, module.ext' P _ $ λ n, nat_smul_eq_nsmul P n }

instance add_comm_monoid.nat_is_scalar_tower :
  is_scalar_tower ℕ R M :=
{ smul_assoc := λ n x y, nat.rec_on n
    (by simp only [zero_smul])
    (λ n ih, by simp only [nat.succ_eq_add_one, add_smul, one_smul, ih]) }

end add_comm_monoid

section add_comm_group

variables [semiring S] [ring R] [add_comm_group M] [module S M] [module R M]

section
variables (R)
/-- `zsmul` is equal to any other module structure via a cast. -/
lemma zsmul_eq_smul_cast (n : ℤ) (b : M) : n • b = (n : R) • b :=
have (smul_add_hom ℤ M).flip b = ((smul_add_hom R M).flip b).comp (int.cast_add_hom R),
  by { ext, simp },
add_monoid_hom.congr_fun this n
end

/-- Convert back any exotic `ℤ`-smul to the canonical instance. This should not be needed since in
mathlib all `add_comm_group`s should normally have exactly one `ℤ`-module structure by design. -/
lemma int_smul_eq_zsmul (h : module ℤ M) (n : ℤ) (x : M) :
  @has_scalar.smul ℤ M h.to_has_scalar n x = n • x :=
by rw [zsmul_eq_smul_cast ℤ n x, int.cast_id]

/-- All `ℤ`-module structures are equal. Not an instance since in mathlib all `add_comm_group`
should normally have exactly one `ℤ`-module structure by design. -/
def add_comm_group.int_module.unique : unique (module ℤ M) :=
{ default := by apply_instance,
  uniq := λ P, module.ext' P _ $ λ n, int_smul_eq_zsmul P n }

end add_comm_group

lemma map_int_cast_smul [add_comm_group M] [add_comm_group M₂] {F : Type*}
  [add_monoid_hom_class F M M₂] (f : F) (R S : Type*) [ring R] [ring S] [module R M] [module S M₂]
  (x : ℤ) (a : M) : f ((x : R) • a) = (x : S) • f a :=
by simp only [←zsmul_eq_smul_cast, map_zsmul]

lemma map_nat_cast_smul [add_comm_monoid M] [add_comm_monoid M₂] {F : Type*}
  [add_monoid_hom_class F M M₂] (f : F)
  (R S : Type*) [semiring R] [semiring S] [module R M] [module S M₂] (x : ℕ) (a : M) :
  f ((x : R) • a) = (x : S) • f a :=
by simp only [←nsmul_eq_smul_cast, map_nsmul]

lemma map_inv_int_cast_smul [add_comm_group M] [add_comm_group M₂] {F : Type*}
  [add_monoid_hom_class F M M₂] (f : F)
  (R S : Type*) [division_ring R] [division_ring S] [module R M] [module S M₂]
  (n : ℤ) (x : M) :
  f ((n⁻¹ : R) • x) = (n⁻¹ : S) • f x :=
begin
  by_cases hR : (n : R) = 0; by_cases hS : (n : S) = 0,
  { simp [hR, hS] },
  { suffices : ∀ y, f y = 0, by simp [this], clear x, intro x,
    rw [← inv_smul_smul₀ hS (f x), ← map_int_cast_smul f R S], simp [hR] },
  { suffices : ∀ y, f y = 0, by simp [this], clear x, intro x,
    rw [← smul_inv_smul₀ hR x, map_int_cast_smul f R S, hS, zero_smul] },
  { rw [← inv_smul_smul₀ hS (f _), ← map_int_cast_smul f R S, smul_inv_smul₀ hR] }
end

lemma map_inv_nat_cast_smul [add_comm_group M] [add_comm_group M₂] {F : Type*}
  [add_monoid_hom_class F M M₂] (f : F)
  (R S : Type*) [division_ring R] [division_ring S] [module R M] [module S M₂]
  (n : ℕ) (x : M) :
  f ((n⁻¹ : R) • x) = (n⁻¹ : S) • f x :=
by exact_mod_cast map_inv_int_cast_smul f R S n x

lemma map_rat_cast_smul [add_comm_group M] [add_comm_group M₂] {F : Type*}
  [add_monoid_hom_class F M M₂] (f : F)
  (R S : Type*) [division_ring R] [division_ring S] [module R M] [module S M₂]
  (c : ℚ) (x : M) :
  f ((c : R) • x) = (c : S) • f x :=
by rw [rat.cast_def, rat.cast_def, div_eq_mul_inv, div_eq_mul_inv, mul_smul, mul_smul,
  map_int_cast_smul f R S, map_inv_nat_cast_smul f R S]

lemma map_rat_smul [add_comm_group M] [add_comm_group M₂] [module ℚ M] [module ℚ M₂] {F : Type*}
  [add_monoid_hom_class F M M₂] (f : F) (c : ℚ) (x : M) :
  f (c • x) = c • f x :=
rat.cast_id c ▸ map_rat_cast_smul f ℚ ℚ c x

/-- There can be at most one `module ℚ E` structure on an additive commutative group. This is not
an instance because `simp` becomes very slow if we have many `subsingleton` instances,
see [gh-6025]. -/
lemma subsingleton_rat_module (E : Type*) [add_comm_group E] : subsingleton (module ℚ E) :=
⟨λ P Q, module.ext' P Q $ λ r x,
  @map_rat_smul _ _ _ _ P Q _ _ (add_monoid_hom.id E) r x⟩

/-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications
agree on inverses of integer numbers in `R` and `S`. -/
lemma inv_int_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R]
  [division_ring S] [module R E] [module S E] (n : ℤ) (x : E) :
  (n⁻¹ : R) • x = (n⁻¹ : S) • x :=
map_inv_int_cast_smul (add_monoid_hom.id E) R S n x

/-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications
agree on inverses of natural numbers in `R` and `S`. -/
lemma inv_nat_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R]
  [division_ring S] [module R E] [module S E] (n : ℕ) (x : E) :
  (n⁻¹ : R) • x = (n⁻¹ : S) • x :=
map_inv_nat_cast_smul (add_monoid_hom.id E) R S n x

/-- If `E` is a vector space over a division rings `R` and has a monoid action by `α`, then that
action commutes by scalar multiplication of inverses of integers in `R` -/
lemma inv_int_cast_smul_comm {α E : Type*} (R : Type*) [add_comm_group E] [division_ring R]
  [monoid α] [module R E] [distrib_mul_action α E] (n : ℤ) (s : α) (x : E) :
  (n⁻¹ : R) • s • x = s • (n⁻¹ : R) • x :=
(map_inv_int_cast_smul (distrib_mul_action.to_add_monoid_hom E s) R R n x).symm

/-- If `E` is a vector space over a division rings `R` and has a monoid action by `α`, then that
action commutes by scalar multiplication of inverses of natural numbers in `R`. -/
lemma inv_nat_cast_smul_comm {α E : Type*} (R : Type*) [add_comm_group E] [division_ring R]
  [monoid α] [module R E] [distrib_mul_action α E] (n : ℕ) (s : α) (x : E) :
  (n⁻¹ : R) • s • x = s • (n⁻¹ : R) • x :=
(map_inv_nat_cast_smul (distrib_mul_action.to_add_monoid_hom E s) R R n x).symm

/-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications
agree on rational numbers in `R` and `S`. -/
lemma rat_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R]
  [division_ring S] [module R E] [module S E] (r : ℚ) (x : E) :
  (r : R) • x = (r : S) • x :=
map_rat_cast_smul (add_monoid_hom.id E) R S r x

instance add_comm_group.int_is_scalar_tower {R : Type u} {M : Type v} [ring R] [add_comm_group M]
  [module R M]: is_scalar_tower ℤ R M :=
{ smul_assoc := λ n x y, ((smul_add_hom R M).flip y).map_zsmul x n }

instance is_scalar_tower.rat {R : Type u} {M : Type v} [ring R] [add_comm_group M]
  [module R M] [module ℚ R] [module ℚ M] : is_scalar_tower ℚ R M :=
{ smul_assoc := λ r x y, map_rat_smul ((smul_add_hom R M).flip y) r x }

instance smul_comm_class.rat {R : Type u} {M : Type v} [semiring R] [add_comm_group M]
  [module R M] [module ℚ M] : smul_comm_class ℚ R M :=
{ smul_comm := λ r x y, (map_rat_smul (smul_add_hom R M x) r y).symm }

instance smul_comm_class.rat' {R : Type u} {M : Type v} [semiring R] [add_comm_group M]
  [module R M] [module ℚ M] : smul_comm_class R ℚ M :=
smul_comm_class.symm _ _ _

section no_zero_smul_divisors
/-! ### `no_zero_smul_divisors`

This section defines the `no_zero_smul_divisors` class, and includes some tests
for the vanishing of elements (especially in modules over division rings).
-/

/-- `no_zero_smul_divisors R M` states that a scalar multiple is `0` only if either argument is `0`.
This a version of saying that `M` is torsion free, without assuming `R` is zero-divisor free.

The main application of `no_zero_smul_divisors R M`, when `M` is a module,
is the result `smul_eq_zero`: a scalar multiple is `0` iff either argument is `0`.

It is a generalization of the `no_zero_divisors` class to heterogeneous multiplication.
-/
class no_zero_smul_divisors (R M : Type*) [has_zero R] [has_zero M] [has_scalar R M] : Prop :=
(eq_zero_or_eq_zero_of_smul_eq_zero : ∀ {c : R} {x : M}, c • x = 0 → c = 0 ∨ x = 0)

export no_zero_smul_divisors (eq_zero_or_eq_zero_of_smul_eq_zero)

/-- Pullback a `no_zero_smul_divisors` instance along an injective function. -/
lemma function.injective.no_zero_smul_divisors {R M N : Type*} [has_zero R] [has_zero M]
  [has_zero N] [has_scalar R M] [has_scalar R N] [no_zero_smul_divisors R N] (f : M → N)
  (hf : function.injective f) (h0 : f 0 = 0) (hs : ∀ (c : R) (x : M), f (c • x) = c • f x) :
  no_zero_smul_divisors R M :=
⟨λ c m h,
  or.imp_right (@hf _ _) $ h0.symm ▸ eq_zero_or_eq_zero_of_smul_eq_zero (by rw [←hs, h, h0])⟩

@[priority 100] -- See note [lower instance priority]
instance no_zero_divisors.to_no_zero_smul_divisors [has_zero R] [has_mul R] [no_zero_divisors R] :
  no_zero_smul_divisors R R :=
⟨λ c x, eq_zero_or_eq_zero_of_mul_eq_zero⟩

section module

variables [semiring R] [add_comm_monoid M] [module R M]

@[simp]
theorem smul_eq_zero [no_zero_smul_divisors R M] {c : R} {x : M} :
  c • x = 0 ↔ c = 0 ∨ x = 0 :=
⟨eq_zero_or_eq_zero_of_smul_eq_zero,
 λ h, h.elim (λ h, h.symm ▸ zero_smul R x) (λ h, h.symm ▸ smul_zero c)⟩

theorem smul_ne_zero [no_zero_smul_divisors R M] {c : R} {x : M} :
  c • x ≠ 0 ↔ c ≠ 0 ∧ x ≠ 0 :=
by simp only [ne.def, smul_eq_zero, not_or_distrib]

section nat

variables (R) (M) [no_zero_smul_divisors R M] [char_zero R]
include R

lemma nat.no_zero_smul_divisors : no_zero_smul_divisors ℕ M :=
⟨by { intros c x, rw [nsmul_eq_smul_cast R, smul_eq_zero], simp }⟩

@[simp] lemma two_nsmul_eq_zero {v : M} : 2 • v = 0 ↔ v = 0 :=
by { haveI := nat.no_zero_smul_divisors R M, norm_num [smul_eq_zero] }

end nat

variables (R M)

/-- If `M` is an `R`-module with one and `M` has characteristic zero, then `R` has characteristic
zero as well. Usually `M` is an `R`-algebra. -/
lemma char_zero.of_module (M) [add_comm_monoid_with_one M] [char_zero M] [module R M] :
  char_zero R :=
begin
  refine ⟨λ m n h, @nat.cast_injective M _ _ _ _ _⟩,
  rw [← nsmul_one, ← nsmul_one, nsmul_eq_smul_cast R m (1 : M), nsmul_eq_smul_cast R n (1 : M), h]
end

end module

section add_comm_group -- `R` can still be a semiring here

variables [semiring R] [add_comm_group M] [module R M]

section smul_injective

variables (M)

lemma smul_right_injective [no_zero_smul_divisors R M] {c : R} (hc : c ≠ 0) :
  function.injective ((•) c : M → M) :=
(injective_iff_map_eq_zero (smul_add_hom R M c)).2 $ λ a ha, (smul_eq_zero.mp ha).resolve_left hc

variables {M}

lemma smul_right_inj [no_zero_smul_divisors R M] {c : R} (hc : c ≠ 0) {x y : M} :
  c • x = c • y ↔ x = y :=
(smul_right_injective M hc).eq_iff

end smul_injective

section nat

variables (R M) [no_zero_smul_divisors R M] [char_zero R]
include R

lemma self_eq_neg {v : M} : v = - v ↔ v = 0 :=
by rw [← two_nsmul_eq_zero R M, two_smul, add_eq_zero_iff_eq_neg]

lemma neg_eq_self {v : M} : - v = v ↔ v = 0 :=
by rw [eq_comm, self_eq_neg R M]

lemma self_ne_neg {v : M} : v ≠ -v ↔ v ≠ 0 :=
(self_eq_neg R M).not

lemma neg_ne_self {v : M} : -v ≠ v ↔ v ≠ 0 :=
(neg_eq_self R M).not

end nat

end add_comm_group

section module

variables [ring R] [add_comm_group M] [module R M] [no_zero_smul_divisors R M]

section smul_injective

variables (R)

lemma smul_left_injective {x : M} (hx : x ≠ 0) :
  function.injective (λ (c : R), c • x) :=
λ c d h, sub_eq_zero.mp ((smul_eq_zero.mp
  (calc (c - d) • x = c • x - d • x : sub_smul c d x
                ... = 0 : sub_eq_zero.mpr h)).resolve_right hx)

end smul_injective

end module

section division_ring

variables [division_ring R] [add_comm_group M] [module R M]

@[priority 100] -- see note [lower instance priority]
instance division_ring.to_no_zero_smul_divisors : no_zero_smul_divisors R M :=
⟨λ c x h, or_iff_not_imp_left.2 $ λ hc, (smul_eq_zero_iff_eq' hc).1 h⟩

end division_ring

end no_zero_smul_divisors

@[simp] lemma nat.smul_one_eq_coe {R : Type*} [semiring R] (m : ℕ) :
  m • (1 : R) = ↑m :=
by rw [nsmul_eq_mul, mul_one]

@[simp] lemma int.smul_one_eq_coe {R : Type*} [ring R] (m : ℤ) :
  m • (1 : R) = ↑m :=
by rw [zsmul_eq_mul, mul_one]

lemma finset.cast_card [comm_semiring R] (s : finset α) : (s.card : R) = ∑ a in s, 1 :=
by rw [finset.sum_const, nat.smul_one_eq_coe]


/-
Copyright (c) 2020 Alena Gusakov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov, Arthur Paulino, Kyle Miller

! This file was ported from Lean 3 source module combinatorics.simple_graph.matching
! leanprover-community/mathlib commit 138448ae98f529ef34eeb61114191975ee2ca508
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.SimpleGraph.DegreeSum
import Mathbin.Combinatorics.SimpleGraph.Subgraph

/-!
# Matchings

A *matching* for a simple graph is a set of disjoint pairs of adjacent vertices, and the set of all
the vertices in a matching is called its *support* (and sometimes the vertices in the support are
said to be *saturated* by the matching). A *perfect matching* is a matching whose support contains
every vertex of the graph.

In this module, we represent a matching as a subgraph whose vertices are each incident to at most
one edge, and the edges of the subgraph represent the paired vertices.

## Main definitions

* `simple_graph.subgraph.is_matching`: `M.is_matching` means that `M` is a matching of its
  underlying graph.
  denoted `M.is_matching`.

* `simple_graph.subgraph.is_perfect_matching` defines when a subgraph `M` of a simple graph is a
  perfect matching, denoted `M.is_perfect_matching`.

## TODO

* Define an `other` function and prove useful results about it (https://leanprover.zulipchat.com/#narrow/stream/252551-graph-theory/topic/matchings/near/266205863)

* Provide a bicoloring for matchings (https://leanprover.zulipchat.com/#narrow/stream/252551-graph-theory/topic/matchings/near/265495120)

* Tutte's Theorem

* Hall's Marriage Theorem (see combinatorics.hall)
-/

universe u

namespace SimpleGraph

variable {V : Type u} {G : SimpleGraph V} (M : Subgraph G)

namespace Subgraph

#print SimpleGraph.Subgraph.IsMatching /-
/--
The subgraph `M` of `G` is a matching if every vertex of `M` is incident to exactly one edge in `M`.
We say that the vertices in `M.support` are *matched* or *saturated*.
-/
def IsMatching : Prop :=
  ∀ ⦃v⦄, v ∈ M.verts → ∃! w, M.Adj v w
#align simple_graph.subgraph.is_matching SimpleGraph.Subgraph.IsMatching
-/

#print SimpleGraph.Subgraph.IsMatching.toEdge /-
/-- Given a vertex, returns the unique edge of the matching it is incident to. -/
noncomputable def IsMatching.toEdge {M : Subgraph G} (h : M.IsMatching) (v : M.verts) :
    M.edgeSetEmbedding :=
  ⟨⟦(v, (h v.property).some)⟧, (h v.property).choose_spec.1⟩
#align simple_graph.subgraph.is_matching.to_edge SimpleGraph.Subgraph.IsMatching.toEdge
-/

#print SimpleGraph.Subgraph.IsMatching.toEdge_eq_of_adj /-
theorem IsMatching.toEdge_eq_of_adj {M : Subgraph G} (h : M.IsMatching) {v w : V} (hv : v ∈ M.verts)
    (hvw : M.Adj v w) : h.toEdge ⟨v, hv⟩ = ⟨⟦(v, w)⟧, hvw⟩ :=
  by
  simp only [is_matching.to_edge, Subtype.mk_eq_mk]
  congr
  exact ((h (M.edge_vert hvw)).choose_spec.2 w hvw).symm
#align simple_graph.subgraph.is_matching.to_edge_eq_of_adj SimpleGraph.Subgraph.IsMatching.toEdge_eq_of_adj
-/

#print SimpleGraph.Subgraph.IsMatching.toEdge.surjective /-
theorem IsMatching.toEdge.surjective {M : Subgraph G} (h : M.IsMatching) :
    Function.Surjective h.toEdge := by
  rintro ⟨e, he⟩
  refine' Sym2.ind (fun x y he => _) e he
  exact ⟨⟨x, M.edge_vert he⟩, h.to_edge_eq_of_adj _ he⟩
#align simple_graph.subgraph.is_matching.to_edge.surjective SimpleGraph.Subgraph.IsMatching.toEdge.surjective
-/

#print SimpleGraph.Subgraph.IsMatching.toEdge_eq_toEdge_of_adj /-
theorem IsMatching.toEdge_eq_toEdge_of_adj {M : Subgraph G} {v w : V} (h : M.IsMatching)
    (hv : v ∈ M.verts) (hw : w ∈ M.verts) (ha : M.Adj v w) : h.toEdge ⟨v, hv⟩ = h.toEdge ⟨w, hw⟩ :=
  by
  rw [h.to_edge_eq_of_adj hv ha, h.to_edge_eq_of_adj hw (M.symm ha), Subtype.mk_eq_mk, Sym2.eq_swap]
#align simple_graph.subgraph.is_matching.to_edge_eq_to_edge_of_adj SimpleGraph.Subgraph.IsMatching.toEdge_eq_toEdge_of_adj
-/

#print SimpleGraph.Subgraph.IsPerfectMatching /-
/-- The subgraph `M` of `G` is a perfect matching on `G` if it's a matching and every vertex `G` is
matched.
-/
def IsPerfectMatching : Prop :=
  M.IsMatching ∧ M.IsSpanning
#align simple_graph.subgraph.is_perfect_matching SimpleGraph.Subgraph.IsPerfectMatching
-/

#print SimpleGraph.Subgraph.IsMatching.support_eq_verts /-
theorem IsMatching.support_eq_verts {M : Subgraph G} (h : M.IsMatching) : M.support = M.verts :=
  by
  refine' M.support_subset_verts.antisymm fun v hv => _
  obtain ⟨w, hvw, -⟩ := h hv
  exact ⟨_, hvw⟩
#align simple_graph.subgraph.is_matching.support_eq_verts SimpleGraph.Subgraph.IsMatching.support_eq_verts
-/

#print SimpleGraph.Subgraph.isMatching_iff_forall_degree /-
theorem isMatching_iff_forall_degree {M : Subgraph G} [∀ v : V, Fintype (M.neighborSet v)] :
    M.IsMatching ↔ ∀ v : V, v ∈ M.verts → M.degree v = 1 := by simpa [degree_eq_one_iff_unique_adj]
#align simple_graph.subgraph.is_matching_iff_forall_degree SimpleGraph.Subgraph.isMatching_iff_forall_degree
-/

#print SimpleGraph.Subgraph.IsMatching.even_card /-
theorem IsMatching.even_card {M : Subgraph G} [Fintype M.verts] (h : M.IsMatching) :
    Even M.verts.toFinset.card := by
  classical
    rw [is_matching_iff_forall_degree] at h
    use M.coe.edge_finset.card
    rw [← two_mul, ← M.coe.sum_degrees_eq_twice_card_edges]
    simp [h, Finset.card_univ]
#align simple_graph.subgraph.is_matching.even_card SimpleGraph.Subgraph.IsMatching.even_card
-/

#print SimpleGraph.Subgraph.isPerfectMatching_iff /-
theorem isPerfectMatching_iff : M.IsPerfectMatching ↔ ∀ v, ∃! w, M.Adj v w :=
  by
  refine' ⟨_, fun hm => ⟨fun v hv => hm v, fun v => _⟩⟩
  · rintro ⟨hm, hs⟩ v
    exact hm (hs v)
  · obtain ⟨w, hw, -⟩ := hm v
    exact M.edge_vert hw
#align simple_graph.subgraph.is_perfect_matching_iff SimpleGraph.Subgraph.isPerfectMatching_iff
-/

#print SimpleGraph.Subgraph.isPerfectMatching_iff_forall_degree /-
theorem isPerfectMatching_iff_forall_degree {M : Subgraph G} [∀ v, Fintype (M.neighborSet v)] :
    M.IsPerfectMatching ↔ ∀ v, M.degree v = 1 := by
  simp [degree_eq_one_iff_unique_adj, is_perfect_matching_iff]
#align simple_graph.subgraph.is_perfect_matching_iff_forall_degree SimpleGraph.Subgraph.isPerfectMatching_iff_forall_degree
-/

#print SimpleGraph.Subgraph.IsPerfectMatching.even_card /-
theorem IsPerfectMatching.even_card {M : Subgraph G} [Fintype V] (h : M.IsPerfectMatching) :
    Even (Fintype.card V) := by classical simpa [h.2.card_verts] using is_matching.even_card h.1
#align simple_graph.subgraph.is_perfect_matching.even_card SimpleGraph.Subgraph.IsPerfectMatching.even_card
-/

end Subgraph

end SimpleGraph


/-
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.subgroup.pointwise
import linear_algebra.span

/-! # Pointwise instances on `submodule`s

This file provides:

* `submodule.has_pointwise_neg`

and the actions

* `submodule.pointwise_distrib_mul_action`
* `submodule.pointwise_mul_action_with_zero`

which matches the action of `mul_action_set`.

These actions are available in the `pointwise` locale.

## Implementation notes

Most of the lemmas in this file are direct copies of lemmas from
`group_theory/submonoid/pointwise.lean`.
-/

variables {α : Type*} {R : Type*} {M : Type*}

open_locale pointwise

namespace submodule

section neg

section semiring
variables [semiring R] [add_comm_group M] [module R M]

/-- The submodule with every element negated. Note if `R` is a ring and not just a semiring, this
is a no-op, as shown by `submodule.neg_eq_self`.

Recall that When `R` is the semiring corresponding to the nonnegative elements of `R'`,
`submodule R' M` is the type of cones of `M`. This instance reflects such cones about `0`.

This is available as an instance in the `pointwise` locale. -/
protected def has_pointwise_neg : has_neg (submodule R M) :=
{ neg := λ p,
  { carrier := -(p : set M),
    smul_mem' := λ r m hm, set.mem_neg.2 $ smul_neg r m ▸ p.smul_mem r $ set.mem_neg.1 hm,
    ..(- p.to_add_submonoid) } }

localized "attribute [instance] submodule.has_pointwise_neg" in pointwise
open_locale pointwise

@[simp] lemma coe_set_neg (S : submodule R M) : ↑(-S) = -(S : set M) := rfl

@[simp] lemma neg_to_add_submonoid (S : submodule R M) :
  (-S).to_add_submonoid = -S.to_add_submonoid := rfl

@[simp]

/-- `submodule.has_pointwise_neg` is involutive.

This is available as an instance in the `pointwise` locale. -/
protected def has_involutive_pointwise_neg : has_involutive_neg (submodule R M) :=
{ neg := has_neg.neg,
  neg_neg := λ S, set_like.coe_injective $ neg_neg _ }

localized "attribute [instance] submodule.has_involutive_pointwise_neg" in pointwise

@[simp] lemma neg_le_neg (S T : submodule R M) : -S ≤ -T ↔ S ≤ T :=
set_like.coe_subset_coe.symm.trans set.neg_subset_neg

lemma neg_le (S T : submodule R M) : -S ≤ T ↔ S ≤ -T :=
set_like.coe_subset_coe.symm.trans set.neg_subset

/-- `submodule.has_pointwise_neg` as an order isomorphism. -/
def neg_order_iso : submodule R M ≃o submodule R M :=
{ to_equiv := equiv.neg _,
  map_rel_iff' := neg_le_neg }

lemma closure_neg (s : set M) : span R (-s) = -(span R s) :=
begin
  apply le_antisymm,
  { rw [span_le, coe_set_neg, ←set.neg_subset, neg_neg],
    exact subset_span },
  { rw [neg_le, span_le, coe_set_neg, ←set.neg_subset],
    exact subset_span }
end

@[simp]
lemma neg_inf (S T : submodule R M) : -(S ⊓ T) = (-S) ⊓ (-T) :=
set_like.coe_injective set.inter_neg

@[simp]
lemma neg_sup (S T : submodule R M) : -(S ⊔ T) = (-S) ⊔ (-T) :=
(neg_order_iso : submodule R M ≃o submodule R M).map_sup S T

@[simp]
lemma neg_bot : -(⊥ : submodule R M) = ⊥ :=
set_like.coe_injective $ (set.neg_singleton 0).trans $ congr_arg _ neg_zero

@[simp]
lemma neg_top : -(⊤ : submodule R M) = ⊤ :=
set_like.coe_injective $ set.neg_univ

@[simp]
lemma neg_infi {ι : Sort*} (S : ι → submodule R M) : -(⨅ i, S i) = ⨅ i, -S i :=
(neg_order_iso : submodule R M ≃o submodule R M).map_infi _

@[simp]
lemma neg_supr {ι : Sort*} (S : ι → submodule R M) : -(⨆ i, S i) = ⨆ i, -(S i) :=
(neg_order_iso : submodule R M ≃o submodule R M).map_supr _

end semiring

open_locale pointwise

@[simp] lemma neg_eq_self [ring R] [add_comm_group M] [module R M] (p : submodule R M) : -p = p :=
ext $ λ _, p.neg_mem_iff

end neg

variables [semiring R] [add_comm_monoid M] [module R M]

instance pointwise_add_comm_monoid : add_comm_monoid (submodule R M) :=
{ add := (⊔),
  add_assoc := λ _ _ _, sup_assoc,
  zero := ⊥,
  zero_add := λ _, bot_sup_eq,
  add_zero := λ _, sup_bot_eq,
  add_comm := λ _ _, sup_comm }

@[simp] lemma add_eq_sup (p q : submodule R M) : p + q = p ⊔ q := rfl
@[simp] lemma zero_eq_bot : (0 : submodule R M) = ⊥ := rfl

instance : canonically_ordered_add_monoid (submodule R M) :=
{ zero := 0,
  bot := ⊥,
  add := (+),
  add_le_add_left := λ a b, sup_le_sup_left,
  exists_add_of_le := λ a b h, ⟨b, (sup_eq_right.2 h).symm⟩,
  le_self_add := λ a b, le_sup_left,
  ..submodule.pointwise_add_comm_monoid,
  ..submodule.complete_lattice }

section
variables [monoid α] [distrib_mul_action α M] [smul_comm_class α R M]

/-- The action on a submodule corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_distrib_mul_action : distrib_mul_action α (submodule R M) :=
{ smul := λ a S, S.map (distrib_mul_action.to_linear_map _ _ a),
  one_smul := λ S,
    (congr_arg (λ f, S.map f) (linear_map.ext $ by exact one_smul α)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f : M →ₗ[R] M, S.map f) (linear_map.ext $ by exact mul_smul _ _)).trans
      (S.map_comp _ _),
  smul_zero := λ a, map_bot _,
  smul_add := λ a S₁ S₂, map_sup _ _ _ }

localized "attribute [instance] submodule.pointwise_distrib_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : submodule R M) : ↑(a • S) = a • (S : set M) := rfl

@[simp] lemma pointwise_smul_to_add_submonoid (a : α) (S : submodule R M) :
  (a • S).to_add_submonoid = a • S.to_add_submonoid := rfl

@[simp] lemma pointwise_smul_to_add_subgroup {R M : Type*}
  [ring R] [add_comm_group M] [distrib_mul_action α M] [module R M] [smul_comm_class α R M]
  (a : α) (S : submodule R M) :
  (a • S).to_add_subgroup = a • S.to_add_subgroup := rfl

lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submodule R M) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set M))

instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ M] [smul_comm_class αᵐᵒᵖ R M]
  [is_central_scalar α M] :
  is_central_scalar α (submodule R M) :=
⟨λ a S, congr_arg (λ f, S.map f) $ linear_map.ext $ by exact op_smul_eq_smul _⟩

@[simp] lemma smul_le_self_of_tower {α : Type*}
  [semiring α] [module α R] [module α M] [smul_comm_class α R M] [is_scalar_tower α R M]
  (a : α) (S : submodule R M) : a • S ≤ S :=
begin
  rintro y ⟨x, hx, rfl⟩,
  exact smul_of_tower_mem _ a hx,
end

end

section
variables [semiring α] [module α M] [smul_comm_class α R M]
/-- The action on a submodule corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale.

This is a stronger version of `submodule.pointwise_distrib_mul_action`. Note that `add_smul` does
not hold so this cannot be stated as a `module`. -/
protected def pointwise_mul_action_with_zero : mul_action_with_zero α (submodule R M) :=
{ zero_smul := λ S,
    (congr_arg (λ f : M →ₗ[R] M, S.map f) (linear_map.ext $ by exact zero_smul α)).trans S.map_zero,
  .. submodule.pointwise_distrib_mul_action }

localized "attribute [instance] submodule.pointwise_mul_action_with_zero" in pointwise

end

end submodule