/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Aaron Anderson, Yakov Pechersky

! This file was ported from Lean 3 source module group_theory.perm.support
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Card
import Mathlib.Data.Fintype.Basic
import Mathlib.GroupTheory.Perm.Basic
/-!
# support of a permutation

## Main definitions

In the following, `f g : Equiv.Perm α`.

* `Equiv.Perm.Disjoint`: two permutations `f` and `g` are `Disjoint` if every element is fixed
  either by `f`, or by `g`.
  Equivalently, `f` and `g` are `Disjoint` iff their `support` are disjoint.
* `Equiv.Perm.IsSwap`: `f = swap x y` for `x ≠ y`.
* `Equiv.Perm.support`: the elements `x : α` that are not fixed by `f`.

-/

open Equiv Finset

namespace Equiv.Perm

variable {α : Type _}

section Disjoint

/-- Two permutations `f` and `g` are `Disjoint` if their supports are disjoint, i.e.,
every element is fixed either by `f`, or by `g`. -/
def Disjoint (f g : Perm α) :=
  ∀ x, f x = x ∨ g x = x
#align equiv.perm.disjoint Equiv.Perm.Disjoint

variable {f g h : Perm α}

@[symm]
theorem Disjoint.symm : Disjoint f g → Disjoint g f := by simp only [Disjoint, or_comm, imp_self]
#align equiv.perm.disjoint.symm Equiv.Perm.Disjoint.symm

theorem Disjoint.symmetric : Symmetric (@Disjoint α) := fun _ _ => Disjoint.symm
#align equiv.perm.disjoint.symmetric Equiv.Perm.Disjoint.symmetric

instance : IsSymm (Perm α) Disjoint :=
  ⟨Disjoint.symmetric⟩

theorem disjoint_comm : Disjoint f g ↔ Disjoint g f :=
  ⟨Disjoint.symm, Disjoint.symm⟩
#align equiv.perm.disjoint_comm Equiv.Perm.disjoint_comm

theorem Disjoint.commute (h : Disjoint f g) : Commute f g :=
  Equiv.ext fun x =>
    (h x).elim
      (fun hf =>
        (h (g x)).elim (fun hg => by simp [mul_apply, hf, hg]) fun hg => by
          simp [mul_apply, hf, g.injective hg])
      fun hg =>
      (h (f x)).elim (fun hf => by simp [mul_apply, f.injective hf, hg]) fun hf => by
        simp [mul_apply, hf, hg]
#align equiv.perm.disjoint.commute Equiv.Perm.Disjoint.commute

@[simp]
theorem disjoint_one_left (f : Perm α) : Disjoint 1 f := fun _ => Or.inl rfl
#align equiv.perm.disjoint_one_left Equiv.Perm.disjoint_one_left

@[simp]
theorem disjoint_one_right (f : Perm α) : Disjoint f 1 := fun _ => Or.inr rfl
#align equiv.perm.disjoint_one_right Equiv.Perm.disjoint_one_right

theorem disjoint_iff_eq_or_eq : Disjoint f g ↔ ∀ x : α, f x = x ∨ g x = x :=
  Iff.rfl
#align equiv.perm.disjoint_iff_eq_or_eq Equiv.Perm.disjoint_iff_eq_or_eq

@[simp]
theorem disjoint_refl_iff : Disjoint f f ↔ f = 1 := by
  refine' ⟨fun h => _, fun h => h.symm ▸ disjoint_one_left 1⟩
  ext x
  cases' h x with hx hx <;> simp [hx]
#align equiv.perm.disjoint_refl_iff Equiv.Perm.disjoint_refl_iff

theorem Disjoint.inv_left (h : Disjoint f g) : Disjoint f⁻¹ g := by
  intro x
  rw [inv_eq_iff_eq, eq_comm]
  exact h x
#align equiv.perm.disjoint.inv_left Equiv.Perm.Disjoint.inv_left

theorem Disjoint.inv_right (h : Disjoint f g) : Disjoint f g⁻¹ :=
  h.symm.inv_left.symm
#align equiv.perm.disjoint.inv_right Equiv.Perm.Disjoint.inv_right

@[simp]
theorem disjoint_inv_left_iff : Disjoint f⁻¹ g ↔ Disjoint f g := by
  refine' ⟨fun h => _, Disjoint.inv_left⟩
  convert h.inv_left
#align equiv.perm.disjoint_inv_left_iff Equiv.Perm.disjoint_inv_left_iff

@[simp]
theorem disjoint_inv_right_iff : Disjoint f g⁻¹ ↔ Disjoint f g := by
  rw [disjoint_comm, disjoint_inv_left_iff, disjoint_comm]
#align equiv.perm.disjoint_inv_right_iff Equiv.Perm.disjoint_inv_right_iff

theorem Disjoint.mul_left (H1 : Disjoint f h) (H2 : Disjoint g h) : Disjoint (f * g) h := fun x =>
  by cases H1 x <;> cases H2 x <;> simp [*]
#align equiv.perm.disjoint.mul_left Equiv.Perm.Disjoint.mul_left

theorem Disjoint.mul_right (H1 : Disjoint f g) (H2 : Disjoint f h) : Disjoint f (g * h) := by
  rw [disjoint_comm]
  exact H1.symm.mul_left H2.symm
#align equiv.perm.disjoint.mul_right Equiv.Perm.Disjoint.mul_right

theorem disjoint_prod_right (l : List (Perm α)) (h : ∀ g ∈ l, Disjoint f g) : Disjoint f l.prod :=
  by
  induction' l with g l ih
  · exact disjoint_one_right _
  · rw [List.prod_cons]
    exact (h _ (List.mem_cons_self _ _)).mul_right (ih fun g hg => h g (List.mem_cons_of_mem _ hg))
#align equiv.perm.disjoint_prod_right Equiv.Perm.disjoint_prod_right

theorem disjoint_prod_perm {l₁ l₂ : List (Perm α)} (hl : l₁.Pairwise Disjoint) (hp : l₁ ~ l₂) :
    l₁.prod = l₂.prod :=
  hp.prod_eq' <| hl.imp Disjoint.commute
#align equiv.perm.disjoint_prod_perm Equiv.Perm.disjoint_prod_perm

theorem nodup_of_pairwise_disjoint {l : List (Perm α)} (h1 : (1 : Perm α) ∉ l)
     (h2 : l.Pairwise Disjoint) : l.Nodup := by
  refine' List.Pairwise.imp_of_mem _ h2
  intro τ σ h_mem _ h_disjoint _
  subst τ
  suffices (σ : Perm α) = 1 by
    rw [this] at h_mem
    exact h1 h_mem
  exact ext fun a => (or_self_iff _).mp (h_disjoint a)
#align equiv.perm.nodup_of_pairwise_disjoint Equiv.Perm.nodup_of_pairwise_disjoint

