Skip to content

Commit 74acc3a

Browse files
committed
Issue justinethier#203 - Tweaked (real?) to be true if both (zero? (imag-part z)) and (exact? (imag-part z)) are true
1 parent 59d79b5 commit 74acc3a

File tree

2 files changed

+17
-3
lines changed

2 files changed

+17
-3
lines changed

hs-src/Language/Scheme/Numerical.hs

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -479,7 +479,12 @@ numRealPart badArgList = throwError $ NumArgs (Just 1) badArgList
479479

480480
-- |Retrieve imaginary part of a complex number
481481
numImagPart :: [LispVal] -> ThrowsError LispVal
482-
numImagPart [(Complex c)] = return $ Float $ imagPart c
482+
numImagPart [(Complex c)] = do
483+
let n = imagPart c
484+
f = Float n
485+
if isFloatAnInteger f
486+
then return $ Number $ floor n
487+
else return f
483488
numImagPart [(Float _)] = return $ Number 0
484489
numImagPart [(Rational _)] = return $ Number 0
485490
numImagPart [(Number _)] = return $ Number 0
@@ -594,7 +599,13 @@ isReal :: [LispVal] -> ThrowsError LispVal
594599
isReal ([Number _]) = return $ Bool True
595600
isReal ([Rational _]) = return $ Bool True
596601
isReal ([Float _]) = return $ Bool True
597-
isReal ([Complex c]) = return $ Bool $ (imagPart c) == 0
602+
isReal ([Complex c]) = do
603+
imagPt <- numImagPart [(Complex c)]
604+
isExact <- isNumExact [imagPt]
605+
isZero <- numBoolBinopEq [imagPt, (Number 0)]
606+
case (isExact, isZero) of
607+
(Bool True, Bool True) -> return $ Bool True
608+
_ -> return $ Bool False
598609
isReal _ = return $ Bool False
599610

600611
-- |Predicate to determine if given number is a rational.

tests/t-numerical-ops.scm

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,11 @@
1111
(assert/equal (complex? 3+4i) #t)
1212
(assert/equal (complex? 3) #t)
1313
(assert/equal (real? 3) #t)
14-
(assert/equal (real? -2.5+0.0i) #t)
14+
(assert/equal (real? -2.5+0i) #t)
15+
(assert/equal (real? -2.5+0.1i) #f)
16+
;(assert/equal (real? -2.5+0.0i) #f)
1517
;Issue #14: (assert/equal (real? #e1e103) #t)
18+
; TODO: (assert/equal (rational? 3.5) #t)
1619
(assert/equal (rational? 6/10) #t)
1720
(assert/equal (rational? 6/3) #t)
1821
(assert/equal (integer? 3+0i) #t)

0 commit comments

Comments
 (0)