-- Conectivas_y_desigualdades.lean
-- Conectivas y desigualdades.
-- José A. Alonso Jiménez
-- Sevilla, 23 de agosto de 2020
-- ---------------------------------------------------------------------

-- En esta relación se formulan algunas de las anteriores propiedades de
-- las desigualdades de los números reales usando conectivas.

import data.real.basic

variables (a b c : ℝ)

-- ---------------------------------------------------------------------
-- Ejercicio 1. Demostrar que
--    0 ≤ a → b ≤ a + b
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example : 0 ≤ a → b ≤ a + b :=
begin
  intro ha,
  exact le_add_of_nonneg_left ha,
end

-- 2ª demostración
-- ===============

example : 0 ≤ a → b ≤ a + b :=
le_add_of_nonneg_left

-- 3ª demostración
-- ===============

example : 0 ≤ a → b ≤ a + b :=
by finish

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que
--    0 ≤ b → a ≤ a + b
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example: 0 ≤ b → a ≤ a + b :=
begin
  intro hb,
  exact le_add_of_nonneg_right hb,
end

-- 2ª demostración
-- ===============

example: 0 ≤ b → a ≤ a + b :=
le_add_of_nonneg_right

-- 3ª demostración
-- ===============

example: 0 ≤ b → a ≤ a + b :=
by finish

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que
--    (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
begin
  intros hab,
  cases hab with ha hb,
  exact add_nonneg ha hb,
end

-- 2ª demostración
-- ===============

example : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
begin
  rintros ⟨ha, hb⟩,
  exact add_nonneg ha hb,
end

-- 3ª demostración
-- ===============

example : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
λ ⟨ha, hb⟩, add_nonneg ha hb

-- ---------------------------------------------------------------------
-- Ejercicio 4. Demostrar que
--    0 ≤ a → (0 ≤ b → 0 ≤ a + b)
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intro ha,
  intro hb,
  exact add_nonneg ha hb,
end

-- 2ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  exact add_nonneg ha hb,
end

-- 3ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
λ ha hb, add_nonneg ha hb

-- 4ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
add_nonneg

-- 5ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
by intros ; linarith

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que si
--   (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b
-- entonces
--   0 ≤ a → (0 ≤ b → 0 ≤ a + b)
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intro ha,
  intro hb,
  apply H,
  split,
  { exact ha, },
  { exact hb, },
end

-- 2ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  apply H,
  split,
  { exact ha, },
  { exact hb, },
end

-- 3ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  exact H ⟨ha, hb⟩,
end

-- 4ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
λ ha hb, H ⟨ha, hb⟩

-- 5ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
by tauto

-- 6ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
by finish


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

import order.bounds.basic

/-!
# Intervals in Lattices

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

In this file, we provide instances of lattice structures on intervals within lattices.
Some of them depend on the order of the endpoints of the interval, and thus are not made
global instances. These are probably not all of the lattice instances that could be placed on these
intervals, but more can be added easily along the same lines when needed.

## Main definitions
In the following, `*` can represent either `c`, `o`, or `i`.
  * `set.Ic*.order_bot`
  * `set.Ii*.semillatice_inf`
  * `set.I*c.order_top`
  * `set.I*c.semillatice_inf`
  * `set.I**.lattice`
  * `set.Iic.bounded_order`, within an `order_bot`
  * `set.Ici.bounded_order`, within an `order_top`

-/

variable {α : Type*}

namespace set

namespace Ico

instance [semilattice_inf α] {a b : α} : semilattice_inf (Ico a b) :=
subtype.semilattice_inf (λ x y hx hy, ⟨le_inf hx.1 hy.1, lt_of_le_of_lt inf_le_left hx.2⟩)

/-- `Ico a b` has a bottom element whenever `a < b`. -/
@[reducible] protected def order_bot [partial_order α] {a b : α} (h : a < b) :
  order_bot (Ico a b) :=
(is_least_Ico h).order_bot

end Ico

namespace Iio

instance [semilattice_inf α] {a : α} : semilattice_inf (Iio a) :=
subtype.semilattice_inf (λ x y hx hy, lt_of_le_of_lt inf_le_left hx)

end Iio

namespace Ioc

instance [semilattice_sup α] {a b : α} : semilattice_sup (Ioc a b) :=
subtype.semilattice_sup (λ x y hx hy, ⟨lt_of_lt_of_le hx.1 le_sup_left, sup_le hx.2 hy.2⟩)

/-- `Ioc a b` has a top element whenever `a < b`. -/
@[reducible] protected def order_top [partial_order α] {a b : α} (h : a < b) :
  order_top (Ioc a b) :=
(is_greatest_Ioc h).order_top

end Ioc

namespace Ioi

instance [semilattice_sup α] {a : α} : semilattice_sup (Ioi a) :=
subtype.semilattice_sup (λ x y hx hy, lt_of_lt_of_le hx le_sup_left)

end Ioi

namespace Iic

instance [semilattice_inf α] {a : α} : semilattice_inf (Iic a) :=
subtype.semilattice_inf (λ x y hx hy, le_trans inf_le_left hx)

instance [semilattice_sup α] {a : α} : semilattice_sup (Iic a) :=
subtype.semilattice_sup (λ x y hx hy, sup_le hx hy)

instance [lattice α] {a : α} : lattice (Iic a) :=
{ .. Iic.semilattice_inf,
  .. Iic.semilattice_sup }

instance [preorder α] {a : α} : order_top (Iic a) :=
{ top := ⟨a, le_refl a⟩,
  le_top := λ x, x.prop }

@[simp] lemma coe_top [preorder α] {a : α} : ↑(⊤ : Iic a) = a := rfl

instance [preorder α] [order_bot α] {a : α} : order_bot (Iic a) :=
{ bot := ⟨⊥, bot_le⟩,
  bot_le := λ ⟨_,_⟩, subtype.mk_le_mk.2 bot_le }

@[simp] lemma coe_bot [preorder α] [order_bot α] {a : α} : ↑(⊥ : Iic a) = (⊥ : α) := rfl

instance [preorder α] [order_bot α] {a : α} : bounded_order (Iic a) :=
{ .. Iic.order_top,
  .. Iic.order_bot }

end Iic

namespace Ici

instance [semilattice_inf α] {a : α}: semilattice_inf (Ici a) :=
subtype.semilattice_inf (λ x y hx hy, le_inf hx hy)

instance [semilattice_sup α] {a : α} : semilattice_sup (Ici a) :=
subtype.semilattice_sup (λ x y hx hy, le_trans hx le_sup_left)

instance [lattice α] {a : α} : lattice (Ici a) :=
{ .. Ici.semilattice_inf,
  .. Ici.semilattice_sup }

instance [distrib_lattice α] {a : α} : distrib_lattice (Ici a) :=
{ le_sup_inf := λ a b c, le_sup_inf,
  .. Ici.lattice }

instance [preorder α] {a : α} : order_bot (Ici a) :=
{ bot := ⟨a, le_refl a⟩,
  bot_le := λ x, x.prop }

@[simp] lemma coe_bot [preorder α] {a : α} : ↑(⊥ : Ici a) = a := rfl

instance [preorder α] [order_top α] {a : α}: order_top (Ici a) :=
{ top := ⟨⊤, le_top⟩,
  le_top := λ ⟨_,_⟩, subtype.mk_le_mk.2 le_top }

@[simp] lemma coe_top [preorder α] [order_top α] {a : α} : ↑(⊤ : Ici a) = (⊤ : α) := rfl

instance [preorder α] [order_top α] {a : α}: bounded_order (Ici a) :=
{ .. Ici.order_top,
  .. Ici.order_bot }

end Ici

namespace Icc

instance [semilattice_inf α] {a b : α} : semilattice_inf (Icc a b) :=
subtype.semilattice_inf (λ x y hx hy, ⟨le_inf hx.1 hy.1, le_trans inf_le_left hx.2⟩)

instance [semilattice_sup α] {a b : α} : semilattice_sup (Icc a b) :=
subtype.semilattice_sup (λ x y hx hy, ⟨le_trans hx.1 le_sup_left, sup_le hx.2 hy.2⟩)

instance [lattice α] {a b : α} : lattice (Icc a b) :=
{ .. Icc.semilattice_inf,
  .. Icc.semilattice_sup }

/-- `Icc a b` has a bottom element whenever `a ≤ b`. -/
@[reducible] protected def order_bot [preorder α] {a b : α} (h : a ≤ b) : order_bot (Icc a b) :=
(is_least_Icc h).order_bot

/-- `Icc a b` has a top element whenever `a ≤ b`. -/
@[reducible] protected def order_top [preorder α] {a b : α} (h : a ≤ b) : order_top (Icc a b) :=
(is_greatest_Icc h).order_top

/-- `Icc a b` is a `bounded_order` whenever `a ≤ b`. -/
@[reducible] protected def bounded_order [preorder α] {a b : α} (h : a ≤ b) :
  bounded_order (Icc a b) :=
{ .. Icc.order_top h,
  .. Icc.order_bot h }

end Icc

end set


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import topology.algebra.affine
/-!

# `equiv` -- bijections the easy way

Here's a theorem. Say `f : X → Y` is a function. Then
the following are equivalent:

(1) `f` is a bijection (i.e., injective and surjective)
(2) There exists a function `g : Y → X` which is a
two-sided inverse of `f` (i.e. `f ∘ g` and `g ∘ f` are
both identity functions)

However, trying to prove this in Lean, you run into a perhaps
unexpected hitch. Let's consider following even simpler
theorem. Again say `f : X → Y` is a function. Then I claim
the following are equivalent:

(1) `f` is a surjection;
(2) There exists `g : Y → X` such that `f(g(y))=y` for all `y : Y`.

If you didn't know this already, then pause for a second and write down a proof
on paper before continuing. Consider drawing a picture if this helps.

OK here's the proof. To do (1) implies (2) define `g` thus: if `y : Y` then
by surjectivity of `f` there exists some `x : X` such that `f(x)=y`; define
`g(y)` to be any such `x` and this works. To do (2) implies (1) just note
that if `y : Y` then certainly there exists `x : X` with `f(x)=y` because
we can just take `x=g(y)`.

Did you notice where we used the axiom of choice? Do you know what the axiom of choice is?

To make that function `g : Y → X` in the proof of (1) → (2) we need to make *one object* `g`
which involves making a "random" choice of element `g(y)` from the nonempty set `{x : X | f x = y}`,
for every `y : Y`, all at once. That's exactly what the axiom of choice says that you can do.
In fact the axiom of choice is *equivalent* to the claim that (1) and (2) are equivalent.

-/

example (X Y : Type) (f : X → Y) : function.surjective f ↔ ∃ g : Y → X, ∀ y, f(g y)=y :=
begin
  split,
  { intro hf,
    -- `hf` has type `∀ y, ∃ x, f x = y`.
    choose g hg using hf,
    -- now `g` is a function which, given `y`, chooses such an `x`,
    -- and `hg` says that `f (g y) = y`,
    use g,
    exact hg },
  { rintro ⟨g, hg⟩ y,
    exact ⟨g y, hg y⟩ }
end

-- Now see if you can prove the `bijective` version.
-- The `apply_fun` tactic might be useful. From the docstring:
-- "If we have `h : a = b`, then `apply_fun f at h` will replace this
-- with `h : f a = f b`."

example (X Y : Type) (f : X → Y) :
  function.bijective f ↔ ∃ g : Y → X, (∀ y, f(g y)=y) ∧ (∀ x, g(f x) = x) :=
begin
  sorry,
end

/-

# The axiom of choice in Lean

Unfortunately, *using* the above result is *really annoying*. The theorem
says that there *exists* a `g`, but this is a statement in the `Prop`
universe. What we actually want is the inverse itself; this is data, so it
lives in the `Type` universe. Here are the types of everything:

-- this is on the `Prop` side of Lean
`∃ g : Y → X, (∀ y, f(g y)=y) ∧ (∀ x, g(f x) = x) : Prop`

-- these are on the `Type` side of Lean
`g : Y → X`
`Y → X : Type`

In constructive mathematics, or computer science, or whatever you want to
call it, it's impossible to move from the `Prop` universe to the `Type`
universe; we know `g` exists, but we don't have a *formula* for it.
In mathematics we don't care about this, and we can use what the
computer scientists call "classical axioms" to get `g` from the `∃ g` statement.
For example, `classical.some` is a function which eats a proof of `∃ x : X, <something>`
and returns a term of type `X` which satisfies the `<something>`. It's really inconvenient
having to keep using `classical.some` though. What is done in Lean's maths library
is something different. In Lean, a group isomorphism or a homeomorphism
is defined not to be a bijective function `f : X → Y` with some properties,
but a *pair* of functions `f : X → Y` and `g : Y → X` with some properties
(including the properties of being each other's inverse). In the next
sheet we'll see the `equiv` structure, which packages up the common
data needed in all these definitions; `equiv` is "constructive bijections",
or "bijections with a given inverse".

-/


theorem t (p q r:Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
    (assume Hpqr : p ∧ (q ∨ r),
        or.elim (and.elim_right Hpqr)
            (assume Hq : q,
                or.intro_left (p ∧ r) (and.intro (and.elim_left Hpqr) Hq)
            )
            (assume Hr : r,
                or.intro_right (p ∧ q) (and.intro (and.elim_left Hpqr) Hr)
            )
    )
    (assume Hpqr : (p ∧ q) ∨ (p ∧ r),
        or.elim Hpqr
            (assume Hpq : (p ∧ q),
                and.intro (and.elim_left Hpq) (or.intro_left r (and.elim_right Hpq))
            )
            (assume Hpr : (p ∧ r),
                and.intro (and.elim_left Hpr) (or.intro_right q (and.elim_right Hpr))
            )
    )
check t  -- t : ∀ p q r, p ∧ (q ∨ r) ↔ p ∧ q ∨ p ∧ r


/-
This file contains the definition of a Boolean literal.
The type of the underlying Boolean variable is polymorphic, such
that Boolean variables may be represented by nats, strings, etc.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import tactic

universe u

-- Represents the type of the variable stored in the literal
variable {V : Type*}

/-
All propositional formulas are comprised of Boolean literals.
Literals are positive or negative forms of the underlying variable type.
-/
@[derive decidable_eq]
inductive literal (V)
| Pos (v : V) : literal
| Neg (v : V) : literal

/-
Propositional formulas may be evaluated under truth assignments.
Assignments give boolean values to the variables in the formula.
-/
def assignment (V : Type*) := V → bool

namespace literal

open function

/-! # Properties -/

instance [inhabited V] : inhabited (literal V) := ⟨Pos (arbitrary V)⟩

protected def repr [has_repr V] : literal V → string
| (Pos v) := "Pos " ++ (has_repr.repr v)
| (Neg v) := "Neg " ++ (has_repr.repr v)

instance [has_repr V] : has_repr (literal V) := ⟨literal.repr⟩
instance [has_repr V] : has_to_string (literal V) := ⟨literal.repr⟩

/-! # Var -/

/- Extracts the underlying variable of the literal -/
def var : literal V → V
| (Pos v) := v
| (Neg v) := v

theorem var_surjective : surjective (var : literal V → V) :=
assume v, exists.intro (Pos v) (by simp only [var])

theorem ne_of_ne_var {l₁ l₂ : literal V} : l₁.var ≠ l₂.var → l₁ ≠ l₂ :=
assume h₁ h₂, h₁ (congr_arg var h₂)

/-! # Evaluation -/

/-
When provided an assignment, literals may be evaluated against
that assignment. Negated literals flip the truth value of the
underlying variable when evaluated on the assignment.
-/
protected def eval (τ : assignment V) : literal V → bool
| (Pos v) := τ v
| (Neg v) := bnot (τ v)

/-! # Flip -/

/- Flips the parity of the literal from positive to negative and vice versa -/
protected def flip : literal V → literal V
| (Pos v) := Neg v
| (Neg v) := Pos v

@[simp] theorem flip_ne [decidable_eq V] : ∀ (l : literal V), l.flip ≠ l
| (Pos v) := dec_trivial
| (Neg v) := dec_trivial

theorem flip_flip : ∀ (l : literal V), l.flip.flip = l
| (Pos v) := rfl
| (Neg v) := rfl

theorem flip_var_eq : ∀ (l : literal V), l.flip.var = l.var
| (Pos v) := rfl
| (Neg v) := rfl

@[simp] theorem flip_injective : injective (literal.flip : literal V → literal V) :=
assume l₁ l₂ h, (flip_flip l₂) ▸ ((flip_flip l₁) ▸ (congr_arg literal.flip h))

theorem flip_inj {l₁ l₂ : literal V} : l₁.flip = l₂.flip ↔ l₁ = l₂ :=
flip_injective.eq_iff

@[simp] theorem flip_surjective : surjective (literal.flip : literal V → literal V) :=
assume l, exists.intro l.flip (flip_flip l)

@[simp] theorem flip_bijective : bijective (literal.flip : literal V → literal V) :=
⟨flip_injective, flip_surjective⟩

theorem exists_flip_eq (l₁ : literal V) : ∃ (l₂ : literal V), l₂.flip = l₁ :=
⟨l₁.flip, flip_flip l₁⟩

section -- Various lemmas on how var and flip interact

variables {l₁ l₂ : literal V}

theorem var_eq_iff_eq_or_flip_eq : l₁.var = l₂.var ↔ l₁ = l₂ ∨ l₁.flip = l₂ :=
by cases l₁; cases l₂; simp [literal.flip, var]

theorem flip_eq_iff_eq_flip : l₁.flip = l₂ ↔ l₁ = l₂.flip :=
⟨λ h, congr_arg literal.flip h ▸ (flip_flip l₁).symm,
 λ h, (congr_arg literal.flip h).symm ▸ flip_flip l₂⟩

theorem flip_ne_iff_ne_flip : l₁.flip ≠ l₂ ↔ l₁ ≠ l₂.flip :=
⟨λ h₁ h₂, absurd (flip_eq_iff_eq_flip.mpr h₂) h₁,
 λ h₁ h₂, absurd (flip_eq_iff_eq_flip.mp h₂) h₁⟩

theorem flip_eq_of_ne_of_var_eq : l₁ ≠ l₂ → l₁.var = l₂.var → l₁.flip = l₂ :=
λ h₁ h₂, or.elim (var_eq_iff_eq_or_flip_eq.mp h₂) (λ h, absurd h h₁) id

theorem eq_of_flip_ne_of_var_eq : l₁.flip ≠ l₂ → l₁.var = l₂.var → l₁ = l₂ :=
λ h₁ h₂, or.elim (var_eq_iff_eq_or_flip_eq.mp h₂) id (λ h, absurd h h₁)

end /- end section -/

/-! # Flip evaluation -/

-- When a literal is flipped, its truth assignment is negated
theorem eval_flip (τ : assignment V) (l : literal V) :
  l.flip.eval τ = bnot (l.eval τ) :=
by cases l; simp only [literal.flip, literal.eval, bnot_bnot]

-- A slight modification where the negation is the flipped literal
theorem eval_flip2 (τ : assignment V) (l : literal V) :
  l.eval τ = bnot (l.flip.eval τ) :=
by cases l; simp only [literal.flip, literal.eval, bnot_bnot]

theorem eval_flip_of_eval {τ : assignment V} {l : literal V} {b : bool} :
  l.eval τ = b → l.flip.eval τ = bnot b :=
assume h, congr_arg bnot h ▸ eval_flip τ l

theorem eval_of_eval_flip {τ : assignment V} {l : literal V} {b : bool} :
  literal.eval τ l.flip = b → literal.eval τ l = bnot b :=
assume h, congr_arg bnot h ▸ eval_flip2 τ l

/-! # Positives and negatives -/

protected def is_pos : literal V → Prop
| (Pos _) := true
| (Neg _) := false

protected def is_neg : literal V → Prop
| (Pos _) := false
| (Neg _) := true

-- Must be protected because of decidable.is_true
protected def is_true (τ : assignment V) (l : literal V) : Prop :=
literal.eval τ l = tt

protected def is_false (τ : assignment V) (l : literal V) : Prop :=
literal.eval τ l = ff

instance : decidable_pred (literal.is_pos : literal V → Prop)
| (Pos v) := decidable.true
| (Neg v) := decidable.false

instance : decidable_pred (literal.is_neg : literal V → Prop)
| (Pos v) := decidable.false
| (Neg v) := decidable.true

instance (τ : assignment V) : decidable_pred (literal.is_true τ) :=
λ l, by cases h : l.eval τ; { unfold literal.is_true, rw h, exact eq.decidable _ _ }

instance (τ : assignment V) : decidable_pred (literal.is_false τ) :=
λ l, by cases h : l.eval τ; { unfold literal.is_false, rw h, exact eq.decidable _ _ }

-- A literal can never be both positive and negative
theorem is_pos_ne_is_neg (l : literal V) :
  literal.is_pos l ≠ literal.is_neg l :=
by cases l; simp [literal.is_pos, literal.is_neg]

-- A literal can never be both true and false under the same assignment
-- NOTE: A strange proof, can probably be simplified
theorem is_true_ne_is_false [inhabited V] (τ : assignment V) :
  (literal.is_true τ) ≠ (literal.is_false τ) :=
begin
  intro h,
  have v := arbitrary (literal V),
  have := congr_arg (λ (f : literal V → Prop), f v) h,
  cases he : literal.eval τ v;
  { simp [literal.is_true, literal.is_false, he] at this, assumption }
end

end literal


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

! This file was ported from Lean 3 source module group_theory.subgroup.zpowers
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subgroup.Basic

/-!
# Subgroups generated by an element

## Tags
subgroup, subgroups

-/

variable {G : Type _} [Group G]

variable {A : Type _} [AddGroup A]

variable {N : Type _} [Group N]

namespace Subgroup

/-- The subgroup generated by an element. -/
def zpowers (g : G) : Subgroup G :=
  Subgroup.copy (zpowersHom G g).range (Set.range ((· ^ ·) g : ℤ → G)) rfl
#align subgroup.zpowers Subgroup.zpowers

theorem mem_zpowers (g : G) : g ∈ zpowers g :=
  ⟨1, zpow_one _⟩
#align subgroup.mem_zpowers Subgroup.mem_zpowers

theorem zpowers_eq_closure (g : G) : zpowers g = closure {g} := by
  ext
  exact mem_closure_singleton.symm
#align subgroup.zpowers_eq_closure Subgroup.zpowers_eq_closure

theorem range_zpowersHom (g : G) : (zpowersHom G g).range = zpowers g :=
  rfl
#align subgroup.range_zpowers_hom Subgroup.range_zpowersHom

theorem zpowers_subset {a : G} {K : Subgroup G} (h : a ∈ K) : zpowers a ≤ K := fun x hx =>
  match x, hx with
  | _, ⟨i, rfl⟩ => K.zpow_mem h i
#align subgroup.zpowers_subset Subgroup.zpowers_subset

theorem mem_zpowers_iff {g h : G} : h ∈ zpowers g ↔ ∃ k : ℤ, g ^ k = h :=
  Iff.rfl
#align subgroup.mem_zpowers_iff Subgroup.mem_zpowers_iff

theorem zpow_mem_zpowers (g : G) (k : ℤ) : g ^ k ∈ zpowers g :=
  mem_zpowers_iff.mpr ⟨k, rfl⟩
#align subgroup.zpow_mem_zpowers Subgroup.zpow_mem_zpowers

theorem npow_mem_zpowers (g : G) (k : ℕ) : g ^ k ∈ zpowers g :=
  zpow_ofNat g k ▸ zpow_mem_zpowers g k
#align subgroup.npow_mem_zpowers Subgroup.npow_mem_zpowers

theorem forall_zpowers {x : G} {p : zpowers x → Prop} : (∀ g, p g) ↔ ∀ m : ℤ, p ⟨x ^ m, m, rfl⟩ :=
  Set.forall_subtype_range_iff
#align subgroup.forall_zpowers Subgroup.forall_zpowers

theorem exists_zpowers {x : G} {p : zpowers x → Prop} : (∃ g, p g) ↔ ∃ m : ℤ, p ⟨x ^ m, m, rfl⟩ :=
  Set.exists_subtype_range_iff
#align subgroup.exists_zpowers Subgroup.exists_zpowers

theorem forall_mem_zpowers {x : G} {p : G → Prop} : (∀ g ∈ zpowers x, p g) ↔ ∀ m : ℤ, p (x ^ m) :=
  Set.forall_range_iff
#align subgroup.forall_mem_zpowers Subgroup.forall_mem_zpowers

theorem exists_mem_zpowers {x : G} {p : G → Prop} : (∃ g ∈ zpowers x, p g) ↔ ∃ m : ℤ, p (x ^ m) :=
  Set.exists_range_iff
#align subgroup.exists_mem_zpowers Subgroup.exists_mem_zpowers

instance (a : G) : Countable (zpowers a) :=
  ((zpowersHom G a).rangeRestrict_surjective.comp Multiplicative.ofAdd.surjective).countable

end Subgroup

namespace AddSubgroup

/-- The subgroup generated by an element. -/
def zmultiples (a : A) : AddSubgroup A :=
  AddSubgroup.copy (zmultiplesHom A a).range (Set.range ((· • a) : ℤ → A)) rfl
#align add_subgroup.zmultiples AddSubgroup.zmultiples

@[simp]
theorem range_zmultiplesHom (a : A) : (zmultiplesHom A a).range = zmultiples a :=
  rfl
#align add_subgroup.range_zmultiples_hom AddSubgroup.range_zmultiplesHom

attribute [to_additive existing AddSubgroup.zmultiples] Subgroup.zpowers

attribute [to_additive (attr := simp) AddSubgroup.mem_zmultiples] Subgroup.mem_zpowers
#align add_subgroup.mem_zmultiples AddSubgroup.mem_zmultiples

attribute [to_additive AddSubgroup.zmultiples_eq_closure] Subgroup.zpowers_eq_closure
#align add_subgroup.zmultiples_eq_closure AddSubgroup.zmultiples_eq_closure

attribute [to_additive existing (attr := simp) AddSubgroup.range_zmultiplesHom]
  Subgroup.range_zpowersHom

attribute [to_additive AddSubgroup.zmultiples_subset] Subgroup.zpowers_subset
#align add_subgroup.zmultiples_subset AddSubgroup.zmultiples_subset

attribute [to_additive AddSubgroup.mem_zmultiples_iff] Subgroup.mem_zpowers_iff
#align add_subgroup.mem_zmultiples_iff AddSubgroup.mem_zmultiples_iff

attribute [to_additive (attr := simp) AddSubgroup.zsmul_mem_zmultiples] Subgroup.zpow_mem_zpowers
#align add_subgroup.zsmul_mem_zmultiples AddSubgroup.zsmul_mem_zmultiples

attribute [to_additive (attr := simp) AddSubgroup.nsmul_mem_zmultiples] Subgroup.npow_mem_zpowers
#align add_subgroup.nsmul_mem_zmultiples AddSubgroup.nsmul_mem_zmultiples

--Porting note: increasing simp priority. Better lemma than `Subtype.forall`
attribute [to_additive (attr := simp 1100) AddSubgroup.forall_zmultiples] Subgroup.forall_zpowers
#align add_subgroup.forall_zmultiples AddSubgroup.forall_zmultiples

attribute [to_additive AddSubgroup.forall_mem_zmultiples] Subgroup.forall_mem_zpowers
#align add_subgroup.forall_mem_zmultiples AddSubgroup.forall_mem_zmultiples

--Porting note: increasing simp priority. Better lemma than `Subtype.exists`
attribute [to_additive (attr := simp 1100) AddSubgroup.exists_zmultiples] Subgroup.exists_zpowers
#align add_subgroup.exists_zmultiples AddSubgroup.exists_zmultiples

attribute [to_additive AddSubgroup.exists_mem_zmultiples] Subgroup.exists_mem_zpowers
#align add_subgroup.exists_mem_zmultiples AddSubgroup.exists_mem_zmultiples

instance (a : A) : Countable (zmultiples a) :=
  (zmultiplesHom A a).rangeRestrict_surjective.countable

section Ring

variable {R : Type _} [Ring R] (r : R) (k : ℤ)

@[simp]
theorem int_cast_mul_mem_zmultiples : ↑(k : ℤ) * r ∈ zmultiples r := by
  simpa only [← zsmul_eq_mul] using zsmul_mem_zmultiples r k
#align add_subgroup.int_cast_mul_mem_zmultiples AddSubgroup.int_cast_mul_mem_zmultiples

@[simp]
theorem int_cast_mem_zmultiples_one : ↑(k : ℤ) ∈ zmultiples (1 : R) :=
  mem_zmultiples_iff.mp ⟨k, by simp⟩
#align add_subgroup.int_cast_mem_zmultiples_one AddSubgroup.int_cast_mem_zmultiples_one

end Ring

end AddSubgroup

@[to_additive (attr := simp) map_zmultiples]
theorem MonoidHom.map_zpowers (f : G →* N) (x : G) :
    (Subgroup.zpowers x).map f = Subgroup.zpowers (f x) := by
  rw [Subgroup.zpowers_eq_closure, Subgroup.zpowers_eq_closure, f.map_closure, Set.image_singleton]
#align monoid_hom.map_zpowers MonoidHom.map_zpowers
#align add_monoid_hom.map_zmultiples AddMonoidHom.map_zmultiples

theorem Int.mem_zmultiples_iff {a b : ℤ} : b ∈ AddSubgroup.zmultiples a ↔ a ∣ b :=
  exists_congr fun k => by rw [mul_comm, eq_comm, ← smul_eq_mul]
#align int.mem_zmultiples_iff Int.mem_zmultiples_iff

theorem ofMul_image_zpowers_eq_zmultiples_ofMul {x : G} :
    Additive.ofMul '' (Subgroup.zpowers x : Set G) = AddSubgroup.zmultiples (Additive.ofMul x) := by
  ext y
  constructor
  · rintro ⟨z, ⟨m, hm⟩, hz2⟩
    use m
    simp only at *
    rwa [← ofMul_zpow, hm]
  · rintro ⟨n, hn⟩
    refine' ⟨x ^ n, ⟨n, rfl⟩, _⟩
    rwa [ofMul_zpow]
#align of_mul_image_zpowers_eq_zmultiples_of_mul ofMul_image_zpowers_eq_zmultiples_ofMul

theorem ofAdd_image_zmultiples_eq_zpowers_ofAdd {x : A} :
    Multiplicative.ofAdd '' (AddSubgroup.zmultiples x : Set A) =
      Subgroup.zpowers (Multiplicative.ofAdd x) := by
  symm
  rw [Equiv.eq_image_iff_symm_image_eq]
  exact ofMul_image_zpowers_eq_zmultiples_ofMul
#align of_add_image_zmultiples_eq_zpowers_of_add ofAdd_image_zmultiples_eq_zpowers_ofAdd

namespace Subgroup

@[to_additive zmultiples_isCommutative]
instance zpowers_isCommutative (g : G) : (zpowers g).IsCommutative :=
  ⟨⟨fun ⟨_, _, h₁⟩ ⟨_, _, h₂⟩ => by
      rw [Subtype.ext_iff, coe_mul, coe_mul, Subtype.coe_mk, Subtype.coe_mk, ← h₁, ← h₂,
        zpow_mul_comm]⟩⟩
#align subgroup.zpowers_is_commutative Subgroup.zpowers_isCommutative
#align add_subgroup.zmultiples_is_commutative AddSubgroup.zmultiples_isCommutative

@[to_additive (attr := simp) zmultiples_le]
theorem zpowers_le {g : G} {H : Subgroup G} : zpowers g ≤ H ↔ g ∈ H := by
  rw [zpowers_eq_closure, closure_le, Set.singleton_subset_iff, SetLike.mem_coe]
#align subgroup.zpowers_le Subgroup.zpowers_le
#align add_subgroup.zmultiples_le AddSubgroup.zmultiples_le

@[to_additive (attr := simp) zmultiples_eq_bot]
theorem zpowers_eq_bot {g : G} : zpowers g = ⊥ ↔ g = 1 := by rw [eq_bot_iff, zpowers_le, mem_bot]
#align subgroup.zpowers_eq_bot Subgroup.zpowers_eq_bot
#align add_subgroup.zmultiples_eq_bot AddSubgroup.zmultiples_eq_bot

@[to_additive (attr := simp) zmultiples_zero_eq_bot]
theorem zpowers_one_eq_bot : Subgroup.zpowers (1 : G) = ⊥ :=
  Subgroup.zpowers_eq_bot.mpr rfl
#align subgroup.zpowers_one_eq_bot Subgroup.zpowers_one_eq_bot
#align add_subgroup.zmultiples_zero_eq_bot AddSubgroup.zmultiples_zero_eq_bot

@[to_additive]
theorem centralizer_closure (S : Set G) :
    (closure S).centralizer = ⨅ g ∈ S, (zpowers g).centralizer :=
  le_antisymm
      (le_infᵢ fun _ => le_infᵢ fun hg => centralizer_le <| zpowers_le.2 <| subset_closure hg) <|
    le_centralizer_iff.1 <|
      (closure_le _).2 fun g =>
        SetLike.mem_coe.2 ∘ zpowers_le.1 ∘ le_centralizer_iff.1 ∘ infᵢ_le_of_le g ∘ infᵢ_le _
#align subgroup.centralizer_closure Subgroup.centralizer_closure
#align add_subgroup.centralizer_closure AddSubgroup.centralizer_closure

@[to_additive]
theorem center_eq_infᵢ (S : Set G) (hS : closure S = ⊤) :
    center G = ⨅ g ∈ S, centralizer (zpowers g) := by
  rw [← centralizer_top, ← hS, centralizer_closure]
#align subgroup.center_eq_infi Subgroup.center_eq_infᵢ
#align add_subgroup.center_eq_infi AddSubgroup.center_eq_infᵢ

@[to_additive]
theorem center_eq_infi' (S : Set G) (hS : closure S = ⊤) :
    center G = ⨅ g : S, centralizer (zpowers (g : G)) :=
  by rw [center_eq_infᵢ S hS, ← infᵢ_subtype'']
#align subgroup.center_eq_infi' Subgroup.center_eq_infi'
#align add_subgroup.center_eq_infi' AddSubgroup.center_eq_infi'

end Subgroup


/-
  Package the definition of an open cover of an open set.

  Author: Ramon Fernandez Mir
-/

import topology.basic
import topology.opens
import sheaves.opens

universes u

open topological_space lattice

section covering

variables {α : Type u} [topological_space α]

-- Open cover.

structure covering (U : opens α) :=
{γ    : Type u}
(Uis  : γ → opens α)
(Hcov : ⋃ Uis = U)

variable (α)

def covering.univ := covering (@opens.univ α _)

variable {α}

-- If ⋃ Ui = U then for all i, Ui ⊆ U.

lemma subset_covering {U : opens α} {OC : covering U} :
∀ i, OC.Uis i ⊆ U :=
λ i x Hx, OC.Hcov ▸ opens_supr_mem OC.Uis i x Hx

-- Make covering from standard definition. Used for instance in compactness.

def opens.from_sets {A : Type*} [topological_space A]
: set (set A) → set (opens A) := λ C, { x | x.1 ∈ C }

lemma opens.from_sets.eq {A : Type*} [topological_space A]
(S : set (set A)) (HS : ∀ (t : set A), t ∈ S → is_open t)
: subtype.val '' (opens.from_sets S) = S :=
set.ext $ λ x, ⟨
  λ ⟨x', Hx', Hval⟩, Hval ▸ Hx',
  λ Hx, by simp [HS x Hx]; by exact Hx⟩

@[reducible] def covering.from_cover {A : Type*} [topological_space A]
(U     : opens A)
(C     : set (set A))
(HC    : ∀ (t : set A), t ∈ C → is_open t)
(Hcov : U.1 = ⋃₀ C)
: covering U :=
{ γ := opens.from_sets C,
  Uis := λ x, x,
  Hcov :=
    begin
      apply subtype.ext.2,
      rw Hcov,
      apply set.ext,
      intros x,
      split,
      { intros Hx,
        rcases Hx with ⟨U, HU, HxU⟩,
        existsi U,
        simp at HU,
        rcases HU with ⟨OU, HU⟩,
        rw ←opens.from_sets.eq C HC,
        split,
        { simp [HU],
          use OU, },
        { exact HxU, } },
      { intros Hx,
        rcases Hx with ⟨U, HU, HxU⟩,
        use U,
        simp,
        use (HC U HU),
        { simp [opens.from_sets],
          exact HU, },
        { exact HxU, }  }
    end, }

lemma covering.from_cover.Uis {A : Type*} [topological_space A]
(U     : opens A)
(C     : set (set A))
(HC    : ∀ (t : set A), t ∈ C → is_open t)
(Hcov : U.1 = ⋃₀ C)
: ∀ i, ((covering.from_cover U C HC Hcov).Uis i).1 ∈ C :=
begin
  intros i,
  simp [covering.from_cover] at *,
  cases i with i Hi,
  simp,
  simp [opens.from_sets] at *,
  exact Hi,
end

end covering


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Johannes Hölzl, Mario Carneiro
Ported by: Kevin Buzzard, Johan Commelin, Siddhartha Gadgil, Anand Rao
-/

import Mathlib.Data.Nat.Size

/-!

These are lemmas that were proved in the process of porting `Data.Nat.Sqrt`.

-/

namespace Nat

section Misc

-- porting note: Miscellaneous lemmas that should be integrated with `Mathlib` in the future

protected lemma mul_le_of_le_div (k x y : ℕ) (h : x ≤ y / k) : x * k ≤ y := by
  by_cases hk : k = 0
  case pos => rw [hk, mul_zero]; exact zero_le _
  case neg => rwa [← le_div_iff_mul_le (pos_iff_ne_zero.2 hk)]

protected lemma div_mul_div_le (a b c d : ℕ) :
    (a / b) * (c / d) ≤ (a * c) / (b * d) := by
  by_cases hb : b = 0
  case pos => simp [hb]
  by_cases hd : d = 0
  case pos => simp [hd]
  have hbd : b * d ≠ 0 := mul_ne_zero hb hd
  rw [le_div_iff_mul_le (Nat.pos_of_ne_zero hbd)]
  transitivity ((a / b) * b) * ((c / d) * d)
  · apply le_of_eq; simp only [mul_assoc, mul_left_comm]
  · apply Nat.mul_le_mul <;> apply div_mul_le_self

private lemma iter_fp_bound (n k : ℕ) :
    let iter_next (n guess : ℕ) := (guess + n / guess) / 2;
    sqrt.iter n k ≤ iter_next n (sqrt.iter n k) := by
  intro iter_next
  unfold sqrt.iter
  by_cases h : (k + n / k) / 2 < k
  case pos => simp [if_pos h]; exact iter_fp_bound _ _
  case neg => simp [if_neg h]; exact Nat.le_of_not_lt h

private lemma AM_GM : {a b : ℕ} → (4 * a * b ≤ (a + b) * (a + b))
  | 0, _ => by rw [mul_zero, zero_mul]; exact zero_le _
  | _, 0 => by rw [mul_zero]; exact zero_le _
  | a + 1, b + 1 => by
    have ih := add_le_add_right (@AM_GM a b) 4
    simp only [mul_add, add_mul, show (4 : ℕ) = 1 + 1 + 1 + 1 from rfl, one_mul, mul_one] at ih ⊢
    simp only [add_assoc, add_left_comm, add_le_add_iff_left] at ih ⊢
    exact ih

end Misc

section Std

-- porting note: These two lemmas seem like they belong to `Std.Data.Nat.Basic`.

lemma sqrt.iter_sq_le (n guess : ℕ) : sqrt.iter n guess * sqrt.iter n guess ≤ n := by
  unfold sqrt.iter
  let next := (guess + n / guess) / 2
  by_cases h : next < guess
  case pos => simpa only [dif_pos h] using sqrt.iter_sq_le n next
  case neg =>
    simp only [dif_neg h]
    apply Nat.mul_le_of_le_div
    apply le_of_add_le_add_left (a := guess)
    rw [← mul_two, ← le_div_iff_mul_le]
    · exact le_of_not_lt h
    · exact zero_lt_two

lemma sqrt.lt_iter_succ_sq (n guess : ℕ) (hn : n < (guess + 1) * (guess + 1)) :
    n < (sqrt.iter n guess + 1) * (sqrt.iter n guess + 1) := by
  unfold sqrt.iter
  -- m was `next`
  let m := (guess + n / guess) / 2
  by_cases h : m < guess
  case pos =>
    suffices : n < (m + 1) * (m + 1)
    · simpa only [dif_pos h] using sqrt.lt_iter_succ_sq n m this
    refine lt_of_mul_lt_mul_left ?_ (4 * (guess * guess)).zero_le
    apply lt_of_le_of_lt AM_GM
    rw [show (4 : ℕ) = 2 * 2 from rfl]
    rw [mul_mul_mul_comm 2, mul_mul_mul_comm (2 * guess)]
    refine mul_self_lt_mul_self (?_ : _ < _ * succ (_ / 2))
    rw [← add_div_right _ (by decide), mul_comm 2, mul_assoc,
      show guess + n / guess + 2 = (guess + n / guess + 1) + 1 from rfl]
    have aux_lemma {a : ℕ} : a ≤ 2 * ((a + 1) / 2) := by
      rw [mul_comm]
      exact (add_le_add_iff_right 2).1 $ succ_le_of_lt $ @lt_div_mul_add (a + 1) 2 zero_lt_two
    refine lt_of_lt_of_le ?_ (act_rel_act_of_rel _ aux_lemma)
    rw [add_assoc, mul_add]
    exact add_lt_add_left (lt_mul_div_succ _ (lt_of_le_of_lt (Nat.zero_le m) h)) _
  case neg =>
    simpa only [dif_neg h] using hn

end Std

end Nat


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
-/
import algebra.ordered_monoid

/-!
# Ordered groups

This file develops the basics of ordered groups.

## Implementation details

Unfortunately, the number of `'` appended to lemmas in this file
may differ between the multiplicative and the additive version of a lemma.
The reason is that we did not want to change existing names in the library.
-/

set_option old_structure_cmd true

universe u
variable {α : Type u}

/-- An ordered additive commutative group is an additive commutative group
with a partial order in which addition is strictly monotone. -/
@[protect_proj, ancestor add_comm_group partial_order]
class ordered_add_comm_group (α : Type u) extends add_comm_group α, partial_order α :=
(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b)

/-- An ordered commutative group is an commutative group
with a partial order in which multiplication is strictly monotone. -/
@[protect_proj, ancestor comm_group partial_order]
class ordered_comm_group (α : Type u) extends comm_group α, partial_order α :=
(mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b)

attribute [to_additive] ordered_comm_group

/--The units of an ordered commutative monoid form an ordered commutative group. -/
@[to_additive]
instance units.ordered_comm_group [ordered_comm_monoid α] : ordered_comm_group (units α) :=
{ mul_le_mul_left := λ a b h c, mul_le_mul_left' h _,
  .. units.partial_order,
  .. (infer_instance : comm_group (units α)) }

section ordered_comm_group
variables [ordered_comm_group α] {a b c d : α}

@[to_additive ordered_add_comm_group.add_lt_add_left]
lemma ordered_comm_group.mul_lt_mul_left' (a b : α) (h : a < b) (c : α) : c * a < c * b :=
begin
  rw lt_iff_le_not_le at h ⊢,
  split,
  { apply ordered_comm_group.mul_le_mul_left _ _ h.1 },
  { intro w,
    replace w : c⁻¹ * (c * b) ≤ c⁻¹ * (c * a) := ordered_comm_group.mul_le_mul_left _ _ w _,
    simp only [mul_one, mul_comm, mul_left_inv, mul_left_comm] at w,
    exact h.2 w },
end

@[to_additive ordered_add_comm_group.le_of_add_le_add_left]
lemma ordered_comm_group.le_of_mul_le_mul_left (h : a * b ≤ a * c) : b ≤ c :=
have a⁻¹ * (a * b) ≤ a⁻¹ * (a * c), from ordered_comm_group.mul_le_mul_left _ _ h _,
begin simp [inv_mul_cancel_left] at this, assumption end

@[to_additive]
lemma ordered_comm_group.lt_of_mul_lt_mul_left (h : a * b < a * c) : b < c :=
have a⁻¹ * (a * b) < a⁻¹ * (a * c), from ordered_comm_group.mul_lt_mul_left' _ _ h _,
begin simp [inv_mul_cancel_left] at this, assumption end

@[priority 100, to_additive]    -- see Note [lower instance priority]
instance ordered_comm_group.to_ordered_cancel_comm_monoid (α : Type u)
  [s : ordered_comm_group α] :
  ordered_cancel_comm_monoid α :=
{ mul_left_cancel       := @mul_left_cancel α _,
  le_of_mul_le_mul_left := @ordered_comm_group.le_of_mul_le_mul_left α _,
  ..s }

@[priority 100, to_additive]
instance ordered_comm_group.has_exists_mul_of_le (α : Type u)
  [ordered_comm_group α] :
  has_exists_mul_of_le α :=
⟨λ a b hab, ⟨b * a⁻¹, (mul_inv_cancel_comm_assoc a b).symm⟩⟩

@[to_additive neg_le_neg]
lemma inv_le_inv' (h : a ≤ b) : b⁻¹ ≤ a⁻¹ :=
have 1 ≤ a⁻¹ * b,           from mul_left_inv a ▸ mul_le_mul_left' h _,
have 1 * b⁻¹ ≤ a⁻¹ * b * b⁻¹, from mul_le_mul_right' this _,
by rwa [mul_inv_cancel_right, one_mul] at this

@[to_additive]
lemma le_of_inv_le_inv (h : b⁻¹ ≤ a⁻¹) : a ≤ b :=
suffices (a⁻¹)⁻¹ ≤ (b⁻¹)⁻¹, from
  begin simp [inv_inv] at this, assumption end,
inv_le_inv' h

@[to_additive]
lemma one_le_of_inv_le_one (h : a⁻¹ ≤ 1) : 1 ≤ a :=
have a⁻¹ ≤ 1⁻¹, by rwa one_inv,
le_of_inv_le_inv this

@[to_additive]
lemma inv_le_one_of_one_le (h : 1 ≤ a) : a⁻¹ ≤ 1 :=
have a⁻¹ ≤ 1⁻¹, from inv_le_inv' h,
by rwa one_inv at this

@[to_additive nonpos_of_neg_nonneg]
lemma le_one_of_one_le_inv (h : 1 ≤ a⁻¹) : a ≤ 1 :=
have 1⁻¹ ≤ a⁻¹, by rwa one_inv,
le_of_inv_le_inv this

@[to_additive neg_nonneg_of_nonpos]
lemma one_le_inv_of_le_one (h : a ≤ 1) : 1 ≤ a⁻¹ :=
have 1⁻¹ ≤ a⁻¹, from inv_le_inv' h,
by rwa one_inv at this

@[to_additive neg_lt_neg]
lemma inv_lt_inv' (h : a < b) : b⁻¹ < a⁻¹ :=
have 1 < a⁻¹ * b, from mul_left_inv a ▸ mul_lt_mul_left' h (a⁻¹),
have 1 * b⁻¹ < a⁻¹ * b * b⁻¹, from mul_lt_mul_right' this (b⁻¹),
by rwa [mul_inv_cancel_right, one_mul] at this

@[to_additive]
lemma lt_of_inv_lt_inv (h : b⁻¹ < a⁻¹) : a < b :=
inv_inv a ▸ inv_inv b ▸ inv_lt_inv' h

@[to_additive]
lemma one_lt_of_inv_inv (h : a⁻¹ < 1) : 1 < a :=
have a⁻¹ < 1⁻¹, by rwa one_inv,
lt_of_inv_lt_inv this

@[to_additive]
lemma inv_inv_of_one_lt (h : 1 < a) : a⁻¹ < 1 :=
have a⁻¹ < 1⁻¹, from inv_lt_inv' h,
by rwa one_inv at this

@[to_additive neg_of_neg_pos]
lemma inv_of_one_lt_inv (h : 1 < a⁻¹) : a < 1 :=
have 1⁻¹ < a⁻¹, by rwa one_inv,
lt_of_inv_lt_inv this

@[to_additive neg_pos_of_neg]
lemma one_lt_inv_of_inv (h : a < 1) : 1 < a⁻¹ :=
have 1⁻¹ < a⁻¹, from inv_lt_inv' h,
by rwa one_inv at this

@[to_additive]
lemma le_inv_of_le_inv (h : a ≤ b⁻¹) : b ≤ a⁻¹ :=
begin
  have h := inv_le_inv' h,
  rwa inv_inv at h
end

@[to_additive]
lemma inv_le_of_inv_le (h : a⁻¹ ≤ b) : b⁻¹ ≤ a :=
begin
  have h := inv_le_inv' h,
  rwa inv_inv at h
end

@[to_additive]
lemma lt_inv_of_lt_inv (h : a < b⁻¹) : b < a⁻¹ :=
begin
  have h := inv_lt_inv' h,
  rwa inv_inv at h
end

@[to_additive]
lemma inv_lt_of_inv_lt (h : a⁻¹ < b) : b⁻¹ < a :=
begin
  have h := inv_lt_inv' h,
  rwa inv_inv at h
end

@[to_additive]
lemma mul_le_of_le_inv_mul (h : b ≤ a⁻¹ * c) : a * b ≤ c :=
begin
  have h := mul_le_mul_left' h a,
  rwa mul_inv_cancel_left at h
end

@[to_additive]
lemma le_inv_mul_of_mul_le (h : a * b ≤ c) : b ≤ a⁻¹ * c :=
begin
  have h := mul_le_mul_left' h a⁻¹,
  rwa inv_mul_cancel_left at h
end

@[to_additive]
lemma le_mul_of_inv_mul_le (h : b⁻¹ * a ≤ c) : a ≤ b * c :=
begin
  have h := mul_le_mul_left' h b,
  rwa mul_inv_cancel_left at h
end

@[to_additive]
lemma inv_mul_le_of_le_mul (h : a ≤ b * c) : b⁻¹ * a ≤ c :=
begin
  have h := mul_le_mul_left' h b⁻¹,
  rwa inv_mul_cancel_left at h
end

@[to_additive]
lemma le_mul_of_inv_mul_le_left (h : b⁻¹ * a ≤ c) : a ≤ b * c :=
le_mul_of_inv_mul_le h

@[to_additive]
lemma inv_mul_le_left_of_le_mul (h : a ≤ b * c) : b⁻¹ * a ≤ c :=
inv_mul_le_of_le_mul h

@[to_additive]
lemma le_mul_of_inv_mul_le_right (h : c⁻¹ * a ≤ b) : a ≤ b * c :=
by { rw mul_comm, exact le_mul_of_inv_mul_le h }

@[to_additive]
lemma inv_mul_le_right_of_le_mul (h : a ≤ b * c) : c⁻¹ * a ≤ b :=
by { rw mul_comm at h, apply inv_mul_le_left_of_le_mul h }

@[to_additive]
lemma mul_lt_of_lt_inv_mul (h : b < a⁻¹ * c) : a * b < c :=
begin
  have h := mul_lt_mul_left' h a,
  rwa mul_inv_cancel_left at h
end

@[to_additive]
lemma lt_inv_mul_of_mul_lt (h : a * b < c) : b < a⁻¹ * c :=
begin
  have h := mul_lt_mul_left' h (a⁻¹),
  rwa inv_mul_cancel_left at h
end

@[to_additive]
lemma lt_mul_of_inv_mul_lt (h : b⁻¹ * a < c) : a < b * c :=
begin
  have h := mul_lt_mul_left' h b,
  rwa mul_inv_cancel_left at h
end

@[to_additive]
lemma inv_mul_lt_of_lt_mul (h : a < b * c) : b⁻¹ * a < c :=
begin
  have h := mul_lt_mul_left' h (b⁻¹),
  rwa inv_mul_cancel_left at h
end

@[to_additive]
lemma lt_mul_of_inv_mul_lt_left (h : b⁻¹ * a < c) : a < b * c :=
lt_mul_of_inv_mul_lt h

@[to_additive]
lemma inv_mul_lt_left_of_lt_mul (h : a < b * c) : b⁻¹ * a < c :=
inv_mul_lt_of_lt_mul h

@[to_additive]
lemma lt_mul_of_inv_mul_lt_right (h : c⁻¹ * a < b) : a < b * c :=
by { rw mul_comm, exact lt_mul_of_inv_mul_lt h }

@[to_additive]
lemma inv_mul_lt_right_of_lt_mul (h : a < b * c) : c⁻¹ * a < b :=
by { rw mul_comm at h, exact inv_mul_lt_of_lt_mul h }

@[simp, to_additive]
lemma inv_lt_one_iff_one_lt : a⁻¹ < 1 ↔ 1 < a :=
⟨ one_lt_of_inv_inv, inv_inv_of_one_lt ⟩

@[simp, to_additive]
lemma inv_le_inv_iff : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
have a * b * a⁻¹ ≤ a * b * b⁻¹ ↔ a⁻¹ ≤ b⁻¹, from mul_le_mul_iff_left _,
by { rw [mul_inv_cancel_right, mul_comm a, mul_inv_cancel_right] at this, rw [this] }

@[to_additive neg_le]
lemma inv_le' : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
have a⁻¹ ≤ (b⁻¹)⁻¹ ↔ b⁻¹ ≤ a, from inv_le_inv_iff,
by rwa inv_inv at this

@[to_additive le_neg]
lemma le_inv' : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
have (a⁻¹)⁻¹ ≤ b⁻¹ ↔ b ≤ a⁻¹, from inv_le_inv_iff,
by rwa inv_inv at this

@[to_additive neg_le_iff_add_nonneg]
lemma inv_le_iff_one_le_mul : a⁻¹ ≤ b ↔ 1 ≤ b * a :=
(mul_le_mul_iff_right a).symm.trans $ by rw inv_mul_self

@[to_additive neg_le_iff_add_nonneg']
lemma inv_le_iff_one_le_mul' : a⁻¹ ≤ b ↔ 1 ≤ a * b :=
(mul_le_mul_iff_left a).symm.trans $ by rw mul_inv_self

@[to_additive]
lemma inv_lt_iff_one_lt_mul : a⁻¹ < b ↔ 1 < b * a :=
(mul_lt_mul_iff_right a).symm.trans $ by rw inv_mul_self

@[to_additive]
lemma inv_lt_iff_one_lt_mul' : a⁻¹ < b ↔ 1 < a * b :=
(mul_lt_mul_iff_left a).symm.trans $ by rw mul_inv_self

@[to_additive]
lemma le_inv_iff_mul_le_one : a ≤ b⁻¹ ↔ a * b ≤ 1 :=
(mul_le_mul_iff_right b).symm.trans $ by rw inv_mul_self

@[to_additive]
lemma le_inv_iff_mul_le_one' : a ≤ b⁻¹ ↔ b * a ≤ 1 :=
(mul_le_mul_iff_left b).symm.trans $ by rw mul_inv_self

@[to_additive]
lemma lt_inv_iff_mul_lt_one : a < b⁻¹ ↔ a * b < 1 :=
(mul_lt_mul_iff_right b).symm.trans $ by rw inv_mul_self

@[to_additive]
lemma lt_inv_iff_mul_lt_one' : a < b⁻¹ ↔ b * a < 1 :=
(mul_lt_mul_iff_left b).symm.trans $ by rw mul_inv_self

@[simp, to_additive neg_nonpos]
lemma inv_le_one' : a⁻¹ ≤ 1 ↔ 1 ≤ a :=
have a⁻¹ ≤ 1⁻¹ ↔ 1 ≤ a, from inv_le_inv_iff,
by rwa one_inv at this

@[simp, to_additive neg_nonneg]
lemma one_le_inv' : 1 ≤ a⁻¹ ↔ a ≤ 1 :=
have 1⁻¹ ≤ a⁻¹ ↔ a ≤ 1, from inv_le_inv_iff,
by rwa one_inv at this

@[to_additive]
lemma inv_le_self (h : 1 ≤ a) : a⁻¹ ≤ a :=
le_trans (inv_le_one'.2 h) h

@[to_additive]
lemma self_le_inv (h : a ≤ 1) : a ≤ a⁻¹ :=
le_trans h (one_le_inv'.2 h)

@[simp, to_additive]
lemma inv_lt_inv_iff : a⁻¹ < b⁻¹ ↔ b < a :=
have a * b * a⁻¹ < a * b * b⁻¹ ↔ a⁻¹ < b⁻¹, from mul_lt_mul_iff_left _,
by { rw [mul_inv_cancel_right, mul_comm a, mul_inv_cancel_right] at this, rw [this] }

@[to_additive neg_lt_zero]
lemma inv_lt_one' : a⁻¹ < 1 ↔ 1 < a :=
have a⁻¹ < 1⁻¹ ↔ 1 < a, from inv_lt_inv_iff,
by rwa one_inv at this

@[to_additive neg_pos]
lemma one_lt_inv' : 1 < a⁻¹ ↔ a < 1 :=
have 1⁻¹ < a⁻¹ ↔ a < 1, from inv_lt_inv_iff,
by rwa one_inv at this

@[to_additive neg_lt]
lemma inv_lt' : a⁻¹ < b ↔ b⁻¹ < a :=
have a⁻¹ < (b⁻¹)⁻¹ ↔ b⁻¹ < a, from inv_lt_inv_iff,
by rwa inv_inv at this

@[to_additive lt_neg]
lemma lt_inv' : a < b⁻¹ ↔ b < a⁻¹ :=
have (a⁻¹)⁻¹ < b⁻¹ ↔ b < a⁻¹, from inv_lt_inv_iff,
by rwa inv_inv at this

@[to_additive]
lemma inv_lt_self (h : 1 < a) : a⁻¹ < a :=
(inv_lt_one'.2 h).trans h

@[to_additive]
lemma le_inv_mul_iff_mul_le : b ≤ a⁻¹ * c ↔ a * b ≤ c :=
have a⁻¹ * (a * b) ≤ a⁻¹ * c ↔ a * b ≤ c, from mul_le_mul_iff_left _,
by rwa inv_mul_cancel_left at this

@[simp, to_additive]
lemma inv_mul_le_iff_le_mul : b⁻¹ * a ≤ c ↔ a ≤ b * c :=
have b⁻¹ * a ≤ b⁻¹ * (b * c) ↔ a ≤ b * c, from mul_le_mul_iff_left _,
by rwa inv_mul_cancel_left at this

@[to_additive]
lemma mul_inv_le_iff_le_mul : a * c⁻¹ ≤ b ↔ a ≤ b * c :=
by rw [mul_comm a, mul_comm b, inv_mul_le_iff_le_mul]

@[simp, to_additive]
lemma mul_inv_le_iff_le_mul' : a * b⁻¹ ≤ c ↔ a ≤ b * c :=
by rw [← inv_mul_le_iff_le_mul, mul_comm]

@[to_additive]
lemma inv_mul_le_iff_le_mul' : c⁻¹ * a ≤ b ↔ a ≤ b * c :=
by rw [inv_mul_le_iff_le_mul, mul_comm]

@[simp, to_additive]
lemma lt_inv_mul_iff_mul_lt : b < a⁻¹ * c ↔ a * b < c :=
have a⁻¹ * (a * b) < a⁻¹ * c ↔ a * b < c, from mul_lt_mul_iff_left _,
by rwa inv_mul_cancel_left at this

@[simp, to_additive]
lemma inv_mul_lt_iff_lt_mul : b⁻¹ * a < c ↔ a < b * c :=
have b⁻¹ * a < b⁻¹ * (b * c) ↔ a < b * c, from mul_lt_mul_iff_left _,
by rwa inv_mul_cancel_left at this

@[to_additive]
lemma inv_mul_lt_iff_lt_mul_right : c⁻¹ * a < b ↔ a < b * c :=
by rw [inv_mul_lt_iff_lt_mul, mul_comm]

@[to_additive add_neg_le_add_neg_iff]
lemma div_le_div_iff' : a * b⁻¹ ≤ c * d⁻¹ ↔ a * d ≤ c * b :=
begin
  split ; intro h,
  have := mul_le_mul_right' (mul_le_mul_right' h b) d,
  rwa [inv_mul_cancel_right, mul_assoc _ _ b, mul_comm _ b, ← mul_assoc, inv_mul_cancel_right]
    at this,
  have := mul_le_mul_right' (mul_le_mul_right' h d⁻¹) b⁻¹,
  rwa [mul_inv_cancel_right, _root_.mul_assoc, _root_.mul_comm d⁻¹ b⁻¹, ← mul_assoc,
    mul_inv_cancel_right] at this,
end

@[simp, to_additive] lemma div_le_self_iff (a : α) {b : α} : a / b ≤ a ↔ 1 ≤ b :=
by simp [div_eq_mul_inv]

@[simp, to_additive] lemma div_lt_self_iff (a : α) {b : α} : a / b < a ↔ 1 < b :=
by simp [div_eq_mul_inv]

/-- Pullback an `ordered_comm_group` under an injective map. -/
@[to_additive function.injective.ordered_add_comm_group
"Pullback an `ordered_add_comm_group` under an injective map."]
def function.injective.ordered_comm_group {β : Type*}
  [has_one β] [has_mul β] [has_inv β] [has_div β]
  (f : β → α) (hf : function.injective f) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹)
  (div : ∀ x y, f (x / y) = f x / f y) :
  ordered_comm_group β :=
{ ..partial_order.lift f hf,
  ..hf.ordered_comm_monoid f one mul,
  ..hf.comm_group f one mul inv div }

end ordered_comm_group

section ordered_add_comm_group
variables [ordered_add_comm_group α] {a b c d : α}

lemma sub_le_sub (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c :=
by simpa only [sub_eq_add_neg] using add_le_add hab (neg_le_neg hcd)

lemma sub_lt_sub (hab : a < b) (hcd : c < d) : a - d < b - c :=
by simpa only [sub_eq_add_neg] using add_lt_add hab (neg_lt_neg hcd)

alias sub_le_self_iff ↔ _ sub_le_self

alias sub_lt_self_iff ↔ _ sub_lt_self

lemma sub_le_sub_iff : a - b ≤ c - d ↔ a + d ≤ c + b :=
by simpa only [sub_eq_add_neg] using add_neg_le_add_neg_iff

@[simp]
lemma sub_le_sub_iff_left (a : α) {b c : α} : a - b ≤ a - c ↔ c ≤ b :=
by rw [sub_eq_add_neg, sub_eq_add_neg, add_le_add_iff_left, neg_le_neg_iff]

lemma sub_le_sub_left (h : a ≤ b) (c : α) : c - b ≤ c - a :=
(sub_le_sub_iff_left c).2 h

@[simp]
lemma sub_le_sub_iff_right (c : α) : a - c ≤ b - c ↔ a ≤ b :=
by simpa only [sub_eq_add_neg] using add_le_add_iff_right _

lemma sub_le_sub_right (h : a ≤ b) (c : α) : a - c ≤ b - c :=
(sub_le_sub_iff_right c).2 h

@[simp]
lemma sub_lt_sub_iff_left (a : α) {b c : α} : a - b < a - c ↔ c < b :=
by rw [sub_eq_add_neg, sub_eq_add_neg, add_lt_add_iff_left, neg_lt_neg_iff]

lemma sub_lt_sub_left (h : a < b) (c : α) : c - b < c - a :=
(sub_lt_sub_iff_left c).2 h

@[simp]
lemma sub_lt_sub_iff_right (c : α) : a - c < b - c ↔ a < b :=
by simpa only [sub_eq_add_neg] using add_lt_add_iff_right _

lemma sub_lt_sub_right (h : a < b) (c : α) : a - c < b - c :=
(sub_lt_sub_iff_right c).2 h

@[simp] lemma sub_nonneg : 0 ≤ a - b ↔ b ≤ a :=
by rw [← sub_self a, sub_le_sub_iff_left]

alias sub_nonneg ↔ le_of_sub_nonneg sub_nonneg_of_le

@[simp] lemma sub_nonpos : a - b ≤ 0 ↔ a ≤ b :=
by rw [← sub_self b,  sub_le_sub_iff_right]

alias sub_nonpos ↔ le_of_sub_nonpos sub_nonpos_of_le

@[simp] lemma sub_pos : 0 < a - b ↔ b < a :=
by rw [← sub_self a, sub_lt_sub_iff_left]

alias sub_pos ↔ lt_of_sub_pos sub_pos_of_lt

@[simp] lemma sub_lt_zero : a - b < 0 ↔ a < b :=
by rw [← sub_self b, sub_lt_sub_iff_right]

alias sub_lt_zero ↔ lt_of_sub_neg sub_neg_of_lt

lemma le_sub_iff_add_le' : b ≤ c - a ↔ a + b ≤ c :=
by rw [sub_eq_add_neg, add_comm, le_neg_add_iff_add_le]

lemma le_sub_iff_add_le : a ≤ c - b ↔ a + b ≤ c :=
by rw [le_sub_iff_add_le', add_comm]

alias le_sub_iff_add_le ↔ add_le_of_le_sub_right le_sub_right_of_add_le

lemma sub_le_iff_le_add' : a - b ≤ c ↔ a ≤ b + c :=
by rw [sub_eq_add_neg, add_comm, neg_add_le_iff_le_add]

alias le_sub_iff_add_le' ↔ add_le_of_le_sub_left le_sub_left_of_add_le

lemma sub_le_iff_le_add : a - c ≤ b ↔ a ≤ b + c :=
by rw [sub_le_iff_le_add', add_comm]

@[simp] lemma neg_le_sub_iff_le_add : -b ≤ a - c ↔ c ≤ a + b :=
le_sub_iff_add_le.trans neg_add_le_iff_le_add'

lemma neg_le_sub_iff_le_add' : -a ≤ b - c ↔ c ≤ a + b :=
by rw [neg_le_sub_iff_le_add, add_comm]

lemma sub_le : a - b ≤ c ↔ a - c ≤ b :=
sub_le_iff_le_add'.trans sub_le_iff_le_add.symm

theorem le_sub : a ≤ b - c ↔ c ≤ b - a :=
le_sub_iff_add_le'.trans le_sub_iff_add_le.symm

lemma lt_sub_iff_add_lt' : b < c - a ↔ a + b < c :=
by rw [sub_eq_add_neg, add_comm, lt_neg_add_iff_add_lt]

alias lt_sub_iff_add_lt' ↔ add_lt_of_lt_sub_left lt_sub_left_of_add_lt

lemma lt_sub_iff_add_lt : a < c - b ↔ a + b < c :=
by rw [lt_sub_iff_add_lt', add_comm]

alias lt_sub_iff_add_lt ↔ add_lt_of_lt_sub_right lt_sub_right_of_add_lt

lemma sub_lt_iff_lt_add' : a - b < c ↔ a < b + c :=
by rw [sub_eq_add_neg, add_comm, neg_add_lt_iff_lt_add]

alias sub_lt_iff_lt_add' ↔ lt_add_of_sub_left_lt sub_left_lt_of_lt_add

lemma sub_lt_iff_lt_add : a - c < b ↔ a < b + c :=
by rw [sub_lt_iff_lt_add', add_comm]

alias sub_lt_iff_lt_add ↔ lt_add_of_sub_right_lt sub_right_lt_of_lt_add

@[simp] lemma neg_lt_sub_iff_lt_add : -b < a - c ↔ c < a + b :=
lt_sub_iff_add_lt.trans neg_add_lt_iff_lt_add_right

lemma neg_lt_sub_iff_lt_add' : -a < b - c ↔ c < a + b :=
by rw [neg_lt_sub_iff_lt_add, add_comm]

lemma sub_lt : a - b < c ↔ a - c < b :=
sub_lt_iff_lt_add'.trans sub_lt_iff_lt_add.symm

theorem lt_sub : a < b - c ↔ c < b - a :=
lt_sub_iff_add_lt'.trans lt_sub_iff_add_lt.symm

end ordered_add_comm_group

/-!

### Linearly ordered commutative groups

-/

/-- A linearly ordered additive commutative group is an
additive commutative group with a linear order in which
addition is monotone. -/
@[protect_proj, ancestor add_comm_group linear_order]
class linear_ordered_add_comm_group (α : Type u) extends add_comm_group α, linear_order α :=
(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b)

/-- A linearly ordered commutative group is a
commutative group with a linear order in which
multiplication is monotone. -/
@[protect_proj, ancestor comm_group linear_order, to_additive]
class linear_ordered_comm_group (α : Type u) extends comm_group α, linear_order α :=
(mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b)

section linear_ordered_comm_group
variables [linear_ordered_comm_group α] {a b c : α}

@[priority 100, to_additive] -- see Note [lower instance priority]
instance linear_ordered_comm_group.to_ordered_comm_group : ordered_comm_group α :=
{ ..‹linear_ordered_comm_group α› }

@[priority 100, to_additive] -- see Note [lower instance priority]
instance linear_ordered_comm_group.to_linear_ordered_cancel_comm_monoid :
  linear_ordered_cancel_comm_monoid α :=
{ le_of_mul_le_mul_left := λ x y z, le_of_mul_le_mul_left',
  mul_left_cancel := λ x y z, mul_left_cancel,
  ..‹linear_ordered_comm_group α› }

/-- Pullback a `linear_ordered_comm_group` under an injective map. -/
@[to_additive function.injective.linear_ordered_add_comm_group
"Pullback a `linear_ordered_add_comm_group` under an injective map."]
def function.injective.linear_ordered_comm_group {β : Type*}
  [has_one β] [has_mul β] [has_inv β] [has_div β]
  (f : β → α) (hf : function.injective f) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹)
  (div : ∀ x y, f (x / y) = f x / f y)  :
  linear_ordered_comm_group β :=
{ ..linear_order.lift f hf,
  ..hf.ordered_comm_group f one mul inv div }

@[to_additive linear_ordered_add_comm_group.add_lt_add_left]
lemma linear_ordered_comm_group.mul_lt_mul_left'
  (a b : α) (h : a < b) (c : α) : c * a < c * b :=
ordered_comm_group.mul_lt_mul_left' a b h c

@[to_additive min_neg_neg]
lemma min_inv_inv' (a b : α) : min (a⁻¹) (b⁻¹) = (max a b)⁻¹ :=
eq.symm $ @monotone.map_max α (order_dual α) _ _ has_inv.inv a b $ λ a b, inv_le_inv'

@[to_additive max_neg_neg]
lemma max_inv_inv' (a b : α) : max (a⁻¹) (b⁻¹) = (min a b)⁻¹ :=
eq.symm $ @monotone.map_min α (order_dual α) _ _ has_inv.inv a b $ λ a b, inv_le_inv'

@[to_additive min_sub_sub_right]
lemma min_div_div_right' (a b c : α) : min (a / c) (b / c) = min a b / c :=
by simpa only [div_eq_mul_inv] using min_mul_mul_right a b (c⁻¹)

@[to_additive max_sub_sub_right]
lemma max_div_div_right' (a b c : α) : max (a / c) (b / c) = max a b / c :=
by simpa only [div_eq_mul_inv] using max_mul_mul_right a b (c⁻¹)

@[to_additive min_sub_sub_left]
lemma min_div_div_left' (a b c : α) : min (a / b) (a / c) = a / max b c :=
by simp only [div_eq_mul_inv, min_mul_mul_left, min_inv_inv']

@[to_additive max_sub_sub_left]
lemma max_div_div_left' (a b c : α) : max (a / b) (a / c) = a / min b c :=
by simp only [div_eq_mul_inv, max_mul_mul_left, max_inv_inv']

@[to_additive max_zero_sub_eq_self]
lemma max_one_div_eq_self' (a : α) : max a 1 / max (a⁻¹) 1 = a :=
begin
  rcases le_total a 1,
  { rw [max_eq_right h, max_eq_left, one_div, inv_inv], { rwa [le_inv', one_inv] } },
  { rw [max_eq_left, max_eq_right, div_eq_mul_inv, one_inv, mul_one],
    { rwa [inv_le', one_inv] }, exact h }
end

@[to_additive eq_zero_of_neg_eq]
lemma eq_one_of_inv_eq' (h : a⁻¹ = a) : a = 1 :=
match lt_trichotomy a 1 with
| or.inl h₁ :=
  have 1 < a, from h ▸ one_lt_inv_of_inv h₁,
  absurd h₁ this.asymm
| or.inr (or.inl h₁) := h₁
| or.inr (or.inr h₁) :=
  have a < 1, from h ▸ inv_inv_of_one_lt h₁,
  absurd h₁ this.asymm
end

@[to_additive exists_zero_lt]
lemma exists_one_lt' [nontrivial α] : ∃ (a:α), 1 < a :=
begin
  obtain ⟨y, hy⟩ := exists_ne (1 : α),
  cases hy.lt_or_lt,
  { exact ⟨y⁻¹, one_lt_inv'.mpr h⟩ },
  { exact ⟨y, h⟩ }
end

@[priority 100, to_additive] -- see Note [lower instance priority]
instance linear_ordered_comm_group.to_no_top_order [nontrivial α] :
  no_top_order α :=
⟨ begin
    obtain ⟨y, hy⟩ : ∃ (a:α), 1 < a := exists_one_lt',
    exact λ a, ⟨a * y, lt_mul_of_one_lt_right' a hy⟩
  end ⟩

@[priority 100, to_additive] -- see Note [lower instance priority]
instance linear_ordered_comm_group.to_no_bot_order [nontrivial α] : no_bot_order α :=
⟨ begin
    obtain ⟨y, hy⟩ : ∃ (a:α), 1 < a := exists_one_lt',
    exact λ a, ⟨a / y, (div_lt_self_iff a).mpr hy⟩
  end ⟩

end linear_ordered_comm_group

section linear_ordered_add_comm_group

variables [linear_ordered_add_comm_group α] {a b c : α}

@[simp]
lemma sub_le_sub_flip : a - b ≤ b - a ↔ a ≤ b :=
begin
  rw [sub_le_iff_le_add, sub_add_eq_add_sub, le_sub_iff_add_le],
  split,
  { intro h,
    by_contra H,
    rw not_le at H,
    apply not_lt.2 h,
    exact add_lt_add H H, },
  { intro h,
    exact add_le_add h h, }
end

lemma le_of_forall_pos_le_add [densely_ordered α] (h : ∀ ε : α, 0 < ε → a ≤ b + ε) : a ≤ b :=
le_of_forall_le_of_dense $ λ c hc,
calc a ≤ b + (c - b) : h _ (sub_pos_of_lt hc)
   ... = c           : add_sub_cancel'_right _ _

lemma le_of_forall_pos_lt_add (h : ∀ ε : α, 0 < ε → a < b + ε) : a ≤ b :=
le_of_not_lt $ λ h₁, by simpa using h _ (sub_pos_of_lt h₁)

/-- `abs a` is the absolute value of `a`. -/
def abs (a : α) : α := max a (-a)

lemma abs_of_nonneg (h : 0 ≤ a) : abs a = a :=
max_eq_left $ (neg_nonpos.2 h).trans h

lemma abs_of_pos (h : 0 < a) : abs a = a :=
abs_of_nonneg h.le

lemma abs_of_nonpos (h : a ≤ 0) : abs a = -a :=
max_eq_right $ h.trans (neg_nonneg.2 h)

lemma abs_of_neg (h : a < 0) : abs a = -a :=
abs_of_nonpos h.le

@[simp] lemma abs_zero : abs 0 = (0:α) :=
abs_of_nonneg le_rfl

@[simp] lemma abs_neg (a : α) : abs (-a) = abs a :=
begin unfold abs, rw [max_comm, neg_neg] end

@[simp] lemma abs_pos : 0 < abs a ↔ a ≠ 0 :=
begin
  rcases lt_trichotomy a 0 with (ha|rfl|ha),
  { simp [abs_of_neg ha, neg_pos, ha.ne, ha] },
  { simp },
  { simp [abs_of_pos ha, ha, ha.ne.symm] }
end

lemma abs_pos_of_pos (h : 0 < a) : 0 < abs a := abs_pos.2 h.ne.symm

lemma abs_pos_of_neg (h : a < 0) : 0 < abs a := abs_pos.2 h.ne

lemma abs_sub (a b : α) : abs (a - b) = abs (b - a) :=
by rw [← neg_sub, abs_neg]

lemma abs_le' : abs a ≤ b ↔ a ≤ b ∧ -a ≤ b := max_le_iff

lemma abs_le : abs a ≤ b ↔ - b ≤ a ∧ a ≤ b :=
by rw [abs_le', and.comm, neg_le]

lemma neg_le_of_abs_le (h : abs a ≤ b) : -b ≤ a := (abs_le.mp h).1

lemma le_of_abs_le (h : abs a ≤ b) : a ≤ b := (abs_le.mp h).2

lemma le_abs : a ≤ abs b ↔ a ≤ b ∨ a ≤ -b := le_max_iff

lemma le_abs_self (a : α) : a ≤ abs a := le_max_left _ _

lemma neg_le_abs_self (a : α) : -a ≤ abs a := le_max_right _ _

lemma abs_nonneg (a : α) : 0 ≤ abs a :=
(le_total 0 a).elim (λ h, h.trans (le_abs_self a)) (λ h, (neg_nonneg.2 h).trans $ neg_le_abs_self a)

@[simp] lemma abs_abs (a : α) : abs (abs a) = abs a :=
abs_of_nonneg $ abs_nonneg a

@[simp] lemma abs_eq_zero : abs a = 0 ↔ a = 0 :=
not_iff_not.1 $ ne_comm.trans $ (abs_nonneg a).lt_iff_ne.symm.trans abs_pos

@[simp] lemma abs_nonpos_iff {a : α} : abs a ≤ 0 ↔ a = 0 :=
(abs_nonneg a).le_iff_eq.trans abs_eq_zero

lemma abs_lt : abs a < b ↔ - b < a ∧ a < b :=
max_lt_iff.trans $ and.comm.trans $ by rw [neg_lt]

lemma neg_lt_of_abs_lt (h : abs a < b) : -b < a := (abs_lt.mp h).1

lemma lt_of_abs_lt (h : abs a < b) : a < b := (abs_lt.mp h).2

lemma lt_abs : a < abs b ↔ a < b ∨ a < -b := lt_max_iff

lemma max_sub_min_eq_abs' (a b : α) : max a b - min a b = abs (a - b) :=
begin
  cases le_total a b with ab ba,
  { rw [max_eq_right ab, min_eq_left ab, abs_of_nonpos, neg_sub], rwa sub_nonpos },
  { rw [max_eq_left ba, min_eq_right ba, abs_of_nonneg], rwa sub_nonneg }
end

lemma max_sub_min_eq_abs (a b : α) : max a b - min a b = abs (b - a) :=
by { rw [abs_sub], exact max_sub_min_eq_abs' _ _ }

lemma abs_add (a b : α) : abs (a + b) ≤ abs a + abs b :=
abs_le.2 ⟨(neg_add (abs a) (abs b)).symm ▸
  add_le_add (neg_le.2 $ neg_le_abs_self _) (neg_le.2 $ neg_le_abs_self _),
  add_le_add (le_abs_self _) (le_abs_self _)⟩

lemma abs_sub_le_iff : abs (a - b) ≤ c ↔ a - b ≤ c ∧ b - a ≤ c :=
by rw [abs_le, neg_le_sub_iff_le_add, @sub_le_iff_le_add' _ _ b, and_comm]

lemma abs_sub_lt_iff : abs (a - b) < c ↔ a - b < c ∧ b - a < c :=
by rw [abs_lt, neg_lt_sub_iff_lt_add, @sub_lt_iff_lt_add' _ _ b, and_comm]

lemma sub_le_of_abs_sub_le_left (h : abs (a - b) ≤ c) : b - c ≤ a :=
sub_le.1 $ (abs_sub_le_iff.1 h).2

lemma sub_le_of_abs_sub_le_right (h : abs (a - b) ≤ c) : a - c ≤ b :=
sub_le_of_abs_sub_le_left (abs_sub a b ▸ h)

lemma sub_lt_of_abs_sub_lt_left (h : abs (a - b) < c) : b - c < a :=
sub_lt.1 $ (abs_sub_lt_iff.1 h).2

lemma sub_lt_of_abs_sub_lt_right (h : abs (a - b) < c) : a - c < b :=
sub_lt_of_abs_sub_lt_left (abs_sub a b ▸ h)

lemma abs_sub_abs_le_abs_sub (a b : α) : abs a - abs b ≤ abs (a - b) :=
sub_le_iff_le_add.2 $
calc abs a = abs (a - b + b)     : by rw [sub_add_cancel]
       ... ≤ abs (a - b) + abs b : abs_add _ _

lemma abs_abs_sub_abs_le_abs_sub (a b : α) : abs (abs a - abs b) ≤ abs (a - b) :=
abs_sub_le_iff.2 ⟨abs_sub_abs_le_abs_sub _ _, by rw abs_sub; apply abs_sub_abs_le_abs_sub⟩

lemma abs_eq (hb : 0 ≤ b) : abs a = b ↔ a = b ∨ a = -b :=
iff.intro
  begin
    cases le_total a 0 with a_nonpos a_nonneg,
    { rw [abs_of_nonpos a_nonpos, neg_eq_iff_neg_eq, eq_comm], exact or.inr },
    { rw [abs_of_nonneg a_nonneg, eq_comm], exact or.inl }
  end
  (by intro h; cases h; subst h; try { rw abs_neg }; exact abs_of_nonneg hb)

lemma abs_le_max_abs_abs (hab : a ≤ b)  (hbc : b ≤ c) : abs b ≤ max (abs a) (abs c) :=
abs_le'.2
  ⟨by simp [hbc.trans (le_abs_self c)],
   by simp [(neg_le_neg hab).trans (neg_le_abs_self a)]⟩

theorem abs_le_abs (h₀ : a ≤ b) (h₁ : -a ≤ b) : abs a ≤ abs b :=
(abs_le'.2 ⟨h₀, h₁⟩).trans (le_abs_self b)

lemma abs_max_sub_max_le_abs (a b c : α) : abs (max a c - max b c) ≤ abs (a - b) :=
begin
  simp_rw [abs_le, le_sub_iff_add_le, sub_le_iff_le_add, ← max_add_add_left],
  split; apply max_le_max; simp only [← le_sub_iff_add_le, ← sub_le_iff_le_add, sub_self, neg_le,
    neg_le_abs_self, neg_zero, abs_nonneg, le_abs_self]
end

lemma eq_of_abs_sub_eq_zero {a b : α} (h : abs (a - b) = 0) : a = b :=
sub_eq_zero.1 $ abs_eq_zero.1 h

lemma abs_by_cases (P : α → Prop) {a : α} (h1 : P a) (h2 : P (-a)) : P (abs a) :=
sup_ind _ _ h1 h2

lemma abs_sub_le (a b c : α) : abs (a - c) ≤ abs (a - b) + abs (b - c) :=
calc
    abs (a - c) = abs (a - b + (b - c))     : by rw [sub_add_sub_cancel]
            ... ≤ abs (a - b) + abs (b - c) : abs_add _ _

lemma abs_add_three (a b c : α) : abs (a + b + c) ≤ abs a + abs b + abs c :=
(abs_add _ _).trans (add_le_add_right (abs_add _ _) _)

lemma dist_bdd_within_interval {a b lb ub : α} (hal : lb ≤ a) (hau : a ≤ ub)
      (hbl : lb ≤ b) (hbu : b ≤ ub) : abs (a - b) ≤ ub - lb :=
abs_sub_le_iff.2 ⟨sub_le_sub hau hbl, sub_le_sub hbu hal⟩

lemma eq_of_abs_sub_nonpos (h : abs (a - b) ≤ 0) : a = b :=
eq_of_abs_sub_eq_zero (le_antisymm h (abs_nonneg (a - b)))

end linear_ordered_add_comm_group

/-- This is not so much a new structure as a construction mechanism
  for ordered groups, by specifying only the "positive cone" of the group. -/
class nonneg_add_comm_group (α : Type*) extends add_comm_group α :=
(nonneg : α → Prop)
(pos : α → Prop := λ a, nonneg a ∧ ¬ nonneg (neg a))
(pos_iff : ∀ a, pos a ↔ nonneg a ∧ ¬ nonneg (-a) . order_laws_tac)
(zero_nonneg : nonneg 0)
(add_nonneg : ∀ {a b}, nonneg a → nonneg b → nonneg (a + b))
(nonneg_antisymm : ∀ {a}, nonneg a → nonneg (-a) → a = 0)

namespace nonneg_add_comm_group
variable [s : nonneg_add_comm_group α]
include s

@[reducible, priority 100] -- see Note [lower instance priority]
instance to_ordered_add_comm_group : ordered_add_comm_group α :=
{ le := λ a b, nonneg (b - a),
  lt := λ a b, pos (b - a),
  lt_iff_le_not_le := λ a b, by simp; rw [pos_iff]; simp,
  le_refl := λ a, by simp [zero_nonneg],
  le_trans := λ a b c nab nbc, by simp [-sub_eq_add_neg];
    rw ← sub_add_sub_cancel; exact add_nonneg nbc nab,
  le_antisymm := λ a b nab nba, eq_of_sub_eq_zero $
    nonneg_antisymm nba (by rw neg_sub; exact nab),
  add_le_add_left := λ a b nab c, by simpa [(≤), preorder.le] using nab,
  ..s }

theorem nonneg_def {a : α} : nonneg a ↔ 0 ≤ a :=
show _ ↔ nonneg _, by simp

theorem pos_def {a : α} : pos a ↔ 0 < a :=
show _ ↔ pos _, by simp

theorem not_zero_pos : ¬ pos (0 : α) :=
mt pos_def.1 (lt_irrefl _)

theorem zero_lt_iff_nonneg_nonneg {a : α} :
  0 < a ↔ nonneg a ∧ ¬ nonneg (-a) :=
pos_def.symm.trans (pos_iff _)

theorem nonneg_total_iff :
  (∀ a : α, nonneg a ∨ nonneg (-a)) ↔
  (∀ a b : α, a ≤ b ∨ b ≤ a) :=
⟨λ h a b, by have := h (b - a); rwa [neg_sub] at this,
 λ h a, by rw [nonneg_def, nonneg_def, neg_nonneg]; apply h⟩

/--
A `nonneg_add_comm_group` is a `linear_ordered_add_comm_group`
if `nonneg` is total and decidable.
-/
def to_linear_ordered_add_comm_group
  [decidable_pred (@nonneg α _)]
  (nonneg_total : ∀ a : α, nonneg a ∨ nonneg (-a))
  : linear_ordered_add_comm_group α :=
{ le := (≤),
  lt := (<),
  le_total := nonneg_total_iff.1 nonneg_total,
  decidable_le := by apply_instance,
  decidable_lt := by apply_instance,
  ..@nonneg_add_comm_group.to_ordered_add_comm_group _ s }

end nonneg_add_comm_group

namespace order_dual

instance [ordered_add_comm_group α] : ordered_add_comm_group (order_dual α) :=
{ add_left_neg := λ a : α, add_left_neg a,
  sub := λ a b, (a - b : α),
  ..order_dual.ordered_add_comm_monoid,
  ..show add_comm_group α, by apply_instance }

instance [linear_ordered_add_comm_group α] :
  linear_ordered_add_comm_group (order_dual α) :=
{ add_le_add_left := λ a b h c, @add_le_add_left α _ b a h _,
  ..order_dual.linear_order α,
  ..show add_comm_group α, by apply_instance }

end order_dual

namespace prod

variables {G H : Type*}

@[to_additive]
instance [ordered_comm_group G] [ordered_comm_group H] :
  ordered_comm_group (G × H) :=
{ .. prod.comm_group, .. prod.partial_order G H, .. prod.ordered_cancel_comm_monoid }

end prod

section type_tags

instance [ordered_add_comm_group α] : ordered_comm_group (multiplicative α) :=
{ ..multiplicative.comm_group,
  ..multiplicative.ordered_comm_monoid }

instance [ordered_comm_group α] : ordered_add_comm_group (additive α) :=
{ ..additive.add_comm_group,
  ..additive.ordered_add_comm_monoid }

instance [linear_ordered_add_comm_group α] : linear_ordered_comm_group (multiplicative α) :=
{ ..multiplicative.linear_order,
  ..multiplicative.ordered_comm_group }

instance [linear_ordered_comm_group α] : linear_ordered_add_comm_group (additive α) :=
{ ..additive.linear_order,
  ..additive.ordered_add_comm_group }

end type_tags


import tactic
import data.set.finite
import data.real.basic -- for metrics

/-
# (Re)-Building topological spaces in Lean
Mathlib has a large library of results on topological spaces, including various
constructions, separation axioms, Tychonoff's theorem, sheaves, Stone-Čech
compactification, Heine-Cantor, to name but a few.
See https://leanprover-community.github.io/theories/topology.html which for a
(subset) of what's in library.
But today we will ignore all that, and build our own version of topological
spaces from scratch!
(On Friday morning Patrick Massot will lead a session exploring the existing
mathlib library in more detail)
To get this file run either `leanproject get lftcm2020`, if you didn't already or cd to
that folder and run `git pull; leanproject get-mathlib-cache`, this is
`src/exercise_sources/wednesday/topological_spaces.lean`.
The exercises are spread throughout, you needn't do them in order! They are marked as
short, medium and long, so I suggest you try some short ones first.
First a little setup, we will be making definitions involving the real numbers,
the theory of which is not computable, and we'll use sets.
-/
noncomputable theory
open set

/-!
## What is a topological space:
There are many definitions: one from Wikipedia:
  A topological space is an ordered pair (X, τ), where X is a set and τ is a
  collection of subsets of X, satisfying the following axioms:
  - The empty set and X itself belong to τ.
  - Any arbitrary (finite or infinite) union of members of τ still belongs to τ.
  - The intersection of any finite number of members of τ still belongs to τ.
We can formalize this as follows: -/

class topological_space_wiki :=
  (X : Type)  -- the underlying Type that the topology will be on
  (τ : set (set X))  -- the set of open subsets of X
  (empty_mem : ∅ ∈ τ)  -- empty set is open
  (univ_mem : univ ∈ τ)  -- whole space is open
  (union : ∀ B ⊆ τ, ⋃₀ B ∈ τ)  -- arbitrary unions (sUnions) of members of τ are open
  (inter : ∀ (B ⊆ τ) (h : set.finite B), ⋂₀ B ∈ τ)  -- finite intersections of
                                                -- members of τ are open

/-
Before we go on we should be sure we want to use this as our definition.
-/

@[ext]
class topological_space (X : Type) :=
  (is_open : set X → Prop) -- why set X → Prop not set (set X)? former plays
                           -- nicer with typeclasses later
  (univ_mem : is_open univ)
  (union : ∀ (B : set (set X)) (h : ∀ b ∈ B, is_open b), is_open (⋃₀ B))
  (inter : ∀ (A B : set X) (hA : is_open A) (hB : is_open B), is_open (A ∩ B))

namespace topological_space

/- We can now work with topological spaces like this. -/
example (X : Type) [topological_space X] (U V W : set X) (hU : is_open U) (hV : is_open V)
  (hW : is_open W) : is_open (U ∩ V ∩ W) :=
begin
  apply inter _ _ _ hW,
  exact inter _ _ hU hV,
end

/- ## Exercise 0 [short]:
One of the axioms of a topological space we have here is unnecessary, it follows
from the others. If we remove it we'll have less work to do each time we want to
create a new topological space so:
1. Identify and remove the unneeded axiom, make sure to remove it throughout the file.
2. Add the axiom back as a lemma with the same name and prove it based on the
   others, so that the _interface_ is the same. -/

lemma empty_mem (X : Type) [topological_space X] : is_open (∅ : set X) :=
begin
  convert union (∅ : set (set X)) _; simp,
end

/- Defining a basic topology now works like so: -/
def discrete (X : Type) : topological_space X :=
{ is_open := λ U, true, -- everything is open
  univ_mem := trivial,
  union := begin intros B h, trivial, end,
  inter := begin intros A hA B hB, trivial, end }

/- ## Exercise 1 [medium]:
One way me might want to create topological spaces in practice is to take
the coarsest possible topological space containing a given set of is_open.
To define this we might say we want to define what `is_open` is given the set
of generators.
So we want to define the predicate `is_open` by declaring that each generator
will be open, the intersection of two opens will be open, and each union of a
set of opens will be open, and finally the empty and whole space (`univ`) must
be open. The cleanest way to do this is as an inductive definition.
The exercise is to make this definition of the topological space generated by a
given set in Lean.
### Hint:
As a hint for this exercise take a look at the following definition of a
constructible set of a topological space, defined by saying that an intersection
of an open and a closed set is constructible and that the union of any pair of
constructible sets is constructible.
(Bonus exercise: mathlib doesn't have any theory of constructible sets, make one and PR
it! [arbitrarily long!], or just prove that open and closed sets are constructible for now) -/

inductive is_constructible {X : Type} (T : topological_space X) : set X → Prop
/- Given two open sets in `T`, the intersection of one with the complement of
   the other open is locally closed, hence constructible: -/
| locally_closed : ∀ (A B : set X), is_open A → is_open B → is_constructible (A ∩ Bᶜ)
-- Given two constructible sets their union is constructible:
| union : ∀ A B, is_constructible A → is_constructible B → is_constructible (A ∪ B)

-- For example we can now use this definition to prove the empty set is constructible
example {X : Type} (T : topological_space X) : is_constructible T ∅ :=
begin
  -- The intersection of the whole space (open) with the empty set (closed) is
  -- locally closed, hence constructible
  have := is_constructible.locally_closed univ univ T.univ_mem T.univ_mem,
  -- but simp knows that's just the empty set (`simp` uses `this` automatically)
  simpa,
end

/-- The open sets of the least topology containing a collection of basic sets. -/
inductive generated_open (X : Type) (g : set (set X)) : set X → Prop
-- The exercise: Add a definition here defining which sets are generated by `g` like the
-- `is_constructible` definition above.
| basic : ∀ s ∈ g, generated_open s
| univ : generated_open univ
| inter : ∀ s t, generated_open s → generated_open t → generated_open (s ∩ t)
| sUnion : ∀ k, (∀ s ∈ k, generated_open s) → generated_open (⋃₀ k)

/-- The smallest topological space containing the collection `g` of basic sets -/
def generate_from (X : Type) (g : set (set X)) : topological_space X :=
{ is_open   := generated_open X g,
  univ_mem  := generated_open.univ,
  inter     := generated_open.inter,
  union     := generated_open.sUnion }

/- ## Exercise 2 [short]:
Define the indiscrete topology on any type using this.
(To do it without this it is surprisingly fiddly to prove that the set `{∅, univ}`
actually forms a topology) -/
def indiscrete (X : Type) : topological_space X :=
  generate_from X ∅
end topological_space

open topological_space
/- Now it is quite easy to give a topology on the product of a pair of
   topological spaces. -/
instance prod.topological_space (X Y : Type) [topological_space X]
  [topological_space Y] : topological_space (X × Y) :=
topological_space.generate_from (X × Y) {U | ∃ (Ux : set X) (Uy : set Y)
  (hx : is_open Ux) (hy : is_open Uy), U = Ux ×ˢ Uy}

-- the proof of this is bit long so I've left it out for the purpose of this file!
lemma is_open_prod_iff (X Y : Type) [topological_space X] [topological_space Y]
  {s : set (X × Y)} :
is_open s ↔ (∀a b, (a, b) ∈ s → ∃ (u : set X) (v : set Y), is_open u ∧ is_open v ∧
                                  a ∈ u ∧ b ∈ v ∧ u ×ˢ v ⊆ s) := sorry

/- # Metric spaces -/

open_locale big_operators

class metric_space_basic (X : Type) :=
  (dist : X → X → ℝ)
  (dist_eq_zero_iff : ∀ x y, dist x y = 0 ↔ x = y)
  (dist_symm : ∀ x y, dist x y = dist y x)
  (triangle : ∀ x y z, dist x z ≤ dist x y + dist y z)

namespace metric_space_basic
open topological_space

/- ## Exercise 3 [short]:
We have defined a metric space with a metric landing in ℝ, and made no mention of
nonnegativity, (this is in line with the philosophy of using the easiest axioms for our
definitions as possible, to make it easier to define individual metrics). Show that we
really did define the usual notion of metric space. -/
lemma dist_nonneg {X : Type} [metric_space_basic X] (x y : X) : 0 ≤ dist x y :=
begin
  have : 0 ≤ 2 * dist x y,
  calc
    0 = dist x x : by symmetry; rw [dist_eq_zero_iff x x]
    ... ≤ dist x y + dist y x : by simp only [triangle]
    ... = dist x y + dist x y : by rw [dist_symm]
    ... = 2 * dist x y : by rw two_mul,
  linarith [this],
end

/- From a metric space we get an induced topological space structure like so: -/

instance {X : Type} [metric_space_basic X] : topological_space X :=
generate_from X { B | ∃ (x : X) r, B = {y | dist x y < r} }

end metric_space_basic

open metric_space_basic

/- So far so good, now lets define the product of two metric spaces:
## Exercise 4 [medium]:
Fill in the proofs here.
Hint: the computer can do boring casework you would never dream of in real life.
`max` is defined as `if x < y then y else x` and the `split_ifs` tactic will
break apart if statements. -/
instance prod.metric_space_basic (X Y : Type) [metric_space_basic X] [metric_space_basic Y] :
metric_space_basic (X × Y) :=
{ dist := λ u v, max (dist u.fst v.fst) (dist u.snd v.snd),
  dist_eq_zero_iff :=
    begin
      intros x y, split,
      { intro h,
        have hf := dist_nonneg x.1 y.1,
        have hs := dist_nonneg x.2 y.2,
        have := max_le_iff.mp (le_of_eq h),
        ext; rw ← dist_eq_zero_iff; linarith,},
      { intro h, rw [h, (dist_eq_zero_iff _ _).mpr, (dist_eq_zero_iff _ _).mpr, max_self]; refl,}
    end,
  dist_symm := by { intros x y, simp [dist_symm]},
  triangle :=
    begin
      intros x y z,
      have hf := triangle x.fst y.fst z.fst,
      have hs := triangle x.snd y.snd z.snd,
      simp only [max, max_default],
      split_ifs; linarith,
    end
  }


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.list.perm

/-!
# Sorting algorithms on lists

In this file we define `list.sorted r l` to be an alias for `pairwise r l`. This alias is preferred
in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms:
`list.insertion_sort` and `list.merge_sort`, and prove their correctness.
-/

open list.perm

universe uu

namespace list

/-!
### The predicate `list.sorted`
-/

section sorted

variables {α : Type uu} {r : α → α → Prop} {a : α} {l : list α}

/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def sorted := @pairwise

instance decidable_sorted [decidable_rel r] (l : list α) : decidable (sorted r l) :=
list.decidable_pairwise _

@[simp] theorem sorted_nil : sorted r [] := pairwise.nil

lemma sorted.of_cons : sorted r (a :: l) → sorted r l := pairwise.of_cons

theorem sorted.tail {r : α → α → Prop} {l : list α} (h : sorted r l) : sorted r l.tail :=
h.tail

theorem rel_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) →
  ∀ b ∈ l, r a b :=
rel_of_pairwise_cons

@[simp] theorem sorted_cons {a : α} {l : list α} :
  sorted r (a :: l) ↔ (∀ b ∈ l, r a b) ∧ sorted r l :=
pairwise_cons

protected theorem sorted.nodup {r : α → α → Prop} [is_irrefl α r] {l : list α} (h : sorted r l) :
  nodup l :=
h.nodup

theorem eq_of_perm_of_sorted [is_antisymm α r]
  {l₁ l₂ : list α} (p : l₁ ~ l₂) (s₁ : sorted r l₁) (s₂ : sorted r l₂) : l₁ = l₂ :=
begin
  induction s₁ with a l₁ h₁ s₁ IH generalizing l₂,
  { exact p.nil_eq },
  { have : a ∈ l₂ := p.subset (mem_cons_self _ _),
    rcases mem_split this with ⟨u₂, v₂, rfl⟩,
    have p' := (perm_cons a).1 (p.trans perm_middle),
    obtain rfl := IH p' (s₂.sublist $ by simp),
    change a::u₂ ++ v₂ = u₂ ++ ([a] ++ v₂), rw ← append_assoc, congr,
    have : ∀ (x : α) (h : x ∈ u₂), x = a := λ x m,
      antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _))
        (h₁ _ (by simp [m])),
    rw [(@eq_repeat _ a (length u₂ + 1) (a::u₂)).2,
        (@eq_repeat _ a (length u₂ + 1) (u₂++[a])).2];
    split; simp [iff_true_intro this, or_comm] }
end

theorem sublist_of_subperm_of_sorted [is_antisymm α r]
  {l₁ l₂ : list α} (p : l₁ <+~ l₂) (s₁ : l₁.sorted r) (s₂ : l₂.sorted r) : l₁ <+ l₂ :=
let ⟨_, h, h'⟩ := p in by rwa ←eq_of_perm_of_sorted h (s₂.sublist h') s₁

@[simp] theorem sorted_singleton (a : α) : sorted r [a] := pairwise_singleton _ _

lemma sorted.rel_nth_le_of_lt {l : list α}
  (h : l.sorted r) {a b : ℕ} (ha : a < l.length) (hb : b < l.length) (hab : a < b) :
  r (l.nth_le a ha) (l.nth_le b hb) :=
list.pairwise_iff_nth_le.1 h a b hb hab

lemma sorted.rel_nth_le_of_le [is_refl α r] {l : list α}
  (h : l.sorted r) {a b : ℕ} (ha : a < l.length) (hb : b < l.length) (hab : a ≤ b) :
  r (l.nth_le a ha) (l.nth_le b hb) :=
begin
  cases eq_or_lt_of_le hab with H H,
  { subst H, exact refl _ },
  { exact h.rel_nth_le_of_lt _ _ H }
end

lemma sorted.rel_of_mem_take_of_mem_drop {l : list α} (h : list.sorted r l)
  {k : ℕ} {x y : α} (hx : x ∈ list.take k l) (hy : y ∈ list.drop k l) :
  r x y :=
begin
  obtain ⟨iy, hiy, rfl⟩ := nth_le_of_mem hy,
  obtain ⟨ix, hix, rfl⟩ := nth_le_of_mem hx,
  rw [nth_le_take', nth_le_drop'],
  rw length_take at hix,
  exact h.rel_nth_le_of_lt _ _ (ix.lt_add_right _ _ (lt_min_iff.mp hix).left)
end

end sorted

section sort
variables {α : Type uu} (r : α → α → Prop) [decidable_rel r]
local infix ` ≼ ` : 50 := r

/-! ### Insertion sort -/

section insertion_sort

/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp] def ordered_insert (a : α) : list α → list α
| []       := [a]
| (b :: l) := if a ≼ b then a :: b :: l else b :: ordered_insert l

/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp] def insertion_sort : list α → list α
| []       := []
| (b :: l) := ordered_insert r b (insertion_sort l)

@[simp] lemma ordered_insert_nil (a : α) : [].ordered_insert r a = [a] := rfl

theorem ordered_insert_length : Π (L : list α) (a : α), (L.ordered_insert r a).length = L.length + 1
| [] a := rfl
| (hd :: tl) a := by { dsimp [ordered_insert], split_ifs; simp [ordered_insert_length], }

/-- An alternative definition of `ordered_insert` using `take_while` and `drop_while`. -/
lemma ordered_insert_eq_take_drop (a : α) : ∀ l : list α,
  l.ordered_insert r a = l.take_while (λ b, ¬(a ≼ b)) ++ (a :: l.drop_while (λ b, ¬(a ≼ b)))
| [] := rfl
| (b :: l) := by { dsimp only [ordered_insert], split_ifs; simp [take_while, drop_while, *] }

lemma insertion_sort_cons_eq_take_drop (a : α) (l : list α) :
  insertion_sort r (a :: l) = (insertion_sort r l).take_while (λ b, ¬(a ≼ b)) ++
    (a :: (insertion_sort r l).drop_while (λ b, ¬(a ≼ b))) :=
ordered_insert_eq_take_drop r a _

section correctness
open perm

theorem perm_ordered_insert (a) : ∀ l : list α, ordered_insert r a l ~ a :: l
| []       := perm.refl _
| (b :: l) := by by_cases a ≼ b; [simp [ordered_insert, h],
  simpa [ordered_insert, h] using
    ((perm_ordered_insert l).cons _).trans (perm.swap _ _ _)]

theorem ordered_insert_count [decidable_eq α] (L : list α) (a b : α) :
  count a (L.ordered_insert r b) = count a L + if (a = b) then 1 else 0 :=
begin
  rw [(L.perm_ordered_insert r b).count_eq, count_cons],
  split_ifs; simp only [nat.succ_eq_add_one, add_zero],
end

theorem perm_insertion_sort : ∀ l : list α, insertion_sort r l ~ l
| []       := perm.nil
| (b :: l) := by simpa [insertion_sort] using
  (perm_ordered_insert _ _ _).trans ((perm_insertion_sort l).cons b)

variable {r}

/-- If `l` is already `list.sorted` with respect to `r`, then `insertion_sort` does not change
it. -/
lemma sorted.insertion_sort_eq : ∀ {l : list α} (h : sorted r l), insertion_sort r l = l
| [] _ := rfl
| [a] _ := rfl
| (a :: b :: l) h :=
  begin
    rw [insertion_sort, sorted.insertion_sort_eq, ordered_insert, if_pos],
    exacts [rel_of_sorted_cons h _ (or.inl rfl), h.tail]
  end

section total_and_transitive
variables [is_total α r] [is_trans α r]

theorem sorted.ordered_insert (a : α) : ∀ l, sorted r l → sorted r (ordered_insert r a l)
| []       h := sorted_singleton a
| (b :: l) h := begin
  by_cases h' : a ≼ b,
  { simpa [ordered_insert, h', h] using λ b' bm, trans h' (rel_of_sorted_cons h _ bm) },
  { suffices : ∀ (b' : α), b' ∈ ordered_insert r a l → r b b',
    { simpa [ordered_insert, h', h.of_cons.ordered_insert l] },
    intros b' bm,
    cases (show b' = a ∨ b' ∈ l, by simpa using
      (perm_ordered_insert _ _ _).subset bm) with be bm,
    { subst b', exact (total_of r _ _).resolve_left h' },
    { exact rel_of_sorted_cons h _ bm } }
end

variable (r)

/-- The list `list.insertion_sort r l` is `list.sorted` with respect to `r`. -/
theorem sorted_insertion_sort : ∀ l, sorted r (insertion_sort r l)
| []       := sorted_nil
| (a :: l) := (sorted_insertion_sort l).ordered_insert a _

end total_and_transitive
end correctness
end insertion_sort

/-! ### Merge sort -/

section merge_sort

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the
-- equation compiler can't prove the third equation

/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp] def split : list α → list α × list α
| []       := ([], [])
| (a :: l) := let (l₁, l₂) := split l in (a :: l₂, l₁)

theorem split_cons_of_eq (a : α) {l l₁ l₂ : list α} (h : split l = (l₁, l₂)) :
  split (a :: l) = (a :: l₂, l₁) :=
by rw [split, h]; refl

theorem length_split_le : ∀ {l l₁ l₂ : list α},
  split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l
| []     ._  ._  rfl := ⟨nat.le_refl 0, nat.le_refl 0⟩
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ h₂, nat.le_succ_of_le h₁⟩
end

theorem length_split_lt {a b} {l l₁ l₂ : list α} (h : split (a::b::l) = (l₁, l₂)) :
  length l₁ < length (a::b::l) ∧ length l₂ < length (a::b::l) :=
begin
  cases e : split l with l₁' l₂',
  injection (split_cons_of_eq _ (split_cons_of_eq _ e)).symm.trans h, substs l₁ l₂,
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ (nat.succ_le_succ h₁), nat.succ_le_succ (nat.succ_le_succ h₂)⟩
end

theorem perm_split : ∀ {l l₁ l₂ : list α}, split l = (l₁, l₂) → l ~ l₁ ++ l₂
| []     ._  ._  rfl := perm.refl _
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  exact ((perm_split e).trans perm_append_comm).cons a,
end

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge : list α → list α → list α
| []       l'        := l'
| l        []        := l
| (a :: l) (b :: l') := if a ≼ b then a :: merge l (b :: l') else b :: merge (a :: l) l'

include r
/-- Implementation of a merge sort algorithm to sort a list. -/
def merge_sort : list α → list α
| []        := []
| [a]       := [a]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  exact merge r (merge_sort l₁) (merge_sort l₂)
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_cons_cons {a b} {l l₁ l₂ : list α}
  (h : split (a::b::l) = (l₁, l₂)) :
  merge_sort r (a::b::l) = merge r (merge_sort r l₁) (merge_sort r l₂) :=
begin
  suffices : ∀ (L : list α) h1, @@and.rec
    (λ a a (_ : length l₁ < length l + 1 + 1 ∧
      length l₂ < length l + 1 + 1), L) h1 h1 = L,
  { simp [merge_sort, h], apply this },
  intros, cases h1, refl
end

section correctness

theorem perm_merge : ∀ (l l' : list α), merge r l l' ~ l ++ l'
| []       []        := by simp [merge]
| []       (b :: l') := by simp [merge]
| (a :: l) []        := by simp [merge]
| (a :: l) (b :: l') := begin
  by_cases a ≼ b,
  { simpa [merge, h] using perm_merge _ _ },
  { suffices : b :: merge r (a :: l) l' ~ a :: (l ++ b :: l'), {simpa [merge, h]},
    exact ((perm_merge _ _).cons _).trans ((swap _ _ _).trans (perm_middle.symm.cons _)) }
end

theorem perm_merge_sort : ∀ l : list α, merge_sort r l ~ l
| []        := by simp [merge_sort]
| [a]       := by simp [merge_sort]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  apply (perm_merge r _ _).trans,
  exact ((perm_merge_sort l₁).append (perm_merge_sort l₂)).trans (perm_split e).symm
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

@[simp] lemma length_merge_sort (l : list α) : (merge_sort r l).length = l.length :=
(perm_merge_sort r _).length_eq

section total_and_transitive
variables {r} [is_total α r] [is_trans α r]

theorem sorted.merge : ∀ {l l' : list α}, sorted r l → sorted r l' → sorted r (merge r l l')
| []       []        h₁ h₂ := by simp [merge]
| []       (b :: l') h₁ h₂ := by simpa [merge] using h₂
| (a :: l) []        h₁ h₂ := by simpa [merge] using h₁
| (a :: l) (b :: l') h₁ h₂ := begin
  by_cases a ≼ b,
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r l (b :: l')), r a b',
    { simpa [merge, h, h₁.of_cons.merge h₂] },
    intros b' bm,
    rcases (show b' = b ∨ b' ∈ l ∨ b' ∈ l', by simpa [or.left_comm] using
      (perm_merge _ _ _).subset bm) with be | bl | bl',
    { subst b', assumption },
    { exact rel_of_sorted_cons h₁ _ bl },
    { exact trans h (rel_of_sorted_cons h₂ _ bl') } },
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r (a :: l) l'), r b b',
    { simpa [merge, h, h₁.merge h₂.of_cons] },
    intros b' bm,
    have ba : b ≼ a := (total_of r _ _).resolve_left h,
    rcases (show b' = a ∨ b' ∈ l ∨ b' ∈ l', by simpa using
      (perm_merge _ _ _).subset bm) with be | bl | bl',
    { subst b', assumption },
    { exact trans ba (rel_of_sorted_cons h₁ _ bl) },
    { exact rel_of_sorted_cons h₂ _ bl' } }
end

variable (r)

theorem sorted_merge_sort : ∀ l : list α, sorted r (merge_sort r l)
| []        := by simp [merge_sort]
| [a]       := by simp [merge_sort]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  exact (sorted_merge_sort l₁).merge (sorted_merge_sort l₂)
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_eq_self [is_antisymm α r] {l : list α} : sorted r l → merge_sort r l = l :=
eq_of_perm_of_sorted (perm_merge_sort _ _) (sorted_merge_sort _ _)

theorem merge_sort_eq_insertion_sort [is_antisymm α r] (l : list α) :
  merge_sort r l = insertion_sort r l :=
eq_of_perm_of_sorted ((perm_merge_sort r l).trans (perm_insertion_sort r l).symm)
  (sorted_merge_sort r l) (sorted_insertion_sort r l)

end total_and_transitive
end correctness

@[simp] theorem merge_sort_nil : [].merge_sort r = [] :=
by rw list.merge_sort

@[simp] theorem merge_sort_singleton (a : α) : [a].merge_sort r = [a] :=
by rw list.merge_sort

end merge_sort
end sort

/- try them out! -/

--#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

--#eval merge_sort     (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

end list


import ..lectures.love01_definitions_and_statements_demo
import ..lectures.love10_denotational_semantics_demo

/-!
# FPV Homework 6: Operational and denotational semantics

This homework corresponds to chapters 8 and 10 of the HHG.
-/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (4 points): Operational Semantics of Regular Expressions

Regular expression are a very popular tool for software development. Often,
when textual input needs to be analyzed it is matched against a regular
expression. In this question, we define the syntax of regular expressions and
what it means for a regular expression to match a string.

We define `regex` to represent the following grammar:

    R ::= ∅       — `nothing`: matches nothing
        | ε       — `empty`: matches the empty string
        | a       — `atom`: matches the atom `a`
        | R ⬝ R    — `concat`: matches the concatenation of two regexes
        | R + R   — `alt`: matches either of two regexes
        | R*      — `star`: matches arbitrary many repetitions of a regex

Notice the rough correspondence with a WHILE language:

    `empty`  ~ `skip`
    `atom`   ~ assignment
    `concat` ~ sequential composition
    `alt`    ~ conditional statement
    `star`   ~ while loop -/

inductive regex (α : Type) : Type
| nothing {} : regex
| empty   {} : regex
| atom       : α → regex
| concat     : regex → regex → regex
| alt        : regex → regex → regex
| star       : regex → regex

/-! The `matches r s` predicate indicates that the regular expression `r` matches
the string `s`. -/

inductive matches {α : Type } : regex α → list α → Prop
| empty :
  matches regex.empty []
| atom (a : α) :
  matches (regex.atom a) [a]
| concat {r₁ r₂ : regex α} (s₁ s₂ : list α) (h₁ : matches r₁ s₁)
    (h₂ : matches r₂ s₂) :
  matches (regex.concat r₁ r₂) (s₁ ++ s₂)
| alt_left {r₁ r₂ : regex α} (s : list α) (h : matches r₁ s) :
  matches (regex.alt r₁ r₂) s
| alt_right {r₁ r₂ : regex α} (s : list α) (h : matches r₂ s) :
  matches (regex.alt r₁ r₂) s
| star_base {r : regex α} :
  matches (regex.star r) []
| star_step {r : regex α} (s s' : list α) (h₁ : matches r s)
    (h₂ : matches (regex.star r) s') :
  matches (regex.star r) (s ++ s')

/-! The introduction rules correspond to the following cases:

* match the empty string
* match one atom (e.g., character)
* match two concatenated regexes
* match the left option
* match the right option
* match the empty string (the base case of `R*`)
* match `R` followed again by `R*` (the induction step of `R*`)

1.1 (1 point). Explain why there is no rule for `nothing`. -/

-- enter your answer here

/-! 1.2 (3 points). Prove the following inversion rules. -/

@[simp] lemma matches_atom {α : Type} {s : list α} {a : α} :
  matches (regex.atom a) s ↔ s = [a] :=
sorry

@[simp] lemma matches_nothing {α : Type} {s : list α} :
  ¬ matches regex.nothing s :=
sorry

@[simp] lemma matches_empty {α : Type} {s : list α} :
  matches regex.empty s ↔ s = [] :=
sorry

@[simp] lemma matches_concat {α : Type} {s : list α} {r₁ r₂ : regex α} :
  matches (regex.concat r₁ r₂) s
  ↔ (∃s₁ s₂, matches r₁ s₁ ∧ matches r₂ s₂ ∧ s = s₁ ++ s₂) :=
sorry

@[simp] lemma matches_alt {α : Type} {s : list α} {r₁ r₂ : regex α} :
  matches (regex.alt r₁ r₂) s ↔ (matches r₁ s ∨ matches r₂ s) :=
sorry

/-! ## Question 2: Monotonicity (4 points)

2.1 (2 points). Prove the following lemma from the Ch. 10 lecture. -/

lemma monotone_comp {α β : Type} [partial_order α] (f g : α → set (β × β))
    (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
sorry

/-! 2.2 (2 points). Prove its cousin. -/

lemma monotone_restrict {α β : Type} [partial_order α] (f : α → set (β × β))
    (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
sorry

/-! ## Question 3: Denotational Semantics of Regular Expressions (4 points)

In this exercise, we explore an alternative semantics of regular
expressions. Namely, we can imagine that the atoms represent binary relations,
instead of letters or symbols. Concatenation corresponds to composition of
relations, and alternation is union. Mathematically, regexes and binary
relations are both instances of Kleene algebras.

3.1 (2 points). Complete the following translation of regular expressions to relations.

Hint: Exploit the correspondence with the WHILE language. -/

def rel_of_regex {α : Type} : regex (set (α × α)) → set (α × α)
| regex.nothing        := ∅
| regex.empty          := Id
| (regex.atom s)       := s
-- enter the missing cases here

/-! 3.2 (2 points). Prove the following recursive equation about your definition. -/

lemma rel_of_regex_star {α : Type} (r : regex (set (α × α))) :
  rel_of_regex (regex.star r) =
  rel_of_regex (regex.alt (regex.concat r (regex.star r)) regex.empty) :=
sorry

end LoVe


import game.max.level10

open_locale classical

noncomputable theory

namespace test

variables {a b c : ℝ}

-- What ℝ has that a general total order hasn't got, is - .

example : -a ≤ -b ↔ b ≤ a := by split; intros; linarith

def abs (x : ℝ) := max x (-x)

-- useful for rewriting
lemma abs_def (x : ℝ) : abs x = max x (-x) := rfl

-- needs congr'
lemma abs_neg (x : ℝ) : abs (-x) = abs x :=
begin
  rw abs_def,
  rw abs_def,
  rw max_comm,
  congr',
  ring,
end

-- order level 3
-- Powerful. Teaches them the colon.
theorem abs_le : abs a ≤ b ↔ -b ≤ a ∧ a ≤ b :=
begin
  rw abs_def,
  rw max_le_iff,
  split;
  intro h;
  cases h;
  split;
  linarith,
end

theorem abs_of_nonneg (h : 0 ≤ a) : abs a = a :=
begin
  rw abs_def,
  apply max_eq_left,
  linarith,
end

theorem abs_of_nonpos (h : a ≤ 0) : abs a = -a :=
begin
  rw abs_def,
  apply max_eq_right,
  linarith,
end

variables (a b) -- want them explicit in the next few

theorem abs_add : abs (a + b) ≤ abs a + abs b :=
begin
  rw abs_le,
  cases le_total 0 a with h0a ha0,
  { -- 0 ≤ a
    rw abs_of_nonneg h0a,
    cases le_total 0 b with h0b hb0,
    { rw abs_of_nonneg h0b,
      split; linarith
    },
    { rw abs_of_nonpos hb0,
      split; linarith
    },
  },
  { -- a ≤ 0
    rw abs_of_nonpos ha0,
    cases le_total 0 b with h0b hb0,
    { rw abs_of_nonneg h0b,
      split; linarith
    },
    { rw abs_of_nonpos hb0,
      split; linarith
    },
  },
end

-- order level 4
-- convert makes this simple
theorem abs_sub_le_add_abs : abs (a - b) ≤ abs a + abs b :=
begin
  rw ←abs_neg b,
  convert abs_add a (-b),
end

-- order level 5
-- combination of ring and linarith; always try and deduce from triangle ineq
theorem abs_abs_sub_le_abs_sub : abs (abs a - abs b) ≤ abs (a - b) :=
begin
  rw abs_le,
  split,
  { have h := abs_sub_le_add_abs a (a - b),
    ring_nf at h,
    linarith,
  },
  { have h := abs_sub_le_add_abs (a - b) (-b),
    rw abs_neg at h,
    ring_nf at h,
    linarith,
  }
end

-- order level 2
theorem abs_mul (a b : ℝ) : abs (a * b) = abs a * abs b :=
begin
  cases le_total 0 a with h0a ha0;
  cases le_total 0 b with h0b hb0,
  { -- both nonnegative
    rw abs_of_nonneg h0a,
    rw abs_of_nonneg h0b,
    rw abs_of_nonneg,
    nlinarith,
  },
  { -- b <= 0 <= a
    rw abs_of_nonneg h0a,
    rw abs_of_nonpos hb0,
    rw abs_of_nonpos,
    { ring},
    nlinarith,
  },
  { -- a ≤ 0 ≤ b
    rw abs_of_nonpos ha0,
    rw abs_of_nonneg h0b,
    rw abs_of_nonpos,
    { ring},
    nlinarith,
  },
  { -- both nonnegative
    rw abs_of_nonpos ha0,
    rw abs_of_nonpos hb0,
    rw abs_of_nonneg,
    { ring},
    nlinarith,
  },
end

-- order level 6 (unfinished)
lemma le_iff_square_le (ha : 0 ≤ a) (hb : 0 ≤ b): a ≤ b ↔ a^2 ≤ b^2 :=
begin
  rw (show a^2 ≤ b^2 ↔ 0 ≤ b^2 - a^2, by split; intros; linarith),
  rw (show b^2 - a^2 = (b + a) * (b - a), by ring),
  rw (show a ≤ b ↔ 0 ≤ b - a, by split; intros; linarith), -- should be a lemma
  have hab : 0 ≤ b + a, by linarith,
  split,
  { intros,
    nlinarith},
  { intros,
    by_cases h : b + a = 0,
    { linarith },
    have ha2 : 0 < b + a,
    { by_contradiction hab,
      push_neg at hab,
      apply h,
      linarith
    },
    sorry,
  }
end

end test