import Mathlib.Data.Nat.Basic
import Mathlib.Data.Fin.Basic
import Mathlib.Data.Finset.Powerset
import Mathlib.Data.Fintype.CardEmbedding
import Mathlib.Algebra.BigOperators.Order
import Mathlib.Tactic.Tauto

open Finset Nat Classical

/-

Basic Ramsey theory for graphs

**Main results**

1). Upper bound (Ramsey's Theorem) R(s+1,t+t) ≤ (s+t).choose s (DONE)

Ramsey (s t : ℕ)  : Ramsey_of ((s + t).choose s) s.succ t.succ :=

2). Lower bound (Erdos prob): if (n.choose s) < 2^((s.choose 2)-1) then n < R(s,s)
(but written without division)

 Ramsey_lower_bound (s n : ℕ) (hn: 2 ≤ s ) :
(n.choose s) * 2 * (2^((n.choose 2) - (s.choose 2) )) < 2^(n.choose 2) → ¬ Ramsey_of n s s

3). Existence of k-colour 2-graph Ramsey numbers and Schur's theorem
kcol_Ramsey (s: Fin k.succ → ℕ) : ∃ n, kRamsey_of n s

4).  Schur's theorem: for any k, there exists n such that in any k-coloring of ℕ there is
a monochromatic solution to x + y = z with x,y,z < n
Schur' (k:ℕ) : ∃ (n:ℕ), Schur n k

-/
open Finset Nat

section twocolour

/-- Only two colours for now. We can think of 0 as red and 1 as blue -/
lemma  fin_two_not (a : Fin 2) : ¬ a = 0 ↔ a = 1 :=by
  apply Iff.intro
  · intro hn0
    have h1: (a:ℕ).succ ≤ 2:=a.2
    rw [succ_le_succ_iff] at h1
    rw [← Fin.val_eq_val] at *
    apply le_antisymm h1
    rwa [one_le_iff_ne_zero]
  · intro h1 h0
    rw [h0] at h1
    exact Fin.zero_ne_one h1

/- flip a colour -/
def not_c (c : Fin 2) : Fin 2:= if (c = 0) then 1 else 0

/-- not not  -/
lemma not_not_c (c : Fin 2) : not_c (not_c c) = c:=
by
  rw [not_c,not_c]
  split_ifs with h
  contradiction
  exact h.symm
  rw [fin_two_not] at h
  exact h.symm
  contradiction

/-- the flipped colouring given by swapping all colours -/
def col_flip (col : Finset ℕ → Fin 2) (A: Finset ℕ) : Fin 2 :=  (not_c (col A))

/-- A col is mono on a set A iff every pair in the set receives the same colour  -/
def mono_c_on (A : Finset ℕ) (col : Finset ℕ → Fin 2) (c :Fin 2) :  Prop:=
∀ (e : Finset ℕ), e ∈ Finset.powersetLen 2 A → col e = c

/-- Trivially if A is empty or a singleton any colouring is mono on it-/
lemma mono_on_subsingleton {A : Finset ℕ} (h: A.card < 2) (col : Finset ℕ → Fin 2) (c : Fin 2) : mono_c_on A col c:=
by
  intro e he
  apply False.elim
  rw [powersetLen_empty 2 h] at he
  contradiction

/-- col is mono on A iff its flipped version is mono -/
lemma mono_flip  {A : Finset ℕ} {col : Finset ℕ → Fin 2} {c : Fin 2} : mono_c_on A col c ↔
mono_c_on A (col_flip col) (not_c c):=
by
  simp_rw [col_flip]
  dsimp
  apply Iff.intro
  intros hm e he
  dsimp
  rw [hm e he]
  intro hm e he
  have t1:=hm e he
  dsimp at t1
  apply_fun not_c at t1
  simp_rw [not_not_c] at t1
  assumption

/-- A colouring col is a Ramsey_col for N s t if every n-set contains a red s-set or a blue t-set under col -/
def Ramsey_col (col : Finset ℕ → Fin 2) (N s t : ℕ) : Prop :=
∀ {V : Finset ℕ}, N ≤ V.card → (∃ (A : Finset ℕ), A ⊆ V ∧ ((mono_c_on A col 0 ∧ s ≤ A.card) ∨ (mono_c_on A col 1 ∧ t ≤ A.card)))

/-- N is Ramsey for s,t if every colouring is a Ramsey_col for n s t -/
def Ramsey_of (N s t : ℕ): Prop:= ∀ (col : Finset ℕ → Fin 2), Ramsey_col col N s t

/-- if N is Ramsey for s,t and N ≤ M then m is also Ramsey -/
lemma mono_Ramsey_of {N M s t: ℕ} (h : Ramsey_of N s t) (hm: N ≤ M) : Ramsey_of M s t :=
by
  intro col V h2
  exact  h col (hm.trans h2)

/-- given a Finset V and n ∉ V the nbhd_col c is the set of w ∈ V such that col {w, n} = c -/
def nbhd_col {n : ℕ}  (col : Finset ℕ → Fin 2) (c : Fin 2) {V: Finset ℕ}(hV: n ∉ V) : Finset ℕ:= V.filter ( λ w => col (insert w {n}) = c)

/-- rw lemma for nbhd_col -/
lemma col_nhbd_col {n w: ℕ} {col : Finset ℕ → Fin 2} {c: Fin 2}{V : Finset ℕ}(hV: n ∉ V)  (hw: w ∈ nbhd_col col c hV) : col (insert w {n}) = c:=
by
  exact (mem_filter.1 hw).2

/-- Any vertex in nbhd_col is in the original set V -/
lemma mem_col_nbhd_range {v : ℕ} {n : ℕ} {col : Finset ℕ → Fin 2} {c: Fin 2} {V : Finset ℕ}{hV: n ∉ V} (hv :v ∈ nbhd_col col c hV): v ∈ V:=
by
  exact (mem_filter.1 hv).1

/-- Any subset of nbhd_col is a subset of V -/
lemma col_nbhd_sub_range {n : ℕ} {col : Finset ℕ → Fin 2} {c: Fin 2}
{A V : Finset ℕ}{hV: n ∉ V} (hA: A ⊆ nbhd_col col c hV) : A ⊆ V:=
by
  intros v hv
  exact mem_col_nbhd_range (hA hv)

/-- the sets {b,a} and {a,b} are equal (note the proof is not refl)-/
lemma insert_eq' (a b : ℕ)  : (insert a {b}: Finset ℕ)= insert b {a} :=by
ext x
apply Iff.intro
· intro h
  rw [mem_insert,  mem_singleton] at *
  rwa [or_comm]
· intro h
  rw [mem_insert,  mem_singleton] at *
  rwa [or_comm]

/-- Given an edge from n to the c-coloured nbhd of n it has colour c-/
lemma mono_nbhr {n : ℕ}{A V e: Finset ℕ} {col: Finset ℕ → Fin 2} {c : Fin 2} {hV: n ∉ V} (hnb: A ⊆ nbhd_col col c hV)
(he: e ∈ image (insert n) (powersetLen 1 A)): col e = c:=by
  simp_rw [mem_image, mem_powersetLen,card_eq_one] at he
  obtain ⟨B,⟨h1,⟨b,rfl⟩⟩,h3⟩:=he
  rw [←h3,insert_eq']
  exact col_nhbd_col hV ((h1.trans hnb) (mem_singleton_self b))

/-- If A is mono c and contained in the set of c-col nbhrs of n then A ∪ {n} is also mono c-/
lemma mono_c_ext  {n : ℕ}{A V : Finset ℕ} {col: Finset ℕ → Fin 2} {c : Fin 2} {hV: n ∉ V}
 (hm : mono_c_on A col c) (hnb: A ⊆ nbhd_col col c hV) :
mono_c_on (insert n A) col c:=by
  intros e he
  rw [powersetLen_succ_insert,mem_union] at he
  cases' he with he he
  exact hm e he
  exact (mono_nbhr hnb he)
  exact not_mem_mono (col_nbhd_sub_range hnb) hV

/-- red and blue nbhds of n are disjoint-/
lemma  nbhd_col_disj {n : ℕ} {V : Finset ℕ} (col : Finset ℕ → Fin 2)   (hV: n ∉ V): Disjoint (nbhd_col col 0 hV ) (nbhd_col col 1 hV):=by
  unfold nbhd_col
  intros w hw0 hw1 x hx
  have hx0:=hw0 hx
  have hx1:=hw1 hx
  dsimp at *
  simp_rw [mem_inter,mem_filter] at *
  apply False.elim
  rcases hx0 with ⟨_,hx0⟩
  rcases hx1 with ⟨_,hx1⟩
  rw [hx0] at hx1
  apply Fin.zero_ne_one hx1

/- union of red and blue nbhds of n ∉ V is V-/
lemma  nbhd_col_union_eq {n : ℕ} {V : Finset ℕ} (col : Finset ℕ → Fin 2) (hV: n ∉ V) : (nbhd_col col 0 hV) ∪ (nbhd_col col 1 hV) = V :=by
  unfold nbhd_col
  convert filter_union_filter_neg_eq (λ w => col (insert w {n})  = 0) V
  simp_rw [fin_two_not]

/-- sum of red and blue nbhds is |V| -/
lemma card_col_nbhd {n : ℕ} {V : Finset ℕ} (col : Finset ℕ → Fin 2)   (hV: n ∉ V) :
V.card = (nbhd_col col 0 hV).card + (nbhd_col col 1 hV).card :=by
  have :=card_union_eq (nbhd_col_disj col hV)
  rwa [nbhd_col_union_eq] at this

/-- The inequality we require for the inductive step in Ramsey's theorem -/
lemma nbhd_cards_add_imp {a b c d: ℕ} :  a + b - 1 ≤ c + d  → a ≤ c ∨ b ≤ d:=by
  intros h
  contrapose h
  push_neg at h
  change c.succ ≤ a ∧ d.succ ≤ b at h
  have :=add_lt_add_of_le_of_lt h.1 h.2
  rw [succ_add] at this
  exact (not_le_of_gt (le_pred_of_lt  this))

/-- Key step  R (s+1,t+1) ≤ R(s,t+1) + R(s+1,t) -/
lemma Ramsey_step {a b s t : ℕ} (hab : 1 ≤ a + b): Ramsey_of a s t.succ → Ramsey_of b s.succ t
→ Ramsey_of (a+b) s.succ t.succ:=by
  intro ra rb col W hc
  --- Need to show W contains a set of size s+1  that is red or t+1 that is blue
  -- Since 0 < a+b , so W is non-empty and we can find a element n ∈ W.
  -- We work in the nbhd of n, which is V := W.erase n
  obtain ⟨n,hn⟩:=card_pos.1 (hab.trans hc)
  set V:= W.erase n with hVr
  -- n ∉ V
  have hV:=not_mem_erase n W
  -- |V| = |W|-1
  have hVc:=card_erase_of_mem hn
  rw [← hVr] at hVc
  have :=pred_le_pred hc
  rw [← pred_eq_sub_one] at hVc; rw [← hVc] at this
  rw [ card_col_nbhd col hV,pred_eq_sub_one] at  this
  -- Have a + b - 1 ≤ |V0| + |V1| (so we can apply previous lemma to say..)
  cases' nbhd_cards_add_imp this with h h
 --- Case 1) a ≤ |V0| so we use Ramsey_of a s t+1 to get set C ⊆ A such that either
  rcases ra col h with ⟨C,hC1,⟨hR2,hR3⟩| ⟨hB2,hB3⟩⟩
  use (insert n C)
  refine' ⟨insert_subset.2 ⟨hn,(col_nbhd_sub_range hC1).trans (erase_subset n W)⟩,_⟩
  left
  refine' ⟨mono_c_ext hR2 hC1,_⟩
  convert succ_le_succ hR3
  apply card_insert_of_not_mem
  intro hnR; exact  hV (mem_col_nbhd_range (hC1 hnR))
  exact  ⟨C,(col_nbhd_sub_range hC1).trans  (erase_subset n W),Or.inr ⟨hB2,hB3⟩⟩
  rcases rb col h with ⟨C,hC1,⟨hR2,hR3⟩| ⟨hB2,hB3⟩⟩
  exact ⟨C,(col_nbhd_sub_range hC1).trans  (erase_subset n W), Or.inl ⟨hR2,hR3⟩⟩
  use (insert n C)
  refine' ⟨insert_subset.2 ⟨hn,(col_nbhd_sub_range hC1).trans (erase_subset n W)⟩,_⟩
  right
  refine' ⟨mono_c_ext hB2 hC1,_⟩
  convert succ_le_succ hB3
  apply card_insert_of_not_mem
  intro hnR;exact hV (mem_col_nbhd_range (hC1 hnR))

/-- Symmetry in (s,t) -/
lemma Ramsey_symm (s t n : ℕ) : Ramsey_of n s t → Ramsey_of n t s:=by
  intros h col V hV
  rcases (h (col_flip col) hV) with ⟨A,hA1,⟨hA2,hA3⟩ | ⟨hA2,hA3⟩⟩
  exact ⟨A,hA1, Or.inr ⟨mono_flip.2 hA2,hA3⟩⟩
  exact ⟨A,hA1,Or.inl ⟨mono_flip.2 hA2,hA3⟩⟩

/-- R(0,t) ≤ 0 and R(1,t) ≤ 1 -/
lemma Ramsey_lt_two {s t : ℕ} (h : s < 2): Ramsey_of s s t:=by
  intro col V hV
  obtain ⟨B,hB1,rfl⟩:=exists_smaller_set V s hV
  exact ⟨B,hB1,Or.inl ⟨mono_on_subsingleton h col 0,le_refl _⟩⟩

/-- R(0,t) ≤ 0 -/
lemma Ramsey_zero (t : ℕ): Ramsey_of 0 0 t:=
by
  exact Ramsey_lt_two zero_lt_two

