! Copyright (C) 2016 Jon Harper.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs kernel math math.combinatorics
math.statistics prettyprint sequences sets sorting threads ;
IN: fogcreek

: positions-by-chars ( seq -- assoc )
    [ ] collect-index-by ;
: all-pairs ( assoc -- pairs )
    [ nip 2 all-combinations ] { } assoc>map concat ;
: sort-by-length-pos ( pairs -- pairs' )
    [ [ first2 - abs neg ] [ first ] bi 2array ] sort-with ;
: find-pair-without-uniques ( pairs seq -- pair/f )
    [ [ first2 [ 1 + ] dip ] dip <slice> all-unique? ] curry 
    find nip ;
: fogcreek-pair ( seq -- {i,j}/f )
    [ positions-by-chars all-pairs sort-by-length-pos ] keep
    find-pair-without-uniques ;
: copy-to-end ( seq pair -- seq' )
    first swap [ nth ] [ swap suffix ] bi ;
: remove-indices ( seq indices -- seq' )
    natural-sort reverse [ swap remove-nth ] each ;
: (fogcreek-step) ( seq pair -- seq' )
    [ copy-to-end ] [ remove-indices ] bi ;
: fogcreek-step ( seq -- seq' ? )
    dup fogcreek-pair dup [ [ (fogcreek-step) ] keep ] when ;
: remove-after-underscore ( seq -- seq' )
    [ CHAR: _ ] keep index [ head ] when* ;
: fogcreek ( seq -- seq' )
    [ fogcreek-step ] loop remove-after-underscore ;