mirror of
https://codeberg.org/ProgramSnail/prog_synthesis.git
synced 2025-12-05 21:18:42 +00:00
02: fixes, different gen separation, ~unique expr gen
This commit is contained in:
ProgramSnail
parent
5e7729e4ac
commit
bcfed9769c
1 changed files with 105 additions and 19 deletions
124
02.hs
124
02.hs
|
|
@ -62,24 +62,86 @@ execProg :: [Int] -> Expr -> Maybe [Int]
|
|||
execProg input expr = execList (Env {input, prog=expr, steps=20}) expr
|
||||
|
||||
terminals :: [Expr]
|
||||
terminals = [Zero, ZeroList, InList]
|
||||
terminals = [Zero, ZeroList, InList,
|
||||
Len InList, FirstZero InList, Succ Zero]
|
||||
|
||||
concatShuffle :: [[Expr]] -> [Expr]
|
||||
concatShuffle xxs = let xxs' = filter (not . null) xxs in
|
||||
if null xxs' then [] else
|
||||
map head xxs' ++ concatShuffle (map tail xxs')
|
||||
|
||||
nextSimpleExprsLists :: [Expr] -> [[Expr]]
|
||||
nextSimpleExprsLists exprs = [[Succ e | e <- exprs, typeOf e == IntT],
|
||||
[Sort e | e <- exprs, typeOf e == ListT],
|
||||
[Recursive e | e <- exprs, typeOf e == ListT],
|
||||
[FirstZero e | e <- exprs, typeOf e == ListT],
|
||||
[Len e | e <- exprs, typeOf e == ListT]]
|
||||
|
||||
nextExprsLists :: [Expr] -> [[Expr]]
|
||||
nextExprsLists exprs = nextSimpleExprsLists exprs ++
|
||||
[[e :+: e' | e <- exprs, typeOf e == ListT,
|
||||
e' <- exprs, typeOf e' == ListT],
|
||||
[SubList e from to | e <- exprs, typeOf e == ListT,
|
||||
from <- exprs, typeOf from == IntT,
|
||||
to <- exprs, typeOf to == IntT]]
|
||||
|
||||
nextSimpleExprs :: [Expr] -> [Expr]
|
||||
nextSimpleExprs exprs = (++) exprs $ concatShuffle $ nextSimpleExprsLists exprs
|
||||
|
||||
nextExprs :: [Expr] -> [Expr]
|
||||
nextExprs exprs = concatShuffle $ [exprs]
|
||||
++ [[Succ e | e <- exprs, typeOf e == IntT]]
|
||||
++ [[Sort e, Recursive e, FirstZero e, Len e] | e <- exprs, typeOf e == ListT]
|
||||
++ [[e :+: e' |
|
||||
e <- exprs, typeOf e == ListT,
|
||||
e' <- exprs, typeOf e' == ListT]]
|
||||
++ [[SubList InList from to |
|
||||
-- e <- exprs, typeOf e == ListT,
|
||||
from <- exprs, typeOf from == IntT,
|
||||
to <- exprs, typeOf to == IntT]]
|
||||
nextExprs exprs = (++) exprs $ concatShuffle $ nextExprsLists exprs
|
||||
|
||||
-- NOTE: slower version due to additional elem checks
|
||||
-- nextExprsLists' :: [Expr] -> [Expr] -> [[Expr]]
|
||||
-- nextExprsLists' prevExprs allExprs = nextSimpleExprsLists prevExprs ++
|
||||
-- [[e :+: e' | e <- allExprs, typeOf e == ListT,
|
||||
-- e' <- allExprs, typeOf e' == ListT,
|
||||
-- e `elem` prevExprs || e' `elem` prevExprs],
|
||||
-- [SubList e from to | e <- allExprs, typeOf e == ListT,
|
||||
-- from <- allExprs, typeOf from == IntT,
|
||||
-- to <- allExprs, typeOf to == IntT,
|
||||
-- e `elem` prevExprs || from `elem` prevExprs || to `elem` prevExprs]]
|
||||
|
||||
nextSimpleExprs' :: [Expr] -> [Expr]
|
||||
nextSimpleExprs' = concatShuffle . nextSimpleExprsLists
|
||||
|
||||
-- TODO: check formula for three args
|
||||
nextExprsLists' :: [Expr] -> [Expr] -> [[Expr]]
|
||||
nextExprsLists' prevExprs allExprs = nextSimpleExprsLists prevExprs ++
|
||||
[[e :+: e' | e <- prevExprs, typeOf e == ListT,
|
||||
e' <- allExprs, typeOf e' == ListT],
|
||||
[e :+: e' | e <- allExprs, typeOf e == ListT, e `notElem` prevExprs,
|
||||
e' <- prevExprs, typeOf e' == ListT],
|
||||
[SubList e from to | e <- prevExprs, typeOf e == ListT,
|
||||
from <- allExprs, typeOf from == IntT,
|
||||
to <- allExprs, typeOf to == IntT],
|
||||
[SubList e from to | e <- allExprs, typeOf e == ListT, e `notElem` prevExprs,
|
||||
from <- prevExprs, typeOf from == IntT,
|
||||
to <- allExprs, typeOf to == IntT],
|
||||
[SubList e from to | e <- allExprs, typeOf e == ListT, e `notElem` prevExprs,
|
||||
from <- allExprs, typeOf from == IntT, from `notElem` prevExprs,
|
||||
to <- prevExprs, typeOf to == IntT]]
|
||||
|
||||
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]}
|
||||
|
||||
|
|
@ -97,24 +159,48 @@ areSame examples exprLeft exprRight | typeOf exprLeft == IntT = False
|
|||
| typeOf exprRight == IntT = False
|
||||
| otherwise = all (\Example {exampleInput, exampleOutput} -> execProg exampleInput exprLeft == execProg exampleInput exprRight ) examples
|
||||
|
||||
-----
|
||||
|
||||
upSyntesisStep :: [Example] -> [Expr] -> Either [Expr] Expr
|
||||
upSyntesisStep examples exprs = 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
|
||||
case find (isCorrect examples) exprs'' of
|
||||
Just answer -> Right answer
|
||||
Nothing -> Left $ nextExprs exprs''
|
||||
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'
|
||||
|
||||
upSyntesisRec :: [Example] -> Int -> [Expr] -> Maybe Expr
|
||||
upSyntesisRec _ 0 _ = Nothing
|
||||
upSyntesisRec examples steps exprs = case upSyntesisStep examples exprs of
|
||||
Right answer -> Just answer
|
||||
Left exprs' -> upSyntesisRec examples (steps - 1) exprs'
|
||||
Right answer -> Just answer
|
||||
Left exprs' -> upSyntesisRec examples (steps - 1) exprs'
|
||||
|
||||
|
||||
upSyntesis :: [Example] -> Int -> Maybe Expr
|
||||
upSyntesis examples steps = upSyntesisRec examples steps terminals
|
||||
|
||||
-----
|
||||
|
||||
upSyntesisStep' :: [Example] -> [Expr] -> [Expr] -> Either [Expr] Expr
|
||||
upSyntesisStep' examples prevExprs allExprs =
|
||||
case find (isCorrect examples) prevExprs of
|
||||
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'
|
||||
|
||||
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)
|
||||
|
||||
upSyntesis' :: [Example] -> Int -> Maybe Expr
|
||||
upSyntesis' examples steps = upSyntesisRec' examples steps terminals terminals
|
||||
|
||||
-----
|
||||
|
||||
exampleOf :: [Int] -> [Int] -> Example
|
||||
exampleOf input output = Example {exampleInput = input, exampleOutput = output}
|
||||
|
||||
|
|
@ -123,4 +209,4 @@ sameExamples = [exampleOf [1] [1], exampleOf [1,2] [1,2], exampleOf [1,2,3] [1,2
|
|||
revExamplesExpected = Recursive (SubList InList (Succ Zero) (Len InList)) :+: SubList InList Zero Zero
|
||||
revExamples = [exampleOf [1] [1], exampleOf [1,2] [2,1], exampleOf [1,2,3] [3,2,1], exampleOf [1,2,3,4] [4,3,2,1]]
|
||||
|
||||
main = print $ upSyntesis revExamples 5
|
||||
main = print $ upSyntesis' revExamples 4
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue