/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module order.directed
! leanprover-community/mathlib commit 6cb77a8eaff0ddd100e87b1591c6d3ad319514ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Image
import Mathbin.Order.Lattice
import Mathbin.Order.Max

/-!
# Directed indexed families and sets

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

This file defines directed indexed families and directed sets. An indexed family/set is
directed iff each pair of elements has a shared upper bound.

## Main declarations

* `directed r f`: Predicate stating that the indexed family `f` is `r`-directed.
* `directed_on r s`: Predicate stating that the set `s` is `r`-directed.
* `is_directed α r`: Prop-valued mixin stating that `α` is `r`-directed. Follows the style of the
  unbundled relation classes such as `is_total`.
-/

open Function

universe u v w

variable {α : Type u} {β : Type v} {ι : Sort w} (r r' s : α → α → Prop)

-- mathport name: «expr ≼ »
local infixl:50 " ≼ " => r

#print Directed /-
/-- A family of elements of α is directed (with respect to a relation `≼` on α)
  if there is a member of the family `≼`-above any pair in the family.  -/
def Directed (f : ι → α) :=
  ∀ x y, ∃ z, f x ≼ f z ∧ f y ≼ f z
#align directed Directed
-/

#print DirectedOn /-
/-- A subset of α is directed if there is an element of the set `≼`-above any
  pair of elements in the set. -/
def DirectedOn (s : Set α) :=
  ∀ x ∈ s, ∀ y ∈ s, ∃ z ∈ s, x ≼ z ∧ y ≼ z
#align directed_on DirectedOn
-/

variable {r r'}

#print directedOn_iff_directed /-
theorem directedOn_iff_directed {s} : @DirectedOn α r s ↔ Directed r (coe : s → α) := by
  simp [Directed, DirectedOn] <;> refine' ball_congr fun x hx => by simp <;> rfl
#align directed_on_iff_directed directedOn_iff_directed
-/

alias directedOn_iff_directed ↔ DirectedOn.directed_val _
#align directed_on.directed_coe DirectedOn.directed_val

#print directedOn_range /-
theorem directedOn_range {f : β → α} : Directed r f ↔ DirectedOn r (Set.range f) := by
  simp_rw [Directed, DirectedOn, Set.forall_range_iff, Set.exists_range_iff]
#align directed_on_range directedOn_range
-/

#print directedOn_image /-
theorem directedOn_image {s} {f : β → α} : DirectedOn r (f '' s) ↔ DirectedOn (f ⁻¹'o r) s := by
  simp only [DirectedOn, Set.ball_image_iff, Set.bex_image_iff, Order.Preimage]
#align directed_on_image directedOn_image
-/

#print DirectedOn.mono' /-
theorem DirectedOn.mono' {s : Set α} (hs : DirectedOn r s)
    (h : ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b → r' a b) : DirectedOn r' s := fun x hx y hy =>
  let ⟨z, hz, hxz, hyz⟩ := hs _ hx _ hy
  ⟨z, hz, h hx hz hxz, h hy hz hyz⟩
#align directed_on.mono' DirectedOn.mono'
-/

#print DirectedOn.mono /-
theorem DirectedOn.mono {s : Set α} (h : DirectedOn r s) (H : ∀ {a b}, r a b → r' a b) :
    DirectedOn r' s :=
  h.mono' fun _ _ _ _ => H
#align directed_on.mono DirectedOn.mono
-/

/- warning: directed_comp -> directed_comp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {r : α -> α -> Prop} {ι : Sort.{u3}} {f : ι -> β} {g : β -> α}, Iff (Directed.{u1, u3} α ι r (Function.comp.{u3, succ u2, succ u1} ι β α g f)) (Directed.{u2, u3} β ι (Order.Preimage.{succ u2, succ u1} β α g r) f)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u3}} {r : α -> α -> Prop} {ι : Sort.{u1}} {f : ι -> β} {g : β -> α}, Iff (Directed.{u2, u1} α ι r (Function.comp.{u1, succ u3, succ u2} ι β α g f)) (Directed.{u3, u1} β ι (Order.Preimage.{succ u3, succ u2} β α g r) f)
Case conversion may be inaccurate. Consider using '#align directed_comp directed_compₓ'. -/
theorem directed_comp {ι} {f : ι → β} {g : β → α} : Directed r (g ∘ f) ↔ Directed (g ⁻¹'o r) f :=
  Iff.rfl
#align directed_comp directed_comp

/- warning: directed.mono -> Directed.mono is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : α -> α -> Prop} {ι : Sort.{u2}} {f : ι -> α}, (forall (a : α) (b : α), (r a b) -> (s a b)) -> (Directed.{u1, u2} α ι r f) -> (Directed.{u1, u2} α ι s f)
but is expected to have type
  forall {α : Type.{u2}} {r : α -> α -> Prop} {s : α -> α -> Prop} {ι : Sort.{u1}} {f : ι -> α}, (forall (a : α) (b : α), (r a b) -> (s a b)) -> (Directed.{u2, u1} α ι r f) -> (Directed.{u2, u1} α ι s f)
Case conversion may be inaccurate. Consider using '#align directed.mono Directed.monoₓ'. -/
theorem Directed.mono {s : α → α → Prop} {ι} {f : ι → α} (H : ∀ a b, r a b → s a b)
    (h : Directed r f) : Directed s f := fun a b =>
  let ⟨c, h₁, h₂⟩ := h a b
  ⟨c, H _ _ h₁, H _ _ h₂⟩
#align directed.mono Directed.mono

/- warning: directed.mono_comp -> Directed.mono_comp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (r : α -> α -> Prop) {ι : Sort.{u3}} {rb : β -> β -> Prop} {g : α -> β} {f : ι -> α}, (forall {{x : α}} {{y : α}}, (r x y) -> (rb (g x) (g y))) -> (Directed.{u1, u3} α ι r f) -> (Directed.{u2, u3} β ι rb (Function.comp.{u3, succ u1, succ u2} ι α β g f))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u3}} (r : α -> α -> Prop) {ι : Sort.{u1}} {rb : β -> β -> Prop} {g : α -> β} {f : ι -> α}, (forall {{x : α}} {{y : α}}, (r x y) -> (rb (g x) (g y))) -> (Directed.{u2, u1} α ι r f) -> (Directed.{u3, u1} β ι rb (Function.comp.{u1, succ u2, succ u3} ι α β g f))
Case conversion may be inaccurate. Consider using '#align directed.mono_comp Directed.mono_compₓ'. -/
theorem Directed.mono_comp {ι} {rb : β → β → Prop} {g : α → β} {f : ι → α}
    (hg : ∀ ⦃x y⦄, x ≼ y → rb (g x) (g y)) (hf : Directed r f) : Directed rb (g ∘ f) :=
  directed_comp.2 <| hf.mono hg
#align directed.mono_comp Directed.mono_comp

#print directed_of_sup /-
/-- A monotone function on a sup-semilattice is directed. -/
theorem directed_of_sup [SemilatticeSup α] {f : α → β} {r : β → β → Prop}
    (H : ∀ ⦃i j⦄, i ≤ j → r (f i) (f j)) : Directed r f := fun a b =>
  ⟨a ⊔ b, H le_sup_left, H le_sup_right⟩
#align directed_of_sup directed_of_sup
-/

#print Monotone.directed_le /-
theorem Monotone.directed_le [SemilatticeSup α] [Preorder β] {f : α → β} :
    Monotone f → Directed (· ≤ ·) f :=
  directed_of_sup
#align monotone.directed_le Monotone.directed_le
-/

#print Antitone.directed_ge /-
theorem Antitone.directed_ge [SemilatticeSup α] [Preorder β] {f : α → β} (hf : Antitone f) :
    Directed (· ≥ ·) f :=
  directed_of_sup hf
#align antitone.directed_ge Antitone.directed_ge
-/

/- warning: directed_on_of_sup_mem -> directedOn_of_sup_mem is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeSup.{u1} α] {S : Set.{u1} α}, (forall {{i : α}} {{j : α}}, (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) i S) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) j S) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α _inst_1) i j) S)) -> (DirectedOn.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_1)))) S)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeSup.{u1} α] {S : Set.{u1} α}, (forall {{i : α}} {{j : α}}, (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) i S) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) j S) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α _inst_1) i j) S)) -> (DirectedOn.{u1} α (fun (x._@.Mathlib.Order.Directed._hyg.1249 : α) (x._@.Mathlib.Order.Directed._hyg.1251 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_1))) x._@.Mathlib.Order.Directed._hyg.1249 x._@.Mathlib.Order.Directed._hyg.1251) S)
Case conversion may be inaccurate. Consider using '#align directed_on_of_sup_mem directedOn_of_sup_memₓ'. -/
/-- A set stable by supremum is `≤`-directed. -/
theorem directedOn_of_sup_mem [SemilatticeSup α] {S : Set α}
    (H : ∀ ⦃i j⦄, i ∈ S → j ∈ S → i ⊔ j ∈ S) : DirectedOn (· ≤ ·) S := fun a ha b hb =>
  ⟨a ⊔ b, H ha hb, le_sup_left, le_sup_right⟩
#align directed_on_of_sup_mem directedOn_of_sup_mem

/- warning: directed.extend_bot -> Directed.extend_bot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {ι : Sort.{u3}} [_inst_1 : Preorder.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α _inst_1)] {e : ι -> β} {f : ι -> α}, (Directed.{u1, u3} α ι (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1)) f) -> (Function.Injective.{u3, succ u2} ι β e) -> (Directed.{u1, succ u2} α β (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1)) (Function.extend.{u3, succ u2, succ u1} ι β α e f (Bot.bot.{max u2 u1} (β -> α) (Pi.hasBot.{u2, u1} β (fun (ᾰ : β) => α) (fun (i : β) => OrderBot.toHasBot.{u1} α (Preorder.toLE.{u1} α _inst_1) _inst_2)))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {ι : Sort.{u3}} [_inst_1 : Preorder.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α _inst_1)] {e : ι -> β} {f : ι -> α}, (Directed.{u1, u3} α ι (fun (x._@.Mathlib.Order.Directed._hyg.1323 : α) (x._@.Mathlib.Order.Directed._hyg.1325 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) x._@.Mathlib.Order.Directed._hyg.1323 x._@.Mathlib.Order.Directed._hyg.1325) f) -> (Function.Injective.{u3, succ u2} ι β e) -> (Directed.{u1, succ u2} α β (fun (x._@.Mathlib.Order.Directed._hyg.1342 : α) (x._@.Mathlib.Order.Directed._hyg.1344 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) x._@.Mathlib.Order.Directed._hyg.1342 x._@.Mathlib.Order.Directed._hyg.1344) (Function.extend.{u3, succ u2, succ u1} ι β α e f (Bot.bot.{max u1 u2} (β -> α) (Pi.instBotForAll.{u2, u1} β (fun (ᾰ : β) => α) (fun (i : β) => OrderBot.toBot.{u1} α (Preorder.toLE.{u1} α _inst_1) _inst_2)))))
Case conversion may be inaccurate. Consider using '#align directed.extend_bot Directed.extend_botₓ'. -/
theorem Directed.extend_bot [Preorder α] [OrderBot α] {e : ι → β} {f : ι → α}
    (hf : Directed (· ≤ ·) f) (he : Function.Injective e) :
    Directed (· ≤ ·) (Function.extend e f ⊥) :=
  by
  intro a b
  rcases(em (∃ i, e i = a)).symm with (ha | ⟨i, rfl⟩)
  · use b
    simp [Function.extend_apply' _ _ _ ha]
  rcases(em (∃ i, e i = b)).symm with (hb | ⟨j, rfl⟩)
  · use e i
    simp [Function.extend_apply' _ _ _ hb]
  rcases hf i j with ⟨k, hi, hj⟩
  use e k
  simp only [he.extend_apply, *, true_and_iff]
#align directed.extend_bot Directed.extend_bot

#print directed_of_inf /-
/-- An antitone function on an inf-semilattice is directed. -/
theorem directed_of_inf [SemilatticeInf α] {r : β → β → Prop} {f : α → β}
    (hf : ∀ a₁ a₂, a₁ ≤ a₂ → r (f a₂) (f a₁)) : Directed r f := fun x y =>
  ⟨x ⊓ y, hf _ _ inf_le_left, hf _ _ inf_le_right⟩
#align directed_of_inf directed_of_inf
-/

#print Monotone.directed_ge /-
theorem Monotone.directed_ge [SemilatticeInf α] [Preorder β] {f : α → β} (hf : Monotone f) :
    Directed (· ≥ ·) f :=
  directed_of_inf hf
#align monotone.directed_ge Monotone.directed_ge
-/

#print Antitone.directed_le /-
theorem Antitone.directed_le [SemilatticeInf α] [Preorder β] {f : α → β} (hf : Antitone f) :
    Directed (· ≤ ·) f :=
  directed_of_inf hf
#align antitone.directed_le Antitone.directed_le
-/

/- warning: directed_on_of_inf_mem -> directedOn_of_inf_mem is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] {S : Set.{u1} α}, (forall {{i : α}} {{j : α}}, (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) i S) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) j S) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α _inst_1) i j) S)) -> (DirectedOn.{u1} α (GE.ge.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))) S)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] {S : Set.{u1} α}, (forall {{i : α}} {{j : α}}, (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) i S) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) j S) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (Inf.inf.{u1} α (SemilatticeInf.toInf.{u1} α _inst_1) i j) S)) -> (DirectedOn.{u1} α (fun (x._@.Mathlib.Order.Directed._hyg.1751 : α) (x._@.Mathlib.Order.Directed._hyg.1753 : α) => GE.ge.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) x._@.Mathlib.Order.Directed._hyg.1751 x._@.Mathlib.Order.Directed._hyg.1753) S)
Case conversion may be inaccurate. Consider using '#align directed_on_of_inf_mem directedOn_of_inf_memₓ'. -/
/-- A set stable by infimum is `≥`-directed. -/
theorem directedOn_of_inf_mem [SemilatticeInf α] {S : Set α}
    (H : ∀ ⦃i j⦄, i ∈ S → j ∈ S → i ⊓ j ∈ S) : DirectedOn (· ≥ ·) S := fun a ha b hb =>
  ⟨a ⊓ b, H ha hb, inf_le_left, inf_le_right⟩
#align directed_on_of_inf_mem directedOn_of_inf_mem

#print IsDirected /-
/-- `is_directed α r` states that for any elements `a`, `b` there exists an element `c` such that
`r a c` and `r b c`. -/
class IsDirected (α : Type _) (r : α → α → Prop) : Prop where
  Directed (a b : α) : ∃ c, r a c ∧ r b c
#align is_directed IsDirected
-/

#print directed_of /-
theorem directed_of (r : α → α → Prop) [IsDirected α r] (a b : α) : ∃ c, r a c ∧ r b c :=
  IsDirected.directed _ _
#align directed_of directed_of
-/

#print directed_id /-
theorem directed_id [IsDirected α r] : Directed r id := by convert directed_of r
#align directed_id directed_id
-/

#print directed_id_iff /-
theorem directed_id_iff : Directed r id ↔ IsDirected α r :=
  ⟨fun h => ⟨h⟩, @directed_id _ _⟩
#align directed_id_iff directed_id_iff
-/

#print directedOn_univ /-
theorem directedOn_univ [IsDirected α r] : DirectedOn r Set.univ := fun a _ b _ =>
  let ⟨c, hc⟩ := directed_of r a b
  ⟨c, trivial, hc⟩
#align directed_on_univ directedOn_univ
-/

#print directedOn_univ_iff /-
theorem directedOn_univ_iff : DirectedOn r Set.univ ↔ IsDirected α r :=
  ⟨fun h =>
    ⟨fun a b =>
      let ⟨c, _, hc⟩ := h a trivial b trivial
      ⟨c, hc⟩⟩,
    @directedOn_univ _ _⟩
#align directed_on_univ_iff directedOn_univ_iff
-/

#print IsTotal.to_isDirected /-
-- see Note [lower instance priority]
instance (priority := 100) IsTotal.to_isDirected [IsTotal α r] : IsDirected α r :=
  ⟨fun a b => Or.cases_on (total_of r a b) (fun h => ⟨b, h, refl _⟩) fun h => ⟨a, refl _, h⟩⟩
