benchmark: Extract common bench code

code/benchmark/float-integer.lisp

@@ -20,75 +20,12 @@
 
 (defun float-integer (&key (base 10)
  (name (uiop:implementation-identifier)))
- (labels ((bench (clients limit key)
- (mapcar (lambda (properties
- &aux (client (apply #'make-instance
- (getf properties :initargs))))
- (cond ((member key (getf properties :types))
- ;; Do one conversion in case there is some initialization needed.
- (quaviver:float-integer client base (random limit))
- (list* key
- (the-cost-of-nothing:benchmark
- (quaviver:float-integer client
- base
- (* (1- (ash (random 2) 1))
- (random limit))))
- properties))
- (t
- properties)))
- clients))
- (plot (title results key)
- (write-string (cl-spark:vspark
- (mapcan (lambda (properties
- &aux (value (getf properties key)))
- (when value
- (list value)))
- results)
- :title title
- :min 0
- :size 132
- :labels (mapcan (lambda (client)
- (when (getf client key)
- (list (getf client :label))))
- results)))))
- (let ((results *float-integer-clients*)
- (table (ascii-table:make-table
- (list* "client"
- (loop for test in *float-integer-tests*
- for type = (getf test :type)
- collect (format nil "~21@a"
- (format nil "absolute ~(~a~)" type))
- collect (format nil "~21@a"
- (format nil "relative ~(~a~)" type)))))))
- (loop for test in *float-integer-tests*
- for type = (getf test :type)
- for limit = (getf test :limit)
- do (setf results (bench results limit type))
- (plot (format nil "float-integer ~(~a~)" type)
- results type)
- (terpri))
- (write-results name `(quaviver:float-integer ,base) results)
- (loop with mins = (loop for test in *float-integer-tests*
- for type = (getf test :type)
- collect type
- collect (loop for result in results
- for value = (getf result type)
- when value
- minimize value))
- for result in results
- do (ascii-table:add-row table (list* (getf result :label)
- (loop for test in *float-integer-tests*
- for type = (getf test :type)
- for value = (getf result type)
- when value
- collect (format nil "~21,15g"
- (getf result type))
- and collect (format nil "~21,15f"
- (/ (getf result type)
- (getf mins type)))
- else
- collect (make-string 21
- :initial-element #\space)
- and collect (make-string 21
- :initial-element #\space)))))
- (ascii-table:display table))))
+ (let ((results (bench (lambda (client &key type limit)
+ (quaviver:float-integer client
+ base
+ (* (1- (ash (random 2) 1))
+ (random limit))))
+ *float-integer-tests*
+ *float-integer-clients*)))
+ (write-results name `(quaviver:float-integer ,base) results)
+ (report/run-summary "float-integer" *float-integer-tests* results)))

code/benchmark/integer-float.lisp

@@ -18,7 +18,6 @@
 
 (defvar *schubfach-client* (make-instance 'quaviver/schubfach:client))
 
-
 (defun random-float (type)
  (multiple-value-list
  (quaviver:float-integer *schubfach-client* 10
@@ -28,74 +27,11 @@
 
 (defun integer-float (&key (base 10)
  (name (uiop:implementation-identifier)))
- (labels ((bench (clients limit key
- &aux (significand-limit (ash 1 (quaviver:significand-size key)))
- (exponent-limit (1- (ash 1 (byte-size (quaviver:exponent-bytespec key)))))
- (exponent-bias (quaviver:exponent-bias key)))
- (mapcar (lambda (properties
- &aux (client (apply #'make-instance
- (getf properties :initargs))))
- (cond ((member key (getf properties :types))
- ;; Do one conversion in case there is some initialization needed.
- (apply #'quaviver:integer-float client key base (random-float key)) (list* key
- (the-cost-of-nothing:benchmark
- (apply #'quaviver:integer-float client key base (random-float key)))
- properties))
- (t
- properties)))
- clients))
- (plot (title results key)
- (write-string (cl-spark:vspark
- (mapcan (lambda (properties
- &aux (value (getf properties key)))
- (when value
- (list value)))
- results)
- :title title
- :min 0
- :size 132
- :labels (mapcan (lambda (client)
- (when (getf client key)
- (list (getf client :label))))
- results)))))
- (let ((results *integer-float-clients*)
- (table (ascii-table:make-table
- (list* "client"
- (loop for test in *integer-float-tests*
- for type = (getf test :type)
- collect (format nil "~21@a"
- (format nil "absolute ~(~a~)" type))
- collect (format nil "~21@a"
- (format nil "relative ~(~a~)" type)))))))
- (loop for test in *integer-float-tests*
- for type = (getf test :type)
- for limit = (getf test :limit)
- do (setf results (bench results limit type))
- (plot (format nil "integer-float ~(~a~)" type)
- results type)
- (terpri))
- (write-results name `(quaviver:integer-float ,base) results)
- (loop with mins = (loop for test in *integer-float-tests*
- for type = (getf test :type)
- collect type
- collect (loop for result in results
- for value = (getf result type)
- when value
- minimize value))
- for result in results
- do (ascii-table:add-row table (list* (getf result :label)
- (loop for test in *integer-float-tests*
- for type = (getf test :type)
- for value = (getf result type)
- when value
- collect (format nil "~21,15g"
- (getf result type))
- and collect (format nil "~21,15f"
- (/ (getf result type)
- (getf mins type)))
- else
- collect (make-string 21
- :initial-element #\space)
- and collect (make-string 21
- :initial-element #\space)))))
- (ascii-table:display table))))
+ (let ((results (bench (lambda (client &key type)
+ (apply #'quaviver:integer-float
+ client type base
+ (random-float type)))
+ *integer-float-tests*
+ *integer-float-clients*)))
+ (write-results name `(quaviver:integer-float ,base) results)
+ (report/run-summary "integer-float" *integer-float-tests* results)))

code/benchmark/report.lisp

@@ -113,3 +113,58 @@
  nconc (mapcar #'car result))
  :test #'equalp)
  do (report/test test)))
+
+(defun report/plot-type (title results key)
+ (write-string (cl-spark:vspark
+ (mapcan (lambda (properties
+ &aux (value (getf properties key)))
+ (when value
+ (list value)))
+ results)
+ :title title
+ :min 0
+ :size 132
+ :labels (mapcan (lambda (client)
+ (when (getf client key)
+ (list (getf client :label))))
+ results))))
+
+(defun report/run-summary (title tests results)
+ (loop for test in tests
+ for type = (getf test :type)
+ do (report/plot-type (format nil "~a ~(~a~)" title type)
+ results type)
+ (terpri))
+ (let ((table (ascii-table:make-table
+ (list* "client"
+ (loop for test in *float-integer-tests*
+ for type = (getf test :type)
+ collect (format nil "~21@a"
+ (format nil "absolute ~(~a~)" type))
+ collect (format nil "~21@a"
+ (format nil "relative ~(~a~)" type)))))))
+ (loop with mins = (loop for test in tests
+ for type = (getf test :type)
+ collect type
+ collect (loop for result in results
+ for value = (getf result type)
+ when value
+ minimize value))
+ for result in results
+ do (ascii-table:add-row table
+ (list* (getf result :label)
+ (loop for test in tests
+ for type = (getf test :type)
+ for value = (getf result type)
+ when value
+ collect (format nil "~21,15g"
+ (getf result type))
+ and collect (format nil "~21,15f"
+ (/ (getf result type)
+ (getf mins type)))
+ else
+ collect (make-string 21
+ :initial-element #\space)
+ and collect (make-string 21
+ :initial-element #\space)))))
+ (ascii-table:display table)))

code/benchmark/results.lisp

@@ -20,3 +20,17 @@
  (with-standard-io-syntax
  (write current :stream stream))))
  (values))
+
+(defun bench (func tests clients)
+ (loop with results = (copy-tree clients)
+ for test in tests
+ for type = (getf test :type)
+ finally (return results)
+ do (loop for client in results
+ for client-instance = (apply #'make-instance
+ (getf client :initargs))
+ when (member type (getf client :types))
+ do (apply func client-instance test)
+ (setf (cdr (last client))
+ (list type
+ (the-cost-of-nothing:benchmark (apply func client-instance test)))))))