/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import tactic.rcases
import computability.language

/-!
# Regular Expressions

This file contains the formal definition for regular expressions and basic lemmas. Note these are
regular expressions in terms of formal language theory. Note this is different to regex's used in
computer science such as the POSIX standard.

## TODO

* Show that this regular expressions and DFA/NFA's are equivalent.
* `attribute [pattern] has_mul.mul` has been added into this file, it could be moved.
-/

open list set

universe u

variables {α β γ : Type*} [dec : decidable_eq α]

/--
This is the definition of regular expressions. The names used here is to mirror the definition
of a Kleene algebra (https://en.wikipedia.org/wiki/Kleene_algebra).
* `0` (`zero`) matches nothing
* `1` (`epsilon`) matches only the empty string
* `char a` matches only the string 'a'
* `star P` matches any finite concatenation of strings which match `P`
* `P + Q` (`plus P Q`) matches anything which match `P` or `Q`
* `P * Q` (`comp P Q`) matches `x ++ y` if `x` matches `P` and `y` matches `Q`
-/
inductive regular_expression (α : Type u) : Type u
| zero : regular_expression
| epsilon : regular_expression
| char : α → regular_expression
| plus : regular_expression → regular_expression → regular_expression
| comp : regular_expression → regular_expression → regular_expression
| star : regular_expression → regular_expression

namespace regular_expression
variables {a b : α}

instance : inhabited (regular_expression α) := ⟨zero⟩

instance : has_add (regular_expression α) := ⟨plus⟩
instance : has_mul (regular_expression α) := ⟨comp⟩
instance : has_one (regular_expression α) := ⟨epsilon⟩
instance : has_zero (regular_expression α) := ⟨zero⟩
instance : has_pow (regular_expression α) ℕ := ⟨λ n r, npow_rec r n⟩

attribute [pattern] has_mul.mul

@[simp] lemma zero_def : (zero : regular_expression α) = 0 := rfl
@[simp] lemma one_def : (epsilon : regular_expression α) = 1 := rfl

@[simp] lemma plus_def (P Q : regular_expression α) : plus P Q = P + Q := rfl
@[simp] lemma comp_def (P Q : regular_expression α) : comp P Q = P * Q := rfl

/-- `matches P` provides a language which contains all strings that `P` matches -/
@[simp] def matches : regular_expression α → language α
| 0 := 0
| 1 := 1
| (char a) := {[a]}
| (P + Q) := P.matches + Q.matches
| (P * Q) := P.matches * Q.matches
| (star P) := P.matches.star

@[simp] lemma matches_zero : (0 : regular_expression α).matches = 0 := rfl
@[simp] lemma matches_epsilon : (1 : regular_expression α).matches = 1 := rfl
@[simp] lemma matches_char (a : α) : (char a).matches = {[a]} := rfl
@[simp] lemma matches_add (P Q : regular_expression α) :
  (P + Q).matches = P.matches + Q.matches := rfl
@[simp] lemma matches_mul (P Q : regular_expression α) :
  (P * Q).matches = P.matches * Q.matches := rfl
@[simp] lemma matches_pow (P : regular_expression α) :
  ∀ n : ℕ, (P ^ n).matches = P.matches ^ n
| 0 := matches_epsilon
| (n + 1) := (matches_mul _ _).trans $ eq.trans (congr_arg _ (matches_pow n)) (pow_succ _ _).symm
@[simp] lemma matches_star (P : regular_expression α) : P.star.matches = P.matches.star := rfl

/-- `match_epsilon P` is true if and only if `P` matches the empty string -/
def match_epsilon : regular_expression α → bool
| 0 := ff
| 1 := tt
| (char _) := ff
| (P + Q) := P.match_epsilon || Q.match_epsilon
| (P * Q) := P.match_epsilon && Q.match_epsilon
| (star P) := tt

include dec

/-- `P.deriv a` matches `x` if `P` matches `a :: x`, the Brzozowski derivative of `P` with respect
  to `a` -/
def deriv : regular_expression α → α → regular_expression α
| 0 _ := 0
| 1 _ := 0
| (char a₁) a₂ := if a₁ = a₂ then 1 else 0
| (P + Q) a := deriv P a + deriv Q a
| (P * Q) a :=
  if P.match_epsilon then
    deriv P a * Q + deriv Q a
  else
    deriv P a * Q
| (star P) a := deriv P a * star P

@[simp] lemma deriv_zero (a : α) : deriv 0 a = 0 := rfl
@[simp] lemma deriv_one (a : α) : deriv 1 a = 0 := rfl
@[simp] lemma deriv_char_self (a : α) : deriv (char a) a = 1 := if_pos rfl
@[simp] lemma deriv_char_of_ne (h : a ≠ b) : deriv (char a) b = 0 := if_neg h
@[simp] lemma deriv_add (P Q : regular_expression α) (a : α) :
  deriv (P + Q) a = deriv P a + deriv Q a := rfl
@[simp] lemma deriv_star (P : regular_expression α) (a : α) :
  deriv (P.star) a = deriv P a * star P := rfl

/-- `P.rmatch x` is true if and only if `P` matches `x`. This is a computable definition equivalent
  to `matches`. -/
def rmatch : regular_expression α → list α → bool
| P [] := match_epsilon P
| P (a::as) := rmatch (P.deriv a) as

@[simp] lemma zero_rmatch (x : list α) : rmatch 0 x = ff :=
by induction x; simp [rmatch, match_epsilon, *]

lemma char_rmatch_iff (a : α) (x : list α) : rmatch (char a) x ↔ x = [a] :=
begin
  cases x with _ x,
    dec_trivial,
  cases x,
    rw [rmatch, deriv],
    split_ifs;
    tauto,
  rw [rmatch, deriv],
  split_ifs,
    rw one_rmatch_iff,
    tauto,
  rw zero_rmatch,
  tauto
end

lemma add_rmatch_iff (P Q : regular_expression α) (x : list α) :
  (P + Q).rmatch x ↔ P.rmatch x ∨ Q.rmatch x :=
begin
  induction x with _ _ ih generalizing P Q,
  { simp only [rmatch, match_epsilon, bor_coe_iff] },
  { repeat {rw rmatch},
    rw deriv,
    exact ih _ _ }
end

lemma mul_rmatch_iff (P Q : regular_expression α) (x : list α) :
  (P * Q).rmatch x ↔ ∃ t u : list α, x = t ++ u ∧ P.rmatch t ∧ Q.rmatch u :=
begin
  induction x with a x ih generalizing P Q,
  { rw [rmatch, match_epsilon],
    split,
    { intro h,
      refine ⟨ [], [], rfl, _ ⟩,
      rw [rmatch, rmatch],
      rwa band_coe_iff at h },
    { rintro ⟨ t, u, h₁, h₂ ⟩,
      cases list.append_eq_nil.1 h₁.symm with ht hu,
      subst ht,
      subst hu,
      repeat {rw rmatch at h₂},
      simp [h₂] } },
  { rw [rmatch, deriv],
    split_ifs with hepsilon,
    { rw [add_rmatch_iff, ih],
      split,
      { rintro (⟨ t, u, _ ⟩ | h),
        { exact ⟨ a :: t, u, by tauto ⟩ },
        { exact ⟨ [], a :: x, rfl, hepsilon, h ⟩ } },
      { rintro ⟨ t, u, h, hP, hQ ⟩,
        cases t with b t,
        { right,
          rw list.nil_append at h,
          rw ←h at hQ,
          exact hQ },
        { left,
          simp only [list.cons_append] at h,
          refine ⟨ t, u, h.2, _, hQ ⟩,
          rw rmatch at hP,
          convert hP,
          exact h.1 } } },
    { rw ih,
      split;
      rintro ⟨ t, u, h, hP, hQ ⟩,
      { exact ⟨ a :: t, u, by tauto ⟩ },
      { cases t with b t,
        { contradiction },
        { simp only [list.cons_append] at h,
          refine ⟨ t, u, h.2, _, hQ ⟩,
          rw rmatch at hP,
          convert hP,
          exact h.1 } } } }
end

lemma star_rmatch_iff (P : regular_expression α) : ∀ (x : list α),
  (star P).rmatch x ↔ ∃ S : list (list α), x = S.join ∧ ∀ t ∈ S, t ≠ [] ∧ P.rmatch t
| x :=
begin
  have A : ∀ (m n : ℕ), n < m + n + 1,
  { assume m n,
    convert add_lt_add_of_le_of_lt (add_le_add (zero_le m) (le_refl n)) zero_lt_one,
    simp },
  have IH := λ t (h : list.length t < list.length x), star_rmatch_iff t,
  clear star_rmatch_iff,
  split,
  { cases x with a x,
    { intro,
      fconstructor,
      exact [],
      tauto },
    { rw [rmatch, deriv, mul_rmatch_iff],
      rintro ⟨ t, u, hs, ht, hu ⟩,
      have hwf : u.length < (list.cons a x).length,
      { rw [hs, list.length_cons, list.length_append],
        apply A },
      rw IH _ hwf at hu,
      rcases hu with ⟨ S', hsum, helem ⟩,
      use (a :: t) :: S',
      split,
      { simp [hs, hsum] },
      { intros t' ht',
        cases ht' with ht' ht',
        { rw ht',
          exact ⟨ dec_trivial, ht ⟩ },
        { exact helem _ ht' } } } },
  { rintro ⟨ S, hsum, helem ⟩,
    cases x with a x,
    { dec_trivial },
    { rw [rmatch, deriv, mul_rmatch_iff],
      cases S with t' U,
      { exact ⟨ [], [], by tauto ⟩ },
      { cases t' with b t,
        { simp only [forall_eq_or_imp, list.mem_cons_iff] at helem,
          simp only [eq_self_iff_true, not_true, ne.def, false_and] at helem,
          cases helem },
        simp only [list.join, list.cons_append] at hsum,
        refine ⟨ t, U.join, hsum.2, _, _ ⟩,
        { specialize helem (b :: t) (by simp),
          rw rmatch at helem,
          convert helem.2,
          exact hsum.1 },
        { have hwf : U.join.length < (list.cons a x).length,
          { rw [hsum.1, hsum.2],
            simp only [list.length_append, list.length_join, list.length],
            apply A },
          rw IH _ hwf,
          refine ⟨ U, rfl, λ t h, helem t _ ⟩,
          right,
          assumption } } } }
end
using_well_founded
{ rel_tac := λ _ _, `[exact ⟨(λ L₁ L₂ : list _, L₁.length < L₂.length), inv_image.wf _ nat.lt_wf⟩] }

@[simp] lemma rmatch_iff_matches (P : regular_expression α) :
  ∀ x : list α, P.rmatch x ↔ x ∈ P.matches :=
begin
  intro x,
  induction P generalizing x,
  all_goals
  { try {rw zero_def},
    try {rw one_def},
    try {rw plus_def},
    try {rw comp_def},
    rw matches },
  case zero :
  { rw zero_rmatch,
    tauto },
  case epsilon :
  { rw one_rmatch_iff,
    refl },
  case char :
  { rw char_rmatch_iff,
    refl },
  case plus : _ _ ih₁ ih₂
  { rw [add_rmatch_iff, ih₁, ih₂],
    refl },
  case comp : P Q ih₁ ih₂
  { simp only [mul_rmatch_iff, comp_def, language.mul_def, exists_and_distrib_left, set.mem_image2,
      set.image_prod],
    split,
    { rintro ⟨ x, y, hsum, hmatch₁, hmatch₂ ⟩,
      rw ih₁ at hmatch₁,
      rw ih₂ at hmatch₂,
      exact ⟨ x, hmatch₁, y, hmatch₂, hsum.symm ⟩ },
    { rintro ⟨ x, hmatch₁, y, hmatch₂, hsum ⟩,
      rw ←ih₁ at hmatch₁,
      rw ←ih₂ at hmatch₂,
      exact ⟨ x, y, hsum.symm, hmatch₁, hmatch₂ ⟩ } },
  case star : _ ih
  { rw [star_rmatch_iff, language.star_def_nonempty],
    split,
    all_goals
    { rintro ⟨ S, hx, hS ⟩,
      refine ⟨ S, hx, _ ⟩,
      intro y,
      specialize hS y },
    { rw ←ih y,
      tauto },
    { rw ih y,
      tauto } }
end

instance (P : regular_expression α) : decidable_pred P.matches :=
begin
  intro x,
  change decidable (x ∈ P.matches),
  rw ←rmatch_iff_matches,
  exact eq.decidable _ _
end

omit dec

/-- Map the alphabet of a regular expression. -/
@[simp] def map (f : α → β) : regular_expression α → regular_expression β
| 0 := 0
| 1 := 1
| (char a) := char (f a)
| (R + S) := map R + map S
| (R * S) := map R * map S
| (star R) := star (map R)

@[simp] protected lemma map_pow (f : α → β) (P : regular_expression α) :
  ∀ n : ℕ, map f (P ^ n) = map f P ^ n
| 0 := rfl
| (n + 1) := (congr_arg ((*) (map f P)) (map_pow n) : _)

@[simp] lemma map_id : ∀ (P : regular_expression α), P.map id = P
| 0 := rfl
| 1 := rfl
| (char a) := rfl
| (R + S) := by simp_rw [map, map_id]
| (R * S) := by simp_rw [map, map_id]
| (star R) := by simp_rw [map, map_id]

@[simp] lemma map_map (g : β → γ) (f : α → β) :
  ∀ (P : regular_expression α), (P.map f).map g = P.map (g ∘ f)
| 0 := rfl
| 1 := rfl
| (char a) := rfl
| (R + S) := by simp_rw [map, map_map]
| (R * S) := by simp_rw [map, map_map]
| (star R) := by simp_rw [map, map_map]

/-- The language of the map is the map of the language. -/
@[simp] lemma matches_map (f : α → β) :
  ∀ P : regular_expression α, (P.map f).matches = language.map f P.matches
| 0 := (map_zero _).symm
| 1 := (map_one _).symm
| (char a) := by { rw eq_comm, exact image_singleton }
| (R + S) := by simp only [matches_map, map, matches_add, map_add]
| (R * S) := by simp only [matches_map, map, matches_mul, map_mul]
| (star R) := begin
    simp_rw [map, matches, matches_map],
    rw [language.star_eq_supr_pow, language.star_eq_supr_pow],
    simp_rw ←map_pow,
    exact image_Union.symm,
  end

end regular_expression


import tactic
import data.set.finite
import data.real.basic

import topological_spaces
import neighbourhoods
import topological_spaces2
import t2_spaces

noncomputable theory
open set

-- Definition d'un espace métrique :
class metric_space (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
open topological_space

-- Preuve que la distance est positive à partir des autres axiomes :
lemma dist_nonneg {X : Type} [metric_space X] (x y : X) : 0 ≤ dist x y :=
begin
  have :=
  calc 0 = dist x x : by rw (dist_eq_zero_iff x x).2 rfl
     ... ≤ dist x y + dist y x : triangle x y x
     ... = dist x y + dist x y : by rw dist_symm x y
     ... = 2 * dist x y : by linarith,
  linarith,
end

-- Topologie induite par la distance :
instance {X : Type} [metric_space X] : topological_space X :=
generate_from X { B | ∃ (x : X) r, B = {y | dist x y < r} }

-- Caractérisation des ouverts pour la distance :
lemma is_open_metric_iff {X : Type} [metric_space X] {U : set X}:
is_open U ↔ ∀ x ∈ U, ∃ r > 0, {y | dist x y < r} ⊆ U :=
begin
  split,
  { intro hyp,
    intros x hx,
    induction hyp with G hG A B hA1 hB1 hA2 hB2 C hC1 hC2,
    { rcases hG with ⟨xG, r, hG⟩,
      rw hG at hx, simp at hx,
      use [r - dist xG x, by linarith [hx]],
      intros y hy, simp at hy,
      rw hG,
      calc dist xG y ≤ dist xG x + dist x y      : triangle xG x y
                 ... < dist xG x + r - dist xG x : by linarith [hy]
                 ... = r                         : by linarith, },
    { rcases hA2 hx.1 with ⟨r1, hr1, hA⟩,
      rcases hB2 hx.2 with ⟨r2, hr2, hB⟩,
      use min r1 r2, split,
      exact lt_min hr1 hr2,
      intros y hy, split,
      apply hA,
      calc dist x y < min r1 r2 : hy
                ... ≤ r1        : min_le_left r1 r2,
      apply hB,
      calc dist x y < min r1 r2 : hy
                ... ≤ r2        : min_le_right r1 r2, },
    { rcases hx with ⟨c, hcC, hxc⟩,
      rcases hC2 c hcC hxc with ⟨r, hr, hc⟩,
      use [r, hr],
      intros y hy,
      use [c, hcC, hc hy], },
    { use [1, by linarith], simp, }, },
  { intro hyp,
    choose φ hφ using hyp,
    have clef : U = ⋃₀ { ({y : X | dist x y < φ x H}) | (x : X) (H : x ∈ U) },
    { apply le_antisymm,
      { intros x hx,
        use {y : X | dist x y < φ x hx}, split,
        use [x, hx],
        specialize hφ x hx, rw exists_prop at hφ,
        calc dist x x = 0      : (dist_eq_zero_iff x x).2 rfl
                  ... < φ x hx : by linarith [hφ.1], },
      { apply sUnion_subset,
        rintros B ⟨x, hx, hB⟩,
        rw ← hB,
        specialize hφ x hx, rw exists_prop at hφ,
        exact hφ.2, }, },
    rw clef,
    apply union,
    rintros B ⟨x, hx, hB⟩,
    rw ← hB,
    apply generated_open.generator,
    use [x, φ x hx], },
end

end metric_space

open topological_space
open metric_space

-- Espace métrique ℝ :
instance metric_space_R : metric_space ℝ :=
{ dist := λ x y,  abs (x - y),
  dist_eq_zero_iff :=
  begin
    intros x y,
    split,
    intro hyp,
    linarith [abs_eq_zero.1 hyp],
    intro hyp,
    simp [hyp],
  end,
  dist_symm := abs_sub,
  triangle :=
  begin
    intros x y z,
    have clef : x - z = (x - y) + (y - z), linarith,
    calc abs (x - z) = abs ((x - y) + (y - z))   : by simp [clef]
                 ... ≤ abs (x - y) + abs (y - z) : abs_add _ _,
  end }

-- Produit de deux espaces métriques :
instance prod.metric_space (X Y : Type) [metric_space X] [metric_space Y] :
metric_space (X × Y) :=
{ dist := λ u v, max (dist u.fst v.fst) (dist u.snd v.snd),
  dist_eq_zero_iff :=
  begin
    intros u v,
    split,
    { intro hyp,
      have := dist_nonneg u.fst v.fst,
      have := dist_nonneg u.snd v.snd,
      have := max_le_iff.1 (le_of_eq hyp),
      ext; rw ← dist_eq_zero_iff; linarith, },
    { intro hyp,
      rw [hyp, (dist_eq_zero_iff _ _).mpr, (dist_eq_zero_iff _ _).mpr, max_self]; refl },
  end,
  dist_symm :=
  begin
    intros u v,
    rw [dist_symm u.fst v.fst, dist_symm u.snd v.snd],
  end,
  triangle :=
  begin
    intros u v w,
    have := triangle u.fst v.fst w.fst,
    have := triangle u.snd v.snd w.snd,
    unfold max, split_ifs;
    linarith,
  end
  }

-- Tout espace métrique est séparé :
instance metric_t2 {X : Type} [metric_space X] : t2_space X :=
{ t2 :=
begin
  intros x y hxy,
  let r := dist x y,
  have r_strict_pos : r > 0,
  { cases le_or_gt r 0 with h1 h2,
    exfalso, exact hxy ((dist_eq_zero_iff x y).1 (le_antisymm h1 (dist_nonneg x y))),
    exact h2, },
  let Ux := {z : X | dist x z < r/2},
  let Uy := {z : X | dist y z < r/2},
  use [Ux, Uy],
  repeat {split},
  apply generated_open.generator, use [x, r/2],
  apply generated_open.generator, use [y, r/2],
  calc dist x x = 0   : (dist_eq_zero_iff x x).2 rfl
            ... < r/2 : by linarith,
  calc dist y y = 0   : (dist_eq_zero_iff y y).2 rfl
            ... < r/2 : by linarith,
  apply le_antisymm,
  { rintros z ⟨ hzUx, hzUy ⟩,
    have hxz : dist x z < r/2, exact hzUx,
    have hyz : dist y z < r/2, exact hzUy,
    have :=
    calc dist x y ≤ dist x z + dist z y : triangle x z y
              ... = dist x z + dist y z : by linarith [dist_symm y z]
              ... < r/2 + r/2           : by linarith [hxz, hyz]
              ... = r                   : by linarith,
    linarith, },
  { intros x hx, exfalso, exact hx, },
end }

-- Convergence d'une suite dans un espace métrique :
lemma seq_lim_metric {X : Type} [metric_space X] (u : ℕ → X) (l : X) :
seq_lim u l ↔ ∀ ε > 0, ∃ (N : ℕ), ∀ n ≥ N, dist (u n) l < ε :=
begin
  split,
  { intro hyp,
    intros ε εpos,
    let V := { x | dist l x < ε },
    have hV : V ∈ neighbourhoods l,
    { apply generated_filter.generator, split,
      apply generated_open.generator,
      use [l, ε],
      calc dist l l = 0 : (dist_eq_zero_iff l l).2 rfl
                ... < ε : by linarith [εpos], },
    cases hyp V hV with N hN,
    use N,
    intros n hn,
    calc dist (u n) l = dist l (u n) : dist_symm (u n) l
                  ... < ε            : hN n hn, },
  { intro hyp,
    intros V hV,
    rcases (is_neighbourhood_iff l).1 hV with ⟨U, hU, hlU, hUV⟩,
    rcases is_open_metric_iff.1 hU l hlU with ⟨ε, εpos, H⟩,
    cases hyp ε εpos with N hN,
    use N,
    intros n hn,
    apply hUV,
    apply H,
    calc dist l (u n) = dist (u n) l : dist_symm l (u n)
                  ... < ε            : hN n hn, },
end