02: fixes, nextSimpleExprs & same nodes deletion integration

This commit is contained in:
ProgramSnail 2025-09-30 10:34:37 +03:00
parent bcfed9769c
commit da9ceb714e

47
02.hs
View file

@ -62,8 +62,8 @@ execProg :: [Int] -> Expr -> Maybe [Int]
execProg input expr = execList (Env {input, prog=expr, steps=20}) expr
terminals :: [Expr]
terminals = [Zero, ZeroList, InList,
Len InList, FirstZero InList, Succ Zero]
terminals = [Zero, ZeroList, InList] -- ,
-- Succ Zero, Len InList]
concatShuffle :: [[Expr]] -> [Expr]
concatShuffle xxs = let xxs' = filter (not . null) xxs in
@ -125,24 +125,6 @@ nextExprsLists' prevExprs allExprs = nextSimpleExprsLists prevExprs ++
nextExprs' :: [Expr] -> [Expr] -> [Expr]
nextExprs' prevExprs allExprs = concatShuffle $ nextExprsLists' prevExprs allExprs
-- -- do not repeat exprs
-- nextExprs' :: [Expr] -> [Expr] -> [Expr]
-- nextExprs' prevExprs allExprs = concatShuffle $ [[Succ e | e <- prevExprs, typeOf e == IntT]] ++
-- [[Sort e, Recursive e, FirstZero e, Len e] | e <- prevExprs, typeOf e == ListT]
-- ++ [[left :+: right |
-- left <- prevExprs, typeOf left == ListT,
-- right <- allExprs, typeOf right == ListT],
-- [left :+: right |
-- left <- allExprs, typeOf left == ListT, ,
-- right <- prevExprs, typeOf right == ListT],
-- [SubList e from to |
-- e <- exprs, typeOf e == ListT,
-- from <- prevExprs, typeOf from == IntT,
-- to <- allExprs, typeOf to == IntT],
-- [SubList InList from to |
-- from <- allExprs, typeOf from == IntT, from `notElem` prevExprs,
-- to <- prevExprs, typeOf to == IntT]]
data Example = Example {exampleInput :: [Int], exampleOutput :: [Int]}
-- check expr on all examples
@ -157,7 +139,9 @@ isValid examples expr | typeOf expr == IntT = True
areSame :: [Example] -> Expr -> Expr -> Bool
areSame examples exprLeft exprRight | typeOf exprLeft == IntT = False
| typeOf exprRight == IntT = False
| otherwise = all (\Example {exampleInput, exampleOutput} -> execProg exampleInput exprLeft == execProg exampleInput exprRight ) examples
| otherwise = all (\Example {exampleInput, exampleOutput} -> let Just resLeft = execProg exampleInput exprLeft in
let Just resRight = execProg exampleInput exprRight in
resLeft /= [] && resLeft == resRight) examples
-----
@ -165,8 +149,10 @@ upSyntesisStep :: [Example] -> [Expr] -> Either [Expr] Expr
upSyntesisStep examples exprs = case find (isCorrect examples) exprs of
Just answer -> Right answer
Nothing -> let exprs' = filter (isValid examples) exprs in -- exclude invalid fragments
-- let exprs'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] exprs' in -- merge same values
Left $ nextExprs exprs'
let exprs'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] exprs' in -- merge same values
Left $
nextSimpleExprs $
nextExprs exprs''
upSyntesisRec :: [Example] -> Int -> [Expr] -> Maybe Expr
upSyntesisRec _ 0 _ = Nothing
@ -176,7 +162,7 @@ upSyntesisRec examples steps exprs = case upSyntesisStep examples exprs of
upSyntesis :: [Example] -> Int -> Maybe Expr
upSyntesis examples steps = upSyntesisRec examples steps terminals
upSyntesis examples steps = upSyntesisRec examples steps $ nextSimpleExprs terminals
-----
@ -186,18 +172,21 @@ upSyntesisStep' examples prevExprs allExprs =
Just answer -> Right answer
Nothing -> let allExprs' = filter (isValid examples) allExprs in -- exclude invalid fragments
let prevExprs' = filter (isValid examples) prevExprs in -- exclude invalid fragments
-- let allExprs'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] allExprs' in -- merge same values
-- let prevExprs'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] prevExprs' in -- merge same values
Left $ nextExprs' prevExprs' allExprs'
let allExprs'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] allExprs' in -- merge same values
let prevExprs'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] prevExprs' in -- merge same values
Left $
-- nextSimpleExprs $
nextExprs' prevExprs'' allExprs''
upSyntesisRec' :: [Example] -> Int -> [Expr] -> [Expr] -> Maybe Expr
upSyntesisRec' _ 0 _ _ = Nothing
upSyntesisRec' examples steps prevExprs allExprs = case upSyntesisStep' examples prevExprs allExprs of
Right answer -> Just answer
Left exprs -> upSyntesisRec' examples (steps - 1) exprs (allExprs ++ exprs)
Left exprs -> upSyntesisRec' examples (steps - 1) exprs (allExprs ++ exprs)
upSyntesis' :: [Example] -> Int -> Maybe Expr
upSyntesis' examples steps = upSyntesisRec' examples steps terminals terminals
upSyntesis' examples steps = let terminals' = nextSimpleExprs terminals in
upSyntesisRec' examples steps terminals' terminals'
-----