z-algorithm: slightly faster by allocating and using an array.

db4
John Benediktsson 2014-11-28 10:19:10 -08:00
parent a363c2faf4
commit 7379741b54
1 changed files with 12 additions and 11 deletions

View File

@ -1,38 +1,39 @@
! Copyright (C) 2010 Dmitry Shubin. ! Copyright (C) 2010 Dmitry Shubin.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators.smart kernel locals math math.ranges USING: arrays kernel locals math math.ranges sequences
sequences sequences.private ; sequences.private ;
IN: z-algorithm IN: z-algorithm
: lcp ( seq1 seq2 -- n ) : lcp ( seq1 seq2 -- n )
[ min-length ] 2keep mismatch [ nip ] when* ; [ min-length dup ] 2keep mismatch-unsafe [ nip ] when* ;
<PRIVATE <PRIVATE
:: out-of-zbox ( seq Z l r k -- seq Z l r ) :: out-of-zbox ( seq Z l r k -- seq Z l r )
seq k tail-slice seq lcp :> Zk seq k tail-slice seq lcp :> Zk
Zk Z push seq Z Zk k Z set-nth seq Z
Zk 0 > [ k Zk k + 1 - ] [ l r ] if ; inline Zk 0 > [ k Zk k + 1 - ] [ l r ] if ; inline
:: inside-zbox ( seq Z l r k -- seq Z l r ) :: inside-zbox ( seq Z l r k -- seq Z l r )
k l - Z nth :> Zk' k l - Z nth :> Zk'
r k - 1 + :> b r k - 1 + :> b
seq Z Zk' b < seq Z Zk' b <
[ Zk' Z push l r ] ! still inside [ Zk' k Z set-nth l r ] ! still inside
[ [
seq r 1 + seq b [ tail-slice ] 2bi@ lcp :> q seq r 1 + seq b [ tail-slice ] 2bi@ lcp :> q
q b + Z push k q r + q b + k Z set-nth k q r +
] if ; inline ] if ; inline
: (z-value) ( seq Z l r k -- seq Z l r ) : z-value ( seq Z l r k -- seq Z l r )
2dup < [ out-of-zbox ] [ inside-zbox ] if ; inline 2dup < [ out-of-zbox ] [ inside-zbox ] if ; inline
:: (z-values) ( seq -- Z ) :: (z-values) ( seq -- Z )
V{ } clone 0 0 seq length :> ( Z l r len ) seq length dup 0 <array> :> ( len Z )
len Z push [ seq Z l r 1 len [a,b) [ (z-value) ] each ] len 0 Z set-nth
drop-outputs Z ; inline seq Z 0 0 len [1,b) [ z-value ] each 4drop
Z ; inline
PRIVATE> PRIVATE>
: z-values ( seq -- Z ) : z-values ( seq -- Z )
dup length 0 > [ (z-values) ] when >array ; [ { } ] [ (z-values) ] if-empty ;