/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.algebra.restrict_scalars
import category_theory.linear.basic
import algebra.category.Module.basic

/-!
# Additional typeclass for modules over an algebra

For an object in `M : Module A`, where `A` is a `k`-algebra,
we provide additional typeclasses on the underlying type `M`,
namely `module k M` and `is_scalar_tower k A M`.
These are not made into instances by default.

We provide the `linear k (Module A)` instance.

## Note

If you begin with a `[module k M] [module A M] [is_scalar_tower k A M]`,
and build a bundled module via `Module.of A M`,
these instances will not necessarily agree with the original ones.

It seems without making a parallel version `Module' k A`, for modules over a `k`-algebra `A`,
that carries these typeclasses, this seems hard to achieve.
(An alternative would be to always require these typeclasses, and remove the original `Module`,
requiring users to write `Module' ℤ A` when `A` is merely a ring.)
-/

universes v u w
open category_theory

namespace Module

variables {k : Type u} [field k]
variables {A : Type w} [ring A] [algebra k A]

/--
Type synonym for considering a module over a `k`-algebra as a `k`-module.
-/
def module_of_algebra_Module (M : Module.{v} A) : module k M :=
restrict_scalars.module k A M

localized "attribute [instance] Module.module_of_algebra_Module" in Module

lemma is_scalar_tower_of_algebra_Module (M : Module.{v} A) : is_scalar_tower k A M :=
restrict_scalars.is_scalar_tower k A M

localized "attribute [instance] Module.is_scalar_tower_of_algebra_Module" in Module

-- We verify that the morphism spaces become `k`-modules.
example (M N : Module.{v} A) : module k (M ⟶ N) := by apply_instance

instance linear_over_field : linear k (Module.{v} A) :=
{ hom_module := λ M N, by apply_instance, }

end Module


import tactic.linarith
import algebra.field_power

example {α : Type} (_inst : Π (a : Prop), decidable a)
  [linear_ordered_field α]
  {a b c : α}
  (ha : a < 0)
  (hb : ¬b = 0)
  (hc' : c = 0)
  (h : (1 - a) * (b * b) ≤ 0)
  (hc : 0 ≤ 0)
  (this : -(a * -b * -b + b * -b + 0) = (1 - a) * (b * b))
  (h : (1 - a) * (b * b) ≤ 0) :
  0 < 1 - a :=
begin
  linarith
end

example (e b c a v0 v1 : ℚ) (h1 : v0 = 5*a) (h2 : v1 = 3*b) (h3 : v0 + v1 + c = 10) :
  v0 + 5 + (v1 - 3) + (c - 2) = 10 :=
by linarith

example (u v r s t : ℚ) (h : 0 < u*(t*v + t*r + s)) : 0 < (t*(r + v) + s)*3*u :=
by linarith

example (A B : ℚ) (h : 0 < A * B) : 0 < 8*A*B :=
begin
  linarith
end

example (A B : ℚ) (h : 0 < A * B) : 0 < A*8*B :=
begin
  linarith
end

example (A B : ℚ) (h : 0 < A * B) : 0 < A*B/8 :=
begin
  linarith
end

example (A B : ℚ) (h : 0 < A * B) : 0 < A/8*B :=
begin
  linarith
end

example (ε : ℚ) (h1 : ε > 0) : ε / 2 + ε / 3 + ε / 7 < ε :=
 by linarith

example (x y z : ℚ) (h1 : 2*x  < 3*y) (h2 : -4*x + z/2 < 0)
        (h3 : 12*y - z < 0)  : false :=
by linarith

example (ε : ℚ) (h1 : ε > 0) : ε / 2 < ε :=
by linarith

example (ε : ℚ) (h1 : ε > 0) : ε / 3 + ε / 3 + ε / 3 = ε :=
by linarith

example (a b c : ℚ)  (h2 : b + 2 > 3 + b) : false :=
by linarith {discharger := `[ring]}

example (a b c : ℚ)  (h2 : b + 2 > 3 + b) : false :=
by linarith

example (a b c : ℚ) (x y : ℤ) (h1 : x ≤ 3*y) (h2 : b + 2 > 3 + b) : false :=
by linarith {restrict_type := ℚ}

example (g v V c h : ℚ) (h1 : h = 0) (h2 : v = V) (h3 : V > 0) (h4 : g > 0)
        (h5 : 0 ≤ c) (h6 : c < 1) :
  v ≤ V :=
by linarith

constant nat.prime : ℕ → Prop

example (x y z : ℚ) (h1 : 2*x + ((-3)*y) < 0) (h2 : (-4)*x + 2*z < 0)
       (h3 : 12*y + (-4)* z < 0) (h4 : nat.prime 7) : false :=
by linarith

example (x y z : ℚ) (h1 : 2*1*x + (3)*(y*(-1)) < 0) (h2 : (-2)*x*2 < -(z + z))
       (h3 : 12*y + (-4)* z < 0) (h4 : nat.prime 7) : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0) (h3 : x*y < 5)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0) (h3 : x*y < 5) :
        ¬ 12*y - 4* z < 0 :=
by linarith

example (w x y z : ℤ) (h1 : 4*x + (-3)*y + 6*w ≤ 0) (h2 : (-1)*x < 0)
        (h3 : y < 0) (h4 : w ≥ 0) (h5 : nat.prime x.nat_abs) : false :=
by linarith

example (a b c : ℚ) (h1 : a > 0) (h2 : b > 5) (h3 : c < -10)
        (h4 : a + b - c < 3)  : false :=
by linarith

example (a b c : ℚ) (h2 : b > 0) (h3 : ¬ b ≥ 0) : false :=
by linarith

example (a b c : ℚ) (h2 : (2 : ℚ) > 3)  : a + b - c ≥ 3 :=
by linarith {exfalso := ff}

example (x : ℚ) (hx : x > 0) (h : x.num < 0) : false :=
by linarith [rat.num_pos_iff_pos.mpr hx, h]

example (x : ℚ) (hx : x > 0) (h : x.num < 0) : false :=
by linarith only [rat.num_pos_iff_pos.mpr hx, h]

example (x y z : ℚ) (hx : x ≤ 3*y) (h2 : y ≤ 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (x y z : ℕ) (hx : x ≤ 3*y) (h2 : y ≤ 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (x y z : ℚ) (hx : ¬ x > 3*y) (h2 : ¬ y > 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (h1 : (1 : ℕ) < 1) : false :=
by linarith

example (a b c : ℚ) (h2 : b > 0) (h3 : b < 0) : nat.prime 10 :=
by linarith

example (a b c : ℕ) : a + b ≥ a :=
by linarith

example (a b c : ℕ) : ¬ a + b < a :=
by linarith

example (x y : ℚ) (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3) (h' : (x + 4) * x ≥ 0)
  (h'' : (6 + 3 * y) * y ≥ 0)  : false :=
by linarith

example (x y : ℚ)
  (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3 ∧ (x + 4) * x ≥ 0 ∧ (6 + 3 * y) * y ≥ 0) : false :=
by linarith

example (a b i : ℕ) (h1 :  ¬ a < i) (h2 : b < i) (h3 : a ≤ b) : false :=
by linarith

example (n : ℕ) (h1 : n ≤ 3) (h2 : n > 2) : n = 3 := by linarith

example (z : ℕ) (hz : ¬ z ≥ 2) (h2 : ¬ z + 1 ≤ 2) : false :=
by linarith

example (z : ℕ) (hz : ¬ z ≥ 2) : z + 1 ≤ 2 :=
by linarith

example (a b c : ℚ) (h1 : 1 / a < b) (h2 : b < c) : 1 / a < c :=
by linarith

example
(N : ℕ) (n : ℕ) (Hirrelevant : n > N)
(A : ℚ) (l : ℚ) (h : A - l ≤ -(A - l)) (h_1 : ¬A ≤ -A) (h_2 : ¬l ≤ -l)
(h_3 : -(A - l) < 1) :  A < l + 1 := by linarith

example (d : ℚ) (q n : ℕ) (h1 : ((q : ℚ) - 1)*n ≥ 0) (h2 : d = 2/3*(((q : ℚ) - 1)*n)) :
  d ≤ ((q : ℚ) - 1)*n :=
by linarith

example (d : ℚ) (q n : ℕ) (h1 : ((q : ℚ) - 1)*n ≥ 0) (h2 : d = 2/3*(((q : ℚ) - 1)*n)) :
  ((q : ℚ) - 1)*n - d = 1/3 * (((q : ℚ) - 1)*n) :=
by linarith

example (a : ℚ) (ha : 0 ≤ a) : 0 * 0 ≤ 2 * a :=
by linarith

example (x : ℚ) : id x ≥ x :=
by success_if_fail {linarith}; linarith!

example (x y z : ℚ) (hx : x < 5) (hx2 : x > 5) (hy : y < 5000000000) (hz : z > 34*y) : false :=
by linarith only [hx, hx2]

example (x y z : ℚ) (hx : x < 5) (hy : y < 5000000000) (hz : z > 34*y) : x ≤ 5 :=
by linarith only [hx]

example (x y : ℚ) (h : x < y) : x ≠ y := by linarith

example (x y : ℚ) (h : x < y) : ¬ x = y := by linarith

example (u v x y A B : ℚ)
(a : 0 < A)
(a_1 : 0 <= 1 - A)
(a_2 : 0 <= B - 1)
(a_3 : 0 <= B - x)
(a_4 : 0 <= B - y)
(a_5 : 0 <= u)
(a_6 : 0 <= v)
(a_7 : 0 < A - u)
(a_8 : 0 < A - v) :
 u * y + v * x + u * v < 3 * A * B :=
 by nlinarith

example (u v x y A B : ℚ) : (0 < A) → (A ≤ 1) → (1 ≤ B)
→ (x ≤ B) → ( y ≤ B)
→ (0 ≤ u ) → (0 ≤ v )
→ (u < A) → ( v < A)
→ (u * y + v * x + u * v < 3 * A * B) :=
begin
  intros,
  nlinarith
end

example (u v x y A B : ℚ)
(a : 0 < A)
(a_1 : 0 <= 1 - A)
(a_2 : 0 <= B - 1)
(a_3 : 0 <= B - x)
(a_4 : 0 <= B - y)
(a_5 : 0 <= u)
(a_6 : 0 <= v)
(a_7 : 0 < A - u)
(a_8 : 0 < A - v) :
 (0 < A * A)
-> (0 <= A * (1 - A))
-> (0 <= A * (B - 1))
-> (0 <= A * (B - x))
-> (0 <= A * (B - y))
-> (0 <= A * u)
-> (0 <= A * v)
-> (0 < A * (A - u))
-> (0 < A * (A - v))
-> (0 <= (1 - A) * A)
-> (0 <= (1 - A) * (1 - A))
-> (0 <= (1 - A) * (B - 1))
-> (0 <= (1 - A) * (B - x))
-> (0 <= (1 - A) * (B - y))
-> (0 <= (1 - A) * u)
-> (0 <= (1 - A) * v)
-> (0 <= (1 - A) * (A - u))
-> (0 <= (1 - A) * (A - v))
-> (0 <= (B - 1) * A)
-> (0 <= (B - 1) * (1 - A))
-> (0 <= (B - 1) * (B - 1))
-> (0 <= (B - 1) * (B - x))
-> (0 <= (B - 1) * (B - y))
-> (0 <= (B - 1) * u)
-> (0 <= (B - 1) * v)
-> (0 <= (B - 1) * (A - u))
-> (0 <= (B - 1) * (A - v))
-> (0 <= (B - x) * A)
-> (0 <= (B - x) * (1 - A))
-> (0 <= (B - x) * (B - 1))
-> (0 <= (B - x) * (B - x))
-> (0 <= (B - x) * (B - y))
-> (0 <= (B - x) * u)
-> (0 <= (B - x) * v)
-> (0 <= (B - x) * (A - u))
-> (0 <= (B - x) * (A - v))
-> (0 <= (B - y) * A)
-> (0 <= (B - y) * (1 - A))
-> (0 <= (B - y) * (B - 1))
-> (0 <= (B - y) * (B - x))
-> (0 <= (B - y) * (B - y))
-> (0 <= (B - y) * u)
-> (0 <= (B - y) * v)
-> (0 <= (B - y) * (A - u))
-> (0 <= (B - y) * (A - v))
-> (0 <= u * A)
-> (0 <= u * (1 - A))
-> (0 <= u * (B - 1))
-> (0 <= u * (B - x))
-> (0 <= u * (B - y))
-> (0 <= u * u)
-> (0 <= u * v)
-> (0 <= u * (A - u))
-> (0 <= u * (A - v))
-> (0 <= v * A)
-> (0 <= v * (1 - A))
-> (0 <= v * (B - 1))
-> (0 <= v * (B - x))
-> (0 <= v * (B - y))
-> (0 <= v * u)
-> (0 <= v * v)
-> (0 <= v * (A - u))
-> (0 <= v * (A - v))
-> (0 < (A - u) * A)
-> (0 <= (A - u) * (1 - A))
-> (0 <= (A - u) * (B - 1))
-> (0 <= (A - u) * (B - x))
-> (0 <= (A - u) * (B - y))
-> (0 <= (A - u) * u)
-> (0 <= (A - u) * v)
-> (0 < (A - u) * (A - u))
-> (0 < (A - u) * (A - v))
-> (0 < (A - v) * A)
-> (0 <= (A - v) * (1 - A))
-> (0 <= (A - v) * (B - 1))
-> (0 <= (A - v) * (B - x))
-> (0 <= (A - v) * (B - y))
-> (0 <= (A - v) * u)
-> (0 <= (A - v) * v)
-> (0 < (A - v) * (A - u))
-> (0 < (A - v) * (A - v))
->
 u * y + v * x + u * v < 3 * A * B :=
 begin
  intros,
  linarith
 end

example (A B : ℚ) : (0 < A) → (1 ≤ B) → (0 < A / 8 * B) :=
begin
  intros, nlinarith
end

example (x y : ℚ) : 0 ≤ x ^2 + y ^2 :=
by nlinarith

example (x y : ℚ) : 0 ≤ x*x + y*y :=
by nlinarith

example (x y : ℚ) : x = 0 → y = 0 → x*x + y*y = 0 :=
by intros; nlinarith

lemma norm_eq_zero_iff {x y : ℚ} : x * x + y * y = 0 ↔ x = 0 ∧ y = 0 :=
begin
  split,
  { intro, split; nlinarith },
  { intro, nlinarith }
end

lemma norm_nonpos_right {x y : ℚ} (h1 : x * x + y * y ≤ 0) : y = 0 :=
by nlinarith

lemma norm_nonpos_left (x y : ℚ) (h1 : x * x + y * y ≤ 0) : x = 0 :=
by nlinarith

variables {E : Type*} [add_group E]
example (f : ℤ → E) (h : 0 = f 0) : 1 ≤ 2 := by nlinarith
example (a : E) (h : a = a) : 1 ≤ 2  := by nlinarith

-- test that the apply bug doesn't affect linarith preprocessing

constant α : Type
variable [fact false] -- we work in an inconsistent context below
def leα : α → α → Prop := λ a b, ∀ c : α, true

noncomputable instance : linear_ordered_field α :=
by refine_struct { le := leα }; exact (fact.out false).elim

example (a : α) (ha : a < 2) : a ≤ a :=
by linarith

example (p q r s t u v w : ℕ) (h1 : p + u = q + t) (h2 : r + w = s + v) :
  p * r + q * s + (t * w + u * v) = p * s + q * r + (t * v + u * w) :=
by nlinarith

-- Tests involving a norm, including that squares in a type where `sq_nonneg` does not apply
-- do not cause an exception
variables {R : Type*} [ring R] (abs : R → ℚ)

lemma abs_nonneg' : ∀ r, 0 ≤ abs r := (fact.out false).elim

example (t : R) (a b : ℚ) (h : a ≤ b) : abs (t^2) * a ≤ abs (t^2) * b :=
by nlinarith [abs_nonneg' abs (t^2)]

example (t : R)  (a b : ℚ) (h : a ≤ b) : a ≤ abs (t^2) + b :=
by linarith [abs_nonneg' abs (t^2)]

example (t : R) (a b : ℚ) (h : a ≤ b) : abs t * a ≤ abs t * b :=
by nlinarith [abs_nonneg' abs t]

constant T : Type

attribute [instance]
constant T_zero : ordered_ring T

namespace T

lemma zero_lt_one : (0 : T) < 1 := (fact.out false).elim

lemma works {a b : ℕ} (hab : a ≤ b) (h : b < a) : false :=
begin
  linarith,
end

end T

example (a b c : ℚ) (h : a ≠ b) (h3 : b ≠ c) (h2 : a ≥ b) : b ≠ c :=
by linarith {split_ne := tt}

example (a b c : ℚ) (h : a ≠ b) (h2 : a ≥ b) (h3 : b ≠ c) : a > b :=
by linarith {split_ne := tt}

example (x y : ℚ) (h₁ : 0 ≤ y) (h₂ : y ≤ x) : y * x ≤ x * x := by nlinarith

example (x y : ℚ) (h₁ : 0 ≤ y) (h₂ : y ≤ x) : y * x ≤ x ^ 2 := by nlinarith

axiom foo {x : int} : 1 ≤ x → 1 ≤ x*x
lemma bar (x y: int)(h : 0 ≤ y ∧ 1 ≤ x) : 1 ≤ y + x*x := by linarith [foo h.2]


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.group_action_hom
import algebra.module.basic
import data.set_like
import group_theory.group_action.basic
/-!

# Sets invariant to a `mul_action`

In this file we define `sub_mul_action R M`; a subset of a `mul_action R M` which is closed with
respect to scalar multiplication.

For most uses, typically `submodule R M` is more powerful.

## Main definitions

* `sub_mul_action.mul_action` - the `mul_action R M` transferred to the subtype.
* `sub_mul_action.mul_action'` - the `mul_action S M` transferred to the subtype when
  `is_scalar_tower S R M`.
* `sub_mul_action.is_scalar_tower` - the `is_scalar_tower S R M` transferred to the subtype.

## Tags

submodule, mul_action
-/

open function

universes u u' v
variables {S : Type u'} {R : Type u} {M : Type v}

set_option old_structure_cmd true

/-- A sub_mul_action is a set which is closed under scalar multiplication.  -/
structure sub_mul_action (R : Type u) (M : Type v) [has_scalar R M] : Type v :=
(carrier : set M)
(smul_mem' : ∀ (c : R) {x : M}, x ∈ carrier → c • x ∈ carrier)

namespace sub_mul_action

variables [has_scalar R M]

instance : set_like (sub_mul_action R M) M :=
⟨sub_mul_action.carrier, λ p q h, by cases p; cases q; congr'⟩

@[simp] lemma mem_carrier {p : sub_mul_action R M} {x : M} : x ∈ p.carrier ↔ x ∈ (p : set M) :=
iff.rfl

@[ext] theorem ext {p q : sub_mul_action R M} (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q := set_like.ext h

/-- Copy of a sub_mul_action with a new `carrier` equal to the old one. Useful to fix definitional
equalities.-/
protected def copy (p : sub_mul_action R M) (s : set M) (hs : s = ↑p) : sub_mul_action R M :=
{ carrier := s,
  smul_mem' := hs.symm ▸ p.smul_mem' }

instance : has_bot (sub_mul_action R M) :=
⟨{ carrier := ∅, smul_mem' := λ c, set.not_mem_empty}⟩

instance : inhabited (sub_mul_action R M) := ⟨⊥⟩

end sub_mul_action

namespace sub_mul_action

section has_scalar

variables [has_scalar R M]
variables (p : sub_mul_action R M)
variables {r : R} {x : M}

lemma smul_mem (r : R) (h : x ∈ p) : r • x ∈ p := p.smul_mem' r h

instance : has_scalar R p :=
{ smul := λ c x, ⟨c • x.1, smul_mem _ c x.2⟩ }

variables {p}
@[simp, norm_cast] lemma coe_smul (r : R) (x : p) : ((r • x : p) : M) = r • ↑x := rfl
@[simp, norm_cast] lemma coe_mk (x : M) (hx : x ∈ p) : ((⟨x, hx⟩ : p) : M) = x := rfl

variables (p)

/-- Embedding of a submodule `p` to the ambient space `M`. -/
protected def subtype : p →[R] M :=
by refine {to_fun := coe, ..}; simp [coe_smul]

@[simp] theorem subtype_apply (x : p) : p.subtype x = x := rfl

lemma subtype_eq_val : ((sub_mul_action.subtype p) : p → M) = subtype.val := rfl

end has_scalar

section mul_action

variables [monoid S] [monoid R]

variables [mul_action R M]
variables [has_scalar S R] [mul_action S M] [is_scalar_tower S R M]
variables (p : sub_mul_action R M)
variables {r : R} {x : M}

lemma smul_of_tower_mem (s : S) (h : x ∈ p) : s • x ∈ p :=
by { rw [←one_smul R x, ←smul_assoc], exact p.smul_mem _ h }

instance has_scalar' : has_scalar S p :=
{ smul := λ c x, ⟨c • x.1, smul_of_tower_mem _ c x.2⟩ }

instance : is_scalar_tower S R p :=
{ smul_assoc := λ s r x, subtype.ext $ smul_assoc s r ↑x }

@[simp, norm_cast] lemma coe_smul_of_tower (s : S) (x : p) : ((s • x : p) : M) = s • ↑x := rfl

@[simp] lemma smul_mem_iff' (u : units S) : (u : S) • x ∈ p ↔ x ∈ p :=
⟨λ h, by simpa only [smul_smul, u.inv_mul, one_smul] using p.smul_of_tower_mem (↑u⁻¹ : S) h,
  p.smul_of_tower_mem u⟩

/-- If the scalar product forms a `mul_action`, then the subset inherits this action -/
instance mul_action' : mul_action S p :=
{ smul := (•),
  one_smul := λ x, subtype.ext $ one_smul _ x,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul c₁ c₂ x }

instance : mul_action R p := p.mul_action'

end mul_action

section module

variables [semiring R] [add_comm_monoid M]
variables [module R M]
variables (p : sub_mul_action R M)

lemma zero_mem (h : (p : set M).nonempty) : (0 : M) ∈ p :=
let ⟨x, hx⟩ := h in zero_smul R (x : M) ▸ p.smul_mem 0 hx

/-- If the scalar product forms a `module`, and the `sub_mul_action` is not `⊥`, then the
subset inherits the zero. -/
instance [n_empty : nonempty p] : has_zero p :=
{ zero := ⟨0, n_empty.elim $ λ x, p.zero_mem ⟨x, x.prop⟩⟩ }

end module

section add_comm_group

variables [ring R] [add_comm_group M]
variables [module R M]
variables (p p' : sub_mul_action R M)
variables {r : R} {x y : M}

lemma neg_mem (hx : x ∈ p) : -x ∈ p := by { rw ← neg_one_smul R, exact p.smul_mem _ hx }

@[simp] lemma neg_mem_iff : -x ∈ p ↔ x ∈ p :=
⟨λ h, by { rw ←neg_neg x, exact neg_mem _ h}, neg_mem _⟩

instance : has_neg p := ⟨λx, ⟨-x.1, neg_mem _ x.2⟩⟩

@[simp, norm_cast] lemma coe_neg (x : p) : ((-x : p) : M) = -x := rfl

end add_comm_group

end sub_mul_action

namespace sub_mul_action

variables [division_ring S] [semiring R] [mul_action R M]
variables [has_scalar S R] [mul_action S M] [is_scalar_tower S R M]
variables (p : sub_mul_action R M) {s : S} {x y : M}

theorem smul_mem_iff (s0 : s ≠ 0) : s • x ∈ p ↔ x ∈ p :=
p.smul_mem_iff' (units.mk0 s s0)

end sub_mul_action


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.star.basic
import algebra.ring.pi
import algebra.module.pi

/-!
# `star` on pi types

We put a `has_star` structure on pi types that operates elementwise, such that it describes the
complex conjugation of vectors.
-/

universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances

namespace pi

instance [Π i, has_star (f i)] : has_star (Π i, f i) :=
{ star := λ x i, star (x i) }

@[simp] lemma star_apply [Π i, has_star (f i)] (x : Π i, f i) (i : I) : star x i = star (x i) := rfl

lemma star_def [Π i, has_star (f i)] (x : Π i, f i) : star x = λ i, star (x i) := rfl

instance [Π i, has_involutive_star (f i)] : has_involutive_star (Π i, f i) :=
{ star_involutive := λ _, funext $ λ _, star_star _ }

instance [Π i, semigroup (f i)] [Π i, star_semigroup (f i)] : star_semigroup (Π i, f i) :=
{ star_mul := λ _ _, funext $ λ _, star_mul _ _ }

instance [Π i, add_monoid (f i)] [Π i, star_add_monoid (f i)] : star_add_monoid (Π i, f i) :=
{ star_add := λ _ _, funext $ λ _, star_add _ _ }

instance [Π i, non_unital_semiring (f i)] [Π i, star_ring (f i)] : star_ring (Π i, f i) :=
{ ..pi.star_add_monoid, ..(pi.star_semigroup : star_semigroup (Π i, f i)) }

instance {R : Type w}
  [Π i, has_smul R (f i)] [has_star R] [Π i, has_star (f i)] [Π i, star_module R (f i)] :
  star_module R (Π i, f i) :=
{ star_smul := λ r x, funext $ λ i, star_smul r (x i) }

lemma single_star [Π i, add_monoid (f i)] [Π i, star_add_monoid (f i)] [decidable_eq I]
  (i : I) (a : f i) :
  pi.single i (star a) = star (pi.single i a) :=
single_op (λ i, @star (f i) _) (λ i, star_zero _) i a

end pi

namespace function

lemma update_star [Π i, has_star (f i)] [decidable_eq I]
  (h : Π (i : I), f i) (i : I) (a : f i) :
  function.update (star h) i (star a) = star (function.update h i a) :=
funext $ λ j, (apply_update (λ i, star) h i a j).symm

end function


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.sort
import Mathlib.data.multiset.basic
import Mathlib.data.string.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Construct a sorted list from a multiset.
-/

namespace multiset

/-- `sort s` constructs a sorted list from the multiset `s`.
  (Uses merge sort algorithm.) -/
def sort {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r] [is_antisymm α r] [is_total α r] (s : multiset α) : List α :=
  quot.lift_on s (list.merge_sort r) sorry

@[simp] theorem coe_sort {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r] [is_antisymm α r] [is_total α r] (l : List α) : sort r ↑l = list.merge_sort r l :=
  rfl

@[simp] theorem sort_sorted {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r] [is_antisymm α r] [is_total α r] (s : multiset α) : list.sorted r (sort r s) :=
  quot.induction_on s fun (l : List α) => list.sorted_merge_sort r l

@[simp] theorem sort_eq {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r] [is_antisymm α r] [is_total α r] (s : multiset α) : ↑(sort r s) = s :=
  quot.induction_on s fun (l : List α) => quot.sound (list.perm_merge_sort r l)

@[simp] theorem mem_sort {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r] [is_antisymm α r] [is_total α r] {s : multiset α} {a : α} : a ∈ sort r s ↔ a ∈ s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ sort r s ↔ a ∈ s)) (Eq.symm (propext mem_coe))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ ↑(sort r s) ↔ a ∈ s)) (sort_eq r s))) (iff.refl (a ∈ s)))

