diff --git a/Data/Ix/Shapable.hs b/Data/Ix/Shapable.hs new file mode 100644 --- /dev/null +++ b/Data/Ix/Shapable.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE FlexibleInstances #-} +module Data.Ix.Shapable + ( Shapable(..) + , rank + , shape + , shapeToStride + , size + ) where + +import Data.Array.Base (numElements) +import Data.Array.IArray + +-- | Determine the rank of an array. +rank :: (Shapable i, Ix i, IArray a e) => a i e -> Int +rank = sRank . fst . bounds + +-- | Canonical representation of the shape. +-- The following properties hold: +-- 'length . shape = rank' +-- 'product . shape = size' +shape :: (Shapable i, Ix i, IArray a e) => a i e -> [Int] +shape = uncurry sShape . bounds + +-- | How much the offset changes when you move one element in the given +-- direction. Since arrays are in row-major order, 'last . shapeToStride = const 1' +shapeToStride :: [Int] -> [Int] +shapeToStride = scanr (*) 1 . tail + +-- | Number of elements in the Array. +size :: (Ix i, IArray a e) => a i e -> Int +size = numElements + +-- | We need this type class to distinguish between different tuples of Ix. +-- There are Shapable instances for homogenous Int tuples, but may Haddock +-- doesn't see them. +class Shapable i where + sRank :: i -> Int + sShape :: i -> i -> [Int] + sBounds :: [Int] -> (i,i) + +instance Shapable Int where + sRank _ = 1 + sShape a a' = [rangeSize (a,a')] + sBounds [a] = (0,a-1) + sBounds _ = error "sBounds expected list length 1" + +instance Shapable (Int,Int) where + sRank _ = 2 + sShape (a,b) (a',b') = [rangeSize (a,a'), rangeSize (b,b')] + sBounds [a,b] = ((0,0),(a-1,b-1)) + sBounds _ = error "sBounds expected list length 2" + +instance Shapable (Int,Int,Int) where + sRank _ = 3 + sShape (a,b,c) (a',b',c') = + [rangeSize (a,a'), rangeSize (b,b'), rangeSize (c,c')] + sBounds [a,b,c] = ((0,0,0),(a-1,b-1,c-1)) + sBounds _ = error "sBounds expected list length 3" + +instance Shapable (Int,Int,Int,Int) where + sRank _ = 4 + sShape (a,b,c,d) (a',b',c',d') = + [rangeSize (a,a'), rangeSize (b,b'), rangeSize (c,c'), rangeSize (d,d')] + sBounds [a,b,c,d] = ((0,0,0,0),(a-1,b-1,c-1,d-1)) + sBounds _ = error "sBounds expected list length 4" + +instance Shapable (Int,Int,Int,Int,Int) where + sRank _ = 5 + sShape (a,b,c,d,e) (a',b',c',d',e') = + [rangeSize (a,a'), rangeSize (b,b'), rangeSize (c,c'), rangeSize (d,d') + , rangeSize (e,e')] + sBounds [a,b,c,d,e] = ((0,0,0,0,0),(a-1,b-1,c-1,d-1,e-1)) + sBounds _ = error "sBounds expected list length 5" + +instance Shapable (Int,Int,Int,Int,Int,Int) where + sRank _ = 6 + sShape (a,b,c,d,e,f) (a',b',c',d',e',f') = + [rangeSize (a,a'), rangeSize (b,b'), rangeSize (c,c'), rangeSize (d,d') + , rangeSize (e,e'), rangeSize (f,f')] + sBounds [a,b,c,d,e,f] = ((0,0,0,0,0,0),(a-1,b-1,c-1,d-1,e-1,f-1)) + sBounds _ = error "sBounds expected list length 6" + +instance Shapable (Int,Int,Int,Int,Int,Int,Int) where + sRank _ = 7 + sShape (a,b,c,d,e,f,g) (a',b',c',d',e',f',g') = + [rangeSize (a,a'), rangeSize (b,b'), rangeSize (c,c'), rangeSize (d,d') + , rangeSize (e,e'), rangeSize (f,f'), rangeSize (g,g')] + sBounds [a,b,c,d,e,f,g] = ((0,0,0,0,0,0,0),(a-1,b-1,c-1,d-1,e-1,f-1,g-1)) + sBounds _ = error "sBounds expected list length 7" + +instance Shapable (Int,Int,Int,Int,Int,Int,Int,Int) where + sRank _ = 8 + sShape (a,b,c,d,e,f,g,h) (a',b',c',d',e',f',g',h') = + [rangeSize (a,a'), rangeSize (b,b'), rangeSize (c,c'), rangeSize (d,d') + , rangeSize (e,e'), rangeSize (f,f'), rangeSize (g,g'), rangeSize (h,h')] + sBounds [a,b,c,d,e,f,g,h] = ((0,0,0,0,0,0,0,0),(a-1,b-1,c-1,d-1,e-1,f-1,g-1,h-1)) + sBounds _ = error "sBounds expected list length 8" + +instance Shapable (Int,Int,Int,Int,Int,Int,Int,Int,Int) where + sRank _ = 9 + sShape (a,b,c,d,e,f,g,h,i) (a',b',c',d',e',f',g',h',i') = + [rangeSize (a,a'), rangeSize (b,b'), rangeSize (c,c'), rangeSize (d,d') + , rangeSize (e,e'), rangeSize (f,f'), rangeSize (g,g'), rangeSize (h,h') + , rangeSize (i,i')] + sBounds [a,b,c,d,e,f,g,h,i] = ((0,0,0,0,0,0,0,0,0) + ,(a-1,b-1,c-1,d-1,e-1,f-1,g-1,h-1,i-1)) + sBounds _ = error "sBounds expected list length 9" + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2008 Jed Brown + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/ix-shapable.cabal b/ix-shapable.cabal new file mode 100644 --- /dev/null +++ b/ix-shapable.cabal @@ -0,0 +1,26 @@ +Name: ix-shapable +Version: 0.1.0 +Synopsis: Reshape multi-dimensional arrays. +Description: Reshape multi-dimensional arrays. + . + Provides the 'Shapable' class, respresenting those + instances of 'Ix' that provide to arrays indexing + that is isomorphic to that of C-style + multi-dimensional arrays. + . + Factored out of the 'carray' library with the kind + permission of its author. + +Category: Data +License: BSD3 +License-File: LICENSE +Author: Jed Brown +Maintainer: Tracy Wadleigh +Stability: Experimental +Cabal-Version: >= 1.2 +Build-Type: Simple + +Library + Exposed-Modules: Data.Ix.Shapable + Build-Depends: base, array + Ghc-Options: -Wall