From 597f34e7092cad66be12ee4a3e04b13f3239c85e Mon Sep 17 00:00:00 2001 From: ProgramSnail Date: Tue, 23 Sep 2025 11:40:41 +0300 Subject: [PATCH] 02: fixes --- 02.hs | 40 ++++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 14 deletions(-) diff --git a/02.hs b/02.hs index 5cbc78e..afd3d75 100644 --- a/02.hs +++ b/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