@[simp] theorem length_sort {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r] [is_antisymm α r] [is_total α r] {s : multiset α} : list.length (sort r s) = coe_fn card s :=
  quot.induction_on s (list.length_merge_sort r)

protected instance has_repr {α : Type u_1} [has_repr α] : has_repr (multiset α) :=
  has_repr.mk
    fun (s : multiset α) =>
      string.str string.empty (char.of_nat (bit1 (bit1 (bit0 (bit1 (bit1 (bit1 1))))))) ++
          string.intercalate
            (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit1 (bit1 (bit0 1)))))))
              (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
            (sort LessEq (map repr s)) ++
        string.str string.empty (char.of_nat (bit1 (bit0 (bit1 (bit1 (bit1 (bit1 1)))))))


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

import data.nat.basic algebra.group data.real.cau_seq tactic.ring data.nat.choose algebra.archimedean

open nat is_absolute_value
variables {α : Type*} {β : Type*}

def series [has_add α] (f : ℕ → α) : ℕ → α
| 0       := f 0
| (n + 1) := series n + f (n + 1)

def sum_between [has_add α] (f : ℕ → α) (n m : ℕ) := series (λ k, f (k + n)) (m - n)

@[simp] lemma series_zero [has_add α] (f : ℕ → α) : series f 0 = f 0 := by unfold series

lemma series_succ [has_add α] (f : ℕ → α) (n : ℕ) : series f (succ n) = series f n + f (succ n):= by unfold series

lemma series_eq_finset_sum [add_comm_monoid α] (f : ℕ → α) (n : ℕ) : series f n = finset.sum (finset.range (succ n)) f := begin
  induction n with n' hi,
  simp!,rw [finset.range_succ,series_succ],
  have : succ n' ∉ (finset.range (succ n')) := by {rw finset.mem_range,
  exact lt_irrefl _},
  rw [finset.sum_insert this,hi,add_comm],
end

lemma series_succ₁ [add_comm_monoid α] (f : ℕ → α) (i : ℕ) : series f (succ i) = f 0 + series (λ i, f (succ i)) i := begin
 induction i with i' hi,
 refl,
 rw [series_succ, hi, series_succ, add_assoc],
end

lemma series_comm [add_comm_monoid α] (f : ℕ → α) (n : ℕ) : series f n = series (λ i, f (n - i)) n := begin
  induction n with n' hi,
  simp!,simp!,rw hi,
  have : (λ (i : ℕ), f (succ n' - i)) (succ n') = f (n' - n'),simp,
  rw ←this,have : (λ (i : ℕ), f (succ n' - i)) (succ n') + series (λ (i : ℕ), f (succ n' - i)) n' = series (λ (i : ℕ), f (succ n' - i)) (succ n'),simp!,
  rw this,
  have : (λ i, f (n' - i)) = (λ i, f (succ n' - succ i)) := by
   {apply funext,assume i,rw succ_sub_succ},
  rw this,clear this,
  have : f (succ n') = (λ (i : ℕ), f (succ n' - i)) 0,simp,rw this,rw ←series_succ₁,
end

lemma series_neg [ring α] (f : ℕ → α) (n : ℕ) : -series f n = series (λ m, -f m) n := begin
  induction n with n' hi, simp!,simp![hi],
end

lemma series_sub_series [ring α] (f : ℕ → α) {i j : ℕ} : i < j → series f j - series f i
= series (λ (k : ℕ), f (k + (i + 1))) (j - (i + 1)) := begin
  assume ij,
  induction i with i' hi,
  cases j with j',exact absurd ij dec_trivial,
  rw sub_eq_iff_eq_add',
  exact series_succ₁  _ _,
  rw [series_succ,sub_add_eq_sub_sub,hi (lt_of_succ_lt ij),sub_eq_iff_eq_add'],
  have : (j - (i' + 1)) = succ (j - (succ i' + 1)) := by
    {rw [←nat.succ_sub ij,succ_sub_succ]},
  rw this,
  have : f (succ i') = (λ (k : ℕ), f (k + (i' + 1))) 0 := by simp,
  rw this,simp[succ_add,add_succ],
  rw series_succ₁,simp,
end

lemma series_const_zero [has_zero α] (i : ℕ): series (λ j, 0) i = 0 := begin
  induction i with i' hi,simp,simpa [series_succ],
end

lemma series_add [add_comm_monoid α] (f g : ℕ → α) (n : ℕ) : series (λ i, f i + g i) n = series f n + series g n := begin
  induction n with n' hi,simp[series_zero],simp[series_succ,hi],
end

lemma series_mul_left [semiring α] (f : ℕ → α) (a : α) (n : ℕ) : series (λ i, a * f i) n = a * series f n := begin
  induction n with n' hi,simp[series_zero],simp[series_succ,hi,mul_add],
end

lemma series_mul_right [semiring α] (f : ℕ → α) (a : α) (n : ℕ) : series (λ i, f i * a) n = series f n * a:= begin
  induction n with n' hi,simp[series_zero],simp[series_succ,hi,add_mul],
end

lemma abv_series_le_series_abv [discrete_linear_ordered_field α] [ring β] {f : ℕ → β}
{abv : β → α} [is_absolute_value abv] (n : ℕ) : abv (series f n) ≤ series (λ i, abv (f i)) n := begin
  induction n with n' hi,
  simp,simp[series_succ],
  exact le_trans (abv_add _ _ _) (add_le_add_left hi _),
end

lemma series_mul_series [semiring α] (f g : ℕ → α) (n m : ℕ) : series f n * series g m
= series (λ i, f i * series g m) n := begin
  induction n with n' hi,
  simp,simp[series_succ,mul_add,add_mul,hi],
end

lemma series_le_series [ordered_cancel_comm_monoid α] {f g : ℕ → α} {n : ℕ} : (∀ m ≤ n, f m ≤ g m) →
series f n ≤ series g n := begin
  assume h,induction n with n' hi,exact h 0 (le_refl _),
  unfold series,exact add_le_add (hi (λ m hm, h m (le_succ_of_le hm))) (h _ (le_refl _)),
end

lemma series_lt_series [ordered_cancel_comm_monoid α] {f g : ℕ → α} {n : ℕ} : (∀ m ≤ n, f m < g m) →
series f n < series g n := begin
  assume h,induction n with n' hi,exact h 0 (le_refl _),
  unfold series,exact add_lt_add (hi (λ m hm, h m (le_succ_of_le hm))) (h _ (le_refl _)),
end

lemma series_congr [has_add α] {f g : ℕ → α} {i : ℕ} : (∀ j ≤ i, f j = g j) → series f i = series g i := begin
  assume h,induction i with i' hi,exact h 0 (zero_le _),
  unfold series,rw h _ (le_refl (succ i')),
  rw hi (λ j ji, h j (le_succ_of_le ji)),
end

lemma series_nonneg [ordered_cancel_comm_monoid α] {f : ℕ → α} {n : ℕ} : (∀ m ≤ n, 0 ≤ f m) → 0 ≤ series f n := begin
  induction n with n' hi,simp,assume h,exact h 0 (le_refl _),
  assume h,unfold series,refine add_nonneg (hi (λ m hm, h m (le_succ_of_le hm))) (h _ (le_refl _)),
end

lemma series_pos [ordered_cancel_comm_monoid α] {f : ℕ → α} {n : ℕ} : (∀ m ≤ n, 0 < f m) → 0 < series f n := begin
  induction n with n' hi,simp,assume h,exact h 0 (le_refl _),
  assume h,unfold series,refine add_pos (hi (λ m hm, h m (le_succ_of_le hm))) (h _ (le_refl _)),
end

-- proof that two different ways of representing a sum across a 2D plane are equal, used
-- in proof of exp (x + y) = exp x * exp y
lemma series_series_diag_flip [add_comm_monoid α] (f : ℕ → ℕ → α) (n : ℕ) : series (λ i,
series (λ k, f k (i - k)) i) n = series (λ i, series (λ k, f i k) (n - i)) n := begin
  have : ∀ m : ℕ, m ≤ n → series (λ (i : ℕ), series (λ k, f k (i - k)) (min m i)) n =
  series (λ i, series (λ k, f i k) (n - i)) m := by
  { assume m mn, induction m with m' hi,
    simp[series_succ,series_zero,mul_add,max_eq_left (zero_le n)],
    simp only [series_succ _ m'],rw ←hi (le_of_succ_le mn),clear hi,
    induction n with n' hi,
    simp[series_succ],exact absurd mn dec_trivial,cases n' with n₂,
    simp [series_succ],rw [min_eq_left mn,series_succ,min_eq_left (le_of_succ_le mn)],
    rw eq_zero_of_le_zero (le_of_succ_le_succ mn),simp,
    cases lt_or_eq_of_le mn,
    simp [series_succ _ (succ n₂),min_eq_left mn,hi (le_of_lt_succ h)],rw [←add_assoc,←add_assoc],
    suffices : series (f (succ m')) (n₂ - m') + series (λ (k : ℕ), f k (succ (succ n₂) - k)) (succ m')
    = series (f (succ m')) (succ n₂ - m') +
        series (λ (k : ℕ), f k (succ (succ n₂) - k)) (min m' (succ (succ n₂))),
      rw this,rw[min_eq_left (le_of_succ_le mn),series_succ,succ_sub_succ,succ_sub (le_of_succ_le_succ (le_of_lt_succ h)),series_succ],
      rw [add_comm (series (λ (k : ℕ), f k (succ (succ n₂) - k)) m'),add_assoc],
    rw ←h,simp[nat.sub_self],clear hi mn h,simp[series_succ,nat.sub_self],
    suffices : series (λ (i : ℕ), series (λ (k : ℕ), f k (i - k)) (min (succ m') i)) m' = series (λ (i : ℕ), series (λ (k : ℕ), f k (i - k)) (min m' i)) m',
      rw [this,min_eq_left (le_succ _)],clear n₂,
    have h₁ : ∀ i ≤ m', (λ (i : ℕ), series (λ (k : ℕ), f k (i - k)) (min (succ m') i)) i = (λ (i : ℕ), series (λ (k : ℕ), f k (i - k)) (min m' i)) i,
      assume i im,simp, rw [min_eq_right im,min_eq_right (le_succ_of_le im)],
    rw series_congr h₁},
  specialize this n (le_refl _),
  rw ←this,refine series_congr _,assume i ni,rw min_eq_right ni,
end

open monoid

theorem series_binomial {α : Type*} [comm_semiring α] (x y : α) (i : ℕ) : pow (x + y) i =
series (λ j, choose i j * pow x j * pow y (i - j)) i := begin
  induction i with i' hi,
  simp!,unfold monoid.pow,rw hi,
  rw [←series_mul_left],
  have : ∀ j : ℕ, j ≤ i' → (λ (i : ℕ), (x + y) * (↑(choose i' i) * pow x i * pow y (i' - i))) j
  = choose i' j * pow x (succ j) * pow y (i' - j) + choose i' j * pow x j * pow y (succ i' - j) := by
  { assume j ji,dsimp only,rw add_mul,
    have :  x * (↑(choose i' j) * pow x j * pow y (i' - j)) + y * (↑(choose i' j) * pow x j * pow y (i' - j))
    = ↑(choose i' j) * (x * pow x j) * pow y (i' - j) + ↑(choose i' j) * pow x j * (y * pow y (i' - j)),
      simp[mul_comm,_root_.mul_assoc,mul_left_comm],
    rw [this,←_root_.pow_succ,←_root_.pow_succ,succ_sub ji]},
  rw [series_congr this],clear this,
  clear hi,rw series_add,
  have : series (λ (i : ℕ), ↑(choose i' i) * pow x i * pow y (succ i' - i)) i' =
      series (λ (i : ℕ), ↑(choose i' i) * pow x i * pow y (succ i' - i)) (succ i') := by
  { simp[series_succ],},
  rw [this,series_succ₁,series_succ₁],
  simp[nat.sub_self],rw ←series_add,
  refine congr_arg _ (series_congr _),
  assume j ji,unfold choose,rw [nat.cast_add,add_mul,add_mul],
end

lemma geo_series_eq {α : Type*} [field α] (x : α) (n : ℕ) : x ≠ 1 → series (pow x) n = (1 - pow x (succ n)) / (1 - x) := begin
  assume x1,have x1' : 1 + -x ≠ 0,assume h,rw [eq_comm, ←sub_eq_iff_eq_add] at h,simp at h,trivial,
  induction n with n' hi,
  {simp![div_self x1']},
  {rw eq_div_iff_mul_eq,simpa,
  rw [_root_.series_succ,_root_.pow_succ _ (succ n')],
  rw hi,simp,rw [add_mul,div_mul_cancel _ x1',mul_add],ring,exact x1'},
end

lemma is_cau_geo_series {α : Type*} [discrete_linear_ordered_field α] [archimedean α] (x : α) :
abs x < 1 → is_cau_seq abs (series (pow x)) := begin
  assume x1, have : series (pow x) = λ n,(1 - pow x (succ n)) / (1 - x),
    apply funext,assume n,refine geo_series_eq x n _ ,assume h, rw h at x1,exact absurd x1 (by norm_num),rw this,
  have absx : 0 < abs (1 - x),refine abs_pos_of_ne_zero _,assume h,rw sub_eq_zero_iff_eq at h,rw ←h at x1,
  have : ¬abs (1 : α) < 1,norm_num,trivial,simp at absx,
  cases classical.em (x = 0),rw h,simp[monoid.pow],assume ε ε0,existsi 1,assume j j1,simpa!,
  have x2: 1 < (abs x)⁻¹,rw lt_inv,simpa,{norm_num},exact abs_pos_of_ne_zero h,
  have pos_x : 0 < abs x := abs_pos_of_ne_zero h,
  assume ε ε0,
  cases pow_unbounded_of_gt_one (2 / (ε * abs (1 - x))) x2 with i hi,
  have ε2 : 0 < 2 / (ε * abs (1 - x)) := div_pos (by norm_num) (mul_pos ε0 absx),
  rw [pow_inv,lt_inv ε2 (pow_pos pos_x _)] at hi,
  existsi i,assume j ji,rw [inv_eq_one_div,div_div_eq_mul_div,_root_.one_mul,lt_div_iff (by norm_num : (0 : α) < 2)] at hi,
  rw [div_sub_div_same,abs_div,div_lt_iff absx],
  refine lt_of_le_of_lt _ hi,
  simp,
  refine le_trans (abs_add _ _) _,
  have : pow (abs x) i * 2 = pow (abs x) i + pow (abs x) i,ring,
  rw this,
  refine add_le_add _ _,
  {rw [←_root_.one_mul (pow (abs x) i),pow_abs,_root_.pow_succ,abs_mul],
  exact mul_le_mul_of_nonneg_right (le_of_lt x1) (abs_nonneg _)},
  {rw [abs_neg,←pow_abs],
  rw [←inv_le_inv (pow_pos pos_x _) (pow_pos pos_x _),←pow_inv,←pow_inv],
  refine pow_le_pow (le_of_lt x2) (le_succ_of_le ji),}
end

lemma is_cau_geo_series_const {α : Type*} [discrete_linear_ordered_field α] [archimedean α] (a x : α) :
abs x < 1 → is_cau_seq abs (series (λ n, a * pow x n)) := begin
  assume x1 ε ε0,
  cases classical.em (a = 0),
  existsi 0,intros,rw [series_mul_left],induction j,simp!,assumption,rw h,simpa!,
  cases is_cau_geo_series x x1 (ε / abs a) (div_pos ε0 (abs_pos_of_ne_zero h)) with i hi,
  existsi i,assume j ji,rw [series_mul_left,series_mul_left,←mul_sub,abs_mul,mul_comm,←lt_div_iff],
  exact hi j ji,exact abs_pos_of_ne_zero h,
end

lemma is_cau_series_of_abv_le_cau {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β] {f : ℕ → β}
{g : ℕ → α} {abv : β → α} [is_absolute_value abv] (n : ℕ) : (∀ m, n ≤ m → abv (f m) ≤ g m) →
is_cau_seq abs (series g) → is_cau_seq abv (series f) := begin
  assume hm hg ε ε0,cases hg (ε / 2) (div_pos ε0 (by norm_num)) with i hi,
  existsi max n i,
  assume j ji,
  have hi₁ := hi j (le_trans (le_max_right n i) ji),
  have hi₂ := hi (max n i) (le_max_right n i),
  have sub_le := abs_sub_le (series g j) (series g i) (series g (max n i)),
  have := add_lt_add hi₁ hi₂,rw abs_sub (series g (max n i)) at this,
  have ε2 : ε / 2 + ε / 2 = ε,ring,
  rw ε2 at this,
  refine lt_of_le_of_lt _ this,
  refine le_trans _ sub_le,
  refine le_trans _ (le_abs_self _),
  generalize hk : j - max n i = k,clear this ε2 hi₂ hi₁ hi ε0 ε hg sub_le,
  rw nat.sub_eq_iff_eq_add ji at hk,rw hk, clear hk ji j,
  induction k with k' hi,simp,rw abv_zero abv,
  rw succ_add,unfold series,
  rw [add_comm,add_sub_assoc],
  refine le_trans (abv_add _ _ _) _,
  rw [add_comm (series g (k' + max n i)),add_sub_assoc],
  refine add_le_add _ _,
  refine hm _ _,rw [←zero_add n,←succ_add],refine add_le_add _ _,exact zero_le _,
  simp, exact le_max_left _ _,assumption,
end

-- The form of ratio test with  0 ≤ r < 1, and abv (f (succ m)) ≤ r * abv (f m) handled zero terms of series the best
lemma series_ratio_test {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β]
[archimedean α] {abv : β → α} [is_absolute_value abv] {f : ℕ → β} (n : ℕ) (r : α) :
0 ≤ r → r < 1 → (∀ m, n ≤ m → abv (f (succ m)) ≤ r * abv (f m)) → is_cau_seq abv (series f)
  := begin
  assume r0 r1 h,
  refine is_cau_series_of_abv_le_cau (succ n) _ (is_cau_geo_series_const (abv (f (succ n)) * pow r⁻¹ (succ n)) r _),
  assume m mn,
  generalize hk : m - (succ n) = k,rw nat.sub_eq_iff_eq_add mn at hk,
  cases classical.em (r = 0) with r_zero r_pos,have m_pos := lt_of_lt_of_le (succ_pos n) mn,
  have := pred_le_pred mn,simp at this,
  have := h (pred m) this,simp[r_zero,succ_pred_eq_of_pos m_pos] at this,
  refine le_trans this _,refine mul_nonneg _ _,refine mul_nonneg (abv_nonneg _ _) (pow_nonneg (inv_nonneg.mpr r0) _),exact pow_nonneg r0 _,
  replace r_pos : 0 < r,cases lt_or_eq_of_le r0 with h h,exact h,exact absurd h.symm r_pos,
  revert m n,
  induction k with k' hi,assume m n h mn hk,
  rw [hk,zero_add,mul_right_comm,←pow_inv _ _ (ne_of_lt r_pos).symm,←div_eq_mul_inv,mul_div_cancel],
  exact (ne_of_lt (pow_pos r_pos _)).symm,
  assume m n h mn hk,rw [hk,succ_add],
  have kn : k' + (succ n) ≥ (succ n), rw ←zero_add (succ n),refine add_le_add _ _,exact zero_le _,simp,
  replace hi := hi (k' + (succ n)) n h kn rfl,
  rw [(by simp!;ring : pow r (succ (k' + succ n)) = pow r (k' + succ n) * r),←_root_.mul_assoc],
  replace h := h (k' + succ n) (le_of_succ_le kn),rw mul_comm at h,
  exact le_trans h (mul_le_mul_of_nonneg_right hi r0),
  rwa abs_of_nonneg r0,
end

lemma series_cau_of_abv_cau {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β] {abv : β → α} {f : ℕ → β}
[is_absolute_value abv] : is_cau_seq abs (series (λ n, abv (f n))) → is_cau_seq abv (series f) :=
   λ h, is_cau_series_of_abv_le_cau 0 (λ n h, le_refl _) h

-- I did not use the equivalent function on cauchy sequences as I do not have a proof
-- series (λ n, series (λ m, a m * b (n - m)) n) j) is a cauchy sequence. Using this lemma
-- and of_near, this can be proven to be a cauchy sequence
lemma series_cauchy_prod {α β : Type*} [discrete_linear_ordered_field α] [ring β] {a b : ℕ → β}
{abv : β → α} [is_absolute_value abv] : is_cau_seq abs (series (λ n, abv (a n))) → is_cau_seq abv (series b) →
∀ ε : α, 0 < ε → ∃ i : ℕ, ∀ j ≥ i, abv (series a j * series b j - series (λ n,
series (λ m, a m * b (n - m)) n) j) < ε := begin
-- slightly adapted version of theorem 9.4.7 from "The Real Numbers and Real Analysis", Ethan D. Bloch
  assume ha hb ε ε0,
  cases cau_seq.bounded ⟨_, hb⟩ with Q hQ,simp at hQ,
  cases cau_seq.bounded ⟨_, ha⟩ with P hP,simp at hP,
  have P0 : 0 < P,exact lt_of_le_of_lt (abs_nonneg _) (hP 0),
  have Pε0 := div_pos ε0 (mul_pos (show (2 : α) > 0, from by norm_num) P0),
  cases cau_seq.cauchy₂ ⟨_, hb⟩ Pε0 with N hN,simp at hN,
  have Qε0 := div_pos ε0 (mul_pos (show (4 : α) > 0, from by norm_num) (lt_of_le_of_lt (abv_nonneg _ _) (hQ 0))),
  cases cau_seq.cauchy₂ ⟨_, ha⟩ Qε0 with M hM,simp at hM,
  existsi 2 * (max N M + 1),
  assume K hK,have := series_series_diag_flip (λ m n, a m * b n) K,simp at this,rw this,clear this,
  have : (λ (i : ℕ), series (λ (k : ℕ), a i * b k) (K - i)) = (λ (i : ℕ), a i * series (λ (k : ℕ), b k) (K - i)) := by
    {apply funext,assume i,rw series_mul_left},
  rw this,clear this,simp,
  have : series (λ (i : ℕ), a i * series b (K - i)) K = series (λ (i : ℕ), a i * (series b (K - i) - series b K))
  K + series (λ i, a i * series b K) K,
    {rw ←series_add,simp[(mul_add _ _ _).symm]},
  rw this, clear this,
  rw series_mul_series,simp,
  rw abv_neg abv,
  refine lt_of_le_of_lt (abv_series_le_series_abv _) _,
  simp [abv_mul abv],
  suffices : series (λ (i : ℕ), abv (a i) * abv (series b (K - i) + -series b K)) (max N M + 1) +
  (series (λ (i : ℕ), abv (a i) * abv (series b (K - i) + -series b K)) K -series (λ (i : ℕ),
  abv (a i) * abv (series b (K - i) + -series b K)) (max N M + 1)) < ε / (2 * P) * P + ε / (4 * Q) * (2 * Q),
  { simp [(div_div_eq_div_mul _ _ _).symm] at this,
    rwa[div_mul_cancel _ (ne_of_lt P0).symm,(by norm_num : (4 : α) = 2 * 2),←div_div_eq_div_mul,mul_comm (2 : α),←_root_.mul_assoc,
    div_mul_cancel _ (ne_of_lt (lt_of_le_of_lt (abv_nonneg _ _) (hQ 0))).symm,div_mul_cancel,add_halves] at this,
    norm_num},
  refine add_lt_add _ _,
  {have : series (λ (i : ℕ), abv (a i) * abv (series b (K - i) + -series b K)) (max N M + 1) ≤ series
  (λ (i : ℕ), abv (a i) * (ε / (2 * P))) (max N M + 1) := by
    {refine series_le_series _,assume m mJ,refine mul_le_mul_of_nonneg_left _ _,
      {refine le_of_lt (hN (K - m) K _ _),{
      refine nat.le_sub_left_of_add_le (le_trans _ hK),
      rw[succ_mul,_root_.one_mul],
      exact add_le_add mJ (le_trans (le_max_left _ _) (le_of_lt (lt_add_one _)))},
      {refine le_trans _ hK,rw ←_root_.one_mul N,
      refine mul_le_mul (by norm_num) (by rw _root_.one_mul;exact le_trans (le_max_left _ _)
      (le_of_lt (lt_add_one _))) (zero_le _) (zero_le _)}},
      exact abv_nonneg abv _},
  refine lt_of_le_of_lt this _,
  rw [series_mul_right,mul_comm],
  specialize hP (max N M + 1),rwa abs_of_nonneg at hP,
  exact (mul_lt_mul_left Pε0).mpr hP,
  exact series_nonneg (λ x h, abv_nonneg abv _)},
  {have hNMK : max N M + 1 < K := by
    {refine lt_of_lt_of_le _ hK,
    rw [succ_mul,_root_.one_mul,←add_zero (max N M + 1)],
    refine add_lt_add_of_le_of_lt (le_refl _) _,rw add_zero,
    refine add_pos_of_nonneg_of_pos (zero_le _) (by norm_num)},
  rw series_sub_series _ hNMK,
  have : series (λ (k : ℕ), abv (a (k + (max N M + 1 + 1))) * abv
  (series b (K - (k + (max N M + 1 + 1))) + -series b K)) (K - (max N M + 1 + 1)) ≤
  series (λ (k : ℕ), abv (a (k + (max N M + 1 + 1))) * (2 * Q)) (K - (max N M + 1 + 1)) := by
    {refine series_le_series _,
    assume m hm,
    refine mul_le_mul_of_nonneg_left _ _,
    {refine le_trans (abv_add abv _ _) _,
    rw (by ring : 2 * Q = Q + Q),
    refine add_le_add (le_of_lt (hQ _)) _,
    rw abv_neg abv, exact le_of_lt (hQ _)},
    exact abv_nonneg abv _},
  refine lt_of_le_of_lt this _,
  rw [series_mul_right],
  refine (mul_lt_mul_right (mul_pos (by norm_num) (lt_of_le_of_lt (abv_nonneg abv _) (hQ 0)))).mpr _,
  refine lt_of_le_of_lt (le_abs_self _) _,
  rw[←@series_sub_series _ _ (λ k, abv (a k)) (max N M + 1) K hNMK],
  refine hM _ _ _ (le_trans (le_max_right _ _) (le_of_lt (lt_add_one _))),
  refine le_trans _ hK,
  rw [succ_mul,_root_.one_mul,←add_zero M],
  exact add_le_add (le_trans (le_max_right _ _) (le_of_lt (lt_add_one _))) (zero_le _)},
end


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

/-
Linear integer arithmetic formulas in pre-normalized form.
-/

import tactic.omega.int.preterm

namespace omega
namespace int

/-- Intermediate shadow syntax for LNA formulas that includes unreified exprs -/
meta inductive exprform
| eq  : exprterm → exprterm → exprform
| le  : exprterm → exprterm → exprform
| not : exprform → exprform
| or  : exprform → exprform → exprform
| and : exprform → exprform → exprform

/-- Intermediate shadow syntax for LIA formulas that includes non-canonical terms -/
@[derive has_reflect, derive inhabited]
inductive preform
| eq  : preterm → preterm → preform
| le  : preterm → preterm → preform
| not : preform → preform
| or  : preform → preform → preform
| and : preform → preform → preform

localized "notation x ` =* ` y := omega.int.preform.eq x y" in omega.int
localized "notation x ` ≤* ` y := omega.int.preform.le x y" in omega.int
localized "notation `¬* ` p   := omega.int.preform.not p" in omega.int
localized "notation p ` ∨* ` q := omega.int.preform.or p q" in omega.int
localized "notation p ` ∧* ` q := omega.int.preform.and p q" in omega.int

namespace preform

/-- Evaluate a preform into prop using the valuation v. -/
@[simp] def holds (v : nat → int) : preform → Prop
| (t =* s) := t.val v = s.val v
| (t ≤* s) := t.val v ≤ s.val v
| (¬* p)   := ¬ p.holds
| (p ∨* q) := p.holds ∨ q.holds
| (p ∧* q) := p.holds ∧ q.holds

end preform

/-- univ_close p n := p closed by prepending n universal quantifiers -/
@[simp] def univ_close (p : preform) : (nat → int) → nat → Prop
| v 0     := p.holds v
| v (k+1) := ∀ i : int, univ_close (update_zero i v) k

namespace preform

/-- Fresh de Brujin index not used by any variable in argument -/
def fresh_index : preform → nat
| (t =* s) := max t.fresh_index s.fresh_index
| (t ≤* s) := max t.fresh_index s.fresh_index
| (¬* p)   := p.fresh_index
| (p ∨* q) := max p.fresh_index q.fresh_index
| (p ∧* q) := max p.fresh_index q.fresh_index

/-- All valuations satisfy argument -/
def valid (p : preform) : Prop :=
∀ v, holds v p

/-- There exists some valuation that satisfies argument -/
def sat (p : preform) : Prop :=
∃ v, holds v p

/-- implies p q := under any valuation, q holds if p holds -/
def implies (p q : preform) : Prop :=
∀ v, (holds v p → holds v q)

/-- equiv p q := under any valuation, p holds iff q holds -/
def equiv (p q : preform) : Prop :=
∀ v, (holds v p ↔ holds v q)

lemma sat_of_implies_of_sat {p q : preform} :
  implies p q → sat p → sat q :=
begin intros h1 h2, apply exists_imp_exists h1 h2 end

lemma sat_or {p q : preform} :
  sat (p ∨* q) ↔ sat p ∨ sat q :=
begin
  constructor; intro h1,
  { cases h1 with v h1, cases h1 with h1 h1;
    [left,right]; refine ⟨v,_⟩; assumption },
  { cases h1 with h1 h1; cases h1 with v h1;
    refine ⟨v,_⟩; [left,right]; assumption }
end

/-- There does not exist any valuation that satisfies argument -/
def unsat (p : preform) : Prop := ¬ sat p

def repr : preform → string
| (t =* s) := "(" ++ t.repr ++ " = " ++ s.repr ++ ")"
| (t ≤* s) := "(" ++ t.repr ++ " ≤ " ++ s.repr ++ ")"
| (¬* p)   := "¬" ++ p.repr
| (p ∨* q) := "(" ++ p.repr ++ " ∨ " ++ q.repr ++ ")"
| (p ∧* q) := "(" ++ p.repr ++ " ∧ " ++ q.repr ++ ")"

instance has_repr : has_repr preform := ⟨repr⟩
meta instance has_to_format : has_to_format preform := ⟨λ x, x.repr⟩

end preform

lemma univ_close_of_valid {p : preform} :
  ∀ {m v}, p.valid → univ_close p v m
| 0 v h1     := h1 _
| (m+1) v h1 := λ i, univ_close_of_valid h1

lemma valid_of_unsat_not {p : preform} : (¬*p).unsat → p.valid :=
begin
  simp only [preform.sat, preform.unsat, preform.valid, preform.holds],
  rw not_exists_not, intro h, assumption
end

/-- Tactic for setting up proof by induction over preforms. -/
meta def preform.induce (t : tactic unit := tactic.skip) : tactic unit :=
`[ intro p, induction p with t s t s p ih p q ihp ihq p q ihp ihq; t]

end int

end omega


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import topology.metric_space.basic
import topology.algebra.uniform_group
import topology.algebra.ring
import ring_theory.subring.basic
import group_theory.archimedean
import algebra.periodic
import order.filter.archimedean
import topology.instances.int

/-!
# Topological properties of ℝ
-/

noncomputable theory
open classical filter int metric set topological_space
open_locale classical topological_space filter uniformity interval

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

instance : noncompact_space ℝ := int.closed_embedding_coe_real.noncompact_space

theorem real.uniform_continuous_add : uniform_continuous (λp : ℝ × ℝ, p.1 + p.2) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_add_continuous_lemma abs ε0 in
⟨δ, δ0, λ a b h, let ⟨h₁, h₂⟩ := max_lt_iff.1 h in Hδ h₁ h₂⟩

theorem real.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℝ _) :=
metric.uniform_continuous_iff.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
  by rw dist_comm at h; simpa [real.dist_eq] using h⟩

instance : uniform_add_group ℝ :=
uniform_add_group.mk' real.uniform_continuous_add real.uniform_continuous_neg

 -- short-circuit type class inference
instance : topological_add_group ℝ := by apply_instance

instance : proper_space ℝ :=
{ is_compact_closed_ball := λx r, by { rw real.closed_ball_eq_Icc, apply is_compact_Icc } }

instance : second_countable_topology ℝ := second_countable_of_proper

lemma real.is_topological_basis_Ioo_rat :
  @is_topological_basis ℝ _ (⋃(a b : ℚ) (h : a < b), {Ioo a b}) :=
is_topological_basis_of_open_of_nhds
  (by simp [is_open_Ioo] {contextual:=tt})
  (assume a v hav hv,
    let ⟨l, u, ⟨hl, hu⟩, h⟩ := mem_nhds_iff_exists_Ioo_subset.mp (is_open.mem_nhds hv hav),
        ⟨q, hlq, hqa⟩ := exists_rat_btwn hl,
        ⟨p, hap, hpu⟩ := exists_rat_btwn hu in
    ⟨Ioo q p,
      by { simp only [mem_Union], exact ⟨q, p, rat.cast_lt.1 $ hqa.trans hap, rfl⟩ },
      ⟨hqa, hap⟩, assume a' ⟨hqa', ha'p⟩, h ⟨hlq.trans hqa', ha'p.trans hpu⟩⟩)

@[simp] lemma real.cocompact_eq : cocompact ℝ = at_bot ⊔ at_top :=
by simp only [← comap_dist_right_at_top_eq_cocompact (0 : ℝ), real.dist_eq, sub_zero,
  comap_abs_at_top]

/- TODO(Mario): Prove that these are uniform isomorphisms instead of uniform embeddings
lemma uniform_embedding_add_rat {r : ℚ} : uniform_embedding (λp:ℚ, p + r) :=
_

lemma uniform_embedding_mul_rat {q : ℚ} (hq : q ≠ 0) : uniform_embedding ((*) q) :=
_ -/

lemma real.mem_closure_iff {s : set ℝ} {x : ℝ} :
  x ∈ closure s ↔ ∀ ε > 0, ∃ y ∈ s, |y - x| < ε :=
by simp [mem_closure_iff_nhds_basis nhds_basis_ball, real.dist_eq]

lemma real.uniform_continuous_inv (s : set ℝ) {r : ℝ} (r0 : 0 < r) (H : ∀ x ∈ s, r ≤ |x|) :
  uniform_continuous (λp:s, p.1⁻¹) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_inv_continuous_lemma abs ε0 r0 in
⟨δ, δ0, λ a b h, Hδ (H _ a.2) (H _ b.2) h⟩

lemma real.uniform_continuous_abs : uniform_continuous (abs : ℝ → ℝ) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
  ⟨ε, ε0, λ a b, lt_of_le_of_lt (abs_abs_sub_abs_le_abs_sub _ _)⟩

lemma real.tendsto_inv {r : ℝ} (r0 : r ≠ 0) : tendsto (λq, q⁻¹) (𝓝 r) (𝓝 r⁻¹) :=
by rw ← abs_pos at r0; exact
tendsto_of_uniform_continuous_subtype
  (real.uniform_continuous_inv {x | |r| / 2 < |x|} (half_pos r0) (λ x h, le_of_lt h))
  (is_open.mem_nhds ((is_open_lt' (|r| / 2)).preimage continuous_abs) (half_lt_self r0))

lemma real.continuous_inv : continuous (λa:{r:ℝ // r ≠ 0}, a.val⁻¹) :=
continuous_iff_continuous_at.mpr $ assume ⟨r, hr⟩,
  tendsto.comp (real.tendsto_inv hr) (continuous_iff_continuous_at.mp continuous_subtype_val _)

lemma real.continuous.inv [topological_space α] {f : α → ℝ} (h : ∀a, f a ≠ 0) (hf : continuous f) :
  continuous (λa, (f a)⁻¹) :=
show continuous ((has_inv.inv ∘ @subtype.val ℝ (λr, r ≠ 0)) ∘ λa, ⟨f a, h a⟩),
  from real.continuous_inv.comp (continuous_subtype_mk _ hf)

lemma real.uniform_continuous_mul_const {x : ℝ} : uniform_continuous ((*) x) :=
metric.uniform_continuous_iff.2 $ λ ε ε0, begin
  cases exists_gt (|x|) with y xy,
  have y0 := lt_of_le_of_lt (abs_nonneg _) xy,
  refine ⟨_, div_pos ε0 y0, λ a b h, _⟩,
  rw [real.dist_eq, ← mul_sub, abs_mul, ← mul_div_cancel' ε (ne_of_gt y0)],
  exact mul_lt_mul' (le_of_lt xy) h (abs_nonneg _) y0
end

lemma real.uniform_continuous_mul (s : set (ℝ × ℝ))
  {r₁ r₂ : ℝ} (H : ∀ x ∈ s, |(x : ℝ × ℝ).1| < r₁ ∧ |x.2| < r₂) :
  uniform_continuous (λp:s, p.1.1 * p.1.2) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_mul_continuous_lemma abs ε0 in
⟨δ, δ0, λ a b h,
  let ⟨h₁, h₂⟩ := max_lt_iff.1 h in Hδ (H _ a.2).1 (H _ b.2).2 h₁ h₂⟩

protected lemma real.continuous_mul : continuous (λp : ℝ × ℝ, p.1 * p.2) :=
continuous_iff_continuous_at.2 $ λ ⟨a₁, a₂⟩,
tendsto_of_uniform_continuous_subtype
  (real.uniform_continuous_mul
    ({x | |x| < |a₁| + 1} ×ˢ {x | |x| < |a₂| + 1})
    (λ x, id))
  (is_open.mem_nhds
    (((is_open_gt' (|a₁| + 1)).preimage continuous_abs).prod
      ((is_open_gt' (|a₂| + 1)).preimage continuous_abs ))
    ⟨lt_add_one (|a₁|), lt_add_one (|a₂|)⟩)

instance : topological_ring ℝ :=
{ continuous_mul := real.continuous_mul, ..real.topological_add_group }

instance : complete_space ℝ :=
begin
  apply complete_of_cauchy_seq_tendsto,
  intros u hu,
  let c : cau_seq ℝ abs := ⟨u, metric.cauchy_seq_iff'.1 hu⟩,
  refine ⟨c.lim, λ s h, _⟩,
  rcases metric.mem_nhds_iff.1 h with ⟨ε, ε0, hε⟩,
  have := c.equiv_lim ε ε0,
  simp only [mem_map, mem_at_top_sets, mem_set_of_eq],
  refine this.imp (λ N hN n hn, hε (hN n hn))
end

lemma real.totally_bounded_ball (x ε : ℝ) : totally_bounded (ball x ε) :=
by rw real.ball_eq_Ioo; apply totally_bounded_Ioo

section

lemma closure_of_rat_image_lt {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q < x}) = {r | ↑q ≤ r} :=
subset.antisymm
  ((is_closed_ge' _).closure_subset_iff.2
    (image_subset_iff.2 $ λ p h, le_of_lt $ (@rat.cast_lt ℝ _ _ _).2 h)) $
λ x hx, mem_closure_iff_nhds.2 $ λ t ht,
let ⟨ε, ε0, hε⟩ := metric.mem_nhds_iff.1 ht in
let ⟨p, h₁, h₂⟩ := exists_rat_btwn ((lt_add_iff_pos_right x).2 ε0) in
⟨_, hε (show abs _ < _,
    by rwa [abs_of_nonneg (le_of_lt $ sub_pos.2 h₁), sub_lt_iff_lt_add']),
  p, rat.cast_lt.1 (@lt_of_le_of_lt ℝ _ _ _ _ hx h₁), rfl⟩

/- TODO(Mario): Put these back only if needed later
lemma closure_of_rat_image_le_eq {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q ≤ x}) = {r | ↑q ≤ r} :=
_

lemma closure_of_rat_image_le_le_eq {a b : ℚ} (hab : a ≤ b) :
  closure (of_rat '' {q:ℚ | a ≤ q ∧ q ≤ b}) = {r:ℝ | of_rat a ≤ r ∧ r ≤ of_rat b} :=
_-/

lemma real.bounded_iff_bdd_below_bdd_above {s : set ℝ} : bounded s ↔ bdd_below s ∧ bdd_above s :=
⟨begin
  assume bdd,
  rcases (bounded_iff_subset_ball 0).1 bdd with ⟨r, hr⟩, -- hr : s ⊆ closed_ball 0 r
  rw real.closed_ball_eq_Icc at hr, -- hr : s ⊆ Icc (0 - r) (0 + r)
  exact ⟨bdd_below_Icc.mono hr, bdd_above_Icc.mono hr⟩
end,
λ h, bounded_of_bdd_above_of_bdd_below h.2 h.1⟩

lemma real.subset_Icc_Inf_Sup_of_bounded {s : set ℝ} (h : bounded s) :
  s ⊆ Icc (Inf s) (Sup s) :=
subset_Icc_cInf_cSup (real.bounded_iff_bdd_below_bdd_above.1 h).1
  (real.bounded_iff_bdd_below_bdd_above.1 h).2

end

section periodic

namespace function

lemma periodic.compact_of_continuous' [topological_space α] {f : ℝ → α} {c : ℝ}
  (hp : periodic f c) (hc : 0 < c) (hf : continuous f) :
  is_compact (range f) :=
begin
  convert is_compact_Icc.image hf,
  ext x,
  refine ⟨_, mem_range_of_mem_image f (Icc 0 c)⟩,
  rintros ⟨y, h1⟩,
  obtain ⟨z, hz, h2⟩ := hp.exists_mem_Ico₀ hc y,
  exact ⟨z, mem_Icc_of_Ico hz, h2.symm.trans h1⟩,
end

/-- A continuous, periodic function has compact range. -/
lemma periodic.compact_of_continuous [topological_space α] {f : ℝ → α} {c : ℝ}
  (hp : periodic f c) (hc : c ≠ 0) (hf : continuous f) :
  is_compact (range f) :=
begin
  cases lt_or_gt_of_ne hc with hneg hpos,
  exacts [hp.neg.compact_of_continuous' (neg_pos.mpr hneg) hf, hp.compact_of_continuous' hpos hf],
end

/-- A continuous, periodic function is bounded. -/
lemma periodic.bounded_of_continuous [pseudo_metric_space α] {f : ℝ → α} {c : ℝ}
  (hp : periodic f c) (hc : c ≠ 0) (hf : continuous f) :
  bounded (range f) :=
(hp.compact_of_continuous hc hf).bounded

end function

end periodic

section subgroups

/-- Given a nontrivial subgroup `G ⊆ ℝ`, if `G ∩ ℝ_{>0}` has no minimum then `G` is dense. -/
lemma real.subgroup_dense_of_no_min {G : add_subgroup ℝ} {g₀ : ℝ} (g₀_in : g₀ ∈ G) (g₀_ne : g₀ ≠ 0)
  (H' : ¬ ∃ a : ℝ, is_least {g : ℝ | g ∈ G ∧ 0 < g} a) :
  dense (G : set ℝ) :=
begin
  let G_pos := {g : ℝ | g ∈ G ∧ 0 < g},
  push_neg at H',
  intros x,
  suffices : ∀ ε > (0 : ℝ), ∃ g ∈ G, |x - g| < ε,
    by simpa only [real.mem_closure_iff, abs_sub_comm],
  intros ε ε_pos,
  obtain ⟨g₁, g₁_in, g₁_pos⟩ : ∃ g₁ : ℝ, g₁ ∈ G ∧ 0 < g₁,
  { cases lt_or_gt_of_ne g₀_ne with Hg₀ Hg₀,
    { exact ⟨-g₀, G.neg_mem g₀_in, neg_pos.mpr Hg₀⟩ },
    { exact ⟨g₀, g₀_in, Hg₀⟩ } },
  obtain ⟨a, ha⟩ : ∃ a, is_glb G_pos a :=
    ⟨Inf G_pos, is_glb_cInf ⟨g₁, g₁_in, g₁_pos⟩ ⟨0, λ _ hx, le_of_lt hx.2⟩⟩,
  have a_notin : a ∉ G_pos,
  { intros H,
    exact H' a ⟨H, ha.1⟩ },
  obtain ⟨g₂, g₂_in, g₂_pos, g₂_lt⟩ : ∃ g₂ : ℝ, g₂ ∈ G ∧ 0 < g₂ ∧ g₂ < ε,
  { obtain ⟨b, hb, hb', hb''⟩ := ha.exists_between_self_add' a_notin ε_pos,
    obtain ⟨c, hc, hc', hc''⟩ := ha.exists_between_self_add' a_notin (sub_pos.2 hb'),
    refine ⟨b - c, G.sub_mem hb.1 hc.1, _, _⟩ ;
    linarith },
  refine ⟨floor (x/g₂) * g₂, _, _⟩,
  { exact add_subgroup.int_mul_mem _ g₂_in },
  { rw abs_of_nonneg (sub_floor_div_mul_nonneg x g₂_pos),
    linarith [sub_floor_div_mul_lt x g₂_pos] }
end

/-- Subgroups of `ℝ` are either dense or cyclic. See `real.subgroup_dense_of_no_min` and
`subgroup_cyclic_of_min` for more precise statements. -/
lemma real.subgroup_dense_or_cyclic (G : add_subgroup ℝ) :
  dense (G : set ℝ) ∨ ∃ a : ℝ, G = add_subgroup.closure {a} :=
begin
  cases add_subgroup.bot_or_exists_ne_zero G with H H,
  { right,
    use 0,
    rw [H, add_subgroup.closure_singleton_zero] },
  { let G_pos := {g : ℝ | g ∈ G ∧ 0 < g},
    by_cases H' : ∃ a, is_least G_pos a,
    { right,
      rcases H' with ⟨a, ha⟩,
      exact ⟨a, add_subgroup.cyclic_of_min ha⟩ },
    { left,
      rcases H with ⟨g₀, g₀_in, g₀_ne⟩,
      exact real.subgroup_dense_of_no_min g₀_in g₀_ne H' } }
end

end subgroups


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro
-/
import algebra.group_power
import tactic.subtype_instance

variables {α : Type*} [monoid α] {s : set α}
variables {β : Type*} [add_monoid β] {t : set β}

/-- `s` is a submonoid: a set containing 1 and closed under multiplication. -/
class is_submonoid (s : set α) : Prop :=
(one_mem : (1:α) ∈ s)
(mul_mem {a b} : a ∈ s → b ∈ s → a * b ∈ s)

/-- `s` is an additive submonoid: a set containing 0 and closed under addition. -/
class is_add_submonoid (s : set β) : Prop :=
(zero_mem : (0:β) ∈ s)
(add_mem {a b} : a ∈ s → b ∈ s → a + b ∈ s)

attribute [to_additive is_add_submonoid] is_submonoid
attribute [to_additive is_add_submonoid.zero_mem] is_submonoid.one_mem
attribute [to_additive is_add_submonoid.add_mem] is_submonoid.mul_mem
attribute [to_additive is_add_submonoid.mk] is_submonoid.mk

instance additive.is_add_submonoid
  (s : set α) : ∀ [is_submonoid s], @is_add_submonoid (additive α) _ s
| ⟨h₁, h₂⟩ := ⟨h₁, @h₂⟩

theorem additive.is_add_submonoid_iff
  {s : set α} : @is_add_submonoid (additive α) _ s ↔ is_submonoid s :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, @h₂⟩, λ h, by resetI; apply_instance⟩

instance multiplicative.is_submonoid
  (s : set β) : ∀ [is_add_submonoid s], @is_submonoid (multiplicative β) _ s
| ⟨h₁, h₂⟩ := ⟨h₁, @h₂⟩

theorem multiplicative.is_submonoid_iff
  {s : set β} : @is_submonoid (multiplicative β) _ s ↔ is_add_submonoid s :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, @h₂⟩, λ h, by resetI; apply_instance⟩

section powers

def powers (x : α) : set α := {y | ∃ n:ℕ, x^n = y}
def multiples (x : β) : set β := {y | ∃ n:ℕ, add_monoid.smul n x = y}
attribute [to_additive multiples] powers

instance powers.is_submonoid (x : α) : is_submonoid (powers x) :=
{ one_mem := ⟨0, by simp⟩,
  mul_mem := λ x₁ x₂ ⟨n₁, hn₁⟩ ⟨n₂, hn₂⟩, ⟨n₁ + n₂, by simp [pow_add, *]⟩ }

instance multiples.is_add_submonoid (x : β) : is_add_submonoid (multiples x) :=
multiplicative.is_submonoid_iff.1 $ powers.is_submonoid _
attribute [to_additive multiples.is_add_submonoid] powers.is_submonoid

lemma is_submonoid.pow_mem {a : α} [is_submonoid s] (h : a ∈ s) : ∀ {n : ℕ}, a ^ n ∈ s
| 0 := is_submonoid.one_mem s
| (n + 1) := is_submonoid.mul_mem h is_submonoid.pow_mem

lemma is_add_submonoid.smul_mem {a : β} [is_add_submonoid t] :
  ∀ (h : a ∈ t) {n : ℕ}, add_monoid.smul n a ∈ t :=
@is_submonoid.pow_mem (multiplicative β) _ _ _ _
attribute [to_additive is_add_submonoid.smul_mem] is_submonoid.pow_mem

lemma is_submonoid.power_subset {a : α} [is_submonoid s] (h : a ∈ s) : powers a ⊆ s :=
assume x ⟨n, hx⟩, hx ▸ is_submonoid.pow_mem h

lemma is_add_submonoid.multiple_subset {a : β} [is_add_submonoid t] :
  a ∈ t → multiples a ⊆ t :=
@is_submonoid.power_subset (multiplicative β) _ _ _ _
attribute [to_additive is_add_submonoid.multiple_subset] is_add_submonoid.multiple_subset

end powers

@[to_additive is_add_submonoid.list_sum_mem]
lemma is_submonoid.list_prod_mem [is_submonoid s] : ∀{l : list α}, (∀x∈l, x ∈ s) → l.prod ∈ s
| []     h := is_submonoid.one_mem s
| (a::l) h :=
  suffices a * l.prod ∈ s, by simpa,
  have a ∈ s ∧ (∀x∈l, x ∈ s), by simpa using h,
  is_submonoid.mul_mem this.1 (is_submonoid.list_prod_mem this.2)

instance subtype.monoid {s : set α} [is_submonoid s] : monoid s :=
by subtype_instance

attribute [to_additive subtype.add_monoid._proof_1] subtype.monoid._proof_1
attribute [to_additive subtype.add_monoid._proof_2] subtype.monoid._proof_2
attribute [to_additive subtype.add_monoid._proof_3] subtype.monoid._proof_3
attribute [to_additive subtype.add_monoid._proof_4] subtype.monoid._proof_4
attribute [to_additive subtype.add_monoid._proof_5] subtype.monoid._proof_5
attribute [to_additive subtype.add_monoid] subtype.monoid

namespace monoid

inductive in_closure (s : set α) : α → Prop
| basic {a : α} : a ∈ s → in_closure a
| one : in_closure 1
| mul {a b : α} : in_closure a → in_closure b → in_closure (a * b)

def closure (s : set α) : set α := {a | in_closure s a }

instance closure.is_submonoid (s : set α) : is_submonoid (closure s) :=
{ one_mem := in_closure.one s, mul_mem := assume a b, in_closure.mul }

theorem subset_closure {s : set α} : s ⊆ closure s :=
assume a, in_closure.basic

theorem closure_subset {s t : set α} [is_submonoid t] (h : s ⊆ t) : closure s ⊆ t :=
assume a ha, by induction ha; simp [h _, *, is_submonoid.one_mem, is_submonoid.mul_mem]

theorem exists_list_of_mem_closure {s : set α} {a : α} (h : a ∈ closure s) :
  (∃l:list α, (∀x∈l, x ∈ s) ∧ l.prod = a) :=
begin
  induction h,
  case in_closure.basic : a ha { existsi ([a]), simp [ha] },
  case in_closure.one { existsi ([]), simp },
  case in_closure.mul : a b _ _ ha hb {
    rcases ha with ⟨la, ha, eqa⟩,
    rcases hb with ⟨lb, hb, eqb⟩,
    existsi (la ++ lb),
    simp [eqa.symm, eqb.symm, or_imp_distrib],
    exact assume a, ⟨ha a, hb a⟩
  }
end

end monoid

namespace add_monoid

def closure (s : set β) : set β := @monoid.closure (multiplicative β) _ s

instance closure.is_add_submonoid (s : set β) : is_add_submonoid (closure s) :=
multiplicative.is_submonoid_iff.1 $ monoid.closure.is_submonoid s

theorem subset_closure {s : set β} : s ⊆ closure s :=
@monoid.subset_closure (multiplicative β) _ _

theorem closure_subset {s t : set β} [is_add_submonoid t] : s ⊆ t → closure s ⊆ t :=
@monoid.closure_subset (multiplicative β) _ _ _ _

theorem exists_list_of_mem_closure {s : set β} {a : β} :
  a ∈ closure s → ∃l:list β, (∀x∈l, x ∈ s) ∧ l.sum = a :=
@monoid.exists_list_of_mem_closure (multiplicative β) _ _ _

end add_monoid


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import analysis.normed_space.banach
import analysis.normed_space.finite_dimension
import analysis.calculus.affine_map
import analysis.convex.combination
import linear_algebra.affine_space.basis
import linear_algebra.affine_space.finite_dimensional

/-!
# Bases in normed affine spaces.

This file contains results about bases in normed affine spaces.

## Main definitions:

 * `continuous_barycentric_coord`
 * `is_open_map_barycentric_coord`
 * `interior_convex_hull_aff_basis`
 * `exists_subset_affine_independent_span_eq_top_of_open`
 * `interior_convex_hull_nonempty_iff_aff_span_eq_top`
-/

section barycentric

variables {ι 𝕜 E P : Type*} [nondiscrete_normed_field 𝕜] [complete_space 𝕜]
variables [normed_group E] [normed_space 𝕜 E] [finite_dimensional 𝕜 E]
variables [metric_space P] [normed_add_torsor E P]
variables (b : affine_basis ι 𝕜 P)

@[continuity]
lemma continuous_barycentric_coord (i : ι) : continuous (b.coord i) :=
(b.coord i).continuous_of_finite_dimensional

local attribute [instance] finite_dimensional.complete

lemma is_open_map_barycentric_coord [nontrivial ι] (i : ι) :
  is_open_map (b.coord i) :=
(b.coord i).is_open_map (continuous_barycentric_coord b i) (b.surjective_coord i)

lemma smooth_barycentric_coord (b : affine_basis ι 𝕜 E) (i : ι) : cont_diff 𝕜 ⊤ (b.coord i) :=
(⟨b.coord i, continuous_barycentric_coord b i⟩ : E →A[𝕜] 𝕜).cont_diff

end barycentric

open set

/-- Given a finite-dimensional normed real vector space, the interior of the convex hull of an
affine basis is the set of points whose barycentric coordinates are strictly positive with respect
to this basis.

TODO Restate this result for affine spaces (instead of vector spaces) once the definition of
convexity is generalised to this setting. -/
lemma interior_convex_hull_aff_basis {ι E : Type*} [fintype ι] [normed_group E] [normed_space ℝ E]
  (b : affine_basis ι ℝ E) :
  interior (convex_hull ℝ (range b.points)) = { x | ∀ i, 0 < b.coord i x } :=
begin
  casesI subsingleton_or_nontrivial ι,
  { -- The zero-dimensional case.
    suffices : range (b.points) = univ, { simp [this], },
    refine affine_subspace.eq_univ_of_subsingleton_span_eq_top _ b.tot,
    rw ← image_univ,
    exact subsingleton.image subsingleton_of_subsingleton b.points, },
  { -- The positive-dimensional case.
    haveI : finite_dimensional ℝ E,
    { classical,
      obtain ⟨i⟩ := (infer_instance : nonempty ι),
      exact finite_dimensional.of_fintype_basis (b.basis_of i), },
    have : convex_hull ℝ (range b.points) = ⋂ i, (b.coord i)⁻¹' Ici 0,
    { rw convex_hull_affine_basis_eq_nonneg_barycentric b, ext, simp, },
    ext,
    simp only [this, interior_Inter_of_fintype, ← is_open_map.preimage_interior_eq_interior_preimage
      (is_open_map_barycentric_coord b _) (continuous_barycentric_coord b _),
      interior_Ici, mem_Inter, mem_set_of_eq, mem_Ioi, mem_preimage], },
end

variables {V P : Type*} [normed_group V] [normed_space ℝ V] [metric_space P] [normed_add_torsor V P]
include V

open affine_map

/-- Given a set `s` of affine-independent points belonging to an open set `u`, we may extend `s` to
an affine basis, all of whose elements belong to `u`. -/
lemma exists_subset_affine_independent_span_eq_top_of_open {s u : set P} (hu : is_open u)
  (hsu : s ⊆ u) (hne : s.nonempty) (h : affine_independent ℝ (coe : s → P)) :
  ∃ t : set P, s ⊆ t ∧ t ⊆ u ∧ affine_independent ℝ (coe : t → P) ∧ affine_span ℝ t = ⊤ :=
begin
  obtain ⟨q, hq⟩ := hne,
  obtain ⟨ε, hε, hεu⟩ := metric.is_open_iff.mp hu q (hsu hq),
  obtain ⟨t, ht₁, ht₂, ht₃⟩ := exists_subset_affine_independent_affine_span_eq_top h,
  let f : P → P := λ y, line_map q y (ε / 2 / (dist y q)),
  have hf : ∀ y, f y ∈ u,
  { intros y,
    apply hεu,
    simp only [metric.mem_ball, f, line_map_apply, dist_vadd_left, norm_smul, real.norm_eq_abs,
      dist_eq_norm_vsub V y q],
    cases eq_or_ne (∥y -ᵥ q∥) 0 with hyq hyq, { rwa [hyq, mul_zero], },
    rw [← norm_pos_iff, norm_norm] at hyq,
    calc abs (ε / 2 / ∥y -ᵥ q∥) * ∥y -ᵥ q∥
          = ε / 2 / ∥y -ᵥ q∥ * ∥y -ᵥ q∥ : by rw [abs_div, abs_of_pos (half_pos hε), abs_of_pos hyq]
      ... = ε / 2 : div_mul_cancel _ (ne_of_gt hyq)
      ... < ε : half_lt_self hε, },
  have hεyq : ∀ (y ∉ s), ε / 2 / dist y q ≠ 0,
  { simp only [ne.def, div_eq_zero_iff, or_false, dist_eq_zero, bit0_eq_zero, one_ne_zero,
      not_or_distrib, ne_of_gt hε, true_and, not_false_iff],
    exact λ y h1 h2, h1 (h2.symm ▸ hq) },
  classical,
  let w : t → ℝˣ := λ p, if hp : (p : P) ∈ s then 1 else units.mk0 _ (hεyq ↑p hp),
  refine ⟨set.range (λ (p : t), line_map q p (w p : ℝ)), _, _, _, _⟩,
  { intros p hp, use ⟨p, ht₁ hp⟩, simp [w, hp], },
  { intros y hy,
    simp only [set.mem_range, set_coe.exists, subtype.coe_mk] at hy,
    obtain ⟨p, hp, hyq⟩ := hy,
    by_cases hps : p ∈ s;
    simp only [w, hps, line_map_apply_one, units.coe_mk0, dif_neg, dif_pos, not_false_iff,
      units.coe_one, subtype.coe_mk] at hyq;
    rw ← hyq;
    [exact hsu hps, exact hf p], },
  { exact (ht₂.units_line_map ⟨q, ht₁ hq⟩ w).range, },
  { rw [affine_span_eq_affine_span_line_map_units (ht₁ hq) w, ht₃], },
end

lemma interior_convex_hull_nonempty_iff_aff_span_eq_top [finite_dimensional ℝ V] {s : set V} :
  (interior (convex_hull ℝ s)).nonempty ↔ affine_span ℝ s = ⊤ :=
begin
  split,
  { rintros ⟨x, hx⟩,
    obtain ⟨u, hu₁, hu₂, hu₃⟩ := mem_interior.mp hx,
    let t : set V := {x},
    obtain ⟨b, hb₁, hb₂, hb₃, hb₄⟩ := exists_subset_affine_independent_span_eq_top_of_open hu₂
      (singleton_subset_iff.mpr hu₃) (singleton_nonempty x)
      (affine_independent_of_subsingleton ℝ (coe : t → V)),
    rw [eq_top_iff, ← hb₄, ← affine_span_convex_hull s],
    mono,
    exact hb₂.trans hu₁, },
  { intros h,
    obtain ⟨t, hts, h_tot, h_ind⟩ := exists_affine_independent ℝ V s,
    suffices : (interior (convex_hull ℝ (range (coe : t → V)))).nonempty,
    { rw [subtype.range_coe_subtype, set_of_mem_eq] at this,
      apply nonempty.mono _ this,
      mono* },
    haveI : fintype t := fintype_of_fin_dim_affine_independent ℝ h_ind,
    use finset.centroid ℝ (finset.univ : finset t) (coe : t → V),
    rw [h, ← @set_of_mem_eq V t, ← subtype.range_coe_subtype] at h_tot,
    let b : affine_basis t ℝ V := ⟨coe, h_ind, h_tot⟩,
    rw interior_convex_hull_aff_basis b,
    have htne : (finset.univ : finset t).nonempty,
    { simpa [finset.univ_nonempty_iff] using
        affine_subspace.nonempty_of_affine_span_eq_top ℝ V V h_tot, },
    simp [finset.centroid_def, b.coord_apply_combination_of_mem (finset.mem_univ _)
      (finset.sum_centroid_weights_eq_one_of_nonempty ℝ (finset.univ : finset t) htne),
      finset.centroid_weights_apply, nat.cast_pos, inv_pos, finset.card_pos.mpr htne], },
end

lemma convex.interior_nonempty_iff_affine_span_eq_top [finite_dimensional ℝ V] {s : set V}
  (hs : convex ℝ s) : (interior s).nonempty ↔ affine_span ℝ s = ⊤ :=
by rw [← interior_convex_hull_nonempty_iff_aff_span_eq_top, hs.convex_hull_eq]