expr generation

This commit is contained in:
ProgramSnail 2025-10-19 18:31:24 +03:00
parent bfbff8b7cd
commit c61121e2da

View file

@ -6,6 +6,7 @@ import Data.Set (Set, insert)
import Data.Set (delete) import Data.Set (delete)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.List (inits)
data Value = BoolV Bool data Value = BoolV Bool
| IntV Int | IntV Int
@ -219,13 +220,13 @@ fillHoles (Hole :+: Hole) [left, right] = left :+: right
fillHoles (Hole :-: Hole) [left, right] = left :-: right fillHoles (Hole :-: Hole) [left, right] = left :-: right
fillHoles (IncE Hole) [e] = IncE e fillHoles (IncE Hole) [e] = IncE e
fillHoles (DecE Hole) [e] = DecE e fillHoles (DecE Hole) [e] = DecE e
-- fillHoles ZeroE fillHoles ZeroE [] = ZeroE
fillHoles (Div2E Hole) [e] = Div2E e fillHoles (Div2E Hole) [e] = Div2E e
fillHoles (TailE Hole) [e] = TailE e fillHoles (TailE Hole) [e] = TailE e
fillHoles (HeadE Hole) [e] = HeadE e fillHoles (HeadE Hole) [e] = HeadE e
fillHoles (Hole :++: Hole) [left, right] = left :++: right fillHoles (Hole :++: Hole) [left, right] = left :++: right
fillHoles (Hole ::: Hole) [left, right] = left ::: right fillHoles (Hole ::: Hole) [left, right] = left ::: right
-- fillHoles EmptyListE fillHoles EmptyListE [] = EmptyListE
fillHoles (IsLeafE Hole) [e] = IsLeafE e fillHoles (IsLeafE Hole) [e] = IsLeafE e
fillHoles (TreeValE Hole) [e] = TreeValE e fillHoles (TreeValE Hole) [e] = TreeValE e
fillHoles (TreeLeftE Hole) [e] = TreeLeftE e fillHoles (TreeLeftE Hole) [e] = TreeLeftE e
@ -336,22 +337,34 @@ patterns3 :: [Expr]
patterns3 = [CreateNodeE {nodeLeft = Hole, nodeRoot = Hole, nodeRight = Hole}, patterns3 = [CreateNodeE {nodeLeft = Hole, nodeRoot = Hole, nodeRight = Hole},
IfE {ifCond = Hole, ifDoThen = Hole, ifDoElse = Hole}] IfE {ifCond = Hole, ifDoThen = Hole, ifDoElse = Hole}]
genNext1 :: [[Expr]] -> [Expr]
genNext1 = head
concatShuffle :: [[a]] -> [a] concatShuffle :: [[a]] -> [a]
concatShuffle xxs = let xxs' = filter (not . null) xxs in concatShuffle xxs = let xxs' = filter (not . null) xxs in
if null xxs' then [] else if null xxs' then [] else
map head xxs' ++ concatShuffle (map tail xxs') map head xxs' ++ concatShuffle (map tail xxs')
-- 1 2 3 ... n + n (n - 1) ... 1, take (n + 1) / 2 -- -> n, +1 for top expression
genNext1 :: [[Expr]] -> [Expr]
genNext1 = head
-- 1 2 3 ... (n - 1) + (n - 1) ... 1 -> n, +1 for top expression
genNext2 :: [[Expr]] -> [(Expr, Expr)] genNext2 :: [[Expr]] -> [(Expr, Expr)]
genNext2 exprs = let len = length exprs in genNext2 exprs = let len = length exprs in
take ((len + 1) `div` 2) $ let exprs' = tail exprs in
concatShuffle $ concatShuffle $
zipWith (\xs ys -> ([(x, y) | x <- xs, y <- ys])) exprs $ zipWith (\xs ys -> ([(x, y) | x <- xs, y <- ys])) exprs' $
reverse exprs reverse exprs'
-- beautiful way to combine ?? -- map genNext2 [1, 1 2, 1 2 3, ..., 1 2 ... (n - 1)] + (n - 1) (n - 2) ... 1 -> n, +1 for top expression
genNext3 :: [[Expr]] -> [(Expr, Expr, Expr)] genNext3 :: [[Expr]] -> [(Expr, Expr, Expr)]
genNext3 = undefined genNext3 exprs = let exprs' = tail exprs in
let prefixes = map genNext2 $ tail $ inits exprs' in
let ends = reverse exprs' in
concatShuffle $
zipWith (\xys zs -> ([(x, y, z) | (x, y) <- xys, z <- zs])) prefixes ends
-- get list of patterns and holes for forward steps
genStep :: [[Expr]] -> [(Expr, [Expr])]
genStep [] = map (, []) patterns0
genStep xs = concatShuffle [[(p, [x]) | p <- patterns1, x <- genNext1 xs],
[(p, [x, y]) | p <- patterns2, (x, y) <- genNext2 xs],
[(p, [x, y, z]) | p <- patterns3, (x, y, z) <- genNext3 xs]]