Library lts_tau

Require Import base.
Require Import prelim.
Require Import finiteness.

Module LTS_TAU.
Section lts_tau. Context {Obs:ObservationSystem}.

  Record LTS :=
    { state : Type
    ; steps : state -> option O -> state -> Prop
    }.

  Definition steps_tau (X:LTS) s s' := steps X s None s'.

  Definition steps_star (X:LTS) :=
    clos_refl_trans (state X) (steps_tau X).

  Definition steps_plus (X:LTS) :=
    clos_trans (state X) (steps_tau X).

  Definition weak_step (X:LTS) (x:state X) (o:option O) (x':state X) :=
    match o with
    | Some o =>
       exists q1, exists q2,
         steps_star X x q1 /\
         steps X q1 (Some o) q2 /\
         steps_star X q2 x'
    | None =>
         steps_star X x x'
    end.

  Definition enables {X:LTS} (x:state X) (o:option O) :=
    exists x', steps X x o x'.

  Definition stable {X:LTS} (x:state X) :=
    ~enables x None.

  Definition divergence_set X (P:state X -> Prop) (D:state X -> Prop) :=
    forall x, D x ->
      P x /\ exists x', steps_tau X x x' /\ D x'.

  Definition convergence_set X (P:state X -> Prop) (C:state X -> Prop) :=
    forall x,
      (P x \/ forall x', steps_tau X x x' -> C x') -> C x.

  Definition diverges X (P:state X -> Prop) x :=
    exists D, divergence_set X P D /\ D x.

  Definition converges X (P:state X -> Prop) x :=
    forall C, convergence_set X P C -> C x.

  Definition div_from X (D:state X -> Prop) x :=
    fun x' => D x' /\ path_where _ (steps_tau X) D x x'.

  Lemma div_from_div_set : forall X D P x,
    divergence_set X P D ->
    divergence_set X P (div_from X D x).

  Lemma divergence_convergence_dual {Classic:EM} : forall X P x,
    converges X P x <-> ~diverges X (fun x => ~P x) x.

  Definition void_lts : LTS := Build_LTS Empty_set (fun _ _ _ => False).


  Definition transition_diagram :=
    forall (X Y:LTS) (R:state X -> state Y -> Prop), state X -> state Y -> Prop.

  Definition td_and (T1 T2:transition_diagram) : transition_diagram :=
    fun X Y R x y => T1 X Y R x y /\ T2 X Y R x y.

  Definition simulation (T:transition_diagram) X Y (R:state X -> state Y -> Prop) :=
    forall x y, R x y -> T X Y R x y.

  Definition bisimulation (T:transition_diagram) X Y (R:state X -> state Y -> Prop) :=
    forall x y, R x y -> T X Y R x y /\ T Y X (inv R) y x.

  Definition bisimilar T X Y x y :=
    exists R, bisimulation T X Y R /\ R x y.

  Lemma sim_bisim : forall T X Y R,
    simulation T X Y R ->
    simulation T Y X (inv R) ->
    bisimulation T X Y R.

  Lemma bisim_sim : forall T X Y R,
    bisimulation T X Y R ->
    simulation T X Y R /\
    simulation T Y X (inv R).

  Lemma inv_bisimulation : forall T X Y R,
    bisimulation T X Y R ->
    bisimulation T Y X (inv R).

  Lemma bisimilar_sym : forall T X Y x y,
    bisimilar T X Y x y -> bisimilar T Y X y x.

  Lemma inv_bisimilar : forall T X Y,
    inv (bisimilar T X Y) = bisimilar T Y X.

  Lemma simulation_and : forall T1 T2 X Y R,
    simulation T1 X Y R ->
    simulation T2 X Y R ->
    simulation (td_and T1 T2) X Y R.

  Lemma and_simulation : forall T1 T2 X Y R,
    simulation (td_and T1 T2) X Y R ->
    simulation T1 X Y R /\ simulation T2 X Y R.

  Lemma bisimulation_and : forall T1 T2 X Y R,
    bisimulation T1 X Y R ->
    bisimulation T2 X Y R ->
    bisimulation (td_and T1 T2) X Y R.

  Lemma and_bisimulation : forall T1 T2 X Y R,
    bisimulation (td_and T1 T2) X Y R ->
    bisimulation T1 X Y R /\ bisimulation T2 X Y R.

  Lemma by_symmetry :
    forall T (P:forall X Y, ((state X -> state Y -> Prop) -> Prop) -> Prop),
      (forall X Y, P X Y (simulation T X Y) -> P Y X (simulation T Y X) -> P X Y (bisimulation T X Y)) ->
      (forall X Y, P X Y (simulation T X Y)) ->
      (forall X Y, P X Y (bisimulation T X Y)).

  Record proc :=
    { sys : LTS
    ; root : state sys
    }.

  Definition wd {X:LTS} (x:state X) : proc :=
    {| sys := X ; root := x |}.

  Definition upd_root (w:proc) (x:state (sys w)) : proc := wd x.

  Definition equiv T (w1 w2:proc) :=
    bisimilar T (sys w1) (sys w2) (root w1) (root w2).


  Definition prerun X := list (state X * option O).

  Fixpoint good_prerun X (pr:prerun X) (z:state X) {struct pr} : Prop :=
    match pr with
    | nil => True
    | (x,a)::pr' => steps X x a z /\ good_prerun X pr' x
    end.

  Record run X :=
    { curr : state X
    ; prev : prerun X
    ; good_run : good_prerun X prev curr
    }.
  Global Implicit Arguments curr.
  Global Implicit Arguments prev.

  Lemma run_ext : forall X (x1 x2:run X),
    curr x1 = curr x2 -> prev x1 = prev x2 -> x1 = x2.

  Definition run_transition_diagram :=
    forall (X Y:LTS) (R:run X -> run Y -> Prop), run X -> run Y -> Prop.

  Definition rtd_and (T1 T2:run_transition_diagram) : run_transition_diagram :=
    fun X Y R x y => T1 X Y R x y /\ T2 X Y R x y.

  Definition run_simulation (T:run_transition_diagram) X Y (R:run X -> run Y -> Prop) :=
    forall x y, R x y -> T X Y R x y.

  Definition run_bisimulation (T:run_transition_diagram) X Y (R:run X -> run Y -> Prop) :=
    forall x y, R x y -> T X Y R x y /\ T Y X (inv R) y x.

  Definition run_similar T X Y x y :=
    exists R, run_simulation T X Y R /\ R x y.

  Definition run_bisimilar T X Y x y :=
    exists R, run_bisimulation T X Y R /\ R x y.

  Lemma run_sim_bisim : forall T X Y R,
    run_simulation T X Y R ->
    run_simulation T Y X (inv R) ->
    run_bisimulation T X Y R.

  Lemma run_bisim_sim : forall T X Y R,
    run_bisimulation T X Y R ->
    run_simulation T X Y R /\
    run_simulation T Y X (inv R).

  Lemma inv_run_bisimulation : forall T X Y R,
    run_bisimulation T X Y R ->
    run_bisimulation T Y X (inv R).

  Lemma run_bisimilar_sym : forall T X Y x y,
    run_bisimilar T X Y x y -> run_bisimilar T Y X y x.

  Lemma inv_run_bisimilar : forall T X Y,
    inv (run_bisimilar T X Y) = run_bisimilar T Y X.

  Lemma run_simulation_and : forall T1 T2 X Y R,
    run_simulation T1 X Y R ->
    run_simulation T2 X Y R ->
    run_simulation (rtd_and T1 T2) X Y R.

  Lemma and_run_simulation : forall T1 T2 X Y R,
    run_simulation (rtd_and T1 T2) X Y R ->
    run_simulation T1 X Y R /\ run_simulation T2 X Y R.

  Lemma run_bisimulation_and : forall T1 T2 X Y R,
    run_bisimulation T1 X Y R ->
    run_bisimulation T2 X Y R ->
    run_bisimulation (rtd_and T1 T2) X Y R.

  Lemma and_run_bisimulation : forall T1 T2 X Y R,
    run_bisimulation (rtd_and T1 T2) X Y R ->
    run_bisimulation T1 X Y R /\ run_bisimulation T2 X Y R.

  Record history :=
    { hsys : LTS
    ; hrun : run hsys
    }.


  Definition hst {X:LTS} (x:run X) : history :=
    {| hsys := X ; hrun := x |}.

  Definition upd_run (h:history) (x:run (hsys h)) : history := hst x.

  Definition hist_equiv T (h1 h2:history) :=
    run_bisimilar T (hsys h1) (hsys h2) (hrun h1) (hrun h2).

  Definition start_run X (x:state X) :=
    {| curr := x; prev := nil ; good_run := I |}.

  Definition extended_run X (r:run X) (a:option O) (r':run X) :=
    (curr r, a) :: prev r = prev r'.

  Definition extended_run_star X :=
    clos_refl_trans (run X) (fun r r' => extended_run X r None r').

  Definition step_run X (r:run X) (a:option O) (r':run X) :=
    match a with
    | None => extended_run_star X r r'
    | Some a => exists r0, exists r1,
        extended_run_star X r r0 /\
        extended_run X r0 (Some a) r1 /\
        extended_run_star X r1 r'
    end.

  Inductive run_from X (x0:state X) : run X -> Prop :=
    | run_from_start : forall r,
         curr r = x0 ->
         prev r = nil ->
         run_from X x0 r
    | run_from_step : forall r a r',
         run_from X x0 r ->
         extended_run X r a r' ->
         run_from X x0 r'.

  Program Definition extend_run X (r:run X) (a:option O) (x:state X) (H:steps X (curr r) a x) :=
    {| curr := x
     ; prev := (curr r,a) :: prev r
     ; good_run := conj H (good_run X r)
     |}.

  Program Definition append_run X (r:run X) (r':run X) (H:run_from X (curr r) r') :=
    {| curr := curr r'; prev := prev r' ++ prev r |}.

  Lemma append_run_from X r r' (H:run_from X (curr r) r') :
    forall x, run_from X x r ->
    run_from X x (append_run X r r' H).


  Lemma extended_run_steps_tau : forall X x1 x2,
    extended_run X x1 None x2 ->
    steps_tau X (curr x1) (curr x2).

  Lemma extended_run_step : forall Z z1 o z2,
    extended_run Z z1 o z2 ->
    steps Z (curr z1) o (curr z2).

  Lemma run_star_step_star : forall Z z1 z2,
    extended_run_star Z z1 z2 ->
    steps_star Z (curr z1) (curr z2).

  Lemma extended_run_star_decompose X : forall r r',
    extended_run_star X r r' ->
    exists r2, exists H:run_from X (curr r) r2,
      r' = append_run X r r2 H /\
      extended_run_star X (start_run X (curr r)) r2.

  Lemma extended_run_decompose X : forall r a r',
    extended_run X r a r' ->
    exists r2, exists H:run_from X (curr r) r2,
      r' = append_run X r r2 H /\
      extended_run X (start_run X (curr r)) a r2.

  Lemma step_run_decompose X : forall r a r',
    step_run X r a r' ->
    exists r2, exists H:run_from X (curr r) r2,
      r' = append_run X r r2 H /\
      step_run X (start_run X (curr r)) a r2.

  Lemma step_run_start_tau_run_from : forall X x0 h h',
    extended_run_star X h h'->
    run_from X x0 h ->
    run_from X x0 h'.

  Lemma step_run_start_run_from : forall X x o h,
    step_run X (start_run X x) o h -> run_from X x h.

  Lemma step_run_start_append : forall X h1 o h2 H,
    step_run X (start_run X (curr h1)) o h2 ->
    step_run X h1 o (append_run X h1 h2 H).

  Definition curr_rel X Y (R:run X -> run Y -> Prop) (x:state X) (y:state Y) : Prop :=
      exists rx, exists ry,
        R rx ry /\ x = curr rx /\ y = curr ry.

  Inductive related_preruns X Y (R:state X -> state Y -> Prop) :
    prerun X -> state X -> prerun Y -> state Y -> Prop :=

    | related_prerun_end : forall x y,
        R x y -> related_preruns X Y R nil x nil y

    | related_prerun_tau_left : forall x x' xs y ys,
        R x y ->
        related_preruns X Y R xs x' ys y ->
        related_preruns X Y R ((x',None)::xs) x ys y

    | related_prerun_tau_right : forall x xs y y' ys,
        R x y ->
        related_preruns X Y R xs x ys y' ->
        related_preruns X Y R xs x ((y',None)::ys) y

    | related_prerun_action : forall a x x' xs y y' ys,
        R x y ->
        related_preruns X Y R xs x' ys y' ->
        related_preruns X Y R ((x',a)::xs) x ((y',a)::ys) y.

  Definition related_runs X Y (R:state X -> state Y -> Prop) (r1:run X) (r2:run Y) :=
    related_preruns X Y R (prev r1) (curr r1) (prev r2) (curr r2).

  Lemma related_runs_append : forall X Y (r1 r2:run X) (r1' r2':run Y) H H' R,
    related_runs X Y R r1 r1' ->
    related_runs X Y R r2 r2' ->
    related_runs X Y R (append_run X r1 r2 H) (append_run Y r1' r2' H').

  Definition hdivergence_set X (P:run X -> Prop) (D:run X -> Prop) :=
    forall x, D x ->
      P x /\ exists x', extended_run X x None x' /\ D x'.

  Definition hconvergence_set X (P:run X -> Prop) (C:run X -> Prop) :=
    forall x,
      (P x \/ forall x', extended_run X x None x' -> C x') -> C x.

  Definition hdiverges X (P:run X -> Prop) x :=
    exists D, hdivergence_set X P D /\ D x.

  Definition hconverges X (P:run X -> Prop) x :=
    forall C, hconvergence_set X P C -> C x.

  Lemma hdiverges_hconverges_dual {Classic:EM} :
    forall X P x,
      hconverges X P x <-> ~hdiverges X (fun x => ~P x) x.

  Lemma related_runs_incl : forall X Y (R1 R2:state X -> state Y -> Prop),
    (forall x y, R1 x y -> R2 x y) ->
    (forall x y, related_runs X Y R1 x y ->
                 related_runs X Y R2 x y).

  Lemma inv_curr_rel : forall X Y R,
    inv (curr_rel X Y R) = curr_rel Y X (inv R).

  Lemma inv_related_runs : forall X Y R,
    inv (related_runs X Y R) = related_runs Y X (inv R).

  Lemma hdiverges_stable : forall X P x ,
    hdiverges X P x -> stable (curr x) -> False.

  Lemma hdiverges_mono : forall X (P1 P2:run X -> Prop) x,
    (forall x, P1 x -> P2 x) ->
    hdiverges X P1 x -> hdiverges X P2 x.

  Definition weak_image_finite X := forall x o,
    finite (state X) (fun x' => weak_step X x o x').

  Fixpoint tau_path_from X x0 (l:list (state X)) :=
    match l with
    | nil => False
    | x1::l' =>
      match l' with
      | nil => x1 = x0
      | x2::_ => tau_path_from X x0 l' /\ steps X x2 None x1
      end
    end.

  Inductive path_obs_extend X : list (state X) -> O -> state X -> Prop :=
    | path_obs_extend_intro : forall x l o x',
      steps X x (Some o) x' ->
      path_obs_extend X (x::l) o x'.

  Inductive prerun_cycle X x0 : prerun X -> Prop :=
  | prerun_cycle_here : forall l,
      prerun_cycle X x0 ((x0,None)::l)
  | prerun_cycle_later : forall x' l,
      prerun_cycle X x0 l ->
      prerun_cycle X x0 ((x',None)::l).

  Inductive run_cycle X : state X -> prerun X -> Prop :=
  | run_cycle_here : forall x l,
      prerun_cycle X x l ->
      run_cycle X x l
  | run_cycle_later : forall x' x a l,
      run_cycle X x' l ->
      run_cycle X x ((x',a)::l).

  Section finite_runs.
    Context {Classic:EM}.

    Variable X:LTS.
    Hypothesis Hfin : weak_image_finite X.

    Lemma strong_step_finite : forall x o,
      finite (state X) (steps X x o).

    Lemma tau_paths_finite : forall x0,
      finite (list (state X)) (fun l => tau_path_from X x0 l /\ NoDup l).

    Lemma tau_path_extend_states_finite : forall l o,
      finite (state X) (path_obs_extend X l o).

    Definition weak_paths_finite x0 o :
      finite (list (state X) * (state X * list (state X)))
        (fun x : list (state X) * (state X * list (state X)) =>
          (tau_path_from X x0 (fst x) /\ NoDup (fst x)) /\
          path_obs_extend X (fst x) o (fst (snd x)) /\
          tau_path_from X (fst (snd x)) (snd (snd x)) /\ NoDup (snd (snd x)))
    :=
      finite_mapping _ _ _ _
      (tau_paths_finite x0)
      (fun l _ =>
        finite_mapping _ _ _ _
          (tau_path_extend_states_finite l o)
          (fun a _ => tau_paths_finite a)).

    Inductive weak_path_run_rel o :
      (list (state X) * (state X * list (state X))) ->
      run X -> Prop :=
    | weak_path_run_rel_intro : forall x' l1 x c l2 r,
         curr r = c ->
         prev r = (map (fun x => (x,None)) l2 ++
                        (x',Some o) ::
                        map (fun x => (x,None)) l1) ->
      weak_path_run_rel o (x'::l1,(x,c :: l2)) r.

    Inductive weak_path_tau_rel :
      (list (state X)) -> run X -> Prop :=
      | weak_path_tau_rel_intro : forall x l r,
         curr r = x -> prev r = map (fun x => (x,None)) l ->
         weak_path_tau_rel (x::l) r.

    Lemma acyclic_tau_paths_finite x0 :
      finite (run X)
        (fun h => step_run X (start_run X x0) None h /\
                 ~run_cycle X (curr h) (prev h)).

    Lemma acyclic_obs_paths_finite x0 a :
      finite (run X) (fun h => step_run X (start_run X x0) (Some a) h /\ ~run_cycle X (curr h) (prev h)).
  End finite_runs.

  Definition acyclic_run X (h:run X) :=
    ~run_cycle X (curr h) (prev h).

  Lemma weak_image_finite_acyclic_runs {Classic:EM} X :
    weak_image_finite X ->
    forall x a,
      finite (run X) (fun h =>
         step_run X (start_run X x) a h /\ acyclic_run X h).

  Lemma weak_image_finite_acyclic_extensions {Classic:EM} X :
    weak_image_finite X ->
    forall h a,
      finite (run X) (fun h' => exists q, exists H,
         h' = append_run X h q H /\
         acyclic_run X q /\
         step_run X (start_run X (curr h)) a q).

  Definition finite_divergences X (x:state X) :=
    forall D, divergence_set X (fun _ => True) D -> D x ->
      exists l, forall z, In z l <-> (D z /\ steps_star X x z).

  Lemma weak_image_finite_divergences {Classic:EM} X :
    weak_image_finite X ->
    (forall x, finite_divergences X x).

  Lemma step_star_extend_star : forall X h x x',
    steps_star X x x' ->
    curr h = x ->
    exists h', extended_run_star X h h' /\
               curr h' = x'.

  Lemma weak_step_step_run : forall X h x o x',
    weak_step X x o x' ->
    curr h = x ->
    exists h', step_run X h o h' /\
               curr h' = x'.

  Lemma step_run_back_finite {Classic:EM} X : forall x o,
    exists l, forall x', In x' l <-> step_run X x' o x.

End lts_tau.
End LTS_TAU.