许多这些功能可能在标准库中
确实。如果您import Data.List, 则可以sort使用，maximum并且minimum可以从Prelude. sortfromData.List总而言之比准快速排序更有效，特别是因为这里的列表中有很多已排序的块。
descending :: (Ord a) => [a] -> Bool
descending [] = True
descending (h:[]) = True
descending (h:t)
| h > (max_list t) = descending t
| otherwise = False
效率低——O(n²)因为它在每一步都遍历了整个左尾，尽管如果列表是降序的，那么尾的最大值必须是它的头。 但这在这里有一个很好的结果。它防止了 thunk 的积累，因为第三个等式的第一个守卫succ_list强制对列表进行完全评估。但是，通过显式强制列表once可以更有效地完成此操作。
descending (h:t@(ht:_)) = h > ht && descending t
会使它成为线性的。那
在注意到我的程序运行了一段时间后，我编写了一个等效的 C 程序进行比较。
那将是不寻常的。到目前为止，很少有人会在 C 中使用链表，在此之上实现惰性求值将是一项艰巨的任务。
用 C编写一个等价的程序是非常不习惯的。在 C 中，实现算法的自然方法是使用数组和就地突变。这在这里自动效率更高。
我的猜测是 Haskell 的惰性求值会导致 apply_times 函数在实际开始求值之前在内存中构建一个巨大的列表。
不完全是，它构建的是一个巨大的thunk，
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])...))
并且，在构建该 thunk 之后，必须对其进行评估。要评估最外面的调用，必须对下一个调用进行足够远的评估，以找出最外面的调用中匹配的模式。所以最外面的调用被压入堆栈，并开始评估下一个调用。为此，必须确定哪个模式匹配，因此需要第三次调用的部分结果。因此，第二个调用被压入堆栈 ... 。最后，堆栈上有 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
这可以防止 thunk 的积累，因此您不需要比在succ_list和计数器中构建的一些短列表更多的内存。
尽量减少复制和垃圾收集的方法怎么样，因为列表会不断创建，而 C 实现会完成所有工作。
对，这仍然会分配（和垃圾收集）很多。现在，GHC在分配和垃圾收集短期数据方面非常出色（在我的机器上，它可以轻松地以每 MUT 秒 2GB 的速率进行分配而不会很慢），但是，不分配所有这些列表会更快。
因此，如果要推送它，请使用就地突变。工作在一个
STUArray s Int Int
或者一个未装箱的可变向量（我更喜欢array包提供的接口，但最喜欢vector接口；在性能方面，vector包为你内置了很多优化，如果你使用array包，你必须编写自己快速编写代码，但编写良好的代码在所有实际用途中的性能相同）。
我现在做了一些测试。我没有测试过原来的lazy apply_times，只测试了deepseq每个应用程序的一个f，并且已经将所有涉及的实体的类型固定为Int。
通过该设置，替换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。
将算法拆分为小的顶级函数，每个函数执行一项任务，使其更具可读性，但这是有代价的。函数之间需要传递更多参数，因此并非所有参数都可以在寄存器中传递，并且某些传递的参数 - 数组边界和元素计数 - 根本没有使用，所以这是传递的重量。使所有其他函数成为本地函数在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 秒内完成任务。
然而，问题中提到的聪明算法用更少的代码在更短的时间内解决了任务。