Submission #3418835


Source Code Expand

-- TDPC C - トーナメント
import Control.Monad
import Data.Maybe
import Debug.Trace
import Data.List
import qualified Data.Map.Strict as Map
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet

main :: IO ()
main = do
  k <- readLn :: IO Int
  rs <- replicateM (2^k) readLn :: IO [Int]
  let rWithId = zip [1..] rs
  let dic = Map.fromListWith (+) . join $ solve k rWithId
  forM_ rWithId (\r -> print $ dic Map.! r)

solve k rs = foldr (.) id (replicate k (aggregate . proceed)) $ initial
  where
    initial = map (:[]) . zip rs $ repeat 1 :: [[Prob]]

type Id = Int
type Rating = Int
type Prob = ((Id, Rating), Double)

prob :: Prob -> Prob -> [Prob]
prob ((i, p), pp) ((j, q), qp)
  = let e = 1 / (1 + 10**(fromIntegral (q - p) / 400))
    in [((i, p), pp * qp * e), ((j, q), pp * qp * (1 - e))]

proceed :: [[Prob]] -> [[Prob]]
proceed [] = []
proceed (ps:qs:probs) = join [prob p q | p <- ps, q <- qs] : proceed probs

aggregate :: [[Prob]] -> [[Prob]]
aggregate = map (Map.toList . Map.fromListWith (+))

Submission Info

Submission Time
Task C - トーナメント
User utopian
Language Haskell (GHC 7.10.3)
Score 4
Code Size 1119 Byte
Status AC
Exec Time 501 ms
Memory 2556 KB

Judge Result

Set Name All
Score / Max Score 4 / 4
Status
AC × 6
Set Name Test Cases
All 00, 01, 02, 03, 90, 91
Case Name Status Exec Time Memory
00 AC 500 ms 2556 KB
01 AC 500 ms 2428 KB
02 AC 460 ms 2428 KB
03 AC 501 ms 2428 KB
90 AC 1 ms 508 KB
91 AC 2 ms 636 KB