[Haskell-cafe] Re: Updating doubly linked lists
oleg at okmij.org
oleg at okmij.org
Sat Jan 3 04:51:15 EST 2009
Stephan Guenther wrote:
> Is it possible to change a particular node of the doubly linked list?
> That is to say, that would like to have a function:
> update :: DList a -> a -> DList a
> where
> update node newValue
> returns a list where only the value at the node which is passed in is
> set to the new Value and all other values are the same. All this of
> course in a pure way, that is without using (M/T/TM)Vars or IORefs.
It is possible to do all of this, and more:
- no rebuilding of the whole list on updates to the list
- the update operation takes constant time (for lists longer
than 32 elements on 32-bit platform)
- both cyclic and terminated lists can be handled, uniformly
- no monads used or mentioned
- let alone no IORef, STRef, TVars, etc.
The algorithm is essentially imperative (and so permits identity
checking and in-place `updates') but implemented purely
functionally. No destructive updates are ever used. Therefore, all the
changes can be undone and re-done, and the code is MT-safe. The code
is easily generalizable to 2D.
Here are the tests
> testl = fromList [1..5]
> testl_s = takeDL 11 testl
*FL> testl_s
[5,1,2,3,4,5,1,2,3,4,5]
> testl1 = update (-1) testl
> testl1_s = takeDL 11 testl1
*FL> testl1_s
[-1,1,2,3,4,-1,1,2,3,4,-1]
> testl2 = update (-2) . move_right' . move_right' $ testl1
> testl2_s = takeDL 11 testl2
*FL> testl2_s
[-2,3,4,-1,1,-2,3,4,-1,1,-2]
> -- Old testl is still available
> testl3 = update (-2) . move_right' . move_right' $ testl
> testl3_s = takeDL 11 testl3
*FL> testl3_s
[-2,3,4,5,1,-2,3,4,5,1,-2]
It is not for nothing Haskell is called the best imperative
language. One can implement imperative algorithms just as they are --
purely functionally, without any monads or other categorical notions.
module FL where
import qualified Data.IntMap as IM
-- Representation of the double-linked list
type Ref = Int -- positive, we shall treat 0 specially
data Node a = Node{node_val :: a,
node_left :: Ref,
node_right :: Ref}
data DList a = DList{dl_counter :: Ref, -- to generate new Refs
dl_current :: Ref, -- current node
dl_mem :: IM.IntMap (Node a)} -- main `memory'
-- Operations on the DList a
empty :: DList a
empty = DList{dl_counter = 1, dl_current = 0, dl_mem = IM.empty}
-- In a well-formed list, dl_current must point to a valid node
-- All operations below preserve well-formedness
well_formed :: DList a -> Bool
well_formed dl | IM.null (dl_mem dl) = dl_current dl == 0
well_formed dl = IM.member (dl_current dl) (dl_mem dl)
is_empty :: DList a -> Bool
is_empty dl = IM.null (dl_mem dl)
-- auxiliary function
get_curr_node :: DList a -> Node a
get_curr_node DList{dl_current=curr,dl_mem=mem} =
maybe (error "not well-formed") id $ IM.lookup curr mem
-- The insert operation below makes a cyclic list
-- The other operations don't care
-- Insert to the right of the current element, if any
-- Return the DL where the inserted node is the current one
insert_right :: a -> DList a -> DList a
insert_right x dl | is_empty dl =
let ref = dl_counter dl
-- the following makes the list cyclic
node = Node{node_val = x, node_left = ref, node_right = ref}
in DList{dl_counter = succ ref,
dl_current = ref,
dl_mem = IM.insert ref node (dl_mem dl)}
insert_right x dl at DList{dl_counter = ref, dl_current = curr, dl_mem = mem} =
DList{dl_counter = succ ref, dl_current = ref,
dl_mem = IM.insert ref new_node $ IM.insert curr curr_node' mem}
where
curr_node = get_curr_node dl
curr_node'= curr_node{node_right = ref}
new_node = Node{node_val = x, node_left = curr,
node_right = node_right curr_node}
get_curr :: DList a -> a
get_curr = node_val . get_curr_node
move_right :: DList a -> Maybe (DList a)
move_right dl = if next == 0 then Nothing else Just (dl{dl_current=next})
where
next = node_right $ get_curr_node dl
-- If no right, just stay inplace
move_right' :: DList a -> DList a
move_right' dl = maybe dl id $ move_right dl
fromList :: [a] -> DList a
fromList = foldl (flip insert_right) FL.empty
takeDL :: Int -> DList a -> [a]
takeDL 0 _ = []
takeDL n dl | is_empty dl = []
takeDL n dl = get_curr dl : (maybe [] (takeDL (pred n)) $ move_right dl)
-- Update the current node
update :: a -> DList a -> DList a
update x dl@(DList{dl_current = curr, dl_mem = mem}) =
dl{dl_mem = IM.insert curr (curr_node{node_val = x}) mem}
where
curr_node = get_curr_node dl
testl = fromList [1..5]
testl_s = takeDL 11 testl
testl1 = update (-1) testl
testl1_s = takeDL 11 testl1
testl2 = update (-2) . move_right' . move_right' $ testl1
testl2_s = takeDL 11 testl2
-- Old testl is still available
testl3 = update (-2) . move_right' . move_right' $ testl
testl3_s = takeDL 11 testl3
More information about the Haskell-Cafe
mailing list