;;; ;;; ;;; 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])))