fork download 
  1. ;; -*- mode:lisp;coding:us-ascii -*-
  2.  
  3. (defpackage "COM.INFORMATIMAGO.BENCHMARK.CONCATENATE-STRINGS"
  4.   (:use "COMMON-LISP")
  5.   (:export "BENCHMARK-CONCATENATE-STRINGS"))
  6. (in-package "COM.INFORMATIMAGO.BENCHMARK.CONCATENATE-STRINGS")
  7.  
  8. (defparameter *internal-time-unit*
  9.   (coerce (/ internal-time-units-per-second) 'double-float)
  10.   "The internal time slice, in seconds, as a DOUBLE-FLOAT.")
  11.  
  12. (defun get-run-time ()
  13.   "
  14. RETURN: The run-time (in seconds).
  15.         Run-time is not synchronized with real-time,
  16.         since the process is scheduled by the kernel.
  17. "
  18.   (* (get-internal-run-time) *internal-time-unit*))
  19.  
  20. (defun chrono-run-time* (thunk)
  21.   "
  22. Call the THUNK and return the run-time spent on it.
  23. The results of THUNK are ignored.
  24. "
  25.   (let ((start (get-run-time)))
  26.     (funcall thunk)
  27.     (- (get-run-time) start)))
  28.  
  29. (defmacro chrono-run-time (&body body)
  30.   `(chrono-run-time* (lambda () ,@body)))
  31.  
  32. (defun iota (count &optional (start 0) (step 1))
  33.   "
  34. RETURN:   A list containing the elements
  35.           (start start+step ... start+(count-1)*step)
  36.           The start and step parameters default to 0 and 1, respectively.
  37.           This procedure takes its name from the APL primitive.
  38. EXAMPLE:  (iota 5) => (0 1 2 3 4)
  39.           (iota 5 0 -0.1) => (0 -0.1 -0.2 -0.3 -0.4)
  40. "
  41.   (loop
  42.     :repeat count
  43.     :for item = start :then (+ item step)
  44.     :collect item))
  45.  
  46. (defgeneric group-by (sequence n)
  47.   (:documentation "Returns a list of subsequences of SEQUENCE of length N,
  48. whose concatenation is equal to SEQUENCE.")
  49.   (:method ((sequence vector) n)
  50.     (check-type n (integer 1))
  51.     (loop
  52.       :with length := (length sequence)
  53.       :for i :from 0 :by n
  54.       :while (< i length)
  55.       :collect (subseq sequence i (min length (+ i n)))))
  56.   (:method ((sequence list) n)
  57.     (check-type n (integer 1))
  58.     (loop
  59.       :for sub  := sequence :then rest
  60.       :for  rest := (nthcdr #+sbcl #| is idiotic! |#  (min (length sub) n)
  61.                             #-sbcl n
  62.                             sub)
  63.       :while sub
  64.       :collect (ldiff sub rest))))
  65.  
  66. (defun concatenate-strings (list-of-string-designators)
  67.   "
  68. LIST-OF-STRING-DESIGNATORS:
  69.                  EACH element may be either a string-designator or a list of characters,
  70.                  or a list containing a string-designator or a list of character,
  71.                  and a start and end position denoting a substring.
  72.  
  73. RETURN:          A string containing the concatenation of the strings
  74.                  of the LIST-OF-STRINGS.
  75. "
  76.   (flet ((slength (string)
  77.            (if (stringp string)
  78.                (length string)
  79.                (- (or (third string) (length (first string)))
  80.                   (second string)))))
  81.     (loop
  82.       :with strings = (mapcar
  83.                        (lambda (item)
  84.                          (etypecase item
  85.                            (null                         "")
  86.                            ((or string symbol character) (string item))
  87.                            (cons (if (every (function characterp) item)
  88.                                      (coerce item 'string)
  89.                                      (list (etypecase (first item)
  90.                                              (null                         "")
  91.                                              ((or string symbol character) (string (first item)))
  92.                                              (cons                         (coerce (first item) 'string)))
  93.                                            (second item)
  94.                                            (third item))))))
  95.                        list-of-string-designators)
  96.       :with result = (make-string (reduce (function +) strings :key (function slength)))
  97.       :for pos = 0
  98.         :then (+ pos (slength string))
  99.       :for string :in strings
  100.       :do (if (stringp string)
  101.               (replace result string :start1 pos)
  102.               (replace result (first string) :start1 pos
  103.                                              :start2 (second string) :end2 (third string)))
  104.       :finally (return result))))
  105.  
  106. (defun benchmark-concatenate-strings ()
  107.   (let ((headers 
  108.           '("#strings"
  109.             "concat-string"
  110.             "w/out-to-str"
  111.             "reduce-concat"
  112.             "apply-concat")))
  113.     (format t "~2%** ~{~A~^, ~}~2%" (list (lisp-implementation-type)
  114.                                           (lisp-implementation-version)
  115.                                           (machine-type)))
  116.     (format t "| ~{~A |~}~%" headers)
  117.     (format t "|-~%")
  118.     (format t "| ~{~*<r> |~}~%" headers)
  119.     (dolist (n '(100 1000 5000 10000 50000 100000))
  120.       (let* ((strings (map-into (make-list n)
  121.                                 (lambda (i) (format nil "+~R" i))
  122.                                 (iota n)))
  123.              (results '())
  124.              (times
  125.                (list
  126.                 (chrono-run-time (push (concatenate-strings strings) results))
  127.                 (chrono-run-time (push (with-output-to-string (out)
  128.                                          (dolist (string strings)
  129.                                            (write-string string out)))
  130.                                        results))
  131.                 (chrono-run-time (push (if (<= n 10000)
  132.                                            (reduce (lambda (a b)
  133.                                                      (concatenate 'string a b))
  134.                                                    strings :initial-value "")
  135.                                            ;; otherwise it's too slow.
  136.                                            nil)
  137.                                        results))
  138.                 (chrono-run-time (push (if #-sbcl t #+sbcl (<= n 50000)
  139.                                            (loop ; apply-concat
  140.                                                  :for groups := (group-by strings (1- call-arguments-limit))
  141.                                                    :then (group-by concats (1- call-arguments-limit))
  142.                                                  :for concats := (mapcar (lambda (strings)
  143.                                                                            (apply (function concatenate) 'string strings))
  144.                                                                          groups)
  145.                                                  :while (rest concats)
  146.                                                  :finally (return (first concats)))
  147.                                            ;; sbcl cannot support that
  148.                                            ;; many arguments on the
  149.                                            ;; control stack, which is
  150.                                            ;; idiotic, since it has a
  151.                                            ;; call-arguments-limit =
  152.                                            ;; 4611686018427387903
  153.                                            nil)
  154.                                        results)))))
  155.  
  156.         (setf results (nreverse results))
  157.         (format t "| ~8D | ~:{~:[N/A~;~12,6F~] |~}~%"
  158.                 n (mapcar (function list) results times))
  159.         (loop
  160.           :with f  :=       (first results)
  161.           :with fn := (first (rest headers))
  162.           :for s   :in       (rest results)
  163.           :for n   :in (rest (rest headers))
  164.           :do (assert (or (null s) (string= f s))
  165.                       (f s)
  166.                       "Different results between ~A and ~A"
  167.                       fn n))))))
  168.  
  169.  
  170.  
  171. (benchmark-concatenate-strings)
  172.  
  173.  
  174. #|
  175.  
  176. clall '(load (compile-file "/Users/pjb/src/lisp/encours/benchmark-string-concatenate.lisp"))'
  177.  
  178. * Benchmark string concatenation
  179.  
  180. ** "Armed Bear Common Lisp", "1.8.0", "X86_64"
  181.  
  182. | #strings | concat-string | w/out-to-str | reduce-concat | apply-concat |
  183. |----------+---------------+--------------+---------------+--------------|
  184. |      <r> |           <r> |          <r> |           <r> |          <r> |
  185. |      100 |      0.009000 |     0.000000 |      0.002000 |      0.00100 |
  186. |     1000 |      0.011000 |      0.00100 |      0.097000 |      0.00100 |
  187. |     5000 |      0.046000 |     0.005000 |      1.986000 |     0.004000 |
  188. |    10000 |      0.075000 |     0.007000 |      7.264000 |     0.007000 |
  189. |    50000 |      0.401000 |     0.033000 |           N/A |     0.043000 |
  190. |   100000 |      0.822000 |     0.066000 |           N/A |     0.109000 |
  191.  
  192. ==> with-output-to-string faster overall.
  193.  
  194. ** "Clozure Common Lisp", "Version 1.12 (v1.12-39-g6c1a9458) DarwinX8664", "x86_64"
  195.  
  196. | #strings | concat-string | w/out-to-str | reduce-concat | apply-concat |
  197. |----------+---------------+--------------+---------------+--------------|
  198. |      <r> |           <r> |          <r> |           <r> |          <r> |
  199. |      100 |      0.000024 |     0.000010 |      0.000060 |     0.000051 |
  200. |     1000 |      0.000291 |     0.000254 |      0.018234 |     0.000258 |
  201. |     5000 |      0.001795 |     0.001753 |      0.307806 |     0.001815 |
  202. |    10000 |      0.003970 |     0.004644 |      1.184964 |     0.003426 |
  203. |    50000 |      0.022194 |     0.034771 |           N/A |     0.024760 |
  204. |   100000 |      0.062293 |     0.071735 |           N/A |     0.105054 |
  205.  
  206. CONCATENATE-STRING is faster when you have more than between 50000 and 100000 strings to concatenate.
  207. WITH-OUTPUT-STRING is faster when you have about 100 strings.
  208. APPLY-CONCAT is faster when you have about 1000 strings.
  209. (In ccl, call-arguments-limit is 65536).
  210.  
  211. ** ECL, 21.2.1, x86_64
  212.  
  213. | #strings | concat-string | w/out-to-str | reduce-concat | apply-concat |
  214. |----------+---------------+--------------+---------------+--------------|
  215. |      <r> |           <r> |          <r> |           <r> |          <r> |
  216. |      100 |      0.001000 |     0.000000 |      0.001000 |     0.000000 |
  217. |     1000 |      0.000000 |     0.001000 |      0.391000 |     0.001000 |
  218. |     5000 |      0.003000 |     0.038000 |     14.063000 |     0.007000 |
  219. |    10000 |      0.006000 |     0.005000 |     59.637000 |     0.013000 |
  220. |    50000 |      0.029000 |     0.088000 |           N/A |     0.072000 |
  221. |   100000 |      0.059000 |     0.133000 |           N/A |     0.305000 |
  222.  
  223. CONCATENATE-STRING is faster when you have more than about 50000 strings to concatenate.
  224. APPLY-CONCAT is faster between about 5000 and 10000 strings.
  225. Any function but REDUCE-CONCAT but is as fast when you have less than about 1000 strings.
  226.  
  227. ** SBCL, 2.1.3, X86-64
  228.  
  229. | #strings | concat-string | w/out-to-str | reduce-concat | apply-concat |
  230. |----------+---------------+--------------+---------------+--------------|
  231. |      <r> |           <r> |          <r> |           <r> |          <r> |
  232. |      100 |      0.000018 |     0.000005 |      0.000027 |     0.000017 |
  233. |     1000 |      0.000198 |     0.000055 |      0.035400 |     0.000095 |
  234. |     5000 |      0.001590 |     0.000875 |      0.370234 |     0.000288 |
  235. |    10000 |      0.003036 |     0.001767 |      1.534191 |     0.001092 |
  236. |    50000 |      0.017485 |     0.006019 |           N/A |     0.009070 |
  237. |   100000 |      0.053100 |     0.032041 |           N/A |          N/A |
  238.  
  239. SBCL is a liar, and cannot do call-arguments-limit parameters, far
  240. from it!  So apply-concat is limited to less than about 50000
  241. arguments.
  242.  
  243. WITH-OUTPUT-TO-STRING is fastest above about 50000 strings.
  244. APPLY-CONCAT is fastest between about 5000 and 50000 strings.
  245. WITH-OUTPUT-TO-STRING is fastest below 5000 strings.
  246.  
  247. |#
  248.  
  249.  
Runtime error #stdin #stdout #stderr 0.67s 48540KB
comments (?)
stdin 
Standard input is empty
stdout 

** SBCL, 1.4.16.debian, X86-64

| #strings |concat-string |w/out-to-str |reduce-concat |apply-concat |
|-
| <r> |<r> |<r> |<r> |<r> |
|      100 |     0.000000 |    0.000000 |    0.000000 |    0.004000 |
|     1000 |     0.000000 |    0.000000 |    0.015000 |    0.000000 |
|     5000 |     0.002000 |    0.001000 |    0.619000 |    0.000000 |
stderr 
Heap exhausted during allocation: 1179648 bytes available, 1382048 requested.
Gen  Boxed Unboxed   LgBox LgUnbox  Pin       Alloc     Waste        Trig      WP GCs Mem-age
 0       1       0       0       0    0           0     32768      503316       1   0  0.0000
 1      24      29       0     182  151     7281248    419232      503316     235   0  0.6515
 2       2       0       0      82   84     2612608    139904     1802004      84   1  0.4971
 3       1       0       0      40   41     1252464     91024      503316      41   0  0.0000
 4      25      13       0      94   68     4067328    258048     4570644     132   1  0.0000
 5       0       0       0       0    0           0         0     2000000       0   0  0.0000
 6     501     258      64      47    0    27637552    870608     2000000     870   0  0.0000
 7       0       0       0       0    0           0         0     2000000       0   0  0.0000
           Total bytes allocated    =      42851200
           Dynamic-space-size bytes =      50331648
GC control variables:
   *GC-INHIBIT* = false
   *GC-PENDING* = false
   *STOP-FOR-GC-PENDING* = false
Unhandled SB-KERNEL::HEAP-EXHAUSTED-ERROR in thread #<SB-THREAD:THREAD "main thread" RUNNING
                                                       {10005D05B3}>:
  Heap exhausted (no more space for allocation).
1179648 bytes available, 1382048 requested.

PROCEED WITH CAUTION.

Backtrace for: #<SB-THREAD:THREAD "main thread" RUNNING {10005D05B3}>
0: (SB-DEBUG::DEBUGGER-DISABLED-HOOK #<SB-KERNEL::HEAP-EXHAUSTED-ERROR {10000029E3}> #<unused argument> :QUIT T)
1: (SB-DEBUG::RUN-HOOK SB-EXT:*INVOKE-DEBUGGER-HOOK* #<SB-KERNEL::HEAP-EXHAUSTED-ERROR {10000029E3}>)
2: (INVOKE-DEBUGGER #<SB-KERNEL::HEAP-EXHAUSTED-ERROR {10000029E3}>)
3: (ERROR #<SB-KERNEL::HEAP-EXHAUSTED-ERROR {10000029E3}>)
4: (SB-KERNEL::HEAP-EXHAUSTED-ERROR 589824 691024)
5: ("foreign function: call_into_lisp")
6: ("foreign function: funcall2")
7: ("foreign function: gc_heap_exhausted_error_or_lose")
8: ("foreign function: gc_find_freeish_pages")
9: ("foreign function: gc_alloc_large")
10: ("foreign function: alloc")
11: (SB-VM::ALLOC-TRAMP)
12: (GET-OUTPUT-STREAM-STRING #<SB-IMPL::STRING-OUTPUT-STREAM {1001D50E63}>)
13: ((LAMBDA NIL :IN BENCHMARK-CONCATENATE-STRINGS))
14: (CHRONO-RUN-TIME* #<CLOSURE (LAMBDA NIL :IN BENCHMARK-CONCATENATE-STRINGS) {1001D50D1B}>)
15: (BENCHMARK-CONCATENATE-STRINGS)
16: (SB-FASL::LOAD-FASL-GROUP #S(SB-FASL::FASL-INPUT :STREAM #<SB-SYS:FD-STREAM for "file /home/jMMvaO/prog.fasl" {1001B74D23}> :TABLE #(530 #<PACKAGE "SB-IMPL"> SB-IMPL::%DEFPACKAGE #1="COM.INFORMATIMAGO.BENCHMARK.CONCATENATE-STRINGS" #2="COMMON-LISP" (#2#) #3="BENCHMARK-CONCATENATE-STRINGS" (#3#) (#1#) #4="/home/okBJ5K/prog.lisp" #<SB-KERNEL:LAYOUT for SB-C:DEFINITION-SOURCE-LOCATION {50300883}> #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING #4# :INDICES 32769) ...) :STACK #(0 BENCHMARK-CONCATENATE-STRINGS BENCHMARK-CONCATENATE-STRINGS #<FUNCTION BENCHMARK-CONCATENATE-STRINGS> BENCHMARK-CONCATENATE-STRINGS NIL (SB-INT:SFUNCTION NIL NULL) (NIL NIL #5=#(#(9 7 169 6 149 214 1 149 222 1 148 216 ...) CALL-ARGUMENTS-LIMIT ASSERT CHRONO-RUN-TIME WITH-OUTPUT-TO-STRING CONCATENATE-STRINGS SB-IMPL::ASSERT-PROMPT SB-KERNEL:ASSERT-ERROR STRING= CHRONO-RUN-TIME* MAKE-LIST IOTA ...)) NIL #5# CALL-ARGUMENTS-LIMIT ASSERT ...) :NAME-BUFFER #("" "MAKE-STRING-OUTPUT-STREAMPNGSCTION") :DEPRECATED-STUFF NIL :SKIP-UNTIL NIL) NIL)
17: (SB-FASL::LOAD-AS-FASL #<SB-SYS:FD-STREAM for "file /home/jMMvaO/prog.fasl" {1001B74D23}> NIL NIL)
18: ((FLET SB-FASL::THUNK :IN LOAD))
19: (SB-FASL::CALL-WITH-LOAD-BINDINGS #<CLOSURE (FLET SB-FASL::THUNK :IN LOAD) {155554C5F62B}> #<SB-SYS:FD-STREAM for "file /home/jMMvaO/prog.fasl" {1001B74D23}>)
20: ((FLET SB-FASL::LOAD-STREAM :IN LOAD) #<SB-SYS:FD-STREAM for "file /home/jMMvaO/prog.fasl" {1001B74D23}> T)
21: (LOAD "prog.fasl" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST T :EXTERNAL-FORMAT :DEFAULT)
22: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
23: (SB-INT:SIMPLE-EVAL-IN-LEXENV (WITH-COMPILATION-UNIT NIL (LOAD "prog.fasl")) #<NULL-LEXENV>)
24: (EVAL (WITH-COMPILATION-UNIT NIL (LOAD "prog.fasl")))
25: (SB-IMPL::PROCESS-EVAL/LOAD-OPTIONS ((:EVAL . "(with-compilation-unit () (load \"prog.fasl\"))") (:EVAL . "(quit)")))
26: (SB-IMPL::TOPLEVEL-INIT)
27: ((FLET SB-UNIX::BODY :IN SB-EXT:SAVE-LISP-AND-DIE))
28: ((FLET "WITHOUT-INTERRUPTS-BODY-14" :IN SB-EXT:SAVE-LISP-AND-DIE))
29: ((LABELS SB-IMPL::RESTART-LISP :IN SB-EXT:SAVE-LISP-AND-DIE))

unhandled condition in --disable-debugger mode, quitting
; 
; compilation unit aborted
;   caught 1 fatal ERROR condition
https://ideone.com/qpO1I7
Benchmark of various way to concatenate strings.
language:
Common Lisp (sbcl 1.4.16)
created:
3 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!