import Saturn.Skip
import Saturn.Core
open Nat

 /- Operations and relations on the types `FinSeq α` of finite sequences,
    with proofs of correctness. Specifically, we implement:
    * elementary operations
    * concatenation of sequences
      - including a proof that the concatenation function is as required.
    * deletion and insertion of elements
      - we define deletion (properties are easy to prove)
      - we define insertion, and prove that the sequence after insertion has correct values.
      - we prove the relation between deletion and insertion.
    * searching for elements
      - we implement functions to search for elements equal to given ones
          or satisfying a predicate.
      - these functions return an index and a proof of correctness.
      - another function either finds an element with proof or shows it is not in the sequence
    * decidable equality of sequences
      - if `α` is a type with decidable equality, we implement decidable equality of `FinSeq α`.
 -/

-- Part 1:  elementary operations on `FinSeq`

namespace FinSeq
def cons {α : Type}{n: Nat}(head : α)(tail : FinSeq n α) : FinSeq (n + 1) α
  | zero, _  => head
  | j + 1, w => tail j (le_of_succ_le_succ w)

def empty {α: Type} : FinSeq zero α :=
  fun j jw => nomatch jw

infixr:66 "+|" => cons

def tail {α : Type}{n: Nat}(seq : FinSeq (n + 1) α): FinSeq n α
  | k, w => seq (k + 1) (succ_lt_succ w)

def head{α : Type}{n: Nat}(seq : FinSeq (n + 1) α): α := seq zero (zero_lt_succ _)

def init {α : Type}{n: Nat}(seq : FinSeq (n + 1) α): FinSeq n α
 | k, w => seq k (Nat.le_step w)

def last{α : Type}{n: Nat}(seq : FinSeq (n + 1) α): α :=
  seq n (Nat.le_refl _)

def list{α : Type}{n : Nat}: FinSeq n α → List α :=
  match n with
  | zero => fun _ => []
  | l + 1 => fun s => (s.head) :: (list (s.tail))
end FinSeq

theorem witness_independent{α : Type}{n : Nat}(seq: FinSeq n α) :
    (i : Nat)→ (j : Nat) → (iw : i < n) → (jw : j < n) →  (i = j) → seq i iw = seq j jw
    | i, j, _, _, eqn =>
    match j, eqn with
    | .(i), rfl => rfl

-- Part 2: concatenation
def concatSeqAux {α: Type}{n m l: Nat}: (s : n + m = l) →
    (seq1 : FinSeq n α) → (seq2 : FinSeq m α) →
       FinSeq l α :=
    match n with
    | zero => fun s => fun _ => fun seq2 => by
        have ss : l = m := by
          rw [← s]
          apply Nat.zero_add
        rw [ss]
        exact seq2
    | k + 1 => fun s seq1 seq2 =>
      let ss : k + (m + 1)  = l :=
        by
          rw [← s]
          rw [(Nat.add_comm m 1)]
          rw [(Nat.add_assoc k 1 m)]
      concatSeqAux ss (seq1.init) ((seq1.last) +| seq2)

def concatSeq {α: Type}{n m: Nat}(seq1 : FinSeq n α)(seq2 : FinSeq m α):
  FinSeq (n + m) α := concatSeqAux rfl seq1 seq2

theorem concat_aux_eqs{α: Type}{n m l: Nat}: (s : n + m = l) →
    (seq1 : FinSeq n α) → (seq2 : FinSeq m α) → (k: Nat) →
      ((kw : k < n) → (w : k < l) → concatSeqAux s seq1 seq2 k w = seq1 k kw) ∧
      ((kw : k < m) → (w : (n + k) < l) → concatSeqAux s seq1 seq2 (n + k) w = seq2 k kw) := by
        match n with
        | zero =>

            intro s seq1 seq2 k
            have ss : l = m := by
              rw [← s]
              apply Nat.zero_add
            have sf : FinSeq l α = FinSeq m α := by
              rw [ss]
            apply And.intro
            focus
              intro kw
              exact nomatch kw
            match l, m, ss, sf, seq2 with
                | d, .(d), rfl, rfl, seq =>
                    intro kw w
                    apply witness_independent
                    apply Nat.zero_add
        | p + 1 =>
          intro s seq1 seq2 k
          let ss : p + (m + 1)  = l :=
            by
              rw [← s]
              rw [(Nat.add_comm m 1)]
              rw [(Nat.add_assoc p 1 m)]
              done
          let resolve : concatSeqAux s seq1 seq2=
              concatSeqAux ss (seq1.init) ((seq1.last) +| seq2) := rfl
          rw [resolve]
          let hyp := concat_aux_eqs ss (seq1.init) ((seq1.last) +| seq2)
          let hyp1 := (hyp k).left
          apply And.intro
          focus
              intro kw w
              match Nat.eq_or_lt_of_le kw with
              | Or.inr kww => exact hyp1 (le_of_succ_le_succ kww) w
              | Or.inl eql =>
                  match k, eql, kw, w with
                  | .(p), rfl, pw, w =>
                    let ww : p + zero < l := by
                      rw [(Nat.add_zero p)]
                      assumption
                    let hyp2 := (hyp zero).right (Nat.zero_lt_succ _) ww
                    let lem2 : concatSeqAux ss (seq1.init) (seq1.last+|seq2) (p + zero) ww =
                          concatSeqAux ss (seq1.init) (seq1.last+|seq2) p w :=
                          match (p + zero), Nat.add_zero p, ww with
                          | .(p), rfl, ww => rfl
                    rw [← lem2]
                    rw [hyp2]
                    rfl
          let ass := Nat.add_assoc p 1 k
          let comm := Nat.add_comm 1 k
          intro kw w
          match p + 1 + k, ass, w with
          | .(p + (1 + k)), rfl, ww =>
            let hypw := (hyp (1 + k)).right
            let kww : 1 + k < m + 1 := by
              rw [comm]
              apply Nat.succ_lt_succ
              assumption
            let resol := hypw kww ww
            rw [resol]
            match 1 + k, comm, kww with
            | .(k + 1), rfl, kwww => rfl

infix:65 "++|" => concatSeq

theorem concat_empty_seq_id{α: Type}{n: Nat}: (seq : FinSeq n α) → seq ++| (FinSeq.empty) = seq :=
          by
            intro seq
            apply funext
            intro k
            apply funext
            intro kw
            apply (concat_aux_eqs rfl seq FinSeq.empty k).left

-- Part 3 : insertion and deletion

def FinSeq.delete{α : Type}{n: Nat}(k : Nat) (kw : k < (n + 1)) (seq : FinSeq (n + 1) α): FinSeq n α
  | j, w => seq (skip k j) (skip_le_succ w)

structure ProvedInsert{α : Type}{n: Nat}(value : α) (seq : FinSeq n α)
                (k : Nat)(kw : k < n + 1)(j: Nat) (jw : j < n + 1) where
  result : α
  checkImage : (i : Nat) → (iw : i < n) → (skip  k i = j) → result = seq i iw
  checkFocus : j = k → result = value

def provedInsert{α : Type}(n: Nat)(value : α) (seq : FinSeq n α)
                (k : Nat)(kw : k < n + 1)(j: Nat) (jw : j < n + 1) :
                  ProvedInsert value seq k kw j jw :=
          if c: j = k then
            let result := value
            let checkImage :
              (i : Nat) → (iw : i < n) → (skip  k i = j) → result = seq i iw := by
                  intro i iw hyp
                  rw [c] at hyp
                  exact False.elim $ skip_no_fixedpoints k i hyp
            let  checkFocus : j = k → result = value := fun  _  => rfl
            ⟨result, checkImage, checkFocus⟩
          else
            let ii := skipInverse k j c
            let eqn := skip_inverse_eq k j c
            let bound : ii < n  := skip_preimage_lt kw jw eqn
            let result := seq ii bound
            let checkImage :
              (i : Nat) → (iw : i < n) → (skip  k i = j) → seq ii bound = seq i iw := by
                  intro i1 iw1 hyp
                  apply witness_independent
                  apply (skip_injective k)
                  rw [hyp]
                  rw [← eqn]
            let  checkFocus : j = k → result = value := by
                intro  hyp
                rw [← eqn] at hyp
                exact False.elim $ skip_no_fixedpoints k ii hyp
            ⟨result, checkImage, checkFocus⟩

def FinSeq.insert{α : Type}(value: α) : (n : Nat) →  (k: Nat) →
    (lt : k < succ n) → (FinSeq n   α) →  (FinSeq (Nat.succ n)  α)
  | n, k, lt, seq, j, w => (provedInsert n value seq k lt j w).result

open FinSeq

theorem insert_at_focus{α : Type}(value: α) : (n : Nat) →  (k: Nat) →
    (lt : k < succ n) → (seq :FinSeq n   α) →  insert value n k lt seq k lt = value
  | n, k, lt, seq =>   (provedInsert n value seq k lt k lt).checkFocus rfl

theorem insert_at_image(value: α) : (n : Nat) →  (k: Nat) →
    (lt : k < succ n) → (seq :FinSeq n   α) → (i : Nat) → (iw : i < n) →
      insert value n k lt seq (skip k i) (skip_le_succ iw) = seq i iw
     | n, k, lt, seq, i, iw =>
       (provedInsert n value seq k lt (skip k i) (skip_le_succ iw)).checkImage i iw rfl

theorem insert_delete_id{α : Type}{n: Nat}(k : Nat) (kw : k < (n + 1)) (seq : FinSeq (n + 1) α) :
  insert (seq k kw) n k kw (delete k kw seq) = seq :=
    funext $ fun j => funext $ fun jw =>
        if c : j = k then
          by
          match j, jw, c with
          | .(k), .(kw), rfl => apply insert_at_focus
        else
          by
          let i := skipInverse k j c
          let eqn : skip k i = j  := skip_inverse_eq k j c
          let iw : i < n := skip_preimage_lt kw jw eqn
          let lem1 : insert (seq k kw) n k kw (delete k kw seq) j jw
            = insert (seq k kw) n k kw (delete k kw seq) (skip k i) (skip_le_succ iw) :=
              by
                apply witness_independent
                rw [← eqn]
          let lem2 : insert (seq k kw) n k kw (delete k kw seq) (skip k i) (_ : skip k i < n + 1) =
                        delete k kw seq i iw := by apply insert_at_image
          let resolve : delete k kw seq i iw = seq (skip k i) (skip_le_succ iw) := by rfl
          rw [lem1]
          rw [lem2]
          rw [resolve]
          apply witness_independent
          exact eqn

-- Part 4 : searching

structure ElemInSeq{α: Type}{n : Nat} (seq : FinSeq n α) (elem : α) where
  index: Nat
  bound : index < n
  equation : seq index bound = elem

inductive ExistsElem{α: Type}{n : Nat} (seq : FinSeq n α) (elem : α) where
  | exsts : (index: Nat) →  (bound : index < n) →
            (equation : seq index bound = elem) → ExistsElem seq elem
  | notExst : ((index: Nat) →  (bound : index < n) →
                 Not (seq index bound = elem)) → ExistsElem seq elem

structure ElemSeqPred{α: Type}{n : Nat} (seq : FinSeq n α) (pred : α → Prop) where
  index: Nat
  bound : index < n
  equation : pred (seq index bound)

def elemPredAt{α: Type}{n : Nat}(pred : α → Prop)[DecidablePred pred]
  (seq : FinSeq n α)(k: Nat): Option (ElemSeqPred seq pred) :=
    if lt : k <n then
      if eqn : pred (seq k lt)
        then some ⟨k, lt, eqn⟩
        else none
    else none

def findAux?{α: Type}{n : Nat}(pred : α → Prop)(cursor: Nat)
      (cursorBound : cursor < n)[DecidablePred pred]:
  (seq : FinSeq n α) → Option (ElemSeqPred seq pred) :=
    fun seq =>
      if eqn : pred (seq cursor cursorBound)
        then some ⟨cursor, cursorBound, eqn⟩
        else
          match cursor, cursorBound with
          | zero, _ => none
          | l + 1, cb =>
            let bd : l + 1 ≤  n := by
                apply Nat.le_of_lt
                exact cb
            findAux? pred l bd seq

def find?{α: Type}{n : Nat}(pred : α → Prop)[DecidablePred pred]:
  (seq : FinSeq n α) → Option (ElemSeqPred seq pred) :=
  match n with
  | zero => fun _ =>  none
  | m + 1 => fun seq => findAux? pred m (Nat.le_refl _) seq

def findFilteredAux?{α: Type}{n : Nat}(filter : FinSeq n Bool)(pred : α → Prop)(cursor: Nat)
      (cursorBound : cursor < n)[DecidablePred pred]:
  (seq : FinSeq n α) → Option (ElemSeqPred seq pred) :=
    fun seq =>
    if filter cursor cursorBound then
      if eqn : pred (seq cursor cursorBound)
        then some ⟨cursor, cursorBound, eqn⟩
        else
          match cursor, cursorBound with
          | zero, _ => none
          | l + 1, cb =>
            let bd : l + 1 ≤  n := by
                apply Nat.le_of_lt
                exact cb
            findFilteredAux? filter pred l bd seq
    else
      match cursor, cursorBound with
          | zero, _ => none
          | l + 1, cb =>
            let bd : l + 1 ≤  n := by
                apply Nat.le_of_lt
                exact cb
            findFilteredAux? filter pred l bd seq

def findFiltered?{α: Type}{n : Nat}(filter : FinSeq n Bool)(pred : α → Prop)[DecidablePred pred]:
  (seq : FinSeq n α) → Option (ElemSeqPred seq pred) :=
  match n, filter with
  | zero, _ => fun _ =>  none
  | m + 1, filter => fun seq => findFilteredAux? filter pred m (Nat.le_refl _) seq

def findElemAux?{α: Type}{n : Nat}(cursor: Nat)
      (cursorBound : cursor < n)[DecidableEq α]:
  (seq: FinSeq n  α) → (elem: α) →  Option (ElemInSeq seq elem) :=
    fun seq  elem =>
      if eqn : seq cursor cursorBound = elem
        then some ⟨cursor, cursorBound, eqn⟩
        else
          match cursor, cursorBound with
          | zero, _ => none
          | l + 1, cb =>
            let bd : l + 1 ≤  n := by
                apply Nat.le_of_lt
                exact cb
            findElemAux? l bd seq elem

def findElem?{α: Type}[deq: DecidableEq α]{n: Nat}:
  (seq: FinSeq n  α) → (elem: α) →  Option (ElemInSeq seq elem) :=
   match n with
  | zero => fun _ _ =>  none
  | m + 1 => fun seq elem => findElemAux?  m (Nat.le_refl _) seq elem

def elemNotBeyond{α: Type}{n : Nat}(seq : FinSeq n α)(elem : α)(m: Nat): Prop :=
      ∀ k: Nat, ∀ kw : k <n, ∀ mw : m ≤ k, Not (seq k kw = elem)

def elem_not_beyond_zero_implies_not_exsts{α: Type}{n : Nat}(seq : FinSeq n α)(elem: α):
    elemNotBeyond seq elem zero → ExistsElem seq elem :=
    fun hyp => ExistsElem.notExst $
    by
      intro k
      intro kw
      exact hyp k kw  (Nat.zero_le k)

theorem elem_not_beyond_vacuously{α: Type}{n : Nat}(seq : FinSeq n α)(elem: α)(m: Nat):
    (n ≤ m) → elemNotBeyond seq elem m  := by
      intro hyp k kw ineq
      let inq := Nat.le_trans hyp ineq
      let inq2 := Nat.lt_of_lt_of_le kw inq
      exact (False.elim (Nat.lt_irrefl k inq2))