/-- R(1,t) ≤ 1 -/
lemma Ramsey_one (t : ℕ): Ramsey_of 1 1 t:=
by
  exact Ramsey_lt_two one_lt_two

/-- R(s,2) ≤ s -/
lemma Ramsey_theorem_two (s : ℕ) : Ramsey_of s s 2:=
by
  intro col V hV
  by_cases h : ∃(e: Finset ℕ), e ∈ powersetLen 2 V ∧ col e = 1
  obtain ⟨e,he⟩:=h
  refine' ⟨e,(mem_powersetLen.1 he.1).1,Or.inr ⟨_, (mem_powersetLen.1 he.1).2.symm.le⟩⟩
  intros x
  have :=powersetLen_self e
  intros hx
  rw [(mem_powersetLen.1 he.1).2] at this
  rw [this,mem_singleton] at hx
  convert he.2
  push_neg at h
  refine' ⟨V, le_refl V, _⟩
  left
  refine' ⟨_ ,hV⟩
  intros e he
  have := h e he
  dsimp at this
  rwa [← fin_two_not,not_not] at this

/-- Ramsey's theorem: R(s+1,t+1) ≤ (s+t).choose s -/
theorem Ramsey (s t : ℕ)  : Ramsey_of ((s + t).choose s) s.succ t.succ :=
by
  induction' s with s hs generalizing t
  rw [choose_zero_right]
  exact Ramsey_one t.succ
  induction' t  with t ht generalizing s
  simp_rw [add_zero, choose_self]
  apply Ramsey_symm
  exact Ramsey_one _
  rw [succ_add,add_succ,choose_succ_succ,← add_succ]
  refine' Ramsey_step _ (hs t.succ) _
  change 0 < _
  apply add_pos
  refine' choose_pos _
  exact le_add_right (le_refl s)
  refine' choose_pos _
  rw [add_succ]
  apply succ_le_succ (le_add_right (le_refl s))
  rw [add_succ,← succ_add]
  exact ht s hs

/-- R(3,3) ≤ 6-/
lemma R33 : Ramsey_of 6 3 3:=
by
  exact Ramsey 2 2

/-- R(3,4) ≤ 10 -/
lemma R34 : Ramsey_of 10 3 4:=
by
  exact Ramsey 2 3

/-- R(4,4) ≤ 20 -/
lemma R44 : Ramsey_of 20 4 4:=
by
  exact Ramsey 3 3

/-- R(5,5) ≤ 70 -/
lemma R55 : Ramsey_of 70 5 5:=
by
  exact Ramsey 4 4

/-- R(6,6) ≤ 252 -/
lemma R66 : Ramsey_of 252 6 6:=
by
  exact Ramsey 5 5

-- section lower_bounds

-- /-- If n is Ramsey for s then  for every coloring of range n by red/blue there is a subset
--  A of size at least s and a color c such that all pairs coloured of A colored by c.  -/
-- lemma Ramsey_of_range {n s: ℕ} (hr: Ramsey_of n s s) : ∀ (col: Finset ℕ → Fin 2),
-- ∃ (A: Finset ℕ), ∃ (c : Fin 2), A ⊆ range n ∧ s ≤ A.card ∧ (∀ {e}, e ∈ powersetLen 2 A → col e = c ) :=
-- by
--   intro col,
--   obtain ⟨A,hA1,⟨hA2,hA3⟩|⟨hA2,hA3⟩⟩:= hr col (card_range n).symm.le,
--   exact ⟨A,0,hA1,hA3, hA2⟩,
--   exact ⟨A,1,hA1,hA3,hA2⟩,
--

-- /-- n is not Ramsey for s if there is a 2-coloring such that for any color c ∈ {0,1}  and any s-subset S ⊆ range n
-- there is a pair e ⊆ S that is not coloured c -/
-- theorem Ramsey_lb (s n: ℕ) :
-- (∃ (col : Finset ℕ → Fin 2),∀ (c: Fin 2), ∀ (S ∈ powersetLen s (range n)), ∃ e, e ∈powersetLen 2 S ∧ col e ≠ c)  → ¬ Ramsey_of n s s :=
-- by
--   intros h hr,
--   obtain ⟨col,hc⟩:=h,
--   obtain ⟨A,c,hA1,hA2,hA3⟩:=(Ramsey_of_range hr) col,
--   obtain ⟨B,hB⟩:= exists_smaller_set A s hA2,
--   specialize hc c B, rw mem_powersetLen at hc,
--   obtain ⟨e,he1,he2⟩:=hc ⟨hB.1.trans hA1,hB.2⟩,
--   apply he2,
--   apply hA3,
--   exact powersetLen_mono hB.1 he1,
--

-- lemma Finset_fin2 : (univ: Finset (Fin 2)) = ({0}:Finset (Fin 2)) ∪ ({1}:Finset (Fin 2))  ∧ disjoint ({0}:Finset (Fin 2))  ({1}:Finset (Fin 2)):=
-- by
--   split,
--   ext, simp_rw [mem_union,mem_singleton,mem_univ],
--   split,
--   intro h, by_cases a = 0, left , exact h, right, exact (fin_two_not _).1 h,
--   intro, triv,
--   intros x hx,
--   simp only [inf_eq_inter, inter_singleton_of_not_mem, mem_singleton, Fin.one_eq_zero_iff, nat.one_ne_zero, not_false_iff,not_mem_empty] at hx,
--   exact hx,
--

-- lemma map_fin_eq {n : ℕ} (A: Finset (Fin n)) :Finset.Fin n (A.map Fin.coe_embedding) = A :=
-- by
--   ext,
--   simp_rw [mem_fin, mem_map,Fin.coe_embedding_apply,  exists_prop,← Fin.ext_iff,exists_eq_right],
--

-- lemma map_fin_range {n : ℕ} (S: Finset (Fin n)) : S.map Fin.coe_embedding ⊆range n:=
-- by
--   intros x,
--   rw [mem_map,mem_range],
--   rintro ⟨a,h1,h2⟩, rw Fin.coe_embedding_apply at h2,
--   subst_vars,
--   exact a.2,
--

-- /-- Equiv to show existence of coloring of Fin n with no mono K_s to showing coloring of ℕ -/
-- lemma fin_lb' (s n : ℕ) : (∃ (col : Finset ℕ → Fin 2), ∀(c: Fin 2), ∀ (S ∈ powersetLen s (range n)), ∃ e, e ∈powersetLen 2 S ∧ col e ≠ c)  ↔
-- (∃ (colf : Finset (Fin n) → Fin 2),∀ (c: Fin 2), ∀ (S:Finset (Fin n)), S.card = s →  ∃ e, e ∈ powersetLen 2 S ∧ colf e ≠ c) :=
-- by
--   split,
--   intro h, cases h with col hc,
--   set colf: Finset (Fin n) → Fin 2 :=  (λ s, col (s.map Fin.coe_embedding)),
--   use colf,rintros c S hS,
--   specialize hc c (S.map Fin.coe_embedding),
--   rw mem_powersetLen at hc,
--   rw card_map at hc,
--   obtain ⟨e,he,hec⟩:=hc ⟨map_fin_range S,hS⟩,
--   simp_rw mem_powersetLen at he ⊢,
--   rw subset_map_iff at he,
--   obtain ⟨hu,hf⟩:=he,
--   obtain ⟨u,H1,H2⟩:=hu,
--   refine ⟨u,⟨H1,_⟩,_⟩,
--   rwa [H2,card_map] at hf,
--   rw H2 at hec, exact hec,
--   --
--   intro h, cases h with colf hc,
--   set col: Finset ℕ → Fin 2:=(λ s, if (s ⊆ range n) then (colf (s.Fin n)) else 0) with hcol,
--   use col, rintros c S hS,  rw mem_powersetLen at hS,
--   specialize hc c (S.Fin n),
--   cases hS with hr hc2,
--   have :=@fin_map n S,
--   rw filter_true_of_mem at this,
--   rw [← this, card_map] at hc2,
--   obtain ⟨e,he,hec⟩:= hc hc2,
--   use (e.map Fin.coe_embedding),
--   rw mem_powersetLen at *,
--   clear hc, rw card_map,refine ⟨⟨_,he.2⟩,_⟩,
--   cases he with he1 he2,
--   rw ← this, rw subset_map_iff, exact ⟨e,he1,rfl⟩,
--   convert hec, rw hcol,dsimp,split_ifs,
--   congr', exact map_fin_eq e,
--   exfalso, apply h, exact map_fin_range e,
--   intros x hx, exact mem_range.1 (hr hx),
--

-- open_locale classical
-- open fintype
-- variables {α β :Type*} [fintype α] [fintype β]

-- noncomputable
-- def equiv_sub_fun {α β :Type*} [fintype α] [fintype β] (p : α → Prop) (b : β):
-- {f : α → β // ∀x, ¬ p x → f x = b} ≃ Π x:α, p x → β:=
-- { to_fun := λ f x hx, f.val x,
--   inv_fun := by
--     intros h,
--     set f: α → β :=λ x, if hx: p x then (h x hx) else b with hf,
--     refine ⟨f,_⟩,
--     intros x hx , rw hf,
--     dsimp, simp only [dite_eq_right_iff],
--     intros h1, contradiction,
--   ,
--   left_inv := by
--     intros f,
--     simp only [subtype.val_eq_coe, dite_eq_ite],
--     ext,
--     simp only [subtype.coe_mk, ite_eq_left_iff],
--     intro hx,
--     have :=f.property x hx, simp_rw ← this,
--     refl,
--   ,
--   right_inv := by
--   intros h, simp only [dite_not] at *,
--   ext, split_ifs, refl,
--   ,  }

-- def equiv_prop_true_fun (P: Prop) (h : P) [fintype β] : (P → β) ≃ β:=
-- { to_fun :=λ f, f h,
--   inv_fun := λ b,λ h1, b,
--   left_inv := by
--     intros h2,dsimp, simp only [eq_self_iff_true],
--   ,
--   right_inv := by
--     intro b, dsimp,refl,
--   , }

-- def equiv_prop_false_fun (P: Prop) (h : ¬P) [fintype β] : (P → β) ≃ unit:=
-- { to_fun :=λ f, punit.star,
--   inv_fun := by
--   intros u h1,exfalso,apply h h1,
--   ,
--   left_inv := by
--     intro f,dsimp,
--     ext,contradiction,
--   ,
--   right_inv := by
--   intro u,dsimp, simp only [eq_iff_true_of_subsingleton],
--   , }

-- lemma function_res_card  {α β :Type*} [fintype α] [fintype β] (p: α →Prop) (b : β):
-- fintype.card  (Π x:α,p x → β) = card β ^(Finset.card (univ.filter (λx, p x))):=
-- by
--   simp only [fintype.card_pi],
--   have : ∀ a:α, (fintype.card (p a → β) = if (p a) then (card β) else 1),{
--     intros a,
--     by_cases p a, simp only [*, if_true] at *,
--     rw card_eq, use equiv_prop_true_fun _ h,
--     simp only [*, if_false] at *,
--     rw ← card_unit,
--     rw card_eq,  use equiv_prop_false_fun  _ h,},
--   simp_rw [this, prod_ite,  prod_const, one_pow, mul_one],
--

-- lemma card_fun_res {α β :Type*} [fintype α] [fintype β] (p: α →Prop ) (b : β):
-- fintype.card ({f:α → β // ∀x, ¬ p x → f x = b}) = card β ^(Finset.card (univ.filter (λx,  p x))):=
-- by
--   rw ← function_res_card p b,
--   apply card_eq.2,  use equiv_sub_fun p b,
--

-- --subtype of 2-edge colorings of K_n
-- def twocol (n : ℕ) :Type*:= {A:Finset (Fin n) // A.card = 2} → Fin 2

-- def flipcol {n : ℕ}: twocol n → twocol n :=
-- λ col e, not_c (col e)

-- def not_sub {n : ℕ} (S: Finset (Fin n)): {A:Finset (Fin n) // A.card = 2} → Prop:=λ e, ¬ ↑e ⊆ S

-- def twocol_mono_c {n : ℕ} (c : Fin 2) (S: Finset (Fin n))  : twocol n → Prop :=
-- λ col, ∀ e: {A:Finset (Fin n) // A.card = 2}, e.val ⊆ S →  col e = c

-- def twocol_mono {n : ℕ} (S: Finset (Fin n))  : twocol n → Prop :=
-- λ col,  (∀ e: {A:Finset (Fin n) // A.card = 2}, e.val ⊆ S →  col e = 0) ∨ (∀ e: {A:Finset (Fin n) // A.card = 2}, e.val ⊆ S →  col e = 1)

-- lemma flip_mono {n : ℕ} (c : Fin 2) (S: Finset (Fin n)) (col: twocol n) : twocol_mono_c c S col ↔ twocol_mono_c (not_c c) S (flipcol col):=
-- by
--   unfold twocol_mono_c flipcol,
--   split,
--   intros h e he, rw h e he,
--   intros h e he, rw ← not_not_c c,
--   rw ←  h e he, rw not_not_c,
--

-- instance twocol_fintype (n : ℕ) : fintype (twocol n):=
-- by
--   unfold twocol,
--   apply_instance,
--

-- /-- The number of k-edge colourings of K_n^r is...-/
-- lemma card_cols (n k r: ℕ) : fintype.card ({A:Finset (Fin n) // A.card = r} → Fin k )= k^(n.choose r):=
-- by
--   rw [fintype.card_fun, fintype.card_fin, fintype.card_Finset_len,fintype.card_fin],
--

-- lemma card_twocols (n : ℕ): fintype.card (twocol n)= 2^(n.choose 2):=card_cols n 2 2

-- lemma card_filter_powersetLen {n k: ℕ} (S: Finset (Fin n)):
-- (filter (λ (x : {A: Finset (Fin n) // A.card = k}), ↑x ⊆ S) univ).card = S.card.choose k :=
-- by
--   dsimp, rw [← card_powersetLen k S, Finset.card_congr],
--   intros a h1 , rw mem_filter at h1, rw mem_powersetLen,
--   split, exact h1.2, exact a.property,
--   intros a b ha hb heq,
--   exact subtype.eq heq,
--   intros b hb, rw mem_powersetLen at hb,
--   refine ⟨⟨b,hb.2⟩,_⟩,
--   rw [mem_filter,exists_prop],
--   exact ⟨⟨mem_univ _, hb.1 ⟩,rfl⟩,
--

-- lemma card_filter_powersetLen_compl {n : ℕ} (k : ℕ) (S: Finset (Fin n)):
-- (filter (λ (x : {A: Finset (Fin n) // A.card = k}), ¬↑x ⊆ S) univ).card = n.choose k - S.card.choose k :=
-- by
--   have :=@card_Finset_len (Fin n) _ k,
--   rw fintype.card_Fin at this,
--   rw ← Finset.card_univ at this,
--   rw ← filter_card_add_filter_neg_card_eq_card  (λx : {A:Finset (Fin n)// A.card = k}, ↑x ⊆ S) at this,
--   rw [← this, card_filter_powersetLen S, add_tsub_cancel_left],
--

-- /-- The number of 2-edge colorings of K_n that are mono c on a set S of size s is
--     2^(n.choose 2 - s.choose 2) -/
-- lemma card_mono_cols {n : ℕ} {c : Fin 2} {S: Finset (Fin n)}:
-- fintype.card ({col: twocol n // twocol_mono_c c S col}) = 2^(n.choose 2 - S.card.choose 2):=
-- by
--   unfold twocol_mono_c,
--   have := @card_fun_res ({A:Finset (Fin n) // A.card = 2}) (Fin 2) _ _ (not_sub S) c,
--   unfold not_sub at this, simp_rw not_not at this,
--   rwa [ fintype.card_fin, card_filter_powersetLen_compl 2 S] at this,
--

-- lemma Ramsey_lb_twocol {s n: ℕ} :
-- (∃ col: twocol n, ∀ (c: Fin 2), ∀ (S:Finset (Fin n)), S.card = s →  ¬ twocol_mono_c c S col) → ¬ Ramsey_of n s s  :=
-- by
--   intro h,
--   apply Ramsey_lb, rw (fin_lb' s n),
--   obtain ⟨col,hc⟩:=h,
--   set colf: Finset (Fin n) → Fin 2:= λ x, if hx: x.card = 2 then  col ⟨x,hx⟩ else 0 with hcolf,
--   use colf,intros c S hS,
--   specialize hc c S hS,
--   contrapose hc, rw not_not, push_neg at hc,
--   unfold twocol_mono_c, intros e he,
--   specialize hc ↑e, rw mem_powersetLen at hc,
--   rw hcolf at hc,
--   simp only [eq_self_iff_true, subtype.val_eq_coe, subtype.coe_eta, dite_eq_ite, and_imp] at *,
--   specialize hc he e.property,
--   split_ifs at hc, exact hc,
--   exfalso, apply h, exact e.property,
--

-- open_locale big_operators

-- lemma card_card (Q: α → β → Prop) {a : α}: fintype.card ({b:β//Q a b}) = Finset.card {b: β| Q a b}.to_Finset :=
-- by
--   simp only [set.to_Finset_card, set.coe_set_of],
--

-- lemma subtype_pigeon_exist (F: Finset α) (p: α → β  → Prop) :
-- ∑ a in F, fintype.card {b : β // p a b} < fintype.card β → ∃ b, ∀ a, a ∈ F → ¬ p a b:=
-- by
--   simp_rw card_card p,
--   simp_rw Finset.card_eq_sum_ones, --simp,
--   intros hf, by_contra, push_neg at h,
--   rw sum_comm' _ at hf,
--   rotate,
--   exact (univ:Finset β),
--   intro b, exact {a:α| a∈F ∧ p a b}.to_Finset,
--   intros x y,
--   simp_rw set.mem_to_Finset at *,
--   split,
--   rintros ⟨hx,hy⟩,  exact ⟨⟨hx,hy⟩,mem_univ _⟩,
--   intro h,  exact ⟨h.1.1,h.1.2⟩,
--   simp_rw sum_const at hf,
--   simp only [set.to_Finset_card, set.coe_set_of, smul_one_eq_coe, cast_id] at hf,
--   have c1:∀ b, 1 ≤ card {x//x ∈F ∧ p x b},{
--     intro b, change 0 < _, rw card_pos_iff,
--     obtain ⟨a,ha⟩:=h b, use ⟨a,ha⟩,},
--   rw fintype.card_eq_sum_ones at hf,
--   apply lt_irrefl (∑ b: β,1),
--   apply lt_of_le_of_lt _ hf,
--   apply sum_le_sum, intros b hb, exact c1 b,
--

-- /-- The mono two colorings that are red on S are disjoint from those that are blue-/
-- lemma col_mono_disj {n : ℕ} {S: Finset (Fin n)} (hn : 2 ≤ S.card ) :
--  disjoint {col: twocol n | twocol_mono_c 0 S col}.to_Finset {col: twocol n | twocol_mono_c 1 S col}.to_Finset:=
-- by
--   simp only [set.to_Finset_disjoint_iff],
--   have := hn.trans (card_le_univ S), rw fintype.card_Fin at this,
--   intros col hc,
--   obtain ⟨e,he⟩:=exists_smaller_set _ _ hn,
--   simp only [set.inf_eq_inter, set.mem_inter_iff, set.mem_set_of_eq] at hc,
--   have c0:=hc.1 ⟨e,he.2⟩ he.1, have c1:=hc.2 ⟨e,he.2⟩ he.1,
--   rw c0 at c1, rw ← fin_two_not at c1, contradiction,
--

-- /-- The mono two colorings on S are either red or blue -/
-- lemma col_mono_union {n : ℕ} {S: Finset (Fin n)}  :  {col: twocol n | twocol_mono_c 0 S col}.to_Finset ∪ {col: twocol n | twocol_mono_c 1 S col}.to_Finset
-- = {col : twocol n | twocol_mono S col}.to_Finset
-- :=
-- by
--   ext, simp only [mem_union, set.mem_to_Finset, set.mem_set_of_eq],--simp only [set.mem_union, set.mem_set_of_eq],
--   unfold twocol_mono_c twocol_mono,
--

-- /-- Hence the number of mono colorings that of S is the sum over Fin 2 of mono 0 and mono 1 two-colourings -/
-- lemma sum_cols_mono {n : ℕ} {S: Finset (Fin n)} (hn : 2 ≤ S.card ) :
-- ∑  c, fintype.card ({col: twocol n // twocol_mono_c c S col})
-- = fintype.card ({col: twocol n // twocol_mono S col}) :=
-- by
--   simp_rw card_card,
--   rw [Finset_fin2.1,sum_union Finset_fin2.2, sum_singleton,sum_singleton],
--   rw ← card_disjoint_union, congr, exact col_mono_union,
--   exact col_mono_disj hn,
--

-- -- All quantities in this inequality are now known to us
-- lemma union_card_mono_le_imp {s n : ℕ} (hn: 2 ≤ s ):
-- ∑ S in powersetLen s univ, ∑ c: Fin 2, fintype.card({col: twocol n // twocol_mono_c c S col} )
--                                     < fintype.card(twocol n) →¬Ramsey_of n s s:=
-- by
--   intro h,
--   apply Ramsey_lb_twocol,
--   have : ∀ S:Finset (Fin n), S ∈  powersetLen s univ →  2 ≤ S.card,{
--     intros S hS, rw mem_powersetLen at hS,rw hS.2, exact hn, apply_instance,
--   },
--   rw Finset.sum_congr at h,
--   rotate, refl,
--   intros S hS, exact sum_cols_mono (this S hS),
--   have :=subtype_pigeon_exist (powersetLen s (univ: Finset (Fin n))) twocol_mono h,
--   obtain ⟨col,h⟩:=this, use col, intros c S,
--   intros hc hf,
--   specialize h S,rw mem_powersetLen_univ_iff at h,
--   specialize h hc, apply h,
--   unfold twocol_mono,
--   by_cases hc2: c= 0,
--     left, rw hc2 at hf, exact hf,
--     right, rw fin_two_not c at hc2, rw hc2 at hf, exact hf,
--

-- -- The classical (easy) probabilistic lower bound for R(s,s)
-- theorem Ramsey_lower_bound (s n : ℕ) (hn: 2 ≤ s ) :
-- (n.choose s) * 2 * (2^((n.choose 2) - (s.choose 2) )) < 2^(n.choose 2) → ¬ Ramsey_of n s s:=
-- by
--   intros h,
--   apply union_card_mono_le_imp hn,
--   simp_rw card_mono_cols, unfold twocol, rw card_cols,
--   simp_rw sum_const, rw card_univ, rw fintype.card_fin,
--   simp_rw [nsmul_eq_mul, cast_id],
--   convert h,  nth_rewrite_rhs 0 ← fintype.card_Fin n,  rw ← card_univ,
--   rw ← card_powersetLen, rw Finset.card_eq_sum_ones,simp_rw sum_mul, rw one_mul,
--   apply Finset.sum_congr, refl,intros S hS,rw mem_powersetLen_univ_iff at hS,
--   rw hS,
--

--  lower_bounds

  twocolour

--  /-  k-colour 2-graph Ramsey numbers -/

-- section kcolour
-- variable {k : ℕ}

-- /-- A col is mono on a particular set iff every pair in the set receives the same colour  -/
-- def kmono_c_on (A : Finset ℕ) (col : Finset ℕ → Fin k) (c : Fin k)  : Prop:=
-- ∀ (e : Finset ℕ), e ∈ powersetLen 2 A → col e = c

-- /-- A colouring col is Ramsey for n s t if every n-set contains a red s-set or a blue t-set under col -/
-- def kRamsey_col (col : Finset ℕ → Fin k) (n : ℕ) (s : Fin k → ℕ) : Prop:= ∀ {V : Finset ℕ}, n ≤ V.card →
-- (∃ (A : Finset ℕ), ∃ (i : Fin k), (A ⊆ V ∧ kmono_c_on A col i ∧ (s i) ≤ A.card))

-- /-- n is Ramsey if every colouring is Ramsey for n (with s and t) -/
-- def kRamsey_of (n : ℕ) (s : Fin k → ℕ): Prop:= ∀ (col : Finset ℕ → Fin k), kRamsey_col col n s

-- /-- if n is Ramsey for s,t and n ≤ m then m is also Ramsey -/
-- lemma kmono_Ramsey_of {n m: ℕ} {s: Fin k → ℕ} (h : kRamsey_of n s) (hm: n ≤ m) : kRamsey_of m s  :=
-- by
--   intros col V h2,
--   exact  h col (hm.trans h2),
--

-- def kres (s : Fin k.succ → ℕ) : Fin k → ℕ:=λ i, s i

-- def kto2 (col : Finset ℕ → Fin k.succ) : Finset ℕ → Fin 2:=λ e, if (col e = k) then 1 else 0

-- def rescol {col : Finset ℕ → Fin k.succ} {A : Finset ℕ} (hm: mono_c_on A (kto2 col) 0) (hk : 0 < k): Finset ℕ →  (Fin k) :=
-- by
--   intros e,
--   by_cases he: e ∈ powersetLen 2 A,
--   have hcol:=hm e he,
--   unfold kto2 at hcol, simp only [ite_eq_right_iff, Fin.one_eq_zero_iff, nat.one_ne_zero] at hcol,
--   refine ⟨col e,_⟩,
--   by_contra,
--   have hk2:=Fin.eq_last_of_not_lt h, apply hcol, rw hk2,
--   exact (Fin.coe_nat_eq_last k).symm,
--   exact ⟨0,hk⟩,
--

-- lemma resol_eq_col {col : Finset ℕ → Fin k.succ} {A : Finset ℕ} (hm: mono_c_on A (kto2 col) 0)(hk : 0 < k):
-- ∀ e ∈ powersetLen 2 A, (rescol hm hk e : ℕ) = (col e):=
-- by
--   intros e he, unfold rescol, split_ifs, refl,
--

-- lemma mono_to_kmono_1 {col : Finset ℕ → Fin k.succ} {A : Finset ℕ} (hm: mono_c_on A (kto2 col) 1) : kmono_c_on A col k:=
-- by
--   unfold mono_c_on kto2 at hm,
--   simp only [ite_eq_left_iff, Fin.zero_eq_one_iff, nat.one_ne_zero] at hm,
--   unfold kmono_c_on,
--   intros e he,
--   specialize hm e he,
--   contrapose hm, push_neg, exact ⟨hm,not_false⟩,
--

-- lemma mono_to_kmono_0 {col : Finset ℕ → Fin k.succ} {A : Finset ℕ} {a: ℕ}{s : Fin k.succ → ℕ}
-- (hm: mono_c_on A (kto2 col) 0) (kra: kRamsey_of a (kres s)) (hA : a ≤ A.card) (hk: 0 < k):
--  ∃ (i:Fin k), ∃ (B:Finset ℕ), B⊆ A ∧ kmono_c_on B col i ∧ (s i) ≤ B.card:=
-- by
--   specialize kra (rescol hm hk) hA,
--   obtain ⟨B,i, hB1,hB2,hB3⟩:=kra,
--   refine ⟨i,B,hB1,_, hB3⟩,
--   intros e he,
--   have h1:=resol_eq_col hm hk e (powersetLen_mono hB1 he),
--   have h2:= hB2 e he, rw h2 at h1,
--   rw Fin.eq_iff_veq,
--   simp only [Fin.val_eq_coe, Fin.coe_eq_cast_succ, Fin.coe_cast_succ],  rw h1,
--

-- lemma kRamsey_step {a b : ℕ} (s: Fin k.succ → ℕ) (hk : 0 < k): kRamsey_of a (kres s) → Ramsey_of b a (s k) → kRamsey_of b s:=
-- by
--   intros kra rb col V hcv,
--   specialize rb (kto2 col) hcv,
--   obtain ⟨A,hA1,⟨hA2,hA3⟩|⟨hA2,hA3⟩⟩:=rb,
--   obtain ⟨i,B, hB1, hB2,hB3⟩:=mono_to_kmono_0 hA2 kra hA3 hk,
--   exact ⟨B,i,hB1.trans hA1,hB2,hB3⟩,
--   exact ⟨A,k,hA1,mono_to_kmono_1 hA2,hA3⟩,
--

-- lemma kRamsey_one  (s : Fin 1 → ℕ) : kRamsey_of (s 0) s:=
-- by
--   intros col A hA,
--   refine ⟨A,0,subset_refl _,  _ ,hA⟩,
--   intros e he, rw eq_iff_true_of_subsingleton, triv,
--

-- lemma kRamsey_of_zero {n : ℕ} (s : Fin k.succ → ℕ) :(s k) = 0 →   kRamsey_of n s:=
-- by
--   intros hk col A hA,
--   refine ⟨∅, k, empty_subset _,_, _⟩,
--   intros e he,  exfalso,
--   have hec1:=mem_powersetLen.1 he,
--   have hec2:=card_le_of_subset hec1.1,
--   rw [card_empty ,hec1.2]at hec2,
--   exact (not_le_of_gt zero_lt_two) hec2,
--   rw hk, exact zero_le',
--

-- -- For any number of colours (k+1) and any clique sizes s0 ,s1,... sk there is an n that will work..
-- theorem kcol_Ramsey (s: Fin k.succ → ℕ) : ∃ n, kRamsey_of n s:=
-- by
--   induction k with k h generalizing s,
--   exact ⟨s 0, kRamsey_one s⟩,
--   obtain ⟨a,ha⟩:= h (kres s),
--   have hk1:=kmono_Ramsey_of  ha (le_succ a),
--   refine ⟨(a + (s k.succ).pred).choose a,_⟩,
--   refine kRamsey_step s (succ_pos k) hk1 _,
--   cases (s k.succ),
--   apply Ramsey_symm,
--   apply mono_Ramsey_of (Ramsey_zero a.succ)  zero_le',
--   rw pred_succ, exact Ramsey a n,
--

--  kcolour

-- section schur

-- variable {k : ℕ}

-- def schur3 (x y z : ℕ) : Prop:= x + y = z ∧ 0 < x ∧ 0 < y ∧ 0 < z

-- lemma schur_of_ordered {a b c : ℕ} (h: a < b ∧ b < c): schur3 (c-b) (b-a) (c-a):=
-- by
--   exact ⟨tsub_add_tsub_cancel h.2.le h.1.le,nat.sub_pos_of_lt h.2, nat.sub_pos_of_lt h.1,nat.sub_pos_of_lt (h.1.trans h.2)⟩,
--

-- def scol (ncol : ℕ → Fin k.succ) : Finset ℕ → Fin k.succ:=
-- λ A, if hne : A.nonempty then (ncol (max' A hne - min' A hne)) else 0

-- lemma scol_pair {a b : ℕ} (h : a < b) (ncol : ℕ→ Fin k.succ) :scol ncol {a,b} = ncol (b - a):=
-- by
--   unfold scol,
--   set X:={a,b},
--   have ha: a ∈ X,
--   { rw mem_insert,left,refl,},
--   have hb: b ∈ X,
--   { rw mem_insert,right,exact mem_singleton_self b,},
--   set c:= max' X ⟨a,ha⟩ with hc,
--   set d:= min' X ⟨a,ha⟩ with hd,
--   have : X = insert a {b}:=rfl,
--   dsimp, split_ifs,   congr,
--   refine le_antisymm _ (le_max' X b hb),
--   apply max'_le, intros y hy, rw [mem_insert,mem_singleton] at hy,
--   cases hy,
--   rw hy, exact h.le, rwa hy,
--   refine le_antisymm  (min'_le {a,b} a ha) _,
--   apply le_min', intros y hy, rw [mem_insert,mem_singleton] at hy,
--   cases hy,
--   rwa hy, rw hy, exact h.le,
--   exfalso, apply h_1,
--   exact ⟨a,ha⟩,
--

-- /-- Schur n k holds iff n is sufficiently large that in any k-colouring of ℕ, every subsert of size at
-- least n contains a non-zero monochromatic solution of x + y = z -/
-- def Schur (n k : ℕ):Prop:=
--  ∀ (col : ℕ → Fin k.succ),∀ (V: Finset ℕ),
--   n ≤ V.card →  ∃ (x y z : ℕ), ∃ (c : Fin k.succ), schur3 x y z ∧ col x = c ∧ col y = c ∧ col z = c

-- lemma card_pred_le_card_erase (S : Finset ℕ) (a : ℕ) : S.card.pred ≤ (S.erase a).card:=
-- by
--   rw card_erase_eq_ite, split_ifs,refl,exact pred_le _,
--

-- /-- Any set of 3 nats can be ordered and the pairs are edges of the triangle on B -/
-- lemma card_three_nat {B : Finset ℕ} (h : B.card = 3) : ∃ (a b c : ℕ), a < b ∧ b < c ∧
--  {a,b} ∈ powersetLen 2 B ∧ {a,c} ∈ powersetLen 2 B ∧ {b,c} ∈ powersetLen 2 B:=
-- by
--   obtain ⟨x,y,z,hxy, hxz, hyz,hB⟩:=card_eq_three.1 h,
--   have hbx: x∈ B,{rw [hB,mem_insert],left,refl},
--   have hby: y∈ B,{rw [hB,mem_insert,mem_insert],right,left,refl},
--   have hbz: z∈ B,{rw [hB,mem_insert,mem_insert,mem_singleton],right,right,refl},
--   set a:= min' B ⟨x,hbx⟩,
--   set c:= max' B ⟨x,hbx⟩,
--   have haB: a ∈ B :=min'_mem B ⟨x,hbx⟩,
--   have hcB: c ∈ B :=max'_mem B ⟨x,hbx⟩,
--   have haltc:a < c,
--     {refine min'_lt_max'_of_card B (_:1<B.card),
--      rw h, exact succ_le_succ one_le_two},
--   have hBea:= card_erase_of_mem haB,
--   have :=card_erase_of_mem (mem_erase_of_ne_of_mem (ne_of_gt haltc) hcB),
--   rw [hBea,h] at this,
--   rw (by refl:3-1-1=1) at this,
--   obtain ⟨b,hb⟩:=card_eq_one.1 this,
--   have hbb: b ∈ {b}:=mem_singleton_self b,
--   rw ← hb at hbb,
--   have  hbB':=mem_of_mem_erase hbb,
--   have  hbB:=mem_of_mem_erase hbB',
--   refine ⟨a,b,c,_,_,_,_,_⟩,
--   have aleb:a≤ b:=min'_le B b hbB,
--   have hnab:a ≠ b := (ne_of_mem_erase hbB').symm,
--   exact lt_of_le_of_ne aleb hnab,
--   have blec:b≤ c:=le_max' B b hbB,
--   have hnbc:b≠c := (ne_of_mem_erase hbb),
--   exact lt_of_le_of_ne  blec hnbc,
--   {
--      refine mem_powersetLen.2 ⟨_,card_eq_two.2 ⟨a,b,⟨(ne_of_mem_erase hbB').symm,rfl⟩⟩⟩ ,
--      intros x hx1, rw [mem_insert,mem_singleton] at hx1,
--      cases hx1,  {rw hx1, exact haB}, {rw hx1, exact hbB},
--   },
--   {
--      refine mem_powersetLen.2 ⟨_,card_eq_two.2 ⟨a,c,⟨ne_of_lt haltc,rfl⟩⟩⟩,
--      intros x hx1, rw [mem_insert,mem_singleton] at hx1,
--      cases hx1,  {rw hx1, exact haB}, {rw hx1, exact hcB},
--   },
--   {
--     refine mem_powersetLen.2 ⟨_,card_eq_two.2 ⟨b,c,⟨(ne_of_mem_erase hbb), rfl⟩⟩⟩,
--      intros x hx1, rw [mem_insert,mem_singleton] at hx1,
--      cases hx1, {rw hx1, exact hbB},  {rw hx1, exact hcB},
--   },
--

-- /-- For any k the k-colour Ramsey number for triangles + 1 is sufficient to guarantee
--  mono x + y = z in every n-subset -/
-- theorem Schur' (k:ℕ) : ∃ (n:ℕ), Schur n k:=
-- by
--   set s: Fin k.succ → ℕ:= λ i , 3,
--   obtain ⟨n,hn⟩:=kcol_Ramsey s,
--   use n.succ, intros col V hv,
--   have:= (pred_le_pred hv).trans (card_pred_le_card_erase V 0),
--   rw pred_succ at this,
--   obtain ⟨A,i,hA1,hA2,hA3⟩:=hn (scol col) this,
--   obtain ⟨B,hB⟩:=exists_smaller_set A 3 hA3,
--   obtain ⟨a,b,c,hab,hbc,h1,h2,h3⟩:=card_three_nat hB.2,
--   refine ⟨c-b,b-a,c-a,i,schur_of_ordered ⟨hab,hbc⟩,_⟩,
--   have cab:=hA2 {a,b} (powersetLen_mono hB.1 h1),
--   rw scol_pair hab col at cab,
--   have cac:=hA2 {a,c} (powersetLen_mono hB.1 h2),
--   rw scol_pair (hab.trans hbc) col at cac,
--   have cbc:=hA2 {b,c} (powersetLen_mono hB.1 h3),
--   rw scol_pair hbc col at cbc,
--   exact ⟨cbc,cab,cac⟩,
--

--  schur


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

! This file was ported from Lean 3 source module topology.algebra.uniform_filter_basis
! leanprover-community/mathlib commit 531db2ef0fdddf8b3c8dcdcd87138fe969e1a81a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.FilterBasis
import Mathbin.Topology.Algebra.UniformGroup

/-!
# Uniform properties of neighborhood bases in topological algebra

This files contains properties of filter bases on algebraic structures that also require the theory
of uniform spaces.

The only result so far is a characterization of Cauchy filters in topological groups.

-/

open uniformity Filter

open Filter

namespace AddGroupFilterBasis

variable {G : Type _} [AddCommGroup G] (B : AddGroupFilterBasis G)

/-- The uniform space structure associated to an abelian group filter basis via the associated
topological abelian group structure. -/
protected def uniformSpace : UniformSpace G :=
  @TopologicalAddGroup.toUniformSpace G _ B.topology B.is_topological_add_group
#align add_group_filter_basis.uniform_space AddGroupFilterBasis.uniformSpace

/-- The uniform space structure associated to an abelian group filter basis via the associated
topological abelian group structure is compatible with its group structure. -/
protected theorem uniformAddGroup : @UniformAddGroup G B.UniformSpace _ :=
  @comm_topologicalAddGroup_is_uniform G _ B.topology B.is_topological_add_group
#align add_group_filter_basis.uniform_add_group AddGroupFilterBasis.uniformAddGroup

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (x y «expr ∈ » M) -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (x y «expr ∈ » M) -/
theorem cauchy_iff {F : Filter G} :
    @Cauchy G B.UniformSpace F ↔
      F.ne_bot ∧ ∀ U ∈ B, ∃ M ∈ F, ∀ (x) (_ : x ∈ M) (y) (_ : y ∈ M), y - x ∈ U :=
  by
  letI := B.uniform_space
  haveI := B.uniform_add_group
  suffices F ×ᶠ F ≤ 𝓤 G ↔ ∀ U ∈ B, ∃ M ∈ F, ∀ (x) (_ : x ∈ M) (y) (_ : y ∈ M), y - x ∈ U by
    constructor <;> rintro ⟨h', h⟩ <;> refine' ⟨h', _⟩ <;> [rwa [← this], rwa [this]]
  rw [uniformity_eq_comap_nhds_zero G, ← map_le_iff_le_comap]
  change tendsto _ _ _ ↔ _
  simp [(basis_sets F).prod_self.tendsto_iffₓ B.nhds_zero_has_basis, @forall_swap (_ ∈ _) G]
#align add_group_filter_basis.cauchy_iff AddGroupFilterBasis.cauchy_iff

end AddGroupFilterBasis


theorem mul_left_cancel (a b c : mynat) (ha : a ≠ 0) : a * b = a * c → b = c :=
begin
induction c with d hd generalizing b,
rw mul_zero,
rw mul_eq_zero_iff,
intro h,
cases h,
exfalso,
exact ha h,
exact h,
intro h,
cases b,
rw mul_zero at h,
symmetry at h,
rw mul_eq_zero_iff at h,
cases h,
exfalso,
exact ha h,
symmetry at h,
exact h,
rw succ_eq_succ_iff,
apply hd,
rw mul_succ at h,
rw mul_succ at h,
apply add_right_cancel _ a _,
exact h,
end


import data.nat.prime

open nat

lemma larger_prime' : ∀ n : ℕ, ∃ p, (prime p) ∧ (p > n) :=
begin
 intro n,
 let m := fact n + 1,
 let p := min_fac m,
 have m_ne_1 : m ≠ 1 := ne_of_gt (nat.succ_lt_succ (fact_pos n)),
 have p_gt_0 : p > 0 := min_fac_pos m,
 have p_prime : prime p := min_fac_prime m_ne_1,
 have not_p_le_n : ¬ p ≤ n, {
  intro p_le_n,
  have d0 : p ∣ fact n := dvd_fact p_gt_0 p_le_n,
  have d1 : p ∣ fact n + 1 := min_fac_dvd m,
  have d  : p ∣ 1 := (nat.dvd_add_iff_right d0).mpr d1,
  exact prime.not_dvd_one p_prime d
 },
 have p_gt_n : p > n := lt_of_not_ge not_p_le_n,
 exact ⟨p,⟨p_prime,p_gt_n⟩⟩,
end

lemma larger_prime'' : ∀ n : ℕ, ∃ p, (prime p) ∧ (p > n) :=
λ n,
 let m := fact n + 1 in
 let p := min_fac m in
 let p_prime := min_fac_prime (ne_of_gt (nat.succ_lt_succ (fact_pos n))) in
  ⟨p,⟨p_prime,
          (lt_of_not_ge (λ p_le_n,
                         prime.not_dvd_one
                         p_prime ((nat.dvd_add_iff_right
                                    (dvd_fact p_prime.pos p_le_n)).mpr (min_fac_dvd m))))⟩⟩


import tactic
import data.set
import incidence_geometry

def Point := ℝ × ℝ

@[simp] lemma point_neq_by_coords (A B : Point) : (A ≠ B) ↔ (A.1 ≠ B.1 ∨ A.2 ≠ B.2) :=
begin
  rw ← not_iff_not,
  push_neg,
  exact prod.ext_iff
end

@[ext] structure LineEq := (a b c : ℝ) (h : a ≠ 0 ∨ b ≠ 0)

definition line_eq (l m : LineEq) : Prop := ∃ (x : ℝ), x≠ 0 ∧ l.a = x * m.a ∧ l.b = x * m.b ∧ l.c = x * m.c

lemma line_eq_refl : reflexive line_eq :=
begin
  intro l,
  use 1,
  refine ⟨zero_ne_one.symm, _, _, _⟩,
  { rw one_mul },
  { rw one_mul },
  { rw one_mul },
end

lemma line_eq_symm : symmetric line_eq :=
begin
  intros l m hlm,
  rcases hlm with ⟨x, ⟨hx, ha, hb, hc⟩⟩ ,
  use x⁻¹,
  have hxinv : x⁻¹*x = 1, { finish }, /- TODO: remove finish -/
  refine ⟨inv_ne_zero hx,_,_,_⟩,
  { simp only [ha], rw [← mul_assoc, hxinv, one_mul] },
  { simp only [hb], rw [← mul_assoc, hxinv, one_mul] },
  { simp only [hc], rw [← mul_assoc, hxinv, one_mul] },
end

lemma line_eq_trans : transitive line_eq :=
begin
  intros l m n hlm hmn,
  rcases hlm with ⟨x, ⟨hx, ha₁, hb₁, hc₁⟩⟩ ,
  rcases hmn with ⟨y, ⟨hy, ha₂, hb₂, hc₂⟩⟩ ,
  use x*y,
  refine ⟨mul_ne_zero hx hy,_,_,_⟩,
  { rw [ha₁, ha₂, mul_assoc] },
  { rw [hb₁, hb₂, mul_assoc] },
  { rw [hc₁, hc₂, mul_assoc] },
end

theorem line_equiv : equivalence line_eq := ⟨line_eq_refl, line_eq_symm, line_eq_trans⟩

def Line.setoid : setoid LineEq := { r := line_eq, iseqv := line_equiv }

local attribute [instance] Line.setoid

def Line := quotient Line.setoid

def Line.reduce : LineEq → Line := quot.mk line_eq
instance : has_lift LineEq Line := { lift := Line.reduce }
instance : has_coe LineEq Line := { coe := Line.reduce }

def Line.mk (a b c : ℝ) (h : a ≠ 0 ∨ b ≠ 0) : Line := ↑(LineEq.mk a b c h)

def has_point' (l : LineEq) (P : Point) : Prop := l.a*P.1 + l.b*P.2 + l.c = 0

theorem has_point_well_defined {l m : LineEq} (h : l ≈ m) (P : Point): has_point' l P ↔ has_point' m P :=
begin
  cases h with x h,
  rcases h with ⟨hx, ha, hb, hc⟩,
  rw [has_point', ha, hb, hc, mul_assoc, mul_assoc, ← left_distrib, ← left_distrib],
  rw has_point',
  finish, /- TODO: remove finish -/
end

lemma has_point_well_defined' {l m : LineEq} (h: l ≈ m) : has_point' l = has_point' m := begin
  rw function.funext_iff,
  intro P,
  rw has_point_well_defined,
  exact h,
end

def has_point := quotient.lift has_point' @has_point_well_defined'

noncomputable def line_from_points {A B : Point} (hAB : A ≠ B) : Line :=
begin
  rw point_neq_by_coords at hAB,
  by_cases hx: A.1 = B.1,
  {
    let a : ℝ := 1,
    let b : ℝ := 0,
    let c : ℝ := -(A.1+B.1)/2,
    have h : a ≠ 0 ∨ b ≠ 0, { left, exact ne_zero.ne a },
    exact Line.mk a b c h },
  {
    rw push_neg.not_eq at hx,
    let a : ℝ := -(A.2-B.2)/(A.1-B.1),
    let b : ℝ := 1,
    let c : ℝ := -(a*(A.1+B.1)-(A.2+B.2))/2,
    have h : a ≠ 0 ∨ b ≠ 0, { right, exact ne_zero.ne b },
    exact Line.mk a b c h }
end

def line_from_points' : Point → Point → Prop
  | (x, y) (a, b) := true

lemma points_in_line_from_points {A B : Point} (hAB : A ≠ B) :
  has_point (line_from_points hAB) A ∧ has_point (line_from_points hAB) B :=
begin
  -- rw line_from_points,
  split,
  { rw [has_point], /- TODO: ¿Cómo puedo escoger un representante canónico? ¿o puedo evitar tener que escojerlo? -/
    sorry },
  { sorry },
end

instance : incidence_geometry Point Line := {
  lies_on := λ P l, has_point l P,
  I1 := begin
    intros A B hAB,
    use line_from_points hAB,
    split,
    { simp, exact points_in_line_from_points hAB },
    { intro m, simp, intros hA hB,
      sorry }
  end,
  I2 := begin
    intro ℓ,

    -- cases l.h,
    -- {
    --   use Point.mk (-l.c) 0,
    --   use Point.mk (-l.c-l.b) 1,
    --   split,
    --   { rw [ ← push_neg.not_eq, Point.ext_iff, push_neg.not_and_distrib_eq ],
    --     right,
    --     push_neg,
    --     exact zero_ne_one },
    --   { split,
    --     { rw [h, one_mul, mul_zero, add_zero, add_left_neg] },
    --     { rw [h, one_mul, mul_one, sub_add_cancel, add_left_neg] }, }
    -- },
    -- {
    --   use Point.mk 0 (-l.c),
    --   use Point.mk 1 (-l.c-l.a),
    --   split,
    --   { rw [ ← push_neg.not_eq,
    --       Point.ext_iff,
    --       push_neg.not_and_distrib_eq ],
    --     left,
    --     push_neg,
    --     exact zero_ne_one },
    --   { split,
    --     { rw [h, mul_zero, one_mul, zero_add, add_left_neg] },
    --     { rw [h, mul_one, one_mul, add_sub_cancel'_right, add_left_neg] }},
    -- },
    sorry
  end,
  I3 := begin
    let A : Point := (0, 1), use A,
    let B : Point := (1, 0), use B,
    let C : Point := (1, 1), use C,
    split,
    { rw [different3, point_neq_by_coords, point_neq_by_coords, point_neq_by_coords],
      refine ⟨_, _, _⟩,
      { left, exact zero_ne_one },
      { left, exact zero_ne_one },
      { right, exact zero_ne_one },
      },
    { push_neg,
      intros l hA hB,
      -- rw [ne.def, mul_one, mul_one],
      -- cases l.h with ha hb,
      -- {
      --   rw [ha, mul_zero, mul_one, add_zero, add_eq_zero_iff_neg_eq] at hB,
      --   have hc : l.c = -1, { exact hB.symm },
      --   rw [ha, hc, mul_zero,  zero_add, mul_one, add_eq_zero_iff_eq_neg, neg_neg ] at hA,
      --   rw [ha, hA, hc, add_neg_cancel_comm, push_neg.not_eq],
      --   exact one_ne_zero },
      -- {
      --   rw [hb, mul_zero, mul_one, zero_add, add_eq_zero_iff_neg_eq] at hA,
      --   have hc : l.c = -1, { exact hA.symm },
      --   rw [hc, mul_zero, mul_one, add_zero, add_eq_zero_iff_eq_neg, neg_neg] at hB,
      --   rw [hB, hb, hc, add_neg_cancel_comm, push_neg.not_eq],
      --   exact one_ne_zero }},
    sorry }
  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 algebra.big_operators.ring
import number_theory.divisors
import algebra.squarefree
import algebra.invertible

/-!
# Arithmetic Functions and Dirichlet Convolution

This file defines arithmetic functions, which are functions from `ℕ` to a specified type that map 0
to 0. In the literature, they are often instead defined as functions from `ℕ+`. These arithmetic
functions are endowed with a multiplication, given by Dirichlet convolution, and pointwise addition,
to form the Dirichlet ring.

## Main Definitions
 * `arithmetic_function R` consists of functions `f : ℕ → R` such that `f 0 = 0`.
 * An arithmetic function `f` `is_multiplicative` when `x.coprime y → f (x * y) = f x * f y`.
 * The pointwise operations `pmul` and `ppow` differ from the multiplication
  and power instances on `arithmetic_function R`, which use Dirichlet multiplication.
 * `ζ` is the arithmetic function such that `ζ x = 1` for `0 < x`.
 * `σ k` is the arithmetic function such that `σ k x = ∑ y in divisors x, y ^ k` for `0 < x`.
 * `pow k` is the arithmetic function such that `pow k x = x ^ k` for `0 < x`.
 * `id` is the identity arithmetic function on `ℕ`.
 * `ω n` is the number of distinct prime factors of `n`.
 * `Ω n` is the number of prime factors of `n` counted with multiplicity.
 * `μ` is the Möbius function.

## Main Results
 * Several forms of Möbius inversion:
 * `sum_eq_iff_sum_mul_moebius_eq` for functions to a `comm_ring`
 * `sum_eq_iff_sum_smul_moebius_eq` for functions to an `add_comm_group`
 * `prod_eq_iff_prod_pow_moebius_eq` for functions to a `comm_group`
 * `prod_eq_iff_prod_pow_moebius_eq_of_nonzero` for functions to a `comm_group_with_zero`

## Notation
The arithmetic functions `ζ` and `σ` have Greek letter names, which are localized notation in
the namespace `arithmetic_function`.

## Tags
arithmetic functions, dirichlet convolution, divisors

-/

open finset
open_locale big_operators

namespace nat
variable (R : Type*)

/-- An arithmetic function is a function from `ℕ` that maps 0 to 0. In the literature, they are
  often instead defined as functions from `ℕ+`. Multiplication on `arithmetic_functions` is by
  Dirichlet convolution. -/
@[derive [has_coe_to_fun, has_zero, inhabited]]
def arithmetic_function [has_zero R] := zero_hom ℕ R

variable {R}

namespace arithmetic_function

section has_zero
variable [has_zero R]

@[simp] lemma to_fun_eq (f : arithmetic_function R) : f.to_fun = f := rfl

@[simp]
lemma map_zero {f : arithmetic_function R} : f 0 = 0 :=
zero_hom.map_zero' f

theorem coe_inj {f g : arithmetic_function R} : (f : ℕ → R) = g ↔ f = g :=
⟨λ h, zero_hom.coe_inj h, λ h, h ▸ rfl⟩

@[simp]
lemma zero_apply {x : ℕ} : (0 : arithmetic_function R) x = 0 :=
zero_hom.zero_apply x

@[ext] theorem ext ⦃f g : arithmetic_function R⦄ (h : ∀ x, f x = g x) : f = g :=
zero_hom.ext h

theorem ext_iff {f g : arithmetic_function R} : f = g ↔ ∀ x, f x = g x :=
zero_hom.ext_iff

section has_one
variable [has_one R]

instance : has_one (arithmetic_function R) := ⟨⟨λ x, ite (x = 1) 1 0, rfl⟩⟩

@[simp]
lemma one_one : (1 : arithmetic_function R) 1 = 1 := rfl

@[simp]
lemma one_apply_ne {x : ℕ} (h : x ≠ 1) : (1 : arithmetic_function R) x = 0 := if_neg h

end has_one
end has_zero

instance nat_coe [has_zero R] [has_one R] [has_add R] :
  has_coe (arithmetic_function ℕ) (arithmetic_function R) :=
⟨λ f, ⟨↑(f : ℕ → ℕ), by { transitivity ↑(f 0), refl, simp }⟩⟩

@[simp]
lemma nat_coe_nat (f : arithmetic_function ℕ) :
  (↑f : arithmetic_function ℕ) = f :=
ext $ λ _, cast_id _

@[simp]
lemma nat_coe_apply [has_zero R] [has_one R] [has_add R] {f : arithmetic_function ℕ} {x : ℕ} :
  (f : arithmetic_function R) x = f x := rfl

instance int_coe [has_zero R] [has_one R] [has_add R] [has_neg R] :
  has_coe (arithmetic_function ℤ) (arithmetic_function R) :=
⟨λ f, ⟨↑(f : ℕ → ℤ), by { transitivity ↑(f 0), refl, simp }⟩⟩

@[simp]
lemma int_coe_int (f : arithmetic_function ℤ) :
  (↑f : arithmetic_function ℤ) = f :=
ext $ λ _, int.cast_id _

@[simp]
lemma int_coe_apply [has_zero R] [has_one R] [has_add R] [has_neg R]
  {f : arithmetic_function ℤ} {x : ℕ} :
  (f : arithmetic_function R) x = f x := rfl

@[simp]
lemma coe_coe [has_zero R] [has_one R] [has_add R] [has_neg R] {f : arithmetic_function ℕ} :
  ((f : arithmetic_function ℤ) : arithmetic_function R) = f :=
by { ext, simp, }

section add_monoid

variable [add_monoid R]

instance : has_add (arithmetic_function R) := ⟨λ f g, ⟨λ n, f n + g n, by simp⟩⟩

@[simp]
lemma add_apply {f g : arithmetic_function R} {n : ℕ} : (f + g) n = f n + g n := rfl

instance : add_monoid (arithmetic_function R) :=
{ add_assoc := λ _ _ _, ext (λ _, add_assoc _ _ _),
  zero_add := λ _, ext (λ _, zero_add _),
  add_zero := λ _, ext (λ _, add_zero _),
  .. arithmetic_function.has_zero R,
  .. arithmetic_function.has_add }

end add_monoid

instance [add_comm_monoid R] : add_comm_monoid (arithmetic_function R) :=
{ add_comm := λ _ _, ext (λ _, add_comm _ _),
  .. arithmetic_function.add_monoid }

instance [add_group R] : add_group (arithmetic_function R) :=
{ neg := λ f, ⟨λ n, - f n, by simp⟩,
  add_left_neg := λ _, ext (λ _, add_left_neg _),
  .. arithmetic_function.add_monoid }

instance [add_comm_group R] : add_comm_group (arithmetic_function R) :=
{ .. arithmetic_function.add_comm_monoid,
  .. arithmetic_function.add_group }

section has_scalar
variables {M : Type*} [has_zero R] [add_comm_monoid M] [has_scalar R M]

/-- The Dirichlet convolution of two arithmetic functions `f` and `g` is another arithmetic function
  such that `(f * g) n` is the sum of `f x * g y` over all `(x,y)` such that `x * y = n`. -/
instance : has_scalar (arithmetic_function R) (arithmetic_function M) :=
⟨λ f g, ⟨λ n, ∑ x in divisors_antidiagonal n, f x.fst • g x.snd, by simp⟩⟩

@[simp]
lemma smul_apply {f : arithmetic_function R} {g : arithmetic_function M} {n : ℕ} :
  (f • g) n = ∑ x in divisors_antidiagonal n, f x.fst • g x.snd := rfl

end has_scalar

/-- The Dirichlet convolution of two arithmetic functions `f` and `g` is another arithmetic function
  such that `(f * g) n` is the sum of `f x * g y` over all `(x,y)` such that `x * y = n`. -/
instance [semiring R] : has_mul (arithmetic_function R) := ⟨(•)⟩

@[simp]
lemma mul_apply [semiring R] {f g : arithmetic_function R} {n : ℕ} :
  (f * g) n = ∑ x in divisors_antidiagonal n, f x.fst * g x.snd := rfl

section module
variables {M : Type*} [semiring R] [add_comm_monoid M] [module R M]

lemma mul_smul' (f g : arithmetic_function R) (h : arithmetic_function M) :
  (f * g) • h = f • g • h :=
begin
  ext n,
  simp only [mul_apply, smul_apply, sum_smul, mul_smul, smul_sum, finset.sum_sigma'],
  apply finset.sum_bij,
  swap 5,
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, exact ⟨(k, l*j), (l, j)⟩ },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H,
    simp only [finset.mem_sigma, mem_divisors_antidiagonal] at H ⊢,
    rcases H with ⟨⟨rfl, n0⟩, rfl, i0⟩,
    refine ⟨⟨(mul_assoc _ _ _).symm, n0⟩, rfl, _⟩,
    rw mul_ne_zero_iff at *,
    exact ⟨i0.2, n0.2⟩, },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, simp only [mul_assoc] },
  { rintros ⟨⟨a,b⟩, ⟨c,d⟩⟩ ⟨⟨i,j⟩, ⟨k,l⟩⟩ H₁ H₂,
    simp only [finset.mem_sigma, mem_divisors_antidiagonal,
      and_imp, prod.mk.inj_iff, add_comm, heq_iff_eq] at H₁ H₂ ⊢,
    rintros rfl h2 rfl rfl,
    exact ⟨⟨eq.trans H₁.2.1.symm H₂.2.1, rfl⟩, rfl, rfl⟩ },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, refine ⟨⟨(i*k, l), (i, k)⟩, _, _⟩,
  { simp only [finset.mem_sigma, mem_divisors_antidiagonal] at H ⊢,
    rcases H with ⟨⟨rfl, n0⟩, rfl, j0⟩,
    refine ⟨⟨mul_assoc _ _ _, n0⟩, rfl, _⟩,
    rw mul_ne_zero_iff at *,
    exact ⟨n0.1, j0.1⟩ },
  { simp only [true_and, mem_divisors_antidiagonal, and_true, prod.mk.inj_iff, eq_self_iff_true,
      ne.def, mem_sigma, heq_iff_eq] at H ⊢,
    rw H.2.1 } }
end

lemma one_smul' (b : arithmetic_function M) :
  (1 : arithmetic_function R) • b = b :=
begin
  ext,
  rw smul_apply,
  by_cases x0 : x = 0, {simp [x0]},
  have h : {(1,x)} ⊆ divisors_antidiagonal x := by simp [x0],
  rw ← sum_subset h, {simp},
  intros y ymem ynmem,
  have y1ne : y.fst ≠ 1,
  { intro con,
    simp only [con, mem_divisors_antidiagonal, one_mul, ne.def] at ymem,
    simp only [mem_singleton, prod.ext_iff] at ynmem,
    tauto },
  simp [y1ne],
end

end module

section semiring
variable [semiring R]

instance : monoid (arithmetic_function R) :=
{ one_mul := one_smul',
  mul_one := λ f,
  begin
    ext,
    rw mul_apply,
    by_cases x0 : x = 0, {simp [x0]},
    have h : {(x,1)} ⊆ divisors_antidiagonal x := by simp [x0],
    rw ← sum_subset h, {simp},
    intros y ymem ynmem,
    have y2ne : y.snd ≠ 1,
    { intro con,
      simp only [con, mem_divisors_antidiagonal, mul_one, ne.def] at ymem,
      simp only [mem_singleton, prod.ext_iff] at ynmem,
      tauto },
    simp [y2ne],
  end,
  mul_assoc := mul_smul',
  .. arithmetic_function.has_one,
  .. arithmetic_function.has_mul }

instance : semiring (arithmetic_function R) :=
{ zero_mul := λ f, by { ext, simp only [mul_apply, zero_mul, sum_const_zero, zero_apply] },
  mul_zero := λ f, by { ext, simp only [mul_apply, sum_const_zero, mul_zero, zero_apply] },
  left_distrib := λ a b c, by { ext, simp only [←sum_add_distrib, mul_add, mul_apply, add_apply] },
  right_distrib := λ a b c, by { ext, simp only [←sum_add_distrib, add_mul, mul_apply, add_apply] },
  .. arithmetic_function.has_zero R,
  .. arithmetic_function.has_mul,
  .. arithmetic_function.has_add,
  .. arithmetic_function.add_comm_monoid,
  .. arithmetic_function.monoid }

end semiring

instance [comm_semiring R] : comm_semiring (arithmetic_function R) :=
{ mul_comm := λ f g, by { ext,
    rw [mul_apply, ← map_swap_divisors_antidiagonal, sum_map],
    simp [mul_comm] },
  .. arithmetic_function.semiring }

instance [comm_ring R] : comm_ring (arithmetic_function R) :=
{ .. arithmetic_function.add_comm_group,
  .. arithmetic_function.comm_semiring }

instance {M : Type*} [semiring R] [add_comm_monoid M] [module R M] :
  module (arithmetic_function R) (arithmetic_function M) :=
{ one_smul := one_smul',
  mul_smul := mul_smul',
  smul_add := λ r x y, by { ext, simp only [sum_add_distrib, smul_add, smul_apply, add_apply] },
  smul_zero := λ r, by { ext, simp only [smul_apply, sum_const_zero, smul_zero, zero_apply] },
  add_smul := λ r s x, by { ext, simp only [add_smul, sum_add_distrib, smul_apply, add_apply] },
  zero_smul := λ r, by { ext, simp only [smul_apply, sum_const_zero, zero_smul, zero_apply] }, }

section zeta

/-- `ζ 0 = 0`, otherwise `ζ x = 1`. The Dirichlet Series is the Riemann ζ.  -/
def zeta : arithmetic_function ℕ :=
⟨λ x, ite (x = 0) 0 1, rfl⟩

localized "notation `ζ` := zeta" in arithmetic_function

@[simp]
lemma zeta_apply {x : ℕ} : ζ x = if (x = 0) then 0 else 1 := rfl

lemma zeta_apply_ne {x : ℕ} (h : x ≠ 0) : ζ x = 1 := if_neg h

@[simp]
theorem coe_zeta_mul_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
  (↑ζ * f) x = ∑ i in divisors x, f i :=
begin
  rw mul_apply,
  transitivity ∑ i in divisors_antidiagonal x, f i.snd,
  { apply sum_congr rfl,
    intros i hi,
    rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
    rw [nat_coe_apply, zeta_apply_ne (left_ne_zero_of_mul h), cast_one, one_mul] },
  { apply sum_bij (λ i h, prod.snd i),
    { rintros ⟨a, b⟩ h, simp [snd_mem_divisors_of_mem_antidiagonal h] },
    { rintros ⟨a, b⟩ h, refl },
    { rintros ⟨a1, b1⟩ ⟨a2, b2⟩ h1 h2 h,
      dsimp at h,
      rw h at *,
      rw mem_divisors_antidiagonal at *,
      ext, swap, {refl},
      simp only [prod.fst, prod.snd] at *,
      apply nat.eq_of_mul_eq_mul_right _ (eq.trans h1.1 h2.1.symm),
      rcases h1 with ⟨rfl, h⟩,
      apply nat.pos_of_ne_zero (right_ne_zero_of_mul h) },
    { intros a ha,
      rcases mem_divisors.1 ha with ⟨⟨b, rfl⟩, ne0⟩,
      use (b, a),
      simp [ne0, mul_comm] } }
end

theorem coe_zeta_smul_apply {M : Type*} [comm_ring R] [add_comm_group M] [module R M]
  {f : arithmetic_function M} {x : ℕ} :
  ((↑ζ : arithmetic_function R) • f) x = ∑ i in divisors x, f i :=
begin
  rw smul_apply,
  transitivity ∑ i in divisors_antidiagonal x, f i.snd,
  { apply sum_congr rfl,
    intros i hi,
    rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
    rw [nat_coe_apply, zeta_apply_ne (left_ne_zero_of_mul h), cast_one, one_smul] },
  { apply sum_bij (λ i h, prod.snd i),
    { rintros ⟨a, b⟩ h, simp [snd_mem_divisors_of_mem_antidiagonal h] },
    { rintros ⟨a, b⟩ h, refl },
    { rintros ⟨a1, b1⟩ ⟨a2, b2⟩ h1 h2 h,
      dsimp at h,
      rw h at *,
      rw mem_divisors_antidiagonal at *,
      ext, swap, {refl},
      simp only [prod.fst, prod.snd] at *,
      apply nat.eq_of_mul_eq_mul_right _ (eq.trans h1.1 h2.1.symm),
      rcases h1 with ⟨rfl, h⟩,
      apply nat.pos_of_ne_zero (right_ne_zero_of_mul h) },
    { intros a ha,
      rcases mem_divisors.1 ha with ⟨⟨b, rfl⟩, ne0⟩,
      use (b, a),
      simp [ne0, mul_comm] } }
end

@[simp]
theorem coe_mul_zeta_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
  (f * ζ) x = ∑ i in divisors x, f i :=
begin
  apply opposite.op_injective,
  rw [op_sum],
  convert @coe_zeta_mul_apply Rᵒᵖ _ { to_fun := opposite.op ∘ f, map_zero' := by simp} x,
  rw [mul_apply, mul_apply, op_sum],
  conv_lhs { rw ← map_swap_divisors_antidiagonal, },
  rw sum_map,
  apply sum_congr rfl,
  intros y hy,
  by_cases h1 : y.fst = 0,
  { simp [function.comp_apply, h1] },
  { simp only [h1, mul_one, one_mul, prod.fst_swap, function.embedding.coe_fn_mk, prod.snd_swap,
      if_false, zeta_apply, zero_hom.coe_mk, nat_coe_apply, cast_one] }
end

theorem zeta_mul_apply {f : arithmetic_function ℕ} {x : ℕ} :
  (ζ * f) x = ∑ i in divisors x, f i :=
by rw [← nat_coe_nat ζ, coe_zeta_mul_apply]

theorem mul_zeta_apply {f : arithmetic_function ℕ} {x : ℕ} :
  (f * ζ) x = ∑ i in divisors x, f i :=
by rw [← nat_coe_nat ζ, coe_mul_zeta_apply]

end zeta

open_locale arithmetic_function

section pmul

/-- This is the pointwise product of `arithmetic_function`s. -/
def pmul [mul_zero_class R] (f g : arithmetic_function R) :
  arithmetic_function R :=
⟨λ x, f x * g x, by simp⟩

@[simp]
lemma pmul_apply [mul_zero_class R] {f g : arithmetic_function R} {x : ℕ} :
  f.pmul g x = f x * g x := rfl

lemma pmul_comm [comm_monoid_with_zero R] (f g : arithmetic_function R) :
  f.pmul g = g.pmul f :=
by { ext, simp [mul_comm] }

variable [semiring R]

@[simp]
lemma pmul_zeta (f : arithmetic_function R) : f.pmul ↑ζ = f :=
begin
  ext x,
  cases x;
  simp [nat.succ_ne_zero],
end

@[simp]
lemma zeta_pmul (f : arithmetic_function R) : (ζ : arithmetic_function R).pmul f = f :=
begin
  ext x,
  cases x;
  simp [nat.succ_ne_zero],
end

/-- This is the pointwise power of `arithmetic_function`s. -/
def ppow (f : arithmetic_function R) (k : ℕ) :
  arithmetic_function R :=
if h0 : k = 0 then ζ else ⟨λ x, (f x) ^ k,
  by { rw [map_zero], exact zero_pow (nat.pos_of_ne_zero h0) }⟩

@[simp]
lemma ppow_zero {f : arithmetic_function R} : f.ppow 0 = ζ :=
by rw [ppow, dif_pos rfl]

@[simp]
lemma ppow_apply {f : arithmetic_function R} {k x : ℕ} (kpos : 0 < k) :
  f.ppow k x = (f x) ^ k :=
by { rw [ppow, dif_neg (ne_of_gt kpos)], refl }

lemma ppow_succ {f : arithmetic_function R} {k : ℕ} :
  f.ppow (k + 1) = f.pmul (f.ppow k) :=
begin
  ext x,
  rw [ppow_apply (nat.succ_pos k), pow_succ],
  induction k; simp,
end

lemma ppow_succ' {f : arithmetic_function R} {k : ℕ} {kpos : 0 < k} :
  f.ppow (k + 1) = (f.ppow k).pmul f :=
begin
  ext x,
  rw [ppow_apply (nat.succ_pos k), pow_succ'],
  induction k; simp,
end

end pmul

/-- Multiplicative functions -/
def is_multiplicative [monoid_with_zero R] (f : arithmetic_function R) : Prop :=
f 1 = 1 ∧ (∀ {m n : ℕ}, m.coprime n → f (m * n) = f m * f n)

namespace is_multiplicative

section monoid_with_zero
variable [monoid_with_zero R]

@[simp]
lemma map_one {f : arithmetic_function R} (h : f.is_multiplicative) : f 1 = 1 :=
h.1

@[simp]
lemma map_mul_of_coprime {f : arithmetic_function R} (hf : f.is_multiplicative)
  {m n : ℕ} (h : m.coprime n) : f (m * n) = f m * f n :=
hf.2 h

end monoid_with_zero

lemma nat_cast {f : arithmetic_function ℕ} [semiring R] (h : f.is_multiplicative) :
  is_multiplicative (f : arithmetic_function R) :=
⟨by simp [h], λ m n cop, by simp [cop, h]⟩

lemma int_cast {f : arithmetic_function ℤ} [ring R] (h : f.is_multiplicative) :
  is_multiplicative (f : arithmetic_function R) :=
⟨by simp [h], λ m n cop, by simp [cop, h]⟩

lemma mul [comm_semiring R] {f g : arithmetic_function R}
  (hf : f.is_multiplicative) (hg : g.is_multiplicative) :
  is_multiplicative (f * g) :=
⟨by { simp [hf, hg], }, begin
  simp only [mul_apply],
  intros m n cop,
  rw sum_mul_sum,
  symmetry,
  apply sum_bij (λ (x : (ℕ × ℕ) × ℕ × ℕ) h, (x.1.1 * x.2.1, x.1.2 * x.2.2)),
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    rcases h with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    simp only [mem_divisors_antidiagonal, nat.mul_eq_zero, ne.def],
    split, {ring},
    rw nat.mul_eq_zero at *,
    apply not_or ha hb },
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    rcases h with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    dsimp only,
    rw [hf.map_mul_of_coprime cop.coprime_mul_right.coprime_mul_right_right,
        hg.map_mul_of_coprime cop.coprime_mul_left.coprime_mul_left_right],
    ring, },
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ ⟨⟨c1, c2⟩, ⟨d1, d2⟩⟩ hab hcd h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at hab,
    rcases hab with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at hcd,
    simp only [prod.mk.inj_iff] at h,
    ext; dsimp only,
    { transitivity nat.gcd (a1 * a2) (a1 * b1),
      { rw [nat.gcd_mul_left, cop.coprime_mul_left.coprime_mul_right_right.gcd_eq_one, mul_one] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.1.1, h.1, nat.gcd_mul_left,
            cop.coprime_mul_left.coprime_mul_right_right.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (a1 * a2) (a2 * b2),
      { rw [mul_comm, nat.gcd_mul_left, cop.coprime_mul_right.coprime_mul_left_right.gcd_eq_one,
            mul_one] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.1.1, h.2, mul_comm, nat.gcd_mul_left,
            cop.coprime_mul_right.coprime_mul_left_right.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (b1 * b2) (a1 * b1),
      { rw [mul_comm, nat.gcd_mul_right,
           cop.coprime_mul_right.coprime_mul_left_right.symm.gcd_eq_one, one_mul] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.2.1, h.1, mul_comm c1 d1, nat.gcd_mul_left,
            cop.coprime_mul_right.coprime_mul_left_right.symm.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (b1 * b2) (a2 * b2),
      { rw [nat.gcd_mul_right,
           cop.coprime_mul_left.coprime_mul_right_right.symm.gcd_eq_one, one_mul] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.2.1, h.2, nat.gcd_mul_right,
            cop.coprime_mul_left.coprime_mul_right_right.symm.gcd_eq_one, one_mul] } } },
  { rintros ⟨b1, b2⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    use ((b1.gcd m, b2.gcd m), (b1.gcd n, b2.gcd n)),
    simp only [exists_prop, prod.mk.inj_iff, ne.def, mem_product, mem_divisors_antidiagonal],
    rw [← cop.gcd_mul _, ← cop.gcd_mul _, ← h.1, nat.gcd_mul_gcd_of_coprime_of_mul_eq_mul cop h.1,
        nat.gcd_mul_gcd_of_coprime_of_mul_eq_mul cop.symm _],
    { rw [nat.mul_eq_zero, decidable.not_or_iff_and_not] at h, simp [h.2.1, h.2.2] },
    rw [mul_comm n m, h.1] }
end⟩

lemma pmul [comm_semiring R] {f g : arithmetic_function R}
  (hf : f.is_multiplicative) (hg : g.is_multiplicative) :
  is_multiplicative (f.pmul g) :=
⟨by { simp [hf, hg], }, λ m n cop, begin
  simp only [pmul_apply, hf.map_mul_of_coprime cop, hg.map_mul_of_coprime cop],
  ring,
end⟩

end is_multiplicative

section special_functions

/-- The identity on `ℕ` as an `arithmetic_function`.  -/
def id : arithmetic_function ℕ := ⟨id, rfl⟩

@[simp]
lemma id_apply {x : ℕ} : id x = x := rfl

/-- `pow k n = n ^ k`, except `pow 0 0 = 0`. -/
def pow (k : ℕ) : arithmetic_function ℕ := id.ppow k

@[simp]
lemma pow_apply {k n : ℕ} : pow k n = if (k = 0 ∧ n = 0) then 0 else n ^ k :=
begin
  cases k,
  { simp [pow] },
  simp [pow, (ne_of_lt (nat.succ_pos k)).symm],
end

/-- `σ k n` is the sum of the `k`th powers of the divisors of `n` -/
def sigma (k : ℕ) : arithmetic_function ℕ :=
⟨λ n, ∑ d in divisors n, d ^ k, by simp⟩

localized "notation `σ` := sigma" in arithmetic_function

@[simp]
lemma sigma_apply {k n : ℕ} : σ k n = ∑ d in divisors n, d ^ k := rfl

lemma sigma_one_apply {n : ℕ} : σ 1 n = ∑ d in divisors n, d := by simp

lemma zeta_mul_pow_eq_sigma {k : ℕ} : ζ * pow k = σ k :=
begin
  ext,
  rw [sigma, zeta_mul_apply],
  apply sum_congr rfl,
  intros x hx,
  rw [pow_apply, if_neg (not_and_of_not_right _ _)],
  contrapose! hx,
  simp [hx],
end

lemma is_multiplicative_zeta : is_multiplicative ζ :=
⟨by simp, λ m n cop, begin
  cases m, {simp},
  cases n, {simp},
  simp [nat.succ_ne_zero]
end⟩

lemma is_multiplicative_id : is_multiplicative arithmetic_function.id :=
⟨rfl, λ _ _ _, rfl⟩

lemma is_multiplicative.ppow [comm_semiring R] {f : arithmetic_function R}
  (hf : f.is_multiplicative) {k : ℕ} :
  is_multiplicative (f.ppow k) :=
begin
  induction k with k hi,
  { exact is_multiplicative_zeta.nat_cast },
  { rw ppow_succ,
    apply hf.pmul hi },
end

lemma is_multiplicative_pow {k : ℕ} : is_multiplicative (pow k) :=
is_multiplicative_id.ppow

lemma is_multiplicative_sigma {k : ℕ} :
  is_multiplicative (sigma k) :=
begin
  rw [← zeta_mul_pow_eq_sigma],
  apply ((is_multiplicative_zeta).mul is_multiplicative_pow)
end

/-- `Ω n` is the number of prime factors of `n`. -/
def card_factors : arithmetic_function ℕ :=
⟨λ n, n.factors.length, by simp⟩

localized "notation `Ω` := card_factors" in arithmetic_function

lemma card_factors_apply {n : ℕ} :
  Ω n = n.factors.length := rfl

@[simp]
lemma card_factors_one : Ω 1 = 0 := by simp [card_factors]

lemma card_factors_eq_one_iff_prime {n : ℕ} :
  Ω n = 1 ↔ n.prime :=
begin
  refine ⟨λ h, _, λ h, list.length_eq_one.2 ⟨n, factors_prime h⟩⟩,
  cases n,
  { contrapose! h,
    simp },
  rcases list.length_eq_one.1 h with ⟨x, hx⟩,
  rw [← prod_factors n.succ_pos, hx, list.prod_singleton],
  apply prime_of_mem_factors,
  rw [hx, list.mem_singleton]
end

lemma card_factors_mul {m n : ℕ} (m0 : m ≠ 0) (n0 : n ≠ 0) :
  Ω (m * n) = Ω m + Ω n :=
by rw [card_factors_apply, card_factors_apply, card_factors_apply, ← multiset.coe_card,
  ← factors_eq, unique_factorization_monoid.factors_mul m0 n0, factors_eq, factors_eq,
  multiset.card_add, multiset.coe_card, multiset.coe_card]

lemma card_factors_multiset_prod {s : multiset ℕ} (h0 : s.prod ≠ 0) :
  Ω s.prod = (multiset.map Ω s).sum :=
begin
  revert h0,
  apply s.induction_on, by simp,
  intros a t h h0,
  rw [multiset.prod_cons, mul_ne_zero_iff] at h0,
  simp [h0, card_factors_mul, h],
end

/-- `ω n` is the number of distinct prime factors of `n`. -/
def card_distinct_factors : arithmetic_function ℕ :=
⟨λ n, n.factors.erase_dup.length, by simp⟩

localized "notation `ω` := card_distinct_factors" in arithmetic_function

lemma card_distinct_factors_zero : ω 0 = 0 := by simp

lemma card_distinct_factors_apply {n : ℕ} :
  ω n = n.factors.erase_dup.length := rfl

lemma card_distinct_factors_eq_card_factors_iff_squarefree {n : ℕ} (h0 : n ≠ 0) :
  ω n = Ω n ↔ squarefree n :=
begin
  rw [squarefree_iff_nodup_factors h0, card_distinct_factors_apply],
  split; intro h,
  { rw ← list.eq_of_sublist_of_length_eq n.factors.erase_dup_sublist h,
    apply list.nodup_erase_dup },
  { rw list.erase_dup_eq_self.2 h,
    refl }
end

/-- `μ` is the Möbius function. If `n` is squarefree with an even number of distinct prime factors,
  `μ n = 1`. If `n` is squarefree with an odd number of distinct prime factors, `μ n = -1`.
  If `n` is not squarefree, `μ n = 0`. -/
def moebius : arithmetic_function ℤ :=
⟨λ n, if squarefree n then (-1) ^ (card_factors n) else 0, by simp⟩

localized "notation `μ` := moebius" in arithmetic_function

@[simp]
lemma moebius_apply_of_squarefree {n : ℕ} (h : squarefree n): μ n = (-1) ^ (card_factors n) :=
if_pos h

@[simp]
lemma moebius_eq_zero_of_not_squarefree {n : ℕ} (h : ¬ squarefree n): μ n = 0 := if_neg h

lemma moebius_ne_zero_iff_squarefree {n : ℕ} : μ n ≠ 0 ↔ squarefree n :=
begin
  split; intro h,
  { contrapose! h,
    simp [h] },
  { simp [h, pow_ne_zero] }
end

lemma moebius_ne_zero_iff_eq_or {n : ℕ} : μ n ≠ 0 ↔ μ n = 1 ∨ μ n = -1 :=
begin
  split; intro h,
  { rw moebius_ne_zero_iff_squarefree at h,
    rw moebius_apply_of_squarefree h,
    apply neg_one_pow_eq_or },
  { rcases h with h | h; simp [h] }
end

open unique_factorization_monoid

@[simp] lemma coe_moebius_mul_coe_zeta [comm_ring R] : (μ * ζ : arithmetic_function R) = 1 :=
begin
  ext x,
  cases x,
  { simp only [divisors_zero, sum_empty, ne.def, not_false_iff, coe_mul_zeta_apply,
      zero_ne_one, one_apply_ne] },
  cases x,
  { simp only [moebius_apply_of_squarefree, card_factors_one, squarefree_one, divisors_one,
      int.cast_one, sum_singleton, coe_mul_zeta_apply, one_one, int_coe_apply, pow_zero] },
  rw [coe_mul_zeta_apply, one_apply_ne (ne_of_gt (succ_lt_succ (nat.succ_pos _)))],
  simp_rw [int_coe_apply],
  rw [← finset.sum_int_cast, ← sum_filter_ne_zero],
  convert int.cast_zero,
  simp only [moebius_ne_zero_iff_squarefree],
  suffices :
    ∑ (y : finset ℕ) in (unique_factorization_monoid.factors x.succ.succ).to_finset.powerset,
    ite (squarefree y.val.prod) ((-1:ℤ) ^ Ω y.val.prod) 0 = 0,
  { have h : ∑ i in _, ite (squarefree i) ((-1:ℤ) ^ Ω i) 0 = _ :=
      (sum_divisors_filter_squarefree (nat.succ_ne_zero _)),
    exact (eq.trans (by congr') h).trans this },
  apply eq.trans (sum_congr rfl _) (sum_powerset_neg_one_pow_card_of_nonempty _),
  { intros y hy,
    rw [finset.mem_powerset, ← finset.val_le_iff, multiset.to_finset_val] at hy,
    have h : unique_factorization_monoid.factors y.val.prod = y.val,
    { apply factors_multiset_prod_of_irreducible,
      intros z hz,
      apply irreducible_of_factor _ (multiset.subset_of_le
        (le_trans hy (multiset.erase_dup_le _)) hz) },
    rw [if_pos],
    { rw [card_factors_apply, ← multiset.coe_card, ← factors_eq, h, finset.card] },
    rw [unique_factorization_monoid.squarefree_iff_nodup_factors, h],
    { apply y.nodup },
    rw [ne.def, multiset.prod_eq_zero_iff],
    intro con,
    rw ← h at con,
    exact not_irreducible_zero (irreducible_of_factor 0 con) },
  { rw finset.nonempty,
    rcases wf_dvd_monoid.exists_irreducible_factor _ (nat.succ_ne_zero _) with ⟨i, hi⟩,
    { rcases exists_mem_factors_of_dvd (nat.succ_ne_zero _) hi.1 hi.2 with ⟨j, hj, hj2⟩,
      use j,
      apply multiset.mem_to_finset.2 hj },
    rw nat.is_unit_iff,
    omega },
end

@[simp] lemma coe_zeta_mul_coe_moebius [comm_ring R] : (ζ * μ : arithmetic_function R) = 1 :=
by rw [mul_comm, coe_moebius_mul_coe_zeta]

@[simp]

@[simp] lemma coe_zeta_mul_moebius : (ζ * μ : arithmetic_function ℤ) = 1 :=
by rw [← int_coe_int μ, coe_zeta_mul_coe_moebius]

section comm_ring
variable [comm_ring R]

instance : invertible (ζ : arithmetic_function R) :=
{ inv_of := μ,
  inv_of_mul_self := coe_moebius_mul_coe_zeta,
  mul_inv_of_self := coe_zeta_mul_coe_moebius}

/-- A unit in `arithmetic_function R` that evaluates to `ζ`, with inverse `μ`. -/
def zeta_unit : units (arithmetic_function R) :=
⟨ζ, μ, coe_zeta_mul_coe_moebius, coe_moebius_mul_coe_zeta⟩

@[simp]
lemma coe_zeta_unit :
  ((zeta_unit : units (arithmetic_function R)) : arithmetic_function R) = ζ := rfl

@[simp]
lemma inv_zeta_unit :
  ((zeta_unit⁻¹ : units (arithmetic_function R)) : arithmetic_function R) = μ := rfl

end comm_ring

/-- Möbius inversion for functions to an `add_comm_group`. -/
theorem sum_eq_iff_sum_smul_moebius_eq
  [add_comm_group R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∑ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∑ (x : ℕ × ℕ) in n.divisors_antidiagonal, μ x.fst • g x.snd = f n :=
begin
  let f' : arithmetic_function R := ⟨λ x, if x = 0 then 0 else f x, if_pos rfl⟩,
  let g' : arithmetic_function R := ⟨λ x, if x = 0 then 0 else g x, if_pos rfl⟩,
  transitivity (ζ : arithmetic_function ℤ) • f' = g',
  { rw ext_iff,
    apply forall_congr,
    intro n,
    cases n, { simp },
    rw coe_zeta_smul_apply,
    simp only [n.succ_ne_zero, forall_prop_of_true, succ_pos', if_false, zero_hom.coe_mk],
    rw sum_congr rfl (λ x hx, _),
    rw (if_neg (ne_of_gt (nat.pos_of_mem_divisors hx))) },
  transitivity μ • g' = f',
  { split; intro h,
    { rw [← h, ← mul_smul, moebius_mul_coe_zeta, one_smul] },
    { rw [← h, ← mul_smul, coe_zeta_mul_moebius, one_smul] } },
  { rw ext_iff,
    apply forall_congr,
    intro n,
    cases n, { simp },
    simp only [n.succ_ne_zero, forall_prop_of_true, succ_pos', smul_apply,
      if_false, zero_hom.coe_mk],
    rw sum_congr rfl (λ x hx, _),
    rw (if_neg (ne_of_gt (nat.pos_of_mem_divisors (snd_mem_divisors_of_mem_antidiagonal hx)))) },
end

/-- Möbius inversion for functions to a `comm_ring`. -/
theorem sum_eq_iff_sum_mul_moebius_eq [comm_ring R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∑ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∑ (x : ℕ × ℕ) in n.divisors_antidiagonal, (μ x.fst : R) * g x.snd = f n :=
begin
  rw sum_eq_iff_sum_smul_moebius_eq,
  apply forall_congr,
  intro a,
  apply imp_congr (iff.refl _) (eq.congr_left (sum_congr rfl (λ x hx, _))),
  rw [gsmul_eq_mul],
end

/-- Möbius inversion for functions to a `comm_group`. -/
theorem prod_eq_iff_prod_pow_moebius_eq [comm_group R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∏ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∏ (x : ℕ × ℕ) in n.divisors_antidiagonal, g x.snd ^ (μ x.fst) = f n :=
@sum_eq_iff_sum_smul_moebius_eq (additive R) _ _ _

/-- Möbius inversion for functions to a `comm_group_with_zero`. -/
theorem prod_eq_iff_prod_pow_moebius_eq_of_nonzero [comm_group_with_zero R] {f g : ℕ → R}
  (hf : ∀ (n : ℕ), 0 < n → f n ≠ 0) (hg : ∀ (n : ℕ), 0 < n → g n ≠ 0) :
  (∀ (n : ℕ), 0 < n → ∏ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∏ (x : ℕ × ℕ) in n.divisors_antidiagonal, g x.snd ^ (μ x.fst) = f n :=
begin
  refine iff.trans (iff.trans (forall_congr (λ n, _)) (@prod_eq_iff_prod_pow_moebius_eq (units R) _
    (λ n, if h : 0 < n then units.mk0 (f n) (hf n h) else 1)
    (λ n, if h : 0 < n then units.mk0 (g n) (hg n h) else 1))) (forall_congr (λ n, _));
  refine imp_congr_right (λ hn, _),
  { dsimp,
    rw [dif_pos hn, ← units.eq_iff, ← units.coe_hom_apply, monoid_hom.map_prod, units.coe_mk0,
      prod_congr rfl _],
    intros x hx,
    rw [dif_pos (nat.pos_of_mem_divisors hx), units.coe_hom_apply, units.coe_mk0] },
  { dsimp,
    rw [dif_pos hn, ← units.eq_iff, ← units.coe_hom_apply, monoid_hom.map_prod, units.coe_mk0,
      prod_congr rfl _],
    intros x hx,
    rw [dif_pos (nat.pos_of_mem_divisors (nat.snd_mem_divisors_of_mem_antidiagonal hx)),
      units.coe_hom_apply, units.coe_gpow', units.coe_mk0] }
end

end special_functions
end arithmetic_function
end nat


/- Tactic : rw

## Summary

If `h` is a proof of `X = Y`, then `rw h,` will change
all `X`s in the goal to `Y`s.

**Variants:** `rw ← h` changes
`Y` to `X` and
`rw h at h2` changes `X` to `Y` in hypothesis `h2` instead
of the goal.

## Details

The `rw` tactic is a way to do "substituting in". There
are two distinct situations where use this tactics.

1) If `h : A = B` is a hypothesis (i.e., a proof of `A = B`)
in your local context (the box in the top right)
and if your goal contains one or more `A`s, then `rw h`
will change them all to `B`'s.

2) The `rw` tactic will also work with proofs of theorems
which are equalities (look for them in the drop down
menu on the left, within Theorem Statements).

**Important note:** if `h` is not a proof of the form `A = B`
or `A ↔ B` (for example if `h` is a function, an implication,
or perhaps even a proposition itself rather than its proof),
then `rw` is not the tactic you want to use. For example,
`rw (P = Q)` is never correct: `P = Q` is the true-false
statement itself, not the proof.
If `h : P = Q` is its proof, then `rw h` will work.

**Pro tip 1:** If `h : A = B` and you want to change
`B`s to `A`s instead, try `rw ←h` (get the arrow with `\l`,
note that this is a small letter L, not a number 1).

### Example:
If it looks like this in the top right hand box:
```
A B C : Point
h1 : A = B
h2 : B = C
⊢ A = C
```

then

`rw h1,`

will change the goal into `⊢ B = C`.

### Example:
You can use `rw` to change a hypothesis as well.
For example, if your local context looks like this:
```
A B C : Point
h1 : A = C
h2 : A = B
⊢ B = C
```
then `rw h1 at h2` will turn `h2` into `h2 : C = B` (remember operator precedence).

-/

/-
# Tutorial World

## Level 2: the rewrite (`rw`) tactic.

The next tactic we will learn is `rw` (from rewrite). Rewriting is one of the most basic methods of proof,
where we "substitute" one object that we know that is equal to another.

For example, if `h : A = B` is a hypothesis (i.e., a proof of `A = B`) in your local context (the box in the top right)
and if your goal contains one or more `A`s, then `rw h` will change them all to `B`'s.

Now, delete the sorry and take a look in the top right box at what we have. The variables `A`, `B` and `C` are
points that lie in the plane `Ω`. Here we have to prove that if the point $A$ is equal to the point $B$,
and the point $B$ is equal to the point $C$, then the point $A$ is equal to the point $C$.

Try to use a sequence of rewrite steps to prove the lemma below by typing them into the box underneath,
between the begin and end lines that tell Lean you are starting and finishing a proof.

Right below this explanation, you will find a grey box where a "Hint" is hidden in case you get stuck. Click on
it to step through this level faster, but remember to use it wisely! From now on, you will find some "Hints" that might help you.

-/

/- Hint : Click here for a hint, in case you get stuck.
Delete `sorry` and type `rw h1,` (don't forget the comma!). Then, note how the goal changes into ⊢ B = C. Directly after,
try to think what would happen if you write `rw h2,`. Typing that line will finish the proof instead of wiritng ⊢ C = C . This is
because Lean tries to apply `refl` right after some tactics, and `rw`is one of them!
-/

variables {Ω : Type} -- hide

/- Lemma : no-side-bar
If A, B and C are points with A = B and B = C, then A = C.
-/
lemma example_rw (A B C: Ω) (h1 : A = B) (h2 : B = C) : A = C :=
begin
  rw h1,
  rw h2,

end

/-

## Exploring your proof

Click on `rw h1`, and then use the arrow keys to move your cursor around the proof.
Go up and down and note that the goal changes -- indeed you can inspect Lean's "state" at
each line of the proof (the hypotheses, and the goal). Try to figure out the exact place
where the goal changes. The comma tells Lean "I've finished writing this tactic now, please
process it." Lean ignores new lines, but pays great attention to commas.

-/


-- La_equipotencia_es_una_relacion_transitiva.lean
-- La equipotencia es una relación transitiva
-- José A. Alonso Jiménez
-- Sevilla, 17 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Dos conjuntos A y B son equipotentes (y se denota por A ≃ B) si
-- existe una aplicación biyectiva entre ellos. La equipotencia se puede
-- definir en Lean por
--    def es_equipotente (A B : Type*) :=
--      ∃ g : A → B, bijective g
--
--    infix ` ⋍ `: 50 := es_equipotente
--
-- Demostrar que la relación de equipotencia es transitiva.
-- ---------------------------------------------------------------------

import tactic
open function

def es_equipotente (A B : Type*) :=
  ∃ g : A → B, bijective g

infix ` ⋍ `: 50 := es_equipotente

-- 1ª demostración
example : transitive (⋍) :=
begin
  intros X Y Z hXY hYZ,
  unfold es_equipotente at *,
  cases hXY with f hf,
  cases hYZ with g hg,
  use (g ∘ f),
  exact bijective.comp hg hf,
end

-- 2ª demostración
example : transitive (⋍) :=
begin
  rintros X Y Z ⟨f, hf⟩ ⟨g, hg⟩,
  use [g ∘ f, bijective.comp hg hf],
end

-- 3ª demostración
example : transitive (⋍) :=
λ X Y Z ⟨f, hf⟩ ⟨g, hg⟩, by use [g ∘ f, bijective.comp hg hf]

-- 4ª demostración
example : transitive (⋍) :=
λ X Y Z ⟨f, hf⟩ ⟨g, hg⟩, exists.intro (g ∘ f) (bijective.comp hg hf)

-- 4ª demostración
example : transitive (⋍) :=
λ X Y Z ⟨f, hf⟩ ⟨g, hg⟩, ⟨g ∘ f, bijective.comp hg hf⟩