From 5e7729e4ac4a7262107149b3984e8584b9aa7006 Mon Sep 17 00:00:00 2001 From: ProgramSnail Date: Tue, 23 Sep 2025 19:34:52 +0300 Subject: [PATCH] 02: use one expr type --- 02.hs | 103 +++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 62 insertions(+), 41 deletions(-) diff --git a/02.hs b/02.hs index afd3d75..1b72977 100644 --- a/02.hs +++ b/02.hs @@ -3,35 +3,45 @@ import Data.Maybe (isJust) infixl 4 :+: -data IntExpr = Zero - | Succ IntExpr - | Len ListExpr - | FirstZero ListExpr +data Expr = Zero + | Succ Expr + | Len Expr + | FirstZero Expr + | Sort Expr + | SubList Expr Expr Expr + | Expr :+: Expr + | Recursive Expr + | ZeroList + | InList deriving (Read, Show, Eq) -data ListExpr = Sort ListExpr - | SubList ListExpr IntExpr IntExpr - | ListExpr :+: ListExpr - | Recursive ListExpr - | ZeroList - | InList +data Type = IntT | ListT + deriving (Read, Show, Eq) +data Value = IntV Int | ListV [Int] deriving (Read, Show, Eq) -data Env = Env {input :: [Int], prog :: ListExpr, steps :: Int} +typeOf :: Expr -> Type +typeOf Zero = IntT +typeOf (Succ {}) = IntT +typeOf (Len {}) = IntT +typeOf (FirstZero {}) = IntT +typeOf _ = ListT + +data Env = Env {input :: [Int], prog :: Expr, steps :: Int} stepInEnv :: Env -> Env stepInEnv env@(Env {input, prog, steps}) = env { steps = steps - 1 } -execInt :: Env -> IntExpr -> Maybe Int +execInt :: Env -> Expr -> 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) = length <$> execList (stepInEnv env) listExpr execInt env (FirstZero listExpr) = do value <- execList (stepInEnv env) listExpr 0 `elemIndex` value +execInt _ _ = Nothing --- TODO: limit execution steps -execList :: Env -> ListExpr -> Maybe [Int] +execList :: Env -> Expr -> 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 @@ -45,51 +55,62 @@ execList env (Recursive listExpr) = do listValue <- execList (stepInEnv env) lis 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 +execList _ _ = Nothing -execProg :: [Int] -> ListExpr -> Maybe [Int] +-- TODO: union +execProg :: [Int] -> Expr -> Maybe [Int] execProg input expr = execList (Env {input, prog=expr, steps=20}) expr -data AllExprs = AllExprs {ints :: [IntExpr], lists :: [ListExpr]} - deriving (Read, Show, Eq) +terminals :: [Expr] +terminals = [Zero, ZeroList, InList] -terminals :: AllExprs -terminals = AllExprs {ints = [Zero], lists = [ZeroList, InList]} +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 :: AllExprs -> AllExprs -nextExprs (AllExprs {ints, lists}) = AllExprs {ints = map Succ ints ++ map Len lists ++ map FirstZero lists ++ ints, - lists = map Sort lists ++ - [SubList list from to | list <- lists, from <- ints, to <- ints] ++ - [left :+: right | left <- lists, right <- lists] ++ - map Recursive lists ++ - lists} +nextExprs :: [Expr] -> [Expr] +nextExprs exprs = concatShuffle $ [exprs] + ++ [[Succ e | e <- exprs, typeOf e == IntT]] + ++ [[Sort e, Recursive e, FirstZero e, Len e] | e <- exprs, typeOf e == ListT] + ++ [[e :+: e' | + e <- exprs, typeOf e == ListT, + e' <- exprs, typeOf e' == ListT]] + ++ [[SubList InList from to | + -- e <- exprs, typeOf e == ListT, + from <- exprs, typeOf from == IntT, + to <- exprs, typeOf to == IntT]] data Example = Example {exampleInput :: [Int], exampleOutput :: [Int]} -- check expr on all examples -isCorrect :: [Example] -> ListExpr -> Bool +isCorrect :: [Example] -> Expr -> Bool isCorrect examples expr = all (\Example {exampleInput, exampleOutput} -> execProg exampleInput expr == Just exampleOutput) examples -isValid :: [Example] -> ListExpr -> Bool -isValid examples expr = all (\Example {exampleInput, exampleOutput} -> isJust $ execProg exampleInput expr) examples +isValid :: [Example] -> Expr -> Bool +isValid examples expr | typeOf expr == IntT = True + | otherwise = 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 examples exprLeft exprRight = all (\Example {exampleInput, exampleOutput} -> execProg exampleInput exprLeft == execProg exampleInput exprRight ) examples +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 -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{lists=lists''} +upSyntesisStep :: [Example] -> [Expr] -> Either [Expr] Expr +upSyntesisStep examples exprs = 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 + case find (isCorrect examples) exprs'' of + Just answer -> Right answer + Nothing -> Left $ nextExprs exprs'' -upSyntesisRec :: [Example] -> Int -> AllExprs -> Maybe ListExpr +upSyntesisRec :: [Example] -> Int -> [Expr] -> Maybe Expr 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] -> Int -> Maybe ListExpr +upSyntesis :: [Example] -> Int -> Maybe Expr upSyntesis examples steps = upSyntesisRec examples steps terminals ----- @@ -97,9 +118,9 @@ upSyntesis examples steps = upSyntesisRec examples steps terminals exampleOf :: [Int] -> [Int] -> Example exampleOf input output = Example {exampleInput = input, exampleOutput = output} --- InList +sameExamplesExpected = 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) +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