/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel

! This file was ported from Lean 3 source module order.monotone.union
! 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.Bounds.Basic

/-!
# Monotonicity on intervals

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

In this file we prove that a function is (strictly) monotone (or antitone) on a linear order `α`
provided that it is (strictly) monotone on `(-∞, a]` and on `[a, +∞)`. This is a special case
of a more general statement where one deduces monotonicity on a union from monotonicity on each
set.
-/

open Set

variable {α β : Type _} [LinearOrder α] [Preorder β] {a : α} {f : α → β}

/- warning: strict_mono_on.union -> StrictMonoOn.union is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {f : α -> β} {s : Set.{u1} α} {t : Set.{u1} α} {c : α}, (StrictMonoOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f s) -> (StrictMonoOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f t) -> (IsGreatest.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) s c) -> (IsLeast.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) t c) -> (StrictMonoOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {f : α -> β} {s : Set.{u2} α} {t : Set.{u2} α} {c : α}, (StrictMonoOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f s) -> (StrictMonoOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f t) -> (IsGreatest.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) s c) -> (IsLeast.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) t c) -> (StrictMonoOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Union.union.{u2} (Set.{u2} α) (Set.instUnionSet.{u2} α) s t))
Case conversion may be inaccurate. Consider using '#align strict_mono_on.union StrictMonoOn.unionₓ'. -/
/-- If `f` is strictly monotone both on `s` and `t`, with `s` to the left of `t` and the center
point belonging to both `s` and `t`, then `f` is strictly monotone on `s ∪ t` -/
protected theorem StrictMonoOn.union {s t : Set α} {c : α} (h₁ : StrictMonoOn f s)
    (h₂ : StrictMonoOn f t) (hs : IsGreatest s c) (ht : IsLeast t c) : StrictMonoOn f (s ∪ t) :=
  by
  have A : ∀ x, x ∈ s ∪ t → x ≤ c → x ∈ s :=
    by
    intro x hx hxc
    cases hx
    · exact hx
    rcases eq_or_lt_of_le hxc with (rfl | h'x)
    · exact hs.1
    exact (lt_irrefl _ (h'x.trans_le (ht.2 hx))).elim
  have B : ∀ x, x ∈ s ∪ t → c ≤ x → x ∈ t :=
    by
    intro x hx hxc
    cases hx
    swap
    · exact hx
    rcases eq_or_lt_of_le hxc with (rfl | h'x)
    · exact ht.1
    exact (lt_irrefl _ (h'x.trans_le (hs.2 hx))).elim
  intro x hx y hy hxy
  rcases lt_or_le x c with (hxc | hcx)
  · have xs : x ∈ s := A _ hx hxc.le
    rcases lt_or_le y c with (hyc | hcy)
    · exact h₁ xs (A _ hy hyc.le) hxy
    · exact (h₁ xs hs.1 hxc).trans_le (h₂.monotone_on ht.1 (B _ hy hcy) hcy)
  · have xt : x ∈ t := B _ hx hcx
    have yt : y ∈ t := B _ hy (hcx.trans hxy.le)
    exact h₂ xt yt hxy
#align strict_mono_on.union StrictMonoOn.union

/- warning: strict_mono_on.Iic_union_Ici -> StrictMonoOn.Iic_union_Ici is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {a : α} {f : α -> β}, (StrictMonoOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Set.Iic.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a)) -> (StrictMonoOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Set.Ici.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a)) -> (StrictMono.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {a : α} {f : α -> β}, (StrictMonoOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Set.Iic.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a)) -> (StrictMonoOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Set.Ici.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a)) -> (StrictMono.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f)
Case conversion may be inaccurate. Consider using '#align strict_mono_on.Iic_union_Ici StrictMonoOn.Iic_union_Iciₓ'. -/
/-- If `f` is strictly monotone both on `(-∞, a]` and `[a, ∞)`, then it is strictly monotone on the
whole line. -/
protected theorem StrictMonoOn.Iic_union_Ici (h₁ : StrictMonoOn f (Iic a))
    (h₂ : StrictMonoOn f (Ici a)) : StrictMono f :=
  by
  rw [← strictMonoOn_univ, ← @Iic_union_Ici _ _ a]
  exact StrictMonoOn.union h₁ h₂ isGreatest_Iic isLeast_Ici
#align strict_mono_on.Iic_union_Ici StrictMonoOn.Iic_union_Ici

/- warning: strict_anti_on.union -> StrictAntiOn.union is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {f : α -> β} {s : Set.{u1} α} {t : Set.{u1} α} {c : α}, (StrictAntiOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f s) -> (StrictAntiOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f t) -> (IsGreatest.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) s c) -> (IsLeast.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) t c) -> (StrictAntiOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {f : α -> β} {s : Set.{u2} α} {t : Set.{u2} α} {c : α}, (StrictAntiOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f s) -> (StrictAntiOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f t) -> (IsGreatest.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) s c) -> (IsLeast.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) t c) -> (StrictAntiOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Union.union.{u2} (Set.{u2} α) (Set.instUnionSet.{u2} α) s t))
Case conversion may be inaccurate. Consider using '#align strict_anti_on.union StrictAntiOn.unionₓ'. -/
/-- If `f` is strictly antitone both on `s` and `t`, with `s` to the left of `t` and the center
point belonging to both `s` and `t`, then `f` is strictly antitone on `s ∪ t` -/
protected theorem StrictAntiOn.union {s t : Set α} {c : α} (h₁ : StrictAntiOn f s)
    (h₂ : StrictAntiOn f t) (hs : IsGreatest s c) (ht : IsLeast t c) : StrictAntiOn f (s ∪ t) :=
  (h₁.dual_right.union h₂.dual_right hs ht).dual_right
#align strict_anti_on.union StrictAntiOn.union

/- warning: strict_anti_on.Iic_union_Ici -> StrictAntiOn.Iic_union_Ici is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {a : α} {f : α -> β}, (StrictAntiOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Set.Iic.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a)) -> (StrictAntiOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Set.Ici.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a)) -> (StrictAnti.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {a : α} {f : α -> β}, (StrictAntiOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Set.Iic.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a)) -> (StrictAntiOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Set.Ici.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a)) -> (StrictAnti.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f)
Case conversion may be inaccurate. Consider using '#align strict_anti_on.Iic_union_Ici StrictAntiOn.Iic_union_Iciₓ'. -/
/-- If `f` is strictly antitone both on `(-∞, a]` and `[a, ∞)`, then it is strictly antitone on the
whole line. -/
protected theorem StrictAntiOn.Iic_union_Ici (h₁ : StrictAntiOn f (Iic a))
    (h₂ : StrictAntiOn f (Ici a)) : StrictAnti f :=
  (h₁.dual_right.Iic_union_Ici h₂.dual_right).dual_right
#align strict_anti_on.Iic_union_Ici StrictAntiOn.Iic_union_Ici

/- warning: monotone_on.union_right -> MonotoneOn.union_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {f : α -> β} {s : Set.{u1} α} {t : Set.{u1} α} {c : α}, (MonotoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f s) -> (MonotoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f t) -> (IsGreatest.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) s c) -> (IsLeast.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) t c) -> (MonotoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {f : α -> β} {s : Set.{u2} α} {t : Set.{u2} α} {c : α}, (MonotoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f s) -> (MonotoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f t) -> (IsGreatest.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) s c) -> (IsLeast.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) t c) -> (MonotoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Union.union.{u2} (Set.{u2} α) (Set.instUnionSet.{u2} α) s t))
Case conversion may be inaccurate. Consider using '#align monotone_on.union_right MonotoneOn.union_rightₓ'. -/
/-- If `f` is monotone both on `s` and `t`, with `s` to the left of `t` and the center
point belonging to both `s` and `t`, then `f` is monotone on `s ∪ t` -/
protected theorem MonotoneOn.union_right {s t : Set α} {c : α} (h₁ : MonotoneOn f s)
    (h₂ : MonotoneOn f t) (hs : IsGreatest s c) (ht : IsLeast t c) : MonotoneOn f (s ∪ t) :=
  by
  have A : ∀ x, x ∈ s ∪ t → x ≤ c → x ∈ s :=
    by
    intro x hx hxc
    cases hx
    · exact hx
    rcases eq_or_lt_of_le hxc with (rfl | h'x)
    · exact hs.1
    exact (lt_irrefl _ (h'x.trans_le (ht.2 hx))).elim
  have B : ∀ x, x ∈ s ∪ t → c ≤ x → x ∈ t :=
    by
    intro x hx hxc
    cases hx
    swap
    · exact hx
    rcases eq_or_lt_of_le hxc with (rfl | h'x)
    · exact ht.1
    exact (lt_irrefl _ (h'x.trans_le (hs.2 hx))).elim
  intro x hx y hy hxy
  rcases lt_or_le x c with (hxc | hcx)
  · have xs : x ∈ s := A _ hx hxc.le
    rcases lt_or_le y c with (hyc | hcy)
    · exact h₁ xs (A _ hy hyc.le) hxy
    · exact (h₁ xs hs.1 hxc.le).trans (h₂ ht.1 (B _ hy hcy) hcy)
  · have xt : x ∈ t := B _ hx hcx
    have yt : y ∈ t := B _ hy (hcx.trans hxy)
    exact h₂ xt yt hxy
#align monotone_on.union_right MonotoneOn.union_right

/- warning: monotone_on.Iic_union_Ici -> MonotoneOn.Iic_union_Ici is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {a : α} {f : α -> β}, (MonotoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Set.Iic.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a)) -> (MonotoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Set.Ici.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a)) -> (Monotone.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {a : α} {f : α -> β}, (MonotoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Set.Iic.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a)) -> (MonotoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Set.Ici.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a)) -> (Monotone.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f)
Case conversion may be inaccurate. Consider using '#align monotone_on.Iic_union_Ici MonotoneOn.Iic_union_Iciₓ'. -/
/-- If `f` is monotone both on `(-∞, a]` and `[a, ∞)`, then it is monotone on the whole line. -/
protected theorem MonotoneOn.Iic_union_Ici (h₁ : MonotoneOn f (Iic a)) (h₂ : MonotoneOn f (Ici a)) :
    Monotone f := by
  rw [← monotoneOn_univ, ← @Iic_union_Ici _ _ a]
  exact MonotoneOn.union_right h₁ h₂ isGreatest_Iic isLeast_Ici
#align monotone_on.Iic_union_Ici MonotoneOn.Iic_union_Ici

/- warning: antitone_on.union_right -> AntitoneOn.union_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {f : α -> β} {s : Set.{u1} α} {t : Set.{u1} α} {c : α}, (AntitoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f s) -> (AntitoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f t) -> (IsGreatest.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) s c) -> (IsLeast.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) t c) -> (AntitoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {f : α -> β} {s : Set.{u2} α} {t : Set.{u2} α} {c : α}, (AntitoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f s) -> (AntitoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f t) -> (IsGreatest.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) s c) -> (IsLeast.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) t c) -> (AntitoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Union.union.{u2} (Set.{u2} α) (Set.instUnionSet.{u2} α) s t))
Case conversion may be inaccurate. Consider using '#align antitone_on.union_right AntitoneOn.union_rightₓ'. -/
/-- If `f` is antitone both on `s` and `t`, with `s` to the left of `t` and the center
point belonging to both `s` and `t`, then `f` is antitone on `s ∪ t` -/
protected theorem AntitoneOn.union_right {s t : Set α} {c : α} (h₁ : AntitoneOn f s)
    (h₂ : AntitoneOn f t) (hs : IsGreatest s c) (ht : IsLeast t c) : AntitoneOn f (s ∪ t) :=
  (h₁.dual_right.union_right h₂.dual_right hs ht).dual_right
#align antitone_on.union_right AntitoneOn.union_right

/- warning: antitone_on.Iic_union_Ici -> AntitoneOn.Iic_union_Ici is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {a : α} {f : α -> β}, (AntitoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Set.Iic.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a)) -> (AntitoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f (Set.Ici.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a)) -> (Antitone.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) _inst_2 f)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {a : α} {f : α -> β}, (AntitoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Set.Iic.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a)) -> (AntitoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f (Set.Ici.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a)) -> (Antitone.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) _inst_2 f)
Case conversion may be inaccurate. Consider using '#align antitone_on.Iic_union_Ici AntitoneOn.Iic_union_Iciₓ'. -/
/-- If `f` is antitone both on `(-∞, a]` and `[a, ∞)`, then it is antitone on the whole line. -/
protected theorem AntitoneOn.Iic_union_Ici (h₁ : AntitoneOn f (Iic a)) (h₂ : AntitoneOn f (Ici a)) :
    Antitone f :=
  (h₁.dual_right.Iic_union_Ici h₂.dual_right).dual_right
#align antitone_on.Iic_union_Ici AntitoneOn.Iic_union_Ici


import group_theory.free_abelian_group_finsupp
import data.finsupp.basic

/-!
In this file we define the equivalence between `free_abelian_group X`
and `X →₀ ℤ` (the type of finitely supported function `X → ℤ`).
Both types come with useful machinery, and the purpose of this file
is to transport some of the machinery from one to the other.

We also define a new induction principle on `free_abelian_group X`,
needed for proving that the maps in `Lbar_complex` compose the way they should.
This induction principle is `induction_on_free_predicate` below.
A `free_predicate` on a free abelian group is a predicate that contains
`a : free_abelian_group X` if and only if it contains all the summands of `a`.
-/

noncomputable theory

open_locale big_operators

namespace free_abelian_group
variables {X : Type*}

open_locale classical

lemma support_add_smul_of (a : free_abelian_group X) (n : ℤ) (hn : n ≠ 0)
  (x : X) (hxa : x ∉ a.support) :
  support (a + n • of x) = insert x a.support :=
begin
  apply finset.subset.antisymm,
  { apply finset.subset.trans (support_add _ _),
    intros y,
    simp only [finset.mem_union, finset.mem_insert, support_zsmul n hn, support_of, or_comm (y = x),
      finset.mem_singleton, imp_self] },
  { intros y,
    simp only [finset.mem_insert],
    rintro (rfl|hya),
    { rw not_mem_support_iff at hxa,
      simp only [coeff, add_monoid_hom.coe_comp, finsupp.apply_add_hom_apply,
        function.comp_app] at hxa,
      simp only [support, add_monoid_hom.map_add, pi.add_apply, finsupp.mem_support_iff,
        ne.def, finsupp.coe_add, hxa, zero_add, add_monoid_hom.map_zsmul,
        to_finsupp_of],
      rw [← finsupp.single_add_hom_apply, ← add_monoid_hom.map_zsmul, zsmul_one],
      simpa only [int.cast_id, finsupp.single_eq_same, finsupp.single_add_hom_apply] },
    { rw not_mem_support_iff at hxa,
      rw mem_support_iff at hya,
      simp only [coeff, add_monoid_hom.coe_comp, finsupp.apply_add_hom_apply,
        function.comp_app, ne.def] at hxa hya,
      simp only [support, add_monoid_hom.map_add, pi.add_apply, finsupp.mem_support_iff,
        ne.def, finsupp.coe_add, add_monoid_hom.map_zsmul, to_finsupp_of],
      rwa [← finsupp.single_add_hom_apply, ← add_monoid_hom.map_zsmul, zsmul_one,
        finsupp.single_add_hom_apply, finsupp.single_apply, if_neg, add_zero],
      rintro rfl, contradiction } }
end

lemma support_sum (s : finset X) (n : X → ℤ) :
  (support (∑ x in s, n x • of x)) ⊆ s :=
begin
  apply finset.induction_on s,
  { simp only [finset.empty_subset, finset.sum_empty, support_zero] },
  intros x s hxs IH,
  rw finset.sum_insert hxs,
  apply finset.subset.trans (support_add _ _),
  by_cases hn : n x = 0,
  { simp only [hn, finset.empty_union, zero_smul, support_zero],
    apply finset.subset.trans IH (finset.subset_insert x s) },
  rw [support_zsmul _ hn, support_of],
  intros y hy,
  simp only [finset.mem_union, finset.mem_singleton] at hy,
  simp only [finset.mem_insert],
  apply or.imp id _ hy,
  intro h, exact IH h
end

@[simp] lemma coeff_of_self (x : X) : coeff x (of x) = 1 :=
by simp only [coeff, add_monoid_hom.coe_comp, finsupp.apply_add_hom_apply,
      finsupp.single_eq_same, function.comp_app, to_finsupp_of]

lemma sum_support_coeff (a : free_abelian_group X) :
  ∑ x in a.support, coeff x a • (of x) = a :=
begin
  apply (equiv_finsupp X).injective,
  simp only [equiv_finsupp_apply],
  rw [← finsupp.sum_single a.to_finsupp, finsupp.sum],
  simp only [add_monoid_hom.map_sum, add_monoid_hom.map_zsmul, to_finsupp_of],
  apply finset.sum_congr rfl,
  intros x hx,
  simp only [← finsupp.single_add_hom_apply, ← add_monoid_hom.map_zsmul, zsmul_one, coeff,
    int.cast_id, add_monoid_hom.comp_apply, finsupp.apply_add_hom_apply]
end

-- probably needs a better name
@[elab_as_eliminator] protected lemma induction_on''
  {P : free_abelian_group X → Prop}
  (a : free_abelian_group X)
  (h0 : P 0)
  (h1 : ∀ (n:ℤ) (h : n ≠ 0) x, P (n • of x))
  (h2 : ∀ (a : free_abelian_group X) (n : ℤ) (hn : n ≠ 0) (x : X) (h : x ∉ a.support),
    P a → (∀ (n:ℤ), P (n • of x)) → P (a + n • of x)) :
  P a :=
begin
  rw ← sum_support_coeff a,
  generalize hs : a.support = s,
  classical,
  apply finset.induction_on s; clear_dependent s,
  { simpa only [finset.sum_empty] },
  intros x s hxs IH,
  rw [finset.sum_insert hxs, add_comm],
  by_cases hxa : coeff x a = 0,
  { rw [hxa, zero_smul, add_zero], exact IH },
  apply h2 _ _ hxa _ _ IH,
  { intro n, by_cases hn : n = 0, { rwa [hn, zero_smul] }, exact h1 n hn x },
  contrapose! hxs,
  apply support_sum _ _ hxs
end

/-- A `free_predicate` on a free abelian group is a predicate that cuts out a subgroup
generated by a subset of the generators of the free abelian group. -/
def free_predicate (Q : free_abelian_group X → Prop) :=
∀ a : free_abelian_group X, Q a ↔ ∀ x ∈ a.support, Q (of x)

namespace free_predicate

variables {Q : free_abelian_group X → Prop} {a b : free_abelian_group X}

lemma zero (h : free_predicate Q) : Q 0 :=
begin
  rw h,
  simp only [finset.not_mem_empty, forall_prop_of_false,
    not_false_iff, support_zero, forall_true_iff]
end

lemma add (h : free_predicate Q) (ha : Q a) (hb : Q b) : Q (a + b) :=
begin
  rw h at ha hb ⊢,
  intros x hx,
  replace hx := support_add _ _ hx,
  simp only [finset.mem_union] at hx,
  cases hx; solve_by_elim
end

lemma neg (h : free_predicate Q) (ha : Q a) : Q (-a) :=
begin
  rw h at ha ⊢,
  intros x hx,
  rw support_neg at hx,
  solve_by_elim
end

lemma neg_iff (h : free_predicate Q) : Q (-a) ↔ Q a :=
⟨λ ha, by simpa only [neg_neg] using h.neg ha, h.neg⟩

/-- The additive subgroup of elements of `free_abelian_group X` satisfying a given `free_predicate`. -/
def add_subgroup (h : free_predicate Q) : add_subgroup (free_abelian_group X) :=
{ carrier := {a | Q a},
  zero_mem' := h.zero,
  add_mem' := λ a b ha hb, h.add ha hb,
  neg_mem' := λ a ha, h.neg ha }

lemma zsmul (h : free_predicate Q) (n : ℤ) (ha : Q a) : Q (n • a) :=
add_subgroup.zsmul_mem h.add_subgroup ha n

lemma of_zsmul (h : free_predicate Q) (n : ℤ) (hn : n ≠ 0) (ha : Q (n • a)) : Q a :=
by { rw h at ha ⊢, simpa only [support_zsmul n hn] using ha }

lemma zsmul_iff (h : free_predicate Q) (n : ℤ) (hn : n ≠ 0) : Q (n • a) ↔ Q a :=
⟨h.of_zsmul n hn, h.zsmul n⟩

lemma smul (h : free_predicate Q) (n : ℤ) (ha : Q a) : Q (n • a) :=
by { rw ← zsmul_eq_smul, apply h.zsmul _ ha }

lemma of_smul (h : free_predicate Q) (n : ℤ) (hn : n ≠ 0) (ha : Q (n • a)) : Q a :=
by rwa [h.zsmul_iff n hn] at ha

lemma smul_iff (h : free_predicate Q) (n : ℤ) (hn : n ≠ 0) : Q (n • a) ↔ Q a :=
⟨h.of_smul n hn, h.smul n⟩

lemma smul_nat (h : free_predicate Q) (n : ℕ) (ha : Q a) : Q (n • a) :=
h.smul n ha

lemma of_smul_nat (h : free_predicate Q) (n : ℕ) (hn : n ≠ 0) (ha : Q (n • a)) : Q a :=
h.of_smul n (by exact_mod_cast hn) ha

lemma smul_nat_iff (h : free_predicate Q) (n : ℕ) (hn : n ≠ 0) : Q (n • a) ↔ Q a :=
⟨h.of_smul_nat n hn, h.smul_nat n⟩

end free_predicate

/-- An induction principle for elements of `free_abelian_group X`
satisfying some `free_predicate Q`. -/
@[elab_as_eliminator] protected lemma induction_on_free_predicate
  {P : free_abelian_group X → Prop}
  (Q : free_abelian_group X → Prop)
  (hQ : free_predicate Q)
  (a : free_abelian_group X)
  (hQa : Q a)
  (hP0 : P 0)
  (hof : ∀ x, Q (of x) → P (of x))
  (hneg : ∀ a, Q a → P a → P (-a))
  (hadd : ∀ a b, Q a → Q b → P a → P b → P (a + b)) :
  P a :=
begin
  revert hQa,
  have N : ∀ (n:ℕ) x, Q (n • of x) → P (n • of x),
  { intros n x,
    induction n with n ih,
    { intro, exact hP0 },
    { intro hQx,
      have hQ1x : Q (of x) := hQ.of_smul_nat n.succ n.succ_ne_zero hQx,
      have hQnx : Q (n • of x) := hQ.smul_nat n hQ1x,
      rw [nat.succ_eq_add_one, add_smul, one_smul],
      apply hadd _ _ hQnx hQ1x (ih hQnx) (hof _ hQ1x) } },
  apply free_abelian_group.induction_on'' a,
  { intro, exact hP0 },
  { intros n hn x,
    cases le_or_lt 0 n with h0n hn0,
    { lift n to ℕ using h0n, apply N },
    { have h0n : 0 ≤ -n, { rw [neg_nonneg], exact hn0.le },
      lift -n to ℕ using h0n with k hk,
      intro hQx,
      have hQ1x : Q (of x) := hQ.of_smul n hn hQx,
      rw [← neg_neg n, neg_smul],
      apply hneg _ (hQ.smul _ hQ1x),
      rw ← hk,
      exact N _ _ (hQ.smul_nat k hQ1x) } },
  { intros a n hn x hxa IH1 IH2 hq,
    have hQa : Q a,
    { rw hQ at hq ⊢, intros x hxa', apply hq, rw support_add_smul_of _ _ hn _ hxa,
      apply finset.mem_insert_of_mem hxa' },
    have hQx : Q (of x),
    { rw hQ at hq ⊢, intros x' hxa', apply hq, rw support_add_smul_of _ _ hn _ hxa,
      rw [support_of, finset.mem_singleton] at hxa', subst hxa',
      apply finset.mem_insert_self },
    exact hadd _ _ hQa (hQ.smul n hQx) (IH1 hQa) (IH2 n (hQ.smul n hQx)) }
end

lemma mem_support_map {X Y : Type*} (f : X → Y) (hf : function.injective f)
  (a : free_abelian_group X) (y : Y) :
  y ∈ (map f a).support ↔ ∃ x, x ∈ a.support ∧ y = f x :=
begin
  revert y,
  apply free_abelian_group.induction_on'' a; clear a,
  { intro y,
    simp only [finset.not_mem_empty, exists_false, support_zero,
      add_monoid_hom.map_zero, false_and], },
  { intros n hn x y,
    simp only [hn, add_monoid_hom.map_zsmul, map_of_apply, support_zsmul, support_of,
      exists_eq_left, ne.def, not_false_iff, finset.mem_singleton], },
  { rintro a n hn x hx IH - y,
    simp only [add_monoid_hom.map_zsmul, add_monoid_hom.map_add, map_of_apply,
      support_add_smul_of _ _ hn _ hx],
    rw support_add_smul_of _ _ hn,
    { simp only [IH, finset.mem_insert],
      split,
      { rintro (rfl|⟨x', h, rfl⟩),
        { exact ⟨x, or.inl rfl, rfl⟩, },
        { exact ⟨x', or.inr h, rfl⟩ } },
      { rintro ⟨x', (rfl|h), rfl⟩,
        { exact or.inl rfl },
        { exact or.inr ⟨x', h, rfl⟩ } } },
    { simp only [IH, not_exists, not_and],
      intros x' hx',
      apply hf.ne,
      rintro rfl,
      exact hx hx' } }
end

end free_abelian_group
#lint- only unused_arguments def_lemma doc_blame


lemma not_iff_imp_false (P : Prop) : ¬ P ↔ P → false := iff.rfl --hide

lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q :=
begin
    intro f,
    cases f with p np,
    exfalso,
    --rw not_iff_imp_false at np,
    apply np,
    exact p,
end


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

! This file was ported from Lean 3 source module analysis.convex.independent
! leanprover-community/mathlib commit fefd8a38be7811574cd2ec2f77d3a393a407f112
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Combination
import Mathbin.Analysis.Convex.Extreme

/-!
# Convex independence

This file defines convex independent families of points.

Convex independence is closely related to affine independence. In both cases, no point can be
written as a combination of others. When the combination is affine (that is, any coefficients), this
yields affine independence. When the combination is convex (that is, all coefficients are
nonnegative), then this yields convex independence. In particular, affine independence implies
convex independence.

## Main declarations

* `convex_independent p`: Convex independence of the indexed family `p : ι → E`. Every point of the
  family only belongs to convex hulls of sets of the family containing it.
* `convex_independent_iff_finset`: Carathéodory's theorem allows us to only check finsets to
  conclude convex independence.
* `convex.extreme_points_convex_independent`: Extreme points of a convex set are convex independent.

## References

* https://en.wikipedia.org/wiki/Convex_position

## TODO

Prove `affine_independent.convex_independent`. This requires some glue between `affine_combination`
and `finset.center_mass`.

## Tags

independence, convex position
-/

open Affine BigOperators Classical

open Finset Function

variable {𝕜 E ι : Type _}

section OrderedSemiring

variable (𝕜) [OrderedSemiring 𝕜] [AddCommGroup E] [Module 𝕜 E] {s t : Set E}

/-- An indexed family is said to be convex independent if every point only belongs to convex hulls
of sets containing it. -/
def ConvexIndependent (p : ι → E) : Prop :=
  ∀ (s : Set ι) (x : ι), p x ∈ convexHull 𝕜 (p '' s) → x ∈ s
#align convex_independent ConvexIndependent

variable {𝕜}

/-- A family with at most one point is convex independent. -/
theorem Subsingleton.convexIndependent [Subsingleton ι] (p : ι → E) : ConvexIndependent 𝕜 p :=
  fun s x hx => by
  have : (convexHull 𝕜 (p '' s)).Nonempty := ⟨p x, hx⟩
  rw [convexHull_nonempty_iff, Set.nonempty_image_iff] at this
  rwa [Subsingleton.mem_iff_nonempty]
#align subsingleton.convex_independent Subsingleton.convexIndependent

/-- A convex independent family is injective. -/
protected theorem ConvexIndependent.injective {p : ι → E} (hc : ConvexIndependent 𝕜 p) :
    Function.Injective p := by
  refine' fun i j hij => hc {j} i _
  rw [hij, Set.image_singleton, convexHull_singleton]
  exact Set.mem_singleton _
#align convex_independent.injective ConvexIndependent.injective

/-- If a family is convex independent, so is any subfamily given by composition of an embedding into
index type with the original family. -/
theorem ConvexIndependent.comp_embedding {ι' : Type _} (f : ι' ↪ ι) {p : ι → E}
    (hc : ConvexIndependent 𝕜 p) : ConvexIndependent 𝕜 (p ∘ f) :=
  by
  intro s x hx
  rw [← f.injective.mem_set_image]
  exact hc _ _ (by rwa [Set.image_image])
#align convex_independent.comp_embedding ConvexIndependent.comp_embedding

/-- If a family is convex independent, so is any subfamily indexed by a subtype of the index type.
-/
protected theorem ConvexIndependent.subtype {p : ι → E} (hc : ConvexIndependent 𝕜 p) (s : Set ι) :
    ConvexIndependent 𝕜 fun i : s => p i :=
  hc.comp_embedding (Embedding.subtype _)
#align convex_independent.subtype ConvexIndependent.subtype

/-- If an indexed family of points is convex independent, so is the corresponding set of points. -/
protected theorem ConvexIndependent.range {p : ι → E} (hc : ConvexIndependent 𝕜 p) :
    ConvexIndependent 𝕜 (fun x => x : Set.range p → E) :=
  by
  let f : Set.range p → ι := fun x => x.property.some
  have hf : ∀ x, p (f x) = x := fun x => x.property.some_spec
  let fe : Set.range p ↪ ι := ⟨f, fun x₁ x₂ he => Subtype.ext (hf x₁ ▸ hf x₂ ▸ he ▸ rfl)⟩
  convert hc.comp_embedding fe
  ext
  rw [embedding.coe_fn_mk, comp_app, hf]
#align convex_independent.range ConvexIndependent.range

/-- A subset of a convex independent set of points is convex independent as well. -/
protected theorem ConvexIndependent.mono {s t : Set E}
    (hc : ConvexIndependent 𝕜 (fun x => x : t → E)) (hs : s ⊆ t) :
    ConvexIndependent 𝕜 (fun x => x : s → E) :=
  hc.comp_embedding (s.embeddingOfSubset t hs)
#align convex_independent.mono ConvexIndependent.mono

/-- The range of an injective indexed family of points is convex independent iff that family is. -/
theorem Function.Injective.convexIndependent_iff_set {p : ι → E} (hi : Function.Injective p) :
    ConvexIndependent 𝕜 (fun x => x : Set.range p → E) ↔ ConvexIndependent 𝕜 p :=
  ⟨fun hc =>
    hc.comp_embedding
      (⟨fun i => ⟨p i, Set.mem_range_self _⟩, fun x y h => hi (Subtype.mk_eq_mk.1 h)⟩ :
        ι ↪ Set.range p),
    ConvexIndependent.range⟩
#align function.injective.convex_independent_iff_set Function.Injective.convexIndependent_iff_set

/-- If a family is convex independent, a point in the family is in the convex hull of some of the
points given by a subset of the index type if and only if the point's index is in this subset. -/
@[simp]
protected theorem ConvexIndependent.mem_convexHull_iff {p : ι → E} (hc : ConvexIndependent 𝕜 p)
    (s : Set ι) (i : ι) : p i ∈ convexHull 𝕜 (p '' s) ↔ i ∈ s :=
  ⟨hc _ _, fun hi => subset_convexHull 𝕜 _ (Set.mem_image_of_mem p hi)⟩
#align convex_independent.mem_convex_hull_iff ConvexIndependent.mem_convexHull_iff

/-- If a family is convex independent, a point in the family is not in the convex hull of the other
points. See `convex_independent_set_iff_not_mem_convex_hull_diff` for the `set` version.  -/
theorem convexIndependent_iff_not_mem_convexHull_diff {p : ι → E} :
    ConvexIndependent 𝕜 p ↔ ∀ i s, p i ∉ convexHull 𝕜 (p '' (s \ {i})) :=
  by
  refine' ⟨fun hc i s h => _, fun h s i hi => _⟩
  · rw [hc.mem_convex_hull_iff] at h
    exact h.2 (Set.mem_singleton _)
  · by_contra H
    refine' h i s _
    rw [Set.diff_singleton_eq_self H]
    exact hi
#align convex_independent_iff_not_mem_convex_hull_diff convexIndependent_iff_not_mem_convexHull_diff

theorem convexIndependent_set_iff_inter_convexHull_subset {s : Set E} :
    ConvexIndependent 𝕜 (fun x => x : s → E) ↔ ∀ t, t ⊆ s → s ∩ convexHull 𝕜 t ⊆ t :=
  by
  constructor
  · rintro hc t h x ⟨hxs, hxt⟩
    refine' hc { x | ↑x ∈ t } ⟨x, hxs⟩ _
    rw [Subtype.coe_image_of_subset h]
    exact hxt
  · intro hc t x h
    rw [← subtype.coe_injective.mem_set_image]
    exact hc (t.image coe) (Subtype.coe_image_subset s t) ⟨x.prop, h⟩
#align convex_independent_set_iff_inter_convex_hull_subset convexIndependent_set_iff_inter_convexHull_subset

/-- If a set is convex independent, a point in the set is not in the convex hull of the other
points. See `convex_independent_iff_not_mem_convex_hull_diff` for the indexed family version.  -/
theorem convexIndependent_set_iff_not_mem_convexHull_diff {s : Set E} :
    ConvexIndependent 𝕜 (fun x => x : s → E) ↔ ∀ x ∈ s, x ∉ convexHull 𝕜 (s \ {x}) :=
  by
  rw [convexIndependent_set_iff_inter_convexHull_subset]
  constructor
  · rintro hs x hxs hx
    exact (hs _ (Set.diff_subset _ _) ⟨hxs, hx⟩).2 (Set.mem_singleton _)
  · rintro hs t ht x ⟨hxs, hxt⟩
    by_contra h
    exact hs _ hxs (convexHull_mono (Set.subset_diff_singleton ht h) hxt)
#align convex_independent_set_iff_not_mem_convex_hull_diff convexIndependent_set_iff_not_mem_convexHull_diff

end OrderedSemiring

section LinearOrderedField

variable [LinearOrderedField 𝕜] [AddCommGroup E] [Module 𝕜 E] {s : Set E}

/-- To check convex independence, one only has to check finsets thanks to Carathéodory's theorem. -/
theorem convexIndependent_iff_finset {p : ι → E} :
    ConvexIndependent 𝕜 p ↔
      ∀ (s : Finset ι) (x : ι), p x ∈ convexHull 𝕜 (s.image p : Set E) → x ∈ s :=
  by
  refine' ⟨fun hc s x hx => hc s x _, fun h s x hx => _⟩
  · rwa [Finset.coe_image] at hx
  have hp : injective p := by
    rintro a b hab
    rw [← mem_singleton]
    refine' h {b} a _
    rw [hab, image_singleton, coe_singleton, convexHull_singleton]
    exact Set.mem_singleton _
  rw [convexHull_eq_union_convexHull_finite_subsets] at hx
  simp_rw [Set.mem_unionᵢ] at hx
  obtain ⟨t, ht, hx⟩ := hx
  rw [← hp.mem_set_image]
  refine' ht _
  suffices x ∈ t.preimage p (hp.inj_on _) by rwa [mem_preimage, ← mem_coe] at this
  refine' h _ x _
  rwa [t.image_preimage p (hp.inj_on _), filter_true_of_mem]
  · exact fun y hy => s.image_subset_range p (ht <| mem_coe.2 hy)
#align convex_independent_iff_finset convexIndependent_iff_finset

/-! ### Extreme points -/

theorem Convex.convexIndependent_extremePoints (hs : Convex 𝕜 s) :
    ConvexIndependent 𝕜 (fun p => p : s.extremePoints 𝕜 → E) :=
  convexIndependent_set_iff_not_mem_convexHull_diff.2 fun x hx h =>
    (extremePoints_convexHull_subset
          (inter_extremePoints_subset_extremePoints_of_subset
            (convexHull_min ((Set.diff_subset _ _).trans extremePoints_subset) hs) ⟨h, hx⟩)).2
      (Set.mem_singleton _)
#align convex.convex_independent_extreme_points Convex.convexIndependent_extremePoints

end LinearOrderedField


-- https://cr.yp.to/papers/goppadecoding-20220320.pdf
import tactic
import data.polynomial.basic
import linear_algebra.lagrange
import to_mathlib.with_bot_top
import to_mathlib.polynomial.degree_lt_le
import to_mathlib.linear_algebra.basic
import to_mathlib.polynomial.vandermonde
import to_mathlib.polynomial.misc

-- Section 2 (Polynomials)
/-
Much of this section is straightforwardly in mathlib. Imports are given (though
some may be redundant), and where there is a wrinkle to do with the way Lean
represents things, it's noted.
-/
section gdtwo

-- 2.1 (Commutative rings)
/-
Provided by the comm_ring structure. Note that there is a theory of semirings,
not-necessarily-commutative rings, etc. also.

import algebra.ring.basic
-/

-- 2.2 Ring morphisms
/-
Provided by the ring_hom structure (which extends multiplicative and additive
homomorphisms). This gives additive and multiplicative identity preservation,
and distribution over the operations. Preservation of additive inverse is given
by ring_hom.map_neg.

import algebra.ring.basic
-/

-- 2.3 Multiples
/-
This is simply about ideals and their generators. This is probably best given by
ideal.span (which defines the ideal which is generated by a ring). There are a
collection of span_singleton lemmas for the special case where the generating
set is a singleton (a principal ideal). There is a theorem of principal ideal
domains but this seems not necessary here.

import ring_theory.ideal.basic
-/

-- 2.4 Units
/-
The definition of a (multiplicative) unit is given by the is_unit predicate.
units M is the structure which contains the units of a monoid M in a bundled way
(that is, something of type units M contains the unit, its inverse, and proofs
that they form a left-sided and right-sided unit pair). units M is not a set -
you cannot talk about a ∈ units M, but given some a : M (where we have [ring M]),
if you have a hypothesis of type is_unit a, that contains the u : units M whose
coercion is a, so you can extract it.

import algebra.group.units
-/

-- 2.5 Fields
/-
Given by the field structure. The is_field predicate expresses that a ring is a
field; the is_field.to_field definition noncomputably takes a proof that a
ring R is a field and gives the field structure resulting.

import algebra.field.basic

-/

-- 2.6 Vector space
/-
A vector space is a module over a field. Lean does not have a separate notion of
a vector space, and so the module structure (which corresponds to a semimodule
in regular maths - i.e. it can be defined over a semiring) is used for it.

There is a lot of subtlety here that is not relevant outside of the original
algebraic context, and so other imports might be needed. Handle with care.

import algebra.module.basic
-/

-- 2.7 Standard n-dimensional vector space.
/-
A complicated issue because in full generality these structure can have
complicated indexing and so much is given in a high level of abstraction.
On top of that, finiteness can be a tricky issue when trying to do stuff
correctly. It might be that actually want you want is matrix.std_basis
or matrix.std_basis_matrix, as this could give you the matrix basis for the
special case of rows and columns. You need to think carefully about what is
meant here.

If you just want row vectors, incidentally, the ![a, b, ..., z] notation
introduced by data.fin.vec_notation will suffice, as these are things to which
matrices can be applied.

The following should give the required notation and the basis stuff. But here
be dragons if you aren't careful.

import data.matrix.basis
import data.matrix.notation
-/

-- 2.8 Linear maps
/-
The linear_map structure of algebra.module.linear_map is the abstract version of
this.

finrank_le_finrank_of_injective is the theorem that if a linear map between
two finite-dimensional spaces is injective, the dimension of the domain
is less than or equal to the dimension of the codomain. The converse implies
that when the domain has a greater dimension than the codomain, there is some
non-zero vector which maps to zero. One can also look at this using the
rank-nullity theorem, finrank_range_add_finrank_ker.

The theory of finite-dimensional spaces is obviously full of particular
theorems, and is covered by linear_algebra.finite_dimensional.

import algebra.module.linear_map
import linear_algebra.finite_dimensional
-/

-- 2.9 Polynomials
/-
Polynomials over a ring R are really just finitely-supported maps from R to
ℕ, along with the structure that retains the structure of R for addition and
scalar multiplication and defines products using convolution. This is an
additive monoid algebra, and so secretly this is just what a polynomial is
in Lean. However, data.basic provides a good API and notation so that
we mostly don't have to worry about any of this.

Note that polynomials are not (currently) implemented in a computable way -
that is, the definition of polynomials is sufficiently abstracted that it
requires classical choice. This might change at some point (because it is
not ideal...)

import data.polynomial.basic

-/

-- 2.10 The ring-structure of polynomials
/-
As mentioned, the commutative ring structure on polynomials over a commutative
ring is virtually present by definition. semiring is the core
instance - there are various other instances for generalisations or different
ways to view the structure.
-/

-- 2.11 The k-algebra structure of polynomials
/-
The C map is the constant map from R to R[X]. This is the algebra
map. The instance algebra_of_algebra shows that A[X] is an R-algebra
when A is an R-algebra, which gives the special case when A = R, and API is
provided for working with this.

import data.algebra_map
-/

-- 2.12 Units of k[x]
/-
The theorem is_unit_iff characterises the units of R[X], where R is
commutative domain, as the embedding of the units of R. When R is not a domain
but simply a commutative semiring, it is still true that a member of R is a unit
iff its embedding is (is_unit_C). (Consider (2X + 1)*(2X + 1) when R
is Z/(4) - 2X + 1 is a unit without degree 0. The issue turns out to be that
deg(f*g) = deg f * deg g for non-zero f, g may not be true in the presence of
zero divisors.)

import data.polynomial.ring_division
-/

-- 2.13 The k-vector structure of polynomials
/-
We have module as an instance, and it's definitionally equal to the
instance of module that arises from the instance of polynomials as an algebra
under the base ring - so from Lean's point of view these are the same.

import data.polynomial.basic
-/

-- 2.14 Powers of x
/-
monomial n a is the monomial a*X^n. We have sum_monomial_eq which tells us that
a polynomial is equal to the sum over its coefficients f_i of f_i*X^i (Lean
provides sum to do this kind of summation: internally this is a
finset.sum. This is as opposed to a finsum, which is the infinite sum over
finite non-zero values mentioned in the paper: for various reasons there are a
few different ways of doing finite sums but this is the way polynomial does
things). We also have from this a way of doing induction on polynomials by
proving an additive fact for monomials.

import data.polynomial.induction

-/

-- 2.15 Coefficients
/-
coeff p n gives the nth coefficient of n in p, where n : ℕ. Extending
this to ℤ would not be too hard; what the appropriate decision in 4.1 would
be is yet to be answered.

import data.polynomial.basic
-/

-- 2.16 Degree
/-
We have both degree and nat_degree (which differ in how
they handle the zero polynomial). There are a good number of theorems for these.

import data.polynomial.basic
-/

-- 2.17 Monic polynomials
/-
There is a monic predicate.

import data.degree.definitions
-/

-- 2.18 Evaluation
/-
eval exists, though it is non-computable so you can prove theorems
about it but not actually evaluate computationally.

import data.polynomial.basic
-/
-- 2.19 Roots
/-
roots gives a multiset of the polynomial's roots,
including multiplicity. It does not have a meaningful definition for the zero
polynomial!

import data.polynomial.basic
-/
-- 2.20 Vandermonde invertibility
/-
This derives from card_roots, which is a version of it though not
in the equivalent form.

However, it is also true separately from polynomial theory.
-/

-- 2.21 Transposed Vandermonde inequality
/-
Easily proved.
-/

-- 2.22 Derivatives
/-
derivative is the formal derivative of a  The product
rule is proven for it. Bernoulli's rule is not proven for it, but this shouldn't
be too difficult.

import data.derivative
-/

-- 2.23 Quotients and remainders
/-
There is a notion of polynomial division and modulo, but also polynomial
is a Euclidean domain which gives the q/r decomposition.
-/
-- 2.24 Unique Factorisation
/-
We have an instance of unique_factorization_monoid for polynomial, and it follows
from the Euclidean domain stuff.

-/
-- 2.25 Greatest common divisors
/-
Follows from Euclidean domain.
-/

-- 2.26 Squarefreeness
/-
separable.squarefree precisely gives that a polynomial is squarefree
if it is separable - which is exactly that it is coprime with its formal derivative.

import field_theory.separable
-/

end gdtwo

/-

namespace polynomial

universes u y v

variables {R : Type u} [comm_semiring R] {ι : Type y}

open_locale polynomial classical big_operators

theorem derivative_prod' {s : finset ι} {f : ι → R[X]} :
  derivative (∏ b in s, f b) = ∑ b in s, (∏ a in (s.erase b), f a) * (f b).derivative := derivative_prod

end polynomial
-/

section gdthree
open_locale polynomial classical big_operators

noncomputable theory

open polynomial finset lagrange

universes u v
variables {F : Type u} [field F] (s : finset F)

def nodal : F[X] := ∏ y in s, (X - C y)

lemma nodal_eq_remove {x : F} (hx : x ∈ s) : nodal s = (X - C x) * (∏ y in s.erase x, (X - C y)) := by {rw mul_prod_erase _ _ hx, refl}

lemma nodal_derive_eval_node_eq {x : F} (hx : x ∈ s) : eval x (nodal s).derivative = ∏ y in (s.erase x), (x - y) :=
begin
  rw [nodal_eq_remove _ hx, bernoulli_rule (root_X_sub_C.mpr rfl)],
  simp_rw [eval_prod, derivative_sub, derivative_X, derivative_C, sub_zero, eval_one, one_mul, eval_sub, eval_X, eval_C]
end

lemma nodal_div_eq {x : F} (hx : x ∈ s) :
nodal s / (X - C x) = (∏ y in s.erase x, (X - C y)) :=
begin
  rw [nodal_eq_remove _ hx, euclidean_domain.mul_div_cancel_left],
  apply X_sub_C_ne_zero,
end

lemma basis_eq_nodal_div_eval_deriv_mul_linear {x : F} (hx : x ∈ s) : basis s x = C (eval x (nodal s).derivative)⁻¹ * (nodal s / (X - C x))  :=
begin
  rw lagrange.basis,
  rw [nodal_div_eq _ hx, nodal_derive_eval_node_eq _ hx, prod_mul_distrib, ← prod_inv_distrib', map_prod],
end

lemma interpolate_eq_derivative_interpolate (f : F → F) : interpolate s f = ∑ x in s, C (f x * (eval x (nodal s).derivative)⁻¹) * (nodal s / (X - C x)) :=
begin
  apply sum_congr rfl, intros _ hx,
  rw [C.map_mul, basis_eq_nodal_div_eval_deriv_mul_linear _ hx, mul_assoc]
end

/-- Lagrange interpolation: given a finset `s` and a function `f : F → F`,
`interpolate s f` is the unique polynomial of degree `< s.card`
that takes value `f x` on all `x` in `s`. -/
def interpolate' (r : s → F) : F[X] :=
∑ x : s, C (r x) * basis s x

end gdthree

section gdfour
open_locale classical polynomial

open polynomial linear_map algebra

def approximant_error {R : Type*} [comm_ring R] (A B : R[X]) : R[X] × R[X] →ₗ[R] R[X] :=
coprod (lmul_right _ B) (lmul_right _ (-A))

def approximant_quotient {R : Type*} [comm_ring R] {a b A B : R[X]}
{n : ℕ} (hA : A ∈ degree_le R n) (hB : B ∈ degree_lt R n)
{t : ℕ} (ha : a ∈ degree_le R t) (hb : b ∈ degree_lt R t) :
R[X] × R[X] →ₗ[R] R[X] ⧸ degree_lt R (n - t) :=
(degree_lt R (n - t)).mkq.comp (approximant_error A B)

lemma approximant_error_apply {R : Type*} [comm_ring R] {A B a b : R[X]} : approximant_error A B (a, b) = a*B - b*A := by {simp only [approximant_error, coprod_apply, lmul_right_apply], ring }

lemma mul_sub_mul_degree_lt_add_of_degrees_le_lt_le_lt {R : Type*} [comm_ring R] [no_zero_divisors R] {a b A B : R[X]} {n t : ℕ}
(hA : A.degree ≤ n) (hB : B.degree < n) (ha : a.degree ≤ t) (hb : b.degree < t)
: (a*B - b*A).degree < t + n :=
begin
  have h : (a * B - b * A).degree ≤ max (a.degree + B.degree) (b.degree + A.degree),
    exact le_trans (degree_sub_le _ _) (le_of_eq (by simp only [degree_mul])),
  rw [le_max_iff] at h, cases h; apply lt_of_le_of_lt h,
  exact with_bot.add_lt_add_of_le_of_lt_of_right_ne_bot (with_bot.coe_ne_bot) ha hB,
  exact with_bot.add_lt_add_of_lt_of_le_of_right_ne_bot (with_bot.coe_ne_bot) hb hA
end

theorem approximate_error_bounded_degree
{R : Type*} [comm_ring R] [no_zero_divisors R] {A B : R[X]}
{n : ℕ} (hA : A ∈ degree_le R n) (hB : B ∈ degree_lt R n) (t : ℕ) :
∀ ab : R[X] × R[X], ab ∈ (degree_le R t).prod (degree_lt R t) →
(approximant_error A B) ab ∈ degree_lt R (t + n) :=
begin
  simp only [ mem_degree_lt, mem_degree_le, approximant_error_apply,
              submodule.mem_prod, and_imp, prod.forall] at *,
  intros a b ha hb,
  exact mul_sub_mul_degree_lt_add_of_degrees_le_lt_le_lt hA hB ha hb
end

def approximant_error_restricted {R : Type*} [comm_ring R] [no_zero_divisors R] {A B : R[X]}
{n : ℕ} (hA : A ∈ degree_le R n) (hB : B ∈ degree_lt R n) (t : ℕ) :
(degree_le R t).prod (degree_lt R t) →ₗ[R] degree_lt R (t + n) :=
linear_map.restrict' _ (approximate_error_bounded_degree hA hB _)

theorem comap_nontrivial {K : Type*} {V : Type*} {V₂ : Type*} [field K]
[add_comm_group V] [module K V] [add_comm_group V₂] [module K V₂]
(f : V →ₗ[K] V₂) {q : submodule K V₂}
(hq : (module.rank K V₂) < (module.rank K q) + (module.rank K V) ) : ∃ x ≠ 0, f x ∈ q :=
begin
  suffices H : submodule.comap f q ≠ ⊥,
  { rcases submodule.exists_mem_ne_zero_of_ne_bot H with ⟨x, hf, hx⟩,
    exact ⟨x, hx, hf⟩
  },
  intro H, apply not_le_of_lt hq,
  have range_disjoint : q ⊓ f.range = ⊥, by rw [inf_comm, ← linear_map.comap_le_ker_iff, H]; exact bot_le,
  have ker_trivial : f.ker = ⊥, by rw eq_bot_iff; exact le_trans (linear_map.ker_le_comap) H.le,
  convert linear_map.dim_le_of_injective _ (submodule.injective_subtype (q ⊔ f.range)),
  rw [  ← congr_arg ((+) (module.rank K ↥q)) (dim_range_add_dim_ker f),
        ker_trivial, ←add_assoc, ← dim_sup_add_dim_inf_eq, range_disjoint],
  simp_rw [dim_bot, add_zero]
end

end gdfour


import data.set data.stream.basic
open stream

structure LTS:= (S : Type) (Act : Type)(TR : set (S × Act × S))
--structure LTS:= (S : Type) (A : Type) (Δ : set (S × Act × S))

structure path (M : LTS) :=
(init : M.S)
(s : stream (M.Act × M.S))
(sound : ((init, (s 0).1, (s 0).2) ∈ M.TR) ∧
          ∀ i : ℕ, ((s i).2, (s (i+1)).1, (s (i+1)).2) ∈ M.TR)

variable {M : LTS}

namespace path

def index (π : path M) : ℕ+ → (M.Act × M.S)
| (n) := (π.s (n-1))

lemma drop_aux (π : path M) (n : ℕ) :
    ((π.s n).snd, (drop (n+1) π.s 0).fst, (drop (n+1) π.s 0).snd) ∈ M.TR ∧ ∀ (i : ℕ), ((drop (n+1) π.s i).snd, (stream.drop (n+1) π.s (i + 1)).fst, (drop (n+1) π.s (i + 1)).snd) ∈ M.TR :=
    begin
         have := π.sound, cases this with L R,
         rw stream.drop,
         dsimp at *, simp at *,
         split,
         apply R n,
         intro i,
         replace R := R (i+n.succ),
         rw add_assoc at R, rw add_comm n.succ 1 at R, rw ← add_assoc at R,
         apply R,
end

def drop (π : path M) : ℕ → path M
| 0 := π
| (nat.succ n) :=
    path.mk (π.s n).2 (π.s.drop n.succ) (drop_aux π n)

lemma drop_drop  (π : path M) {i j : ℕ} :
    (π.drop i).drop j = π.drop (i+j) :=
    begin
        cases i, {rw drop, simp},
        cases j, rw [drop,drop],
        rw drop, rw drop, rw drop, simp,
        rw drop_drop,
         split,
        rw stream.drop,
        simp, rw add_comm,
        rw nat.add_succ,
        rw add_comm, rw nat.add_succ,
        rw add_comm i.succ,
        rw nat.add_succ, rw add_comm,
    end

end path

inductive formula (M : LTS)
| T : formula
| state_predicate (p : M.S → Prop) : formula
| act_predicate (p : M.Act → Prop) : formula
| state (s : M.S) : formula
| act (a : M.Act) : formula
| neg (x : formula) : formula
| conj (φ₁ φ₂ : formula) : formula
| disj (φ₁ φ₂ : formula) : formula
| impl (φ₁ φ₂ : formula) : formula
| next (φ : formula) : formula
| always (φ : formula) : formula
| eventually (φ : formula) : formula
| until (φ₁ φ₂ : formula) : formula

def sat {M : LTS} : formula M → path M → Prop
| formula.T := λ _, true
| (formula.state s) :=  λ π, π.init = s
| (formula.act a)  := λ π, (path.index π 1).1 = a
| (formula.neg φ) := λ π, ¬ (sat φ) π
| (formula.conj φ₁ φ₂) := λ π, sat φ₁ π ∧ sat φ₂ π
| (formula.disj φ₁ φ₂) := λ π, sat φ₁ π ∨ sat φ₂ π
| (formula.impl φ₁ φ₂) := λ π, sat φ₁ π → sat φ₂ π
| (formula.next φ) := λ π, sat φ (π.drop 1)
| (formula.until φ₁ φ₂) := λ π,
    ∃ j, sat φ₂ (π.drop j) ∧ (∀ i < j, sat φ₁ (π.drop i))
| (formula.always φ) := λ π, ∀ i, sat φ (π.drop i)
| (formula.eventually φ) := λ π, ∃ i, sat φ (π.drop i)
| (formula.state_predicate p) := λ π, p π.init
| (formula.act_predicate p) := λ π, p (path.index π 1).1

notation φ ` & ` ψ := formula.conj  φ ψ
notation φ ` ⅋ ` ψ := formula.disj φ ψ
notation ` !` φ := formula.neg φ
notation φ ` U ` ψ := formula.until φ ψ
notation ` ◆` φ := formula.eventually φ
notation ` ◾` φ  := formula.always  φ
notation φ ` ⇒ ` ψ := formula.impl φ ψ
notation π `⊨` P := sat P π

namespace formula

def weak_until (φ ψ : formula M) : formula M :=
(◾φ) ⅋ (φ U ψ)

end formula

notation φ ` W ` ψ := formula.weak_until φ ψ

namespace sat

lemma  weak_until (φ ψ : formula M) (π : path M) :
    sat (formula.weak_until φ ψ) π ↔ sat (◾ φ) π ∨ sat (φ U ψ) π :=
  by {rw formula.weak_until, repeat {rw sat}}

end sat

lemma push_neg_tok {M : LTS} {π : path M} : ∀ P : formula M,
    ¬ (sat P π) ↔ sat (!P) π :=
by {intro P, refl,}

lemma always_eventually_dual (P : formula M) (π : path M) :
    sat (◾!P) π ↔ (¬ sat (◆P) π) :=
by {repeat {rw sat}, tidy}

@[simp] lemma succ_add_1 {π : path M} {i : ℕ} :
 (π.drop i).drop 1 = π.drop (i.succ) :=
 by {rw path.drop_drop}


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

import .basic

section relation
variables {α : Sort*} (r : α → α → Prop)

definition euclidean : Prop := ∀ {{x y z}}, r x y → r x z → r y z

definition equivalence.mk : reflexive r → euclidean r → equivalence r :=
λ hr he, mk_equivalence r hr (λ _ _ hxy, he hxy (hr _)) (λ _ _ _ hxy hyz, he (he hxy (hr _)) hyz)

inductive ec : α → α → Prop
| base {{x y}} : r x y → ec x y
| refl {} (x) : ec x x
| eucl {{x y z}} : ec x y → ec x z → ec y z

theorem tc_transitive : transitive (tc r) := tc.trans

theorem ec_equivalence : equivalence (ec r) := equivalence.mk (ec r) ec.refl ec.eucl

variable {r}

theorem equivalence.refl : equivalence r → reflexive r := λ ⟨hr, _, _⟩, hr

theorem equivalence.symm : equivalence r → symmetric r := λ ⟨_, hs, _⟩, hs

theorem equivalence.trans : equivalence r → transitive r := λ ⟨_, _, ht⟩, ht

theorem equivalence.eucl : equivalence r → euclidean r :=  λ ⟨_, hs, ht⟩ x y z h₁ h₂, ht (hs h₁) h₂

theorem tc.mono {s : α → α → Prop} : (∀ {{x y}}, r x y → s x y) → ∀ {{x y}}, tc r x y → tc s x y :=
λ hrs x y htc, tc.rec_on htc (λ _ _ hxy, tc.base _ _ (hrs hxy)) (λ _ _ _ _ _ ixy iyz, tc.trans _ _ _ ixy iyz)

theorem tc.elim {s : α → α → Prop} (hs : transitive s) : (∀ {{x y}}, r x y → s x y) → ∀ {{x y}}, tc r x y → s x y :=
λ hrs x y htc, tc.rec_on htc hrs (λ _ _ _ _ _ ixy iyz, hs ixy iyz)

theorem tc.elim_self (hr : transitive r) : ∀ {{x y}}, tc r x y → r x y := tc.elim hr (λ _ _, id)

theorem ec_of_eq : ∀ {{x y}}, x = y → ec r x y
| _ _ rfl := ec.refl _

theorem ec.symm {{x y}} : ec r x y → ec r y x :=
λ h, ec.eucl h $ ec.refl x

theorem ec.trans {{x y z}} : ec r x y → ec r y z → ec r x z :=
λ h₁ h₂, ec.eucl (ec.symm h₁) h₂

theorem ec.mono {s : α → α → Prop} : (∀ {{x y}}, r x y → s x y) → ∀ {{x y}}, ec r x y → ec s x y :=
λ h x y hec, ec.rec_on hec (λ _ _ hr, ec.base (h hr)) (λ x, ec.refl x) (λ _ _ _ _ _ ixy ixz, ec.eucl ixy ixz)

theorem ec.elim {s : α → α → Prop} (hs : equivalence s) : (∀ {{x y}}, r x y → s x y) → ∀ {{x y}}, ec r x y → s x y :=
λ hrs x y, ec.rec hrs (λ x, hs.refl x) (λ _ _ _ _ _ ixy ixz, hs.eucl ixy ixz)

theorem ec.elim_self (hr : equivalence r) : ∀ {{x y}}, ec r x y → r x y := ec.elim hr (λ _ _, id)

theorem tc_iff_self_of_transitive (hr : transitive r) (x y) : tc r x y ↔ r x y :=
⟨λ h, tc.elim_self hr h, λ h, tc.base _ _ h⟩

theorem tc_eq_self_of_transitive (hr : transitive r) : tc r = r :=
funext $ λ x, funext $ λ y, propext $ tc_iff_self_of_transitive hr x y

theorem ec_iff_self_of_equivalence (hr : equivalence r) (x y) : ec r x y ↔ r x y :=
⟨λ h, ec.elim_self hr h, λ h, ec.base h⟩

theorem ec_eq_self_of_equivalence (hr : equivalence r) : ec r = r :=
funext $ λ x, funext $ λ y, propext $ ec_iff_self_of_equivalence hr x y

theorem ec_of_ec_rc {{x y}} : ec (λ x y, r x y ∨ x = y) x y → ec r x y :=
λ e, ec.rec_on e
(λ _ _ hxy, or.elim hxy (λ h, ec.base h) (λ h, ec_of_eq h))
(λ _, ec.refl _)
(λ _ _ _ _ _ hxy hxz, ec.eucl hxy hxz)

theorem ec_rc_of_ec {{x y}} : ec r x y → ec (λ x y, r x y ∨ x = y) x y :=
λ h, ec.mono (λ _ _, or.inl) h

variable (r)

theorem ec_rc_eq_ec : ec (λ x y, r x y ∨ x = y) = ec r :=
funext $ λ x, funext $ λ y, propext $ ⟨λ h, ec_of_ec_rc h, λ h, ec_rc_of_ec h⟩

theorem tc_idempotent : tc (tc r) = tc r := tc_eq_self_of_transitive (tc_transitive r)

theorem ec_idempotent : ec (ec r) = ec r := ec_eq_self_of_equivalence (ec_equivalence r)

lemma ec_of_eqv_gen {α : Type*} {r : α → α → Prop} {{x y : α}} : eqv_gen r x y → ec r x y :=
λ h, eqv_gen.rec_on h
  (λ _ _ h, ec.base h)
  (λ _, ec.refl _)
  (λ _ _ _ ixy, ec.symm ixy)
  (λ _ _ _ _ _ ixy iyz, ec.trans ixy iyz)

lemma eqv_gen_of_ec {α : Type*} {r : α → α → Prop} {{x y : α}} : ec r x y → eqv_gen r x y :=
λ h, ec.rec_on h
  (λ _ _ h, eqv_gen.rel _ _ h)
  (λ _, eqv_gen.refl _)
  (λ _ _ _ _ _ ixy ixz, eqv_gen.trans _ _ _ (eqv_gen.symm _ _ ixy) ixz)

theorem eqv_gen_iff_ec {α : Type*} (r : α → α → Prop) (x y : α) : eqv_gen r x y ↔ ec r x y :=
⟨λ h, ec_of_eqv_gen h, λ h, eqv_gen_of_ec h⟩

theorem eqv_gen_eq_ec {α : Type*} (r : α → α → Prop) : eqv_gen r = ec r :=
funext $ λ x, funext $ λ y, propext $ eqv_gen_iff_ec r x y

end relation

namespace quot
variables {α : Sort*} {r : α → α → Prop}

private def ecq : quot r → quot r → Prop :=
have h₀ : ∀ x₁ x₂, r x₁ x₂ → ec r x₁ = ec r x₂,
from λ x₁ x₂ h, funext $ λ y, propext $ ⟨ec.eucl (ec.base h), ec.eucl (ec.symm (ec.base h))⟩,
let r₁ : quot r → α → Prop := quot.lift (ec r) h₀ in
have h₁ : ∀ x y₁ y₂, r y₁ y₂ → r₁ x y₁ = r₁ x y₂,
from λ x, quot.induction_on x (λ x y₁ y₂ h, show ec r x y₁ = ec r x y₂, from propext ⟨λ h₁, ec.trans h₁ (ec.base h), λ h₂, ec.trans h₂ (ec.symm (ec.base h))⟩),
λ x, quot.lift (r₁ x) $ (h₁ x)

private lemma ecq_refl (x : quot r) : ecq x x := quot.induction_on x ec.refl

private lemma ecq_of_eq : ∀ {x y : quot r}, x = y → ecq x y | _ _ rfl := ecq_refl _

theorem ec_exact {x y : α} : quot.mk r x = quot.mk r y → ec r x y := ecq_of_eq

theorem ec_sound {x y : α} : ec r x y → quot.mk r x = quot.mk r y :=
λ h, ec.rec_on h
  (λ _ _ h, quot.sound h)
  (λ _, rfl)
  (λ _ _ _ _ _ hxy hxz, eq.subst hxy hxz)

end quot

definition relation.pi {α : Sort*} {β : α → Sort*} (r : Π i, β i → β i → Prop) (x y : Π i, β i) : Prop := ∀ i, r i (x i) (y i)

namespace relation
variables {α : Sort*} {β : α → Sort*} {r : Π i, β i → β i → Prop}

theorem pi_reflexive : (∀ i, reflexive (r i)) → reflexive (pi r) := λ h x i, h i (x i)

theorem pi_symmetric : (∀ i, symmetric (r i)) → symmetric (pi r) := λ h x y hxy i, h i (hxy i)

theorem pi_transitive : (∀ i, transitive (r i)) → transitive (pi r) := λ h x y z hxy hyz i, h i (hxy i) (hyz i)

theorem pi_euclidean : (∀ i, euclidean (r i)) → euclidean (pi r) := λ h x y z hxy hxz i, h i (hxy i) (hxz i)

theorem pi_equivalence : (∀ i, equivalence (r i)) → equivalence (pi r) :=
λ heq, equivalence.mk (pi r) (pi_reflexive $ λ i, equivalence.refl (heq i)) (pi_euclidean $ λ i, equivalence.eucl (heq i))

theorem pi_tc_of_tc_pi {t₁ t₂ : Π i, β i} : tc (pi r) t₁ t₂ → pi (λ i, tc (r i)) t₁ t₂ :=
have htr : transitive (pi (λ i, tc (r i))), from pi_transitive (λ i, tc_transitive (r i)),
have hin : ∀ {{t₁ t₂}}, pi r t₁ t₂ → pi (λ i, tc (r i)) t₁ t₂, from λ _ _ h i, tc.base _ _ (h i),
λ h, tc.elim htr hin h

theorem pi_ec_of_ec_pi {t₁ t₂ : Π i, β i} : ec (pi r) t₁ t₂ → pi (λ i, ec (r i)) t₁ t₂ :=
have heq : equivalence (pi (λ i, ec (r i))), from pi_equivalence (λ i, ec_equivalence (r i)),
have hin : ∀ {{t₁ t₂}}, pi r t₁ t₂ → pi (λ i, ec (r i)) t₁ t₂, from λ _ _ h i, ec.base (h i),
λ h, ec.elim heq hin h

end relation

definition {u v} relation.pr {α₁ : Sort u} {α₂ : Sort v} (r : pprod (α₁ → α₁ → Prop) (α₂ → α₂ → Prop)) (x y : pprod α₁ α₂) : Prop := r.fst x.fst y.fst ∧ r.snd x.snd y.snd

namespace relation
variables {α₁ : Sort*} {α₂ : Sort*} {r : pprod (α₁ → α₁ → Prop) (α₂ → α₂ → Prop)}

theorem pr_reflexive : reflexive r.fst → reflexive r.snd → reflexive (pr r) :=
λ h₁ h₂ ⟨x₁, x₂⟩, ⟨h₁ x₁, h₂ x₂⟩

theorem pr_symmetric : symmetric r.fst → symmetric r.snd → symmetric (pr r) :=
λ h₁ h₂ _ _ ⟨hxy₁, hxy₂⟩, ⟨h₁ hxy₁, h₂ hxy₂⟩

theorem pr_transitive : transitive r.fst → transitive r.snd → transitive (pr r) :=
λ h₁ h₂ _ _ _ ⟨hxy₁, hxy₂⟩ ⟨hyz₁, hyz₂⟩, ⟨h₁ hxy₁ hyz₁, h₂ hxy₂ hyz₂⟩

theorem pr_euclidean : euclidean r.fst → euclidean r.snd → euclidean (pr r) :=
λ h₁ h₂ _ _ _ ⟨hxy₁, hxy₂⟩ ⟨hxz₁, hxz₂⟩, ⟨h₁ hxy₁ hxz₁, h₂ hxy₂ hxz₂⟩

theorem pr_equivalence : equivalence r.fst → equivalence r.snd → equivalence (pr r) :=
λ h₁ h₂, equivalence.mk (pr r) (pr_reflexive (equivalence.refl h₁) (equivalence.refl h₂)) (pr_euclidean (equivalence.eucl h₁) (equivalence.eucl h₂))

theorem pr_tc_of_tc_pr {x y : pprod α₁ α₂} : tc (pr r) x y → pr ⟨tc r.fst, tc r.snd⟩ x y :=
have htr : transitive (pr ⟨tc r.fst, tc r.snd⟩), from pr_transitive (tc_transitive r.fst) (tc_transitive r.snd),
have hin : ∀ {{x y}}, pr r x y → pr ⟨tc r.fst, tc r.snd⟩ x y, from λ _ _ ⟨hxy₁, hxy₂⟩, ⟨tc.base _ _ hxy₁, tc.base _ _ hxy₂⟩,
λ h, tc.elim htr hin h

theorem pr_ec_of_ec_pr {x y : pprod α₁ α₂} : ec (pr r) x y → pr ⟨ec r.fst, ec r.snd⟩ x y :=
have heq : equivalence (pr ⟨ec r.fst, ec r.snd⟩), from pr_equivalence (ec_equivalence r.fst) (ec_equivalence r.snd),
have hin : ∀ {{x y}}, pr r x y → pr ⟨ec r.fst, ec r.snd⟩ x y, from λ _ _ ⟨hxy₁, hxy₂⟩, ⟨ec.base hxy₁, ec.base hxy₂⟩,
λ h, ec.elim heq hin h

end relation


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

! This file was ported from Lean 3 source module tactic.qify
! leanprover-community/mathlib commit 9fe85cd025655fc6285758c29b6a392c0fa96743
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.NormCast
import Mathbin.Data.Rat.Cast

/-!
# A tactic to shift `ℕ` or `ℤ` goals to `ℚ`

Note that this file is following from `zify`.

Division in `ℕ` and `ℤ` is not always working fine (e.g. (5 : ℕ) / 2 = 2), so it's easier
to work in `ℚ`, where division and subtraction are well behaved. `qify` can be used to cast goals
and hypotheses about natural numbers or integers to rational numbers. It makes use of `push_cast`,
part of the `norm_cast` family, to simplify these goals.

## Implementation notes

`qify` is extensible, using the attribute `@[qify]` to label lemmas used for moving propositions
from `ℕ` or `ℤ` to `ℚ`.
`qify` lemmas should have the form `∀ a₁ ... aₙ : ℕ, Pq (a₁ : ℚ) ... (aₙ : ℚ) ↔ Pn a₁ ... aₙ`.
For example, `rat.coe_nat_le_coe_nat_iff : ∀ (m n : ℕ), ↑m ≤ ↑n ↔ m ≤ n` is a `qify` lemma.

`qify` is very nearly just `simp only with qify push_cast`. There are a few minor differences:
* `qify` lemmas are used in the opposite order of the standard simp form.
  E.g. we will rewrite with `rat.coe_nat_le_coe_nat_iff` from right to left.
* `qify` should fail if no `qify` lemma applies (i.e. it was unable to shift any proposition to ℚ).
  However, once this succeeds, it does not necessarily need to rewrite with any `push_cast` rules.
-/

open Tactic

namespace Qify

/-- The `qify` attribute is used by the `qify` tactic. It applies to lemmas that shift propositions
from `nat` or `int` to `rat`.

`qify` lemmas should have the form `∀ a₁ ... aₙ : ℕ, Pq (a₁ : ℚ) ... (aₙ : ℚ) ↔ Pn a₁ ... aₙ` or
 `∀ a₁ ... aₙ : ℤ, Pq (a₁ : ℚ) ... (aₙ : ℚ) ↔ Pz a₁ ... aₙ`.
For example, `rat.coe_nat_le_coe_nat_iff : ∀ (m n : ℕ), ↑m ≤ ↑n ↔ m ≤ n` is a `qify` lemma.
-/
@[user_attribute]
unsafe def qify_attr : user_attribute simp_lemmas Unit
    where
  Name := `qify
  descr := "Used to tag lemmas for use in the `qify` tactic"
  cache_cfg :=
    { mk_cache := fun ns =>
        mapM
            (fun n => do
              let c ← mk_const n
              return (c, tt))
            ns >>=
          simp_lemmas.mk.append_with_symm
      dependencies := [] }
#align qify.qify_attr qify.qify_attr

/-- Given an expression `e`, `lift_to_q e` looks for subterms of `e` that are propositions "about"
natural numbers or integers and change them to propositions about rational numbers.

Returns an expression `e'` and a proof that `e = e'`.

Includes `ge_iff_le` and `gt_iff_lt` in the simp set. These can't be tagged with `qify` as we
want to use them in the "forward", not "backward", direction.
-/
unsafe def lift_to_q (e : expr) : tactic (expr × expr) := do
  let sl ← qify_attr.get_cache
  let sl ← sl.add_simp `ge_iff_le
  let sl ← sl.add_simp `gt_iff_lt
  let (e', prf, _) ← simplify sl [] e
  return (e', prf)
#align qify.lift_to_q qify.lift_to_q

@[qify]
theorem Rat.coe_nat_le_coe_nat_iff (a b : ℕ) : (a : ℚ) ≤ b ↔ a ≤ b := by simp
#align qify.rat.coe_nat_le_coe_nat_iff Qify.Rat.coe_nat_le_coe_nat_iff

@[qify]
theorem Rat.coe_nat_lt_coe_nat_iff (a b : ℕ) : (a : ℚ) < b ↔ a < b := by simp
#align qify.rat.coe_nat_lt_coe_nat_iff Qify.Rat.coe_nat_lt_coe_nat_iff

@[qify]
theorem Rat.coe_nat_eq_coe_nat_iff (a b : ℕ) : (a : ℚ) = b ↔ a = b := by simp
#align qify.rat.coe_nat_eq_coe_nat_iff Qify.Rat.coe_nat_eq_coe_nat_iff

@[qify]
theorem Rat.coe_nat_ne_coe_nat_iff (a b : ℕ) : (a : ℚ) ≠ b ↔ a ≠ b := by simp
#align qify.rat.coe_nat_ne_coe_nat_iff Qify.Rat.coe_nat_ne_coe_nat_iff

@[qify]
theorem Rat.coe_int_le_coe_int_iff (a b : ℤ) : (a : ℚ) ≤ b ↔ a ≤ b := by simp
#align qify.rat.coe_int_le_coe_int_iff Qify.Rat.coe_int_le_coe_int_iff

@[qify]
theorem Rat.coe_int_lt_coe_int_iff (a b : ℤ) : (a : ℚ) < b ↔ a < b := by simp
#align qify.rat.coe_int_lt_coe_int_iff Qify.Rat.coe_int_lt_coe_int_iff

@[qify]
theorem Rat.coe_int_eq_coe_int_iff (a b : ℤ) : (a : ℚ) = b ↔ a = b := by simp
#align qify.rat.coe_int_eq_coe_int_iff Qify.Rat.coe_int_eq_coe_int_iff

@[qify]
theorem Rat.coe_int_ne_coe_int_iff (a b : ℤ) : (a : ℚ) ≠ b ↔ a ≠ b := by simp
#align qify.rat.coe_int_ne_coe_int_iff Qify.Rat.coe_int_ne_coe_int_iff

end Qify

/-- `qify extra_lems e` is used to shift propositions in `e` from `ℕ` or `ℤ` to `ℚ`.
This is often useful since `ℚ` has well-behaved division and subtraction.

The list of extra lemmas is used in the `push_cast` step.

Returns an expression `e'` and a proof that `e = e'`.-/
unsafe def tactic.qify (extra_lems : List simp_arg_type) : expr → tactic (expr × expr) := fun q =>
  do
  let (q1, p1) ← qify.lift_to_q q <|> fail "failed to find an applicable qify lemma"
  let (q2, p2) ← norm_cast.derive_push_cast extra_lems q1
  Prod.mk q2 <$> mk_eq_trans p1 p2
#align tactic.qify tactic.qify

/-- A variant of `tactic.qify` that takes `h`, a proof of a proposition about natural numbers
or integers, and returns a proof of the qified version of that propositon.
-/
unsafe def tactic.qify_proof (extra_lems : List simp_arg_type) (h : expr) : tactic expr := do
  let (_, pf) ← infer_type h >>= tactic.qify extra_lems
  mk_eq_mp pf h
#align tactic.qify_proof tactic.qify_proof

section

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- The `qify` tactic is used to shift propositions from `ℕ` or `ℤ` to `ℚ`.
This is often useful since `ℚ` has well-behaved division and subtraction.

```lean
example (a b c : ℕ) (x y z : ℤ) (h : ¬ x*y*z < 0) : c < a + 3*b :=
begin
  qify,
  qify at h,
  /-
  h : ¬↑x * ↑y * ↑z < 0
  ⊢ ↑c < ↑a + 3 * ↑b
  -/
end
```

`qify` can be given extra lemmas to use in simplification. This is especially useful in the
presence of subtraction and division: passing `≤` or `∣` arguments will allow `push_cast`
to do more work.
```
example (a b c : ℕ) (h : a - b < c) (hab : b ≤ a) : false :=
begin
  qify [hab] at h,
  /- h : ↑a - ↑b < ↑c -/
end
```

```
example (a b c : ℕ) (h : a / b = c) (hab : b ∣ a) : false :=
begin
  qify [hab] at h,
  /- h : ↑a / ↑b = ↑c -/
end
```

`qify` makes use of the `@[qify]` attribute to move propositions,
and the `push_cast` tactic to simplify the `ℚ`-valued expressions.
-/
unsafe def tactic.interactive.qify (sl : parse simp_arg_list) (l : parse location) : tactic Unit :=
  do
  let locs ← l.get_locals
  replace_at (tactic.qify sl) locs l >>= guardb
#align tactic.interactive.qify tactic.interactive.qify

end

add_tactic_doc
  { Name := "qify"
    category := DocCategory.attr
    declNames := [`qify.qify_attr]
    tags := ["coercions", "transport"] }

add_tactic_doc
  { Name := "qify"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.qify]
    tags := ["coercions", "transport"] }


/-
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

! This file was ported from Lean 3 source module category_theory.quotient
! leanprover-community/mathlib commit 740acc0e6f9adf4423f92a485d0456fc271482da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.NatIso
import Mathlib.CategoryTheory.EqToHom

/-!
# Quotient category

Constructs the quotient of a category by an arbitrary family of relations on its hom-sets,
by introducing a type synonym for the objects, and identifying homs as necessary.

This is analogous to 'the quotient of a group by the normal closure of a subset', rather
than 'the quotient of a group by a normal subgroup'. When taking the quotient by a congruence
relation, `functor_map_eq_iff` says that no unnecessary identifications have been made.
-/

/-- A `HomRel` on `C` consists of a relation on every hom-set. -/
def HomRel (C) [Quiver C] :=
  ∀ ⦃X Y : C⦄, (X ⟶ Y) → (X ⟶ Y) → Prop
#align hom_rel HomRel

-- Porting Note: `deriving Inhabited` was not able to deduce this typeclass
instance (C) [Quiver C] : Inhabited (HomRel C) where
  default := fun _ _ _ _ ↦ PUnit

namespace CategoryTheory

variable {C : Type _} [Category C] (r : HomRel C)

/-- A `HomRel` is a congruence when it's an equivalence on every hom-set, and it can be composed
from left and right. -/
class Congruence : Prop where
  /-- `r` is an equivalence on every hom-set. -/
  isEquiv : ∀ {X Y}, IsEquiv _ (@r X Y)
  /-- Precomposition with an arrow respects `r`. -/
  compLeft : ∀ {X Y Z} (f : X ⟶ Y) {g g' : Y ⟶ Z}, r g g' → r (f ≫ g) (f ≫ g')
  /-- Postcomposition with an arrow respects `r`. -/
  compRight : ∀ {X Y Z} {f f' : X ⟶ Y} (g : Y ⟶ Z), r f f' → r (f ≫ g) (f' ≫ g)
#align category_theory.congruence CategoryTheory.Congruence

attribute [instance] Congruence.isEquiv

/-- A type synonym for `C`, thought of as the objects of the quotient category. -/
@[ext]
structure Quotient (r : HomRel C) where
  /-- The object of `C`. -/
  as : C
#align category_theory.quotient CategoryTheory.Quotient

instance [Inhabited C] : Inhabited (Quotient r) :=
  ⟨{ as := default }⟩

namespace Quotient

/-- Generates the closure of a family of relations w.r.t. composition from left and right. -/
inductive CompClosure (r : HomRel C) ⦃s t : C⦄ : (s ⟶ t) → (s ⟶ t) → Prop
  | intro {a b : C} (f : s ⟶ a) (m₁ m₂ : a ⟶ b) (g : b ⟶ t) (h : r m₁ m₂) :
    CompClosure r (f ≫ m₁ ≫ g) (f ≫ m₂ ≫ g)
#align category_theory.quotient.comp_closure CategoryTheory.Quotient.CompClosure

theorem CompClosure.of {a b : C} (m₁ m₂ : a ⟶ b) (h : r m₁ m₂) : CompClosure r m₁ m₂ := by
  simpa using CompClosure.intro (𝟙 _) m₁ m₂ (𝟙 _) h
#align category_theory.quotient.comp_closure.of CategoryTheory.Quotient.CompClosure.of

theorem comp_left {a b c : C} (f : a ⟶ b) :
    ∀ (g₁ g₂ : b ⟶ c) (_ : CompClosure r g₁ g₂), CompClosure r (f ≫ g₁) (f ≫ g₂)
  | _, _, ⟨x, m₁, m₂, y, h⟩ => by simpa using CompClosure.intro (f ≫ x) m₁ m₂ y h
#align category_theory.quotient.comp_left CategoryTheory.Quotient.comp_left

theorem comp_right {a b c : C} (g : b ⟶ c) :
    ∀ (f₁ f₂ : a ⟶ b) (_ : CompClosure r f₁ f₂), CompClosure r (f₁ ≫ g) (f₂ ≫ g)
  | _, _, ⟨x, m₁, m₂, y, h⟩ => by simpa using CompClosure.intro x m₁ m₂ (y ≫ g) h
#align category_theory.quotient.comp_right CategoryTheory.Quotient.comp_right

/-- Hom-sets of the quotient category. -/
def Hom (s t : Quotient r) :=
  Quot <| @CompClosure C _ r s.as t.as
#align category_theory.quotient.hom CategoryTheory.Quotient.Hom

instance (a : Quotient r) : Inhabited (Hom r a a) :=
  ⟨Quot.mk _ (𝟙 a.as)⟩

/-- Composition in the quotient category. -/
def comp ⦃a b c : Quotient r⦄ : Hom r a b → Hom r b c → Hom r a c := fun hf hg ↦
  Quot.liftOn hf
    (fun f ↦
      Quot.liftOn hg (fun g ↦ Quot.mk _ (f ≫ g)) fun g₁ g₂ h ↦
        Quot.sound <| comp_left r f g₁ g₂ h)
    fun f₁ f₂ h ↦ Quot.inductionOn hg fun g ↦ Quot.sound <| comp_right r g f₁ f₂ h
#align category_theory.quotient.comp CategoryTheory.Quotient.comp

@[simp]
theorem comp_mk {a b c : Quotient r} (f : a.as ⟶ b.as) (g : b.as ⟶ c.as) :
    comp r (Quot.mk _ f) (Quot.mk _ g) = Quot.mk _ (f ≫ g) :=
  rfl
#align category_theory.quotient.comp_mk CategoryTheory.Quotient.comp_mk

-- porting note: Had to manually add the proofs of `comp_id` `id_comp` and `assoc`
instance category : Category (Quotient r) where
  Hom := Hom r
  id a := Quot.mk _ (𝟙 a.as)
  comp := @comp _ _ r
  comp_id f := Quot.inductionOn f $ by simp
  id_comp f := Quot.inductionOn f $ by simp
  assoc f g h := Quot.inductionOn f $ Quot.inductionOn g $ Quot.inductionOn h $ by simp
#align category_theory.quotient.category CategoryTheory.Quotient.category

/-- The functor from a category to its quotient. -/
@[simps]
def functor : C ⥤ Quotient r where
  obj a := { as := a }
  map := @fun _ _ f ↦ Quot.mk _ f
#align category_theory.quotient.functor CategoryTheory.Quotient.functor

noncomputable instance fullFunctor : Full (functor r) where preimage := @fun X Y f ↦ Quot.out f

instance : EssSurj (functor r)
    where mem_essImage Y :=
    ⟨Y.as, ⟨eqToIso (by
            ext
            rfl)⟩⟩

protected theorem induction {P : ∀ {a b : Quotient r}, (a ⟶ b) → Prop}
    (h : ∀ {x y : C} (f : x ⟶ y), P ((functor r).map f)) :
    ∀ {a b : Quotient r} (f : a ⟶ b), P f :=
  by
  rintro ⟨x⟩ ⟨y⟩ ⟨f⟩
  exact h f
#align category_theory.quotient.induction CategoryTheory.Quotient.induction

protected theorem sound {a b : C} {f₁ f₂ : a ⟶ b} (h : r f₁ f₂) :
    (functor r).map f₁ = (functor r).map f₂ := by
  simpa using Quot.sound (CompClosure.intro (𝟙 a) f₁ f₂ (𝟙 b) h)
#align category_theory.quotient.sound CategoryTheory.Quotient.sound

theorem functor_map_eq_iff [h : Congruence r] {X Y : C} (f f' : X ⟶ Y) :
    (functor r).map f = (functor r).map f' ↔ r f f' :=
  by
  constructor
  · erw [Quot.eq]
    intro h
    induction' h with m m' hm
    · cases hm
      apply Congruence.compLeft
      apply Congruence.compRight
      assumption
    · haveI := (h.isEquiv : IsEquiv _ (@r X Y))
      -- porting note: had to add this line for `refl` (and name the `Congruence` argument)
      apply refl
    · apply symm
      assumption
    · apply _root_.trans <;> assumption
  · apply Quotient.sound
#align category_theory.quotient.functor_map_eq_iff CategoryTheory.Quotient.functor_map_eq_iff

variable {D : Type _} [Category D] (F : C ⥤ D)
  (H : ∀ (x y : C) (f₁ f₂ : x ⟶ y), r f₁ f₂ → F.map f₁ = F.map f₂)

/-- The induced functor on the quotient category. -/
@[simps]
def lift : Quotient r ⥤ D where
  obj a := F.obj a.as
  map := @fun a b hf ↦
    Quot.liftOn hf (fun f ↦ F.map f)
      (by
        rintro _ _ ⟨_, _, _, _, h⟩
        simp [H _ _ _ _ h])
  map_id a := F.map_id a.as
  map_comp := by
    rintro a b c ⟨f⟩ ⟨g⟩
    exact F.map_comp f g
#align category_theory.quotient.lift CategoryTheory.Quotient.lift

theorem lift_spec : functor r ⋙ lift r F H = F :=
  by
  apply Functor.ext; rotate_left
  · rintro X
    rfl
  · rintro X Y f
    simp
#align category_theory.quotient.lift_spec CategoryTheory.Quotient.lift_spec

theorem lift_unique (Φ : Quotient r ⥤ D) (hΦ : functor r ⋙ Φ = F) : Φ = lift r F H :=
  by
  subst_vars
  fapply Functor.hext
  · rintro X
    dsimp [lift, Functor]
    congr
  · rintro _ _ f
    dsimp [lift, Functor]
    refine Quot.inductionOn f (fun _ ↦ ?_) -- porting note: this line was originally an `apply`
    simp only [Quot.liftOn_mk, Functor.comp_map]
    congr
#align category_theory.quotient.lift_unique CategoryTheory.Quotient.lift_unique

/-- The original functor factors through the induced functor. -/
def lift.isLift : functor r ⋙ lift r F H ≅ F :=
  NatIso.ofComponents (fun X ↦ Iso.refl _) (by aesop_cat)
#align category_theory.quotient.lift.is_lift CategoryTheory.Quotient.lift.isLift

@[simp]
theorem lift.isLift_hom (X : C) : (lift.isLift r F H).hom.app X = 𝟙 (F.obj X) :=
  rfl
#align category_theory.quotient.lift.is_lift_hom CategoryTheory.Quotient.lift.isLift_hom

@[simp]
theorem lift.isLift_inv (X : C) : (lift.isLift r F H).inv.app X = 𝟙 (F.obj X) :=
  rfl
#align category_theory.quotient.lift.is_lift_inv CategoryTheory.Quotient.lift.isLift_inv

theorem lift_map_functor_map {X Y : C} (f : X ⟶ Y) :
    (lift r F H).map ((functor r).map f) = F.map f :=
  by
  rw [← NatIso.naturality_1 (lift.isLift r F H)]
  dsimp
  simp
#align category_theory.quotient.lift_map_functor_map CategoryTheory.Quotient.lift_map_functor_map

end Quotient

end CategoryTheory


import Hm.Set

open Set

/-
Technically speaking relations also require a carrier set + a proof
that they are ⊆ carrier. However most applications we will every see
don't really care about the carrier set and just assume it to be
univ (α × β). Since always working with the carrier set + proof in a structure
would clutter the implementation unnecessarily.
-/
def Relation (α : Type u) (β : Type v) := Set (α × β)
def RelationOn (α : Type u) := Relation α α

instance FunctionToRelation : Coe (α → β → Prop) (Relation α β) where
  coe f := {t | f t.fst t.snd}

instance FunctionToRelationOn : Coe (α → α → Prop) (RelationOn α) where
  coe f := {t | f t.fst t.snd}

section RelationProperties

variable {α : Type _} (R : RelationOn α)

def reflexive := ∀ a : α, (a, a) ∈ R
def irreflexive := ∀ a : α, (a, a) ∉ R
def symmetrical := ∀ (a b : α), (a, b) ∈ R → (b, a) ∈ R
def transitive := ∀ (a b c : α), (a, b) ∈ R ∧ (b, c) ∈ R → (a, c) ∈ R
def antisymmetrical := ∀ (a b : α),  (a, b) ∈ R ∧ (b, a) ∈ R → a = b
def asymmetrical := ∀ (a b : α), (a, b) ∈ R → (b, a) ∉ R

class EquivalenceRel {α : Type _} (R : RelationOn α) where
  reflexive : reflexive R
  symmetrical : symmetrical R
  transitive : transitive R

/-
This instance allows us to use ≈ (denoted with \~~) when we know there
exists an equivalence relation on α.
variable (α : Type u) (a b : α) (R : RelationOn α) [EquivalenceRel R]
#check a ≈ b
-/
instance {R : RelationOn α} [EquivalenceRel R] : HasEquiv α where
  Equiv := λ a b => (a, b) ∈ R

def equivalence_class (R : RelationOn α) [EquivalenceRel R] (a : α) : Set α := {x | a ≈ x }

theorem equivalence_classes_disjunct (R: RelationOn α) [eqr: EquivalenceRel R] (a b : α) (a_nequiv_b: ¬(a ≈ b)) : equivalence_class R a ∩ equivalence_class R b = ∅ := by
  apply eq_empty_iff_all_notin.mpr
  intro x hx
  have a_equiv_x : a ≈ x := hx.left
  have b_equiv_x : b ≈ x := hx.right
  have x_equiv_b : x ≈ b := eqr.symmetrical b x b_equiv_x
  have a_equiv_b : a ≈ b := eqr.transitive a x b ⟨a_equiv_x, x_equiv_b⟩
  exact a_nequiv_b a_equiv_b

def id_rel (α : Type u) : RelationOn α := { t | t.fst = t.snd }

theorem mem_id_rel (a b : α) : (a, b) ∈ id_rel α ↔ a = b := Iff.rfl

theorem id_rel_reflexive (α : Type u) : reflexive $ id_rel α := λ _ => rfl

end RelationProperties

-- Thanks to the coercion above we can now denote theorems such as
example : reflexive (Nat.le : RelationOn Nat) := λ _ => Nat.le.refl

namespace Relation

def inverse (R : Relation α β) : Relation β α := {t | (t.snd, t.fst) ∈ R}

postfix:max "⁻¹" => inverse

def comp (R : Relation α β) (S : Relation β γ) : Relation α γ := { t | ∃ a, (t.fst, a) ∈ R ∧ (a, t.snd) ∈ S}

infixr:60 "∘" => comp

section usability

theorem mem_inverse (R : Relation α β) : x ∈ R⁻¹ ↔ (x.snd, x.fst) ∈ R := Iff.rfl

theorem mem_comp (x : α × γ) (R : Relation α β) (S : Relation β γ) : (x ∈ R∘S) ↔ (∃ a, (x.fst, a) ∈ R ∧ (a, x.snd) ∈ S) := ⟨id, id⟩

theorem mem_comp_of_left_right (a : β) (x : α × γ) (R : Relation α β) (S : Relation β γ) : (x.fst, a) ∈ R → (a, x.snd) ∈ S → x ∈ R ∘ S := by
  intro hr hs
  exact Exists.intro a $ And.intro hr hs

end usability

theorem comp_inverse_distrib {R₁ R₂: RelationOn α} : (R₁∘R₂)⁻¹ = R₂⁻¹∘R₁⁻¹ := by
  apply setext
  intro x
  apply Iff.intro <;>
  {
    intro h;
    cases h with
    | intro y h₂ =>
      exact Exists.intro y ⟨h₂.right, h₂.left⟩
  }

-- Alternative proof that shows steps in more detail
example {R₁ R₂: RelationOn α} : (R₁∘R₂)⁻¹ = R₂⁻¹∘R₁⁻¹ := by
  apply setext
  intro x
  apply Iff.intro
  case h.mp =>
    intro h
    rw [mem_inverse, mem_comp] at h
    simp at h
    apply Exists.elim h
    intro a ha
    apply mem_comp_of_left_right a x
    case a =>
      rw [mem_inverse]
      simp
      exact ha.right
    case a =>
      rw [mem_inverse]
      simp
      exact ha.left
  case h.mpr =>
    intro h
    rw [mem_inverse, mem_comp]
    simp
    rw [mem_comp] at h
    apply Exists.elim h
    intro a ha
    rw [mem_inverse, mem_inverse] at ha
    simp at ha
    exists a
    exact And.intro ha.right ha.left

theorem rel_and_rel_impl_comp {R S : RelationOn α} {A B C : Set α} :
  R ⊆ (cartesian A B) ∧ S ⊆ (cartesian B C) → (R ∘ S) ⊆ (cartesian A C) := by
    intro h x comp
    rw [mem_comp] at comp
    apply Exists.elim comp
    intro a ha
    apply mem_cartesian_of_left_right x A C
    case a =>
      exact And.left $ h.left (x.fst, a) ha.left
    case a =>
      exact And.right $ h.right (a, x.snd) ha.right

end Relation


namespace prop_04

variables A B C D : Prop

theorem prop_4 (h1 : A ∨ B) (h2 : A → C) (h3 : B → D) : C ∨ D :=
show C ∨ D, from or.elim h1
    (assume h4: A,
     have h5: C, from h2 h4,
     show C ∨ D, from or.inl h5)
    (assume h6: B,
     have h7: D, from h3 h6,
     show C ∨ D, from or.inr h7)

-- end namespace
end prop_04


example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    cases h with hp hqr,
    cases hqr with hq hr,
      left, constructor, exact hp, exact hq,
      right, constructor, exact hp, exact hr,
    intro h,
    cases h with hpq hpr,
      cases hpq with hp hq,
      constructor, exact hp, left, exact hq,
      cases hpr with hp hr,
      constructor, exact hp, right, exact hr
end