diff --git a/02.hs b/02.hs index aa7f453..d81cdb0 100644 --- a/02.hs +++ b/02.hs @@ -62,8 +62,8 @@ execProg :: [Int] -> Expr -> Maybe [Int] execProg input expr = execList (Env {input, prog=expr, steps=20}) expr terminals :: [Expr] -terminals = [Zero, ZeroList, InList, - Len InList, FirstZero InList, Succ Zero] +terminals = [Zero, ZeroList, InList] -- , + -- Succ Zero, Len InList] concatShuffle :: [[Expr]] -> [Expr] concatShuffle xxs = let xxs' = filter (not . null) xxs in @@ -125,24 +125,6 @@ nextExprsLists' prevExprs allExprs = nextSimpleExprsLists prevExprs ++ 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 @@ -157,7 +139,9 @@ isValid examples expr | typeOf expr == IntT = True areSame :: [Example] -> Expr -> Expr -> Bool areSame examples exprLeft exprRight | typeOf exprLeft == IntT = False | typeOf exprRight == IntT = False - | otherwise = all (\Example {exampleInput, exampleOutput} -> execProg exampleInput exprLeft == execProg exampleInput exprRight ) examples + | otherwise = all (\Example {exampleInput, exampleOutput} -> let Just resLeft = execProg exampleInput exprLeft in + let Just resRight = execProg exampleInput exprRight in + resLeft /= [] && resLeft == resRight) examples ----- @@ -165,8 +149,10 @@ upSyntesisStep :: [Example] -> [Expr] -> Either [Expr] Expr 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' + let exprs'' = foldl (\acc expr -> if any (areSame examples expr) acc then acc else expr : acc) [] exprs' in -- merge same values + Left $ + nextSimpleExprs $ + nextExprs exprs'' upSyntesisRec :: [Example] -> Int -> [Expr] -> Maybe Expr upSyntesisRec _ 0 _ = Nothing @@ -176,7 +162,7 @@ upSyntesisRec examples steps exprs = case upSyntesisStep examples exprs of upSyntesis :: [Example] -> Int -> Maybe Expr -upSyntesis examples steps = upSyntesisRec examples steps terminals +upSyntesis examples steps = upSyntesisRec examples steps $ nextSimpleExprs terminals ----- @@ -186,18 +172,21 @@ upSyntesisStep' examples prevExprs allExprs = 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' + 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 $ + -- nextSimpleExprs $ + 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) + Left exprs -> upSyntesisRec' examples (steps - 1) exprs (allExprs ++ exprs) upSyntesis' :: [Example] -> Int -> Maybe Expr -upSyntesis' examples steps = upSyntesisRec' examples steps terminals terminals +upSyntesis' examples steps = let terminals' = nextSimpleExprs terminals in + upSyntesisRec' examples steps terminals' terminals' -----