world Cup 2014 Asian Qualifiers Group B

gistfile1.hs

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