#align is_total.to_is_directed IsTotal.to_isDirected
-/

#print isDirected_mono /-
theorem isDirected_mono [IsDirected α r] (h : ∀ ⦃a b⦄, r a b → s a b) : IsDirected α s :=
  ⟨fun a b =>
    let ⟨c, ha, hb⟩ := IsDirected.directed a b
    ⟨c, h ha, h hb⟩⟩
#align is_directed_mono isDirected_mono
-/

#print exists_ge_ge /-
theorem exists_ge_ge [LE α] [IsDirected α (· ≤ ·)] (a b : α) : ∃ c, a ≤ c ∧ b ≤ c :=
  directed_of (· ≤ ·) a b
#align exists_ge_ge exists_ge_ge
-/

#print exists_le_le /-
theorem exists_le_le [LE α] [IsDirected α (· ≥ ·)] (a b : α) : ∃ c, c ≤ a ∧ c ≤ b :=
  directed_of (· ≥ ·) a b
#align exists_le_le exists_le_le
-/

#print OrderDual.isDirected_ge /-
instance OrderDual.isDirected_ge [LE α] [IsDirected α (· ≤ ·)] : IsDirected αᵒᵈ (· ≥ ·) := by
  assumption
#align order_dual.is_directed_ge OrderDual.isDirected_ge
-/

#print OrderDual.isDirected_le /-
instance OrderDual.isDirected_le [LE α] [IsDirected α (· ≥ ·)] : IsDirected αᵒᵈ (· ≤ ·) := by
  assumption
#align order_dual.is_directed_le OrderDual.isDirected_le
-/

section Preorder

variable [Preorder α] {a : α}

#print IsMin.isBot /-
protected theorem IsMin.isBot [IsDirected α (· ≥ ·)] (h : IsMin a) : IsBot a := fun b =>
  let ⟨c, hca, hcb⟩ := exists_le_le a b
  (h hca).trans hcb
#align is_min.is_bot IsMin.isBot
-/

#print IsMax.isTop /-
protected theorem IsMax.isTop [IsDirected α (· ≤ ·)] (h : IsMax a) : IsTop a :=
  h.toDual.IsBot
#align is_max.is_top IsMax.isTop
-/

#print DirectedOn.is_bot_of_is_min /-
theorem DirectedOn.is_bot_of_is_min {s : Set α} (hd : DirectedOn (· ≥ ·) s) {m} (hm : m ∈ s)
    (hmin : ∀ a ∈ s, a ≤ m → m ≤ a) : ∀ a ∈ s, m ≤ a := fun a as =>
  let ⟨x, xs, xm, xa⟩ := hd m hm a as
  (hmin x xs xm).trans xa
#align directed_on.is_bot_of_is_min DirectedOn.is_bot_of_is_min
-/

#print DirectedOn.is_top_of_is_max /-
theorem DirectedOn.is_top_of_is_max {s : Set α} (hd : DirectedOn (· ≤ ·) s) {m} (hm : m ∈ s)
    (hmax : ∀ a ∈ s, m ≤ a → a ≤ m) : ∀ a ∈ s, a ≤ m :=
  @DirectedOn.is_bot_of_is_min αᵒᵈ _ s hd m hm hmax
#align directed_on.is_top_of_is_max DirectedOn.is_top_of_is_max
-/

#print isTop_or_exists_gt /-
theorem isTop_or_exists_gt [IsDirected α (· ≤ ·)] (a : α) : IsTop a ∨ ∃ b, a < b :=
  (em (IsMax a)).imp IsMax.isTop not_isMax_iff.mp
#align is_top_or_exists_gt isTop_or_exists_gt
-/

#print isBot_or_exists_lt /-
theorem isBot_or_exists_lt [IsDirected α (· ≥ ·)] (a : α) : IsBot a ∨ ∃ b, b < a :=
  @isTop_or_exists_gt αᵒᵈ _ _ a
#align is_bot_or_exists_lt isBot_or_exists_lt
-/

#print isBot_iff_isMin /-
theorem isBot_iff_isMin [IsDirected α (· ≥ ·)] : IsBot a ↔ IsMin a :=
  ⟨IsBot.isMin, IsMin.isBot⟩
#align is_bot_iff_is_min isBot_iff_isMin
-/

#print isTop_iff_isMax /-
theorem isTop_iff_isMax [IsDirected α (· ≤ ·)] : IsTop a ↔ IsMax a :=
  ⟨IsTop.isMax, IsMax.isTop⟩
#align is_top_iff_is_max isTop_iff_isMax
-/

variable (β) [PartialOrder β]

#print exists_lt_of_directed_ge /-
theorem exists_lt_of_directed_ge [IsDirected β (· ≥ ·)] [Nontrivial β] : ∃ a b : β, a < b :=
  by
  rcases exists_pair_ne β with ⟨a, b, hne⟩
  rcases isBot_or_exists_lt a with (ha | ⟨c, hc⟩)
  exacts[⟨a, b, (ha b).lt_of_ne hne⟩, ⟨_, _, hc⟩]
#align exists_lt_of_directed_ge exists_lt_of_directed_ge
-/

#print exists_lt_of_directed_le /-
theorem exists_lt_of_directed_le [IsDirected β (· ≤ ·)] [Nontrivial β] : ∃ a b : β, a < b :=
  let ⟨a, b, h⟩ := exists_lt_of_directed_ge βᵒᵈ
  ⟨b, a, h⟩
#align exists_lt_of_directed_le exists_lt_of_directed_le
-/

end Preorder

#print SemilatticeSup.to_isDirected_le /-
-- see Note [lower instance priority]
instance (priority := 100) SemilatticeSup.to_isDirected_le [SemilatticeSup α] :
    IsDirected α (· ≤ ·) :=
  ⟨fun a b => ⟨a ⊔ b, le_sup_left, le_sup_right⟩⟩
#align semilattice_sup.to_is_directed_le SemilatticeSup.to_isDirected_le
-/

#print SemilatticeInf.to_isDirected_ge /-
-- see Note [lower instance priority]
instance (priority := 100) SemilatticeInf.to_isDirected_ge [SemilatticeInf α] :
    IsDirected α (· ≥ ·) :=
  ⟨fun a b => ⟨a ⊓ b, inf_le_left, inf_le_right⟩⟩
#align semilattice_inf.to_is_directed_ge SemilatticeInf.to_isDirected_ge
-/

#print OrderTop.to_isDirected_le /-
-- see Note [lower instance priority]
instance (priority := 100) OrderTop.to_isDirected_le [LE α] [OrderTop α] : IsDirected α (· ≤ ·) :=
  ⟨fun a b => ⟨⊤, le_top, le_top⟩⟩
#align order_top.to_is_directed_le OrderTop.to_isDirected_le
-/

#print OrderBot.to_isDirected_ge /-
-- see Note [lower instance priority]
instance (priority := 100) OrderBot.to_isDirected_ge [LE α] [OrderBot α] : IsDirected α (· ≥ ·) :=
  ⟨fun a b => ⟨⊥, bot_le, bot_le⟩⟩
#align order_bot.to_is_directed_ge OrderBot.to_isDirected_ge
-/


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module category_theory.conj
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Equiv.Units.Basic
import Mathlib.CategoryTheory.Endomorphism

/-!
# Conjugate morphisms by isomorphisms

An isomorphism `α : X ≅ Y` defines
- a monoid isomorphism
  `CategoryTheory.Iso.conj : End X ≃* End Y` by `α.conj f = α.inv ≫ f ≫ α.hom`;
- a group isomorphism `CategoryTheory.Iso.conjAut : Aut X ≃* Aut Y` by
  `α.conjAut f = α.symm ≪≫ f ≪≫ α`.

For completeness, we also define
`CategoryTheory.Iso.homCongr : (X ≅ X₁) → (Y ≅ Y₁) → (X ⟶ Y) ≃ (X₁ ⟶ Y₁)`,
cf. `Equiv.arrowCongr`.
-/

universe v u

namespace CategoryTheory

namespace Iso

variable {C : Type u} [Category.{v} C]

/-- If `X` is isomorphic to `X₁` and `Y` is isomorphic to `Y₁`, then
there is a natural bijection between `X ⟶ Y` and `X₁ ⟶ Y₁`. See also `Equiv.arrowCongr`. -/
def homCongr {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) : (X ⟶ Y) ≃ (X₁ ⟶ Y₁) where
  toFun f := α.inv ≫ f ≫ β.hom
  invFun f := α.hom ≫ f ≫ β.inv
  left_inv f :=
    show α.hom ≫ (α.inv ≫ f ≫ β.hom) ≫ β.inv = f by
      rw [Category.assoc, Category.assoc, β.hom_inv_id, α.hom_inv_id_assoc, Category.comp_id]
  right_inv f :=
    show α.inv ≫ (α.hom ≫ f ≫ β.inv) ≫ β.hom = f by
      rw [Category.assoc, Category.assoc, β.inv_hom_id, α.inv_hom_id_assoc, Category.comp_id]
#align category_theory.iso.hom_congr CategoryTheory.Iso.homCongr

-- @[simp, nolint simpNF] Porting note: dsimp can not prove this
@[simp]
theorem homCongr_apply {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (f : X ⟶ Y) :
    α.homCongr β f = α.inv ≫ f ≫ β.hom := by
  rfl
#align category_theory.iso.hom_congr_apply CategoryTheory.Iso.homCongr_apply

/- Porting note: removed `@[simp]`; simp can prove this -/
theorem homCongr_refl {X Y : C} (f : X ⟶ Y) : (Iso.refl X).homCongr (Iso.refl Y) f = f := by simp
#align category_theory.iso.hom_congr_refl CategoryTheory.Iso.homCongr_refl

/- Porting note: removed `@[simp]`; simp can prove this -/
theorem homCongr_trans {X₁ Y₁ X₂ Y₂ X₃ Y₃ : C} (α₁ : X₁ ≅ X₂) (β₁ : Y₁ ≅ Y₂) (α₂ : X₂ ≅ X₃)
    (β₂ : Y₂ ≅ Y₃) (f : X₁ ⟶ Y₁) :
    (α₁ ≪≫ α₂).homCongr (β₁ ≪≫ β₂) f = (α₁.homCongr β₁).trans (α₂.homCongr β₂) f := by simp
#align category_theory.iso.hom_congr_trans CategoryTheory.Iso.homCongr_trans

@[simp]
theorem homCongr_symm {X₁ Y₁ X₂ Y₂ : C} (α : X₁ ≅ X₂) (β : Y₁ ≅ Y₂) :
    (α.homCongr β).symm = α.symm.homCongr β.symm :=
  rfl
#align category_theory.iso.hom_congr_symm CategoryTheory.Iso.homCongr_symm

variable {X Y : C} (α : X ≅ Y)

/-- An isomorphism between two objects defines a monoid isomorphism between their
monoid of endomorphisms. -/
def conj : End X ≃* End Y :=
  { homCongr α α with map_mul' := fun f g => homCongr_comp α α α g f }
#align category_theory.iso.conj CategoryTheory.Iso.conj

theorem conj_apply (f : End X) : α.conj f = α.inv ≫ f ≫ α.hom :=
  rfl
#align category_theory.iso.conj_apply CategoryTheory.Iso.conj_apply

@[simp]
theorem conj_comp (f g : End X) : α.conj (f ≫ g) = α.conj f ≫ α.conj g :=
  α.conj.map_mul g f
#align category_theory.iso.conj_comp CategoryTheory.Iso.conj_comp

@[simp]
theorem conj_id : α.conj (𝟙 X) = 𝟙 Y :=
  α.conj.map_one
#align category_theory.iso.conj_id CategoryTheory.Iso.conj_id

@[simp]
theorem refl_conj (f : End X) : (Iso.refl X).conj f = f := by
  rw [conj_apply, Iso.refl_inv, Iso.refl_hom, Category.id_comp, Category.comp_id]
#align category_theory.iso.refl_conj CategoryTheory.Iso.refl_conj

@[simp]
theorem trans_conj {Z : C} (β : Y ≅ Z) (f : End X) : (α ≪≫ β).conj f = β.conj (α.conj f) :=
  homCongr_trans α α β β f
#align category_theory.iso.trans_conj CategoryTheory.Iso.trans_conj

@[simp]
theorem symm_self_conj (f : End X) : α.symm.conj (α.conj f) = f := by
  rw [← trans_conj, α.self_symm_id, refl_conj]
#align category_theory.iso.symm_self_conj CategoryTheory.Iso.symm_self_conj

@[simp]
theorem self_symm_conj (f : End Y) : α.conj (α.symm.conj f) = f :=
  α.symm.symm_self_conj f
#align category_theory.iso.self_symm_conj CategoryTheory.Iso.self_symm_conj

/- Porting note: removed `@[simp]`; simp can prove this -/
theorem conj_pow (f : End X) (n : ℕ) : α.conj (f ^ n) = α.conj f ^ n :=
  α.conj.toMonoidHom.map_pow f n
#align category_theory.iso.conj_pow CategoryTheory.Iso.conj_pow

-- porting note: todo: change definition so that `conjAut_apply` becomes a `rfl`?
/-- `conj` defines a group isomorphisms between groups of automorphisms -/
def conjAut : Aut X ≃* Aut Y :=
  (Aut.unitsEndEquivAut X).symm.trans <| (Units.mapEquiv α.conj).trans <| Aut.unitsEndEquivAut Y
set_option linter.uppercaseLean3 false in
#align category_theory.iso.conj_Aut CategoryTheory.Iso.conjAut

theorem conjAut_apply (f : Aut X) : α.conjAut f = α.symm ≪≫ f ≪≫ α := by
  aesop_cat_nonterminal
  apply CategoryTheory.Iso.ext
  simp only [conjAut, Aut.unitsEndEquivAut, conj]
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.iso.conj_Aut_apply CategoryTheory.Iso.conjAut_apply

@[simp]
theorem conjAut_hom (f : Aut X) : (α.conjAut f).hom = α.conj f.hom :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.iso.conj_Aut_hom CategoryTheory.Iso.conjAut_hom

@[simp]
theorem trans_conjAut {Z : C} (β : Y ≅ Z) (f : Aut X) :
    (α ≪≫ β).conjAut f = β.conjAut (α.conjAut f) := by
  simp only [conjAut_apply, Iso.trans_symm, Iso.trans_assoc]
set_option linter.uppercaseLean3 false in
#align category_theory.iso.trans_conj_Aut CategoryTheory.Iso.trans_conjAut

/- Porting note: removed `@[simp]`; simp can prove this -/
theorem conjAut_mul (f g : Aut X) : α.conjAut (f * g) = α.conjAut f * α.conjAut g :=
  α.conjAut.map_mul f g
set_option linter.uppercaseLean3 false in
#align category_theory.iso.conj_Aut_mul CategoryTheory.Iso.conjAut_mul

@[simp]
theorem conjAut_trans (f g : Aut X) : α.conjAut (f ≪≫ g) = α.conjAut f ≪≫ α.conjAut g :=
  conjAut_mul α g f
set_option linter.uppercaseLean3 false in
#align category_theory.iso.conj_Aut_trans CategoryTheory.Iso.conjAut_trans

/- Porting note: removed `@[simp]`; simp can prove this -/
theorem conjAut_pow (f : Aut X) (n : ℕ) : α.conjAut (f ^ n) = α.conjAut f ^ n :=
  α.conjAut.toMonoidHom.map_pow f n
set_option linter.uppercaseLean3 false in
#align category_theory.iso.conj_Aut_pow CategoryTheory.Iso.conjAut_pow

/- Porting note: removed `@[simp]`; simp can prove this -/
theorem conjAut_zpow (f : Aut X) (n : ℤ) : α.conjAut (f ^ n) = α.conjAut f ^ n :=
  α.conjAut.toMonoidHom.map_zpow f n
set_option linter.uppercaseLean3 false in
#align category_theory.iso.conj_Aut_zpow CategoryTheory.Iso.conjAut_zpow

end Iso

namespace Functor

universe v₁ u₁

variable {C : Type u} [Category.{v} C] {D : Type u₁} [Category.{v₁} D] (F : C ⥤ D)

theorem map_homCongr {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (f : X ⟶ Y) :
    F.map (Iso.homCongr α β f) = Iso.homCongr (F.mapIso α) (F.mapIso β) (F.map f) := by simp
#align category_theory.functor.map_hom_congr CategoryTheory.Functor.map_homCongr

theorem map_conj {X Y : C} (α : X ≅ Y) (f : End X) :
    F.map (α.conj f) = (F.mapIso α).conj (F.map f) :=
  map_homCongr F α α f
#align category_theory.functor.map_conj CategoryTheory.Functor.map_conj

theorem map_conjAut (F : C ⥤ D) {X Y : C} (α : X ≅ Y) (f : Aut X) :
    F.mapIso (α.conjAut f) = (F.mapIso α).conjAut (F.mapIso f) := by
  ext; simp only [mapIso_hom, Iso.conjAut_hom, F.map_conj]
set_option linter.uppercaseLean3 false in
#align category_theory.functor.map_conj_Aut CategoryTheory.Functor.map_conjAut

-- alternative proof: by simp only [Iso.conjAut_apply, F.mapIso_trans, F.mapIso_symm]
end Functor

end CategoryTheory


import data.real.basic

def even_fun (f : ℝ → ℝ) := ∀ x, f (-x) = f x

example (f g : ℝ → ℝ) : even_fun f → even_fun (g ∘ f) :=
begin
  intros hf x,
  calc (g ∘ f) (-x)
      = g (f (-x)) : rfl
  ... = g (f x)    : by rw hf,
end


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

! This file was ported from Lean 3 source module data.pi.lex
! leanprover-community/mathlib commit 6623e6af705e97002a9054c1c05a980180276fc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Basic
import Mathlib.Order.WellFounded
import Mathlib.Algebra.Group.Pi
import Mathlib.Algebra.Order.Group.Defs
import Mathlib.Mathport.Notation

/-!
# Lexicographic order on Pi types

This file defines the lexicographic order for Pi types. `a` is less than `b` if `a i = b i` for all
`i` up to some point `k`, and `a k < b k`.

## Notation

* `Πₗ i, α i`: Pi type equipped with the lexicographic order. Type synonym of `Π i, α i`.

## See also

Related files are:
* `Data.Finset.Colex`: Colexicographic order on finite sets.
* `Data.List.Lex`: Lexicographic order on lists.
* `Data.Oigma.Order`: Lexicographic order on `Σₗ i, α i`.
* `Data.PSigma.Order`: Lexicographic order on `Σₗ' i, α i`.
* `Data.Prod.Lex`: Lexicographic order on `α × β`.
-/

variable {ι : Type _} {β : ι → Type _} (r : ι → ι → Prop) (s : ∀ {i}, β i → β i → Prop)

namespace Pi

instance {α : Type _} : ∀ [Inhabited α], Inhabited (Lex α) :=
  @fun x => x

/-- The lexicographic relation on `Π i : ι, β i`, where `ι` is ordered by `r`,
  and each `β i` is ordered by `s`. -/
protected def Lex (x y : ∀ i, β i) : Prop :=
  ∃ i, (∀ j, r j i → x j = y j) ∧ s (x i) (y i)
#align pi.lex Pi.Lex

/- This unfortunately results in a type that isn't delta-reduced, so we keep the notation out of the
basic API, just in case -/
/-- The notation `Πₗ i, α i` refers to a pi type equipped with the lexicographic order. -/
notation3 "Πₗ "(...)", "r:(scoped p => Lex (∀ i, p i)) => r

@[simp]
theorem toLex_apply (x : ∀ i, β i) (i : ι) : toLex x i = x i :=
  rfl
#align pi.to_lex_apply Pi.toLex_apply

@[simp]
theorem ofLex_apply (x : Lex (∀ i, β i)) (i : ι) : ofLex x i = x i :=
  rfl
#align pi.of_lex_apply Pi.ofLex_apply

theorem lex_lt_of_lt_of_preorder [∀ i, Preorder (β i)] {r} (hwf : WellFounded r) {x y : ∀ i, β i}
    (hlt : x < y) : ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i :=
  let h' := Pi.lt_def.1 hlt
  let ⟨i, hi, hl⟩ := hwf.has_min _ h'.2
  ⟨i, fun j hj => ⟨h'.1 j, not_not.1 fun h => hl j (lt_of_le_not_le (h'.1 j) h) hj⟩, hi⟩
#align pi.lex_lt_of_lt_of_preorder Pi.lex_lt_of_lt_of_preorder

theorem lex_lt_of_lt [∀ i, PartialOrder (β i)] {r} (hwf : WellFounded r) {x y : ∀ i, β i}
    (hlt : x < y) : Pi.Lex r (@fun i => (· < ·)) x y := by
  simp_rw [Pi.Lex, le_antisymm_iff]
  exact lex_lt_of_lt_of_preorder hwf hlt
#align pi.lex_lt_of_lt Pi.lex_lt_of_lt

theorem isTrichotomous_lex [∀ i, IsTrichotomous (β i) s] (wf : WellFounded r) :
    IsTrichotomous (∀ i, β i) (Pi.Lex r @s) :=
  { trichotomous := fun a b => by
      cases' eq_or_ne a b with hab hab
      · exact Or.inr (Or.inl hab)
      · rw [Function.ne_iff] at hab
        let i := wf.min _ hab
        have hri : ∀ j, r j i → a j = b j := by
          intro j
          rw [← not_imp_not]
          exact fun h' => wf.not_lt_min _ _ h'
        have hne : a i ≠ b i := wf.min_mem _ hab
        cases' trichotomous_of s (a i) (b i) with hi hi
        exacts[Or.inl ⟨i, hri, hi⟩,
          Or.inr <| Or.inr <| ⟨i, fun j hj => (hri j hj).symm, hi.resolve_left hne⟩] }
#align pi.is_trichotomous_lex Pi.isTrichotomous_lex

instance [LT ι] [∀ a, LT (β a)] : LT (Lex (∀ i, β i)) :=
  ⟨Pi.Lex (· < ·) @fun _ => (· < ·)⟩

instance Lex.isStrictOrder [LinearOrder ι] [∀ a, PartialOrder (β a)] :
    IsStrictOrder (Lex (∀ i, β i)) (· < ·) where
  irrefl := fun a ⟨k, _, hk₂⟩ => lt_irrefl (a k) hk₂
  trans := by
    rintro a b c ⟨N₁, lt_N₁, a_lt_b⟩ ⟨N₂, lt_N₂, b_lt_c⟩
    rcases lt_trichotomy N₁ N₂ with (H | rfl | H)
    exacts[⟨N₁, fun j hj => (lt_N₁ _ hj).trans (lt_N₂ _ <| hj.trans H), lt_N₂ _ H ▸ a_lt_b⟩,
      ⟨N₁, fun j hj => (lt_N₁ _ hj).trans (lt_N₂ _ hj), a_lt_b.trans b_lt_c⟩,
      ⟨N₂, fun j hj => (lt_N₁ _ (hj.trans H)).trans (lt_N₂ _ hj), (lt_N₁ _ H).symm ▸ b_lt_c⟩]
#align pi.lex.is_strict_order Pi.Lex.isStrictOrder

instance [LinearOrder ι] [∀ a, PartialOrder (β a)] : PartialOrder (Lex (∀ i, β i)) :=
  partialOrderOfSO (· < ·)

/-- `Πₗ i, α i` is a linear order if the original order is well-founded. -/
noncomputable instance [LinearOrder ι] [IsWellOrder ι (· < ·)] [∀ a, LinearOrder (β a)] :
    LinearOrder (Lex (∀ i, β i)) :=
  @linearOrderOfSTO (Πₗ i, β i) (· < ·)
    { trichotomous := (isTrichotomous_lex _ _ IsWellFounded.wf).1 } (Classical.decRel _)

section PartialOrder

variable [LinearOrder ι] [IsWellOrder ι (· < ·)] [∀ i, PartialOrder (β i)] {x y : ∀ i, β i} {i : ι}
  {a : β i}

open Function

theorem toLex_monotone : Monotone (@toLex (∀ i, β i)) := fun a b h =>
  or_iff_not_imp_left.2 fun hne =>
    let ⟨i, hi, hl⟩ := IsWellFounded.wf.has_min (r := (· < · )) { i | a i ≠ b i }
      (Function.ne_iff.1 hne)
    ⟨i, fun j hj => by
      contrapose! hl
      exact ⟨j, hl, hj⟩, (h i).lt_of_ne hi⟩
#align pi.to_lex_monotone Pi.toLex_monotone

theorem toLex_strictMono : StrictMono (@toLex (∀ i, β i)) := fun a b h =>
  let ⟨i, hi, hl⟩ := IsWellFounded.wf.has_min (r := (· < · )) { i | a i ≠ b i }
    (Function.ne_iff.1 h.ne)
  ⟨i, fun j hj => by
    contrapose! hl
    exact ⟨j, hl, hj⟩, (h.le i).lt_of_ne hi⟩
#align pi.to_lex_strict_mono Pi.toLex_strictMono

@[simp]
theorem lt_toLex_update_self_iff : toLex x < toLex (update x i a) ↔ x i < a := by
  refine' ⟨_, fun h => toLex_strictMono <| lt_update_self_iff.2 h⟩
  rintro ⟨j, hj, h⟩
  dsimp at h
  obtain rfl : j = i := by
    by_contra H
    rw [update_noteq H] at h
    exact h.false
  rwa [update_same] at h
#align pi.lt_to_lex_update_self_iff Pi.lt_toLex_update_self_iff

@[simp]
theorem toLex_update_lt_self_iff : toLex (update x i a) < toLex x ↔ a < x i := by
  refine' ⟨_, fun h => toLex_strictMono <| update_lt_self_iff.2 h⟩
  rintro ⟨j, hj, h⟩
  dsimp at h
  obtain rfl : j = i := by
    by_contra H
    rw [update_noteq H] at h
    exact h.false
  rwa [update_same] at h
#align pi.to_lex_update_lt_self_iff Pi.toLex_update_lt_self_iff

@[simp]
theorem le_toLex_update_self_iff : toLex x ≤ toLex (update x i a) ↔ x i ≤ a := by
  simp_rw [le_iff_lt_or_eq, lt_toLex_update_self_iff, toLex_inj, eq_update_self_iff]
#align pi.le_to_lex_update_self_iff Pi.le_toLex_update_self_iff

@[simp]
theorem toLex_update_le_self_iff : toLex (update x i a) ≤ toLex x ↔ a ≤ x i := by
  simp_rw [le_iff_lt_or_eq, toLex_update_lt_self_iff, toLex_inj, update_eq_self_iff]
#align pi.to_lex_update_le_self_iff Pi.toLex_update_le_self_iff

end PartialOrder

instance [LinearOrder ι] [IsWellOrder ι (· < ·)] [∀ a, PartialOrder (β a)] [∀ a, OrderBot (β a)] :
    OrderBot (Lex (∀ a, β a)) where
  bot := toLex ⊥
  bot_le _ := toLex_monotone bot_le

instance [LinearOrder ι] [IsWellOrder ι (· < ·)] [∀ a, PartialOrder (β a)] [∀ a, OrderTop (β a)] :
    OrderTop (Lex (∀ a, β a)) where
  top := toLex ⊤
  le_top _ := toLex_monotone le_top

instance [LinearOrder ι] [IsWellOrder ι (· < ·)] [∀ a, PartialOrder (β a)]
    [∀ a, BoundedOrder (β a)] : BoundedOrder (Lex (∀ a, β a)) :=
  { }

instance [Preorder ι] [∀ i, LT (β i)] [∀ i, DenselyOrdered (β i)] :
    DenselyOrdered (Lex (∀ i, β i)) :=
  ⟨by
    rintro _ a₂ ⟨i, h, hi⟩
    obtain ⟨a, ha₁, ha₂⟩ := exists_between hi
    classical
      refine' ⟨Function.update a₂ _ a, ⟨i, fun j hj => _, _⟩, i, fun j hj => _, _⟩
      rw [h j hj]
      dsimp only at hj
      · rw [Function.update_noteq hj.ne a]
      · rwa [Function.update_same i a]
      · rw [Function.update_noteq hj.ne a]
      · rwa [Function.update_same i a]⟩

theorem Lex.noMaxOrder' [Preorder ι] [∀ i, LT (β i)] (i : ι) [NoMaxOrder (β i)] :
    NoMaxOrder (Lex (∀ i, β i)) :=
  ⟨fun a => by
    let ⟨b, hb⟩ := exists_gt (a i)
    classical
    exact ⟨Function.update a i b, i, fun j hj =>
      (Function.update_noteq hj.ne b a).symm, by rwa [Function.update_same i b]⟩⟩
#align pi.lex.no_max_order' Pi.Lex.noMaxOrder'

instance [LinearOrder ι] [IsWellOrder ι (· < ·)] [Nonempty ι] [∀ i, PartialOrder (β i)]
    [∀ i, NoMaxOrder (β i)] : NoMaxOrder (Lex (∀ i, β i)) :=
  ⟨fun a =>
    let ⟨_, hb⟩ := exists_gt (ofLex a)
    ⟨_, toLex_strictMono hb⟩⟩

instance [LinearOrder ι] [IsWellOrder ι (· < ·)] [Nonempty ι] [∀ i, PartialOrder (β i)]
    [∀ i, NoMinOrder (β i)] : NoMinOrder (Lex (∀ i, β i)) :=
  ⟨fun a =>
    let ⟨_, hb⟩ := exists_lt (ofLex a)
    ⟨_, toLex_strictMono hb⟩⟩

--We might want the analog of `Pi.orderedCancelCommMonoid` as well in the future.
@[to_additive]
instance Lex.orderedCommGroup [LinearOrder ι] [∀ a, OrderedCommGroup (β a)] :
    OrderedCommGroup (Lex (∀ i, β i)) :=
  { Pi.commGroup with
    mul_le_mul_left := fun x y hxy z =>
      hxy.elim (fun hxyz => hxyz ▸ le_rfl) fun ⟨i, hi⟩ =>
        Or.inr ⟨i, fun j hji =>
          show z j * x j = z j * y j by rw [hi.1 j hji], mul_lt_mul_left' hi.2 _⟩ }
#align pi.lex.ordered_comm_group Pi.Lex.orderedCommGroup
#align pi.lex.ordered_add_comm_group Pi.Lex.orderedAddCommGroup

/-- If we swap two strictly decreasing values in a function, then the result is lexicographically
smaller than the original function. -/
theorem lex_desc {α} [Preorder ι] [DecidableEq ι] [Preorder α] {f : ι → α} {i j : ι} (h₁ : i < j)
    (h₂ : f j < f i) : toLex (f ∘ Equiv.swap i j) < toLex f :=
  ⟨i, fun k hik => congr_arg f (Equiv.swap_apply_of_ne_of_ne hik.ne (hik.trans h₁).ne), by
    simpa only [Pi.toLex_apply, Function.comp_apply, Equiv.swap_apply_left] using h₂⟩
#align pi.lex_desc Pi.lex_desc

end Pi


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import analysis.convex.between
import analysis.convex.normed
import analysis.normed.group.add_torsor

/-!
# Sides of affine subspaces

This file defines notions of two points being on the same or opposite sides of an affine subspace.

## Main definitions

* `s.w_same_side x y`: The points `x` and `y` are weakly on the same side of the affine
  subspace `s`.
* `s.s_same_side x y`: The points `x` and `y` are strictly on the same side of the affine
  subspace `s`.
* `s.w_opp_side x y`: The points `x` and `y` are weakly on opposite sides of the affine
  subspace `s`.
* `s.s_opp_side x y`: The points `x` and `y` are strictly on opposite sides of the affine
  subspace `s`.

-/

variables {R V V' P P' : Type*}

open affine_equiv affine_map

namespace affine_subspace

section strict_ordered_comm_ring

variables [strict_ordered_comm_ring R] [add_comm_group V] [module R V] [add_torsor V P]
variables [add_comm_group V'] [module R V'] [add_torsor V' P']

include V

/-- The points `x` and `y` are weakly on the same side of `s`. -/
def w_same_side (s : affine_subspace R P) (x y : P) : Prop :=
∃ p₁ p₂ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂)

/-- The points `x` and `y` are strictly on the same side of `s`. -/
def s_same_side (s : affine_subspace R P) (x y : P) : Prop :=
s.w_same_side x y ∧ x ∉ s ∧ y ∉ s

/-- The points `x` and `y` are weakly on opposite sides of `s`. -/
def w_opp_side (s : affine_subspace R P) (x y : P) : Prop :=
∃ p₁ p₂ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y)

