Permalink
Browse files

get [x..] construct (and friends) working

  • Loading branch information...
1 parent c6b11dd commit 086bbf3e65a435b171481065fb345a2d23f368b6 Barak A. Pearlmutter committed Apr 23, 2009
Showing with 19 additions and 9 deletions.
  1. +12 −3 Numeric/FAD.hs
  2. +7 −6 Test.hs
View
@@ -476,11 +476,20 @@ instance (Ord a, Num a) => Ord (Tower tag a) where
0 -- Incorrect!
-}
-instance (Enum a, Num a) => Enum (Tower tag a) where
+instance (Enum a, Num a, Ord a) => Enum (Tower tag a) where
succ = liftA1 succ (const 1)
pred = liftA1 pred (const 1)
- fromEnum = liftA1disc fromEnum
- toEnum = lift . toEnum
+ -- this would be a bug, as it would discard the tower:
+ -- fromEnum = liftA1disc fromEnum
+ fromEnum (Tower []) = 0
+ fromEnum (Tower [x0]) = fromEnum x0
+ fromEnum _ = error "fromEnum of Dual number with tower"
+ toEnum = lift . toEnum
+ enumFrom = iterate succ -- [n..]
+ enumFromThen n n' = iterate (+(n'-n)) n -- [n,n'..]
+ enumFromTo n m = takeWhile (<=m) (enumFrom n) -- [n..m]
+ enumFromThenTo n n' m -- [n,n'..m]
+ = takeWhile (if n' >= n then (<= m) else (>= m)) (enumFromThen n n')
-- First-Order Differentiation Operators
View
13 Test.hs
@@ -185,7 +185,7 @@ main = do
onceCheck $ taylor_accurate cos 40 0 (2*pi)
quickCheck $ taylor_accurate_p cos 40 (-2.5*pi) (2.5*pi)
-- tan
- onceCheck $ taylor_accurate tan 15 0 (pi/8)
+ onceCheck $ taylor_accurate tan 15 0 (pi/8)
-- trig identity
quickCheck $ taylor_accurate_p (\x -> sin x * cos x - sin (2*x) / 2) 10 (-5) 5
-- asin
@@ -206,7 +206,7 @@ main = do
-- atanh
onceCheck $ taylor_accurate atanh 15 0.1 0.2
-- atan2
- quickCheck prop_atan2_shouldBeOne
+ quickCheck $ prop_atan2_shouldBeOne
onceCheck $ prop_atan2_shouldBeOne (pi/2)
-- (==)
onceCheck $ diffs (id_c 7) 3 == [3,1]
@@ -215,7 +215,8 @@ main = do
onceCheck $ diffs succ 17 == [18,1]
-- pred
onceCheck $ diffs pred 17 == [16,1]
- -- The [x..] bug:
- onceCheck $ diff (\x->[x] !! 0) 7 == 1
- --BUG-- onceCheck $ diff (\x->[x..] !! 0) 7 == 1 -- actually returns 0
- --BUG-- onceCheck $ diff (\x->[0,x..] !! 2) 13 == 26 -- actually returns 0
+ -- The [x..] construct
+ onceCheck $ diff (\x->[x] !! 0) 7 == 1
+ onceCheck $ diff (\x->[x..] !! 0) 7 == 1
+ onceCheck $ diff (\x->[0,x..] !! 2) 7 == 2
+ -- onceCheck $ diffsUF (\x->[1,x..4.5]) 2 !! 0 == (\x->[1,x..4.5]) 2 -- BUG?

0 comments on commit 086bbf3

Please sign in to comment.