/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module data.rbtree.insert
! leanprover-community/mathlib commit 4d4167104581a21259f7f448e1972a63a4546be7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Rbtree.Find

universe u v

attribute [local simp] Rbnode.Lift

namespace Rbnode

variable {α : Type u}

open Color

@[simp]
theorem balance1_eq₁ (l : Rbnode α) (x r₁ y r₂ v t) :
    balance1 (red_node l x r₁) y r₂ v t = red_node (black_node l x r₁) y (black_node r₂ v t) := by
  cases r₂ <;> rfl
#align rbnode.balance1_eq₁ Rbnode.balance1_eq₁

@[simp]
theorem balance1_eq₂ (l₁ : Rbnode α) (y l₂ x r v t) :
    getColor l₁ ≠ red →
      balance1 l₁ y (red_node l₂ x r) v t = red_node (black_node l₁ y l₂) x (black_node r v t) :=
  by cases l₁ <;> simp [get_color, balance1, false_imp_iff]
#align rbnode.balance1_eq₂ Rbnode.balance1_eq₂

@[simp]
theorem balance1_eq₃ (l : Rbnode α) (y r v t) :
    getColor l ≠ red → getColor r ≠ red → balance1 l y r v t = black_node (red_node l y r) v t := by
  cases l <;> cases r <;> simp [get_color, balance1, false_imp_iff]
#align rbnode.balance1_eq₃ Rbnode.balance1_eq₃

@[simp]
theorem balance2_eq₁ (l : Rbnode α) (x₁ r₁ y r₂ v t) :
    balance2 (red_node l x₁ r₁) y r₂ v t = red_node (black_node t v l) x₁ (black_node r₁ y r₂) := by
  cases r₂ <;> rfl
#align rbnode.balance2_eq₁ Rbnode.balance2_eq₁

@[simp]
theorem balance2_eq₂ (l₁ : Rbnode α) (y l₂ x₂ r₂ v t) :
    getColor l₁ ≠ red →
      balance2 l₁ y (red_node l₂ x₂ r₂) v t =
        red_node (black_node t v l₁) y (black_node l₂ x₂ r₂) :=
  by cases l₁ <;> simp [get_color, balance2, false_imp_iff]
#align rbnode.balance2_eq₂ Rbnode.balance2_eq₂

@[simp]
theorem balance2_eq₃ (l : Rbnode α) (y r v t) :
    getColor l ≠ red → getColor r ≠ red → balance2 l y r v t = black_node t v (red_node l y r) := by
  cases l <;> cases r <;> simp [get_color, balance2, false_imp_iff]
#align rbnode.balance2_eq₃ Rbnode.balance2_eq₃

-- We can use the same induction principle for balance1 and balance2
theorem Balance.cases {p : Rbnode α → α → Rbnode α → Prop} (l y r)
    (red_left : ∀ l x r₁ y r₂, p (red_node l x r₁) y r₂)
    (red_right : ∀ l₁ y l₂ x r, getColor l₁ ≠ red → p l₁ y (red_node l₂ x r))
    (other : ∀ l y r, getColor l ≠ red → getColor r ≠ red → p l y r) : p l y r :=
  by
  cases l <;> cases r
  any_goals apply red_left
  any_goals apply red_right <;> simp [get_color] <;> contradiction <;> done
  any_goals apply other <;> simp [get_color] <;> contradiction <;> done
#align rbnode.balance.cases Rbnode.Balance.cases

theorem balance1_ne_leaf (l : Rbnode α) (x r v t) : balance1 l x r v t ≠ leaf := by
  apply balance.cases l x r <;> intros <;> simp [*] <;> contradiction
#align rbnode.balance1_ne_leaf Rbnode.balance1_ne_leaf

theorem balance1Node_ne_leaf {s : Rbnode α} (a : α) (t : Rbnode α) :
    s ≠ leaf → balance1Node s a t ≠ leaf := by
  intro h; cases s
  · contradiction
  all_goals simp [balance1_node]; apply balance1_ne_leaf
#align rbnode.balance1_node_ne_leaf Rbnode.balance1Node_ne_leaf

theorem balance2_ne_leaf (l : Rbnode α) (x r v t) : balance2 l x r v t ≠ leaf := by
  apply balance.cases l x r <;> intros <;> simp [*] <;> contradiction
#align rbnode.balance2_ne_leaf Rbnode.balance2_ne_leaf

theorem balance2Node_ne_leaf {s : Rbnode α} (a : α) (t : Rbnode α) :
    s ≠ leaf → balance2Node s a t ≠ leaf := by
  intro h; cases s
  · contradiction
  all_goals simp [balance2_node]; apply balance2_ne_leaf
#align rbnode.balance2_node_ne_leaf Rbnode.balance2Node_ne_leaf

variable (lt : α → α → Prop)

@[elab_as_elim]
theorem ins.induction [DecidableRel lt] {p : Rbnode α → Prop} (t x) (is_leaf : p leaf)
    (is_red_lt : ∀ (a y b) (hc : cmpUsing lt x y = Ordering.lt) (ih : p a), p (red_node a y b))
    (is_red_eq : ∀ (a y b) (hc : cmpUsing lt x y = Ordering.eq), p (red_node a y b))
    (is_red_gt : ∀ (a y b) (hc : cmpUsing lt x y = Ordering.gt) (ih : p b), p (red_node a y b))
    (is_black_lt_red :
      ∀ (a y b) (hc : cmpUsing lt x y = Ordering.lt) (hr : getColor a = red) (ih : p a),
        p (black_node a y b))
    (is_black_lt_not_red :
      ∀ (a y b) (hc : cmpUsing lt x y = Ordering.lt) (hnr : getColor a ≠ red) (ih : p a),
        p (black_node a y b))
    (is_black_eq : ∀ (a y b) (hc : cmpUsing lt x y = Ordering.eq), p (black_node a y b))
    (is_black_gt_red :
      ∀ (a y b) (hc : cmpUsing lt x y = Ordering.gt) (hr : getColor b = red) (ih : p b),
        p (black_node a y b))
    (is_black_gt_not_red :
      ∀ (a y b) (hc : cmpUsing lt x y = Ordering.gt) (hnr : getColor b ≠ red) (ih : p b),
        p (black_node a y b)) :
    p t := by
  induction t
  case leaf => apply is_leaf
  case red_node a y b =>
    cases h : cmpUsing lt x y
    case lt => apply is_red_lt <;> assumption
    case eq => apply is_red_eq <;> assumption
    case gt => apply is_red_gt <;> assumption
  case black_node a y b =>
    cases h : cmpUsing lt x y
    case lt =>
      by_cases get_color a = red
      · apply is_black_lt_red <;> assumption
      · apply is_black_lt_not_red <;> assumption
    case eq => apply is_black_eq <;> assumption
    case gt =>
      by_cases get_color b = red
      · apply is_black_gt_red <;> assumption
      · apply is_black_gt_not_red <;> assumption
#align rbnode.ins.induction Rbnode.ins.induction

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem isSearchable_balance1 {l y r v t lo hi} :
    IsSearchable lt l lo (some y) →
      IsSearchable lt r (some y) (some v) →
        IsSearchable lt t (some v) hi → IsSearchable lt (balance1 l y r v t) lo hi :=
  by
  apply balance.cases l y r <;> intros <;> simp [*] <;>
    run_tac
      is_searchable_tactic
#align rbnode.is_searchable_balance1 Rbnode.isSearchable_balance1

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem isSearchable_balance1Node {t} [IsTrans α lt] :
    ∀ {y s lo hi},
      IsSearchable lt t lo (some y) →
        IsSearchable lt s (some y) hi → IsSearchable lt (balance1Node t y s) lo hi :=
  by
  cases t <;> simp! <;> intros <;>
    run_tac
      is_searchable_tactic
  · cases lo
    · apply is_searchable_none_low_of_is_searchable_some_low
      assumption
    · simp at *
      apply is_searchable_some_low_of_is_searchable_of_lt <;> assumption
  all_goals apply is_searchable_balance1 <;> assumption
#align rbnode.is_searchable_balance1_node Rbnode.isSearchable_balance1Node

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem isSearchable_balance2 {l y r v t lo hi} :
    IsSearchable lt t lo (some v) →
      IsSearchable lt l (some v) (some y) →
        IsSearchable lt r (some y) hi → IsSearchable lt (balance2 l y r v t) lo hi :=
  by
  apply balance.cases l y r <;> intros <;> simp [*] <;>
    run_tac
      is_searchable_tactic
#align rbnode.is_searchable_balance2 Rbnode.isSearchable_balance2

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem isSearchable_balance2Node {t} [IsTrans α lt] :
    ∀ {y s lo hi},
      IsSearchable lt s lo (some y) →
        IsSearchable lt t (some y) hi → IsSearchable lt (balance2Node t y s) lo hi :=
  by
  induction t <;> simp! <;> intros <;>
    run_tac
      is_searchable_tactic
  · cases hi
    · apply is_searchable_none_high_of_is_searchable_some_high
      assumption
    · simp at *
      apply is_searchable_some_high_of_is_searchable_of_lt
      assumption'
  all_goals apply is_searchable_balance2; assumption'
#align rbnode.is_searchable_balance2_node Rbnode.isSearchable_balance2Node

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem isSearchable_ins [DecidableRel lt] {t x} [IsStrictWeakOrder α lt] :
    ∀ {lo hi} (h : IsSearchable lt t lo hi),
      Lift lt lo (some x) → Lift lt (some x) hi → IsSearchable lt (ins lt t x) lo hi :=
  by
  apply ins.induction lt t x <;> intros <;> simp_all! (config := { eta := false }) <;>
    run_tac
      is_searchable_tactic
  · apply ih h_hs₁
    assumption
    simp [*]
  · apply is_searchable_of_is_searchable_of_incomp hc
    assumption
  · apply is_searchable_of_incomp_of_is_searchable hc
    assumption
  · apply ih h_hs₂
    cases hi <;> simp [*]
    assumption
  · apply is_searchable_balance1_node
    apply ih h_hs₁
    assumption
    simp [*]
    assumption
  · apply ih h_hs₁
    assumption
    simp [*]
  · apply is_searchable_of_is_searchable_of_incomp hc
    assumption
  · apply is_searchable_of_incomp_of_is_searchable hc
    assumption
  · apply is_searchable_balance2_node
    assumption
    apply ih h_hs₂
    simp [*]
    assumption
  · apply ih h_hs₂
    assumption
    simp [*]
#align rbnode.is_searchable_ins Rbnode.isSearchable_ins

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem isSearchable_mkInsertResult {c t} :
    IsSearchable lt t none none → IsSearchable lt (mkInsertResult c t) none none := by
  classical
    cases c <;> cases t <;> simp [mk_insert_result]
    · intro h
      run_tac
        is_searchable_tactic
#align rbnode.is_searchable_mk_insert_result Rbnode.isSearchable_mkInsertResult

theorem isSearchable_insert [DecidableRel lt] {t x} [IsStrictWeakOrder α lt] :
    IsSearchable lt t none none → IsSearchable lt (insert lt t x) none none := by intro h;
  simp [insert]; apply is_searchable_mk_insert_result;
  apply is_searchable_ins <;> · first |assumption|simp
#align rbnode.is_searchable_insert Rbnode.isSearchable_insert

end Rbnode

namespace Rbnode

section MembershipLemmas

parameter {α : Type u}(lt : α → α → Prop)

attribute [local simp] mem balance1_node balance2_node

-- mathport name: mem
local infixl:0 " ∈ " => Mem lt

theorem mem_balance1Node_of_mem_left {x s} (v) (t : Rbnode α) :
    (x ∈ s) → (x ∈ balance1Node s v t) :=
  by
  cases s <;> simp [false_imp_iff]
  all_goals
    apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp at * <;> cases_type*or.1 <;>
      simp [*]
#align rbnode.mem_balance1_node_of_mem_left Rbnode.mem_balance1Node_of_mem_left

theorem mem_balance2Node_of_mem_left {x s} (v) (t : Rbnode α) :
    (x ∈ s) → (x ∈ balance2Node s v t) :=
  by
  cases s <;> simp [false_imp_iff]
  all_goals
    apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp at * <;> cases_type*or.1 <;>
      simp [*]
#align rbnode.mem_balance2_node_of_mem_left Rbnode.mem_balance2Node_of_mem_left

theorem mem_balance1Node_of_mem_right {x t} (v) (s : Rbnode α) :
    (x ∈ t) → (x ∈ balance1Node s v t) := by
  intros ; cases s <;> simp [*]
  all_goals apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp [*]
#align rbnode.mem_balance1_node_of_mem_right Rbnode.mem_balance1Node_of_mem_right

theorem mem_balance2Node_of_mem_right {x t} (v) (s : Rbnode α) :
    (x ∈ t) → (x ∈ balance2Node s v t) := by
  intros ; cases s <;> simp [*]
  all_goals apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp [*]
#align rbnode.mem_balance2_node_of_mem_right Rbnode.mem_balance2Node_of_mem_right

theorem mem_balance1Node_of_incomp {x v} (s t) :
    ¬lt x v ∧ ¬lt v x → s ≠ leaf → (x ∈ balance1Node s v t) :=
  by
  intros ; cases s <;> simp
  · contradiction
  all_goals apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp [*]
#align rbnode.mem_balance1_node_of_incomp Rbnode.mem_balance1Node_of_incomp

theorem mem_balance2Node_of_incomp {x v} (s t) :
    ¬lt v x ∧ ¬lt x v → s ≠ leaf → (x ∈ balance2Node s v t) :=
  by
  intros ; cases s <;> simp
  · contradiction
  all_goals apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp [*]
#align rbnode.mem_balance2_node_of_incomp Rbnode.mem_balance2Node_of_incomp

theorem ins_ne_leaf [DecidableRel lt] (t : Rbnode α) (x : α) : t.ins lt x ≠ leaf :=
  by
  apply ins.induction lt t x
  any_goals intros ; simp [ins, *]
  · intros
    apply balance1_node_ne_leaf
    assumption
  · intros
    apply balance2_node_ne_leaf
    assumption
#align rbnode.ins_ne_leaf Rbnode.ins_ne_leaf

theorem insert_ne_leaf [DecidableRel lt] (t : Rbnode α) (x : α) : insert lt t x ≠ leaf :=
  by
  simp [insert]
  cases he : ins lt t x <;> cases get_color t <;> simp [mk_insert_result]
  · have := ins_ne_leaf lt t x
    contradiction
  · exact absurd he (ins_ne_leaf _ _ _)
#align rbnode.insert_ne_leaf Rbnode.insert_ne_leaf

theorem mem_ins_of_incomp [DecidableRel lt] (t : Rbnode α) {x y : α} :
    ∀ h : ¬lt x y ∧ ¬lt y x, x ∈ t.ins lt y :=
  by
  apply ins.induction lt t y <;> intros <;> simp [ins, *]
  · have := ih h
    apply mem_balance1_node_of_mem_left
    assumption
  · have := ih h
    apply mem_balance2_node_of_mem_left
    assumption
#align rbnode.mem_ins_of_incomp Rbnode.mem_ins_of_incomp

theorem mem_ins_of_mem [DecidableRel lt] [IsStrictWeakOrder α lt] {t : Rbnode α} (z : α) :
    ∀ {x} (h : x ∈ t), x ∈ t.ins lt z :=
  by
  apply ins.induction lt t z <;> intros <;> simp_all [ins] <;> try contradiction <;> cases_type*or.1
  any_goals intros ; simp [h]; done
  any_goals intros ; simp [ih h]; done
  · have := incomp_trans_of lt h ⟨hc.2, hc.1⟩
    simp [this]
  · apply mem_balance1_node_of_mem_left
    apply ih h
  · apply mem_balance1_node_of_incomp
    cases h
    all_goals simp [*, ins_ne_leaf lt a z]
  · apply mem_balance1_node_of_mem_right
    assumption
  · have := incomp_trans_of lt hc ⟨h.2, h.1⟩
    simp [this]
  · apply mem_balance2_node_of_mem_right
    assumption
  · have := ins_ne_leaf lt a z
    apply mem_balance2_node_of_incomp
    cases h
    simp [*]
    apply ins_ne_leaf
  · apply mem_balance2_node_of_mem_left
    apply ih h
#align rbnode.mem_ins_of_mem Rbnode.mem_ins_of_mem

theorem mem_mkInsertResult {a t} (c) : Mem lt a t → Mem lt a (mkInsertResult c t) := by
  intros <;> cases c <;> cases t <;> simp_all [mk_insert_result, mem]
#align rbnode.mem_mk_insert_result Rbnode.mem_mkInsertResult

theorem mem_of_mem_mkInsertResult {a t c} : Mem lt a (mkInsertResult c t) → Mem lt a t := by
  cases t <;> cases c <;> simp [mk_insert_result, mem] <;> intros <;> assumption
#align rbnode.mem_of_mem_mk_insert_result Rbnode.mem_of_mem_mkInsertResult

theorem mem_insert_of_incomp [DecidableRel lt] (t : Rbnode α) {x y : α} :
    ∀ h : ¬lt x y ∧ ¬lt y x, x ∈ t.insert lt y := by
  intros <;> unfold insert <;> apply mem_mk_insert_result <;> apply mem_ins_of_incomp <;> assumption
#align rbnode.mem_insert_of_incomp Rbnode.mem_insert_of_incomp

theorem mem_insert_of_mem [DecidableRel lt] [IsStrictWeakOrder α lt] {t x} (z) :
    (x ∈ t) → (x ∈ t.insert lt z) := by
  intros <;> apply mem_mk_insert_result <;> apply mem_ins_of_mem <;> assumption
#align rbnode.mem_insert_of_mem Rbnode.mem_insert_of_mem

theorem of_mem_balance1Node {x s v t} :
    (x ∈ balance1Node s v t) → (x ∈ s) ∨ ¬lt x v ∧ ¬lt v x ∨ (x ∈ t) :=
  by
  cases s <;> simp
  · intros
    simp [*]
  all_goals
    apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp_all <;> cases_type*or.1 <;>
      simp [*]
#align rbnode.of_mem_balance1_node Rbnode.of_mem_balance1Node

theorem of_mem_balance2Node {x s v t} :
    (x ∈ balance2Node s v t) → (x ∈ s) ∨ ¬lt x v ∧ ¬lt v x ∨ (x ∈ t) :=
  by
  cases s <;> simp
  · intros
    simp [*]
  all_goals
    apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp_all <;> cases_type*or.1 <;>
      simp [*]
#align rbnode.of_mem_balance2_node Rbnode.of_mem_balance2Node

theorem equiv_or_mem_of_mem_ins [DecidableRel lt] {t : Rbnode α} {x z} :
    ∀ h : x ∈ t.ins lt z, x ≈[lt]z ∨ (x ∈ t) :=
  by
  apply ins.induction lt t z <;> intros <;> simp_all [ins, StrictWeakOrder.Equiv] <;>
    cases_type*or.1
  any_goals intros ; simp [h]
  any_goals intros ; have ih := ih h; cases ih <;> simp [*]; done
  · have h' := of_mem_balance1_node lt h
    cases_type*or.1
    have := ih h'
    cases_type*or.1
    all_goals simp [h, *]
  · have h' := of_mem_balance2_node lt h
    cases_type*or.1
    have := ih h'
    cases_type*or.1
    all_goals simp [h, *]
#align rbnode.equiv_or_mem_of_mem_ins Rbnode.equiv_or_mem_of_mem_ins

theorem equiv_or_mem_of_mem_insert [DecidableRel lt] {t : Rbnode α} {x z} :
    ∀ h : x ∈ t.insert lt z, x ≈[lt]z ∨ (x ∈ t) := by simp [insert]; intros ;
  apply equiv_or_mem_of_mem_ins; exact mem_of_mem_mk_insert_result lt h
#align rbnode.equiv_or_mem_of_mem_insert Rbnode.equiv_or_mem_of_mem_insert

attribute [local simp] mem_exact

theorem memExact_balance1Node_of_memExact {x s} (v) (t : Rbnode α) :
    MemExact x s → MemExact x (balance1Node s v t) :=
  by
  cases s <;> simp [false_imp_iff]
  all_goals
    apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp_all <;> cases_type*or.1 <;>
      simp [*]
#align rbnode.mem_exact_balance1_node_of_mem_exact Rbnode.memExact_balance1Node_of_memExact

theorem memExact_balance2Node_of_memExact {x s} (v) (t : Rbnode α) :
    MemExact x s → MemExact x (balance2Node s v t) :=
  by
  cases s <;> simp [false_imp_iff]
  all_goals
    apply balance.cases s_lchild s_val s_rchild <;> intros <;> simp_all <;> cases_type*or.1 <;>
      simp [*]
#align rbnode.mem_exact_balance2_node_of_mem_exact Rbnode.memExact_balance2Node_of_memExact

theorem find_balance1Node [DecidableRel lt] [IsStrictWeakOrder α lt] {x y z t s} :
    ∀ {lo hi},
      IsSearchable lt t lo (some z) →
        IsSearchable lt s (some z) hi →
          find lt t y = some x → y ≈[lt]x → find lt (balance1Node t z s) y = some x :=
  by
  intro _ _ hs₁ hs₂ heq heqv
  have hs := is_searchable_balance1_node lt hs₁ hs₂
  have := Eq.trans (find_eq_find_of_eqv hs₁ heqv.symm) HEq
  have := Iff.mpr (find_correct_exact hs₁) this
  have := mem_exact_balance1_node_of_mem_exact z s this
  have := Iff.mp (find_correct_exact hs) this
  exact Eq.trans (find_eq_find_of_eqv hs heqv) this
#align rbnode.find_balance1_node Rbnode.find_balance1Node

theorem find_balance2Node [DecidableRel lt] [IsStrictWeakOrder α lt] {x y z s t} [IsTrans α lt] :
    ∀ {lo hi},
      IsSearchable lt s lo (some z) →
        IsSearchable lt t (some z) hi →
          find lt t y = some x → y ≈[lt]x → find lt (balance2Node t z s) y = some x :=
  by
  intro _ _ hs₁ hs₂ heq heqv
  have hs := is_searchable_balance2_node lt hs₁ hs₂
  have := Eq.trans (find_eq_find_of_eqv hs₂ heqv.symm) HEq
  have := Iff.mpr (find_correct_exact hs₂) this
  have := mem_exact_balance2_node_of_mem_exact z s this
  have := Iff.mp (find_correct_exact hs) this
  exact Eq.trans (find_eq_find_of_eqv hs heqv) this
#align rbnode.find_balance2_node Rbnode.find_balance2Node

-- Auxiliary lemma
theorem ite_eq_of_not_lt [DecidableRel lt] [IsStrictOrder α lt] {a b} {β : Type v} (t s : β)
    (h : lt b a) : (if lt a b then t else s) = s := by have := not_lt_of_lt h; simp [*]
#align rbnode.ite_eq_of_not_lt Rbnode.ite_eq_of_not_lt

attribute [local simp] ite_eq_of_not_lt

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
private unsafe def simp_fi : tactic Unit :=
  sorry
#align rbnode.simp_fi rbnode.simp_fi

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
theorem find_ins_of_eqv [DecidableRel lt] [IsStrictWeakOrder α lt] {x y : α} {t : Rbnode α}
    (he : x ≈[lt]y) :
    ∀ {lo hi} (hs : IsSearchable lt t lo hi) (hlt₁ : Lift lt lo (some x))
      (hlt₂ : Lift lt (some x) hi), find lt (ins lt t x) y = some x :=
  by
  simp [StrictWeakOrder.Equiv] at he
  apply ins.induction lt t x <;> intros
  ·
    run_tac
      simp_fi
  all_goals simp at hc; cases hs
  · have := lt_of_incomp_of_lt he.swap hc
    have := ih hs_hs₁ hlt₁ hc
    run_tac
      simp_fi
  ·
    run_tac
      simp_fi
  · have := lt_of_lt_of_incomp hc he
    have := ih hs_hs₂ hc hlt₂
    run_tac
      simp_fi
  · run_tac
      simp_fi
    have := is_searchable_ins lt hs_hs₁ hlt₁ hc
    apply find_balance1_node lt this hs_hs₂ (ih hs_hs₁ hlt₁ hc) he.symm
  · have := lt_of_incomp_of_lt he.swap hc
    have := ih hs_hs₁ hlt₁ hc
    run_tac
      simp_fi
  ·
    run_tac
      simp_fi
  · run_tac
      simp_fi
    have := is_searchable_ins lt hs_hs₂ hc hlt₂
    apply find_balance2_node lt hs_hs₁ this (ih hs_hs₂ hc hlt₂) he.symm
  · have := lt_of_lt_of_incomp hc he
    have := ih hs_hs₂ hc hlt₂
    run_tac
      simp_fi
#align rbnode.find_ins_of_eqv Rbnode.find_ins_of_eqv

theorem find_mkInsertResult [DecidableRel lt] (c : Color) (t : Rbnode α) (x : α) :
    find lt (mkInsertResult c t) x = find lt t x :=
  by
  cases t <;> cases c <;> simp [mk_insert_result]
  · simp [find]
    cases cmpUsing lt x t_val <;> simp [find]
#align rbnode.find_mk_insert_result Rbnode.find_mkInsertResult

theorem find_insert_of_eqv [DecidableRel lt] [IsStrictWeakOrder α lt] {x y : α} {t : Rbnode α}
    (he : x ≈[lt]y) : IsSearchable lt t none none → find lt (insert lt t x) y = some x :=
  by
  intro hs
  simp [insert, find_mk_insert_result]
  apply find_ins_of_eqv lt he hs <;> simp
#align rbnode.find_insert_of_eqv Rbnode.find_insert_of_eqv

theorem weak_trichotomous (x y) {p : Prop} (is_lt : ∀ h : lt x y, p)
    (is_eqv : ∀ h : ¬lt x y ∧ ¬lt y x, p) (is_gt : ∀ h : lt y x, p) : p :=
  by
  by_cases lt x y
  · apply is_lt
    assumption
  by_cases lt y x
  · apply is_gt
    assumption
  · apply is_eqv
    constructor <;> assumption
#align rbnode.weak_trichotomous Rbnode.weak_trichotomous

section FindInsOfNotEqv

section SimpAuxLemmas

theorem find_black_eq_find_red [DecidableRel lt] {l y r x} :
    find lt (black_node l y r) x = find lt (red_node l y r) x := by simp [find];
  all_goals cases cmpUsing lt x y <;> simp [find]
#align rbnode.find_black_eq_find_red Rbnode.find_black_eq_find_red

theorem find_red_of_lt [DecidableRel lt] {l y r x} (h : lt x y) :
    find lt (red_node l y r) x = find lt l x := by simp [find, cmpUsing, *]
#align rbnode.find_red_of_lt Rbnode.find_red_of_lt

theorem find_red_of_gt [DecidableRel lt] [IsStrictOrder α lt] {l y r x} (h : lt y x) :
    find lt (red_node l y r) x = find lt r x := by have := not_lt_of_lt h; simp [find, cmpUsing, *]
#align rbnode.find_red_of_gt Rbnode.find_red_of_gt

theorem find_red_of_incomp [DecidableRel lt] {l y r x} (h : ¬lt x y ∧ ¬lt y x) :
    find lt (red_node l y r) x = some y := by simp [find, cmpUsing, *]
#align rbnode.find_red_of_incomp Rbnode.find_red_of_incomp

end SimpAuxLemmas

attribute [local simp]
  find_black_eq_find_red find_red_of_lt find_red_of_lt find_red_of_gt find_red_of_incomp

variable [IsStrictWeakOrder α lt] [DecidableRel lt]

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem find_balance1_lt {l r t v x y lo hi} (h : lt x y) (hl : IsSearchable lt l lo (some v))
    (hr : IsSearchable lt r (some v) (some y)) (ht : IsSearchable lt t (some y) hi) :
    find lt (balance1 l v r y t) x = find lt (red_node l v r) x :=
  by
  revert hl hr ht;
  apply balance.cases l v r <;> intros <;> simp [*] <;>
    run_tac
      is_searchable_tactic
  · apply weak_trichotomous lt y_1 x <;> intros <;> simp [*]
  · apply weak_trichotomous lt x_1 x <;> intro h'
    · have := trans_of lt (lo_lt_hi hr_hs₁) h'
      simp [*]
    · have : lt y_1 x := lt_of_lt_of_incomp (lo_lt_hi hr_hs₁) h'
      simp [*]
    · apply weak_trichotomous lt y_1 x <;> intros <;> simp [*]
#align rbnode.find_balance1_lt Rbnode.find_balance1_lt

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
unsafe def ins_ne_leaf_tac :=
  sorry
#align rbnode.ins_ne_leaf_tac rbnode.ins_ne_leaf_tac

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic ins_ne_leaf_tac -/
theorem find_balance1Node_lt {t s x y lo hi} (hlt : lt y x) (ht : IsSearchable lt t lo (some x))
    (hs : IsSearchable lt s (some x) hi)
    (hne : t ≠ leaf := by
      run_tac
        ins_ne_leaf_tac) :
    find lt (balance1Node t x s) y = find lt t y :=
  by
  cases t <;> simp [balance1_node]
  · contradiction
  all_goals intros ;
    run_tac
      is_searchable_tactic;
    apply find_balance1_lt; assumption'
