Здравствуйте, BulatZiganshin, Вы писали:
BZ>поскольку каждый архитектор должен построить дом, подписать письмо четырёх и решить задачу К, я тоже не выдержал. см. http://www.haskell.org/haskellwiki/Ru/Problem_K
А не проще ли было как-то поимперативнее? Я хаскель знаю слабо, но вот в духе потока сознания родилось следующее:
import Control.Monad
import Data.Array.IO
import Data.IORef
import Data.List
import Data.Char
import Text.ParserCombinators.Parsec
import Control.Exception
import Prelude hiding (catch)
--------------------------------------------------------------------------------------
data Table = Table
{ tWidth :: Int
, tHeight :: Int
, tData :: IOArray (Int,Int) Cell
}
data Cell = CEmpty
| CNumber Integer
| CText String
| CExpr Expr
| CError String
data Expr = ESimple Term
| EBinary Expr Op Term
data Term = ENumber Integer
| ERef Int Int
data Op = OPlus
| OMinus
| OMul
| ODiv
deriving Eq
numOps = [(OPlus, (+)), (OMinus, (-)), (OMul, (*)), (ODiv, div)]
evalOp (CNumber n1, op, CNumber n2) = CNumber $ n1 `f` n2 where Just (_,f) = find ((== op).fst) numOps
evalOp _ = errEval
errParse = CError "#Parse"
errEval = CError "#Eval"
errIdx = CError "#Index"
errExpr = CError "#Expr" -- unevaluated
instance Show Cell where
show CEmpty = ""
show (CNumber n) = show n
show (CText t) = t
show (CExpr e) = show errExpr
show (CError e) = e
--------------------------------------------------------------------------------------
parseTable :: String -> IO Table
parseTable input = do
case lines input of
[] -> error "invalid input"
(l:ls) -> do let [h,w] = map toInt . split $ l
dat <- newArray ((0,0),(h-1,w-1)) CEmpty :: IO (IOArray (Int,Int) Cell)
forM_ (zip [0..] ls) $ \(i,l) ->
forM_ (zip [0..] $ split l) $ \(j,x) ->
writeArray dat (i,j) $ parseCell x
return Table { tWidth = w, tHeight = h, tData = dat }
where toInt = read :: String -> Int
split = lines . map (\c -> if c == '\t' then '\n' else c)
parseCell :: String -> Cell
parseCell "" = CEmpty
parseCell ('\'':s) = CText s
parseCell ('=' :s) = case parse expr "" s of
Right e -> CExpr e
Left _ -> errParse
parseCell s | all isDigit s = CNumber (read s)
| otherwise = errParse
expr = do { t <- term; rest $ ESimple t }
rest e = do { eof; return e }
<|> do { o <- op; t <- term; rest $ EBinary e o t }
op = foldl1 (<|>) $
map (\(ch,op) -> do { char ch; return op })
[('+',OPlus), ('-', OMinus), ('*', OMul), ('/', ODiv)]
term = do { n <- number; return $ ENumber n }
<|> do { a <- letter; n <- number; return $ ERef (fromIntegral n - 1) (ord (toUpper a) - ord 'A') }
number = do { ds <- many1 digit; return (read ds :: Integer) }
--------------------------------------------------------------------------------------
printTable :: Table -> IO ()
printTable (Table w h d) = do
a <- newArray ((0,0),(h-1,w-1)) "" :: IO (IOArray (Int,Int) String)
forM_ [(i,j) | i <- [0..h-1], j <- [0..w-1]] $ \(i,j) -> do
c <- readArray d (i,j)
t <- evaluate (show c) `catch` (const $ return $ show errEval)
writeArray a (i,j) t
maxw <- foldl (\a x -> a `max` length x) 1 `liftM` getElems a
forM_ [0..h-1] $ \i -> do
(putStrLn . concat . intersperse " " . map (pad maxw)) =<< (forM [0..w-1] $ \j -> readArray a (i,j))
where pad w s = s ++ replicate (w - length s) ' '
--------------------------------------------------------------------------------------
data CState = CInit | CEval | CDone deriving Eq
evalTable :: Table -> IO Table
evalTable (Table w h d) = do
st <- newArray ((0,0),(h-1,w-1)) CInit :: IO (IOArray (Int,Int) CState)
d' <- mapArray id d -- copy ("let d' = d" evaluates table in place)
let eval ij = do
curst <- readArray st ij
case curst of
CDone -> return ()
CEval -> error "eval"
CInit -> do writeArray st ij CEval
c <- readArray d' ij
c' <- case c of
CExpr e -> evalExpr e
_ -> return c
writeArray d' ij c'
writeArray st ij CDone
evalExpr (ESimple t) = evalTerm t
evalExpr (EBinary e o t) = do e' <- evalExpr e
t' <- evalTerm t
return $ evalOp (e', o, t')
evalTerm (ENumber n) = return $ CNumber n
evalTerm (ERef i j) = if i < 0 || j < 0 || i >= h || j >= w
then return errIdx
else do
tmpst <- readArray st (i,j)
if tmpst == CEval
then return errEval
else do if tmpst == CInit then eval (i,j) else return ()
c' <- readArray d' (i,j)
case c' of
CNumber _ -> return c'
_ -> return errEval
forM_ [(i,j) | i <- [0..h-1], j <- [0..w-1]] eval
return $ Table w h d'
--------------------------------------------------------------------------------------
main = printTable =<< evalTable =<< parseTable =<< getContents
Наверное, если знать язык получше, можно упростить и сократить.