haskell初学者求讨论
查看原帖
haskell初学者求讨论
625398
_OTZ_楼主2024/10/13 17:01
  • 使用了 array 存取矩阵,下标 1..n
  • 使用了一个 Map 存取字母到Int的对应关系

请大佬们帮忙看下,讨论下写法


module Main where

import Control.Monad (replicateM)
import Control.Monad.Reader (MonadReader (ask), Reader, runReader)
import Control.Monad.State (StateT, execStateT, modify)
import Data.Array
import Data.Char (intToDigit)
import Data.Foldable (Foldable (toList))
import qualified Data.Map as M
import Data.Maybe (fromMaybe)

main :: IO ()
main = do
  numberOfRows <- read <$> getLine
  matrix <- listArray (1, numberOfRows) <$> replicateM (numberOfRows) (readLine numberOfRows)
  let letterIntMapping = flip runReader matrix . flip execStateT mempty . getLetterIntMapping $ 1
  if verify matrix letterIntMapping
    then
      ( putStrLn . unwords . tail $
          ((formatAnwser letterIntMapping) . head) <$> (toList (matrix ! 1))
      )
        >> (putStrLn . show $ numberOfRows - 1)
    else putStrLn "ERROR!"

readLine :: Int -> IO (Array Int String)
readLine numberOfRows = listArray (1, numberOfRows) . words <$> getLine

type AdditionTable = Array Int (Array Int String)

type LetterIntMapping = M.Map Char Int

getLetterIntMapping :: Int {- layerCount -} -> StateT LetterIntMapping (Reader AdditionTable) ()
getLetterIntMapping layerCount = do
  table <- ask
  if layerCount <= (snd . bounds $ table)
    then do
      let curRow = table ! layerCount
      modify (M.insert (head $ curRow ! 1) (length . filter ((> 1) . length) . toList $ curRow))
      getLetterIntMapping $ layerCount + 1
    else return ()

verify :: AdditionTable -> LetterIntMapping -> Bool
verify table mapping =
  let numsOfRow = snd $ bounds table
   in all (flip runReader (table, mapping) . verifyAPoint) [(x, y) | x <- [2 .. numsOfRow], y <- [2 .. numsOfRow]]

verifyAPoint :: (Int, Int) -> Reader (AdditionTable, LetterIntMapping) Bool
verifyAPoint (row, column) = do
  (table, mapping) <- ask
  let letterToInt' = flip letterToInt mapping
      columnValue = letterToInt' (head $ table ! 1 ! column)
      rowValue = letterToInt' (head $ table ! row ! 1)
      baseN = (subtract 1) . snd $ bounds table
      (quot', rem') = quotRem (columnValue + rowValue) baseN
  return $ (intToDigit . letterToInt' <$> table ! row ! column) == ((if quot' /= 0 then show quot' else []) ++ show rem')
  where
    letterToInt ch map = fromMaybe (-1) $ M.lookup ch map

formatAnwser :: LetterIntMapping -> Char -> String
formatAnwser _ '+' = mempty
formatAnwser mapping ch = ch : '=' : (show $ fromMaybe (negate 1) (M.lookup ch mapping))
2024/10/13 17:01
加载中...