latest semantic-db
parent
229e9835fb
commit
7ce7df5f89
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue