rowan.a.tl/HushGP
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

formatting

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
HushGP.cabal
View File

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

46
src/Instructions.hs
View File

@ -1,30 +1,30 @@
module Instructions (
module Instructions.GenericInstructions,
module Instructions.IntInstructions,
module Instructions.FloatInstructions,
module Instructions.StringInstructions,
module Instructions.CharInstructions,
module Instructions.CodeInstructions,
module Instructions.ExecInstructions,
module Instructions.LogicalInstructions,
module Instructions.VectorIntInstructions,
module Instructions.VectorFloatInstructions,
module Instructions.VectorStringInstructions,
module Instructions.VectorLogicalInstructions,
module Instructions.VectorCharInstructions
)
module Instructions
( module Instructions.GenericInstructions,
module Instructions.IntInstructions,
module Instructions.FloatInstructions,
module Instructions.StringInstructions,
module Instructions.CharInstructions,
module Instructions.CodeInstructions,
module Instructions.ExecInstructions,
module Instructions.LogicalInstructions,
module Instructions.VectorIntInstructions,
module Instructions.VectorFloatInstructions,
module Instructions.VectorStringInstructions,
module Instructions.VectorLogicalInstructions,
module Instructions.VectorCharInstructions,
)
where
import Instructions.GenericInstructions
import Instructions.IntInstructions
import Instructions.FloatInstructions
import Instructions.StringInstructions
import Instructions.CharInstructions
import Instructions.CodeInstructions
import Instructions.ExecInstructions
import Instructions.FloatInstructions
import Instructions.GenericInstructions
import Instructions.IntInstructions
import Instructions.LogicalInstructions
import Instructions.VectorIntInstructions
import Instructions.VectorFloatInstructions
import Instructions.VectorStringInstructions
import Instructions.VectorLogicalInstructions
import Instructions.StringInstructions
import Instructions.VectorCharInstructions
import Instructions.VectorFloatInstructions
import Instructions.VectorIntInstructions
import Instructions.VectorLogicalInstructions
import Instructions.VectorStringInstructions

86
src/LearnQuickCheck.hs
View File

@ -2,11 +2,11 @@ module LearnQuickCheck where
-- https://jesper.sikanda.be/posts/quickcheck-intro.html
import Test.QuickCheck
import Data.List (sort)
import Control.Monad
import Data.List (sort)
import Test.QuickCheck
qsort :: Ord a => [a] -> [a]
qsort :: (Ord a) => [a] -> [a]
qsort = sort
distance :: Int -> Int -> Int
@ -27,8 +27,8 @@ bad_distance x y = y - x
prop_dist_symmetric_fail :: Int -> Int -> Bool
prop_dist_symmetric_fail x y = bad_distance x y == bad_distance y x
sorted :: Ord a => [a] -> Bool
sorted (x:y:ys) = x <= y && sorted (y:ys)
sorted :: (Ord a) => [a] -> Bool
sorted (x : y : ys) = x <= y && sorted (y : ys)
sorted _ = True
prop_sorted :: [Int] -> Bool
@ -37,13 +37,15 @@ prop_sorted xs = sorted xs
-- roundtrip property
insert :: Int -> [Int] -> [Int]
insert x [] = [x]
insert x (y:ys) | x <= y = x:y:ys
| otherwise = y:insert x ys
insert x (y : ys)
| x <= y = x : y : ys
| otherwise = y : insert x ys
delete :: Int -> [Int] -> [Int]
delete x [] = []
delete x (y:ys) | x == y = ys
| otherwise = y:delete x ys
delete x (y : ys)
| x == y = ys
| otherwise = y : delete x ys
prop_insert_delete :: [Int] -> Int -> Bool
prop_insert_delete xs x = delete x (insert x xs) == xs
@ -53,24 +55,24 @@ prop_qsort_sort :: [Int] -> Bool
prop_qsort_sort xs = qsort xs == sort xs
-- 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
-- Algebraic Laws
vAdd :: (Int, Int) -> (Int, Int) -> (Int, Int)
vAdd :: (Int, Int) -> (Int, Int) -> (Int, Int)
vAdd tup0 tup1 = (fst tup0 + fst tup1, snd tup0 + snd tup1)
prop_vAdd_commutative :: (Int,Int) -> (Int,Int) -> Bool
prop_vAdd_commutative :: (Int, Int) -> (Int, Int) -> Bool
prop_vAdd_commutative v w = vAdd v w == vAdd w v
prop_vAdd_associative :: (Int,Int) -> (Int,Int) -> (Int,Int) -> Bool
prop_vAdd_associative :: (Int, Int) -> (Int, Int) -> (Int, Int) -> Bool
prop_vAdd_associative u v w = vAdd (vAdd u v) w == vAdd u (vAdd v w)
prop_vAdd_neutral_left :: (Int,Int) -> Bool
prop_vAdd_neutral_left u = vAdd (0,0) u == u
prop_vAdd_neutral_left :: (Int, Int) -> Bool
prop_vAdd_neutral_left u = vAdd (0, 0) u == u
prop_vAdd_neutral_right :: (Int,Int) -> Bool
prop_vAdd_neutral_right u = vAdd u (0,0) == u
prop_vAdd_neutral_right :: (Int, Int) -> Bool
prop_vAdd_neutral_right u = vAdd u (0, 0) == u
prop_qsort_idempotent :: [Int] -> Bool
prop_qsort_idempotent xs = qsort (qsort xs) == qsort xs
@ -80,7 +82,7 @@ prop_qsort_idempotent xs = qsort (qsort xs) == qsort xs
-- prop_replicate n x i = replicate n x !! i == x
prop_replicate :: Int -> Int -> Int -> Property
prop_replicate n x i =
prop_replicate n x i =
(i >= 0 && i < n) ==> replicate n (x :: Int) !! i == x
prop_insert_sorted :: Int -> [Int] -> Property
@ -92,23 +94,22 @@ prop_insert_sorted' x = forAll orderedList (\xs -> sorted (insert x xs))
-- Testing properties of functions
prop_filter :: Fun Int Bool -> [Int] -> Property
prop_filter p xs =
-- Filter elements not satisfying p.
let ys = [ x | x <- xs , applyFun p x ]
-- If any elements are left...
in ys /= [] ==>
-- ...generate a random index i...
forAll (choose (0,length ys-1))
-- ...and test if p (ys!!i) holds.
(\i -> applyFun p (ys!!i))
prop_filter p xs =
-- Filter elements not satisfying p.
let ys = [x | x <- xs, applyFun p x]
in -- If any elements are left...
ys /= [] ==>
-- ...generate a random index i...
forAll
(choose (0, length ys - 1))
-- ...and test if p (ys!!i) holds.
(\i -> applyFun p (ys !! i))
prop_bananas :: Fun String Int -> Bool
prop_bananas f =
applyFun f "banana" == applyFun f "monkey" ||
applyFun f "banana" == applyFun f "elephant" ||
applyFun f "monkey" == applyFun f "elephant"
prop_bananas f =
applyFun f "banana" == applyFun f "monkey"
|| applyFun f "banana" == applyFun f "elephant"
|| applyFun f "monkey" == applyFun f "elephant"
-- main :: IO ()
-- main = do
@ -167,22 +168,25 @@ instance Arbitrary Point where
x <- arbitrary
-- y <- arbitrary
-- return $ Pt x y
-- could do
-- could do
Pt x <$> arbitrary
data Set a = Set [a]
instance (Show a) => Show (Set a) where
show s = showSet s where
showSet (Set []) = "{}"
showSet (Set (x:xs)) = "{" <> show x <> showSubSet xs <> "}" where
showSubSet [] = ""
showSubSet (ix:ixs) = "," <> show ix <> showSubSet ixs
show s = showSet s
where
showSet (Set []) = "{}"
showSet (Set (x : xs)) = "{" <> show x <> showSubSet xs <> "}"
where
showSubSet [] = ""
showSubSet (ix : ixs) = "," <> show ix <> showSubSet ixs
instance (Arbitrary a) => Arbitrary (Set a) where
arbitrary = do Set <$> arbitrary
-- list <- arbitrary
-- return $ Set list
-- list <- arbitrary
-- return $ Set list
-- sample $ (arbitrary :: Gen (Set Int))

2
src/Push.hs
View File

@ -64,7 +64,7 @@ interpretExec state@(State {_exec = e : es}) =
(StateFunc func) -> interpretExec $ func state {_exec = es}
(Block block) -> interpretExec (state {_exec = block ++ es})
(PlaceInput val) -> interpretExec (state {_exec = (view input state Map.! val) : es})
Close -> undefined -- This should be removed later. Will be converted to Blocks in the Plushy -> Exec stack process
Close -> undefined -- This should be removed later. Will be converted to Blocks in the Plushy -> Exec stack process
interpretExec state = state
-- Need to make interpretExec strict, right?

43
src/State.hs
View File

@ -1,11 +1,12 @@
{-# LANGUAGE TemplateHaskell, DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module State where
import Control.Lens hiding (elements)
import Data.Map qualified as Map
import Test.QuickCheck
import GHC.Generics
import Test.QuickCheck
-- The exec stack must store heterogenous types,
-- and we must be able to detect that type at runtime.
@ -26,7 +27,7 @@ data Gene
| PlaceInput String
| Close
| Block [Gene]
deriving Generic
deriving (Generic)
instance Eq Gene where
GeneInt x == GeneInt y = x == y
@ -64,22 +65,23 @@ instance Show Gene where
instance CoArbitrary Gene
instance Arbitrary Gene where
arbitrary = oneof [
GeneInt <$> arbitrary,
GeneFloat <$> arbitrary,
GeneBool <$> arbitrary,
GeneString <$> arbitrary,
GeneChar <$> arbitrary,
StateFunc <$> arbitrary,
PlaceInput <$> arbitrary,
GeneVectorInt <$> arbitrary,
GeneVectorFloat <$> arbitrary,
GeneVectorBool <$> arbitrary,
GeneVectorString <$> arbitrary,
GeneVectorChar <$> arbitrary,
Block <$> arbitrary,
return Close
]
arbitrary =
oneof
[ GeneInt <$> arbitrary,
GeneFloat <$> arbitrary,
GeneBool <$> arbitrary,
GeneString <$> arbitrary,
GeneChar <$> arbitrary,
StateFunc <$> arbitrary,
PlaceInput <$> arbitrary,
GeneVectorInt <$> arbitrary,
GeneVectorFloat <$> arbitrary,
GeneVectorBool <$> arbitrary,
GeneVectorString <$> arbitrary,
GeneVectorChar <$> arbitrary,
Block <$> arbitrary,
return Close
]
data State = State
{ _exec :: [Gene],
@ -120,7 +122,8 @@ instance Arbitrary State where
arbParameter <- arbitrary
-- arbInput <- 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