import .basic .monster .presentation .suzuki .higman_sims .mclaughlin .conway_groups .mathieu_group

-- import tactic.metadata
noncomputable theory
open monster suzuki higman_sims mclaughlin conway_groups mathieu_group coxeter_vertices mul_action
open category_theory (mk_ob)
local infix ` ≅ `:60 := isomorphic
local notation `⟪`:50 a `⟫`:50 := free_group.of a
local notation h :: t  := dvector.cons h t
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`) := l
local infix ` ↑↑ `:65 := right_conjugation

/- the first happy family, a.k.a. Mathieu groups -/

/-- The group $M_{11}$ is the stabilizer of an arbitrary point of the steiner system $S(5,6,12)$
  under the evaluation action of its Automorphism group.-/
@[fabstract]
def M11 : Group :=
mk_ob $ @stabilizer _ _ _ (mathieu_group.evaluation_action s_5_6_12)
  (classical.choice $ nonempty_steiner_system dec_trivial)

/--The group $M_{12}$ is the automorphism group of the steiner system $S(5,6,12)$.-/
@[fabstract]
def M12 : Group := mk_ob $ Aut(s_5_6_12)

/-- The group $M_{22}$ is the stabilizer of two arbitrary points of the steiner system $S(5,8,24)$
  under the evaluation action of its automorphism group. -/
@[fabstract]
def M22 : Group :=
have H : ∃x : s_5_8_24 × s_5_8_24, x.1 ≠ x.2, from omitted,
mk_ob $ two_pt_stabilizer (mathieu_group.evaluation_action s_5_8_24) (classical.some_spec H)

/-- The group $M_{23}$ is the stabilizer of an arbitrary point of the steiner system $S(5,8,24)$
  under the evaluation action of its automorphism group.-/
@[fabstract]
def M23 : Group :=
mk_ob $ @stabilizer _ _ _ (mathieu_group.evaluation_action s_5_8_24)
  (classical.choice $ nonempty_steiner_system dec_trivial)

/-- The group $M_{24}$ is the automorphism group of the steiner system $S(5,8,24)$. -/
@[fabstract]
def M24 : Group := mk_ob $ Aut(s_5_8_24)

/- the second happy family -/

/-- the Conway group Co₁ -/
@[fabstract]
def Co1 : Group := Co1
/-- the Conway group Co₂ -/
@[fabstract]
def Co2 : Group := Co2
/-- the Conway group Co₃ -/
@[fabstract]
def Co3 : Group := Co3
/-- the McLaughlin group -/
@[fabstract]
def McL : Group := McL
/-- the Higman–Sims group -/
@[fabstract]
def HS : Group := HS

namespace J2
def a : free_group $ dfin 4 := ⟪(by to_dfin 0)⟫
def b : free_group $ dfin 4 := ⟪(by to_dfin 1)⟫
def u : free_group $ dfin 4 := ⟪(by to_dfin 2)⟫
def v : free_group $ dfin 4 := ⟪(by to_dfin 3)⟫
end J2
section J2
open J2
/-- the Hall-Janko group J₂ -/
/- From the corresponding entry in the atlas of finite groups -/
@[fabstract]
def J2 : Group :=
⟪dfin 4 | {a * b * u ⁻¹, a * b⁻¹ * v ⁻¹, a^2, b^3, u^15,
  (u^4 * v^2 * u^3 * v^3)^2, (u^3 * v * (u^2 * v^2)^2)^2} ⟫
end J2

/-- the Suzuki sporadic group -/
@[fabstract]
def Suz : Group := Suz

/- THE THIRD HAPPY FAMILY -/

-- todo: move monster here

/-- The baby monster group B is defined as follows:
if x be any element in conjugacy class 2A,
then the centralizer C_M(x) is 2 ⬝ B, so B ≅ C_M(x)/Z(C_M(x)) -/
@[fabstract]
def BabyMonster : Group :=
let C := conj_class Monster 2 'A' in
let x := classical.some C.1.2 in
let Cx : set Monster := centralizer {x} in
mk_ob $ quotient_group.quotient $ is_subgroup.center $ Cx

/-- Fi24 is characterized by 3 ⬝ Fi24 ≅ N_M(x) where x is any element in conjugacy class 3A.
  The derived subgroup of this group is the sporadic group Fi24' -/
/- todo: double check that quotienting out the span of x indeed gives Fi24. -/
@[fabstract]
def Fi24 : Group :=
let C := conj_class Monster 3 'A' in
let x := classical.some C.1.2 in
let N_Mx : set Monster := normalizer $ group.closure {x} in
let span_x : set N_Mx := induced_subgroup (group.closure {x}) N_Mx in
by exact mk_ob (quotient_group.quotient span_x)

/-- The Fischer group Fi24' -/
@[fabstract]
def Fi24' : Group :=
mk_ob $ derived_subgroup Fi24

/- A 3-transposition group is a “finite group G generated by a conjugacy class D of involutions, such that any two elements of D have a product of order at most 3, and … such that G’ = G” and any normal 2- or 3-subgroup of G is central. The elements of D are known as 3-transpositions, or just transpositions if there is no risk of confusion”  -/
def Y432 : Group := coxeter_group $ matrix_of_graph (coxeter_edges [4,3,2])

namespace Fi23
def a : Y432 := generated_of $ torso
def b₁ : Y432 := generated_of $ arm (by to_dfin 0) (by to_dfin 0)
def c₁ : Y432 := generated_of $ arm (by to_dfin 0) (by to_dfin 1)
def b₂ : Y432 := generated_of $ arm (by to_dfin 1) (by to_dfin 0)
def c₂ : Y432 := generated_of $ arm (by to_dfin 1) (by to_dfin 1)
def b₃ : Y432 := generated_of $ arm (by to_dfin 2) (by to_dfin 0)
def c₃ : Y432 := generated_of $ arm (by to_dfin 2) (by to_dfin 1)
end Fi23
section Fi23
open Fi23
/- We define Fi23 following p 232 of the atlas -/
/-- the Fischer group Fi23 -/
@[fabstract]
def Fi23 : Group :=
  category_theory.mk_ob $ quotient_group.quotient $
    is_subgroup.center $ (Y432)/⟪{(a*b₁*c₁*a*b₂*c₂*a*b₃*c₃)^10}⟫
end Fi23

/- We define Fi22 following p 162 of the atlas -/
/-- the Fischer group Fi22 -/
def Y332 : Group := coxeter_group $ matrix_of_graph (coxeter_edges [3,3,2])

namespace Fi22
def a : Y332 := generated_of $ arm (by to_dfin 1) (by to_dfin 2)
def b : Y332 := generated_of $ arm (by to_dfin 1) (by to_dfin 1)
def c : Y332 := generated_of $ arm (by to_dfin 1) (by to_dfin 0)
def d : Y332 := generated_of $ torso
def e : Y332 := generated_of $ arm (by to_dfin 0) (by to_dfin 0)
def f : Y332 := generated_of $ arm (by to_dfin 0) (by to_dfin 1)
def g : Y332 := generated_of $ arm (by to_dfin 0) (by to_dfin 2)
def h : Y332 := generated_of $ arm (by to_dfin 2) (by to_dfin 0)
def i : Y332 := generated_of $ arm (by to_dfin 2) (by to_dfin 1)
end Fi22
section Fi22
open Fi22
@[fabstract]
def Fi22 : Group := Y332/⟪{(a*b*c*d*e*f*h)^9, (b*c*d*e*f*g*h)^9, (b*c*d*e*f*d*h*i*d)^10}⟫
end Fi22

/-- the Thompson Group is C_M(x)/<x> for some element x in 3C -/
@[fabstract]
def Th : Group :=
let C := conj_class Monster 3 'C' in
let x := classical.some C.1.2 in
let C_Mx : set Monster := centralizer {x} in
let span_x : set C_Mx := induced_subgroup (group.closure {x}) C_Mx in
by exact mk_ob (quotient_group.quotient span_x)

/-- the Harada–Norton group is C_M(x)/<x> for some element x in 5A -/
@[fabstract]
def HN : Group :=
let C := conj_class Monster 5 'A' in
let x := classical.some C.1.2 in
let C_Mx : set Monster := centralizer {x} in
let span_x : set C_Mx := induced_subgroup (group.closure {x}) C_Mx in
by exact mk_ob (quotient_group.quotient span_x)

/-- the Held group is C_M(x)/<x> for some element x in 7A -/
@[fabstract]
def He : Group :=
let C := conj_class Monster 7 'A' in
let x := classical.some C.1.2 in
let C_Mx : set Monster := centralizer {x} in
let span_x : set C_Mx := induced_subgroup (group.closure {x}) C_Mx in
by exact mk_ob (quotient_group.quotient span_x)

/- the pariahs  -/

theorem J1_char : ∃!(G : Group.{0}), ∃(h : fintype G),
by { exactI
  simple_group G ∧
  (∃(s : set G), is_Sylow_subgroup 2 s ∧ commutative_on s) ∧
  (∃x : G, x*x = 1 ∧ mk_ob (centralizer {x} : set G) ≅
    mk_ob (cyclic_group 2 × alternating_group 5)) } :=
omitted

/-- the Janko group J₁ -/
@[fabstract]
def J1 : Group := classical.the _ J1_char
namespace J3
def a := ⟪ff⟫
def b := ⟪tt⟫
end J3
section J3
open J3
/-- the Janko group J₃ -/
/- From http://brauer.maths.qmul.ac.uk/Atlas/v3/pres/J3G1-P1:

  Presentation 	〈 a, b | a2 = b3 = (ab)19 = [a, b]9 = ((ab)6(ab−1)5)2 = ((ababab−1)2abab−1ab−1abab−1)2 = abab(abab−1)3abab(abab−1)4ab−1(abab−1)3 = (ababababab−1abab−1)4 = 1 〉 -/
@[fabstract]
def J3 : Group :=
⟪bool | {a^2, b^3, (a*b)^19, ⟦a, b⟧^9, ((a*b)^6*(a*b⁻¹)^5)^2,
  ((a*b*a*b*a*(b⁻¹))^2*a*b*a*b⁻¹*a*b⁻¹*a*b*a*b⁻¹)^2,
  a*b*a*b*(a*b*a*b⁻¹)^3*a*b*a*b*(a*b*a*b⁻¹)^4*a*b⁻¹*(a*b*a*b⁻¹)^3,
  (a*b*a*b*a*b*a*b*a*b⁻¹*a*b*a*b⁻¹)^4}⟫
end J3

/- Presentation of the Lyons group, following section 3B of the paper
   Volker Gebhardt, Two "Short" Presentations for Lyons' Sporadic Simple Group
   https://projecteuclid.org/download/pdf_1/euclid.em/1045604668, p 335-6 -/

namespace Ly
def a : free_group $ dfin 5 := ⟪by to_dfin 0⟫
def b : free_group $ dfin 5 := ⟪by to_dfin 1⟫
def c : free_group $ dfin 5 := ⟪by to_dfin 2⟫
def d : free_group $ dfin 5 := ⟪by to_dfin 3⟫
def z : free_group $ dfin 5 := ⟪by to_dfin 4⟫

-- testing binding strength
-- example {α : Type*} [group α] (x y z w : α) : x * y * w ↑↑ z = (x * y * w) ↑↑ z := by refl
-- example {α : Type*} [group α] (x y z w : α) : x ↑↑ z * y * w = x ↑↑ (z * y * w) := by refl
-- example {α : Type*} [group α] (x y z w : α) : x ↑↑ z⁻¹ = x ↑↑ (z⁻¹) := by refl

def RH₃ : set $ free_group $ dfin 5 := {a^8, b^5, (a*b)^4, ⟦a^2,b⟧, ⟦a,b⟧^3}

def RH₂ : set $ free_group $ dfin 5 :=
  RH₃ ∪ { c^5, c^3 * (c ↑↑ (a^2))⁻¹,
  (c ↑↑ b * a)⁻¹ * (c ↑↑ a^2 * b) * c * b * c * b ⁻¹,
  (c ↑↑ b^2)⁻¹ * c^2 * (c ↑↑ b⁻¹) * ((c ↑↑ b)⁻¹)^2 }

def RH₁ : set $ free_group $ dfin 5 :=
  { (a * b⁻¹ * a ↑↑ d)⁻¹ * a * b⁻¹ * a^5,
  (b^2 * a ⁻¹ ↑↑ d)⁻¹ * (a⁻¹)^2*b^2 * a⁻¹,
  ((b*a*c⁻¹*b*a*(b⁻¹)^2*a) ↑↑ d)⁻¹ * c * d, a⁻¹*b*a⁻¹*b⁻¹*a*(b⁻¹)^2*a*c*b⁻¹*c*b*a*c⁻¹,
  ((a^2*c⁻¹*b*a*c⁻¹*b*a⁻¹*b⁻¹) ↑↑ d*c*d)⁻¹ * (a⁻¹)^2*b⁻¹*a⁻¹*(b⁻¹*c)^2*b^2,
  (b^2*a*c*b*a ↑↑ d*c*a⁻¹*b*c*d)⁻¹ * a⁻¹*b*a⁻¹*b⁻¹*a⁻¹*(b⁻¹)^2*c*a⁻¹*b⁻¹*c⁻¹*b*a,
  ((a * (c⁻¹)^2 *b) ↑↑ d*c*a⁻¹*b*c*d)⁻¹ * (a⁻¹)^4 * b^2 * c⁻¹*b⁻¹*a*b⁻¹*c*a*b⁻¹,
  c*a⁻¹*c⁻¹*a*c⁻¹*a⁻¹*c*a*d⁻¹*c⁻¹*a⁻¹*c⁻¹*a*c*a⁻¹*c*d*c*a*c⁻¹*a⁻¹*c⁻¹*a*c*d }

def RG : set $ free_group $ dfin 5 :=
  {(a ↑↑ z)⁻¹ * (a⁻¹)^3, (a ↑↑ z * d * z)⁻¹ * a^3,
   (c⁻¹ * d⁻¹ * c * b * a * b^2 * (c*b)^2 * c⁻¹ * d ↑↑ z * d * z)⁻¹ * c⁻¹*b*c^2 * a *
     c⁻¹*b*d⁻¹*c*a*c⁻¹*b*c⁻¹*(b⁻¹)^2 * c*a⁻¹*c* d⁻¹ * c* b^2 *c*d*a*d⁻¹*c⁻¹*d⁻¹*c*b*a⁻¹*b,
   ⟦z, d⁻¹*c⁻¹*b*a*b⁻¹*d⁻¹*c*d⁻¹*c⁻¹*d*c⁻¹*b⁻¹*a*b⁻¹*c*d⁻¹*c*d⟧⁻¹ * b * c* b⁻¹*c⁻¹,
   (a ↑↑ z*d*b⁻¹*z)⁻¹ * a⁻¹*d⁻¹*c⁻¹*b*(c⁻¹)^2*a*b⁻¹*c*a⁻¹*b^2*c*b⁻¹*c*a⁻¹*c⁻¹*d*b⁻¹*a⁻¹,
   (c⁻¹*a⁻¹*d⁻¹*c⁻¹ * b * a * b⁻¹ * a * c⁻¹ *b*c*a*c⁻¹*d⁻¹*c*d*a*c*b⁻¹*a*b*a*c ↑↑ z*d*b⁻¹*z)⁻¹ *
     a⁻¹*c*(a⁻¹)^3*c⁻¹*(b⁻¹)^2*c⁻¹*d*c⁻¹*a*c⁻¹*b^2*c*b⁻¹*c*a⁻¹*c⁻¹*d*b⁻¹*c⁻¹*d⁻¹*c⁻¹*b*a*b*d*c*a⁻¹,
   ((a⁻¹*b*d*c*a⁻¹*b⁻¹*a*b*a⁻¹*c⁻¹*b⁻¹*c*a)↑↑z*d*c*d*z)⁻¹*c⁻¹*a^3*b*c⁻¹*b⁻¹*a⁻¹*c*d⁻¹*c⁻¹*b*a⁻¹*b⁻¹,
   (d⁻¹*c*b*a⁻¹*b⁻¹ ↑↑ z*d*c*d*z)⁻¹*a*c*a⁻¹*b*a*c⁻¹*b*c*a*c⁻¹*b⁻¹*a⁻¹*b⁻¹*a*b*d⁻¹*c*a*c⁻¹*b⁻¹*c⁻¹*a,
   a*d⁻¹*c⁻¹*b*(a⁻¹)^2*d⁻¹*c⁻¹*(b⁻¹)^2*c⁻¹*d*c⁻¹*(a*c⁻¹)^2 *
     b*a⁻¹*c^2*b⁻¹*c*d⁻¹*c*a*c*b⁻¹*a*d⁻¹*z⁻¹*b*z*b⁻¹*z
   }
end Ly

section Ly
open Ly
/-We quote: the complete defining set RH₂ ∪ Rh₁ ∪ RG of relations for G with respect
  to the generators a,b,c,d and z contains 25 relations of total length 549-/

/-- the Lyons group -/
@[fabstract]
def Ly : Group := ⟪dfin 5 | RH₂ ∪ RH₁ ∪ RG ⟫
end Ly
/- Presentation for the O'Nan group, following the paper
   Leonard H. Soicher, A new existence and uniqueness proof for the O'Nan group,
   https://doi.org/10.1112/blms/22.2.148 (section 2)-/

/-                                8
   O'N := ⟨a (torso) --- b --- c --- d --- e --- f, g | relations⟩ -/

namespace O'N
def O'N_diagram :=
  annotate (annotated_graph_of_graph $ coxeter_edges [5])
    (arm (by to_dfin 0) (by to_dfin 1), arm (by to_dfin 0) (by to_dfin 2)) 8

noncomputable instance O'N_diagram_decidable_rel : decidable_rel $ O'N_diagram.edge :=
λ _ _, classical.prop_decidable _

def O'N_cover := coxeter_group' (matrix_of_annotated_graph O'N_diagram) unit

def a : O'N_cover := generated_of $ sum.inl $ torso
def b : O'N_cover := generated_of $ sum.inl $ arm (by to_dfin 0) (by to_dfin 0)
def c : O'N_cover := generated_of $ sum.inl $ arm (by to_dfin 0) (by to_dfin 1)
def d : O'N_cover := generated_of $ sum.inl $ arm (by to_dfin 0) (by to_dfin 2)
def e : O'N_cover := generated_of $ sum.inl $ arm (by to_dfin 0) (by to_dfin 3)
def f : O'N_cover := generated_of $ sum.inl $ arm (by to_dfin 0) (by to_dfin 4)
def g : O'N_cover := generated_of $ sum.inr $ ()
end O'N
section O'N
open O'N

/-- the O'Nan group -/
@[fabstract]
def O'N : Group :=
  O'N_cover/⟪{(a*f)⁻¹ * g^2, ((c*d)^4)⁻¹ * g^2, ⟦c,d*g*d*g⟧,
              ⟦d, c*g*c*g⟧, (b*c*d*g)^5, f⁻¹ * (d * g)^4,
              ((b*a)↑↑g)⁻¹ * b * a * ((b*a) ↑↑ c*g*c*g),
              ((e*f) ↑↑ g)⁻¹ * e * f * ((e*f)↑↑ d*g*d*g)}⟫
end O'N
/-
Atlas entry for J4 presented on its G2-`standard' generators.

G<x,y,t>:=Group<x,y,t| x^2, y^3, (x*y)^23, (x,y)^12, (x,y*x*y)^5,
(x*y*x*y*x*y^-1)^3*(x*y*x*y^-1*x*y^-1)^3, (x*y*(x*y*x*y^-1)^3)^4,
t^2, (t,x), (t,y*x*y*(x*y^-1)^2*(x*y)^3),
(y*t^(y*x*y^-1*x*y*x*y^-1*x))^3,
((y*x*y*x*y*x*y)^3*t*t^((x*y)^3*y*(x*y)^6*y))^2
>;
-/

namespace J4
def x : free_group $ dfin 3 := ⟪(by to_dfin 0)⟫
def y : free_group $ dfin 3 := ⟪(by to_dfin 1)⟫
def t : free_group $ dfin 3 := ⟪(by to_dfin 2)⟫
end J4
section J4
open J4
/-- the Janko group J₄ -/
@[fabstract]
def J4 : Group := ⟪ dfin 3 | {x^2, y^3, (x*y)^23, ⟦x,y⟧^12, ⟦x,y*x*y ⟧^5,
  (x*y*x*y*x*y⁻¹)^3*(x*y*x*y⁻¹*x*y⁻¹)^3, (x*y*(x*y*x*y⁻¹)^3)^4,
  t^2, ⟦t,x⟧, ⟦t,y*x*y*(x*y⁻¹)^2*(x*y)^3⟧, (y*(t ↑↑ y*x*y⁻¹*x*y*x*y⁻¹*x))^3,
  ((y*x*y*x*y*x*y)^3 * t * (t ↑↑ (x*y)^3*y*(x*y)^6*y))^2 }⟫
end J4
/- Presentation of the Rudvalis group, following the paper
   J.D. Bradley, R.T. Curtis and M. Aslam Malik,
   Symmetric generation of the Rudvalis group
   https://doi.org/10.1112/jlms/jdq039
   Section 4.4 -/

namespace Ru
def u : free_group $ dfin 3 := ⟪(by to_dfin 0)⟫
def v : free_group $ dfin 3 := ⟪(by to_dfin 1)⟫
def t : free_group $ dfin 3 := ⟪(by to_dfin 2)⟫
end Ru
section Ru
open Ru
/-- the Rudvalis group -/
@[fabstract]
def Ru : Group := ⟪dfin 3 | {u^4, v^2, (u*v)^7, (u^2*v)^3, t^2, ⟦t,u↑↑v⟧, ⟦t,v↑↑u⟧,
                            (u*t)^10, (u*v*u*t)^13, (u*⟦t,u⁻¹⟧*⟦t↑↑u^2, ⟦u⁻¹, t⟧⟧)^3,
                            ((u*t↑↑u*v)*(t*u^2)^4*(t↑↑u*v))^2, (u*(t↑↑v)*⟦t↑↑u*v,u⟧^2)^2}⟫
end Ru

-- run_cmd mk_JSON_dump


import GameServer.Commands

import NNG.Tactics

TacticDoc rfl
"
## Summary

`rfl` proves goals of the form `X = X`.

## Details

The `rfl` tactic will close any goal of the form `A = B`
where `A` and `B` are *exactly the same thing*.

### Example:
If it looks like this in the top right hand box:
```
Objects
  a b c d : ℕ
Prove:
  (a + b) * (c + d) = (a + b) * (c + d)
```

then

`rfl`

will close the goal and solve the level."

TacticDoc induction_on
"
## Summary

If `n : ℕ` is in our objects list, then `induction_on n`
attempts to prove the current goal by induction on `n`, with the inductive
assumption in the `succ` case being `ind_hyp`.

### Example:
If your current goal is:
```
Objects
  n : ℕ
Prove:
  2 * n = n + n
```

then

`induction_on n`

will give us two goals:

```
Prove:
  2 * 0 = 0 + 0
```

and
```
Objects
  n : ℕ,
Assumptions
  ind_hyp : 2 * n = n + n
Prove:
  2 * succ n = succ n + succ n
```
"

TacticDoc rewrite
"
## Summary

If `h` is a proof of `X = Y`, then `rewrite [h],` will change
all `X`s in the goal to `Y`s. Variants: `rewrite [<- h]` (changes
`Y` to `X`) and
`rewrite [h] at h2` (changes `X` to `Y` in hypothesis `h2` instead
of the goal).

## Details

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

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

2) The `rewrite` tactic will also work with proofs of theorems
which are equalities (look for them in the inventory).
For example, if your inventory contains `add_zero x : x + 0 = x`,
then `rewrite [add_zero]` will change `x + 0` into `x` in your goal
(or fail with an error if Lean cannot find `x + 0` in the goal).

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

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

### Example:
If it looks like this in the top right hand box:
```
Objects
  x y : ℕ
Assumptions
  h : x = y + y
Prove:
  succ (x + 0) = succ (y + y)
```

then

`rewrite [add_zero]`

will change the goal into `succ x = succ (y + y)`, and then

`rewrite [h]`

will change the goal into `succ (y + y) = succ (y + y)`, which
can be solved with `rfl,`.

### Example:
You can use `rewrite` to change a hypothesis as well.
For example, if your local context looks like this:
```
Objects
  x y : ℕ
Assumptions
  h1 : x = y + 3
  h2 : 2 * y = x
Prove:
  y = 3
```
then `rewrite [h1] at h2` will turn `h2` into `h2 : 2 * y = y + 3`.
"

TacticDoc intro
"Useful to introduce stuff"

TacticSet basics := rfl induction_on intro rewrite


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

! This file was ported from Lean 3 source module category_theory.monoidal.free.coherence
! leanprover-community/mathlib commit f187f1074fa1857c94589cc653c786cadc4c35ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Monoidal.Free.Basic
import Mathbin.CategoryTheory.Groupoid
import Mathbin.CategoryTheory.DiscreteCategory

/-!
# The monoidal coherence theorem

In this file, we prove the monoidal coherence theorem, stated in the following form: the free
monoidal category over any type `C` is thin.

We follow a proof described by Ilya Beylin and Peter Dybjer, which has been previously formalized
in the proof assistant ALF. The idea is to declare a normal form (with regard to association and
adding units) on objects of the free monoidal category and consider the discrete subcategory of
objects that are in normal form. A normalization procedure is then just a functor
`full_normalize : free_monoidal_category C ⥤ discrete (normal_monoidal_object C)`, where
functoriality says that two objects which are related by associators and unitors have the
same normal form. Another desirable property of a normalization procedure is that an object is
isomorphic (i.e., related via associators and unitors) to its normal form. In the case of the
specific normalization procedure we use we not only get these isomorphismns, but also that they
assemble into a natural isomorphism `𝟭 (free_monoidal_category C) ≅ full_normalize ⋙ inclusion`.
But this means that any two parallel morphisms in the free monoidal category factor through a
discrete category in the same way, so they must be equal, and hence the free monoidal category
is thin.

## References

* [Ilya Beylin and Peter Dybjer, Extracting a proof of coherence for monoidal categories from a
   proof of normalization for monoids][beylin1996]

-/

universe u

namespace CategoryTheory

open MonoidalCategory

namespace FreeMonoidalCategory

variable {C : Type u}

section

variable (C)

/-- We say an object in the free monoidal category is in normal form if it is of the form
    `(((𝟙_ C) ⊗ X₁) ⊗ X₂) ⊗ ⋯`. -/
@[nolint has_nonempty_instance]
inductive NormalMonoidalObject : Type u
  | Unit : normal_monoidal_object
  | tensor : normal_monoidal_object → C → normal_monoidal_object
#align category_theory.free_monoidal_category.normal_monoidal_object CategoryTheory.FreeMonoidalCategory.NormalMonoidalObject

end

-- mathport name: exprF
local notation "F" => FreeMonoidalCategory

-- mathport name: exprN
local notation "N" => Discrete ∘ NormalMonoidalObject

-- mathport name: «expr ⟶ᵐ »
local infixr:10 " ⟶ᵐ " => Hom

/-- Auxiliary definition for `inclusion`. -/
@[simp]
def inclusionObj : NormalMonoidalObject C → F C
  | normal_monoidal_object.unit => unit
  | normal_monoidal_object.tensor n a => tensor (inclusion_obj n) (of a)
#align category_theory.free_monoidal_category.inclusion_obj CategoryTheory.FreeMonoidalCategory.inclusionObj

/-- The discrete subcategory of objects in normal form includes into the free monoidal category. -/
@[simp]
def inclusion : N C ⥤ F C :=
  Discrete.functor inclusionObj
#align category_theory.free_monoidal_category.inclusion CategoryTheory.FreeMonoidalCategory.inclusion

/-- Auxiliary definition for `normalize`. -/
@[simp]
def normalizeObj : F C → NormalMonoidalObject C → N C
  | Unit, n => ⟨n⟩
  | of X, n => ⟨NormalMonoidalObject.tensor n X⟩
  | tensor X Y, n => normalize_obj Y (normalize_obj X n).as
#align category_theory.free_monoidal_category.normalize_obj CategoryTheory.FreeMonoidalCategory.normalizeObj

@[simp]
theorem normalizeObj_unitor (n : NormalMonoidalObject C) : normalizeObj (𝟙_ (F C)) n = ⟨n⟩ :=
  rfl
#align category_theory.free_monoidal_category.normalize_obj_unitor CategoryTheory.FreeMonoidalCategory.normalizeObj_unitor

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem normalizeObj_tensor (X Y : F C) (n : NormalMonoidalObject C) :
    normalizeObj (X ⊗ Y) n = normalizeObj Y (normalizeObj X n).as :=
  rfl
#align category_theory.free_monoidal_category.normalize_obj_tensor CategoryTheory.FreeMonoidalCategory.normalizeObj_tensor

section

open Hom

attribute [local tidy] tactic.discrete_cases

/-- Auxiliary definition for `normalize`. Here we prove that objects that are related by
    associators and unitors map to the same normal form. -/
@[simp]
def normalizeMapAux :
    ∀ {X Y : F C},
      (X ⟶ᵐ Y) → ((Discrete.functor (normalizeObj X) : _ ⥤ N C) ⟶ Discrete.functor (normalizeObj Y))
  | _, _, id _ => 𝟙 _
  | _, _, α_hom _ _ _ =>
    ⟨fun X => 𝟙 _, by
      rintro ⟨X⟩ ⟨Y⟩ f
      simp⟩
  | _, _, α_inv _ _ _ =>
    ⟨fun X => 𝟙 _, by
      rintro ⟨X⟩ ⟨Y⟩ f
      simp⟩
  | _, _, l_hom _ =>
    ⟨fun X => 𝟙 _, by
      rintro ⟨X⟩ ⟨Y⟩ f
      simp⟩
  | _, _, l_inv _ =>
    ⟨fun X => 𝟙 _, by
      rintro ⟨X⟩ ⟨Y⟩ f
      simp⟩
  | _, _, ρ_hom _ =>
    ⟨fun ⟨X⟩ => ⟨⟨by simp⟩⟩, by
      rintro ⟨X⟩ ⟨Y⟩ f
      simp⟩
  | _, _, ρ_inv _ =>
    ⟨fun ⟨X⟩ => ⟨⟨by simp⟩⟩, by
      rintro ⟨X⟩ ⟨Y⟩ f
      simp⟩
  | X, Y, @comp _ U V W f g => normalize_map_aux f ≫ normalize_map_aux g
  | X, Y, @hom.tensor _ T U V W f g =>
    ⟨fun X =>
      (normalize_map_aux g).app (normalizeObj T X.as) ≫
        (Discrete.functor (normalizeObj W) : _ ⥤ N C).map ((normalize_map_aux f).app X),
      by tidy⟩
#align category_theory.free_monoidal_category.normalize_map_aux CategoryTheory.FreeMonoidalCategory.normalizeMapAux

end

section

variable (C)

/-- Our normalization procedure works by first defining a functor `F C ⥤ (N C ⥤ N C)` (which turns
    out to be very easy), and then obtain a functor `F C ⥤ N C` by plugging in the normal object
    `𝟙_ C`. -/
@[simp]
def normalize : F C ⥤ N C ⥤ N C
    where
  obj X := Discrete.functor (normalizeObj X)
  map X Y := Quotient.lift normalizeMapAux (by tidy)
#align category_theory.free_monoidal_category.normalize CategoryTheory.FreeMonoidalCategory.normalize

/-- A variant of the normalization functor where we consider the result as an object in the free
    monoidal category (rather than an object of the discrete subcategory of objects in normal
    form). -/
@[simp]
def normalize' : F C ⥤ N C ⥤ F C :=
  normalize C ⋙ (whiskeringRight _ _ _).obj inclusion
#align category_theory.free_monoidal_category.normalize' CategoryTheory.FreeMonoidalCategory.normalize'

/-- The normalization functor for the free monoidal category over `C`. -/
def fullNormalize : F C ⥤ N C
    where
  obj X := ((normalize C).obj X).obj ⟨NormalMonoidalObject.unit⟩
  map X Y f := ((normalize C).map f).app ⟨NormalMonoidalObject.unit⟩
#align category_theory.free_monoidal_category.full_normalize CategoryTheory.FreeMonoidalCategory.fullNormalize

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Given an object `X` of the free monoidal category and an object `n` in normal form, taking
    the tensor product `n ⊗ X` in the free monoidal category is functorial in both `X` and `n`. -/
@[simp]
def tensorFunc : F C ⥤ N C ⥤ F C
    where
  obj X := Discrete.functor fun n => inclusion.obj ⟨n⟩ ⊗ X
  map X Y f :=
    ⟨fun n => 𝟙 _ ⊗ f, by
      rintro ⟨X⟩ ⟨Y⟩
      tidy⟩
#align category_theory.free_monoidal_category.tensor_func CategoryTheory.FreeMonoidalCategory.tensorFunc

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem tensorFunc_map_app {X Y : F C} (f : X ⟶ Y) (n) : ((tensorFunc C).map f).app n = 𝟙 _ ⊗ f :=
  rfl
#align category_theory.free_monoidal_category.tensor_func_map_app CategoryTheory.FreeMonoidalCategory.tensorFunc_map_app

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem tensorFunc_obj_map (Z : F C) {n n' : N C} (f : n ⟶ n') :
    ((tensorFunc C).obj Z).map f = inclusion.map f ⊗ 𝟙 Z :=
  by
  cases n
  cases n'
  tidy
#align category_theory.free_monoidal_category.tensor_func_obj_map CategoryTheory.FreeMonoidalCategory.tensorFunc_obj_map

/-- Auxiliary definition for `normalize_iso`. Here we construct the isomorphism between
    `n ⊗ X` and `normalize X n`. -/
