From 1feddeed149b18ffd81fb6b92473ad4d4062cdd0 Mon Sep 17 00:00:00 2001 From: ProgramSnail Date: Thu, 18 Sep 2025 00:31:50 +0300 Subject: [PATCH] intial impl, tests (does nto work for now0 --- 02.hs | 91 ++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 62 insertions(+), 29 deletions(-) diff --git a/02.hs b/02.hs index 2a4c1c7..5cbc78e 100644 --- a/02.hs +++ b/02.hs @@ -1,4 +1,5 @@ -import Data.List (elemIndex, sort) +import Data.List (elemIndex, sort, find) +import Data.Maybe (isJust) infixl 4 :+: @@ -6,6 +7,7 @@ data IntExpr = Zero | Succ IntExpr | Len ListExpr | FirstZero ListExpr + deriving (Read, Show, Eq) data ListExpr = Sort ListExpr | SubList ListExpr IntExpr IntExpr @@ -13,48 +15,79 @@ data ListExpr = Sort ListExpr | Recursive ListExpr | ZeroList | InList + deriving (Read, Show, Eq) -execInt :: [Int] -> ListExpr -> IntExpr -> Maybe Int -execInt _ _ Zero = Just 0 -execInt input prog (Succ expr) = (+) 1 <$> execInt input prog expr -execInt input prog (Len listExpr) = Just $ length $ execList input prog listExpr -execInt input prog (FirstZero listExpr) = do value <- execList input prog listExpr - 0 `elemIndex` value +data Env = Env {input :: [Int], prog :: ListExpr, steps :: Int} + +stepInEnv :: Env -> Env +stepInEnv env@(Env {input, prog, steps}) = env { steps = steps - 1 } + +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 (FirstZero listExpr) = do value <- execList (stepInEnv env) listExpr + 0 `elemIndex` value -- TODO: limit execution steps -execList :: [Int] -> ListExpr -> ListExpr -> Maybe [Int] -execList input prog (Sort listExpr) = sort <$> execList input prog listExpr -execList input prog (SubList listExpr exprFrom exprTo) = do valFrom <-execInt input prog exprFrom - valTo <- execInt input prog exprTo - listValue <- execList input prog listExpr - return $ drop valFrom $ take valTo listValue -execList input prog (exprLeft :+: exprRight) = do valLeft <- execList input prog exprLeft - valRight <- execList input prog exprRight - return $ valLeft ++ valRight -execList input prog (Recursive listExpr) = do listValue <- execList input prog listExpr - if null listValue then Just [] else execList listValue prog prog -execList input prog ZeroList = Just [0] -execList input prog InList = Just input +execList :: Env -> ListExpr -> Maybe [Int] +execList (Env {input, prog, steps=0}) _ = Nothing +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 +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 _ 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 data AllExprs = AllExprs {ints :: [IntExpr], lists :: [ListExpr]} terminals :: AllExprs terminals = AllExprs {ints = [Zero], lists = [ZeroList, InList]} -step :: AllExprs -> AllExprs -step (AllExprs {ints = ints, lists = 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} +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} -data Example = Example {input :: [Int], output :: [Int]} +data Example = Example {exampleInput :: [Int], exampleOutput :: [Int]} -- check expr on all examples isCorrect :: [Example] -> ListExpr -> Bool -isCorrect examples expr = all (\Example {input = input, output = output} -> execList input expr expr == Just output) examples +isCorrect examples expr = all (\Example {exampleInput, exampleOutput} -> execProg exampleInput expr == Just exampleOutput) examples --- TODO: remove ones that cannot be executed correctly +isValid :: [Example] -> ListExpr -> Bool +isValid examples expr = all (\Example {exampleInput, exampleOutput} -> isJust $ execProg exampleInput expr) examples -- check are exprs produce same results on all the examples --- areSame :: [Example] -> ListExpr -> ListExpr -> Bool +areSame :: [Example] -> ListExpr -> ListExpr -> Bool +areSame examples exprLeft exprRight = all (\Example {exampleInput, exampleOutput} -> execProg exampleInput exprLeft == execProg exampleInput exprRight ) examples --- TODO --- upSyntesis +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 + Just answer -> Right answer + Nothing -> Left $ nextExprs allExprs + +upSyntesisRec :: [Example] -> Int -> AllExprs -> Maybe ListExpr +upSyntesisRec _ 0 _ = Nothing +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 + +----- + +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]}]