/-
Copyright (c) 2020 Mathieu Guay-Paquet. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mathieu Guay-Paquet

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

/-!
# Order filters

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

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections
require more structure, such as a bottom element, a top element, or
a join-semilattice structure.

- `order.pfilter P`: The type of nonempty, downward directed, upward closed
               subsets of `P`. This is dual to `order.ideal`, so it
               simply wraps `order.ideal Pᵒᵈ`.
- `order.is_pfilter P`: a predicate for when a `set P` is a filter.

Note the relation between `order/filter` and `order/pfilter`: for any
type `α`, `filter α` represents the same mathematical object as
`pfilter (set α)`.

## References

- <https://en.wikipedia.org/wiki/Filter_(mathematics)>

## Tags

pfilter, filter, ideal, dual

-/

namespace Order

variable {P : Type _}

#print Order.PFilter /-
/-- A filter on a preorder `P` is a subset of `P` that is
  - nonempty
  - downward directed
  - upward closed. -/
structure PFilter (P) [Preorder P] where
  dual : Ideal Pᵒᵈ
#align order.pfilter Order.PFilter
-/

#print Order.IsPFilter /-
/-- A predicate for when a subset of `P` is a filter. -/
def IsPFilter [Preorder P] (F : Set P) : Prop :=
  @IsIdeal Pᵒᵈ _ F
#align order.is_pfilter Order.IsPFilter
-/

#print Order.IsPFilter.of_def /-
theorem IsPFilter.of_def [Preorder P] {F : Set P} (nonempty : F.Nonempty)
    (directed : DirectedOn (· ≥ ·) F) (mem_of_le : ∀ {x y : P}, x ≤ y → x ∈ F → y ∈ F) :
    IsPFilter F :=
  ⟨fun _ _ _ _ => mem_of_le ‹_› ‹_›, Nonempty, Directed⟩
#align order.is_pfilter.of_def Order.IsPFilter.of_def
-/

#print Order.IsPFilter.toPFilter /-
/-- Create an element of type `order.pfilter` from a set satisfying the predicate
`order.is_pfilter`. -/
def IsPFilter.toPFilter [Preorder P] {F : Set P} (h : IsPFilter F) : PFilter P :=
  ⟨h.toIdeal⟩
#align order.is_pfilter.to_pfilter Order.IsPFilter.toPFilter
-/

namespace Pfilter

section Preorder

variable [Preorder P] {x y : P} (F s t : PFilter P)

instance [Inhabited P] : Inhabited (PFilter P) :=
  ⟨⟨default⟩⟩

/-- A filter on `P` is a subset of `P`. -/
instance : Coe (PFilter P) (Set P) :=
  ⟨fun F => F.dual.carrier⟩

/-- For the notation `x ∈ F`. -/
instance : Membership P (PFilter P) :=
  ⟨fun x F => x ∈ (F : Set P)⟩

@[simp]
theorem SetLike.mem_coe : x ∈ (F : Set P) ↔ x ∈ F :=
  iff_of_eq rfl
#align order.pfilter.mem_coe SetLike.mem_coeₓ

#print Order.PFilter.isPFilter /-
theorem isPFilter : IsPFilter (F : Set P) :=
  F.dual.IsIdeal
#align order.pfilter.is_pfilter Order.PFilter.isPFilter
-/

#print Order.PFilter.nonempty /-
theorem nonempty : (F : Set P).Nonempty :=
  F.dual.Nonempty
#align order.pfilter.nonempty Order.PFilter.nonempty
-/

#print Order.PFilter.directed /-
theorem directed : DirectedOn (· ≥ ·) (F : Set P) :=
  F.dual.Directed
#align order.pfilter.directed Order.PFilter.directed
-/

#print Order.PFilter.mem_of_le /-
theorem mem_of_le {F : PFilter P} : x ≤ y → x ∈ F → y ∈ F := fun h => F.dual.lower h
#align order.pfilter.mem_of_le Order.PFilter.mem_of_le
-/

#print Order.PFilter.ext /-
/-- Two filters are equal when their underlying sets are equal. -/
@[ext]
theorem ext (h : (s : Set P) = t) : s = t := by
  cases s
  cases t
  exact congr_arg _ (Ideal.ext h)
#align order.pfilter.ext Order.PFilter.ext
-/

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : PartialOrder (PFilter P) :=
  PartialOrder.lift coe ext

/- warning: order.pfilter.mem_of_mem_of_le -> Order.PFilter.mem_of_mem_of_le is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P] {x : P} {F : Order.PFilter.{u1} P _inst_1} {G : Order.PFilter.{u1} P _inst_1}, (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P _inst_1) (Order.PFilter.hasMem.{u1} P _inst_1) x F) -> (LE.le.{u1} (Order.PFilter.{u1} P _inst_1) (Preorder.toLE.{u1} (Order.PFilter.{u1} P _inst_1) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P _inst_1) (Order.PFilter.partialOrder.{u1} P _inst_1))) F G) -> (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P _inst_1) (Order.PFilter.hasMem.{u1} P _inst_1) x G)
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P] {x : P} {F : Order.PFilter.{u1} P _inst_1} {G : Order.PFilter.{u1} P _inst_1}, (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P _inst_1) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P _inst_1) P (Order.PFilter.instSetLikePFilter.{u1} P _inst_1)) x F) -> (LE.le.{u1} (Order.PFilter.{u1} P _inst_1) (Preorder.toLE.{u1} (Order.PFilter.{u1} P _inst_1) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P _inst_1) (SetLike.instPartialOrder.{u1, u1} (Order.PFilter.{u1} P _inst_1) P (Order.PFilter.instSetLikePFilter.{u1} P _inst_1)))) F G) -> (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P _inst_1) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P _inst_1) P (Order.PFilter.instSetLikePFilter.{u1} P _inst_1)) x G)
Case conversion may be inaccurate. Consider using '#align order.pfilter.mem_of_mem_of_le Order.PFilter.mem_of_mem_of_leₓ'. -/
@[trans]
theorem mem_of_mem_of_le {F G : PFilter P} : x ∈ F → F ≤ G → x ∈ G :=
  Ideal.mem_of_mem_of_le
#align order.pfilter.mem_of_mem_of_le Order.PFilter.mem_of_mem_of_le

#print Order.PFilter.principal /-
/-- The smallest filter containing a given element. -/
def principal (p : P) : PFilter P :=
  ⟨Ideal.principal p⟩
#align order.pfilter.principal Order.PFilter.principal
-/

#print Order.PFilter.mem_mk /-
@[simp]
theorem mem_mk (x : P) (I : Ideal Pᵒᵈ) : x ∈ (⟨I⟩ : PFilter P) ↔ OrderDual.toDual x ∈ I :=
  Iff.rfl
#align order.pfilter.mem_def Order.PFilter.mem_mk
-/

/- warning: order.pfilter.principal_le_iff -> Order.PFilter.principal_le_iff is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P] {x : P} {F : Order.PFilter.{u1} P _inst_1}, Iff (LE.le.{u1} (Order.PFilter.{u1} P _inst_1) (Preorder.toLE.{u1} (Order.PFilter.{u1} P _inst_1) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P _inst_1) (Order.PFilter.partialOrder.{u1} P _inst_1))) (Order.PFilter.principal.{u1} P _inst_1 x) F) (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P _inst_1) (Order.PFilter.hasMem.{u1} P _inst_1) x F)
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P] {x : P} {F : Order.PFilter.{u1} P _inst_1}, Iff (LE.le.{u1} (Order.PFilter.{u1} P _inst_1) (Preorder.toLE.{u1} (Order.PFilter.{u1} P _inst_1) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P _inst_1) (SetLike.instPartialOrder.{u1, u1} (Order.PFilter.{u1} P _inst_1) P (Order.PFilter.instSetLikePFilter.{u1} P _inst_1)))) (Order.PFilter.principal.{u1} P _inst_1 x) F) (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P _inst_1) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P _inst_1) P (Order.PFilter.instSetLikePFilter.{u1} P _inst_1)) x F)
Case conversion may be inaccurate. Consider using '#align order.pfilter.principal_le_iff Order.PFilter.principal_le_iffₓ'. -/
@[simp]
theorem principal_le_iff {F : PFilter P} : principal x ≤ F ↔ x ∈ F :=
  Ideal.principal_le_iff
#align order.pfilter.principal_le_iff Order.PFilter.principal_le_iff

#print Order.PFilter.mem_principal /-
@[simp]
theorem mem_principal : x ∈ principal y ↔ y ≤ x :=
  Ideal.mem_principal
#align order.pfilter.mem_principal Order.PFilter.mem_principal
-/

/- warning: order.pfilter.antitone_principal -> Order.PFilter.antitone_principal is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P], Antitone.{u1, u1} P (Order.PFilter.{u1} P _inst_1) _inst_1 (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P _inst_1) (Order.PFilter.partialOrder.{u1} P _inst_1)) (Order.PFilter.principal.{u1} P _inst_1)
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P], Antitone.{u1, u1} P (Order.PFilter.{u1} P _inst_1) _inst_1 (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P _inst_1) (SetLike.instPartialOrder.{u1, u1} (Order.PFilter.{u1} P _inst_1) P (Order.PFilter.instSetLikePFilter.{u1} P _inst_1))) (Order.PFilter.principal.{u1} P _inst_1)
Case conversion may be inaccurate. Consider using '#align order.pfilter.antitone_principal Order.PFilter.antitone_principalₓ'. -/
-- defeq abuse
theorem antitone_principal : Antitone (principal : P → PFilter P) := by delta Antitone <;> simp
#align order.pfilter.antitone_principal Order.PFilter.antitone_principal

/- warning: order.pfilter.principal_le_principal_iff -> Order.PFilter.principal_le_principal_iff is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P] {p : P} {q : P}, Iff (LE.le.{u1} (Order.PFilter.{u1} P _inst_1) (Preorder.toLE.{u1} (Order.PFilter.{u1} P _inst_1) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P _inst_1) (Order.PFilter.partialOrder.{u1} P _inst_1))) (Order.PFilter.principal.{u1} P _inst_1 q) (Order.PFilter.principal.{u1} P _inst_1 p)) (LE.le.{u1} P (Preorder.toLE.{u1} P _inst_1) p q)
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P] {p : P} {q : P}, Iff (LE.le.{u1} (Order.PFilter.{u1} P _inst_1) (Preorder.toLE.{u1} (Order.PFilter.{u1} P _inst_1) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P _inst_1) (SetLike.instPartialOrder.{u1, u1} (Order.PFilter.{u1} P _inst_1) P (Order.PFilter.instSetLikePFilter.{u1} P _inst_1)))) (Order.PFilter.principal.{u1} P _inst_1 q) (Order.PFilter.principal.{u1} P _inst_1 p)) (LE.le.{u1} P (Preorder.toLE.{u1} P _inst_1) p q)
Case conversion may be inaccurate. Consider using '#align order.pfilter.principal_le_principal_iff Order.PFilter.principal_le_principal_iffₓ'. -/
theorem principal_le_principal_iff {p q : P} : principal q ≤ principal p ↔ p ≤ q := by simp
#align order.pfilter.principal_le_principal_iff Order.PFilter.principal_le_principal_iff

end Preorder

section OrderTop

variable [Preorder P] [OrderTop P] {F : PFilter P}

/- warning: order.pfilter.top_mem -> Order.PFilter.top_mem is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P] [_inst_2 : OrderTop.{u1} P (Preorder.toLE.{u1} P _inst_1)] {F : Order.PFilter.{u1} P _inst_1}, Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P _inst_1) (Order.PFilter.hasMem.{u1} P _inst_1) (Top.top.{u1} P (OrderTop.toHasTop.{u1} P (Preorder.toLE.{u1} P _inst_1) _inst_2)) F
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : Preorder.{u1} P] [_inst_2 : OrderTop.{u1} P (Preorder.toLE.{u1} P _inst_1)] {F : Order.PFilter.{u1} P _inst_1}, Membership.mem.{u1, u1} P (Order.PFilter.{u1} P _inst_1) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P _inst_1) P (Order.PFilter.instSetLikePFilter.{u1} P _inst_1)) (Top.top.{u1} P (OrderTop.toTop.{u1} P (Preorder.toLE.{u1} P _inst_1) _inst_2)) F
Case conversion may be inaccurate. Consider using '#align order.pfilter.top_mem Order.PFilter.top_memₓ'. -/
/-- A specific witness of `pfilter.nonempty` when `P` has a top element. -/
@[simp]
theorem top_mem : ⊤ ∈ F :=
  Ideal.bot_mem _
#align order.pfilter.top_mem Order.PFilter.top_mem

/-- There is a bottom filter when `P` has a top element. -/
instance : OrderBot (PFilter P) where
  bot := ⟨⊥⟩
  bot_le F := (bot_le : ⊥ ≤ F.dual)

end OrderTop

/-- There is a top filter when `P` has a bottom element. -/
instance {P} [Preorder P] [OrderBot P] : OrderTop (PFilter P)
    where
  top := ⟨⊤⟩
  le_top F := (le_top : F.dual ≤ ⊤)

section SemilatticeInf

variable [SemilatticeInf P] {x y : P} {F : PFilter P}

/- warning: order.pfilter.inf_mem -> Order.PFilter.inf_mem is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} P] {x : P} {y : P} {F : Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))}, (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Order.PFilter.hasMem.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) x F) -> (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Order.PFilter.hasMem.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) y F) -> (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Order.PFilter.hasMem.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Inf.inf.{u1} P (SemilatticeInf.toHasInf.{u1} P _inst_1) x y) F)
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} P] {x : P} {y : P} {F : Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))}, (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1)))) x F) -> (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1)))) y F) -> (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Inf.inf.{u1} P (SemilatticeInf.toInf.{u1} P _inst_1) x y) F)
Case conversion may be inaccurate. Consider using '#align order.pfilter.inf_mem Order.PFilter.inf_memₓ'. -/
/-- A specific witness of `pfilter.directed` when `P` has meets. -/
theorem inf_mem (hx : x ∈ F) (hy : y ∈ F) : x ⊓ y ∈ F :=
  Ideal.sup_mem hx hy
#align order.pfilter.inf_mem Order.PFilter.inf_mem

/- warning: order.pfilter.inf_mem_iff -> Order.PFilter.inf_mem_iff is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} P] {x : P} {y : P} {F : Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))}, Iff (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Order.PFilter.hasMem.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Inf.inf.{u1} P (SemilatticeInf.toHasInf.{u1} P _inst_1) x y) F) (And (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Order.PFilter.hasMem.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) x F) (Membership.Mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Order.PFilter.hasMem.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) y F))
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} P] {x : P} {y : P} {F : Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))}, Iff (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Inf.inf.{u1} P (SemilatticeInf.toInf.{u1} P _inst_1) x y) F) (And (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1)))) x F) (Membership.mem.{u1, u1} P (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) (SetLike.instMembership.{u1, u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1))) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (SemilatticeInf.toPartialOrder.{u1} P _inst_1)))) y F))
Case conversion may be inaccurate. Consider using '#align order.pfilter.inf_mem_iff Order.PFilter.inf_mem_iffₓ'. -/
@[simp]
theorem inf_mem_iff : x ⊓ y ∈ F ↔ x ∈ F ∧ y ∈ F :=
  Ideal.sup_mem_iff
#align order.pfilter.inf_mem_iff Order.PFilter.inf_mem_iff

end SemilatticeInf

section CompleteSemilatticeInf

variable [CompleteSemilatticeInf P] {F : PFilter P}

/- warning: order.pfilter.Inf_gc -> Order.PFilter.infₛ_gc is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : CompleteSemilatticeInf.{u1} P], GaloisConnection.{u1, u1} P (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)) (OrderDual.preorder.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Order.PFilter.partialOrder.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (fun (x : P) => coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (fun (_x : Equiv.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) => (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) -> (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (OrderDual.toDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.principal.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)) x)) (fun (F : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => InfSet.infₛ.{u1} P (CompleteSemilatticeInf.toHasInf.{u1} P _inst_1) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Set.{u1} P) (HasLiftT.mk.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Set.{u1} P) (CoeTCₓ.coe.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Set.{u1} P) (coeBase.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Set.{u1} P) (Order.PFilter.Set.hasCoe.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (fun (_x : Equiv.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) -> (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Equiv.hasCoeToFun.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (OrderDual.ofDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) F)))
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : CompleteSemilatticeInf.{u1} P], GaloisConnection.{u1, u1} P (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)) (OrderDual.preorder.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (SetLike.instPartialOrder.{u1, u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))))) (fun (x : P) => FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (fun (_x : Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) => OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (OrderDual.toDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.principal.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)) x)) (fun (F : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => InfSet.infₛ.{u1} P (CompleteSemilatticeInf.toInfSet.{u1} P _inst_1) (SetLike.coe.{u1, u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) F) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (fun (_x : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (OrderDual.ofDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) F)))
Case conversion may be inaccurate. Consider using '#align order.pfilter.Inf_gc Order.PFilter.infₛ_gcₓ'. -/
theorem infₛ_gc :
    GaloisConnection (fun x => OrderDual.toDual (principal x)) fun F =>
      infₛ (OrderDual.ofDual F : PFilter P) :=
  fun x F => by
  simp
  rfl
#align order.pfilter.Inf_gc Order.PFilter.infₛ_gc

/- warning: order.pfilter.Inf_gi -> Order.PFilter.infGi is a dubious translation:
lean 3 declaration is
  forall {P : Type.{u1}} [_inst_1 : CompleteSemilatticeInf.{u1} P], GaloisCoinsertion.{u1, u1} P (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)) (OrderDual.preorder.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Order.PFilter.partialOrder.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (fun (x : P) => coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (fun (_x : Equiv.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) => (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) -> (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (OrderDual.toDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.principal.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)) x)) (fun (F : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => InfSet.infₛ.{u1} P (CompleteSemilatticeInf.toHasInf.{u1} P _inst_1) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Set.{u1} P) (HasLiftT.mk.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Set.{u1} P) (CoeTCₓ.coe.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Set.{u1} P) (coeBase.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (Set.{u1} P) (Order.PFilter.Set.hasCoe.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (fun (_x : Equiv.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) -> (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Equiv.hasCoeToFun.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (OrderDual.ofDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) F)))
but is expected to have type
  forall {P : Type.{u1}} [_inst_1 : CompleteSemilatticeInf.{u1} P], GaloisCoinsertion.{u1, u1} P (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)) (OrderDual.preorder.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (PartialOrder.toPreorder.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (SetLike.instPartialOrder.{u1, u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))))) (fun (x : P) => FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (fun (_x : Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) => OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))))) (OrderDual.toDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.principal.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)) x)) (fun (F : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => InfSet.infₛ.{u1} P (CompleteSemilatticeInf.toInfSet.{u1} P _inst_1) (SetLike.coe.{u1, u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) F) P (Order.PFilter.instSetLikePFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (fun (_x : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) => Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1))) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (OrderDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) (OrderDual.ofDual.{u1} (Order.PFilter.{u1} P (PartialOrder.toPreorder.{u1} P (CompleteSemilatticeInf.toPartialOrder.{u1} P _inst_1)))) F)))
Case conversion may be inaccurate. Consider using '#align order.pfilter.Inf_gi Order.PFilter.infGiₓ'. -/
/-- If a poset `P` admits arbitrary `Inf`s, then `principal` and `Inf` form a Galois coinsertion. -/
def infGi :
    GaloisCoinsertion (fun x => OrderDual.toDual (principal x)) fun F =>
      infₛ (OrderDual.ofDual F : PFilter P)
    where
  choice F _ := infₛ (id F : PFilter P)
  gc := infₛ_gc
  u_l_le s := infₛ_le <| mem_principal.2 <| le_refl s
  choice_eq _ _ := rfl
#align order.pfilter.Inf_gi Order.PFilter.infGi

end CompleteSemilatticeInf

end Pfilter

end Order


variable {p : Prop}
variable {q : Prop}

theorem t1 : p → q → p := fun hp : p => fun hq : q => hp

#print t1

namespace unsound
axiom unsound : False -- void, uninhabited, etc
theorem ex : 1 = 0 :=
  False.elim unsound
end unsound

-- we can also use universal quantification explicitly instead of with variable
theorem t1alt : ∀ {p q : Prop}, p → q → p :=
  fun {p q : Prop} (hp : p) (hq : q) => hp

/-
Lean defines all the standard logical connectives and notation. The propositional connectives come with the following notation:

Ascii Unicode Editor_shortcut Definition
True			                    True
False			                    False
Not	  ¬	      \not, \neg	    Not
/\	  ∧	      \and	          And
\/	  ∨	      \or           	Or
->	→	       \to, \r, \imp	 If
<->	↔	       \iff, \lr	     Iff
-/

#check p → q → p ∧ q
#check ¬ p → p ↔ False
#check p ∨ q -> q ∨ p

/-
The expression And.intro invokes the and-introduction rule: given proof of p and
a proof of q, get a proof of p ^ q.
-/

example (hp : p) (hq : q) : p ∧ q := And.intro hp hq

#check fun (hp : p) (hq : q) => And.intro hp hq

/-
Likewise, And.left and And.right return, respectively, p and q given p ^ q.
-/

example (hpq : p ∧ q) : p := And.left hpq
example (hpq : p ∧ q) : q := And.right hpq

example (hpq : p ∧ q) : q ∧ p :=
  And.intro (And.right hpq) (And.left hpq)

-- Note that And is really a constructor for an ordered pair, the more fundamental
-- type in a props-as-types correspondence:

variable (hp : p) (hq : q)

#check (⟨hp, hq⟩ : p ∧ q) -- this is \langle and \rangle or \< and \>

-- We can also just say hpq.right, hpq.left

example (hpq : p ∧ q) : q ∧ p :=
  ⟨ hpq.right, hpq.left ⟩

example (h: p ∧ q) : q ∧ p ∧ q :=
  ⟨h.right,⟨h.left,h.right⟩⟩

variable (xs : List Nat)
#check xs.length

-- Likewise we can use Or introduction rules:

example (hp:p) : (p ∨ q) := Or.intro_left q hp
example (hq:q) : (p ∨ q) := Or.intro_right p hq

example (h:p∨q) : q∨p :=
  Or.elim h
    (fun hp : p => show q∨p from Or.inr hp) -- Or.inr = Or.intro_right _
    (fun hq : q => show q∨p from Or.inl hq)

-- There's also negation:

example (hpq: p→q) (hnq: ¬q) : ¬p :=
  fun hp:p => show False from (hnq (hpq hp))

example (hp:p) (hnp: ¬p) : q := False.elim (hnp hp) -- can obtain anything from contradiction

example (hp:p) (hnp: ¬p) : q := absurd hp hnp

variable (r: Prop)

example (hnp : ¬p) (hq:q) (hqp:q->p) : r :=
  absurd (hqp hq) hnp

-- And logical equivalence; Iff.intro gives p<->q from p->q and q->p. Iff.mp givs
-- a proof of p->q from p<->q, and Iff.mpr gives q->p.

variable (p q : Prop)
theorem and_swap : p ∧ q ↔ q∧p :=
  Iff.intro
    (fun h: p∧q => show q∧p from And.intro (And.right h) (And.left h))
    (fun h:q∧p => show p∧q from And.intro (And.right h) (And.left h))

#check and_swap p q

-- we can rewrite this more concisely using type inference / pair-And equivalence:

variable (p q : Prop)
theorem and_swap' : p∧q ↔ q∧p :=
  ⟨fun h => ⟨h.right,h.left⟩, fun h => ⟨h.right,h.left⟩⟩

-- auxillary subgoals: Lean lets us break up proofs into subgoals for structuring
-- particularly long proofs:

variable (p q : Prop)
example (h : p∧q) : q ∧ p :=
  have hp:p := h.left
  have hq:q := h.right
  show q ∧ p from And.intro hq hp

-- Internally, `have hp:p:=s;t` produces the term `(fun (h:p) => t) s` - meaning
-- s is a proof of p, t is a proof of the desired conclusion assuming h:p,
-- and the two are combined by lambda application and abstraction.

-- All the constructs we used have been constructive. To use full classical logic
-- (eg law of excluded middle) we will need to use the Classical namespace

open Classical

variable (p:Prop)
#check em p

-- In particular this allows us to use the principle of double-negation
-- elimination:

theorem dne {p:Prop} (h: ¬¬p) : p :=
  Or.elim (em p)
    (fun hp : p => hp)
    (fun hnp : ¬p => absurd hnp h)

-- This means we can use proof by contradiction: to prove p, we assume ¬p and
-- derive False. We can also use dne to prove em alternatively:

theorem em' (p:Prop) : p∨¬p :=
  dne (fun hcontra:¬(p∨¬p) => hcontra (byCases Or.inl Or.inr))
  -- isn't byCases "cheating?" I don't think so! A quick check indicates that you
  -- can only prove one direction with intutionistic logic (along with a
  -- non-intuitionistic assumption)

-- Exercises
variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  Iff.intro
    (fun ⟨hp,hq⟩ => ⟨hq,hp⟩)
    (fun ⟨hq,hp⟩ => ⟨hp,hq⟩)

example : p ∨ q ↔ q ∨ p :=
  Iff.intro
    (fun hpq => Or.elim hpq (fun hp => Or.inr hp) (fun hq => Or.inl hq))
    (fun hqp => Or.elim hqp (fun hp => Or.inr hp) (fun hq => Or.inl hq))

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  Iff.intro
    (fun ⟨⟨p,q⟩,r⟩ => ⟨p,⟨q,r⟩⟩)
    (fun ⟨p,⟨q,r⟩⟩ => ⟨⟨p,q⟩,r⟩)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  Iff.intro
    (fun hpqr => Or.elim hpqr
        (fun hpq => Or.elim hpq Or.inl (fun hq => Or.inr (Or.inl hq)))
        (fun hr => Or.inr (Or.inr hr)))
    (fun hpqr => Or.elim hpqr
        (fun hp => Or.inl (Or.inl hp))
        (fun hqr => Or.elim hqr (fun hq => Or.inl (Or.inr hq)) Or.inr))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  Iff.intro
    (fun ⟨hp,hqr⟩ => Or.elim hqr
                      (fun hq => Or.inl ⟨hp,hq⟩)
                      (fun hr => Or.inr ⟨hp,hr⟩))
    (fun hpqpr => Or.elim hpqpr
                    (fun ⟨hp,hq⟩ => ⟨hp,Or.inl hq⟩)
                    (fun ⟨hp,hr⟩ => ⟨hp,Or.inr hr⟩))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  Iff.intro
    (fun hpqr => Or.elim hpqr
                  (fun hp => ⟨Or.inl hp, Or.inl hp⟩)
                  (fun ⟨hq,hr⟩ => ⟨Or.inr hq, Or.inr hr⟩))
    (fun ⟨hpq,hpr⟩ =>
      Or.elim hpq (fun hp => Or.inl hp)
                  (fun hq => Or.elim hpr
                    (fun hp => Or.inl hp) -- This should never be reached, can we rewrite to avoid?
                    (fun hr => Or.inr ⟨hq,hr⟩)))

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  Iff.intro
    (fun htqtr => fun ⟨hp,hq⟩ => (htqtr hp) hq)
    (fun hpqtr => fun hp => fun hq => hpqtr ⟨hp,hq⟩)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  Iff.intro
    (fun hqtr => ⟨fun hp => hqtr (Or.inl hp),fun hq => hqtr (Or.inr hq)⟩)
    (fun ⟨hptr,hqtr⟩ => fun hpoq => Or.elim hpoq hptr hqtr)

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  Iff.intro
    (fun notpq => ⟨fun hp => notpq (Or.inl hp),fun hq => notpq (Or.inr hq) ⟩ )
    (fun ⟨notP,notQ⟩ => fun pOq => Or.elim pOq notP notQ)

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  fun npOnQ => Or.elim npOnQ
                      (fun np => fun ⟨hp,hq⟩ => np hp)
                      (fun nq => fun ⟨hp,hq⟩ => nq hq)

example : ¬(p ∧ ¬p) := (fun ⟨hp,hnp⟩ => hnp hp)

example : p ∧ ¬q → ¬(p → q) :=
  fun ⟨hp,nq⟩ => (fun ptq => nq (ptq hp))

example : ¬p → (p → q) :=
  fun np => fun hp => False.elim (np hp)

example : (¬p ∨ q) → (p → q) :=
  fun npOq => Or.elim npOq
                     (fun np => fun hp => False.elim (np hp))
                     (fun hq => fun hp => hq)

example : p ∨ False ↔ p :=
  Iff.intro
    (fun pOf => Or.elim pOf id False.elim)
    Or.inl

example : p ∧ False ↔ False :=
  Iff.intro
    (fun ⟨p,contra⟩ => contra)
    False.elim

example : (p → q) → (¬q → ¬p) :=
  fun ptq => fun nq => (fun p => nq (ptq p))

-- These require classical reasoning.
open Classical

variable (p q r s : Prop)

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := fun ptrOs =>
  byCases
    (fun hp : p => Or.elim (ptrOs hp) (fun hr:r => Or.inl (fun hp':p => hr)) (fun hs:s => Or.inr (fun hp':p => hs)))
    (fun hnp: ¬p => (Or.inl (fun hp:p => False.elim (hnp hp))))

example : ¬(p ∧ q) → ¬p ∨ ¬q := fun npAq =>
  byCases
    (fun hp:p => byCases (fun hq:q => False.elim (npAq ⟨hp,hq⟩)) Or.inr)
    Or.inl

example : ¬(p → q) → p ∧ ¬q := fun npTq =>
  byCases
    (fun hp:p => ⟨hp,(fun hq:q => npTq (fun hp2 => hq))⟩)
    (fun hnp:¬p => False.elim (npTq (fun hp:p => False.elim (hnp hp))))

example : (p → q) → (¬p ∨ q) := fun pTq =>
  byCases
    (fun hp:p => Or.inr (pTq hp))
    Or.inl

example : (¬q → ¬p) → (p → q) := fun nqTnp =>
  byCases
    (fun hq:q => fun hp:p => hq)
    (fun hnq:¬q => fun hp:p => False.elim ((nqTnp hnq) hp))

example : p ∨ ¬p :=
  byCases Or.inl Or.inr

example : ((p → q) → p) → p := fun pqp =>
  byCases
    (fun hp:p => hp)
    (fun hnp:¬p => pqp (fun hp:p => False.elim (hnp hp)))

-- This does NOT require classical logic
example: ¬(p ↔ ¬p) :=
  fun ⟨c,d⟩ =>
    let r := (fun hp:p => (c hp) hp)
    r (d r)


open classical
variables (α : Type) (p q : α -> Prop)
variable a : α
variable r : Prop
variable z : Prop
theorem dne {z: Prop} (h: ¬¬z): z :=
  by_contradiction
    (assume h1 : not z,
    show false, from h h1)
example : (¬ ∀ x, p x) ↔  (∃ x, ¬ p x) :=
    iff.intro
      (assume h: ¬∀ x, p x,
      by_contradiction
        (assume h1 : ¬(∃ x, ¬p x),
        have h2 : ∀ x, ¬¬p x, from forall_not_of_not_exists h1,
        have h3 : ∀ x, p x, from
        (assume x, dne (h2 x)),
        show false, from h h3))
      (assume h: ∃ x, ¬p x,
      exists.elim h $
      assume x(hx : ¬ p x),
        assume hno: ∀ x, p x,
        have h1 : p x, from hno x,
        show false,from hx h1
      )


/-
Copyright (c) 2022. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Firsching, Fabian Kruse, Nikolas Kuhn
-/
import analysis.p_series
import analysis.special_functions.log.deriv
import tactic.positivity
import data.real.pi.wallis

/-!
# Stirling's formula

This file proves Stirling's formula for the factorial.
It states that $n!$ grows asymptotically like $\sqrt{2\pi n}(\frac{n}{e})^n$.

## Proof outline

The proof follows: <https://proofwiki.org/wiki/Stirling%27s_Formula>.

We proceed in two parts.

**Part 1**: We consider the sequence $a_n$ of fractions $\frac{n!}{\sqrt{2n}(\frac{n}{e})^n}$
and prove that this sequence converges to a real, positive number $a$. For this the two main
ingredients are
 - taking the logarithm of the sequence and
 - using the series expansion of $\log(1 + x)$.

**Part 2**: We use the fact that the series defined in part 1 converges againt a real number $a$
and prove that $a = \sqrt{\pi}$. Here the main ingredient is the convergence of Wallis' product
formula for `π`.
-/

open_locale topology real big_operators nat
open finset filter nat real

namespace stirling
/-!
 ### Part 1
 https://proofwiki.org/wiki/Stirling%27s_Formula#Part_1
-/

/--
Define `stirling_seq n` as $\frac{n!}{\sqrt{2n}(\frac{n}{e})^n}$.
Stirling's formula states that this sequence has limit $\sqrt(π)$.
-/
noncomputable def stirling_seq (n : ℕ) : ℝ :=
n! / (sqrt (2 * n) * (n / exp 1) ^ n)

@[simp] lemma stirling_seq_zero : stirling_seq 0 = 0 :=
by rw [stirling_seq, cast_zero, mul_zero, real.sqrt_zero, zero_mul, div_zero]

@[simp] lemma stirling_seq_one : stirling_seq 1 = exp 1 / sqrt 2 :=
by rw [stirling_seq, pow_one, factorial_one, cast_one, mul_one, mul_one_div, one_div_div]

/--
We have the expression
`log (stirling_seq (n + 1)) = log(n + 1)! - 1 / 2 * log(2 * n) - n * log ((n + 1) / e)`.
-/
lemma log_stirling_seq_formula (n : ℕ) : log (stirling_seq n.succ) =
  log n.succ!- 1 / 2 * log (2 * n.succ) - n.succ * log (n.succ / exp 1) :=
by rw [stirling_seq, log_div, log_mul, sqrt_eq_rpow, log_rpow, real.log_pow, tsub_tsub];
  try { apply ne_of_gt }; positivity -- TODO: Make `positivity` handle `≠ 0` goals

/--
The sequence `log (stirling_seq (m + 1)) - log (stirling_seq (m + 2))` has the series expansion
   `∑ 1 / (2 * (k + 1) + 1) * (1 / 2 * (m + 1) + 1)^(2 * (k + 1))`
-/
lemma log_stirling_seq_diff_has_sum (m : ℕ) :
  has_sum (λ k : ℕ, (1 : ℝ) / (2 * k.succ + 1) * ((1 / (2 * m.succ + 1)) ^ 2) ^ k.succ)
  (log (stirling_seq m.succ) - log (stirling_seq m.succ.succ)) :=
begin
  change has_sum ((λ b : ℕ, 1 / (2 * (b : ℝ) + 1) * ((1 / (2 * m.succ + 1)) ^ 2) ^ b) ∘ succ) _,
  refine (has_sum_nat_add_iff 1).mpr _,
  convert (has_sum_log_one_add_inv $ cast_pos.mpr (succ_pos m)).mul_left ((m.succ : ℝ) + 1 / 2),
  { ext k,
    rw [← pow_mul, pow_add],
    push_cast,
    have : 2 * (k : ℝ) + 1 ≠ 0, {norm_cast, exact succ_ne_zero (2*k)},
    have : 2 * ((m : ℝ) + 1) + 1 ≠ 0, {norm_cast, exact succ_ne_zero (2*m.succ)},
    field_simp,
    ring },
  { have h : ∀ (x : ℝ) (hx : x ≠ 0), 1 + x⁻¹ = (x + 1) / x,
    { intros, rw [_root_.add_div, div_self hx, inv_eq_one_div], },
    simp only [log_stirling_seq_formula, log_div, log_mul, log_exp, factorial_succ, cast_mul,
      cast_succ, cast_zero, range_one, sum_singleton, h] { discharger :=
      `[norm_cast, apply_rules [mul_ne_zero, succ_ne_zero, factorial_ne_zero, exp_ne_zero]] },
    ring },
end

/-- The sequence `log ∘ stirling_seq ∘ succ` is monotone decreasing -/
lemma log_stirling_seq'_antitone : antitone (real.log ∘ stirling_seq ∘ succ) :=
antitone_nat_of_succ_le $ λ n, sub_nonneg.mp $ (log_stirling_seq_diff_has_sum n).nonneg $ λ m,
  by positivity

/--
We have a bound for successive elements in the sequence `log (stirling_seq k)`.
-/
lemma log_stirling_seq_diff_le_geo_sum (n : ℕ) :
  log (stirling_seq n.succ) - log (stirling_seq n.succ.succ) ≤
  (1 / (2 * n.succ + 1)) ^ 2 / (1 - (1 / (2 * n.succ + 1)) ^ 2) :=
begin
  have h_nonneg : 0 ≤ ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2) := sq_nonneg _,
  have g : has_sum (λ k : ℕ, ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2) ^ k.succ)
    ((1 / (2 * n.succ + 1)) ^ 2 / (1 - (1 / (2 * n.succ + 1)) ^ 2)),
  { have := (has_sum_geometric_of_lt_1 h_nonneg _).mul_left ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2),
    { simp_rw ←pow_succ at this,
      exact this, },
    rw [one_div, inv_pow],
    exact inv_lt_one (one_lt_pow ((lt_add_iff_pos_left 1).mpr $ by positivity) two_ne_zero) },
  have hab : ∀ (k : ℕ), (1 / (2 * (k.succ : ℝ) + 1)) * ((1 / (2 * n.succ + 1)) ^ 2) ^ k.succ ≤
    ((1 / (2 * n.succ + 1)) ^ 2) ^ k.succ,
  { refine λ k, mul_le_of_le_one_left (pow_nonneg h_nonneg k.succ) _,
    rw one_div,
    exact inv_le_one (le_add_of_nonneg_left $ by positivity) },
  exact has_sum_le hab (log_stirling_seq_diff_has_sum n) g,
end

/--
We have the bound  `log (stirling_seq n) - log (stirling_seq (n+1))` ≤ 1/(4 n^2)
-/
lemma log_stirling_seq_sub_log_stirling_seq_succ (n : ℕ) :
  log (stirling_seq n.succ) - log (stirling_seq n.succ.succ) ≤ 1 / (4 * n.succ ^ 2) :=
begin
  have h₁ : 0 < 4 * ((n : ℝ) + 1) ^ 2 := by positivity,
  have h₃ : 0 < (2 * ((n : ℝ) + 1) + 1) ^ 2 := by positivity,
  have h₂ : 0 < 1 - (1 / (2 * ((n : ℝ) + 1) + 1)) ^ 2,
  { rw ← mul_lt_mul_right h₃,
    have H : 0 < (2 * ((n : ℝ) + 1) + 1) ^ 2 - 1 := by nlinarith [@cast_nonneg ℝ _ n],
    convert H using 1; field_simp [h₃.ne'] },
  refine (log_stirling_seq_diff_le_geo_sum n).trans _,
  push_cast,
  rw div_le_div_iff h₂ h₁,
  field_simp [h₃.ne'],
  rw div_le_div_right h₃,
  ring_nf,
  norm_cast,
  linarith,
end

/-- For any `n`, we have `log_stirling_seq 1 - log_stirling_seq n ≤ 1/4 * ∑' 1/k^2`  -/
lemma log_stirling_seq_bounded_aux :
  ∃ (c : ℝ), ∀ (n : ℕ), log (stirling_seq 1) - log (stirling_seq n.succ) ≤ c :=
begin
  let d := ∑' k : ℕ, (1 : ℝ) / k.succ ^ 2,
  use (1 / 4 * d : ℝ),
  let log_stirling_seq' : ℕ → ℝ := λ k, log (stirling_seq k.succ),
  intro n,
  have h₁ : ∀ k, log_stirling_seq' k - log_stirling_seq' (k + 1) ≤ 1 / 4 * (1 / k.succ ^ 2) :=
  by { intro k, convert log_stirling_seq_sub_log_stirling_seq_succ k using 1, field_simp, },
  have h₂ : ∑ (k : ℕ) in range n, (1 : ℝ) / (k.succ) ^ 2 ≤ d := by
  { exact sum_le_tsum (range n) (λ k _, by positivity)
      ((summable_nat_add_iff 1).mpr $ real.summable_one_div_nat_pow.mpr one_lt_two) },
  calc
  log (stirling_seq 1) - log (stirling_seq n.succ) = log_stirling_seq' 0 - log_stirling_seq' n : rfl
  ... = ∑ k in range n, (log_stirling_seq' k - log_stirling_seq' (k + 1)) : by
    rw ← sum_range_sub' log_stirling_seq' n
  ... ≤ ∑ k in range n, (1/4) * (1 / k.succ^2) : sum_le_sum (λ k _, h₁ k)
  ... = 1 / 4 * ∑ k in range n, 1 / k.succ ^ 2 : by rw mul_sum
  ... ≤ 1 / 4 * d : mul_le_mul_of_nonneg_left h₂ $ by positivity,
end

/-- The sequence `log_stirling_seq` is bounded below for `n ≥ 1`. -/
lemma log_stirling_seq_bounded_by_constant : ∃ c, ∀ (n : ℕ), c ≤ log (stirling_seq n.succ) :=
begin
  obtain ⟨d, h⟩ := log_stirling_seq_bounded_aux,
  exact ⟨log (stirling_seq 1) - d, λ n, sub_le_comm.mp (h n)⟩,
end

/-- The sequence `stirling_seq` is positive for `n > 0`  -/
lemma stirling_seq'_pos (n : ℕ) : 0 < stirling_seq n.succ := by { unfold stirling_seq, positivity }

/--
The sequence `stirling_seq` has a positive lower bound.
-/
lemma stirling_seq'_bounded_by_pos_constant : ∃ a, 0 < a ∧ ∀ n : ℕ, a ≤ stirling_seq n.succ :=
begin
  cases log_stirling_seq_bounded_by_constant with c h,
  refine ⟨exp c, exp_pos _, λ n, _⟩,
  rw ← le_log_iff_exp_le (stirling_seq'_pos n),
  exact h n,
end

/-- The sequence `stirling_seq ∘ succ` is monotone decreasing -/
lemma stirling_seq'_antitone : antitone (stirling_seq ∘ succ) :=
λ n m h, (log_le_log (stirling_seq'_pos m) (stirling_seq'_pos n)).mp (log_stirling_seq'_antitone h)

/-- The limit `a` of the sequence `stirling_seq` satisfies `0 < a` -/
lemma stirling_seq_has_pos_limit_a :
  ∃ (a : ℝ), 0 < a ∧ tendsto stirling_seq at_top (𝓝 a) :=
begin
  obtain ⟨x, x_pos, hx⟩ := stirling_seq'_bounded_by_pos_constant,
  have hx' : x ∈ lower_bounds (set.range (stirling_seq ∘ succ)) := by simpa [lower_bounds] using hx,
  refine ⟨_, lt_of_lt_of_le x_pos (le_cInf (set.range_nonempty _) hx'), _⟩,
  rw ←filter.tendsto_add_at_top_iff_nat 1,
  exact tendsto_at_top_cinfi stirling_seq'_antitone ⟨x, hx'⟩,
end

/-!
 ### Part 2
 https://proofwiki.org/wiki/Stirling%27s_Formula#Part_2
-/

/-- The sequence `n / (2 * n + 1)` tends to `1/2` -/
lemma tendsto_self_div_two_mul_self_add_one :
  tendsto (λ (n : ℕ), (n : ℝ) / (2 * n + 1)) at_top (𝓝 (1 / 2)) :=
begin
  conv { congr, skip, skip, rw [one_div, ←add_zero (2 : ℝ)] },
  refine (((tendsto_const_div_at_top_nhds_0_nat 1).const_add (2 : ℝ)).inv₀
    ((add_zero (2 : ℝ)).symm ▸ two_ne_zero)).congr' (eventually_at_top.mpr ⟨1, λ n hn, _⟩),
  rw [add_div' (1 : ℝ) 2 n (cast_ne_zero.mpr (one_le_iff_ne_zero.mp hn)), inv_div],
end

/-- For any `n ≠ 0`, we have the identity
`(stirling_seq n)^4 / (stirling_seq (2*n))^2 * (n / (2 * n + 1)) = W n`, where `W n` is the
`n`-th partial product of Wallis' formula for `π / 2`. -/
lemma stirling_seq_pow_four_div_stirling_seq_pow_two_eq (n : ℕ) (hn : n ≠ 0) :
  ((stirling_seq n) ^ 4 / (stirling_seq (2 * n)) ^ 2) * (n / (2 * n + 1)) = wallis.W n :=
begin
  rw [bit0_eq_two_mul, stirling_seq, pow_mul, stirling_seq, wallis.W_eq_factorial_ratio],
  simp_rw [div_pow, mul_pow],
  rw [sq_sqrt, sq_sqrt],
  any_goals { positivity },
  have : (n : ℝ) ≠ 0, from cast_ne_zero.mpr hn,
  have : (exp 1) ≠ 0, from exp_ne_zero 1,
  have : ((2 * n)!: ℝ) ≠ 0, from cast_ne_zero.mpr (factorial_ne_zero (2 * n)),
  have : 2 * (n : ℝ) + 1 ≠ 0, by {norm_cast, exact succ_ne_zero (2*n)},
  field_simp,
  simp only [mul_pow, mul_comm 2 n, mul_comm 4 n, pow_mul],
  ring,
end

/--
Suppose the sequence `stirling_seq` (defined above) has the limit `a ≠ 0`.
Then the Wallis sequence `W n` has limit `a^2 / 2`.
-/
lemma second_wallis_limit (a : ℝ) (hane : a ≠ 0) (ha : tendsto stirling_seq at_top (𝓝 a)) :
  tendsto wallis.W at_top (𝓝 (a ^ 2 / 2)):=
begin
  refine tendsto.congr' (eventually_at_top.mpr ⟨1, λ n hn,
    stirling_seq_pow_four_div_stirling_seq_pow_two_eq n (one_le_iff_ne_zero.mp hn)⟩) _,
  have h : a ^ 2 / 2 = (a ^ 4 / a ^ 2) * (1 / 2),
  { rw [mul_one_div, ←mul_one_div (a ^ 4) (a ^ 2), one_div, ←pow_sub_of_lt a],
    norm_num },
  rw h,
  exact ((ha.pow 4).div ((ha.comp (tendsto_id.const_mul_at_top' two_pos)).pow 2)
    (pow_ne_zero 2 hane)).mul tendsto_self_div_two_mul_self_add_one,
end

/-- **Stirling's Formula** -/
theorem tendsto_stirling_seq_sqrt_pi : tendsto (λ (n : ℕ), stirling_seq n) at_top (𝓝 (sqrt π)) :=
begin
  obtain ⟨a, hapos, halimit⟩ := stirling_seq_has_pos_limit_a,
  have hπ : π / 2 = a ^ 2 / 2 := tendsto_nhds_unique wallis.tendsto_W_nhds_pi_div_two
    (second_wallis_limit a hapos.ne' halimit),
  rwa [(div_left_inj' (two_ne_zero' ℝ)).mp hπ, sqrt_sq hapos.le],
end

end stirling


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Julian Kuelshammer
-/
import algebra.big_operators.order
import group_theory.coset
import data.nat.totient
import data.int.gcd
import data.set.finite
import dynamics.periodic_pts
import algebra.iterate_hom

/-!
# Order of an element

This file defines the order of an element of a finite group. For a finite group `G` the order of
`x ∈ G` is the minimal `n ≥ 1` such that `x ^ n = 1`.

## Main definitions

* `is_of_fin_order` is a predicate on an element `x` of a monoid `G` saying that `x` is of finite
  order.
* `is_of_fin_add_order` is the additive analogue of `is_of_find_order`.
* `order_of x` defines the order of an element `x` of a monoid `G`, by convention its value is `0`
  if `x` has infinite order.
* `add_order_of` is the additive analogue of `order_of`.

## Tags
order of an element
-/

open function nat

universes u v

variables {G : Type u} {A : Type v}
variables {x y : G} {a b : A} {n m : ℕ}

section monoid_add_monoid

variables [monoid G] [add_monoid A]

section is_of_fin_order

lemma is_periodic_pt_add_iff_nsmul_eq_zero (a : A) :
  is_periodic_pt ((+) a) n 0 ↔ n • a = 0 :=
by rw [is_periodic_pt, is_fixed_pt, add_left_iterate, add_zero]

@[to_additive is_periodic_pt_add_iff_nsmul_eq_zero]
lemma is_periodic_pt_mul_iff_pow_eq_one (x : G) : is_periodic_pt ((*) x) n 1 ↔ x ^ n = 1 :=
by rw [is_periodic_pt, is_fixed_pt, mul_left_iterate, mul_one]

/-- `is_of_fin_add_order` is a predicate on an element `a` of an additive monoid to be of finite
order, i.e. there exists `n ≥ 1` such that `n • a = 0`.-/
def is_of_fin_add_order (a : A) : Prop :=
(0 : A) ∈ periodic_pts ((+) a)

/-- `is_of_fin_order` is a predicate on an element `x` of a monoid to be of finite order, i.e. there
exists `n ≥ 1` such that `x ^ n = 1`.-/
@[to_additive is_of_fin_add_order]
def is_of_fin_order (x : G) : Prop :=
(1 : G) ∈ periodic_pts ((*) x)

lemma is_of_fin_add_order_of_mul_iff :
  is_of_fin_add_order (additive.of_mul x) ↔ is_of_fin_order x := iff.rfl

lemma is_of_fin_order_of_add_iff :
  is_of_fin_order (multiplicative.of_add a) ↔ is_of_fin_add_order a := iff.rfl

lemma is_of_fin_add_order_iff_nsmul_eq_zero (a : A) :
  is_of_fin_add_order a ↔ ∃ n, 0 < n ∧ n • a = 0 :=
by { convert iff.rfl, simp only [exists_prop, is_periodic_pt_add_iff_nsmul_eq_zero] }

@[to_additive is_of_fin_add_order_iff_nsmul_eq_zero]
lemma is_of_fin_order_iff_pow_eq_one (x : G) :
  is_of_fin_order x ↔ ∃ n, 0 < n ∧ x ^ n = 1 :=
by { convert iff.rfl, simp [is_periodic_pt_mul_iff_pow_eq_one] }

end is_of_fin_order

/-- `add_order_of a` is the order of the element `a`, i.e. the `n ≥ 1`, s.t. `n • a = 0` if it
exists. Otherwise, i.e. if `a` is of infinite order, then `add_order_of a` is `0` by convention.-/
noncomputable def add_order_of (a : A) : ℕ :=
minimal_period ((+) a) 0

/-- `order_of x` is the order of the element `x`, i.e. the `n ≥ 1`, s.t. `x ^ n = 1` if it exists.
Otherwise, i.e. if `x` is of infinite order, then `order_of x` is `0` by convention.-/
@[to_additive add_order_of]
noncomputable def order_of (x : G) : ℕ :=
minimal_period ((*) x) 1

attribute [to_additive add_order_of] order_of

@[to_additive]
lemma commute.order_of_mul_dvd_lcm (h : commute x y) :
  order_of (x * y) ∣ nat.lcm (order_of x) (order_of y) :=
begin
  convert function.commute.minimal_period_of_comp_dvd_lcm h.function_commute_mul_left,
  rw [order_of, comp_mul_left],
end

@[simp] lemma add_order_of_of_mul_eq_order_of (x : G) :
  add_order_of (additive.of_mul x) = order_of x := rfl

@[simp] lemma order_of_of_add_eq_add_order_of (a : A) :
  order_of (multiplicative.of_add a) = add_order_of a := rfl

@[to_additive add_order_of_pos']
lemma order_of_pos' (h : is_of_fin_order x) : 0 < order_of x :=
minimal_period_pos_of_mem_periodic_pts h

lemma pow_order_of_eq_one (x : G) : x ^ order_of x = 1 :=
begin
  convert is_periodic_pt_minimal_period ((*) x) _,
  rw [order_of, mul_left_iterate, mul_one],
end

lemma add_order_of_nsmul_eq_zero (a : A) : add_order_of a • a = 0 :=
begin
  convert is_periodic_pt_minimal_period ((+) a) _,
  rw [add_order_of, add_left_iterate, add_zero],
end

attribute [to_additive add_order_of_nsmul_eq_zero] pow_order_of_eq_one

@[to_additive add_order_of_eq_zero]
lemma order_of_eq_zero (h : ¬ is_of_fin_order x) : order_of x = 0 :=
by rwa [order_of, minimal_period, dif_neg]

lemma nsmul_ne_zero_of_lt_add_order_of' (n0 : n ≠ 0) (h : n < add_order_of a) :
  n • a ≠ 0 :=
λ j, not_is_periodic_pt_of_pos_of_lt_minimal_period n0 h
  ((is_periodic_pt_add_iff_nsmul_eq_zero a).mpr j)

@[to_additive nsmul_ne_zero_of_lt_add_order_of']
lemma pow_eq_one_of_lt_order_of' (n0 : n ≠ 0) (h : n < order_of x) : x ^ n ≠ 1 :=
λ j, not_is_periodic_pt_of_pos_of_lt_minimal_period n0 h
  ((is_periodic_pt_mul_iff_pow_eq_one x).mpr j)

lemma add_order_of_le_of_nsmul_eq_zero (hn : 0 < n) (h : n • a = 0) : add_order_of a ≤ n :=
is_periodic_pt.minimal_period_le hn (by rwa is_periodic_pt_add_iff_nsmul_eq_zero)

@[to_additive add_order_of_le_of_nsmul_eq_zero]
lemma order_of_le_of_pow_eq_one (hn : 0 < n) (h : x ^ n = 1) : order_of x ≤ n :=
is_periodic_pt.minimal_period_le hn (by rwa is_periodic_pt_mul_iff_pow_eq_one)

@[simp] lemma order_of_one : order_of (1 : G) = 1 :=
by rw [order_of, one_mul_eq_id, minimal_period_id]

@[simp] lemma add_order_of_zero : add_order_of (0 : A) = 1 :=
by simp only [←order_of_of_add_eq_add_order_of, order_of_one, of_add_zero]

attribute [to_additive add_order_of_zero] order_of_one

@[simp] lemma order_of_eq_one_iff : order_of x = 1 ↔ x = 1 :=
by rw [order_of, is_fixed_point_iff_minimal_period_eq_one, is_fixed_pt, mul_one]

@[simp] lemma add_order_of_eq_one_iff : add_order_of a = 1 ↔ a = 0 :=
by simp [← order_of_of_add_eq_add_order_of]

attribute [to_additive add_order_of_eq_one_iff] order_of_eq_one_iff

lemma pow_eq_mod_order_of {n : ℕ} : x ^ n = x ^ (n % order_of x) :=
calc x ^ n = x ^ (n % order_of x + order_of x * (n / order_of x)) : by rw [nat.mod_add_div]
       ... = x ^ (n % order_of x) : by simp [pow_add, pow_mul, pow_order_of_eq_one]

lemma nsmul_eq_mod_add_order_of {n : ℕ} : n • a = (n % add_order_of a) • a :=
begin
  apply multiplicative.of_add.injective,
  rw [← order_of_of_add_eq_add_order_of, of_add_nsmul, of_add_nsmul, pow_eq_mod_order_of],
end

attribute [to_additive nsmul_eq_mod_add_order_of] pow_eq_mod_order_of

lemma order_of_dvd_of_pow_eq_one (h : x ^ n = 1) : order_of x ∣ n :=
is_periodic_pt.minimal_period_dvd ((is_periodic_pt_mul_iff_pow_eq_one _).mpr h)

lemma add_order_of_dvd_of_nsmul_eq_zero (h : n • a = 0) : add_order_of a ∣ n :=
is_periodic_pt.minimal_period_dvd ((is_periodic_pt_add_iff_nsmul_eq_zero _).mpr h)

attribute [to_additive add_order_of_dvd_of_nsmul_eq_zero] order_of_dvd_of_pow_eq_one

lemma add_order_of_dvd_iff_nsmul_eq_zero {n : ℕ} : add_order_of a ∣ n ↔ n • a = 0 :=
⟨λ h, by rw [nsmul_eq_mod_add_order_of, nat.mod_eq_zero_of_dvd h, zero_nsmul],
  add_order_of_dvd_of_nsmul_eq_zero⟩

@[to_additive add_order_of_dvd_iff_nsmul_eq_zero]
lemma order_of_dvd_iff_pow_eq_one {n : ℕ} : order_of x ∣ n ↔ x ^ n = 1 :=
⟨λ h, by rw [pow_eq_mod_order_of, nat.mod_eq_zero_of_dvd h, pow_zero], order_of_dvd_of_pow_eq_one⟩

lemma exists_pow_eq_self_of_coprime (h : n.coprime (order_of x)) :
  ∃ m : ℕ, (x ^ n) ^ m = x :=
begin
  by_cases h0 : order_of x = 0,
  { rw [h0, coprime_zero_right] at h,
    exact ⟨1, by rw [h, pow_one, pow_one]⟩ },
  by_cases h1 : order_of x = 1,
  { exact ⟨0, by rw [order_of_eq_one_iff.mp h1, one_pow, one_pow]⟩ },
  obtain ⟨m, hm⟩ :=
    exists_mul_mod_eq_one_of_coprime h (one_lt_iff_ne_zero_and_ne_one.mpr ⟨h0, h1⟩),
  exact ⟨m, by rw [←pow_mul, pow_eq_mod_order_of, hm, pow_one]⟩,
end

lemma exists_nsmul_eq_self_of_coprime (a : A)
  (h : coprime n (add_order_of a)) : ∃ m : ℕ, m • (n • a) = a :=
begin
  change n.coprime (order_of (multiplicative.of_add a)) at h,
  exact exists_pow_eq_self_of_coprime h,
end

attribute [to_additive exists_nsmul_eq_self_of_coprime] exists_pow_eq_self_of_coprime

lemma add_order_of_eq_add_order_of_iff {B : Type*} [add_monoid B] {b : B} :
  add_order_of a = add_order_of b ↔ ∀ n : ℕ, n • a = 0 ↔ n • b = 0 :=
begin
  simp_rw ← add_order_of_dvd_iff_nsmul_eq_zero,
  exact ⟨λ h n, by rw h, λ h, nat.dvd_antisymm ((h _).mpr (dvd_refl _)) ((h _).mp (dvd_refl _))⟩,
end

@[to_additive add_order_of_eq_add_order_of_iff]
lemma order_of_eq_order_of_iff {H : Type*} [monoid H] {y : H} :
  order_of x = order_of y ↔ ∀ n : ℕ, x ^ n = 1 ↔ y ^ n = 1 :=
by simp_rw [← is_periodic_pt_mul_iff_pow_eq_one, ← minimal_period_eq_minimal_period_iff, order_of]

lemma add_order_of_injective {B : Type*} [add_monoid B] (f : A →+ B)
  (hf : function.injective f) (a : A) : add_order_of (f a) = add_order_of a :=
by simp_rw [add_order_of_eq_add_order_of_iff, ←f.map_nsmul, ←f.map_zero, hf.eq_iff, iff_self,
            forall_const]

@[to_additive add_order_of_injective]
lemma order_of_injective {H : Type*} [monoid H] (f : G →* H)
  (hf : function.injective f) (x : G) : order_of (f x) = order_of x :=
by simp_rw [order_of_eq_order_of_iff, ←f.map_pow, ←f.map_one, hf.eq_iff, iff_self, forall_const]

@[simp, norm_cast, to_additive] lemma order_of_submonoid {H : submonoid G}
  (y : H) : order_of (y : G) = order_of y :=
order_of_injective H.subtype subtype.coe_injective y

variables (x)

lemma order_of_pow' (h : n ≠ 0) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n :=
begin
  convert minimal_period_iterate_eq_div_gcd h,
  simp only [order_of, mul_left_iterate],
end

variables (a)

lemma add_order_of_nsmul' (h : n ≠ 0) :
  add_order_of (n • a) = add_order_of a / gcd (add_order_of a) n :=
by simpa [← order_of_of_add_eq_add_order_of, of_add_nsmul] using order_of_pow' _ h

attribute [to_additive add_order_of_nsmul'] order_of_pow'

variable (n)

lemma order_of_pow'' (h : is_of_fin_order x) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n :=
begin
  convert minimal_period_iterate_eq_div_gcd' h,
  simp only [order_of, mul_left_iterate],
end

lemma add_order_of_nsmul'' (h : is_of_fin_add_order a) :
  add_order_of (n • a) = add_order_of a / gcd (add_order_of a) n :=
by simp [← order_of_of_add_eq_add_order_of, of_add_nsmul,
  order_of_pow'' _ n (is_of_fin_order_of_add_iff.mpr h)]

attribute [to_additive add_order_of_nsmul''] order_of_pow''

section p_prime

variables {a x n} {p : ℕ} [hp : fact p.prime]
include hp

lemma add_order_of_eq_prime (hg : p • a = 0) (hg1 : a ≠ 0) : add_order_of a = p :=
minimal_period_eq_prime ((is_periodic_pt_add_iff_nsmul_eq_zero _).mpr hg)
  (by rwa [is_fixed_pt, add_zero])

@[to_additive add_order_of_eq_prime]
lemma order_of_eq_prime (hg : x ^ p = 1) (hg1 : x ≠ 1) : order_of x = p :=
minimal_period_eq_prime ((is_periodic_pt_mul_iff_pow_eq_one _).mpr hg)
  (by rwa [is_fixed_pt, mul_one])

lemma add_order_of_eq_prime_pow (hnot : ¬ (p ^ n) • a = 0) (hfin : (p ^ (n + 1)) • a = 0) :
  add_order_of a = p ^ (n + 1) :=
begin
  apply minimal_period_eq_prime_pow;
  rwa is_periodic_pt_add_iff_nsmul_eq_zero,
end

@[to_additive add_order_of_eq_prime_pow]
lemma order_of_eq_prime_pow (hnot : ¬ x ^ p ^ n = 1) (hfin : x ^ p ^ (n + 1) = 1) :
  order_of x = p ^ (n + 1) :=
begin
  apply minimal_period_eq_prime_pow;
  rwa is_periodic_pt_mul_iff_pow_eq_one,
end

omit hp
-- An example on how to determine the order of an element of a finite group.
example : order_of (-1 : units ℤ) = 2 :=
begin
  haveI : fact (prime 2) := ⟨prime_two⟩,
  exact order_of_eq_prime (int.units_mul_self _) dec_trivial,
end

end p_prime

end monoid_add_monoid

section cancel_monoid
variables [left_cancel_monoid G] (x)
variables [add_left_cancel_monoid A] (a)

lemma pow_injective_aux (h : n ≤ m)
  (hm : m < order_of x) (eq : x ^ n = x ^ m) : n = m :=
by_contradiction $ assume ne : n ≠ m,
  have h₁ : m - n > 0, from nat.pos_of_ne_zero (by simp [nat.sub_eq_iff_eq_add h, ne.symm]),
  have h₂ : m = n + (m - n) := (nat.add_sub_of_le h).symm,
  have h₃ : x ^ (m - n) = 1,
    by { rw [h₂, pow_add] at eq, apply mul_left_cancel, convert eq.symm, exact mul_one (x ^ n) },
  have le : order_of x ≤ m - n, from order_of_le_of_pow_eq_one h₁ h₃,
  have lt : m - n < order_of x,
    from (nat.sub_lt_left_iff_lt_add h).mpr $ nat.lt_add_left _ _ _ hm,
  lt_irrefl _ (le.trans_lt lt)

-- TODO: This lemma was originally private, but this doesn't seem to work with `to_additive`,
-- therefore the private got removed.
lemma nsmul_injective_aux {n m : ℕ} (h : n ≤ m)
  (hm : m < add_order_of a) (eq : n • a = m • a) : n = m :=
begin
  apply_fun multiplicative.of_add at eq,
  rw [of_add_nsmul, of_add_nsmul] at eq,
  rw ← order_of_of_add_eq_add_order_of at hm,
  exact pow_injective_aux (multiplicative.of_add a) h hm eq,
end

attribute [to_additive nsmul_injective_aux] pow_injective_aux

lemma nsmul_injective_of_lt_add_order_of {n m : ℕ}
  (hn : n < add_order_of a) (hm : m < add_order_of a) (eq : n • a = m • a) : n = m :=
(le_total n m).elim
  (assume h, nsmul_injective_aux a h hm eq)
  (assume h, (nsmul_injective_aux a h hn eq.symm).symm)

@[to_additive nsmul_injective_of_lt_add_order_of]
lemma pow_injective_of_lt_order_of
  (hn : n < order_of x) (hm : m < order_of x) (eq : x ^ n = x ^ m) : n = m :=
(le_total n m).elim
  (assume h, pow_injective_aux x h hm eq)
  (assume h, (pow_injective_aux x h hn eq.symm).symm)

end cancel_monoid

section group
variables [group G] [add_group A] {x a} {i : ℤ}

@[simp, norm_cast, to_additive] lemma order_of_subgroup {H : subgroup G}
  (y: H) : order_of (y : G) = order_of y :=
order_of_injective H.subtype subtype.coe_injective y

lemma gpow_eq_mod_order_of : x ^ i = x ^ (i % order_of x) :=
calc x ^ i = x ^ (i % order_of x + order_of x * (i / order_of x)) :
    by rw [int.mod_add_div]
       ... = x ^ (i % order_of x) :
    by simp [gpow_add, gpow_mul, pow_order_of_eq_one]

lemma gsmul_eq_mod_add_order_of : i • a = (i % add_order_of a) • a :=
begin
  apply multiplicative.of_add.injective,
  simp [of_add_gsmul, gpow_eq_mod_order_of],
end

attribute [to_additive gsmul_eq_mod_add_order_of] gpow_eq_mod_order_of

end group

section fintype
variables [fintype G] [fintype A]

section finite_monoid
variables [monoid G] [add_monoid A]
open_locale big_operators

lemma sum_card_add_order_of_eq_card_nsmul_eq_zero [decidable_eq A] (hn : 0 < n) :
  ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ a : A, add_order_of a = m)).card
  = (finset.univ.filter (λ a : A, n • a = 0)).card :=
calc ∑ m in (finset.range n.succ).filter (∣ n),
        (finset.univ.filter (λ a : A, add_order_of a = m)).card
    = _ : (finset.card_bUnion (by { intros, apply finset.disjoint_filter.2, cc })).symm
... = _ : congr_arg finset.card (finset.ext (begin
  assume a,
  suffices : add_order_of a ≤ n ∧ add_order_of a ∣ n ↔ n • a = 0,
  { simpa [nat.lt_succ_iff], },
  exact ⟨λ h, let ⟨m, hm⟩ := h.2 in
                by rw [hm, mul_comm, mul_nsmul, add_order_of_nsmul_eq_zero, nsmul_zero],
    λ h, ⟨add_order_of_le_of_nsmul_eq_zero hn h, add_order_of_dvd_of_nsmul_eq_zero h⟩⟩
end))

@[to_additive sum_card_add_order_of_eq_card_nsmul_eq_zero]
lemma sum_card_order_of_eq_card_pow_eq_one [decidable_eq G] (hn : 0 < n) :
  ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
  = (finset.univ.filter (λ x : G, x ^ n = 1)).card :=
calc ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
    = _ : (finset.card_bUnion (by { intros, apply finset.disjoint_filter.2, cc })).symm
... = _ : congr_arg finset.card (finset.ext (begin
  assume x,
  suffices : order_of x ≤ n ∧ order_of x ∣ n ↔ x ^ n = 1,
  { simpa [nat.lt_succ_iff], },
  exact ⟨λ h, let ⟨m, hm⟩ := h.2 in by rw [hm, pow_mul, pow_order_of_eq_one, one_pow],
    λ h, ⟨order_of_le_of_pow_eq_one hn h, order_of_dvd_of_pow_eq_one h⟩⟩
end))

end finite_monoid

section finite_cancel_monoid
-- TODO: Of course everything also works for right_cancel_monoids.
variables [left_cancel_monoid G] [add_left_cancel_monoid A]

-- TODO: Use this to show that a finite left cancellative monoid is a group.
lemma exists_pow_eq_one (x : G) : is_of_fin_order x :=
begin
  refine (is_of_fin_order_iff_pow_eq_one _).mpr _,
  obtain ⟨i, j, a_eq, ne⟩ : ∃(i j : ℕ), x ^ i = x ^ j ∧ i ≠ j :=
    by simpa only [not_forall, exists_prop] using (not_injective_infinite_fintype (λi:ℕ, x^i)),
  wlog h'' : j ≤ i,
  refine ⟨i - j, nat.sub_pos_of_lt (lt_of_le_of_ne h'' ne.symm), mul_right_injective (x^j) _⟩,
  rw [mul_one, ← pow_add, ← a_eq, nat.add_sub_cancel' h''],
end

lemma exists_nsmul_eq_zero (a : A) : is_of_fin_add_order a :=
begin
  rcases exists_pow_eq_one (multiplicative.of_add a) with ⟨i, hi1, hi2⟩,
  refine ⟨i, hi1, multiplicative.of_add.injective _⟩,
  rw [add_left_iterate, of_add_zero, of_add_eq_one, add_zero],
  exact (is_periodic_pt_mul_iff_pow_eq_one (multiplicative.of_add a)).mp hi2,
end

attribute [to_additive exists_nsmul_eq_zero] exists_pow_eq_one

lemma add_order_of_le_card_univ : add_order_of a ≤ fintype.card A :=
finset.le_card_of_inj_on_range (• a)
  (assume n _, finset.mem_univ _)
  (assume i hi j hj, nsmul_injective_of_lt_add_order_of a hi hj)

@[to_additive add_order_of_le_card_univ]
lemma order_of_le_card_univ : order_of x ≤ fintype.card G :=
finset.le_card_of_inj_on_range ((^) x)
  (assume n _, finset.mem_univ _)
  (assume i hi j hj, pow_injective_of_lt_order_of x hi hj)

/-- This is the same as `add_order_of_pos' but with one fewer explicit assumption since this is
  automatic in case of a finite cancellative additive monoid.-/
lemma add_order_of_pos (a : A) : 0 < add_order_of a := add_order_of_pos' (exists_nsmul_eq_zero _)

/-- This is the same as `order_of_pos' but with one fewer explicit assumption since this is
  automatic in case of a finite cancellative monoid.-/
@[to_additive add_order_of_pos]
lemma order_of_pos (x : G) : 0 < order_of x := order_of_pos' (exists_pow_eq_one x)

open nat

/-- This is the same as `add_order_of_nsmul'` and `add_order_of_nsmul` but with one assumption less
which is automatic in the case of a finite cancellative additive monoid. -/
lemma add_order_of_nsmul (a : A) :
  add_order_of (n • a) = add_order_of a / gcd (add_order_of a) n :=
add_order_of_nsmul'' _ _ (exists_nsmul_eq_zero _)

/-- This is the same as `order_of_pow'` and `order_of_pow''` but with one assumption less which is
automatic in the case of a finite cancellative monoid.-/
@[to_additive add_order_of_nsmul]
lemma order_of_pow (x : G) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n := order_of_pow'' _ _ (exists_pow_eq_one _)

lemma mem_multiples_iff_mem_range_add_order_of [decidable_eq A] :
  b ∈ add_submonoid.multiples a ↔
  b ∈ (finset.range (add_order_of a)).image ((• a) : ℕ → A)  :=
finset.mem_range_iff_mem_finset_range_of_mod_eq' (add_order_of_pos a)
  (assume i, nsmul_eq_mod_add_order_of.symm)

@[to_additive mem_multiples_iff_mem_range_add_order_of]
lemma mem_powers_iff_mem_range_order_of [decidable_eq G] :
  y ∈ submonoid.powers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
finset.mem_range_iff_mem_finset_range_of_mod_eq' (order_of_pos x)
  (assume i, pow_eq_mod_order_of.symm)

noncomputable instance decidable_multiples [decidable_eq A] :
  decidable_pred (add_submonoid.multiples a : set A) :=
begin
  assume b,
  apply decidable_of_iff' (b ∈ (finset.range (add_order_of a)).image (• a)),
  exact mem_multiples_iff_mem_range_add_order_of,
end

@[to_additive decidable_multiples]
noncomputable instance decidable_powers [decidable_eq G] :
  decidable_pred (submonoid.powers x : set G) :=
begin
  assume y,
  apply decidable_of_iff'
    (y ∈ (finset.range (order_of x)).image ((^) x)),
  exact mem_powers_iff_mem_range_order_of
end

/-- The equivalence between `fin (order_of x)` and `submonoid.powers x`, sending `i` to `x ^ i`. -/
noncomputable def fin_equiv_powers (x : G) :
  fin (order_of x) ≃ (submonoid.powers x : set G) :=
equiv.of_bijective (λ n, ⟨x ^ ↑n, ⟨n, rfl⟩⟩) ⟨λ ⟨i, hi⟩ ⟨j, hj⟩ ij,
  subtype.mk_eq_mk.2 (pow_injective_of_lt_order_of x hi hj (subtype.mk_eq_mk.1 ij)),
  λ ⟨_, i, rfl⟩, ⟨⟨i % order_of x, mod_lt i (order_of_pos x)⟩, subtype.eq pow_eq_mod_order_of.symm⟩⟩

/-- The equivalence between `fin (add_order_of a)` and `add_submonoid.multiples a`,
  sending `i` to `i • a`."-/
noncomputable def fin_equiv_multiples (a : A) :
  fin (add_order_of a) ≃ (add_submonoid.multiples a : set A) :=
fin_equiv_powers (multiplicative.of_add a)

attribute [to_additive fin_equiv_multiples] fin_equiv_powers

@[simp] lemma fin_equiv_powers_apply {x : G} {n : fin (order_of x)} :
  fin_equiv_powers x n = ⟨x ^ ↑n, n, rfl⟩ := rfl

@[simp] lemma fin_equiv_multiples_apply {a : A} {n : fin (add_order_of a)} :
  fin_equiv_multiples a n = ⟨nsmul ↑n a, n, rfl⟩ := rfl

attribute [to_additive fin_equiv_multiples_apply] fin_equiv_powers_apply

@[simp] lemma fin_equiv_powers_symm_apply (x : G) (n : ℕ)
  {hn : ∃ (m : ℕ), x ^ m = x ^ n} :
  ((fin_equiv_powers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
by rw [equiv.symm_apply_eq, fin_equiv_powers_apply, subtype.mk_eq_mk,
  pow_eq_mod_order_of, fin.coe_mk]

@[simp] lemma fin_equiv_multiples_symm_apply (a : A) (n : ℕ)
  {hn : ∃ (m : ℕ), m • a = n • a} :
  ((fin_equiv_multiples a).symm ⟨n • a, hn⟩) =
    ⟨n % add_order_of a, nat.mod_lt _ (add_order_of_pos a)⟩ :=
fin_equiv_powers_symm_apply (multiplicative.of_add a) n

attribute [to_additive fin_equiv_multiples_symm_apply] fin_equiv_powers_symm_apply

/-- The equivalence between `submonoid.powers` of two elements `x, y` of the same order, mapping
  `x ^ i` to `y ^ i`. -/
noncomputable def powers_equiv_powers (h : order_of x = order_of y) :
  (submonoid.powers x : set G) ≃ (submonoid.powers y : set G) :=
(fin_equiv_powers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_powers y))

/-- The equivalence between `submonoid.multiples` of two elements `a, b` of the same additive order,
  mapping `i • a` to `i • b`. -/
noncomputable def multiples_equiv_multiples (h : add_order_of a = add_order_of b) :
  (add_submonoid.multiples a : set A) ≃ (add_submonoid.multiples b : set A) :=
(fin_equiv_multiples a).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_multiples b))

attribute [to_additive multiples_equiv_multiples] powers_equiv_powers

@[simp]
lemma powers_equiv_powers_apply (h : order_of x = order_of y)
  (n : ℕ) : powers_equiv_powers h ⟨x ^ n, n, rfl⟩ = ⟨y ^ n, n, rfl⟩ :=
begin
  rw [powers_equiv_powers, equiv.trans_apply, equiv.trans_apply,
    fin_equiv_powers_symm_apply, ← equiv.eq_symm_apply, fin_equiv_powers_symm_apply],
  simp [h]
end

@[simp]
lemma multiples_equiv_multiples_apply (h : add_order_of a = add_order_of b)
  (n : ℕ) : multiples_equiv_multiples h ⟨n • a, n, rfl⟩ = ⟨n • b, n, rfl⟩ :=
powers_equiv_powers_apply h n

attribute [to_additive multiples_equiv_multiples_apply] powers_equiv_powers_apply

lemma order_eq_card_powers [decidable_eq G] :
  order_of x = fintype.card (submonoid.powers x : set G) :=
(fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_powers x⟩)

lemma add_order_of_eq_card_multiples [decidable_eq A] :
  add_order_of a = fintype.card (add_submonoid.multiples a : set A) :=
(fintype.card_fin (add_order_of a)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_multiples a⟩)

attribute [to_additive add_order_of_eq_card_multiples] order_eq_card_powers

end finite_cancel_monoid

section finite_group
variables [group G] [add_group A]

lemma exists_gpow_eq_one (x : G) : ∃ (i : ℤ) (H : i ≠ 0), x ^ (i : ℤ) = 1 :=
--lemma exists_gpow_eq_one (a : α) : ∃ (i : ℤ) (H : i ≠ 0), a ^ (i : ℤ) = 1 :=
begin
  rcases exists_pow_eq_one x with ⟨w, hw1, hw2⟩,
  refine ⟨w, int.coe_nat_ne_zero.mpr (ne_of_gt hw1), _⟩,
  rw gpow_coe_nat,
  exact (is_periodic_pt_mul_iff_pow_eq_one _).mp hw2,
end

lemma exists_gsmul_eq_zero (a : A) : ∃ (i : ℤ) (H : i ≠ 0), i • a = 0 :=
@exists_gpow_eq_one (multiplicative A) _ _ a

attribute [to_additive] exists_gpow_eq_one

lemma mem_multiples_iff_mem_gmultiples :
  b ∈ add_submonoid.multiples a ↔ b ∈ add_subgroup.gmultiples a :=
⟨λ ⟨n, hn⟩, ⟨n, by simp * at *⟩, λ ⟨i, hi⟩, ⟨(i % add_order_of a).nat_abs,
  by { simp only [nsmul_eq_smul] at hi ⊢,
       rwa  [← gsmul_coe_nat,
       int.nat_abs_of_nonneg (int.mod_nonneg _ (int.coe_nat_ne_zero_iff_pos.2
          (add_order_of_pos a))), ← gsmul_eq_mod_add_order_of] } ⟩⟩

open subgroup

@[to_additive mem_multiples_iff_mem_gmultiples]
lemma mem_powers_iff_mem_gpowers : y ∈ submonoid.powers x ↔ y ∈ gpowers x :=
⟨λ ⟨n, hn⟩, ⟨n, by simp * at *⟩,
λ ⟨i, hi⟩, ⟨(i % order_of x).nat_abs,
  by rwa [← gpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _
    (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos x))),
    ← gpow_eq_mod_order_of]⟩⟩

lemma multiples_eq_gmultiples (a : A) :
  (add_submonoid.multiples a : set A) = add_subgroup.gmultiples a :=
set.ext $ λ y, mem_multiples_iff_mem_gmultiples

@[to_additive multiples_eq_gmultiples]
lemma powers_eq_gpowers (x : G) : (submonoid.powers x : set G) = gpowers x :=
set.ext $ λ x, mem_powers_iff_mem_gpowers

lemma mem_gmultiples_iff_mem_range_add_order_of [decidable_eq A] :
  b ∈ add_subgroup.gmultiples a ↔ b ∈ (finset.range (add_order_of a)).image (• a) :=
by rw [← mem_multiples_iff_mem_gmultiples, mem_multiples_iff_mem_range_add_order_of]

@[to_additive mem_gmultiples_iff_mem_range_add_order_of]
lemma mem_gpowers_iff_mem_range_order_of [decidable_eq G] :
  y ∈ subgroup.gpowers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
by rw [← mem_powers_iff_mem_gpowers, mem_powers_iff_mem_range_order_of]

noncomputable instance decidable_gmultiples [decidable_eq A] :
  decidable_pred (add_subgroup.gmultiples a : set A) :=
begin
  rw ← multiples_eq_gmultiples,
  exact decidable_multiples,
end

@[to_additive decidable_gmultiples]
noncomputable instance decidable_gpowers [decidable_eq G] :
  decidable_pred (subgroup.gpowers x : set G) :=
begin
  rw ← powers_eq_gpowers,
  exact decidable_powers,
end

/-- The equivalence between `fin (order_of x)` and `subgroup.gpowers x`, sending `i` to `x ^ i`. -/
noncomputable def fin_equiv_gpowers (x : G) :
  fin (order_of x) ≃ (subgroup.gpowers x : set G) :=
(fin_equiv_powers x).trans (equiv.set.of_eq (powers_eq_gpowers x))

/-- The equivalence between `fin (add_order_of a)` and `subgroup.gmultiples a`,
  sending `i` to `i • a`. -/
noncomputable def fin_equiv_gmultiples (a : A) :
  fin (add_order_of a) ≃ (add_subgroup.gmultiples a : set A) :=
fin_equiv_gpowers (multiplicative.of_add a)

attribute [to_additive fin_equiv_gmultiples] fin_equiv_gpowers

@[simp] lemma fin_equiv_gpowers_apply {n : fin (order_of x)} :
  fin_equiv_gpowers x n = ⟨x ^ (n : ℕ), n, gpow_coe_nat x n⟩ := rfl

@[simp] lemma fin_equiv_gmultiples_apply {n : fin (add_order_of a)} :
  fin_equiv_gmultiples a n = ⟨(n : ℕ) • a, n, gsmul_coe_nat a n⟩ :=
fin_equiv_gpowers_apply

attribute [to_additive fin_equiv_gmultiples_apply] fin_equiv_gpowers_apply

@[simp] lemma fin_equiv_gpowers_symm_apply (x : G) (n : ℕ)
  {hn : ∃ (m : ℤ), x ^ m = x ^ n} :
  ((fin_equiv_gpowers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
by { rw [fin_equiv_gpowers, equiv.symm_trans_apply, equiv.set.of_eq_symm_apply],
  exact fin_equiv_powers_symm_apply x n }

@[simp] lemma fin_equiv_gmultiples_symm_apply (a : A) (n : ℕ)
  {hn : ∃ (m : ℤ), m • a = n • a} :
  ((fin_equiv_gmultiples a).symm ⟨n • a, hn⟩) =
    ⟨n % add_order_of a, nat.mod_lt _ (add_order_of_pos a)⟩ :=
fin_equiv_gpowers_symm_apply (multiplicative.of_add a) n

attribute [to_additive fin_equiv_gmultiples_symm_apply] fin_equiv_gpowers_symm_apply

/-- The equivalence between `subgroup.gpowers` of two elements `x, y` of the same order, mapping
  `x ^ i` to `y ^ i`. -/
noncomputable def gpowers_equiv_gpowers (h : order_of x = order_of y) :
  (subgroup.gpowers x : set G) ≃ (subgroup.gpowers y : set G) :=
(fin_equiv_gpowers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_gpowers y))

/-- The equivalence between `subgroup.gmultiples` of two elements `a, b` of the same additive order,
  mapping `i • a` to `i • b`. -/
noncomputable def gmultiples_equiv_gmultiples (h : add_order_of a = add_order_of b) :
  (add_subgroup.gmultiples a : set A) ≃ (add_subgroup.gmultiples b : set A) :=
(fin_equiv_gmultiples a).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_gmultiples b))

attribute [to_additive gmultiples_equiv_gmultiples] gpowers_equiv_gpowers

@[simp]
lemma gpowers_equiv_gpowers_apply (h : order_of x = order_of y)
  (n : ℕ) : gpowers_equiv_gpowers h ⟨x ^ n, n, gpow_coe_nat x n⟩ = ⟨y ^ n, n, gpow_coe_nat y n⟩ :=
begin
  rw [gpowers_equiv_gpowers, equiv.trans_apply, equiv.trans_apply,
    fin_equiv_gpowers_symm_apply, ← equiv.eq_symm_apply, fin_equiv_gpowers_symm_apply],
  simp [h]
end

@[simp]
lemma gmultiples_equiv_gmultiples_apply (h : add_order_of a = add_order_of b) (n : ℕ) :
  gmultiples_equiv_gmultiples h ⟨n • a, n, gsmul_coe_nat a n⟩ = ⟨n • b, n, gsmul_coe_nat b n⟩ :=
gpowers_equiv_gpowers_apply h n

attribute [to_additive gmultiples_equiv_gmultiples_apply] gpowers_equiv_gpowers_apply

lemma order_eq_card_gpowers [decidable_eq G] :
  order_of x = fintype.card (subgroup.gpowers x : set G) :=
(fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_gpowers x⟩)

lemma add_order_eq_card_gmultiples [decidable_eq A] :
  add_order_of a = fintype.card (add_subgroup.gmultiples a : set A) :=
(fintype.card_fin (add_order_of a)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_gmultiples a⟩)

attribute [to_additive add_order_eq_card_gmultiples] order_eq_card_gpowers

open quotient_group

/- TODO: use cardinal theory, introduce `card : set G → ℕ`, or setup decidability for cosets -/
lemma order_of_dvd_card_univ : order_of x ∣ fintype.card G :=
begin
  classical,
  have ft_prod : fintype (quotient (gpowers x) × (gpowers x)),
    from fintype.of_equiv G group_equiv_quotient_times_subgroup,
  have ft_s : fintype (gpowers x),
    from @fintype.fintype_prod_right _ _ _ ft_prod _,
  have ft_cosets : fintype (quotient (gpowers x)),
    from @fintype.fintype_prod_left _ _ _ ft_prod ⟨⟨1, (gpowers x).one_mem⟩⟩,
  have eq₁ : fintype.card G = @fintype.card _ ft_cosets * @fintype.card _ ft_s,
    from calc fintype.card G = @fintype.card _ ft_prod :
        @fintype.card_congr _ _ _ ft_prod group_equiv_quotient_times_subgroup
      ... = @fintype.card _ (@prod.fintype _ _ ft_cosets ft_s) :
        congr_arg (@fintype.card _) $ subsingleton.elim _ _
      ... = @fintype.card _ ft_cosets * @fintype.card _ ft_s :
        @fintype.card_prod _ _ ft_cosets ft_s,
  have eq₂ : order_of x = @fintype.card _ ft_s,
    from calc order_of x = _ : order_eq_card_gpowers
      ... = _ : congr_arg (@fintype.card _) $ subsingleton.elim _ _,
  exact dvd.intro (@fintype.card (quotient (subgroup.gpowers x)) ft_cosets)
          (by rw [eq₁, eq₂, mul_comm])
end

lemma add_order_of_dvd_card_univ : add_order_of a ∣ fintype.card A :=
begin
  rw ← order_of_of_add_eq_add_order_of,
  exact order_of_dvd_card_univ,
end

attribute [to_additive add_order_of_dvd_card_univ] order_of_dvd_card_univ

@[simp] lemma pow_card_eq_one : x ^ fintype.card G = 1 :=
let ⟨m, hm⟩ := @order_of_dvd_card_univ _ x _ _ in
by simp [hm, pow_mul, pow_order_of_eq_one]

@[simp] lemma card_nsmul_eq_zero {a : A} : fintype.card A • a = 0 :=
begin
  apply multiplicative.of_add.injective,
  rw [of_add_nsmul, of_add_zero],
  exact pow_card_eq_one,
end

attribute [to_additive card_nsmul_eq_zero] pow_card_eq_one

variable (a)

lemma image_range_add_order_of [decidable_eq A] :
  finset.image (λ i, i • a) (finset.range (add_order_of a)) =
  (add_subgroup.gmultiples a : set A).to_finset :=
by {ext x, rw [set.mem_to_finset, set_like.mem_coe, mem_gmultiples_iff_mem_range_add_order_of] }

/-- TODO: Generalise to `submonoid.powers`.-/
@[to_additive image_range_add_order_of]
lemma image_range_order_of [decidable_eq G] :
  finset.image (λ i, x ^ i) (finset.range (order_of x)) = (gpowers x : set G).to_finset :=
by { ext x, rw [set.mem_to_finset, set_like.mem_coe, mem_gpowers_iff_mem_range_order_of] }

lemma gcd_nsmul_card_eq_zero_iff : n • a = 0 ↔ (gcd n (fintype.card A)) • a = 0 :=
⟨λ h, gcd_nsmul_eq_zero _ h $ card_nsmul_eq_zero,
  λ h, let ⟨m, hm⟩ := gcd_dvd_left n (fintype.card A) in
    by rw [hm, mul_comm, mul_nsmul, h, nsmul_zero]⟩

/-- TODO: Generalise to `finite_cancel_monoid`. -/
@[to_additive gcd_nsmul_card_eq_zero_iff]
lemma pow_gcd_card_eq_one_iff : x ^ n = 1 ↔ x ^ (gcd n (fintype.card G)) = 1 :=
⟨λ h, pow_gcd_eq_one _ h $ pow_card_eq_one,
  λ h, let ⟨m, hm⟩ := gcd_dvd_left n (fintype.card G) in
    by rw [hm, pow_mul, h, one_pow]⟩

end finite_group

end fintype


/-
Copyright (c) 2015 Leonardo de Moura. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import data.list.comb data.list.perm

namespace list
variable {A : Type}
variable (R : A → A → Prop)

inductive locally_sorted : list A → Prop :=
| base0 : locally_sorted []
| base  : ∀ a, locally_sorted [a]
| step  : ∀ {a b l}, R a b → locally_sorted (b::l) → locally_sorted (a::b::l)

inductive hd_rel (a : A) : list A → Prop :=
| base : hd_rel a []
| step : ∀ {b} (l), R a b → hd_rel a (b::l)

inductive sorted : list A → Prop :=
| base : sorted []
| step : ∀ {a : A} {l : list A}, hd_rel R a l → sorted l → sorted (a::l)

variable {R}

lemma hd_rel_inv : ∀ {a b l}, hd_rel R a (b::l) → R a b :=
begin intros a b l h, cases h, assumption end

lemma sorted_inv : ∀ {a l}, sorted R (a::l) → hd_rel R a l ∧ sorted R l :=
begin intros a l h, cases h, split, repeat assumption end

lemma sorted.rect_on {P : list A → Type} : ∀ {l}, sorted R l → P [] → (∀ a l, sorted R l → P l → hd_rel R a l → P (a::l)) → P l
| []     s h₁ h₂ := h₁
| (a::l) s h₁ h₂ :=
  have hd_rel R a l, from and.left (sorted_inv s),
  have sorted R l,   from and.right (sorted_inv s),
  have P l,          from sorted.rect_on this h₁ h₂,
  h₂ a l `sorted R l` `P l` `hd_rel R a l`

lemma sorted_singleton (a : A) : sorted R [a] :=
sorted.step !hd_rel.base !sorted.base

lemma sorted_of_locally_sorted : ∀ {l}, locally_sorted R l → sorted R l
| []        h := !sorted.base
| [a]       h := !sorted_singleton
| (a::b::l) (locally_sorted.step h₁ h₂) :=
  have sorted R (b::l), from sorted_of_locally_sorted h₂,
  sorted.step (hd_rel.step _ h₁) this

lemma locally_sorted_of_sorted : ∀ {l}, sorted R l → locally_sorted R l
| []        h := !locally_sorted.base0
| [a]       h := !locally_sorted.base
| (a::b::l) (sorted.step (hd_rel.step _ h₁) h₂) :=
  have locally_sorted R (b::l), from locally_sorted_of_sorted h₂,
  locally_sorted.step h₁ this

lemma locally_sorted_eq_sorted : @locally_sorted = @sorted :=
funext (λ A, funext (λ R, funext (λ l, propext (iff.intro sorted_of_locally_sorted locally_sorted_of_sorted))))

variable (R)

inductive strongly_sorted : list A → Prop :=
| base : strongly_sorted []
| step : ∀ {a l}, all l (R a) → strongly_sorted l → strongly_sorted (a::l)

variable {R}

lemma sorted_of_strongly_sorted : ∀ {l}, strongly_sorted R l → sorted R l
| []        h := !sorted.base
| [a]       h := !sorted_singleton
| (a::b::l) (strongly_sorted.step h₁ h₂) :=
  have hd_rel R a (b::l), from hd_rel.step _ (of_all_cons h₁),
  have sorted R (b::l),   from sorted_of_strongly_sorted h₂,
  sorted.step `hd_rel R a (b::l)` `sorted R (b::l)`

lemma sorted_extends (trans : transitive R) : ∀ {a l}, sorted R (a::l) → all l (R a)
| a []     h := !all_nil
| a (b::l) h :=
  have hd_rel R a (b::l), from and.left (sorted_inv h),
  have R a b,             from hd_rel_inv this,
  have all l (R b),       from sorted_extends (and.right (sorted_inv h)),
  all_of_forall (take x, suppose x ∈ b::l,
    or.elim (eq_or_mem_of_mem_cons this)
      (suppose x = b, by subst x; assumption)
      (suppose x ∈ l,
        have R b x, from of_mem_of_all this `all l (R b)`,
        trans `R a b` `R b x`))

theorem strongly_sorted_of_sorted_of_transitive (trans : transitive R) : ∀ {l}, sorted R l → strongly_sorted R l
| []     h := !strongly_sorted.base
| (a::l) h :=
  have sorted R l,          from and.right (sorted_inv h),
  have strongly_sorted R l, from strongly_sorted_of_sorted_of_transitive this,
  have all l (R a),         from sorted_extends trans h,
  strongly_sorted.step `all l (R a)` `strongly_sorted R l`

open perm

lemma eq_of_sorted_of_perm (tr : transitive R) (anti : anti_symmetric R) : ∀ {l₁ l₂ : list A}, l₁ ~ l₂ → sorted R l₁ → sorted R l₂ → l₁ = l₂
| []       []       h₁ h₂ h₃ := rfl
| (a₁::l₁) []       h₁ h₂ h₃ := absurd (perm.symm h₁) !not_perm_nil_cons
| []       (a₂::l₂) h₁ h₂ h₃ := absurd h₁ !not_perm_nil_cons
| (a::l₁)  l₂       h₁ h₂ h₃ :=
  have aux : ∀ {t}, l₂ = a::t → a::l₁ = l₂, from
    take t, suppose l₂ = a::t,
    have l₁ ~ t,      by rewrite [this at h₁]; apply perm_cons_inv h₁,
    have sorted R l₁, from and.right (sorted_inv h₂),
    have sorted R t,  by rewrite [`l₂ = a::t` at h₃]; exact and.right (sorted_inv h₃),
    have l₁ = t,      from eq_of_sorted_of_perm `l₁ ~ t` `sorted R l₁` `sorted R t`,
    show a :: l₁ = l₂,  by rewrite [`l₂ = a::t`, this],
  have   a ∈ l₂,                       from mem_perm h₁ !mem_cons,
  obtain s t (e₁ : l₂ = s ++ (a::t)),  from mem_split this,
  begin
    cases s with b s,
    { have l₂ = a::t, by exact e₁,
      exact aux this },
    { have e₁   : l₂ = b::(s++(a::t)), by exact e₁,
      have b ∈ l₂,                by rewrite e₁; apply mem_cons,
      have hall₂ : all (s++(a::t)) (R b), begin rewrite [e₁ at h₃], apply sorted_extends tr h₃ end,
      have a ∈ s++(a::t),         from mem_append_right _ !mem_cons,
      have R b a,                 from of_mem_of_all this hall₂,
      have b ∈ a::l₁,             from mem_perm (perm.symm h₁) `b ∈ l₂`,
      have hall₁ : all l₁ (R a),  from sorted_extends tr h₂,
      apply or.elim (eq_or_mem_of_mem_cons `b ∈ a::l₁`),
        suppose b = a,  by rewrite this at e₁; exact aux e₁,
        suppose b ∈ l₁,
          have R a b, from of_mem_of_all this hall₁,
          have b = a, from anti `R b a` `R a b`,
          by rewrite this at e₁; exact aux e₁ }
  end
end list