-- gps2.hs: General Program Synthesis Benchmark Suite II -- -- Copyright (C) 2021 Rudy Matela -- Distributed under the 3-Clause BSD licence (see the file LICENSE). {-# LANGUAGE CPP, TemplateHaskell #-} #if __GLASGOW_HASKELL__ <= 710 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} import Data.Typeable #endif import Conjure import System.Environment (getArgs) import Data.List (findIndex, inits) -- for #1 import Data.Char (toUpper) -- for #4 import Data.Ratio ((%)) -- for #7 import Data.List (findIndices, tails, isPrefixOf) -- for #12 import Data.Maybe (fromJust) -- for #23 import Test.LeanCheck -- for #24 import Data.Express -- for #24 gps1p :: [Int] -> Maybe Int gps1p [0,-1,2] = Just 1 gps1p [-1,0,1] = Just 0 gps1p [0,-1] = Just 1 gps1p [1,-1,-1] = Just 2 gps1g :: [Int] -> Maybe Int gps1g xs = findIndex (0 >) (map sum (tail (inits xs))) gps1p2 :: Int -> [Int] -> Int gps1p2 0 [0,-1,2] = 1 gps1p2 0 [-1,0,1] = 0 gps1p2 0 [0,-1] = 1 gps1p2 0 [1,-1,-1] = 2 gps1p2 0 [0,0,0,-1] = 3 gps1p2 0 [1,0,0,-2] = 3 -- efficient gps1, unreachable performance-wise gps1g2 :: Int -> [Int] -> Int gps1g2 t [] = undefined -- 1 gps1g2 t (x:xs) = if t + x < 0 -- 7 then 0 -- 8 else 1 + gps1g2 (t + x) xs -- 15 gps1c :: IO () gps1c = do conjure "gps1" gps1p [ pr (0 :: Int) , prim "+" ((+) :: Int -> Int -> Int) , prim ">" ((>) :: Int -> Int -> Bool) , prim "foldr" (foldr :: (Int -> Int -> Int) -> Int -> [Int] -> Int) , prim "sum" (sum :: [Int] -> Int) , prim "findIndex" (findIndex :: (Int -> Bool) -> [Int] -> Maybe Int) , prim "map" (map :: ([Int] -> Int) -> [[Int]] -> [Int]) , prim "inits" (inits :: [Int] -> [[Int]]) , prim "tail" (tail :: [[Int]] -> [[Int]]) ] conjure "gps1" gps1p [ pr (0 :: Int) , prim "+" ((+) :: Int -> Int -> Int) , prim ">" ((>) :: Int -> Int -> Bool) , prim "sum" (sum :: [Int] -> Int) , prim "foldr" (foldr :: (Int -> Int -> Int) -> Int -> [Int] -> Int) , prim "findIndex" (findIndex :: (Int -> Bool) -> [Int] -> Maybe Int) , prim "map" (map :: ([Int] -> Int) -> [[Int]] -> [Int]) , prim "inits" (inits :: [Int] -> [[Int]]) , prim "tail" (tail :: [[Int]] -> [[Int]]) ] conjureWithMaxSize 4 "gps1" gps1p2 [ pr (0 :: Int) , pr (1 :: Int) , prim "+" ((+) :: Int -> Int -> Int) , prim "<" ((<) :: Int -> Int -> Bool) , prif (undefined :: Int) , prim "undefined" (undefined :: Int) ] gps2p :: Double -> Double -> Int -> Double gps2p 2 1 1 = 2 + 1 gps2p 2 1 2 = 2 + 1 + 1 + 0.5 gps2p 2 1 3 = 2 + 1 + 1 + 0.5 + 0.5 + 0.25 gps2p 3 1 1 = 3 + 1 gps2p 3 1 2 = 3 + 1 + 1/3 -- apex to apex gps2g :: Double -> Double -> Int -> Double gps2g h0 h1 0 = h0 + h1 gps2g h0 h1 n = h0 + h1 + gps2g h1 (h1 * (h1 / h0)) (n - 1) -- size 17, out of reach performance-wise gps2c :: IO () gps2c = do conjureWithMaxSize 6 "gps2" gps2p [ pr (0 :: Int) , pr (1 :: Int) , prim "*" ((*) :: Double -> Double -> Double) , prim "/" ((/) :: Double -> Double -> Double) , prim "+" ((+) :: Double -> Double -> Double) , prim "-" ((-) :: Double -> Double -> Double) ] gps3p :: String -> Int gps3p "X X X X X X X X X XXX" = 300 gps3p "11 11 11 11 11 11 11 11 11 11" = 20 -- unreachable performance wise -- I presume a correct solution would need around 30 symbols gps3c :: IO () gps3c = conjure "gps3" gps3p [] -- GPS #4: https://www.codewars.com/kata/517abf86da9663f1d2000003 -- Here we're using the problem description as in the GPS2 paper -- considering we're getting input as kebab-case. -- Nevertheless, this one is out of reach performance-wise (and OOM-wise) gps4s :: (String -> String) -> Bool gps4s g = g "the-stealth-warrior" == "theStealthWarrior" && g "camel-case" == "camelCase" && g "Kebab-Case" == "KebabCase" gps4g :: String -> String gps4g "" = "" -- gps4g ('-':c:cs) = toUpper c : gps4g cs -- gps4g ('_':c:cs) = toUpper c : gps4g cs gps4g (c:cs) = if c == '-' -- 5 then if null cs -- 8 then "" -- 9 else toUpper (head cs) : gps4g (tail cs) -- 16 else c : gps4g cs -- 19 gps4c :: IO () gps4c = do conjureFromSpecWith args{maxSize=6} "gps4" gps4s [ pr '-' , pr ("" :: String) , prim ":" ((:) :: Char -> String -> String) , prim "==" ((==) :: Char -> Char -> Bool) , prim "head" (head :: String -> Char) , prim "tail" (tail :: String -> String) , prif (undefined :: Char) , prif (undefined :: String) , prim "toUpper" (toUpper :: Char -> Char) ] -- GPS #5: Coin Sums -- https://projecteuler.net/problem=31 -- -- The problem description is inconsistent with the one given in the paper. -- -- Paper: change-making problem in USD -- Euler: How many different ways can £2 be made using any number of coins? -- -- I'm considering the Paper to be canonical, as the one in Project Euler can be solved by a constant function: -- -- solution :: Int -- solution = 6378216738 -- <-- arbitrary example here, I didn't run the numbers gps5p :: Int -> [Int] gps5p 100 = [4, 0, 0, 0] gps5p 50 = [2, 0, 0, 0] gps5p 25 = [1, 0, 0, 0] gps5p 30 = [1, 0, 1, 0] gps5p 20 = [0, 2, 0, 0] gps5p 3 = [0, 0, 0, 3] gps5s :: ([Int] -> Int -> [Int]) -> Bool gps5s t = t [25, 10, 5, 1] 100 == [4, 0, 0, 0] && t [25, 10, 5, 1] 50 == [2, 0, 0, 0] && t [25, 10, 5, 1] 25 == [1, 0, 0, 0] && t [25, 10, 5, 1] 30 == [1, 0, 1, 0] && t [25, 10, 5, 1] 20 == [0, 2, 0, 0] && t [25, 10, 5, 1] 3 == [0, 0, 0, 3] coins :: [Int] coins = [25, 10, 5, 1] gps5g :: Int -> [Int] gps5g = tell coins tell :: [Int] -> Int -> [Int] tell [] a = [] tell (n:ns) a = a `div` n : tell ns (a `mod` n) gps5c :: IO () gps5c = do -- cannot conjure directly due to needing to introduce a local definition conjure "gps5" gps5p [ ] conjureFromSpec "tell" gps5s [ pr ([] :: [Int]) , prim ":" ((:) :: Int -> [Int] -> [Int]) , prim "`div`" (div :: Int -> Int -> Int) , prim "`mod`" (mod :: Int -> Int -> Int) ] conjure "gps5" gps5p [ pr coins , prim "tell" tell ] conjure "gps5" gps5p [ pr (1 :: Int) , pr (5 :: Int) , pr (10 :: Int) , pr (25 :: Int) , pr ([] :: [Int]) , prim ":" ((:) :: Int -> [Int] -> [Int]) , prim "tell" tell ] -- GPS2#6: Cut Vector gps6g :: [Int] -> Int gps6g xs = snd $ minimum [ (abs (sum xs0 - sum xs1), i) | i <- [0 .. length xs] , let (xs0, xs1) = splitAt i xs ] -- not Conjurable due to needing local definition -- I conjecture it _perhaps-maybe_ this could be done in 3 steps, -- but I'll leave this as-is for now. gps6c :: IO () gps6c = conjure "gps6" gps6g [] -- GPS2#7: Dice Game -- https://projecteuler.net/problem=31 -- https://github.com/thelmuth/Clojush/blob/psb2-v1.0/src/clojush/problems/psb2/dice_game.clj -- again, paper and problem are inconsistent, going with paper gps7p :: Integer -> Integer -> Rational gps7p 4 6 = 1 % 4 gps7p 6 4 = 7 % 12 gps7p 2 4 = 1 % 8 gps7p 4 2 = 5 % 8 gps7p 2 6 = 1 % 12 gps7p 6 2 = 3 % 4 gps7g :: Integer -> Integer -> Rational gps7g peter colin = sum (map (min colin) [0 .. (peter-1)]) % (colin*peter) -- out of reach performance-wise gps7c :: IO () gps7c = do conjureWith args{maxSize=6} "gps7" gps7p $ take 0 [ pr (0 :: Integer) , pr (1 :: Integer) , prim "%" ((%) :: Integer -> Integer -> Rational) , prim "+" ((+) :: Integer -> Integer -> Integer) , prim "-" ((-) :: Integer -> Integer -> Integer) , prim "*" ((*) :: Integer -> Integer -> Integer) , prim "min" (min :: Integer -> Integer -> Integer) , prim ".." (enumFromTo :: Integer -> Integer -> [Integer]) , prim "map" (map :: (Integer -> Integer) -> [Integer] -> [Integer]) , prim "sum" (sum :: [Integer] -> Integer) ] gps8p :: Int -> [Int] -> (Int,Int) gps8p 2 [1,1,2] = (1,1) gps8p 3 [1,1,2] = (1,2) gps8p 2 [0,1,0,2] = (0,2) gps8g :: Int -> [Int] -> (Int,Int) gps8g x xs = head [(y,z) | y <- xs, z <- xs, y + z == x] -- this one could be generated but is a bit of a stretch... -- it is unintuitive to provide the given symbols -- gps8g :: Int -> [Int] -> (Int,Int) -- gps8g x xs = head $ filter ((x ==) . uncurry (+)) $ liftA2 (,) xs xs gps8c :: IO () gps8c = conjure "gps" gps8p [] -- GPSB#9: Fizz Buzz (CW) gps9p :: Int -> String gps9p 3 = "Fizz" gps9p 4 = "4" gps9p 5 = "Buzz" gps9p 6 = "Fizz" gps9p 10 = "Buzz" gps9p 15 = "FizzBuzz" gps9p 17 = "17" gps9g :: Int -> String gps9g x | x `div` 3 == 0 = "Fizz" -- 7 | x `div` 5 == 0 = "Buzz" -- 14 | x `div` 3 == 0 && x `div` 5 == 0 = "FizzBuzz" -- 27 | otherwise = show x -- 29 -- probably unreachable performance-wise gps9c :: IO () gps9c = conjure "gps" gps9p [] gps10p :: [Int] -> Int gps10p [1,2,3] = -5 gps10p [10,20,30] = 13 -- does not do rounding gps10g :: [Int] -> Int gps10g xs = sum $ map (\x -> x `div` 3 - 2) xs -- TODO: reachable with explicit fold? -- gps10g [] = 0 -- gps10g (x:xs) = x`div`3 - 2 : gps10g xs -- ?? -- unreachable due to lambda gps10c :: IO () gps10c = conjure "gps" gps9p [] gps11p :: Int -> Int -> Int gps11p = gcd' where gcd' :: Int -> Int -> Int gcd' 1 1 = 1 gcd' 1 2 = 1 gcd' 2 1 = 1 gcd' 2 2 = 2 gcd' 2 6 = 2 gcd' 6 2 = 2 gcd' 3 6 = 3 gcd' 6 3 = 3 gcd' 6 9 = 3 gcd' 9 6 = 3 gcd' 12 18 = 6 gps11c :: IO () gps11c = conjure "gcd a b" gps11p [ pr (0::Int) , prim "`mod`" (mod :: Int -> Int -> Int) ] -- generated function: -- gcd x 0 = x -- gcd x y = gcd y (x `mod` y) gps12p :: String -> String -> [Int] gps12p "a" "a" = [0] gps12p "aa" "a" = [0,1] gps12p "aa" "aa" = [0] gps12p "a a" "a" = [0,2] gps12p "b" "a" = [] gps12g :: String -> String -> [Int] gps12g s s' = findIndices (s' `isPrefixOf`) (tails s) gps12c :: IO () gps12c = conjure "gps12" gps12p [ prim "findIndices" (findIndices :: (String -> Bool) -> [String] -> [Int]) , prim "`isPrefixOf`" (isPrefixOf :: String -> String -> Bool) , prim "tails" (tails :: String -> [String]) ] gps13p :: [Int] -> [Int] gps13p [0,1] = [1] gps13p [1,0] = [1,0] gps13p [2,0,1] = [2,1] gps13p [1,0,1] = [1] gps13g :: [Int] -> [Int] gps13g = leaders where leaders [] = [] leaders (x:xs) = if all (x >) xs then x : leaders xs else leaders xs gps13c :: IO () gps13c = conjure "gps13_leaders" gps13p [ pr ([] :: [Int]) , prim ":" ((:) :: Int -> [Int] -> [Int]) , prim ">" ((>) :: Int -> Int -> Bool) , prim "all" (all :: (Int -> Bool) -> [Int] -> Bool) , prif (undefined :: [Int]) ] gps14p :: [Int] -> Int gps14p = undefined -- 30 symbols gps14g :: [Int] -> Int gps14g = luhn where luhn :: [Int] -> Int luhn xs = sum (firsts xs ++ map double9 (seconds xs)) where double9 :: Int -> Int double9 x = if xx > 9 then xx - 9 else xx where xx = x * 2 seconds :: [Int] -> [Int] seconds [] = [] seconds (x:y:xs) = y : seconds xs firsts :: [Int] -> [Int] firsts [] = [] firsts (x:y:xs) = x : seconds xs -- cannot Conjure directly gps14c :: IO () gps14c = conjure "gps14_luhn" gps14p [ ] gps15p :: () -> () gps15p = undefined -- skipped gps15c :: IO () gps15c = conjure "gps15_mastermind" gps15p [] gps16p :: String -> String gps16p "a" = "a" gps16p "aaa" = "a" gps16p "aa" = "aa" gps16p "a a" = " " gps16p " a " = "a" gps16p "a a " = " a" gps16p " a a " = " " gps16g1 :: String -> String gps16g1 s = if odd len then take 1 (drop (len `div` 2) s) else take 2 (drop (len `div` 2 - 1) s) where len = length s gps16g2 :: String -> String gps16g2 "" = "" gps16g2 (c:cs) = if length cs <= 1 then c : cs else gps16g2 (init cs) gps16c :: IO () gps16c = conjure "gps16_middle" gps16p [ pr "" , pr (1 :: Int) , prim "<=" ((<=) :: Int -> Int -> Bool) , prim ":" ((:) :: Char -> String -> String) , prim "length" (length :: String -> Int) , prim "init" (init :: String -> String) , prif (undefined :: String) ] gps17p :: [Int] -> Int gps17p [0,1,0] = 0 gps17p [1,1] = 1 gps17p [1,1,0] = 1 gps17p [0,1,1] = 1 gps17p [1,1,1] = 2 gps17g :: [Int] -> Int gps17g xs = pds xs where pds [] = 0 pds (x:xs) = if not (null xs) && x == head xs then x + pds xs else pds xs -- surprise: -- gps17_pds [] = 0 -- gps17_pds (x:xs) = (if not (null xs) && head xs == x then x else 0) + gps17_pds xs -- can generate at size 15 in 18 seconds -- setting limit of 5 for faster automated tests -- BENCHMARK: increase maxSize from 5 to 18 gps17c :: IO () gps17c = conjureWith args{maxSize=5} "gps17_pds" gps17p [ pr (0 :: Int) , prif (undefined :: Int) , prim "not" not , prim "null" (null :: [Int] -> Bool) , prim "==" ((==) :: Int -> Int -> Bool) , prim "head" (head :: [Int] -> Int) , prim "+" ((+) :: Int -> Int -> Int) , prim "&&" (&&) ] gps18p :: [Double] -> [Double] -> Double gps18p [1.0] [0.5] = 0.5 gps18p [2.0] [0.5] = 1.0 gps18p [1.0,1.0] [0.5,0.0] = 1.5 gps18p [1.0,1.0] [0.0,0.5] = 1.5 gps18g :: [Double] -> [Double] -> Double gps18g prices discounts = foldr (+) 0 (zipWith (*) prices (map (1-) discounts)) -- this was OOM'd gps18c :: IO () gps18c = conjureWithMaxSize 6 "gps18_price" gps18p [ pr (0 :: Double) , pr (1 :: Double) , prim "+" ((+) :: Double -> Double -> Double) , prim "*" ((*) :: Double -> Double -> Double) , prim "-" ((-) :: Double -> Double -> Double) -- , prim "foldr" (foldr :: (Double -> Double -> Double) -> Double -> [Double] -> Double) -- , prim "zipWith" (zipWith :: (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]) -- , prim "map" (map :: (Double -> Double) -> [Double] -> [Double]) ] gps19p :: Int -> Double -> Double -> Double -> Double gps19p 0 0 1.0 1.0 = 0 gps19p 1 0 1.0 1.0 = 0 gps19p 2 0 1.0 1.0 = 0 gps19p 1 0 1.0 2.0 = 1.0 gps19p 2 0 1.0 2.0 = 2.0 gps19p 1 0 0.5 1.0 = 0.5 gps19p 2 0 0.5 1.0 = 1.0 gps19g :: Int -> Double -> Double -> Double -> Double gps19g 0 total melt fall = total gps19g n total melt fall = gps19p (n-1) (max 0 (total-melt+fall)) melt fall -- size 14, out of reach performance wise. gps19c :: IO () gps19c = conjureWithMaxSize 6 "gps19_snowday" gps19p [ pr (0 :: Int) , pr (1 :: Int) , prim "max" (max :: Double -> Double -> Double) , prim "+" ((+) :: Double -> Double -> Double) , prim "-" ((-) :: Double -> Double -> Double) ] gps20p :: String -> Bool gps20p = undefined gps20c :: IO () gps20c = conjure "gps20" gps20p [ ] gps21s :: (String -> String) -> Bool gps21s s = s "word" == "word" && s "words" == "sdrow" && s "word words" == "word sdrow" && s "words word" == "sdrow word" spinSpec :: (String -> String) -> Bool spinSpec spin = spin "abc" == "abc" && spin "abcd" == "abcd" && spin "word" == "word" && spin "abcde" == "edcba" && spin "words" == "sdrow" && spin "hello" == "olleh" && spin "world" == "dlrow" spin :: String -> String spin w = if length w >= 5 then reverse w else w gps21g :: String -> String gps21g s = unwords (map spin (words s)) gps21c :: IO () gps21c = do conjureFromSpec "spin" spinSpec [ prim "length" (length :: String -> Int) , prim "reverse" (reverse :: String -> String) , prif (undefined :: String) , prim ">=" ((>=) :: Int -> Int -> Bool) , pr (5 :: Int) ] conjureFromSpec "gps21_spinwords" gps21s [ prim "words" words , prim "unwords" unwords , prim "spin" (spin :: String -> String) , prim "map" (map :: (String -> String) -> [String] -> [String]) , prim "length" (length :: String -> Int) , prim "reverse" (reverse :: String -> String) , prif (undefined :: String) , prim ">=" ((>=) :: Int -> Int -> Bool) , pr (5 :: Int) ] digits :: Int -> [Int] digits 0 = [] digits n = n `mod` 10 : digits (n `div` 10) digits' :: Int -> [Int] digits' 1 = [1] digits' 12 = [2,1] digits' 21 = [1,2] digits' 123 = [3,2,1] digits' 321 = [1,2,3] gps22p :: Int -> String gps22p = undefined gps22c :: IO () gps22c = do conjure "digits" digits' [ pr ([] :: [Int]) , prim ":" ((:) :: Int -> [Int] -> [Int]) , prim "`div`" (div :: Int -> Int -> Int) , prim "`mod`" (mod :: Int -> Int -> Int) , prim "div10" ((`div` 10) :: Int -> Int) , pr (10 :: Int) ] conjure "gps22" gps22p [ ] gps23s :: (String -> String -> String -> String) -> Bool gps23s s = s "abcd" "abcd" "abcd" == "abcd" && s "abcd" "dcba" "abcd" == "dcba" && s "abcd" "1234" "abcd" == "1234" && s "abcd" "1234" "bacd" == "2134" gps23g :: String -> String -> String -> String -- gps23g f t s = map (\c -> fromJust $ c `lookup` zipWith (,) f t) s gps23g f t s = map (fromJust . (`lookup` zipWith (,) f t)) s gps23c :: IO () gps23c = do -- cannot conjure, needs lambda conjureFromSpec "gps23" gps23s [ ] data Twitter = Tweet Int | TooMany | Empty deriving (Eq, Show) #if __GLASGOW_HASKELL__ <= 710 deriving instance Typeable Twitter instance Express Twitter where expr (Tweet n) = value "Tweet" Tweet :$ expr n expr t = val t #else deriveExpress ''Twitter #endif deriveListable ''Twitter deriveName ''Twitter instance Conjurable Twitter where conjureExpress = reifyExpress conjureEquality = reifyEquality conjureTiers = reifyTiers gps24g_twitter :: String -> Twitter gps24g_twitter "" = Empty gps24g_twitter s = if length s > 140 then TooMany else Tweet (length s) gps24s_twitter :: (String -> Twitter) -> Bool gps24s_twitter twitter = twitter "" == Empty && twitter "abcd" == Tweet 4 && twitter "0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij" == Tweet 140 && twitter "0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghijX" == TooMany gps24c :: IO () gps24c = do conjureFromSpecWith args{maxTests=360} "gps24" gps24s_twitter [ pr Empty , pr TooMany , prim "Tweet" Tweet , prif (undefined :: Twitter) , pr "" , prim ":" ((:) :: Char -> String -> String) , prim "length" (length :: String -> Int) , pr (140 :: Int) , prim ">" ((>) :: Int -> Int -> Bool) ] gps25p :: [Double] -> [Double] -> Double gps25p [0] [1] = 1 gps25p [1] [0] = 1 gps25p [-1] [1] = 2 gps25p [0,1] [1,0] = sqrt 2 gps25p [1,0] [0,1] = sqrt 2 gps25p [0,0,1] [1,0,0] = sqrt 2 gps25p [0,1,2] [1,2,3] = sqrt 3 gps25g :: [Double] -> [Double] -> Double gps25g v1 v2 = sqrt (foldr (+) 0 (map (^2) (zipWith (-) v1 v2))) -- out of reach performance-wise gps25c :: IO () gps25c = conjureWith args{maxSize=6} "gps25" gps25p [ pr (0 :: Double) , pr (2 :: Double) , prim "+" ((+) :: Double -> Double -> Double) , prim "-" ((-) :: Double -> Double -> Double) , prim "**" ((**) :: Double -> Double -> Double) , prim "zipWith" (zipWith :: (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]) , prim "map" (map :: (Double -> Double) -> [Double] -> [Double]) , prim "sqrt" (sqrt :: Double -> Double) ] main :: IO () main = do as <- getArgs case as of [] -> sequence_ gpss (n:_) -> gpss !! (read n - 1) gpss :: [IO ()] gpss = [ gps1c , gps2c , gps3c , gps4c , gps5c , gps6c , gps7c , gps8c , gps9c , gps10c , gps11c , gps12c , gps13c , gps14c , gps15c , gps16c , gps17c , gps18c , gps19c , gps20c , gps21c , gps22c , gps23c , gps24c , gps25c ]