strsearch.dylan

module:   string-search
author:   Robert Stockton (rgs@cs.cmu.edu)
synopsis: Provides a small assortment of specialized operations for
          searching and modifying <vector>s and <byte-string>s.  These
          operations are analogous to existing collection operations but
          provide keywords and efficiency improvements which are
          meaningful only within the more limited domain.

//======================================================================
//
// Copyright (c) 1994  Carnegie Mellon University
// Copyright (c) 1998, 1999, 2000  Gwydion Dylan Maintainers
// All rights reserved.
//
// Use and copying of this software and preparation of derivative
// works based on this software are permitted, including commercial
// use, provided that the following conditions are observed:
//
// 1. This copyright notice must be retained in full on any copies
//    and on appropriate parts of any derivative works.
// 2. Documentation (paper or online) accompanying any system that
//    incorporates this software, or any part of it, must acknowledge
//    the contribution of the Gwydion Project at Carnegie Mellon
//    University, and the Gwydion Dylan Maintainers.
//
// This software is made available "as is".  Neither the authors nor
// Carnegie Mellon University make any warranty about the software,
// its performance, or its conformity to any specification.
//
// Bug reports should be sent to <gd-bugs@gwydiondylan.org>; questions,
// comments and suggestions are welcome at <gd-hackers@gwydiondylan.org>.
// Also, see http://www.gwydiondylan.org/ for updates and documentation.
//
//======================================================================

//======================================================================
// The "string-search" module provides basic search and replace capabilities
// upon restricted subsets of <sequence> -- primarily <vector> and
// <byte-string>.  Exploiting the known properties of these types yields
// substantially better performance than can be achieved for sequences in
// general.
//
// The following functions are supplied:
//
// find-first-key vector predicate? #key start end failure => key
//     Find the index of first element (after start but before end) of a
//     vector which satisfies the given predicate.  If no matching element is
//     found, return failure.  The defaults for start, end and failure are,
//     respectively,  0, size(vector), and #f.  This function is like
//     find-key, but accepts start: and end: rather than skip:.)
//
// find-last-key vector predicate? #key start end failure => key
//     This is like find-first-key, but goes backward from end.
//
// substring-position big pattern #key compiled start => index
//     This is a specialized version of subsequence-position which works only
//     on <byte-strings>.  Since this routine only handles byte-characters and
//     \== tests, it can do a "Boyer-Moore-ish" search.  (If the pattern is
//     too small for B-M to pay off, substring-position will fall back upon a
//     simpler search strategy -- this function should never be slower than
//     subsequence-position.)
//
//     Note that this function takes a start: keyword (which defaults to 0)
//     instead of skip:.
//
//     As a further optimization, you may pre-compute a "compiled" dispatch
//     table for the pattern with compile-substring and pass it in (along with
//     the pattern itself) via the compiled: keyword.  This will save both
//     time and space if you are searching for the same pattern repeatedly.
//
// compile-substring pattern => compiled
//     Produce a skip table for Boyer-Moore-ish searching.  By splitting this
//     off into a separate routine we allow people to pre-compile heavily used
//     strings, thus avoiding one of the more expensive parts of the search.
//
// replace-substring big pattern goal #key count compiled => result
//     Replaces all (or up to count) occurrences of pattern in big with goal.
//     As in substring-position all three arguments must be <byte-string>s.
//     Accepts the compiled: keyword as described above.  Returns a new string
//     iff it finds at least one match to replace.
//======================================================================

