module Data.Classify.Rank
( selectBest
, sortByRank
, sortByRank'
) where
import Data.Classify.DataTypes
import Data.List
import Data.Char
import Data.Ord
import qualified Data.Map as Map
import qualified Data.Classify.Parser as P
import Control.Monad
selectBest :: [Element] -> Element
selectBest = last . sortByRank
sortByRank :: [Element] -> [Element]
sortByRank = map fst . sortByRank'
sortByRank' elts
= concatMap (sortBy (comparing (length.name.fst)))
$ groupBy (\a b -> snd a == snd b)
$ sortBy (comparing snd) $ zip elts (map getRank elts)
getRank elt =
sum [ score elt,
cleanExtension ==> 2,
unrealVersion (version elt),
numLength (version elt)
]
where
cleanExtension = all isAlpha (lastname elt)
cleanTitle = all isAlpha (title elt)
unrealVersion (Version season episode) = sum [ episode < 1 ==> negate 1
, episode > 50 ==> negate 2
, episode > 100 ==> negate 5
, season < 1 ==> negate 10
, season > 30 ==> negate 3
]
unrealVersion (DateVersion year month day) = 0
numLength (Version season episode) | season < 1 || episode < 1 = 0
numLength (Version season episode) = sum [ floor $ logBase 10 (fromIntegral season)
, floor $ logBase 10 (fromIntegral episode) ]
numLength _ = 0
infix 2 ==>
True ==> n = n
False ==> _ = 0
testSeries = Map.fromList [ (P.trunc t,t) | (_,t,_) <- testData]
v24 = "24"
simpsons = "The Simpsons"
colbert = "The Colbert Report"
palms = "Hidden Palms"
daily = "The Daily Show"
testData = [ ("24.S06E01.6AM.TO.7AM.PROPER.DVDRip.XviD-MEMETiC.avi", "24", Version 6 1)
, ("The.Simpsons.S18E09.PROPER.PDTV.XviD-2HD.avi", "The Simpsons", Version 18 9)
, ("30.Rock.S01E09.HDTV.XviD-NoTV.avi", "30 Rock", Version 1 9)
, ("Cops.S19E32.HDTV.XviD-2HD.avi", "Cops", Version 19 32)
, ("The.4400.S04E02.DSR.XviD-ORENJi.avi", "The 4400", Version 4 2)
, ("Jay.Leno.2007.06.25.John.Edwards.HDTV.XViD-STFU.avi", "Jay Leno", DateVersion 2007 6 25)
, ("the.daily.show.06.21.07.dsr.xvid-crimson.[VTV].avi", daily, DateVersion 2007 6 21)
, ("the.colbert.report.06.21.07.dsr.xvid-w4f.[VTV].avi", colbert, DateVersion 2007 6 21)
, ("hidden.palms.0107-yestv.[VTV].avi", palms, Version 1 7)
, ("hidden.palms.0108-yestv.[VTV].avi", palms, Version 1 8)
, ("hidden.palms.0109-yestv.[VTV].avi", palms, Version 1 9)
, ("hidden.palms.0110-yestv.[VTV].avi", palms, Version 1 10)
, ("hidden.palms.0111-yestv.[VTV].avi", palms, Version 1 11)
, ("hidden.palms.0112-yestv.[VTV].mkv", palms, Version 1 12)
, ("the.colbert.report.06.28.01.dsr.xvid-sys.[VTV].avi", colbert, DateVersion 2001 6 28)
, ("the.colbert.report.06.28.15.dsr.xvid-sys.[VTV].avi", colbert, DateVersion 2015 6 28)
, ("the.colbert.report.06.28.07.dsr.xvid-sys.[VTV].avi", colbert, DateVersion 2007 6 28)
, ("the.colbert.report.07.26.07.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2007 7 26)
, ("the.colbert.report.07.25.07.dsr.xvid-stfu.[VTV].avi", colbert, DateVersion 2007 7 25)
, ("the.colbert.report.09.12.07.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2007 9 12)
, ("the.colbert.report.09.13.07.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2007 9 13)
, ("the.colbert.report.09.13.08.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2008 9 13)
, ("the.colbert.report.09.13.09.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2009 9 13)
, ("the.colbert.report.9.19.07.dsr.xvid.iht.[VTV].avi", colbert, DateVersion 2007 9 19)
, ("the.daily.show.9.19.07.dsr.xvid.iht.[VTV].avi", daily, DateVersion 2007 9 19)
, ("Time.Warp.S01E02.HDTV.XviD-GNARLY.avi", "Time Warp", Version 1 2)
, ("True.Blood.S01E07.720p.HDTV.x264-2HD.mkv", "True Blood", Version 1 7)
, ("Family.Guy.S07E03.PDTV.XviD-LOL.avi", "Family Guy", Version 7 3)
, ("Dexter.S03E02.720p.HDTV.x264-SYS.mkv", "Dexter", Version 3 2)
, ("Greys.Anatomy.S05E04.720p.HDTV.X264-DIMENSION.mkv", "Greys Anatomy", Version 5 4)
, ("Life.S02E05.HDTV.XviD-LOL.[VTV].avi", "Life", Version 2 5)
, ("Merlin.2008.S01E05.WS.PDTV.XviD-BiA.avi", "Merlin", Version 1 5)
, ("South.Park.S12E09.DSR.XviD-0TV.avi", "South Park", Version 12 9)
, ("Stargate.Atlantis.S05E12.720p.HDTV.x264-CTU.mkv", "Stargate Atlantis", Version 5 12)
, ("Heroes.S03E05.HDTV.XviD-LOL.avi", "Heroes", Version 3 5)
, ("Californication.S02E04.720p.HDTV.X264-DIMENSION.mkv", "Californication", Version 2 4)
, ("Psych - 1x09 - Forget Me Not.avi", "Psych", Version 1 9)
, ("south.park.1109.dsr.xvid-sys.[VTV].avi", "South Park", Version 11 9)
, ("South Park - 12x09 - Breast Cancer Show Ever.avi", "South Park", Version 12 9)
, ("Merlin 2008 5x03 The Death Song Of Uther Pendragon REPACK HDTV x264-FoV", "Merlin", Version 5 3)
]
runTests = flip mapM_ testData $ \(str, series, expectedVersion) ->
let elts = P.run (P.parseElement testSeries) str
in if null elts
then do putStrLn $ "Failed to parse: " ++ str
putStrLn $ "Expected: " ++ show (series, expectedVersion)
else let best = selectBest elts
v = version best
in when (version best /= expectedVersion) $
do forM (sortByRank' elts) $ \(elt,rank) ->
putStrLn $ "Erroneous parse: " ++ show (rank, score elt,str, title elt, version elt)
putStrLn $ "Expected: " ++ show (series, expectedVersion)