/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import order.ideal

/-!
# The back and forth method and countable dense linear orders

## Results

Suppose `α β` are linear orders, with `α` countable and `β` dense, nontrivial. Then there is an
order embedding `α ↪ β`. If in addition `α` is dense, nonempty, without endpoints and `β` is
countable, without endpoints, then we can upgrade this to an order isomorphism `α ≃ β`.

The idea for both results is to consider "partial isomorphisms", which identify a finite subset of
`α` with a finite subset of `β`, and prove that for any such partial isomorphism `f` and `a : α`, we
can extend `f` to include `a` in its domain.

## References

https://en.wikipedia.org/wiki/Back-and-forth_method

## Tags

back and forth, dense, countable, order
-/

noncomputable theory
open_locale classical

namespace order

/-- Suppose `α` is a nonempty dense linear order without endpoints, and
    suppose `lo`, `hi`, are finite subssets with all of `lo` strictly
    before `hi`. Then there is an element of `α` strictly between `lo`
    and `hi`. -/
lemma exists_between_finsets {α : Type*} [linear_order α]
  [densely_ordered α] [no_min_order α] [no_max_order α] [nonem : nonempty α]
  (lo hi : finset α) (lo_lt_hi : ∀ (x ∈ lo) (y ∈ hi), x < y) :
  ∃ m : α, (∀ x ∈ lo, x < m) ∧ (∀ y ∈ hi, m < y) :=
if nlo : lo.nonempty then
  if nhi : hi.nonempty then -- both sets are nonempty, use densely_ordered
    exists.elim (exists_between (lo_lt_hi _ (finset.max'_mem _ nlo) _ (finset.min'_mem _ nhi)))
      (λ m hm, ⟨m, λ x hx, lt_of_le_of_lt (finset.le_max' lo x hx) hm.1,
                   λ y hy, lt_of_lt_of_le hm.2 (finset.min'_le hi y hy)⟩)
  else -- upper set is empty, use `no_max_order`
    exists.elim (exists_gt (finset.max' lo nlo)) (λ m hm,
    ⟨m, λ x hx, lt_of_le_of_lt (finset.le_max' lo x hx) hm,
        λ y hy, (nhi ⟨y, hy⟩).elim⟩)
else
  if nhi : hi.nonempty then -- lower set is empty, use `no_min_order`
    exists.elim (exists_lt (finset.min' hi nhi)) (λ m hm,
    ⟨m, λ x hx, (nlo ⟨x, hx⟩).elim,
        λ y hy, lt_of_lt_of_le hm (finset.min'_le hi y hy)⟩)
  else -- both sets are empty, use nonempty
    nonem.elim (λ m,
    ⟨m, λ x hx, (nlo ⟨x, hx⟩).elim,
        λ y hy, (nhi ⟨y, hy⟩).elim⟩)

variables (α β : Type*) [linear_order α] [linear_order β]

/-- The type of partial order isomorphisms between `α` and `β` defined on finite subsets.
    A partial order isomorphism is encoded as a finite subset of `α × β`, consisting
    of pairs which should be identified. -/
def partial_iso : Type* :=
{ f : finset (α × β) // ∀ (p q ∈ f),
  cmp (prod.fst p) (prod.fst q) = cmp (prod.snd p) (prod.snd q) }

namespace partial_iso

instance : inhabited (partial_iso α β) := ⟨⟨∅, λ p h q, h.elim⟩⟩
instance : preorder (partial_iso α β) := subtype.preorder _

variables {α β}

/-- For each `a`, we can find a `b` in the codomain, such that `a`'s relation to
the domain of `f` is `b`'s relation to the image of `f`.

Thus, if `a` is not already in `f`, then we can extend `f` by sending `a` to `b`.
-/
lemma exists_across [densely_ordered β] [no_min_order β] [no_max_order β] [nonempty β]
  (f : partial_iso α β) (a : α) :
  ∃ b : β, ∀ (p ∈ f.val), cmp (prod.fst p) a = cmp (prod.snd p) b :=
begin
  by_cases h : ∃ b, (a, b) ∈ f.val,
  { cases h with b hb, exact ⟨b, λ p hp, f.prop _ hp _ hb⟩, },
  have : ∀ (x ∈ (f.val.filter (λ (p : α × β), p.fst < a)).image prod.snd)
           (y ∈ (f.val.filter (λ (p : α × β), a < p.fst)).image prod.snd),
    x < y,
  { intros x hx y hy,
    rw finset.mem_image at hx hy,
    rcases hx with ⟨p, hp1, rfl⟩,
    rcases hy with ⟨q, hq1, rfl⟩,
    rw finset.mem_filter at hp1 hq1,
    rw ←lt_iff_lt_of_cmp_eq_cmp (f.prop _ hp1.1 _ hq1.1),
    exact lt_trans hp1.right hq1.right, },
  cases exists_between_finsets _ _ this with b hb,
  use b,
  rintros ⟨p1, p2⟩ hp,
  have : p1 ≠ a := λ he, h ⟨p2, he ▸ hp⟩,
  cases lt_or_gt_of_ne this with hl hr,
  { have : p1 < a ∧ p2 < b := ⟨hl, hb.1 _ (finset.mem_image.mpr ⟨(p1, p2),
                        finset.mem_filter.mpr ⟨hp, hl⟩, rfl⟩)⟩,
    rw [←cmp_eq_lt_iff, ←cmp_eq_lt_iff] at this, cc, },
  { have : a < p1 ∧ b < p2 := ⟨hr, hb.2 _ (finset.mem_image.mpr ⟨(p1, p2),
                        finset.mem_filter.mpr ⟨hp, hr⟩, rfl⟩)⟩,
    rw [←cmp_eq_gt_iff, ←cmp_eq_gt_iff] at this, cc, },
end

/-- A partial isomorphism between `α` and `β` is also a partial isomorphism between `β` and `α`. -/
protected def comm : partial_iso α β → partial_iso β α :=
subtype.map (finset.image (equiv.prod_comm _ _)) $ λ f hf p hp q hq,
  eq.symm $ hf ((equiv.prod_comm α β).symm p)
(by { rw [←finset.mem_coe, finset.coe_image, equiv.image_eq_preimage] at hp, rwa ←finset.mem_coe })
 ((equiv.prod_comm α β).symm q)
(by { rw [←finset.mem_coe, finset.coe_image, equiv.image_eq_preimage] at hq, rwa ←finset.mem_coe })

variable (β)
/-- The set of partial isomorphisms defined at `a : α`, together with a proof that any
    partial isomorphism can be extended to one defined at `a`. -/
def defined_at_left [densely_ordered β] [no_min_order β] [no_max_order β] [nonempty β]
  (a : α) : cofinal (partial_iso α β) :=
{ carrier := λ f, ∃ b : β, (a, b) ∈ f.val,
  mem_gt := λ f, begin
    cases exists_across f a with b a_b,
    refine ⟨⟨insert (a, b) f.val, λ p hp q hq, _⟩, ⟨b, finset.mem_insert_self _ _⟩,
      finset.subset_insert _ _⟩,
    rw finset.mem_insert at hp hq,
    rcases hp with rfl | pf;
    rcases hq with rfl | qf,
    { simp only [cmp_self_eq_eq] },
    { rw cmp_eq_cmp_symm, exact a_b _ qf },
    { exact a_b _ pf },
    { exact f.prop _ pf _ qf },
  end }

variables (α) {β}
/-- The set of partial isomorphisms defined at `b : β`, together with a proof that any
    partial isomorphism can be extended to include `b`. We prove this by symmetry. -/
def defined_at_right [densely_ordered α] [no_min_order α] [no_max_order α] [nonempty α]
  (b : β) : cofinal (partial_iso α β) :=
{ carrier := λ f, ∃ a, (a, b) ∈ f.val,
  mem_gt := λ f, begin
    rcases (defined_at_left α b).mem_gt f.comm with ⟨f', ⟨a, ha⟩, hl⟩,
    refine ⟨f'.comm, ⟨a, _⟩, _⟩,
    { change (a, b) ∈ f'.val.image _,
      rwa [←finset.mem_coe, finset.coe_image, equiv.image_eq_preimage] },
    { change _ ⊆ f'.val.image _,
      rw [←finset.coe_subset, finset.coe_image, ← equiv.subset_image],
      change f.val.image _ ⊆ _ at hl,
      rwa [←finset.coe_subset, finset.coe_image] at hl }
  end }

variable {α}

/-- Given an ideal which intersects `defined_at_left β a`, pick `b : β` such that
    some partial function in the ideal maps `a` to `b`. -/
def fun_of_ideal [densely_ordered β] [no_min_order β] [no_max_order β] [nonempty β]
  (a : α) (I : ideal (partial_iso α β)) :
  (∃ f, f ∈ defined_at_left β a ∧ f ∈ I) → { b // ∃ f ∈ I, (a, b) ∈ subtype.val f } :=
classical.indefinite_description _ ∘ (λ ⟨f, ⟨b, hb⟩, hf⟩, ⟨b, f, hf, hb⟩)

/-- Given an ideal which intersects `defined_at_right α b`, pick `a : α` such that
    some partial function in the ideal maps `a` to `b`. -/
def inv_of_ideal [densely_ordered α] [no_min_order α] [no_max_order α] [nonempty α]
  (b : β) (I : ideal (partial_iso α β)) :
  (∃ f, f ∈ defined_at_right α b ∧ f ∈ I) → { a // ∃ f ∈ I, (a, b) ∈ subtype.val f } :=
classical.indefinite_description _ ∘ (λ ⟨f, ⟨a, ha⟩, hf⟩, ⟨a, f, hf, ha⟩)

end partial_iso
open partial_iso

variables (α β)

/-- Any countable linear order embeds in any nontrivial dense linear order. -/
theorem embedding_from_countable_to_dense [encodable α] [densely_ordered β] [nontrivial β] :
  nonempty (α ↪o β) :=
begin
  rcases exists_pair_lt β with ⟨x, y, hxy⟩,
  cases exists_between hxy with a ha,
  haveI : nonempty (set.Ioo x y) := ⟨⟨a, ha⟩⟩,
  let our_ideal : ideal (partial_iso α _) :=
    ideal_of_cofinals default (defined_at_left (set.Ioo x y)),
  let F := λ a, fun_of_ideal a our_ideal (cofinal_meets_ideal_of_cofinals _ _ a),
  refine ⟨rel_embedding.trans (order_embedding.of_strict_mono (λ a, (F a).val) (λ a₁ a₂, _))
    (order_embedding.subtype _)⟩,
  rcases (F a₁).prop with ⟨f, hf, ha₁⟩,
  rcases (F a₂).prop with ⟨g, hg, ha₂⟩,
  rcases our_ideal.directed _ hf _ hg with ⟨m, hm, fm, gm⟩,
  exact (lt_iff_lt_of_cmp_eq_cmp $ m.prop (a₁, _) (fm ha₁) (a₂, _) (gm ha₂)).mp
end

/-- Any two countable dense, nonempty linear orders without endpoints are order isomorphic. -/
theorem iso_of_countable_dense
  [encodable α] [densely_ordered α] [no_min_order α] [no_max_order α] [nonempty α]
  [encodable β] [densely_ordered β] [no_min_order β] [no_max_order β] [nonempty β] :
  nonempty (α ≃o β) :=
let to_cofinal : α ⊕ β → cofinal (partial_iso α β) :=
  λ p, sum.rec_on p (defined_at_left β) (defined_at_right α) in
let our_ideal : ideal (partial_iso α β) := ideal_of_cofinals default to_cofinal in
let F := λ a, fun_of_ideal a our_ideal (cofinal_meets_ideal_of_cofinals _ to_cofinal (sum.inl a)) in
let G := λ b, inv_of_ideal b our_ideal (cofinal_meets_ideal_of_cofinals _ to_cofinal (sum.inr b)) in
⟨order_iso.of_cmp_eq_cmp (λ a, (F a).val) (λ b, (G b).val) $ λ a b,
begin
  rcases (F a).prop with ⟨f, hf, ha⟩,
  rcases (G b).prop with ⟨g, hg, hb⟩,
  rcases our_ideal.directed _ hf _ hg with ⟨m, hm, fm, gm⟩,
  exact m.prop (a, _) (fm ha) (_, b) (gm hb)
end⟩

end order


import tactic.interactive
import .mat .one_by_one_matrix
import tactic.transfer
import logic.relator
import .inner_product_space

-- TODO: move
namespace fin

open finset

lemma sum_image_succ_univ {α : Type} [comm_ring α] {n : nat} (f : fin (n + 1) → α) :
  sum (image fin.succ univ) (λ x, f x) = sum univ (λ i, f (fin.succ i)) :=
begin
  rw finset.sum_image,
  intros _ _ _ _ h,
  apply (eq_iff_veq _ _).2,
  apply (eq_iff_veq _ _).1 (succ.inj h),
end

lemma image_succ_univ (n : nat) :
  insert (⟨0, nat.zero_lt_succ n⟩ : fin (n + 1)) (image fin.succ (univ : finset (fin n)))
    = (univ : finset (fin (n + 1))) :=
begin
  apply subset.antisymm,
  { intros k hk,
    rw mem_insert at hk,
    apply or.elim hk (λ _, mem_univ) (λ _, mem_univ),
  },
  { intros k _,
    by_cases h_cases: k = ⟨0, nat.zero_lt_succ n⟩,
    { rw h_cases,
      apply mem_insert_self _ },
    { apply mem_insert_of_mem,
      rw mem_image,
      use fin.pred k h_cases,
      use mem_univ _,
      apply succ_pred } }
end

lemma not_mem_image_succ_univ (n : nat) :
  ¬ (⟨0, nat.zero_lt_succ n⟩ : fin (n + 1)) ∈ image fin.succ (univ : finset (fin n)) :=
begin
  intros h,
  rw mem_image at h,
  apply exists.elim h,
  intros k hk,
  apply exists.elim hk,
  intros _ hk',
  rw eq_iff_veq at hk',
  simp at hk',
  exact nat.succ_ne_zero _ hk'
end

lemma sum_succ {α : Type} [comm_ring α] {n : nat} (f : fin (n + 1) → α) :
  finset.sum finset.univ (λ x : fin (n + 1), f x) = f ⟨0, nat.zero_lt_succ n⟩ + finset.sum finset.univ (λ x : fin n, f x.succ) :=
begin
  rw [← sum_image_succ_univ],
  rw [← image_succ_univ n],
  rw sum_insert,
  apply not_mem_image_succ_univ n
end

end fin

section transport

open tactic

@[user_attribute]
meta def to_rowvec_attr : user_attribute (name_map name) name :=
{ name      := `to_rowvec,
  descr     := "Transport column vector to row vector",
  cache_cfg := ⟨λ ns, ns.mfoldl (λ dict n, do
    val ← to_rowvec_attr.get_param n,
    pure $ dict.insert n val) mk_name_map, []⟩,
  parser    := lean.parser.ident,
  after_set := some $ λ src _ _, do
    env ← get_env,
    dict ← to_rowvec_attr.get_cache,
    tgt ← to_rowvec_attr.get_param src,
    (get_decl tgt >> skip) <|>
      transport_with_dict dict src tgt }

end transport

def colvec (n : Type) [fintype n] (α : Type) : Type := matrix n (fin 1) α
def rowvec (n : Type) [fintype n] (α : Type) : Type := matrix (fin 1) n α
attribute [to_rowvec rowvec] colvec

section instances

variables {α : Type} {n : Type} [fintype n]

instance colvec.has_scalar [semiring α] : has_scalar α (colvec n α) := matrix.has_scalar
instance rowvec.has_scalar [semiring α] : has_scalar α (rowvec n α) := matrix.has_scalar
attribute [to_rowvec rowvec.has_scalar] colvec.has_scalar

instance colvec.has_add [has_add α] : has_add (colvec n α) := matrix.has_add
instance rowvec.has_add [has_add α] : has_add (rowvec n α) := matrix.has_add
attribute [to_rowvec rowvec.has_add] colvec.has_add

instance colvec.has_zero [has_zero α] : has_zero (colvec n α) := matrix.has_zero
instance rowvec.has_zero [has_zero α] : has_zero (rowvec n α) := matrix.has_zero
attribute [to_rowvec rowvec.has_zero] colvec.has_zero

instance colvec.add_comm_group [add_comm_group α] : add_comm_group (colvec n α) := matrix.add_comm_group
instance rowvec.add_comm_group [add_comm_group α] : add_comm_group (rowvec n α) := matrix.add_comm_group
attribute [to_rowvec rowvec.add_comm_group] colvec.add_comm_group

instance colvec.module [ring α] : module α (colvec n α) := matrix.module
instance rowvec.module [ring α] : module α (rowvec n α) := matrix.module
attribute [to_rowvec rowvec.add_comm_group] colvec.add_comm_group

def colvec.nth (x : colvec n α) (i : n) : α := x i 0
def rowvec.nth (x : rowvec n α) (i : n) : α := x 0 i
attribute [to_rowvec rowvec.nth] colvec.nth

def colvec.mk (f : n → α) : colvec n α := λ i j, f i
def rowvec.mk (f : n → α) : rowvec n α := λ i j, f j
attribute [to_rowvec rowvec.mk] colvec.mk

@[simp, to_rowvec rowvec.nth_mk]
lemma colvec.nth_mk (f : n → α) : colvec.nth (colvec.mk f) = f :=
by refl

@[simp, to_rowvec rowvec.nth_mk]
lemma colvec.nth_zero [has_zero α] (i : n): (0 : colvec n α).nth i = 0 :=
by refl

lemma colvec.eq_of_nth_eq (x : colvec n α) (y : colvec n α) (h : ∀i, x.nth i = y.nth i) : x = y :=
begin
  ext i j,
  rw fin.eq_zero_fin1 j,
  apply h,
end

lemma rowvec.eq_of_nth_eq (x : rowvec n α) (y : rowvec n α) (h : ∀i, x.nth i = y.nth i) : x = y :=
begin
  ext i j,
  rw fin.eq_zero_fin1 i,
  apply h,
end

attribute [to_rowvec rowvec.eq_of_nth_eq] colvec.eq_of_nth_eq

end instances

section inner

variables {α : Type} [has_mul α] [add_comm_monoid α] {n : Type} [fintype n]

def colvec.inner (v w : colvec n α) : α := (matrix.mul vᵀ w) 0 0
def rowvec.inner (v w : rowvec n α) : α := (matrix.mul v wᵀ) 0 0

end inner

section transfer

variables {α : Type} [has_mul α] [add_comm_monoid α] {n : Type} [fintype n]

open transfer

/- Set up relators for transfer tactic to transfer from colvec to rowvec -/

lemma colvec.rel_eq_inner {α : Type} [comm_ring α]:
  ((λ (x : rowvec n α) (y : colvec n α), xᵀ = y) ⇒ (λ (x : rowvec n α) (y : colvec n α), xᵀ = y) ⇒ @eq α) rowvec.inner colvec.inner :=
begin
  intros x xt hx y yt hy,
  unfold colvec.inner rowvec.inner,
  rw [hy,←hx,matrix.transpose_transpose]
end

lemma colvec.rel_transpose_add {α : Type} [comm_ring α]:
  ((λ (x : rowvec n α) (y : colvec n α), xᵀ = y) ⇒ (λ (x : rowvec n α) (y : colvec n α), xᵀ = y) ⇒ (λ (x : rowvec n α) (y : colvec n α), xᵀ = y)) (+) (+) :=
begin
  intros x xt hx y yt hy,
  rw [←hx,←hy,matrix.transpose_add]
end

lemma relator.rel_eq_add {α : Type} [comm_ring α]:
  ((@eq α) ⇒ (@eq α) ⇒ (@eq α)) (+) (+) :=
begin
  intros x x' hx y y' hy,
  rw [hx,hy]
end

lemma relator.rel_le {α  : Type} [has_le α] :
  (@eq α ⇒ @eq α ⇒ (↔)) (≤) (≤) :=
λ _ _ h1 _ _ h2, by rw [h1, h2]

lemma relator.rel_pos {α  : Type} [has_le α] [has_zero α] :
  (@eq α ⇒ (↔)) (has_le.le 0) (has_le.le 0) :=
λ _ _ h, by rw [h]

lemma relator.rel_eq_const {α  : Type} {a : rowvec n α} :
  ((@eq (rowvec n α))) (a) (a) := rfl

lemma relator.rel_eq_zero_transpose {α  : Type} [has_zero α] :
  ((λ (x : rowvec n α) (y : colvec n α), xᵀ = y) ⇒ (↔)) (eq 0) (eq 0) :=
begin
  intros x y h,
  convert matrix.eq_iff_transpose_eq _ _,
  apply h.symm
end

lemma colvec.rel_smul_transpose {α  : Type} [semiring α] (a : α) :
  ((λ (x : rowvec n α) (y : colvec n α), xᵀ = y) ⇒
  (λ (x : rowvec n α) (y : colvec n α), xᵀ = y))
  (has_scalar.smul a) (has_scalar.smul a) :=
λ _ _ h, by rw [matrix.transpose_smul,h]

lemma relator.rel_mul_const {α  : Type} [has_mul α] (a : α) :
  ((=) ⇒ (=)) (has_mul.mul a) (has_mul.mul a) :=
λ _ _ h, by rw [h]

lemma relator.rel_eq_zero {α  : Type} [has_zero α] :
  ((@eq α) ⇒ (↔)) (eq 0) (eq 0) :=
λ _ _ h, by rw [h]

-- TODO: move
lemma relator.rel_imp' : ((↔) ⇒ (↔) ⇒ (↔)) (→) (→) :=
λ _ _ h1 _ _ h2, by rw [h1, h2]

-- TODO: move
lemma relator.rel_eq_same {α  : Type} : (@eq α ⇒ @eq α ⇒ (↔)) (=) (=) :=
begin
  apply relator.rel_eq,
  split,
  exact λ a b c h1 h2, eq.trans h1 h2.symm,
  exact λ a b c h1 h2, eq.trans h1.symm h2
end

instance colvec.bi_total_transpose : relator.bi_total (λ (x : rowvec n α) (y : colvec n α), xᵀ = y) :=
⟨λ x, ⟨xᵀ, eq.refl _⟩, λ x, ⟨xᵀ, matrix.transpose_transpose _⟩⟩

lemma colvec.rel_forall_transpose : (((λ (x : rowvec n α) (y : colvec n α), xᵀ = y) ⇒ iff) ⇒ iff) (λp, ∀i, p i) (λq, ∀i, q i) :=
by apply relator.rel_forall_of_total

meta def colvec.transfer : tactic unit :=
tactic.transfer [
  `relator.rel_eq_zero_transpose,
  `relator.rel_eq_zero,
  `relator.rel_eq_same,
  `relator.rel_eq_add,
  `relator.rel_pos,
  `relator.rel_imp',
  `colvec.rel_forall_transpose,
  `colvec.rel_eq_inner,
  `colvec.rel_transpose_add,
  `relator.rel_eq_const,
  `colvec.rel_smul_transpose,
  `relator.rel_mul_const
]

end transfer

section inner

variables {α : Type} [comm_ring α] {n : Type} [fintype n] (a : α) (x y z : colvec n α)

lemma colvec.inner_comm : x.inner y = y.inner x :=
begin
  dsimp [colvec.inner, colvec, mat],
  intros,
  rw [←matrix.transpose_transpose ((matrix.transpose y).mul x), matrix.transpose_mul, matrix.transpose_transpose y],
  refl
end

lemma rowvec.inner_comm : ∀ (x y : rowvec n α), x.inner y = y.inner x :=
begin colvec.transfer, exact colvec.inner_comm end

lemma colvec.inner_add_left : (x + y).inner z = x.inner z + y.inner z :=
by simp [colvec.inner, colvec, mat, matrix.transpose_add, matrix.add_mul']

lemma rowvec.inner_add_left : ∀ (x y z : rowvec n α), (x + y).inner z = x.inner z + y.inner z :=
begin colvec.transfer, exact colvec.inner_add_left end

lemma colvec.inner_smul_left : (a • x).inner y = a * x.inner y :=
by simp [colvec.inner, colvec, mat, matrix.smul_mul, matrix.transpose_smul]; refl

lemma rowvec.inner_smul_left (a : α) : ∀ (x y : rowvec n α), (a • x).inner y = a * x.inner y :=
begin colvec.transfer, exact colvec.inner_smul_left a end

end inner

section inner

variables {α : Type} [linear_ordered_comm_ring α] {m : Type} [fintype m] {n : Type} [fintype n] [decidable_eq n] (a : α) (x y z : colvec n α)

lemma colvec.inner_self_nonneg : 0 ≤ x.inner x :=
begin
  dsimp [colvec.inner, colvec, mat, matrix.mul],
  apply finset.sum_nonneg,
  intros i _,
  apply mul_self_nonneg
end

lemma rowvec.inner_self_nonneg : ∀ (x : rowvec n α), 0 ≤ x.inner x :=
begin colvec.transfer, exact colvec.inner_self_nonneg end

lemma colvec.eq_zero_of_inner_self_eq_zero : 0 = x.inner x → 0 = x :=
begin
  dsimp [colvec.inner, colvec, mat, matrix.mul],
  intros h,
  apply colvec.eq_of_nth_eq,
  intro i,
  apply (eq_zero_of_mul_self_eq_zero ((finset.sum_eq_zero_iff_of_nonneg _).1 h.symm i (finset.mem_univ _))).symm,
  intros i hi,
  apply mul_self_nonneg
end

lemma rowvec.eq_zero_of_inner_self_eq_zero : ∀ (x : rowvec n α), 0 = x.inner x → 0 = x :=
begin colvec.transfer, exact colvec.eq_zero_of_inner_self_eq_zero end

local attribute [instance] classical.prop_decidable

noncomputable instance colvec.real_inner_product_space : real_inner_product_space (colvec n ℝ) :=
{
  inner := colvec.inner,
  inner_add_left := colvec.inner_add_left,
  inner_smul_left := colvec.inner_smul_left,
  inner_comm := colvec.inner_comm,
  inner_self_nonneg := colvec.inner_self_nonneg,
  eq_zero_of_inner_self_eq_zero := λ x h, (colvec.eq_zero_of_inner_self_eq_zero x h.symm).symm
}

noncomputable instance rowvec.real_inner_product_space : real_inner_product_space (rowvec n ℝ) :=
{
  inner := rowvec.inner,
  inner_add_left := rowvec.inner_add_left,
  inner_smul_left := rowvec.inner_smul_left,
  inner_comm := rowvec.inner_comm,
  inner_self_nonneg := rowvec.inner_self_nonneg,
  eq_zero_of_inner_self_eq_zero := λ x h, (rowvec.eq_zero_of_inner_self_eq_zero x h.symm).symm
}

lemma colvec.inner_eq_sum_nth :
  x.inner y = finset.univ.sum (λi, x.nth i * y.nth i) :=
by unfold colvec.inner matrix.mul colvec.nth; refl

lemma rowvec.inner_eq_sum_nth (x : rowvec n α) (y : rowvec n α) :
  x.inner y = finset.univ.sum (λi, x.nth i * y.nth i) :=
by unfold rowvec.inner matrix.mul colvec.nth; refl

attribute [to_rowvec rowvec.inner_eq_sum_nth] colvec.inner_eq_sum_nth

--TODO @[to_rowvec rowvec.inner_mul]
lemma colvec.inner_mul (A : matrix m n ℝ) (x : colvec n ℝ) (y : colvec m ℝ) :
  ⟪ x, Aᵀ.mul y ⟫ = ⟪ y, A.mul x ⟫ :=
begin
  unfold has_inner.inner colvec.inner,
  rw [←one_by_one_matrix.transpose ℝ (matrix.mul xᵀ (matrix.mul Aᵀ y)),
      matrix.transpose_mul, matrix.transpose_mul, ←matrix.mul_assoc,
      matrix.transpose_transpose, matrix.transpose_transpose]
end

end inner

section fin_index

variables {α : Type} {n : nat} (a : α) (x y z : colvec (fin n) α)

@[to_rowvec rowvec.head]
def colvec.head (x : colvec (fin (n+1)) α) : α := x.nth ⟨0, nat.zero_lt_succ n⟩

@[to_rowvec rowvec.tail]
def colvec.tail (x : colvec (fin (n+1)) α) : colvec (fin n) α :=
  colvec.mk (λ i, x.nth ⟨i.1.succ, nat.succ_lt_succ i.2⟩)

@[to_rowvec rowvec.cons]
def colvec.cons (c : α) (x : colvec (fin n) α) : colvec (fin (n+1)) α :=
  colvec.mk (λ i, dite (i.val = 0) (λ_, c) (λhi, x.nth ⟨i.val.pred,nat.pred_lt_pred hi i.2⟩))

@[simp, to_rowvec rowvec.head_smul]
lemma colvec.head_smul [semiring α] (c : α) (x : colvec (fin (n+1)) α) :
  (c • x).head = c * x.head :=
by refl

@[simp, to_rowvec rowvec.tail_smul]
lemma colvec.tail_smul [semiring α] (c : α) (x : colvec (fin (n+1)) α) :
  (c • x).tail = c • x.tail :=
by refl

@[simp, to_rowvec rowvec.head_cons]
lemma colvec.head_cons (c : α) (x : colvec (fin n) α) : (colvec.cons c x).head = c :=
by refl

-- TODO: get rid of this?
attribute [to_rowvec rowvec.head.equations._eqn_1] colvec.head.equations._eqn_1
attribute [to_rowvec rowvec.tail.equations._eqn_1] colvec.tail.equations._eqn_1
attribute [to_rowvec rowvec.cons.equations._eqn_1] colvec.cons.equations._eqn_1

@[simp, to_rowvec rowvec.tail_cons]
lemma colvec.tail_cons (x : colvec (fin n) α) (c : α) : (colvec.cons c x).tail = x :=
by apply colvec.eq_of_nth_eq; simp [colvec.tail,colvec.cons,nat.pred_succ,dif_eq_if, nat.succ_ne_zero]

@[simp, to_rowvec rowvec.cons_head_tail]
lemma colvec.cons_head_tail (x : colvec (fin (n+1)) α) : colvec.cons x.head x.tail = x :=
begin
  apply colvec.eq_of_nth_eq,
  intro i,
  unfold colvec.cons colvec.head colvec.tail,
  by_cases h_cases : i.val = 0,
  { have hi : i = ⟨0, nat.zero_lt_succ n⟩,
      from (fin.eq_iff_veq _ _).2 h_cases,
    simp [hi] },
  { simp [h_cases, nat.succ_pred_eq_of_pos (nat.pos_of_ne_zero h_cases)] },
end

--TODO: @[to_rowvec rowvec.last]
lemma colvec.mul_head_add_mul_tail {α : Type} [comm_ring α] (x y : colvec (fin (n+1)) ℝ) :
  x.head * y.head + ⟪ x.tail, y.tail ⟫ = ⟪ x, y ⟫  :=
begin
  unfold has_inner.inner,
  simp only [colvec.inner_eq_sum_nth],
  unfold colvec.head colvec.tail,
  rw fin.sum_succ (λ j : fin (n+1), x.nth j * y.nth j),
  congr,
  simp,
  funext,
  congr,
  apply (fin.eq_iff_veq _ _).2,
  simp,
  apply (fin.eq_iff_veq _ _).2,
  simp,
end

@[to_rowvec rowvec.last]
def colvec.last (x : colvec (fin (n+1)) α) : α := x.nth ⟨n, nat.lt_succ_self n⟩

@[to_rowvec rowvec.butlast]
def colvec.butlast (x : colvec (fin (n+1)) α) : colvec (fin n) α :=
  colvec.mk (λ i, x.nth ⟨i.1, nat.le_succ_of_le i.2⟩)

@[to_rowvec rowvec.snoc]
def colvec.snoc (x : colvec (fin n) α) (c : α) : colvec (fin (n+1)) α :=
  colvec.mk (λ i, dite (i.val < n) (λhi, x.nth ⟨i.val,hi⟩) (λ_, c))

--TODO: Lemmas about last, butlast, snoc

end fin_index


import topology.metric_space.basic
import .for_mathlib

open set

lemma Inf.closure (I : set ℝ) (h1 : ∃ a, a ∈ I) (h2 : ∃ (x : ℝ), ∀ (y : ℝ), y ∈ I → x ≤ y) : Inf I ∈ closure I :=
begin
  intros F hF,
  by_contradiction hhF,
  obtain ⟨ε, hε, H⟩  := metric.is_open_iff.1 (is_open_compl_iff.2 hF.1) (Inf I) (by exact mem_compl hhF),
  have hIε : ∀ x ∈ I, Inf I + ε/2 ≤ x,
  { intros x hx,
    cases le_or_lt (Inf I + ε / 2) x,
    { exact h },
    { cases le_or_lt (Inf I - ε / 2) x,
      exfalso,
      { have hxB : x ∈ metric.ball (Inf I) ε,
        { rw [metric.mem_ball',real.dist_eq],
          exact abs_lt.2 ⟨by linarith, by linarith⟩ },
        exact (H hxB) (hF.2 hx) },
      { linarith [(real.is_glb_Inf I ⟨x, hx⟩ h2).1 hx] } } },
  obtain ⟨a, ⟨ha1,ha2⟩⟩ := real.lt_Inf_add_pos h1 (half_pos hε),
  linarith [hIε a ha1],
end

lemma bolz (a b : ℝ) (hab : a < b) (f: ℝ → ℝ) (hf : continuous_on f (Icc a b)) (ha : (f a)<0 ∧ (f b)>0) : ∃ c ∈ (Icc a b),f(c)=0 :=
begin
  let I := {x ∈ Icc a b | f x ≥ 0},
  have h1 : ∃ (x : ℝ), x ∈ I, by exact ⟨b, right_mem_Icc.2 (le_of_lt hab), ge_iff_le.1 (le_of_lt ha.2)⟩,
  have hIb : bdd_below I := ⟨a, λ _ h, h.1.1⟩,
  have hb : Inf I ≤ b,
  {
    rw real.Inf_le_iff,
    { intros ε hε,
      use b,
      split,
      { simp only [mem_sep_eq, ge_iff_le, right_mem_Icc],
        split; linarith },
      exact lt_add_of_pos_right b hε },
    { exact ⟨a, (λ y hy, (mem_Icc.1 hy.1).1)⟩ },
    { exact nonempty_def.mpr h1 }
  },
  cases ha with ha1 ha2,
  have hIIci : I = f⁻¹'(Ici 0) ∩ (Icc a b), by exact subset.antisymm (λ x hx, ⟨hx.2, hx.1⟩) (λ x hx, ⟨hx.2, hx.1⟩),
  have hII : is_closed I,
  { obtain ⟨U, hU⟩ := continuous_on_iff_is_closed.1 hf (Ici 0) (is_closed_Ici) ,
    rw [hIIci, hU.2],
    exact is_closed.inter hU.1 (is_closed_Icc),
    },
  have himI : 0 ≤ f (Inf I),
  { obtain hx := Inf.closure I h1 ⟨a, (λ y hy, (mem_Icc.1 hy.1).1)⟩,
    rw (is_closed.closure_eq hII) at hx,
    exact hx.2 },
  have ha : a < Inf {x ∈ Icc a b | f x ≥ 0},
  { have h3 : a ≠ Inf I,
    { intro hax,
      have htt : f (Inf I) <0, by rwa ← hax,
      linarith },
    apply (ne.le_iff_lt h3).mp,
    have halb : lower_bounds I a,
    { unfold lower_bounds,
      simp only [and_imp, mem_sep_eq, ge_iff_le, mem_set_of_eq, mem_Icc],
      exact λ t ht1 ht2 hh, ht1 },
    exact (le_cInf_iff ⟨a, halb⟩ h1).2 halb },
  have hI : Inf I ∈ Icc a b := mem_Icc.mpr ⟨le_of_lt ha, hb⟩,
  have hf : f (Inf {x ∈ Icc a b | f x ≥ 0}) = 0,
  { by_contradiction,
    cases (ne.symm h).lt_or_lt,
    { obtain ⟨δ₀, hδ₀ , hh⟩  := metric.continuous_on_iff.1 hf (Inf I) hI ((f (Inf I))/2) (half_pos h_1),
      let δ := min δ₀ ((Inf I)-a),
      have hδ : δ > 0,
      { exact lt_min hδ₀ (by linarith) },
      have hhδ : ∀ (a_1 : ℝ), a_1 ∈ Icc a b → dist a_1 (Inf I) < δ → dist (f a_1) (f (Inf I)) < f (Inf I) / 2,
      { intros x hx hxd,
        exact hh x hx (by linarith[min_le_left δ₀ (Inf I - a)]) },
      have t : Inf I - δ/2 ∈ Icc a b,
      { exact (mem_Icc.mpr ⟨by linarith [min_le_right δ₀ ((Inf I)-a)], by linarith⟩) },
      have tt : dist (Inf I - δ/2) (Inf I) < δ,
      { have m : abs(Inf I - δ/2 - Inf I) = δ/2,
        { ring_nf,
          rw abs_neg,
          exact abs_of_pos (by linarith) },
        rw [real.dist_eq (Inf I - δ/2) (Inf I), m],
        linarith },
      obtain hhh := (hhδ (Inf I - δ/2) t tt),
      have r : 0 < f (Inf I - δ/2),
      { rw real.dist_eq at hhh,
        linarith[neg_lt_of_abs_lt hhh] },
      have HH : Inf I ≤ Inf I - δ / 2,
      {
        have hkey : Inf I - δ/2 ∈ I := ⟨t, ge_iff_le.1 (le_of_lt r)⟩,
        apply (real.is_glb_Inf I ⟨Inf I - δ/2, hkey⟩ hIb).1 hkey,
      },
      linarith [HH] },
    { linarith[himI] } },
  exact ⟨Inf {x ∈ (Icc a b)| f x >= 0}, hI, hf⟩,
end

theorem bolzano (a b : ℝ) (hab : a < b) (f: ℝ → ℝ) (hf : continuous_on f (Icc a b)) (ha : (f a)*(f b)<0) : ∃ c ∈ (Icc a b), f(c)=0 :=
begin
  cases (mul_neg_iff.1 ha),
  { let g := λ (α : ℝ ), -α,
    obtain ⟨c, H, hc⟩  := bolz a b hab (g ∘ f) (continuous_on.neg hf) ⟨neg_lt_zero.mpr h.1, neg_pos.mpr h.2⟩,
    exact ⟨c, H, neg_eq_zero.1 hc⟩ },
  { exact bolz a b hab f hf h }
end


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

! This file was ported from Lean 3 source module algebra.tropical.basic
! leanprover-community/mathlib commit 9116dd6709f303dcf781632e15fdef382b0fc579
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupPower.Order
import Mathlib.Algebra.Order.Monoid.WithTop
import Mathlib.Algebra.SMulWithZero
import Mathlib.Algebra.Order.Monoid.MinMax

/-!

# Tropical algebraic structures

This file defines algebraic structures of the (min-)tropical numbers, up to the tropical semiring.
Some basic lemmas about conversion from the base type `R` to `tropical R` are provided, as
well as the expected implementations of tropical addition and tropical multiplication.

## Main declarations

* `Tropical R`: The type synonym of the tropical interpretation of `R`.
    If `[LinearOrder R]`, then addition on `R` is via `min`.
* `Semiring (Tropical R)`: A `LinearOrderedAddCommMonoidWithTop R`
    induces a `Semiring (Tropical R)`. If one solely has `[LinearOrderedAddCommMonoid R]`,
    then the "tropicalization of `R`" would be `Tropical (WithTop R)`.

## Implementation notes

The tropical structure relies on `Top` and `min`. For the max-tropical numbers, use
`OrderDual R`.

Inspiration was drawn from the implementation of `Additive`/`Multiplicative`/`Opposite`,
where a type synonym is created with some barebones API, and quickly made irreducible.

Algebraic structures are provided with as few typeclass assumptions as possible, even though
most references rely on `Semiring (Tropical R)` for building up the whole theory.

## References followed

* https://arxiv.org/pdf/math/0408099.pdf
* https://www.mathenjeans.fr/sites/default/files/sujets/tropical_geometry_-_casagrande.pdf

-/

universe u v

variable (R : Type u)

/-- The tropicalization of a type `R`. -/
def Tropical : Type u :=
  R
#align tropical Tropical

variable {R}

namespace Tropical

/-- Reinterpret `x : R` as an element of `Tropical R`.
See `Tropical.tropEquiv` for the equivalence.
-/
--@[pp_nodot] Porting note: not implemented in Lean4
def trop : R → Tropical R :=
  id
#align tropical.trop Tropical.trop

/-- Reinterpret `x : Tropical R` as an element of `R`.
See `Tropical.tropEquiv` for the equivalence. -/
--@[pp_nodot] Porting note: not implemented in Lean4
def untrop : Tropical R → R :=
  id
#align tropical.untrop Tropical.untrop

theorem trop_injective : Function.Injective (trop : R → Tropical R) := fun _ _ => id
#align tropical.trop_injective Tropical.trop_injective

theorem untrop_injective : Function.Injective (untrop : Tropical R → R) := fun _ _ => id
#align tropical.untrop_injective Tropical.untrop_injective

@[simp]
theorem trop_inj_iff (x y : R) : trop x = trop y ↔ x = y :=
  Iff.rfl
#align tropical.trop_inj_iff Tropical.trop_inj_iff

@[simp]
theorem untrop_inj_iff (x y : Tropical R) : untrop x = untrop y ↔ x = y :=
  Iff.rfl
#align tropical.untrop_inj_iff Tropical.untrop_inj_iff

@[simp]
theorem trop_untrop (x : Tropical R) : trop (untrop x) = x :=
  rfl
#align tropical.trop_untrop Tropical.trop_untrop

@[simp]

--Porting note: New attribute seems to fix things
attribute [irreducible] Tropical

theorem leftInverse_trop : Function.LeftInverse (trop : R → Tropical R) untrop :=
  trop_untrop
#align tropical.left_inverse_trop Tropical.leftInverse_trop

theorem rightInverse_trop : Function.RightInverse (trop : R → Tropical R) untrop :=
  untrop_trop
#align tropical.right_inverse_trop Tropical.rightInverse_trop

/-- Reinterpret `x : R` as an element of `Tropical R`.
See `Tropical.tropOrderIso` for the order-preserving equivalence. -/
def tropEquiv : R ≃ Tropical R where
  toFun := trop
  invFun := untrop
  left_inv := untrop_trop
  right_inv := trop_untrop
#align tropical.trop_equiv Tropical.tropEquiv

@[simp]
theorem tropEquiv_coe_fn : (tropEquiv : R → Tropical R) = trop :=
  rfl
#align tropical.trop_equiv_coe_fn Tropical.tropEquiv_coe_fn

@[simp]
theorem tropEquiv_symm_coe_fn : (tropEquiv.symm : Tropical R → R) = untrop :=
  rfl
#align tropical.trop_equiv_symm_coe_fn Tropical.tropEquiv_symm_coe_fn

theorem trop_eq_iff_eq_untrop {x : R} {y} : trop x = y ↔ x = untrop y :=
  tropEquiv.apply_eq_iff_eq_symm_apply
#align tropical.trop_eq_iff_eq_untrop Tropical.trop_eq_iff_eq_untrop

theorem untrop_eq_iff_eq_trop {x} {y : R} : untrop x = y ↔ x = trop y :=
  tropEquiv.symm.apply_eq_iff_eq_symm_apply
#align tropical.untrop_eq_iff_eq_trop Tropical.untrop_eq_iff_eq_trop

theorem injective_trop : Function.Injective (trop : R → Tropical R) :=
  tropEquiv.injective
#align tropical.injective_trop Tropical.injective_trop

theorem injective_untrop : Function.Injective (untrop : Tropical R → R) :=
  tropEquiv.symm.injective
#align tropical.injective_untrop Tropical.injective_untrop

theorem surjective_trop : Function.Surjective (trop : R → Tropical R) :=
  tropEquiv.surjective
#align tropical.surjective_trop Tropical.surjective_trop

theorem surjective_untrop : Function.Surjective (untrop : Tropical R → R) :=
  tropEquiv.symm.surjective
#align tropical.surjective_untrop Tropical.surjective_untrop

instance [Inhabited R] : Inhabited (Tropical R) :=
  ⟨trop default⟩

/-- Recursing on a `x' : Tropical R` is the same as recursing on an `x : R` reinterpreted
as a term of `Tropical R` via `trop x`. -/
@[simp]
def tropRec {F : Tropical R → Sort v} (h : ∀ X, F (trop X)) : ∀ X, F X := fun X => h (untrop X)
#align tropical.trop_rec Tropical.tropRec

instance [DecidableEq R] : DecidableEq (Tropical R) := fun _ _ =>
  decidable_of_iff _ injective_untrop.eq_iff

section Order

instance [LE R] : LE (Tropical R) where le x y := untrop x ≤ untrop y

@[simp]
theorem untrop_le_iff [LE R] {x y : Tropical R} : untrop x ≤ untrop y ↔ x ≤ y :=
  Iff.rfl
#align tropical.untrop_le_iff Tropical.untrop_le_iff

instance decidableLE [LE R] [DecidableRel ((· ≤ ·) : R → R → Prop)] :
    DecidableRel ((· ≤ ·) : Tropical R → Tropical R → Prop) := fun x y =>
  ‹DecidableRel (· ≤ ·)› (untrop x) (untrop y)
#align tropical.decidable_le Tropical.decidableLE

instance [LT R] : LT (Tropical R) where lt x y := untrop x < untrop y

@[simp]
theorem untrop_lt_iff [LT R] {x y : Tropical R} : untrop x < untrop y ↔ x < y :=
  Iff.rfl
#align tropical.untrop_lt_iff Tropical.untrop_lt_iff

instance decidableLT [LT R] [DecidableRel ((· < ·) : R → R → Prop)] :
    DecidableRel ((· < ·) : Tropical R → Tropical R → Prop) := fun x y =>
  ‹DecidableRel (· < ·)› (untrop x) (untrop y)
#align tropical.decidable_lt Tropical.decidableLT

instance [Preorder R] : Preorder (Tropical R) :=
  { instLETropical, instLTTropical with
    le_refl := fun x => le_refl (untrop x)
    le_trans := fun _ _ _ h h' => le_trans (α := R) h h'
    lt_iff_le_not_le := fun _ _ => lt_iff_le_not_le (α := R) }

/-- Reinterpret `x : R` as an element of `tropical R`, preserving the order. -/
def tropOrderIso [Preorder R] : R ≃o Tropical R :=
  { tropEquiv with map_rel_iff' := untrop_le_iff }
#align tropical.trop_order_iso Tropical.tropOrderIso

@[simp]
theorem tropOrderIso_coe_fn [Preorder R] : (tropOrderIso : R → Tropical R) = trop :=
  rfl
#align tropical.trop_order_iso_coe_fn Tropical.tropOrderIso_coe_fn

@[simp]
theorem tropOrderIso_symm_coe_fn [Preorder R] : (tropOrderIso.symm : Tropical R → R) = untrop :=
  rfl
#align tropical.trop_order_iso_symm_coe_fn Tropical.tropOrderIso_symm_coe_fn

theorem trop_monotone [Preorder R] : Monotone (trop : R → Tropical R) := fun _ _ => id
#align tropical.trop_monotone Tropical.trop_monotone

theorem untrop_monotone [Preorder R] : Monotone (untrop : Tropical R → R) := fun _ _ => id
#align tropical.untrop_monotone Tropical.untrop_monotone

instance [PartialOrder R] : PartialOrder (Tropical R) :=
  { instPreorderTropical with le_antisymm := fun _ _ h h' => untrop_injective (le_antisymm h h') }

instance [Top R] : Zero (Tropical R) :=
  ⟨trop ⊤⟩

instance [Top R] : Top (Tropical R) :=
  ⟨0⟩

@[simp]
theorem untrop_zero [Top R] : untrop (0 : Tropical R) = ⊤ :=
  rfl
#align tropical.untrop_zero Tropical.untrop_zero

@[simp]
theorem trop_top [Top R] : trop (⊤ : R) = 0 :=
  rfl
#align tropical.trop_top Tropical.trop_top

@[simp]
theorem trop_coe_ne_zero (x : R) : trop (x : WithTop R) ≠ 0 :=
  fun.
#align tropical.trop_coe_ne_zero Tropical.trop_coe_ne_zero

@[simp]
theorem zero_ne_trop_coe (x : R) : (0 : Tropical (WithTop R)) ≠ trop x :=
  fun.
#align tropical.zero_ne_trop_coe Tropical.zero_ne_trop_coe

@[simp]
theorem le_zero [LE R] [OrderTop R] (x : Tropical R) : x ≤ 0 :=
  le_top (α := R)
#align tropical.le_zero Tropical.le_zero

instance [LE R] [OrderTop R] : OrderTop (Tropical R) :=
  { instTopTropical with le_top := fun _ => le_top (α := R) }

variable [LinearOrder R]

/-- Tropical addition is the minimum of two underlying elements of `R`. -/
instance : Add (Tropical R) :=
  ⟨fun x y => trop (min (untrop x) (untrop y))⟩

instance : AddCommSemigroup (Tropical R) where
  add := (· + ·)
  add_assoc _ _ _ := untrop_injective (min_assoc _ _ _)
  add_comm _ _ := untrop_injective (min_comm _ _)

@[simp]
theorem untrop_add (x y : Tropical R) : untrop (x + y) = min (untrop x) (untrop y) :=
  rfl
#align tropical.untrop_add Tropical.untrop_add

@[simp]
theorem trop_min (x y : R) : trop (min x y) = trop x + trop y :=
  rfl
#align tropical.trop_min Tropical.trop_min

@[simp]
theorem trop_inf (x y : R) : trop (x ⊓ y) = trop x + trop y :=
  rfl
#align tropical.trop_inf Tropical.trop_inf

theorem trop_add_def (x y : Tropical R) : x + y = trop (min (untrop x) (untrop y)) :=
  rfl
#align tropical.trop_add_def Tropical.trop_add_def

instance : LinearOrder (Tropical R) :=
  { instPartialOrderTropical with
    le_total := fun a b => le_total (untrop a) (untrop b)
    decidable_le := Tropical.decidableLE
    max := fun a b => trop (max (untrop a) (untrop b))
    max_def := fun a b => untrop_injective (by simp [max_def]; split_ifs <;> simp)
    min := (· + ·)
    min_def := fun a b => untrop_injective (by simp [min_def]; split_ifs <;> simp) }

@[simp]
theorem untrop_sup (x y : Tropical R) : untrop (x ⊔ y) = untrop x ⊔ untrop y :=
  rfl
#align tropical.untrop_sup Tropical.untrop_sup

@[simp]
theorem untrop_max (x y : Tropical R) : untrop (max x y) = max (untrop x) (untrop y) :=
  rfl
#align tropical.untrop_max Tropical.untrop_max

@[simp]
theorem min_eq_add : (min : Tropical R → Tropical R → Tropical R) = (· + ·) :=
  rfl
#align tropical.min_eq_add Tropical.min_eq_add

@[simp]
theorem inf_eq_add : ((· ⊓ ·) : Tropical R → Tropical R → Tropical R) = (· + ·) :=
  rfl
#align tropical.inf_eq_add Tropical.inf_eq_add

theorem trop_max_def (x y : Tropical R) : max x y = trop (max (untrop x) (untrop y)) :=
  rfl
#align tropical.trop_max_def Tropical.trop_max_def

theorem trop_sup_def (x y : Tropical R) : x ⊔ y = trop (untrop x ⊔ untrop y) :=
  rfl
#align tropical.trop_sup_def Tropical.trop_sup_def

@[simp]
theorem add_eq_left ⦃x y : Tropical R⦄ (h : x ≤ y) : x + y = x :=
  untrop_injective (by simpa using h)
#align tropical.add_eq_left Tropical.add_eq_left

@[simp]
theorem add_eq_right ⦃x y : Tropical R⦄ (h : y ≤ x) : x + y = y :=
  untrop_injective (by simpa using h)
#align tropical.add_eq_right Tropical.add_eq_right

theorem add_eq_left_iff {x y : Tropical R} : x + y = x ↔ x ≤ y := by
  rw [trop_add_def, trop_eq_iff_eq_untrop, ← untrop_le_iff, min_eq_left_iff]
#align tropical.add_eq_left_iff Tropical.add_eq_left_iff

theorem add_eq_right_iff {x y : Tropical R} : x + y = y ↔ y ≤ x := by
  rw [trop_add_def, trop_eq_iff_eq_untrop, ← untrop_le_iff, min_eq_right_iff]
#align tropical.add_eq_right_iff Tropical.add_eq_right_iff

--Porting note: removing `simp`. `simp` can prove it
theorem add_self (x : Tropical R) : x + x = x :=
  untrop_injective (min_eq_right le_rfl)
#align tropical.add_self Tropical.add_self

set_option linter.deprecated false in
@[simp]
theorem bit0 (x : Tropical R) : bit0 x = x :=
  add_self x
#align tropical.bit0 Tropical.bit0

theorem add_eq_iff {x y z : Tropical R} : x + y = z ↔ x = z ∧ x ≤ y ∨ y = z ∧ y ≤ x := by
  rw [trop_add_def, trop_eq_iff_eq_untrop]
  simp [min_eq_iff]
#align tropical.add_eq_iff Tropical.add_eq_iff

@[simp]
theorem add_eq_zero_iff {a b : Tropical (WithTop R)} : a + b = 0 ↔ a = 0 ∧ b = 0 := by
  rw [add_eq_iff]
  constructor
  · rintro (⟨rfl, h⟩ | ⟨rfl, h⟩)
    · exact ⟨rfl, le_antisymm (le_zero _) h⟩
    · exact ⟨le_antisymm (le_zero _) h, rfl⟩
  · rintro ⟨rfl, rfl⟩
    simp
#align tropical.add_eq_zero_iff Tropical.add_eq_zero_iff

instance [OrderTop R] : AddCommMonoid (Tropical R) :=
  { instZeroTropical, instAddCommSemigroupTropical with
    zero_add := fun _ => untrop_injective (min_top_left _)
    add_zero := fun _ => untrop_injective (min_top_right _) }

end Order

section Monoid

/-- Tropical multiplication is the addition in the underlying `R`. -/
instance [Add R] : Mul (Tropical R) :=
  ⟨fun x y => trop (untrop x + untrop y)⟩

@[simp]
theorem trop_add [Add R] (x y : R) : trop (x + y) = trop x * trop y :=
  rfl
#align tropical.trop_add Tropical.trop_add

@[simp]
theorem untrop_mul [Add R] (x y : Tropical R) : untrop (x * y) = untrop x + untrop y :=
  rfl
#align tropical.untrop_mul Tropical.untrop_mul

theorem trop_mul_def [Add R] (x y : Tropical R) : x * y = trop (untrop x + untrop y) :=
  rfl
#align tropical.trop_mul_def Tropical.trop_mul_def

instance [Zero R] : One (Tropical R) :=
  ⟨trop 0⟩

@[simp]
theorem trop_zero [Zero R] : trop (0 : R) = 1 :=
  rfl
#align tropical.trop_zero Tropical.trop_zero

@[simp]
theorem untrop_one [Zero R] : untrop (1 : Tropical R) = 0 :=
  rfl
#align tropical.untrop_one Tropical.untrop_one

instance [LinearOrder R] [OrderTop R] [Zero R] : AddMonoidWithOne (Tropical R) :=
  { instOneTropical, instAddCommMonoidTropical with
    natCast := fun n => if n = 0 then 0 else 1
    natCast_zero := rfl
    natCast_succ := fun n => (untrop_inj_iff _ _).1 (by cases n <;> simp [Nat.cast]) }

instance [Zero R] : Nontrivial (Tropical (WithTop R)) :=
  ⟨⟨0, 1, trop_injective.ne WithTop.top_ne_coe⟩⟩

instance [Neg R] : Inv (Tropical R) :=
  ⟨fun x => trop (-untrop x)⟩

@[simp]
theorem untrop_inv [Neg R] (x : Tropical R) : untrop x⁻¹ = -untrop x :=
  rfl
#align tropical.untrop_inv Tropical.untrop_inv

instance [Sub R] : Div (Tropical R) :=
  ⟨fun x y => trop (untrop x - untrop y)⟩

@[simp]
theorem untrop_div [Sub R] (x y : Tropical R) : untrop (x / y) = untrop x - untrop y :=
  rfl
#align tropical.untrop_div Tropical.untrop_div

instance [AddSemigroup R] : Semigroup (Tropical R) where
  mul := (· * ·)
  mul_assoc _ _ _ := untrop_injective (add_assoc _ _ _)

instance [AddCommSemigroup R] : CommSemigroup (Tropical R) :=
  { instSemigroupTropical with mul_comm := fun _ _ => untrop_injective (add_comm _ _) }

instance {α : Type _} [SMul α R] : Pow (Tropical R) α where pow x n := trop <| n • untrop x

@[simp]
theorem untrop_pow {α : Type _} [SMul α R] (x : Tropical R) (n : α) :
    untrop (x ^ n) = n • untrop x :=
  rfl
#align tropical.untrop_pow Tropical.untrop_pow

@[simp]
theorem trop_smul {α : Type _} [SMul α R] (x : R) (n : α) : trop (n • x) = trop x ^ n :=
  rfl
#align tropical.trop_smul Tropical.trop_smul

instance [AddZeroClass R] : MulOneClass (Tropical R) where
  one := 1
  mul := (· * ·)
  one_mul _ := untrop_injective <| zero_add _
  mul_one _ := untrop_injective <| add_zero _

instance [AddMonoid R] : Monoid (Tropical R) :=
  { instMulOneClassTropical, instSemigroupTropical with
    npow := fun n x => x ^ n
    npow_zero := fun _ => untrop_injective <| by simp
    npow_succ := fun _ _ => untrop_injective <| succ_nsmul _ _ }

@[simp]
theorem trop_nsmul [AddMonoid R] (x : R) (n : ℕ) : trop (n • x) = trop x ^ n :=
  rfl
#align tropical.trop_nsmul Tropical.trop_nsmul

instance [AddCommMonoid R] : CommMonoid (Tropical R) :=
  { instMonoidTropical, instCommSemigroupTropical with }

instance [AddGroup R] : Group (Tropical R) :=
  { instMonoidTropical with
    inv := Inv.inv
    div_eq_mul_inv := fun _ _ => untrop_injective <| by simp [sub_eq_add_neg]
    mul_left_inv := fun _ => untrop_injective <| add_left_neg _
    zpow := fun n x => trop <| n • untrop x
    zpow_zero' := fun _ => untrop_injective <| zero_zsmul _
    zpow_succ' := fun _ _ => untrop_injective <| SubNegMonoid.zsmul_succ' _ _
    zpow_neg' := fun _ _ => untrop_injective <| SubNegMonoid.zsmul_neg' _ _ }

instance [AddCommGroup R] : CommGroup (Tropical R) :=
  { instGroupTropical with mul_comm := fun _ _ => untrop_injective (add_comm _ _) }

@[simp]
theorem untrop_zpow [AddGroup R] (x : Tropical R) (n : ℤ) : untrop (x ^ n) = n • untrop x :=
  rfl
#align tropical.untrop_zpow Tropical.untrop_zpow

@[simp]
theorem trop_zsmul [AddGroup R] (x : R) (n : ℤ) : trop (n • x) = trop x ^ n :=
  rfl
#align tropical.trop_zsmul Tropical.trop_zsmul

end Monoid

section Distrib

instance covariant_mul [LE R] [Add R] [CovariantClass R R (· + ·) (· ≤ ·)] :
    CovariantClass (Tropical R) (Tropical R) (· * ·) (· ≤ ·) :=
  ⟨fun _ y z h => add_le_add_left (show untrop y ≤ untrop z from h) _⟩
#align tropical.covariant_mul Tropical.covariant_mul

instance covariant_swap_mul [LE R] [Add R] [CovariantClass R R (Function.swap (· + ·)) (· ≤ ·)] :
    CovariantClass (Tropical R) (Tropical R) (Function.swap (· * ·)) (· ≤ ·) :=
  ⟨fun _ y z h => add_le_add_right (show untrop y ≤ untrop z from h) _⟩
#align tropical.covariant_swap_mul Tropical.covariant_swap_mul

instance covariant_add [LinearOrder R] : CovariantClass (Tropical R) (Tropical R) (· + ·) (· ≤ ·) :=
  ⟨fun x y z h => by
    cases' le_total x y with hx hy
    · rw [add_eq_left hx, add_eq_left (hx.trans h)]
    · rw [add_eq_right hy]
      cases' le_total x z with hx hx
      · rwa [add_eq_left hx]
      · rwa [add_eq_right hx]⟩
#align tropical.covariant_add Tropical.covariant_add

instance covariant_mul_lt [LT R] [Add R] [CovariantClass R R (· + ·) (· < ·)] :
    CovariantClass (Tropical R) (Tropical R) (· * ·) (· < ·) :=
  ⟨fun _ _ _ h => add_lt_add_left (untrop_lt_iff.2 h) _⟩
#align tropical.covariant_mul_lt Tropical.covariant_mul_lt

instance covariant_swap_mul_lt [Preorder R] [Add R]
    [CovariantClass R R (Function.swap (· + ·)) (· < ·)] :
    CovariantClass (Tropical R) (Tropical R) (Function.swap (· * ·)) (· < ·) :=
  ⟨fun _ y z h => add_lt_add_right (show untrop y < untrop z from h) _⟩
#align tropical.covariant_swap_mul_lt Tropical.covariant_swap_mul_lt

instance [LinearOrder R] [Add R] [CovariantClass R R (· + ·) (· ≤ ·)]
    [CovariantClass R R (Function.swap (· + ·)) (· ≤ ·)] :
    Distrib (Tropical R) where
  mul := (· * ·)
  add := (· + ·)
  left_distrib _ _ _ := untrop_injective (min_add_add_left _ _ _).symm
  right_distrib _ _ _ := untrop_injective (min_add_add_right _ _ _).symm

@[simp]
theorem add_pow [LinearOrder R] [AddMonoid R] [CovariantClass R R (· + ·) (· ≤ ·)]
    [CovariantClass R R (Function.swap (· + ·)) (· ≤ ·)] (x y : Tropical R) (n : ℕ) :
    (x + y) ^ n = x ^ n + y ^ n := by
  cases' le_total x y with h h
  · rw [add_eq_left h, add_eq_left (pow_le_pow_of_le_left' h _)]
  · rw [add_eq_right h, add_eq_right (pow_le_pow_of_le_left' h _)]
#align tropical.add_pow Tropical.add_pow

end Distrib

section Semiring

variable [LinearOrderedAddCommMonoidWithTop R]

instance : CommSemiring (Tropical R) :=
  { instAddMonoidWithOneTropical,
    instDistribTropical,
    instAddCommMonoidTropical,
    instCommMonoidTropical with
    zero_mul := fun _ => untrop_injective (by simp [top_add])
    mul_zero := fun _ => untrop_injective (by simp [add_top]) }

@[simp]
theorem succ_nsmul {R} [LinearOrder R] [OrderTop R] (x : Tropical R) (n : ℕ) : (n + 1) • x = x := by
  induction' n with n IH
  · simp
  · rw [add_nsmul, IH, one_nsmul, add_self]
#align tropical.succ_nsmul Tropical.succ_nsmul

-- TODO: find/create the right classes to make this hold (for enat, ennreal, etc)
-- Requires `zero_eq_bot` to be true
-- lemma add_eq_zero_iff {a b : tropical R} :
--   a + b = 1 ↔ a = 1 ∨ b = 1 := sorry
--Porting note: removing @[simp], `simp` can prove it
theorem mul_eq_zero_iff {R : Type _} [LinearOrderedAddCommMonoid R] {a b : Tropical (WithTop R)} :
    a * b = 0 ↔ a = 0 ∨ b = 0 := by simp [← untrop_inj_iff, WithTop.add_eq_top]
#align tropical.mul_eq_zero_iff Tropical.mul_eq_zero_iff

instance {R : Type _} [LinearOrderedAddCommMonoid R] : NoZeroDivisors (Tropical (WithTop R)) :=
  ⟨mul_eq_zero_iff.mp⟩

end Semiring

end Tropical


import Lean
import Init.Data.Nat
import Init.Data.String
import Init.Data.Fin

namespace CoC open CoC

set_option pp.proofs true
set_option linter.unusedVariables false

abbrev Name := String
abbrev Level := Nat
notation " let " x " := " a " in " e => let x := a ; e
infix : 50 " ⊔ " => Nat.max

inductive Term : Type where
  | type (l : Level)
  | var (x : Name)
  | app (f: Term) (a: Term)
  | pi (v : Name) (vty : Term) (pty : Term)
  | lam (v : Name) (vty : Term) (e : Term)

open Term
notation "(" a " : " A ")'" " -> " e => pi a A e
notation "λ' " a " : " A " => " e => lam a A e

open Lean

#reduce (λ x : Nat => (λ (y : Nat) (x : Bool) => y) x)

def freev : Term -> Name -> Bool
  | type _ , _ => false
  | var x , n => x == n
  | app f a , n => freev f n || freev a n
  | pi x t e , n => freev t n || (x != n && freev e n)
  | lam x t e , n => freev t n || (x != n && freev e n)

notation e "[" a "]ₜ?" => freev e a

def boundv (t : Term)(n : Name) : Bool :=
  match t with
  | (a : A)' -> B => a == n || boundv A n || boundv B n
  | λ' a : A => B => a == n || boundv A n || boundv B n
  | app f a => boundv f n || boundv a n
  | _ => false

notation e "[" a "]'?"  => boundv e a

theorem bool_or_efalse : (a || b) = false -> a = false /\ b = false := by
  intro p
  cases a ; all_goals cases b
  constructor; rfl; rfl
  all_goals simp at p

theorem boundv_th₁ : ((a : A)' -> B)[n]'? = false -> A[n]'? = false /\ B[n]'? = false := by
  intro p
  unfold boundv at p
  have f := bool_or_efalse p ; cases f ; case intro z x => {
  have g := bool_or_efalse z ;
  cases g ;
  case intro z y => {
    apply And.intro ;
    exact y ;
    exact x
  }
  }

-- #print boundv_th₁

theorem boundv_th₂ : (lam a A B)[n]'? = false -> A[n]'? = false /\ B[n]'? = false := by
  intro p
  unfold boundv at p
  have f := bool_or_efalse p ; cases f ; case intro z x => {
  have g := bool_or_efalse z ;
  cases g ;
  case intro z y => {
    apply And.intro ;
    exact y ;
    exact x
  }
  }

theorem boundv_th₃ : (app f a)[n]'? = false -> f[n]'? = false /\ a[n]'? = false := by
  intro p
  unfold boundv at p
  exact bool_or_efalse p

def substn (t : Term)(n m : Name){p : boundv t m = false} :=
  match t with
  | type _ => t
  | var x => bif x == n then var m else t
  | app f a => app (@substn f n m (boundv_th₃ p).1) (@substn a n m (boundv_th₃ p).2)
  | pi a A B => pi a (@substn A n m (boundv_th₁ p).1) (bif a == n then B else @substn B n m (boundv_th₁ p).2)
  | lam a A B => lam a (@substn A n m (boundv_th₁ p).1) (bif a == n then B else @substn B n m (boundv_th₁ p).2)

def depth : Term -> Nat -- rec depth
  | type _ => 0
  | var _ => 0
  | app f a => (depth f ⊔ depth a) + 1
  | pi _ A e => (depth A ⊔ depth e) + 1
  | lam _ A e => (depth A ⊔ depth e) + 1

def deplt : Term -> Term -> Prop := InvImage Nat.lt depth

def depacc : Acc deplt t := InvImage.accessible depth (Nat.lt_wfRel.wf.apply (depth t))

def depwf : WellFounded deplt := ⟨ @depacc ⟩

def dep_wfRel : WellFoundedRelation Term where
  rel := deplt
  wf  := depwf

def depsn {p} : depth (@substn t n m p) = depth t := by
  cases t
  any_goals (unfold depth ; unfold substn ; simp)
  case var x => (
    generalize h : (x == n) = a
    cases a
    all_goals simp
  )
  case app f a => (
    have g₁ := depsn (t := f) (n := n) (m := m) (p := (boundv_th₃ p).1)
    have g₂ := depsn (t := a) (n := n) (m := m) (p := (boundv_th₃ p).2)
    rw [g₁ , g₂]
  )
  case pi a A e => (
    have g₁ := depsn (t := A) (n := n) (m := m) (p := (boundv_th₁ p).1)
    rw [g₁]
    generalize h : (a == n) = b
    cases b
    case true => simp
    case false => (
      simp
      have g₁ := depsn (t := e) (n := n) (m := m) (p := (boundv_th₁ p).2)
      rw [g₁]
    )
  )
  case lam a A e => (
    have g₁ := depsn (t := A) (n := n) (m := m) (p := (boundv_th₁ p).1)
    rw [g₁]
    generalize h : (a == n) = b
    cases b
    case true => simp
    case false => (
      simp
      have g₁ := depsn (t := e) (n := n) (m := m) (p := (boundv_th₁ p).2)
      rw [g₁]
    )
  )

notation t "[" n " => " m "]'" => substn t n m

-- #eval (pi "c" (type 1) (var "b"))["b" => "c"]'
#reduce (("c" : type 1)' -> var "b")["c"]'?

def freshb (e : Term) : Name :=
  match e with
  | type _ => "x"
  | var _ => "x"
  | app f a => freshb f ++ freshb a
  | pi a A e => a ++ freshb A ++ freshb e
  | lam a A e => a ++ freshb A ++ freshb e

theorem freshb_th₁ : t[freshb t]'? = false := by
  cases t
--  any_goals
  case type _ => rfl
  case var _ => rfl
  case app f a => sorry
  admit
  admit

def freshst (m e : Term) : Name := by sorry

theorem freshst_th₁ : m[freshst m e]ₜ? = false := by sorry

theorem freshst_th₂ : e[freshst m e]'? = false := by sorry

theorem maxlt : a < ((a ⊔ b) + 1) := by sorry

theorem deplt_th₁₁ : deplt f (app f a) := by sorry

theorem deplt_th₁₂ : deplt a (app f a) := by sorry

theorem deplt_th₂₁ : deplt A (pi a A e) := by sorry

theorem deplt_th₂₂ : deplt (@substn e a z p) ((a : A)' -> e) := by sorry

theorem deplt_th₂₃ :   deplt e ((a : A)' -> e) := by sorry

theorem deplt_th₃₁ : deplt A (lam a A e) := by sorry

theorem deplt_th₃₂ : deplt (@substn e a z p) (lam a A e) := by sorry

theorem deplt_th₃₃ :   deplt e (lam a A e) := by sorry

-- set_option pp.instances false

def subst (t : Term)(n : Name)(m : Term) : Term :=
  match t with
  | type _ => t
  | var x => bif x == n then m else t
  | app f a => app (subst f n m) (subst a n m)
  | pi a A e => bif a == n then pi a (subst A n m) e
    else bif e[n]ₜ? && m[a]ₜ?
      then let z := freshst m e
        in pi z (subst A n m) (subst (@substn e a z freshst_th₂) n m)
      else pi a (subst A n m) (subst e n m)
  | lam a A e => bif a == n then lam a (subst A n m) e
    else bif e[n]ₜ? && m[a]ₜ?
      then let z := freshst m e
        in lam z (subst A n m) (subst (@substn e a z freshst_th₂) n m)
      else lam a (subst A n m) (subst e n m)
termination_by subst t _ _ => depth t
decreasing_by {
  try apply deplt_th₁₁
  try apply deplt_th₁₂
  try apply deplt_th₂₂
}
notation e "[" a " => " m "]" => subst e a m

theorem subst_def : t[n => m] = match t with
  | type _ => t
  | var x => bif x == n then m else t
  | app f a => app (subst f n m) (subst a n m)
  | pi a A e => bif a == n then pi a (subst A n m) e
    else bif e[n]ₜ? && m[a]ₜ?
      then let z := freshst m e
        in pi z (subst A n m) (subst (@substn e a z freshst_th₂) n m)
      else pi a (subst A n m) (subst e n m)
  | lam a A e => bif a == n then lam a (subst A n m) e
    else bif e[n]ₜ? && m[a]ₜ?
      then let z := freshst m e
        in lam z (subst A n m) (subst (@substn e a z freshst_th₂) n m)
      else lam a (subst A n m) (subst e n m)
  := by
  cases t
  case type => simp ; rfl
  case var => simp ; rfl
  case app => simp ; rfl
  case pi => simp ; rfl
  case lam => simp ; rfl

theorem subst_th₁ : (type l)[n => m] = type l := rfl
theorem subst_th₂ : (var x)[n => m] = bif x == n then m else var x := rfl
theorem subst_th₃ : (app f a)[n => m] = app (f[n => m]) (a[n => m]) := rfl
theorem subst_th₄ : (pi a A e)[a => m] = pi a (A[a => m]) e := by
  rw [subst_def]
  simp

-- #print subst #print subst._unary

def redcbl : Term -> Bool
  | app (lam _ _ _) _ => true
  | app t@(app _ _) _ => redcbl t
  | _ => false

def betan1 : Term -> Term
  | app (lam x t e) a => e[x => a]
  | app (app f b) a => app (betan1 (app f b)) a
  | t => t

set_option quotPrecheck false

notation a " ▹ " b => (betan1 a = b)

theorem beta_th₀ : (app (lam a A e) x) ▹ e[a => x] := by
  simp [betan1]

instance funpow : Pow (α -> α) Nat :=
⟨
  fun f => let rec ch (n : Nat) : α -> α :=
    match n with
    | 0  => id
    | i+1 => f ∘ (ch i)
  ch
⟩

def funpow_add {f : A -> A}{m n : Nat} : (f ^ (m + n)) x = ((f ^ n) ((f ^ m) x)):= by
  induction n ; any_goals simp [HPow.hPow, Pow.pow, funpow.ch] at *
  case succ a p => rw [p]

def Betaeq (t₁ : Term)(t₂ : Term) : Type :=
  (m n : Nat) ×' ((betan1 ^ m) t₁) = ((betan1 ^ n) t₂)

notation t₁ " =ᵦ " t₂ => Betaeq t₁ t₂

notation a " :' " A => Prod.mk (α := Name) (β := Term) a A
notation : 67 xs ",, " x => List.cons x xs

--
def ntin (n : Name) : List (Name × Term) -> Bool
  | [] => true
  | (x , _) :: xs => n != x && ntin n xs

def TTrip := (List (Name × Term)) × Term × Term

inductive Typing : TTrip -> Type :=
  | rweak  : Typing (Γ, e, T)
          -> Typing (Γ, A, (type l))
          -> {_ : ntin a Γ = true}
          -> Typing (Γ,, a :' A, e, T)

  | rtype  : Typing ([], type l, type (l+1))

  | rvar   : Typing (Γ, A, type l)
          -> {_ : ntin a Γ}
          -> Typing (Γ,, a :' A, var a, A)

  | rapp   : Typing (Γ, f, (x : A)' -> B)
          -> Typing (Γ, a, A)
          -> Typing (Γ, app f a, B[x => a])

  | rpi  : Typing (Γ, A, type l₁)
          -> Typing (Γ,, a :' A, B, type l₂)
          -> Typing (Γ, pi a A B, type (l₁ ⊔ l₂))

  | rlam   : Typing (Γ,, a :' A, b, B)
          -> Typing (Γ, pi a A B, type l)
          -> Typing (Γ, lam a A b, pi a A B)

  | rcnv   : Typing (Γ, a, A)
          -> Typing (Γ, B, type l)
          -> {p : A =ᵦ B}
          -> Typing (Γ, a, B)

open Typing
notation Γ " ⊢ " e " : " T => Typing (Γ, e, T)
-- 后面不能有"(...)"才能print
#print Term
#print Typing

inductive Vect (A : Type ℓ) : Nat -> Type _
  | nil : Vect A 0
  | cons (x : A)(xs : Vect A n) : Vect A (n + 1)

def Targs (n : Nat)(A : Type)(T : Type ℓ) : Type _ :=
  match n with
  | 0 => T
  | n + 1 => A -> Targs n A T

def Dargs (n : Nat)(A : Type)(T : Targs n A (Type ℓ)) : Type (_) :=
  match n with
  | 0 => T
  | m+1 => (a : A) -> (Dargs m A (T a))

variable (A : Type)(T : Targs 4 A Type) in
#reduce Dargs 4 A T

structure ElabD :=
  ncgoal : Nat
  cgoals : Vect (Σ(n : Nat)(_ : Vect (Fin n) n), (Targs n Term TTrip)) ncgoal
  fngoal : Targs ncgoal Term TTrip
-- List.rec (Typing fngoal) (λ x xs tx => Typing x -> tx) cgoals

def Tcterm : ElabD -> Type _
  | ⟨ 0, Vect.nil, Tt⟩  => Typing Tt
  | ⟨ m+1, Vect.cons x xs, fg⟩  =>
  (h0 : Term) -> Typing (x h0)

structure ElabST (dt : ElabD) :=
  cterm : Tcterm dt

abbrev ElabM := StateT ElabST Option #reduce ElabM

def tintro (n : Name) : ElabM Unit := do
  let st <- get
  match st with
  | ElabST.mk fgs cgl ctm => match cgl[0]? with
  | none => failure
  | some ⟨ ctx , tm , ty ⟩ => _

#exit
  | none => pure
  | some (ElabST.mk fgs cgl ctm) => {}


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

! This file was ported from Lean 3 source module data.list.prime
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Associated
import Mathbin.Data.List.BigOperators.Lemmas
import Mathbin.Data.List.Perm

/-!
# Products of lists of prime elements.

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

This file contains some theorems relating `prime` and products of `list`s.

-/

open List

section CommMonoidWithZero

variable {M : Type _} [CommMonoidWithZero M]

/- warning: prime.dvd_prod_iff -> Prime.dvd_prod_iff is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : CommMonoidWithZero.{u1} M] {p : M} {L : List.{u1} M}, (Prime.{u1} M _inst_1 p) -> (Iff (Dvd.Dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) p (List.prod.{u1} M (MulZeroClass.toHasMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) (MulOneClass.toHasOne.{u1} M (MulZeroOneClass.toMulOneClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) L)) (Exists.{succ u1} M (fun (a : M) => Exists.{0} (Membership.Mem.{u1, u1} M (List.{u1} M) (List.hasMem.{u1} M) a L) (fun (H : Membership.Mem.{u1, u1} M (List.{u1} M) (List.hasMem.{u1} M) a L) => Dvd.Dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) p a))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : CommMonoidWithZero.{u1} M] {p : M} {L : List.{u1} M}, (Prime.{u1} M _inst_1 p) -> (Iff (Dvd.dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) p (List.prod.{u1} M (MulZeroClass.toMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) (Monoid.toOne.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1))) L)) (Exists.{succ u1} M (fun (a : M) => And (Membership.mem.{u1, u1} M (List.{u1} M) (List.instMembershipList.{u1} M) a L) (Dvd.dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) p a))))
Case conversion may be inaccurate. Consider using '#align prime.dvd_prod_iff Prime.dvd_prod_iffₓ'. -/
/-- Prime `p` divides the product of a list `L` iff it divides some `a ∈ L` -/
theorem Prime.dvd_prod_iff {p : M} {L : List M} (pp : Prime p) : p ∣ L.Prod ↔ ∃ a ∈ L, p ∣ a :=
  by
  constructor
  · intro h
    induction' L with L_hd L_tl L_ih
    · rw [prod_nil] at h
      exact absurd h pp.not_dvd_one
    · rw [prod_cons] at h
      cases' pp.dvd_or_dvd h with hd hd
      · exact ⟨L_hd, mem_cons_self L_hd L_tl, hd⟩
      · obtain ⟨x, hx1, hx2⟩ := L_ih hd
        exact ⟨x, mem_cons_of_mem L_hd hx1, hx2⟩
  · exact fun ⟨a, ha1, ha2⟩ => dvd_trans ha2 (dvd_prod ha1)
#align prime.dvd_prod_iff Prime.dvd_prod_iff

/- warning: prime.not_dvd_prod -> Prime.not_dvd_prod is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : CommMonoidWithZero.{u1} M] {p : M} {L : List.{u1} M}, (Prime.{u1} M _inst_1 p) -> (forall (a : M), (Membership.Mem.{u1, u1} M (List.{u1} M) (List.hasMem.{u1} M) a L) -> (Not (Dvd.Dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) p a))) -> (Not (Dvd.Dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) p (List.prod.{u1} M (MulZeroClass.toHasMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) (MulOneClass.toHasOne.{u1} M (MulZeroOneClass.toMulOneClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) L)))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : CommMonoidWithZero.{u1} M] {p : M} {L : List.{u1} M}, (Prime.{u1} M _inst_1 p) -> (forall (a : M), (Membership.mem.{u1, u1} M (List.{u1} M) (List.instMembershipList.{u1} M) a L) -> (Not (Dvd.dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) p a))) -> (Not (Dvd.dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) p (List.prod.{u1} M (MulZeroClass.toMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1)))) (Monoid.toOne.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M _inst_1))) L)))
Case conversion may be inaccurate. Consider using '#align prime.not_dvd_prod Prime.not_dvd_prodₓ'. -/
theorem Prime.not_dvd_prod {p : M} {L : List M} (pp : Prime p) (hL : ∀ a ∈ L, ¬p ∣ a) :
    ¬p ∣ L.Prod :=
  mt (Prime.dvd_prod_iff pp).mp <| not_bex.mpr hL
#align prime.not_dvd_prod Prime.not_dvd_prod

end CommMonoidWithZero

section CancelCommMonoidWithZero

variable {M : Type _} [CancelCommMonoidWithZero M] [Unique (Units M)]

/- warning: mem_list_primes_of_dvd_prod -> mem_list_primes_of_dvd_prod is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} M] [_inst_2 : Unique.{succ u1} (Units.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))] {p : M}, (Prime.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1) p) -> (forall {L : List.{u1} M}, (forall (q : M), (Membership.Mem.{u1, u1} M (List.{u1} M) (List.hasMem.{u1} M) q L) -> (Prime.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1) q)) -> (Dvd.Dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) p (List.prod.{u1} M (MulZeroClass.toHasMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) (MulOneClass.toHasOne.{u1} M (MulZeroOneClass.toMulOneClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) L)) -> (Membership.Mem.{u1, u1} M (List.{u1} M) (List.hasMem.{u1} M) p L))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} M] [_inst_2 : Unique.{succ u1} (Units.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))] {p : M}, (Prime.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1) p) -> (forall {L : List.{u1} M}, (forall (q : M), (Membership.mem.{u1, u1} M (List.{u1} M) (List.instMembershipList.{u1} M) q L) -> (Prime.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1) q)) -> (Dvd.dvd.{u1} M (semigroupDvd.{u1} M (SemigroupWithZero.toSemigroup.{u1} M (MonoidWithZero.toSemigroupWithZero.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) p (List.prod.{u1} M (MulZeroClass.toMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) (Monoid.toOne.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1)))) L)) -> (Membership.mem.{u1, u1} M (List.{u1} M) (List.instMembershipList.{u1} M) p L))
Case conversion may be inaccurate. Consider using '#align mem_list_primes_of_dvd_prod mem_list_primes_of_dvd_prodₓ'. -/
theorem mem_list_primes_of_dvd_prod {p : M} (hp : Prime p) {L : List M} (hL : ∀ q ∈ L, Prime q)
    (hpL : p ∣ L.Prod) : p ∈ L :=
  by
  obtain ⟨x, hx1, hx2⟩ := hp.dvd_prod_iff.mp hpL
  rwa [(prime_dvd_prime_iff_eq hp (hL x hx1)).mp hx2]
#align mem_list_primes_of_dvd_prod mem_list_primes_of_dvd_prod

/- warning: perm_of_prod_eq_prod -> perm_of_prod_eq_prod is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} M] [_inst_2 : Unique.{succ u1} (Units.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))] {l₁ : List.{u1} M} {l₂ : List.{u1} M}, (Eq.{succ u1} M (List.prod.{u1} M (MulZeroClass.toHasMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) (MulOneClass.toHasOne.{u1} M (MulZeroOneClass.toMulOneClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) l₁) (List.prod.{u1} M (MulZeroClass.toHasMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) (MulOneClass.toHasOne.{u1} M (MulZeroOneClass.toMulOneClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) l₂)) -> (forall (p : M), (Membership.Mem.{u1, u1} M (List.{u1} M) (List.hasMem.{u1} M) p l₁) -> (Prime.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1) p)) -> (forall (p : M), (Membership.Mem.{u1, u1} M (List.{u1} M) (List.hasMem.{u1} M) p l₂) -> (Prime.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1) p)) -> (List.Perm.{u1} M l₁ l₂)
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} M] [_inst_2 : Unique.{succ u1} (Units.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))] {l₁ : List.{u1} M} {l₂ : List.{u1} M}, (Eq.{succ u1} M (List.prod.{u1} M (MulZeroClass.toMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) (Monoid.toOne.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1)))) l₁) (List.prod.{u1} M (MulZeroClass.toMul.{u1} M (MulZeroOneClass.toMulZeroClass.{u1} M (MonoidWithZero.toMulZeroOneClass.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1))))) (Monoid.toOne.{u1} M (MonoidWithZero.toMonoid.{u1} M (CommMonoidWithZero.toMonoidWithZero.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1)))) l₂)) -> (forall (p : M), (Membership.mem.{u1, u1} M (List.{u1} M) (List.instMembershipList.{u1} M) p l₁) -> (Prime.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1) p)) -> (forall (p : M), (Membership.mem.{u1, u1} M (List.{u1} M) (List.instMembershipList.{u1} M) p l₂) -> (Prime.{u1} M (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} M _inst_1) p)) -> (List.Perm.{u1} M l₁ l₂)
Case conversion may be inaccurate. Consider using '#align perm_of_prod_eq_prod perm_of_prod_eq_prodₓ'. -/
theorem perm_of_prod_eq_prod :
    ∀ {l₁ l₂ : List M}, l₁.Prod = l₂.Prod → (∀ p ∈ l₁, Prime p) → (∀ p ∈ l₂, Prime p) → Perm l₁ l₂
  | [], [], _, _, _ => Perm.nil
  | [], a :: l, h₁, h₂, h₃ =>
    have ha : a ∣ 1 := @prod_nil M _ ▸ h₁.symm ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _
    absurd ha (Prime.not_dvd_one (h₃ a (mem_cons_self _ _)))
  | a :: l, [], h₁, h₂, h₃ =>
    have ha : a ∣ 1 := @prod_nil M _ ▸ h₁ ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _
    absurd ha (Prime.not_dvd_one (h₂ a (mem_cons_self _ _)))
  | a :: l₁, b :: l₂, h, hl₁, hl₂ => by
    classical
      have hl₁' : ∀ p ∈ l₁, Prime p := fun p hp => hl₁ p (mem_cons_of_mem _ hp)
      have hl₂' : ∀ p ∈ (b :: l₂).eraseₓ a, Prime p := fun p hp => hl₂ p (mem_of_mem_erase hp)
      have ha : a ∈ b :: l₂ :=
        mem_list_primes_of_dvd_prod (hl₁ a (mem_cons_self _ _)) hl₂
          (h ▸ by rw [prod_cons] <;> exact dvd_mul_right _ _)
      have hb : b :: l₂ ~ a :: (b :: l₂).eraseₓ a := perm_cons_erase ha
      have hl : Prod l₁ = Prod ((b :: l₂).eraseₓ a) :=
        (mul_right_inj' (hl₁ a (mem_cons_self _ _)).NeZero).1 <| by
          rwa [← prod_cons, ← prod_cons, ← hb.prod_eq]
      exact perm.trans ((perm_of_prod_eq_prod hl hl₁' hl₂').cons _) hb.symm
#align perm_of_prod_eq_prod perm_of_prod_eq_prod

end CancelCommMonoidWithZero


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

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_739 :
  (nat.factorial 9) % 10 = 0 :=
begin
  norm_num,
end


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Sébastien Gouëzel
-/
import analysis.normed.field.basic

/-!
# Completeness in terms of `cauchy` filters vs `is_cau_seq` sequences

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

In this file we apply `metric.complete_of_cauchy_seq_tendsto` to prove that a `normed_ring`
is complete in terms of `cauchy` filter if and only if it is complete in terms
of `cau_seq` Cauchy sequences.
-/

universes u v
open set filter
open_locale topology classical

variable {β : Type v}

lemma cau_seq.tendsto_limit [normed_ring β] [hn : is_absolute_value (norm : β → ℝ)]
  (f : cau_seq β norm) [cau_seq.is_complete β norm] :
  tendsto f at_top (𝓝 f.lim) :=
_root_.tendsto_nhds.mpr
begin
  intros s os lfs,
  suffices : ∃ (a : ℕ), ∀ (b : ℕ), b ≥ a → f b ∈ s, by simpa using this,
  rcases metric.is_open_iff.1 os _ lfs with ⟨ε, ⟨hε, hεs⟩⟩,
  cases setoid.symm (cau_seq.equiv_lim f) _ hε with N hN,
  existsi N,
  intros b hb,
  apply hεs,
  dsimp [metric.ball], rw [dist_comm, dist_eq_norm],
  solve_by_elim
end

variables [normed_field β]

/-
 This section shows that if we have a uniform space generated by an absolute value, topological
 completeness and Cauchy sequence completeness coincide. The problem is that there isn't
 a good notion of "uniform space generated by an absolute value", so right now this is
 specific to norm. Furthermore, norm only instantiates is_absolute_value on normed_division_ring.
 This needs to be fixed, since it prevents showing that ℤ_[hp] is complete
-/

open metric

lemma cauchy_seq.is_cau_seq {f : ℕ → β} (hf : cauchy_seq f) :
  is_cau_seq norm f :=
begin
  cases cauchy_iff.1 hf with hf1 hf2,
  intros ε hε,
  rcases hf2 {x | dist x.1 x.2 < ε} (dist_mem_uniformity hε) with ⟨t, ⟨ht, htsub⟩⟩,
  simp at ht, cases ht with N hN,
  existsi N,
  intros j hj,
  rw ←dist_eq_norm,
  apply @htsub (f j, f N),
  apply set.mk_mem_prod; solve_by_elim [le_refl]
end

lemma cau_seq.cauchy_seq (f : cau_seq β norm) : cauchy_seq f :=
begin
  refine cauchy_iff.2 ⟨by apply_instance, λ s hs, _⟩,
  rcases mem_uniformity_dist.1 hs with ⟨ε, ⟨hε, hεs⟩⟩,
  cases cau_seq.cauchy₂ f hε with N hN,
  existsi {n | n ≥ N}.image f,
  simp only [exists_prop, mem_at_top_sets, mem_map, mem_image, ge_iff_le, mem_set_of_eq],
  split,
  { existsi N, intros b hb, existsi b, simp [hb] },
  { rintros ⟨a, b⟩ ⟨⟨a', ⟨ha'1, ha'2⟩⟩, ⟨b', ⟨hb'1, hb'2⟩⟩⟩,
    dsimp at ha'1 ha'2 hb'1 hb'2,
    rw [←ha'2, ←hb'2],
    apply hεs,
    rw dist_eq_norm,
    apply hN; assumption }
end

/-- In a normed field, `cau_seq` coincides with the usual notion of Cauchy sequences. -/
lemma cau_seq_iff_cauchy_seq {α : Type u} [normed_field α] {u : ℕ → α} :
  is_cau_seq norm u ↔ cauchy_seq u :=
⟨λh, cau_seq.cauchy_seq ⟨u, h⟩,
 λh, h.is_cau_seq⟩

/-- A complete normed field is complete as a metric space, as Cauchy sequences converge by
assumption and this suffices to characterize completeness. -/
@[priority 100] -- see Note [lower instance priority]
instance complete_space_of_cau_seq_complete [cau_seq.is_complete β norm] : complete_space β :=
begin
  apply complete_of_cauchy_seq_tendsto,
  assume u hu,
  have C : is_cau_seq norm u := cau_seq_iff_cauchy_seq.2 hu,
  existsi cau_seq.lim ⟨u, C⟩,
  rw metric.tendsto_at_top,
  assume ε εpos,
  cases (cau_seq.equiv_lim ⟨u, C⟩) _ εpos with N hN,
  existsi N,
  simpa [dist_eq_norm] using hN
end


theorem and_comm (a b : Prop) : (a ∧ b) = (b ∧ a) := sorry

theorem and_assoc (a b c : Prop) : ((a ∧ b) ∧ c) = (a ∧ (b ∧ c)):= sorry

theorem and_left_comm (a b c : Prop) : (a ∧ (b ∧ c)) = (b ∧ (a ∧ c)) := sorry

example (p q r : Prop) : (p ∧ q ∧ r)
                       = (r ∧ p ∧ q) :=
by simp only [and_comm, and_left_comm, and_assoc]

example (p q r : Prop) : ((let_fun x := p; x) ∧ (let_fun x := q; x) ∧ (let_fun x := r; x))
                       = ((let_fun x := r; x) ∧ (let_fun x := p; x) ∧ (let_fun x := q; x)) :=
by simp only [and_comm, and_left_comm, and_assoc]


import algebra.category.Ring
import category_theory.yoneda
import data.polynomial.algebra_map

open category_theory
open opposite
open polynomial

noncomputable theory

/-!
We show that the forgetful functor `CommRing ⥤ Type` is (co)representable.

There are a sequence of hints available in
`hints/category_theory/hintX.lean`, for `X = 1,2,3,4`.
-/

-- Because we'll be working with `polynomial ℤ`, which is in `Type 0`,
-- we just restrict to that universe for this exercise.
notation `CommRing` := CommRing.{0}

/-!
One bonus hint before we start, showing you how to obtain the
ring homomorphism from `ℤ` into any commutative ring.
-/
example (R : CommRing) : ℤ →+* R :=
by library_search

/-!
Also useful may be the functions
-/
#print polynomial.eval₂
#print polynomial.eval₂_ring_hom

/-!
The actual exercise!
-/
def CommRing_forget_representable : Σ (R : CommRing), (forget CommRing) ≅ coyoneda.obj (op R) :=
sorry

/-!
There are some further hints in
`hints/category_theory/exercise4/`
-/

/-
If you get an error message
```
synthesized type class instance is not definitionally equal to expression inferred by typing rules
```
while solving this exercise, see hint4.lean.
-/


import group_theory.subgroup data.equiv.basic data.fintype algebra.big_operators
open equiv
variables {α : Type*}

def is_transposition (f : perm α) : Prop :=
∃ x y, f x = y ∧ f y = x ∧ ∀ a, a ≠ x → a ≠ y → f a = a

lemma is_transposition_inv {f : perm α} : is_transposition f →
  is_transposition (f⁻¹) :=
λ ⟨x, y, h⟩, ⟨x, y, h.2.1 ▸ equiv.left_inv _ _, h.1 ▸ equiv.left_inv _ _,
  λ a hax hay, by conv {to_lhs, rw ← h.2.2 a hax hay};
    exact equiv.left_inv _ _⟩

variable [fintype α]

lemma product_of_transpositions (f : perm α) : ∃ s : list (perm α),
  f = s.prod ∧ ∀ g ∈ s, is_transposition g := sorry

lemma sign_well_defined_aux : ∀ (n : ℕ) (f : perm α) (m l : list (perm α)),
  (∀ g ∈ l, is_transposition g) → l.prod = f → l.length = n →
  (∀ g ∈ m, is_transposition g) → m.prod = f → l.length % 2 = m.length % 2
| 0 := λ f m,
  match m with
  | [] := by simp {contextual := tt}
  | (k :: m) := λ l hl hlf hl0, begin

    end
  end
lemma sign_well_defined (f : perm α) :
  (∀ l : list (perm α), (∀ g ∈ l, is_transposition g) → l.prod = f → l.length % 2 = 0) ∨
  (∀ l : list (perm α), (∀ g ∈ l, is_transposition g) → l.prod = f → l.length % 2 = 0) :=
have ∀ n : ℕ, ∀ l m : list (perm α), (∀ g ∈ l, is_transposition g) → l.prod = f → l.length = n
  (∀ g ∈ m, is_transposition g) → m.prod = f → l.length % 2 = m.length % 2 | 0 :=
begin

end


theorem nothing_mem_nil {t: Type} {xs: list t}: (∀ (x: t), x ∉ xs) ↔ xs = [] :=
begin
  split,
  intro h,
  induction xs,
  refl,
  exfalso,
  exact h xs_hd (or.inl rfl),
  intro h,
  rw h,
  exact list.not_mem_nil,
end


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.locally_finite

/-!
# Finite intervals of naturals

This file proves that `ℕ` is a `locally_finite_order` and calculates the cardinality of its
intervals as finsets and fintypes.

## TODO

Some lemmas can be generalized using `ordered_group`, `canonically_ordered_monoid` or `succ_order`
and subsequently be moved upstream to `data.finset.locally_finite`.
-/

open finset nat

instance : locally_finite_order ℕ :=
{ finset_Icc := λ a b, (list.range' a (b + 1 - a)).to_finset,
  finset_Ico := λ a b, (list.range' a (b - a)).to_finset,
  finset_Ioc := λ a b, (list.range' (a + 1) (b - a)).to_finset,
  finset_Ioo := λ a b, (list.range' (a + 1) (b - a - 1)).to_finset,
  finset_mem_Icc := λ a b x, begin
    rw [list.mem_to_finset, list.mem_range'],
    cases le_or_lt a b,
    { rw [add_tsub_cancel_of_le (nat.lt_succ_of_le h).le, nat.lt_succ_iff] },
    { rw [tsub_eq_zero_iff_le.2 (succ_le_of_lt h), add_zero],
      exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.trans hx.2)) }
  end,
  finset_mem_Ico := λ a b x, begin
    rw [list.mem_to_finset, list.mem_range'],
    cases le_or_lt a b,
    { rw [add_tsub_cancel_of_le h] },
    { rw [tsub_eq_zero_iff_le.2 h.le, add_zero],
      exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.trans hx.2.le)) }
  end,
  finset_mem_Ioc := λ a b x, begin
    rw [list.mem_to_finset, list.mem_range'],
    cases le_or_lt a b,
    { rw [←succ_sub_succ, add_tsub_cancel_of_le (succ_le_succ h), nat.lt_succ_iff,
        nat.succ_le_iff] },
    { rw [tsub_eq_zero_iff_le.2 h.le, add_zero],
      exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.le.trans hx.2)) }
  end,
  finset_mem_Ioo := λ a b x, begin
    rw [list.mem_to_finset, list.mem_range', ← tsub_add_eq_tsub_tsub],
    cases le_or_lt (a + 1) b,
    { rw [add_tsub_cancel_of_le h, nat.succ_le_iff] },
    { rw [tsub_eq_zero_iff_le.2 h.le, add_zero],
      exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.trans hx.2)) }
  end }

variables (a b c : ℕ)

namespace nat

lemma Icc_eq_range' : Icc a b = (list.range' a (b + 1 - a)).to_finset := rfl
lemma Ico_eq_range' : Ico a b = (list.range' a (b - a)).to_finset := rfl
lemma Ioc_eq_range' : Ioc a b = (list.range' (a + 1) (b - a)).to_finset := rfl
lemma Ioo_eq_range' : Ioo a b = (list.range' (a + 1) (b - a - 1)).to_finset := rfl

lemma Iio_eq_range : Iio = range := by { ext b x, rw [mem_Iio, mem_range] }

@[simp] lemma Ico_zero_eq_range : Ico 0 = range := by rw [←bot_eq_zero, ←Iio_eq_Ico, Iio_eq_range]

lemma _root_.finset.range_eq_Ico : range = Ico 0 := Ico_zero_eq_range.symm

@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a :=
by rw [Icc_eq_range', list.card_to_finset, (list.nodup_range' _ _).erase_dup, list.length_range']

@[simp] lemma card_Ico : (Ico a b).card = b - a :=
by rw [Ico_eq_range', list.card_to_finset, (list.nodup_range' _ _).erase_dup, list.length_range']

@[simp] lemma card_Ioc : (Ioc a b).card = b - a :=
by rw [Ioc_eq_range', list.card_to_finset, (list.nodup_range' _ _).erase_dup, list.length_range']

@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 :=
by rw [Ioo_eq_range', list.card_to_finset, (list.nodup_range' _ _).erase_dup, list.length_range']

@[simp] lemma card_Iic : (Iic b).card = b + 1 := by rw [Iic, card_Icc, bot_eq_zero, tsub_zero]
@[simp] lemma card_Iio : (Iio b).card = b := by rw [Iio, card_Ico, bot_eq_zero, tsub_zero]