// Find the index of first element (after "from") of a vector which
// satisfies the given predicate.  (Like find-key, but accepts start: and end:
// rather than skip:.)
define method find-first-key(seq :: <vector>, pred?,
                             #key start = 0, end: last, failure: fail)
  block (return)
    let sz = size(seq);
    let last = if (last & last < sz) last else sz end if;
    for (i :: <integer> from start below last)
      if (pred?(seq[i])) return(i) end if;
    finally fail
    end for
  end block
end method find-first-key;

// Like find-first-key, but goes backward from the end (or from before end:).
define method find-last-key(seq :: <vector>, pred?,
                            #key start = 0, end: last, failure: fail)
  block (return)
    let sz = size(seq);
    let last = if (last & last < sz) last else sz end if;
    for (i from last - 1 to start by -1)
      if (pred?(seq[i])) return(i) end if;
    finally fail
    end for
  end block
end method find-last-key;

// Specialized version of "subsequence-position" specialized for byte-strings.
// Since this routine only handles byte-characters and "==" tests, it can do
// a Boyer-Moore-ish search.  As a further optimization, you may pre-compile
// the pattern with "compile-substring" and pass it in as the "compiled:"
// keyword.  This will save both time and space if you are searching for the
// same pattern repeatedly.
define method substring-position(big :: <byte-string>,
                                 pattern :: <byte-string>,
                                 #key compiled, start = 0)
  let sz = size(big);
  let pat-sz = size(pattern);

  select (pat-sz)
    0 =>                        // empty string always matches
      start;
    1 =>                        // simple character search
      let ch = pattern[0];
      for (key from start below sz,
           until big[key] == ch)
      finally
        if (key < sz) key end if;
      end for;
    2 =>                        // pairs of characters -- starting to get
      let ch1 = pattern[0];        // marginal
      let ch2 = pattern[1];
      for (key from start below sz - 1,
           until big[key] == ch1 & big[key + 1] == ch2)
      finally
        if (key < (sz - 1)) key end if;
      end for;
    otherwise =>                // It's worth doing something Boyer-Moore-ish
      let pat-last = pat-sz - 1;
      let last-char = pattern[pat-last];
      let skip = compiled | compile-substring(pattern);
      local method search(index)
              if (index >= sz)        // past end of big -- it's not here
                #f;
              else
                let char = big[index];
                if (char == last-char) // maybe it's here -- we'd better check
                  for (pat-key from 0 below pat-last,
                       big-key from index - pat-last,
                       while big[big-key] == pattern[pat-key])
                  finally
                    if (pat-key == pat-last) // fell off end -- found it.
                      index - pat-last;
                    else
                      search(index + 1) // no luck -- try further down
                    end if;
                  end for;
                else                // last character didn't match, so we can use
                  // the "skip table" to optimize
                  search(index + skip[as(<integer>, char)]);
                end if;
              end if;
            end method;
      search(start + pat-last);
  end select;
end method substring-position;

// Produce a skip table for Boyer-Moore-ish searching.  By splitting this off
// into a separate routine we allow people to pre-compile heavily used
// strings, thus avoiding one of the more expensive parts of the search.
define method compile-substring(pattern :: <byte-string>) => (compiled);
  let sz = size(pattern);
  if (sz < 3)
    #();
  else
    let result = make(<vector>, size: 256, fill: sz);
    for (index from 0 below sz - 1, skip from sz - 1 by -1)
      result[as(<integer>, pattern[index])] := skip;
    end for;
    result;
  end if;
end method;

// Replaces all (or up to count:) occurrences of pattern in big with goal.
// Accepts the "compiled:" keyword as described above.  Returns a new string
// or the unmodified original.
define method
    replace-substring(big :: <byte-string>, pattern :: <byte-string>,
                      goal :: <byte-string>,
                      #key count: max = size(big),
                           compiled) => (result :: <string>);
  let compiled = compiled | compile-substring(pattern);
  let index = substring-position(big, pattern, compiled: compiled);
  if (index)
    let sz = size(pattern);
    let pieces = #();
    for (start-index = 0 then index + sz,
         index = index
           then substring-position(big, pattern, start: index + sz,
                                   compiled: compiled),
         count :: <integer> from 1 to max,
         while index)
      pieces := pair(goal,
                     pair(subsequence(big, start: start-index, end: index),
                          pieces));
    finally
      apply(concatenate-as, <byte-string>,
            reverse!(pair(subsequence(big, start: start-index), pieces)))
    end for;
  else
    big;
  end if;
end method replace-substring;