Require Import Relations Recdef.
Require Import mathcomp.ssreflect.ssreflect.

Set Implicit Arguments.
Import Prenex Implicits.

Directed Acyclic Graphs

Termination and Transitive Closure


Inductive sn (X : Type) (R : X -> X -> Prop) (x : X) : Prop :=
  SN : (forall y, R x y -> sn R y) -> sn R x.

Inductive star (X : Type) (R : X -> X -> Prop) (x : X) : X -> Prop :=
| Star0 : star R x x
| StarL y z : R x z -> star R z y -> star R x y.

Definition terminates X (e : X -> X -> Prop) := forall x, sn e x.

Lemma sn_preimage T1 T2 (e1 : T1 -> T1 -> Prop) (e2 : T2 -> T2 -> Prop) (h : T1 -> T2) x :
  (forall x y, e1 x y -> e2 (h x) (h y)) -> sn e2 (h x) -> sn e1 x.

Lemma terminates_gtn : terminates (fun n m => m < n).

Lemma terminates_measure T (f : T -> nat) (e : T -> T -> Prop) :
      (forall x y, e x y -> f y < f x) -> terminates e.

Finite Rooted Labeled Graphs


Record graph (L : Type) :=
  Graph { vertex :> finType ; edge : rel vertex ; label : vertex -> L }.

Record rGraph (L : Type) := RGraph {
    graph_of :> graph L ;
    root : graph_of ;
    rootP x : connect (@edge _ graph_of) root x }.

Section GraphTheory.
  Variables (L : choiceType) (p : L -> {fset L} -> bool).
  Implicit Types (G : graph L) (rG : rGraph L).

  Definition erel G := (@edge _ G).
  Implicit Arguments erel [].
  Definition glocal G := [forall x : G, p (label x) [fset (label y) | y <- fset (edge x)]].
  Definition respects e G := [forall x : G, forall y : G, edge x y ==> e (label x) (label y)].

  Definition leaf G (x:G) := ~~ [exists y, edge x y].
End GraphTheory.


The reachable subgraph of every element is rooted at that element

Definition restrict (T : finType) (P : pred T) (Tp : subType P) (e : rel T) :=
  fun x y : Tp => e (val x) (val y).

Lemma connect_subtype (T : finType) (x0 : T) (e : rel T) (Tp : subFinType (connect e x0)) :
  forall x p, connect (restrict Tp e) (Sub x0 p) x.

Disjoint Union of finite graphs

Section Disjoint.
  Variables (L : Type) (I:finType) (G : I -> graph L).

  Definition lift_edge (x y : {i : I & G i}) :=
    (tag x == tag y) && edge (tagged x) (tagged_as x y).

  Lemma lift_eq (i : I) (x y : G i) :
    lift_edge (existT i x) (existT i y) = edge x y.

  Lemma lift_eqn (ix iy : I) (x : G ix) (y : G iy) :
    ix != iy -> lift_edge (existT ix x) (existT iy y) = false.

  Lemma liftE (i j : I) (x : G i) (y : G j) :
    lift_edge (existT i x) (existT j y) -> j = i.

  Lemma lift_connect (i : I) (x y : G i) :
    connect (@edge _ (G i)) x y -> connect lift_edge (existT i x) (existT i y).
End Disjoint.