/-
Copyright (c) 2017 Mario Carneiro. 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.finset.basic
import Mathlib.data.multiset.fold
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# The fold operation for a commutative associative operation over a finset.
-/

namespace finset

/-! ### fold -/

/-- `fold op b f s` folds the commutative associative operation `op` over the
  `f`-image of `s`, i.e. `fold (+) b f {1,2,3} = `f 1 + f 2 + f 3 + b`. -/
def fold {α : Type u_1} {β : Type u_2} (op : β → β → β) [hc : is_commutative β op] [ha : is_associative β op] (b : β) (f : α → β) (s : finset α) : β :=
  multiset.fold op b (multiset.map f (val s))

@[simp] theorem fold_empty {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} : fold op b f ∅ = b :=
  rfl

@[simp] theorem fold_insert {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {a : α} [DecidableEq α] (h : ¬a ∈ s) : fold op b f (insert a s) = op (f a) (fold op b f s) := sorry

@[simp] theorem fold_singleton {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {a : α} : fold op b f (singleton a) = op (f a) b :=
  rfl

@[simp] theorem fold_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {g : γ ↪ α} {s : finset γ} : fold op b f (map g s) = fold op b (f ∘ ⇑g) s := sorry

@[simp] theorem fold_image {α : Type u_1} {β : Type u_2} {γ : Type u_3} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} [DecidableEq α] {g : γ → α} {s : finset γ} (H : ∀ (x : γ), x ∈ s → ∀ (y : γ), y ∈ s → g x = g y → x = y) : fold op b f (image g s) = fold op b (f ∘ g) s := sorry

theorem fold_congr {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {g : α → β} (H : ∀ (x : α), x ∈ s → f x = g x) : fold op b f s = fold op b g s := sorry

theorem fold_op_distrib {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {s : finset α} {f : α → β} {g : α → β} {b₁ : β} {b₂ : β} : fold op (op b₁ b₂) (fun (x : α) => op (f x) (g x)) s = op (fold op b₁ f s) (fold op b₂ g s) := sorry

theorem fold_hom {α : Type u_1} {β : Type u_2} {γ : Type u_3} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {op' : γ → γ → γ} [is_commutative γ op'] [is_associative γ op'] {m : β → γ} (hm : ∀ (x y : β), m (op x y) = op' (m x) (m y)) : fold op' (m b) (fun (x : α) => m (f x)) s = m (fold op b f s) := sorry

theorem fold_union_inter {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} [DecidableEq α] {s₁ : finset α} {s₂ : finset α} {b₁ : β} {b₂ : β} : op (fold op b₁ f (s₁ ∪ s₂)) (fold op b₂ f (s₁ ∩ s₂)) = op (fold op b₂ f s₁) (fold op b₁ f s₂) := sorry

@[simp] theorem fold_insert_idem {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {a : α} [DecidableEq α] [hi : is_idempotent β op] : fold op b f (insert a s) = op (f a) (fold op b f s) := sorry

theorem fold_op_rel_iff_and {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {r : β → β → Prop} (hr : ∀ {x y z : β}, r x (op y z) ↔ r x y ∧ r x z) {c : β} : r c (fold op b f s) ↔ r c b ∧ ∀ (x : α), x ∈ s → r c (f x) := sorry

theorem fold_op_rel_iff_or {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {r : β → β → Prop} (hr : ∀ {x y z : β}, r x (op y z) ↔ r x y ∨ r x z) {c : β} : r c (fold op b f s) ↔ r c b ∨ ∃ (x : α), ∃ (H : x ∈ s), r c (f x) := sorry

@[simp] theorem fold_union_empty_singleton {α : Type u_1} [DecidableEq α] (s : finset α) : fold has_union.union ∅ singleton s = s := sorry

@[simp] theorem fold_sup_bot_singleton {α : Type u_1} [DecidableEq α] (s : finset α) : fold has_sup.sup ⊥ singleton s = s :=
  fold_union_empty_singleton s

theorem le_fold_min {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α} [linear_order β] (c : β) : c ≤ fold min b f s ↔ c ≤ b ∧ ∀ (x : α), x ∈ s → c ≤ f x :=
  fold_op_rel_iff_and fun (x y z : β) => le_min_iff

theorem fold_min_le {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α} [linear_order β] (c : β) : fold min b f s ≤ c ↔ b ≤ c ∨ ∃ (x : α), ∃ (H : x ∈ s), f x ≤ c :=
  id (fold_op_rel_iff_or fun (x y z : β) => id min_le_iff)

theorem lt_fold_min {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α} [linear_order β] (c : β) : c < fold min b f s ↔ c < b ∧ ∀ (x : α), x ∈ s → c < f x :=
  fold_op_rel_iff_and fun (x y z : β) => lt_min_iff

theorem fold_min_lt {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α} [linear_order β] (c : β) : fold min b f s < c ↔ b < c ∨ ∃ (x : α), ∃ (H : x ∈ s), f x < c :=
  id (fold_op_rel_iff_or fun (x y z : β) => id min_lt_iff)

theorem fold_max_le {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α} [linear_order β] (c : β) : fold max b f s ≤ c ↔ b ≤ c ∧ ∀ (x : α), x ∈ s → f x ≤ c :=
  id (fold_op_rel_iff_and fun (x y z : β) => id max_le_iff)

theorem le_fold_max {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α} [linear_order β] (c : β) : c ≤ fold max b f s ↔ c ≤ b ∨ ∃ (x : α), ∃ (H : x ∈ s), c ≤ f x :=
  fold_op_rel_iff_or fun (x y z : β) => le_max_iff

theorem fold_max_lt {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α} [linear_order β] (c : β) : fold max b f s < c ↔ b < c ∧ ∀ (x : α), x ∈ s → f x < c :=
  id (fold_op_rel_iff_and fun (x y z : β) => id max_lt_iff)

theorem lt_fold_max {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α} [linear_order β] (c : β) : c < fold max b f s ↔ c < b ∨ ∃ (x : α), ∃ (H : x ∈ s), c < f x :=
  fold_op_rel_iff_or fun (x y z : β) => lt_max_iff


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca, Johan Commelin, Scott Morrison
-/
import analysis.normed.group.SemiNormedGroup
import analysis.normed.group.quotient
import category_theory.limits.shapes.kernels

/-!
# Kernels and cokernels in SemiNormedGroup₁ and SemiNormedGroup

We show that `SemiNormedGroup₁` has cokernels
(for which of course the `cokernel.π f` maps are norm non-increasing),
as well as the easier result that `SemiNormedGroup` has cokernels. We also show that
`SemiNormedGroup` has kernels.

So far, I don't see a way to state nicely what we really want:
`SemiNormedGroup` has cokernels, and `cokernel.π f` is norm non-increasing.
The problem is that the limits API doesn't promise you any particular model of the cokernel,
and in `SemiNormedGroup` one can always take a cokernel and rescale its norm
(and hence making `cokernel.π f` arbitrarily large in norm), obtaining another categorical cokernel.

-/

open category_theory category_theory.limits

universe u

namespace SemiNormedGroup₁

noncomputable theory

/-- Auxiliary definition for `has_cokernels SemiNormedGroup₁`. -/
def cokernel_cocone {X Y : SemiNormedGroup₁.{u}} (f : X ⟶ Y) : cofork f 0 :=
cofork.of_π
  (@SemiNormedGroup₁.mk_hom
    _ (SemiNormedGroup.of (Y ⧸ (normed_add_group_hom.range f.1)))
    f.1.range.normed_mk
    (normed_add_group_hom.is_quotient_quotient _).norm_le)
  begin
    ext,
    simp only [comp_apply, limits.zero_comp, normed_add_group_hom.zero_apply,
      SemiNormedGroup₁.mk_hom_apply, SemiNormedGroup₁.zero_apply, ←normed_add_group_hom.mem_ker,
      f.1.range.ker_normed_mk, f.1.mem_range],
    use x,
    refl,
  end

/-- Auxiliary definition for `has_cokernels SemiNormedGroup₁`. -/
def cokernel_lift {X Y : SemiNormedGroup₁.{u}} (f : X ⟶ Y) (s : cokernel_cofork f) :
  (cokernel_cocone f).X ⟶ s.X :=
begin
  fsplit,
  -- The lift itself:
  { apply normed_add_group_hom.lift _ s.π.1,
    rintro _ ⟨b, rfl⟩,
    change (f ≫ s.π) b = 0,
    simp, },
  -- The lift has norm at most one:
  exact normed_add_group_hom.lift_norm_noninc _ _ _ s.π.2,
end

instance : has_cokernels SemiNormedGroup₁.{u} :=
{ has_colimit := λ X Y f, has_colimit.mk
  { cocone := cokernel_cocone f,
    is_colimit := is_colimit_aux _
      (cokernel_lift f)
      (λ s, begin
        ext,
        apply normed_add_group_hom.lift_mk f.1.range,
        rintro _ ⟨b, rfl⟩,
        change (f ≫ s.π) b = 0,
        simp,
      end)
      (λ s m w, subtype.eq
        (normed_add_group_hom.lift_unique f.1.range _ _ _ (congr_arg subtype.val w : _))), } }

-- Sanity check
example : has_cokernels SemiNormedGroup₁ := by apply_instance

end SemiNormedGroup₁

namespace SemiNormedGroup

section equalizers_and_kernels

/-- The equalizer cone for a parallel pair of morphisms of seminormed groups. -/
def fork {V W : SemiNormedGroup.{u}} (f g : V ⟶ W) : fork f g :=
@fork.of_ι _ _ _ _ _ _ (of (f - g).ker) (normed_add_group_hom.incl (f - g).ker) $
begin
  ext v,
  have : v.1 ∈ (f - g).ker := v.2,
  simpa only [normed_add_group_hom.incl_apply, pi.zero_apply, coe_comp,
    normed_add_group_hom.coe_zero, subtype.val_eq_coe, normed_add_group_hom.mem_ker,
    normed_add_group_hom.coe_sub, pi.sub_apply, sub_eq_zero] using this
end

instance has_limit_parallel_pair {V W : SemiNormedGroup.{u}} (f g : V ⟶ W) :
  has_limit (parallel_pair f g) :=
{ exists_limit := nonempty.intro
  { cone := fork f g,
    is_limit := fork.is_limit.mk _
      (λ c, normed_add_group_hom.ker.lift (fork.ι c) _ $
      show normed_add_group_hom.comp_hom (f - g) c.ι = 0,
      by { rw [add_monoid_hom.map_sub, add_monoid_hom.sub_apply, sub_eq_zero], exact c.condition })
      (λ c, normed_add_group_hom.ker.incl_comp_lift _ _ _)
      (λ c g h, by { ext x, dsimp, rw ← h, refl }) } }

instance : limits.has_equalizers.{u (u+1)} SemiNormedGroup :=
@has_equalizers_of_has_limit_parallel_pair SemiNormedGroup _ $ λ V W f g,
  SemiNormedGroup.has_limit_parallel_pair f g

end equalizers_and_kernels

section cokernel

-- PROJECT: can we reuse the work to construct cokernels in `SemiNormedGroup₁` here?
-- I don't see a way to do this that is less work than just repeating the relevant parts.

/-- Auxiliary definition for `has_cokernels SemiNormedGroup`. -/
def cokernel_cocone {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : cofork f 0 :=
@cofork.of_π _ _ _ _ _ _
  (SemiNormedGroup.of (Y ⧸ (normed_add_group_hom.range f)))
  f.range.normed_mk
  begin
    ext,
    simp only [comp_apply, limits.zero_comp, normed_add_group_hom.zero_apply,
      ←normed_add_group_hom.mem_ker, f.range.ker_normed_mk, f.mem_range, exists_apply_eq_apply],
  end

/-- Auxiliary definition for `has_cokernels SemiNormedGroup`. -/
def cokernel_lift {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) (s : cokernel_cofork f) :
  (cokernel_cocone f).X ⟶ s.X := normed_add_group_hom.lift _ s.π
begin
  rintro _ ⟨b, rfl⟩,
  change (f ≫ s.π) b = 0,
  simp,
end

/-- Auxiliary definition for `has_cokernels SemiNormedGroup`. -/
def is_colimit_cokernel_cocone {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
  is_colimit (cokernel_cocone f) :=
is_colimit_aux _ (cokernel_lift f)
(λ s, begin
  ext,
  apply normed_add_group_hom.lift_mk f.range,
  rintro _ ⟨b, rfl⟩,
  change (f ≫ s.π) b = 0,
  simp,
end)
(λ s m w, normed_add_group_hom.lift_unique f.range _ _ _ w)

instance : has_cokernels SemiNormedGroup.{u} :=
{ has_colimit := λ X Y f, has_colimit.mk
  { cocone := cokernel_cocone f,
    is_colimit := is_colimit_cokernel_cocone f } }

-- Sanity check
example : has_cokernels SemiNormedGroup := by apply_instance

section explicit_cokernel

/-- An explicit choice of cokernel, which has good properties with respect to the norm. -/
def explicit_cokernel {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : SemiNormedGroup.{u} :=
(cokernel_cocone f).X

/-- Descend to the explicit cokernel. -/
def explicit_cokernel_desc {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
  (w : f ≫ g = 0) : explicit_cokernel f ⟶ Z :=
(is_colimit_cokernel_cocone f).desc (cofork.of_π g (by simp [w]))

/-- The projection from `Y` to the explicit cokernel of `X ⟶ Y`. -/
def explicit_cokernel_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : Y ⟶ explicit_cokernel f :=
(cokernel_cocone f).ι.app walking_parallel_pair.one

lemma explicit_cokernel_π_surjective {X Y : SemiNormedGroup.{u}} {f : X ⟶ Y} :
  function.surjective (explicit_cokernel_π f) :=
surjective_quot_mk _

@[simp, reassoc]
lemma comp_explicit_cokernel_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
  f ≫ explicit_cokernel_π f = 0 :=
begin
  convert (cokernel_cocone f).w walking_parallel_pair_hom.left,
  simp,
end

@[simp]
lemma explicit_cokernel_π_apply_dom_eq_zero {X Y : SemiNormedGroup.{u}} {f : X ⟶ Y} (x : X) :
  (explicit_cokernel_π f) (f x) = 0 :=
show (f ≫ (explicit_cokernel_π f)) x = 0, by { rw [comp_explicit_cokernel_π], refl }

@[simp, reassoc]
lemma explicit_cokernel_π_desc {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
  (w : f ≫ g = 0) : explicit_cokernel_π f ≫ explicit_cokernel_desc w = g :=
(is_colimit_cokernel_cocone f).fac _ _

@[simp]
lemma explicit_cokernel_π_desc_apply {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
  {cond : f ≫ g = 0} (x : Y) : explicit_cokernel_desc cond (explicit_cokernel_π f x) = g x :=
show (explicit_cokernel_π f ≫ explicit_cokernel_desc cond) x = g x, by rw explicit_cokernel_π_desc

lemma explicit_cokernel_desc_unique {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
  (w : f ≫ g = 0) (e : explicit_cokernel f ⟶ Z) (he : explicit_cokernel_π f ≫ e = g) :
  e = explicit_cokernel_desc w :=
begin
  apply (is_colimit_cokernel_cocone f).uniq (cofork.of_π g (by simp [w])),
  rintro (_|_),
  { convert w.symm,
    simp },
  { exact he }
end

lemma explicit_cokernel_desc_comp_eq_desc {X Y Z W : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
  {h : Z ⟶ W} {cond : f ≫ g = 0} :
  explicit_cokernel_desc cond ≫ h = explicit_cokernel_desc (show f ≫ (g ≫ h) = 0,
  by rw [← category_theory.category.assoc, cond, limits.zero_comp]) :=
begin
  refine explicit_cokernel_desc_unique _ _ _,
  rw [← category_theory.category.assoc, explicit_cokernel_π_desc]
end

@[simp]
lemma explicit_cokernel_desc_zero {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} :
  explicit_cokernel_desc (show f ≫ (0 : Y ⟶ Z) = 0, from category_theory.limits.comp_zero) = 0 :=
eq.symm $ explicit_cokernel_desc_unique _ _ category_theory.limits.comp_zero

@[ext]
lemma explicit_cokernel_hom_ext {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y}
  (e₁ e₂ : explicit_cokernel f ⟶ Z)
  (h : explicit_cokernel_π f ≫ e₁ = explicit_cokernel_π f ≫ e₂) : e₁ = e₂ :=
begin
  let g : Y ⟶ Z := explicit_cokernel_π f ≫ e₂,
  have w : f ≫ g = 0, by simp,
  have : e₂ = explicit_cokernel_desc w,
  { apply explicit_cokernel_desc_unique, refl },
  rw this,
  apply explicit_cokernel_desc_unique,
  exact h,
end

instance explicit_cokernel_π.epi {X Y : SemiNormedGroup.{u}} {f : X ⟶ Y} :
  epi (explicit_cokernel_π f) :=
begin
  constructor,
  intros Z g h H,
  ext x,
  obtain ⟨x, hx⟩ := explicit_cokernel_π_surjective (explicit_cokernel_π f x),
  change (explicit_cokernel_π f ≫ g) _ = _,
  rw [H]
end

lemma is_quotient_explicit_cokernel_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
normed_add_group_hom.is_quotient (explicit_cokernel_π f) :=
normed_add_group_hom.is_quotient_quotient _

lemma norm_noninc_explicit_cokernel_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
  (explicit_cokernel_π f).norm_noninc :=
(is_quotient_explicit_cokernel_π f).norm_le

open_locale nnreal

lemma explicit_cokernel_desc_norm_le_of_norm_le {X Y Z : SemiNormedGroup.{u}}
  {f : X ⟶ Y} {g : Y ⟶ Z} (w : f ≫ g = 0) (c : ℝ≥0) (h : ‖ g ‖ ≤ c) :
  ‖ explicit_cokernel_desc w ‖ ≤ c :=
normed_add_group_hom.lift_norm_le _ _ _ h

lemma explicit_cokernel_desc_comp_eq_zero {X Y Z W : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
  {h : Z ⟶ W} (cond : f ≫ g = 0) (cond2 : g ≫ h = 0) :
  explicit_cokernel_desc cond ≫ h = 0 :=
begin
  rw [← cancel_epi (explicit_cokernel_π f), ← category.assoc, explicit_cokernel_π_desc],
  simp [cond2]
end

lemma explicit_cokernel_desc_norm_le {X Y Z : SemiNormedGroup.{u}}
  {f : X ⟶ Y} {g : Y ⟶ Z} (w : f ≫ g = 0) : ‖ explicit_cokernel_desc w ‖ ≤ ‖ g ‖ :=
explicit_cokernel_desc_norm_le_of_norm_le w ‖ g ‖₊ le_rfl

/-- The explicit cokernel is isomorphic to the usual cokernel. -/
def explicit_cokernel_iso {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
  explicit_cokernel f ≅ cokernel f :=
(is_colimit_cokernel_cocone f).cocone_point_unique_up_to_iso (colimit.is_colimit _)

@[simp]
lemma explicit_cokernel_iso_hom_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
  explicit_cokernel_π f ≫ (explicit_cokernel_iso f).hom = cokernel.π _ :=
by simp [explicit_cokernel_π, explicit_cokernel_iso, is_colimit.cocone_point_unique_up_to_iso]

@[simp]
lemma explicit_cokernel_iso_inv_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
  cokernel.π f ≫ (explicit_cokernel_iso f).inv = explicit_cokernel_π f :=
by simp [explicit_cokernel_π, explicit_cokernel_iso]

@[simp]
lemma explicit_cokernel_iso_hom_desc {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
  (w : f ≫ g = 0) :
  (explicit_cokernel_iso f).hom ≫ cokernel.desc f g w = explicit_cokernel_desc w :=
begin
  ext1,
  simp [explicit_cokernel_desc, explicit_cokernel_π, explicit_cokernel_iso,
    is_colimit.cocone_point_unique_up_to_iso],
end

/-- A special case of `category_theory.limits.cokernel.map` adapted to `explicit_cokernel`. -/
noncomputable def explicit_cokernel.map {A B C D : SemiNormedGroup.{u}} {fab : A ⟶ B}
  {fbd : B ⟶ D} {fac : A ⟶ C} {fcd : C ⟶ D} (h : fab ≫ fbd = fac ≫ fcd) :
  explicit_cokernel fab ⟶ explicit_cokernel fcd :=
@explicit_cokernel_desc _ _ _ fab (fbd ≫ explicit_cokernel_π _) $ by simp [reassoc_of h]

/-- A special case of `category_theory.limits.cokernel.map_desc` adapted to `explicit_cokernel`. -/
lemma explicit_coker.map_desc {A B C D B' D' : SemiNormedGroup.{u}}
  {fab : A ⟶ B} {fbd : B ⟶ D} {fac : A ⟶ C} {fcd : C ⟶ D}
  {h : fab ≫ fbd = fac ≫ fcd} {fbb' : B ⟶ B'} {fdd' : D ⟶ D'}
  {condb : fab ≫ fbb' = 0} {condd : fcd ≫ fdd' = 0} {g : B' ⟶ D'}
  (h' : fbb' ≫ g = fbd ≫ fdd'):
  explicit_cokernel_desc condb ≫ g = explicit_cokernel.map h ≫ explicit_cokernel_desc condd :=
begin
  delta explicit_cokernel.map,
  simp [← cancel_epi (explicit_cokernel_π fab), category.assoc, explicit_cokernel_π_desc, h']
end

end explicit_cokernel

end cokernel

end SemiNormedGroup


/-
Copyright (c) 2021 . All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import group_theory.group_action.basic
import group_theory.subgroup.zpowers
import algebra.group_ring_action.basic
/-!
# Conjugation action of a group on itself

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

This file defines the conjugation action of a group on itself. See also `mul_aut.conj` for
the definition of conjugation as a homomorphism into the automorphism group.

## Main definitions

A type alias `conj_act G` is introduced for a group `G`. The group `conj_act G` acts on `G`
by conjugation. The group `conj_act G` also acts on any normal subgroup of `G` by conjugation.

As a generalization, this also allows:
* `conj_act Mˣ` to act on `M`, when `M` is a `monoid`
* `conj_act G₀` to act on `G₀`, when `G₀` is a `group_with_zero`

## Implementation Notes

The scalar action in defined in this file can also be written using `mul_aut.conj g • h`. This
has the advantage of not using the type alias `conj_act`, but the downside of this approach
is that some theorems about the group actions will not apply when since this
`mul_aut.conj g • h` describes an action of `mul_aut G` on `G`, and not an action of `G`.

-/

variables (α M G G₀ R K : Type*)

/-- A type alias for a group `G`. `conj_act G` acts on `G` by conjugation -/
def conj_act : Type* := G

namespace conj_act
open mul_action subgroup

variables {M G G₀ R K}

instance : Π [group G], group (conj_act G) := id
instance : Π [div_inv_monoid G], div_inv_monoid (conj_act G) := id
instance : Π [group_with_zero G], group_with_zero (conj_act G) := id
instance : Π [fintype G], fintype (conj_act G) := id

@[simp] lemma card [fintype G] : fintype.card (conj_act G) = fintype.card G := rfl

section div_inv_monoid

variable [div_inv_monoid G]

instance : inhabited (conj_act G) := ⟨1⟩

/-- Reinterpret `g : conj_act G` as an element of `G`. -/
def of_conj_act : conj_act G ≃* G := ⟨id, id, λ _, rfl, λ _, rfl, λ _ _, rfl⟩

/-- Reinterpret `g : G` as an element of `conj_act G`. -/
def to_conj_act : G ≃* conj_act G := of_conj_act.symm

/-- A recursor for `conj_act`, for use as `induction x using conj_act.rec` when `x : conj_act G`. -/
protected def rec {C : conj_act G → Sort*} (h : Π g, C (to_conj_act g)) : Π g, C g := h

@[simp] lemma «forall» (p : conj_act G → Prop) :
  (∀ (x : conj_act G), p x) ↔ ∀ x : G, p (to_conj_act x) := iff.rfl

@[simp] lemma of_mul_symm_eq : (@of_conj_act G _).symm = to_conj_act := rfl
@[simp] lemma to_mul_symm_eq : (@to_conj_act G _).symm = of_conj_act := rfl
@[simp] lemma to_conj_act_of_conj_act (x : conj_act G) : to_conj_act (of_conj_act x) = x := rfl
@[simp] lemma of_conj_act_to_conj_act (x : G) : of_conj_act (to_conj_act x) = x := rfl
@[simp] lemma of_conj_act_one : of_conj_act (1 : conj_act G) = 1 := rfl
@[simp] lemma to_conj_act_one : to_conj_act (1 : G) = 1 := rfl
@[simp] lemma of_conj_act_inv (x : conj_act G) : of_conj_act (x⁻¹) = (of_conj_act x)⁻¹ := rfl
@[simp] lemma to_conj_act_inv (x : G) : to_conj_act (x⁻¹) = (to_conj_act x)⁻¹ := rfl
@[simp] lemma of_conj_act_mul (x y : conj_act G) :
  of_conj_act (x * y) = of_conj_act x * of_conj_act y := rfl
@[simp] lemma to_conj_act_mul (x y : G) : to_conj_act (x * y) =
  to_conj_act x * to_conj_act y := rfl

instance : has_smul (conj_act G) G :=
{ smul := λ g h, of_conj_act g * h * (of_conj_act g)⁻¹ }

lemma smul_def (g : conj_act G) (h : G) : g • h = of_conj_act g * h * (of_conj_act g)⁻¹ := rfl

end div_inv_monoid

section units

section monoid
variables [monoid M]

instance has_units_scalar : has_smul (conj_act Mˣ) M :=
{ smul := λ g h, of_conj_act g * h * ↑(of_conj_act g)⁻¹ }

lemma units_smul_def (g : conj_act Mˣ) (h : M) : g • h = of_conj_act g * h * ↑(of_conj_act g)⁻¹ :=
rfl

instance units_mul_distrib_mul_action : mul_distrib_mul_action (conj_act Mˣ) M :=
{ smul := (•),
  one_smul := by simp [units_smul_def],
  mul_smul := by simp [units_smul_def, mul_assoc, mul_inv_rev],
  smul_mul := by simp [units_smul_def, mul_assoc],
  smul_one := by simp [units_smul_def], }

instance units_smul_comm_class [has_smul α M] [smul_comm_class α M M] [is_scalar_tower α M M] :
  smul_comm_class α (conj_act Mˣ) M :=
{ smul_comm := λ a um m, by rw [units_smul_def, units_smul_def, mul_smul_comm, smul_mul_assoc] }

instance units_smul_comm_class' [has_smul α M] [smul_comm_class M α M] [is_scalar_tower α M M] :
  smul_comm_class (conj_act Mˣ) α M :=
by { haveI : smul_comm_class α M M := smul_comm_class.symm _ _ _, exact smul_comm_class.symm _ _ _ }

end monoid

section semiring
variables [semiring R]

instance units_mul_semiring_action : mul_semiring_action (conj_act Rˣ) R :=
{ smul := (•),
  smul_zero := by simp [units_smul_def],
  smul_add := by simp [units_smul_def, mul_add, add_mul],
  ..conj_act.units_mul_distrib_mul_action}

end semiring

end units

section group_with_zero
variable [group_with_zero G₀]

@[simp] lemma of_conj_act_zero : of_conj_act (0 : conj_act G₀) = 0 := rfl
@[simp]

instance mul_action₀ : mul_action (conj_act G₀) G₀ :=
{ smul := (•),
  one_smul := by simp [smul_def],
  mul_smul := by simp [smul_def, mul_assoc, mul_inv_rev] }

instance smul_comm_class₀ [has_smul α G₀] [smul_comm_class α G₀ G₀] [is_scalar_tower α G₀ G₀] :
  smul_comm_class α (conj_act G₀) G₀ :=
{ smul_comm := λ a ug g, by rw [smul_def, smul_def, mul_smul_comm, smul_mul_assoc] }

instance smul_comm_class₀' [has_smul α G₀] [smul_comm_class G₀ α G₀] [is_scalar_tower α G₀ G₀] :
  smul_comm_class (conj_act G₀) α G₀ :=
by { haveI := smul_comm_class.symm G₀ α G₀, exact smul_comm_class.symm _ _ _ }

end group_with_zero

section division_ring
variables [division_ring K]

instance distrib_mul_action₀ : distrib_mul_action (conj_act K) K :=
{ smul := (•),
  smul_zero := by simp [smul_def],
  smul_add := by simp [smul_def, mul_add, add_mul],
  ..conj_act.mul_action₀ }

end division_ring

variables [group G]

instance : mul_distrib_mul_action (conj_act G) G :=
{ smul := (•),
  smul_mul := by simp [smul_def, mul_assoc],
  smul_one := by simp [smul_def],
  one_smul := by simp [smul_def],
  mul_smul := by simp [smul_def, mul_assoc] }

instance smul_comm_class [has_smul α G] [smul_comm_class α G G] [is_scalar_tower α G G] :
  smul_comm_class α (conj_act G) G :=
{ smul_comm := λ a ug g, by rw [smul_def, smul_def, mul_smul_comm, smul_mul_assoc] }

instance smul_comm_class' [has_smul α G] [smul_comm_class G α G] [is_scalar_tower α G G] :
  smul_comm_class (conj_act G) α G :=
by { haveI := smul_comm_class.symm G α G, exact smul_comm_class.symm _ _ _ }

lemma smul_eq_mul_aut_conj (g : conj_act G) (h : G) : g • h = mul_aut.conj (of_conj_act g) h := rfl

/-- The set of fixed points of the conjugation action of `G` on itself is the center of `G`. -/
lemma fixed_points_eq_center : fixed_points (conj_act G) G = center G :=
begin
  ext x,
  simp [mem_center_iff, smul_def, mul_inv_eq_iff_eq_mul]
end

lemma stabilizer_eq_centralizer (g : G) : stabilizer (conj_act G) g = (zpowers g).centralizer :=
le_antisymm (le_centralizer_iff.mp (zpowers_le.mpr (λ x, mul_inv_eq_iff_eq_mul.mp)))
  (λ x h, mul_inv_eq_of_eq_mul (h g (mem_zpowers g)).symm)

/-- As normal subgroups are closed under conjugation, they inherit the conjugation action
  of the underlying group. -/
instance subgroup.conj_action {H : subgroup G} [hH : H.normal] :
  has_smul (conj_act G) H :=
⟨λ g h, ⟨g • h, hH.conj_mem h.1 h.2 (of_conj_act g)⟩⟩

lemma subgroup.coe_conj_smul {H : subgroup G} [hH : H.normal] (g : conj_act G) (h : H) :
  ↑(g • h) = g • (h : G) := rfl

instance subgroup.conj_mul_distrib_mul_action {H : subgroup G} [hH : H.normal] :
  mul_distrib_mul_action (conj_act G) H :=
(subtype.coe_injective).mul_distrib_mul_action H.subtype subgroup.coe_conj_smul

/-- Group conjugation on a normal subgroup. Analogous to `mul_aut.conj`. -/
def _root_.mul_aut.conj_normal {H : subgroup G} [hH : H.normal] : G →* mul_aut H :=
(mul_distrib_mul_action.to_mul_aut (conj_act G) H).comp to_conj_act.to_monoid_hom

@[simp] lemma _root_.mul_aut.conj_normal_apply {H : subgroup G} [H.normal] (g : G) (h : H) :
  ↑(mul_aut.conj_normal g h) = g * h * g⁻¹ := rfl

@[simp] lemma _root_.mul_aut.conj_normal_symm_apply {H : subgroup G} [H.normal] (g : G) (h : H) :
  ↑((mul_aut.conj_normal g).symm h) = g⁻¹ * h * g :=
by { change _ * (_)⁻¹⁻¹ = _, rw inv_inv, refl }

@[simp] lemma _root_.mul_aut.conj_normal_inv_apply {H : subgroup G} [H.normal] (g : G) (h : H) :
  ↑((mul_aut.conj_normal g)⁻¹ h) = g⁻¹ * h * g :=
mul_aut.conj_normal_symm_apply g h

lemma _root_.mul_aut.conj_normal_coe {H : subgroup G} [H.normal] {h : H} :
  mul_aut.conj_normal ↑h = mul_aut.conj h :=
mul_equiv.ext (λ x, rfl)

instance normal_of_characteristic_of_normal {H : subgroup G} [hH : H.normal]
  {K : subgroup H} [h : K.characteristic] : (K.map H.subtype).normal :=
⟨λ a ha b, by
{ obtain ⟨a, ha, rfl⟩ := ha,
  exact K.apply_coe_mem_map H.subtype
    ⟨_, ((set_like.ext_iff.mp (h.fixed (mul_aut.conj_normal b)) a).mpr ha)⟩ }⟩

end conj_act


-- Copyright © 2019 François G. Dorais. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.

import .basic

namespace universal
variables {τ : Type} {σ : Type*} (sig : signature τ σ)

abbreviation substitution (dom₁ dom₂ : list τ) := Π (i : index dom₁), term sig dom₂ i.val

namespace substitution
variables {sig} {dom₁ dom₂ dom₃ : list τ} (sub : substitution sig dom₁ dom₂)

abbreviation to_valuation : algebra.valuation (term_algebra sig dom₂) dom₁ := sub

abbreviation apply {cod} (t : term sig dom₁ cod) : term sig dom₂ cod :=
algebra.eval (term_algebra sig dom₂) t sub

theorem apply_def {cod} (t : term sig dom₁ cod) : sub.apply t = (term_algebra sig dom₂).eval t sub := rfl

theorem apply_proj {i : index dom₁} : sub.apply (term.proj i) = sub i := rfl

theorem apply_func {f} (ts : Π (i : sig.index f), term sig dom₁ i.val) :
sub.apply (term.func f ts) = term.func f (λ i, sub.apply (ts i)) := rfl

theorem eval (alg : algebra sig) : ∀ {cod} (t : term sig dom₁ cod) (val : Π (i : index dom₂), alg.sort i.val),
alg.eval (sub.apply t) val = alg.eval t (λ i, alg.eval (sub i) val)
| _ (term.proj i) val := rfl
| _ (term.func f ts) val :=
  have IH : (λ i, alg.eval (sub.apply (ts i)) val) = (λ i, alg.eval (ts i) (λ i, alg.eval (sub i) val)),
  from funext $ λ i, eval (ts i) val,
  calc alg.eval (sub.apply (term.func f ts)) val
  = alg.func f (λ i, alg.eval (sub.apply (ts i)) val) : rfl ...
  = alg.func f (λ i, alg.eval (ts i) (λ i, alg.eval (sub i) val)) : by rw IH ...
  = alg.eval (term.func f ts) (λ (i : index dom₁), alg.eval (sub i) val) : by reflexivity

abbreviation id {dom : list τ} : substitution sig dom dom := term.proj

@[simp] theorem id_apply {dom : list τ} : ∀ {cod} (t : term sig dom cod), substitution.id.apply t = t
| _ (term.proj _) := rfl
| _ (term.func f ts) :=
  have (λ i, apply id (ts i)) = ts,
  from funext $ λ i, id_apply (ts i),
  calc apply id (term.func f ts)
  = term.func f (λ i, apply id (ts i)) : rfl ...
  = term.func f ts : by rw this

abbreviation comp : substitution sig dom₂ dom₃ → substitution sig dom₁ dom₂ → substitution sig dom₁ dom₃ :=
λ sub₂₃ sub₁₂ i, sub₂₃.apply (sub₁₂ i)

@[simp] theorem comp_apply (sub₂₃ : substitution sig dom₂ dom₃) (sub₁₂ : substitution sig dom₁ dom₂) :
∀ {cod} (t : term sig dom₁ cod), (comp sub₂₃ sub₁₂).apply t = sub₂₃.apply (sub₁₂.apply t)
| _ (term.proj _) := rfl
| _ (term.func f ts) :=
  have (λ i, (comp sub₂₃ sub₁₂).apply (ts i)) = (λ i, sub₂₃.apply (sub₁₂.apply (ts i))),
  from funext $ λ i, comp_apply (ts i),
  calc (comp sub₂₃ sub₁₂).apply (term.func f ts)
  = term.func f (λ i, (comp sub₂₃ sub₁₂).apply (ts i)) : rfl ...
  = term.func f (λ i, sub₂₃.apply (sub₁₂.apply (ts i))) : by rw this ...
  = sub₂₃.apply (term.func f (λ i, sub₁₂.apply (ts i))) : by rw apply_func sub₂₃ ...
  = sub₂₃.apply (apply sub₁₂ (term.func f ts)) : by rw apply_func sub₁₂

end substitution

section subst
variables {sig} {dom₁ dom₂ : list τ} (sub : substitution sig dom₁ dom₂)

abbreviation term.subst {{cod}} : term sig dom₁ cod → term sig dom₂ cod := sub.apply

abbreviation equation.subst {{cod}} : equation sig dom₁ cod → equation sig dom₂ cod :=
λ e, ⟨sub.apply e.lhs, sub.apply e.rhs⟩

theorem equation.subst_lhs {cod} (e : equation sig dom₁ cod) : (e.subst sub).lhs = e.lhs.subst sub := rfl

theorem equation.subst_rhs {cod} (e : equation sig dom₁ cod) : (e.subst sub).rhs = e.rhs.subst sub := rfl

theorem subst_subst {dom₁ dom₂ dom₃ : list τ} (sub₂₃ : substitution sig dom₂ dom₃) (sub₁₂ : substitution sig dom₁ dom₂) {cod} (t : term sig dom₁ cod) :
t.subst (λ i, (sub₁₂ i).subst sub₂₃) = (t.subst sub₁₂).subst sub₂₃ := substitution.comp_apply sub₂₃ sub₁₂ t

@[simp] theorem subst_proj {dom} {cod} (t : term sig dom cod) : t.subst term.proj = t := substitution.id_apply t

end subst

end universal


/-
Copyright (c) 2017 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Mario Carneiro

Evaluating arithmetic expressions including *, +, -, ^, ≤
-/

import algebra.group_power data.rat tactic.interactive data.nat.prime

universes u v w

namespace expr

protected meta def to_pos_rat : expr → option ℚ
| `(%%e₁ / %%e₂) := do m ← e₁.to_nat, n ← e₂.to_nat, some (rat.mk m n)
| e              := do n ← e.to_nat, return (rat.of_int n)

protected meta def to_rat : expr → option ℚ
| `(has_neg.neg %%e) := do q ← e.to_pos_rat, some (-q)
| e                  := e.to_pos_rat

protected meta def of_rat (α : expr) : ℚ → tactic expr
| ⟨(n:ℕ), d, h, c⟩   := do
  e₁ ← expr.of_nat α n,
  if d = 1 then return e₁ else
  do e₂ ← expr.of_nat α d,
  tactic.mk_app ``has_div.div [e₁, e₂]
| ⟨-[1+n], d, h, c⟩ := do
  e₁ ← expr.of_nat α (n+1),
  e ← (if d = 1 then return e₁ else do
    e₂ ← expr.of_nat α d,
    tactic.mk_app ``has_div.div [e₁, e₂]),
  tactic.mk_app ``has_neg.neg [e]

end expr

namespace tactic

meta def refl_conv (e : expr) : tactic (expr × expr) :=
do p ← mk_eq_refl e, return (e, p)

meta def trans_conv (t₁ t₂ : expr → tactic (expr × expr)) (e : expr) :
  tactic (expr × expr) :=
(do (e₁, p₁) ← t₁ e,
  (do (e₂, p₂) ← t₂ e₁,
    p ← mk_eq_trans p₁ p₂, return (e₂, p)) <|>
  return (e₁, p₁)) <|> t₂ e

end tactic

open tactic

namespace norm_num
variable {α : Type u}

lemma subst_into_neg {α} [has_neg α] (a ta t : α) (pra : a = ta) (prt : -ta = t) : -a = t :=
by simp [pra, prt]

theorem bit0_zero [add_group α] : bit0 (0 : α) = 0 := add_zero _

theorem bit1_zero [add_group α] [has_one α] : bit1 (0 : α) = 1 :=
by rw [bit1, bit0_zero, zero_add]

lemma pow_bit0_helper [monoid α] (a t : α) (b : ℕ) (h : a ^ b = t) :
  a ^ bit0 b = t * t :=
by simp [pow_bit0, h]

lemma pow_bit1_helper [monoid α] (a t : α) (b : ℕ) (h : a ^ b = t) :
  a ^ bit1 b = t * t * a :=
by simp [pow_bit1, h]

lemma lt_add_of_pos_helper [ordered_cancel_comm_monoid α]
  (a b c : α) (h : a + b = c) (h₂ : 0 < b) : a < c :=
h ▸ (lt_add_iff_pos_right _).2 h₂

lemma nat_div_helper (a b q r : ℕ) (h : r + q * b = a) (h₂ : r < b) : a / b = q :=
by rw [← h, nat.add_mul_div_right _ _ (lt_of_le_of_lt (nat.zero_le _) h₂),
       nat.div_eq_of_lt h₂, zero_add]

lemma int_div_helper (a b q r : ℤ) (h : r + q * b = a) (h₁ : 0 ≤ r) (h₂ : r < b) : a / b = q :=
by rw [← h, int.add_mul_div_right _ _ (ne_of_gt (lt_of_le_of_lt h₁ h₂)),
       int.div_eq_zero_of_lt h₁ h₂, zero_add]

lemma nat_mod_helper (a b q r : ℕ) (h : r + q * b = a) (h₂ : r < b) : a % b = r :=
by rw [← h, nat.add_mul_mod_self_right, nat.mod_eq_of_lt h₂]

lemma int_mod_helper (a b q r : ℤ) (h : r + q * b = a) (h₁ : 0 ≤ r) (h₂ : r < b) : a % b = r :=
by rw [← h, int.add_mul_mod_self, int.mod_eq_of_lt h₁ h₂]

meta def eval_pow (simp : expr → tactic (expr × expr)) : expr → tactic (expr × expr)
| `(@has_pow.pow %%α _ %%m %%e₁ %%e₂) :=
  match m with
  | `(nat.has_pow) :=
    mk_app ``nat.pow [e₁, e₂] >>= eval_pow
  | `(@monoid.has_pow %%α %%m) :=
    mk_app ``monoid.pow [e₁, e₂] >>= eval_pow
  | _ := failed
  end
| `(monoid.pow %%e₁ 0) := do
  p ← mk_app ``pow_zero [e₁],
  a ← infer_type e₁,
  o ← mk_app ``has_one.one [a],
  return (o, p)
| `(monoid.pow %%e₁ 1) := do
  p ← mk_app ``pow_one [e₁],
  return (e₁, p)
| `(monoid.pow %%e₁ (bit0 %%e₂)) := do
  e ← mk_app ``monoid.pow [e₁, e₂],
  (e', p) ← simp e,
  p' ← mk_app ``norm_num.pow_bit0_helper [e₁, e', e₂, p],
  e'' ← to_expr ``(%%e' * %%e'),
  return (e'', p')
| `(monoid.pow %%e₁ (bit1 %%e₂)) := do
  e ← mk_app ``monoid.pow [e₁, e₂],
  (e', p) ← simp e,
  p' ← mk_app ``norm_num.pow_bit1_helper [e₁, e', e₂, p],
  e'' ← to_expr ``(%%e' * %%e' * %%e₁),
  return (e'', p')
| `(nat.pow %%e₁ %%e₂) := do
  p₁ ← mk_app ``nat.pow_eq_pow [e₁, e₂],
  e ← mk_app ``monoid.pow [e₁, e₂],
  (e', p₂) ← simp e,
  p ← mk_eq_trans p₁ p₂,
  return (e', p)
| _ := failed

meta def prove_pos : instance_cache → expr → tactic (instance_cache × expr)
| c `(has_one.one _) := do (c, p) ← c.mk_app ``zero_lt_one [], return (c, p)
| c `(bit0 %%e)      := do (c, p) ← prove_pos c e, (c, p) ← c.mk_app ``bit0_pos [e, p], return (c, p)
| c `(bit1 %%e)      := do (c, p) ← prove_pos c e, (c, p) ← c.mk_app ``bit1_pos' [e, p], return (c, p)
| c `(%%e₁ / %%e₂)   := do
  (c, p₁) ← prove_pos c e₁, (c, p₂) ← prove_pos c e₂,
  (c, p) ← c.mk_app ``div_pos_of_pos_of_pos [e₁, e₂, p₁, p₂],
  return (c, p)
| c e                       := failed

meta def prove_lt (simp : expr → tactic (expr × expr)) : instance_cache → expr → expr → tactic (instance_cache × expr)
| c `(- %%e₁) `(- %%e₂) := do
  (c, p) ← prove_lt c e₁ e₂,
  (c, p) ← c.mk_app ``neg_lt_neg [e₁, e₂, p],
  return (c, p)
| c `(- %%e₁) `(has_zero.zero _) := do
  (c, p) ← prove_pos c e₁,
  (c, p) ← c.mk_app ``neg_neg_of_pos [e₁, p],
  return (c, p)
| c `(- %%e₁) e₂ := do
  (c, p₁) ← prove_pos c e₁,
  (c, me₁) ← c.mk_app ``has_neg.neg [e₁],
  (c, p₁) ← c.mk_app ``neg_neg_of_pos [e₁, p₁],
  (c, p₂) ← prove_pos c e₂,
  (c, z) ← c.mk_app ``has_zero.zero [],
  (c, p) ← c.mk_app ``lt_trans [me₁, z, e₂, p₁, p₂],
  return (c, p)
| c `(has_zero.zero _) e₂ := prove_pos c e₂
| c e₁ e₂ := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  d ← expr.of_rat c.α (n₂ - n₁),
  (c, e₃) ← c.mk_app ``has_add.add [e₁, d],
  (e₂', p) ← norm_num e₃,
  guard (e₂' =ₐ e₂),
  (c, p') ← prove_pos c d,
  (c, p) ← c.mk_app ``norm_num.lt_add_of_pos_helper [e₁, d, e₂, p, p'],
  return (c, p)

private meta def true_intro (p : expr) : tactic (expr × expr) :=
prod.mk <$> mk_const `true <*> mk_app ``eq_true_intro [p]

private meta def false_intro (p : expr) : tactic (expr × expr) :=
prod.mk <$> mk_const `false <*> mk_app ``eq_false_intro [p]

meta def eval_ineq (simp : expr → tactic (expr × expr)) : expr → tactic (expr × expr)
| `(%%e₁ < %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  if n₁ < n₂ then
    do (_, p) ← prove_lt simp c e₁ e₂, true_intro p
  else do
    (c, p) ← if n₁ = n₂ then c.mk_app ``lt_irrefl [e₁] else
      (do (c, p') ← prove_lt simp c e₂ e₁,
          c.mk_app ``not_lt_of_gt [e₁, e₂, p']),
    false_intro p
| `(%%e₁ ≤ %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  if n₁ ≤ n₂ then do
    (c, p) ← if n₁ = n₂ then c.mk_app ``le_refl [e₁] else
      (do (c, p') ← prove_lt simp c e₁ e₂,
          c.mk_app ``le_of_lt [e₁, e₂, p']),
    true_intro p
  else do
    (c, p) ← prove_lt simp c e₂ e₁,
    (c, p) ← c.mk_app ``not_le_of_gt [e₁, e₂, p],
    false_intro p
| `(%%e₁ = %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  if n₁ < n₂ then do
    (c, p) ← prove_lt simp c e₁ e₂,
    (c, p) ← c.mk_app ``ne_of_lt [e₁, e₂, p],
    false_intro p
  else if n₂ < n₁ then do
    (c, p) ← prove_lt simp c e₂ e₁,
    (c, p) ← c.mk_app ``ne_of_gt [e₁, e₂, p],
    false_intro p
  else mk_eq_refl e₁ >>= true_intro
| `(%%e₁ > %%e₂) := mk_app ``has_lt.lt [e₂, e₁] >>= simp
| `(%%e₁ ≥ %%e₂) := mk_app ``has_le.le [e₂, e₁] >>= simp
| `(%%e₁ ≠ %%e₂) := do e ← mk_app ``eq [e₁, e₂], mk_app ``not [e] >>= simp
| _ := failed

meta def eval_div_ext (simp : expr → tactic (expr × expr)) : expr → tactic (expr × expr)
| `(has_inv.inv %%e) := do
  c ← infer_type e >>= mk_instance_cache,
  (c, p₁) ← c.mk_app ``inv_eq_one_div [e],
  (c, o) ← c.mk_app ``has_one.one [],
  (c, e') ← c.mk_app ``has_div.div [o, e],
  (do (e'', p₂) ← simp e',
    p ← mk_eq_trans p₁ p₂,
    return (e'', p)) <|> return (e', p₁)
| `(%%e₁ / %%e₂) := do
  α ← infer_type e₁,
  c ← mk_instance_cache α,
  match α with
  | `(nat) := do
    n₁ ← e₁.to_nat, n₂ ← e₂.to_nat,
    q ← expr.of_nat α (n₁ / n₂),
    r ← expr.of_nat α (n₁ % n₂),
    (c, e₃) ← c.mk_app ``has_mul.mul [q, e₂],
    (c, e₃) ← c.mk_app ``has_add.add [r, e₃],
    (e₁', p) ← norm_num e₃,
    guard (e₁' =ₐ e₁),
    (c, p') ← prove_lt simp c r e₂,
    p ← mk_app ``norm_num.nat_div_helper [e₁, e₂, q, r, p, p'],
    return (q, p)
  | `(int) := match e₂ with
    | `(- %%e₂') := do
      (c, p₁) ← c.mk_app ``int.div_neg [e₁, e₂'],
      (c, e) ← c.mk_app ``has_div.div [e₁, e₂'],
      (c, e) ← c.mk_app ``has_neg.neg [e],
      (e', p₂) ← simp e,
      p ← mk_eq_trans p₁ p₂,
      return (e', p)
    | _ := do
      n₁ ← e₁.to_int,
      n₂ ← e₂.to_int,
      q ← expr.of_rat α $ rat.of_int (n₁ / n₂),
      r ← expr.of_rat α $ rat.of_int (n₁ % n₂),
      (c, e₃) ← c.mk_app ``has_mul.mul [q, e₂],
      (c, e₃) ← c.mk_app ``has_add.add [r, e₃],
      (e₁', p) ← norm_num e₃,
      guard (e₁' =ₐ e₁),
      (c, r0) ← c.mk_app ``has_zero.zero [],
      (c, r0) ← c.mk_app ``has_le.le [r0, r],
      (_, p₁) ← simp r0,
      p₁ ← mk_app ``of_eq_true [p₁],
      (c, p₂) ← prove_lt simp c r e₂,
      p ← mk_app ``norm_num.int_div_helper [e₁, e₂, q, r, p, p₁, p₂],
      return (q, p)
    end
  | _ := failed
  end
| `(%%e₁ % %%e₂) := do
  α ← infer_type e₁,
  c ← mk_instance_cache α,
  match α with
  | `(nat) := do
    n₁ ← e₁.to_nat, n₂ ← e₂.to_nat,
    q ← expr.of_nat α (n₁ / n₂),
    r ← expr.of_nat α (n₁ % n₂),
    (c, e₃) ← c.mk_app ``has_mul.mul [q, e₂],
    (c, e₃) ← c.mk_app ``has_add.add [r, e₃],
    (e₁', p) ← norm_num e₃,
    guard (e₁' =ₐ e₁),
    (c, p') ← prove_lt simp c r e₂,
    p ← mk_app ``norm_num.nat_mod_helper [e₁, e₂, q, r, p, p'],
    return (r, p)
  | `(int) := match e₂ with
    | `(- %%e₂') := do
      let p₁ := (expr.const ``int.mod_neg []).mk_app [e₁, e₂'],
      (c, e) ← c.mk_app ``has_mod.mod [e₁, e₂'],
      (e', p₂) ← simp e,
      p ← mk_eq_trans p₁ p₂,
      return (e', p)
    | _ := do
      n₁ ← e₁.to_int,
      n₂ ← e₂.to_int,
      q ← expr.of_rat α $ rat.of_int (n₁ / n₂),
      r ← expr.of_rat α $ rat.of_int (n₁ % n₂),
      (c, e₃) ← c.mk_app ``has_mul.mul [q, e₂],
      (c, e₃) ← c.mk_app ``has_add.add [r, e₃],
      (e₁', p) ← norm_num e₃,
      guard (e₁' =ₐ e₁),
      (c, r0) ← c.mk_app ``has_zero.zero [],
      (c, r0) ← c.mk_app ``has_le.le [r0, r],
      (_, p₁) ← simp r0,
      p₁ ← mk_app ``of_eq_true [p₁],
      (c, p₂) ← prove_lt simp c r e₂,
      p ← mk_app ``norm_num.int_mod_helper [e₁, e₂, q, r, p, p₁, p₂],
      return (r, p)
    end
  | _ := failed
  end
| `(%%e₁ ∣ %%e₂) := do
  α ← infer_type e₁,
  c ← mk_instance_cache α,
  n ← match α with
  | `(nat) := return ``nat.dvd_iff_mod_eq_zero
  | `(int) := return ``int.dvd_iff_mod_eq_zero
  | _ := failed
  end,
  p₁ ← mk_app ``propext [@expr.const tt n [] e₁ e₂],
  (e', p₂) ← simp `(%%e₂ % %%e₁ = 0),
  p' ← mk_eq_trans p₁ p₂,
  return (e', p')
| _ := failed

lemma not_prime_helper (a b n : ℕ)
  (h : a * b = n) (h₁ : 1 < a) (h₂ : 1 < b) : ¬ nat.prime n :=
by rw ← h; exact nat.not_prime_mul h₁ h₂

lemma is_prime_helper (n : ℕ)
  (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n :=
nat.prime_def_min_fac.2 ⟨h₁, h₂⟩

lemma min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = 2 :=
by simp [nat.min_fac_eq, show 2 ∣ bit0 n, by simp [bit0_eq_two_mul n]]

def min_fac_helper (n k : ℕ) : Prop :=
0 < k ∧ bit1 k ≤ nat.min_fac (bit1 n)

theorem min_fac_helper.n_pos {n k : ℕ} (h : min_fac_helper n k) : 0 < n :=
nat.pos_iff_ne_zero.2 $ λ e,
by rw e at h; exact not_le_of_lt (nat.bit1_lt h.1) h.2

lemma min_fac_ne_bit0 {n k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k :=
by rw bit0_eq_two_mul; exact λ e, absurd
  ((nat.dvd_add_iff_right (by simp [bit0_eq_two_mul n])).2
    (dvd_trans ⟨_, e⟩ (nat.min_fac_dvd _)))
  dec_trivial

lemma min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 :=
begin
  refine ⟨zero_lt_one, lt_of_le_of_ne _ min_fac_ne_bit0.symm⟩,
  refine @lt_of_le_of_ne ℕ _ _ _ (nat.min_fac_pos _) _,
  intro e,
  have := nat.min_fac_prime _,
  { rw ← e at this, exact nat.not_prime_one this },
  { exact ne_of_gt (nat.bit1_lt h) }
end

lemma min_fac_helper_1 {n k k' : ℕ} (e : k + 1 = k')
  (np : nat.min_fac (bit1 n) ≠ bit1 k)
  (h : min_fac_helper n k) : min_fac_helper n k' :=
begin
  rw ← e,
  refine ⟨nat.succ_pos _,
    (lt_of_le_of_ne (lt_of_le_of_ne _ _ : k+1+k < _)
      min_fac_ne_bit0.symm : bit0 (k+1) < _)⟩,
  { rw add_right_comm, exact h.2 },
  { rw add_right_comm, exact np.symm }
end

lemma min_fac_helper_2 (n k k' : ℕ) (e : k + 1 = k')
  (np : ¬ nat.prime (bit1 k)) (h : min_fac_helper n k) : min_fac_helper n k' :=
begin
  refine min_fac_helper_1 e _ h,
  intro e₁, rw ← e₁ at np,
  exact np (nat.min_fac_prime $ ne_of_gt $ nat.bit1_lt h.n_pos)
end

lemma min_fac_helper_3 (n k k' : ℕ) (e : k + 1 = k')
  (nd : bit1 k ∣ bit1 n = false)
  (h : min_fac_helper n k) : min_fac_helper n k' :=
begin
  refine min_fac_helper_1 e _ h,
  intro e₁, rw [eq_false, ← e₁] at nd,
  exact nd (nat.min_fac_dvd _)
end

lemma min_fac_helper_4 (n k : ℕ) (hd : bit1 k ∣ bit1 n = true)
  (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 k :=
by rw eq_true at hd; exact
le_antisymm (nat.min_fac_le_of_dvd (nat.bit1_lt h.1) hd) h.2

lemma min_fac_helper_5 (n k k' : ℕ) (e : bit1 k * bit1 k = k')
  (hd : bit1 n < k') (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 n :=
begin
  refine (nat.prime_def_min_fac.1 (nat.prime_def_le_sqrt.2
    ⟨nat.bit1_lt h.n_pos, _⟩)).2,
  rw ← e at hd,
  intros m m2 hm md,
  have := le_trans h.2 (le_trans (nat.min_fac_le_of_dvd m2 md) hm),
  rw nat.le_sqrt at this,
  exact not_le_of_lt hd this
end

meta def prove_non_prime (simp : expr → tactic (expr × expr)) (e : expr) (n d₁ : ℕ) : tactic expr :=
do let e₁ := reflect d₁,
  c ← mk_instance_cache `(nat),
  (c, p₁) ← prove_lt simp c `(1) e₁,
  let d₂ := n / d₁, let e₂ := reflect d₂,
  (e', p) ← mk_app ``has_mul.mul [e₁, e₂] >>= norm_num,
  guard (e' =ₐ e),
  (c, p₂) ← prove_lt simp c `(1) e₂,
  return $ (expr.const ``not_prime_helper []).mk_app [e₁, e₂, e, p, p₁, p₂]

meta def prove_min_fac (simp : expr → tactic (expr × expr))
  (e₁ : expr) (n1 : ℕ) : expr → expr → tactic (expr × expr)
| e₂ p := do
  k ← e₂.to_nat,
  let k1 := bit1 k,
  e₁1 ← mk_app ``bit1 [e₁],
  e₂1 ← mk_app ``bit1 [e₂],
  if n1 < k1*k1 then do
    c ← mk_instance_cache `(nat),
    (c, e') ← c.mk_app ``has_mul.mul [e₂1, e₂1],
    (e', p₁) ← norm_num e',
    (c, p₂) ← prove_lt simp c e₁1 e',
    p' ← mk_app ``min_fac_helper_5 [e₁, e₂, e', p₁, p₂, p],
    return (e₁1, p')
  else let d := k1.min_fac in
  if to_bool (d < k1) then do
    (e', p₁) ← norm_num `(%%e₂ + 1),
    p₂ ← prove_non_prime simp e₂1 k1 d,
    mk_app ``min_fac_helper_2 [e₁, e₂, e', p₁, p₂, p] >>= prove_min_fac e'
  else do
    (_, p₂) ← simp `((%%e₂1 : ℕ) ∣ %%e₁1),
    if k1 ∣ n1 then do
      p' ← mk_app ``min_fac_helper_4 [e₁, e₂, p₂, p],
      return (e₂1, p')
    else do
      (e', p₁) ← norm_num `(%%e₂ + 1),
      mk_app ``min_fac_helper_3 [e₁, e₂, e', p₁, p₂, p] >>= prove_min_fac e'

meta def eval_prime (simp : expr → tactic (expr × expr)) : expr → tactic (expr × expr)
| `(nat.prime %%e) := do
  n ← e.to_nat,
  match n with
  | 0 := false_intro `(nat.not_prime_zero)
  | 1 := false_intro `(nat.not_prime_one)
  | _ := let d₁ := n.min_fac in
    if d₁ < n then prove_non_prime simp e n d₁ >>= false_intro
    else do
      let e₁ := reflect d₁,
      c ← mk_instance_cache `(nat),
      (c, p₁) ← prove_lt simp c `(1) e₁,
      (e₁, p) ← simp `(nat.min_fac %%e),
      true_intro $ (expr.const ``is_prime_helper []).mk_app [e, p₁, p]
  end
| `(nat.min_fac 0) := refl_conv (reflect (0:ℕ))
| `(nat.min_fac 1) := refl_conv (reflect (1:ℕ))
| `(nat.min_fac (bit0 %%e)) := prod.mk `(2) <$> mk_app ``min_fac_bit0 [e]
| `(nat.min_fac (bit1 %%e)) := do
  n ← e.to_nat,
  c ← mk_instance_cache `(nat),
  (c, p) ← prove_pos c e,
  mk_app ``min_fac_helper_0 [e, p] >>= prove_min_fac simp e (bit1 n) `(1)
| _ := failed

meta def derive1 (simp : expr → tactic (expr × expr)) (e : expr) :
  tactic (expr × expr) :=
norm_num e <|> eval_div_ext simp e <|>
eval_pow simp e <|> eval_ineq simp e <|> eval_prime simp e

meta def derive : expr → tactic (expr × expr) | e :=
do (_, e', pr) ←
    ext_simplify_core () {} simp_lemmas.mk (λ _, failed) (λ _ _ _ _ _, failed)
      (λ _ _ _ _ e,
        do (new_e, pr) ← derive1 derive e,
           guard (¬ new_e =ₐ e),
           return ((), new_e, some pr, tt))
      `eq e,
    return (e', pr)

end norm_num

namespace tactic.interactive
open norm_num interactive interactive.types

/-- Basic version of `norm_num` that does not call `simp`. -/
meta def norm_num1 (loc : parse location) : tactic unit :=
do ns ← loc.get_locals,
   tt ← tactic.replace_at derive ns loc.include_goal
      | fail "norm_num failed to simplify",
   when loc.include_goal $ try tactic.triv,
   when (¬ ns.empty) $ try tactic.contradiction

/-- Normalize numerical expressions. Supports the operations
  `+` `-` `*` `/` `^` `<` `≤` over ordered fields (or other
  appropriate classes), as well as `-` `/` `%` over `ℤ` and `ℕ`. -/
meta def norm_num (hs : parse simp_arg_list) (l : parse location) : tactic unit :=
repeat1 $ orelse' (norm_num1 l) $
simp_core {} (norm_num1 (loc.ns [none])) ff hs [] l

meta def apply_normed (x : parse texpr) : tactic unit :=
do x₁ ← to_expr x,
  (x₂,_) ← derive x₁,
  tactic.exact x₂

end tactic.interactive


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.structured_arrow
import category_theory.groupoid
import category_theory.punit

/-!
# The category of elements

This file defines the category of elements, also known as (a special case of) the Grothendieck
construction.

Given a functor `F : C ⥤ Type`, an object of `F.elements` is a pair `(X : C, x : F.obj X)`.
A morphism `(X, x) ⟶ (Y, y)` is a morphism `f : X ⟶ Y` in `C`, so `F.map f` takes `x` to `y`.

## Implementation notes

This construction is equivalent to a special case of a comma construction, so this is mostly just a
more convenient API. We prove the equivalence in
`category_theory.category_of_elements.structured_arrow_equivalence`.

## References
* [Emily Riehl, *Category Theory in Context*, Section 2.4][riehl2017]
* <https://en.wikipedia.org/wiki/Category_of_elements>
* <https://ncatlab.org/nlab/show/category+of+elements>

## Tags
category of elements, Grothendieck construction, comma category
-/

namespace category_theory

universes w v u
variables {C : Type u} [category.{v} C]

/--
The type of objects for the category of elements of a functor `F : C ⥤ Type`
is a pair `(X : C, x : F.obj X)`.
-/
@[nolint has_nonempty_instance]
def functor.elements (F : C ⥤ Type w) := (Σ c : C, F.obj c)

/-- The category structure on `F.elements`, for `F : C ⥤ Type`.
    A morphism `(X, x) ⟶ (Y, y)` is a morphism `f : X ⟶ Y` in `C`, so `F.map f` takes `x` to `y`.
 -/
instance category_of_elements (F : C ⥤ Type w) : category.{v} F.elements :=
{ hom := λ p q, { f : p.1 ⟶ q.1 // (F.map f) p.2 = q.2 },
  id := λ p, ⟨𝟙 p.1, by obviously⟩,
  comp := λ p q r f g, ⟨f.val ≫ g.val, by obviously⟩ }

namespace category_of_elements

@[ext]
lemma ext (F : C ⥤ Type w) {x y : F.elements} (f g : x ⟶ y) (w : f.val = g.val) : f = g :=
subtype.ext_val w

@[simp] lemma comp_val {F : C ⥤ Type w} {p q r : F.elements} {f : p ⟶ q} {g : q ⟶ r} :
  (f ≫ g).val = f.val ≫ g.val := rfl

@[simp] lemma id_val {F : C ⥤ Type w} {p : F.elements} : (𝟙 p : p ⟶ p).val = 𝟙 p.1 := rfl

end category_of_elements

noncomputable
instance groupoid_of_elements {G : Type u} [groupoid.{v} G] (F : G ⥤ Type w) :
  groupoid F.elements :=
{ inv := λ p q f, ⟨inv f.val,
    calc F.map (inv f.val) q.2 = F.map (inv f.val) (F.map f.val p.2) : by rw f.2
                           ... = (F.map f.val ≫ F.map (inv f.val)) p.2 : rfl
                           ... = p.2 : by {rw ← F.map_comp, simp} ⟩,
  inv_comp' := λ _ _ _, by { ext, simp },
  comp_inv' := λ _ _ _, by { ext, simp } }

namespace category_of_elements
variable (F : C ⥤ Type w)

/-- The functor out of the category of elements which forgets the element. -/
@[simps]
def π : F.elements ⥤ C :=
{ obj := λ X, X.1,
  map := λ X Y f, f.val }

/--
A natural transformation between functors induces a functor between the categories of elements.
-/
@[simps]
def map {F₁ F₂ : C ⥤ Type w} (α : F₁ ⟶ F₂) : F₁.elements ⥤ F₂.elements :=
{ obj := λ t, ⟨t.1, α.app t.1 t.2⟩,
  map := λ t₁ t₂ k, ⟨k.1, by simpa [←k.2] using (functor_to_types.naturality _ _ α k.1 t₁.2).symm⟩ }

@[simp] lemma map_π {F₁ F₂ : C ⥤ Type w} (α : F₁ ⟶ F₂) : map α ⋙ π F₂ = π F₁ := rfl

/-- The forward direction of the equivalence `F.elements ≅ (*, F)`. -/
def to_structured_arrow : F.elements ⥤ structured_arrow punit F :=
{ obj := λ X, structured_arrow.mk (λ _, X.2),
  map := λ X Y f, structured_arrow.hom_mk f.val (by tidy) }

@[simp] lemma to_structured_arrow_obj (X) :
  (to_structured_arrow F).obj X = { left := ⟨⟨⟩⟩, right := X.1, hom := λ _, X.2 } := rfl
@[simp] lemma to_comma_map_right {X Y} (f : X ⟶ Y) :
  ((to_structured_arrow F).map f).right = f.val := rfl

/-- The reverse direction of the equivalence `F.elements ≅ (*, F)`. -/
def from_structured_arrow : structured_arrow punit F ⥤ F.elements :=
{ obj := λ X, ⟨X.right, X.hom (punit.star)⟩,
  map := λ X Y f, ⟨f.right, congr_fun f.w'.symm punit.star⟩ }

@[simp] lemma from_structured_arrow_obj (X) :
  (from_structured_arrow F).obj X = ⟨X.right, X.hom (punit.star)⟩ := rfl
@[simp] lemma from_structured_arrow_map {X Y} (f : X ⟶ Y) :
  (from_structured_arrow F).map f = ⟨f.right, congr_fun f.w'.symm punit.star⟩ := rfl

/-- The equivalence between the category of elements `F.elements`
    and the comma category `(*, F)`. -/
@[simps]
def structured_arrow_equivalence : F.elements ≌ structured_arrow punit F :=
equivalence.mk (to_structured_arrow F) (from_structured_arrow F)
  (nat_iso.of_components (λ X, eq_to_iso (by tidy)) (by tidy))
  (nat_iso.of_components
    (λ X, structured_arrow.iso_mk (iso.refl _) (by tidy))
    (by tidy))

open opposite

/--
The forward direction of the equivalence `F.elementsᵒᵖ ≅ (yoneda, F)`,
given by `category_theory.yoneda_sections`.
-/
@[simps]
def to_costructured_arrow (F : Cᵒᵖ ⥤ Type v) : (F.elements)ᵒᵖ ⥤ costructured_arrow yoneda F :=
{ obj := λ X, costructured_arrow.mk
    ((yoneda_sections (unop (unop X).fst) F).inv (ulift.up (unop X).2)),
  map := λ X Y f,
  begin
    fapply costructured_arrow.hom_mk,
    exact f.unop.val.unop,
    ext y,
    simp only [costructured_arrow.mk_hom_eq_self, yoneda_map_app, functor_to_types.comp, op_comp,
      yoneda_sections_inv_app, functor_to_types.map_comp_apply, quiver.hom.op_unop,
      subtype.val_eq_coe],
    congr,
    exact f.unop.2,
  end }

/--
The reverse direction of the equivalence `F.elementsᵒᵖ ≅ (yoneda, F)`,
given by `category_theory.yoneda_equiv`.
-/
@[simps]
def from_costructured_arrow (F : Cᵒᵖ ⥤ Type v) : (costructured_arrow yoneda F)ᵒᵖ ⥤ F.elements :=
{ obj := λ X, ⟨op (unop X).1, yoneda_equiv.1 (unop X).3⟩,
  map := λ X Y f, ⟨f.unop.1.op,
  begin
    convert (congr_fun ((unop X).hom.naturality f.unop.left.op) (𝟙 _)).symm,
    simp only [equiv.to_fun_as_coe, quiver.hom.unop_op, yoneda_equiv_apply,
      types_comp_apply, category.comp_id, yoneda_obj_map],
    have : yoneda.map f.unop.left ≫ (unop X).hom = (unop Y).hom,
    { convert f.unop.3, erw category.comp_id },
    erw ← this,
    simp only [yoneda_map_app, functor_to_types.comp],
    erw category.id_comp
  end ⟩}

@[simp]
lemma from_costructured_arrow_obj_mk (F : Cᵒᵖ ⥤ Type v) {X : C} (f : yoneda.obj X ⟶ F) :
  (from_costructured_arrow F).obj (op (costructured_arrow.mk f)) = ⟨op X, yoneda_equiv.1 f⟩ := rfl

/-- The unit of the equivalence `F.elementsᵒᵖ ≅ (yoneda, F)` is indeed iso. -/
lemma from_to_costructured_arrow_eq (F : Cᵒᵖ ⥤ Type v) :
 (to_costructured_arrow F).right_op ⋙ from_costructured_arrow F = 𝟭 _ :=
begin
  apply functor.ext,
  intros X Y f,
  have : ∀ {a b : F.elements} (H : a = b),
    ↑(eq_to_hom H) = eq_to_hom (show a.fst = b.fst, by { cases H, refl }) :=
    λ _ _ H, by { cases H, refl },
  ext, simp[this],
  tidy
end

/-- The counit of the equivalence `F.elementsᵒᵖ ≅ (yoneda, F)` is indeed iso. -/
lemma to_from_costructured_arrow_eq (F : Cᵒᵖ ⥤ Type v) :
  (from_costructured_arrow F).right_op ⋙ to_costructured_arrow F = 𝟭 _ :=
begin
  apply functor.hext,
  { intro X, cases X, cases X_right,
    simp only [functor.id_obj, functor.right_op_obj,
      to_costructured_arrow_obj, functor.comp_obj, costructured_arrow.mk],
    congr,
    ext x f,
    convert congr_fun (X_hom.naturality f.op).symm (𝟙 X_left),
    simp only [quiver.hom.unop_op, yoneda_obj_map],
    erw category.comp_id },
  intros X Y f,
  rcases X with ⟨X_left, ⟨⟨⟩⟩⟩, rcases Y with ⟨Y_left, ⟨⟨⟩⟩⟩, cases f,
  simp [costructured_arrow.hom_mk],
  delta costructured_arrow.mk,
  congr,
  { ext x f,
    convert congr_fun (X_hom.naturality f.op).symm (𝟙 X_left),
    simp only [quiver.hom.unop_op, category_theory.yoneda_obj_map],
    erw category.comp_id },
  { ext x f,
    convert congr_fun (Y_hom.naturality f.op).symm (𝟙 Y_left),
    simp only [quiver.hom.unop_op, category_theory.yoneda_obj_map],
    erw category.comp_id },
  simp,
  exact proof_irrel_heq _ _,
end

/-- The equivalence `F.elementsᵒᵖ ≅ (yoneda, F)` given by yoneda lemma. -/
@[simps] def costructured_arrow_yoneda_equivalence (F : Cᵒᵖ ⥤ Type v) :
  (F.elements)ᵒᵖ ≌ costructured_arrow yoneda F :=
equivalence.mk (to_costructured_arrow F) (from_costructured_arrow F).right_op
  (nat_iso.op (eq_to_iso (from_to_costructured_arrow_eq F)))
  (eq_to_iso $ to_from_costructured_arrow_eq F)

/--
The equivalence `(-.elements)ᵒᵖ ≅ (yoneda, -)` of is actually a natural isomorphism of functors.
-/
lemma costructured_arrow_yoneda_equivalence_naturality {F₁ F₂ : Cᵒᵖ ⥤ Type v}
  (α : F₁ ⟶ F₂) : (map α).op ⋙ to_costructured_arrow F₂ =
    to_costructured_arrow F₁ ⋙ costructured_arrow.map α :=
begin
  fapply functor.ext,
  { intro X,
    simp only [costructured_arrow.map_mk, to_costructured_arrow_obj,
      functor.op_obj, functor.comp_obj],
    congr,
    ext x f,
    simpa using congr_fun (α.naturality f.op).symm (unop X).snd },
  { intros X Y f, ext,
    have : ∀ {F : Cᵒᵖ ⥤ Type v} {a b : costructured_arrow yoneda F} (H : a = b),
      comma_morphism.left (eq_to_hom H) = eq_to_hom (show a.left = b.left, by { cases H, refl }) :=
      λ _ _ _ H, by { cases H, refl },
    simp [this] }
end

end category_of_elements
end category_theory


import .vm_check ..syntax

/-
foo is an rbmap with ("A", 0) to ("Z", 25)
-/
def foo :=
let l := (list.range 26).map (λ i, (char.to_string $ char.of_nat (i + 65), i))
in rbmap.from_list l

#eval foo.find "Z"

/- check time -/
-- set_option profiler true

-- too slow
-- theorem bar : foo.find "Z" = some 25 := rfl

#eval foo.find "Z"

-- curiously, fails; VM doesn't have code associated with bool.tt
-- example : tt = tt := by vm_check_tt

example : id tt = tt := by vm_check_tt

example : tt && tt = tt := by vm_check_tt

example : 2 < 5 := vm_check

-- fails
-- example : 5 < 2 := vm_check

-- fails
-- example : ∀ x, 2 < x := vm_check

example : 1000 * 1000 = 1000000 := vm_check

-- set_option profiler true

theorem bar : foo.find "Z" = some 25 := vm_check

-- fails
-- example : ∀ x : nat, x = x :=
-- assume x, vm_check

namespace testeq

def foo (s t : string) : nat :=
if s = t then 0 else 1

def foo' (s t : nat) : nat :=
if s = t then 0 else 1

def bar (s t : string) : nat → nat
| 0 := 0
| (n+1):= foo s t + bar n

def bar' (s t : nat) : nat → nat
| 0 := 0
| (n+1):= foo' s t + bar' n

def baz := "hello"

def bla (s : string) : nat → nat
| 0 := 0
| (n+1):= foo s s + bla n

def bla' := "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"

def bla'' := "oxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"

set_option profiler true

/-
#eval bar bla' bla' 1000000

#eval bar bla' bla'' 1000000

#eval bar ("o"++ bla') bla'' 1000000

#eval bar "hello" "goodbye" 1000000

#eval bar "hello" "hello" 1000000

#eval bar "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
1000000

--#eval bar baz baz 1000000

--#eval bla "hello" 1000000

--#eval bar' 25 67 1000000

--#eval bar' 43 43 1000000

-/

end testeq

/-do
tgt ← target,
apply `(@of_to_bool_eq_tt %%tgt),
skip
-/

section
open hol
open hol.type

-- these seem slow
set_option profiler true

theorem arities_ok_mk_prop : arities_ok mk_prop :=
by { dsimp [mk_prop, arities_ok, arities_ok_aux, list.empty, coe_sort], reflexivity }

theorem arities_ok_mk_list_type (t : type) (h : arities_ok t) : arities_ok (mk_list_type t) = tt :=
by { dsimp [mk_list_type, arities_ok, coe_sort] at *, dsimp [arities_ok_aux], rw h, reflexivity }

theorem arities_ok_mk_list_type' (t : type) (h : arities_ok t) : arities_ok (mk_list_type t) = tt :=
by { simp [mk_list_type, arities_ok, coe_sort] at *, simp [arities_ok_aux], split, assumption, reflexivity }

@[simp] theorem arity_list : constructor.list.arity = 1 := rfl

theorem arities_ok_mk_list_type'' (t : type) (h : arities_ok t = tt) : arities_ok (mk_list_type t) = tt :=
by { simp [arities_ok] at *, simp [mk_list_type, arities_ok_aux, h] }

theorem arities_ok_mk_list_type''' (t : type) (h : arities_ok t = tt) : arities_ok (mk_list_type t) = tt :=  by { dsimp [arities_ok] at *, dsimp [mk_list_type, arities_ok_aux, constructor.list], rw h, reflexivity }

-- much faster
#eval arities_ok mk_prop
#eval arities_ok (mk_list_type mk_prop)

end


import tactic --hide

/-
You can also use `cases` when working with the `∨` ("or") connective. For example, if you have
the assumption

```
h : P ∨ Q
```

then `cases h with hp hq` will convert your state into the following two states:

```
P : Prop
hp : P
⊢ P
```
and

```
P : Prop
hq : Q
⊢ Q
```
one where `P` is true and one where `Q` is true.

Try this in the lemma below.
-/

/- Lemma
If $P$ is a logical statement and $P$ or $P$ is true, then $P$ is true.
-/

lemma cases_or_example (P : Prop) (hp : P ∨ P) : P :=
begin
  cases hp with hp hp,
  exact hp,
  exact hp,
end


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import control.equiv_functor
import data.option.basic
import data.subtype
import logic.equiv.defs

/-!
# Equivalences for `option α`

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

We define
* `equiv.option_congr`: the `option α ≃ option β` constructed from `e : α ≃ β` by sending `none` to
  `none`, and applying a `e` elsewhere.
* `equiv.remove_none`: the `α ≃ β` constructed from `option α ≃ option β` by removing `none` from
  both sides.
-/

namespace equiv

open option

variables {α β γ : Type*}

section option_congr

/-- A universe-polymorphic version of `equiv_functor.map_equiv option e`. -/
@[simps apply]
def option_congr (e : α ≃ β) : option α ≃ option β :=
{ to_fun := option.map e,
  inv_fun := option.map e.symm,
  left_inv := λ x, (option.map_map _ _ _).trans $
    e.symm_comp_self.symm ▸ congr_fun option.map_id x,
  right_inv := λ x, (option.map_map _ _ _).trans $
    e.self_comp_symm.symm ▸ congr_fun option.map_id x }

@[simp] lemma option_congr_refl : option_congr (equiv.refl α) = equiv.refl _ :=
ext $ congr_fun option.map_id

@[simp] lemma option_congr_symm (e : α ≃ β) : (option_congr e).symm = option_congr e.symm := rfl

@[simp] lemma option_congr_trans (e₁ : α ≃ β) (e₂ : β ≃ γ) :
  (option_congr e₁).trans (option_congr e₂) = option_congr (e₁.trans e₂) :=
ext $ option.map_map _ _

/-- When `α` and `β` are in the same universe, this is the same as the result of
`equiv_functor.map_equiv`. -/
lemma option_congr_eq_equiv_function_map_equiv {α β : Type*} (e : α ≃ β) :
  option_congr e = equiv_functor.map_equiv option e := rfl

end option_congr

section remove_none
variables (e : option α ≃ option β)

private def remove_none_aux (x : α) : β :=
if h : (e (some x)).is_some
  then option.get h
  else option.get $ show (e none).is_some, from
  begin
    rw ←option.ne_none_iff_is_some,
    intro hn,
    rw [option.not_is_some_iff_eq_none, ←hn] at h,
    simpa only using e.injective h,
  end

private lemma remove_none_aux_some {x : α} (h : ∃ x', e (some x) = some x') :
  some (remove_none_aux e x) = e (some x) :=
by simp [remove_none_aux, option.is_some_iff_exists.mpr h]

private lemma remove_none_aux_none {x : α} (h : e (some x) = none) :
  some (remove_none_aux e x) = e none :=
by simp [remove_none_aux, option.not_is_some_iff_eq_none.mpr h]

private lemma remove_none_aux_inv (x : α) : remove_none_aux e.symm (remove_none_aux e x) = x :=
option.some_injective _ begin
  cases h1 : e.symm (some (remove_none_aux e x)); cases h2 : (e (some x)),
  { rw remove_none_aux_none _ h1,
    exact (e.eq_symm_apply.mpr h2).symm },
  { rw remove_none_aux_some _ ⟨_, h2⟩ at h1,
    simpa using h1, },
  { rw remove_none_aux_none _ h2 at h1,
    simpa using h1, },
  { rw remove_none_aux_some _ ⟨_, h1⟩,
    rw remove_none_aux_some _ ⟨_, h2⟩,
    simp },
end

/-- Given an equivalence between two `option` types, eliminate `none` from that equivalence by
mapping `e.symm none` to `e none`. -/
def remove_none : α ≃ β :=
{ to_fun := remove_none_aux e,
  inv_fun := remove_none_aux e.symm,
  left_inv := remove_none_aux_inv e,
  right_inv := remove_none_aux_inv e.symm, }

@[simp]
lemma remove_none_symm : (remove_none e).symm = remove_none e.symm := rfl

lemma remove_none_some {x : α} (h : ∃ x', e (some x) = some x') :
  some (remove_none e x) = e (some x) := remove_none_aux_some e h

@[simp] lemma option_symm_apply_none_iff : e.symm none = none ↔ e none = none :=
⟨λ h, by simpa using (congr_arg e h).symm, λ h, by simpa using (congr_arg e.symm h).symm⟩

lemma some_remove_none_iff {x : α} :
  some (remove_none e x) = e none ↔ e.symm none = some x :=
begin
  cases h : e (some x) with a,
  { rw remove_none_none _ h,
    simpa using (congr_arg e.symm h).symm },
  { rw remove_none_some _ ⟨a, h⟩,
    have := (congr_arg e.symm h),
    rw [symm_apply_apply] at this,
    simp only [false_iff, apply_eq_iff_eq],
    simp [this] }
end

@[simp]
lemma remove_none_option_congr (e : α ≃ β) : remove_none e.option_congr = e :=
equiv.ext $ λ x, option.some_injective _ $ remove_none_some _ ⟨e x, by simp [equiv_functor.map]⟩

end remove_none

lemma option_congr_injective : function.injective (option_congr : α ≃ β → option α ≃ option β) :=
function.left_inverse.injective remove_none_option_congr

/-- Equivalences between `option α` and `β` that send `none` to `x` are equivalent to
equivalences between `α` and `{y : β // y ≠ x}`. -/
def option_subtype [decidable_eq β] (x : β) :
  {e : option α ≃ β // e none = x} ≃ (α ≃ {y : β // y ≠ x}) :=
{ to_fun := λ e,
    { to_fun := λ a, ⟨e a, ((equiv_like.injective _).ne_iff' e.property).2 (some_ne_none _)⟩,
      inv_fun := λ b, get (ne_none_iff_is_some.1 (((equiv_like.injective _).ne_iff'
        (((apply_eq_iff_eq_symm_apply _).1 e.property).symm)).2 b.property)),
      left_inv := λ a, begin
          rw [←some_inj, some_get, ←coe_def],
          exact symm_apply_apply (e : option α ≃ β) a
        end,
      right_inv := λ b, begin
          ext,
          simp,
          exact apply_symm_apply _ _
        end },
  inv_fun := λ e,
    ⟨{ to_fun := λ a, cases_on' a x (coe ∘ e),
       inv_fun := λ b, if h : b = x then none else e.symm ⟨b, h⟩,
       left_inv := λ a, begin
           cases a, { simp },
           simp only [cases_on'_some, function.comp_app, subtype.coe_eta, symm_apply_apply,
                      dite_eq_ite],
           exact if_neg (e a).property
         end,
       right_inv := λ b, begin
           by_cases h : b = x;
             simp [h]
         end},
     rfl⟩,
  left_inv := λ e, begin
      ext a,
      cases a,
      { simpa using e.property.symm },
      { simpa }
    end,
  right_inv := λ e, begin
      ext a,
      refl
    end }

@[simp] lemma option_subtype_apply_apply [decidable_eq β] (x : β)
  (e : {e : option α ≃ β // e none = x}) (a : α) (h) :
  option_subtype x e a = ⟨(e : option α ≃ β) a, h⟩ :=
rfl

@[simp] lemma coe_option_subtype_apply_apply [decidable_eq β] (x : β)
  (e : {e : option α ≃ β // e none = x}) (a : α) :
  ↑(option_subtype x e a) = (e : option α ≃ β) a :=
rfl

@[simp] lemma option_subtype_apply_symm_apply [decidable_eq β] (x : β)
  (e : {e : option α ≃ β // e none = x}) (b : {y : β // y ≠ x}) :
  ↑((option_subtype x e).symm b) = (e : option α ≃ β).symm b :=
begin
  dsimp only [option_subtype],
  simp
end

@[simp] lemma option_subtype_symm_apply_apply_coe [decidable_eq β] (x : β)
  (e : α ≃ {y : β // y ≠ x}) (a : α) : (option_subtype x).symm e a = e a :=
rfl

@[simp] lemma option_subtype_symm_apply_apply_some [decidable_eq β] (x : β)
  (e : α ≃ {y : β // y ≠ x}) (a : α) : (option_subtype x).symm e (some a) = e a :=
rfl

@[simp] lemma option_subtype_symm_apply_apply_none [decidable_eq β] (x : β)
  (e : α ≃ {y : β // y ≠ x}) : (option_subtype x).symm e none = x :=
rfl

@[simp] lemma option_subtype_symm_apply_symm_apply [decidable_eq β] (x : β)
  (e : α ≃ {y : β // y ≠ x}) (b : {y : β // y ≠ x}) :
  ((option_subtype x).symm e : option α ≃ β).symm b = e.symm b :=
begin
  simp only [option_subtype, coe_fn_symm_mk, subtype.coe_mk, subtype.coe_eta, dite_eq_ite,
             ite_eq_right_iff],
  exact λ h, false.elim (b.property h),
end

end equiv


import tactic.rewrite_search

axiom foo : [0] = [1]
axiom bar1 : [1] = [2]
axiom bar2 : [2] = [3]
axiom bar3 : [3] = [4]
axiom bar4 : [4] = [5]
axiom bar5 : [5] = [6]
axiom bar6 : [6] = [7]
axiom baz : [4] = [0]

-- Obviously sub-optimal
example : [0] = [7] :=
begin
  -- erw [foo, bar1, bar2, bar3, bar4, bar5, bar6],
  rewrite_search_with [foo, bar1, bar2, bar3, bar4, bar5, bar6, baz]
    { optimal := ff, no visualiser, explain := tt },
end

example : [0] = [7] :=
begin
  /- `rewrite_search` says -/
  erw [foo, bar1, bar2, bar3, bar4, bar5, bar6]
end

-- Obviously optimal
example : [0] = [7] :=
begin
  rewrite_search_with [foo, bar1, bar2, bar3, bar4, bar5, bar6, baz]
    { optimal := tt, no visualiser, explain := tt },
end

example : [0] = [7] :=
begin
  /- `rewrite_search` says -/
  erw [←baz, bar4, bar5, bar6]
end


import Lbar.functor
import laurent_measures.functor
import laurent_measures.aux_lemmas
import invpoly.functor
import condensed.condensify

.

/-!
The short exact sequence
```
0 → ℤ[T⁻¹] → ℳ(S, ℤ((T))_r') → ℳ-bar(S)_r' → 0
```
-/

-- move me
lemma int.coe_nat_injective : function.injective (coe : ℕ → ℤ) :=
λ m n h, int.coe_nat_inj h

lemma int.nat_abs_of_nonpos {a : ℤ} : a ≤ 0 → ↑(a.nat_abs) = -a :=
begin
  intro h,
  rw ← int.nat_abs_neg,
  apply int.nat_abs_of_nonneg,
  exact neg_nonneg.mpr h,
end

noncomputable theory

open aux_thm69
open_locale nnreal

variables (r' : ℝ≥0) [fact (0 < r')] (S : Fintype)

namespace invpoly

def to_laurent_measures_fun (F : invpoly r' S) : S → ℤ → ℤ
| s 0       := (F s).coeff 0
| s (n+1:ℕ) := 0
| s -[1+n]  := (F s).coeff (n+1)

lemma to_laurent_measures_fun_zero (F : invpoly r' S) (s : S) :
to_laurent_measures_fun r' S F s 0 = (F s).coeff 0 :=
rfl

lemma to_laurent_measures_fun_pos (F : invpoly r' S) (s : S) (n : ℕ) :
to_laurent_measures_fun r' S F s (n+1 : ℕ) = 0 :=
rfl

lemma to_laurent_measures_fun_pos' (F : invpoly r' S) (s : S) (n : ℕ) :
to_laurent_measures_fun r' S F s (n + 1) = 0 :=
rfl

lemma to_laurent_measures_fun_pos'' (F : invpoly r' S) (s : S) {m : ℤ} (hn : 0 < m) :
to_laurent_measures_fun r' S F s m = 0 :=
begin
  convert to_laurent_measures_fun_pos' r' S F s (m - 1).nat_abs,
  rw int.nat_abs_of_nonneg,
  { ring },
  { linarith }
end

lemma to_laurent_measures_fun_neg (F : invpoly r' S) (s : S) (n : ℕ) :
to_laurent_measures_fun r' S F s -[1+n] = (F s).coeff (n+1) :=
rfl

lemma to_laurent_measures_fun_neg' (F : invpoly r' S) (s : S) (n : ℕ) :
to_laurent_measures_fun r' S F s (-(n.succ)) = (F s).coeff (n+1) :=
rfl

lemma to_laurent_measures_fun_nonpos (F : invpoly r' S) (s : S) (n : ℕ) :
to_laurent_measures_fun r' S F s (-n) = (F s).coeff n :=
begin
  cases n,
  { exact to_laurent_measures_fun_zero r' S F s, },
  { exact to_laurent_measures_fun_neg r' S F s n, }
end

/-- The natural inclusion from an S-indexed set of polynomials `Fₛ : ℤ[T⁻¹]` to
the corresponding power series `Fₛ : ℤ[[T]][T⁻¹]`. -/
@[simps] def to_laurent_measures (F : invpoly r' S) : laurent_measures r' S :=
{ to_fun := to_laurent_measures_fun r' S F,
  summable' := λ s, begin
    rw ← nnreal.summable_coe,
    rw ← @summable_subtype_and_compl ℝ ℤ _ _ _ _ _ {n : ℤ | n ≤ 0},
    split,
    { have := F.nnreal_summable s,
      rw ← nnreal.summable_coe at this,
      convert (equiv.summable_iff (equiv.nonpos_ge_zero ℤ)).mpr _,
      rotate,
      { exact λ a, ((∥(F s).coeff (int.to_nat a)∥₊ * r' ^ (-(a.1))) : ℝ) },
      rotate,
      { apply funext,
        rintros ⟨x, hx⟩,
        rcases x with ⟨_ | x⟩ | x,
        { refl },
        { rw [int.of_nat_eq_coe, int.coe_nat_succ, set.mem_set_of_eq] at hx,
          refine (not_lt.mpr hx _).elim,
          exact int.add_pos_of_nonneg_of_pos (int.coe_zero_le x) zero_lt_one },
        { simp only [subtype.coe_mk, zpow_neg_succ_of_nat, nonneg.coe_mul, coe_nnnorm,
            nnreal.coe_pow, subtype.val_eq_coe, zpow_neg, function.comp_app, nnreal.coe_eq_zero,
            equiv.nonpos_ge_zero_eval, inv_inv, inv_eq_zero, pow_eq_zero_iff, nat.succ_pos'],
        congr } },
      { refine (equiv.summable_iff (int_subtype_nonneg_equiv.symm : ℕ ≃ {z : ℤ // 0 ≤ z})).mp _,
        simpa },
      /- setup equiv with `ℕ` using `k → -k` and use `F.nnreal_summable s` -/ },
    { convert summable_zero, ext ⟨((_|n)|n), hn⟩,
      { simp only [int.of_nat_eq_coe, int.coe_nat_zero, le_refl, not_true, set.mem_compl_iff,
          set.mem_set_of_eq] at hn,
        exact hn.elim },
      { erw [nnnorm_zero, zero_mul, nnreal.coe_zero], },
      { simp only [not_le, int.neg_succ_not_pos, set.mem_compl_iff, set.mem_set_of_eq] at hn,
        exact hn.elim }, },
  end }

open_locale big_operators

/-- The projection from a Laurent measure `Fₛ : ℤ[[T]][T⁻¹]` to `Fₛ : ℤ[T⁻¹]` obtained
by throwing away all the positive terms. -/
def of_laurent_measures [fact (r' < 1)] (F : laurent_measures r' S) : invpoly r' S :=
λ s, ∑ n in finset.range ((1 : ℤ) -(laurent_measures.exists_bdd_filtration
  (show (0 : ℝ) < r', by norm_cast; exact fact.elim infer_instance)
  (by norm_cast; exact fact.elim infer_instance) F).some).to_nat,
  F s (-n) * polynomial.X^n

-- move me
open polynomial finset
lemma polynomial.sum_range_const_mul_X_pow_coeff {R : Type*} [semiring R]
  (f : ℕ → R) (d n : ℕ) :
(∑ i in range d, C (f i) * X^i).coeff n = if n < d then f n else 0 :=
begin
  rw finset_sum_coeff,
  split_ifs,
  { suffices : ∀ b, (C (f b) * X ^ b).coeff n = if n = b then f b else 0,
    { simp_rw this,
      simp [h], },
    intro i,
    simp [coeff_X_pow] },
  { refine sum_eq_zero (λ i hi, coeff_eq_zero_of_degree_lt _),
    apply lt_of_le_of_lt (degree_mul_le _ _),
    apply lt_of_le_of_lt (add_le_add (degree_C_le) (degree_X_pow_le i)),
    norm_cast,
    rw finset.mem_range at hi,
    rw [zero_add],
    exact lt_of_lt_of_le hi (le_of_not_lt h), },
end

-- ℤ[X] version without C
lemma polynomial.sum_range_int_mul_X_pow_coeff (f : ℕ → ℤ) (d n : ℕ) :
(∑ i in range d, (f i : polynomial ℤ) * X^i).coeff n = if n < d then f n else 0 :=
polynomial.sum_range_const_mul_X_pow_coeff f d n

lemma of_laurent_measures_strict [fact (r' < 1)] (F : laurent_measures r' S) :
  ∥of_laurent_measures r' S F∥₊ ≤ ∥F∥₊ :=
begin
  unfold has_nnnorm.nnnorm,
  apply finset.sum_le_sum, rintro s -,
  change tsum _ ≤ tsum _,
  delta of_laurent_measures,
  simp_rw polynomial.sum_range_int_mul_X_pow_coeff,
  apply tsum_le_tsum_of_inj (λ (n : ℕ), -(n : ℤ)),
  { intros a b h, simpa using h, },
  { intros, apply zero_le, },
  { intro i,
    split_ifs,
    { refl, },
    convert zero_le _,
    simp only [norm_zero, mul_eq_zero, nonneg.mk_eq_zero, eq_self_iff_true, true_or], },
  { apply summable_of_ne_finset_zero,
    intros i hi,
    split_ifs,
    { exfalso,
      apply hi,
      rw ← finset.mem_range at h,
      exact h, },
    { simp } },
  { exact F.nnreal_summable s },
  { apply_instance, }
end

lemma to_laurent_measures_of_laurent_measures [fact (r' < 1)] (F : invpoly r' S) :
  of_laurent_measures r' S (to_laurent_measures r' S F) = F :=
begin
  let d := (laurent_measures.exists_bdd_filtration
    (show (0 : ℝ) < r', by norm_cast; exact fact.elim infer_instance)
    (by norm_cast; exact fact.elim infer_instance) (to_laurent_measures r' S F)).some,
  have hd : ∀ (s : S) (n : ℤ), n < d → (to_laurent_measures r' S F) s n = 0 :=
    (laurent_measures.exists_bdd_filtration
    (show (0 : ℝ) < r', by norm_cast; exact fact.elim infer_instance)
    (by norm_cast; exact fact.elim infer_instance) (to_laurent_measures r' S F)).some_spec,
  ext s n,
  delta of_laurent_measures,
  suffices : (∑ (n : ℕ) in range (1 - d).to_nat,
    C (to_laurent_measures r' S F s (-↑n)) * X ^ n).coeff n =
  (F s).coeff n,
    simpa,
  rw polynomial.sum_range_const_mul_X_pow_coeff,
  rw ← to_laurent_measures_fun_nonpos,
  split_ifs, refl,
  symmetry,
  apply hd,
  push_neg at h,
  rw int.to_nat_le at h,
  linarith,
end

-- note: can't deduce immediately from `to_laurent_measures_of_laurent_measures`
-- because `r' < 1` not assumed.
lemma to_laurent_measures_injective : function.injective (to_laurent_measures r' S) :=
begin
  intros F G h,
  ext s (_|n),
  { apply_fun (λ F, F s 0) at h, exact h },
  { apply_fun (λ F, F s (-n.succ)) at h, exact h }
end

def to_laurent_measures_addhom : invpoly r' S →+ laurent_measures r' S :=
add_monoid_hom.mk' (to_laurent_measures r' S) $
begin
  intros F G, ext s ((_|n)|n),
  { simp only [to_laurent_measures_fun, add_apply, int.of_nat_zero,
      to_laurent_measures_to_fun, laurent_measures.add_apply, polynomial.coeff_add], },
  { refl, },
  { simp only [to_laurent_measures_fun, add_apply, to_laurent_measures_to_fun,
      laurent_measures.add_apply, polynomial.coeff_add], }
end

lemma to_laurent_measures_addhom_isometry (p : invpoly r' S) :
  ∥(to_laurent_measures_addhom r' S) p∥₊ = ∥p∥₊ :=
begin
  unfold nnnorm,
  congr',
  ext s,
  norm_cast,
  refine tsum_eq_tsum_of_ne_zero_bij (λ n, -((n.1 : ℕ) : ℤ)) _ _ _,
  { rintros ⟨x, _⟩ ⟨y, _⟩ h, simpa using h },
  { intros n hn,
    rw function.mem_support at hn,
    rw set.mem_range,
    rcases n with ((_|n)|n),
    { exact ⟨⟨0, hn⟩, rfl⟩ },
    { exfalso,
      simpa [to_laurent_measures_addhom, to_laurent_measures_fun_pos'] using hn },
    { exact ⟨⟨n+1, hn⟩, rfl⟩ } },
  { rintro ⟨n, hn⟩,
    simp only [to_laurent_measures_addhom, add_monoid_hom.mk'_apply, to_laurent_measures_to_fun, subtype.coe_mk, zpow_neg,
      zpow_coe_nat, mul_eq_mul_right_iff, subtype.mk_eq_mk, inv_eq_zero],
    left,
    cases n with n,
    { simp [to_laurent_measures_fun_zero], },
    { simp only [to_laurent_measures_fun_neg'], } },
end

def to_laurent_measures_hom [fact (r' < 1)]: comphaus_filtered_pseudo_normed_group_with_Tinv_hom r'
  (invpoly r' S) (laurent_measures r' S) :=
{ strict' := begin
    rintros c p hp,
    simp only [add_monoid_hom.to_fun_eq_coe, laurent_measures.mem_filtration_iff],
    simp only [mem_filtration_iff] at hp,
    rwa to_laurent_measures_addhom_isometry,
  end,
  continuous' := λ c, continuous_bot,
  map_Tinv' := begin
    intro F,
    ext s z,
    change to_laurent_measures_fun r' S (λ (s : ↥S), polynomial.X * F s) s z =
      to_laurent_measures_fun r' S F s (z + 1),
    rcases lt_trichotomy 0 z with (hz | rfl | hz),
    { let n := (z - 1).nat_abs,
      have hn : z - 1 = n := int.eq_nat_abs_of_zero_le (int.le_sub_one_of_lt hz),
      rw sub_eq_iff_eq_add at hn,
      rw [hn, to_laurent_measures_fun_pos', (by norm_cast : (n : ℤ) + 1 = (n + 1 : ℕ)),
        to_laurent_measures_fun_pos'] },
    { rw [to_laurent_measures_fun_zero, (by norm_cast : (0 : ℤ) + 1 = (0 + 1 : ℕ)),
        to_laurent_measures_fun_pos],
      simp only [polynomial.mul_coeff_zero, polynomial.coeff_X_zero, zero_mul] },
    { let n := (z + 1).nat_abs,
      have hn : (n : ℤ) = -(z + 1) := int.nat_abs_of_nonpos (int.add_one_le_of_lt hz),
      rw eq_neg_iff_eq_neg at hn,
      rw hn,
      rw ← eq_sub_iff_add_eq at hn,
      rw [hn, to_laurent_measures_fun_nonpos, (by {simp, ring} : -(n : ℤ) - 1 = -(n + 1 : ℕ)),
        to_laurent_measures_fun_nonpos, polynomial.coeff_X_mul] },
  end,
  .. to_laurent_measures_addhom r' S }.

@[simps]
def to_laurent_measures_nat_trans [fact (r' < 1)]:
  Fintype_invpoly r' ⟶ Fintype_LaurentMeasures r' :=
{ app := λ S, to_laurent_measures_hom r' S,
  naturality' := λ S T f, begin
    ext p t n,
    classical,
    suffices : to_laurent_measures_fun r' T (map f p) t n =
      (finset.filter (λ (t_1 : S.α), f t_1 = t) finset.univ).sum (λ (x : S.α),
        to_laurent_measures_fun r' S p x n),
    simpa [to_laurent_measures_hom, to_laurent_measures_addhom],
    rcases n with ((_ | n) | n),
    { convert map_apply f p t 0, },
    { simp only [int.of_nat_eq_coe, to_laurent_measures_fun_pos, finset.sum_const_zero] },
    { convert map_apply f p t (n+1), }
  end }

end invpoly

namespace laurent_measures

/-- `to_Lbar r S` is the function sending a Laurent measure `Fₛ : ℤ → ℤ` to its
truncation `Fₛ : {n ≥ 1} → ℤ` (often thought of as a power series `Fₛ ∈ Tℤ[[T]]`.) -/
@[simps] def to_Lbar (F : laurent_measures r' S) : Lbar r' S :=
{ to_fun := λ s n, if n = 0 then 0 else F s n,
  coeff_zero' := λ s, if_pos rfl,
  summable' := λ s, begin
    have := nnreal.summable_comp_injective (F.nnreal_summable s) int.coe_nat_injective,
    refine nnreal.summable_of_le _ this,
    intros n,
    split_ifs,
    { simp only [int.nat_abs_zero, nat.cast_zero, zero_mul, zero_le'] },
    { simp only [function.comp_app, nnreal.coe_nat_abs, zpow_coe_nat] }
  end }

/-- `to_Lbar_section r S` is the natural inclusion from `Lbar r S` to `laurent_measures r S`
sending a power series `Fₛ : {n≥1} → ℤ` to the associated function `Fₛ : ℤ → ℤ` which
vanishes on non-positive integers. -/
def to_Lbar_section (G : Lbar r' S) : laurent_measures r' S :=
⟨λ s n, G s n.to_nat,
begin
  intro s,
  refine (nnreal.summable_iff_on_nat_less 0 (λ n n0, _)).mpr _,
  { simp [int.to_nat_of_nonpos n0.le] },
  { simp only [int.to_nat_coe_nat, zpow_coe_nat],
    simpa only [← nnreal.coe_nat_abs] using G.summable' s }
end⟩

lemma to_Lbar_section_to_Lbar (G : Lbar r' S) :
  to_Lbar r' S (to_Lbar_section r' S G) = G :=
begin
  ext s (_|n),
  { exact (G.coeff_zero s).symm },
  { show ite (n.succ = 0) 0 (G s (n + 1)) = G s n.succ, from if_neg n.succ_ne_zero }
end

lemma tsum_nat_eq_tsum_int {α : Type*} [add_comm_monoid α] [topological_space α]
  [t2_space α]
  (f : ℤ → α) : ∑' (n : ℕ), f n = ∑' (z : ℤ), if z < 0 then 0 else f z :=
let e : ↥(function.support (λ (x : ℕ), f ↑x)) ≃
  ↥(function.support (λ (y : ℤ), ite (y < 0) 0 (f y))) :=
{ to_fun := λ x, ⟨x, x.2⟩,
  inv_fun := λ y, ⟨y.1.nat_abs, λ h, begin
    cases y with y hy,
    apply hy,
    dsimp only,
    split_ifs, refl,
    convert h,
    exact int.eq_nat_abs_of_zero_le (le_of_not_lt h_1),
  end⟩,
  left_inv := begin
    rintro ⟨x, hx⟩,
    refl,
  end,
  right_inv := begin
    rintro ⟨y, hy⟩,
    simp only [coe_coe, subtype.coe_mk, subtype.mk_eq_mk],
    refine (int.eq_nat_abs_of_zero_le _).symm,
    by_contra h,
    push_neg at h,
    apply hy,
    dsimp only,
    rw if_pos h,
  end } in
begin
  apply equiv.tsum_eq_tsum_of_support e,
  rintros ⟨x, hx⟩,
  have hx2 : ¬ ((x : ℤ) < 0) := λ h, nat.not_lt_zero x (int.coe_nat_lt.1 h),
  simp [hx2],
end

lemma to_Lbar_section_mem_filtration (G : Lbar r' S) (c : ℝ≥0)
  (hG : G ∈ pseudo_normed_group.filtration (Lbar r' S) c) :
  to_Lbar_section r' S G ∈ pseudo_normed_group.filtration (laurent_measures r' S) c :=
begin
  change _ ≤ _,
  convert (hG : _ ≤ _) using 1,
  change finset.univ.sum _ = finset.univ.sum _,
  congr' 1, ext s, norm_cast,
  symmetry,
  convert tsum_nat_eq_tsum_int (λ n, ∥G s n.to_nat∥₊ * r' ^ n),
  { ext n,
    simp only [int.nat_abs, nonneg.coe_mul, nnreal.coe_nat_cast, nnreal.coe_pow,
      int.to_nat_coe_nat, zpow_coe_nat, coe_nnnorm, mul_eq_mul_right_iff,
      int.nat_abs, _root_.coe_nnnorm, int.norm_eq_abs, int.cast_nat_abs],
    left, refl,
  },
  { ext z,
    simp only [to_Lbar_section, coe_mk, nonneg.coe_mul, coe_nnnorm, nnreal.coe_zpow],
    split_ifs,
    { simp [int.to_nat_of_nonpos h.le, G.coeff_zero] },
    { simp } },
end

lemma to_Lbar_surjective : function.surjective (to_Lbar r' S) :=
λ G, ⟨to_Lbar_section r' S G, to_Lbar_section_to_Lbar r' S G⟩

lemma nnnorm_to_Lbar (F : laurent_measures r' S) : ∥to_Lbar r' S F∥₊ ≤ ∥F∥₊ :=
begin
  rw [nnnorm_def, Lbar.nnnorm_def],
  refine finset.sum_le_sum (λ s hs, _),
  have := nnreal.summable_comp_injective (F.nnreal_summable s) int.coe_nat_injective,
  refine (tsum_le_tsum _ ((to_Lbar r' S F).summable s) this).trans
    (nnreal.tsum_comp_le_tsum_of_inj (F.nnreal_summable s) int.coe_nat_injective),
  intro n,
  simp only [nnreal.coe_nat_abs, to_Lbar_to_fun, function.comp_app, zpow_coe_nat],
  split_ifs, { rw [nnnorm_zero, zero_mul], exact zero_le' }, { refl }
end

/-- `to_Lbar_hom` is the `comphaus_filtered_pseudo_normed_group_with_Tinv_hom` version
of `to_Lbar r S`, the function which truncates a Laurent power series in `ℤ[[T]][1/T]`
to its positive terms in `Tℤ[[T]]`. -/
@[simps] def to_Lbar_hom : comphaus_filtered_pseudo_normed_group_with_Tinv_hom r'
  (laurent_measures r' S) (Lbar r' S) :=
{ to_fun := to_Lbar r' S,
  map_zero' := by { ext,
    simp only [to_Lbar_to_fun, zero_apply, if_t_t, Lbar.coe_zero, pi.zero_apply], },
  map_add' := λ F G, by { ext, simp only [to_Lbar_to_fun, add_apply, Lbar.coe_add, pi.add_apply],
    split_ifs, { rw add_zero }, { refl } },
  strict' := λ c F (hF : ∥F∥₊ ≤ c), (nnnorm_to_Lbar r' S F).trans hF,
  continuous' := λ c, begin
    let f : _ := _, show continuous f,
    rw Lbar_le.continuous_iff,
    intros N,
    let e : ℕ ↪ ℤ := ⟨coe, int.coe_nat_injective⟩,
    let T : finset ℤ := (finset.range (N + 1)).map e,
    let g : laurent_measures_bdd r' S T c → Lbar_bdd r' ⟨S⟩ c N := λ F,
    { to_fun := λ s n, if n = 0 then 0 else F s ⟨n, _⟩,
      coeff_zero' := λ s, if_pos rfl,
      sum_le' := _ },
    have : Lbar_le.truncate N ∘ f = g ∘ truncate T,
    { dsimp [f], ext F s ⟨(_|n), hn⟩, { simp only [fin.mk_zero, Lbar_bdd.coeff_zero], },
      simp only [Lbar_le.truncate_to_fun, Lbar_bdd.coe_mk, coe_coe, int.coe_nat_succ,
        truncate_to_fun, subtype.coe_mk, subtype.ext_iff, fin.coe_zero, nat.succ_ne_zero, if_false],
      exact to_Lbar_to_fun r' S F s (n+1), },
    { rw this, exact continuous_of_discrete_topology.comp (truncate_continuous _ _ _ _) },
    { simpa only [coe_coe, finset.mem_map, finset.mem_range, function.embedding.coe_fn_mk,
        int.coe_nat_inj', exists_prop, exists_eq_right] using n.2, },
    { cases S, refine le_trans (finset.sum_le_sum _) F.bound, dsimp,
      rintro s -,
      erw [finset.sum_attach', finset.sum_map, ← fin.sum_univ_eq_sum_range],
      refine finset.sum_le_sum (λ i hi, _),
      simp only [finset.mem_map, finset.mem_range, exists_prop, exists_eq_right, nnreal.coe_nat_abs,
        embedding_like.apply_eq_iff_eq, function.embedding.coe_fn_mk, subtype.coe_mk, zpow_coe_nat],
      rw dif_pos, swap, { exact i.2 },
      split_ifs, { rw [nnnorm_zero, zero_mul], exact zero_le' }, { refl } }
  end,
  map_Tinv' := λ F, begin
    erw [Tinv_apply, Lbar.Tinv_apply],
    ext s (_|n),
    { simp only [to_Lbar_to_fun, eq_self_iff_true, if_true, Lbar.Tinv_zero], },
    { simp only [to_Lbar_to_fun, nat.succ_ne_zero, int.coe_nat_succ, shift_to_fun_to_fun,
        Lbar.Tinv_succ], }
  end }

@[simps]
def to_Lbar_nat_trans : Fintype_LaurentMeasures r' ⟶ Fintype_Lbar r' :=
{ app := λ S, to_Lbar_hom r' S,
  naturality' := λ S₁ S₂ f, begin
    ext,
    simp only [Fintype_LaurentMeasures_map, category_theory.comp_apply, to_Lbar_hom_to_fun, to_Lbar_to_fun,
      Fintype_Lbar_map_to_fun, Lbar.map_to_fun, map_hom, map_apply,
      comphaus_filtered_pseudo_normed_group_with_Tinv_hom.coe_mk],
    split_ifs, { simp only [finset.sum_const_zero], }, { refl }
  end }
.

end laurent_measures

namespace Lbar

open category_theory ProFiltPseuNormGrpWithTinv₁

theorem short_exact (S : Profinite) [fact (r' < 1)] :
  short_exact
    ((condensify_map
      (whisker_right (invpoly.to_laurent_measures_nat_trans r') (PFPNGT₁_to_CHFPNG₁ₑₗ r'))).app S)
    ((condensify_map
      (whisker_right (laurent_measures.to_Lbar_nat_trans r') (PFPNGT₁_to_CHFPNG₁ₑₗ r'))).app S) :=
begin
  refine condensify_exact _ _ id id le_rfl le_rfl _ _ _ _ S,
  { apply invpoly.to_laurent_measures_injective },
  { intro S, ext F s (_|n); refl, },
  { rintro S c F ⟨hF1, hF2⟩,
    simp only [whisker_right_app, laurent_measures.to_Lbar_nat_trans_app, functor.comp_map,
      set.mem_preimage, set.mem_singleton_iff] at hF1 hF2,
    change laurent_measures.to_Lbar r' S F = 0 at hF1,
    change F ∈ pseudo_normed_group.filtration (laurent_measures r' S) c at hF2,
    show F ∈ invpoly.to_laurent_measures r' S ''
      (pseudo_normed_group.filtration (invpoly r' S) c),
    have hd := laurent_measures.bdd_filtration_spec
      (show (0 : ℝ) < r', by norm_cast; exact fact.elim infer_instance)
      (by norm_cast; exact fact.elim infer_instance)
      F,
    refine ⟨invpoly.of_laurent_measures r' S F, _, _⟩,
    { change ∥_∥₊ ≤ c,
      change ∥_∥₊ ≤ c at hF2,
      exact le_trans (invpoly.of_laurent_measures_strict r' S F) hF2 },
    { ext s n,
      change invpoly.to_laurent_measures_fun r' S _ s _ = _,
      rcases n with (_|n)|n,
      {
        change invpoly.to_laurent_measures_fun r' S _ s 0 = _,
        delta invpoly.of_laurent_measures,
        rw [invpoly.to_laurent_measures_fun_zero, invpoly.polynomial.sum_range_int_mul_X_pow_coeff],
        split_ifs, refl,
        push_neg at h,
        rw [int.to_nat_le, sub_le_iff_le_add, int.coe_nat_zero, zero_add] at h,
        symmetry,
        apply hd,
        rwa int.lt_iff_add_one_le },
      { change invpoly.to_laurent_measures_fun r' S _ s (n + 1 : ℕ) = _,
        rw invpoly.to_laurent_measures_fun_pos,
        unfold laurent_measures.to_Lbar at hF1,
        rw ext_iff at hF1,
        symmetry,
        convert congr_fun (congr_fun hF1 s) (n + 1) },
      { rw invpoly.to_laurent_measures_fun_neg,
        delta invpoly.of_laurent_measures,
        rw invpoly.polynomial.sum_range_int_mul_X_pow_coeff,
        split_ifs, refl,
        symmetry,
        apply hd,
        push_neg at h,
        rw [int.to_nat_le, sub_le_iff_le_add', int.coe_nat_add, ← add_assoc, int.coe_nat_one,
          le_add_iff_nonneg_left] at h,
        rwa [int.neg_succ_of_nat_coe', int.lt_iff_add_one_le, sub_add_cancel,
          neg_le_iff_add_nonneg] }, } },
  { rintro S c F hF,
    refine ⟨laurent_measures.to_Lbar_section r' S F, _, _⟩,
    { apply laurent_measures.to_Lbar_section_mem_filtration,
      exact pseudo_normed_group.filtration_mono le_rfl hF, },
    { apply laurent_measures.to_Lbar_section_to_Lbar } }
end

end Lbar


import data.nat.basic

universe u

def string.drop_chars (c : char) (s : string) : string :=
⟨s.data.drop_while (λ x, x = c)⟩

def string.reverse (s : string) : string := ⟨s.data.reverse⟩

def update (α : Type u) (k : nat) (a : α) (f : nat → α) : nat → α :=
λ x : nat, if x = k then a else f x

lemma forall_lt_zero (p : nat → Prop) : ∀ x < 0, p x :=
λ x h, by cases h

axiom any {P : Prop} : P

lemma forall_lt_succ (p : nat → Prop) (k : nat) :
  p k → (∀ x < k, p x) → (∀ x < k.succ, p x) :=
begin
  intros h1 h2 m h3,
  apply or.elim (nat.lt_succ_iff_lt_or_eq.elim_left h3); intro h4,
  apply h2 m h4,
  apply @eq.rec _ _ p h1 _ h4.symm,
end

lemma forall_lt_succ_iff (p : nat → Prop) (k : nat) :
  (∀ x < k.succ, p x) ↔ (p k ∧ (∀ x < k, p x)) :=
iff.intro
  (λ h, ⟨ h k (nat.lt_succ_self k),
          λ x h2, h x (lt.trans h2 (nat.lt_succ_self k))⟩)
  (λ h, forall_lt_succ p k h.left h.right)

instance forall_lt.decidable (p : nat → Prop) [decidable_pred p] :
  ∀ k : nat, decidable (∀ x < k, p x)
| 0     := decidable.is_true (forall_lt_zero p)
| (k+1) := decidable_of_iff' _ (forall_lt_succ_iff p k)

open tactic

meta def get_default (αx : expr) : tactic expr :=
to_expr ``(@inhabited.default %%αx _)