/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot, Yury Kudryashov, Rémy Degenne
-/
import data.set.intervals.basic
import order.hom.set

/-!
# Lemmas about images of intervals under order isomorphisms.

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

variables {α β : Type*}
open set

namespace order_iso

section preorder
variables [preorder α] [preorder β]

@[simp] lemma preimage_Iic (e : α ≃o β) (b : β) : e ⁻¹' (Iic b) = Iic (e.symm b) :=
by { ext x, simp [← e.le_iff_le] }

@[simp] lemma preimage_Ici (e : α ≃o β) (b : β) : e ⁻¹' (Ici b) = Ici (e.symm b) :=
by { ext x, simp [← e.le_iff_le] }

@[simp] lemma preimage_Iio (e : α ≃o β) (b : β) : e ⁻¹' (Iio b) = Iio (e.symm b) :=
by { ext x, simp [← e.lt_iff_lt] }

@[simp] lemma preimage_Ioi (e : α ≃o β) (b : β) : e ⁻¹' (Ioi b) = Ioi (e.symm b) :=
by { ext x, simp [← e.lt_iff_lt] }

@[simp] lemma preimage_Icc (e : α ≃o β) (a b : β) : e ⁻¹' (Icc a b) = Icc (e.symm a) (e.symm b) :=
by simp [← Ici_inter_Iic]

@[simp] lemma preimage_Ico (e : α ≃o β) (a b : β) : e ⁻¹' (Ico a b) = Ico (e.symm a) (e.symm b) :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_Ioc (e : α ≃o β) (a b : β) : e ⁻¹' (Ioc a b) = Ioc (e.symm a) (e.symm b) :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_Ioo (e : α ≃o β) (a b : β) : e ⁻¹' (Ioo a b) = Ioo (e.symm a) (e.symm b) :=
by simp [← Ioi_inter_Iio]

@[simp] lemma image_Iic (e : α ≃o β) (a : α) : e '' (Iic a) = Iic (e a) :=
by rw [e.image_eq_preimage, e.symm.preimage_Iic, e.symm_symm]

@[simp] lemma image_Ici (e : α ≃o β) (a : α) : e '' (Ici a) = Ici (e a) :=
e.dual.image_Iic a

@[simp] lemma image_Iio (e : α ≃o β) (a : α) : e '' (Iio a) = Iio (e a) :=
by rw [e.image_eq_preimage, e.symm.preimage_Iio, e.symm_symm]

@[simp] lemma image_Ioi (e : α ≃o β) (a : α) : e '' (Ioi a) = Ioi (e a) :=
e.dual.image_Iio a

@[simp] lemma image_Ioo (e : α ≃o β) (a b : α) : e '' (Ioo a b) = Ioo (e a) (e b) :=
by rw [e.image_eq_preimage, e.symm.preimage_Ioo, e.symm_symm]

@[simp] lemma image_Ioc (e : α ≃o β) (a b : α) : e '' (Ioc a b) = Ioc (e a) (e b) :=
by rw [e.image_eq_preimage, e.symm.preimage_Ioc, e.symm_symm]

@[simp] lemma image_Ico (e : α ≃o β) (a b : α) : e '' (Ico a b) = Ico (e a) (e b) :=
by rw [e.image_eq_preimage, e.symm.preimage_Ico, e.symm_symm]

@[simp]

end preorder

/-- Order isomorphism between `Iic (⊤ : α)` and `α` when `α` has a top element -/
def Iic_top [preorder α] [order_top α] : set.Iic (⊤ : α) ≃o α :=
{ map_rel_iff' := λ x y, by refl,
  .. (@equiv.subtype_univ_equiv α (set.Iic (⊤ : α)) (λ x, le_top)), }

/-- Order isomorphism between `Ici (⊥ : α)` and `α` when `α` has a bottom element -/
def Ici_bot [preorder α] [order_bot α] : set.Ici (⊥ : α) ≃o α :=
{ map_rel_iff' := λ x y, by refl,
  .. (@equiv.subtype_univ_equiv α (set.Ici (⊥ : α)) (λ x, bot_le)) }

end order_iso


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Bhavik Mehta, Eric Wieser

! This file was ported from Lean 3 source module algebra.big_operators.multiset.lemmas
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.List.BigOperators.Lemmas
import Mathlib.Algebra.BigOperators.Multiset.Basic

/-! # Lemmas about `Multiset.sum` and `Multiset.prod` requiring extra algebra imports -/

variable {α : Type _}

namespace Multiset

theorem dvd_prod [CommMonoid α] {s : Multiset α} {a : α} : a ∈ s → a ∣ s.prod :=
  Quotient.inductionOn s (fun l a h => by simpa using List.dvd_prod h) a
#align multiset.dvd_prod Multiset.dvd_prod

@[to_additive]
theorem prod_eq_one_iff [CanonicallyOrderedMonoid α] {m : Multiset α} :
    m.prod = 1 ↔ ∀ x ∈ m, x = (1 : α) :=
  Quotient.inductionOn m fun l => by simpa using List.prod_eq_one_iff l
#align multiset.prod_eq_one_iff Multiset.prod_eq_one_iff
#align multiset.sum_eq_zero_iff Multiset.sum_eq_zero_iff

end Multiset

@[simp]
lemma CanonicallyOrderedCommSemiring.multiset_prod_pos {R} [CanonicallyOrderedCommSemiring R]
    [Nontrivial R] {m : Multiset R} : 0 < m.prod ↔ (∀ x ∈ m, (0 : R) < x) := by
  rcases m with ⟨l⟩
  rw [Multiset.quot_mk_to_coe'', Multiset.coe_prod]
  exact CanonicallyOrderedCommSemiring.list_prod_pos

open Multiset

namespace Commute

variable [NonUnitalNonAssocSemiring α] (s : Multiset α)

theorem multiset_sum_right (a : α) (h : ∀ b ∈ s, Commute a b) : Commute a s.sum := by
  induction s using Quotient.inductionOn
  rw [quot_mk_to_coe, coe_sum]
  exact Commute.list_sum_right _ _ h
#align commute.multiset_sum_right Commute.multiset_sum_right

theorem multiset_sum_left (b : α) (h : ∀ a ∈ s, Commute a b) : Commute s.sum b :=
  ((Commute.multiset_sum_right _ _) fun _ ha => (h _ ha).symm).symm
#align commute.multiset_sum_left Commute.multiset_sum_left

end Commute


import init.data.list.basic
import data.fintype.basic
import tactic.norm_num
import language
/- explicit type argument -/
universes u v
/-- 按照DFA的形式化定义其五元组表示, 不过这里没有使用集合论而采用了类型论进行表示
分别为:
输入符号类型`α`
状态类型`σ`
状态转移函数为`tansition`, `σ → α → σ`，可理解为`σ`碰到了`α`转移到新的`σ`
起始状态是`σ`的一个term
接受状态`σ`的集合 --/
structure DFA (α : Type u) (σ : Type v) :=
  (transition : σ → α → σ)
  (start : σ)
  (accept: set σ)

/- 这里定义一些DFA上的实用函数用于简化证明过程 --/
namespace DFA

/- 输入字符的类型，状态的类型，以及自动机的类型 -/
variables {α : Type u} {σ : Type v} (M: DFA α σ)

/-- 许多定理都需要假定一个类型是`inhabited`的。一个类型是`inhabited`的意味着
   它至少有一个元素。例如定理： if α is a type, ∃ x: α, x = x 为真当且仅当α是`inhabited`的。这里DFA的`inhabited`我定义为空自动机，只有一个元素，所有的转移都会回到自身（即转移函数为空），当然这需要建立在状态类型`α`也是`inhabited`的基础上，否则找不到至少一个状态。 -/
instance [inhabited σ]: inhabited (DFA α σ) :=
 ⟨ DFA.mk (λ _ _, default) default ∅ ⟩

/- `M.eval_from s input` 对从状态`s`开始读入`input`进行求值 -/
def eval_from (start : σ) (input: list α) : σ :=
  list.foldl M.transition start input

/-- 强化simp使用 -/
@[simp] lemma eval_from_nil (s:σ) : M.eval_from s [] = s := rfl
@[simp] lemma eval_from_singleton (s : σ) (a : α) :
  M.eval_from s [a] = M.transition s a := rfl
@[simp] lemma eval_from_append_singleton (s: σ) (x: list α) (a: α):
  M.eval_from s (x++[a]) = M.transition (M.eval_from s x) a :=
  by simp only [eval_from, list.foldl_append, list.foldl_cons, list.foldl_nil]

/-- `M.eval x` evaluate `M` with input `x` starting from `M.start`-/
def eval : list α → σ := M.eval_from M.start

@[simp] lemma eval_nil : M.eval [] = M.start := rfl
@[simp] lemma eval_singleton(a:α) :
  M.eval [a] = M.transition M.start a := rfl
@[simp] lemma eval_append_singleton (x : list α) (a: α):
  M.eval (x ++ [a]) = M.transition (M.eval x) a :=
  eval_from_append_singleton _ _ _ _

lemma eval_from_of_append (start: σ) (x y: list α) :
  M.eval_from start (x ++ y) = M.eval_from (M.eval_from start x) y :=
  x.foldl_append _ _ y

/- `M.accepts x`能接受`x`，如果对于`x`有`M.eval x ∈ M.accept` -/
def accepts : language α :=
  λ x, M.eval x ∈ M.accept

lemma mem_accepts (x : list α) : x ∈ M.accepts ↔ M.eval_from M.start x ∈ M.accept := by refl

/- fintype说明σ是有限的类型(集合)而非无限的类型(集合) -/
lemma eval_from_split [fintype σ] {x : list α} {s t : σ}
/- card是cardinal的缩写 -/
(hlen : fintype.card σ ≤ x.length)
(hx : M.eval_from s x = t) :
∃ q a b c,
x = a ++ b ++ c ∧
a.length + b.length ≤ fintype.card σ ∧
b ≠ [] ∧
M.eval_from s a = q ∧
M.eval_from q b = q ∧
M.eval_from q c = t :=
begin
  /- 利用fintype上的鸽巢原理(鸽子和鸽巢都是有限的) -/
  /- 那么有长度n和m, n和m不等,-/
  /- 且`M.eval_from s (x.take n)` = `M.eval_from s (x.take m)`-/
  obtain ⟨n, m, hneq, heq⟩ := fintype.exists_ne_map_eq_of_card_lt
  (λ n : fin (fintype.card σ + 1), M.eval_from s (x.take n)) (by norm_num),
  /- 不失一般性，我们可以假设n≤m -/
  wlog hle : (n : ℕ) ≤ m using n m,
  /- 又已经知道n和m不等了，所以n<m -/
  have hlt : (n : ℕ) < m := (ne.le_iff_lt hneq).mp hle,
  /- m:|σ| + 1 ≤ |σ|, n < m < |σ| -/
  have hm : (m : ℕ) ≤ fintype.card σ := fin.is_le m,
  dsimp at heq,

  /- 那么q,a,b,c就都找到了, 分别是:-/
  /- q = M.eval_from s (x.take m).take n = M.eval_from s (x.take n)-/
  /- a = x.take m-/
  /- b = (x.take m).drop n-/
  /- c = x.drop m -/
  refine ⟨M.eval_from s ((x.take m).take n), (x.take m).take n, (x.take m).drop n, x.drop m,
    _, _, _, by refl, _⟩,

  { rw [list.take_append_drop, list.take_append_drop] },

  { simp only [list.length_drop, list.length_take],
    rw [min_eq_left (hm.trans hlen), min_eq_left hle, add_tsub_cancel_of_le hle],
    exact hm },

  { intro h,
    have hlen' := congr_arg list.length h,
    simp only [list.length_drop, list.length, list.length_take] at hlen',
    rw [min_eq_left, tsub_eq_zero_iff_le] at hlen',
    { apply hneq,
      apply le_antisymm,
      assumption' },
    exact hm.trans hlen, },

  have hq :
    M.eval_from (M.eval_from s ((x.take m).take n)) ((x.take m).drop n) =
      M.eval_from s ((x.take m).take n),
  { rw [list.take_take, min_eq_left hle, ←eval_from_of_append, heq, ←min_eq_left hle,
        ←list.take_take, min_eq_left hle, list.take_append_drop] },

  use hq,
  rwa [←hq, ←eval_from_of_append, ←eval_from_of_append, ←list.append_assoc, list.take_append_drop,
       list.take_append_drop]
end

/- x绕回来了,多用几个x多绕几圈或者不绕 -/
lemma eval_from_of_pow {x y : list α} {s : σ} (hx : M.eval_from s x = s)
  (hy : y ∈ @language.star α {x}) : M.eval_from s y = s :=
begin
  rw language.mem_star at hy,
  rcases hy with ⟨ S, rfl, hS ⟩,
  induction S with a S ih,
  { refl },
  { have ha := hS a (list.mem_cons_self _ _),
    rw set.mem_singleton_iff at ha,
    rw [list.join, eval_from_of_append, ha, hx],
    apply ih,
    intros z hz,
    exact hS z (list.mem_cons_of_mem a hz) }
end

/- pump lemma的证明-/
/- 同样先限定σ是个finite type, x是α上的串, hx表明该串能被M接收-/
/- hlen表明x的长度要大于等于|σ|(也就是pump lemma里说的那个`N`)-/
/- 然后用∃对串进行拆分-/
lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card σ ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card σ ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
/- 首先利用上面的辅助定理`eval_from_split`进行拆分找到abc并获取相应的结论-/
  obtain ⟨_, a, b, c, hx, hlen, hnil, rfl, hb, hc⟩ := M.eval_from_split hlen rfl,
  use [a, b, c, hx, hlen, hnil],
  intros y hy,
  /-拆分hy-/
  rw language.mem_mul at hy,
  rcases hy with ⟨ ab, c', hab, hc', rfl ⟩,
  rw language.mem_mul at hab,
  /-再拆hab-/
  rcases hab with ⟨ a', b', ha', hb', rfl ⟩,
  rw set.mem_singleton_iff at ha' hc',
  substs ha' hc',
  have h := M.eval_from_of_pow hb hb',
  rwa [mem_accepts, eval_from_of_append, eval_from_of_append, h, hc]
end

end DFA


/-
Copyright (c) 2023 Antoine Labelle. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Antoine Labelle
-/
import combinatorics.quiver.cast
import combinatorics.quiver.symmetric

/-!
# Single-object quiver

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

Single object quiver with a given arrows type.

## Main definitions

Given a type `α`, `single_obj α` is the `unit` type, whose single object is called `star α`, with
`quiver` structure such that `star α ⟶ star α` is the type `α`.
An element `x : α` can be reinterpreted as an element of `star α ⟶ star α` using
`to_hom`.
More generally, a list of elements of `a` can be reinterpreted as a path from `star α` to
itself using `path_equiv_list`.
-/

namespace quiver

/-- Type tag on `unit` used to define single-object quivers. -/
@[derive unique, nolint unused_arguments]
def single_obj (α : Type*) : Type := unit

namespace single_obj

variables (α β γ : Type*)

instance : quiver (single_obj α) := ⟨λ _ _, α⟩

/-- The single object in `single_obj α`. -/
def star : single_obj α := unit.star

instance : inhabited (single_obj α) := ⟨star α⟩

variables {α β γ}

/-- Equip `single_obj α` with a reverse operation. -/
@[reducible] -- See note [reducible non-instances]
def has_reverse (rev : α → α) : has_reverse (single_obj α) := ⟨λ _ _, rev⟩

/-- Equip `single_obj α` with an involutive reverse operation. -/
@[reducible] -- See note [reducible non-instances]
def has_involutive_reverse (rev : α → α) (h : function.involutive rev) :
  has_involutive_reverse (single_obj α) :=
{ to_has_reverse := has_reverse rev,
  inv' := λ _ _, h}

/-- The type of arrows from `star α` to itself is equivalent to the original type `α`. -/
@[simps] def to_hom : α ≃ (star α ⟶ star α) := equiv.refl _

/--
Prefunctors between two `single_obj` quivers correspond to functions between the corresponding
arrows types.
-/
@[simps] def to_prefunctor :
  (α → β) ≃ (single_obj α ⥤q single_obj β) :=
{ to_fun := λ f, ⟨id, λ _ _, f⟩,
  inv_fun := λ f a, f.map (to_hom a),
  left_inv := λ _, rfl,
  right_inv :=  λ f, by cases f; obviously }

lemma to_prefunctor_id : to_prefunctor id = 𝟭q (single_obj α) := rfl

@[simp] lemma to_prefunctor_symm_id :
  to_prefunctor.symm (𝟭q (single_obj α)) = id := rfl

lemma to_prefunctor_comp (f : α → β) (g : β → γ) :
  to_prefunctor (g ∘ f) = to_prefunctor f ⋙q to_prefunctor g := rfl

@[simp] lemma to_prefunctor_symm_comp (f : single_obj α ⥤q single_obj β)
  (g : single_obj β ⥤q single_obj γ) : to_prefunctor.symm (f ⋙q g) =
  to_prefunctor.symm g ∘ to_prefunctor.symm f :=
by simp only [equiv.symm_apply_eq, to_prefunctor_comp, equiv.apply_symm_apply]

/--
Auxiliary definition for `quiver.single_obj.path_equiv_list`.
Converts a path in the quiver `single_obj α` into a list of elements of type `a`.
-/
@[simp] def path_to_list : Π {x : single_obj α}, path (star α) x → list α
| _ path.nil := []
| _ (path.cons p a) := a :: path_to_list p

/--
Auxiliary definition for `quiver.single_obj.path_equiv_list`.
Converts a list of elements of type `α` into a path in the quiver `single_obj α`.
-/
@[simp] def list_to_path : list α → path (star α) (star α)
| [] := path.nil
| (a :: l) := (list_to_path l).cons a

lemma path_to_list_to_path {x : single_obj α} (p : path (star α) x) :
  list_to_path (path_to_list p) = p.cast rfl (unit.ext) :=
by { induction p with y z p a ih, refl, tidy, }

lemma list_to_path_to_list (l : list α) :
  path_to_list (list_to_path l) = l :=
by { induction l with a l ih, refl, simp [ih] }

/-- Paths in `single_obj α` quiver correspond to lists of elements of type `α`. -/
def path_equiv_list : path (star α) (star α) ≃ list α :=
⟨path_to_list, list_to_path, λ p, path_to_list_to_path p, list_to_path_to_list⟩

@[simp] lemma path_equiv_list_nil : path_equiv_list path.nil = ([] : list α) := rfl

@[simp] lemma path_equiv_list_cons (p : path (star α) (star α)) (a : star α ⟶ star α) :
  path_equiv_list (path.cons p a) =  a :: path_to_list p := rfl

@[simp] lemma path_equiv_list_symm_nil : path_equiv_list.symm ([] : list α) = path.nil := rfl

@[simp] lemma path_equiv_list_symm_cons (l : list α) (a : α) :
  path_equiv_list.symm (a :: l) =  path.cons (path_equiv_list.symm l) a := rfl

end single_obj

end quiver


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

! This file was ported from Lean 3 source module data.pfunctor.univariate.basic
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.W.Basic

/-!
# Polynomial functors

This file defines polynomial functors and the W-type construction as a
polynomial functor.  (For the M-type construction, see
pfunctor/M.lean.)
-/

-- "W", "Idx"
set_option linter.uppercaseLean3 false

universe u

/-- A polynomial functor `P` is given by a type `A` and a family `B` of types over `A`. `P` maps
any type `α` to a new type `P.obj α`, which is defined as the sigma type `Σ x, P.B x → α`.

An element of `P.obj α` is a pair `⟨a, f⟩`, where `a` is an element of a type `A` and
`f : B a → α`. Think of `a` as the shape of the object and `f` as an index to the relevant
elements of `α`.
-/
structure PFunctor where
  /-- The head type -/
  A : Type u
  /-- The child family of types -/
  B : A → Type u
#align pfunctor PFunctor

namespace PFunctor

instance : Inhabited PFunctor :=
  ⟨⟨default, default⟩⟩

variable (P : PFunctor) {α β : Type u}

/-- Applying `P` to an object of `Type` -/
def Obj (α : Type _) :=
  Σx : P.A, P.B x → α
#align pfunctor.obj PFunctor.Obj

/-- Applying `P` to a morphism of `Type` -/
def map {α β : Type _} (f : α → β) : P.Obj α → P.Obj β :=
  fun ⟨a, g⟩ => ⟨a, f ∘ g⟩
#align pfunctor.map PFunctor.map

instance Obj.inhabited [Inhabited P.A] [Inhabited α] : Inhabited (P.Obj α) :=
  ⟨⟨default, default⟩⟩
#align pfunctor.obj.inhabited PFunctor.Obj.inhabited

instance : Functor P.Obj where map := @map P

protected theorem map_eq {α β : Type _} (f : α → β) (a : P.A) (g : P.B a → α) :
    @Functor.map P.Obj _ _ _ f ⟨a, g⟩ = ⟨a, f ∘ g⟩ :=
  rfl
#align pfunctor.map_eq PFunctor.map_eq

protected theorem id_map {α : Type _} : ∀ x : P.Obj α, id <$> x = id x := fun ⟨_a, _b⟩ => rfl
#align pfunctor.id_map PFunctor.id_map

protected theorem comp_map {α β γ : Type _} (f : α → β) (g : β → γ) :
    ∀ x : P.Obj α, (g ∘ f) <$> x = g <$> f <$> x := fun ⟨_a, _b⟩ => rfl
#align pfunctor.comp_map PFunctor.comp_map

instance : LawfulFunctor P.Obj where
  map_const := rfl
  id_map := @PFunctor.id_map P
  comp_map := @PFunctor.comp_map P

/-- re-export existing definition of W-types and
adapt it to a packaged definition of polynomial functor -/
def W :=
  WType P.B
#align pfunctor.W PFunctor.W

/- inhabitants of W types is awkward to encode as an instance
assumption because there needs to be a value `a : P.A`
such that `P.B a` is empty to yield a finite tree -/
-- attribute [nolint has_nonempty_instance] W

variable {P}

/-- root element  of a W tree -/
def W.head : W P → P.A
  | ⟨a, _f⟩ => a
#align pfunctor.W.head PFunctor.W.head

/-- children of the root of a W tree -/
def W.children : ∀ x : W P, P.B (W.head x) → W P
  | ⟨_a, f⟩ => f
#align pfunctor.W.children PFunctor.W.children

/-- destructor for W-types -/
def W.dest : W P → P.Obj (W P)
  | ⟨a, f⟩ => ⟨a, f⟩
#align pfunctor.W.dest PFunctor.W.dest

/-- constructor for W-types -/
def W.mk : P.Obj (W P) → W P
  | ⟨a, f⟩ => ⟨a, f⟩
#align pfunctor.W.mk PFunctor.W.mk

@[simp]
theorem W.dest_mk (p : P.Obj (W P)) : W.dest (W.mk p) = p := by cases p; rfl
#align pfunctor.W.dest_mk PFunctor.W.dest_mk

@[simp]
theorem W.mk_dest (p : W P) : W.mk (W.dest p) = p := by cases p; rfl
#align pfunctor.W.mk_dest PFunctor.W.mk_dest

variable (P)

/-- `Idx` identifies a location inside the application of a pfunctor.
For `F : pfunctor`, `x : F.obj α` and `i : F.Idx`, `i` can designate
one part of `x` or is invalid, if `i.1 ≠ x.1` -/
def IdxCat :=
  Σx : P.A, P.B x
#align pfunctor.Idx PFunctor.IdxCat

instance IdxCat.inhabited [Inhabited P.A] [Inhabited (P.B default)] : Inhabited P.IdxCat :=
  ⟨⟨default, default⟩⟩
#align pfunctor.Idx.inhabited PFunctor.IdxCat.inhabited

variable {P}

/-- `x.iget i` takes the component of `x` designated by `i` if any is or returns
a default value -/
def Obj.iget [DecidableEq P.A] {α} [Inhabited α] (x : P.Obj α) (i : P.IdxCat) : α :=
  if h : i.1 = x.1 then x.2 (cast (congr_arg _ h) i.2) else default
#align pfunctor.obj.iget PFunctor.Obj.iget

@[simp]
theorem fst_map {α β : Type u} (x : P.Obj α) (f : α → β) : (f <$> x).1 = x.1 := by cases x; rfl
#align pfunctor.fst_map PFunctor.fst_map

@[simp]
theorem iget_map [DecidableEq P.A] {α β : Type u} [Inhabited α] [Inhabited β] (x : P.Obj α)
    (f : α → β) (i : P.IdxCat) (h : i.1 = x.1) : (f <$> x).iget i = f (x.iget i) := by
  simp only [Obj.iget, fst_map, *, dif_pos, eq_self_iff_true]
  cases x
  rfl
#align pfunctor.iget_map PFunctor.iget_map

end PFunctor

/-
Composition of polynomial functors.
-/
namespace PFunctor

/-- functor composition for polynomial functors -/
def comp (P₂ P₁ : PFunctor.{u}) : PFunctor.{u} :=
  ⟨Σa₂ : P₂.1, P₂.2 a₂ → P₁.1, fun a₂a₁ => Σu : P₂.2 a₂a₁.1, P₁.2 (a₂a₁.2 u)⟩
#align pfunctor.comp PFunctor.comp

/-- constructor for composition -/
def comp.mk (P₂ P₁ : PFunctor.{u}) {α : Type} (x : P₂.Obj (P₁.Obj α)) : (comp P₂ P₁).Obj α :=
  ⟨⟨x.1, Sigma.fst ∘ x.2⟩, fun a₂a₁ => (x.2 a₂a₁.1).2 a₂a₁.2⟩
#align pfunctor.comp.mk PFunctor.comp.mk

/-- destructor for composition -/
def comp.get (P₂ P₁ : PFunctor.{u}) {α : Type} (x : (comp P₂ P₁).Obj α) : P₂.Obj (P₁.Obj α) :=
  ⟨x.1.1, fun a₂ => ⟨x.1.2 a₂, fun a₁ => x.2 ⟨a₂, a₁⟩⟩⟩
#align pfunctor.comp.get PFunctor.comp.get

end PFunctor

/-
Lifting predicates and relations.
-/
namespace PFunctor

variable {P : PFunctor.{u}}

open Functor

theorem liftp_iff {α : Type u} (p : α → Prop) (x : P.Obj α) :
    Liftp p x ↔ ∃ a f, x = ⟨a, f⟩ ∧ ∀ i, p (f i) := by
  constructor
  · rintro ⟨y, hy⟩
    cases' h : y with a f
    refine' ⟨a, fun i => (f i).val, _, fun i => (f i).property⟩
    rw [← hy, h, PFunctor.map_eq]
    congr
  rintro ⟨a, f, xeq, pf⟩
  use ⟨a, fun i => ⟨f i, pf i⟩⟩
  rw [xeq]; rfl
#align pfunctor.liftp_iff PFunctor.liftp_iff

theorem liftp_iff' {α : Type u} (p : α → Prop) (a : P.A) (f : P.B a → α) :
    @Liftp.{u} P.Obj _ α p ⟨a, f⟩ ↔ ∀ i, p (f i) := by
  simp only [liftp_iff, Sigma.mk.inj_iff]; constructor <;> intro h
  · rcases h with ⟨a', f', heq, h'⟩
    cases heq
    assumption
  repeat' first |constructor|assumption
#align pfunctor.liftp_iff' PFunctor.liftp_iff'

theorem liftr_iff {α : Type u} (r : α → α → Prop) (x y : P.Obj α) :
    Liftr r x y ↔ ∃ a f₀ f₁, x = ⟨a, f₀⟩ ∧ y = ⟨a, f₁⟩ ∧ ∀ i, r (f₀ i) (f₁ i) := by
  constructor
  · rintro ⟨u, xeq, yeq⟩
    cases' h : u with a f
    use a, fun i => (f i).val.fst, fun i => (f i).val.snd
    constructor
    · rw [← xeq, h]
      rfl
    constructor
    · rw [← yeq, h]
      rfl
    intro i
    exact (f i).property
  rintro ⟨a, f₀, f₁, xeq, yeq, h⟩
  use ⟨a, fun i => ⟨(f₀ i, f₁ i), h i⟩⟩
  constructor
  · rw [xeq]
    rfl
  rw [yeq]; rfl
#align pfunctor.liftr_iff PFunctor.liftr_iff

open Set

theorem supp_eq {α : Type u} (a : P.A) (f : P.B a → α) :
    @supp.{u} P.Obj _ α (⟨a, f⟩ : P.Obj α) = f '' univ := by
  ext x; simp only [supp, image_univ, mem_range, mem_setOf_eq]
  constructor <;> intro h
  · apply @h fun x => ∃ y : P.B a, f y = x
    rw [liftp_iff']
    intro
    refine' ⟨_, rfl⟩
  · simp only [liftp_iff']
    cases h
    subst x
    tauto
#align pfunctor.supp_eq PFunctor.supp_eq

end PFunctor


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import algebra.hom.ring
import data.nat.basic

/-!
# Power operations on monoids and groups

The power operation on monoids and groups.
We separate this from group, because it depends on `ℕ`,
which in turn depends on other parts of algebra.

This module contains lemmas about `a ^ n` and `n • a`, where `n : ℕ` or `n : ℤ`.
Further lemmas can be found in `algebra.group_power.lemmas`.

The analogous results for groups with zero can be found in `algebra.group_with_zero.power`.

## Notation

- `a ^ n` is used as notation for `has_pow.pow a n`; in this file `n : ℕ` or `n : ℤ`.
- `n • a` is used as notation for `has_scalar.smul n a`; in this file `n : ℕ` or `n : ℤ`.

## Implementation details

We adopt the convention that `0^0 = 1`.
-/

universes u v w x y z u₁ u₂

variables {α : Type*} {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z}
  {R : Type u₁} {S : Type u₂}

/-!
### Commutativity

First we prove some facts about `semiconj_by` and `commute`. They do not require any theory about
`pow` and/or `nsmul` and will be useful later in this file.
-/

section has_pow
variables [has_pow M ℕ]

@[simp] lemma pow_ite (P : Prop) [decidable P] (a : M) (b c : ℕ) :
  a ^ (if P then b else c) = if P then a ^ b else a ^ c :=
by split_ifs; refl

@[simp] lemma ite_pow (P : Prop) [decidable P] (a b : M) (c : ℕ) :
  (if P then a else b) ^ c = if P then a ^ c else b ^ c :=
by split_ifs; refl

end has_pow

section monoid
variables [monoid M] [monoid N] [add_monoid A] [add_monoid B]

@[simp, to_additive one_nsmul]
theorem pow_one (a : M) : a^1 = a :=
by rw [pow_succ, pow_zero, mul_one]

/-- Note that most of the lemmas about powers of two refer to it as `sq`. -/
@[to_additive two_nsmul, nolint to_additive_doc]
theorem pow_two (a : M) : a^2 = a * a :=
by rw [pow_succ, pow_one]

alias pow_two ← sq

@[to_additive]
theorem pow_mul_comm' (a : M) (n : ℕ) : a^n * a = a * a^n := commute.pow_self a n

@[to_additive add_nsmul]
theorem pow_add (a : M) (m n : ℕ) : a^(m + n) = a^m * a^n :=
by induction n with n ih; [rw [nat.add_zero, pow_zero, mul_one],
  rw [pow_succ', ← mul_assoc, ← ih, ← pow_succ', nat.add_assoc]]

@[simp] lemma pow_boole (P : Prop) [decidable P] (a : M) :
  a ^ (if P then 1 else 0) = if P then a else 1 :=
by simp

-- the attributes are intentionally out of order. `smul_zero` proves `nsmul_zero`.
@[to_additive nsmul_zero, simp] theorem one_pow (n : ℕ) : (1 : M)^n = 1 :=
by induction n with n ih; [exact pow_zero _, rw [pow_succ, ih, one_mul]]

@[to_additive mul_nsmul']
theorem pow_mul (a : M) (m n : ℕ) : a^(m * n) = (a^m)^n :=
begin
  induction n with n ih,
  { rw [nat.mul_zero, pow_zero, pow_zero] },
  { rw [nat.mul_succ, pow_add, pow_succ', ih] }
end

@[to_additive nsmul_left_comm]
lemma pow_right_comm (a : M) (m n : ℕ) : (a^m)^n = (a^n)^m :=
by rw [←pow_mul, nat.mul_comm, pow_mul]

@[to_additive mul_nsmul]
theorem pow_mul' (a : M) (m n : ℕ) : a^(m * n) = (a^n)^m :=
by rw [nat.mul_comm, pow_mul]

@[to_additive nsmul_add_sub_nsmul]
theorem pow_mul_pow_sub (a : M) {m n : ℕ} (h : m ≤ n) : a ^ m * a ^ (n - m) = a ^ n :=
by rw [←pow_add, nat.add_comm, tsub_add_cancel_of_le h]

@[to_additive sub_nsmul_nsmul_add]
theorem pow_sub_mul_pow (a : M) {m n : ℕ} (h : m ≤ n) : a ^ (n - m) * a ^ m = a ^ n :=
by rw [←pow_add, tsub_add_cancel_of_le h]

/-- If `x ^ n = 1`, then `x ^ m` is the same as `x ^ (m % n)` -/
@[to_additive nsmul_eq_mod_nsmul "If `n • x = 0`, then `m • x` is the same as `(m % n) • x`"]
lemma pow_eq_pow_mod {M : Type*} [monoid M] {x : M} (m : ℕ) {n : ℕ} (h : x ^ n = 1) :
  x ^ m = x ^ (m % n) :=
begin
  have t := congr_arg (λ a, x ^ a) (nat.div_add_mod m n).symm,
  dsimp at t,
  rw [t, pow_add, pow_mul, h, one_pow, one_mul],
end

@[to_additive bit0_nsmul]
theorem pow_bit0 (a : M) (n : ℕ) : a ^ bit0 n = a^n * a^n := pow_add _ _ _

@[to_additive bit1_nsmul]
theorem pow_bit1 (a : M) (n : ℕ) : a ^ bit1 n = a^n * a^n * a :=
by rw [bit1, pow_succ', pow_bit0]

@[to_additive]
theorem pow_mul_comm (a : M) (m n : ℕ) : a^m * a^n = a^n * a^m :=
commute.pow_pow_self a m n

@[to_additive]
lemma commute.mul_pow {a b : M} (h : commute a b) (n : ℕ) : (a * b) ^ n = a ^ n * b ^ n :=
nat.rec_on n (by simp only [pow_zero, one_mul]) $ λ n ihn,
by simp only [pow_succ, ihn, ← mul_assoc, (h.pow_left n).right_comm]

@[to_additive bit0_nsmul']
theorem pow_bit0' (a : M) (n : ℕ) : a ^ bit0 n = (a * a) ^ n :=
by rw [pow_bit0, (commute.refl a).mul_pow]

@[to_additive bit1_nsmul']
theorem pow_bit1' (a : M) (n : ℕ) : a ^ bit1 n = (a * a) ^ n * a :=
by rw [bit1, pow_succ', pow_bit0']

lemma dvd_pow {x y : M} (hxy : x ∣ y) :
  ∀ {n : ℕ} (hn : n ≠ 0), x ∣ y^n
| 0       hn := (hn rfl).elim
| (n + 1) hn := by { rw pow_succ, exact hxy.mul_right _ }

alias dvd_pow ← has_dvd.dvd.pow

lemma dvd_pow_self (a : M) {n : ℕ} (hn : n ≠ 0) : a ∣ a^n :=
dvd_rfl.pow hn

end monoid

/-!
### Commutative (additive) monoid
-/

section comm_monoid
variables [comm_monoid M] [add_comm_monoid A]

@[to_additive nsmul_add]
theorem mul_pow (a b : M) (n : ℕ) : (a * b)^n = a^n * b^n :=
(commute.all a b).mul_pow n

/-- The `n`th power map on a commutative monoid for a natural `n`, considered as a morphism of
monoids. -/
@[to_additive "Multiplication by a natural `n` on a commutative additive
monoid, considered as a morphism of additive monoids.", simps]
def pow_monoid_hom (n : ℕ) : M →* M :=
{ to_fun := (^ n),
  map_one' := one_pow _,
  map_mul' := λ a b, mul_pow a b n }

-- the below line causes the linter to complain :-/
-- attribute [simps] pow_monoid_hom nsmul_add_monoid_hom

end comm_monoid

section div_inv_monoid
variable [div_inv_monoid G]

open int

@[simp, to_additive one_zsmul]
theorem zpow_one (a : G) : a ^ (1:ℤ) = a :=
by { convert pow_one a using 1, exact zpow_coe_nat a 1 }

@[to_additive two_zsmul]
theorem zpow_two (a : G) : a ^ (2 : ℤ) = a * a :=
by { convert pow_two a using 1, exact zpow_coe_nat a 2 }

@[to_additive neg_one_zsmul]
theorem zpow_neg_one (x : G) : x ^ (-1:ℤ) = x⁻¹ :=
(zpow_neg_succ_of_nat x 0).trans $ congr_arg has_inv.inv (pow_one x)

@[to_additive]
theorem zpow_neg_coe_of_pos (a : G) : ∀ {n : ℕ}, 0 < n → a ^ -(n:ℤ) = (a ^ n)⁻¹
| (n+1) _ := zpow_neg_succ_of_nat _ _

end div_inv_monoid

section division_monoid
variables [division_monoid α] {a b : α}

@[simp, to_additive] lemma inv_pow (a : α) : ∀ n : ℕ, (a⁻¹) ^ n = (a ^ n)⁻¹
| 0       := by rw [pow_zero, pow_zero, inv_one]
| (n + 1) := by rw [pow_succ', pow_succ, inv_pow, mul_inv_rev]

-- the attributes are intentionally out of order. `smul_zero` proves `zsmul_zero`.
@[to_additive zsmul_zero, simp] lemma one_zpow : ∀ (n : ℤ), (1 : α) ^ n = 1
| (n : ℕ) := by rw [zpow_coe_nat, one_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, inv_one]

@[simp, to_additive neg_zsmul] lemma zpow_neg (a : α) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := div_inv_monoid.zpow_neg' _ _
| 0       := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp }
| -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_inv, ← zpow_coe_nat], refl }

@[to_additive neg_one_zsmul_add]
lemma mul_zpow_neg_one (a b : α) : (a * b) ^ (-1 : ℤ) = b ^ (-1 : ℤ) * a ^ (-1 : ℤ) :=
by simp_rw [zpow_neg_one, mul_inv_rev]

@[to_additive zsmul_neg] lemma inv_zpow (a : α) : ∀ n : ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := by rw [zpow_coe_nat, zpow_coe_nat, inv_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_pow]

@[simp, to_additive zsmul_neg']
lemma inv_zpow' (a : α) (n : ℤ) : a⁻¹ ^ n = a ^ (-n) := by rw [inv_zpow, zpow_neg]

@[to_additive nsmul_zero_sub]
lemma one_div_pow (a : α) (n : ℕ) : (1 / a) ^ n = 1 / a ^ n := by simp_rw [one_div, inv_pow]

@[to_additive zsmul_zero_sub]
lemma one_div_zpow (a : α) (n : ℤ) :  (1 / a) ^ n = 1 / a ^ n := by simp_rw [one_div, inv_zpow]

@[to_additive add_commute.zsmul_add]
protected lemma commute.mul_zpow (h : commute a b) : ∀ (i : ℤ), (a * b) ^ i = a ^ i * b ^ i
| (n : ℕ) := by simp [h.mul_pow n]
| -[1+n]  := by simp [h.mul_pow, (h.pow_pow _ _).eq, mul_inv_rev]

end division_monoid

section division_comm_monoid
variables [division_comm_monoid α]

@[to_additive zsmul_add] lemma mul_zpow (a b : α) : ∀ n : ℤ, (a * b) ^ n = a ^ n * b ^ n :=
(commute.all a b).mul_zpow

@[simp, to_additive nsmul_sub] lemma div_pow (a b : α) (n : ℕ) : (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_pow, inv_pow]

@[simp, to_additive zsmul_sub] lemma div_zpow (a b : α) (n : ℤ) : (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_zpow, inv_zpow]

/-- The `n`-th power map (for an integer `n`) on a commutative group, considered as a group
homomorphism. -/
@[to_additive "Multiplication by an integer `n` on a commutative additive group, considered as an
additive group homomorphism.", simps]
def zpow_group_hom (n : ℤ) : α →* α :=
{ to_fun := (^ n),
  map_one' := one_zpow n,
  map_mul' := λ a b, mul_zpow a b n }

end division_comm_monoid

section group
variables [group G] [group H] [add_group A] [add_group B]

@[to_additive sub_nsmul] lemma pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a^(m - n) = a^m * (a^n)⁻¹ :=
eq_mul_inv_of_mul_eq $ by rw [←pow_add, tsub_add_cancel_of_le h]

@[to_additive] lemma pow_inv_comm (a : G) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m :=
(commute.refl a).inv_left.pow_pow _ _

@[to_additive sub_nsmul_neg]
lemma inv_pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a⁻¹^(m - n) = (a^m)⁻¹ * a^n :=
by rw [pow_sub a⁻¹ h, inv_pow, inv_pow, inv_inv]

end group

lemma zero_pow [monoid_with_zero R] : ∀ {n : ℕ}, 0 < n → (0 : R) ^ n = 0
| (n+1) _ := by rw [pow_succ, zero_mul]

lemma zero_pow_eq [monoid_with_zero R] (n : ℕ) : (0 : R)^n = if n = 0 then 1 else 0 :=
begin
  split_ifs with h,
  { rw [h, pow_zero], },
  { rw [zero_pow (nat.pos_of_ne_zero h)] },
end

lemma pow_eq_zero_of_le [monoid_with_zero M] {x : M} {n m : ℕ}
  (hn : n ≤ m) (hx : x^n = 0) : x^m = 0 :=
by rw [← tsub_add_cancel_of_le hn, pow_add, hx, mul_zero]

namespace ring_hom

variables [semiring R] [semiring S]

protected lemma map_pow (f : R →+* S) (a) :
  ∀ n : ℕ, f (a ^ n) = (f a) ^ n :=
map_pow f a

end ring_hom

section pow_monoid_with_zero_hom

variables [comm_monoid_with_zero M] {n : ℕ} (hn : 0 < n)
include M hn

/-- We define `x ↦ x^n` (for positive `n : ℕ`) as a `monoid_with_zero_hom` -/
def pow_monoid_with_zero_hom : M →*₀ M :=
{ map_zero' := zero_pow hn,
  ..pow_monoid_hom n }

@[simp]
lemma coe_pow_monoid_with_zero_hom : (pow_monoid_with_zero_hom hn : M → M) = (^ n) := rfl

@[simp]
lemma pow_monoid_with_zero_hom_apply (a : M) : pow_monoid_with_zero_hom hn a = a ^ n := rfl

end pow_monoid_with_zero_hom

lemma pow_dvd_pow [monoid R] (a : R) {m n : ℕ} (h : m ≤ n) :
  a ^ m ∣ a ^ n := ⟨a ^ (n - m), by rw [← pow_add, nat.add_comm, tsub_add_cancel_of_le h]⟩

theorem pow_dvd_pow_of_dvd [comm_monoid R] {a b : R} (h : a ∣ b) : ∀ n : ℕ, a ^ n ∣ b ^ n
| 0     := by rw [pow_zero, pow_zero]
| (n+1) := by { rw [pow_succ, pow_succ], exact mul_dvd_mul h (pow_dvd_pow_of_dvd n) }

theorem pow_eq_zero [monoid_with_zero R] [no_zero_divisors R] {x : R} {n : ℕ} (H : x^n = 0) :
  x = 0 :=
begin
  induction n with n ih,
  { rw pow_zero at H,
    rw [← mul_one x, H, mul_zero] },
  { rw pow_succ at H,
    exact or.cases_on (mul_eq_zero.1 H) id ih }
end

@[simp] lemma pow_eq_zero_iff [monoid_with_zero R] [no_zero_divisors R]
  {a : R} {n : ℕ} (hn : 0 < n) :
  a ^ n = 0 ↔ a = 0 :=
begin
  refine ⟨pow_eq_zero, _⟩,
  rintros rfl,
  exact zero_pow hn,
end

lemma pow_eq_zero_iff' [monoid_with_zero R] [no_zero_divisors R] [nontrivial R]
  {a : R} {n : ℕ} :
  a ^ n = 0 ↔ a = 0 ∧ n ≠ 0 :=
by cases (zero_le n).eq_or_gt; simp [*, ne_of_gt]

lemma pow_ne_zero_iff [monoid_with_zero R] [no_zero_divisors R] {a : R} {n : ℕ} (hn : 0 < n) :
  a ^ n ≠ 0 ↔ a ≠ 0 :=
(pow_eq_zero_iff hn).not

@[field_simps] theorem pow_ne_zero [monoid_with_zero R] [no_zero_divisors R]
  {a : R} (n : ℕ) (h : a ≠ 0) : a ^ n ≠ 0 :=
mt pow_eq_zero h

theorem sq_eq_zero_iff [monoid_with_zero R] [no_zero_divisors R] {a : R} : a ^ 2 = 0 ↔ a = 0 :=
pow_eq_zero_iff two_pos

lemma pow_dvd_pow_iff [cancel_comm_monoid_with_zero R]
  {x : R} {n m : ℕ} (h0 : x ≠ 0) (h1 : ¬ is_unit x) :
  x ^ n ∣ x ^ m ↔ n ≤ m :=
begin
  split,
  { intro h, rw [← not_lt], intro hmn, apply h1,
    have : x ^ m * x ∣ x ^ m * 1,
    { rw [← pow_succ', mul_one], exact (pow_dvd_pow _ (nat.succ_le_of_lt hmn)).trans h },
    rwa [mul_dvd_mul_iff_left, ← is_unit_iff_dvd_one] at this, apply pow_ne_zero m h0 },
  { apply pow_dvd_pow }
end

section semiring
variables [semiring R]

lemma min_pow_dvd_add {n m : ℕ} {a b c : R} (ha : c ^ n ∣ a) (hb : c ^ m ∣ b) :
  c ^ (min n m) ∣ a + b :=
begin
  replace ha := (pow_dvd_pow c (min_le_left n m)).trans ha,
  replace hb := (pow_dvd_pow c (min_le_right n m)).trans hb,
  exact dvd_add ha hb
end

end semiring

section comm_semiring
variables [comm_semiring R]

lemma add_sq (a b : R) : (a + b) ^ 2 = a ^ 2 + 2 * a * b + b ^ 2 :=
by simp only [sq, add_mul_self_eq]

lemma add_sq' (a b : R) : (a + b) ^ 2 = a ^ 2 + b ^ 2 + 2 * a * b :=
by rw [add_sq, add_assoc, add_comm _ (b ^ 2), add_assoc]

alias add_sq ← add_pow_two

end comm_semiring

section has_distrib_neg
variables [monoid R] [has_distrib_neg R]

variables (R)
theorem neg_one_pow_eq_or : ∀ n : ℕ, (-1 : R)^n = 1 ∨ (-1 : R)^n = -1
| 0     := or.inl (pow_zero _)
| (n+1) := (neg_one_pow_eq_or n).swap.imp
  (λ h, by rw [pow_succ, h, neg_one_mul, neg_neg])
  (λ h, by rw [pow_succ, h, mul_one])
variables {R}

theorem neg_pow (a : R) (n : ℕ) : (- a) ^ n = (-1) ^ n * a ^ n :=
(neg_one_mul a) ▸ (commute.neg_one_left a).mul_pow n

@[simp] theorem neg_pow_bit0 (a : R) (n : ℕ) : (- a) ^ (bit0 n) = a ^ (bit0 n) :=
by rw [pow_bit0', neg_mul_neg, pow_bit0']

@[simp] theorem neg_pow_bit1 (a : R) (n : ℕ) : (- a) ^ (bit1 n) = - a ^ (bit1 n) :=
by simp only [bit1, pow_succ, neg_pow_bit0, neg_mul_eq_neg_mul]

@[simp] lemma neg_sq (a : R) : (-a) ^ 2 = a ^ 2 := by simp [sq]
@[simp] lemma neg_one_sq : (-1 : R) ^ 2 = 1 := by rw [neg_sq, one_pow]

alias neg_sq ← neg_pow_two
alias neg_one_sq ← neg_one_pow_two

end has_distrib_neg

section ring
variables [ring R] {a b : R}

protected lemma commute.sq_sub_sq (h : commute a b) : a ^ 2 - b ^ 2 = (a + b) * (a - b) :=
by rw [sq, sq, h.mul_self_sub_mul_self_eq]

@[simp]
lemma neg_one_pow_mul_eq_zero_iff {n : ℕ} {r : R} : (-1)^n * r = 0 ↔ r = 0 :=
by rcases neg_one_pow_eq_or R n; simp [h]

@[simp]
lemma mul_neg_one_pow_eq_zero_iff {n : ℕ} {r : R} : r * (-1)^n = 0 ↔ r = 0 :=
by rcases neg_one_pow_eq_or R n; simp [h]

variables [no_zero_divisors R]

protected lemma commute.sq_eq_sq_iff_eq_or_eq_neg (h : commute a b) :
  a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b :=
by rw [←sub_eq_zero, h.sq_sub_sq, mul_eq_zero, add_eq_zero_iff_eq_neg, sub_eq_zero, or_comm]

@[simp] lemma sq_eq_one_iff : a^2 = 1 ↔ a = 1 ∨ a = -1 :=
by rw [←(commute.one_right a).sq_eq_sq_iff_eq_or_eq_neg, one_pow]

lemma sq_ne_one_iff : a^2 ≠ 1 ↔ a ≠ 1 ∧ a ≠ -1 := sq_eq_one_iff.not.trans not_or_distrib

end ring

section comm_ring
variables [comm_ring R]

lemma sq_sub_sq (a b : R) : a ^ 2 - b ^ 2 = (a + b) * (a - b) := (commute.all a b).sq_sub_sq

alias sq_sub_sq ← pow_two_sub_pow_two

lemma sub_sq (a b : R) : (a - b) ^ 2 = a ^ 2 - 2 * a * b + b ^ 2 :=
by rw [sub_eq_add_neg, add_sq, neg_sq, mul_neg, ← sub_eq_add_neg]

alias sub_sq ← sub_pow_two

lemma sub_sq' (a b : R) : (a - b) ^ 2 = a ^ 2 + b ^ 2 - 2 * a * b :=
by rw [sub_eq_add_neg, add_sq', neg_sq, mul_neg, ← sub_eq_add_neg]

variables [no_zero_divisors R] {a b : R}

lemma sq_eq_sq_iff_eq_or_eq_neg : a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b :=
(commute.all a b).sq_eq_sq_iff_eq_or_eq_neg

lemma eq_or_eq_neg_of_sq_eq_sq (a b : R) : a ^ 2 = b ^ 2 → a = b ∨ a = -b :=
sq_eq_sq_iff_eq_or_eq_neg.1

/- Copies of the above comm_ring lemmas for `units R`. -/
namespace units

protected lemma sq_eq_sq_iff_eq_or_eq_neg {a b : Rˣ} : a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b :=
by simp_rw [ext_iff, coe_pow, sq_eq_sq_iff_eq_or_eq_neg, units.coe_neg]

protected lemma eq_or_eq_neg_of_sq_eq_sq (a b : Rˣ) (h : a ^ 2 = b ^ 2) : a = b ∨ a = -b :=
units.sq_eq_sq_iff_eq_or_eq_neg.1 h

end units

end comm_ring

lemma of_add_nsmul [add_monoid A] (x : A) (n : ℕ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_add_zsmul [sub_neg_monoid A] (x : A) (n : ℤ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_mul_pow [monoid A] (x : A) (n : ℕ) :
  additive.of_mul (x ^ n) = n • (additive.of_mul x) := rfl

lemma of_mul_zpow [div_inv_monoid G] (x : G) (n : ℤ) :
  additive.of_mul (x ^ n) = n • additive.of_mul x :=
rfl

@[simp, to_additive]
lemma semiconj_by.zpow_right [group G] {a x y : G} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (x^m) (y^m)
| (n : ℕ) := by simp [zpow_coe_nat, h.pow_right n]
| -[1+n] := by simp [(h.pow_right n.succ).inv_right]

namespace commute

variables [group G] {a b : G}

@[simp, to_additive] lemma zpow_right (h : commute a b) (m : ℤ) : commute a (b^m) := h.zpow_right m

@[simp, to_additive] lemma zpow_left (h : commute a b) (m : ℤ) : commute (a^m) b :=
(h.symm.zpow_right m).symm

@[to_additive]
lemma zpow_zpow (h : commute a b) (m n : ℤ) : commute (a^m) (b^n) := (h.zpow_left m).zpow_right n

variables (a) (m n : ℤ)

@[simp, to_additive] lemma self_zpow : commute a (a ^ n) := (commute.refl a).zpow_right n
@[simp, to_additive] lemma zpow_self : commute (a ^ n) a := (commute.refl a).zpow_left n
@[simp, to_additive] lemma zpow_zpow_self : commute (a ^ m) (a ^ n) :=
(commute.refl a).zpow_zpow m n

end commute


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Yury Kudryashov, Sébastien Gouëzel, Chris Hughes
-/
import data.fin.basic
import order.pilex
/-!
# Operation on tuples

We interpret maps `Π i : fin n, α i` as `n`-tuples of elements of possibly varying type `α i`,
`(α 0, …, α (n-1))`. A particular case is `fin n → α` of elements with all the same type.
In this case when `α i` is a constant map, then tuples are isomorphic (but not definitionally equal)
to `vector`s.

We define the following operations:

* `fin.tail` : the tail of an `n+1` tuple, i.e., its last `n` entries;
* `fin.cons` : adding an element at the beginning of an `n`-tuple, to get an `n+1`-tuple;
* `fin.init` : the beginning of an `n+1` tuple, i.e., its first `n` entries;
* `fin.snoc` : adding an element at the end of an `n`-tuple, to get an `n+1`-tuple. The name `snoc`
  comes from `cons` (i.e., adding an element to the left of a tuple) read in reverse order.
* `fin.insert_nth` : insert an element to a tuple at a given position.
* `fin.find p` : returns the first index `n` where `p n` is satisfied, and `none` if it is never
  satisfied.

-/
universes u v

namespace fin

variables {m n : ℕ}
open function

section tuple

/-- There is exactly one tuple of size zero. -/
example (α : fin 0 → Sort u) : unique (Π i : fin 0, α i) :=
by apply_instance

@[simp] lemma tuple0_le {α : Π i : fin 0, Type*} [Π i, preorder (α i)] (f g : Π i, α i) : f ≤ g :=
fin_zero_elim

variables {α : fin (n+1) → Type u} (x : α 0) (q : Πi, α i) (p : Π(i : fin n), α (i.succ))
  (i : fin n) (y : α i.succ) (z : α 0)

/-- The tail of an `n+1` tuple, i.e., its last `n` entries. -/
def tail (q : Πi, α i) : (Π(i : fin n), α (i.succ)) := λ i, q i.succ

lemma tail_def {n : ℕ} {α : fin (n+1) → Type*} {q : Π i, α i} :
  tail (λ k : fin (n+1), q k) = (λ k : fin n, q k.succ) := rfl

/-- Adding an element at the beginning of an `n`-tuple, to get an `n+1`-tuple. -/
def cons (x : α 0) (p : Π(i : fin n), α (i.succ)) : Πi, α i :=
λ j, fin.cases x p j

@[simp] lemma tail_cons : tail (cons x p) = p :=
by simp [tail, cons]

@[simp] lemma cons_succ : cons x p i.succ = p i :=
by simp [cons]

@[simp] lemma cons_zero : cons x p 0 = x :=
by simp [cons]

/-- Updating a tuple and adding an element at the beginning commute. -/
@[simp] lemma cons_update : cons x (update p i y) = update (cons x p) i.succ y :=
begin
  ext j,
  by_cases h : j = 0,
  { rw h, simp [ne.symm (succ_ne_zero i)] },
  { let j' := pred j h,
    have : j'.succ = j := succ_pred j h,
    rw [← this, cons_succ],
    by_cases h' : j' = i,
    { rw h', simp },
    { have : j'.succ ≠ i.succ, by rwa [ne.def, succ_inj],
      rw [update_noteq h', update_noteq this, cons_succ] } }
end

/-- As a binary function, `fin.cons` is injective. -/
lemma cons_injective2 : function.injective2 (@cons n α) :=
λ x₀ y₀ x y h, ⟨congr_fun h 0, funext $ λ i, by simpa using congr_fun h (fin.succ i)⟩

@[simp] lemma cons_eq_cons {x₀ y₀ : α 0} {x y : Π i : fin n, α (i.succ)} :
  cons x₀ x = cons y₀ y ↔ x₀ = y₀ ∧ x = y :=
cons_injective2.eq_iff

lemma cons_left_injective (x : Π i : fin n, α (i.succ)) : function.injective (λ x₀, cons x₀ x) :=
cons_injective2.left _

lemma cons_right_injective (x₀ : α 0) : function.injective (cons x₀) :=
cons_injective2.right _

/-- Adding an element at the beginning of a tuple and then updating it amounts to adding it
directly. -/
lemma update_cons_zero : update (cons x p) 0 z = cons z p :=
begin
  ext j,
  by_cases h : j = 0,
  { rw h, simp },
  { simp only [h, update_noteq, ne.def, not_false_iff],
    let j' := pred j h,
    have : j'.succ = j := succ_pred j h,
    rw [← this, cons_succ, cons_succ] }
end

/-- Concatenating the first element of a tuple with its tail gives back the original tuple -/
@[simp] lemma cons_self_tail : cons (q 0) (tail q) = q :=
begin
  ext j,
  by_cases h : j = 0,
  { rw h, simp },
  { let j' := pred j h,
    have : j'.succ = j := succ_pred j h,
    rw [← this, tail, cons_succ] }
end

/-- Recurse on an `n+1`-tuple by splitting it into a single element and an `n`-tuple. -/
@[elab_as_eliminator]
def cons_induction {P : (Π i : fin n.succ, α i) → Sort v}
  (h : ∀ x₀ x, P (fin.cons x₀ x)) (x : (Π i : fin n.succ, α i)) : P x :=
_root_.cast (by rw cons_self_tail) $ h (x 0) (tail x)

@[simp] lemma cons_induction_cons {P : (Π i : fin n.succ, α i) → Sort v}
  (h : Π x₀ x, P (fin.cons x₀ x)) (x₀ : α 0) (x : Π i : fin n, α i.succ) :
  @cons_induction _ _ _ h (cons x₀ x) = h x₀ x :=
begin
  rw [cons_induction, cast_eq],
  congr',
  exact tail_cons _ _
end

/-- Updating the first element of a tuple does not change the tail. -/
@[simp] lemma tail_update_zero : tail (update q 0 z) = tail q :=
by { ext j, simp [tail, fin.succ_ne_zero] }

/-- Updating a nonzero element and taking the tail commute. -/
@[simp] lemma tail_update_succ :
  tail (update q i.succ y) = update (tail q) i y :=
begin
  ext j,
  by_cases h : j = i,
  { rw h, simp [tail] },
  { simp [tail, (fin.succ_injective n).ne h, h] }
end

lemma comp_cons {α : Type*} {β : Type*} (g : α → β) (y : α) (q : fin n → α) :
  g ∘ (cons y q) = cons (g y) (g ∘ q) :=
begin
  ext j,
  by_cases h : j = 0,
  { rw h, refl },
  { let j' := pred j h,
    have : j'.succ = j := succ_pred j h,
    rw [← this, cons_succ, comp_app, cons_succ] }
end

lemma comp_tail {α : Type*} {β : Type*} (g : α → β) (q : fin n.succ → α) :
  g ∘ (tail q) = tail (g ∘ q) :=
by { ext j, simp [tail] }

lemma le_cons [Π i, preorder (α i)] {x : α 0} {q : Π i, α i} {p : Π i : fin n, α i.succ} :
  q ≤ cons x p ↔ q 0 ≤ x ∧ tail q ≤ p :=
forall_fin_succ.trans $ and_congr iff.rfl $ forall_congr $ λ j, by simp [tail]

lemma cons_le [Π i, preorder (α i)] {x : α 0} {q : Π i, α i} {p : Π i : fin n, α i.succ} :
  cons x p ≤ q ↔ x ≤ q 0 ∧ p ≤ tail q :=
@le_cons  _ (λ i, order_dual (α i)) _ x q p

lemma cons_le_cons [Π i, preorder (α i)] {x₀ y₀ : α 0} {x y : Π i : fin n, α (i.succ)} :
  cons x₀ x ≤ cons y₀ y ↔ x₀ ≤ y₀ ∧ x ≤ y :=
forall_fin_succ.trans $ and_congr_right' $ by simp only [cons_succ, pi.le_def]

lemma pi_lex_lt_cons_cons {x₀ y₀ : α 0} {x y : Π i : fin n, α (i.succ)}
  (s : Π {i : fin n.succ}, α i → α i → Prop) :
  pi.lex (<) @s (fin.cons x₀ x) (fin.cons y₀ y) ↔
    s x₀ y₀ ∨ x₀ = y₀ ∧ pi.lex (<) (λ i : fin n, @s i.succ) x y :=
begin
  simp_rw [pi.lex, fin.exists_fin_succ, fin.cons_succ, fin.cons_zero, fin.forall_fin_succ],
  simp [and_assoc, exists_and_distrib_left],
end

@[simp]
lemma range_cons {α : Type*} {n : ℕ} (x : α) (b : fin n → α) :
  set.range (fin.cons x b : fin n.succ → α) = insert x (set.range b) :=
begin
  ext y,
  simp only [set.mem_range, set.mem_insert_iff],
  split,
  { rintros ⟨i, rfl⟩,
    refine cases (or.inl (cons_zero _ _)) (λ i, or.inr ⟨i, _⟩) i,
    rw cons_succ },
  { rintros (rfl | ⟨i, hi⟩),
    { exact ⟨0, fin.cons_zero _ _⟩ },
    { refine ⟨i.succ, _⟩,
      rw [cons_succ, hi] } }
end

/-- `fin.append ho u v` appends two vectors of lengths `m` and `n` to produce
one of length `o = m + n`.  `ho` provides control of definitional equality
for the vector length. -/
def append {α : Type*} {o : ℕ} (ho : o = m + n) (u : fin m → α) (v : fin n → α) : fin o → α :=
λ i, if h : (i : ℕ) < m
  then u ⟨i, h⟩
  else v ⟨(i : ℕ) - m, (tsub_lt_iff_left (le_of_not_lt h)).2 (ho ▸ i.property)⟩

@[simp] lemma fin_append_apply_zero {α : Type*} {o : ℕ} (ho : (o + 1) = (m + 1) + n)
  (u : fin (m + 1) → α) (v : fin n → α) :
  fin.append ho u v 0 = u 0 := rfl

end tuple

section tuple_right
/-! In the previous section, we have discussed inserting or removing elements on the left of a
tuple. In this section, we do the same on the right. A difference is that `fin (n+1)` is constructed
inductively from `fin n` starting from the left, not from the right. This implies that Lean needs
more help to realize that elements belong to the right types, i.e., we need to insert casts at
several places. -/

variables {α : fin (n+1) → Type u} (x : α (last n)) (q : Πi, α i) (p : Π(i : fin n), α i.cast_succ)
(i : fin n) (y : α i.cast_succ) (z : α (last n))

/-- The beginning of an `n+1` tuple, i.e., its first `n` entries -/
def init (q : Πi, α i) (i : fin n) : α i.cast_succ :=
q i.cast_succ

lemma init_def {n : ℕ} {α : fin (n+1) → Type*} {q : Π i, α i} :
  init (λ k : fin (n+1), q k) = (λ k : fin n, q k.cast_succ) := rfl

/-- Adding an element at the end of an `n`-tuple, to get an `n+1`-tuple. The name `snoc` comes from
`cons` (i.e., adding an element to the left of a tuple) read in reverse order. -/
def snoc (p : Π(i : fin n), α i.cast_succ) (x : α (last n)) (i : fin (n+1)) : α i :=
if h : i.val < n
then _root_.cast (by rw fin.cast_succ_cast_lt i h) (p (cast_lt i h))
else _root_.cast (by rw eq_last_of_not_lt h) x

@[simp] lemma init_snoc : init (snoc p x) = p :=
begin
  ext i,
  have h' := fin.cast_lt_cast_succ i i.is_lt,
  simp [init, snoc, i.is_lt, h'],
  convert cast_eq rfl (p i)
end

@[simp] lemma snoc_cast_succ : snoc p x i.cast_succ = p i :=
begin
  have : i.cast_succ.val < n := i.is_lt,
  have h' := fin.cast_lt_cast_succ i i.is_lt,
  simp [snoc, this, h'],
  convert cast_eq rfl (p i)
end

@[simp] lemma snoc_comp_cast_succ {n : ℕ} {α : Sort*} {a : α} {f : fin n → α} :
  (snoc f a : fin (n + 1) → α) ∘ cast_succ = f :=
funext (λ i, by rw [function.comp_app, snoc_cast_succ])

@[simp] lemma snoc_last : snoc p x (last n) = x :=
by { simp [snoc] }

/-- Updating a tuple and adding an element at the end commute. -/
@[simp] lemma snoc_update : snoc (update p i y) x = update (snoc p x) i.cast_succ y :=
begin
  ext j,
  by_cases h : j.val < n,
  { simp only [snoc, h, dif_pos],
    by_cases h' : j = cast_succ i,
    { have C1 : α i.cast_succ = α j, by rw h',
      have E1 : update (snoc p x) i.cast_succ y j = _root_.cast C1 y,
      { have : update (snoc p x) j (_root_.cast C1 y) j = _root_.cast C1 y, by simp,
        convert this,
        { exact h'.symm },
        { exact heq_of_cast_eq (congr_arg α (eq.symm h')) rfl } },
      have C2 : α i.cast_succ = α (cast_succ (cast_lt j h)),
        by rw [cast_succ_cast_lt, h'],
      have E2 : update p i y (cast_lt j h) = _root_.cast C2 y,
      { have : update p (cast_lt j h) (_root_.cast C2 y) (cast_lt j h) = _root_.cast C2 y,
          by simp,
        convert this,
        { simp [h, h'] },
        { exact heq_of_cast_eq C2 rfl } },
      rw [E1, E2],
      exact eq_rec_compose _ _ _ },
    { have : ¬(cast_lt j h = i),
        by { assume E, apply h', rw [← E, cast_succ_cast_lt] },
      simp [h', this, snoc, h] } },
  { rw eq_last_of_not_lt h,
    simp [ne.symm (ne_of_lt (cast_succ_lt_last i))] }
end

/-- Adding an element at the beginning of a tuple and then updating it amounts to adding it
directly. -/
lemma update_snoc_last : update (snoc p x) (last n) z = snoc p z :=
begin
  ext j,
  by_cases h : j.val < n,
  { have : j ≠ last n := ne_of_lt h,
    simp [h, update_noteq, this, snoc] },
  { rw eq_last_of_not_lt h,
    simp }
end

/-- Concatenating the first element of a tuple with its tail gives back the original tuple -/
@[simp] lemma snoc_init_self : snoc (init q) (q (last n)) = q :=
begin
  ext j,
  by_cases h : j.val < n,
  { have : j ≠ last n := ne_of_lt h,
    simp [h, update_noteq, this, snoc, init, cast_succ_cast_lt],
    have A : cast_succ (cast_lt j h) = j := cast_succ_cast_lt _ _,
    rw ← cast_eq rfl (q j),
    congr' 1; rw A },
  { rw eq_last_of_not_lt h,
    simp }
end

/-- Updating the last element of a tuple does not change the beginning. -/
@[simp] lemma init_update_last : init (update q (last n) z) = init q :=
by { ext j, simp [init, ne_of_lt, cast_succ_lt_last] }

/-- Updating an element and taking the beginning commute. -/
@[simp] lemma init_update_cast_succ :
  init (update q i.cast_succ y) = update (init q) i y :=
begin
  ext j,
  by_cases h : j = i,
  { rw h, simp [init] },
  { simp [init, h] }
end

/-- `tail` and `init` commute. We state this lemma in a non-dependent setting, as otherwise it
would involve a cast to convince Lean that the two types are equal, making it harder to use. -/
lemma tail_init_eq_init_tail {β : Type*} (q : fin (n+2) → β) :
  tail (init q) = init (tail q) :=
by { ext i, simp [tail, init, cast_succ_fin_succ] }

/-- `cons` and `snoc` commute. We state this lemma in a non-dependent setting, as otherwise it
would involve a cast to convince Lean that the two types are equal, making it harder to use. -/
lemma cons_snoc_eq_snoc_cons {β : Type*} (a : β) (q : fin n → β) (b : β) :
  @cons n.succ (λ i, β) a (snoc q b) = snoc (cons a q) b :=
begin
  ext i,
  by_cases h : i = 0,
  { rw h, refl },
  set j := pred i h with ji,
  have : i = j.succ, by rw [ji, succ_pred],
  rw [this, cons_succ],
  by_cases h' : j.val < n,
  { set k := cast_lt j h' with jk,
    have : j = k.cast_succ, by rw [jk, cast_succ_cast_lt],
    rw [this, ← cast_succ_fin_succ],
    simp },
  rw [eq_last_of_not_lt h', succ_last],
  simp
end

lemma comp_snoc {α : Type*} {β : Type*} (g : α → β) (q : fin n → α) (y : α) :
  g ∘ (snoc q y) = snoc (g ∘ q) (g y) :=
begin
  ext j,
  by_cases h : j.val < n,
  { have : j ≠ last n := ne_of_lt h,
    simp [h, this, snoc, cast_succ_cast_lt] },
  { rw eq_last_of_not_lt h,
    simp }
end

lemma comp_init {α : Type*} {β : Type*} (g : α → β) (q : fin n.succ → α) :
  g ∘ (init q) = init (g ∘ q) :=
by { ext j, simp [init] }

end tuple_right

section insert_nth

variables {α : fin (n+1) → Type u} {β : Type v}

/-- Define a function on `fin (n + 1)` from a value on `i : fin (n + 1)` and values on each
`fin.succ_above i j`, `j : fin n`. This version is elaborated as eliminator and works for
propositions, see also `fin.insert_nth` for a version without an `@[elab_as_eliminator]`
attribute. -/
@[elab_as_eliminator]
def succ_above_cases {α : fin (n + 1) → Sort u} (i : fin (n + 1)) (x : α i)
  (p : Π j : fin n, α (i.succ_above j)) (j : fin (n + 1)) : α j :=
if hj : j = i then eq.rec x hj.symm
else if hlt : j < i then eq.rec_on (succ_above_cast_lt hlt) (p _)
else eq.rec_on (succ_above_pred $ (ne.lt_or_lt hj).resolve_left hlt) (p _)

lemma forall_iff_succ_above {p : fin (n + 1) → Prop} (i : fin (n + 1)) :
  (∀ j, p j) ↔ p i ∧ ∀ j, p (i.succ_above j) :=
⟨λ h, ⟨h _, λ j, h _⟩, λ h, succ_above_cases i h.1 h.2⟩

/-- Insert an element into a tuple at a given position. For `i = 0` see `fin.cons`,
for `i = fin.last n` see `fin.snoc`. See also `fin.succ_above_cases` for a version elaborated
as an eliminator. -/
def insert_nth (i : fin (n + 1)) (x : α i) (p : Π j : fin n, α (i.succ_above j)) (j : fin (n + 1)) :
  α j :=
succ_above_cases i x p j

@[simp] lemma insert_nth_apply_same (i : fin (n + 1)) (x : α i) (p : Π j, α (i.succ_above j)) :
  insert_nth i x p i = x :=
by simp [insert_nth, succ_above_cases]

@[simp] lemma insert_nth_apply_succ_above (i : fin (n + 1)) (x : α i) (p : Π j, α (i.succ_above j))
  (j : fin n) :
  insert_nth i x p (i.succ_above j) = p j :=
begin
  simp only [insert_nth, succ_above_cases, dif_neg (succ_above_ne _ _)],
  by_cases hlt : j.cast_succ < i,
  { rw [dif_pos ((succ_above_lt_iff _ _).2 hlt)],
    apply eq_of_heq ((eq_rec_heq _ _).trans _),
    rw [cast_lt_succ_above hlt] },
  { rw [dif_neg (mt (succ_above_lt_iff _ _).1 hlt)],
    apply eq_of_heq ((eq_rec_heq _ _).trans _),
    rw [pred_succ_above (le_of_not_lt hlt)] }
end

@[simp] lemma succ_above_cases_eq_insert_nth :
  @succ_above_cases.{u + 1} = @insert_nth.{u} := rfl

@[simp] lemma insert_nth_comp_succ_above (i : fin (n + 1)) (x : β) (p : fin n → β) :
  insert_nth i x p ∘ i.succ_above = p :=
funext $ insert_nth_apply_succ_above i x p

lemma insert_nth_eq_iff {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)} {q : Π j, α j} :
  i.insert_nth x p = q ↔ q i = x ∧ p = (λ j, q (i.succ_above j)) :=
by simp [funext_iff, forall_iff_succ_above i, eq_comm]

lemma eq_insert_nth_iff {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)} {q : Π j, α j} :
  q = i.insert_nth x p ↔ q i = x ∧ p = (λ j, q (i.succ_above j)) :=
eq_comm.trans insert_nth_eq_iff

lemma insert_nth_apply_below {i j : fin (n + 1)} (h : j < i) (x : α i)
  (p : Π k, α (i.succ_above k)) :
  i.insert_nth x p j = eq.rec_on (succ_above_cast_lt h) (p $ j.cast_lt _) :=
by rw [insert_nth, succ_above_cases, dif_neg h.ne, dif_pos h]

lemma insert_nth_apply_above {i j : fin (n + 1)} (h : i < j) (x : α i)
  (p : Π k, α (i.succ_above k)) :
  i.insert_nth x p j = eq.rec_on (succ_above_pred h) (p $ j.pred _) :=
by rw [insert_nth, succ_above_cases, dif_neg h.ne', dif_neg h.not_lt]

lemma insert_nth_zero (x : α 0) (p : Π j : fin n, α (succ_above 0 j)) :
  insert_nth 0 x p = cons x (λ j, _root_.cast (congr_arg α (congr_fun succ_above_zero j)) (p j)) :=
begin
  refine insert_nth_eq_iff.2 ⟨by simp, _⟩,
  ext j,
  convert (cons_succ _ _ _).symm
end

@[simp] lemma insert_nth_zero' (x : β) (p : fin n → β) :
  @insert_nth _ (λ _, β) 0 x p = cons x p :=
by simp [insert_nth_zero]

lemma insert_nth_last (x : α (last n)) (p : Π j : fin n, α ((last n).succ_above j)) :
  insert_nth (last n) x p =
    snoc (λ j, _root_.cast (congr_arg α (succ_above_last_apply j)) (p j)) x :=
begin
  refine insert_nth_eq_iff.2 ⟨by simp, _⟩,
  ext j,
  apply eq_of_heq,
  transitivity snoc (λ j, _root_.cast (congr_arg α (succ_above_last_apply j)) (p j)) x j.cast_succ,
  { rw [snoc_cast_succ], exact (cast_heq _ _).symm },
  { apply congr_arg_heq,
    rw [succ_above_last] }
end

@[simp] lemma insert_nth_last' (x : β) (p : fin n → β) :
  @insert_nth _ (λ _, β) (last n) x p = snoc p x :=
by simp [insert_nth_last]

@[simp] lemma insert_nth_zero_right [Π j, has_zero (α j)] (i : fin (n + 1)) (x : α i) :
  i.insert_nth x 0 = pi.single i x :=
insert_nth_eq_iff.2 $ by simp [succ_above_ne, pi.zero_def]

lemma insert_nth_binop (op : Π j, α j → α j → α j) (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (op i x y) (λ j, op _ (p j) (q j)) =
    λ j, op j (i.insert_nth x p j) (i.insert_nth y q j) :=
insert_nth_eq_iff.2 $ by simp

@[simp] lemma insert_nth_mul [Π j, has_mul (α j)] (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (x * y) (p * q) = i.insert_nth x p * i.insert_nth y q :=
insert_nth_binop (λ _, (*)) i x y p q

@[simp] lemma insert_nth_add [Π j, has_add (α j)] (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (x + y) (p + q) = i.insert_nth x p + i.insert_nth y q :=
insert_nth_binop (λ _, (+)) i x y p q

@[simp] lemma insert_nth_div [Π j, has_div (α j)] (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (x / y) (p / q) = i.insert_nth x p / i.insert_nth y q :=
insert_nth_binop (λ _, (/)) i x y p q

@[simp] lemma insert_nth_sub [Π j, has_sub (α j)] (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (x - y) (p - q) = i.insert_nth x p - i.insert_nth y q :=
insert_nth_binop (λ _, has_sub.sub) i x y p q

@[simp] lemma insert_nth_sub_same [Π j, add_group (α j)] (i : fin (n + 1))
  (x y : α i) (p : Π j, α (i.succ_above j)) :
  i.insert_nth x p - i.insert_nth y p = pi.single i (x - y) :=
by simp_rw [← insert_nth_sub, ← insert_nth_zero_right, pi.sub_def, sub_self, pi.zero_def]

variables [Π i, preorder (α i)]

lemma insert_nth_le_iff {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)} {q : Π j, α j} :
  i.insert_nth x p ≤ q ↔ x ≤ q i ∧ p ≤ (λ j, q (i.succ_above j)) :=
by simp [pi.le_def, forall_iff_succ_above i]

lemma le_insert_nth_iff {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)} {q : Π j, α j} :
  q ≤ i.insert_nth x p ↔ q i ≤ x ∧ (λ j, q (i.succ_above j)) ≤ p :=
by simp [pi.le_def, forall_iff_succ_above i]

open set

lemma insert_nth_mem_Icc {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)}
  {q₁ q₂ : Π j, α j} :
  i.insert_nth x p ∈ Icc q₁ q₂ ↔
    x ∈ Icc (q₁ i) (q₂ i) ∧ p ∈ Icc (λ j, q₁ (i.succ_above j)) (λ j, q₂ (i.succ_above j)) :=
by simp only [mem_Icc, insert_nth_le_iff, le_insert_nth_iff, and.assoc, and.left_comm]

lemma preimage_insert_nth_Icc_of_mem {i : fin (n + 1)} {x : α i} {q₁ q₂ : Π j, α j}
  (hx : x ∈ Icc (q₁ i) (q₂ i)) :
  i.insert_nth x ⁻¹' (Icc q₁ q₂) = Icc (λ j, q₁ (i.succ_above j)) (λ j, q₂ (i.succ_above j)) :=
set.ext $ λ p, by simp only [mem_preimage, insert_nth_mem_Icc, hx, true_and]

lemma preimage_insert_nth_Icc_of_not_mem {i : fin (n + 1)} {x : α i} {q₁ q₂ : Π j, α j}
  (hx : x ∉ Icc (q₁ i) (q₂ i)) :
  i.insert_nth x ⁻¹' (Icc q₁ q₂) = ∅ :=
set.ext $ λ p, by simp only [mem_preimage, insert_nth_mem_Icc, hx, false_and, mem_empty_eq]

end insert_nth

section find

/-- `find p` returns the first index `n` where `p n` is satisfied, and `none` if it is never
satisfied. -/
def find : Π {n : ℕ} (p : fin n → Prop) [decidable_pred p], option (fin n)
| 0     p _ := none
| (n+1) p _ := by resetI; exact option.cases_on
  (@find n (λ i, p (i.cast_lt (nat.lt_succ_of_lt i.2))) _)
  (if h : p (fin.last n) then some (fin.last n) else none)
  (λ i, some (i.cast_lt (nat.lt_succ_of_lt i.2)))

/-- If `find p = some i`, then `p i` holds -/

/-- `find p` does not return `none` if and only if `p i` holds at some index `i`. -/
lemma is_some_find_iff : Π {n : ℕ} {p : fin n → Prop} [decidable_pred p],
  by exactI (find p).is_some ↔ ∃ i, p i
| 0     p _ := iff_of_false (λ h, bool.no_confusion h) (λ ⟨i, _⟩, fin_zero_elim i)
| (n+1) p _ := ⟨λ h, begin
  rw [option.is_some_iff_exists] at h,
  cases h with i hi,
  exactI ⟨i, find_spec _ hi⟩
end, λ ⟨⟨i, hin⟩, hi⟩,
begin
  resetI,
  dsimp [find],
  cases h : find (λ i : fin n, (p (i.cast_lt (nat.lt_succ_of_lt i.2)))) with j,
  { split_ifs with hl hl,
    { exact option.is_some_some },
    { have := (@is_some_find_iff n (λ x, p (x.cast_lt (nat.lt_succ_of_lt x.2))) _).2
        ⟨⟨i, lt_of_le_of_ne (nat.le_of_lt_succ hin)
        (λ h, by clear_aux_decl; cases h; exact hl hi)⟩, hi⟩,
      rw h at this,
      exact this } },
  { simp }
end⟩

/-- `find p` returns `none` if and only if `p i` never holds. -/
lemma find_eq_none_iff {n : ℕ} {p : fin n → Prop} [decidable_pred p] :
  find p = none ↔ ∀ i, ¬ p i :=
by rw [← not_exists, ← is_some_find_iff]; cases (find p); simp

/-- If `find p` returns `some i`, then `p j` does not hold for `j < i`, i.e., `i` is minimal among
the indices where `p` holds. -/
lemma find_min : Π {n : ℕ} {p : fin n → Prop} [decidable_pred p] {i : fin n}
  (hi : i ∈ by exactI fin.find p) {j : fin n} (hj : j < i), ¬ p j
| 0     p _ i hi j hj hpj := option.no_confusion hi
| (n+1) p _ i hi ⟨j, hjn⟩ hj hpj := begin
  resetI,
  dsimp [find] at hi,
  cases h : find (λ i : fin n, (p (i.cast_lt (nat.lt_succ_of_lt i.2)))) with k,
  { rw [h] at hi,
    split_ifs at hi with hl hl,
    { have := option.some_inj.1 hi,
      subst this,
      rw [find_eq_none_iff] at h,
      exact h ⟨j, hj⟩ hpj },
    { exact option.no_confusion hi } },
  { rw h at hi,
    dsimp at hi,
    have := option.some_inj.1 hi,
    subst this,
    exact find_min h (show (⟨j, lt_trans hj k.2⟩ : fin n) < k, from hj) hpj }
end

lemma find_min' {p : fin n → Prop} [decidable_pred p] {i : fin n}
  (h : i ∈ fin.find p) {j : fin n} (hj : p j) : i ≤ j :=
le_of_not_gt (λ hij, find_min h hij hj)

lemma nat_find_mem_find {p : fin n → Prop} [decidable_pred p]
  (h : ∃ i, ∃ hin : i < n, p ⟨i, hin⟩) :
  (⟨nat.find h, (nat.find_spec h).fst⟩ : fin n) ∈ find p :=
let ⟨i, hin, hi⟩ := h in
begin
  cases hf : find p with f,
  { rw [find_eq_none_iff] at hf,
    exact (hf ⟨i, hin⟩ hi).elim },
  { refine option.some_inj.2 (le_antisymm _ _),
    { exact find_min' hf (nat.find_spec h).snd },
    { exact nat.find_min' _ ⟨f.2, by convert find_spec p hf;
        exact fin.eta _ _⟩ } }
end

lemma mem_find_iff {p : fin n → Prop} [decidable_pred p] {i : fin n} :
  i ∈ fin.find p ↔ p i ∧ ∀ j, p j → i ≤ j :=
⟨λ hi, ⟨find_spec _ hi, λ _, find_min' hi⟩,
  begin
    rintros ⟨hpi, hj⟩,
    cases hfp : fin.find p,
    { rw [find_eq_none_iff] at hfp,
      exact (hfp _ hpi).elim },
    { exact option.some_inj.2 (le_antisymm (find_min' hfp hpi) (hj _ (find_spec _ hfp))) }
  end⟩

lemma find_eq_some_iff {p : fin n → Prop} [decidable_pred p] {i : fin n} :
  fin.find p = some i ↔ p i ∧ ∀ j, p j → i ≤ j :=
 mem_find_iff

lemma mem_find_of_unique {p : fin n → Prop} [decidable_pred p]
  (h : ∀ i j, p i → p j → i = j) {i : fin n} (hi : p i) : i ∈ fin.find p :=
mem_find_iff.2 ⟨hi, λ j hj, le_of_eq $ h i j hi hj⟩

end find

end fin


import tactic
import data.real.basic
import data.pnat.basic
import measure_theory.interval_integral

local notation `|` x `|` := abs x

def is_limit (a : ℕ+ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε

def is_convergent (a : ℕ+ → ℝ) : Prop :=
∃ l : ℝ, is_limit a l

/-
1. Consider the following properties of a sequence of real numbers (a n ) n≥0 :
(i) a_n → a, or
(ii) “a_n eventually equals a” – i.e. ∃N ∈ N such that ∀n ≥ N, a n = a, or
(iii) “(a_n ) is bounded” – i.e. ∃ R ∈ R such that |a n | < R ∀n ∈ N.
For each statement (a-e) below, which of (i-iii) is it equivalent to? Proof?
(a) ∃ N ∈ N such that ∀n ≥ N, ∀ε > 0, |a n − a| < ε.
(b) ∀ε > 0 there are only finitely many n ∈ N for which |a n − a| ≥ ε.
(c) ∀N ∈ N, ∃ ε > 0 such that n ≥ N ⇒ |a n − a| < ε.
(d) ∃ ε > 0 such that ∀N ∈ N, |a n − a| < ε ∀n ≥ N .
(e) ∀R > 0 ∃ N ∈ N such that n ≥ N ⇒ a n ∈ (a − 1/R , a + 1/R ).
-/

namespace sheet4

section Q1

-- Before we start, here are some useful intermediate things
theorem eq_zero_of_non_neg_of_lt_eps (x : ℝ) (hx : 0 ≤ x) (hε : ∀ ε > 0, x < ε) : x = 0 :=
begin
  sorry
end

-- finite subsets of the naturals are bounded; proof by induction
-- on the finite set.
theorem set.nat_finite_bounded (S : set ℕ) (hS : S.finite) :
  ∃ B : ℕ, ∀ n : ℕ, n ∈ S → n ≤ B :=
begin
  apply set.finite.induction_on hS; clear hS S,
  { use 37,
    rintro n ⟨⟩ },
  { rintros a S - hS ⟨B, hB⟩,
    use max B a,
    rintros n (rfl | hnS),
    { apply le_max_right },
    { exact le_trans (hB n hnS) (le_max_left _ _)} },
end

def Q1i (an : ℕ+ → ℝ) (a : ℝ) := is_limit an a
def Q1ii (an : ℕ+ → ℝ) (a : ℝ) := ∃ N : ℕ+, ∀ n, N ≤ n → an n = a
def Q1iii (an : ℕ+ → ℝ) := ∃ R : ℝ, ∀ n : ℕ+, |an n| < R

-- Q1 instructions: change thing on RHS of ↔ to `Q1ii an a` or `Q1iii an`
-- as appropriate, then prove
theorem Q1a (an : ℕ+ → ℝ) (a : ℝ) :
  (∃ N : ℕ+, ∀ n, N ≤ n → ∀ ε, 0 < ε → |an n - a| < ε) ↔ Q1i an a :=
begin
  sorry
end

theorem Q1b (an : ℕ+ → ℝ) (a : ℝ) :
  (∀ ε, 0 < ε → {n : ℕ+ | ε ≤ |an n - a|}.finite) ↔ Q1i an a :=
begin
  sorry
end

theorem Q1c (an : ℕ+ → ℝ) (a : ℝ) :
  (∀ N : ℕ+, ∃ ε > 0, ∀ n ≥ N, |an n - a| < ε) ↔ Q1i an a :=
begin
  sorry
end

theorem Q1d (an : ℕ+ → ℝ) (a : ℝ) :
  (∃ ε > 0, ∀ N : ℕ+, ∀ n ≥ N, |an n - a| < ε) ↔ Q1i an a :=
begin
  sorry
end

open set

theorem Q1e (an : ℕ+ → ℝ) (a : ℝ) :
  (∀R > 0, ∃ N : ℕ+, ∀ n ≥ N, an n ∈ Ioo (a - 1/R) (a + 1/R)) ↔ Q1i an a :=
begin
  sorry
end

end Q1

section Q3
/-
3. Suppose that a n ≤ b n ≤ c n ∀n and that a n → a and c n → a. Prove that b n → a.
-/

theorem Q3sandwich (a b c : ℕ+ → ℝ) (l : ℝ) (hab : ∀ n, a n ≤ b n)
  (hbc : ∀ n, b n ≤ c n) (ha : is_limit a l) (hc : is_limit c l) :
  is_limit b l :=
begin
  sorry
end

end Q3

/-
4. Suppose that aₙ → 0 and (bₙ) is bounded. Prove that aₙ bₙ → 0.
-/

/-- A sequence (aₙ) is bounded if there's some R such that |aₙ|≤ R for all n. -/
def is_bounded (a : ℕ+ → ℝ) := ∃ R : ℝ, ∀ n, |a n| ≤ R

section Q4

theorem Q4 (a b : ℕ+ → ℝ) (l : ℝ) (ha : is_limit a 0) (hb : is_bounded b) :
  is_limit (λ n, a n * b n) 0 :=
begin
  sorry
end

end Q4

section Q5
-- let's do it properly

theorem is_bounded_of_is_convergent {a : ℕ+ → ℝ} (ha : is_convergent a) :
  is_bounded a :=
begin
  sorry
end

theorem limit_add_const {a : ℕ+ → ℝ} (l t : ℝ) (hal : is_limit a l) :
  is_limit (λ n, t + a n) (t + l) :=
begin
  sorry
end

theorem limit_mul_const {a : ℕ+ → ℝ} {l : ℝ} (hal : is_limit a l) (t : ℝ) :
  is_limit (λ n, t * a n) (t * l) :=
begin
  sorry
end

theorem limit_add {a b : ℕ+ → ℝ} {l m : ℝ} (hal : is_limit a l) (hbm : is_limit b m) :
  is_limit (λ n, a n + b n) (l + m) :=
begin
  sorry
end

theorem limit_zero_mul_limit_zero {a b : ℕ+ → ℝ} (hal : is_limit a 0)
  (hbm : is_limit b 0) : is_limit (λ n, a n * b n) 0 :=
begin
  sorry
end

theorem mul_limit {a b : ℕ+ → ℝ} {l m : ℝ} (hal : is_limit a l)
  (hb : is_limit b m) : is_limit (λ n, a n * b n) (l * m) :=
begin
  sorry
end

theorem inv_limit {a : ℕ+ → ℝ} {l : ℝ} (hl : l ≠ 0) (hal : is_limit a l) :
  is_limit (λ n, (a n)⁻¹) l⁻¹ :=
begin
  sorry
end

theorem div_limit {a b : ℕ+ → ℝ} {l m : ℝ} (hl : m ≠ 0) (hal : is_limit a l)
  (hb : is_limit b m) : is_limit (λ n, a n / b n) (l / m) :=
begin
  sorry
end

end Q5

section Q6

/-
6. Given functions f n : (0, 1) → R and f : (0, 1) → R, suppose we make the following
Definition: f n converges to f (or f n → f ) if and only if ∀x ∈ (0, 1), f n (x) → f (x).

Consider the examples fₙ(x) = n for x ≤ 1/n and 0 for x > 1/n. Do they converge
to some function f : (0, 1) → ℝ ? Prove your answer. Compare with the sequence
of real numbers aₙ := ∫₀¹ fₙ .
-/

open set

def fn_is_limit (fn : ℕ+ → ℝ → ℝ) (f : ℝ → ℝ) :=
  ∀ x : ℝ, x ∈ Ioo (0 : ℝ) 1 → is_limit (λ n, fn n x) (f x)

-- fill in
def flim : ℝ → ℝ := sorry

noncomputable def fn (n : ℕ+) (x : ℝ) : ℝ := if x ≤ 1 / n then n else 0

-- this is possible
theorem Q6yes : fn_is_limit fn flim :=
begin
  sorry
end

noncomputable def a (n : ℕ+) : ℝ := ∫ x in 0..1, fn n x

-- this is not
theorem a_is_one (n : ℕ+) : a n = 1 :=
begin
  -- this is basically impossible to do in Lean right now
  -- because we only just got integrals. An expert could
  -- do it no problem, but I'm not an expert!
  -- The so-called "API" is not there.
  sorry
end

end Q6

end sheet4


import ntac

example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
begin
  split,
  from hp,
  from hq
end

example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
begin
  {split,
  {from hp},
  {from hq}}
end

example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
begin
  {split,
  {exact hp},
  {exact hq}}
end

example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
begin[ntac]
  split;{trace_expr p, assumption}
end

example (p q r: Prop) (hp : p) (hq : q) : (p ∨ r) ∧ q :=
begin
split,
from or.inl hp,
from hq
end

example (p q r: Prop) (hp : p) (hq : q) : (p ∨ r) ∧ q :=
begin
suffices hpr : p ∨ r,from ⟨hpr, hq⟩,
from or.inl hp,
end

theorem sample1 (p q r: Prop) (hp : p) (hq : q) : (p ∨ r) ∧ q :=
begin[ntac]
have hpr: p ∨ r, have aaa:true := dec_trivial,
from or.inl hp,
from ⟨hpr, hq⟩,
trace_proof LANG_en, trace_proof_file LANG_en
end

theorem sample2 (p q r: Prop) (hp : p) (hq : q) : (p ∨ r) ∧ q :=
begin[ntac]
have hpr: p ∨ r,
NTAC_focus1_list {from or.inl hp} ["obviously, ",p ∨ r, ". "] tt tt,
from ⟨hpr, hq⟩,

end

example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
begin[ntac]
  NTAC_focus1_list {split} ["It suffices to show", p, " and ", q, " separately."] tt tt,
  NTAC_focus1_list {exact hp} ["we can use ", hp, " here."] tt tt,
  exact hq,
  trace_proof LANG_en,
end

example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
begin[ntac]
  NTAC_focus1_triv {split},
  exact hp,
  exact hq,
  trace_proof LANG_en,
end

example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
begin[ntac]
  NTAC_focus1_list {split} ["It suffices to show", p, " and ", q, " separately."] tt tt,
  TRIV, {exact hp} ,
  exact hq,
  trace_proof LANG_en,
end


example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c :=
  calc a
     <= b := h1
   _ <= c := h2
   _ <= c := Nat.le_refl _

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c :=
  calc a
     <= b := h1
   _ <= c := h2

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c :=
  calc a <= b := h1
  _ <= c := h2

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c :=
  calc
  a <= b := h1
  _ <= c := h2

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c :=
  calc
  a <= b := sorry
  _ <= c := h2

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c := by
  calc a
     <= b := ?h
   _ <= c := h2
  case h => exact h1

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c := by
  calc  a
      = a + 0 := rfl
   _ <= b := ?h
   _  = b := rfl
  case h => exact h1
  exact h2

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c := by
  calc  _
     <= b := ?h
   _  = b := rfl
  case h => exact h1
  exact h2

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c := by
  calc  _
     <= b := h1
   _  = b + 0 := rfl
  exact h2

example (a b c : Nat) (h1 : a <= b) (h2 : b <= c) : a <= c := by
  calc  a
     <= b := h1
   _  = b + 0 := rfl
  exact h2


/-
  First localization test. R[1/a][1/b] ≅ R[1/ab].
-/

import ring_theory.localization
import to_mathlib.localization.localization_alt

universes u v w

open localization_alt

-- Define localisation on a set of generators.

section localization_on_generators

parameters {A : Type u} {B : Type v} {C : Type w}
parameters [comm_ring A] [comm_ring B] [comm_ring C]
parameters (G : set A) (f : A → B) [is_ring_hom f]

def S : set A := monoid.closure G
instance S_submonoid : is_submonoid S := monoid.closure.is_submonoid G

def is_localization' := is_localization S f
def is_localization_data' := is_localization_data S f

end localization_on_generators

-- We show that R[1/a][1/b] = R[1/ab], i.e. is_localization' R[1/a][1/b] (a*b).

section localization_ab

parameters {R : Type u} [comm_ring R]
parameters (a b : R)

-- I need this because localization on generators is defined using monoid.closure.

lemma powers_closure_eq : ∀ x : R, powers x = S {x} :=
begin
  intros x,
  apply set.eq_of_subset_of_subset,
  { rintros y ⟨n, Hy⟩,
    revert x y,
    induction n with n Hn,
    { intros x y Hx,
      simp at Hx,
      rw ←Hx,
      exact monoid.in_closure.one {x}, },
    { intros x y Hx,
      rw pow_succ at Hx,
      have Hxx : x ∈ {x} := set.mem_singleton x,
      have Hxclo := monoid.in_closure.basic Hxx,
      have Hxnclo := Hn x (eq.refl (x ^ n)),
      rw ←Hx,
      apply monoid.in_closure.mul Hxclo Hxnclo, } },
  { intros y Hy,
    induction Hy,
    case monoid.in_closure.basic : z Hz
    { cases Hz,
      { rw Hz,
        exact ⟨1, by simp⟩, },
      { cases Hz, } },
    case monoid.in_closure.one
    { exact (powers.is_submonoid x).one_mem, },
    case monoid.in_closure.mul : x y HxS HyS Hx Hy
    { rcases Hx with ⟨n, Hx⟩,
      rcases Hy with ⟨m, Hy⟩,
      rw [←Hx, ←Hy, ←pow_add],
      exact ⟨n + m, by simp⟩, } }
end

-- Definition of R[1/a].

@[reducible] def Ra := localization.away a

instance Ra_comm_ring : comm_ring Ra := by apply_instance
instance powers_a_submonoid : is_submonoid (powers a) := powers.is_submonoid a

lemma one_powers_a : (1:R) ∈ powers a := powers_a_submonoid.one_mem

-- Definition of R[1/a][1/b].

def b1 : Ra := ⟦⟨b, 1, one_powers_a⟩⟧

@[reducible] def Rab := localization Ra (powers b1)

instance Afg_comm_ring : comm_ring Rab := by apply_instance
instance powers_b1_submonoid : is_submonoid (powers b1) := powers.is_submonoid b1

lemma one_powers_b1 : (1:Ra) ∈ powers b1 := powers_b1_submonoid.one_mem

-- Basically saying that b1 is b/1.

lemma elem_powers_b1_bn
: ∀ {x : Ra}, x ∈ powers b1 ↔ ∃ n : ℕ, x = ⟦⟨b ^ n, 1, one_powers_a⟩⟧ :=
begin
  intros x,
  split,
  { intros Hx,
    rcases Hx with ⟨n, Hx⟩,
    existsi n,
    revert x,
    induction n with n Hn,
    { simp, apply quotient.sound; use [1, one_powers_a]; simp, },
    { intros x Hx,
      rw pow_succ at *,
      rw ←Hx,
      rw @Hn (b1 ^ n); try { refl },
      apply quotient.sound; use [1, one_powers_a]; simp, } },
  { rintros ⟨n, Hx⟩,
    existsi n,
    revert x,
    induction n with n Hn,
    { simp, apply quotient.sound; use [1, one_powers_a]; simp, },
    { intros x Hx,
      rw pow_succ at *,
      rw Hx,
      rw @Hn (⟦(b ^ n, ⟨1, _⟩)⟧); try { refl },
      apply quotient.sound; use [1, one_powers_a]; simp, } }
end

lemma elem_powers_b1
: ∀ {x : Ra}, x ∈ powers b1 ↔ ∃ y ∈ powers b, x = ⟦⟨y, 1, one_powers_a⟩⟧ :=
begin
  intros x,
  split,
  { intros Hx,
    have Hbn := elem_powers_b1_bn.1 Hx,
    rcases Hbn with ⟨n, Hx⟩,
    existsi (b ^ n),
    existsi (⟨n, by simp⟩ : b ^ n ∈ powers b),
    exact Hx, },
  { rintros ⟨y, ⟨n, Hy⟩, Hx⟩,
    rw ←Hy at Hx,
    apply elem_powers_b1_bn.2 ⟨n, Hx⟩, }
end

-- Localization map A --> A[1/a][1/b].

@[reducible] def h : R → Rab := λ x, ⟦⟨⟦⟨x, 1, is_submonoid.one_mem _⟩⟧, 1, is_submonoid.one_mem _⟩⟧
instance is_ring_hom_h : is_ring_hom h :=
{ map_one := rfl,
  map_add := λ x y,
  begin
    apply quotient.sound; use [1, one_powers_b1]; simp,
    apply quotient.sound; use [1, one_powers_a]; simp,
  end,
  map_mul := λ x y,
  begin
    apply quotient.sound; use [1, one_powers_b1]; simp,
    apply quotient.sound; use [1, one_powers_a]; simp,
  end}

-- Proving the lemmas: inverts, denom and ker = ann.

section localization_ab_proof

-- Inverses.

def one_Rab : Rab := 1

def binv_Rab : Rab := ⟦⟨⟦⟨1, 1, one_powers_a⟩⟧, b1, ⟨1, by simp⟩⟩⟧
def ainv_Rab : Rab := ⟦⟨⟦⟨1, a, ⟨1, by simp⟩⟩⟧, 1, one_powers_b1⟩⟧

lemma loc_inverts : inverts (S {a * b}) h :=
begin
  rintros ⟨x, Hx⟩,
  induction Hx,
  case monoid.in_closure.basic : y Hy
  { rcases Hy with ⟨Hya, Hyb⟩,
    { existsi (ainv_Rab * binv_Rab),
      apply quotient.sound; use [1, one_powers_b1]; simp,
      apply quotient.sound; use [1, one_powers_a]; simp,
      rw Hy; simp, },
    { cases Hy, } },
  case monoid.in_closure.one
  { existsi one_Rab,
    simp,
    rw is_ring_hom_h.map_one,
    simpa, },
  case monoid.in_closure.mul : x y HxS HyS Hx Hy
  { rcases Hx with ⟨xinv, Hxinv⟩,
    rcases Hy with ⟨yinv, Hyinv⟩,
    existsi (xinv * yinv),
    simp at *,
    rw [is_ring_hom_h.map_mul, mul_comm _ yinv, mul_assoc, ←mul_assoc (h y)],
    rw [Hyinv, one_mul],
    exact Hxinv, }
end

-- Denoms.

def homogenizer (n m : ℕ) : R := if n ≤ m then a^(m - n) else b^(n - m)

lemma homogenizer_a {n m : ℕ} : n ≤ m → homogenizer n m = a^(m - n) :=
begin
  intros Hnm,
  dunfold homogenizer,
  rw if_eq_of_eq_true,
  apply eq_true_intro Hnm,
end

lemma homogenizer_b {n m : ℕ} : ¬(n ≤ m) → homogenizer n m = b^(n - m) :=
begin
  intros Hnm,
  dunfold homogenizer,
  rw if_eq_of_eq_false,
  apply eq_false_intro Hnm,
end

lemma homogenizer_mul : ∀ n m, a^n * b^m * homogenizer n m = a^(max n m) * b^(max n m) :=
begin
  intros n m,
  cases (classical.em (n ≤ m)) with Htt Hff,
  { rw homogenizer_a Htt,
    rw max_eq_right Htt,
    rw mul_assoc,
    rw mul_comm,
    rw mul_assoc,
    rw ←pow_add,
    rw nat.sub_add_cancel Htt,
    rw mul_comm, },
  { rw homogenizer_b Hff,
    replace Hff := le_of_not_le Hff,
    rw max_eq_left Hff,
    rw mul_assoc,
    rw ←pow_add,
    rw add_comm,
    rw nat.sub_add_cancel Hff, }
end

lemma loc_has_denom : has_denom (S {a * b}) h :=
begin
  intros x,
  refine quotient.induction_on x _,
  rintros ⟨xRa, xdenRab⟩,
  refine quotient.induction_on xRa _,
  rintros ⟨xR, xdenRa⟩,
  rcases xdenRa with ⟨y, Hy⟩,
  rcases xdenRab with ⟨w, Hw⟩,
  have Hb := elem_powers_b1.1 Hw,
  rcases Hb with ⟨z, Hz, Hweq⟩,
  have Hy' := Hy,
  rcases Hy with ⟨n, Hy⟩,
  rcases Hz with ⟨m, Hz⟩,
  have HyzkSab : (a * b)^(max n m) ∈ powers (a * b) := ⟨(max n m), by simp⟩,
  rw powers_closure_eq at HyzkSab,
  simp,
  existsi (a * b)^(max n m),
  existsi HyzkSab,
  existsi xR * homogenizer n m,
  apply quotient.sound,
  use [w, Hw]; simp,
  rw Hweq,
  apply quotient.sound,
  simp,
  existsi y,
  existsi Hy',
  simp,
  rw [←Hy, ←Hz],
  rw mul_comm xR,
  rw ←mul_assoc (b^m),
  rw ←mul_assoc (a^n),
  rw ←mul_assoc (a^n),
  rw homogenizer_mul n m,
  rw mul_pow a b,
  simp,
end

-- Kernel is monoid annihilator.

lemma loc_ker_ann_sub : ker h ≤ submonoid_ann (S {a * b}) :=
λ x Hx,
begin
  unfold submonoid_ann,
  unfold ker at *,
  unfold ideal.mk at *,
  have Hx : x ∈ {x : R | h x = 0} := Hx,
  have Hx0 : h x = 0 := by apply_assumption,
  dunfold ann_aux,
  unfold set.range,
  simp,
  show ∃ (c z : R), z ∈ S {a * b} ∧ c * z = 0 ∧ c = x,
    existsi x,
    dunfold h at Hx0,
    have Hx01 := quotient.exact Hx0,
    rcases Hx01 with ⟨t, Ht, Hx01⟩,
    simp at Hx01,
    have Hty1 := elem_powers_b1.1 Ht,
    rcases Hty1 with ⟨y, Hy, Hty1⟩,
    rw Hty1 at Hx01,
    have Hxy0 := quotient.exact Hx01,
    rcases Hxy0 with ⟨z, Hz, Hxyz0⟩,
    simp at Hxyz0,
    rcases Hy with ⟨m, Hy⟩,
    rcases Hz with ⟨n, Hz⟩,
    existsi (z * y * homogenizer n m),
    split,
    { rw [←Hy, ←Hz, homogenizer_mul n m, ←mul_pow, ←powers_closure_eq],
      exact ⟨max n m, rfl⟩, },
    { split; try { refl },
      rw [←mul_assoc, mul_comm z, ←mul_assoc, Hxyz0],
      simp, }
end

lemma loc_ker_ann : ker h = submonoid_ann (S {a * b}) :=
begin
  apply le_antisymm,
  { exact loc_ker_ann_sub, },
  { exact inverts_ker (S {a * b}) h loc_inverts, }
end

-- R[1/a][1/b] = R[1/ab].

open localization

lemma loc_Rab : is_localization' {a * b} ((of ∘ of) : R → Rab) :=
⟨loc_inverts, loc_has_denom, loc_ker_ann⟩

end localization_ab_proof

end localization_ab


/-
Copyright (c) 2022 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn

! This file was ported from Lean 3 source module order.succ_pred.relation
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.SuccPred.Basic

/-!
# Relations on types with a `succ_order`

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

This file contains properties about relations on types with a `succ_order`
and their closure operations (like the transitive closure).
-/

open Function Order Relation Set

section PartialSucc

variable {α : Type _} [PartialOrder α] [SuccOrder α] [IsSuccArchimedean α]

#print reflTransGen_of_succ_of_le /-
/-- For `n ≤ m`, `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ succ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_succ_of_le (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ico n m, r i (succ i))
    (hnm : n ≤ m) : ReflTransGen r n m := by
  revert h; refine' Succ.rec _ _ hnm
  · intro h
    exact refl_trans_gen.refl
  · intro m hnm ih h
    have : refl_trans_gen r n m := ih fun i hi => h i ⟨hi.1, hi.2.trans_le <| le_succ m⟩
    cases' (le_succ m).eq_or_lt with hm hm
    · rwa [← hm]
    exact this.tail (h m ⟨hnm, hm⟩)
#align refl_trans_gen_of_succ_of_le reflTransGen_of_succ_of_le
-/

#print reflTransGen_of_succ_of_ge /-
/-- For `m ≤ n`, `(n, m)` is in the reflexive-transitive closure of `~` if `succ i ~ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_succ_of_ge (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ico m n, r (succ i) i)
    (hmn : m ≤ n) : ReflTransGen r n m :=
  by
  rw [← refl_trans_gen_swap]
  exact reflTransGen_of_succ_of_le (swap r) h hmn
#align refl_trans_gen_of_succ_of_ge reflTransGen_of_succ_of_ge
-/

#print transGen_of_succ_of_lt /-
/-- For `n < m`, `(n, m)` is in the transitive closure of a relation `~` if `i ~ succ i`
  for all `i` between `n` and `m`. -/
theorem transGen_of_succ_of_lt (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ico n m, r i (succ i))
    (hnm : n < m) : TransGen r n m :=
  (reflTransGen_iff_eq_or_transGen.mp <| reflTransGen_of_succ_of_le r h hnm.le).resolve_left hnm.ne'
#align trans_gen_of_succ_of_lt transGen_of_succ_of_lt
-/

#print transGen_of_succ_of_gt /-
/-- For `m < n`, `(n, m)` is in the transitive closure of a relation `~` if `succ i ~ i`
  for all `i` between `n` and `m`. -/
theorem transGen_of_succ_of_gt (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ico m n, r (succ i) i)
    (hmn : m < n) : TransGen r n m :=
  (reflTransGen_iff_eq_or_transGen.mp <| reflTransGen_of_succ_of_ge r h hmn.le).resolve_left hmn.Ne
#align trans_gen_of_succ_of_gt transGen_of_succ_of_gt
-/

end PartialSucc

section LinearSucc

variable {α : Type _} [LinearOrder α] [SuccOrder α] [IsSuccArchimedean α]

#print reflTransGen_of_succ /-
/-- `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ succ i` and `succ i ~ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_succ (r : α → α → Prop) {n m : α} (h1 : ∀ i ∈ Ico n m, r i (succ i))
    (h2 : ∀ i ∈ Ico m n, r (succ i) i) : ReflTransGen r n m :=
  (le_total n m).elim (reflTransGen_of_succ_of_le r h1) <| reflTransGen_of_succ_of_ge r h2
#align refl_trans_gen_of_succ reflTransGen_of_succ
-/

#print transGen_of_succ_of_ne /-
/-- For `n ≠ m`,`(n, m)` is in the transitive closure of a relation `~` if `i ~ succ i` and
  `succ i ~ i` for all `i` between `n` and `m`. -/
theorem transGen_of_succ_of_ne (r : α → α → Prop) {n m : α} (h1 : ∀ i ∈ Ico n m, r i (succ i))
    (h2 : ∀ i ∈ Ico m n, r (succ i) i) (hnm : n ≠ m) : TransGen r n m :=
  (reflTransGen_iff_eq_or_transGen.mp (reflTransGen_of_succ r h1 h2)).resolve_left hnm.symm
#align trans_gen_of_succ_of_ne transGen_of_succ_of_ne
-/

#print transGen_of_succ_of_reflexive /-
/-- `(n, m)` is in the transitive closure of a reflexive relation `~` if `i ~ succ i` and
  `succ i ~ i` for all `i` between `n` and `m`. -/
theorem transGen_of_succ_of_reflexive (r : α → α → Prop) {n m : α} (hr : Reflexive r)
    (h1 : ∀ i ∈ Ico n m, r i (succ i)) (h2 : ∀ i ∈ Ico m n, r (succ i) i) : TransGen r n m :=
  by
  rcases eq_or_ne m n with (rfl | hmn); · exact trans_gen.single (hr m)
  exact transGen_of_succ_of_ne r h1 h2 hmn.symm
#align trans_gen_of_succ_of_reflexive transGen_of_succ_of_reflexive
-/

end LinearSucc

section PartialPred

variable {α : Type _} [PartialOrder α] [PredOrder α] [IsPredArchimedean α]

#print reflTransGen_of_pred_of_ge /-
/-- For `m ≤ n`, `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ pred i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_pred_of_ge (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ioc m n, r i (pred i))
    (hnm : m ≤ n) : ReflTransGen r n m :=
  @reflTransGen_of_succ_of_le αᵒᵈ _ _ _ r n m (fun x hx => h x ⟨hx.2, hx.1⟩) hnm
#align refl_trans_gen_of_pred_of_ge reflTransGen_of_pred_of_ge
-/

#print reflTransGen_of_pred_of_le /-
/-- For `n ≤ m`, `(n, m)` is in the reflexive-transitive closure of `~` if `pred i ~ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_pred_of_le (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ioc n m, r (pred i) i)
    (hmn : n ≤ m) : ReflTransGen r n m :=
  @reflTransGen_of_succ_of_ge αᵒᵈ _ _ _ r n m (fun x hx => h x ⟨hx.2, hx.1⟩) hmn
#align refl_trans_gen_of_pred_of_le reflTransGen_of_pred_of_le
-/

#print transGen_of_pred_of_gt /-
/-- For `m < n`, `(n, m)` is in the transitive closure of a relation `~` for `n ≠ m` if `i ~ pred i`
  for all `i` between `n` and `m`. -/
theorem transGen_of_pred_of_gt (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ioc m n, r i (pred i))
    (hnm : m < n) : TransGen r n m :=
  @transGen_of_succ_of_lt αᵒᵈ _ _ _ r _ _ (fun x hx => h x ⟨hx.2, hx.1⟩) hnm
#align trans_gen_of_pred_of_gt transGen_of_pred_of_gt
-/

#print transGen_of_pred_of_lt /-
/-- For `n < m`, `(n, m)` is in the transitive closure of a relation `~` for `n ≠ m` if `pred i ~ i`
  for all `i` between `n` and `m`. -/
theorem transGen_of_pred_of_lt (r : α → α → Prop) {n m : α} (h : ∀ i ∈ Ioc n m, r (pred i) i)
    (hmn : n < m) : TransGen r n m :=
  @transGen_of_succ_of_gt αᵒᵈ _ _ _ r _ _ (fun x hx => h x ⟨hx.2, hx.1⟩) hmn
#align trans_gen_of_pred_of_lt transGen_of_pred_of_lt
-/

end PartialPred

section LinearPred

variable {α : Type _} [LinearOrder α] [PredOrder α] [IsPredArchimedean α]

#print reflTransGen_of_pred /-
/-- `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ pred i` and `pred i ~ i`
  for all `i` between `n` and `m`. -/
theorem reflTransGen_of_pred (r : α → α → Prop) {n m : α} (h1 : ∀ i ∈ Ioc m n, r i (pred i))
    (h2 : ∀ i ∈ Ioc n m, r (pred i) i) : ReflTransGen r n m :=
  @reflTransGen_of_succ αᵒᵈ _ _ _ r n m (fun x hx => h1 x ⟨hx.2, hx.1⟩) fun x hx =>
    h2 x ⟨hx.2, hx.1⟩
#align refl_trans_gen_of_pred reflTransGen_of_pred
-/

#print transGen_of_pred_of_ne /-
/-- For `n ≠ m`, `(n, m)` is in the transitive closure of a relation `~` if `i ~ pred i` and
  `pred i ~ i` for all `i` between `n` and `m`. -/
theorem transGen_of_pred_of_ne (r : α → α → Prop) {n m : α} (h1 : ∀ i ∈ Ioc m n, r i (pred i))
    (h2 : ∀ i ∈ Ioc n m, r (pred i) i) (hnm : n ≠ m) : TransGen r n m :=
  @transGen_of_succ_of_ne αᵒᵈ _ _ _ r n m (fun x hx => h1 x ⟨hx.2, hx.1⟩)
    (fun x hx => h2 x ⟨hx.2, hx.1⟩) hnm
#align trans_gen_of_pred_of_ne transGen_of_pred_of_ne
-/

#print transGen_of_pred_of_reflexive /-
/-- `(n, m)` is in the transitive closure of a reflexive relation `~` if `i ~ pred i` and
  `pred i ~ i` for all `i` between `n` and `m`. -/
theorem transGen_of_pred_of_reflexive (r : α → α → Prop) {n m : α} (hr : Reflexive r)
    (h1 : ∀ i ∈ Ioc m n, r i (pred i)) (h2 : ∀ i ∈ Ioc n m, r (pred i) i) : TransGen r n m :=
  @transGen_of_succ_of_reflexive αᵒᵈ _ _ _ r n m hr (fun x hx => h1 x ⟨hx.2, hx.1⟩) fun x hx =>
    h2 x ⟨hx.2, hx.1⟩
#align trans_gen_of_pred_of_reflexive transGen_of_pred_of_reflexive
-/

end LinearPred