module Main(main) where
import Char
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Monad.State
type CellRef = (String,String)
data Cell =
CEmpty
| CError String
| CInt Int
| CText String
| CFormulae CExpr
data BinOp =
BPlus
| BMinus
| BMul
| BDiv
data CExpr =
CECell CellRef
| CEInt Int
| CEBin BinOp CExpr CExpr
instance Show Cell where
show CEmpty = ""
show (CError s) = '#':s
show (CInt i) = show i
show (CText t) = t
show (CFormulae e) = '=':show e
instance Show BinOp where
show BPlus = "+"
show BMinus = "-"
show BMul = "*"
show BDiv = "/"
instance Show CExpr where
show (CECell (r,c)) = (c)++r
show (CEInt i) = show i
show (CEBin op a b) = show a++show op++show b
splitByTab l = split Nothing l
where
split Nothing [] = []
split (Just acc) [] = [reverse acc]
split acc (x:xs)
| x == '\t' = case acc of
Nothing -> []:split Nothing xs
Just acc -> reverse acc:split Nothing xs
| otherwise = case acc of
Nothing -> split (Just [x]) xs
Just acc -> split (Just $ x:acc) xs
tabbedListLine = do
l <- getLine
return $ splitByTab l
parseWH :: IO (Int,Int)
parseWH = do
hw <- tabbedListLine
case hw of
[hs,ws] -> return (read ws,read hs)
_ -> error "Illegal height and width line."
allindexes = chars1++nextchars chars1
where
chars = ['A'..'Z']
chars1 = map (\x -> [x]) chars
nextchars pcs = let cs' = [ c:cs | c <- chars, cs <- pcs] in cs'++nextchars cs'
parseCells w h = parselines M.empty 1
where
parselines cells j
| j > h = return cells
| otherwise = do
cells' <- parseline j
parselines (M.union cells cells') (j+1)
indexes j = map (\x -> (show j,x)) $ take w allindexes
parseline j = do
l <- tabbedListLine
return $ M.fromList $ zip (indexes j) $ filter notEmpty $ (map parse l)
notEmpty CEmpty = False
notEmpty _ = True
parse "" = CEmpty
parse ('\'':text) = CText text
parse ('=':formulae) = parseexpr formulae
parse i@(x:xs)
| isDigit x = CInt (read i)
| otherwise = CError "NAI"
parseexpr "" = CError "NoExpr"
parseexpr e = case pexpr e of
Just e -> CFormulae e
Nothing -> CError "Parse"
pexpr e = case parg e of
Just (a,rem) -> case rem of
(bop:args) -> case binop bop of
Just bop -> case pexpr args of
Just b -> Just $ CEBin bop a b
Nothing -> Nothing
Nothing -> Nothing
_ -> Just a
Nothing -> Nothing
where
binop '+' = Just BPlus
binop '-' = Just BMinus
binop '*' = Just BMul
binop '/' = Just BDiv
binop _ = Nothing
parg [] = Nothing
parg e@(c:cs)
| isDigit c = let
(n,rest) = span isDigit e
in
Just (CEInt (read n),rest)
| isAlpha c = let
(c,restc) = span isAlpha e
(r,restr) = span isDigit restc
in case (c,r) of
([],_) -> Nothing
(c,[]) -> Nothing
(c,r) -> Just (CECell (r,map toUpper c),restr)
| otherwise = Nothing
dig c = fromEnum (toUpper c)-fromEnum 'A'+1
base = dig 'z'+1
colToInt col = acc 0 $ map dig col
where
acc sum [] = sum
acc sum (c:cs) = acc (sum*base+c) cs
intToCol :: Int -> String
intToCol 1 = "A"
intToCol i = map (toEnum . (fromEnum 'A'+)) $ reverse $ mods i
where
mods 0 = []
mods x = let (d,m) = divMod x base in (m-1):mods d
celllookup i j cells = case M.lookup (i,j) cells of
Nothing -> error $ "empty looking up "++show (i,j) -- CEmpty
Just x -> x
getcell i j = do
cells <- get
return $ celllookup i j cells
setcell i j cell = do
cells <- get
put $ M.adjust (const cell) (i,j) cells
markerror i j = do
x <- getcell i j
setcell i j (CError "cycle")
return x
printCells w h cells = print 1
where
printrow i j
| j<=w = do
putStr (show $ celllookup (show i) (intToCol j) cells)
if j/=w then putStr "\t" else return ()
printrow i (j+1)
| otherwise = putStrLn ""
print i
| i <= h = do
printrow i 1
print (i+1)
| otherwise = return ()
evalcells cells = execState (eval formulaes) cells
where
allcells = M.toList cells
formulaes = map (\((i,j),_) -> (i,j)) $ filter isformulae allcells
isformulae (_,CFormulae _) = True
isformulae _ = False
eval ((i,j):fs) = do
evalcell i j
eval fs
eval [] = return ()
evalcell i j = do
x <- getcell i j
case x of
CFormulae expr -> do
markerror i j
r <- evalexpr expr
setcell i j r
return r
v -> return v
evalexpr (CECell (i,j)) = evalcell i j
evalexpr (CEInt i) = return $ CInt i
evalexpr (CEBin op a b) = do
ar <- evalexpr a
case ar of
CError _ -> return ar
x -> evalbin op ar b
evalbin op ar b = case b of
CEBin op' a' b -> do
ar' <- evalexpr a'
evalbin op' (apply op ar ar') b
_ -> do
br <- evalexpr b
return $ apply op ar br
apply _ ar@(CError _) _ = ar
apply _ _ br@(CError _) = br
apply op (CInt x) (CInt y) = case op of
BPlus -> CInt $ x + y
BMinus -> CInt $ x - y
BMul -> CInt $ x * y
BDiv
| y == 0 -> CError "DBZ"
| otherwise -> CInt $ x `div` y
apply _ _ _ = CError "InvOp"
main = do
(width,height) <- parseWH
cells <- parseCells width height
printCells width height $ evalcells cellsВыдержать "промышленный уровень" мне не удалось. ;)
Пальцы сами не хотят писать evalCells или cellLookup. ;)
Три часа работы. Два затруднения - нумерация ячеек и порядок вычисления выражений (откель там и появился evalbin;).
С циклами проблем не возникло, по крайней мере, в первом приближении. Есть небольшая неприятность - если встречается цикл, то сообщение об ошибке из него распространяется на все ссылающиеся на этот цикл элементы.
Проблем с проектированием типов данных (на это делается упор при рассмотрении решения на C++) не возникло.
Расширение в сторону операций со строками делается просто - добавляются необходимые сравнения с образцом в apply.
Для обработки больших таблиц необходимо не хранить пустые элементы в cells (сейчас они хранятся).