caching - Haskell:部分丢弃惰性评估结果

Question

我有一个非常大的决策树。其使用方法如下:

-- once per application start
t :: Tree
t = buildDecisionTree
-- done several times
makeDecision :: Something -> Decision
makeDecision something = search t something

该决策树太大，无法装入内存。但是，由于惰性求值，它仅被部分求值。

问题是，在某些情况下，尝试所有可能的决策会导致整个树被评估。这不会终止，但也不应导致内存溢出。此外，如果该过程被中止，内存使用量不会减少，因为仍然已经评估了一个巨大的子树。

解决方案是每次调用 makeDecision 时重新评估树，但这会失去缓存决策的好处，并显着减慢 makeDecision 的速度。

我想走中间路线。特别是在我的应用程序中，使用树中的公共(public)路径前缀进行连续决策是很常见的。所以我想缓存最后使用的路径，但删除其他路径，导致它们在下次使用时重新评估。我怎样才能在 Haskell 中做到这一点？

Answer 1

在纯 Haskell 中这是不可能的，请参阅问题 Can a thunk be duplicated to improve memory performance? (正如@shang 所指出的)。不过，您可以使用 IO 来完成此操作。

我们从模块头开始，仅列出使该模块(将使用 unsafePerformIO)安全的类型和函数。也可以在没有 unsafePerformIO 的情况下执行此操作，但这意味着用户必须在 IO 中保留更多代码。

{-# LANGUAGE ExistentialQuantification #-}
module ReEval (ReEval, newReEval, readReEval, resetReEval) where

import Data.IORef
import System.IO.Unsafe

我们首先定义一种数据类型，该数据类型以防止所有共享的方式存储值，方法是使函数和参数彼此远离，并且仅在需要该值时才应用该函数。请注意，unsharedValue 返回的值可以共享，但不能与其他调用的返回值共享(假设该函数正在执行一些重要的操作):

data Unshared a = forall b. Unshared (b -> a) b

unsharedValue :: Unshared a -> a
unsharedValue (Unshared f x) = f x

现在我们定义可重置计算的数据类型。我们需要存储计算结果和当前值。后者存储在 IORef 中，因为我们希望能够重置它。

data ReEval a = ReEval {
    calculation :: Unshared a,
    currentValue :: IORef a
    }

要将值包装在 ReEval 框中，我们需要一个函数和一个参数。为什么不直接a -> ReEval a？因为这样就无法阻止参数被共享。

newReEval :: (b -> a) -> b -> ReEval a
newReEval f x = unsafePerformIO $ do
    let c = Unshared f x
    ref <- newIORef (unsharedValue c)
    return $ ReEval c ref

读取很简单:只需从IORef获取值即可。使用 unsafePerformIO 是安全的，因为我们始终会获得 unsharedValue c 的值，尽管它是不同的“副本”。

readReEval :: ReEval a -> a
readReEval r = unsafePerformIO $ readIORef (currentValue r)

最后是重置。我将其留在 IO monad 中，并不是因为它比包装在 unsafePerformIO 中的其他函数安全性更低，而是因为这是让用户控制的最简单方法。 重置确实发生了。您不想冒这样的风险:所有对 resetReEval 的调用都被延迟，直到内存耗尽，甚至因为没有返回值可供使用而被优化掉。

resetReEval :: ReEval a -> IO ()
resetReEval r = writeIORef (currentValue r) (unsharedValue (calculation r))

本模块到此结束。下面是示例代码:

import Debug.Trace
import ReEval
main = do
    let func a = trace ("func " ++ show a) negate a
    let l = [ newReEval func n | n <- [1..5] ]
    print (map readReEval l)
    print (map readReEval l)
    mapM_ resetReEval l
    print (map readReEval l)

在这里您可以看到它达到了预期的效果:

$ runhaskell test.hs 
func 1
func 2
func 3
func 4
func 5
[-1,-2,-3,-4,-5]
[-1,-2,-3,-4,-5]
func 1
func 2
func 3
func 4
func 5
[-1,-2,-3,-4,-5]