Skip to content

Instantly share code, notes, and snippets.

@takaki
Created Oct 17, 2012
Embed
What would you like to do?
world Cup 2014 Asian Qualifiers Group B
import Control.Monad
import Data.List
import Data.Maybe
data Country = Japan | Jordan | Australia | Oman | Iraq deriving (Eq,Show)
countries = [Japan, Jordan , Australia, Oman, Iraq]
countryPriority :: Country -> Int
countryPriority x
| x == Japan = 0
| otherwise = 5
matchDone = concat
[ [(Japan,3),(Oman,0)]
, [(Jordan,1),(Iraq,1)]
, [(Japan,3),(Jordan,0)]
, [(Oman,1),(Australia,1)]
, [(Australia,1),(Japan,1)]
, [(Iraq,1),(Oman,1)]
, [(Japan,3),(Iraq,0)]
, [(Jordan,3),(Australia,0)]
, [(Oman, 3), (Jordan, 0)]
, [(Iraq, 0), (Australia, 3)]
]
matchLeft =
[
[Iraq, Jordan]
, [Oman, Japan]
, [Australia, Oman]
, [Jordan, Japan]
, [Japan, Australia]
, [Oman, Iraq]
, [Iraq, Japan]
, [Australia, Jordan]
, [Jordan, Oman]
, [Australia, Iraq] ]
leftResultPattern :: [[Int]]
leftResultPattern = map concat $ replicateM leftMatchNum [[3,0],[1,1],[0,3]]
leftMatchNum = length matchLeft
resultToPointPattern :: [Int] -> [(Country, Int)]
resultToPointPattern res = zip (concat matchLeft) res
calcPoint :: [(Country, Int)] -> Country -> (Country, Int)
calcPoint pp c = (c, sum $ (map snd $ filter (\x@(cn,pt) -> cn == c ) pp))
resultCompare :: (Country, Int) -> (Country, Int) -> Ordering
resultCompare (c1,r1) (c2,r2)
| r1 > r2 = LT
| r1 < r2 = GT
| r1 == r2 = compare (countryPriority c2) (countryPriority c1)
orderByJapan :: [(Country,Int)] -> [(Country,Int)] -> Ordering
orderByJapan x y =
compare
(fmap snd $ find (\a@(c,r) -> c == Japan) x)
(fmap snd $ find (\a@(c,r) -> c == Japan) y)
main = do
let pointPattern =
map (\pt ->
sortBy resultCompare
(map (calcPoint (matchDone ++ (resultToPointPattern pt)))
countries)
) leftResultPattern
let lossPattern = filter (\x -> notElem Japan (map (\y@(c,r)->c)
(take 2 x)))
pointPattern
let lossPoints = sort $ map (\x -> snd $ fromMaybe (Japan, 0) x)
(nub $ map (find (\x@(a,b) -> a == Japan)) lossPattern)
mapM_ print $ sortBy orderByJapan lossPattern
let l = length lossPattern
let t = length pointPattern
print $ (l, t, (fromIntegral l)/(fromIntegral t))
mapM_ print $ map (\p ->
let l = length $ filter (elem (Japan, p)) lossPattern
t = length $ filter (elem (Japan, p)) pointPattern
in
(p, l, t, (fromIntegral (t-l))/(fromIntegral t) * 100)) lossPoints
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment