/extra/z-algorithm/z-algorithm.factor

 1! Copyright (C) 2010 Dmitry Shubin.
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: arrays combinators.smart kernel locals math math.ranges
 4sequences sequences.private ;
 5IN: z-algorithm
 6
 7: lcp ( seq1 seq2 -- n )
 8    [ min-length ] 2keep mismatch [ nip ] when* ;
 9
10<PRIVATE
11
12:: out-of-zbox ( seq Z l r k -- seq Z l r )
13    seq k tail-slice seq lcp :> Zk
14    Zk Z push seq Z
15    Zk 0 > [ k Zk k + 1 - ] [ l r ] if ; inline
16
17:: inside-zbox ( seq Z l r k -- seq Z l r )
18    k l - Z nth :> Zk'
19    r k - 1 +   :> b
20    seq Z Zk' b <
21    [ Zk' Z push l r ] ! still inside
22    [
23        seq r 1 + seq b [ tail-slice ] 2bi@ lcp :> q
24        q b + Z push k q r +
25    ] if ; inline
26
27: (z-value) ( seq Z l r k -- seq Z l r )
28    2dup < [ out-of-zbox ] [ inside-zbox ] if ; inline
29
30:: (z-values) ( seq -- Z )
31    V{ } clone 0 0 seq length :> ( Z l r len )
32    len Z push [ seq Z l r 1 len [a,b) [ (z-value) ] each ]
33    drop-outputs Z ; inline
34
35PRIVATE>
36
37: z-values ( seq -- Z )
38    dup length 0 > [ (z-values) ] when >array ;