;;;; -*- mode: lisp -*-
;;; Explore the performance of 'naive' ratio addition.
;;; Evaluate (time-addition 17000)
;;; to compare that to 'native' addition. (See notes below.)
#|
'Naive' ratio addition is done with:
(1) integer numerator and denominator values of unlimited magnitude as
provided by the implementation;
(2) the well-known simple (elementary school) procedure (see
`naive-add' below).
'Native' addition uses `common-lisp:+' on `common-lisp:rational'
values.
The latter is much faster. Of course, it may well use a smarter
procedure. Moreover, note that the naive procedure conses five extra
intermediate integer objects, which the native procedure may avoid.
In the following example the integer lengths (in bits)
of the numerator and the denominator of the sum
are about 24,000 each.
* (time-addition 17000)
SBCL 2.1.11.debian
Optimized: (SPEED (SAFETY 0)).
(ADD-MANY-NATIVELY 17000):
Evaluation took:
0.332 seconds of real time
0.329429 seconds of total run time (0.308463 user, 0.020966 system)
[ Run times consist of 0.001 seconds GC time, and 0.329 seconds non-GC time. ]
99.10% CPU
1,063,210,660 processor cycles
187,128,784 bytes consed
=========
(ADD-MANY-NAIVELY 17000):
Evaluation took:
14.125 seconds of real time
14.020188 seconds of total run time (14.011096 user, 0.009092 system)
[ Run times consist of 0.002 seconds GC time, and 14.019 seconds non-GC time. ]
99.26% CPU
45,101,779,501 processor cycles
430,218,720 bytes consed
=========
24510
24506
> (time-addition 17000)
CLISP 2.49.93+ (2018-02-18) (built on lcy02-amd64-055.buildd [127.0.1.1])
Optimized: (SPEED (SAFETY 0)).
(ADD-MANY-NATIVELY 17000):
Real time: 0.844972 sec.
Run time: 0.834785 sec.
Space: 130085000 Bytes
GC: 72, GC time: 0.39007 sec.
=========
(ADD-MANY-NAIVELY 17000):
Real time: 22.318913 sec.
Run time: 22.146378 sec.
Space: 152753752 Bytes
GC: 85, GC time: 0.485215 sec.
=========
24510 ;
24506
|#
(deftype naive-ratio ()
"A ratio of two integers as used with 'naive-add'."
'(cons integer integer))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *optimization-settings* '(speed (safety 0))
"The optimization settings to use at compile time."))
(defmacro defun-decl-opt (name parameters doc-string &body body)
"Define a function, inserting an `optimize' declaration."
(assert (stringp doc-string))
`(defun ,name ,parameters
,doc-string
(declare (optimize ,@*optimization-settings*))
,@body))
(declaim (ftype (function (naive-ratio naive-ratio) naive-ratio)
naive-add)
(inline naive-add))
(defun-decl-opt naive-add (x y)
"Return X + Y = a/b + c/d = (ad + bc)/bd as an irreducible fraction.
This is the 'naive' way to add two ratios. Take and return values of
type `naive-ratio', where a ratio N/D of two integers is represented
as (N . D)."
(declare (type naive-ratio x y))
(let ((a (car x))
(b (cdr x))
(c (car y))
(d (cdr y)))
(declare (integer a b c d))
(let* ((bd (* b d))
(n (+ (* a d) (* b c)))
(g (gcd bd n)))
(declare (dynamic-extent bd n g))
`(,(floor n g) . ,(floor bd g)))))
(defmacro define-adder-of-many (name type add reciprocal)
"Define function NAME that sums many TYPE values with ADD."
`(defun-decl-opt ,name (limit)
,(format nil "Compute 1/1 + 1/2 + ... + 1/LIMIT using `~S'."
add)
(declare (fixnum limit))
(loop for d from 2 to limit
for sum = (the ,type (,reciprocal 1))
then (the ,type (,add sum (,reciprocal d)))
finally (return sum))))
(define-adder-of-many add-many-natively
rational + /)
(define-adder-of-many add-many-naively
naive-ratio naive-add (lambda (x) `(1 . ,x)))
(defun report-addition-time (adder limit)
"Do addition with ADDER and print time, etc."
(prog2
(format *trace-output* "(~S ~S):~%" adder limit)
(time (funcall adder limit))
(format *trace-output* "=========~%")))
(defun time-addition (limit)
"Run the two kinds of addition, measuring time."
(format t "~A ~A~%" (lisp-implementation-type) (lisp-implementation-version))
(macrolet ((optimization-settings () `',*optimization-settings*))
(format t "Optimized: ~S.~%~%" (optimization-settings)))
(let ((s0 (report-addition-time 'add-many-natively limit))
(s1 (report-addition-time 'add-many-naively limit)))
(assert (= s0 (/ (car s1) (cdr s1))))
(values (integer-length (car s1))
(integer-length (cdr s1)))))
