Can I create a DAG in newlisp

[csfreebird]

Hi, My task is to create a directed acyclic graph, I want to implement it using list.
Can any one make an example for me?
My simple case looks like:
[img]1.png[/img]

A and B are start nodes. Each node has properities, each edge has properties too.
E, G and F are end nodes.

I also need a way to find all dependencies of one node.e.g.
If input is D, its dependencies are A, B and C.

[johu]

For example:

Code: Select all

(setq dag '((a c) (b c) (c d) (c g) (d e) (d f)))
(setq dag2 '((a b) (b c) (b d) (b e) (g d) (c e) (d e) (e f)))
(define (search-pre lst)
  (letex (_x (args 0))
    (if (replace nil (map (fn (x) (match '(? _x) x true)) lst)) $it "start")))
(define (search-next lst)
  (letex (_x (args 0))
    (if (replace nil (map (fn (x) (match '(_x ?) x true)) lst)) $it "end")))
(define (search-all lst)
  (letex (_x (args 0))
    (let (res)
      (dolist (x lst)
         (if (match '(? _x) x true) (push $it res -1))
         (if (match '(_x ?) x true) (push $it res -1)))
      (if res (replace nil res)))))

Then,

> (search-all dag 'd)
((c d) (d e) (d f))
> (search-pre dag 'a)
"start"
> (search-next dag 'g)
"end"
> (search-pre dag 'c)
((a c) (b c))
> (search-next dag 'c)
((c d) (c g))

[rickyboy]

I'd use FOOP. After all, FOOP "objects" are just lists (and using only lists was one of your requirements). Anyway, it seems like a natural choice. So, here's a walk through a FOOP implementation.

First some preliminaries. (BTW, I always seem to use mappend, and this time was no different.)

Code: Select all

(define (mappend) (apply append (apply map (args))))
(define (Class:Class) (cons (context) (args)))

The three principal types of objects we need are nodes, edges, and DAGs.

Code: Select all

(new Class 'Node)
(new Class 'Edge)
(new Class 'DAG)

Naturally, DAGs will contain nodes and edges. Here is a helper function to create a DAG. Besides nodes and edges, DAGS contain a "parents-alist", an adjacency list matching nodes (node names, actually) to a list of their parents (names). The create function will compute the "parents-alist" for you, as a convenience.

Code: Select all

(define (DAG:create nodes edges)
  "Create a DAG object from Nodes and Edges."
  (let ((simple-nodes (map (fn (n) (n 1)) nodes))
        (simple-edges (map (fn (e) (list (e 1) (e 2))) edges)))
    (DAG nodes
         edges
         ;; parents-alist: assocs look like (node (parent-node ...))
         (map (fn (sn)
                (list sn
                      (map first
                           (filter (fn (se) (= sn (last se)))
                                   simple-edges))))
              simple-nodes))))

Let's see it in action on your DAG.

Code: Select all

(define my-dag
  (DAG:create (list (Node "A" 'happy)
                    (Node "B" 'sad)
                    (Node "C" 'happy)
                    (Node "D" 'indifferent)
                    (Node "E" 'surly)
                    (Node "F" 'happy)
                    (Node "G" 'sad))
              (list (Edge "A" "C" 3)
                    (Edge "B" "C" 4)
                    (Edge "C" "D" 8)
                    (Edge "C" "G" 1)
                    (Edge "D" "E" 4)
                    (Edge "D" "F" 9))))

Here's what it looks like.

Code: Select all

> my-dag
(DAG ((Node "A" happy) (Node "B" sad) (Node "C" happy)
      (Node "D" indifferent) (Node  "E" surly)
      (Node "F" happy) (Node "G" sad))
     ((Edge "A" "C" 3) (Edge "B" "C" 4) (Edge "C" "D" 8)
      (Edge "C" "G" 1) (Edge "D" "E"  4) (Edge "D" "F" 9))
     (("A" ()) ("B" ()) ("C" ("A" "B")) ("D" ("C"))
      ("E" ("D")) ("F" ("D")) ("G" ("C"))))

You said you required that nodes and edges contain properties. The convention I'm using here is that, when defining a Node, the first "slot" contains the name and the remaining "slots" contain any number of properties that you want to add. So, (Node "A" 'happy) is a node with the name "A" and one property value (namely, 'happy). The same idea applies to edges, except that the first 2 slots contain node names and the remaining slots can be properties. Hence, (Edge "A" "C" 3) is an edge starting from node "A", ending at node "C" and containing the property value 3 (which could be an edge weight/cost, for example). I hope this is what you were looking for, regarding properties.

Now, here are some accessor functions for DAGs (only the ones we need for this application BTW).

Code: Select all

(define (DAG:nodes) (self 1))

(define (DAG:parents node-name)
  (let ((parents-alist (self 3)))
    (if node-name
        (if (assoc node-name parents-alist) (last $it) '())
        parents-alist)))

Finally, here's a function to compute a node's ancestors (i.e. parents, grandparents, and so on) which is what you principally asked for.

Code: Select all

(define (DAG:ancestors node-name)
  (let ((parents (:parents (self) node-name)))
    (and parents
         (append parents
                 (mappend (fn (p) (:ancestors (self) p))
                          parents)))))

Here's a shim that allows you to express what you want to do in your application's parlance.

Code: Select all

(define (find-all-dependencies dag node-name)
  (:ancestors dag node-name))

And here's an example usage.

Code: Select all

> (find-all-dependencies my-dag "D")
("C" "A" "B")

Since you mentioned properties, there may be a situation where you want all the dependencies expressed as Nodes, rather than simply node names, because you might want to extract any node properties. Here's how you might approach that.

A function to get the actual Node (FOOP object) from its name.

Code: Select all

(define (DAG:get-node node-name)
  (and (find (list 'Node node-name '*)
             (:nodes (self))
             match)
       $0))

Now compute the dependencies expressed as a list of Nodes.

Code: Select all

(define (get-all-dependencies dag node-name)
   (map (fn (name) (:get-node dag name))
        (:ancestors dag node-name)))

In action.

Code: Select all

> (get-all-dependencies my-dag "D")
((Node "C" happy) (Node "A" happy) (Node "B" sad))

(If I was able to accomplish it, there should be an attachment to this reply that contains all the code here, for your convenience.)

[rickyboy]

Here's another attachment of code. This contains the code from the previous post with a few additions. Everything you can do with parents and ancestors ("deep parents") in the former code, you can now do with children and descendants ("deep children") also. I also added some comments showing example usages of a few of the intermediate functions (including a couple of degenerate cases, but not exhaustive).

Please try improving it for performance or adding new functionality, for instance, there is no DAG validation (e.g. checking for cycles or making sure a Node exists when it's mentioned by name in an Edge); there is no shortest path function, etc. yet.

Happy hacking!

[csfreebird]

Thank yuu, johu. Your example is simple enough to understand.
Thank you rickyboy, you are so fast, I will learn your code carefully.