/-
Released under Apache 2.0 license as described in the file LICENSE.
Author: Peter Jipsen
Names based on http://math.chapman.edu/~jipsen/structures/doku.php
-/

import init.logic init.algebra.classes
universe u
set_option default_priority 100
set_option old_structure_cmd true

variables {α: Type u}(f:α→α → α)
--local infix  ⊕  := f

--Magmas (= binars = groupoids)

class Mag(α:Type u) := (o:α→α → α)
infix ⬝ := Mag.o

--variables {α :Type u}
variables [Mag α ] --(a b : α)
variables a b : α

#check Mag.o a b

--Semigroups
class Sgrp(α:Type u) extends Mag α := (asso: ∀x y z: α, x⬝y⬝z = x⬝(y⬝z))

@[simp] lemma assoc [Sgrp α]: ∀x y z:α, x⬝y⬝z = x⬝(y⬝z) := Sgrp.asso
instance Sgrp_to_is_associative [Sgrp α] : is_associative α (⬝) := ⟨assoc⟩

#check Sgrp_to_is_associative

--Commutative semigroups
class CSgrp(α: Type u) extends Sgrp α := (comm: ∀x y:α, x⬝y = y⬝x)

@[simp] lemma comm [CSgrp α]: ∀x y:α, x⬝y = y⬝x := CSgrp.comm
instance CSgrp_to_is_commutative [CSgrp α] : is_commutative α (⬝) := ⟨comm⟩

--Bands (= idempotent semigroups)
class Band(α:Type u) extends Sgrp α := (idem: ∀ x:α, x⬝x = x)

--Semilattices
class Slat(α:Type u) extends Band α :=
(comm: ∀x y:α, x⬝y = y⬝x)
-- use coersion to tell Lean that every Slat is an idempotent CSgrp

--Double magmas
class DMag(α:Type u) := (o₁:α→α → α)(o₂:α→α → α)
local infix ∧ :65 := DMag.o₁
local infix ∨ :65 := DMag.o₂

--Lattices
class Lat(α:Type u) extends DMag α:=
(asso₁: ∀x y z: α, (x∧y)∧z = x∧(y∧z))(asso₂: ∀x y z: α, (x∨y)∨z = x∨(y∨z))
(comm₁: ∀x y:α, x∧y = y∧x)           (comm₂: ∀x y:α, x∨y = y∨x)
(abso₁: ∀x y:α, (x∧y)∨x = x)         (abso₂: ∀x y:α, (x∨y)∧x = x)

--Monoids
class Mon(α:Type u) extends Sgrp α := (e:α)
(l_id: ∀x:α, e⬝x = x) (r_id: ∀x:α, x⬝e = x)

--Commutative monoids
class CMon(α:Type u) extends Sgrp α := (e:α)
(l_id: ∀x:α, e⬝x = x)
(comm: ∀x y:α, x⬝y = y⬝x)

--Magmas with unary operation
class Mag₁(α:Type u) extends Mag α := (i:α → α)
postfix ⁻¹ := Mag₁.i

--Commutative magmas
class CMag(α:Type u) := (p:α→α → α)
(comm: ∀x y:α, p x y = p y x)
local infix ⊕ :65 := CMag.p

--Commutative magmas with unary operation
class CMag₁(α:Type u) extends CMag α := (n:α → α)(d:α)
prefix ¬   := CMag₁.n

--MV-algebras
class MValg(α:Type u) extends CMag₁ α :=
(dneg: ∀x:α, ¬¬x = x)
(l_id: ∀x:α, x⊕d = x)
(meet: ∀x y:α, ¬(¬x⊕y)⊕y = ¬(¬y⊕x)⊕x)
#print MValg

--Groups
class Grp(α:Type u) extends Mag₁ α := (e:α)
(asso:  ∀x y z: α, x⬝y⬝z = x⬝(y⬝z))
(l_id:  ∀x:α, e⬝x = x)
(l_inv: ∀x:α, x⁻¹⬝x = e)

-- Some small models

inductive M₂: Type | e:M₂ | a:M₂
export M₂ (e a)
namespace M₂            -- 2-elt idempotent monoid
  def cdot:  M₂→M₂ → M₂ | e x := x  | x e := x | a a := a
  instance: Mag M₂ := ⟨cdot⟩
#check Mag.o
  lemma asso (x y z:M₂): (x⬝y)⬝z = x⬝(y⬝z) :=  by cases x; cases y; cases z; refl
  instance: Sgrp M₂ := ⟨(⬝), asso⟩
  lemma idem (x:M₂): x⬝x = x := by cases x; refl
  instance: Band M₂ := ⟨(⬝), asso, idem⟩
  lemma comm (x y:M₂): x⬝y = y⬝x :=  by cases x; cases y; refl
  instance: Slat M₂ := ⟨(⬝), asso, idem, comm⟩
  lemma l_id (x:M₂): e⬝x = x := by cases x; refl
  lemma r_id (x:M₂): x⬝e = x := by cases x; refl
  instance: Mon M₂ := ⟨(⬝), asso, e, l_id, r_id⟩

#check M₂
variables c d : M₂
#reduce M₂.cdot M₂.a M₂.a
#print classes
end M₂

inductive Z₃: Type | e:Z₃ | a:Z₃ | b:Z₃
export Z₃ (e a b)
namespace Z₃            -- 3-elt group
  def cdot:  Z₃→Z₃ → Z₃ | e x := x | x e := x
                        | a a := b | a b := e
                        | b a := e | b b := a
  def inv:  Z₃→ Z₃ | e := e | a := b | b := a
  instance: Mag₁ Z₃ := ⟨cdot, inv⟩
  lemma asso (x y z:Z₃): (x⬝y)⬝z = x⬝(y⬝z) :=  by cases x; cases y; cases z; refl
  lemma l_id (x:Z₃): e⬝x = x := by cases x; refl
  lemma l_inv (x:Z₃): x⁻¹⬝x = e := by cases x; refl
  instance: Grp Z₃ := ⟨(⬝), inv, e, asso, l_id, l_inv⟩
end Z₃

variable x:int

/-
variables (f g o:α→α → α)(h k:α → α)(d e:α)(R S:α→α → Prop)
local infix `⬝`:70  := o
local notation x+y := f x y
local notation x⊕y := g x y
local notation x\y := f x y
local notation x/y := g x y
local notation x⁻¹ := h x
local notation ¬x  := h x
local notation 1   := e
local notation 0   := d
local notation x≤y := R x y
local infix `≺`:50 := R

def involutive            := ∀x,     h(h x) = x
def inverse_ops           := ∀x,     h(k x) = x
def l_unary_absorption    := ∀x,     h(k x) = k x
def r_unary_absorption    := ∀x,     h(k x) = h x
def unary_idempotent      := ∀x,     h(h x) = h x
def idempotent            := ∀x,     x⬝x = x
def l_identity            := ∀x,     1⬝x = x
def r_identity            := ∀x,     x⬝1 = x
def l_zero                := ∀x,     0⬝x = 0
def r_zero                := ∀x,     x⬝0 = 0
def l_inverse             := ∀x,     x⁻¹⬝x = 1
def r_inverse             := ∀x,     x⬝x⁻¹ = 1
def l_const_mult          := ∀x,     c⬝x = h x
def r_const_mult          := ∀x,     x⬝c = h x
def square_constant       := ∀x,     x⬝x = c
def square_unary          := ∀x,     x⬝x = h x
def l_unary_identity      := ∀x,     (h x)⬝x = x
def r_unary_identity      := ∀x,     x⬝(h x) = x
def l_unary_const_mult    := ∀x,     h(c⬝x) = c⬝(h x)
def r_unary_const_mult    := ∀x,     h(x⬝c) = (h x)⬝c

--def commutative           := ∀x y,   x⬝y = y⬝x  defined in logic.lean
def l_unary_projection    := ∀x y,   x⬝y = h x
def r_unary_projection    := ∀x y,   x⬝y = h y
def l_idempotent          := ∀x y,   x⬝(x⬝y) = x⬝y
def r_idempotent          := ∀x y,   (x⬝y)⬝y = x⬝y
def l_idempotent'         := ∀x y,   x⬝(y⬝x) = x⬝y
def r_idempotent'         := ∀x y,   (x⬝y)⬝x = x⬝y
def l_rectangular         := ∀x y,   (x⬝y)⬝x = x
def r_rectangular         := ∀x y,   x⬝(y⬝x) = x
def absorption            := ∀x y,   (x⬝y)+x = x
def absorption'           := ∀x y,   x+(y⬝x) = x
def l_division            := ∀x y,   x⬝(x\y) = y
def r_division            := ∀x y,   (x/y)⬝y = x
def l_division'           := ∀x y,   x\(x⬝y) = y
def r_division'           := ∀x y,   (x⬝y)/y = x
def unary_commutative     := ∀x y,   (h x)⬝(h y) = (h y)⬝(h x)
def unary_involutive      := ∀x y,   h(x⬝y) = (h y)⬝(h x)
def interdistributive     := ∀x y,   h(x⬝y) = (h x)+(h y)
def unary_distributive    := ∀x y,   h(x⬝y) = (h x)⬝(h y)
def l_twisted             := ∀x y,   (h(x⬝y))⬝x = x⬝(h y)
def r_twisted             := ∀x y,   x⬝(h(y⬝x)) = (h y)⬝x
def l_locality            := ∀x y,   h((h x)⬝y) = h(x⬝y)
def r_locality            := ∀x y,   h(x⬝(h y)) = h(x⬝y)
def l_unary_distributive  := ∀x y,   h((h x)⬝y) = (h x)⬝(h y)
def r_unary_distributive  := ∀x y,   h(x⬝(h y)) = (h x)⬝(h y)
def l_absorbtive          := ∀x y,   (h x)⬝(h(x⬝y)) = h(x⬝y)
def r_absorbtive          := ∀x y,   (h(x⬝y))⬝(h y) = h(x⬝y)
def flexible              := ∀x y,   (x⬝y)⬝x = x⬝(y⬝x)

