From ceb049de0898a2cc58fac8191a049e65bad7a2f6 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Tue, 19 Oct 2010 18:03:46 +0000 Subject: complex dilogarithm --- packages/special/lib/Numeric/GSL/Special/Dilog.hs | 15 +++++++++------ packages/special/lib/Numeric/GSL/Special/Internal.hsc | 15 ++++++++++++++- packages/special/lib/Numeric/GSL/Special/auto.hs | 16 +++++++++++++--- 3 files changed, 36 insertions(+), 10 deletions(-) (limited to 'packages/special/lib/Numeric') diff --git a/packages/special/lib/Numeric/GSL/Special/Dilog.hs b/packages/special/lib/Numeric/GSL/Special/Dilog.hs index 48b548b..6aa58c4 100644 --- a/packages/special/lib/Numeric/GSL/Special/Dilog.hs +++ b/packages/special/lib/Numeric/GSL/Special/Dilog.hs @@ -15,6 +15,9 @@ module Numeric.GSL.Special.Dilog( dilog_e , dilog +, complex_dilog_xy_e +, complex_dilog_e +, complex_spence_xy_e ) where import Foreign(Ptr) @@ -29,14 +32,14 @@ dilog :: Double -> Double dilog = gsl_sf_dilog foreign import ccall SAFE_CHEAP "gsl_sf_dilog" gsl_sf_dilog :: Double -> Double -complex_dilog_xy_e :: Double -> Double -> Ptr () -> (Double,Double) -complex_dilog_xy_e x y result_re = createSFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y result_re +complex_dilog_xy_e :: Double -> Double -> ((Double,Double),(Double,Double)) +complex_dilog_xy_e x y = create2SFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_xy_e" gsl_sf_complex_dilog_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt -complex_dilog_e :: Double -> Double -> Ptr () -> (Double,Double) -complex_dilog_e r theta result_re = createSFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta result_re +complex_dilog_e :: Double -> Double -> ((Double,Double),(Double,Double)) +complex_dilog_e r theta = create2SFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_e" gsl_sf_complex_dilog_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt -complex_spence_xy_e :: Double -> Double -> Ptr () -> (Double,Double) -complex_spence_xy_e x y real_sp = createSFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y real_sp +complex_spence_xy_e :: Double -> Double -> ((Double,Double),(Double,Double)) +complex_spence_xy_e x y = create2SFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y foreign import ccall SAFE_CHEAP "gsl_sf_complex_spence_xy_e" gsl_sf_complex_spence_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt diff --git a/packages/special/lib/Numeric/GSL/Special/Internal.hsc b/packages/special/lib/Numeric/GSL/Special/Internal.hsc index 68ec2f2..d1a9c57 100644 --- a/packages/special/lib/Numeric/GSL/Special/Internal.hsc +++ b/packages/special/lib/Numeric/GSL/Special/Internal.hsc @@ -20,6 +20,7 @@ Support for Special functions. module Numeric.GSL.Special.Internal ( createSFR, + create2SFR, createSFR_E10, Precision(..), Gsl_mode_t, @@ -79,7 +80,7 @@ instance Storable Gsl_sf_result_e10 where ---------------------------------------------------------------- --- | access to a sf_result +-- | access to one sf_result createSFR :: String -> (Ptr a -> IO CInt) -> (Double, Double) createSFR s f = unsafePerformIO $ do p <- malloc :: IO (Ptr Gsl_sf_result) @@ -88,6 +89,18 @@ createSFR s f = unsafePerformIO $ do free p return (val,err) +---------------------------------------------------------------- +-- | access to two sf_result +create2SFR :: String -> (Ptr a -> Ptr a -> IO CInt) -> ((Double, Double),(Double, Double)) +create2SFR s f = unsafePerformIO $ do + p1 <- malloc :: IO (Ptr Gsl_sf_result) + p2 <- malloc :: IO (Ptr Gsl_sf_result) + f (castPtr p1) (castPtr p2) // check s + SF val1 err1 <- peek p1 + SF val2 err2 <- peek p2 + free p1 + free p2 + return ((val1,err1),(val2,err2)) --------------------------------------------------------------------- -- the sf_result_e10 contains two doubles and the exponent diff --git a/packages/special/lib/Numeric/GSL/Special/auto.hs b/packages/special/lib/Numeric/GSL/Special/auto.hs index b46e6c6..b6276b2 100644 --- a/packages/special/lib/Numeric/GSL/Special/auto.hs +++ b/packages/special/lib/Numeric/GSL/Special/auto.hs @@ -31,7 +31,8 @@ fixlong (x:xs) = x : fixlong xs safe (Header _ _ args) = all ok args - || all ok (init args) && kn (last args) + || all ok (init args) && kn (last args) + || length args >= 2 && all ok (init (init args)) && kn (last args) && kn (last (init args)) where ok ((Normal s),_) | s `elem` ["double","float","int","gsl_mode_t"] = True ok _ = False kn ((Pointer "gsl_sf_result"),_) = True @@ -206,7 +207,9 @@ showFull hc h@(Header t n args) = -- "\n-- | wrapper for "++showC h fixmd1 = rep ("Gsl_mode_t","Precision") fixmd2 = rep ("mode"," (precCode mode)") -boiler h@(Header t n args) | fst (last args) == Pointer "gsl_sf_result" = boilerResult h +boiler h@(Header t n args) | fst (last args) == Pointer "gsl_sf_result" + && fst (last (init args)) == Pointer "gsl_sf_result" = boiler2Results h + | fst (last args) == Pointer "gsl_sf_result" = boilerResult h | fst (last args) == Pointer "gsl_sf_result_e10" = boilerResultE10 h | any isMode args = boilerMode h | otherwise = boilerBasic h @@ -223,6 +226,11 @@ boilerResult h@(Header t n args) = hName n ++ " "++ initArgs args ++ " = createSFR \""++ hName n ++"\" $ " ++ n ++ " "++ (fixmd2 $ initArgs args) +boiler2Results h@(Header t n args) = + hName n++" :: "++ (fixmd1 $ concat $ intersperse" -> "$ map showHa (init (init args))) ++" -> " ++ "((Double,Double),(Double,Double))\n" ++ + hName n ++ " "++ init2Args args ++ + " = create2SFR \""++ hName n ++"\" $ " ++ n ++ " "++ (fixmd2 $ init2Args args) + boilerResultE10 h@(Header t n args) = hName n++" :: "++ (fixmd1 $ concat $ intersperse" -> "$ map showHa (init args)) ++" -> " ++ "(Double,Int,Double)\n" ++ hName n ++ " "++ initArgs args ++ @@ -241,4 +249,6 @@ cVar (v:vs) | isUpper v = toLower v : v : vs | otherwise = v:vs allArgs args = unwords (map (cVar.snd) args) -initArgs args = unwords (map (cVar.snd) (init args)) \ No newline at end of file +initArgs args = unwords (map (cVar.snd) (init args)) +init2Args args = unwords (map (cVar.snd) (init $ init args)) + -- cgit v1.2.3