hstatistics 0.1.0.1 → 0.1.0.2
raw patch · 8 files changed
+103/−283 lines, 8 filesdep ~hmatrix
Dependency ranges changed: hmatrix
Files
- CHANGES +5/−0
- configure.hs +26/−19
- hstatistics.cabal +2/−2
- lib/Numeric/GSL/Distribution/Continuous.hs +3/−36
- lib/Numeric/GSL/Distribution/Discrete.hs +3/−36
- lib/Numeric/GSL/Histogram.hs +20/−68
- lib/Numeric/GSL/Histogram2D.hs +20/−68
- lib/Numeric/GSL/Permutation.hs +24/−54
CHANGES view
@@ -1,2 +1,7 @@ 0.1.0.1: first version++0.1.0.2:+ fixed configure.hs to work for local install+ updated to reflect exportation of check from Data.Packed.Development+ in hmatrix-0.9.3.0
configure.hs view
@@ -18,6 +18,7 @@ -} import System+import System.Directory(createDirectoryIfMissing) import Data.List(isPrefixOf, intercalate) import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Configure@@ -37,13 +38,14 @@ ] -- compile a simple program with symbols from GSL and LAPACK with the given libs-testprog buildInfo libs fmks =+testprog bInfo buildInfo libs fmks = "echo \"#include <gsl/gsl_sf_gamma.h>\nint main(){zgesvd_(); gsl_sf_gamma(5);}\""- ++" > /tmp/dummy.c; gcc "+ ++" > " ++ (buildDir bInfo) ++ "/dummy.c; gcc " ++ (join $ ccOptions buildInfo) ++ " " ++ (join $ cppOptions buildInfo) ++ " "- ++ (join $ map ("-I"++) $ includeDirs buildInfo)- ++" /tmp/dummy.c -o /tmp/dummy "+ ++ (join $ map ("-I"++) $ includeDirs buildInfo) ++ " " + ++ (buildDir bInfo) ++ "/dummy.c -o "+ ++ (buildDir bInfo) ++ "/dummy " ++ (join $ map ("-L"++) $ extraLibDirs buildInfo) ++ " " ++ (prepend "-l" $ libs) ++ " " ++ (prepend "-framework " fmks) ++ " > /dev/null 2> /dev/null"@@ -51,26 +53,28 @@ join = intercalate " " prepend x = unwords . map (x++) . words -check buildInfo libs fmks = (ExitSuccess ==) `fmap` system (testprog buildInfo libs fmks)+check bInfo buildInfo libs fmks = (ExitSuccess ==) `fmap` system (testprog bInfo buildInfo libs fmks) -- simple test for GSL-gsl buildInfo = "echo \"#include <gsl/gsl_sf_gamma.h>\nint main(){gsl_sf_gamma(5);}\""- ++" > /tmp/dummy.c; gcc "+gsl bInfo buildInfo = "echo \"#include <gsl/gsl_sf_gamma.h>\nint main(){gsl_sf_gamma(5);}\""+ ++" > " ++ (buildDir bInfo) ++ "/dummy.c; gcc " ++ (join $ ccOptions buildInfo) ++ " " ++ (join $ cppOptions buildInfo) ++ " "- ++ (join $ map ("-I"++) $ includeDirs buildInfo)- ++ " /tmp/dummy.c -o /tmp/dummy "+ ++ (join $ map ("-I"++) $ includeDirs buildInfo) ++ " " + ++ (buildDir bInfo) ++ "/dummy.c -o "+ ++ (buildDir bInfo) ++ "/dummy " ++ (join $ map ("-L"++) $ extraLibDirs buildInfo) ++ " -lgsl -lgslcblas" ++ " > /dev/null 2> /dev/null" -- test for gsl >= 1.12-gsl112 buildInfo =+gsl112 bInfo buildInfo = "echo \"#include <gsl/gsl_sf_exp.h>\nint main(){gsl_sf_exprel_n_CF_e(1,1,0);}\""- ++" > /tmp/dummy.c; gcc /tmp/dummy.c "+ ++" > " ++ (buildDir bInfo) ++ "/dummy.c; gcc " + ++ (buildDir bInfo) ++ "/dummy.c " ++ (join $ ccOptions buildInfo) ++ " " ++ (join $ cppOptions buildInfo) ++ " " ++ (join $ map ("-I"++) $ includeDirs buildInfo)- ++" -o /tmp/dummy "+ ++" -o " ++ (buildDir bInfo) ++ "/dummy " ++ (join $ map ("-L"++) $ extraLibDirs buildInfo) ++ " -lgsl -lgslcblas" ++ " > /dev/null 2> /dev/null" @@ -78,11 +82,11 @@ checkCommand c = (ExitSuccess ==) `fmap` system c -- test different configurations until the first one works-try _ _ _ [] = return Nothing-try i b f (opt:rest) = do- ok <- check i (b ++ " " ++ opt) f+try _ _ _ _ [] = return Nothing+try l i b f (opt:rest) = do+ ok <- check l i (b ++ " " ++ opt) f if ok then return (Just opt)- else try i b f rest+ else try l i b f rest -- read --configure-option=link:lib1,lib2,lib3,etc linkop = "link:"@@ -110,11 +114,14 @@ let pref = if null (words (base ++ " " ++ auxpref)) then "gsl lapack" else auxpref fullOpts = map ((pref++" ")++) opts - r <- try buildInfo base fwks fullOpts+ -- create the build directory (used for tmp files) if necessary+ createDirectoryIfMissing True $ buildDir bInfo+ + r <- try bInfo buildInfo base fwks fullOpts case r of Nothing -> do putStrLn " FAIL"- g <- checkCommand $ gsl buildInfo+ g <- checkCommand $ gsl bInfo buildInfo if g then putStrLn " *** Sorry, I can't link LAPACK." else putStrLn " *** Sorry, I can't link GSL."@@ -124,7 +131,7 @@ writeFile "hstatistics.buildinfo" ("buildable: False\n") Just ops -> do putStrLn " OK"- g <- checkCommand $ gsl112 buildInfo+ g <- checkCommand $ gsl112 bInfo buildInfo writeFile "hstatistics.buildinfo" $ "extra-libraries: " ++ ops ++ "\n" ++ if g
hstatistics.cabal view
@@ -1,5 +1,5 @@ Name: hstatistics-Version: 0.1.0.1+Version: 0.1.0.2 License: GPL License-file: LICENSE Copyright: (c) A.V.H. McPhail 2010@@ -22,7 +22,7 @@ library Build-Depends: base >= 3 && < 5,- storable-complex, hmatrix+ storable-complex, hmatrix >= 0.9.3 Extensions: ForeignFunctionInterface
lib/Numeric/GSL/Distribution/Continuous.hs view
@@ -128,8 +128,7 @@ -> Double -- ^ result random_1p d s p = unsafePerformIO $ alloca $ \r -> do- err <- distribution_random_one_param (fromIntegral s) (fromei d) p r- check "random1p" err+ check "random1p" $ distribution_random_one_param (fromIntegral s) (fromei d) p r r' <- peek r return r' @@ -154,8 +153,7 @@ -> Double -- ^ result random_2p d s p1 p2 = unsafePerformIO $ alloca $ \r -> do- err <- distribution_random_two_param (fromIntegral s) (fromei d) p1 p2 r- check "random2p" err+ check "random2p" $ distribution_random_two_param (fromIntegral s) (fromei d) p1 p2 r r' <- peek r return r' @@ -194,8 +192,7 @@ -> Double -- ^ result random_3p d s p1 p2 p3 = unsafePerformIO $ alloca $ \r -> do- err <- distribution_random_three_param (fromIntegral s) (fromei d) p1 p2 p3 r- check "random_3p" err+ check "random_3p" $ distribution_random_three_param (fromIntegral s) (fromei d) p1 p2 p3 r r' <- peek r return r' @@ -298,34 +295,4 @@ ----------------------------------------------------------------------------- ------------------------------------------------------------------------------------------------------------------------------------------------------------{- copied from hmatrix -}---- GSL error codes are <= 1024--- | error codes for the auxiliary functions required by the wrappers-errorCode :: CInt -> String-errorCode 2000 = "bad size"-errorCode 2001 = "bad function code"-errorCode 2002 = "memory problem"-errorCode 2003 = "bad file"-errorCode 2004 = "singular"-errorCode 2005 = "didn't converge"-errorCode 2006 = "the input matrix is not positive definite"-errorCode 2007 = "not yet supported in this OS"-errorCode n = "code "++show n---- | check the error code-check :: String -> CInt -> IO ()-check msg err = do- when (err/=0) $ if err > 1024- then (error (msg++": "++errorCode err)) -- our errors- else do -- GSL errors- ps <- gsl_strerror err- s <- peekCString ps- error (msg++": "++s)- return ()---- | description of GSL error codes-foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar)- -----------------------------------------------------------------------------
lib/Numeric/GSL/Distribution/Discrete.hs view
@@ -81,8 +81,7 @@ -> Int -- ^ result random_1p d s p = unsafePerformIO $ alloca $ \r -> do- err <- distribution_discrete_one_param (fromIntegral s) (fromei d) p r- check "random1p" err+ check "random1p" $ distribution_discrete_one_param (fromIntegral s) (fromei d) p r r' <- peek r return $ fromIntegral r' @@ -119,8 +118,7 @@ -> Int -- ^ result random_2p d s p1 p2 = unsafePerformIO $ alloca $ \r -> do- err <- distribution_discrete_two_param (fromIntegral s) (fromei d) p1 (fromIntegral p2) r- check "random2p" err+ check "random2p" $ distribution_discrete_two_param (fromIntegral s) (fromei d) p1 (fromIntegral p2) r r' <- peek r return $ fromIntegral r' @@ -152,8 +150,7 @@ -> Int -- ^ result random_3p d s p1 p2 p3 = unsafePerformIO $ alloca $ \r -> do- err <- distribution_discrete_three_param (fromIntegral s) (fromei d) (fromIntegral p1) (fromIntegral p2) (fromIntegral p3) r- check "random_3p" err+ check "random_3p" $ distribution_discrete_three_param (fromIntegral s) (fromei d) (fromIntegral p1) (fromIntegral p2) (fromIntegral p3) r r' <- peek r return $ fromIntegral r' @@ -209,34 +206,4 @@ ----------------------------------------------------------------------------- ------------------------------------------------------------------------------------------------------------------------------------------------------------{- copied from hmatrix -}---- GSL error codes are <= 1024--- | error codes for the auxiliary functions required by the wrappers-errorCode :: CInt -> String-errorCode 2000 = "bad size"-errorCode 2001 = "bad function code"-errorCode 2002 = "memory problem"-errorCode 2003 = "bad file"-errorCode 2004 = "singular"-errorCode 2005 = "didn't converge"-errorCode 2006 = "the input matrix is not positive definite"-errorCode 2007 = "not yet supported in this OS"-errorCode n = "code "++show n---- | check the error code-check :: String -> CInt -> IO ()-check msg err = do- when (err/=0) $ if err > 1024- then (error (msg++": "++errorCode err)) -- our errors- else do -- GSL errors- ps <- gsl_strerror err- s <- peekCString ps- error (msg++": "++s)- return ()---- | description of GSL error codes-foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar)- -----------------------------------------------------------------------------
lib/Numeric/GSL/Histogram.hs view
@@ -339,52 +339,52 @@ add :: Histogram -> Histogram -> Histogram add d (H _ s) = unsafePerformIO $ do h@(H _ d') <- cloneHistogram d- err <- withForeignPtr d' $ \dp ->+ check "add" $+ withForeignPtr d' $ \dp -> withForeignPtr s $ \sp -> histogram_add dp sp- check "add" err return h -- | subtracts the contents of the bins of the second histogram from the first subtract :: Histogram -> Histogram -> Histogram subtract d (H _ s) = unsafePerformIO $ do h@(H _ d') <- cloneHistogram d- err <- withForeignPtr d' $ \dp ->+ check "subtract" $+ withForeignPtr d' $ \dp -> withForeignPtr s $ \sp -> histogram_sub dp sp- check "subtract" err return h -- | multiplies the contents of the bins of the second histogram by the first multiply :: Histogram -> Histogram -> Histogram multiply d (H _ s) = unsafePerformIO $ do h@(H _ d') <- cloneHistogram d- err <- withForeignPtr d' $ \dp ->+ check "multiply" $+ withForeignPtr d' $ \dp -> withForeignPtr s $ \sp -> histogram_mul dp sp- check "multiply" err return h -- | divides the contents of the bins of the first histogram by the second divide :: Histogram -> Histogram -> Histogram divide d (H _ s) = unsafePerformIO $ do h@(H _ d') <- cloneHistogram d- err <- withForeignPtr d' $ \dp ->+ check "divide" $+ withForeignPtr d' $ \dp -> withForeignPtr s $ \sp -> histogram_div dp sp- check "divide" err return h -- | multiplies the contents of the bins by a constant scale :: Histogram -> Double -> Histogram scale d s = unsafePerformIO $ do h@(H _ d') <- cloneHistogram d- err <- withForeignPtr d' $ (\f -> histogram_scale f s)- check "scale" err+ check "scale" $+ withForeignPtr d' $ (\f -> histogram_scale f s) return h -- | adds a constant to the contents of the bins shift :: Histogram -> Double -> Histogram shift d s = unsafePerformIO $ do h@(H _ d') <- cloneHistogram d- err <- withForeignPtr d' $ (\f -> histogram_shift f s)- check "shift" err+ check "shift" $+ withForeignPtr d' $ (\f -> histogram_shift f s) return h foreign import ccall "gsl-histogram.h gsl_histogram_equal_bins_p" histogram_equal_bins :: HistHandle -> HistHandle -> IO CInt@@ -401,8 +401,8 @@ fwriteHistogram :: FilePath -> Histogram -> IO () fwriteHistogram fn (H _ h) = do cn <- newCString fn- err <- withForeignPtr h $ histogram_fwrite cn- check "fwriteHistogram" err+ check "fwriteHistogram" $+ withForeignPtr h $ histogram_fwrite cn free cn -- | read a histogram in the native binary format, number of bins must be known@@ -411,8 +411,8 @@ h <- histogram_new (fromIntegral b) h' <- newForeignPtr histogram_free h cn <- newCString fn- err <- withForeignPtr h' $ histogram_fread cn- check "freadHistogram" err+ check "freadHistogram" $+ withForeignPtr h' $ histogram_fread cn return $ H b h' -- | saves the histogram with the given formats (%f,%e,%g) for ranges and bins@@ -422,8 +422,8 @@ cn <- newCString fn cr <- newCString fr cb <- newCString fb- err <- withForeignPtr h $ histogram_fprintf cn cr cb- check "fprintfHistogram" err+ check "fprintfHistogram" $+ withForeignPtr h $ histogram_fprintf cn cr cb free cn free cr free cb@@ -435,8 +435,8 @@ h <- histogram_new (fromIntegral b) h' <- newForeignPtr histogram_free h cn <- newCString fn- err <- withForeignPtr h' $ histogram_fscanf cn- check "fscanfHistogram" err+ check "fscanfHistogram" $+ withForeignPtr h' $ histogram_fscanf cn return $ H b h' foreign import ccall "histogram-aux.h hist_fwrite" histogram_fwrite :: Ptr CChar -> HistHandle -> IO CInt@@ -469,53 +469,5 @@ foreign import ccall "gsl-histogram.h gsl_histogram_pdf_sample" histogram_pdf_sample :: PDFHandle -> IO Double ---------------------------------------------------------------------------------------------- ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------{- copied from hmatrix -}---- GSL error codes are <= 1024--- | error codes for the auxiliary functions required by the wrappers-errorCode :: CInt -> String-errorCode 2000 = "bad size"-errorCode 2001 = "bad function code"-errorCode 2002 = "memory problem"-errorCode 2003 = "bad file"-errorCode 2004 = "singular"-errorCode 2005 = "didn't converge"-errorCode 2006 = "the input matrix is not positive definite"-errorCode 2007 = "not yet supported in this OS"-errorCode n = "code "++show n---- | check the error code-check :: String -> CInt -> IO ()-check msg err = do- when (err/=0) $ if err > 1024- then (error (msg++": "++errorCode err)) -- our errors- else do -- GSL errors- ps <- gsl_strerror err- s <- peekCString ps- error (msg++": "++s)- return ()---- | description of GSL error codes-foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar)- -----------------------------------------------------------------------------
lib/Numeric/GSL/Histogram2D.hs view
@@ -400,52 +400,52 @@ add :: Histogram2D -> Histogram2D -> Histogram2D add d (H _ _ s) = unsafePerformIO $ do h@(H _ _ d') <- cloneHistogram2D d - err <- withForeignPtr d' $ \dp ->+ check "add" $+ withForeignPtr d' $ \dp -> withForeignPtr s $ \sp -> histogram2d_add dp sp- check "add" err return h -- | subtracts the contents of the bins of the second histogram from the first subtract :: Histogram2D -> Histogram2D -> Histogram2D subtract d (H _ _ s) = unsafePerformIO $ do h@(H _ _ d') <- cloneHistogram2D d - err <- withForeignPtr d' $ \dp ->+ check "subtract" $+ withForeignPtr d' $ \dp -> withForeignPtr s $ \sp -> histogram2d_sub dp sp- check "subtract" err return h -- | multiplies the contents of the bins of the second histogram by the first multiply :: Histogram2D -> Histogram2D -> Histogram2D multiply d (H _ _ s) = unsafePerformIO $ do h@(H _ _ d') <- cloneHistogram2D d - err <- withForeignPtr d' $ \dp ->+ check "multiply" $+ withForeignPtr d' $ \dp -> withForeignPtr s $ \sp -> histogram2d_mul dp sp- check "multiply" err return h -- | divides the contents of the bins of the first histogram by the second divide :: Histogram2D -> Histogram2D -> Histogram2D divide d (H _ _ s) = unsafePerformIO $ do h@(H _ _ d') <- cloneHistogram2D d - err <- withForeignPtr d' $ \dp ->+ check "divide" $+ withForeignPtr d' $ \dp -> withForeignPtr s $ \sp -> histogram2d_div dp sp- check "divide" err return h -- | multiplies the contents of the bins by a constant scale :: Histogram2D -> Double -> Histogram2D scale d s = unsafePerformIO $ do h@(H _ _ d') <- cloneHistogram2D d - err <- withForeignPtr d' $ (\f -> histogram2d_scale f s)- check "scale" err+ check "scale" $+ withForeignPtr d' $ (\f -> histogram2d_scale f s) return h -- | adds a constant to the contents of the bins shift :: Histogram2D -> Double -> Histogram2D shift d s = unsafePerformIO $ do h@(H _ _ d') <- cloneHistogram2D d - err <- withForeignPtr d' $ (\f -> histogram2d_shift f s)- check "shift" err+ check "shift" $+ withForeignPtr d' $ (\f -> histogram2d_shift f s) return h foreign import ccall "gsl-histogram2d.h gsl_histogram2d_equal_bins_p" histogram2d_equal_bins :: Hist2DHandle -> Hist2DHandle -> IO CInt@@ -462,8 +462,8 @@ fwriteHistogram2D :: FilePath -> Histogram2D -> IO () fwriteHistogram2D fn (H _ _ h) = do cn <- newCString fn- err <- withForeignPtr h $ histogram2d_fwrite cn- check "fwriteHistogram2d2D" err+ check "fwriteHistogram2d2D" $+ withForeignPtr h $ histogram2d_fwrite cn free cn -- | read a histogram in the native binary format, number of bins must be known@@ -472,8 +472,8 @@ h <- histogram2d_new (fromIntegral bx) (fromIntegral by) h' <- newForeignPtr histogram2d_free h cn <- newCString fn- err <- withForeignPtr h' $ histogram2d_fread cn- check "freadHistogram2d2D" err+ check "freadHistogram2d2D" $+ withForeignPtr h' $ histogram2d_fread cn return $ H bx by h' -- | saves the histogram with the given formats (%f,%e,%g) for ranges and bins@@ -483,8 +483,8 @@ cn <- newCString fn cr <- newCString fr cb <- newCString fb- err <- withForeignPtr h $ histogram2d_fprintf cn cr cb- check "fprintfHistogram2d2D" err+ check "fprintfHistogram2d2D" $+ withForeignPtr h $ histogram2d_fprintf cn cr cb free cn free cr free cb@@ -496,8 +496,8 @@ h <- histogram2d_new (fromIntegral bx) (fromIntegral by) h' <- newForeignPtr histogram2d_free h cn <- newCString fn- err <- withForeignPtr h' $ histogram2d_fscanf cn- check "fscanfHistogram2d2D" err+ check "fscanfHistogram2d2D" $+ withForeignPtr h' $ histogram2d_fscanf cn return $ H bx by h' foreign import ccall "histogram-aux.h hist2d_fwrite" histogram2d_fwrite :: Ptr CChar -> Hist2DHandle -> IO CInt@@ -531,53 +531,5 @@ foreign import ccall "gsl-histogram2d.h gsl_histogram2d_pdf_sample" histogram2d_pdf_sample :: PDFHandle -> IO Double ---------------------------------------------------------------------------------------------- ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------{- copied from hmatrix -}---- GSL error codes are <= 1024--- | error codes for the auxiliary functions required by the wrappers-errorCode :: CInt -> String-errorCode 2000 = "bad size"-errorCode 2001 = "bad function code"-errorCode 2002 = "memory problem"-errorCode 2003 = "bad file"-errorCode 2004 = "singular"-errorCode 2005 = "didn't converge"-errorCode 2006 = "the input matrix is not positive definite"-errorCode 2007 = "not yet supported in this OS"-errorCode n = "code "++show n---- | check the error code-check :: String -> CInt -> IO ()-check msg err = do- when (err/=0) $ if err > 1024- then (error (msg++": "++errorCode err)) -- our errors- else do -- GSL errors- ps <- gsl_strerror err- s <- peekCString ps- error (msg++": "++s)- return ()---- | description of GSL error codes-foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar)- -----------------------------------------------------------------------------
lib/Numeric/GSL/Permutation.hs view
@@ -99,10 +99,10 @@ clonePermutation (P n s) = do d <- permutation_new (fromIntegral n) d' <- newForeignPtr permutation_free d- err <- withForeignPtr s $ \s' ->+ check "clonePermutation" $+ withForeignPtr s $ \s' -> withForeignPtr d' $ \d'' -> permutation_clone d'' s'- check "clonePermutation" err return (P n d') foreign import ccall "gsl-permutation.h gsl_permutation_memcpy" permutation_clone :: PermHandle -> PermHandle -> IO CInt@@ -115,8 +115,8 @@ -> Permutation random_permute s n = unsafePerformIO $ do (P _ p) <- nullPermutation n- err <- withForeignPtr p $ \p' -> permutation_random_permute (fromIntegral s) p'- check "random_permute" err+ check "random_permute" $+ withForeignPtr p $ \p' -> permutation_random_permute (fromIntegral s) p' return (P n p) foreign import ccall "permutation-aux.h random_permute" permutation_random_permute :: CInt -> PermHandle -> IO CInt@@ -132,8 +132,8 @@ -- | swaps the i-th and j-th elements swapIO :: Permutation -> Int -> Int -> IO () swapIO (P _ p) i j = do- err <- withForeignPtr p $ \p' -> permutation_swap p' (fromIntegral i) (fromIntegral j)- check "swap" err+ check "swap" $+ withForeignPtr p $ \p' -> permutation_swap p' (fromIntegral i) (fromIntegral j) -- | swaps the i-th and j-th elements swap :: Permutation -> Int -> Int -> Permutation@@ -173,8 +173,8 @@ -- | reverse the elements of the permutation reverseIO :: Permutation -> IO () reverseIO (P _ p) = do- err <- withForeignPtr p $ \p' -> permutation_reverse p' - check "reverseIO" err+ check "reverseIO" $+ withForeignPtr p $ \p' -> permutation_reverse p' -- | reverse the elements of the permutation reverse :: Permutation -> Permutation@@ -188,9 +188,9 @@ inverse (P n p) = unsafePerformIO $ do d <- permutation_new (fromIntegral n) d' <- newForeignPtr permutation_free d- err <- withForeignPtr d' $ \d'' ->+ check "inverse" $+ withForeignPtr d' $ \d'' -> withForeignPtr p $ \p' -> permutation_inverse d'' p'- check "inverse" err return (P n d') -- | advances the permutation to the next in lexicographic order, if there is one@@ -236,10 +236,10 @@ mul (P n p1) (P _ p2) = unsafePerformIO $ do p <- permutation_new (fromIntegral n) p' <- newForeignPtr permutation_free p- err <- withForeignPtr p' $ \p'' ->+ check "mul" $+ withForeignPtr p' $ \p'' -> withForeignPtr p1 $ \p1' -> withForeignPtr p2 $ \p2' -> permutation_mul p'' p1' p2'- check "mul" err return (P n p') foreign import ccall "permutation-aux.h permute" permutation_permute :: PermHandle -> CInt -> Ptr Double -> CInt -> Ptr Double -> IO CInt@@ -252,8 +252,8 @@ fwritePermutation :: FilePath -> Permutation -> IO () fwritePermutation fn (P _ p) = do cn <- newCString fn- err <- withForeignPtr p $ permutation_fwrite cn- check "fwritePermutation" err+ check "fwritePermutation" $+ withForeignPtr p $ permutation_fwrite cn free cn -- | read a permutation in the native binary format, length must be known@@ -262,8 +262,8 @@ h <- permutation_new (fromIntegral b) h' <- newForeignPtr permutation_free h cn <- newCString fn- err <- withForeignPtr h' $ permutation_fread cn- check "freadPermutation" err+ check "freadPermutation" $+ withForeignPtr h' $ permutation_fread cn return $ P b h' -- | saves the permutation with the given format@@ -271,8 +271,8 @@ fprintfPermutation fn fr (P _ p) = do cn <- newCString fn cr <- newCString fr- err <- withForeignPtr p $ permutation_fprintf cn cr- check "fprintfPermutation" err+ check "fprintfPermutation" $+ withForeignPtr p $ permutation_fprintf cn cr free cn free cr return ()@@ -283,8 +283,8 @@ h <- permutation_new (fromIntegral b) h' <- newForeignPtr permutation_free h cn <- newCString fn- err <- withForeignPtr h' $ permutation_fscanf cn- check "fscanfPermutation" err+ check "fscanfPermutation" $+ withForeignPtr h' $ permutation_fscanf cn return $ P b h' foreign import ccall "permutation-aux.h perm_fwrite" permutation_fwrite :: Ptr CChar -> PermHandle -> IO CInt@@ -301,10 +301,10 @@ canonical (P n p) = unsafePerformIO $ do q <- permutation_new (fromIntegral n) q' <- newForeignPtr permutation_free q- err <- withForeignPtr p $ \p' ->+ check "canonical" $+ withForeignPtr p $ \p' -> withForeignPtr q' $ \q'' -> permutation_linear_to_canonical q'' p'- check "canonical" err return (CP n q') -- | convert from canonical to linear@@ -312,10 +312,10 @@ linear (CP n p) = unsafePerformIO $ do q <- permutation_new (fromIntegral n) q' <- newForeignPtr permutation_free q- err <- withForeignPtr p $ \p' ->+ check "linear" $+ withForeignPtr p $ \p' -> withForeignPtr q' $ \q'' -> permutation_canonical_to_linear q'' p'- check "linear" err return (P n q') -- | a count of the inversions@@ -345,34 +345,4 @@ ----------------------------------------------------------------------------- ------------------------------------------------------------------------------------------------------------------------------------------------------------{- copied from hmatrix -}---- GSL error codes are <= 1024--- | error codes for the auxiliary functions required by the wrappers-errorCode :: CInt -> String-errorCode 2000 = "bad size"-errorCode 2001 = "bad function code"-errorCode 2002 = "memory problem"-errorCode 2003 = "bad file"-errorCode 2004 = "singular"-errorCode 2005 = "didn't converge"-errorCode 2006 = "the input matrix is not positive definite"-errorCode 2007 = "not yet supported in this OS"-errorCode n = "code "++show n---- | check the error code-check :: String -> CInt -> IO ()-check msg err = do- when (err/=0) $ if err > 1024- then (error (msg++": "++errorCode err)) -- our errors- else do -- GSL errors- ps <- gsl_strerror err- s <- peekCString ps- error (msg++": "++s)- return ()---- | description of GSL error codes-foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar)- -----------------------------------------------------------------------------