Improve speed of string manipulations - performance

Question

This is a follow-up question, sort of, to this one: Write an efficient string replacement function? .
In (albeit distant) future I hope to get to do natural language processing. Of course speed of strings manipulation is important because of that. Accidentally, I've stumbled over this test: http://raid6.com.au/~onlyjob/posts/arena/ - all tests are biased, this is no exception. However, it raised important question for me. And so I wrote a few tests to see how am I doing:
This was my first attempt (I'll call it #A):
#A
(defun test ()
(declare (optimize (debug 0) (safety 0) (speed 3)))
(loop with addidtion = (concatenate 'string "abcdefgh" "efghefgh")
and initial = (get-internal-real-time)
for i from 0 below (+ (* (/ 1024 (length addidtion)) 1024 4) 1000)
for ln = (* (length addidtion) i)
for accumulated = addidtion
then (loop with concatenated = (concatenate 'string accumulated addidtion)
for start = (search "efgh" concatenated)
while start do (replace concatenated "____" :start1 start)
finally (return concatenated))
when (zerop (mod ln (* 1024 256))) do
(format t "~&~f s | ~d Kb" (/ (- (get-internal-real-time) initial) 1000) (/ ln 1024)))
(values))
(test)
Baffled with the results, I tried to use cl-ppcre - I don't know what I was hoping for, but the results came out as really bad... Here's the code I used for testing:
#B
(ql:quickload "cl-ppcre")
(defun test ()
(declare (optimize (debug 0) (safety 0) (speed 3)))
(loop with addidtion = (concatenate 'string "abcdefgh" "efghefgh")
and initial = (get-internal-real-time)
for i from 0 below (+ (* (/ 1024 (length addidtion)) 1024 4) 1000)
for ln = (* (length addidtion) i)
for accumulated = addidtion
then (cl-ppcre:regex-replace-all "efgh" (concatenate 'string accumulated addidtion) "____")
when (zerop (mod ln (* 1024 256))) do
(format t "~&~f s | ~d Kb" (/ (- (get-internal-real-time) initial) 1000) (/ ln 1024)))
(values))
(test)
Well, then, in hopes to maybe side-step some generalizations, I decided to write my own, albeit somewhat naive version:
#C
(defun replace-all (input match replacement)
(declare (type string input match replacement)
(optimize (debug 0) (safety 0) (speed 3)))
(loop with pattern fixnum = (1- (length match))
with i fixnum = pattern
with j fixnum = i
with len fixnum = (length input) do
(cond
((>= i len) (return input))
((zerop j)
(loop do
(setf (aref input i) (aref replacement j) i (1+ i))
(if (= j pattern)
(progn (incf i pattern) (return))
(incf j))))
((char= (aref input i) (aref match j))
(decf i) (decf j))
(t (setf i (+ i 1 (- pattern j)) j pattern)))))
(defun test ()
(declare (optimize (debug 0) (safety 0) (speed 3)))
(loop with addidtion string = (concatenate 'string "abcdefgh" "efghefgh")
and initial = (get-internal-real-time)
for i fixnum from 0 below (+ (* (/ 1024 (length addidtion)) 1024 4) 1000)
for ln fixnum = (* (length addidtion) i)
for accumulated string = addidtion
then (replace-all (concatenate 'string accumulated addidtion) "efgh" "____")
when (zerop (mod ln (* 1024 256))) do
(format t "~&~f s | ~d Kb" (/ (- (get-internal-real-time) initial) 1000) (/ ln 1024)))
(values))
(test)
Almost as slow as cl-ppcre! Now, that's incredible! There isn't anything I can spot here such that would result in such poor performance... And still it does suck :(
Realizing that the standard functions performed the best so far, I looked into SBCL source and after some reading I came up with this:
#D
(defun replace-all (input match replacement &key (start 0))
(declare (type simple-string input match replacement)
(type fixnum start)
(optimize (debug 0) (safety 0) (speed 3)))
(loop with input-length fixnum = (length input)
and match-length fixnum = (length match)
for i fixnum from 0 below (ceiling (the fixnum (- input-length start)) match-length) do
(loop with prefix fixnum = (+ start (the fixnum (* i match-length)))
for j fixnum from 0 below match-length do
(when (<= (the fixnum (+ prefix j match-length)) input-length)
(loop for k fixnum from (+ prefix j) below (the fixnum (+ prefix j match-length))
for n fixnum from 0 do
(unless (char= (aref input k) (aref match n)) (return))
finally
(loop for m fixnum from (- k match-length) below k
for o fixnum from 0 do
(setf (aref input m) (aref replacement o))
finally
(return-from replace-all
(replace-all input match replacement :start k))))))
finally (return input)))
(defun test ()
(declare (optimize (debug 0) (safety 0) (speed 3)))
(loop with addidtion string = (concatenate 'string "abcdefgh" "efghefgh")
and initial = (get-internal-real-time)
for i fixnum from 0 below (+ (* (/ 1024 (length addidtion)) 1024 4) 1000)
for ln fixnum = (* (length addidtion) i)
for accumulated string = addidtion
then (replace-all (concatenate 'string accumulated addidtion) "efgh" "____")
when (zerop (mod ln (* 1024 256))) do
(format t "~&~f s | ~d Kb" (/ (- (get-internal-real-time) initial) 1000) (/ ln 1024)))
(values))
(test)
Finally, I can win, although a tiny fraction of performance against the standard library - yet it is still very-very bad compared to almost everything else...
Here's the table with the results:
| SBCL #A | SBCL #B | SBCL #C | SBCL #D | C gcc 4 -O3 | String size |
|-----------+-----------+------------+-----------+-------------+-------------|
| 17.463 s | 166.254 s | 28.924 s | 16.46 s | 1 s | 256 Kb |
| 68.484 s | 674.629 s | 116.55 s | 63.318 s | 4 s | 512 Kb |
| 153.99 s | gave up | 264.927 s | 141.04 s | 10 s | 768 Kb |
| 275.204 s | . . . . . | 474.151 s | 251.315 s | 17 s | 1024 Kb |
| 431.768 s | . . . . . | 745.737 s | 391.534 s | 27 s | 1280 Kb |
| 624.559 s | . . . . . | 1079.903 s | 567.827 s | 38 s | 1536 Kb |
Now, the question: What did I do wrong? Is this something inherent to Lisp strings? Can this probably be mitigated through... what?
In the long shot, I'd even consider writing a specialized library for string processing. If the problem isn't my bad code, but rather the implementation. Would it make sense to do so? If yes, what language would you suggest for doing it?
EDIT: Just for the record, I'm now trying to use this library: https://github.com/Ramarren/ropes to deal with strings concatenation. Unfortunately, it doesn't have a replace function in it and doing multiple replaces isn't very trivial. But I'll keep this post updated when I have something.
I've tried to slightly change huaiyuan's variant to use array's fill-pointers instead of string concatenation (to achieve something similar to StringBuilder suggested by Paulo Madeira. It probably can be optimized further, but I'm not sure about the types / which will method be faster / will it be worth to redefine types for * and + to get them to only operate on fixnum or signed-byte. Anyway, here's the code and the benchmark:
(defun test/e ()
(declare (optimize speed))
(labels ((min-power-of-two (num)
(declare (type fixnum num))
(decf num)
(1+
(progn
(loop for i fixnum = 1 then (the (unsigned-byte 32) (ash i 1))
while (< i 17) do
(setf num
(logior
(the fixnum
(ash num (the (signed-byte 32)
(+ 1 (the (signed-byte 32)
(lognot i)))))) num))) num)))
(join (x y)
(let ((capacity (array-dimension x 0))
(desired-length (+ (length x) (length y)))
(x-copy x))
(declare (type fixnum capacity desired-length)
(type (vector character) x y x-copy))
(when (< capacity desired-length)
(setf x (make-array
(min-power-of-two desired-length)
:element-type 'character
:fill-pointer desired-length))
(replace x x-copy))
(replace x y :start1 (length x))
(setf (fill-pointer x) desired-length) x))
(seek (old str pos)
(let ((q (position (aref old 0) str :start pos)))
(and q (search old str :start2 q))))
(subs (str old new)
(loop for p = (seek old str 0) then (seek old str p)
while p do (replace str new :start1 p))
str))
(declare (inline min-power-of-two join seek subs)
(ftype (function (fixnum) fixnum) min-power-of-two))
(let* ((builder
(make-array 16 :element-type 'character
:initial-contents "abcdefghefghefgh"
:fill-pointer 16))
(ini (get-internal-real-time)))
(declare (type (vector character) builder))
(loop for i fixnum below (+ 1000 (* 4 1024 1024 (/ (length builder))))
for j = builder then
(subs (join j builder) "efgh" "____")
for k fixnum = (* (length builder) i)
when (= 0 (mod k (* 1024 256)))
do (format t "~&~8,2F sec ~8D kB"
(/ (- (get-internal-real-time) ini) 1000)
(/ k 1024))))))
1.68 sec 256 kB
6.63 sec 512 kB
14.84 sec 768 kB
26.35 sec 1024 kB
41.01 sec 1280 kB
59.55 sec 1536 kB
82.85 sec 1792 kB
110.03 sec 2048 kB

Answer 1

The bottle-neck is the search function, which is perhaps not optimized in SBCL. The following version uses position to help it skip over impossible region and is about 10 times as fast as your version #A on my machine:
(defun test/e ()
(declare (optimize speed))
(labels ((join (x y)
(concatenate 'simple-base-string x y))
(seek (old str pos)
(let ((q (position (char old 0) str :start pos)))
(and q (search old str :start2 q))))
(subs (str old new)
(loop for p = (seek old str 0) then (seek old str p)
while p do (replace str new :start1 p))
str))
(declare (inline join seek subs))
(let* ((str (join "abcdefgh" "efghefgh"))
(ini (get-internal-real-time)))
(loop for i below (+ 1000 (* 4 1024 1024 (/ (length str))))
for j = str then (subs (join j str) "efgh" "____")
for k = (* (length str) i)
when (= 0 (mod k (* 1024 256)))
do (format t "~&~8,2F sec ~8D kB"
(/ (- (get-internal-real-time) ini) 1000)
(/ k 1024))))))

Answer 2

The tests in that page are indeed biased, so let's see by how much. The author claims to test string manipulation, but here's what the programs in that page test:
String concatenation
Memory management, either explicit (C) or implicit
In some languages, regular expressions
In others, string search algorithms and substring replacement
Memory access, which has bounds checks on several languages
There are way too many aspects just here. Here's how it's being measured:
Real time in seconds
This is unfortunate, since the computer had to be completely dedicated to running just this test for reasonable values, without any other processes whatsoever, such as services, antiviruses, browsers, even a waiting *nix shell. CPU time would be much more useful, you could even run the tests in a virtual machine.
Another aspect is that characters in C, C++, Perl, Python, PHP and Ruby are 8-bit, but they're 16-bit in many of the other tested languages. This means that memory usage is stressed in very different amounts, by at least a factor of 2. Here, cache misses are much more noticeable.
I suspect the reason Perl is so fast is that it checks its arguments once before invoking a C function, instead of constantly checking bounds. Other languages with 8-bit strings are not so fast, but are still reasonably fast.
JavaScript V8 has strings that are ASCII if possible, so if the appended and replaced token was "ëfgh", you'd pay a lot more in that implementation.
Python 3 is almost three times slower than Python 2, and my guess is it's due to the wchar_t * vs char * internal representation of strings.
JavaScript SpiderMonkey uses 16-bit strings. I didn't dig the sourced much, but the file jsstr.h mentions ropes.
Java is so slow because Strings are immutable, and so for this benchmark, it's definitely not the appropriate data type. You're paying the price of generating a huge string after each .replace(). I haven't tested, but probably a StringBuffer would be much faster.
So, this benchmark is to be taken not only with a grain of salt, but with a handful of it.
In Common Lisp, bounds checking and type dispatching in aref and its setf are probably the bottlenecks.
For good performance, you would have to ditch generic string sequences and use simple-strings or simple-vectors, whichever your implementation optimizes best. Then, you should have a way of making calls to schar or svref and their setfable forms that bypass bounds checking. From here, you can implement your own simple-string-search or simple-character-vector-search (and replace-simple-string or replace-simple-vector, although they play a much smaller role in this particular example) with full speed optimization and type declarations, with bounds checking at the head of each call instead of at each array access.
A sufficiently smart compiler™ would do all of this for you given "proper" declarations. The problem is, you'd have to use (concatenate 'simple-string/simple-vector ...), because neither simple strings nor simple vectors are adjustable.
With a compacting/moving GC, there's always a penalty in these cases (e.g. array/object copying), and choosing between array adjustment and concatenation must really depend on profiling tests. Otherwise, adjustment can be way faster than concatenation, while there's enough free memory to grow the array.
You could use adjustable arrays, if the implementation would access the actual elements directly after a brief bounds checking at the head of optimized calls to/expansions of search and replace with adjustable arrays (e.g. by having internal definitions that take the actual displaced vector/array and start and end offsets).
But I'm speculating a lot here, you have to compile, inspect the compilation and profile in each implementation for real-world facts.
As a side note, the C example code is full of bugs, such as off-by-one (-1, actually) allocations (the strcat calls write an extra byte, the zero-terminated string terminator), an uninitialized zero-terminated string gstr (the first strcat works by luck, because the memory might not be initialized to 0), conversions from size_t and time_t to int and assumption of these types in a printf format string, an unused variable pos_c that is initialized with the first allocation for gstr which is incremented without taking into account that realloc may move the buffer, and no error handling whatsoever.