{-# LANGUAGE FlexibleContexts #-}
module Main.Diagnose where
import Main.ParserCSV
import Data.List
import Data.Time
import Ideas.Common.Id
import Ideas.Text.HTML
import Recognize.Data.MathStoryProblem
import Recognize.Data.Approach
import Recognize.Data.Entry
import Recognize.Data.Solution
import Util.W3CSSHTML
diagnoseSingle :: MathStoryProblem -> String -> IO Entry
diagnoseSingle e _ = timed $ do
let entry = diagnose e (defaultSolution [error "diagnoseSingle conversion of Solution"])
print entry
writePage ("single."++show e) (makePage (show e) (toHTML entry))
return entry
diagnoseMultiple :: MathStoryProblem -> CSV -> IO ()
diagnoseMultiple e csv = timed $ do
let answers = map (defaultSolution . map (uncurry Input . fmap ((:[]).Right))) (restrict csv)
nrs = [1 :: Int ..]
entries = zipWith (\_ -> diagnose e) nrs answers
writeFileMsg "output/diagnosed.txt" (outDiagnose entries)
writeFileMsg "output/categories.txt" (outCategories entries)
writeOutput ("output/out."++show e++".txt") entries
writePage ("all."++show e) (makePage (show e) (mconcat (map toHTML entries)))
putStrLn $ "Answers: " ++ show (length entries)
putStrLn $ categoryStatistics entries
timed :: IO a -> IO a
timed m = do
t0 <- getCurrentTime
a <- m
t1 <- getCurrentTime
putStrLn $ "time: " ++ show (diffUTCTime t1 t0)
return a
writeOutput :: FilePath -> [Entry] -> IO ()
writeOutput file = writeFileMsg file . show
writeFileMsg :: FilePath -> String -> IO ()
writeFileMsg file s = do
putStr $ "Generating " ++ file ++ "... "
writeFile file s
putStrLn "ok"
outDiagnose :: [Entry] -> String
outDiagnose = unlines . zipWith f [0 :: Int ..]
where
f nr entry = nrStr ++ "\n" ++ concatMap (\d -> show d ++ "\n") (diagnoses entry)
where
nrStr = "#" ++ show nr ++ ": "
outCategories :: [Entry] -> String
outCategories = unlines . zipWith f [0 :: Int ..]
where
f nr entry = nrStr ++ intercalate ", " (map (show . approach) $ diagnoses entry)
where
nrStr = "#" ++ show nr ++ ": "
categoryStatistics :: [Entry] -> String
categoryStatistics xs = unlines $ map f $ count $ map categoryAsString xs
where
nrTotal = length xs
f (d, n) = d ++ ": " ++ show n ++ percPar n nrTotal
count :: Ord a => [a] -> [(a, Int)]
count = map f . group . sort
where
f xs = (head xs, length xs)
percPar :: Integral a => a -> a -> String
percPar x y = " (" ++ perc x y ++ ")"
perc :: Integral a => a -> a -> String
perc x y | y == 0 = "0%"
| otherwise = show d ++ "." ++ make (show m) ++ "%"
where
(d, m) = (round ((10000 * fromIntegral x / fromIntegral y) :: Double) :: Integer) `divMod` 100
make s = replicate (2 - length s) '0' ++ s
restrict :: [[String]] -> [[(Id,String)]]
restrict xs = map (zip header) content
where
ys = map (map normalize) xs
header = map newId (head ys)
content = filter (\y -> p y && not (null y)) (tail ys)
p = all (not . isInfixOf "v0")
normalize :: String -> String
normalize [] = []
normalize xs | "\\'" `isPrefixOf` xs = "'" ++ normalize (drop 2 xs)
| "\\\"" `isPrefixOf` xs = '"' : normalize (drop 2 xs)
| "&#x" `isPrefixOf` xs =
case break (== ';') (drop 3 xs) of
(xs1, ';':xs2) ->
case lookup xs1 asciiTable of
Just c -> c : normalize xs2
Nothing -> '?' : normalize xs2
_ -> error "normalize"
normalize (x:xs) = x : normalize xs
asciiTable :: [(String, Char)]
asciiTable =
[ ("e9", 'e')
, ("e0", 'a')
, ("e8", 'e')
, ("f9", 'u')
, ("ea", 'e')
, ("e2", 'a')
, ("e7", 'c')
, ("c3", 'A')
, ("f7", '%')
, ("a0", ' ')
, ("a9", '?')
, ("b0", '?')
, ("aa", '?')
]