@[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a :=
by rw [fintype.card_of_finset, card_Icc]

@[simp] lemma card_fintype_Ico : fintype.card (set.Ico a b) = b - a :=
by rw [fintype.card_of_finset, card_Ico]

@[simp] lemma card_fintype_Ioc : fintype.card (set.Ioc a b) = b - a :=
by rw [fintype.card_of_finset, card_Ioc]

@[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 :=
by rw [fintype.card_of_finset, card_Ioo]

@[simp] lemma card_fintype_Iic : fintype.card (set.Iic b) = b + 1 :=
by rw [fintype.card_of_finset, card_Iic]

@[simp] lemma card_fintype_Iio : fintype.card (set.Iio b) = b :=
by rw [fintype.card_of_finset, card_Iio]

-- TODO@Yaël: Generalize all the following lemmas to `succ_order`

lemma Icc_succ_left : Icc a.succ b = Ioc a b := by { ext x, rw [mem_Icc, mem_Ioc, succ_le_iff] }

lemma Ico_succ_right : Ico a b.succ = Icc a b := by { ext x, rw [mem_Ico, mem_Icc, lt_succ_iff] }

lemma Ico_succ_left : Ico a.succ b = Ioo a b := by { ext x, rw [mem_Ico, mem_Ioo, succ_le_iff] }

lemma Icc_pred_right {b : ℕ} (h : 0 < b) : Icc a (b - 1) = Ico a b :=
by { ext x, rw [mem_Icc, mem_Ico, lt_iff_le_pred h] }

lemma Ico_succ_succ : Ico a.succ b.succ = Ioc a b :=
by { ext x, rw [mem_Ico, mem_Ioc, succ_le_iff, lt_succ_iff] }

@[simp] lemma Ico_succ_singleton : Ico a (a + 1) = {a} := by rw [Ico_succ_right, Icc_self]

@[simp] lemma Ico_pred_singleton {a : ℕ} (h : 0 < a) : Ico (a - 1) a = {a - 1} :=
by rw [←Icc_pred_right _ h, Icc_self]

variables {a b c}

lemma Ico_succ_right_eq_insert_Ico (h : a ≤ b) : Ico a (b + 1) = insert b (Ico a b) :=
by rw [Ico_succ_right, ←Ico_insert_right h]

lemma Ico_insert_succ_left (h : a < b) : insert a (Ico a.succ b) = Ico a b :=
by rw [Ico_succ_left, ←Ioo_insert_left h]

lemma image_sub_const_Ico (h : c ≤ a) : (Ico a b).image (λ x, x - c) = Ico (a - c) (b - c) :=
begin
  ext x,
  rw mem_image,
  split,
  { rintro ⟨x, hx, rfl⟩,
    rw [mem_Ico] at ⊢ hx,
    exact ⟨tsub_le_tsub_right hx.1 _, tsub_lt_tsub_right_of_le (h.trans hx.1) hx.2⟩ },
  { rintro h,
    refine ⟨x + c, _, add_tsub_cancel_right _ _⟩,
    rw mem_Ico at ⊢ h,
    exact ⟨tsub_le_iff_right.1 h.1, lt_tsub_iff_right.1 h.2⟩ }
end

lemma Ico_image_const_sub_eq_Ico (hac : a ≤ c) :
  (Ico a b).image (λ x, c - x) = Ico (c + 1 - b) (c + 1 - a) :=
begin
  ext x,
  rw [mem_image, mem_Ico],
  split,
  { rintro ⟨x, hx, rfl⟩,
    rw mem_Ico at hx,
    refine ⟨_, ((tsub_le_tsub_iff_left hac).2 hx.1).trans_lt ((tsub_lt_tsub_iff_right hac).2
      (nat.lt_succ_self _))⟩,
    cases lt_or_le c b,
    { rw tsub_eq_zero_iff_le.mpr (succ_le_of_lt h),
      exact zero_le _ },
    { rw ←succ_sub_succ c,
      exact (tsub_le_tsub_iff_left (succ_le_succ $ hx.2.le.trans h)).2 hx.2 } },
  { rintro ⟨hb, ha⟩,
    rw [lt_tsub_iff_left, lt_succ_iff] at ha,
    have hx : x ≤ c := (nat.le_add_left _ _).trans ha,
    refine ⟨c - x, _, tsub_tsub_cancel_of_le hx⟩,
    { rw mem_Ico,
      exact ⟨le_tsub_of_add_le_right ha, (tsub_lt_iff_left hx).2 $ succ_le_iff.1 $
        tsub_le_iff_right.1 hb⟩ } }
end

lemma Ico_succ_left_eq_erase_Ico : Ico a.succ b = erase (Ico a b) a :=
begin
  ext x,
  rw [Ico_succ_left, mem_erase, mem_Ico, mem_Ioo, ←and_assoc, ne_comm, and_comm (a ≠ x),
    lt_iff_le_and_ne],
end

end nat

namespace finset

lemma range_image_pred_top_sub (n : ℕ) : (finset.range n).image (λ j, n - 1 - j) = finset.range n :=
begin
  cases n,
  { rw [range_zero, image_empty] },
  { rw [finset.range_eq_Ico, nat.Ico_image_const_sub_eq_Ico (zero_le _)],
    simp_rw [succ_sub_succ, tsub_zero, tsub_self] }
end

lemma range_add_eq_union : range (a + b) = range a ∪ (range b).map (add_left_embedding a) :=
begin
  rw [finset.range_eq_Ico, map_eq_image],
  convert (Ico_union_Ico_eq_Ico a.zero_le le_self_add).symm,
  exact image_add_left_Ico _ _ _,
end

end finset