02: fixes

02.hs

@@ -26,7 +26,7 @@ execInt :: Env -> IntExpr -> Maybe Int
 execInt (Env {input, prog, steps=0}) _ = Nothing
 execInt _ Zero = Just 0
 execInt env (Succ expr) = (+) 1 <$> execInt (stepInEnv env) expr
-execInt env (Len listExpr) = Just $ length $ execList (stepInEnv env) listExpr
+execInt env (Len listExpr) = length <$> execList (stepInEnv env) listExpr
 execInt env (FirstZero listExpr) = do value <- execList (stepInEnv env) listExpr
                                       0 `elemIndex` value
 
@@ -37,26 +37,31 @@ execList env (Sort listExpr) = sort <$> execList (stepInEnv env) listExpr
 execList env (SubList listExpr exprFrom exprTo) = do valFrom  <- execInt (stepInEnv env) exprFrom
                                                      valTo <- execInt (stepInEnv env) exprTo
                                                      listValue <- execList (stepInEnv env) listExpr
-                                                     return $ drop valFrom $ take valTo listValue
+                                                     return $ drop valFrom $ take (valTo + 1) listValue
 execList env (exprLeft :+: exprRight) = do valLeft <- execList (stepInEnv env) exprLeft
                                            valRight <- execList (stepInEnv env) exprRight
                                            return $ valLeft ++ valRight
-execList env (Recursive listExpr) = Nothing -- do listValue <- execList (stepInEnv env) listExpr
-                                    --   if null listValue then Just [] else execList (stepInEnv $ env {input = listValue}) (prog env)
+execList env (Recursive listExpr) = do listValue <- execList (stepInEnv env) listExpr
+                                       if null listValue then Just [] else execList (stepInEnv $ env {input = listValue}) (prog env)
 execList _ ZeroList = Just [0]
 execList (Env {input, prog, steps}) InList = Just input
 
 execProg :: [Int] -> ListExpr -> Maybe [Int]
-execProg input expr = execList (Env {input, prog=expr, steps=100}) expr
+execProg input expr = execList (Env {input, prog=expr, steps=20}) expr
 
 data AllExprs = AllExprs {ints :: [IntExpr], lists :: [ListExpr]}
+    deriving (Read, Show, Eq)
 
 terminals :: AllExprs
 terminals = AllExprs {ints = [Zero], lists = [ZeroList, InList]}
 
 nextExprs :: AllExprs -> AllExprs
 nextExprs (AllExprs {ints, lists}) = AllExprs {ints = map Succ ints ++ map Len lists ++ map FirstZero lists ++ ints,
-                                               lists = map Sort lists ++ zipWith3 SubList lists ints ints ++ zipWith (:+:) lists lists ++ map Recursive lists ++ lists}
+                                               lists = map Sort lists ++
+                                                       [SubList list from to | list <- lists, from <- ints, to <- ints] ++
+                                                       [left :+: right | left <- lists, right <- lists] ++
+                                                       map Recursive lists ++
+                                                       lists}
 
 data Example = Example {exampleInput :: [Int], exampleOutput :: [Int]}
 
@@ -72,11 +77,11 @@ areSame :: [Example] -> ListExpr -> ListExpr -> Bool
 areSame examples exprLeft exprRight = all (\Example {exampleInput, exampleOutput} -> execProg exampleInput exprLeft == execProg exampleInput exprRight ) examples
 
 upSyntesisStep :: [Example] -> AllExprs -> Either AllExprs ListExpr
-upSyntesisStep examples allExprs@(AllExprs {ints, lists}) = let lists = filter (isValid examples) lists in -- exclude invalid fragments
-                                                            -- let lists = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] lists' in -- merge same values
-                                                            case find (isCorrect examples) lists of
+upSyntesisStep examples allExprs@(AllExprs {ints, lists}) = let lists' = filter (isValid examples) lists in -- exclude invalid fragments
+                                                            let lists'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] lists' in -- merge same values
+                                                            case find (isCorrect examples) lists'' of
                                                               Just answer -> Right answer
-                                                              Nothing -> Left $ nextExprs allExprs
+                                                              Nothing -> Left $ nextExprs allExprs{lists=lists''}
 
 upSyntesisRec :: [Example] -> Int -> AllExprs  -> Maybe ListExpr
 upSyntesisRec _ 0 _ = Nothing
@@ -84,10 +89,17 @@ upSyntesisRec examples steps exprs = case upSyntesisStep examples exprs of
                                           Right answer -> Just answer
                                           Left exprs' -> upSyntesisRec examples (steps - 1) exprs'
 
-upSyntesis :: [Example] -> Maybe ListExpr
-upSyntesis examples = upSyntesisRec examples 1 terminals
+upSyntesis :: [Example] -> Int -> Maybe ListExpr
+upSyntesis examples steps = upSyntesisRec examples steps terminals
 
 -----
 
-syntesisTest1 = upSyntesis [Example {exampleInput = [1,2,3,4,5,6,7,8], exampleOutput = [1,2,3,4,5,6,7,8]}]
-syntesisTest2 = upSyntesis [Example {exampleInput = [1,2,3,4,5,6,7,8], exampleOutput = [8,7,6,5,4,3,2,1]}]
+exampleOf :: [Int] -> [Int] -> Example
+exampleOf input output =  Example {exampleInput = input, exampleOutput = output}
+
+-- InList
+sameExamples = [exampleOf [1] [1], exampleOf [1,2] [1,2], exampleOf [1,2,3] [1,2,3], exampleOf [1,2,3,4] [1,2,3,4]]
+-- (Recursive $ SubList InList (Suc 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