Depth First Search (nbtw assumption)

The graph is represented by a pair (vertices, successor)

• vertices : this constant is the set of graph vertices
• successor : this function gives for each vertex the set of vertices directly joinable from it

The algorithm is standard with gray/black sets of nodes. (white set is the complement of their union)
The proof assumes to start with non black-to-white colouring.
All proofs are automatic.

Program logic with reachable predicate defined with an existential quantifier. This proof does not use the access predicate. Notice that x is here blackened after the assertion. This is because the provers cannot prove the assertion within 15 seconds if x was blackened before it.

module Dfs_nbtw
  use import int.Int
  use import list.List
  use import list.Append
  use import list.Mem as L
  use import list.Elements as E
  use import init_graph.GraphSetSucc

(*  inductive reachable vertex vertex =
  | Reachable_empty:
      forall x: vertex. reachable x x
  | Reachable_cons:
      forall x y z: vertex, l: list vertex.
      edge x y -> reachable y z -> reachable x z
*)

  predicate reachable (x z: vertex) =
    exists l. path x l z  

  lemma reachable_succ:
    forall x x'. edge x x' -> reachable x x'

  lemma reachable_trans:
    forall x y z. reachable x y -> reachable y z -> reachable x z

   predicate no_black_to_white (b g: set vertex) =
    forall x x'. edge x x' -> mem x b -> mem x' (union b g) 

  lemma black_to_white_path_goes_thru_gray:
    forall g b. no_black_to_white b g -> 
      forall x l z. path x l z -> mem x b -> not mem z (union b g) ->
        exists y. L.mem y l /\ mem y g

let rec dfs r g b 
  variant {(cardinal vertices - cardinal g), (cardinal r)} =
  requires {subset r vertices}  
  requires {subset g vertices}  
  requires {no_black_to_white b g}
  ensures {subset b result}  
  ensures {no_black_to_white result g}
  ensures {forall x. mem x r -> not mem x g -> mem x result} 
  ensures {forall z. mem z result -> exists y. mem y (union b r) /\ reachable y z}

  if is_empty r then b else
  let x = choose r in
  let r' = remove x r in
  if mem x (union g b) then dfs r' g b else 
  let b' = dfs (successors x) (add x g) b in
  assert{ forall z. mem z b' -> exists y. mem y (add x b) /\ reachable y z};
  dfs r' g (add x b')

let dfs_main roots =
  requires {subset roots vertices}
  ensures {forall z. mem z result <-> exists y. mem y roots /\ reachable y z}
  dfs roots empty empty

end