def searchElemRec{α: Type}[deq: DecidableEq α]{n: Nat}:
  (seq: FinSeq n  α) → (elem: α) →
  (m: Nat) → elemNotBeyond seq elem m →   ExistsElem seq elem :=
  fun seq elem m =>
  match m with
  | zero => fun hyp => elem_not_beyond_zero_implies_not_exsts seq elem hyp
  | l + 1 =>
    fun hyp =>
    if lw : l < n then
      if eqn : seq l lw = elem
        then ExistsElem.exsts l lw eqn
        else
          let accum : elemNotBeyond seq elem l :=
            by
                    intro k kw ineq
                    cases Nat.eq_or_lt_of_le ineq with
                    | inl eql =>
                      let lem1 : seq l lw = seq k kw := by
                        apply witness_independent
                        exact eql
                      rw [← lem1]
                      exact eqn
                    | inr lt => exact hyp k kw lt
        searchElemRec seq elem l accum
    else
    let overshoot : n ≤ l := by
            cases Nat.lt_or_ge l n with
            | inl l1 => exact absurd l1 lw
            | inr l2 => exact l2
          let accum: elemNotBeyond seq elem l :=
            elem_not_beyond_vacuously seq elem l overshoot
          searchElemRec seq elem l accum

def searchElem{α: Type}[deq: DecidableEq α]{n: Nat}:
  (seq: FinSeq n  α) → (elem: α) →  ExistsElem seq elem :=
  fun seq elem => searchElemRec seq elem n
            (elem_not_beyond_vacuously seq elem n (Nat.le_refl _))

def findSome?{α β : Type}{n: Nat}(f : α → Option β) : (FinSeq n  α) → Option β :=
    match n with
    | zero => fun _ => none
    | m + 1 =>
      fun seq =>
        match (f (seq zero (zero_lt_succ m))) with
        | none =>
          findSome? f (fun t : Nat => fun w : t < m => seq (t + 1)
                (Nat.succ_lt_succ w) )
        | some b => some b

-- Part 5 : equality

def equalBeyond{α: Type}{n : Nat}(seq1 seq2 : FinSeq n α)(m: Nat): Prop :=
  ∀ k: Nat, ∀ kw : k <n, ∀ mw : m ≤ k, seq1 k kw = seq2 k kw

theorem equal_beyond_zero_implies_equals{α: Type}{n : Nat}(seq1 seq2 : FinSeq n α):
    equalBeyond seq1 seq2 zero → seq1 = seq2 := by
      intro hyp
      apply funext
      intro k
      apply funext
      intro kw
      exact hyp k kw  (Nat.zero_le k)

theorem equal_beyond_vacuously{α: Type}{n : Nat}(seq1 seq2 : FinSeq n α)(m: Nat):
    (n ≤ m) → equalBeyond seq1 seq2 m := by
      intro hyp k kw ineq
      let inq := Nat.le_trans hyp ineq
      let inq2 := Nat.lt_of_lt_of_le kw inq
      exact (False.elim (Nat.lt_irrefl k inq2))

def deqSeqRec{α: Type}[DecidableEq α]{n : Nat}(seq1 seq2 : FinSeq n α): (m: Nat) →
      Decidable (equalBeyond seq1 seq2 m) →
      Decidable (seq1 = seq2) :=
      fun m dec =>
      match m, dec with
      | m, isFalse contra =>
        isFalse (
          by
            intro hyp
            have restr : equalBeyond seq1 seq2 m := by
              intro k kw _
              rw [hyp]
            exact contra restr)
      | zero, isTrue pf =>
        isTrue (equal_beyond_zero_implies_equals seq1 seq2 pf)
      | l + 1, isTrue eql_bynd  =>
        if lw : l < n then
          match decEq (seq1 l lw) (seq2 l lw) with
          | isTrue eql_at_l =>
              let accum: Decidable (equalBeyond seq1 seq2 l) :=
                isTrue (
                  by
                    intro k kw ineq
                    cases Nat.eq_or_lt_of_le ineq with
                    | inl eql =>
                      let lem1 : seq1 l lw = seq1 k kw := by
                        apply witness_independent
                        exact eql
                      let lem2 : seq2 l lw = seq2 k kw := by
                        apply witness_independent
                        exact eql
                      rw [← lem1]
                      rw [← lem2]
                      exact eql_at_l
                    | inr l2 =>
                      exact eql_bynd k kw l2
                )
              deqSeqRec seq1 seq2 l accum
          | isFalse contra => isFalse (fun hyp =>
                        contra (
                          by
                            rw [hyp]
                            done
                          )
                          )
        else
          let overshoot : n ≤ l := by
            cases Nat.lt_or_ge l n with
            | inl l1 => exact absurd l1 lw
            | inr l2 => exact l2
          let accum: Decidable (equalBeyond seq1 seq2 l) :=
            isTrue (equal_beyond_vacuously seq1 seq2 l overshoot)
          deqSeqRec seq1 seq2 l accum

def deqSeq {α : Type}[DecidableEq α] (n: Nat) : (c1 : FinSeq n  α) →
                              (c2: FinSeq n  α) → Decidable (c1 = c2) :=
              fun seq1 seq2 =>
                deqSeqRec seq1 seq2 n (isTrue (equal_beyond_vacuously seq1 seq2 n (Nat.le_refl n)))

instance {n: Nat}[DecidableEq α] : DecidableEq (FinSeq n  α) := fun c1 c2 => deqSeq _ c1 c2


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

! This file was ported from Lean 3 source module algebra.periodic
! leanprover-community/mathlib commit 30413fc89f202a090a54d78e540963ed3de0056e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Algebra.Field.Opposite
import Mathlib.Algebra.Module.Basic
import Mathlib.Algebra.Order.Archimedean
import Mathlib.Data.Int.Parity
import Mathlib.GroupTheory.Coset
import Mathlib.GroupTheory.Subgroup.Zpowers
import Mathlib.GroupTheory.Submonoid.Membership

/-!
# Periodicity

In this file we define and then prove facts about periodic and antiperiodic functions.

## Main definitions

* `Function.Periodic`: A function `f` is *periodic* if `∀ x, f (x + c) = f x`.
  `f` is referred to as periodic with period `c` or `c`-periodic.

* `Function.Antiperiodic`: A function `f` is *antiperiodic* if `∀ x, f (x + c) = -f x`.
  `f` is referred to as antiperiodic with antiperiod `c` or `c`-antiperiodic.

Note that any `c`-antiperiodic function will necessarily also be `2*c`-periodic.

## Tags

period, periodic, periodicity, antiperiodic
-/

variable {α β γ : Type _} {f g : α → β} {c c₁ c₂ x : α}

open Set BigOperators

namespace Function

/-! ### Periodicity -/

/-- A function `f` is said to be `periodic` with period `c` if for all `x`, `f (x + c) = f x`. -/
@[simp]
def Periodic [Add α] (f : α → β) (c : α) : Prop :=
  ∀ x : α, f (x + c) = f x
#align function.periodic Function.Periodic

protected theorem Periodic.funext [Add α] (h : Periodic f c) : (fun x => f (x + c)) = f :=
  funext h
#align function.periodic.funext Function.Periodic.funext

protected theorem Periodic.comp [Add α] (h : Periodic f c) (g : β → γ) : Periodic (g ∘ f) c := by
  simp_all
#align function.periodic.comp Function.Periodic.comp

theorem Periodic.comp_addHom [Add α] [Add γ] (h : Periodic f c) (g : AddHom γ α) (g_inv : α → γ)
    (hg : RightInverse g_inv g) : Periodic (f ∘ g) (g_inv c) := fun x => by
  simp only [hg c, h (g x), map_add, comp_apply]
#align function.periodic.comp_add_hom Function.Periodic.comp_addHom

@[to_additive]
protected theorem Periodic.mul [Add α] [Mul β] (hf : Periodic f c) (hg : Periodic g c) :
    Periodic (f * g) c := by simp_all
#align function.periodic.mul Function.Periodic.mul
#align function.periodic.add Function.Periodic.add

@[to_additive]
protected theorem Periodic.div [Add α] [Div β] (hf : Periodic f c) (hg : Periodic g c) :
    Periodic (f / g) c := by simp_all
#align function.periodic.div Function.Periodic.div
#align function.periodic.sub Function.Periodic.sub

@[to_additive]
theorem _root_.List.periodic_prod [Add α] [Monoid β] (l : List (α → β))
    (hl : ∀ f ∈ l, Periodic f c) : Periodic l.prod c := by
  induction' l with g l ih hl
  · simp
  · rw [List.forall_mem_cons] at hl
    simpa only [List.prod_cons] using hl.1.mul (ih hl.2)
#align list.periodic_prod List.periodic_prod
#align list.periodic_sum List.periodic_sum

@[to_additive]
theorem _root_.Multiset.periodic_prod [Add α] [CommMonoid β] (s : Multiset (α → β))
    (hs : ∀ f ∈ s, Periodic f c) : Periodic s.prod c :=
  (s.prod_toList ▸ s.toList.periodic_prod) fun f hf => hs f <| Multiset.mem_toList.mp hf
#align multiset.periodic_prod Multiset.periodic_prod
#align multiset.periodic_sum Multiset.periodic_sum

@[to_additive]
theorem _root_.Finset.periodic_prod [Add α] [CommMonoid β] {ι : Type _} {f : ι → α → β}
    (s : Finset ι) (hs : ∀ i ∈ s, Periodic (f i) c) : Periodic (∏ i in s, f i) c :=
  s.prod_to_list f ▸ (s.toList.map f).periodic_prod (by simpa [-Periodic] )
#align finset.periodic_prod Finset.periodic_prod
#align finset.periodic_sum Finset.periodic_sum

@[to_additive]
protected theorem Periodic.smul [Add α] [SMul γ β] (h : Periodic f c) (a : γ) :
    Periodic (a • f) c := by simp_all
#align function.periodic.smul Function.Periodic.smul
#align function.periodic.vadd Function.Periodic.vadd

protected theorem Periodic.const_smul [AddMonoid α] [Group γ] [DistribMulAction γ α]
    (h : Periodic f c) (a : γ) : Periodic (fun x => f (a • x)) (a⁻¹ • c) := fun x => by
  simpa only [smul_add, smul_inv_smul] using h (a • x)
#align function.periodic.const_smul Function.Periodic.const_smul

protected theorem Periodic.const_smul₀ [AddCommMonoid α] [DivisionSemiring γ] [Module γ α]
    (h : Periodic f c) (a : γ) : Periodic (fun x => f (a • x)) (a⁻¹ • c) := fun x => by
  by_cases ha : a = 0
  · simp only [ha, zero_smul]
  · simpa only [smul_add, smul_inv_smul₀ ha] using h (a • x)
#align function.periodic.const_smul₀ Function.Periodic.const_smul₀

protected theorem Periodic.const_mul [DivisionSemiring α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (a * x)) (a⁻¹ * c) :=
  Periodic.const_smul₀ h a
#align function.periodic.const_mul Function.Periodic.const_mul

theorem Periodic.const_inv_smul [AddMonoid α] [Group γ] [DistribMulAction γ α] (h : Periodic f c)
    (a : γ) : Periodic (fun x => f (a⁻¹ • x)) (a • c) := by
  simpa only [inv_inv] using h.const_smul a⁻¹
#align function.periodic.const_inv_smul Function.Periodic.const_inv_smul

theorem Periodic.const_inv_smul₀ [AddCommMonoid α] [DivisionSemiring γ] [Module γ α]
    (h : Periodic f c) (a : γ) : Periodic (fun x => f (a⁻¹ • x)) (a • c) := by
  simpa only [inv_inv] using h.const_smul₀ a⁻¹
#align function.periodic.const_inv_smul₀ Function.Periodic.const_inv_smul₀

theorem Periodic.const_inv_mul [DivisionSemiring α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (a⁻¹ * x)) (a * c) :=
  h.const_inv_smul₀ a
#align function.periodic.const_inv_mul Function.Periodic.const_inv_mul

theorem Periodic.mul_const [DivisionSemiring α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (x * a)) (c * a⁻¹) :=
  h.const_smul₀ (MulOpposite.op a)
#align function.periodic.mul_const Function.Periodic.mul_const

theorem Periodic.mul_const' [DivisionSemiring α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (x * a)) (c / a) := by simpa only [div_eq_mul_inv] using h.mul_const a
#align function.periodic.mul_const' Function.Periodic.mul_const'

theorem Periodic.mul_const_inv [DivisionSemiring α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (x * a⁻¹)) (c * a) :=
  h.const_inv_smul₀ (MulOpposite.op a)
#align function.periodic.mul_const_inv Function.Periodic.mul_const_inv

theorem Periodic.div_const [DivisionSemiring α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (x / a)) (c * a) := by simpa only [div_eq_mul_inv] using h.mul_const_inv a
#align function.periodic.div_const Function.Periodic.div_const

theorem Periodic.add_period [AddSemigroup α] (h1 : Periodic f c₁) (h2 : Periodic f c₂) :
    Periodic f (c₁ + c₂) := by simp_all [← add_assoc]
#align function.periodic.add_period Function.Periodic.add_period

theorem Periodic.sub_eq [AddGroup α] (h : Periodic f c) (x : α) : f (x - c) = f x := by
  simpa only [sub_add_cancel] using (h (x - c)).symm
#align function.periodic.sub_eq Function.Periodic.sub_eq

theorem Periodic.sub_eq' [AddCommGroup α] (h : Periodic f c) : f (c - x) = f (-x) := by
  simpa only [sub_eq_neg_add] using h (-x)
#align function.periodic.sub_eq' Function.Periodic.sub_eq'

protected theorem Periodic.neg [AddGroup α] (h : Periodic f c) : Periodic f (-c) := by
  simpa only [sub_eq_add_neg, Periodic] using h.sub_eq
#align function.periodic.neg Function.Periodic.neg

theorem Periodic.sub_period [AddGroup α] (h1 : Periodic f c₁) (h2 : Periodic f c₂) :
    Periodic f (c₁ - c₂) := fun x => by
  rw [sub_eq_add_neg, ← add_assoc, h2.neg, h1]
#align function.periodic.sub_period Function.Periodic.sub_period

theorem Periodic.const_add [AddSemigroup α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (a + x)) c := fun x => by simpa [add_assoc] using h (a + x)
#align function.periodic.const_add Function.Periodic.const_add

theorem Periodic.add_const [AddCommSemigroup α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (x + a)) c := fun x => by
  simpa only [add_right_comm] using h (x + a)
#align function.periodic.add_const Function.Periodic.add_const

theorem Periodic.const_sub [AddCommGroup α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (a - x)) c := fun x => by
  simp only [← sub_sub, h.sub_eq]
#align function.periodic.const_sub Function.Periodic.const_sub

theorem Periodic.sub_const [AddCommGroup α] (h : Periodic f c) (a : α) :
    Periodic (fun x => f (x - a)) c :=  by
  simpa only [sub_eq_add_neg] using h.add_const (-a)
#align function.periodic.sub_const Function.Periodic.sub_const

theorem Periodic.nsmul [AddMonoid α] (h : Periodic f c) (n : ℕ) : Periodic f (n • c) := by
  induction n <;> simp_all [Nat.succ_eq_add_one, add_nsmul, ← add_assoc, zero_nsmul]
#align function.periodic.nsmul Function.Periodic.nsmul

theorem Periodic.nat_mul [Semiring α] (h : Periodic f c) (n : ℕ) : Periodic f (n * c) := by
  simpa only [nsmul_eq_mul] using h.nsmul n
#align function.periodic.nat_mul Function.Periodic.nat_mul

theorem Periodic.neg_nsmul [AddGroup α] (h : Periodic f c) (n : ℕ) : Periodic f (-(n • c)) :=
  (h.nsmul n).neg
#align function.periodic.neg_nsmul Function.Periodic.neg_nsmul