--def associative           := ∀x y z, x⬝(y⬝z) = (x⬝y)⬝z  defined in logic.lean
def l_commutative         := ∀x y z, x⬝(y⬝z) = y⬝(x⬝z)
def r_commutative         := ∀x y z, (x⬝y)⬝z = (x⬝z)⬝y
def interassociative1     := ∀x y z, x⬝(y+z) = (x⬝y)+z
def interassociative2     := ∀x y z, x⬝(y+z) = (x+y)⬝z
def l_distributive        := ∀x y z, x⬝(y+z) = (x⬝y)+(x⬝z)
def r_distributive        := ∀x y z, (x+y)⬝z = (x⬝z)+(y⬝z)
def l_self_distributive   := ∀x y z, x⬝(y⬝z) = (x⬝y)⬝(x⬝z)
def r_self_distributive   := ∀x y z, (x⬝y)⬝z = (x⬝z)⬝(y⬝z)
def directoid_absorption  := ∀x y z, x⬝((x⬝y)⬝z) = (x⬝y)⬝z
def directoid_absorbtion' := ∀x y z, (x⬝(y⬝z))⬝z = x⬝(y⬝z)
def Moufang1              := ∀x y z, ((x⬝y)⬝x)⬝z = x⬝(y⬝(x⬝z))
def Moufang2              := ∀x y z, ((x⬝y)⬝z)⬝y = x⬝(y⬝(z⬝y))
def Moufang3              := ∀x y z, (x⬝y)⬝(z⬝x) = (x⬝(y⬝z))⬝x
def Moufang4              := ∀x y z, (x⬝y)⬝(z⬝x) = x⬝((y⬝z)⬝x)
def l_cancelative         := ∀x y z, x⬝y = x⬝z → y = z
def r_cancelative         := ∀x y z, x⬝y = z⬝y → x = z
-/


import tactic

def injective {X Y} (f : X → Y) := ∀ x₁ x₂, f x₁ = f x₂ → x₁ = x₂

def range {X Y} (f : X → Y) := { y | ∃ x, f x = y }

theorem comp_inj_is_inj
{X Y Z} (f : X → Y) (g : Y → Z)
(p1 : injective f)
(p2 : injective g)
:  injective (g ∘ f)
:= begin
  introv x p3,
  change g (f x) = g (f x₂) at p3,
  apply p1,
  apply p2,
  apply p3,
end

lemma succ_greater_than_nat (n : ℕ) : nat.succ n > n
:=
begin
  rw nat.succ_eq_add_one,
  linarith
end

lemma pred_exists (n : ℕ) (p: n > 0) : exists k, nat.succ k = n
:=
begin
induction n with d hd,
{linarith,},
{
    existsi d,
  refl
}
end

-- forgot library function, lifted from square root prime code
-- credit to github user dm1237
lemma succ_eq_add_one (n : ℕ) : nat.succ n = n + 1 :=
begin
    exact rfl,
end

-- forgot library function
lemma my_le_trans
(j k m : ℕ)
(p1: k < m)
(p2: j < k)
: j < m - 1
:=
begin
sorry
end

-- I'm not gonna waste time proving this
lemma inequality_fact
(j m : ℕ)
(p: j < m)
: j - 1 < m - 1
:= begin
sorry
end

/--
Type of pairs (k,p) where k
is a natural number and p is a witness to the proof that k < n.
-/
def finite_subset (n : ℕ) := Σ' k, k < n

/--
Every pair that lives in finite_subest m lives in finite_subset n
where m < n
-/
def lift_finite (m n : ℕ) (p : m < n) : finite_subset m → finite_subset n
    := λ k, ⟨k.1, lt.trans k.2 p⟩

/--
Application of lift_finite from m to m + 1
-/
def lift_one
(m : ℕ)
: finite_subset m → finite_subset (m + 1)
:= (lift_finite m (m+1) (succ_greater_than_nat m))

/--
The lifting function is injective
-/
theorem lift_finite_injective (m n : ℕ) (p : m < n) : injective (lift_finite m n p)
:= begin

/- pf sketch

--  suppose f x1 = f x2 = < k, pf: k < n >

--  we know x1 = < l , pf: k < m > and x2 = < j , pf: j < m >

--  note that (f x1).1 = (f x2).1 = k

--  furthermore, k < m < n

--  then x1 = < k, pf: k < m > = x2

--  done
-/

introv x p2,
cases x,
cases x₂,
cases p2,
refl,
end

/--
The lifting from m to m + 1 injective
-/
lemma lift_one_injective (m : ℕ)
: injective (lift_one m)
:= begin
apply lift_finite_injective m (m + 1) (succ_greater_than_nat m),
end

-- warning, sort of janky
-- ie, don't use if we don't miss k in the codomain
-- it's not injective by itself
-- but relabel k ∘ f ∘ lift IS injective
-- because f ∘ lift misses k
def relabel
(m k : ℕ)
(p: k < m)
: finite_subset m → finite_subset (m - 1)
:= λ j, if H : j.1 < k then ⟨j.1, my_le_trans j.1 k m p H ⟩ else ⟨j.1 - 1, inequality_fact j.1 m j.2⟩

/-
This formalizes the notion that when f is injective and misses k
in the codomain then when we relabel to bring m to m - 1,
composition is injective
-/
lemma relabel_with_inj_f_misses_k_is_inj
(m k : ℕ)
(p: k < m)
(f: finite_subset m → finite_subset m)
(inj: injective f)
: injective ((relabel m k p) ∘ f)
:=
begin
sorry
end

/--
Pigeonhole principle, induction on n
-/
theorem pigeonhole_principle
    (n m : ℕ)
    (f : finite_subset n → finite_subset m)
: (n > m) → ¬(injective f)
:= begin

  intros n_gt_m f_injective,
  induction n with d hd,
  { linarith, /- case d = 0 -/ },

  let g := f ∘ (lift_one d),
  let hd' := hd g,

  rcases lt_or_eq_of_le (nat.lt_succ_iff.1 n_gt_m) with h | rfl,

  {   /- case where d > m -/
      /- prove injective g -/
    apply hd' h,
    let g_injective := comp_inj_is_inj (lift_one d) f (lift_one_injective d) f_injective,
    exact g_injective,
  },

  {   /- case where d = m -/
      /- prove f : finite_subset (nat.succ m) → finite_subset m is not injective -/

    induction m with l hl,

    {sorry,}, -- need to recall the proof we gave before

    let k := f ⟨l + 1, succ_greater_than_nat (l + 1)⟩, -- let k = f(l + 1)
    let violator := f ∘ (lift_one (l + 1)),
    let restriction := (relabel (l + 1) k.1 k.2) ∘ violator,
    let violator_is_inj := comp_inj_is_inj (lift_one (l + 1)) f (lift_one_injective (l + 1)) f_injective,
    let res_is_inj := relabel_with_inj_f_misses_k_is_inj (l + 1) k.1 k.2 violator violator_is_inj,
    /- contradiction, since restriction: [m] →  [m - 1] is injective,
     but this can't be true IH
     -/

    sorry
  }

end

#print pigeonhole_principle


/-
Copyright (c) 2022 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/

import group_theory.complement
import group_theory.group_action.basic
import group_theory.index

/-!
# The Transfer Homomorphism

In this file we construct the transfer homomorphism.

## Main definitions

- `diff ϕ S T` : The difference of two left transversals `S` and `T` under the homomorphism `ϕ`.
- `transfer ϕ` : The transfer homomorphism induced by `ϕ`.
-/

open_locale big_operators

variables {G : Type*} [group G] {H : subgroup G} {A : Type*} [comm_group A] (ϕ : H →* A)

namespace subgroup

namespace left_transversals

open finset mul_action

open_locale pointwise

variables (R S T : left_transversals (H : set G)) [fintype (G ⧸ H)]

/-- The difference of two left transversals -/
@[to_additive "The difference of two left transversals"]
noncomputable def diff : A :=
let α := mem_left_transversals.to_equiv S.2, β := mem_left_transversals.to_equiv T.2 in
∏ q, ϕ ⟨(α q)⁻¹ * β q, quotient_group.left_rel_apply.mp $
  quotient.exact' ((α.symm_apply_apply q).trans (β.symm_apply_apply q).symm)⟩

@[to_additive] lemma diff_mul_diff : diff ϕ R S * diff ϕ S T = diff ϕ R T :=
prod_mul_distrib.symm.trans (prod_congr rfl (λ q hq, (ϕ.map_mul _ _).symm.trans (congr_arg ϕ
  (by simp_rw [subtype.ext_iff, coe_mul, coe_mk, mul_assoc, mul_inv_cancel_left]))))

@[to_additive] lemma diff_self : diff ϕ T T = 1 :=
mul_right_eq_self.mp (diff_mul_diff ϕ T T T)

@[to_additive] lemma diff_inv : (diff ϕ S T)⁻¹ = diff ϕ T S :=
inv_eq_of_mul_eq_one_right $ (diff_mul_diff ϕ S T S).trans $ diff_self ϕ S

@[to_additive] lemma smul_diff_smul (g : G) : diff ϕ (g • S) (g • T) = diff ϕ S T :=
prod_bij' (λ q _, g⁻¹ • q) (λ _ _, mem_univ _) (λ _ _, congr_arg ϕ (by simp_rw [coe_mk,
  smul_apply_eq_smul_apply_inv_smul, smul_eq_mul, mul_inv_rev, mul_assoc, inv_mul_cancel_left]))
  (λ q _, g • q) (λ _ _, mem_univ _) (λ q _, smul_inv_smul g q) (λ q _, inv_smul_smul g q)

end left_transversals

end subgroup

namespace monoid_hom

variables [fintype (G ⧸ H)]

open subgroup subgroup.left_transversals

