Ещё одно решение "Проблемы К" на Хаскелле
Я тоже не смог удержаться, и вслед за Сергеем Зефировым и Булатом Зиганьшиным тоже сделал своё решение этой задачки.
Кратко о задаче:
Необходимо реализовать простую электронную таблицу в виде программы, выполняющейся из командной строки. Она должна уметь обрабатывать ячейки таблицы как и более продвинутые аналоги, только с упрощенным синтаксисом выражений. Каждая ячейка может содержать:
- Ничего
- Неотрицательное целое число
- Текстовые строки, которые начинаются с символа '
- Строки-выражения, которые начинаются с символа '=' и могут содержать неотрицательные целые числа, ссылки на ячейки и простые арифметические выражения. Скобки запрещены, у всех операций одинаковый приоритет. Ссылки на ячейки состоят из одной латинской буквы и следующей за ней цифры.
Читать описание полностью...
Автор задачи, ЖЖ-юзер Gaperton, опубликовал предысторию этой задачи: "О дизайне и ФП", а также поделился своим решением задачи на RSDN.ru
Также стало доступно модуляризованное решение на Хаскелле (чего так хотел увидеть Гапертон) от NGGU...
А вот и моё решение:
module Main where
import Char (isAlpha, isAlphaNum, isDigit)
import List (nub, groupBy, sort, (\\), union, intersect)
import Data.Graph (SCC(CyclicSCC), stronglyConnComp, flattenSCCs)
--------------------------------------------------------------------------------
-- | Главная функция: считать со stdin таблицу, вычислить и распечатать в stdout
main = print . calculate =<< getSheet
--------------------------------------------------------------------------------
-- Вспомогательные функции
--------------------------------------------------------------------------------
-- | Перевёрнутый оператор $
x |> f = f x; infixl 0 |>
--------------------------------------------------------------------------------
-- | Считать со stdin таблицу в список табличных строк,
-- каждая из которых в виде списка столбцов (в строковом представлении)
getSheet :: IO (Sheet Integer)
getSheet = getIntegralSheet
getIntegralSheet :: (Integral a, Read a) => IO (Sheet a)
getIntegralSheet = do
s <- getLine
let (r:_) = words s
rows = read r
ss <- sequence $ replicate rows $ getLine
return $ read $ s ++ "\n" ++ unlines ss
`catch` \_ -> do
return $ read "1\t1\n'#Error: no data"
--------------------------------------------------------------------------------
-- Типы данных
--------------------------------------------------------------------------------
-- | Класс типов вычислимых объектов
class Calculable a where
calculate :: a -> a
--------------------------------------------------------------------------------
-- | Бинарные операции
type BinOp a = a -> a -> a
type StrOp = BinOp String
--------------------------------------------------------------------------------
-- | Результат запроса на вычисление функции Func
data (Num a) => FResult a
= FRErr String -- Ошибка при вычислении
| FRNum a -- Результат: число
| FRStr String -- Результат: строка
instance (Show a, Num a) => Show (FResult a) where
show (FRErr s) = "#" ++ s
show (FRNum n) = show n
show (FRStr s) = s
--------------------------------------------------------------------------------
-- | Бинарные операции
data (Num a) => Func a
= FNum String (BinOp a) -- Арифметическая функция
| FStr String StrOp -- Строковая функция
| FErr String -- Недопустимая функция
| FQrN (Func a) a a -- Запрос на вычисление арифмет. функции
| FQrS (Func a) String String -- Запрос на вычисление строковой функции
| FRes (FResult a) -- И результат вычисление
instance (Show a, Num a) => Show (Func a) where
show (FNum s _) = s
show (FStr s _) = s
show (FQrN (FNum s _) a b) = show a ++ s ++ show b
show (FQrS (FStr s _) a b) = show a ++ s ++ show b
show (FRes r) = show r
show _ = "_?_"
instance (Integral a) => Read (Func a) where
readsPrec _ s = [(case s of
"+" -> FNum s (+)
"-" -> FNum s (-)
"*" -> FNum s (*)
"/" -> FNum s div
"^" -> FNum s (^)
"++" -> FStr s (++)
"--" -> FStr s (\\)
"**" -> FStr s union
"//" -> FStr s intersect
s -> FErr s
, "")]
instance (Num a) => Calculable (Func a) where
----------------------------------------------------------------------------
-- Безопасное вычисление арифметической операции
calculate (FQrN (FErr s) _ _) = FRes $ FRErr $ "Op:" ++ s
calculate (FQrS (FErr s) _ _) = FRes $ FRErr $ "Op:" ++ s
calculate (FQrN (FNum "/" _) a 0) = FRes $ FRErr "Inf"
calculate (FQrN (FNum _ f) a b) = FRes $ FRNum $ a `f` b
calculate (FQrN (FStr _ _) _ _) = FRes $ FRErr $ "StrOp on Numbers"
calculate (FQrS (FStr _ f) a b) = FRes $ FRStr $ a `f` b
calculate (FQrS (FNum _ _) _ _) = FRes $ FRErr $ "NumOp on Strings"
calculate _ = FRes $ FRErr $ "Query"
--------------------------------------------------------------------------------
-- | Содержимое ячейки таблицы
type IdCell a = (String, Cell a)
data Cell a
= CNull -- Пустая ячейка
| CNum a -- Целочисленная константа
| CRef String -- Ссылка на ячейку
| CStr String -- Строковая константа
| CErr String -- Ячейка с какой-то ошибкой
| CFun (Func a) (Cell a) (Cell a) -- Формула
| CQry (IdCell a) (Sheet a) -- Запрос на вычисление ячейки в контексте таблицы
instance (Show a, Integral a) => Show (Cell a) where
show CNull = " "
show (CNum n) = show n
show (CRef s) = s
show (CStr s) = s
show (CErr s) = "#" ++ s
show (CFun f x y) = show x ++ show f ++ show y
show (CQry c sh) = show c ++ show sh
instance (Read a, Integral a) => Read (Cell a) where
readsPrec _ s = [(parse s, "")]
where
-- Разбор ячейки из строкового вида
parse :: ( Read a, Integral a) => String -> Cell a
parse "" = CNull -- Пустая ячейка
parse str@(s:ss) | isDigit s = readNumb str -- Целочисленная константа
| s == '\'' = CStr ss -- Строковая константа
| s == '=' = pars $ reverse $ lines $ items ss -- Формула
| otherwise = CErr "Parse" -- Что-то не то...
-- Вставить перенос строки между элементами формулы
items :: String -> String
items s = case span isAlphaNum s of
("", "") -> ""
(left, "") -> left
(left, op'right) -> left ++ "\n" ++ op ++ "\n" ++ items right
where (op, right) = break isAlphaNum op'right
-- Преобразовать перевёрнутый список элементов формулы в саму формулу
pars :: (Read a, Integral a) => [String] -> Cell a
pars [x] = pars' x -- Число или ссылка на ячейку
pars (r:o:xs) = CFun (read o) (pars xs) (pars' r) -- Операция над двумя элементами
pars xs = CErr "Expr" -- Какая-то ошибка в формуле
pars' s@(x:xs) | isDigit x = readNumb s
| isAlpha x = CRef s
pars' s = CErr s
-- Попытаться прочесть целое число из строки
readNumb s | all isDigit s = CNum $ read s
| otherwise = CErr "NaN" -- Not a Number
instance (Integral a) => Calculable (Cell a) where
----------------------------------------------------------------------------
-- Вычисление ячейки таблицы
calculate (CQry (cid, cell) (Sheet sh)) = calc cell
where
-- Вычислить ячейку
calc (CFun f x y) = case (x, y) of
((CNum a), (CNum b)) -> res -- число с числом
where
res = case calculate $ FQrN f a b of
(FRes (FRNum n)) -> CNum n
(FRes (FRErr s)) -> CErr s
_ -> CErr "Calc"
((CStr a), (CStr b)) -> res -- строка со строкой
where
res = case calculate $ FQrS f a b of
(FRes (FRStr n)) -> CStr n
(FRes (FRErr s)) -> CErr s
_ -> CErr "Calc"
((CRef _), _) -> res -- что-то с ячейкой
(_, (CRef _)) -> res
((CFun _ _ _), _) -> res -- что-то с формулой
(_, (CFun _ _ _)) -> res
(err@(CErr _), _) -> err
(_, err@(CErr _)) -> err
otherwise -> CErr "Expr" -- ошибка в формуле
where
res = calc $ CFun f (calc x) (calc y)
calc (CRef x) = case lookup x sh of
Just z -> calc z -- вычислим ячейку
_ -> CErr "Cell" -- нет такой ячейки
calc x = x
calculate c = calculate $ CQry ("A1", c) (Sheet [])
--------------------------------------------------------------------------------
-- | Электронная таблица в виде списка кортежей,
-- первый элемент которых -- идентификатор ячейки (напр., "A1"),
-- а второй -- содержимое ячейки (напр., "=B2*5") в распарсенном виде
data Sheet a = Sheet [IdCell a]
instance (Show a, Integral a) => Show (Sheet a) where
show (Sheet s) = s
-- Разобьём на строки
|> groupBy (\(_:a,_) (_:b,_) -> a == b)
-- Теперь сформируем столбцы табуляцией
|> map (map (\(_, x) -> show x ++ "\t"))
-- И превратим всё это в одну длинную строку
|> map concat
|> unlines
instance (Read a, Integral a) => Read (Sheet a) where
readsPrec _ s = [(readSh s, "")]
where
readSh :: (Integral a, Read a) => String -> Sheet a
readSh s = ss
-- Разобъём строки таблицы на кучи ячеек
|> map (lines . map (\c -> if c == '\t' then '\n' else c))
-- Если введено было меньше столбцов, чем нужно, то добавим пустые (Null)
|> map ((take columns) . (++ repeat ""))
-- Пронумеруем ячейки таблицы в виде "A1"
|> map (zip (['A'..'Z'] ++ ['a'..'z']) . map read)
|> zip (map show [1..])
|> map (\(n, s) -> map (\(c, f) -> (c:n, f)) s)
-- И превратим всё это в таблицу
|> concat
|> Sheet
where
(rc:ss) = lines s -- Разобьём входную строку на строки таблицы
(_:o:_) = words $ rc ++ " 0"
columns = read o
instance (Integral a) => Calculable (Sheet a) where
----------------------------------------------------------------------------
-- Вычисление всей таблицы
calculate (Sheet sh) = Sheet sh'
where
-- Пройтись по всем элементам таблицы, пытаясь их вычислить
sh' = sh
-- Пометить зацикленные ячейки
|> map (\c@(cid,_) -> if isCycled cid then (cid, CErr "Cycle") else c)
-- Вычислить значения ячеек
|> map (\c@(cid,_) -> (cid, calculate $ CQry c (Sheet sh')))
-- Определить, зациклена ли ячейка
isCycled :: String -> Bool
isCycled x = x `elem` crefs
where
crefs = sh
|> map (\(cid, cell) -> (cid, cid, cids cell))
|> stronglyConnComp
|> filter isCyclic
|> flattenSCCs
|> sort
|> nub
cids (CFun _ a b) = cids a ++ cids b
cids (CRef cid) = [cid]
cids _ = []
isCyclic (CyclicSCC _) = True
isCyclic _ = False
У меня на это дело ушло где-то дня три-четыре. Чистого времени - больше суток...
Ох и намучился я с поиском циклических ссылок в ячейках таблицы... Зато обошёлся без библиотеки графов... :o)
На тестовый набор данных:
8 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 =1+A5+1 =5A =A1++C1
=1+ x ' =D1+D2
=D1++D2 =D1--D2 =D1**D2 =D1//D2
=D1++C6++D2++C6++D3
программа выдаёт результат:
12 -4 3 Sample
4 -16 -4 Spread
Test 1 5 Sheet
#Parse #Cell #Inf #Cycle
#Cycle #Cycle #NaN #StrOp on Numbers
#Expr #Parse #NumOp on Strings
SampleSpread ml Samplerd Sape
Sample Spread Sheet
Update. С целью получения максимально идиоматического :о) хаскеллевского решения, радикально редизайнил программу, используя классы типов... ;о)
Update. Расширил набор операций операциями над строками: конкатенация, разность, объединение и пересечение (вообще-то это операции над множествами, но и для строк пойдут)
Update. Таки переделал алгоритм поиска зацикленных ячеек таблицы на графы...
Backup. Добавил для истории первый вариант решения этой задачи (тот, который одобрили Гапертон, Thesz и Булат:
module Main where
import Char
import List
import Control.Monad
--------------------------------------------------------------------------------
-- | Главная функция: считать со stdin таблицу, подготовить,
-- вычислить и распечатать в stdout
main = print . calculate =<< getSheet
--------------------------------------------------------------------------------
-- Вспомогательные функции
-- | Перевёрнутый оператор $
x |> f = f x; infixl 0 |>
--------------------------------------------------------------------------------
-- Типы данных
-- | Некая бинарная операция: (Символ_операции, функция_операции)
type Func a = (Char, (a -> a -> a))
--------------------------------------------------------------------------------
-- | Набор допустимых целочисленных операций
func :: Char -> Func Integer
func c = case c of
'+' -> (c, (+))
'-' -> (c, (-))
'*' -> (c, (*))
'/' -> (c, div)
_ -> ('?', const) -- Недопустимая операция
--------------------------------------------------------------------------------
-- | Содержимое ячейки таблицы
data (Integral a) => Cell a = Null -- Пустая ячейка
| Numb a -- Целочисленная константа
| CRef String -- Ссылка на ячейку
| Str String -- Строковая константа
| Op (Func a) (Cell a) (Cell a) -- Формула
instance (Show a, Integral a) => Show (Cell a)
where
show Null = " "
show (CRef s) = s
show (Numb n) = show n
show (Str s) = s
show (Op (f,_) x y) = show x ++ [f] ++ show y
--------------------------------------------------------------------------------
-- | Какая-то ошибка при вычислении или разборе ячейки таблицы
err :: String -> Cell a
err ('#':str) = Str $ "#" ++ str
err str = Str $ "#" ++ str
--------------------------------------------------------------------------------
-- | Электронная таблица в виде списка кортежей,
-- первый элемент которых -- идентификатор ячейки (напр., "A1"),
-- а второй -- содержимое ячейки (напр., "=B2*5") в распарсенном виде
data Sheet a = Sheet [(String, Cell a)]
instance (Show a, Integral a) => Show (Sheet a)
where
show (Sheet s) = -- Разобьём на строки
groupBy (\(_:c1,_) (_:c2,_) -> c1 == c2) s
-- Теперь сформируем столбцы табуляцией
|> map (map (\(_, x) -> show x ++ "\t"))
-- И превратим всё это в одну длинную строку
|> map concat
|> unlines
instance Read (Sheet Integer)
where
readsPrec _ s = [(readSh s, "")]
where
readSh :: String -> Sheet Integer
readSh s = -- Разобъём строки таблицы на кучи ячеек
map (lines . map (\c -> if c == '\t' then '\n' else c)) ss
-- Если введено было меньше столбцов, чем нужно, то добавим пустые (Null)
|> map (++ repeat "")
|> map (take columns)
-- Пронумеруем ячейки таблицы в виде "A1"
|> map (zip (['A'..'Z'] ++ ['a'..'z']) . map parse)
|> zip (['1'..'9'] ++ "0")
|> map (\(n, s) -> map (\(c, f) -> (c:[n], f)) s)
-- И превратим всё это в таблицу
|> concat
|> Sheet
where
(c:ss) = lines s -- Разобьём входную строку на строки таблицы
columns = read c
--------------------------------------------------------------------------------
-- | Разбор ячейки из строкового вида
parse :: String -> Cell Integer
parse "" = Null -- Пустая ячейка
parse str@(s:ss) | isDigit s = readNumb str -- Целочисленная константа
| s == '\'' = Str ss -- Строковая константа
| s == '=' = pars $ reverse $ lines $ items ss -- Формула
| otherwise = err str -- Неправильная ячейка
where
-- Вставить перенос строки между элементами формулы
items s = case span isAlphaNum s of
("", "") -> ""
(left, "") -> left
(left, (op:right)) -> left ++ "\n" ++ [op] ++ "\n" ++ items right
-- Преобразовать перевёрнутый список элементов формулы в саму формулу
pars :: [String] -> Cell Integer
pars [x] = pars' x -- Число или ссылка на ячейку
pars (r:[o]:xs) = Op (func o) (pars xs) (pars' r) -- Операция над двумя элементами
pars xs = err "Expr" -- Какая-то ошибка в формуле
pars' s@(x:xs) | isDigit x = readNumb s
| isAlpha x = CRef s
pars' s = err s
readNumb s | all isDigit s = Numb $ read s
| otherwise = err "NaN" -- Not a Nnumber
--------------------------------------------------------------------------------
-- | Считать со stdin таблицу в список табличных строк,
-- каждая из которых в виде списка столбцов (в строковом представлении)
getSheet :: IO (Sheet Integer)
getSheet = do
s <- getLine
let (r, (_:c)) = span (/='\t') s
rows = read r
ss <- forM [1..rows] $ \_ -> do
return =<< getLine
return $ read $ c ++ "\n" ++ unlines ss
--------------------------------------------------------------------------------
-- | Собственно вычисление ячеек таблицы
calculate :: Sheet Integer -> Sheet Integer
calculate (Sheet sh) = Sheet sheet
where
-- Пройтись по всем элементам таблицы, пытаясь их вычислить
sheet = map (\(a, b) -> (a, calc b)) sh
-- Вычислить ячейку
calc :: Cell Integer -> Cell Integer
calc op@(Op f x y) = case (x, y) of
((Numb a), (Numb b)) -> eval f a b -- число с числом
((CRef _), _) -> res -- что-то с ячейкой
(_, (CRef _)) -> res
((Op _ _ _), _) -> res -- что-то с формулой
(_, (Op _ _ _)) -> res
otherwise -> err "Expr" -- ошибка в формуле
where
res = calc $ Op f (calc x) (calc y)
calc c@(CRef x) = if isCycled x
then err "Cycle" -- Зацикленная ссылка
else case lookup x sheet of
Nothing -> err $ show c -- нет такой ячейки
Just z -> calc z -- иначе вычислим ячейку
calc x = x
-- Безопасное вычисление арифметической операции
eval :: Func Integer -> Integer -> Integer -> Cell Integer
eval ('?',_) _ _ = err "Operator"
eval ('/',_) a 0 = err "Inf"
eval ( _, f) a b = Numb $ a `f` b
-- Определить, зациклена ли ячейка
isCycled :: String -> Bool
isCycled x = x `elem` take (length sh) (cycles x)
where
-- Найти список ячеек, на которые ссылается данная
cycles x = case lookup x sh of
Just (CRef y) -> y:cycles y
Just (Op _ a b) ->
case (a, b) of
(CRef y, CRef z) -> y:cycles y ++ z:cycles z
(CRef y, _) -> y:cycles y
(_, CRef z) -> z:cycles z
_ -> []
_ -> []
Кратко о задаче:
Необходимо реализовать простую электронную таблицу в виде программы, выполняющейся из командной строки. Она должна уметь обрабатывать ячейки таблицы как и более продвинутые аналоги, только с упрощенным синтаксисом выражений. Каждая ячейка может содержать:
- Ничего
- Неотрицательное целое число
- Текстовые строки, которые начинаются с символа '
- Строки-выражения, которые начинаются с символа '=' и могут содержать неотрицательные целые числа, ссылки на ячейки и простые арифметические выражения. Скобки запрещены, у всех операций одинаковый приоритет. Ссылки на ячейки состоят из одной латинской буквы и следующей за ней цифры.
Читать описание полностью...
Автор задачи, ЖЖ-юзер Gaperton, опубликовал предысторию этой задачи: "О дизайне и ФП", а также поделился своим решением задачи на RSDN.ru
Также стало доступно модуляризованное решение на Хаскелле (чего так хотел увидеть Гапертон) от NGGU...
А вот и моё решение:
module Main where
import Char (isAlpha, isAlphaNum, isDigit)
import List (nub, groupBy, sort, (\\), union, intersect)
import Data.Graph (SCC(CyclicSCC), stronglyConnComp, flattenSCCs)
--------------------------------------------------------------------------------
-- | Главная функция: считать со stdin таблицу, вычислить и распечатать в stdout
main = print . calculate =<< getSheet
--------------------------------------------------------------------------------
-- Вспомогательные функции
--------------------------------------------------------------------------------
-- | Перевёрнутый оператор $
x |> f = f x; infixl 0 |>
--------------------------------------------------------------------------------
-- | Считать со stdin таблицу в список табличных строк,
-- каждая из которых в виде списка столбцов (в строковом представлении)
getSheet :: IO (Sheet Integer)
getSheet = getIntegralSheet
getIntegralSheet :: (Integral a, Read a) => IO (Sheet a)
getIntegralSheet = do
s <- getLine
let (r:_) = words s
rows = read r
ss <- sequence $ replicate rows $ getLine
return $ read $ s ++ "\n" ++ unlines ss
`catch` \_ -> do
return $ read "1\t1\n'#Error: no data"
--------------------------------------------------------------------------------
-- Типы данных
--------------------------------------------------------------------------------
-- | Класс типов вычислимых объектов
class Calculable a where
calculate :: a -> a
--------------------------------------------------------------------------------
-- | Бинарные операции
type BinOp a = a -> a -> a
type StrOp = BinOp String
--------------------------------------------------------------------------------
-- | Результат запроса на вычисление функции Func
data (Num a) => FResult a
= FRErr String -- Ошибка при вычислении
| FRNum a -- Результат: число
| FRStr String -- Результат: строка
instance (Show a, Num a) => Show (FResult a) where
show (FRErr s) = "#" ++ s
show (FRNum n) = show n
show (FRStr s) = s
--------------------------------------------------------------------------------
-- | Бинарные операции
data (Num a) => Func a
= FNum String (BinOp a) -- Арифметическая функция
| FStr String StrOp -- Строковая функция
| FErr String -- Недопустимая функция
| FQrN (Func a) a a -- Запрос на вычисление арифмет. функции
| FQrS (Func a) String String -- Запрос на вычисление строковой функции
| FRes (FResult a) -- И результат вычисление
instance (Show a, Num a) => Show (Func a) where
show (FNum s _) = s
show (FStr s _) = s
show (FQrN (FNum s _) a b) = show a ++ s ++ show b
show (FQrS (FStr s _) a b) = show a ++ s ++ show b
show (FRes r) = show r
show _ = "_?_"
instance (Integral a) => Read (Func a) where
readsPrec _ s = [(case s of
"+" -> FNum s (+)
"-" -> FNum s (-)
"*" -> FNum s (*)
"/" -> FNum s div
"^" -> FNum s (^)
"++" -> FStr s (++)
"--" -> FStr s (\\)
"**" -> FStr s union
"//" -> FStr s intersect
s -> FErr s
, "")]
instance (Num a) => Calculable (Func a) where
----------------------------------------------------------------------------
-- Безопасное вычисление арифметической операции
calculate (FQrN (FErr s) _ _) = FRes $ FRErr $ "Op:" ++ s
calculate (FQrS (FErr s) _ _) = FRes $ FRErr $ "Op:" ++ s
calculate (FQrN (FNum "/" _) a 0) = FRes $ FRErr "Inf"
calculate (FQrN (FNum _ f) a b) = FRes $ FRNum $ a `f` b
calculate (FQrN (FStr _ _) _ _) = FRes $ FRErr $ "StrOp on Numbers"
calculate (FQrS (FStr _ f) a b) = FRes $ FRStr $ a `f` b
calculate (FQrS (FNum _ _) _ _) = FRes $ FRErr $ "NumOp on Strings"
calculate _ = FRes $ FRErr $ "Query"
--------------------------------------------------------------------------------
-- | Содержимое ячейки таблицы
type IdCell a = (String, Cell a)
data Cell a
= CNull -- Пустая ячейка
| CNum a -- Целочисленная константа
| CRef String -- Ссылка на ячейку
| CStr String -- Строковая константа
| CErr String -- Ячейка с какой-то ошибкой
| CFun (Func a) (Cell a) (Cell a) -- Формула
| CQry (IdCell a) (Sheet a) -- Запрос на вычисление ячейки в контексте таблицы
instance (Show a, Integral a) => Show (Cell a) where
show CNull = " "
show (CNum n) = show n
show (CRef s) = s
show (CStr s) = s
show (CErr s) = "#" ++ s
show (CFun f x y) = show x ++ show f ++ show y
show (CQry c sh) = show c ++ show sh
instance (Read a, Integral a) => Read (Cell a) where
readsPrec _ s = [(parse s, "")]
where
-- Разбор ячейки из строкового вида
parse :: ( Read a, Integral a) => String -> Cell a
parse "" = CNull -- Пустая ячейка
parse str@(s:ss) | isDigit s = readNumb str -- Целочисленная константа
| s == '\'' = CStr ss -- Строковая константа
| s == '=' = pars $ reverse $ lines $ items ss -- Формула
| otherwise = CErr "Parse" -- Что-то не то...
-- Вставить перенос строки между элементами формулы
items :: String -> String
items s = case span isAlphaNum s of
("", "") -> ""
(left, "") -> left
(left, op'right) -> left ++ "\n" ++ op ++ "\n" ++ items right
where (op, right) = break isAlphaNum op'right
-- Преобразовать перевёрнутый список элементов формулы в саму формулу
pars :: (Read a, Integral a) => [String] -> Cell a
pars [x] = pars' x -- Число или ссылка на ячейку
pars (r:o:xs) = CFun (read o) (pars xs) (pars' r) -- Операция над двумя элементами
pars xs = CErr "Expr" -- Какая-то ошибка в формуле
pars' s@(x:xs) | isDigit x = readNumb s
| isAlpha x = CRef s
pars' s = CErr s
-- Попытаться прочесть целое число из строки
readNumb s | all isDigit s = CNum $ read s
| otherwise = CErr "NaN" -- Not a Number
instance (Integral a) => Calculable (Cell a) where
----------------------------------------------------------------------------
-- Вычисление ячейки таблицы
calculate (CQry (cid, cell) (Sheet sh)) = calc cell
where
-- Вычислить ячейку
calc (CFun f x y) = case (x, y) of
((CNum a), (CNum b)) -> res -- число с числом
where
res = case calculate $ FQrN f a b of
(FRes (FRNum n)) -> CNum n
(FRes (FRErr s)) -> CErr s
_ -> CErr "Calc"
((CStr a), (CStr b)) -> res -- строка со строкой
where
res = case calculate $ FQrS f a b of
(FRes (FRStr n)) -> CStr n
(FRes (FRErr s)) -> CErr s
_ -> CErr "Calc"
((CRef _), _) -> res -- что-то с ячейкой
(_, (CRef _)) -> res
((CFun _ _ _), _) -> res -- что-то с формулой
(_, (CFun _ _ _)) -> res
(err@(CErr _), _) -> err
(_, err@(CErr _)) -> err
otherwise -> CErr "Expr" -- ошибка в формуле
where
res = calc $ CFun f (calc x) (calc y)
calc (CRef x) = case lookup x sh of
Just z -> calc z -- вычислим ячейку
_ -> CErr "Cell" -- нет такой ячейки
calc x = x
calculate c = calculate $ CQry ("A1", c) (Sheet [])
--------------------------------------------------------------------------------
-- | Электронная таблица в виде списка кортежей,
-- первый элемент которых -- идентификатор ячейки (напр., "A1"),
-- а второй -- содержимое ячейки (напр., "=B2*5") в распарсенном виде
data Sheet a = Sheet [IdCell a]
instance (Show a, Integral a) => Show (Sheet a) where
show (Sheet s) = s
-- Разобьём на строки
|> groupBy (\(_:a,_) (_:b,_) -> a == b)
-- Теперь сформируем столбцы табуляцией
|> map (map (\(_, x) -> show x ++ "\t"))
-- И превратим всё это в одну длинную строку
|> map concat
|> unlines
instance (Read a, Integral a) => Read (Sheet a) where
readsPrec _ s = [(readSh s, "")]
where
readSh :: (Integral a, Read a) => String -> Sheet a
readSh s = ss
-- Разобъём строки таблицы на кучи ячеек
|> map (lines . map (\c -> if c == '\t' then '\n' else c))
-- Если введено было меньше столбцов, чем нужно, то добавим пустые (Null)
|> map ((take columns) . (++ repeat ""))
-- Пронумеруем ячейки таблицы в виде "A1"
|> map (zip (['A'..'Z'] ++ ['a'..'z']) . map read)
|> zip (map show [1..])
|> map (\(n, s) -> map (\(c, f) -> (c:n, f)) s)
-- И превратим всё это в таблицу
|> concat
|> Sheet
where
(rc:ss) = lines s -- Разобьём входную строку на строки таблицы
(_:o:_) = words $ rc ++ " 0"
columns = read o
instance (Integral a) => Calculable (Sheet a) where
----------------------------------------------------------------------------
-- Вычисление всей таблицы
calculate (Sheet sh) = Sheet sh'
where
-- Пройтись по всем элементам таблицы, пытаясь их вычислить
sh' = sh
-- Пометить зацикленные ячейки
|> map (\c@(cid,_) -> if isCycled cid then (cid, CErr "Cycle") else c)
-- Вычислить значения ячеек
|> map (\c@(cid,_) -> (cid, calculate $ CQry c (Sheet sh')))
-- Определить, зациклена ли ячейка
isCycled :: String -> Bool
isCycled x = x `elem` crefs
where
crefs = sh
|> map (\(cid, cell) -> (cid, cid, cids cell))
|> stronglyConnComp
|> filter isCyclic
|> flattenSCCs
|> sort
|> nub
cids (CFun _ a b) = cids a ++ cids b
cids (CRef cid) = [cid]
cids _ = []
isCyclic (CyclicSCC _) = True
isCyclic _ = False
У меня на это дело ушло где-то дня три-четыре. Чистого времени - больше суток...
Ох и намучился я с поиском циклических ссылок в ячейках таблицы... Зато обошёлся без библиотеки графов... :o)
На тестовый набор данных:
8 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 =1+A5+1 =5A =A1++C1
=1+ x ' =D1+D2
=D1++D2 =D1--D2 =D1**D2 =D1//D2
=D1++C6++D2++C6++D3
программа выдаёт результат:
12 -4 3 Sample
4 -16 -4 Spread
Test 1 5 Sheet
#Parse #Cell #Inf #Cycle
#Cycle #Cycle #NaN #StrOp on Numbers
#Expr #Parse #NumOp on Strings
SampleSpread ml Samplerd Sape
Sample Spread Sheet
Update. С целью получения максимально идиоматического :о) хаскеллевского решения, радикально редизайнил программу, используя классы типов... ;о)
Update. Расширил набор операций операциями над строками: конкатенация, разность, объединение и пересечение (вообще-то это операции над множествами, но и для строк пойдут)
Update. Таки переделал алгоритм поиска зацикленных ячеек таблицы на графы...
Backup. Добавил для истории первый вариант решения этой задачи (тот, который одобрили Гапертон, Thesz и Булат:
module Main where
import Char
import List
import Control.Monad
--------------------------------------------------------------------------------
-- | Главная функция: считать со stdin таблицу, подготовить,
-- вычислить и распечатать в stdout
main = print . calculate =<< getSheet
--------------------------------------------------------------------------------
-- Вспомогательные функции
-- | Перевёрнутый оператор $
x |> f = f x; infixl 0 |>
--------------------------------------------------------------------------------
-- Типы данных
-- | Некая бинарная операция: (Символ_операции, функция_операции)
type Func a = (Char, (a -> a -> a))
--------------------------------------------------------------------------------
-- | Набор допустимых целочисленных операций
func :: Char -> Func Integer
func c = case c of
'+' -> (c, (+))
'-' -> (c, (-))
'*' -> (c, (*))
'/' -> (c, div)
_ -> ('?', const) -- Недопустимая операция
--------------------------------------------------------------------------------
-- | Содержимое ячейки таблицы
data (Integral a) => Cell a = Null -- Пустая ячейка
| Numb a -- Целочисленная константа
| CRef String -- Ссылка на ячейку
| Str String -- Строковая константа
| Op (Func a) (Cell a) (Cell a) -- Формула
instance (Show a, Integral a) => Show (Cell a)
where
show Null = " "
show (CRef s) = s
show (Numb n) = show n
show (Str s) = s
show (Op (f,_) x y) = show x ++ [f] ++ show y
--------------------------------------------------------------------------------
-- | Какая-то ошибка при вычислении или разборе ячейки таблицы
err :: String -> Cell a
err ('#':str) = Str $ "#" ++ str
err str = Str $ "#" ++ str
--------------------------------------------------------------------------------
-- | Электронная таблица в виде списка кортежей,
-- первый элемент которых -- идентификатор ячейки (напр., "A1"),
-- а второй -- содержимое ячейки (напр., "=B2*5") в распарсенном виде
data Sheet a = Sheet [(String, Cell a)]
instance (Show a, Integral a) => Show (Sheet a)
where
show (Sheet s) = -- Разобьём на строки
groupBy (\(_:c1,_) (_:c2,_) -> c1 == c2) s
-- Теперь сформируем столбцы табуляцией
|> map (map (\(_, x) -> show x ++ "\t"))
-- И превратим всё это в одну длинную строку
|> map concat
|> unlines
instance Read (Sheet Integer)
where
readsPrec _ s = [(readSh s, "")]
where
readSh :: String -> Sheet Integer
readSh s = -- Разобъём строки таблицы на кучи ячеек
map (lines . map (\c -> if c == '\t' then '\n' else c)) ss
-- Если введено было меньше столбцов, чем нужно, то добавим пустые (Null)
|> map (++ repeat "")
|> map (take columns)
-- Пронумеруем ячейки таблицы в виде "A1"
|> map (zip (['A'..'Z'] ++ ['a'..'z']) . map parse)
|> zip (['1'..'9'] ++ "0")
|> map (\(n, s) -> map (\(c, f) -> (c:[n], f)) s)
-- И превратим всё это в таблицу
|> concat
|> Sheet
where
(c:ss) = lines s -- Разобьём входную строку на строки таблицы
columns = read c
--------------------------------------------------------------------------------
-- | Разбор ячейки из строкового вида
parse :: String -> Cell Integer
parse "" = Null -- Пустая ячейка
parse str@(s:ss) | isDigit s = readNumb str -- Целочисленная константа
| s == '\'' = Str ss -- Строковая константа
| s == '=' = pars $ reverse $ lines $ items ss -- Формула
| otherwise = err str -- Неправильная ячейка
where
-- Вставить перенос строки между элементами формулы
items s = case span isAlphaNum s of
("", "") -> ""
(left, "") -> left
(left, (op:right)) -> left ++ "\n" ++ [op] ++ "\n" ++ items right
-- Преобразовать перевёрнутый список элементов формулы в саму формулу
pars :: [String] -> Cell Integer
pars [x] = pars' x -- Число или ссылка на ячейку
pars (r:[o]:xs) = Op (func o) (pars xs) (pars' r) -- Операция над двумя элементами
pars xs = err "Expr" -- Какая-то ошибка в формуле
pars' s@(x:xs) | isDigit x = readNumb s
| isAlpha x = CRef s
pars' s = err s
readNumb s | all isDigit s = Numb $ read s
| otherwise = err "NaN" -- Not a Nnumber
--------------------------------------------------------------------------------
-- | Считать со stdin таблицу в список табличных строк,
-- каждая из которых в виде списка столбцов (в строковом представлении)
getSheet :: IO (Sheet Integer)
getSheet = do
s <- getLine
let (r, (_:c)) = span (/='\t') s
rows = read r
ss <- forM [1..rows] $ \_ -> do
return =<< getLine
return $ read $ c ++ "\n" ++ unlines ss
--------------------------------------------------------------------------------
-- | Собственно вычисление ячеек таблицы
calculate :: Sheet Integer -> Sheet Integer
calculate (Sheet sh) = Sheet sheet
where
-- Пройтись по всем элементам таблицы, пытаясь их вычислить
sheet = map (\(a, b) -> (a, calc b)) sh
-- Вычислить ячейку
calc :: Cell Integer -> Cell Integer
calc op@(Op f x y) = case (x, y) of
((Numb a), (Numb b)) -> eval f a b -- число с числом
((CRef _), _) -> res -- что-то с ячейкой
(_, (CRef _)) -> res
((Op _ _ _), _) -> res -- что-то с формулой
(_, (Op _ _ _)) -> res
otherwise -> err "Expr" -- ошибка в формуле
where
res = calc $ Op f (calc x) (calc y)
calc c@(CRef x) = if isCycled x
then err "Cycle" -- Зацикленная ссылка
else case lookup x sheet of
Nothing -> err $ show c -- нет такой ячейки
Just z -> calc z -- иначе вычислим ячейку
calc x = x
-- Безопасное вычисление арифметической операции
eval :: Func Integer -> Integer -> Integer -> Cell Integer
eval ('?',_) _ _ = err "Operator"
eval ('/',_) a 0 = err "Inf"
eval ( _, f) a b = Numb $ a `f` b
-- Определить, зациклена ли ячейка
isCycled :: String -> Bool
isCycled x = x `elem` take (length sh) (cycles x)
where
-- Найти список ячеек, на которые ссылается данная
cycles x = case lookup x sh of
Just (CRef y) -> y:cycles y
Just (Op _ a b) ->
case (a, b) of
(CRef y, CRef z) -> y:cycles y ++ z:cycles z
(CRef y, _) -> y:cycles y
(_, CRef z) -> z:cycles z
_ -> []
_ -> []