formatting

This commit is contained in:
Rowan Torbitzky-Lane 2025-02-01 00:18:17 -06:00
parent e5285e5c8f
commit 32b48b79d0
5 changed files with 95 additions and 86 deletions

View File

@ -120,4 +120,6 @@ test-suite HushGP-test
build-depends: build-depends:
base, base,
HushGP, HushGP,
QuickCheck QuickCheck,
lens

View File

@ -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

View File

@ -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

View File

@ -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