Problem K
условие
решение на хаскелл
другое решение на хаскелл
Смотрел, смотрел и не удержался... Привожу своё решение.
Оно может быть интересно как пример фатального влияния ооп на человеческий мозг.
Коротко о решении:
модуль Sheet (использует Expression)
Sheet a - тип данных таблица - по сути набор именованных значений а. Определены операция вычисления (Sheet Expr -> Sheet CExpr) и преобразования в текстовый формат (Sheet CExpr -> String). Здесь же анализ циклическиз зависимостей между выражениями в таблице.
модуль Expression
CExpr - тип данных константа, описывает базовые типов.
Function - тип данных функция, представляет операции над базовыми типами.
Expr - тип данных выражение, служит для представления произвольного выражения.
Определены операция вычисления выражения ((String->CExpr) -> Expr -> CExpr) и взятие списка переменных (Expr -> [String])
В модулях SheetParser и ExprParser инкапсулировано знание о входном формате, строковом представление таблицы Sheet Expr и выражения Expr.
модуль Main - решает поставленную задачу.
Зависимости:
Main -> (Sheet -> Expr) -- 1 здесь сосредоточена вся бизнес логика (вычисления) -> (SheetParser -> Sheet -> (ExprParser -> Expr) -> Expr) -- 2 используются только конструкторы Sheet и Expr
Где бы найти строгого судью, который решил бы какое из решений лучше...
Пример работы:
7 4 12 =C2 3 'Sample =A1+B1*C1/5 =A2*B1 =B3-C3 ='Spread 'Test =4-3 5 ='Sheet =A9 =1/0 =A5 =B5 =1+C6+1 =5A =A1++A1 =1+ x =A5 =A6+B6 =A1 =A3 =A4 =A5 12 -4 3 'Sample 4 -16 -4 'Spread 'Test 1 5 'Sheet #NoRef #div by 0 #Cycle #Cycle #Cycle #Parsing #Parsing #Parsing #Parsing #Cycle #Parsing 12 'Test #Cycle Код:
----------------------------------------------------------------------------------------- module Main where import Sheet import SheetParser main = do input <- getContents let sheet = mkExprSheet $ mkStringSheet $ parseInput input putStrLn $ showSheet $ evaluate sheet ----------------------------------------------------------------------------------------- module Sheet where import Expression import Data.Graph import Data.List data Sheet a = Sheet [(String, a)] deriving Show mapS :: (a -> b) -> (Sheet a) -> (Sheet b) mapS f (Sheet cs) = Sheet $ map (\(k, v) -> (k, f v)) cs evaluate :: Sheet Expr -> Sheet CExpr evaluate s@(Sheet cells) = Sheet values where values = map eval cells resolve var = resolve' $ lookup var values resolve' Nothing = CError "NoRef" resolve' (Just e) = e cyclic = cyclicCells s eval (var, expr) | var `elem` cyclic = (var, CError "Cycle") | otherwise = (var, evaluateExpr resolve expr) -- get names of cyclic referenced variables cyclicCells :: Sheet Expr -> [String] cyclicCells (Sheet cells) = concatMap flattenSCC $ filter isCyclic sccs where sccs = stronglyConnComp $ map describeRefs cells describeRefs (var, expr) = (var, var, vars expr) isCyclic (AcyclicSCC _) = False isCyclic (CyclicSCC _) = True -- get display string showSheet :: Sheet CExpr -> String showSheet exprSheet = unlines $ map (tail.concatMap ('\t':)) $ map (snd.unzip) $ groupBy' (tail.fst) cells where (Sheet cells) = mapS showCell exprSheet groupBy' f = groupBy (\a b -> f a == f b) showCell :: CExpr -> String showCell (CText t) = '\'':t showCell (CNumber n) = show n showCell (CError e) = '#':e showCell (CEmpty) = [] ----------------------------------------------------------------------------------------- module Expression where import Data.Char --------------------------------- -- | Expression data CExpr = CNumber Integer | CText String | CError String | CEmpty deriving (Show) data Expr = EVar String -- variable | EConst CExpr -- const | EFunc Function [Expr] -- function deriving (Show) data Function = Infix String -- name (CExpr -> CExpr -> CExpr) -- evaluator fname :: Function -> String fname (Infix n _) = n instance Show Function where show = fname --- resolve variables in expression vars :: Expr -> [String] vars (EVar var) = [var] vars (EFunc _ exprs) = concat $ map vars exprs vars _ = [] --------------------------------------------- -- | Evaluation type ResolveVar = String -> CExpr evaluateExpr :: ResolveVar -> Expr -> CExpr evaluateExpr _ (EConst value) = value evaluateExpr resolve (EVar var) = resolve var evaluateExpr resolve (EFunc f es) = eval f (map (evaluateExpr resolve) es) where eval (Infix _ f) (x:y:[]) = f x y eval _ _ = CError "eval" --------------------------------------------- -- | Supported functions -- Add fadd :: CExpr -> CExpr -> CExpr fadd (CNumber n1) (CNumber n2) = CNumber $ n1 + n2 fadd e@(CError _) _ = e fadd _ e@(CError _) = e fadd _ _ = CError "add" -- Sub fsub :: CExpr -> CExpr -> CExpr fsub (CNumber n1) (CNumber n2) = CNumber $ n1 - n2 fsub e@(CError _) _ = e fsub _ e@(CError _) = e fsub _ _ = CError "sub" -- Mult fmult :: CExpr -> CExpr -> CExpr fmult (CNumber n1) (CNumber n2) = CNumber $ n1 * n2 fmult e@(CError _) _ = e fmult _ e@(CError _) = e fmult _ _ = CError "mult" -- Div fdiv :: CExpr -> CExpr -> CExpr fdiv (CNumber n1) (CNumber n2) | n2 /= 0 = CNumber $ n1 `div` n2 | otherwise = CError "div by 0" fdiv e@(CError _) _ = e fdiv _ e@(CError _) = e fdiv _ _ = CError "div" ----------------------------------------------------------------------------------------- module SheetParser where import Sheet import Expression import ExprParser split :: Eq a => a -> [a] -> [[a]] split _ [] = [] split d xs = split' $ span (d/=) xs where split' (group, []) = [group] split' (group, (r:[])) = group : [[]] split' (group, (r:rs)) = group : split d rs -- parse input, fail if incorrect input parseInput :: String -> (Int, Int, [[String]]) parseInput input | isValid = (rows, columns, rs) where ((r:c:[]):rs) = map (split '\t') $ lines input (rows, columns) = (read r, read c) isValid = (length rs) == rows && all ((columns==).length) rs -- build string sheet mkStringSheet :: (Int, Int, [[String]]) -> Sheet String mkStringSheet (_, _, rs) = Sheet $ concatMap merge $ zip [1..] $ map (zip ['A'..]) rs where merge :: (Int, [(Char, String)]) -> [(String, String)] merge (r, xs) = map (\(c, t) -> (c:(show r), t)) xs -- build expr sheet from string sheet mkExprSheet :: Sheet String -> Sheet Expr mkExprSheet = mapS parseCell where parseCell ('=':rs) = parseExpr functions rs parseCell rs = EConst $ parseCExpr rs functions = [Infix "+" fadd, Infix "-" fsub, Infix "*" fmult, Infix "/" fdiv] ----------------------------------------------------------------------------------------- module ExprParser where import Expression import Data.Char ----------------------------------- -- | Lexer data Term = TNumber Integer | TText String | TRef String | TFunc String | TError String | TEqual deriving Show parseTerm :: [String] -> String -> [Term] parseTerm funcs text = parseTerm' parsers text where parseTerm' :: [String -> (Maybe Term, String)] -> String -> [Term] parseTerm' _ [] = [] parseTerm' [] text = [TError text] parseTerm' (p:ps) text = case p text of (Nothing, _) -> parseTerm' ps text (Just t, rs) -> t : (parseTerm' parsers rs) -- possible terms parsers = [parseEqual, parseNumber, parseText, parseRef, parseFunc funcs] -- '=' parseEqual ('=':rs) = (Just TEqual, rs) parseEqual text = (Nothing, text) -- [0-9]* parseNumber text = case span isDigit text of ([], _) -> (Nothing, text) (digits, rest) -> (Just $ TNumber $ read digits, rest) -- [']:(.*) parseText ('\'':text) = (Just $ TText text, []) parseText text = (Nothing, text) -- [A-Za-z][0-9] parseRef (x:y:rest) | (isLetter x) && (isDigit y) = (Just $ TRef (x:y:[]), rest) parseRef text = (Nothing, text) -- f1|f2|... parseFunc (s:ss) text | s == take (length s) text = (Just $ TFunc s, drop (length s) text) | otherwise = parseFunc ss text parseFunc [] text = (Nothing, text) -------------------------------------------- -- | Parser -- parse expression parseExpr :: [Function] -> String -> Expr parseExpr _ [] = EConst $ CEmpty parseExpr fs text = parseExpr' Nothing terms where terms = parseTerm (map fname fs) text findFunc s = head $ filter ((s==).fname) fs parseExpr' :: (Maybe Expr) -> [Term] -> Expr parseExpr' Nothing ((TNumber n):ts) = parseExpr' (Just $ EConst $ CNumber n) ts parseExpr' Nothing ((TText t):ts) = parseExpr' (Just $ EConst $ CText t) ts parseExpr' Nothing ((TError e):ts) = parseExpr' (Just $ EConst $ CError "Syntax") ts parseExpr' Nothing ((TRef r):ts) = parseExpr' (Just $ EVar r) ts parseExpr' (Just e) ((TFunc f):t:ts) = parseExpr' (Just $ EFunc (findFunc f) (e:(parseExpr' Nothing [t]):[])) ts parseExpr' (Just e) [] = e parseExpr' _ _ = EConst $ CError "Parsing" -- parse constant expression parseCExpr :: String -> CExpr parseCExpr text = parseCExpr' terms where terms = parseTerm [] text parseCExpr' [] = CEmpty parseCExpr' ((TNumber n):[]) = CNumber n parseCExpr' ((TText t):[]) = CText t parseCExpr' _ = CError "Parsing"
решение на хаскелл
другое решение на хаскелл
Смотрел, смотрел и не удержался... Привожу своё решение.
Оно может быть интересно как пример фатального влияния ооп на человеческий мозг.
Коротко о решении:
модуль Sheet (использует Expression)
Sheet a - тип данных таблица - по сути набор именованных значений а. Определены операция вычисления (Sheet Expr -> Sheet CExpr) и преобразования в текстовый формат (Sheet CExpr -> String). Здесь же анализ циклическиз зависимостей между выражениями в таблице.
модуль Expression
CExpr - тип данных константа, описывает базовые типов.
Function - тип данных функция, представляет операции над базовыми типами.
Expr - тип данных выражение, служит для представления произвольного выражения.
Определены операция вычисления выражения ((String->CExpr) -> Expr -> CExpr) и взятие списка переменных (Expr -> [String])
В модулях SheetParser и ExprParser инкапсулировано знание о входном формате, строковом представление таблицы Sheet Expr и выражения Expr.
модуль Main - решает поставленную задачу.
Зависимости:
Main -> (Sheet -> Expr) -- 1 здесь сосредоточена вся бизнес логика (вычисления) -> (SheetParser -> Sheet -> (ExprParser -> Expr) -> Expr) -- 2 используются только конструкторы Sheet и Expr
Где бы найти строгого судью, который решил бы какое из решений лучше...
Пример работы:
7 4 12 =C2 3 'Sample =A1+B1*C1/5 =A2*B1 =B3-C3 ='Spread 'Test =4-3 5 ='Sheet =A9 =1/0 =A5 =B5 =1+C6+1 =5A =A1++A1 =1+ x =A5 =A6+B6 =A1 =A3 =A4 =A5 12 -4 3 'Sample 4 -16 -4 'Spread 'Test 1 5 'Sheet #NoRef #div by 0 #Cycle #Cycle #Cycle #Parsing #Parsing #Parsing #Parsing #Cycle #Parsing 12 'Test #Cycle Код:
----------------------------------------------------------------------------------------- module Main where import Sheet import SheetParser main = do input <- getContents let sheet = mkExprSheet $ mkStringSheet $ parseInput input putStrLn $ showSheet $ evaluate sheet ----------------------------------------------------------------------------------------- module Sheet where import Expression import Data.Graph import Data.List data Sheet a = Sheet [(String, a)] deriving Show mapS :: (a -> b) -> (Sheet a) -> (Sheet b) mapS f (Sheet cs) = Sheet $ map (\(k, v) -> (k, f v)) cs evaluate :: Sheet Expr -> Sheet CExpr evaluate s@(Sheet cells) = Sheet values where values = map eval cells resolve var = resolve' $ lookup var values resolve' Nothing = CError "NoRef" resolve' (Just e) = e cyclic = cyclicCells s eval (var, expr) | var `elem` cyclic = (var, CError "Cycle") | otherwise = (var, evaluateExpr resolve expr) -- get names of cyclic referenced variables cyclicCells :: Sheet Expr -> [String] cyclicCells (Sheet cells) = concatMap flattenSCC $ filter isCyclic sccs where sccs = stronglyConnComp $ map describeRefs cells describeRefs (var, expr) = (var, var, vars expr) isCyclic (AcyclicSCC _) = False isCyclic (CyclicSCC _) = True -- get display string showSheet :: Sheet CExpr -> String showSheet exprSheet = unlines $ map (tail.concatMap ('\t':)) $ map (snd.unzip) $ groupBy' (tail.fst) cells where (Sheet cells) = mapS showCell exprSheet groupBy' f = groupBy (\a b -> f a == f b) showCell :: CExpr -> String showCell (CText t) = '\'':t showCell (CNumber n) = show n showCell (CError e) = '#':e showCell (CEmpty) = [] ----------------------------------------------------------------------------------------- module Expression where import Data.Char --------------------------------- -- | Expression data CExpr = CNumber Integer | CText String | CError String | CEmpty deriving (Show) data Expr = EVar String -- variable | EConst CExpr -- const | EFunc Function [Expr] -- function deriving (Show) data Function = Infix String -- name (CExpr -> CExpr -> CExpr) -- evaluator fname :: Function -> String fname (Infix n _) = n instance Show Function where show = fname --- resolve variables in expression vars :: Expr -> [String] vars (EVar var) = [var] vars (EFunc _ exprs) = concat $ map vars exprs vars _ = [] --------------------------------------------- -- | Evaluation type ResolveVar = String -> CExpr evaluateExpr :: ResolveVar -> Expr -> CExpr evaluateExpr _ (EConst value) = value evaluateExpr resolve (EVar var) = resolve var evaluateExpr resolve (EFunc f es) = eval f (map (evaluateExpr resolve) es) where eval (Infix _ f) (x:y:[]) = f x y eval _ _ = CError "eval" --------------------------------------------- -- | Supported functions -- Add fadd :: CExpr -> CExpr -> CExpr fadd (CNumber n1) (CNumber n2) = CNumber $ n1 + n2 fadd e@(CError _) _ = e fadd _ e@(CError _) = e fadd _ _ = CError "add" -- Sub fsub :: CExpr -> CExpr -> CExpr fsub (CNumber n1) (CNumber n2) = CNumber $ n1 - n2 fsub e@(CError _) _ = e fsub _ e@(CError _) = e fsub _ _ = CError "sub" -- Mult fmult :: CExpr -> CExpr -> CExpr fmult (CNumber n1) (CNumber n2) = CNumber $ n1 * n2 fmult e@(CError _) _ = e fmult _ e@(CError _) = e fmult _ _ = CError "mult" -- Div fdiv :: CExpr -> CExpr -> CExpr fdiv (CNumber n1) (CNumber n2) | n2 /= 0 = CNumber $ n1 `div` n2 | otherwise = CError "div by 0" fdiv e@(CError _) _ = e fdiv _ e@(CError _) = e fdiv _ _ = CError "div" ----------------------------------------------------------------------------------------- module SheetParser where import Sheet import Expression import ExprParser split :: Eq a => a -> [a] -> [[a]] split _ [] = [] split d xs = split' $ span (d/=) xs where split' (group, []) = [group] split' (group, (r:[])) = group : [[]] split' (group, (r:rs)) = group : split d rs -- parse input, fail if incorrect input parseInput :: String -> (Int, Int, [[String]]) parseInput input | isValid = (rows, columns, rs) where ((r:c:[]):rs) = map (split '\t') $ lines input (rows, columns) = (read r, read c) isValid = (length rs) == rows && all ((columns==).length) rs -- build string sheet mkStringSheet :: (Int, Int, [[String]]) -> Sheet String mkStringSheet (_, _, rs) = Sheet $ concatMap merge $ zip [1..] $ map (zip ['A'..]) rs where merge :: (Int, [(Char, String)]) -> [(String, String)] merge (r, xs) = map (\(c, t) -> (c:(show r), t)) xs -- build expr sheet from string sheet mkExprSheet :: Sheet String -> Sheet Expr mkExprSheet = mapS parseCell where parseCell ('=':rs) = parseExpr functions rs parseCell rs = EConst $ parseCExpr rs functions = [Infix "+" fadd, Infix "-" fsub, Infix "*" fmult, Infix "/" fdiv] ----------------------------------------------------------------------------------------- module ExprParser where import Expression import Data.Char ----------------------------------- -- | Lexer data Term = TNumber Integer | TText String | TRef String | TFunc String | TError String | TEqual deriving Show parseTerm :: [String] -> String -> [Term] parseTerm funcs text = parseTerm' parsers text where parseTerm' :: [String -> (Maybe Term, String)] -> String -> [Term] parseTerm' _ [] = [] parseTerm' [] text = [TError text] parseTerm' (p:ps) text = case p text of (Nothing, _) -> parseTerm' ps text (Just t, rs) -> t : (parseTerm' parsers rs) -- possible terms parsers = [parseEqual, parseNumber, parseText, parseRef, parseFunc funcs] -- '=' parseEqual ('=':rs) = (Just TEqual, rs) parseEqual text = (Nothing, text) -- [0-9]* parseNumber text = case span isDigit text of ([], _) -> (Nothing, text) (digits, rest) -> (Just $ TNumber $ read digits, rest) -- [']:(.*) parseText ('\'':text) = (Just $ TText text, []) parseText text = (Nothing, text) -- [A-Za-z][0-9] parseRef (x:y:rest) | (isLetter x) && (isDigit y) = (Just $ TRef (x:y:[]), rest) parseRef text = (Nothing, text) -- f1|f2|... parseFunc (s:ss) text | s == take (length s) text = (Just $ TFunc s, drop (length s) text) | otherwise = parseFunc ss text parseFunc [] text = (Nothing, text) -------------------------------------------- -- | Parser -- parse expression parseExpr :: [Function] -> String -> Expr parseExpr _ [] = EConst $ CEmpty parseExpr fs text = parseExpr' Nothing terms where terms = parseTerm (map fname fs) text findFunc s = head $ filter ((s==).fname) fs parseExpr' :: (Maybe Expr) -> [Term] -> Expr parseExpr' Nothing ((TNumber n):ts) = parseExpr' (Just $ EConst $ CNumber n) ts parseExpr' Nothing ((TText t):ts) = parseExpr' (Just $ EConst $ CText t) ts parseExpr' Nothing ((TError e):ts) = parseExpr' (Just $ EConst $ CError "Syntax") ts parseExpr' Nothing ((TRef r):ts) = parseExpr' (Just $ EVar r) ts parseExpr' (Just e) ((TFunc f):t:ts) = parseExpr' (Just $ EFunc (findFunc f) (e:(parseExpr' Nothing [t]):[])) ts parseExpr' (Just e) [] = e parseExpr' _ _ = EConst $ CError "Parsing" -- parse constant expression parseCExpr :: String -> CExpr parseCExpr text = parseCExpr' terms where terms = parseTerm [] text parseCExpr' [] = CEmpty parseCExpr' ((TNumber n):[]) = CNumber n parseCExpr' ((TText t):[]) = CText t parseCExpr' _ = CError "Parsing"