[Haskell-cafe] Re: Updating doubly linked lists

[oleg at okmij.org]

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