mirror of
https://codeberg.org/ProgramSnail/prog_synthesis.git
synced 2025-12-06 05:28:42 +00:00
get concat shuffle from 02, part of genNexts, patterns
This commit is contained in:
parent
e78372fbfc
commit
bfbff8b7cd
1 changed files with 49 additions and 4 deletions
53
escher.hs
53
escher.hs
|
|
@ -80,7 +80,7 @@ instance Monad Result where
|
||||||
instance Alternative Result where
|
instance Alternative Result where
|
||||||
empty = Error
|
empty = Error
|
||||||
Error <|> y = y
|
Error <|> y = y
|
||||||
NewExamples es <|> _ = NewExamples es
|
NewExamples es <|> _ = NewExamples es
|
||||||
r@(Result x) <|> _ = r
|
r@(Result x) <|> _ = r
|
||||||
|
|
||||||
instance Functor Result where
|
instance Functor Result where
|
||||||
|
|
@ -246,7 +246,7 @@ confBySynt input expr st = Conf {confInput = input,
|
||||||
confExamples = syntExamples st}
|
confExamples = syntExamples st}
|
||||||
|
|
||||||
matchGoal :: Goal -> Synt -> Expr -> Bool
|
matchGoal :: Goal -> Synt -> Expr -> Bool
|
||||||
matchGoal (Goal goal) st expr = let examples = syntExamples st in
|
matchGoal (Goal goal) st expr = let examples = syntExamples st in
|
||||||
foldl checkOnInput True $ zip examples goal
|
foldl checkOnInput True $ zip examples goal
|
||||||
where checkOnInput False _ = False
|
where checkOnInput False _ = False
|
||||||
checkOnInput acc (input, output) = let output' = eval (confBySynt input expr st) expr in
|
checkOnInput acc (input, output) = let output' = eval (confBySynt input expr st) expr in
|
||||||
|
|
@ -287,8 +287,6 @@ resolveStep (ifCond, ifDoThen, ifDoElse) r = do st <- get
|
||||||
syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals st,
|
syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals st,
|
||||||
syntExprs = (expr, []) : syntExprs st }
|
syntExprs = (expr, []) : syntExprs st }
|
||||||
|
|
||||||
-- data Resolver = Resolver { resolverGoal :: Goal, resolverCond :: Goal, resolverThen :: Goal, resolverElse :: Goal } -- ids ??
|
|
||||||
|
|
||||||
-- clear goal tree up to root, add example, calculate exprs on input (could be recursive ?)
|
-- clear goal tree up to root, add example, calculate exprs on input (could be recursive ?)
|
||||||
saturateStep :: Expr -> SyntState ()
|
saturateStep :: Expr -> SyntState ()
|
||||||
saturateStep expr = do st <- get
|
saturateStep expr = do st <- get
|
||||||
|
|
@ -310,3 +308,50 @@ terminateStep :: Expr -> SyntState (Maybe Expr)
|
||||||
terminateStep expr = do st <- get
|
terminateStep expr = do st <- get
|
||||||
return $ if matchGoal (syntRoot st) st expr
|
return $ if matchGoal (syntRoot st) st expr
|
||||||
then Just expr else Nothing
|
then Just expr else Nothing
|
||||||
|
|
||||||
|
------
|
||||||
|
|
||||||
|
-- TODO: with holes ?
|
||||||
|
patterns0 :: [Expr]
|
||||||
|
patterns0 = [ZeroE, EmptyListE]
|
||||||
|
|
||||||
|
patterns1 :: [Expr]
|
||||||
|
patterns1 = [NotE Hole, IncE Hole,
|
||||||
|
DecE Hole, Div2E Hole,
|
||||||
|
TailE Hole, HeadE Hole,
|
||||||
|
IsLeafE Hole, TreeValE Hole,
|
||||||
|
TreeLeftE Hole, TreeRightE Hole,
|
||||||
|
CreateLeafE Hole, SelfE Hole,
|
||||||
|
InputE Hole]
|
||||||
|
|
||||||
|
patterns2 :: [Expr]
|
||||||
|
patterns2 = [Hole :&&: Hole,
|
||||||
|
Hole :||: Hole,
|
||||||
|
Hole :+: Hole,
|
||||||
|
Hole :-: Hole,
|
||||||
|
Hole :++: Hole,
|
||||||
|
Hole ::: Hole]
|
||||||
|
|
||||||
|
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
|
||||||
|
genNext2 :: [[Expr]] -> [(Expr, Expr)]
|
||||||
|
genNext2 exprs = let len = length exprs in
|
||||||
|
take ((len + 1) `div` 2) $
|
||||||
|
concatShuffle $
|
||||||
|
zipWith (\xs ys -> ([(x, y) | x <- xs, y <- ys])) exprs $
|
||||||
|
reverse exprs
|
||||||
|
|
||||||
|
-- beautiful way to combine ??
|
||||||
|
genNext3 :: [[Expr]] -> [(Expr, Expr, Expr)]
|
||||||
|
genNext3 = undefined
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue