これらの関数の多くはおそらく標準ライブラリにあります
それはそう。の場合import Data.List、それはsort利用可能にmaximumなり、minimumから利用可能になりますPrelude。sortfromは、特にここData.Listのリストにソートされたチャンクがたくさんあるため、準クイックソートよりも全体的に効率的です。
descending :: (Ord a) => [a] -> Bool
descending [] = True
descending (h:[]) = True
descending (h:t)
| h > (max_list t) = descending t
| otherwise = False
非効率的です---O(n²)各ステップで左テール全体をトラバースするため、リストが降順の場合は、テールの最大値がそのヘッドである必要があります。 しかし、それはここで素晴らしい結果をもたらします。succ_list3番目の方程式の最初のガードがリストを完全に評価するように強制するため、サンクの蓄積を防ぎます。ただし、リストを1回明示的に強制することで、より効率的に実行できます。
descending (h:t@(ht:_)) = h > ht && descending t
それを線形にします。それか
プログラムの実行に時間がかかることに気付いた後、比較のために同等のCプログラムを作成しました。
それは珍しいでしょう。これまでのところ、Cでリンクリストを使用することはほとんどなく、その上に遅延評価を実装することはかなりの作業になります。
Cで同等のプログラムを作成することは、非常に単調です。Cでは、アルゴリズムを実装する自然な方法は、配列とインプレースミューテーションを使用します。これは、ここでは自動的にはるかに効率的です。
私の推測では、Haskellの遅延評価により、apply_times関数は、実際に結果の評価を開始する前に、メモリ内に巨大なリストを作成します。
完全ではありませんが、それが構築するのは巨大なサンクです、
apply_times 999999 succ_list [0,1,2,3,4,5,6,7,8,9]
~> apply_times 999998 succ_list (succ_list [0 .. 9])
~> apply_times 999997 succ_list (succ_list (succ_list [0 .. 9]))
~> apply_times 999996 succ_list (succ_list (succ_list (succ_list [0 .. 9])))
...
succ_list (succ_list (succ_list ... (succ_list [0 .. 9])...))
そして、そのサンクが構築された後、それを評価する必要があります。最も外側の呼び出しを評価するには、最も外側の呼び出しでどのパターンが一致するかを見つけるために、次の呼び出しを十分に評価する必要があります。したがって、最も外側の呼び出しがスタックにプッシュされ、次の呼び出しの評価が開始されます。そのためには、どのパターンが一致するかを判断する必要があるため、3回目の呼び出しの結果の一部が必要になります。したがって、2番目の呼び出しはスタックにプッシュされます...。最後に、スタックに999998の呼び出しがあり、最も内側の呼び出しの評価を開始します。次に、各呼び出しと次の外部呼び出しの間に少しピンポンを再生し（少なくとも、依存関係が少し広がる可能性があります）、スタックから呼び出しをバブリングしてポップします。
メモリ消費を最小限に抑えるために使用できる優れたトリックはありますか
はい、中間リストがの引数になる前に、それらが評価されるように強制しますapply_times。ここで完全な評価が必要なので、バニラseqは十分ではありません
import Control.DeepSeq
apply_times' :: (NFData a, Integral n) => n -> (a -> a) -> a -> a
apply_times' 0 _ x = x
apply_times' k f x = apply_times' (k-1) f $!! f x
これにより、サンクの蓄積が防止されるため、で作成されたいくつかの短いリストsucc_listとカウンターよりも多くのメモリは必要ありません。
C実装がすべてを適切に実行している間、リストは何度も作成され続けるため、コピーとガベージコレクションを最小限に抑える方法についてはどうでしょうか。
そうです、それでも多くの割り当て（およびガベージコレクション）が行われます。現在、GHCは短命のデータの割り当てとガベージコレクションに非常に優れています（私のボックスでは、MUT秒あたり2GBの速度で、遅くなることなく簡単に割り当てることができます）が、それでも、これらすべてのリストを割り当てない方が高速です。
したがって、プッシュする場合は、インプレースミューテーションを使用します。に取り組む
STUArray s Int Int
またはボックス化されていない可変ベクトル（私はarrayパッケージによって提供されるインターフェイスを好みますが、ほとんどの場合vectorインターフェイスを好みます。パフォーマンスの観点から、vectorパッケージには多くの最適化が組み込まれています。arrayパッケージを使用する場合は、次のように記述する必要があります。自分でコードを高速化しますが、適切に記述されたコードは、すべての実用的な目的で同等に機能します）。
私は今少しテストをしました。私は元の怠惰なものをテストしておらず、の各アプリケーションをapply_times1つだけテストし、関連するすべてのエンティティのタイプをとして修正しました。deepseqfInt
この設定により、に置き換えるsort_listとData:list.sort、実行時間が1.82秒から1.65秒に短縮されました（ただし、割り当てられるバイト数は増加しました）。それほど大きな違いはありませんが、リストは準クイックソートの悪いケースを実際に噛み砕くのに十分な長さではありません。
大きな違いはdescending、提案どおりに変更することで発生します。これにより、時間が0.48秒に短縮され、割り当てレートはMUT秒あたり2,170,566,037バイト、GC時間は0.01秒になります（sort_list代わりにを使用するとsort、時間が最大0.58秒になります）。
リストの終了セグメントの並べ替えをより単純なものに置き換えるとreverse（アルゴリズムにより、並べ替え時に降順で並べ替えられることが保証されます）、時間が0.43秒に短縮されます。
ボックス化されていない可変配列を使用するためのアルゴリズムのかなり直接的な変換、
{-# LANGUAGE BangPatterns #-}
module Main (main) where
import Data.Array.ST
import Data.Array.Base
import Control.Monad.ST
import Control.Monad (when, replicateM_)
sortPart :: STUArray s Int Int -> Int -> Int -> ST s ()
sortPart a lo hi
| lo < hi = do
let lscan !p h i
| i < h = do
v <- unsafeRead a i
if p < v then return i else lscan p h (i+1)
| otherwise = return i
rscan !p l i
| l < i = do
v <- unsafeRead a i
if v < p then return i else rscan p l (i-1)
| otherwise = return i
swap i j = do
v <- unsafeRead a i
unsafeRead a j >>= unsafeWrite a i
unsafeWrite a j v
sloop !p l h
| l < h = do
l1 <- lscan p h l
h1 <- rscan p l1 h
if (l1 < h1) then (swap l1 h1 >> sloop p l1 h1) else return l1
| otherwise = return l
piv <- unsafeRead a hi
i <- sloop piv lo hi
swap i hi
sortPart a lo (i-1)
sortPart a (i+1) hi
| otherwise = return ()
descending :: STUArray s Int Int -> Int -> Int -> ST s Bool
descending arr lo hi
| lo < hi = do
let check i !v
| hi < i = return True
| otherwise = do
w <- unsafeRead arr i
if w < v
then check (i+1) w
else return False
x <- unsafeRead arr lo
check (lo+1) x
| otherwise = return True
findAndReplace :: STUArray s Int Int -> Int -> Int -> ST s ()
findAndReplace arr lo hi
| lo < hi = do
x <- unsafeRead arr lo
let go !mi !mv i
| hi < i = when (lo < mi) $ unsafeWrite arr mi x >> unsafeWrite arr lo mv
| otherwise = do
w <- unsafeRead arr i
if x < w && w < mv
then go i w (i+1)
else go mi mv (i+1)
look i
| hi < i = return ()
| otherwise = do
w <- unsafeRead arr i
if x < w
then go i w (i+1)
else look (i+1)
look (lo+1)
| otherwise = return ()
succArr :: STUArray s Int Int -> Int -> Int -> ST s ()
succArr arr lo hi
| lo < hi = do
end <- descending arr lo hi
if end
then return ()
else do
needSwap <- descending arr (lo+1) hi
if needSwap
then do
findAndReplace arr lo hi
sortPart arr (lo+1) hi
else succArr arr (lo+1) hi
| otherwise = return ()
solution :: [Int]
solution = runST $ do
arr <- newListArray (0,9) [0 .. 9]
replicateM_ 999999 $ succArr arr 0 9
getElems arr
main :: IO ()
main = print solution
0.15秒で完了します。並べ替えをパーツの単純な反転に置き換えると、0.11になります。
アルゴリズムを小さなトップレベルの関数に分割すると、それぞれが1つのタスクを実行するため、読みやすくなりますが、コストがかかります。関数間でより多くのパラメーターを渡す必要があります。その結果、すべてをレジスターで渡すことができるわけではなく、渡されたパラメーターの一部（配列の境界と要素数）がまったく使用されないため、自重が渡されます。他のすべての関数をローカル関数にsolutionすると、必要なパラメーターのみを渡す必要があるため、全体的な割り当てと実行時間がいくらか短縮されます（ソートで0.13秒、リバースで0.09秒）。
与えられたアルゴリズムからさらに逸脱し、それを後ろから前に機能させる、
module Main (main) where
import Data.Array.ST
import Data.Array.Base
import Data.Array.Unboxed
import Control.Monad.ST
import Control.Monad (when)
import Data.Bits
lexPerm :: Int -> Int -> [Int]
lexPerm idx num = elems (runSTUArray $ do
arr <- unsafeNewArray_ (0,num)
let fill i
| num < i = return ()
| otherwise = unsafeWrite arr i i >> fill (i+1)
swap i j = do
x <- unsafeRead arr i
y <- unsafeRead arr j
unsafeWrite arr j x
unsafeWrite arr i y
flop i j
| i < j = do
swap i j
flop (i+1) (j-1)
| otherwise = return ()
binsearch v a b = go a b
where
go i j
| i < j = do
let m = (i+j+1) `unsafeShiftR` 1
w <- unsafeRead arr m
if w < v
then go i (m-1)
else go m j
| otherwise = swap a i
upstep k j
| k < 1 = return ()
| j == num-1 = unsafeRead arr num >>= flip (back k) (num-1)
| otherwise = nextP k (num-1)
back k v i
| i < 0 = return ()
| otherwise = do
w <- unsafeRead arr i
if w < v
then nextP k i
else back k w (i-1)
nextP k up
| k < 1 || up < 0 = return ()
| otherwise = do
v <- unsafeRead arr up
binsearch v up num
flop (up+1) num
upstep (k-1) up
fill 0
nextP (idx-1) (num-1)
return arr)
main :: IO ()
main = print $ lexPerm 1000000 9
0.02秒でタスクを完了できます。
しかし、質問でほのめかされた巧妙なアルゴリズムは、はるかに少ない時間ではるかに少ないコードでタスクを解決します。