/-- The points `x` and `y` are strictly on opposite sides of `s`. -/
def s_opp_side (s : affine_subspace R P) (x y : P) : Prop :=
s.w_opp_side x y ∧ x ∉ s ∧ y ∉ s

include V'

lemma w_same_side.map {s : affine_subspace R P} {x y : P} (h : s.w_same_side x y)
  (f : P →ᵃ[R] P') : (s.map f).w_same_side (f x) (f y) :=
begin
  rcases h with ⟨p₁, hp₁, p₂, hp₂, h⟩,
  refine ⟨f p₁, mem_map_of_mem f hp₁, f p₂, mem_map_of_mem f hp₂, _⟩,
  simp_rw [←linear_map_vsub],
  exact h.map f.linear
end

lemma _root_.function.injective.w_same_side_map_iff {s : affine_subspace R P} {x y : P}
  {f : P →ᵃ[R] P'} (hf : function.injective f) :
  (s.map f).w_same_side (f x) (f y) ↔ s.w_same_side x y :=
begin
  refine ⟨λ h, _, λ h, h.map _⟩,
  rcases h with ⟨fp₁, hfp₁, fp₂, hfp₂, h⟩,
  rw mem_map at hfp₁ hfp₂,
  rcases hfp₁ with ⟨p₁, hp₁, rfl⟩,
  rcases hfp₂ with ⟨p₂, hp₂, rfl⟩,
  refine ⟨p₁, hp₁, p₂, hp₂, _⟩,
  simp_rw [←linear_map_vsub, (f.linear_injective_iff.2 hf).same_ray_map_iff] at h,
  exact h
end

lemma _root_.function.injective.s_same_side_map_iff {s : affine_subspace R P} {x y : P}
  {f : P →ᵃ[R] P'} (hf : function.injective f) :
  (s.map f).s_same_side (f x) (f y) ↔ s.s_same_side x y :=
by simp_rw [s_same_side, hf.w_same_side_map_iff, mem_map_iff_mem_of_injective hf]

@[simp] lemma _root_.affine_equiv.w_same_side_map_iff {s : affine_subspace R P} {x y : P}
  (f : P ≃ᵃ[R] P') : (s.map ↑f).w_same_side (f x) (f y) ↔ s.w_same_side x y :=
(show function.injective f.to_affine_map, from f.injective).w_same_side_map_iff

@[simp] lemma _root_.affine_equiv.s_same_side_map_iff {s : affine_subspace R P} {x y : P}
  (f : P ≃ᵃ[R] P') : (s.map ↑f).s_same_side (f x) (f y) ↔ s.s_same_side x y :=
(show function.injective f.to_affine_map, from f.injective).s_same_side_map_iff

lemma w_opp_side.map {s : affine_subspace R P} {x y : P} (h : s.w_opp_side x y)
  (f : P →ᵃ[R] P') : (s.map f).w_opp_side (f x) (f y) :=
begin
  rcases h with ⟨p₁, hp₁, p₂, hp₂, h⟩,
  refine ⟨f p₁, mem_map_of_mem f hp₁, f p₂, mem_map_of_mem f hp₂, _⟩,
  simp_rw [←linear_map_vsub],
  exact h.map f.linear
end

lemma _root_.function.injective.w_opp_side_map_iff {s : affine_subspace R P} {x y : P}
  {f : P →ᵃ[R] P'} (hf : function.injective f) :
  (s.map f).w_opp_side (f x) (f y) ↔ s.w_opp_side x y :=
begin
  refine ⟨λ h, _, λ h, h.map _⟩,
  rcases h with ⟨fp₁, hfp₁, fp₂, hfp₂, h⟩,
  rw mem_map at hfp₁ hfp₂,
  rcases hfp₁ with ⟨p₁, hp₁, rfl⟩,
  rcases hfp₂ with ⟨p₂, hp₂, rfl⟩,
  refine ⟨p₁, hp₁, p₂, hp₂, _⟩,
  simp_rw [←linear_map_vsub, (f.linear_injective_iff.2 hf).same_ray_map_iff] at h,
  exact h
end

lemma _root_.function.injective.s_opp_side_map_iff {s : affine_subspace R P} {x y : P}
  {f : P →ᵃ[R] P'} (hf : function.injective f) :
  (s.map f).s_opp_side (f x) (f y) ↔ s.s_opp_side x y :=
by simp_rw [s_opp_side, hf.w_opp_side_map_iff, mem_map_iff_mem_of_injective hf]

@[simp] lemma _root_.affine_equiv.w_opp_side_map_iff {s : affine_subspace R P} {x y : P}
  (f : P ≃ᵃ[R] P') : (s.map ↑f).w_opp_side (f x) (f y) ↔ s.w_opp_side x y :=
(show function.injective f.to_affine_map, from f.injective).w_opp_side_map_iff

@[simp] lemma _root_.affine_equiv.s_opp_side_map_iff {s : affine_subspace R P} {x y : P}
  (f : P ≃ᵃ[R] P') : (s.map ↑f).s_opp_side (f x) (f y) ↔ s.s_opp_side x y :=
(show function.injective f.to_affine_map, from f.injective).s_opp_side_map_iff

omit V'

lemma w_same_side.nonempty {s : affine_subspace R P} {x y : P} (h : s.w_same_side x y) :
  (s : set P).nonempty :=
⟨h.some, h.some_spec.some⟩

lemma s_same_side.nonempty {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) :
  (s : set P).nonempty :=
⟨h.1.some, h.1.some_spec.some⟩

lemma w_opp_side.nonempty {s : affine_subspace R P} {x y : P} (h : s.w_opp_side x y) :
  (s : set P).nonempty :=
⟨h.some, h.some_spec.some⟩

lemma s_opp_side.nonempty {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) :
  (s : set P).nonempty :=
⟨h.1.some, h.1.some_spec.some⟩

lemma s_same_side.w_same_side {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) :
  s.w_same_side x y :=
h.1

lemma s_same_side.left_not_mem {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) :
  x ∉ s :=
h.2.1

lemma s_same_side.right_not_mem {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) :
  y ∉ s :=
h.2.2

lemma s_opp_side.w_opp_side {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) :
  s.w_opp_side x y :=
h.1

lemma s_opp_side.left_not_mem {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) :
  x ∉ s :=
h.2.1

lemma s_opp_side.right_not_mem {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) :
  y ∉ s :=
h.2.2

lemma w_same_side_comm {s : affine_subspace R P} {x y : P} :
  s.w_same_side x y ↔ s.w_same_side y x :=
⟨λ ⟨p₁, hp₁, p₂, hp₂, h⟩, ⟨p₂, hp₂, p₁, hp₁, h.symm⟩,
 λ ⟨p₁, hp₁, p₂, hp₂, h⟩, ⟨p₂, hp₂, p₁, hp₁, h.symm⟩⟩

alias w_same_side_comm ↔ w_same_side.symm _

lemma s_same_side_comm {s : affine_subspace R P} {x y : P} :
  s.s_same_side x y ↔ s.s_same_side y x :=
by rw [s_same_side, s_same_side, w_same_side_comm, and_comm (x ∉ s)]

alias s_same_side_comm ↔ s_same_side.symm _

lemma w_opp_side_comm {s : affine_subspace R P} {x y : P} :
  s.w_opp_side x y ↔ s.w_opp_side y x :=
begin
  split,
  { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩,
    refine ⟨p₂, hp₂, p₁, hp₁, _⟩,
    rwa [same_ray_comm, ←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] },
  { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩,
    refine ⟨p₂, hp₂, p₁, hp₁, _⟩,
    rwa [same_ray_comm, ←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] }
end

alias w_opp_side_comm ↔ w_opp_side.symm _

lemma s_opp_side_comm {s : affine_subspace R P} {x y : P} :
  s.s_opp_side x y ↔ s.s_opp_side y x :=
by rw [s_opp_side, s_opp_side, w_opp_side_comm, and_comm (x ∉ s)]

alias s_opp_side_comm ↔ s_opp_side.symm _

lemma not_w_same_side_bot (x y : P) : ¬ (⊥ : affine_subspace R P).w_same_side x y :=
by simp [w_same_side, not_mem_bot]

lemma not_s_same_side_bot (x y : P) : ¬ (⊥ : affine_subspace R P).s_same_side x y :=
λ h, not_w_same_side_bot x y h.w_same_side

lemma not_w_opp_side_bot (x y : P) : ¬ (⊥ : affine_subspace R P).w_opp_side x y :=
by simp [w_opp_side, not_mem_bot]

lemma not_s_opp_side_bot (x y : P) : ¬ (⊥ : affine_subspace R P).s_opp_side x y :=
λ h, not_w_opp_side_bot x y h.w_opp_side

@[simp] lemma w_same_side_self_iff {s : affine_subspace R P} {x : P} :
  s.w_same_side x x ↔ (s : set P).nonempty :=
⟨λ h, h.nonempty, λ ⟨p, hp⟩, ⟨p, hp, p, hp, same_ray.rfl⟩⟩

lemma s_same_side_self_iff {s : affine_subspace R P} {x : P} :
  s.s_same_side x x ↔ (s : set P).nonempty ∧ x ∉ s :=
⟨λ ⟨h, hx, _⟩, ⟨w_same_side_self_iff.1 h, hx⟩, λ ⟨h, hx⟩, ⟨w_same_side_self_iff.2 h, hx, hx⟩⟩

lemma w_same_side_of_left_mem {s : affine_subspace R P} {x : P} (y : P) (hx : x ∈ s) :
  s.w_same_side x y :=
begin
  refine ⟨x, hx, x, hx, _⟩,
  simp
end

lemma w_same_side_of_right_mem {s : affine_subspace R P} (x : P) {y : P} (hy : y ∈ s) :
  s.w_same_side x y :=
(w_same_side_of_left_mem x hy).symm

lemma w_opp_side_of_left_mem {s : affine_subspace R P} {x : P} (y : P) (hx : x ∈ s) :
  s.w_opp_side x y :=
begin
  refine ⟨x, hx, x, hx, _⟩,
  simp
end

lemma w_opp_side_of_right_mem {s : affine_subspace R P} (x : P) {y : P} (hy : y ∈ s) :
  s.w_opp_side x y :=
(w_opp_side_of_left_mem x hy).symm

lemma w_same_side_vadd_left_iff {s : affine_subspace R P} {x y : P} {v : V}
  (hv : v ∈ s.direction) : s.w_same_side (v +ᵥ x) y ↔ s.w_same_side x y :=
begin
  split,
  { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩,
    refine ⟨-v +ᵥ p₁,
            affine_subspace.vadd_mem_of_mem_direction (submodule.neg_mem _ hv) hp₁, p₂, hp₂, _⟩,
    rwa [vsub_vadd_eq_vsub_sub, sub_neg_eq_add, add_comm, ←vadd_vsub_assoc] },
  { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩,
    refine ⟨v +ᵥ p₁,
            affine_subspace.vadd_mem_of_mem_direction hv hp₁, p₂, hp₂, _⟩,
    rwa vadd_vsub_vadd_cancel_left }
end

lemma w_same_side_vadd_right_iff {s : affine_subspace R P} {x y : P} {v : V}
  (hv : v ∈ s.direction) : s.w_same_side x (v +ᵥ y) ↔ s.w_same_side x y :=
by rw [w_same_side_comm, w_same_side_vadd_left_iff hv, w_same_side_comm]

lemma s_same_side_vadd_left_iff {s : affine_subspace R P} {x y : P} {v : V}
  (hv : v ∈ s.direction) : s.s_same_side (v +ᵥ x) y ↔ s.s_same_side x y :=
by rw [s_same_side, s_same_side, w_same_side_vadd_left_iff hv,
       vadd_mem_iff_mem_of_mem_direction hv]

lemma s_same_side_vadd_right_iff {s : affine_subspace R P} {x y : P} {v : V}
  (hv : v ∈ s.direction) : s.s_same_side x (v +ᵥ y) ↔ s.s_same_side x y :=
by rw [s_same_side_comm, s_same_side_vadd_left_iff hv, s_same_side_comm]

lemma w_opp_side_vadd_left_iff {s : affine_subspace R P} {x y : P} {v : V}
  (hv : v ∈ s.direction) : s.w_opp_side (v +ᵥ x) y ↔ s.w_opp_side x y :=
begin
  split,
  { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩,
    refine ⟨-v +ᵥ p₁,
            affine_subspace.vadd_mem_of_mem_direction (submodule.neg_mem _ hv) hp₁, p₂, hp₂, _⟩,
    rwa [vsub_vadd_eq_vsub_sub, sub_neg_eq_add, add_comm, ←vadd_vsub_assoc] },
  { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩,
    refine ⟨v +ᵥ p₁,
            affine_subspace.vadd_mem_of_mem_direction hv hp₁, p₂, hp₂, _⟩,
    rwa vadd_vsub_vadd_cancel_left }
end

lemma w_opp_side_vadd_right_iff {s : affine_subspace R P} {x y : P} {v : V}
  (hv : v ∈ s.direction) : s.w_opp_side x (v +ᵥ y) ↔ s.w_opp_side x y :=
by rw [w_opp_side_comm, w_opp_side_vadd_left_iff hv, w_opp_side_comm]

lemma s_opp_side_vadd_left_iff {s : affine_subspace R P} {x y : P} {v : V}
  (hv : v ∈ s.direction) : s.s_opp_side (v +ᵥ x) y ↔ s.s_opp_side x y :=
by rw [s_opp_side, s_opp_side, w_opp_side_vadd_left_iff hv,
       vadd_mem_iff_mem_of_mem_direction hv]

lemma s_opp_side_vadd_right_iff {s : affine_subspace R P} {x y : P} {v : V}
  (hv : v ∈ s.direction) : s.s_opp_side x (v +ᵥ y) ↔ s.s_opp_side x y :=
by rw [s_opp_side_comm, s_opp_side_vadd_left_iff hv, s_opp_side_comm]

lemma w_same_side_smul_vsub_vadd_left {s : affine_subspace R P} {p₁ p₂ : P} (x : P)
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : 0 ≤ t) : s.w_same_side (t • (x -ᵥ p₁) +ᵥ p₂) x :=
begin
  refine ⟨p₂, hp₂, p₁, hp₁, _⟩,
  rw vadd_vsub,
  exact same_ray_nonneg_smul_left _ ht
end

lemma w_same_side_smul_vsub_vadd_right {s : affine_subspace R P} {p₁ p₂ : P} (x : P)
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : 0 ≤ t) : s.w_same_side x (t • (x -ᵥ p₁) +ᵥ p₂) :=
(w_same_side_smul_vsub_vadd_left x hp₁ hp₂ ht).symm

lemma w_same_side_line_map_left {s : affine_subspace R P} {x : P} (y : P) (h : x ∈ s) {t : R}
  (ht : 0 ≤ t) : s.w_same_side (line_map x y t) y :=
w_same_side_smul_vsub_vadd_left y h h ht

lemma w_same_side_line_map_right {s : affine_subspace R P} {x : P} (y : P) (h : x ∈ s) {t : R}
  (ht : 0 ≤ t) : s.w_same_side y (line_map x y t) :=
(w_same_side_line_map_left y h ht).symm

lemma w_opp_side_smul_vsub_vadd_left {s : affine_subspace R P} {p₁ p₂ : P} (x : P)
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : t ≤ 0) : s.w_opp_side (t • (x -ᵥ p₁) +ᵥ p₂) x :=
begin
  refine ⟨p₂, hp₂, p₁, hp₁, _⟩,
  rw [vadd_vsub, ←neg_neg t, neg_smul, ←smul_neg, neg_vsub_eq_vsub_rev],
  exact same_ray_nonneg_smul_left _ (neg_nonneg.2 ht)
end

lemma w_opp_side_smul_vsub_vadd_right {s : affine_subspace R P} {p₁ p₂ : P} (x : P)
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : t ≤ 0) : s.w_opp_side x (t • (x -ᵥ p₁) +ᵥ p₂) :=
(w_opp_side_smul_vsub_vadd_left x hp₁ hp₂ ht).symm

lemma w_opp_side_line_map_left {s : affine_subspace R P} {x : P} (y : P) (h : x ∈ s) {t : R}
  (ht : t ≤ 0) : s.w_opp_side (line_map x y t) y :=
w_opp_side_smul_vsub_vadd_left y h h ht

lemma w_opp_side_line_map_right {s : affine_subspace R P} {x : P} (y : P) (h : x ∈ s) {t : R}
  (ht : t ≤ 0) : s.w_opp_side y (line_map x y t) :=
(w_opp_side_line_map_left y h ht).symm

lemma _root_.wbtw.w_same_side₂₃ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z)
  (hx : x ∈ s) : s.w_same_side y z :=
begin
  rcases h with ⟨t, ⟨ht0, -⟩, rfl⟩,
  exact w_same_side_line_map_left z hx ht0
end

lemma _root_.wbtw.w_same_side₃₂ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z)
  (hx : x ∈ s) : s.w_same_side z y :=
(h.w_same_side₂₃ hx).symm

lemma _root_.wbtw.w_same_side₁₂ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z)
  (hz : z ∈ s) : s.w_same_side x y :=
h.symm.w_same_side₃₂ hz

lemma _root_.wbtw.w_same_side₂₁ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z)
  (hz : z ∈ s) : s.w_same_side y x :=
h.symm.w_same_side₂₃ hz

lemma _root_.wbtw.w_opp_side₁₃ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z)
  (hy : y ∈ s) : s.w_opp_side x z :=
begin
  rcases h with ⟨t, ⟨ht0, ht1⟩, rfl⟩,
  refine ⟨_, hy, _, hy, _⟩,
  rcases ht1.lt_or_eq with ht1' | rfl, swap, { simp },
  rcases ht0.lt_or_eq with ht0' | rfl, swap, { simp },
  refine or.inr (or.inr ⟨1 - t, t, sub_pos.2 ht1', ht0', _⟩),
  simp_rw [line_map_apply, vadd_vsub_assoc, vsub_vadd_eq_vsub_sub, ←neg_vsub_eq_vsub_rev z x,
           vsub_self, zero_sub, ←neg_one_smul R (z -ᵥ x), ←add_smul, smul_neg, ←neg_smul,
           smul_smul],
  ring_nf
end

lemma _root_.wbtw.w_opp_side₃₁ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z)
  (hy : y ∈ s) : s.w_opp_side z x :=
h.symm.w_opp_side₁₃ hy

end strict_ordered_comm_ring

section linear_ordered_field

variables [linear_ordered_field R] [add_comm_group V] [module R V] [add_torsor V P]
variables [add_comm_group V'] [module R V'] [add_torsor V' P']

include V

variables {R}

@[simp] lemma w_opp_side_self_iff {s : affine_subspace R P} {x : P} : s.w_opp_side x x ↔ x ∈ s :=
begin
  split,
  { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩,
    obtain ⟨a, -, -, -, -, h₁, -⟩ := h.exists_eq_smul_add,
    rw [add_comm, vsub_add_vsub_cancel, ←eq_vadd_iff_vsub_eq] at h₁,
    rw h₁,
    exact s.smul_vsub_vadd_mem a hp₂ hp₁ hp₁ },
  { exact λ h, ⟨x, h, x, h, same_ray.rfl⟩ }
end

lemma not_s_opp_side_self (s : affine_subspace R P) (x : P) : ¬s.s_opp_side x x :=
by simp [s_opp_side]

lemma w_same_side_iff_exists_left {s : affine_subspace R P} {x y p₁ : P} (h : p₁ ∈ s) :
  s.w_same_side x y ↔ x ∈ s ∨ ∃ p₂ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) :=
begin
  split,
  { rintro ⟨p₁', hp₁', p₂', hp₂', h0 | h0 | ⟨r₁, r₂, hr₁, hr₂, hr⟩⟩,
    { rw vsub_eq_zero_iff_eq at h0,
      rw h0,
      exact or.inl hp₁' },
    { refine or.inr ⟨p₂', hp₂', _⟩,
      rw h0,
      exact same_ray.zero_right _ },
    { refine or.inr ⟨(r₁ / r₂) • (p₁ -ᵥ p₁') +ᵥ p₂', s.smul_vsub_vadd_mem _ h hp₁' hp₂',
                     or.inr (or.inr ⟨r₁, r₂, hr₁, hr₂, _⟩)⟩,
      rw [vsub_vadd_eq_vsub_sub, smul_sub, ←hr, smul_smul, mul_div_cancel' _ hr₂.ne.symm,
          ←smul_sub, vsub_sub_vsub_cancel_right] } },
  { rintro (h' | h'),
    { exact w_same_side_of_left_mem y h' },
    { exact ⟨p₁, h, h'⟩ } }
end

lemma w_same_side_iff_exists_right {s : affine_subspace R P} {x y p₂ : P} (h : p₂ ∈ s) :
  s.w_same_side x y ↔ y ∈ s ∨ ∃ p₁ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) :=
begin
  rw [w_same_side_comm, w_same_side_iff_exists_left h],
  simp_rw same_ray_comm
end

lemma s_same_side_iff_exists_left {s : affine_subspace R P} {x y p₁ : P} (h : p₁ ∈ s) :
  s.s_same_side x y ↔ x ∉ s ∧ y ∉ s ∧ ∃ p₂ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) :=
begin
  rw [s_same_side, and_comm, w_same_side_iff_exists_left h, and_assoc, and.congr_right_iff],
  intro hx,
  rw or_iff_right hx
end

lemma s_same_side_iff_exists_right {s : affine_subspace R P} {x y p₂ : P} (h : p₂ ∈ s) :
  s.s_same_side x y ↔ x ∉ s ∧ y ∉ s ∧ ∃ p₁ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) :=
begin
  rw [s_same_side_comm, s_same_side_iff_exists_left h, ←and_assoc, and_comm (y ∉ s), and_assoc],
  simp_rw same_ray_comm
end

lemma w_opp_side_iff_exists_left {s : affine_subspace R P} {x y p₁ : P} (h : p₁ ∈ s) :
  s.w_opp_side x y ↔ x ∈ s ∨ ∃ p₂ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) :=
begin
  split,
  { rintro ⟨p₁', hp₁', p₂', hp₂', h0 | h0 | ⟨r₁, r₂, hr₁, hr₂, hr⟩⟩,
    { rw vsub_eq_zero_iff_eq at h0,
      rw h0,
      exact or.inl hp₁' },
    { refine or.inr ⟨p₂', hp₂', _⟩,
      rw h0,
      exact same_ray.zero_right _ },
    { refine or.inr ⟨(-r₁ / r₂) • (p₁ -ᵥ p₁') +ᵥ p₂', s.smul_vsub_vadd_mem _ h hp₁' hp₂',
                     or.inr (or.inr ⟨r₁, r₂, hr₁, hr₂, _⟩)⟩,
      rw [vadd_vsub_assoc, smul_add, ←hr, smul_smul, neg_div, mul_neg,
          mul_div_cancel' _ hr₂.ne.symm, neg_smul, neg_add_eq_sub, ←smul_sub,
          vsub_sub_vsub_cancel_right] } },
  { rintro (h' | h'),
    { exact w_opp_side_of_left_mem y h' },
    { exact ⟨p₁, h, h'⟩ } }
end

lemma w_opp_side_iff_exists_right {s : affine_subspace R P} {x y p₂ : P} (h : p₂ ∈ s) :
  s.w_opp_side x y ↔ y ∈ s ∨ ∃ p₁ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) :=
begin
  rw [w_opp_side_comm, w_opp_side_iff_exists_left h],
  split,
  { rintro (hy | ⟨p, hp, hr⟩), { exact or.inl hy },
    refine or.inr ⟨p, hp, _⟩,
    rwa [same_ray_comm, ←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] },
  { rintro (hy | ⟨p, hp, hr⟩), { exact or.inl hy },
    refine or.inr ⟨p, hp, _⟩,
    rwa [same_ray_comm, ←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] }
end

lemma s_opp_side_iff_exists_left {s : affine_subspace R P} {x y p₁ : P} (h : p₁ ∈ s) :
  s.s_opp_side x y ↔ x ∉ s ∧ y ∉ s ∧ ∃ p₂ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) :=
begin
  rw [s_opp_side, and_comm, w_opp_side_iff_exists_left h, and_assoc, and.congr_right_iff],
  intro hx,
  rw or_iff_right hx
end

lemma s_opp_side_iff_exists_right {s : affine_subspace R P} {x y p₂ : P} (h : p₂ ∈ s) :
  s.s_opp_side x y ↔ x ∉ s ∧ y ∉ s ∧ ∃ p₁ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) :=
begin
  rw [s_opp_side, and_comm, w_opp_side_iff_exists_right h, and_assoc, and.congr_right_iff,
      and.congr_right_iff],
  rintro hx hy,
  rw or_iff_right hy
end

lemma w_same_side.trans {s : affine_subspace R P} {x y z : P} (hxy : s.w_same_side x y)
  (hyz : s.w_same_side y z) (hy : y ∉ s) : s.w_same_side x z :=
begin
  rcases hxy with ⟨p₁, hp₁, p₂, hp₂, hxy⟩,
  rw [w_same_side_iff_exists_left hp₂, or_iff_right hy] at hyz,
  rcases hyz with ⟨p₃, hp₃, hyz⟩,
  refine ⟨p₁, hp₁, p₃, hp₃, hxy.trans hyz _⟩,
  refine λ h, false.elim _,
  rw vsub_eq_zero_iff_eq at h,
  exact hy (h.symm ▸ hp₂)
end

lemma w_same_side.trans_s_same_side {s : affine_subspace R P} {x y z : P}
  (hxy : s.w_same_side x y) (hyz : s.s_same_side y z) : s.w_same_side x z :=
hxy.trans hyz.1 hyz.2.1

lemma w_same_side.trans_w_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_same_side x y)
  (hyz : s.w_opp_side y z) (hy : y ∉ s) : s.w_opp_side x z :=
begin
  rcases hxy with ⟨p₁, hp₁, p₂, hp₂, hxy⟩,
  rw [w_opp_side_iff_exists_left hp₂, or_iff_right hy] at hyz,
  rcases hyz with ⟨p₃, hp₃, hyz⟩,
  refine ⟨p₁, hp₁, p₃, hp₃, hxy.trans hyz _⟩,
  refine λ h, false.elim _,
  rw vsub_eq_zero_iff_eq at h,
  exact hy (h.symm ▸ hp₂)
end

lemma w_same_side.trans_s_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_same_side x y)
  (hyz : s.s_opp_side y z) : s.w_opp_side x z :=
hxy.trans_w_opp_side hyz.1 hyz.2.1

lemma s_same_side.trans_w_same_side {s : affine_subspace R P} {x y z : P}
  (hxy : s.s_same_side x y) (hyz : s.w_same_side y z) : s.w_same_side x z :=
(hyz.symm.trans_s_same_side hxy.symm).symm

lemma s_same_side.trans {s : affine_subspace R P} {x y z : P} (hxy : s.s_same_side x y)
  (hyz : s.s_same_side y z) : s.s_same_side x z :=
⟨hxy.w_same_side.trans_s_same_side hyz, hxy.2.1, hyz.2.2⟩

lemma s_same_side.trans_w_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_same_side x y)
  (hyz : s.w_opp_side y z) : s.w_opp_side x z :=
hxy.w_same_side.trans_w_opp_side hyz hxy.2.2

lemma s_same_side.trans_s_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_same_side x y)
  (hyz : s.s_opp_side y z) : s.s_opp_side x z :=
⟨hxy.trans_w_opp_side hyz.1, hxy.2.1, hyz.2.2⟩

lemma w_opp_side.trans_w_same_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_opp_side x y)
  (hyz : s.w_same_side y z) (hy : y ∉ s) : s.w_opp_side x z :=
(hyz.symm.trans_w_opp_side hxy.symm hy).symm

lemma w_opp_side.trans_s_same_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_opp_side x y)
  (hyz : s.s_same_side y z) : s.w_opp_side x z :=
hxy.trans_w_same_side hyz.1 hyz.2.1

lemma w_opp_side.trans {s : affine_subspace R P} {x y z : P} (hxy : s.w_opp_side x y)
  (hyz : s.w_opp_side y z) (hy : y ∉ s) : s.w_same_side x z :=
begin
  rcases hxy with ⟨p₁, hp₁, p₂, hp₂, hxy⟩,
  rw [w_opp_side_iff_exists_left hp₂, or_iff_right hy] at hyz,
  rcases hyz with ⟨p₃, hp₃, hyz⟩,
  rw [←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] at hyz,
  refine ⟨p₁, hp₁, p₃, hp₃, hxy.trans hyz _⟩,
  refine λ h, false.elim _,
  rw vsub_eq_zero_iff_eq at h,
  exact hy (h ▸ hp₂)
end

lemma w_opp_side.trans_s_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_opp_side x y)
  (hyz : s.s_opp_side y z) : s.w_same_side x z :=
hxy.trans hyz.1 hyz.2.1

lemma s_opp_side.trans_w_same_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_opp_side x y)
  (hyz : s.w_same_side y z) : s.w_opp_side x z :=
(hyz.symm.trans_s_opp_side hxy.symm).symm

lemma s_opp_side.trans_s_same_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_opp_side x y)
  (hyz : s.s_same_side y z) : s.s_opp_side x z :=
(hyz.symm.trans_s_opp_side hxy.symm).symm

lemma s_opp_side.trans_w_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_opp_side x y)
  (hyz : s.w_opp_side y z) : s.w_same_side x z :=
(hyz.symm.trans_s_opp_side hxy.symm).symm

lemma s_opp_side.trans {s : affine_subspace R P} {x y z : P} (hxy : s.s_opp_side x y)
  (hyz : s.s_opp_side y z) : s.s_same_side x z :=
⟨hxy.trans_w_opp_side hyz.1, hxy.2.1, hyz.2.2⟩

lemma w_same_side_and_w_opp_side_iff {s : affine_subspace R P} {x y : P} :
  (s.w_same_side x y ∧ s.w_opp_side x y) ↔ (x ∈ s ∨ y ∈ s) :=
begin
  split,
  { rintro ⟨hs, ho⟩,
    rw w_opp_side_comm at ho,
    by_contra h,
    rw not_or_distrib at h,
    exact h.1 (w_opp_side_self_iff.1 (hs.trans_w_opp_side ho h.2)) },
  { rintro (h | h),
    { exact ⟨w_same_side_of_left_mem y h, w_opp_side_of_left_mem y h⟩ },
    { exact ⟨w_same_side_of_right_mem x h, w_opp_side_of_right_mem x h⟩ } }
end

lemma w_same_side.not_s_opp_side {s : affine_subspace R P} {x y : P} (h : s.w_same_side x y) :
  ¬s.s_opp_side x y :=
begin
  intro ho,
  have hxy := w_same_side_and_w_opp_side_iff.1 ⟨h, ho.1⟩,
  rcases hxy with hx | hy,
  { exact ho.2.1 hx },
  { exact ho.2.2 hy }
end

lemma s_same_side.not_w_opp_side {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) :
  ¬s.w_opp_side x y :=
begin
  intro ho,
  have hxy := w_same_side_and_w_opp_side_iff.1 ⟨h.1, ho⟩,
  rcases hxy with hx | hy,
  { exact h.2.1 hx },
  { exact h.2.2 hy }
end

lemma s_same_side.not_s_opp_side {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) :
  ¬s.s_opp_side x y :=
λ ho, h.not_w_opp_side ho.1

