Skip to content

Instantly share code, notes, and snippets.

@csoroz

csoroz/Test.hs

Created July 10, 2019 15:55
Show Gist options
  • Save csoroz/fc337aad325417526f5b153e70502f28 to your computer and use it in GitHub Desktop.
Save csoroz/fc337aad325417526f5b153e70502f28 to your computer and use it in GitHub Desktop.
Download ZIP
Non-integer test
Raw
Test.hs
import System.Environment (getArgs)
import System.IO (IOMode(..),withFile,hGetContents)
import qualified Data.Fixed as FP
import NonIntegral
data E34
instance FP.HasResolution E34 where
resolution _ = 10^(34::Int)
type FixedPoint = FP.Fixed E34
-- p < 1 - (1 - f) *** σ <=> 1/(1-p) < exp(-σ * ln' (1 - f))
f,c :: FixedPoint
f = 1 / 10
c = ln' (1 - f)
taylor :: FixedPoint -> FixedPoint -> FixedPoint -> Either String (Ordering,FixedPoint,Int)
taylor a p σ = case taylorExpCmp 3 (1/q) (-σ * c) of
BELOW r n -> if p < a then Right (LT,r,n) else Left "should be leader"
ABOVE r n -> if p > a then Right (GT,r,n) else Left "should not be leader"
UNKNOWN -> Left "UNKNOWN"
where q = 1 - p
test :: FixedPoint -> FixedPoint -> FixedPoint -> Either String ([FixedPoint],Ordering,Int)
test x p σ = fmap (\(cmp,r,n) -> ([exp' x, - ln' p, a, r], cmp, n)) (taylor a p σ)
where a = 1 - ((1 - f) *** σ)
check :: (Int,String,String) -> IO ()
check (i,t,r) = putStr (show i++": ") >>
case fmap (== result) (test x p σ) of
Right True -> putStrLn "OK"
Right False -> putStrLn "Error!" >> die
Left e -> putStrLn e >> die
where
[x,p,σ] = map (FP.MkFixed . read) (words t)
result = (map read xs, read cmp, read n)
where (xs,[cmp,n]) = splitAt 4 (words r)
die = error (t ++ " ! " ++ r)
main :: IO ()
main = getArgs >>= \[tests,results] ->
withFile tests ReadMode $ \t ->
withFile results ReadMode $ \r ->
do tt <- hGetContents t
rr <- hGetContents r
mapM_ check $ zip3 [1..] (lines tt) (lines rr)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment