Paste: a few more
Author: | randy7 |
Mode: | factor |
Date: | Fri, 6 Mar 2009 22:14:15 |
Plain Text |
IN: lil-utils
USING: assocs io arrays namespaces kernel locals math math.ranges sequences splitting ;
: bread-crumbs ( path -- seq )
"/" split dup dup length [1,b]
[ head ] with map
[ "/" join ] map
[ harvest ] bi@ over first [ CHAR: : = ] find
drop f =
[ [ "/" prefix ] bi@ ] when zip ;
: overlap? ( array array -- ? )
2dup [ second ] [ first ] bi* >
[
[ first ] [ second ] bi* >= [ f ] [ t ] if
] [ 2drop f ] if ; inline
: spaces ( seq seq -- seq ? )
2dup [ overlap? ] curry map sift empty?
[ suffix t ] [ drop f ] if ;
: spaces2 ( seq seq -- seq )
2dup [ overlap? ] curry map sift empty?
[ suffix ] [ "overlap" write nl drop ] if ;
: non-overlaps ( seq -- seq )
{ } [ spaces2 ] reduce ;
: any-overlap? ( pair-seq pair -- ? )
[ overlap? ] curry any? ;
SYMBOL: vikky
V{ } clone vikky set
: seq-overlaps? ( seq -- ? )
dup empty?
[ drop f ]
[
[ rest-slice ] [ 1 head first ] bi
[ vikky get ] dip 2dup any-overlap?
[ 3drop t ]
[ suffix vikky set seq-overlaps? ] if
] if ;
New Annotation