Ru/Problem K

-- чистое время решения задачи - 8 часов
import Prelude hiding (catch)
import Control.Exception
import Data.Char
import Data.Graph
import Data.List
import Data.Function (on)
import Data.Ord (comparing)
 
-----------------------------------------------------------------------------------------------
-- Мини-библиотека ----------------------------------------------------------------------------
-----------------------------------------------------------------------------------------------
 
mapSnds         = map.mapSnd
mapSnd  f (a,b) = (a,f b)
groupOn f       = groupBy ((==) `on` f)
sortOn  f       = sortBy  (comparing f)
a.$b = b a
 
-- Вычислить (f x), возвращая вместо ошибок при вычислении errValue
reliable :: (x->y) -> y -> x -> IO y
reliable f errValue x  =  (evaluate$ f x) `catch` (\_ -> return errValue)
 
 
 
-----------------------------------------------------------------------------------------------
-- Типы данных --------------------------------------------------------------------------------
-----------------------------------------------------------------------------------------------
 
-- Таблица, содержимое ячеек которой представлено типом a
type Sheet a = [NamedCell a]
-- Отображение содержимого ячеек
mapSheet  f = mapSnds f
mapSheetM f = mapM (\(a,b) -> do fb <- f b; return (a,fb))
 
-- Поименованная ячейка
type NamedCell a = (CellName,a)
 
-- Имя ячейки (такое, как "a1")
type CellName = String
 
-- Содержимое ячейки: пусто/строка/выражение/ошибка
--   a = Expr Int   до вычислений по формулам
--   a = Int        после вычислений
data Cell a  =  EmptyCell | StringCell String | ExprCell a | ErrorCell String
 
-- AST выражения, имеющего тип a
data Expr a  =  BinOp (BinOp a) (Expr a) (Expr a)
             |  RefCell CellName
             |  Const a
 
-- Бинарная операция
type BinOp a  =  a->a->a
-- Превращение строковой записи в бинарную операцию
cvt "+" = (+)
cvt "-" = (-)
cvt "*" = (*)
cvt "/" = div
 
-- Список ячеек, на которые ссылается Expr
refs (BinOp   _ x y)  =  refs x++refs y
refs (RefCell name)   =  [name]
refs (Const   _)      =  []
 
 
-----------------------------------------------------------------------------------------------
-- Программа ----------------------------------------------------------------------------------
-----------------------------------------------------------------------------------------------
--main = interact$ fromSheet.mapSheet showCell.calcSheet.removeCycles.mapSheet parseCell.toSheet
 
 
main = do
    input <- getContents
    -- Конвертирует входной формат данных в таблицу строк
    let inputSheet      = toSheet input                   :: Sheet String
    -- Проводит парсинг содержимого каждой ячейки
    parsedSheet <- mapSheetM (reliable parseCell (ErrorCell "#PARSING")) inputSheet
                                                          :: IO (Sheet (Cell (Expr Int)))
    -- Заменяет формулы в циклически зависящих ячейках на сообщения об ошибке
    let acyclicSheet    = removeCycles parsedSheet        :: Sheet (Cell (Expr Int))
    -- Вычисляет формулы в ячейках
    let calculatedSheet = calcSheet acyclicSheet          :: Sheet (Cell Int)
    -- Заменяет результат вычисления в каждой ячейке его текстовым представлением
    outputSheet <- mapSheetM (reliable showCell "#EVAL") calculatedSheet  :: IO (Sheet String)
    -- Конвертирует таблицу строк в выходной формат данных
    putStrLn (fromSheet outputSheet)
 
 
 
-- Превращает входные данные в список пар (имя ячейки, её содержимое):
--   [ ("a1", "2"), ("a2", "=a1+1"),  ("b1", "=a2+1"), ("b2", "=b1") ]
toSheet :: String -> Sheet String
toSheet input  =  enumSheet xs  where
   -- xs - тексты ячеек, разбитые построчно
   xs :: [[String]]
   x:xs = map words$ lines input
   -- число строк/столбцов в таблице, записанное в первой строке ввода
   -- [rows,cols] = map read x
   -- Перенумеровать все ячейки таблицы
   enumSheet :: [[a]] -> Sheet a
   enumSheet = concat . zipWith enumRow [1..]
   -- Перенумеровать ячейки строки num
   enumRow :: Int -> [a] -> [NamedCell a]
   enumRow num = zipWith (enumCell num) ['a'..]
   -- Занумеровать ячейку столбца letter строки num
   enumCell :: Int -> Char -> a -> NamedCell a
   enumCell num letter cell = (letter:show num, cell)
 
 
 
