import tactic

inductive Form : Type
| atom : ℕ → Form
| tensor : Form → Form → Form
| par : Form → Form → Form
| neg : Form → Form

infix ` ⊗ `:70 := Form.tensor
infix ` ⅋ `:65 := Form.par
prefix `~` := Form.neg

theorem not_self_dual {A} : A ≠ ~A :=
begin
  intro e,
  apply_fun Form.sizeof at e,
  refine ne_of_lt _ e,
  rw [Form.sizeof, nat.add_comm], exact nat.lt_succ_self _ ,
end

theorem not_self_sub_left_tensor {A B} : A ≠ A ⊗ B :=
begin
  intro e,
  apply_fun Form.sizeof at e,
  refine ne_of_lt _ e,
  rw [Form.sizeof, nat.add_comm],
  apply nat.lt_of_succ_le,
  rw nat.add_comm, rw nat.add_comm 1,
  apply nat.le_add_right,
end

theorem not_self_sub_right_tensor {A B} : B ≠ A ⊗ B :=
begin
  intro e,
  apply_fun Form.sizeof at e,
  refine ne_of_lt _ e,
  rw [Form.sizeof, nat.add_comm],
  apply nat.lt_of_succ_le,
  rw [←nat.add_assoc],
  apply nat.le_add_right,
end

theorem not_self_sub_left_par {A B} : A ≠ A ⅋ B :=
begin
  intro e,
  apply_fun Form.sizeof at e,
  refine ne_of_lt _ e,
  rw [Form.sizeof, nat.add_comm],
  apply nat.lt_of_succ_le,
  rw nat.add_comm, rw nat.add_comm 1,
  apply nat.le_add_right,
end

theorem not_self_sub_right_par {A B} : B ≠ A ⅋ B :=
begin
  intro e,
  apply_fun Form.sizeof at e,
  refine ne_of_lt _ e,
  rw [Form.sizeof, nat.add_comm],
  apply nat.lt_of_succ_le,
  rw [←nat.add_assoc],
  apply nat.le_add_right,
end

inductive Link : Type
| ax : ℕ → ℕ → Form → Link
| cut : ℕ → ℕ → Form → Link
| tensor : ℕ → ℕ → ℕ → Form → Form → Link
| par : ℕ → ℕ → ℕ → Form → Form → Link
| con : ℕ → Form → Link

def Form_occ := Form × ℕ

def is_premise (Ai : Form_occ) : Link → Prop
| (Link.ax n m B) := false
| (Link.cut n m B) := (Ai = ⟨B,n⟩) ∨ (Ai = ⟨~B,m⟩)
| (Link.tensor n m k A B) := (Ai = ⟨A,n⟩) ∨ (Ai = ⟨B,m⟩)
| (Link.par n m k A B) := (Ai = ⟨A,n⟩) ∨ (Ai = ⟨B,m⟩)
| (Link.con n A) := Ai = ⟨A,n⟩

def is_conclusion (Ai : Form_occ) : Link → Prop
| (Link.ax n m B) := (Ai = ⟨B,n⟩) ∨ (Ai = ⟨~B,m⟩)
| (Link.cut n m B) := false
| (Link.tensor n m k A B) := Ai = ⟨A ⊗ B,k⟩
| (Link.par n m k A B) := Ai = ⟨A ⅋ B,k⟩
| (Link.con n A) := false

inductive valid_link : Link → Prop
| ax  (i j A) : valid_link (Link.ax i j A)
| cut (i j A) : valid_link (Link.cut i j A)
| tensor (i j k A B) : (A,i) ≠ (B,j) → valid_link (Link.tensor i j k A B)
| par (i j k A B) : (A,i) ≠ (B,j) → valid_link (Link.par i j k A B)
| con (i A) : valid_link (Link.con i A)

structure proof_structure : Type :=
(links : set Link)
(valid : ∀ l ∈ links, valid_link l)
(form_occs : set Form_occ)
(link_prem : ∀ l ∈ links, ∀ Ai : Form_occ, is_premise Ai l → Ai ∈ form_occs)
(link_con : ∀ l ∈ links, ∀ Ai : Form_occ, is_conclusion Ai l → Ai ∈ form_occs)
(premise : Form_occ → Link)
(prem_unique : ∀ Ai ∈ form_occs, ∀ l ∈ links, is_premise Ai l → premise Ai = l)
(prem_range : ∀ Ai ∈ form_occs, premise Ai ∈ links ∧ is_premise Ai (premise Ai))
(conclusion : Form_occ → Link)
(con_unique : ∀ Ai ∈ form_occs, ∀ l ∈ links, is_conclusion Ai l → conclusion Ai = l)
(con_range : ∀ Ai ∈ form_occs, conclusion Ai ∈ links ∧ is_conclusion Ai (conclusion Ai))

@[reducible]
def dir := bool

@[pattern] def down := ff
@[pattern] def up := tt

@[pattern] def with_down (Ai : Form_occ) := (Ai,down)
@[pattern] def with_up (Ai : Form_occ) := (Ai,up)
postfix `↓`:max_plus := with_down
postfix `↑`:max_plus := with_up

@[reducible]
def switch := bool

@[reducible, pattern] def L := ff
@[reducible, pattern] def R := tt

def switching := Link → switch

@[simp]
def switch.flip {α β} (f : α → α → β) : switch → α → α → β
| L a b := f a b
| R a b := f b a

@[simp] lemma flip_L {α β} {f : α → α → β} {a b} : switch.flip f L a b = f a b := rfl
@[simp] lemma flip_R {α β} {f : α → α → β} {a b} : switch.flip f R a b = f b a := rfl

inductive steps_tensor (Ai Bi Ci : Form_occ) : Form_occ × dir → Form_occ × dir → Prop
| down : steps_tensor Ai↓ Ci↓
| turn : steps_tensor Bi↓ Ai↑
| up : steps_tensor Ci↑ Bi↑

inductive steps_par (Ai Bi Ci : Form_occ) : Form_occ × dir → Form_occ × dir → Prop
| down : steps_par Ai↓ Ci↓
| turn : steps_par Bi↓ Bi↑
| up : steps_par Ci↑ Ai↑

inductive dual (A : Form) (ai ni : ℕ) : Form_occ → Form_occ → Prop
| posneg : dual (A,ai) (~A,ni)
| negpos : dual (~A,ni) (A,ai)

inductive steps (T : switch) : Link → Form_occ × dir → Form_occ × dir → Prop
| ax  (A : Form) (ai ni : ℕ) (Bi Ci) : dual A ai ni Bi Ci → steps (Link.ax ai ni A) Bi↑ Ci↓
| cut (A : Form) (ai ni : ℕ) (Bi Ci) : dual A ai ni Bi Ci → steps (Link.cut ai ni A) Bi↓ Ci↑
| con (A : Form) (ai : ℕ)            : steps (Link.con ai A) (A, ai)↓ (A,ai)↑
| tensor (A B : Form) (ai bi ci : ℕ) (x y) :
  T.flip steps_tensor (A, ai) (B, bi) (A ⊗ B, ci) x y →
  steps (Link.tensor ai bi ci A B) x y
| par (A B : Form) (ai bi ci : ℕ) (x y) :
  T.flip steps_par (A, ai) (B, bi) (A ⅋ B, ci) x y →
  steps (Link.par ai bi ci A B) x y

theorem dual_unique_prev {A ai ni Bi Ci Di}
  (d₁ : dual A ai ni Bi Ci) (d₂ : dual A ai ni Di Ci) : Bi = Di :=
begin
  generalize_hyp e : Ci = Ci' at d₂,
  have : A ≠ ~A,
  { intro e,
    apply_fun Form.sizeof at e,
    refine ne_of_lt _ e,
    rw [Form.sizeof, nat.add_comm], exact nat.lt_succ_self _ },
  cases d₁; cases d₂; injection e with e1 e2; cases e2;
  try { cases e1 }; [refl, cases this e1.symm, cases this e1, refl]
end

theorem steps_tensor_unique_prev (Ai Bi Ci : Form_occ) (X Y Z) : Ai ≠ Bi → Bi ≠ Ci → Ai ≠ Ci → steps_tensor Ai Bi Ci X Z → steps_tensor Ai Bi Ci Y Z → X = Y :=
begin
  intros _ _ _ s₁ s₂,
  cases s₁; cases s₂; try {refl}; try {contradiction},
end

theorem steps_tensor_unique_next (Ai Bi Ci : Form_occ) (X Y Z) : Ai ≠ Bi → Bi ≠ Ci → Ai ≠ Ci → steps_tensor Ai Bi Ci X Y → steps_tensor Ai Bi Ci X Z → Y = Z :=
begin
  intros _ _ _ s₁ s₂,
  cases s₁; cases s₂; try {refl}; try {contradiction},
end

theorem steps_par_unique_prev (Ai Bi Ci : Form_occ) (X Y Z) : Ai ≠ Bi → Bi ≠ Ci → Ai ≠ Ci → steps_par Ai Bi Ci X Z → steps_par Ai Bi Ci Y Z → X = Y :=
begin
  intros _ _ _ s₁ s₂,
  cases s₁; cases s₂; try {refl}; try {contradiction},
end

theorem steps_par_unique_next (Ai Bi Ci : Form_occ) (X Y Z) : Ai ≠ Bi → Bi ≠ Ci → Ai ≠ Ci → steps_par Ai Bi Ci X Y → steps_par Ai Bi Ci X Z → Y = Z :=
begin
  intros _ _ _ s₁ s₂,
  cases s₁; cases s₂; try {refl}; try {contradiction},
end

theorem steps_unique_prev {T : switch} {Δ : Link} {X Y Z} : valid_link Δ → steps T Δ X Z → steps T Δ Y Z → X = Y :=
begin
  intros hΔ s₁ s₂,
  cases s₁,
  case steps.ax : A ai ni Bi Ci d₁ {
    cases s₂ with _ _ _ Di _ d₂,
    rw dual_unique_prev d₁ d₂ },
  case steps.cut : A ai ni Bi Ci d₁ {
    rcases s₂ with _ | ⟨_,_,_,Di,_,d₂⟩,
    rw dual_unique_prev d₂ d₁
  },
  case steps.con : A ai { cases s₂, refl },
  case steps.tensor : A B ai bi ci X y t₁ {
    rcases s₂ with _ | _ | _ | ⟨_,_,_,_,_,_,_,t₂⟩,
    cases T; simp at t₁ t₂;
    apply steps_tensor_unique_prev _ _ _ _ _ _ _ _ _ t₁ t₂;
    cases hΔ, finish,
    intro e, injection e with e1,
    exact not_self_sub_right_tensor e1,
    intro e, injection e with e1,
    exact not_self_sub_left_tensor e1,
    finish,
    intro e, injection e with e1,
    exact not_self_sub_left_tensor e1,
    intro e, injection e with e1,
    exact not_self_sub_right_tensor e1,
  },
  case steps.par : A B ai bi ci X y p₁ {
    rcases s₂ with _ | _ | _ | _ | ⟨_,_,_,_,_,_,_,p₂⟩,
    cases T; simp at p₁ p₂;
    apply steps_par_unique_prev _ _ _ _ _ _ _ _ _ p₁ p₂;
    cases hΔ, finish,
    intro e, injection e with e1,
    exact not_self_sub_right_par e1,
    intro e, injection e with e1,
    exact not_self_sub_left_par e1,
    finish,
    intro e, injection e with e1,
    exact not_self_sub_left_par e1,
    intro e, injection e with e1,
    exact not_self_sub_right_par e1,
  },
end

inductive trip (ps : proof_structure) (S : switching) : list (Form_occ × dir) → Prop
| emp : trip []
| single (Ai : Form_occ) (d : dir) : Ai ∈ ps.form_occs → trip [(Ai,d)]
| consup (Ai Bi : Form_occ) (d : dir) (Γ : list (Form_occ × dir)) : Ai ∈ ps.form_occs → (steps (S (ps.premise Bi)) (ps.premise Bi) (Ai,d) Bi↑) → trip (Bi↑ :: Γ) → trip ((Ai,d) :: Bi↑ :: Γ)
| consdown (Ai Bi : Form_occ) (d : dir) (Γ : list (Form_occ × dir)) : Ai ∈ ps.form_occs → (steps (S (ps.conclusion Bi)) (ps.conclusion Bi) (Ai,d) Bi↓) → trip (Bi↓ :: Γ) → trip ((Ai,d) :: Bi↓ :: Γ)

theorem trip_in_form_occs {ps : proof_structure} (S : switching) (Γ : list (Form_occ × dir)): trip ps S Γ → ∀ Ai d, (Ai,d) ∈ Γ → Ai ∈ ps.form_occs :=
begin
  induction Γ,
  intros _ _ _ h, cases h,
  intros t Ai d h,
  case list.cons : Ai Γ ih {
    cases t with Bi d₁ hB Ci Di d₂ Γ hC s₁ t₁ Ci Di d₂ Γ hC s₁ t₁,
    { cases h; cases h, assumption, },
    repeat { cases h; cases h, assumption, apply ih t₁, constructor, exact h, apply ih t₁, right, exact h, },
  }
end

theorem premise_valid_link {ps : proof_structure} : ∀ {Ai ∈ ps.form_occs}, valid_link (ps.premise Ai) :=
  λ A hA, ps.valid _ (ps.prem_range _ hA).1

theorem conclusion_valid_link {ps : proof_structure} : ∀ {Ai ∈ ps.form_occs}, valid_link (ps.conclusion Ai) :=
  λ A hA, ps.valid _ (ps.con_range _ hA).1

theorem trip_unique_cons (ps : proof_structure) (S : switching) (t : list (Form_occ × dir)) (nnil : t ≠ []) (Ai Bi : Form_occ) (d₁ d₂ : dir) : trip ps S ((Ai,d₁)::t) → trip ps S ((Bi,d₂)::t) → (Ai,d₁) = (Bi,d₂) :=
begin
  intros tA tB,
  cases t with Cid t, contradiction,
  cases d₁,
  cases d₂,
  repeat {
    rcases tA with _ | _ | ⟨_,Ci,_,_,hA,sAC,t₁⟩ | ⟨_,Ci,_,_,hA,sAC,t₁⟩,
    rcases tB with _ | _ | ⟨_,_,_,_,hB,sBC,t₂⟩,
    apply steps_unique_prev _ sAC sBC,
    apply premise_valid_link,
    apply trip_in_form_occs _ _ t₂, left, refl,
    rcases tB with _ | _ | _ | ⟨_,Ci,_,_,hB,sBC,t₂⟩,
    apply steps_unique_prev _ sAC sBC,
    apply conclusion_valid_link,
    apply trip_in_form_occs _ _ t₂, left, refl },
end

theorem trip_unique (ps : proof_structure) (S : switching) (t : list (Form_occ × dir)) (nnil : t ≠ []) (Ai Bi : Form_occ) (d₁ d₂ : dir) : trip ps S ((Ai,d₁)::t) → trip ps S ((Bi,d₂)::t) →

def length_non_nil {α} (p : list α) : length p > 1 → p ≠ [] :=
begin
intros ip, intro h,
rw h at ip, have : nil.length = 0, trivial, rw this at ip, cases ip,
end

def cycle_trip (ps : proof_structure) (S : switching) (Ai : Form_occ) (d : dir) (p : list (Form_occ × dir)) (ip : p ≠ []) : Prop := trip ps S (⟨Ai,d⟩::p) ∧ steps (S )(last p ip)

def rotate {α} (l : list α) (n : ℕ) := drop n l ++ take n l

def cycle_equiv {α} (l1 l2 : list α) := ∃ n : ℕ, rotate l1 n = l2

def longtrip (ps : proof_structure) (S1 S2 : switching) (p1 p2 : list (Form_occ × dir)) (ip1 : length p1 > 1) (ip2 : length p2 > 1) : Prop :=
  cycle_trip ps S1 p1 ip1 →
  cycle_trip ps S2 p2 ip2 → cycle_equiv p1 p2

-- theorem tensor_rotate

def ax_cut (A : Form) : proof_structure :=
{links := {Link.ax 0 1 A, Link.cut 0 1 A},
form_occs := {⟨A,0⟩, ⟨~A,1⟩},
link_prem :=
  begin
    intros l hl Ai hp,
    cases hl,
    rw hl at hp,
    cases hp,
    cases hl,
    cases hp; finish,
  end,
link_con :=
  begin
    intros l hl Ai hc,
    cases hl,
    rw hl at hc,
    cases hc; finish,
    cases hl,
    cases hc; finish,
  end,
premise := (λ Ai, Link.cut 0 1 A),
prem_unique :=
  begin
    intros Ai hA l hl pl,
    cases hl, rw hl at pl, cases pl; finish,
    cases hl, cases pl; finish,
  end,
prem_range :=
  begin
  intros Ai hA,
  split, finish,
  cases hA,
    left, exact hA,
  right, cases hA, refl,
  end,
conclusion := λ Ai, Link.ax 0 1 A,
con_unique :=
  begin
    intros Ai hA l hl cl,
    cases hA,
    cases hl, finish,
    cases hl, cases cl,
    cases hA,
    cases hl, finish,
    cases hl, cases cl
    end,
con_range := by intros; finish}


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Justus Springer
-/
import order.complete_lattice
import data.fintype.lattice
import category_theory.limits.shapes.pullbacks
import category_theory.category.preorder
import category_theory.limits.shapes.products
import category_theory.limits.shapes.finite_limits

/-!
# Limits in lattice categories are given by infimums and supremums.

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

universes w u

open category_theory
open category_theory.limits

namespace category_theory.limits.complete_lattice

section semilattice

variables {α : Type u}

variables {J : Type w} [small_category J] [fin_category J]

/--
The limit cone over any functor from a finite diagram into a `semilattice_inf` with `order_top`.
-/
def finite_limit_cone [semilattice_inf α] [order_top α] (F : J ⥤ α) : limit_cone F :=
{ cone :=
  { X := finset.univ.inf F.obj,
    π := { app := λ j, hom_of_le (finset.inf_le (fintype.complete _)) } },
  is_limit := { lift := λ s, hom_of_le (finset.le_inf (λ j _, (s.π.app j).down.down)) } }

/--
The colimit cocone over any functor from a finite diagram into a `semilattice_sup` with `order_bot`.
-/
def finite_colimit_cocone [semilattice_sup α] [order_bot α] (F : J ⥤ α) : colimit_cocone F :=
{ cocone :=
  { X := finset.univ.sup F.obj,
    ι := { app := λ i, hom_of_le (finset.le_sup (fintype.complete _)) } },
  is_colimit := { desc := λ s, hom_of_le (finset.sup_le (λ j _, (s.ι.app j).down.down)) } }

@[priority 100] -- see Note [lower instance priority]
instance has_finite_limits_of_semilattice_inf_order_top [semilattice_inf α] [order_top α] :
  has_finite_limits α :=
⟨λ J 𝒥₁ 𝒥₂, by exactI { has_limit := λ F, has_limit.mk (finite_limit_cone F) }⟩

@[priority 100] -- see Note [lower instance priority]
instance has_finite_colimits_of_semilattice_sup_order_bot [semilattice_sup α] [order_bot α] :
  has_finite_colimits α :=
⟨λ J 𝒥₁ 𝒥₂, by exactI { has_colimit := λ F, has_colimit.mk (finite_colimit_cocone F) }⟩

/--
The limit of a functor from a finite diagram into a `semilattice_inf` with `order_top` is the
infimum of the objects in the image.
-/
lemma finite_limit_eq_finset_univ_inf [semilattice_inf α] [order_top α] (F : J ⥤ α) :
  limit F = finset.univ.inf F.obj :=
(is_limit.cone_point_unique_up_to_iso (limit.is_limit F)
  (finite_limit_cone F).is_limit).to_eq

/--
The colimit of a functor from a finite diagram into a `semilattice_sup` with `order_bot`
is the supremum of the objects in the image.
-/

/--
A finite product in the category of a `semilattice_inf` with `order_top` is the same as the infimum.
-/
lemma finite_product_eq_finset_inf [semilattice_inf α] [order_top α] {ι : Type u}
  [fintype ι] (f : ι → α) : (∏ f) = (fintype.elems ι).inf f :=
begin
  transitivity,
  exact (is_limit.cone_point_unique_up_to_iso (limit.is_limit _)
    (finite_limit_cone (discrete.functor f)).is_limit).to_eq,
  change finset.univ.inf (f ∘ discrete_equiv.to_embedding) = (fintype.elems ι).inf f,
  simp only [←finset.inf_map, finset.univ_map_equiv_to_embedding],
  refl,
end

/--
A finite coproduct in the category of a `semilattice_sup` with `order_bot` is the same as the
supremum.
-/
lemma finite_coproduct_eq_finset_sup [semilattice_sup α] [order_bot α] {ι : Type u}
  [fintype ι] (f : ι → α) : (∐ f) = (fintype.elems ι).sup f :=
begin
  transitivity,
  exact (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _)
    (finite_colimit_cocone (discrete.functor f)).is_colimit).to_eq,
  change finset.univ.sup (f ∘ discrete_equiv.to_embedding) = (fintype.elems ι).sup f,
  simp only [←finset.sup_map, finset.univ_map_equiv_to_embedding],
  refl,
end

@[priority 100] -- see Note [lower instance priority]
instance [semilattice_inf α] [order_top α] : has_binary_products α :=
begin
  haveI : ∀ (x y : α), has_limit (pair x y),
  { letI := has_finite_limits_of_has_finite_limits_of_size.{u} α, apply_instance },
  apply has_binary_products_of_has_limit_pair
end

/--
The binary product in the category of a `semilattice_inf` with `order_top` is the same as the
infimum.
-/
@[simp]
lemma prod_eq_inf [semilattice_inf α] [order_top α] (x y : α) : limits.prod x y = x ⊓ y :=
calc limits.prod x y = limit (pair x y) : rfl
... = finset.univ.inf (pair x y).obj : by rw finite_limit_eq_finset_univ_inf (pair.{u} x y)
... = x ⊓ (y ⊓ ⊤) : rfl -- Note: finset.inf is realized as a fold, hence the definitional equality
... = x ⊓ y : by rw inf_top_eq

@[priority 100] -- see Note [lower instance priority]
instance [semilattice_sup α] [order_bot α] : has_binary_coproducts α :=
begin
  haveI : ∀ (x y : α), has_colimit (pair x y),
  { letI := has_finite_colimits_of_has_finite_colimits_of_size.{u} α, apply_instance },
  apply has_binary_coproducts_of_has_colimit_pair
end

/--
The binary coproduct in the category of a `semilattice_sup` with `order_bot` is the same as the
supremum.
-/
@[simp]
lemma coprod_eq_sup [semilattice_sup α] [order_bot α] (x y : α) : limits.coprod x y = x ⊔ y :=
calc limits.coprod x y = colimit (pair x y) : rfl
... = finset.univ.sup (pair x y).obj : by rw finite_colimit_eq_finset_univ_sup (pair x y)
... = x ⊔ (y ⊔ ⊥) : rfl -- Note: finset.sup is realized as a fold, hence the definitional equality
... = x ⊔ y : by rw sup_bot_eq

/--
The pullback in the category of a `semilattice_inf` with `order_top` is the same as the infimum
over the objects.
-/
@[simp]
lemma pullback_eq_inf [semilattice_inf α] [order_top α] {x y z : α} (f : x ⟶ z) (g : y ⟶ z) :
  pullback f g = x ⊓ y :=
calc pullback f g = limit (cospan f g) : rfl
... = finset.univ.inf (cospan f g).obj : by rw finite_limit_eq_finset_univ_inf
... = z ⊓ (x ⊓ (y ⊓ ⊤)) : rfl
... = z ⊓ (x ⊓ y) : by rw inf_top_eq
... = x ⊓ y : inf_eq_right.mpr (inf_le_of_left_le f.le)

/--
The pushout in the category of a `semilattice_sup` with `order_bot` is the same as the supremum
over the objects.
-/
@[simp]
lemma pushout_eq_sup [semilattice_sup α] [order_bot α] (x y z : α) (f : z ⟶ x) (g : z ⟶ y) :
  pushout f g = x ⊔ y :=
calc pushout f g = colimit (span f g) : rfl
... = finset.univ.sup (span f g).obj : by rw finite_colimit_eq_finset_univ_sup
... = z ⊔ (x ⊔ (y ⊔ ⊥)) : rfl
... = z ⊔ (x ⊔ y) : by rw sup_bot_eq
... = x ⊔ y : sup_eq_right.mpr (le_sup_of_le_left f.le)

end semilattice

variables {α : Type u} [complete_lattice α]
variables {J : Type u} [small_category J]

/--
The limit cone over any functor into a complete lattice.
-/
def limit_cone (F : J ⥤ α) : limit_cone F :=
{ cone :=
  { X := infi F.obj,
    π :=
    { app := λ j, hom_of_le (complete_lattice.Inf_le _ _ (set.mem_range_self _)) } },
  is_limit :=
  { lift := λ s, hom_of_le (complete_lattice.le_Inf _ _
    begin rintros _ ⟨j, rfl⟩, exact (s.π.app j).le, end) } }

/--
The colimit cocone over any functor into a complete lattice.
-/
def colimit_cocone (F : J ⥤ α) : colimit_cocone F :=
{ cocone :=
  { X := supr F.obj,
    ι :=
    { app := λ j, hom_of_le (complete_lattice.le_Sup _ _ (set.mem_range_self _)) } },
  is_colimit :=
  { desc := λ s, hom_of_le (complete_lattice.Sup_le _ _
    begin rintros _ ⟨j, rfl⟩, exact (s.ι.app j).le, end) } }

-- It would be nice to only use the `Inf` half of the complete lattice, but
-- this seems not to have been described separately.
@[priority 100] -- see Note [lower instance priority]
instance has_limits_of_complete_lattice : has_limits α :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit.mk (limit_cone F) } }

@[priority 100] -- see Note [lower instance priority]
instance has_colimits_of_complete_lattice : has_colimits α :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk (colimit_cocone F) } }

/--
The limit of a functor into a complete lattice is the infimum of the objects in the image.
-/
lemma limit_eq_infi (F : J ⥤ α) : limit F = infi F.obj :=
(is_limit.cone_point_unique_up_to_iso (limit.is_limit F)
  (limit_cone F).is_limit).to_eq

/--
The colimit of a functor into a complete lattice is the supremum of the objects in the image.
-/
lemma colimit_eq_supr (F : J ⥤ α) : colimit F = supr F.obj :=
(is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit F)
  (colimit_cocone F).is_colimit).to_eq

end category_theory.limits.complete_lattice


import rescale.normed_group
import polyhedral_lattice.category

/-!

# Rescaling the norm on a polyhedral lattice.

Rescaling the norm on a polyhedral lattice by a positive real factor gives a
polyhedral lattice (at least for us -- Scholze seem to demand a rationality
condition which we are missing).

-/

noncomputable theory
open_locale big_operators classical nnreal

namespace generates_norm

open rescale

variables (N : ℝ≥0) (Λ : Type*) [polyhedral_lattice Λ]
variables {J : Type*} [fintype J] (x : J → Λ) (hx : generates_norm x)

def rescale_generators : J → (rescale N Λ) := x

variables {Λ x}

include hx

lemma rescale [hN : fact (0 < N)] : generates_norm (rescale_generators N Λ x) :=
begin
  intro l,
  obtain ⟨c, H1, H2⟩ := hx l,
  refine ⟨c, H1, _⟩,
  simp only [norm_def, ← mul_div_assoc, ← finset.sum_div],
  congr' 1,
end

end generates_norm

namespace rescale

variables {N : ℝ≥0} {V : Type*}

instance (Λ : Type*) [hN : fact (0 < N)] [polyhedral_lattice Λ] :
  polyhedral_lattice (rescale N Λ) :=
{ finite := by { delta rescale, apply_instance },
  free   := by { delta rescale, apply_instance },
  polyhedral' :=
  begin
    obtain ⟨ι, _inst_ι, l, hl⟩ := polyhedral_lattice.polyhedral' Λ, resetI,
    refine ⟨ι, _inst_ι, l, hl.rescale N⟩,
  end }

end rescale

namespace PolyhedralLattice

@[simps] protected def rescale (N : ℝ≥0) [hN : fact (0 < N)] :
  PolyhedralLattice ⥤ PolyhedralLattice :=
{ obj := λ Λ, of (rescale N Λ),
  map := λ Λ₁ Λ₂ f,
  { to_fun := λ l, @rescale.of N Λ₂ (f ((@rescale.of N Λ₁).symm l)),
    map_add' := f.map_add, -- defeq abuse
    strict' := λ l,
    begin
      simp only [← coe_nnnorm, nnreal.coe_le_coe],
      erw [rescale.nnnorm_def, rescale.nnnorm_def], simp only [div_eq_mul_inv],
      exact mul_le_mul' (f.strict l) le_rfl
    end } }

end PolyhedralLattice


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.rcases
import Mathlib.PostPort

universes u v l w

namespace Mathlib

/-!
# lift tactic

This file defines the `lift` tactic, allowing the user to lift elements from one type to another
under a specified condition.

## Tags

lift, tactic
-/

/-- A class specifying that you can lift elements from `α` to `β` assuming `cond` is true.
  Used by the tactic `lift`. -/
class can_lift (α : Type u) (β : Type v)
where
  coe : β → α
  cond : α → Prop
  prf : ∀ (x : α), cond x → ∃ (y : β), coe y = x

/--
A user attribute used internally by the `lift` tactic.
This should not be applied by hand.
-/
protected instance nat.can_lift : can_lift ℤ ℕ :=
  can_lift.mk coe (fun (n : ℤ) => 0 ≤ n) sorry

/-- Enable automatic handling of pi types in `can_lift`. -/
protected instance pi.can_lift (ι : Type u) (α : ι → Type v) (β : ι → Type w) [(i : ι) → can_lift (α i) (β i)] : can_lift ((i : ι) → α i) ((i : ι) → β i) :=
  can_lift.mk (fun (f : (i : ι) → β i) (i : ι) => can_lift.coe (f i))
    (fun (f : (i : ι) → α i) => ∀ (i : ι), can_lift.cond (β i) (f i)) sorry

namespace tactic

/--
Construct the proof of `cond x` in the lift tactic.
*  `e` is the expression being lifted and `h` is the specified proof of `can_lift.cond e`.
*  `old_tp` and `new_tp` are the arguments to `can_lift` and `inst` is the `can_lift`-instance.
*  `s` and `to_unfold` contain the information of the simp set used to simplify.

If the proof was specified, we check whether it has the correct type.
If it doesn't have the correct type, we display an error message
(but first call dsimp on the expression in the message).

