Paste: mostly-intersect

Author: randy7
Mode: factor
Date: Sun, 5 Apr 2009 14:55:38
Plain Text | 
: has-all? ( tested-seq requirements-seq -- ? )
    [ swap member? ] with map [ ] all? ;

    
: have-all ( seq^2 requirements-seq -- matches ) 
    '[ _ has-all? ] filter ;
    
: most-is-n ( seq -- n/2+1 ) 
    length 2 /i 1+ ;    
    
: most-items ( seq^2 -- most-seq )
    [ concat ] [ most-is-n 1- ] bi
    [ duplicates ] times prune ; 
! I'm not sure about the use of duplicates here, though it seems like it's correct

: mostly-intersect ( seq^2 -- seq )
    dup most-items have-all ;

Annotation: more of those -- dont tell facebook

Author: randy7
Mode: factor
Date: Sun, 5 Apr 2009 15:52:07
Plain Text | 
    
: count-item ( seq item -- n ) [ = ] curry count ;

: occurence ( seq^2 seq -- counted-seq^2 ) ! only 1 and 0 in our case, because most-items is pruned
    swap [ [ count-item ] with map ] with map ;

: occurs-enough?-map ( seq^2 seq -- appeared^2 )
    occurence [ [ sum ] [ most-is-n ] bi >= ] map ;

: most-in-common ( seq^2 -- have-most-in-common )
    [ ] [ dup most-items occurs-enough?-map ] bi zip
    [ dup second t = [ first ] [ drop f ] if ] map sift ;

New Annotation

Summary:
Author:
Mode:
Body: