import Logic.Predicate.Term

namespace FirstOrder

variable (L : Language.{u})

inductive SubFormula (μ : Type v) : ℕ → Type (max u v) where
  | verum  {n} : SubFormula μ n
  | falsum {n} : SubFormula μ n
  | rel    {n} : ∀ {k}, L.rel k → (Fin k → SubTerm L μ n) → SubFormula μ n
  | nrel   {n} : ∀ {k}, L.rel k → (Fin k → SubTerm L μ n) → SubFormula μ n
  | and    {n} : SubFormula μ n → SubFormula μ n → SubFormula μ n
  | or     {n} : SubFormula μ n → SubFormula μ n → SubFormula μ n
  | all    {n} : SubFormula μ (n + 1) → SubFormula μ n
  | ex     {n} : SubFormula μ (n + 1) → SubFormula μ n

variable (μ : Type v) (μ₁ : Type v₁) (μ₂ : Type v₂) (μ₃ : Type v₃)

abbrev Formula := SubFormula L μ 0

abbrev Sentence := Formula L Empty

abbrev SyntacticSubFormula (n : ℕ) := SubFormula L ℕ n

abbrev SyntacticFormula := SyntacticSubFormula L 0

variable {L μ μ₁ μ₂ μ₃}

namespace SubFormula
variable {n n₁ n₂ : ℕ}

def neg {n} : SubFormula L μ n → SubFormula L μ n
  | verum    => falsum
  | falsum   => verum
  | rel r v  => nrel r v
  | nrel r v => rel r v
  | and p q  => or (neg p) (neg q)
  | or p q   => and (neg p) (neg q)
  | all p    => ex (neg p)
  | ex p     => all (neg p)

lemma neg_neg (p : SubFormula L μ n) : neg (neg p) = p :=
  by induction p <;> simp[*, neg]

instance : HasLogicSymbols (SubFormula L μ n) where
  neg := neg
  arrow := fun p q => or (neg p) q
  and := and
  or := or
  top := verum
  bot := falsum

instance : HasUniv (SubFormula L μ) := ⟨all⟩
instance : HasEx (SubFormula L μ) := ⟨ex⟩

@[simp] lemma neg_top : ~(⊤ : SubFormula L μ n) = ⊥ := rfl

@[simp] lemma neg_bot : ~(⊥ : SubFormula L μ n) = ⊤ := rfl

@[simp] lemma neg_rel {k} (r : L.rel k) (v : Fin k → SubTerm L μ n) : ~(rel r v) = nrel r v := rfl

@[simp] lemma neg_nrel {k} (r : L.rel k) (v : Fin k → SubTerm L μ n) : ~(nrel r v) = rel r v := rfl

@[simp] lemma neg_and (p q : SubFormula L μ n) : ~(p ⋏ q) = ~p ⋎ ~q := rfl

@[simp] lemma neg_or (p q : SubFormula L μ n) : ~(p ⋎ q) = ~p ⋏ ~q := rfl

@[simp] lemma neg_all (p : SubFormula L μ (n + 1)) : ~(∀' p) = ∃' ~p := rfl

@[simp] lemma neg_ex (p : SubFormula L μ (n + 1)) : ~(∃' p) = ∀' ~p := rfl

@[simp] lemma neg_neg' (p : SubFormula L μ n) : ~~p = p := neg_neg p

lemma neg_eq (p : SubFormula L μ n) : ~p = neg p := rfl

lemma imp_eq (p q : SubFormula L μ n) : p ⟶ q = ~p ⋎ q := rfl

lemma iff_eq (p q : SubFormula L μ n) : p ⟷ q = (~p ⋎ q) ⋏ (~q ⋎ p) := rfl

@[simp] lemma and_inj (p₁ q₁ p₂ q₂ : SubFormula L μ n) : p₁ ⋏ p₂ = q₁ ⋏ q₂ ↔ p₁ = q₁ ∧ p₂ = q₂ :=
by simp[HasAnd.and]

@[simp] lemma or_inj (p₁ q₁ p₂ q₂ : SubFormula L μ n) : p₁ ⋎ p₂ = q₁ ⋎ q₂ ↔ p₁ = q₁ ∧ p₂ = q₂ :=
by simp[HasOr.or]

@[simp] lemma all_inj (p q : SubFormula L μ (n + 1)) : ∀' p = ∀' q ↔ p = q :=
  by simp[HasUniv.univ]

@[simp] lemma ex_inj (p q : SubFormula L μ (n + 1)) : ∃' p = ∃' q ↔ p = q :=
  by simp[HasEx.ex]

variable (L)

abbrev rel! (k) (r : L.rel k) (v : Fin k → SubTerm L μ n) := rel r v

abbrev nrel! (k) (r : L.rel k) (v : Fin k → SubTerm L μ n) := nrel r v

variable {L}

def complexity : {n : ℕ} → SubFormula L μ n → ℕ
| _, ⊤        => 0
| _, ⊥        => 0
| _, rel _ _  => 0
| _, nrel _ _ => 0
| _, p ⋏ q    => max p.complexity q.complexity + 1
| _, p ⋎ q    => max p.complexity q.complexity + 1
| _, ∀' p     => p.complexity + 1
| _, ∃' p     => p.complexity + 1

@[simp] lemma complexity_top : complexity (⊤ : SubFormula L μ n) = 0 := rfl

@[simp] lemma complexity_bot : complexity (⊥ : SubFormula L μ n) = 0 := rfl

@[simp] lemma complexity_rel {k} (r : L.rel k) (v : Fin k → SubTerm L μ n) : complexity (rel r v) = 0 := rfl

@[simp] lemma complexity_nrel {k} (r : L.rel k) (v : Fin k → SubTerm L μ n) : complexity (nrel r v) = 0 := rfl

@[simp] lemma complexity_and (p q : SubFormula L μ n) : complexity (p ⋏ q) = max p.complexity q.complexity + 1 := rfl
@[simp] lemma complexity_and' (p q : SubFormula L μ n) : complexity (and p q) = max p.complexity q.complexity + 1 := rfl

@[simp] lemma complexity_or (p q : SubFormula L μ n) : complexity (p ⋎ q) = max p.complexity q.complexity + 1 := rfl
@[simp] lemma complexity_or' (p q : SubFormula L μ n) : complexity (or p q) = max p.complexity q.complexity + 1 := rfl

@[simp] lemma complexity_all (p : SubFormula L μ (n + 1)) : complexity (∀' p) = p.complexity + 1 := rfl
@[simp] lemma complexity_all' (p : SubFormula L μ (n + 1)) : complexity (all p) = p.complexity + 1 := rfl

@[simp] lemma complexity_ex (p : SubFormula L μ (n + 1)) : complexity (∃' p) = p.complexity + 1 := rfl
@[simp] lemma complexity_ex' (p : SubFormula L μ (n + 1)) : complexity (ex p) = p.complexity + 1 := rfl

@[elab_as_elim]
def cases' {C : ∀ n, SubFormula L μ n → Sort _}
  (hverum  : ∀ {n : ℕ}, C n ⊤)
  (hfalsum : ∀ {n : ℕ}, C n ⊥)
  (hrel    : ∀ {n l : ℕ} (r : L.rel l) (v : Fin l → SubTerm L μ n), C n (rel r v))
  (hnrel   : ∀ {n l : ℕ} (r : L.rel l) (v : Fin l → SubTerm L μ n), C n (nrel r v))
  (hand    : ∀ {n : ℕ} (p q : SubFormula L μ n), C n (p ⋏ q))
  (hor     : ∀ {n : ℕ} (p q : SubFormula L μ n), C n (p ⋎ q))
  (hall    : ∀ {n : ℕ} (p : SubFormula L μ (n + 1)), C n (∀' p))
  (hex     : ∀ {n : ℕ} (p : SubFormula L μ (n + 1)), C n (∃' p)) :
    ∀ {n : ℕ} (p : SubFormula L μ n), C n p
  | _, verum    => hverum
  | _, falsum   => hfalsum
  | _, rel r v  => hrel r v
  | _, nrel r v => hnrel r v
  | _, and p q  => hand p q
  | _, or p q   => hor p q
  | _, all p    => hall p
  | _, ex p     => hex p

@[elab_as_elim]
def rec' {C : ∀ n, SubFormula L μ n → Sort _}
  (hverum  : ∀ {n : ℕ}, C n ⊤)
  (hfalsum : ∀ {n : ℕ}, C n ⊥)
  (hrel    : ∀ {n l : ℕ} (r : L.rel l) (v : Fin l → SubTerm L μ n), C n (rel r v))
  (hnrel   : ∀ {n l : ℕ} (r : L.rel l) (v : Fin l → SubTerm L μ n), C n (nrel r v))
  (hand    : ∀ {n : ℕ} (p q : SubFormula L μ n), C n p → C n q → C n (p ⋏ q))
  (hor     : ∀ {n : ℕ} (p q : SubFormula L μ n), C n p → C n q → C n (p ⋎ q))
  (hall    : ∀ {n : ℕ} (p : SubFormula L μ (n + 1)), C (n + 1) p → C n (∀' p))
  (hex     : ∀ {n : ℕ} (p : SubFormula L μ (n + 1)), C (n + 1) p → C n (∃' p)) :
    ∀ {n : ℕ} (p : SubFormula L μ n), C n p
  | _, verum    => hverum
  | _, falsum   => hfalsum
  | _, rel r v  => hrel r v
  | _, nrel r v => hnrel r v
  | _, and p q  => hand p q (rec' hverum hfalsum hrel hnrel hand hor hall hex p) (rec' hverum hfalsum hrel hnrel hand hor hall hex q)
  | _, or p q   => hor p q (rec' hverum hfalsum hrel hnrel hand hor hall hex p) (rec' hverum hfalsum hrel hnrel hand hor hall hex q)
  | _, all p    => hall p (rec' hverum hfalsum hrel hnrel hand hor hall hex p)
  | _, ex p     => hex p (rec' hverum hfalsum hrel hnrel hand hor hall hex p)

variable [∀ k, ToString (L.func k)] [∀ k, ToString (L.rel k)] [ToString μ]

def toStr : ∀ {n}, SubFormula L μ n → String
  | _, ⊤                     => "\\top"
  | _, ⊥                     => "\\bot"
  | _, rel (k := 0) r _      => "{" ++ toString r ++ "}"
  | _, rel (k := _ + 1) r v  => "{" ++ toString r ++ "} \\left(" ++ String.vecToStr (fun i => toString (v i)) ++ "\\right)"
  | _, nrel (k := 0) r _     => "\\lnot {" ++ toString r ++ "}"
  | _, nrel (k := _ + 1) r v => "\\lnot {" ++ toString r ++ "} \\left(" ++ String.vecToStr (fun i => toString (v i)) ++ "\\right)"
  | _, p ⋏ q                 => "\\left(" ++ toStr p ++ " \\land " ++ toStr q ++ "\\right)"
  | _, p ⋎ q                 => "\\left(" ++ toStr p ++ " \\lor "  ++ toStr q ++ "\\right)"
  | _, @all _ _ n p          => "(\\forall x_{" ++ toString n ++ "}) " ++ toStr p
  | _, @ex _ _ n p           => "(\\exists x_{" ++ toString n ++ "}) " ++ toStr p

instance : Repr (SubFormula L μ n) := ⟨fun t _ => toStr t⟩

instance : ToString (SubFormula L μ n) := ⟨toStr⟩

end SubFormula

namespace SubFormula
variable {n n₁ n₂ n₃ m m₁ m₂ m₃ : ℕ}

@[simp] lemma complexity_neg (p : SubFormula L μ n) : complexity (~p) = complexity p :=
by induction p using rec' <;> simp[*]

@[reducible]
def bind' : ∀ {n₁ n₂}, (bound : Fin n₁ → SubTerm L μ₂ n₂) → (free : μ₁ → SubTerm L μ₂ n₂) →
    SubFormula L μ₁ n₁ → SubFormula L μ₂ n₂
  | _, _, _,     _,    ⊤          => ⊤
  | _, _, _,     _,    ⊥          => ⊥
  | _, _, bound, free, (rel r v)  => rel r (SubTerm.bind bound free ∘ v)
  | _, _, bound, free, (nrel r v) => nrel r (SubTerm.bind bound free ∘ v)
  | _, _, bound, free, (p ⋏ q)    => bind' bound free p ⋏ bind' bound free q
  | _, _, bound, free, (p ⋎ q)    => bind' bound free p ⋎ bind' bound free q
  | _, _, bound, free, (∀' p)     => ∀' bind' (Fin.cases #0 $ SubTerm.bShift ∘ bound) (SubTerm.bShift ∘ free) p
  | _, _, bound, free, (∃' p)     => ∃' bind' (Fin.cases #0 $ SubTerm.bShift ∘ bound) (SubTerm.bShift ∘ free) p

lemma bind'_neg {n₁ n₂} (bound : Fin n₁ → SubTerm L μ₂ n₂) (free : μ₁ → SubTerm L μ₂ n₂) (p) :
    bind' bound free (~p) = ~bind' bound free p :=
  by induction p using rec' generalizing n₂ <;> simp[*, bind', ←neg_eq]

def bind (bound : Fin n₁ → SubTerm L μ₂ n₂) (free : μ₁ → SubTerm L μ₂ n₂) : SubFormula L μ₁ n₁ →L SubFormula L μ₂ n₂ where
  toFun := bind' bound free
  map_top' := by simp[bind']
  map_bot' := by simp[bind']
  map_and' := by simp[bind']
  map_or'  := by simp[bind']
  map_neg' := by simp[bind'_neg]
  map_imp' := by simp[imp_eq, bind'_neg, ←neg_eq, bind']

abbrev bind₀ (f : μ₁ → SubTerm L μ₂ n) : SubFormula L μ₁ n →L SubFormula L μ₂ n := bind SubTerm.bvar f

def map (bound : Fin n₁ → Fin n₂) (free : μ₁ → μ₂) : SubFormula L μ₁ n₁ →L SubFormula L μ₂ n₂ :=
  bind (fun n => #(bound n)) (fun m => &(free m))

abbrev map₀ (free : μ₁ → μ₂) : SubFormula L μ₁ n →L SubFormula L μ₂ n := map id free

def subst (t : SubTerm L μ n) : SubFormula L μ (n + 1) →L SubFormula L μ n :=
  bind (SubTerm.bvar <: t) SubTerm.fvar

def emb : SubFormula L Empty n →L SubFormula L μ n := map id Empty.elim

section bind
variable (bound : Fin n₁ → SubTerm L μ₂ n₂) (free : μ₁ → SubTerm L μ₂ n₂)

lemma bind_rel {k} (r : L.rel k) (v : Fin k → SubTerm L μ₁ n₁) :
    bind bound free (rel r v) = rel r (fun i => (v i).bind bound free) := rfl

lemma bind_nrel {k} (r : L.rel k) (v : Fin k → SubTerm L μ₁ n₁) :
    bind bound free (nrel r v) = nrel r (fun i => (v i).bind bound free) := rfl

@[simp] lemma bind_all (p : SubFormula L μ₁ (n₁ + 1)) :
    bind bound free (∀' p) = ∀' bind (#0 :> SubTerm.bShift ∘ bound) (SubTerm.bShift ∘ free) p := rfl

@[simp] lemma bind_ex (p : SubFormula L μ₁ (n₁ + 1)) :
    bind bound free (∃' p) = ∃' bind (#0 :> SubTerm.bShift ∘ bound) (SubTerm.bShift ∘ free) p := rfl

@[simp] lemma complexity_bind (p : SubFormula L μ₁ n₁) : complexity (bind bound free p) = complexity p :=
  by induction p using rec' generalizing μ₂ n₂ <;> simp[*, bind_rel, bind_nrel]

@[simp] lemma bind_id (p) : @bind L μ μ n n SubTerm.bvar SubTerm.fvar p = p :=
  by induction p using rec' <;> simp[*, bind_rel, bind_nrel]

@[simp] lemma eq_bind_of (bound : Fin n → SubTerm L μ n) (free : μ → SubTerm L μ n)
    (hbound : ∀ x, bound x = #x) (hfree : ∀ x, free x = &x) (p : SubFormula L μ n) :
    bind bound free p = p :=
  by
  have : bound = SubTerm.bvar := funext hbound
  have : free = SubTerm.fvar := funext hfree
  simp[*]

end bind

lemma bind_bind
  (bound₁ : Fin n₁ → SubTerm L μ₂ n₂) (free₁ : μ₁ → SubTerm L μ₂ n₂)
  (bound₂ : Fin n₂ → SubTerm L μ₃ n₃) (free₂ : μ₂ → SubTerm L μ₃ n₃) (p : SubFormula L μ₁ n₁) :
    bind bound₂ free₂ (bind bound₁ free₁ p) = bind (fun n => (bound₁ n).bind bound₂ free₂) (fun m => (free₁ m).bind bound₂ free₂) p := by
  induction p using rec' generalizing n₂ n₃ <;> simp[*, SubTerm.bind_bind, bind_rel, bind_nrel] <;>
  { congr
    refine funext (Fin.cases (by simp) (by simp[SubTerm.bShift, SubTerm.map, SubTerm.bind_bind]))
    refine funext (by simp[SubTerm.bShift, SubTerm.map, SubTerm.bind_bind]) }

lemma bind_comp_bind
  (bound₁ : Fin n₁ → SubTerm L μ₂ n₂) (free₁ : μ₁ → SubTerm L μ₂ n₂)
  (bound₂ : Fin n₂ → SubTerm L μ₃ n₃) (free₂ : μ₂ → SubTerm L μ₃ n₃) :
    (bind bound₂ free₂).comp (bind bound₁ free₁) = bind (fun n => (bound₁ n).bind bound₂ free₂) (fun m => (free₁ m).bind bound₂ free₂) :=
  by ext p; simp[bind_bind]

section map
variable (bound : Fin n₁ → Fin n₂) (free : μ₁ → μ₂)

lemma map_rel {k} (r : L.rel k) (v : Fin k → SubTerm L μ₁ n₁) :
    map bound free (rel r v) = rel r (fun i => (v i).map bound free) := rfl

lemma map_nrel {k} (r : L.rel k) (v : Fin k → SubTerm L μ₁ n₁) :
    map bound free (nrel r v) = nrel r (fun i => (v i).map bound free) := rfl

@[simp] lemma map_all (p : SubFormula L μ₁ (n₁ + 1)) :
    map bound free (∀' p) = ∀' map (0 :> Fin.succ ∘ bound) free p :=
  by simp[map]; congr; exact funext (Fin.cases (by simp) (by simp))

@[simp] lemma map_ex (p : SubFormula L μ₁ (n₁ + 1)) :
    map bound free (∃' p) = ∃' map (0 :> Fin.succ ∘ bound) free p :=
  by simp[map]; congr; exact funext (Fin.cases (by simp) (by simp))

@[simp] lemma complexity_map (p : SubFormula L μ₁ n₁) : complexity (map bound free p) = complexity p :=
  complexity_bind _ _ _

end map

lemma map_map
  (bound₁ : Fin n₁ → Fin n₂) (free₁ : μ₁ → μ₂)
  (bound₂ : Fin n₂ → Fin n₃) (free₂ : μ₂ → μ₃) (p : SubFormula L μ₁ n₁) :
    map bound₂ free₂ (map bound₁ free₁ p) = map (bound₂ ∘ bound₁) (free₂ ∘ free₁) p :=
  bind_bind _ _ _ _ _

@[simp] lemma map_id (p) : @map L μ μ n n id id p = p :=
  bind_id _

lemma map_inj : ∀ {n₁ n₂ μ₁ μ₂} {bound : Fin n₁ → Fin n₂} {free : μ₁ → μ₂},
    (hb : Function.Injective bound) → (hf : Function.Injective free) → Function.Injective $ map (L := L) bound free
  | _, _, _, _, _,     _,    _,  _,  ⊤,        p => by cases p using cases' <;> simp[map_rel, map_nrel]
  | _, _, _, _, _,     _,    _,  _,  ⊥,        p => by cases p using cases' <;> simp[map_rel, map_nrel]
  | _, _, _, _, _,     _,    hb, hf, rel r v,  p => by
    cases p using cases' <;> simp[map_rel, map_nrel]
    case hrel =>
      rintro rfl; simp; rintro rfl h; simp
      funext i; exact SubTerm.map_inj hb hf (congr_fun h i)
  | _, _, _, _, _,     _,    hb, hf, nrel r v, p => by
    cases p using cases' <;> simp[map_rel, map_nrel]
    case hnrel =>
      rintro rfl; simp; rintro rfl h; simp
      funext i; exact SubTerm.map_inj hb hf (congr_fun h i)
  | _, _, _, _, _,     _,    hb, hf, p ⋏ q,    r => by
    cases r using cases' <;> simp[map_rel, map_nrel]
    intro hp hq; exact ⟨map_inj hb hf hp, map_inj hb hf hq⟩
  | _, _, _, _, _,     _,    hb, hf, p ⋎ q,    r => by
    cases r using cases' <;> simp[map_rel, map_nrel]
    intro hp hq; exact ⟨map_inj hb hf hp, map_inj hb hf hq⟩
  | _, _, _, _, bound, free, hb, hf, ∀' p,     q => by
    cases q using cases' <;> simp[map_rel, map_nrel]
    intro h; exact map_inj (bound := 0 :> Fin.succ ∘ bound)
      (Matrix.injective_vecCons ((Fin.succ_injective _).comp hb) (fun _ => (Fin.succ_ne_zero _).symm)) hf h
  | _, _, _, _, bound, free, hb, hf, ∃' p,     q => by
    cases q using cases' <;> simp[map_rel, map_nrel]
    intro h; exact map_inj (bound := 0 :> Fin.succ ∘ bound)
      (Matrix.injective_vecCons ((Fin.succ_injective _).comp hb) (fun _ => (Fin.succ_ne_zero _).symm)) hf h

lemma subst_rel {s : SubTerm L μ n} {k} (r : L.rel k) (v : Fin k → SubTerm L μ (n + 1)) :
    subst s (rel r v) = rel r (fun i => SubTerm.subst s (v i)) :=
  by simp[subst, SubTerm.subst, bind_rel]

lemma subst_nrel {s : SubTerm L μ n} {k} (r : L.rel k) (v : Fin k → SubTerm L μ (n + 1)) :
    subst s (nrel r v) = nrel r (fun i => SubTerm.subst s (v i)) :=
  by simp[subst, SubTerm.subst, bind_nrel]

@[simp] lemma subst_all {s : SubTerm L μ n} (p : SubFormula L μ (n + 1 + 1)) :
    subst s (∀' p) = ∀' subst s.bShift p := by
  simp[subst, SubTerm.subst]; congr
  funext i
  cases' i using Fin.cases with i <;> simp
  cases' i using Fin.lastCases with i <;> simp[Fin.succ_castSucc]

@[simp] lemma subst_ex {s : SubTerm L μ n} (p : SubFormula L μ (n + 1 + 1)) :
    subst s (∃' p) = ∃' subst s.bShift p := by
  simp[subst, SubTerm.subst]; congr
  funext i
  cases' i using Fin.cases with i <;> simp
  cases' i using Fin.lastCases with i <;> simp[Fin.succ_castSucc]

lemma emb_rel {k} (r : L.rel k) (v : Fin k → SubTerm L Empty n) :
    emb (μ := μ) (rel r v) = rel r (fun i => SubTerm.map id Empty.elim (v i)) :=
  by simp[emb, map_rel]

lemma emb_nrel {k} (r : L.rel k) (v : Fin k → SubTerm L Empty n) :
    emb (μ := μ) (nrel r v) = nrel r (fun i => SubTerm.map id Empty.elim (v i)) :=
  by simp[emb, map_nrel]

@[simp] lemma emb_all (p : SubFormula L Empty (n + 1)) :
    emb (μ := μ) (∀' p) = ∀' emb p :=
  by simp[emb]

@[simp] lemma emb_ex (p : SubFormula L Empty (n + 1)) :
    emb (μ := μ) (∃' p) = ∃' emb p :=
  by simp[emb]

section Syntactic

def shift : SyntacticSubFormula L n →L SyntacticSubFormula L n :=
  map id Nat.succ

def free : SyntacticSubFormula L (n + 1) →L SyntacticSubFormula L n :=
  bind (SubTerm.bvar <: &0) (fun m => &(Nat.succ m))

def fix : SyntacticSubFormula L n →L SyntacticSubFormula L (n + 1) :=
  bind (fun x => #(Fin.castSucc x)) (#(Fin.last n) :>ₙ SubTerm.fvar)

lemma shift_rel {k} (r : L.rel k) (v : Fin k → SyntacticSubTerm L n) :
    shift (rel r v) = rel r (fun i => SubTerm.shift $ v i) := rfl

lemma shift_nrel {k} (r : L.rel k) (v : Fin k → SyntacticSubTerm L n) :
    shift (nrel r v) = nrel r (fun i => SubTerm.shift $ v i) := rfl

@[simp] lemma shift_all (p : SyntacticSubFormula L (n + 1)) :
    shift (∀' p) = ∀' shift p  := by simp[shift]

@[simp] lemma shift_ex (p : SyntacticSubFormula L (n + 1)) :
    shift (∃' p) = ∃' shift p  := by simp[shift]

lemma shift_Injective : Function.Injective (@shift L n) :=
  Function.LeftInverse.injective (g := map id Nat.pred)
    (by intros p; simp[shift, map_map, Function.comp]; exact map_id _)

def shiftEmb : SyntacticSubFormula L n ↪ SyntacticSubFormula L n where
  toFun := shift
  inj' := shift_Injective

lemma shiftEmb_eq_shift (p : SyntacticSubFormula L n) :
  shiftEmb p = shift p := rfl

lemma shift_subst (s : SyntacticSubTerm L n) (p : SyntacticSubFormula L (n + 1)) :
    shift (subst s p) = subst s.shift (shift p) :=
  by
  simp[shift, subst, map, bind_bind]; congr; funext x
  cases' x using Fin.lastCases <;> simp; rfl

lemma free_rel {k} (r : L.rel k) (v : Fin k → SyntacticSubTerm L (n + 1)) :
    free (rel r v) = rel r (fun i => SubTerm.free $ v i) := rfl

lemma free_nrel {k} (r : L.rel k) (v : Fin k → SyntacticSubTerm L (n + 1)) :
    free (nrel r v) = nrel r (fun i => SubTerm.free $ v i) := rfl

@[simp] lemma free_all (p : SyntacticSubFormula L (n + 1 + 1)) :
    free (∀' p) = ∀' free p  := by
  simp[free]; congr; exact funext (Fin.cases (by simp) (Fin.lastCases (by simp) (by simp; simp[Fin.succ_castSucc])))

@[simp] lemma free_ex (p : SyntacticSubFormula L (n + 1 + 1)) :
    free (∃' p) = ∃' free p  := by
  simp[free]; congr; exact funext (Fin.cases (by simp) (Fin.lastCases (by simp) (by simp; simp[Fin.succ_castSucc])))

lemma fix_rel {k} (r : L.rel k) (v : Fin k → SyntacticSubTerm L n) :
    fix (rel r v) = rel r (fun i => SubTerm.fix $ v i) := rfl

lemma fix_nrel {k} (r : L.rel k) (v : Fin k → SyntacticSubTerm L n) :
    fix (nrel r v) = nrel r (fun i => SubTerm.fix $ v i) := rfl

@[simp] lemma fix_all (p : SyntacticSubFormula L (n + 1)) :
    fix (∀' p) = ∀' fix p := by
  simp[fix]; congr
  · exact funext (Fin.cases (by simp) (by simp[Fin.succ_castSucc]))
  · exact funext (Nat.rec (by simp) (by simp))

@[simp] lemma fix_ex (p : SyntacticSubFormula L (n + 1)) :
    fix (∃' p) = ∃' fix p := by
  simp[fix]; congr
  · exact funext (Fin.cases (by simp) (by simp[Fin.succ_castSucc]))
  · exact funext (Nat.rec (by simp) (by simp))

@[simp] lemma free_fix (p : SyntacticSubFormula L n) : free (fix p) = p :=
  by simp[fix, free, bind_bind]; apply eq_bind_of <;> simp; intros x; cases x <;> simp

@[simp] lemma fix_free (p : SyntacticSubFormula L (n + 1)) : fix (free p) = p :=
  by
  simp[fix, free, bind_bind]; apply eq_bind_of <;> simp
  intros x; exact Fin.lastCases (by simp) (by simp) x

@[simp] lemma subst_shift_eq_free (p : SyntacticSubFormula L 1) : subst &0 (shift p) = free p :=
  by simp[subst, shift, free, map, bind_bind]

@[simp] lemma complexity_free (p : SyntacticSubFormula L (n + 1)) :
    complexity (free p) = complexity p :=
  by simp[free]

@[elab_as_elim]
def formulaRec {C : SyntacticFormula L → Sort _}
  (hverum  : C ⊤)
  (hfalsum : C ⊥)
  (hrel    : ∀ {l : ℕ} (r : L.rel l) (v : Fin l → SyntacticTerm L), C (rel r v))
  (hnrel   : ∀ {l : ℕ} (r : L.rel l) (v : Fin l → SyntacticTerm L), C (nrel r v))
  (hand    : ∀ (p q : SyntacticFormula L), C p → C q → C (p ⋏ q))
  (hor     : ∀ (p q : SyntacticFormula L), C p → C q → C (p ⋎ q))
  (hall    : ∀ (p : SyntacticSubFormula L 1), C (free p) → C (∀' p))
  (hex     : ∀ (p : SyntacticSubFormula L 1), C (free p) → C (∃' p)) :
    ∀ (p : SyntacticFormula L), C p
  | ⊤        => hverum
  | ⊥        => hfalsum
  | rel r v  => hrel r v
  | nrel r v => hnrel r v
  | p ⋏ q    => hand p q (formulaRec hverum hfalsum hrel hnrel hand hor hall hex p) (formulaRec hverum hfalsum hrel hnrel hand hor hall hex q)
  | p ⋎ q    => hor p q (formulaRec hverum hfalsum hrel hnrel hand hor hall hex p) (formulaRec hverum hfalsum hrel hnrel hand hor hall hex q)
  | ∀' p     => hall p (formulaRec hverum hfalsum hrel hnrel hand hor hall hex (free p))
  | ∃' p     => hex p (formulaRec hverum hfalsum hrel hnrel hand hor hall hex (free p))
  termination_by formulaRec _ _ _ _ _ _ _ _ p => p.complexity

end Syntactic

def fvarList : {n : ℕ} → SubFormula L μ n → List μ
  | _, ⊤        => []
  | _, ⊥        => []
  | _, rel _ v  => List.join $ Matrix.toList (fun i => (v i).fvarList)
  | _, nrel _ v => List.join $ Matrix.toList (fun i => (v i).fvarList)
  | _, p ⋏ q    => p.fvarList ++ q.fvarList
  | _, p ⋎ q    => p.fvarList ++ q.fvarList
  | _, ∀' p     => p.fvarList
  | _, ∃' p     => p.fvarList

abbrev fvar? (p : SubFormula L μ n) (x : μ) : Prop := x ∈ p.fvarList

lemma bind_eq_of_funEqOn (bound : Fin n₁ → SubTerm L μ₂ n₂) (free₁ free₂ : μ₁ → SubTerm L μ₂ n₂) (p : SubFormula L μ₁ n₁)
  (h : Function.funEqOn (fvar? p) free₁ free₂) :
    bind bound free₁ p = bind bound free₂ p := by
  induction p using rec' generalizing n₂ <;> simp[*, bind_rel, bind_nrel] <;> simp[fvar?, fvarList] at h
  case hrel =>
    funext i
    exact SubTerm.bind_eq_of_funEqOn _ _ _ _ (h.of_subset (by simp[fvarList]; intro x hx; exact ⟨i, hx⟩))
  case hnrel =>
    funext i
    exact SubTerm.bind_eq_of_funEqOn _ _ _ _ (h.of_subset (by simp[fvarList]; intro x hx; exact ⟨i, hx⟩))
  case hand ihp ihq =>
    exact ⟨ihp _ _ _ (h.of_subset (fun x hx => Or.inl hx)), ihq _ _ _ (h.of_subset (fun x hx => Or.inr hx))⟩
  case hor ihp ihq =>
    exact ⟨ihp _ _ _ (h.of_subset (fun x hx => Or.inl hx)), ihq _ _ _ (h.of_subset (fun x hx => Or.inr hx))⟩
  case hall ih =>
    exact ih _ _ _ (by intro x hx; simp[h x hx])
  case hex ih =>
    exact ih _ _ _ (by intro x hx; simp[h x hx])

lemma bind_eq_of_funEqOn' {bound₁ bound₂ : Fin n → SubTerm L μ n} {free₁ free₂ : μ → SubTerm L μ n} (p : SubFormula L μ n)
  (hbound : bound₁ = bound₂)
  (hfree : Function.funEqOn (fvar? p) free₁ free₂) :
    bind bound₁ free₁ p = bind bound₂ free₂ p := by
  rw[hbound]; exact bind_eq_of_funEqOn _ _ _ _ hfree

lemma ne_of_ne_complexity {p q : SubFormula L μ n} (h : p.complexity ≠ q.complexity) : p ≠ q :=
  by rintro rfl; contradiction

declare_syntax_cat subformula
syntax "⊤" : subformula
syntax "⊥" : subformula
syntax:45 subterm:45 "=" subterm:0 : subformula
syntax:45 subterm:45 "≠" subterm:0 : subformula
syntax:45 subterm:45 "<" subterm:0 : subformula
syntax:45 "prop" term:max : subformula
syntax:45 "rel¹" term "/[" subterm:0 "]" : subformula
syntax:45 "rel²" term "/[" subterm:0 "," subterm:0 "]" : subformula
syntax:45 "rel³" term "/[" subterm:0 "," subterm:0 "," subterm:0 "]" : subformula
syntax:max "¬" subformula:35 : subformula
syntax:32 subformula:32 "∧" subformula:33 : subformula
syntax:30 subformula:30 "∨" subformula:31 : subformula
syntax:25 "∀" subformula:24 : subformula
syntax:25 "∃" subformula:24 : subformula
syntax:25 "∀*" subformula:24 : subformula
syntax "(" subformula ")" : subformula
syntax:max "!" term:max : subformula
syntax "“" subformula "”" : term

macro_rules
  | `(“ ⊤ ”)                                          => `(⊤)
  | `(“ ⊥ ”)                                          => `(⊥)
  | `(“ ! $t:term ”)                                  => `($t)
  | `(“ prop $s:term ”)                               => `(rel $s ![])
  | `(“ rel¹ $s:term /[ $t:subterm ] ”)               => `(rel $s ![T“$t”])
  | `(“ rel² $s:term /[ $t₁:subterm, $t₂:subterm ] ”) => `(rel $s ![T“$t₁”, T“$t₂”])
  | `(“ rel³ $s:term /[ $t₁:subterm, $t₂:subterm, $t₃:subterm ] ”) => `(rel $s ![T“$t₁”, T“$t₂”, T“$t₃”])
  | `(“ ¬ $p:subformula ”)                            => `(~“$p”)
  | `(“ $t:subterm = $u:subterm ”)                    => `(rel Language.HasEq.eq ![T“$t”, T“$u”])
  | `(“ $t:subterm ≠ $u:subterm ”)                    => `(nrel Language.HasEq.eq ![T“$t”, T“$u”])
  | `(“ $t:subterm < $u:subterm ”)                    => `(rel Language.HasLt.lt ![T“$t”, T“$u”])
  | `(“ $p:subformula ∧ $q:subformula ”)              => `(“$p” ⋏ “$q”)
  | `(“ $p:subformula ∨ $q:subformula ”)              => `(“$p” ⋎ “$q”)
  | `(“ ∀ $p:subformula ”)                            => `(∀' “$p”)
  | `(“ ∃ $p:subformula ”)                            => `(∃' “$p”)
  | `(“ ∀* $p:subformula ”)                           => `(univClosure “$p”)
  | `(“ ( $x ) ”)                                     => `(“$x”)

#check (“¬ prop (Language.toRelational 1)” : Formula (Language.relational (fun _ => ℕ)) ℕ)
#check (“rel¹ Language.toRelational 1 /[&0]” : Formula (Language.relational (fun _ => ℕ)) ℕ)
#check (“¬ rel² Language.toRelational 1 /[&0, &1]” : Formula (Language.relational (fun _ => ℕ)) ℕ)
#check (“¬(∀ ∀ (#0 + 1) * #1 < #0 + #1 ∨ 0 < 5)” : Sentence Language.oring)
#check (“∀* ¬⊤ ∨ ¬0 < 5” : Sentence Language.oring)

syntax:10 subformula:9 "→" subformula:10 : subformula
syntax:10 subformula:10 "↔" subformula:10 : subformula

macro_rules
  | `(“ $p:subformula → $q:subformula ”) => `(“$p” ⟶ “$q”)
  | `(“ $p:subformula ↔ $q:subformula ”) => `(“$p” ⟷ “$q”)

#reduce (“(∃ ⊤) ↔ !(∃' ⊤)” : Sentence Language.oring)
#check (“0 < 0 → 0 < 1 → 0 < 2” : Sentence Language.oring)

end SubFormula

abbrev Theory (L : Language) (μ) := Set (Formula L μ)

abbrev CTheory (L : Language) := Set (Sentence L)

class SubTheory (T U : CTheory L) where
  sub : T ⊆ U

namespace SubTheory

variable {T U T₁ T₂ T₃ : CTheory L}

instance : SubTheory T T := ⟨by rfl⟩

def trans [SubTheory T₁ T₂] [SubTheory T₂ T₃] : SubTheory T₁ T₃ := ⟨subset_trans (sub (T := T₁) (U := T₂)) sub⟩

end SubTheory

namespace SubFormula

variable {L : Language} [∀ k, DecidableEq (L.func k)] [∀ k, DecidableEq (L.rel k)] [DecidableEq μ]

def hasDecEq : (p q : SubFormula L μ n) → Decidable (p = q)
  | ⊤,        q => by cases q using cases' <;>
      { simp; try { exact isFalse not_false }; try { exact isTrue trivial } }
  | ⊥,        q => by cases q using cases' <;>
      { simp; try { exact isFalse not_false }; try { exact isTrue trivial } }
  | rel r v,  q => by
      cases q using cases' <;> try { simp; exact isFalse not_false }
      case hrel k₁ k₂ r₂ v₂ =>
        by_cases e : k₁ = k₂
        · rcases e with rfl
          exact match decEq r r₂ with
          | isTrue h  => by simp[h]; exact Matrix.decVec _ _ (fun i => decEq (v i) (v₂ i))
          | isFalse h => isFalse (by simp[h])
        · exact isFalse (by simp[e])
  | nrel r v, q => by
      cases q using cases' <;> try { simp; exact isFalse not_false }
      case hnrel k₁ k₂ r₂ v₂ =>
        by_cases e : k₁ = k₂
        · rcases e with rfl
          exact match decEq r r₂ with
          | isTrue h  => by simp[h]; exact Matrix.decVec _ _ (fun i => decEq (v i) (v₂ i))
          | isFalse h => isFalse (by simp[h])
        · exact isFalse (by simp[e])
  | p ⋏ q,    r => by
      cases r using cases' <;> try { simp; exact isFalse not_false }
      case hand p' q' =>
        exact match hasDecEq p p' with
        | isTrue hp =>
          match hasDecEq q q' with
          | isTrue hq  => isTrue (hp ▸ hq ▸ rfl)
          | isFalse hq => isFalse (by simp[hp, hq])
        | isFalse hp => isFalse (by simp[hp])
  | p ⋎ q,    r => by
      cases r using cases' <;> try { simp; exact isFalse not_false }
      case hor p' q' =>
        exact match hasDecEq p p' with
        | isTrue hp =>
          match hasDecEq q q' with
          | isTrue hq  => isTrue (hp ▸ hq ▸ rfl)
          | isFalse hq => isFalse (by simp[hp, hq])
        | isFalse hp => isFalse (by simp[hp])
  | ∀' p,     q => by
      cases q using cases' <;> try { simp; exact isFalse not_false }
      case hall p' => simp; exact hasDecEq p p'
  | ∃' p,     q => by
      cases q using cases' <;> try { simp; exact isFalse not_false }
      case hex p' => simp; exact hasDecEq p p'

instance : DecidableEq (SubFormula L μ n) := hasDecEq

end SubFormula

end FirstOrder


import .datatypes tactic.norm_num
namespace polya

theorem eq_or_gt_of_ge {α} [decidable_linear_order α] {a b : α} (h : a ≥ b) : a = b ∨ a > b :=
have h1 : ¬ b > a, from not_lt_of_ge h,
eq_or_lt_of_not_lt h1

theorem eq_or_lt_of_le {α} [decidable_linear_order α] {a b : α} (h : a ≤ b) : a = b ∨ a < b :=
have h1 : ¬ b < a, from not_lt_of_ge h,
have h2 : b = a ∨ a < b, from eq_or_lt_of_not_lt h1,
h2.elim (λ e, or.inl (e.symm)) or.inr

theorem le_of_eq_or_lt {α} [decidable_linear_order α] {a b : α} (h : a = b ∨ a < b) : a ≤ b :=
h.elim (λ e, by rw e; reflexivity) le_of_lt

theorem ge_of_eq_or_gt {α} [decidable_linear_order α] {a b : α} (h : a = b ∨ a > b) : a ≥ b :=
h.elim (λ e, by rw e; change b ≤ b; reflexivity) le_of_lt

class comp_op (op : ℚ → ℚ → Prop) :=
(rev_op : ℚ → ℚ → Prop)
(rev_op_is_rev : ∀ {x y}, rev_op y x ↔ op x y)
(rel_of_sub_rel_zero : ∀ {x y : ℚ}, op (x-y) 0 ↔ op x y)
(op_mul : ∀ {x y c : ℚ}, c > 0 → op x y → op (c*x) (c*y))
(op_inv : ∀ {x y z : ℚ}, x > 0 → op z (x*y) → op ((rat.pow x (-1))*z) y)

class weak_comp_op (op) extends comp_op op :=
(strict_op : ℚ → ℚ → Prop)
(disj : ∀ {x y}, op x y ↔ x = y ∨ strict_op x y)
(ne_of_str : ∀ {x y}, strict_op x y → x ≠ y)

instance colt : comp_op (@has_lt.lt ℚ _) :=
{rev_op := @gt ℚ _,
 rev_op_is_rev := by intros; reflexivity,
 rel_of_sub_rel_zero := begin intros, constructor, exact lt_of_sub_neg, exact sub_neg_of_lt end,
 op_mul := begin intros, refine mul_lt_mul_of_pos_left _ _, repeat {assumption} end,
 op_inv := begin intros, fapply lt_of_mul_lt_mul_left, exact x, rw [←mul_assoc, rat.mul_pow_neg_one, one_mul], assumption, apply ne_of_gt, assumption, apply le_of_lt, assumption end }

instance cole : weak_comp_op (@has_le.le ℚ _) :=
{rev_op := @ge ℚ _,
 rev_op_is_rev := by intros; reflexivity,
 rel_of_sub_rel_zero := begin intros, constructor, apply le_of_sub_nonpos, apply sub_nonpos_of_le end,
 op_mul := begin intros, apply mul_le_mul_of_nonneg_left, assumption, apply le_of_lt, assumption end,
 strict_op := @has_lt.lt ℚ _,
 disj := begin intros, constructor, apply eq_or_lt_of_le, apply le_of_eq_or_lt end,
 ne_of_str := @ne_of_lt ℚ _,
 op_inv := begin intros, fapply le_of_mul_le_mul_left, exact x, rw [←mul_assoc, rat.mul_pow_neg_one, one_mul], assumption, apply ne_of_gt, assumption, assumption end}

instance cogt : comp_op (@gt ℚ _) :=
{rev_op := @has_lt.lt ℚ _,
 rev_op_is_rev := by intros; reflexivity,
 rel_of_sub_rel_zero := begin intros, constructor, exact lt_of_sub_pos, exact sub_pos_of_lt end,
 op_mul := begin intros, refine mul_lt_mul_of_pos_left _ _, repeat {assumption} end,
 op_inv := begin intros, fapply lt_of_mul_lt_mul_left, exact x, rw [←mul_assoc, rat.mul_pow_neg_one, one_mul], assumption, apply ne_of_gt, assumption, apply le_of_lt, assumption end}

instance coge : weak_comp_op (@ge ℚ _) :=
{rev_op := @has_le.le ℚ _,
 rev_op_is_rev := by intros; reflexivity,
 rel_of_sub_rel_zero := begin intros, constructor, apply le_of_sub_nonneg, apply sub_nonneg_of_le end,
 op_mul := begin intros, apply mul_le_mul_of_nonneg_left, assumption, apply le_of_lt, assumption end,
 strict_op := @gt ℚ _,
 disj := begin intros, constructor, apply eq_or_gt_of_ge, apply ge_of_eq_or_gt end,
 ne_of_str := @ne_of_gt ℚ _,
 op_inv := begin intros, fapply le_of_mul_le_mul_left, exact x, rw [←mul_assoc, rat.mul_pow_neg_one, one_mul], assumption, apply ne_of_gt, assumption, assumption end}

instance coeq : comp_op (@eq ℚ) :=
{rev_op := @eq ℚ,
 rev_op_is_rev := by cc,
 rel_of_sub_rel_zero := by intros; apply sub_eq_zero_iff_eq,
 op_mul := by cc,
 op_inv := begin intros, fapply eq_of_mul_eq_mul_left, exact x, apply ne_of_gt, assumption, rw [←mul_assoc, rat.mul_pow_neg_one, one_mul ], assumption, apply ne_of_gt, assumption end
}

@[reducible] private def strict_op := weak_comp_op.strict_op

@[reducible] private def rev := comp_op.rev_op
lemma rev_op_is_rev {o x y} [comp_op o] : rev o y x ↔ o x y := comp_op.rev_op_is_rev _

lemma op_mul_neg {o}  {x y c : ℚ} [comp_op o] (hc : c < 0) (h : o x y) : rev o (c*x) (c*y) :=
have o (x-y) 0, from (comp_op.rel_of_sub_rel_zero o).mpr h,
have o (-c*(x-y)) ((-c)*0), from comp_op.op_mul (neg_pos_of_neg hc) this,
have o (c*y - c*x) 0, begin
 rw [mul_sub, mul_zero, ←neg_mul_eq_neg_mul, ←neg_mul_eq_neg_mul, sub_neg_eq_add, add_comm] at this, assumption
end,
rev_op_is_rev.mpr ((comp_op.rel_of_sub_rel_zero o).mp this)

/-
set_option pp.all true
example : (-1 : ℚ) < 0 :=
begin
apply neg_of_neg_pos, -- fails
--apply (@neg_of_neg_pos ℚ _), -- succeeds
--refine neg_of_neg_pos _, -- succeeds
end

example : (-1 : ℤ) < 0 :=
begin
apply neg_of_neg_pos, -- succeeds
end
-/

lemma op_neg {o} {x y : ℚ} [comp_op o] (h : o x y) : rev o (-x) (-y) :=
begin
rw [neg_eq_neg_one_mul, neg_eq_neg_one_mul y],
apply op_mul_neg,
refine neg_of_neg_pos _,
exact zero_lt_one,
assumption
end

theorem sym_op_pos {o} [comp_op o] {lhs rhs c : ℚ} (hc : c > 0) (h : o lhs (c*rhs)) : rev o rhs ((1/c)*lhs) :=
have h' : o ((1/c)*lhs) ((1/c)*(c*rhs)), from comp_op.op_mul (one_div_pos_of_pos hc) h,
suffices o ((1/c)*lhs) rhs, by rw rev_op_is_rev; assumption,
by rw [←mul_assoc, one_div_mul_cancel (ne_of_gt hc), one_mul] at h'; assumption
--comp_op.rev_recip hc h

theorem sym_op_neg {o} [comp_op o] {lhs rhs c : ℚ} (hc : c < 0) (h : o lhs (c*rhs)) : o rhs ((1/c)*lhs) :=
have h' : rev o ((1/c)*lhs) ((1/c)*(c*rhs)), begin
apply op_mul_neg,
refine one_div_neg_of_neg _, repeat {assumption}
end,
suffices rev o ((1/c)*lhs) rhs, begin
apply rev_op_is_rev.mp,
assumption
end,
by rw [←mul_assoc, one_div_mul_cancel (ne_of_lt hc), one_mul] at h'; assumption

theorem diseq_sym {lhs rhs c : ℚ} (hc : c ≠ 0) (h : lhs ≠ c*rhs) : rhs ≠ (1/c) * lhs :=
sorry

theorem eq_sym {lhs rhs c : ℚ} (hc : c ≠ 0) (h : lhs = c*rhs) : rhs = (1/c) * lhs :=
sorry

/-section ineq_sym
variables {lhs rhs c : ℚ}
theorem ineq_sym_le_pos (hc : c > 0) (h : lhs ≤ c*rhs) : rhs ≥ (1/c) * lhs :=
sorry

theorem ineq_sym_lt_pos (hc : c > 0) (h : lhs < c*rhs) : rhs > (1/c) * lhs :=
sorry

theorem ineq_sym_ge_pos (hc : c > 0) (h : lhs ≥ c*rhs) : rhs ≤ (1/c) * lhs :=
sorry

theorem ineq_sym_gt_pos (hc : c > 0) (h : lhs > c*rhs) : rhs < (1/c) * lhs :=
sorry

theorem ineq_sym_le_neg (hc : c < 0) (h : lhs ≤ c*rhs) : rhs ≤ (1/c) * lhs :=
sorry

theorem ineq_sym_lt_neg (hc : c < 0) (h : lhs < c*rhs) : rhs < (1/c) * lhs :=
sorry

theorem ineq_sym_ge_neg (hc : c < 0) (h : lhs ≥ c*rhs) : rhs ≥ (1/c) * lhs :=
sorry

theorem ineq_sym_gt_neg (hc : c < 0) (h : lhs > c*rhs) : rhs > (1/c) * lhs :=
sorry

meta def name_of_comp_pos : comp → name
| comp.le := ``ineq_sym_le_pos
| comp.lt := ``ineq_sym_lt_pos
| comp.ge := ``ineq_sym_ge_pos
| comp.gt := ``ineq_sym_gt_pos

meta def name_of_comp_neg : comp → name
| comp.le := ``ineq_sym_le_neg
| comp.lt := ``ineq_sym_lt_neg
| comp.ge := ``ineq_sym_ge_neg
| comp.gt := ``ineq_sym_gt_neg

meta def name_of_c_and_comp (c : ℚ) (cmp : comp) : name :=
if c ≥ 0 then name_of_comp_pos cmp else name_of_comp_neg cmp

end ineq_sym-/

/-theorem ineq_diseq_le {lhs rhs c : ℚ} (hc : lhs ≠ c*rhs) (h : lhs ≤ c*rhs) : lhs < c*rhs :=
or.elim (lt_or_eq_of_le h) (id) (λ hp, absurd hp hc)

theorem ineq_diseq_ge {lhs rhs c : ℚ} (hc : lhs ≠ c*rhs) (h : lhs ≥ c*rhs) : lhs > c*rhs :=
or.elim (lt_or_eq_of_le h) (id) (λ hp, absurd (eq.symm hp) hc)-/

theorem ineq_diseq {lhs rhs c : ℚ} {o} [weak_comp_op o] (hc : lhs ≠ c*rhs) (h : o lhs (c*rhs)) :
        weak_comp_op.strict_op o lhs (c*rhs) :=
or.elim ((weak_comp_op.disj o).mp h) (λ t, absurd t hc) id

/-theorem ineq_diseq_sign_lhs_le {lhs rhs : ℚ} (hc : lhs ≠ 0) (h : lhs ≤ 0*rhs) : lhs < 0*rhs :=
sorry

theorem ineq_diseq_sign_lhs_ge {lhs rhs : ℚ} (hc : lhs ≠ 0) (h : lhs ≥ 0*rhs) : lhs > 0*rhs :=
sorry-/

theorem ineq_diseq_sign_lhs {lhs rhs : ℚ} (hc : lhs ≠ 0) {o} [weak_comp_op o] (h : o lhs (0*rhs)) :
        weak_comp_op.strict_op o lhs (0*rhs) :=
begin
apply ineq_diseq,
simp *, assumption
end

/-theorem ineq_diseq_sign_rhs_le {rhs : ℚ} (hc : rhs ≠ 0) (h : rhs ≤ 0) : rhs < 0 :=
sorry

theorem ineq_diseq_sign_rhs_ge {rhs : ℚ} (hc : rhs ≠ 0) (h : rhs ≥ 0) : rhs > 0 :=
sorry-/

theorem ineq_diseq_sign_rhs {rhs : ℚ} (hc : rhs ≠ 0) {o} [weak_comp_op o] (h : o rhs 0) : weak_comp_op.strict_op o rhs 0 :=
begin
cases (weak_comp_op.disj o).mp h,
repeat {cc}
end

theorem op_ineq {lhs rhs c : ℚ} (h1 : lhs ≤ c*rhs) (h2 : lhs ≥ c*rhs) : lhs = c*rhs :=
have h : lhs = c*rhs ∨ lhs < c*rhs, from eq_or_lt_of_le h1,
h.elim id (λ e, absurd h2 (not_le_of_gt e))

theorem op_zero_of_zero_op_neg_mul {o} [comp_op o] {c q : ℚ} (h : c < 0) (h2 : o 0 (c*q)) : o q 0 :=
have hc : 1 / c < 0, from one_div_neg_of_neg h,
have h' : _, from op_mul_neg hc h2,
have h'' : _, from rev_op_is_rev.mp h',
have hc' : (1/c)*(c*q) = q, by rw [←mul_assoc, one_div_mul_cancel, one_mul]; apply ne_of_lt h,
by rw [hc', mul_zero] at h''; assumption

theorem rev_op_zero_of_neg_mul_op_zero {o} [comp_op o] {c q : ℚ} (h : c < 0) (h2 : o (c*q) 0) : rev o q 0 :=
have hc : 1 / c < 0, from one_div_neg_of_neg h,
have h' : _, from op_mul_neg hc h2,
have hc' : (1/c)*(c*q) = q, by rw [←mul_assoc, one_div_mul_cancel, one_mul]; apply ne_of_lt h,
by rw [hc', mul_zero] at h'; assumption

theorem op_zero_of_pos_mul_op_zero {o} [comp_op o] {c q : ℚ} (h : c > 0) (h2 : o (c*q) 0) : o q 0 :=
have hc : 1 / c > 0, from one_div_pos_of_pos h,
have h' : _, from comp_op.op_mul hc h2,
have hc' : (1/c)*(c*q) = q, by rw [←mul_assoc, one_div_mul_cancel, one_mul]; apply ne_of_gt h,
by rw [hc', mul_zero] at h'; assumption

section
variables {lhs : ℚ} (rhs : ℚ)
/-theorem zero_mul_le (h : lhs ≤ 0) : lhs ≤ 0*rhs := by rw zero_mul; assumption
theorem zero_mul_lt (h : lhs < 0) : lhs < 0*rhs := by rw zero_mul; assumption
theorem zero_mul_ge (h : lhs ≥ 0) : lhs ≥ 0*rhs := by rw zero_mul; assumption
theorem zero_mul_gt (h : lhs > 0) : lhs > 0*rhs := by rw zero_mul; assumption

meta def zero_mul_name_of_comp : comp → name
| comp.le := ``zero_mul_le
| comp.lt := ``zero_mul_lt
| comp.ge := ``zero_mul_ge
| comp.gt := ``zero_mul_gt-/
theorem op_zero_mul {o} [comp_op o] (h : o lhs 0) : o lhs (0*rhs) := by simp *

variable {rhs}
/-theorem zero_mul_le' (h : lhs ≤ 0*rhs) : lhs ≤ 0 := by rw -(zero_mul rhs); assumption
theorem zero_mul_lt' (h : lhs < 0*rhs) : lhs < 0 := by rw -(zero_mul rhs); assumption
theorem zero_mul_ge' (h : lhs ≥ 0*rhs) : lhs ≥ 0 := by rw -(zero_mul rhs); assumption
theorem zero_mul_gt' (h : lhs > 0*rhs) : lhs > 0 := by rw -(zero_mul rhs); assumption-/

theorem op_zero_mul' {o} [comp_op o] (h : o lhs (0*rhs)) : o lhs 0 := by rw ←(zero_mul rhs); assumption

/-meta def zero_mul'_name_of_comp : comp → name
| comp.le := ``zero_mul_le'
| comp.lt := ``zero_mul_lt'
| comp.ge := ``zero_mul_ge'
| comp.gt := ``zero_mul_gt'-/

end

theorem eq_zero_of_eq_mul_zero {lhs rhs : ℚ} (h : lhs = 0*rhs) : lhs = 0 :=
by rw ←(zero_mul rhs); assumption

theorem ne_zero_of_ne_mul_zero {lhs rhs : ℚ} (h : lhs ≠ 0*rhs) : lhs ≠ 0 :=
by rw ←(zero_mul rhs); assumption

theorem eq_zero_of_two_eqs_rhs {lhs rhs c1 c2 : ℚ} (h : lhs = c1*rhs) (h2 : lhs = c2*rhs) (hc : c1 ≠ c2) : rhs = 0 :=
begin
 rw h at h2,
 have h3 := sub_eq_zero_of_eq h2,
 rw ←sub_mul at h3,
 cases eq_zero_or_eq_zero_of_mul_eq_zero h3 with ha hb,
 apply absurd (eq_of_sub_eq_zero ha) hc,
 assumption
end

theorem eq_zero_of_two_eqs_lhs {lhs rhs c1 c2 : ℚ} (h : lhs = c1*rhs) (h2 : lhs = c2*rhs) (hc : c1 ≠ c2) : lhs = 0 :=
have hr : rhs = 0, from eq_zero_of_two_eqs_rhs h h2 hc,
begin rw hr at h, rw mul_zero at h, assumption end

section
variables {lhs rhs c : ℚ} (h : lhs = 0)
include h

/-
PUT THEOREMS FOR ineq_of_ineq_and_eq_zero_rhs here
-/

end

section
variables {lhs rhs c d : ℚ}
--include h

/- there are 16 possibilities here!
theorem sub_le_zero_of_le {a b : ℚ} (h : a ≤ b) : a - b ≤ 0 := sorry
theorem sub_lt_zero_of_lt {a b : ℚ} (h : a < b) : a - b < 0 := sorry
theorem sub_ge_zero_of_ge {a b : ℚ} (h : a ≥ b) : a - b ≥ 0 := sorry
theorem sub_gt_zero_of_gt {a b : ℚ} (h : a > b) : a - b > 0 := sorry-/

theorem sub_op_zero_of_op {a b : ℚ} {o} [comp_op o] (h : o a b) : o (a-b) 0 :=
(comp_op.rel_of_sub_rel_zero _).mpr h

variable (h : lhs = d*rhs)
include h

-- is this used?
theorem op_eq_coeff_sub_pos {o} [comp_op o] (h1 : o lhs (c*rhs)) (h2 : d - c > 0) : o rhs 0 :=
have o (d*rhs) (c*rhs), by rw ←h; assumption,
have o (d*rhs - c*rhs) 0, from sub_op_zero_of_op this,
have o ((d-c)*rhs) 0, by rw sub_mul; assumption,
have dc : 1/(d-c) > 0, from one_div_pos_of_pos h2,
let cmp := comp_op.op_mul dc this in
begin
rw [mul_zero, ←mul_assoc, div_mul_cancel _ (ne_of_gt h2), one_mul] at cmp,
assumption
end

/-theorem le_gt_rhs (h1 : lhs ≤ c*rhs) (h2 : d - c > 0) : rhs ≤ 0 :=
have d*rhs ≤ c*rhs, by rw -h; assumption,
have d*rhs - c*rhs ≤ 0, from sub_le_zero_of_le this,
have (d - c)*rhs ≤ 0, by rw sub_mul; assumption,
show rhs ≤ 0, from nonpos_of_mul_nonpos_left this h2

theorem lt_gt_rhs (h1 : lhs < c*rhs) (h2 : d - c > 0) : rhs < 0 :=
have d*rhs < c*rhs, by rw -h; assumption,
have d*rhs - c*rhs < 0, from sub_lt_zero_of_lt this,
have (d - c)*rhs < 0, by rw sub_mul; assumption,
show rhs < 0, from neg_of_mul_neg_left this (le_of_lt h2)

theorem ge_gt_rhs (h1 : lhs ≥ c*rhs) (h2 : d - c > 0) : rhs ≥ 0 :=
have d*rhs ≥ c*rhs, by rw -h; assumption,
have d*rhs - c*rhs ≥ 0, from sub_ge_zero_of_ge this,
have (d - c)*rhs ≥ 0, by rw sub_mul; assumption,
show rhs ≥ 0, from nonneg_of_mul_nonneg_left this h2

theorem gt_gt_rhs (h1 : lhs > c*rhs) (h2 : d - c > 0) : rhs > 0 :=
have d*rhs > c*rhs, by rw -h; assumption,
have d*rhs - c*rhs > 0, from sub_gt_zero_of_gt this,
have (d - c)*rhs > 0, by rw sub_mul; assumption,
show rhs > 0, from pos_of_mul_pos_left this (le_of_lt h2)-/

omit h
theorem sub_lt_of_lt (h1 : lhs < c*rhs) : 1*lhs + (-c)*rhs < 0 :=
begin
 rw [neg_mul_eq_neg_mul_symm, one_mul],
 exact sub_neg_of_lt h1
end

theorem sub_le_of_le (h1 : lhs ≤ c*rhs) : 1*lhs + (-c)*rhs ≤ 0 :=
begin
 rw [neg_mul_eq_neg_mul_symm, one_mul],
 rw [add_neg_le_iff_le_add', add_zero],
 exact h1
end

theorem sub_lt_of_gt (h1 : lhs > c*rhs) : (-1)*lhs + c*rhs < 0 :=
begin
 rw [add_comm, ←neg_mul_eq_neg_mul, one_mul],
 exact sub_neg_of_lt h1
end

theorem sub_le_of_ge (h1 : lhs ≥ c*rhs) : (-1)*lhs + c*rhs ≤ 0 :=
begin
 rw [add_comm, ←neg_mul_eq_neg_mul, one_mul],
 exact sub_nonpos_of_le h1
end

theorem mul_lt_of_gt {rhs : ℚ} (h1 : lhs > 0*rhs) : (-1)*lhs < 0 :=
begin
  simp at h1,
  simp only [neg_mul_eq_neg_mul_symm, one_mul],
  exact neg_neg_of_pos h1
end

theorem mul_le_of_ge {rhs : ℚ} (h1 : lhs ≥ 0*rhs) : (-1)*lhs ≤ 0 :=
begin
  simp at h1,
  simp only [neg_mul_eq_neg_mul_symm, one_mul],
  exact neg_le_of_neg_le h1
end

theorem mul_lt_of_lt {rhs : ℚ} (h1 : lhs < 0*rhs) : 1*lhs < 0 :=
begin
  simp at h1,
  rw [one_mul],
  exact h1
end

theorem mul_le_of_le {rhs : ℚ} (h1 : lhs ≤ 0*rhs) : 1*lhs ≤ 0 :=
begin
  simp at h1,
  rw [one_mul],
  exact h1
end

end

meta def sum_form_name_of_comp_single : comp → name
| comp.lt := ``mul_lt_of_lt
| comp.le := ``mul_le_of_le
| comp.gt := ``mul_lt_of_gt
| comp.ge := ``mul_le_of_ge

meta def sum_form_name_of_comp : comp → name
| comp.lt := ``sub_lt_of_lt
| comp.le := ``sub_le_of_le
| comp.gt := ``sub_lt_of_gt
| comp.ge := ``sub_le_of_ge

theorem gt_self_contr {e : ℚ} (h : e > 1*e) : false :=
begin apply lt_irrefl e, rw one_mul at h, assumption end

theorem lt_self_contr {e : ℚ} (h : e < 1*e) : false :=
begin apply lt_irrefl e, rw one_mul at h, assumption end

theorem le_gt_contr {e : ℚ} (h1 : e ≤ 0) (h2 : e > 0) : false :=
not_le_of_gt h2 h1

theorem ge_lt_contr {e : ℚ} (h1 : e ≥ 0) (h2 : e < 0) : false :=
not_le_of_gt h2 h1

theorem gt_lt_contr {e : ℚ} (h1 : e > 0) (h2 : e < 0) : false :=
not_le_of_gt h1 (le_of_lt h2)

theorem op_of_sum_op_zero_pos {o} [comp_op o] {lhs rhs a b : ℚ} (h : o (a*lhs + b*rhs) 0)
        (h2 : a > 0) : o lhs (((-b)/a)*rhs) :=
have o (a*lhs - -(b*rhs)) 0, by rw sub_neg_eq_add; assumption,
have o (a*lhs) (-(b*rhs)), from (comp_op.rel_of_sub_rel_zero _).mp this,
let np := comp_op.op_mul (one_div_pos_of_pos h2) this in
begin
rw [←mul_assoc, one_div_mul_cancel (ne_of_gt h2), one_mul, neg_mul_eq_neg_mul, ←mul_assoc, div_mul_eq_mul_div, one_mul] at np, assumption
end

theorem op_of_sum_op_zero_neg {o} [comp_op o] {lhs rhs a b : ℚ} (h : o (a*lhs + b*rhs) 0)
        (h2 : a < 0) : rev o lhs (((-b)/a)*rhs) :=
have o (a*lhs - -(b*rhs)) 0, by rw sub_neg_eq_add; assumption,
have o (a*lhs) (-(b*rhs)), from (comp_op.rel_of_sub_rel_zero _).mp this,
let np := comp_op.op_mul (neg_pos_of_neg (one_div_neg_of_neg h2)) this in

begin
rw [←mul_assoc, ←neg_mul_eq_neg_mul, one_div_mul_cancel (ne_of_lt h2), ←neg_mul_eq_neg_mul, one_mul, neg_mul_neg, ←mul_assoc, div_mul_eq_mul_div, one_mul ] at np,
rw [←(neg_neg lhs), neg_div, ←neg_mul_eq_neg_mul],
apply op_neg,
assumption
end

theorem rev_op_zero_of_op {o} [comp_op o] {e : ℚ} (h : o e 0) : rev o (-e) 0 :=
suffices rev o (-e) (-0), by rw ←neg_zero; assumption,
begin
rw [neg_eq_neg_one_mul, neg_eq_neg_one_mul (0 : ℚ)],
apply op_mul_neg,
apply neg_of_neg_pos _,
exact zero_lt_one,
assumption
end

instance {o} [comp_op o] : comp_op (rev o) :=
{ op_inv := sorry,
  op_mul := sorry,
  rel_of_sub_rel_zero := sorry,
  rev_op_is_rev := sorry,
  rev_op := o
}

theorem rev_rev {o} [comp_op o] : rev (rev o) = o :=
begin
apply funext,
intro x, apply funext, intro y,
rw [rev_op_is_rev, rev_op_is_rev]
end

class one_op_one_div_class (o : ℚ → ℚ → Prop) :=
(oood : ∀ {x}, 0 < x → o x 1 → o 1 (rat.pow x (-1)))

instance ooodlt : one_op_one_div_class (@has_lt.lt rat _) :=
⟨begin intro, rw rat.pow_neg_one, apply one_lt_one_div end⟩

instance ooodle : one_op_one_div_class (@has_le.le rat _) :=
⟨begin intro, rw rat.pow_neg_one, apply one_le_one_div end⟩

instance ooodgt : one_op_one_div_class (@gt rat _) :=
⟨begin intros, rw rat.pow_neg_one, change 1/1 > 1/x, apply one_div_lt_one_div_of_lt, apply zero_lt_one, assumption end⟩

instance ooodge : one_op_one_div_class (@ge rat _) :=
⟨begin intros, rw rat.pow_neg_one, change 1/1 ≥ 1/x, apply one_div_le_one_div_of_le, apply zero_lt_one, assumption end⟩

instance {o} [comp_op o] [one_op_one_div_class o] : one_op_one_div_class (rev o) :=
⟨begin
 intros x h hr,
 apply rev_op_is_rev.mp,
 rw rev_rev,
 have : o ((rat.pow x (-1))*1) 1 := comp_op.op_inv h _,
 simp [rat.pow] at this, rw rat.pow_neg_one at this,
 rw rat.pow_neg_one,
 apply this,
 rw rev_op_is_rev at hr, rw mul_one, exact hr
end⟩

def one_op_one_div {o : ℚ → ℚ → Prop} [h : one_op_one_div_class o] := @one_op_one_div_class.oood _ h

theorem one_op_inv_mul_of_op_of_pos {o} [comp_op o] {lhs rhs c : ℚ} (h : o lhs (c*rhs)) (hp : lhs > 0) :
         o 1 (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) :=
have (rat.pow lhs (-1)) > 0, by rw [rat.pow_neg_one]; apply one_div_pos_of_pos hp,
have o ( (rat.pow lhs (-1))*lhs) ( (rat.pow lhs (-1))*(c*rhs)), from comp_op.op_mul this h,
begin
  rw [rat.pow_neg_one, ← inv_eq_one_div] at ⊢ this,
  rw [rat.pow_one],
  rw [inv_mul_cancel (ne_of_gt hp)] at this,
  rw [mul_comm lhs⁻¹, ← mul_assoc, mul_comm (c*rhs)],
  exact this
end

theorem one_op_inv_mul_of_op_of_neg {o} [comp_op o] {lhs rhs c : ℚ} (h : o lhs (c*rhs)) (hp : lhs < 0) :
         rev o 1 (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) :=
--o (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) 1 :=
have (rat.pow lhs (-1)) < 0, by rw [rat.pow_neg_one]; apply one_div_neg_of_neg hp,
have rev o ( (rat.pow lhs (-1))*lhs) ( (rat.pow lhs (-1))*(c*rhs)), from op_mul_neg this h,
begin
  rw [rat.pow_neg_one, ← inv_eq_one_div] at ⊢ this,
  rw [rat.pow_one],
  rw [inv_mul_cancel (ne_of_lt hp)] at this,
  rw [mul_comm lhs⁻¹, ← mul_assoc, mul_comm (c*rhs)],
  exact this
end

theorem one_op_inv_mul_of_lt_of_pos_pos_flipped {lhs rhs c : ℚ} {o} [one_op_one_div_class o]
        (h : o (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) 1)
        (hl : lhs > 0) (hr : rhs > 0) (hc : c > 0) : o 1 ((1/c) * ((rat.pow lhs 1)*(rat.pow rhs (-1)))) :=
have rat.pow lhs (-1) > 0, by rw rat.pow_neg_one; apply one_div_pos_of_pos hl,
have c * ((rat.pow lhs (-1)) * rhs) > 0, by repeat {apply mul_pos _ _, repeat {assumption}},
have o 1 (rat.pow (c * ((rat.pow lhs (-1)) * (rat.pow rhs 1))) (-1)), by simp only [rat.pow_one] at *; apply one_op_one_div this h,
by simp only [rat.pow_neg_one, rat.pow_one] at ⊢ this; rw [←one_div_mul_one_div, ←one_div_mul_one_div, one_div_one_div] at this; assumption

theorem one_op_inv_mul_of_lt_of_pos_pos_flipped' {lhs rhs c : ℚ} {o} [comp_op o] [one_op_one_div_class o]
        (h : o 1 (c*((rat.pow lhs (-1))*(rat.pow rhs 1))))
        (hl : lhs > 0) (hr : rhs > 0) (hc : c > 0) : (rev o) 1 ((1/c) * ((rat.pow lhs 1)*(rat.pow rhs (-1)))) :=
have h' : _ := (comp_op.rev_op_is_rev _).mpr h,
one_op_inv_mul_of_lt_of_pos_pos_flipped h' hl hr hc

/-theorem one_lt_inv_mul_of_lt_of_pos_flipped' {lhs rhs c : ℚ} (h : 1 > (c*((1/lhs)*rhs)))
        (hl : lhs > 0) (hr : rhs > 0) (hc : c > 0) : 1 < ((1/c) * (lhs*(1/rhs))) :=
/-have 1/lhs > 0, from one_div_pos_of_pos hl,
have c * ((1/lhs) * rhs) > 0, by repeat {apply mul_pos, repeat {assumption}},
have 1 < 1 / (c * ((1/lhs) * rhs)), from one_lt_one_div this h,
by rw [-one_div_mul_one_div, -one_div_mul_one_div, one_div_one_div] at this; assumption-/
one_lt_inv_mul_of_lt_of_pos_flipped h hl hr hc-/

/-theorem one_le_inv_mul_of_le_of_pos_flipped {lhs rhs c : ℚ} (h : 1 ≥ (c*((1/lhs)*rhs)))
        (hl : lhs > 0) (hr : rhs > 0) (hc : c > 0) : 1 ≤ ((1/c) * (lhs*(1/rhs))) :=
have 1/lhs > 0, from one_div_pos_of_pos hl,
have c * ((1/lhs) * rhs) > 0, by repeat {apply mul_pos, repeat {assumption}},
have 1 ≤ 1 / (c * ((1/lhs) * rhs)), from one_le_one_div this h,
by rw [-one_div_mul_one_div, -one_div_mul_one_div, one_div_one_div] at this; assumption-/

theorem one_op_inv_mul_of_lt_of_pos_neg_flipped {lhs rhs c : ℚ} {o} [comp_op o] [one_op_one_div_class o]
        (h : (rev o) 1 (c*((rat.pow lhs (-1))*(rat.pow rhs 1))))
        --  (h : o (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) 1)
        (hl : lhs > 0) (hr : rhs < 0) (hc : c < 0) :
o 1 ((1/c) * ((rat.pow lhs 1)*(rat.pow rhs (-1)))) :=
--(rev o) 1 (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) :=
--h
sorry
/-have rat.pow lhs (-1) > 0, by rw rat.pow_neg_one; apply one_div_pos_of_pos hl,
have c * ((rat.pow lhs (-1)) * rhs) > 0,
  begin apply mul_pos_of_neg_of_neg _ _, assumption, apply mul_neg_of_pos_of_neg _ _, repeat {assumption} end,
have o 1 (rat.pow (c * ((rat.pow lhs (-1)) * (rat.pow rhs 1))) (-1)), by simp only [rat.pow_one] at *; apply one_op_one_div this h,
by simp only [rat.pow_neg_one, rat.pow_one] at this ⊢; rw [←one_div_mul_one_div, ←one_div_mul_one_div, one_div_one_div] at this; assumption-/

/-theorem one_lt_inv_mul_of_lt_of_neg_flipped {lhs rhs c : ℚ} (h : 1 > (c*((1/lhs)*rhs)))
        (hl : lhs > 0) (hr : rhs < 0) (hc : c < 0) : 1 < ((1/c) * (lhs*(1/rhs))) :=
have 1/lhs > 0, from one_div_pos_of_pos hl,
have c * ((1/lhs) * rhs) > 0,
  begin apply mul_pos_of_neg_of_neg, assumption, apply mul_neg_of_pos_of_neg, repeat {assumption} end,
have 1 < 1 / (c * ((1/lhs) * rhs)), from one_lt_one_div this h,
by rw [-one_div_mul_one_div, -one_div_mul_one_div, one_div_one_div] at this; assumption

theorem one_le_inv_mul_of_le_of_neg_flipped {lhs rhs c : ℚ} (h : 1 ≥ (c*((1/lhs)*rhs)))
        (hl : lhs > 0) (hr : rhs < 0) (hc : c < 0) : 1 ≤ ((1/c) * (lhs*(1/rhs))) :=
have 1/lhs > 0, from one_div_pos_of_pos hl,
have c * ((1/lhs) * rhs) > 0,
  begin apply mul_pos_of_neg_of_neg, assumption, apply mul_neg_of_pos_of_neg, repeat {assumption} end,
have 1 ≤ 1 / (c * ((1/lhs) * rhs)), from one_le_one_div this h,
by rw [-one_div_mul_one_div, -one_div_mul_one_div, one_div_one_div] at this; assumption-/

theorem one_op_inv_mul_of_lt_of_neg_pos_flipped {lhs rhs c : ℚ} {o} [comp_op o] [one_op_one_div_class o]
        --(h : o (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) 1)
          (h : (rev o) 1 (c*((rat.pow lhs (-1))*(rat.pow rhs 1))))
        (hl : lhs < 0) (hr : rhs > 0) (hc : c < 0) :
            -- o 1 ((1/c) * ((rat.pow lhs 1)*(rat.pow rhs (-1)))) :=
            (rev o) 1 (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) := h
--have h : o (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) 1, from rev_op_is_rev.mp h, -- kill this line to change order
/-have rat.pow lhs (-1) < 0, by rw rat.pow_neg_one; apply one_div_neg_of_neg hl,
have c * ((rat.pow lhs (-1)) * rhs) > 0,
  begin apply mul_pos_of_neg_of_neg _ _, assumption, apply mul_neg_of_neg_of_pos _ _, repeat {assumption} end,
have o 1 (rat.pow (c * ((rat.pow lhs (-1)) * (rat.pow rhs 1))) (-1)), by simp only [rat.pow_one] at *; apply one_op_one_div this h,
by simp only [rat.pow_neg_one, rat.pow_one] at ⊢ this; rw [←one_div_mul_one_div, ←one_div_mul_one_div, one_div_one_div] at this; assumption-/

theorem one_op_inv_mul_of_lt_of_neg_neg_flipped {lhs rhs c : ℚ} {o} [one_op_one_div_class o]
        (h : o (c*((rat.pow lhs (-1))*(rat.pow rhs 1))) 1)
        (hl : lhs < 0) (hr : rhs < 0) (hc : c > 0) : o 1 ((1/c) * ((rat.pow lhs 1)*(rat.pow rhs (-1)))) :=
have rat.pow lhs (-1) < 0, by rw rat.pow_neg_one; apply one_div_neg_of_neg hl,
have c * ((rat.pow lhs (-1)) * rhs) > 0,
  begin apply mul_pos _ _, assumption, apply mul_pos_of_neg_of_neg _ _, repeat {assumption} end,
have o 1 (rat.pow (c * ((rat.pow lhs (-1)) * (rat.pow rhs 1))) (-1)), by simp only [rat.pow_one] at *; apply one_op_one_div this h,
by simp only [rat.pow_neg_one,  rat.pow_one] at ⊢ this; rw [←one_div_mul_one_div, ←one_div_mul_one_div, one_div_one_div] at this; assumption

theorem one_eq_div_of_eq {lhs rhs c : ℚ} (h : lhs = c*rhs) (hl : lhs ≠ 0) : 1 = c*((rat.pow lhs (-1))*(rat.pow rhs 1)) :=
have (rat.pow lhs (-1))*lhs = (rat.pow lhs (-1))*(c*rhs), by cc,
sorry --by finish

theorem lt_pos_pow {a : ℚ} (h : 1 < a) : Π (n : ℕ), 1 < rat.pow a (int.of_nat (n+1))
| 0 := by simp [*, rat.pow]
| (k+1) := begin simp [*, rat.pow], rw ←(mul_one (1:ℚ)), apply mul_lt_mul _ _ _ _, assumption, apply le_of_lt, apply lt_pos_pow, exact zero_lt_one, apply le_trans, apply zero_le_one, apply le_of_lt, assumption end

theorem le_pos_pow {a : ℚ} (h : 1 ≤ a) : Π (n : ℕ), 1 ≤ rat.pow a (int.of_nat (n+1))
| 0 := by simp [*, rat.pow]
| (k+1) := begin simp [*, rat.pow], rw ←(mul_one (1:ℚ)), apply mul_le_mul, assumption, apply le_pos_pow, apply zero_le_one, apply le_trans, apply zero_le_one, assumption end

theorem lt_pos_pow' {a : ℚ} (h : 1 < a) : Π {z : ℤ} (hz : z > 0), 1 < rat.pow a z
| (int.of_nat 0) hz := false.elim $ lt_irrefl _ hz
| (int.of_nat (k+1)) hz := lt_pos_pow h _
| -[1+k] hz := false.elim $ lt_irrefl _ $ lt.trans (int.neg_succ_lt_zero _) hz

theorem le_pos_pow' {a : ℚ} (h : 1 ≤ a) : Π {z : ℤ} (hz : z > 0), 1 ≤ rat.pow a z
| (int.of_nat 0) hz := false.elim $ lt_irrefl _ hz
| (int.of_nat (k+1)) hz := le_pos_pow h _
| -[1+k] hz := false.elim $ lt_irrefl _ $ lt.trans (int.neg_succ_lt_zero _) hz

theorem eq_pow {a : ℚ} (h : 1 = a) (z : ℤ) : 1 = rat.pow a z :=
have rat.pow 1 z = 1, from rat.one_pow _,
by cc

theorem eq_pow' {a b : ℚ} {z : ℤ} (h : 1 = rat.pow (a * b) z) : 1 = rat.pow a z * rat.pow b z := sorry

theorem ne_of_strict_op {o} [weak_comp_op o] {a : ℚ} (h : strict_op o a 0) : a ≠ 0 :=
weak_comp_op.ne_of_str h

/-theorem op_inv_n {o} [comp_op o] {x y z : ℚ} {p : ℤ} (hx : x > 0) (h : o z ((rat.pow x p)*y)) : o ((rat.pow x (-p))*z) y :=
begin
induction p with a a,
induction a,
change int.of_nat 0 with 0 at h,
simp [rat.pow, int.of_nat],
end-/

-- assumes lhs > rhs as exprs. 1 R coeff* lhs^el * rhs^er ==> ineq_data
theorem op_of_one_op_pos {o} [comp_op o] {lhs rhs c : ℚ} (hlhs : lhs > 0) {el er : ℤ} (h : o 1 (c*(rat.pow lhs (el) * rat.pow rhs er))) : o (rat.pow lhs (-el)) (c*rat.pow rhs er) :=
sorry

theorem op_of_one_op_neg {o} [comp_op o] {lhs rhs c : ℚ} (hlhs : lhs < 0) {el er : ℤ} (h : o 1 (c*(rat.pow lhs (el) * rat.pow rhs er))) : (rev o) (rat.pow lhs el) (c*rat.pow rhs er) :=
sorry

theorem op_of_inv_op_inv_pow {o} [comp_op o] {lhs rhs c : ℚ} (h : o (rat.pow lhs (-1)) (c*rat.pow rhs (-1))) : rev o lhs (c*rhs) := sorry

theorem op_of_op_pow {o} [comp_op o] {lhs rhs c : ℚ} (h : o (rat.pow lhs 1) (c*rat.pow rhs 1)) : o lhs (c*rhs) :=
by simp [rat.pow_one, *] at *

private meta def norm_num_inter : tactic unit := `[norm_num]

theorem one_op_of_op_inv {o} [comp_op o] {rhs c : ℚ} (h : o 1 (c*rat.pow rhs (-1))) : rev o 1 ((1/c)*rhs) :=
sorry

theorem one_op_of_op {o} [comp_op o] {rhs c : ℚ} (h : o 1 (c * rat.pow rhs 1)) : o 1 (c*rhs) :=
by simp [rat.pow_one, *] at *

theorem op_zero_of_mul_op_zero_of_pos {o} [comp_op o] {rhs c : ℚ} (h : o (c*rhs) 0) (hc : c > 0) : o rhs 0 := sorry

theorem op_zero_of_mul_op_zero_of_neg {o} [comp_op o] {rhs c : ℚ} (h : o (c*rhs) 0) (hc : c < 0) : rev o rhs 0 := sorry

end polya


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.abelian
import algebra.lie.ideal_operations
import order.hom.basic

/-!
# Solvable Lie algebras

Like groups, Lie algebras admit a natural concept of solvability. We define this here via the
derived series and prove some related results. We also define the radical of a Lie algebra and
prove that it is solvable when the Lie algebra is Noetherian.

## Main definitions

  * `lie_algebra.derived_series_of_ideal`
  * `lie_algebra.derived_series`
  * `lie_algebra.is_solvable`
  * `lie_algebra.is_solvable_add`
  * `lie_algebra.radical`
  * `lie_algebra.radical_is_solvable`
  * `lie_algebra.derived_length_of_ideal`
  * `lie_algebra.derived_length`
  * `lie_algebra.derived_abelian_of_ideal`

## Tags

lie algebra, derived series, derived length, solvable, radical
-/

universes u v w w₁ w₂

variables (R : Type u) (L : Type v) (M : Type w) {L' : Type w₁}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
variables (I J : lie_ideal R L) {f : L' →ₗ⁅R⁆ L}

namespace lie_algebra

/-- A generalisation of the derived series of a Lie algebra, whose zeroth term is a specified ideal.

It can be more convenient to work with this generalisation when considering the derived series of
an ideal since it provides a type-theoretic expression of the fact that the terms of the ideal's
derived series are also ideals of the enclosing algebra.

See also `lie_ideal.derived_series_eq_derived_series_of_ideal_comap` and
`lie_ideal.derived_series_eq_derived_series_of_ideal_map` below. -/
def derived_series_of_ideal (k : ℕ) : lie_ideal R L → lie_ideal R L := (λ I, ⁅I, I⁆)^[k]

@[simp] lemma derived_series_of_ideal_zero :
  derived_series_of_ideal R L 0 I = I := rfl

@[simp] lemma derived_series_of_ideal_succ (k : ℕ) :
  derived_series_of_ideal R L (k + 1) I =
  ⁅derived_series_of_ideal R L k I, derived_series_of_ideal R L k I⁆ :=
function.iterate_succ_apply' (λ I, ⁅I, I⁆) k I

/-- The derived series of Lie ideals of a Lie algebra. -/
abbreviation derived_series (k : ℕ) : lie_ideal R L := derived_series_of_ideal R L k ⊤

lemma derived_series_def (k : ℕ) :
  derived_series R L k = derived_series_of_ideal R L k ⊤ := rfl

variables {R L}

local notation `D` := derived_series_of_ideal R L

lemma derived_series_of_ideal_add (k l : ℕ) : D (k + l) I = D k (D l I) :=
begin
  induction k with k ih,
  { rw [zero_add, derived_series_of_ideal_zero], },
  { rw [nat.succ_add k l, derived_series_of_ideal_succ, derived_series_of_ideal_succ, ih], },
end

@[mono] lemma derived_series_of_ideal_le {I J : lie_ideal R L} {k l : ℕ} (h₁ : I ≤ J) (h₂ : l ≤ k) :
  D k I ≤ D l J :=
begin
  revert l, induction k with k ih; intros l h₂,
  { rw le_zero_iff at h₂, rw [h₂, derived_series_of_ideal_zero], exact h₁, },
  { have h : l = k.succ ∨ l ≤ k, by rwa [le_iff_eq_or_lt, nat.lt_succ_iff] at h₂,
    cases h,
    { rw [h, derived_series_of_ideal_succ, derived_series_of_ideal_succ],
      exact lie_submodule.mono_lie _ _ _ _ (ih (le_refl k)) (ih (le_refl k)), },
    { rw derived_series_of_ideal_succ, exact le_trans (lie_submodule.lie_le_left _ _) (ih h), }, },
end

lemma derived_series_of_ideal_succ_le (k : ℕ) : D (k + 1) I ≤ D k I :=
derived_series_of_ideal_le (le_refl I) k.le_succ

lemma derived_series_of_ideal_le_self (k : ℕ) : D k I ≤ I :=
derived_series_of_ideal_le (le_refl I) (zero_le k)

lemma derived_series_of_ideal_mono {I J : lie_ideal R L} (h : I ≤ J) (k : ℕ) : D k I ≤ D k J :=
derived_series_of_ideal_le h (le_refl k)

lemma derived_series_of_ideal_antitone {k l : ℕ} (h : l ≤ k) : D k I ≤ D l I :=
derived_series_of_ideal_le (le_refl I) h

lemma derived_series_of_ideal_add_le_add (J : lie_ideal R L) (k l : ℕ) :
  D (k + l) (I + J) ≤ (D k I) + (D l J) :=
begin
  let D₁ : lie_ideal R L →o lie_ideal R L :=
  { to_fun    := λ I, ⁅I, I⁆,
    monotone' := λ I J h, lie_submodule.mono_lie I J I J h h, },
  have h₁ : ∀ (I J : lie_ideal R L), D₁ (I ⊔ J) ≤ (D₁ I) ⊔ J,
  { simp [lie_submodule.lie_le_right, lie_submodule.lie_le_left, le_sup_of_le_right], },
  rw ← D₁.iterate_sup_le_sup_iff at h₁,
  exact h₁ k l I J,
end

lemma derived_series_of_bot_eq_bot (k : ℕ) : derived_series_of_ideal R L k ⊥ = ⊥ :=
by { rw eq_bot_iff, exact derived_series_of_ideal_le_self ⊥ k, }

lemma abelian_iff_derived_one_eq_bot : is_lie_abelian I ↔ derived_series_of_ideal R L 1 I = ⊥ :=
by rw [derived_series_of_ideal_succ, derived_series_of_ideal_zero,
  lie_submodule.lie_abelian_iff_lie_self_eq_bot]

lemma abelian_iff_derived_succ_eq_bot (I : lie_ideal R L) (k : ℕ) :
  is_lie_abelian (derived_series_of_ideal R L k I) ↔ derived_series_of_ideal R L (k + 1) I = ⊥ :=
by rw [add_comm, derived_series_of_ideal_add I 1 k, abelian_iff_derived_one_eq_bot]

end lie_algebra

namespace lie_ideal

open lie_algebra

variables {R L}

lemma derived_series_eq_derived_series_of_ideal_comap (k : ℕ) :
  derived_series R I k = (derived_series_of_ideal R L k I).comap I.incl :=
begin
  induction k with k ih,
  { simp only [derived_series_def, comap_incl_self, derived_series_of_ideal_zero], },
  { simp only [derived_series_def, derived_series_of_ideal_succ] at ⊢ ih, rw ih,
    exact comap_bracket_incl_of_le I
      (derived_series_of_ideal_le_self I k) (derived_series_of_ideal_le_self I k), },
end

lemma derived_series_eq_derived_series_of_ideal_map (k : ℕ) :
  (derived_series R I k).map I.incl = derived_series_of_ideal R L k I :=
by { rw [derived_series_eq_derived_series_of_ideal_comap, map_comap_incl, inf_eq_right],
     apply derived_series_of_ideal_le_self, }

lemma derived_series_eq_bot_iff (k : ℕ) :
  derived_series R I k = ⊥ ↔ derived_series_of_ideal R L k I = ⊥ :=
by rw [← derived_series_eq_derived_series_of_ideal_map, map_eq_bot_iff, ker_incl, eq_bot_iff]

lemma derived_series_add_eq_bot {k l : ℕ} {I J : lie_ideal R L}
  (hI : derived_series R I k = ⊥) (hJ : derived_series R J l = ⊥) :
  derived_series R ↥(I + J) (k + l) = ⊥ :=
begin
  rw lie_ideal.derived_series_eq_bot_iff at hI hJ ⊢,
  rw ← le_bot_iff,
  let D := derived_series_of_ideal R L, change D k I = ⊥ at hI, change D l J = ⊥ at hJ,
  calc D (k + l) (I + J) ≤ (D k I) + (D l J) : derived_series_of_ideal_add_le_add I J k l
                     ... ≤ ⊥ : by { rw [hI, hJ], simp, },
end

lemma derived_series_map_le (k : ℕ) :
  (derived_series R L' k).map f ≤ derived_series R L k :=
begin
  induction k with k ih,
  { simp only [derived_series_def, derived_series_of_ideal_zero, le_top], },
  { simp only [derived_series_def, derived_series_of_ideal_succ] at ih ⊢,
    exact le_trans (map_bracket_le f) (lie_submodule.mono_lie _ _ _ _ ih ih), },
end

lemma derived_series_map_eq (k : ℕ) (h : function.surjective f) :
  (derived_series R L' k).map f = derived_series R L k :=
begin
  induction k with k ih,
  { change (⊤ : lie_ideal R L').map f = ⊤,
    rw ←f.ideal_range_eq_map,
    exact f.ideal_range_eq_top_of_surjective h, },
  { simp only [derived_series_def, map_bracket_eq f h, ih, derived_series_of_ideal_succ], },
end

end lie_ideal

namespace lie_algebra

/-- A Lie algebra is solvable if its derived series reaches 0 (in a finite number of steps). -/
class is_solvable : Prop :=
(solvable : ∃ k, derived_series R L k = ⊥)

instance is_solvable_bot : is_solvable R ↥(⊥ : lie_ideal R L) :=
⟨⟨0, subsingleton.elim _ ⊥⟩⟩

instance is_solvable_add {I J : lie_ideal R L} [hI : is_solvable R I] [hJ : is_solvable R J] :
  is_solvable R ↥(I + J) :=
begin
  obtain ⟨k, hk⟩ := id hI, obtain ⟨l, hl⟩ := id hJ,
  exact ⟨⟨k+l, lie_ideal.derived_series_add_eq_bot hk hl⟩⟩,
end

end lie_algebra

variables {R L}

namespace function

open lie_algebra

lemma injective.lie_algebra_is_solvable [h₁ : is_solvable R L] (h₂ : injective f) :
  is_solvable R L' :=
begin
  obtain ⟨k, hk⟩ := id h₁,
  use k,
  apply lie_ideal.bot_of_map_eq_bot h₂, rw [eq_bot_iff, ← hk],
  apply lie_ideal.derived_series_map_le,
end

lemma surjective.lie_algebra_is_solvable [h₁ : is_solvable R L'] (h₂ : surjective f) :
  is_solvable R L :=
begin
  obtain ⟨k, hk⟩ := id h₁,
  use k,
  rw [← lie_ideal.derived_series_map_eq k h₂, hk],
  simp only [lie_ideal.map_eq_bot_iff, bot_le],
end

end function

lemma lie_hom.is_solvable_range (f : L' →ₗ⁅R⁆ L) [h : lie_algebra.is_solvable R L'] :
  lie_algebra.is_solvable R f.range :=
f.surjective_range_restrict.lie_algebra_is_solvable

namespace lie_algebra

lemma solvable_iff_equiv_solvable (e : L' ≃ₗ⁅R⁆ L) : is_solvable R L' ↔ is_solvable R L :=
begin
  split; introsI h,
  { exact e.symm.injective.lie_algebra_is_solvable, },
  { exact e.injective.lie_algebra_is_solvable, },
end

lemma le_solvable_ideal_solvable {I J : lie_ideal R L} (h₁ : I ≤ J) (h₂ : is_solvable R J) :
  is_solvable R I :=
(lie_ideal.hom_of_le_injective h₁).lie_algebra_is_solvable

variables (R L)

@[priority 100]
instance of_abelian_is_solvable [is_lie_abelian L] : is_solvable R L :=
begin
  use 1,
  rw [← abelian_iff_derived_one_eq_bot, lie_abelian_iff_equiv_lie_abelian lie_ideal.top_equiv],
  apply_instance,
end

/-- The (solvable) radical of Lie algebra is the `Sup` of all solvable ideals. -/
def radical := Sup { I : lie_ideal R L | is_solvable R I }

/-- The radical of a Noetherian Lie algebra is solvable. -/
instance radical_is_solvable [is_noetherian R L] : is_solvable R (radical R L) :=
begin
  have hwf := lie_submodule.well_founded_of_noetherian R L L,
  rw ← complete_lattice.is_sup_closed_compact_iff_well_founded at hwf,
  refine hwf { I : lie_ideal R L | is_solvable R I } ⟨⊥, _⟩ (λ I hI J hJ, _),
  { exact lie_algebra.is_solvable_bot R L, },
  { apply lie_algebra.is_solvable_add R L, exacts [hI, hJ] },
end

/-- The `→` direction of this lemma is actually true without the `is_noetherian` assumption. -/
lemma lie_ideal.solvable_iff_le_radical [is_noetherian R L] (I : lie_ideal R L) :
  is_solvable R I ↔ I ≤ radical R L :=
⟨λ h, le_Sup h, λ h, le_solvable_ideal_solvable h infer_instance⟩

lemma center_le_radical : center R L ≤ radical R L :=
have h : is_solvable R (center R L), { apply_instance, }, le_Sup h

/-- Given a solvable Lie ideal `I` with derived series `I = D₀ ≥ D₁ ≥ ⋯ ≥ Dₖ = ⊥`, this is the
natural number `k` (the number of inclusions).

For a non-solvable ideal, the value is 0. -/
noncomputable def derived_length_of_ideal (I : lie_ideal R L) : ℕ :=
Inf {k | derived_series_of_ideal R L k I = ⊥}

/-- The derived length of a Lie algebra is the derived length of its 'top' Lie ideal.

See also `lie_algebra.derived_length_eq_derived_length_of_ideal`. -/
noncomputable abbreviation derived_length : ℕ := derived_length_of_ideal R L ⊤

lemma derived_series_of_derived_length_succ (I : lie_ideal R L) (k : ℕ) :
  derived_length_of_ideal R L I = k + 1 ↔
  is_lie_abelian (derived_series_of_ideal R L k I) ∧ derived_series_of_ideal R L k I ≠ ⊥ :=
begin
  rw abelian_iff_derived_succ_eq_bot,
  let s := {k | derived_series_of_ideal R L k I = ⊥}, change Inf s = k + 1 ↔ k + 1 ∈ s ∧ k ∉ s,
  have hs : ∀ (k₁ k₂ : ℕ), k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s,
  { intros k₁ k₂ h₁₂ h₁,
    suffices : derived_series_of_ideal R L k₂ I ≤ ⊥, { exact eq_bot_iff.mpr this, },
    change derived_series_of_ideal R L k₁ I = ⊥ at h₁, rw ← h₁,
    exact derived_series_of_ideal_antitone I h₁₂, },
  exact nat.Inf_upward_closed_eq_succ_iff hs k,
end

lemma derived_length_eq_derived_length_of_ideal (I : lie_ideal R L) :
  derived_length R I = derived_length_of_ideal R L I :=
begin
  let s₁ := {k | derived_series R I k = ⊥},
  let s₂ := {k | derived_series_of_ideal R L k I = ⊥},
  change Inf s₁ = Inf s₂,
  congr, ext k, exact I.derived_series_eq_bot_iff k,
end

variables {R L}

/-- Given a solvable Lie ideal `I` with derived series `I = D₀ ≥ D₁ ≥ ⋯ ≥ Dₖ = ⊥`, this is the
`k-1`th term in the derived series (and is therefore an Abelian ideal contained in `I`).

For a non-solvable ideal, this is the zero ideal, `⊥`. -/
noncomputable def derived_abelian_of_ideal (I : lie_ideal R L) : lie_ideal R L :=
match derived_length_of_ideal R L I with
| 0     := ⊥
| k + 1 := derived_series_of_ideal R L k I
end

lemma abelian_derived_abelian_of_ideal (I : lie_ideal R L) :
  is_lie_abelian (derived_abelian_of_ideal I) :=
begin
  dunfold derived_abelian_of_ideal,
  cases h : derived_length_of_ideal R L I with k,
  { exact is_lie_abelian_bot R L, },
  { rw derived_series_of_derived_length_succ at h, exact h.1, },
end

lemma derived_length_zero (I : lie_ideal R L) [hI : is_solvable R I] :
  derived_length_of_ideal R L I = 0 ↔ I = ⊥ :=
begin
  let s := {k | derived_series_of_ideal R L k I = ⊥}, change Inf s = 0 ↔ _,
  have hne : s ≠ ∅,
  { obtain ⟨k, hk⟩ := id hI,
    refine set.nonempty.ne_empty ⟨k, _⟩,
    rw [derived_series_def, lie_ideal.derived_series_eq_bot_iff] at hk, exact hk, },
  simp [hne],
end

lemma abelian_of_solvable_ideal_eq_bot_iff (I : lie_ideal R L) [h : is_solvable R I] :
  derived_abelian_of_ideal I = ⊥ ↔ I = ⊥ :=
begin
  dunfold derived_abelian_of_ideal,
  cases h : derived_length_of_ideal R L I with k,
  { rw derived_length_zero at h, rw h, refl, },
  { obtain ⟨h₁, h₂⟩ := (derived_series_of_derived_length_succ R L I k).mp h,
    have h₃ : I ≠ ⊥, { intros contra, apply h₂, rw contra, apply derived_series_of_bot_eq_bot, },
    change derived_series_of_ideal R L k I = ⊥ ↔ I = ⊥,
    split; contradiction, },
end

end lie_algebra


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.group_action.basic
import Mathlib.algebra.group_action_hom
import Mathlib.algebra.module.basic
import Mathlib.PostPort

universes u v l

namespace Mathlib

/-!

# Sets invariant to a `mul_action`

In this file we define `sub_mul_action R M`; a subset of a `mul_action M` which is closed with
respect to scalar multiplication.

For most uses, typically `submodule R M` is more powerful.

## Tags

submodule, mul_action
-/

/-- A sub_mul_action is a set which is closed under scalar multiplication.  -/
structure sub_mul_action (R : Type u) (M : Type v) [has_scalar R M]
where
  carrier : set M
  smul_mem' : ∀ (c : R) {x : M}, x ∈ carrier → c • x ∈ carrier

namespace sub_mul_action

protected instance set.has_coe_t {R : Type u} {M : Type v} [has_scalar R M] : has_coe_t (sub_mul_action R M) (set M) :=
  has_coe_t.mk fun (s : sub_mul_action R M) => carrier s

protected instance has_mem {R : Type u} {M : Type v} [has_scalar R M] : has_mem M (sub_mul_action R M) :=
  has_mem.mk fun (x : M) (p : sub_mul_action R M) => x ∈ ↑p

protected instance has_coe_to_sort {R : Type u} {M : Type v} [has_scalar R M] : has_coe_to_sort (sub_mul_action R M) :=
  has_coe_to_sort.mk (Type (max 0 v)) fun (p : sub_mul_action R M) => Subtype fun (x : M) => x ∈ p

protected instance has_top {R : Type u} {M : Type v} [has_scalar R M] : has_top (sub_mul_action R M) :=
  has_top.mk (mk set.univ sorry)

protected instance has_bot {R : Type u} {M : Type v} [has_scalar R M] : has_bot (sub_mul_action R M) :=
  has_bot.mk (mk ∅ sorry)

protected instance inhabited {R : Type u} {M : Type v} [has_scalar R M] : Inhabited (sub_mul_action R M) :=
  { default := ⊥ }

@[simp] theorem coe_sort_coe {R : Type u} {M : Type v} [has_scalar R M] (p : sub_mul_action R M) : ↥↑p = ↥p :=
  rfl

protected theorem exists {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} {q : ↥p → Prop} : (∃ (x : ↥p), q x) ↔ ∃ (x : M), ∃ (H : x ∈ p), q { val := x, property := H } :=
  set_coe.exists

protected theorem forall {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} {q : ↥p → Prop} : (∀ (x : ↥p), q x) ↔ ∀ (x : M) (H : x ∈ p), q { val := x, property := H } :=
  set_coe.forall

theorem coe_injective {R : Type u} {M : Type v} [has_scalar R M] : function.injective coe := sorry

@[simp] theorem coe_set_eq {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} {q : sub_mul_action R M} : ↑p = ↑q ↔ p = q :=
  function.injective.eq_iff coe_injective

theorem ext'_iff {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} {q : sub_mul_action R M} : p = q ↔ ↑p = ↑q :=
  iff.symm coe_set_eq

theorem ext {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} {q : sub_mul_action R M} (h : ∀ (x : M), x ∈ p ↔ x ∈ q) : p = q :=
  coe_injective (set.ext h)

end sub_mul_action

namespace sub_mul_action

@[simp] theorem mem_coe {R : Type u} {M : Type v} [has_scalar R M] (p : sub_mul_action R M) {x : M} : x ∈ ↑p ↔ x ∈ p :=
  iff.rfl

theorem smul_mem {R : Type u} {M : Type v} [has_scalar R M] (p : sub_mul_action R M) {x : M} (r : R) (h : x ∈ p) : r • x ∈ p :=
  smul_mem' p r h

protected instance has_scalar {R : Type u} {M : Type v} [has_scalar R M] (p : sub_mul_action R M) : has_scalar R ↥p :=
  has_scalar.mk fun (c : R) (x : ↥p) => { val := c • subtype.val x, property := sorry }

@[simp] theorem coe_eq_coe {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} {x : ↥p} {y : ↥p} : ↑x = ↑y ↔ x = y :=
  iff.symm subtype.ext_iff_val

@[simp] theorem coe_smul {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} (r : R) (x : ↥p) : ↑(r • x) = r • ↑x :=
  rfl

@[simp] theorem coe_mk {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} (x : M) (hx : x ∈ p) : ↑{ val := x, property := hx } = x :=
  rfl

@[simp] theorem coe_mem {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} (x : ↥p) : ↑x ∈ p :=
  subtype.property x

@[simp] protected theorem eta {R : Type u} {M : Type v} [has_scalar R M] {p : sub_mul_action R M} (x : ↥p) (hx : ↑x ∈ p) : { val := ↑x, property := hx } = x :=
  subtype.eta x hx

/-- Embedding of a submodule `p` to the ambient space `M`. -/
protected def subtype {R : Type u} {M : Type v} [has_scalar R M] (p : sub_mul_action R M) : mul_action_hom R (↥p) M :=
  mul_action_hom.mk coe sorry

@[simp] theorem subtype_apply {R : Type u} {M : Type v} [has_scalar R M] (p : sub_mul_action R M) (x : ↥p) : coe_fn (sub_mul_action.subtype p) x = ↑x :=
  rfl

theorem subtype_eq_val {R : Type u} {M : Type v} [has_scalar R M] (p : sub_mul_action R M) : ⇑(sub_mul_action.subtype p) = subtype.val :=
  rfl

@[simp] theorem smul_mem_iff' {R : Type u} {M : Type v} [monoid R] [mul_action R M] (p : sub_mul_action R M) {x : M} (u : units R) : ↑u • x ∈ p ↔ x ∈ p := sorry

/-- If the scalar product forms a `mul_action`, then the subset inherits this action -/
protected instance mul_action {R : Type u} {M : Type v} [monoid R] [mul_action R M] (p : sub_mul_action R M) : mul_action R ↥p :=
  mul_action.mk sorry sorry

theorem zero_mem {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (p : sub_mul_action R M) (h : set.nonempty ↑p) : 0 ∈ p := sorry

/-- If the scalar product forms a `semimodule`, and the `sub_mul_action` is not `⊥`, then the
subset inherits the zero. -/
protected instance has_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (p : sub_mul_action R M) [n_empty : Nonempty ↥p] : HasZero ↥p :=
  { zero := { val := 0, property := sorry } }

theorem neg_mem {R : Type u} {M : Type v} [ring R] [add_comm_group M] [semimodule R M] (p : sub_mul_action R M) {x : M} (hx : x ∈ p) : -x ∈ p :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-x ∈ p)) (Eq.symm (neg_one_smul R x)))) (smul_mem p (-1) hx)

@[simp] theorem neg_mem_iff {R : Type u} {M : Type v} [ring R] [add_comm_group M] [semimodule R M] (p : sub_mul_action R M) {x : M} : -x ∈ p ↔ x ∈ p :=
  { mp := fun (h : -x ∈ p) => eq.mpr (id (Eq._oldrec (Eq.refl (x ∈ p)) (Eq.symm (neg_neg x)))) (neg_mem p h),
    mpr := neg_mem p }

protected instance has_neg {R : Type u} {M : Type v} [ring R] [add_comm_group M] [semimodule R M] (p : sub_mul_action R M) : Neg ↥p :=
  { neg := fun (x : ↥p) => { val := -subtype.val x, property := sorry } }

@[simp] theorem coe_neg {R : Type u} {M : Type v} [ring R] [add_comm_group M] [semimodule R M] (p : sub_mul_action R M) (x : ↥p) : ↑(-x) = -↑x :=
  rfl

end sub_mul_action

namespace sub_mul_action

theorem smul_mem_iff {R : Type u} {M : Type v} [division_ring R] [add_comm_group M] [module R M] (p : sub_mul_action R M) {r : R} {x : M} (r0 : r ≠ 0) : r • x ∈ p ↔ x ∈ p :=
  smul_mem_iff' p (units.mk0 r r0)


import condensed.extr.basic
import topology.category.CompHaus.projective

noncomputable theory

open category_theory

namespace ExtrDisc

lemma lift_exists' {X Y : CompHaus} {P : ExtrDisc} (f : X ⟶ Y)
  (hf : function.surjective f) (e : P.val.to_CompHaus ⟶ Y) :
  ∃ g : P.val.to_CompHaus ⟶ X, g ≫ f = e :=
begin
  have : epi f := by rwa CompHaus.epi_iff_surjective f,
  let B : Profinite := Profinite.of (ultrafilter P.val),
  let π : B ⟶ P.val := ⟨_, continuous_ultrafilter_extend id⟩,
  have : epi π,
  { rw Profinite.epi_iff_surjective,
    intro x, refine ⟨(pure x : ultrafilter P.val), _⟩,
    have := @ultrafilter_extend_extends P.val _ _ _ id,
    exact congr_fun this x, },
  resetI,
  choose s hs using projective.factors (𝟙 _) π,
  let φ : CompHaus.of (ultrafilter P.val.to_CompHaus) ⟶ Y := π ≫ e,
  choose g h using projective.factors φ f,
  refine ⟨s ≫ g, _⟩,
  erw [category.assoc, h, ← category.assoc, hs, category.id_comp],
end

def lift' {X Y : CompHaus} {P : ExtrDisc} (f : X ⟶ Y)
  (hf : function.surjective f) (e : P.val.to_CompHaus ⟶ Y) : P.val.to_CompHaus ⟶ X :=
(lift_exists' f hf e).some

@[simp, reassoc]
lemma lift_lifts' {X Y : CompHaus} {P : ExtrDisc} (f : X ⟶ Y)
  (hf : function.surjective f) (e : P.val.to_CompHaus ⟶ Y) :
  lift' f hf e ≫ f = e :=
(lift_exists' f hf e).some_spec

end ExtrDisc


import Smt

theorem resolution (p q r : Bool) : p || q → !p || r → q || r := by
  smt
  intro hpq
  intro hnpr
  cases p <;> cases r <;> simp_all


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

Transitive reflexive as well as reflexive closure of relations.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.basic
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

namespace relation

/--
The composition of two relations, yielding a new relation.  The result
relates a term of `α` and a term of `γ` if there is an intermediate
term of `β` related to both.
-/
def comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} (r : α → β → Prop) (p : β → γ → Prop) (a : α)
    (c : γ) :=
  ∃ (b : β), r a b ∧ p b c

theorem comp_eq {α : Type u_1} {β : Type u_2} {r : α → β → Prop} : comp r Eq = r := sorry

theorem eq_comp {α : Type u_1} {β : Type u_2} {r : α → β → Prop} : comp Eq r = r := sorry

theorem iff_comp {α : Type u_1} {r : Prop → α → Prop} : comp Iff r = r := sorry

theorem comp_iff {α : Type u_1} {r : α → Prop → Prop} : comp r Iff = r := sorry

theorem comp_assoc {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} {r : α → β → Prop}
    {p : β → γ → Prop} {q : γ → δ → Prop} : comp (comp r p) q = comp r (comp p q) :=
  sorry

theorem flip_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : α → β → Prop}
    {p : β → γ → Prop} : flip (comp r p) = comp (flip p) (flip r) :=
  sorry

/--
The map of a relation `r` through a pair of functions pushes the
relation to the codomains of the functions.  The resulting relation is
defined by having pairs of terms related if they have preimages
related by `r`.
-/
protected def map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (r : α → β → Prop)
    (f : α → γ) (g : β → δ) : γ → δ → Prop :=
  fun (c : γ) (d : δ) => ∃ (a : α), ∃ (b : β), r a b ∧ f a = c ∧ g b = d

/-- `refl_trans_gen r`: reflexive transitive closure of `r` -/
inductive refl_trans_gen {α : Type u_1} (r : α → α → Prop) (a : α) : α → Prop where
| refl : refl_trans_gen r a a
| tail : ∀ {b c : α}, refl_trans_gen r a b → r b c → refl_trans_gen r a c

/-- `refl_gen r`: reflexive closure of `r` -/
inductive refl_gen {α : Type u_1} (r : α → α → Prop) (a : α) : α → Prop where
| refl : refl_gen r a a
| single : ∀ {b : α}, r a b → refl_gen r a b

/-- `trans_gen r`: transitive closure of `r` -/
inductive trans_gen {α : Type u_1} (r : α → α → Prop) (a : α) : α → Prop where
| single : ∀ {b : α}, r a b → trans_gen r a b
| tail : ∀ {b c : α}, trans_gen r a b → r b c → trans_gen r a c

theorem refl_gen.to_refl_trans_gen {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} :
    refl_gen r a b → refl_trans_gen r a b :=
  sorry

namespace refl_trans_gen

theorem trans {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α} (hab : refl_trans_gen r a b)
    (hbc : refl_trans_gen r b c) : refl_trans_gen r a c :=
  sorry

theorem single {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} (hab : r a b) :
    refl_trans_gen r a b :=
  tail refl hab

theorem head {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α} (hab : r a b)
    (hbc : refl_trans_gen r b c) : refl_trans_gen r a c :=
  sorry

theorem symmetric {α : Type u_1} {r : α → α → Prop} (h : symmetric r) :
    symmetric (refl_trans_gen r) :=
  sorry

theorem cases_tail {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} :
    refl_trans_gen r a b → b = a ∨ ∃ (c : α), refl_trans_gen r a c ∧ r c b :=
  iff.mp (cases_tail_iff r a b)

theorem head_induction_on {α : Type u_1} {r : α → α → Prop} {b : α}
    {P : (a : α) → refl_trans_gen r a b → Prop} {a : α} (h : refl_trans_gen r a b) (refl : P b refl)
    (head : ∀ {a c : α} (h' : r a c) (h : refl_trans_gen r c b), P c h → P a (head h' h)) : P a h :=
  sorry

theorem trans_induction_on {α : Type u_1} {r : α → α → Prop}
    {P : {a b : α} → refl_trans_gen r a b → Prop} {a : α} {b : α} (h : refl_trans_gen r a b)
    (ih₁ : α → P refl) (ih₂ : ∀ {a b : α} (h : r a b), P (single h))
    (ih₃ :
      ∀ {a b c : α} (h₁ : refl_trans_gen r a b) (h₂ : refl_trans_gen r b c),
        P h₁ → P h₂ → P (trans h₁ h₂)) :
    P h :=
  sorry

theorem cases_head {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} (h : refl_trans_gen r a b) :
    a = b ∨ ∃ (c : α), r a c ∧ refl_trans_gen r c b :=
  sorry

theorem cases_head_iff {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} :
    refl_trans_gen r a b ↔ a = b ∨ ∃ (c : α), r a c ∧ refl_trans_gen r c b :=
  sorry

theorem total_of_right_unique {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α}
    (U : relator.right_unique r) (ab : refl_trans_gen r a b) (ac : refl_trans_gen r a c) :
    refl_trans_gen r b c ∨ refl_trans_gen r c b :=
  sorry

end refl_trans_gen

namespace trans_gen

theorem to_refl {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} (h : trans_gen r a b) :
    refl_trans_gen r a b :=
  trans_gen.drec (fun {b : α} (h : r a b) => refl_trans_gen.single h)
    (fun {b c : α} (h_ᾰ : trans_gen r a b) (bc : r b c) (ab : refl_trans_gen r a b) =>
      refl_trans_gen.tail ab bc)
    h

theorem trans_left {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α} (hab : trans_gen r a b)
    (hbc : refl_trans_gen r b c) : trans_gen r a c :=
  sorry

theorem trans {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α} (hab : trans_gen r a b)
    (hbc : trans_gen r b c) : trans_gen r a c :=
  trans_left hab (to_refl hbc)

theorem head' {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α} (hab : r a b)
    (hbc : refl_trans_gen r b c) : trans_gen r a c :=
  trans_left (single hab) hbc

theorem tail' {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α} (hab : refl_trans_gen r a b)
    (hbc : r b c) : trans_gen r a c :=
  sorry

theorem trans_right {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α}
    (hab : refl_trans_gen r a b) (hbc : trans_gen r b c) : trans_gen r a c :=
  sorry

theorem head {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α} (hab : r a b)
    (hbc : trans_gen r b c) : trans_gen r a c :=
  head' hab (to_refl hbc)

theorem tail'_iff {α : Type u_1} {r : α → α → Prop} {a : α} {c : α} :
    trans_gen r a c ↔ ∃ (b : α), refl_trans_gen r a b ∧ r b c :=
  sorry

theorem head'_iff {α : Type u_1} {r : α → α → Prop} {a : α} {c : α} :
    trans_gen r a c ↔ ∃ (b : α), r a b ∧ refl_trans_gen r b c :=
  sorry

theorem trans_gen_eq_self {α : Type u_1} {r : α → α → Prop} (trans : transitive r) :
    trans_gen r = r :=
  sorry

theorem transitive_trans_gen {α : Type u_1} {r : α → α → Prop} : transitive (trans_gen r) :=
  fun (a b c : α) => trans

theorem trans_gen_idem {α : Type u_1} {r : α → α → Prop} : trans_gen (trans_gen r) = trans_gen r :=
  trans_gen_eq_self transitive_trans_gen

theorem trans_gen_lift {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {p : β → β → Prop} {a : α}
    {b : α} (f : α → β) (h : ∀ (a b : α), r a b → p (f a) (f b)) (hab : trans_gen r a b) :
    trans_gen p (f a) (f b) :=
  sorry

theorem trans_gen_lift' {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {p : β → β → Prop} {a : α}
    {b : α} (f : α → β) (h : ∀ (a b : α), r a b → trans_gen p (f a) (f b)) (hab : trans_gen r a b) :
    trans_gen p (f a) (f b) :=
  eq.mpr (id (Eq.refl (trans_gen p (f a) (f b))))
    (eq.mp (congr_fun (congr_fun trans_gen_idem (f a)) (f b)) (trans_gen_lift f h hab))

theorem trans_gen_closed {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {p : α → α → Prop} :
    (∀ (a b : α), r a b → trans_gen p a b) → trans_gen r a b → trans_gen p a b :=
  trans_gen_lift' id

end trans_gen

theorem refl_trans_gen_iff_eq {α : Type u_1} {r : α → α → Prop} {a : α} {b : α}
    (h : ∀ (b : α), ¬r a b) : refl_trans_gen r a b ↔ b = a :=
  sorry

theorem refl_trans_gen_iff_eq_or_trans_gen {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} :
    refl_trans_gen r a b ↔ b = a ∨ trans_gen r a b :=
  sorry

theorem refl_trans_gen_lift {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {p : β → β → Prop}
    {a : α} {b : α} (f : α → β) (h : ∀ (a b : α), r a b → p (f a) (f b))
    (hab : refl_trans_gen r a b) : refl_trans_gen p (f a) (f b) :=
  refl_trans_gen.trans_induction_on hab (fun (a : α) => refl_trans_gen.refl)
    (fun (a b : α) => refl_trans_gen.single ∘ h a b)
    fun (a b c : α) (_x : refl_trans_gen r a b) (_x : refl_trans_gen r b c) => refl_trans_gen.trans

theorem refl_trans_gen_mono {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {p : α → α → Prop} :
    (∀ (a b : α), r a b → p a b) → refl_trans_gen r a b → refl_trans_gen p a b :=
  refl_trans_gen_lift id

theorem refl_trans_gen_eq_self {α : Type u_1} {r : α → α → Prop} (refl : reflexive r)
    (trans : transitive r) : refl_trans_gen r = r :=
  sorry

theorem reflexive_refl_trans_gen {α : Type u_1} {r : α → α → Prop} : reflexive (refl_trans_gen r) :=
  fun (a : α) => refl_trans_gen.refl

theorem transitive_refl_trans_gen {α : Type u_1} {r : α → α → Prop} :
    transitive (refl_trans_gen r) :=
  fun (a b c : α) => refl_trans_gen.trans

theorem refl_trans_gen_idem {α : Type u_1} {r : α → α → Prop} :
    refl_trans_gen (refl_trans_gen r) = refl_trans_gen r :=
  refl_trans_gen_eq_self reflexive_refl_trans_gen transitive_refl_trans_gen

theorem refl_trans_gen_lift' {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {p : β → β → Prop}
    {a : α} {b : α} (f : α → β) (h : ∀ (a b : α), r a b → refl_trans_gen p (f a) (f b))
    (hab : refl_trans_gen r a b) : refl_trans_gen p (f a) (f b) :=
  eq.mpr (id (Eq.refl (refl_trans_gen p (f a) (f b))))
    (eq.mp (congr_fun (congr_fun refl_trans_gen_idem (f a)) (f b)) (refl_trans_gen_lift f h hab))

theorem refl_trans_gen_closed {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {p : α → α → Prop} :
    (∀ (a b : α), r a b → refl_trans_gen p a b) → refl_trans_gen r a b → refl_trans_gen p a b :=
  refl_trans_gen_lift' id

/--
The join of a relation on a single type is a new relation for which
pairs of terms are related if there is a third term they are both
related to.  For example, if `r` is a relation representing rewrites
in a term rewriting system, then *confluence* is the property that if
`a` rewrites to both `b` and `c`, then `join r` relates `b` and `c`
(see `relation.church_rosser`).
-/
def join {α : Type u_1} (r : α → α → Prop) : α → α → Prop :=
  fun (a b : α) => ∃ (c : α), r a c ∧ r b c

theorem church_rosser {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {c : α}
    (h : ∀ (a b c : α), r a b → r a c → ∃ (d : α), refl_gen r b d ∧ refl_trans_gen r c d)
    (hab : refl_trans_gen r a b) (hac : refl_trans_gen r a c) : join (refl_trans_gen r) b c :=
  sorry

theorem join_of_single {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} (h : reflexive r)
    (hab : r a b) : join r a b :=
  Exists.intro b { left := hab, right := h b }

theorem symmetric_join {α : Type u_1} {r : α → α → Prop} : symmetric (join r) := sorry

theorem reflexive_join {α : Type u_1} {r : α → α → Prop} (h : reflexive r) : reflexive (join r) :=
  fun (a : α) => Exists.intro a { left := h a, right := h a }

theorem transitive_join {α : Type u_1} {r : α → α → Prop} (ht : transitive r)
    (h : ∀ (a b c : α), r a b → r a c → join r b c) : transitive (join r) :=
  sorry

theorem equivalence_join {α : Type u_1} {r : α → α → Prop} (hr : reflexive r) (ht : transitive r)
    (h : ∀ (a b c : α), r a b → r a c → join r b c) : equivalence (join r) :=
  { left := reflexive_join hr, right := { left := symmetric_join, right := transitive_join ht h } }

theorem equivalence_join_refl_trans_gen {α : Type u_1} {r : α → α → Prop}
    (h : ∀ (a b c : α), r a b → r a c → ∃ (d : α), refl_gen r b d ∧ refl_trans_gen r c d) :
    equivalence (join (refl_trans_gen r)) :=
  equivalence_join reflexive_refl_trans_gen transitive_refl_trans_gen
    fun (a b c : α) => church_rosser h

theorem join_of_equivalence {α : Type u_1} {r : α → α → Prop} {a : α} {b : α} {r' : α → α → Prop}
    (hr : equivalence r) (h : ∀ (a b : α), r' a b → r a b) : join r' a b → r a b :=
  sorry

theorem refl_trans_gen_of_transitive_reflexive {α : Type u_1} {r : α → α → Prop} {a : α} {b : α}
    {r' : α → α → Prop} (hr : reflexive r) (ht : transitive r) (h : ∀ (a b : α), r' a b → r a b)
    (h' : refl_trans_gen r' a b) : r a b :=
  refl_trans_gen.drec (hr a)
    (fun {b c : α} (hab : refl_trans_gen r' a b) (hbc : r' b c) (ih : r a b) => ht ih (h b c hbc))
    h'

theorem refl_trans_gen_of_equivalence {α : Type u_1} {r : α → α → Prop} {a : α} {b : α}
    {r' : α → α → Prop} (hr : equivalence r) :
    (∀ (a b : α), r' a b → r a b) → refl_trans_gen r' a b → r a b :=
  refl_trans_gen_of_transitive_reflexive (and.left hr) (and.right (and.right hr))

theorem eqv_gen_iff_of_equivalence {α : Type u_1} {r : α → α → Prop} {a : α} {b : α}
    (h : equivalence r) : eqv_gen r a b ↔ r a b :=
  sorry

theorem eqv_gen_mono {α : Type u_1} {a : α} {b : α} {r : α → α → Prop} {p : α → α → Prop}
    (hrp : ∀ (a b : α), r a b → p a b) (h : eqv_gen r a b) : eqv_gen p a b :=
  sorry

end Mathlib