If the proof was not specified, we create assert it as a local constant.
(The name of this local constant doesn't matter, since `lift` will remove it from the context.)
-/
/-- Lift the expression `p` to the type `t`, with proof obligation given by `h`.
  The list `n` is used for the two newly generated names, and to specify whether `h` should
  remain in the local context. See the doc string of `tactic.interactive.lift` for more information.
  -/
/-- Parses an optional token "using" followed by a trailing `pexpr`. -/
/-- Parses a token "to" followed by a trailing `pexpr`. -/
namespace interactive

/--
Lift an expression to another type.
* Usage: `'lift' expr 'to' expr ('using' expr)? ('with' id (id id?)?)?`.
* If `n : ℤ` and `hn : n ≥ 0` then the tactic `lift n to ℕ using hn` creates a new
  constant of type `ℕ`, also named `n` and replaces all occurrences of the old variable `(n : ℤ)`
  with `↑n` (where `n` in the new variable). It will remove `n` and `hn` from the context.
  + So for example the tactic `lift n to ℕ using hn` transforms the goal
    `n : ℤ, hn : n ≥ 0, h : P n ⊢ n = 3` to `n : ℕ, h : P ↑n ⊢ ↑n = 3`
    (here `P` is some term of type `ℤ → Prop`).
* The argument `using hn` is optional, the tactic `lift n to ℕ` does the same, but also creates a
  new subgoal that `n ≥ 0` (where `n` is the old variable).
  + So for example the tactic `lift n to ℕ` transforms the goal
    `n : ℤ, h : P n ⊢ n = 3` to two goals
    `n : ℕ, h : P ↑n ⊢ ↑n = 3` and `n : ℤ, h : P n ⊢ n ≥ 0`.
* You can also use `lift n to ℕ using e` where `e` is any expression of type `n ≥ 0`.
* Use `lift n to ℕ with k` to specify the name of the new variable.
* Use `lift n to ℕ with k hk` to also specify the name of the equality `↑k = n`. In this case, `n`
  will remain in the context. You can use `rfl` for the name of `hk` to substitute `n` away
  (i.e. the default behavior).
* You can also use `lift e to ℕ with k hk` where `e` is any expression of type `ℤ`.
  In this case, the `hk` will always stay in the context, but it will be used to rewrite `e` in
  all hypotheses and the target.
  + So for example the tactic `lift n + 3 to ℕ using hn with k hk` transforms the goal
    `n : ℤ, hn : n + 3 ≥ 0, h : P (n + 3) ⊢ n + 3 = 2 * n` to the goal
    `n : ℤ, k : ℕ, hk : ↑k = n + 3, h : P ↑k ⊢ ↑k = 2 * n`.
* The tactic `lift n to ℕ using h` will remove `h` from the context. If you want to keep it,
  specify it again as the third argument to `with`, like this: `lift n to ℕ using h with n rfl h`.
* More generally, this can lift an expression from `α` to `β` assuming that there is an instance
  of `can_lift α β`. In this case the proof obligation is specified by `can_lift.cond`.
* Given an instance `can_lift β γ`, it can also lift `α → β` to `α → γ`; more generally, given
  `β : Π a : α, Type*`, `γ : Π a : α, Type*`, and `[Π a : α, can_lift (β a) (γ a)]`, it
  automatically generates an instance `can_lift (Π a, β a) (Π a, γ a)`.

`lift` is in some sense dual to the `zify` tactic. `lift (z : ℤ) to ℕ` will change the type of an
integer `z` (in the supertype) to `ℕ` (the subtype), given a proof that `z ≥ 0`;
propositions concerning `z` will still be over `ℤ`. `zify` changes propositions about `ℕ` (the
subtype) to propositions about `ℤ` (the supertype), without changing the type of any variable.
-/


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.module.equiv
import data.dfinsupp.basic
import data.finsupp.basic

/-!
# Conversion between `finsupp` and homogenous `dfinsupp`

This module provides conversions between `finsupp` and `dfinsupp`.
It is in its own file since neither `finsupp` or `dfinsupp` depend on each other.

## Main definitions

* "identity" maps between `finsupp` and `dfinsupp`:
  * `finsupp.to_dfinsupp : (ι →₀ M) → (Π₀ i : ι, M)`
  * `dfinsupp.to_finsupp : (Π₀ i : ι, M) → (ι →₀ M)`
  * Bundled equiv versions of the above:
    * `finsupp_equiv_dfinsupp : (ι →₀ M) ≃ (Π₀ i : ι, M)`
    * `finsupp_add_equiv_dfinsupp : (ι →₀ M) ≃+ (Π₀ i : ι, M)`
    * `finsupp_lequiv_dfinsupp R : (ι →₀ M) ≃ₗ[R] (Π₀ i : ι, M)`
* stronger versions of `finsupp.split`:
  * `sigma_finsupp_equiv_dfinsupp : ((Σ i, η i) →₀ N) ≃ (Π₀ i, (η i →₀ N))`
  * `sigma_finsupp_add_equiv_dfinsupp : ((Σ i, η i) →₀ N) ≃+ (Π₀ i, (η i →₀ N))`
  * `sigma_finsupp_lequiv_dfinsupp : ((Σ i, η i) →₀ N) ≃ₗ[R] (Π₀ i, (η i →₀ N))`

## Theorems

The defining features of these operations is that they preserve the function and support:

* `finsupp.to_dfinsupp_coe`
* `finsupp.to_dfinsupp_support`
* `dfinsupp.to_finsupp_coe`
* `dfinsupp.to_finsupp_support`

and therefore map `finsupp.single` to `dfinsupp.single` and vice versa:

* `finsupp.to_dfinsupp_single`
* `dfinsupp.to_finsupp_single`

as well as preserving arithmetic operations.

For the bundled equivalences, we provide lemmas that they reduce to `finsupp.to_dfinsupp`:

* `finsupp_add_equiv_dfinsupp_apply`
* `finsupp_lequiv_dfinsupp_apply`
* `finsupp_add_equiv_dfinsupp_symm_apply`
* `finsupp_lequiv_dfinsupp_symm_apply`

## Implementation notes

We provide `dfinsupp.to_finsupp` and `finsupp_equiv_dfinsupp` computably by adding
`[decidable_eq ι]` and `[Π m : M, decidable (m ≠ 0)]` arguments. To aid with definitional unfolding,
these arguments are also present on the `noncomputable` equivs.
-/

variables {ι : Type*} {R : Type*} {M : Type*}

/-! ### Basic definitions and lemmas -/
section defs

/-- Interpret a `finsupp` as a homogenous `dfinsupp`. -/
def finsupp.to_dfinsupp [has_zero M] (f : ι →₀ M) : Π₀ i : ι, M :=
⟦⟨f, f.support.1, λ i, (classical.em (f i = 0)).symm.imp_left (finsupp.mem_support_iff.mpr)⟩⟧

@[simp] lemma finsupp.to_dfinsupp_coe [has_zero M] (f : ι →₀ M) : ⇑f.to_dfinsupp = f := rfl

section
variables [decidable_eq ι] [has_zero M]

@[simp] lemma finsupp.to_dfinsupp_single (i : ι) (m : M) :
  (finsupp.single i m).to_dfinsupp = dfinsupp.single i m :=
by { ext, simp [finsupp.single_apply, dfinsupp.single_apply] }

variables [Π m : M, decidable (m ≠ 0)]

@[simp] lemma to_dfinsupp_support (f : ι →₀ M) : f.to_dfinsupp.support = f.support :=
by { ext, simp, }

/-- Interpret a homogenous `dfinsupp` as a `finsupp`.

Note that the elaborator has a lot of trouble with this definition - it is often necessary to
write `(dfinsupp.to_finsupp f : ι →₀ M)` instead of `f.to_finsupp`, as for some unknown reason
using dot notation or omitting the type ascription prevents the type being resolved correctly. -/
def dfinsupp.to_finsupp (f : Π₀ i : ι, M) : ι →₀ M :=
⟨f.support, f, λ i, by simp only [dfinsupp.mem_support_iff]⟩

@[simp] lemma dfinsupp.to_finsupp_coe (f : Π₀ i : ι, M) : ⇑f.to_finsupp = f := rfl
@[simp] lemma dfinsupp.to_finsupp_support (f : Π₀ i : ι, M) : f.to_finsupp.support = f.support :=
by { ext, simp, }

@[simp] lemma dfinsupp.to_finsupp_single (i : ι) (m : M) :
  (dfinsupp.single i m : Π₀ i : ι, M).to_finsupp = finsupp.single i m :=
by { ext, simp [finsupp.single_apply, dfinsupp.single_apply] }

@[simp] lemma finsupp.to_dfinsupp_to_finsupp (f : ι →₀ M) : f.to_dfinsupp.to_finsupp = f :=
finsupp.coe_fn_injective rfl

@[simp] lemma dfinsupp.to_finsupp_to_dfinsupp (f : Π₀ i : ι, M) : f.to_finsupp.to_dfinsupp = f :=
dfinsupp.coe_fn_injective rfl

end

end defs

/-! ### Lemmas about arithmetic operations -/
section lemmas

namespace finsupp

@[simp] lemma to_dfinsupp_zero [has_zero M] :
  (0 : ι →₀ M).to_dfinsupp = 0 := dfinsupp.coe_fn_injective rfl

@[simp] lemma to_dfinsupp_add [add_zero_class M] (f g : ι →₀ M) :
  (f + g).to_dfinsupp = f.to_dfinsupp + g.to_dfinsupp := dfinsupp.coe_fn_injective rfl

@[simp] lemma to_dfinsupp_neg [add_group M] (f : ι →₀ M) :
  (-f).to_dfinsupp = -f.to_dfinsupp := dfinsupp.coe_fn_injective rfl

@[simp] lemma to_dfinsupp_sub [add_group M] (f g : ι →₀ M) :
  (f - g).to_dfinsupp = f.to_dfinsupp - g.to_dfinsupp :=
dfinsupp.coe_fn_injective rfl

@[simp] lemma to_dfinsupp_smul [monoid R] [add_monoid M] [distrib_mul_action R M]
  (r : R) (f : ι →₀ M) : (r • f).to_dfinsupp = r • f.to_dfinsupp :=
dfinsupp.coe_fn_injective rfl

end finsupp

namespace dfinsupp
variables [decidable_eq ι]

@[simp] lemma to_finsupp_zero [has_zero M] [Π m : M, decidable (m ≠ 0)] :
  to_finsupp 0 = (0 : ι →₀ M) := finsupp.coe_fn_injective rfl

@[simp] lemma to_finsupp_add [add_zero_class M] [Π m : M, decidable (m ≠ 0)] (f g : Π₀ i : ι, M) :
  (to_finsupp (f + g) : ι →₀ M) = (to_finsupp f + to_finsupp g) :=
finsupp.coe_fn_injective $ dfinsupp.coe_add _ _

@[simp] lemma to_finsupp_neg [add_group M] [Π m : M, decidable (m ≠ 0)] (f : Π₀ i : ι, M) :
  (to_finsupp (-f) : ι →₀ M) = -to_finsupp f :=
finsupp.coe_fn_injective $ dfinsupp.coe_neg _

@[simp] lemma to_finsupp_sub [add_group M] [Π m : M, decidable (m ≠ 0)] (f g : Π₀ i : ι, M) :
  (to_finsupp (f - g) : ι →₀ M) = to_finsupp f - to_finsupp g :=
finsupp.coe_fn_injective $ dfinsupp.coe_sub _ _

@[simp] lemma to_finsupp_smul [monoid R] [add_monoid M] [distrib_mul_action R M]
  [Π m : M, decidable (m ≠ 0)]
  (r : R) (f : Π₀ i : ι, M) : (to_finsupp (r • f) : ι →₀ M) = r • to_finsupp f :=
finsupp.coe_fn_injective $ dfinsupp.coe_smul _ _

end dfinsupp

end lemmas

/-! ### Bundled `equiv`s -/

section equivs

/-- `finsupp.to_dfinsupp` and `dfinsupp.to_finsupp` together form an equiv. -/
@[simps {fully_applied := ff}]
def finsupp_equiv_dfinsupp [decidable_eq ι] [has_zero M] [Π m : M, decidable (m ≠ 0)] :
  (ι →₀ M) ≃ (Π₀ i : ι, M) :=
{ to_fun := finsupp.to_dfinsupp, inv_fun := dfinsupp.to_finsupp,
  left_inv := finsupp.to_dfinsupp_to_finsupp, right_inv := dfinsupp.to_finsupp_to_dfinsupp }

/-- The additive version of `finsupp.to_finsupp`. Note that this is `noncomputable` because
`finsupp.has_add` is noncomputable. -/
@[simps {fully_applied := ff}]
def finsupp_add_equiv_dfinsupp
  [decidable_eq ι] [add_zero_class M] [Π m : M, decidable (m ≠ 0)] :
  (ι →₀ M) ≃+ (Π₀ i : ι, M) :=
{ to_fun := finsupp.to_dfinsupp, inv_fun := dfinsupp.to_finsupp,
  map_add' := finsupp.to_dfinsupp_add,
  .. finsupp_equiv_dfinsupp}

variables (R)

/-- The additive version of `finsupp.to_finsupp`. Note that this is `noncomputable` because
`finsupp.has_add` is noncomputable. -/
@[simps {fully_applied := ff}]
def finsupp_lequiv_dfinsupp
  [decidable_eq ι] [semiring R] [add_comm_monoid M] [Π m : M, decidable (m ≠ 0)] [module R M] :
  (ι →₀ M) ≃ₗ[R] (Π₀ i : ι, M) :=
{ to_fun := finsupp.to_dfinsupp, inv_fun := dfinsupp.to_finsupp,
  map_smul' := finsupp.to_dfinsupp_smul,
  map_add' := finsupp.to_dfinsupp_add,
  .. finsupp_equiv_dfinsupp}

section sigma
/-- ### Stronger versions of `finsupp.split` -/

noncomputable theory
open_locale classical

variables {η : ι → Type*} {N : Type*} [semiring R]

open finsupp

/-- `finsupp.split` is an equivalence between `(Σ i, η i) →₀ N` and `Π₀ i, (η i →₀ N)`. -/
def sigma_finsupp_equiv_dfinsupp [has_zero N] : ((Σ i, η i) →₀ N) ≃ (Π₀ i, (η i →₀ N)) :=
{ to_fun := λ f, ⟦⟨split f, (split_support f : finset ι).val, λ i,
    begin
    rw [← finset.mem_def, mem_split_support_iff_nonzero],
    exact (decidable.em _).symm
    end⟩⟧,
  inv_fun := λ f,
  begin
    refine on_finset (finset.sigma f.support (λ j, (f j).support)) (λ ji, f ji.1 ji.2)
      (λ g hg, finset.mem_sigma.mpr ⟨_, mem_support_iff.mpr hg⟩),
    simp only [ne.def, dfinsupp.mem_support_to_fun],
    intro h,
    rw h at hg,
    simpa using hg
  end,
  left_inv := λ f, by { ext, simp [split] },
  right_inv := λ f, by { ext, simp [split] } }

@[simp]
lemma sigma_finsupp_equiv_dfinsupp_apply [has_zero N] (f : (Σ i, η i) →₀ N) :
  (sigma_finsupp_equiv_dfinsupp f : Π i, (η i →₀ N)) = finsupp.split f := rfl

@[simp]
lemma sigma_finsupp_equiv_dfinsupp_symm_apply [has_zero N] (f : Π₀ i, (η i →₀ N)) (s : Σ i, η i) :
  (sigma_finsupp_equiv_dfinsupp.symm f : (Σ i, η i) →₀ N) s = f s.1 s.2 := rfl

@[simp]
lemma sigma_finsupp_equiv_dfinsupp_support [has_zero N] (f : (Σ i, η i) →₀ N) :
  (sigma_finsupp_equiv_dfinsupp f).support = finsupp.split_support f :=
begin
  ext,
  rw dfinsupp.mem_support_to_fun,
  exact (finsupp.mem_split_support_iff_nonzero _ _).symm,
end

@[simp] lemma sigma_finsupp_equiv_dfinsupp_single [has_zero N] (a : Σ i, η i) (n : N) :
  sigma_finsupp_equiv_dfinsupp (finsupp.single a n)
    = @dfinsupp.single _ (λ i, η i →₀ N) _ _ a.1 (finsupp.single a.2 n) :=
begin
  obtain ⟨i, a⟩ := a,
  ext j b,
  by_cases h : i = j,
  { subst h,
    simp [split_apply, finsupp.single_apply] },
  suffices : finsupp.single (⟨i, a⟩ : Σ i, η i) n ⟨j, b⟩ = 0,
  { simp [split_apply, dif_neg h, this] },
  have H : (⟨i, a⟩ : Σ i, η i) ≠ ⟨j, b⟩ := by simp [h],
  rw [finsupp.single_apply, if_neg H]
end

-- Without this Lean fails to find the `add_zero_class` instance on `Π₀ i, (η i →₀ N)`.
local attribute [-instance] finsupp.has_zero

@[simp]
lemma sigma_finsupp_equiv_dfinsupp_add [add_zero_class N] (f g : (Σ i, η i) →₀ N) :
  sigma_finsupp_equiv_dfinsupp (f + g) =
  (sigma_finsupp_equiv_dfinsupp f + (sigma_finsupp_equiv_dfinsupp g) : (Π₀ (i : ι), η i →₀ N)) :=
by {ext, refl}

/-- `finsupp.split` is an additive equivalence between `(Σ i, η i) →₀ N` and `Π₀ i, (η i →₀ N)`. -/
@[simps]
def sigma_finsupp_add_equiv_dfinsupp [add_zero_class N] : ((Σ i, η i) →₀ N) ≃+ (Π₀ i, (η i →₀ N)) :=
{ to_fun := sigma_finsupp_equiv_dfinsupp,
  inv_fun := sigma_finsupp_equiv_dfinsupp.symm,
  map_add' := sigma_finsupp_equiv_dfinsupp_add,
  .. sigma_finsupp_equiv_dfinsupp }

local attribute [-instance] finsupp.add_zero_class

--tofix: r • (sigma_finsupp_equiv_dfinsupp f) doesn't work.
@[simp]
lemma sigma_finsupp_equiv_dfinsupp_smul {R} [monoid R] [add_monoid N] [distrib_mul_action R N]
  (r : R) (f : (Σ i, η i) →₀ N) : sigma_finsupp_equiv_dfinsupp (r • f) =
  @has_scalar.smul R (Π₀ i, η i →₀ N) mul_action.to_has_scalar r (sigma_finsupp_equiv_dfinsupp f) :=
by { ext, refl }

local attribute [-instance] finsupp.add_monoid

/-- `finsupp.split` is a linear equivalence between `(Σ i, η i) →₀ N` and `Π₀ i, (η i →₀ N)`. -/
@[simps]
def sigma_finsupp_lequiv_dfinsupp [add_comm_monoid N] [module R N] :
  ((Σ i, η i) →₀ N) ≃ₗ[R] (Π₀ i, (η i →₀ N)) :=
{ map_smul' := sigma_finsupp_equiv_dfinsupp_smul,
  .. sigma_finsupp_add_equiv_dfinsupp }

end sigma

end equivs


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov

! This file was ported from Lean 3 source module order.filter.indicator_function
! leanprover-community/mathlib commit 4d392a6c9c4539cbeca399b3ee0afea398fbd2eb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.IndicatorFunction
import Mathbin.Order.Filter.AtTopBot

/-!
# Indicator function and filters

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

Properties of indicator functions involving `=ᶠ` and `≤ᶠ`.

## Tags
indicator, characteristic, filter
-/

variable {α β M E : Type _}

open Set Filter Classical

open Filter Classical

section Zero

variable [Zero M] {s t : Set α} {f g : α → M} {a : α} {l : Filter α}

/- warning: indicator_eventually_eq -> indicator_eventuallyEq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {M : Type.{u2}} [_inst_1 : Zero.{u2} M] {s : Set.{u1} α} {t : Set.{u1} α} {f : α -> M} {g : α -> M} {l : Filter.{u1} α}, (Filter.EventuallyEq.{u1, u2} α M (Inf.inf.{u1} (Filter.{u1} α) (Filter.hasInf.{u1} α) l (Filter.principal.{u1} α s)) f g) -> (Filter.EventuallyEq.{u1, 0} α Prop l s t) -> (Filter.EventuallyEq.{u1, u2} α M l (Set.indicator.{u1, u2} α M _inst_1 s f) (Set.indicator.{u1, u2} α M _inst_1 t g))
but is expected to have type
  forall {α : Type.{u2}} {M : Type.{u1}} [_inst_1 : Zero.{u1} M] {s : Set.{u2} α} {t : Set.{u2} α} {f : α -> M} {g : α -> M} {l : Filter.{u2} α}, (Filter.EventuallyEq.{u2, u1} α M (Inf.inf.{u2} (Filter.{u2} α) (Filter.instInfFilter.{u2} α) l (Filter.principal.{u2} α s)) f g) -> (Filter.EventuallyEq.{u2, 0} α Prop l s t) -> (Filter.EventuallyEq.{u2, u1} α M l (Set.indicator.{u2, u1} α M _inst_1 s f) (Set.indicator.{u2, u1} α M _inst_1 t g))
Case conversion may be inaccurate. Consider using '#align indicator_eventually_eq indicator_eventuallyEqₓ'. -/
theorem indicator_eventuallyEq (hf : f =ᶠ[l ⊓ 𝓟 s] g) (hs : s =ᶠ[l] t) :
    indicator s f =ᶠ[l] indicator t g :=
  (eventually_inf_principal.1 hf).mp <|
    hs.mem_iff.mono fun x hst hfg =>
      by_cases (fun hxs : x ∈ s => by simp only [*, hst.1 hxs, indicator_of_mem]) fun hxs => by
        simp only [indicator_of_not_mem hxs, indicator_of_not_mem (mt hst.2 hxs)]
#align indicator_eventually_eq indicator_eventuallyEq

end Zero

section AddMonoid

variable [AddMonoid M] {s t : Set α} {f g : α → M} {a : α} {l : Filter α}

/- warning: indicator_union_eventually_eq -> indicator_union_eventuallyEq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {M : Type.{u2}} [_inst_1 : AddMonoid.{u2} M] {s : Set.{u1} α} {t : Set.{u1} α} {f : α -> M} {l : Filter.{u1} α}, (Filter.Eventually.{u1} α (fun (a : α) => Not (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s t))) l) -> (Filter.EventuallyEq.{u1, u2} α M l (Set.indicator.{u1, u2} α M (AddZeroClass.toHasZero.{u2} M (AddMonoid.toAddZeroClass.{u2} M _inst_1)) (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) s t) f) (HAdd.hAdd.{max u1 u2, max u1 u2, max u1 u2} (α -> M) (α -> M) (α -> M) (instHAdd.{max u1 u2} (α -> M) (Pi.instAdd.{u1, u2} α (fun (ᾰ : α) => M) (fun (i : α) => AddZeroClass.toHasAdd.{u2} M (AddMonoid.toAddZeroClass.{u2} M _inst_1)))) (Set.indicator.{u1, u2} α M (AddZeroClass.toHasZero.{u2} M (AddMonoid.toAddZeroClass.{u2} M _inst_1)) s f) (Set.indicator.{u1, u2} α M (AddZeroClass.toHasZero.{u2} M (AddMonoid.toAddZeroClass.{u2} M _inst_1)) t f)))
but is expected to have type
  forall {α : Type.{u2}} {M : Type.{u1}} [_inst_1 : AddMonoid.{u1} M] {s : Set.{u2} α} {t : Set.{u2} α} {f : α -> M} {l : Filter.{u2} α}, (Filter.Eventually.{u2} α (fun (a : α) => Not (Membership.mem.{u2, u2} α (Set.{u2} α) (Set.instMembershipSet.{u2} α) a (Inter.inter.{u2} (Set.{u2} α) (Set.instInterSet.{u2} α) s t))) l) -> (Filter.EventuallyEq.{u2, u1} α M l (Set.indicator.{u2, u1} α M (AddMonoid.toZero.{u1} M _inst_1) (Union.union.{u2} (Set.{u2} α) (Set.instUnionSet.{u2} α) s t) f) (HAdd.hAdd.{max u2 u1, max u2 u1, max u2 u1} (α -> M) (α -> M) (α -> M) (instHAdd.{max u2 u1} (α -> M) (Pi.instAdd.{u2, u1} α (fun (ᾰ : α) => M) (fun (i : α) => AddZeroClass.toAdd.{u1} M (AddMonoid.toAddZeroClass.{u1} M _inst_1)))) (Set.indicator.{u2, u1} α M (AddMonoid.toZero.{u1} M _inst_1) s f) (Set.indicator.{u2, u1} α M (AddMonoid.toZero.{u1} M _inst_1) t f)))
