Pure fixed length queue

Question

I am modeling an infectious disease with a fixed incubation period. I chose a queue to keep track of when people become symptomatic. I imagined using some operations like so:

queue' = enqueue numberOfPeopleWhoJustGotInfected queue
(numberOfPeopleWhoJustBecameSymptomatic,queue'') = dequeue queue

Since enqueue and dequeue would always be atomic and the queue length would be fixed, I wrote a fixed length queue data structure. endequeue models the atomic enqueue & dequeue sequence. I hope that it will be more efficient than the library Data.Queue.

I'd like feedback on:

Efficiency. Can it be improved?
Typeclasses. Did I use them correctly? Am I missing others which are applicable?
Test Cases. Are there other logical properties I could add?

Haskell Code:

module FixedLengthQueue
 ( endequeue
 , fromList
 , length
 , peek
 ) where

import Prelude hiding (foldl,foldl1,foldr,foldr1,length)
import Control.Applicative ((<$>),(<*>))
import Data.Array
import Data.Foldable
import Data.Functor
import Data.Maybe  (fromJust)
import Data.Monoid

type Pointer = Int
type Length  = Int

data FixedLengthQueue a = FLQ Length Pointer (Array Int a)
  deriving (Eq) -- I need to manually define, see tests

instance (Show a) => Show (FixedLengthQueue a) where
  show = ("fromList "++) . show . toList

instance Functor FixedLengthQueue where
  fmap f =  fromJust . fromList . fmap f . toList

instance Foldable FixedLengthQueue where
  foldMap f (FLQ n p arr)
    =  f (arr ! p) <> g (succMod p n)
    where
      g z
        | z /= p    = f (arr ! z) <> g (succMod z n)
        | otherwise = mempty

fromList :: [a] -> Maybe (FixedLengthQueue a)
fromList [] = Nothing -- Nonsensical empty fixed length queue
fromList xs
  = Just
  . FLQ len 0
  . array (0, len-1)
  $ zip   [0..len-1] xs
  where
    len = foldl' inc 0 xs
    inc = flip (const succ)   

length :: FixedLengthQueue a -> Int
length (FLQ n _ _) = n

peek :: FixedLengthQueue a -> a
peek (FLQ _ p arr) = arr ! p

endequeue :: a -> FixedLengthQueue a -> (a,FixedLengthQueue a)
endequeue e (FLQ n p arr)
  = ( arr ! p
    , FLQ n (succMod p n) $ arr // [(p,e)]
    )

succMod n m
  | n' >= m   = n' - m
  | otherwise = n'
  where n' = succ n

Basic Tests:

module Main where

import Prelude hiding (mapM_)
import Data.Foldable
import FixedLengthQueue
import Test.QuickCheck
import Safe

main ::  IO ()
main =   
  mapM_ quickCheck              
  ([ \x -> fmap peek                                        (fromList x) == headMay x
   , \x -> fmap (fst . endequeue undefined)                 (fromList x) == headMay x
   , \x -> fmap (init . toList . snd . endequeue undefined) (fromList x) == tailMay x
   , \x -> let mxs = (replicate 2) <$> (headMay x) >>= fromList
           in (snd . (endequeue <$> peek <*> id) <$> mxs)                == mxs
   ] :: [[Int] -> Bool])

I've found using record syntax in the beginning to be helpful. That way, if you ever change any part of your type, you don't have to go through and change all of your pattern matching as well. — Carcigenicate
– Carcigenicate, Commented Dec 1, 2014 at 11:13
It usually is. The downside being, if you don't end up changing anything, your code is bloated to deal with records. — Carcigenicate
– Carcigenicate, Commented Dec 1, 2014 at 18:11

nponeccop · Accepted Answer · 2014-12-01 23:37:57Z

Your fmap function is overly complicated. Array x is a Functor and Length and Pointer are obviously preserved by fmap, so:

instance Functor FixedLengthQueue where
  fmap f (FLQ a b x) =  FLQ a b $ fmap f x

There is listArray :: Ix i => (i, i) -> [e] -> Array i e, so you don't need zipping.

foldl' inc 0 xs is just length xs:

fromList :: [a] -> Maybe (FixedLengthQueue a)
fromList [] = Nothing -- Nonsensical empty fixed length queue
fromList xs
  = Just
  . FLQ len 0
  . listArray (0, len-1)
  $ xs
  where
    len = Prelude.length xs

Note the qualified use of Prelude.length. You can use

import Prelude hiding (foldl,foldl1,foldr,foldr1); 
import qualified Prelude (length)

if you want length to always mean FixedLenghtQueue.length. Prelude.length will still be available.

Since all your internal arrays are 0-based, there is no need to store Length separately, it can be always retrieved by snd . bounds or rangeSize . bounds

Your FixedLengthQueue can be thought as a special array or a special list. So you can just construct the list or the array explicitly and use existing foldMap implementations. Here is code using innerArray approach:

instance Foldable FixedLengthQueue where
    foldMap f = foldMap f . innerArray where
        innerArray (FLQ l p a) = ixmap (bounds a) (mapIdx l p) a
        mapIdx l p i = (i + l - p) `mod` l

As for performance, you should benchmark your full application before optimization. Compositional style is not necessary worse performing so you should strive to write at as high level as possible before trying optimizations.

Also there is Data.Sequence which I think will perform better than Array while keeping you away from ST monad.

A useful typeclass instance to implement is Traversable. It is also cumbersome to implement as innerArray approach will work poorly:

instance Traversable FixedLengthQueue where
    traverse f = fmap fromArray . traverse f . innerArray where
        fromArray a = FLQ (rangeSize $ bounds a) 0 a

Interestingly, Prelude uses "innerList" approach - it converts an array to a list and back:

instance Ix i => Traversable (Array i) where
        traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)

So I think the best we can do with Traversable is to use "innerList" approach too:

instance Traversable FixedLengthQueue where
    traverse f = fmap (fromJust . fromList) . traverse f . toList

Here is an Eq instance:

instance (Eq a) => Eq (FixedLengthQueue a) where
    (FLQ l1 _ _) == (FLQ l2 _ _) | l1 /= l2 = False
    q1 == q2 = toList q1 == toList q2

Here is another approach to implement toList:

indexList p l = range (p, l - 1) ++ range (0, p - 1)

toList' (FLQ l p a) = map (a !) $ indexList p l

I'm not sure that it's much better though, but the idea can be used everywhere:

eq (FLQ l1 p1 a1) (FLQ l2 p2 a2) = l1 == l2 && comp where
    r1 = indexList p1 l1
    r2 = indexList p2 l2
    comp = Prelude.all (\(i1, i2) -> (a1 ! i1) == (a2 ! i2)) $ zip r1 r2

foldl' inc 0 xs is necessary to avoid name conflicts with Prelude.length. — recursion.ninja
– recursion.ninja, Commented Dec 1, 2014 at 21:14
Thanks for all the wonderful feedback! I'm going to wait a few days before accepting the answer in the hope that it being unaccepted might attract another reviewer. — recursion.ninja
– recursion.ninja, Commented Dec 1, 2014 at 23:10

Stack Exchange Network

Pure fixed length queue

1 Answer 1

You must log in to answer this question.

Hot Network Questions

Pure fixed length queue

1 Answer 1

You must log in to answer this question.

Related

Hot Network Questions