02: fixes, different gen separation, ~unique expr gen

02.hs

@@ -62,25 +62,87 @@ 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')
 
-nextExprs :: [Expr] -> [Expr]
+nextSimpleExprsLists :: [Expr] -> [[Expr]]
-nextExprs exprs = concatShuffle $ [exprs]
+nextSimpleExprsLists exprs = [[Succ e | e <- exprs, typeOf e == IntT],
-                        ++ [[Succ e | e <- exprs, typeOf e == IntT]]
+                              [Sort e | e <- exprs, typeOf e == ListT],
-                        ++ [[Sort e, Recursive e, FirstZero e, Len e] | e <- exprs, typeOf e == ListT]
+                              [Recursive e | e <- exprs, typeOf e == ListT],
-                        ++ [[e :+: e' |
+                              [FirstZero e | e <- exprs, typeOf e == ListT],
-                          e <- exprs, typeOf e == ListT,
+                              [Len e | e <- exprs, typeOf e == ListT]]
-                          e' <- exprs, typeOf e' == ListT]]
+
-                        ++ [[SubList InList from to |
+nextExprsLists :: [Expr] -> [[Expr]]
-                          -- e <- exprs, typeOf e == ListT,
+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 = (++) 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]}
 
 -- check expr on all examples
@@ -97,12 +159,14 @@ 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
+upSyntesisStep examples exprs =  case find (isCorrect examples) exprs of
-                                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''
+                                   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
@@ -110,11 +174,33 @@ upSyntesisRec examples steps exprs = case upSyntesisStep examples exprs of
                                        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