theorem pow_apply_eq_self_of_apply_eq_self {x : α} (hfx : f x = x) : ∀ n : ℕ, (f ^ n) x = x
  | 0 => rfl
  | n + 1 => by rw [pow_succ', mul_apply, hfx, pow_apply_eq_self_of_apply_eq_self hfx n]
#align equiv.perm.pow_apply_eq_self_of_apply_eq_self Equiv.Perm.pow_apply_eq_self_of_apply_eq_self

theorem zpow_apply_eq_self_of_apply_eq_self {x : α} (hfx : f x = x) : ∀ n : ℤ, (f ^ n) x = x
  | (n : ℕ) => pow_apply_eq_self_of_apply_eq_self hfx n
  | Int.negSucc n => by rw [zpow_negSucc, inv_eq_iff_eq, pow_apply_eq_self_of_apply_eq_self hfx]
#align equiv.perm.zpow_apply_eq_self_of_apply_eq_self Equiv.Perm.zpow_apply_eq_self_of_apply_eq_self

theorem pow_apply_eq_of_apply_apply_eq_self {x : α} (hffx : f (f x) = x) :
    ∀ n : ℕ, (f ^ n) x = x ∨ (f ^ n) x = f x
  | 0 => Or.inl rfl
  | n + 1 =>
    (pow_apply_eq_of_apply_apply_eq_self hffx n).elim
      (fun h => Or.inr (by rw [pow_succ, mul_apply, h]))
      fun h => Or.inl (by rw [pow_succ, mul_apply, h, hffx])
#align equiv.perm.pow_apply_eq_of_apply_apply_eq_self Equiv.Perm.pow_apply_eq_of_apply_apply_eq_self

theorem zpow_apply_eq_of_apply_apply_eq_self {x : α} (hffx : f (f x) = x) :
    ∀ i : ℤ, (f ^ i) x = x ∨ (f ^ i) x = f x
  | (n : ℕ) => pow_apply_eq_of_apply_apply_eq_self hffx n
  | Int.negSucc n =>
    by
    rw [zpow_negSucc, inv_eq_iff_eq, ← f.injective.eq_iff, ← mul_apply, ← pow_succ, eq_comm,
      inv_eq_iff_eq, ← mul_apply, ← pow_succ', @eq_comm _ x, or_comm]
    exact pow_apply_eq_of_apply_apply_eq_self hffx _
#align equiv.perm.zpow_apply_eq_of_apply_apply_eq_self Equiv.Perm.zpow_apply_eq_of_apply_apply_eq_self

theorem Disjoint.mul_apply_eq_iff {σ τ : Perm α} (hστ : Disjoint σ τ) {a : α} :
    (σ * τ) a = a ↔ σ a = a ∧ τ a = a := by
  refine' ⟨fun h => _, fun h => by rw [mul_apply, h.2, h.1]⟩
  cases' hστ a with hσ hτ
  · exact ⟨hσ, σ.injective (h.trans hσ.symm)⟩
  · exact ⟨(congr_arg σ hτ).symm.trans h, hτ⟩
#align equiv.perm.disjoint.mul_apply_eq_iff Equiv.Perm.Disjoint.mul_apply_eq_iff

theorem Disjoint.mul_eq_one_iff {σ τ : Perm α} (hστ : Disjoint σ τ) : σ * τ = 1 ↔ σ = 1 ∧ τ = 1 :=
  by simp_rw [ext_iff, one_apply, hστ.mul_apply_eq_iff, forall_and]
#align equiv.perm.disjoint.mul_eq_one_iff Equiv.Perm.Disjoint.mul_eq_one_iff

theorem Disjoint.zpow_disjoint_zpow {σ τ : Perm α} (hστ : Disjoint σ τ) (m n : ℤ) :
    Disjoint (σ ^ m) (τ ^ n) := fun x =>
  Or.imp (fun h => zpow_apply_eq_self_of_apply_eq_self h m)
    (fun h => zpow_apply_eq_self_of_apply_eq_self h n) (hστ x)
#align equiv.perm.disjoint.zpow_disjoint_zpow Equiv.Perm.Disjoint.zpow_disjoint_zpow

theorem Disjoint.pow_disjoint_pow {σ τ : Perm α} (hστ : Disjoint σ τ) (m n : ℕ) :
    Disjoint (σ ^ m) (τ ^ n) :=
  hστ.zpow_disjoint_zpow m n
#align equiv.perm.disjoint.pow_disjoint_pow Equiv.Perm.Disjoint.pow_disjoint_pow

end Disjoint

section IsSwap

variable [DecidableEq α]

/-- `f.IsSwap` indicates that the permutation `f` is a transposition of two elements. -/
def IsSwap (f : Perm α) : Prop :=
  ∃ x y, x ≠ y ∧ f = swap x y
#align equiv.perm.is_swap Equiv.Perm.IsSwap

@[simp]
theorem ofSubtype_swap_eq {p : α → Prop} [DecidablePred p] (x y : Subtype p) :
    ofSubtype (Equiv.swap x y) = Equiv.swap ↑x ↑y :=
  Equiv.ext fun z => by
    by_cases hz : p z
    · rw [swap_apply_def, ofSubtype_apply_of_mem _ hz]
      split_ifs with hzx hzy
      · simp_rw [hzx, Subtype.coe_eta, swap_apply_left]
      · simp_rw [hzy, Subtype.coe_eta, swap_apply_right]
      · rw [swap_apply_of_ne_of_ne] <;>
        simp [Subtype.ext_iff, *]
    · rw [ofSubtype_apply_of_not_mem _ hz, swap_apply_of_ne_of_ne]
      intro h
      apply hz
      rw [h]
      exact Subtype.prop x
      intro h
      apply hz
      rw [h]
      exact Subtype.prop y
#align equiv.perm.of_subtype_swap_eq Equiv.Perm.ofSubtype_swap_eq

theorem IsSwap.of_subtype_isSwap {p : α → Prop} [DecidablePred p] {f : Perm (Subtype p)}
    (h : f.IsSwap) : (ofSubtype f).IsSwap :=
  let ⟨⟨x, hx⟩, ⟨y, hy⟩, hxy⟩ := h
  ⟨x, y, by
    simp only [Ne.def, Subtype.ext_iff] at hxy
    exact hxy.1, by
    rw [hxy.2, ofSubtype_swap_eq]⟩
#align equiv.perm.is_swap.of_subtype_is_swap Equiv.Perm.IsSwap.of_subtype_isSwap

theorem ne_and_ne_of_swap_mul_apply_ne_self {f : Perm α} {x y : α} (hy : (swap x (f x) * f) y ≠ y) :
    f y ≠ y ∧ y ≠ x := by
  simp only [swap_apply_def, mul_apply, f.injective.eq_iff] at *
  by_cases h : f y = x
  · constructor <;> intro <;> simp_all only [if_true, eq_self_iff_true, not_true, Ne.def]
  · split_ifs at hy with h h <;> try { subst x } <;> try { simp [*] at * }
#align equiv.perm.ne_and_ne_of_swap_mul_apply_ne_self Equiv.Perm.ne_and_ne_of_swap_mul_apply_ne_self

end IsSwap

section support

section Set

variable (p q : Perm α)

theorem set_support_inv_eq : { x | p⁻¹ x ≠ x } = { x | p x ≠ x } := by
  ext x
  simp only [Set.mem_setOf_eq, Ne.def]
  rw [inv_def, symm_apply_eq, eq_comm]
#align equiv.perm.set_support_inv_eq Equiv.Perm.set_support_inv_eq

theorem set_support_apply_mem {p : Perm α} {a : α} : p a ∈ { x | p x ≠ x } ↔ a ∈ { x | p x ≠ x } :=
  by simp
#align equiv.perm.set_support_apply_mem Equiv.Perm.set_support_apply_mem

theorem set_support_zpow_subset (n : ℤ) : { x | (p ^ n) x ≠ x } ⊆ { x | p x ≠ x } := by
  intro x
  simp only [Set.mem_setOf_eq, Ne.def]
  intro hx H
  simp [zpow_apply_eq_self_of_apply_eq_self H] at hx
#align equiv.perm.set_support_zpow_subset Equiv.Perm.set_support_zpow_subset

theorem set_support_mul_subset : { x | (p * q) x ≠ x } ⊆ { x | p x ≠ x } ∪ { x | q x ≠ x } := by
  intro x
  simp only [Perm.coe_mul, Function.comp_apply, Ne.def, Set.mem_union, Set.mem_setOf_eq]
  by_cases hq : q x = x <;> simp [hq]
#align equiv.perm.set_support_mul_subset Equiv.Perm.set_support_mul_subset

end Set

variable [DecidableEq α] [Fintype α] {f g : Perm α}

/-- The `Finset` of nonfixed points of a permutation. -/
def support (f : Perm α) : Finset α :=
  univ.filter fun x => f x ≠ x
#align equiv.perm.support Equiv.Perm.support

@[simp]
theorem mem_support {x : α} : x ∈ f.support ↔ f x ≠ x := by
  rw [support, mem_filter, and_iff_right (mem_univ x)]
#align equiv.perm.mem_support Equiv.Perm.mem_support

theorem not_mem_support {x : α} : x ∉ f.support ↔ f x = x := by simp
#align equiv.perm.not_mem_support Equiv.Perm.not_mem_support

theorem coe_support_eq_set_support (f : Perm α) : (f.support : Set α) = { x | f x ≠ x } := by
  ext
  simp
#align equiv.perm.coe_support_eq_set_support Equiv.Perm.coe_support_eq_set_support

@[simp]
theorem support_eq_empty_iff {σ : Perm α} : σ.support = ∅ ↔ σ = 1 := by
  simp_rw [Finset.ext_iff, mem_support, Finset.not_mem_empty, iff_false_iff, not_not,
    Equiv.Perm.ext_iff, one_apply]
#align equiv.perm.support_eq_empty_iff Equiv.Perm.support_eq_empty_iff

@[simp]
theorem support_one : (1 : Perm α).support = ∅ := by rw [support_eq_empty_iff]
#align equiv.perm.support_one Equiv.Perm.support_one

@[simp]
theorem support_refl : support (Equiv.refl α) = ∅ :=
  support_one
#align equiv.perm.support_refl Equiv.Perm.support_refl

theorem support_congr (h : f.support ⊆ g.support) (h' : ∀ x ∈ g.support, f x = g x) : f = g := by
  ext x
  by_cases hx : x ∈ g.support
  · exact h' x hx
  · rw [not_mem_support.mp hx, ← not_mem_support]
    exact fun H => hx (h H)
#align equiv.perm.support_congr Equiv.Perm.support_congr

theorem support_mul_le (f g : Perm α) : (f * g).support ≤ f.support ⊔ g.support := fun x => by
  simp only [sup_eq_union]
  rw [mem_union, mem_support, mem_support, mem_support, mul_apply, ← not_and_or, not_imp_not]
  rintro ⟨hf, hg⟩
  rw [hg, hf]
#align equiv.perm.support_mul_le Equiv.Perm.support_mul_le

theorem exists_mem_support_of_mem_support_prod {l : List (Perm α)} {x : α}
    (hx : x ∈ l.prod.support) : ∃ f : Perm α, f ∈ l ∧ x ∈ f.support := by
  contrapose! hx
  simp_rw [mem_support, not_not] at hx⊢
  induction' l with f l ih
  · rfl
  · rw [List.prod_cons, mul_apply, ih, hx]
    simp only [List.find?, List.mem_cons, true_or]
    intros f' hf'
    refine' hx f' _
    simp only [List.find?, List.mem_cons]
    exact Or.inr hf'
#align equiv.perm.exists_mem_support_of_mem_support_prod Equiv.Perm.exists_mem_support_of_mem_support_prod

theorem support_pow_le (σ : Perm α) (n : ℕ) : (σ ^ n).support ≤ σ.support := fun _ h1 =>
  mem_support.mpr fun h2 => mem_support.mp h1 (pow_apply_eq_self_of_apply_eq_self h2 n)
#align equiv.perm.support_pow_le Equiv.Perm.support_pow_le

@[simp]
theorem support_inv (σ : Perm α) : support σ⁻¹ = σ.support := by
  simp_rw [Finset.ext_iff, mem_support, not_iff_not, inv_eq_iff_eq.trans eq_comm, iff_self_iff,
    imp_true_iff]
#align equiv.perm.support_inv Equiv.Perm.support_inv

-- @[simp] -- Porting note: simp can prove this
theorem apply_mem_support {x : α} : f x ∈ f.support ↔ x ∈ f.support := by
  rw [mem_support, mem_support, Ne.def, Ne.def, apply_eq_iff_eq]
#align equiv.perm.apply_mem_support Equiv.Perm.apply_mem_support

-- Porting note: new theorem
@[simp]
theorem apply_pow_apply_eq_iff (f : Perm α) (n : ℕ) {x : α} :
    f ((f ^ n) x) = (f ^ n) x ↔ f x = x := by
  rw [← mul_apply, Commute.self_pow f, mul_apply, apply_eq_iff_eq]

-- @[simp] -- Porting note: simp can prove this
theorem pow_apply_mem_support {n : ℕ} {x : α} : (f ^ n) x ∈ f.support ↔ x ∈ f.support := by
  simp only [mem_support, ne_eq, apply_pow_apply_eq_iff]
#align equiv.perm.pow_apply_mem_support Equiv.Perm.pow_apply_mem_support

-- Porting note: new theorem
@[simp]
theorem apply_zpow_apply_eq_iff (f : Perm α) (n : ℤ) {x : α} :
    f ((f ^ n) x) = (f ^ n) x ↔ f x = x := by
  rw [← mul_apply, Commute.self_zpow f, mul_apply, apply_eq_iff_eq]

-- @[simp] -- Porting note: simp can prove this
theorem zpow_apply_mem_support {n : ℤ} {x : α} : (f ^ n) x ∈ f.support ↔ x ∈ f.support := by
  simp only [mem_support, ne_eq, apply_zpow_apply_eq_iff]
#align equiv.perm.zpow_apply_mem_support Equiv.Perm.zpow_apply_mem_support

theorem pow_eq_on_of_mem_support (h : ∀ x ∈ f.support ∩ g.support, f x = g x) (k : ℕ) :
    ∀ x ∈ f.support ∩ g.support, (f ^ k) x = (g ^ k) x := by
  induction' k with k hk
  · simp
  · intro x hx
    rw [pow_succ', mul_apply, pow_succ', mul_apply, h _ hx, hk]
    rwa [mem_inter, apply_mem_support, ← h _ hx, apply_mem_support, ← mem_inter]
#align equiv.perm.pow_eq_on_of_mem_support Equiv.Perm.pow_eq_on_of_mem_support

theorem disjoint_iff_disjoint_support : Disjoint f g ↔ _root_.Disjoint f.support g.support := by
  simp [disjoint_iff_eq_or_eq, disjoint_iff, disjoint_iff, Finset.ext_iff, not_and_or,
    imp_iff_not_or]
#align equiv.perm.disjoint_iff_disjoint_support Equiv.Perm.disjoint_iff_disjoint_support

theorem Disjoint.disjoint_support (h : Disjoint f g) : _root_.Disjoint f.support g.support :=
  disjoint_iff_disjoint_support.1 h
#align equiv.perm.disjoint.disjoint_support Equiv.Perm.Disjoint.disjoint_support

theorem Disjoint.support_mul (h : Disjoint f g) : (f * g).support = f.support ∪ g.support := by
  refine' le_antisymm (support_mul_le _ _) fun a => _
  rw [mem_union, mem_support, mem_support, mem_support, mul_apply, ← not_and_or, not_imp_not]
  exact
    (h a).elim (fun hf h => ⟨hf, f.apply_eq_iff_eq.mp (h.trans hf.symm)⟩) fun hg h =>
      ⟨(congr_arg f hg).symm.trans h, hg⟩
#align equiv.perm.disjoint.support_mul Equiv.Perm.Disjoint.support_mul

theorem support_prod_of_pairwise_disjoint (l : List (Perm α)) (h : l.Pairwise Disjoint) :
    l.prod.support = (l.map support).foldr (· ⊔ ·) ⊥ := by
  induction' l with hd tl hl
  · simp
  · rw [List.pairwise_cons] at h
    have : Disjoint hd tl.prod := disjoint_prod_right _ h.left
    simp [this.support_mul, hl h.right]
#align equiv.perm.support_prod_of_pairwise_disjoint Equiv.Perm.support_prod_of_pairwise_disjoint

theorem support_prod_le (l : List (Perm α)) : l.prod.support ≤ (l.map support).foldr (· ⊔ ·) ⊥ := by
  induction' l with hd tl hl
  · simp
  · rw [List.prod_cons, List.map_cons, List.foldr_cons]
    refine' (support_mul_le hd tl.prod).trans _
    exact sup_le_sup le_rfl hl
#align equiv.perm.support_prod_le Equiv.Perm.support_prod_le

theorem support_zpow_le (σ : Perm α) (n : ℤ) : (σ ^ n).support ≤ σ.support := fun _ h1 =>
  mem_support.mpr fun h2 => mem_support.mp h1 (zpow_apply_eq_self_of_apply_eq_self h2 n)
#align equiv.perm.support_zpow_le Equiv.Perm.support_zpow_le

@[simp]
theorem support_swap {x y : α} (h : x ≠ y) : support (swap x y) = {x, y} := by
  ext z
  by_cases hx : z = x
  any_goals simpa [hx] using h.symm
  by_cases hy : z = y <;>
  · simp [swap_apply_of_ne_of_ne, hx, hy] <;>
    exact h
#align equiv.perm.support_swap Equiv.Perm.support_swap

theorem support_swap_iff (x y : α) : support (swap x y) = {x, y} ↔ x ≠ y := by
  refine' ⟨fun h => _, fun h => support_swap h⟩
  by_contra'
  rw [← this] at h
  simp only [swap_self, support_refl, pair_eq_singleton] at h
  have : x ∈ ∅ := by
    rw [h]
    exact mem_singleton.mpr rfl
  have := (Finset.ne_empty_of_mem this)
  exact this rfl
#align equiv.perm.support_swap_iff Equiv.Perm.support_swap_iff

theorem support_swap_mul_swap {x y z : α} (h : List.Nodup [x, y, z]) :
    support (swap x y * swap y z) = {x, y, z} := by
  simp only [List.not_mem_nil, and_true_iff, List.mem_cons, not_false_iff, List.nodup_cons,
    List.mem_singleton, and_self_iff, List.nodup_nil] at h
  push_neg  at h
  apply le_antisymm
  · convert support_mul_le (swap x y) (swap y z) using 1
    rw [support_swap h.left.left, support_swap h.right.left]
    simp only [sup_eq_union]
    simp only [mem_singleton, mem_insert, union_insert, insert_union, mem_union, true_or, or_true,
      insert_eq_of_mem]
    rfl
  · intro
    simp only [mem_insert, mem_singleton]
    rintro (rfl | rfl | rfl | _) <;>
      simp [swap_apply_of_ne_of_ne, h.left.left, h.left.left.symm, h.left.right.symm,
        h.left.right.left.symm, h.right.left.symm]

#align equiv.perm.support_swap_mul_swap Equiv.Perm.support_swap_mul_swap

theorem support_swap_mul_ge_support_diff (f : Perm α) (x y : α) :
    f.support \ {x, y} ≤ (swap x y * f).support := by
  intro
  simp only [and_imp, Perm.coe_mul, Function.comp_apply, Ne.def, mem_support, mem_insert, mem_sdiff,
    mem_singleton]
  push_neg
  rintro ha ⟨hx, hy⟩ H
  rw [swap_apply_eq_iff, swap_apply_of_ne_of_ne hx hy] at H
  exact ha H
#align equiv.perm.support_swap_mul_ge_support_diff Equiv.Perm.support_swap_mul_ge_support_diff

theorem support_swap_mul_eq (f : Perm α) (x : α) (h : f (f x) ≠ x) :
    (swap x (f x) * f).support = f.support \ {x} := by
  by_cases hx : f x = x
  · simp [hx, sdiff_singleton_eq_erase, not_mem_support.mpr hx, erase_eq_of_not_mem]
  ext z
  by_cases hzx : z = x
  · simp [hzx]
  by_cases hzf : z = f x
  · simp [hzf, hx, h, swap_apply_of_ne_of_ne]
  by_cases hzfx : f z = x
  · simp [Ne.symm hzx, hzx, Ne.symm hzf, hzfx]
  · simp [Ne.symm hzx, hzx, Ne.symm hzf, hzfx, f.injective.ne hzx, swap_apply_of_ne_of_ne]
#align equiv.perm.support_swap_mul_eq Equiv.Perm.support_swap_mul_eq

theorem mem_support_swap_mul_imp_mem_support_ne {x y : α} (hy : y ∈ support (swap x (f x) * f)) :
    y ∈ support f ∧ y ≠ x := by
  simp only [mem_support, swap_apply_def, mul_apply, f.injective.eq_iff] at *
  by_cases h : f y = x
  · constructor <;> intro <;> simp_all only [if_true, eq_self_iff_true, not_true, Ne.def]
  · split_ifs at hy with hf heq <;>
    simp_all only [not_true]
    exact ⟨h, hy⟩
    refine' ⟨hy, heq⟩
#align equiv.perm.mem_support_swap_mul_imp_mem_support_ne Equiv.Perm.mem_support_swap_mul_imp_mem_support_ne

theorem Disjoint.mem_imp (h : Disjoint f g) {x : α} (hx : x ∈ f.support) : x ∉ g.support :=
  disjoint_left.mp h.disjoint_support hx
#align equiv.perm.disjoint.mem_imp Equiv.Perm.Disjoint.mem_imp

theorem eq_on_support_mem_disjoint {l : List (Perm α)} (h : f ∈ l) (hl : l.Pairwise Disjoint) :
    ∀ x ∈ f.support, f x = l.prod x := by
  induction' l with hd tl IH
  · simp at h
  · intro x hx
    rw [List.pairwise_cons] at hl
    rw [List.mem_cons] at h
    rcases h with (rfl | h)
    ·
      rw [List.prod_cons, mul_apply,
        not_mem_support.mp ((disjoint_prod_right tl hl.left).mem_imp hx)]
    · rw [List.prod_cons, mul_apply, ← IH h hl.right _ hx, eq_comm, ← not_mem_support]
      refine' (hl.left _ h).symm.mem_imp _
      simpa using hx
#align equiv.perm.eq_on_support_mem_disjoint Equiv.Perm.eq_on_support_mem_disjoint

theorem Disjoint.mono {x y : Perm α} (h : Disjoint f g) (hf : x.support ≤ f.support)
    (hg : y.support ≤ g.support) : Disjoint x y := by
  rw [disjoint_iff_disjoint_support] at h⊢
  exact h.mono hf hg
#align equiv.perm.disjoint.mono Equiv.Perm.Disjoint.mono

theorem support_le_prod_of_mem {l : List (Perm α)} (h : f ∈ l) (hl : l.Pairwise Disjoint) :
    f.support ≤ l.prod.support := by
  intro x hx
  rwa [mem_support, ← eq_on_support_mem_disjoint h hl _ hx, ← mem_support]
#align equiv.perm.support_le_prod_of_mem Equiv.Perm.support_le_prod_of_mem

section ExtendDomain

variable {β : Type _} [DecidableEq β] [Fintype β] {p : β → Prop} [DecidablePred p]

@[simp]

theorem card_support_extend_domain (f : α ≃ Subtype p) {g : Perm α} :
    (g.extendDomain f).support.card = g.support.card := by simp
#align equiv.perm.card_support_extend_domain Equiv.Perm.card_support_extend_domain

end ExtendDomain

section Card

-- @[simp] -- Porting note: simp can prove this
theorem card_support_eq_zero {f : Perm α} : f.support.card = 0 ↔ f = 1 := by
  rw [Finset.card_eq_zero, support_eq_empty_iff]
#align equiv.perm.card_support_eq_zero Equiv.Perm.card_support_eq_zero

theorem one_lt_card_support_of_ne_one {f : Perm α} (h : f ≠ 1) : 1 < f.support.card := by
  simp_rw [one_lt_card_iff, mem_support, ← not_or]
  contrapose! h
  ext a
  specialize h (f a) a
  rwa [apply_eq_iff_eq, or_self_iff, or_self_iff] at h
#align equiv.perm.one_lt_card_support_of_ne_one Equiv.Perm.one_lt_card_support_of_ne_one

theorem card_support_ne_one (f : Perm α) : f.support.card ≠ 1 := by
  by_cases h : f = 1
  · exact ne_of_eq_of_ne (card_support_eq_zero.mpr h) zero_ne_one
  · exact ne_of_gt (one_lt_card_support_of_ne_one h)
#align equiv.perm.card_support_ne_one Equiv.Perm.card_support_ne_one

@[simp]
theorem card_support_le_one {f : Perm α} : f.support.card ≤ 1 ↔ f = 1 := by
  rw [le_iff_lt_or_eq, Nat.lt_succ_iff, le_zero_iff, card_support_eq_zero, or_iff_not_imp_right,
    imp_iff_right f.card_support_ne_one]
#align equiv.perm.card_support_le_one Equiv.Perm.card_support_le_one

theorem two_le_card_support_of_ne_one {f : Perm α} (h : f ≠ 1) : 2 ≤ f.support.card :=
  one_lt_card_support_of_ne_one h
#align equiv.perm.two_le_card_support_of_ne_one Equiv.Perm.two_le_card_support_of_ne_one

theorem card_support_swap_mul {f : Perm α} {x : α} (hx : f x ≠ x) :
    (swap x (f x) * f).support.card < f.support.card :=
  Finset.card_lt_card
    ⟨fun z hz => (mem_support_swap_mul_imp_mem_support_ne hz).left, fun h =>
      absurd (h (mem_support.2 hx)) (mt mem_support.1 (by simp))⟩
#align equiv.perm.card_support_swap_mul Equiv.Perm.card_support_swap_mul

theorem card_support_swap {x y : α} (hxy : x ≠ y) : (swap x y).support.card = 2 :=
  show (swap x y).support.card = Finset.card ⟨x ::ₘ y ::ₘ 0, by simp [hxy]⟩ from
    congr_arg card <| by simp [support_swap hxy, *, Finset.ext_iff]
#align equiv.perm.card_support_swap Equiv.Perm.card_support_swap

@[simp]
theorem card_support_eq_two {f : Perm α} : f.support.card = 2 ↔ IsSwap f := by
  constructor <;> intro h
  · obtain ⟨x, t, hmem, hins, ht⟩ := card_eq_succ.1 h
    obtain ⟨y, rfl⟩ := card_eq_one.1 ht
    rw [mem_singleton] at hmem
    refine' ⟨x, y, hmem, _⟩
    ext a
    have key : ∀ b, f b ≠ b ↔ _ := fun b => by rw [← mem_support, ← hins, mem_insert, mem_singleton]
    by_cases ha : f a = a
    · have ha' := not_or.mp (mt (key a).mpr (not_not.mpr ha))
      rw [ha, swap_apply_of_ne_of_ne ha'.1 ha'.2]
    · have ha' := (key (f a)).mp (mt f.apply_eq_iff_eq.mp ha)
      obtain rfl | rfl := (key a).mp ha
      · rw [Or.resolve_left ha' ha, swap_apply_left]
      · rw [Or.resolve_right ha' ha, swap_apply_right]
  · obtain ⟨x, y, hxy, rfl⟩ := h
    exact card_support_swap hxy
#align equiv.perm.card_support_eq_two Equiv.Perm.card_support_eq_two

theorem Disjoint.card_support_mul (h : Disjoint f g) :
    (f * g).support.card = f.support.card + g.support.card := by
  rw [← Finset.card_disjoint_union]
  · congr
    ext
    simp [h.support_mul]
  · simpa using h.disjoint_support
#align equiv.perm.disjoint.card_support_mul Equiv.Perm.Disjoint.card_support_mul

theorem card_support_prod_list_of_pairwise_disjoint {l : List (Perm α)} (h : l.Pairwise Disjoint) :
    l.prod.support.card = (l.map (Finset.card ∘ support)).sum := by
  induction' l with a t ih
  · exact card_support_eq_zero.mpr rfl
  · obtain ⟨ha, ht⟩ := List.pairwise_cons.1 h
    rw [List.prod_cons, List.map_cons, List.sum_cons, ← ih ht]
    exact (disjoint_prod_right _ ha).card_support_mul
#align equiv.perm.card_support_prod_list_of_pairwise_disjoint Equiv.Perm.card_support_prod_list_of_pairwise_disjoint

end Card

end support

@[simp]
theorem support_subtype_perm [DecidableEq α] {s : Finset α} (f : Perm α) (h) :
    ((f.subtypePerm h : Perm { x // x ∈ s }).support)  =
    (s.attach.filter ((fun x => decide (f x ≠ x))) : Finset { x // x ∈ s }) :=
  by
  ext
  simp [Subtype.ext_iff]
#align equiv.perm.support_subtype_perm Equiv.Perm.support_subtype_perm

end Equiv.Perm


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

! This file was ported from Lean 3 source module order.hom.set
! leanprover-community/mathlib commit 198161d833f2c01498c39c266b0b3dbe2c7a8c07
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Hom.Basic
import Mathlib.Logic.Equiv.Set
import Mathlib.Data.Set.Image

/-!
# Order homomorphisms and sets
-/

open OrderDual

variable {F α β γ δ : Type _}

namespace OrderIso

section LE

variable [LE α] [LE β] [LE γ]

theorem range_eq (e : α ≃o β) : Set.range e = Set.univ :=
  e.surjective.range_eq
#align order_iso.range_eq OrderIso.range_eq

@[simp]
theorem symm_image_image (e : α ≃o β) (s : Set α) : e.symm '' (e '' s) = s :=
  e.toEquiv.symm_image_image s
#align order_iso.symm_image_image OrderIso.symm_image_image

@[simp]
theorem image_symm_image (e : α ≃o β) (s : Set β) : e '' (e.symm '' s) = s :=
  e.toEquiv.image_symm_image s
#align order_iso.image_symm_image OrderIso.image_symm_image

theorem image_eq_preimage (e : α ≃o β) (s : Set α) : e '' s = e.symm ⁻¹' s :=
  e.toEquiv.image_eq_preimage s
#align order_iso.image_eq_preimage OrderIso.image_eq_preimage

@[simp]

@[simp]
theorem symm_preimage_preimage (e : α ≃o β) (s : Set β) : e.symm ⁻¹' (e ⁻¹' s) = s :=
  e.toEquiv.symm_preimage_preimage s
#align order_iso.symm_preimage_preimage OrderIso.symm_preimage_preimage

@[simp]
theorem image_preimage (e : α ≃o β) (s : Set β) : e '' (e ⁻¹' s) = s :=
  e.toEquiv.image_preimage s
#align order_iso.image_preimage OrderIso.image_preimage

@[simp]
theorem preimage_image (e : α ≃o β) (s : Set α) : e ⁻¹' (e '' s) = s :=
  e.toEquiv.preimage_image s
#align order_iso.preimage_image OrderIso.preimage_image

end LE

open Set

variable [Preorder α] [Preorder β] [Preorder γ]

/-- Order isomorphism between two equal sets. -/
def setCongr (s t : Set α) (h : s = t) :
    s ≃o t where
  toEquiv := Equiv.setCongr h
  map_rel_iff' := Iff.rfl
#align order_iso.set_congr OrderIso.setCongr

/-- Order isomorphism between `univ : Set α` and `α`. -/
def Set.univ : (Set.univ : Set α) ≃o
      α where
  toEquiv := Equiv.Set.univ α
  map_rel_iff' := Iff.rfl
#align order_iso.set.univ OrderIso.Set.univ

end OrderIso

/-- If a function `f` is strictly monotone on a set `s`, then it defines an order isomorphism
between `s` and its image. -/
protected noncomputable def StrictMonoOn.orderIso {α β} [LinearOrder α] [Preorder β] (f : α → β)
    (s : Set α) (hf : StrictMonoOn f s) :
    s ≃o f '' s where
  toEquiv := hf.injOn.bijOn_image.equiv _
  map_rel_iff' := hf.le_iff_le (Subtype.property _) (Subtype.property _)
#align strict_mono_on.order_iso StrictMonoOn.orderIso

namespace StrictMono

variable [LinearOrder α] [Preorder β]

variable (f : α → β) (h_mono : StrictMono f) (h_surj : Function.Surjective f)

/-- A strictly monotone function from a linear order is an order isomorphism between its domain and
its range. -/
@[simps! apply]
protected noncomputable def orderIso :
    α ≃o Set.range f where
  toEquiv := Equiv.ofInjective f h_mono.injective
  map_rel_iff' := h_mono.le_iff_le
#align strict_mono.order_iso StrictMono.orderIso
#align strict_mono.order_iso_apply StrictMono.orderIso_apply

/-- A strictly monotone surjective function from a linear order is an order isomorphism. -/
noncomputable def orderIsoOfSurjective : α ≃o β :=
  (h_mono.orderIso f).trans <|
    (OrderIso.setCongr _ _ h_surj.range_eq).trans OrderIso.Set.univ
#align strict_mono.order_iso_of_surjective StrictMono.orderIsoOfSurjective

@[simp]
theorem coe_orderIsoOfSurjective : (orderIsoOfSurjective f h_mono h_surj : α → β) = f :=
  rfl
#align strict_mono.coe_order_iso_of_surjective StrictMono.coe_orderIsoOfSurjective

@[simp]
theorem orderIsoOfSurjective_symm_apply_self (a : α) :
    (orderIsoOfSurjective f h_mono h_surj).symm (f a) = a :=
  (orderIsoOfSurjective f h_mono h_surj).symm_apply_apply _
#align strict_mono.order_iso_of_surjective_symm_apply_self StrictMono.orderIsoOfSurjective_symm_apply_self

theorem orderIsoOfSurjective_self_symm_apply (b : β) :
    f ((orderIsoOfSurjective f h_mono h_surj).symm b) = b :=
  (orderIsoOfSurjective f h_mono h_surj).apply_symm_apply _
#align strict_mono.order_iso_of_surjective_self_symm_apply StrictMono.orderIsoOfSurjective_self_symm_apply

end StrictMono

section BooleanAlgebra

variable (α) [BooleanAlgebra α]

/-- Taking complements as an order isomorphism to the order dual. -/
@[simps]
def OrderIso.compl : α ≃o αᵒᵈ where
  toFun := OrderDual.toDual ∘ HasCompl.compl
  invFun := HasCompl.compl ∘ OrderDual.ofDual
  left_inv := compl_compl
  right_inv := compl_compl (α := αᵒᵈ)
  map_rel_iff' := compl_le_compl_iff_le
#align order_iso.compl OrderIso.compl
#align order_iso.compl_symm_apply OrderIso.compl_symm_apply
#align order_iso.compl_apply OrderIso.compl_apply

theorem compl_strictAnti : StrictAnti (compl : α → α) :=
  (OrderIso.compl α).strictMono
#align compl_strict_anti compl_strictAnti

theorem compl_antitone : Antitone (compl : α → α) :=
  (OrderIso.compl α).monotone
#align compl_antitone compl_antitone

end BooleanAlgebra


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Eric Wieser
! This file was ported from Lean 3 source module group_theory.group_action.prod
! leanprover-community/mathlib commit aba57d4d3dae35460225919dcd82fe91355162f9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Prod
import Mathlib.GroupTheory.GroupAction.Defs

/-!
# Prod instances for additive and multiplicative actions
This file defines instances for binary product of additive and multiplicative actions and provides
scalar multiplication as a homomorphism from `α × β` to `β`.
## Main declarations
* `smulMulHom `/`smulMonoidHom `: Scalar multiplication bundled as a multiplicative/monoid
  homomorphism.
## See also
* `Mathlib.GroupTheory.GroupAction.Option`
* `Mathlib.GroupTheory.GroupAction.Pi`
* `Mathlib.GroupTheory.GroupAction.Sigma`
* `Mathlib.GroupTheory.GroupAction.Sum`

# Porting notes
The `to_additive` attribute can be used to generate both the `smul` and `vadd` lemmas
from the corresponding `pow` lemmas, as explained on zulip here:
https://leanprover.zulipchat.com/#narrow/near/316087838

This was not done as part of the port in order to stay as close as possible to the mathlib3 code.
-/

variable {M N P E α β : Type _}

namespace Prod

section

variable [SMul M α] [SMul M β] [SMul N α] [SMul N β] (a : M) (x : α × β)

@[to_additive]
instance smul : SMul M (α × β) :=
  ⟨fun a p => (a • p.1, a • p.2)⟩

@[to_additive (attr := simp)]
theorem smul_fst : (a • x).1 = a • x.1 :=
  rfl
#align prod.smul_fst Prod.smul_fst
#align prod.vadd_fst Prod.vadd_fst

@[to_additive (attr := simp)]
theorem smul_snd : (a • x).2 = a • x.2 :=
  rfl
#align prod.smul_snd Prod.smul_snd
#align prod.vadd_snd Prod.vadd_snd

@[to_additive (attr := simp)]
theorem smul_mk (a : M) (b : α) (c : β) : a • (b, c) = (a • b, a • c) :=
  rfl
#align prod.smul_mk Prod.smul_mk
#align prod.vadd_mk Prod.vadd_mk

@[to_additive]

@[to_additive (attr := simp)]
theorem smul_swap : (a • x).swap = a • x.swap :=
  rfl
#align prod.smul_swap Prod.smul_swap
#align prod.vadd_swap Prod.vadd_swap

theorem smul_zero_mk {α : Type _} [Monoid M] [AddMonoid α] [DistribMulAction M α] (a : M) (c : β) :
    a • ((0 : α), c) = (0, a • c) := by rw [Prod.smul_mk, smul_zero]
#align prod.smul_zero_mk Prod.smul_zero_mk

theorem smul_mk_zero {β : Type _} [Monoid M] [AddMonoid β] [DistribMulAction M β] (a : M) (b : α) :
    a • (b, (0 : β)) = (a • b, 0) := by rw [Prod.smul_mk, smul_zero]
#align prod.smul_mk_zero Prod.smul_mk_zero

variable [Pow α E] [Pow β E]

@[to_additive existing smul]
instance pow : Pow (α × β) E where pow p c := (p.1 ^ c, p.2 ^ c)
#align prod.has_pow Prod.pow
#align prod.has_smul Prod.smul

@[to_additive existing (attr := simp) (reorder := 6) smul_fst]
theorem pow_fst (p : α × β) (c : E) : (p ^ c).fst = p.fst ^ c :=
  rfl
#align prod.pow_fst Prod.pow_fst

@[to_additive existing (attr := simp) (reorder := 6) smul_snd]
theorem pow_snd (p : α × β) (c : E) : (p ^ c).snd = p.snd ^ c :=
  rfl
#align prod.pow_snd Prod.pow_snd

/- Note that the `c` arguments to this lemmas cannot be in the more natural right-most positions due
to limitations in `to_additive` and `to_additive_reorder`, which will silently fail to reorder more
than two adjacent arguments -/
@[to_additive existing (attr := simp) (reorder := 6) smul_mk]
theorem pow_mk (c : E) (a : α) (b : β) : Prod.mk a b ^ c = Prod.mk (a ^ c) (b ^ c) :=
  rfl
#align prod.pow_mk Prod.pow_mk

@[to_additive existing (reorder := 6) smul_def]
theorem pow_def (p : α × β) (c : E) : p ^ c = (p.1 ^ c, p.2 ^ c) :=
  rfl
#align prod.pow_def Prod.pow_def

@[to_additive existing (attr := simp) (reorder := 6) smul_swap]
theorem pow_swap (p : α × β) (c : E) : (p ^ c).swap = p.swap ^ c :=
  rfl
#align prod.pow_swap Prod.pow_swap

@[to_additive vaddAssocClass]
instance isScalarTower [SMul M N] [IsScalarTower M N α] [IsScalarTower M N β] :
    IsScalarTower M N (α × β) :=
  ⟨fun _ _ _ => mk.inj_iff.mpr ⟨smul_assoc _ _ _, smul_assoc _ _ _⟩⟩

@[to_additive]
instance smulCommClass [SMulCommClass M N α] [SMulCommClass M N β] :
    SMulCommClass M N (α × β) where
  smul_comm _ _ _ := mk.inj_iff.mpr ⟨smul_comm _ _ _, smul_comm _ _ _⟩

@[to_additive]
instance isCentralScalar [SMul Mᵐᵒᵖ α] [SMul Mᵐᵒᵖ β] [IsCentralScalar M α] [IsCentralScalar M β] :
    IsCentralScalar M (α × β) :=
  ⟨fun _ _ => Prod.ext (op_smul_eq_smul _ _) (op_smul_eq_smul _ _)⟩
#align prod.is_central_scalar Prod.isCentralScalar
#align prod.is_central_vadd Prod.isCentralVAdd

@[to_additive]
instance faithfulSMulLeft [FaithfulSMul M α] [Nonempty β] : FaithfulSMul M (α × β) :=
  ⟨fun h =>
    let ⟨b⟩ := ‹Nonempty β›
    eq_of_smul_eq_smul fun a : α => by injection h (a, b)⟩
#align prod.has_faithful_smul_left Prod.faithfulSMulLeft
#align prod.has_faithful_vadd_left Prod.faithfulVAddLeft

@[to_additive]
instance faithfulSMulRight [Nonempty α] [FaithfulSMul M β] : FaithfulSMul M (α × β) :=
  ⟨fun h =>
    let ⟨a⟩ := ‹Nonempty α›
    eq_of_smul_eq_smul fun b : β => by injection h (a, b)⟩
#align prod.has_faithful_smul_right Prod.faithfulSMulRight
#align prod.has_faithful_vadd_right Prod.faithfulVAddRight

end

@[to_additive]
instance smulCommClassBoth [Mul N] [Mul P] [SMul M N] [SMul M P] [SMulCommClass M N N]
    [SMulCommClass M P P] : SMulCommClass M (N × P) (N × P) :=
  ⟨fun c x y => by simp [smul_def, mul_def, mul_smul_comm]⟩
#align prod.smul_comm_class_both Prod.smulCommClassBoth
#align prod.vadd_comm_class_both Prod.vaddCommClassBoth

instance isScalarTowerBoth [Mul N] [Mul P] [SMul M N] [SMul M P] [IsScalarTower M N N]
    [IsScalarTower M P P] : IsScalarTower M (N × P) (N × P) :=
  ⟨fun c x y => by simp [smul_def, mul_def, smul_mul_assoc]⟩
#align prod.is_scalar_tower_both Prod.isScalarTowerBoth

@[to_additive]
instance mulAction {_ : Monoid M} [MulAction M α] [MulAction M β] : MulAction M (α × β) where
  mul_smul _ _ _ := mk.inj_iff.mpr ⟨mul_smul _ _ _, mul_smul _ _ _⟩
  one_smul := fun ⟨_, _⟩ => mk.inj_iff.mpr ⟨one_smul _ _, one_smul _ _⟩

instance smulZeroClass {R M N : Type _} [Zero M] [Zero N] [SMulZeroClass R M] [SMulZeroClass R N] :
    SMulZeroClass R (M × N) where smul_zero _ := mk.inj_iff.mpr ⟨smul_zero _, smul_zero _⟩

instance distribSMul {R M N : Type _} [AddZeroClass M] [AddZeroClass N] [DistribSMul R M]
    [DistribSMul R N] : DistribSMul R (M × N) where
  smul_add _ _ _ := mk.inj_iff.mpr ⟨smul_add _ _ _, smul_add _ _ _⟩

instance distribMulAction {R M N : Type _} {_ : Monoid R} [AddMonoid M] [AddMonoid N]
    [DistribMulAction R M] [DistribMulAction R N] : DistribMulAction R (M × N) :=
  { Prod.mulAction, Prod.distribSMul with }

instance mulDistribMulAction {R M N : Type _} {_ : Monoid R} [Monoid M] [Monoid N]
    [MulDistribMulAction R M] [MulDistribMulAction R N] : MulDistribMulAction R (M × N) where
  smul_mul _ _ _ := mk.inj_iff.mpr ⟨smul_mul' _ _ _, smul_mul' _ _ _⟩
  smul_one _ := mk.inj_iff.mpr ⟨smul_one _, smul_one _⟩

end Prod

/-! ### Scalar multiplication as a homomorphism -/

section BundledSMul

/-- Scalar multiplication as a multiplicative homomorphism. -/
@[simps]
def smulMulHom [Monoid α] [Mul β] [MulAction α β] [IsScalarTower α β β] [SMulCommClass α β β] :
    α × β →ₙ* β where
  toFun a := a.1 • a.2
  map_mul' _ _ := (smul_mul_smul _ _ _ _).symm
#align smul_mul_hom smulMulHom
#align smul_mul_hom_apply smulMulHom_apply

/-- Scalar multiplication as a monoid homomorphism. -/
@[simps]
def smulMonoidHom [Monoid α] [MulOneClass β] [MulAction α β] [IsScalarTower α β β]
    [SMulCommClass α β β] : α × β →* β :=
  { smulMulHom with map_one' := one_smul _ _ }
#align smul_monoid_hom smulMonoidHom
#align smul_monoid_hom_apply smulMonoidHom_apply

end BundledSMul


/-
Copyright 2020 Google LLC

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

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

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.borel_space
import data.set.countable
import data.complex.exponential
import formal_ml.ennreal
import formal_ml.nnreal
import formal_ml.sum
import formal_ml.exp_bound

/-
  The Vapnik-Chevronenkis Dimension and its connection to learning is one of the most
  remarkable and fundamental results in machine learning. In particular, it allows us
  to understand simple, infinite hypothesis spaces, like the separating hyperplane,
  and begin to understand the complexity of neural networks. This analysis is also a
  precursor to understanding support vector machines and structural risk.
 -/

lemma filter_union {α:Type*} [decidable_eq α] {S:finset α} {P:α → Prop} [decidable_pred P]:
  finset.filter P S ∪ finset.filter (λ a, ¬P a)  S = S :=
begin
  ext a;split;intro A1,
  {
    simp at A1,
    cases A1 with A1 A1;apply A1.left,
  },
  {
    simp,
    simp [A1],
    apply em,
  },
end

lemma filter_disjoint {α:Type*} [decidable_eq α] {S T:finset α} {P:α → Prop}  [decidable_pred P]:
  disjoint (finset.filter P S) (finset.filter (λ a, ¬P a)  T) :=
begin
  rw finset.disjoint_left,
  intros a B1 B2,
  simp at B1,
  simp at B2,
  apply B2.right,
  apply B1.right,
end

lemma filter_disjoint' {α:Type*} [DE:decidable_eq α] {S:finset α} {P:α → Prop} [DP:decidable_pred P]:
  disjoint (finset.filter P S) (finset.filter (λ a, ¬P a)  S) :=
  @filter_disjoint α DE S S P DP

lemma filter_card {α:Type*} [decidable_eq α] {S:finset α} {P:α → Prop} [decidable_pred P]:
  (finset.filter P S).card + (finset.filter (λ a, ¬P a)  S).card = S.card :=
begin
  have A1:(finset.filter P S ∪ finset.filter (λ a, ¬P a)  S).card = S.card,
  {
    rw filter_union,
  },
  rw ← A1,
  rw finset.card_union_eq,
  apply filter_disjoint,
end

namespace VC_PAC_problem

def Φ:ℕ → ℕ → ℕ
| 0 m := 1
| d 0 := 1
| (nat.succ d) (nat.succ m) :=  Φ (d.succ) m + Φ d m

@[simp]
lemma phi_d_zero_eq_one {d:ℕ}:Φ d 0 = 1 :=
begin
  cases d;unfold Φ,
end

@[simp]
lemma phi_zero_m_eq_one {m:ℕ}:Φ 0 m = 1 :=
begin
  cases m;unfold Φ,
end

lemma phi_succ_succ {d m:ℕ}:Φ d.succ m.succ = Φ d.succ m + Φ d m := rfl

end VC_PAC_problem

/-
  It is important to be able to talk about the VC dimension of a set of sets without
  referring to a particular problem. For that reason, I have placed it outside of the
  VC_PAC_problem.
-/
namespace VC_PAC_problem
section VC_PAC_problem
universe u
variable {α:Type u}
open_locale classical

--The set of restrictions of concepts onto S, conventionally written as Πc(S) and represented as vectors.
noncomputable def restrict_set (C:set (set α)) (S:finset α):finset (finset α) :=
  S.powerset.filter (λ x, ∃ c∈ C, c ∩ (↑S) = (↑x))

--Does there exist a concept that agrees with any subset of S on S?
def shatters (C:set (set α)) (S:finset α):Prop :=
  (restrict_set C S) = S.powerset

--What is the largest extended natural number n such that all finite sets of size ≤ n can be shattered?
--Note that if the VC dimension is infinity, then that means that any finite set can be shattered,
--but it does not say anything about infinite sets. See Kearns and Vazirani, page 51.
--For example, the Borel algebra on the reals shatters every finite set, but does not shatter
--all infinite sets (e.g. it does not shatter the reals themselves), so it has a VC dimension of
--infinity.
--Note: an empty hypothesis space, by this definition, has a VCD of infinity. This may cause problems.
/-noncomputable def VCD (C:set (set α)):enat := Sup {n:enat|∃ (X':finset α), ((X'.card:enat) = n)  ∧
  shatters C (X')}-/

/-
  Consider all sets that can be shattered. What is the supremum of their sizes (in enat)?
 -/
noncomputable def VCD (C:set (set α)):enat := Sup
  ((λ X':finset α, (↑(X'.card):enat)) '' {X':finset α|shatters C (X')})

/-
  Normally, this restriction is defined for sets of exactly size m. However, this
  runs into problems if there do not exist sets of a certain size.
 -/
noncomputable def restrict_set_bound (C:set (set α)) (m:ℕ):nat := Sup ((λ X', (restrict_set C X').card) ''
   {X':finset α|X'.card ≤ m})

lemma restrict_set_subset {C:set (set α)} (S:finset α):restrict_set C S⊆ S.powerset :=
begin
  unfold restrict_set,
  simp,
end

lemma mem_restrict_set_subset {C:set (set α)} {S:finset α} {c:finset α}:c ∈ restrict_set C S →
  c⊆ S :=
begin
  intros A1,
  rw ← finset.mem_powerset,
  have A2:= @restrict_set_subset α C S,
  apply A2,
  apply A1,
end

-- filter (λ x, true)
--{S':set P.X|∃ c ∈ P.C, (S')= c ∩ (S)}
lemma mem_restrict_set {C:set (set α)} (S:finset α) (T:finset α):
  T ∈ restrict_set C S ↔ (∃ c∈ C, c ∩ (↑S) = (↑T)) :=
begin
  unfold restrict_set,
  rw finset.mem_filter,
  split;intros B1,
  {
    apply B1.right,
  },
  {
    split,
    rw finset.mem_powerset,
    cases B1 with c B1,
    cases B1 with B1 B2,
    rw finset.subset_iff,
    intros x A1,
    have B3:= set.inter_subset_right c (↑S),
    rw B2 at B3,
    apply B3,
    simp,
    apply A1,
    apply B1,
  },
end

lemma shatters_iff {C:set (set α)} (S:finset α):
   (shatters C S) ↔ (∀ S'⊆ S, ∃ c∈ C, c ∩(↑S) = (↑S')) :=
begin
  unfold shatters,
  split;intros A1,
  {
    intros S' B1,
    rw finset.ext_iff at A1,
    have B2 := A1 S',
    rw finset.mem_powerset at B2,
    rw ← B2 at B1,
    rw mem_restrict_set at B1,
    apply B1,
  },
  {
    apply finset.subset.antisymm,
    apply restrict_set_subset,
    rw finset.subset_iff,
    intros S' C1,
    rw finset.mem_powerset at C1,
    have C2 := A1 S' C1,
    rw mem_restrict_set,
    apply C2,
  },
end

lemma shatters_def (C:set (set α)) (S:finset α):
  shatters C S = ((restrict_set C S) = S.powerset) := rfl

/-Introducing a trivial upper bound establishes that Sup exists meaningfully (instead
  of a default value of zero).-/
lemma restrict_set_trivial_upper_bound  {C:set (set α)} (X':finset α):
  (restrict_set C X').card ≤ 2^(X'.card) :=
begin
  have B1:(restrict_set C X').card ≤ X'.powerset.card,
  {
    apply finset.card_le_of_subset,
    apply restrict_set_subset,
  },
  apply le_trans B1,
  rw finset.card_powerset,
end

lemma restrict_set_le_upper_bound {C:set (set α)} (X':finset α):
  (restrict_set C X').card ≤ restrict_set_bound C (X'.card) :=
begin
  apply le_cSup,
  rw bdd_above_def,
  unfold upper_bounds,
  apply exists.intro (2^(X'.card)),
  simp,
  intros  X'' A1,
  have A3:2^(X''.card) ≤ 2^(X'.card),
  {
    apply linear_ordered_semiring.pow_monotone one_le_two A1,
    repeat {apply nat.nontrivial},
  },
  apply le_trans _ A3,
  apply restrict_set_trivial_upper_bound,
  simp,
  apply exists.intro X',
  split,
  refl,
  refl,
end

lemma shatters_card_le_VCD {C:set (set α)} {S:finset α}:shatters C S → (S.card:enat) ≤ VCD C :=
begin
  unfold VCD,
  intros A1,
  apply le_Sup,
  simp,
  apply exists.intro S,
  simp [A1],
end

lemma VCD_le {C:set (set α)} {d:enat}:(∀ S:finset α, shatters C S → (↑S.card)  ≤ d) → VCD C ≤ d :=
begin
  intros A1,
  unfold VCD,
  apply Sup_le,
  intros b B1,
  simp at B1,
  cases B1 with X' B1,
  cases B1 with B1 B2,
  subst b,
  apply A1 X' B1,
end

lemma restrict_set_elements_subset_of_VCD_zero {C:set (set α)} {S T U:finset α}:(VCD C = 0) →
  T ∈ (restrict_set C S) → U ∈ (restrict_set C S) → T ⊆ U :=
begin
  intros A1 A2 A3,
  rw finset.subset_iff,
  intros x B1,
  apply by_contradiction,
  intros B2,
  have B3 := (mem_restrict_set _ _).mp A2,
  have B4 := (mem_restrict_set _ _).mp A3,
  cases B3 with c_yes B3,
  cases B4 with c_no B4,
  cases B3 with B3 B5,
  cases B4 with B4 B6,
  have C1:↑T ⊆ c_yes, {rw ← B5,apply set.inter_subset_left},
  have C2:x∈ c_yes,{apply C1,simp,apply B1},
  have C3:c_yes ∩ {x} = {x},
  {ext,split;intros B8A;simp;simp at B8A,apply B8A.right,subst x_1,simp [C2]},
  have C4:↑U ⊆ c_no, {rw ← B6,apply set.inter_subset_left},
  have C5:T ⊆ S,
  {
    rw ← finset.coe_subset,rw ← B5, apply set.inter_subset_right,
  },
  have C6:x ∈ S,
  {
    apply C5, apply B1,
  },
  have C7:x∉ c_no,
  {
    intros C5A,apply B2,rw ← finset.mem_coe,rw ← B6, simp,
    apply and.intro C5A C6,
  },
  have C8:c_no ∩ ↑({x}:finset α) = ↑(∅:finset α),
  {
    simp, apply C7,
  },
  have C9:shatters C {x},
  {
    unfold shatters,
    rw finset.powerset_singleton,
    apply finset.subset.antisymm,
    apply restrict_set_subset,
    rw finset.subset_iff,
    intros X' C9A,
    simp at C9A,cases C9A;subst X';rw mem_restrict_set,
    {apply exists.intro c_no, apply exists.intro B4, exact C8},
    {apply exists.intro c_yes, apply exists.intro B3,simp,apply C3},
  },
  have C10:1 ≤ VCD C,
  {
    apply shatters_card_le_VCD C9,
  },
  rw A1 at C10,
  have C11:(0:enat) < (1:enat) := enat.zero_lt_one,
  rw lt_iff_not_ge at C11,
  apply C11,
  apply C10,
end

lemma restrict_set_elements_eq_of_VCD_zero {C:set (set α)} {S T U:finset α}:(VCD C = 0) →
  T ∈ (restrict_set C S) → U ∈ (restrict_set C S) → T = U :=
begin
  intros A1 A2 A3,
  apply finset.subset.antisymm,
  apply restrict_set_elements_subset_of_VCD_zero A1 A2 A3,
  apply restrict_set_elements_subset_of_VCD_zero A1 A3 A2,
end

lemma mem_restrict_set_of_mem_restrict_set {C:set (set α)} {S₁ S₂ T:finset α}:
  T ∈ restrict_set C S₂ →
  S₁ ⊆ S₂ →
  (T ∩ S₁) ∈ restrict_set C S₁ :=
begin
  repeat {rw mem_restrict_set},
  intros A1 A2,
  cases A1 with c A1,
  apply exists.intro c,
  cases A1 with A1 A3,
  apply exists.intro A1,
  simp,
  rw ← A3,
  rw set.inter_assoc,
  rw ← finset.coe_subset at A2,
  rw set.inter_eq_self_of_subset_right A2,
end

lemma mem_restrict_set_insert {C:set (set α)} {S c:finset α} {x:α}:x∉ S → (x∉ c) →
  ((c ∈ restrict_set C S) ↔ (insert x c ∈ restrict_set C (insert x S)) ∨ c∈ restrict_set C (insert x S))
 :=
begin
  repeat {rw mem_restrict_set},
  intros A1 AX,split;intros A2,
  {
    cases A2 with c' A2,
    cases A2 with A2 A3,
    cases (em (x∈ c')) with B1 B1,
    {
      left,
      apply exists.intro c',
      apply exists.intro A2,
      simp,
      have B2:insert x c' = c' := set.insert_eq_of_mem B1,
      rw ← B2,
      rw ← set.insert_inter,
      rw A3,
    },
    {
      right,
      apply exists.intro c',
      apply exists.intro A2,
      simp,
      rw set.inter_insert_of_not_mem B1,
      apply A3,
    },
  },
  {
    cases A2 with A2 A2;cases A2 with c' A2;cases A2 with A2 A3;
    apply exists.intro c';apply exists.intro A2,
    {
      simp at A3,
      have C1:=set.mem_of_inter_insert A3,
      rw set.inter_insert_of_mem C1 at A3,
      apply set.eq_of_insert_of_not_mem _ _ A3,
      simp,
      intro C2,
      apply A1,
      apply AX,
    },
    {
      ext a;split;intros D1,
      {
        rw ← A3,
        simp at D1,
        simp [D1],
      },
      {
        have D2:a ≠ x,
        {
          intros D2A,
          subst a,
          apply AX D1,
        },
        rw ← A3 at D1,
        simp [D2] at D1,
        simp [D1],
      },
    },
  },
end

lemma mem_restrict_set_erase {C:set (set α)} {S c:finset α} {x:α}:x∉ S → (x∈ c) →
  (c ∈ restrict_set C (insert x S))  → (c.erase x ∈ restrict_set C S)
 :=
begin
  intros A1 A2 A3,
  rw mem_restrict_set_insert A1,
  left,
  rw finset.insert_erase,
  apply A3,
  apply A2,
  apply finset.not_mem_erase,
end

lemma restrict_card_le_one_of_VCD_zero {C:set (set α)} {S:finset α}:(VCD C = 0) →
  (restrict_set C S).card ≤ 1 :=
begin
  intros A1,
  apply finset.card_identical_elements,
  intros T U B1 B2,
  apply restrict_set_elements_eq_of_VCD_zero A1 B1 B2,
end

lemma restrict_set_empty_of_empty {S:finset α}:restrict_set ∅ S = ∅ :=
begin
  ext c,
  rw mem_restrict_set,
  split;intros B1,
  {
    cases B1 with c2 B1,
    cases B1 with B1 B2,
    simp at B1,
    exfalso,
    apply B1,
  },
  {
    exfalso,
    simp at B1,
    apply B1,
  },
end

lemma restrict_set_nonempty_empty {C:set (set α)}:
  set.nonempty C → restrict_set C ∅ = {∅} :=
begin
  intros A1,
  ext c,
  rw mem_restrict_set,split;intros B1,
  {
    simp,
    cases B1 with c' B1,
    cases B1 with B1 B2,
    rw ← finset.coe_inj,
    rw ← B2,
    simp,
  },
  {
    simp at B1,
    subst c,
    rw set.nonempty_def at A1,
    cases A1 with c' A1,
    apply exists.intro c',
    apply exists.intro A1,
    simp,
  },
end

lemma restrict_set_empty_card_le_1 {C:set (set α)}:
  (restrict_set C ∅).card ≤ 1 :=
begin
  cases (set.eq_empty_or_nonempty C) with B1 B1,
  {
    subst C,
    rw restrict_set_empty_of_empty,
    simp,
  },
  {
    rw restrict_set_nonempty_empty B1,
    simp,
  },
end

lemma filter_union {α:Type*} {S:finset α} {P:α → Prop}:
  finset.filter P S ∪ finset.filter (λ a, ¬P a)  S = S :=
begin
  ext a;split;intro A1,
  {
    simp at A1,
    cases A1 with A1 A1;apply A1.left,
  },
  {
    simp,
    simp [A1],
    apply em,
  },
end

lemma recursive_restrict_set_card {C:set (set α)} {x:α} {S:finset α}:x∉ S →
  ((restrict_set C (insert x S)).filter (λ c,(x∉c ∧ (insert x c) ∈ (restrict_set
C (insert x S))))).card + (restrict_set C S).card = (restrict_set C (insert x S)).card :=
begin
  intro A1,
  let Ex := restrict_set C (insert x S),
  let E := restrict_set C S,
  begin
    have B1:Ex = restrict_set C (insert x S) := rfl,
    have B2:E = restrict_set C S := rfl,

    repeat {rw ← B1},
    repeat {rw ← B2},
    rw add_comm,
    rw ← @filter_card _ _ Ex (λ c, x ∈ c),
    simp,
    simp,
    rw ← @filter_card _ _ (finset.filter (λ c, x∉ c) Ex)
       (λ c, (insert x c) ∈ Ex),
    simp,
    repeat {rw finset.filter_filter},
    rw add_comm _ (finset.filter (λ (a : finset α), x ∉ a ∧ insert x a ∉ Ex) Ex).card,
    rw ← add_assoc,
    simp,
    have C1:(finset.filter (λ (a : finset α), x ∉ a ∧ insert x a ∉ Ex) Ex) =
      (finset.filter (λ (a : finset α), insert x a ∉ Ex) E),
    {
      ext c,split;repeat {rw B1};repeat {rw B2};intros C1A;simp at C1A;simp [C1A],
      { rw mem_restrict_set_insert A1 C1A.right.left, apply or.inr C1A.left},
      {
        have C1B:x ∉ c,
        {
          have C1B1:c ⊆ S := mem_restrict_set_subset C1A.left,
          intro C1B2,
          apply A1,
          apply C1B1,
          apply C1B2,
        },
        have C1C := (mem_restrict_set_insert A1 C1B).mp C1A.left,
        simp [C1A.right] at C1C,
        apply and.intro C1C C1B,
      },
    },
    rw C1,
    clear C1,
    have C2:(finset.filter (has_mem.mem x) Ex).card =
      (finset.filter (λ a, insert x a ∈ Ex) E).card ,
    {
      have C2A:(finset.filter (has_mem.mem x) Ex) =
        (finset.filter (λ a, insert x a ∈ Ex) E).image (insert x),
      {
        ext a,split;repeat {rw B1};repeat {rw B2};intros C2A1;simp at C2A1;simp,
        {
          apply exists.intro (a.erase x),
          cases C2A1 with C2A1 C2A2,
          have C2A3:insert x (a.erase x) = a := finset.insert_erase C2A2,
          have C2A4:x ∉ a.erase x := finset.not_mem_erase x a,
          split,
          split,
          apply mem_restrict_set_erase A1 C2A2 C2A1,
          rw C2A3,
          apply C2A1,
          apply C2A3,
        },
        {
          cases C2A1 with c C2A1,
          cases C2A1 with C2A1 C2A2,
          cases C2A1 with C2A1 C2A3,
          subst a,
          simp [C2A3],
        },
      },
      rw C2A,
      clear C2A,
      repeat {rw B1},
      repeat {rw B2},
      apply finset.card_image_of_inj_on,
      intros c C2B c' C2C,
      simp at C2B,
      simp at C2C,
      have C2D:∀ {c'':finset α}, c'' ∈ restrict_set C S → x ∉ c'',
      {
        intros c'' C2D1 C2D3,
        apply A1,
        have C2D2 := mem_restrict_set_subset C2D1,
        apply C2D2,
        apply C2D3,
      },
      apply finset.eq_of_insert_of_not_mem,
      apply C2D C2B.left,
      apply C2D C2C.left,
    },

    rw C2,
    rw  ← @filter_card _ _ E (λ a, insert x a ∈ Ex),
  end
end

lemma enat.le_coe_eq_coe {v:enat} {d:nat}:v ≤ d → ∃ d':ℕ, v = d'  ∧ d' ≤ d :=
begin
  --intros A1,
  apply enat.cases_on v,
  {
    intros A1,
    simp at A1,
    exfalso,
    apply A1,
  },
  {
    intros n A1,
    apply exists.intro n,
    simp at A1,
    simp [A1],
  },
end

lemma phi_monotone_m {d  m₁ m₂:ℕ}:m₁ ≤ m₂ → Φ d m₁ ≤ Φ d m₂ :=
begin
  intros A1,
  rw le_iff_exists_add at A1,
  cases A1 with c A1,
  subst m₂,
  induction c,
  simp,
  have A2:(m₁ + c_n.succ) = (m₁ + c_n).succ := rfl,
  rw A2,
  cases d,
  simp,
  rw phi_succ_succ,
  apply le_trans c_ih,
  simp,
end

lemma phi_le_d_succ {d m:ℕ}:Φ d m ≤ Φ d.succ m :=
begin
  revert d,
  induction m,
  intro d,
  simp,
  intro d,
  rw phi_succ_succ,
  cases d,
  simp,
  rw phi_succ_succ,
  rw add_comm,
  simp,
  apply le_trans m_ih,
  apply m_ih,
end

lemma phi_monotone_d {d₁ d₂ m:ℕ}:d₁ ≤ d₂ → Φ d₁ m ≤ Φ d₂ m :=
begin
  intros A1,
  rw le_iff_exists_add at A1,
  cases A1 with c A1,
  subst d₂,
  induction c,
  simp,
  have A2:(d₁ + c_n.succ) = (d₁ + c_n).succ := rfl,
  rw A2,
  apply le_trans c_ih,
  apply phi_le_d_succ,
end

lemma eq_restrict_set {C:finset (finset α)} {S:finset α}:(∀ c∈ C , c⊆ S)→
  C = restrict_set (C.to_set_of_sets) S :=
begin
  intros A1,
  ext c,split;intros B1,
  {
    rw mem_restrict_set,
    apply exists.intro (↑c),
    split,
    rw finset.mem_to_set_of_sets,
    apply B1,
    have B2 := A1 c B1,
    apply set.inter_eq_self_of_subset_left,
    simp,
    apply B2,
  },
  {
    rw mem_restrict_set at B1,
    cases B1 with c' B1,
    cases B1 with B1 B2,
    rw finset.mem_to_set_of_sets' at B1,
    cases B1 with c'' B1,
    cases B1 with B1 B2,
    subst c',
    rw set.inter_eq_self_of_subset_left at B2,
    simp at B2,
    subst c'',
    apply B1,
    simp,
    apply A1 c'' B1,
  },
end

lemma finite_restrict_set_eq_image {C:finset (finset α)} {S:finset α}:
  (restrict_set C.to_set_of_sets S) = C.image (λ S', S'∩ S) :=
begin
  ext,split;intros A1A,
  {
    simp,
    rw mem_restrict_set at A1A,
    cases A1A with c A1A,
    cases A1A with A1A A1B,
    rw finset.mem_to_set_of_sets' at A1A,
    cases A1A with c' A1A,
    apply exists.intro c',
    cases A1A with A1A A1C,
    rw A1C at A1B,
    rw ← finset.coe_inter at A1B,
    rw finset.coe_inj at A1B,
    apply and.intro A1A A1B,
  },
  {
    simp at A1A,
    cases A1A with c A1A,
    cases A1A with A1A A1B,
    subst a,
    rw mem_restrict_set,
    apply exists.intro (↑c),
    split,
    rw finset.mem_to_set_of_sets,
    apply A1A,
    rw finset.coe_inter,
  },
end

lemma finite_restrict_set_le {C:finset (finset α)} {S:finset α}:
  (restrict_set C.to_set_of_sets S).card ≤ C.card :=
begin
  rw finite_restrict_set_eq_image,
  apply finset.card_image_le,
end

lemma shatters_subset {S:finset α} {x:α} {C:set (set α)} {S':finset α}:x∉S →
   shatters (
          (
            (restrict_set C (insert x S)).filter
            (λ (c:finset α),(x∉c ∧ ((insert x c) ∈ (restrict_set C (insert x S)))))
          ).to_set_of_sets
        ) S'  → S' ⊆ S :=
begin
  intros A1 A2,
  rw shatters_iff at A2,
  have D1A:S' ⊆ S' := finset.subset.refl S',
  have D1B := A2 S' D1A,
  cases D1B with c D1B,
  cases D1B with D1B D1C,
  rw finset.mem_to_set_of_sets' at D1B,
  cases D1B with c' D1B,
  cases D1B with D1B D1D,
  subst c,
  simp at D1B,
  cases D1B with D1B D1E,
  cases D1E with D1E D1F,
  have D1G:= mem_restrict_set_subset D1B,
  rw ← finset.coe_inter at D1C,
  rw finset.coe_inj at D1C,
  have D1H:S'⊆ c',
  {
    rw ← D1C,
    apply finset.inter_subset_left,
  },
  apply finset.subset.trans D1H,
  apply finset.subset_of_not_mem_of_subset_insert D1E D1G,
end

lemma shatters_succ {S:finset α} {x:α} {C:set (set α)} {S':finset α}:x∉S →
   shatters (
          (
            (restrict_set C (insert x S)).filter
            (λ (c:finset α),(x∉c ∧ ((insert x c) ∈ (restrict_set C (insert x S)))))
          ).to_set_of_sets
        ) S'  → shatters C (insert x S') :=
begin
  intros A1 A2,
  rw shatters_iff,
  intros c B1,
  have D1:S' ⊆ S := shatters_subset A1 A2,
  have D2:(insert x (↑S':set α)) ⊆ (insert x ↑S),
  {
    apply set.insert_subset_insert,
    simp,
    apply D1,
  },

  rw shatters_iff at A2,
  cases (em (x ∈ c)) with A3 A3,
  {
    have C1:c.erase x ⊆ S',
    {
      rw ← finset.subset_insert_iff,
      apply B1,
    },
    have B2 := A2 (c.erase x) C1,
    cases B2 with c' B2,
    cases B2 with B2 B3,
    simp,
    rw finset.mem_to_set_of_sets' at B2,
    cases B2 with c'' B2,
    cases B2 with B2 B4,
    simp at B2,
    cases B2 with B2 B5,
    cases B5 with B5 B6,
    rw mem_restrict_set at B6,
    cases B6 with c''' B6,
    cases B6 with B6 B7,
    subst c',
    apply exists.intro c''',
    apply and.intro B6,
    simp at B7,
    rw ← finset.coe_inter at B3,
    rw finset.coe_inj at B3,

    have B8:insert x (c'' ∩ S') = insert x (c.erase x),
    {
      rw B3,
    },
    rw finset.insert_erase A3 at B8,
    have B9 := set.mem_of_inter_insert B7,
    rw ← finset.insert_inter_eq_insert_inter_insert at B8,
    rw ← B8,
    rw finset.coe_inter,
    repeat {rw finset.coe_insert},
    rw ← B7,
    rw set.inter_assoc,
    rw set.inter_comm (insert x ↑S),
    rw ← set.inter_assoc,
    symmetry,
    apply set.inter_eq_self_of_subset_left,
    have B10:=set.inter_subset_right c''' (insert x ↑S'),
    apply set.subset.trans B10 D2,
   },
  {
    have E1:c ⊆ S',
    {
      rw finset.subset_iff,
      intros a E1A,
      have E1B := B1 E1A,
      rw finset.mem_insert at E1B,
      cases E1B with E1B E1B,
      {
        subst a,
        exfalso,
        apply A3 E1A,
      },
      apply E1B,
    },
    have E2 := A2 c E1,
    cases E2 with c' E2,
    cases E2 with E2 E3,
    rw finset.mem_to_set_of_sets' at E2,
    cases E2 with c'' E2,
    cases E2 with E2 E3,
    simp at E2,
    subst c',
    cases E2 with E2 E4,
    cases E4 with E4 E5,
    rw mem_restrict_set at E2,
    cases E2 with c''' E2,
    cases E2 with E2 E6,
    apply exists.intro c''',
    apply exists.intro E2,
    have E7:x ∉ (↑c'':set α),
    {simp [E4]},
    rw ← set.inter_insert_of_not_mem E7 at E3,
    simp at E6,
    rw ← E3,
    simp,
    rw ← E6,
    rw set.inter_assoc,
    rw set.inter_comm (insert x ↑S),
    rw ← set.inter_assoc,
    symmetry,
    apply set.inter_eq_self_of_subset_left,
    have E8:=set.inter_subset_right c''' (insert x ↑S'),
    apply set.subset.trans E8 D2,
  },
end

lemma VCD_succ {S:finset α} {x:α} {C:set (set α)} {d:ℕ}:x∉S → VCD C = d.succ →
    VCD (
          (
            (restrict_set C (insert x S)).filter
            (λ (c:finset α),(x∉c ∧ ((insert x c) ∈ (restrict_set C (insert x S)))))
          ).to_set_of_sets
        ) ≤ d :=
begin
  intros A1 A2,
  apply VCD_le,
  intros T B1,
  have B2:T ⊆ S := shatters_subset A1 B1,
  have B3:x ∉ T,
  {
    intro B3A,
    apply A1,
    apply B2,
    apply B3A,
  },
  have B4:shatters C (insert x T),
  {
    apply shatters_succ,
    apply A1,
    apply B1,
  },
  have B5:((insert x T).card:enat) ≤ VCD C,
  {
    apply shatters_card_le_VCD B4,
  },
  rw A2 at B5,
  simp at B5,
  rw finset.card_insert_of_not_mem B3 at B5,
  have B6:T.card + 1 = (T.card).succ := rfl,
  rw B6 at B5,
  rw nat.succ_le_succ_iff at B5,
  simp,
  apply B5
end

--This is known as Sauer's Lemma, or Sauer-Saleh Lemma.
--This connects VC-dimension to the complexity of the hypothesis space restricted to a finite set
--of certain size.
lemma restrict_set_le_phi {C:set (set α)} {S:finset α} (d:ℕ):
  (VCD C = d) →
  (restrict_set C S).card ≤ Φ d S.card :=
begin
  revert d,
  revert C,
  apply finset.induction_on S,
  {
    intros C d A1,
    simp,
    apply restrict_set_empty_card_le_1,
  },
  {
    intros x S B1 B2 C d B3,
    cases d,
    {
      rw phi_zero_m_eq_one,
      apply restrict_card_le_one_of_VCD_zero,
      simp at B3,
      apply B3,
    },
    let C':finset (finset α) := (restrict_set C (insert x S)).filter (λ c,(x∉c ∧ (insert x c) ∈ (restrict_set C (insert x S)))),
    begin
      have C0:C' = (restrict_set C (insert x S)).filter (λ c,(x∉c ∧ (insert x c) ∈ (restrict_set C (insert x S)))) := rfl,
      rw ← recursive_restrict_set_card B1,
      rw ← C0,
      have D1:C'.card + (restrict_set C S).card ≤ C'.card +  Φ d.succ S.card,
      {
        simp [B2,B3],
      },
      apply le_trans D1,

      have C5:C' = restrict_set (C'.to_set_of_sets) S,
      {
        apply eq_restrict_set,
        intros c C3A,
        rw C0 at C3A,
        simp at C3A,
        have C3C := mem_restrict_set_subset C3A.left,
        apply finset.subset_of_not_mem_of_subset_insert C3A.right.left C3C,
      },
      rw C5,
      have C6:VCD (C'.to_set_of_sets) ≤ (d:enat),
      {
        rw C0,
        apply VCD_succ,
        apply B1,
        apply B3
      },
      have C7:∃d':ℕ, VCD (C'.to_set_of_sets) = d' ∧ d' ≤ d,
      {
        apply enat.le_coe_eq_coe C6,
      },
      cases C7 with d' C7,
      have C8:(restrict_set C'.to_set_of_sets S).card + Φ d.succ S.card ≤ Φ d S.card + Φ d.succ S.card,
      {
        simp,
        have C8A:(restrict_set C'.to_set_of_sets S).card ≤ Φ d' S.card,
        {
          apply B2,
          apply C7.left,
        },
        apply le_trans C8A,
        apply phi_monotone_d,
        apply C7.right,
      },
      apply le_trans C8,
      rw finset.card_insert_of_not_mem B1,
      rw phi_succ_succ,
      rw add_comm,
    end,
  },
end

/- Lemma 3.2 in K+V. -/
lemma phi_sum {d m : ℕ} : Φ d m = (finset.range (d.succ)).sum (λ i, nat.choose m i) :=
begin
  revert d,
  induction m,
  { intros d, simp, rw finset.sum_eq_single 0,
    { refl },
    { intros b h h2, cases b,
      { exfalso, apply h2, refl },
      { rw nat.choose_zero_succ } },
    { intros h, exfalso, apply h, simp }  },
  { intros d, cases d,
    { rw phi_zero_m_eq_one, simp },
    { rw phi_succ_succ,
      rw m_ih, rw m_ih, rw choose_sum_rec }  },
end

/- A key question will be how to handle product measures. Eventually, we need to think
   about either:
1. How to create a product measure, as a technical detail that is factored
   out of the theorem.
2. How to create a stochastic process of IID instances.
3. Assume the existence of a stochastic process.
#2 or #3 is closer to our standard approach. Either way, we need to extend independence to
infinite sets of random variables/events.

-/

lemma shatters_subset' {C:set (set α)} {S:finset α} {T:finset α}:shatters C T → S ⊆ T → shatters C S :=
begin
  haveI:decidable_eq α := classical.decidable_eq α,
  intros h h5,
  rw shatters_iff,
  intros S' h_subset,
  rw shatters_iff at h,
  have h2 := h S' _,
  cases h2 with c h2,
  cases h2 with h2 h3,
  apply exists.intro c,
  apply exists.intro h2,
  apply set.subset.antisymm,
  { rw ← h3,
    apply set.inter_subset_inter, apply set.subset.refl,
    simp, apply h5 },
  { apply set.subset_inter,
    rw ← h3, apply set.inter_subset_left, simp, apply h_subset },
  apply finset.subset.trans,
  apply h_subset,
  apply h5,
end

lemma VCD_le' {C:set (set α)} {d:nat}:(∀ S:finset α, (S.card = (nat.succ d)) → ¬(shatters C S)) → VCD C ≤ ↑d :=
begin
  intros A1,
  apply VCD_le,
  intros S A2,
  apply classical.by_contradiction,
  intros A3,
  rw ← lt_iff_not_ge at A3,
  simp at A3,
  have A4:= nat.succ_le_of_lt A3,
  have A5:∃ (T:finset α), T.card = (d.succ) ∧ T ⊆ S,
  { apply finset.exists_subset_card A4 },
  cases A5 with T A5,
  have A6 := A1 T A5.left,
  apply A6,
  apply @shatters_subset' α C T S,
  apply A2,
  apply A5.right,
end

/- The standard way to prove an exact VC dimension. For a particular size, show that there
   exists a set that can be shattered, and any set one larger can't be shattered. -/
lemma VCD_eq {C:set (set α)} {d:nat} {T:finset α}:T.card = d → (shatters C T) →
(∀ S:finset α, (S.card = (nat.succ d)) → ¬(shatters C S)) → (VCD C = ↑d) := begin
  intros h1 h2 h3,
  apply le_antisymm,
  apply VCD_le',
  apply h3,
  rw ← h1,
  apply shatters_card_le_VCD,
  apply h2
end

--def process {Ω:Type*}:Type :=  probability_space (ℕ → Ω)

-- TODO: introduce ε-nets, and show that the VC dimension of C is a bound on
-- the VC-dimension of the ε-net.
-- TODO: show that if the training examples cover the ε-net, then any consistent
-- algorithm will get a hypothesis with low error.
-- TODO: Introduce the proof from 3.5.2 proving a bound on the probability of
-- hitting the ε-net.
end VC_PAC_problem
end VC_PAC_problem


import .dvd
import .nat_sub
import .induction

namespace hidden

namespace mynat

private lemma mod_lemma {m n : mynat} :
 0 < n ∧ n ≤ m → m - n < m :=
begin
  assume h,
  cases h with h0n hnm,
  have : 0 < m,
    apply lt_le_chain n,
      assumption,
    assumption,
  rw zero_lt_iff_succ at h0n,
  cases h0n with k hk,
  rw hk,
  apply sub_succ_lt,
  from nzero_iff_zero_lt.mpr this,
end

-- I copied this from Lean source :(
private def mod.F (m : mynat)
(f : Π k, k < m → mynat → mynat) (n : mynat) : mynat :=
if h : 0 < n ∧ n ≤ m then f (m - n) (mod_lemma h) n else m

def mod := well_founded.fix lt_well_founded mod.F

instance: has_mod mynat := ⟨mod⟩

lemma mod_def_aux (x y : mynat) : x % y = if h : 0 < y ∧ y ≤ x then (x - y) % y else x :=
congr_fun (well_founded.fix_eq lt_well_founded mod.F x) y

variables {m n k : mynat}

theorem mod_zero: ∀ {m : mynat}, m % 0 = m
| zero     := rfl
| (succ m) := rfl

theorem zero_mod: ∀ {m : mynat}, 0 % m = 0
| zero     := rfl
| (succ m) := rfl

theorem mod_cancel: (m + n) % n = m % n :=
begin
  rw mod_def_aux,
  cases n, {
    rw dif_neg _, {
      rw [zz, mod_zero],
      refl,
    }, {
      from (λ ⟨h, _⟩, lt_nrefl h),
    },
  }, {
    rw dif_pos _, {
      rw add_sub,
    }, {
      split, {
        from zero_lt_succ,
      }, {
        rw add_comm,
        from le_to_add,
      }
    }
  }
end

theorem mod_cancel_lots: (m + k * n) % n = m % n :=
begin
  induction k with k' hk', {
    rw [zz, zero_mul, add_zero],
  }, {
    rw [succ_mul, ←add_assoc, mod_cancel, hk'],
  },
end

theorem zero_mod_iff_dvd: m % n = 0 ↔ n ∣ m :=
begin
  split, {
    -- probably we'll need to define div before we can do this
    sorry,
  }, {
    assume hnm,
    cases hnm with k hk,
    rw hk,
    rw ←zero_add (k * n),
    rw mod_cancel_lots,
    rw zero_mod,
  },
end

end mynat

end hidden


import basic

section
  parameters (S : signature) (X : Type*)

  inductive term
  | var     : X → term
  | app (f : S.F) : (S.ρ f → term) → term

  def free : algebra S :=
  ⟨term, term.app⟩

end

section
  parameters {S : signature} (A : algebra S) (X : Type*)

  open term

  def free_ := free S X
  def var_  := @var S X

  -- Free algebra is really free: existence & uniqueness of homomorphism

  section
    parameter (h : X → A)

    def imap : free_ → A
    | (var .(S) x) := h x
    -- WARNING: need to fully expand composition so Lean doesn't throw a tantrum
    | (app f a)    := A f (λ x, imap $ a x)

    lemma imap_is_hom : homomorphic imap :=
    λ f a, show imap (app f a) = A f (imap ∘ a), from rfl
  end

  lemma hom_unique : ∀ {α β : free_ → A},
  homomorphic α → homomorphic β → α ∘ var_ = β ∘ var_ → α = β :=
  begin
    assume (α β : free_ → A)
           (hα : homomorphic α)
           (hβ : homomorphic β)
           (h : α ∘ var_ = β ∘ var_),

    funext t, show α t = β t,

    induction t with t f a ih,

    show α (var_ t) = β (var_ t),
    { apply congr_fun h t },

    show α (app f a) = β (app f a),
    { have ih' : α ∘ a = β ∘ a, from funext ih,
      calc α (app f a) = A f (α ∘ a) : hα f a
                 ... = A f (β ∘ a) : congr_arg (A f) ih'
                 ... = β (app f a) : (hβ f a).symm }
  end
end


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/

/-
Linear integer arithmetic terms in pre-normalized form.
-/

import tactic.omega.term

namespace omega
namespace int

/-- The shadow syntax for arithmetic terms. All constants are reified to `cst`
(e.g., `-5` is reified to `cst -5`) and all other atomic terms are reified to
`exp` (e.g., `-5 * (gcd 14 -7)` is reified to `exp -5 \`(gcd 14 -7)`).
`exp` accepts a coefficient of type `int` as its first argument because
multiplication by constant is allowed by the omega test. -/
meta inductive exprterm : Type
| cst : int → exprterm
| exp : int → expr → exprterm
| add : exprterm → exprterm → exprterm

/-- Similar to `exprterm`, except that all exprs are now replaced with
de Brujin indices of type `nat`. This is akin to generalizing over
the terms represented by the said exprs. -/
@[derive has_reflect, derive inhabited]
inductive preterm : Type
| cst : int → preterm
| var : int → nat → preterm
| add : preterm → preterm → preterm

localized "notation `&` k    := omega.int.preterm.cst k" in omega.int
localized "infix ` ** ` : 300 := omega.int.preterm.var" in omega.int
localized "notation t `+*` s := omega.int.preterm.add t s" in omega.int

namespace preterm

/-- Preterm evaluation -/
@[simp] def val (v : nat → int) : preterm → int
| (& i) := i
| (i ** n) :=
  if i = 1
  then v n
  else if i = -1
       then -(v n)
       else (v n) * i
| (t1 +* t2) := t1.val + t2.val

/-- Fresh de Brujin index not used by any variable in argument -/
def fresh_index : preterm → nat
| (& _) := 0
| (i ** n) := n + 1
| (t1 +* t2) := max t1.fresh_index t2.fresh_index

@[simp] def add_one (t : preterm) : preterm := t +* (&1)

def repr : preterm → string
| (& i) := i.repr
| (i ** n) := i.repr ++ "*x" ++ n.repr
| (t1 +* t2) := "(" ++ t1.repr ++ " + " ++ t2.repr ++ ")"

end preterm

open_locale list.func -- get notation for list.func.set

/-- Return a term (which is in canonical form by definition)
    that is equivalent to the input preterm -/
@[simp] def canonize : preterm → term
| (& i)      := ⟨i, []⟩
| (i ** n)   := ⟨0, [] {n ↦ i}⟩
| (t1 +* t2) := term.add (canonize t1) (canonize t2)

@[simp] lemma val_canonize {v : nat → int} :
  ∀ {t : preterm}, (canonize t).val v = t.val v
| (& i) :=
  by simp only [preterm.val, add_zero, term.val, canonize, coeffs.val_nil]
| (i ** n)   :=
  begin
    simp only [coeffs.val_set, canonize,
      preterm.val, zero_add, term.val],
    split_ifs with h1 h2,
    { simp only [one_mul, h1] },
    { simp only [neg_mul_eq_neg_mul_symm, one_mul, h2] },
    { rw mul_comm }
  end
| (t +* s) :=
  by simp only [canonize, val_canonize,
     term.val_add, preterm.val]

end int

end omega