Created
February 24, 2021 23:38
-
-
Save thedeemon/199130c0cdef6e47c124ef9065ad402c to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| import Text.Read | |
| import Data.Foldable | |
| sampleData = | |
| [ | |
| ["10", "20", "30"], | |
| ["0", "1", "aa", "2"], | |
| ["0", "eheh", "1", "bb", "2"], | |
| ["2", "really", "bad"], | |
| ["3", "4", "5"] | |
| ] | |
| main = processData sampleData | |
| processData grid = | |
| let res = grid |> parseGrid |> fixGrid |> addOne | |
| in do printMatrix res | |
| explainFixes res | |
| explainBeyondRepair res | |
| (|>) x f = f x -- our pipeline operator | |
| -- types for reporting errors for single elements of the grid | |
| type Position = (Int, Int) | |
| data Err = Err { | |
| position :: Position, | |
| message :: String | |
| } deriving Show | |
| parseElement :: String -> Position -> Either Err Double | |
| parseElement str pos = case readMaybe str of | |
| Just x -> Right x | |
| Nothing -> Left (Err pos str) | |
| coords :: [[Position]] | |
| coords = [[(i,j) | j <-[1..]] | i <- [1..]] | |
| parseGrid grid = zipWith (zipWith parseElement) grid coords | |
| -- unrec error or (row of numbers, list of remarks) | |
| fixLine :: [Either Err Double] -> Either String ([Double], [String]) | |
| fixLine row = case row of | |
| Right a : Left e : Right b : rest -> do | |
| let v = (a+b)/2 | |
| let newMsg = "Fixed a value at " ++ show (position e) | |
| (goodRest, messages) <- fixLine (Right v : Right b : rest) | |
| return (a : goodRest, newMsg : messages) | |
| Right _ : Left e : Left _ : rest -> Left ("Unrecoverable at " ++ show (position e)) | |
| Right a : Right b : rest -> do | |
| (goodRest, messages) <- fixLine (Right b : rest) | |
| return (a : goodRest, messages) | |
| Right a : [] -> Right ([a], []) | |
| Left e : rest -> Left ("Unrecoverable at " ++ show (position e)) | |
| data Res = Res { -- result of the whole computation | |
| ok :: Bool, -- successful? | |
| matr :: [[Double]], -- the matrix of numbers | |
| remarks :: [String] | |
| } deriving Show | |
| fixGrid :: [[Either Err Double]] -> Res | |
| fixGrid grid = loop ([], []) grid where | |
| loop (matrix, messages) rows = case rows of | |
| [] -> Res True (reverse matrix) (reverse messages) | |
| row : rest -> case fixLine row of | |
| Right (xs, msgs) -> loop (xs : matrix, msgs ++ messages) rest | |
| Left msg -> Res False (reverse matrix) (msg : reverse messages) | |
| addOne :: Res -> Res | |
| addOne (Res o m r) = Res o (map (map (+ 1.0)) m) r | |
| printMatrix :: Res -> IO () | |
| printMatrix (Res _ matrix _) = forM_ matrix (putStrLn . show) | |
| explainFixes :: Res -> IO () | |
| explainFixes (Res ok _ messages) = | |
| -- if !ok the first msg is about beyond repair, skip it here | |
| let msgs = if ok then messages else drop 1 messages | |
| in forM_ msgs putStrLn | |
| explainBeyondRepair :: Res -> IO () | |
| explainBeyondRepair (Res ok _ messages) = | |
| if ok then return () else putStrLn ("Why failed: " ++ head messages) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment