latest semantic-db

db4
Alex Chapman 2008-03-08 10:07:11 +11:00
parent 229e9835fb
commit 7ce7df5f89
2 changed files with 5 additions and 5 deletions

View File

@ -16,7 +16,7 @@ C: <tree> tree
parent-child* drop ;
: un-parent-child ( parent child -- )
has-parent-relation -rot <arc> select-tuples [ id>> delete-arc ] each ;
has-parent-relation spin <arc> select-tuples [ id>> delete-arc ] each ;
: child-arcs ( node-id -- child-arcs )
has-parent-relation f rot <arc> select-tuples ;

View File

@ -1,7 +1,7 @@
USING: accessors arrays db db.sqlite db.tuples kernel math namespaces
semantic-db semantic-db.context semantic-db.hierarchy semantic-db.relations
sequences tools.test tools.walker ;
IN: vocab.tests
IN: semantic-db.tests
[
create-node-table create-arc-table
@ -48,11 +48,11 @@ IN: vocab.tests
"charlie" create-node* "charlie" set
"gertrude" create-node* "gertrude" set
[ t ] [ "adam" get "bob" get parent-child* integer? ] unit-test
{ { "eve" "bob" } { "eve" "fran" } { "bob" "gertrude" } { "fran" "charlie" } } [ first2 [ get ] 2apply parent-child ] each
{ { "eve" "bob" } { "eve" "fran" } { "bob" "gertrude" } { "bob" "fran" } { "fran" "charlie" } } [ first2 [ get ] 2apply parent-child ] each
[ { "bob" "fran" } ] [ "eve" get children [ node-content ] map ] unit-test
[ { "adam" "eve" } ] [ "bob" get parents [ node-content ] map ] unit-test
[ "fran" { "charlie" } ] [ "fran" get get-node-hierarchy dup tree-id node-content swap tree-children [ tree-id node-content ] map ] unit-test
[ { "adam" "eve" } ] [ "charlie" get get-root-nodes ] unit-test
[ { } ] [ "fran" get "charlie" get tuck un-parent-child parents ] unit-test
[ { "adam" "eve" } ] [ "charlie" get break get-root-nodes [ node-content ] map ] unit-test
[ { } ] [ "fran" get "charlie" get tuck un-parent-child parents [ node-content ] map ] unit-test
] with-context
] with-tmp-sqlite