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

! This file was ported from Lean 3 source module data.finite.card
! leanprover-community/mathlib commit dde670c9a3f503647fd5bfdf1037bad526d3397a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.SetTheory.Cardinal.Finite

/-!

# Cardinality of finite types

The cardinality of a finite type `α` is given by `Nat.card α`. This function has
the "junk value" of `0` for infinite types, but to ensure the function has valid
output, one just needs to know that it's possible to produce a `Finite` instance
for the type. (Note: we could have defined a `Finite.card` that required you to
supply a `Finite` instance, but (a) the function would be `noncomputable` anyway
so there is no need to supply the instance and (b) the function would have a more
complicated dependent type that easily leads to "motive not type correct" errors.)

## Implementation notes

Theorems about `Nat.card` are sometimes incidentally true for both finite and infinite
types. If removing a finiteness constraint results in no loss in legibility, we remove
it. We generally put such theorems into the `SetTheory.Cardinal.Finite` module.

-/

noncomputable section

open Classical

variable {α β γ : Type _}

/-- There is (noncomputably) an equivalence between a finite type `α` and `Fin (Nat.card α)`. -/
def Finite.equivFin (α : Type _) [Finite α] : α ≃ Fin (Nat.card α) := by
  have := (Finite.exists_equiv_fin α).choose_spec.some
  rwa [Nat.card_eq_of_equiv_fin this]
#align finite.equiv_fin Finite.equivFin

/-- Similar to `Finite.equivFin` but with control over the term used for the cardinality. -/
def Finite.equivFinOfCardEq [Finite α] {n : ℕ} (h : Nat.card α = n) : α ≃ Fin n := by
  subst h
  apply Finite.equivFin
#align finite.equiv_fin_of_card_eq Finite.equivFinOfCardEq

theorem Nat.card_eq (α : Type _) :
    Nat.card α = if h : Finite α then @Fintype.card α (Fintype.ofFinite α) else 0 := by
  cases finite_or_infinite α
  · letI := Fintype.ofFinite α
    simp only [*, Nat.card_eq_fintype_card, dif_pos]
  · simp only [*, card_eq_zero_of_infinite, not_finite_iff_infinite.mpr, dite_false]
#align nat.card_eq Nat.card_eq

theorem Finite.card_pos_iff [Finite α] : 0 < Nat.card α ↔ Nonempty α := by
  haveI := Fintype.ofFinite α
  rw [Nat.card_eq_fintype_card, Fintype.card_pos_iff]
#align finite.card_pos_iff Finite.card_pos_iff

theorem Finite.card_pos [Finite α] [h : Nonempty α] : 0 < Nat.card α :=
  Finite.card_pos_iff.mpr h
#align finite.card_pos Finite.card_pos

namespace Finite

theorem cast_card_eq_mk {α : Type _} [Finite α] : ↑(Nat.card α) = Cardinal.mk α :=
  Cardinal.cast_toNat_of_lt_aleph0 (Cardinal.lt_aleph0_of_finite α)
#align finite.cast_card_eq_mk Finite.cast_card_eq_mk

theorem card_eq [Finite α] [Finite β] : Nat.card α = Nat.card β ↔ Nonempty (α ≃ β) := by
  haveI := Fintype.ofFinite α
  haveI := Fintype.ofFinite β
  simp only [Nat.card_eq_fintype_card, Fintype.card_eq]
#align finite.card_eq Finite.card_eq

theorem card_le_one_iff_subsingleton [Finite α] : Nat.card α ≤ 1 ↔ Subsingleton α := by
  haveI := Fintype.ofFinite α
  simp only [Nat.card_eq_fintype_card, Fintype.card_le_one_iff_subsingleton]
#align finite.card_le_one_iff_subsingleton Finite.card_le_one_iff_subsingleton

theorem one_lt_card_iff_nontrivial [Finite α] : 1 < Nat.card α ↔ Nontrivial α := by
  haveI := Fintype.ofFinite α
  simp only [Nat.card_eq_fintype_card, Fintype.one_lt_card_iff_nontrivial]
#align finite.one_lt_card_iff_nontrivial Finite.one_lt_card_iff_nontrivial

theorem one_lt_card [Finite α] [h : Nontrivial α] : 1 < Nat.card α :=
  one_lt_card_iff_nontrivial.mpr h
#align finite.one_lt_card Finite.one_lt_card

@[simp]
theorem card_option [Finite α] : Nat.card (Option α) = Nat.card α + 1 := by
  haveI := Fintype.ofFinite α
  simp only [Nat.card_eq_fintype_card, Fintype.card_option]
#align finite.card_option Finite.card_option

theorem card_le_of_injective [Finite β] (f : α → β) (hf : Function.Injective f) :
    Nat.card α ≤ Nat.card β := by
  haveI := Fintype.ofFinite β
  haveI := Fintype.ofInjective f hf
  simpa only [Nat.card_eq_fintype_card, ge_iff_le] using Fintype.card_le_of_injective f hf
#align finite.card_le_of_injective Finite.card_le_of_injective

theorem card_le_of_embedding [Finite β] (f : α ↪ β) : Nat.card α ≤ Nat.card β :=
  card_le_of_injective _ f.injective
#align finite.card_le_of_embedding Finite.card_le_of_embedding

theorem card_le_of_surjective [Finite α] (f : α → β) (hf : Function.Surjective f) :
    Nat.card β ≤ Nat.card α := by
  haveI := Fintype.ofFinite α
  haveI := Fintype.ofSurjective f hf
  simpa only [Nat.card_eq_fintype_card, ge_iff_le] using Fintype.card_le_of_surjective f hf
#align finite.card_le_of_surjective Finite.card_le_of_surjective

theorem card_eq_zero_iff [Finite α] : Nat.card α = 0 ↔ IsEmpty α := by
  haveI := Fintype.ofFinite α
  simp only [Nat.card_eq_fintype_card, Fintype.card_eq_zero_iff]
#align finite.card_eq_zero_iff Finite.card_eq_zero_iff

/-- If `f` is injective, then `Nat.card α ≤ Nat.card β`. We must also assume
  `Nat.card β = 0 → Nat.card α = 0` since `Nat.card` is defined to be `0` for infinite types. -/
theorem card_le_of_injective' {f : α → β} (hf : Function.Injective f)
    (h : Nat.card β = 0 → Nat.card α = 0) : Nat.card α ≤ Nat.card β :=
  (or_not_of_imp h).casesOn (fun h => le_of_eq_of_le h zero_le') fun h =>
    @card_le_of_injective α β (Nat.finite_of_card_ne_zero h) f hf
#align finite.card_le_of_injective' Finite.card_le_of_injective'

/-- If `f` is an embedding, then `Nat.card α ≤ Nat.card β`. We must also assume
  `Nat.card β = 0 → Nat.card α = 0` since `Nat.card` is defined to be `0` for infinite types. -/
theorem card_le_of_embedding' (f : α ↪ β) (h : Nat.card β = 0 → Nat.card α = 0) :
    Nat.card α ≤ Nat.card β :=
  card_le_of_injective' f.2 h
#align finite.card_le_of_embedding' Finite.card_le_of_embedding'

/-- If `f` is surjective, then `Nat.card β ≤ Nat.card α`. We must also assume
  `Nat.card α = 0 → Nat.card β = 0` since `Nat.card` is defined to be `0` for infinite types. -/
theorem card_le_of_surjective' {f : α → β} (hf : Function.Surjective f)
    (h : Nat.card α = 0 → Nat.card β = 0) : Nat.card β ≤ Nat.card α :=
  (or_not_of_imp h).casesOn (fun h => le_of_eq_of_le h zero_le') fun h =>
    @card_le_of_surjective α β (Nat.finite_of_card_ne_zero h) f hf
#align finite.card_le_of_surjective' Finite.card_le_of_surjective'

/-- NB: `Nat.card` is defined to be `0` for infinite types. -/
theorem card_eq_zero_of_surjective {f : α → β} (hf : Function.Surjective f) (h : Nat.card β = 0) :
    Nat.card α = 0 := by
  cases finite_or_infinite β
  · haveI := card_eq_zero_iff.mp h
    haveI := Function.isEmpty f
    exact Nat.card_of_isEmpty
  · haveI := Infinite.of_surjective f hf
    exact Nat.card_eq_zero_of_infinite
#align finite.card_eq_zero_of_surjective Finite.card_eq_zero_of_surjective

/-- NB: `Nat.card` is defined to be `0` for infinite types. -/
theorem card_eq_zero_of_injective [Nonempty α] {f : α → β} (hf : Function.Injective f)
    (h : Nat.card α = 0) : Nat.card β = 0 :=
  card_eq_zero_of_surjective (Function.invFun_surjective hf) h
#align finite.card_eq_zero_of_injective Finite.card_eq_zero_of_injective

/-- NB: `Nat.card` is defined to be `0` for infinite types. -/
theorem card_eq_zero_of_embedding [Nonempty α] (f : α ↪ β) (h : Nat.card α = 0) : Nat.card β = 0 :=
  card_eq_zero_of_injective f.2 h
#align finite.card_eq_zero_of_embedding Finite.card_eq_zero_of_embedding

theorem card_sum [Finite α] [Finite β] : Nat.card (Sum α β) = Nat.card α + Nat.card β := by
  haveI := Fintype.ofFinite α
  haveI := Fintype.ofFinite β
  simp only [Nat.card_eq_fintype_card, Fintype.card_sum]
#align finite.card_sum Finite.card_sum

theorem card_image_le {s : Set α} [Finite s] (f : α → β) : Nat.card (f '' s) ≤ Nat.card s :=
  card_le_of_surjective _ Set.surjective_onto_image
#align finite.card_image_le Finite.card_image_le

theorem card_range_le [Finite α] (f : α → β) : Nat.card (Set.range f) ≤ Nat.card α :=
  card_le_of_surjective _ Set.surjective_onto_range
#align finite.card_range_le Finite.card_range_le

theorem card_subtype_le [Finite α] (p : α → Prop) : Nat.card { x // p x } ≤ Nat.card α := by
  haveI := Fintype.ofFinite α
  simpa only [Nat.card_eq_fintype_card, ge_iff_le] using Fintype.card_subtype_le p
#align finite.card_subtype_le Finite.card_subtype_le

theorem card_subtype_lt [Finite α] {p : α → Prop} {x : α} (hx : ¬p x) :
    Nat.card { x // p x } < Nat.card α := by
  haveI := Fintype.ofFinite α
  simpa only [Nat.card_eq_fintype_card, gt_iff_lt] using Fintype.card_subtype_lt hx
#align finite.card_subtype_lt Finite.card_subtype_lt

end Finite

namespace Set

theorem card_union_le (s t : Set α) : Nat.card (↥(s ∪ t)) ≤ Nat.card s + Nat.card t := by
  cases' _root_.finite_or_infinite (↥(s ∪ t)) with h h
  · rw [finite_coe_iff, finite_union, ← finite_coe_iff, ← finite_coe_iff] at h
    cases h
    rw [← Cardinal.natCast_le, Nat.cast_add, Finite.cast_card_eq_mk, Finite.cast_card_eq_mk,
      Finite.cast_card_eq_mk]
    exact Cardinal.mk_union_le s t
  · exact Nat.card_eq_zero_of_infinite.trans_le (zero_le _)
#align set.card_union_le Set.card_union_le

end Set


-- 5.8 Exercises
-- #1

-- 3.7 Exercises
-- #1

variables p q r : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
begin
  apply iff.intro,
    intro h,
    cases h with hp hq,
    exact ⟨hq, hp⟩,
  intro h,
  cases h with hq hp,
  exact ⟨hp, hq⟩
end

example : p ∨ q ↔ q ∨ p :=
begin
  apply iff.intro,
    intro h,
    cases h with hp hq,
      right,
      assumption,
    left,
    assumption,
  intro h,
  cases h with hq hp,
    right,
    assumption,
  left,
  assumption,
end

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
begin
  apply iff.intro,
    intro h,
    cases h with hpq hr,
    cases hpq with hp hq,
    split,
      assumption,
    split,
      assumption,
    assumption,
  intro h,
  cases h with hp hqr,
  cases hqr with hq hr,
  split,
    split,
      assumption,
    assumption,
  assumption
end

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
begin
  apply iff.intro,
    intro h,
    cases h with hpq hr,
      cases hpq with hp hq,
        left,
        assumption,
      right,
      left,
      assumption,
    right,
    right,
    assumption,
  intro h,
  cases h with hp hqr,
    left,
    left,
    assumption,
  cases hqr with hq hr,
    left,
    right,
    assumption,
  right,
  assumption,
end

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    cases h with hp hqr,
    cases hqr with hq hr,
      left,
      apply and.intro, -- equivalent to split
        assumption,
      assumption,
    right,
    split,
      assumption,
    assumption,
  intro h,
  cases h with hpq hpr,
  cases hpq with hp hq,
    split,
      assumption,
    left,
    assumption,
  cases hpr with hp hr,
  split,
    assumption,
  right,
  assumption,
end

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
begin
  apply iff.intro,
    intro h,
    cases h with hp hqr,
      split,
        left,
        assumption,
      left,
      assumption,
    cases hqr with hq hr,
    split,
      right,
      assumption,
    right,
    assumption,
  intro h,
  cases h with hpq hpr,
  cases hpq with hp hq,
    left,
    assumption,
  cases hpr with hp hr,
    left,
    assumption,
  right,
  split,
    assumption,
    assumption,
end

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
begin
  apply iff.intro,
    intros hpqr hpq,
    cases hpq with hp hq,
    apply hpqr,
      assumption,
    assumption,
  intros hpqr hp hq,
  apply hpqr,
  split,
    assumption,
  assumption,
end

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
begin
  apply iff.intro,
    intro h,
    split,
      intro hp,
      apply h,
      left,
      assumption,
    intro hq,
    apply h,
    right,
    assumption,
  intros h hpq,
  cases h with hpr hqr,
  cases hpq with hp hq,
    apply hpr,
    assumption,
  apply hqr,
  assumption,
end

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
begin
  apply iff.intro,
    intro h,
    split,
      intro hp,
      apply h,
      left,
      assumption,
    intro hq,
    apply h,
    right,
    assumption,
  intro h,
  cases h with hnp hnq,
  intro hpq,
  cases hpq with hp hq,
    apply hnp,
    assumption,
  apply hnq,
  assumption,
end

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
begin
  intro h,
  intro hpq,
  cases hpq with hp hq,
  cases h with hnp hnq,
    apply hnp,
    assumption,
  apply hnq,
  assumption,
end

example : ¬(p ∧ ¬p) :=
begin
  intro h,
  cases h with hp hnp,
  apply hnp,
  assumption,
end

example : p ∧ ¬q → ¬(p → q) :=
begin
  intro h,
  intro hpq,
  cases h with hp hnq,
  apply hnq,
  apply hpq,
  assumption,
end

example : ¬p → (p → q) :=
begin
  intros hnp hp,
  exfalso,
  apply hnp,
  assumption,
end

example : (¬p ∨ q) → (p → q) :=
begin
  intros h hp,
  cases h with hnp hq,
    exfalso,
    apply hnp,
    assumption,
  assumption,
end

example : p ∨ false ↔ p :=
begin
  apply iff.intro,
    intro h,
    cases h with hp hf,
      assumption,
    exfalso,
    assumption,
  intro hp,
  left,
  assumption,
end

example : p ∧ false ↔ false :=
begin
  apply iff.intro,
    intro h,
    cases h with hp hf,
    assumption,
  intro hf,
  exfalso,
  assumption,
end

example : (p → q) → (¬q → ¬p) :=
begin
  intros hpq hnq,
  intros hp,
  apply hnq,
  apply hpq,
  assumption,
end


/-
Copyright (c) 2021 Johan Commelin.
All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Damiano Testa, Kevin Buzzard
-/
import algebra.order.monoid

/-!
An example of a `linear_ordered_comm_monoid_with_zero` in which the product of two positive
elements vanishes.

This is the monoid with 3 elements `0, ε, 1` where `ε ^ 2 = 0` and everything else is forced.
The order is `0 < ε < 1`.  Since `ε ^ 2 = 0`, the product of strictly positive elements can vanish.

Relevant Zulip chat:
https://leanprover.zulipchat.com/#narrow/stream/116395-maths/topic/mul_pos
-/

/--  The three element monoid. -/
@[derive [decidable_eq]]
inductive foo
| zero
| eps
| one

namespace foo

instance inhabited : inhabited foo := ⟨zero⟩

instance : has_zero foo := ⟨zero⟩
instance : has_one foo := ⟨one⟩
notation `ε` := eps

/-- The order on `foo` is the one induced by the natural order on the image of `aux1`. -/
def aux1 : foo → ℕ
| 0 := 0
| ε := 1
| 1 := 2

/-- A tactic to prove facts by cases. -/
meta def boom : tactic unit :=
`[repeat {rintro ⟨⟩}; dec_trivial]

lemma aux1_inj : function.injective aux1 :=
by boom

instance : linear_order foo :=
linear_order.lift aux1 $ aux1_inj

/-- Multiplication on `foo`: the only external input is that `ε ^ 2 = 0`. -/
def mul : foo → foo → foo
| 1 x := x
| x 1 := x
| _ _ := 0

instance : comm_monoid foo :=
{ mul := mul,
  one := 1,
  one_mul := by boom,
  mul_one := by boom,
  mul_comm := by boom,
  mul_assoc := by boom }

instance : linear_ordered_comm_monoid_with_zero foo :=
{ zero := 0,
  zero_mul := by boom,
  mul_zero := by boom,
  mul_le_mul_left := by { rintro ⟨⟩ ⟨⟩ h ⟨⟩; revert h; dec_trivial },
  zero_le_one := dec_trivial,
  .. foo.linear_order,
  .. foo.comm_monoid }

lemma not_mul_pos : ¬ ∀ {M : Type} [linear_ordered_comm_monoid_with_zero M], by exactI ∀
  (a b : M) (ha : 0 < a) (hb : 0 < b),
  0 < a * b :=
begin
  intros h,
  specialize h ε ε (by boom) (by boom),
  exact (lt_irrefl 0 (h.trans_le (by boom))).elim,
end

example : 0 < ε ∧ ε * ε = 0 := by boom

end foo


import data.real.basic
open classical
attribute [instance] prop_decidable

/-
  Rigorous definition of a limit
  For a sequence x_n, we say that \lim_{n \to \infty} x_n = l if
    ∀ ε > 0, ∃ N, n ≥ N → |x_n - l| < ε
-/

def lim_to_inf (x : ℕ → ℝ) (l : ℝ) :=
  ∀ ε > 0, ∃ N, ∀ n ≥ N, abs (x n - l) < ε

theorem exercise_1p3 (x y : ℕ → ℝ) (l : ℝ)
  (h₁ : ∀ n, abs (x n - l) ≤ y n) (h₂ : lim_to_inf y 0) :
  lim_to_inf x l :=
begin
    intros ε ε_pos,
    rcases h₂ ε ε_pos with ⟨N, hN⟩,
    use N,
    intros n hn,
    specialize h₁ n,
    specialize hN n hn,
    calc
    abs (x n - l) ≤ y n   : h₁
    ... ≤ abs (y n)       : le_abs_self (y n)
    ... ≤ abs (y n - 0)   : by rw sub_zero (y n)
    ... < ε               : hN,
end


import tactic
import data.zmod.basic
import field_theory.finite.basic
import data.nat.prime_norm_num

/-

# Prove the theorem, due to Kraichik, asserting that 13|2^70+3^70

This is the sixth question in Sierpinski's book "250 elementary problems
in number theory".

-/

example : 13 ∣ 2^70 + 3^70 :=
begin
  sorry,
end


import metric_spaces.basic

noncomputable theory
local attribute [instance] classical.prop_decidable

open set definitions

variables {α X : Type*} [metric_space X]
variables {Y : Type*}   [metric_space Y]

namespace connected

/- We have some equivalent definitions for connected sets
- X is connected
↔ ∃ f : X → {0, 1}, f is continuous then f is a constant function
↔ the only sets that are both open and closed are X and ∅ -/

/- Since working with the set {0, 1} is a hassle, we will define the
inductive type binary containing terms: val_a and val_b -/
inductive binary : Type* | val_a : binary | val_b : binary

lemma binary_cases (y : binary) : y = binary.val_a ∨ y = binary.val_b :=
by cases y; finish

/- We need to show that binary form a metric space so we will define
a discrete metric on binary -/
private def binary_metric : binary → binary → ℝ :=
  λ x y, if (x = y) then 0 else 1

/- We need to prove all the metric axioms -/
private lemma binary_dist_self : ∀ x, binary_metric x x = 0 :=
λ x, by unfold binary_metric; simp

private lemma binary_eq_of_dist_eq_zero :
  ∀ x y, binary_metric x y = 0 → x = y := λ x y h,
begin
  cases x; cases y;
  try { refl <|>
      {	exfalso, apply @zero_ne_one ℝ _, rw ←h,
        unfold binary_metric, simp } }
end

private lemma binary_dist_comm :
  ∀ x y, binary_metric x y = binary_metric y x := λ x y,
by cases x; cases y; try { unfold binary_metric, simp }; refl

private lemma binary_dist_triangle :
  ∀ x y z, binary_metric x z ≤ binary_metric x y + binary_metric y z := λ x y z,
begin
  cases x; cases y; cases z;
  try {	unfold binary_metric, simp };
  norm_num
end

instance metric_space_of_binary : metric_space binary :=
{ dist := binary_metric,
  dist_self := binary_dist_self,
  eq_of_dist_eq_zero := binary_eq_of_dist_eq_zero,
  dist_comm := binary_dist_comm,
  dist_triangle := binary_dist_triangle }

lemma notempty {S : set α} (h : S ≠ ∅) : ∃ s : α, s ∈ S :=
begin
  by_contra hs, push_neg at hs,
  exact (push_neg.not_eq _ _).1 h (set.eq_empty_iff_forall_not_mem.2 hs)
end

private def aux_fun (U : set X) : X → binary :=
  λ x, if (x ∈ U) then binary.val_a else binary.val_b

private lemma aux_fun_eq_val_a {U : set X} : ∀ u ∈ U, aux_fun U u = binary.val_a :=
λ u hu, by unfold aux_fun; split_ifs; refl

private lemma aux_fun_eq_val_b {U : set X} : ∀ u ∉ U, aux_fun U u = binary.val_b :=
λ u hu, by unfold aux_fun; split_ifs; refl

lemma disj_if_inter_empty {U V : set X} (hdisj : U ∩ V = ∅) :
∀ v ∈ V, v ∉ U := λ v hv hu, by rw [←(mem_empty_eq v), ←hdisj]; exact ⟨hu, hv⟩

private lemma aux_fun_is_continuous {U V : set X}
(hU₀ : is_open' U) (hV₀ : is_open' V) (hU₁ : U ≠ ∅) (hV₁ : V ≠ ∅)
(hdisj : U ∩ V = ∅) (hcover : U ∪ V = univ) : is_continuous (aux_fun U) :=
begin
  intros x ε hε, have := mem_univ x,
  rw ←hcover at this, cases this,
    {	rcases hU₀ _ this with ⟨δ, hδ₀, hδ₁⟩,
      refine ⟨δ, hδ₀, λ y hy, _⟩, convert hε,
      have hyU : y ∈ U, apply hδ₁, rw dist_comm at hy, exact hy,
      rw aux_fun_eq_val_a _ this,
      rw aux_fun_eq_val_a _ hyU,
      exact dist_self _ },
    { rcases hV₀ _ this with ⟨δ, hδ₀, hδ₁⟩,
      refine ⟨δ, hδ₀, λ y hy, _⟩, convert hε,
      have hyV : y ∈ V, apply hδ₁, rw dist_comm at hy, exact hy,
      rw aux_fun_eq_val_b x (disj_if_inter_empty hdisj _ this),
      rw aux_fun_eq_val_b y (disj_if_inter_empty hdisj _ hyV),
      exact dist_self _	}
end

lemma connected_of_const_func (h : ∀ f : X → binary, is_continuous f →
  (f = λ _, binary.val_a) ∨ (f = λ _, binary.val_b)) : is_connected' X :=
begin
  rintro ⟨U, V, hU₀, hV₀, hU₁, hV₁, hdisj, hcover⟩,
  have := h (aux_fun U) _,
  cases notempty hU₁ with u hu,	cases notempty hV₁ with v hv,
  apply (show binary.val_a ≠ binary.val_b, by finish),
  cases this; rw function.funext_iff at this,
    { rw ←(this v),
      show (λ (x : X), ite (x ∈ U) binary.val_a binary.val_b) v = binary.val_b,
      simp, split_ifs with hvU,
      exact eq_empty_iff_forall_not_mem.1 hdisj v ⟨hvU, hv⟩, refl },
    { rw ←(this u),
      show binary.val_a = (λ (x : X), ite (x ∈ U) binary.val_a binary.val_b) u,
      simp, split_ifs, refl },
  exact aux_fun_is_continuous hU₀ hV₀ hU₁ hV₁ hdisj hcover
end

private lemma binary_singleton_is_open (x : binary) :
  is_open' ({ x } : set binary) :=
begin
  intros y hy,
  refine ⟨1, (by norm_num), _⟩,
  rw mem_singleton_iff.1 hy, intros z hz,
  simp [dist, binary_metric] at hz,
  split_ifs at hz,
    { exact h ▸ mem_singleton _ },
    { linarith }
end

private lemma not_constant_a {f : X → binary} :
  (¬ f = λ x, binary.val_a) → ∃ x, f x = binary.val_b := λ hf,
begin
  by_contra h, push_neg at h,
  apply hf, ext, have := h x, cases f x; finish,
end

private lemma not_constant_b {f : X → binary} :
  (¬ f = λ x, binary.val_b) → ∃ x, f x = binary.val_a := λ hf,
begin
  by_contra h, push_neg at h,
  apply hf, ext, have := h x, cases f x; finish,
end

lemma const_func_of_connected (h : is_connected' X) :
∀ f : X → binary, is_continuous f →
  (f = λ _, binary.val_a) ∨ (f = λ _, binary.val_b) :=
begin
  by_contra hf, push_neg at hf,
  rcases hf with ⟨f, hf₀, hf₁, hf₂⟩, apply h,
  refine ⟨f ⁻¹' { binary.val_a }, f ⁻¹' { binary.val_b }, _, _, _⟩;
  try { exact open_closed.contin_to_preimg_open _
    (binary_singleton_is_open _) hf₀ },
  cases not_constant_a hf₁ with b hb',
  cases not_constant_b hf₂ with a ha',
  refine ⟨_, _, _, _⟩,
  { intro ha, apply not_mem_empty a, rwa ←ha },
  { intro hb, apply not_mem_empty b, rwa ←hb },
  { by_contra hpre, cases notempty hpre with x hx,
    apply (show binary.val_a ≠ binary.val_b, by finish),
    rw ←(mem_singleton_iff.1 hx.1),
    exact mem_singleton_iff.1 hx.2 },
  ext, split; intro _,
    { exact mem_univ _ },
    { suffices : f x = binary.val_a ∨ f x = binary.val_b,
        cases this, left, exact this, right, exact this,
      cases f x; finish }
end

theorem connected_iff_const_func : is_connected' X ↔ ∀ f : X → binary,
  is_continuous f → (f = λ _, binary.val_a) ∨ (f = λ _, binary.val_b) :=
⟨λ h , const_func_of_connected h, λ h, connected_of_const_func h⟩

/- Furthermore, X is connected is equivalent to the only open sets in X are
univ and ∅ -/
lemma compl_nempty_of_not_univ {S : set X} : ¬S = univ → Sᶜ ≠ ∅ :=
λ h hn, h $ by rw ← compl_univ at hn; exact compl_inj_iff.mp hn

lemma eq_union_sub {S T : set X} (h : S = S ∪ T) : T ⊆ S :=
by intros t ht; rw h; right; assumption

lemma sub_disj_eq_empty {S T : set X} (h : T ⊆ S) (hinter : S ∩ T = ∅) : T = ∅ :=
by rw ←hinter; ext; exact ⟨λ hx, ⟨h hx, hx⟩, λ hx, hx.2 ⟩

lemma compl_eq_disj_cover {S T : set X}
(hinter : S ∩ T = ∅) (hcover : S ∪ T = univ) : Sᶜ = T :=
begin
  ext, split; intro hx,
    { have := mem_univ x,
      rw ←hcover at this,
      cases this; finish },
    { intro hS,
      rw [←mem_empty_eq x, ←hinter],
      exact ⟨hS, hx⟩ }
end

lemma open_and_closed_of_connected (h : is_connected' X)
(S : set X) (hS : is_open' S ∧ is_closed' S) : S = ∅ ∨ S = univ :=
begin
  cases hS with hS₀ hS₁,
  by_contra hp, push_neg at hp, apply h,
  cases notempty hp.1 with x hx,
  exact ⟨S, Sᶜ, hS₀, hS₁, hp.1, compl_nempty_of_not_univ hp.2, by finish⟩
end

lemma connected_of_open_and_closed
(h : ∀ S : set X, is_open' S ∧ is_closed' S → S = ∅ ∨ S = univ) :
is_connected' X :=
begin
  rintro ⟨U, V, hU₀, hV₀, hU₁, hV₁, hinter, hcover⟩,
  cases h U ⟨hU₀, _⟩ with hempt huniv,
    { contradiction },
    { rw ←hcover at huniv,
      refine hV₁ (sub_disj_eq_empty (eq_union_sub huniv) hinter) },
  unfold is_closed',
  rwa compl_eq_disj_cover hinter hcover
end

theorem connected_iff_open_and_closed : is_connected' X ↔
  ∀ S : set X, is_open' S ∧ is_closed' S → S = ∅ ∨ S = univ :=
⟨λ h, open_and_closed_of_connected h, λ h, connected_of_open_and_closed h⟩

lemma image_factorization_contin {U : set X} {f : X → Y}
  (hf : is_continuous f) : is_continuous $ image_factorization f U :=
begin
  unfold image_factorization,
  intros u ε hε,
  rcases hf u.1 ε hε with ⟨δ, hδ₀, hδ₁⟩,
  exact ⟨δ, hδ₀, λ x hx, by simp; exact hδ₁ x.1 hx⟩
end

/- The image of a connected space is connected -/
theorem image_of_connected_is_connected {U : set X} {f : X → Y}
  (hU : is_connected' U) (hf : is_continuous f) : is_connected' $ f '' U :=
begin
  rw connected_iff_const_func at *, intros g hg,
  have := hU (g ∘ image_factorization f U) (continuity.comp_continuous _ hg),
  cases this, left, swap, right,
  all_goals { try
    { ext y, rcases (mem_image f U y.1).1 y.2 with ⟨x, hx₀, hx₁⟩,
      rw (show g y = (g ∘ image_factorization f U) ⟨x, hx₀⟩,
          by simp [function.comp, image_factorization, hx₁]),
      simp [this] } },
  exact image_factorization_contin hf
end

/- ARGGG! This is messy :( -/
theorem between_closure_is_connected_of_connected {U : set X}
  (hU : is_connected' U) : ∀ V, U ⊆ V ∧ V ⊆ closure' U → is_connected' V :=
begin
  rintros V ⟨hV₀, hV₁⟩,
  rw connected_iff_const_func at *,
  rw open_closed.closure'.with_limit_points_is_closure U at hV₁,
  intros f hf, let g : U → binary := λ u, f ⟨u.1, hV₀ u.2⟩,
  cases hU g (open_closed.subset_contin_of_contin hV₀ f g hf rfl),
  left, swap, right,
  all_goals { ext, cases hV₁ x.2 with hinU hlp,
    { try { rw [show binary.val_a = g ⟨x.1, hinU⟩, by simp [h]]
        <|> rw [show binary.val_b = g ⟨x.1, hinU⟩, by simp [h]] },
      show f x = (λ (u : U), f ⟨u.1, hV₀ u.2⟩) ⟨x.val, hinU⟩, simp },
    { choose s h₀ h₁ h₂ using λ n : ℕ, hlp (1 / (n + 1) : ℝ) nat.one_div_pos_of_nat,
      have ha : (λ n, g $ ⟨s n, h₀ n⟩) ⇒ f x := λ ε' hε',
        by { rcases hf x ε' hε' with ⟨δ, hδ₀, hδ₁⟩,
            cases exists_nat_gt (1 / δ) with N hN,
            refine ⟨N, λ n hn, _⟩, rw dist_comm,
            refine hδ₁ ⟨s n, _⟩ (lt_trans _ ((one_div_lt _ hδ₀).2 hN)),
            rw dist_comm, refine lt_of_lt_of_le (h₂ n) _,
            rw [one_div_le, one_div_one_div],
            norm_cast, exact le_add_right hn,
            norm_cast, exact nat.succ_pos n,

            rw one_div_pos, all_goals
              { refine lt_trans (inv_pos.2 hδ₀) _,
                rw inv_eq_one_div, exact hN } },
      refine convergence.limit_unique _ _ ha _,
      rw h, simp [convergence.const_converge] } }
end

/- A direct corollary is that the closure of a connected set is connected -/
theorem closure_is_connected_of_connected {U : set X}
  (hU : is_connected' U) : is_connected' $ closure' U :=
between_closure_is_connected_of_connected hU _
  ⟨open_closed.closure'.subset_closure', subset.refl $ closure' U⟩

end connected


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Type class hierarchy for Boolean algebras.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.bounded_lattice
import Mathlib.PostPort

universes u_1 l u v

namespace Mathlib

/-- Set / lattice complement -/
class has_compl (α : Type u_1)
where
  compl : α → α

postfix:0 "ᶜ" => Mathlib.has_compl.compl

/-- A boolean algebra is a bounded distributive lattice with a
  complementation operation `-` such that `x ⊓ - x = ⊥` and `x ⊔ - x = ⊤`.
  This is a generalization of (classical) logic of propositions, or
  the powerset lattice. -/
class boolean_algebra (α : Type u_1)
extends has_sdiff α, has_compl α, bounded_distrib_lattice α
where
  inf_compl_le_bot : ∀ (x : α), x ⊓ (xᶜ) ≤ ⊥
  top_le_sup_compl : ∀ (x : α), ⊤ ≤ x ⊔ (xᶜ)
  sdiff_eq : ∀ (x y : α), x \ y = x ⊓ (yᶜ)

@[simp] theorem inf_compl_eq_bot {α : Type u} {x : α} [boolean_algebra α] : x ⊓ (xᶜ) = ⊥ :=
  bot_unique (boolean_algebra.inf_compl_le_bot x)

@[simp] theorem compl_inf_eq_bot {α : Type u} {x : α} [boolean_algebra α] : xᶜ ⊓ x = ⊥ :=
  Eq.trans inf_comm inf_compl_eq_bot

@[simp] theorem sup_compl_eq_top {α : Type u} {x : α} [boolean_algebra α] : x ⊔ (xᶜ) = ⊤ :=
  top_unique (boolean_algebra.top_le_sup_compl x)

@[simp] theorem compl_sup_eq_top {α : Type u} {x : α} [boolean_algebra α] : xᶜ ⊔ x = ⊤ :=
  Eq.trans sup_comm sup_compl_eq_top

theorem is_compl_compl {α : Type u} {x : α} [boolean_algebra α] : is_compl x (xᶜ) :=
  is_compl.of_eq inf_compl_eq_bot sup_compl_eq_top

theorem is_compl.compl_eq {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : is_compl x y) : xᶜ = y :=
  Eq.symm (is_compl.right_unique h is_compl_compl)

theorem disjoint_compl_right {α : Type u} {x : α} [boolean_algebra α] : disjoint x (xᶜ) :=
  is_compl.disjoint is_compl_compl

theorem disjoint_compl_left {α : Type u} {x : α} [boolean_algebra α] : disjoint (xᶜ) x :=
  disjoint.symm disjoint_compl_right

theorem sdiff_eq {α : Type u} {x : α} {y : α} [boolean_algebra α] : x \ y = x ⊓ (yᶜ) :=
  boolean_algebra.sdiff_eq x y

theorem compl_unique {α : Type u} {x : α} {y : α} [boolean_algebra α] (i : x ⊓ y = ⊥) (s : x ⊔ y = ⊤) : xᶜ = y :=
  is_compl.compl_eq (is_compl.of_eq i s)

@[simp] theorem compl_top {α : Type u} [boolean_algebra α] : ⊤ᶜ = ⊥ :=
  is_compl.compl_eq is_compl_top_bot

@[simp] theorem compl_bot {α : Type u} [boolean_algebra α] : ⊥ᶜ = ⊤ :=
  is_compl.compl_eq is_compl_bot_top

@[simp] theorem compl_compl {α : Type u} [boolean_algebra α] (x : α) : xᶜᶜ = x :=
  is_compl.compl_eq (is_compl.symm is_compl_compl)

theorem compl_injective {α : Type u} [boolean_algebra α] : function.injective compl :=
  function.involutive.injective compl_compl

@[simp] theorem compl_inj_iff {α : Type u} {x : α} {y : α} [boolean_algebra α] : xᶜ = (yᶜ) ↔ x = y :=
  function.injective.eq_iff compl_injective

theorem is_compl.compl_eq_iff {α : Type u} {x : α} {y : α} {z : α} [boolean_algebra α] (h : is_compl x y) : zᶜ = y ↔ z = x :=
  is_compl.compl_eq h ▸ compl_inj_iff

@[simp] theorem compl_eq_top {α : Type u} {x : α} [boolean_algebra α] : xᶜ = ⊤ ↔ x = ⊥ :=
  is_compl.compl_eq_iff is_compl_bot_top

@[simp] theorem compl_eq_bot {α : Type u} {x : α} [boolean_algebra α] : xᶜ = ⊥ ↔ x = ⊤ :=
  is_compl.compl_eq_iff is_compl_top_bot

@[simp] theorem compl_inf {α : Type u} {x : α} {y : α} [boolean_algebra α] : x ⊓ yᶜ = xᶜ ⊔ (yᶜ) :=
  is_compl.compl_eq (is_compl.inf_sup is_compl_compl is_compl_compl)

@[simp] theorem compl_sup {α : Type u} {x : α} {y : α} [boolean_algebra α] : x ⊔ yᶜ = xᶜ ⊓ (yᶜ) :=
  is_compl.compl_eq (is_compl.sup_inf is_compl_compl is_compl_compl)

theorem compl_le_compl {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : y ≤ x) : xᶜ ≤ (yᶜ) :=
  is_compl.antimono is_compl_compl is_compl_compl h

@[simp] theorem compl_le_compl_iff_le {α : Type u} {x : α} {y : α} [boolean_algebra α] : yᶜ ≤ (xᶜ) ↔ x ≤ y := sorry

theorem le_compl_of_le_compl {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : y ≤ (xᶜ)) : x ≤ (yᶜ) := sorry

theorem compl_le_of_compl_le {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : yᶜ ≤ x) : xᶜ ≤ y := sorry

theorem le_compl_iff_le_compl {α : Type u} {x : α} {y : α} [boolean_algebra α] : y ≤ (xᶜ) ↔ x ≤ (yᶜ) :=
  { mp := le_compl_of_le_compl, mpr := le_compl_of_le_compl }

theorem compl_le_iff_compl_le {α : Type u} {x : α} {y : α} [boolean_algebra α] : xᶜ ≤ y ↔ yᶜ ≤ x :=
  { mp := compl_le_of_compl_le, mpr := compl_le_of_compl_le }

theorem sup_sdiff_same {α : Type u} {x : α} {y : α} [boolean_algebra α] : x ⊔ y \ x = x ⊔ y := sorry

theorem sdiff_eq_left {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : x ⊓ y = ⊥) : x \ y = x := sorry

theorem sdiff_le_sdiff {α : Type u} {w : α} {x : α} {y : α} {z : α} [boolean_algebra α] (h₁ : w ≤ y) (h₂ : z ≤ x) : w \ x ≤ y \ z :=
  eq.mpr (id (Eq._oldrec (Eq.refl (w \ x ≤ y \ z)) sdiff_eq))
    (eq.mpr (id (Eq._oldrec (Eq.refl (w ⊓ (xᶜ) ≤ y \ z)) sdiff_eq)) (inf_le_inf h₁ (compl_le_compl h₂)))

@[simp] theorem sdiff_idem_right {α : Type u} {x : α} {y : α} [boolean_algebra α] : x \ y \ y = x \ y := sorry

protected instance boolean_algebra_Prop : boolean_algebra Prop :=
  boolean_algebra.mk bounded_distrib_lattice.sup bounded_distrib_lattice.le bounded_distrib_lattice.lt sorry sorry sorry
    sorry sorry sorry bounded_distrib_lattice.inf sorry sorry sorry sorry bounded_distrib_lattice.top sorry
    bounded_distrib_lattice.bot sorry Not (fun (p q : Prop) => p ∧ ¬q) sorry sorry sorry

protected instance pi.boolean_algebra {α : Type u} {β : Type v} [boolean_algebra β] : boolean_algebra (α → β) :=
  boolean_algebra.mk (fun (ᾰ ᾰ_1 : α → β) (i : α) => boolean_algebra.sup (ᾰ i) (ᾰ_1 i)) partial_order.le partial_order.lt
    sorry sorry sorry sorry sorry sorry (fun (ᾰ ᾰ_1 : α → β) (i : α) => boolean_algebra.inf (ᾰ i) (ᾰ_1 i)) sorry sorry
    sorry sorry (fun (i : α) => boolean_algebra.top) sorry (fun (i : α) => boolean_algebra.bot) sorry
    (fun (ᾰ : α → β) (i : α) => boolean_algebra.compl (ᾰ i))
    (fun (ᾰ ᾰ_1 : α → β) (i : α) => boolean_algebra.sdiff (ᾰ i) (ᾰ_1 i)) sorry sorry sorry


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark, Kyle Miller
-/
import combinatorics.simple_graph.adj_matrix
import linear_algebra.char_poly.coeff
import data.int.modeq
import data.zmod.basic
import tactic.interval_cases

/-!
# The Friendship Theorem

## Definitions and Statement
- A `friendship` graph is one in which any two distinct vertices have exactly one neighbor in common
- A `politician`, at least in the context of this problem, is a vertex in a graph which is adjacent
  to every other vertex.
- The friendship theorem (Erdős, Rényi, Sós 1966) states that every finite friendship graph has a
  politician.

## Proof outline
The proof revolves around the theory of adjacency matrices, although some steps could equivalently
be phrased in terms of counting walks.
- Assume `G` is a finite friendship graph.
- First we show that any two nonadjacent vertices have the same degree
- Assume for contradiction that `G` does not have a politician.
- Conclude from the last two points that `G` is `d`-regular for some `d : ℕ`.
- Show that `G` has `d ^ 2 - d + 1` vertices.
- By casework, show that if `d = 0, 1, 2`, then `G` has a politician.
- If `3 ≤ d`, let `p` be a prime factor of `d - 1`.
- If `A` is the adjacency matrix of `G` with entries in `ℤ/pℤ`, we show that `A ^ p` has trace `1`.
- This gives a contradiction, as `A` has trace `0`, and thus `A ^ p` has trace `0`.

## References
- [P. Erdős, A. Rényi, V. Sós, *On A Problem of Graph Theory*][erdosrenyisos]
- [C. Huneke, *The Friendship Theorem*][huneke2002]

-/

open_locale classical big_operators
noncomputable theory

open finset simple_graph matrix

universes u v
variables {V : Type u} {R : Type v} [semiring R]

section friendship_def
variables (G : simple_graph V)

/--
This property of a graph is the hypothesis of the friendship theorem:
every pair of nonadjacent vertices has exactly one common friend,
a vertex to which both are adjacent.
-/
def friendship [fintype V] : Prop := ∀ ⦃v w : V⦄, v ≠ w → fintype.card (G.common_neighbors v w) = 1

/--
A politician is a vertex that is adjacent to all other vertices.
-/
def exists_politician : Prop := ∃ (v : V), ∀ (w : V), v ≠ w → G.adj v w

end friendship_def

variables [fintype V] {G : simple_graph V} {d : ℕ} (hG : friendship G)
include hG

namespace friendship

variables (R)
/-- One characterization of a friendship graph is that there is exactly one walk of length 2
  between distinct vertices. These walks are counted in off-diagonal entries of the square of
  the adjacency matrix, so for a friendship graph, those entries are all 1. -/
theorem adj_matrix_sq_of_ne {v w : V} (hvw : v ≠ w) :
  ((G.adj_matrix R) ^ 2) v w = 1 :=
begin
  rw [sq, ← nat.cast_one, ← hG hvw],
  simp [common_neighbors, neighbor_finset_eq_filter, finset.filter_filter, finset.filter_inter,
    and_comm],
end

/-- This calculation amounts to counting the number of length 3 walks between nonadjacent vertices.
  We use it to show that nonadjacent vertices have equal degrees. -/
lemma adj_matrix_pow_three_of_not_adj {v w : V} (non_adj : ¬ G.adj v w) :
  ((G.adj_matrix R) ^ 3) v w = degree G v :=
begin
  rw [pow_succ, mul_eq_mul, adj_matrix_mul_apply, degree, card_eq_sum_ones, sum_nat_cast],
  apply sum_congr rfl,
  intros x hx,
  rw [adj_matrix_sq_of_ne _ hG, nat.cast_one],
  rintro ⟨rfl⟩,
  rw mem_neighbor_finset at hx,
  exact non_adj hx,
end

variable {R}

/-- As `v` and `w` not being adjacent implies
  `degree G v = ((G.adj_matrix R) ^ 3) v w` and `degree G w = ((G.adj_matrix R) ^ 3) v w`,
  the degrees are equal if `((G.adj_matrix R) ^ 3) v w = ((G.adj_matrix R) ^ 3) w v`

  This is true as the adjacency matrix is symmetric. -/
lemma degree_eq_of_not_adj {v w : V} (hvw : ¬ G.adj v w) :
  degree G v = degree G w :=
begin
  rw [← nat.cast_id (G.degree v), ← nat.cast_id (G.degree w),
      ← adj_matrix_pow_three_of_not_adj ℕ hG hvw,
      ← adj_matrix_pow_three_of_not_adj ℕ hG (λ h, hvw (G.sym h))],
  conv_lhs {rw ← transpose_adj_matrix},
  simp only [pow_succ, sq, mul_eq_mul, ← transpose_mul, transpose_apply],
  simp only [← mul_eq_mul, mul_assoc],
end

/-- Let `A` be the adjacency matrix of a graph `G`.
  If `G` is a friendship graph, then all of the off-diagonal entries of `A^2` are 1.
  If `G` is `d`-regular, then all of the diagonal entries of `A^2` are `d`.
  Putting these together determines `A^2` exactly for a `d`-regular friendship graph. -/
theorem adj_matrix_sq_of_regular (hd : G.is_regular_of_degree d) :
  ((G.adj_matrix R) ^ 2) = λ v w, if v = w then d else 1 :=
begin
  ext v w, by_cases h : v = w,
  { rw [h, sq, mul_eq_mul, adj_matrix_mul_self_apply_self, hd], simp, },
  { rw [adj_matrix_sq_of_ne R hG h, if_neg h], },
end

lemma adj_matrix_sq_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1)
  (hd : G.is_regular_of_degree d) :
  (G.adj_matrix (zmod p)) ^ 2 = λ _ _, 1 :=
by simp [adj_matrix_sq_of_regular hG hd, dmod]

section nonempty

variable [nonempty V]

/-- If `G` is a friendship graph without a politician (a vertex adjacent to all others), then
  it is regular. We have shown that nonadjacent vertices of a friendship graph have the same degree,
  and if there isn't a politician, we can show this for adjacent vertices by finding a vertex
  neither is adjacent to, and then using transitivity. -/
theorem is_regular_of_not_exists_politician (hG' : ¬exists_politician G) :
  ∃ (d : ℕ), G.is_regular_of_degree d :=
begin
  have v := classical.arbitrary V,
  use G.degree v,
  intro x,
  by_cases hvx : G.adj v x, swap, { exact (degree_eq_of_not_adj hG hvx).symm, },
  dunfold exists_politician at hG',
  push_neg at hG',
  rcases hG' v with ⟨w, hvw', hvw⟩,
  rcases hG' x with ⟨y, hxy', hxy⟩,
  by_cases hxw : G.adj x w,
    swap, { rw degree_eq_of_not_adj hG hvw, exact degree_eq_of_not_adj hG hxw },
  rw degree_eq_of_not_adj hG hxy,
  by_cases hvy : G.adj v y,
    swap, { exact (degree_eq_of_not_adj hG hvy).symm },
  rw degree_eq_of_not_adj hG hvw,
  apply degree_eq_of_not_adj hG,
  intro hcontra,
  rcases finset.card_eq_one.mp (hG hvw') with ⟨⟨a, ha⟩, h⟩,
  have key : ∀ {x}, x ∈ G.common_neighbors v w → x = a,
  { intros x hx,
    have h' := mem_univ (subtype.mk x hx),
    rw [h, mem_singleton] at h',
    injection h', },
  apply hxy',
  rw [key ((mem_common_neighbors G).mpr ⟨hvx, G.sym hxw⟩),
      key ((mem_common_neighbors G).mpr ⟨hvy, G.sym hcontra⟩)],
end

/-- Let `A` be the adjacency matrix of a `d`-regular friendship graph, and let `v` be a vector
  all of whose components are `1`. Then `v` is an eigenvector of `A ^ 2`, and we can compute
  the eigenvalue to be `d * d`, or as `d + (fintype.card V - 1)`, so those quantities must be equal.

  This essentially means that the graph has `d ^ 2 - d + 1` vertices. -/
lemma card_of_regular (hd : G.is_regular_of_degree d) :
  d + (fintype.card V - 1) = d * d :=
begin
  have v := classical.arbitrary V,
  transitivity ((G.adj_matrix ℕ) ^ 2).mul_vec (λ _, 1) v,
  { rw [adj_matrix_sq_of_regular hG hd, mul_vec, dot_product, ← insert_erase (mem_univ v)],
    simp only [sum_insert, mul_one, if_true, nat.cast_id, eq_self_iff_true,
               mem_erase, not_true, ne.def, not_false_iff, add_right_inj, false_and],
    rw [finset.sum_const_nat, card_erase_of_mem (mem_univ v), mul_one], { refl },
    intros x hx, simp [(ne_of_mem_erase hx).symm], },
  { rw [sq, mul_eq_mul, ← mul_vec_mul_vec],
    simp [adj_matrix_mul_vec_const_apply_of_regular hd, neighbor_finset,
          card_neighbor_set_eq_degree, hd v], }
end

/-- The size of a `d`-regular friendship graph is `1 mod (d-1)`, and thus `1 mod p` for a
  factor `p ∣ d-1`. -/
lemma card_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) (hd : G.is_regular_of_degree d) :
  (fintype.card V : zmod p) = 1 :=
begin
  have hpos : 0 < fintype.card V := fintype.card_pos_iff.mpr infer_instance,
  rw [← nat.succ_pred_eq_of_pos hpos, nat.succ_eq_add_one, nat.pred_eq_sub_one],
  simp only [add_left_eq_self, nat.cast_add, nat.cast_one],
  have h := congr_arg (λ n, (↑n : zmod p)) (card_of_regular hG hd),
  revert h, simp [dmod],
end

end nonempty

omit hG

lemma adj_matrix_sq_mul_const_one_of_regular (hd : G.is_regular_of_degree d) :
  (G.adj_matrix R) * (λ _ _, 1) = λ _ _, d :=
by { ext x, simp [← hd x, degree] }

lemma adj_matrix_mul_const_one_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1)
  (hd : G.is_regular_of_degree d) :
  (G.adj_matrix (zmod p)) * (λ _ _, 1) = λ _ _, 1 :=
by rw [adj_matrix_sq_mul_const_one_of_regular hd, dmod]

include hG

/-- Modulo a factor of `d-1`, the square and all higher powers of the adjacency matrix
  of a `d`-regular friendship graph reduce to the matrix whose entries are all 1. -/
lemma adj_matrix_pow_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1)
  (hd : G.is_regular_of_degree d) {k : ℕ} (hk : 2 ≤ k) :
  (G.adj_matrix (zmod p)) ^ k = λ _ _, 1 :=
begin
  iterate 2 {cases k with k, { exfalso, linarith, }, },
  induction k with k hind,
  { exact adj_matrix_sq_mod_p_of_regular hG dmod hd, },
  have h2 : 2 ≤ k.succ.succ := by omega,
  rw [pow_succ, hind h2],
  exact adj_matrix_mul_const_one_mod_p_of_regular dmod hd,
end

variable [nonempty V]

/-- This is the main proof. Assuming that `3 ≤ d`, we take `p` to be a prime factor of `d-1`.
  Then the `p`th power of the adjacency matrix of a `d`-regular friendship graph must have trace 1
  mod `p`, but we can also show that the trace must be the `p`th power of the trace of the original
  adjacency matrix, which is 0, a contradiction.
-/
lemma false_of_three_le_degree (hd : G.is_regular_of_degree d) (h : 3 ≤ d) : false :=
begin
  -- get a prime factor of d - 1
  let p : ℕ := (d - 1).min_fac,
  have p_dvd_d_pred := (zmod.nat_coe_zmod_eq_zero_iff_dvd _ _).mpr (d - 1).min_fac_dvd,
  have dpos : 0 < d := by linarith,
  have d_cast : ↑(d - 1) = (d : ℤ) - 1 := by norm_cast,
  haveI : fact p.prime := ⟨nat.min_fac_prime (by linarith)⟩,
  have hp2 : 2 ≤ p := (fact.out p.prime).two_le,
  have dmod : (d : zmod p) = 1,
  { rw [← nat.succ_pred_eq_of_pos dpos, nat.succ_eq_add_one, nat.pred_eq_sub_one],
    simp only [add_left_eq_self, nat.cast_add, nat.cast_one],
    exact p_dvd_d_pred, },
  have Vmod := card_mod_p_of_regular hG dmod hd,
  -- now we reduce to a trace calculation
  have := zmod.trace_pow_card (G.adj_matrix (zmod p)),
  contrapose! this, clear this,
  -- the trace is 0 mod p when computed one way
  rw [trace_adj_matrix, zero_pow (fact.out p.prime).pos],
  -- but the trace is 1 mod p when computed the other way
  rw adj_matrix_pow_mod_p_of_regular hG dmod hd hp2,
  dunfold fintype.card at Vmod,
  simp only [matrix.trace, diag_apply, mul_one, nsmul_eq_mul, linear_map.coe_mk, sum_const],
  rw [Vmod, ← nat.cast_one, zmod.nat_coe_zmod_eq_zero_iff_dvd, nat.dvd_one,
    nat.min_fac_eq_one_iff],
  linarith,
end

/-- If `d ≤ 1`, a `d`-regular friendship graph has at most one vertex, which is
  trivially a politician. -/
lemma exists_politician_of_degree_le_one (hd : G.is_regular_of_degree d) (hd1 : d ≤ 1) :
  exists_politician G :=
begin
  have sq : d * d = d := by { interval_cases d; norm_num },
  have h := card_of_regular hG hd,
  rw sq at h,
  have : fintype.card V ≤ 1,
  { cases fintype.card V with n,
    { exact zero_le _, },
    { have : n = 0,
      { rw [nat.succ_sub_succ_eq_sub, nat.sub_zero] at h,
        linarith },
      subst n, } },
  use classical.arbitrary V,
  intros w h, exfalso,
  apply h,
  apply fintype.card_le_one_iff.mp this,
end

/-- If `d = 2`, a `d`-regular friendship graph has 3 vertices, so it must be complete graph,
  and all the vertices are politicians. -/
lemma neighbor_finset_eq_of_degree_eq_two (hd : G.is_regular_of_degree 2) (v : V) :
  G.neighbor_finset v = finset.univ.erase v :=
begin
  apply finset.eq_of_subset_of_card_le,
  { rw finset.subset_iff,
    intro x,
    rw [mem_neighbor_finset, finset.mem_erase],
    exact λ h, ⟨(G.ne_of_adj h).symm, finset.mem_univ _⟩ },
  convert_to 2 ≤ _,
  { convert_to _ = fintype.card V - 1,
    { have hfr:= card_of_regular hG hd,
      linarith },
    { exact finset.card_erase_of_mem (finset.mem_univ _), }, },
  { dsimp [is_regular_of_degree, degree] at hd,
    rw hd, }
end

lemma exists_politician_of_degree_eq_two (hd : G.is_regular_of_degree 2) :
  exists_politician G :=
begin
  have v := classical.arbitrary V,
  use v,
  intros w hvw,
  rw [← mem_neighbor_finset, neighbor_finset_eq_of_degree_eq_two hG hd v, finset.mem_erase],
  exact ⟨hvw.symm, finset.mem_univ _⟩,
end

lemma exists_politician_of_degree_le_two (hd : G.is_regular_of_degree d) (h : d ≤ 2) :
  exists_politician G :=
begin
  interval_cases d,
  iterate 2 { apply exists_politician_of_degree_le_one hG hd, norm_num },
  { exact exists_politician_of_degree_eq_two hG hd },
end

end friendship

/-- We wish to show that a friendship graph has a politician (a vertex adjacent to all others).
  We proceed by contradiction, and assume the graph has no politician.
  We have already proven that a friendship graph with no politician is `d`-regular for some `d`,
  and now we do casework on `d`.
  If the degree is at most 2, we observe by casework that it has a politician anyway.
  If the degree is at least 3, the graph cannot exist. -/
theorem friendship_theorem [nonempty V] : exists_politician G :=
begin
  by_contradiction npG,
  rcases hG.is_regular_of_not_exists_politician npG with ⟨d, dreg⟩,
  have h : d ≤ 2 ∨ 3 ≤ d := by omega,
  cases h with dle2 dge3,
  { exact npG (hG.exists_politician_of_degree_le_two dreg dle2) },
  { exact hG.false_of_three_le_degree dreg dge3 },
end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.finset.fold
import algebra.gcd_monoid.multiset

/-!
# GCD and LCM operations on finsets

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

## Main definitions

- `finset.gcd` - the greatest common denominator of a `finset` of elements of a `gcd_monoid`
- `finset.lcm` - the least common multiple of a `finset` of elements of a `gcd_monoid`

## Implementation notes

Many of the proofs use the lemmas `gcd.def` and `lcm.def`, which relate `finset.gcd`
and `finset.lcm` to `multiset.gcd` and `multiset.lcm`.

TODO: simplify with a tactic and `data.finset.lattice`

## Tags

finset, gcd
-/

variables {α β γ : Type*}

namespace finset
open multiset

variables [cancel_comm_monoid_with_zero α] [normalized_gcd_monoid α]

/-! ### lcm -/
section lcm

/-- Least common multiple of a finite set -/
def lcm (s : finset β) (f : β → α) : α := s.fold gcd_monoid.lcm 1 f

variables {s s₁ s₂ : finset β} {f : β → α}

lemma lcm_def : s.lcm f = (s.1.map f).lcm := rfl

@[simp]

@[simp] lemma lcm_dvd_iff {a : α} : s.lcm f ∣ a ↔ (∀b ∈ s, f b ∣ a) :=
begin
  apply iff.trans multiset.lcm_dvd,
  simp only [multiset.mem_map, and_imp, exists_imp_distrib],
  exact ⟨λ k b hb, k _ _ hb rfl, λ k a' b hb h, h ▸ k _ hb⟩,
end

lemma lcm_dvd {a : α} : (∀b ∈ s, f b ∣ a) → s.lcm f ∣ a :=
lcm_dvd_iff.2

lemma dvd_lcm {b : β} (hb : b ∈ s) : f b ∣ s.lcm f :=
lcm_dvd_iff.1 dvd_rfl _ hb

@[simp] lemma lcm_insert [decidable_eq β] {b : β} :
  (insert b s : finset β).lcm f = gcd_monoid.lcm (f b) (s.lcm f) :=
begin
  by_cases h : b ∈ s,
  { rw [insert_eq_of_mem h,
        (lcm_eq_right_iff (f b) (s.lcm f) (multiset.normalize_lcm (s.1.map f))).2 (dvd_lcm h)] },
  apply fold_insert h,
end

@[simp] lemma lcm_singleton {b : β} : ({b} : finset β).lcm f = normalize (f b) :=
multiset.lcm_singleton

@[simp] lemma normalize_lcm : normalize (s.lcm f) = s.lcm f := by simp [lcm_def]

lemma lcm_union [decidable_eq β] : (s₁ ∪ s₂).lcm f = gcd_monoid.lcm (s₁.lcm f) (s₂.lcm f) :=
finset.induction_on s₁ (by rw [empty_union, lcm_empty, lcm_one_left, normalize_lcm]) $ λ a s has ih,
  by rw [insert_union, lcm_insert, lcm_insert, ih, lcm_assoc]

theorem lcm_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a ∈ s₂, f a = g a) :
  s₁.lcm f = s₂.lcm g :=
by { subst hs, exact finset.fold_congr hfg }

lemma lcm_mono_fun {g : β → α} (h : ∀ b ∈ s, f b ∣ g b) : s.lcm f ∣ s.lcm g :=
lcm_dvd (λ b hb, (h b hb).trans (dvd_lcm hb))

lemma lcm_mono (h : s₁ ⊆ s₂) : s₁.lcm f ∣ s₂.lcm f :=
lcm_dvd $ assume b hb, dvd_lcm (h hb)

lemma lcm_image [decidable_eq β] {g : γ → β} (s : finset γ) : (s.image g).lcm f = s.lcm (f ∘ g) :=
by { classical, induction s using finset.induction with c s hc ih; simp [*] }

lemma lcm_eq_lcm_image [decidable_eq α] : s.lcm f = (s.image f).lcm id := eq.symm $ lcm_image _

theorem lcm_eq_zero_iff [nontrivial α] : s.lcm f = 0 ↔ 0 ∈ f '' s :=
by simp only [multiset.mem_map, lcm_def, multiset.lcm_eq_zero_iff, set.mem_image, mem_coe,
  ← finset.mem_def]

end lcm

/-! ### gcd -/
section gcd

/-- Greatest common divisor of a finite set -/
def gcd (s : finset β) (f : β → α) : α := s.fold gcd_monoid.gcd 0 f

variables {s s₁ s₂ : finset β} {f : β → α}

lemma gcd_def : s.gcd f = (s.1.map f).gcd := rfl

@[simp] lemma gcd_empty : (∅ : finset β).gcd f = 0 :=
fold_empty

lemma dvd_gcd_iff {a : α} : a ∣ s.gcd f ↔ ∀b ∈ s, a ∣ f b :=
begin
  apply iff.trans multiset.dvd_gcd,
  simp only [multiset.mem_map, and_imp, exists_imp_distrib],
  exact ⟨λ k b hb, k _ _ hb rfl, λ k a' b hb h, h ▸ k _ hb⟩,
end

lemma gcd_dvd {b : β} (hb : b ∈ s) : s.gcd f ∣ f b :=
dvd_gcd_iff.1 dvd_rfl _ hb

lemma dvd_gcd {a : α} : (∀b ∈ s, a ∣ f b) → a ∣ s.gcd f :=
dvd_gcd_iff.2

@[simp] lemma gcd_insert [decidable_eq β] {b : β} :
  (insert b s : finset β).gcd f = gcd_monoid.gcd (f b) (s.gcd f) :=
begin
  by_cases h : b ∈ s,
  { rw [insert_eq_of_mem h,
    (gcd_eq_right_iff (f b) (s.gcd f) (multiset.normalize_gcd (s.1.map f))).2 (gcd_dvd h)] ,},
  apply fold_insert h,
end

@[simp] lemma gcd_singleton {b : β} : ({b} : finset β).gcd f = normalize (f b) :=
multiset.gcd_singleton

@[simp] lemma normalize_gcd : normalize (s.gcd f) = s.gcd f := by simp [gcd_def]

lemma gcd_union [decidable_eq β] : (s₁ ∪ s₂).gcd f = gcd_monoid.gcd (s₁.gcd f) (s₂.gcd f) :=
finset.induction_on s₁ (by rw [empty_union, gcd_empty, gcd_zero_left, normalize_gcd]) $
  λ a s has ih, by rw [insert_union, gcd_insert, gcd_insert, ih, gcd_assoc]

theorem gcd_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a ∈ s₂, f a = g a) :
  s₁.gcd f = s₂.gcd g :=
by { subst hs, exact finset.fold_congr hfg }

lemma gcd_mono_fun {g : β → α} (h : ∀ b ∈ s, f b ∣ g b) : s.gcd f ∣ s.gcd g :=
dvd_gcd (λ b hb, (gcd_dvd hb).trans (h b hb))

lemma gcd_mono (h : s₁ ⊆ s₂) : s₂.gcd f ∣ s₁.gcd f :=
dvd_gcd $ assume b hb, gcd_dvd (h hb)

lemma gcd_image [decidable_eq β] {g : γ → β} (s : finset γ) : (s.image g).gcd f = s.gcd (f ∘ g) :=
by { classical, induction s using finset.induction with c s hc ih; simp [*] }

lemma gcd_eq_gcd_image [decidable_eq α] : s.gcd f = (s.image f).gcd id := eq.symm $ gcd_image _

theorem gcd_eq_zero_iff : s.gcd f = 0 ↔ ∀ (x : β), x ∈ s → f x = 0 :=
begin
  rw [gcd_def, multiset.gcd_eq_zero_iff],
  split; intro h,
  { intros b bs,
    apply h (f b),
    simp only [multiset.mem_map, mem_def.1 bs],
    use b,
    simp [mem_def.1 bs] },
  { intros a as,
    rw multiset.mem_map at as,
    rcases as with ⟨b, ⟨bs, rfl⟩⟩,
    apply h b (mem_def.1 bs) }
end

lemma gcd_eq_gcd_filter_ne_zero [decidable_pred (λ (x : β), f x = 0)] :
  s.gcd f = (s.filter (λ x, f x ≠ 0)).gcd f :=
begin
  classical,
  transitivity ((s.filter (λ x, f x = 0)) ∪ (s.filter (λ x, f x ≠ 0))).gcd f,
  { rw filter_union_filter_neg_eq },
  rw gcd_union,
  transitivity gcd_monoid.gcd (0 : α) _,
  { refine congr (congr rfl _) rfl,
    apply s.induction_on, { simp },
    intros a s has h,
    rw filter_insert,
    split_ifs with h1; simp [h, h1], },
  simp [gcd_zero_left, normalize_gcd],
end

lemma gcd_mul_left {a : α} : s.gcd (λ x, a * f x) = normalize a * s.gcd f :=
begin
  classical,
  apply s.induction_on,
  { simp },
  intros b t hbt h,
  rw [gcd_insert, gcd_insert, h, ← gcd_mul_left],
  apply ((normalize_associated a).mul_right _).gcd_eq_right
end

lemma gcd_mul_right {a : α} : s.gcd (λ x, f x * a) = s.gcd f * normalize a :=
begin
  classical,
  apply s.induction_on,
  { simp },
  intros b t hbt h,
  rw [gcd_insert, gcd_insert, h, ← gcd_mul_right],
  apply ((normalize_associated a).mul_left _).gcd_eq_right
end

lemma extract_gcd' (f g : β → α) (hs : ∃ x, x ∈ s ∧ f x ≠ 0)
  (hg : ∀ b ∈ s, f b = s.gcd f * g b) : s.gcd g = 1 :=
((@mul_right_eq_self₀ _ _ (s.gcd f) _).1 $
  by conv_lhs { rw [← normalize_gcd, ← gcd_mul_left, ← gcd_congr rfl hg] }).resolve_right $
  by {contrapose! hs, exact gcd_eq_zero_iff.1 hs}

lemma extract_gcd (f : β → α) (hs : s.nonempty) :
  ∃ g : β → α, (∀ b ∈ s, f b = s.gcd f * g b) ∧ s.gcd g = 1 :=
begin
  classical,
  by_cases h : ∀ x ∈ s, f x = (0 : α),
  { refine ⟨λ b, 1, λ b hb, by rw [h b hb, gcd_eq_zero_iff.2 h, mul_one], _⟩,
    rw [gcd_eq_gcd_image, image_const hs, gcd_singleton, id, normalize_one] },
  { choose g' hg using @gcd_dvd _ _ _ _ s f,
    have := λ b hb, _, push_neg at h,
    refine ⟨λ b, if hb : b ∈ s then g' hb else 0, this, extract_gcd' f _ h this⟩,
    rw [dif_pos hb, hg hb] },
end

end gcd
end finset

namespace finset
section is_domain

variables [comm_ring α] [is_domain α] [normalized_gcd_monoid α]

lemma gcd_eq_of_dvd_sub {s : finset β} {f g : β → α} {a : α}
  (h : ∀ x : β, x ∈ s → a ∣ f x - g x) :
  gcd_monoid.gcd a (s.gcd f) = gcd_monoid.gcd a (s.gcd g) :=
begin
  classical,
  revert h,
  apply s.induction_on,
  { simp },
  intros b s bs hi h,
  rw [gcd_insert, gcd_insert, gcd_comm (f b), ← gcd_assoc, hi (λ x hx, h _ (mem_insert_of_mem hx)),
      gcd_comm a, gcd_assoc, gcd_comm a (gcd_monoid.gcd _ _),
      gcd_comm (g b), gcd_assoc _ _ a, gcd_comm _ a],
  exact congr_arg _ (gcd_eq_of_dvd_sub_right (h _ (mem_insert_self _ _)))
end

end is_domain

end finset


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import data.finset.sort

/-!
# Finite sets

This file defines predicates `finite : set α → Prop` and `infinite : set α → Prop` and proves some
basic facts about finite sets.
-/

open set function

universes u v w x
variables {α : Type u} {β : Type v} {ι : Sort w} {γ : Type x}

namespace set

/-- A set is finite if the subtype is a fintype, i.e. there is a
  list that enumerates its members. -/
inductive finite (s : set α) : Prop
| intro : fintype s → finite

lemma finite_def {s : set α} : finite s ↔ nonempty (fintype s) := ⟨λ ⟨h⟩, ⟨h⟩, λ ⟨h⟩, ⟨h⟩⟩

/-- A set is infinite if it is not finite. -/
def infinite (s : set α) : Prop := ¬ finite s

/-- The subtype corresponding to a finite set is a finite type. Note
that because `finite` isn't a typeclass, this will not fire if it
is made into an instance -/
noncomputable def finite.fintype {s : set α} (h : finite s) : fintype s :=
classical.choice $ finite_def.1 h

/-- Get a finset from a finite set -/
noncomputable def finite.to_finset {s : set α} (h : finite s) : finset α :=
@set.to_finset _ _ h.fintype

@[simp] lemma not_infinite {s : set α} : ¬ s.infinite ↔ s.finite :=
by simp [infinite]

@[simp] theorem finite.mem_to_finset {s : set α} (h : finite s) {a : α} : a ∈ h.to_finset ↔ a ∈ s :=
@mem_to_finset _ _ h.fintype _

@[simp] theorem finite.to_finset.nonempty {s : set α} (h : finite s) :
  h.to_finset.nonempty ↔ s.nonempty :=
show (∃ x, x ∈ h.to_finset) ↔ (∃ x, x ∈ s),
from exists_congr (λ _, h.mem_to_finset)

@[simp] lemma finite.coe_to_finset {s : set α} (h : finite s) : ↑h.to_finset = s :=
@set.coe_to_finset _ s h.fintype

@[simp] lemma finite.coe_sort_to_finset {s : set α} (h : finite s) :
  (h.to_finset : Type*) = s :=
by rw [← finset.coe_sort_coe _, h.coe_to_finset]

@[simp] lemma finite_empty_to_finset (h : finite (∅ : set α)) : h.to_finset = ∅ :=
by rw [← finset.coe_inj, h.coe_to_finset, finset.coe_empty]

@[simp] lemma finite.to_finset_inj {s t : set α} {hs : finite s} {ht : finite t} :
  hs.to_finset = ht.to_finset ↔ s = t :=
by simp [←finset.coe_inj]

lemma subset_to_finset_iff {s : finset α} {t : set α} (ht : finite t) :
  s ⊆ ht.to_finset ↔ ↑s ⊆ t :=
by rw [← finset.coe_subset, ht.coe_to_finset]

@[simp] lemma finite_to_finset_eq_empty_iff {s : set α} {h : finite s} :
  h.to_finset = ∅ ↔ s = ∅ :=
by simp [←finset.coe_inj]

theorem finite.exists_finset {s : set α} : finite s →
  ∃ s' : finset α, ∀ a : α, a ∈ s' ↔ a ∈ s
| ⟨h⟩ := by exactI ⟨to_finset s, λ _, mem_to_finset⟩

theorem finite.exists_finset_coe {s : set α} (hs : finite s) :
  ∃ s' : finset α, ↑s' = s :=
⟨hs.to_finset, hs.coe_to_finset⟩

/-- Finite sets can be lifted to finsets. -/
instance : can_lift (set α) (finset α) :=
{ coe := coe,
  cond := finite,
  prf := λ s hs, hs.exists_finset_coe }

theorem finite_mem_finset (s : finset α) : finite {a | a ∈ s} :=
⟨fintype.of_finset s (λ _, iff.rfl)⟩

theorem finite.of_fintype [fintype α] (s : set α) : finite s :=
by classical; exact ⟨set_fintype s⟩

theorem exists_finite_iff_finset {p : set α → Prop} :
  (∃ s, finite s ∧ p s) ↔ ∃ s : finset α, p ↑s :=
⟨λ ⟨s, hs, hps⟩, ⟨hs.to_finset, hs.coe_to_finset.symm ▸ hps⟩,
  λ ⟨s, hs⟩, ⟨↑s, finite_mem_finset s, hs⟩⟩

lemma finite.fin_embedding {s : set α} (h : finite s) : ∃ (n : ℕ) (f : fin n ↪ α), range f = s :=
⟨_, (fintype.equiv_fin (h.to_finset : set α)).symm.as_embedding, by simp⟩

lemma finite.fin_param {s : set α} (h : finite s) :
  ∃ (n : ℕ) (f : fin n → α), injective f ∧ range f = s :=
let ⟨n, f, hf⟩ := h.fin_embedding in ⟨n, f, f.injective, hf⟩

/-- Membership of a subset of a finite type is decidable.

Using this as an instance leads to potential loops with `subtype.fintype` under certain decidability
assumptions, so it should only be declared a local instance. -/
def decidable_mem_of_fintype [decidable_eq α] (s : set α) [fintype s] (a) : decidable (a ∈ s) :=
decidable_of_iff _ mem_to_finset

instance fintype_empty : fintype (∅ : set α) :=
fintype.of_finset ∅ $ by simp

theorem empty_card : fintype.card (∅ : set α) = 0 := rfl

@[simp] theorem empty_card' {h : fintype.{u} (∅ : set α)} :
  @fintype.card (∅ : set α) h = 0 :=
eq.trans (by congr) empty_card

@[simp] theorem finite_empty : @finite α ∅ := ⟨set.fintype_empty⟩

instance finite.inhabited : inhabited {s : set α // finite s} := ⟨⟨∅, finite_empty⟩⟩

/-- A `fintype` structure on `insert a s`. -/
def fintype_insert' {a : α} (s : set α) [fintype s] (h : a ∉ s) : fintype (insert a s : set α) :=
fintype.of_finset ⟨a ::ₘ s.to_finset.1,
  multiset.nodup_cons_of_nodup (by simp [h]) s.to_finset.2⟩ $ by simp

theorem card_fintype_insert' {a : α} (s : set α) [fintype s] (h : a ∉ s) :
  @fintype.card _ (fintype_insert' s h) = fintype.card s + 1 :=
by rw [fintype_insert', fintype.card_of_finset];
   simp [finset.card, to_finset]; refl

@[simp] theorem card_insert {a : α} (s : set α)
  [fintype s] (h : a ∉ s) {d : fintype.{u} (insert a s : set α)} :
  @fintype.card _ d = fintype.card s + 1 :=
by rw ← card_fintype_insert' s h; congr

lemma card_image_of_inj_on {s : set α} [fintype s]
  {f : α → β} [fintype (f '' s)] (H : ∀x∈s, ∀y∈s, f x = f y → x = y) :
  fintype.card (f '' s) = fintype.card s :=
by haveI := classical.prop_decidable; exact
calc fintype.card (f '' s) = (s.to_finset.image f).card : fintype.card_of_finset' _ (by simp)
... = s.to_finset.card : finset.card_image_of_inj_on
    (λ x hx y hy hxy, H x (mem_to_finset.1 hx) y (mem_to_finset.1 hy) hxy)
... = fintype.card s : (fintype.card_of_finset' _ (λ a, mem_to_finset)).symm

lemma card_image_of_injective (s : set α) [fintype s]
  {f : α → β} [fintype (f '' s)] (H : function.injective f) :
  fintype.card (f '' s) = fintype.card s :=
card_image_of_inj_on $ λ _ _ _ _ h, H h

section

local attribute [instance] decidable_mem_of_fintype

instance fintype_insert [decidable_eq α] (a : α) (s : set α) [fintype s] :
  fintype (insert a s : set α) :=
if h : a ∈ s then by rwa [insert_eq, union_eq_self_of_subset_left (singleton_subset_iff.2 h)]
else fintype_insert' _ h

end

@[simp] theorem finite.insert (a : α) {s : set α} : finite s → finite (insert a s)
| ⟨h⟩ := ⟨@set.fintype_insert _ (classical.dec_eq α) _ _ h⟩

lemma to_finset_insert [decidable_eq α] {a : α} {s : set α} (hs : finite s) :
  (hs.insert a).to_finset = insert a hs.to_finset :=
finset.ext $ by simp

@[simp] lemma insert_to_finset [decidable_eq α] {a : α} {s : set α} [fintype s] :
  (insert a s).to_finset = insert a s.to_finset :=
by simp [finset.ext_iff, mem_insert_iff]

@[elab_as_eliminator]
theorem finite.induction_on {C : set α → Prop} {s : set α} (h : finite s)
  (H0 : C ∅) (H1 : ∀ {a s}, a ∉ s → finite s → C s → C (insert a s)) : C s :=
let ⟨t⟩ := h in by exactI
match s.to_finset, @mem_to_finset _ s _ with
| ⟨l, nd⟩, al := begin
    change ∀ a, a ∈ l ↔ a ∈ s at al,
    clear _let_match _match t h, revert s nd al,
    refine multiset.induction_on l _ (λ a l IH, _); intros s nd al,
    { rw show s = ∅, from eq_empty_iff_forall_not_mem.2 (by simpa using al),
      exact H0 },
    { rw ← show insert a {x | x ∈ l} = s, from set.ext (by simpa using al),
      cases multiset.nodup_cons.1 nd with m nd',
      refine H1 _ ⟨finset.subtype.fintype ⟨l, nd'⟩⟩ (IH nd' (λ _, iff.rfl)),
      exact m }
  end
end

@[elab_as_eliminator]
theorem finite.dinduction_on {C : ∀s:set α, finite s → Prop} {s : set α} (h : finite s)
  (H0 : C ∅ finite_empty)
  (H1 : ∀ {a s}, a ∉ s → ∀ h : finite s, C s h → C (insert a s) (h.insert a)) :
  C s h :=
have ∀ h : finite s, C s h,
  from finite.induction_on h (λ h, H0) (λ a s has hs ih h, H1 has hs (ih _)),
this h

instance fintype_singleton (a : α) : fintype ({a} : set α) :=
unique.fintype

@[simp] theorem card_singleton (a : α) :
  fintype.card ({a} : set α) = 1 :=
fintype.card_of_subsingleton _

@[simp] theorem finite_singleton (a : α) : finite ({a} : set α) :=
⟨set.fintype_singleton _⟩

lemma subsingleton.finite {s : set α} (h : s.subsingleton) : finite s :=
h.induction_on finite_empty finite_singleton

lemma finite_is_top (α : Type*) [partial_order α] : finite {x : α | is_top x} :=
(subsingleton_is_top α).finite

lemma finite_is_bot (α : Type*) [partial_order α] : finite {x : α | is_bot x} :=
(subsingleton_is_bot α).finite

instance fintype_pure : ∀ a : α, fintype (pure a : set α) :=
set.fintype_singleton

theorem finite_pure (a : α) : finite (pure a : set α) :=
⟨set.fintype_pure a⟩

instance fintype_univ [fintype α] : fintype (@univ α) :=
fintype.of_equiv α $ (equiv.set.univ α).symm

theorem finite_univ [fintype α] : finite (@univ α) := ⟨set.fintype_univ⟩

/-- If `(set.univ : set α)` is finite then `α` is a finite type. -/
noncomputable def fintype_of_univ_finite (H : (univ : set α).finite ) :
  fintype α :=
@fintype.of_equiv _ (univ : set α) H.fintype (equiv.set.univ _)

lemma univ_finite_iff_nonempty_fintype :
  (univ : set α).finite ↔ nonempty (fintype α) :=
begin
  split,
  { intro h, exact ⟨fintype_of_univ_finite h⟩ },
  { rintro ⟨_i⟩, exactI finite_univ }
end

theorem infinite_univ_iff : (@univ α).infinite ↔ _root_.infinite α :=
⟨λ h₁, ⟨λ h₂, h₁ $ @finite_univ α h₂⟩, λ ⟨h₁⟩ h₂, h₁ (fintype_of_univ_finite h₂)⟩

theorem infinite_univ [h : _root_.infinite α] : infinite (@univ α) :=
infinite_univ_iff.2 h

theorem infinite_coe_iff {s : set α} : _root_.infinite s ↔ infinite s :=
⟨λ ⟨h₁⟩ h₂, h₁ h₂.fintype, λ h₁, ⟨λ h₂, h₁ ⟨h₂⟩⟩⟩

theorem infinite.to_subtype {s : set α} (h : infinite s) : _root_.infinite s :=
infinite_coe_iff.2 h

/-- Embedding of `ℕ` into an infinite set. -/
noncomputable def infinite.nat_embedding (s : set α) (h : infinite s) : ℕ ↪ s :=
by { haveI := h.to_subtype, exact infinite.nat_embedding s }

lemma infinite.exists_subset_card_eq {s : set α} (hs : infinite s) (n : ℕ) :
  ∃ t : finset α, ↑t ⊆ s ∧ t.card = n :=
⟨((finset.range n).map (hs.nat_embedding _)).map (embedding.subtype _), by simp⟩

lemma infinite.nonempty {s : set α} (h : s.infinite) : s.nonempty :=
let a := infinite.nat_embedding s h 37 in ⟨a.1, a.2⟩

instance fintype_union [decidable_eq α] (s t : set α) [fintype s] [fintype t] :
  fintype (s ∪ t : set α) :=
fintype.of_finset (s.to_finset ∪ t.to_finset) $ by simp

theorem finite.union {s t : set α} : finite s → finite t → finite (s ∪ t)
| ⟨hs⟩ ⟨ht⟩ := ⟨@set.fintype_union _ (classical.dec_eq α) _ _ hs ht⟩

lemma finite.sup {s t : set α} : finite s → finite t → finite (s ⊔ t) := finite.union

lemma infinite_of_finite_compl [_root_.infinite α] {s : set α}
  (hs : sᶜ.finite) : s.infinite :=
λ h, set.infinite_univ (by simpa using hs.union h)

lemma finite.infinite_compl [_root_.infinite α] {s : set α}
  (hs : s.finite) : sᶜ.infinite :=
λ h, set.infinite_univ (by simpa using hs.union h)

instance fintype_sep (s : set α) (p : α → Prop) [fintype s] [decidable_pred p] :
  fintype ({a ∈ s | p a} : set α) :=
fintype.of_finset (s.to_finset.filter p) $ by simp

instance fintype_inter (s t : set α) [fintype s] [decidable_pred (∈ t)] : fintype (s ∩ t : set α) :=
set.fintype_sep s t

/-- A `fintype` structure on a set defines a `fintype` structure on its subset. -/
def fintype_subset (s : set α) {t : set α} [fintype s] [decidable_pred (∈ t)] (h : t ⊆ s) :
  fintype t :=
by rw ← inter_eq_self_of_subset_right h; apply_instance

theorem finite.subset {s : set α} : finite s → ∀ {t : set α}, t ⊆ s → finite t
| ⟨hs⟩ t h := ⟨@set.fintype_subset _ _ _ hs (classical.dec_pred t) h⟩

lemma finite.union_iff {s t : set α} : finite (s ∪ t) ↔ finite s ∧ finite t :=
⟨λ h, ⟨h.subset (subset_union_left _ _), h.subset (subset_union_right _ _)⟩,
 λ ⟨hs, ht⟩, hs.union ht⟩

lemma finite.diff {s t u : set α} (hs : s.finite) (ht : t.finite) (h : u \ t ≤ s) : u.finite :=
begin
  refine finite.subset (ht.union hs) _,
  exact diff_subset_iff.mp h
end

theorem finite.inter_of_left {s : set α} (h : finite s) (t : set α) : finite (s ∩ t) :=
h.subset (inter_subset_left _ _)

theorem finite.inter_of_right {s : set α} (h : finite s) (t : set α) : finite (t ∩ s) :=
h.subset (inter_subset_right _ _)

theorem finite.inf_of_left {s : set α} (h : finite s) (t : set α) : finite (s ⊓ t) :=
h.inter_of_left t

theorem finite.inf_of_right {s : set α} (h : finite s) (t : set α) : finite (t ⊓ s) :=
h.inter_of_right t

protected theorem infinite.mono {s t : set α} (h : s ⊆ t) : infinite s → infinite t :=
mt (λ ht, ht.subset h)

lemma infinite.diff {s t : set α} (hs : s.infinite) (ht : t.finite) :
  (s \ t).infinite :=
λ h, hs ((h.union ht).subset (s.subset_diff_union t))

instance fintype_image [decidable_eq β] (s : set α) (f : α → β) [fintype s] : fintype (f '' s) :=
fintype.of_finset (s.to_finset.image f) $ by simp

instance fintype_range [decidable_eq α] (f : ι → α) [fintype (plift ι)] :
  fintype (range f) :=
fintype.of_finset (finset.univ.image $ f ∘ plift.down) $
  by simp [(@equiv.plift ι).exists_congr_left]

theorem finite_range (f : ι → α) [fintype (plift ι)] : finite (range f) :=
by haveI := classical.dec_eq α; exact ⟨by apply_instance⟩

theorem finite.image {s : set α} (f : α → β) : finite s → finite (f '' s)
| ⟨h⟩ := ⟨@set.fintype_image _ _ (classical.dec_eq β) _ _ h⟩

theorem infinite_of_infinite_image (f : α → β) {s : set α} (hs : (f '' s).infinite) :
  s.infinite :=
mt (finite.image f) hs

lemma finite.dependent_image {s : set α} (hs : finite s) (F : Π i ∈ s, β) :
  finite {y : β | ∃ x (hx : x ∈ s), y = F x hx} :=
begin
  letI : fintype s := hs.fintype,
  convert finite_range (λ x : s, F x x.2),
  simp only [set_coe.exists, subtype.coe_mk, eq_comm],
end

theorem finite.of_preimage {f : α → β} {s : set β} (h : finite (f ⁻¹' s)) (hf : surjective f) :
  finite s :=
hf.image_preimage s ▸ h.image _

instance fintype_map {α β} [decidable_eq β] :
  ∀ (s : set α) (f : α → β) [fintype s], fintype (f <$> s) := set.fintype_image

theorem finite.map {α β} {s : set α} :
  ∀ (f : α → β), finite s → finite (f <$> s) := finite.image

/-- If a function `f` has a partial inverse and sends a set `s` to a set with `[fintype]` instance,
then `s` has a `fintype` structure as well. -/
def fintype_of_fintype_image (s : set α)
  {f : α → β} {g} (I : is_partial_inv f g) [fintype (f '' s)] : fintype s :=
fintype.of_finset ⟨_, @multiset.nodup_filter_map β α g _
  (@injective_of_partial_inv_right _ _ f g I) (f '' s).to_finset.2⟩ $ λ a,
begin
  suffices : (∃ b x, f x = b ∧ g b = some a ∧ x ∈ s) ↔ a ∈ s,
  by simpa [exists_and_distrib_left.symm, and.comm, and.left_comm, and.assoc],
  rw exists_swap,
  suffices : (∃ x, x ∈ s ∧ g (f x) = some a) ↔ a ∈ s, {simpa [and.comm, and.left_comm, and.assoc]},
  simp [I _, (injective_of_partial_inv I).eq_iff]
end

theorem finite_of_finite_image {s : set α} {f : α → β} (hi : set.inj_on f s) :
  finite (f '' s) → finite s | ⟨h⟩ :=
⟨@fintype.of_injective _ _ h (λ a : s, ⟨f a.1, mem_image_of_mem f a.2⟩) $
  λ a b eq, subtype.eq $ hi a.2 b.2 $ subtype.ext_iff_val.1 eq⟩

theorem finite_image_iff {s : set α} {f : α → β} (hi : inj_on f s) :
  finite (f '' s) ↔ finite s :=
⟨finite_of_finite_image hi, finite.image _⟩

theorem infinite_image_iff {s : set α} {f : α → β} (hi : inj_on f s) :
  infinite (f '' s) ↔ infinite s :=
not_congr $ finite_image_iff hi

theorem infinite_of_inj_on_maps_to {s : set α} {t : set β} {f : α → β}
  (hi : inj_on f s) (hm : maps_to f s t) (hs : infinite s) : infinite t :=
((infinite_image_iff hi).2 hs).mono (maps_to'.mp hm)

theorem infinite.exists_ne_map_eq_of_maps_to {s : set α} {t : set β} {f : α → β}
  (hs : infinite s) (hf : maps_to f s t) (ht : finite t) :
  ∃ (x ∈ s) (y ∈ s), x ≠ y ∧ f x = f y :=
begin
  contrapose! ht,
  exact infinite_of_inj_on_maps_to (λ x hx y hy, not_imp_not.1 (ht x hx y hy)) hf hs
end

theorem infinite.exists_lt_map_eq_of_maps_to [linear_order α] {s : set α} {t : set β} {f : α → β}
  (hs : infinite s) (hf : maps_to f s t) (ht : finite t) :
  ∃ (x ∈ s) (y ∈ s), x < y ∧ f x = f y :=
let ⟨x, hx, y, hy, hxy, hf⟩ := hs.exists_ne_map_eq_of_maps_to hf ht
in hxy.lt_or_lt.elim (λ hxy, ⟨x, hx, y, hy, hxy, hf⟩) (λ hyx, ⟨y, hy, x, hx, hyx, hf.symm⟩)

theorem infinite_range_of_injective [_root_.infinite α] {f : α → β} (hi : injective f) :
  infinite (range f) :=
by { rw [←image_univ, infinite_image_iff (inj_on_of_injective hi _)], exact infinite_univ }

theorem infinite_of_injective_forall_mem [_root_.infinite α] {s : set β} {f : α → β}
  (hi : injective f) (hf : ∀ x : α, f x ∈ s) : infinite s :=
by { rw ←range_subset_iff at hf, exact (infinite_range_of_injective hi).mono hf }

theorem finite.preimage {s : set β} {f : α → β}
  (I : set.inj_on f (f⁻¹' s)) (h : finite s) : finite (f ⁻¹' s) :=
finite_of_finite_image I (h.subset (image_preimage_subset f s))

theorem finite.preimage_embedding {s : set β} (f : α ↪ β) (h : s.finite) : (f ⁻¹' s).finite :=
finite.preimage (λ _ _ _ _ h', f.injective h') h

lemma finite_option {s : set (option α)} : finite s ↔ finite {x : α | some x ∈ s} :=
⟨λ h, h.preimage_embedding embedding.some,
  λ h, ((h.image some).insert none).subset $
    λ x, option.cases_on x (λ _, or.inl rfl) (λ x hx, or.inr $ mem_image_of_mem _ hx)⟩

instance fintype_Union [decidable_eq α] [fintype (plift ι)]
  (f : ι → set α) [∀ i, fintype (f i)] : fintype (⋃ i, f i) :=
fintype.of_finset (finset.univ.bUnion (λ i : plift ι, (f i.down).to_finset)) $ by simp

theorem finite_Union [fintype (plift ι)] {f : ι → set α} (H : ∀i, finite (f i)) :
  finite (⋃ i, f i) :=
⟨@set.fintype_Union _ _ (classical.dec_eq α) _ _ (λ i, finite.fintype (H i))⟩

/-- A union of sets with `fintype` structure over a set with `fintype` structure has a `fintype`
structure. -/
def fintype_bUnion [decidable_eq α] {ι : Type*} {s : set ι} [fintype s]
  (f : ι → set α) (H : ∀ i ∈ s, fintype (f i)) : fintype (⋃ i ∈ s, f i) :=
by rw bUnion_eq_Union; exact
@set.fintype_Union _ _ _ _ _ (by rintro ⟨i, hi⟩; exact H i hi)

instance fintype_bUnion' [decidable_eq α] {ι : Type*} {s : set ι} [fintype s]
  (f : ι → set α) [H : ∀ i, fintype (f i)] : fintype (⋃ i ∈ s, f i) :=
fintype_bUnion _ (λ i _, H i)

theorem finite.sUnion {s : set (set α)} (h : finite s) (H : ∀t∈s, finite t) : finite (⋃₀ s) :=
by rw sUnion_eq_Union; haveI := finite.fintype h;
   apply finite_Union; simpa using H

theorem finite.bUnion {α} {ι : Type*} {s : set ι} {f : Π i ∈ s, set α} :
  finite s → (∀ i ∈ s, finite (f i ‹_›)) → finite (⋃ i∈s, f i ‹_›)
| ⟨hs⟩ h := by rw [bUnion_eq_Union]; exactI finite_Union (λ i, h _ _)

instance fintype_lt_nat (n : ℕ) : fintype {i | i < n} :=
fintype.of_finset (finset.range n) $ by simp

instance fintype_le_nat (n : ℕ) : fintype {i | i ≤ n} :=
by simpa [nat.lt_succ_iff] using set.fintype_lt_nat (n+1)

lemma finite_le_nat (n : ℕ) : finite {i | i ≤ n} := ⟨set.fintype_le_nat _⟩

lemma finite_lt_nat (n : ℕ) : finite {i | i < n} := ⟨set.fintype_lt_nat _⟩

lemma infinite.exists_nat_lt {s : set ℕ} (hs : infinite s) (n : ℕ) : ∃ m ∈ s, n < m :=
let ⟨m, hm⟩ := (hs.diff $ set.finite_le_nat n).nonempty in ⟨m, by simpa using hm⟩

instance fintype_prod (s : set α) (t : set β) [fintype s] [fintype t] : fintype (set.prod s t) :=
fintype.of_finset (s.to_finset.product t.to_finset) $ by simp

lemma finite.prod {s : set α} {t : set β} : finite s → finite t → finite (set.prod s t)
| ⟨hs⟩ ⟨ht⟩ := by exactI ⟨set.fintype_prod s t⟩

/-- `image2 f s t` is finitype if `s` and `t` are. -/
instance fintype_image2 [decidable_eq γ] (f : α → β → γ) (s : set α) (t : set β)
  [hs : fintype s] [ht : fintype t] : fintype (image2 f s t : set γ) :=
by { rw ← image_prod, apply set.fintype_image }

lemma finite.image2 (f : α → β → γ) {s : set α} {t : set β} (hs : finite s) (ht : finite t) :
  finite (image2 f s t) :=
by { rw ← image_prod, exact (hs.prod ht).image _ }

/-- If `s : set α` is a set with `fintype` instance and `f : α → set β` is a function such that
each `f a`, `a ∈ s`, has a `fintype` structure, then `s >>= f` has a `fintype` structure. -/
def fintype_bind {α β} [decidable_eq β] (s : set α) [fintype s]
  (f : α → set β) (H : ∀ a ∈ s, fintype (f a)) : fintype (s >>= f) :=
set.fintype_bUnion _ H

instance fintype_bind' {α β} [decidable_eq β] (s : set α) [fintype s]
  (f : α → set β) [H : ∀ a, fintype (f a)] : fintype (s >>= f) :=
fintype_bind _ _ (λ i _, H i)

theorem finite.bind {α β} {s : set α} {f : α → set β} (h : finite s) (hf : ∀ a ∈ s, finite (f a)) :
  finite (s >>= f) :=
h.bUnion hf

instance fintype_seq [decidable_eq β] (f : set (α → β)) (s : set α) [fintype f] [fintype s] :
  fintype (f.seq s) :=
by { rw seq_def, apply set.fintype_bUnion' }

instance fintype_seq' {α β : Type u} [decidable_eq β]
  (f : set (α → β)) (s : set α) [fintype f] [fintype s] :
  fintype (f <*> s) :=
set.fintype_seq f s

theorem finite.seq {f : set (α → β)} {s : set α} (hf : finite f) (hs : finite s) :
  finite (f.seq s) :=
by { rw seq_def, exact hf.bUnion (λ f _, hs.image _) }

theorem finite.seq' {α β : Type u} {f : set (α → β)} {s : set α} (hf : finite f) (hs : finite s) :
  finite (f <*> s) :=
hf.seq hs

/-- There are finitely many subsets of a given finite set -/
lemma finite.finite_subsets {α : Type u} {a : set α} (h : finite a) : finite {b | b ⊆ a} :=
⟨fintype.of_finset ((finset.powerset h.to_finset).map finset.coe_emb.1) $ λ s,
  by simpa [← @exists_finite_iff_finset α (λ t, t ⊆ a ∧ t = s), subset_to_finset_iff,
    ← and.assoc] using h.subset⟩

lemma exists_min_image [linear_order β] (s : set α) (f : α → β) (h1 : finite s) :
  s.nonempty → ∃ a ∈ s, ∀ b ∈ s, f a ≤ f b
| ⟨x, hx⟩ := by simpa only [exists_prop, finite.mem_to_finset]
  using h1.to_finset.exists_min_image f ⟨x, h1.mem_to_finset.2 hx⟩

lemma exists_max_image [linear_order β] (s : set α) (f : α → β) (h1 : finite s) :
  s.nonempty → ∃ a ∈ s, ∀ b ∈ s, f b ≤ f a
| ⟨x, hx⟩ := by simpa only [exists_prop, finite.mem_to_finset]
  using h1.to_finset.exists_max_image f ⟨x, h1.mem_to_finset.2 hx⟩

theorem exists_lower_bound_image [hα : nonempty α] [linear_order β] (s : set α) (f : α → β)
  (h : s.finite) : ∃ (a : α), ∀ b ∈ s, f a ≤ f b :=
begin
  by_cases hs : set.nonempty s,
  { exact let ⟨x₀, H, hx₀⟩ := set.exists_min_image s f h hs in ⟨x₀, λ x hx, hx₀ x hx⟩ },
  { exact nonempty.elim hα (λ a, ⟨a, λ x hx, absurd (set.nonempty_of_mem hx) hs⟩) }
end

theorem exists_upper_bound_image [hα : nonempty α] [linear_order β] (s : set α) (f : α → β)
  (h : s.finite) : ∃ (a : α), ∀ b ∈ s, f b ≤ f a :=
begin
  by_cases hs : set.nonempty s,
  { exact let ⟨x₀, H, hx₀⟩ := set.exists_max_image s f h hs in ⟨x₀, λ x hx, hx₀ x hx⟩ },
  { exact nonempty.elim hα (λ a, ⟨a, λ x hx, absurd (set.nonempty_of_mem hx) hs⟩) }
end

end set

namespace finset
variables [decidable_eq β]
variables {s : finset α}

lemma finite_to_set (s : finset α) : set.finite (↑s : set α) :=
set.finite_mem_finset s

@[simp] lemma coe_bUnion {f : α → finset β} : ↑(s.bUnion f) = (⋃x ∈ (↑s : set α), ↑(f x) : set β) :=
by simp [set.ext_iff]

@[simp] lemma finite_to_set_to_finset {α : Type*} (s : finset α) :
  (finite_to_set s).to_finset = s :=
by { ext, rw [set.finite.mem_to_finset, mem_coe] }

end finset

namespace set

/-- Finite product of finite sets is finite -/
lemma finite.pi {δ : Type*} [fintype δ] {κ : δ → Type*} {t : Π d, set (κ d)}
  (ht : ∀ d, (t d).finite) :
  (pi univ t).finite :=
begin
  lift t to Π d, finset (κ d) using ht,
  classical,
  rw ← fintype.coe_pi_finset,
  exact (fintype.pi_finset t).finite_to_set,
end

/-- A finite union of finsets is finite. -/
lemma union_finset_finite_of_range_finite (f : α → finset β) (h : (range f).finite) :
  (⋃ a, (f a : set β)).finite :=
begin
  rw ← bUnion_range,
  exact h.bUnion (λ y hy, y.finite_to_set)
end

lemma eq_finite_Union_of_finite_subset_Union  {ι} {s : ι → set α} {t : set α} (tfin : finite t)
  (h : t ⊆ ⋃ i, s i) :
  ∃ I : set ι, (finite I) ∧ ∃ σ : {i | i ∈ I} → set α,
     (∀ i, finite (σ i)) ∧ (∀ i, σ i ⊆ s i) ∧ t = ⋃ i, σ i :=
let ⟨I, Ifin, hI⟩ := finite_subset_Union tfin h in
⟨I, Ifin, λ x, s x ∩ t,
    λ i, tfin.subset (inter_subset_right _ _),
    λ i, inter_subset_left _ _,
    begin
      ext x,
      rw mem_Union,
      split,
      { intro x_in,
        rcases mem_Union.mp (hI x_in) with ⟨i, _, ⟨hi, rfl⟩, H⟩,
        use [i, hi, H, x_in] },
      { rintros ⟨i, hi, H⟩,
        exact H }
    end⟩

/-- An increasing union distributes over finite intersection. -/
lemma Union_Inter_of_monotone {ι ι' α : Type*} [fintype ι] [linear_order ι']
  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, monotone (s i)) :
  (⋃ j : ι', ⋂ i : ι, s i j) = ⋂ i : ι, ⋃ j : ι', s i j :=
begin
  ext x, refine ⟨λ hx, Union_Inter_subset hx, λ hx, _⟩,
  simp only [mem_Inter, mem_Union, mem_Inter] at hx ⊢, choose j hj using hx,
  obtain ⟨j₀⟩ := show nonempty ι', by apply_instance,
  refine ⟨finset.univ.fold max j₀ j, λ i, hs i _ (hj i)⟩,
  rw [finset.fold_op_rel_iff_or (@le_max_iff _ _)],
  exact or.inr ⟨i, finset.mem_univ i, le_rfl⟩
end

instance nat.fintype_Iio (n : ℕ) : fintype (Iio n) :=
fintype.of_finset (finset.range n) $ by simp

/--
If `P` is some relation between terms of `γ` and sets in `γ`,
such that every finite set `t : set γ` has some `c : γ` related to it,
then there is a recursively defined sequence `u` in `γ`
so `u n` is related to the image of `{0, 1, ..., n-1}` under `u`.

(We use this later to show sequentially compact sets
are totally bounded.)
-/
lemma seq_of_forall_finite_exists  {γ : Type*}
  {P : γ → set γ → Prop} (h : ∀ t,  finite t → ∃ c, P c t) :
  ∃ u : ℕ → γ, ∀ n, P (u n) (u '' Iio n) :=
⟨λ n, @nat.strong_rec_on' (λ _, γ) n $ λ n ih, classical.some $ h
    (range $ λ m : Iio n, ih m.1 m.2)
    (finite_range _),
λ n, begin
  classical,
  refine nat.strong_rec_on' n (λ n ih, _),
  rw nat.strong_rec_on_beta', convert classical.some_spec (h _ _),
  ext x, split,
  { rintros ⟨m, hmn, rfl⟩, exact ⟨⟨m, hmn⟩, rfl⟩ },
  { rintros ⟨⟨m, hmn⟩, rfl⟩, exact ⟨m, hmn, rfl⟩ }
end⟩

lemma finite_range_ite {p : α → Prop} [decidable_pred p] {f g : α → β} (hf : finite (range f))
  (hg : finite (range g)) : finite (range (λ x, if p x then f x else g x)) :=
(hf.union hg).subset range_ite_subset

lemma finite_range_const {c : β} : finite (range (λ x : α, c)) :=
(finite_singleton c).subset range_const_subset

lemma range_find_greatest_subset {P : α → ℕ → Prop} [∀ x, decidable_pred (P x)] {b : ℕ}:
  range (λ x, nat.find_greatest (P x) b) ⊆ ↑(finset.range (b + 1)) :=
by { rw range_subset_iff, intro x, simp [nat.lt_succ_iff, nat.find_greatest_le] }

lemma finite_range_find_greatest {P : α → ℕ → Prop} [∀ x, decidable_pred (P x)] {b : ℕ} :
  finite (range (λ x, nat.find_greatest (P x) b)) :=
(finset.range (b + 1)).finite_to_set.subset range_find_greatest_subset

lemma card_lt_card {s t : set α} [fintype s] [fintype t] (h : s ⊂ t) :
  fintype.card s < fintype.card t :=
fintype.card_lt_of_injective_not_surjective (set.inclusion h.1) (set.inclusion_injective h.1) $
  λ hst, (ssubset_iff_subset_ne.1 h).2 (eq_of_inclusion_surjective hst)

lemma card_le_of_subset {s t : set α} [fintype s] [fintype t] (hsub : s ⊆ t) :
  fintype.card s ≤ fintype.card t :=
fintype.card_le_of_injective (set.inclusion hsub) (set.inclusion_injective hsub)

lemma eq_of_subset_of_card_le {s t : set α} [fintype s] [fintype t]
   (hsub : s ⊆ t) (hcard : fintype.card t ≤ fintype.card s) : s = t :=
(eq_or_ssubset_of_subset hsub).elim id
  (λ h, absurd hcard $ not_le_of_lt $ card_lt_card h)

lemma subset_iff_to_finset_subset (s t : set α) [fintype s] [fintype t] :
  s ⊆ t ↔ s.to_finset ⊆ t.to_finset :=
by simp

@[simp, mono] lemma finite.to_finset_mono {s t : set α} {hs : finite s} {ht : finite t} :
  hs.to_finset ⊆ ht.to_finset ↔ s ⊆ t :=
begin
  split,
  { intros h x,
    rw [←finite.mem_to_finset hs, ←finite.mem_to_finset ht],
    exact λ hx, h hx },
  { intros h x,
    rw [finite.mem_to_finset hs, finite.mem_to_finset ht],
    exact λ hx, h hx }
end

@[simp, mono] lemma finite.to_finset_strict_mono {s t : set α} {hs : finite s} {ht : finite t} :
  hs.to_finset ⊂ ht.to_finset ↔ s ⊂ t :=
begin
  rw [←lt_eq_ssubset, ←finset.lt_iff_ssubset, lt_iff_le_and_ne, lt_iff_le_and_ne],
  simp
end

lemma card_range_of_injective [fintype α] {f : α → β} (hf : injective f)
  [fintype (range f)] : fintype.card (range f) = fintype.card α :=
eq.symm $ fintype.card_congr $ equiv.of_injective f hf

lemma finite.exists_maximal_wrt [partial_order β] (f : α → β) (s : set α) (h : set.finite s) :
  s.nonempty → ∃ a ∈ s, ∀ a' ∈ s, f a ≤ f a' → f a = f a' :=
begin
  classical,
  refine h.induction_on _ _,
  { exact λ h, absurd h empty_not_nonempty },
  intros a s his _ ih _,
  cases s.eq_empty_or_nonempty with h h,
  { use a, simp [h] },
  rcases ih h with ⟨b, hb, ih⟩,
  by_cases f b ≤ f a,
  { refine ⟨a, set.mem_insert _ _, λ c hc hac, le_antisymm hac _⟩,
    rcases set.mem_insert_iff.1 hc with rfl | hcs,
    { refl },
    { rwa [← ih c hcs (le_trans h hac)] } },
  { refine ⟨b, set.mem_insert_of_mem _ hb, λ c hc hbc, _⟩,
    rcases set.mem_insert_iff.1 hc with rfl | hcs,
    { exact (h hbc).elim },
    { exact ih c hcs hbc } }
end

lemma finite.card_to_finset {s : set α} [fintype s] (h : s.finite) :
  h.to_finset.card = fintype.card s :=
by { rw [← finset.card_attach, finset.attach_eq_univ, ← fintype.card], congr' 2, funext,
     rw set.finite.mem_to_finset }

lemma infinite.exists_not_mem_finset {s : set α} (hs : s.infinite) (f : finset α) :
  ∃ a ∈ s, a ∉ f :=
let ⟨a, has, haf⟩ := (hs.diff f.finite_to_set).nonempty in ⟨a, has, λ h, haf $ finset.mem_coe.1 h⟩

section decidable_eq

lemma to_finset_compl {α : Type*} [fintype α] [decidable_eq α]
  (s : set α) [fintype (sᶜ : set α)] [fintype s] : sᶜ.to_finset = (s.to_finset)ᶜ :=
by ext; simp

lemma to_finset_inter {α : Type*} [decidable_eq α] (s t : set α) [fintype (s ∩ t : set α)]
  [fintype s] [fintype t] : (s ∩ t).to_finset = s.to_finset ∩ t.to_finset :=
by ext; simp

lemma to_finset_union {α : Type*} [decidable_eq α] (s t : set α) [fintype (s ∪ t : set α)]
  [fintype s] [fintype t] : (s ∪ t).to_finset = s.to_finset ∪ t.to_finset :=
by ext; simp

lemma to_finset_ne_eq_erase {α : Type*} [decidable_eq α] [fintype α] (a : α)
  [fintype {x : α | x ≠ a}] : {x : α | x ≠ a}.to_finset = finset.univ.erase a :=
by ext; simp

lemma card_ne_eq [fintype α] (a : α) [fintype {x : α | x ≠ a}] :
  fintype.card {x : α | x ≠ a} = fintype.card α - 1 :=
begin
  haveI := classical.dec_eq α,
  rw [←to_finset_card, to_finset_ne_eq_erase, finset.card_erase_of_mem (finset.mem_univ _),
      finset.card_univ, nat.pred_eq_sub_one],
end

end decidable_eq

section

variables [semilattice_sup α] [nonempty α] {s : set α}

/--A finite set is bounded above.-/
protected lemma finite.bdd_above (hs : finite s) : bdd_above s :=
finite.induction_on hs bdd_above_empty $ λ a s _ _ h, h.insert a

/--A finite union of sets which are all bounded above is still bounded above.-/
lemma finite.bdd_above_bUnion {I : set β} {S : β → set α} (H : finite I) :
  (bdd_above (⋃i∈I, S i)) ↔ (∀i ∈ I, bdd_above (S i)) :=
finite.induction_on H
  (by simp only [bUnion_empty, bdd_above_empty, ball_empty_iff])
  (λ a s ha _ hs, by simp only [bUnion_insert, ball_insert_iff, bdd_above_union, hs])

end

section

variables [semilattice_inf α] [nonempty α] {s : set α}

/--A finite set is bounded below.-/
protected lemma finite.bdd_below (hs : finite s) : bdd_below s :=
@finite.bdd_above (order_dual α) _ _ _ hs

/--A finite union of sets which are all bounded below is still bounded below.-/
lemma finite.bdd_below_bUnion {I : set β} {S : β → set α} (H : finite I) :
  (bdd_below (⋃i∈I, S i)) ↔ (∀i ∈ I, bdd_below (S i)) :=
@finite.bdd_above_bUnion (order_dual α) _ _ _ _ _ H

end

end set

namespace finset

/-- A finset is bounded above. -/
protected lemma bdd_above [semilattice_sup α] [nonempty α] (s : finset α) :
  bdd_above (↑s : set α) :=
s.finite_to_set.bdd_above

/-- A finset is bounded below. -/
protected lemma bdd_below [semilattice_inf α] [nonempty α] (s : finset α) :
  bdd_below (↑s : set α) :=
s.finite_to_set.bdd_below

end finset

namespace fintype
variables [fintype α] {p q : α → Prop} [decidable_pred p] [decidable_pred q]

@[simp]
lemma card_subtype_compl : fintype.card {x // ¬ p x} = fintype.card α - fintype.card {x // p x} :=
begin
  classical,
  rw [fintype.card_of_subtype (set.to_finset pᶜ), set.to_finset_compl p, finset.card_compl,
      fintype.card_of_subtype (set.to_finset p)];
    intros; simp; refl
end

/-- If two subtypes of a fintype have equal cardinality, so do their complements. -/
lemma card_compl_eq_card_compl (h : fintype.card {x // p x} = fintype.card {x // q x}) :
  fintype.card {x // ¬ p x} = fintype.card {x // ¬ q x} :=
by simp only [card_subtype_compl, h]

end fintype

/--
If a set `s` does not contain any elements between any pair of elements `x, z ∈ s` with `x ≤ z`
(i.e if given `x, y, z ∈ s` such that `x ≤ y ≤ z`, then `y` is either `x` or `z`), then `s` is
finite.
-/
lemma set.finite_of_forall_between_eq_endpoints {α : Type*} [linear_order α] (s : set α)
  (h : ∀ (x ∈ s) (y ∈ s) (z ∈ s), x ≤ y → y ≤ z → x = y ∨ y = z) :
  set.finite s :=
begin
  by_contra hinf,
  change s.infinite at hinf,
  rcases hinf.exists_subset_card_eq 3 with ⟨t, hts, ht⟩,
  let f := t.order_iso_of_fin ht,
  let x := f 0,
  let y := f 1,
  let z := f 2,
  have := h x (hts x.2) y (hts y.2) z (hts z.2)
    (f.monotone $ by dec_trivial) (f.monotone $ by dec_trivial),
  have key₁ : (0 : fin 3) ≠ 1 := by dec_trivial,
  have key₂ : (1 : fin 3) ≠ 2 := by dec_trivial,
  cases this,
  { dsimp only [x, y] at this, exact key₁ (f.injective $ subtype.coe_injective this) },
  { dsimp only [y, z] at this, exact key₂ (f.injective $ subtype.coe_injective this) }
end


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.range
import Mathlib.PostPort

namespace Mathlib

namespace list

namespace nat

/-- The antidiagonal of a natural number `n` is the list of pairs `(i,j)` such that `i+j = n`. -/
def antidiagonal (n : ℕ) : List (ℕ × ℕ) := map (fun (i : ℕ) => (i, n - i)) (range (n + 1))

/-- A pair (i,j) is contained in the antidiagonal of `n` if and only if `i+j=n`. -/
@[simp] theorem mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
    x ∈ antidiagonal n ↔ prod.fst x + prod.snd x = n :=
  sorry

/-- The length of the antidiagonal of `n` is `n+1`. -/
@[simp] theorem length_antidiagonal (n : ℕ) : length (antidiagonal n) = n + 1 := sorry

/-- The antidiagonal of `0` is the list `[(0,0)]` -/
@[simp] theorem antidiagonal_zero : antidiagonal 0 = [(0, 0)] := rfl

/-- The antidiagonal of `n` does not contain duplicate entries. -/
theorem nodup_antidiagonal (n : ℕ) : nodup (antidiagonal n) :=
  nodup_map (function.left_inverse.injective fun (i : ℕ) => rfl) (nodup_range (n + 1))

@[simp] theorem antidiagonal_succ {n : ℕ} :
    antidiagonal (n + 1) = (0, n + 1) :: map (prod.map Nat.succ id) (antidiagonal n) :=
  sorry

end Mathlib