Case conversion may be inaccurate. Consider using '#align indicator_union_eventually_eq indicator_union_eventuallyEqₓ'. -/
theorem indicator_union_eventuallyEq (h : ∀ᶠ a in l, a ∉ s ∩ t) :
    indicator (s ∪ t) f =ᶠ[l] indicator s f + indicator t f :=
  h.mono fun a ha => indicator_union_of_not_mem_inter ha _
#align indicator_union_eventually_eq indicator_union_eventuallyEq

end AddMonoid

section Order

variable [Zero β] [Preorder β] {s t : Set α} {f g : α → β} {a : α} {l : Filter α}

/- warning: indicator_eventually_le_indicator -> indicator_eventuallyLE_indicator is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Zero.{u2} β] [_inst_2 : Preorder.{u2} β] {s : Set.{u1} α} {f : α -> β} {g : α -> β} {l : Filter.{u1} α}, (Filter.EventuallyLE.{u1, u2} α β (Preorder.toLE.{u2} β _inst_2) (Inf.inf.{u1} (Filter.{u1} α) (Filter.hasInf.{u1} α) l (Filter.principal.{u1} α s)) f g) -> (Filter.EventuallyLE.{u1, u2} α β (Preorder.toLE.{u2} β _inst_2) l (Set.indicator.{u1, u2} α β _inst_1 s f) (Set.indicator.{u1, u2} α β _inst_1 s g))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Zero.{u1} β] [_inst_2 : Preorder.{u1} β] {s : Set.{u2} α} {f : α -> β} {g : α -> β} {l : Filter.{u2} α}, (Filter.EventuallyLE.{u2, u1} α β (Preorder.toLE.{u1} β _inst_2) (Inf.inf.{u2} (Filter.{u2} α) (Filter.instInfFilter.{u2} α) l (Filter.principal.{u2} α s)) f g) -> (Filter.EventuallyLE.{u2, u1} α β (Preorder.toLE.{u1} β _inst_2) l (Set.indicator.{u2, u1} α β _inst_1 s f) (Set.indicator.{u2, u1} α β _inst_1 s g))
Case conversion may be inaccurate. Consider using '#align indicator_eventually_le_indicator indicator_eventuallyLE_indicatorₓ'. -/
theorem indicator_eventuallyLE_indicator (h : f ≤ᶠ[l ⊓ 𝓟 s] g) :
    indicator s f ≤ᶠ[l] indicator s g :=
  (eventually_inf_principal.1 h).mono fun a h => indicator_rel_indicator le_rfl h
#align indicator_eventually_le_indicator indicator_eventuallyLE_indicator

end Order

/- warning: monotone.tendsto_indicator -> Monotone.tendsto_indicator is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {ι : Type.{u3}} [_inst_1 : Preorder.{u3} ι] [_inst_2 : Zero.{u2} β] (s : ι -> (Set.{u1} α)), (Monotone.{u3, u1} ι (Set.{u1} α) _inst_1 (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))) s) -> (forall (f : α -> β) (a : α), Filter.Tendsto.{u3, u2} ι β (fun (i : ι) => Set.indicator.{u1, u2} α β _inst_2 (s i) f a) (Filter.atTop.{u3} ι _inst_1) (Pure.pure.{u2, u2} Filter.{u2} Filter.hasPure.{u2} β (Set.indicator.{u1, u2} α β _inst_2 (Set.unionᵢ.{u1, succ u3} α ι (fun (i : ι) => s i)) f a)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {ι : Type.{u3}} [_inst_1 : Preorder.{u3} ι] [_inst_2 : Zero.{u2} β] (s : ι -> (Set.{u1} α)), (Monotone.{u3, u1} ι (Set.{u1} α) _inst_1 (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α))))))) s) -> (forall (f : α -> β) (a : α), Filter.Tendsto.{u3, u2} ι β (fun (i : ι) => Set.indicator.{u1, u2} α β _inst_2 (s i) f a) (Filter.atTop.{u3} ι _inst_1) (Pure.pure.{u2, u2} Filter.{u2} Filter.instPureFilter.{u2} β (Set.indicator.{u1, u2} α β _inst_2 (Set.unionᵢ.{u1, succ u3} α ι (fun (i : ι) => s i)) f a)))
Case conversion may be inaccurate. Consider using '#align monotone.tendsto_indicator Monotone.tendsto_indicatorₓ'. -/
theorem Monotone.tendsto_indicator {ι} [Preorder ι] [Zero β] (s : ι → Set α) (hs : Monotone s)
    (f : α → β) (a : α) :
    Tendsto (fun i => indicator (s i) f a) atTop (pure <| indicator (⋃ i, s i) f a) :=
  by
  by_cases h : ∃ i, a ∈ s i
  · rcases h with ⟨i, hi⟩
    refine' tendsto_pure.2 ((eventually_ge_at_top i).mono fun n hn => _)
    rw [indicator_of_mem (hs hn hi) _, indicator_of_mem ((subset_Union _ _) hi) _]
  · rw [not_exists] at h
    simp only [indicator_of_not_mem (h _)]
    convert tendsto_const_pure
    apply indicator_of_not_mem
    simpa only [not_exists, mem_Union]
#align monotone.tendsto_indicator Monotone.tendsto_indicator

/- warning: antitone.tendsto_indicator -> Antitone.tendsto_indicator is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {ι : Type.{u3}} [_inst_1 : Preorder.{u3} ι] [_inst_2 : Zero.{u2} β] (s : ι -> (Set.{u1} α)), (Antitone.{u3, u1} ι (Set.{u1} α) _inst_1 (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))) s) -> (forall (f : α -> β) (a : α), Filter.Tendsto.{u3, u2} ι β (fun (i : ι) => Set.indicator.{u1, u2} α β _inst_2 (s i) f a) (Filter.atTop.{u3} ι _inst_1) (Pure.pure.{u2, u2} Filter.{u2} Filter.hasPure.{u2} β (Set.indicator.{u1, u2} α β _inst_2 (Set.interᵢ.{u1, succ u3} α ι (fun (i : ι) => s i)) f a)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {ι : Type.{u3}} [_inst_1 : Preorder.{u3} ι] [_inst_2 : Zero.{u2} β] (s : ι -> (Set.{u1} α)), (Antitone.{u3, u1} ι (Set.{u1} α) _inst_1 (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α))))))) s) -> (forall (f : α -> β) (a : α), Filter.Tendsto.{u3, u2} ι β (fun (i : ι) => Set.indicator.{u1, u2} α β _inst_2 (s i) f a) (Filter.atTop.{u3} ι _inst_1) (Pure.pure.{u2, u2} Filter.{u2} Filter.instPureFilter.{u2} β (Set.indicator.{u1, u2} α β _inst_2 (Set.interᵢ.{u1, succ u3} α ι (fun (i : ι) => s i)) f a)))
Case conversion may be inaccurate. Consider using '#align antitone.tendsto_indicator Antitone.tendsto_indicatorₓ'. -/
theorem Antitone.tendsto_indicator {ι} [Preorder ι] [Zero β] (s : ι → Set α) (hs : Antitone s)
    (f : α → β) (a : α) :
    Tendsto (fun i => indicator (s i) f a) atTop (pure <| indicator (⋂ i, s i) f a) :=
  by
  by_cases h : ∃ i, a ∉ s i
  · rcases h with ⟨i, hi⟩
    refine' tendsto_pure.2 ((eventually_ge_at_top i).mono fun n hn => _)
    rw [indicator_of_not_mem _ _, indicator_of_not_mem _ _]
    · simp only [mem_Inter, not_forall]
      exact ⟨i, hi⟩
    · intro h
      have := hs hn h
      contradiction
  · push_neg  at h
    simp only [indicator_of_mem, h, mem_Inter.2 h, tendsto_const_pure]
#align antitone.tendsto_indicator Antitone.tendsto_indicator

#print tendsto_indicator_bunionᵢ_finset /-
theorem tendsto_indicator_bunionᵢ_finset {ι} [Zero β] (s : ι → Set α) (f : α → β) (a : α) :
    Tendsto (fun n : Finset ι => indicator (⋃ i ∈ n, s i) f a) atTop
      (pure <| indicator (unionᵢ s) f a) :=
  by
  rw [Union_eq_Union_finset s]
  refine' Monotone.tendsto_indicator (fun n : Finset ι => ⋃ i ∈ n, s i) _ f a
  exact fun t₁ t₂ => bUnion_subset_bUnion_left
