module Data.Number.ER.Real.Approx.Tests.Reporting 

where

import qualified Data.Number.ER.Real.Approx as RA

import Data.Number.ER.Misc

import qualified Data.List as List
import Text.Regex
import System.IO


unsafeERTestReport ::
    (Show tId, Show sId, RA.ERIntApprox ira) =>
    String ->
    (tId, sId, ira, ira) ->
    a -> a
unsafeERTestReport reportFileName (testId, subId, almostPreciseVal, approxVal) =
    unsafeReport reportFileName $ 
        stdRepLine (testId, subId) (overestimation, detail)
    where
    overestimation = fst $ getOverestimation almostPreciseVal approxVal
    detail = (almostPreciseVal, approxVal)

stdRepLine (testId, subId) (overestimation, detail) =
    "case=" ++ show testId
    ++ ";pt=" ++ show subId
    ++ ";ovest=" ++ show overestimation
    ++ ";detail=" ++ show detail

getOverestimation ::
    (RA.ERIntApprox ira) =>
    ira -> ira -> (Double, (ira, ira))
getOverestimation model res =
    ((abs $ wMod - wRes) / (1 + (max 0 (wMod))), (model, res))
    where
    wMod = hMod - lMod
    wRes = hRes - lRes
    (lMod, hMod) = RA.doubleBounds model
    (lRes, hRes) = RA.doubleBounds res
    