#align rbnode.find_balance1_node_lt Rbnode.find_balance1Node_lt

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem find_balance1_gt {l r t v x y lo hi} (h : lt y x) (hl : IsSearchable lt l lo (some v))
    (hr : IsSearchable lt r (some v) (some y)) (ht : IsSearchable lt t (some y) hi) :
    find lt (balance1 l v r y t) x = find lt t x :=
  by
  revert hl hr ht;
  apply balance.cases l v r <;> intros <;> simp [*] <;>
    run_tac
      is_searchable_tactic
  · have := trans_of lt (lo_lt_hi hr) h
    simp [*]
  · have := trans_of lt (lo_lt_hi hr_hs₂) h
    simp [*]
#align rbnode.find_balance1_gt Rbnode.find_balance1_gt

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic ins_ne_leaf_tac -/
theorem find_balance1Node_gt {t s x y lo hi} (h : lt x y) (ht : IsSearchable lt t lo (some x))
    (hs : IsSearchable lt s (some x) hi)
    (hne : t ≠ leaf := by
      run_tac
        ins_ne_leaf_tac) :
    find lt (balance1Node t x s) y = find lt s y :=
  by
  cases t <;> simp [balance1_node]
  all_goals intros ;
    run_tac
      is_searchable_tactic;
    apply find_balance1_gt; assumption'
#align rbnode.find_balance1_node_gt Rbnode.find_balance1Node_gt

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem find_balance1_eqv {l r t v x y lo hi} (h : ¬lt x y ∧ ¬lt y x)
    (hl : IsSearchable lt l lo (some v)) (hr : IsSearchable lt r (some v) (some y))
    (ht : IsSearchable lt t (some y) hi) : find lt (balance1 l v r y t) x = some y :=
  by
  revert hl hr ht;
  apply balance.cases l v r <;> intros <;> simp [*] <;>
    run_tac
      is_searchable_tactic
  · have : lt y_1 x := lt_of_lt_of_incomp (lo_lt_hi hr) h.swap
    simp [*]
  · have : lt x_1 x := lt_of_lt_of_incomp (lo_lt_hi hr_hs₂) h.swap
    simp [*]
#align rbnode.find_balance1_eqv Rbnode.find_balance1_eqv

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic ins_ne_leaf_tac -/
theorem find_balance1Node_eqv {t s x y lo hi} (h : ¬lt x y ∧ ¬lt y x)
    (ht : IsSearchable lt t lo (some y)) (hs : IsSearchable lt s (some y) hi)
    (hne : t ≠ leaf := by
      run_tac
        ins_ne_leaf_tac) :
    find lt (balance1Node t y s) x = some y :=
  by
  cases t <;> simp [balance1_node]
  · contradiction
  all_goals intros ;
    run_tac
      is_searchable_tactic;
    apply find_balance1_eqv; assumption'
#align rbnode.find_balance1_node_eqv Rbnode.find_balance1Node_eqv

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem find_balance2_lt {l v r t x y lo hi} (h : lt x y) (hl : IsSearchable lt l (some y) (some v))
    (hr : IsSearchable lt r (some v) hi) (ht : IsSearchable lt t lo (some y)) :
    find lt (balance2 l v r y t) x = find lt t x :=
  by
  revert hl hr ht;
  apply balance.cases l v r <;> intros <;> simp [*] <;>
    run_tac
      is_searchable_tactic
  · have := trans h (lo_lt_hi hl_hs₁)
    simp [*]
  · have := trans h (lo_lt_hi hl)
    simp [*]
#align rbnode.find_balance2_lt Rbnode.find_balance2_lt

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic ins_ne_leaf_tac -/
theorem find_balance2Node_lt {s t x y lo hi} (h : lt x y) (ht : IsSearchable lt t (some y) hi)
    (hs : IsSearchable lt s lo (some y))
    (hne : t ≠ leaf := by
      run_tac
        ins_ne_leaf_tac) :
    find lt (balance2Node t y s) x = find lt s x :=
  by
  cases t <;> simp [balance2_node]
  all_goals intros ;
    run_tac
      is_searchable_tactic;
    apply find_balance2_lt; assumption'
#align rbnode.find_balance2_node_lt Rbnode.find_balance2Node_lt

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem find_balance2_gt {l v r t x y lo hi} (h : lt y x) (hl : IsSearchable lt l (some y) (some v))
    (hr : IsSearchable lt r (some v) hi) (ht : IsSearchable lt t lo (some y)) :
    find lt (balance2 l v r y t) x = find lt (red_node l v r) x :=
  by
  revert hl hr ht;
  apply balance.cases l v r <;> intros <;> simp [*] <;>
    run_tac
      is_searchable_tactic
  · apply weak_trichotomous lt x_1 x <;> intro h' <;> simp [*]
    · apply weak_trichotomous lt y_1 x <;> intros <;> simp [*]
    · have : lt x _ := lt_of_incomp_of_lt h'.swap (lo_lt_hi hl_hs₂)
      simp [*]
    · have := trans h' (lo_lt_hi hl_hs₂)
      simp [*]
  · apply weak_trichotomous lt y_1 x <;> intros <;> simp [*]
#align rbnode.find_balance2_gt Rbnode.find_balance2_gt

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic ins_ne_leaf_tac -/
theorem find_balance2Node_gt {s t x y lo hi} (h : lt y x) (ht : IsSearchable lt t (some y) hi)
    (hs : IsSearchable lt s lo (some y))
    (hne : t ≠ leaf := by
      run_tac
        ins_ne_leaf_tac) :
    find lt (balance2Node t y s) x = find lt t x :=
  by
  cases t <;> simp [balance2_node]
  · contradiction
  all_goals intros ;
    run_tac
      is_searchable_tactic;
    apply find_balance2_gt; assumption'
#align rbnode.find_balance2_node_gt Rbnode.find_balance2Node_gt

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
theorem find_balance2_eqv {l v r t x y lo hi} (h : ¬lt x y ∧ ¬lt y x)
    (hl : IsSearchable lt l (some y) (some v)) (hr : IsSearchable lt r (some v) hi)
    (ht : IsSearchable lt t lo (some y)) : find lt (balance2 l v r y t) x = some y :=
  by
  revert hl hr ht;
  apply balance.cases l v r <;> intros <;> simp [*] <;>
    run_tac
      is_searchable_tactic
  · have := lt_of_incomp_of_lt h (lo_lt_hi hl_hs₁)
    simp [*]
  · have := lt_of_incomp_of_lt h (lo_lt_hi hl)
    simp [*]
#align rbnode.find_balance2_eqv Rbnode.find_balance2_eqv

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic rbnode.is_searchable_tactic -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic ins_ne_leaf_tac -/
theorem find_balance2Node_eqv {t s x y lo hi} (h : ¬lt x y ∧ ¬lt y x)
    (ht : IsSearchable lt t (some y) hi) (hs : IsSearchable lt s lo (some y))
    (hne : t ≠ leaf := by
      run_tac
        ins_ne_leaf_tac) :
    find lt (balance2Node t y s) x = some y :=
  by
  cases t <;> simp [balance2_node]
  · contradiction
  all_goals intros ;
    run_tac
      is_searchable_tactic;
    apply find_balance2_eqv; assumption'
#align rbnode.find_balance2_node_eqv Rbnode.find_balance2Node_eqv

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.3968712505.simp_fi -/
theorem find_ins_of_disj {x y : α} {t : Rbnode α} (hn : lt x y ∨ lt y x) :
    ∀ {lo hi} (hs : IsSearchable lt t lo hi) (hlt₁ : Lift lt lo (some x))
      (hlt₂ : Lift lt (some x) hi), find lt (ins lt t x) y = find lt t y :=
  by
  apply ins.induction lt t x <;> intros
  · cases hn
    all_goals simp [find, ins, cmpUsing, *]
  all_goals simp at hc; cases hs
  · have := ih hs_hs₁ hlt₁ hc
    run_tac
      simp_fi
  · cases hn
    · have := lt_of_incomp_of_lt hc.symm hn
      run_tac
        simp_fi
    · have := lt_of_lt_of_incomp hn hc
      run_tac
        simp_fi
  · have := ih hs_hs₂ hc hlt₂
    run_tac
      simp_fi
  · have ih := ih hs_hs₁ hlt₁ hc
    cases hn
    · cases hc' : cmpUsing lt y y_1 <;> simp at hc'
      · have hsi := is_searchable_ins lt hs_hs₁ hlt₁ (trans_of lt hn hc')
        have := find_balance1_node_lt lt hc' hsi hs_hs₂
        run_tac
          simp_fi
      · have hlt := lt_of_lt_of_incomp hn hc'
        have hsi := is_searchable_ins lt hs_hs₁ hlt₁ hlt
        have := find_balance1_node_eqv lt hc' hsi hs_hs₂
        run_tac
          simp_fi
      · have hsi := is_searchable_ins lt hs_hs₁ hlt₁ hc
        have := find_balance1_node_gt lt hc' hsi hs_hs₂
        simp [*]
        run_tac
          simp_fi
    · have hlt := trans hn hc
      have hsi := is_searchable_ins lt hs_hs₁ hlt₁ hc
      have := find_balance1_node_lt lt hlt hsi hs_hs₂
      run_tac
        simp_fi
  · have := ih hs_hs₁ hlt₁ hc
    run_tac
      simp_fi
  · cases hn
    · have := lt_of_incomp_of_lt hc.swap hn
      run_tac
        simp_fi
    · have := lt_of_lt_of_incomp hn hc
      run_tac
        simp_fi
  · have ih := ih hs_hs₂ hc hlt₂
    cases hn
    · have hlt := trans hc hn
      run_tac
        simp_fi
      have hsi := is_searchable_ins lt hs_hs₂ hc hlt₂
      have := find_balance2_node_gt lt hlt hsi hs_hs₁
      run_tac
        simp_fi
    · run_tac
        simp_fi
      cases hc' : cmpUsing lt y y_1 <;> simp at hc'
      · have hsi := is_searchable_ins lt hs_hs₂ hc hlt₂
        have := find_balance2_node_lt lt hc' hsi hs_hs₁
        run_tac
          simp_fi
      · have hlt := lt_of_incomp_of_lt hc'.swap hn
        have hsi := is_searchable_ins lt hs_hs₂ hlt hlt₂
        have := find_balance2_node_eqv lt hc' hsi hs_hs₁
        run_tac
          simp_fi
      · have hsi := is_searchable_ins lt hs_hs₂ hc hlt₂
        have := find_balance2_node_gt lt hc' hsi hs_hs₁
        run_tac
          simp_fi
  · have ih := ih hs_hs₂ hc hlt₂
    run_tac
      simp_fi
#align rbnode.find_ins_of_disj Rbnode.find_ins_of_disj

end FindInsOfNotEqv

theorem find_insert_of_disj [DecidableRel lt] [IsStrictWeakOrder α lt] {x y : α} {t : Rbnode α}
    (hd : lt x y ∨ lt y x) :
    IsSearchable lt t none none → find lt (insert lt t x) y = find lt t y :=
  by
  intro hs
  simp [insert, find_mk_insert_result]
  apply find_ins_of_disj lt hd hs <;> simp
#align rbnode.find_insert_of_disj Rbnode.find_insert_of_disj

theorem find_insert_of_not_eqv [DecidableRel lt] [IsStrictWeakOrder α lt] {x y : α} {t : Rbnode α}
    (hn : ¬x ≈[lt]y) : IsSearchable lt t none none → find lt (insert lt t x) y = find lt t y :=
  by
  intro hs
  simp [insert, find_mk_insert_result]
  have he : lt x y ∨ lt y x :=
    by
    simp [StrictWeakOrder.Equiv, Decidable.not_and_iff_or_not, Decidable.not_not_iff] at hn
    assumption
  apply find_ins_of_disj lt he hs <;> simp
#align rbnode.find_insert_of_not_eqv Rbnode.find_insert_of_not_eqv

end MembershipLemmas

section IsRedBlack

variable {α : Type u}

open Nat Color

inductive IsBadRedBlack : Rbnode α → Nat → Prop
  |
  bad_red {c₁ c₂ n l r v} (rb_l : IsRedBlack l c₁ n) (rb_r : IsRedBlack r c₂ n) :
    is_bad_red_black (red_node l v r) n
#align rbnode.is_bad_red_black Rbnode.IsBadRedBlack

theorem balance1_rb {l r t : Rbnode α} {y v : α} {c_l c_r c_t n} :
    IsRedBlack l c_l n →
      IsRedBlack r c_r n → IsRedBlack t c_t n → ∃ c, IsRedBlack (balance1 l y r v t) c (succ n) :=
  by intro h₁ h₂ _ <;> cases h₁ <;> cases h₂ <;> repeat' first |assumption|constructor
#align rbnode.balance1_rb Rbnode.balance1_rb

theorem balance2_rb {l r t : Rbnode α} {y v : α} {c_l c_r c_t n} :
    IsRedBlack l c_l n →
      IsRedBlack r c_r n → IsRedBlack t c_t n → ∃ c, IsRedBlack (balance2 l y r v t) c (succ n) :=
  by intro h₁ h₂ _ <;> cases h₁ <;> cases h₂ <;> repeat' first |assumption|constructor
#align rbnode.balance2_rb Rbnode.balance2_rb

theorem balance1Node_rb {t s : Rbnode α} {y : α} {c n} :
    IsBadRedBlack t n → IsRedBlack s c n → ∃ c, IsRedBlack (balance1Node t y s) c (succ n) := by
  intro h _ <;> cases h <;> simp [balance1_node] <;> apply balance1_rb <;> assumption'
#align rbnode.balance1_node_rb Rbnode.balance1Node_rb

theorem balance2Node_rb {t s : Rbnode α} {y : α} {c n} :
    IsBadRedBlack t n → IsRedBlack s c n → ∃ c, IsRedBlack (balance2Node t y s) c (succ n) := by
  intro h _ <;> cases h <;> simp [balance2_node] <;> apply balance2_rb <;> assumption'
#align rbnode.balance2_node_rb Rbnode.balance2Node_rb

def InsRbResult : Rbnode α → Color → Nat → Prop
  | t, red, n => IsBadRedBlack t n
  | t, black, n => ∃ c, IsRedBlack t c n
#align rbnode.ins_rb_result Rbnode.InsRbResult

variable {lt : α → α → Prop} [DecidableRel lt]

theorem of_getColor_eq_red {t : Rbnode α} {c n} : getColor t = red → IsRedBlack t c n → c = red :=
  by intro h₁ h₂; cases h₂ <;> simp only [get_color] at h₁ <;> contradiction
#align rbnode.of_get_color_eq_red Rbnode.of_getColor_eq_red

theorem of_getColor_ne_red {t : Rbnode α} {c n} : getColor t ≠ red → IsRedBlack t c n → c = black :=
  by intro h₁ h₂; cases h₂ <;> simp only [get_color] at h₁ <;> contradiction
#align rbnode.of_get_color_ne_red Rbnode.of_getColor_ne_red

variable (lt)

theorem ins_rb {t : Rbnode α} (x) : ∀ {c n} (h : IsRedBlack t c n), InsRbResult (ins lt t x) c n :=
  by
  apply ins.induction lt t x <;> intros <;> cases h <;> simp [ins, *, ins_rb_result]
  · repeat' constructor
  · specialize ih h_rb_l
    cases ih
    constructor <;> assumption
  · constructor <;> assumption
  · specialize ih h_rb_r
    cases ih
    constructor <;> assumption
  · specialize ih h_rb_l
    cases of_get_color_eq_red hr h_rb_l
    apply balance1_node_rb <;> assumption
  · specialize ih h_rb_l
    cases of_get_color_ne_red hnr h_rb_l
    cases ih
    constructor
    constructor <;> assumption
  · constructor
    constructor <;> assumption
  · specialize ih h_rb_r
    cases of_get_color_eq_red hr h_rb_r
    apply balance2_node_rb <;> assumption
  · specialize ih h_rb_r
    cases of_get_color_ne_red hnr h_rb_r
    cases ih
    constructor
    constructor <;> assumption
#align rbnode.ins_rb Rbnode.ins_rb

def InsertRbResult : Rbnode α → Color → Nat → Prop
  | t, red, n => IsRedBlack t black (succ n)
  | t, black, n => ∃ c, IsRedBlack t c n
#align rbnode.insert_rb_result Rbnode.InsertRbResult

theorem insert_rb {t : Rbnode α} (x) {c n} (h : IsRedBlack t c n) :
    InsertRbResult (insert lt t x) c n := by
  simp [insert]
  have hi := ins_rb lt x h
  generalize he : ins lt t x = r
  simp [he] at hi
  cases h <;> simp [get_color, ins_rb_result, insert_rb_result, mk_insert_result] at *
  assumption'
  · cases hi
    simp [mk_insert_result]
    constructor <;> assumption
#align rbnode.insert_rb Rbnode.insert_rb

theorem insert_isRedBlack {t : Rbnode α} {c n} (x) :
    IsRedBlack t c n → ∃ c n, IsRedBlack (insert lt t x) c n :=
  by
  intro h
  have := insert_rb lt x h
  cases c <;> simp [insert_rb_result] at this
  · constructor
    constructor
    assumption
  · cases this
    constructor
    constructor
    assumption
#align rbnode.insert_is_red_black Rbnode.insert_isRedBlack

end IsRedBlack

end Rbnode


/-
Copyright (c) 2019 Rob Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rob Lewis
-/
import tactic.simp_result

namespace tactic

/--
`delta_instance ids` tries to solve the goal by calling `apply_instance`,
first unfolding the definitions in `ids`.
-/
-- We call `dsimp_result` here because otherwise
-- `delta_target` will insert an `id` in the result.
-- See the note [locally reducible category instances]
-- https://github.com/leanprover-community/mathlib/blob/c9fca15420e2ad443707ace831679fd1762580fe/src/algebra/category/Mon/basic.lean#L27
-- for an example where this used to cause a problem.
meta def delta_instance (ids : list name) : tactic unit :=
dsimp_result
  (intros >> reset_instance_cache >> delta_target ids >> apply_instance >> done)

namespace interactive
setup_tactic_parser

/--
`delta_instance id₁ id₂ ...` tries to solve the goal by calling `apply_instance`,
first unfolding the definitions in `idᵢ`.
-/
meta def delta_instance (ids : parse ident*) : itactic :=
tactic.delta_instance ids
end interactive

/-- Guess a name for an instance from its expression.

This is a poor-man's version of the C++ `heuristic_inst_name`, and tries much less hard to pick a
good name. -/
meta def delta_instance_name : pexpr → string
| (expr.app f _) := delta_instance_name f
| (expr.pi _ _ _ body) := delta_instance_name body
| (expr.lam _ _ _ body) := delta_instance_name body
| (expr.const nm _) := nm.last
| _ := "inst"

/--
Tries to derive instances by unfolding the newly introduced type and applying type class resolution.

For example,
```lean
@[derive ring] def new_int : Type := ℤ
```
adds an instance `ring new_int`, defined to be the instance of `ring ℤ` found by `apply_instance`.

Multiple instances can be added with `@[derive [ring, module ℝ]]`.

This derive handler applies only to declarations made using `def`, and will fail on such a
declaration if it is unable to derive an instance. It is run with higher priority than the built-in
handlers, which will fail on `def`s.
-/
@[derive_handler, priority 2000] meta def delta_instance_handler : derive_handler :=
λ cls new_decl_name,
do env ← get_env,
if env.is_inductive new_decl_name then return ff else
do new_decl ← get_decl new_decl_name,
   new_decl_pexpr ← resolve_name new_decl_name,
   arity ← get_pexpr_arg_arity_with_tgt cls new_decl.type,
   tgt ← to_expr $ apply_under_n_pis cls new_decl_pexpr new_decl.type
     (new_decl.type.pi_arity - arity),
   (vs, tgt') ← open_pis tgt,
   tgt ← whnf tgt' transparency.none >>= pis vs,
   (_, inst) ← solve_aux tgt $ tactic.delta_instance [new_decl_name],
   inst ← instantiate_mvars inst,
   inst ← replace_univ_metas_with_univ_params inst,
   tgt ← instantiate_mvars tgt,
   nm ← get_unused_decl_name $ new_decl_name <.> (delta_instance_name cls),
   add_protected_decl $ declaration.defn nm inst.collect_univ_params tgt inst
     new_decl.reducibility_hints new_decl.is_trusted,
   set_basic_attribute `instance nm tt,
   return tt

end tactic


import .common

open cpi
open cpi.species

open_locale normalise

def k_bind : ℍ := fin_poly.X "k_bind"
def k_degrade : ℍ := fin_poly.X "k_degrade"
def k_unbind : ℍ := fin_poly.X "k_unbind"
def k_react : ℍ := fin_poly.X "k_react"

def aff : affinity ℍ := affinity.mk_pair k_bind -- x, y

def M : affinity ℍ -- u, r, t
  :=  affinity.mk 3 0 2 k_unbind -- u - t
  ∘[] affinity.mk 3 1 2 k_react -- r - t

def ω : context := context.extend 0 (context.extend M.arity (context.extend 0 (context.extend 0 context.nil)))
def Γ : context := context.extend aff.arity context.nil

def s : name Γ := name.zero ⟨ 0, nat.succ_pos 1 ⟩
def e : name Γ := name.zero ⟨ 1, lt_add_one 1 ⟩

@[pattern] def S : reference 0 ω := reference.zero 0
@[pattern] def E : reference M.arity ω := reference.extend $ reference.zero M.arity
@[pattern] def P₁ : reference 0 ω := reference.extend ∘ reference.extend $ reference.zero 0
@[pattern] def P₂ : reference 0 ω := reference.extend ∘ reference.extend ∘ reference.extend $ reference.zero 0

def x {Γ} : name (context.extend 2 Γ) := name.zero ⟨ 0, nat.succ_pos 1 ⟩
def y {Γ} : name (context.extend 2 Γ) := name.zero ⟨ 1, lt_add_one 1 ⟩

def u {Γ} : name (context.extend M.arity Γ) := name.zero ⟨ 0, nat.succ_pos 2 ⟩
def r {Γ} : name (context.extend M.arity Γ) := name.zero ⟨ 1, int.coe_nat_lt.mp trivial ⟩
def t {Γ} : name (context.extend M.arity Γ) := name.zero ⟨ 2, lt_add_one 2 ⟩

-- S = s(x, y). (x. S + y. (P|P'))
def Sₛ_ : species ℍ ω Γ :=
  s #( 2 ) ⬝ Σ# ( whole.cons (x #) (apply S ∅)
                $ whole.cons (y #) (apply P₁ ∅ |ₛ apply P₂ ∅)
                $ whole.empty )

def S_ : choices ℍ ω Γ :=
  s #( 2 ) ⬝' Σ# ( whole.cons (x #) (apply S ∅)
                 ∘ whole.cons (y #) (apply P₁ ∅ |ₛ apply P₂ ∅)
                 $ whole.empty )

-- E = ν(u, r, t : M) . e⟨u, r⟩. t. E)
def Eₛ : reference 0 ω := reference.zero 0
def Eₛ_ : species ℍ ω Γ :=
  ν(M) (name.extend e #⟨ [u, r] ⟩) ⬝ (name.extend t # ⬝ apply Eₛ ∅)

def E_ : choices ℍ ω (context.extend M.arity Γ) :=
  (name.extend e #⟨ [u, r] ⟩) ⬝' (name.extend t # ⬝ ν(M) apply E (u :: r :: t :: ∅))

-- P = P' = τ@k_degrade. 0
def Pₛ_ : species ℍ ω Γ := τ@k_degrade ⬝ nil

def P_ : choices ℍ ω Γ := τ@k_degrade ⬝' nil
def P'_ : species ℍ ω Γ := Σ# P_

def ℓ : lookup ℍ ω Γ
| _ S := species.rename name.extend S_
| _ E := E_
| _ P₁ := species.rename name.extend P_
| _ P₂ := species.rename name.extend P_
| (nat.succ n) (reference.extend (reference.extend a)) := by { cases a, cases a_a, cases a_a_a }

-- S [s]—→ (; x, y) (x.S + y.(P|P'))
example : (Σ# S_) [ℓ, # s]⟶ (production.concretion (#( vector.nil; 2 )
  Σ# ( whole.cons (x#) (apply S ∅)
     ∘ whole.cons (y#) (apply P₁ ∅ |ₛ apply P₂ ∅)
     $ whole.empty )))
:= transition.choice₁ _ _ _ _ _ _

-- P₁ [τ@k_degrade]⟶ 0
example : P'_ [ℓ, τ@' k_degrade]⟶ (production.species nil)
  := transition.choice₂ k_degrade whole.nil whole.empty

/- Various intermediates -/
def E'_ {Γ} : species ℍ ω Γ := ν(M) apply E (u :: r :: t :: ∅)
def C'_ : species ℍ ω Γ :=
  ν(M) ( ( Σ# ( whole.cons (u#) (apply S ∅)
              $ whole.cons (r#) (apply P₁ ∅ |ₛ apply P₂ ∅)
              $ whole.empty ) )
       |ₛ t# ⬝ E'_)

#eval process_immediate aff ℓ conc ((2 : ℂ) ◯ E'_ |ₚ 2 ◯ (apply S ∅) )

def system : process ℂ ℍ ω Γ :=
  fin_poly.X "S" ◯ (apply S ∅) |ₚ
  fin_poly.X "E" ◯ E'_ |ₚ
  fin_poly.X "S" ◯ C'_ |ₚ
  fin_poly.X "P₁" ◯ (apply P₁ ∅) |ₚ
  fin_poly.X "P₂" ◯ (apply P₂ ∅)

#eval process_immediate aff ℓ conc system

/-
-- Run the result of the above through enzyme.py

(-1•(E•S•k_bind) + 1•(S•k_react) + 1•(S•k_unbind)) • E
(-1•(E•S•k_bind) + 1•(S•k_unbind)) • S
(-1•(P₁•k_degrade) + 1•(S•k_react)) • P₁
(-1•(P₂•k_degrade) + 1•(S•k_react)) • P₂
(-1•(S•k_react) + -1•(S•k_unbind) + 1•(E•S•k_bind)) • C
-/


import sub_pq
import pq_induction_principles

universe u

section pq_group_sub_pq

variables {Q : Type u} [power_quandle Q] {Q1 : sub_power_quandle Q}

def pq_group_sub_pq_inclusion : pq_group Q1 →* pq_group Q :=
begin
  fapply L_of_morph,
  {
    intro x,
    cases x with x hx,
    exact x,
  },
  {
    split,
    {
      intros a b,
      cases a with a ha,
      cases b with b hb,
      refl,
    },
    {
      intros a n,
      cases a with a ha,
      refl,
    },
  },
end

variables {G : Type*} [group G]

def pre_pq_group_in_sub_pq (Q1 : sub_power_quandle Q) : pre_pq_group Q → Prop
| pre_pq_group.unit := true
| (pre_pq_group.incl x) := x ∈ Q1.carrier
| (pre_pq_group.mul x y) := pre_pq_group_in_sub_pq x ∧ pre_pq_group_in_sub_pq y
| (pre_pq_group.inv x) := pre_pq_group_in_sub_pq x

def subgroup_of_pq_supergroup (Q1 : sub_power_quandle Q) : subgroup (pq_group Q) := {
  carrier := λ x, ∃ y : pre_pq_group Q, ⟦y⟧ = x ∧ pre_pq_group_in_sub_pq Q1 y,
  one_mem' := begin
    use pre_pq_group.unit,
    split,
    refl,
    trivial,
  end,
  mul_mem' := begin
    intros a b ha hb,
    cases ha with a1 ha1,
    cases hb with b1 hb1,
    cases ha1 with ha1 ha2,
    cases hb1 with hb1 hb2,
    use pre_pq_group.mul a1 b1,
    split,
    rw ←ha1,
    rw ←hb1,
    refl,
    split,
    assumption,
    assumption,
  end,
  inv_mem' := begin
    intros a ha,
    cases ha with a1 ha1,
    cases ha1 with ha1 ha2,
    use pre_pq_group.inv a1,
    split,
    rw ←ha1,
    refl,
    assumption,
  end}

def iso_subs_forward : pq_group Q1 →* subgroup_of_pq_supergroup Q1 :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    intro q,
    cases q with q hq,
    fconstructor,
    exact of q,
    unfold subgroup_of_pq_supergroup,
    use pre_pq_group.incl q,
    split,
    refl,
    exact hq,
  },
  {
    split,
    {
      intros a b,
      cases a with a ha,
      cases b with b hb,
      simp only,
      have : (⟨a, ha⟩ ▷ ⟨b, hb⟩ : Q1) = ⟨a ▷ b, _⟩ := rfl,
      rw this,
      simp only,
      simp_rw ←rhd_of_eq_of_rhd,
      refl,
    },
    {
      intros a n,
      cases a with a ha,
      simp only,
      have : (⟨a, ha⟩ ^ n : Q1) = ⟨a ^ n, _⟩ := rfl,
      rw this,
      simp only,
      simp_rw of_pow_eq_pow_of,
      ext1,
      simp only [subgroup.coe_gpow, subtype.coe_mk],
    },
  },
end

theorem iso_subs_forward_bijective : function.bijective (iso_subs_forward : pq_group Q1 → subgroup_of_pq_supergroup Q1) :=
begin
  split,
  {
    refine iso_subs_forward.injective_iff.mpr _,
    intros a ha,
    unfold iso_subs_forward at ha,
  },
  {
    sorry,
  },
end

def iso_subs_backward : subgroup_of_pq_supergroup Q1 →* pq_group Q1 :=
begin
  fconstructor,
  {
    intro q,
    cases q with q hq,
    unfold subgroup_of_pq_supergroup at hq,
    sorry,
  },
  sorry,
  sorry,
end

def iso_subs : pq_group Q1 ≃* subgroup_of_pq_supergroup Q1 := {
  to_fun := iso_subs_forward,
  inv_fun := _,
  left_inv := _,
  right_inv := _,
  map_mul' := begin
    intros x y,
    simp only [monoid_hom.map_mul],
  end }

lemma pq_group_sub_pq_inclusion_injective : function.injective (pq_group_sub_pq_inclusion : pq_group Q1 → pq_group Q) :=
begin
  refine pq_group_sub_pq_inclusion.injective_iff.mpr _,
  intros x hx,
  sorry,
  /-
  refine pq_group_list _,
  intros x hxy,
  induction x with y x hx,
  {
    simp only [list.prod_nil, list.map],
  },
  {

  },
  -/
end

end pq_group_sub_pq


import .reify .nnf

open expr tactic

meta def main : tactic unit :=
do dx ← get_domain,
   ihx ← to_expr ``(inhabited),
   ix ← mk_instance (app ihx dx),
   rev dx,
   abst dx,
   reify dx ix,
   -- to_expr ``(form.rvalid_of_valid _) >>= apply,
   -- to_expr ``(@form.valid_of_closed_of_unsat_neg _ %%ix) >>= apply,
   -- exact_dec_trivial,
   skip

example (f g : nat → nat) : ∃ y : nat, (f y < y ∨ y ≤ g (y + 2)) := begin
  main,

  --apply form.rvalid_of_valid _,

end


import data.list.basic
import init.data.list.lemmas

import util

open list

def atom := string

inductive lvalue
| tt
| uu
| ff

structure rule :=
  (head : list atom)
  (pbody : list atom)
  (nbody : list atom)

def program := list rule

example : program := [
  rule.mk [] [] [],
  rule.mk [] [] [],
  rule.mk [] [] []]

example : rule :=
  { rule . head := [],
        pbody := [],
        nbody := [] }

#check list.subset

structure I :=
  (T : list atom)
  (P : list atom)
  (subset : T ⊆ P)

section I
  variable i : I

  @[simp, reducible] def U : list atom :=
    filter (λ x, x ∉ i.T) i.P

  @[simp, reducible] def eval (a : atom) : lvalue :=
    if a ∈ i.T then lvalue.tt else
    if a ∈ i.P then lvalue.uu else lvalue.ff

  def for (i : I) (a : list atom) : I :=
    begin
      let T₂ := (filter (λ x, x ∈ a) i.T),
      let P₂ := (filter (λ x, x ∈ a) i.P),

    end

  -- def eval_I (a : list atom) :

  -- @[simp, reducible] def eval_or (a : list atom) : lvalue :=

  private def I_from_disjoint (T : list atom) (PwithoutT : list atom) : I :=
    begin
      let P := T ++ PwithoutT,
      have subset : T ⊆ P := begin
        apply subset_append_of_subset_left,
        apply subset.refl,
      end,
      exact ⟨T, P, subset⟩
    end

end I

section rule
  variable r : rule
  def sat (i : I) : bool :=
    sorry
end rule


import data.fintype.basic
import algebra.power_mod
import group_theory.group_action
import algebra.group_power
import algebra.big_operators
import data.zmod.basic
import tactic.ring tactic.abel
import group_theory.self_map
import group_theory.action_instances
import group_theory.burnside_count
import group_theory.dihedral
import data.fin_extra
import data.enumeration
import order.lattice order.lattice_extra

open group_theory

namespace combinatorics

variable (N : ℕ)

def square_grid := (fin N.succ) × (fin N.succ)

namespace square_grid

instance : decidable_eq (square_grid N) :=
 by { dsimp [square_grid], apply_instance }

instance : fintype (square_grid N) :=
 by { dsimp [square_grid], apply_instance }

instance : has_repr (square_grid N) :=
  ⟨λ ij, ij.1.val.repr ++ ij.2.val.repr⟩

instance : distrib_lattice (square_grid N) :=
  by { dsimp [square_grid], apply_instance }

instance : bounded_order (square_grid N) :=
  by { dsimp [square_grid], apply_instance }

variable {N}
def s : self_map (square_grid N) := λ ij, ⟨ij.1, ij.2.reflect⟩
def r : self_map (square_grid N) := λ ij, ⟨ij.2.reflect, ij.1⟩
variable (N)

def p : dihedral.prehom 4 (self_map (square_grid N)) :=
begin
 refine_struct {
  r := r,
  s := s
 }; funext ij; rcases ij with ⟨i,j⟩;
 simp [self_map.one_app, self_map.mul_app, r, s, pow_succ, fin.reflect_reflect];
 refl
end

instance four_pos : fact (4 > 0) := by apply_instance

instance : mul_action (dihedral 4) (square_grid N) :=
  self_map.mul_action_of_hom (p N).to_hom

lemma smul_r₀ (ij : square_grid N) :
 (dihedral.r (0 : zmod 4)) • ij = ij := rfl

lemma smul_r₁ (ij : square_grid N) :
 (dihedral.r (1 : zmod 4)) • ij = ⟨ij.2.reflect, ij.1⟩ := rfl

lemma smul_r₂ (ij : (square_grid N)) :
  (dihedral.r (2 : zmod 4)) • ij = ⟨ij.1.reflect, ij.2.reflect⟩ :=
begin
  change ((p N).to_hom) (dihedral.r (2 : zmod 4)) ij = _,
  rw [dihedral.prehom.to_hom.map_r (p N) 2],
  change r (r ij) = _,
  simp only [r, fin.reflect_reflect],
end

lemma smul_r₃ (ij : (square_grid N)) :
  (dihedral.r (3 : zmod 4)) • ij = ⟨ij.2, ij.1.reflect⟩ :=
begin
  change ((p N).to_hom) (dihedral.r (3 : zmod 4)) ij = _,
  rw [dihedral.prehom.to_hom.map_r (p N) 3],
  change r (r (r ij)) = _,
  simp only [r, fin.reflect_reflect],
end

lemma smul_s₀ (ij : (square_grid N)) :
  (dihedral.s (0 : zmod 4)) • ij = ⟨ij.1, ij.2.reflect⟩ := rfl

lemma smul_s₁ (ij : (square_grid N)) :
  (dihedral.s (1 : zmod 4)) • ij = ⟨ij.2, ij.1⟩ :=
begin
  change ((p N).to_hom) (dihedral.s (1 : zmod 4)) ij = _,
  rw [dihedral.prehom.to_hom.map_s (p N) 1,
      self_map.mul_app],
  change r (s ij) = _, simp only [s, r, fin.reflect_reflect],
end

lemma smul_s₂ (ij : (square_grid N)) :
  (dihedral.s (2 : zmod 4)) • ij = ⟨ij.1.reflect, ij.2⟩ :=
begin
  change ((p N).to_hom) (dihedral.s (2 : zmod 4)) ij = _,
  rw [dihedral.prehom.to_hom.map_s (p N) 2],
  change r (r (s ij)) = _,
  simp only [s, r, fin.reflect_reflect],
end

lemma smul_s₃ (ij : (square_grid N)) :
  (dihedral.s (3 : zmod 4)) • ij = ⟨ij.2.reflect, ij.1.reflect⟩ :=
begin
  change ((p N).to_hom) (dihedral.s (3 : zmod 4)) ij = _,
  rw [dihedral.prehom.to_hom.map_s (p N) 3],
  change r (r (r (s ij))) = _,
  simp only [s, r, fin.reflect_reflect],
end

def subsets := finset (square_grid N)

namespace subsets

instance : decidable_eq (subsets N) :=
  by { dsimp [subsets], apply_instance }

instance : has_repr (subsets N) :=
  by { dsimp [subsets], apply_instance }

instance : mul_action (dihedral 4) (subsets N) :=
  by { dsimp [subsets], apply_instance }

end subsets

@[derive decidable_eq]
structure dim := (w h : ℕ)

namespace dim

def flip : dim → dim := λ d, ⟨d.h, d.w⟩

lemma flip_h (d : dim) : d.flip.h = d.w := rfl
lemma flip_w (d : dim) : d.flip.w = d.h := rfl

lemma flip_flip (d : dim) : d.flip.flip = d := by { cases d, refl }

def smul₀ : (dihedral 4) → dim → dim
| (dihedral.r i) d := cond i.val.bodd d.flip d
| (dihedral.s i) d := cond i.val.bodd d d.flip

lemma bodd_mod4 (i : ℕ) : (i % 4).bodd = i.bodd :=
begin
  have : nat.bodd 4 = ff := rfl,
  rw[← congr_arg nat.bodd (nat.mod_add_div i 4),
     nat.bodd_add, nat.bodd_mul, this, ff_band, bxor_ff ]
end

lemma bodd_add (i j : zmod 4) : (i + j).val.bodd =
  bxor i.val.bodd j.val.bodd :=
by { rw [← nat.bodd_add,zmod.val_add], exact bodd_mod4 (i.val + j.val) }

lemma bodd_sub (i j : zmod 4) : (i - j).val.bodd =
  bxor i.val.bodd j.val.bodd :=
begin
  have := bodd_add (i - j) j,
  rw [sub_add_cancel] at this,
  have := congr_fun (congr_arg bxor this) j.val.bodd,
  rw [bool.bxor_assoc, bxor_self, bxor_ff] at this,
  exact this.symm
end

instance : mul_action (dihedral 4) dim := {
  smul := smul₀,
  one_smul := λ ⟨_,_⟩, rfl,
  mul_smul := λ g h d,
  begin
    cases d with a b,
    cases g with i i; cases h with j j;
    simp only [smul₀, bodd_add, bodd_sub,
               dihedral.rr_mul, dihedral.rs_mul,
               dihedral.sr_mul, dihedral.ss_mul];
    cases i.val.bodd; cases j.val.bodd;
    simp only [bxor, cond, flip_flip]; split; refl
  end
}

end dim

@[derive decidable_eq]
structure box :=
(i j k l : fin N.succ) (hik : i ≤ k) (hjl : j ≤ l)

namespace box

variable {N}

@[ext] lemma ext (x y : box N) :
  x.i = y.i → x.j = y.j → x.k = y.k → x.l = y.l → x = y :=
by { cases x, cases y, simp only [], rintro ⟨_⟩ ⟨_⟩ ⟨_⟩ ⟨_⟩, cc }

def bottom_left : (box N) → (square_grid N)
| ⟨i,j,k,l,_,_⟩ := ⟨i,j⟩

def bottom_right : (box N) → (square_grid N)
| ⟨i,j,k,l,_,_⟩ := ⟨k,j⟩

def top_left : (box N) → (square_grid N)
| ⟨i,j,k,l,_,_⟩ := ⟨i,l⟩

def top_right : (box N) → (square_grid N)
| ⟨i,j,k,l,_,_⟩ := ⟨k,l⟩

def size : (box N) → dim
| ⟨i,j,k,l,_,_⟩ := ⟨k - i, l - j⟩

def r : self_map (box N)
| ⟨i,j,k,l,hik,hjl⟩ :=
  ⟨l.reflect, i, j.reflect, k, fin.reflect_le hjl, hik⟩

def s : self_map (box N)
| ⟨i,j,k,l,hik,hjl⟩ :=
   ⟨i,l.reflect,k,j.reflect,hik, fin.reflect_le hjl⟩

variable (N)

def p : dihedral.prehom 4 (self_map (box N)) :=
begin
  have hc : ((4 : ℕ+) : ℕ) = 4 := rfl,
  have hp : (r ^ 4 : self_map (box N)) = r * r * r * r :=
    by simp only [pow_succ, pow_zero, mul_assoc, mul_one],
  refine_struct {
    r := r, s := s
  };
  ext x; cases x with i j k l h₀ h₁;
  simp only [hc, hp, self_map.mul_app, self_map.one_app,
             r, s, fin.reflect_reflect],
end

instance : mul_action (dihedral 4) (box N) :=
  self_map.mul_action_of_hom (p N).to_hom

lemma smul_r₀ (x : box N) :
  (dihedral.r (0 : zmod 4)) • x = x := rfl

lemma smul_r₁ (x : box N) :
  (dihedral.r (1 : zmod 4)) • x =
    box.mk x.l.reflect x.i x.j.reflect x.k
          (fin.reflect_le x.hjl) x.hik :=
by { cases x, refl }

lemma smul_r₂ (x : box N) :
  (dihedral.r (2 : zmod 4)) • x =
    box.mk x.k.reflect x.l.reflect x.i.reflect x.j.reflect
          (fin.reflect_le x.hik) (fin.reflect_le x.hjl) :=
by { cases x, refl }

lemma smul_r₃ (x : box N) :
  (dihedral.r (3 : zmod 4)) • x =
    box.mk x.j x.k.reflect x.l x.i.reflect
          x.hjl (fin.reflect_le x.hik) :=
by { change (r * (r * r)) _ = _, cases x,
     simp only [self_map.mul_app, r, fin.reflect_reflect], cc }

lemma smul_s₀ (x : box N) :
  (dihedral.s (0 : zmod 4)) • x =
    box.mk x.i x.l.reflect x.k x.j.reflect
           x.hik (fin.reflect_le x.hjl) :=
by { cases x, refl }

lemma smul_s₁ (x : box N) :
  (dihedral.s (1 : zmod 4)) • x =
    box.mk x.j x.i x.l x.k x.hjl x.hik :=
by { change (r * s) _ = _, cases x,
     simp only [self_map.mul_app, r, s, fin.reflect_reflect], cc }

lemma smul_s₂ (x : box N) :
  (dihedral.s (2 : zmod 4)) • x =
    box.mk x.k.reflect x.j x.i.reflect x.l
           (fin.reflect_le x.hik) x.hjl :=
by { change (r * r * s) _ = _, cases x,
     simp only [self_map.mul_app, r, s, fin.reflect_reflect], cc }

lemma smul_s₃ (x : box N) :
  (dihedral.s (3 : zmod 4)) • x =
    box.mk x.l.reflect x.k.reflect x.j.reflect x.i.reflect
          (fin.reflect_le x.hjl) (fin.reflect_le x.hik) :=
by { change (r * r * r * s) _ = _, cases x,
     simp only [self_map.mul_app, r, s, fin.reflect_reflect], cc }

def to_subset : ∀ (x : box N), subsets N
| ⟨i,j,k,l,hik,hjl⟩ :=
   finset.product (finset.Icc i k) (finset.Icc j l)

end box

variable {N}

namespace subsets

def bounding_box : (subsets N) → (square_grid N) × (square_grid N) :=
  λ (xs : finset (square_grid N)), ⟨xs.inf id,xs.sup id⟩

def size  (y : subsets N) : ℕ × ℕ :=
 let b := y.bounding_box in prod.mk (b.2.1 - b.1.1) (b.2.2 - b.1.2)

def is_horizontal (y : subsets N) : bool := y.size.2 = 0
def is_vertical   (y : subsets N) : bool := y.size.1  = 0

end subsets

@[derive decidable_eq]
inductive Z_single (N : ℕ)
| H : (fin N) → (fin N.succ) → Z_single
| V : (fin N.succ) → (fin N) → Z_single

namespace Z_single

def to_string : (Z_single N) → string
| (H i j) := "H" ++ i.val.repr ++ j.val.repr
| (V i j) := "V" ++ i.val.repr ++ j.val.repr

instance : has_repr (Z_single N) := ⟨to_string⟩

def bounding_box : (Z_single N) → (square_grid N) × (square_grid N)
| (H i j) := ⟨⟨i.inc,j⟩,⟨i.succ,j⟩⟩
| (V i j) := ⟨⟨i,j.inc⟩,⟨i,j.succ⟩⟩

def size : (Z_single N) → ℕ × ℕ
| (H _ _) := ⟨1,0⟩
| (V _ _) := ⟨0,1⟩

instance : enumeration (Z_single N) := {
  elems :=
   ((enumeration.elems : list (fin N)).bind
      (λ i, (enumeration.elems : list (fin N.succ)).map (Z_single.H i))) ++
   ((enumeration.elems : list (fin N.succ)).bind
      (λ i, (enumeration.elems : list (fin N)).map (Z_single.V i))),
  nodup := sorry,
  complete := λ z,
  begin
    cases z with i j i j; rw [list.mem_append],
    { left,
      exact @list.mem_bind_of_mem (fin N) (Z_single N) (H i j)
        (enumeration.elems : list (fin N))
        (λ i, (enumeration.elems : list (fin N.succ)).map (Z_single.H i))
        i (enumeration.complete i)
        (list.mem_map_of_mem (H i) (enumeration.complete j)) },
    { right,
      exact @list.mem_bind_of_mem (fin N.succ) (Z_single N) (V i j)
        (enumeration.elems : list (fin N.succ))
        (λ i, (enumeration.elems : list (fin N)).map (Z_single.V i))
        i (enumeration.complete i)
        (list.mem_map_of_mem (V i) (enumeration.complete j)) },
  end
}

def to_Y₀ : ∀ (z : Z_single N), list (square_grid N)
| (H i j) := [prod.mk i.inc j, prod.mk i.succ j]
| (V i j) := [prod.mk i j.inc, prod.mk i j.succ]

lemma to_Y₀_nodup (z : Z_single N) : z.to_Y₀.nodup :=
begin
 have : ∀ {n : ℕ} (k : fin n), k.inc ≠ k.succ :=
   λ n k, ne_of_lt k.inc_lt_succ,
 cases z with i j i j; dsimp[to_Y₀];
 simp [fin.eq_iff_veq,(nat.succ_ne_self i.val).symm, this]
end

def to_Y (z : Z_single N) : (subsets N) :=
 @finset.mk (square_grid N) z.to_Y₀ z.to_Y₀_nodup

lemma to_Y_card (z : Z_single N) : z.to_Y.card = 2 :=
by { cases z with i j i j; refl }

lemma to_Y_bounding_box (z : Z_single N) :
  z.to_Y.bounding_box = z.bounding_box :=
begin
  cases z with i j i j,
  focus {
    let u : square_grid N := ⟨i.inc,j⟩,
    let v : square_grid N := ⟨i.succ,j⟩,
    have huv : u ≤ v := ⟨le_of_lt i.inc_lt_succ,le_refl j⟩, },
  swap, focus
  { let u : square_grid N := ⟨i,j.inc⟩,
    let v : square_grid N := ⟨i,j.succ⟩,
    have huv : u ≤ v := ⟨le_refl i,le_of_lt j.inc_lt_succ⟩ },
  all_goals {
    change prod.mk (u ⊓ (v ⊓ ⊤)) (u ⊔ (v ⊔ ⊥)) = ⟨u,v⟩,
    rw [inf_top_eq, sup_bot_eq],
    rw [inf_of_le_left huv, sup_of_le_right huv]
  }
end

lemma to_Y_size (z : Z_single N) :
  z.to_Y.size = z.size :=
begin
  dsimp [subsets.size], rw [to_Y_bounding_box],
  rcases z with ⟨⟨i,hi⟩,⟨j,hj⟩⟩ | ⟨⟨i,hi⟩,⟨j,hj⟩⟩,
  { change prod.mk ((i + 1) - i) (j - j) = ⟨1,0⟩,
    rw [nat.sub_self, nat.add_sub_cancel_left] },
  { change prod.mk (i - i) ((j + 1) - j) = ⟨0,1⟩,
    rw [nat.sub_self, nat.add_sub_cancel_left] }
end

lemma to_Y_inj : function.injective (@to_Y N) :=
begin
  intros z₀ z₁ he,
  have hb := congr_arg subsets.bounding_box he,
  rw [to_Y_bounding_box, to_Y_bounding_box] at hb, clear he,
  cases z₀ with i₀ j₀ i₀ j₀; cases z₁ with i₁ j₁ i₁ j₁,
  all_goals {
    simp only [bounding_box] at hb,
    injection hb  with hb₀ hb₁,
    injection hb₀ with hb₂ hb₃,
    injection hb₁ with hb₄ hb₅ },
  { replace hb₄ := fin.succ_inj.mp hb₄, cc },
  { exfalso, exact ne_of_lt (fin.inc_lt_succ i₀) (hb₂.trans hb₄.symm) },
  { exfalso, exact ne_of_lt (fin.inc_lt_succ j₀) (hb₃.trans hb₅.symm) },
  { replace hb₅ := fin.succ_inj.mp hb₅, cc }
end

def s : (Z_single N) → (Z_single N)
| (H i j) := H i j.reflect
| (V i j) := V i j.reflect

def r : (Z_single N) → (Z_single N)
| (H i j) := V j.reflect i
| (V i j) := H j.reflect i

lemma to_Y_s (z : Z_single N) :
  (s z).to_Y = (dihedral.s (0 : zmod 4)) • z.to_Y :=
begin
  cases z with i j i j; dsimp[s, to_Y, to_Y₀];
  change finset.mk _ _ = _;
  ext x; cases x with i' j';
  simp only [
      mul_action.mem_smul_finset', dihedral.s_inv,
      finset.mem_mk, multiset.mem_coe,
      list.mem_cons_iff, list.mem_singleton,
      mul_action.smul_eq_iff_eq_smul_inv];
  simp only [smul_s₀,
      fin.reflect_inc, fin.reflect_succ, or_comm],
end

lemma to_Y_r (z : Z_single N) :
  (r z).to_Y = (dihedral.r (1 : zmod 4)) • z.to_Y :=
begin
  cases z with i j i j; dsimp[r, to_Y, to_Y₀];
  change finset.mk _ _ = _;
  ext x; cases x with i' j';
  simp only [
      mul_action.mem_smul_finset', dihedral.r_inv, neg_neg,
      finset.mem_mk, multiset.mem_coe,
      list.mem_cons_iff, list.mem_singleton,
      mul_action.smul_eq_iff_eq_smul_inv];
  simp only [smul_r₁,
      fin.reflect_inc, fin.reflect_succ,  or.comm],
end

end Z_single

end square_grid
end combinatorics


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Reid Barton, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.over
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.category_theory.limits.shapes.wide_pullbacks
import Mathlib.category_theory.limits.shapes.finite_products
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Products in the over category

Shows that products in the over category can be derived from wide pullbacks in the base category.
The main result is `over_product_of_wide_pullback`, which says that if `C` has `J`-indexed wide
pullbacks, then `over B` has `J`-indexed products.
-/

namespace category_theory.over

namespace construct_products

/--
(Implementation)
Given a product diagram in `C/B`, construct the corresponding wide pullback diagram
in `C`.
-/
def wide_pullback_diagram_of_diagram_over {C : Type u} [category C] (B : C) {J : Type v}
    (F : discrete J ⥤ over B) : limits.wide_pullback_shape J ⥤ C :=
  limits.wide_pullback_shape.wide_cospan B (fun (j : J) => comma.left (functor.obj F j))
    fun (j : J) => comma.hom (functor.obj F j)

/-- (Impl) A preliminary definition to avoid timeouts. -/
def cones_equiv_inverse_obj {C : Type u} [category C] (B : C) {J : Type v} (F : discrete J ⥤ over B)
    (c : limits.cone F) : limits.cone (wide_pullback_diagram_of_diagram_over B F) :=
  limits.cone.mk (comma.left (limits.cone.X c))
    (nat_trans.mk
      fun (X : limits.wide_pullback_shape J) =>
        option.cases_on X (comma.hom (limits.cone.X c))
          fun (j : J) => comma_morphism.left (nat_trans.app (limits.cone.π c) j))

/-- (Impl) A preliminary definition to avoid timeouts. -/
def cones_equiv_inverse {C : Type u} [category C] (B : C) {J : Type v} (F : discrete J ⥤ over B) :
    limits.cone F ⥤ limits.cone (wide_pullback_diagram_of_diagram_over B F) :=
  functor.mk (cones_equiv_inverse_obj B F)
    fun (c₁ c₂ : limits.cone F) (f : c₁ ⟶ c₂) =>
      limits.cone_morphism.mk (comma_morphism.left (limits.cone_morphism.hom f))

/-- (Impl) A preliminary definition to avoid timeouts. -/
@[simp] theorem cones_equiv_functor_map_hom {C : Type u} [category C] (B : C) {J : Type v}
    (F : discrete J ⥤ over B) (c₁ : limits.cone (wide_pullback_diagram_of_diagram_over B F))
    (c₂ : limits.cone (wide_pullback_diagram_of_diagram_over B F)) (f : c₁ ⟶ c₂) :
    limits.cone_morphism.hom (functor.map (cones_equiv_functor B F) f) =
        hom_mk (limits.cone_morphism.hom f) :=
  Eq.refl (limits.cone_morphism.hom (functor.map (cones_equiv_functor B F) f))

/-- (Impl) A preliminary definition to avoid timeouts. -/
@[simp] def cones_equiv_unit_iso {J : Type v} {C : Type u} [category C] (B : C)
    (F : discrete J ⥤ over B) : 𝟭 ≅ cones_equiv_functor B F ⋙ cones_equiv_inverse B F :=
  nat_iso.of_components
    (fun (_x : limits.cone (wide_pullback_diagram_of_diagram_over B F)) =>
      limits.cones.ext (iso.mk 𝟙 𝟙) sorry)
    sorry

/-- (Impl) A preliminary definition to avoid timeouts. -/
@[simp] def cones_equiv_counit_iso {J : Type v} {C : Type u} [category C] (B : C)
    (F : discrete J ⥤ over B) : cones_equiv_inverse B F ⋙ cones_equiv_functor B F ≅ 𝟭 :=
  nat_iso.of_components
    (fun (_x : limits.cone F) => limits.cones.ext (iso.mk (hom_mk 𝟙) (hom_mk 𝟙)) sorry) sorry

-- TODO: Can we add `. obviously` to the second arguments of `nat_iso.of_components` and

--       `cones.ext`?

/--
(Impl) Establish an equivalence between the category of cones for `F` and for the "grown" `F`.
-/
@[simp] theorem cones_equiv_unit_iso_2 {J : Type v} {C : Type u} [category C] (B : C)
    (F : discrete J ⥤ over B) : equivalence.unit_iso (cones_equiv B F) = cones_equiv_unit_iso B F :=
  Eq.refl (equivalence.unit_iso (cones_equiv B F))

/-- Use the above equivalence to prove we have a limit. -/
theorem has_over_limit_discrete_of_wide_pullback_limit {J : Type v} {C : Type u} [category C]
    {B : C} (F : discrete J ⥤ over B)
    [limits.has_limit (wide_pullback_diagram_of_diagram_over B F)] : limits.has_limit F :=
  sorry

/-- Given a wide pullback in `C`, construct a product in `C/B`. -/
theorem over_product_of_wide_pullback {J : Type v} {C : Type u} [category C]
    [limits.has_limits_of_shape (limits.wide_pullback_shape J) C] {B : C} :
    limits.has_limits_of_shape (discrete J) (over B) :=
  limits.has_limits_of_shape.mk
    fun (F : discrete J ⥤ over B) => has_over_limit_discrete_of_wide_pullback_limit F

/-- Given a pullback in `C`, construct a binary product in `C/B`. -/
theorem over_binary_product_of_pullback {C : Type u} [category C] [limits.has_pullbacks C] {B : C} :
    limits.has_binary_products (over B) :=
  over_product_of_wide_pullback

/-- Given all wide pullbacks in `C`, construct products in `C/B`. -/
theorem over_products_of_wide_pullbacks {C : Type u} [category C] [limits.has_wide_pullbacks C]
    {B : C} : limits.has_products (over B) :=
  fun (J : Type v) => over_product_of_wide_pullback

/-- Given all finite wide pullbacks in `C`, construct finite products in `C/B`. -/
theorem over_finite_products_of_finite_wide_pullbacks {C : Type u} [category C]
    [limits.has_finite_wide_pullbacks C] {B : C} : limits.has_finite_products (over B) :=
  fun (J : Type v) (𝒥₁ : DecidableEq J) (𝒥₂ : fintype J) => over_product_of_wide_pullback

end construct_products

/--
Construct terminal object in the over category. This isn't an instance as it's not typically the
way we want to define terminal objects.
(For instance, this gives a terminal object which is different from the generic one given by
`over_product_of_wide_pullback` above.)
-/
theorem over_has_terminal {C : Type u} [category C] (B : C) : limits.has_terminal (over B) := sorry

end Mathlib


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem algebra_manipexpr_2erprsqpesqeqnrpnesq
  (e r : ℂ) :
  2 * (e * r) + (e^2 + r^2) = (-r + (-e))^2 :=
begin
  ring,
end


import logic lib.tukey

universes u

open_locale logic_symbol

namespace logic
open_locale aclogic
variables {F : Type*} [has_logic_symbol F] [axiomatic_classical_logic F]

namespace Theory

variables {T U : Theory F}

open axiomatic_classical_logic axiomatic_classical_logic'

lemma consistent_of_consistent_ss (h : T.consistent) (ss : U ⊆ T) : U.consistent :=
by { simp[consistent_iff_bot] at h ⊢, intros hU, have : T ⊢ ⊥, from weakening ss hU, contradiction }

private lemma list_set_finite {α} (l : list α) : {a : α | a ∈ l}.finite :=
by { induction l with a l IH, { simp },
  { simp[show {b : α | b = a ∨ b ∈ l} = insert a {b : α | b ∈ l}, by refl], exact set.finite.insert a IH } }

variables (F)

class has_finite_character :=
(finite_character' : ∀ {T : Theory F}, (∀ (s ⊆ T) (f : s.finite), consistent s) → consistent T)

def finite_character_of_finite_provable
  (H : ∀ T p, T ⊢ p → ∃ P : list F, (∀ p, p ∈ P → T p) ∧ ∅ ⊢ P.conjunction ⟶ p) :
  has_finite_character F :=
⟨λ T h,
  begin
    by_contradiction A,
    have : ∃ (P : list F), (∀ p ∈ P, T p) ∧ ∅ ⊢ P.conjunction ⟶ ⊥, from H _ _ (not_consistent_iff_bot.mp A),
    rcases this with ⟨P, ss, b⟩,
    let s := {p | p ∈ P},
    have : s ⊢ ⊥,
    { have lmm₁ : s ⊢ P.conjunction ⟶ ⊥, from weakening (by simp) b,
      have lmm₂ : s ⊢ P.conjunction, from list_conjunction_provable (λ p h, by_axiom (by simp[s, h])),
      exact lmm₁ ⨀ lmm₂ },
    have : consistent s, from h s ss (by simp[s, list_set_finite]),
    have : ¬s ⊢ ⊥, exact consistent_iff_bot.mp this,
    contradiction
  end⟩

variables {F}

namespace consistent
open has_finite_character
variables [has_finite_character F]

lemma finite_character :
  consistent T ↔ ∀ (s ⊆ T) (f : s.finite), consistent s :=
⟨begin
  intros h,
  by_contradiction A, simp at A,
  rcases A with ⟨s, ss, s_fin, hs⟩,
  have : s ⊢ ⊥, from not_consistent_iff_bot.mp hs,
  have : T ⊢ ⊥, from weakening ss this,
  have : ¬T ⊢ ⊥, from consistent_iff_bot.mp h,
  contradiction
end, finite_character'⟩

lemma tukey_finite_charactor : tukey.finite_charactor (Theory.consistent : Theory F → Prop) :=
λ T, finite_character

lemma finite_character_union (consis : consistent T) :
  consistent (T ∪ U) ↔ ∀ (s ⊆ U) (f : s.finite), consistent (T ∪ s) :=
begin
  rw finite_character, split,
  { intros h s s_ss s_fin,
    rw finite_character, intros s' s'_ss, refine h s'
      (by { have : T ∪ s ⊆ T ∪ U, { simp, exact set.subset_union_of_subset_right s_ss T },
      exact set.subset.trans s'_ss this }) },
  { intros h s s_ss s_fin,
    let u := s ∩ U,
    have lmm : consistent (T ∪ u), from h u (by simp[u]) (by { simp[u], exact set.finite.inter_of_left s_fin U }),
    have ss : s ⊆ T ∪ u, { intros p mem, simp[u], have : p ∈ T ∨ p ∈ U, from s_ss mem, tauto },
    refine consistent_of_consistent_ss lmm ss }
end

lemma of_finite_induction
  (consis : consistent T)
  (H : ∀ (s ⊆ U) (p ∈ U), p ∉ s → s.finite → consistent (T ∪ s) → consistent ((T ∪ s) +{ p })) :
  consistent (T ∪ U) :=
begin
  refine (finite_character_union consis).mpr _,
  suffices : ∀ (s : Theory F), set.finite s → s ⊆ U → (T ∪ s).consistent,
  { intros s ss fin, exact this s fin ss },
  intros s fin,
  refine set.finite.induction_on fin (λ _, by simp[consis]) _,
  intros p s nmem fin consis ss,
  have : T ∪ insert p s = (T ∪ s) +{ p }, { ext q, simp },
  simp[this],
  exact H s (set.subset.trans (show s ⊆ insert p s, by simp) ss) p (ss (show p ∈ insert p s, by simp)) nmem fin
    (consis (set.subset.trans (show s ⊆ insert p s, by simp) ss))
end

lemma Union_seq (T : ℕ → Theory F) (h : ∀ n, T n ⊆ T (n + 1)) :
  Theory.consistent (⋃ n, T n) ↔ ∀ n, Theory.consistent (T n) :=
⟨λ H n, consistent_of_consistent_ss H (set.subset_Union T n),
 λ H, by {
  have ss_of_le : ∀ {m n}, m ≤ n → T m ⊆ T n,
  { suffices : ∀ n m, T m ⊆ T (m + n),
    { intros m n le, simpa[show m + (n - m) = n, by omega] using this (n - m) m },
    intros n m, induction n with n IH; simp[←nat.add_one, ←add_assoc],
    { exact set.subset.trans IH (h (m + n)) } },
  rw[finite_character], intros s s_ss s_fin,
  casesI s_fin,
  choose f hf using show ∀ x : s, ∃ i, x.1 ∈ T i, { simpa [set.subset_def] using s_ss },
  let M := ⨆ᶠ i, f i,
  have : s ⊆ T M,
  { intros x hx,
    have : f ⟨x, hx⟩ ≤ M, from le_fintype_sup _ _,
    exact ss_of_le this (hf ⟨x, hx⟩) },
  exact consistent_of_consistent_ss (H M) this }⟩

lemma inconsistent_insert_iff_provable_neg {p : F} :
  ¬Theory.consistent (T +{ p }) ↔ T ⊢ ∼p :=
begin
  simp [Theory.consistent_iff_bot, deduction],
  have : T ⊢ ∼p ⟷ p ⟶ ⊥, from neg_iff p,
  split; intros h, { exact (iff_equiv.mp this).2 ⨀ h }, { exact (iff_equiv.mp this).1 ⨀ h }
end

lemma extendable (consis : T.consistent) (p : F) :
  Theory.consistent (T +{ p }) ∨ Theory.consistent (T +{ ∼p }) :=
by { by_contradiction A, simp[not_or_distrib, inconsistent_insert_iff_provable_neg] at A, rcases A with ⟨A₁, A₂⟩,
     exact consis ⟨p, A₂, A₁⟩ }

def maximal (T : Theory F) : Theory F := classical.epsilon (λ M, consistent M ∧ T ⊆ M ∧ ∀ S, consistent S → M ⊆ S → S = M)

theorem maximal_consistent (consis : consistent T) :  consistent (maximal T) := (classical.epsilon_spec (tukey.exists_maximum tukey_finite_charactor T consis)).1

theorem ss_maximal (consis : consistent T) :  T ⊆ maximal T := (classical.epsilon_spec (tukey.exists_maximum tukey_finite_charactor T consis)).2.1

theorem maximal_maximal (consis : consistent T) : ∀ S, consistent S → maximal T ⊆ S → S = maximal T := (classical.epsilon_spec (tukey.exists_maximum tukey_finite_charactor T consis)).2.2

lemma mem_maximal (consis : consistent T) (p : F) : p ∈ maximal T ∨ ∼p ∈ maximal T :=
begin
  rcases extendable (maximal_consistent consis) p,
  { have : insert p (maximal T) = maximal T, from maximal_maximal consis _ h (set.subset_insert _ _),
    refine or.inl _, rw[←this], exact set.mem_insert p (maximal T) },
  { have : insert (∼p) (maximal T) = maximal T, from maximal_maximal consis _ h (set.subset_insert _ _),
    refine or.inr _, rw[←this], exact set.mem_insert (∼p) (maximal T) }
end

lemma mem_maximal_iff (consis : consistent T) {p : F} : p ∈ maximal T ↔ maximal T ⊢ p :=
⟨by_axiom,
  λ b, by { rcases mem_maximal consis p with (h | h),
    { exact h }, { have : maximal T ⊢ ∼p, from by_axiom h,
      have : ¬(consistent (maximal T)), { simp[consistent_def], refine ⟨_, b, this⟩ },
      have : consistent (maximal T), from maximal_consistent consis,
      contradiction } }⟩

lemma neg_mem_maximal_iff (consis : consistent T) {p : F} :
  ∼p ∈ maximal T ↔ p ∉ maximal T :=
⟨λ b A, by { simp[mem_maximal_iff consis] at*,
  have : ¬consistent (maximal T), { simp[consistent_def], refine ⟨p, A, b⟩ },
  have : consistent (maximal T), from maximal_consistent consis,
  contradiction },
λ b, by { rcases mem_maximal consis p with (h | h), { contradiction }, { exact h } }⟩

lemma imply_mem_maximal_iff (consis : consistent T) {p q : F} :
  p ⟶ q ∈ maximal T ↔ (p ∈ maximal T → q ∈ maximal T) :=
⟨λ b₁ b₂, by { simp[mem_maximal_iff consis] at*, exact b₁ ⨀ b₂ },
λ h, begin
  by_cases C : p ∈ maximal T,
  { simp[mem_maximal_iff consis] at*, exact hyp_right (h C) p },
  { have : ∼p ∈ maximal T, from (neg_mem_maximal_iff consis).mpr C,
    simp[mem_maximal_iff consis] at*,
    refine deduction.mp _,
    exact explosion (show (maximal T) +{ p } ⊢ p, by simp) (show (maximal T) +{ p } ⊢ ∼p, by simp[this]) }
end⟩

end consistent

lemma provable_iff_inconsistent {p : F} : T ⊢ p ↔ ¬consistent (T +{∼p}) :=
⟨λ h, by { simp[consistent_def], refine ⟨p, by simp[h], by simp⟩ },
λ h, by { have : T +{ ∼p } ⊢ ⊥, from not_consistent_iff_bot.mp h,
          have : T ⊢ ∼∼p, from (iff_of_equiv (neg_iff _)).mpr (deduction.mp this),
          exact dn_iff.mp this }⟩

end Theory

namespace complete
open Theory
variables {F} {𝓢 : Type*} [has_finite_character F] [semantics F 𝓢] [complete F 𝓢] {S : 𝓢}

theorem compactness [semantics.nontrivial F 𝓢] {T : Theory F} :
  semantics.Satisfiable 𝓢 T ↔ (∀ u ⊆ T, u.finite → semantics.Satisfiable 𝓢 (u : set F)) :=
⟨by rintros ⟨S, hS⟩ u ss hu; refine ⟨S, semantics.models_of_ss ss hS⟩,
  begin
    intros h,
    have : consistent T,
    from consistent.finite_character.mpr
      (by { intros u ss hu, exact consistent_iff_Satisfiable.mpr (h u ss hu) }),
    exact consistent_iff_Satisfiable.mp this
  end⟩

theorem compactness' [semantics.nontrivial F 𝓢] {T : Theory F} :
  ¬semantics.Satisfiable 𝓢 T ↔ (∃ u ⊆ T, u.finite ∧ ¬semantics.Satisfiable 𝓢 (u : set F)) :=
by rw[compactness]; simp

end complete

end logic


import graphs.ext

/-
We prove the same for vertex maps ...
-/
/- Lemma :
-/
lemma eq_mor_eq_emap {G H : graph} (α : G ↦ H) (β : G ↦ H) (hyp : α = β) : α.edge_map = β.edge_map :=
begin
  sorry,

end


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.category.Cat
import Mathlib.category_theory.groupoid
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Objects of a category up to an isomorphism

`is_isomorphic X Y := nonempty (X ≅ Y)` is an equivalence relation on the objects of a category.
The quotient with respect to this relation defines a functor from our category to `Type`.
-/

namespace category_theory

/-- An object `X` is isomorphic to an object `Y`, if `X ≅ Y` is not empty. -/
def is_isomorphic {C : Type u} [category C] : C → C → Prop :=
  fun (X Y : C) => Nonempty (X ≅ Y)

/-- `is_isomorphic` defines a setoid. -/
def is_isomorphic_setoid (C : Type u) [category C] : setoid C :=
  setoid.mk is_isomorphic sorry

/--
The functor that sends each category to the quotient space of its objects up to an isomorphism.
-/
def isomorphism_classes : Cat ⥤ Type u :=
  functor.mk (fun (C : Cat) => quotient (is_isomorphic_setoid (bundled.α C)))
    fun (C D : Cat) (F : C ⟶ D) => quot.map (functor.obj F) sorry

theorem groupoid.is_isomorphic_iff_nonempty_hom {C : Type u} [groupoid C] {X : C} {Y : C} : is_isomorphic X Y ↔ Nonempty (X ⟶ Y) :=
  equiv.nonempty_iff_nonempty (groupoid.iso_equiv_hom X Y)


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

Basic topological facts (limits and continuity) about `floor`,
`ceil` and `fract` in a `floor_ring`.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.algebra.ordered
import Mathlib.algebra.floor
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

theorem tendsto_floor_at_top {α : Type u_1} [linear_ordered_ring α] [floor_ring α] :
    filter.tendsto floor filter.at_top filter.at_top :=
  sorry

theorem tendsto_floor_at_bot {α : Type u_1} [linear_ordered_ring α] [floor_ring α] :
    filter.tendsto floor filter.at_bot filter.at_bot :=
  monotone.tendsto_at_bot_at_bot (fun (a b : α) (hab : a ≤ b) => floor_mono hab)
    fun (b : ℤ) =>
      Exists.intro (↑b)
        (eq.mpr (id (Eq._oldrec (Eq.refl (floor ↑b ≤ b)) (floor_coe b))) (le_refl b))

theorem tendsto_ceil_at_top {α : Type u_1} [linear_ordered_ring α] [floor_ring α] :
    filter.tendsto ceil filter.at_top filter.at_top :=
  filter.tendsto.comp filter.tendsto_neg_at_bot_at_top
    (filter.tendsto.comp tendsto_floor_at_bot filter.tendsto_neg_at_top_at_bot)

theorem tendsto_ceil_at_bot {α : Type u_1} [linear_ordered_ring α] [floor_ring α] :
    filter.tendsto ceil filter.at_bot filter.at_bot :=
  filter.tendsto.comp filter.tendsto_neg_at_top_at_bot
    (filter.tendsto.comp tendsto_floor_at_top filter.tendsto_neg_at_bot_at_top)

theorem continuous_on_floor {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] (n : ℤ) :
    continuous_on (fun (x : α) => ↑(floor x)) (set.Ico (↑n) (↑n + 1)) :=
  iff.mpr (continuous_on_congr (floor_eq_on_Ico' n)) continuous_on_const

theorem continuous_on_ceil {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] (n : ℤ) :
    continuous_on (fun (x : α) => ↑(ceil x)) (set.Ioc (↑n - 1) ↑n) :=
  iff.mpr (continuous_on_congr (ceil_eq_on_Ioc' n)) continuous_on_const

theorem tendsto_floor_right' {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] (n : ℤ) :
    filter.tendsto (fun (x : α) => ↑(floor x)) (nhds_within (↑n) (set.Ici ↑n)) (nhds ↑n) :=
  sorry

theorem tendsto_ceil_left' {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] (n : ℤ) :
    filter.tendsto (fun (x : α) => ↑(ceil x)) (nhds_within (↑n) (set.Iic ↑n)) (nhds ↑n) :=
  sorry

theorem tendsto_floor_right {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] (n : ℤ) :
    filter.tendsto (fun (x : α) => ↑(floor x)) (nhds_within (↑n) (set.Ici ↑n))
        (nhds_within (↑n) (set.Ici ↑n)) :=
  sorry

theorem tendsto_ceil_left {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] (n : ℤ) :
    filter.tendsto (fun (x : α) => ↑(ceil x)) (nhds_within (↑n) (set.Iic ↑n))
        (nhds_within (↑n) (set.Iic ↑n)) :=
  sorry

theorem tendsto_floor_left {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] (n : ℤ) :
    filter.tendsto (fun (x : α) => ↑(floor x)) (nhds_within (↑n) (set.Iio ↑n))
        (nhds_within (↑n - 1) (set.Iic (↑n - 1))) :=
  sorry

theorem tendsto_ceil_right {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] (n : ℤ) :
    filter.tendsto (fun (x : α) => ↑(ceil x)) (nhds_within (↑n) (set.Ioi ↑n))
        (nhds_within (↑n + 1) (set.Ici (↑n + 1))) :=
  sorry

theorem tendsto_floor_left' {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] (n : ℤ) :
    filter.tendsto (fun (x : α) => ↑(floor x)) (nhds_within (↑n) (set.Iio ↑n)) (nhds (↑n - 1)) :=
  sorry

theorem tendsto_ceil_right' {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] (n : ℤ) :
    filter.tendsto (fun (x : α) => ↑(ceil x)) (nhds_within (↑n) (set.Ioi ↑n)) (nhds (↑n + 1)) :=
  sorry

theorem continuous_on_fract {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [topological_add_group α] (n : ℤ) :
    continuous_on fract (set.Ico (↑n) (↑n + 1)) :=
  continuous_on.sub continuous_on_id (continuous_on_floor n)

theorem tendsto_fract_left' {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] [topological_add_group α] (n : ℤ) :
    filter.tendsto fract (nhds_within (↑n) (set.Iio ↑n)) (nhds 1) :=
  sorry

theorem tendsto_fract_left {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] [topological_add_group α] (n : ℤ) :
    filter.tendsto fract (nhds_within (↑n) (set.Iio ↑n)) (nhds_within 1 (set.Iio 1)) :=
  tendsto_nhds_within_of_tendsto_nhds_of_eventually_within fract (tendsto_fract_left' n)
    (filter.eventually_of_forall fract_lt_one)

theorem tendsto_fract_right' {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] [topological_add_group α] (n : ℤ) :
    filter.tendsto fract (nhds_within (↑n) (set.Ici ↑n)) (nhds 0) :=
  sorry

theorem tendsto_fract_right {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] [order_closed_topology α] [topological_add_group α] (n : ℤ) :
    filter.tendsto fract (nhds_within (↑n) (set.Ici ↑n)) (nhds_within 0 (set.Ici 0)) :=
  tendsto_nhds_within_of_tendsto_nhds_of_eventually_within fract (tendsto_fract_right' n)
    (filter.eventually_of_forall fract_nonneg)

theorem continuous_on.comp_fract' {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] {β : Type u_2} {γ : Type u_3} [order_topology α] [topological_add_group α]
    [topological_space β] [topological_space γ] {f : β → α → γ}
    (h : continuous_on (function.uncurry f) (set.prod set.univ (set.Icc 0 1)))
    (hf : ∀ (s : β), f s 0 = f s 1) :
    continuous fun (st : β × α) => f (prod.fst st) (fract (prod.snd st)) :=
  sorry

theorem continuous_on.comp_fract {α : Type u_1} [linear_ordered_ring α] [floor_ring α]
    [topological_space α] {β : Type u_2} [order_topology α] [topological_add_group α]
    [topological_space β] {f : α → β} (h : continuous_on f (set.Icc 0 1)) (hf : f 0 = f 1) :
    continuous (f ∘ fract) :=
  sorry

end Mathlib


/-
Copyright (c) 2021 Chris Birkbeck. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Birkbeck
-/
import data.setoid.basic
import group_theory.subgroup.basic
import group_theory.coset
import group_theory.subgroup.pointwise
import data.set.basic
import tactic.group

/-!
# Double cosets

This file defines double cosets for two subgroups `H K` of a group `G` and the quotient of `G` by
the double coset relation, i.e. `H \ G / K`. We also prove that `G` can be writen as a disjoint
union of the double cosets and that if one of `H` or `K` is the trivial group (i.e. `⊥` ) then
this is the usual left or right quotient of a group by a subgroup.

## Main definitions

* `rel`: The double coset relation defined by two subgroups `H K` of `G`.
* `double_coset.quotient`: The quotient of `G` by the double coset relation, i.e, ``H \ G / K`.
-/

variables {G : Type*} [group G] {α : Type*} [has_mul α] (J: subgroup G) (g : G)

namespace doset

open_locale pointwise

/--The double_coset as an element of `set α` corresponding to `s a t` -/
def _root_.doset (a : α) (s t : set α) : set α := s * {a} * t

lemma mem_doset {s t : set α} {a b : α} : b ∈ doset a s t ↔ ∃ (x ∈ s) (y ∈ t), b = x * a * y :=
⟨λ ⟨_, y, ⟨x, _, hx, rfl, rfl⟩, hy, h⟩, ⟨x, hx, y, hy, h.symm⟩,
  λ ⟨x, hx, y, hy, h⟩, ⟨x * a, y, ⟨x, a, hx, rfl, rfl⟩, hy, h.symm⟩⟩

lemma mem_doset_self (H K : subgroup G) (a : G) : a ∈ doset a H K :=
mem_doset.mpr ⟨1, H.one_mem, 1, K.one_mem, (one_mul a).symm.trans (mul_one (1 * a)).symm⟩

lemma doset_eq_of_mem {H K : subgroup G} {a b : G} (hb : b ∈ doset a H K) :
  doset b H K = doset a H K :=
begin
  obtain ⟨_, k, ⟨h, a, hh, (rfl : _ = _), rfl⟩, hk, rfl⟩ := hb,
  rw [doset, doset, ←set.singleton_mul_singleton, ←set.singleton_mul_singleton, mul_assoc,
    mul_assoc, subgroup.singleton_mul_subgroup hk, ←mul_assoc, ←mul_assoc,
    subgroup.subgroup_mul_singleton hh],
end

lemma mem_doset_of_not_disjoint {H K : subgroup G} {a b : G}
  (h : ¬ disjoint (doset a H K) (doset b H K)) : b ∈ doset a H K :=
begin
  rw set.not_disjoint_iff at h,
  simp only [mem_doset] at *,
  obtain ⟨x, ⟨l, hl, r, hr, hrx⟩, y, hy, ⟨r', hr', rfl⟩⟩ := h,
  refine ⟨y⁻¹ * l, H.mul_mem (H.inv_mem hy) (hl), r * r'⁻¹, K.mul_mem hr (K.inv_mem hr'), _⟩,
  rwa [mul_assoc, mul_assoc, eq_inv_mul_iff_mul_eq, ←mul_assoc, ←mul_assoc, eq_mul_inv_iff_mul_eq],
end

lemma eq_of_not_disjoint {H K : subgroup G} {a b : G} (h: ¬ disjoint (doset a H K) (doset b H K)) :
  doset a H K = doset b H K :=
begin
  rw disjoint.comm at h,
  have ha : a ∈ doset b H K := mem_doset_of_not_disjoint h,
  apply doset_eq_of_mem ha,
end

/-- The setoid defined by the double_coset relation -/
def setoid (H K : set G) : setoid G :=
setoid.ker (λ x, doset x H K)

/-- Quotient of `G` by the double coset relation, i.e. `H \ G / K` -/
def quotient (H K : set G) : Type* :=
quotient (setoid H K)

lemma rel_iff {H K : subgroup G} {x y : G} :
  (setoid ↑H ↑K).rel x y ↔ ∃ (a ∈ H) (b ∈ K), y = a * x * b :=
iff.trans ⟨λ hxy, (congr_arg _ hxy).mpr (mem_doset_self H K y),
  λ hxy, (doset_eq_of_mem hxy).symm⟩ mem_doset

lemma bot_rel_eq_left_rel (H : subgroup G) :
  (setoid ↑(⊥ : subgroup G) ↑H).rel = (quotient_group.left_rel H).rel :=
begin
  ext a b,
  rw rel_iff,
  split,
  { rintros ⟨a, (rfl : a = 1), b, hb, rfl⟩,
    change a⁻¹ * (1 * a * b) ∈ H,
    rwa [one_mul, inv_mul_cancel_left] },
  { rintro (h : a⁻¹ * b ∈ H),
    exact ⟨1, rfl, a⁻¹ * b, h, by rw [one_mul, mul_inv_cancel_left]⟩ },
end

lemma rel_bot_eq_right_group_rel (H : subgroup G) :
  (setoid ↑H ↑(⊥ : subgroup G)).rel = (quotient_group.right_rel H).rel :=
begin
  ext a b,
  rw rel_iff,
  split,
  { rintros ⟨b, hb, a, (rfl : a = 1), rfl⟩,
    change b * a * 1 * a⁻¹ ∈ H,
    rwa [mul_one, mul_inv_cancel_right] },
  { rintro (h : b * a⁻¹ ∈ H),
    exact ⟨b * a⁻¹, h, 1, rfl, by rw [mul_one, inv_mul_cancel_right]⟩ },
end

/--Create a doset out of an element of `H \ G / K`-/
def quot_to_doset (H K : subgroup G) (q : quotient ↑H ↑K) : set G := (doset q.out' H K)

/--Map from `G` to `H \ G / K`-/
abbreviation mk (H K : subgroup G) (a : G) : quotient ↑H ↑K :=
quotient.mk' a

instance (H K : subgroup G) : inhabited (quotient ↑H ↑K) := ⟨mk H K (1 : G)⟩

lemma eq (H K : subgroup G) (a b : G) : mk H K a = mk H K b ↔ ∃ (h ∈ H) (k ∈ K), b = h * a * k :=
by { rw quotient.eq', apply rel_iff, }

lemma out_eq' (H K : subgroup G) (q : quotient ↑H ↑K) : mk H K q.out' = q :=
quotient.out_eq' q

lemma mk_out'_eq_mul (H K : subgroup G) (g : G) :
  ∃ (h k : G), (h ∈ H) ∧ (k ∈ K) ∧ (mk H K g : quotient ↑H ↑K).out' = h * g * k :=
begin
have := eq H K (mk H K g : quotient ↑H ↑K).out' g,
  rw out_eq' at this,
  obtain ⟨h, h_h, k, hk, T⟩ := this.1 rfl,
  refine ⟨h⁻¹, k⁻¹, (H.inv_mem h_h), K.inv_mem hk, eq_mul_inv_of_mul_eq (eq_inv_mul_of_mul_eq _)⟩,
  rw [← mul_assoc, ← T]
end

lemma mk_eq_of_doset_eq {H K : subgroup G} {a b : G} (h : doset a H K = doset b H K) :
  mk H K a = mk H K b :=
begin
  rw eq,
  exact mem_doset.mp (h.symm ▸ mem_doset_self H K b)
end

lemma disjoint_out' {H K : subgroup G} {a b : quotient H.1 K} :
  a ≠ b → disjoint (doset a.out' H K) (doset b.out' H K) :=
begin
  contrapose!,
  intro h,
  simpa [out_eq'] using mk_eq_of_doset_eq (eq_of_not_disjoint  h),
end

lemma union_quot_to_doset (H K : subgroup G) : (⋃ q, quot_to_doset H K q) = set.univ :=
begin
  ext x,
  simp only [set.mem_Union, quot_to_doset, mem_doset, set_like.mem_coe, exists_prop,
    set.mem_univ, iff_true],
  use mk H K x,
  obtain ⟨h, k, h3, h4, h5⟩ := mk_out'_eq_mul H K x,
  refine ⟨h⁻¹, H.inv_mem h3, k⁻¹, K.inv_mem h4, _⟩,
  simp only [h5, subgroup.coe_mk, ←mul_assoc, one_mul, mul_left_inv, mul_inv_cancel_right],
end

lemma doset_union_right_coset (H K : subgroup G) (a : G) :
  (⋃ (k : K), right_coset ↑H (a * k)) = doset a H K :=
begin
  ext x,
  simp only [mem_right_coset_iff, exists_prop, mul_inv_rev, set.mem_Union, mem_doset,
  subgroup.mem_carrier, set_like.mem_coe],
  split,
  {rintro ⟨y, h_h⟩,
    refine ⟨x * (y⁻¹ * a⁻¹), h_h, y, y.2, _⟩,
    simp only [← mul_assoc, subgroup.coe_mk, inv_mul_cancel_right]},
  {rintros ⟨x, hx, y, hy, hxy⟩,
    refine ⟨⟨y,hy⟩,_⟩,
    simp only [hxy, ←mul_assoc, hx, mul_inv_cancel_right, subgroup.coe_mk]},
end

lemma doset_union_left_coset (H K : subgroup G) (a : G) :
  (⋃ (h : H), left_coset (h * a : G) K) = doset a H K :=
begin
  ext x,
  simp only [mem_left_coset_iff, mul_inv_rev, set.mem_Union, mem_doset],
  split,
  { rintro ⟨y, h_h⟩,
    refine ⟨y, y.2, a⁻¹ * y⁻¹ * x, h_h, _⟩,
    simp only [←mul_assoc, one_mul, mul_right_inv, mul_inv_cancel_right]},
  { rintros ⟨x, hx, y, hy, hxy⟩,
    refine ⟨⟨x, hx⟩, _⟩,
    simp only [hxy, ←mul_assoc, hy, one_mul, mul_left_inv, subgroup.coe_mk, inv_mul_cancel_right]},
  end

lemma left_bot_eq_left_quot (H : subgroup G) :
  quotient (⊥ : subgroup G).1 H = (G ⧸ H) :=
begin
  unfold quotient,
  congr,
  ext,
  simp_rw ← bot_rel_eq_left_rel H,
  refl,
end

lemma right_bot_eq_right_quot (H : subgroup G) :
  quotient H.1 (⊥ : subgroup G) = _root_.quotient (quotient_group.right_rel H) :=
begin
  unfold quotient,
  congr,
  ext,
  simp_rw ← rel_bot_eq_right_group_rel H,
  refl,
end

end doset