/-- Given `ϕ : H →* A` from `H : subgroup G` to a commutative group `A`,
the transfer homomorphism is `transfer ϕ : G →* A`. -/
@[to_additive "Given `ϕ : H →+ A` from `H : add_subgroup G` to an additive commutative group `A`,
the transfer homomorphism is `transfer ϕ : G →+ A`."]
noncomputable def transfer : G →* A :=
let T : left_transversals (H : set G) := inhabited.default in
{ to_fun := λ g, diff ϕ T (g • T),
  map_one' := by rw [one_smul, diff_self],
  map_mul' := λ g h, by rw [mul_smul, ←diff_mul_diff, smul_diff_smul] }

variables (T : left_transversals (H : set G))

@[to_additive] lemma transfer_def (g : G) : transfer ϕ g = diff ϕ T (g • T) :=
by rw [transfer, ←diff_mul_diff, ←smul_diff_smul, mul_comm, diff_mul_diff]; refl

end monoid_hom


/-
Copyright (c) 2022 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/

import group_theory.complement
import group_theory.group_action.basic
import group_theory.index

/-!
# The Transfer Homomorphism

In this file we construct the transfer homomorphism.

## Main definitions

- `diff ϕ S T` : The difference of two left transversals `S` and `T` under the homomorphism `ϕ`.
- `transfer ϕ` : The transfer homomorphism induced by `ϕ`.
-/

open_locale big_operators

variables {G : Type*} [group G] {H : subgroup G} {A : Type*} [comm_group A] (ϕ : H →* A)

namespace subgroup

namespace left_transversals

open finset mul_action

open_locale pointwise

variables (R S T : left_transversals (H : set G)) [fintype (G ⧸ H)]

/-- The difference of two left transversals -/
@[to_additive "The difference of two left transversals"]
noncomputable def diff : A :=
let α := mem_left_transversals.to_equiv S.2, β := mem_left_transversals.to_equiv T.2 in
∏ q, ϕ ⟨(α q)⁻¹ * β q, quotient.exact' ((α.symm_apply_apply q).trans (β.symm_apply_apply q).symm)⟩

@[to_additive] lemma diff_mul_diff : diff ϕ R S * diff ϕ S T = diff ϕ R T :=
prod_mul_distrib.symm.trans (prod_congr rfl (λ q hq, (ϕ.map_mul _ _).symm.trans (congr_arg ϕ
  (by simp_rw [subtype.ext_iff, coe_mul, coe_mk, mul_assoc, mul_inv_cancel_left]))))

@[to_additive] lemma diff_self : diff ϕ T T = 1 :=
mul_right_eq_self.mp (diff_mul_diff ϕ T T T)

@[to_additive] lemma diff_inv : (diff ϕ S T)⁻¹ = diff ϕ T S :=
inv_eq_of_mul_eq_one_right $ (diff_mul_diff ϕ S T S).trans $ diff_self ϕ S

@[to_additive] lemma smul_diff_smul (g : G) : diff ϕ (g • S) (g • T) = diff ϕ S T :=
prod_bij' (λ q _, g⁻¹ • q) (λ _ _, mem_univ _) (λ _ _, congr_arg ϕ (by simp_rw [coe_mk,
  smul_apply_eq_smul_apply_inv_smul, smul_eq_mul, mul_inv_rev, mul_assoc, inv_mul_cancel_left]))
  (λ q _, g • q) (λ _ _, mem_univ _) (λ q _, smul_inv_smul g q) (λ q _, inv_smul_smul g q)

end left_transversals

end subgroup

namespace monoid_hom

variables [fintype (G ⧸ H)]

open subgroup subgroup.left_transversals

