diff --git a/Data/NetCDF.hs b/Data/NetCDF.hs --- a/Data/NetCDF.hs +++ b/Data/NetCDF.hs @@ -237,7 +237,7 @@ readAttr' nc var n l NcAttrDouble nc_get_att_double -- | Helper function for attribute reading. -readAttr' :: Show a => Int -> Int -> String -> Int -> ([a] -> NcAttr) +readAttr' :: Int -> Int -> String -> Int -> ([a] -> NcAttr) -> (Int -> Int -> String -> Int -> IO (Int, [a])) -> Access NcAttr readAttr' nc var n l w rf = chk $ do tmp <- rf nc var n l diff --git a/Data/NetCDF/HMatrix.hs b/Data/NetCDF/HMatrix.hs deleted file mode 100644 --- a/Data/NetCDF/HMatrix.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE FlexibleInstances, ConstraintKinds, TypeFamilies #-} -{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, GADTs #-} -{-# OPTIONS_GHC -fno-warn-orphans -fwarn-missing-methods #-} --- | NetCDF store instance for HMatrix vectors and matrices. -module Data.NetCDF.HMatrix - ( HVector (..) - , HMatrix (..) - ) where - -import Data.NetCDF.Store - -import qualified Numeric.Container as C -import qualified Numeric.LinearAlgebra.Util as C -import Foreign.C -import Data.Packed.Vector -import Data.Packed.Development - -newtype HVector a = HVector (C.Vector a) - deriving (Eq, Show) - -instance NcStore HVector where - type NcStoreExtraCon HVector a = C.Element a - toForeignPtr (HVector v) = fst3 $ unsafeToForeignPtr v - fromForeignPtr p s = HVector $ unsafeFromForeignPtr p 0 (Prelude.product s) - smap f (HVector v) = HVector $ C.mapVector f v - -data HMatrix a = HMatrix (C.Matrix a) - -instance NcStore HMatrix where - type NcStoreExtraCon HMatrix a = C.Element a - toForeignPtr (HMatrix m) = fst3 $ unsafeToForeignPtr $ C.flatten m - fromForeignPtr p s = - let c = last s - d = product s - in HMatrix $ matrixFromVector RowMajor (d `div` c) (last s) $ - unsafeFromForeignPtr p 0 (Prelude.product s) - smap f (HMatrix m) = HMatrix $ C.mapMatrix f m - -instance C.Element CShort -instance C.Element CInt -instance C.Element CFloat -instance C.Element CDouble - -instance C.Container C.Vector CFloat -instance C.Container C.Vector CDouble - -instance C.Indexable (C.Vector CFloat) CFloat where (!) = (@>) -instance C.Indexable (C.Vector CDouble) CDouble where (!) = (@>) - -fst3 :: (a, b, c) -> a -fst3 (x, _, _) = x diff --git a/Data/NetCDF/PutGet.hs b/Data/NetCDF/PutGet.hs --- a/Data/NetCDF/PutGet.hs +++ b/Data/NetCDF/PutGet.hs @@ -109,5 +109,5 @@ -- | Helper function for dealing with size (start, count, stride) -- arrays. -withSizeArray :: (Storable a, Integral a) => [a] -> (Ptr CULong -> IO b) -> IO b +withSizeArray :: Integral a => [a] -> (Ptr CULong -> IO b) -> IO b withSizeArray = withArray . liftM fromIntegral diff --git a/Data/NetCDF/Raw/Attributes.chs b/Data/NetCDF/Raw/Attributes.chs --- a/Data/NetCDF/Raw/Attributes.chs +++ b/Data/NetCDF/Raw/Attributes.chs @@ -5,6 +5,7 @@ module Data.NetCDF.Raw.Attributes where import Data.Char +import Data.Word import Data.NetCDF.Raw.Utils @@ -17,10 +18,9 @@ -- int nc_put_att_text(int ncid, int varid, const char *name, -- size_t len, const char *op); nc_put_att_text :: Int -> Int -> String -> Int -> String -> IO Int -nc_put_att_text nc var name xtype v = do +nc_put_att_text nc var name _ v = do let ncid = fromIntegral nc varid = fromIntegral var - ncxtype = fromIntegral xtype ncsize = fromIntegral $ length v let tv = map convChar v withCString name $ \namep -> do @@ -34,7 +34,7 @@ nc_put_att_text'_ :: CInt -> CInt -> CString -> CULong -> Ptr CChar -> IO CInt -nc_put_att :: (Storable a, Storable b, Show b) => +nc_put_att :: Storable b => (CInt -> CInt -> CString -> CInt -> CULong -> Ptr b -> IO CInt) -> (a -> b) -> Int -> Int -> String -> Int -> [a] -> IO Int nc_put_att cfn conv nc var name xtype v = do @@ -171,7 +171,7 @@ {#fun nc_del_att { `Int', `Int', `String' } -> `Int' #} -nc_get_att :: (Storable a, Storable b) => +nc_get_att :: Storable a => (CInt -> CInt -> CString -> Ptr a -> IO CInt) -> (a -> b) -> Int -> Int -> String -> Int -> IO (Int, [b]) nc_get_att cfn conv nc var name cnt = do diff --git a/Data/NetCDF/Raw/Utils.hs b/Data/NetCDF/Raw/Utils.hs --- a/Data/NetCDF/Raw/Utils.hs +++ b/Data/NetCDF/Raw/Utils.hs @@ -4,14 +4,20 @@ module Data.NetCDF.Raw.Utils ( module Data.NetCDF.Raw.Utils - , module Foreign , module Foreign.C + , module Foreign.Ptr + , module Foreign.Storable + , module Foreign.Marshal.Array + , module Foreign.Marshal.Alloc , unsafePerformIO ) where import Control.Monad (liftM) -import Foreign hiding (unsafePerformIO) import Foreign.C +import Foreign.Ptr +import Foreign.Storable +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc import System.IO.Unsafe (unsafePerformIO) ncMaxName, ncMaxDims, ncMaxVars, ncMaxAttrs, ncMaxVarDims :: Int @@ -30,17 +36,17 @@ peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b peekFloatConv = liftM realToFrac . peek -withIntArray :: (Storable a, Integral a) => [a] -> (Ptr CInt -> IO b) -> IO b +withIntArray :: Integral a => [a] -> (Ptr CInt -> IO b) -> IO b withIntArray = withArray . liftM fromIntegral -withIntPtrConv :: (Storable a, Storable b, Integral a, Integral b) +withIntPtrConv :: (Storable b, Integral a, Integral b) => a -> (Ptr b -> IO c) -> IO c withIntPtrConv val f = alloca $ \ptr -> do poke ptr (fromIntegral val) f ptr -withFloatPtrConv :: (Storable a, Storable b, RealFloat a, RealFloat b) +withFloatPtrConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c withFloatPtrConv val f = alloca $ \ptr -> do diff --git a/Data/NetCDF/Store.hs b/Data/NetCDF/Store.hs --- a/Data/NetCDF/Store.hs +++ b/Data/NetCDF/Store.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, ConstraintKinds, TypeFamilies #-} +{-# LANGUAGE ConstraintKinds, TypeFamilies #-} -- | The /store polymorphism/ for the functions to get the values of -- NetCDF variables relies on a simple `NcStore` typeclass for -- converting between /store/ values and @ForeignPtr@s. diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,6 +1,8 @@ hnetcdf ======= +[![Build Status](https://travis-ci.org/ian-ross/hnetcdf.svg?branch=master)](https://travis-ci.org/ian-ross/hnetcdf) + Haskell NetCDF library: as well as conventional low-level FFI bindings to the functions in the NetCDF library (in the `Data.NetCDF.Raw` modules), `hnetcdf` provides a higher-level Haskell interface diff --git a/examples/example1.hs b/examples/example1.hs --- a/examples/example1.hs +++ b/examples/example1.hs @@ -55,7 +55,7 @@ Right slice1tmp <- getA nc zvar [0, 0, 0] [1, nlat, nlon] :: SVRet CShort let slice1 = SV.map (/ 9.8) $ coardsScale zvar slice1tmp :: SV.Vector CDouble putStrLn $ "length slice1 = " ++ show (length slice1) - let idx i j = (nlat - i) * nlon + (j - 1) + let idx i j = (nlat - j) * nlon + (i - 1) putStrLn $ "lon(i=25) = " ++ show (lon SV.! (25 - 1)) putStrLn $ "lat(j=40) = " ++ show (lat SV.! (nlat - 40)) putStrLn $ "slice1(i=25,j=40) = " ++ show (slice1 SV.! idx 25 40) diff --git a/examples/example3.hs b/examples/example3.hs deleted file mode 100644 --- a/examples/example3.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Main where - -import Prelude hiding (length, sum) -import Control.Applicative ((<$>)) -import Data.NetCDF -import Data.NetCDF.HMatrix -import qualified Data.Map as M -import Foreign.C -import Foreign.Storable -import Numeric.Container - -type VRet a = IO (Either NcError (HVector a)) -type MRet a = IO (Either NcError (HMatrix a)) - -main :: IO () -main = do - -- Open file and access some basic metadata. - Right nc <- openFile "z500-short.nc" - putStrLn $ "Name: " ++ ncName nc - putStrLn $ "Dims: " ++ show (M.keys $ ncDims nc) - putStr $ unlines $ map (\(n, s) -> " " ++ n ++ ": " ++ s) $ - M.toList $ flip M.map (ncDims nc) $ - \d -> show (ncDimLength d) ++ if ncDimUnlimited d then " (UNLIM)" else "" - putStrLn $ "Vars: " ++ show (M.keys $ ncVars nc) - putStrLn $ "Global attributes: " ++ show (M.keys $ ncAttrs nc) - - -- Get dimension sizes. - let Just ntime = ncDimLength <$> ncDim nc "time" - Just nlat = ncDimLength <$> ncDim nc "latitude" - Just nlon = ncDimLength <$> ncDim nc "longitude" - - -- Get longitude variable: metadata, then all values, then a slice - -- of values. - let (Just lonvar) = ncVar nc "longitude" - Right (HVector lon) <- get nc lonvar :: VRet CFloat - let mlon = mean lon - putStrLn $ "longitude: " ++ show lon ++ " -> " ++ show mlon - Right (HVector lon2) <- getS nc lonvar [0] [72] [2] :: VRet CFloat - let mlon2 = mean lon2 - putStrLn $ "longitude (every 2): " ++ show lon2 ++ " -> " ++ show mlon2 - - -- Get latitude variable: metadata, then all values, then a slice of - -- values. - let (Just latvar) = ncVar nc "latitude" - Right (HVector lat) <- get nc latvar :: VRet CFloat - let mlat = mean lat - putStrLn $ "latitude: " ++ show lat ++ " -> " ++ show mlat - Right (HVector lat2) <- getS nc latvar [0] [37] [2] :: VRet CFloat - let mlat2 = mean lat2 - putStrLn $ "latitude (every 2): " ++ show lat2 ++ " -> " ++ show mlat2 - - -- Get Z500 variable: get a slice, do COARDS short -> double - -- scaling, convert units. - let (Just zvar) = ncVar nc "z500" - putStrLn $ "z500 dims: " ++ show (map ncDimName $ ncVarDims zvar) - Right slice1tmp <- - getA nc zvar [0, 0, 0] [1, nlat, nlon] :: MRet CShort - let (HMatrix slice1tmp2) = coardsScale zvar slice1tmp :: HMatrix CDouble - slice1 = cmap ((/ 9.8) . realToFrac) slice1tmp2 :: Matrix Double - putStrLn $ "size slice1 = " ++ - show (rows slice1) ++ " x " ++ show (cols slice1) - putStrLn $ "lon(i=25) = " ++ show (lon @> (25 - 1)) - putStrLn $ "lat(j=40) = " ++ show (lat @> (nlat - 40)) - let v @!! (i, j) = v @@> (nlat - i, j - 1) - putStrLn $ "slice1(i=25,j=40) = " ++ show (slice1 @!! (25, 40)) - -mean :: (Storable a, Fractional a) => Vector a -> a -mean xs = (foldVector (+) 0 xs) / fromIntegral (dim xs) diff --git a/hnetcdf.cabal b/hnetcdf.cabal --- a/hnetcdf.cabal +++ b/hnetcdf.cabal @@ -1,178 +1,161 @@ -name: hnetcdf -version: 0.3.0.0 -synopsis: Haskell NetCDF library +name: hnetcdf +version: 0.4.0.0 +cabal-version: >=1.8 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: Copyright (2013) Ian Ross +maintainer: ian@skybluetrades.net +homepage: https://github.com/ian-ross/hnetcdf +synopsis: Haskell NetCDF library description: - Bindings to the Unidata NetCDF library, along with a higher-level - Haskell interface that attempts to provide container polymorphic - data access (initially just Storable vectors and Repa arrays). -license: BSD3 -license-file: LICENSE -author: Ian Ross -maintainer: ian@skybluetrades.net -copyright: Copyright (2013) Ian Ross -category: Data -build-type: Simple -extra-source-files: README.markdown CHANGELOG.markdown -cabal-version: >=1.8 -homepage: https://github.com/ian-ross/hnetcdf -data-files: test/tst-raw-get-put.nc test/tst-bathymetry.nc + Bindings to the Unidata NetCDF library, along with a higher-level + Haskell interface that attempts to provide container polymorphic + data access (initially just Storable vectors and Repa arrays). +category: Data +author: Ian Ross +data-files: + test/tst-raw-get-put.nc + test/tst-bathymetry.nc +extra-source-files: + README.markdown + CHANGELOG.markdown source-repository head - type: git - location: https://github.com/ian-ross/hnetcdf - - -Library - exposed-modules: Data.NetCDF - Data.NetCDF.Vector - Data.NetCDF.Repa - Data.NetCDF.HMatrix - Data.NetCDF.Metadata - Data.NetCDF.PutGet - Data.NetCDF.Storable - Data.NetCDF.Store - Data.NetCDF.Types - Data.NetCDF.Utils - Data.NetCDF.Raw - Data.NetCDF.Raw.Base - Data.NetCDF.Raw.PutGet - Data.NetCDF.Raw.Attributes - Data.NetCDF.Raw.Utils --- Data.NetCDF.Raw.NetCDF4 - build-depends: base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - either >= 3.4.1 && < 5, - errors >= 1.4.2 && < 1.5, - filepath >= 1.3 && < 1.4, - hmatrix >= 0.16.0.2 && < 0.17, - repa, - transformers >= 0.2 && < 0.5, - vector >= 0.9 && < 0.11 - build-tools: c2hs - extra-libraries: netcdf - ghc-options: -Wall - -Test-Suite test-raw-metadata - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: test-raw-metadata.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - vector >= 0.9 && < 0.11, - repa, - test-framework >= 0.3, - test-framework-hunit, - test-framework-quickcheck2 >= 0.3, - HUnit, - QuickCheck - extra-libraries: netcdf - -Test-Suite test-raw-get-put - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: test-raw-get-put.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - vector >= 0.9 && < 0.11, - repa, - directory >= 1.1 && < 1.3, - test-framework >= 0.3, - test-framework-hunit, - test-framework-quickcheck2 >= 0.3, - HUnit, - QuickCheck - extra-libraries: netcdf - -Test-Suite test-raw-attributes - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: test-raw-attributes.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - vector >= 0.9 && < 0.11, - repa, - directory >= 1.1 && < 1.3, - test-framework >= 0.3, - test-framework-hunit, - test-framework-quickcheck2 >= 0.3, - HUnit, - QuickCheck - extra-libraries: netcdf - -Test-Suite test-get - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: test-get.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - errors >= 1.4.2 && < 1.5, - hmatrix >= 0.16.0.2 && < 0.17, - repa, - vector >= 0.9 && < 0.11, - directory >= 1.1 && < 1.3, - test-framework >= 0.3, - test-framework-hunit, - test-framework-quickcheck2 >= 0.3, - HUnit, - QuickCheck - extra-libraries: netcdf - -Test-Suite test-put - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: test-put.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - errors >= 1.4.2 && < 1.5, - vector >= 0.9 && < 0.11, - directory >= 1.1 && < 1.3 - extra-libraries: netcdf + type: git + location: https://github.com/ian-ross/hnetcdf -Test-Suite test-hmatrix - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: test-hmatrix.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - errors >= 1.4.2 && < 1.5, - vector >= 0.9 && < 0.11, - directory >= 1.1 && < 1.3, - hmatrix >= 0.16.0.2 && < 0.17, - test-framework >= 0.3, - test-framework-hunit, - test-framework-quickcheck2 >= 0.3, - HUnit, - QuickCheck - extra-libraries: netcdf +library + build-depends: + base >= 4.3 && <5, + containers >= 0.5.0.0 && <0.6, + either >= 4.4 && <4.5, + errors >= 2.0 && <2.2, + filepath >= 1.4 && <1.5, + repa >= 3.4 && <3.5, + transformers >= 0.2 && <0.6, + vector >= 0.10.9 && <0.12 + exposed-modules: + Data.NetCDF + Data.NetCDF.Vector + Data.NetCDF.Repa + Data.NetCDF.Metadata + Data.NetCDF.PutGet + Data.NetCDF.Storable + Data.NetCDF.Store + Data.NetCDF.Types + Data.NetCDF.Utils + Data.NetCDF.Raw + Data.NetCDF.Raw.Base + Data.NetCDF.Raw.PutGet + Data.NetCDF.Raw.Attributes + Data.NetCDF.Raw.Utils + build-tools: c2hs -any + extra-libraries: + netcdf + ghc-options: -Wall -Executable example1 - hs-source-dirs: examples - main-is: example1.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - vector >= 0.9 && < 0.11 +executable example1 + build-depends: + hnetcdf -any, + base >= 4.3 && <5, + containers, + vector + main-is: example1.hs + hs-source-dirs: examples -Executable example2 - hs-source-dirs: examples - main-is: example2.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - vector >= 0.9 && < 0.11, - repa +executable example2 + build-depends: + hnetcdf -any, + base >= 4.3 && <5, + containers, + vector, + repa + main-is: example2.hs + hs-source-dirs: examples -Executable example3 - hs-source-dirs: examples - main-is: example3.hs - build-depends: hnetcdf, - base >= 4.3 && < 5, - containers >= 0.4 && < 0.6, - vector >= 0.9 && < 0.11, - hmatrix +test-suite test-raw-metadata + build-depends: + hnetcdf -any, + base >= 4.3 && <5, + containers, + vector, + repa, + test-framework >= 0.8 && <0.9, + test-framework-hunit >= 0.3 && <0.4, + test-framework-quickcheck2 >= 0.3 && <0.4, + HUnit >= 1.2.5.2 && <1.4, + QuickCheck >= 2.8.1 && <2.9 + type: exitcode-stdio-1.0 + main-is: test-raw-metadata.hs + extra-libraries: + netcdf + hs-source-dirs: test +test-suite test-raw-get-put + build-depends: + hnetcdf -any, + base >= 4.3 && <5, + containers, + vector, + repa, + directory, + test-framework, + test-framework-hunit, + test-framework-quickcheck2, + HUnit, + QuickCheck + type: exitcode-stdio-1.0 + main-is: test-raw-get-put.hs + extra-libraries: + netcdf + hs-source-dirs: test +test-suite test-raw-attributes + build-depends: + hnetcdf -any, + base >= 4.3 && <5, + containers, + vector, + repa, + directory, + test-framework, + test-framework-hunit, + test-framework-quickcheck2, + HUnit, + QuickCheck + type: exitcode-stdio-1.0 + main-is: test-raw-attributes.hs + extra-libraries: + netcdf + hs-source-dirs: test +test-suite test-get + build-depends: + hnetcdf -any, + base >= 4.3 && <5, + containers, + errors, + repa, + vector, + directory, + test-framework, + test-framework-hunit, + test-framework-quickcheck2, + HUnit, + QuickCheck + type: exitcode-stdio-1.0 + main-is: test-get.hs + extra-libraries: + netcdf + hs-source-dirs: test +test-suite test-put + build-depends: + hnetcdf -any, + base >= 4.3 && <5, + containers, + errors, + vector, + directory + type: exitcode-stdio-1.0 + main-is: test-put.hs + extra-libraries: + netcdf + hs-source-dirs: test diff --git a/test/test-get.hs b/test/test-get.hs --- a/test/test-get.hs +++ b/test/test-get.hs @@ -8,13 +8,11 @@ import Data.Array.Repa.Repr.ForeignPtr (F) import Control.Error import Control.Monad -import Numeric.Container as C import Foreign.C import Data.NetCDF import qualified Data.NetCDF.Vector as V import qualified Data.NetCDF.Repa as R -import qualified Data.NetCDF.HMatrix as H main :: IO () main = defaultMain tests @@ -45,9 +43,6 @@ , testCase "Read (float, Repa)" (getVarRepa infile "vf" fwit) , testCase "Read (int, Repa)" (getVarRepa infile "vi" iwit) , testCase "Read (short, Repa)" (getVarRepa infile "vs" swit) - , testCase "Read (float, hmatrix)" (getVarHMV infile "vf" fwit) - , testCase "Read (int, hmatrix)" (getVarHMV infile "vi" iwit) - , testCase "Read (short, hmatrix)" (getVarHMV infile "vs" swit) ], testGroup "Variable slice access functions" [ testCase "Read (float, SV)" (getVarASV infile "vf" fwit) @@ -56,9 +51,6 @@ , testCase "Read (float, Repa)" (getVarARepa infile "vf" fwit) , testCase "Read (int, Repa)" (getVarARepa infile "vi" iwit) , testCase "Read (short, Repa)" (getVarARepa infile "vs" swit) - , testCase "Read (float, hmatrix)" (getVarAHMV infile "vf" fwit) - , testCase "Read (int, hmatrix)" (getVarAHMV infile "vi" iwit) - , testCase "Read (short, hmatrix)" (getVarAHMV infile "vs" swit) ], testGroup "Strided slice access functions" [ testCase "Read (float, SV)" (getVarSSV infile "vf" fwit) @@ -67,9 +59,6 @@ , testCase "Read (float, Repa)" (getVarSRepa infile "vf" fwit) , testCase "Read (int, Repa)" (getVarSRepa infile "vi" iwit) , testCase "Read (short, Repa)" (getVarSRepa infile "vs" swit) - , testCase "Read (float, hmatrix)" (getVarSHMV infile "vf" fwit) - , testCase "Read (int, hmatrix)" (getVarSHMV infile "vi" iwit) - , testCase "Read (short, hmatrix)" (getVarSHMV infile "vs" swit) ] ] @@ -77,8 +66,6 @@ type SVRet a = IO (Either NcError (SV.Vector a)) type RepaRet3 a = IO (Either NcError (R.Array F R.DIM3 a)) type RepaRet1 a = IO (Either NcError (R.Array F R.DIM1 a)) -type HMVRet a = IO (Either NcError (H.HVector a)) -type HMMRet a = IO (Either NcError (H.HMatrix a)) -------------------------------------------------------------------------------- @@ -165,32 +152,7 @@ (and $ zipWith (==) tstvals truevals) void $ closeFile nc -getVarHMV :: forall a. (Eq a, Num a, Show a, NcStorable a, Element a) - => FilePath -> String -> a -> Assertion -getVarHMV f v _ = do - enc <- openFile f - assertBool "failed to open file" $ isRight enc - let Right nc = enc - case ncVar nc v of - Nothing -> assertBool "missing variable" False - Just var -> do - eval <- get nc var :: HMVRet a - case eval of - Left e -> assertBool ("read error: " ++ show e) False - Right (H.HVector val) -> do - let [nz, ny, nx] = map ncDimLength $ ncVarDims var - truevals = [fromIntegral $ ix + 10 * iy + 100 * iz | - ix <- [1..nx], iy <- [1..ny], iz <- [1..nz]] - idxs = [(iz - 1) * ny * nx + (iy - 1) * nx + (ix - 1) | - ix <- [1..nx], iy <- [1..ny], iz <- [1..nz]] - tstvals = [val C.@> i | i <- idxs] - assertBool ("value error: " ++ show tstvals ++ - " instead of " ++ show truevals) - (and $ zipWith (==) tstvals truevals) - void $ closeFile nc - - -------------------------------------------------------------------------------- -- -- VARIABLE SLICE READ @@ -291,54 +253,7 @@ assertBool ("3: value error: " ++ show tstvals ++ " instead of " ++ show truevals) (tstvals == truevals) -getVarAHMV :: forall a. (Num a, Show a, Eq a, NcStorable a, Element a) - => FilePath -> String -> a -> Assertion -getVarAHMV f v _ = do - enc <- openFile f - assertBool "failed to open file" $ isRight enc - let Right nc = enc - case ncVar nc v of - Nothing -> assertBool "missing variable" False - Just var -> do - let [nz, ny, nx] = map ncDimLength $ ncVarDims var - forM_ [1..nx] $ \ix -> do - forM_ [1..ny] $ \iy -> do - let start = [0, iy-1, ix-1] - count = [nz, 1, 1] - eval <- getA nc var start count :: HMVRet a - case eval of - Left e -> assertBool ("read error: " ++ show e) False - Right vals -> do - let truevals = H.HVector $ C.buildVector (fromIntegral nz) - (\iz -> fromIntegral $ ix + 10 * iy + 100 * (iz+1)) - assertBool ("1: value error: " ++ show vals ++ - " instead of " ++ show truevals) (vals == truevals) - forM_ [1..nx] $ \ix -> do - forM_ [1..nz] $ \iz -> do - let start = [iz-1, 0, ix-1] - count = [1, ny, 1] - eval <- getA nc var start count :: HMVRet a - case eval of - Left e -> assertBool ("read error: " ++ show e) False - Right vals -> do - let truevals = H.HVector $ C.buildVector (fromIntegral ny) - (\iy -> fromIntegral $ ix + 10 * (iy+1) + 100 * iz) - assertBool ("2: value error: " ++ show vals ++ - " instead of " ++ show truevals) (vals == truevals) - forM_ [1..ny] $ \iy -> do - forM_ [1..nz] $ \iz -> do - let start = [iz-1, iy-1, 0] - count = [1, 1, nx] - eval <- getA nc var start count :: HMVRet a - case eval of - Left e -> assertBool ("read error: " ++ show e) False - Right vals -> do - let truevals = H.HVector $ C.buildVector (fromIntegral nx) - (\ix -> fromIntegral $ (ix+1) + 10 * iy + 100 * iz) - assertBool ("3: value error: " ++ show vals ++ - " instead of " ++ show truevals) (vals == truevals) - -------------------------------------------------------------------------------- -- -- STRIDED SLICE READ @@ -465,62 +380,3 @@ assertBool ("3: value error: " ++ show tstvals ++ " instead of " ++ show truevals) (tstvals == truevals) - -getVarSHMV :: forall a. (Num a, Show a, Eq a, NcStorable a, Element a) - => FilePath -> String -> a -> Assertion -getVarSHMV f v _ = do - enc <- openFile f - assertBool "failed to open file" $ isRight enc - let Right nc = enc - case ncVar nc v of - Nothing -> assertBool "missing variable" False - Just var -> do - let [nz, ny, nx] = map ncDimLength $ ncVarDims var - forM_ [1..nx] $ \ix -> do - forM_ [1..ny] $ \iy -> do - forM_ [1..nz] $ \s -> do - let start = [0, iy-1, ix-1] - count = [(nz + s - 1) `div` s, 1, 1] - stride = [s, 1, 1] - eval <- getS nc var start count stride :: HMVRet a - case eval of - Left e -> assertBool ("read error: " ++ show e) False - Right vals -> do - let truevals = H.HVector $ C.buildVector - (fromIntegral $ (nz + s - 1) `div` s) - (\iz -> fromIntegral $ - ix + 10 * iy + 100 * (iz * s + 1)) - assertBool ("1: value error: " ++ show vals ++ - " instead of " ++ show truevals) (vals == truevals) - forM_ [1..nx] $ \ix -> do - forM_ [1..nz] $ \iz -> do - forM_ [1..ny] $ \s -> do - let start = [iz-1, 0, ix-1] - count = [1, (ny + s - 1) `div` s, 1] - stride = [1, s, 1] - eval <- getS nc var start count stride :: HMVRet a - case eval of - Left e -> assertBool ("read error: " ++ show e) False - Right vals -> do - let truevals = H.HVector $ C.buildVector - (fromIntegral $ (ny + s - 1) `div` s) - (\iy -> fromIntegral $ - ix + 10 * (iy * s + 1) + 100 * iz) - assertBool ("2: value error: " ++ show vals ++ - " instead of " ++ show truevals) (vals == truevals) - forM_ [1..ny] $ \iy -> do - forM_ [1..nz] $ \iz -> do - forM_ [1..nx] $ \s -> do - let start = [iz-1, iy-1, 0] - count = [1, 1, (nx + s - 1) `div` s] - stride = [1, 1, s] - eval <- getS nc var start count stride :: HMVRet a - case eval of - Left e -> assertBool ("read error: " ++ show e) False - Right vals -> do - let truevals = H.HVector $ C.buildVector - (fromIntegral $ (nx + s - 1) `div` s) - (\ix -> fromIntegral $ - (ix * s + 1) + 10 * iy + 100 * iz) - assertBool ("3: value error: " ++ show vals ++ - " instead of " ++ show truevals) (vals == truevals) diff --git a/test/test-hmatrix.hs b/test/test-hmatrix.hs deleted file mode 100644 --- a/test/test-hmatrix.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -import Test.Framework (defaultMain, testGroup, Test) -import Test.Framework.Providers.HUnit -import Test.Framework.Providers.QuickCheck2 -import Test.HUnit hiding (Test, assert) -import Test.QuickCheck -import Test.QuickCheck.Monadic - -import qualified Data.Map as M -import Data.Maybe -import qualified Data.Vector.Storable as SV -import Numeric.LinearAlgebra.HMatrix -import Control.Error -import Control.Monad -import Foreign.C - -import Data.NetCDF -import Data.NetCDF.Vector -import Data.NetCDF.HMatrix - -type HMatrixRet a = IO (Either NcError (HMatrix a)) - -main :: IO () -main = defaultMain tests - -tests :: [Test] -tests = - [ testGroup "HMatrix handling" - [ testCase "Data ordering" hmatrixDataOrdering - ] - ] - -hmatrixDataOrdering :: Assertion -hmatrixDataOrdering = do - let xdim = NcDim "x" 5 False - ydim = NcDim "y" 10 False - ncout = emptyNcInfo "tst-hmatrix.nc" # - addNcDim xdim # - addNcDim ydim # - addNcVar (NcVar "x" NcDouble [xdim] M.empty) # - addNcVar (NcVar "y" NcDouble [ydim] M.empty) # - addNcVar (NcVar "z1" NcDouble [ydim, xdim] M.empty) # - addNcVar (NcVar "z2" NcDouble [ydim, xdim] M.empty) - z1 = cmap realToFrac $ matrix 5 [1..50] :: Matrix CDouble - z2 = fromColumns $ toColumns z1 :: Matrix CDouble - let write nc = do - let xvar = fromJust $ ncVar nc "x" - yvar = fromJust $ ncVar nc "y" - z1var = fromJust $ ncVar nc "z1" - z2var = fromJust $ ncVar nc "z2" - put nc xvar $ SV.fromList [1..5 :: CDouble] - put nc yvar $ SV.fromList [1..10 :: CDouble] - put nc z1var $ HMatrix z1 - put nc z2var $ HMatrix z2 - return () - withCreateFile ncout write (putStrLn . ("ERROR: " ++) . show) - let read nc = do - let z1var = fromJust $ ncVar nc "z1" - z2var = fromJust $ ncVar nc "z2" - Right (HMatrix z1) <- get nc z1var :: HMatrixRet CDouble - Right (HMatrix z2) <- get nc z2var :: HMatrixRet CDouble - return (z1, z2) - (z1tst, z2tst) <- - withReadFile "tst-hmatrix.nc" read (error . ("ERROR: " ++) . show) - assertBool "Straightforward write/read" (flatten z1tst == flatten z1) - assertBool "Columnar write/read" (flatten z2tst == flatten z2)