diff --git a/mnist-idx.cabal b/mnist-idx.cabal --- a/mnist-idx.cabal +++ b/mnist-idx.cabal @@ -1,6 +1,6 @@ name: mnist-idx -version: 0.1.2.8 +version: 0.1.3.0 -- A short (one-line) description of the package. synopsis: Read and write IDX data that is used in e.g. the MNIST database. @@ -11,7 +11,7 @@ like the MNIST handwritten digit database. -- URL for the project homepage or repository. -homepage: https://github.com/kryoxide/mnist-idx/ +homepage: https://christof-schramm.net -- The license under which the package is released. license: LGPL-3 @@ -24,7 +24,7 @@ -- An email address to which users can send suggestions, bug reports, and -- patches. -maintainer: christof.schramm@campus.lmu.de +maintainer: blog@christof-schramm.net -- A copyright notice. -- copyright: @@ -42,7 +42,7 @@ source-repository head type: git - location: https://github.com/kryoxide/mnist-idx/ + location: https://github.com/schrammc/mnist-idx/ library -- Modules exported by the library. @@ -56,11 +56,10 @@ -- other-extensions: -- Other library packages from which modules are imported. - default-language: Haskell2010 build-depends: base >=4.6 && <5, binary >= 0.7 && < 0.9, vector >= 0.10 && < 0.13, - bytestring >= 0.10 && < 0.11 + bytestring >= 0.10 && < 0.12 -- Directories containing source files. hs-source-dirs: src @@ -80,4 +79,7 @@ , vector >= 0.10 && < 0.13 , binary >= 0.7 && < 0.9 , directory >= 1.2 && < 1.4 + , QuickCheck>= 2.12 && < 3 , mnist-idx + + default-language: Haskell2010 diff --git a/src/Data/IDX.hs b/src/Data/IDX.hs --- a/src/Data/IDX.hs +++ b/src/Data/IDX.hs @@ -25,11 +25,15 @@ , isIDXReal , isIDXIntegral - -- * Raw data + -- ** Raw data , idxDoubleContent , idxIntContent - -- * Labeled data + -- ** Partitioned data + , partitionedDoubleData + , partitionedIntData + + -- ** Labeled data , labeledIntData , labeledDoubleData @@ -71,33 +75,34 @@ import Data.Word -- | Partition a dataset and label each subpartition, return int values -labeledIntData:: IDXLabels -> IDXData -> Maybe [(Int, V.Vector Int)] +labeledIntData :: IDXLabels -> IDXData -> Maybe [(Int, V.Vector Int)] labeledIntData (IDXLabels v) dat = - if (V.length v) == dim0 - then Just $ do - i <- [0 .. dim0 - 1] - let lab = v ! i - return $ (lab,V.slice (i*entrySize) entrySize content) + if V.length v == length partitionedData + then Just $ zip (V.toList v) partitionedData else Nothing where - dim0 = (idxDimensions dat) ! 0 - content = idxIntContent dat - entrySize = (V.product $ idxDimensions dat) `div` dim0 + partitionedData = partitionedIntData dat -- | Partition a dataset and label each subpartition, return double values -labeledDoubleData:: IDXLabels -> IDXData -> Maybe [(Int, V.Vector Double)] +labeledDoubleData :: IDXLabels -> IDXData -> Maybe [(Int, V.Vector Double)] labeledDoubleData (IDXLabels v) dat = - if (V.length v) == dim0 - then Just $ do - i <- [0 .. dim0 - 1] - let lab = v ! i - return $ (lab,V.slice (i*entrySize) entrySize content) + if V.length v == length partitionedData + then Just $ zip (V.toList v) partitionedData else Nothing where - dim0 = (idxDimensions dat) ! 0 - content = idxDoubleContent dat - entrySize = (V.product $ idxDimensions dat) `div` dim0 + partitionedData = partitionedDoubleData dat +-- | Partition a dataset along the first dimension. If the data set contains +-- images this means splitting the dataset up into a list of images where each +-- 'Double' represents one pixel. +partitionedDoubleData :: IDXData -> [V.Vector Double] +partitionedDoubleData = partitionedData idxDoubleContent + +-- | Partition a dataset along the first dimension. If the data set contains +-- images this means splitting the dataset up into a list of images where each +-- 'Int' represents one pixel. +partitionedIntData :: IDXData -> [V.Vector Int] +partitionedIntData = partitionedData idxIntContent -- | Read labels from a file, return 'Nothing' if something doesn't work decodeIDXLabelsFile :: FilePath -> IO (Maybe IDXLabels) diff --git a/src/Data/IDX/Internal.hs b/src/Data/IDX/Internal.hs --- a/src/Data/IDX/Internal.hs +++ b/src/Data/IDX/Internal.hs @@ -33,7 +33,7 @@ IDXInt :: IDXContentType IDXFloat :: IDXContentType IDXDouble :: IDXContentType - deriving Show + deriving (Show, Eq) instance Binary IDXContentType where get = do @@ -59,7 +59,7 @@ -- is used, the data is serialized according to the 'IDXContentType'. data IDXData = IDXInts IDXContentType (V.Vector Int) (V.Vector Int ) | IDXDoubles IDXContentType (V.Vector Int) (V.Vector Double) - deriving Show + deriving (Show, Eq) instance Binary IDXData where @@ -236,3 +236,14 @@ putReal :: IDXContentType -> Double -> Put putReal IDXDouble n = put n putReal IDXFloat n = put $! (realToFrac n :: Float ) + +-- | Split data by the first dimension of the C-Array. This would e.g. split a +-- data-set of images into a list of data representing an individual image +partitionedData :: V.Unbox a => (IDXData -> V.Vector a) -> IDXData -> [V.Vector a] +partitionedData getContent idxData = do + i <- [0 .. dim0 - 1] + return $ (V.slice (i*entrySize) entrySize content) + where + dim0 = V.head $ idxDimensions idxData + content = getContent idxData + entrySize = (V.product $ idxDimensions idxData) `div` dim0 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,27 +1,60 @@ +{-# LANGUAGE ScopedTypeVariables #-} module Main where -import Test.Hspec import Data.IDX import Data.IDX.Internal +import Control.Monad import qualified Data.Vector.Unboxed as V +import System.Directory +import System.IO +import Test.Hspec +import Test.QuickCheck +import qualified Data.Binary as Binary -import System.Directory -import System.IO +dataList :: [Int] dataList = [1,2,3,4] +testData :: IDXData testData = IDXInts IDXUnsignedByte dims values where dims = V.fromList [2,2] values = V.fromList dataList +testLabels :: IDXLabels testLabels = IDXLabels $ V.fromList [0,1] +instance Arbitrary IDXContentType where + arbitrary = elements [IDXInt, IDXDouble] + +instance Arbitrary IDXData where + arbitrary = do + typ <- arbitrary :: Gen IDXContentType + numberOfDimensions <- choose (1, 5) :: Gen Int + dimensionSizes <- V.fromList <$> replicateM numberOfDimensions (choose (1, 10)) + case typ of + IDXInt -> + IDXInts typ dimensionSizes . V.fromList + <$> replicateM (product $ V.toList dimensionSizes) arbitrary + IDXDouble -> + IDXDoubles typ dimensionSizes . V.fromList + <$> replicateM (product $ V.toList dimensionSizes) arbitrary + _ -> error "This shouldn't happen" + spec :: Spec spec = do describe "IDX dataset" $ do + it "Binary serialization roundtrips" $ + property $ \(idxData :: IDXData) -> Binary.decode (Binary.encode idxData) == idxData + + it "Partitioning the dataset and concatenating partitions is identical (double)" $ + property $ \(idxData :: IDXData) -> mconcat (partitionedDoubleData idxData) == idxDoubleContent idxData + + it "Partitioning the dataset and concatenating partitions is identical (int)" $ + property $ \(idxData :: IDXData) -> mconcat (partitionedIntData idxData) == idxIntContent idxData + it "should be created and deserialized correctly" $ do -- Get temporary directory