#align tendsto_indicator_bUnion_finset tendsto_indicator_bunionᵢ_finset
-/

#print Filter.EventuallyEq.support /-
theorem Filter.EventuallyEq.support [Zero β] {f g : α → β} {l : Filter α} (h : f =ᶠ[l] g) :
    Function.support f =ᶠ[l] Function.support g :=
  by
  filter_upwards [h]with x hx
  rw [eq_iff_iff]
  change f x ≠ 0 ↔ g x ≠ 0
  rw [hx]
#align filter.eventually_eq.support Filter.EventuallyEq.support
-/

#print Filter.EventuallyEq.indicator /-
theorem Filter.EventuallyEq.indicator [Zero β] {l : Filter α} {f g : α → β} {s : Set α}
    (hfg : f =ᶠ[l] g) : s.indicator f =ᶠ[l] s.indicator g :=
  by
  filter_upwards [hfg]with x hx
  by_cases x ∈ s
  · rwa [indicator_of_mem h, indicator_of_mem h]
  · rw [indicator_of_not_mem h, indicator_of_not_mem h]
#align filter.eventually_eq.indicator Filter.EventuallyEq.indicator
-/

#print Filter.EventuallyEq.indicator_zero /-
theorem Filter.EventuallyEq.indicator_zero [Zero β] {l : Filter α} {f : α → β} {s : Set α}
    (hf : f =ᶠ[l] 0) : s.indicator f =ᶠ[l] 0 :=
  by
  refine' hf.indicator.trans _
  rw [indicator_zero']
#align filter.eventually_eq.indicator_zero Filter.EventuallyEq.indicator_zero
-/


/-
The current plan is to allow instances to have preconditions with registered tactics.
Typeclass resolution will delay these proof obligations, effectively assuming that they will succeed.
If typeclass resolution succeeds, it will return a list of (mvar, lctx) pairs to the elaborator,
which will try to synthesize the proofs and throw a good error message if it fails.
-/

class Foo (b : Bool) : Type

class FooTrue (b : Bool) extends Foo b : Type :=
(H : b = true)

/- This requires the tactic framework and auto_param. -/
-- @[instance] axiom CoeFooFooTrue (b : Bool) (H : b = true . refl) : HasCoe (Foo b) (FooTrue b)

instance BoolToFoo (b : Bool) : Foo b := Foo.mk b

def forceFooTrue (b : Bool) (fooTrue : FooTrue b) : Bool := b

/- Should succeed (once CoeFooFooTrue can be written) -/
#check forceFooTrue true (Foo.mk true)

/- Should fail (even after CoeFooFooTrue can be written -/
#check forceFooTrue false (Foo.mk false)

/-
This plan has one limitation, that has so far been deemed acceptable:
it will not support classes with different instances depending on the provability of preconditions.
The classic example is multiplying two elements of `ℤ/nℤ` where `n` is not prime.
Here is a toy version of this problem:

<<
@[class] axiom Prime (p : Nat) : Prop

@[instance] axiom p2 : Prime 2
@[instance] axiom p3 : Prime 3

@[class] axiom Field : Type → Type
@[class] axiom Ring : Type → Type

@[instance] axiom FieldToDiv (α : Type) [Field α] : Div α
@[instance] axiom FieldToMul (α : Type) [Field α] : Mul α
@[instance] axiom RingToMul (α : Type) [Ring α] : Mul α

axiom mkType : Nat → Type

@[instance] axiom PrimeField (n : Nat) (Hp : Prime n . provePrimality) : Field (mkType n)
@[instance] axiom NonPrimeRing (n : Nat) : Ring (mkType n)

example (α β : mkType 4) : α * β = β * α
>>

The issue is that (depending on the order the instances are tried),
the instance involving `FieldToMul` will succeed in typeclass resolution,
but the proof will fail later on.

I (@dselsam) still thinks this plan is a good compromise.
For examples like this, the definition in question (i.e. `Prime`) can be made a class instead
and taken as an inst-implicit argument to `PrimeField`.
-/


-- import LTS.defs property_catalogue.LTL.patterns tactic proof_state

-- open tactic

-- variable {M : LTS}
-- variable {α : Type}

-- namespace absent
-- namespace globally

-- lemma by_partition_before_after {π : path M} (P S : formula M) :
--     (sat (exist.globally S) π ) → (sat (absent.before P S) π) → (sat (absent.after P S) π) → (sat (absent.globally P) π) :=
-- begin
--     intros H1 H2 H3,
--     rw absent.globally, rw sat,
--     rw exist.globally at H1, rw sat at H1,
--     rw absent.before at H2, iterate 3 {rw sat at H2},
--     rw absent.after at H3, iterate 3 {rw sat at H3},
--     simp at *,
--     cases H1 with k H1,
--     intro i,
--     replace H2 := H2 k,
--     replace H2 := H2 H1,
--     cases H2 with w H2,
--     have EM : (i < w) ∨ ¬ (i < w), from em (i<w),
--     cases EM,
--     apply H2.2,
--     assumption,
--     simp at EM,
--     replace H3 := H3 w,
--     cases H2 with L R,
--     replace H3 := H3 L,
--     have : ∃ j, i = w + j, from le_iff_exists_add.mp EM,
--     cases this with j H4, rw H4,
--     replace H3 := H3 j,
--     rw path.drop_drop at H3,
--     assumption,
-- end

-- meta def solve_by_partition (tok1 tok2 : expr) (ps : proof_data α ): tactic (proof_data α) :=
-- do
--   tactic.interactive.apply ``(by_partition_before_aft %%tok1 %%tok2),
--   return ps
-- -- t1 ← tok1.log_format, t2 ← tok2.log_format,
-- --  s.log $ "apply by_partition_before_aft" ++ t1 ++ t2 ++ "\n"

-- meta def solve (tok : expr) (ps : proof_data α) : list expr → tactic (proof_data α)
-- | [] :=  return ps
-- | (h::t) :=
--    do typ ← infer_type h,
--    match typ with
--    | `(sat (absent.before %%tok %%new) %%path):=
--    do {ps ←  solve_by_partition tok new ps, return ps }<|> solve t
--    | `(sat (absent.after %%tok %%new) %%path) :=
--    do {ps ← solve_by_partition tok new ps, return ps }<|> solve t
--    | _ := do solve t
--    end

-- end globally

-- namespace between

-- theorem absent_between_response {M : LTS} {p : path M} { B I C : formula M} ( A : formula M) :
-- (sat (responds.globally  (C) (A) ) p) ∧
-- (sat (absent.between (B) (C) (A)) p) ∧
-- (sat (absent.between (B) (A) (I)) p)→ (sat (absent.between (B) (C) (I)) p) :=
-- begin rintros ⟨ H1, H2, H3⟩,
-- intro i,
-- replace H1 := H1 i,
-- intro Hcond, cases Hcond with L R,
-- replace H1 := H1 L,
-- rw absent.between at H2,
-- have : ((p.drop i) ⊨ (C &  ◆A)), by {rw sat, split,assumption,assumption},
-- replace H2 := H2 (i) this,
-- cases H1 with w Hw,
-- cases R with k Hk,
-- clear this,
-- cases H2 with z Hz,
-- cases Hz with z1 z2,
-- have : k < z ∨ ¬ (k < z), from or_not,
-- cases this,
-- use k,
-- split, assumption,
-- intros j Hj,
-- have fact : j < z, by omega,
-- replace z2 := z2 j fact, assumption,
-- simp at this,
-- have EM : z = k ∨ z < k, by omega,
-- clear this,
-- cases EM, use k,
-- split, assumption, rw ← EM, assumption,
-- replace H3 := H3 (i+z),
-- rw ← path.drop_drop at H3,
-- have help : (((p.drop i).drop z) ⊨ ◆(I)), by {use (k-z),
-- rw path.drop_drop, rw path.drop_drop,have : i + (z + (k - z)) = i+k, by omega, rw this, rw ← path.drop_drop, assumption,},
-- have : ( ((p.drop i).drop z) ⊨  (A &  ◆I)), by {rw sat, split, assumption, assumption,},
-- clear help, replace H3 := H3 this,
-- cases H3 with t Ht,
-- clear this,
-- cases Ht with Ht Ht',
-- rw path.drop_drop at *,
-- use (z+t),split,
-- assumption,
-- intros j Hj,
-- have : j < z ∨ ¬ (j < z), from or_not,
-- cases this, replace z2 := z2 j this,
-- assumption,
-- simp at this,
-- have EM' : z = j ∨ z < j, by omega,
-- cases EM', rw EM' at Hj,
-- replace Ht' := Ht' 0 _,
-- rw path.drop_drop at Ht',
-- rw← EM',
-- simp at Ht', rw path.drop_drop,assumption,
-- omega,
-- clear this,
-- replace Ht' := Ht' (j-z),
-- rw path.drop_drop at Ht',
-- have : (i + z + (j - z)) = (i + j), by omega,
-- rw this at Ht',
-- rw path.drop_drop,
--  apply Ht', omega,
-- end

-- theorem foo {M : LTS} {P Q R : formula M} {x : path M} : (x ⊨ R ⇒ (P W Q)) ↔ (x ⊨ R ⇒ (P U Q)) ∨ (x ⊨ R ⇒ ◾ P) :=
-- begin
-- split,
-- intro H,
-- rw sat at H,
-- rw sat.weak_until at H,
-- rw imp_or_distrib at H,
-- cases H,
-- right, assumption,
-- left, assumption,
-- intro H,
-- rw sat,
-- rw sat.weak_until,
-- cases H,
-- intro Hr, replace H := H Hr,
-- right, assumption,
-- intro Hr, replace H := H Hr,left, assumption,
-- end

-- theorem absent_after_between_response {M : LTS} {p : path M} { B I C : formula M} ( A : formula M) :
-- (sat (responds.globally  (C) (A) ) p) ∧
-- (sat (absent.between (B) (C) (A)) p) ∧
-- (sat (absent.after_until (B) (A) (I)) p)→ (sat (absent.after_until (B) (C) (I)) p) :=
-- begin
--   rintros ⟨H1, H2, H3⟩,
--   rw after_until,
--   intro i,
--   rw foo,
--   left,
--   apply absent_between_response A,split,assumption,
--   split,assumption,
--   clear H2, clear H1,clear i,
--   rw after_until at H3,
--   rw between,
--   intros i H,
--   replace H3 := H3 i H,
--   cases H with L R,
--   cases H3,
--   cases R with w Hw, use w, split, assumption,
--   intros i _,
--   replace H3 := H3 i, assumption, assumption,
-- end

-- meta def solve_by_absent_between_response (A : expr) (ps : proof_data α): tactic (proof_data α) :=
-- do
--   tactic.interactive.apply ``(absent_between_response %%A),
--   repeat1 (applyc `and.intro), `[repeat {assumption}],
--   return ps

-- meta def solve  (ps : proof_data α) : list expr → tactic (proof_data α)
-- | [] :=  return ps
-- | (h::t) :=
--    do typ ← infer_type h,
--    match typ with
--    | `(sat (responds.globally %%C %%A) _):=
--     do {ps ← solve_by_absent_between_response A ps, return ps} <|> solve t
--    | _ := do solve t
--    end

-- end between

-- namespace after_until

-- theorem from_absent_between_response {M : LTS} {p : path M} { B I C : formula M} ( A : formula M) :
-- (sat (responds.globally  (C) (A) ) p) ∧
-- (sat (absent.between (B) (C) (A)) p) ∧
-- (sat (absent.after_until (B) (A) (I)) p)→ (sat (absent.after_until (B) (C) (I)) p) :=
-- begin
--   rintros ⟨H1, H2, H3⟩,
--   rw after_until,
--   intro i,
--   rw between.foo,
--   left,
--   apply between.absent_between_response A,split,assumption,
--   split,assumption,
--   clear H2, clear H1,clear i,
--   rw after_until at H3,
--   rw between,
--   intros i H,
--   replace H3 := H3 i H,
--   cases H with L R,
--   cases H3,
--   cases R with w Hw, use w, split, assumption,
--   intros i _,
--   replace H3 := H3 i, assumption, assumption,
-- end

-- meta def solve_by_absent_between_response (A : expr) (ps : proof_data α): tactic (proof_data α) :=
-- do
--   tactic.interactive.apply ``(from_absent_between_response %%A),
--   ps ← ps.log "apply absent.after_until.from_absent_between_response",
--   let ps := {used := ps.used ++ ["apply absent.after_until.from_absent_between_response"], ..ps},
--   repeat1 (applyc `and.intro), `[repeat {assumption}],
--   ps ← ps.log "match_premises",
--   return {used := ps.used ++ ["match_premises"], ..ps}

-- meta def solve  (ps : proof_data α) : list expr → tactic (proof_data α)
-- | [] :=  return ps
-- | (h::t) :=
--    do typ ← infer_type h,
--    match typ with
--    | `(sat (responds.globally %%C %%A) _):=
--      do {ps ← solve_by_absent_between_response A ps, return ps} <|> solve t
--    | _ := do solve t
--    end

-- end after_until

-- end absent


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.binary_products
import category_theory.limits.preserves.shapes.pullbacks

/-!
# Relating monomorphisms and epimorphisms to limits and colimits

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

If `F` preserves (resp. reflects) pullbacks, then it preserves (resp. reflects) monomorphisms.

We also provide the dual version for epimorphisms.

-/

universes v₁ v₂ u₁ u₂

namespace category_theory
open category limits

variables {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D]
variables (F : C ⥤ D)

/-- If `F` preserves pullbacks, then it preserves monomorphisms. -/
lemma preserves_mono_of_preserves_limit {X Y : C} (f : X ⟶ Y) [preserves_limit (cospan f f) F]
  [mono f] : mono (F.map f) :=
begin
  have := is_limit_pullback_cone_map_of_is_limit F _ (pullback_cone.is_limit_mk_id_id f),
  simp_rw [F.map_id] at this,
  apply pullback_cone.mono_of_is_limit_mk_id_id _ this,
end

@[priority 100]
instance preserves_monomorphisms_of_preserves_limits_of_shape
  [preserves_limits_of_shape walking_cospan F] : F.preserves_monomorphisms :=
{ preserves := λ X Y f hf, by exactI preserves_mono_of_preserves_limit F f }

/-- If `F` reflects pullbacks, then it reflects monomorphisms. -/
lemma reflects_mono_of_reflects_limit {X Y : C} (f : X ⟶ Y) [reflects_limit (cospan f f) F]
  [mono (F.map f)] : mono f :=
begin
  have := pullback_cone.is_limit_mk_id_id (F.map f),
  simp_rw [←F.map_id] at this,
  apply pullback_cone.mono_of_is_limit_mk_id_id _ (is_limit_of_is_limit_pullback_cone_map F _ this),
end

@[priority 100]
instance reflects_monomorphisms_of_reflects_limits_of_shape
  [reflects_limits_of_shape walking_cospan F] : F.reflects_monomorphisms :=
{ reflects := λ X Y f hf, by exactI reflects_mono_of_reflects_limit F f }

/-- If `F` preserves pushouts, then it preserves epimorphisms. -/
lemma preserves_epi_of_preserves_colimit {X Y : C} (f : X ⟶ Y) [preserves_colimit (span f f) F]
  [epi f] : epi (F.map f) :=
begin
  have := is_colimit_pushout_cocone_map_of_is_colimit F _ (pushout_cocone.is_colimit_mk_id_id f),
  simp_rw [F.map_id] at this,
  apply pushout_cocone.epi_of_is_colimit_mk_id_id _ this,
end

@[priority 100]
instance preserves_epimorphisms_of_preserves_colimits_of_shape
  [preserves_colimits_of_shape walking_span F] : F.preserves_epimorphisms :=
{ preserves := λ X Y f hf, by exactI preserves_epi_of_preserves_colimit F f }

/-- If `F` reflects pushouts, then it reflects epimorphisms. -/
lemma reflects_epi_of_reflects_colimit {X Y : C} (f : X ⟶ Y) [reflects_colimit (span f f) F]
  [epi (F.map f)] : epi f :=
begin
  have := pushout_cocone.is_colimit_mk_id_id (F.map f),
  simp_rw [← F.map_id] at this,
  apply pushout_cocone.epi_of_is_colimit_mk_id_id _
    (is_colimit_of_is_colimit_pushout_cocone_map F _ this)
end

@[priority 100]
instance reflects_epimorphisms_of_reflects_colimits_of_shape
  [reflects_colimits_of_shape walking_span F] : F.reflects_epimorphisms :=
{ reflects := λ X Y f hf, by exactI reflects_epi_of_reflects_colimit F f }

end category_theory


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.group.opposite
import group_theory.group_action.defs

/-!
# Scalar actions on and by `Mᵐᵒᵖ`

This file defines the actions on the opposite type `has_scalar R Mᵐᵒᵖ`, and actions by the opposite
type, `has_scalar Rᵐᵒᵖ M`.

Note that `mul_opposite.has_scalar` is provided in an earlier file as it is needed to provide the
`add_monoid.nsmul` and `add_comm_group.gsmul` fields.
-/

variables (α : Type*)

/-! ### Actions _on_ the opposite type

Actions on the opposite type just act on the underlying type.
-/

namespace mul_opposite

instance (R : Type*) [monoid R] [mul_action R α] : mul_action R αᵐᵒᵖ :=
{ one_smul := λ x, unop_injective $ one_smul R (unop x),
  mul_smul := λ r₁ r₂ x, unop_injective $ mul_smul r₁ r₂ (unop x),
  .. mul_opposite.has_scalar α R }

instance (R : Type*) [monoid R] [add_monoid α] [distrib_mul_action R α] :
  distrib_mul_action R αᵐᵒᵖ :=
{ smul_add := λ r x₁ x₂, unop_injective $ smul_add r (unop x₁) (unop x₂),
  smul_zero := λ r, unop_injective $ smul_zero r,
  .. mul_opposite.mul_action α R }

instance (R : Type*) [monoid R] [monoid α] [mul_distrib_mul_action R α] :
  mul_distrib_mul_action R αᵐᵒᵖ :=
{ smul_mul := λ r x₁ x₂, unop_injective $ smul_mul' r (unop x₂) (unop x₁),
  smul_one := λ r, unop_injective $ smul_one r,
  .. mul_opposite.mul_action α R }

instance {M N} [has_scalar M N] [has_scalar M α] [has_scalar N α] [is_scalar_tower M N α] :
  is_scalar_tower M N αᵐᵒᵖ :=
⟨λ x y z, unop_injective $ smul_assoc _ _ _⟩

instance {M N} [has_scalar M α] [has_scalar N α] [smul_comm_class M N α] :
  smul_comm_class M N αᵐᵒᵖ :=
⟨λ x y z, unop_injective $ smul_comm _ _ _⟩

end mul_opposite

/-! ### Actions _by_ the opposite type (right actions)

In `has_mul.to_has_scalar` in another file, we define the left action `a₁ • a₂ = a₁ * a₂`. For the
multiplicative opposite, we define `mul_opposite.op a₁ • a₂ = a₂ * a₁`, with the multiplication
reversed.
-/

open mul_opposite

/-- Like `has_mul.to_has_scalar`, but multiplies on the right.

See also `monoid.to_opposite_mul_action` and `monoid_with_zero.to_opposite_mul_action_with_zero`. -/
instance has_mul.to_has_opposite_scalar [has_mul α] : has_scalar αᵐᵒᵖ α :=
{ smul := λ c x, x * c.unop }

@[simp] lemma op_smul_eq_mul [has_mul α] {a a' : α} : op a • a' = a' * a := rfl

-- TODO: add an additive version once we have additive opposites
/-- The right regular action of a group on itself is transitive. -/
instance mul_action.opposite_regular.is_pretransitive {G : Type*} [group G] :
  mul_action.is_pretransitive Gᵐᵒᵖ G :=
⟨λ x y, ⟨op (x⁻¹ * y), mul_inv_cancel_left _ _⟩⟩

instance semigroup.opposite_smul_comm_class [semigroup α] :
  smul_comm_class αᵐᵒᵖ α α :=
{ smul_comm := λ x y z, (mul_assoc _ _ _) }

instance semigroup.opposite_smul_comm_class' [semigroup α] :
  smul_comm_class α αᵐᵒᵖ α :=
{ smul_comm := λ x y z, (mul_assoc _ _ _).symm }

/-- Like `monoid.to_mul_action`, but multiplies on the right. -/
instance monoid.to_opposite_mul_action [monoid α] : mul_action αᵐᵒᵖ α :=
{ smul := (•),
  one_smul := mul_one,
  mul_smul := λ x y r, (mul_assoc _ _ _).symm }

instance is_scalar_tower.opposite_mid {M N} [monoid N] [has_scalar M N]
  [smul_comm_class M N N] :
  is_scalar_tower M Nᵐᵒᵖ N :=
⟨λ x y z, mul_smul_comm _ _ _⟩

instance smul_comm_class.opposite_mid {M N} [monoid N] [has_scalar M N]
  [is_scalar_tower M N N] :
  smul_comm_class M Nᵐᵒᵖ N :=
⟨λ x y z, by { induction y using mul_opposite.rec, simp [smul_mul_assoc] }⟩

-- The above instance does not create an unwanted diamond, the two paths to
-- `mul_action αᵐᵒᵖ αᵐᵒᵖ` are defeq.
example [monoid α] : monoid.to_mul_action αᵐᵒᵖ = mul_opposite.mul_action α αᵐᵒᵖ := rfl

/-- `monoid.to_opposite_mul_action` is faithful on cancellative monoids. -/
instance left_cancel_monoid.to_has_faithful_opposite_scalar [left_cancel_monoid α] :
  has_faithful_scalar αᵐᵒᵖ α :=
⟨λ x y h, unop_injective $ mul_left_cancel (h 1)⟩

/-- `monoid.to_opposite_mul_action` is faithful on nontrivial cancellative monoids with zero. -/
instance cancel_monoid_with_zero.to_has_faithful_opposite_scalar
  [cancel_monoid_with_zero α] [nontrivial α] : has_faithful_scalar αᵐᵒᵖ α :=
⟨λ x y h, unop_injective $ mul_left_cancel₀ one_ne_zero (h 1)⟩


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.num.bitwise
import Mathlib.data.int.char_zero
import Mathlib.data.nat.gcd
import Mathlib.data.nat.psub
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Properties of the binary representation of integers
-/

namespace pos_num

@[simp] theorem cast_one {α : Type u_1} [HasOne α] [Add α] : ↑1 = 1 :=
  rfl

@[simp] theorem cast_one' {α : Type u_1} [HasOne α] [Add α] : ↑one = 1 :=
  rfl

@[simp] theorem cast_bit0 {α : Type u_1} [HasOne α] [Add α] (n : pos_num) : ↑(bit0 n) = bit0 ↑n :=
  rfl

@[simp] theorem cast_bit1 {α : Type u_1} [HasOne α] [Add α] (n : pos_num) : ↑(bit1 n) = bit1 ↑n :=
  rfl

@[simp] theorem cast_to_nat {α : Type u_1} [add_monoid α] [HasOne α] (n : pos_num) : ↑↑n = ↑n := sorry

@[simp] theorem to_nat_to_int (n : pos_num) : ↑↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (Eq.symm (int.nat_cast_eq_coe_nat ↑n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (cast_to_nat n))) (Eq.refl ↑n))

@[simp] theorem cast_to_int {α : Type u_1} [add_group α] [HasOne α] (n : pos_num) : ↑↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (Eq.symm (to_nat_to_int n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑↑n = ↑n)) (int.cast_coe_nat ↑n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (cast_to_nat n))) (Eq.refl ↑n)))

theorem succ_to_nat (n : pos_num) : ↑(succ n) = ↑n + 1 := sorry

theorem one_add (n : pos_num) : 1 + n = succ n :=
  pos_num.cases_on n (Eq.refl (1 + one)) (fun (n : pos_num) => Eq.refl (1 + bit1 n))
    fun (n : pos_num) => Eq.refl (1 + bit0 n)

theorem add_one (n : pos_num) : n + 1 = succ n :=
  pos_num.cases_on n (Eq.refl (one + 1)) (fun (n : pos_num) => Eq.refl (bit1 n + 1))
    fun (n : pos_num) => Eq.refl (bit0 n + 1)

theorem add_to_nat (m : pos_num) (n : pos_num) : ↑(m + n) = ↑m + ↑n := sorry

theorem add_succ (m : pos_num) (n : pos_num) : m + succ n = succ (m + n) := sorry

theorem bit0_of_bit0 (n : pos_num) : bit0 n = bit0 n := sorry

theorem bit1_of_bit1 (n : pos_num) : bit1 n = bit1 n :=
  (fun (this : bit0 n + 1 = bit1 n) => this)
    (eq.mpr (id (Eq._oldrec (Eq.refl (bit0 n + 1 = bit1 n)) (add_one (bit0 n))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (succ (bit0 n) = bit1 n)) (bit0_of_bit0 n))) (Eq.refl (succ (bit0 n)))))

theorem mul_to_nat (m : pos_num) (n : pos_num) : ↑(m * n) = ↑m * ↑n := sorry

theorem to_nat_pos (n : pos_num) : 0 < ↑n := sorry

theorem cmp_to_nat_lemma {m : pos_num} {n : pos_num} : ↑m < ↑n → ↑(bit1 m) < ↑(bit0 n) := sorry

theorem cmp_swap (m : pos_num) (n : pos_num) : ordering.swap (cmp m n) = cmp n m := sorry

theorem cmp_to_nat (m : pos_num) (n : pos_num) : ordering.cases_on (cmp m n) (↑m < ↑n) (m = n) (↑n < ↑m) := sorry

theorem lt_to_nat {m : pos_num} {n : pos_num} : ↑m < ↑n ↔ m < n := sorry

theorem le_to_nat {m : pos_num} {n : pos_num} : ↑m ≤ ↑n ↔ m ≤ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑m ≤ ↑n ↔ m ≤ n)) (Eq.symm (propext not_lt)))) (not_congr lt_to_nat)

end pos_num

namespace num

theorem add_zero (n : num) : n + 0 = n :=
  num.cases_on n (Eq.refl (zero + 0)) fun (n : pos_num) => Eq.refl (pos n + 0)

theorem zero_add (n : num) : 0 + n = n :=
  num.cases_on n (Eq.refl (0 + zero)) fun (n : pos_num) => Eq.refl (0 + pos n)

theorem add_one (n : num) : n + 1 = succ n := sorry

theorem add_succ (m : num) (n : num) : m + succ n = succ (m + n) := sorry

@[simp] theorem add_of_nat (m : ℕ) (n : ℕ) : ↑(m + n) = ↑m + ↑n := sorry

theorem bit0_of_bit0 (n : num) : bit0 n = num.bit0 n :=
  num.cases_on n (idRhs (bit0 0 = bit0 0) rfl)
    fun (n : pos_num) => idRhs (pos (bit0 n) = pos (pos_num.bit0 n)) (congr_arg pos (pos_num.bit0_of_bit0 n))

theorem bit1_of_bit1 (n : num) : bit1 n = num.bit1 n :=
  num.cases_on n (idRhs (bit1 0 = bit1 0) rfl)
    fun (n : pos_num) => idRhs (pos (bit1 n) = pos (pos_num.bit1 n)) (congr_arg pos (pos_num.bit1_of_bit1 n))

@[simp] theorem cast_zero {α : Type u_1} [HasZero α] [HasOne α] [Add α] : ↑0 = 0 :=
  rfl

@[simp] theorem cast_zero' {α : Type u_1} [HasZero α] [HasOne α] [Add α] : ↑zero = 0 :=
  rfl

@[simp] theorem cast_one {α : Type u_1} [HasZero α] [HasOne α] [Add α] : ↑1 = 1 :=
  rfl

@[simp] theorem cast_pos {α : Type u_1} [HasZero α] [HasOne α] [Add α] (n : pos_num) : ↑(pos n) = ↑n :=
  rfl

theorem succ'_to_nat (n : num) : ↑(succ' n) = ↑n + 1 :=
  num.cases_on n (idRhs (↑(succ' 0) = 0 + ↑(succ' 0)) (Eq.symm (zero_add ↑(succ' 0))))
    fun (n : pos_num) => idRhs (↑(pos_num.succ n) = ↑n + 1) (pos_num.succ_to_nat n)

theorem succ_to_nat (n : num) : ↑(succ n) = ↑n + 1 :=
  succ'_to_nat n

@[simp] theorem cast_to_nat {α : Type u_1} [add_monoid α] [HasOne α] (n : num) : ↑↑n = ↑n :=
  num.cases_on n (idRhs (↑0 = 0) nat.cast_zero) fun (n : pos_num) => idRhs (↑↑n = ↑n) (pos_num.cast_to_nat n)

@[simp] theorem to_nat_to_int (n : num) : ↑↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (Eq.symm (int.nat_cast_eq_coe_nat ↑n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (cast_to_nat n))) (Eq.refl ↑n))

@[simp] theorem cast_to_int {α : Type u_1} [add_group α] [HasOne α] (n : num) : ↑↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (Eq.symm (to_nat_to_int n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑↑n = ↑n)) (int.cast_coe_nat ↑n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (cast_to_nat n))) (Eq.refl ↑n)))

theorem to_of_nat (n : ℕ) : ↑↑n = n := sorry

@[simp] theorem of_nat_cast {α : Type u_1} [add_monoid α] [HasOne α] (n : ℕ) : ↑↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (Eq.symm (cast_to_nat ↑n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑↑n = ↑n)) (to_of_nat n))) (Eq.refl ↑n))

theorem of_nat_inj {m : ℕ} {n : ℕ} : ↑m = ↑n ↔ m = n :=
  { mp := fun (h : ↑m = ↑n) => function.left_inverse.injective to_of_nat h, mpr := congr_arg fun (x : ℕ) => ↑x }

theorem add_to_nat (m : num) (n : num) : ↑(m + n) = ↑m + ↑n := sorry

theorem mul_to_nat (m : num) (n : num) : ↑(m * n) = ↑m * ↑n := sorry

theorem cmp_to_nat (m : num) (n : num) : ordering.cases_on (cmp m n) (↑m < ↑n) (m = n) (↑n < ↑m) := sorry

theorem lt_to_nat {m : num} {n : num} : ↑m < ↑n ↔ m < n := sorry

theorem le_to_nat {m : num} {n : num} : ↑m ≤ ↑n ↔ m ≤ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑m ≤ ↑n ↔ m ≤ n)) (Eq.symm (propext not_lt)))) (not_congr lt_to_nat)

end num

namespace pos_num

@[simp] theorem of_to_nat (n : pos_num) : ↑↑n = num.pos n := sorry

end pos_num

namespace num

@[simp] theorem of_to_nat (n : num) : ↑↑n = n :=
  num.cases_on n (idRhs (↑↑0 = ↑↑0) rfl) fun (n : pos_num) => idRhs (↑↑n = pos n) (pos_num.of_to_nat n)

theorem to_nat_inj {m : num} {n : num} : ↑m = ↑n ↔ m = n :=
  { mp := fun (h : ↑m = ↑n) => function.left_inverse.injective of_to_nat h, mpr := congr_arg fun (x : num) => ↑x }

/--
This tactic tries to turn an (in)equality about `num`s to one about `nat`s by rewriting.
```lean
example (n : num) (m : num) : n ≤ n + m :=
begin
  num.transfer_rw,
  exact nat.le_add_right _ _
end
```
-/
/--
This tactic tries to prove (in)equalities about `num`s by transfering them to the `nat` world and
then trying to call `simp`.
```lean
example (n : num) (m : num) : n ≤ n + m := by num.transfer
```
-/
protected instance comm_semiring : comm_semiring num :=
  comm_semiring.mk Add.add sorry 0 zero_add add_zero sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry sorry sorry

protected instance ordered_cancel_add_comm_monoid : ordered_cancel_add_comm_monoid num :=
  ordered_cancel_add_comm_monoid.mk comm_semiring.add comm_semiring.add_assoc sorry comm_semiring.zero
    comm_semiring.zero_add comm_semiring.add_zero comm_semiring.add_comm sorry LessEq Less sorry sorry sorry sorry sorry

protected instance linear_ordered_semiring : linear_ordered_semiring num :=
  linear_ordered_semiring.mk comm_semiring.add comm_semiring.add_assoc comm_semiring.zero comm_semiring.zero_add
    comm_semiring.add_zero comm_semiring.add_comm comm_semiring.mul comm_semiring.mul_assoc comm_semiring.one
    comm_semiring.one_mul comm_semiring.mul_one comm_semiring.zero_mul comm_semiring.mul_zero comm_semiring.left_distrib
    comm_semiring.right_distrib ordered_cancel_add_comm_monoid.add_left_cancel
    ordered_cancel_add_comm_monoid.add_right_cancel ordered_cancel_add_comm_monoid.le ordered_cancel_add_comm_monoid.lt
    ordered_cancel_add_comm_monoid.le_refl ordered_cancel_add_comm_monoid.le_trans
    ordered_cancel_add_comm_monoid.le_antisymm ordered_cancel_add_comm_monoid.add_le_add_left
    ordered_cancel_add_comm_monoid.le_of_add_le_add_left sorry sorry sorry sorry num.decidable_le num.decidable_eq
    num.decidable_lt sorry

theorem dvd_to_nat (m : num) (n : num) : ↑m ∣ ↑n ↔ m ∣ n := sorry

end num

namespace pos_num

theorem to_nat_inj {m : pos_num} {n : pos_num} : ↑m = ↑n ↔ m = n := sorry

theorem pred'_to_nat (n : pos_num) : ↑(pred' n) = Nat.pred ↑n := sorry

@[simp] theorem pred'_succ' (n : num) : pred' (num.succ' n) = n := sorry

@[simp] theorem succ'_pred' (n : pos_num) : num.succ' (pred' n) = n := sorry

protected instance has_dvd : has_dvd pos_num :=
  has_dvd.mk fun (m n : pos_num) => num.pos m ∣ num.pos n

theorem dvd_to_nat {m : pos_num} {n : pos_num} : ↑m ∣ ↑n ↔ m ∣ n :=
  num.dvd_to_nat (num.pos m) (num.pos n)

theorem size_to_nat (n : pos_num) : ↑(size n) = nat.size ↑n := sorry

theorem size_eq_nat_size (n : pos_num) : ↑(size n) = nat_size n := sorry

theorem nat_size_to_nat (n : pos_num) : nat_size n = nat.size ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat_size n = nat.size ↑n)) (Eq.symm (size_eq_nat_size n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(size n) = nat.size ↑n)) (size_to_nat n))) (Eq.refl (nat.size ↑n)))

theorem nat_size_pos (n : pos_num) : 0 < nat_size n :=
  pos_num.cases_on n (nat.succ_pos 0) (fun (n : pos_num) => nat.succ_pos (nat_size n))
    fun (n : pos_num) => nat.succ_pos (nat_size n)

/--
This tactic tries to turn an (in)equality about `pos_num`s to one about `nat`s by rewriting.
```lean
example (n : pos_num) (m : pos_num) : n ≤ n + m :=
begin
  pos_num.transfer_rw,
  exact nat.le_add_right _ _
end
```
-/
/--
This tactic tries to prove (in)equalities about `pos_num`s by transferring them to the `nat` world
and then trying to call `simp`.
```lean
example (n : pos_num) (m : pos_num) : n ≤ n + m := by pos_num.transfer
```
-/
protected instance add_comm_semigroup : add_comm_semigroup pos_num :=
  add_comm_semigroup.mk Add.add sorry sorry

protected instance comm_monoid : comm_monoid pos_num :=
  comm_monoid.mk Mul.mul sorry 1 sorry sorry sorry

protected instance distrib : distrib pos_num :=
  distrib.mk Mul.mul Add.add sorry sorry

protected instance linear_order : linear_order pos_num :=
  linear_order.mk LessEq Less sorry sorry sorry sorry (fun (a b : pos_num) => pos_num.decidable_le a b)
    (fun (a b : pos_num) => pos_num.decidable_eq a b) fun (a b : pos_num) => pos_num.decidable_lt a b

@[simp] theorem cast_to_num (n : pos_num) : ↑n = num.pos n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n = num.pos n)) (Eq.symm (cast_to_nat n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = num.pos n)) (Eq.symm (of_to_nat n)))) (Eq.refl ↑↑n))

@[simp] theorem bit_to_nat (b : Bool) (n : pos_num) : ↑(bit b n) = nat.bit b ↑n :=
  bool.cases_on b (Eq.refl ↑(bit false n)) (Eq.refl ↑(bit tt n))

@[simp] theorem cast_add {α : Type u_1} [add_monoid α] [HasOne α] (m : pos_num) (n : pos_num) : ↑(m + n) = ↑m + ↑n := sorry

@[simp] theorem cast_succ {α : Type u_1} [add_monoid α] [HasOne α] (n : pos_num) : ↑(succ n) = ↑n + 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(succ n) = ↑n + 1)) (Eq.symm (add_one n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(n + 1) = ↑n + 1)) (cast_add n 1)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑n + ↑1 = ↑n + 1)) cast_one)) (Eq.refl (↑n + 1))))

@[simp] theorem cast_inj {α : Type u_1} [add_monoid α] [HasOne α] [char_zero α] {m : pos_num} {n : pos_num} : ↑m = ↑n ↔ m = n := sorry

@[simp] theorem one_le_cast {α : Type u_1} [linear_ordered_semiring α] (n : pos_num) : 1 ≤ ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 ≤ ↑n)) (Eq.symm (cast_to_nat n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 ≤ ↑↑n)) (Eq.symm nat.cast_one)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑1 ≤ ↑↑n)) (propext nat.cast_le))) (to_nat_pos n)))

@[simp] theorem cast_pos {α : Type u_1} [linear_ordered_semiring α] (n : pos_num) : 0 < ↑n :=
  lt_of_lt_of_le zero_lt_one (one_le_cast n)

@[simp] theorem cast_mul {α : Type u_1} [semiring α] (m : pos_num) (n : pos_num) : ↑(m * n) = ↑m * ↑n := sorry

@[simp] theorem cmp_eq (m : pos_num) (n : pos_num) : cmp m n = ordering.eq ↔ m = n := sorry

@[simp] theorem cast_lt {α : Type u_1} [linear_ordered_semiring α] {m : pos_num} {n : pos_num} : ↑m < ↑n ↔ m < n := sorry

@[simp] theorem cast_le {α : Type u_1} [linear_ordered_semiring α] {m : pos_num} {n : pos_num} : ↑m ≤ ↑n ↔ m ≤ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑m ≤ ↑n ↔ m ≤ n)) (Eq.symm (propext not_lt)))) (not_congr cast_lt)

end pos_num

namespace num

theorem bit_to_nat (b : Bool) (n : num) : ↑(bit b n) = nat.bit b ↑n :=
  bool.cases_on b (num.cases_on n (Eq.refl ↑(bit false zero)) fun (n : pos_num) => Eq.refl ↑(bit false (pos n)))
    (num.cases_on n (Eq.refl ↑(bit tt zero)) fun (n : pos_num) => Eq.refl ↑(bit tt (pos n)))

theorem cast_succ' {α : Type u_1} [add_monoid α] [HasOne α] (n : num) : ↑(succ' n) = ↑n + 1 := sorry

theorem cast_succ {α : Type u_1} [add_monoid α] [HasOne α] (n : num) : ↑(succ n) = ↑n + 1 :=
  cast_succ' n

@[simp] theorem cast_add {α : Type u_1} [semiring α] (m : num) (n : num) : ↑(m + n) = ↑m + ↑n := sorry

@[simp] theorem cast_bit0 {α : Type u_1} [semiring α] (n : num) : ↑(num.bit0 n) = bit0 ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(num.bit0 n) = bit0 ↑n)) (Eq.symm (bit0_of_bit0 n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(bit0 n) = bit0 ↑n)) (bit0.equations._eqn_1 n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑(n + n) = bit0 ↑n)) (cast_add n n))) (Eq.refl (↑n + ↑n))))

@[simp] theorem cast_bit1 {α : Type u_1} [semiring α] (n : num) : ↑(num.bit1 n) = bit1 ↑n := sorry

@[simp] theorem cast_mul {α : Type u_1} [semiring α] (m : num) (n : num) : ↑(m * n) = ↑m * ↑n := sorry

theorem size_to_nat (n : num) : ↑(size n) = nat.size ↑n :=
  num.cases_on n (idRhs (0 = nat.size 0) (Eq.symm nat.size_zero))
    fun (n : pos_num) => idRhs (↑(pos_num.size n) = nat.size ↑n) (pos_num.size_to_nat n)

theorem size_eq_nat_size (n : num) : ↑(size n) = nat_size n :=
  num.cases_on n (idRhs (↑(size 0) = ↑(size 0)) rfl)
    fun (n : pos_num) => idRhs (↑(pos_num.size n) = pos_num.nat_size n) (pos_num.size_eq_nat_size n)

theorem nat_size_to_nat (n : num) : nat_size n = nat.size ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat_size n = nat.size ↑n)) (Eq.symm (size_eq_nat_size n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(size n) = nat.size ↑n)) (size_to_nat n))) (Eq.refl (nat.size ↑n)))

@[simp] theorem of_nat'_eq (n : ℕ) : of_nat' n = ↑n := sorry

theorem zneg_to_znum (n : num) : -to_znum n = to_znum_neg n :=
  num.cases_on n (Eq.refl (-to_znum zero)) fun (n : pos_num) => Eq.refl (-to_znum (pos n))

theorem zneg_to_znum_neg (n : num) : -to_znum_neg n = to_znum n :=
  num.cases_on n (Eq.refl (-to_znum_neg zero)) fun (n : pos_num) => Eq.refl (-to_znum_neg (pos n))

theorem to_znum_inj {m : num} {n : num} : to_znum m = to_znum n ↔ m = n := sorry

@[simp] theorem cast_to_znum {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] (n : num) : ↑(to_znum n) = ↑n :=
  num.cases_on n (idRhs (↑(to_znum 0) = ↑(to_znum 0)) rfl)
    fun (n : pos_num) => idRhs (↑(to_znum (pos n)) = ↑(to_znum (pos n))) rfl

@[simp] theorem cast_to_znum_neg {α : Type u_1} [add_group α] [HasOne α] (n : num) : ↑(to_znum_neg n) = -↑n :=
  num.cases_on n (idRhs (0 = -0) (Eq.symm neg_zero))
    fun (n : pos_num) => idRhs (↑(to_znum_neg (pos n)) = ↑(to_znum_neg (pos n))) rfl

@[simp] theorem add_to_znum (m : num) (n : num) : to_znum (m + n) = to_znum m + to_znum n :=
  num.cases_on m (num.cases_on n (Eq.refl (to_znum (zero + zero))) fun (n : pos_num) => Eq.refl (to_znum (zero + pos n)))
    fun (m : pos_num) =>
      num.cases_on n (Eq.refl (to_znum (pos m + zero))) fun (n : pos_num) => Eq.refl (to_znum (pos m + pos n))

end num

namespace pos_num

theorem pred_to_nat {n : pos_num} (h : 1 < n) : ↑(pred n) = Nat.pred ↑n := sorry

theorem sub'_one (a : pos_num) : sub' a 1 = num.to_znum (pred' a) :=
  pos_num.cases_on a (Eq.refl (sub' one 1)) (fun (a : pos_num) => Eq.refl (sub' (bit1 a) 1))
    fun (a : pos_num) => Eq.refl (sub' (bit0 a) 1)

theorem one_sub' (a : pos_num) : sub' 1 a = num.to_znum_neg (pred' a) :=
  pos_num.cases_on a (Eq.refl (sub' 1 one)) (fun (a : pos_num) => Eq.refl (sub' 1 (bit1 a)))
    fun (a : pos_num) => Eq.refl (sub' 1 (bit0 a))

theorem lt_iff_cmp {m : pos_num} {n : pos_num} : m < n ↔ cmp m n = ordering.lt :=
  iff.rfl

theorem le_iff_cmp {m : pos_num} {n : pos_num} : m ≤ n ↔ cmp m n ≠ ordering.gt := sorry

end pos_num

namespace num

theorem pred_to_nat (n : num) : ↑(pred n) = Nat.pred ↑n := sorry

theorem ppred_to_nat (n : num) : coe <$> ppred n = nat.ppred ↑n := sorry

theorem cmp_swap (m : num) (n : num) : ordering.swap (cmp m n) = cmp n m := sorry

theorem cmp_eq (m : num) (n : num) : cmp m n = ordering.eq ↔ m = n := sorry

@[simp] theorem cast_lt {α : Type u_1} [linear_ordered_semiring α] {m : num} {n : num} : ↑m < ↑n ↔ m < n := sorry

@[simp] theorem cast_le {α : Type u_1} [linear_ordered_semiring α] {m : num} {n : num} : ↑m ≤ ↑n ↔ m ≤ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑m ≤ ↑n ↔ m ≤ n)) (Eq.symm (propext not_lt)))) (not_congr cast_lt)

@[simp] theorem cast_inj {α : Type u_1} [linear_ordered_semiring α] {m : num} {n : num} : ↑m = ↑n ↔ m = n := sorry

theorem lt_iff_cmp {m : num} {n : num} : m < n ↔ cmp m n = ordering.lt :=
  iff.rfl

theorem le_iff_cmp {m : num} {n : num} : m ≤ n ↔ cmp m n ≠ ordering.gt := sorry

theorem bitwise_to_nat {f : num → num → num} {g : Bool → Bool → Bool} (p : pos_num → pos_num → num) (gff : g false false = false) (f00 : f 0 0 = 0) (f0n : ∀ (n : pos_num), f 0 (pos n) = cond (g false tt) (pos n) 0) (fn0 : ∀ (n : pos_num), f (pos n) 0 = cond (g tt false) (pos n) 0) (fnn : ∀ (m n : pos_num), f (pos m) (pos n) = p m n) (p11 : p 1 1 = cond (g tt tt) 1 0) (p1b : ∀ (b : Bool) (n : pos_num), p 1 (pos_num.bit b n) = bit (g tt b) (cond (g false tt) (pos n) 0)) (pb1 : ∀ (a : Bool) (m : pos_num), p (pos_num.bit a m) 1 = bit (g a tt) (cond (g tt false) (pos m) 0)) (pbb : ∀ (a b : Bool) (m n : pos_num), p (pos_num.bit a m) (pos_num.bit b n) = bit (g a b) (p m n)) (m : num) (n : num) : ↑(f m n) = nat.bitwise g ↑m ↑n := sorry

@[simp] theorem lor_to_nat (m : num) (n : num) : ↑(lor m n) = nat.lor ↑m ↑n := sorry

@[simp] theorem land_to_nat (m : num) (n : num) : ↑(land m n) = nat.land ↑m ↑n := sorry

@[simp] theorem ldiff_to_nat (m : num) (n : num) : ↑(ldiff m n) = nat.ldiff ↑m ↑n := sorry

@[simp] theorem lxor_to_nat (m : num) (n : num) : ↑(lxor m n) = nat.lxor ↑m ↑n := sorry

@[simp] theorem shiftl_to_nat (m : num) (n : ℕ) : ↑(shiftl m n) = nat.shiftl (↑m) n := sorry

@[simp] theorem shiftr_to_nat (m : num) (n : ℕ) : ↑(shiftr m n) = nat.shiftr (↑m) n := sorry

