From 8d01d9a20837614a8b71578686d0b1df2dbf8234 Mon Sep 17 00:00:00 2001
From: Rowan Torbitzky-Lane <rowan.a.tl@protonmail.com>
Date: Thu, 30 Jan 2025 20:59:36 -0600
Subject: [PATCH] burned out of quick check for today, more later

---
 HushGP.cabal           |   3 +-
 src/LearnQuickCheck.hs | 134 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 136 insertions(+), 1 deletion(-)
 create mode 100644 src/LearnQuickCheck.hs

diff --git a/HushGP.cabal b/HushGP.cabal
index 7e224d7..1cc07e2 100644
--- a/HushGP.cabal
+++ b/HushGP.cabal
@@ -52,6 +52,7 @@ library
                     , Instructions.VectorStringInstructions
                     , Instructions.VectorLogicalInstructions
                     , Instructions.VectorCharInstructions
+                    , LearnQuickCheck
 
     -- Modules included in this library but not exported.
     -- other-modules:
@@ -61,7 +62,7 @@ library
 
     -- Other library packages from which modules are imported.
     build-depends:
-        base, containers, lens, split
+        base, containers, lens, split, QuickCheck
 
     -- Directories containing source files.
     hs-source-dirs:   src
diff --git a/src/LearnQuickCheck.hs b/src/LearnQuickCheck.hs
new file mode 100644
index 0000000..aaef6fc
--- /dev/null
+++ b/src/LearnQuickCheck.hs
@@ -0,0 +1,134 @@
+module LearnQuickCheck where
+
+-- https://jesper.sikanda.be/posts/quickcheck-intro.html
+
+import Test.QuickCheck
+import Data.List (sort)
+
+qsort :: Ord a => [a] -> [a]
+qsort = sort
+
+distance :: Int -> Int -> Int
+distance x y = abs (x - y)
+
+prop_dist35 :: Bool
+prop_dist35 = distance 3 5 == 2
+
+prop_dist_self :: Int -> Bool
+prop_dist_self x = distance x x == 0
+
+prop_dist_symmetric :: Int -> Int -> Bool
+prop_dist_symmetric x y = distance x y == distance y x
+
+bad_distance :: Int -> Int -> Int
+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 _ = True
+
+prop_sorted :: [Int] -> Bool
+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
+
+delete :: Int -> [Int] -> [Int]
+delete x [] = []
+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
+
+-- Equivalent Property
+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' xs = qsort xs == sort xs
+
+-- Algebraic Laws
+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 v w = vAdd v w == vAdd w v
+
+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_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
+
+-- Testing with different distributions section
+-- prop_replicate :: Int -> Int -> Int -> Bool
+-- prop_replicate n x i = replicate n x !! i == x
+
+prop_replicate :: Int -> Int -> Int -> Property
+prop_replicate n x i = 
+  (i >= 0 && i < n) ==> replicate n (x :: Int) !! i == x
+
+prop_insert_sorted :: Int -> [Int] -> Property
+prop_insert_sorted x xs = sorted xs ==> sorted (insert x xs)
+
+-- Quantified properties
+prop_insert_sorted' :: Int -> Property
+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_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"
+
+main :: IO ()
+main = do
+  quickCheck prop_dist35
+  quickCheck prop_dist_self
+  quickCheck prop_dist_symmetric
+  -- Roundtrip tests
+  quickCheck prop_insert_delete
+  -- Equivalent tests
+  quickCheck prop_qsort_sort
+  -- quickCheck prop_qsort_sort'
+  -- Algebraic tests
+  quickCheck prop_vAdd_commutative
+  quickCheck prop_vAdd_associative
+  quickCheck prop_vAdd_neutral_left
+  quickCheck prop_vAdd_neutral_right
+  -- Testing with different distributions
+  quickCheck prop_replicate
+  quickCheck prop_insert_sorted
+  -- Quantified Properties
+  quickCheck prop_insert_sorted'
+  -- Testing properties of functions
+  quickCheck prop_filter
+  quickCheck prop_bananas