7

这是一个后续问题，有点像这个问题：写一个有效的字符串替换函数？.

在（尽管遥远的）未来，我希望能够进行自然语言处理。因此，字符串操作的速度当然很重要。偶然地，我偶然发现了这个测试：http ://raid6.com.au/~onlyjob/posts/arena/ - 所有测试都有偏见，这也不例外。然而，它对我提出了重要的问题。所以我写了一些测试来看看我做得怎么样：

这是我的第一次尝试（我称之为#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)

对结果感到困惑，我尝试使用cl-ppcre- 我不知道我希望什么，但结果非常糟糕......这是我用于测试的代码：

#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)

那么，为了避免一些概括，我决定写自己的，虽然有点幼稚的版本：

＃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)

几乎一样慢cl-ppcre！现在，这太不可思议了！我在这里找不到任何会导致性能如此糟糕的东西......而且它仍然很糟糕:(

意识到标准功能迄今为止表现最好，我查看了 SBCL 源代码，经过阅读后我想出了这个：

#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)

最后，我能赢，虽然与标准库相比只有一小部分性能——但与几乎所有其他东西相比，它仍然非常非常糟糕......

这是结果表：

| 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     |

现在，问题是：我做错了什么？这是 Lisp 字符串固有的东西吗？这可能会通过……什么来缓解？

从长远来看，我什至会考虑编写一个专门的字符串处理库。如果问题不是我的错误代码，而是实现。这样做有意义吗？如果是，你会建议用什么语言来做？

编辑：为了记录，我现在正在尝试使用这个库：https ://github.com/Ramarren/ropes来处理字符串连接。不幸的是，它没有替换功能，并且进行多次替换并不是很简单。但是当我有东西时，我会更新这篇文章。

我尝试稍微改变 huaiyuan 的变体以使用数组的填充指针而不是字符串连接（以实现类似于StringBuilderPaulo Madeira 建议的东西。它可能可以进一步优化，但我不确定类型 / 哪个方法更快/是否值得重新定义类型*并+让它们仅在fixnumor上操作signed-byte。无论如何，这是代码和基准：

(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
4

2 回答 2

5

瓶颈是search函数，它可能在 SBCL 中没有优化。以下版本用于position帮助它跳过不可能的区域，并且速度大约是我机器上的版本#A 的 10 倍：

(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))))))
于 2013-07-14T17:10:21.467 回答
2

该页面中的测试确实有偏见，所以让我们看看有多少。作者声称要测试字符串操作，但这是该页面中的程序测试的内容：

  • 字符串连接
  • 内存管理，显式 (C) 或隐式
  • 在某些语言中，正则表达式
  • 在其他方面，字符串搜索算法和子字符串替换
    • 内存访问，对多种语言进行边界检查

这里有太多的方面。以下是它的测量方式：

  • 以秒为单位的实时

这是不幸的，因为计算机必须完全专注于运行这个测试以获得合理的值，而不需要任何其他进程，例如服务、防病毒、浏览器，甚至是等待的 *nix shell。CPU 时间会更有用，您甚至可以在虚拟机中运行测试。

另一方面是 C、C++、Perl、Python、PHP 和 Ruby 中的字符是 8 位的，但在许多其他经过测试的语言中它们是 16 位的。这意味着内存使用量的压力非常不同，至少是 2 倍。在这里，缓存未命中更加明显。

我怀疑 Perl 如此之快的原因是它在调用 C 函数之前检查其参数一次，而不是不断检查边界。其他具有 8 位字符串的语言没有那么快，但仍然相当快。

如果可能的话，JavaScript V8 具有 ASCII 字符串，因此如果附加和替换的标记是“ëfgh”，那么您将在该实现中付出更多。

Python 3 几乎比 Python 2 慢三倍，我猜这是由于字符串的wchar_t *vschar *内部表示。

JavaScript SpiderMonkey 使用 16 位字符串。我没有深入挖掘来源，但文件 jsstr.h 提到了绳索。

Java 之所以这么慢，是因为Strings 是不可变的，因此对于这个基准测试，它绝对不是合适的数据类型。你付出了在每个.replace(). 我没有测试过，但可能StringBuffer会更快。

所以，这个基准不仅要带着一粒盐，而且要少一点。

在 Common Lisp 中，边界检查和类型分派aref可能setf是瓶颈。

为了获得良好的性能，您将不得不放弃通用string序列并使用simple-strings 或simple-vectors，无论您的实现优化得如何。然后，您应该有一种方法来调用scharorsvref及其setf能够绕过边界检查的表单。从这里，您可以使用全速优化和类型声明来实现自己的simple-string-searchor simple-character-vector-search（和replace-simple-stringor ，尽管它们在这个特定示例中扮演的角色要小得多），在每次调用的开头而不是在每次数组访问时进行边界检查。replace-simple-vector

一个足够聪明的编译器™ 会为你做所有这些给你“正确”的声明。问题是，您必须使用(concatenate 'simple-string/simple-vector ...)，因为简单的字符串和简单的向量都不能调整。

使用压缩/移动 GC，在这些情况下（例如数组/对象复制）总是会受到惩罚，并且在数组调整和连接之间进行选择必须真正取决于分析测试。否则，调整可能比串联快得多，同时有足够的可用内存来增长数组。

您可以使用可调数组，如果实现将在对可调数组的优化调用/扩展的头部进行简短的边界检查后直接访问实际元素search（replace例如，通过具有采用实际移位向量/数组并开始的内部定义）和结束偏移）。

但是我在这里推测了很多，您必须编译，检查每个实现中的编译和配置文件以了解真实世界的事实。

作为旁注，C 示例代码充满了错误，例如非一（实际上是-1）分配（strcat调用写入一个额外的字节，零终止字符串终止符），未初始化的零终止字符串gstr（第一个strcat很幸运，因为内存可能没有初始化为 0），格式字符串中这些类型的转换和size_t假设，一个未使用的变量，它在第一次分配时被初始化，在不考虑的情况下递增这可能会移动缓冲区，并且没有任何错误处理。time_tintprintfpos_cgstrrealloc

于 2013-07-18T19:11:16.147 回答