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 qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (inits)
data Value = BoolV Bool
| IntV Int
@ -219,13 +220,13 @@ fillHoles (Hole :+: Hole) [left, right] = left :+: right
fillHoles (Hole :-: Hole) [left, right] = left :-: right
fillHoles (IncE Hole) [e] = IncE e
fillHoles (DecE Hole) [e] = DecE e
-- fillHoles ZeroE
fillHoles ZeroE [] = ZeroE
fillHoles (Div2E Hole) [e] = Div2E e
fillHoles (TailE Hole) [e] = TailE e
fillHoles (HeadE Hole) [e] = HeadE e
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 (TreeValE Hole) [e] = TreeValE e
fillHoles (TreeLeftE Hole) [e] = TreeLeftE e
@ -336,22 +337,34 @@ patterns3 :: [Expr]
patterns3 = [CreateNodeE {nodeLeft = Hole, nodeRoot = Hole, nodeRight = Hole},
IfE {ifCond = Hole, ifDoThen = Hole, ifDoElse = Hole}]
genNext1 :: [[Expr]] -> [Expr]
genNext1 = head
concatShuffle :: [[a]] -> [a]
concatShuffle xxs = let xxs' = filter (not . null) xxs in
if null xxs' then [] else
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 exprs = let len = length exprs in
take ((len + 1) `div` 2) $
let exprs' = tail exprs in
concatShuffle $
zipWith (\xs ys -> ([(x, y) | x <- xs, y <- ys])) exprs $
reverse exprs
zipWith (\xs ys -> ([(x, y) | x <- xs, y <- ys])) 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 = 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]]