Doubly Linked Circular List

Learn
#1

I have been feeling very stupid (took me like 8 hours) trying to implement a doubly linked circular list. Is there a better way to implement fromNonEmpty?

data DLCL a = DLCL {value :: a, prev :: DLCL a, next :: DLCL a}

instance Show a => Show (DLCL a) where
  show (DLCL x (DLCL y _ _) (DLCL z _ _)) = show y <> " <- " <> show x <> " -> " <> show z

fromNonEmpty :: NonEmpty a -> DLCL a
fromNonEmpty (x:|xs) = h 
  where
  h = DLCL x l f 
  (l, f) = fromList h h xs
  fromList f p = \case
    [x] -> let c = DLCL x p f 
           in (c, c)
    x:xs -> let c = DLCL x p n 
                (l,n) = fromList f c xs
            in (l,c)
    [] -> (p,p)

Also, how does the GC collect this? Does it look for isolated networks?

1 Like
#2
  1. Are you sure you want a doubly-linked circular list in Haskell, as opposed to something that uses zippers or some other more FP-native structure? Unlike a singly-linked list, the direct encoding (what your DLCL does) won’t share structure with the result of performing various operations on it.
  2. If you are sure, and you want to avoid the worst performance pitfalls of trying to do this, have you considered using Data.FDList?
  3. But if you’re just doing this for the learning experience…
fromNonEmpty :: NonEmpty a -> DLCL a
fromNonEmpty xs = hd
  where
  link f g (prev, next) =
    let (node0, node1) = f (prev, node2)
        (node2, node3) = g (node1, next)
    in (node0, node3)
  (hd, last) = foldr1 link
    (fmap (\x -> join (,) . uncurry (DLCL x)) xs)
    (last, hd)
#3

I think yours is a nice implementation. It’s easier to understand when I replace the single-letter variables with words:

fromNonEmpty :: NonEmpty a -> DLCL a
fromNonEmpty (x:|xs) = home
  where
  home = DLCL x last first
  (last, first) = fromList home home xs
  fromList first previous = \case
    [x] -> let current = DLCL x previous first
           in (current, current)
    x:xs -> let current = DLCL x previous next
                (last,next) = fromList first current xs
            in (last,current)
    [] -> (previous,previous)

The only thing that smells a little to me is the [] -> (previous, previous) case. It could just as well be [] -> (first, first), since the only way to hit that case is if your input list hast only one element, so first = previous for that case.

I’ve moved things around a little bit to avoid that unnecessary complication:

fromNonEmpty' :: NonEmpty a -> DLCL a
fromNonEmpty' (x:|xs) = first where
  (last, first) = fromList last x xs
  fromList previous thisValue = \case
    [] -> (this,this) where
      this = DLCL thisValue previous first
    nextValue:rest -> (last,this) where
      this = DLCL thisValue previous next
      (last, next) = fromList this nextValue rest

In my version, fromList always produces a new node, the node that corresponds to its thisValue argument and it’s supposed to return (last node, this node)

1 Like
#4

It doesn’t look for isolated networks per se, it looks for things that are reachable (starting from root objects), so anything that’s not reachable gets garbage collected.

That’s a good observation, but I think this specific data structure could still be useful if you’re not planning to apply any operation to the DLCL once it’s constructed and if you’re planning to move back and forth many more times than the number of elements in the list, because once fully forced, this DLCL won’t be allocating any memory when you move back and forth.

Your version doesn’t seem to work:

ghci> ref <- newIORef $ fromNonEmpty'' $ 1:|[2,3,4,5]
ghci> replicateM 6 $ atomicModifyIORef ref (\(DLCL _ _ r) -> (r,r))
[1 <- 2 -> 3,2 <- 3 -> 4,3 <- 4 -> 5,4 <- 5 -> 1,1 <- 1 -> 2,1 <- 2 -> 3]
ghci> replicateM 6 $ atomicModifyIORef ref (\(DLCL _ l _) -> (l,l))
[1 <- 1 -> 2,1 <- 1 -> 2,1 <- 1 -> 2,1 <- 1 -> 2,1 <- 1 -> 2,1 <- 1 -> 2]

(Never mind the IORef awkwardness, I used it to be able to move back and forth easily in ghci)

1 Like
#5

Ah thank you, you are correct! I’ll edit my post to a correct, if a bit more complicated version.

#6

I was using this as a learning experience for Robot Simulator in Haskell on Exercism

They have a type data Bearing = North | East | South | West and thought the type type Compass = DLCL Bearing would be a cool way of tracking the direction with next and prev used for turning.

#7

By operations do you mean things like append and tail?

#8

OK, here’s a version I prefer even more since DLCL is used only once:

fromNonEmpty' :: NonEmpty a -> DLCL a
fromNonEmpty' (x:|xs) = first where
  (last, first) = fromList last x xs
  fromList previous thisValue thisRest = (last,this) where
    this = DLCL thisValue previous next
    (last, next) = case thisRest of
      [] -> (this,first)
      nextValue:nextRest -> fromList this nextValue nextRest
#9

Thanks I was trying to figure out how to get rid of the [x] case.

#10

Yes, exactly.

I’ve updated my solution to one that works; thanks again for the correction. It differs from yours and @enobayram’s by using a fold function and no other explicit recursion—it’s a good thing to keep in mind that most natural operations on lists are expressible as folds.

2 Likes
#11

If it brings you joy, who am I to stop you; but I would have chosen to implement an instance of Enum to represent that.

3 Likes
#12

For fun, using tardis:

import Data.Foldable (for_)
import Data.Function (fix)
import Control.Monad.Tardis

fromNonEmpty :: NonEmpty a -> DLCL a
fromNonEmpty xs = fst $ fix $ execTardis $
  for_ xs $ \x -> tardis $ \(nxt,prv) -> let cur = DLCL x prv nxt in ((),(cur,cur))
5 Likes
#13

Should do some benchmarks comparing Enum to DLCL

#14

I think I have been unknowningly needing tardis my whole life

1 Like
#15

You could try an intermediate array to keep things simpler:

fromNonEmpty :: NonEmpty a -> DLCL a
fromNonEmpty (x:|xs) = a ! 0
  where
    a = listArray (0, len-1)
      [DLCL { value = v, prev = a ! p, next = a ! n }
      |(v,p,n) <- zip3 l (len-1:[0..]) ([1..len-1]<>[0])]
    len = length l
    l = (x:xs)

An intermediate circular list can be used too, but tying the lazy knot becomes much more complicated:

fromNonEmpty :: NonEmpty a -> DLCL a
fromNonEmpty (x:|xs) = head l
  where
    l = z3 (x:xs) (drop (length xs) c) (tail c)
    c = cycle l
    z3 []       _       _     = []
    z3 (v:vs) ~(p:ps) ~(n:ns) = DLCL v p n : z3 vs ps ns
1 Like