produceSummary :: String -> IO ()
produceSummary filepath =
    do
    casesInfo <- parseReport filepath
    writeFile summaryFilepath $ formatSummary casesInfo
    return ()
    where
    summaryFilepath = filepath ++ "-summary"
    formatSummary casesInfo =
        "all " ++ show casesCount ++ " cases:"
        ++ "\n  approx. average time per case: " ++ show timeInSeconds ++ " seconds"
        ++ "\n  approx. average per case average overestimation: " ++ show avgOverestimation
        ++ "\n  approx. average per case maximum overestimation: " ++ show maxOverestimation
        ++ "\n\n removing the worst 5% of the cases (for each measure separately):"
        ++ "\n  approx. average time per case: " ++ show timeInSeconds95 ++ " seconds"
        ++ "\n  approx. average per case average overestimation: " ++ show avgOverestimation95
        ++ "\n  approx. average per case maximum overestimation: " ++ show maxOverestimation95
        ++ "\n\n considering only the worst 50% but not the worst 5% of the cases (for each measure separately):"
        ++ "\n  approx. average time per case: " ++ show timeInSeconds45 ++ " seconds"
        ++ "\n  approx. average per case average overestimation: " ++ show avgOverestimation45
        ++ "\n  approx. average per case maximum overestimation: " ++ show maxOverestimation45
        ++ "\n\n considering only the best 50% of the cases (for each measure separately):"
        ++ "\n  approx. average time per case: " ++ show timeInSeconds50 ++ " seconds"
        ++ "\n  approx. average per case average overestimation: " ++ show avgOverestimation50
        ++ "\n  approx. average per case maximum overestimation: " ++ show maxOverestimation50
        ++ "\n\n" ++ (unlines $ map formatSummaryCase casesInfo)
        where
        (allTimes, (allAvgOvers, allMaxOvers)) =
            mapSnd unzip $ unzip $ snd $ unzip casesInfo
        timeInSeconds = (sum allTimes) / casesCountF
        avgOverestimation = (sum allAvgOvers) / casesCountF
        maxOverestimation = (sum allMaxOvers) / casesCountF
        casesCount = length casesInfo
        casesCountF :: Double
        casesCountF = fromInteger $ toInteger casesCount
        
        timeInSeconds95 = (sum allTimes95) / casesCount95F
        avgOverestimation95 = (sum allAvgOvers95) / casesCount95F
        maxOverestimation95 = (sum allMaxOvers95) / casesCount95F
        allTimes95 = drop fivePerCent $ reverse $ List.sort allTimes 
        allAvgOvers95 = drop fivePerCent $ reverse $ List.sort allAvgOvers 
        allMaxOvers95 = drop fivePerCent $ reverse $ List.sort allMaxOvers
        casesCount95F = fromInteger $ toInteger $ casesCount - fivePerCent
        fivePerCent = max 1 $ (5 * casesCount) `div` 100
        
        timeInSeconds50 = (sum allTimes50) / casesCount50F
        avgOverestimation50 = (sum allAvgOvers50) / casesCount50F
        maxOverestimation50 = (sum allMaxOvers50) / casesCount50F
        allTimes50 = drop fiftyPerCent $ reverse $ List.sort allTimes 
        allAvgOvers50 = drop fiftyPerCent $ reverse $ List.sort allAvgOvers 
        allMaxOvers50 = drop fiftyPerCent $ reverse $ List.sort allMaxOvers
        casesCount50F = fromInteger $ toInteger $ casesCount - fiftyPerCent
        fiftyPerCent = casesCount `div` 2
        
        timeInSeconds45 = (sum allTimes45) / casesCount45F
        avgOverestimation45 = (sum allAvgOvers45) / casesCount45F
        maxOverestimation45 = (sum allMaxOvers45) / casesCount45F
        allTimes45 =  drop fivePerCent $ reverse $ drop fiftyPerCent $ List.sort allTimes 
        allAvgOvers45 = drop fivePerCent $ reverse $ drop fiftyPerCent $ List.sort allAvgOvers 
        allMaxOvers45 = drop fivePerCent $ reverse $ drop fiftyPerCent $ List.sort allMaxOvers
        casesCount45F = fromInteger $ toInteger $ casesCount - fiftyPerCent - fivePerCent
    formatSummaryCase (caseId, (timeInSeconds, (avgOverestimation, maxOverestimation))) =
        "case " ++ caseId ++ ":"
        ++ "\n  approximate time = " ++ show timeInSeconds ++ " seconds"
        ++ "\n  average sampled overestimation = " ++ show avgOverestimation 
        ++ "\n  maximal sampled overestimation = " ++ show maxOverestimation
    parseReport :: String -> IO [(String, (Double, (Double, Double)))]
    parseReport filepath =
        withFile filepath ReadMode readFirstAndOtherLines
        where
        readFirstAndOtherLines h =
            do
            startLine <- hGetLine h
            firstLine <- hGetLine h
            readCases (firstLine, (getTime firstLine) - (getTime startLine)) h
        readCases (currentLine, caseCompTime) h =
            do
            (caseOverestimations, maybeNextLineAndTime) <- readCase [] 0 currentLine
            let caseInfo = (caseId, (caseCompTime, avgAndMax caseOverestimations))
            case maybeNextLineAndTime of
                Nothing -> return [caseInfo]
                Just (nextLine, nextCaseTime) ->
                    do
                    otherCases <- readCases (nextLine, nextCaseTime) h
                    return $ caseInfo : otherCases
            where     
            avgAndMax ns =
                (sum ns / (fromInteger $ toInteger $ length ns), foldl1 max ns)
            caseId = getCaseId currentLine
            readCase overestimationsSoFar currentTimeStep currentLine
                | currentCaseId /= caseId =
                    return (overestimationsSoFar, Just (currentLine, currentTimeStep))
                | otherwise =
                    do
                    finished <- hIsEOF h
                    case finished of
                        True -> return (currentOverestimations, Nothing)
                        False ->
                            do
                            nextLine <- hGetLine h
                            let nextTimeStep = (getTime nextLine) - (getTime currentLine)
                            readCase currentOverestimations nextTimeStep nextLine
                where
                currentCaseId = getCaseId currentLine
                currentOverestimations = 
                    currentOverestimation : overestimationsSoFar
                currentOverestimation = getOverestimation currentLine
        getTime :: String -> Double
        getTime line = 
            case reads line of
                [(time,'s':_)] -> time
        getCaseId :: String -> String
        getCaseId line =
            case matchRegex idRegex line of
                Just [caseId] -> caseId
            where
            idRegex = mkRegex "case=([^;]*);"
        getOverestimation :: String -> Double
        getOverestimation line =
            case matchRegex ovestRegex line of
                Just [ovestS] -> read ovestS
            where
            ovestRegex = mkRegex "ovest=([^;]*);"