程序代写代做代考 data structure algorithm Haskell Advanced Programming – Testing and Assessment

Advanced Programming – Testing and Assessment

Advanced Programming
Testing and Assessment

Ken Friis Larsen
kflarsen@diku.dk

Department of Computer Science
University of Copenhagen

September 13, 2018

1 / 25

Today’s Program

I Questions from the Quiz

I Quick monad recap

I What is an assessment?

I Testing

I Property based testing

2 / 25

Questions and Comments from the Quiz

I “Why have both @=? and @?=? The difference is the order of the
actual and the expected value. Why not just have one of them?”

I “Could be nice if the quiz had some simple QuickCheck
exercises/questions”

I “I would appreciate a more elaborate walkthrough of the way
Gen works.”

I “Not sure how I should handle multiple tests in a sequence”

I “The exercise “Monad and QuickCheck Exercises”, still didn’t
figure out how to use the Random module…stopped tinkering
after 2 hours or so”

3 / 25

Our Two Favorite Type Classes

class Functor f where
fmap :: (a -> b) -> f a -> f b

class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b

class Applicative m => Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
fail :: String -> m a

4 / 25

Make Functors (and Applicatives) For Your Monads

Whenever you make your type a monad, you should also make it a
functor (and an applicative functor).

Here are implementations of Functor and Applicative for free (you
can sometimes/often do better):

instance Monad T where

instance Functor T where
fmap f xs = xs >>= return . f

instance Applicative T where
pure = return
af <*> ax = do f <- af x <- ax return (f x) 5 / 25 What Is An Assessment? From the frontpage of the exam: For each question your report should give an overview of your solution, including an assessment of how good you think your solution is and on which grounds you base your assessment (testing, gut feeling, proof of correctness, . . . ). 6 / 25 Assessment You should document: I Your assumptions (if any). I How suitable is your choice of algorithms and data structures, often based on your assumptions I The correctness/robustness of your code. I An overall summary of the quality of your code. And present evidence for your conclusions. 7 / 25 Morse Code I One of the exercises from exercise set 0 is about decoding morse code. I That is, write the functions encode :: String -> String
decode :: String -> [String]

For instance, “…—..-….-” could be the encoding for both
Sofia and Eugenia.

8 / 25

Morse Code, Implementation

import qualified Data.List as L

charMap = [(‘A’, “.-“), (‘B’, “-…”), … ]

findChar c = fromMaybe “” $ lookup c charMap

encode :: String -> String
encode = concatMap findChar
decode :: String -> [String]
decode “” = [“”]
decode input = [ c : rest | (c, code) <- charMap , code `L.isPrefixOf` input , let clen = length code , rest <- decode $ drop clen input] 9 / 25 Assessment You should document: I Your assumptions (if any). I How suitable is your choice of algorithms and data structures, often based on your assumptions I The correctness/robustness of your code. I An overall summary of the quality of your code. And present evidence for your conclusions. 10 / 25 (Bad) Assessment of Morse Code Implementation I believe that my solution for working with Morse code is quite good. The only weakness is that I use a list as my data structure for mapping chars to the corresponding Morse code. Instead I should probably have used an array or a map (tree or hash based). That would make `findChar` a constant time operation, which would make `encode` much faster. Alas, it also make my implementation of `decode` much uglier, and since the list is short i decided to stay with list. I tested my functions in the REPL for many examples, and they always gave the correct results. 11 / 25 Correctness Claim by Testing To claim that your code is correct, you must as a minimum do some kind of testing: I Black-box testing I White-box testing I Functional testing I Unit testing I . . . Bare minimum, for each test: I write down what you (think) you test, I what is the expected outcome of the test, I what was the outcome of the test. All in a test schema/table (or as unit test). Summarise if needed. 12 / 25 Unit Testing In Haskell Unit tests for the Morse module import Test.Tasty import Test.Tasty.HUnit import Morse fromTheQuiz = testGroup "From the quiz" [ testCase "Encode SOFIA" (assertBool "" ("...---..-.....-" == encode("SOFIA"))) , testCase "Encode SOFIA 2" ("...---..-.....-" @=? encode("SOFIA")) , testCase "Decode Eugenia" (assertBool "" ("EUGENIA" `elem` decode "...---..-....-")) , testCase "Decode Eugenia 2" (assertBool "" ("EUGENIA" `elem` decode "...---..-...-")) ] main = defaultMain fromTheQuiz 13 / 25 Property Based Testing To say something about the correctness of our code, we should be able to prove what properties holds for the code, or at least test that the properties hold for a few instances. For instance, for the Morse module we would expect to be able to decode an encoded string: s = decode(encode(s)) Alas, that’s too strong a property. Several strings can have the same encoding. Thus the property we are after is s ∈ decode(encode(s)) 14 / 25 Using QuickCheck For Property Testing The standard testing framework for property based testing in Haskell is QuickCheck, in the module Test.QuickCheck. We write our property as a predicate, which we can then test with the function quickCheck import Test.QuickCheck import qualified Morse prop_encode_decode s = s `elem` Morse.decode (Morse.encode s) 15 / 25 QuickCheck Building Blocks I QuickCheck generates random values by clever use of the Arbitrary type-class: class Arbitrary a where arbitrary :: Gen a I That uses the type: newtype Gen a = MkGen { unGen :: QCGen -> Int -> a }

to generate values of type a.

I Gen is a monad.

16 / 25

QuickCheck for Morse, Take 2

import qualified Test.QuickCheck as QC
import qualified Data.Char as C
import qualified Morse

upper = map C.toUpper

prop_encode_decode (LO s) = upper s `elem`
Morse.decode (Morse.encode s)

asciiLetter = QC.elements ([‘a’..’z’] ++ [‘A’..’Z’])

newtype LettersOnly = LO String
deriving (Eq, Show)

instance QC.Arbitrary LettersOnly where
arbitrary = fmap LO (QC.listOf asciiLetter)

17 / 25

QuickCheck for Morse, Take 3

import Test.QuickCheck
import qualified Data.Char as C
import qualified Morse

upper = map C.toUpper
prop_encode_decode (LO s) = upper s `elem`

Morse.decode (Morse.encode s)

weightedLetters = frequency [(2 ^ (max – length code), return c)
| (c,code) <- Morse.charMap] where max = 1 + (maximum $ map (length . snd) Morse.charMap) newtype LettersOnly = LO String deriving (Eq, Show) instance Arbitrary LettersOnly where arbitrary = fmap LO $ do n <- choose (0, 5) vectorOf n weightedLetters 18 / 25 Testing Algebraic Data Types How can be generate random expressions for checking that Add is commutative: data Expr = Con Int | Add Expr Expr deriving (Eq, Show, Read, Ord) eval :: Expr -> Int
eval (Con n) = n
eval (Add x y) = eval x + eval y

prop_com_add x y = eval (Add x y) == eval (Add y x)

19 / 25

Generating Exprs

I Our first attempt
expr = oneof [ fmap Con arbitrary

, do x <- expr y <- expr return $ Add x y] instance Arbitrary Expr where arbitrary = expr is correct, I ... but may generate humongous expressions. I Instead we should generate a sized expression expr = sized exprN exprN 0 = fmap Con arbitrary exprN n = oneof [fmap Con arbitrary, liftM2 Add subexpr subexpr] where subexpr = exprN (n `div` 2) 20 / 25 Test your understanding: Check that minus is commutative I Add constructor and extend eval. I Extend data generator: expr = sized exprN exprN 0 = liftM Con arbitrary exprN n = oneof [liftM Con arbitrary, liftM2 Add subexpr subexpr, liftM2 Minus subexpr subexpr ] where subexpr = exprN (n `div` 2) I Write a property prop_com_minus x y = eval (Minus x y) == eval (Minus y x) 21 / 25 Shrinking in Haskell I The Arbitrary type class also specify the function shrink shrink :: a -> [a]

Which should produces a (possibly) empty list of all the possible
immediate shrinks of the given value.

I For Exprs

instance Arbitrary Expr where
arbitrary = sized exprN
where expr N 0 = …

shrink (Add e1 e2) = [e1, e2]
shrink (Minus e1 e2) = [e1, e2]
shrink _ = []

22 / 25

Questions and Comments from the Quiz

I “Why have both @=? and @?=? The difference is the order of the
actual and the expected value. Why not just have one of them?”

I “Could be nice if the quiz had some simple QuickCheck
exercises/questions”

I “I would appreciate a more elaborate walkthrough of the way
Gen works.”

I “Not sure how I should handle multiple tests in a sequence”

I “The exercise “Monad and QuickCheck Exercises”, still didn’t
figure out how to use the Random module…stopped tinkering
after 2 hours or so”

23 / 25

If time permits

I Improve the assessment of the Morse code together

I Talk about the assignment, and how stack is used

I Talk about worksheet exercises, and how to generate the
expression and the expected values together.

24 / 25

Summary

I Practise making an assessments (it will be on the exam)

I To claim correctness you should have some kind of evidence, as
a minimum some testing.

I Use Test.Tasty.HUnit for unit testing

I Use QuickCheck for better testing
I Property-based testing:

I Identify properties to test
I Write data-generators (in Haskell using Arbitrary and Gen)
I When a pro: shrinking

25 / 25