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 ) ! example path: "/boot/home/apps/CDPlayer"
    "/" 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 -- ? ) ! { from to } x2
    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 ! rest head
        [ vikky get ] dip 2dup any-overlap? ! rest vikky head t/f
            [ 3drop t ] 
            [ suffix  vikky set seq-overlaps? ] if 
    ] if ; 
        
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! !!!!!!!!!!!!!!!!!!!

New Annotation

Summary:
Author:
Mode:
Body: