Haskell Data.STM.LinkedList实现
我正在研究Data.STM.LinkedList的实现，以获得高性能的链表。查看文档，length函数以O（n）形式运行-为什么？在O（1）中实现它是否存在任何实际问题 这是源代码 是否可以在O（1）中实现它？我是Haskell的新手，所以我不确定保存一些关于列表的元数据是否有问题Haskell Data.STM.LinkedList实现,haskell,doubly-linked-list,Haskell,Doubly Linked List,我正在研究Data.STM.LinkedList的实现，以获得高性能的链表。查看文档，length函数以O（n）形式运行-为什么？在O（1）中实现它是否存在任何实际问题 这是源代码 是否可以在O（1）中实现它？我是Haskell的新手，所以我不确定保存一些关于列表的元数据是否有问题 谢谢 对于一级近似值，Haskell是一种表达能力很强的语言，任何用另一种通用语言实现的算法也可以用Haskell实现，同时保持渐近性能特征。（这是一个很低的条。大多数通用语言都是这样表达的。） 特别是，尽管Has
谢谢 对于一级近似值，Haskell是一种表达能力很强的语言，任何用另一种通用语言实现的算法也可以用Haskell实现，同时保持渐近性能特征。（这是一个很低的条。大多数通用语言都是这样表达的。） 特别是，尽管Haskell最自然地支持不可变数据结构，但它对可变数据有足够的支持，可变数据结构及其算法通常可以相当直接地转换为Haskell代码。可能会有一些开销（通常是相当大的开销），可变数据结构可能比不可变数据结构更难使用，但这仍然是可能的
作为一个实际问题，虽然匹配一个可变数据结构的C++实现的实际（而不是渐近）性能很可能证明是非常困难的，如果不是不可能的话。它可以是合理的2-3倍内的性能的C++，并获得5-10倍是相当容易的（见下文）。但是，如果你需要匹配C++的性能，你最好在C++中编写高性能的变异代码，并使用FFI（FieldFieldFieldAtter）来与该代码接口。 无论如何，一个具有O（1）
长度的“中等性能”双链表肯定是可能的，并且维护可变的列表范围元数据没有根本的困难。代码< > STM Link KEdList< /C>不提供O（1）<代码>长度<代码>可能是C++保证只有O（n）<代码> STD:：：清单：大小< /COD>性能的相同原因。也就是说，双链表的许多实际用途不需要调用长度
/大小
，提供O（1）性能需要额外的记账成本
作为概念证明，以下数据类型足以实现具有O（1）长度函数的完全可变双链表。这里，以下划线结尾的类型和标识符仅供内部使用。列表在指针上是严格的（因此没有无限的列表！），但在值上是懒惰的
data List a = List
{ headNode_ :: !(IORef (Node_ a))
, length_ :: !(IORef Int) }
data Node_ a = Node_
{ prev_ :: !(IORef (Node_ a))
, next_ :: !(IORef (Node_ a))
, value_ :: a }
列表
类型包含指向不完整的头节点
的指针（即，IORef
），该头节点指向列表的开始和结束（或指向空列表的自身），但具有未定义的值字段。这使得它成为一个不安全的节点值，因此最终用户永远不应该直接访问它。列表
还包含指向列表长度值的指针
delete :: Node a -> IO ()
delete Node{node_,list_} = do
modifyIORef' (length_ list_) pred
Node_{next_, prev_} <- readIORef node_
modifyIORef' prev_ (\n -> n{next_=next_})
modifyIORef' next_ (\n -> n{prev_=prev_})
另一种类型节点
（无下划线）用于用节点指针对应的列表（如注释中的“迭代器”）修饰节点指针，以使列表元数据可用于需要它的函数：
data Node a = Node
{ node_ :: !(IORef (Node_ a))
, list_ :: !(List a) }
请注意，List
和Node
是使用列表时面向用户的数据类型
您可以创建一个空的列表，如下所示：
empty :: IO (List a)
empty = mdo
n <- newIORef (Node_ n n undefined)
List n <$> newIORef 0
请注意，所有插入都经过负责增加长度值的insertBetween
delete :: Node a -> IO ()
delete Node{node_,list_} = do
modifyIORef' (length_ list_) pred
Node_{next_, prev_} <- readIORef node_
modifyIORef' prev_ (\n -> n{next_=next_})
modifyIORef' next_ (\n -> n{prev_=prev_})
无论是内部节点还是起始节点或结束节点，删除都是简单而统一的。所有删除操作都通过此delete
函数进行，该函数负责减小长度值
delete :: Node a -> IO ()
delete Node{node_,list_} = do
modifyIORef' (length_ list_) pred
Node_{next_, prev_} <- readIORef node_
modifyIORef' prev_ (\n -> n{next_=next_})
modifyIORef' next_ (\n -> n{prev_=prev_})
注意，我们必须注意不要给用户head节点，因此这里的maybeNode\uuu
检查它并返回Nothing
要开始，用户可以使用以下功能（在禁止的头部节点上使用prev
或next
）获取列表的开始或结束：
缺少的只是一些杂项查询功能：
value :: Node a -> IO a
value = fmap value_ . readIORef . node_
null :: List a -> IO Bool
null l = (==0) <$> length l
length :: List a -> IO Int
length = readIORef . length_
警告：如果在完全计算生成的字符串之前对列表进行了修改，则此Show
实例是不安全的，因此它只能用于调试（可能从生产版本中删除）
此外，由于我们可以删除和重新插入，因此这不是严格必要的，但如果不就地修改元素，任何自尊心强的可变结构都是不完整的：
modify :: (a -> a) -> Node a -> IO ()
modify f Node{node_} = modifyIORef' node_ (\n -> n { value_ = f (value_ n) })
这是完整的代码。（参见定义ex1
的用法示例。）欢迎您将其作为自己实现的起点。它是未经测试和未基准的，除了几个快速测试表明它可能比C++实现慢5-10倍。
{-# LANGUAGE NamedFieldPuns, RecursiveDo #-}
module LinkedList
( List, Node
, value, null, length
, empty, prepend, append, insertBefore, insertAfter, delete, modify
, prev, next, start, end
, toList, toListRev
) where
import System.IO.Unsafe
import Control.Monad
import Prelude hiding (null, length)
import Data.IORef
data List a = List
{ headNode_ :: !(IORef (Node_ a))
, length_ :: !(IORef Int) }
data Node a = Node
{ node_ :: !(IORef (Node_ a))
, list_ :: !(List a) }
data Node_ a = Node_
{ prev_ :: !(IORef (Node_ a))
, next_ :: !(IORef (Node_ a))
, value_ :: a }
-- unsafe show instance: remove from production version
instance (Show a) => Show (List a) where
showsPrec d lst = showParen (d > 10) $ showString "fromList " . showsPrec 11 (unsafePerformIO $ toList lst)
value :: Node a -> IO a
value = fmap value_ . readIORef . node_
null :: List a -> IO Bool
null l = (==0) <$> length l
length :: List a -> IO Int
length = readIORef . length_
empty :: IO (List a)
empty = mdo
n <- newIORef (Node_ n n undefined)
List n <$> newIORef 0
prepend :: a -> List a -> IO (Node a)
prepend x l = insertAfter x (Node (headNode_ l) l)
append :: a -> List a -> IO (Node a)
append x l = insertBefore x (Node (headNode_ l) l)
insertBefore :: a -> Node a -> IO (Node a)
insertBefore x Node{node_=rnode2, list_} = do
Node_{prev_=rnode1} <- readIORef rnode2
insertBetween_ x list_ rnode1 rnode2
insertAfter :: a -> Node a -> IO (Node a)
insertAfter x Node{node_=rnode1, list_} = do
Node_{next_=rnode2} <- readIORef rnode1
insertBetween_ x list_ rnode1 rnode2
insertBetween_ :: a -> List a -> IORef (Node_ a) -> IORef (Node_ a) -> IO (Node a)
insertBetween_ x l rnode1 rnode2 = do
modifyIORef' (length_ l) succ
newnode <- newIORef (Node_ rnode1 rnode2 x)
modifyIORef' rnode1 (\n -> n{next_=newnode})
modifyIORef' rnode2 (\n -> n{prev_=newnode})
return $ Node newnode l
delete :: Node a -> IO ()
delete Node{node_,list_} = do
modifyIORef' (length_ list_) pred
Node_{next_, prev_} <- readIORef node_
modifyIORef' prev_ (\n -> n{next_=next_})
modifyIORef' next_ (\n -> n{prev_=prev_})
modify :: (a -> a) -> Node a -> IO ()
modify f Node{node_} = modifyIORef' node_ (\n -> n { value_ = f (value_ n) })
prev :: Node a -> IO (Maybe (Node a))
prev Node{node_, list_} = do
Node_{prev_} <- readIORef node_
return $ maybeNode_ prev_ list_
next :: Node a -> IO (Maybe (Node a))
next Node{node_, list_} = do
Node_{next_} <- readIORef node_
return $ maybeNode_ next_ list_
maybeNode_ :: IORef (Node_ a) -> List a -> Maybe (Node a)
maybeNode_ n l =
if n == headNode_ l
then Nothing
else Just (Node n l)
start :: List a -> IO (Maybe (Node a))
start l = next $ Node (headNode_ l) l
end :: List a -> IO (Maybe (Node a))
end l = prev $ Node (headNode_ l) l
toList :: List a -> IO [a]
toList = toList_ next_
toListRev :: List a -> IO [a]
toListRev = toList_ prev_
toList_ :: (Node_ a -> IORef (Node_ a)) -> List a -> IO [a]
toList_ dir l = go =<< readIORef h
where h = headNode_ l
go n = do
if dir n == h then return []
else do
n' <- readIORef (dir n)
(value_ n':) <$> go n'
ex1 :: IO (List Int)
ex1 = do
t <- empty
mapM_ (flip prepend t) [10,9..1]
mapM_ (flip append t) [11..20]
return t
{-#语言名称字段puns，递归do}
模块链接列表
（列表、节点）
，值，空，长度
，空，前置，追加，插入之前，插入之后，删除，修改
，上一个，下一个，开始，结束
，托利斯特，托利斯特雷夫
)在哪里
导入System.IO不安全
进口管制
导入前奏隐藏（空，长度）
导入数据.IORef
数据列表a=列表
{头节点：：！（IORef（节点a））
，长度：：！（IORef Int）}
数据节点a=节点
{节点：：！（IORef（节点a））
，列表：：！（列表a）}
数据节点uA=节点_
{上一个：：！（IORef（节点a））
，下一个：：！（IORef（节点a））
，值\：：a}
--不安全的显示实例：从生产版本中删除
实例（显示a）=>显示（列表a）其中
showsPrec d lst=showParen（d>10）$showString“fromList”。showsPrec 11（未安全性能$toList lst）
值：：节点a->IO a
值=fmap值。readIORef。节点_
空：：列表a->IO布尔
空l=（==0）长度l
长度：：列表a->IO Int
长度=readIORef。长度_
空：：IO（列表a）
空=mdo
n列表a->IO（节点a）
前置x l=插入x之后（节点（头节点）l）
追加：：a->列出a
toList :: List a -> IO [a]
toList = toList_ next_
toListRev :: List a -> IO [a]
toListRev = toList_ prev_
toList_ :: (Node_ a -> IORef (Node_ a)) -> List a -> IO [a]
toList_ dir l = go =<< readIORef h
where h = headNode_ l
go n = do
if dir n == h then return []
else do
n' <- readIORef (dir n)
(value_ n':) <$> go n'
instance (Show a) => Show (List a) where
showsPrec d lst = showParen (d > 10) $ showString "fromList " . showsPrec 11 (unsafePerformIO $ toList lst)
modify :: (a -> a) -> Node a -> IO ()
modify f Node{node_} = modifyIORef' node_ (\n -> n { value_ = f (value_ n) })
{-# LANGUAGE NamedFieldPuns, RecursiveDo #-}
module LinkedList
( List, Node
, value, null, length
, empty, prepend, append, insertBefore, insertAfter, delete, modify
, prev, next, start, end
, toList, toListRev
) where
import System.IO.Unsafe
import Control.Monad
import Prelude hiding (null, length)
import Data.IORef
data List a = List
{ headNode_ :: !(IORef (Node_ a))
, length_ :: !(IORef Int) }
data Node a = Node
{ node_ :: !(IORef (Node_ a))
, list_ :: !(List a) }
data Node_ a = Node_
{ prev_ :: !(IORef (Node_ a))
, next_ :: !(IORef (Node_ a))
, value_ :: a }
-- unsafe show instance: remove from production version
instance (Show a) => Show (List a) where
showsPrec d lst = showParen (d > 10) $ showString "fromList " . showsPrec 11 (unsafePerformIO $ toList lst)
value :: Node a -> IO a
value = fmap value_ . readIORef . node_
null :: List a -> IO Bool
null l = (==0) <$> length l
length :: List a -> IO Int
length = readIORef . length_
empty :: IO (List a)
empty = mdo
n <- newIORef (Node_ n n undefined)
List n <$> newIORef 0
prepend :: a -> List a -> IO (Node a)
prepend x l = insertAfter x (Node (headNode_ l) l)
append :: a -> List a -> IO (Node a)
append x l = insertBefore x (Node (headNode_ l) l)
insertBefore :: a -> Node a -> IO (Node a)
insertBefore x Node{node_=rnode2, list_} = do
Node_{prev_=rnode1} <- readIORef rnode2
insertBetween_ x list_ rnode1 rnode2
insertAfter :: a -> Node a -> IO (Node a)
insertAfter x Node{node_=rnode1, list_} = do
Node_{next_=rnode2} <- readIORef rnode1
insertBetween_ x list_ rnode1 rnode2
insertBetween_ :: a -> List a -> IORef (Node_ a) -> IORef (Node_ a) -> IO (Node a)
insertBetween_ x l rnode1 rnode2 = do
modifyIORef' (length_ l) succ
newnode <- newIORef (Node_ rnode1 rnode2 x)
modifyIORef' rnode1 (\n -> n{next_=newnode})
modifyIORef' rnode2 (\n -> n{prev_=newnode})
return $ Node newnode l
delete :: Node a -> IO ()
delete Node{node_,list_} = do
modifyIORef' (length_ list_) pred
Node_{next_, prev_} <- readIORef node_
modifyIORef' prev_ (\n -> n{next_=next_})
modifyIORef' next_ (\n -> n{prev_=prev_})
modify :: (a -> a) -> Node a -> IO ()
modify f Node{node_} = modifyIORef' node_ (\n -> n { value_ = f (value_ n) })
prev :: Node a -> IO (Maybe (Node a))
prev Node{node_, list_} = do
Node_{prev_} <- readIORef node_
return $ maybeNode_ prev_ list_
next :: Node a -> IO (Maybe (Node a))
next Node{node_, list_} = do
Node_{next_} <- readIORef node_
return $ maybeNode_ next_ list_
maybeNode_ :: IORef (Node_ a) -> List a -> Maybe (Node a)
maybeNode_ n l =
if n == headNode_ l
then Nothing
else Just (Node n l)
start :: List a -> IO (Maybe (Node a))
start l = next $ Node (headNode_ l) l
end :: List a -> IO (Maybe (Node a))
end l = prev $ Node (headNode_ l) l
toList :: List a -> IO [a]
toList = toList_ next_
toListRev :: List a -> IO [a]
toListRev = toList_ prev_
toList_ :: (Node_ a -> IORef (Node_ a)) -> List a -> IO [a]
toList_ dir l = go =<< readIORef h
where h = headNode_ l
go n = do
if dir n == h then return []
else do
n' <- readIORef (dir n)
(value_ n':) <$> go n'
ex1 :: IO (List Int)
ex1 = do
t <- empty
mapM_ (flip prepend t) [10,9..1]
mapM_ (flip append t) [11..20]
return t