;;;
;;;
;;; Graph demonstration
;;;
;;;

;;
;; Matcher definitions
;;
(define $graph
  (lambda [$a]
    (set (edge a))))

(define $edge
  (lambda [$a]
    (algebraic-data-matcher
      {<edge a a>})))

;;
;; Sample data
;;
(define $graph-data1
  {<Edge 1 4>
   <Edge 2 1>
   <Edge 3 1>
   <Edge 3 2>
   <Edge 4 3>
   <Edge 5 1>
   <Edge 5 4>
   })

(define $graph-data2
  {<Edge 1 4> <Edge 1 5> <Edge 1 8> <Edge 1 10>
   <Edge 2 3> <Edge 2 6> <Edge 2 12>
   <Edge 3 2> <Edge 3 7> <Edge 3 9>
   <Edge 4 1> <Edge 4 6>
   <Edge 5 1> <Edge 5 8> <Edge 5 9> <Edge 5 11>
   <Edge 6 2> <Edge 6 4> <Edge 6 10> <Edge 6 12>
   <Edge 7 3> <Edge 7 9> <Edge 7 11>
   <Edge 8 1> <Edge 8 5>
   <Edge 9 3> <Edge 9 5> <Edge 9 7>
   <Edge 10 1> <Edge 10 6> <Edge 10 12>
   <Edge 11 5> <Edge 11 7>
   <Edge 12 2> <Edge 12 6> <Edge 12 10>
   })
   
;;
;; Demonstration code
;;
;; find all nodes who have an edge from 's' but not have an edge to 's'
(test (let {[$s 1]}
        (match-all graph-data1 (graph integer)
          [<cons <edge ,s $x>
                 !<cons <edge ,x ,s>
                        _>>
           x])))

;; find all nodes in two paths from 's'
(test (let {[$s 1]}
        (match-all graph-data1 (graph integer)
          [<cons <edge (& ,s $x_1) $x_2>
                 <cons <edge ,x_2 $x_3>
                       _>>
           x])))

;; enumerate first 5 paths from 's' to 'e'
(test (take 5 (let {[$s 1] [$e 2]}
                 (match-all graph-data2 (graph integer)
                   [<cons <edge (& ,s $x_1) $x_2>
                          (loop $i [4 $n]
                            <cons <edge ,x_(- i 2) $x_(- i 1)> ...>
                            <cons <edge ,x_(- n 1) (& ,e $x_n)> _>)>
                    x]))))

;; find all cliques whose size is 'n'
(test (let {[$n 3]}
        (match-all graph-data2 (graph integer)
          [<cons <edge $x_1 $x_2>
                 (loop $i [3 n]
                   <cons <edge ,x_1 $x_i>
                         (loop $j [2 (- i 1)]
                           <cons <edge ,x_j ,x_i> ...>
                           ...)>
                   _)>
           x])))