Commit 3e50aabc authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

floor, ceiling, fraction, integerp, evenp, sign, round (and tests)

parent 117f608c
...@@ -26,6 +26,49 @@ ...@@ -26,6 +26,49 @@
(symbols)) (symbols))
#'string<)) #'string<))
(defun floor (number)
"return NUMBER truncated toward negative infinity"
(let ((trunc (truncate number)))
(if (< number trunc)
(1- trunc)
trunc)))
(defun ceiling (number)
"return NUMBER truncated toward positive infinity"
(let ((trunc (truncate number)))
(if (< trunc number)
(1+ trunc)
trunc)))
(defun fraction (number)
"return the fractional part of NUMBER"
(- number (truncate number)))
(defun integerp (obj)
"return t if OBJ is an integer, nil else"
(and (numberp obj)
(= obj (truncate obj))))
(defun evenp (number)
"return t if NUMBER is divisible by 2, else nil"
(and (integerp number)
(zerop (% number 2))))
(defun sign (number)
"return -1, 0, or 1 if NUMBER is negative, zero, or positive"
(cond ((< number 0) -1)
((= number 0) 0)
(t 1)))
(defun round (number)
"return NUMBER rounded to the nearest integer"
(let ((frac (fraction number)))
(if (= frac 0.5)
(if (evenp number)
number
(+ number frac))
(truncate (+ number (* (sign number) 0.5))))))
(defun isqrt (num) (defun isqrt (num)
"return the integer square root of NUM ARG" "return the integer square root of NUM ARG"
(truncate (sqrt num))) (truncate (sqrt num)))
......
(testcmp "truncate positive float" '(truncate (1+ 3.4)) 4) (testcmp "integerp 'symbol" '(integerp 'symbol) nil)
(testcmp "integerp 0" '(integerp 0) t)
(testcmp "integerp 6" '(integerp 6) t)
(testcmp "integerp -6" '(integerp -6) t)
(testcmp "integerp 7" '(integerp 7) t)
(testcmp "integerp -7" '(integerp -7) t)
(testcmp "integerp 6.5" '(integerp 6.5) nil)
(testcmp "integerp -6.5" '(integerp -6.5) nil)
(testcmp "evenp 0" '(evenp 0) t)
(testcmp "evenp 6" '(evenp 6) t)
(testcmp "evenp -6" '(evenp -6) t)
(testcmp "evenp 7" '(evenp 7) nil)
(testcmp "evenp -7" '(evenp -7) nil)
(testcmp "evenp 6.5" '(evenp 6.5) nil)
(testcmp "evenp -6.5" '(evenp -6.5) nil)
(testcmp "sign 0" '(sign 0) 0)
(testcmp "sign 1" '(sign 1) 1)
(testcmp "sign 10" '(sign 10) 1)
(testcmp "sign 10.3" '(sign 10.3) 1)
(testcmp "sign -1" '(sign -1) -1)
(testcmp "sign -10" '(sign -10) -1)
(testcmp "sign -10.3" '(sign -10.3) -1)
(testcmp "truncate positive float (eval'ed)" '(truncate (1+ 3.4)) 4)
(testcmp "truncate positive float bigger" '(truncate (1+ 3.6)) 4)
(testcmp "truncate positive int" '(truncate 3) 3) (testcmp "truncate positive int" '(truncate 3) 3)
(testcmp "truncate zero" '(truncate 0) 0)
(testcmp "truncate negative float" '(truncate -3.4) -3) (testcmp "truncate negative float" '(truncate -3.4) -3)
(testcmp "truncate negative float smaller" '(truncate -3.6) -3)
(testcmp "truncate negative int" '(truncate -3) -3) (testcmp "truncate negative int" '(truncate -3) -3)
(testcmp "floor positive float (eval'ed)" '(floor (1+ 3.4)) 4)
(testcmp "flor positive float bigger" '(floor (1+ 3.6)) 4)
(testcmp "floor positive int" '(floor 3) 3)
(testcmp "floor zero" '(floor 0) 0)
(testcmp "floor negative float" '(floor -3.4) -4)
(testcmp "floor negative float smaller" '(floor -3.6) -4)
(testcmp "floor negative int" '(floor -3) -3)
(testcmp "ceiling positive float (eval'ed)" '(ceiling (1+ 3.4)) 5)
(testcmp "ceiling positive float bigger" '(ceiling (1+ 3.6)) 5)
(testcmp "ceiling positive int" '(ceiling 3) 3)
(testcmp "ceiling zero" '(ceiling 0) 0)
(testcmp "ceiling negative float" '(ceiling -3.4) -3)
(testcmp "ceiling negative float smaller" '(ceiling -3.6) -3)
(testcmp "ceiling negative int" '(ceiling -3) -3)
(testcmp "fraction positive float (eval'ed)" '(fraction (1+ 3.4)) 0.4)
(testcmp "fraction positive float bigger" '(fraction (1+ 3.6)) 0.6)
(testcmp "fraction positive int" '(fraction 3) 0)
(testcmp "fraction zero" '(fraction 0) 0)
(testcmp "fraction negative float" '(fraction -3.4) -0.4)
(testcmp "fraction negative float smaller" '(fraction -3.6) -0.6)
(testcmp "fraction negative int" '(fraction -3) 0)
(testcmp "round positive float (eval'ed)" '(round (1+ 3.4)) 4)
(testcmp "round positive float bigger" '(round (1+ 3.6)) 5)
(testcmp "round positive int" '(round 3) 3)
(testcmp "round zero" '(round 0) 0)
(testcmp "round negative float" '(round -3.4) -3)
(testcmp "round negative float smaller" '(round -3.6) -4)
(testcmp "round negative int" '(round -3) -3)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment