結果

問題 No.210 探し物はどこですか？
ユーザー autotaker1984autotaker1984
提出日時 2015-04-08 12:47:56
言語 Haskell
(9.8.2)
結果
CE  
(最新)
AC  
(最初)
実行時間 -
コード長 2,911 bytes
コンパイル時間 952 ms
コンパイル使用メモリ 152,192 KB
最終ジャッジ日時 2024-07-04 11:04:57
合計ジャッジ時間 1,321 ms
ジャッジサーバーID
（参考情報） 		judge5 / judge1
このコードへのチャレンジ
（要ログイン）
コンパイルエラー時のメッセージ・ソースコードは、提出者また管理者しか表示できないようにしております。（リジャッジ後のコンパイルエラーは公開されます）
ただし、clay言語の場合は開発者のデバッグのため、公開されます。

コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )

Main.hs:16:1: error: [GHC-87110]
    Could not load module ‘Data.Map’.
    It is a member of the hidden package ‘containers-0.6.8’.
    Use -v to see a list of the files searched for.
   |
16 | import qualified Data.Map as M
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Main.hs:17:1: error: [GHC-87110]
    Could not load module ‘Data.Set’.
    It is a member of the hidden package ‘containers-0.6.8’.
    Use -v to see a list of the files searched for.
   |
17 | import qualified Data.Set as S
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

ソースコード

diff # 

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List hiding(insert)
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where 
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    n <- readLn :: IO Int
    ps <- map ((/1000).itof)<$> readInts
    qs <- map ((/100).itof) <$> readInts
    let go !e c queue 
            | c > 3000 * n = e
            | otherwise = 
                let (p,q) = minElem queue in
                let queue' = insert (p * (1 - q)) q $ deleteMin queue in
                go (e - p * itof c) (c+1) queue'
    let p0 = map negate $ zipWith (*) ps qs
    let q0 = foldr (uncurry insert) emptyHP $ zip p0 qs
    printf "%.5f\n" $ go 0 1 q0



data Heap k v = Null | Fork !k !v !(Heap k v) !(Heap k v) 

{-# INLINE emptyHP #-}
emptyHP :: Heap k v
emptyHP = Null

{-# INLINE isEmpty #-}
isEmpty :: Heap k v -> Bool
isEmpty Null = True
isEmpty _ = False

{-# INLINE minElem #-}
minElem :: Heap k v -> (k,v)
minElem (Fork k v _ _) = (k,v)
minElem Null = error "min for empty queue is not supported"

{-# INLINE minKey #-}
minKey :: Heap k v -> k
minKey (Fork k _ _ _) = k
minKey Null = error "min for empty queue is not supported"

{-# INLINE deleteMin #-}
deleteMin :: (Ord k) => Heap k v -> Heap k v
deleteMin (Fork _ _ a b) = merge a b
deleteMin _ = undefined

{-# INLINE merge #-}
insert :: (Ord k) => k -> v -> Heap k v -> Heap k v
insert k v a = merge (Fork k v Null Null) a

merge :: (Ord k) => Heap k v -> Heap k v -> Heap k v
merge a Null = a
merge Null b = b
merge a b 
    | minKey a <= minKey b = jo a b
    | otherwise = jo b a where
        jo (Fork k v _a _b) _c = Fork k v _b (merge _a _c)
        jo _ _ = undefined
0