@hammarは、あまりにも怠惰な問題と、それを解決する方法 (厳密なバージョンの を使用) をすでに指摘しています。maximumfoldl1'foldl1
しかし、コードにはさらに非効率な点があります。
cSeq n = length $ game n
cSeqgame長さを計算するためだけに、リストを作成しましょう。残念ながら、lengthは「良い消費者」ではないため、中間リストの構築は融合されていません。これはかなりの不必要な割り当てであり、時間がかかります。これらのリストを削除する
cSeq n = coll (1 :: Int) n
where
coll acc 1 = acc
coll acc m
| even m = coll (acc + 1) (m `div` 2)
| otherwise = coll (acc + 1) (3*m+1)
割り当てを 65% 削減し、実行時間を約 20% 削減します (それでも遅い)。次のポイントではdiv、通常の除算に加えて符号チェックを実行する を使用しています。関連するすべての数値は正であるため、quot代わりに を使用すると、速度が少し向上します (ここではあまり重要ではありませんが、後で重要になります)。
次の重要なポイントは、型シグネチャを指定していないため、数値のlength型(1 :: Int)がInteger. での操作Integerは、対応する での操作よりもかなり遅いIntため、可能であれば、速度が重要な場合よりもInt(または) を使用する必要があります。これらの計算には64 ビット GHC で十分であり、 を使用すると実行時間が約半分に短縮され、 を使用すると実行時間が約 70%短縮され、ネイティブ コード ジェネレータを使用すると、LLVM バックエンドを使用すると実行時間が短縮されます。使用時は約70%、使用時は約95%軽減されます。WordIntegerIntdivquotdivquot
ネイティブ コード ジェネレーターと LLVM バックエンドの違いは、主にいくつかの基本的な低レベルの最適化によるものです。
evenodd定義されている
even, odd :: (Integral a) => a -> Bool
even n = n `rem` 2 == 0
odd = not . even
でGHC.Real。タイプが の場合Int、LLVM は、モジュラスを決定するために使用される 2 による除算をビットごとの and ( n .&. 1 == 0) に置き換えることを認識しています。ネイティブ コード ジェネレーターは、これらの低レベルの最適化の多くを (まだ) 行っていません。これを手作業で行った場合、NCG と LLVM バックエンドによって生成されたコードはほぼ同じように動作します。
を使用する場合div、NCG と LLVM の両方が、除算を短いシフトと加算のシーケンスに置き換えることができないため、比較的遅い機械除算命令を符号テストで取得します。ではquot、どちらも に対してそれを行うことができるためInt、はるかに高速なコードを取得できます。
発生するすべての数が正であるという知識により、負の引数を修正するコードなしで、2 による除算を単純な右シフトに置き換えることができます。これにより、LLVM バックエンドによって生成されるコードがさらに ~33% 高速化されます。 NCGに違いはありません。
したがって、8 秒プラス/マイナスを少し (NCG では少し少なく、LLVM バックエンドではもう少し) かかったオリジナルから、次のようになりました。
module Main (main)
where
import Data.List
import Data.Bits
main = print (answer (1000000 :: Int))
-- Count the length of the sequences
-- count' creates a tuple with the second value
-- being the starting number of the game
-- and the first value being the total
-- length of the chain
count' n = (cSeq n, n)
cSeq n = go (1 :: Int) n
where
go !acc 1 = acc
go acc m
| even' m = go (acc+1) (m `shiftR` 1)
| otherwise = go (acc+1) (3*m+1)
even' :: Int -> Bool
even' m = m .&. 1 == 0
-- Find the maximum chain value of the game
answer n = foldl1' max $ map count' [1..n]
私のセットアップでは、NCG で 0.37 秒、LLVM バックエンドで 0.27 秒かかります。
foldl1' max実行時間はわずかに改善されますが、 を手動再帰に置き換えることで、割り当てを大幅に削減できます。
answer n = go 1 1 2
where
go ml mi i
| n < i = (ml,mi)
| l > ml = go l i (i+1)
| otherwise = go ml mi (i+1)
where
l = cSeq i
それは0.35 respになります。0.25 秒 (小さな が生成されます52,936 bytes allocated in the heap)。
それでも遅すぎる場合は、適切なメモ化戦略について心配することができます。私が知っている最善の方法(1)は、ボックス化されていない配列を使用して、制限を超えない数のチェーンの長さを格納することです。
{-# LANGUAGE BangPatterns #-}
module Main (main) where
import System.Environment (getArgs)
import Data.Array.ST
import Data.Array.Base
import Control.Monad.ST
import Data.Bits
main :: IO ()
main = do
args <- getArgs
let bd = case args of
a:_ -> read a
_ -> 100000
print $ mxColl bd
mxColl :: Int -> (Int,Int)
mxColl bd = runST $ do
arr <- newArray (0,bd) 0
unsafeWrite arr 1 1
goColl arr bd 1 1 2
goColl :: STUArray s Int Int -> Int -> Int -> Int -> Int -> ST s (Int,Int)
goColl arr bd ms ml i
| bd < i = return (ms,ml)
| otherwise = do
nln <- collatzLength arr bd i
if ml < nln
then goColl arr bd i nln (i+1)
else goColl arr bd ms ml (i+1)
collatzLength :: STUArray s Int Int -> Int -> Int -> ST s Int
collatzLength arr bd n = go 1 n
where
go !l 1 = return l
go l m
| bd < m = go (l+1) $ case m .&. 1 of
0 -> m `shiftR` 1
_ -> 3*m+1
| otherwise = do
l' <- unsafeRead arr m
case l' of
0 -> do
l'' <- go 1 $ case m .&. 1 of
0 -> m `shiftR` 1
_ -> 3*m+1
unsafeWrite arr m (l''+1)
return (l + l'')
_ -> return (l+l'-1)
NCG でコンパイルすると 0.04 秒、LLVM バックエンドで 0.05 秒で 1000000 の制限のジョブを実行します (明らかに、STUArrayNCG ほどコードの最適化には適していません)。
64 ビット GHC を持っていない場合、単純に を使用することはできませんInt。これは、一部の入力でオーバーフローするためです。ただし、計算の圧倒的な部分は依然としてInt範囲内で実行されるため、可能な場合はそれを使用し、必要な場所にのみ移動するInteger必要があります。
switch :: Int
switch = (maxBound - 1) `quot` 3
back :: Integer
back = 2 * fromIntegral (maxBound :: Int)
cSeq :: Int -> Int
cSeq n = goInt 1 n
where
goInt acc 1 = acc
goInt acc m
| m .&. 1 == 0 = goInt (acc+1) (m `shiftR` 1)
| m > switch = goInteger (acc+1) (3*toInteger m + 1)
| otherwise = goInt (acc+1) (3*m+1)
goInteger acc m
| fromInteger m .&. (1 :: Int) == 1 = goInteger (acc+1) (3*m+1)
| m > back = goInteger (acc+1) (m `quot` 2) -- yup, quot is faster than shift for Integer here
| otherwise = goInt (acc + 1) (fromInteger $ m `quot` 2)
ループの最適化が難しくなるため、 を使用した単一のループよりも遅くなりますIntが、それでもまともです。ここ (ループが実行されない場合) では、NCG で 0.42 秒、LLVM バックエンドで 0.37 秒かかります (純粋なバージョンでInteger使用する場合とほとんど同じです)。quotInt
メモ化されたバージョンに同様のトリックを使用すると、同様の結果が得られます。純粋なIntバージョンよりもかなり遅くなりますが、メモ化されていないバージョンに比べて非常に高速です。
(1)この特別な (タイプの) 問題では、連続した範囲の引数の結果をメモする必要があります。他の問題については、Mapまたは他のデータ構造がより適切な選択になります。