1

codeingame.com で見つけたトレーニング演習を解こうとしています。

質問は次のとおりです。数値のリストがあり、とがリストのにあるv_small - v_bigという条件で、の差の最小値を見つけたいとします。さらに、この質問の最大時間は 1 秒で、最大メモリ使用量は 512MB です。v_big > v_smallv_big v_small

小さなリストの場合、単純なアルゴリズムで十分です。

---------------------------------- try1.hs -------------------------------------
import Control.Applicative ((<$>))

main :: IO ()
main = do _ <- getLine
          v <- g . f . map read . take 1000 . words <$> getLine --or equivalently
--        v <- g . h . map read . take 1000 . words <$> getLine 
          print v

f :: [Int] -> [Int]
f [] =   []
f xx@(x:xs) = (minimum $ map (\y -> y-x) xx) : (f xs)

g :: [Int] -> Int
g [] = 0
g xs = minimum xs

h :: [Int] -> [Int]
h [] = []
h (x:xs) = (foldr (\y' y -> min (y'-x) y) 0 xs): (h xs)

しかし、リストの長さはどこで機能し、多くの要素fh生成すると思います。最後のリストには 99999 個の要素があり、時間がかかります。n*(n+1)/2n

次の試行は、局所的な最大値と最小値を見つけて、最大値と最小値のみを比較することでした。これにより、アルゴリズムのコストが #maxima*#minima に削減されます。

---------------------------------- try2.hs -------------------------------------
import Control.Applicative ((<$>))
-- import Control.Arrow ((&&&))

data Extremum = Max Int | Min Int deriving (Show)


main :: IO ()
main = do _ <- getLine
          e <- getExtremes
          print e

getExtremes :: IO Int
getExtremes = minimum . concat . myMap f . headextr .
                                         map read . take 1000 .words <$> getLine

myMap :: (a -> [a] -> [b]) -> [a] -> [[b]]
myMap _ [] = []
myMap g xx@(x:xs) = (g x) xx : myMap g xs

f :: Extremum -> [Extremum] -> [Int]
f (Max y) (Max _:xs) = f (Max y) xs
f (Max y) (Min x:xs) = (min 0 (x-y)): f (Max y) xs
f _ _ = []

headextr :: [Int] -> [Extremum]
headextr xx@(x:y:_) | x > y = Max x : extremes xx
                    | x < y = Min x : extremes xx
headextr xx = extremes xx


extremes :: [Int] -> [Extremum]
extremes [] = []
extremes [x] = [Max x, Min x]
extremes [x,y]      | x > y          =       Min y:[]
                    | otherwise      =       Max y:[]
extremes (x:y:z:xs) | x > y && y < z = Min y:extremes (y:z:xs)
                    | x < y && y > z = Max y:extremes (y:z:xs)
                    | otherwise      =       extremes (y:z:xs)

しかし、それでも希望の 1 秒には達していません。プロファイリングのために入力を減らしましたtake 1000が、私はプロのプログラマーではないので、それを使用することができませんでしたf/h.バージョンfも原因です。

この演習の入力ファイルはhttp://www.codingame.com/ide/fileservlet?id=372552140039にあります- (このリンクが機能しない場合は、www.codingame.com -> training -> にあります)証券取引所の損失 -> Test_5_input.txt/Test_5_output.txt)

では、このアルゴリズムを高速化する方法、またはより高速な別のアルゴリズムはありますか?

4

2 に答える 2

1

Monoidこれは、BiggestDrop数値全体で最大の低下を追跡するを使用したソリューションです。それは、数字の範囲の最小値である 3 番目の情報を記憶します。これにより、データセットを断片に分割し、それらの断片を処理し、断片を組み合わせて答えを得ることができます。以下のコード例では、これを利用していません。をデータセット全体で 1 回折りたたむだけMonoidです。mappend

Monoidより高速な sを記述するためのより良い方法がおそらくあります。

この問題には適切だと思われたので、「パイプ」ライブラリを使用してみましたが、解決策に何も追加されなかったと思います。

{-# LANGUAGE ScopedTypeVariables #-}
module Main (
    main
) where


import System.IO

import Data.Maybe
import Data.Monoid
import Data.Char
import Control.Applicative
import Control.Monad

import Pipes
import qualified Pipes.Prelude as P

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

-- Min monoid
newtype Min a = Min {
    getMin :: Maybe a
} deriving (Show, Eq)

instance (Ord a) => Monoid (Min a) where
    mempty = Min Nothing
    mappend x y = Min $ ((liftM2 min) (getMin x) (getMin y)) <|>  (getMin x) <|> (getMin y)

toMin = Min . Just

-- Max monoid
newtype Max a = Max {
    getMax :: Maybe a
} deriving (Show, Eq)

instance (Ord a) => Monoid (Max a) where
    mempty = Max Nothing
    mappend x y = Max $  ((liftM2 max) (getMax x) (getMax y)) <|>  (getMax x) <|> (getMax y)

toMax = Max . Just       

-- Extrema monoid
type Extrema a = (Min a, Max a)

getMinimum = getMin . fst
getMaximum = getMax . snd

toExtrema x = (toMin x, toMax x)

-- Biggest drop monoid

data BiggestDrop a = BiggestDrop {
    extrema :: Extrema a,
    biggestDrop :: Max a
} deriving Show

instance (Num a, Ord a) => Monoid (BiggestDrop a) where
    mempty = BiggestDrop {
        extrema = mempty,
        biggestDrop = mempty
    }
    mappend before after = BiggestDrop {
        extrema = mappend (extrema before) (extrema after),
        biggestDrop = mconcat [
            biggestDrop before,
            biggestDrop after,
            Max $ (liftM2 (-)) (getMaximum $ extrema before) (getMinimum $ extrema after)
        ]
    }

toBiggestDrop x = BiggestDrop {
        extrema = toExtrema x,
        biggestDrop = mempty
    }

-- Read data from stdin and fold BiggestDrop's mappend across it

main = do
  (answer :: BiggestDrop Int) <- P.fold mappend mempty id (words >-> (P.map (toBiggestDrop . read)))
  print answer
  print . fromJust . getMax $ biggestDrop answer
  where
    words = stdinWords >-> (P.map C.unpack) >-> (P.filter ((/=) []))


-- Produce words from stdin

stdinWords' :: (MonadIO m) => Int -> Producer B.ByteString m ()
stdinWords' chunkSize = goMore B.empty
    where
        goMore remainder = do
            eof <- liftIO isEOF
            case eof of
                True ->
                    unless (B.null remainder) $ yield remainder                    
                _ -> do
                    chunk <- liftIO $ B.hGet stdin chunkSize
                    let (first:others) = C.splitWith isSpace chunk
                    goParts ((B.append remainder first):others)
        goParts parts = do
            case parts of
                [] ->
                    goMore B.empty
                [x] ->
                    goMore x
                (x:xs) -> do
                    unless (B.null x) $ yield x
                    goParts xs

stdinWords = stdinWords' 512 

「pipes-bytestring」について学びたいと思って、「pipes」ライブラリを使用して上記のコードをまとめました。ファイルから単語を読み取るには、あきらめてプロデューサーを作成する必要がありました。ファイルから読み取るチャンクのサイズは単なる推測です。

于 2013-10-05T03:49:41.863 に答える