Re: A library for parsing and formatting decimal numbers (?)

Teemu Likonen wrote:

* 2011-06-05T08:07:28+03:00 * Teemu Likonen wrote:
I have a couple of functions which basically add two features: (1) parse
a string for a decimal number and return it as a rational number, and
(2) format any real number in decimal form in various ways.

* 2011-06-05T22:50:28+03:00 * Teemu Likonen wrote:
See the README file and functions' documentation strings (and the
code) for details:

$ git clone git://

I consider this stable so I guess we can say that it's now released. The
package is also introduced here:

Using Arc, let's compare the COBOL way to the Lisp way.

The COBOL way:

(defun round-half-away-from-zero (number &optional (divisor 1))
(if (zerop number)
(values 0 0)
(let ((quotient (if (plusp number)
(floor (+ (/ number divisor) 1/2))
(ceiling (- (/ number divisor) 1/2)))))
(values quotient (- number (* quotient divisor))))))

The Lisp way:

(def round-half-away-from-zero (number . divisor)
(roundup (/ number (last (cons 1 divisor)))))

The COBOL way:

(defun divide-into-groups (string &key (separator #\Space) (from-end nil)
(group-digits 3))

(assert (and (integerp group-digits)
(plusp group-digits))
"The GROUP-DIGITS argument must be a positive integer")

(setf separator (princ-to-string separator))

(if (zerop (length separator))
(flet ((make-groups (string separator)
(loop with length = (length string)
with result = (make-array length :element-type 'character
:fill-pointer 0 :adjustable t)
for c across string
for i upfrom 1
do (vector-push-extend c result)
if (and (zerop (rem i group-digits))
(< i length))
do (loop for c across separator
do (vector-push-extend c result))
finally (return result))))

(if from-end
(nreverse (make-groups (reverse string) (reverse separator)))
(make-groups string separator)))))

The Lisp way:

(def divide-into-groups (mystring (o separator " ") (o from-end nil)
(o group-digits 3))
(unless ((andf number positive) group-digits)
(err "group-digits argument must be positive."))
(if (empty separator)
(with (explode (fn (str reverse?)
(with (result (coerce str 'cons))
(if reverse? (rev result) result))))
(with (result (flat (intersperse (explode separator from-end)
(tuples (explode mystring from-end) group-digits))))
(string (if from-end (rev result) result))))))

The COBOL way:

(defun string-align (string width &key (side :left) (char #\Space))
(if (>= (length string) width)
(let ((result (make-string width :initial-element char)))
(ecase side
(:left (replace result string))
(:right (replace result string
:start1 (- width (length string))))))))

The Lisp way:

(def string-align (mystring width (o side 'left) (o char #\space))
(if (>= (len mystring) width)
(with (padding (newstring (- width (len mystring)) char))
(if (is 'left side)
(string mystring padding)
(string padding mystring)))))

The COBOL way:

(defun decimal-round-split (number &key
(round-magnitude 0)
(rounder #'round-half-away-from-zero)
(positive-sign #\+)
(negative-sign #\-)
(zero-sign nil))

(assert (integerp round-magnitude) (round-magnitude)
"ROUND-MAGNITUDE argument must be an integer.")

(let ((divisor (expt 10 round-magnitude)))
(setf number (* divisor (funcall rounder number divisor))))

(let ((sign (cond ((plusp number) (or positive-sign ""))
((minusp number) (or negative-sign ""))
(t (or zero-sign "")))))

(multiple-value-bind (integer fractional)
(truncate (abs number))
(let ((fractional-string
(with-output-to-string (out)
(loop with next = fractional
with remainder
repeat (abs round-magnitude)
until (zerop next)
(multiple-value-setq (next remainder)
(truncate (* next 10)))
(princ next out)
(setf next remainder)))))
(list (princ-to-string sign)
(princ-to-string integer)

The Lisp way:

(def decimal-round-split (mynumber
(o round-magnitude 0)
(o rounder round-half-away-from-zero)
(o positive-sign "+")
(o negative-sign "-")
(o zero-sign ""))
(withs (divisor (expt 10 round-magnitude)
mynumber (* divisor (rounder mynumber divisor))
sign (if (positive mynumber) positive-sign
(< mynumber 0) negative-sign
mynumber (abs mynumber)
integer (trunc mynumber)
fraction (if (>= round-magnitude 0) ""
(trim (string-align
(string (/ (- mynumber integer) divisor))
(- round-magnitude) 'side 'right 'char #\0)
'end #\0)))
(list sign (string integer) fraction)))

The COBOL way:

(defun format-decimal-number (number &key
(round-magnitude 0)
(rounder #'round-half-away-from-zero)
(decimal-separator #\.)
(integer-group-separator nil)
(integer-group-digits 3)
(integer-minimum-width 0)
(integer-pad-char #\Space)
(fractional-group-separator nil)
(fractional-group-digits 3)
(fractional-minimum-width 0)
(fractional-pad-char #\Space)
(show-trailing-zeros nil)
(positive-sign nil)
(negative-sign #\-)
(zero-sign nil))

(destructuring-bind (sign integer fractional)
(decimal-round-split number
:round-magnitude round-magnitude
:rounder rounder
:positive-sign positive-sign
:negative-sign negative-sign
:zero-sign zero-sign)

(setf decimal-separator (if decimal-separator
(princ-to-string decimal-separator)
integer (divide-into-groups
:separator (or integer-group-separator "")
:group-digits integer-group-digits
:from-end t)
fractional (divide-into-groups
(if (and show-trailing-zeros
(plusp (- (- (length fractional))
(replace (make-string (abs round-magnitude)
:initial-element #\0)
:separator (or fractional-group-separator "")
:group-digits fractional-group-digits
:from-end nil))

(string-align (concatenate 'string sign integer)
:side :right :char integer-pad-char)
(string-align (if (plusp (length fractional))
(concatenate 'string decimal-separator fractional)
:side :left :char fractional-pad-char))
(list sign integer decimal-separator fractional))))

The Lisp way:

(def format-decimal-number (mynumber
(o round-magnitude 0)
(o rounder round-half-away-from-zero)
(o decimal-separator #\.)
(o integer-group-separator "")
(o integer-group-digits 3)
(o integer-minimal-width 0)
(o integer-pad-char #\space)
(o fractional-group-separator "")
(o fractional-group-digits 3)
(o fractional-minimal-width 0)
(o fractional-pad-char #\space)
(o show-trailing-zeros nil)
(o positive-sign "")
(o negative-sign "-")
(o zero-sign ""))
(format (fn (sign integer fraction)
(istring (string sign
(divide-into-groups integer
'group-digits integer-group-digits
'separator integer-group-separator
'from-end t))
(if (and show-trailing-zeros (< round-magnitude 0))
(string-align fraction (abs round-magnitude) 'char #\0)
'group-digits fractional-group-digits
'separator fractional-group-separator))
(string-align istring integer-minimal-width
'side 'right 'char integer-pad-char)
(if (empty fstring)
(string decimal-separator fstring))
'side 'left 'char fractional-pad-char)))))
(apply format
(decimal-round-split mynumber 'round-magnitude round-magnitude
'rounder rounder 'positive-sign positive-sign
'negative-sign negative-sign 'zero-sign zero-sign))))


(prn (format-decimal-number -100/6 'round-magnitude -3))


(for e -5 5
(write (format-decimal-number (expt 10 e)
'round-magnitude -5
'decimal-separator ","
'integer-minimal-width 7
'integer-group-separator " "
'fractional-minimal-width 7
'fractional-group-separator " "))

" 0,000 01"
" 0,000 1 "
" 0,001 "
" 0,01 "
" 0,1 "
" 1 "
" 10 "
" 100 "
" 1 000 "
" 10 000 "
"100 000 "

(for e -4 4
(write (format-decimal-number (expt 10 e)
'round-magnitude -4
'decimal-separator "."
'integer-minimal-width 6
'integer-group-separator ","
'show-trailing-zeros t
'fractional-group-separator ""))

" 0.0001"
" 0.0010"
" 0.0100"
" 0.1000"
" 1.0000"
" 10.0000"
" 100.0000"
" 1,000.0000"

(for m -3 3
(prn #\" (format-decimal-number
2000/3 'round-magnitude m
'integer-minimal-width 4
'fractional-minimal-width 4) #\"))

" 666.667"
" 666.67 "
" 666.7 "
" 667 "
" 670 "
" 700 "
"1000 "