lemma w_opp_side.not_s_same_side {s : affine_subspace R P} {x y : P} (h : s.w_opp_side x y) :
  ¬s.s_same_side x y :=
λ hs, hs.not_w_opp_side h

lemma s_opp_side.not_w_same_side {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) :
  ¬s.w_same_side x y :=
λ hs, hs.not_s_opp_side h

lemma s_opp_side.not_s_same_side {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) :
  ¬s.s_same_side x y :=
λ hs, h.not_w_same_side hs.1

lemma w_opp_side_iff_exists_wbtw {s : affine_subspace R P} {x y : P} :
  s.w_opp_side x y ↔ ∃ p ∈ s, wbtw R x p y :=
begin
  refine ⟨λ h, _, λ ⟨p, hp, h⟩, h.w_opp_side₁₃ hp⟩,
  rcases h with ⟨p₁, hp₁, p₂, hp₂, (h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩)⟩,
  { rw vsub_eq_zero_iff_eq at h,
    rw h,
    exact ⟨p₁, hp₁, wbtw_self_left _ _ _⟩ },
  { rw vsub_eq_zero_iff_eq at h,
    rw ←h,
    exact ⟨p₂, hp₂, wbtw_self_right _ _ _⟩ },
  { refine ⟨line_map x y (r₂ / (r₁ + r₂)), _, _⟩,
    { rw [line_map_apply, ←vsub_vadd x p₁, ←vsub_vadd y p₂, vsub_vadd_eq_vsub_sub,
          vadd_vsub_assoc, ←vadd_assoc, vadd_eq_add],
      convert s.smul_vsub_vadd_mem (r₂ / (r₁ + r₂)) hp₂ hp₁ hp₁,
      rw [add_comm (y -ᵥ p₂), smul_sub, smul_add, add_sub_assoc, add_assoc, add_right_eq_self,
          div_eq_inv_mul, ←neg_vsub_eq_vsub_rev, smul_neg, ←smul_smul, ←h, smul_smul,
          ←neg_smul, ←sub_smul, ←div_eq_inv_mul, ←div_eq_inv_mul, ←neg_div, ←sub_div,
          sub_eq_add_neg, ←neg_add, neg_div, div_self (left.add_pos hr₁ hr₂).ne.symm,
          neg_one_smul, neg_add_self] },
    { exact set.mem_image_of_mem _ ⟨div_nonneg hr₂.le (left.add_pos hr₁ hr₂).le,
                                    div_le_one_of_le (le_add_of_nonneg_left hr₁.le)
                                                     (left.add_pos hr₁ hr₂).le⟩ } }
end

lemma s_opp_side.exists_sbtw {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) :
  ∃ p ∈ s, sbtw R x p y :=
begin
  obtain ⟨p, hp, hw⟩ := w_opp_side_iff_exists_wbtw.1 h.w_opp_side,
  refine ⟨p, hp, hw, _, _⟩,
  { rintro rfl,
    exact h.2.1 hp },
  { rintro rfl,
    exact h.2.2 hp },
end

lemma _root_.sbtw.s_opp_side_of_not_mem_of_mem {s : affine_subspace R P} {x y z : P}
  (h : sbtw R x y z) (hx : x ∉ s) (hy : y ∈ s) : s.s_opp_side x z :=
begin
  refine ⟨h.wbtw.w_opp_side₁₃ hy, hx, λ hz, hx _⟩,
  rcases h with ⟨⟨t, ⟨ht0, ht1⟩, rfl⟩, hyx, hyz⟩,
  rw line_map_apply at hy,
  have ht : t ≠ 1, { rintro rfl, simpa [line_map_apply] using hyz },
  have hy' := vsub_mem_direction hy hz,
  rw [vadd_vsub_assoc, ←neg_vsub_eq_vsub_rev z, ←neg_one_smul R (z -ᵥ x), ←add_smul,
      ←sub_eq_add_neg, s.direction.smul_mem_iff (sub_ne_zero_of_ne ht)] at hy',
  rwa vadd_mem_iff_mem_of_mem_direction (submodule.smul_mem _ _ hy') at hy
end

lemma s_same_side_smul_vsub_vadd_left {s : affine_subspace R P} {x p₁ p₂ : P} (hx : x ∉ s)
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : 0 < t) : s.s_same_side (t • (x -ᵥ p₁) +ᵥ p₂) x :=
begin
  refine ⟨w_same_side_smul_vsub_vadd_left x hp₁ hp₂ ht.le, λ h, hx _, hx⟩,
  rwa [vadd_mem_iff_mem_direction _ hp₂, s.direction.smul_mem_iff ht.ne.symm,
       vsub_right_mem_direction_iff_mem hp₁] at h
end

lemma s_same_side_smul_vsub_vadd_right {s : affine_subspace R P} {x p₁ p₂ : P} (hx : x ∉ s)
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : 0 < t) : s.s_same_side x (t • (x -ᵥ p₁) +ᵥ p₂) :=
(s_same_side_smul_vsub_vadd_left hx hp₁ hp₂ ht).symm

lemma s_same_side_line_map_left {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s)
  {t : R} (ht : 0 < t) : s.s_same_side (line_map x y t) y :=
s_same_side_smul_vsub_vadd_left hy hx hx ht

lemma s_same_side_line_map_right {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s)
  {t : R} (ht : 0 < t) : s.s_same_side y (line_map x y t) :=
(s_same_side_line_map_left hx hy ht).symm

lemma s_opp_side_smul_vsub_vadd_left {s : affine_subspace R P} {x p₁ p₂ : P} (hx : x ∉ s)
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : t < 0) : s.s_opp_side (t • (x -ᵥ p₁) +ᵥ p₂) x :=
begin
  refine ⟨w_opp_side_smul_vsub_vadd_left x hp₁ hp₂ ht.le, λ h, hx _, hx⟩,
  rwa [vadd_mem_iff_mem_direction _ hp₂, s.direction.smul_mem_iff ht.ne,
       vsub_right_mem_direction_iff_mem hp₁] at h
end

lemma s_opp_side_smul_vsub_vadd_right {s : affine_subspace R P} {x p₁ p₂ : P} (hx : x ∉ s)
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : t < 0) : s.s_opp_side x (t • (x -ᵥ p₁) +ᵥ p₂) :=
(s_opp_side_smul_vsub_vadd_left hx hp₁ hp₂ ht).symm

lemma s_opp_side_line_map_left {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s)
  {t : R} (ht : t < 0) : s.s_opp_side (line_map x y t) y :=
s_opp_side_smul_vsub_vadd_left hy hx hx ht

lemma s_opp_side_line_map_right {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s)
  {t : R} (ht : t < 0) : s.s_opp_side y (line_map x y t) :=
(s_opp_side_line_map_left hx hy ht).symm

lemma set_of_w_same_side_eq_image2 {s : affine_subspace R P} {x p : P} (hx : x ∉ s) (hp : p ∈ s) :
  {y | s.w_same_side x y} = set.image2 (λ (t : R) q, t • (x -ᵥ p) +ᵥ q) (set.Ici 0) s :=
begin
  ext y,
  simp_rw [set.mem_set_of, set.mem_image2, set.mem_Ici, mem_coe],
  split,
  { rw [w_same_side_iff_exists_left hp, or_iff_right hx],
    rintro ⟨p₂, hp₂, h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩⟩,
    { rw vsub_eq_zero_iff_eq at h,
      exact false.elim (hx (h.symm ▸ hp)) },
    { rw vsub_eq_zero_iff_eq at h,
      refine ⟨0, p₂, le_refl _, hp₂, _⟩,
      simp [h] },
    { refine ⟨r₁ / r₂, p₂, (div_pos hr₁ hr₂).le, hp₂, _⟩,
      rw [div_eq_inv_mul, ←smul_smul, h, smul_smul, inv_mul_cancel hr₂.ne.symm, one_smul,
          vsub_vadd] } },
  { rintro ⟨t, p', ht, hp', rfl⟩,
    exact w_same_side_smul_vsub_vadd_right x hp hp' ht }
end

lemma set_of_s_same_side_eq_image2 {s : affine_subspace R P} {x p : P} (hx : x ∉ s) (hp : p ∈ s) :
  {y | s.s_same_side x y} = set.image2 (λ (t : R) q, t • (x -ᵥ p) +ᵥ q) (set.Ioi 0) s :=
begin
  ext y,
  simp_rw [set.mem_set_of, set.mem_image2, set.mem_Ioi, mem_coe],
  split,
  { rw s_same_side_iff_exists_left hp,
    rintro ⟨-, hy, p₂, hp₂, h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩⟩,
    { rw vsub_eq_zero_iff_eq at h,
      exact false.elim (hx (h.symm ▸ hp)) },
    { rw vsub_eq_zero_iff_eq at h,
      exact false.elim (hy (h.symm ▸ hp₂)) },
    { refine ⟨r₁ / r₂, p₂, div_pos hr₁ hr₂, hp₂, _⟩,
      rw [div_eq_inv_mul, ←smul_smul, h, smul_smul, inv_mul_cancel hr₂.ne.symm, one_smul,
          vsub_vadd] } },
  { rintro ⟨t, p', ht, hp', rfl⟩,
    exact s_same_side_smul_vsub_vadd_right hx hp hp' ht }
end

lemma set_of_w_opp_side_eq_image2 {s : affine_subspace R P} {x p : P} (hx : x ∉ s) (hp : p ∈ s) :
  {y | s.w_opp_side x y} = set.image2 (λ (t : R) q, t • (x -ᵥ p) +ᵥ q) (set.Iic 0) s :=
begin
  ext y,
  simp_rw [set.mem_set_of, set.mem_image2, set.mem_Iic, mem_coe],
  split,
  { rw [w_opp_side_iff_exists_left hp, or_iff_right hx],
    rintro ⟨p₂, hp₂, h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩⟩,
    { rw vsub_eq_zero_iff_eq at h,
      exact false.elim (hx (h.symm ▸ hp)) },
    { rw vsub_eq_zero_iff_eq at h,
      refine ⟨0, p₂, le_refl _, hp₂, _⟩,
      simp [h] },
    { refine ⟨-r₁ / r₂, p₂, (div_neg_of_neg_of_pos (left.neg_neg_iff.2 hr₁) hr₂).le, hp₂, _⟩,
      rw [div_eq_inv_mul, ←smul_smul, neg_smul, h, smul_neg, smul_smul,
          inv_mul_cancel hr₂.ne.symm, one_smul, neg_vsub_eq_vsub_rev, vsub_vadd] } },
  { rintro ⟨t, p', ht, hp', rfl⟩,
    exact w_opp_side_smul_vsub_vadd_right x hp hp' ht }
end

lemma set_of_s_opp_side_eq_image2 {s : affine_subspace R P} {x p : P} (hx : x ∉ s) (hp : p ∈ s) :
  {y | s.s_opp_side x y} = set.image2 (λ (t : R) q, t • (x -ᵥ p) +ᵥ q) (set.Iio 0) s :=
begin
  ext y,
  simp_rw [set.mem_set_of, set.mem_image2, set.mem_Iio, mem_coe],
  split,
  { rw s_opp_side_iff_exists_left hp,
    rintro ⟨-, hy, p₂, hp₂, h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩⟩,
    { rw vsub_eq_zero_iff_eq at h,
      exact false.elim (hx (h.symm ▸ hp)) },
    { rw vsub_eq_zero_iff_eq at h,
      exact false.elim (hy (h ▸ hp₂)) },
    { refine ⟨-r₁ / r₂, p₂, div_neg_of_neg_of_pos (left.neg_neg_iff.2 hr₁) hr₂, hp₂, _⟩,
      rw [div_eq_inv_mul, ←smul_smul, neg_smul, h, smul_neg, smul_smul,
          inv_mul_cancel hr₂.ne.symm, one_smul, neg_vsub_eq_vsub_rev, vsub_vadd] } },
  { rintro ⟨t, p', ht, hp', rfl⟩,
    exact s_opp_side_smul_vsub_vadd_right hx hp hp' ht }
end

lemma w_opp_side_point_reflection {s : affine_subspace R P} {x : P} (y : P) (hx : x ∈ s) :
  s.w_opp_side y (point_reflection R x y) :=
(wbtw_point_reflection R _ _).w_opp_side₁₃ hx

lemma s_opp_side_point_reflection {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s) :
  s.s_opp_side y (point_reflection R x y) :=
begin
  refine (sbtw_point_reflection_of_ne R (λ h, hy _)).s_opp_side_of_not_mem_of_mem hy hx,
  rwa ←h
end

end linear_ordered_field

section normed

variables [seminormed_add_comm_group V] [normed_space ℝ V] [pseudo_metric_space P]
variables [normed_add_torsor V P]

include V

lemma is_connected_set_of_w_same_side {s : affine_subspace ℝ P} (x : P)
  (h : (s : set P).nonempty) : is_connected {y | s.w_same_side x y} :=
begin
  obtain ⟨p, hp⟩ := h,
  haveI : nonempty s := ⟨⟨p, hp⟩⟩,
  by_cases hx : x ∈ s,
  { convert is_connected_univ,
    { simp [w_same_side_of_left_mem, hx] },
    { exact add_torsor.connected_space V P } },
  { rw [set_of_w_same_side_eq_image2 hx hp, ←set.image_prod],
    refine (is_connected_Ici.prod (is_connected_iff_connected_space.2 _)).image _
           ((continuous_fst.smul continuous_const).vadd continuous_snd).continuous_on,
    convert add_torsor.connected_space s.direction s }
end

lemma is_preconnected_set_of_w_same_side (s : affine_subspace ℝ P) (x : P) :
  is_preconnected {y | s.w_same_side x y} :=
begin
  rcases set.eq_empty_or_nonempty (s : set P) with h | h,
  { convert is_preconnected_empty,
    rw coe_eq_bot_iff at h,
    simp only [h, not_w_same_side_bot],
    refl },
  { exact (is_connected_set_of_w_same_side x h).is_preconnected }
end

lemma is_connected_set_of_s_same_side {s : affine_subspace ℝ P} {x : P} (hx : x ∉ s)
  (h : (s : set P).nonempty) : is_connected {y | s.s_same_side x y} :=
begin
  obtain ⟨p, hp⟩ := h,
  haveI : nonempty s := ⟨⟨p, hp⟩⟩,
  rw [set_of_s_same_side_eq_image2 hx hp, ←set.image_prod],
  refine (is_connected_Ioi.prod (is_connected_iff_connected_space.2 _)).image _
         ((continuous_fst.smul continuous_const).vadd continuous_snd).continuous_on,
  convert add_torsor.connected_space s.direction s
end

lemma is_preconnected_set_of_s_same_side (s : affine_subspace ℝ P) (x : P) :
  is_preconnected {y | s.s_same_side x y} :=
begin
  rcases set.eq_empty_or_nonempty (s : set P) with h | h,
  { convert is_preconnected_empty,
    rw coe_eq_bot_iff at h,
    simp only [h, not_s_same_side_bot],
    refl },
  { by_cases hx : x ∈ s,
    { convert is_preconnected_empty,
      simp only [hx, s_same_side, not_true, false_and, and_false],
      refl },
    { exact (is_connected_set_of_s_same_side hx h).is_preconnected } }
end

lemma is_connected_set_of_w_opp_side {s : affine_subspace ℝ P} (x : P)
  (h : (s : set P).nonempty) : is_connected {y | s.w_opp_side x y} :=
begin
  obtain ⟨p, hp⟩ := h,
  haveI : nonempty s := ⟨⟨p, hp⟩⟩,
  by_cases hx : x ∈ s,
  { convert is_connected_univ,
    { simp [w_opp_side_of_left_mem, hx] },
    { exact add_torsor.connected_space V P } },
  { rw [set_of_w_opp_side_eq_image2 hx hp, ←set.image_prod],
    refine (is_connected_Iic.prod (is_connected_iff_connected_space.2 _)).image _
           ((continuous_fst.smul continuous_const).vadd continuous_snd).continuous_on,
    convert add_torsor.connected_space s.direction s }
end

lemma is_connected_set_of_s_opp_side {s : affine_subspace ℝ P} {x : P} (hx : x ∉ s)
  (h : (s : set P).nonempty) : is_connected {y | s.s_opp_side x y} :=
begin
  obtain ⟨p, hp⟩ := h,
  haveI : nonempty s := ⟨⟨p, hp⟩⟩,
  rw [set_of_s_opp_side_eq_image2 hx hp, ←set.image_prod],
  refine (is_connected_Iio.prod (is_connected_iff_connected_space.2 _)).image _
         ((continuous_fst.smul continuous_const).vadd continuous_snd).continuous_on,
  convert add_torsor.connected_space s.direction s
end

lemma is_preconnected_set_of_s_opp_side (s : affine_subspace ℝ P) (x : P) :
  is_preconnected {y | s.s_opp_side x y} :=
begin
  rcases set.eq_empty_or_nonempty (s : set P) with h | h,
  { convert is_preconnected_empty,
    rw coe_eq_bot_iff at h,
    simp only [h, not_s_opp_side_bot],
    refl },
  { by_cases hx : x ∈ s,
    { convert is_preconnected_empty,
      simp only [hx, s_opp_side, not_true, false_and, and_false],
      refl },
    { exact (is_connected_set_of_s_opp_side hx h).is_preconnected } }
end

end normed

end affine_subspace


import Cdclt.Quant

open proof
open proof.sort proof.term
open rules
open quantRules

def u1 := atom 1
def u2 := atom 2
def x := (const 60 u1)
def f1 := const 61 (arrow u1 u1)
def t1  := const 62 u1
def t2 := const 63 u2
def p1 := const 64 (arrow u1 boolSort)

def myquant := qforall 60 (f1 • x) -- this binds the variable
def myquant2 := qforall 60 x -- this binds the variable

theorem testInst1 : thHolds myquant → thHolds (f1 • t1) :=
λ s0 : thHolds myquant =>
show thHolds (f1 • t1) from instForall t1 s0

-- should not go through since t2 has different type from x
-- theorem testInst2 : thHolds myquant → thHolds (f1 • t2) :=
-- λ s0 : thHolds myquant =>
-- show thHolds (f1 • t2) from instForall t2 s0


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

import ring_theory.integrally_closed
import ring_theory.polynomial.scale_roots

/-!
# Rational root theorem and integral root theorem

This file contains the rational root theorem and integral root theorem.
The rational root theorem for a unique factorization domain `A`
with localization `S`, states that the roots of `p : polynomial A` in `A`'s
field of fractions are of the form `x / y` with `x y : A`, `x ∣ p.coeff 0` and
`y ∣ p.leading_coeff`.
The corollary is the integral root theorem `is_integer_of_is_root_of_monic`:
if `p` is monic, its roots must be integers.
Finally, we use this to show unique factorization domains are integrally closed.

## References

 * https://en.wikipedia.org/wiki/Rational_root_theorem
-/

section scale_roots

variables {A K R S : Type*} [comm_ring A] [field K] [comm_ring R] [comm_ring S]
variables {M : submonoid A} [algebra A S] [is_localization M S] [algebra A K] [is_fraction_ring A K]

open finsupp is_fraction_ring is_localization polynomial

lemma scale_roots_aeval_eq_zero_of_aeval_mk'_eq_zero {p : polynomial A} {r : A} {s : M}
  (hr : aeval (mk' S r s) p = 0) :
  aeval (algebra_map A S r) (scale_roots p s) = 0 :=
begin
  convert scale_roots_eval₂_eq_zero (algebra_map A S) hr,
  rw [aeval_def, mk'_spec' _ r s]
end

variables [is_domain A]

lemma num_is_root_scale_roots_of_aeval_eq_zero
  [unique_factorization_monoid A] {p : polynomial A} {x : K} (hr : aeval x p = 0) :
  is_root (scale_roots p (denom A x)) (num A x) :=
begin
  apply is_root_of_eval₂_map_eq_zero (is_fraction_ring.injective A K),
  refine scale_roots_aeval_eq_zero_of_aeval_mk'_eq_zero _,
  rw mk'_num_denom,
  exact hr
end

end scale_roots

section rational_root_theorem

variables {A K : Type*} [comm_ring A] [is_domain A] [unique_factorization_monoid A] [field K]
variables [algebra A K] [is_fraction_ring A K]

open is_fraction_ring is_localization polynomial unique_factorization_monoid

/-- Rational root theorem part 1:
if `r : f.codomain` is a root of a polynomial over the ufd `A`,
then the numerator of `r` divides the constant coefficient -/
theorem num_dvd_of_is_root {p : polynomial A} {r : K} (hr : aeval r p = 0) :
  num A r ∣ p.coeff 0 :=
begin
  suffices : num A r ∣ (scale_roots p (denom A r)).coeff 0,
  { simp only [coeff_scale_roots, tsub_zero] at this,
    haveI := classical.prop_decidable,
    by_cases hr : num A r = 0,
    { obtain ⟨u, hu⟩ := (is_unit_denom_of_num_eq_zero hr).pow p.nat_degree,
      rw ←hu at this,
      exact units.dvd_mul_right.mp this },
    { refine dvd_of_dvd_mul_left_of_no_prime_factors hr _ this,
      intros q dvd_num dvd_denom_pow hq,
      apply hq.not_unit,
      exact num_denom_reduced A r dvd_num (hq.dvd_of_dvd_pow dvd_denom_pow) } },
  convert dvd_term_of_is_root_of_dvd_terms 0 (num_is_root_scale_roots_of_aeval_eq_zero hr) _,
  { rw [pow_zero, mul_one] },
  intros j hj,
  apply dvd_mul_of_dvd_right,
  convert pow_dvd_pow (num A r) (nat.succ_le_of_lt (bot_lt_iff_ne_bot.mpr hj)),
  exact (pow_one _).symm
end

/-- Rational root theorem part 2:
if `r : f.codomain` is a root of a polynomial over the ufd `A`,
then the denominator of `r` divides the leading coefficient -/
theorem denom_dvd_of_is_root {p : polynomial A} {r : K} (hr : aeval r p = 0) :
  (denom A r : A) ∣ p.leading_coeff :=
begin
  suffices : (denom A r : A) ∣ p.leading_coeff * num A r ^ p.nat_degree,
  { refine dvd_of_dvd_mul_left_of_no_prime_factors
      (mem_non_zero_divisors_iff_ne_zero.mp (denom A r).2) _ this,
    intros q dvd_denom dvd_num_pow hq,
    apply hq.not_unit,
    exact num_denom_reduced A r (hq.dvd_of_dvd_pow dvd_num_pow) dvd_denom },
  rw ←coeff_scale_roots_nat_degree,
  apply dvd_term_of_is_root_of_dvd_terms _ (num_is_root_scale_roots_of_aeval_eq_zero hr),
  intros j hj,
  by_cases h : j < p.nat_degree,
  { rw coeff_scale_roots,
    refine (dvd_mul_of_dvd_right _ _).mul_right _,
    convert pow_dvd_pow _ (nat.succ_le_iff.mpr (lt_tsub_iff_left.mpr _)),
    { exact (pow_one _).symm },
    simpa using h },
  rw [←nat_degree_scale_roots p (denom A r)] at *,
  rw [coeff_eq_zero_of_nat_degree_lt (lt_of_le_of_ne (le_of_not_gt h) hj.symm), zero_mul],
  exact dvd_zero _
end

/-- Integral root theorem:
if `r : f.codomain` is a root of a monic polynomial over the ufd `A`,
then `r` is an integer -/
theorem is_integer_of_is_root_of_monic {p : polynomial A} (hp : monic p) {r : K}
  (hr : aeval r p = 0) : is_integer A r :=
is_integer_of_is_unit_denom (is_unit_of_dvd_one _ (hp ▸ denom_dvd_of_is_root hr))

namespace unique_factorization_monoid

lemma integer_of_integral {x : K} :
  is_integral A x → is_integer A x :=
λ ⟨p, hp, hx⟩, is_integer_of_is_root_of_monic hp hx

@[priority 100] -- See library note [lower instance priority]
instance : is_integrally_closed A :=
⟨λ x, integer_of_integral⟩

end unique_factorization_monoid

end rational_root_theorem


import power_quandle

universe u

section sub_power_quandle

structure sub_power_quandle (Q : Type u) [power_quandle Q] :=
(carrier : set Q)
(closed_rhd : ∀ x y : Q, x ∈ carrier → y ∈ carrier → (x ▷ y) ∈ carrier)
(closed_pow : ∀ x : Q, ∀ n : ℤ, x ∈ carrier → x ^ n ∈ carrier)
(closed_one : (1 : Q) ∈ carrier)

variables {Q : Type u} [power_quandle Q]

instance spq_coe_carrier : has_coe (sub_power_quandle Q) (set Q) := ⟨λ spq, spq.carrier⟩

lemma spq_coe_is_carrier (Q1 : sub_power_quandle Q) : ↑Q1 = Q1.carrier := rfl

variables {Q1 : sub_power_quandle Q}

def spq_rhd : Q1 → Q1 → Q1 := λ ⟨x, hx⟩ ⟨y, hy⟩, ⟨x ▷ y, Q1.closed_rhd x y hx hy⟩

def spq_pow : Q1 → ℤ → Q1 := λ ⟨x, hx⟩ n, ⟨x ^ n, Q1.closed_pow x n hx⟩

def spq_one : Q1 := ⟨1, Q1.closed_one⟩

instance sub_power_quandle_has_rhd : has_rhd Q1 := ⟨spq_rhd⟩

instance sub_power_quandle_has_pow : has_pow Q1 ℤ := ⟨spq_pow⟩

instance sub_power_quandle_has_one : has_one Q1 := ⟨spq_one⟩

lemma spq_rhd_def (a b : Q) (ha : a ∈ Q1.carrier) (hb : b ∈ Q1.carrier) : (⟨a, ha⟩ ▷ ⟨b, hb⟩ : Q1) = ⟨a ▷ b, (Q1.closed_rhd a b ha hb)⟩ := rfl

lemma spq_pow_def (a : Q) (n : ℤ) (ha : a ∈ Q1.carrier) : (⟨a, ha⟩ ^ n : Q1) = ⟨a ^ n, (Q1.closed_pow a n ha)⟩ := rfl

lemma spq_one_def : (1 : Q1) = ⟨1, Q1.closed_one⟩ := rfl

lemma coe_rhd (a b : Q1) : (↑a : Q) ▷ (↑b) = ↑(a ▷ b) :=
begin
  cases a with a ha,
  cases b with b hb,
  refl,
end

lemma coe_pow (a : Q1) (n : ℤ) : (↑a : Q) ^ n = ↑(a ^ n) :=
begin
  cases a with a ha,
  refl,
end

lemma coe_one : (↑(1 : Q1) : Q) = 1 := rfl

instance sub_power_quandle_is_pq : power_quandle Q1 := {
  rhd_dist := begin
    rintros ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩,
    simp only [spq_rhd_def, subtype.mk_eq_mk],
    apply power_quandle.rhd_dist,
  end,
  rhd_idem := begin
    rintros ⟨a, ha⟩,
    simp only [spq_rhd_def, subtype.mk_eq_mk],
    apply power_quandle.rhd_idem,
  end,
  pow_one := begin
    rintros ⟨a, ha⟩,
    simp only [spq_pow_def, subtype.mk_eq_mk],
    apply power_quandle.pow_one,
  end,
  pow_zero := begin
    rintros ⟨a, ha⟩,
    simp only [spq_pow_def, spq_one_def, subtype.mk_eq_mk],
    apply power_quandle.pow_zero,
  end,
  pow_comp := begin
    rintros ⟨a, ha⟩ n m,
    simp only [spq_pow_def, subtype.mk_eq_mk],
    apply power_quandle.pow_comp,
  end,
  rhd_one := begin
    rintros ⟨a, ha⟩,
    simp only [spq_rhd_def, spq_one_def, subtype.mk_eq_mk],
    apply power_quandle.rhd_one,
  end,
  one_rhd := begin
    rintros ⟨a, ha⟩,
    simp only [spq_rhd_def, spq_one_def, subtype.mk_eq_mk],
    apply power_quandle.one_rhd,
  end,
  pow_rhd := begin
    rintros ⟨a, ha⟩ ⟨b, hb⟩ n,
    simp only [spq_rhd_def, spq_pow_def, subtype.mk_eq_mk],
    apply power_quandle.pow_rhd,
  end,
  rhd_pow_add := begin
    rintros ⟨a, ha⟩ ⟨b, hb⟩ n m,
    simp only [spq_rhd_def, spq_pow_def, subtype.mk_eq_mk],
    apply power_quandle.rhd_pow_add,
  end,
  ..sub_power_quandle_has_rhd,
  ..sub_power_quandle_has_pow,
  ..sub_power_quandle_has_one }

end sub_power_quandle

section sub_pq_le

variables {Q : Type u} [power_quandle Q]

instance sub_pq_has_le : has_le (sub_power_quandle Q) := ⟨λ Q1 Q2, Q1.carrier ⊆ Q2.carrier⟩

lemma sub_pq_le_def (Q1 Q2 : sub_power_quandle Q) : Q1 ≤ Q2 ↔ Q1.carrier ⊆ Q2.carrier := by refl

end sub_pq_le

section sub_pq_univ

def sub_pq_univ (Q : Type u) [power_quandle Q] : sub_power_quandle Q := {
  carrier := set.univ,
  closed_rhd := begin
    intros, exact dec_trivial,
  end,
  closed_pow := begin
    intros, exact dec_trivial,
  end,
  closed_one := begin
    intros, exact dec_trivial,
  end }

variables {Q : Type u} [power_quandle Q]

def sub_pq_univ_iso_pq : sub_pq_univ Q ≃ Q :=
begin
  fconstructor,
  {
    intro x,
    cases x with x hx,
    exact x,
  },
  {
    intro x,
    fconstructor,
    exact x,
    fconstructor,
  },
  {
    intro x,
    cases x,
    refl,
  },
  {
    intro x,
    refl,
  },
end

lemma sub_pq_univ_iso_pq_is_pq_morphism : is_pq_morphism (@sub_pq_univ_iso_pq Q _) :=
begin
  split,
  {
    intros a b,
    cases a,
    cases b,
    refl,
  },
  {
    intros a n,
    cases a,
    refl,
  },
end

lemma sub_pq_univ_le (Q1 : sub_power_quandle Q) : Q1 ≤ sub_pq_univ Q :=
begin
  rw sub_pq_le_def,
  tauto,
end

end sub_pq_univ


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.pnat.basic
import data.finset.intervals

namespace pnat

/-- `Ico l u` is the set of positive natural numbers `l ≤ k < u`. -/
def Ico (l u : ℕ+) : finset ℕ+ :=
(finset.Ico l u).attach.map
  { to_fun := λ n, ⟨(n : ℕ), lt_of_lt_of_le l.2 (finset.Ico.mem.1 n.2).1⟩,
    -- why can't we do this directly?
    inj' := λ n m h, subtype.eq (by { replace h := congr_arg subtype.val h, exact h }) }

@[simp] lemma Ico.mem : ∀ {n m l : ℕ+}, l ∈ Ico n m ↔ n ≤ l ∧ l < m :=
by { rintro ⟨n, hn⟩ ⟨m, hm⟩ ⟨l, hl⟩, simp [pnat.Ico] }

@[simp] lemma Ico.card (l u : ℕ+) : (Ico l u).card = u - l := by simp [pnat.Ico]

end pnat


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.normed_space.multilinear

/-!
# Formal multilinear series

In this file we define `formal_multilinear_series 𝕜 E F` to be a family of `n`-multilinear maps for
all `n`, designed to model the sequence of derivatives of a function. In other files we use this
notion to define `C^n` functions (called `times_cont_diff` in `mathlib`) and analytic functions.

## Notations

We use the notation `E [×n]→L[𝕜] F` for the space of continuous multilinear maps on `E^n` with
values in `F`. This is the space in which the `n`-th derivative of a function from `E` to `F` lives.

## Tags

multilinear, formal series
-/

noncomputable theory

open set fin
open_locale topological_space

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{G : Type*} [normed_group G] [normed_space 𝕜 G]

/-- A formal multilinear series over a field `𝕜`, from `E` to `F`, is given by a family of
multilinear maps from `E^n` to `F` for all `n`. -/
@[derive add_comm_group]
def formal_multilinear_series
  (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
  (E : Type*) [normed_group E] [normed_space 𝕜 E]
  (F : Type*) [normed_group F] [normed_space 𝕜 F] :=
Π (n : ℕ), (E [×n]→L[𝕜] F)

instance : inhabited (formal_multilinear_series 𝕜 E F) := ⟨0⟩

section module
/- `derive` is not able to find the module structure, probably because Lean is confused by the
dependent types. We register it explicitly. -/
local attribute [reducible] formal_multilinear_series

instance : module 𝕜 (formal_multilinear_series 𝕜 E F) :=
begin
  letI : ∀ n, module 𝕜 (continuous_multilinear_map 𝕜 (λ (i : fin n), E) F) :=
    λ n, by apply_instance,
  apply_instance
end

end module

namespace formal_multilinear_series

variables (p : formal_multilinear_series 𝕜 E F)

/-- Forgetting the zeroth term in a formal multilinear series, and interpreting the following terms
as multilinear maps into `E →L[𝕜] F`. If `p` corresponds to the Taylor series of a function, then
`p.shift` is the Taylor series of the derivative of the function. -/
def shift : formal_multilinear_series 𝕜 E (E →L[𝕜] F) :=
λn, (p n.succ).curry_right

/-- Adding a zeroth term to a formal multilinear series taking values in `E →L[𝕜] F`. This
corresponds to starting from a Taylor series for the derivative of a function, and building a Taylor
series for the function itself. -/
def unshift (q : formal_multilinear_series 𝕜 E (E →L[𝕜] F)) (z : F) :
  formal_multilinear_series 𝕜 E F
| 0       := (continuous_multilinear_curry_fin0 𝕜 E F).symm z
| (n + 1) := continuous_multilinear_curry_right_equiv' 𝕜 n E F (q n)

/-- Killing the zeroth coefficient in a formal multilinear series -/
def remove_zero (p : formal_multilinear_series 𝕜 E F) : formal_multilinear_series 𝕜 E F
| 0       := 0
| (n + 1) := p (n + 1)

@[simp] lemma remove_zero_coeff_zero : p.remove_zero 0 = 0 := rfl

@[simp] lemma remove_zero_coeff_succ (n : ℕ) : p.remove_zero (n+1) = p (n+1) := rfl

lemma remove_zero_of_pos {n : ℕ} (h : 0 < n) : p.remove_zero n = p n :=
by { rw ← nat.succ_pred_eq_of_pos h, refl }

/-- Convenience congruence lemma stating in a dependent setting that, if the arguments to a formal
multilinear series are equal, then the values are also equal. -/
lemma congr (p : formal_multilinear_series 𝕜 E F) {m n : ℕ} {v : fin m → E} {w : fin n → E}
  (h1 : m = n) (h2 : ∀ (i : ℕ) (him : i < m) (hin : i < n), v ⟨i, him⟩ = w ⟨i, hin⟩) :
  p m v = p n w :=
by { cases h1, congr' with ⟨i, hi⟩, exact h2 i hi hi }

/-- Composing each term `pₙ` in a formal multilinear series with `(u, ..., u)` where `u` is a fixed
continuous linear map, gives a new formal multilinear series `p.comp_continuous_linear_map u`. -/
def comp_continuous_linear_map (p : formal_multilinear_series 𝕜 F G) (u : E →L[𝕜] F) :
  formal_multilinear_series 𝕜 E G :=
λ n, (p n).comp_continuous_linear_map (λ (i : fin n), u)

@[simp] lemma comp_continuous_linear_map_apply
  (p : formal_multilinear_series 𝕜 F G) (u : E →L[𝕜] F) (n : ℕ) (v : fin n → E) :
  (p.comp_continuous_linear_map u) n v = p n (u ∘ v) := rfl

variables (𝕜) {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜']
variables [normed_space 𝕜' E] [is_scalar_tower 𝕜 𝕜' E]
variables [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F]

/-- Reinterpret a formal `𝕜'`-multilinear series as a formal `𝕜`-multilinear series, where `𝕜'` is a
normed algebra over `𝕜`. -/
@[simp] protected def restrict_scalars (p : formal_multilinear_series 𝕜' E F) :
  formal_multilinear_series 𝕜 E F :=
λ n, (p n).restrict_scalars 𝕜

end formal_multilinear_series


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import number_theory.bernoulli_polynomials
import dirichlet_character.basic
import general_bernoulli_number.bernoulli_polynomial_mul

/-!
# General Bernoulli Numbers

This file defines the generalized Bernoulli numbers related to Dirichlet characters
and gives its properties.

## Main definitions
 * `general_bernoulli_number`

## Implementation notes
TODO (optional)

## References
Introduction to Cyclotomic Fields, Washington (Chapter 12, Section 2)

## Tags
p-adic, L-function, Bernoulli measure, Dirichlet character
-/

variables {S : Type*} [comm_semiring S] [algebra ℚ S] {n : ℕ} (ψ : dirichlet_character S n)
open dirichlet_character
open_locale big_operators

/-- The generalized Bernoulli number
  `B_{m, ψ} = f^{m - 1} * ∑_{a = 0}^{f - 1} ψ(a) * B_m(a+1/f)`,
  where `f` is the conductor of the Dirichlet character `ψ`. -/
noncomputable def general_bernoulli_number (m : ℕ) : S :=
  (algebra_map ℚ S ((ψ.conductor)^(m - 1 : ℤ))) * (∑ a in finset.range ψ.conductor,
  asso_dirichlet_character (asso_primitive_character ψ) a.succ * algebra_map ℚ S
  ((polynomial.bernoulli m).eval (a.succ / ψ.conductor : ℚ)))
-- def is ind of F

namespace general_bernoulli_number

lemma general_bernoulli_number_def (m : ℕ) : general_bernoulli_number ψ m =
  (algebra_map ℚ S ((ψ.conductor)^(m - 1 : ℤ))) * (∑ a in finset.range ψ.conductor,
  asso_dirichlet_character (asso_primitive_character ψ) a.succ *
  algebra_map ℚ S ((polynomial.bernoulli m).eval (a.succ / ψ.conductor : ℚ))) := rfl

/-- B_{n,1} = B_n, where 1 is the trivial Dirichlet character of level 1. -/
lemma general_bernoulli_number_one_eval {n : ℕ} :
  general_bernoulli_number (1 : dirichlet_character S 1) n = algebra_map ℚ S (bernoulli' n) :=
begin
  rw general_bernoulli_number_def, simp_rw [conductor.one nat.one_pos],
  simp only [one_pow, one_mul, nat.cast_zero, polynomial.bernoulli_eval_one,
    nat.cast_one, div_one, finset.sum_singleton, finset.range_one, monoid_hom.coe_mk],
  rw extend_eq_char _ is_unit_one,
  rw asso_primitive_character_one nat.one_pos,
  convert one_mul _,
  { simp only [one_zpow, ring_hom.map_one], },
  { convert (one_mul _).symm, },
end

lemma general_bernoulli_number_one_eval_one :
general_bernoulli_number (1 : dirichlet_character S 1) 1 = algebra_map ℚ S (1/2 : ℚ) :=
begin
  rw general_bernoulli_number_def, simp_rw [conductor.one nat.one_pos],
  simp only [one_div, one_pow, one_mul, bernoulli'_one, nat.cast_zero,
    polynomial.bernoulli_eval_one, nat.cast_one, div_one, finset.sum_singleton,
    finset.range_one, monoid_hom.coe_mk],
  rw extend_eq_char _ is_unit_one,
  rw asso_primitive_character_one nat.one_pos,
  convert one_mul _,
  { simp only [one_zpow, ring_hom.map_one], },
  { convert (one_mul _).symm, },
end
--revise proof using above lemma

/-- `∑_{a = 0}^{m*n - 1} f a = ∑_{i = 0}^{n - 1} (∑_{a = m*i}^{m*(i + 1)} fa)`. -/
lemma finset.sum_range_mul_eq_sum_Ico {m n : ℕ} (f : ℕ → S) :
  ∑ a in finset.range (m * n), f a =
  ∑ i in finset.range n, (∑ a in finset.Ico (m * i) (m * i.succ), f a) :=
begin
  induction n with d hd,
  { simp only [finset.sum_empty, finset.range_zero, mul_zero], },
  { rw [finset.sum_range_succ, ←hd], rw [finset.range_eq_Ico,
      finset.sum_Ico_consecutive _ (nat.zero_le _) (mul_le_mul (le_refl _) (nat.le_succ _)
      (nat.zero_le _) (nat.zero_le _))], },
end

/-- Showing that the definition of general_bernoulli_number is independent of F,
  where F is a multiple of the conductor. -/
lemma eq_sum_bernoulli_of_conductor_dvd {F : ℕ} [hF : fact (0 < F)] (m : ℕ) (h : ψ.conductor ∣ F) :
  general_bernoulli_number ψ m = (algebra_map ℚ S) (F^(m - 1 : ℤ)) *
  (∑ a in finset.range F, asso_dirichlet_character ψ.asso_primitive_character a.succ *
    algebra_map ℚ S ((polynomial.bernoulli m).eval (a.succ / F : ℚ))) :=
begin
  cases h with k h, rw h,
  rw finset.sum_range_mul_eq_sum_Ico,
  simp_rw [finset.sum_Ico_eq_sum_range],
  simp_rw [←nat.mul_sub_left_distrib],
  simp_rw [norm_num.sub_nat_pos (nat.succ _) _ 1 rfl],
  simp_rw [mul_one],
  rw general_bernoulli_number_def,
  have hF : F ≠ 0 := ne_of_gt (fact_iff.1 hF),
  have hk1 : k ≠ 0,
  { intro h1, apply hF, rw [h, h1, mul_zero], },
  have hk2 : (k : ℚ) ≠ 0, { norm_cast, apply hk1, },
  conv_lhs { congr, skip, apply_congr, skip,
    rw [←mul_div_mul_left _ _ hk2, ←mul_div_assoc', polynomial.bernoulli_eval_mul' _ hk1,
    (algebra_map _ _).map_mul, (algebra_map _ _).map_sum, ←mul_assoc,
    mul_comm ((asso_dirichlet_character ψ.asso_primitive_character) ↑(x.succ)) _, mul_assoc,
    finset.mul_sum], },
  rw [←finset.mul_sum, ←mul_assoc],
  apply congr_arg2,
  { rw [nat.cast_mul, mul_zpow, ring_hom.map_mul], },
  { rw finset.sum_comm,
    apply finset.sum_congr rfl (λ i hi, _),
    apply finset.sum_congr rfl (λ j hj, _),
    apply congr_arg2,
    { apply congr_arg, rw ←nat.add_succ,
      simp only [zero_mul, nat.cast_add, zmod.nat_cast_self, zero_add, nat.cast_mul], },
    { apply congr_arg, congr,
      rw ←nat.add_succ, rw nat.cast_add,
      rw add_div, rw add_comm, rw mul_comm,
      repeat { rw nat.cast_mul, },
      rw mul_div_mul_left _ _ _,
      norm_cast, intro h1, apply hF, rw [h, h1, zero_mul], }, },
end

end general_bernoulli_number


import Init.Data.List

section MergeSort
  universe u
  variable
    {A : Type u}
    (f : A -> A -> Bool)

  def splitList : Nat -> List A -> List A × List A :=
    fun n xs => (List.take n xs, List.drop n xs)

  theorem take_decreasing :
    forall (xs : List A) (n : Nat),
    n < List.length xs ->
    sizeOf (List.take n xs) < sizeOf xs := by
    intro xs
    induction xs with
    | nil =>
      focus
        intros n Ha
        contradiction
    | cons xh xhs ih =>
      focus
        intros n Ha
        cases n with
        | zero =>
          focus
            unfold List.take
            simp
            simp at Ha
            sorry

        | succ n' =>
          focus
            unfold List.take
            simp
            simp at Ha
            sorry

    theorem drop_decreasing :
      forall (xs : List A) (n : Nat),
      0 < n ->
      0 < List.length xs ->
      sizeOf (List.drop n xs) < sizeOf xs := by
      intro xs
      induction xs with
      | nil =>
        focus
          intros n Ha Hb
          contradiction
      | cons xh xhs ih =>
        focus
          intros n Ha Hb
          cases n with
          | zero =>
            focus
              contradiction
          | succ n' =>
            focus
              cases xhs with
              | nil =>
                sorry
              | cons yh yhs =>
                sorry
                /-
                  requires transitivy of <
                  I don't know how to
                  simplify
                -/

  theorem splitList_decreasing :
    ∀ (n : Nat) (xs xsh ysh : List A),
      0 < n ->
      n < (List.length xs) ->
      0 < List.length xs ->
      (xsh, ysh) = splitList n xs ->
      sizeOf xsh < sizeOf xs ∧
      sizeOf ysh < sizeOf xs := by
    intros n xs xsh ysh Ha Hb Hc Hd
    unfold splitList at Hd
    sorry

  def splitHalf : List A -> List A × List A :=
    fun xs => splitList (Nat.div (xs.length) 2) xs

  def mergeList : List A  -> List A -> List A
  | [], ys => ys
  | xs, [] => xs
  | (xh :: xhs), (yh :: yhs) =>
    match f xh yh with
    | true => xh :: mergeList xhs (yh :: yhs)
    | false => yh :: mergeList (xh :: xhs) yhs
  termination_by mergeList xs ys => (xs, ys)

  def mergeSort : List A -> List A
  | [] => []
  | [x] => [x]
  | (x₁ :: x₂ :: xs) =>
    match splitHalf (x₁ :: x₂ :: xs) with
    | (xsh, ysh) =>
        have : sizeOf xsh < sizeOf (x₁ :: x₂ :: xs) := by
          sorry
        have : sizeOf ysh < sizeOf (x₁ :: x₂ :: xs) := by
          sorry
        mergeList f (mergeSort xsh) (mergeSort ysh)

  def go : A -> List A -> List A × List A
  | _, [] => ([], [])
  | z, (x :: xs) =>
    match go z xs with
    | (ys, zs) =>
      match f x z with
      | true => (x :: ys, zs)
      | _ => (ys, x :: zs)

  theorem go_decreasing :
    ∀ (xs : List A) (z : A),
    ¬(xs = [])  ->
    match go f z xs with
    | (ys, zs) => sizeOf zs < sizeOf xs := by
    intro xs
    induction xs with
    | nil =>
      intros z Ha
      contradiction
    | cons x xs ih =>
      intros z Ha
      unfold go
      simp
      cases (f x z) with
      | true =>
        simp
        cases xs with
        | nil =>
          unfold go
          simp
        | cons xt xsh =>
          unfold go
          simp
          sorry
      | false => sorry

  def groupBy : List A -> List (List A)
  | [] => []
  | (x :: xs) =>
    match go f x (x :: xs) with
    | (ys, zs) =>
      have : sizeOf zs < sizeOf (x :: xs) := by sorry
      ys :: groupBy zs

end MergeSort

#eval groupBy (fun x y => x == y) [1, 1, 3, 4, 5]
#eval mergeSort (fun x y => x <= y)  [100, 200, 3, -1, 9, 8, 10, 1]
#eval mergeList (fun x y => x <= y) [8, 9, 10] [1, 2, 3]


inductive Vec.{u} (α : Type u) : Nat → Type u
| nil  : Vec α 0
| cons : α → {n : Nat} → Vec α n → Vec α (n+1)

open Vec
universe u

variable {α : Type u}
variable (f : α → α → α)

def mapHead1 : {n : Nat} → Vec α n → Vec α n → Vec α n
| _, nil, nil => nil
| _, cons a va, cons b bv => cons (f a b) va

theorem ex1 : mapHead1 f nil nil = nil :=
rfl

theorem ex2 (a b : α) (n : Nat) (va vb : Vec α n) : mapHead1 f (cons a va) (cons b vb) = cons (f a b) va :=
rfl