From: Slava Pestov Date: Fri, 6 Feb 2009 04:29:15 +0000 (-0600) Subject: Fix conflict X-Git-Tag: 0.94~2191^2~346 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=ae0da1cf983e96fb51df05562817558387e732e9 Fix conflict --- ae0da1cf983e96fb51df05562817558387e732e9 diff --cc basis/math/rectangles/rectangles-tests.factor index 332a3ef52d,0000000000..ca722859d2 mode 100644,000000..100644 --- a/basis/math/rectangles/rectangles-tests.factor +++ b/basis/math/rectangles/rectangles-tests.factor @@@ -1,35 -1,0 +1,42 @@@ +USING: tools.test math.rectangles ; +IN: math.rectangles.tests + +[ T{ rect f { 10 10 } { 20 20 } } ] +[ + T{ rect f { 10 10 } { 50 50 } } + T{ rect f { -10 -10 } { 40 40 } } + rect-intersect +] unit-test + +[ T{ rect f { 200 200 } { 0 0 } } ] +[ + T{ rect f { 100 100 } { 50 50 } } + T{ rect f { 200 200 } { 40 40 } } + rect-intersect +] unit-test + +[ f ] [ + T{ rect f { 100 100 } { 50 50 } } + T{ rect f { 200 200 } { 40 40 } } + contains-rect? +] unit-test + +[ t ] [ + T{ rect f { 100 100 } { 50 50 } } + T{ rect f { 120 120 } { 40 40 } } + contains-rect? +] unit-test + +[ f ] [ + T{ rect f { 1000 100 } { 50 50 } } + T{ rect f { 120 120 } { 40 40 } } + contains-rect? +] unit-test + ++[ T{ rect f { 10 20 } { 20 20 } } ] [ ++ { ++ { 20 20 } ++ { 10 40 } ++ { 30 30 } ++ } rect-containing ++] unit-test diff --cc basis/math/rectangles/rectangles.factor index 1c30253d30,0000000000..d3ada2951c mode 100644,000000..100644 --- a/basis/math/rectangles/rectangles.factor +++ b/basis/math/rectangles/rectangles.factor @@@ -1,46 -1,0 +1,50 @@@ +! Copyright (C) 2008, 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel arrays sequences math math.vectors accessors ; +IN: math.rectangles + +TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ; + +: ( loc dim -- rect ) rect boa ; inline + +: ( -- rect ) rect new ; inline + +: point>rect ( loc -- rect ) { 0 0 } ; inline + +: rect-bounds ( rect -- loc dim ) [ loc>> ] [ dim>> ] bi ; + +: rect-extent ( rect -- loc ext ) rect-bounds over v+ ; + +: with-rect-extents ( rect1 rect2 loc-quot: ( loc1 loc2 -- ) ext-quot: ( ext1 ext2 -- ) -- ) + [ [ rect-extent ] bi@ ] 2dip bi-curry* bi* ; inline + +: ( loc ext -- rect ) over [v-] ; + +: offset-rect ( rect loc -- newrect ) + over loc>> v+ swap dim>> ; + +: (rect-intersect) ( rect rect -- array array ) + [ vmax ] [ vmin ] with-rect-extents ; + +: rect-intersect ( rect1 rect2 -- newrect ) + (rect-intersect) ; + +GENERIC: contains-rect? ( rect1 rect2 -- ? ) + +M: rect contains-rect? + (rect-intersect) [v-] { 0 0 } = ; + +GENERIC: contains-point? ( point rect -- ? ) + +M: rect contains-point? + [ point>rect ] dip contains-rect? ; + +: (rect-union) ( rect rect -- array array ) + [ vmin ] [ vmax ] with-rect-extents ; + +: rect-union ( rect1 rect2 -- newrect ) + (rect-union) ; ++ ++: rect-containing ( points -- rect ) ++ [ vsupremum ] [ vinfimum ] bi ++ [ nip ] [ v- ] 2bi ; diff --cc basis/math/vectors/vectors.factor index a6967a7218,4d9a0916b5..eb5fa7b970 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@@ -19,6 -19,9 +19,9 @@@ IN: math.vector : vmax ( u v -- w ) [ max ] 2map ; : vmin ( u v -- w ) [ min ] 2map ; -: vgreatest ( array -- vmax ) { -1.0/0.0 -1.0/0.0 } [ vmax ] reduce ; -: vleast ( array -- vmax ) { 1.0/0.0 1.0/0.0 } [ vmin ] reduce ; ++: vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ; ++: vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ; + : v. ( u v -- x ) [ * ] [ + ] 2map-reduce ; : norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ; : norm ( v -- x ) norm-sq sqrt ; diff --cc extra/quadtrees/quadtrees-tests.factor index 697fd53f3a,7a17c1fb44..993389a4b4 --- a/extra/quadtrees/quadtrees-tests.factor +++ b/extra/quadtrees/quadtrees-tests.factor @@@ -1,5 -1,5 +1,5 @@@ ! (c) 2009 Joe Groff, see BSD license - USING: assocs kernel tools.test quadtrees math.rectangles sorting ; -USING: accessors assocs kernel tools.test quadtrees math.geometry.rect sorting ; ++USING: accessors assocs kernel tools.test quadtrees math.rectangles sorting ; IN: quadtrees.tests : unit-bounds ( -- rect ) { -1.0 -1.0 } { 2.0 2.0 } ; diff --cc extra/quadtrees/quadtrees.factor index 383a0907e7,d9bdbe4aeb..1a916c74f4 --- a/extra/quadtrees/quadtrees.factor +++ b/extra/quadtrees/quadtrees.factor @@@ -1,17 -1,20 +1,19 @@@ ! (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 ; +USING: assocs kernel math.rectangles combinators accessors - math.vectors vectors sequences math math.points math.geometry - combinators.short-circuit arrays fry locals ; ++math.vectors vectors sequences math combinators.short-circuit arrays fry ; IN: quadtrees TUPLE: quadtree { bounds rect } point value ll lr ul ur leaf? ; - : ( bounds -- quadtree ) f f f f f f t quadtree boa ; + : ( bounds -- quadtree ) + quadtree new + swap >>bounds + t >>leaf? ; : 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-lr ( rect -- point ) [ loc>> ] [ dim>> { 1 0 } v* ] bi v+ ; ++: rect-ul ( rect -- point ) [ loc>> ] [ dim>> { 0 1 } v* ] bi v+ ; ++: rect-ur ( rect -- point ) [ loc>> ] [ dim>> ] bi v+ ; : rect-center ( rect -- point ) [ loc>> ] [ dim>> 0.5 v*n ] bi v+ ; inline @@@ -94,12 -100,12 +99,12 @@@ DEFER: in-rect dup leaf?>> [ leaf-at-point ] [ node-at-point ] if ; : (node-in-rect*) ( values rect node -- values ) -- 2dup bounds>> intersects? [ in-rect* ] [ 2drop ] if ; ++ 2dup bounds>> contains-rect? [ 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&& ++ tuck { [ nip point>> ] [ point>> swap contains-point? ] } 2&& [ value>> over push ] [ drop ] if ; : in-rect* ( values rect tree -- values )