Merge branch 'master' of git://factorcode.org/git/factor into new_ui
Slava Pestov
commit
7ca7e58b2f
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math.functions math.ranges project-euler.common sequences ;
|
||||
USING: kernel math.functions math.ranges project-euler.common
|
||||
sequences math.order ;
|
||||
IN: project-euler.056
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=56
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
USING: arrays assocs help.markup help.syntax math.geometry.rect quadtrees quotations sequences ;
|
||||
IN: quadtrees
|
||||
|
||||
ARTICLE: "quadtrees" "Quadtrees"
|
||||
"The " { $snippet "quadtrees" } " vocabulary implements the quadtree structure in Factor. Quadtrees follow the " { $link "assocs-protocol" } " for insertion, deletion, and querying of exact points, using two-dimensional vectors as keys. Additional words are provided for spatial queries and pruning the tree structure:"
|
||||
{ $subsection prune }
|
||||
{ $subsection in-rect }
|
||||
"The following words are provided to help write quadtree algorithms:"
|
||||
{ $subsection descend }
|
||||
{ $subsection each-quadrant }
|
||||
{ $subsection map-quadrant } ;
|
||||
|
||||
ABOUT: "quadtrees"
|
||||
|
||||
HELP: prune
|
||||
{ $values { "tree" quadtree } }
|
||||
{ $description "Removes empty nodes from " { $snippet "tree" } "." } ;
|
||||
|
||||
HELP: in-rect
|
||||
{ $values { "tree" quadtree } { "rect" rect } { "values" sequence } }
|
||||
{ $description "Returns a " { $link sequence } " of values from " { $snippet "tree" } " whose keys lie inside " { $snippet "rect" } "." } ;
|
||||
|
||||
HELP: descend
|
||||
{ $values { "pt" sequence } { "node" quadtree } { "subnode" quadtree } }
|
||||
{ $description "Descends into the subnode of quadtree node " { $snippet "node" } " that contains " { $snippet "pt" } ", leaving " { $snippet "pt" } " on the stack." } ;
|
||||
|
||||
HELP: each-quadrant
|
||||
{ $values { "node" quadtree } { "quot" quotation } }
|
||||
{ $description "Calls " { $snippet "quot" } " with each subnode of " { $snippet "node" } " on the top of the stack in turn." } ;
|
||||
|
||||
HELP: map-quadrant
|
||||
{ $values { "node" quadtree } { "quot" quotation } { "array" array } }
|
||||
{ $description "Calls " { $snippet "quot" } " with each subnode of " { $snippet "node" } " on the top of the stack in turn, collecting the four results into " { $snippet "array" } "." } ;
|
||||
|
||||
|
|
@ -0,0 +1,202 @@
|
|||
! (c) 2009 Joe Groff, see BSD license
|
||||
USING: assocs kernel tools.test quadtrees math.geometry.rect sorting ;
|
||||
IN: quadtrees.tests
|
||||
|
||||
: unit-bounds ( -- rect ) { -1.0 -1.0 } { 2.0 2.0 } <rect> ;
|
||||
|
||||
: value>>key ( assoc value key -- assoc )
|
||||
pick set-at ; inline
|
||||
: delete>>key ( assoc key -- assoc )
|
||||
over delete-at ; inline
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } { 0.0 -0.25 } "a" f f f f t } ]
|
||||
[
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
] unit-test
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } { 0.0 -0.25 } "b" f f f f t } ]
|
||||
[
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
"b" { 0.0 -0.25 } value>>key
|
||||
] unit-test
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
|
||||
T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } { -0.5 -0.75 } "c" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 -1.0 } { 1.0 1.0 } } { 0.0 -0.25 } "a" f f f f t }
|
||||
T{ quadtree f T{ rect f { -1.0 0.0 } { 1.0 1.0 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 0.0 } { 1.0 1.0 } } { 0.25 0.25 } "b" f f f f t }
|
||||
f
|
||||
} ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
"b" { 0.25 0.25 } value>>key
|
||||
"c" { -0.5 -0.75 } value>>key
|
||||
] unit-test
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
|
||||
T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } { -0.5 -0.75 } "c" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 -1.0 } { 1.0 1.0 } } { 0.0 -0.25 } "a" f f f f t }
|
||||
T{ quadtree f T{ rect f { -1.0 0.0 } { 1.0 1.0 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 0.0 } { 1.0 1.0 } } f f
|
||||
T{ quadtree f T{ rect f { 0.0 0.0 } { 0.5 0.5 } } { 0.25 0.25 } "b" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.5 0.0 } { 0.5 0.5 } } { 0.75 0.25 } "d" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 0.5 } { 0.5 0.5 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.5 0.5 } { 0.5 0.5 } } f f f f f f t }
|
||||
}
|
||||
f
|
||||
} ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
"b" { 0.25 0.25 } value>>key
|
||||
"c" { -0.5 -0.75 } value>>key
|
||||
"d" { 0.75 0.25 } value>>key
|
||||
] unit-test
|
||||
|
||||
[ "b" t ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
"b" { 0.25 0.25 } value>>key
|
||||
"c" { -0.5 -0.75 } value>>key
|
||||
"d" { 0.75 0.25 } value>>key
|
||||
|
||||
{ 0.25 0.25 } swap at*
|
||||
] unit-test
|
||||
|
||||
[ f f ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
"b" { 0.25 0.25 } value>>key
|
||||
"c" { -0.5 -0.75 } value>>key
|
||||
"d" { 0.75 0.25 } value>>key
|
||||
|
||||
{ 1.0 1.0 } swap at*
|
||||
] unit-test
|
||||
|
||||
[ { "a" "c" } ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
"b" { 0.25 0.25 } value>>key
|
||||
"c" { -0.5 -0.75 } value>>key
|
||||
"d" { 0.75 0.25 } value>>key
|
||||
|
||||
{ -0.6 -0.8 } { 0.8 1.0 } <rect> swap in-rect natural-sort
|
||||
] unit-test
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
|
||||
T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } { -0.5 -0.75 } "c" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 -1.0 } { 1.0 1.0 } } { 0.0 -0.25 } "a" f f f f t }
|
||||
T{ quadtree f T{ rect f { -1.0 0.0 } { 1.0 1.0 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 0.0 } { 1.0 1.0 } } { 0.75 0.25 } "d" f f f f t }
|
||||
f
|
||||
} ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
"b" { 0.25 0.25 } value>>key
|
||||
"c" { -0.5 -0.75 } value>>key
|
||||
"d" { 0.75 0.25 } value>>key
|
||||
|
||||
{ 0.25 0.25 } delete>>key
|
||||
prune
|
||||
] unit-test
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
|
||||
T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } { -0.5 -0.75 } "c" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 -1.0 } { 1.0 1.0 } } { 0.0 -0.25 } "a" f f f f t }
|
||||
T{ quadtree f T{ rect f { -1.0 0.0 } { 1.0 1.0 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 0.0 } { 1.0 1.0 } } f f f f f f t }
|
||||
f
|
||||
} ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { 0.0 -0.25 } value>>key
|
||||
"b" { 0.25 0.25 } value>>key
|
||||
"c" { -0.5 -0.75 } value>>key
|
||||
"d" { 0.75 0.25 } value>>key
|
||||
|
||||
{ 0.25 0.25 } delete>>key
|
||||
{ 0.75 0.25 } delete>>key
|
||||
prune
|
||||
] unit-test
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
|
||||
T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } f f
|
||||
T{ quadtree f T{ rect f { -1.0 -1.0 } { 0.5 0.5 } } { -0.75 -0.75 } "b" f f f f t }
|
||||
T{ quadtree f T{ rect f { -0.5 -1.0 } { 0.5 0.5 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { -1.0 -0.5 } { 0.5 0.5 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { -0.5 -0.5 } { 0.5 0.5 } } { -0.25 -0.25 } "a" f f f f t }
|
||||
f
|
||||
}
|
||||
T{ quadtree f T{ rect f { 0.0 -1.0 } { 1.0 1.0 } } f f
|
||||
T{ quadtree f T{ rect f { 0.0 -1.0 } { 0.5 0.5 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.5 -1.0 } { 0.5 0.5 } } { 0.75 -0.75 } "f" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 -0.5 } { 0.5 0.5 } } { 0.25 -0.25 } "e" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.5 -0.5 } { 0.5 0.5 } } f f f f f f t }
|
||||
f
|
||||
}
|
||||
T{ quadtree f T{ rect f { -1.0 0.0 } { 1.0 1.0 } } f f
|
||||
T{ quadtree f T{ rect f { -1.0 0.0 } { 0.5 0.5 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { -0.5 0.0 } { 0.5 0.5 } } { -0.25 0.25 } "c" f f f f t }
|
||||
T{ quadtree f T{ rect f { -1.0 0.5 } { 0.5 0.5 } } { -0.75 0.75 } "d" f f f f t }
|
||||
T{ quadtree f T{ rect f { -0.5 0.5 } { 0.5 0.5 } } f f f f f f t }
|
||||
f
|
||||
}
|
||||
T{ quadtree f T{ rect f { 0.0 0.0 } { 1.0 1.0 } } f f
|
||||
T{ quadtree f T{ rect f { 0.0 0.0 } { 0.5 0.5 } } { 0.25 0.25 } "g" f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.5 0.0 } { 0.5 0.5 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.0 0.5 } { 0.5 0.5 } } f f f f f f t }
|
||||
T{ quadtree f T{ rect f { 0.5 0.5 } { 0.5 0.5 } } { 0.75 0.75 } "h" f f f f t }
|
||||
f
|
||||
}
|
||||
f
|
||||
} ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { -0.25 -0.25 } value>>key
|
||||
"b" { -0.75 -0.75 } value>>key
|
||||
"c" { -0.25 0.25 } value>>key
|
||||
"d" { -0.75 0.75 } value>>key
|
||||
"e" { 0.25 -0.25 } value>>key
|
||||
"f" { 0.75 -0.75 } value>>key
|
||||
"g" { 0.25 0.25 } value>>key
|
||||
"h" { 0.75 0.75 } value>>key
|
||||
|
||||
prune
|
||||
] unit-test
|
||||
|
||||
[ 8 ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { -0.25 -0.25 } value>>key
|
||||
"b" { -0.75 -0.75 } value>>key
|
||||
"c" { -0.25 0.25 } value>>key
|
||||
"d" { -0.75 0.75 } value>>key
|
||||
"e" { 0.25 -0.25 } value>>key
|
||||
"f" { 0.75 -0.75 } value>>key
|
||||
"g" { 0.25 0.25 } value>>key
|
||||
"h" { 0.75 0.75 } value>>key
|
||||
|
||||
assoc-size
|
||||
] unit-test
|
||||
|
||||
[ {
|
||||
{ { -0.75 -0.75 } "b" }
|
||||
{ { -0.75 0.75 } "d" }
|
||||
{ { -0.25 -0.25 } "a" }
|
||||
{ { -0.25 0.25 } "c" }
|
||||
{ { 0.25 -0.25 } "e" }
|
||||
{ { 0.25 0.25 } "g" }
|
||||
{ { 0.75 -0.75 } "f" }
|
||||
{ { 0.75 0.75 } "h" }
|
||||
} ] [
|
||||
unit-bounds <quadtree>
|
||||
"a" { -0.25 -0.25 } value>>key
|
||||
"b" { -0.75 -0.75 } value>>key
|
||||
"c" { -0.25 0.25 } value>>key
|
||||
"d" { -0.75 0.75 } value>>key
|
||||
"e" { 0.25 -0.25 } value>>key
|
||||
"f" { 0.75 -0.75 } value>>key
|
||||
"g" { 0.25 0.25 } value>>key
|
||||
"h" { 0.75 0.75 } value>>key
|
||||
|
||||
>alist natural-sort
|
||||
] unit-test
|
||||
|
||||
|
|
@ -0,0 +1,188 @@
|
|||
! (c) 2009 Joe Groff, see BSD license
|
||||
USING: assocs kernel math.geometry.rect combinators accessors
|
||||
math.vectors vectors sequences math math.points math.geometry
|
||||
combinators.short-circuit arrays fry locals ;
|
||||
IN: quadtrees
|
||||
|
||||
TUPLE: quadtree { bounds rect } point value ll lr ul ur leaf? ;
|
||||
|
||||
: <quadtree> ( bounds -- quadtree ) f f f f f f t quadtree boa ;
|
||||
|
||||
: rect-ll ( rect -- point ) loc>> ;
|
||||
: rect-lr ( rect -- point ) [ loc>> ] [ width ] bi v+x ;
|
||||
: rect-ul ( rect -- point ) [ loc>> ] [ height ] bi v+y ;
|
||||
: rect-ur ( rect -- point ) [ loc>> ] [ dim>> ] bi v+ ;
|
||||
|
||||
: rect-center ( rect -- point ) [ loc>> ] [ dim>> 0.5 v*n ] bi v+ ; inline
|
||||
|
||||
: (quadrant) ( pt node -- quadrant )
|
||||
swap [ first 0.0 < ] [ second 0.0 < ] bi
|
||||
[ [ ll>> ] [ lr>> ] if ]
|
||||
[ [ ul>> ] [ ur>> ] if ] if ;
|
||||
|
||||
: quadrant ( pt node -- quadrant )
|
||||
[ bounds>> rect-center v- ] keep (quadrant) ;
|
||||
|
||||
: descend ( pt node -- pt subnode )
|
||||
[ drop ] [ quadrant ] 2bi ; inline
|
||||
|
||||
:: each-quadrant ( node quot -- )
|
||||
node ll>> quot call
|
||||
node lr>> quot call
|
||||
node ul>> quot call
|
||||
node ur>> quot call ; inline
|
||||
: map-quadrant ( node quot: ( child-node -- x ) -- array )
|
||||
each-quadrant 4array ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
DEFER: (prune)
|
||||
DEFER: insert
|
||||
DEFER: erase
|
||||
DEFER: at-point
|
||||
DEFER: quadtree>alist
|
||||
DEFER: quadtree-size
|
||||
DEFER: node-insert
|
||||
DEFER: in-rect*
|
||||
|
||||
: child-dim ( rect -- dim/2 ) dim>> 0.5 v*n ; inline
|
||||
: ll-bounds ( rect -- rect' )
|
||||
[ loc>> ] [ child-dim ] bi <rect> ;
|
||||
: lr-bounds ( rect -- rect' )
|
||||
[ [ loc>> ] [ dim>> { 0.5 0.0 } v* ] bi v+ ] [ child-dim ] bi <rect> ;
|
||||
: ul-bounds ( rect -- rect' )
|
||||
[ [ loc>> ] [ dim>> { 0.0 0.5 } v* ] bi v+ ] [ child-dim ] bi <rect> ;
|
||||
: ur-bounds ( rect -- rect' )
|
||||
[ [ loc>> ] [ dim>> { 0.5 0.5 } v* ] bi v+ ] [ child-dim ] bi <rect> ;
|
||||
|
||||
: {quadrants} ( node -- quadrants )
|
||||
{ [ ll>> ] [ lr>> ] [ ul>> ] [ ur>> ] } cleave 4array ;
|
||||
|
||||
: add-subnodes ( node -- node )
|
||||
dup bounds>> {
|
||||
[ ll-bounds <quadtree> >>ll ]
|
||||
[ lr-bounds <quadtree> >>lr ]
|
||||
[ ul-bounds <quadtree> >>ul ]
|
||||
[ ur-bounds <quadtree> >>ur ]
|
||||
} cleave
|
||||
f >>leaf? ;
|
||||
|
||||
: split-leaf ( value point leaf -- )
|
||||
add-subnodes
|
||||
[ value>> ] [ point>> ] [ ] tri
|
||||
[ node-insert ] [ node-insert ] bi ;
|
||||
|
||||
: leaf-replaceable? ( pt leaf -- ? ) point>> { [ nip not ] [ = ] } 2|| ;
|
||||
: leaf-insert ( value point leaf -- )
|
||||
2dup leaf-replaceable?
|
||||
[ [ (>>point) ] [ (>>value) ] bi ]
|
||||
[ split-leaf ] if ;
|
||||
|
||||
: node-insert ( value point node -- )
|
||||
descend insert ;
|
||||
|
||||
: insert ( value point tree -- )
|
||||
dup leaf?>> [ leaf-insert ] [ node-insert ] if ;
|
||||
|
||||
: leaf-at-point ( point leaf -- value/f ? )
|
||||
tuck point>> = [ value>> t ] [ drop f f ] if ;
|
||||
|
||||
: node-at-point ( point node -- value/f ? )
|
||||
descend at-point ;
|
||||
|
||||
: at-point ( point tree -- value/f ? )
|
||||
dup leaf?>> [ leaf-at-point ] [ node-at-point ] if ;
|
||||
|
||||
: (node-in-rect*) ( values rect node -- values )
|
||||
2dup bounds>> intersects? [ in-rect* ] [ 2drop ] if ;
|
||||
: node-in-rect* ( values rect node -- values )
|
||||
[ (node-in-rect*) ] with each-quadrant ;
|
||||
|
||||
: leaf-in-rect* ( values rect leaf -- values )
|
||||
tuck { [ nip point>> ] [ point>> swap intersects? ] } 2&&
|
||||
[ value>> over push ] [ drop ] if ;
|
||||
|
||||
: in-rect* ( values rect tree -- values )
|
||||
dup leaf?>> [ leaf-in-rect* ] [ node-in-rect* ] if ;
|
||||
|
||||
: leaf-erase ( point leaf -- )
|
||||
tuck point>> = [ f >>point f >>value ] when drop ;
|
||||
|
||||
: node-erase ( point node -- )
|
||||
descend erase ;
|
||||
|
||||
: erase ( point tree -- )
|
||||
dup leaf?>> [ leaf-erase ] [ node-erase ] if ;
|
||||
|
||||
: (?leaf) ( quadrant -- {point,value}/f )
|
||||
dup point>> [ swap value>> 2array ] [ drop f ] if* ;
|
||||
: ?leaf ( quadrants -- {point,value}/f )
|
||||
[ (?leaf) ] map sift dup length {
|
||||
{ 1 [ first ] }
|
||||
{ 0 [ drop { f f } ] }
|
||||
[ 2drop f ]
|
||||
} case ;
|
||||
|
||||
: collapseable? ( node -- {point,value}/f )
|
||||
{quadrants} { [ [ leaf?>> ] all? ] [ ?leaf ] } 1&& ;
|
||||
|
||||
: remove-subnodes ( node -- leaf ) f >>ll f >>lr f >>ul f >>ur t >>leaf? ;
|
||||
|
||||
: collapse ( node {point,value} -- )
|
||||
first2 [ >>point ] [ >>value ] bi* remove-subnodes drop ;
|
||||
|
||||
: node-prune ( node -- )
|
||||
[ [ (prune) ] each-quadrant ] [ ] [ collapseable? ] tri
|
||||
[ collapse ] [ drop ] if* ;
|
||||
|
||||
: (prune) ( tree -- )
|
||||
dup leaf?>> [ drop ] [ node-prune ] if ;
|
||||
|
||||
: leaf>alist ( leaf -- alist )
|
||||
dup point>> [ [ point>> ] [ value>> ] bi 2array 1array ] [ drop { } ] if ;
|
||||
|
||||
: node>alist ( node -- alist ) [ quadtree>alist ] map-quadrant concat ;
|
||||
|
||||
: quadtree>alist ( tree -- assoc )
|
||||
dup leaf?>> [ leaf>alist ] [ node>alist ] if ;
|
||||
|
||||
: leaf-size ( leaf -- count )
|
||||
point>> [ 1 ] [ 0 ] if ;
|
||||
: node-size ( node -- count )
|
||||
0 swap [ quadtree-size + ] each-quadrant ;
|
||||
|
||||
: quadtree-size ( tree -- count )
|
||||
dup leaf?>> [ leaf-size ] [ node-size ] if ;
|
||||
|
||||
: leaf= ( a b -- ? ) [ [ point>> ] [ value>> ] bi 2array ] bi@ = ;
|
||||
|
||||
: node= ( a b -- ? ) [ {quadrants} ] bi@ = ;
|
||||
|
||||
: (tree=) ( a b -- ? ) dup leaf?>> [ leaf= ] [ node= ] if ;
|
||||
|
||||
: tree= ( a b -- ? )
|
||||
2dup [ leaf?>> ] bi@ = [ (tree=) ] [ 2drop f ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: prune ( tree -- tree ) [ (prune) ] keep ;
|
||||
|
||||
: in-rect ( tree rect -- values )
|
||||
[ 16 <vector> ] 2dip in-rect* ;
|
||||
|
||||
M: quadtree equal? ( a b -- ? )
|
||||
over quadtree? [ tree= ] [ 2drop f ] if ;
|
||||
|
||||
INSTANCE: quadtree assoc
|
||||
|
||||
M: quadtree at* ( key assoc -- value/f ? ) at-point ;
|
||||
M: quadtree assoc-size ( assoc -- n ) quadtree-size ;
|
||||
M: quadtree >alist ( assoc -- alist ) quadtree>alist ;
|
||||
M: quadtree set-at ( value key assoc -- ) insert ;
|
||||
M: quadtree delete-at ( key assoc -- ) erase ;
|
||||
M: quadtree clear-assoc ( assoc -- )
|
||||
t >>leaf?
|
||||
f >>point
|
||||
f >>value
|
||||
drop ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Quadtree spatial indices
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
assocs
|
||||
graphics
|
||||
Loading…
Reference in New Issue