--- title: "Calling a Haskell function in R - a float expansion example" date: "2016-08-11" output: html_document: highlight: pygments --- ***(latest update : r Sys.time())***
{r setup, include=FALSE} # use highlight: pygments knitr::opts_chunk$set(echo = TRUE, collapse=TRUE) ghc.path <- "/opt/ghc/7.10.3/bin" Sys.setenv(PATH = paste0(Sys.getenv()["PATH"], ":", ghc.path))  In [the previous article](http://stla.github.io/stlapblog/posts/DyadicExpansion.html), I wrote a R function returning the binary expansion of a real number$u \in [0,1]$. In the present article, I will: - write a similar function in Haskell; - write this function in a way compatible with R, inside a module; - compile this module in a dynamic linker suitable for R (dll with Windows, so with Linux); - call the function from R through the dynamic linker. The creation of a Haskell function compatible with R is allowed by the [Foreign Function Interface (FFI)](https://wiki.haskell.org/Foreign_Function_Interface), in other words the Foreign module. I learnt how to do such things with the help of [this blog post by Neil Mitchell](http://neilmitchell.blogspot.be/2011/10/calling-haskell-from-r.html). ## Binary (and more) expansion in Haskell Let's go to Haskell. The floatExpansion function below is obtained by a small modification of the floatToDigits function of the Numeric package. It returns the expansion of a real number$u \in [0,1]$in a given integer base. {r, engine='haskell', engine.path='ghc'} import Numeric let floatExpansion :: RealFloat a => Integer -> a -> [Int]; floatExpansion base u = replicate (- snd expansion) 0 ++ fst expansion where expansion = floatToDigits base u floatExpansion 2 0.125  ## First dynamic linker: string output Firstly, I show how to make this function compatible with R when its output is a string instead of a list. It is easy to convert a list to a string in Haskell: {r, engine='haskell', engine.path='ghc'} show [0, 0, 1]  To get the output as a vector in R, more work is needed, and I will do it in the next section. ### Make the function compatible with R To make the function compatible with R, there are two rules: - Every argument must be a pointer (Ptr) to a C compatible type: CInt, CDouble or CString. - The result must be IO (). A value of type Ptr represents a pointer to an object. This type is provided by the [Foreign.Ptr module](https://hackage.haskell.org/package/base-4.9.0.0/docs/Foreign-Ptr.html), which is imported via the Foreign module. The types CInt, CDouble and CString are provided by the [Foreign.C module](https://hackage.haskell.org/package/base-4.9.0.0/docs/Foreign-C.html). We end up with this module: haskell -- FloatExpansionString.hs {-# LANGUAGE ForeignFunctionInterface #-} module FloatExpansion where import Foreign import Foreign.C import Numeric foreign export ccall floatExpansionR :: Ptr CInt -> Ptr CDouble -> Ptr CString -> IO () floatExpansionR :: Ptr CInt -> Ptr CDouble -> Ptr CString -> IO () floatExpansionR base u result = do base <- peek base u <- peek u expansion <- newCString$ show $floatExpansion (toInteger base) u poke result$ expansion floatExpansion :: RealFloat a => Integer -> a -> [Int] floatExpansion base u = replicate (- snd expansion) 0 ++ fst expansion where expansion = floatToDigits base u  ### Compilation We need the following C file to do the compilation, as explained in the [GHC users guide](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/win32-dlls.html#making-dlls-to-be-called-from-other-languages). c // StartEnd.c #include void HsStart() { int argc = 1; char* argv[] = {"ghcDll", NULL}; // argv must end with NULL // Initialize Haskell runtime char** args = argv; hs_init(&argc, &args); } void HsEnd() { hs_exit(); }  Then we compile the library with the command: bash ghc -shared -fPIC -dynamic -lHSrts-ghc7.10.3 FloatExpansionString.hs StartEnd.c -o FloatExpansionString.so  This creates the dynamic linker FloatExpansionString.so. ### Call in R We firstly load the library with: {r} dyn.load("FloatExpansionString.so") .C("HsStart")  And we invoke the function with the help of the .C function, as follows: {r} .C("floatExpansionR", base=2L, x=0.125, result="")$result  It works. But it would be better to have a vector as output. ## Second dynamic linker: vector output To get the output as a vector, the additional modules we need are: Foreign.R, Foreign.R.Types and Data.Vector.SEXP. They are provided by the [inline-r package](https://hackage.haskell.org/package/inline-r). The [Int] type of the output list of the floatExpansion function must be converted to [Int32]. We write a simple function intToInt32 to help us to do the conversion. It works with the help of the Data.Int module which is imported via the Foreign module. We end up with this module: haskell -- FloatExpansion.hs {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE DataKinds #-} module FloatExpansion where import Foreign import Foreign.C import Foreign.R (SEXP) import qualified Foreign.R.Type as R import qualified Data.Vector.SEXP as DV import Numeric foreign export ccall floatExpansionR :: Ptr CInt -> Ptr CDouble -> Ptr (SEXP s R.Int) -> IO () floatExpansionR :: Ptr CInt -> Ptr CDouble -> Ptr (SEXP s R.Int) -> IO () floatExpansionR base u result = do base <- peek base u <- peek u let expansion = map intToInt32$ floatExpansion (toInteger base) u poke result $DV.toSEXP$ DV.fromList expansion intToInt32 :: Int -> Int32 intToInt32 i = fromIntegral (i :: Int) :: Int32 floatExpansion :: RealFloat a => Integer -> a -> [Int] floatExpansion base u = replicate (- snd expansion) 0 ++ fst expansion where expansion = floatToDigits base u  We compile the library as before. And we load it in R as before: {r} dyn.load("FloatExpansion.so") .C("HsStart")  And we invoke the function with the help of the .C function, as follows: {r} .C("floatExpansionR", base=2L, x=0.125, result=list(0L))$result  In fact, the output is a list with one element, the desired vector. Let's write a user-friendly function: {r} floatExpand <- function(x, base=2L){ .C("floatExpansionR", base=as.integer(base), x=as.double(x), result=list(integer(1)))$result[[1]] }  `{r, include=FALSE} num2dyadic <- function(u, nmax=1024L){ out <- integer(nmax) i <- j <- 0L while(u>0 && i