/-
Copyright (c) 2022 Alex J. Best, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best, Yaël Dillies
-/
import algebra.order.archimedean
import algebra.order.hom.monoid
import algebra.order.ring
import algebra.ring.equiv

/-!
# Ordered ring homomorphisms

Homomorphisms between ordered (semi)rings that respect the ordering.

## Main definitions

* `order_ring_hom` : Monotone semiring homomorphisms.
* `order_ring_iso` : Monotone semiring isomorphisms.

## Notation

* `→+*o`: Ordered ring homomorphisms.
* `≃+*o`: Ordered ring isomorphisms.

## Tags

ordered ring homomorphism, order homomorphism
-/

open function

variables {F α β γ δ : Type*}

/-- `order_ring_hom α β` is the type of monotone semiring homomorphisms from `α` to `β`.

When possible, instead of parametrizing results over `(f : order_ring_hom α β)`,
you should parametrize over `(F : Type*) [order_ring_hom_class F α β] (f : F)`.

When you extend this structure, make sure to extend `order_ring_hom_class`. -/
structure order_ring_hom (α β : Type*) [non_assoc_semiring α] [preorder α] [non_assoc_semiring β]
  [preorder β]
  extends α →+* β :=
(monotone' : monotone to_fun)

/-- Reinterpret an ordered ring homomorphism as a ring homomorphism. -/
add_decl_doc order_ring_hom.to_ring_hom

infix ` →+*o `:25 := order_ring_hom

/-- `order_ring_hom α β` is the type of order-preserving semiring isomorphisms between `α` and `β`.

When possible, instead of parametrizing results over `(f : order_ring_iso α β)`,
you should parametrize over `(F : Type*) [order_ring_iso_class F α β] (f : F)`.

When you extend this structure, make sure to extend `order_ring_iso_class`. -/
structure order_ring_iso (α β : Type*) [has_mul α] [has_add α] [has_le α] [has_mul β] [has_add β]
  [has_le β] extends α ≃+* β :=
(map_le_map_iff' {a b : α} : to_fun a ≤ to_fun b ↔ a ≤ b)

infix ` ≃+*o `:25 := order_ring_iso

/-- `order_ring_hom_class F α β` states that `F` is a type of ordered semiring homomorphisms.
You should extend this typeclass when you extend `order_ring_hom`. -/
class order_ring_hom_class (F : Type*) (α β : out_param $ Type*) [non_assoc_semiring α] [preorder α]
  [non_assoc_semiring β] [preorder β] extends ring_hom_class F α β :=
(monotone (f : F) : monotone f)

/-- `order_ring_iso_class F α β` states that `F` is a type of ordered semiring isomorphisms.
You should extend this class when you extend `order_ring_iso`. -/
class order_ring_iso_class (F : Type*) (α β : out_param Type*) [has_mul α] [has_add α] [has_le α]
  [has_mul β] [has_add β] [has_le β]
  extends ring_equiv_class F α β :=
(map_le_map_iff (f : F) {a b : α} : f a ≤ f b ↔ a ≤ b)

@[priority 100] -- See note [lower priority instance]
instance order_ring_hom_class.to_order_add_monoid_hom_class [non_assoc_semiring α] [preorder α]
  [non_assoc_semiring β] [preorder β] [order_ring_hom_class F α β] :
  order_add_monoid_hom_class F α β :=
{ .. ‹order_ring_hom_class F α β› }

@[priority 100] -- See note [lower priority instance]
instance order_ring_hom_class.to_order_monoid_with_zero_hom_class [non_assoc_semiring α]
  [preorder α] [non_assoc_semiring β] [preorder β] [order_ring_hom_class F α β] :
  order_monoid_with_zero_hom_class F α β :=
{ .. ‹order_ring_hom_class F α β› }

@[priority 100] -- See note [lower instance priority]
instance order_ring_iso_class.to_order_iso_class [has_mul α] [has_add α] [has_le α] [has_mul β]
  [has_add β] [has_le β] [order_ring_iso_class F α β] :
  order_iso_class F α β :=
{ ..‹order_ring_iso_class F α β› }

@[priority 100] -- See note [lower instance priority]
instance order_ring_iso_class.to_order_ring_hom_class [non_assoc_semiring α] [preorder α]
  [non_assoc_semiring β] [preorder β] [order_ring_iso_class F α β] :
  order_ring_hom_class F α β :=
{ monotone := λ f, order_hom_class.mono f, ..‹order_ring_iso_class F α β› }

instance [non_assoc_semiring α] [preorder α] [non_assoc_semiring β] [preorder β]
  [order_ring_hom_class F α β] :
  has_coe_t F (α →+*o β) :=
⟨λ f, ⟨f, order_hom_class.mono f⟩⟩

instance [has_mul α] [has_add α] [has_le α] [has_mul β] [has_add β] [has_le β]
  [order_ring_iso_class F α β] :
  has_coe_t F (α ≃+*o β) :=
⟨λ f, ⟨f, λ a b, map_le_map_iff f⟩⟩

/-! ### Ordered ring homomorphisms -/

namespace order_ring_hom
variables [non_assoc_semiring α] [preorder α]

section preorder
variables [non_assoc_semiring β] [preorder β] [non_assoc_semiring γ] [preorder γ]
  [non_assoc_semiring δ] [preorder δ]

/-- Reinterpret an ordered ring homomorphism as an ordered additive monoid homomorphism. -/
def to_order_add_monoid_hom (f : α →+*o β) : α →+o β := { ..f }

/-- Reinterpret an ordered ring homomorphism as an order homomorphism. -/
def to_order_monoid_with_zero_hom (f : α →+*o β) : α →*₀o β := { ..f }

instance : order_ring_hom_class (α →+*o β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by obtain ⟨⟨_, _⟩, _⟩ := f; obtain ⟨⟨_, _⟩, _⟩ := g; congr',
  map_mul := λ f, f.map_mul',
  map_one := λ f, f.map_one',
  map_add := λ f, f.map_add',
  map_zero := λ f, f.map_zero',
  monotone := λ f, f.monotone' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (α →+*o β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

lemma to_fun_eq_coe (f : α →+*o β) : f.to_fun = ⇑f := rfl
@[ext] lemma ext {f g : α →+*o β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

@[simp] lemma to_ring_hom_eq_coe (f : α →+*o β) : f.to_ring_hom = f := ring_hom.ext $ λ _, rfl
@[simp] lemma to_order_add_monoid_hom_eq_coe (f : α →+*o β) : f.to_order_add_monoid_hom = f := rfl
@[simp] lemma to_order_monoid_with_zero_hom_eq_coe (f : α →+*o β) :
  f.to_order_monoid_with_zero_hom = f := rfl

@[simp] lemma coe_coe_ring_hom (f : α →+*o β) : ⇑(f : α →+* β) = f := rfl
@[simp] lemma coe_coe_order_add_monoid_hom (f : α →+*o β) : ⇑(f : α →+o β) = f := rfl
@[simp] lemma coe_coe_order_monoid_with_zero_hom (f : α →+*o β) : ⇑(f : α →*₀o β) = f := rfl

@[norm_cast] lemma coe_ring_hom_apply (f : α →+*o β) (a : α) : (f : α →+* β) a = f a := rfl
@[norm_cast] lemma coe_order_add_monoid_hom_apply (f : α →+*o β) (a : α) : (f : α →+o β) a = f a :=
rfl
@[norm_cast] lemma coe_order_monoid_with_zero_hom_apply (f : α →+*o β) (a : α) :
  (f : α →*₀o β) a = f a := rfl

/-- Copy of a `order_ring_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : α →+*o β) (f' : α → β) (h : f' = f) : α →+*o β :=
{ .. f.to_ring_hom.copy f' h, .. f.to_order_add_monoid_hom.copy f' h }

variable (α)

/-- The identity as an ordered ring homomorphism. -/
protected def id : α →+*o α := { ..ring_hom.id _, ..order_hom.id }

instance : inhabited (α →+*o α) := ⟨order_ring_hom.id α⟩

@[simp] lemma coe_id : ⇑(order_ring_hom.id α) = id := rfl

variable {α}

@[simp] lemma id_apply (a : α) : order_ring_hom.id α a = a := rfl

@[simp] lemma coe_ring_hom_id : (order_ring_hom.id α : α →+* α) = ring_hom.id α := rfl
@[simp] lemma coe_order_add_monoid_hom_id :
  (order_ring_hom.id α : α →+o α) = order_add_monoid_hom.id α := rfl
@[simp] lemma coe_order_monoid_with_zero_hom_id :
  (order_ring_hom.id α : α →*₀o α) = order_monoid_with_zero_hom.id α := rfl

/-- Composition of two `order_ring_hom`s as an `order_ring_hom`. -/
protected def comp (f : β →+*o γ) (g : α →+*o β) : α →+*o γ :=
{ ..f.to_ring_hom.comp g.to_ring_hom, ..f.to_order_add_monoid_hom.comp g.to_order_add_monoid_hom }

@[simp] lemma coe_comp (f : β →+*o γ) (g : α →+*o β) : ⇑(f.comp g) = f ∘ g := rfl
@[simp]

lemma cancel_right {f₁ f₂ : β →+*o γ} {g : α →+*o β} (hg : surjective g) :
  f₁.comp g = f₂.comp g ↔ f₁ = f₂ :=
⟨λ h, ext $ hg.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {f : β →+*o γ} {g₁ g₂ : α →+*o β} (hf : injective f) :
  f.comp g₁ = f.comp g₂ ↔ g₁ = g₂ :=
⟨λ h, ext $ λ a, hf $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩

end preorder

variables [non_assoc_semiring β]

instance [preorder β] : preorder (order_ring_hom α β) := preorder.lift (coe_fn : _ → α → β)

instance [partial_order β] : partial_order (order_ring_hom α β) :=
partial_order.lift _ fun_like.coe_injective

end order_ring_hom

/-! ### Ordered ring isomorphisms -/

namespace order_ring_iso
section has_le
variables [has_mul α] [has_add α] [has_le α] [has_mul β] [has_add β] [has_le β] [has_mul γ]
  [has_add γ] [has_le γ] [has_mul δ] [has_add δ] [has_le δ]

/-- Reinterpret an ordered ring isomorphism as an order isomorphism. -/
def to_order_iso (f : α ≃+*o β) : α ≃o β := ⟨f.to_ring_equiv.to_equiv, f.map_le_map_iff'⟩

instance : order_ring_iso_class (α ≃+*o β) α β :=
{ coe := λ f, f.to_fun,
  inv := λ f, f.inv_fun,
  coe_injective' := λ f g h₁ h₂, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_add := λ f, f.map_add',
  map_mul := λ f, f.map_mul',
  map_le_map_iff := λ f, f.map_le_map_iff',
  left_inv := λ f, f.left_inv,
  right_inv := λ f, f.right_inv }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (α ≃+*o β) (λ _, α → β) := fun_like.has_coe_to_fun

lemma to_fun_eq_coe (f : α ≃+*o β) : f.to_fun = f := rfl

@[ext] lemma ext {f g : α ≃+*o β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

@[simp] lemma coe_mk (e : α ≃+* β) (h) : ⇑(⟨e, h⟩ : α ≃+*o β) = e := rfl
@[simp] lemma mk_coe (e : α ≃+*o β) (h) : (⟨e, h⟩ : α ≃+*o β) = e := ext $ λ _, rfl

@[simp] lemma to_ring_equiv_eq_coe (f : α ≃+*o β) : f.to_ring_equiv = f := ring_equiv.ext $ λ _, rfl
@[simp] lemma to_order_iso_eq_coe (f : α ≃+*o β) : f.to_order_iso = f := order_iso.ext rfl

@[simp, norm_cast] lemma coe_to_ring_equiv (f : α ≃+*o β) : ⇑(f : α ≃+* β) = f := rfl
@[simp, norm_cast] lemma coe_to_order_iso (f : α ≃+*o β) : ⇑(f : α ≃o β) = f := rfl

variable (α)

/-- The identity map as an ordered ring isomorphism. -/
@[refl] protected def refl : α ≃+*o α := ⟨ring_equiv.refl α, λ _ _, iff.rfl⟩

instance : inhabited (α ≃+*o α) := ⟨order_ring_iso.refl α⟩

@[simp] lemma refl_apply (x : α) : order_ring_iso.refl α x = x := rfl
@[simp] lemma coe_ring_equiv_refl : (order_ring_iso.refl α : α ≃+* α) = ring_equiv.refl α := rfl
@[simp] lemma coe_order_iso_refl : (order_ring_iso.refl α : α ≃o α) = order_iso.refl α := rfl

variables {α}

/-- The inverse of an ordered ring isomorphism as an ordered ring isomorphism. -/
@[symm] protected def symm (e : α ≃+*o β) : β ≃+*o α :=
⟨e.to_ring_equiv.symm,
  λ a b, by erw [←map_le_map_iff e, e.1.apply_symm_apply, e.1.apply_symm_apply]⟩

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : α ≃+*o β) : β → α := e.symm

@[simp] lemma symm_symm (e : α ≃+*o β) : e.symm.symm = e := ext $ λ _, rfl

/-- Composition of `order_ring_iso`s as an `order_ring_iso`. -/
@[trans, simps] protected def trans (f : α ≃+*o β) (g : β ≃+*o γ) : α ≃+*o γ :=
⟨f.to_ring_equiv.trans g.to_ring_equiv, λ a b, (map_le_map_iff g).trans (map_le_map_iff f)⟩

@[simp] lemma trans_apply (f : α ≃+*o β) (g : β ≃+*o γ) (a : α) : f.trans g a = g (f a) := rfl

@[simp] lemma self_trans_symm (e : α ≃+*o β) : e.trans e.symm = order_ring_iso.refl α :=
ext e.left_inv
@[simp] lemma symm_trans_self (e : α ≃+*o β) : e.symm.trans e = order_ring_iso.refl β :=
ext e.right_inv

lemma symm_bijective : bijective (order_ring_iso.symm : (α ≃+*o β) → β ≃+*o α) :=
⟨λ f g h, f.symm_symm.symm.trans $ (congr_arg order_ring_iso.symm h).trans g.symm_symm,
  λ f, ⟨f.symm, f.symm_symm⟩⟩

end has_le

section non_assoc_semiring
variables [non_assoc_semiring α] [preorder α] [non_assoc_semiring β] [preorder β]
  [non_assoc_semiring γ] [preorder γ]

/-- Reinterpret an ordered ring isomorphism as an ordered ring homomorphism. -/
def to_order_ring_hom (f : α ≃+*o β) : α →+*o β :=
⟨f.to_ring_equiv.to_ring_hom, λ a b, (map_le_map_iff f).2⟩

@[simp] lemma to_order_ring_hom_eq_coe (f : α ≃+*o β) : f.to_order_ring_hom = f := rfl

@[simp, norm_cast] lemma coe_to_order_ring_hom (f : α ≃+*o β) : ⇑(f : α →+*o β) = f := rfl

@[simp]
lemma coe_to_order_ring_hom_refl : (order_ring_iso.refl α : α →+*o α) = order_ring_hom.id α := rfl

lemma to_order_ring_hom_injective : injective (to_order_ring_hom : (α ≃+*o β) → α →+*o β) :=
λ f g h, fun_like.coe_injective $ by convert fun_like.ext'_iff.1 h

end non_assoc_semiring
end order_ring_iso

/-!
### Uniqueness

There is at most one ordered ring homomorphism from a linear ordered field to an archimedean linear
ordered field. Reciprocally, such an ordered ring homomorphism exists when the codomain is further
conditionally complete.
-/

/-- There is at most one ordered ring homomorphism from a linear ordered field to an archimedean
linear ordered field. -/
-- TODO[gh-6025]: make this an instance once safe to do so
lemma order_ring_hom.subsingleton [linear_ordered_field α] [linear_ordered_field β]
  [archimedean β] :
  subsingleton (α →+*o β) :=
⟨λ f g, begin
  ext x,
  by_contra' h,
  wlog h : f x < g x using [f g, g f],
  { exact ne.lt_or_lt h },
  obtain ⟨q, hf, hg⟩ := exists_rat_btwn h,
  rw ←map_rat_cast f at hf,
  rw ←map_rat_cast g at hg,
  exact (lt_asymm ((order_hom_class.mono g).reflect_lt hg) $
    (order_hom_class.mono f).reflect_lt hf).elim,
end⟩

local attribute [instance] order_ring_hom.subsingleton

/-- There is at most one ordered ring isomorphism between a linear ordered field and an archimedean
linear ordered field. -/
-- TODO[gh-6025]: make this an instance once safe to do so
lemma order_ring_iso.subsingleton_right [linear_ordered_field α] [linear_ordered_field β]
  [archimedean β] :
  subsingleton (α ≃+*o β) :=
order_ring_iso.to_order_ring_hom_injective.subsingleton

local attribute [instance] order_ring_iso.subsingleton_right

/-- There is at most one ordered ring isomorphism between an archimedean linear ordered field and a
linear ordered field. -/
-- TODO[gh-6025]: make this an instance once safe to do so
lemma order_ring_iso.subsingleton_left [linear_ordered_field α] [archimedean α]
  [linear_ordered_field β] :
  subsingleton (α ≃+*o β) :=
order_ring_iso.symm_bijective.injective.subsingleton


import extra.number_theory.pos_rat_primes

/-! # IMO 2010 A5 -/

namespace IMOSL
namespace IMO2010A5

def good' {G : Type*} [add_monoid G] (f : G → G) :=
  ∀ x y : G, f (2 • f x + y) = 3 • x + f (x + y)

def good {G : Type*} [monoid G] (f : G → G) :=
  ∀ x y : G, f (f x ^ 2 * y) = x ^ 3 * f (x * y)

private lemma neg_is_good' {G : Type*} [add_comm_group G] : good' (has_neg.neg : G → G) :=
  λ x y, by rw [eq_add_neg_iff_add_eq, add_comm, ← sub_eq_add_neg,
    add_sub_add_right_eq_sub, smul_neg, sub_neg_eq_add, eq_comm, succ_nsmul]

private lemma good'_iff {G : Type*} [add_comm_group G] [no_zero_smul_divisors ℕ G] :
  ∀ f : G → G, good' f ↔ ∃ φ : G →+ G, f = φ ∧ ∀ x : G, 2 • φ (φ x) = 3 • x + φ x :=
begin
  ---- First, solve the `←` direction.
  intros f; symmetry; refine ⟨λ h x y, _, λ h, _⟩,
  rcases h with ⟨φ, rfl, h⟩; rw [map_add, map_add, ← add_assoc, ← h, map_nsmul],

  ---- Now solve the `→` direction
  -- First reduce to just `f` being additive.
  have h0 := λ x, h x 0,
  simp_rw add_zero at h0,
  suffices : ∀ x y, f (x + y) = f x + f y,
  { refine ⟨⟨f, _, this⟩, rfl, λ x, _⟩,
    replace this := this 0 0,
    rwa [add_zero, self_eq_add_left] at this,
    rw [add_monoid_hom.coe_mk, ← h0, two_nsmul, ← this, ← two_nsmul] },

  -- Reduce to showing that `f` is injective.
  revert h; suffices : function.injective f,
  { intros h x y,
    have h1 := h x (2 • f y),
    rw [← smul_add, add_comm x, h, ← add_assoc, ← smul_add, add_comm y, ← h0] at h1,
    replace h1 := this h1,
    rwa [smul_right_inj, eq_comm] at h1,
    exact two_ne_zero },

  -- Now show that `f` is injective.
  intros x y h,
  have h1 := h0 y,
  rwa [← h, h0, add_left_inj, smul_right_inj] at h1,
  exact three_ne_zero
end

/-- Final solution, additive version -/
theorem final_solution_additive {G : Type*} [add_comm_group G]
  {S : Type*} {ρ : G →+ S → ℤ} (h : function.injective ρ) :
  ∀ f : G → G, good' f ↔ f = has_neg.neg :=
begin
  ---- A characterization of zeroes in `G` using `ρ`
  refine λ f, ⟨λ h0, _, λ h0, by subst h0; exact neg_is_good'⟩,
  simp_rw [injective_iff_map_eq_zero', function.funext_iff, pi.zero_apply] at h,

  ---- Set up `no_zero_smul_divisors ℕ G` instance
  haveI _inst_2 : no_zero_smul_divisors ℕ G :=
  ⟨λ n x h1, begin
      rw [← h, or_iff_not_imp_left]; intros h2 s,
      rw ← h at h1; replace h1 := h1 s,
      rwa [map_nsmul, pi.smul_apply, smul_eq_zero, or_iff_right h2] at h1
  end⟩,

  ---- Setup for the final step of induction
  rw good'_iff at h0; rcases h0 with ⟨φ, rfl, h0⟩,
  obtain ⟨γ, rfl⟩ : ∃ γ : G →+ G, γ - add_monoid_hom.id G = φ :=
    ⟨φ + add_monoid_hom.id G, add_sub_cancel _ _⟩,
  simp_rw [add_monoid_hom.sub_apply, add_monoid_hom.id_apply, map_sub, nsmul_sub] at h0,
  replace h0 : ∀ x : G, 2 • γ (γ x) - 5 • γ x = 0 :=
    λ x, by replace h0 := h0 x; rwa [succ_nsmul' x 2, add_add_sub_cancel, add_comm, ← sub_add,
      add_left_inj, sub_sub, ← add_nsmul, sub_eq_iff_eq_add, ← succ_nsmul, ← sub_eq_zero] at h0,
  simp_rw [← h, map_sub, pi.sub_apply, sub_eq_zero, map_nsmul, pi.smul_apply,
    nsmul_eq_mul, nat.cast_bit1, nat.cast_bit0, nat.cast_one] at h0,
  simp_rw [function.funext_iff, add_monoid_hom.sub_apply,
    add_monoid_hom.id_apply, sub_eq_neg_self, ← h],
  clear h,

  suffices : ∀ (s : S) (k : ℕ) (x : G), 2 ^ k ∣ ρ (γ x) s,
  { intros x s; refine int.eq_zero_of_abs_lt_dvd (this s (ρ (γ x) s).nat_abs x) _,
    change |↑(ρ (γ x) s)| < ((2 : ℕ) : ℤ) ^ (ρ (γ x) s).nat_abs,
    rw [← nat.cast_pow, ← int.cast_nat_abs, nat.cast_lt],
    exact (ρ (γ x) s).nat_abs.lt_two_pow },

  ---- Induction
  intros s k; induction k with k h; intros x,
  rw pow_zero; exact one_dvd _,
  replace h := h (γ x); cases h with c h,
  replace h0 := h0 x s,
  generalize_hyp : ρ (γ (γ x)) s = A at h h0,
  subst h; generalize_hyp : ρ (γ x) s = A at h0 ⊢,
  rw [← mul_assoc, ← pow_succ] at h0,
  refine (is_coprime.pow_left ⟨(-2 : ℤ), 1, _⟩).dvd_of_dvd_mul_left ⟨c, h0.symm⟩,
  norm_num
end

/-- Final solution, multiplicative version -/
theorem final_solution_multiplicative {G : Type*} [comm_group G]
  {S : Type*} {ρ : additive G →+ S → ℤ} (h : function.injective ρ) :
  ∀ f : G → G, good f ↔ f = has_inv.inv :=
  final_solution_additive h

/-- Final solution, original (`ℚ+`) version -/
theorem final_solution_original :
  ∀ f : {q : ℚ // 0 < q} → {q : ℚ // 0 < q}, good f ↔ f = has_inv.inv :=
  final_solution_multiplicative extra.pos_rat_factor_hom.inj

end IMO2010A5
end IMOSL


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

Computational realization of filters (experimental).
-/
import order.filter
open set filter

/-- A `cfilter α σ` is a realization of a filter (base) on `α`,
  represented by a type `σ` together with operations for the top element and
  the binary inf operation. -/
structure cfilter (α σ : Type*) [partial_order α] :=
(f : σ → α)
(pt : σ)
(inf : σ → σ → σ)
(inf_le_left : ∀ a b : σ, f (inf a b) ≤ f a)
(inf_le_right : ∀ a b : σ, f (inf a b) ≤ f b)

variables {α : Type*} {β : Type*} {σ : Type*} {τ : Type*}

namespace cfilter
section
variables [partial_order α] (F : cfilter α σ)

instance : has_coe_to_fun (cfilter α σ) := ⟨_, cfilter.f⟩

@[simp] theorem coe_mk (f pt inf h₁ h₂ a) : (@cfilter.mk α σ _ f pt inf h₁ h₂) a = f a := rfl

/-- Map a cfilter to an equivalent representation type. -/
def of_equiv (E : σ ≃ τ) : cfilter α σ → cfilter α τ
| ⟨f, p, g, h₁, h₂⟩ :=
  { f            := λ a, f (E.symm a),
    pt           := E p,
    inf          := λ a b, E (g (E.symm a) (E.symm b)),
    inf_le_left  := λ a b, by simpa using h₁ (E.symm a) (E.symm b),
    inf_le_right := λ a b, by simpa using h₂ (E.symm a) (E.symm b) }

@[simp] theorem of_equiv_val (E : σ ≃ τ) (F : cfilter α σ) (a : τ) :
  F.of_equiv E a = F (E.symm a) := by cases F; refl

end

/-- The filter represented by a `cfilter` is the collection of supersets of
  elements of the filter base. -/
def to_filter (F : cfilter (set α) σ) : filter α :=
{ sets             := {a | ∃ b, F b ⊆ a},
  univ_sets        := ⟨F.pt, subset_univ _⟩,
  sets_of_superset := λ x y ⟨b, h⟩ s, ⟨b, subset.trans h s⟩,
  inter_sets       := λ x y ⟨a, h₁⟩ ⟨b, h₂⟩, ⟨F.inf a b,
    subset_inter (subset.trans (F.inf_le_left _ _) h₁) (subset.trans (F.inf_le_right _ _) h₂)⟩ }

@[simp] theorem mem_to_filter_sets (F : cfilter (set α) σ) {a : set α} :
  a ∈ F.to_filter ↔ ∃ b, F b ⊆ a := iff.rfl

end cfilter

/-- A realizer for filter `f` is a cfilter which generates `f`. -/
structure filter.realizer (f : filter α) :=
(σ : Type*)
(F : cfilter (set α) σ)
(eq : F.to_filter = f)

protected def cfilter.to_realizer (F : cfilter (set α) σ) : F.to_filter.realizer := ⟨σ, F, rfl⟩

namespace filter.realizer

theorem mem_sets {f : filter α} (F : f.realizer) {a : set α} : a ∈ f ↔ ∃ b, F.F b ⊆ a :=
by cases F; subst f; simp

-- Used because it has better definitional equalities than the eq.rec proof
def of_eq {f g : filter α} (e : f = g) (F : f.realizer) : g.realizer :=
⟨F.σ, F.F, F.eq.trans e⟩

/-- A filter realizes itself. -/
def of_filter (f : filter α) : f.realizer := ⟨f.sets,
{ f            := subtype.val,
  pt           := ⟨univ, univ_mem_sets⟩,
  inf          := λ ⟨x, h₁⟩ ⟨y, h₂⟩, ⟨_, inter_mem_sets h₁ h₂⟩,
  inf_le_left  := λ ⟨x, h₁⟩ ⟨y, h₂⟩, inter_subset_left x y,
  inf_le_right := λ ⟨x, h₁⟩ ⟨y, h₂⟩, inter_subset_right x y },
filter_eq $ set.ext $ λ x, set_coe.exists.trans exists_sets_subset_iff⟩

/-- Transfer a filter realizer to another realizer on a different base type. -/
def of_equiv {f : filter α} (F : f.realizer) (E : F.σ ≃ τ) : f.realizer :=
⟨τ, F.F.of_equiv E, by refine eq.trans _ F.eq; exact filter_eq (set.ext $ λ x,
⟨λ ⟨s, h⟩, ⟨E.symm s, by simpa using h⟩, λ ⟨t, h⟩, ⟨E t, by simp [h]⟩⟩)⟩

@[simp] theorem of_equiv_σ {f : filter α} (F : f.realizer) (E : F.σ ≃ τ) : (F.of_equiv E).σ = τ := rfl
@[simp]

/-- `unit` is a realizer for the principal filter -/
protected def principal (s : set α) : (principal s).realizer := ⟨unit,
{ f            := λ _, s,
  pt           := (),
  inf          := λ _ _, (),
  inf_le_left  := λ _ _, le_refl _,
  inf_le_right := λ _ _, le_refl _ },
filter_eq $ set.ext $ λ x,
⟨λ ⟨_, s⟩, s, λ h, ⟨(), h⟩⟩⟩

@[simp] theorem principal_σ (s : set α) : (realizer.principal s).σ = unit := rfl
@[simp] theorem principal_F (s : set α) (u : unit) : (realizer.principal s).F u = s := rfl

/-- `unit` is a realizer for the top filter -/
protected def top : (⊤ : filter α).realizer :=
(realizer.principal _).of_eq principal_univ

@[simp] theorem top_σ : (@realizer.top α).σ = unit := rfl
@[simp] theorem top_F (u : unit) : (@realizer.top α).F u = univ := rfl

/-- `unit` is a realizer for the bottom filter -/
protected def bot : (⊥ : filter α).realizer :=
(realizer.principal _).of_eq principal_empty

@[simp] theorem bot_σ : (@realizer.bot α).σ = unit := rfl
@[simp] theorem bot_F (u : unit) : (@realizer.bot α).F u = ∅ := rfl

/-- Construct a realizer for `map m f` given a realizer for `f` -/
protected def map (m : α → β) {f : filter α} (F : f.realizer) : (map m f).realizer := ⟨F.σ,
{ f            := λ s, image m (F.F s),
  pt           := F.F.pt,
  inf          := F.F.inf,
  inf_le_left  := λ a b, image_subset _ (F.F.inf_le_left _ _),
  inf_le_right := λ a b, image_subset _ (F.F.inf_le_right _ _) },
filter_eq $ set.ext $ λ x, by simp [cfilter.to_filter]; rw F.mem_sets; exact
exists_congr (λ s, image_subset_iff)⟩

@[simp] theorem map_σ (m : α → β) {f : filter α} (F : f.realizer) : (F.map m).σ = F.σ := rfl
@[simp] theorem map_F (m : α → β) {f : filter α} (F : f.realizer) (s) : (F.map m).F s = image m (F.F s) := rfl

/-- Construct a realizer for `comap m f` given a realizer for `f` -/
protected def comap (m : α → β) {f : filter β} (F : f.realizer) : (comap m f).realizer := ⟨F.σ,
{ f            := λ s, preimage m (F.F s),
  pt           := F.F.pt,
  inf          := F.F.inf,
  inf_le_left  := λ a b, preimage_mono (F.F.inf_le_left _ _),
  inf_le_right := λ a b, preimage_mono (F.F.inf_le_right _ _) },
filter_eq $ set.ext $ λ x, by cases F; subst f; simp [cfilter.to_filter, mem_comap_sets]; exact
⟨λ ⟨s, h⟩, ⟨_, ⟨s, subset.refl _⟩, h⟩,
 λ ⟨y, ⟨s, h⟩, h₂⟩, ⟨s, subset.trans (preimage_mono h) h₂⟩⟩⟩

/-- Construct a realizer for the sup of two filters -/
protected def sup {f g : filter α} (F : f.realizer) (G : g.realizer) : (f ⊔ g).realizer := ⟨F.σ × G.σ,
{ f            := λ ⟨s, t⟩, F.F s ∪ G.F t,
  pt           := (F.F.pt, G.F.pt),
  inf          := λ ⟨a, a'⟩ ⟨b, b'⟩, (F.F.inf a b, G.F.inf a' b'),
  inf_le_left  := λ ⟨a, a'⟩ ⟨b, b'⟩, union_subset_union (F.F.inf_le_left _ _) (G.F.inf_le_left _ _),
  inf_le_right := λ ⟨a, a'⟩ ⟨b, b'⟩, union_subset_union (F.F.inf_le_right _ _) (G.F.inf_le_right _ _) },
filter_eq $ set.ext $ λ x, by cases F; cases G; substs f g; simp [cfilter.to_filter]; exact
⟨λ ⟨s, t, h⟩, ⟨⟨s, subset.trans (subset_union_left _ _) h⟩,
               ⟨t, subset.trans (subset_union_right _ _) h⟩⟩,
 λ ⟨⟨s, h₁⟩, ⟨t, h₂⟩⟩, ⟨s, t, union_subset h₁ h₂⟩⟩⟩

/-- Construct a realizer for the inf of two filters -/
protected def inf {f g : filter α} (F : f.realizer) (G : g.realizer) : (f ⊓ g).realizer := ⟨F.σ × G.σ,
{ f            := λ ⟨s, t⟩, F.F s ∩ G.F t,
  pt           := (F.F.pt, G.F.pt),
  inf          := λ ⟨a, a'⟩ ⟨b, b'⟩, (F.F.inf a b, G.F.inf a' b'),
  inf_le_left  := λ ⟨a, a'⟩ ⟨b, b'⟩, inter_subset_inter (F.F.inf_le_left _ _) (G.F.inf_le_left _ _),
  inf_le_right := λ ⟨a, a'⟩ ⟨b, b'⟩, inter_subset_inter (F.F.inf_le_right _ _) (G.F.inf_le_right _ _) },
filter_eq $ set.ext $ λ x, by cases F; cases G; substs f g; simp [cfilter.to_filter]; exact
⟨λ ⟨s, t, h⟩, ⟨_, ⟨s, subset.refl _⟩, _, ⟨t, subset.refl _⟩, h⟩,
 λ ⟨y, ⟨s, h₁⟩, z, ⟨t, h₂⟩, h⟩, ⟨s, t, subset.trans (inter_subset_inter h₁ h₂) h⟩⟩⟩

/-- Construct a realizer for the cofinite filter -/
protected def cofinite [decidable_eq α] : (@cofinite α).realizer := ⟨finset α,
{ f            := λ s, {a | a ∉ s},
  pt           := ∅,
  inf          := (∪),
  inf_le_left  := λ s t a, mt (finset.mem_union_left _),
  inf_le_right := λ s t a, mt (finset.mem_union_right _) },
filter_eq $ set.ext $ λ x, by simp [cfilter.to_filter]; exactI
⟨λ ⟨s, h⟩, finite_subset (finite_mem_finset s) (compl_subset_comm.1 h),
 λ ⟨fs⟩, ⟨(-x).to_finset, λ a (h : a ∉ (-x).to_finset),
  classical.by_contradiction $ λ h', h (mem_to_finset.2 h')⟩⟩⟩

/-- Construct a realizer for filter bind -/
protected def bind {f : filter α} {m : α → filter β} (F : f.realizer) (G : ∀ i, (m i).realizer) : (f.bind m).realizer :=
⟨Σ s : F.σ, Π i ∈ F.F s, (G i).σ,
{ f            := λ ⟨s, f⟩, ⋃ i ∈ F.F s, (G i).F (f i H),
  pt           := ⟨F.F.pt, λ i H, (G i).F.pt⟩,
  inf          := λ ⟨a, f⟩ ⟨b, f'⟩, ⟨F.F.inf a b, λ i h,
    (G i).F.inf (f i (F.F.inf_le_left _ _ h)) (f' i (F.F.inf_le_right _ _ h))⟩,
  inf_le_left  := λ ⟨a, f⟩ ⟨b, f'⟩ x,
    show (x ∈ ⋃ (i : α) (H : i ∈ F.F (F.F.inf a b)), _) →
          x ∈ ⋃ i (H : i ∈ F.F a), ((G i).F) (f i H), by simp; exact
    λ i h₁ h₂, ⟨i, F.F.inf_le_left _ _ h₁, (G i).F.inf_le_left _ _ h₂⟩,
  inf_le_right := λ ⟨a, f⟩ ⟨b, f'⟩ x,
    show (x ∈ ⋃ (i : α) (H : i ∈ F.F (F.F.inf a b)), _) →
          x ∈ ⋃ i (H : i ∈ F.F b), ((G i).F) (f' i H), by simp; exact
    λ i h₁ h₂, ⟨i, F.F.inf_le_right _ _ h₁, (G i).F.inf_le_right _ _ h₂⟩ },
filter_eq $ set.ext $ λ x, by cases F with _ F _; subst f; simp [cfilter.to_filter, mem_bind_sets]; exact
⟨λ ⟨s, f, h⟩, ⟨F s, ⟨s, subset.refl _⟩, λ i H, (G i).mem_sets.2
   ⟨f i H, λ a h', h ⟨_, ⟨i, rfl⟩, _, ⟨H, rfl⟩, h'⟩⟩⟩,
 λ ⟨y, ⟨s, h⟩, f⟩,
  let ⟨f', h'⟩ := classical.axiom_of_choice (λ i:F s, (G i).mem_sets.1 (f i (h i.2))) in
  ⟨s, λ i h, f' ⟨i, h⟩, λ a ⟨_, ⟨i, rfl⟩, _, ⟨H, rfl⟩, m⟩, h' ⟨_, H⟩ m⟩⟩⟩

/-- Construct a realizer for indexed supremum -/
protected def Sup {f : α → filter β} (F : ∀ i, (f i).realizer) : (⨆ i, f i).realizer :=
let F' : (⨆ i, f i).realizer :=
  ((realizer.bind realizer.top F).of_eq $
    filter_eq $ set.ext $ by simp [filter.bind, eq_univ_iff_forall, supr_sets_eq]) in
F'.of_equiv $ show (Σ u:unit, Π (i : α), true → (F i).σ) ≃ Π i, (F i).σ, from
⟨λ⟨_,f⟩ i, f i ⟨⟩, λ f, ⟨(), λ i _, f i⟩,
 λ ⟨⟨⟩, f⟩, by dsimp; congr; simp, λ f, rfl⟩

/-- Construct a realizer for the product of filters -/
protected def prod {f g : filter α} (F : f.realizer) (G : g.realizer) : (f.prod g).realizer :=
(F.comap _).inf (G.comap _)

theorem le_iff {f g : filter α} (F : f.realizer) (G : g.realizer) :
  f ≤ g ↔ ∀ b : G.σ, ∃ a : F.σ, F.F a ≤ G.F b :=
⟨λ H t, F.mem_sets.1 (H (G.mem_sets.2 ⟨t, subset.refl _⟩)),
 λ H x h, F.mem_sets.2 $
   let ⟨s, h₁⟩ := G.mem_sets.1 h, ⟨t, h₂⟩ := H s in ⟨t, subset.trans h₂ h₁⟩⟩

theorem tendsto_iff (f : α → β) {l₁ : filter α} {l₂ : filter β} (L₁ : l₁.realizer) (L₂ : l₂.realizer) :
  tendsto f l₁ l₂ ↔ ∀ b, ∃ a, ∀ x ∈ L₁.F a, f x ∈ L₂.F b :=
(le_iff (L₁.map f) L₂).trans $ forall_congr $ λ b, exists_congr $ λ a, image_subset_iff

theorem ne_bot_iff {f : filter α} (F : f.realizer) :
  f ≠ ⊥ ↔ ∀ a : F.σ, F.F a ≠ ∅ :=
by haveI := classical.prop_decidable;
   rw [not_iff_comm, ← lattice.le_bot_iff,
       F.le_iff realizer.bot]; simp [not_forall]; exact
⟨λ ⟨x, e⟩ _, ⟨x, le_of_eq e⟩,
 λ h, let ⟨x, h⟩ := h () in ⟨x, lattice.le_bot_iff.1 h⟩⟩

end filter.realizer


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Robert Y. Lewis

Analytic facts about polynomials.
-/

import topology.algebra.ring data.polynomial

lemma polynomial.continuous_eval {α} [comm_semiring α] [decidable_eq α] [topological_space α]
  [topological_semiring α] (p : polynomial α) : continuous (λ x, p.eval x) :=
begin
  apply p.induction,
  { convert continuous_const,
    ext, show polynomial.eval x 0 = 0, from rfl },
  { intros a b f haf hb hcts,
    simp only [polynomial.eval_add],
    refine continuous_add _ hcts,
    have : ∀ x, finsupp.sum (finsupp.single a b) (λ (e : ℕ) (a : α), a * x ^ e) = b * x ^a,
      from λ x, finsupp.sum_single_index (by simp),
    convert continuous_mul _ _,
    { ext, apply this },
    { apply_instance },
    { apply continuous_const },
    { apply continuous_pow }}
end