mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
add Set1
This commit is contained in:
Joel Kaasinen
@@ -0,0 +1 @@
|
||||
module Mooc.LimitedPrelude (Int,Integer,Bool(..),Ordering(..),Eq(..),Ord(..),Num(..),Maybe(..),otherwise) where
|
||||
@@ -0,0 +1,132 @@
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables, TemplateHaskell #-}
|
||||
|
||||
module Mooc.Test where
|
||||
|
||||
import Control.Exception (evaluate,SomeException,fromException)
|
||||
import Control.Monad
|
||||
import Data.Foldable
|
||||
import Data.Functor
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Data.Semigroup
|
||||
import System.Timeout
|
||||
import Test.QuickCheck
|
||||
import Test.QuickCheck.Monadic
|
||||
|
||||
import Mooc.Todo
|
||||
|
||||
-- better assertions
|
||||
|
||||
expectation expected actual = counterexample (" Expected: " ++ show expected ++ "\n Was: " ++ show actual)
|
||||
|
||||
expected ==? actual = expectation expected actual (expected == actual)
|
||||
actual ?== expected = expected ==? actual
|
||||
|
||||
infix 4 ==?
|
||||
infix 4 ?==
|
||||
|
||||
actual ?~= expected = expectation expected actual (abs (actual-expected) < 0.01)
|
||||
expected =~? actual = actual ?~= expected
|
||||
|
||||
infix 4 =~?
|
||||
infix 4 ?~=
|
||||
|
||||
hasElements expected actual = counterexample (" Expected elements (in any order): " ++ show expected
|
||||
++ "\n Was: " ++ show actual)
|
||||
(sort expected == sort actual)
|
||||
|
||||
was f actual = counterexample (" Was: "++show actual) (f actual)
|
||||
|
||||
-- helpers
|
||||
|
||||
shrinkPositive :: Int -> [Int]
|
||||
shrinkPositive = map getPositive . shrink . Positive
|
||||
|
||||
forAllShrink_ :: Arbitrary a => Gen a -> (a -> Property) -> Property
|
||||
forAllShrink_ gen = forAllShrinkBlind gen shrink
|
||||
|
||||
forAll_ :: Arbitrary a => (a -> Property) -> Property
|
||||
forAll_ = forAllShrink_ arbitrary
|
||||
|
||||
-- timeouts for evaluation
|
||||
|
||||
timedMillis = 500
|
||||
|
||||
timed val k = monadicIO $ do
|
||||
res <- run $ timeout (timedMillis*1000) $ evaluate val
|
||||
case res of
|
||||
Nothing -> return $ counterexample (" didn't return in "++show timedMillis++"ms") $ False
|
||||
Just v -> return $ k v
|
||||
|
||||
-- handling TODO excercises
|
||||
|
||||
isTodo :: SomeException -> Bool
|
||||
isTodo e = case fromException e of Just TODO -> True
|
||||
_ -> False
|
||||
|
||||
resultIsTodo :: Result -> Bool
|
||||
resultIsTodo (Failure {theException = (Just e)}) = isTodo e
|
||||
resultIsTodo _ = False
|
||||
|
||||
-- scoring
|
||||
|
||||
data Outcome = Pass | Fail | Todo deriving (Show, Eq, Ord)
|
||||
|
||||
instance Semigroup Outcome where
|
||||
(<>) = max
|
||||
|
||||
instance Monoid Outcome where
|
||||
mempty = Pass
|
||||
|
||||
quietArgs = stdArgs {chatty=False}
|
||||
|
||||
myCheck :: Testable prop => prop -> IO Outcome
|
||||
myCheck prop = quickCheckWithResult quietArgs prop >>= interpret
|
||||
where interpret res
|
||||
| resultIsTodo res = return Todo
|
||||
| isSuccess res = return Pass
|
||||
| otherwise = putStrLn (output res) >> return Fail
|
||||
|
||||
histogram vals = [(head xs, length xs) | xs <- group (sort vals)]
|
||||
|
||||
textAttr a s = "\ESC[" ++ a ++ "m" ++ s ++ "\ESC[0m"
|
||||
textBold = textAttr "1"
|
||||
textBoldGreen = textAttr "1;32"
|
||||
textBoldRed = textAttr "1;31"
|
||||
textBlue = textAttr "34"
|
||||
|
||||
showCheck :: Outcome -> String
|
||||
showCheck Todo = "_"
|
||||
showCheck Pass = textBoldGreen "\x2713"
|
||||
showCheck Fail = textBoldRed "\x2715"
|
||||
|
||||
showOutcome :: Outcome -> String
|
||||
showOutcome Pass = textBoldGreen "+++++ Pass"
|
||||
showOutcome Fail = textBoldRed "----- Fail"
|
||||
showOutcome Todo = textBlue "00000 Todo"
|
||||
|
||||
showExercise :: Int -> String
|
||||
showExercise i = textBold $ "===== EXERCISE " ++ show i
|
||||
|
||||
showFinal :: [Outcome] -> String
|
||||
showFinal outs = concatMap showCheck outs ++ "\n" ++ show score ++ " / " ++ show total
|
||||
where score = length $ filter (==Pass) outs
|
||||
total = length outs
|
||||
|
||||
type Test = (Int,String,[Property])
|
||||
|
||||
toJSON :: [(Int,String,Outcome)] -> String
|
||||
toJSON ts = "[" ++ intercalate "," (map f ts) ++ "]"
|
||||
where f (i,name,outcome) = "{\"number\":"++show i++",\"name\":"++show name++",\"outcome\":\""++show outcome++"\"}"
|
||||
|
||||
score :: [Test] -> IO ()
|
||||
score tests = do
|
||||
triples <- forM tests $ \(i,n,ts) -> do
|
||||
putStrLn $ showExercise i
|
||||
out <- fold <$> mapM myCheck ts
|
||||
putStrLn $ showOutcome out
|
||||
return (i,n,out)
|
||||
let outcomes = [o | (_,_,o) <- triples]
|
||||
putStrLn "===== TOTAL"
|
||||
putStrLn $ showFinal outcomes
|
||||
writeFile "score.json" $ toJSON triples
|
||||
@@ -0,0 +1,197 @@
|
||||
{-# LANGUAGE TemplateHaskell, DeriveLift, StandaloneDeriving #-}
|
||||
|
||||
module Mooc.Th (testing, testing',
|
||||
isDefined, withDefined, hasType, importsOnly, show',
|
||||
reifyType, DataType(..), FieldType(..), Constructor(..),
|
||||
withInstance, withInstance1)
|
||||
where
|
||||
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Syntax
|
||||
|
||||
-- testing presence of definitions
|
||||
|
||||
isDefined :: String -> Q Exp
|
||||
isDefined s = do
|
||||
mn <- lookupValueName s
|
||||
let defined = isJust mn
|
||||
[|counterexample ("You haven't defined '"++s++"' yet!") defined|]
|
||||
|
||||
varOrCon :: Name -> Q Exp
|
||||
varOrCon n@(Name (OccName s) _)
|
||||
| isUpper (head s) = return $ ConE n
|
||||
| otherwise = return $ VarE n
|
||||
|
||||
withDefined :: String -> Q Exp
|
||||
withDefined s = do
|
||||
mn <- lookupValueName s
|
||||
case mn of
|
||||
Nothing -> [|(\_ -> counterexample ("You haven't defined '"++s++"' yet!") False)|]
|
||||
Just n -> [|(\f -> f $(varOrCon n))|]
|
||||
|
||||
getType :: String -> Q (Maybe Type)
|
||||
getType s = do
|
||||
mn <- lookupValueName s
|
||||
case mn of Nothing -> return Nothing
|
||||
Just n -> do i <- reify n
|
||||
case i of VarI _ typ _ -> return (Just typ)
|
||||
DataConI _ typ _ -> return (Just typ)
|
||||
_ -> return Nothing
|
||||
|
||||
showType :: Type -> String
|
||||
showType (ConT name) = nameBase name
|
||||
showType (AppT (AppT ArrowT arg) typ) = showType arg ++ " -> " ++ showType typ
|
||||
showType (AppT ListT typ) = "[" ++ showType typ ++ "]"
|
||||
showType t = show t
|
||||
-- TODO: more cases as needed
|
||||
|
||||
hasType :: String -> Q Type -> Q Exp
|
||||
hasType s qtyp = do
|
||||
mt <- getType s
|
||||
typ <- qtyp
|
||||
let correct = mt == Just typ
|
||||
let expected = showType typ
|
||||
let actual = case mt of Nothing -> "nothing"
|
||||
Just t -> showType t
|
||||
if correct
|
||||
then [|\k -> counterexample s (k $(varOrCon $ mkName s))|]
|
||||
else [|\k -> counterexample ("The type of '"++s++"'\n Expected: "++expected++"\n Was: "++actual) False|]
|
||||
|
||||
-- testing types
|
||||
|
||||
data FieldType = SimpleType String | WeirdType
|
||||
deriving (Eq,Show,Lift)
|
||||
|
||||
interpretFieldType (ConT n) = SimpleType $ nameBase n
|
||||
interpretFieldType (VarT n) = SimpleType $ nameBase n
|
||||
interpretFieldType (AppT t1 t2) =
|
||||
case (interpretFieldType t1, interpretFieldType t2) of
|
||||
(SimpleType s1, SimpleType s2) -> SimpleType $ s1 ++ " " ++ s2
|
||||
_ -> WeirdType
|
||||
interpretFieldType _ = WeirdType
|
||||
|
||||
data Constructor = Constructor String [FieldType] | Weird String
|
||||
deriving (Eq,Show,Lift)
|
||||
|
||||
interpretConstructor (NormalC n bts) = Constructor (nameBase n) args
|
||||
where (_,typs) = unzip bts
|
||||
args = map interpretFieldType typs
|
||||
interpretConstructor c = Weird (constructorName c)
|
||||
|
||||
data DataType = DataType [String] [Constructor]
|
||||
deriving (Eq,Show,Lift)
|
||||
|
||||
reifyType :: String -> Q Exp
|
||||
reifyType s = do
|
||||
n <- lookupTypeName s
|
||||
case n of
|
||||
Nothing -> [|\k -> counterexample ("Type "++s++" not defined!") False|]
|
||||
Just n -> do info <- reify n
|
||||
case info of
|
||||
TyConI (DataD _ _ vs _ cs _) -> let cons = map interpretConstructor cs
|
||||
vars = map bndrName vs
|
||||
in [|\k -> counterexample ("The type "++s) $ k (DataType vars cons)|]
|
||||
_ -> [|\k -> counterexample ("Definition "++s++" is not a data declaration!") False|]
|
||||
|
||||
bndrName (PlainTV n) = nameBase n
|
||||
bndrName (KindedTV n _) = nameBase n
|
||||
|
||||
constructorName = nameBase . constructorName'
|
||||
|
||||
constructorName' :: Con -> Name
|
||||
constructorName' c = case c of
|
||||
NormalC n _ -> n
|
||||
RecC n _ -> n
|
||||
InfixC _ n _ -> n
|
||||
ForallC _ _ c -> constructorName' c
|
||||
GadtC (n:_) _ _ -> n
|
||||
RecGadtC (n:_) _ _ -> n
|
||||
|
||||
-- testing classes
|
||||
|
||||
withInstance :: String -> String -> Q Exp -> Q Exp
|
||||
withInstance cln typn val = do
|
||||
cl <- lookupTypeName cln
|
||||
typ <- lookupTypeName typn
|
||||
case (cl,typ) of
|
||||
(Nothing,_) -> [|\k -> counterexample ("Class "++cln++" not found") (property False)|]
|
||||
(_,Nothing) -> [|\k -> counterexample ("Type "++typn++" not found") (property False)|]
|
||||
(Just c, Just t) -> do b <- isInstance c [(ConT t)]
|
||||
if b
|
||||
then [|\k -> k $val|]
|
||||
else [|\k -> counterexample ("Type "++typn++" is not an instance of class "++cln) (property False)|]
|
||||
|
||||
lookupConstructor :: String -> Q (Maybe Type)
|
||||
lookupConstructor "[]" = return (Just ListT)
|
||||
lookupConstructor x = (fmap.fmap) ConT $ lookupTypeName x
|
||||
|
||||
withInstance1 :: String -> String -> Q Exp -> Q Exp
|
||||
withInstance1 cln typn val = do
|
||||
cl <- lookupTypeName cln
|
||||
cons <- lookupConstructor typn
|
||||
case (cl,cons) of
|
||||
(Nothing,_) -> [|\k -> counterexample ("Class "++cln++" not found") (property False)|]
|
||||
(_,Nothing) -> [|\k -> counterexample ("Type "++typn++" not found") (property False)|]
|
||||
(Just c, Just t) -> do b <- isInstance c [(AppT t (VarT (mkName "a")))]
|
||||
if b
|
||||
then [|\k -> k $val|]
|
||||
else [|\k -> counterexample ("Type "++typn++" is not an instance of class "++cln) (property False)|]
|
||||
|
||||
-- verbose testing
|
||||
|
||||
data Call = Prefix Name [Exp] | Operator Name Exp Exp
|
||||
|
||||
parseCall :: Exp -> Call
|
||||
parseCall (VarE name) = Prefix name []
|
||||
parseCall (AppE f arg) = Prefix name (args ++ [arg])
|
||||
where Prefix name args = parseCall f
|
||||
parseCall (InfixE (Just l) (VarE op) (Just r)) = Operator op l r
|
||||
parseCall x = error $ "Unsupported: " ++ show x
|
||||
|
||||
show' v = showsPrec 11 v ""
|
||||
|
||||
showArgs :: Call -> Q Exp
|
||||
showArgs (Prefix name args) = [|fstring ++ " " ++ intercalate " " $arglist|]
|
||||
where fstring = nameBase name
|
||||
arglist = foldr (\arg exp -> [| show' $arg : $exp |]) [| [] |] (map return args)
|
||||
showArgs (Operator name left right) = [| show' $(return left) ++ " " ++ opstring ++ " " ++ show' $(return right) |]
|
||||
where opstring = nameBase name
|
||||
|
||||
testing :: Q Exp -> Q Exp
|
||||
testing call = do
|
||||
parsed <- fmap parseCall call
|
||||
[| \k -> counterexample $(showArgs parsed) (k $call) |]
|
||||
|
||||
-- TH pprint prints all names as qualified, let's convert the names to unqualified locals
|
||||
unqualifyName (Name n _) = Name n NameS
|
||||
|
||||
unqualify :: Exp -> Exp
|
||||
unqualify (VarE n) = VarE (unqualifyName n)
|
||||
unqualify (ConE n) = ConE (unqualifyName n)
|
||||
unqualify (AppE f x) = AppE (unqualify f) (unqualify x)
|
||||
unqualify (InfixE mleft op mright) = InfixE (fmap unqualify mleft) (unqualify op) (fmap unqualify mright)
|
||||
unqualify (UInfixE left op right) = UInfixE (unqualify left) (unqualify op) (unqualify right)
|
||||
unqualify (LitE l) = LitE l
|
||||
unqualify (TupE exps) = TupE (map unqualify exps)
|
||||
unqualify (ListE exps) = ListE (map unqualify exps)
|
||||
unqualify x = error $ "Unsupported: " ++ show x
|
||||
|
||||
testing' :: Q Exp -> Q Exp
|
||||
testing' call = do
|
||||
str <- fmap (pprint.unqualify) call
|
||||
--str <- fmap show call
|
||||
[| \k -> counterexample str (k $call) |]
|
||||
|
||||
-- checking imports
|
||||
|
||||
importsOnly :: String -> [String] -> Q Exp
|
||||
importsOnly name allowed = do
|
||||
(ModuleInfo pkgImports) <- reifyModule (Module (PkgName "main") (ModName name))
|
||||
let imports = [nam | (Module _ (ModName nam)) <- pkgImports]
|
||||
let forbidden = imports \\ allowed
|
||||
case forbidden of
|
||||
[] -> [|property True|]
|
||||
xs -> [|counterexample ("forbidden imports: " ++ show xs) False|]
|
||||
@@ -0,0 +1,7 @@
|
||||
module Mooc.Todo where
|
||||
|
||||
import Control.Exception (Exception, throw)
|
||||
|
||||
data TODO = TODO deriving Show
|
||||
instance Exception TODO
|
||||
todo = throw TODO
|
||||
@@ -0,0 +1,251 @@
|
||||
-- Welcome to the first exercise set of the Haskell Mooc! Edit this
|
||||
-- file according to the instructions, and check your answers with
|
||||
--
|
||||
-- stack runhaskell Set1Test.hs
|
||||
--
|
||||
-- You can also play around with your answers in GHCi with
|
||||
--
|
||||
-- stack ghci Set1.hs
|
||||
--
|
||||
-- This set contains exercises on
|
||||
-- * defining functions
|
||||
-- * basic expressions
|
||||
-- * pattern matching
|
||||
-- * recursion
|
||||
|
||||
|
||||
module Set1 where
|
||||
|
||||
import Mooc.Todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 1: define variables one and two. They should have type Int and
|
||||
-- values 1 and 2, respectively.
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 2: define the function double of type Integer->Integer. Double
|
||||
-- should take one argument and return it multiplied by two.
|
||||
|
||||
double :: Integer -> Integer
|
||||
double x = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 3: define the function quadruple that uses the function double
|
||||
-- from the previous exercise to return its argument multiplied by
|
||||
-- four.
|
||||
|
||||
quadruple :: Integer -> Integer
|
||||
quadruple x = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 4: define the function distance. It should take four arguments of
|
||||
-- type Double: x1, y1, x2, and y2 and return the (euclidean) distance
|
||||
-- between points (x1,y1) and (x2,y2).
|
||||
--
|
||||
-- Give distance a type signature, i.e. distance :: something.
|
||||
--
|
||||
-- PS. if you can't remember how the distance is computed, the formula is:
|
||||
-- square root of ((x distance) squared + (y distance) squared)
|
||||
|
||||
distance = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 5: define the function eeny that returns "eeny" for even inputs
|
||||
-- and "meeny" for odd inputs.
|
||||
--
|
||||
-- Ps. have a look at the built in function "even"
|
||||
|
||||
eeny :: Integer -> String
|
||||
eeny = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 6: here's the function checkPassword from the course material.
|
||||
-- Modify it so that it accepts two passwords, "swordfish" and
|
||||
-- "mellon".
|
||||
|
||||
checkPassword :: String -> String
|
||||
checkPassword password = if password == "swordfish"
|
||||
then "You're in."
|
||||
else "ACCESS DENIED!"
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 7: A postal service prices packages the following way.
|
||||
-- Packages that weigh up to 500 grams cost 250 credits.
|
||||
-- Packages over 500 grams cost 300 credit + 1 credit per gram.
|
||||
-- Packages over 5000 grams cost a constant 6000 credits.
|
||||
--
|
||||
-- Write a function postagePrice that takes the weight of a package
|
||||
-- in, and returns the cost in credits.
|
||||
|
||||
postagePrice :: Int -> Int
|
||||
postagePrice = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 8: define a function isZero that returns True if it is given an
|
||||
-- Integer that is 0, and False otherwise. Give isZero a type signature.
|
||||
--
|
||||
-- Use pattern matching! Don't use comparisons!
|
||||
--
|
||||
-- Ps. remember, the type of booleans in haskell is Bool
|
||||
|
||||
isZero = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 9: implement using recursion a function sumTo such that
|
||||
-- sumTo n
|
||||
-- computes the sum 1+2+...+n
|
||||
|
||||
sumTo :: Integer -> Integer
|
||||
sumTo = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 10: power n k should compute n to the power k (i.e. n^k)
|
||||
-- Use recursion.
|
||||
|
||||
power :: Integer -> Integer -> Integer
|
||||
power = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 11: ilog3 n should be the number of times you can divide given
|
||||
-- number by three (rounding down) before you get 0.
|
||||
--
|
||||
-- For example, ilog3 20 ==> 3 since
|
||||
-- 20/3 = 6.66 (gets rounded down to 6)
|
||||
-- 6/3 = 2
|
||||
-- 2/3 = 0.666 (gets rounded down to 0)
|
||||
--
|
||||
-- Use recursion to define ilog3. Use the function "div" for integer
|
||||
-- division. It rounds down for you.
|
||||
--
|
||||
-- More examples:
|
||||
-- ilog3 2 ==> 1
|
||||
-- ilog3 7 ==> 2
|
||||
|
||||
ilog3 :: Integer -> Integer
|
||||
ilog3 = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 12: compute binomial coefficients using recursion. Binomial
|
||||
-- coefficients are defined by the following equations:
|
||||
--
|
||||
-- B(n,k) = B(n-1,k) + B(n-1,k-1)
|
||||
-- B(n,0) = 1
|
||||
-- B(0,k) = 0, when k>0
|
||||
--
|
||||
-- Hint! pattern matching is your friend.
|
||||
|
||||
binomial :: Integer -> Integer -> Integer
|
||||
binomial = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 13: implement the odd factorial function. Odd factorial is like
|
||||
-- factorial, but it only multiplies odd numbers.
|
||||
--
|
||||
-- Examples:
|
||||
-- oddFactorial 7 ==> 7*5*3*1 ==> 105
|
||||
-- oddFactorial 6 ==> 5*3*1 ==> 15
|
||||
|
||||
oddFactorial :: Integer -> Integer
|
||||
oddFactorial = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 14: implement the Euclidean Algorithm for finding the greatest
|
||||
-- common divisor:
|
||||
--
|
||||
-- Given two numbers, a and b,
|
||||
-- * if one is zero, return the other number
|
||||
-- * if not, subtract the smaller number from the larger one
|
||||
-- * replace the larger number with this new number
|
||||
-- * repeat
|
||||
--
|
||||
-- For example,
|
||||
-- myGcd 9 12 ==> 3
|
||||
-- In this case, the algorithm proceeds like this
|
||||
--
|
||||
-- a b
|
||||
--
|
||||
-- 9 12
|
||||
-- 9 (12-9)
|
||||
-- 9 3
|
||||
-- (9-3) 3
|
||||
-- 6 3
|
||||
-- (6-3) 3
|
||||
-- 3 3
|
||||
-- (3-3) 3
|
||||
-- 0 3
|
||||
--
|
||||
-- Background reading:
|
||||
-- * https://en.wikipedia.org/wiki/Euclidean_algorithm
|
||||
|
||||
myGcd :: Integer -> Integer -> Integer
|
||||
myGcd = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 15: Implement the function leftpad which adds space characters
|
||||
-- to the start of the string until it is long enough.
|
||||
--
|
||||
-- Examples:
|
||||
-- leftpad "foo" 5 ==> " foo"
|
||||
-- leftpad "13" 3 ==> " 13"
|
||||
-- leftpad "xxxxx" 3 ==> "xxxxx"
|
||||
--
|
||||
-- Tips:
|
||||
-- * you can combine strings with the ++ operator.
|
||||
-- * you can compute the length of a string with the length function
|
||||
|
||||
leftpad :: String -> Int -> String
|
||||
leftpad = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 16: let's make a countdown for a rocket! Given a number, you
|
||||
-- should produce a string that says "Ready!", counts down from the
|
||||
-- number, and then says "Liftoff!".
|
||||
--
|
||||
-- For example,
|
||||
-- countdown 4 ==> "Ready! 4... 3... 2... 1... Liftoff!"
|
||||
--
|
||||
-- Hints:
|
||||
-- * you can combine strings with the ++ operator
|
||||
-- * you can use the show function to convert a number into a string
|
||||
-- * you'll probably need a recursive helper function
|
||||
|
||||
countdown :: Integer -> String
|
||||
countdown = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 17: implement the function smallestDivisor that returns the
|
||||
-- smallest number (greater than 1) that divides the given number evenly.
|
||||
--
|
||||
-- That is, when
|
||||
-- smallestDivisor n ==> k
|
||||
-- we have
|
||||
-- n = t*k
|
||||
-- for some t.
|
||||
--
|
||||
-- Ps. your function doesn't need to work for inputs 0 and 1, but
|
||||
-- remember this in the next exercise!
|
||||
|
||||
smallestDivisor :: Integer -> Integer
|
||||
smallestDivisor = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 18: implement a function isPrime that checks if the given number
|
||||
-- is a prime number. Use the function smallestDivisor.
|
||||
--
|
||||
-- Ps. 0 and 1 are not prime numbers
|
||||
|
||||
isPrime :: Integer -> Bool
|
||||
isPrime = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 19: implement a function biggestPrimeAtMost that returns the
|
||||
-- biggest prime number that is less than or equal to the given
|
||||
-- number. Use the function isPrime you just defined.
|
||||
--
|
||||
-- Examples:
|
||||
-- biggestPrimeAtMost 3 ==> 3
|
||||
-- biggestPrimeAtMost 10 ==> 7
|
||||
|
||||
biggestPrimeAtMost :: Integer -> Integer
|
||||
biggestPrimeAtMost = todo
|
||||
@@ -0,0 +1,168 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Set1Test where
|
||||
|
||||
import Data.List
|
||||
import Test.QuickCheck
|
||||
|
||||
import Mooc.Th
|
||||
import Mooc.Test
|
||||
|
||||
import Set1
|
||||
|
||||
main = score tests
|
||||
|
||||
tests = [(1,"onetwo",[ex1_one_defined, ex1_one_type
|
||||
,ex1_two_defined, ex1_two_type])
|
||||
,(2,"double",[ex2_double])
|
||||
,(3,"quadruple",[ex3_quadruple])
|
||||
,(4,"distance",[property ex4_distance])
|
||||
,(5,"eeny",[property ex5_eeny_even, property ex5_meeny_odd])
|
||||
,(6,"checkPassword",[property ex6_denied, property ex6_accepted])
|
||||
,(7,"postagePrice",[property ex7_corners
|
||||
,property ex7_cheap
|
||||
,property ex7_medium
|
||||
,property ex7_large])
|
||||
,(8,"isZero",[property ex8_isZero_0
|
||||
,property ex8_isZero_positive
|
||||
,property ex8_isZero_negative])
|
||||
,(9,"sumTo",[ex9_sumTo])
|
||||
,(10,"power",[ex10_power])
|
||||
,(11,"ilog3",[property ex11_ilog3])
|
||||
,(12,"binomial",[ex12_binomial])
|
||||
,(13,"oddFactorial",[ex13_oddFactorial])
|
||||
,(14,"myGcd",[ex14_myGcd])
|
||||
,(15,"leftpad",[property ex15_leftpad])
|
||||
,(16,"countdown",[ex16_countdown])
|
||||
,(17,"smallestDivisor",[ex17_smallestDivisor_prime, property ex17_smallestDivisor_comp])
|
||||
,(18,"isPrime",[ex18_isPrime])
|
||||
,(19,"biggestPrimeAtMost",[ex19_biggestPrimeAtMost])]
|
||||
|
||||
-- -- -- -- -- --
|
||||
|
||||
ex1_one_defined = $(isDefined "one")
|
||||
ex1_two_defined = $(isDefined "two")
|
||||
ex1_one_type = $(hasType "one" [t|Int|]) (?==1)
|
||||
ex1_two_type = $(hasType "two" [t|Int|]) (?==2)
|
||||
|
||||
ex2_double = forAll_ $ \x -> $(testing [|double x|]) (?==2*x)
|
||||
|
||||
ex3_quadruple = forAll_ $ \x -> $(testing [|quadruple x|]) (?==4*x)
|
||||
|
||||
ex4_distance = do
|
||||
(deltax,deltay,dist) <- elements ([(3,4,5),(5,12,13),(8,15,17),(7,24,25)] :: [(Double,Double,Double)])
|
||||
x1 <- elements [-5..5]
|
||||
y1 <- elements [-5..5]
|
||||
let x2 = x1+deltax
|
||||
let y2 = y1+deltay
|
||||
return $ $(testing [|distance x1 x2 y1 y2|]) (dist=~?)
|
||||
|
||||
ex5_eeny_even = forAll_ $ \x -> $(testing [|eeny (2*x)|]) (?=="eeny")
|
||||
ex5_meeny_odd = forAll_ $ \x -> $(testing [|eeny (2*x+1)|]) (?=="meeny")
|
||||
|
||||
word = listOf1 (choose ('a','z'))
|
||||
passwords = ["swordfish","mellon"]
|
||||
|
||||
ex6_denied = do
|
||||
w <- word `suchThat` (\w -> not (elem w passwords))
|
||||
return $ $(testing [|checkPassword w|]) (?=="ACCESS DENIED!")
|
||||
|
||||
ex6_accepted = do
|
||||
w <- elements passwords
|
||||
return $ $(testing [|checkPassword w|]) (?=="You're in.")
|
||||
|
||||
ex7_corners =
|
||||
$(testing [|postagePrice 500|]) (?==250)
|
||||
.&&.
|
||||
$(testing [|postagePrice 5000|]) (?==5300)
|
||||
|
||||
ex7_cheap =
|
||||
forAllBlind (choose (0,500)) $ \w ->
|
||||
$(testing [|postagePrice w|]) (?==250)
|
||||
|
||||
ex7_medium =
|
||||
forAllBlind (choose (501,5000)) $ \w ->
|
||||
$(testing [|postagePrice w|]) (?==300+w)
|
||||
|
||||
ex7_large =
|
||||
forAllBlind (choose (5001,10000)) $ \w ->
|
||||
$(testing [|postagePrice w|]) (?==6000)
|
||||
|
||||
ex8_isZero_0 = $(testing [|isZero 0|]) (?== True)
|
||||
|
||||
ex8_isZero_positive :: Positive Integer -> Property
|
||||
ex8_isZero_positive (Positive n) = $(testing [|isZero n|]) (?== False)
|
||||
|
||||
ex8_isZero_negative :: Positive Integer -> Property
|
||||
ex8_isZero_negative (Positive n) = $(testing [|isZero n|]) (?== False)
|
||||
|
||||
ex9_sumTo =
|
||||
forAllBlind (elements [1..100]) $ \n ->
|
||||
$(testing [|sumTo n|]) (?==sum [1..n])
|
||||
|
||||
ex10_power =
|
||||
forAllBlind (elements [1..10]) $ \n ->
|
||||
forAllBlind (elements [1..10]) $ \k ->
|
||||
$(testing [|power n k|]) (?==n^k)
|
||||
|
||||
ex11_ilog3 (Blind (Positive n)) =
|
||||
$(testing [|ilog3 n|]) (?== 1 + floor (logBase 3 $ fromIntegral n))
|
||||
|
||||
ex12_binomial =
|
||||
forAllBlind (elements [0..10]) $ \n ->
|
||||
forAllBlind (elements [0..n]) $ \k ->
|
||||
$(testing [|binomial n k|]) (?== f n `div` (f k * f (n-k)))
|
||||
where f n = product [1..n]
|
||||
|
||||
ex13_oddFactorial =
|
||||
forAllBlind (elements [1..15]) $ \n ->
|
||||
$(testing [|oddFactorial n|]) (?== f n)
|
||||
where f n = product [1,3..n]
|
||||
|
||||
ex14_myGcd =
|
||||
forAllBlind (elements [1..max]) $ \x ->
|
||||
forAllBlind (elements [1..max]) $ \y ->
|
||||
$(testing [|myGcd x y|]) (?== gcd x y)
|
||||
where max = 10000
|
||||
|
||||
ex15_leftpad =
|
||||
do text <- word
|
||||
ws <- listOf (return ' ')
|
||||
let res = ws++text
|
||||
let len = length res
|
||||
return $ $(testing [|leftpad text len|]) (?==res)
|
||||
|
||||
ex16_countdown =
|
||||
forAllBlind (elements [1..20]) $ \n ->
|
||||
$(testing [|countdown n|]) . was $ \v ->
|
||||
counterexample "should start with \"Ready!\"" (take 6 v ?== "Ready!")
|
||||
.&&.
|
||||
counterexample "should end with \"Liftoff!\"" (reverse (take 8 (reverse v)) ?== "Liftoff!")
|
||||
.&&.
|
||||
let cnt = init $ init $ intercalate "... " (map show [n,n-1..0])
|
||||
in counterexample ("should contain the string " ++ show cnt) (isInfixOf cnt v)
|
||||
|
||||
primes = go [2..]
|
||||
where go (x:xs) = x : go (filter (notDivBy x) xs)
|
||||
notDivBy x y = mod y x /= 0
|
||||
|
||||
ex17_smallestDivisor_prime = do
|
||||
forAllBlind (elements $ take 12 primes) $ \p ->
|
||||
$(testing [|smallestDivisor p|]) (?== p)
|
||||
|
||||
ex17_smallestDivisor_comp = do
|
||||
k <- (elements . take 10 $ primes)
|
||||
p <- (elements . take 20 . drop 10 $ primes)
|
||||
let n = k*p
|
||||
return $ $(testing [|smallestDivisor n|]) (?== k)
|
||||
|
||||
ex18_isPrime =
|
||||
forAllBlind (elements [0..max]) $ \n ->
|
||||
$(testing [|isPrime n|]) (?== elem n primes')
|
||||
where max = 20
|
||||
primes' = takeWhile (<=max) primes
|
||||
|
||||
ex19_biggestPrimeAtMost =
|
||||
forAllBlind (elements [2..max]) $ \n ->
|
||||
$(testing [|biggestPrimeAtMost n|]) (?== last (takeWhile (<=n) primes))
|
||||
where max = 100
|
||||
@@ -0,0 +1,2 @@
|
||||
resolver: lts-14.9
|
||||
install-ghc: true
|
||||
@@ -0,0 +1,8 @@
|
||||
name: tests
|
||||
version: 0.0.1
|
||||
build-type: Simple
|
||||
cabal-version: >= 1.10
|
||||
|
||||
library
|
||||
build-depends: QuickCheck, hspec, base, template-haskell, generic-random, JuicyPixels
|
||||
default-language: Haskell2010
|
||||
Reference in New Issue
Block a user