3 ;; A decimal number parser and formatting package for Common Lisp.
5 ;; Author: Teemu Likonen <tlikonen@iki.fi>
7 ;; License: Public domain
9 ;; This program is distributed in the hope that it will be useful, but
10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 (defpackage #:decimals
15 (:export #:round-half-away-from-zero
16 #:format-decimal-number
17 #:parse-decimal-number
19 #:define-decimal-formatter))
21 (in-package #:decimals)
24 (defun round-half-away-from-zero (number &optional (divisor 1))
26 "Divide _number_ by _divisor_ and round the result to the nearest integer.
27 If the result is half-way between two integers round away from zero. Two
28 values are returned: quotient and remainder.
30 This is similar to `cl:round` function except that `cl:round` rounds to
31 an even integer when number is exactly between two integers. Examples:
33 (round-half-away-from-zero 3/2) => 2, -1/2
34 (round 3/2) => 2, -1/2
36 (round-half-away-from-zero 5/2) => 3, -1/2
37 (round 5/2) => 2, 1/2"
41 (let ((quotient (if (plusp number)
42 (floor (+ (/ number divisor) 1/2))
43 (ceiling (- (/ number divisor) 1/2)))))
44 (values quotient (- number (* quotient divisor))))))
47 (defun divide-into-groups (string &key (separator #\Space) (from-end nil)
50 (assert (and (integerp group-digits)
53 "The GROUP-DIGITS argument must be a positive integer")
55 (setf separator (princ-to-string separator))
57 (if (zerop (length separator))
59 (flet ((make-groups (string separator)
60 (loop :with length := (length string)
61 :with result := (make-array length :element-type 'character
62 :fill-pointer 0 :adjustable t)
65 :do (vector-push-extend c result)
66 :if (and (zerop (rem i group-digits))
68 :do (loop :for c :across separator
69 :do (vector-push-extend c result))
70 :finally (return result))))
73 (nreverse (make-groups (reverse string) (reverse separator)))
74 (make-groups string separator)))))
77 (defun decimal-round-split (number &key
79 (rounder #'round-half-away-from-zero)
84 (assert (integerp round-magnitude) (round-magnitude)
85 "ROUND-MAGNITUDE argument must be an integer.")
88 (setf number (rational number)))
90 (let ((divisor (expt 10 round-magnitude)))
91 (setf number (* divisor (funcall rounder number divisor))))
93 (let ((sign (cond ((plusp number) (or positive-sign ""))
94 ((minusp number) (or negative-sign ""))
95 (t (or zero-sign "")))))
97 (multiple-value-bind (integer fractional)
98 (truncate (abs number))
99 (let ((fractional-string
100 (with-output-to-string (out)
101 (loop :with next := fractional
103 :repeat (abs round-magnitude)
106 (setf (values next remainder) (truncate (* next 10)))
108 (setf next remainder)))))
109 (list (princ-to-string sign)
110 (princ-to-string integer)
111 fractional-string)))))
114 (defun string-align (string width &key (side :left) (char #\Space))
115 (if (>= (length string) width)
117 (let ((result (make-string width :initial-element char)))
119 (:left (replace result string))
120 (:right (replace result string
121 :start1 (- width (length string))))))))
124 (defun format-decimal-number (number &key
126 (rounder #'round-half-away-from-zero)
127 (decimal-separator #\.)
128 (integer-group-separator nil)
129 (integer-group-digits 3)
130 (integer-minimum-width 0)
131 (integer-pad-char #\Space)
132 (fractional-group-separator nil)
133 (fractional-group-digits 3)
134 (fractional-minimum-width 0)
135 (fractional-pad-char #\Space)
136 (show-trailing-zeros nil)
141 "Apply specified decimal number formatting rules to _number_ and
142 return a formatted string.
144 The second return value is (almost) the same formatted string divided
145 into four strings. It's a list of four strings: sign, integer part,
146 decimal separator and fractional part. Formatting arguments
147 _integer-minimum-width_ and _fractional-minimum-width_ do not apply to
148 the second return value. Everything else does.
150 _Number_ must be of type `real`. This function uses `rational` types
151 internally. If the given _number_ is a `float` it is first turned into
152 `rational` by calling `cl:rational`.
154 Formatting rules are specified with keyword arguments, as described
155 below. The default value is in parentheses.
157 * `round-magnitude (0)`
159 This is the order of magnitude used for rounding. The value must be
160 an integer and it is interpreted as a power of 10.
162 * `show-trailing-zeros (nil)`
164 If the value is non-nil print all trailing zeros in fractional part.
167 (format-decimal-number 1/5 :round-magnitude -3
168 :show-trailing-zeros nil)
171 (format-decimal-number 1/5 :round-magnitude -3
172 :show-trailing-zeros t)
175 * `rounder (#'round-half-away-from-zero)`
177 The value must be a function (or a symbol naming a function). It is
178 used to round the number to the specified round magnitude. The
179 function must work like `cl:truncate`, `cl:floor`, `cl:ceiling` and
180 `cl:round`, that is, take two arguments, a number and a divisor, and
181 return the quotient as the first value.
183 This package introduces another rounding function,
184 `round-half-away-from-zero`, which is used by default. See its
185 documentation for more information.
187 * `decimal-separator (#\\.)`
189 If the value is non-nil the `princ` output of the value will be
190 added between integer and fractional parts. Probably the most useful
191 types are `character` and `string`.
193 * `integer-group-separator (nil)`
194 * `fractional-group-separator (nil)`
196 If the value is non-nil the digits in integer or fractional parts
197 are put in groups. The `princ` output of the value will be added
198 between digit groups.
200 * `integer-group-digits (3)`
201 * `fractional-group-digits (3)`
203 The value is a positive integer defining the number of digits in
206 * `integer-minimum-width (0)`
207 * `fractional-minimum-width (0)`
209 Format integer or fractional part using minimum of this amount of
210 characters, possibly using some padding characters (see below).
211 _positive-sign_, _negative-sign_ or _zero-sign_ (see below) is
212 included when calculating the width of the integer part. Similarly
213 _decimal-separator_ is included when calculating the width of the
216 * `integer-pad-char (#\\Space)`
217 * `fractional-pad-char (#\\Space)`
219 The value is the padding character which is used to fill
220 _integer-minimum-width_ or _fractional-minimum-width_.
222 * `positive-sign (nil)`
223 * `negative-sign (#\\-)`
226 If values are non-nil these are used as the leading sign for
227 positive, negative and zero numbers. The `princ` output of the value
230 (destructuring-bind (sign integer fractional)
231 (decimal-round-split number
232 :round-magnitude round-magnitude
234 :positive-sign positive-sign
235 :negative-sign negative-sign
236 :zero-sign zero-sign)
238 (setf decimal-separator (if decimal-separator
239 (princ-to-string decimal-separator)
241 integer (divide-into-groups
243 :separator (or integer-group-separator "")
244 :group-digits integer-group-digits
246 fractional (divide-into-groups
247 (if (and show-trailing-zeros
248 (plusp (- (- (length fractional))
250 (replace (make-string (abs round-magnitude)
251 :initial-element #\0)
254 :separator (or fractional-group-separator "")
255 :group-digits fractional-group-digits
261 (string-align (concatenate 'string sign integer)
262 integer-minimum-width
263 :side :right :char integer-pad-char)
264 (string-align (if (plusp (length fractional))
265 (concatenate 'string decimal-separator fractional)
267 fractional-minimum-width
268 :side :left :char fractional-pad-char))
269 (list sign integer decimal-separator fractional))))
272 (defmacro define-decimal-formatter (name &body keyword-arguments)
274 "Define a decimal number formatter function to use with the `~/`
275 directive of `cl:format`. The valid format is this:
277 (define-decimal-formatter name
281 _Name_ is the symbol that names the function. _Keyword_ must be a valid
282 keyword argument for the `format-decimal-number` function (see its
283 documentation for more information). _Form_ is evaluated and the value
284 is used with the _keyword_ argument. Macro's side effect is that global
285 function _name_ is defined. It can be used with the `~/` directive of
286 `cl:format` function.
290 (define-decimal-formatter my-formatter
291 (:round-magnitude -6)
292 (:decimal-separator \",\")
293 (:integer-group-separator \" \")
294 (:integer-minimum-width 4)
295 (:fractional-group-separator \" \")
296 (:fractional-minimum-width 10)
297 (:show-trailing-zeros t))
300 (format nil \"~/my-formatter/\" 10/6)
303 (format nil \"~/my-formatter/\" 100/8)
306 The `~/` directive function call can optionally take up to three
307 arguments to override the defaults:
309 ~round-magnitude,integer-minimum-width,fractional-minimum-width/FUNCTION/
313 (format nil \"~-2,3,4/my-formatter/\" 10/6)
316 (let ((key-arg (gensym)))
317 `(let ((,key-arg (list ,@(loop :for (keyword value) :in keyword-arguments
318 :do (assert (keywordp keyword) (keyword)
320 :collect keyword :collect value))))
322 (defun ,name (stream number &optional colon-p at-sign-p
323 round-magnitude integer-minimum-width
324 fractional-minimum-width)
325 (declare (ignore colon-p at-sign-p))
327 (let ((args (copy-list ,key-arg)))
328 (when round-magnitude
329 (setf (getf args :round-magnitude)
331 (when integer-minimum-width
332 (setf (getf args :integer-minimum-width)
333 integer-minimum-width))
334 (when fractional-minimum-width
335 (setf (getf args :fractional-minimum-width)
336 fractional-minimum-width))
337 (princ (apply #'format-decimal-number number args) stream))))))
340 (defun number-string-to-integer (string)
341 (handler-case (parse-integer string)
342 (parse-error () nil)))
345 (defun number-string-to-fractional (string)
346 (when (every #'digit-char-p string)
347 (setf string (string-right-trim "0" string))
348 (handler-case (/ (parse-integer string)
349 (expt 10 (length string)))
350 (parse-error () nil))))
353 (define-condition decimal-parse-error (parse-error)
355 (:report "Not a valid decimal number string.")
357 "Function `parse-decimal-number` signals this condition when it
358 couldn't parse a decimal number from string."))
361 (defun parse-decimal-number (string &key
362 (decimal-separator #\.)
367 "Examine _string_ (or its substring from _start_ to _end_) for a
368 decimal number. Assume that the decimal number is exact and return it as
371 Rules for parsing: First all leading and trailing `#\\Space` characters
372 are stripped. The resulting string may start with a _positive-sign_ or a
373 _negative-sign_ character. The latter causes this function to assume a
374 negative number. The following characters in the string must include one
375 or more digit characters and it may include one _decimal-separator_
376 character which separates integer and fractional parts. All other
377 characters are illegal. If these rules are not met a
378 `decimal-parse-error` condition is signaled.
382 (parse-decimal-number \"0.2\") => 1/5
383 (parse-decimal-number \".2\") => 1/5
384 (parse-decimal-number \"+3.\") => 3
385 (parse-decimal-number \" -7 \") => -7
387 (parse-decimal-number \"−12,345\"
388 :decimal-separator #\\,
392 (setf string (string-trim " " (subseq string start end)))
393 (if (not (plusp (length string)))
394 (error 'decimal-parse-error)
396 (cond ((char= (aref string 0) negative-sign)
398 string (subseq string 1)))
399 ((char= (aref string 0) positive-sign)
400 (setf string (subseq string 1))))
402 (if (and (every (lambda (item)
403 (or (digit-char-p item)
404 (char= item decimal-separator)))
406 (some #'digit-char-p string)
407 (<= 0 (count decimal-separator string) 1))
409 (let ((pos (position decimal-separator string)))
411 (+ (or (number-string-to-integer (subseq string 0 pos))
414 (or (number-string-to-fractional
415 (subseq string (1+ pos)))
419 (error 'decimal-parse-error)))))