/-- Given `ϕ : H →* A` from `H : subgroup G` to a commutative group `A`,
the transfer homomorphism is `transfer ϕ : G →* A`. -/
@[to_additive "Given `ϕ : H →+ A` from `H : add_subgroup G` to an additive commutative group `A`,
the transfer homomorphism is `transfer ϕ : G →+ A`."]
noncomputable def transfer : G →* A :=
let T : left_transversals (H : set G) := inhabited.default in
{ to_fun := λ g, diff ϕ T (g • T),
  map_one' := by rw [one_smul, diff_self],
  map_mul' := λ g h, by rw [mul_smul, ←diff_mul_diff, smul_diff_smul] }

variables (T : left_transversals (H : set G))

@[to_additive] lemma transfer_def (g : G) : transfer ϕ g = diff ϕ T (g • T) :=
by rw [transfer, ←diff_mul_diff, ←smul_diff_smul, mul_comm, diff_mul_diff]; refl

end monoid_hom


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module topology.metric_space.antilipschitz
! leanprover-community/mathlib commit 97f079b7e89566de3a1143f887713667328c38ba
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.MetricSpace.Lipschitz
import Mathlib.Topology.UniformSpace.CompleteSeparated

/-!
# Antilipschitz functions

We say that a map `f : α → β` between two (extended) metric spaces is
`AntilipschitzWith K`, `K ≥ 0`, if for all `x, y` we have `edist x y ≤ K * edist (f x) (f y)`.
For a metric space, the latter inequality is equivalent to `dist x y ≤ K * dist (f x) (f y)`.

## Implementation notes

The parameter `K` has type `ℝ≥0`. This way we avoid conjuction in the definition and have
coercions both to `ℝ` and `ℝ≥0∞`. We do not require `0 < K` in the definition, mostly because
we do not have a `posreal` type.
-/

variable {α β γ : Type _}

open scoped NNReal ENNReal Uniformity Topology
open Set Filter Bornology

/-- We say that `f : α → β` is `AntilipschitzWith K` if for any two points `x`, `y` we have
`edist x y ≤ K * edist (f x) (f y)`. -/
def AntilipschitzWith [PseudoEMetricSpace α] [PseudoEMetricSpace β] (K : ℝ≥0) (f : α → β) :=
  ∀ x y, edist x y ≤ K * edist (f x) (f y)
#align antilipschitz_with AntilipschitzWith

theorem AntilipschitzWith.edist_lt_top [PseudoEMetricSpace α] [PseudoMetricSpace β] {K : ℝ≥0}
    {f : α → β} (h : AntilipschitzWith K f) (x y : α) : edist x y < ⊤ :=
  (h x y).trans_lt <| ENNReal.mul_lt_top ENNReal.coe_ne_top (edist_ne_top _ _)
#align antilipschitz_with.edist_lt_top AntilipschitzWith.edist_lt_top

theorem AntilipschitzWith.edist_ne_top [PseudoEMetricSpace α] [PseudoMetricSpace β] {K : ℝ≥0}
    {f : α → β} (h : AntilipschitzWith K f) (x y : α) : edist x y ≠ ⊤ :=
  (h.edist_lt_top x y).ne
#align antilipschitz_with.edist_ne_top AntilipschitzWith.edist_ne_top

section Metric

variable [PseudoMetricSpace α] [PseudoMetricSpace β] {K : ℝ≥0} {f : α → β}

theorem antilipschitzWith_iff_le_mul_nndist :
    AntilipschitzWith K f ↔ ∀ x y, nndist x y ≤ K * nndist (f x) (f y) := by
  simp only [AntilipschitzWith, edist_nndist]
  norm_cast
#align antilipschitz_with_iff_le_mul_nndist antilipschitzWith_iff_le_mul_nndist

alias antilipschitzWith_iff_le_mul_nndist ↔
  AntilipschitzWith.le_mul_nndist AntilipschitzWith.of_le_mul_nndist
#align antilipschitz_with.le_mul_nndist AntilipschitzWith.le_mul_nndist
#align antilipschitz_with.of_le_mul_nndist AntilipschitzWith.of_le_mul_nndist

theorem antilipschitzWith_iff_le_mul_dist :
    AntilipschitzWith K f ↔ ∀ x y, dist x y ≤ K * dist (f x) (f y) := by
  simp only [antilipschitzWith_iff_le_mul_nndist, dist_nndist]
  norm_cast
#align antilipschitz_with_iff_le_mul_dist antilipschitzWith_iff_le_mul_dist

alias antilipschitzWith_iff_le_mul_dist ↔
  AntilipschitzWith.le_mul_dist AntilipschitzWith.of_le_mul_dist
#align antilipschitz_with.le_mul_dist AntilipschitzWith.le_mul_dist
#align antilipschitz_with.of_le_mul_dist AntilipschitzWith.of_le_mul_dist

namespace AntilipschitzWith

theorem mul_le_nndist (hf : AntilipschitzWith K f) (x y : α) :
    K⁻¹ * nndist x y ≤ nndist (f x) (f y) := by
  simpa only [div_eq_inv_mul] using NNReal.div_le_of_le_mul' (hf.le_mul_nndist x y)
#align antilipschitz_with.mul_le_nndist AntilipschitzWith.mul_le_nndist

theorem mul_le_dist (hf : AntilipschitzWith K f) (x y : α) :
    (K⁻¹ * dist x y : ℝ) ≤ dist (f x) (f y) := by exact_mod_cast hf.mul_le_nndist x y
#align antilipschitz_with.mul_le_dist AntilipschitzWith.mul_le_dist

end AntilipschitzWith

end Metric

namespace AntilipschitzWith

variable [PseudoEMetricSpace α] [PseudoEMetricSpace β] [PseudoEMetricSpace γ]

variable {K : ℝ≥0} {f : α → β}

open EMetric

-- uses neither `f` nor `hf`
/-- Extract the constant from `hf : AntilipschitzWith K f`. This is useful, e.g.,
if `K` is given by a long formula, and we want to reuse this value. -/
@[nolint unusedArguments]
protected def k (_hf : AntilipschitzWith K f) : ℝ≥0 := K
set_option linter.uppercaseLean3 false in
#align antilipschitz_with.K AntilipschitzWith.k

protected theorem injective {α : Type _} {β : Type _} [EMetricSpace α] [PseudoEMetricSpace β]
    {K : ℝ≥0} {f : α → β} (hf : AntilipschitzWith K f) : Function.Injective f := fun x y h => by
  simpa only [h, edist_self, mul_zero, edist_le_zero] using hf x y
#align antilipschitz_with.injective AntilipschitzWith.injective

theorem mul_le_edist (hf : AntilipschitzWith K f) (x y : α) :
    (K : ℝ≥0∞)⁻¹ * edist x y ≤ edist (f x) (f y) := by
  rw [mul_comm, ← div_eq_mul_inv]
  exact ENNReal.div_le_of_le_mul' (hf x y)
#align antilipschitz_with.mul_le_edist AntilipschitzWith.mul_le_edist

theorem ediam_preimage_le (hf : AntilipschitzWith K f) (s : Set β) : diam (f ⁻¹' s) ≤ K * diam s :=
  diam_le fun x hx y hy => (hf x y).trans <|
    mul_le_mul_left' (edist_le_diam_of_mem (mem_preimage.1 hx) hy) K
#align antilipschitz_with.ediam_preimage_le AntilipschitzWith.ediam_preimage_le

theorem le_mul_ediam_image (hf : AntilipschitzWith K f) (s : Set α) : diam s ≤ K * diam (f '' s) :=
  (diam_mono (subset_preimage_image _ _)).trans (hf.ediam_preimage_le (f '' s))
#align antilipschitz_with.le_mul_ediam_image AntilipschitzWith.le_mul_ediam_image

protected theorem id : AntilipschitzWith 1 (id : α → α) := fun x y => by
  simp only [ENNReal.coe_one, one_mul, id, le_refl]
#align antilipschitz_with.id AntilipschitzWith.id

theorem comp {Kg : ℝ≥0} {g : β → γ} (hg : AntilipschitzWith Kg g) {Kf : ℝ≥0} {f : α → β}
    (hf : AntilipschitzWith Kf f) : AntilipschitzWith (Kf * Kg) (g ∘ f) := fun x y =>
  calc
    edist x y ≤ Kf * edist (f x) (f y) := hf x y
    _ ≤ Kf * (Kg * edist (g (f x)) (g (f y))) := (ENNReal.mul_left_mono (hg _ _))
    _ = _ := by rw [ENNReal.coe_mul, mul_assoc]; rfl
#align antilipschitz_with.comp AntilipschitzWith.comp

theorem restrict (hf : AntilipschitzWith K f) (s : Set α) : AntilipschitzWith K (s.restrict f) :=
  fun x y => hf x y
#align antilipschitz_with.restrict AntilipschitzWith.restrict

theorem codRestrict (hf : AntilipschitzWith K f) {s : Set β} (hs : ∀ x, f x ∈ s) :
    AntilipschitzWith K (s.codRestrict f hs) := fun x y => hf x y
#align antilipschitz_with.cod_restrict AntilipschitzWith.codRestrict

theorem to_right_inv_on' {s : Set α} (hf : AntilipschitzWith K (s.restrict f)) {g : β → α}
    {t : Set β} (g_maps : MapsTo g t s) (g_inv : RightInvOn g f t) :
    LipschitzWith K (t.restrict g) := fun x y => by
  simpa only [restrict_apply, g_inv x.mem, g_inv y.mem, Subtype.edist_eq, Subtype.coe_mk] using
    hf ⟨g x, g_maps x.mem⟩ ⟨g y, g_maps y.mem⟩
#align antilipschitz_with.to_right_inv_on' AntilipschitzWith.to_right_inv_on'

theorem to_rightInvOn (hf : AntilipschitzWith K f) {g : β → α} {t : Set β} (h : RightInvOn g f t) :
    LipschitzWith K (t.restrict g) :=
  (hf.restrict univ).to_right_inv_on' (mapsTo_univ g t) h
#align antilipschitz_with.to_right_inv_on AntilipschitzWith.to_rightInvOn

theorem to_rightInverse (hf : AntilipschitzWith K f) {g : β → α} (hg : Function.RightInverse g f) :
    LipschitzWith K g := by
  intro x y
  have := hf (g x) (g y)
  rwa [hg x, hg y] at this
#align antilipschitz_with.to_right_inverse AntilipschitzWith.to_rightInverse

theorem comap_uniformity_le (hf : AntilipschitzWith K f) : (𝓤 β).comap (Prod.map f f) ≤ 𝓤 α := by
  refine ((uniformity_basis_edist.comap _).le_basis_iff uniformity_basis_edist).2 fun ε h₀ => ?_
  refine ⟨(↑K)⁻¹ * ε, ENNReal.mul_pos (ENNReal.inv_ne_zero.2 ENNReal.coe_ne_top) h₀.ne', ?_⟩
  refine' fun x hx => (hf x.1 x.2).trans_lt _
  rw [mul_comm, ← div_eq_mul_inv] at hx
  rw [mul_comm]
  exact ENNReal.mul_lt_of_lt_div hx
#align antilipschitz_with.comap_uniformity_le AntilipschitzWith.comap_uniformity_le

protected theorem uniformInducing (hf : AntilipschitzWith K f) (hfc : UniformContinuous f) :
    UniformInducing f :=
  ⟨le_antisymm hf.comap_uniformity_le hfc.le_comap⟩
#align antilipschitz_with.uniform_inducing AntilipschitzWith.uniformInducing

protected theorem uniformEmbedding {α : Type _} {β : Type _} [EMetricSpace α] [PseudoEMetricSpace β]
    {K : ℝ≥0} {f : α → β} (hf : AntilipschitzWith K f) (hfc : UniformContinuous f) :
    UniformEmbedding f :=
  ⟨hf.uniformInducing hfc, hf.injective⟩
#align antilipschitz_with.uniform_embedding AntilipschitzWith.uniformEmbedding

theorem isComplete_range [CompleteSpace α] (hf : AntilipschitzWith K f)
    (hfc : UniformContinuous f) : IsComplete (range f) :=
  (hf.uniformInducing hfc).isComplete_range
#align antilipschitz_with.is_complete_range AntilipschitzWith.isComplete_range

theorem isClosed_range {α β : Type _} [PseudoEMetricSpace α] [EMetricSpace β] [CompleteSpace α]
    {f : α → β} {K : ℝ≥0} (hf : AntilipschitzWith K f) (hfc : UniformContinuous f) :
    IsClosed (range f) :=
  (hf.isComplete_range hfc).isClosed
#align antilipschitz_with.is_closed_range AntilipschitzWith.isClosed_range

theorem closedEmbedding {α : Type _} {β : Type _} [EMetricSpace α] [EMetricSpace β] {K : ℝ≥0}
    {f : α → β} [CompleteSpace α] (hf : AntilipschitzWith K f) (hfc : UniformContinuous f) :
    ClosedEmbedding f :=
  { (hf.uniformEmbedding hfc).embedding with closed_range := hf.isClosed_range hfc }
#align antilipschitz_with.closed_embedding AntilipschitzWith.closedEmbedding

theorem subtype_coe (s : Set α) : AntilipschitzWith 1 ((↑) : s → α) :=
  AntilipschitzWith.id.restrict s
#align antilipschitz_with.subtype_coe AntilipschitzWith.subtype_coe

@[nontriviality] -- porting note: added `nontriviality`
theorem of_subsingleton [Subsingleton α] {K : ℝ≥0} : AntilipschitzWith K f := fun x y => by
  simp only [Subsingleton.elim x y, edist_self, zero_le]
#align antilipschitz_with.of_subsingleton AntilipschitzWith.of_subsingleton

/-- If `f : α → β` is `0`-antilipschitz, then `α` is a `subsingleton`. -/
protected theorem subsingleton {α β} [EMetricSpace α] [PseudoEMetricSpace β] {f : α → β}
    (h : AntilipschitzWith 0 f) : Subsingleton α :=
  ⟨fun x y => edist_le_zero.1 <| (h x y).trans_eq <| zero_mul _⟩
#align antilipschitz_with.subsingleton AntilipschitzWith.subsingleton

end AntilipschitzWith

namespace AntilipschitzWith

open Metric

variable [PseudoMetricSpace α] [PseudoMetricSpace β] {K : ℝ≥0} {f : α → β}

theorem bounded_preimage (hf : AntilipschitzWith K f) {s : Set β} (hs : Bounded s) :
    Bounded (f ⁻¹' s) :=
  Exists.intro (K * diam s) fun x hx y hy =>
    calc
      dist x y ≤ K * dist (f x) (f y) := hf.le_mul_dist x y
      _ ≤ K * diam s := mul_le_mul_of_nonneg_left (dist_le_diam_of_mem hs hx hy) K.2
#align antilipschitz_with.bounded_preimage AntilipschitzWith.bounded_preimage

theorem tendsto_cobounded (hf : AntilipschitzWith K f) : Tendsto f (cobounded α) (cobounded β) :=
  compl_surjective.forall.2 fun s (hs : IsBounded s) =>
    Metric.isBounded_iff.2 <| hf.bounded_preimage <| Metric.isBounded_iff.1 hs
#align antilipschitz_with.tendsto_cobounded AntilipschitzWith.tendsto_cobounded

/-- The image of a proper space under an expanding onto map is proper. -/
protected theorem properSpace {α : Type _} [MetricSpace α] {K : ℝ≥0} {f : α → β} [ProperSpace α]
    (hK : AntilipschitzWith K f) (f_cont : Continuous f) (hf : Function.Surjective f) :
    ProperSpace β := by
  refine ⟨fun x₀ r => ?_⟩
  let K := f ⁻¹' closedBall x₀ r
  have A : IsClosed K := isClosed_ball.preimage f_cont
  have B : Bounded K := hK.bounded_preimage bounded_closedBall
  have : IsCompact K := isCompact_iff_isClosed_bounded.2 ⟨A, B⟩
  convert this.image f_cont
  exact (hf.image_preimage _).symm
#align antilipschitz_with.proper_space AntilipschitzWith.properSpace

end AntilipschitzWith

theorem LipschitzWith.to_rightInverse [PseudoEMetricSpace α] [PseudoEMetricSpace β] {K : ℝ≥0}
    {f : α → β} (hf : LipschitzWith K f) {g : β → α} (hg : Function.RightInverse g f) :
    AntilipschitzWith K g := fun x y => by simpa only [hg _] using hf (g x) (g y)
#align lipschitz_with.to_right_inverse LipschitzWith.to_rightInverse

/-- The preimage of a proper space under a Lipschitz homeomorphism is proper. -/
protected theorem LipschitzWith.properSpace [PseudoMetricSpace α] [MetricSpace β] [ProperSpace β]
    {K : ℝ≥0} {f : α ≃ₜ β} (hK : LipschitzWith K f) : ProperSpace α :=
  (hK.to_rightInverse f.right_inv).properSpace f.symm.continuous f.symm.surjective
#align lipschitz_with.proper_space LipschitzWith.properSpace


/-
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.int.basic
import algebra.char_zero
import order.locally_finite
import data.finset.locally_finite

/-!
# Finite intervals of integers

This file proves that `ℤ` is a `locally_finite_order` and calculates the cardinality of its
intervals as finsets and fintypes.
-/

open finset int

instance : locally_finite_order ℤ :=
{ finset_Icc := λ a b, (finset.range (b + 1 - a).to_nat).map $
    nat.cast_embedding.trans $ add_left_embedding a,
  finset_Ico := λ a b, (finset.range (b - a).to_nat).map $
    nat.cast_embedding.trans $ add_left_embedding a,
  finset_Ioc := λ a b, (finset.range (b - a).to_nat).map $
    nat.cast_embedding.trans $ add_left_embedding (a + 1),
  finset_Ioo := λ a b, (finset.range (b - a - 1).to_nat).map $
    nat.cast_embedding.trans $ add_left_embedding (a + 1),
  finset_mem_Icc := λ a b x, begin
    simp_rw [mem_map, exists_prop, mem_range, int.lt_to_nat, function.embedding.trans_apply,
      nat.cast_embedding_apply, add_left_embedding_apply],
    split,
    { rintro ⟨a, h, rfl⟩,
      rw [lt_sub_iff_add_lt, int.lt_add_one_iff, add_comm] at h,
      exact ⟨int.le.intro rfl, h⟩ },
    { rintro ⟨ha, hb⟩,
      use (x - a).to_nat,
      rw ←lt_add_one_iff at hb,
      rw to_nat_sub_of_le ha,
      exact ⟨sub_lt_sub_right hb _, add_sub_cancel'_right _ _⟩ }
  end,
  finset_mem_Ico := λ a b x, begin
    simp_rw [mem_map, exists_prop, mem_range, int.lt_to_nat, function.embedding.trans_apply,
      nat.cast_embedding_apply, add_left_embedding_apply],
    split,
    { rintro ⟨a, h, rfl⟩,
      exact ⟨int.le.intro rfl, lt_sub_iff_add_lt'.mp h⟩ },
    { rintro ⟨ha, hb⟩,
      use (x - a).to_nat,
      rw to_nat_sub_of_le ha,
      exact ⟨sub_lt_sub_right hb _, add_sub_cancel'_right _ _⟩ }
  end,
  finset_mem_Ioc := λ a b x, begin
    simp_rw [mem_map, exists_prop, mem_range, int.lt_to_nat, function.embedding.trans_apply,
      nat.cast_embedding_apply, add_left_embedding_apply],
    split,
    { rintro ⟨a, h, rfl⟩,
      rw [←add_one_le_iff, le_sub_iff_add_le', add_comm _ (1 : ℤ), ←add_assoc] at h,
      exact ⟨int.le.intro rfl, h⟩ },
    { rintro ⟨ha, hb⟩,
      use (x - (a + 1)).to_nat,
      rw [to_nat_sub_of_le ha, ←add_one_le_iff, sub_add, add_sub_cancel],
      exact ⟨sub_le_sub_right hb _, add_sub_cancel'_right _ _⟩ }
  end,
  finset_mem_Ioo := λ a b x, begin
    simp_rw [mem_map, exists_prop, mem_range, int.lt_to_nat, function.embedding.trans_apply,
      nat.cast_embedding_apply, add_left_embedding_apply],
    split,
    { rintro ⟨a, h, rfl⟩,
      rw [sub_sub, lt_sub_iff_add_lt'] at h,
      exact ⟨int.le.intro rfl, h⟩ },
    { rintro ⟨ha, hb⟩,
      use (x - (a + 1)).to_nat,
      rw [to_nat_sub_of_le ha, sub_sub],
      exact ⟨sub_lt_sub_right hb _, add_sub_cancel'_right _ _⟩ }
  end }

namespace int
variables (a b : ℤ)

lemma Icc_eq_finset_map :
  Icc a b = (finset.range (b + 1 - a).to_nat).map
    (nat.cast_embedding.trans $ add_left_embedding a) := rfl
lemma Ico_eq_finset_map :
  Ico a b = (finset.range (b - a).to_nat).map
    (nat.cast_embedding.trans $ add_left_embedding a) := rfl
lemma Ioc_eq_finset_map :
  Ioc a b = (finset.range (b - a).to_nat).map
    (nat.cast_embedding.trans $ add_left_embedding (a + 1)) := rfl
lemma Ioo_eq_finset_map :
  Ioo a b = (finset.range (b - a - 1).to_nat).map
    (nat.cast_embedding.trans $ add_left_embedding (a + 1)) := rfl

@[simp] lemma card_Icc : (Icc a b).card = (b + 1 - a).to_nat :=
by { change (finset.map _ _).card = _, rw [finset.card_map, finset.card_range] }

@[simp] lemma card_Ico : (Ico a b).card = (b - a).to_nat :=
by { change (finset.map _ _).card = _, rw [finset.card_map, finset.card_range] }

@[simp] lemma card_Ioc : (Ioc a b).card = (b - a).to_nat :=
by { change (finset.map _ _).card = _, rw [finset.card_map, finset.card_range] }

@[simp] lemma card_Ioo : (Ioo a b).card = (b - a - 1).to_nat :=
by { change (finset.map _ _).card = _, rw [finset.card_map, finset.card_range] }

lemma card_Icc_of_le (h : a ≤ b + 1) : ((Icc a b).card : ℤ) = b + 1 - a :=
by rw [card_Icc, to_nat_sub_of_le h]

lemma card_Ico_of_le (h : a ≤ b) : ((Ico a b).card : ℤ) = b - a :=
by rw [card_Ico, to_nat_sub_of_le h]

lemma card_Ioc_of_le (h : a ≤ b) : ((Ioc a b).card : ℤ) = b - a :=
by rw [card_Ioc, to_nat_sub_of_le h]

lemma card_Ioo_of_lt (h : a < b) : ((Ioo a b).card : ℤ) = b - a - 1 :=
by rw [card_Ioo, sub_sub, to_nat_sub_of_le h]

@[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = (b + 1 - a).to_nat :=
by rw [←card_Icc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ico : fintype.card (set.Ico a b) = (b - a).to_nat :=
by rw [←card_Ico, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioc : fintype.card (set.Ioc a b) = (b - a).to_nat :=
by rw [←card_Ioc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = (b - a - 1).to_nat :=
by rw [←card_Ioo, fintype.card_of_finset]

lemma card_fintype_Icc_of_le (h : a ≤ b + 1) : (fintype.card (set.Icc a b) : ℤ) = b + 1 - a :=
by rw [card_fintype_Icc, to_nat_sub_of_le h]

lemma card_fintype_Ico_of_le (h : a ≤ b) : (fintype.card (set.Ico a b) : ℤ) = b - a :=
by rw [card_fintype_Ico, to_nat_sub_of_le h]

lemma card_fintype_Ioc_of_le (h : a ≤ b) : (fintype.card (set.Ioc a b) : ℤ) = b - a :=
by rw [card_fintype_Ioc, to_nat_sub_of_le h]

lemma card_fintype_Ioo_of_lt (h : a < b) : (fintype.card (set.Ioo a b) : ℤ) = b - a - 1 :=
by rw [card_fintype_Ioo, sub_sub, to_nat_sub_of_le h]

lemma image_Ico_mod (n a : ℤ) (h : 0 ≤ a) :
  (Ico n (n+a)).image (% a) = Ico 0 a :=
begin
  obtain rfl | ha := eq_or_lt_of_le h,
  { simp, },
  ext i,
  simp only [mem_image, exists_prop, mem_range, mem_Ico],
  split,
  { rintro ⟨i, h, rfl⟩, exact ⟨mod_nonneg i (ne_of_gt ha), mod_lt_of_pos i ha⟩, },
  intro hia,
  have hn := int.mod_add_div n a,
  obtain hi | hi := lt_or_le i (n % a),
  { refine ⟨i + a * (n/a + 1), ⟨_, _⟩, _⟩,
    { rw [add_comm (n/a), mul_add, mul_one, ← add_assoc],
      refine hn.symm.le.trans (add_le_add_right _ _),
      simpa only [zero_add] using add_le_add (hia.left) (int.mod_lt_of_pos n ha).le, },
    { refine lt_of_lt_of_le (add_lt_add_right hi (a * (n/a + 1))) _,
      rw [mul_add, mul_one, ← add_assoc, hn], },
    { rw [int.add_mul_mod_self_left, int.mod_eq_of_lt hia.left hia.right], } },
  { refine ⟨i + a * (n/a), ⟨_, _⟩, _⟩,
    { exact hn.symm.le.trans (add_le_add_right hi _), },
    { rw [add_comm n a],
      refine add_lt_add_of_lt_of_le hia.right (le_trans _ hn.le),
      simp only [zero_le, le_add_iff_nonneg_left],
      exact int.mod_nonneg n (ne_of_gt ha), },
    { rw [int.add_mul_mod_self_left, int.mod_eq_of_lt hia.left hia.right], } },
end

end int


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

! This file was ported from Lean 3 source module algebra.group.conj
! leanprover-community/mathlib commit 0743cc5d9d86bcd1bba10f480e948a257d65056f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Semiconj
import Mathlib.Algebra.GroupWithZero.Basic
import Mathlib.Algebra.Hom.Aut
import Mathlib.Algebra.Hom.Group

/-!
# Conjugacy of group elements

See also `MulAut.conj` and `Quandle.conj`.
-/

universe u v

variable {α : Type u} {β : Type v}

section Monoid

variable [Monoid α] [Monoid β]

/-- We say that `a` is conjugate to `b` if for some unit `c` we have `c * a * c⁻¹ = b`. -/
def IsConj (a b : α) :=
  ∃ c : αˣ, SemiconjBy (↑c) a b
#align is_conj IsConj

@[refl]
theorem IsConj.refl (a : α) : IsConj a a :=
  ⟨1, SemiconjBy.one_left a⟩
#align is_conj.refl IsConj.refl

@[symm]
theorem IsConj.symm {a b : α} : IsConj a b → IsConj b a
  | ⟨c, hc⟩ => ⟨c⁻¹, hc.units_inv_symm_left⟩
#align is_conj.symm IsConj.symm

theorem isConj_comm {g h : α} : IsConj g h ↔ IsConj h g :=
  ⟨IsConj.symm, IsConj.symm⟩
#align is_conj_comm isConj_comm

@[trans]
theorem IsConj.trans {a b c : α} : IsConj a b → IsConj b c → IsConj a c
  | ⟨c₁, hc₁⟩, ⟨c₂, hc₂⟩ => ⟨c₂ * c₁, hc₂.mul_left hc₁⟩
#align is_conj.trans IsConj.trans

@[simp]
theorem isConj_iff_eq {α : Type _} [CommMonoid α] {a b : α} : IsConj a b ↔ a = b :=
  ⟨fun ⟨c, hc⟩ => by
    rw [SemiconjBy, mul_comm, ← Units.mul_inv_eq_iff_eq_mul, mul_assoc, c.mul_inv, mul_one] at hc
    exact hc, fun h => by rw [h]⟩
#align is_conj_iff_eq isConj_iff_eq

protected theorem MonoidHom.map_isConj (f : α →* β) {a b : α} : IsConj a b → IsConj (f a) (f b)
  | ⟨c, hc⟩ => ⟨Units.map f c, by rw [Units.coe_map, SemiconjBy, ← f.map_mul, hc.eq, f.map_mul]⟩
#align monoid_hom.map_is_conj MonoidHom.map_isConj

end Monoid

section CancelMonoid

variable [CancelMonoid α]

-- These lemmas hold for `RightCancelMonoid` with the current proofs, but for the sake of
-- not duplicating code (these lemmas also hold for `LeftCancelMonoids`) we leave these
-- not generalised.
@[simp]
theorem isConj_one_right {a : α} : IsConj 1 a ↔ a = 1 :=
  ⟨fun ⟨c, hc⟩ => mul_right_cancel (hc.symm.trans ((mul_one _).trans (one_mul _).symm)), fun h => by
    rw [h]⟩
#align is_conj_one_right isConj_one_right

@[simp]
theorem isConj_one_left {a : α} : IsConj a 1 ↔ a = 1 :=
  calc
    IsConj a 1 ↔ IsConj 1 a := ⟨IsConj.symm, IsConj.symm⟩
    _ ↔ a = 1 := isConj_one_right
#align is_conj_one_left isConj_one_left

end CancelMonoid

section Group

variable [Group α]

@[simp]
theorem isConj_iff {a b : α} : IsConj a b ↔ ∃ c : α, c * a * c⁻¹ = b :=
  ⟨fun ⟨c, hc⟩ => ⟨c, mul_inv_eq_iff_eq_mul.2 hc⟩, fun ⟨c, hc⟩ =>
    ⟨⟨c, c⁻¹, mul_inv_self c, inv_mul_self c⟩, mul_inv_eq_iff_eq_mul.1 hc⟩⟩
#align is_conj_iff isConj_iff

-- Porting note: not in simp NF.
-- @[simp]
theorem conj_inv {a b : α} : (b * a * b⁻¹)⁻¹ = b * a⁻¹ * b⁻¹ :=
  ((MulAut.conj b).map_inv a).symm
#align conj_inv conj_inv

@[simp]
theorem conj_mul {a b c : α} : b * a * b⁻¹ * (b * c * b⁻¹) = b * (a * c) * b⁻¹ :=
  ((MulAut.conj b).map_mul a c).symm
#align conj_mul conj_mul

@[simp]
theorem conj_pow {i : ℕ} {a b : α} : (a * b * a⁻¹) ^ i = a * b ^ i * a⁻¹ := by
  induction' i with i hi
  · simp
  · simp [pow_succ, hi]
#align conj_pow conj_pow

@[simp]
theorem conj_zpow {i : ℤ} {a b : α} : (a * b * a⁻¹) ^ i = a * b ^ i * a⁻¹ := by
  induction' i
  · change (a * b * a⁻¹) ^ (_ : ℤ) = a * b ^ (_ : ℤ) * a⁻¹
    simp [zpow_ofNat]
  · simp [zpow_negSucc, conj_pow]
    rw [mul_assoc]
-- Porting note: Added `change`, `zpow_ofNat`, and `rw`.
#align conj_zpow conj_zpow

theorem conj_injective {x : α} : Function.Injective fun g : α => x * g * x⁻¹ :=
  (MulAut.conj x).injective
#align conj_injective conj_injective

end Group

@[simp]
theorem isConj_iff₀ [GroupWithZero α] {a b : α} : IsConj a b ↔ ∃ c : α, c ≠ 0 ∧ c * a * c⁻¹ = b :=
  ⟨fun ⟨c, hc⟩ =>
    ⟨c, by
      rw [← Units.val_inv_eq_inv_val, Units.mul_inv_eq_iff_eq_mul]
      exact ⟨c.ne_zero, hc⟩⟩,
    fun ⟨c, c0, hc⟩ =>
    ⟨Units.mk0 c c0, by
      rw [SemiconjBy, ← Units.mul_inv_eq_iff_eq_mul, Units.val_inv_eq_inv_val, Units.val_mk0]
      exact hc⟩⟩
#align is_conj_iff₀ isConj_iff₀

namespace IsConj

/- This small quotient API is largely copied from the API of `associates`;
where possible, try to keep them in sync -/
/-- The setoid of the relation `IsConj` iff there is a unit `u` such that `u * x = y * u` -/
protected def setoid (α : Type _) [Monoid α] : Setoid α where
  r := IsConj
  iseqv := ⟨IsConj.refl, IsConj.symm, IsConj.trans⟩
#align is_conj.setoid IsConj.setoid

end IsConj

attribute [local instance] IsConj.setoid

/-- The quotient type of conjugacy classes of a group. -/
def ConjClasses (α : Type _) [Monoid α] : Type _ :=
  Quotient (IsConj.setoid α)
#align conj_classes ConjClasses

namespace ConjClasses

section Monoid

variable [Monoid α] [Monoid β]

/-- The canonical quotient map from a monoid `α` into the `ConjClasses` of `α` -/
protected def mk {α : Type _} [Monoid α] (a : α) : ConjClasses α := ⟦a⟧
#align conj_classes.mk ConjClasses.mk

instance : Inhabited (ConjClasses α) := ⟨⟦1⟧⟩

theorem mk_eq_mk_iff_isConj {a b : α} : ConjClasses.mk a = ConjClasses.mk b ↔ IsConj a b :=
  Iff.intro Quotient.exact Quot.sound
#align conj_classes.mk_eq_mk_iff_is_conj ConjClasses.mk_eq_mk_iff_isConj

theorem quotient_mk_eq_mk (a : α) : ⟦a⟧ = ConjClasses.mk a :=
  rfl
#align conj_classes.quotient_mk_eq_mk ConjClasses.quotient_mk_eq_mk

theorem quot_mk_eq_mk (a : α) : Quot.mk Setoid.r a = ConjClasses.mk a :=
  rfl
#align conj_classes.quot_mk_eq_mk ConjClasses.quot_mk_eq_mk

theorem forall_isConj {p : ConjClasses α → Prop} : (∀ a, p a) ↔ ∀ a, p (ConjClasses.mk a) :=
  Iff.intro (fun h _ => h _) fun h a => Quotient.inductionOn a h
#align conj_classes.forall_is_conj ConjClasses.forall_isConj

theorem mk_surjective : Function.Surjective (@ConjClasses.mk α _) :=
  forall_isConj.2 fun a => ⟨a, rfl⟩
#align conj_classes.mk_surjective ConjClasses.mk_surjective

instance : One (ConjClasses α) :=
  ⟨⟦1⟧⟩

theorem one_eq_mk_one : (1 : ConjClasses α) = ConjClasses.mk 1 :=
  rfl
#align conj_classes.one_eq_mk_one ConjClasses.one_eq_mk_one

theorem exists_rep (a : ConjClasses α) : ∃ a0 : α, ConjClasses.mk a0 = a :=
  Quot.exists_rep a
#align conj_classes.exists_rep ConjClasses.exists_rep

/-- A `MonoidHom` maps conjugacy classes of one group to conjugacy classes of another. -/
def map (f : α →* β) : ConjClasses α → ConjClasses β :=
  Quotient.lift (ConjClasses.mk ∘ f) fun _ _ ab => mk_eq_mk_iff_isConj.2 (f.map_isConj ab)
#align conj_classes.map ConjClasses.map

theorem map_surjective {f : α →* β} (hf : Function.Surjective f) :
    Function.Surjective (ConjClasses.map f) := by
  intro b
  obtain ⟨b, rfl⟩ := ConjClasses.mk_surjective b
  obtain ⟨a, rfl⟩ := hf b
  exact ⟨ConjClasses.mk a, rfl⟩
#align conj_classes.map_surjective ConjClasses.map_surjective

-- Porting note: This has not been adapted to mathlib4, is it still accurate?
library_note "slow-failing instance priority"/--
Certain instances trigger further searches when they are considered as candidate instances;
these instances should be assigned a priority lower than the default of 1000 (for example, 900).

The conditions for this rule are as follows:
 * a class `C` has instances `instT : C T` and `instT' : C T'`
 * types `T` and `T'` are both specializations of another type `S`
 * the parameters supplied to `S` to produce `T` are not (fully) determined by `instT`,
   instead they have to be found by instance search
If those conditions hold, the instance `instT` should be assigned lower priority.

For example, suppose the search for an instance of `DecidableEq (Multiset α)` tries the
candidate instance `Con.quotient.decidableEq (c : Con M) : decidableEq c.quotient`.
Since `Multiset` and `Con.quotient` are both quotient types, unification will check
that the relations `List.perm` and `c.toSetoid.r` unify. However, `c.toSetoid` depends on
a `Mul M` instance, so this unification triggers a search for `Mul (List α)`;
this will traverse all subclasses of `Mul` before failing.
On the other hand, the search for an instance of `DecidableEq (Con.quotient c)` for `c : con M`
can quickly reject the candidate instance `Multiset.decidableEq` because the type of
`List.perm : List ?m_1 → List ?m_1 → Prop` does not unify with `M → M → Prop`.
Therefore, we should assign `Con.quotient.decidableEq` a lower priority because it fails slowly.
(In terms of the rules above, `C := DecidableEq`, `T := Con.quotient`,
`instT := Con.quotient.decidableEq`, `T' := Multiset`, `instT' := Multiset.decidableEq`,
and `S := Quot`.)

If the type involved is a free variable (rather than an instantiation of some type `S`),
the instance priority should be even lower, see Note [lower instance priority].
-/

-- see Note [slow-failing instance priority]
instance (priority := 900) [DecidableRel (IsConj : α → α → Prop)] : DecidableEq (ConjClasses α) :=
  instDecidableEqQuotient

end Monoid

section CommMonoid

variable [CommMonoid α]

theorem mk_injective : Function.Injective (@ConjClasses.mk α _) := fun _ _ =>
  (mk_eq_mk_iff_isConj.trans isConj_iff_eq).1
#align conj_classes.mk_injective ConjClasses.mk_injective

theorem mk_bijective : Function.Bijective (@ConjClasses.mk α _) :=
  ⟨mk_injective, mk_surjective⟩
#align conj_classes.mk_bijective ConjClasses.mk_bijective

/-- The bijection between a `CommGroup` and its `ConjClasses`. -/
def mkEquiv : α ≃ ConjClasses α :=
  ⟨ConjClasses.mk, Quotient.lift id fun (a : α) b => isConj_iff_eq.1, Quotient.lift_mk _ _, by
    rw [Function.RightInverse, Function.LeftInverse, forall_isConj]
    intro x
    rw [← quotient_mk_eq_mk, ← quotient_mk_eq_mk, Quotient.lift_mk, id.def]⟩
#align conj_classes.mk_equiv ConjClasses.mkEquiv

end CommMonoid

end ConjClasses

section Monoid

variable [Monoid α]

/-- Given an element `a`, `conjugatesOf a` is the set of conjugates. -/
def conjugatesOf (a : α) : Set α :=
  { b | IsConj a b }
#align conjugates_of conjugatesOf

theorem mem_conjugatesOf_self {a : α} : a ∈ conjugatesOf a :=
  IsConj.refl _
#align mem_conjugates_of_self mem_conjugatesOf_self

theorem IsConj.conjugatesOf_eq {a b : α} (ab : IsConj a b) : conjugatesOf a = conjugatesOf b :=
  Set.ext fun _ => ⟨fun ag => ab.symm.trans ag, fun bg => ab.trans bg⟩
#align is_conj.conjugates_of_eq IsConj.conjugatesOf_eq

theorem isConj_iff_conjugatesOf_eq {a b : α} : IsConj a b ↔ conjugatesOf a = conjugatesOf b :=
  ⟨IsConj.conjugatesOf_eq, fun h => by
    have ha := @mem_conjugatesOf_self _ _ b -- Porting note: added `@`.
    rwa [← h] at ha⟩
#align is_conj_iff_conjugates_of_eq isConj_iff_conjugatesOf_eq

end Monoid

namespace ConjClasses

variable [Monoid α]

attribute [local instance] IsConj.setoid

/-- Given a conjugacy class `a`, `carrier a` is the set it represents. -/
def carrier : ConjClasses α → Set α :=
  Quotient.lift conjugatesOf fun (_ : α) _ ab => IsConj.conjugatesOf_eq ab
#align conj_classes.carrier ConjClasses.carrier

theorem mem_carrier_mk {a : α} : a ∈ carrier (ConjClasses.mk a) :=
  IsConj.refl _
#align conj_classes.mem_carrier_mk ConjClasses.mem_carrier_mk

theorem mem_carrier_iff_mk_eq {a : α} {b : ConjClasses α} :
    a ∈ carrier b ↔ ConjClasses.mk a = b := by
  revert b
  rw [forall_isConj]
  intro b
  rw [carrier, eq_comm, mk_eq_mk_iff_isConj, ← quotient_mk_eq_mk, Quotient.lift_mk]
  rfl
#align conj_classes.mem_carrier_iff_mk_eq ConjClasses.mem_carrier_iff_mk_eq

theorem carrier_eq_preimage_mk {a : ConjClasses α} : a.carrier = ConjClasses.mk ⁻¹' {a} :=
  Set.ext fun _ => mem_carrier_iff_mk_eq
#align conj_classes.carrier_eq_preimage_mk ConjClasses.carrier_eq_preimage_mk

end ConjClasses

-- porting notes: not implemented
-- assert_not_exists multiset


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.normed_space.operator_norm
import Mathlib.analysis.normed_space.extend
import Mathlib.analysis.convex.cone
import Mathlib.data.complex.is_R_or_C
import Mathlib.PostPort

universes u_1 u_2 u v

namespace Mathlib

/-!
# Hahn-Banach theorem

In this file we prove a version of Hahn-Banach theorem for continuous linear
functions on normed spaces over `ℝ` and `ℂ`.

In order to state and prove its corollaries uniformly, we prove the statements for a field `𝕜`
satisfying `is_R_or_C 𝕜`.

In this setting, `exists_dual_vector` states that, for any nonzero `x`, there exists a continuous
linear form `g` of norm `1` with `g x = ∥x∥` (where the norm has to be interpreted as an element
of `𝕜`).

-/

/--
The norm of `x` as an element of `𝕜` (a normed algebra over `ℝ`). This is needed in particular to
state equalities of the form `g x = norm' 𝕜 x` when `g` is a linear function.

For the concrete cases of `ℝ` and `𝕜`, this is just `∥x∥` and `↑∥x∥`, respectively.
-/
def norm' (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] [normed_algebra ℝ 𝕜] {E : Type u_2}
    [normed_group E] (x : E) : 𝕜 :=
  coe_fn (algebra_map ℝ 𝕜) (norm x)

theorem norm'_def (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] [normed_algebra ℝ 𝕜] {E : Type u_2}
    [normed_group E] (x : E) : norm' 𝕜 x = coe_fn (algebra_map ℝ 𝕜) (norm x) :=
  rfl

theorem norm_norm' (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] [normed_algebra ℝ 𝕜] (A : Type u_2)
    [normed_group A] (x : A) : norm (norm' 𝕜 x) = norm x :=
  sorry

namespace real

/-- Hahn-Banach theorem for continuous linear functions over `ℝ`. -/
theorem exists_extension_norm_eq {E : Type u_1} [normed_group E] [normed_space ℝ E]
    (p : subspace ℝ E) (f : continuous_linear_map ℝ ↥p ℝ) :
    ∃ (g : continuous_linear_map ℝ E ℝ), (∀ (x : ↥p), coe_fn g ↑x = coe_fn f x) ∧ norm g = norm f :=
  sorry

end real

/-- Hahn-Banach theorem for continuous linear functions over `𝕜` satisyfing `is_R_or_C 𝕜`. -/
theorem exists_extension_norm_eq {𝕜 : Type u_1} [is_R_or_C 𝕜] {F : Type u_2} [normed_group F]
    [normed_space 𝕜 F] (p : subspace 𝕜 F) (f : continuous_linear_map 𝕜 (↥p) 𝕜) :
    ∃ (g : continuous_linear_map 𝕜 F 𝕜), (∀ (x : ↥p), coe_fn g ↑x = coe_fn f x) ∧ norm g = norm f :=
  sorry

theorem coord_norm' {𝕜 : Type v} [is_R_or_C 𝕜] {E : Type u} [normed_group E] [normed_space 𝕜 E]
    (x : E) (h : x ≠ 0) : norm (norm' 𝕜 x • continuous_linear_equiv.coord 𝕜 x h) = 1 :=
  sorry

/-- Corollary of Hahn-Banach.  Given a nonzero element `x` of a normed space, there exists an
    element of the dual space, of norm `1`, whose value on `x` is `∥x∥`. -/
theorem exists_dual_vector {𝕜 : Type v} [is_R_or_C 𝕜] {E : Type u} [normed_group E]
    [normed_space 𝕜 E] (x : E) (h : x ≠ 0) :
    ∃ (g : continuous_linear_map 𝕜 E 𝕜), norm g = 1 ∧ coe_fn g x = norm' 𝕜 x :=
  sorry

/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, and choosing
    the dual element arbitrarily when `x = 0`. -/
theorem exists_dual_vector' {𝕜 : Type v} [is_R_or_C 𝕜] {E : Type u} [normed_group E]
    [normed_space 𝕜 E] [nontrivial E] (x : E) :
    ∃ (g : continuous_linear_map 𝕜 E 𝕜), norm g = 1 ∧ coe_fn g x = norm' 𝕜 x :=
  sorry

end Mathlib


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

import data.multiset.basic
import data.vector.basic
import data.setoid.basic
import tactic.apply_fun

/-!
# Symmetric powers

This file defines symmetric powers of a type.  The nth symmetric power
consists of homogeneous n-tuples modulo permutations by the symmetric
group.

The special case of 2-tuples is called the symmetric square, which is
addressed in more detail in `data.sym.sym2`.

TODO: This was created as supporting material for `sym2`; it
needs a fleshed-out interface.

## Tags

symmetric powers

-/

open function

/--
The nth symmetric power is n-tuples up to permutation.  We define it
as a subtype of `multiset` since these are well developed in the
library.  We also give a definition `sym.sym'` in terms of vectors, and we
show these are equivalent in `sym.sym_equiv_sym'`.
-/
def sym (α : Type*) (n : ℕ) := {s : multiset α // s.card = n}

instance sym.has_coe (α : Type*) (n : ℕ) : has_coe (sym α n) (multiset α) := coe_subtype

/--
This is the `list.perm` setoid lifted to `vector`.

See note [reducible non-instances].
-/
@[reducible]
def vector.perm.is_setoid (α : Type*) (n : ℕ) : setoid (vector α n) :=
(list.is_setoid α).comap subtype.val

local attribute [instance] vector.perm.is_setoid

namespace sym

variables {α β : Type*} {n : ℕ} {s : sym α n} {a b : α}

lemma coe_injective : injective (coe : sym α n → multiset α) := subtype.coe_injective

@[simp, norm_cast] lemma coe_inj {s₁ s₂ : sym α n} : (s₁ : multiset α) = s₂ ↔ s₁ = s₂ :=
coe_injective.eq_iff

/--
Construct an element of the `n`th symmetric power from a multiset of cardinality `n`.
-/
@[simps, pattern]
abbreviation mk (m : multiset α) (h : m.card = n) : sym α n := ⟨m, h⟩

/--
The unique element in `sym α 0`.
-/
@[pattern] def nil : sym α 0 := ⟨0, multiset.card_zero⟩

/--
Inserts an element into the term of `sym α n`, increasing the length by one.
-/
@[pattern] def cons (a : α) (s : sym α n) : sym α n.succ :=
⟨a ::ₘ s.1, by rw [multiset.card_cons, s.2]⟩

infixr ` ::ₛ `:67 := cons

@[simp]
lemma cons_inj_right (a : α) (s s' : sym α n) : a ::ₛ s = a ::ₛ s' ↔ s = s' :=
subtype.ext_iff.trans $ (multiset.cons_inj_right _).trans subtype.ext_iff.symm

@[simp]
lemma cons_inj_left (a a' : α) (s : sym α n) : a ::ₛ s = a' ::ₛ s ↔ a = a' :=
subtype.ext_iff.trans $ multiset.cons_inj_left _

lemma cons_swap (a b : α) (s : sym α n) : a ::ₛ b ::ₛ s = b ::ₛ a ::ₛ s :=
subtype.ext $ multiset.cons_swap a b s.1

lemma coe_cons (s : sym α n) (a : α) : (a ::ₛ s : multiset α) = a ::ₘ s := rfl

/--
This is the quotient map that takes a list of n elements as an n-tuple and produces an nth
symmetric power.
-/
instance : has_lift (vector α n) (sym α n) :=
{ lift := λ x, ⟨↑x.val, (multiset.coe_card _).trans x.2⟩ }

@[simp] lemma of_vector_nil : ↑(vector.nil : vector α 0) = (sym.nil : sym α 0) := rfl

@[simp] lemma of_vector_cons (a : α) (v : vector α n) :
  ↑(vector.cons a v) = a ::ₛ (↑v : sym α n) := by { cases v, refl }

/--
`α ∈ s` means that `a` appears as one of the factors in `s`.
-/
instance : has_mem α (sym α n) := ⟨λ a s, a ∈ s.1⟩

instance decidable_mem [decidable_eq α] (a : α) (s : sym α n) : decidable (a ∈ s) :=
s.1.decidable_mem _

@[simp]
lemma mem_mk (a : α) (s : multiset α) (h : s.card = n) : a ∈ mk s h ↔ a ∈ s := iff.rfl

@[simp] lemma mem_cons {a b : α} {s : sym α n} : a ∈ b ::ₛ s ↔ a = b ∨ a ∈ s :=
multiset.mem_cons

lemma mem_cons_of_mem {a b : α} {s : sym α n} (h : a ∈ s) : a ∈ b ::ₛ s :=
multiset.mem_cons_of_mem h

@[simp] lemma mem_cons_self (a : α) (s : sym α n) : a ∈ a ::ₛ s :=
multiset.mem_cons_self a s.1

lemma sound {a b : vector α n} (h : a.val ~ b.val) : (↑a : sym α n) = ↑b :=
subtype.ext $ quotient.sound h

/-- `erase s a h` is the sym that subtracts 1 from the
  multiplicity of `a` if a is present in the sym. -/
def erase [decidable_eq α] (s : sym α (n + 1)) (a : α) (h : a ∈ s) : sym α n :=
⟨s.val.erase a, (multiset.card_erase_of_mem h).trans $ s.property.symm ▸ n.pred_succ⟩

@[simp] lemma erase_mk [decidable_eq α] (m : multiset α) (hc : m.card = n + 1) (a : α) (h : a ∈ m) :
  (mk m hc).erase a h = mk (m.erase a) (by { rw [multiset.card_erase_of_mem h, hc], refl }) := rfl

@[simp] lemma coe_erase [decidable_eq α] {s : sym α n.succ} {a : α} (h : a ∈ s) :
  (s.erase a h : multiset α) = multiset.erase s a := rfl

@[simp] lemma cons_erase [decidable_eq α] {s : sym α n.succ} {a : α} (h : a ∈ s) :
  a ::ₛ s.erase a h = s :=
coe_injective $ multiset.cons_erase h

@[simp] lemma erase_cons_head [decidable_eq α] (s : sym α n) (a : α)
  (h : a ∈ a ::ₛ s := mem_cons_self a s) : (a ::ₛ s).erase a h = s :=
coe_injective $ multiset.erase_cons_head a s.1

/--
Another definition of the nth symmetric power, using vectors modulo permutations. (See `sym`.)
-/
def sym' (α : Type*) (n : ℕ) := quotient (vector.perm.is_setoid α n)

/--
This is `cons` but for the alternative `sym'` definition.
-/
def cons' {α : Type*} {n : ℕ} : α → sym' α n → sym' α (nat.succ n) :=
λ a, quotient.map (vector.cons a) (λ ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ h, list.perm.cons _ h)

notation a :: b := cons' a b

/--
Multisets of cardinality n are equivalent to length-n vectors up to permutations.
-/
def sym_equiv_sym' {α : Type*} {n : ℕ} : sym α n ≃ sym' α n :=
equiv.subtype_quotient_equiv_quotient_subtype _ _ (λ _, by refl) (λ _ _, by refl)

lemma cons_equiv_eq_equiv_cons (α : Type*) (n : ℕ) (a : α) (s : sym α n) :
  a :: sym_equiv_sym' s = sym_equiv_sym' (a ::ₛ s) :=
by { rcases s with ⟨⟨l⟩, _⟩, refl, }

instance : has_zero (sym α 0) := ⟨⟨0, rfl⟩⟩
instance : has_emptyc (sym α 0) := ⟨0⟩

lemma eq_nil_of_card_zero (s : sym α 0) : s = nil :=
subtype.ext $ multiset.card_eq_zero.1 s.2

instance unique_zero : unique (sym α 0) :=
⟨⟨nil⟩, eq_nil_of_card_zero⟩

/-- `repeat a n` is the sym containing only `a` with multiplicity `n`. -/
def repeat (a : α) (n : ℕ) : sym α n := ⟨multiset.repeat a n, multiset.card_repeat _ _⟩

lemma repeat_succ {a : α} {n : ℕ} : repeat a n.succ = a ::ₛ repeat a n := rfl

lemma coe_repeat : (repeat a n : multiset α) = multiset.repeat a n := rfl

@[simp] lemma mem_repeat : b ∈ repeat a n ↔ n ≠ 0 ∧ b = a := multiset.mem_repeat

lemma eq_repeat_iff : s = repeat a n ↔ ∀ b ∈ s, b = a :=
begin
  rw [subtype.ext_iff, coe_repeat],
  convert multiset.eq_repeat',
  exact s.2.symm,
end

lemma exists_mem (s : sym α n.succ) : ∃ a, a ∈ s :=
multiset.card_pos_iff_exists_mem.1 $ s.2.symm ▸ n.succ_pos

lemma exists_eq_cons_of_succ (s : sym α n.succ) : ∃ (a : α) (s' : sym α n), s = a ::ₛ s' :=
begin
  obtain ⟨a, ha⟩ := exists_mem s,
  classical,
  exact ⟨a, s.erase a ha, (cons_erase ha).symm⟩,
end

lemma eq_repeat {a : α} {n : ℕ} {s : sym α n} : s = repeat a n ↔ ∀ b ∈ s, b = a :=
subtype.ext_iff.trans $ multiset.eq_repeat.trans $ and_iff_right s.prop

lemma eq_repeat_of_subsingleton [subsingleton α] (a : α) {n : ℕ} (s : sym α n) : s = repeat a n :=
eq_repeat.2 $ λ b hb, subsingleton.elim _ _

instance [subsingleton α] (n : ℕ) : subsingleton (sym α n) :=
⟨begin
  cases n,
  { simp, },
  { intros s s',
    obtain ⟨b, -⟩ := exists_mem s,
    rw [eq_repeat_of_subsingleton b s', eq_repeat_of_subsingleton b s], },
end⟩

instance inhabited_sym [inhabited α] (n : ℕ) : inhabited (sym α n) :=
⟨repeat default n⟩

instance inhabited_sym' [inhabited α] (n : ℕ) : inhabited (sym' α n) :=
⟨quotient.mk' (vector.repeat default n)⟩

instance (n : ℕ) [is_empty α] : is_empty (sym α n.succ) :=
⟨λ s, by { obtain ⟨a, -⟩ := exists_mem s, exact is_empty_elim a }⟩

instance (n : ℕ) [unique α] : unique (sym α n) := unique.mk' _

lemma repeat_left_inj {a b : α} {n : ℕ} (h : n ≠ 0) : repeat a n = repeat b n ↔ a = b :=
subtype.ext_iff.trans (multiset.repeat_left_inj h)

lemma repeat_left_injective {n : ℕ} (h : n ≠ 0) : function.injective (λ x : α, repeat x n) :=
λ a b, (repeat_left_inj h).1

instance (n : ℕ) [nontrivial α] : nontrivial (sym α (n + 1)) :=
(repeat_left_injective n.succ_ne_zero).nontrivial

/-- A function `α → β` induces a function `sym α n → sym β n` by applying it to every element of
the underlying `n`-tuple. -/
def map {n : ℕ} (f : α → β) (x : sym α n) : sym β n :=
⟨x.val.map f, by simpa [multiset.card_map] using x.property⟩

@[simp] lemma mem_map {n : ℕ} {f : α → β} {b : β} {l : sym α n} :
  b ∈ sym.map f l ↔ ∃ a, a ∈ l ∧ f a = b := multiset.mem_map

/-- Note: `sym.map_id` is not simp-normal, as simp ends up unfolding `id` with `sym.map_congr` -/
@[simp] lemma map_id' {α : Type*} {n : ℕ} (s : sym α n) : sym.map (λ (x : α), x) s = s :=
by simp [sym.map]

lemma map_id {α : Type*} {n : ℕ} (s : sym α n) : sym.map id s = s :=
by simp [sym.map]

@[simp] lemma map_map {α β γ : Type*} {n : ℕ} (g : β → γ) (f : α → β) (s : sym α n) :
  sym.map g (sym.map f s) = sym.map (g ∘ f) s :=
by simp [sym.map]

@[simp] lemma map_zero (f : α → β) :
  sym.map f (0 : sym α 0) = (0 : sym β 0) := rfl

@[simp] lemma map_cons {n : ℕ} (f : α → β) (a : α) (s : sym α n) :
  (a ::ₛ s).map f = (f a) ::ₛ s.map f :=
by simp [map, cons]

@[congr] lemma map_congr {f g : α → β} {s : sym α n} (h : ∀ x ∈ s, f x = g x) :
  map f s = map g s := subtype.ext $ multiset.map_congr rfl h

@[simp] lemma map_mk {f : α → β} {m : multiset α} {hc : m.card = n} :
  map f (mk m hc) = mk (m.map f) (by simp [hc]) := rfl

@[simp] lemma coe_map (s : sym α n) (f : α → β) : ↑(s.map f) = multiset.map f s := rfl

lemma map_injective {f : α → β} (hf : injective f) (n : ℕ) :
  injective (map f : sym α n → sym β n) :=
λ s t h, coe_injective $ multiset.map_injective hf $ coe_inj.2 h

/-- Mapping an equivalence `α ≃ β` using `sym.map` gives an equivalence between `sym α n` and
`sym β n`. -/
@[simps]
def equiv_congr (e : α ≃ β) : sym α n ≃ sym β n :=
{ to_fun := map e,
  inv_fun := map e.symm,
  left_inv := λ x, by rw [map_map, equiv.symm_comp_self, map_id],
  right_inv := λ x, by rw [map_map, equiv.self_comp_symm, map_id] }

/-- "Attach" a proof that `a ∈ s` to each element `a` in `s` to produce
an element of the symmetric power on `{x // x ∈ s}`. -/
def attach (s : sym α n) : sym {x // x ∈ s} n := ⟨s.val.attach, by rw [multiset.card_attach, s.2]⟩

@[simp] lemma attach_mk {m : multiset α} {hc : m.card = n} :
  attach (mk m hc) = mk m.attach (multiset.card_attach.trans hc) := rfl

@[simp] lemma coe_attach (s : sym α n) : (s.attach : multiset {a // a ∈ s}) = multiset.attach s :=
rfl

lemma attach_map_coe (s : sym α n) : s.attach.map coe = s :=
coe_injective $ multiset.attach_map_val _

@[simp] lemma mem_attach (s : sym α n) (x : {x // x ∈ s}) : x ∈ s.attach :=
multiset.mem_attach _ _

@[simp] lemma attach_nil : (nil : sym α 0).attach = nil := rfl

@[simp] lemma attach_cons (x : α) (s : sym α n) :
  (cons x s).attach = cons ⟨x, mem_cons_self _ _⟩ (s.attach.map (λ x, ⟨x, mem_cons_of_mem x.prop⟩))
  :=
coe_injective $ multiset.attach_cons _ _

end sym