variables p q r : Prop

-- commutativity of ∧ and ∨
def conjuction_commutativity : p ∧ q ↔ q ∧ p := sorry

def disjunction_commutativity_one_way {p: Prop} {q: Prop} (h : p ∨ q) : q ∨ p :=
or.elim h
  (assume hp : p,
    show q ∨ p, from or.intro_right q hp)
  (assume hq : q,
    show q ∨ p, from or.intro_left p hq)

example : p ∨ q ↔ q ∨ p :=
iff.intro
  (disjunction_commutativity_one_way)
  (disjunction_commutativity_one_way)

def conjuction_associativity_left {p: Prop} {q: Prop} {r: Prop} (h: (p ∧ q) ∧ r) : p ∧ (q ∧ r) :=
have hpq: p ∧ q, from h.left,
have hp: p, from hpq.left,
have hq: q, from hpq.right,
have hr: r, from h.right,
have hqr: q ∧ r, from ⟨hq, hr⟩,
show p ∧ (q ∧ r), from ⟨hp, hqr⟩

def conjuction_associativity_right {p: Prop} {q: Prop} {r: Prop} (h: p ∧ (q ∧ r)) : (p ∧ q) ∧ r :=
have hqr: q ∧ r, from h.right,
have hq: q, from hqr.left,
have hr: r, from hqr.right,
have hp: p, from h.left,
have hpq: p ∧ q, from ⟨hp, hq⟩,
show (p ∧ q) ∧ r, from ⟨hpq, hr⟩

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
iff.intro
  (conjuction_associativity_left)
  (conjuction_associativity_right)

def disjunction_associativity_right {p: Prop} {q: Prop} {r: Prop} (h: (p ∨ q) ∨ r) : p ∨ (q ∨ r) :=
or.elim h
  (assume hpq: p ∨ q,
    or.elim hpq
      (assume hp: p,
        show p ∨ (q ∨ r), from or.inl hp )
      (assume hq: q,
        have hqr: q ∨ r, from or.inl hq,
        show p ∨ (q ∨ r), from or.inr hqr))
  (assume hr: r,
   have hqr: q ∨ r, from or.inr hr,
   show p ∨ (q ∨ r), from or.inr hqr)

def disjunction_associativity_left {p: Prop} {q: Prop} {r: Prop} (h: p ∨ (q ∨ r)) : (p ∨ q) ∨ r :=
or.elim h
  (assume hp: p,
   have hpq: p ∨ q, from or.inl hp,
   show (p ∨ q) ∨ r, from or.inl hpq)
  (assume hqr: q ∨ r,
    or.elim hqr
      (assume hq: q,
        have hpq: p ∨ q, from or.inr hq,
        show (p ∨ q) ∨ r, from or.inl hpq)
      (assume hr: r,
        show (p ∨ q) ∨ r, from or.inr hr ))

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
iff.intro
  (disjunction_associativity_right)
  (disjunction_associativity_left)

-- distributivity
def conjunction_distributivity {p: Prop} {q: Prop} {r: Prop} : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
  (assume hpqr: p ∧ (q ∨ r),
   have hp: p, from hpqr.left,
   have hqr: q ∨ r, from hpqr.right,
   or.elim hqr
      (assume hq: q,
        have hpq: p ∧ q, from ⟨hp, hq⟩,
        show (p ∧ q) ∨ (p ∧ r), from or.inl hpq
      )
      (assume hr: r,
        have hpr: p ∧ r, from ⟨hp, hr⟩,
        show (p ∧ q) ∨ (p ∧ r), from or.inr hpr
      )
  )
  (assume pqpr: (p ∧ q) ∨ (p ∧ r),
    or.elim pqpr
      (assume pq: p ∧ q,
        have hp: p, from pq.left,
        have hq: q, from pq.right,
        have hqr: q ∨ r, from or.inl hq,
        show p ∧ (q ∨ r), from ⟨hp,hqr⟩
      )
      (assume pr: p ∧ r,
        have hp: p, from pr.left,
        have hr: r, from pr.right,
        have hqr: q ∨ r, from or.inr hr,
        show p ∧ (q ∨ r), from ⟨hp,hqr⟩
      )
  )

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := sorry

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
iff.intro
  (assume hpqr: p → (q → r),
    assume hpq: p ∧ q,
    have hp: p, from hpq.left,
    have hq: q, from hpq.right,
    have hqr: q → r,from hpqr hp,
    show r, from hqr hq
  )
  (assume hpqr: p ∧ q → r,
    assume hp: p,
    assume hq: q,
    show r,from hpqr ⟨hp, hq⟩
  )

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
iff.intro

(assume hpqr: (p ∨ q) → r,
 have hpr: p → r, from
  assume hp: p,
    have hpq: p ∨ q, from or.inl  hp,
    show r, from hpqr hpq,
 have hqr: q → r, from
  assume hq: q,
    have hpq: p ∨ q, from or.inr hq,
    show r, from hpqr hpq,
 show (p → r) ∧ (q → r), from ⟨hpr, hqr⟩ )

(assume hprqr: (p → r) ∧ (q → r),
  assume hpq: p ∨ q,
    or.elim hpq
      (assume hp: p,
        show r, from hprqr.left hp)
      (assume hq: q,
        show r, from hprqr.right hq))

def disjunction_negation: ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
iff.intro

(assume npq: ¬(p ∨ q),
have np: ¬p, from
  assume hp: p,
    have hpq: p ∨ q, from or.inl hp,
    show false, from npq hpq,
have nq: ¬q, from
  assume hq: q,
    have hpq: p ∨ q, from or.inr hq,
    show false, from npq hpq,
show ¬p ∧ ¬q, from ⟨np, nq⟩)

(assume npnq: ¬p ∧ ¬q,
assume pq: p ∨ q,
 or.elim pq
 (assume hp: p,
  show false, from npnq.left hp)
 (assume hq: q,
  show false, from npnq.right hq)
)

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
assume npnq: ¬p ∨ ¬q,
assume hpq: p ∧ q,
or.elim npnq
(assume hnp: ¬p,
show false, from hnp hpq.left)
(assume hnq: ¬q,
show false, from hnq hpq.right)

example : ¬(p ∧ ¬p) :=
assume npq: p ∧ ¬p,
show false, from npq.right npq.left

example : p ∧ ¬q → ¬(p → q) :=
assume hpnq: p ∧ ¬q,
assume hpq: p → q,
show false, from hpnq.right (hpq hpnq.left)

example : ¬p → (p → q) :=
assume hnp: ¬p,
assume hp: p,
show q, from absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
assume hnpq: ¬p ∨ q,
assume hp: p,
or.elim hnpq
(assume nhp: ¬p,
show q, from absurd hp nhp
)
(assume hq: q,
show q, from hq)

def disjunction_with_false : p ∨ false ↔ p :=
iff.intro
(assume hpf: p ∨ false,
or.elim hpf
  (assume hp: p,
  show p , from hp)
  (assume hf: false,
  show p, from false.elim hf))
(assume hp: p,
show p ∨ false, from or.intro_left false hp )

example : p ∧ false ↔ false :=
iff.intro
(assume hpf: p ∧ false,
show false, from hpf.right)
(assume hf: false,
show p ∧ false, from false.elim hf)

example : (p → q) → (¬q → ¬p) :=
assume hpq: p → q,
assume hnq: ¬q,
assume hp: p,
have hq: q, from hpq hp,
show false, from hnq hq

open classical

variables s : Prop

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
assume hprs: p → r ∨ s,
or.elim (em r)
  (assume vr: r,
    or.inl
      (show p → r, from
        assume hp: p,
        vr)
  )
  (assume hnr: ¬r,
    or.inr
      (show p → s, from
        assume hp: p,
        or.elim (hprs hp)
          (assume hr: r,
           show s, from absurd hr hnr)
          (assume hs: s,
           show s, from hs
          )
        )
  )

def conjunction_negation {p: Prop} {q: Prop} (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
or.elim (em p)
  (assume hp : p,
    or.inr
      (show ¬q, from
        assume hq : q,
        h ⟨hp, hq⟩))
  (assume hp : ¬p,
    or.inl hp)

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p, absurd hnp h)

example : ¬(p → q) → p ∧ ¬q :=
assume npq: ¬(p → q),
by_cases
  (assume h1:  p ∧ ¬q, h1)
  (assume h2: ¬(p ∧ ¬q),
    have hpq: p → q, from
      assume hp: p,
        have hnpq: ¬p ∨ ¬¬q, from conjunction_negation h2,
        have hpnpq: p ∧ (¬p ∨ ¬¬q), from ⟨hp, hnpq⟩,
        have pnppnnq: (p ∧ ¬p) ∨ (p ∧ ¬¬q),
          from iff.mp conjunction_distributivity hpnpq,
        or.elim pnppnnq
          (assume pnp: (p ∧ ¬p),
            show q, from absurd pnp.left pnp.right)
          (assume pnnq: (p ∧ ¬¬q),
            show q, from dne pnnq.right),
    show p ∧ ¬q, from absurd hpq npq)

  --  p ∧ ¬(p ∧ ¬q) = p ∧ (¬p ∨ q) =(! p ∧ ¬p ?!?!= false  ) false ∨ (p ∧ q) =
  -- = p ∧ q = q

def impication_negation_to_disjunction {p: Prop} {q: Prop} : ¬(p → q) → p ∧ ¬q :=
assume npq: ¬(p → q),
by_contradiction
  (assume h2: ¬(p ∧ ¬q),
  have hpq: p → q, from
      assume hp: p,
        have hnpq: ¬p ∨ ¬¬q, from conjunction_negation h2,
        have hpnpq: p ∧ (¬p ∨ ¬¬q), from ⟨hp, hnpq⟩,
        have pnppnnq: (p ∧ ¬p) ∨ (p ∧ ¬¬q),
          from iff.mp conjunction_distributivity hpnpq,
        or.elim pnppnnq
          (assume pnp: (p ∧ ¬p),
            show q, from absurd pnp.left pnp.right)
          (assume pnnq: (p ∧ ¬¬q),
            show q, from dne pnnq.right),
  show false, from absurd hpq npq)

example : (p → q) → (¬p ∨ q) :=
assume hpq: p → q,
by_cases
  (assume hp: p, or.inr (hpq hp))
  (assume hnp: ¬p, or.inl hnp)

example : (¬q → ¬p) → (p → q) :=
assume npnq: ¬q → ¬p,
assume hp:p,
by_cases
  (assume hq: q, hq)
  (assume hnq: ¬q, absurd hp (npnq hnq))

example : p ∨ ¬p :=
by_cases
  (assume hp: p, or.inl hp)
  (assume hnp: ¬p, or.inr hnp)

example : (((p → q) → p) → p) :=
assume hpqp: (p → q) → p,
by_cases
  (assume hpq: (p → q), hpqp hpq)
  (assume nhpq: ¬(p → q),
    (impication_negation_to_disjunction nhpq).left )

-- Prove ¬(p ↔ ¬p) without using classical logic.
-- p ↔ ¬p - > false

example: ¬(p ↔ ¬p) :=-
assume pisnotp: p ↔ ¬p,
iff.mp pisnotp -- p -> ¬p   , ¬p = p -> false
pisnotp -- ¬(p <-> ¬p) =  p <-> ¬p  -> false
pisnotp -- false

example: ¬(p ↔ ¬p) :=
assume pisnotp: p ↔ ¬p,
have h1: p → ¬p  , from iff.mp pisnotp,
have h2: ¬ (p ↔ ¬p), from h1 pisnotp,

example: (p ↔ q) → (q ↔ p) :=
  assume pq: p ↔ q,
   iff.intro
   (assume hq: q,
    iff.mpr pq hq)
   (assume hp: p,
    iff.mp pq hp)


/-
Copyright (c) 2020 Shing Tak Lam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam
-/
import data.zmod.basic
import group_theory.exponent

/-!
# Dihedral Groups

We define the dihedral groups `dihedral_group n`, with elements `r i` and `sr i` for `i : zmod n`.

For `n ≠ 0`, `dihedral_group n` represents the symmetry group of the regular `n`-gon. `r i`
represents the rotations of the `n`-gon by `2πi/n`, and `sr i` represents the reflections of the
`n`-gon. `dihedral_group 0` corresponds to the infinite dihedral group.
-/

/--
For `n ≠ 0`, `dihedral_group n` represents the symmetry group of the regular `n`-gon.
`r i` represents the rotations of the `n`-gon by `2πi/n`, and `sr i` represents the reflections of
the `n`-gon. `dihedral_group 0` corresponds to the infinite dihedral group.
-/
@[derive decidable_eq]
inductive dihedral_group (n : ℕ) : Type
| r : zmod n → dihedral_group
| sr : zmod n → dihedral_group

namespace dihedral_group

variables {n : ℕ}

/--
Multiplication of the dihedral group.
-/
private def mul : dihedral_group n → dihedral_group n → dihedral_group n
| (r i) (r j) := r (i + j)
| (r i) (sr j) := sr (j - i)
| (sr i) (r j) := sr (i + j)
| (sr i) (sr j) := r (j - i)

/--
The identity `1` is the rotation by `0`.
-/
private def one : dihedral_group n := r 0

instance : inhabited (dihedral_group n) := ⟨one⟩

/--
The inverse of a an element of the dihedral group.
-/
private def inv : dihedral_group n → dihedral_group n
| (r i) := r (-i)
| (sr i) := sr i

/--
The group structure on `dihedral_group n`.
-/
instance : group (dihedral_group n) :=
{ mul := mul,
  mul_assoc :=
  begin
    rintros (a | a) (b | b) (c | c);
    simp only [mul];
    ring,
  end,
  one := one,
  one_mul :=
  begin
    rintros (a | a),
    exact congr_arg r (zero_add a),
    exact congr_arg sr (sub_zero a),
  end,
  mul_one := begin
    rintros (a | a),
    exact congr_arg r (add_zero a),
    exact congr_arg sr (add_zero a),
  end,
  inv := inv,
  mul_left_inv := begin
    rintros (a | a),
    exact congr_arg r (neg_add_self a),
    exact congr_arg r (sub_self a),
  end }

@[simp] lemma r_mul_r (i j : zmod n) : r i * r j = r (i + j) := rfl
@[simp] lemma r_mul_sr (i j : zmod n) : r i * sr j = sr (j - i) := rfl
@[simp] lemma sr_mul_r (i j : zmod n) : sr i * r j = sr (i + j) := rfl
@[simp] lemma sr_mul_sr (i j : zmod n) : sr i * sr j = r (j - i) := rfl

lemma one_def : (1 : dihedral_group n) = r 0 := rfl

private def fintype_helper : (zmod n ⊕ zmod n) ≃ dihedral_group n :=
{ inv_fun := λ i, match i with
                 | (r j) := sum.inl j
                 | (sr j) := sum.inr j
                 end,
  to_fun := λ i, match i with
                 | (sum.inl j) := r j
                 | (sum.inr j) := sr j
                 end,
  left_inv := by rintro (x | x); refl,
  right_inv := by rintro (x | x); refl }

/--
If `0 < n`, then `dihedral_group n` is a finite group.
-/
instance [ne_zero n] : fintype (dihedral_group n) := fintype.of_equiv _ fintype_helper

instance : nontrivial (dihedral_group n) := ⟨⟨r 0, sr 0, dec_trivial⟩⟩

/--
If `0 < n`, then `dihedral_group n` has `2n` elements.
-/
lemma card [ne_zero n] : fintype.card (dihedral_group n) = 2 * n :=
by rw [← fintype.card_eq.mpr ⟨fintype_helper⟩, fintype.card_sum, zmod.card, two_mul]

@[simp] lemma r_one_pow (k : ℕ) : (r 1 : dihedral_group n) ^ k = r k :=
begin
  induction k with k IH,
  { rw nat.cast_zero, refl },
  { rw [pow_succ, IH, r_mul_r],
    congr' 1,
    norm_cast,
    rw nat.one_add }
end

@[simp] lemma r_one_pow_n : (r (1 : zmod n))^n = 1 :=
begin
  rw [r_one_pow, one_def],
  congr' 1,
  exact zmod.nat_cast_self _,