@[simp]
def normalizeIsoApp :
    ∀ (X : F C) (n : N C), ((tensorFunc C).obj X).obj n ≅ ((normalize' C).obj X).obj n
  | of X, n => Iso.refl _
  | Unit, n => ρ_ _
  | tensor X Y, n =>
    (α_ _ _ _).symm ≪≫ tensorIso (normalize_iso_app X n) (Iso.refl _) ≪≫ normalize_iso_app _ _
#align category_theory.free_monoidal_category.normalize_iso_app CategoryTheory.FreeMonoidalCategory.normalizeIsoApp

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem normalizeIsoApp_tensor (X Y : F C) (n : N C) :
    normalizeIsoApp C (X ⊗ Y) n =
      (α_ _ _ _).symm ≪≫ tensorIso (normalizeIsoApp C X n) (Iso.refl _) ≪≫ normalizeIsoApp _ _ _ :=
  rfl
#align category_theory.free_monoidal_category.normalize_iso_app_tensor CategoryTheory.FreeMonoidalCategory.normalizeIsoApp_tensor

@[simp]
theorem normalizeIsoApp_unitor (n : N C) : normalizeIsoApp C (𝟙_ (F C)) n = ρ_ _ :=
  rfl
#align category_theory.free_monoidal_category.normalize_iso_app_unitor CategoryTheory.FreeMonoidalCategory.normalizeIsoApp_unitor

/-- Auxiliary definition for `normalize_iso`. -/
@[simp]
def normalizeIsoAux (X : F C) : (tensorFunc C).obj X ≅ (normalize' C).obj X :=
  NatIso.ofComponents (normalizeIsoApp C X)
    (by
      rintro ⟨X⟩ ⟨Y⟩
      tidy)
#align category_theory.free_monoidal_category.normalize_iso_aux CategoryTheory.FreeMonoidalCategory.normalizeIsoAux

section

variable {D : Type u} [Category.{u} D] {I : Type u} (f : I → D) (X : Discrete I)

-- TODO: move to discrete_category.lean, decide whether this should be a global simp lemma
@[simp]
theorem discrete_functor_obj_eq_as : (Discrete.functor f).obj X = f X.as :=
  rfl
#align category_theory.free_monoidal_category.discrete_functor_obj_eq_as CategoryTheory.FreeMonoidalCategory.discrete_functor_obj_eq_as

-- TODO: move to discrete_category.lean, decide whether this should be a global simp lemma
@[simp]
theorem discrete_functor_map_eq_id (g : X ⟶ X) : (Discrete.functor f).map g = 𝟙 _ := by tidy
#align category_theory.free_monoidal_category.discrete_functor_map_eq_id CategoryTheory.FreeMonoidalCategory.discrete_functor_map_eq_id

end

/-- The isomorphism between `n ⊗ X` and `normalize X n` is natural (in both `X` and `n`, but
    naturality in `n` is trivial and was "proved" in `normalize_iso_aux`). This is the real heart
    of our proof of the coherence theorem. -/
def normalizeIso : tensorFunc C ≅ normalize' C :=
  NatIso.ofComponents (normalizeIsoAux C)
    (by
      rintro X Y f
      apply Quotient.inductionOn f
      intro f
      ext n
      induction f generalizing n
      · simp only [mk_id, Functor.map_id, category.id_comp, category.comp_id]
      · dsimp
        simp only [id_tensor_associator_inv_naturality_assoc, ← pentagon_inv_assoc,
          tensor_hom_inv_id_assoc, tensor_id, category.id_comp, discrete.functor_map_id,
          comp_tensor_id, iso.cancel_iso_inv_left, category.assoc]
        dsimp
        simp only [category.comp_id]
      · dsimp
        simp only [discrete.functor_map_id, comp_tensor_id, category.assoc, pentagon_inv_assoc, ←
          associator_inv_naturality_assoc, tensor_id, iso.cancel_iso_inv_left]
        dsimp
        simp only [category.comp_id]
      · dsimp
        rw [triangle_assoc_comp_right_assoc]
        simp only [discrete.functor_map_id, category.assoc]
        cases n
        dsimp
        simp only [category.comp_id]
      · dsimp
        simp only [triangle_assoc_comp_left_inv_assoc, inv_hom_id_tensor_assoc, tensor_id,
          category.id_comp, discrete.functor_map_id]
        dsimp
        simp only [category.comp_id]
        cases n
        simp
      · dsimp
        rw [← (iso.inv_comp_eq _).2 (right_unitor_tensor _ _), category.assoc, ←
          right_unitor_naturality]
        simp only [iso.cancel_iso_inv_left, category.assoc]
        congr 1
        convert(category.comp_id _).symm
        convert discrete_functor_map_eq_id inclusion_obj _ _
        ext
        rfl
      · dsimp
        simp only [← (iso.eq_comp_inv _).1 (right_unitor_tensor_inv _ _), right_unitor_conjugation,
          category.assoc, iso.hom_inv_id, iso.hom_inv_id_assoc, iso.inv_hom_id,
          iso.inv_hom_id_assoc]
        congr
        convert(discrete_functor_map_eq_id inclusion_obj _ _).symm
        ext
        rfl
      · dsimp at *
        rw [id_tensor_comp, category.assoc, f_ih_g ⟦f_g⟧, ← category.assoc, f_ih_f ⟦f_f⟧,
          category.assoc, ← functor.map_comp]
        congr 2
      · dsimp at *
        rw [associator_inv_naturality_assoc]
        slice_lhs 2 3 => rw [← tensor_comp, f_ih_f ⟦f_f⟧]
        conv_lhs => rw [← @category.id_comp (F C) _ _ _ ⟦f_g⟧]
        simp only [category.comp_id, tensor_comp, category.assoc]
        congr 2
        rw [← mk_tensor, Quotient.lift_mk]
        dsimp
        rw [functor.map_comp, ← category.assoc, ← f_ih_g ⟦f_g⟧, ←
          @category.comp_id (F C) _ _ _ ⟦f_g⟧, ←
          category.id_comp ((discrete.functor inclusion_obj).map _), tensor_comp]
        dsimp
        simp only [category.assoc, category.comp_id]
        congr 1
        convert(normalize_iso_aux C f_Z).Hom.naturality ((normalize_map_aux f_f).app n)
        exact (tensor_func_obj_map _ _ _).symm)
#align category_theory.free_monoidal_category.normalize_iso CategoryTheory.FreeMonoidalCategory.normalizeIso

/-- The isomorphism between an object and its normal form is natural. -/
def fullNormalizeIso : 𝟭 (F C) ≅ fullNormalize C ⋙ inclusion :=
  NatIso.ofComponents
    (fun X => (λ_ X).symm ≪≫ ((normalizeIso C).app X).app ⟨NormalMonoidalObject.unit⟩)
    (by
      intro X Y f
      dsimp
      rw [left_unitor_inv_naturality_assoc, category.assoc, iso.cancel_iso_inv_left]
      exact
        congr_arg (fun f => nat_trans.app f (discrete.mk normal_monoidal_object.unit))
          ((normalizeIso.{u} C).Hom.naturality f))
#align category_theory.free_monoidal_category.full_normalize_iso CategoryTheory.FreeMonoidalCategory.fullNormalizeIso

end

/-- The monoidal coherence theorem. -/
instance subsingleton_hom : Quiver.IsThin (F C) := fun _ _ =>
  ⟨fun f g =>
    by
    have : (fullNormalize C).map f = (fullNormalize C).map g := Subsingleton.elim _ _
    rw [← functor.id_map f, ← functor.id_map g]
    simp [← nat_iso.naturality_2 (fullNormalizeIso.{u} C), this]⟩
#align category_theory.free_monoidal_category.subsingleton_hom CategoryTheory.FreeMonoidalCategory.subsingleton_hom

section Groupoid

section

open Hom

/-- Auxiliary construction for showing that the free monoidal category is a groupoid. Do not use
    this, use `is_iso.inv` instead. -/
def inverseAux : ∀ {X Y : F C}, (X ⟶ᵐ Y) → (Y ⟶ᵐ X)
  | _, _, id X => id X
  | _, _, α_hom _ _ _ => α_inv _ _ _
  | _, _, α_inv _ _ _ => α_hom _ _ _
  | _, _, ρ_hom _ => ρ_inv _
  | _, _, ρ_inv _ => ρ_hom _
  | _, _, l_hom _ => l_inv _
  | _, _, l_inv _ => l_hom _
  | _, _, comp f g => (inverse_aux g).comp (inverse_aux f)
  | _, _, hom.tensor f g => (inverse_aux f).tensor (inverse_aux g)
#align category_theory.free_monoidal_category.inverse_aux CategoryTheory.FreeMonoidalCategory.inverseAux

end

instance : Groupoid.{u} (F C) :=
  { (inferInstance : Category (F C)) with
    inv := fun X Y => Quotient.lift (fun f => ⟦inverseAux f⟧) (by tidy) }

end Groupoid

end FreeMonoidalCategory

end CategoryTheory


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

! This file was ported from Lean 3 source module data.fin.succ_pred
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fin.Basic
import Mathbin.Order.SuccPred.Basic

/-!
# Successors and predecessors of `fin n`

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

In this file, we show that `fin n` is both a `succ_order` and a `pred_order`. Note that they are
also archimedean, but this is derived from the general instance for well-orderings as opposed
to a specific `fin` instance.

-/

namespace Fin

instance : ∀ {n : ℕ}, SuccOrder (Fin n)
  | 0 => by constructor <;> exact elim0
  | n + 1 =>
    SuccOrder.ofCore (fun i => if i < Fin.last n then i + 1 else i)
      (by
        intro a ha b
        rw [isMax_iff_eq_top, eq_top_iff, not_le, top_eq_last] at ha
        rw [if_pos ha, lt_iff_coe_lt_coe, le_iff_coe_le_coe, coe_add_one_of_lt ha]
        exact Nat.lt_iff_add_one_le)
      (by
        intro a ha
        rw [isMax_iff_eq_top, top_eq_last] at ha
        rw [if_neg ha.not_lt])

/- warning: fin.succ_eq -> Fin.succ_eq is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, Eq.{1} ((Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) -> (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (SuccOrder.succ.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (PartialOrder.toPreorder.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.partialOrder (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (Fin.succOrder (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (fun (a : Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) => ite.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (LT.lt.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.hasLt (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) a (Fin.last n)) (Fin.decidableLt (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) a (Fin.last n)) (HAdd.hAdd.{0, 0, 0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (instHAdd.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.hasAdd (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 1 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 1 (One.one.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasOneOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n)))))) a)
but is expected to have type
  forall {n : Nat}, Eq.{1} ((Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) -> (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (SuccOrder.succ.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (PartialOrder.toPreorder.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin.instPartialOrderFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (Fin.instForAllNatSuccOrderFinToPreorderInstPartialOrderFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (fun (a : Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) => ite.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (LT.lt.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (instLTFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) a (Fin.last n)) (Fin.decLt (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) a (Fin.last n)) (HAdd.hAdd.{0, 0, 0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (instHAdd.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin.instAddFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 1 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 1 (NeZero.succ n)))) a)
Case conversion may be inaccurate. Consider using '#align fin.succ_eq Fin.succ_eqₓ'. -/
@[simp]
theorem succ_eq {n : ℕ} : SuccOrder.succ = fun a => if a < Fin.last n then a + 1 else a :=
  rfl
#align fin.succ_eq Fin.succ_eq

/- warning: fin.succ_apply -> Fin.succ_apply is a dubious translation:
lean 3 declaration is
  forall {n : Nat} (a : Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))), Eq.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (SuccOrder.succ.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (PartialOrder.toPreorder.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.partialOrder (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (Fin.succOrder (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) a) (ite.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (LT.lt.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.hasLt (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) a (Fin.last n)) (Fin.decidableLt (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) a (Fin.last n)) (HAdd.hAdd.{0, 0, 0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (instHAdd.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.hasAdd (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 1 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 1 (One.one.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasOneOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n)))))) a)
but is expected to have type
  forall {n : Nat} (a : Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))), Eq.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (SuccOrder.succ.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (PartialOrder.toPreorder.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin.instPartialOrderFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (Fin.instForAllNatSuccOrderFinToPreorderInstPartialOrderFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) a) (ite.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (LT.lt.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (instLTFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) a (Fin.last n)) (Fin.decLt (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) a (Fin.last n)) (HAdd.hAdd.{0, 0, 0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (instHAdd.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin.instAddFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 1 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 1 (NeZero.succ n)))) a)
Case conversion may be inaccurate. Consider using '#align fin.succ_apply Fin.succ_applyₓ'. -/
@[simp]
theorem succ_apply {n : ℕ} (a) : SuccOrder.succ a = if a < Fin.last n then a + 1 else a :=
  rfl
#align fin.succ_apply Fin.succ_apply

instance : ∀ {n : ℕ}, PredOrder (Fin n)
  | 0 => by constructor <;> exact elim0
  | n + 1 =>
    PredOrder.ofCore (fun x => if x = 0 then 0 else x - 1)
      (by
        intro a ha b
        rw [isMin_iff_eq_bot, eq_bot_iff, not_le, bot_eq_zero] at ha
        rw [if_neg ha.ne', lt_iff_coe_lt_coe, le_iff_coe_le_coe, coe_sub_one, if_neg ha.ne',
          le_tsub_iff_right, Iff.comm]
        exact Nat.lt_iff_add_one_le
        exact ha)
      (by
        intro a ha
        rw [isMin_iff_eq_bot, bot_eq_zero] at ha
        rwa [if_pos ha, eq_comm])

/- warning: fin.pred_eq -> Fin.pred_eq is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, Eq.{1} ((Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) -> (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (PredOrder.pred.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (PartialOrder.toPreorder.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.partialOrder (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (Fin.predOrder (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (fun (a : Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) => ite.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Eq.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (Zero.zero.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasZeroOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n)))))) (Fin.decidableEq (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (Zero.zero.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasZeroOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n)))))) (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (Zero.zero.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasZeroOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n))))) (HSub.hSub.{0, 0, 0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (instHSub.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.hasSub (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 1 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 1 (One.one.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasOneOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n)))))))
but is expected to have type
  forall {n : Nat}, Eq.{1} ((Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) -> (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (PredOrder.pred.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (PartialOrder.toPreorder.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin.instPartialOrderFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (Fin.instForAllNatPredOrderFinToPreorderInstPartialOrderFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (fun (a : Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) => ite.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Eq.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 0 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 0 (NeZero.succ n)))) (instDecidableEqFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 0 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 0 (NeZero.succ n)))) (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 0 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 0 (NeZero.succ n))) (HSub.hSub.{0, 0, 0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (instHSub.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin.instSubFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 1 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 1 (NeZero.succ n)))))
Case conversion may be inaccurate. Consider using '#align fin.pred_eq Fin.pred_eqₓ'. -/
@[simp]
theorem pred_eq {n} : PredOrder.pred = fun a : Fin (n + 1) => if a = 0 then 0 else a - 1 :=
  rfl
#align fin.pred_eq Fin.pred_eq

/- warning: fin.pred_apply -> Fin.pred_apply is a dubious translation:
lean 3 declaration is
  forall {n : Nat} (a : Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))), Eq.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (PredOrder.pred.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (PartialOrder.toPreorder.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.partialOrder (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (Fin.predOrder (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) a) (ite.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Eq.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (Zero.zero.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasZeroOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n)))))) (Fin.decidableEq (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (Zero.zero.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasZeroOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n)))))) (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 0 (Zero.zero.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasZeroOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n))))) (HSub.hSub.{0, 0, 0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (instHSub.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Fin.hasSub (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 1 (OfNat.mk.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) 1 (One.one.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne))) (Fin.hasOneOfNeZero (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (One.one.{0} Nat Nat.hasOne)) (NeZero.succ n)))))))
but is expected to have type
  forall {n : Nat} (a : Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))), Eq.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (PredOrder.pred.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (PartialOrder.toPreorder.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin.instPartialOrderFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (Fin.instForAllNatPredOrderFinToPreorderInstPartialOrderFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) a) (ite.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Eq.{1} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 0 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 0 (NeZero.succ n)))) (instDecidableEqFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 0 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 0 (NeZero.succ n)))) (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 0 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 0 (NeZero.succ n))) (HSub.hSub.{0, 0, 0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (instHSub.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Fin.instSubFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) a (OfNat.ofNat.{0} (Fin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) 1 (Fin.instOfNatFin (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) 1 (NeZero.succ n)))))
Case conversion may be inaccurate. Consider using '#align fin.pred_apply Fin.pred_applyₓ'. -/
@[simp]
theorem pred_apply {n : ℕ} (a : Fin (n + 1)) : PredOrder.pred a = if a = 0 then 0 else a - 1 :=
  rfl
#align fin.pred_apply Fin.pred_apply

end Fin


import mathlib.cardinal
import mathlib.order
import mathlib.with_bot
import set_theory.cardinal.cofinality

/-!
# Parameters of the construction

This file is based on sections 3.1 and 3.2 of the paper.
-/

/-!
We do not assume that our definitions, instances, lemmas and theorems are 'computable';
that is, can be provably evaluated in finite time by a computer.
For our purposes, restricting to only computable functions is unnecessary.
-/
noncomputable theory

open cardinal set
open_locale cardinal classical

universe u

namespace con_nf

/--
The parameters of the constructions. We collect them all in one class for simplicity.
Note that the ordinal `λ` in the paper is instead referred to here as `Λ`, since the symbol `λ` is
used for lambda abstractions.

Ordinals and cardinals are represented here as arbitrary types (not sets) with certain properties.
For instance, `Λ` is an arbitrary type that has an ordering `Λr`, which is assumed to be a
well-ordering (the `Λwf` term is a proof of this fact). If `Λr a b` holds, then we can say `a < b`.

The prefix `#` denotes the cardinality of a type.

Where possible, we use `<` and `≤` instead of `>` and `≥`. Human readers can easily convert between
the two, but it is not as immediately transparent for Lean. For simplicity, we keep with the
convention of using only `<` and `≤`.
-/
class params :=
(Λ : Type u) (Λr : Λ → Λ → Prop) [Λwf : is_well_order Λ Λr]
(Λ_ord : ordinal.type Λr = (#Λ).ord)
(Λ_limit : (#Λ).is_limit)
(κ : Type u) (κ_regular : (#κ).is_regular) (κr : κ → κ → Prop) [κwf : is_well_order κ κr]
(κ_ord : ordinal.type κr = (#κ).ord)
(Λ_lt_κ : #Λ < #κ)
(μ : Type u) (μr : μ → μ → Prop) [μwf : is_well_order μ μr]
(μ_ord : ordinal.type μr = (#μ).ord)
(μ_strong_limit : (#μ).is_strong_limit)
(κ_lt_μ : #κ < #μ)
(κ_le_μ_cof : #κ ≤ (#μ).ord.cof)

export params (Λ Λr Λwf Λ_ord Λ_limit κ κ_regular κr κwf κ_ord Λ_lt_κ μ μr μwf μ_ord μr
  μ_strong_limit κ_lt_μ κ_le_μ_cof)

-- TODO: Remove the ordering on `κ`.

/-!
### Explicit parameters

There exists valid parameters for the model. The smallest parameters are
* `Λ := ℵ_0`
* `κ := ℵ_1`
* `μ = ℶ_{ω_1}`.
-/

example : params.{0} :=
{ Λ := ℕ,
  Λr := (<),
  Λwf := infer_instance,
  Λ_ord := by simp only [mk_denumerable, ord_aleph_0, ordinal.type_nat_lt],
  Λ_limit := by { rw mk_denumerable, exact is_limit_aleph_0 },
  κ := (aleph 1).ord.out.α,
  κr := (aleph 1).ord.out.r,
  κwf := (aleph 1).ord.out.wo,
  κ_ord := by simp,
  κ_regular := by { rw [mk_ordinal_out, card_ord], exact is_regular_aleph_one },
  Λ_lt_κ := by { rw [mk_denumerable, mk_ordinal_out, card_ord], exact aleph_0_lt_aleph_one },
  μ := (beth $ ord $ aleph 1).ord.out.α,
  μr := (beth $ ord $ aleph 1).ord.out.r,
  μwf := (beth $ ord $ aleph 1).ord.out.wo,
  μ_ord := by simp,
  μ_strong_limit := by simp [is_strong_limit_beth (ord_is_limit $ aleph_0_le_aleph 1).2],
  κ_lt_μ := by { simp only [mk_out, mk_ordinal_out, card_ord],
    exact (aleph_le_beth _).trans_lt (beth_strict_mono (ord_aleph_is_limit _).one_lt) },
  κ_le_μ_cof := begin
    simp only [mk_out, mk_ordinal_out, card_ord],
    rw beth_normal.cof_eq (ord_is_limit $ aleph_0_le_aleph 1),
    exact is_regular_aleph_one.2,
  end }

lemma no_max_order_of_ordinal_type_eq {α : Type u} [preorder α] [infinite α]
  [is_well_order α (<)] (h : ordinal.type ((<) : α → α → Prop) = (#α).ord) :
  no_max_order α :=
begin
  refine ⟨λ a, _⟩,
  have := (ordinal.succ_lt_of_is_limit _).mpr (ordinal.typein_lt_type (<) a),
  { obtain ⟨b, hb⟩ := ordinal.typein_surj (<) this,
    refine ⟨b, _⟩,
    have := order.lt_succ _,
    rw [← hb, ordinal.typein_lt_typein] at this,
    exact this,
    apply_instance, },
  { rw h,
    exact cardinal.ord_is_limit (cardinal.infinite_iff.mp infer_instance), },
end

noncomputable def succ_order_of_is_well_order (α : Type u) [preorder α] [infinite α]
  [inst : is_well_order α (<)] (h : ordinal.type ((<) : α → α → Prop) = (#α).ord) :
  succ_order α := {
  succ := inst.to_is_well_founded.wf.succ,
  le_succ := λ a, le_of_lt (well_founded.lt_succ _
    ((no_max_order_of_ordinal_type_eq h).exists_gt a)),
  max_of_succ_le := λ a ha b hb,
    (ha.not_lt (well_founded.lt_succ _ ((no_max_order_of_ordinal_type_eq h).exists_gt a))).elim,
  succ_le_of_lt := begin
    intros a b ha,
    by_contradiction hb,
    obtain (hab | hab | hab) :=
      inst.to_is_trichotomous.trichotomous (inst.to_is_well_founded.wf.succ a) b,
    { exact hb hab.le, },
    { exact hb hab.le, },
    { rw well_founded.lt_succ_iff ((no_max_order_of_ordinal_type_eq h).exists_gt a) at hab,
      cases hab,
      exact ha.not_lt hab,
      exact ha.ne hab.symm, },
  end,
  le_of_lt_succ := begin
    intros a b ha,
    rw well_founded.lt_succ_iff ((no_max_order_of_ordinal_type_eq h).exists_gt _) at ha,
    cases ha,
    exact ha.le,
    exact ha.le,
  end,
}

variables [params.{u}] {ι α β : Type u}

/-- To allow Lean's type checker to see that the ordering `Λr` is a well-ordering without having to
explicitly write `Λwf` everywhere, we declare it as an instance. -/
instance : is_well_order Λ Λr := Λwf
instance : is_well_order κ κr := κwf
instance : is_well_order μ μr := μwf
/-- We can deduce from the well-ordering `Λwf` that `Λ` is linearly ordered. -/
instance : linear_order Λ := linear_order_of_STO Λr
instance : linear_order κ := linear_order_of_STO κr
instance : linear_order μ := linear_order_of_STO μr
/-- We deduce that `Λ` has a well-founded relation. -/
instance : has_well_founded Λ := is_well_order.to_has_well_founded
instance : has_well_founded κ := is_well_order.to_has_well_founded
instance : has_well_founded μ := is_well_order.to_has_well_founded

lemma κ_le_μ : #κ ≤ #μ := κ_lt_μ.le

noncomputable instance : inhabited Λ :=
@classical.inhabited_of_nonempty _ $ mk_ne_zero_iff.1 Λ_limit.ne_zero

noncomputable instance : inhabited κ :=
@classical.inhabited_of_nonempty _ $ mk_ne_zero_iff.1 κ_regular.pos.ne'

noncomputable instance : inhabited μ :=
@classical.inhabited_of_nonempty _ $ mk_ne_zero_iff.1 μ_strong_limit.ne_zero

instance : infinite Λ := cardinal.infinite_iff.mpr Λ_limit.aleph_0_le
instance : infinite κ := cardinal.infinite_iff.mpr κ_regular.aleph_0_le
instance : infinite μ := cardinal.infinite_iff.mpr μ_strong_limit.is_limit.aleph_0_le

instance : no_max_order Λ := no_max_order_of_ordinal_type_eq Λ_ord
instance : no_max_order μ := no_max_order_of_ordinal_type_eq μ_ord

noncomputable instance : succ_order Λ := succ_order_of_is_well_order Λ Λ_ord
noncomputable instance : succ_order μ := succ_order_of_is_well_order μ μ_ord

/-- Either the base type or a proper type index (an element of `Λ`).
The base type is written `⊥`. -/
@[reducible]
def type_index := with_bot Λ

@[simp] lemma mk_type_index : #type_index = #Λ :=
mk_option.trans $ add_eq_left Λ_limit.aleph_0_le $ one_le_aleph_0.trans Λ_limit.aleph_0_le

/- Since `Λ` is well-ordered, so is `Λ` together with the base type `⊥`.
This allows well founded recursion on type indices. -/

noncomputable instance : linear_order type_index := linear_order_of_STO (<)
noncomputable instance : has_well_founded type_index := is_well_order.to_has_well_founded

/-- The litters. This is the type indexing the partition of `atom`. -/
structure litter :=
(ν : μ)
(β : type_index)
(γ : Λ)
(β_ne_γ : β ≠ γ)

instance : inhabited litter :=
⟨⟨arbitrary μ, ⊥, arbitrary Λ, with_bot.bot_ne_coe⟩⟩

/-- Litters are equivalent to a subtype of a product type. -/
def litter_equiv : litter ≃ {a : μ ×ₗ type_index ×ₗ Λ // a.2.1 ≠ a.2.2} :=
{ to_fun := λ L, ⟨⟨L.ν, L.β, L.γ⟩, L.β_ne_γ⟩,
  inv_fun := λ L, ⟨L.val.1, L.val.2.1, L.val.2.2, L.prop⟩,
  left_inv := by rintro ⟨ν, β, γ, h⟩; refl,
  right_inv := by rintro ⟨⟨ν, β, γ⟩, h⟩; refl }

instance subtype.is_well_order {α : Type*} (p : α → Prop) [has_lt α] [is_well_order α (<)] :
  is_well_order (subtype p) (<) :=
rel_embedding.is_well_order (subtype.rel_embedding (<) p)

instance lex.is_well_order {α β : Type*} [has_lt α] [has_lt β]
  [is_well_order α (<)] [is_well_order β (<)] : is_well_order (α ×ₗ β) (<) := prod.lex.is_well_order

@[simp] lemma mk_litter : #litter = #μ :=
begin
  refine litter_equiv.cardinal_eq.trans (le_antisymm ((cardinal.mk_subtype_le _).trans_eq _)
    ⟨⟨λ ν, ⟨⟨ν, ⊥, arbitrary Λ⟩, with_bot.bot_ne_coe⟩, λ ν₁ ν₂, congr_arg $ prod.fst ∘ subtype.val⟩⟩),
  have := mul_eq_left (κ_regular.aleph_0_le.trans κ_le_μ) (Λ_lt_κ.le.trans κ_lt_μ.le)
    Λ_limit.ne_zero,
  simp only [lex, mk_prod, lift_id, mk_type_index, mul_eq_self Λ_limit.aleph_0_le, this],
end

/-- Principal segments (sets of the form `{y | y < x}`) have cardinality `< μ`. -/
lemma card_Iio_lt (x : μ) : #(Iio x) < #μ := card_typein_lt (<) x μ_ord.symm

/-- Initial segments (sets of the form `{y | y ≤ x}`) have cardinality `< μ`. -/
lemma card_Iic_lt (x : μ) : #(Iic x) < #μ :=
begin
  rw [←Iio_union_right, mk_union_of_disjoint, mk_singleton],
  { exact (add_one_le_succ _).trans_lt (μ_strong_limit.is_limit.2 _ $ card_Iio_lt x) },
  { simp }
end

instance : has_lt litter := ⟨litter_equiv ⁻¹'o (<)⟩

/-- Litters are well-ordered. -/
instance litter.is_well_order : is_well_order litter (<) :=
rel_iso.is_well_order.preimage _ litter_equiv

instance : linear_order litter := linear_order_of_STO (<)
instance : has_well_founded litter := is_well_order.to_has_well_founded

/-- The base type of the construction, `τ₋₁` in the document. Instead of declaring it as an
arbitrary type of cardinality `μ` and partitioning it into suitable sets of litters afterwards, we
define it as `litter × κ`, which has the correct cardinality and comes with a natural
partition.

These are not 'atoms' in the ZFU, TTTU or NFU sense; they are simply the elements of the model which
are in type `τ₋₁`. -/
@[derive inhabited] def atom : Type* := litter × κ

instance : has_lt atom := ⟨prod.lex (<) (<)⟩

/-- Atoms are well-ordered. -/
instance atom.is_well_order : is_well_order atom (<) := prod.lex.is_well_order

instance : linear_order atom := linear_order_of_STO (<)
instance : has_well_founded atom := is_well_order.to_has_well_founded

/-- The cardinality of `τ₋₁` is the cardinality of `μ`.
We will prove that all types constructed in our model have cardinality equal to `μ`. -/
@[simp] lemma mk_atom : #atom = #μ :=
by simp_rw [atom, mk_prod, lift_id, mk_litter,
  mul_eq_left (κ_regular.aleph_0_le.trans κ_le_μ) κ_le_μ κ_regular.pos.ne']

section small
variables {f : α → β} {s t : set α}

/-- A set is small if its cardinality is strictly less than `κ`. -/
def small (s : set α) := #s < #κ

lemma small.lt : small s → #s < #κ := id

lemma _root_.set.subsingleton.small {α : Type*} {s : set α} (hs : s.subsingleton) : small s :=
hs.cardinal_mk_le_one.trans_lt $ one_lt_aleph_0.trans_le κ_regular.aleph_0_le

@[simp] lemma small_empty : small (∅ : set α) := subsingleton_empty.small
@[simp] lemma small_singleton (x : α) : small ({x} : set α) := subsingleton_singleton.small

lemma small_set_of (p : α → Prop) : small (λ a, p a) ↔ small {a | p a} := iff.rfl

lemma small_of_forall_not_mem {s : set α} (h : ∀ x, x ∉ s) : small s :=
by simp only [eq_empty_of_forall_not_mem h, small_empty]

/-- Subsets of small sets are small. We say that the 'smallness' relation is monotone. -/
lemma small.mono (h : s ⊆ t) : small t → small s := (mk_le_mk_of_subset h).trans_lt

/-- Unions of small subsets are small. -/
lemma small.union (hs : small s) (ht : small t) : small (s ∪ t) :=
(mk_union_le _ _).trans_lt $ add_lt_of_lt κ_regular.aleph_0_le hs ht

lemma small.symm_diff (hs : small s) (ht : small t) : small (s ∆ t) :=
(hs.union ht).mono symm_diff_subset_union

lemma small.symm_diff_iff (hs : small s) : small t ↔ small (s ∆ t) :=
⟨hs.symm_diff, λ ht, by simpa only [symm_diff_symm_diff_self'] using ht.symm_diff hs⟩

lemma small_Union (hι : #ι < #κ) {f : ι → set α} (hf : ∀ i, small (f i)) : small (⋃ i, f i) :=
(mk_Union_le _).trans_lt $ mul_lt_of_lt κ_regular.aleph_0_le hι $
  supr_lt_of_is_regular κ_regular hι hf

lemma small_Union_Prop {p : Prop} {f : p → set α} (hf : ∀ i, small (f i)) : small (⋃ i, f i) :=
by by_cases p; simp [h, hf _]

protected lemma small.bUnion {s : set ι} (hs : small s) {f : Π i ∈ s, set α}
  (hf : ∀ i (hi : i ∈ s), small (f i hi)) : small (⋃ i (hi : i ∈ s), f i hi) :=
(mk_bUnion_le' _ _).trans_lt $ mul_lt_of_lt κ_regular.aleph_0_le hs $
  supr_lt_of_is_regular κ_regular hs $ λ i, hf _ _

/-- The image of a small set under any function `f` is small. -/
lemma small.image : small s → small (f '' s) := mk_image_le.trans_lt

/-- The preimage of a small set under an injective function `f` is small. -/
lemma small.preimage {s : set β} (h : f.injective) : small s → small (f ⁻¹' s) :=
(mk_preimage_of_injective f s h).trans_lt

-- TODO: Convert random smallness manipulations into invocations of this lemma.
/-- A set is small if its image under an injective function is contained in a small set. -/
lemma small.image_subset {t : set β} (f : α → β) (h : f.injective) :
  small t → f '' s ⊆ t → small s :=
begin
  intros h₁ h₂,
  have := (small.mono h₂ h₁).preimage h,
  rw [preimage_image_eq s h] at this,
  exact this,
end

end small

section is_near
variables {s t u : set α}

/-- Two sets are near if their symmetric difference is small. -/
def is_near (s t : set α) : Prop := small (s ∆ t)

/-- A set is near itself. -/
@[refl] lemma is_near_refl (s : set α) : is_near s s :=
by { rw [is_near, symm_diff_self], exact small_empty }

/-- A version of the `is_near_refl` lemma that does not require the set `s` to be given explicitly.
The value of `s` will be inferred automatically by the elaborator. -/
lemma is_near_rfl : is_near s s := is_near_refl _

/-- If `s` is near `t`, then `t` is near `s`. -/
@[symm] lemma is_near.symm (h : is_near s t) : is_near t s := by rwa [is_near, symm_diff_comm]
/-- `s` is near `t` if and only if `t` is near `s`.
In each direction, this is an application of the `is_near.symm` lemma.
Lemmas using `↔` can be used with `rw`, so this form of the result is particularly useful. -/
lemma is_near_comm : is_near s t ↔ is_near t s := ⟨is_near.symm, is_near.symm⟩

/-- Nearness is transitive: if `s` is near `t` and `t` is near `u`, then `s` is near `u`. -/
@[trans] lemma is_near.trans (hst : is_near s t) (htu : is_near t u) : is_near s u :=
(hst.union htu).mono $ symm_diff_triangle s t u

/-- If two sets are near each other, then their images under an arbitrary function are also near. -/
lemma is_near.image (f : α → β) (h : is_near s t) : is_near (f '' s) (f '' t) :=
h.image.mono subset_image_symm_diff

lemma is_near_of_small (hs : small s) (ht : small t) : is_near s t :=
small.symm_diff hs ht

lemma small.is_near_iff (hs : small s) : small t ↔ is_near s t :=
hs.symm_diff_iff

lemma is_near.κ_le (h : is_near s t) (hs : #κ ≤ #s) : #κ ≤ #(t : set α) :=
begin
  by_contradiction ht,
  rw not_le at ht,
  have := h.symm,
  rw ← small.is_near_iff ht at this,
  exact (lt_iff_not_ge _ _).mp this hs,
end

lemma is_near.mk_inter (h : is_near s t) (hs : #κ ≤ #s) : #κ ≤ #(s ∩ t : set α) :=
begin
  rw [is_near, symm_diff_eq_sup_sdiff_inf] at h,
  exact le_of_not_gt (λ hst, lt_irrefl _
    (((hs.trans (mk_le_mk_of_subset (subset_union_left _ _))).trans
    (le_mk_diff_add_mk (s ∪ t) (s ∩ t))).trans_lt (add_lt_of_lt κ_regular.aleph_0_le h hst))),
end

end is_near
end con_nf


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Simon Hudon
-/
import control.functor.multivariate
import data.pfunctor.univariate.basic

/-!
# Multivariate polynomial functors.

Multivariate polynomial functors are used for defining M-types and W-types.
They map a type vector `α` to the type `Σ a : A, B a ⟹ α`, with `A : Type` and
`B : A → typevec n`. They interact well with Lean's inductive definitions because
they guarantee that occurrences of `α` are positive.
-/

universes u v
open_locale mvfunctor

/--
multivariate polynomial functors
-/
structure mvpfunctor (n : ℕ) :=
(A : Type.{u}) (B : A → typevec.{u} n)

namespace mvpfunctor
open mvfunctor (liftp liftr)

variables {n m : ℕ} (P : mvpfunctor.{u} n)

/-- Applying `P` to an object of `Type` -/
def obj (α : typevec.{u} n) : Type u := Σ a : P.A, P.B a ⟹ α

/-- Applying `P` to a morphism of `Type` -/
def map {α β : typevec n} (f : α ⟹ β) : P.obj α → P.obj β :=
λ ⟨a, g⟩, ⟨a, typevec.comp f g⟩

instance : inhabited (mvpfunctor n) :=
⟨ ⟨default, λ _, default⟩ ⟩

instance obj.inhabited {α : typevec n} [inhabited P.A] [Π i, inhabited (α i)] :
  inhabited (P.obj α) :=
⟨ ⟨default, λ _ _, default⟩ ⟩

instance : mvfunctor P.obj :=
⟨@mvpfunctor.map n P⟩

theorem map_eq {α β : typevec n} (g : α ⟹ β) (a : P.A) (f : P.B a ⟹ α) :
  @mvfunctor.map _ P.obj _ _ _ g ⟨a, f⟩ = ⟨a, g ⊚ f⟩ :=
rfl

theorem id_map {α : typevec n} : ∀ x : P.obj α, typevec.id <$$> x = x
| ⟨a, g⟩ := rfl

theorem comp_map {α β γ : typevec n} (f : α ⟹ β) (g : β ⟹ γ) :
  ∀ x : P.obj α, (g ⊚ f) <$$> x = g <$$> (f <$$> x)
| ⟨a, h⟩ := rfl

instance : is_lawful_mvfunctor P.obj :=
{ id_map := @id_map _ P,
  comp_map := @comp_map _ P }

/-- Constant functor where the input object does not affect the output -/
def const (n : ℕ) (A : Type u) : mvpfunctor n :=
{ A := A, B := λ a i, pempty }

section const
variables (n) {A : Type u}  {α β : typevec.{u} n}

/-- Constructor for the constant functor -/
def const.mk (x : A) {α} : (const n A).obj α :=
⟨ x, λ i a, pempty.elim a ⟩

variables {n A}

/-- Destructor for the constant functor -/
def const.get (x : (const n A).obj α) : A :=
x.1

@[simp]
lemma const.get_map (f : α ⟹ β) (x : (const n A).obj α) :
  const.get (f <$$> x) = const.get x :=
by { cases x, refl }

@[simp]
lemma const.get_mk (x : A) : const.get (const.mk n x : (const n A).obj α) = x :=
by refl

@[simp]
lemma const.mk_get (x : (const n A).obj α) : const.mk n (const.get x) = x :=
by { cases x, dsimp [const.get,const.mk], congr' with _ ⟨ ⟩ }

end const

/-- Functor composition on polynomial functors -/
def comp (P : mvpfunctor.{u} n) (Q : fin2 n → mvpfunctor.{u} m) : mvpfunctor m :=
{ A := Σ a₂ : P.1, Π i, P.2 a₂ i → (Q i).1,
  B := λ a, λ i, Σ j (b : P.2 a.1 j), (Q j).2 (a.snd j b) i }

variables {P} {Q : fin2 n → mvpfunctor.{u} m} {α β : typevec.{u} m}

/-- Constructor for functor composition -/
def comp.mk (x : P.obj (λ i, (Q i).obj α)) : (comp P Q).obj α :=
⟨ ⟨ x.1, λ i a, (x.2 _ a).1  ⟩, λ i a, (x.snd a.fst (a.snd).fst).snd i (a.snd).snd ⟩

/-- Destructor for functor composition -/
def comp.get (x : (comp P Q).obj α) : P.obj (λ i, (Q i).obj α) :=
⟨ x.1.1, λ i a, ⟨x.fst.snd i a, λ (j : fin2 m) (b : (Q i).B _ j), x.snd j ⟨i, ⟨a, b⟩⟩⟩ ⟩

lemma comp.get_map (f : α ⟹ β) (x : (comp P Q).obj α) :
  comp.get (f <$$> x) = (λ i (x : (Q i).obj α), f <$$> x) <$$> comp.get x :=
by { cases x, refl }

@[simp]
lemma comp.get_mk (x : P.obj (λ i, (Q i).obj α)) : comp.get (comp.mk x) = x :=
begin
  cases x,
  simp! [comp.get,comp.mk],
end

@[simp]
lemma comp.mk_get (x : (comp P Q).obj α) : comp.mk (comp.get x) = x :=
begin
  cases x,
  dsimp [comp.get,comp.mk],
  ext : 2; intros, refl, refl,
  congr, ext1; intros; refl,
  ext : 2, congr, rcases x_1 with ⟨a,b,c⟩; refl
end

/-
lifting predicates and relations
-/

theorem liftp_iff {α : typevec n} (p : Π ⦃i⦄ , α i → Prop) (x : P.obj α) :
  liftp p x ↔ ∃ a f, x = ⟨a, f⟩ ∧ ∀ i j, p (f i j) :=
begin
  split,
  { rintros ⟨y, hy⟩, cases h : y with a f,
    refine ⟨a, λ i j, (f i j).val, _, λ i j, (f i j).property⟩,
    rw [←hy, h, map_eq], refl },
  rintros ⟨a, f, xeq, pf⟩,
  use ⟨a, λ i j, ⟨f i j, pf i j⟩⟩,
  rw [xeq], reflexivity
end

theorem liftp_iff' {α : typevec n} (p : Π ⦃i⦄ , α i → Prop) (a : P.A) (f : P.B a ⟹ α) :
  @liftp.{u} _ P.obj _ α p ⟨a,f⟩ ↔ ∀ i x, p (f i x) :=
begin
  simp only [liftp_iff, sigma.mk.inj_iff]; split; intro,
  { casesm* [Exists _, _ ∧ _], subst_vars, assumption },
  repeat { constructor <|> assumption }
end

theorem liftr_iff {α : typevec n} (r : Π ⦃i⦄, α i → α i → Prop) (x y : P.obj α) :
  liftr r x y ↔ ∃ a f₀ f₁, x = ⟨a, f₀⟩ ∧ y = ⟨a, f₁⟩ ∧ ∀ i j, r (f₀ i j) (f₁ i j) :=
begin
  split,
  { rintros ⟨u, xeq, yeq⟩, cases h : u with a f,
    use [a, λ i j, (f i j).val.fst, λ i j, (f i j).val.snd],
    split, { rw [←xeq, h], refl },
    split, { rw [←yeq, h], refl },
    intros i j, exact (f i j).property },
  rintros ⟨a, f₀, f₁, xeq, yeq, h⟩,
  use ⟨a, λ i j, ⟨(f₀ i j, f₁ i j), h i j⟩⟩,
  dsimp, split,
  { rw [xeq], refl },
  rw [yeq], refl
end

open set mvfunctor

theorem supp_eq {α : typevec n} (a : P.A) (f : P.B a ⟹ α) (i) :
  @supp.{u} _ P.obj _ α  (⟨a,f⟩ : P.obj α) i = f i '' univ :=
begin
  ext, simp only [supp, image_univ, mem_range, mem_set_of_eq],
  split; intro h,
  { apply @h (λ i x, ∃ (y : P.B a i), f i y = x),
    rw liftp_iff', intros, refine ⟨_,rfl⟩ },
  { simp only [liftp_iff'], cases h, subst x,
    tauto }
end

end mvpfunctor

/-
Decomposing an n+1-ary pfunctor.
-/

namespace mvpfunctor
open typevec
variables {n : ℕ} (P : mvpfunctor.{u} (n+1))

/-- Split polynomial functor, get a n-ary functor
from a `n+1`-ary functor -/
def drop : mvpfunctor n :=
{ A := P.A, B := λ a, (P.B a).drop }

/-- Split polynomial functor, get a univariate functor
from a `n+1`-ary functor -/
def last : pfunctor :=
{ A := P.A, B := λ a, (P.B a).last }

/-- append arrows of a polynomial functor application -/
@[reducible] def append_contents {α : typevec n} {β : Type*}
    {a : P.A} (f' : P.drop.B a ⟹ α) (f : P.last.B a → β) :
  P.B a ⟹ α ::: β :=
split_fun f' f

end mvpfunctor


import rat_additions tactic.norm_num --comp_val
open tactic

lemma rat_pow_mul (a : ℚ) (e : ℤ) : rat.pow a (e + e) = rat.pow a e * rat.pow a e := sorry

@[simp]
lemma rat.pow_zero (b : ℚ) : rat.pow b 0 = 1 := sorry

attribute [simp] rat.pow_one

meta def pf_by_norm_num : tactic unit :=
do (lhs, rhs) ← target >>= match_eq,
   (lhsv, lhspf) ← norm_num lhs,
   (rhsv, rhspf) ← norm_num rhs,
   to_expr ``(eq.trans %%lhspf (eq.symm %%rhspf)) >>= exact

lemma f1 (a) : rat.pow a ↑(0 : ℕ) = rat.pow a 0 := sorry
lemma f2 (a) : rat.pow a ↑(1 : ℕ) = rat.pow a 1 := sorry
lemma f3 (a b) : rat.pow a ↑(bit1 b : ℕ) = rat.pow a (bit1 ↑b) := sorry
lemma f4 (a b) : rat.pow a ↑(bit0 b : ℕ) = rat.pow a (bit0 ↑b) := sorry

meta def rat_pow_simp_lemmas : tactic simp_lemmas :=
to_simp_lemmas simp_lemmas.mk [`pow_bit0, `pow_bit1, `rat.pow_zero, `rat.pow_one, `f1, `f2, `f3, `f4]

meta def simp_rat_pow : tactic unit :=
rat_pow_simp_lemmas >>= simp_target

--`[simp only [pow_bit0, pow_bit1, rat.pow_zero, rat.pow_one, f1, f2, f3, f4]]

meta def prove_rat_pow : tactic unit :=
simp_rat_pow >>  pf_by_norm_num

--example : rat.pow 5 3 = 125 := by prove_rat_pow

inductive approx_dir
| over | under | none

meta def approx_dir.to_expr : approx_dir → expr
| approx_dir.over := `(@ge rat _)
| approx_dir.under := `(@has_le.le rat _)
| approx_dir.none := `(@eq rat)

meta def correct_offset (A x prec : ℚ) (n : ℤ) : approx_dir → ℚ
| approx_dir.over := if rat.pow x n ≥ A then x else x + prec
| approx_dir.under := if rat.pow x n ≤ A then x else x - prec
| approx_dir.none := x

meta def round_to_denom (A : ℚ) (denom : ℕ) : ℚ :=
let num_q := (denom*A.num : ℤ) / A.denom in
rat.mk num_q denom

namespace rat

meta def nth_root_aux'' (A : ℚ) (n : ℤ) (prec : ℚ) (dir : approx_dir) : ℚ → ℚ
| guess :=
  let delta_x := (1/(n : ℚ))*((A / rat.pow guess (n - 1)) - guess),
      x := guess + delta_x in
  /-correct_offset A-/ (if abs delta_x < prec then x else nth_root_aux'' x) /-prec n dir-/

meta def nth_root_aux' (A : ℚ) (n : ℤ) (prec : ℚ) (dir : approx_dir) (guess : ℚ) : ℚ :=
correct_offset A (nth_root_aux'' A n prec dir guess) prec n dir

meta def nth_root_aux (A : ℚ) (n : ℤ) (prec guess : ℚ) (dir : approx_dir := approx_dir.none) : ℚ :=
nth_root_aux' A n prec dir guess

/-meta def nth_root_approx (A : ℚ) (n : ℤ) (prec : ℚ) (dir : approx_dir := approx_dir.none) : ℚ :=
nth_root_aux A n prec (A / n) dir-/

meta def nth_root_approx_bin_aux (A : ℚ) (n : ℤ) (prec : ℚ) : ℕ → ℚ → ℚ
| steps guess :=
if steps = 0 then guess
else let v := rat.pow guess n in
if v < A then nth_root_approx_bin_aux (steps/2) (guess + steps*prec)
else if v > A then nth_root_approx_bin_aux (steps/2) (guess - steps*prec)
else guess

meta def nth_root_approx_bin (A : ℚ) (n : ℤ) (prec guess : ℚ) (dir : approx_dir := approx_dir.none) : ℚ :=
let v := nth_root_approx_bin_aux A n prec (ceil (A/4)).nat_abs guess in
correct_offset A v prec n dir

end rat

namespace int
/-def pow (base : ℤ) : ℤ → ℤ
| (of_nat n) := pow_nat base n
| -[1+n] :=

meta def nth_root_aux (A : ℤ) (n : ℤ) (prec : ℚ) : ℤ → ℤ
| guess :=
let delta_x := ((A / pow_int guess (n - 1)) - guess) / n,
    x := guess + delta_x in
if abs delta_x < prec then x else nth_root_aux x

meta def nth_root_approx (A : ℚ) (n : ℤ) (prec : ℚ) : ℚ :=
nth_root_aux A n prec (A / n)-/

-- inl means success, inr means failed with
meta def nth_root_aux (A : ℤ) (n : ℕ) : ℤ → ℤ → ℤ⊕ℤ
| step guess :=
if step = 0 ∨ step = 1 then
 if guess^n = A then sum.inl guess else if (guess+1)^n=A then sum.inl $ guess+1 else if (guess-1)^n=A then sum.inl $ guess-1 else sum.inr guess
else
 if guess^n = A then sum.inl guess
 else if guess^n < A then nth_root_aux ((step+1)/2) (guess+step)
 else nth_root_aux ((step+1)/2) (guess-step)

meta def nth_root (A : ℤ) (n : ℕ) : ℤ⊕ℤ :=
nth_root_aux A n ((A+1)/4)  ((A+1)/4)

meta def nth_root_o (A : ℤ) (n : ℕ) : option ℤ :=
match nth_root A n  with
| sum.inl v := some v
| sum.inr _ := none
end

end int

/--- faster to skip first rat approx in non-1 denom case?
meta def nth_root_approx' (dir : approx_dir) : Π (A : ℚ) (n : ℕ) (prec : ℚ), ℚ | A n prec :=
if A.denom = 1 then
 match int.nth_root A.num n with
 | sum.inl v := v
 | sum.inr v := rat.nth_root_aux A n prec (if v = 0 then prec else v) dir
 end
else
  let num_apr := int.nth_root A.num n,
      den_apr := int.nth_root A.denom n in
  match num_apr, den_apr with
  | sum.inl vn, sum.inl vd := (vn : ℚ) / vd
  | sum.inl vn, sum.inr vd := rat.nth_root_aux A n prec (vn / vd) dir --(vn / rat.nth_root_aux A.denom n prec vd) dir
  | sum.inr vn, sum.inl vd := rat.nth_root_aux A n prec (vn / vd) dir --(rat.nth_root_aux A.num n prec vn / vd) dir
  | sum.inr vn, sum.inr vd := rat.nth_root_aux A n prec (vn / vd) dir--(rat.nth_root_aux A.num n prec vn / rat.nth_root_aux A.denom n prec vn) dir
  end
-- rat.nth_root_aux A n prec ((nth_root_approx' A.num n prec) / (nth_root_approx' A.denom n prec)) dir
-/
-- no rounding or direction fixing
meta def nth_root_approx''_a (dir : approx_dir) : Π (A : ℚ) (n : ℕ) (prec : ℚ), ℚ | A n prec :=
if A.denom = 1 then
 match int.nth_root A.num n with
 | sum.inl v := v
 | sum.inr v := (rat.nth_root_aux'' A n prec dir (if v = 0 then prec else v)) --rat.nth_root_aux A n prec (if v = 0 then prec else v) dir
 end
else
  let num_apr := int.nth_root A.num n,
      den_apr := int.nth_root A.denom n in
  match num_apr, den_apr with
  | sum.inl vn, sum.inl vd := (vn : ℚ) / vd
  | sum.inl vn, sum.inr vd := rat.nth_root_aux'' A n prec dir (vn / vd) --(vn / rat.nth_root_aux A.denom n prec vd) dir
  | sum.inr vn, sum.inl vd := rat.nth_root_aux'' A n prec dir (vn / vd) --(rat.nth_root_aux A.num n prec vn / vd) dir
  | sum.inr vn, sum.inr vd := rat.nth_root_aux'' A n prec dir (vn / vd) --(rat.nth_root_aux A.num n prec vn / rat.nth_root_aux A.denom n prec vn) dir
  end

meta def nth_root_approx (dir : approx_dir) (A : ℚ) (n : ℕ) (denom : ℕ) /-(prec : ℚ)-/ : ℚ :=
let av := nth_root_approx''_a dir A n (1/(denom : ℚ)) in
correct_offset A (round_to_denom av denom) (1/(denom : ℚ)) n dir

/-meta def nth_root_approx (A : ℚ) (n : ℕ) (prec : ℚ) (dir : approx_dir := approx_dir.none) : ℚ :=
nth_root_approx' dir A n prec
-/

open tactic
meta def prove_nth_root_approx (A : ℚ) (n : ℕ) (prec : ℕ) (dir : approx_dir) : tactic expr :=
let apprx := nth_root_approx dir A n prec  in
do  apprx_pow ← to_expr ``(rat.pow %%(reflect apprx) %%(reflect n)),
let tgt := dir.to_expr apprx_pow `(A) in
do (_, e) ← solve_aux tgt (trace_state >> simp_rat_pow >> trace_state >> (try `[norm_num]) >> done),
   return e

--set_option pp.all true

#exit

local attribute [irreducible] rat.pow

example : (0 : ℚ) ≤ 5+1 :=
begin
simp
end

--example : (0 : ℚ) ≤ 500 := by reflexivity

#eval let v := nth_root_approx 10 2 0.5 in v*v

#eval nth_root_approx 2 2 10 approx_dir.under
#eval int.nth_root 2 2
#eval rat.nth_root_aux 2 2 100 0 approx_dir.over
#eval rat.nth_root_aux 2 4 100 0 approx_dir.over

example : (198 : ℚ) / 100 ≤ 2 :=
by norm_num --btrivial

run_cmd do prove_nth_root_approx 2 2 1000 approx_dir.under >>= infer_type >>= trace

/-do trace "hi",
let
    tgt := dir.to_expr `(rat.pow apprx n) A in
failed
-/
#exit

set_option profiler true

run_cmd trace $int.nth_root 1934434936 3

run_cmd trace $ nth_root_approx 19344349361234579569400000000000 2 0.0000000000000000000005

run_cmd trace $ nth_root_approx 54354358908309423742342 2 0.0000000000000000000005

run_cmd trace $ nth_root_approx (54354358908309423742342 / 19344349361234579569400000000000) 2 0.0000000000000000000005

run_cmd trace $ nth_root_approx (100/81) 2 0.00005

example : true :=
by do
trace $ nth_root_approx 1934434936134579569400000000000 2 0.0000000000000000000005,
triv

--run_cmd trace $ int.nth_root 10 2
--run_cmd trace $ rat.nth_root_aux 10 2 0.5 4

#exit

meta def nearest_int (q : ℚ) : ℤ :=
if ↑q.ceil - q < 0.5 then q.ceil else q.floor

meta def find_integer_root (q : ℚ) (n : ℤ) : option ℚ :=
let n_o := nearest_int $ nth_root_approx q n 0.5 in
if rat.pow n_o n = q then some n_o else none

#exit

meta def small_factor_precomp : list ((int × rat) × (rat × expr)) :=
[
((2, 1), (1, `(by prove_rat_pow : rat.pow 1 2 = 1))),
((2, 4), (2, `(by prove_rat_pow  : rat.pow 2 2 = 4))),
((2, 9), (3, `(by prove_rat_pow  : rat.pow 3 2 = 9))),
((2, 16), (4, `(by prove_rat_pow  : rat.pow 4 2 = 16))),
((2, 25), (5, `(by prove_rat_pow  : rat.pow 5 2 = 25))),
((2, 36), (6, `(by prove_rat_pow  : rat.pow 6 2 = 36))),
((2, 49), (7, `(by prove_rat_pow  : rat.pow 7 2 = 49))),
((2, 64), (8, `(by prove_rat_pow  : rat.pow 8 2 = 64))),
((2, 81), (9, `(by prove_rat_pow  : rat.pow 9 2 = 81))),
((2, 100), (10, `(by prove_rat_pow  : rat.pow 10 2 = 100))),
((3, 1), (1, `(by prove_rat_pow  : rat.pow 1 3 = 1))),
((3, 8), (2, `(by prove_rat_pow  : rat.pow 2 3 = 8))),
((3, 27), (3, `(by prove_rat_pow  : rat.pow 3 3 = 27))),
((3, 64), (4, `(by prove_rat_pow  : rat.pow 4 3 = 64))),
((3, 125), (5, `(by prove_rat_pow  : rat.pow 5 3 = 125))),
((3, 216), (6, `(by prove_rat_pow : rat.pow 6 3 = 216))),
((3, 343), (7, `(by prove_rat_pow : rat.pow 7 3 = 343))),
((3, 512), (8, `(by prove_rat_pow : rat.pow 8 3 = 512))),
((3, 729), (9, `(by prove_rat_pow : rat.pow 9 3 = 729))),
((3, 1000), (10, `(by prove_rat_pow : rat.pow 10 3 = 1000))),
((4, 1), (1, `(by prove_rat_pow : rat.pow 1 4 = 1))),
((4, 16), (2, `(by prove_rat_pow : rat.pow 2 4 = 16))),
((4, 81), (3, `(by prove_rat_pow : rat.pow 3 4 = 81))),
((4, 256), (4, `(by prove_rat_pow : rat.pow 4 4 = 256))),
((4, 625), (5, `(by prove_rat_pow : rat.pow 5 4 = 625))),
((4, 1296), (6, `(by prove_rat_pow : rat.pow 6 4 = 1296))),
((4, 2401), (7, `(by prove_rat_pow : rat.pow 7 4 = 2401))),
((4, 4096), (8, `(by prove_rat_pow : rat.pow 8 4 = 4096))),
((4, 6561), (9, `(by prove_rat_pow : rat.pow 9 4 = 6561))),
((4, 10000), (10, `(by prove_rat_pow : rat.pow 10 4 = 10000)))
]

meta def small_factor_map : rb_map (ℤ × ℚ) (ℚ × expr) :=
rb_map.of_list small_factor_precomp


import Myint.Base

namespace myint

def myadd (m n : myint) : myint :=
  myint.mk (m.x + n.x) (m.y + n.y)

instance : Add myint where
  add := myadd

theorem add_eq_myadd (m n : myint) : m + n = myadd m n := rfl

theorem add_x (m n : myint) : (m + n).x = m.x + n.x := by
  rw [add_eq_myadd]
  rw [myadd]

theorem add_y (m n : myint) : (m + n).y = m.y + n.y := by
  rw [add_eq_myadd]
  rw [myadd]

theorem zerox : (0 : myint).x = 0 := rfl
theorem zeroy : (0 : myint).y = 0 := rfl

theorem add_zero (m : myint) : m + 0 ≈ m := by
  rw [equiv_is_myequal]
  rw [myequal]
  rw [add_x, add_y]
  rw [zerox, zeroy]
  rw [mynat.add_zero]
  rw [mynat.add_zero]
  exact mynat.add_comm m.x m.y

theorem zero_add (n : myint) : (0 + n) ≈ n := by
  rw [equiv_is_myequal]
  rw [myequal]
  rw [add_eq_myadd]
  rw [myadd]
  rw [zerox, zeroy]
  rw [mynat.zero_add]
  rw [mynat.zero_add]
  rw [mynat.add_comm]

theorem if_x_and_y_equal_then_equiv (a b : myint) : a.x = b.x ∧ a.y = b.y → a ≈ b := by
  intro h
  rw [equiv_is_myequal]
  rw [myequal]
  rw [h.left]
  rw [h.right]
  rw [mynat.add_comm]

theorem add_assoc (a b c : myint) : (a + b) + c ≈ a + (b + c) := by
  rw [equiv_is_myequal]
  rw [myequal]
  apply if_x_and_y_equal_then_equiv
  apply And.intro
  case a.left =>
    rw [add_x]
    rw [add_x]
    rw [add_x]
    rw [add_x]
    rw [mynat.add_assoc]
  case a.right =>
    rw [add_y]
    rw [add_y]
    rw [add_y]
    rw [add_y]
    rw [mynat.add_assoc]

theorem add_comm (a b : myint) : a + b ≈ b + a := by
  apply if_x_and_y_equal_then_equiv
  apply And.intro
  . rw [add_x]
    rw [add_x]
    rw [mynat.add_comm]
  . rw [add_y]
    rw [add_y]
    rw [mynat.add_comm]

attribute [simp] add_assoc add_comm

theorem add_right (a b t : myint) : a ≈ b → a + t ≈ b + t := by
  intro h
  rw [equiv_is_myequal] at h ⊢
  rw [myequal] at h ⊢
  rw [add_x]
  rw [add_y]
  rw [add_y]
  rw [add_x]
  rw [← mynat.add_assoc (a.x + t.x) _ _]
  rw [mynat.add_assoc a.x t.x]
  rw [mynat.add_comm t.x b.y]
  rw [← mynat.add_assoc a.x _]
  rw [← mynat.add_assoc (a.y + t.y)]
  rw [mynat.add_assoc a.y]
  rw [mynat.add_comm t.y]
  rw [← mynat.add_assoc]
  rw [h]
  rw [mynat.add_assoc (a.y + b.x)]
  rw [mynat.add_comm t.x]
  rw [← mynat.add_assoc]

theorem add_left (t a b : myint) : a ≈ b → t + a ≈ t + b := by
  intro h
  have := add_right a b t h
  have := trans (add_comm t a) this
  exact trans this (add_comm b t)

theorem add_equiv (a b c d : myint) : a ≈ b ∧ c ≈ d → a + c ≈ b + d := by
  intro h
  have h1 := And.left h
  have h2 := And.right h
  have hac := add_right a b c h1
  have hbd := add_left b c d h2
  exact trans hac hbd

theorem ne_add_still_ne (a b t : myint) : a ≉  b → a + t ≉  b + t := by
  intro h
  rw [mynotequal] at h ⊢
  repeat rw [add_eq_myadd, myadd]
  rw [destruct_x, destruct_y]
  rw [destruct_y _ (a.y + t.y), destruct_x (b.x + t.x) _]
  rw [← mynat.add_assoc]
  rw [mynat.add_assoc a.x]
  rw [mynat.add_comm t.x]
  rw [← mynat.add_assoc]
  rw [← mynat.add_assoc]
  rw [mynat.add_assoc a.y]
  rw [mynat.add_comm t.y]
  rw [← mynat.add_assoc]
  rw [mynat.add_assoc (a.y + b.x)]
  rw [mynat.add_comm t.y]
  rw [mynat.add_assoc (a.x + b.y)]
  intro h'
  have := (mynat.add_right_cancel_iff (t.x + t.y) (a.x + b.y) (a.y + b.x)).mp h'
  exact h this

end myint