@[simp] theorem test_bit_to_nat (m : num) (n : ℕ) : test_bit m n = nat.test_bit (↑m) n := sorry

end num

namespace znum

@[simp] theorem cast_zero {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] : ↑0 = 0 :=
  rfl

@[simp] theorem cast_zero' {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] : ↑zero = 0 :=
  rfl

@[simp] theorem cast_one {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] : ↑1 = 1 :=
  rfl

@[simp] theorem cast_pos {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] (n : pos_num) : ↑(pos n) = ↑n :=
  rfl

@[simp] theorem cast_neg {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] (n : pos_num) : ↑(neg n) = -↑n :=
  rfl

@[simp] theorem cast_zneg {α : Type u_1} [add_group α] [HasOne α] (n : znum) : ↑(-n) = -↑n :=
  znum.cases_on n (idRhs (0 = -0) (Eq.symm neg_zero)) (fun (n : pos_num) => idRhs (↑(-pos n) = ↑(-pos n)) rfl)
    fun (n : pos_num) => idRhs (↑(-neg n) = --↑(-neg n)) (Eq.symm (neg_neg ↑(-neg n)))

theorem neg_zero : -0 = 0 :=
  rfl

theorem zneg_pos (n : pos_num) : -pos n = neg n :=
  rfl

theorem zneg_neg (n : pos_num) : -neg n = pos n :=
  rfl

theorem zneg_zneg (n : znum) : --n = n :=
  znum.cases_on n (Eq.refl ( --zero)) (fun (n : pos_num) => Eq.refl ( --pos n)) fun (n : pos_num) => Eq.refl ( --neg n)

theorem zneg_bit1 (n : znum) : -znum.bit1 n = znum.bitm1 (-n) :=
  znum.cases_on n (Eq.refl (-znum.bit1 zero)) (fun (n : pos_num) => Eq.refl (-znum.bit1 (pos n)))
    fun (n : pos_num) => Eq.refl (-znum.bit1 (neg n))

theorem zneg_bitm1 (n : znum) : -znum.bitm1 n = znum.bit1 (-n) :=
  znum.cases_on n (Eq.refl (-znum.bitm1 zero)) (fun (n : pos_num) => Eq.refl (-znum.bitm1 (pos n)))
    fun (n : pos_num) => Eq.refl (-znum.bitm1 (neg n))

theorem zneg_succ (n : znum) : -succ n = pred (-n) := sorry

theorem zneg_pred (n : znum) : -pred n = succ (-n) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-pred n = succ (-n))) (Eq.symm (zneg_zneg (succ (-n))))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-pred n = --succ (-n))) (zneg_succ (-n))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (-pred n = -pred ( --n))) (zneg_zneg n))) (Eq.refl (-pred n))))

@[simp] theorem neg_of_int (n : ℤ) : ↑(-n) = -↑n :=
  int.cases_on n
    (fun (n : ℕ) => nat.cases_on n (idRhs (↑(-0) = ↑(-0)) rfl) fun (n : ℕ) => idRhs (↑(-↑(n + 1)) = ↑(-↑(n + 1))) rfl)
    fun (n : ℕ) => idRhs (↑(-Int.negSucc n) = --↑(-Int.negSucc n)) (Eq.symm (zneg_zneg ↑(-Int.negSucc n)))

@[simp] theorem abs_to_nat (n : znum) : ↑(abs n) = int.nat_abs ↑n := sorry

@[simp] theorem abs_to_znum (n : num) : abs (num.to_znum n) = n :=
  num.cases_on n (idRhs (abs (num.to_znum 0) = abs (num.to_znum 0)) rfl)
    fun (n : pos_num) => idRhs (abs (num.to_znum (num.pos n)) = abs (num.to_znum (num.pos n))) rfl

@[simp] theorem cast_to_int {α : Type u_1} [add_group α] [HasOne α] (n : znum) : ↑↑n = ↑n := sorry

theorem bit0_of_bit0 (n : znum) : bit0 n = znum.bit0 n :=
  znum.cases_on n (idRhs (bit0 0 = bit0 0) rfl)
    (fun (n : pos_num) => idRhs (pos (bit0 n) = pos (pos_num.bit0 n)) (congr_arg pos (pos_num.bit0_of_bit0 n)))
    fun (n : pos_num) => idRhs (neg (bit0 n) = neg (pos_num.bit0 n)) (congr_arg neg (pos_num.bit0_of_bit0 n))

theorem bit1_of_bit1 (n : znum) : bit1 n = znum.bit1 n := sorry

@[simp] theorem cast_bit0 {α : Type u_1} [add_group α] [HasOne α] (n : znum) : ↑(znum.bit0 n) = bit0 ↑n := sorry

@[simp] theorem cast_bit1 {α : Type u_1} [add_group α] [HasOne α] (n : znum) : ↑(znum.bit1 n) = bit1 ↑n := sorry

@[simp] theorem cast_bitm1 {α : Type u_1} [add_group α] [HasOne α] (n : znum) : ↑(znum.bitm1 n) = bit0 ↑n - 1 := sorry

theorem add_zero (n : znum) : n + 0 = n :=
  znum.cases_on n (Eq.refl (zero + 0)) (fun (n : pos_num) => Eq.refl (pos n + 0)) fun (n : pos_num) => Eq.refl (neg n + 0)

theorem zero_add (n : znum) : 0 + n = n :=
  znum.cases_on n (Eq.refl (0 + zero)) (fun (n : pos_num) => Eq.refl (0 + pos n)) fun (n : pos_num) => Eq.refl (0 + neg n)

theorem add_one (n : znum) : n + 1 = succ n := sorry

end znum

namespace pos_num

theorem cast_to_znum (n : pos_num) : ↑n = znum.pos n := sorry

theorem cast_sub' {α : Type u_1} [add_group α] [HasOne α] (m : pos_num) (n : pos_num) : ↑(sub' m n) = ↑m - ↑n := sorry

theorem to_nat_eq_succ_pred (n : pos_num) : ↑n = ↑(pred' n) + 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n = ↑(pred' n) + 1)) (Eq.symm (num.succ'_to_nat (pred' n)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n = ↑(num.succ' (pred' n)))) (succ'_pred' n))) (Eq.refl ↑n))

theorem to_int_eq_succ_pred (n : pos_num) : ↑n = ↑↑(pred' n) + 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n = ↑↑(pred' n) + 1)) (Eq.symm (to_nat_to_int n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑↑(pred' n) + 1)) (to_nat_eq_succ_pred n))) (Eq.refl ↑(↑(pred' n) + 1)))

end pos_num

namespace num

@[simp] theorem cast_sub' {α : Type u_1} [add_group α] [HasOne α] (m : num) (n : num) : ↑(sub' m n) = ↑m - ↑n := sorry

@[simp] theorem of_nat_to_znum (n : ℕ) : to_znum ↑n = ↑n := sorry

@[simp] theorem of_nat_to_znum_neg (n : ℕ) : to_znum_neg ↑n = -↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (to_znum_neg ↑n = -↑n)) (Eq.symm (of_nat_to_znum n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (to_znum_neg ↑n = -to_znum ↑n)) (zneg_to_znum ↑n))) (Eq.refl (to_znum_neg ↑n)))

theorem mem_of_znum' {m : num} {n : znum} : m ∈ of_znum' n ↔ n = to_znum m := sorry

theorem of_znum'_to_nat (n : znum) : coe <$> of_znum' n = int.to_nat' ↑n := sorry

@[simp] theorem of_znum_to_nat (n : znum) : ↑(of_znum n) = int.to_nat ↑n := sorry

@[simp] theorem cast_of_znum {α : Type u_1} [add_group α] [HasOne α] (n : znum) : ↑(of_znum n) = ↑(int.to_nat ↑n) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(of_znum n) = ↑(int.to_nat ↑n))) (Eq.symm (cast_to_nat (of_znum n)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑(of_znum n) = ↑(int.to_nat ↑n))) (of_znum_to_nat n))) (Eq.refl ↑(int.to_nat ↑n)))

@[simp] theorem sub_to_nat (m : num) (n : num) : ↑(m - n) = ↑m - ↑n := sorry

end num

namespace znum

@[simp] theorem cast_add {α : Type u_1} [add_group α] [HasOne α] (m : znum) (n : znum) : ↑(m + n) = ↑m + ↑n := sorry

@[simp] theorem cast_succ {α : Type u_1} [add_group α] [HasOne α] (n : znum) : ↑(succ n) = ↑n + 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(succ n) = ↑n + 1)) (Eq.symm (add_one n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(n + 1) = ↑n + 1)) (cast_add n 1)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑n + ↑1 = ↑n + 1)) cast_one)) (Eq.refl (↑n + 1))))

@[simp] theorem mul_to_int (m : znum) (n : znum) : ↑(m * n) = ↑m * ↑n := sorry

theorem cast_mul {α : Type u_1} [ring α] (m : znum) (n : znum) : ↑(m * n) = ↑m * ↑n := sorry

@[simp] theorem of_to_int (n : znum) : ↑↑n = n := sorry

theorem to_of_int (n : ℤ) : ↑↑n = n := sorry

theorem to_int_inj {m : znum} {n : znum} : ↑m = ↑n ↔ m = n :=
  { mp := fun (h : ↑m = ↑n) => function.left_inverse.injective of_to_int h, mpr := congr_arg fun (x : znum) => ↑x }

@[simp] theorem of_int_cast {α : Type u_1} [add_group α] [HasOne α] (n : ℤ) : ↑↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (Eq.symm (cast_to_int ↑n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑↑n = ↑n)) (to_of_int n))) (Eq.refl ↑n))

@[simp] theorem of_nat_cast {α : Type u_1} [add_group α] [HasOne α] (n : ℕ) : ↑↑n = ↑n :=
  of_int_cast ↑n

@[simp] theorem of_int'_eq (n : ℤ) : of_int' n = ↑n := sorry

theorem cmp_to_int (m : znum) (n : znum) : ordering.cases_on (cmp m n) (↑m < ↑n) (m = n) (↑n < ↑m) := sorry

theorem lt_to_int {m : znum} {n : znum} : ↑m < ↑n ↔ m < n := sorry

theorem le_to_int {m : znum} {n : znum} : ↑m ≤ ↑n ↔ m ≤ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑m ≤ ↑n ↔ m ≤ n)) (Eq.symm (propext not_lt)))) (not_congr lt_to_int)

@[simp] theorem cast_lt {α : Type u_1} [linear_ordered_ring α] {m : znum} {n : znum} : ↑m < ↑n ↔ m < n := sorry

@[simp] theorem cast_le {α : Type u_1} [linear_ordered_ring α] {m : znum} {n : znum} : ↑m ≤ ↑n ↔ m ≤ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑m ≤ ↑n ↔ m ≤ n)) (Eq.symm (propext not_lt)))) (not_congr cast_lt)

@[simp] theorem cast_inj {α : Type u_1} [linear_ordered_ring α] {m : znum} {n : znum} : ↑m = ↑n ↔ m = n := sorry

/--
This tactic tries to turn an (in)equality about `znum`s to one about `int`s by rewriting.
```lean
example (n : znum) (m : znum) : n ≤ n + m * m :=
begin
  znum.transfer_rw,
  exact le_add_of_nonneg_right (mul_self_nonneg _)
end
```
-/
/--
This tactic tries to prove (in)equalities about `znum`s by transfering them to the `int` world and
then trying to call `simp`.
```lean
example (n : znum) (m : znum) : n ≤ n + m * m :=
begin
  znum.transfer,
  exact mul_self_nonneg _
end
```
-/
protected instance linear_order : linear_order znum :=
  linear_order.mk LessEq Less sorry sorry sorry sorry znum.decidable_le znum.decidable_eq znum.decidable_lt

protected instance add_comm_group : add_comm_group znum :=
  add_comm_group.mk Add.add sorry 0 zero_add add_zero Neg.neg
    (add_group.sub._default Add.add sorry 0 zero_add add_zero Neg.neg) sorry sorry

protected instance linear_ordered_comm_ring : linear_ordered_comm_ring znum :=
  linear_ordered_comm_ring.mk add_comm_group.add add_comm_group.add_assoc add_comm_group.zero add_comm_group.zero_add
    add_comm_group.add_zero add_comm_group.neg add_comm_group.sub add_comm_group.add_left_neg add_comm_group.add_comm
    Mul.mul sorry 1 sorry sorry sorry sorry linear_order.le linear_order.lt linear_order.le_refl linear_order.le_trans
    linear_order.le_antisymm sorry sorry sorry linear_order.le_total linear_order.decidable_le linear_order.decidable_eq
    linear_order.decidable_lt sorry sorry

@[simp] theorem dvd_to_int (m : znum) (n : znum) : ↑m ∣ ↑n ↔ m ∣ n := sorry

end znum

namespace pos_num

theorem divmod_to_nat_aux {n : pos_num} {d : pos_num} {q : num} {r : num} (h₁ : ↑r + ↑d * bit0 ↑q = ↑n) (h₂ : ↑r < bit0 1 * ↑d) : ↑(prod.snd (divmod_aux d q r)) + ↑d * ↑(prod.fst (divmod_aux d q r)) = ↑n ∧ ↑(prod.snd (divmod_aux d q r)) < ↑d := sorry

theorem divmod_to_nat (d : pos_num) (n : pos_num) : ↑n / ↑d = ↑(prod.fst (divmod d n)) ∧ ↑n % ↑d = ↑(prod.snd (divmod d n)) := sorry

@[simp] theorem div'_to_nat (n : pos_num) (d : pos_num) : ↑(div' n d) = ↑n / ↑d :=
  Eq.symm (and.left (divmod_to_nat d n))

@[simp] theorem mod'_to_nat (n : pos_num) (d : pos_num) : ↑(mod' n d) = ↑n % ↑d :=
  Eq.symm (and.right (divmod_to_nat d n))

end pos_num

namespace num

@[simp] theorem div_to_nat (n : num) (d : num) : ↑(n / d) = ↑n / ↑d := sorry

@[simp] theorem mod_to_nat (n : num) (d : num) : ↑(n % d) = ↑n % ↑d := sorry

theorem gcd_to_nat_aux {n : ℕ} {a : num} {b : num} : a ≤ b → nat_size (a * b) ≤ n → ↑(gcd_aux n a b) = nat.gcd ↑a ↑b := sorry

@[simp] theorem gcd_to_nat (a : num) (b : num) : ↑(gcd a b) = nat.gcd ↑a ↑b := sorry

theorem dvd_iff_mod_eq_zero {m : num} {n : num} : m ∣ n ↔ n % m = 0 := sorry

protected instance decidable_dvd : DecidableRel has_dvd.dvd :=
  sorry

end num

protected instance pos_num.decidable_dvd : DecidableRel has_dvd.dvd :=
  sorry

namespace znum

@[simp] theorem div_to_int (n : znum) (d : znum) : ↑(n / d) = ↑n / ↑d := sorry

@[simp] theorem mod_to_int (n : znum) (d : znum) : ↑(n % d) = ↑n % ↑d := sorry

@[simp] theorem gcd_to_nat (a : znum) (b : znum) : ↑(gcd a b) = int.gcd ↑a ↑b := sorry

theorem dvd_iff_mod_eq_zero {m : znum} {n : znum} : m ∣ n ↔ n % m = 0 := sorry

protected instance has_dvd.dvd.decidable_rel : DecidableRel has_dvd.dvd :=
  sorry

end znum

namespace int

/-- Cast a `snum` to the corresponding integer. -/
def of_snum : snum → ℤ :=
  snum.rec' (fun (a : Bool) => cond a (-1) 0) fun (a : Bool) (p : snum) (IH : ℤ) => cond a (bit1 IH) (bit0 IH)

end int

protected instance int.snum_coe : has_coe snum ℤ :=
  has_coe.mk int.of_snum

protected instance snum.has_lt : HasLess snum :=
  { Less := fun (a b : snum) => ↑a < ↑b }

protected instance snum.has_le : HasLessEq snum :=
  { LessEq := fun (a b : snum) => ↑a ≤ ↑b }