extra/z-algorithm/z-algorithm.factor

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