我正在尝试解决欧拉计划(http://projecteuler.net/problem=14(的问题14,但我使用Haskell陷入了死胡同。
现在,我知道这些数字可能足够小,我可以做一个蛮力,但这不是我练习的目的。我试图记住 Map Integer (Bool, Integer)
型Map
中的中间结果,其含义为:
- the first Integer (the key) holds the number
- the Tuple (Bool, Interger) holds either (True, Length) or (False, Number)
where Length = length of the chain
Number = the number before him
前任:
for 13: the chain is 13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
My map should contain :
13 - (True, 10)
40 - (False, 13)
20 - (False, 40)
10 - (False, 20)
5 - (False, 10)
16 - (False, 5)
8 - (False, 16)
4 - (False, 8)
2 - (False, 4)
1 - (False, 2)
现在,当我搜索另一个像40
这样的数字时,我知道链有(10 - 1) length
等等。我现在想要,如果我搜索 10,不仅要告诉我 10 的长度是(10 - 3) length
并更新地图,而且我还想更新 20、40,以防它们仍然是(假,_(
我的代码:
import Data.Map as Map
solve :: [Integer] -> Map Integer (Bool, Integer)
solve xs = solve' xs Map.empty
where
solve' :: [Integer] -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
solve' [] table = table
solve' (x:xs) table =
case Map.lookup x table of
Nothing -> countF x 1 (x:xs) table
Just (b, _) ->
case b of
True -> solve' xs table
False -> {-WRONG-} solve' xs table
f :: Integer -> Integer
f x
| x `mod` 2 == 0 = x `quot` 2
| otherwise = 3 * x + 1
countF :: Integer -> Integer -> [Integer] -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
countF n cnt (x:xs) table
| n == 1 = solve' xs (Map.insert x (True, cnt) table)
| otherwise = countF (f n) (cnt + 1) (x:xs) $ checkMap (f n) n table
checkMap :: Integer -> Integer -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
checkMap n rez table =
case Map.lookup n table of
Nothing -> Map.insert n (False, rez) table
Just _ -> table
在 {-WRONG-} 部分,我们应该更新所有值,如以下示例所示:
--We are looking for 10:
10 - (False, 20)
|
V {-finally-} update 10 => (True, 10 - 1 - 1 - 1)
20 - (False, 40) ^
| |
V update 20 => 20 - (True, 10 - 1 - 1)
40 - (False, 13) ^
| |
V update 40 => 40 - (True, 10 - 1)
13 - (True, 10) ^
| |
---------------------------
问题是我不知道是否可以在函数中做 2 件事,例如更新数字并继续递归。在类似C
的语言中,我可能会做类似的事情(伪代码(:
void f(int n, tuple(b,nr), int &length, table)
{
if(b == False) f (nr, (table lookup nr), 0, table);
// the bool is true so we got a length
else
{
length = nr;
return;
}
// Since this is a recurence it would work as a stack, producing the right output
table update(n, --cnt);
}
最后一条指令将起作用,因为我们通过引用发送 cnt。此外,我们始终知道它会在某个时候完成,并且 cnt 不应该<1。
最简单的优化(如您所确定的(是记忆。您尝试自己创建一个记忆系统,但是遇到了有关如何存储记忆值的问题。有一些解决方案可以以可维护的方式执行此操作,例如使用状态 monad 或 STArray。但是,对于您的问题,有一个更简单的解决方案 - 使用Haskell现有的记忆。默认情况下,Haskell会记住常量值,因此如果您创建一个存储collatz值的值,它将自动记忆!
一个简单的例子是以下斐波那契定义:
fib :: Int -> Integer
fib n = fibValues !! n where
fibValues = 1 : 1 : zipWith (+) fibValues (tail fibValues)
fibValues
是一个[Integer]
,因为它只是一个常量值,所以它被记住了。但是,这并不意味着它一次全部记住,因为它是一个无限的列表,这永远不会完成。相反,这些值只在需要时计算,因为 haskell 很懒惰。
因此,如果您对问题做类似的事情,您将无需大量工作即可获得记忆。但是,使用上述列表在您的解决方案中效果不佳。这是因为 collatz 算法使用许多不同的值来获取给定数字的结果,因此使用的容器需要随机访问才能高效。显而易见的选择是数组。
collatzMemoized :: Array Integer Int
接下来,我们需要用正确的值填充数组。我将编写这个函数,假装存在一个计算任何 n 的 collatz 值的 collatz
函数。另外,请注意,数组的大小是固定的,因此需要使用一个值来确定要记住的最大数字。我会使用一百万,但可以使用任何值(这是内存/速度的权衡(。
collatzMemoized = listArray (1, maxNumberToMemoize) $ map collatz [1..maxNumberToMemoize] where
maxNumberToMemroize = 1000000
这非常简单,listArray
被赋予边界,并且给出了该范围内所有 collatz 值的列表。请记住,这不会立即计算所有 collatz 值,因为这些值是惰性的。
现在,可以编写 collatz 函数了。最重要的部分是仅当要检查的数字在其范围内时才检查collatzMemoized
数组:
collatz :: Integer -> Int
collatz 1 = 1
collatz n
| inRange (bounds collatzMemoized) nextValue = 1 + collatzMemoized ! nextValue
| otherwise = 1 + collatz nextValue
where
nextValue = case n of
1 -> 1
n | even n -> n `div` 2
| otherwise -> 3 * n + 1
在ghci中,您现在可以看到记忆的有效性。试试collatz 200000
。大约需要 2 秒才能完成。但是,如果您再次运行它,它将立即完成。
最后,可以找到解决方案:
maxCollatzUpTo :: Integer -> (Integer, Int)
maxCollatzUpTo n = maximumBy (compare `on` snd) $ zip [1..n] (map collatz [1..n]) where
然后打印:
main = print $ maxCollatzUpTo 1000000
如果运行 main,结果将在大约 10 秒内打印出来。
现在,这种方法的一个小问题是它使用了大量的堆栈空间。它将在ghci中正常工作(在堆栈空间方面似乎使用更灵活(。但是,如果您编译它并尝试运行可执行文件,它将崩溃(堆栈空间溢出(。因此,要运行该程序,您必须在编译时指定更多。这可以通过在编译选项中添加-with-rtsopts='K64m'
来完成。这会将堆栈增加到 64mb。
现在可以编译和运行该程序:
> ghc -O3 --make -with-rtsopts='-K6m' problem.hs
运行./problem
将在不到一秒钟的时间内给出结果。
你正在以艰难的方式进行记忆,试图用Haskell编写一个命令式程序。借用David Eisenstat的解决方案,我们将按照j_random_hacker的建议解决它:
collatzLength :: Integer -> Integer
collatzLength n
| n == 1 = 1
| even n = 1 + collatzLength (n `div` 2)
| otherwise = 1 + collatzLength (3*n + 1)
为此,动态编程解决方案是将递归替换为在表中查找内容。让我们创建一个函数来替换递归调用:
collatzLengthDef :: (Integer -> Integer) -> Integer -> Integer
collatzLengthDef r n
| n == 1 = 1
| even n = 1 + r (n `div` 2)
| otherwise = 1 + r (3*n + 1)
现在我们可以将递归算法定义为
collatzLength :: Integer -> Integer
collatzLength = collatzLengthDef collatzLength
现在我们也可以制作一个表格版本(它需要一个数字作为表大小,并返回一个使用该大小的表计算的 collatzLength 函数(:
-- A utility function that makes memoizing things easier
buildTable :: (Ix i) => (i, i) -> (i -> e) -> Array i e
buildTable bounds f = array $ map (x -> (x, f x)) $ range bounds
collatzLengthTabled :: Integer -> Integer -> Integer
collatzLengthTabled n = collatzLengthTableLookup
where
bounds = (1, n)
table = buildTable bounds (collatzLengthDef collatzLengthTableLookup)
collatzLengthTableLookup =
x -> Case inRange bounds x of
True -> table ! x
_ -> (collatzLengthDef collatzLengthTableLookup) x
这是通过将 collatzLength 定义为表查找来工作的,表中是函数的定义,但递归调用被表查找替换。表查找函数检查函数的参数是否在表的范围内,并回退到函数的定义。我们甚至可以使它用于列出任何像这样的函数:
tableRange :: (Ix a) => (a, a) -> ((a -> b) -> a -> b) -> a -> b
tableRange bounds definition = tableLookup
where
table = buildTable bounds (definition tableLookup)
tableLookup =
x -> Case inRange bounds x of
True -> table ! x
_ -> (definition tableLookup) x
collatzLengthTabled n = tableRange (1, n) collatzLengthDef
你只需要确保你
let memoized = collatzLengthTabled 10000000
... memoized ...
这样在内存中只构建了一个表。
我记得在 Haskell 中发现对动态编程算法的记忆非常违反直觉,我已经有一段时间没有这样做了,但希望以下技巧对您有用。
但首先,我不太了解您当前的 DP 方案,尽管我怀疑它可能效率很低,因为它似乎需要为每个答案更新许多条目。 (a(我不知道如何在Haskell中做到这一点,(b(你不需要这样做来有效地解决问题;-(
我建议采用以下方法:首先构建一个普通的递归函数,用于计算输入数字的正确答案。 (提示:它将有一个类似于collatzLength :: Int -> Int
的签名。 当你让这个函数工作时,只需将其定义替换为数组的定义,该数组的元素是使用关联列表的 array
函数懒惰定义的,并将对该函数的所有递归调用替换为数组查找(例如 collatzLength 42
会变得collatzLength ! 42
(。 这将按必要的顺序自动填充数组! 因此,您的"顶级"collatzLength
对象现在实际上将是一个数组,而不是一个函数。
正如我上面建议的,我会使用数组而不是映射数据类型来保存 DP 表,因为您需要存储从 1 到 1,000,000 的所有整数索引的值。
我手边没有Haskell编译器,所以我为任何损坏的代码道歉。
没有记忆,就有一个功能
collatzLength :: Integer -> Integer
collatzLength n
| n == 1 = 1
| even n = 1 + collatzLength (n `div` 2)
| otherwise = 1 + collatzLength (3*n + 1)
使用记忆,类型签名是
memoCL :: Map Integer Integer -> Integer -> (Map Integer Integer, Integer)
因为memoCL
接收一个表作为输入,并将更新后的表作为输出。memoCL
需要做的是用let
形式拦截递归调用的返回并插入新结果。
-- table must have an initial entry for 1
memoCL table n = case Map.lookup n table of
Just m -> (table, m)
Nothing -> let (table', m) = memoCL table (collatzStep n) in (Map.insert n (1 + m) table', 1 + m)
collatzStep :: Integer -> Integer
collatzStep n = if even n then n `div` 2 else 3*n + 1
在某些时候,你会厌倦上面的成语。然后是单子的时候了。
我最终修改了 {-WRONG-} 部分以通过调用 mark x (b, n) [] xs table
mark :: Integer -> (Bool, Integer) -> [Integer] -> [Integer] -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
mark crtElem (b, n) list xs table
| b == False = mark n (findElem n table) (crtElem:list) xs table
| otherwise = continueWith n list xs table
continueWith :: Integer -> [Integer] -> [Integer] -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
continueWith _ [] xs table = solve' xs table
continueWith cnt (y:ys) xs table = continueWith (cnt - 1) ys xs (Map.insert y (True, cnt - 1) table)
findElem :: Integer -> Map Integer (Bool, Integer) -> (Bool, Integer)
findElem n table =
case Map.lookup n table of
Nothing -> (False, 0)
Just (b, nr) -> (b, nr)
但有比这更好(而且不那么冗长(的答案 1
也许你可能会发现我如何解决问题很有趣。它非常实用,尽管它可能不是地球上最有效的东西:)
您可以在此处找到代码:https://github.com/fmancinelli/project-euler/blob/master/haskell/project-euler/Problem014.hs
PS:免责声明:我正在做欧拉计划练习,以便学习哈斯克尔,所以解决方案的质量可能值得商榷。
由于我们正在研究递归方案,因此这里有一个适合您的方案。
让我们考虑函子 N(A,B,X(=A+B*X,它是一个 B 流,最后一个元素是 A。
{-# LANGUAGE DeriveFunctor
, TypeFamilies
, TupleSections #-}
import Data.Functor.Foldable
import qualified Data.Map as M
import Data.List
import Data.Function
import Data.Int
data N a b x = Z a | S b x deriving (Functor)
此流对于多种迭代都很方便。首先,我们可以用它来表示 Collatz 序列中的 Int 链:
type instance Base Int64 = N Int Int64
instance Foldable Int64 where
project 1 = Z 1
project x | odd x = S x $ 3*x+1
project x = S x $ x `div` 2
这只是一个代数,而不是初始代数,因为变换不是同构(相同的 Ints 链是 2*x 和 (x-1(/3 链的一部分(,但这足以表示定点 Base Int64 Int64
。有了这个定义,cata 将把链馈送到给定它的代数中,你可以用它来构造一个整数到链长度的备忘录映射。最后,变形可以使用它来生成不同大小问题的解决方案流:
problems = ana (uncurry $ cata . phi) (M.empty, 1) where
phi :: M.Map Int64 Int ->
Base Int64 (Prim [(Int64, Int)] (M.Map Int64 Int, Int64)) ->
Prim [(Int64, Int)] (M.Map Int64 Int, Int64)
phi m (Z v) = found m 1 v
phi m (S x ~(Cons (_, v') (m', _))) = maybe (notFound m' x v') (found m x) $
M.lookup x m
前面的 ~ (缺点...( 表示惰性模式匹配。在需要值之前,我们不会触及模式。如果不是因为懒惰的模式匹配,它总是会构建整个链,使用映射将是无用的。使用惰性模式匹配,我们仅在 x 的链长度不在映射中时才构造值 v' 和 m'。
帮助程序函数构造(整数,链长(对的流:
found m x v = Cons (x, v) (m, x+1)
notFound m x v = Cons (x, 1+v) (M.insert x (1+v) m, x+1)
现在只需选取前999999个问题,并找出链最长的问题:
main = print $ maximumBy (compare `on` snd) $ take 999999 problems
这比基于数组的解决方案工作得慢,因为地图查找是地图大小的对数,但此解决方案不是固定大小。尽管如此,它还是会在大约 5 秒内完成。