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?
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.
If you are sure, and you want to avoid the worst performance pitfalls of trying to do this, have you considered using Data.FDList?
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)
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)
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.
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.
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
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.
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