1 {-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
    2 module Array where
    3 
    4 -- Some preliminaries (for stronger type checking)
    5 newtype Index = Index {unIndex :: Int} 
    6   deriving (Num, Eq, ArrayElem, Ord, Enum)
    7 
    8 newtype Size  = Size  {unSize  :: Int} 
    9   deriving (Num, Eq, ArrayElem)
   10 
   11 toIndex  :: Size -> Index
   12 toIndex (Size n) = Index n
   13 
   14 maxIndex :: Size -> Index
   15 maxIndex n = toIndex n - 1
   16 
   17 toSize :: Index -> Size
   18 toSize (Index i) = Size i
   19 
   20 {- A type family is like a function on the type level where you
   21 can pattern match on the type arguments. An important difference
   22 is that it's /open/ which means that you can add more equations
   23 to the function at any time.
   24 
   25 In this example we will implement a type family of "efficient"
   26 array implementations.
   27 
   28 Type families are often used as "associated types" - a type
   29 member in a class, much like the class methods are function
   30 members of the class.  
   31 -}
   32 
   33 -- The type signature for our family / associated datatype
   34 data family Array a
   35 -- The "family members" will be arrays of ints, pairs, and nested
   36 -- arrays.
   37 
   38 -- | A class of operations on the array family. We'll make one
   39 --   instance per clause in the definition of the family.
   40 class ArrayElem a where
   41   (!)      :: Array a -> Index -> a
   42   -- | @slice a (i,n)@ is the slice of @a@ starting at 
   43   --   index @i@ with @n@ elements.
   44   slice    :: Array a -> (Index, Size) -> Array a
   45   size     :: Array a -> Size
   46   fromList :: [a] -> Array a
   47 
   48 -- | Converting an array to a list.
   49 toList :: ArrayElem a => Array a -> [a]
   50 toList a = [ a ! i | i <- [0..maxIndex (size a)] ]
   51 
   52 ----------------
   53 -- * Int arrays. 
   54 -- | We cheat with the implementation of Int arrays to make
   55 -- implementations of the functions easy.
   56 type SuperEfficientByteArray = [Int] -- cheating
   57 newtype instance Array Int   = ArrInt SuperEfficientByteArray 
   58 
   59 -- | Here is a style of instance declaration which just binds
   60 -- names and delegates all the work to helper functions. This
   61 -- style makes the types of the instatiated member functions
   62 -- more visible which can help in documenting and developing the
   63 -- code. (Haskell does not allow type signatures in instance
   64 -- declarations.)
   65 instance ArrayElem Int where
   66   (!)      = indexInt
   67   slice    = sliceInt
   68   size     = sizeInt
   69   fromList = fromListInt
   70 
   71 indexInt :: Array Int -> Index -> Int
   72 indexInt (ArrInt a) (Index i) = a !! i
   73 
   74 sliceInt :: Array Int -> (Index, Size) -> Array Int
   75 sliceInt (ArrInt a) (Index i, Size n) =
   76     ArrInt (take n (drop i a))
   77 
   78 sizeInt  :: Array Int -> Size
   79 sizeInt (ArrInt a) = Size (length a)
   80 
   81 fromListInt :: [Int] -> Array Int
   82 fromListInt = ArrInt
   83 
   84 ----------------
   85 -- Arrays of Sizes or Indices are just the same as arrays of ints
   86 newtype instance Array Size  = ArrSize  (Array Int)
   87 newtype instance Array Index = ArrIndex (Array Int)
   88 -- instance declarations are derived at the definition of Size and
   89 -- Index
   90 
   91 ----------------
   92 -- | Arrays of pairs are pairs of arrays. Mostly just lifting
   93 -- the operations to work on pairs.
   94 newtype instance Array (a, b) = ArrPair (Array a, Array b)
   95 
   96 {-
   97 
   98 -- This is a working and short definition, which may be
   99 -- preferrable as the end result, but which may be difficult to
  100 -- read and understand if you are not used to Haskell.
  101 
  102 instance (ArrayElem a, ArrayElem b) => ArrayElem (a, b) where
  103   ArrPair (as, bs) ! i = (as ! i, bs ! i)
  104 
  105   slice (ArrPair (as, bs)) (i, n) =
  106     ArrPair (slice as (i, n), slice bs (i, n))
  107 
  108   size (ArrPair (as, _)) = size as
  109 
  110   fromList xs = ArrPair (fromList as, fromList bs)
  111     where (as, bs) = unzip xs
  112 -}
  113 
  114 -- | This is the expanded version showing all the types
  115 instance (ArrayElem a, ArrayElem b) => ArrayElem (a, b) where
  116   (!)      = indexPair
  117   slice    = slicePair
  118   size     = sizePair
  119   fromList = fromListPair
  120 
  121 indexPair :: (ArrayElem a, ArrayElem b) => 
  122   Array (a, b) -> Index -> (a, b)
  123 indexPair (ArrPair (as, bs)) i = (as ! i, bs ! i)
  124 
  125 slicePair :: (ArrayElem a, ArrayElem b) =>
  126   Array (a, b) -> (Index, Size) -> Array (a, b)
  127 slicePair (ArrPair (as, bs)) (i, n) =
  128   ArrPair (slice as (i, n), slice bs (i, n))
  129 
  130 sizePair :: ArrayElem a => Array (a, b) -> Size
  131 sizePair (ArrPair (as, _)) = size as
  132 
  133 fromListPair :: (ArrayElem a, ArrayElem b) => 
  134   [(a, b)] -> Array (a, b)
  135 fromListPair xs = ArrPair (fromList as, fromList bs)
  136     where (as, bs) = unzip xs
  137 
  138 -- | Nested arrays. Here we have to work a little bit.  A nested
  139 -- array is implemented as a flat array together with an array
  140 -- of offsets (indices) and sizes of the subarrays.
  141 data instance Array (Array a) = ArrNested (Array a) 
  142                                           (Array (Index, Size))
  143 
  144 -- Exercise: what invariant must hold for this to work?
  145 -- Implement a property checking it.
  146 
  147 instance ArrayElem a => ArrayElem (Array a) where
  148   (!)      = indexNested
  149   slice    = sliceNested
  150   size     = sizeNested
  151   fromList = fromListNested
  152 
  153 -- Indexing is just slicing the flat array.
  154 indexNested :: (ArrayElem a) => 
  155   Array (Array a) -> Index -> Array a
  156 indexNested (ArrNested as segs) i = slice as (segs ! i)
  157 
  158 -- | Slicing is slicing the flat array and the segment array,
  159 -- but we have to do some work to figure out how to slice the
  160 -- flat array.
  161 sliceNested :: (ArrayElem a) =>
  162   Array (Array a) -> (Index, Size) -> Array (Array a)
  163 sliceNested (ArrNested as segs) (i, n) =
  164   ArrNested (slice as   (j, m)) 
  165             (fixInvariant $ slice segs (i, n))
  166   where
  167     fixInvariant = fromList . map (mapFst ((-j)+)) . toList
  168     (j, _) = segs ! i
  169     m      = sum [ snd (segs ! k) -- second components store sizes
  170                  | k <- [i..n'-1] ]
  171     n' = min (i+toIndex n) (toIndex $ size segs) 
  172          -- don't look too far
  173 -- Exercise: Refactor to avoid summing - something like 
  174 --    m' = toSize (fst (segs ! (i + toIndex n))  - j)
  175 
  176 mapFst :: (a->a') -> (a, b) -> (a', b)
  177 mapFst       f       (a, b) = (f a, b)
  178          
  179 
  180 sizeNested :: Array (Array a) -> Size
  181 sizeNested (ArrNested _ segs) = size segs
  182 
  183 -- Creating the flat array isn't very nicely done. We shouldn't
  184 -- have to convert our arrays back to lists to do it.  Solution
  185 -- (exercise): add a concatenation operation on arrays.
  186 fromListNested :: (ArrayElem a) => [Array a] -> Array (Array a)
  187 fromListNested xss = 
  188     ArrNested (fromList $ concatMap toList xss) -- Bad!
  189               (fromList $ tail $ scanl seg (0,0) xss)
  190   where seg (i, n) a = (i + toIndex n, size a)
  191 
  192 ----------------------------------------------------------------
  193 
  194 instance Show Size  where 
  195   showsPrec p (Size n)  = showParen (p > 0) $
  196     showString "Size " . showsPrec 1 n
  197 instance Show Index where 
  198   showsPrec p (Index n) = showParen (p > 0) $
  199     showString "Index " . showsPrec 1 n