st/prog_synthesis
1
0
Fork 0
mirror of https://codeberg.org/ProgramSnail/prog_synthesis.git synced 2025-12-05 21:18:42 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

02: unique exprs: pass old exprs without last ones into the function

Browse source
This commit is contained in:
ProgramSnail 2025-09-30 10:59:11 +03:00
parent bffbf6e0b2
commit 67fabd4dc2
1 changed files with 25 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

65
02.hs
View file

@ -92,41 +92,28 @@ nextSimpleExprs exprs = (++) exprs $ concatShuffle $ nextSimpleExprsLists exprs
nextExprs :: [Expr] -> [Expr]
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 = let notPrevExprs = [e | e <- allExprs, e `notElem` prevExprs] in
let listPrevExprs = [ e | e <- prevExprs, typeOf e == ListT] in
let intPrevExprs = [ e | e <- prevExprs, typeOf e == IntT] in
let listNotPrevExprs = [ e | e <- notPrevExprs, typeOf e == ListT] in
let intNotPrevExprs = [ e | e <- notPrevExprs, typeOf e == IntT] in
nextSimpleExprsLists prevExprs ++
[[e :+: e' | e <- listPrevExprs, e' <- listPrevExprs],
[e :+: e' | e <- listPrevExprs, e' <- listNotPrevExprs],
[e :+: e' | e <- listNotPrevExprs, e' <- listPrevExprs],
[SubList e from to | e <- listPrevExprs, from <- intPrevExprs, to <- intPrevExprs],
[SubList e from to | e <- listNotPrevExprs, from <- intPrevExprs, to <- intPrevExprs],
[SubList e from to | e <- listPrevExprs, from <- intNotPrevExprs, to <- intPrevExprs],
[SubList e from to | e <- listPrevExprs, from <- intPrevExprs, to <- intNotPrevExprs],
[SubList e from to | e <- listNotPrevExprs, from <- intNotPrevExprs, to <- intPrevExprs],
[SubList e from to | e <- listNotPrevExprs, from <- intPrevExprs, to <- intNotPrevExprs],
[SubList e from to | e <- listPrevExprs, from <- intNotPrevExprs, to <- intNotPrevExprs]]
nextExprsLists' newExprs oldExprs = let listNewExprs = [ e | e <- newExprs, typeOf e == ListT] in
let intNewExprs = [ e | e <- newExprs, typeOf e == IntT] in
let listOldExprs = [ e | e <- oldExprs, typeOf e == ListT] in
let intOldExprs = [ e | e <- oldExprs, typeOf e == IntT] in
nextSimpleExprsLists newExprs ++
[[e :+: e' | e <- listNewExprs, e' <- listNewExprs],
[e :+: e' | e <- listNewExprs, e' <- listOldExprs],
[e :+: e' | e <- listOldExprs, e' <- listNewExprs],
[SubList e from to | e <- listNewExprs, from <- intNewExprs, to <- intNewExprs],
[SubList e from to | e <- listOldExprs, from <- intNewExprs, to <- intNewExprs],
[SubList e from to | e <- listNewExprs, from <- intOldExprs, to <- intNewExprs],
[SubList e from to | e <- listNewExprs, from <- intNewExprs, to <- intOldExprs],
[SubList e from to | e <- listOldExprs, from <- intOldExprs, to <- intNewExprs],
[SubList e from to | e <- listOldExprs, from <- intNewExprs, to <- intOldExprs],
[SubList e from to | e <- listNewExprs, from <- intOldExprs, to <- intOldExprs]]
nextExprs' :: [Expr] -> [Expr] -> [Expr]
nextExprs' prevExprs allExprs = concatShuffle $ nextExprsLists' prevExprs allExprs
nextExprs' newExprs oldExprs = concatShuffle $ nextExprsLists' newExprs oldExprs
data Example = Example {exampleInput :: [Int], exampleOutput :: [Int]}
@ -171,26 +158,24 @@ upSyntesis examples steps = upSyntesisRec examples steps $ nextSimpleExprs termi
-----
upSyntesisStep' :: [Example] -> [Expr] -> [Expr] -> Either [Expr] Expr
upSyntesisStep' examples prevExprs allExprs =
case find (isCorrect examples) prevExprs of
upSyntesisStep' examples newExprs oldExprs =
case find (isCorrect examples) newExprs 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
Nothing -> let newExprs' = filter (isValid examples) newExprs in -- exclude invalid fragments
-- NOTE: new exprs are not checked against old exprs for now
let newExprs'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] newExprs' in -- merge same values
Left $
-- nextSimpleExprs $
nextExprs' prevExprs'' allExprs''
nextExprs' newExprs'' oldExprs
upSyntesisRec' :: [Example] -> Int -> [Expr] -> [Expr] -> Maybe Expr
upSyntesisRec' _ 0 _ _ = Nothing
upSyntesisRec' examples steps prevExprs allExprs = case upSyntesisStep' examples prevExprs allExprs of
upSyntesisRec' examples steps newExprs oldExprs = case upSyntesisStep' examples newExprs oldExprs of
Right answer -> Just answer
Left exprs -> upSyntesisRec' examples (steps - 1) exprs (allExprs ++ exprs)
Left exprs -> upSyntesisRec' examples (steps - 1) exprs (newExprs ++ oldExprs)
upSyntesis' :: [Example] -> Int -> Maybe Expr
upSyntesis' examples steps = let terminals' = nextSimpleExprs terminals in
upSyntesisRec' examples steps terminals' terminals'
upSyntesis' examples steps = upSyntesisRec' examples steps (nextSimpleExprs terminals) []
-----