theorem Periodic.neg_nat_mul [Ring α] (h : Periodic f c) (n : ℕ) : Periodic f (-(n * c)) :=
  (h.nat_mul n).neg
#align function.periodic.neg_nat_mul Function.Periodic.neg_nat_mul

theorem Periodic.sub_nsmul_eq [AddGroup α] (h : Periodic f c) (n : ℕ) : f (x - n • c) = f x := by
  simpa only [sub_eq_add_neg] using h.neg_nsmul n x
#align function.periodic.sub_nsmul_eq Function.Periodic.sub_nsmul_eq

theorem Periodic.sub_nat_mul_eq [Ring α] (h : Periodic f c) (n : ℕ) : f (x - n * c) = f x := by
  simpa only [nsmul_eq_mul] using h.sub_nsmul_eq n
#align function.periodic.sub_nat_mul_eq Function.Periodic.sub_nat_mul_eq

theorem Periodic.nsmul_sub_eq [AddCommGroup α] (h : Periodic f c) (n : ℕ) :
    f (n • c - x) = f (-x) :=
  (h.nsmul n).sub_eq'
#align function.periodic.nsmul_sub_eq Function.Periodic.nsmul_sub_eq

theorem Periodic.nat_mul_sub_eq [Ring α] (h : Periodic f c) (n : ℕ) : f (n * c - x) = f (-x) := by
  simpa only [sub_eq_neg_add] using h.nat_mul n (-x)
#align function.periodic.nat_mul_sub_eq Function.Periodic.nat_mul_sub_eq

protected theorem Periodic.zsmul [AddGroup α] (h : Periodic f c) (n : ℤ) : Periodic f (n • c) := by
  cases' n with n n
  · simpa only [Int.ofNat_eq_coe, coe_nat_zsmul] using h.nsmul n
  · simpa only [negSucc_zsmul] using (h.nsmul (n + 1)).neg
#align function.periodic.zsmul Function.Periodic.zsmul

protected theorem Periodic.int_mul [Ring α] (h : Periodic f c) (n : ℤ) : Periodic f (n * c) := by
  simpa only [zsmul_eq_mul] using h.zsmul n
#align function.periodic.int_mul Function.Periodic.int_mul

theorem Periodic.sub_zsmul_eq [AddGroup α] (h : Periodic f c) (n : ℤ) : f (x - n • c) = f x :=
  (h.zsmul n).sub_eq x
#align function.periodic.sub_zsmul_eq Function.Periodic.sub_zsmul_eq

theorem Periodic.sub_int_mul_eq [Ring α] (h : Periodic f c) (n : ℤ) : f (x - n * c) = f x :=
  (h.int_mul n).sub_eq x
#align function.periodic.sub_int_mul_eq Function.Periodic.sub_int_mul_eq

theorem Periodic.zsmul_sub_eq [AddCommGroup α] (h : Periodic f c) (n : ℤ) :
    f (n • c - x) = f (-x) :=
  (h.zsmul _).sub_eq'
#align function.periodic.zsmul_sub_eq Function.Periodic.zsmul_sub_eq

theorem Periodic.int_mul_sub_eq [Ring α] (h : Periodic f c) (n : ℤ) : f (n * c - x) = f (-x) :=
  (h.int_mul _).sub_eq'
#align function.periodic.int_mul_sub_eq Function.Periodic.int_mul_sub_eq

protected theorem Periodic.eq [AddZeroClass α] (h : Periodic f c) : f c = f 0 := by
  simpa only [zero_add] using h 0
#align function.periodic.eq Function.Periodic.eq

protected theorem Periodic.neg_eq [AddGroup α] (h : Periodic f c) : f (-c) = f 0 :=
  h.neg.eq
#align function.periodic.neg_eq Function.Periodic.neg_eq

protected theorem Periodic.nsmul_eq [AddMonoid α] (h : Periodic f c) (n : ℕ) : f (n • c) = f 0 :=
  (h.nsmul n).eq
#align function.periodic.nsmul_eq Function.Periodic.nsmul_eq

theorem Periodic.nat_mul_eq [Semiring α] (h : Periodic f c) (n : ℕ) : f (n * c) = f 0 :=
  (h.nat_mul n).eq
#align function.periodic.nat_mul_eq Function.Periodic.nat_mul_eq

theorem Periodic.zsmul_eq [AddGroup α] (h : Periodic f c) (n : ℤ) : f (n • c) = f 0 :=
  (h.zsmul n).eq
#align function.periodic.zsmul_eq Function.Periodic.zsmul_eq

/-- If a function `f` is `periodic` with positive period `c`, then for all `x` there exists some
  `y ∈ Ico 0 c` such that `f x = f y`. -/
theorem Periodic.exists_mem_Ico₀ [LinearOrderedAddCommGroup α] [Archimedean α] (h : Periodic f c)
    (hc : 0 < c) (x) : ∃ y ∈ Ico 0 c, f x = f y :=
  let ⟨n, H, _⟩ := existsUnique_zsmul_near_of_pos' hc x
  ⟨x - n • c, H, (h.sub_zsmul_eq n).symm⟩
#align function.periodic.exists_mem_Ico₀ Function.Periodic.exists_mem_Ico₀

/-- If a function `f` is `periodic` with positive period `c`, then for all `x` there exists some
  `y ∈ Ico a (a + c)` such that `f x = f y`. -/
theorem Periodic.exists_mem_Ico [LinearOrderedAddCommGroup α] [Archimedean α] (h : Periodic f c)
    (hc : 0 < c) (x a) : ∃ y ∈ Ico a (a + c), f x = f y :=
  let ⟨n, H, _⟩ := existsUnique_add_zsmul_mem_Ico hc x a
  ⟨x + n • c, H, (h.zsmul n x).symm⟩
#align function.periodic.exists_mem_Ico Function.Periodic.exists_mem_Ico

/-- If a function `f` is `periodic` with positive period `c`, then for all `x` there exists some
  `y ∈ Ioc a (a + c)` such that `f x = f y`. -/
theorem Periodic.exists_mem_Ioc [LinearOrderedAddCommGroup α] [Archimedean α] (h : Periodic f c)
    (hc : 0 < c) (x a) : ∃ y ∈ Ioc a (a + c), f x = f y :=
  let ⟨n, H, _⟩ := existsUnique_add_zsmul_mem_Ioc hc x a
  ⟨x + n • c, H, (h.zsmul n x).symm⟩
#align function.periodic.exists_mem_Ioc Function.Periodic.exists_mem_Ioc

theorem Periodic.image_Ioc [LinearOrderedAddCommGroup α] [Archimedean α] (h : Periodic f c)
    (hc : 0 < c) (a : α) : f '' Ioc a (a + c) = range f :=
  (image_subset_range _ _).antisymm <|range_subset_iff.2 fun x =>
    let ⟨y, hy, hyx⟩ := h.exists_mem_Ioc hc x a
    ⟨y, hy, hyx.symm⟩
#align function.periodic.image_Ioc Function.Periodic.image_Ioc

theorem Periodic.image_Icc [LinearOrderedAddCommGroup α] [Archimedean α] (h : Periodic f c)
    (hc : 0 < c) (a : α) : f '' Icc a (a + c) = range f :=
  (image_subset_range _ _).antisymm <| h.image_Ioc hc a ▸ image_subset _ Ioc_subset_Icc_self

theorem Periodic.image_uIcc [LinearOrderedAddCommGroup α] [Archimedean α] (h : Periodic f c)
    (hc : c ≠ 0) (a : α) : f '' uIcc a (a + c) = range f := by
  cases hc.lt_or_lt with
  | inl hc =>
    rw [uIcc_of_ge (add_le_of_nonpos_right hc.le), ← h.neg.image_Icc (neg_pos.2 hc) (a + c),
      add_neg_cancel_right]
  | inr hc => rw [uIcc_of_le (le_add_of_nonneg_right hc.le), h.image_Icc hc]

theorem periodic_with_period_zero [AddZeroClass α] (f : α → β) : Periodic f 0 := fun x => by
  rw [add_zero]
#align function.periodic_with_period_zero Function.periodic_with_period_zero

theorem Periodic.map_vadd_zmultiples [AddCommGroup α] (hf : Periodic f c)
    (a : AddSubgroup.zmultiples c) (x : α) : f (a +ᵥ x) = f x := by
  rcases a with ⟨_, m, rfl⟩
  simp [AddSubgroup.vadd_def, add_comm _ x, hf.zsmul m x]
#align function.periodic.map_vadd_zmultiples Function.Periodic.map_vadd_zmultiples

theorem Periodic.map_vadd_multiples [AddCommMonoid α] (hf : Periodic f c)
    (a : AddSubmonoid.multiples c) (x : α) : f (a +ᵥ x) = f x := by
  rcases a with ⟨_, m, rfl⟩
  simp [AddSubmonoid.vadd_def, add_comm _ x, hf.nsmul m x]
#align function.periodic.map_vadd_multiples Function.Periodic.map_vadd_multiples

/-- Lift a periodic function to a function from the quotient group. -/
def Periodic.lift [AddGroup α] (h : Periodic f c) (x : α ⧸ AddSubgroup.zmultiples c) : β :=
  Quotient.liftOn' x f fun a b h' => by
    rw [QuotientAddGroup.leftRel_apply] at h'
    obtain ⟨k, hk⟩ := h'
    exact (h.zsmul k _).symm.trans (congr_arg f (add_eq_of_eq_neg_add hk))
#align function.periodic.lift Function.Periodic.lift

@[simp]
theorem Periodic.lift_coe [AddGroup α] (h : Periodic f c) (a : α) :
    h.lift (a : α ⧸ AddSubgroup.zmultiples c) = f a :=
  rfl
#align function.periodic.lift_coe Function.Periodic.lift_coe

/-! ### Antiperiodicity -/

/-- A function `f` is said to be `antiperiodic` with antiperiod `c` if for all `x`,
  `f (x + c) = -f x`. -/
@[simp]
def Antiperiodic [Add α] [Neg β] (f : α → β) (c : α) : Prop :=
  ∀ x : α, f (x + c) = -f x
#align function.antiperiodic Function.Antiperiodic

protected theorem Antiperiodic.funext [Add α] [Neg β] (h : Antiperiodic f c) :
    (fun x => f (x + c)) = -f :=
  funext h
#align function.antiperiodic.funext Function.Antiperiodic.funext

protected theorem Antiperiodic.funext' [Add α] [InvolutiveNeg β] (h : Antiperiodic f c) :
    (fun x => -f (x + c)) = f :=
  neg_eq_iff_eq_neg.mpr h.funext
#align function.antiperiodic.funext' Function.Antiperiodic.funext'

/-- If a function is `antiperiodic` with antiperiod `c`, then it is also `periodic` with period
  `2 * c`. -/
protected theorem Antiperiodic.periodic [Semiring α] [InvolutiveNeg β] (h : Antiperiodic f c) :
    Periodic f (2 * c) := by simp [two_mul, ← add_assoc, h _]
#align function.antiperiodic.periodic Function.Antiperiodic.periodic

protected theorem Antiperiodic.eq [AddZeroClass α] [Neg β] (h : Antiperiodic f c) : f c = -f 0 := by
  simpa only [zero_add] using h 0
#align function.antiperiodic.eq Function.Antiperiodic.eq

theorem Antiperiodic.nat_even_mul_periodic [Semiring α] [InvolutiveNeg β] (h : Antiperiodic f c)
    (n : ℕ) : Periodic f (n * (2 * c)) :=
  h.periodic.nat_mul n
#align function.antiperiodic.nat_even_mul_periodic Function.Antiperiodic.nat_even_mul_periodic

theorem Antiperiodic.nat_odd_mul_antiperiodic [Semiring α] [InvolutiveNeg β] (h : Antiperiodic f c)
    (n : ℕ) : Antiperiodic f (n * (2 * c) + c) := fun x => by
  rw [← add_assoc, h, h.periodic.nat_mul]
#align function.antiperiodic.nat_odd_mul_antiperiodic Function.Antiperiodic.nat_odd_mul_antiperiodic

theorem Antiperiodic.int_even_mul_periodic [Ring α] [InvolutiveNeg β] (h : Antiperiodic f c)
    (n : ℤ) : Periodic f (n * (2 * c)) :=
  h.periodic.int_mul n
#align function.antiperiodic.int_even_mul_periodic Function.Antiperiodic.int_even_mul_periodic

theorem Antiperiodic.int_odd_mul_antiperiodic [Ring α] [InvolutiveNeg β] (h : Antiperiodic f c)
    (n : ℤ) : Antiperiodic f (n * (2 * c) + c) := fun x => by
  rw [← add_assoc, h, h.periodic.int_mul]
#align function.antiperiodic.int_odd_mul_antiperiodic Function.Antiperiodic.int_odd_mul_antiperiodic

theorem Antiperiodic.sub_eq [AddGroup α] [InvolutiveNeg β] (h : Antiperiodic f c) (x : α) :
    f (x - c) = -f x := by simp only [← neg_eq_iff_eq_neg, ← h (x - c), sub_add_cancel]
#align function.antiperiodic.sub_eq Function.Antiperiodic.sub_eq

theorem Antiperiodic.sub_eq' [AddCommGroup α] [Neg β] (h : Antiperiodic f c) :
    f (c - x) = -f (-x) := by simpa only [sub_eq_neg_add] using h (-x)
#align function.antiperiodic.sub_eq' Function.Antiperiodic.sub_eq'

protected theorem Antiperiodic.neg [AddGroup α] [InvolutiveNeg β] (h : Antiperiodic f c) :
    Antiperiodic f (-c) := by simpa only [sub_eq_add_neg, Antiperiodic] using h.sub_eq
#align function.antiperiodic.neg Function.Antiperiodic.neg

theorem Antiperiodic.neg_eq [AddGroup α] [InvolutiveNeg β] (h : Antiperiodic f c) : f (-c) = -f 0 :=
  by simpa only [zero_add] using h.neg 0
#align function.antiperiodic.neg_eq Function.Antiperiodic.neg_eq

theorem Antiperiodic.nat_mul_eq_of_eq_zero [Semiring α] [NegZeroClass β] (h : Antiperiodic f c)
    (hi : f 0 = 0) : ∀ n : ℕ, f (n * c) = 0
  | 0 => by rwa [Nat.cast_zero, zero_mul]
  | n + 1 => by simp [add_mul, h _, Antiperiodic.nat_mul_eq_of_eq_zero h hi n]
#align function.antiperiodic.nat_mul_eq_of_eq_zero Function.Antiperiodic.nat_mul_eq_of_eq_zero

theorem Antiperiodic.int_mul_eq_of_eq_zero [Ring α] [SubtractionMonoid β] (h : Antiperiodic f c)
    (hi : f 0 = 0) : ∀ n : ℤ, f (n * c) = 0
  | (n : ℕ) => by rw [Int.cast_ofNat, h.nat_mul_eq_of_eq_zero hi n]
  | .negSucc n => by rw [Int.cast_negSucc, neg_mul, ← mul_neg, h.neg.nat_mul_eq_of_eq_zero hi]
#align function.antiperiodic.int_mul_eq_of_eq_zero Function.Antiperiodic.int_mul_eq_of_eq_zero

theorem Antiperiodic.const_add [AddSemigroup α] [Neg β] (h : Antiperiodic f c) (a : α) :
    Antiperiodic (fun x => f (a + x)) c := fun x => by simpa [add_assoc] using h (a + x)
#align function.antiperiodic.const_add Function.Antiperiodic.const_add

theorem Antiperiodic.add_const [AddCommSemigroup α] [Neg β] (h : Antiperiodic f c) (a : α) :
    Antiperiodic (fun x => f (x + a)) c := fun x => by
  simpa only [add_right_comm] using h (x + a)
#align function.antiperiodic.add_const Function.Antiperiodic.add_const

theorem Antiperiodic.const_sub [AddCommGroup α] [InvolutiveNeg β] (h : Antiperiodic f c) (a : α) :
    Antiperiodic (fun x => f (a - x)) c := fun x => by
  simp only [← sub_sub, h.sub_eq]
#align function.antiperiodic.const_sub Function.Antiperiodic.const_sub

theorem Antiperiodic.sub_const [AddCommGroup α] [Neg β] (h : Antiperiodic f c) (a : α) :
    Antiperiodic (fun x => f (x - a)) c := by
  simpa only [sub_eq_add_neg] using h.add_const (-a)
#align function.antiperiodic.sub_const Function.Antiperiodic.sub_const

theorem Antiperiodic.smul [Add α] [Monoid γ] [AddGroup β] [DistribMulAction γ β]
    (h : Antiperiodic f c) (a : γ) : Antiperiodic (a • f) c := by simp_all
#align function.antiperiodic.smul Function.Antiperiodic.smul

theorem Antiperiodic.const_smul [AddMonoid α] [Neg β] [Group γ] [DistribMulAction γ α]
    (h : Antiperiodic f c) (a : γ) : Antiperiodic (fun x => f (a • x)) (a⁻¹ • c) := fun x => by
  simpa only [smul_add, smul_inv_smul] using h (a • x)
#align function.antiperiodic.const_smul Function.Antiperiodic.const_smul

theorem Antiperiodic.const_smul₀ [AddCommMonoid α] [Neg β] [DivisionSemiring γ] [Module γ α]
    (h : Antiperiodic f c) {a : γ} (ha : a ≠ 0) : Antiperiodic (fun x => f (a • x)) (a⁻¹ • c) :=
  fun x => by simpa only [smul_add, smul_inv_smul₀ ha] using h (a • x)
#align function.antiperiodic.const_smul₀ Function.Antiperiodic.const_smul₀

theorem Antiperiodic.const_mul [DivisionSemiring α] [Neg β] (h : Antiperiodic f c) {a : α}
    (ha : a ≠ 0) : Antiperiodic (fun x => f (a * x)) (a⁻¹ * c) :=
  h.const_smul₀ ha
#align function.antiperiodic.const_mul Function.Antiperiodic.const_mul

theorem Antiperiodic.const_inv_smul [AddMonoid α] [Neg β] [Group γ] [DistribMulAction γ α]
    (h : Antiperiodic f c) (a : γ) : Antiperiodic (fun x => f (a⁻¹ • x)) (a • c) := by
  simpa only [inv_inv] using h.const_smul a⁻¹
#align function.antiperiodic.const_inv_smul Function.Antiperiodic.const_inv_smul

theorem Antiperiodic.const_inv_smul₀ [AddCommMonoid α] [Neg β] [DivisionSemiring γ] [Module γ α]
    (h : Antiperiodic f c) {a : γ} (ha : a ≠ 0) : Antiperiodic (fun x => f (a⁻¹ • x)) (a • c) := by
  simpa only [inv_inv] using h.const_smul₀ (inv_ne_zero ha)
#align function.antiperiodic.const_inv_smul₀ Function.Antiperiodic.const_inv_smul₀

theorem Antiperiodic.const_inv_mul [DivisionSemiring α] [Neg β] (h : Antiperiodic f c) {a : α}
    (ha : a ≠ 0) : Antiperiodic (fun x => f (a⁻¹ * x)) (a * c) :=
  h.const_inv_smul₀ ha
#align function.antiperiodic.const_inv_mul Function.Antiperiodic.const_inv_mul

theorem Antiperiodic.mul_const [DivisionSemiring α] [Neg β] (h : Antiperiodic f c) {a : α}
    (ha : a ≠ 0) : Antiperiodic (fun x => f (x * a)) (c * a⁻¹) :=
  h.const_smul₀ <| (MulOpposite.op_ne_zero_iff a).mpr ha
#align function.antiperiodic.mul_const Function.Antiperiodic.mul_const

theorem Antiperiodic.mul_const' [DivisionSemiring α] [Neg β] (h : Antiperiodic f c) {a : α}
    (ha : a ≠ 0) : Antiperiodic (fun x => f (x * a)) (c / a) := by
  simpa only [div_eq_mul_inv] using h.mul_const ha
#align function.antiperiodic.mul_const' Function.Antiperiodic.mul_const'

theorem Antiperiodic.mul_const_inv [DivisionSemiring α] [Neg β] (h : Antiperiodic f c) {a : α}
    (ha : a ≠ 0) : Antiperiodic (fun x => f (x * a⁻¹)) (c * a) :=
  h.const_inv_smul₀ <| (MulOpposite.op_ne_zero_iff a).mpr ha
#align function.antiperiodic.mul_const_inv Function.Antiperiodic.mul_const_inv

theorem Antiperiodic.div_inv [DivisionSemiring α] [Neg β] (h : Antiperiodic f c) {a : α}
    (ha : a ≠ 0) : Antiperiodic (fun x => f (x / a)) (c * a) := by
  simpa only [div_eq_mul_inv] using h.mul_const_inv ha
#align function.antiperiodic.div_inv Function.Antiperiodic.div_inv

theorem Antiperiodic.add [AddGroup α] [InvolutiveNeg β] (h1 : Antiperiodic f c₁)
    (h2 : Antiperiodic f c₂) : Periodic f (c₁ + c₂) := by simp_all [← add_assoc]
#align function.antiperiodic.add Function.Antiperiodic.add

theorem Antiperiodic.sub [AddGroup α] [InvolutiveNeg β] (h1 : Antiperiodic f c₁)
    (h2 : Antiperiodic f c₂) : Periodic f (c₁ - c₂) := by
  simpa only [sub_eq_add_neg] using h1.add h2.neg
#align function.antiperiodic.sub Function.Antiperiodic.sub

theorem Periodic.add_antiperiod [AddGroup α] [Neg β] (h1 : Periodic f c₁) (h2 : Antiperiodic f c₂) :
    Antiperiodic f (c₁ + c₂) := by simp_all [← add_assoc]
#align function.periodic.add_antiperiod Function.Periodic.add_antiperiod

theorem Periodic.sub_antiperiod [AddGroup α] [InvolutiveNeg β] (h1 : Periodic f c₁)
    (h2 : Antiperiodic f c₂) : Antiperiodic f (c₁ - c₂) := by
  simpa only [sub_eq_add_neg] using h1.add_antiperiod h2.neg
#align function.periodic.sub_antiperiod Function.Periodic.sub_antiperiod

theorem Periodic.add_antiperiod_eq [AddGroup α] [Neg β] (h1 : Periodic f c₁)
    (h2 : Antiperiodic f c₂) : f (c₁ + c₂) = -f 0 :=
  (h1.add_antiperiod h2).eq
#align function.periodic.add_antiperiod_eq Function.Periodic.add_antiperiod_eq

theorem Periodic.sub_antiperiod_eq [AddGroup α] [InvolutiveNeg β] (h1 : Periodic f c₁)
    (h2 : Antiperiodic f c₂) : f (c₁ - c₂) = -f 0 :=
  (h1.sub_antiperiod h2).eq
#align function.periodic.sub_antiperiod_eq Function.Periodic.sub_antiperiod_eq

theorem Antiperiodic.mul [Add α] [Mul β] [HasDistribNeg β] (hf : Antiperiodic f c)
    (hg : Antiperiodic g c) : Periodic (f * g) c := by simp_all
#align function.antiperiodic.mul Function.Antiperiodic.mul

theorem Antiperiodic.div [Add α] [DivisionMonoid β] [HasDistribNeg β] (hf : Antiperiodic f c)
    (hg : Antiperiodic g c) : Periodic (f / g) c := by simp_all [neg_div_neg_eq]
#align function.antiperiodic.div Function.Antiperiodic.div

end Function

theorem Int.fract_periodic (α) [LinearOrderedRing α] [FloorRing α] :
    Function.Periodic Int.fract (1 : α) := fun a => by
  exact_mod_cast Int.fract_add_int a 1
#align int.fract_periodic Int.fract_periodic


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Frédéric Dupuis,
  Heather Macbeth

! This file was ported from Lean 3 source module linear_algebra.span
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.LinearAlgebra.Basic
import Mathlib.Order.CompactlyGenerated
import Mathlib.Order.OmegaCompletePartialOrder
import Mathlib.Tactic.Ring

/-!
# The span of a set of vectors, as a submodule

* `submodule.span s` is defined to be the smallest submodule containing the set `s`.

## Notations

* We introduce the notation `R ∙ v` for the span of a singleton, `Submodule.span R {v}`.  This is
  `\.`, not the same as the scalar multiplication `•`/`\bub`.

-/

variable {R R₂ K M M₂ V S : Type _}

namespace Submodule

open Function Set

open Pointwise

section AddCommMonoid

variable [Semiring R] [AddCommMonoid M] [Module R M]

