답변:
하위 선형 시간으로 색인을 생성 할 수있는 구조를 만들어서 매우 효율적으로 수행 할 수 있습니다.
하지만 먼저
{-# LANGUAGE BangPatterns #-}
import Data.Function (fix)을 정의 f하되 직접 호출하는 대신 '오픈 재귀'를 사용하도록 합시다 .
f :: (Int -> Int) -> Int -> Int
f mf 0 = 0
f mf n = max n $ mf (n `div` 2) +
mf (n `div` 3) +
mf (n `div` 4)당신은 f사용하여 메모리 가없는 얻을 수 있습니다fix f
이를 통해 다음 f과 같이 작은 값을 f호출하여 의미하는 바를 테스트 할 수 있습니다 .fix f 123 = 144
우리는 이것을 정의함으로써 이것을 기억할 수 있습니다 :
f_list :: [Int]
f_list = map (f faster_f) [0..]
faster_f :: Int -> Int
faster_f n = f_list !! n그것은 잘 수행되며 O (n ^ 3) 시간이 걸리던 것을 중간 결과를 기억하는 것으로 대체합니다.
그러나에 대한 메모 된 답변을 찾으려면 색인을 작성하는 데 여전히 선형 시간이 걸립니다 mf. 이는 다음과 같은 결과를 의미합니다.
*Main Data.List> faster_f 123801
248604견딜 만하지 만 결과는 그보다 훨씬 뛰어나지 않습니다. 우리는 더 잘할 수 있습니다!
먼저 무한 트리를 정의 해 봅시다 :
data Tree a = Tree (Tree a) a (Tree a)
instance Functor Tree where
fmap f (Tree l m r) = Tree (fmap f l) (f m) (fmap f r)우리가 인덱스 노드를 찾을 수 있도록 그리고 우리는 그것으로 인덱스 방법을 정의 할 수 있습니다 n에 O (로그 n)이 대신 시간 :
index :: Tree a -> Int -> a
index (Tree _ m _) 0 = m
index (Tree l _ r) n = case (n - 1) `divMod` 2 of
(q,0) -> index l q
(q,1) -> index r q... 그리고 우리는 편리한 자연수로 가득 찬 나무를 찾을 수 있습니다. 그래서 우리는 그 지수로 주위를 둘러 볼 필요가 없습니다.
nats :: Tree Int
nats = go 0 1
where
go !n !s = Tree (go l s') n (go r s')
where
l = n + s
r = l + s
s' = s * 2색인을 생성 할 수 있으므로 트리를 목록으로 변환하면됩니다.
toList :: Tree a -> [a]
toList as = map (index as) [0..]당신이 toList nats제공 하는 것을 확인하여 지금까지 작업을 확인할 수 있습니다[0..]
지금,
f_tree :: Tree Int
f_tree = fmap (f fastest_f) nats
fastest_f :: Int -> Int
fastest_f = index f_tree위의 목록과 동일하게 작동하지만 각 노드를 찾기 위해 선형 시간을 소비하는 대신 로그 시간으로 추적 할 수 있습니다.
결과는 훨씬 빠릅니다.
*Main> fastest_f 12380192300
67652175206
*Main> fastest_f 12793129379123
120695231674999실제로 너무 빠르기 때문에 위의 내용을 대체 Int하고 Integer거의 즉각적으로 엄청나게 큰 답변을 얻을 수 있습니다.
*Main> fastest_f' 1230891823091823018203123
93721573993600178112200489
*Main> fastest_f' 12308918230918230182031231231293810923
11097012733777002208302545289166620866358f_tree에서 정의 해서는 안 where됩니까?
에드워드의 대답 은 내가 그것을 복제하고 개방형 재귀 형태로 함수를 기억하는 조합 memoList및 구현 memoTree자를 제공 한 훌륭한 보석입니다 .
{-# LANGUAGE BangPatterns #-}
import Data.Function (fix)
f :: (Integer -> Integer) -> Integer -> Integer
f mf 0 = 0
f mf n = max n $ mf (div n 2) +
mf (div n 3) +
mf (div n 4)
-- Memoizing using a list
-- The memoizing functionality depends on this being in eta reduced form!
memoList :: ((Integer -> Integer) -> Integer -> Integer) -> Integer -> Integer
memoList f = memoList_f
where memoList_f = (memo !!) . fromInteger
memo = map (f memoList_f) [0..]
faster_f :: Integer -> Integer
faster_f = memoList f
-- Memoizing using a tree
data Tree a = Tree (Tree a) a (Tree a)
instance Functor Tree where
fmap f (Tree l m r) = Tree (fmap f l) (f m) (fmap f r)
index :: Tree a -> Integer -> a
index (Tree _ m _) 0 = m
index (Tree l _ r) n = case (n - 1) `divMod` 2 of
(q,0) -> index l q
(q,1) -> index r q
nats :: Tree Integer
nats = go 0 1
where
go !n !s = Tree (go l s') n (go r s')
where
l = n + s
r = l + s
s' = s * 2
toList :: Tree a -> [a]
toList as = map (index as) [0..]
-- The memoizing functionality depends on this being in eta reduced form!
memoTree :: ((Integer -> Integer) -> Integer -> Integer) -> Integer -> Integer
memoTree f = memoTree_f
where memoTree_f = index memo
memo = fmap (f memoTree_f) nats
fastest_f :: Integer -> Integer
fastest_f = memoTree f가장 효율적인 방법은 아니지만 기억합니다.
f = 0 : [ g n | n <- [1..] ]
where g n = max n $ f!!(n `div` 2) + f!!(n `div` 3) + f!!(n `div` 4)를 요청할 때 존재 f !! 144하는지 확인 f !! 143하지만 정확한 값은 계산되지 않습니다. 여전히 계산 결과를 알 수없는 결과로 설정되어 있습니다. 정확한 값만 계산하면됩니다.
따라서 처음에는 계산 된 금액만큼 아무것도 알 수 없습니다.
f = .... 요청하면 f !! 12패턴 일치를 시작합니다.
f = 0 : g 1 : g 2 : g 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...이제 계산을 시작합니다
f !! 12 = g 12 = max 12 $ f!!6 + f!!4 + f!!3이것은 재귀 적으로 f에 대한 또 다른 요구를하므로 우리는
f !! 6 = g 6 = max 6 $ f !! 3 + f !! 2 + f !! 1
f !! 3 = g 3 = max 3 $ f !! 1 + f !! 1 + f !! 0
f !! 1 = g 1 = max 1 $ f !! 0 + f !! 0 + f !! 0
f !! 0 = 0이제 우리는 몇 가지를 흘릴 수 있습니다
f !! 1 = g 1 = max 1 $ 0 + 0 + 0 = 1이는 프로그램이 이제 다음을 알고 있음을 의미합니다.
f = 0 : 1 : g 2 : g 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...계속해서 간질 :
f !! 3 = g 3 = max 3 $ 1 + 1 + 0 = 3이는 프로그램이 이제 다음을 알고 있음을 의미합니다.
f = 0 : 1 : g 2 : 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...이제 다음 계산을 계속합니다 f!!6.
f !! 6 = g 6 = max 6 $ 3 + f !! 2 + 1
f !! 2 = g 2 = max 2 $ f !! 1 + f !! 0 + f !! 0 = max 2 $ 1 + 0 + 0 = 2
f !! 6 = g 6 = max 6 $ 3 + 2 + 1 = 6이는 프로그램이 이제 다음을 알고 있음을 의미합니다.
f = 0 : 1 : 2 : 3 : g 4 : g 5 : 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...이제 다음 계산을 계속합니다 f!!12.
f !! 12 = g 12 = max 12 $ 6 + f!!4 + 3
f !! 4 = g 4 = max 4 $ f !! 2 + f !! 1 + f !! 1 = max 4 $ 2 + 1 + 1 = 4
f !! 12 = g 12 = max 12 $ 6 + 4 + 3 = 13이는 프로그램이 이제 다음을 알고 있음을 의미합니다.
f = 0 : 1 : 2 : 3 : 4 : g 5 : 6 : g 7 : g 8 : g 9 : g 10 : g 11 : 13 : ...따라서 계산은 상당히 게으 릅니다. 이 프로그램은의 가치가 f !! 8존재 한다는 것과 그 가치 가 같다는 것을 알고 g 8있지만, 그것이 무엇인지 전혀 모릅니다 g 8.
g n m = (something with) f!!a!!b
이것은 Edward Kmett의 훌륭한 답변에 대한 부록입니다.
나는 그의 코드를 시도 할 때의 정의 nats와는 index내가 이해하기 쉽게 발견 다른 버전을 쓰기 때문에, 꽤 신비 보였다.
나는 정의 index와 nats측면에서 index'와 nats'.
index' t n범위에 걸쳐 정의됩니다 [1..]. ( index t범위에 대해 정의되어 있음을 기억 하십시오 [0..].) n비트 열로 취급 하고 비트를 역순으로 읽어 트리를 검색합니다 . 비트가 1인 경우 오른쪽 분기를 사용합니다. 비트가 0인 경우 왼쪽 분기를 사용합니다. 마지막 비트 (이어야 함 1)에 도달하면 중지됩니다 .
index' (Tree l m r) 1 = m
index' (Tree l m r) n = case n `divMod` 2 of
(n', 0) -> index' l n'
(n', 1) -> index' r n'마찬가지로 nats정의되어 index그 때문에 index nats n == n항상 사실, nats'정의됩니다 index'.
nats' = Tree l 1 r
where
l = fmap (\n -> n*2) nats'
r = fmap (\n -> n*2 + 1) nats'
nats' = Tree l 1 r자, nats그리고 index단순히 nats'하고 index'있지만, 값을 1로 이동 :
index t n = index' t (n+1)
nats = fmap (\n -> n-1) nats'Edward Kmett의 답변에서 알 수 있듯이 작업 속도를 높이려면 값 비싼 계산을 캐시하고 빠르게 액세스 할 수 있어야합니다.
함수를 비 모노 딕 방식으로 유지하기 위해 무한 게으른 트리를 작성하는 방법은 (이전 게시물에서 볼 수 있듯이) 적절한 색인 방법으로 해당 목표를 달성합니다. 비 모나 딕 함수의 기능을 포기하면 Haskell에서 사용 가능한 표준 연관 컨테이너를 "상태 유사"모나드 (상태 또는 ST와 같은)와 함께 사용할 수 있습니다.
주요 단점은 비 모노 함수를 얻는다는 것인데, 더 이상 구조를 직접 색인화 할 필요가 없으며 표준 연관 컨테이너 구현을 사용할 수 있습니다.
그렇게하려면 먼저 모든 종류의 모나드를 허용하는 함수를 다시 작성해야합니다.
fm :: (Integral a, Monad m) => (a -> m a) -> a -> m a
fm _ 0 = return 0
fm recf n = do
recs <- mapM recf $ div n <$> [2, 3, 4]
return $ max n (sum recs)테스트를 위해 Data.Function.fix를 사용하여 메모를 작성하지 않는 함수를 정의 할 수 있지만 조금 더 장황합니다.
noMemoF :: (Integral n) => n -> n
noMemoF = runIdentity . fix fm그런 다음 State monad를 Data.Map과 함께 사용하여 작업 속도를 높일 수 있습니다.
import qualified Data.Map.Strict as MS
withMemoStMap :: (Integral n) => n -> n
withMemoStMap n = evalState (fm recF n) MS.empty
where
recF i = do
v <- MS.lookup i <$> get
case v of
Just v' -> return v'
Nothing -> do
v' <- fm recF i
modify $ MS.insert i v'
return v'약간만 변경하면 코드를 Data.HashMap과 함께 작동하도록 조정할 수 있습니다.
import qualified Data.HashMap.Strict as HMS
withMemoStHMap :: (Integral n, Hashable n) => n -> n
withMemoStHMap n = evalState (fm recF n) HMS.empty
where
recF i = do
v <- HMS.lookup i <$> get
case v of
Just v' -> return v'
Nothing -> do
v' <- fm recF i
modify $ HMS.insert i v'
return v'영구 데이터 구조 대신 ST 모나드와 함께 가변 데이터 구조 (예 : Data.HashTable)를 시도 할 수도 있습니다.
import qualified Data.HashTable.ST.Linear as MHM
withMemoMutMap :: (Integral n, Hashable n) => n -> n
withMemoMutMap n = runST $
do ht <- MHM.new
recF ht n
where
recF ht i = do
k <- MHM.lookup ht i
case k of
Just k' -> return k'
Nothing -> do
k' <- fm (recF ht) i
MHM.insert ht i k'
return k'메모를 사용하지 않는 구현과 비교할 때 이러한 구현을 사용하면 큰 입력의 경우 몇 초 동안 기다리지 않고 마이크로 초 단위로 결과를 얻을 수 있습니다.
Criterion을 벤치 마크로 사용하면 Data.HashMap을 사용한 구현이 실제로 타이밍이 매우 유사한 Data.Map 및 Data.HashTable보다 약간 더 나은 성능 (약 20 %)을 관찰 할 수 있습니다.
벤치 마크 결과가 약간 놀랍습니다. 필자의 초기 느낌은 HashTable이 변경 가능하기 때문에 HashMap 구현을 능가한다는 것입니다. 이 마지막 구현에서 일부 성능 결함이 숨겨져있을 수 있습니다.
몇 년 후, 나는 이것을보고 선형 zipWith함수와 도우미 함수를 사용하여 이것을 선형으로 기억하는 간단한 방법이 있음을 깨달았습니다 .
dilate :: Int -> [x] -> [x]
dilate n xs = replicate n =<< xsdilate편리한 속성을 가지고 dilate n xs !! i == xs !! div i n있습니다.
따라서 f (0)이 주어 졌다고 가정하면 계산이 간단 해집니다.
fs = f0 : zipWith max [1..] (tail $ fs#/2 .+. fs#/3 .+. fs#/4)
where (.+.) = zipWith (+)
infixl 6 .+.
(#/) = flip dilate
infixl 7 #/원래의 문제 설명과 비슷하게 보이며 선형 솔루션을 제공합니다 ( sum $ take n fsO (n)이 필요함).
Edward Kmett의 답변에 대한 또 다른 부록 : 자체 포함 된 예 :
data NatTrie v = NatTrie (NatTrie v) v (NatTrie v)
memo1 arg_to_index index_to_arg f = (\n -> index nats (arg_to_index n))
where nats = go 0 1
go i s = NatTrie (go (i+s) s') (f (index_to_arg i)) (go (i+s') s')
where s' = 2*s
index (NatTrie l v r) i
| i < 0 = f (index_to_arg i)
| i == 0 = v
| otherwise = case (i-1) `divMod` 2 of
(i',0) -> index l i'
(i',1) -> index r i'
memoNat = memo1 id id 단일 정수 arg (예 : 피보나치)로 함수를 메모하려면 다음과 같이 사용하십시오.
fib = memoNat f
where f 0 = 0
f 1 = 1
f n = fib (n-1) + fib (n-2)음이 아닌 인수의 값만 캐시됩니다.
음수 인수의 값을 캐시하려면 memoInt다음과 같이 정의 된을 사용하십시오 .
memoInt = memo1 arg_to_index index_to_arg
where arg_to_index n
| n < 0 = -2*n
| otherwise = 2*n + 1
index_to_arg i = case i `divMod` 2 of
(n,0) -> -n
(n,1) -> n두 개의 정수 인수가있는 함수의 값을 캐시하려면 memoIntInt다음과 같이 정의 된를 사용하십시오 .
memoIntInt f = memoInt (\n -> memoInt (f n))색인이없고 Edward KMETT를 기반으로하지 않는 솔루션입니다.
공통의 부모에 공통 하위 트리 밖으로 I 계수 ( f(n/4)간에 공유 f(n/2)하고 f(n/4), 그리고 f(n/6)사이에 공유 f(2)하고 f(3)). 부모에서 단일 변수로 저장하면 하위 트리 계산이 한 번 수행됩니다.
data Tree a =
Node {datum :: a, child2 :: Tree a, child3 :: Tree a}
f :: Int -> Int
f n = datum root
where root = f' n Nothing Nothing
-- Pass in the arg
-- and this node's lifted children (if any).
f' :: Integral a => a -> Maybe (Tree a) -> Maybe (Tree a)-> a
f' 0 _ _ = leaf
where leaf = Node 0 leaf leaf
f' n m2 m3 = Node d c2 c3
where
d = if n < 12 then n
else max n (d2 + d3 + d4)
[n2,n3,n4,n6] = map (n `div`) [2,3,4,6]
[d2,d3,d4,d6] = map datum [c2,c3,c4,c6]
c2 = case m2 of -- Check for a passed-in subtree before recursing.
Just c2' -> c2'
Nothing -> f' n2 Nothing (Just c6)
c3 = case m3 of
Just c3' -> c3'
Nothing -> f' n3 (Just c6) Nothing
c4 = child2 c2
c6 = f' n6 Nothing Nothing
main =
print (f 123801)
-- Should print 248604.코드는 일반적인 메모 기능으로 쉽게 확장되지 않으며 (적어도 어떻게 해야할지 모르겠습니다) 하위 문제가 어떻게 겹치는 지 실제로 생각해야하지만 전략 해야 은 정수가 아닌 일반적인 여러 정수 매개 변수에 대해 작동해야합니다 . (두 개의 문자열 매개 변수에 대해 생각했습니다.)
메모는 각 계산 후에 삭제됩니다. (다시 말해서 두 개의 문자열 매개 변수에 대해 생각하고있었습니다.)
이것이 다른 답변보다 더 효율적인지 모르겠습니다. 각 조회는 기술적으로 한두 단계 ( "자녀 또는 자녀의 아이"를 봅니다)이지만 많은 추가 메모리 사용이있을 수 있습니다.
편집 :이 솔루션은 아직 올바르지 않습니다. 공유가 불완전합니다.
편집 : 그것은 제대로 지금 subchildren를 공유해야하지만, 나는이 문제가 사소 공유 많이 가지고 있음을 깨달았다 n/2/2/2과 n/3/3같은 수 있습니다. 문제는 내 전략에 적합하지 않습니다.