Justin Bailey jgbailey at gmail.com
Wed Nov 7 10:52:28 EST 2007

```The other day I decided to implement a ring buffer with a current
element (i.e. a doubly-linked zipper list). In order to allow inserts
(and, in the future, deletes and updates), I have a special sentinel
element called "Join" in the structure. When inserting, I find the
join first, insert and then rebuild the buffer using circular
programming techniques. This also allows the buffer to be converted
back to a list. The current element can be changed by rotating right
or left, which never fails. Rotating n positions takes n steps.

I'm posting it here for comments and feedback. How could the structure
be smarter? Would storing a unique ID with each element make more
sense? Any comments on the space behavior under insert and rotates? I
wanted to "maximize" sharing. Thanks in advance.

Justin

p.s. The original motivation for writing this was to model cellular
automata. The CA world is "circular", so that got me thinking about a
structure that made connecting the ends easy to do.

-- cut here ---

module Ring (Ring, create, insert, current, rotR, rotL, toListL, toListR)
-- Thanks to Keith Wansbrough  for his posting describing a doubly-linked list
-- in Haskell for inspiration here.
--
where

import Data.List (foldl')
-- For testing
import Test.QuickCheck
import System.Random (randomRIO)
import System.Environment (getArgs)

data Ring a = Ring (Ring a) a (Ring a) | Join (Ring a) (Ring a)

instance (Show a) => Show (Ring a) where
show r = "{" ++ show' (findLeftOfJoin r)
where
show' (Join _ _) = "}"
show' (Ring l v _)
| isJoin l = show v ++ show' l
| otherwise = show v ++ "," ++ show' l

create v =
let me = Ring join v join
join = Join me me
in me

insert r a =
let (left, right) = insert' left right start a
start = findLeftOfJoin r
in left
where
insert' left right (Join _ _) val =
let last = Ring join val right
join = Join left last
in (last, join)
insert' left right (Ring l v _) val =
let this = Ring newL val right
(newL, newR) = insert' left this l v
in (this, newR)

fromList [] = error "Can't create empty ring"
fromList ls =
let (left, right) = fromList' left right ls
in left
where
-- compute this ring, given left and right pointers. Return
-- left and right pointers for this segment
fromList' left right [] =
let join = Join left right
in (join, right)
fromList' left right (x:xs) =
let this = Ring l x right
(l, r) = fromList' left this xs
in (this, r)

toList = toListL

-- View of list from left hand side
toListL = toList' . findLeftOfJoin
where
toList' (Join _ _) = []
toList' (Ring l v _) = v : toList' l

toListR = toList' . findRightOfJoin
where
toList' (Join _ _) = []
toList' (Ring _ v r) = v : toList' r

current (Ring r v l) = v
current _ = error "Join is never current (curr)"

rotR r amt
| amt > 0 = goRight r amt
| amt < 0 = goLeft r (negate amt)
| otherwise = r

rotL r amt
| amt > 0 = goLeft r amt
| amt < 0 = goRight r (negate amt)
| otherwise = r

goRight r 0 = r
goRight (Ring _ _ r@(Ring _ _ _)) amt = goRight r (amt - 1)
goRight (Ring _ _ (Join _ r)) amt = goRight r (amt - 1)
goRight (Join _ _) _ = error "Join is never current (goRight)"

goLeft r 0 = r
goLeft (Ring l@(Ring _ _ _) _ _) amt = goLeft l (amt - 1)
goLeft (Ring (Join l _) _ _) amt = goLeft l (amt - 1)
goLeft (Join _ _) _ = error "Join is never current (goLeft)"

isRing (Ring _ _ _) = True
isRing _ = False

isJoin (Join _ _) = True
isJoin _ = False

findLeftOfJoin (Join l _) = l
findLeftOfJoin (Ring l _ _) = findLeftOfJoin l

findRightOfJoin (Join _ r) = r
findRightOfJoin (Ring _ _ r) = findRightOfJoin r
```