variable {x : M} (p p' : Submodule R M)

variable [Semiring R₂] {σ₁₂ : R →+* R₂}

variable [AddCommMonoid M₂] [Module R₂ M₂]

section

variable (R)

/-- The span of a set `s ⊆ M` is the smallest submodule of M that contains `s`. -/
def span (s : Set M) : Submodule R M :=
  infₛ { p | s ⊆ p }
#align submodule.span Submodule.span

end

variable {s t : Set M}

theorem mem_span : x ∈ span R s ↔ ∀ p : Submodule R M, s ⊆ p → x ∈ p :=
  mem_interᵢ₂
#align submodule.mem_span Submodule.mem_span

theorem subset_span : s ⊆ span R s := fun _ h => mem_span.2 fun _ hp => hp h
#align submodule.subset_span Submodule.subset_span

theorem span_le {p} : span R s ≤ p ↔ s ⊆ p :=
  ⟨Subset.trans subset_span, fun ss _ h => mem_span.1 h _ ss⟩
#align submodule.span_le Submodule.span_le

theorem span_mono (h : s ⊆ t) : span R s ≤ span R t :=
  span_le.2 <| Subset.trans h subset_span
#align submodule.span_mono Submodule.span_mono

theorem span_monotone : Monotone (span R : Set M → Submodule R M) := fun _ _ => span_mono
#align submodule.span_monotone Submodule.span_monotone

theorem span_eq_of_le (h₁ : s ⊆ p) (h₂ : p ≤ span R s) : span R s = p :=
  le_antisymm (span_le.2 h₁) h₂
#align submodule.span_eq_of_le Submodule.span_eq_of_le

theorem span_eq : span R (p : Set M) = p :=
  span_eq_of_le _ (Subset.refl _) subset_span
#align submodule.span_eq Submodule.span_eq

theorem span_eq_span (hs : s ⊆ span R t) (ht : t ⊆ span R s) : span R s = span R t :=
  le_antisymm (span_le.2 hs) (span_le.2 ht)
#align submodule.span_eq_span Submodule.span_eq_span

/-- A version of `submodule.span_eq` for when the span is by a smaller ring. -/
@[simp]
theorem span_coe_eq_restrictScalars [Semiring S] [SMul S R] [Module S M] [IsScalarTower S R M] :
    span S (p : Set M) = p.restrictScalars S :=
  span_eq (p.restrictScalars S)
#align submodule.span_coe_eq_restrict_scalars Submodule.span_coe_eq_restrictScalars

theorem map_span [RingHomSurjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : Set M) :
    (span R s).map f = span R₂ (f '' s) :=
  Eq.symm <|
    span_eq_of_le _ (Set.image_subset f subset_span) <|
      map_le_iff_le_comap.2 <| span_le.2 fun x hx => subset_span ⟨x, hx, rfl⟩
#align submodule.map_span Submodule.map_span

alias Submodule.map_span ← _root_.LinearMap.map_span
#align linear_map.map_span LinearMap.map_span

theorem map_span_le [RingHomSurjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : Set M) (N : Submodule R₂ M₂) :
    map f (span R s) ≤ N ↔ ∀ m ∈ s, f m ∈ N := by
  rw [f.map_span, span_le, Set.image_subset_iff]
  exact Iff.rfl
#align submodule.map_span_le Submodule.map_span_le

alias Submodule.map_span_le ← _root_.LinearMap.map_span_le
#align linear_map.map_span_le LinearMap.map_span_le

@[simp]
theorem span_insert_zero : span R (insert (0 : M) s) = span R s := by
  refine' le_antisymm _ (Submodule.span_mono (Set.subset_insert 0 s))
  rw [span_le, Set.insert_subset]
  exact ⟨by simp only [SetLike.mem_coe, Submodule.zero_mem], Submodule.subset_span⟩
#align submodule.span_insert_zero Submodule.span_insert_zero

-- See also `span_preimage_eq` below.
theorem span_preimage_le (f : M →ₛₗ[σ₁₂] M₂) (s : Set M₂) :
    span R (f ⁻¹' s) ≤ (span R₂ s).comap f := by
  rw [span_le, comap_coe]
  exact preimage_mono subset_span
#align submodule.span_preimage_le Submodule.span_preimage_le

alias Submodule.span_preimage_le ← _root_.LinearMap.span_preimage_le
#align linear_map.span_preimage_le LinearMap.span_preimage_le

theorem closure_subset_span {s : Set M} : (AddSubmonoid.closure s : Set M) ⊆ span R s :=
  (@AddSubmonoid.closure_le _ _ _ (span R s).toAddSubmonoid).mpr subset_span
#align submodule.closure_subset_span Submodule.closure_subset_span

theorem closure_le_toAddSubmonoid_span {s : Set M} :
    AddSubmonoid.closure s ≤ (span R s).toAddSubmonoid :=
  closure_subset_span
#align submodule.closure_le_to_add_submonoid_span Submodule.closure_le_toAddSubmonoid_span

@[simp]
theorem span_closure {s : Set M} : span R (AddSubmonoid.closure s : Set M) = span R s :=
  le_antisymm (span_le.mpr closure_subset_span) (span_mono AddSubmonoid.subset_closure)
#align submodule.span_closure Submodule.span_closure

/-- An induction principle for span membership. If `p` holds for 0 and all elements of `s`, and is
preserved under addition and scalar multiplication, then `p` holds for all elements of the span of
`s`. -/
@[elab_as_elim]
theorem span_induction {p : M → Prop} (h : x ∈ span R s) (Hs : ∀ x ∈ s, p x) (H0 : p 0)
    (H1 : ∀ x y, p x → p y → p (x + y)) (H2 : ∀ (a : R) (x), p x → p (a • x)) : p x :=
  ((@span_le (p := ⟨ ⟨⟨p, by intros x y; exact H1 x y⟩, H0⟩, H2⟩)) s).2 Hs h
#align submodule.span_induction Submodule.span_induction

/-- A dependent version of `Submodule.span_induction`. -/
theorem span_induction' {p : ∀ x, x ∈ span R s → Prop}
    (Hs : ∀ (x) (h : x ∈ s), p x (subset_span h))
    (H0 : p 0 (Submodule.zero_mem _))
    (H1 : ∀ x hx y hy, p x hx → p y hy → p (x + y) (Submodule.add_mem _ ‹_› ‹_›))
    (H2 : ∀ (a : R) (x hx), p x hx → p (a • x) (Submodule.smul_mem _ _ ‹_›)) {x}
    (hx : x ∈ span R s) : p x hx := by
  refine' Exists.elim _ fun (hx : x ∈ span R s) (hc : p x hx) => hc
  refine'
    span_induction hx (fun m hm => ⟨subset_span hm, Hs m hm⟩) ⟨zero_mem _, H0⟩
      (fun x y hx hy =>
        Exists.elim hx fun hx' hx =>
          Exists.elim hy fun hy' hy => ⟨add_mem hx' hy', H1 _ _ _ _ hx hy⟩)
      fun r x hx => Exists.elim hx fun hx' hx => ⟨smul_mem _ _ hx', H2 r _ _ hx⟩
#align submodule.span_induction' Submodule.span_induction'

@[simp]
theorem span_span_coe_preimage : span R (((↑) : span R s → M) ⁻¹' s) = ⊤ :=
  eq_top_iff.2 fun x ↦ Subtype.recOn x fun x hx _ ↦ by
    refine' span_induction' (p := fun x hx ↦ (⟨x, hx⟩ : span R s) ∈ span R (Subtype.val ⁻¹' s))
      (fun x' hx' ↦ subset_span hx') _ (fun x _ y _ ↦ _) (fun r x _ ↦ _) hx
    · exact zero_mem _
    · exact add_mem
    · exact smul_mem _ _
#align submodule.span_span_coe_preimage Submodule.span_span_coe_preimage

theorem span_nat_eq_addSubmonoid_closure (s : Set M) :
    (span ℕ s).toAddSubmonoid = AddSubmonoid.closure s := by
  refine' Eq.symm (AddSubmonoid.closure_eq_of_le subset_span _)
  apply (OrderIso.to_galoisConnection (AddSubmonoid.toNatSubmodule (M := M)).symm).l_le
     (a := span ℕ s) (b := AddSubmonoid.closure s)
  rw [span_le]
  exact AddSubmonoid.subset_closure
#align submodule.span_nat_eq_add_submonoid_closure Submodule.span_nat_eq_addSubmonoid_closure

@[simp]
theorem span_nat_eq (s : AddSubmonoid M) : (span ℕ (s : Set M)).toAddSubmonoid = s := by
  rw [span_nat_eq_addSubmonoid_closure, s.closure_eq]
#align submodule.span_nat_eq Submodule.span_nat_eq

theorem span_int_eq_addSubgroup_closure {M : Type _} [AddCommGroup M] (s : Set M) :
    (span ℤ s).toAddSubgroup = AddSubgroup.closure s :=
  Eq.symm <|
    AddSubgroup.closure_eq_of_le _ subset_span fun x hx =>
      span_induction hx (fun x hx => AddSubgroup.subset_closure hx) (AddSubgroup.zero_mem _)
        (fun _ _ => AddSubgroup.add_mem _) fun _ _ _ => AddSubgroup.zsmul_mem _ ‹_› _
#align submodule.span_int_eq_add_subgroup_closure Submodule.span_int_eq_addSubgroup_closure

@[simp]
theorem span_int_eq {M : Type _} [AddCommGroup M] (s : AddSubgroup M) :
    (span ℤ (s : Set M)).toAddSubgroup = s := by rw [span_int_eq_addSubgroup_closure, s.closure_eq]
#align submodule.span_int_eq Submodule.span_int_eq

section

variable (R M)

/-- `span` forms a Galois insertion with the coercion from submodule to set. -/
protected def gi : GaloisInsertion (@span R M _ _ _) (↑)
    where
  choice s _ := span R s
  gc _ _ := span_le
  le_l_u _ := subset_span
  choice_eq _ _ := rfl
#align submodule.gi Submodule.gi

end

@[simp]
theorem span_empty : span R (∅ : Set M) = ⊥ :=
  (Submodule.gi R M).gc.l_bot
#align submodule.span_empty Submodule.span_empty

@[simp]
theorem span_univ : span R (univ : Set M) = ⊤ :=
  eq_top_iff.2 <| SetLike.le_def.2 <| subset_span
#align submodule.span_univ Submodule.span_univ

theorem span_union (s t : Set M) : span R (s ∪ t) = span R s ⊔ span R t :=
  (Submodule.gi R M).gc.l_sup
#align submodule.span_union Submodule.span_union

theorem span_unionᵢ {ι} (s : ι → Set M) : span R (⋃ i, s i) = ⨆ i, span R (s i) :=
  (Submodule.gi R M).gc.l_supᵢ
#align submodule.span_Union Submodule.span_unionᵢ

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem span_unionᵢ₂ {ι} {κ : ι → Sort _} (s : ∀ i, κ i → Set M) :
    span R (⋃ (i) (j), s i j) = ⨆ (i) (j), span R (s i j) :=
  (Submodule.gi R M).gc.l_supᵢ₂
#align submodule.span_Union₂ Submodule.span_unionᵢ₂

theorem span_attach_bunionᵢ [DecidableEq M] {α : Type _} (s : Finset α) (f : s → Finset M) :
    span R (s.attach.bunionᵢ f : Set M) = ⨆ x, span R (f x) := by simp [span_unionᵢ]
#align submodule.span_attach_bUnion Submodule.span_attach_bunionᵢ

theorem sup_span : p ⊔ span R s = span R (p ∪ s) := by rw [Submodule.span_union, p.span_eq]
#align submodule.sup_span Submodule.sup_span

theorem span_sup : span R s ⊔ p = span R (s ∪ p) := by rw [Submodule.span_union, p.span_eq]
#align submodule.span_sup Submodule.span_sup

-- mathport name: «expr ∙ »
notation:1000
  /- Note that the character `∙` U+2219 used below is different from the scalar multiplication
character `•` U+2022 and the matrix multiplication character `⬝` U+2B1D. -/
R " ∙ " x => span R (singleton x)

theorem span_eq_supᵢ_of_singleton_spans (s : Set M) : span R s = ⨆ x ∈ s, R ∙ x := by
  simp only [← span_unionᵢ, Set.bunionᵢ_of_singleton s]
#align submodule.span_eq_supr_of_singleton_spans Submodule.span_eq_supᵢ_of_singleton_spans

theorem span_range_eq_supᵢ {ι : Type _} {v : ι → M} : span R (range v) = ⨆ i, R ∙ v i := by
  rw [span_eq_supᵢ_of_singleton_spans, supᵢ_range]
#align submodule.span_range_eq_supr Submodule.span_range_eq_supᵢ

theorem span_smul_le (s : Set M) (r : R) : span R (r • s) ≤ span R s := by
  rw [span_le]
  rintro _ ⟨x, hx, rfl⟩
  exact smul_mem (span R s) r (subset_span hx)
#align submodule.span_smul_le Submodule.span_smul_le

theorem subset_span_trans {U V W : Set M} (hUV : U ⊆ Submodule.span R V)
    (hVW : V ⊆ Submodule.span R W) : U ⊆ Submodule.span R W :=
  (Submodule.gi R M).gc.le_u_l_trans hUV hVW
#align submodule.subset_span_trans Submodule.subset_span_trans

/-- See `submodule.span_smul_eq` (in `ring_theory.ideal.operations`) for
`span R (r • s) = r • span R s` that holds for arbitrary `r` in a `comm_semiring`. -/
theorem span_smul_eq_of_isUnit (s : Set M) (r : R) (hr : IsUnit r) : span R (r • s) = span R s := by
  apply le_antisymm
  · apply span_smul_le
  · convert span_smul_le (r • s) ((hr.unit⁻¹ : _) : R)
    rw [smul_smul]
    erw [hr.unit.inv_val]
    rw [one_smul]
#align submodule.span_smul_eq_of_is_unit Submodule.span_smul_eq_of_isUnit

@[simp]
theorem coe_supᵢ_of_directed {ι} [hι : Nonempty ι] (S : ι → Submodule R M)
    (H : Directed (· ≤ ·) S) : ((supᵢ S : Submodule R M) : Set M) = ⋃ i, S i := by
  refine' Subset.antisymm _ (unionᵢ_subset <| le_supᵢ S)
  suffices (span R (⋃ i, (S i : Set M)) : Set M) ⊆ ⋃ i : ι, ↑(S i) by
    simpa only [span_unionᵢ, span_eq] using this
  refine' fun x hx => span_induction hx (fun _ => id) _ _ _ <;> simp only [mem_unionᵢ, exists_imp]
  · exact hι.elim fun i => ⟨i, (S i).zero_mem⟩
  · intro x y i hi j hj
    rcases H i j with ⟨k, ik, jk⟩
    exact ⟨k, add_mem (ik hi) (jk hj)⟩
  · exact fun a x i hi => ⟨i, smul_mem _ a hi⟩
#align submodule.coe_supr_of_directed Submodule.coe_supᵢ_of_directed

@[simp]
theorem mem_supᵢ_of_directed {ι} [Nonempty ι] (S : ι → Submodule R M) (H : Directed (· ≤ ·) S) {x} :
    x ∈ supᵢ S ↔ ∃ i, x ∈ S i := by
  rw [← SetLike.mem_coe, coe_supᵢ_of_directed S H, mem_unionᵢ]
  rfl
#align submodule.mem_supr_of_directed Submodule.mem_supᵢ_of_directed

theorem mem_supₛ_of_directed {s : Set (Submodule R M)} {z} (hs : s.Nonempty)
    (hdir : DirectedOn (· ≤ ·) s) : z ∈ supₛ s ↔ ∃ y ∈ s, z ∈ y := by
  have : Nonempty s := hs.to_subtype
  simp only [supₛ_eq_supᵢ', mem_supᵢ_of_directed _ hdir.directed_val, SetCoe.exists, Subtype.coe_mk,
    exists_prop]
#align submodule.mem_Sup_of_directed Submodule.mem_supₛ_of_directed

@[norm_cast, simp]
theorem coe_supᵢ_of_chain (a : ℕ →o Submodule R M) : (↑(⨆ k, a k) : Set M) = ⋃ k, (a k : Set M) :=
  coe_supᵢ_of_directed a a.monotone.directed_le
#align submodule.coe_supr_of_chain Submodule.coe_supᵢ_of_chain

/-- We can regard `coe_supᵢ_of_chain` as the statement that `(↑) : (Submodule R M) → Set M` is
Scott continuous for the ω-complete partial order induced by the complete lattice structures. -/
theorem coe_scott_continuous :
    OmegaCompletePartialOrder.Continuous' ((↑) : Submodule R M → Set M) :=
  ⟨SetLike.coe_mono, coe_supᵢ_of_chain⟩
#align submodule.coe_scott_continuous Submodule.coe_scott_continuous

@[simp]
theorem mem_supᵢ_of_chain (a : ℕ →o Submodule R M) (m : M) : (m ∈ ⨆ k, a k) ↔ ∃ k, m ∈ a k :=
  mem_supᵢ_of_directed a a.monotone.directed_le
#align submodule.mem_supr_of_chain Submodule.mem_supᵢ_of_chain

section

variable {p p'}

theorem mem_sup : x ∈ p ⊔ p' ↔ ∃ y ∈ p, ∃ z ∈ p', y + z = x :=
  ⟨fun h => by
    rw [← span_eq p, ← span_eq p', ← span_union] at h
    refine span_induction h ?_ ?_ ?_ ?_
    · rintro y (h | h)
      · exact ⟨y, h, 0, by simp, by simp⟩
      · exact ⟨0, by simp, y, h, by simp⟩
    · exact ⟨0, by simp, 0, by simp⟩
    · rintro _ _ ⟨y₁, hy₁, z₁, hz₁, rfl⟩ ⟨y₂, hy₂, z₂, hz₂, rfl⟩
      exact ⟨_, add_mem hy₁ hy₂, _, add_mem hz₁ hz₂, by
        rw [add_assoc, add_assoc, ← add_assoc y₂,  ← add_assoc z₁, add_comm y₂]⟩
    · rintro a _ ⟨y, hy, z, hz, rfl⟩
      exact ⟨_, smul_mem _ a hy, _, smul_mem _ a hz, by simp [smul_add]⟩, by
    rintro ⟨y, hy, z, hz, rfl⟩
    exact add_mem ((le_sup_left : p ≤ p ⊔ p') hy) ((le_sup_right : p' ≤ p ⊔ p') hz)⟩
#align submodule.mem_sup Submodule.mem_sup

theorem mem_sup' : x ∈ p ⊔ p' ↔ ∃ (y : p)(z : p'), (y : M) + z = x :=
  mem_sup.trans <| by simp only [Subtype.exists, exists_prop]
#align submodule.mem_sup' Submodule.mem_sup'

variable (p p')

theorem coe_sup : ↑(p ⊔ p') = (p + p' : Set M) := by
  ext
  rw [SetLike.mem_coe, mem_sup, Set.mem_add]
  simp
#align submodule.coe_sup Submodule.coe_sup

theorem sup_toAddSubmonoid : (p ⊔ p').toAddSubmonoid = p.toAddSubmonoid ⊔ p'.toAddSubmonoid := by
  ext x
  rw [mem_toAddSubmonoid, mem_sup, AddSubmonoid.mem_sup]
  rfl
#align submodule.sup_to_add_submonoid Submodule.sup_toAddSubmonoid

theorem sup_toAddSubgroup {R M : Type _} [Ring R] [AddCommGroup M] [Module R M]
    (p p' : Submodule R M) : (p ⊔ p').toAddSubgroup = p.toAddSubgroup ⊔ p'.toAddSubgroup := by
  ext x
  rw [mem_toAddSubgroup, mem_sup, AddSubgroup.mem_sup]
  rfl
#align submodule.sup_to_add_subgroup Submodule.sup_toAddSubgroup

end

theorem mem_span_singleton_self (x : M) : x ∈ R ∙ x :=
  subset_span rfl
#align submodule.mem_span_singleton_self Submodule.mem_span_singleton_self

theorem nontrivial_span_singleton {x : M} (h : x ≠ 0) : Nontrivial (R ∙ x) :=
  ⟨by
    use 0, ⟨x, Submodule.mem_span_singleton_self x⟩
    intro H
    rw [eq_comm, Submodule.mk_eq_zero] at H
    exact h H⟩
#align submodule.nontrivial_span_singleton Submodule.nontrivial_span_singleton

theorem mem_span_singleton {y : M} : (x ∈ R ∙ y) ↔ ∃ a : R, a • y = x :=
  ⟨fun h => by
    refine span_induction h ?_ ?_ ?_ ?_
    · rintro y (rfl | ⟨⟨_⟩⟩)
      exact ⟨1, by simp⟩
    · exact ⟨0, by simp⟩
    · rintro _ _ ⟨a, rfl⟩ ⟨b, rfl⟩
      exact ⟨a + b, by simp [add_smul]⟩
    · rintro a _ ⟨b, rfl⟩
      exact ⟨a * b, by simp [smul_smul]⟩, by
    rintro ⟨a, y, rfl⟩; exact smul_mem _ _ (subset_span <| by simp)⟩
#align submodule.mem_span_singleton Submodule.mem_span_singleton

theorem le_span_singleton_iff {s : Submodule R M} {v₀ : M} :
    (s ≤ R ∙ v₀) ↔ ∀ v ∈ s, ∃ r : R, r • v₀ = v := by simp_rw [SetLike.le_def, mem_span_singleton]
#align submodule.le_span_singleton_iff Submodule.le_span_singleton_iff

variable (R)

theorem span_singleton_eq_top_iff (x : M) : (R ∙ x) = ⊤ ↔ ∀ v, ∃ r : R, r • x = v := by
  rw [eq_top_iff, le_span_singleton_iff]
  tauto
#align submodule.span_singleton_eq_top_iff Submodule.span_singleton_eq_top_iff

@[simp]
theorem span_zero_singleton : (R ∙ (0 : M)) = ⊥ := by
  ext
  simp [mem_span_singleton, eq_comm]
#align submodule.span_zero_singleton Submodule.span_zero_singleton

theorem span_singleton_eq_range (y : M) : ↑(R ∙ y) = range ((· • y) : R → M) :=
  Set.ext fun _ => mem_span_singleton
#align submodule.span_singleton_eq_range Submodule.span_singleton_eq_range

theorem span_singleton_smul_le {S} [Monoid S] [SMul S R] [MulAction S M] [IsScalarTower S R M]
    (r : S) (x : M) : (R ∙ r • x) ≤ R ∙ x := by
  rw [span_le, Set.singleton_subset_iff, SetLike.mem_coe]
  exact smul_of_tower_mem _ _ (mem_span_singleton_self _)
#align submodule.span_singleton_smul_le Submodule.span_singleton_smul_le

theorem span_singleton_group_smul_eq {G} [Group G] [SMul G R] [MulAction G M] [IsScalarTower G R M]
    (g : G) (x : M) : (R ∙ g • x) = R ∙ x := by
  refine' le_antisymm (span_singleton_smul_le R g x) _
  convert span_singleton_smul_le R g⁻¹ (g • x)
  exact (inv_smul_smul g x).symm
#align submodule.span_singleton_group_smul_eq Submodule.span_singleton_group_smul_eq

variable {R}

theorem span_singleton_smul_eq {r : R} (hr : IsUnit r) (x : M) : (R ∙ r • x) = R ∙ x := by
  lift r to Rˣ using hr
  rw [← Units.smul_def]
  exact span_singleton_group_smul_eq R r x
#align submodule.span_singleton_smul_eq Submodule.span_singleton_smul_eq

theorem disjoint_span_singleton {K E : Type _} [DivisionRing K] [AddCommGroup E] [Module K E]
    {s : Submodule K E} {x : E} : Disjoint s (K ∙ x) ↔ x ∈ s → x = 0 := by
  refine' disjoint_def.trans ⟨fun H hx => H x hx <| subset_span <| mem_singleton x, _⟩
  intro H y hy hyx
  obtain ⟨c, rfl⟩ := mem_span_singleton.1 hyx
  by_cases hc : c = 0
  · rw [hc, zero_smul]
  · rw [s.smul_mem_iff hc] at hy
    rw [H hy, smul_zero]
#align submodule.disjoint_span_singleton Submodule.disjoint_span_singleton

theorem disjoint_span_singleton' {K E : Type _} [DivisionRing K] [AddCommGroup E] [Module K E]
    {p : Submodule K E} {x : E} (x0 : x ≠ 0) : Disjoint p (K ∙ x) ↔ x ∉ p :=
  disjoint_span_singleton.trans ⟨fun h₁ h₂ => x0 (h₁ h₂), fun h₁ h₂ => (h₁ h₂).elim⟩
#align submodule.disjoint_span_singleton' Submodule.disjoint_span_singleton'

theorem mem_span_singleton_trans {x y z : M} (hxy : x ∈ R ∙ y) (hyz : y ∈ R ∙ z) : x ∈ R ∙ z := by
  rw [← SetLike.mem_coe, ← singleton_subset_iff] at *
  exact Submodule.subset_span_trans hxy hyz
#align submodule.mem_span_singleton_trans Submodule.mem_span_singleton_trans

theorem mem_span_insert {y} :
    x ∈ span R (insert y s) ↔ ∃ a : R, ∃ z ∈ span R s, x = a • y + z := by
  simp only [← union_singleton, span_union, mem_sup, mem_span_singleton, exists_prop,
    exists_exists_eq_and]
  rw [exists_comm]
  simp only [eq_comm, add_comm, exists_and_left]
#align submodule.mem_span_insert Submodule.mem_span_insert

theorem mem_span_pair {x y z : M} :
    z ∈ span R ({x, y} : Set M) ↔ ∃ a b : R, a • x + b • y = z := by
  simp_rw [mem_span_insert, mem_span_singleton, exists_prop, exists_exists_eq_and, eq_comm]
#align submodule.mem_span_pair Submodule.mem_span_pair

theorem span_insert (x) (s : Set M) : span R (insert x s) = span R ({x} : Set M) ⊔ span R s := by
  rw [insert_eq, span_union]
#align submodule.span_insert Submodule.span_insert

theorem span_insert_eq_span (h : x ∈ span R s) : span R (insert x s) = span R s :=
  span_eq_of_le _ (Set.insert_subset.mpr ⟨h, subset_span⟩) (span_mono <| subset_insert _ _)
#align submodule.span_insert_eq_span Submodule.span_insert_eq_span

theorem span_span : span R (span R s : Set M) = span R s :=
  span_eq _
#align submodule.span_span Submodule.span_span

variable (R S s)

/-- If `R` is "smaller" ring than `S` then the span by `R` is smaller than the span by `S`. -/
theorem span_le_restrictScalars [Semiring S] [SMul R S] [Module S M] [IsScalarTower R S M] :
    span R s ≤ (span S s).restrictScalars R :=
  Submodule.span_le.2 Submodule.subset_span
#align submodule.span_le_restrict_scalars Submodule.span_le_restrictScalars

/-- A version of `submodule.span_le_restrict_scalars` with coercions. -/
@[simp]
theorem span_subset_span [Semiring S] [SMul R S] [Module S M] [IsScalarTower R S M] :
    ↑(span R s) ⊆ (span S s : Set M) :=
  span_le_restrictScalars R S s
#align submodule.span_subset_span Submodule.span_subset_span

/-- Taking the span by a large ring of the span by the small ring is the same as taking the span
by just the large ring. -/

variable {R S s}

theorem span_eq_bot : span R (s : Set M) = ⊥ ↔ ∀ x ∈ s, (x : M) = 0 :=
  eq_bot_iff.trans
    ⟨fun H _ h => (mem_bot R).1 <| H <| subset_span h, fun H =>
      span_le.2 fun x h => (mem_bot R).2 <| H x h⟩
#align submodule.span_eq_bot Submodule.span_eq_bot

@[simp]
theorem span_singleton_eq_bot : (R ∙ x) = ⊥ ↔ x = 0 :=
  span_eq_bot.trans <| by simp
#align submodule.span_singleton_eq_bot Submodule.span_singleton_eq_bot

@[simp]
theorem span_zero : span R (0 : Set M) = ⊥ := by rw [← singleton_zero, span_singleton_eq_bot]
#align submodule.span_zero Submodule.span_zero

theorem span_singleton_eq_span_singleton {R M : Type _} [Ring R] [AddCommGroup M] [Module R M]
    [NoZeroSMulDivisors R M] {x y : M} : ((R ∙ x) = R ∙ y) ↔ ∃ z : Rˣ, z • x = y := by
  by_cases hx : x = 0
  · rw [hx, span_zero_singleton, eq_comm, span_singleton_eq_bot]
    exact ⟨fun hy => ⟨1, by rw [hy, smul_zero]⟩, fun ⟨_, hz⟩ => by rw [← hz, smul_zero]⟩
  by_cases hy : y = 0
  · rw [hy, span_zero_singleton, span_singleton_eq_bot]
    exact ⟨fun hx => ⟨1, by rw [hx, smul_zero]⟩, fun ⟨z, hz⟩ => (smul_eq_zero_iff_eq z).mp hz⟩
  constructor
  · intro hxy
    cases'
      mem_span_singleton.mp
        (by
          rw [hxy]
          apply mem_span_singleton_self) with
      v hv
    cases'
      mem_span_singleton.mp
        (by
          rw [← hxy]
          apply mem_span_singleton_self) with
      i hi
    have vi : v * i = 1 := by
      rw [← one_smul R y, ← hi, smul_smul] at hv
      exact smul_left_injective R hy hv
    have iv : i * v = 1 := by
      rw [← one_smul R x, ← hv, smul_smul] at hi
      exact smul_left_injective R hx hi
    exact ⟨⟨v, i, vi, iv⟩, hv⟩
  · rintro ⟨v, rfl⟩
    rw [span_singleton_group_smul_eq]
#align submodule.span_singleton_eq_span_singleton Submodule.span_singleton_eq_span_singleton

@[simp]
theorem span_image [RingHomSurjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) :
    span R₂ (f '' s) = map f (span R s) :=
  (map_span f s).symm
#align submodule.span_image Submodule.span_image

theorem apply_mem_span_image_of_mem_span [RingHomSurjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) {x : M}
    {s : Set M} (h : x ∈ Submodule.span R s) : f x ∈ Submodule.span R₂ (f '' s) := by
  rw [Submodule.span_image]
  exact Submodule.mem_map_of_mem h
#align submodule.apply_mem_span_image_of_mem_span Submodule.apply_mem_span_image_of_mem_span

@[simp]
theorem map_subtype_span_singleton {p : Submodule R M} (x : p) :
    map p.subtype (R ∙ x) = R ∙ (x : M) := by simp [← span_image]
#align submodule.map_subtype_span_singleton Submodule.map_subtype_span_singleton

/-- `f` is an explicit argument so we can `apply` this theorem and obtain `h` as a new goal. -/
theorem not_mem_span_of_apply_not_mem_span_image [RingHomSurjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) {x : M}
    {s : Set M} (h : f x ∉ Submodule.span R₂ (f '' s)) : x ∉ Submodule.span R s :=
  h.imp (apply_mem_span_image_of_mem_span f)
#align submodule.not_mem_span_of_apply_not_mem_span_image Submodule.not_mem_span_of_apply_not_mem_span_image

theorem supᵢ_span {ι : Sort _} (p : ι → Set M) : (⨆ i, span R (p i)) = span R (⋃ i, p i) :=
  le_antisymm (supᵢ_le fun i => span_mono <| subset_unionᵢ _ i) <|
    span_le.mpr <| unionᵢ_subset fun i _ hm => mem_supᵢ_of_mem i <| subset_span hm
#align submodule.supr_span Submodule.supᵢ_span

theorem supᵢ_eq_span {ι : Sort _} (p : ι → Submodule R M) : (⨆ i, p i) = span R (⋃ i, ↑(p i)) := by
  simp_rw [← supᵢ_span, span_eq]
#align submodule.supr_eq_span Submodule.supᵢ_eq_span

theorem supᵢ_toAddSubmonoid {ι : Sort _} (p : ι → Submodule R M) :
    (⨆ i, p i).toAddSubmonoid = ⨆ i, (p i).toAddSubmonoid := by
  refine' le_antisymm (fun x => _) (supᵢ_le fun i => toAddSubmonoid_mono <| le_supᵢ _ i)
  simp_rw [supᵢ_eq_span, AddSubmonoid.supᵢ_eq_closure, mem_toAddSubmonoid, coe_toAddSubmonoid]
  intro hx
  refine' Submodule.span_induction hx (fun x hx => _) _ (fun x y hx hy => _) fun r x hx => _
  · exact AddSubmonoid.subset_closure hx
  · exact AddSubmonoid.zero_mem _
  · exact AddSubmonoid.add_mem _ hx hy
  · refine AddSubmonoid.closure_induction hx ?_ ?_ ?_
    · rintro x ⟨_, ⟨i, rfl⟩, hix : x ∈ p i⟩
      apply AddSubmonoid.subset_closure (Set.mem_unionᵢ.mpr ⟨i, _⟩)
      exact smul_mem _ r hix
    · rw [smul_zero]
      exact AddSubmonoid.zero_mem _
    · intro x y hx hy
      rw [smul_add]
      exact AddSubmonoid.add_mem _ hx hy
#align submodule.supr_to_add_submonoid Submodule.supᵢ_toAddSubmonoid

/-- An induction principle for elements of `⨆ i, p i`.
If `C` holds for `0` and all elements of `p i` for all `i`, and is preserved under addition,
then it holds for all elements of the supremum of `p`. -/
@[elab_as_elim]
theorem supᵢ_induction {ι : Sort _} (p : ι → Submodule R M) {C : M → Prop} {x : M}
    (hx : x ∈ ⨆ i, p i) (hp : ∀ (i), ∀ x ∈ p i, C x) (h0 : C 0)
    (hadd : ∀ x y, C x → C y → C (x + y)) : C x := by
  rw [← mem_toAddSubmonoid, supᵢ_toAddSubmonoid] at hx
  exact AddSubmonoid.supᵢ_induction (x := x) _ hx hp h0 hadd
#align submodule.supr_induction Submodule.supᵢ_induction

/-- A dependent version of `submodule.supᵢ_induction`. -/
@[elab_as_elim]
theorem supᵢ_induction' {ι : Sort _} (p : ι → Submodule R M) {C : ∀ x, (x ∈ ⨆ i, p i) → Prop}
    (hp : ∀ (i) (x) (hx : x ∈ p i), C x (mem_supᵢ_of_mem i hx)) (h0 : C 0 (zero_mem _))
    (hadd : ∀ x y hx hy, C x hx → C y hy → C (x + y) (add_mem ‹_› ‹_›)) {x : M}
    (hx : x ∈ ⨆ i, p i) : C x hx := by
  refine' Exists.elim _ fun (hx : x ∈ ⨆ i, p i) (hc : C x hx) => hc
  refine' supᵢ_induction p (C := fun x : M ↦ ∃ (hx : x ∈ ⨆ i, p i), C x hx) hx
    (fun i x hx => _) _ fun x y => _
  · exact ⟨_, hp _ _ hx⟩
  · exact ⟨_, h0⟩
  · rintro ⟨_, Cx⟩ ⟨_, Cy⟩
    refine' ⟨_, hadd _ _ _ _ Cx Cy⟩
#align submodule.supr_induction' Submodule.supᵢ_induction'

@[simp]
theorem span_singleton_le_iff_mem (m : M) (p : Submodule R M) : (R ∙ m) ≤ p ↔ m ∈ p := by
  rw [span_le, singleton_subset_iff, SetLike.mem_coe]
#align submodule.span_singleton_le_iff_mem Submodule.span_singleton_le_iff_mem

theorem singleton_span_isCompactElement (x : M) :
    CompleteLattice.IsCompactElement (span R {x} : Submodule R M) := by
  rw [CompleteLattice.isCompactElement_iff_le_of_directed_supₛ_le]
  intro d hemp hdir hsup
  have : x ∈ (supₛ d) := (SetLike.le_def.mp hsup) (mem_span_singleton_self x)
  obtain ⟨y, ⟨hyd, hxy⟩⟩ := (mem_supₛ_of_directed hemp hdir).mp this
  exact ⟨y, ⟨hyd, by simpa only [span_le, singleton_subset_iff] ⟩⟩
#align submodule.singleton_span_is_compact_element Submodule.singleton_span_isCompactElement

/-- The span of a finite subset is compact in the lattice of submodules. -/
theorem finset_span_isCompactElement (S : Finset M) :
    CompleteLattice.IsCompactElement (span R S : Submodule R M) := by
  rw [span_eq_supᵢ_of_singleton_spans]
  simp only [Finset.mem_coe]
  rw [← Finset.sup_eq_supᵢ]
  exact
    CompleteLattice.finset_sup_compact_of_compact S fun x _ => singleton_span_isCompactElement x
#align submodule.finset_span_is_compact_element Submodule.finset_span_isCompactElement

/-- The span of a finite subset is compact in the lattice of submodules. -/
theorem finite_span_isCompactElement (S : Set M) (h : S.Finite) :
    CompleteLattice.IsCompactElement (span R S : Submodule R M) :=
  Finite.coe_toFinset h ▸ finset_span_isCompactElement h.toFinset
#align submodule.finite_span_is_compact_element Submodule.finite_span_isCompactElement

instance : IsCompactlyGenerated (Submodule R M) :=
  ⟨fun s =>
    ⟨(fun x => span R {x}) '' s,
      ⟨fun t ht => by
        rcases(Set.mem_image _ _ _).1 ht with ⟨x, _, rfl⟩
        apply singleton_span_isCompactElement, by
        rw [supₛ_eq_supᵢ, supᵢ_image, ← span_eq_supᵢ_of_singleton_spans, span_eq]⟩⟩⟩

/-- A submodule is equal to the supremum of the spans of the submodule's nonzero elements. -/
theorem submodule_eq_supₛ_le_nonzero_spans (p : Submodule R M) :
    p = supₛ { T : Submodule R M | ∃ (m : M) (_ : m ∈ p) (_ : m ≠ 0), T = span R {m} } := by
  let S := { T : Submodule R M | ∃ (m : M) (_ : m ∈ p) (_ : m ≠ 0), T = span R {m} }
  apply le_antisymm
  · intro m hm
    by_cases h : m = 0
    · rw [h]
      simp
    · exact @le_supₛ _ _ S _ ⟨m, ⟨hm, ⟨h, rfl⟩⟩⟩ m (mem_span_singleton_self m)
  · rw [supₛ_le_iff]
    rintro S ⟨_, ⟨_, ⟨_, rfl⟩⟩⟩
    rwa [span_singleton_le_iff_mem]
#align submodule.submodule_eq_Sup_le_nonzero_spans Submodule.submodule_eq_supₛ_le_nonzero_spans

theorem lt_sup_iff_not_mem {I : Submodule R M} {a : M} : (I < I ⊔ R ∙ a) ↔ a ∉ I := by
  constructor
  · intro h
    by_contra akey
    have h1 : (I ⊔ R ∙ a) ≤ I := by
      simp only [sup_le_iff]
      constructor
      · exact le_refl I
      · exact (span_singleton_le_iff_mem a I).mpr akey
    have h2 := gt_of_ge_of_gt h1 h
    exact lt_irrefl I h2
  · intro h
    apply SetLike.lt_iff_le_and_exists.mpr
    constructor
    simp only [le_sup_left]
    use a
    constructor
    swap
    · assumption
    · have : (R ∙ a) ≤ I ⊔ R ∙ a := le_sup_right
      exact this (mem_span_singleton_self a)
#align submodule.lt_sup_iff_not_mem Submodule.lt_sup_iff_not_mem

theorem mem_supᵢ {ι : Sort _} (p : ι → Submodule R M) {m : M} :
    (m ∈ ⨆ i, p i) ↔ ∀ N, (∀ i, p i ≤ N) → m ∈ N := by
  rw [← span_singleton_le_iff_mem, le_supᵢ_iff]
  simp only [span_singleton_le_iff_mem]
#align submodule.mem_supr Submodule.mem_supᵢ

section

open Classical

/-- For every element in the span of a set, there exists a finite subset of the set
such that the element is contained in the span of the subset. -/
theorem mem_span_finite_of_mem_span {S : Set M} {x : M} (hx : x ∈ span R S) :
    ∃ T : Finset M, ↑T ⊆ S ∧ x ∈ span R (T : Set M) := by
  refine' span_induction hx (fun x hx => _) _ _ _
  · refine' ⟨{x}, _, _⟩
    · rwa [Finset.coe_singleton, Set.singleton_subset_iff]
    · rw [Finset.coe_singleton]
      exact Submodule.mem_span_singleton_self x
  · use ∅
    simp
  · rintro x y ⟨X, hX, hxX⟩ ⟨Y, hY, hyY⟩
    refine' ⟨X ∪ Y, _, _⟩
    · rw [Finset.coe_union]
      exact Set.union_subset hX hY
    rw [Finset.coe_union, span_union, mem_sup]
    exact ⟨x, hxX, y, hyY, rfl⟩
  · rintro a x ⟨T, hT, h2⟩
    exact ⟨T, hT, smul_mem _ _ h2⟩
#align submodule.mem_span_finite_of_mem_span Submodule.mem_span_finite_of_mem_span

end

variable {M' : Type _} [AddCommMonoid M'] [Module R M'] (q₁ q₁' : Submodule R M')

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The product of two submodules is a submodule. -/
def prod : Submodule R (M × M') :=
  {
    p.toAddSubmonoid.prod q₁.toAddSubmonoid with
    carrier := p ×ˢ q₁
    smul_mem' := by rintro a ⟨x, y⟩ ⟨hx, hy⟩; exact ⟨smul_mem _ a hx, smul_mem _ a hy⟩ }
#align submodule.prod Submodule.prod

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem prod_coe : (prod p q₁ : Set (M × M')) = p ×ˢ q₁ :=
  rfl
#align submodule.prod_coe Submodule.prod_coe

@[simp]
theorem mem_prod {p : Submodule R M} {q : Submodule R M'} {x : M × M'} :
    x ∈ prod p q ↔ x.1 ∈ p ∧ x.2 ∈ q :=
  Set.mem_prod
#align submodule.mem_prod Submodule.mem_prod

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem span_prod_le (s : Set M) (t : Set M') : span R (s ×ˢ t) ≤ prod (span R s) (span R t) :=
  span_le.2 <| Set.prod_mono subset_span subset_span
#align submodule.span_prod_le Submodule.span_prod_le

@[simp]
theorem prod_top : (prod ⊤ ⊤ : Submodule R (M × M')) = ⊤ := by ext; simp
#align submodule.prod_top Submodule.prod_top

@[simp]
theorem prod_bot : (prod ⊥ ⊥ : Submodule R (M × M')) = ⊥ := by ext ⟨x, y⟩; simp [Prod.zero_eq_mk]
#align submodule.prod_bot Submodule.prod_bot

-- Porting note: Added nonrec
nonrec theorem prod_mono {p p' : Submodule R M} {q q' : Submodule R M'} :
    p ≤ p' → q ≤ q' → prod p q ≤ prod p' q' :=
  prod_mono
#align submodule.prod_mono Submodule.prod_mono

@[simp]
theorem prod_inf_prod : prod p q₁ ⊓ prod p' q₁' = prod (p ⊓ p') (q₁ ⊓ q₁') :=
  SetLike.coe_injective Set.prod_inter_prod
#align submodule.prod_inf_prod Submodule.prod_inf_prod

@[simp]
theorem prod_sup_prod : prod p q₁ ⊔ prod p' q₁' = prod (p ⊔ p') (q₁ ⊔ q₁') := by
  refine'
    le_antisymm (sup_le (prod_mono le_sup_left le_sup_left) (prod_mono le_sup_right le_sup_right)) _
  simp [SetLike.le_def]; intro xx yy hxx hyy
  rcases mem_sup.1 hxx with ⟨x, hx, x', hx', rfl⟩
  rcases mem_sup.1 hyy with ⟨y, hy, y', hy', rfl⟩
  refine' mem_sup.2 ⟨(x, y), ⟨hx, hy⟩, (x', y'), ⟨hx', hy'⟩, rfl⟩
#align submodule.prod_sup_prod Submodule.prod_sup_prod

end AddCommMonoid

section AddCommGroup

variable [Ring R] [AddCommGroup M] [Module R M]

@[simp]
theorem span_neg (s : Set M) : span R (-s) = span R s :=
  calc
    span R (-s) = span R ((-LinearMap.id : M →ₗ[R] M) '' s) := by simp
    _ = map (-LinearMap.id) (span R s) := ((-LinearMap.id).map_span _).symm
    _ = span R s := by simp

#align submodule.span_neg Submodule.span_neg

theorem mem_span_insert' {x y} {s : Set M} :
    x ∈ span R (insert y s) ↔ ∃ a : R, x + a • y ∈ span R s := by
  rw [mem_span_insert]; constructor
  · rintro ⟨a, z, hz, rfl⟩
    exact ⟨-a, by simp [hz, add_assoc]⟩
  · rintro ⟨a, h⟩
    exact ⟨-a, _, h, by simp [add_comm, add_left_comm]⟩
#align submodule.mem_span_insert' Submodule.mem_span_insert'

instance : IsModularLattice (Submodule R M) :=
  ⟨fun y z xz a ha => by
    rw [mem_inf, mem_sup] at ha
    rcases ha with ⟨⟨b, hb, c, hc, rfl⟩, haz⟩
    rw [mem_sup]
    refine' ⟨b, hb, c, mem_inf.2 ⟨hc, _⟩, rfl⟩
    rw [← add_sub_cancel c b, add_comm]
    apply z.sub_mem haz (xz hb)⟩

end AddCommGroup

section AddCommGroup

variable [Semiring R] [Semiring R₂]

variable [AddCommGroup M] [Module R M] [AddCommGroup M₂] [Module R₂ M₂]

variable {τ₁₂ : R →+* R₂} [RingHomSurjective τ₁₂]

variable {F : Type _} [sc : SemilinearMapClass F τ₁₂ M M₂]

theorem comap_map_eq (f : F) (p : Submodule R M) : comap f (map f p) = p ⊔ LinearMap.ker f := by
  refine' le_antisymm _ (sup_le (le_comap_map _ _) (comap_mono bot_le))
  rintro x ⟨y, hy, e⟩
  exact mem_sup.2 ⟨y, hy, x - y, by simpa using sub_eq_zero.2 e.symm, by simp⟩
#align submodule.comap_map_eq Submodule.comap_map_eq

theorem comap_map_eq_self {f : F} {p : Submodule R M} (h : LinearMap.ker f ≤ p) :
    comap f (map f p) = p := by rw [Submodule.comap_map_eq, sup_of_le_left h]
#align submodule.comap_map_eq_self Submodule.comap_map_eq_self

end AddCommGroup

end Submodule

namespace LinearMap

open Submodule Function

section AddCommGroup

variable [Semiring R] [Semiring R₂]

variable [AddCommGroup M] [AddCommGroup M₂]

variable [Module R M] [Module R₂ M₂]

variable {τ₁₂ : R →+* R₂} [RingHomSurjective τ₁₂]

variable {F : Type _} [sc : SemilinearMapClass F τ₁₂ M M₂]

protected theorem map_le_map_iff (f : F) {p p'} : map f p ≤ map f p' ↔ p ≤ p' ⊔ ker f := by
  rw [map_le_iff_le_comap, Submodule.comap_map_eq]
#align linear_map.map_le_map_iff LinearMap.map_le_map_iff

theorem map_le_map_iff' {f : F} (hf : ker f = ⊥) {p p'} : map f p ≤ map f p' ↔ p ≤ p' := by
  rw [LinearMap.map_le_map_iff, hf, sup_bot_eq]
#align linear_map.map_le_map_iff' LinearMap.map_le_map_iff'

theorem map_injective {f : F} (hf : ker f = ⊥) : Injective (map f) := fun _ _ h =>
  le_antisymm ((map_le_map_iff' hf).1 (le_of_eq h)) ((map_le_map_iff' hf).1 (ge_of_eq h))
#align linear_map.map_injective LinearMap.map_injective

theorem map_eq_top_iff {f : F} (hf : range f = ⊤) {p : Submodule R M} :
    p.map f = ⊤ ↔ p ⊔ LinearMap.ker f = ⊤ := by
  simp_rw [← top_le_iff, ← hf, range_eq_map, LinearMap.map_le_map_iff]
#align linear_map.map_eq_top_iff LinearMap.map_eq_top_iff

end AddCommGroup

section

variable (R) (M) [Semiring R] [AddCommMonoid M] [Module R M]

/-- Given an element `x` of a module `M` over `R`, the natural map from
    `R` to scalar multiples of `x`.-/
@[simps!]
def toSpanSingleton (x : M) : R →ₗ[R] M :=
  LinearMap.id.smulRight x
#align linear_map.to_span_singleton LinearMap.toSpanSingleton

/-- The range of `toSpanSingleton x` is the span of `x`.-/
theorem span_singleton_eq_range (x : M) : (R ∙ x) = range (toSpanSingleton R M x) :=
  Submodule.ext fun y => by
    refine' Iff.trans _ LinearMap.mem_range.symm
    exact mem_span_singleton
#align linear_map.span_singleton_eq_range LinearMap.span_singleton_eq_range

-- @[simp] -- Porting note: simp can prove this
theorem toSpanSingleton_one (x : M) : toSpanSingleton R M x 1 = x :=
  one_smul _ _
#align linear_map.to_span_singleton_one LinearMap.toSpanSingleton_one

@[simp]
theorem toSpanSingleton_zero : toSpanSingleton R M 0 = 0 := by
  ext
  simp
#align linear_map.to_span_singleton_zero LinearMap.toSpanSingleton_zero

end

section AddCommMonoid

variable [Semiring R] [AddCommMonoid M] [Module R M]

variable [Semiring R₂] [AddCommMonoid M₂] [Module R₂ M₂]

variable {σ₁₂ : R →+* R₂}

/-- If two linear maps are equal on a set `s`, then they are equal on `submodule.span s`.

See also `linear_map.eq_on_span'` for a version using `set.eq_on`. -/
theorem eqOn_span {s : Set M} {f g : M →ₛₗ[σ₁₂] M₂} (H : Set.EqOn f g s) ⦃x⦄ (h : x ∈ span R s) :
    f x = g x := by refine' span_induction h H _ _ _ <;> simp (config := { contextual := true })
#align linear_map.eq_on_span LinearMap.eqOn_span

/-- If two linear maps are equal on a set `s`, then they are equal on `submodule.span s`.

This version uses `set.eq_on`, and the hidden argument will expand to `h : x ∈ (span R s : set M)`.
See `linear_map.eq_on_span` for a version that takes `h : x ∈ span R s` as an argument. -/
theorem eqOn_span' {s : Set M} {f g : M →ₛₗ[σ₁₂] M₂} (H : Set.EqOn f g s) :
    Set.EqOn f g (span R s : Set M) :=
  eqOn_span H
#align linear_map.eq_on_span' LinearMap.eqOn_span'

/-- If `s` generates the whole module and linear maps `f`, `g` are equal on `s`, then they are
equal. -/
theorem ext_on {s : Set M} {f g : M →ₛₗ[σ₁₂] M₂} (hv : span R s = ⊤) (h : Set.EqOn f g s) : f = g :=
  LinearMap.ext fun _ => eqOn_span h (eq_top_iff'.1 hv _)
#align linear_map.ext_on LinearMap.ext_on

/-- If the range of `v : ι → M` generates the whole module and linear maps `f`, `g` are equal at
each `v i`, then they are equal. -/
theorem ext_on_range {ι : Type _} {v : ι → M} {f g : M →ₛₗ[σ₁₂] M₂} (hv : span R (Set.range v) = ⊤)
    (h : ∀ i, f (v i) = g (v i)) : f = g :=
  ext_on hv (Set.forall_range_iff.2 h)
#align linear_map.ext_on_range LinearMap.ext_on_range

end AddCommMonoid

section Field

variable [Field K] [AddCommGroup V] [Module K V]

open Classical

-- Porting note: TODO Erase this line. Needed because we don't have η for classes. (lean4#2074)
attribute [-instance] Ring.toNonAssocRing

-- Porting note: added the following line, fails to be inferred otherwise. Probably lean4#2074
instance : Module K K := Semiring.toModule

theorem span_singleton_sup_ker_eq_top (f : V →ₗ[K] K) {x : V} (hx : f x ≠ 0) :
    (K ∙ x) ⊔ ker f = ⊤ :=
  eq_top_iff.2 fun y _ =>
    Submodule.mem_sup.2
      ⟨(f y * (f x)⁻¹) • x, Submodule.mem_span_singleton.2 ⟨f y * (f x)⁻¹, rfl⟩,
        ⟨y - (f y * (f x)⁻¹) • x, by
          rw [LinearMap.mem_ker, f.map_sub, f.map_smul, smul_eq_mul, mul_assoc, inv_mul_cancel hx,
            mul_one, sub_self],
          by simp only [add_sub_cancel'_right]⟩⟩
#align linear_map.span_singleton_sup_ker_eq_top LinearMap.span_singleton_sup_ker_eq_top

variable (K V)

theorem ker_toSpanSingleton {x : V} (h : x ≠ 0) : LinearMap.ker (toSpanSingleton K V x) = ⊥ := by
  ext c; constructor
  · intro hc
    rw [Submodule.mem_bot]
    rw [mem_ker] at hc
    by_contra hc'
    have : x = 0
    calc
      x = c⁻¹ • c • x := by rw [← mul_smul, inv_mul_cancel hc', one_smul]
      _ = c⁻¹ • (toSpanSingleton K V x) c := rfl
      _ = 0 := by rw [hc, smul_zero]
    tauto
  · rw [mem_ker, Submodule.mem_bot]
    intro h
    rw [h]
    simp
#align linear_map.ker_to_span_singleton LinearMap.ker_toSpanSingleton

end Field

end LinearMap

open LinearMap

namespace LinearEquiv

section Field

variable (K V) [Field K] [AddCommGroup V] [Module K V]

-- Porting note: TODO Erase this line. Needed because we don't have η for classes. (lean4#2074)
attribute [-instance] Ring.toNonAssocRing

/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural
    map from `K` to the span of `x`, with invertibility check to consider it as an
    isomorphism.-/
noncomputable
def toSpanNonzeroSingleton (x : V) (h : x ≠ 0) : K ≃ₗ[K] K ∙ x :=
  LinearEquiv.trans
    (LinearEquiv.ofInjective (LinearMap.toSpanSingleton K V x)
      (ker_eq_bot.1 <| LinearMap.ker_toSpanSingleton K V h))
    (LinearEquiv.ofEq (range $ toSpanSingleton K V x) (K ∙ x) (span_singleton_eq_range K V x).symm)
#align linear_equiv.to_span_nonzero_singleton LinearEquiv.toSpanNonzeroSingleton

theorem toSpanNonzeroSingleton_one (x : V) (h : x ≠ 0) :
    LinearEquiv.toSpanNonzeroSingleton K V x h 1 =
      (⟨x, Submodule.mem_span_singleton_self x⟩ : K ∙ x) := by
  apply SetLike.coe_eq_coe.mp
  have : ↑(toSpanNonzeroSingleton K V x h 1) = toSpanSingleton K V x 1 := rfl
  rw [this, toSpanSingleton_one, Submodule.coe_mk]
#align linear_equiv.to_span_nonzero_singleton_one LinearEquiv.toSpanNonzeroSingleton_one

/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural map
    from the span of `x` to `K`.-/
noncomputable
abbrev coord (x : V) (h : x ≠ 0) : (K ∙ x) ≃ₗ[K] K :=
  (toSpanNonzeroSingleton K V x h).symm
#align linear_equiv.coord LinearEquiv.coord

theorem coord_self (x : V) (h : x ≠ 0) :
    (coord K V x h) (⟨x, Submodule.mem_span_singleton_self x⟩ : K ∙ x) = 1 := by
  rw [← toSpanNonzeroSingleton_one K V x h, LinearEquiv.symm_apply_apply]
#align linear_equiv.coord_self LinearEquiv.coord_self

end Field

end LinearEquiv


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.hull

/-!
# Extreme sets

This file defines extreme sets and extreme points for sets in a module.

An extreme set of `A` is a subset of `A` that is as far as it can get in any outward direction: If
point `x` is in it and point `y ∈ A`, then the line passing through `x` and `y` leaves `A` at `x`.
This is an analytic notion of "being on the side of". It is weaker than being exposed (see
`is_exposed.is_extreme`).

## Main declarations

* `is_extreme 𝕜 A B`: States that `B` is an extreme set of `A` (in the literature, `A` is often
  implicit).
* `set.extreme_points 𝕜 A`: Set of extreme points of `A` (corresponding to extreme singletons).
* `convex.mem_extreme_points_iff_convex_diff`: A useful equivalent condition to being an extreme
  point: `x` is an extreme point iff `A \ {x}` is convex.

## Implementation notes

The exact definition of extremeness has been carefully chosen so as to make as many lemmas
unconditional (in particular, the Krein-Milman theorem doesn't need the set to be convex!).
In practice, `A` is often assumed to be a convex set.

## References

See chapter 8 of [Barry Simon, *Convexity*][simon2011]

## TODO

Define intrinsic frontier and prove lemmas related to extreme sets and points.

More not-yet-PRed stuff is available on the branch `sperner_again`.
-/

open_locale classical affine
open set

variables (𝕜 : Type*) {E : Type*}

section has_smul
variables [ordered_semiring 𝕜] [add_comm_monoid E] [has_smul 𝕜 E]

/-- A set `B` is an extreme subset of `A` if `B ⊆ A` and all points of `B` only belong to open
segments whose ends are in `B`. -/
def is_extreme (A B : set E) : Prop :=
B ⊆ A ∧ ∀ ⦃x₁⦄, x₁ ∈ A → ∀ ⦃x₂⦄, x₂ ∈ A → ∀ ⦃x⦄, x ∈ B → x ∈ open_segment 𝕜 x₁ x₂ → x₁ ∈ B ∧ x₂ ∈ B

/-- A point `x` is an extreme point of a set `A` if `x` belongs to no open segment with ends in
`A`, except for the obvious `open_segment x x`. -/
def set.extreme_points (A : set E) : set E :=
{x ∈ A | ∀ ⦃x₁⦄, x₁ ∈ A → ∀ ⦃x₂⦄, x₂ ∈ A → x ∈ open_segment 𝕜 x₁ x₂ → x₁ = x ∧ x₂ = x}

@[refl] protected lemma is_extreme.refl (A : set E) :
  is_extreme 𝕜 A A :=
⟨subset.rfl, λ x₁ hx₁A x₂ hx₂A x hxA hx, ⟨hx₁A, hx₂A⟩⟩

variables {𝕜} {A B C : set E} {x : E}

protected lemma is_extreme.rfl :
  is_extreme 𝕜 A A :=
is_extreme.refl 𝕜 A

@[trans] protected lemma is_extreme.trans (hAB : is_extreme 𝕜 A B) (hBC : is_extreme 𝕜 B C) :
  is_extreme 𝕜 A C :=
begin
  refine ⟨subset.trans hBC.1 hAB.1, λ x₁ hx₁A x₂ hx₂A x hxC hx, _⟩,
  obtain ⟨hx₁B, hx₂B⟩ := hAB.2 hx₁A hx₂A (hBC.1 hxC) hx,
  exact hBC.2 hx₁B hx₂B hxC hx,
end

protected lemma is_extreme.antisymm :
  anti_symmetric (is_extreme 𝕜 : set E → set E → Prop) :=
λ A B hAB hBA, subset.antisymm hBA.1 hAB.1

instance : is_partial_order (set E) (is_extreme 𝕜) :=
{ refl := is_extreme.refl 𝕜,
  trans := λ A B C, is_extreme.trans,
  antisymm := is_extreme.antisymm }

lemma is_extreme.inter (hAB : is_extreme 𝕜 A B) (hAC : is_extreme 𝕜 A C) :
  is_extreme 𝕜 A (B ∩ C) :=
begin
  use subset.trans (inter_subset_left _ _) hAB.1,
  rintro x₁ hx₁A x₂ hx₂A x ⟨hxB, hxC⟩ hx,
  obtain ⟨hx₁B, hx₂B⟩ := hAB.2 hx₁A hx₂A hxB hx,
  obtain ⟨hx₁C, hx₂C⟩ := hAC.2 hx₁A hx₂A hxC hx,
  exact ⟨⟨hx₁B, hx₁C⟩, hx₂B, hx₂C⟩,
end

protected lemma is_extreme.mono (hAC : is_extreme 𝕜 A C) (hBA : B ⊆ A) (hCB : C ⊆ B) :
  is_extreme 𝕜 B C :=
⟨hCB, λ x₁ hx₁B x₂ hx₂B x hxC hx, hAC.2 (hBA hx₁B) (hBA hx₂B) hxC hx⟩

lemma is_extreme_Inter {ι : Type*} [nonempty ι] {F : ι → set E}
  (hAF : ∀ i : ι, is_extreme 𝕜 A (F i)) :
  is_extreme 𝕜 A (⋂ i : ι, F i) :=
begin
  obtain i := classical.arbitrary ι,
  refine ⟨Inter_subset_of_subset i (hAF i).1, λ x₁ hx₁A x₂ hx₂A x hxF hx, _⟩,
  simp_rw mem_Inter at ⊢ hxF,
  have h := λ i, (hAF i).2 hx₁A hx₂A (hxF i) hx,
  exact ⟨λ i, (h i).1, λ i, (h i).2⟩,
end

lemma is_extreme_bInter {F : set (set E)} (hF : F.nonempty)
  (hAF : ∀ B ∈ F, is_extreme 𝕜 A B) :
  is_extreme 𝕜 A (⋂ B ∈ F, B) :=
begin
  obtain ⟨B, hB⟩ := hF,
  refine ⟨(bInter_subset_of_mem hB).trans (hAF B hB).1, λ x₁ hx₁A x₂ hx₂A x hxF hx, _⟩,
  simp_rw mem_Inter₂ at ⊢ hxF,
  have h := λ B hB, (hAF B hB).2 hx₁A hx₂A (hxF B hB) hx,
  exact ⟨λ B hB, (h B hB).1, λ B hB, (h B hB).2⟩,
end

lemma is_extreme_sInter {F : set (set E)} (hF : F.nonempty)
  (hAF : ∀ B ∈ F, is_extreme 𝕜 A B) :
  is_extreme 𝕜 A (⋂₀ F) :=
begin
  obtain ⟨B, hB⟩ := hF,
  refine ⟨(sInter_subset_of_mem hB).trans (hAF B hB).1, λ x₁ hx₁A x₂ hx₂A x hxF hx, _⟩,
  simp_rw mem_sInter at ⊢ hxF,
  have h := λ B hB, (hAF B hB).2 hx₁A hx₂A (hxF B hB) hx,
  exact ⟨λ B hB, (h B hB).1, λ B hB, (h B hB).2⟩,
end

lemma extreme_points_def :
  x ∈ A.extreme_points 𝕜 ↔ x ∈ A ∧ ∀ (x₁ x₂ ∈ A), x ∈ open_segment 𝕜 x₁ x₂ → x₁ = x ∧ x₂ = x :=
iff.rfl

/-- x is an extreme point to A iff {x} is an extreme set of A. -/
lemma mem_extreme_points_iff_extreme_singleton :
  x ∈ A.extreme_points 𝕜 ↔ is_extreme 𝕜 A {x} :=
begin
  refine ⟨_, λ hx, ⟨singleton_subset_iff.1 hx.1, λ x₁ hx₁ x₂ hx₂, hx.2 hx₁ hx₂ rfl⟩⟩,
  rintro ⟨hxA, hAx⟩,
  use singleton_subset_iff.2 hxA,
  rintro x₁ hx₁A x₂ hx₂A y (rfl : y = x),
  exact hAx hx₁A hx₂A,
end

lemma extreme_points_subset : A.extreme_points 𝕜 ⊆ A := λ x hx, hx.1

@[simp] lemma extreme_points_empty :
  (∅ : set E).extreme_points 𝕜 = ∅ :=
subset_empty_iff.1 extreme_points_subset

@[simp] lemma extreme_points_singleton :
  ({x} : set E).extreme_points 𝕜 = {x} :=
extreme_points_subset.antisymm $ singleton_subset_iff.2
  ⟨mem_singleton x, λ x₁ hx₁ x₂ hx₂ _, ⟨hx₁, hx₂⟩⟩

lemma inter_extreme_points_subset_extreme_points_of_subset (hBA : B ⊆ A) :
  B ∩ A.extreme_points 𝕜 ⊆ B.extreme_points 𝕜 :=
λ x ⟨hxB, hxA⟩, ⟨hxB, λ x₁ hx₁ x₂ hx₂ hx, hxA.2 (hBA hx₁) (hBA hx₂) hx⟩

lemma is_extreme.extreme_points_subset_extreme_points (hAB : is_extreme 𝕜 A B) :
  B.extreme_points 𝕜 ⊆ A.extreme_points 𝕜 :=
λ x hx, mem_extreme_points_iff_extreme_singleton.2 (hAB.trans
  (mem_extreme_points_iff_extreme_singleton.1 hx))

lemma is_extreme.extreme_points_eq (hAB : is_extreme 𝕜 A B) :
  B.extreme_points 𝕜 = B ∩ A.extreme_points 𝕜 :=
subset.antisymm (λ x hx, ⟨hx.1, hAB.extreme_points_subset_extreme_points hx⟩)
  (inter_extreme_points_subset_extreme_points_of_subset hAB.1)

end has_smul

section ordered_semiring
variables {𝕜} [ordered_semiring 𝕜] [add_comm_group E] [module 𝕜 E] {A B : set E} {x : E}

lemma is_extreme.convex_diff (hA : convex 𝕜 A) (hAB : is_extreme 𝕜 A B) :
  convex 𝕜 (A \ B) :=
convex_iff_open_segment_subset.2 (λ x₁ x₂ ⟨hx₁A, hx₁B⟩ ⟨hx₂A, hx₂B⟩ x hx,
    ⟨hA.open_segment_subset hx₁A hx₂A hx, λ hxB, hx₁B (hAB.2 hx₁A hx₂A hxB hx).1⟩)

end ordered_semiring

section linear_ordered_ring
variables {𝕜} [linear_ordered_ring 𝕜] [add_comm_group E] [module 𝕜 E]
variables [densely_ordered 𝕜] [no_zero_smul_divisors 𝕜 E] {A B : set E} {x : E}

/-- A useful restatement using `segment`: `x` is an extreme point iff the only (closed) segments
that contain it are those with `x` as one of their endpoints. -/
lemma mem_extreme_points_iff_forall_segment :
  x ∈ A.extreme_points 𝕜 ↔ x ∈ A ∧ ∀ (x₁ x₂ ∈ A), x ∈ segment 𝕜 x₁ x₂ → x₁ = x ∨ x₂ = x :=
begin
  refine and_congr_right (λ hxA, forall₄_congr $ λ x₁ h₁ x₂ h₂, _),
  split,
  { rw ← insert_endpoints_open_segment,
    rintro H (rfl|rfl|hx),
    exacts [or.inl rfl, or.inr rfl, or.inl $ (H hx).1] },
  { intros H hx,
    rcases H (open_segment_subset_segment _ _ _ hx) with rfl | rfl,
    exacts [⟨rfl, (left_mem_open_segment_iff.1 hx).symm⟩, ⟨right_mem_open_segment_iff.1 hx, rfl⟩] }
end

lemma convex.mem_extreme_points_iff_convex_diff (hA : convex 𝕜 A) :
  x ∈ A.extreme_points 𝕜 ↔ x ∈ A ∧ convex 𝕜 (A \ {x}) :=
begin
  use λ hx, ⟨hx.1, (mem_extreme_points_iff_extreme_singleton.1 hx).convex_diff hA⟩,
  rintro ⟨hxA, hAx⟩,
  refine mem_extreme_points_iff_forall_segment.2 ⟨hxA, λ x₁ hx₁ x₂ hx₂ hx, _⟩,
  rw convex_iff_segment_subset at hAx,
  by_contra' h,
  exact (hAx ⟨hx₁, λ hx₁, h.1 (mem_singleton_iff.2 hx₁)⟩
    ⟨hx₂, λ hx₂, h.2 (mem_singleton_iff.2 hx₂)⟩ hx).2 rfl,
end

lemma convex.mem_extreme_points_iff_mem_diff_convex_hull_diff (hA : convex 𝕜 A) :
  x ∈ A.extreme_points 𝕜 ↔ x ∈ A \ convex_hull 𝕜 (A \ {x}) :=
by rw [hA.mem_extreme_points_iff_convex_diff, hA.convex_remove_iff_not_mem_convex_hull_remove,
  mem_diff]

lemma extreme_points_convex_hull_subset :
  (convex_hull 𝕜 A).extreme_points 𝕜 ⊆ A :=
begin
  rintro x hx,
  rw (convex_convex_hull 𝕜 _).mem_extreme_points_iff_convex_diff at hx,
  by_contra,
  exact (convex_hull_min (subset_diff.2 ⟨subset_convex_hull 𝕜 _, disjoint_singleton_right.2 h⟩) hx.2
    hx.1).2 rfl,
  apply_instance
end

end linear_ordered_ring