-- Парсит содержимое ячейки, превращая входную строку во внутреннее представление
parseCell :: String -> Cell (Expr Int)
parseCell "\"\""                      =  EmptyCell
parseCell ('\'':xs)                   =  StringCell xs
parseCell ('=':xs)                    =  ExprCell$ parseExpr xs
parseCell xs        | all isDigit xs  =  ExprCell$ Const (read xs)
 
-- Парсит выражение (начинающееся с '=')
parseExpr :: (Integral a, Read a) =>  String -> Expr a
parseExpr = build.reverse.split where
  -- разбивает строку на список строк [терм,операция,терм,операция...терм]
  split xs | null rest  =  [xs]
           | otherwise  =  x:op:split rest1
    where (x,rest)   = span isAlphaNum xs
          (op,rest1) = break isAlphaNum rest
  -- строит Expr из списка термов/операций (заменить на вызов fold*!)
  build (x:op:xs)  =  BinOp (cvt op) (build xs) (term x)
  build [x]        =  term x
  -- парсит терм = число | имя ячейки
  term xs | all isDigit xs  =  Const (read xs)
          | otherwise       =  RefCell (map toLower xs)
 
 
 
-- Заменяет циклически зависимые ячейки на сообщения об ошибке
removeCycles :: Sheet (Cell (Expr Int)) -> Sheet (Cell (Expr Int))
removeCycles  =  concatMap replaceCycles . topSort  where
  -- Выделить группы ячеек с циклическими зависимостями
  topSort :: Sheet (Cell (Expr Int)) -> [SCC (CellName, Cell (Expr Int))]
  topSort = stronglyConnComp . map f
                where -- f вычисляет, на какие ячейки ссылается эта
                      f x = (x, fst x, refs1 (snd x))
                      refs1 (ExprCell e) = refs e
                      refs1 _            = []
  -- Заменить содержимое циклически зависимых ячеек на сообщения об ошибке
  replaceCycles :: SCC (CellName, Cell (Expr Int)) -> [(CellName, Cell (Expr Int))]
  replaceCycles (AcyclicSCC cell)   =  [cell]
  replaceCycles (CyclicSCC  cells)  =  mapSnds (const$ ErrorCell "#CYCLE") cells
 
 
 
-- Заменяет формулы в ячейках на результаты их вычисления
calcSheet :: Sheet (Cell (Expr Int)) -> Sheet (Cell Int)
calcSheet sheet = result  where
  -- Таблица, в которой формулы заменены результатами их вычислений
  result :: Sheet (Cell Int)
  result = mapSnds calcCell sheet
  -- Замена формулы в ячейке на результат её вычисления
  calcCell :: Cell (Expr Int) -> Cell Int
  calcCell EmptyCell       =  EmptyCell
  calcCell (StringCell s)  =  StringCell s
  calcCell (ExprCell   e)  =  ExprCell   (calc e)
  calcCell (ErrorCell  s)  =  ErrorCell  s
  -- Вычисление значения выражения
  calc :: Expr Int -> Int
  calc (Const x)       =  x
  calc (BinOp op x y)  =  op (calc x) (calc y)
  calc (RefCell x)     =  answer
                            where Just (ExprCell answer) = lookup x result
 
 
 
-- Выводит текстовое представление вычисленной ячейки
showCell :: Cell Int -> String
showCell EmptyCell       =  "\"\""
showCell (StringCell s)  =  s
showCell (ExprCell x)    =  show x
showCell (ErrorCell s)   =  s
 
 
-- Конвертирует таблицу строк в выходной формат данных
fromSheet :: Sheet String -> String
fromSheet xs = xs.$ sortOn  (tail.fst)          -- Разбить ячейки на rows
                 .$ groupOn (tail.fst)          -- ..
                 .$ map (unwords.map snd.sort)  -- Текстовое представление каждого row
                 .$ unlines                     -- Слить текстовые представления rows