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:

https://github.com/tlikonen/cl-decimals

$ git clone git://github.com/tlikonen/cl-decimals.git

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

http://www.cliki.net/Decimals

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))
(group-digits)
"The GROUP-DIGITS argument must be a positive integer")

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

(if (zerop (length separator))
string
(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)
mystring
(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)
string
(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)
mystring
(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)
do
(multiple-value-setq (next remainder)
(truncate (* next 10)))
(princ next out)
(setf next remainder)))))
(list (princ-to-string sign)
(princ-to-string integer)
fractional-string)))))



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
zero-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
integer
: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))
round-magnitude)))
(replace (make-string (abs round-magnitude)
:initial-element #\0)
fractional)
fractional)
:separator (or fractional-group-separator "")
:group-digits fractional-group-digits
:from-end nil))

(values
(concatenate
'string
(string-align (concatenate 'string sign integer)
integer-minimum-width
:side :right :char integer-pad-char)
(string-align (if (plusp (length fractional))
(concatenate 'string decimal-separator fractional)
"")
fractional-minimum-width
: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 ""))
(with
(format (fn (sign integer fraction)
(with
(istring (string sign
(divide-into-groups integer
'group-digits integer-group-digits
'separator integer-group-separator
'from-end t))
fstring
(divide-into-groups
(if (and show-trailing-zeros (< round-magnitude 0))
(string-align fraction (abs round-magnitude) 'char #\0)
fraction)
'group-digits fractional-group-digits
'separator fractional-group-separator))
(string
(string-align istring integer-minimal-width
'side 'right 'char integer-pad-char)
(string-align
(if (empty fstring)
""
(string decimal-separator fstring))
fractional-minimal-width
'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))))



Testing:


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

-16.667


(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 " "))
(prn))

" 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 ""))
(prn))

" 0.0001"
" 0.0010"
" 0.0100"
" 0.1000"
" 1.0000"
" 10.0000"
" 100.0000"
" 1,000.0000"
"10,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 "


.



Relevant Pages