steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

interval-maps: bit more speed using unsafe words.

db4
John Benediktsson 2012-09-19 10:33:25 -07:00
parent ffbe20556b
commit 6cba7af1e1
2 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/interval-maps/interval-maps.factor
View File

@ -1,22 +1,22 @@
! Copyright (C) 2008 Daniel Ehrenberg. ! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences arrays accessors grouping math.order USING: accessors arrays assocs binary-search grouping kernel
sorting binary-search math assocs locals namespaces make ; locals make math math.order sequences sequences.private sorting ;
IN: interval-maps IN: interval-maps
TUPLE: interval-map array ; TUPLE: interval-map { array array read-only } ;
<PRIVATE <PRIVATE
ALIAS: start first ALIAS: start first-unsafe
ALIAS: end second ALIAS: end second-unsafe
ALIAS: value third ALIAS: value third-unsafe
: find-interval ( key interval-map -- interval-node ) : find-interval ( key interval-map -- interval-node )
array>> [ start <=> ] with search nip ; array>> [ start <=> ] with search nip ; inline
: interval-contains? ( key interval-node -- ? ) : interval-contains? ( key interval-node -- ? )
first2 between? ; first2-unsafe between? ; inline
: all-intervals ( sequence -- intervals ) : all-intervals ( sequence -- intervals )
[ [ dup number? [ dup 2array ] when ] dip ] { } assoc-map-as ; [ [ dup number? [ dup 2array ] when ] dip ] { } assoc-map-as ;
@ -31,9 +31,15 @@ ALIAS: value third
: >intervals ( specification -- intervals ) : >intervals ( specification -- intervals )
[ suffix ] { } assoc>map concat 3 group ; [ suffix ] { } assoc>map concat 3 group ;
ERROR: not-an-interval-map obj ;
: check-interval-map ( map -- map )
dup interval-map? [ not-an-interval-map ] unless ; inline
PRIVATE> PRIVATE>
: interval-at* ( key map -- value ? ) : interval-at* ( key map -- value ? )
check-interval-map
[ drop ] [ find-interval ] 2bi [ drop ] [ find-interval ] 2bi
[ nip ] [ interval-contains? ] 2bi [ nip ] [ interval-contains? ] 2bi
[ value t ] [ drop f f ] if ; inline [ value t ] [ drop f f ] if ; inline
@ -43,7 +49,7 @@ PRIVATE>
: interval-key? ( key map -- ? ) interval-at* nip ; : interval-key? ( key map -- ? ) interval-at* nip ;
: interval-values ( map -- values ) : interval-values ( map -- values )
array>> [ value ] map ; check-interval-map array>> [ value ] map ;
: <interval-map> ( specification -- map ) : <interval-map> ( specification -- map )
all-intervals [ first second ] sort-with all-intervals [ first second ] sort-with

17
basis/interval-sets/interval-sets.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 Daniel Ehrenberg. ! Copyright (C) 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays assocs binary-search USING: accessors alien.c-types arrays assocs binary-search
combinators fry grouping hints kernel locals make math combinators fry grouping kernel locals make math math.order
math.order sequences sorting specialized-arrays ; sequences sequences.private sorting specialized-arrays ;
SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: uint
IN: interval-sets IN: interval-sets
! Sets of positive integers ! Sets of positive integers
@ -11,22 +11,25 @@ TUPLE: interval-set { array uint-array read-only } ;
<PRIVATE <PRIVATE
ALIAS: start first ALIAS: start first-unsafe
ALIAS: end second ALIAS: end second-unsafe
: find-interval ( key interval-set -- slice ) : find-interval ( key interval-set -- slice )
array>> 2 <sliced-groups> array>> 2 <sliced-groups>
[ start <=> ] with search nip ; inline [ start <=> ] with search nip ; inline
ERROR: not-an-interval-set obj ;
: check-interval-set ( map -- map )
dup interval-set? [ not-an-interval-set ] unless ; inline
PRIVATE> PRIVATE>
: in? ( key set -- ? ) : in? ( key set -- ? )
dupd find-interval check-interval-set dupd find-interval
[ [ start ] [ end 1 - ] bi between? ] [ [ start ] [ end 1 - ] bi between? ]
[ drop f ] if* ; [ drop f ] if* ;
HINTS: in? { integer interval-set } ;
<PRIVATE <PRIVATE
: spec>pairs ( sequence -- intervals ) : spec>pairs ( sequence -- intervals )