import .mylist
import ..mynat.nat_sub

-- Sorting algorithms and permutations on lists of naturals
-- can probably be generalised to some type class thing

-- TODO: encode/state criterion for a sorting algorithm to
-- be stable, and prove it
-- more algorithms, obviously

namespace hidden
namespace mylist

open mynat

universe u
variable {T: Sort u}
variables {a b c d m n k x y z: mynat}
variables {lst lst1 lst2 lst3 xs ys zs: mylist mynat}
variables {alg: mylist mynat → mylist mynat}

def is_sorted (lst: mylist mynat): Prop :=
∀ a b: mynat,
  ∀ hbl: b < len lst,
    ∀ hab: a < b,
      get a lst (lt_trans hab hbl) ≤
        get b lst hbl

def count [decidable_eq T]: T → mylist T → mynat
| _ empty        := 0
| x (y :: ys) := if x = y then
                 succ (count x ys) else
                 count x ys

-- this seems more straightforward than using bijections or something.
-- correct me if I'm wrong
def is_perm (lst1 lst2: mylist mynat) :=
∀ m: mynat,
  count m lst1 = count m lst2

def sort_alg_correct (alg: mylist mynat → mylist mynat) :=
∀ lst: mylist mynat,
  is_sorted (alg lst) ∧ is_perm lst (alg lst)

private theorem succ_lt_impl_lt: succ a < n → a < n :=
@lt_cancel_strong a n 1

theorem adjacent_sorted_implies_sorted:
(∀ a,
  ∀ hsal: succ a < len lst,
    get a lst (succ_lt_impl_lt hsal) ≤
    get (succ a) lst hsal)
→ is_sorted lst :=
begin
  assume hadj,
  intros a b hbl hab,
  rw lt_iff_succ_le at hab,
  cases hab with d hd,
  induction d with d d_ih generalizing b, {
    conv in b {rw hd},
    simp,
    apply hadj,
  }, {
    conv in b {rw hd},
    conv in (succ a + succ d) {rw add_succ},
    have := d_ih _ _ _ rfl,
    apply le_trans this (hadj _ _),
    rw lt_iff_succ_le,
    from le_to_add,
  },
end

theorem empty_sorted: is_sorted empty :=
begin
  intros a b,
  assume hbl hab,
  exfalso,
  from lt_nzero hbl,
end

theorem singleton_sorted: is_sorted (singleton x) :=
begin
  intros a b,
  assume hbl hab,
  exfalso,
  change b < 1 at hbl,
  rw [←one_eq_succ_zero, ←le_iff_lt_succ] at hbl,
  rw le_zero hbl at hab,
  from lt_nzero hab,
end

theorem cons_sorted:
x ≤ y → is_sorted (y :: ys) → is_sorted (x :: y :: ys) :=
begin
  assume hxy hstd_yys,
  apply adjacent_sorted_implies_sorted,
  intro m,
  assume hsal,
  cases m, {
    from hxy,
  }, {
    have hsm := lt_succ_cancel hsal,
    have hmsm := @lt_to_add_succ m 0,
    have := hstd_yys m (succ m) hsm hmsm,
    from this,
  },
end

theorem duo_sorted: x ≤ y → is_sorted (x :: y :: empty) :=
(λ h, cons_sorted h singleton_sorted)

theorem tail_sorted: is_sorted (x :: xs) → is_sorted xs :=
begin
  assume hstd_xxs,
  intros a b,
  assume hbl hab,
  have := hstd_xxs (succ a) (succ b)
                   (@lt_add _ _ 1 hbl)
                   (@lt_add _ _ 1 hab),
  from this, -- too lazy to change indentation
end

@[refl]
theorem perm_refl: is_perm lst lst := (λ _, rfl)

theorem perm_symm:
is_perm lst1 lst2 → is_perm lst2 lst1 :=
(λ hp12 m, (hp12 m).symm)

theorem cons_perm:
is_perm xs ys → is_perm (x :: xs) (x :: ys) :=
begin
  assume hpxsys,
  intro m,
  dsimp [count],
  rw hpxsys m,
end

theorem perm_trans:
is_perm lst1 lst2 → is_perm lst2 lst3 → is_perm lst1 lst3 :=
begin
  assume hp12 hp23,
  intro m,
  from eq.trans (hp12 m) (hp23 m),
end

theorem count_empty: count x empty = 0 := rfl

theorem empty_perm_is_empty:
is_perm lst empty → lst = empty :=
begin
  assume hple,
  cases lst, {
    refl,
  }, {
    exfalso,
    have := hple lst_head,
    dsimp [count] at this,
    rw if_pos rfl at this,
    from succ_ne_zero this,
  },
end

theorem count_concat:
count m (lst1 ++ lst2)
  = count m lst1 + count m lst2 :=
begin
  induction lst1 with x xs h_ih, {
    rw [count_empty, zero_add, empty_concat],
  }, {
    dsimp [count],
    by_cases (m = x), {
      repeat {rw if_pos h},
      rw [h_ih, succ_add],
    }, {
      repeat {rw if_neg h},
      from h_ih,
    },
  },
end

theorem perm_concat:
is_perm xs ys → is_perm lst1 lst2
  → is_perm (xs ++ lst1) (ys ++ lst2) :=
begin
  assume hpxsys hp12,
  intro m,
  rw [count_concat, count_concat, hpxsys m, hp12 m],
end

theorem duo_perm:
is_perm (x :: y :: empty) (y :: x :: empty) :=
begin
  intro m,
  dsimp [count],
  by_cases hmx: m = x, {
    repeat {rw if_pos hmx},
    by_cases hmy:m = y, {
      repeat {rw if_pos hmy},
    }, {
      repeat {rw if_neg hmy},
      refl,
    },
  }, {
    repeat {rw if_neg hmx},
    by_cases hmy: m = y, {
      repeat {rw if_pos hmy},
      refl,
    }, {
      repeat {rw if_neg hmy},
    },
  },
end

-- insertion sort

def insert_aux: mynat → mylist mynat → mylist mynat
| x empty        := singleton x
| x (y :: ys) := if x ≤ y then
                 x :: y :: ys else
                 y :: insert_aux x ys

def insertion_sort: mylist mynat → mylist mynat
| empty        := empty
| (x :: xs) := insert_aux x (insertion_sort xs)

-- ew
theorem insertion_preserves_sorted:
is_sorted lst → is_sorted (insert_aux x lst) :=
begin
  induction lst with y ys h_ih, {
    assume _,
    from singleton_sorted,
  }, {
    assume h,
    dsimp [insert_aux],
    by_cases hxy: x ≤ y, {
      rw if_pos hxy,
      from cons_sorted hxy h,
    }, {
      rw if_neg hxy,
      cases hz: insert_aux x ys with z zs, {
        from singleton_sorted,
      }, {
        apply cons_sorted, {
          cases ys with y' ys, {
            have: x = z, {
              dsimp [insert_aux] at hz,
              from cons_injective_1 hz,
            },
            rw ←this,
            from lt_impl_le hxy,
          }, {
            dsimp [insert_aux] at hz,
            by_cases hxy': x ≤ y', {
              rw if_pos hxy' at hz,
              rw ←(cons_injective_1 hz),
              from lt_impl_le hxy,
            }, {
              rw if_neg hxy' at hz,
              rw ←(cons_injective_1 hz),
              apply h 0 1 _ _, {
                dsimp [len],
                apply @lt_add _ _ 1,
                from zero_lt_succ,
              }, {
                from zero_lt_succ,
              },
            },
          },
        }, {
          rw ←hz,
          apply h_ih,
          from tail_sorted h,
        },
      },
    },
  },
end

theorem insertion_sort_is_sorted:
is_sorted (insertion_sort lst) :=
begin
  induction lst with head tail h_ih, {
    dsimp [insertion_sort],
    from empty_sorted,
  }, {
    dsimp [insertion_sort],
    from insertion_preserves_sorted h_ih,
  },
end

theorem insertion_is_perm:
is_perm (x :: xs) (insert_aux x xs) :=
begin
  induction xs with x' xs h_ih, {
    refl,
  }, {
    dsimp [insert_aux],
    by_cases hxx': x ≤ x', {
      rw if_pos hxx',
    }, {
      rw if_neg hxx',
      apply perm_trans _ (cons_perm h_ih),
      from perm_concat duo_perm perm_refl,
    },
  },
end

theorem insertion_sort_is_perm:
is_perm lst (insertion_sort lst) :=
begin
  induction lst with head tail h_ih, {
    refl,
  }, {
    dsimp [insertion_sort],
    have := @cons_perm head _ _ h_ih,
    from perm_trans this insertion_is_perm,
  },
end

theorem insertion_sort_correct:
sort_alg_correct insertion_sort :=
(λ lst,
  and.intro
    insertion_sort_is_sorted insertion_sort_is_perm)

-- more theory about permutations/sorted lists

theorem perm_concat_swap:
is_perm (xs ++ ys) (ys ++ xs) :=
begin
  intro m,
  rw count_concat,
  rw count_concat,
  rw add_comm,
end

theorem rev_perm: is_perm lst (rev lst) :=
begin
  induction lst with head tail h_ih, {
    refl,
  }, {
    from perm_trans
          (cons_perm h_ih)
          (@perm_concat_swap (singleton head) (rev tail)),
  },
end

-- is switching away from recursive definitions a good idea? who knows

def slice:
  Π m n: mynat,
    Π lst: mylist T,
      m ≤ n →
        n ≤ len lst → mylist T :=
(λ m n lst hmn hnl,
  -- really I just want to use the witness to m ≤ n here
  take (n - m)
    (drop m lst (le_trans hmn hnl))
    begin
      cases hmn with d hd,
      conv in n {rw hd},
      rw add_comm,
      rw add_sub,
      apply @le_cancel _ _ m,
      rw len_drop,
      rw add_comm,
      rw ←hd,
      from hnl,
    end)

-- swap elements at two indices (m and n resp.) in a list.
-- Cannot be the same index.
-- Require one index less than the other for convenience.
-- maybe define wrapper function?? but makes proofs harder
def swap_elems:
Π (m n: mynat) (lst: mylist T), m < n → n < len lst → mylist T
:= (λ m n lst hmn hnl,
    take m lst (lt_impl_le (lt_trans hmn hnl))
    ++ singleton (get n lst hnl)
    ++ slice (succ m) n lst (lt_iff_succ_le.mp hmn)
                            (lt_impl_le hnl)
    ++ singleton (get m lst (lt_trans hmn hnl))
    ++ drop (succ n) lst (lt_iff_succ_le.mp hnl))

theorem len_slice
(hmn: m ≤ n)
(hnl: n ≤ len lst):
len (slice m n lst hmn hnl) + m = n :=
begin
  unfold slice,
  rw len_take,
  cases hmn with d hd,
  rw hd,
  rw add_comm m d,
  rw add_sub,
end

theorem len_swap
(hmn: m < n)
(hnl: n < len lst):
len (swap_elems m n lst hmn hnl) = len lst :=
begin
  unfold swap_elems,
  repeat {rw len_concat_add},
  rw len_take,
  rw len_singleton,
  rw len_singleton,
  conv {
    congr,
    congr,
    congr,
    rw add_one_succ,
    rw add_comm,
    rw len_slice,
  },
  rw add_one_succ,
  rw add_comm,
  rw len_drop,
end

-- TODO: all this hypothesis-slinging is getting a bit ugly

-- good god working with equivalence relations is a pain
theorem swap_perm
(hmn: m < n)
(hnl: n < len lst):
is_perm lst (swap_elems m n lst hmn hnl) :=
begin
  have hml := lt_trans hmn hnl,
  have hml_ns := lt_impl_le hml,
  have hnl_ns := lt_impl_le hnl,
  unfold swap_elems,
  conv {
    congr,
    rw ←take_concat_drop hml_ns,
  },
  repeat {rw concat_assoc},
  apply perm_concat perm_refl,
  have hdmlne: drop m lst hml_ns ≠ empty, {
    assume h,
    have h2: len lst = m, {
      rw ←@len_drop _ _ m,
      rw h,
      from zero_add m,
    },
    rw h2 at hml,
    from lt_nrefl hml,
  },
  have hrw := @cons_head_tail _ (drop m lst hml_ns) hdmlne,
  have hrw2 := get_head_drop hml,
  conv {
    congr,
    rw ←hrw,
    rw ←hrw2,
  }, clear hrw hrw2,
  apply perm_trans _ perm_concat_swap,
  apply
    @perm_trans _
      (tail (drop m lst hml_ns) hdmlne ++ singleton (get m lst hml))
      _ perm_concat_swap,
  unfold slice,
  rw ←@drop_one_tail _ (drop m lst hml_ns)
    begin
      cases drop m lst hml_ns, {
        contradiction,
      }, {
        apply succ_le_succ,
        from zero_le,
      },
    end,
  rw @drop_drop _ _ m 1,
  conv in (m + 1) {rw add_one_succ},
  have hdl:
    ∀ hsml: succ m ≤ len lst,
      n - succ m ≤ len (drop (succ m) lst hsml), {
    assume _,
    cases (lt_iff_succ_le.mp hmn) with k hk,
    rw hk,
    rw add_comm,
    rw add_sub,
    apply @le_cancel _ _ (succ m),
    rw len_drop,
    rw add_comm,
    rw ←hk,
    from lt_impl_le hnl,
  },
  conv {
    congr,
    congr,
    rw ←@take_concat_drop _ (drop (succ m) lst _) (n - succ m) (hdl _),
  },
  rw concat_assoc,
  rw concat_assoc,
  apply perm_concat perm_refl,
  have hrw:
      succ m + (n - succ m) = n, {
    cases (lt_iff_succ_le.mp hmn) with k hk,
    rw hk,
    rw add_comm _ k,
    rw add_sub,
    rw add_comm,
  },
  rw @drop_drop _ lst (succ m) (n - succ m),
  conv {
    congr,
    congr,
    congr,
    rw hrw,
  },
  have hdnlne: drop n lst hnl_ns ≠ empty, {
    assume h,
    have h2: len lst = n, {
      rw ←@len_drop _ _ n,
      rw h,
      from zero_add n,
    },
    rw h2 at hnl,
    from lt_nrefl hnl,
  },
  have hrw2 := @cons_head_tail _ (drop n lst hnl_ns) hdnlne,
  have hrw3 := @get_head_drop _ lst n hnl,
  conv {
    congr,
    congr,
    rw ←hrw2,
    rw ←hrw3,
  },
  apply perm_trans perm_concat_swap,
  rw concat_assoc,
  apply perm_concat perm_refl,
  apply perm_trans _ perm_concat_swap,
  apply @perm_concat _ _ (singleton (get n lst hnl)) _ perm_refl,
  rw ←@drop_one_tail _ (drop n lst hnl_ns)
    begin
      cases hl: drop n lst hnl_ns, {
        rw hl at hdnlne,
        contradiction,
      }, {
        apply succ_le_succ,
        from zero_le,
      },
    end,
  rw @drop_drop _ _ n 1 _ _,
  refl,
end

-- TODO: swap involutive, get_swap

theorem count_head_eq:
count x (x :: xs) = succ (count x xs) :=
begin
  unfold count,
  rw if_pos rfl,
end

-- again should be typeclass
-- also this kind of signals how useless ∈ was
def index:
Π (n: mynat) (lst: mylist mynat), count n lst ≠ 0 → mynat
| n empty        h := absurd count_empty h
| n (x :: xs) h := if hnx: n = x then
                   0 else
                   succ (index n xs
                    begin
                      unfold count at h,
                      rw if_neg hnx at h,
                      from h,
                    end)

theorem index_head_eq
(hc: count x (x :: xs) ≠ 0):
index x (x :: xs) hc = 0 := dif_pos rfl

theorem index_valid
(hc: count n lst ≠ 0):
index n lst hc < len lst :=
begin
  induction lst with head tail h_ih, {
    contradiction,
  }, {
    unfold index,
    by_cases hnh: n = head, {
      rw dif_pos hnh,
      from zero_lt_succ,
    }, {
      rw dif_neg hnh,
      from succ_lt_succ (h_ih _),
    },
  },
end

@[simp]
theorem get_index
(hc: count n lst ≠ 0)
(hil: index n lst hc < len lst):
get (index n lst hc) lst hil = n :=
begin
  induction lst with head tail h_ih, {
    contradiction,
  }, {
    unfold index,
    by_cases hnh: n = head, {
      conv {
        congr,
        congr,
        rw dif_pos hnh,
      },
      rw get_zero_cons,
      from hnh.symm,
    }, {
      conv {
        congr,
        congr,
        rw dif_neg hnh,
      },
      rw get_succ_cons,
      apply h_ih,
    },
  },
end

theorem perm_head_cancel:
is_perm (x :: xs) (x :: ys) → is_perm xs ys :=
begin
  assume hpxsys,
  intro m,
  have := hpxsys m,
  unfold count at this,
  by_cases hmx: m = x, {
    repeat {rw if_pos hmx at this},
    from succ_inj this,
  }, {
    repeat {rw if_neg hmx at this},
    from this,
  },
end

theorem perm_concat_cancel:
is_perm (xs ++ lst1) (xs ++ lst2) → is_perm lst1 lst2 :=
begin
  induction xs with x xs h_ih, {
    assume h,
    from h,
  }, {
    assume h,
    apply h_ih,
    from perm_head_cancel h,
  },
end

theorem perm_len:
is_perm lst1 lst2 → len lst1 = len lst2 :=
begin
  induction lst1 with x xs h_ih generalizing lst2, {
    assume h,
    rw empty_perm_is_empty (perm_symm h),
  }, {
    assume h,
    cases lst2 with y ys, {
      cases empty_perm_is_empty h,
    }, {
      by_cases hxy: x = y, {
        rw hxy at h,
        -- can't work out direct way to "cancel" succs in goal
        simp,
        apply h_ih,
        from perm_head_cancel h,
      }, {
         have h_aux_1: count x (y :: ys) ≠ 0, {
          rw ←h x,
          rw count_head_eq,
          from succ_ne_zero,
         },
         have h_aux_2: 0 < index x (y :: ys) h_aux_1, {
          unfold index,
          rw dif_neg hxy,
          from zero_lt_succ,
         },
        -- world record for biggest "have" type-to-value ratio
        -- thank your maker that I split away some of the
        -- auxiliary hypotheses
        -- also I had to in order to do "cases" with hypothesis later,
        -- so couldn't afford to have any _s lying around
        have hpswap:
          is_perm
            (y :: ys)
            (swap_elems
              0
              (index x (y :: ys) h_aux_1)
              (y :: ys)
              h_aux_2
              (index_valid h_aux_1)) := swap_perm _ _,
        have hxswap := perm_trans h hpswap,
        clear hpswap,
        cases
            hswap: swap_elems 0 (index x (y :: ys) h_aux_1) (y :: ys) h_aux_2 (index_valid h_aux_1)
            with swap_head swap_tail, {
          rw hswap at hxswap,
          cases (empty_perm_is_empty hxswap),
        }, {
          rw hswap at hxswap,
          have hxsh: swap_head = x, {
            unfold swap_elems at hswap,
            symmetry,
            rw [take_zero, empty_concat, get_index] at hswap,
            from cons_injective_1 hswap,
          },
          rw hxsh at hxswap, clear hxsh,
          have := len_of_refl hswap,
          rw len_swap at this,
          rw this,
          simp,
          apply h_ih,
          from perm_head_cancel hxswap,
        },
      },
    },
  },
end

theorem is_perm_sorted_eq:
is_perm lst1 lst2 → is_sorted lst1 → is_sorted lst2
  → lst1 = lst2 :=
begin
  assume hp12 hs1 hs2,
  have hl12 := perm_len hp12,
  induction hl: len lst1 with n hn generalizing lst1 lst2, {
    rw [zz, ←empty_iff_len_zero] at hl,
    rw hl,
    rw hl at hp12,
    symmetry,
    from empty_perm_is_empty (perm_symm hp12),
  }, {
    cases lst1 with x xs, {
      contradiction,
    }, {
      cases lst2 with y ys, {
        contradiction,
      }, {
        have hxy: x = y, {
          -- note this is not use of classical reasoning, since
          -- we know = is decidable
          by_contradiction hxy',
          -- note sure if it would be worth it to use wlog or not
          -- is_sorted (y :: xs) seems like a pain to prove
          by_cases hxy'': x ≤ y, {
            have hxly := lt_iff_le_and_neq.mpr ⟨hxy'', hxy'⟩,
            have h :=
              hs2 0 (index x (y :: ys)
                begin
                  rw ←hp12 x,
                  rw count_head_eq,
                  from succ_ne_zero,
                end)
                (index_valid _)
                begin
                  unfold index,
                  rw dif_neg hxy',
                  from zero_lt_succ,
                end,
            rw get_zero_cons at h,
            rw get_index at h,
            contradiction,
          }, {
            have h :=
              hs1 0 (index y (x :: xs)
                begin
                  rw hp12 y,
                  rw count_head_eq,
                  from succ_ne_zero,
                end)
                (index_valid _)
                begin
                  unfold index,
                  have: ¬y = x, {
                    assume h,
                    from hxy' h.symm,
                  },
                  rw dif_neg this,
                  from zero_lt_succ,
                end,
            rw get_zero_cons at h,
            rw get_index at h,
            contradiction,
          },
        },
        rw hxy,
        simp,
        apply hn _ (tail_sorted hs1) (tail_sorted hs2), {
          simp at hl12,
          assumption,
        }, {
          simp at hl,
          assumption,
        }, {
          rw hxy at hp12,
          from perm_head_cancel hp12,
        },
      },
    },
  },
end

end mylist
end hidden


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

! This file was ported from Lean 3 source module topology.algebra.ring.ideal
! leanprover-community/mathlib commit 9a59dcb7a2d06bf55da57b9030169219980660cd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Algebra.Ring.Basic
import Mathlib.RingTheory.Ideal.Quotient

/-!
# Ideals and quotients of topological rings

In this file we define `Ideal.closure` to be the topological closure of an ideal in a topological
ring. We also define a `TopologicalSpace` structure on the quotient of a topological ring by an
ideal and prove that the quotient is a topological ring.
-/

section Ring

variable {R : Type _} [TopologicalSpace R] [Ring R] [TopologicalRing R]

/-- The closure of an ideal in a topological ring as an ideal. -/
protected def Ideal.closure (I : Ideal R) : Ideal R :=
  {
    AddSubmonoid.topologicalClosure
      I.toAddSubmonoid with
    carrier := closure I
    smul_mem' := fun c _ hx => map_mem_closure (mulLeft_continuous _) hx fun _ => I.mul_mem_left c }
#align ideal.closure Ideal.closure

@[simp]
theorem Ideal.coe_closure (I : Ideal R) : (I.closure : Set R) = closure I :=
  rfl
#align ideal.coe_closure Ideal.coe_closure

@[simp]
theorem Ideal.closure_eq_of_isClosed (I : Ideal R) [hI : IsClosed (I : Set R)] : I.closure = I :=
  SetLike.ext' hI.closure_eq
#align ideal.closure_eq_of_is_closed Ideal.closure_eq_of_isClosed

end Ring

section CommRing

variable {R : Type _} [TopologicalSpace R] [CommRing R] (N : Ideal R)

open Ideal.Quotient

instance topologicalRingQuotientTopology : TopologicalSpace (R ⧸ N) :=
  instTopologicalSpaceQuotient
#align topological_ring_quotient_topology topologicalRingQuotientTopology

-- note for the reader: in the following, `mk` is `Ideal.Quotient.mk`, the canonical map `R → R/I`.
variable [TopologicalRing R]

theorem QuotientRing.isOpenMap_coe : IsOpenMap (mk N) := by
  intro s s_op
  change IsOpen (mk N ⁻¹' (mk N '' s))
  rw [quotient_ring_saturate]
  exact isOpen_unionᵢ fun ⟨n, _⟩ => isOpenMap_add_left n s s_op
#align quotient_ring.is_open_map_coe QuotientRing.isOpenMap_coe

theorem QuotientRing.quotientMap_coe_coe : QuotientMap fun p : R × R => (mk N p.1, mk N p.2) :=
  IsOpenMap.to_quotientMap ((QuotientRing.isOpenMap_coe N).prod (QuotientRing.isOpenMap_coe N))
    (Continuous.prod_mk (Continuous.comp continuous_quot_mk continuous_fst) <|
      Continuous.comp continuous_quot_mk continuous_snd)
    -- porting note: this is lean4#2074 because this works with `etaExperiment`:
    -- `(continuous_quot_mk.comp continuous_fst).prod_mk (continuous_quot_mk.comp continuous_snd))`
    (by rintro ⟨⟨x⟩, ⟨y⟩⟩; exact ⟨(x, y), rfl⟩)
#align quotient_ring.quotient_map_coe_coe QuotientRing.quotientMap_coe_coe

instance topologicalRing_quotient : TopologicalRing (R ⧸ N) :=
  TopologicalSemiring.toTopologicalRing
    { continuous_add :=
        have cont : Continuous (mk N ∘ fun p : R × R => p.fst + p.snd) :=
          Continuous.comp continuous_quot_mk continuous_add
          -- porting note: this is lean4#2074 because this works with `etaExperiment`:
          -- `continuous_quot_mk.comp continuous_add`
        (QuotientMap.continuous_iff (QuotientRing.quotientMap_coe_coe N)).mpr cont
      continuous_mul :=
        have cont : Continuous (mk N ∘ fun p : R × R => p.fst * p.snd) :=
          Continuous.comp continuous_quot_mk continuous_mul
          -- porting note: this is lean4#2074 because this works with `etaExperiment`:
          -- `continuous_quot_mk.comp continuous_mul`
        (QuotientMap.continuous_iff (QuotientRing.quotientMap_coe_coe N)).mpr cont }
#align topological_ring_quotient topologicalRing_quotient

end CommRing


/-
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, Scott Morrison

! This file was ported from Lean 3 source module data.finsupp.defs
! leanprover-community/mathlib commit 842328d9df7e96fd90fc424e115679c15fb23a71
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.IndicatorFunction
import Mathlib.GroupTheory.Submonoid.Basic

/-!
# Type of functions with finite support

For any type `α` and any type `M` with zero, we define the type `Finsupp α M` (notation: `α →₀ M`)
of finitely supported functions from `α` to `M`, i.e. the functions which are zero everywhere
on `α` except on a finite set.

Functions with finite support are used (at least) in the following parts of the library:

* `MonoidAlgebra R M` and `AddMonoidAlgebra R M` are defined as `M →₀ R`;

* polynomials and multivariate polynomials are defined as `AddMonoidAlgebra`s, hence they use
  `Finsupp` under the hood;

* the linear combination of a family of vectors `v i` with coefficients `f i` (as used, e.g., to
  define linearly independent family `LinearIndependent`) is defined as a map
  `Finsupp.total : (ι → M) → (ι →₀ R) →ₗ[R] M`.

Some other constructions are naturally equivalent to `α →₀ M` with some `α` and `M` but are defined
in a different way in the library:

* `Multiset α ≃+ α →₀ ℕ`;
* `FreeAbelianGroup α ≃+ α →₀ ℤ`.

Most of the theory assumes that the range is a commutative additive monoid. This gives us the big
sum operator as a powerful way to construct `Finsupp` elements, which is defined in
`Algebra/BigOperators/Finsupp`.

-- Porting note: the semireducibility remark no longer applies in Lean 4, afaict.
Many constructions based on `α →₀ M` use `semireducible` type tags to avoid reusing unwanted type
instances. E.g., `MonoidAlgebra`, `AddMonoidAlgebra`, and types based on these two have
non-pointwise multiplication.

## Main declarations

* `Finsupp`: The type of finitely supported functions from `α` to `β`.
* `Finsupp.single`: The `Finsupp` which is nonzero in exactly one point.
* `Finsupp.update`: Changes one value of a `Finsupp`.
* `Finsupp.erase`: Replaces one value of a `Finsupp` by `0`.
* `Finsupp.onFinset`: The restriction of a function to a `Finset` as a `Finsupp`.
* `Finsupp.mapRange`: Composition of a `ZeroHom` with a `Finsupp`.
* `Finsupp.embDomain`: Maps the domain of a `Finsupp` by an embedding.
* `Finsupp.zipWith`: Postcomposition of two `Finsupp`s with a function `f` such that `f 0 0 = 0`.

## Notations

This file adds `α →₀ M` as a global notation for `Finsupp α M`.

We also use the following convention for `Type*` variables in this file

* `α`, `β`, `γ`: types with no additional structure that appear as the first argument to `Finsupp`
  somewhere in the statement;

* `ι` : an auxiliary index type;

* `M`, `M'`, `N`, `P`: types with `Zero` or `(Add)(Comm)Monoid` structure; `M` is also used
  for a (semi)module over a (semi)ring.

* `G`, `H`: groups (commutative or not, multiplicative or additive);

* `R`, `S`: (semi)rings.

## Implementation notes

This file is a `noncomputable theory` and uses classical logic throughout.

## TODO

* Expand the list of definitions and important lemmas to the module docstring.

-/

noncomputable section

open Finset Function

open BigOperators

variable {α β γ ι M M' N P G H R S : Type _}

/-- `Finsupp α M`, denoted `α →₀ M`, is the type of functions `f : α → M` such that
  `f x = 0` for all but finitely many `x`. -/
structure Finsupp (α : Type _) (M : Type _) [Zero M] where
  /-- The support of a finitely supported function (aka `Finsupp`). -/
  support : Finset α
  /-- The underlying function of a bundled finitely supported function (aka `Finsupp`). -/
  toFun : α → M
  /-- The witness that the support of a `Finsupp` is indeed the exact locus where its
  underlying function is nonzero. -/
  mem_support_toFun : ∀ a, a ∈ support ↔ toFun a ≠ 0
#align finsupp Finsupp
#align finsupp.support Finsupp.support
#align finsupp.to_fun Finsupp.toFun
#align finsupp.mem_support_to_fun Finsupp.mem_support_toFun

@[inherit_doc]
infixr:25 " →₀ " => Finsupp

namespace Finsupp

/-! ### Basic declarations about `Finsupp` -/

section Basic

variable [Zero M]

instance funLike : FunLike (α →₀ M) α fun _ => M :=
  ⟨toFun, by
    rintro ⟨s, f, hf⟩ ⟨t, g, hg⟩ (rfl : f = g)
    congr
    ext a
    exact (hf _).trans (hg _).symm⟩
#align finsupp.fun_like Finsupp.funLike

/-- Helper instance for when there are too many metavariables to apply the `FunLike` instance
directly. -/
instance coeFun : CoeFun (α →₀ M) fun _ => α → M :=
  inferInstance
#align finsupp.has_coe_to_fun Finsupp.coeFun

@[ext]
theorem ext {f g : α →₀ M} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext _ _ h
#align finsupp.ext Finsupp.ext

@[deprecated FunLike.ext_iff]
theorem ext_iff {f g : α →₀ M} : f = g ↔ ∀ a, f a = g a :=
  FunLike.ext_iff
#align finsupp.ext_iff Finsupp.ext_iff

@[deprecated FunLike.coe_fn_eq]
theorem coeFn_inj {f g : α →₀ M} : (f : α → M) = g ↔ f = g :=
  FunLike.coe_fn_eq
#align finsupp.coe_fn_inj Finsupp.coeFn_inj

@[deprecated FunLike.coe_injective]
theorem coeFn_injective : @Function.Injective (α →₀ M) (α → M) (⇑) :=
  FunLike.coe_injective
#align finsupp.coe_fn_injective Finsupp.coeFn_injective

@[deprecated FunLike.congr_fun]
theorem congr_fun {f g : α →₀ M} (h : f = g) (a : α) : f a = g a :=
  FunLike.congr_fun h _
#align finsupp.congr_fun Finsupp.congr_fun

@[simp]
theorem coe_mk (f : α → M) (s : Finset α) (h : ∀ a, a ∈ s ↔ f a ≠ 0) : ⇑(⟨s, f, h⟩ : α →₀ M) = f :=
  rfl
#align finsupp.coe_mk Finsupp.coe_mk

instance zero : Zero (α →₀ M) :=
  ⟨⟨∅, 0, fun _ => ⟨fun h ↦ (not_mem_empty _ h).elim, fun H => (H rfl).elim⟩⟩⟩
#align finsupp.has_zero Finsupp.zero

@[simp]
theorem coe_zero : ⇑(0 : α →₀ M) = 0 :=
  rfl
#align finsupp.coe_zero Finsupp.coe_zero

theorem zero_apply {a : α} : (0 : α →₀ M) a = 0 :=
  rfl
#align finsupp.zero_apply Finsupp.zero_apply

@[simp]
theorem support_zero : (0 : α →₀ M).support = ∅ :=
  rfl
#align finsupp.support_zero Finsupp.support_zero

instance inhabited : Inhabited (α →₀ M) :=
  ⟨0⟩
#align finsupp.inhabited Finsupp.inhabited

@[simp]
theorem mem_support_iff {f : α →₀ M} : ∀ {a : α}, a ∈ f.support ↔ f a ≠ 0 :=
  @(f.mem_support_toFun)
#align finsupp.mem_support_iff Finsupp.mem_support_iff

@[simp, norm_cast]
theorem fun_support_eq (f : α →₀ M) : Function.support f = f.support :=
  Set.ext fun _x => mem_support_iff.symm
#align finsupp.fun_support_eq Finsupp.fun_support_eq

theorem not_mem_support_iff {f : α →₀ M} {a} : a ∉ f.support ↔ f a = 0 :=
  not_iff_comm.1 mem_support_iff.symm
#align finsupp.not_mem_support_iff Finsupp.not_mem_support_iff

@[simp, norm_cast]
theorem coe_eq_zero {f : α →₀ M} : (f : α → M) = 0 ↔ f = 0 := by rw [← coe_zero, FunLike.coe_fn_eq]
#align finsupp.coe_eq_zero Finsupp.coe_eq_zero

theorem ext_iff' {f g : α →₀ M} : f = g ↔ f.support = g.support ∧ ∀ x ∈ f.support, f x = g x :=
  ⟨fun h => h ▸ ⟨rfl, fun _ _ => rfl⟩, fun ⟨h₁, h₂⟩ =>
    ext fun a => by
      classical
      exact if h : a ∈ f.support then h₂ a h else by
        have hf : f a = 0 := not_mem_support_iff.1 h
        have hg : g a = 0 := by rwa [h₁, not_mem_support_iff] at h
        rw [hf, hg]⟩
#align finsupp.ext_iff' Finsupp.ext_iff'

@[simp]
theorem support_eq_empty {f : α →₀ M} : f.support = ∅ ↔ f = 0 := by
  exact_mod_cast @Function.support_eq_empty_iff _ _ _ f
#align finsupp.support_eq_empty Finsupp.support_eq_empty

theorem support_nonempty_iff {f : α →₀ M} : f.support.Nonempty ↔ f ≠ 0 := by
  simp only [Finsupp.support_eq_empty, Finset.nonempty_iff_ne_empty, Ne.def]
#align finsupp.support_nonempty_iff Finsupp.support_nonempty_iff

theorem nonzero_iff_exists {f : α →₀ M} : f ≠ 0 ↔ ∃ a : α, f a ≠ 0 := by
  simp [← Finsupp.support_eq_empty, Finset.eq_empty_iff_forall_not_mem]
#align finsupp.nonzero_iff_exists Finsupp.nonzero_iff_exists

theorem card_support_eq_zero {f : α →₀ M} : card f.support = 0 ↔ f = 0 := by simp
#align finsupp.card_support_eq_zero Finsupp.card_support_eq_zero

instance decidableEq [DecidableEq α] [DecidableEq M] : DecidableEq (α →₀ M) := fun f g =>
  decidable_of_iff (f.support = g.support ∧ ∀ a ∈ f.support, f a = g a) ext_iff'.symm
#align finsupp.decidable_eq Finsupp.decidableEq

theorem finite_support (f : α →₀ M) : Set.Finite (Function.support f) :=
  f.fun_support_eq.symm ▸ f.support.finite_toSet
#align finsupp.finite_support Finsupp.finite_support

/- ./././Mathport/Syntax/Translate/Basic.lean:632:2:
  warning: expanding binder collection (a «expr ∉ » s) -/
theorem support_subset_iff {s : Set α} {f : α →₀ M} : ↑f.support ⊆ s ↔ ∀ (a) (_ : a ∉ s), f a = 0 :=
  by
  simp only [Set.subset_def, mem_coe, mem_support_iff]; exact forall_congr' fun a => not_imp_comm
#align finsupp.support_subset_iff Finsupp.support_subset_iff

/-- Given `Finite α`, `equivFunOnFinite` is the `Equiv` between `α →₀ β` and `α → β`.
  (All functions on a finite type are finitely supported.) -/
@[simps]
def equivFunOnFinite [Finite α] : (α →₀ M) ≃ (α → M) where
  toFun := (⇑)
  invFun f := mk (Function.support f).toFinite.toFinset f fun _a => Set.Finite.mem_toFinset _
  left_inv _f := ext fun _x => rfl
  right_inv _f := rfl
#align finsupp.equiv_fun_on_finite Finsupp.equivFunOnFinite

@[simp]
theorem equivFunOnFinite_symm_coe {α} [Finite α] (f : α →₀ M) : equivFunOnFinite.symm f = f :=
  equivFunOnFinite.symm_apply_apply f
#align finsupp.equiv_fun_on_finite_symm_coe Finsupp.equivFunOnFinite_symm_coe

/--
If `α` has a unique term, the type of finitely supported functions `α →₀ β` is equivalent to `β`.
-/
@[simps!]
noncomputable def _root_.Equiv.finsuppUnique {ι : Type _} [Unique ι] : (ι →₀ M) ≃ M :=
  Finsupp.equivFunOnFinite.trans (Equiv.funUnique ι M)
#align equiv.finsupp_unique Equiv.finsuppUnique
#align equiv.finsupp_unique_symm_apply_support_val Equiv.finsuppUnique_symm_apply_support_val
#align equiv.finsupp_unique_symm_apply_to_fun Equiv.finsuppUnique_symm_apply_toFun
#align equiv.finsupp_unique_apply Equiv.finsuppUnique_apply

@[ext]
theorem unique_ext [Unique α] {f g : α →₀ M} (h : f default = g default) : f = g :=
  ext fun a => by rwa [Unique.eq_default a]
#align finsupp.unique_ext Finsupp.unique_ext

theorem unique_ext_iff [Unique α] {f g : α →₀ M} : f = g ↔ f default = g default :=
  ⟨fun h => h ▸ rfl, unique_ext⟩
#align finsupp.unique_ext_iff Finsupp.unique_ext_iff

end Basic

/-! ### Declarations about `single` -/

section Single

variable [Zero M] {a a' : α} {b : M}

/-- `single a b` is the finitely supported function with value `b` at `a` and zero otherwise. -/
def single (a : α) (b : M) : α →₀ M
    where
  support :=
    haveI := Classical.decEq M
    if b = 0 then ∅ else {a}
  toFun :=
    haveI := Classical.decEq α
    Pi.single a b
  mem_support_toFun a' := by
    classical
      obtain rfl | hb := eq_or_ne b 0
      · simp [Pi.single, update]
      rw [if_neg hb, mem_singleton]
      obtain rfl | ha := eq_or_ne a' a
      · simp [hb, Pi.single, update]
      simp [Pi.single_eq_of_ne' ha.symm, ha]
#align finsupp.single Finsupp.single

theorem single_apply [Decidable (a = a')] : single a b a' = if a = a' then b else 0 := by
  classical
  simp_rw [@eq_comm _ a a']
  convert Pi.single_apply a b a'
#align finsupp.single_apply Finsupp.single_apply

theorem single_apply_left {f : α → β} (hf : Function.Injective f) (x z : α) (y : M) :
    single (f x) y (f z) = single x y z := by classical simp only [single_apply, hf.eq_iff]
#align finsupp.single_apply_left Finsupp.single_apply_left

theorem single_eq_set_indicator : ⇑(single a b) = Set.indicator {a} fun _ => b := by
  classical
  ext
  simp [single_apply, Set.indicator, @eq_comm _ a]
#align finsupp.single_eq_set_indicator Finsupp.single_eq_set_indicator

@[simp]
theorem single_eq_same : (single a b : α →₀ M) a = b := by
  classical exact Pi.single_eq_same (f := λ _ => M) a b
#align finsupp.single_eq_same Finsupp.single_eq_same

@[simp]

theorem single_eq_update [DecidableEq α] (a : α) (b : M) :
    ⇑(single a b) = Function.update (0 : _) a b :=
  by classical rw [single_eq_set_indicator, ← Set.piecewise_eq_indicator, Set.piecewise_singleton]
#align finsupp.single_eq_update Finsupp.single_eq_update

theorem single_eq_pi_single [DecidableEq α] (a : α) (b : M) : ⇑(single a b) = Pi.single a b :=
  single_eq_update a b
#align finsupp.single_eq_pi_single Finsupp.single_eq_pi_single

@[simp]
theorem single_zero (a : α) : (single a 0 : α →₀ M) = 0 :=
  FunLike.coe_injective <| by
    classical simpa only [single_eq_update, coe_zero] using Function.update_eq_self a (0 : α → M)
#align finsupp.single_zero Finsupp.single_zero

theorem single_of_single_apply (a a' : α) (b : M) :
    single a ((single a' b) a) = single a' (single a' b) a := by
  classical
  rw [single_apply, single_apply]
  ext
  split_ifs with h
  · rw [h]
  · rw [zero_apply, single_apply, ite_self]
#align finsupp.single_of_single_apply Finsupp.single_of_single_apply

theorem support_single_ne_zero (a : α) (hb : b ≠ 0) : (single a b).support = {a} :=
  if_neg hb
#align finsupp.support_single_ne_zero Finsupp.support_single_ne_zero

theorem support_single_subset : (single a b).support ⊆ {a} := by
  classical show ite _ _ _ ⊆ _; split_ifs <;> [exact empty_subset _, exact Subset.refl _]
#align finsupp.support_single_subset Finsupp.support_single_subset

theorem single_apply_mem (x) : single a b x ∈ ({0, b} : Set M) := by
  rcases em (a = x) with (rfl | hx) <;> [simp, simp [single_eq_of_ne hx]]
#align finsupp.single_apply_mem Finsupp.single_apply_mem

theorem range_single_subset : Set.range (single a b) ⊆ {0, b} :=
  Set.range_subset_iff.2 single_apply_mem
#align finsupp.range_single_subset Finsupp.range_single_subset

/-- `Finsupp.single a b` is injective in `b`. For the statement that it is injective in `a`, see
`Finsupp.single_left_injective` -/
theorem single_injective (a : α) : Function.Injective (single a : M → α →₀ M) := fun b₁ b₂ eq => by
  have : (single a b₁ : α →₀ M) a = (single a b₂ : α →₀ M) a := by rw [eq]
  rwa [single_eq_same, single_eq_same] at this
#align finsupp.single_injective Finsupp.single_injective

theorem single_apply_eq_zero {a x : α} {b : M} : single a b x = 0 ↔ x = a → b = 0 := by
  simp [single_eq_set_indicator]
#align finsupp.single_apply_eq_zero Finsupp.single_apply_eq_zero

theorem single_apply_ne_zero {a x : α} {b : M} : single a b x ≠ 0 ↔ x = a ∧ b ≠ 0 := by
  simp [single_apply_eq_zero]
#align finsupp.single_apply_ne_zero Finsupp.single_apply_ne_zero

theorem mem_support_single (a a' : α) (b : M) : a ∈ (single a' b).support ↔ a = a' ∧ b ≠ 0 := by
  simp [single_apply_eq_zero, not_or]
#align finsupp.mem_support_single Finsupp.mem_support_single

theorem eq_single_iff {f : α →₀ M} {a b} : f = single a b ↔ f.support ⊆ {a} ∧ f a = b := by
  refine' ⟨fun h => h.symm ▸ ⟨support_single_subset, single_eq_same⟩, _⟩
  rintro ⟨h, rfl⟩
  ext x
  by_cases hx : a = x <;> simp only [hx, single_eq_same, single_eq_of_ne, Ne.def, not_false_iff]
  exact not_mem_support_iff.1 (mt (fun hx => (mem_singleton.1 (h hx)).symm) hx)
#align finsupp.eq_single_iff Finsupp.eq_single_iff

theorem single_eq_single_iff (a₁ a₂ : α) (b₁ b₂ : M) :
    single a₁ b₁ = single a₂ b₂ ↔ a₁ = a₂ ∧ b₁ = b₂ ∨ b₁ = 0 ∧ b₂ = 0 := by
  constructor
  · intro eq
    by_cases h : a₁ = a₂
    · refine' Or.inl ⟨h, _⟩
      rwa [h, (single_injective a₂).eq_iff] at eq
    · rw [FunLike.ext_iff] at eq
      have h₁ := eq a₁
      have h₂ := eq a₂
      simp only [single_eq_same, single_eq_of_ne h, single_eq_of_ne (Ne.symm h)] at h₁ h₂
      exact Or.inr ⟨h₁, h₂.symm⟩
  · rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩)
    · rfl
    · rw [single_zero, single_zero]
#align finsupp.single_eq_single_iff Finsupp.single_eq_single_iff

/-- `Finsupp.single a b` is injective in `a`. For the statement that it is injective in `b`, see
`Finsupp.single_injective` -/
theorem single_left_injective (h : b ≠ 0) : Function.Injective fun a : α => single a b :=
  fun _a _a' H => (((single_eq_single_iff _ _ _ _).mp H).resolve_right fun hb => h hb.1).left
#align finsupp.single_left_injective Finsupp.single_left_injective

theorem single_left_inj (h : b ≠ 0) : single a b = single a' b ↔ a = a' :=
  (single_left_injective h).eq_iff
#align finsupp.single_left_inj Finsupp.single_left_inj

theorem support_single_ne_bot (i : α) (h : b ≠ 0) : (single i b).support ≠ ⊥ := by
  simpa only [support_single_ne_zero _ h] using singleton_ne_empty _
#align finsupp.support_single_ne_bot Finsupp.support_single_ne_bot

theorem support_single_disjoint {b' : M} (hb : b ≠ 0) (hb' : b' ≠ 0) {i j : α} :
    Disjoint (single i b).support (single j b').support ↔ i ≠ j := by
  rw [support_single_ne_zero _ hb, support_single_ne_zero _ hb', disjoint_singleton]
#align finsupp.support_single_disjoint Finsupp.support_single_disjoint

@[simp]
theorem single_eq_zero : single a b = 0 ↔ b = 0 := by
  simp [FunLike.ext_iff, single_eq_set_indicator]
#align finsupp.single_eq_zero Finsupp.single_eq_zero

theorem single_swap (a₁ a₂ : α) (b : M) : single a₁ b a₂ = single a₂ b a₁ := by
  classical simp only [single_apply, eq_comm]
#align finsupp.single_swap Finsupp.single_swap

instance nontrivial [Nonempty α] [Nontrivial M] : Nontrivial (α →₀ M) := by
  inhabit α
  rcases exists_ne (0 : M) with ⟨x, hx⟩
  exact nontrivial_of_ne (single default x) 0 (mt single_eq_zero.1 hx)
#align finsupp.nontrivial Finsupp.nontrivial

theorem unique_single [Unique α] (x : α →₀ M) : x = single default (x default) :=
  ext <| Unique.forall_iff.2 single_eq_same.symm
#align finsupp.unique_single Finsupp.unique_single

@[simp]
theorem unique_single_eq_iff [Unique α] {b' : M} : single a b = single a' b' ↔ b = b' := by
  rw [unique_ext_iff, Unique.eq_default a, Unique.eq_default a', single_eq_same, single_eq_same]
#align finsupp.unique_single_eq_iff Finsupp.unique_single_eq_iff

theorem support_eq_singleton {f : α →₀ M} {a : α} :
    f.support = {a} ↔ f a ≠ 0 ∧ f = single a (f a) :=
  ⟨fun h =>
    ⟨mem_support_iff.1 <| h.symm ▸ Finset.mem_singleton_self a,
      eq_single_iff.2 ⟨subset_of_eq h, rfl⟩⟩,
    fun h => h.2.symm ▸ support_single_ne_zero _ h.1⟩
#align finsupp.support_eq_singleton Finsupp.support_eq_singleton

/- ./././Mathport/Syntax/Translate/Basic.lean:632:2:
  warning: expanding binder collection (b «expr ≠ » 0) -/
theorem support_eq_singleton' {f : α →₀ M} {a : α} :
    f.support = {a} ↔ ∃ (b : _)(_ : b ≠ 0), f = single a b :=
  ⟨fun h =>
    let h := support_eq_singleton.1 h
    ⟨_, h.1, h.2⟩,
    fun ⟨_b, hb, hf⟩ => hf.symm ▸ support_single_ne_zero _ hb⟩
#align finsupp.support_eq_singleton' Finsupp.support_eq_singleton'

theorem card_support_eq_one {f : α →₀ M} : card f.support = 1 ↔ ∃ a, f a ≠ 0 ∧ f = single a (f a) :=
  by simp only [card_eq_one, support_eq_singleton]
#align finsupp.card_support_eq_one Finsupp.card_support_eq_one

/- ./././Mathport/Syntax/Translate/Basic.lean:632:2:
  warning: expanding binder collection (b «expr ≠ » 0) -/
theorem card_support_eq_one' {f : α →₀ M} :
    card f.support = 1 ↔ ∃ (a : _)(b : _)(_ : b ≠ 0), f = single a b := by
  simp only [card_eq_one, support_eq_singleton']
#align finsupp.card_support_eq_one' Finsupp.card_support_eq_one'

theorem support_subset_singleton {f : α →₀ M} {a : α} : f.support ⊆ {a} ↔ f = single a (f a) :=
  ⟨fun h => eq_single_iff.mpr ⟨h, rfl⟩, fun h => (eq_single_iff.mp h).left⟩
#align finsupp.support_subset_singleton Finsupp.support_subset_singleton

theorem support_subset_singleton' {f : α →₀ M} {a : α} : f.support ⊆ {a} ↔ ∃ b, f = single a b :=
  ⟨fun h => ⟨f a, support_subset_singleton.mp h⟩, fun ⟨b, hb⟩ => by
    rw [hb, support_subset_singleton, single_eq_same]⟩
#align finsupp.support_subset_singleton' Finsupp.support_subset_singleton'

theorem card_support_le_one [Nonempty α] {f : α →₀ M} :
    card f.support ≤ 1 ↔ ∃ a, f = single a (f a) := by
  simp only [card_le_one_iff_subset_singleton, support_subset_singleton]
#align finsupp.card_support_le_one Finsupp.card_support_le_one

theorem card_support_le_one' [Nonempty α] {f : α →₀ M} :
    card f.support ≤ 1 ↔ ∃ a b, f = single a b := by
  simp only [card_le_one_iff_subset_singleton, support_subset_singleton']
#align finsupp.card_support_le_one' Finsupp.card_support_le_one'

@[simp]
theorem equivFunOnFinite_single [DecidableEq α] [Finite α] (x : α) (m : M) :
    Finsupp.equivFunOnFinite (Finsupp.single x m) = Pi.single x m := by
  ext
  simp [Finsupp.single_eq_pi_single, equivFunOnFinite]
#align finsupp.equiv_fun_on_finite_single Finsupp.equivFunOnFinite_single

@[simp]
theorem equivFunOnFinite_symm_single [DecidableEq α] [Finite α] (x : α) (m : M) :
    Finsupp.equivFunOnFinite.symm (Pi.single x m) = Finsupp.single x m := by
  rw [← equivFunOnFinite_single, Equiv.symm_apply_apply]
#align finsupp.equiv_fun_on_finite_symm_single Finsupp.equivFunOnFinite_symm_single

end Single

/-! ### Declarations about `update` -/

section Update

variable [Zero M] (f : α →₀ M) (a : α) (b : M) (i : α)

/-- Replace the value of a `α →₀ M` at a given point `a : α` by a given value `b : M`.
If `b = 0`, this amounts to removing `a` from the `Finsupp.support`.
Otherwise, if `a` was not in the `Finsupp.support`, it is added to it.

This is the finitely-supported version of `Function.update`. -/
def update (f : α →₀ M) (a : α) (b : M) : α →₀ M where
  support := by
    haveI := Classical.decEq α; haveI := Classical.decEq M
    exact if b = 0 then f.support.erase a else insert a f.support
  toFun :=
    haveI := Classical.decEq α
    Function.update f a b
  mem_support_toFun i := by
    classical
    simp [Function.update, Ne.def]
    split_ifs with hb ha ha <;>
    simp only [*, not_false_iff, iff_true, not_true, iff_false]
    · rw [Finset.mem_erase]
      simp
    · rw [Finset.mem_erase]
      simp [ha]
    · rw [Finset.mem_insert]
      simp [ha]
    · rw [Finset.mem_insert]
      simp [ha]
#align finsupp.update Finsupp.update

@[simp]
theorem coe_update [DecidableEq α] : (f.update a b : α → M) = Function.update f a b := by
  delta update Function.update
  ext
  dsimp
  split_ifs <;> simp
#align finsupp.coe_update Finsupp.coe_update

@[simp]
theorem update_self : f.update a (f a) = f := by
  classical
    ext
    simp
#align finsupp.update_self Finsupp.update_self

@[simp]
theorem zero_update : update 0 a b = single a b := by
  classical
    ext
    rw [single_eq_update]
    rfl
#align finsupp.zero_update Finsupp.zero_update

theorem support_update [DecidableEq α] [DecidableEq M] :
    support (f.update a b) = if b = 0 then f.support.erase a else insert a f.support := by
  classical
  dsimp [update]; congr <;> apply Subsingleton.elim
#align finsupp.support_update Finsupp.support_update

@[simp]
theorem support_update_zero [DecidableEq α] : support (f.update a 0) = f.support.erase a := by
  classical
  simp only [update, ite_true, mem_support_iff, ne_eq, not_not]
  congr; apply Subsingleton.elim
#align finsupp.support_update_zero Finsupp.support_update_zero

variable {b}

theorem support_update_ne_zero [DecidableEq α] (h : b ≠ 0) :
    support (f.update a b) = insert a f.support := by
  classical
  simp only [update, h, ite_false, mem_support_iff, ne_eq]
  congr; apply Subsingleton.elim
#align finsupp.support_update_ne_zero Finsupp.support_update_ne_zero

end Update

/-! ### Declarations about `erase` -/

section Erase

variable [Zero M]

/--
`erase a f` is the finitely supported function equal to `f` except at `a` where it is equal to `0`.
If `a` is not in the support of `f` then `erase a f = f`.
-/
def erase (a : α) (f : α →₀ M) : α →₀ M where
  support :=
    haveI := Classical.decEq α
    f.support.erase a
  toFun a' :=
    haveI := Classical.decEq α
    if a' = a then 0 else f a'
  mem_support_toFun a' := by
    classical
    rw [mem_erase, mem_support_iff]; dsimp
    split_ifs with h
    exact ⟨fun H _ => H.1 h, fun H => (H rfl).elim⟩
    exact and_iff_right h
#align finsupp.erase Finsupp.erase

@[simp]
theorem support_erase [DecidableEq α] {a : α} {f : α →₀ M} :
    (f.erase a).support = f.support.erase a := by
  classical
  dsimp [erase]
  congr; apply Subsingleton.elim
#align finsupp.support_erase Finsupp.support_erase

@[simp]
theorem erase_same {a : α} {f : α →₀ M} : (f.erase a) a = 0 := by
  classical simp only [erase, coe_mk, ite_true]
#align finsupp.erase_same Finsupp.erase_same

@[simp]
theorem erase_ne {a a' : α} {f : α →₀ M} (h : a' ≠ a) : (f.erase a) a' = f a' := by
  classical simp only [erase, coe_mk, h, ite_false]
#align finsupp.erase_ne Finsupp.erase_ne

@[simp]
theorem erase_single {a : α} {b : M} : erase a (single a b) = 0 := by
  ext s; by_cases hs : s = a
  · rw [hs, erase_same]
    rfl
  · rw [erase_ne hs]
    exact single_eq_of_ne (Ne.symm hs)
#align finsupp.erase_single Finsupp.erase_single

theorem erase_single_ne {a a' : α} {b : M} (h : a ≠ a') : erase a (single a' b) = single a' b := by
  ext s; by_cases hs : s = a
  · rw [hs, erase_same, single_eq_of_ne h.symm]
  · rw [erase_ne hs]
#align finsupp.erase_single_ne Finsupp.erase_single_ne

@[simp]
theorem erase_of_not_mem_support {f : α →₀ M} {a} (haf : a ∉ f.support) : erase a f = f := by
  ext b; by_cases hab : b = a
  · rwa [hab, erase_same, eq_comm, ← not_mem_support_iff]
  · rw [erase_ne hab]
#align finsupp.erase_of_not_mem_support Finsupp.erase_of_not_mem_support

@[simp, nolint simpNF] -- Porting note: simpNF linter claims simp can prove this, it can not
theorem erase_zero (a : α) : erase a (0 : α →₀ M) = 0 := by
  classical rw [← support_eq_empty, support_erase, support_zero, erase_empty]
#align finsupp.erase_zero Finsupp.erase_zero

end Erase

/-! ### Declarations about `onFinset` -/

section OnFinset

variable [Zero M]

/-- `Finsupp.onFinset s f hf` is the finsupp function representing `f` restricted to the finset `s`.
The function must be `0` outside of `s`. Use this when the set needs to be filtered anyways,
otherwise a better set representation is often available. -/
def onFinset (s : Finset α) (f : α → M) (hf : ∀ a, f a ≠ 0 → a ∈ s) : α →₀ M where
  support :=
    haveI := Classical.decEq M
    s.filter (f · ≠ 0)
  toFun := f
  mem_support_toFun := by classical simpa
#align finsupp.on_finset Finsupp.onFinset

@[simp]
theorem onFinset_apply {s : Finset α} {f : α → M} {hf a} : (onFinset s f hf : α →₀ M) a = f a :=
  rfl
#align finsupp.on_finset_apply Finsupp.onFinset_apply

@[simp]
theorem support_onFinset_subset {s : Finset α} {f : α → M} {hf} :
    (onFinset s f hf).support ⊆ s := by
  classical convert filter_subset (f · ≠ 0) s
#align finsupp.support_on_finset_subset Finsupp.support_onFinset_subset

-- @[simp] -- Porting note: simp can prove this
theorem mem_support_onFinset {s : Finset α} {f : α → M} (hf : ∀ a : α, f a ≠ 0 → a ∈ s) {a : α} :
    a ∈ (Finsupp.onFinset s f hf).support ↔ f a ≠ 0 := by
  rw [Finsupp.mem_support_iff, Finsupp.onFinset_apply]
#align finsupp.mem_support_on_finset Finsupp.mem_support_onFinset

theorem support_onFinset [DecidableEq M] {s : Finset α} {f : α → M}
    (hf : ∀ a : α, f a ≠ 0 → a ∈ s) :
    (Finsupp.onFinset s f hf).support = s.filter fun a => f a ≠ 0 := by
  dsimp [onFinset]; congr
#align finsupp.support_on_finset Finsupp.support_onFinset

end OnFinset

section OfSupportFinite

variable [Zero M]

/-- The natural `Finsupp` induced by the function `f` given that it has finite support. -/
noncomputable def ofSupportFinite (f : α → M) (hf : (Function.support f).Finite) : α →₀ M where
  support := hf.toFinset
  toFun := f
  mem_support_toFun _ := hf.mem_toFinset
#align finsupp.of_support_finite Finsupp.ofSupportFinite

theorem ofSupportFinite_coe {f : α → M} {hf : (Function.support f).Finite} :
    (ofSupportFinite f hf : α → M) = f :=
  rfl
#align finsupp.of_support_finite_coe Finsupp.ofSupportFinite_coe

instance canLift : CanLift (α → M) (α →₀ M) (⇑) fun f => (Function.support f).Finite
    where prf f hf := ⟨ofSupportFinite f hf, rfl⟩
#align finsupp.can_lift Finsupp.canLift

end OfSupportFinite

/-! ### Declarations about `mapRange` -/

section MapRange

variable [Zero M] [Zero N] [Zero P]

/-- The composition of `f : M → N` and `g : α →₀ M` is `mapRange f hf g : α →₀ N`,
which is well-defined when `f 0 = 0`.

This preserves the structure on `f`, and exists in various bundled forms for when `f` is itself
bundled (defined in `Data/Finsupp/Basic`):

* `Finsupp.mapRange.equiv`
* `Finsupp.mapRange.zeroHom`
* `Finsupp.mapRange.addMonoidHom`
* `Finsupp.mapRange.addEquiv`
* `Finsupp.mapRange.linearMap`
* `Finsupp.mapRange.linearEquiv`
-/
def mapRange (f : M → N) (hf : f 0 = 0) (g : α →₀ M) : α →₀ N :=
  onFinset g.support (f ∘ g) fun a => by
    rw [mem_support_iff, not_imp_not]; exact fun H => (congr_arg f H).trans hf
#align finsupp.map_range Finsupp.mapRange

@[simp]
theorem mapRange_apply {f : M → N} {hf : f 0 = 0} {g : α →₀ M} {a : α} :
    mapRange f hf g a = f (g a) :=
  rfl
#align finsupp.map_range_apply Finsupp.mapRange_apply

@[simp]
theorem mapRange_zero {f : M → N} {hf : f 0 = 0} : mapRange f hf (0 : α →₀ M) = 0 :=
  ext fun a => by simp only [hf, zero_apply, mapRange_apply]
#align finsupp.map_range_zero Finsupp.mapRange_zero

@[simp]
theorem mapRange_id (g : α →₀ M) : mapRange id rfl g = g :=
  ext fun _ => rfl
#align finsupp.map_range_id Finsupp.mapRange_id

theorem mapRange_comp (f : N → P) (hf : f 0 = 0) (f₂ : M → N) (hf₂ : f₂ 0 = 0) (h : (f ∘ f₂) 0 = 0)
    (g : α →₀ M) : mapRange (f ∘ f₂) h g = mapRange f hf (mapRange f₂ hf₂ g) :=
  ext fun _ => rfl
#align finsupp.map_range_comp Finsupp.mapRange_comp

theorem support_mapRange {f : M → N} {hf : f 0 = 0} {g : α →₀ M} :
    (mapRange f hf g).support ⊆ g.support :=
  support_onFinset_subset
#align finsupp.support_map_range Finsupp.support_mapRange

@[simp]
theorem mapRange_single {f : M → N} {hf : f 0 = 0} {a : α} {b : M} :
    mapRange f hf (single a b) = single a (f b) :=
  ext fun a' => by
    classical simpa only [single_eq_pi_single] using Pi.apply_single _ (fun _ => hf) a _ a'
#align finsupp.map_range_single Finsupp.mapRange_single

theorem support_mapRange_of_injective {e : M → N} (he0 : e 0 = 0) (f : ι →₀ M)
    (he : Function.Injective e) : (Finsupp.mapRange e he0 f).support = f.support := by
  ext
  simp only [Finsupp.mem_support_iff, Ne.def, Finsupp.mapRange_apply]
  exact he.ne_iff' he0
#align finsupp.support_map_range_of_injective Finsupp.support_mapRange_of_injective

end MapRange

/-! ### Declarations about `embDomain` -/

section EmbDomain

variable [Zero M] [Zero N]

/-- Given `f : α ↪ β` and `v : α →₀ M`, `Finsupp.embDomain f v : β →₀ M`
is the finitely supported function whose value at `f a : β` is `v a`.
For a `b : β` outside the range of `f`, it is zero. -/
def embDomain (f : α ↪ β) (v : α →₀ M) : β →₀ M where
  support := v.support.map f
  toFun a₂ :=
    haveI := Classical.decEq β
    if h : a₂ ∈ v.support.map f then
      v
        (v.support.choose (fun a₁ => f a₁ = a₂)
          (by
            rcases Finset.mem_map.1 h with ⟨a, ha, rfl⟩
            exact ExistsUnique.intro a ⟨ha, rfl⟩ fun b ⟨_, hb⟩ => f.injective hb))
    else 0
  mem_support_toFun a₂ := by
    dsimp
    split_ifs with h
    · simp only [h, true_iff_iff, Ne.def]
      rw [← not_mem_support_iff, not_not]
      classical apply Finset.choose_mem
    · simp only [h, Ne.def, ne_self_iff_false]
#align finsupp.emb_domain Finsupp.embDomain

@[simp]
theorem support_embDomain (f : α ↪ β) (v : α →₀ M) : (embDomain f v).support = v.support.map f :=
  rfl
#align finsupp.support_emb_domain Finsupp.support_embDomain

@[simp]
theorem embDomain_zero (f : α ↪ β) : (embDomain f 0 : β →₀ M) = 0 :=
  rfl
#align finsupp.emb_domain_zero Finsupp.embDomain_zero

@[simp]
theorem embDomain_apply (f : α ↪ β) (v : α →₀ M) (a : α) : embDomain f v (f a) = v a := by
  classical
    change dite _ _ _ = _
    split_ifs with h <;> rw [Finset.mem_map' f] at h
    · refine' congr_arg (v : α → M) (f.inj' _)
      exact Finset.choose_property (fun a₁ => f a₁ = f a) _ _
    · exact (not_mem_support_iff.1 h).symm
#align finsupp.emb_domain_apply Finsupp.embDomain_apply

theorem embDomain_notin_range (f : α ↪ β) (v : α →₀ M) (a : β) (h : a ∉ Set.range f) :
    embDomain f v a = 0 := by
  classical
    refine' dif_neg (mt (fun h => _) h)
    rcases Finset.mem_map.1 h with ⟨a, _h, rfl⟩
    exact Set.mem_range_self a
#align finsupp.emb_domain_notin_range Finsupp.embDomain_notin_range

theorem embDomain_injective (f : α ↪ β) : Function.Injective (embDomain f : (α →₀ M) → β →₀ M) :=
  fun l₁ l₂ h => ext fun a => by simpa only [embDomain_apply] using FunLike.ext_iff.1 h (f a)
#align finsupp.emb_domain_injective Finsupp.embDomain_injective

@[simp]
theorem embDomain_inj {f : α ↪ β} {l₁ l₂ : α →₀ M} : embDomain f l₁ = embDomain f l₂ ↔ l₁ = l₂ :=
  (embDomain_injective f).eq_iff
#align finsupp.emb_domain_inj Finsupp.embDomain_inj

@[simp]
theorem embDomain_eq_zero {f : α ↪ β} {l : α →₀ M} : embDomain f l = 0 ↔ l = 0 :=
  (embDomain_injective f).eq_iff' <| embDomain_zero f
#align finsupp.emb_domain_eq_zero Finsupp.embDomain_eq_zero

theorem embDomain_mapRange (f : α ↪ β) (g : M → N) (p : α →₀ M) (hg : g 0 = 0) :
    embDomain f (mapRange g hg p) = mapRange g hg (embDomain f p) := by
  ext a
  by_cases h : a ∈ Set.range f
  · rcases h with ⟨a', rfl⟩
    rw [mapRange_apply, embDomain_apply, embDomain_apply, mapRange_apply]
  · rw [mapRange_apply, embDomain_notin_range, embDomain_notin_range, ← hg] <;> assumption
#align finsupp.emb_domain_map_range Finsupp.embDomain_mapRange

theorem single_of_embDomain_single (l : α →₀ M) (f : α ↪ β) (a : β) (b : M) (hb : b ≠ 0)
    (h : l.embDomain f = single a b) : ∃ x, l = single x b ∧ f x = a := by
  classical
    have h_map_support : Finset.map f l.support = {a} := by
      rw [← support_embDomain, h, support_single_ne_zero _ hb]
    have ha : a ∈ Finset.map f l.support := by simp only [h_map_support, Finset.mem_singleton]
    rcases Finset.mem_map.1 ha with ⟨c, _hc₁, hc₂⟩
    use c
    constructor
    · ext d
      rw [← embDomain_apply f l, h]
      by_cases h_cases : c = d
      · simp only [Eq.symm h_cases, hc₂, single_eq_same]
      · rw [single_apply, single_apply, if_neg, if_neg h_cases]
        by_contra hfd
        exact h_cases (f.injective (hc₂.trans hfd))
    · exact hc₂
#align finsupp.single_of_emb_domain_single Finsupp.single_of_embDomain_single

@[simp]
theorem embDomain_single (f : α ↪ β) (a : α) (m : M) : embDomain f (single a m) = single (f a) m :=
  by
  classical
    ext b
    by_cases h : b ∈ Set.range f
    · rcases h with ⟨a', rfl⟩
      simp [single_apply]
    · simp only [embDomain_notin_range, h, single_apply, not_false_iff]
      rw [if_neg]
      rintro rfl
      simp at h
#align finsupp.emb_domain_single Finsupp.embDomain_single

end EmbDomain

/-! ### Declarations about `zipWith` -/

section ZipWith

variable [Zero M] [Zero N] [Zero P]

/-- Given finitely supported functions `g₁ : α →₀ M` and `g₂ : α →₀ N` and function `f : M → N → P`,
`Finsupp.zipWith f hf g₁ g₂` is the finitely supported function `α →₀ P` satisfying
`zipWith f hf g₁ g₂ a = f (g₁ a) (g₂ a)`, which is well-defined when `f 0 0 = 0`. -/
def zipWith (f : M → N → P) (hf : f 0 0 = 0) (g₁ : α →₀ M) (g₂ : α →₀ N) : α →₀ P :=
  onFinset
    (haveI := Classical.decEq α; g₁.support ∪ g₂.support)
    (fun a => f (g₁ a) (g₂ a))
    fun a (H : f _ _ ≠ 0) => by
      classical
      rw [mem_union, mem_support_iff, mem_support_iff, ← not_and_or]
      rintro ⟨h₁, h₂⟩; rw [h₁, h₂] at H; exact H hf
#align finsupp.zip_with Finsupp.zipWith

@[simp]
theorem zipWith_apply {f : M → N → P} {hf : f 0 0 = 0} {g₁ : α →₀ M} {g₂ : α →₀ N} {a : α} :
    zipWith f hf g₁ g₂ a = f (g₁ a) (g₂ a) :=
  rfl
#align finsupp.zip_with_apply Finsupp.zipWith_apply

theorem support_zipWith [D : DecidableEq α] {f : M → N → P} {hf : f 0 0 = 0} {g₁ : α →₀ M}
    {g₂ : α →₀ N} : (zipWith f hf g₁ g₂).support ⊆ g₁.support ∪ g₂.support := by
  rw [Subsingleton.elim D] <;> exact support_onFinset_subset
#align finsupp.support_zip_with Finsupp.support_zipWith

end ZipWith

/-! ### Additive monoid structure on `α →₀ M` -/

section AddZeroClass

variable [AddZeroClass M]

instance add : Add (α →₀ M) :=
  ⟨zipWith (· + ·) (add_zero 0)⟩
#align finsupp.has_add Finsupp.add

@[simp]
theorem coe_add (f g : α →₀ M) : ⇑(f + g) = f + g :=
  rfl
#align finsupp.coe_add Finsupp.coe_add

theorem add_apply (g₁ g₂ : α →₀ M) (a : α) : (g₁ + g₂) a = g₁ a + g₂ a :=
  rfl
#align finsupp.add_apply Finsupp.add_apply

theorem support_add [DecidableEq α] {g₁ g₂ : α →₀ M} :
    (g₁ + g₂).support ⊆ g₁.support ∪ g₂.support :=
  support_zipWith
#align finsupp.support_add Finsupp.support_add

theorem support_add_eq [DecidableEq α] {g₁ g₂ : α →₀ M} (h : Disjoint g₁.support g₂.support) :
    (g₁ + g₂).support = g₁.support ∪ g₂.support :=
  le_antisymm support_zipWith fun a ha =>
    (Finset.mem_union.1 ha).elim
      (fun ha => by
        have : a ∉ g₂.support := disjoint_left.1 h ha
        simp only [mem_support_iff, not_not] at *; simpa only [add_apply, this, add_zero] )
      fun ha => by
      have : a ∉ g₁.support := disjoint_right.1 h ha
      simp only [mem_support_iff, not_not] at *; simpa only [add_apply, this, zero_add]
#align finsupp.support_add_eq Finsupp.support_add_eq

@[simp]
theorem single_add (a : α) (b₁ b₂ : M) : single a (b₁ + b₂) = single a b₁ + single a b₂ :=
  ext fun a' => by
    by_cases h : a = a'
    · rw [h, add_apply, single_eq_same, single_eq_same, single_eq_same]
    · rw [add_apply, single_eq_of_ne h, single_eq_of_ne h, single_eq_of_ne h, zero_add]
#align finsupp.single_add Finsupp.single_add

instance addZeroClass : AddZeroClass (α →₀ M) :=
  FunLike.coe_injective.addZeroClass _ coe_zero coe_add
#align finsupp.add_zero_class Finsupp.addZeroClass

/-- `Finsupp.single` as an `AddMonoidHom`.

See `Finsupp.lsingle` in `LinearAlgebra/Finsupp` for the stronger version as a linear map. -/
@[simps]
def singleAddHom (a : α) : M →+ α →₀ M where
  toFun := single a
  map_zero' := single_zero a
  map_add' := single_add a
#align finsupp.single_add_hom Finsupp.singleAddHom

/-- Evaluation of a function `f : α →₀ M` at a point as an additive monoid homomorphism.

See `Finsupp.lapply` in `LinearAlgebra/Finsupp` for the stronger version as a linear map. -/
@[simps apply]
def applyAddHom (a : α) : (α →₀ M) →+ M where
  toFun g := g a
  map_zero' := zero_apply
  map_add' _ _ := add_apply _ _ _
#align finsupp.apply_add_hom Finsupp.applyAddHom
#align finsupp.apply_add_hom_apply Finsupp.applyAddHom_apply

/-- Coercion from a `Finsupp` to a function type is an `AddMonoidHom`. -/
@[simps]
noncomputable def coeFnAddHom : (α →₀ M) →+ α → M where
  toFun := (⇑)
  map_zero' := coe_zero
  map_add' := coe_add
#align finsupp.coe_fn_add_hom Finsupp.coeFnAddHom
#align finsupp.coe_fn_add_hom_apply Finsupp.coeFnAddHom_apply

theorem update_eq_single_add_erase (f : α →₀ M) (a : α) (b : M) :
    f.update a b = single a b + f.erase a := by
  classical
    ext j
    rcases eq_or_ne a j with (rfl | h)
    · simp
    · simp [Function.update_noteq h.symm, single_apply, h, erase_ne, h.symm]
#align finsupp.update_eq_single_add_erase Finsupp.update_eq_single_add_erase

theorem update_eq_erase_add_single (f : α →₀ M) (a : α) (b : M) :
    f.update a b = f.erase a + single a b := by
  classical
    ext j
    rcases eq_or_ne a j with (rfl | h)
    · simp
    · simp [Function.update_noteq h.symm, single_apply, h, erase_ne, h.symm]
#align finsupp.update_eq_erase_add_single Finsupp.update_eq_erase_add_single

theorem single_add_erase (a : α) (f : α →₀ M) : single a (f a) + f.erase a = f := by
  rw [← update_eq_single_add_erase, update_self]
#align finsupp.single_add_erase Finsupp.single_add_erase

theorem erase_add_single (a : α) (f : α →₀ M) : f.erase a + single a (f a) = f := by
  rw [← update_eq_erase_add_single, update_self]
#align finsupp.erase_add_single Finsupp.erase_add_single

@[simp]
theorem erase_add (a : α) (f f' : α →₀ M) : erase a (f + f') = erase a f + erase a f' := by
  ext s; by_cases hs : s = a
  · rw [hs, add_apply, erase_same, erase_same, erase_same, add_zero]
  rw [add_apply, erase_ne hs, erase_ne hs, erase_ne hs, add_apply]
#align finsupp.erase_add Finsupp.erase_add

/-- `Finsupp.erase` as an `AddMonoidHom`. -/
@[simps]
def eraseAddHom (a : α) : (α →₀ M) →+ α →₀ M where
  toFun := erase a
  map_zero' := erase_zero a
  map_add' := erase_add a
#align finsupp.erase_add_hom Finsupp.eraseAddHom

@[elab_as_elim]
protected theorem induction {p : (α →₀ M) → Prop} (f : α →₀ M) (h0 : p 0)
    (ha : ∀ (a b) (f : α →₀ M), a ∉ f.support → b ≠ 0 → p f → p (single a b + f)) : p f :=
  suffices ∀ (s) (f : α →₀ M), f.support = s → p f from this _ _ rfl
  fun s =>
  Finset.cons_induction_on s (fun f hf => by rwa [support_eq_empty.1 hf]) fun a s has ih f hf => by
    suffices p (single a (f a) + f.erase a) by rwa [single_add_erase] at this
    classical
      apply ha
      · rw [support_erase, mem_erase]
        exact fun H => H.1 rfl
      · rw [← mem_support_iff, hf]
        exact mem_cons_self _ _
      · apply ih _ _
        rw [support_erase, hf, Finset.erase_cons]
#align finsupp.induction Finsupp.induction

theorem induction₂ {p : (α →₀ M) → Prop} (f : α →₀ M) (h0 : p 0)
    (ha : ∀ (a b) (f : α →₀ M), a ∉ f.support → b ≠ 0 → p f → p (f + single a b)) : p f :=
  suffices ∀ (s) (f : α →₀ M), f.support = s → p f from this _ _ rfl
  fun s =>
  Finset.cons_induction_on s (fun f hf => by rwa [support_eq_empty.1 hf]) fun a s has ih f hf => by
    suffices p (f.erase a + single a (f a)) by rwa [erase_add_single] at this
    classical
      apply ha
      · rw [support_erase, mem_erase]
        exact fun H => H.1 rfl
      · rw [← mem_support_iff, hf]
        exact mem_cons_self _ _
      · apply ih _ _
        rw [support_erase, hf, Finset.erase_cons]
#align finsupp.induction₂ Finsupp.induction₂

theorem induction_linear {p : (α →₀ M) → Prop} (f : α →₀ M) (h0 : p 0)
    (hadd : ∀ f g : α →₀ M, p f → p g → p (f + g)) (hsingle : ∀ a b, p (single a b)) : p f :=
  induction₂ f h0 fun _a _b _f _ _ w => hadd _ _ w (hsingle _ _)
#align finsupp.induction_linear Finsupp.induction_linear

@[simp]
theorem add_closure_setOf_eq_single :
    AddSubmonoid.closure { f : α →₀ M | ∃ a b, f = single a b } = ⊤ :=
  top_unique fun x _hx =>
    Finsupp.induction x (AddSubmonoid.zero_mem _) fun a b _f _ha _hb hf =>
      AddSubmonoid.add_mem _ (AddSubmonoid.subset_closure <| ⟨a, b, rfl⟩) hf
#align finsupp.add_closure_set_of_eq_single Finsupp.add_closure_setOf_eq_single

/-- If two additive homomorphisms from `α →₀ M` are equal on each `single a b`,
then they are equal. -/
theorem addHom_ext [AddZeroClass N] ⦃f g : (α →₀ M) →+ N⦄
    (H : ∀ x y, f (single x y) = g (single x y)) : f = g := by
  refine' AddMonoidHom.eq_of_eqOn_denseM add_closure_setOf_eq_single _
  rintro _ ⟨x, y, rfl⟩
  apply H
#align finsupp.add_hom_ext Finsupp.addHom_ext

/-- If two additive homomorphisms from `α →₀ M` are equal on each `single a b`,
then they are equal.

We formulate this using equality of `AddMonoidHom`s so that `ext` tactic can apply a type-specific
extensionality lemma after this one.  E.g., if the fiber `M` is `ℕ` or `ℤ`, then it suffices to
verify `f (single a 1) = g (single a 1)`. -/
@[ext]
theorem addHom_ext' [AddZeroClass N] ⦃f g : (α →₀ M) →+ N⦄
    (H : ∀ x, f.comp (singleAddHom x) = g.comp (singleAddHom x)) : f = g :=
  addHom_ext fun x => FunLike.congr_fun (H x)
#align finsupp.add_hom_ext' Finsupp.addHom_ext'

theorem mulHom_ext [MulOneClass N] ⦃f g : Multiplicative (α →₀ M) →* N⦄
    (H : ∀ x y, f (Multiplicative.ofAdd <| single x y) = g (Multiplicative.ofAdd <| single x y)) :
    f = g :=
  MonoidHom.ext <|
    FunLike.congr_fun <| by
      have := @addHom_ext α M (Additive N) _ _
        (MonoidHom.toAdditive'' f) (MonoidHom.toAdditive'' g) H
      ext
      rw [FunLike.ext_iff] at this
      apply this
#align finsupp.mul_hom_ext Finsupp.mulHom_ext

@[ext]
theorem mulHom_ext' [MulOneClass N] {f g : Multiplicative (α →₀ M) →* N}
    (H : ∀ x, f.comp (AddMonoidHom.toMultiplicative (singleAddHom x)) =
              g.comp (AddMonoidHom.toMultiplicative (singleAddHom x))) :
    f = g :=
  mulHom_ext fun x => FunLike.congr_fun (H x)
#align finsupp.mul_hom_ext' Finsupp.mulHom_ext'

theorem mapRange_add [AddZeroClass N] {f : M → N} {hf : f 0 = 0}
    (hf' : ∀ x y, f (x + y) = f x + f y) (v₁ v₂ : α →₀ M) :
    mapRange f hf (v₁ + v₂) = mapRange f hf v₁ + mapRange f hf v₂ :=
  ext fun _ => by simp only [hf', add_apply, mapRange_apply]
#align finsupp.map_range_add Finsupp.mapRange_add

theorem mapRange_add' [AddZeroClass N] [AddMonoidHomClass β M N] {f : β} (v₁ v₂ : α →₀ M) :
    mapRange f (map_zero f) (v₁ + v₂) = mapRange f (map_zero f) v₁ + mapRange f (map_zero f) v₂ :=
  mapRange_add (map_add f) v₁ v₂
#align finsupp.map_range_add' Finsupp.mapRange_add'

/-- Bundle `Finsupp.embDomain f` as an additive map from `α →₀ M` to `β →₀ M`. -/
@[simps]
def embDomain.addMonoidHom (f : α ↪ β) : (α →₀ M) →+ β →₀ M where
  toFun v := embDomain f v
  map_zero' := by simp
  map_add' v w := by
    ext b
    by_cases h : b ∈ Set.range f
    · rcases h with ⟨a, rfl⟩
      simp
    · simp only [Set.mem_range, not_exists, coe_add, Pi.add_apply,
        embDomain_notin_range _ _ _ h, add_zero]
#align finsupp.emb_domain.add_monoid_hom Finsupp.embDomain.addMonoidHom

@[simp]
theorem embDomain_add (f : α ↪ β) (v w : α →₀ M) :
    embDomain f (v + w) = embDomain f v + embDomain f w :=
  (embDomain.addMonoidHom f).map_add v w
#align finsupp.emb_domain_add Finsupp.embDomain_add

end AddZeroClass

section AddMonoid

variable [AddMonoid M]

/-- Note the general `SMul` instance for `Finsupp` doesn't apply as `ℕ` is not distributive
unless `β i`'s addition is commutative. -/
instance hasNatScalar : SMul ℕ (α →₀ M) :=
  ⟨fun n v => v.mapRange ((· • ·) n) (nsmul_zero _)⟩
#align finsupp.has_nat_scalar Finsupp.hasNatScalar

instance addMonoid : AddMonoid (α →₀ M) :=
  FunLike.coe_injective.addMonoid _ coe_zero coe_add fun _ _ => rfl
#align finsupp.add_monoid Finsupp.addMonoid

end AddMonoid

instance addCommMonoid [AddCommMonoid M] : AddCommMonoid (α →₀ M) :=
  FunLike.coe_injective.addCommMonoid _ coe_zero coe_add fun _ _ => rfl
#align finsupp.add_comm_monoid Finsupp.addCommMonoid

instance neg [NegZeroClass G] : Neg (α →₀ G) :=
  ⟨mapRange Neg.neg neg_zero⟩
#align finsupp.has_neg Finsupp.neg

@[simp]
theorem coe_neg [NegZeroClass G] (g : α →₀ G) : ⇑(-g) = -g :=
  rfl
#align finsupp.coe_neg Finsupp.coe_neg

theorem neg_apply [NegZeroClass G] (g : α →₀ G) (a : α) : (-g) a = -g a :=
  rfl
#align finsupp.neg_apply Finsupp.neg_apply

theorem mapRange_neg [NegZeroClass G] [NegZeroClass H] {f : G → H} {hf : f 0 = 0}
    (hf' : ∀ x, f (-x) = -f x) (v : α →₀ G) : mapRange f hf (-v) = -mapRange f hf v :=
  ext fun _ => by simp only [hf', neg_apply, mapRange_apply]
#align finsupp.map_range_neg Finsupp.mapRange_neg

theorem mapRange_neg' [AddGroup G] [SubtractionMonoid H] [AddMonoidHomClass β G H] {f : β}
    (v : α →₀ G) : mapRange f (map_zero f) (-v) = -mapRange f (map_zero f) v :=
  mapRange_neg (map_neg f) v
#align finsupp.map_range_neg' Finsupp.mapRange_neg'

instance sub [SubNegZeroMonoid G] : Sub (α →₀ G) :=
  ⟨zipWith Sub.sub (sub_zero _)⟩
#align finsupp.has_sub Finsupp.sub

@[simp]
theorem coe_sub [SubNegZeroMonoid G] (g₁ g₂ : α →₀ G) : ⇑(g₁ - g₂) = g₁ - g₂ :=
  rfl
#align finsupp.coe_sub Finsupp.coe_sub

theorem sub_apply [SubNegZeroMonoid G] (g₁ g₂ : α →₀ G) (a : α) : (g₁ - g₂) a = g₁ a - g₂ a :=
  rfl
#align finsupp.sub_apply Finsupp.sub_apply

theorem mapRange_sub [SubNegZeroMonoid G] [SubNegZeroMonoid H] {f : G → H} {hf : f 0 = 0}
    (hf' : ∀ x y, f (x - y) = f x - f y) (v₁ v₂ : α →₀ G) :
    mapRange f hf (v₁ - v₂) = mapRange f hf v₁ - mapRange f hf v₂ :=
  ext fun _ => by simp only [hf', sub_apply, mapRange_apply]
#align finsupp.map_range_sub Finsupp.mapRange_sub

theorem mapRange_sub' [AddGroup G] [SubtractionMonoid H] [AddMonoidHomClass β G H] {f : β}
    (v₁ v₂ : α →₀ G) :
    mapRange f (map_zero f) (v₁ - v₂) = mapRange f (map_zero f) v₁ - mapRange f (map_zero f) v₂ :=
  mapRange_sub (map_sub f) v₁ v₂
#align finsupp.map_range_sub' Finsupp.mapRange_sub'

/-- Note the general `SMul` instance for `Finsupp` doesn't apply as `ℤ` is not distributive
unless `β i`'s addition is commutative. -/
instance hasIntScalar [AddGroup G] : SMul ℤ (α →₀ G) :=
  ⟨fun n v => v.mapRange ((· • ·) n) (zsmul_zero _)⟩
#align finsupp.has_int_scalar Finsupp.hasIntScalar

instance addGroup [AddGroup G] : AddGroup (α →₀ G) :=
  FunLike.coe_injective.addGroup _ coe_zero coe_add coe_neg coe_sub (fun _ _ => rfl) fun _ _ => rfl
#align finsupp.add_group Finsupp.addGroup

instance addCommGroup [AddCommGroup G] : AddCommGroup (α →₀ G) :=
  FunLike.coe_injective.addCommGroup _ coe_zero coe_add coe_neg coe_sub (fun _ _ => rfl) fun _ _ =>
    rfl
#align finsupp.add_comm_group Finsupp.addCommGroup

theorem single_add_single_eq_single_add_single [AddCommMonoid M] {k l m n : α} {u v : M}
    (hu : u ≠ 0) (hv : v ≠ 0) :
    single k u + single l v = single m u + single n v ↔
      (k = m ∧ l = n) ∨ (u = v ∧ k = n ∧ l = m) ∨ (u + v = 0 ∧ k = l ∧ m = n) := by
  classical
    simp_rw [FunLike.ext_iff, coe_add, single_eq_pi_single, ← funext_iff]
    exact Pi.single_add_single_eq_single_add_single hu hv
#align finsupp.single_add_single_eq_single_add_single Finsupp.single_add_single_eq_single_add_single

@[simp]
theorem support_neg [AddGroup G] (f : α →₀ G) : support (-f) = support f :=
  Finset.Subset.antisymm support_mapRange
    (calc
      support f = support (- -f) := congr_arg support (neg_neg _).symm
      _ ⊆ support (-f) := support_mapRange
      )
#align finsupp.support_neg Finsupp.support_neg

theorem support_sub [DecidableEq α] [AddGroup G] {f g : α →₀ G} :
    support (f - g) ⊆ support f ∪ support g := by
  rw [sub_eq_add_neg, ← support_neg g]
  exact support_add
#align finsupp.support_sub Finsupp.support_sub

theorem erase_eq_sub_single [AddGroup G] (f : α →₀ G) (a : α) : f.erase a = f - single a (f a) := by
  ext a'
  rcases eq_or_ne a a' with (rfl | h)
  · simp
  · simp [erase_ne h.symm, single_eq_of_ne h]
#align finsupp.erase_eq_sub_single Finsupp.erase_eq_sub_single

theorem update_eq_sub_add_single [AddGroup G] (f : α →₀ G) (a : α) (b : G) :
    f.update a b = f - single a (f a) + single a b := by
  rw [update_eq_erase_add_single, erase_eq_sub_single]
#align finsupp.update_eq_sub_add_single Finsupp.update_eq_sub_add_single

end Finsupp


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.prod
import data.sym.sym2

/-!
# Symmetric powers of a finset

This file defines the symmetric powers of a finset as `finset (sym α n)` and `finset (sym2 α)`.

## Main declarations

* `finset.sym`: The symmetric power of a finset. `s.sym n` is all the multisets of cardinality `n`
  whose elements are in `s`.
* `finset.sym2`: The symmetric square of a finset. `s.sym2` is all the pairs whose elements are in
  `s`.

## TODO

`finset.sym` forms a Galois connection between `finset α` and `finset (sym α n)`. Similar for
`finset.sym2`.
-/

namespace finset
variables {α : Type*} [decidable_eq α] {s t : finset α} {a b : α}

lemma is_diag_mk_of_mem_diag {a : α × α} (h : a ∈ s.diag) : sym2.is_diag ⟦a⟧ :=
(sym2.is_diag_iff_proj_eq _).2 ((mem_diag _ _).1 h).2

lemma not_is_diag_mk_of_mem_off_diag {a : α × α} (h : a ∈ s.off_diag) : ¬ sym2.is_diag ⟦a⟧ :=
by { rw sym2.is_diag_iff_proj_eq, exact ((mem_off_diag _ _).1 h).2.2 }

section sym2
variables {m : sym2 α}

/-- Lifts a finset to `sym2 α`. `s.sym2` is the finset of all pairs with elements in `s`. -/
protected def sym2 (s : finset α) : finset (sym2 α) := (s.product s).image quotient.mk

@[simp] lemma mem_sym2_iff : m ∈ s.sym2 ↔ ∀ a ∈ m, a ∈ s :=
begin
  refine mem_image.trans
    ⟨_, λ h, ⟨m.out, mem_product.2 ⟨h _ m.out_fst_mem, h _ m.out_snd_mem⟩, m.out_eq⟩⟩,
  rintro ⟨⟨a, b⟩, h, rfl⟩,
  rw sym2.ball,
  rwa mem_product at h,
end

lemma mk_mem_sym2_iff : ⟦(a, b)⟧ ∈ s.sym2 ↔ a ∈ s ∧ b ∈ s := by rw [mem_sym2_iff, sym2.ball]

@[simp] lemma sym2_empty : (∅ : finset α).sym2 = ∅ := rfl

@[simp] lemma sym2_eq_empty : s.sym2 = ∅ ↔ s = ∅ :=
by rw [finset.sym2, image_eq_empty, product_eq_empty, or_self]

@[simp] lemma sym2_nonempty : s.sym2.nonempty ↔ s.nonempty :=
by rw [finset.sym2, nonempty.image_iff, nonempty_product, and_self]

alias sym2_nonempty ↔ _ nonempty.sym2

attribute [protected] nonempty.sym2

@[simp] lemma sym2_univ [fintype α] : (univ : finset α).sym2 = univ := rfl

@[simp] lemma sym2_singleton (a : α) : ({a} : finset α).sym2 = {sym2.diag a} :=
by rw [finset.sym2, singleton_product_singleton, image_singleton, sym2.diag]

@[simp] lemma diag_mem_sym2_iff : sym2.diag a ∈ s.sym2 ↔ a ∈ s := mk_mem_sym2_iff.trans $ and_self _

@[simp] lemma sym2_mono (h : s ⊆ t) : s.sym2 ⊆ t.sym2 :=
λ m he, mem_sym2_iff.2 $ λ a ha, h $ mem_sym2_iff.1 he _ ha

lemma image_diag_union_image_off_diag :
  s.diag.image quotient.mk ∪ s.off_diag.image quotient.mk = s.sym2 :=
by { rw [←image_union, diag_union_off_diag], refl }

end sym2

section sym
variables {n : ℕ} {m : sym α n}

/-- Lifts a finset to `sym α n`. `s.sym n` is the finset of all unordered tuples of cardinality `n`
with elements in `s`. -/
protected def sym (s : finset α) : Π n, finset (sym α n)
| 0       := {∅}
| (n + 1) := s.sup $ λ a, (sym n).image $ _root_.sym.cons a

@[simp] lemma sym_zero : s.sym 0 = {∅} := rfl
@[simp] lemma sym_succ : s.sym (n + 1) = s.sup (λ a, (s.sym n).image $ sym.cons a) := rfl

@[simp] lemma mem_sym_iff : m ∈ s.sym n ↔ ∀ a ∈ m, a ∈ s :=
begin
  induction n with n ih,
  { refine mem_singleton.trans ⟨_, λ _, sym.eq_nil_of_card_zero _⟩,
    rintro rfl,
    exact λ a ha, ha.elim },
  refine mem_sup.trans  ⟨_, λ h, _⟩,
  { rintro ⟨a, ha, he⟩ b hb,
    rw mem_image at he,
    obtain ⟨m, he, rfl⟩ := he,
    rw sym.mem_cons at hb,
    obtain rfl | hb := hb,
    { exact ha },
    { exact ih.1 he _ hb } },
  { obtain ⟨a, m, rfl⟩ := m.exists_eq_cons_of_succ,
    exact ⟨a, h _ $ sym.mem_cons_self _ _,
      mem_image_of_mem _ $ ih.2 $ λ b hb, h _ $ sym.mem_cons_of_mem hb⟩ }
end

@[simp] lemma sym_empty (n : ℕ) : (∅ : finset α).sym (n + 1) = ∅ := rfl

lemma repeat_mem_sym (ha : a ∈ s) (n : ℕ) : sym.repeat a n ∈ s.sym n :=
mem_sym_iff.2 $ λ b hb, by rwa (sym.mem_repeat.1 hb).2

protected lemma nonempty.sym (h : s.nonempty) (n : ℕ) : (s.sym n).nonempty :=
let ⟨a, ha⟩ := h in ⟨_, repeat_mem_sym ha n⟩

@[simp] lemma sym_singleton (a : α) (n : ℕ) : ({a} : finset α).sym n = {sym.repeat a n} :=
eq_singleton_iff_nonempty_unique_mem.2 ⟨(singleton_nonempty _).sym n,
  λ s hs, sym.eq_repeat_iff.2 $ λ b hb, eq_of_mem_singleton $ mem_sym_iff.1 hs _ hb⟩

lemma eq_empty_of_sym_eq_empty (h : s.sym n = ∅) : s = ∅ :=
begin
  rw ←not_nonempty_iff_eq_empty at ⊢ h,
  exact λ hs, h (hs.sym _),
end

@[simp] lemma sym_eq_empty : s.sym n = ∅ ↔ n ≠ 0 ∧ s = ∅ :=
begin
  cases n,
  { exact iff_of_false (singleton_ne_empty _) (λ h, (h.1 rfl).elim) },
  { refine ⟨λ h, ⟨n.succ_ne_zero, eq_empty_of_sym_eq_empty h⟩, _⟩,
    rintro ⟨_, rfl⟩,
    exact sym_empty _ }
end

@[simp] lemma sym_nonempty : (s.sym n).nonempty ↔ n = 0 ∨ s.nonempty :=
by simp_rw [nonempty_iff_ne_empty, ne.def, sym_eq_empty, not_and_distrib, not_ne_iff]

alias sym2_nonempty ↔ _ nonempty.sym2

attribute [protected] nonempty.sym2

@[simp] lemma sym_univ [fintype α] (n : ℕ) : (univ : finset α).sym n = univ :=
eq_univ_iff_forall.2 $ λ s, mem_sym_iff.2 $ λ a _, mem_univ _

@[simp] lemma sym_mono (h : s ⊆ t) (n : ℕ): s.sym n ⊆ t.sym n :=
λ m hm, mem_sym_iff.2 $ λ a ha, h $ mem_sym_iff.1 hm _ ha

@[simp] lemma sym_inter (s t : finset α) (n : ℕ) : (s ∩ t).sym n = s.sym n ∩ t.sym n :=
by { ext m, simp only [mem_inter, mem_sym_iff, imp_and_distrib, forall_and_distrib] }

@[simp] lemma sym_union (s t : finset α) (n : ℕ) : s.sym n ∪ t.sym n ⊆ (s ∪ t).sym n :=
union_subset (sym_mono (subset_union_left s t) n) (sym_mono (subset_union_right s t) n)

end sym
end finset