-- CS2102 F19 Exam #1
--Derek Johnson dej3tc
--10/10/19
/-
#1 [10 points]

Complete the following definitions to give examples of
literal values of specified types. Use lambda expressions
to complete the questions involving function types. Make
functions (lambda expressions) simple: we don't care what
the functions do, just that they are of the right types.
-/
open nat
def x := λ (n:ℕ), n
def n : ℕ := 1
def s : string := "CS"
def b : bool := tt
def f1 : ℕ → bool := λ (n: ℕ), tt
def f2 : (ℕ → ℕ) → bool := λ x,tt
def f3 : (ℕ → ℕ) → (ℕ → ℕ) := λ x,x
def t1 : Type := nat
def t2 : Type → Type := λ (α : Type), α

/-
#2 [10 points]

Complete the following recursive function definition
so that the function computes the sum of the natural
numbers from 0 to (and including) a given value, n.
-/

def sumto : ℕ → ℕ
| 0 := 0
| (nat.succ n') := nat.succ n' + sumto(n')
/-
#3. [5 points]

We have seen that we can write function *specifications*
in the language of predicate logic, and specifically in
the language of pure functional programming. We also know
we can, and generally do, write *implementations* in the
language of imperative programming (e.g., in Python or in
Java). Complete the following sentence by filling in the
blanks to explain the esssential tradeoff between function
specifications, in the langugae of predicate logic, and
function implementations written in imperative programming
languages, respectively.

Specifications are generally understandable but less efficient
while implementations are generally the opposite: less
understandable but more efficient.

-/

/-
# 4. [10 points]

Natural languages, such as English and Mandarin, are very
powerful, but they have some fundamental weaknesses when it
comes to writing and verifying precise specifications and
claims about properties of algorithms and programs. It is
for this reason that computer scientists often prefer to
write express such things using mathematical logic instead
of natural language.

Name three fundamental weaknesses of natural language when
it comes to carrying out such tasks. You may given one-word
answers if you wish.

A. Ambiguous
B. Not Machine Checkable
C. Too Verbose (in some situations)

-/

/-
#5. [10 points]

What logical proposition expresses the claim that a given
implementation, I, of a function of type ℕ → ℕ, is correct
with respect to a specification, S, of the same function?

Answer: For all natural numbers, implementation I will
hold to / be true for specification S.
-/

/-
#6. [10 points]

What Boolean functions do the following definitions define?
-/

def mystery1 : bool → bool → bool
| tt tt := ff
| ff ff := ff
| _ _ := tt

/-
Answer: Not Equal To
-/

def mystery2 : bool → bool → bool
| tt ff := ff
| _ _ := tt

/-
Answer: Not (a, not b)
-/

/-
#7. [10 points]

Define a function that takes a string, s, and a natural
number, n, and that returns value of type (list string)
in which s is repeated n times. Give you answer by
completing the following definition: fill in underscores
with the answers that are needed. Note that the list
namespace is not open by default, so prefix constructor
names with "list." as we do for the first (base) case.
-/

def repeat : string → ℕ → list string
| s nat.zero := list.nil
| s (nat.succ n') := list.cons s (repeat s n')

#eval repeat "hello" 3
/-
#8. [10 points]

Definea a polymorphic function that takes (1) a type, α,
(2) a value, s : α, and (3) a natural number, n, and that
returns a list in which the value, a, is repeated n times.
Make the type argument to this function implicit. Replace
underscores as necessary to give a complete answer. Note
again that the list namespace is not open, so use "fully
qualified" constructor names.
-/

def poly_repeat {α : Type} : α → ℕ → list α
| s nat.zero := list.nil
| s (nat.succ n') := list.cons s (poly_repeat s n')

#eval poly_repeat "hello" 3
/-
#9. [10 points]

Define a data type, an enumerated type, friend_or_foe,
with just two terms, one called friend, one called foe.
Then define a function called eval that takes two terms,
F1 and F2, of this type and returns a term of this type,
where the function implements the following table:

F1      F2      result
friend  friend  friend
friend  foe     foe
foe     friend  foe
foe     foe     friend
-/

-- Answer here
inductive friend_or_foe : Type
 | friend : friend_or_foe
 | foe : friend_or_foe

open friend_or_foe
def eval : friend_or_foe → friend_or_foe → friend_or_foe
| friend friend := friend
| friend foe := foe
| foe friend := foe
| foe foe := friend

/-
#10. [10 points]

We studied the higher-order function, map. In particular,
we implemented a version of it, which we called mmap, for
functions of type ℕ → ℕ, and for lists of type (list ℕ).
The function is reproduced next for your reference. Read
and recall how the function works, then continue on to the
questions that follow.
-/

def mmap : (ℕ → ℕ) → list ℕ → list ℕ
| f [] := []
| f (list.cons h t) := list.cons (f h) (mmap f t)

-- An example application of this function
#eval mmap (λ n, n + 1) [1, 2, 3, 4, 5]

/-
A. Write a polymorphic version of this function, called
pmap, that takes (1) two type arguments, α and β, (2) a
function of type α → β, and (3) a list of values of type
α, and that returns the list of values obtained by
applying the given function to each value in the given
list. Make α and β implicit arguments.
-/

-- Answer here
def pmap {α β : Type} : (α → β) → list α → list β
| f [] := []
| f (list.cons h t) := list.cons (f h) (pmap f t)

/-
B.

Use #eval to evaluate an application of pmap to a function
of type ℕ to bool and a non-empty list of natural numbers.
Use a lambda abstraction to give the function argument. It
does not matter to us what value the function returns.
-/

-- Answer here
def tttt:= λ (n:ℕ), tt

def list1 := [1,2,3,4,5]

#eval pmap (λ (n:ℕ), tt) [1,2,3,4,5]

/-
#11. [10 points]

Define a data type, prod3_nat, with one constructor,
triple, that takes three natural numbers as arguments,
yielding a term of type prod3_nat. Then write three
"projection functions", prod3_nat_fst, prod3_nat_snd,
and prod3_nat_thd, each of which takes a prod3_nat value
and returns its corresponding component element. Hint:
look to see how we defined the prod type, its pair
constructor, and its two projection functions.
-/
inductive prod3_nat : Type
| triple (a :ℕ ) (b:ℕ ) (c : ℕ ) : prod3_nat

def prod3_nat_fst : prod3_nat → ℕ
| (prod3_nat.triple a b c) := a

def prod3_nat_snd : prod3_nat → ℕ
| (prod3_nat.triple a b c) := b

def prod3_nat_thd : prod3_nat → ℕ
| (prod3_nat.triple a b c) := c

def ss := prod3_nat.triple 2 3 4
#eval prod3_nat_fst ss

/-
Extra credit. Define prod3 as a version
of prod3_nat that is polymorphic in each of
its three components; define polymorphic
projection functions; and then use them to
define a function, rotate_right, that takes
a triple, (a, b, c), and returns the triple
(c, a, b).  (Call your type arguments α,
β, and γ - alpha, beta, and gamma).
-/

inductive prod3 (α β γ : Type) : Type
| triple (a : α) (b : β) (y : γ) : prod3

def prod3_fst {α β γ : Type}: prod3 α β γ → α
| (prod3.triple a b c) := a

def prod3_snd {α β γ : Type} : prod3 α β γ → β
| (prod3.triple a b c) := b

def prod3_thd {α β γ : Type} : prod3 α β γ → γ
| (prod3.triple a b c) := c

def rotate_right {α β γ : Type} : prod3 α β γ → prod3 γ α β
| (prod3.triple a b c) := prod3.triple c a b


/-
The goal of this demo is to serve as an extended example to show the process of working with
and extending mathematical structures in Lean. A lot of this file is taken from Floris van Doorn's
demo in LFTCM2020.

We first import a few modules we want from later to connect with later in the document.
-/
import algebra.group.defs
import category_theory.category.basic

/-
This is a long file, so we'll want to section off parts of the document to keep the local variables,
notation, and more isolated.
-/
section basic_definitions

/-
Structures are defined in the following format:

structure structure_name :=
(field1 : ...)
(field2 : ...)
...
(fieldn : ...)

This is very similar to the inductive datatypes that we've seen before. For this demo we'll be
focusing on a simple structure called a _Pointed type_. The structure is simply some type, together
with a particular instance of said type. We can think of them as pairs of a type `T` and some
`p : T`.
-/
structure pointed_type :=
(type : Type*)
(point : type)

/-
Lean now recognizes this as a new type. We could have provided the type ascription to
`pointed_type : Type (u + 1)`, but Lean does it for us.
-/
#check pointed_type

/-
Lean now recognizes this type as something we can refer to, and construct new types out of.
-/
#check ℕ → pointed_type
#check ℕ × pointed_type
#check list pointed_type

/-
We can even provide instances of this structure. For example the natural numbers `ℕ` could be
considered a pointed type by considering the pair `(ℕ, 0)`. The method to do this is to use
`name.mk`:
-/
def pointed_nat : pointed_type := pointed_type.mk ℕ 0
def pointed_int : pointed_type := pointed_type.mk ℤ 0

-- You can also use an "anonymous constructor" by using angle brackets `\< \>`.
def pointed_nat_with_1 : pointed_type := ⟨ℕ, 1⟩

-- We can `#check` to see if Lean recognizes them.
#check pointed_nat

/-
We can even ask Lean to `#reduce` them. This is similar to evaluation, but essentially asks Lean to
rewrite the expression in simplest terms.
-/
#reduce pointed_nat

/-
In fact, using the `structure` keyword means that Lean has generated a ton of useful functions
associated with our new type.
-/
#print prefix pointed_type

/-
Some highlights are:
* `pointed_type.mk : Π (carrier : Type u), carrier → pointed_type`
This is the `make` function. We saw above, the `Π` symbol can basically be thought of as a `λ`, so
the above type takes in a `carrier`, a `point` of the carrier, and returns a `pointed_type`. This is
exactly how we've been using it

* It also automatically provides `pointed_type.carrier` and `pointed_type.point` to
extract the components of
-/

open pointed_type

#check type
#check point

#reduce type pointed_nat
#reduce type pointed_int

/-
Lean also lets you use the usual `.` notation you may be familiar with in OOP. Because
`pointed_nat_with_1` is a `pointed_type`, then we can call `pointed_type.point` by just typing:
-/
#reduce pointed_nat_with_1.point

/-
* Another useful function that is constructed when dealing with a structure is `pointed_type.rec`,
`pointed_type.rec_on`, `pointed_type.cases_on` (a synonym). The exact type signature is not super
important, but the key takeaway is that it allows us to define things on `pointed_types` by
-/
#print prefix pointed_type

#print pointed_type.rec
#check pointed_type.cases_on

/-
Lets do a few more constructions of pointed types. In fact, any non-empty type is a pointed type
if we just choose some instance!
-/
noncomputable def from_nonempty {X : Type} (h : nonempty X) : pointed_type := { type := X,
  point := classical.choice h }

#check classical.choice
-- We see here we need to make this a noncomputable definition, becuase we're using choice.

/-
Actually this gives us an idea that maybe we could show that any pointed type is nonempty! Though
when we look at the type of nonempty we see that it's expecting something in the usual `Sort`
hierarchy.

We can get around this by offering a **coercion** from . This is just like the coercion we have to
specficy when we want to consider `3` as an integer: `(3 : ℤ)`
-/
instance : has_coe_to_sort pointed_type (Type*) := ⟨pointed_type.type⟩

#check pointed_nat
#check (pointed_nat : Type)

/-
Now we can prove the lemma that `pointed_type`s are nonempty by providing a witness!
-/
namespace pointed_type

lemma nonempty (X : pointed_type) : nonempty X := nonempty.intro X.point

/-
Finally, a large class of pointed types can be generated in the following way:
-/
def from_has_one (X : Type) [has_one X] : pointed_type := ⟨X, 1⟩

#reduce from_has_one ℤ

variables (G : Type) [group G]

#reduce from_has_one G

/-
We can even define the product of pointed types.
-/
@[simps point]
def prod (A B : pointed_type) : pointed_type :=
{ type := A × B,
  point := (A.point, B.point) }

/-
Finally, a small command that I learned which is nice to remind yourself of what variables are in
scope
-/
#where

end pointed_type
end basic_definitions

section pointed_maps

/-
Unfortunately pointed types are not super interesting to reason about, but one thing we can do is
define maps between them! Intuitively, a good notion of a map between pointed types is one which
respects the point. This can also be encoded as a structure!
-/
structure pointed_map (A B : pointed_type) :=
(to_fun : A → B) -- The actual function
(to_fun_point : to_fun A.point = B.point) -- The property that the function respects the points

-- Just a quick example of how we can reason about this!
def pointed_coe' : pointed_map pointed_nat pointed_int := sorry

/-
Actually on second though, this is all getting a little annoying to write out all the time! Lets
give ourselves some nice notation to work with
-/

notation `ℕ⬝` := pointed_nat
notation `ℤ⬝` := pointed_int
infix ` →⬝ `:25 := pointed_map

#check ℤ

#check ℕ.

-- Now the definition looks a lot nicer!
def pointed_coe : ℕ⬝ →⬝ ℤ⬝ := { to_fun := int.of_nat,
  to_fun_point :=
  begin
    -- Sometimes when it's not entirely clear what we're trying to prove, `dunfold` and `unfold`
    -- can be your friend! (though it also feels sometimes that definitions aren't unfolding when
    -- they should.)
    sorry
  end }

namespace pointed_map
variables {A B C D : pointed_type}
variables {g : B →⬝ C} {f f₁ f₂ : A →⬝ B} {h : C →⬝ D}
variable (a : A)

/-
You would hope something like this would work
-/
-- #check f a
/-
But Lean rightfully complains that `f` is a `pointed_map` and not a function! In order to "apply" it
to anything, we need to remember that one of its fields is `to_fun`
-/
#check f.to_fun a

/-
But this is annoying, so we can do better and coerce it into a function type using `has_coe_to_fun`!
-/
instance : has_coe_to_fun (A →⬝ B) (λ (h : A →⬝ B ), A → B) := ⟨pointed_map.to_fun⟩

-- And now it works
#check f a

/-
It's usually a good idea to provide a couple `simp` lemmas to help Lean unfold definitions along
the way
-/
@[simp] lemma coe_mk {f : A → B} {hf : f A.point = B.point} {x : A} :
  { pointed_map . to_fun := f, to_fun_point := hf } x = f x := by refl

@[simp] lemma coe_point : f A.point = B.point := f.to_fun_point

/-
And also prove an extensionality lemma that when two pointed maps are the same:
-/
@[ext] protected lemma ext (hf₁₂ : ∀ x, f₁ x = f₂ x) : f₁ = f₂ :=
begin
  -- It probably pays for the first step to be splitting up `f₁` and `f₂` into their constituent
  -- parts with `cases f₁`
  sorry
end

/-
We can now start prove basic things about pointed maps
-/
def comp (g : B →⬝ C) (f : A →⬝ B) : A →⬝ C :=
sorry

def id : A →⬝ A :=
sorry

lemma comp_assoc : h.comp (g.comp f) = (h.comp g).comp f :=
sorry

lemma id_comp : f.comp id = f :=
sorry

lemma comp_id : id.comp f = f :=
sorry

/-
We can define a few maps into and out of products of pointed types, and then prove properties about
them as well!
-/
def fst : A.prod B →⬝ A :=
sorry

def snd : A.prod B →⬝ B :=
sorry

def pair (f : C →⬝ A) (g : C →⬝ B) : C →⬝ A.prod B :=
sorry

lemma fst_pair (f : C →⬝ A) (g : C →⬝ B) : fst.comp (f.pair g) = f :=
sorry

lemma snd_pair (f : C →⬝ A) (g : C →⬝ B) : snd.comp (f.pair g) = g :=
sorry

lemma pair_unique (f : C →⬝ A) (g : C →⬝ B) (u : C→⬝ A.prod B) (h1u : fst.comp u = f)
  (h2u : snd.comp u = g) : u = f.pair g :=
begin
  sorry
end

end pointed_map
end pointed_maps


import data.real.basic --hide

/-
# Chapter 1 : Sets

## Level 8
-/

/-
This is a very basic example of working with intervals of real numbers in Lean.
An interval that is closed at both endpoints $a$ and $b$ can be
constructed using `set.Icc a b`. For an open-closed interval, the notation
is `set.Ioc a b`, etc. The usual closed-interval notation, using square
brackets, is used here as a wrapper around these definitions.
After `intro hx,` the `split` tactic will showcase the conditions for
membership. The inequality goals can be met with the `linarith` tactic.
The latter is very useful when dealing with goals that don't involve any
nonlinearity in the involved variables, in particular with inequalities.
-/

notation `[` a `,` b `]`  := set.Icc a b

/- Lemma
If $x = 2$ then $x ∈ [0,5]$
-/
lemma in_closed_interval (x:ℝ) : x = 2 → x ∈ [(0:ℝ), 5] :=
begin
    intro hx,
    split, linarith, linarith, done
end


import data.vect.basic
import tactic.csimp

universe u

--- Check whether a given vector is monotonic with respect to a given binary relation.
definition is_monotonic {α : Type*} (r : α → α → Prop) : ∀ {n : ℕ}, vect α n → Prop
| _ vect.nil := true
| _ (vect.cons _ vect.nil) := true
| _ (vect.cons x (vect.cons y ys)) := r x y ∧ is_monotonic (vect.cons y ys)

inductive based_chain {α : Type u} (r : α → α → Prop) : α → ℕ → Type u
| base (x : α) : based_chain x 1
| cons {n : ℕ} (x : α) {y : α} (_ : r x y) (xs : based_chain y n) : based_chain x (n+1)

namespace based_chain

definition to_vect {α : Type*} {r : α → α → Prop} : Π {x : α} {n : ℕ}, based_chain r x n → vect α n
| x _ (base _) := vect.cons x vect.nil
| x _ (cons _ h xs) := vect.cons x (to_vect xs)

lemma to_vect_is_monotonic {α : Type*} {r : α → α → Prop} : Π {x : α} {n : ℕ} (ch : based_chain r x n), is_monotonic r ch.to_vect
| _ _ (base x) := by csimp [to_vect,is_monotonic]
| _ _ (cons x h (base y)) := by csimp [to_vect,is_monotonic]; exact ⟨h,true.intro⟩
| _ _ (cons x hxy (cons y h ch)) :=
  begin
    have h_ind : is_monotonic r (cons y h ch).to_vect,
      from to_vect_is_monotonic (cons y h ch),
    csimp [to_vect,is_monotonic] at *,
    split,
    show r x y, from hxy,
    show is_monotonic r (vect.cons y ch.to_vect), from h_ind
  end

definition from_vect {α : Type*} {r : α → α → Prop} : Π {n : ℕ} (xs : vect α (n+1)) (hmono : is_monotonic r xs), based_chain r xs.head (n+1)
| _ (vect.cons x vect.nil) hmono := based_chain.base x
| n (vect.cons x (vect.cons y ys)) hmono :=
  let tail := from_vect (vect.cons y ys) hmono.right
  in cons x hmono.left tail

definition from_vect' {α : Type*} {r : α → α → Prop} {n : ℕ} (xs : vect α (n+1)) (hmono : is_monotonic r xs) : Σ x, based_chain r x (n+1) :=
  ⟨xs.head, from_vect xs hmono⟩

lemma tail_heq {α : Type _} {r : α → α → Prop} (x : α) {n : ℕ} : Π {y₁ y₂ : α} (hxy₁ : r x y₁) (hxy₂ : r x y₂) {ys₁ : based_chain r y₁ n} {ys₂ : based_chain r y₂ n}, (y₁ = y₂) → ys₁ == ys₂ → cons x hxy₁ ys₁ = cons x hxy₂ ys₂ :=
  begin
    intros _ _ _ _ _ _ hy hys,
    cases hy, cases hy,
    have : ys₁ = ys₂ := eq_of_heq hys,
    rw [this]
  end

lemma to_vect_of_from {α : Type*} {r : α → α → Prop} : Π {n : ℕ} (xs : vect α (n+1)) (hmono : is_monotonic r xs), (from_vect xs hmono).to_vect = xs
| _ (vect.cons x vect.nil) hmono := by dsimp [from_vect,to_vect,vect.head]; refl
| _ (vect.cons x (vect.cons y ys)) hmono :=
  begin
    dsimp only [from_vect,to_vect],
    unfold vect.head,
    let h_ind := to_vect_of_from (vect.cons y ys) hmono.right,
    rw [h_ind]
  end

attribute [simp,reducible]
lemma head_of_to_vect {α : Type*} {r : α → α → Prop} : Π {x : α} {n : ℕ} (ch : based_chain r x (n+1)), ch.to_vect.head = x
| _ _ (base x) := rfl
| _ _ (cons x h ys) := rfl

lemma from_vect_of_to {α : Type*} {r : α → α → Prop} : Π {x : α} {n : ℕ} (ch : based_chain r x (n+1)), (from_vect' ch.to_vect (to_vect_is_monotonic ch)) = ⟨x,ch⟩
| _ _ (base x) := rfl
| _ _ (cons x h (base y)) := rfl
| _ _ (cons x hxy (cons y h ys)) :=
  begin
    let h_ind := from_vect_of_to (cons y h ys),
    unfold to_vect at *,
    unfold from_vect' at *,
    apply sigma.eq; try {unfold sigma.fst at *}; try {unfold sigma.snd at *},
    dsimp [from_vect],
    refine tail_heq x _ hxy _ _; try {refl},
    exact (sigma.mk.inj h_ind).right
  end

end based_chain


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.trigonometric.inverse

/-!
# The argument of a complex number.

We define `arg : ℂ → ℝ`, returing a real number in the range (-π, π],
such that for `x ≠ 0`, `sin (arg x) = x.im / x.abs` and `cos (arg x) = x.re / x.abs`,
while `arg 0` defaults to `0`
-/

noncomputable theory

namespace complex

open_locale real topological_space
open filter set

/-- `arg` returns values in the range (-π, π], such that for `x ≠ 0`,
  `sin (arg x) = x.im / x.abs` and `cos (arg x) = x.re / x.abs`,
  `arg 0` defaults to `0` -/
noncomputable def arg (x : ℂ) : ℝ :=
if 0 ≤ x.re
then real.arcsin (x.im / x.abs)
else if 0 ≤ x.im
then real.arcsin ((-x).im / x.abs) + π
else real.arcsin ((-x).im / x.abs) - π

lemma sin_arg (x : ℂ) : real.sin (arg x) = x.im / x.abs :=
by unfold arg; split_ifs;
  simp [sub_eq_add_neg, arg, real.sin_arcsin (abs_le.1 (abs_im_div_abs_le_one x)).1
    (abs_le.1 (abs_im_div_abs_le_one x)).2, real.sin_add, neg_div, real.arcsin_neg,
    real.sin_neg]

lemma cos_arg {x : ℂ} (hx : x ≠ 0) : real.cos (arg x) = x.re / x.abs :=
begin
  have habs : 0 < abs x := abs_pos.2 hx,
  have him : |im x / abs x| ≤ 1,
  { rw [_root_.abs_div, abs_abs], exact div_le_one_of_le x.abs_im_le_abs x.abs_nonneg },
  rw abs_le at him,
  rw arg, split_ifs with h₁ h₂ h₂,
  { rw [real.cos_arcsin]; field_simp [real.sqrt_sq, habs.le, *] },
  { rw [real.cos_add_pi, real.cos_arcsin],
    { field_simp [real.sqrt_div (sq_nonneg _), real.sqrt_sq_eq_abs,
        _root_.abs_of_neg (not_le.1 h₁), *] },
    { simpa [neg_div] using him.2 },
    { simpa [neg_div, neg_le] using him.1 } },
  { rw [real.cos_sub_pi, real.cos_arcsin],
    { field_simp [real.sqrt_div (sq_nonneg _), real.sqrt_sq_eq_abs,
        _root_.abs_of_neg (not_le.1 h₁), *] },
    { simpa [neg_div] using him.2 },
    { simpa [neg_div, neg_le] using him.1 } }
end

@[simp] lemma abs_mul_exp_arg_mul_I (x : ℂ) : ↑(abs x) * exp (arg x * I) = x :=
begin
  rcases eq_or_ne x 0 with (rfl|hx),
  { simp },
  { have : abs x ≠ 0 := abs_ne_zero.2 hx,
    ext; field_simp [sin_arg, cos_arg hx, this, mul_comm (abs x)] }
end

@[simp] lemma abs_mul_cos_add_sin_mul_I (x : ℂ) :
  (abs x * (cos (arg x) + sin (arg x) * I) : ℂ) = x :=
by rw [← exp_mul_I, abs_mul_exp_arg_mul_I]

lemma arg_mul_cos_add_sin_mul_I {r : ℝ} (hr : 0 < r) {θ : ℝ} (hθ : θ ∈ Ioc (-π) π) :
  arg (r * (cos θ + sin θ * I)) = θ :=
begin
  have hπ := real.pi_pos,
  simp only [arg, abs_mul, abs_cos_add_sin_mul_I, abs_of_nonneg hr.le, mul_one],
  simp only [of_real_mul_re, of_real_mul_im, neg_im, ← of_real_cos, ← of_real_sin,
    ← mk_eq_add_mul_I, neg_div, mul_div_cancel_left _ hr.ne',
    mul_nonneg_iff_right_nonneg_of_pos hr],
  by_cases h₁ : θ ∈ Icc (-(π / 2)) (π / 2),
  { rw if_pos, exacts [real.arcsin_sin' h₁, real.cos_nonneg_of_mem_Icc h₁] },
  { rw [mem_Icc, not_and_distrib, not_le, not_le] at h₁, cases h₁,
    { replace hθ := hθ.1,
      have hcos : real.cos θ < 0,
      { rw [← neg_pos, ← real.cos_add_pi], refine real.cos_pos_of_mem_Ioo ⟨_, _⟩; linarith },
      have hsin : real.sin θ < 0 := real.sin_neg_of_neg_of_neg_pi_lt (by linarith) hθ,
      rw [if_neg, if_neg, ← real.sin_add_pi, real.arcsin_sin, add_sub_cancel];
        [linarith, linarith, exact hsin.not_le, exact hcos.not_le] },
    { replace hθ := hθ.2,
      have hcos : real.cos θ < 0 := real.cos_neg_of_pi_div_two_lt_of_lt h₁ (by linarith),
      have hsin : 0 ≤ real.sin θ := real.sin_nonneg_of_mem_Icc ⟨by linarith, hθ⟩,
      rw [if_neg, if_pos, ← real.sin_sub_pi, real.arcsin_sin, sub_add_cancel];
        [linarith, linarith, exact hsin, exact hcos.not_le] } }
end

lemma arg_cos_add_sin_mul_I {θ : ℝ} (hθ : θ ∈ Ioc (-π) π) :
  arg (cos θ + sin θ * I) = θ :=
by rw [← one_mul (_ + _), ← of_real_one, arg_mul_cos_add_sin_mul_I zero_lt_one hθ]

@[simp] lemma arg_zero : arg 0 = 0 := by simp [arg, le_refl]

lemma ext_abs_arg {x y : ℂ} (h₁ : x.abs = y.abs) (h₂ : x.arg = y.arg) : x = y :=
by rw [← abs_mul_exp_arg_mul_I x, ← abs_mul_exp_arg_mul_I y, h₁, h₂]

lemma ext_abs_arg_iff {x y : ℂ} : x = y ↔ abs x = abs y ∧ arg x = arg y :=
⟨λ h, h ▸ ⟨rfl, rfl⟩, and_imp.2 ext_abs_arg⟩

lemma arg_mem_Ioc (z : ℂ) : arg z ∈ Ioc (-π) π :=
begin
  have hπ : 0 < π := real.pi_pos,
  rcases eq_or_ne z 0 with (rfl|hz), simp [hπ, hπ.le],
  rcases exists_unique_add_zsmul_mem_Ioc real.two_pi_pos (arg z) (-π) with ⟨N, hN, -⟩,
  rw [two_mul, neg_add_cancel_left, ← two_mul, zsmul_eq_mul] at hN,
  rw [← abs_mul_cos_add_sin_mul_I z, ← cos_add_int_mul_two_pi _ N,
    ← sin_add_int_mul_two_pi _ N],
  simp only [← of_real_one, ← of_real_bit0, ← of_real_mul, ← of_real_add, ← of_real_int_cast],
  rwa [arg_mul_cos_add_sin_mul_I (abs_pos.2 hz) hN]
end

@[simp] lemma range_arg : range arg = Ioc (-π) π :=
(range_subset_iff.2 arg_mem_Ioc).antisymm (λ x hx, ⟨_, arg_cos_add_sin_mul_I hx⟩)

lemma arg_le_pi (x : ℂ) : arg x ≤ π :=
(arg_mem_Ioc x).2

lemma neg_pi_lt_arg (x : ℂ) : -π < arg x :=
(arg_mem_Ioc x).1

@[simp] lemma arg_nonneg_iff {z : ℂ} : 0 ≤ arg z ↔ 0 ≤ z.im :=
begin
  rcases eq_or_ne z 0 with (rfl|h₀), { simp },
  calc 0 ≤ arg z ↔ 0 ≤ real.sin (arg z) :
    ⟨λ h, real.sin_nonneg_of_mem_Icc ⟨h, arg_le_pi z⟩,
      by { contrapose!, intro h, exact real.sin_neg_of_neg_of_neg_pi_lt h (neg_pi_lt_arg _) }⟩
  ... ↔ _ : by rw [sin_arg, le_div_iff (abs_pos.2 h₀), zero_mul]
end

@[simp] lemma arg_neg_iff {z : ℂ} : arg z < 0 ↔ z.im < 0 :=
lt_iff_lt_of_le_iff_le arg_nonneg_iff

lemma arg_real_mul (x : ℂ) {r : ℝ} (hr : 0 < r) : arg (r * x) = arg x :=
begin
  rcases eq_or_ne x 0 with (rfl|hx), { rw mul_zero },
  conv_lhs { rw [← abs_mul_cos_add_sin_mul_I x, ← mul_assoc, ← of_real_mul,
    arg_mul_cos_add_sin_mul_I (mul_pos hr (abs_pos.2 hx)) x.arg_mem_Ioc] }
end

lemma arg_eq_arg_iff {x y : ℂ} (hx : x ≠ 0) (hy : y ≠ 0) :
  arg x = arg y ↔ (abs y / abs x : ℂ) * x = y :=
begin
  simp only [ext_abs_arg_iff, abs_mul, abs_div, abs_of_real, abs_abs,
    div_mul_cancel _ (abs_ne_zero.2 hx), eq_self_iff_true, true_and],
  rw [← of_real_div, arg_real_mul],
  exact div_pos (abs_pos.2 hy) (abs_pos.2 hx)
end

lemma arg_eq_arg_neg_add_pi_of_im_nonneg_of_re_neg {x : ℂ} (hxr : x.re < 0) (hxi : 0 ≤ x.im) :
  arg x = arg (-x) + π :=
have 0 ≤ (-x).re, from le_of_lt $ by simpa [neg_pos],
by rw [arg, arg, if_neg (not_le.2 hxr), if_pos this, if_pos hxi, abs_neg]

lemma arg_eq_arg_neg_sub_pi_of_im_neg_of_re_neg {x : ℂ} (hxr : x.re < 0) (hxi : x.im < 0) :
  arg x = arg (-x) - π :=
have 0 ≤ (-x).re, from le_of_lt $ by simpa [neg_pos],
by rw [arg, arg, if_neg (not_le.2 hxr), if_neg (not_le.2 hxi), if_pos this, abs_neg]

@[simp] lemma arg_one : arg 1 = 0 :=
by simp [arg, zero_le_one]

@[simp] lemma arg_neg_one : arg (-1) = π :=
by simp [arg, le_refl, not_le.2 (@zero_lt_one ℝ _ _)]

@[simp] lemma arg_I : arg I = π / 2 :=
by simp [arg, le_refl]

@[simp] lemma arg_neg_I : arg (-I) = -(π / 2) :=
by simp [arg, le_refl]

@[simp] lemma tan_arg (x : ℂ) : real.tan (arg x) = x.im / x.re :=
begin
  by_cases h : x = 0,
  { simp only [h, zero_div, complex.zero_im, complex.arg_zero, real.tan_zero, complex.zero_re] },
  rw [real.tan_eq_sin_div_cos, sin_arg, cos_arg h,
      div_div_div_cancel_right _ (abs_ne_zero.2 h)]
end

lemma arg_of_real_of_nonneg {x : ℝ} (hx : 0 ≤ x) : arg x = 0 :=
by simp [arg, hx]

lemma arg_eq_pi_iff {z : ℂ} : arg z = π ↔ z.re < 0 ∧ z.im = 0 :=
begin
  by_cases h₀ : z = 0, { simp [h₀, lt_irrefl, real.pi_ne_zero.symm] },
  split,
  { intro h, rw [← abs_mul_cos_add_sin_mul_I z, h], simp [h₀] },
  { cases z with x y, rintro ⟨h : x < 0, rfl : y = 0⟩,
    rw [← arg_neg_one, ← arg_real_mul (-1) (neg_pos.2 h)], simp [← of_real_def] }
end

lemma arg_of_real_of_neg {x : ℝ} (hx : x < 0) : arg x = π :=
arg_eq_pi_iff.2 ⟨hx, rfl⟩

lemma arg_eq_pi_div_two_iff {z : ℂ} : arg z = π / 2 ↔ z.re = 0 ∧ 0 < z.im :=
begin
  by_cases h₀ : z = 0, { simp [h₀, lt_irrefl, real.pi_div_two_pos.ne] },
  split,
  { intro h, rw [← abs_mul_cos_add_sin_mul_I z, h], simp [h₀] },
  { cases z with x y, rintro ⟨rfl : x = 0, hy : 0 < y⟩,
    rw [← arg_I, ← arg_real_mul I hy, of_real_mul', I_re, I_im, mul_zero, mul_one] }
end

lemma arg_eq_neg_pi_div_two_iff {z : ℂ} : arg z = - (π / 2) ↔ z.re = 0 ∧ z.im < 0 :=
begin
  by_cases h₀ : z = 0, { simp [h₀, lt_irrefl, real.pi_ne_zero] },
  split,
  { intro h, rw [← abs_mul_cos_add_sin_mul_I z, h], simp [h₀] },
  { cases z with x y, rintro ⟨rfl : x = 0, hy : y < 0⟩,
    rw [← arg_neg_I, ← arg_real_mul (-I) (neg_pos.2 hy), mk_eq_add_mul_I],
    simp }
end

lemma arg_of_re_nonneg {x : ℂ} (hx : 0 ≤ x.re) : arg x = real.arcsin (x.im / x.abs) :=
if_pos hx

lemma arg_of_re_neg_of_im_nonneg {x : ℂ} (hx_re : x.re < 0) (hx_im : 0 ≤ x.im) :
  arg x = real.arcsin ((-x).im / x.abs) + π :=
by simp only [arg, hx_re.not_le, hx_im, if_true, if_false]

lemma arg_of_re_neg_of_im_neg {x : ℂ} (hx_re : x.re < 0) (hx_im : x.im < 0) :
  arg x = real.arcsin ((-x).im / x.abs) - π :=
by simp only [arg, hx_re.not_le, hx_im.not_le, if_false]

lemma arg_of_im_nonneg_of_ne_zero {z : ℂ} (h₁ : 0 ≤ z.im) (h₂ : z ≠ 0) :
  arg z = real.arccos (z.re / abs z) :=
by rw [← cos_arg h₂, real.arccos_cos (arg_nonneg_iff.2 h₁) (arg_le_pi _)]

lemma arg_of_im_pos {z : ℂ} (hz : 0 < z.im) : arg z = real.arccos (z.re / abs z) :=
arg_of_im_nonneg_of_ne_zero hz.le (λ h, hz.ne' $ h.symm ▸ rfl)

lemma arg_of_im_neg {z : ℂ} (hz : z.im < 0) : arg z = -real.arccos (z.re / abs z) :=
begin
  have h₀ : z ≠ 0, from mt (congr_arg im) hz.ne,
  rw [← cos_arg h₀, ← real.cos_neg, real.arccos_cos, neg_neg],
  exacts [neg_nonneg.2 (arg_neg_iff.2 hz).le, neg_le.2 (neg_pi_lt_arg z).le]
end

section continuity

variables {x z : ℂ}

lemma arg_eq_nhds_of_re_pos (hx : 0 < x.re) : arg =ᶠ[𝓝 x] λ x, real.arcsin (x.im / x.abs) :=
((continuous_re.tendsto _).eventually (lt_mem_nhds hx)).mono $ λ y hy, arg_of_re_nonneg hy.le

lemma arg_eq_nhds_of_re_neg_of_im_pos (hx_re : x.re < 0) (hx_im : 0 < x.im) :
  arg =ᶠ[𝓝 x] λ x, real.arcsin ((-x).im / x.abs) + π :=
begin
  suffices h_forall_nhds : ∀ᶠ (y : ℂ) in (𝓝 x), y.re < 0 ∧ 0 < y.im,
    from h_forall_nhds.mono (λ y hy, arg_of_re_neg_of_im_nonneg hy.1 hy.2.le),
  refine is_open.eventually_mem _ (⟨hx_re, hx_im⟩ : x.re < 0 ∧ 0 < x.im),
  exact is_open.and (is_open_lt continuous_re continuous_zero)
    (is_open_lt continuous_zero continuous_im),
end

lemma arg_eq_nhds_of_re_neg_of_im_neg (hx_re : x.re < 0) (hx_im : x.im < 0) :
  arg =ᶠ[𝓝 x] λ x, real.arcsin ((-x).im / x.abs) - π :=
begin
  suffices h_forall_nhds : ∀ᶠ (y : ℂ) in (𝓝 x), y.re < 0 ∧ y.im < 0,
    from h_forall_nhds.mono (λ y hy, arg_of_re_neg_of_im_neg hy.1 hy.2),
  refine is_open.eventually_mem _ (⟨hx_re, hx_im⟩ : x.re < 0 ∧ x.im < 0),
  exact is_open.and (is_open_lt continuous_re continuous_zero)
    (is_open_lt continuous_im continuous_zero),
end

lemma arg_eq_nhds_of_im_neg (hz : im z < 0) :
  arg =ᶠ[𝓝 z] λ x, -real.arccos (x.re / abs x) :=
((continuous_im.tendsto _).eventually (gt_mem_nhds hz)).mono $ λ x, arg_of_im_neg

lemma continuous_at_arg (h : 0 < x.re ∨ x.im ≠ 0) : continuous_at arg x :=
begin
  have h₀ : abs x ≠ 0, { rw abs_ne_zero, rintro rfl, simpa using h },
  rw [← lt_or_lt_iff_ne] at h,
  rcases h with (hx_re|hx_im|hx_im),
  exacts [(real.continuous_at_arcsin.comp (continuous_im.continuous_at.div
    continuous_abs.continuous_at h₀)).congr (arg_eq_nhds_of_re_pos hx_re).symm,
    (real.continuous_arccos.continuous_at.comp (continuous_re.continuous_at.div
      continuous_abs.continuous_at h₀)).neg.congr (arg_eq_nhds_of_im_neg hx_im).symm,
    (real.continuous_arccos.continuous_at.comp (continuous_re.continuous_at.div
      continuous_abs.continuous_at h₀)).congr (arg_eq_nhds_of_im_pos hx_im).symm]
end

lemma tendsto_arg_nhds_within_im_neg_of_re_neg_of_im_zero
  {z : ℂ} (hre : z.re < 0) (him : z.im = 0) :
  tendsto arg (𝓝[{z : ℂ | z.im < 0}] z) (𝓝 (-π)) :=
begin
  suffices H :
    tendsto (λ x : ℂ, real.arcsin ((-x).im / x.abs) - π) (𝓝[{z : ℂ | z.im < 0}] z) (𝓝 (-π)),
  { refine H.congr' _,
    have : ∀ᶠ x : ℂ in 𝓝 z, x.re < 0, from continuous_re.tendsto z (gt_mem_nhds hre),
    filter_upwards [self_mem_nhds_within, mem_nhds_within_of_mem_nhds this],
    intros w him hre,
    rw [arg, if_neg hre.not_le, if_neg him.not_le] },
  convert (real.continuous_at_arcsin.comp_continuous_within_at
    ((continuous_im.continuous_at.comp_continuous_within_at continuous_within_at_neg).div
      continuous_abs.continuous_within_at _)).sub tendsto_const_nhds,
  { simp [him] },
  { lift z to ℝ using him, simpa using hre.ne }
end

lemma continuous_within_at_arg_of_re_neg_of_im_zero
  {z : ℂ} (hre : z.re < 0) (him : z.im = 0) :
  continuous_within_at arg {z : ℂ | 0 ≤ z.im} z :=
begin
  have : arg =ᶠ[𝓝[{z : ℂ | 0 ≤ z.im}] z] λ x, real.arcsin ((-x).im / x.abs) + π,
  { have : ∀ᶠ x : ℂ in 𝓝 z, x.re < 0, from continuous_re.tendsto z (gt_mem_nhds hre),
    filter_upwards [self_mem_nhds_within, mem_nhds_within_of_mem_nhds this],
    intros w him hre,
    rw [arg, if_neg hre.not_le, if_pos him] },
  refine continuous_within_at.congr_of_eventually_eq _ this _,
  { refine (real.continuous_at_arcsin.comp_continuous_within_at
      ((continuous_im.continuous_at.comp_continuous_within_at continuous_within_at_neg).div
        continuous_abs.continuous_within_at _)).add tendsto_const_nhds,
    lift z to ℝ using him, simpa using hre.ne },
  { rw [arg, if_neg hre.not_le, if_pos him.ge] }
end

lemma tendsto_arg_nhds_within_im_nonneg_of_re_neg_of_im_zero
  {z : ℂ} (hre : z.re < 0) (him : z.im = 0) :
  tendsto arg (𝓝[{z : ℂ | 0 ≤ z.im}] z) (𝓝 π) :=
by simpa only [arg_eq_pi_iff.2 ⟨hre, him⟩]
  using (continuous_within_at_arg_of_re_neg_of_im_zero hre him).tendsto

end continuity

end complex


variables (men : Type) (barber : men)
variable  (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
  have ¬ shaves barber barber, from (
    assume barber_shaves_self: shaves barber barber,
    have ¬ shaves barber barber, from (h barber).mp barber_shaves_self,
    absurd barber_shaves_self ‹ ¬ shaves barber barber ›
  ),
  have shaves barber barber, from (h barber).mpr ‹ ¬ shaves barber barber ›,
  absurd this ‹ ¬  shaves barber barber ›


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Aaron Anderson.
-/

import data.nat.totient
import number_theory.quadratic_reciprocity
import number_theory.lucas_lehmer
import multiplicity_vectors

/-
# Perfect Numbers

## Notations

## Implementation Notes
I have used pnats in this version most of the time.

## References
https://en.wikipedia.org/wiki/Euclid%E2%80%93Euler_theorem
-/

open_locale classical
open_locale big_operators

section definitions

variable (n : ℕ+)

/--
The finset of (positive) divisors of n
-/
def divisors : finset ℕ+ := (pnat.Ico 1 (n + 1)).filter (λ x : ℕ+, x ∣ n)

/--
The finset of proper (positive) divisors of n
-/
def proper_divisors : finset ℕ+ := (pnat.Ico 1 n).filter (λ x : ℕ+, x ∣ n)

lemma not_proper_self : ¬ n ∈ proper_divisors n := by simp [proper_divisors]

variable {n}
lemma pnat.le_of_dvd {m : ℕ+} : m ∣ n → m ≤ n :=
by { rw pnat.dvd_iff', intro h, rw ← h, apply (pnat.mod_le n m).left }

@[simp]
lemma mem_divisors {m : ℕ+} : m ∈ divisors n ↔ m ∣ n :=
begin
  rw divisors,
  simp only [true_and, pnat.one_le, pnat.Ico.mem, finset.mem_filter],
  split, intro hyp, exact hyp.right,
  intro hyp, split, swap, exact hyp,
  rw pnat.lt_add_one_iff, apply pnat.le_of_dvd hyp
end

lemma divisor_le {m : ℕ+}:
m ∈ divisors n → m ≤ n := by {rw mem_divisors, exact pnat.le_of_dvd}

@[simp]
lemma mem_proper_divisors {m : ℕ+} : m ∈ proper_divisors n ↔ m ∣ n ∧ m ≠ n :=
begin
  rw proper_divisors,
  simp only [true_and, pnat.one_le, ne.def, pnat.Ico.mem, finset.mem_filter],
  split, intro hyp, split, exact hyp.right,
  { intro contra, rw contra at hyp, apply lt_irrefl n hyp.left },
  { intro hyp, split, swap, exact hyp.left, apply lt_of_le_of_ne,
    apply pnat.le_of_dvd hyp.left, apply hyp.right }
end

variable (n)

----pnat.dvd_refl should be a simp lemma!
lemma divisors_eq_proper_divisors_insert_self :
  divisors n = has_insert.insert n (proper_divisors n) :=
begin
  ext, rw [finset.mem_insert, mem_divisors, mem_proper_divisors], split,
  { intro hdvd, by_cases a = n, left, exact h,
    right, split, exact hdvd, exact h },
  { intro hyp, cases hyp, rw hyp, apply pnat.dvd_refl, apply hyp.left }
end

def sum_divisors : ℕ := ∑ i in divisors n, i

def sum_proper_divisors : ℕ := ∑ i in proper_divisors n, i

lemma sum_divisors_eq_sum_proper_divisors_add_self :
  sum_divisors n = sum_proper_divisors n + n :=
begin
  rw sum_divisors,
  rw sum_proper_divisors,
  rw divisors_eq_proper_divisors_insert_self,
  rw finset.sum_insert, rw add_comm,
  apply not_proper_self
end

/--
A perfect number is one that is equal to the sum of its proper divisors
-/
def perfect : Prop := sum_proper_divisors n = n

end definitions

section basic_lemmas

---- should two_mul be a simp lemma?
lemma perfect_iff_sum_divisors_twice {n : ℕ+} : perfect n ↔ sum_divisors n = 2 * n :=
begin
  rw sum_divisors_eq_sum_proper_divisors_add_self,
  rw perfect, rw two_mul, simp
end

@[simp]
lemma divisors_one : divisors 1 = ({1} : finset ℕ+) :=
by { ext, rw mem_divisors, simp [pnat.dvd_one_iff] } ---  pnat.dvd_one_iff should be a simp lemma

@[simp]
lemma mem_one_divisors {n : ℕ+}: (1 : ℕ+) ∈ divisors n :=
by { rw mem_divisors, apply pnat.one_dvd }

lemma mem_self_divisors {n : ℕ+} : n ∈ divisors n :=
by { rw mem_divisors, apply pnat.dvd_refl }

lemma pos_sum_divisors {n : ℕ+} : 0 < sum_divisors n :=
begin
  unfold sum_divisors,
  have h : ∑ i in divisors n, 0 = 0, rw finset.sum_eq_zero_iff, simp,
  rw ← h,
  apply finset.sum_lt_sum, simp,
  existsi (1 : ℕ+), simp only [nat.succ_pos', exists_prop, and_true],
  simp
end

@[simp]
lemma divisors_pow_prime {p : ℕ+} (pp : p.prime) (k : ℕ)  {x : ℕ+} :
  x ∈ divisors (p ^ k) ↔  ∃ (j : ℕ) (H : j ≤ k), x = p ^ j :=
begin
  rw mem_divisors,
  rw pnat.dvd_iff, simp only [pnat.pow_coe],
  --rw nat.primes.coe_pnat_nat, -- simp this?
  --change ↑x ∣ p.val ^ k ↔ ∃ (j : ℕ) (H : j ≤ k), x = p ^ j, --changing ↑ to .val is a pain
  rw nat.dvd_prime_pow pp,
  split; intro h; cases h; cases h_h; existsi h_w; existsi h_h_w,
  { apply pnat.eq, rw h_h_h, simp only [nat.primes.coe_pnat_nat, pnat.pow_coe] },   --- pnat.eq? not coe_inj?
  { rw h_h_h, simp only [nat.primes.coe_pnat_nat, pnat.pow_coe] }
end

lemma divisors_pow_prime_insert {p : ℕ+} (pp : p.prime) (k : ℕ)  :
  divisors (p ^ (k + 1)) = has_insert.insert (p ^ (k + 1)) (divisors (p ^ k)) :=
begin
  ext,
  simp [divisors_pow_prime pp],
  split,
  { intro h, cases h, cases h_h,
    by_cases h_w = k + 1,
    { left, rw h at h_h_right, exact h_h_right },
    { right, existsi h_w, split, omega, exact h_h_right }
  },
  { intro h, cases h, existsi k + 1, tauto,
    cases h, existsi h_w, split, linarith, exact h_h.right }
end

@[simp]
lemma add_one_sub_one_prime {p : ℕ+} (pp : p.prime): (p : ℕ) - 1 + 1 = p :=
by { apply nat.succ_pred_prime pp }

lemma pnat.mul_lt_mul_left (a : ℕ+) {b c : ℕ+}: b < c → a * b < a * c :=
begin
  intro bc,
  apply nat.mul_lt_mul_of_pos_left, apply bc, apply a.property,
end

lemma pnat.mul_lt_mul_right (a : ℕ+) {b c : ℕ+}: b < c → b * a < c * a :=
begin
  intro bc,
  apply nat.mul_lt_mul_of_pos_right, apply bc, apply a.property,
end

lemma pnat.prime.one_lt {p : ℕ+} : p.prime → 1 < p := nat.prime.one_lt

lemma sum_divisors_pow_prime {p : ℕ+} (pp : p.prime) (k : ℕ)  :
  sum_divisors (p ^ k) * (p - 1)= (p ^ (k + 1) - 1) :=
begin
  rw sum_divisors,
  induction k, simp,
  rw divisors_pow_prime_insert pp,
  rw finset.sum_insert,
  { rw add_mul, rw k_ih,
    rw nat.pow_succ p (k_n.succ), rw nat.succ_eq_add_one,
    rw ← nat.add_sub_assoc,
    { refine congr (congr rfl _) rfl,
    have h := add_one_sub_one_prime pp,
    conv_rhs {rw ← h, rw mul_add, rw h}, simp },
    { rw ← pnat.one_coe, rw ← pnat.pow_coe, rw pnat.coe_le_coe, apply pnat.one_le }
  },
  { intro contra, have h := divisor_le contra,
    have g1 :=  pnat.mul_lt_mul_right (p ^ k_n) (pnat.prime.one_lt pp),
    rw pow_succ at h, rw one_mul at g1, apply not_lt_of_ge h g1, -- linarith for nats
  }
end

lemma sum_divisors_prime {p : ℕ+} (pp : p.prime) : sum_divisors p = p + 1 :=
begin
  have h1 := sum_divisors_pow_prime pp 1,
  rw pow_one at h1, --- had to switch which pow, lol
  have h2 : ((p + 1) * (p - 1) : ℕ) = p ^ 2 - 1, -- have to make type declarations
  { rw nat.mul_sub_left_distrib, repeat {rw add_mul},
    rw nat.pow_two, simp only [mul_one, one_mul],
    rw add_comm, rw nat.add_sub_add_left },
  rw ← h2 at h1,
  apply nat.eq_of_mul_eq_mul_right _ h1,
  apply nat.prime.pred_pos pp
end

lemma pnat.prime_two : (2 : ℕ+).prime := nat.prime_two

lemma sum_divisors_pow_two (k : ℕ) : sum_divisors (2 ^ k) = (2 ^ (k + 1) - 1) :=
begin
  have h := sum_divisors_pow_prime pnat.prime_two k,
  change sum_divisors (2 ^ k) * (2 - 1) = 2 ^ (k + 1) - 1 at h, -- couldn't find anything to do but change
  rw mul_one at h,
  apply h,
end

lemma odd_sum_divisors_pow_two (k : ℕ) : ¬ has_dvd.dvd 2 (sum_divisors (2 ^ k)) :=
begin
  rw sum_divisors_pow_two k,
  intro contra,
  have h : 2 ∣ 2 ^ (k + 1) - 1 + 1,
  { existsi 2 ^ k,
    rw [← nat.pred_eq_sub_one, ← nat.succ_eq_add_one, nat.succ_pred_eq_of_pos _],
    { rw [mul_comm, nat.pow_succ] },
    apply nat.pos_pow_of_pos, omega,
  },
  rw ← nat.dvd_add_iff_right contra at h,
  have h:= nat.le_of_dvd _ h; linarith,
end

@[simp]
lemma pnat.coe_eq_one_iff {m : ℕ+} :
(m : ℕ) = 1 ↔ m = 1 := by { split; intro h; try { apply pnat.eq}; rw h; simp }

@[simp]
lemma pnat.eq_iff {m n : ℕ+} :
(m : ℕ) = ↑n ↔ m = n := by { split, apply pnat.eq, intro h, rw h }

lemma pnat.dvd_prime {p m : ℕ+} (pp : p.prime) :
(m ∣ p ↔ m = 1 ∨ m = p) := by { rw pnat.dvd_iff, rw nat.dvd_prime pp, simp }

lemma divisors_prime {p : ℕ+} (pp : p.prime) : divisors p = {p, 1} :=
begin
  ext,
  simp only [mem_divisors, ne.def, finset.mem_insert, finset.mem_singleton],
  split; intro h, rw pnat.dvd_prime pp at h, apply h.symm,
  cases h; rw h, apply pnat.dvd_refl, apply pnat.one_dvd
end

lemma card_pair_eq_two {α : Type} {x y : α} (neq : x ≠ y) : ({x, y} : finset α).card = 2 :=
begin
  rw finset.card_insert_of_not_mem, rw finset.card_singleton, rw finset.mem_singleton, apply neq,
end

----why can't I use the above????
lemma pnat.card_pair_eq_two {x y : ℕ+} (neq : x ≠ y) : ({x, y} : finset ℕ+).card = 2 :=
begin
  rw finset.card_insert_of_not_mem, rw finset.card_singleton, rw finset.mem_singleton, apply neq,
end

lemma pnat.prime.ne_one {p : ℕ+} : p.prime → p ≠ 1 :=
by { intro pp, intro contra, apply nat.prime.ne_one pp, rw pnat.coe_eq_one_iff, apply contra }

lemma pnat.eq_one_of_lt_two {n : ℕ+} : n < 2 → n = 1 :=
begin
  intro h, apply le_antisymm, swap, apply pnat.one_le,
  change n < 1 + 1 at h, rw pnat.lt_add_one_iff at h, apply h
end

@[simp]
lemma pnat.one_val : (1 : ℕ+).val = 1 := rfl

@[simp]
lemma pnat.not_prime_one : ¬ (1: ℕ+).prime :=  nat.not_prime_one

lemma pnat.prime.not_dvd_one {p : ℕ+} :
p.prime →  ¬ p ∣ 1 := λ pp : p.prime, nat.prime.not_dvd_one pp

lemma pnat.exists_prime_and_dvd {n : ℕ+} : 2 ≤ n → (∃ (p : ℕ+), p.prime ∧ p ∣ n) :=
begin
  intro h, cases nat.exists_prime_and_dvd h with p hp,
  existsi (⟨p, nat.prime.pos hp.left⟩ : ℕ+), apply hp
end

lemma prime_iff_two_divisors {n : ℕ+} : n.prime ↔ (divisors n).card = 2 :=
begin
  split,
  { intro np, rw divisors_prime np, apply pnat.card_pair_eq_two (pnat.prime.ne_one np),},
  { intro h,
    have ge2 : 2 ≤ n,
    { contrapose h, simp at h, have  h' := pnat.eq_one_of_lt_two h, rw h',
      simp only [divisors_one, finset.card_singleton], omega },
    have ex := pnat.exists_prime_and_dvd ge2, cases ex with p hp,
    have subs : {n, (1 : ℕ+)} ⊆ divisors n,
    { rw finset.subset_iff, intro x, simp only [finset.mem_insert, finset.mem_singleton],
      intro h, cases h; rw h_1, apply mem_self_divisors, apply mem_one_divisors },
    have seteq : {n, (1 : ℕ+)} = divisors n,
    { apply finset.eq_of_subset_of_card_le subs _, rw h, rw pnat.card_pair_eq_two _,
      contrapose hp, simp only [classical.not_not] at hp, rw hp,
      simp only [not_and], apply pnat.prime.not_dvd_one },
    have pdvd : p ∈ divisors n, rw mem_divisors, apply hp.right,
    rw ← seteq at pdvd, simp only [finset.mem_insert, finset.mem_singleton] at pdvd,
    cases pdvd, rw ← pdvd, apply hp.left,
    exfalso, rw pdvd at hp, apply nat.not_prime_one hp.left
  }
end

lemma subset_eq_divisors_of_sum_eq_sum {n : ℕ+} {s : finset ℕ+} (hsub: ∀ (x : ℕ+), x ∈ s → x ∣ n) :
  ∑ i in s, ↑i = sum_divisors n → s = divisors n :=
begin
  have subs : s ⊆ divisors n,
  { rw finset.subset_iff, intros x hx, rw mem_divisors, apply (hsub x hx) },
  intro h,
  apply finset.subset.antisymm subs _,
  contrapose h, rw finset.subset_iff at h, simp only [classical.not_forall, classical.not_imp] at h,
  intro contra, apply nat.lt_irrefl (s.sum (coe : ℕ+ → ℕ)),
  cases h with x hx, rw mem_divisors at hx,
  --have posx : 0 < id x,
  --{ rw id.def, apply nat.pos_of_ne_zero, intro contra, apply nonzero,
  --  rw contra at hx, apply nat.eq_zero_of_zero_dvd,
  --  rw mem_divisors at hx, apply hx.left.left },
  have h : s.sum coe < (divisors n).sum coe :=
    (finset.sum_lt_sum_of_subset subs) (by simpa) (pnat.pos x) (by simp),
    rw sum_divisors at contra, simp only [id.def] at h, rw ← contra at h, apply h,
end

lemma prime_and_one_of_sum_two_divisors_eq_sum_divisors {x y : ℕ+} (hneq : x ≠ y) (hdvd : y ∣ x) (hsum : ↑(x + y) = sum_divisors x) :
  x.prime ∧ y = 1 :=
begin
  have hdivs : {x, y} = divisors x,
  { apply subset_eq_divisors_of_sum_eq_sum,
    { intro z, simp only [finset.mem_insert, finset.mem_singleton], intro h,
      cases h; rw h, refl, apply hdvd },
    { rw ← hsum, apply finset.sum_pair hneq } },
  have card2 := pnat.card_pair_eq_two hneq, rw hdivs at card2, rw ← prime_iff_two_divisors at card2,
  split, apply card2,
  rw divisors_prime card2 at hdivs,
  have memy : y ∈ ({x, y} : finset ℕ+), simp,
  rw hdivs at memy, simp only [finset.mem_insert, finset.mem_singleton] at memy,
  cases memy, exfalso, apply hneq, symmetry, apply memy,
  apply memy
end

--def pnat.coprime (m n : ℕ+) : Prop := m.gcd n = 1

@[simp]
def pnat.coprime_coe {m n : ℕ+} : nat.coprime ↑m ↑n ↔ m.coprime n :=
by { unfold pnat.coprime, unfold nat.coprime, rw ← pnat.eq_iff, simp }

lemma pnat.gcd_eq_left_iff_dvd {m n : ℕ+} : m ∣ n ↔ m.gcd n = m :=
by { rw pnat.dvd_iff, rw nat.gcd_eq_left_iff_dvd, rw ← pnat.eq_iff, simp }

lemma pnat.coprime.gcd_mul_right_cancel (m : ℕ+) {n k : ℕ+} :
  k.coprime n → (m * k).gcd n = m.gcd n :=
begin
  intro h, apply pnat.eq, simp only [pnat.gcd_coe, pnat.mul_coe],
  apply nat.coprime.gcd_mul_right_cancel, simpa
end

lemma pnat.gcd_comm {m n : ℕ+} : m.gcd n = n.gcd m :=
by { apply pnat.eq, simp only [pnat.gcd_coe], apply nat.gcd_comm }

lemma pnat.coprime.symm {m n : ℕ+} : m.coprime n → n.coprime m :=
by { unfold pnat.coprime, rw pnat.gcd_comm, simp }

lemma pnat.coprime.coprime_dvd_left {m k n : ℕ+} :
  m ∣ k → k.coprime n → m.coprime n :=
by { rw pnat.dvd_iff, repeat {rw ← pnat.coprime_coe}, apply nat.coprime.coprime_dvd_left }

lemma coprime_factor_eq_gcd_left {a b m n : ℕ+} (cop : m.coprime n) (am : a ∣ m) (bn : b ∣ n):
  a = (a * b).gcd m :=
begin
  rw pnat.gcd_eq_left_iff_dvd at am,
  conv_lhs {rw ← am}, symmetry,
  apply pnat.coprime.gcd_mul_right_cancel a,
  apply pnat.coprime.coprime_dvd_left bn cop.symm,
end

lemma pnat.coprime.gcd_mul (k : ℕ+) {m n : ℕ+} (h: m.coprime n) :
  k.gcd (m * n) = k.gcd m * k.gcd n :=
begin
  rw ← pnat.coprime_coe at h, apply pnat.eq,
  simp only [pnat.gcd_coe, pnat.mul_coe], apply nat.coprime.gcd_mul k h
end

lemma pnat.gcd_eq_left {m n : ℕ+} : m ∣ n → m.gcd n = m :=
by { rw pnat.dvd_iff, intro h, apply pnat.eq, simp only [pnat.gcd_coe], apply nat.gcd_eq_left h }

lemma sum_divisors_multiplicative (m n : ℕ+) :
  m.coprime n → sum_divisors (m * n) = (sum_divisors m) * (sum_divisors n) :=
begin
  intro cop,
  repeat {rw sum_divisors},
  rw finset.sum_mul_sum,
  symmetry,
  apply finset.sum_bij (λ x : ℕ+ × ℕ+, λ (h : x ∈ _), x.fst * x.snd),
  { simp only [prod.forall], intros a b hab, dsimp, simp only [finset.mem_product] at hab,
    repeat {rw mem_divisors at hab}, rw mem_divisors,
    apply mul_dvd_mul hab.left hab.right },
  { simp only [prod.forall], intros a b hab, dsimp, simp only [finset.mem_product] at hab },
  { simp only [prod.forall], intros a b c hab h1 h2,
    dsimp at *, rw finset.mem_product at *, repeat {rw mem_divisors at *},
    ext; dsimp,
    { transitivity (a * b).gcd m,
      { apply coprime_factor_eq_gcd_left cop hab.left hab.right },
      { rw h2, symmetry, apply coprime_factor_eq_gcd_left cop h1.left h1.right } },
    { transitivity (b * a).gcd n,
      { apply coprime_factor_eq_gcd_left cop.symm hab.right hab.left },
      { rw mul_comm, rw h2, rw mul_comm, symmetry,
      apply coprime_factor_eq_gcd_left cop.symm h1.right h1.left } } },
  { simp only [exists_prop, prod.exists, finset.mem_product],
    intros c hc,
    existsi c.gcd m, existsi c.gcd n, split,
    { split; rw mem_divisors; apply nat.gcd_dvd_right _, },
    { rw ← pnat.coprime.gcd_mul c cop,
      symmetry, apply pnat.gcd_eq_left,
      rw mem_divisors at hc, apply hc } }
end

end basic_lemmas

section mersenne_to_perfect

/--
A version of ``mersenne'' from number_theory/lucas_lehmer for pnats
-/
def pmersenne (p : ℕ+) : ℕ+ := ⟨ mersenne p, mersenne_pos p.pos ⟩

def nat.mersenne_succ (n : ℕ) : ℕ+ := ⟨mersenne (n + 1), mersenne_pos n.succ_pos⟩

@[simp]
lemma pmersenne_val (p : ℕ+) : ↑(pmersenne p) = mersenne (↑ p) := rfl

/-
theorem two_le_exponent_of_prime_mersenne {p : ℕ+} : nat.prime (pmersenne p) → 2 ≤ p :=
begin
  intro np,
  cases p, cases p_val, exfalso, apply lt_irrefl 0 p_property,
  cases p_val,
  { exfalso, simp only [mersenne, pnat.mk_one, nat.succ_sub_succ_eq_sub,
    pmersenne_val, pnat.one_coe, nat.sub_zero, nat.pow_one] at np,
    apply nat.not_prime_one np },
  { rw ← pnat.coe_le_coe, simp only [pnat.mk_coe, pnat.coe_bit0, pnat.one_coe],
    apply nat.succ_le_succ, apply nat.succ_le_succ, apply nat.zero_le }
end
-/

theorem two_le_exponent_of_prime_mersenne {p : ℕ} : nat.prime (2 ^ p - 1) → 2 ≤ p :=
begin
  intro np, -- rw mersenne at np,
  cases p, exfalso, apply nat.not_prime_zero np,
  cases p, exfalso, apply nat.not_prime_one np,
  omega
end

/--
Euclid's theorem that Mersenne primes induce perfect numbers
-/
theorem mersenne_to_perfect (p : ℕ+) :
  (pmersenne p).prime → perfect ((2 ^ (↑p - 1)) * (pmersenne p)) :=
begin
  intro mp,
  have hp : 2 ≤ p := two_le_exponent_of_prime_mersenne mp,
  rw [perfect_iff_sum_divisors_twice, sum_divisors_multiplicative],
  { rw [sum_divisors_pow_two, sum_divisors_prime mp],
    repeat {rw ← nat.pred_eq_sub_one},
    repeat {rw ← nat.succ_eq_add_one},
    have pps : (p : ℕ).pred.succ = p := nat.succ_pred_eq_of_pos p.property,
    rw pps, simp only [pnat.coe_bit0, pnat.mul_coe, pmersenne_val, pnat.one_coe, pnat.pow_coe],
    rw [← mul_assoc, mul_comm],
    refine congr (congr rfl _) rfl,
    rw [← pps, mersenne, nat.pred_succ, nat.pow_succ, mul_comm,
      ← nat.pred_eq_sub_one, nat.succ_pred_eq_of_pos ],
    apply nat.mul_pos, omega, apply nat.pow_pos, omega },
  { have h := pow_one (pmersenne p),
    rw [← h, ← pnat.coprime_coe, pnat.pow_coe, pnat.pow_coe],
    apply nat.coprime_pow_primes _ _ nat.prime_two mp _,
    apply ne_of_lt,
    simp only [pmersenne_val, mersenne],
    rw [← nat.pred_eq_sub_one, ← nat.pred_succ 2],
    apply nat.pred_lt_pred, omega,
    rw nat.pred_succ 2,
    change 2 ^ 2 ≤ 2 ^ ↑p,
    apply nat.pow_le_pow_of_le_right, omega, apply hp }
end

end mersenne_to_perfect

section perfect_to_mersenne

/--
  Euler's proof that all even perfect numbers come from Mersenne primes
-/
theorem even_perfect_to_mersenne {n : ℕ+} (even : 2 ∣ n) (perf : perfect n):
  ∃ (k : ℕ), n = (2 ^ k) * k.mersenne_succ ∧ k.mersenne_succ.prime :=
begin
  let k := (factorisation n) two_prime, existsi k,
  let x := odd_part n,
  have hxk : x * 2 ^ k = n := (pow_mult_odd_part_eq_self n),
  --change  at hxk,
  have posk : 0 < k, rw ← prime_dvd_iff_factorisation_pos, apply even,

  have hiff : n = 2 ^ k * k.mersenne_succ ↔ 2 * n = 2 * (2 ^ k * k.mersenne_succ),
  { split; intro h, rw h, apply mul_left_cancel h },
  rw [hiff, ← mul_assoc, ← pow_succ (2 : ℕ+)],

  rw perfect_iff_sum_divisors_twice at perf,
  rw ← pnat.eq_iff, simp only [pnat.coe_bit0, pnat.mul_coe, pnat.one_coe, pnat.pow_coe],
  rw ← perf,
  rw ← hxk at perf,
  change sum_divisors (x * 2 ^ k) = 2 * ↑(x * 2 ^ k) at perf,
  rw sum_divisors_multiplicative at perf, swap, apply pnat.coprime.symm (coprime_pow_odd_part posk),
  symmetry' at perf,

  rw hxk at perf,
  have dvd2n : sum_divisors (2 ^ k) ∣ 2 * n, {existsi (sum_divisors x), rw perf, rw mul_comm},
  have dvdn : sum_divisors (2 ^ k) ∣ n,
  { apply nat.coprime.dvd_of_dvd_mul_left (nat.coprime.symm _) dvd2n,
    rw nat.prime.coprime_iff_not_dvd nat.prime_two, apply odd_sum_divisors_pow_two k },
  have dvdx : sum_divisors (2 ^ k) ∣ x := dvd_odd_part_of_odd_dvd dvdn (odd_sum_divisors_pow_two k),
  let y := x / sum_divisors (2 ^ k),
  have ysdpow : y * sum_divisors (2 ^ k) = x := pnat.mul_div_exact dvdx,

  rw ← hxk at perf,
  change 2 * (x * 2 ^ k) = sum_divisors x * sum_divisors (2 ^ k) at perf,
  rw mul_comm at perf,
  rw mul_assoc at perf,
  rw ← nat.pow_succ 2 k at perf,
  rw ← ysdpow at perf,
  rw mul_comm at perf,
  rw ← mul_assoc at perf,
  have h := pnat.mul_right_cancel perf,
  rw ysdpow at *,

  have xneqy : x ≠ y,
  { symmetry, rw ← ysdpow, rw sum_divisors_pow_two, rw ← mul_one y, rw mul_assoc, rw one_mul,
    intro contra, have h := nat.eq_of_mul_eq_mul_left _ contra,
    { have h'' := nat.le_succ_of_pred_le (nat.le_of_eq h.symm),
      have h' := nat.pow_lt_pow_of_lt_right (by omega : 2 > 1) posk,
      change 2 ^ k * 2 ≤ 2 * 1 at h'', rw mul_comm at h'',
      have h3 :=  nat.le_of_mul_le_mul_left h'' (nat.prime.pos nat.prime_two),
      rw nat.pow_zero at h', linarith },
    { by_cases y = 0, swap, apply nat.pos_of_ne_zero h,
      rw h at ysdpow, rw zero_mul at ysdpow, rw ← ysdpow at hxk, rw zero_mul at hxk,
      exfalso, rw hxk at posn, linarith } },
  have hxy : x.prime ∧ y = 1,
  { apply prime_and_one_of_sum_two_divisors_eq_sum_divisors xnonzero xneqy _, swap,
    { existsi sum_divisors (2 ^ k), rw ysdpow },
    rw [← h, ← ysdpow, sum_divisors_pow_two],
    have powpos : 2 ^ k.succ > 0, apply nat.pos_pow_of_pos, linarith,
    symmetry, rw ← nat.succ_pred_eq_of_pos powpos, rw nat.succ_eq_add_one, rw add_mul,
    simp only [nat.add_succ_sub_one, add_zero, one_mul, add_left_inj], rw mul_comm },

  have xeq : x = sum_divisors (2 ^ k), rw ← ysdpow, rw hxy.right, simp,
  have xp : x.prime := hxy.left,

  split, swap, rw sum_divisors_pow_two at xeq, rw ← xeq, apply xp,
  rw ← (pow_fin_mult_coprime_part_eq_self nat.prime_two posn),
  rw sum_divisors_multiplicative, swap,
  { apply nat.prime.coprime_pow_of_not_dvd nat.prime_two (not_dvd_coprime_part nat.prime_two posn)},
  rw [sum_divisors_prime xp, xeq, sum_divisors_pow_two],
  refine congr (congr rfl _) rfl,
  apply nat.succ_pred_eq_of_pos, simp only [nat.nat_zero_eq_zero, gt_iff_lt],
  apply nat.pos_pow_of_pos (k + 1) (nat.prime.pos nat.prime_two)
end

end perfect_to_mersenne

section perfect_iff_mersenne

/--
The Euclid-Euler Theorem, characterizing perfect numbers in terms of Mersenne primes
-/
theorem even_perfect_iff_mersenne {n : ℕ+}:
  2 ∣ n ∧ perfect n ↔ ∃ (p : ℕ+), n = (2 ^ (↑p - 1)) * (pmersenne p) ∧ (pmersenne p).prime :=
begin
  split, intro even_perf, exact even_perfect_to_mersenne even_perf.left even_perf.right,
  intro h, cases h with p hp, rw hp.left, split, swap, apply mersenne_to_perfect p hp.right,
  rw nat.prime.dvd_mul nat.prime_two, left,
  rw nat.dvd_prime_pow nat.prime_two, existsi 1,
  simp only [exists_prop, and_true, eq_self_iff_true, nat.pow_one],
  have gt2 := two_le_exponent_of_prime_mersenne hp.right, omega
end

end perfect_iff_mersenne


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/

import set_theory.game.ordinal
import set_theory.ordinal.natural_ops

/-!
# Birthdays of games

The birthday of a game is an ordinal that represents at which "step" the game was constructed. We
define it recursively as the least ordinal larger than the birthdays of its left and right games. We
prove the basic properties about these.

# Main declarations

- `pgame.birthday`: The birthday of a pre-game.

# Todo

- Define the birthdays of `game`s and `surreal`s.
- Characterize the birthdays of basic arithmetical operations.
-/

universe u

open ordinal

open_locale natural_ops pgame

namespace pgame

/-- The birthday of a pre-game is inductively defined as the least strict upper bound of the
birthdays of its left and right games. It may be thought as the "step" in which a certain game is
constructed. -/
noncomputable def birthday : pgame.{u} → ordinal.{u}
| ⟨xl, xr, xL, xR⟩ :=
    max (lsub.{u u} $ λ i, birthday (xL i)) (lsub.{u u} $ λ i, birthday (xR i))

theorem birthday_def (x : pgame) : birthday x = max
  (lsub.{u u} (λ i, birthday (x.move_left i)))
  (lsub.{u u} (λ i, birthday (x.move_right i))) :=
by { cases x, rw birthday, refl }

theorem birthday_move_left_lt {x : pgame} (i : x.left_moves) :
  (x.move_left i).birthday < x.birthday :=
by { cases x, rw birthday, exact lt_max_of_lt_left (lt_lsub _ i) }

theorem birthday_move_right_lt {x : pgame} (i : x.right_moves) :
  (x.move_right i).birthday < x.birthday :=
by { cases x, rw birthday, exact lt_max_of_lt_right (lt_lsub _ i) }

theorem lt_birthday_iff {x : pgame} {o : ordinal} : o < x.birthday ↔
  (∃ i : x.left_moves, o ≤ (x.move_left i).birthday) ∨
  (∃ i : x.right_moves, o ≤ (x.move_right i).birthday) :=
begin
  split,
  { rw birthday_def,
    intro h,
    cases lt_max_iff.1 h with h' h',
    { left,
      rwa lt_lsub_iff at h' },
    { right,
      rwa lt_lsub_iff at h' } },
  { rintro (⟨i, hi⟩ | ⟨i, hi⟩),
    { exact hi.trans_lt (birthday_move_left_lt i) },
    { exact hi.trans_lt (birthday_move_right_lt i) } }
end

theorem relabelling.birthday_congr : ∀ {x y : pgame.{u}}, x ≡r y → birthday x = birthday y
| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ r := begin
  unfold birthday,
  congr' 1,
  all_goals
  { apply lsub_eq_of_range_eq.{u u u},
    ext i, split },
  all_goals { rintro ⟨j, rfl⟩ },
  { exact ⟨_, (r.move_left j).birthday_congr.symm⟩ },
  { exact ⟨_, (r.move_left_symm j).birthday_congr⟩ },
  { exact ⟨_, (r.move_right j).birthday_congr.symm⟩ },
  { exact ⟨_, (r.move_right_symm j).birthday_congr⟩ }
end
using_well_founded { dec_tac := pgame_wf_tac }

@[simp] theorem birthday_eq_zero {x : pgame} :
  birthday x = 0 ↔ is_empty x.left_moves ∧ is_empty x.right_moves :=
by rw [birthday_def, max_eq_zero, lsub_eq_zero_iff, lsub_eq_zero_iff]

@[simp] theorem birthday_zero : birthday 0 = 0 :=
by simp [pempty.is_empty]

@[simp] theorem birthday_one : birthday 1 = 1 :=
by { rw birthday_def, simp }

@[simp] theorem birthday_star : birthday star = 1 :=
by { rw birthday_def, simp }

@[simp] theorem neg_birthday : ∀ x : pgame, (-x).birthday = x.birthday
| ⟨xl, xr, xL, xR⟩ := begin
  rw [birthday_def, birthday_def, max_comm],
  congr; funext; apply neg_birthday
end

@[simp]

theorem le_birthday : ∀ x : pgame, x ≤ x.birthday.to_pgame
| ⟨xl, _, xL, _⟩ :=
le_def.2 ⟨λ i, or.inl ⟨to_left_moves_to_pgame ⟨_, birthday_move_left_lt i⟩,
  by simp [le_birthday (xL i)]⟩, is_empty_elim⟩

variables (a b x : pgame.{u})

theorem neg_birthday_le : -x.birthday.to_pgame ≤ x :=
by simpa only [neg_birthday, ←neg_le_iff] using le_birthday (-x)

@[simp] theorem birthday_add : ∀ x y : pgame.{u}, (x + y).birthday = x.birthday ♯ y.birthday
| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ := begin
  rw [birthday_def, nadd_def],
  simp only [birthday_add, lsub_sum, mk_add_move_left_inl, move_left_mk, mk_add_move_left_inr,
    mk_add_move_right_inl, move_right_mk, mk_add_move_right_inr],
  rw max_max_max_comm,
  congr; apply le_antisymm,
  any_goals
  { exact max_le_iff.2 ⟨lsub_le_iff.2 (λ i, lt_blsub _ _ (birthday_move_left_lt i)),
      lsub_le_iff.2 (λ i, lt_blsub _ _ (birthday_move_right_lt i))⟩ },
  all_goals
  { apply blsub_le_iff.2 (λ i hi, _),
    rcases lt_birthday_iff.1 hi with ⟨j, hj⟩ | ⟨j, hj⟩ },
  { exact lt_max_of_lt_left ((nadd_le_nadd_right hj _).trans_lt (lt_lsub _ _)) },
  { exact lt_max_of_lt_right ((nadd_le_nadd_right hj _).trans_lt (lt_lsub _ _)) },
  { exact lt_max_of_lt_left ((nadd_le_nadd_left hj _).trans_lt (lt_lsub _ _)) },
  { exact lt_max_of_lt_right ((nadd_le_nadd_left hj _).trans_lt (lt_lsub _ _)) }
end
using_well_founded { dec_tac := pgame_wf_tac }

theorem birthday_add_zero : (a + 0).birthday = a.birthday := by simp
theorem birthday_zero_add : (0 + a).birthday = a.birthday := by simp
theorem birthday_add_one  : (a + 1).birthday = order.succ a.birthday := by simp
theorem birthday_one_add  : (1 + a).birthday = order.succ a.birthday := by simp

@[simp] theorem birthday_nat_cast : ∀ n : ℕ, birthday n = n
| 0 := birthday_zero
| (n + 1) := by simp [birthday_nat_cast]

theorem birthday_add_nat (n : ℕ) : (a + n).birthday = a.birthday + n := by simp
theorem birthday_nat_add (n : ℕ) : (↑n + a).birthday = a.birthday + n := by simp

end pgame


import data.real.basic

--OUTPUT 1
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : a + b + c > 0, from sorry,
  have h2 : a + b + c = 3 * (a + b + c) / 2, from sorry,
  have h3 : a + b + c = 3 * (a + b + c) / 2, from sorry,
  have h4 : a + b + c = 3 * (a + b + c) / 2, from sorry,
  have h5 : a + b + c = 3 * (a + b + c) / 2, from sorry,
  have h6 : a + b + c = 3 * (a + b + c) / 2, from sorry,
  have h7 : a + b + c = 3 * (a + b + c) / 2, from sorry,

  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) : sorry,
end

--OUTPUT 2
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥
    (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry
  ... = 9 / 2 : by sorry
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry
  ... ≥ 3 / ((b + c) + (a + c) + (a + b)) : by sorry
  ... ≥ 3 / 2 : by sorry,
end

--OUTPUT 3
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)), from sorry,
  have h2 : ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)) ≥ ((9 * (a + b + c)) / ((b + c) + (a + c) + (a + b))), from sorry,
  have h3 : ((9 * (a + b + c)) / ((b + c) + (a + c) + (a + b))) ≥ (((1 / (b + c)) + (1 / (a + c)) + (1 / (a + b))) / 3), from sorry,
  have h4 : (((1 / (b + c)) + (1 / (a + c)) + (1 / (a + b))) / 3) ≥ (3 / ((b + c) + (a + c) + (a + b))), from sorry,
  have h5 : (1 / (b + c)) + (1 / (a + c)) + (1 / (a + b)) ≥ 3, from sorry,
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from sorry,
end

--OUTPUT 4
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2, from sorry,
  have h2 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 * (a + b + c)) / ((b + c) + (a + c) + (a + b)), from sorry,
  have h3 : ((1 / (b + c)) + (1 / (a + c)) + (1 / (a + b))) / 3 ≥ (3 / ((b + c) + (a + c) + (a + b))), from sorry,
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from sorry,
end

--OUTPUT 5
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) : by {
    have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b), from sorry,
    have h2 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (9 / 2) * ((a + b + c) / ((b + c) + (a + c) + (a + b))), from sorry,
    have h3 : (a + b + c) / ((b + c) + (a + c) + (a + b)) = (1 / 2), from sorry,
    show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from sorry,
  },
end

--OUTPUT 6
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
by {
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b))
    ≥ ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)) : sorry
    ... ≥ (9 / 2) : sorry
    ... ≥ (3 / 2) : sorry,
}

/--`theorem`
Real Multiplication Distributes over Addition
Let $a$, $b$ and $c$ be real numbers.

Then:
:$a \cdot \paren {b + c} = a \cdot b + a \cdot c$
`proof`
{{begin-eqn}}
{{eqn | l = a \cdot \paren {b + c}
      | o = =
      | r = a \cdot b + a \cdot c
}}
{{eqn | ll= \leadstoandfrom
      | l = a \cdot b + a \cdot c
      | o = =
      | r = a \cdot \paren {b + c}
      | c = by commutativity of multiplication
}}
{{end-eqn}}
{{qed}}
-/
theorem real_multiplication_distributes_over_addition (a b c : ℝ) : a * (b + c) = a * b + a * c :=
begin
  calc a * (b + c) = a * (c + b) : by sorry
  ... = a * c + a * b : by sorry
  ... = a * b + a * c : by sorry,
end

--OUTPUT 7
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b), from sorry,
  have h2 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 * (a + b + c)) / ( (b + c) + (a + c) + (a + b)), from sorry,
  have h3 : (9 * (a + b + c)) / ( (b + c) + (a + c) + (a + b)) ≥ (3 / ((b + c) + (a + c) + (a + b))), from sorry,
  have h4 : (3 / ((b + c) + (a + c) + (a + b))) ≥ (3 / 2), from sorry,
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from sorry,
end

--OUTPUT 8
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2,
  begin
    calc (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b)
    = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry
    ... = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry
    ... = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry
    ... ≥ 3 / 2 : by sorry,
  end,

  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2),
  begin
    calc (a / (b + c)) + (b / (a + c)) + (c / (a + b))
    = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry
    ... ≥ (9 * (a + b + c)) / (2 * (b + c + a + c + a + b)) : by sorry
    ... ≥ (9 * (a + b + c)) / (2 * (3 * (a + b + c))) : by sorry
    ... ≥ (3 / 2) : by sorry,
  end,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Nesbitt's inequality
Let $a$, $b$ and $c$ be positive real numbers.

Then:
:$\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$

`proof`
{{begin-eqn}}
{{eqn | l = \frac a {b + c} + \frac b {a + c} + \frac c {a + b}
      | o = \ge
      | r = \dfrac 3 2
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac 9 2
      | c = by adding $3$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac {9 \paren {a + b + c} } {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = as $\dfrac {a + b + c} {\paren {b + c} + \paren {a + c} + \paren {a + b} } = \dfrac 1 2$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {\frac 1 {b + c} + \frac 1 {a + c} + \frac 1 {a + b} } 3
      | o = \ge
      | r = \frac 3 {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = dividing by $3 \paren {a + b + c}$
}}
{{end-eqn}}
These are the arithmetic mean and the harmonic mean of $\dfrac 1 {b + c}$, $\dfrac 1 {a + c}$ and $\dfrac 1 {a + b}$.

From Arithmetic Mean is Never Less than Harmonic Mean the last inequality is true.

Thus Nesbitt's Inequality holds.
{{qed}}

-/
theorem  nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
FEW SHOT PROMPTS TO CODEX(END)-/


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

We prove the orbit counting lemma traditionally attributed to
Burnside: if a finite group G acts on a finite set X, then
|G| × |X/G| is the sum over `t ∈ G` of `|Xᵗ|`, where
`Xᵗ = { x : t • x = x }`.  (The normal statement involves
dividing the above statement by `|G|`, but we avoid that so
that we can work everywhere in `ℕ`.)
-/

import data.fintype.basic group_theory.group_action
 algebra.group_power algebra.big_operators.basic data.zmod.basic
import tactic.ring

namespace group_theory
section burnside_count

variables {G : Type*} [group G] [fintype G] [decidable_eq G]
variables {X : Type*} [fintype X] [decidable_eq X] [mul_action G X]

instance : decidable_rel (mul_action.orbit_rel G X).r :=
 begin
  dsimp[mul_action.orbit_rel],
  intros x y, simp only [],
  rw [mul_action.mem_orbit_iff],
  apply_instance
 end

variables (G X)
def orbits := quotient (mul_action.orbit_rel G X)
variables {G X}

def orbit (x : X) : (orbits G X) :=
 @quotient.mk X (mul_action.orbit_rel G X) x

lemma orbit_act : ∀ (g : G) (x : X), orbit (g • x) = @orbit G _ _ _ X _ _ _ x :=
 λ g x, (@quotient.eq X (mul_action.orbit_rel G X) (g • x) x).mpr ⟨g,rfl⟩

instance : fintype (orbits G X) :=
 by { dsimp[orbits], apply_instance }

instance : decidable_eq (orbits G X) :=
 by { dsimp[orbits], apply_instance }

variables (G X)
structure transversal :=
(rep : (orbits G X) → X)
(actor : X → G)
(actor_prop : ∀ x, (actor x) • x = rep (orbit x))
variables {G X}

lemma orbit_rep (t : transversal G X) (y : orbits G X) :
  orbit (t.rep y) = y :=
begin
 letI s := (mul_action.orbit_rel G X),
 rcases quotient.exists_rep y with ⟨x,e⟩,
 rw[← e],
 exact calc
  orbit (t.rep (orbit x)) = orbit ((t.actor x) • x)
   : by rw[← t.actor_prop]
  ... = orbit x : orbit_act (t.actor x) x,
end

variables (G X)
lemma transversal_exists : nonempty (transversal G X) :=
begin
 letI s := (mul_action.orbit_rel G X),
 let rep : (orbits G X) → X := quotient.out,
 have exists_actor :
  ∀ x, ∃ g, g • x = rep (orbit x) :=
   λ x,quotient.eq.mp (quotient.out_eq (orbit x)),
 rcases (classical.skolem.mp exists_actor) with ⟨actor,actor_prop⟩,
 exact ⟨⟨rep,actor,actor_prop⟩⟩
end
variables {G X}

variable (X)

def el_fixed_points (g : G) : finset X :=
 finset.univ.filter (λ x,g • x = x)

variable {X}

lemma burnside_count :
 (fintype.card G) * (fintype.card (orbits G X)) =
  (@finset.univ G _).sum (λ g, finset.card (el_fixed_points X g)) :=
begin
 rcases (transversal_exists G X) with ⟨t⟩,
 let V : G → Type* := λ g, { x : X // g • x = x },
 have V_mem : ∀ (g : G) (x : X), (x ∈ el_fixed_points X g) ↔ g • x = x :=
  λ g x,by {simp[el_fixed_points]},
 have V_card : ∀ (g : G), fintype.card (V g) = finset.card (el_fixed_points X g) :=
  λ g, by {apply fintype.subtype_card,},
 let U := Σ g, (V g),
 have U_eq : ∀ u₀ u₁ : U, u₀.fst = u₁.fst → u₀.snd.val = u₁.snd.val → u₀ = u₁ :=
  λ ⟨h₀,⟨x₀,e₀⟩⟩ ⟨h₁,⟨x₁,e₁⟩⟩ hh hx,
   begin
    replace hh : h₀ = h₁ := hh,
    replace hx : x₀ = x₁ := hx,
    rcases hh, congr, assumption,
   end,
 let p : G × (orbits G X) → U :=
  λ ⟨g,y⟩,⟨g * (t.actor (g • (t.rep y))),⟨g • (t.rep y),begin
   change (g * (t.actor (g • (t.rep y)))) • (g • (t.rep y)) = g • (t.rep y),
   rw[mul_smul g _ (g • (t.rep y))],
   rw[t.actor_prop,orbit_act,orbit_rep t],
  end⟩⟩,
 let q : U → G × (orbits G X) :=
  λ ⟨h,⟨x,e⟩⟩,⟨h * (t.actor x)⁻¹,orbit x⟩,
 have pq : ∀ u, p (q u) = u :=
   λ ⟨h,⟨x,e⟩⟩, begin
   let a := t.actor x,
   let g := h * a⁻¹,
   let y := orbit x,
   let x' := g • (t.rep y),
   have ex : x' = x := calc
    x' = (h * a⁻¹) • (t.rep (orbit x)) : rfl
     ... = (h * a⁻¹) • (a • x) : by rw[← t.actor_prop x]
     ... = h • x : by rw[← mul_smul,mul_assoc,mul_left_inv,mul_one]
     ... = x : e,
   have eh : g * (t.actor x') = h :=
    by {rw[ex,mul_assoc,mul_left_inv a,mul_one],},
   apply U_eq,exact eh,exact ex,
  end,
 have qp : ∀ v : G × (orbits G X), q (p v) = v :=
   λ ⟨g,y⟩, begin
    let x := t.rep y,
    let x' := g • x,
    let a := t.actor x',
    change (prod.mk ((g * a) * a⁻¹) (orbit x')) = (prod.mk g y),
    have : orbit x' = y := by { rw[orbit_act,orbit_rep],},
    rw[this,mul_assoc,mul_right_inv,mul_one],
   end,
 exact calc
  (fintype.card G) * (fintype.card (orbits G X))
   = fintype.card (G × (orbits G X)) : (fintype.card_prod _ _).symm
   ... = fintype.card U : fintype.card_congr ⟨p,q,qp,pq⟩
   ... = (@finset.univ G _).sum (λ g, fintype.card (V g)) :
          fintype.card_sigma V
   ... = (@finset.univ G _).sum (λ g, finset.card (el_fixed_points X g)) :
          finset.sum_congr rfl (λ g _, V_card g),
end

end burnside_count
end group_theory


/-
Copyright (c) 2021 Paula Neeley. All rights reserved.
Author: Paula Neeley
-/

import data.list data.set.basic

variable {α : Type*}

def path (R : α → α → Prop) : α → list α → Prop
| x []      := true
| x (y::ys) := R x y ∧ path y ys

def last (R : α → α → Prop) : α → list α → α
| x []      := x
| x (y::ys) := last y ys

def reachable (R : α → α → Prop) (x y : α) : Prop := ∃ l : list α, path R x l ∧ last R x l = y

---------------------- Lemmas about R* ----------------------

lemma reach_right : ∀ x y z : α, ∀ R : α → α → Prop,
  reachable R x y ∧ R y z → reachable R x z :=
begin
intros x y z R h1, cases h1 with h1 h2,
cases h1 with l h1,
revert x, induction l,
{intros x h, cases h
with h1 h3, rw last at h3, existsi ([z] : list α),
split, split, apply eq.subst h3.symm, exact h2,
trivial, repeat {rw last}},
{intros x h1, cases h1 with h1 h3,
cases h1 with h1 h4,
have h5 := l_ih l_hd (and.intro h4 h3),
cases h5 with l h5,
existsi (l_hd::l : list α), split,
exact and.intro h1 h5.left,
exact h5.right}
end

lemma ref_close : ∀ x : α, ∀ R : α → α → Prop, reachable R x x :=
begin
intros x R,
existsi ([] : list α),
split,
trivial,
rw last
end

lemma trans_close : ∀ x y z : α, ∀ R : α → α → Prop,
  reachable R x y ∧ reachable R y z → reachable R x z :=
begin
intros x y z R h,
cases h with h1 h2,
cases h1 with l1 h1,
cases h2 with l2 h2,
revert x y z,
induction l1,
{intros x y z h1 h2, cases h1 with h1 h3, cases h2 with h2 h4,
rw last at h3, existsi (l2 : list α), split, apply eq.subst h3.symm,
exact h2, apply eq.subst h3.symm, exact h4},
{intros x y z h1 h2, cases h1 with h1 h3, cases h2 with h2 h4,
cases h1 with h1 h5,
have h6 := l1_ih l1_hd y z (and.intro h5 h3) (and.intro h2 h4),
cases h6 with l h6,
existsi (l1_hd::l : list α), split, split,
exact h1, exact h6.left, exact h6.right}
end

lemma containsR : ∀ x y : α, ∀ R : α → α → Prop, R x y → reachable R x y :=
begin
intros x y R h,
existsi ([y] : list α),
split, split,
exact h, trivial,
repeat {rw last}
end

open set

lemma smallest (R S : α → α → Prop) (reflS : reflexive S) (transS : transitive S) :
  (∀ x y : α, R x y → S x y) → (∀ x y : α, reachable R x y → S x y) :=
begin
intros h1 x z h2,
cases h2 with l h2,
cases h2 with h2 h3,
revert x z, induction l,
{intros x z h2 h3,
apply eq.subst h3, exact reflS x},
{intros x z h2 h3, cases h2 with h2 h4,
exact (transS ((h1 x) l_hd h2)) (l_ih l_hd z h4 h3)}
end