formatting
This commit is contained in:
parent
e5285e5c8f
commit
32b48b79d0
@ -120,4 +120,6 @@ test-suite HushGP-test
|
|||||||
build-depends:
|
build-depends:
|
||||||
base,
|
base,
|
||||||
HushGP,
|
HushGP,
|
||||||
QuickCheck
|
QuickCheck,
|
||||||
|
lens
|
||||||
|
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
module Instructions (
|
module Instructions
|
||||||
module Instructions.GenericInstructions,
|
( module Instructions.GenericInstructions,
|
||||||
module Instructions.IntInstructions,
|
module Instructions.IntInstructions,
|
||||||
module Instructions.FloatInstructions,
|
module Instructions.FloatInstructions,
|
||||||
module Instructions.StringInstructions,
|
module Instructions.StringInstructions,
|
||||||
@ -11,20 +11,20 @@ module Instructions (
|
|||||||
module Instructions.VectorFloatInstructions,
|
module Instructions.VectorFloatInstructions,
|
||||||
module Instructions.VectorStringInstructions,
|
module Instructions.VectorStringInstructions,
|
||||||
module Instructions.VectorLogicalInstructions,
|
module Instructions.VectorLogicalInstructions,
|
||||||
module Instructions.VectorCharInstructions
|
module Instructions.VectorCharInstructions,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Instructions.GenericInstructions
|
|
||||||
import Instructions.IntInstructions
|
|
||||||
import Instructions.FloatInstructions
|
|
||||||
import Instructions.StringInstructions
|
|
||||||
import Instructions.CharInstructions
|
import Instructions.CharInstructions
|
||||||
import Instructions.CodeInstructions
|
import Instructions.CodeInstructions
|
||||||
import Instructions.ExecInstructions
|
import Instructions.ExecInstructions
|
||||||
|
import Instructions.FloatInstructions
|
||||||
|
import Instructions.GenericInstructions
|
||||||
|
import Instructions.IntInstructions
|
||||||
import Instructions.LogicalInstructions
|
import Instructions.LogicalInstructions
|
||||||
import Instructions.VectorIntInstructions
|
import Instructions.StringInstructions
|
||||||
import Instructions.VectorFloatInstructions
|
|
||||||
import Instructions.VectorStringInstructions
|
|
||||||
import Instructions.VectorLogicalInstructions
|
|
||||||
import Instructions.VectorCharInstructions
|
import Instructions.VectorCharInstructions
|
||||||
|
import Instructions.VectorFloatInstructions
|
||||||
|
import Instructions.VectorIntInstructions
|
||||||
|
import Instructions.VectorLogicalInstructions
|
||||||
|
import Instructions.VectorStringInstructions
|
||||||
|
@ -2,11 +2,11 @@ module LearnQuickCheck where
|
|||||||
|
|
||||||
-- https://jesper.sikanda.be/posts/quickcheck-intro.html
|
-- https://jesper.sikanda.be/posts/quickcheck-intro.html
|
||||||
|
|
||||||
import Test.QuickCheck
|
|
||||||
import Data.List (sort)
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Data.List (sort)
|
||||||
|
import Test.QuickCheck
|
||||||
|
|
||||||
qsort :: Ord a => [a] -> [a]
|
qsort :: (Ord a) => [a] -> [a]
|
||||||
qsort = sort
|
qsort = sort
|
||||||
|
|
||||||
distance :: Int -> Int -> Int
|
distance :: Int -> Int -> Int
|
||||||
@ -27,7 +27,7 @@ bad_distance x y = y - x
|
|||||||
prop_dist_symmetric_fail :: Int -> Int -> Bool
|
prop_dist_symmetric_fail :: Int -> Int -> Bool
|
||||||
prop_dist_symmetric_fail x y = bad_distance x y == bad_distance y x
|
prop_dist_symmetric_fail x y = bad_distance x y == bad_distance y x
|
||||||
|
|
||||||
sorted :: Ord a => [a] -> Bool
|
sorted :: (Ord a) => [a] -> Bool
|
||||||
sorted (x : y : ys) = x <= y && sorted (y : ys)
|
sorted (x : y : ys) = x <= y && sorted (y : ys)
|
||||||
sorted _ = True
|
sorted _ = True
|
||||||
|
|
||||||
@ -37,12 +37,14 @@ prop_sorted xs = sorted xs
|
|||||||
-- roundtrip property
|
-- roundtrip property
|
||||||
insert :: Int -> [Int] -> [Int]
|
insert :: Int -> [Int] -> [Int]
|
||||||
insert x [] = [x]
|
insert x [] = [x]
|
||||||
insert x (y:ys) | x <= y = x:y:ys
|
insert x (y : ys)
|
||||||
|
| x <= y = x : y : ys
|
||||||
| otherwise = y : insert x ys
|
| otherwise = y : insert x ys
|
||||||
|
|
||||||
delete :: Int -> [Int] -> [Int]
|
delete :: Int -> [Int] -> [Int]
|
||||||
delete x [] = []
|
delete x [] = []
|
||||||
delete x (y:ys) | x == y = ys
|
delete x (y : ys)
|
||||||
|
| x == y = ys
|
||||||
| otherwise = y : delete x ys
|
| otherwise = y : delete x ys
|
||||||
|
|
||||||
prop_insert_delete :: [Int] -> Int -> Bool
|
prop_insert_delete :: [Int] -> Int -> Bool
|
||||||
@ -53,7 +55,7 @@ prop_qsort_sort :: [Int] -> Bool
|
|||||||
prop_qsort_sort xs = qsort xs == sort xs
|
prop_qsort_sort xs = qsort xs == sort xs
|
||||||
|
|
||||||
-- can test this in ghci with verboseCheck
|
-- can test this in ghci with verboseCheck
|
||||||
prop_qsort_sort' :: Ord a => [a] -> Bool
|
prop_qsort_sort' :: (Ord a) => [a] -> Bool
|
||||||
prop_qsort_sort' xs = qsort xs == sort xs
|
prop_qsort_sort' xs = qsort xs == sort xs
|
||||||
|
|
||||||
-- Algebraic Laws
|
-- Algebraic Laws
|
||||||
@ -95,20 +97,19 @@ prop_filter :: Fun Int Bool -> [Int] -> Property
|
|||||||
prop_filter p xs =
|
prop_filter p xs =
|
||||||
-- Filter elements not satisfying p.
|
-- Filter elements not satisfying p.
|
||||||
let ys = [x | x <- xs, applyFun p x]
|
let ys = [x | x <- xs, applyFun p x]
|
||||||
-- If any elements are left...
|
in -- If any elements are left...
|
||||||
in ys /= [] ==>
|
ys /= [] ==>
|
||||||
-- ...generate a random index i...
|
-- ...generate a random index i...
|
||||||
forAll (choose (0,length ys-1))
|
forAll
|
||||||
|
(choose (0, length ys - 1))
|
||||||
-- ...and test if p (ys!!i) holds.
|
-- ...and test if p (ys!!i) holds.
|
||||||
(\i -> applyFun p (ys !! i))
|
(\i -> applyFun p (ys !! i))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
prop_bananas :: Fun String Int -> Bool
|
prop_bananas :: Fun String Int -> Bool
|
||||||
prop_bananas f =
|
prop_bananas f =
|
||||||
applyFun f "banana" == applyFun f "monkey" ||
|
applyFun f "banana" == applyFun f "monkey"
|
||||||
applyFun f "banana" == applyFun f "elephant" ||
|
|| applyFun f "banana" == applyFun f "elephant"
|
||||||
applyFun f "monkey" == applyFun f "elephant"
|
|| applyFun f "monkey" == applyFun f "elephant"
|
||||||
|
|
||||||
-- main :: IO ()
|
-- main :: IO ()
|
||||||
-- main = do
|
-- main = do
|
||||||
@ -173,14 +174,17 @@ instance Arbitrary Point where
|
|||||||
data Set a = Set [a]
|
data Set a = Set [a]
|
||||||
|
|
||||||
instance (Show a) => Show (Set a) where
|
instance (Show a) => Show (Set a) where
|
||||||
show s = showSet s where
|
show s = showSet s
|
||||||
|
where
|
||||||
showSet (Set []) = "{}"
|
showSet (Set []) = "{}"
|
||||||
showSet (Set (x:xs)) = "{" <> show x <> showSubSet xs <> "}" where
|
showSet (Set (x : xs)) = "{" <> show x <> showSubSet xs <> "}"
|
||||||
|
where
|
||||||
showSubSet [] = ""
|
showSubSet [] = ""
|
||||||
showSubSet (ix : ixs) = "," <> show ix <> showSubSet ixs
|
showSubSet (ix : ixs) = "," <> show ix <> showSubSet ixs
|
||||||
|
|
||||||
instance (Arbitrary a) => Arbitrary (Set a) where
|
instance (Arbitrary a) => Arbitrary (Set a) where
|
||||||
arbitrary = do Set <$> arbitrary
|
arbitrary = do Set <$> arbitrary
|
||||||
|
|
||||||
-- list <- arbitrary
|
-- list <- arbitrary
|
||||||
-- return $ Set list
|
-- return $ Set list
|
||||||
|
|
||||||
|
13
src/State.hs
13
src/State.hs
@ -1,11 +1,12 @@
|
|||||||
{-# LANGUAGE TemplateHaskell, DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
module State where
|
module State where
|
||||||
|
|
||||||
import Control.Lens hiding (elements)
|
import Control.Lens hiding (elements)
|
||||||
import Data.Map qualified as Map
|
import Data.Map qualified as Map
|
||||||
import Test.QuickCheck
|
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
|
import Test.QuickCheck
|
||||||
|
|
||||||
-- The exec stack must store heterogenous types,
|
-- The exec stack must store heterogenous types,
|
||||||
-- and we must be able to detect that type at runtime.
|
-- and we must be able to detect that type at runtime.
|
||||||
@ -26,7 +27,7 @@ data Gene
|
|||||||
| PlaceInput String
|
| PlaceInput String
|
||||||
| Close
|
| Close
|
||||||
| Block [Gene]
|
| Block [Gene]
|
||||||
deriving Generic
|
deriving (Generic)
|
||||||
|
|
||||||
instance Eq Gene where
|
instance Eq Gene where
|
||||||
GeneInt x == GeneInt y = x == y
|
GeneInt x == GeneInt y = x == y
|
||||||
@ -64,8 +65,9 @@ instance Show Gene where
|
|||||||
instance CoArbitrary Gene
|
instance CoArbitrary Gene
|
||||||
|
|
||||||
instance Arbitrary Gene where
|
instance Arbitrary Gene where
|
||||||
arbitrary = oneof [
|
arbitrary =
|
||||||
GeneInt <$> arbitrary,
|
oneof
|
||||||
|
[ GeneInt <$> arbitrary,
|
||||||
GeneFloat <$> arbitrary,
|
GeneFloat <$> arbitrary,
|
||||||
GeneBool <$> arbitrary,
|
GeneBool <$> arbitrary,
|
||||||
GeneString <$> arbitrary,
|
GeneString <$> arbitrary,
|
||||||
@ -120,6 +122,7 @@ instance Arbitrary State where
|
|||||||
arbParameter <- arbitrary
|
arbParameter <- arbitrary
|
||||||
-- arbInput <- arbitrary
|
-- arbInput <- arbitrary
|
||||||
State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary
|
State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary
|
||||||
|
|
||||||
-- Thanks hlint lol
|
-- Thanks hlint lol
|
||||||
|
|
||||||
instance CoArbitrary State
|
instance CoArbitrary State
|
||||||
|
Loading…
x
Reference in New Issue
Block a user