diff
This commit is contained in:
parent
88f69156e7
commit
9d4aab5f2c
@ -33,7 +33,8 @@ module GEval.Core
|
|||||||
EvaluationContext(..),
|
EvaluationContext(..),
|
||||||
ParserSpec(..),
|
ParserSpec(..),
|
||||||
fileAsLineSource,
|
fileAsLineSource,
|
||||||
checkAndGetFiles
|
checkAndGetFiles,
|
||||||
|
getOutFile
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Conduit
|
import Data.Conduit
|
||||||
@ -154,7 +155,7 @@ getExpectedDirectory :: GEvalSpecification -> FilePath
|
|||||||
getExpectedDirectory spec = fromMaybe outDirectory $ gesExpectedDirectory spec
|
getExpectedDirectory spec = fromMaybe outDirectory $ gesExpectedDirectory spec
|
||||||
where outDirectory = gesOutDirectory spec
|
where outDirectory = gesOutDirectory spec
|
||||||
|
|
||||||
data GEvalSpecialCommand = Init | LineByLine
|
data GEvalSpecialCommand = Init | LineByLine | Diff FilePath
|
||||||
|
|
||||||
data GEvalOptions = GEvalOptions
|
data GEvalOptions = GEvalOptions
|
||||||
{ geoSpecialCommand :: Maybe GEvalSpecialCommand,
|
{ geoSpecialCommand :: Maybe GEvalSpecialCommand,
|
||||||
@ -232,7 +233,7 @@ checkAndGetFiles gevalSpec = do
|
|||||||
checkInputFileIfNeeded metric inputFilePath
|
checkInputFileIfNeeded metric inputFilePath
|
||||||
return (inputFilePath, expectedFilePath, outFilePath)
|
return (inputFilePath, expectedFilePath, outFilePath)
|
||||||
where expectedFilePath = expectedTestDirectory </> (gesExpectedFile gevalSpec)
|
where expectedFilePath = expectedTestDirectory </> (gesExpectedFile gevalSpec)
|
||||||
outFilePath = outTestDirectory </> (gesOutFile gevalSpec)
|
outFilePath = getOutFile gevalSpec (gesOutFile gevalSpec)
|
||||||
inputFilePath = expectedTestDirectory </> (gesInputFile gevalSpec)
|
inputFilePath = expectedTestDirectory </> (gesInputFile gevalSpec)
|
||||||
expectedTestDirectory = expectedDirectory </> testName
|
expectedTestDirectory = expectedDirectory </> testName
|
||||||
outTestDirectory = outDirectory </> testName
|
outTestDirectory = outDirectory </> testName
|
||||||
@ -241,6 +242,11 @@ checkAndGetFiles gevalSpec = do
|
|||||||
testName = gesTestName gevalSpec
|
testName = gesTestName gevalSpec
|
||||||
metric = gesMetric gevalSpec
|
metric = gesMetric gevalSpec
|
||||||
|
|
||||||
|
getOutFile :: GEvalSpecification -> FilePath -> FilePath
|
||||||
|
getOutFile gevalSpec out = outDirectory </> testName </> out
|
||||||
|
where outDirectory = gesOutDirectory gevalSpec
|
||||||
|
testName = gesTestName gevalSpec
|
||||||
|
|
||||||
checkInputFileIfNeeded :: Metric -> FilePath -> IO ()
|
checkInputFileIfNeeded :: Metric -> FilePath -> IO ()
|
||||||
checkInputFileIfNeeded CharMatch inputFilePath = do
|
checkInputFileIfNeeded CharMatch inputFilePath = do
|
||||||
unlessM (D.doesFileExist inputFilePath) $ throwM $ NoInputFile inputFilePath
|
unlessM (D.doesFileExist inputFilePath) $ throwM $ NoInputFile inputFilePath
|
||||||
|
@ -8,7 +8,8 @@
|
|||||||
|
|
||||||
|
|
||||||
module GEval.LineByLine
|
module GEval.LineByLine
|
||||||
(runLineByLine
|
(runLineByLine,
|
||||||
|
runDiff
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import GEval.Core
|
import GEval.Core
|
||||||
@ -34,7 +35,6 @@ runLineByLine spec = do
|
|||||||
(inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec
|
(inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec
|
||||||
gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum
|
gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum
|
||||||
where metric = gesMetric spec
|
where metric = gesMetric spec
|
||||||
justScore (LineRecord _ _ _ _ score) = score
|
|
||||||
consum :: Consumer LineRecord (ResourceT IO) ()
|
consum :: Consumer LineRecord (ResourceT IO) ()
|
||||||
consum = (CL.map (encodeUtf8 . formatOutput) =$= CC.unlinesAscii =$= CC.stdout)
|
consum = (CL.map (encodeUtf8 . formatOutput) =$= CC.unlinesAscii =$= CC.stdout)
|
||||||
formatOutput (LineRecord inp exp out _ score) = Data.Text.intercalate "\t" [
|
formatOutput (LineRecord inp exp out _ score) = Data.Text.intercalate "\t" [
|
||||||
@ -44,7 +44,33 @@ runLineByLine spec = do
|
|||||||
escapeTabs out]
|
escapeTabs out]
|
||||||
formatScore :: MetricValue -> Text
|
formatScore :: MetricValue -> Text
|
||||||
formatScore = Data.Text.pack . printf "%f"
|
formatScore = Data.Text.pack . printf "%f"
|
||||||
escapeTabs = Data.Text.replace "\t" "<tab>"
|
|
||||||
|
runDiff :: FilePath -> GEvalSpecification -> IO ()
|
||||||
|
runDiff otherOut spec = do
|
||||||
|
let otherOutFilePath = getOutFile spec otherOut
|
||||||
|
(inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec
|
||||||
|
let sourceA = gevalLineByLineSource metric inputFilePath expectedFilePath outFilePath
|
||||||
|
let sourceB = gevalLineByLineSource metric inputFilePath expectedFilePath otherOutFilePath
|
||||||
|
runResourceT $
|
||||||
|
((getZipSource $ (,)
|
||||||
|
<$> ZipSource sourceA
|
||||||
|
<*> ZipSource sourceB) $$ consum)
|
||||||
|
where metric = gesMetric spec
|
||||||
|
consum :: Consumer (LineRecord, LineRecord) (ResourceT IO) ()
|
||||||
|
consum = (CL.filter shouldBeShown =$= CL.map (encodeUtf8 . formatOutput) =$= CC.unlinesAscii =$= CC.stdout)
|
||||||
|
shouldBeShown (LineRecord _ _ outA _ scoreA, LineRecord _ _ outB _ scoreB) =
|
||||||
|
outA /= outB && scoreA /= scoreB
|
||||||
|
formatOutput (LineRecord inp exp outA _ scoreA, LineRecord _ _ outB _ scoreB) = Data.Text.intercalate "\t" [
|
||||||
|
formatScoreDiff (scoreB - scoreA),
|
||||||
|
escapeTabs inp,
|
||||||
|
escapeTabs exp,
|
||||||
|
escapeTabs outA,
|
||||||
|
escapeTabs outB]
|
||||||
|
formatScoreDiff :: Double -> Text
|
||||||
|
formatScoreDiff = Data.Text.pack . printf "%f"
|
||||||
|
|
||||||
|
escapeTabs :: Text -> Text
|
||||||
|
escapeTabs = Data.Text.replace "\t" "<tab>"
|
||||||
|
|
||||||
gevalLineByLineCore :: Metric -> FilePath -> FilePath -> FilePath -> Sink LineRecord (ResourceT IO) () -> IO ()
|
gevalLineByLineCore :: Metric -> FilePath -> FilePath -> FilePath -> Sink LineRecord (ResourceT IO) () -> IO ()
|
||||||
gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum =
|
gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum =
|
||||||
|
@ -34,7 +34,13 @@ optionsParser = GEvalOptions
|
|||||||
(flag' LineByLine
|
(flag' LineByLine
|
||||||
( long "line-by-line"
|
( long "line-by-line"
|
||||||
<> short 'l'
|
<> short 'l'
|
||||||
<> help "Give scores for each line rather than the whole test set" )))
|
<> help "Give scores for each line rather than the whole test set" ))
|
||||||
|
<|>
|
||||||
|
(Diff <$> strOption
|
||||||
|
( long "diff"
|
||||||
|
<> short 'd'
|
||||||
|
<> metavar "OTHER-OUT"
|
||||||
|
<> help "compare results")))
|
||||||
<*> specParser
|
<*> specParser
|
||||||
|
|
||||||
precisionArgParser :: Parser Int
|
precisionArgParser :: Parser Int
|
||||||
@ -151,6 +157,9 @@ runGEval''' (Just Init) spec = do
|
|||||||
runGEval''' (Just LineByLine) spec = do
|
runGEval''' (Just LineByLine) spec = do
|
||||||
runLineByLine spec
|
runLineByLine spec
|
||||||
return Nothing
|
return Nothing
|
||||||
|
runGEval''' (Just (Diff otherOut)) spec = do
|
||||||
|
runDiff otherOut spec
|
||||||
|
return Nothing
|
||||||
|
|
||||||
initChallenge :: GEvalSpecification -> IO ()
|
initChallenge :: GEvalSpecification -> IO ()
|
||||||
initChallenge spec = case gesExpectedDirectory spec of
|
initChallenge spec = case gesExpectedDirectory spec of
|
||||||
|
Loading…
Reference in New Issue
Block a user