end

@[simp]

/--
If `0 < n`, then `sr i` has order 2.
-/
@[simp] lemma order_of_sr (i : zmod n) : order_of (sr i) = 2 :=
begin
  rw order_of_eq_prime _ _,
  { exact ⟨nat.prime_two⟩ },
  rw [sq, sr_mul_self],
  dec_trivial,
end

/--
If `0 < n`, then `r 1` has order `n`.
-/
@[simp] lemma order_of_r_one : order_of (r 1 : dihedral_group n) = n :=
begin
  rcases eq_zero_or_ne_zero n with rfl | hn,
  { rw order_of_eq_zero_iff',
    intros n hn,
    rw [r_one_pow, one_def],
    apply mt r.inj,
    simpa using hn.ne' },
  { resetI,
    apply (nat.le_of_dvd (ne_zero.pos n) $ order_of_dvd_of_pow_eq_one $ @r_one_pow_n n)
      .lt_or_eq.resolve_left,
    intro h,
    have h1 : (r 1 : dihedral_group n)^(order_of (r 1)) = 1,
    { exact pow_order_of_eq_one _ },
    rw r_one_pow at h1,
    injection h1 with h2,
    rw [← zmod.val_eq_zero, zmod.val_nat_cast, nat.mod_eq_of_lt h] at h2,
    exact absurd h2.symm (order_of_pos _).ne },
end

/--
If `0 < n`, then `i : zmod n` has order `n / gcd n i`.
-/
lemma order_of_r [ne_zero n] (i : zmod n) : order_of (r i) = n / nat.gcd n i.val :=
begin
  conv_lhs { rw ←zmod.nat_cast_zmod_val i },
  rw [←r_one_pow, order_of_pow, order_of_r_one]
end

lemma exponent : monoid.exponent (dihedral_group n) = lcm n 2 :=
begin
  rcases eq_zero_or_ne_zero n with rfl | hn,
  { exact monoid.exponent_eq_zero_of_order_zero order_of_r_one },
  resetI,
  apply nat.dvd_antisymm,
  { apply monoid.exponent_dvd_of_forall_pow_eq_one,
    rintro (m | m),
    { rw [←order_of_dvd_iff_pow_eq_one, order_of_r],
      refine nat.dvd_trans ⟨gcd n m.val, _⟩ (dvd_lcm_left n 2),
      { exact (nat.div_mul_cancel (nat.gcd_dvd_left n m.val)).symm } },
    { rw [←order_of_dvd_iff_pow_eq_one, order_of_sr],
      exact dvd_lcm_right n 2 } },
  { apply lcm_dvd,
    { convert monoid.order_dvd_exponent (r 1),
      exact order_of_r_one.symm },
    { convert monoid.order_dvd_exponent (sr 0),
      exact (order_of_sr 0).symm } }
end

end dihedral_group


import combinatorics.simple_graph.clique
import combinatorics.simple_graph.degree_sum
import data.finset.basic
import data.nat.basic
import tactic.core
import algebra.big_operators
--local
import nbhd_res

open finset nat
open_locale big_operators

namespace simple_graph

section clique_free_sets
variables {t n : ℕ}
variables {α : Type*} (G : simple_graph α) [fintype α][nonempty α]{s : finset α}[decidable_eq α][decidable_rel G.adj]

-- restricted nbhd is the part of nbhd in A
include G
-- we will need the concept of a clique-free set of vertices in a graph rather than just clique-free graphs
-- A is a t-clique-free set of vertices in G
def clique_free_set (A : finset α) (s : ℕ): Prop:= ∀ B ⊆ A, ¬G.is_n_clique s B

--clique-free if too small
lemma clique_free_card_lt {A : finset α} {s: ℕ} (h: A.card <s): G.clique_free_set A s:=
begin
  rw clique_free_set,intros B hB,rw is_n_clique_iff,push_neg,intro h1,
  exact ne_of_lt (lt_of_le_of_lt (card_le_of_subset hB) h),
end

--clique-free of empty (unless s=0)
lemma clique_free_empty {s : ℕ} (h: 0< s): G.clique_free_set ∅ s:=
begin
  have:=finset.card_empty, rw ← this at h, exact G.clique_free_card_lt h,
end

-- if G has no s-clique then nor does the univ
lemma clique_free_graph_imp_set {s : ℕ} (h: G.clique_free s) :  G.clique_free_set univ s:=
begin
  revert h, contrapose,
  rw clique_free_set,push_neg,intro h, rw clique_free, push_neg,
  obtain ⟨B,h1,h2⟩:=h,  exact ⟨B,h2⟩,
end

-- base case for Erdos/Furedi proof:
-- if A has no 2-clique then restricted degrees are all zero
-- i.e. A is an independent set

lemma two_clique_free {A: finset α} (hA : G.clique_free_set A 2) :  ∀v∈A, G.deg_res v A =0 :=
begin
  intros v hv, rw [deg_res,card_eq_zero],
  contrapose hA,
  obtain ⟨w,hw⟩:=exists_mem_nempty G hA,
  cases hw with h1 h2,
  have ne: v≠w := adj.ne h2,
  have c2 :card {v,w} =2:=card_doubleton ne,
  have :G.is_n_clique 2 {v,w},{
    rw [is_n_clique_iff, coe_insert, coe_singleton, is_clique_iff,set.pairwise_pair_of_symmetric],
    exact ⟨λh,h2,c2⟩,exact G.symm,},
  rw clique_free_set, push_neg,
  refine ⟨{v,w},_,this⟩, intros x hx,
  simp only [mem_insert, mem_singleton] at *,cases hx,{ rw hx,exact hv},{rw hx, exact h1},
end

-- sum of deg_res over an independent set (2-clique-free set) is 0
-- e (G.ind A)=0
lemma two_clique_free_sum {A: finset α} (hA : G.clique_free_set A 2) : ∑ v in A, G.deg_res v A = 0
:=sum_eq_zero (G.two_clique_free hA)

-- if A set is (t+2)-clique-free then any member vertex
-- has restricted nbhd that is (t+1)-clique-free
-- (just prove for any simple_graph α if  G is (t+2)-clique free then so is any nbhd of a vertex in G
-- then can apply it to G.ind A etc...
lemma t_clique_free {A: finset α} {v :α}(hA : G.clique_free_set A (t + 2)) (hv : v ∈ A) :
G.clique_free_set (G.nbhd_res v A) (t + 1):=
begin
  rw clique_free_set at *,
  intros B hB, contrapose! hA,
  set C:= B ∪ {v} with hC,
  refine ⟨C,_,_⟩,{
  rw hC, apply union_subset (subset_trans hB (G.sub_res_nbhd_A v A)) _,
  simp only [hv, singleton_subset_iff]},
  rw is_n_clique_iff at *,
  refine ⟨_,_⟩,{
  rcases hA with ⟨cl,ca⟩,
  rw [is_clique_iff, set.pairwise],
  intros x hx y hy hne,
  by_cases x=v,
    have yB : y∈ G.neighbor_finset v,{
      simp only [*, coe_union, coe_singleton, set.union_singleton, set.mem_insert_iff,
      mem_coe, eq_self_iff_true, true_or, ne.def] at *,
      cases hy,exfalso, exact hne hy.symm,
      exact (mem_of_mem_inter_right (hB hy)),},
    rwa [h, ← mem_neighbor_finset G v],
    by_cases h2:  y=v,{
      rw h2, simp only [*, ne.def, not_false_iff, coe_union, coe_singleton, set.union_singleton,
      set.mem_insert_iff, eq_self_iff_true, mem_coe, true_or, false_or] at *,
      rw [adj_comm,  ← mem_neighbor_finset G v],
      exact mem_of_mem_inter_right (hB hx)},
    simp only [*, ne.def, coe_union, coe_singleton, set.union_singleton, set.mem_insert_iff,
    mem_coe, false_or, eq_self_iff_true] at *,
    exact cl hx hy hne},{
    have: 2=1+1:=by norm_num,
    rw [hC,this, ← add_assoc],
    convert card_union_eq _,{exact hA.2.symm},
    rw disjoint_singleton_right,
    intros h, apply  (not_mem_res_nbhd G v A) (hB h)},
end

end clique_free_sets

end simple_graph


import analysis.special_functions.exp
import analysis.special_functions.exp_deriv
import basic
open polynomial

open set filter

noncomputable theory

@[simp]
def x_sub_dx_fn (f : ℝ → ℝ) :=
id * f - deriv f

lemma x_sub_dx_fn_def (f : ℝ → ℝ) : x_sub_dx_fn f = id * f - deriv f := rfl

lemma x_sub_dx_fn_apply (f : ℝ → ℝ) (x : ℝ) :
x_sub_dx_fn f x = x * f x - deriv f x := rfl

def gaussian : ℝ → ℝ := λ x, real.exp (-(x^2 / 2))

def inv_gaussian : ℝ → ℝ := λ x, real.exp (x^2 / 2)

lemma inv_gaussian_mul_gaussian (x : ℝ) : inv_gaussian x * gaussian x = 1 :=
by rw [gaussian, inv_gaussian, ← real.exp_add, add_neg_self, real.exp_zero]

lemma deriv_gaussian (x : ℝ) : deriv gaussian x = -x * gaussian x :=
by simp [gaussian, mul_comm]

lemma deriv_inv_gaussian (x : ℝ) : deriv inv_gaussian x = x * inv_gaussian x :=
by simp [inv_gaussian, mul_comm]

lemma cont_diff_gaussian : cont_diff ℝ ⊤ gaussian :=
((cont_diff_id.pow 2).div_const 2).neg.exp

lemma cont_diff.iterated_deriv :
∀ (n : ℕ) (f : ℝ → ℝ) (hf : cont_diff ℝ ⊤ f), cont_diff ℝ ⊤ (deriv^[n] f)
| 0     f hf := hf
| (n+1) f hf := cont_diff.iterated_deriv n (deriv f) (cont_diff_top_iff_deriv.mp hf).2

@[simp]
def hermite_exp (n : ℕ) : ℝ → ℝ :=
λ x, (-1)^n * (inv_gaussian x) * (deriv^[n] gaussian x)

lemma hermite_exp_def (n : ℕ) :
hermite_exp n = λ x, (-1)^n * (inv_gaussian x) * (deriv^[n] gaussian x) := rfl

lemma hermite_exp_succ (n : ℕ) : hermite_exp (n+1)
= x_sub_dx_fn (hermite_exp n) :=
begin
  ext,
  simp only [hermite_exp, x_sub_dx_fn, function.iterate_succ', function.comp_app,
             id.def, pi.mul_apply, pi.sub_apply, pow_succ],
  rw [deriv_mul, deriv_const_mul, deriv_inv_gaussian],
  ring,
  { simp [inv_gaussian] },
  { simp [inv_gaussian] },
  { apply (cont_diff_top_iff_deriv.mp (cont_diff.iterated_deriv _ _ cont_diff_gaussian)).1 },
end

lemma exp_mul_exp_neg_eq_one (x : ℝ) : real.exp(x) * real.exp(-x) = 1 :=
begin
  rw real.exp_neg,
  apply (mul_inv_eq_one₀ (real.exp_ne_zero (x))).mpr,
  refl,
end

-- @[simp]
-- lemma hermite_exp_zero : (λ x, (-1)^0 * (inv_gaussian x) * (deriv^[0] gaussian x)) = (λ x, 1) :=
-- begin
--   ext,
--   simp [hermite_exp, inv_gaussian, gaussian, exp_mul_exp_neg_eq_one]
-- end

lemma eval_x_sub_dx_eq (p : polynomial ℝ) :
(λ (x : ℝ), eval x (x_sub_dx p)) = x_sub_dx_fn (λ (x : ℝ), eval x p) :=
begin
  ext, simp,
end

lemma hermite_eq_exp (n : ℕ) :
(λ x, eval x (hermite n)) = λ x, (-1)^n * (inv_gaussian x) * (deriv^[n] gaussian x) :=
begin
  induction n with n ih,
  { simp [inv_gaussian_mul_gaussian] },
  { rw [← hermite_exp_def, hermite_exp_succ,
    hermite_succ, eval_x_sub_dx_eq, hermite_exp_def, ih] },
end

lemma hermite_eq_exp_apply : ∀ (n : ℕ) (x : ℝ), eval x (hermite n) = (-1)^n * (inv_gaussian x) * (deriv^[n] gaussian x) :=
λ n x, congr_fun (hermite_eq_exp n) x


/-
Copyright (c) 2021 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import linear_algebra.basic

/-!
# Rays in modules

This file defines rays in modules.

## Main definitions

* `same_ray`: two vectors belong to the same ray if they are proportional with a nonnegative
  coefficient.

* `module.ray` is a type for the equivalence class of nonzero vectors in a module with some
common positive multiple.
-/

noncomputable theory

open_locale big_operators

section ordered_comm_semiring

variables (R : Type*) [ordered_comm_semiring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {N : Type*} [add_comm_monoid N] [module R N]
variables (ι : Type*) [decidable_eq ι]

/-- Two vectors are in the same ray if either one of them is zero or some positive multiples of them
are equal (in the typical case over a field, this means one of them is a nonnegative multiple of
the other). -/
def same_ray (v₁ v₂ : M) : Prop :=
v₁ = 0 ∨ v₂ = 0 ∨ ∃ (r₁ r₂ : R), 0 < r₁ ∧ 0 < r₂ ∧ r₁ • v₁ = r₂ • v₂

variables {R}

namespace same_ray

variables {x y z : M}

lemma zero_left (y : M) : same_ray R 0 y := or.inl rfl

lemma zero_right (x : M) : same_ray R x 0 := or.inr $ or.inl rfl

@[nontriviality] lemma of_subsingleton [subsingleton M] (x y : M) : same_ray R x y :=
by { rw [subsingleton.elim x 0], exact zero_left _ }

@[nontriviality] lemma of_subsingleton' [subsingleton R] (x y : M) : same_ray R x y :=
by { haveI := module.subsingleton R M, exact of_subsingleton x y }

/-- `same_ray` is reflexive. -/
@[refl] lemma refl (x : M) : same_ray R x x :=
begin
  nontriviality R,
  exact or.inr (or.inr $ ⟨1, 1, zero_lt_one, zero_lt_one, rfl⟩)
end

/-- `same_ray` is symmetric. -/
@[symm] lemma symm (h : same_ray R x y) : same_ray R y x :=
(or.left_comm.1 h).imp_right $ or.imp_right $ λ ⟨r₁, r₂, h₁, h₂, h⟩, ⟨r₂, r₁, h₂, h₁, h.symm⟩

/-- If `x` and `y` are nonzero vectors on the same ray, then there exist positive numbers `r₁ r₂`
such that `r₁ • x = r₂ • y`. -/
lemma exists_pos (h : same_ray R x y) (hx : x ≠ 0) (hy : y ≠ 0) :
  ∃ r₁ r₂ : R, 0 < r₁ ∧ 0 < r₂ ∧ r₁ • x = r₂ • y :=
(h.resolve_left hx).resolve_left hy

lemma _root_.same_ray_comm : same_ray R x y ↔ same_ray R y x :=
⟨same_ray.symm, same_ray.symm⟩

/-- `same_ray` is transitive unless the vector in the middle is zero and both other vectors are
nonzero. -/
lemma trans (hxy : same_ray R x y) (hyz : same_ray R y z) (hy : y = 0 → x = 0 ∨ z = 0) :
  same_ray R x z :=
begin
  rcases eq_or_ne x 0 with rfl|hx, { exact zero_left z },
  rcases eq_or_ne z 0 with rfl|hz, { exact zero_right x },
  rcases eq_or_ne y 0 with rfl|hy, { exact (hy rfl).elim (λ h, (hx h).elim) (λ h, (hz h).elim) },
  rcases hxy.exists_pos hx hy with ⟨r₁, r₂, hr₁, hr₂, h₁⟩,
  rcases hyz.exists_pos hy hz with ⟨r₃, r₄, hr₃, hr₄, h₂⟩,
  refine or.inr (or.inr $ ⟨r₃ * r₁, r₂ * r₄, mul_pos hr₃ hr₁, mul_pos hr₂ hr₄, _⟩),
  rw [mul_smul, mul_smul, h₁, ← h₂, smul_comm]
end

/-- A vector is in the same ray as a nonnegative multiple of itself. -/
lemma _root_.same_ray_nonneg_smul_right (v : M) {r : R} (h : 0 ≤ r) : same_ray R v (r • v) :=
or.inr $ h.eq_or_lt.imp (λ h, h ▸ zero_smul R v) $
  λ h, ⟨r, 1, h, by { nontriviality R, exact zero_lt_one }, (one_smul _ _).symm⟩

/-- A vector is in the same ray as a positive multiple of itself. -/
lemma _root_.same_ray_pos_smul_right (v : M) {r : R} (h : 0 < r) : same_ray R v (r • v) :=
same_ray_nonneg_smul_right v h.le

/-- A vector is in the same ray as a nonnegative multiple of one it is in the same ray as. -/
lemma nonneg_smul_right {r : R} (h : same_ray R x y) (hr : 0 ≤ r) : same_ray R x (r • y) :=
h.trans (same_ray_nonneg_smul_right y hr) $ λ hy, or.inr $ by rw [hy, smul_zero]

/-- A vector is in the same ray as a positive multiple of one it is in the same ray as. -/
lemma pos_smul_right {r : R} (h : same_ray R x y) (hr : 0 < r) : same_ray R x (r • y) :=
h.nonneg_smul_right hr.le

/-- A nonnegative multiple of a vector is in the same ray as that vector. -/
lemma _root_.same_ray_nonneg_smul_left (v : M) {r : R} (h : 0 ≤ r) : same_ray R (r • v) v :=
(same_ray_nonneg_smul_right v h).symm

/-- A positive multiple of a vector is in the same ray as that vector. -/
lemma _root_.same_ray_pos_smul_left (v : M) {r : R} (h : 0 < r) : same_ray R (r • v) v :=
same_ray_nonneg_smul_left v h.le

/-- A nonnegative multiple of a vector is in the same ray as one it is in the same ray as. -/
lemma nonneg_smul_left {r : R} (h : same_ray R x y) (hr : 0 ≤ r) : same_ray R (r • x) y :=
(h.symm.nonneg_smul_right hr).symm

/-- A positive multiple of a vector is in the same ray as one it is in the same ray as. -/
lemma pos_smul_left {r : R} (h : same_ray R x y) (hr : 0 < r) : same_ray R (r • x) y :=
h.nonneg_smul_left hr.le

/-- If two vectors are on the same ray then they remain so after applying a linear map. -/
lemma map (f : M →ₗ[R] N) (h : same_ray R x y) : same_ray R (f x) (f y) :=
h.imp (λ hx, by rw [hx, map_zero]) $ or.imp (λ hy, by rw [hy, map_zero]) $
  λ ⟨r₁, r₂, hr₁, hr₂, h⟩, ⟨r₁, r₂, hr₁, hr₂, by rw [←f.map_smul, ←f.map_smul, h]⟩

/-- The images of two vectors under a linear equivalence are on the same ray if and only if the
original vectors are on the same ray. -/
@[simp] lemma _root_.same_ray_map_iff (e : M ≃ₗ[R] N) : same_ray R (e x) (e y) ↔ same_ray R x y :=
⟨λ h, by simpa using same_ray.map e.symm.to_linear_map h, same_ray.map e.to_linear_map⟩

/-- If two vectors are on the same ray then both scaled by the same action are also on the same
ray. -/
lemma smul {S : Type*} [monoid S] [distrib_mul_action S M] [smul_comm_class R S M]
  (h : same_ray R x y) (s : S) : same_ray R (s • x) (s • y) :=
h.map (s • (linear_map.id : M →ₗ[R] M))

/-- If `x` and `y` are on the same ray as `z`, then so is `x + y`. -/
lemma add_left (hx : same_ray R x z) (hy : same_ray R y z) : same_ray R (x + y) z :=
begin
  rcases eq_or_ne x 0 with rfl|hx₀, { rwa zero_add },
  rcases eq_or_ne y 0 with rfl|hy₀, { rwa add_zero },
  rcases eq_or_ne z 0 with rfl|hz₀, { apply zero_right },
  rcases hx.exists_pos hx₀ hz₀ with ⟨rx, rz₁, hrx, hrz₁, Hx⟩,
  rcases hy.exists_pos hy₀ hz₀ with ⟨ry, rz₂, hry, hrz₂, Hy⟩,
  refine or.inr (or.inr ⟨rx * ry, ry * rz₁ + rx * rz₂, mul_pos hrx hry, _, _⟩),
  { apply_rules [add_pos, mul_pos] },
  { simp only [mul_smul, smul_add, add_smul, ← Hx, ← Hy],
    rw smul_comm }
end

/-- If `y` and `z` are on the same ray as `x`, then so is `y + z`. -/
lemma add_right (hy : same_ray R x y) (hz : same_ray R x z) : same_ray R x (y + z) :=
(hy.symm.add_left hz.symm).symm

end same_ray

/-- Nonzero vectors, as used to define rays. This type depends on an unused argument `R` so that
`ray_vector.setoid` can be an instance. -/
@[nolint unused_arguments has_inhabited_instance]
def ray_vector (R M : Type*) [has_zero M] := {v : M // v ≠ 0}

instance ray_vector.has_coe {R M : Type*} [has_zero M] :
  has_coe (ray_vector R M) M := coe_subtype

instance {R M : Type*} [has_zero M] [nontrivial M] : nonempty (ray_vector R M) :=
let ⟨x, hx⟩ := exists_ne (0 : M) in ⟨⟨x, hx⟩⟩

variables (R M)

/-- The setoid of the `same_ray` relation for the subtype of nonzero vectors. -/
instance : setoid (ray_vector R M) :=
{ r := λ x y, same_ray R (x : M) y,
  iseqv := ⟨λ x, same_ray.refl _, λ x y h, h.symm,
    λ x y z hxy hyz, hxy.trans hyz $ λ hy, (y.2 hy).elim⟩ }

/-- A ray (equivalence class of nonzero vectors with common positive multiples) in a module. -/
@[nolint has_inhabited_instance]
def module.ray := quotient (ray_vector.setoid R M)

variables {R M}

/-- Equivalence of nonzero vectors, in terms of same_ray. -/
lemma equiv_iff_same_ray {v₁ v₂ : ray_vector R M} :
  v₁ ≈ v₂ ↔ same_ray R (v₁ : M) v₂ :=
iff.rfl

variables (R)

/-- The ray given by a nonzero vector. -/
protected def ray_of_ne_zero (v : M) (h : v ≠ 0) : module.ray R M := ⟦⟨v, h⟩⟧

/-- An induction principle for `module.ray`, used as `induction x using module.ray.ind`. -/
lemma module.ray.ind {C : module.ray R M → Prop}
  (h : ∀ v (hv : v ≠ 0), C (ray_of_ne_zero R v hv)) (x : module.ray R M) : C x :=
quotient.ind (subtype.rec $ by exact h) x

variable {R}

instance [nontrivial M] : nonempty (module.ray R M) :=
nonempty.map quotient.mk infer_instance

/-- The rays given by two nonzero vectors are equal if and only if those vectors
satisfy `same_ray`. -/
lemma ray_eq_iff {v₁ v₂ : M} (hv₁ : v₁ ≠ 0) (hv₂ : v₂ ≠ 0) :
  ray_of_ne_zero R _ hv₁ = ray_of_ne_zero R _ hv₂ ↔ same_ray R v₁ v₂ :=
quotient.eq

/-- The ray given by a positive multiple of a nonzero vector. -/
@[simp] lemma ray_pos_smul {v : M} (h : v ≠ 0) {r : R} (hr : 0 < r)
  (hrv : r • v ≠ 0) : ray_of_ne_zero R (r • v) hrv = ray_of_ne_zero R v h :=
(ray_eq_iff _ _).2 $ same_ray_pos_smul_left v hr

/-- An equivalence between modules implies an equivalence between ray vectors. -/
def ray_vector.map_linear_equiv (e : M ≃ₗ[R] N) : ray_vector R M ≃ ray_vector R N :=
equiv.subtype_equiv e.to_equiv $ λ _, e.map_ne_zero_iff.symm

/-- An equivalence between modules implies an equivalence between rays. -/
def module.ray.map (e : M ≃ₗ[R] N) : module.ray R M ≃ module.ray R N :=
quotient.congr (ray_vector.map_linear_equiv e) $ λ ⟨a, ha⟩ ⟨b, hb⟩, (same_ray_map_iff _).symm

@[simp] lemma module.ray.map_apply (e : M ≃ₗ[R] N) (v : M) (hv : v ≠ 0) :
  module.ray.map e (ray_of_ne_zero _ v hv) = ray_of_ne_zero _ (e v) (e.map_ne_zero_iff.2 hv) := rfl

@[simp] lemma module.ray.map_refl : (module.ray.map $ linear_equiv.refl R M) = equiv.refl _ :=
equiv.ext $ module.ray.ind R $ λ _ _, rfl

@[simp] lemma module.ray.map_symm (e : M ≃ₗ[R] N) :
  (module.ray.map e).symm = module.ray.map e.symm := rfl

section action
variables {G : Type*} [group G] [distrib_mul_action G M]

/-- Any invertible action preserves the non-zeroness of ray vectors. This is primarily of interest
when `G = Rˣ` -/
instance {R : Type*} : mul_action G (ray_vector R M) :=
{ smul := λ r, (subtype.map ((•) r) $ λ a, (smul_ne_zero_iff_ne _).2),
  mul_smul := λ a b m, subtype.ext $ mul_smul a b _,
  one_smul := λ m, subtype.ext $ one_smul _ _ }

variables [smul_comm_class R G M]

/-- Any invertible action preserves the non-zeroness of rays. This is primarily of interest when
`G = Rˣ` -/
instance : mul_action G (module.ray R M) :=
{ smul := λ r, quotient.map ((•) r) (λ a b h, h.smul _),
  mul_smul := λ a b, quotient.ind $ by exact(λ m, congr_arg quotient.mk $ mul_smul a b _),
  one_smul := quotient.ind $ by exact (λ m, congr_arg quotient.mk $ one_smul _ _), }

/-- The action via `linear_equiv.apply_distrib_mul_action` corresponds to `module.ray.map`. -/
@[simp] lemma module.ray.linear_equiv_smul_eq_map (e : M ≃ₗ[R] M) (v : module.ray R M) :
  e • v = module.ray.map e v := rfl

@[simp] lemma smul_ray_of_ne_zero (g : G) (v : M) (hv) :
  g • ray_of_ne_zero R v hv = ray_of_ne_zero R (g • v) ((smul_ne_zero_iff_ne _).2 hv) := rfl

end action

namespace module.ray

/-- Scaling by a positive unit is a no-op. -/
lemma units_smul_of_pos (u : Rˣ) (hu : 0 < (u : R)) (v : module.ray R M) :
  u • v = v :=
begin
  induction v using module.ray.ind,
  rw [smul_ray_of_ne_zero, ray_eq_iff],
  exact same_ray_pos_smul_left _ hu
end

/-- An arbitrary `ray_vector` giving a ray. -/
def some_ray_vector (x : module.ray R M) : ray_vector R M := quotient.out x

/-- The ray of `some_ray_vector`. -/
@[simp] lemma some_ray_vector_ray (x : module.ray R M) :
  (⟦x.some_ray_vector⟧ : module.ray R M) = x :=
quotient.out_eq _

/-- An arbitrary nonzero vector giving a ray. -/
def some_vector (x : module.ray R M) : M := x.some_ray_vector

/-- `some_vector` is nonzero. -/
@[simp] lemma some_vector_ne_zero (x : module.ray R M) : x.some_vector ≠ 0 :=
x.some_ray_vector.property

/-- The ray of `some_vector`. -/
@[simp] lemma some_vector_ray (x : module.ray R M) :
  ray_of_ne_zero R _ x.some_vector_ne_zero = x :=
(congr_arg _ (subtype.coe_eta _ _) : _).trans x.out_eq

end module.ray

end ordered_comm_semiring

section ordered_comm_ring

variables {R : Type*} [ordered_comm_ring R]
variables {M N : Type*} [add_comm_group M] [add_comm_group N] [module R M] [module R N] {x y : M}

/-- `same_ray.neg` as an `iff`. -/
@[simp] lemma same_ray_neg_iff : same_ray R (-x) (-y) ↔ same_ray R x y :=
by simp only [same_ray, neg_eq_zero, smul_neg, neg_inj]

alias same_ray_neg_iff ↔ same_ray.of_neg same_ray.neg

lemma same_ray_neg_swap : same_ray R (-x) y ↔ same_ray R x (-y) :=
by rw [← same_ray_neg_iff, neg_neg]

lemma eq_zero_of_same_ray_neg_smul_right [no_zero_smul_divisors R M] {r : R} (hr : r < 0)
  (h : same_ray R x (r • x)) :
  x = 0 :=
begin
  rcases h with rfl|h₀|⟨r₁, r₂, hr₁, hr₂, h⟩,
  { refl },
  { simpa [hr.ne] using h₀ },
  { rw [← sub_eq_zero, smul_smul, ← sub_smul, smul_eq_zero] at h,
    refine h.resolve_left (ne_of_gt $ sub_pos.2 _),
    exact (mul_neg_of_pos_of_neg hr₂ hr).trans hr₁ }
end

/-- If a vector is in the same ray as its negation, that vector is zero. -/
lemma eq_zero_of_same_ray_self_neg [no_zero_smul_divisors R M] (h : same_ray R x (-x)) :
  x = 0 :=
begin
  nontriviality M, haveI : nontrivial R := module.nontrivial R M,
  refine eq_zero_of_same_ray_neg_smul_right (neg_lt_zero.2 (@one_pos R _ _)) _,
  rwa [neg_one_smul]
end

namespace ray_vector

/-- Negating a nonzero vector. -/
instance {R : Type*} : has_neg (ray_vector R M) := ⟨λ v, ⟨-v, neg_ne_zero.2 v.prop⟩⟩

/-- Negating a nonzero vector commutes with coercion to the underlying module. -/
@[simp, norm_cast] lemma coe_neg {R : Type*} (v : ray_vector R M) : ↑(-v) = -(v : M) := rfl

/-- Negating a nonzero vector twice produces the original vector. -/
instance {R : Type*} : has_involutive_neg (ray_vector R M) :=
{ neg := has_neg.neg,
  neg_neg := λ v, by rw [subtype.ext_iff, coe_neg, coe_neg, neg_neg] }

/-- If two nonzero vectors are equivalent, so are their negations. -/
@[simp] lemma equiv_neg_iff {v₁ v₂ : ray_vector R M} : -v₁ ≈ -v₂ ↔ v₁ ≈ v₂ :=
same_ray_neg_iff

end ray_vector

variables (R)

/-- Negating a ray. -/
instance : has_neg (module.ray R M) :=
⟨quotient.map (λ v, -v) (λ v₁ v₂, ray_vector.equiv_neg_iff.2)⟩

/-- The ray given by the negation of a nonzero vector. -/
@[simp] lemma neg_ray_of_ne_zero (v : M) (h : v ≠ 0) :
  -(ray_of_ne_zero R _ h) = ray_of_ne_zero R (-v) (neg_ne_zero.2 h) :=
rfl

namespace module.ray

variables {R}

/-- Negating a ray twice produces the original ray. -/
instance : has_involutive_neg (module.ray R M) :=
{ neg := has_neg.neg,
  neg_neg := λ x, quotient.ind (λ a, congr_arg quotient.mk $ neg_neg _) x }

variables {R M}

/-- A ray does not equal its own negation. -/
lemma ne_neg_self [no_zero_smul_divisors R M] (x : module.ray R M) : x ≠ -x :=
begin
  induction x using module.ray.ind with x hx,
  rw [neg_ray_of_ne_zero, ne.def, ray_eq_iff],
  exact mt eq_zero_of_same_ray_self_neg hx
end

lemma neg_units_smul (u : Rˣ) (v : module.ray R M) : (-u) • v = - (u • v) :=
begin
  induction v using module.ray.ind,
  simp only [smul_ray_of_ne_zero, units.smul_def, units.coe_neg, neg_smul, neg_ray_of_ne_zero]
end

/-- Scaling by a negative unit is negation. -/
lemma units_smul_of_neg (u : Rˣ) (hu : (u : R) < 0) (v : module.ray R M) :
  u • v = -v :=
begin
  rw [← neg_inj, neg_neg, ← neg_units_smul, units_smul_of_pos],
  rwa [units.coe_neg, right.neg_pos_iff]
end

end module.ray

end ordered_comm_ring

section linear_ordered_comm_ring

variables {R : Type*} [linear_ordered_comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]

/-- `same_ray` follows from membership of `mul_action.orbit` for the `units.pos_subgroup`. -/
lemma same_ray_of_mem_orbit {v₁ v₂ : M} (h : v₁ ∈ mul_action.orbit (units.pos_subgroup R) v₂) :
  same_ray R v₁ v₂ :=
begin
  rcases h with ⟨⟨r, hr : 0 < (r : R)⟩, (rfl : r • v₂ = v₁)⟩,
  exact same_ray_pos_smul_left _ hr
end

/-- Scaling by an inverse unit is the same as scaling by itself. -/
@[simp] lemma units_inv_smul (u : Rˣ) (v : module.ray R M) :
  u⁻¹ • v = u • v :=
calc u⁻¹ • v = (u * u) • u⁻¹ • v :
  eq.symm $ (u⁻¹ • v).units_smul_of_pos _ $ mul_self_pos.2 u.ne_zero
... = u • v : by rw [mul_smul, smul_inv_smul]

section
variables [no_zero_smul_divisors R M]

@[simp] lemma same_ray_smul_right_iff {v : M} {r : R} :
  same_ray R v (r • v) ↔ 0 ≤ r ∨ v = 0 :=
⟨λ hrv, or_iff_not_imp_left.2 $ λ hr, eq_zero_of_same_ray_neg_smul_right (not_le.1 hr) hrv,
  or_imp_distrib.2 ⟨same_ray_nonneg_smul_right v, λ h, h.symm ▸ same_ray.zero_left _⟩⟩

/-- A nonzero vector is in the same ray as a multiple of itself if and only if that multiple
is positive. -/
lemma same_ray_smul_right_iff_of_ne {v : M} (hv : v ≠ 0) {r : R} (hr : r ≠ 0) :
  same_ray R v (r • v) ↔ 0 < r :=
by simp only [same_ray_smul_right_iff, hv, or_false, hr.symm.le_iff_lt]

@[simp] lemma same_ray_smul_left_iff {v : M} {r : R} : same_ray R (r • v) v ↔ 0 ≤ r ∨ v = 0 :=
same_ray_comm.trans same_ray_smul_right_iff

/-- A multiple of a nonzero vector is in the same ray as that vector if and only if that multiple
is positive. -/
lemma same_ray_smul_left_iff_of_ne {v : M} (hv : v ≠ 0) {r : R} (hr : r ≠ 0) :
  same_ray R (r • v) v ↔ 0 < r :=
same_ray_comm.trans (same_ray_smul_right_iff_of_ne hv hr)

@[simp] lemma same_ray_neg_smul_right_iff {v : M} {r : R} :
  same_ray R (-v) (r • v) ↔ r ≤ 0 ∨ v = 0 :=
by rw [← same_ray_neg_iff, neg_neg, ← neg_smul, same_ray_smul_right_iff, neg_nonneg]

lemma same_ray_neg_smul_right_iff_of_ne {v : M} {r : R} (hv : v ≠ 0) (hr : r ≠ 0) :
  same_ray R (-v) (r • v) ↔ r < 0 :=
by simp only [same_ray_neg_smul_right_iff, hv, or_false, hr.le_iff_lt]

@[simp] lemma same_ray_neg_smul_left_iff {v : M} {r : R} :
  same_ray R (r • v) (-v) ↔ r ≤ 0 ∨ v = 0 :=
same_ray_comm.trans same_ray_neg_smul_right_iff

lemma same_ray_neg_smul_left_iff_of_ne {v : M} {r : R} (hv : v ≠ 0) (hr : r ≠ 0) :
  same_ray R (r • v) (-v) ↔ r < 0 :=
same_ray_comm.trans $ same_ray_neg_smul_right_iff_of_ne hv hr

@[simp] lemma units_smul_eq_self_iff {u : Rˣ} {v : module.ray R M} :
  u • v = v ↔ (0 : R) < u :=
begin
  induction v using module.ray.ind with v hv,
  simp only [smul_ray_of_ne_zero, ray_eq_iff, units.smul_def,
    same_ray_smul_left_iff_of_ne hv u.ne_zero]
end

@[simp] lemma units_smul_eq_neg_iff {u : Rˣ} {v : module.ray R M} :
  u • v = -v ↔ ↑u < (0 : R) :=
by rw [← neg_inj, neg_neg, ← module.ray.neg_units_smul, units_smul_eq_self_iff, units.coe_neg,
  neg_pos]

end

end linear_ordered_comm_ring

namespace same_ray

variables {R : Type*} [linear_ordered_field R]
variables {M : Type*} [add_comm_group M] [module R M] {v₁ v₂ : M}

/-- If a vector `v₂` is on the same ray as a nonzero vector `v₁`, then it is equal to `c • v₁` for
some nonnegative `c`. -/
lemma exists_right_eq_smul (h : same_ray R v₁ v₂) (h₀ : v₁ ≠ 0) :
  ∃ c : R, 0 ≤ c ∧ v₂ = c • v₁ :=
begin
  rcases h.resolve_left h₀ with (rfl|⟨r₁, r₂, hr₁, hr₂, H⟩),
  { exact ⟨0, le_rfl, (zero_smul _ _).symm⟩ },
  { refine ⟨r₁ / r₂, div_nonneg hr₁.le hr₂.le, _⟩,
    rwa [div_eq_inv_mul, mul_smul, H, inv_smul_smul₀ hr₂.ne'] }
end

/-- If a vector `v₁` is on the same ray as a nonzero vector `v₂`, then it is equal to `c • v₂` for
some nonnegative `c`. -/
lemma exists_left_eq_smul (h : same_ray R v₁ v₂) (h₀ : v₂ ≠ 0) :
  ∃ c : R, 0 ≤ c ∧ v₁ = c • v₂ :=
h.symm.exists_right_eq_smul h₀

/-- If vectors `v₁` and `v₂` are on the same ray, then for some nonnegative `a b`, `a + b = 1`, we
have `v₁ = a • (v₁ + v₂)` and `v₂ = b • (v₁ + v₂)`. -/
lemma exists_eq_smul_add (h : same_ray R v₁ v₂) :
  ∃ a b : R, 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ v₁ = a • (v₁ + v₂) ∧ v₂ = b • (v₁ + v₂) :=
begin
  rcases h with rfl|rfl|⟨r₁, r₂, h₁, h₂, H⟩,
  { use [0, 1], simp },
  { use [1, 0], simp },
  { have h₁₂ : 0 < r₁ + r₂, from add_pos h₁ h₂,
    refine ⟨r₂ / (r₁ + r₂), r₁ / (r₁ + r₂), div_nonneg h₂.le h₁₂.le, div_nonneg h₁.le h₁₂.le,
      _, _, _⟩,
    { rw [← add_div, add_comm, div_self h₁₂.ne'] },
    { rw [div_eq_inv_mul, mul_smul, smul_add, ← H, ← add_smul, add_comm r₂,
        inv_smul_smul₀ h₁₂.ne'] },
    { rw [div_eq_inv_mul, mul_smul, smul_add, H, ← add_smul, add_comm r₂,
        inv_smul_smul₀ h₁₂.ne'] } }
end

/-- If vectors `v₁` and `v₂` are on the same ray, then they are nonnegative multiples of the same
vector. Actually, this vector can be assumed to be `v₁ + v₂`, see `same_ray.exists_eq_smul_add`. -/
lemma exists_eq_smul (h : same_ray R v₁ v₂) :
  ∃ (u : M) (a b : R), 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ v₁ = a • u ∧ v₂ = b • u :=
⟨v₁ + v₂, h.exists_eq_smul_add⟩

end same_ray


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Two sets are equinumerous, or equipollent, if there is a bijection between them. It is sometimes
said that two such sets "have the same cardinality."
-/
import .classical_inverse data.nat
open eq.ops classical nat

/- two versions of Cantor's theorem -/

namespace set

variables {X : Type} {A : set X}

theorem not_surj_on_pow (f : X → set X) : ¬ surj_on f A (𝒫 A) :=
let diag := {x ∈ A | x ∉ f x} in
have diag ⊆ A, from sep_subset _ _,
assume H : surj_on f A (𝒫 A),
obtain x [(xA : x ∈ A) (Hx : f x = diag)], from H `diag ⊆ A`,
have x ∉ f x, from
  suppose x ∈ f x,
  have x ∈ diag, from Hx ▸ this,
  have x ∉ f x, from and.right this,
  show false, from this `x ∈ f x`,
have x ∈ diag, from and.intro xA this,
have x ∈ f x, from Hx⁻¹ ▸ this,
show false, from `x ∉ f x` this

theorem not_inj_on_pow {f : set X → X} (H : maps_to f (𝒫 A) A) : ¬ inj_on f (𝒫 A) :=
let diag := f ' {x ∈ 𝒫 A | f x ∉ x} in
have diag ⊆ A, from image_subset_of_maps_to_of_subset H (sep_subset _ _),
assume H₁ : inj_on f (𝒫 A),
have f diag ∈ diag, from by_contradiction
  (suppose f diag ∉ diag,
    have diag ∈ {x ∈ 𝒫 A | f x ∉ x}, from and.intro `diag ⊆ A` this,
    have f diag ∈ diag, from mem_image_of_mem f this,
    show false, from `f diag ∉ diag` this),
obtain x [(Hx : x ∈ 𝒫 A ∧ f x ∉ x) (fxeq : f x = f diag)], from this,
have x = diag, from H₁ (and.left Hx) `diag ⊆ A` fxeq,
have f diag ∉ diag, from this ▸ and.right Hx,
show false, from this `f diag ∈ diag`

end set

/-
The Schröder-Bernstein theorem. The proof below is nonconstructive, in three ways:
(1) We need a left inverse to g (we could get around this by supplying one).
(2) The definition of h below assumes that membership in Union U is decidable.
(3) We ultimately case split on whether B is empty, and choose an element if it isn't.

Rather than mark every auxiliary construction as "private", we put them all in a
separate namespace.
-/

namespace schroeder_bernstein
section
open set
  parameters {X Y : Type}
  parameter  {A : set X}
  parameter  {B : set Y}
  parameter  {f : X → Y}
  parameter  (f_maps_to : maps_to f A B)
  parameter  (finj : inj_on f A)
  parameter  {g : Y → X}
  parameter  (g_maps_to : maps_to g B A)
  parameter  (ginj : inj_on g B)
  parameter  {dflt : Y}                    -- for now, assume B is nonempty
  parameter  (dfltB : dflt ∈ B)

  /- g⁻¹ : A → B -/

  noncomputable definition ginv : X → Y := inv_fun g B dflt

  lemma ginv_maps_to : maps_to ginv A B :=
  maps_to_inv_fun dfltB

  lemma ginv_g_eq {b : Y} (bB : b ∈ B) : ginv (g b) = b :=
  left_inv_on_inv_fun_of_inj_on dflt ginj bB

  /- define a sequence of sets U -/

  definition U : ℕ → set X
  | U 0       := A \ (g ' B)
  | U (n + 1) := g ' (f ' (U n))

  lemma U_subset_A : ∀ n, U n ⊆ A
  | 0       := show U 0 ⊆ A,
                 from diff_subset _ _
  | (n + 1) := have f ' (U n) ⊆ B,
                 from image_subset_of_maps_to_of_subset f_maps_to (U_subset_A n),
               show U (n + 1) ⊆ A,
                 from image_subset_of_maps_to_of_subset g_maps_to this

  lemma g_ginv_eq {a : X} (aA : a ∈ A) (anU  : a ∉ Union U) : g (ginv a) = a :=
  using ginj,
  have a ∈ g ' B, from by_contradiction
    (suppose a ∉ g ' B,
      have a ∈ U 0, from and.intro aA this,
      have a ∈ Union U, from exists.intro 0 this,
      show false, from anU this),
  obtain b [(bB : b ∈ B) (gbeq : g b = a)], from this,
  calc
    g (ginv a) = g (ginv (g b)) : gbeq
           ... = g b            : ginv_g_eq bB
           ... = a              : gbeq

  /- h : A → B -/

  noncomputable definition h x := if x ∈ Union U then f x else ginv x

  lemma h_maps_to : maps_to h A B :=
  using f_maps_to dfltB,
  take a,
  suppose a ∈ A,
  show h a ∈ B, from
    by_cases
      (suppose a ∈ Union U,
        begin rewrite [↑h, if_pos this], exact f_maps_to `a ∈ A` end)
      (suppose a ∉ Union U,
        begin rewrite [↑h, if_neg this], exact ginv_maps_to `a ∈ A` end)

  /- h is injective -/

  lemma aux {a₁ a₂ : X} (H₁ : a₁ ∈ Union U) (a₂A : a₂ ∈ A) (heq : h a₁ = h a₂) : a₂ ∈ Union U :=
  using ginj,
  obtain n (a₁Un : a₁ ∈ U n), from H₁,
  have ha₁eq : h a₁ = f a₁,
    from dif_pos H₁,
  show a₂ ∈ Union U, from by_contradiction
    (suppose a₂ ∉ Union U,
      have ha₂eq : h a₂ = ginv a₂,
        from dif_neg this,
      have g (f a₁) = a₂, from calc
        g (f a₁) = g (h a₁)       : ha₁eq
             ... = g (h a₂)       : heq
             ... = g (ginv a₂)    : ha₂eq
             ... = a₂             : g_ginv_eq a₂A `a₂ ∉ Union U`,
      have g (f a₁) ∈ g ' (f ' (U n)),
        from mem_image_of_mem g (mem_image_of_mem f a₁Un),
      have a₂ ∈ U (n + 1),
        from `g (f a₁) = a₂` ▸ this,
      have a₂ ∈ Union U,
        from exists.intro _ this,
      show false, from `a₂ ∉ Union U` `a₂ ∈ Union U`)

  lemma h_inj : inj_on h A :=
  take a₁ a₂,
  suppose a₁ ∈ A,
  suppose a₂ ∈ A,
  assume heq : h a₁ = h a₂,
  show a₁ = a₂, from
  by_cases
    (assume a₁UU : a₁ ∈ Union U,
      have a₂UU : a₂ ∈ Union U,
        from aux a₁UU `a₂ ∈ A` heq,
      have f a₁ = f a₂, from calc
        f a₁ = h a₁ : dif_pos a₁UU
          ... = h a₂ : heq
          ... = f a₂ : dif_pos a₂UU,
      show a₁ = a₂, from
        finj `a₁ ∈ A` `a₂ ∈ A` this)
    (assume a₁nUU : a₁ ∉ Union U,
      have a₂nUU : a₂ ∉ Union U,
        from assume H, a₁nUU (aux H `a₁ ∈ A` heq⁻¹),
      have eq₁ : g (ginv a₁) = a₁, from g_ginv_eq `a₁ ∈ A` a₁nUU,
      have eq₂ : g (ginv a₂) = a₂, from g_ginv_eq `a₂ ∈ A` a₂nUU,
      have ginv a₁ = ginv a₂, from calc
        ginv a₁ = h a₁ : dif_neg a₁nUU
            ... = h a₂ : heq
            ... = ginv a₂ : dif_neg a₂nUU,
      show a₁ = a₂, from calc
        a₁    = g (ginv a₁) : eq₁ -- g_ginv_eq `a₁ ∈ A` a₁nUU
          ... = g (ginv a₂) : this
          ... = a₂          : eq₂) -- g_ginv_eq `a₂ ∈ A` a₂nUU)

  /- h is surjective -/

  lemma h_surj : surj_on h A B :=
  take b,
  suppose b ∈ B,
  using f_maps_to,
  by_cases
    (suppose g b ∈ Union U,
       obtain n (gbUn : g b ∈ U n), from this,
      begin
        cases n with n,
          {have g b ∈ U 0, from gbUn,
            have g b ∉ g ' B, from and.right this,
            have g b ∈ g ' B, from mem_image_of_mem g `b ∈ B`,
            show b ∈ h ' A,   from absurd `g b ∈ g ' B` `g b ∉ g ' B`},
        {have g b ∈ U (succ n), from gbUn,
           have g b ∈ g ' (f ' (U n)), from this,
           obtain b' [(b'fUn : b' ∈ f ' (U n)) (geq : g b' = g b)], from this,
           obtain a [(aUn : a ∈ U n) (faeq : f a = b')], from b'fUn,
           have g (f a) = g b, by rewrite [faeq, geq],
           have a ∈ A, from U_subset_A n aUn,
           have f a ∈ B, from f_maps_to this,
           have f a = b, from ginj `f a ∈ B` `b ∈ B` `g (f a) = g b`,
           have a ∈ Union U, from exists.intro n aUn,
           have h a = f a, from dif_pos this,
           show b ∈ h ' A, from mem_image `a ∈ A` (`h a = f a` ⬝ `f a = b`)}
      end)
    (suppose g b ∉ Union U,
      have eq₁ : h (g b) = ginv (g b), from dif_neg this,
      have eq₂ : ginv (g b) = b, from ginv_g_eq `b ∈ B`,
      have g b ∈ A, from g_maps_to `b ∈ B`,
      show b ∈ h ' A, from mem_image `g b ∈ A` (eq₁ ⬝ eq₂))
end
end schroeder_bernstein

namespace set
section
  parameters {X Y : Type}
  parameter  {A : set X}
  parameter  {B : set Y}
  parameter  {f : X → Y}
  parameter  (f_maps_to : maps_to f A B)
  parameter  (finj : inj_on f A)
  parameter  {g : Y → X}
  parameter  (g_maps_to : maps_to g B A)
  parameter  (ginj : inj_on g B)

  include g g_maps_to ginj
  theorem schroeder_bernstein : ∃ h, bij_on h A B :=
  by_cases
    (assume H : ∀ b, b ∉ B,
      have fsurj : surj_on f A B, from take b, suppose b ∈ B, absurd this !H,
      exists.intro f (and.intro f_maps_to (and.intro finj fsurj)))
    (assume H : ¬ ∀ b, b ∉ B,
      have ∃ b, b ∈ B, from exists_of_not_forall_not H,
      obtain b bB, from this,
      let h := @schroeder_bernstein.h X Y A B f g b in
      have h_maps_to : maps_to h A B, from schroeder_bernstein.h_maps_to f_maps_to bB,
      have hinj : inj_on h A, from schroeder_bernstein.h_inj finj ginj, -- ginj,
      have hsurj : surj_on h A B, from schroeder_bernstein.h_surj f_maps_to g_maps_to ginj,
      exists.intro h (and.intro h_maps_to (and.intro hinj hsurj)))
end
end set


import algebra.group_power data.complex.basic group_theory.coset

universes u v w x
variables {G : Type u} {G₂ : Type v} {G₃ : Type w} {G₄ : Type x}
variables [group G] [comm_group G₂] [add_group G₃] [add_comm_group G₄]

-- sheet 4

-- 4. Let S be the two-element set {a, b}. Show that there are precisely 16 distinct binary operations on S. How many of them make S a group? Find a formula for the total number of binary operations on a set of n elements.
--def S' := {}
--theorem sheet04_q4:

-- 5. Prove that multiplication of ℂ numbers is associative.

theorem sheet04_q05 (z z₁ z₂ : ℂ) : z * z₁ * z₂ = z * (z₁ * z₂) := by apply mul_assoc z z₁ z₂

-- 6. Which of the following are groups? Prove one, delete another.
--(a)
--theorem sheet04_q6a_is_T:
--theorem sheet04_q6a_is_F:

-- Let S be the set of all real numbers except −1. For a, b ∈ S define a ∗ b = ab + a + b. Show that (S, ∗) is a group.
def s := {x : ℝ | x ≠ -1}

def op (m n : s) [has_add s] [has_mul s] : s := ⟨m * n + m + n, sorry⟩ -- want to prove that this operation is from s to s to s rather than s to s to ℝ

local notation m ~ n := op m n

--def Is_group {G:Type} (g:set G) (op: g → g → g): Prop := (∀ (x y z ∈ g), op (op x y) z = op x (op y z)) ∧
--(∃ i ∈ g , (∀x ∈ g,op x i = x ∧ op i x = x) ∧ (∀ x ∈ g, ∃ xin:G, op x xin =i ∧ op xin x =i))

--theorem q7: Is_group s ~ := sorry

--theorem q7 (a b : set s)

-- 8. Let G be a group, and let a, b, c ∈ G. Prove the following facts.
--(a) If ab=ac then b=c.
theorem sheet04_q8a (a b c : G) : a * b = a * c ↔ b = c := by apply mul_left_inj a

--(b) The equation axb = c has a unique solution for x ∈ G.
theorem sheet04_q8b (a b c : G) : ∃! x : G, a * x * b = c :=
begin
intros,
existsi (a⁻¹ * c * b⁻¹),
simp [mul_assoc],
assume y h,
rw ← h,
simp [mul_assoc],
end
--(c) (a^{−1})^{−1} = a.
theorem sheet04_q8c (a : G) : a⁻¹⁻¹ = a := by apply inv_inv a
--(d) (ab)^{−1} = b^{-1}a^{−1}.
theorem sheet04_q8d (a b : G) : (a*b)⁻¹ = b⁻¹*a⁻¹ := by apply mul_inv_rev a b
-- 9. Let G be a group, and let e be the identity of G. Suppose that x∗x=e for all x∈G. Show that y ∗ z = z ∗ y for all y, z ∈ G.
theorem sheet04_q9 (y z : G) (hp : ∀x : G, x*x = 1) : y * z = z * y := sorry


import MyNat.Definition
namespace MyNat
open MyNat

/-!
# Function World

## Level 1: the `exact` tactic.

Given an element of `P` and a function from `P` to `Q`,
we define an element of `Q`.
-/
example (P Q : Type) (p : P) (h : P → Q) : Q := by
  exact h p

/-!
Note that `example` is just like a `theorem` or a `lemma`
except it has no name.

If you place your cursor at the end of the `example` line above
the tactic state will look like this:

```
P Q : Type,
p : P,
h : P → Q
⊢ Q
```

In this situation, we have sets `P` and `Q` (but Lean calls them types),
and an element `p` of `P` (written `p : P`
but meaning `p ∈ P`). We also have a function `h` from `P` to `Q`,
and our goal is to construct an
element of the set `Q`. It's clear what to do *mathematically* to solve
this goal -- we can
make an element of `Q` by applying the function `h` to
the element `p`. But how to do it in Lean? There are at least two ways
to explain this idea to Lean,
and here we will learn about one of them, namely the method which
uses the `exact` tactic.

## The `exact` tactic.

If you can explicitly see how to make an element of your goal set,
i.e. you have a formula for it, then you can just write `exact <formula>`
and this will close the goal.

So given that the function application `h p` is an element of `Q` so you can just write
`exact h p` to close the goal.

## Important note

Note that `exact h P` won't work (with a capital `P`);
this is a common error for beginners.
`P` is not an element of `P`, it's `p` that is an element of `P`.

## Summary

If the goal is `⊢ X` then `exact x` will close the goal if
and only if `x` is a term of type `X`.

## Details

Say `P`, `Q` and `R` are types (i.e., what a mathematician
might think of as either sets or propositions),
and the local context looks like this:

```
p : P,
h : P → Q,
j : Q → R
⊢ R
```

If you can spot how to make a term of type `R`, then you
can just make it and say you're done using the `exact` tactic
together with the formula you have spotted. For example the
above goal could be solved with

`exact j (h p)`

because `j (h p)` is easily checked to be a term of type `R`
(i.e., an element of the set `R`, or a proof of the proposition `R`).

Next up [Level 2](./Level2.lean.md)
-/


/-
Copyright (c) 2021 Henry Swanson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henry Swanson
-/
import combinatorics.derangements.basic
import data.fintype.card
import tactic.delta_instance
import tactic.ring

/-!
# Derangements on fintypes

This file contains lemmas that describe the cardinality of `derangements α` when `α` is a fintype.

# Main definitions

* `card_derangements_invariant`: A lemma stating that the number of derangements on a type `α`
    depends only on the cardinality of `α`.
* `num_derangements n`: The number of derangements on an n-element set, defined in a computation-
    friendly way.
* `card_derangements_eq_num_derangements`: Proof that `num_derangements` really does compute the
    number of derangements.
* `num_derangements_sum`: A lemma giving an expression for `num_derangements n` in terms of
    factorials.
-/

open derangements equiv fintype
open_locale big_operators

variables {α : Type*} [decidable_eq α] [fintype α]

instance : decidable_pred (derangements α) := λ _, fintype.decidable_forall_fintype

instance : fintype (derangements α) := by delta_instance derangements

lemma card_derangements_invariant {α β : Type*} [fintype α] [decidable_eq α]
  [fintype β] [decidable_eq β] (h : card α = card β) :
  card (derangements α) = card (derangements β) :=
fintype.card_congr (equiv.derangements_congr $ equiv_of_card_eq h)

lemma card_derangements_fin_add_two (n : ℕ) :
  card (derangements (fin (n+2))) = (n+1) * card (derangements (fin n)) +
  (n+1) * card (derangements (fin (n+1))) :=
begin
  -- get some basic results about the size of fin (n+1) plus or minus an element
  have h1 : ∀ a : fin (n+1), card ({a}ᶜ : set (fin (n+1))) = card (fin n),
  { intro a,
    simp only [fintype.card_fin, finset.card_fin, fintype.card_of_finset, finset.filter_ne' _ a,
      set.mem_compl_singleton_iff, finset.card_erase_of_mem (finset.mem_univ a), nat.pred_succ] },
  have h2 : card (fin (n+2)) = card (option (fin (n+1))),
  { simp only [card_fin, card_option] },
  -- rewrite the LHS and substitute in our fintype-level equivalence
  simp only [card_derangements_invariant h2,
    card_congr (@derangements_recursion_equiv (fin (n+1)) _),
  -- push the cardinality through the Σ and ⊕ so that we can use `card_n`
    card_sigma, card_sum, card_derangements_invariant (h1 _), finset.sum_const, nsmul_eq_mul,
    finset.card_fin, mul_add, nat.cast_id],
end

/-- The number of derangements of an `n`-element set. -/
def num_derangements : ℕ → ℕ
| 0 := 1
| 1 := 0
| (n + 2) := (n + 1) * (num_derangements n + num_derangements (n+1))

@[simp] lemma num_derangements_zero : num_derangements 0 = 1 := rfl

@[simp] lemma num_derangements_one : num_derangements 1 = 0 := rfl

lemma num_derangements_add_two (n : ℕ) :
  num_derangements (n+2) = (n+1) * (num_derangements n + num_derangements (n+1)) := rfl

lemma num_derangements_succ (n : ℕ) :
  (num_derangements (n+1) : ℤ) = (n + 1) * (num_derangements n : ℤ) - (-1)^n :=
begin
  induction n with n hn,
  { refl },
  { simp only [num_derangements_add_two, hn, pow_succ,
      int.coe_nat_mul, int.coe_nat_add, int.coe_nat_succ],
    ring }
end

lemma card_derangements_fin_eq_num_derangements {n : ℕ} :
  card (derangements (fin n)) = num_derangements n :=
begin
  induction n using nat.strong_induction_on with n hyp,
  obtain (_|_|n) := n, { refl }, { refl },  -- knock out cases 0 and 1
  -- now we have n ≥ 2. rewrite everything in terms of card_derangements, so that we can use
  -- `card_derangements_fin_add_two`
  rw [num_derangements_add_two, card_derangements_fin_add_two, mul_add,
    hyp _ (nat.lt_add_of_pos_right zero_lt_two), hyp _ (lt_add_one _)],
end

lemma card_derangements_eq_num_derangements (α : Type*) [fintype α] [decidable_eq α] :
  card (derangements α) = num_derangements (card α) :=
begin
  rw ←card_derangements_invariant (card_fin _),
  exact card_derangements_fin_eq_num_derangements,
end

theorem num_derangements_sum (n : ℕ) :
  (num_derangements n : ℤ) = ∑ k in finset.range (n + 1), (-1:ℤ)^k * nat.asc_factorial k (n - k) :=
begin
  induction n with n hn, { refl },
  rw [finset.sum_range_succ, num_derangements_succ, hn, finset.mul_sum, tsub_self,
    nat.asc_factorial_zero, int.coe_nat_one, mul_one, pow_succ, neg_one_mul, sub_eq_add_neg,
    add_left_inj, finset.sum_congr rfl],
  -- show that (n + 1) * (-1)^x * asc_fac x (n - x) = (-1)^x * asc_fac x (n.succ - x)
  intros x hx,
  have h_le : x ≤ n := finset.mem_range_succ_iff.mp hx,
  rw [nat.succ_sub h_le, nat.asc_factorial_succ, add_tsub_cancel_of_le h_le,
    int.coe_nat_mul, int.coe_nat_succ, mul_left_comm],
end


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import data.nat.basic
import data.nat.prime

open nat

/-!
# IMO 2003 Q6
Let p be a prime number. Prove that there exists a prime number q such that for every natural n,
the number n^p - p is not divisible by q.

# Solution
TODO
-/

theorem imo2003_q6 (p : ℕ) (hp : prime p) : ∃ q : ℕ, prime q ∧ ∀ n : ℕ, ¬ (q ∣ n^p - p) :=
begin
  sorry,
end


import Lean

open Lean
open Lean.Meta
open Lean.Elab.Tactic

universe u
axiom elimEx (motive : Nat → Nat → Sort u) (x y : Nat)
  (diag  : (a : Nat) → motive a a)
  (upper : (delta a : Nat) → motive a (a + delta.succ))
  (lower : (delta a : Nat) → motive (a + delta.succ) a)
  : motive y x

theorem ex1 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx with
  | diag    => apply Or.inl; apply Nat.le_refl
  | lower d => apply Or.inl; show p ≤ p + d.succ; admit
  | upper d => apply Or.inr; show q + d.succ > q; admit

theorem ex2 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx
  case lower => admit
  case upper => admit
  case diag  => apply Or.inl; apply Nat.le_refl

axiom Nat.parityElim (motive : Nat → Sort u)
  (even : (n : Nat) → motive (2*n))
  (odd  : (n : Nat) → motive (2*n+1))
  (n : Nat)
  : motive n

theorem time2Eq (n : Nat) : 2*n = n + n := by
  rw [Nat.mul_comm]
  show (0 + n) + n = n+n
  simp

theorem ex3 (n : Nat) : Exists (fun m => n = m + m ∨ n = m + m + 1) := by
  cases n using Nat.parityElim with
  | even i =>
    apply Exists.intro i
    apply Or.inl
    rw [time2Eq]
  | odd i =>
    apply Exists.intro i
    apply Or.inr
    rw [time2Eq]

open Nat in
theorem ex3b (n : Nat) : Exists (fun m => n = m + m ∨ n = m + m + 1) := by
  cases n using parityElim with
  | even i =>
    apply Exists.intro i
    apply Or.inl
    rw [time2Eq]
  | odd i =>
    apply Exists.intro i
    apply Or.inr
    rw [time2Eq]

def ex4 {α} (xs : List α) (h : xs = [] → False) : α := by
  cases he:xs with
  | nil      => contradiction
  | cons x _ => exact x

def ex5 {α} (xs : List α) (h : xs = [] → False) : α := by
  cases he:xs using List.casesOn with
  | nil      => contradiction
  | cons x _ => exact x

theorem ex6 {α} (f : List α → Bool) (h₁ : {xs : List α} → f xs = true → xs = []) (xs : List α) (h₂ : xs ≠ []) : f xs = false :=
  match he:f xs with
  | true  => False.elim (h₂ (h₁ he))
  | false => rfl

theorem ex7 {α} (f : List α → Bool) (h₁ : {xs : List α} → f xs = true → xs = []) (xs : List α) (h₂ : xs ≠ []) : f xs = false := by
  cases he:f xs with
  | true  => exact False.elim (h₂ (h₁ he))
  | false => rfl

theorem ex8 {α} (f : List α → Bool) (h₁ : {xs : List α} → f xs = true → xs = []) (xs : List α) (h₂ : xs ≠ []) : f xs = false := by
  cases he:f xs using Bool.casesOn with
  | true  => exact False.elim (h₂ (h₁ he))
  | false => rfl

theorem ex9 (xs : List α) (h : xs = [] → False) : Nonempty α := by
  cases xs using List.rec with
  | nil      => contradiction
  | cons x _ => apply Nonempty.intro; assumption

theorem modLt (x : Nat) {y : Nat} (h : y > 0) : x % y < y := by
  induction x, y using Nat.mod.inductionOn with
  | ind x y h₁ ih =>
    rw [Nat.mod_eq_sub_mod h₁.2]
    exact ih h
  | base x y h₁ =>
    match Iff.mp (Decidable.not_and_iff_or_not ..) h₁ with
    | Or.inl h₁ => contradiction
    | Or.inr h₁ =>
      have hgt := Nat.gt_of_not_le h₁
      have heq := Nat.mod_eq_of_lt hgt
      rw [← heq] at hgt
      assumption

theorem ex11 {p q : Prop } (h : p ∨ q) : q ∨ p := by
  induction h using Or.casesOn with
  | inr h  => ?myright
  | inl h  => ?myleft
  case myleft  => exact Or.inr h
  case myright => exact Or.inl h

theorem ex12 {p q : Prop } (h : p ∨ q) : q ∨ p := by
  cases h using Or.casesOn with
  | inr h  => ?myright
  | inl h  => ?myleft
  case myleft  => exact Or.inr h
  case myright => exact Or.inl h

theorem ex13 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx with
  | diag    => ?hdiag
  | lower d => ?hlower
  | upper d => ?hupper
  case hdiag  => apply Or.inl; apply Nat.le_refl
  case hlower => apply Or.inl; show p ≤ p + d.succ; admit
  case hupper => apply Or.inr; show q + d.succ > q; admit

theorem ex14 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx with
  | diag    => ?hdiag
  | lower d => _
  | upper d => ?hupper
  case hdiag  => apply Or.inl; apply Nat.le_refl
  case lower => apply Or.inl; show p ≤ p + d.succ; admit
  case hupper => apply Or.inr; show q + d.succ > q; admit

theorem ex15 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx with
  | diag    => ?hdiag
  | lower d => _
  | upper d => ?hupper
  { apply Or.inl; apply Nat.le_refl }
  { apply Or.inl; show p ≤ p + d.succ; admit }
  { apply Or.inr; show q + d.succ > q; admit }

theorem ex16 {p q : Prop} (h : p ∨ q) : q ∨ p := by
  induction h
  case inl h' => exact Or.inr h'
  case inr h' => exact Or.inl h'

theorem ex17 (n : Nat) : 0 + n = n := by
  induction n
  case zero => rfl
  case succ m ih =>
    show Nat.succ (0 + m) = Nat.succ m
    rw [ih]


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

 If J is a finite set then the sum of (-1)^{|K|} over subsets K ⊆ J
 is usually zero, except that the sum is one if J is empty.

 We will prove two versions of this, one where J is a finset in an
 arbitrary type I, and one where J is the universal set in a fintype I.

 A key point is as follows: if we take J' = (insert a J) = J ∪ {a},
 then the subsets of J can be split into those that contain a and those
 that do not, and these two families are in bijection.  Equivalently,
 we have a bijection P(J') ≃ P(J) × bool (where bool is a set with
 two elements).  We construct this bijection as
 `finset.insert.powerset_filter`.
-/

import data.fintype.basic algebra.big_operators
import algebra.prod_equiv

namespace finset
open finset

universe u

variables {I : Type u} [decidable_eq I]

def card_sign (K : finset I) : ℤ := (-1) ^ K.card
def card_sign_sum (J : finset I) := J.powerset.sum (card_sign : finset I → ℤ)

section insert

variables {i : I} {J : finset I} (hiJ : i ∉ J)
include hiJ

example (n : ℤ) : n * (-1) = - n := by library_search

lemma insert.card_sign :
 card_sign (insert i J) = - card_sign J :=
 by {dsimp[card_sign],
     rw[card_insert_of_not_mem hiJ,pow_add,pow_one,mul_neg_one] }

lemma subset_iff_subset_insert (K : finset I) :
 K ⊆ J ↔ K ⊆ (insert i J) ∧ i ∉ K :=
begin
 split,
 {exact λ hKJ,⟨subset.trans hKJ (subset_insert i J),λ i_in_K,hiJ (hKJ i_in_K)⟩},
 {rintros ⟨hKiJ,hi⟩ a ha,
  rcases mem_insert.mp (hKiJ ha) with a_eq_i | a_in_J,
  {exact (hi (a_eq_i ▸ ha)).elim},{exact a_in_J}
 }
end

lemma insert.powerset_filter :
 (insert i J).powerset.filter (λ K, i ∉ K) = J.powerset := by {
  ext K,rw[mem_filter,mem_powerset,mem_powerset,subset_iff_subset_insert hiJ],
 }

def insert.powerset_equiv :
 { K // K ∈ (insert i J).powerset} ≃ ({K // K ∈ J.powerset} × bool) := {
 to_fun := λ K, ⟨⟨K.val ∩ J,mem_powerset.mpr (inter_subset_right K.val J)⟩,
                 if i ∈ K.val then tt else ff⟩,
 inv_fun := λ Kb, cond Kb.2
  ⟨insert i Kb.1.val,
   mem_powerset.mpr (insert_subset_insert i (mem_powerset.mp Kb.1.property))⟩
  ⟨Kb.1.val,
   mem_powerset.mpr (subset.trans (mem_powerset.mp Kb.1.property) (subset_insert i J))⟩,
 left_inv := λ ⟨K,hK⟩,
 begin
  let hK' := mem_powerset.mp hK,
  apply subtype.eq,ext a,simp only [],split_ifs,
  {rw[cond,mem_insert,mem_inter],
   split,
   {rintro (a_eq_i | h2),exact a_eq_i.symm.subst h,exact h2.left},
   {intro a_in_K,
    rcases mem_insert.mp (hK' a_in_K) with a_eq_i | a_in_J,
    {exact or.inl a_eq_i},
    {exact or.inr ⟨a_in_K,a_in_J⟩}
   }
  },{
   rw[cond,mem_inter],
   split,
   {exact λ h,h.1},
   {intro a_in_K,
    exact ⟨a_in_K,((subset_iff_subset_insert hiJ K).mpr ⟨hK',h⟩) a_in_K⟩,
   }
  }
 end,
 right_inv := λ ⟨⟨K,hK⟩,b⟩,
 begin
  let hK' := mem_powerset.mp hK,
  have hiK : i ∉ K := λ h, hiJ (hK' h),
  cases b; simp only[cond],
  {rw[if_neg hiK],congr,ext a,rw[mem_inter],
   exact ⟨λ h,h.1,λ h,⟨h,hK' h⟩⟩,
  },{
   rw[if_pos (mem_insert_self i K)],congr,ext a,rw[mem_inter,mem_insert],
   split,
   {rintro ⟨a_eq_i | a_in_K,a_in_J⟩,
    {exact (hiJ (a_eq_i ▸ a_in_J)).elim,},
    {exact a_in_K}
   },{
    intro a_in_K,
    exact ⟨or.inr a_in_K,hK' a_in_K⟩
   }
  }
 end
}

lemma card_sign_sum_insert : card_sign_sum (insert i J) = 0 :=
begin
 let e := (insert.powerset_equiv hiJ).symm,
 rw[card_sign_sum,sum_eq_univ_sum],
 rw[← univ_sum_equiv e (λ K,card_sign K.val)],
 let g : {K // K ∈ J.powerset} → bool → ℤ :=
  λ K b, cond b (- (card_sign K.val)) (card_sign K.val),
 have eg : ∀ K, (@univ bool _).sum (g K) = 0 :=
  λ K, by {rw[sum_over_bool],dsimp[g],rw[add_neg_self]},
 have : (λ (K : {K // K ∈ powerset (insert i J)}), (card_sign K.val)) ∘ e.to_fun =
        λ Kb, g Kb.1 Kb.2 :=
  by {ext Kb,rcases Kb with ⟨⟨K,hK⟩,ff | tt⟩,
   {refl},
   {have : i ∉ K := λ h, hiJ ((mem_powerset.mp hK) h),
    exact insert.card_sign this}
  },
 rw[this,sum_univ_product,sum_congr rfl (λ K _,eg K),sum_const_zero],
end

end insert

#check finset.nonempty
lemma card_sign_sum_eq (J : finset I) : card_sign_sum J = if J = ∅ then 1 else 0 :=
begin
 split_ifs with h,
 {rw[h],refl},
 { rcases (nonempty_of_ne_empty h) with ⟨a,a_in_J⟩,
  rw[← insert_erase a_in_J,card_sign_sum_insert (not_mem_erase a J)],
 }
end

end finset

namespace fintype
open finset

lemma card_sign_sum_eq (I : Type*) [decidable_eq I] [fintype I] :
 (@univ I _).powerset.sum card_sign = if (card I = 0) then 1 else 0 :=
begin
 change (@univ I _).card_sign_sum  = if (card I = 0) then 1 else 0,
 let h := @finset.card_eq_zero I univ,
 rw[finset.card_sign_sum_eq,← card_univ],
 by_cases hu : (@univ I _).card = 0,
 rw[if_pos hu,if_pos (h.mp hu)],
 rw[if_neg hu,if_neg (hu ∘ h.mpr)],
end

end fintype


/-
Copyright (c) 2022 Jake Levinson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jake Levinson
-/
import order.upper_lower.basic
import data.finset.preimage

/-!
# Young diagrams

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

A Young diagram is a finite set of up-left justified boxes:

```text
□□□□□
□□□
□□□
□
```
This Young diagram corresponds to the [5, 3, 3, 1] partition of 12.

We represent it as a lower set in `ℕ × ℕ` in the product partial order. We write `(i, j) ∈ μ`
to say that `(i, j)` (in matrix coordinates) is in the Young diagram `μ`.

## Main definitions

- `young_diagram` : Young diagrams
- `young_diagram.card` : the number of cells in a Young diagram (its *cardinality*)
- `young_diagram.distrib_lattice` : a distributive lattice instance for Young diagrams
  ordered by containment, with `(⊥ : young_diagram)` the empty diagram.
- `young_diagram.row` and `young_diagram.row_len`: rows of a Young diagram and their lengths
- `young_diagram.col` and `young_diagram.col_len`: columns of a Young diagram and their lengths

## Notation

In "English notation", a Young diagram is drawn so that (i1, j1) ≤ (i2, j2)
means (i1, j1) is weakly up-and-left of (i2, j2). This terminology is used
below, e.g. in `young_diagram.up_left_mem`.

## Tags

Young diagram

## References

<https://en.wikipedia.org/wiki/Young_tableau>

-/

open function

/-- A Young diagram is a finite collection of cells on the `ℕ × ℕ` grid such that whenever
a cell is present, so are all the ones above and to the left of it. Like matrices, an `(i, j)` cell
is a cell in row `i` and column `j`, where rows are enumerated downward and columns rightward.

Young diagrams are modeled as finite sets in `ℕ × ℕ` that are lower sets with respect to the
standard order on products. -/
@[ext] structure young_diagram :=
(cells : finset (ℕ × ℕ))
(is_lower_set : is_lower_set (cells : set (ℕ × ℕ)))

namespace young_diagram

instance : set_like young_diagram (ℕ × ℕ) :=
{ coe            := coe young_diagram.cells,
  coe_injective' := λ μ ν h, by { rwa [young_diagram.ext_iff, ← finset.coe_inj] } }

@[simp] lemma mem_cells {μ : young_diagram} (c : ℕ × ℕ) :
  c ∈ μ.cells ↔ c ∈ μ := iff.rfl

@[simp] lemma mem_mk (c : ℕ × ℕ) (cells) (is_lower_set) :
  c ∈ young_diagram.mk cells is_lower_set ↔ c ∈ cells := iff.rfl

instance decidable_mem (μ : young_diagram) : decidable_pred (∈ μ) :=
show decidable_pred (∈ μ.cells), by apply_instance

/-- In "English notation", a Young diagram is drawn so that (i1, j1) ≤ (i2, j2)
    means (i1, j1) is weakly up-and-left of (i2, j2). -/
lemma up_left_mem (μ : young_diagram) {i1 i2 j1 j2 : ℕ}
  (hi : i1 ≤ i2) (hj : j1 ≤ j2) (hcell : (i2, j2) ∈ μ) : (i1, j1) ∈ μ :=
μ.is_lower_set (prod.mk_le_mk.mpr ⟨hi, hj⟩) hcell

section distrib_lattice

@[simp] lemma cells_subset_iff {μ ν : young_diagram} : μ.cells ⊆ ν.cells ↔ μ ≤ ν := iff.rfl
@[simp] lemma cells_ssubset_iff {μ ν : young_diagram} : μ.cells ⊂ ν.cells ↔ μ < ν := iff.rfl

instance : has_sup young_diagram :=
{ sup := λ μ ν, { cells        := μ.cells ∪ ν.cells,
                  is_lower_set := by { rw finset.coe_union,
                                       exact μ.is_lower_set.union ν.is_lower_set } } }

@[simp] lemma cells_sup (μ ν : young_diagram) : (μ ⊔ ν).cells = μ.cells ∪ ν.cells := rfl

@[simp, norm_cast] lemma coe_sup (μ ν : young_diagram) : ↑(μ ⊔ ν) = (μ ∪ ν : set (ℕ × ℕ)) :=
finset.coe_union _ _

@[simp] lemma mem_sup {μ ν : young_diagram} {x : ℕ × ℕ} : x ∈ (μ ⊔ ν) ↔ x ∈ μ ∨ x ∈ ν :=
finset.mem_union

instance : has_inf young_diagram :=
{ inf := λ μ ν, { cells        := μ.cells ∩ ν.cells,
                  is_lower_set := by { rw finset.coe_inter,
                                       exact μ.is_lower_set.inter ν.is_lower_set } } }

@[simp] lemma cells_inf (μ ν : young_diagram) : (μ ⊓ ν).cells = μ.cells ∩ ν.cells := rfl

@[simp, norm_cast] lemma coe_inf (μ ν : young_diagram) : ↑(μ ⊓ ν) = (μ ∩ ν : set (ℕ × ℕ)) :=
finset.coe_inter _ _

@[simp] lemma mem_inf {μ ν : young_diagram} {x : ℕ × ℕ} : x ∈ (μ ⊓ ν) ↔ x ∈ μ ∧ x ∈ ν :=
finset.mem_inter

/-- The empty Young diagram is (⊥ : young_diagram). -/
instance : order_bot young_diagram :=
{ bot := { cells := ∅, is_lower_set := λ _ _ _, false.elim }, bot_le := λ _ _, false.elim }

@[simp] lemma cells_bot : (⊥ : young_diagram).cells = ∅ := rfl

@[simp, norm_cast] lemma coe_bot : ↑(⊥ : young_diagram) = (∅ : set (ℕ × ℕ)) := rfl

@[simp] lemma not_mem_bot (x : ℕ × ℕ) : x ∉ (⊥ : young_diagram) := finset.not_mem_empty x

instance : inhabited young_diagram := ⟨⊥⟩

instance : distrib_lattice young_diagram :=
function.injective.distrib_lattice
  young_diagram.cells
  (λ μ ν h, by rwa young_diagram.ext_iff)
  (λ _ _, rfl) (λ _ _, rfl)

end distrib_lattice

/-- Cardinality of a Young diagram -/
@[reducible] protected def card (μ : young_diagram) : ℕ := μ.cells.card

section transpose

/-- The `transpose` of a Young diagram is obtained by swapping i's with j's. -/
def transpose (μ : young_diagram) : young_diagram :=
{ cells :=  (equiv.prod_comm _ _).finset_congr μ.cells,
  is_lower_set := λ _ _ h, begin
    simp only [finset.mem_coe, equiv.finset_congr_apply, finset.mem_map_equiv],
    intro hcell,
    apply μ.is_lower_set _ hcell,
    simp [h],
  end }

@[simp] lemma mem_transpose {μ : young_diagram} {c : ℕ × ℕ} : c ∈ μ.transpose ↔ c.swap ∈ μ :=
by simp [transpose]

@[simp] lemma transpose_transpose (μ : young_diagram) : μ.transpose.transpose = μ :=
by { ext, simp }

lemma transpose_eq_iff_eq_transpose {μ ν : young_diagram} :
  μ.transpose = ν ↔ μ = ν.transpose :=
by { split; { rintro rfl, simp } }

@[simp] lemma transpose_eq_iff {μ ν : young_diagram} :
  μ.transpose = ν.transpose ↔ μ = ν :=
by { rw transpose_eq_iff_eq_transpose, simp }

-- This is effectively both directions of `transpose_le_iff` below.
protected lemma le_of_transpose_le {μ ν : young_diagram} (h_le : μ.transpose ≤ ν) :
  μ ≤ ν.transpose :=
λ c hc, by { simp only [mem_transpose], apply h_le, simpa }

@[simp] lemma transpose_le_iff {μ ν : young_diagram} : μ.transpose ≤ ν.transpose ↔ μ ≤ ν :=
⟨ λ h, by { convert young_diagram.le_of_transpose_le h, simp },
  λ h, by { convert @young_diagram.le_of_transpose_le _ _ _, simpa } ⟩

@[mono]
protected lemma transpose_mono {μ ν : young_diagram} (h_le : μ ≤ ν) : μ.transpose ≤ ν.transpose :=
transpose_le_iff.mpr h_le

/-- Transposing Young diagrams is an `order_iso`. -/
@[simps] def transpose_order_iso : young_diagram ≃o young_diagram :=
⟨⟨transpose, transpose, λ _, by simp, λ _, by simp⟩, by simp⟩

end transpose

section rows
/-! ### Rows and row lengths of Young diagrams.

This section defines `μ.row` and `μ.row_len`, with the following API:
      1.  `(i, j) ∈ μ ↔ j < μ.row_len i`
      2.  `μ.row i = {i} ×ˢ (finset.range (μ.row_len i))`
      3.  `μ.row_len i = (μ.row i).card`
      4.  `∀ {i1 i2}, i1 ≤ i2 → μ.row_len i2 ≤ μ.row_len i1`

Note: #3 is not convenient for defining `μ.row_len`; instead, `μ.row_len` is defined
as the smallest `j` such that `(i, j) ∉ μ`. -/

/-- The `i`-th row of a Young diagram consists of the cells whose first coordinate is `i`. -/
def row (μ : young_diagram) (i : ℕ) : finset (ℕ × ℕ) := μ.cells.filter (λ c, c.fst = i)

lemma mem_row_iff {μ : young_diagram} {i : ℕ} {c : ℕ × ℕ} : c ∈ μ.row i ↔ c ∈ μ ∧ c.fst = i :=
by simp [row]

lemma mk_mem_row_iff {μ : young_diagram} {i j : ℕ} : (i, j) ∈ μ.row i ↔ (i, j) ∈ μ :=
by simp [row]

protected lemma exists_not_mem_row (μ : young_diagram) (i : ℕ) : ∃ j, (i, j) ∉ μ :=
begin
  obtain ⟨j, hj⟩ := infinite.exists_not_mem_finset
    ((μ.cells).preimage (prod.mk i) (λ _ _ _ _ h, by {cases h, refl})),
  rw finset.mem_preimage at hj,
  exact ⟨j, hj⟩,
end

/-- Length of a row of a Young diagram -/
def row_len (μ : young_diagram) (i : ℕ) : ℕ := nat.find $ μ.exists_not_mem_row i

lemma mem_iff_lt_row_len {μ : young_diagram} {i j : ℕ} : (i, j) ∈ μ ↔ j < μ.row_len i :=
by { rw [row_len, nat.lt_find_iff], push_neg,
     exact ⟨λ h _ hmj, μ.up_left_mem (by refl) hmj h, λ h, h _ (by refl)⟩ }

lemma row_eq_prod {μ : young_diagram} {i : ℕ} : μ.row i = {i} ×ˢ finset.range (μ.row_len i) :=
by { ext ⟨a, b⟩,
     simp only [finset.mem_product, finset.mem_singleton, finset.mem_range,
                mem_row_iff, mem_iff_lt_row_len, and_comm, and.congr_right_iff],
     rintro rfl, refl }

lemma row_len_eq_card (μ : young_diagram) {i : ℕ} : μ.row_len i = (μ.row i).card :=
by simp [row_eq_prod]

@[mono]
lemma row_len_anti (μ : young_diagram) (i1 i2 : ℕ) (hi : i1 ≤ i2) : μ.row_len i2 ≤ μ.row_len i1 :=
by { by_contra' h_lt, rw ← lt_self_iff_false (μ.row_len i1),
     rw ← mem_iff_lt_row_len at h_lt ⊢,
     exact μ.up_left_mem hi (by refl) h_lt }

end rows

section columns
/-! ### Columns and column lengths of Young diagrams.

This section has an identical API to the rows section. -/

/-- The `j`-th column of a Young diagram consists of the cells whose second coordinate is `j`. -/
def col (μ : young_diagram) (j : ℕ) : finset (ℕ × ℕ) := μ.cells.filter (λ c, c.snd = j)

lemma mem_col_iff {μ : young_diagram} {j : ℕ} {c : ℕ × ℕ} : c ∈ μ.col j ↔ c ∈ μ ∧ c.snd = j :=
by simp [col]

lemma mk_mem_col_iff {μ : young_diagram} {i j : ℕ} : (i, j) ∈ μ.col j ↔ (i, j) ∈ μ :=
by simp [col]

protected lemma exists_not_mem_col (μ : young_diagram) (j : ℕ) : ∃ i, (i, j) ∉ μ.cells :=
by { convert μ.transpose.exists_not_mem_row j, simp }

/-- Length of a column of a Young diagram -/
def col_len (μ : young_diagram) (j : ℕ) : ℕ := nat.find $ μ.exists_not_mem_col j

@[simp] lemma col_len_transpose (μ : young_diagram) (j : ℕ) : μ.transpose.col_len j = μ.row_len j :=
by simp [row_len, col_len]

@[simp] lemma row_len_transpose (μ : young_diagram) (i : ℕ) : μ.transpose.row_len i = μ.col_len i :=
by simp [row_len, col_len]

lemma mem_iff_lt_col_len {μ : young_diagram} {i j : ℕ} : (i, j) ∈ μ ↔ i < μ.col_len j :=
by { rw [← row_len_transpose, ← mem_iff_lt_row_len], simp }

lemma col_eq_prod {μ : young_diagram} {j : ℕ} : μ.col j = (finset.range (μ.col_len j)) ×ˢ {j} :=
by { ext ⟨a, b⟩,
     simp only [finset.mem_product, finset.mem_singleton, finset.mem_range,
                mem_col_iff, mem_iff_lt_col_len, and_comm, and.congr_right_iff],
     rintro rfl, refl }

lemma col_len_eq_card (μ : young_diagram) {j : ℕ} : μ.col_len j = (μ.col j).card :=
by simp [col_eq_prod]

@[mono]

end columns

section row_lens
/-! ### The list of row lengths of a Young diagram

This section defines `μ.row_lens : list ℕ`, the list of row lengths of a Young diagram `μ`.
  1. `young_diagram.row_lens_sorted` : It is weakly decreasing (`list.sorted (≥)`).
  2. `young_diagram.row_lens_pos` : It is strictly positive.

-/

/-- List of row lengths of a Young diagram -/
def row_lens (μ : young_diagram) : list ℕ := (list.range $ μ.col_len 0).map μ.row_len

@[simp] lemma nth_le_row_lens {μ : young_diagram} {i : ℕ} {hi : i < μ.row_lens.length} :
  μ.row_lens.nth_le i hi = μ.row_len i :=
by simp only [row_lens, list.nth_le_range, list.nth_le_map']

@[simp] lemma length_row_lens {μ : young_diagram} : μ.row_lens.length = μ.col_len 0 :=
by simp only [row_lens, list.length_map, list.length_range]

lemma row_lens_sorted (μ : young_diagram) : μ.row_lens.sorted (≥) :=
(list.pairwise_le_range _).map _ μ.row_len_anti

lemma pos_of_mem_row_lens (μ : young_diagram) (x : ℕ) (hx : x ∈ μ.row_lens) : 0 < x :=
begin
  rw [row_lens, list.mem_map] at hx,
  obtain ⟨i, hi, rfl : μ.row_len i = x⟩ := hx,
  rwa [list.mem_range, ← mem_iff_lt_col_len, mem_iff_lt_row_len] at hi
end

end row_lens

section equiv_list_row_lens
/-! ### Equivalence between Young diagrams and lists of natural numbers

This section defines the equivalence between Young diagrams `μ` and weakly decreasing lists `w`
of positive natural numbers, corresponding to row lengths of the diagram:
  `young_diagram.equiv_list_row_lens :`
  `young_diagram ≃ {w : list ℕ // w.sorted (≥) ∧ ∀ x ∈ w, 0 < x}`

The two directions are `young_diagram.row_lens` (defined above) and `young_diagram.of_row_lens`.

-/

/-- The cells making up a `young_diagram` from a list of row lengths -/
protected def cells_of_row_lens : list ℕ → finset (ℕ × ℕ)
| [] := ∅
| (w :: ws) := (({0} : finset ℕ) ×ˢ finset.range w) ∪
                 (cells_of_row_lens ws).map
                   (embedding.prod_map ⟨_, nat.succ_injective⟩ (embedding.refl ℕ))

protected lemma mem_cells_of_row_lens {w : list ℕ} {c : ℕ × ℕ} :
  c ∈ young_diagram.cells_of_row_lens w ↔ ∃ (h : c.fst < w.length), c.snd < w.nth_le c.fst h :=
begin
  induction w generalizing c;
  rw young_diagram.cells_of_row_lens,
  { simp [young_diagram.cells_of_row_lens] },
  { rcases c with ⟨⟨_, _⟩, _⟩,
    { simp },
    { simpa [w_ih, -finset.singleton_product, nat.succ_lt_succ_iff] } }
end

/-- Young diagram from a sorted list -/
def of_row_lens (w : list ℕ) (hw : w.sorted (≥)) : young_diagram :=
{ cells        := young_diagram.cells_of_row_lens w,
  is_lower_set := begin
    rintros ⟨i2, j2⟩ ⟨i1, j1⟩ ⟨hi : i1 ≤ i2, hj : j1 ≤ j2⟩ hcell,
    rw [finset.mem_coe, young_diagram.mem_cells_of_row_lens] at hcell ⊢,
    obtain ⟨h1, h2⟩ := hcell,
    refine ⟨hi.trans_lt h1, _⟩,
    calc j1 ≤ j2            : hj
      ...   < w.nth_le i2 _ : h2
      ...   ≤ w.nth_le i1 _ : _,
    obtain (rfl | h) := eq_or_lt_of_le hi,
    { refl },
    { apply list.pairwise_iff_nth_le.mp hw _ _ _ h }
  end }

lemma mem_of_row_lens {w : list ℕ} {hw : w.sorted (≥)} {c : ℕ × ℕ} :
  c ∈ of_row_lens w hw ↔ ∃ (h : c.fst < w.length), c.snd < w.nth_le c.fst h :=
young_diagram.mem_cells_of_row_lens

/-- The number of rows in `of_row_lens w hw` is the length of `w` -/
lemma row_lens_length_of_row_lens {w : list ℕ} {hw : w.sorted (≥)} (hpos : ∀ x ∈ w, 0 < x) :
  (of_row_lens w hw).row_lens.length = w.length :=
begin
  simp only [length_row_lens, col_len, nat.find_eq_iff, mem_cells, mem_of_row_lens,
             lt_self_iff_false, is_empty.exists_iff, not_not],
  exact ⟨id, λ n hn, ⟨hn, hpos _ (list.nth_le_mem _ _ hn)⟩⟩,
end

/-- The length of the `i`th row in `of_row_lens w hw` is the `i`th entry of `w` -/
lemma row_len_of_row_lens {w : list ℕ} {hw : w.sorted (≥)}
  (i : ℕ) (hi : i < w.length) : (of_row_lens w hw).row_len i = w.nth_le i hi :=
by simp [row_len, nat.find_eq_iff, mem_of_row_lens, hi]

/-- The left_inv direction of the equivalence -/
lemma of_row_lens_to_row_lens_eq_self {μ : young_diagram} :
  of_row_lens _ (row_lens_sorted μ) = μ :=
begin
  ext ⟨i, j⟩,
  simp only [mem_cells, mem_of_row_lens, length_row_lens, nth_le_row_lens],
  simpa [← mem_iff_lt_col_len, mem_iff_lt_row_len] using j.zero_le.trans_lt,
end

/-- The right_inv direction of the equivalence -/
lemma row_lens_of_row_lens_eq_self {w : list ℕ} {hw : w.sorted (≥)} (hpos : ∀ x ∈ w, 0 < x) :
  (of_row_lens w hw).row_lens = w :=
begin
  ext i r,
  cases lt_or_ge i w.length,
  { simp only [option.mem_def, ← list.nth_le_eq_iff, h, row_lens_length_of_row_lens hpos],
    revert r,
    simpa only [eq_iff_eq_cancel_right, nth_le_row_lens] using row_len_of_row_lens _ h },
  { rw [list.nth_eq_none_iff.mpr h, list.nth_eq_none_iff.mpr],
    rwa row_lens_length_of_row_lens hpos }
end

/-- Equivalence between Young diagrams and weakly decreasing lists of positive natural numbers.
A Young diagram `μ` is equivalent to a list of row lengths. -/
@[simps]
def equiv_list_row_lens : young_diagram ≃ {w : list ℕ // w.sorted (≥) ∧ ∀ x ∈ w, 0 < x} :=
{ to_fun    := λ μ, ⟨μ.row_lens, μ.row_lens_sorted, μ.pos_of_mem_row_lens⟩,
  inv_fun   := λ ww, of_row_lens ww.1 ww.2.1,
  left_inv  := λ μ, of_row_lens_to_row_lens_eq_self,
  right_inv := λ ⟨w, hw⟩, subtype.mk_eq_mk.mpr (row_lens_of_row_lens_eq_self hw.2) }

end equiv_list_row_lens

end young_diagram


/-
Copyright (c) 2021 Chris Birkbeck. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Birkbeck
-/
import linear_algebra.matrix.nonsingular_inverse
import linear_algebra.special_linear_group

/-!
# The General Linear group $GL(n, R)$
This file defines the elements of the General Linear group `general_linear_group n R`,
consisting of all invertible `n` by `n` `R`-matrices.
## Main definitions
* `matrix.general_linear_group` is the type of matrices over R which are units in the matrix ring.
* `matrix.GL_pos` gives the subgroup of matrices with
  positive determinant (over a linear ordered ring).
## Tags
matrix group, group, matrix inverse
-/

namespace matrix
universes u v
open_locale matrix
open linear_map

/-- `GL n R` is the group of `n` by `n` `R`-matrices with unit determinant.
Defined as a subtype of matrices-/
abbreviation general_linear_group (n : Type u) (R : Type v)
  [decidable_eq n] [fintype n] [comm_ring R] : Type* := units (matrix n n R)

notation `GL` := general_linear_group

namespace general_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]

/-- The determinant of a unit matrix is itself a unit. -/
@[simps]
def det : GL n R →* units R :=
{ to_fun := λ A,
  { val := (↑A : matrix n n R).det,
    inv := (↑(A⁻¹) : matrix n n R).det,
    val_inv := by rw [←det_mul, ←mul_eq_mul, A.mul_inv, det_one],
    inv_val := by rw [←det_mul, ←mul_eq_mul, A.inv_mul, det_one]},
  map_one' := units.ext det_one,
  map_mul' := λ A B, units.ext $ det_mul _ _ }

/--The `GL n R` and `general_linear_group R n` groups are multiplicatively equivalent-/
def to_lin : (GL n R) ≃* (linear_map.general_linear_group R (n → R)) :=
units.map_equiv to_lin_alg_equiv'.to_mul_equiv

/--Given a matrix with invertible determinant we get an element of `GL n R`-/
def mk' (A : matrix n n R) (h : invertible (matrix.det A)) : GL n R :=
unit_of_det_invertible A

/--Given a matrix with unit determinant we get an element of `GL n R`-/
noncomputable def mk'' (A : matrix n n R) (h : is_unit (matrix.det A)) : GL n R :=
nonsing_inv_unit A h

/--Given a matrix with non-zero determinant over a field, we get an element of `GL n K`-/
def mk_of_det_ne_zero {K : Type*} [field K] (A : matrix n n K) (h : matrix.det A ≠ 0) :
  GL n K :=
mk' A (invertible_of_nonzero h)

instance coe_fun : has_coe_to_fun (GL n R) (λ _, n → n → R) :=
{ coe := λ A, A.val }

lemma ext_iff (A B : GL n R) : A = B ↔ (∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :=
units.ext_iff.trans matrix.ext_iff.symm

/-- Not marked `@[ext]` as the `ext` tactic already solves this. -/
lemma ext ⦃A B : GL n R⦄ (h : ∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :
  A = B :=
units.ext $ matrix.ext h

section coe_lemmas

variables (A B : GL n R)

@[simp] lemma coe_fn_eq_coe : ⇑A = (↑A : matrix n n R) := rfl

@[simp] lemma coe_mul : ↑(A * B) = (↑A : matrix n n R) ⬝ (↑B : matrix n n R) := rfl

@[simp] lemma coe_one : ↑(1 : GL n R) = (1 : matrix n n R) := rfl

lemma coe_inv : ↑(A⁻¹) = (↑A : matrix n n R)⁻¹ :=
begin
  letI := A.invertible,
  exact inv_of_eq_nonsing_inv (↑A : matrix n n R),
end

/-- An element of the matrix general linear group on `(n) [fintype n]` can be considered as an
element of the endomorphism general linear group on `n → R`. -/
def to_linear : general_linear_group n R ≃* linear_map.general_linear_group R (n → R) :=
units.map_equiv matrix.to_lin_alg_equiv'.to_ring_equiv.to_mul_equiv

-- Note that without the `@` and `‹_›`, lean infers `λ a b, _inst_1 a b` instead of `_inst_1` as the
-- decidability argument, which prevents `simp` from obtaining the instance by unification.
-- These `λ a b, _inst a b` terms also appear in the type of `A`, but simp doesn't get confused by
-- them so for now we do not care.
@[simp] lemma coe_to_linear :
  (@to_linear n ‹_› ‹_› _ _ A : (n → R) →ₗ[R] (n → R)) = matrix.mul_vec_lin A :=
rfl

@[simp] lemma to_linear_apply (v : n → R) :
  (@to_linear n ‹_› ‹_› _ _ A) v = matrix.mul_vec_lin A v :=
rfl

end coe_lemmas

end general_linear_group

namespace special_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]

instance has_coe_to_general_linear_group : has_coe (special_linear_group n R) (GL n R) :=
⟨λ A, ⟨↑A, ↑(A⁻¹), congr_arg coe (mul_right_inv A), congr_arg coe (mul_left_inv A)⟩⟩

end special_linear_group

section

variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]

section
variables (n R)

/-- This is the subgroup of `nxn` matrices with entries over a
linear ordered ring and positive determinant. -/
def GL_pos : subgroup (GL n R) :=
(units.pos_subgroup R).comap general_linear_group.det
end

@[simp] lemma mem_GL_pos (A : GL n R) : A ∈ GL_pos n R ↔ 0 < (A.det : R) := iff.rfl
end

section has_neg

variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]
[fact (even (fintype.card n))]

/-- Formal operation of negation on general linear group on even cardinality `n` given by negating
each element. -/
instance : has_neg (GL_pos n R) :=
⟨λ g,
   ⟨- g,
  begin
    simp only [mem_GL_pos, general_linear_group.coe_det_apply, units.coe_neg],
    have := det_smul g (-1),
    simp only [general_linear_group.coe_fn_eq_coe, one_smul, coe_fn_coe_base', neg_smul] at this,
    rw this,
    simp [nat.neg_one_pow_of_even (fact.out (even (fintype.card n)))],
    have gdet := g.property,
    simp only [mem_GL_pos, general_linear_group.coe_det_apply, subtype.val_eq_coe] at gdet,
    exact gdet,
  end⟩⟩

@[simp] lemma GL_pos_coe_neg (g : GL_pos n R) : ↑(- g) = - (↑g : matrix n n R) :=
rfl

@[simp]lemma GL_pos_neg_elt (g : GL_pos n R): ∀ i j, ( ↑(-g): matrix n n R) i j= - (g i j):=
begin
  simp [coe_fn_coe_base'],
end

end has_neg

namespace special_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [linear_ordered_comm_ring R]

/-- `special_linear_group n R` embeds into `GL_pos n R` -/
def to_GL_pos : special_linear_group n R →* GL_pos n R :=
{ to_fun := λ A, ⟨(A : GL n R), show 0 < (↑A : matrix n n R).det, from A.prop.symm ▸ zero_lt_one⟩,
  map_one' := subtype.ext $ units.ext $ rfl,
  map_mul' := λ A₁ A₂, subtype.ext $ units.ext $ rfl }

instance : has_coe (special_linear_group n R) (GL_pos n R) := ⟨to_GL_pos⟩

lemma coe_eq_to_GL_pos : (coe : special_linear_group n R → GL_pos n R) = to_GL_pos := rfl

lemma to_GL_pos_injective :
  function.injective (to_GL_pos : special_linear_group n R → GL_pos n R) :=
(show function.injective ((coe : GL_pos n R → matrix n n R) ∘ to_GL_pos),
 from subtype.coe_injective).of_comp

end special_linear_group

section examples

/-- The matrix [a, b; -b, a] (inspired by multiplication by a complex number); it is an element of
$GL_2(R)$ if `a ^ 2 + b ^ 2` is nonzero. -/
@[simps coe {fully_applied := ff}]
def plane_conformal_matrix {R} [field R] (a b : R) (hab : a ^ 2 + b ^ 2 ≠ 0) :
  matrix.general_linear_group (fin 2) R :=
general_linear_group.mk_of_det_ne_zero ![![a, b], ![-b, a]]
  (by simpa [det_fin_two, sq] using hab)

/- TODO: Add Iwasawa matrices `n_x=![![1,x],![0,1]]`, `a_t=![![exp(t/2),0],![0,exp(-t/2)]]` and
  `k_θ==![![cos θ, sin θ],![-sin θ, cos θ]]`
-/

end examples

end matrix


import game.limits.L01defs
import game.limits.seq_proveLimit
import algebra.pi_instances
import game.order.level05

--open function
open finset

namespace xena -- hide

notation `|` x `|` := abs x -- hide

def is_convergent (a : ℕ → ℝ) := ∃ α : ℝ, is_limit a α
def is_Cauchy (a : ℕ → ℝ) :=
  ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ m n : ℕ, N ≤ m ∧ N ≤ n → |a m - a n| < ε
def is_bdd (a : ℕ → ℝ) := ∃ B > 0, ∀ n, |a n| ≤ B

-- begin hide
-- We may want to skip this in RNG unless we can make it look (or be) easy --?
-- end hide

/-
Cauchy sequences are bounded.

-/

/- Lemma
A Cauchy sequence is bounded.
-/
lemma cauchy_is_bdd (a : ℕ → ℝ) :
    is_Cauchy a → is_bdd a:=
begin
  --classical proof for boundedness of Cauchy sequences
  intro HC,
  set e := (1:ℝ),
  have h1e : (0:ℝ) < 1, linarith,
  have H := HC 1 h1e,
  cases H with N hN,
  have G := hN N,
  -- construct X = {|a0|, |a1|, ...,|am|}
  let X := finset.image (abs ∘ a) (finset.range (N + 1)),
  -- at least a0 is in X
  have  ha0 : |a 0| ∈ X := finset.mem_image_of_mem _ (mem_range.2 (nat.zero_lt_succ _)),
  -- hence the set X is not empty
  have ha1 : X ≠ ∅ := ne_empty_of_mem ha0,
  have ha2 := nonempty_iff_ne_empty.mpr ha1,
  -- and therefore has a maximum
  let B1 := X.max' ha2,
  -- If n ≤ m then get a proof that |a n| ≤ B1.
  have HB1 : ∀ n ≤ N, |a n| ≤ B1 := λ n Hn, le_max' X ha2 _
    (mem_image_of_mem _ (mem_range.2 (nat.lt_succ_of_le Hn))),
  -- term that bounds all members of the sequence
  set B := max B1 ( |a N| + 1 ) with hB,
  -- so this will be our bound
  use B,
  split,
  swap,
  intro n,
  cases le_or_gt n N with hn1 hn2,
  { -- n ≤ N
    have g1 : | a n | ≤  B1 := HB1 n hn1,
    have g2 : B1 ≤ B := le_max_left _ _,
    linarith,
  },
  { -- n > N
    have g1 := G n,
    have g2 : N ≤ N ∧ N ≤ n,
        split; linarith,
    have g3 := g1 g2,
    rw abs_lt at g3,
    have fact1 := g3.left,
    have fact2 := g3.right,
    simp,
    right,
    rw abs_le,  -- our abs_le is conditional on 0 ≤ c - proven in the last section
    simp,
    split,
    {
    have simplefact1: - a N ≤ | a N | := neg_le_abs_self (a N),
    linarith,
    },
    {have simplefact2: a N ≤ | a N | := le_abs_self(a N),
    linarith},

  have simplefact3: 0 ≤ |a N|, from abs_nonneg (a N),
  linarith,
  },

  have g1 : |a N| + 1 ≤ B := le_max_right _ _,
  have g2: 0 ≤ |a N|, from abs_nonneg (a N),
  linarith,

end

end xena -- hide


theorem Q2a {x y : fake_reals} : (x > 0) → (y < 0) → x * y < 0 := sorry

theorem neg_pos_of_neg' {x : fake_reals} : x < 0 → -x > 0 :=
begin
intro Hx_neg,
  have H : x + (-x) < 0 + (-x) := A1 Hx_neg,
  rwa [add_neg_self,zero_add] at H,
end

theorem neg_eq_neg_one_mul' {x : fake_reals} : -x = (-1)*x :=
neg_eq_neg_one_mul x

theorem neg_one_squared : (-1:fake_reals)*(-1)=1 :=
calc (-1:fake_reals)*(-1)=-(-1) : eq.symm (@neg_eq_neg_one_mul' (-1))
... = 1 : neg_neg 1

theorem pos_eq_neg_mul_neg {x y : fake_reals} : x < 0 → y < 0 → x * y > 0 :=
begin
intros Hxneg Hyneg,
have Hneg_x_pos : -x > 0 := neg_pos_of_neg' Hxneg,
have Hneg_y_pos : -y > 0 := neg_pos_of_neg' Hyneg,
exact calc x * y = -x * -y : by rw [neg_eq_neg_one_mul',@neg_eq_neg_one_mul' y,←mul_one (x * y),←neg_one_squared];simp
... > 0 : A4 Hneg_x_pos Hneg_y_pos,
end

theorem Q2b {x y : fake_reals} : x < 0 → y < 0 → x * y > 0 := sorry

theorem zero_not_pos : ¬ ((0:fake_reals) < 0) := (@A3 0 0).right.right.right (rfl)

theorem fake_reals_integral_domain {x y : fake_reals} : x * y = 0 → x = 0 ∨ y = 0 :=
begin
intro Hxy_zero,
cases (@A3 0 x).left with Hx_pos Hx_nonpos,
  cases (@A3 0 y).left with Hy_pos Hy_nonpos,
    exfalso,
    exact zero_not_pos (calc 0 < x * y : A4 Hx_pos Hy_pos ... = 0 : Hxy_zero),
  cases Hy_nonpos with Hy_0 Hy_neg,
    right,exact eq.symm Hy_0,
  exfalso,
  apply zero_not_pos,
  exact calc 0 = x*y : eq.symm Hxy_zero ... <0 : Q2a Hx_pos Hy_neg,
cases Hx_nonpos with Hx_0 Hx_neg,
  left,exact eq.symm Hx_0,
cases (@A3 0 y).left with Hy_pos Hy_nonpos,
  exfalso,
  apply zero_not_pos,
  exact calc 0=x*y : eq.symm Hxy_zero ... = y*x : by rw[mul_comm] ... <0 : Q2a Hy_pos Hx_neg,
cases Hy_nonpos with Hy_0 Hy_neg,
  right,exact eq.symm Hy_0,
exfalso, apply zero_not_pos,
exact calc 0 < x * y : Q2b Hx_neg Hy_neg ... = 0 : Hxy_zero,
end

theorem Q2c : ∀ x y : fake_reals, x * y = 0 → x = 0 ∨ y = 0 := sorry

end M1F_Sheet03

axiom A5 : ∀ x : fake_reals, x > 0 → ∃ y : fake_reals,
                 y > 0 ∧ y*y=x ∧ ∀ z : fake_reals, z > 0 ∧ z*z=x → z=y

section M1F_Sheet03

theorem Q2d : ∀ x : fake_reals, x > 0 → ∃ z1 z2 : fake_reals, z1*z1=x ∧ z2*z2=x ∧ ∀ z : fake_reals, z*z=x → z=z1 ∨ z=z2 := sorry

end M1F_Sheet03

axiom A6 : ∀ n : ℕ, n > 0 →
             ∀ x : fake_reals, x > 0 →
               ∃ y : fake_reals,
                 y > 0
                ∧ y ^ n = x
                ∧ ∀ z : fake_reals, z > 0 ∧ z ^ n = x → z = y

section M1F_Sheet03


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

import algebra.algebra.basic
import algebra.module.ordered

/-!
# Ordered algebras

An ordered algebra is an ordered semiring, which is an algebra over an ordered commutative semiring,
for which scalar multiplication is "compatible" with the two orders.

The prototypical example is 2x2 matrices over the reals or complexes (or indeed any C^* algebra)
where the ordering the one determined by the positive cone of positive operators,
i.e. `A ≤ B` iff `B - A = star R * R` for some `R`.
(We don't yet have this example in mathlib.)

## Implementation

Because the axioms for an ordered algebra are exactly the same as those for the underlying
module being ordered, we don't actually introduce a new class, but just use the `ordered_module`
mixin.

## Tags

ordered algebra
-/

section ordered_algebra

variables {R A : Type*} {a b : A} {r : R}

variables [ordered_comm_ring R] [ordered_ring A] [algebra R A] [ordered_module R A]

lemma algebra_map_monotone : monotone (algebra_map R A) :=
λ a b h,
begin
  rw [algebra.algebra_map_eq_smul_one, algebra.algebra_map_eq_smul_one, ←sub_nonneg, ←sub_smul],
  transitivity (b - a) • (0 : A),
  { simp, },
  { exact smul_le_smul_of_nonneg zero_le_one (sub_nonneg.mpr h) }
end

end ordered_algebra

section instances

variables {R : Type*} [linear_ordered_comm_ring R]

instance linear_ordered_comm_ring.to_ordered_module : ordered_module R R :=
{ smul_lt_smul_of_pos       := ordered_semiring.mul_lt_mul_of_pos_left,
  lt_of_smul_lt_smul_of_pos := λ a b c w₁ w₂, (mul_lt_mul_left w₂).mp w₁ }

end instances