Add support for interacting with Remote R sessions

RProvider.sln

@@ -39,6 +39,7 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "content", "content", "{33FD
 		docs\content\plugins.md = docs\content\plugins.md
 		docs\content\reading-rdata.fsx = docs\content\reading-rdata.fsx
 		docs\content\Statistics-QuickStart.fsx = docs\content\Statistics-QuickStart.fsx
+		docs\content\tutorial-RemoteR.fsx = docs\content\tutorial-RemoteR.fsx
 		docs\content\tutorial.fsx = docs\content\tutorial.fsx
 		docs\content\whatwhy.md = docs\content\whatwhy.md
 	EndProjectSection

docs/content/tutorial-RemoteR.fsx

@@ -0,0 +1,113 @@
+(*** hide ***)
+// Include the right directories so that the documentation tool tips work
+#nowarn "211" // Ignore warning that a search path does not exist on #I
+#I "../../packages/FSharp.Data.1.1.10/lib/net40/"
+#I "../../bin/"
+
+(** 
+# RemoteR Provider Tutorial
+
+## Referencing the provider
+
+In order to use the RemoteR provider, you need to reference the `RDotNet.dll` library
+(which is a .NET connector for R) and the `RProvider.dll` itself. For this tutorial,
+we use `open` to reference a number of packages including `stats`, `tseries` and `zoo`:
+*)
+#I "../packages/RProvider.1.0.3/lib"
+#r "RDotNet.dll"
+#r "RDotNet.FSharp.dll"
+#r "RDotNet.NativeLibrary.dll"
+#r "RProvider.dll"
+#r "RProvider.Runtime.dll"
+
+open RDotNet
+open RProvider
+
+open System
+open System.Net
+
+type RRSession = RemoteR<"localhost", 8888, false>
+let RR = new RRSession()
+
+(**
+If either of the namespaces above are unrecognized, you need to install the package in R
+using `install.packages("stats")`.
+
+## Obtaining data
+
+In this tutorial, we use [F# Data](http://fsharp.github.io/FSharp.Data/) to access stock
+prices from the Yahoo Finance portal. For more information, see the documentation for the
+[CSV type provider](http://fsharp.github.io/FSharp.Data/library/CsvProvider.html).
+
+The following snippet uses the CSV type provider to generate a type `Stocks` that can be
+used for parsing CSV data from Yahoo. Then it defines a function `getStockPrices` that returns
+array with prices for the specified stock and a specified number of days:
+*)
+#r "FSharp.Data.dll"
+open FSharp.Data
+
+type Stocks = CsvProvider<"http://ichart.finance.yahoo.com/table.csv?s=SPX">
+
+/// Returns prices of a given stock for a specified number 
+/// of days (starting from the most recent)
+let getStockPrices stock count =
+  let url = "http://ichart.finance.yahoo.com/table.csv?s="
+  [| for r in Stocks.Load(url + stock).Take(count).Data -> float r.Open |] 
+  |> Array.rev
+
+/// Get opening prices for MSFT for the last 255 days
+let msftOpens = getStockPrices "MSFT" 255
+
+(**
+## Calling R functions
+
+Now, we're ready to call R functions using the type provider. The following snippet takes
+`msftOpens`, calculates logarithm of the values using `R.log` and then calculates the 
+differences of the resulting vector using `R.diff`:
+*)
+
+// Retrieve stock price time series and compute returns
+let msft = msftOpens |> RR.``base``.log |> RR.``base``.diff
+
+
+(**
+If you want to see the resulting values, you can call `msft.AsVector()` in F# Interactive.
+Next, we use the `acf` function to display the atuo-correlation and call `adf_test` to
+see if the `msft` returns are stationary/non-unit root:
+*)
+
+let a = RR.stats.acf(msft)
+let adf = RR.tseries.adf_test(msft) 
+
+(**
+After running the first snippet, a window similar to the following should appear (note that
+it might not appear as a top-most window).
+
+<div style="text-align:center">
+<img src="images/acf.png" />
+</div>
+
+Finally, we can obtain data for multiple different indicators and use the `R.pairs` function
+to produce a matrix of scatter plots:
+*)
+
+// Build a list of tickers and get diff of logs of prices for each one
+let tickers = 
+  [ "MSFT"; "AAPL"; "X"; "VXX"; "SPX"; "GLD" ]
+let data =
+  [ for t in tickers -> 
+      printfn "got one!"
+      t, getStockPrices t 255 |> RR.``base``.log |> RR.``base``.diff ]
+
+// Create an R data frame with the data and call 'R.pairs'
+let df = RR.``base``.data_frame(namedParams data)
+RR.graphics.pairs(df)
+
+(**
+As a result, you should see a window showing results similar to these:
+
+<div style="text-align:center">
+<img src="images/pairs.png" />
+</div>
+
+*)

src/RProvider/RInterop.fs

@@ -312,6 +312,9 @@ module RDotNetExtensions =
 
 /// [omit]
 module RInterop =
+    type StringLiteral(value:string) = 
+        member this.value = value
+
     type RValue =
         | Function of RParameter list * HasVarArgs
         | Value
@@ -342,26 +345,38 @@ module RInterop =
             printfn "Ignoring name %s of type %s" name something
             RValue.Value      
 
-    let getPackages() : string[] =
+    let getPackages_ (eval: string -> SymbolicExpression) : string[] =
         eval(".packages(all.available=T)").GetValue()
 
-    let getPackageDescription packageName: string = 
+    let getPackages() : string[] =
+        getPackages_ eval
+
+    let getPackageDescription_ (eval: string -> SymbolicExpression) packageName : string =
         eval("packageDescription(\"" + packageName + "\")$Description").GetValue()
+
+    let getPackageDescription packageName: string = 
+        getPackageDescription_ eval packageName
 
-    let getFunctionDescriptions packageName : Map<string, string> =
+    let getFunctionDescriptions_ (exec: string -> unit) (eval: string -> SymbolicExpression) packageName : Map<string, string> =
         exec <| sprintf """rds = readRDS(system.file("Meta", "Rd.rds", package = "%s"))""" packageName
         Map.ofArray <| Array.zip ((eval "rds$Name").GetValue()) ((eval "rds$Title").GetValue())
 
+    let getFunctionDescriptions packageName : Map<string, string> =
+        getFunctionDescriptions_ exec eval packageName
+
     let private packages = System.Collections.Generic.HashSet<string>()
 
-    let loadPackage packageName : unit =
+    let loadPackage_ (eval: string -> SymbolicExpression) (packages: System.Collections.Generic.HashSet<string>) packageName : unit =
         if not(packages.Contains packageName) then
             if not(eval("require(" + packageName + ")").GetValue()) then
                 failwithf "Loading package %s failed" packageName
             packages.Add packageName |> ignore
 
+    let loadPackage packageName : unit =
+        loadPackage_ eval packages packageName
+
     [<Literal>]
-    let internal getBindingsDefn = """function (pkgName) {
+    let getBindingsDefn = """function (pkgName) {
     require(pkgName, character.only=TRUE)
     pkgListing <- ls(paste("package:",pkgName,sep=""))
     lapply(
@@ -377,11 +392,15 @@ module RInterop =
         }
     )
 }"""
+
+    let getBindingsFromR_ evalTo eval =
+        let symbolName = getNextSymbolName()
+        evalTo (getBindingsDefn.Replace("\r","")) symbolName
+        fun packageName -> eval (sprintf "%s('%s')" symbolName packageName)
+
     let internal getBindingsFromR =
         lazy
-            let symbolName = getNextSymbolName()
-            evalTo (getBindingsDefn.Replace("\r", "")) symbolName
-            fun (packageName) -> eval (sprintf "%s('%s')" symbolName packageName)
+            getBindingsFromR_ evalTo eval
 
     let internal bindingInfoFromR (bindingEntry: GenericVector) =
         let entryList = bindingEntry.AsList()
@@ -411,51 +430,59 @@ module RInterop =
                 RValue.Value
         name, value
 
-    let getBindings packageName : Map<string, RValue> =
+    let getBindings_ (getBindingsFromR: string -> SymbolicExpression) packageName : Map<string, RValue> =
         // TODO: Maybe get these from the environments?
-        let bindings = getBindingsFromR.Value packageName
+        let bindings = getBindingsFromR packageName
         [| for entry in bindings.AsList() -> entry.AsList() |]
         |> Array.map (fun (entry: GenericVector) -> bindingInfoFromR entry)
         |> Map.ofSeq
 
-    let callFunc (packageName: string) (funcName: string) (argsByName: seq<KeyValuePair<string, obj>>) (varArgs: obj[]) : SymbolicExpression =
-            // We make sure we keep a reference to any temporary symbols until after exec is called, 
-            // so that the binding is kept alive in R
-            // TODO: We need to figure out how to unset the symvol
-            let tempSymbols = System.Collections.Generic.List<string * SymbolicExpression>()
-            let passArg (arg: obj) : string = 
-                match arg with
-                    | :? Missing            -> failwithf "Cannot pass Missing value"
-                    | :? int | :? double    -> arg.ToString()
-                    //  This doesn't handle escaping so we fall through to using toR 
-                    //| :? string as sval     -> "\"" + sval + "\""
-                    | :? bool as bval       -> if bval then "TRUE" else "FALSE"
-                    // We allow pairs to be passed, to specify parameter name
-                    | _ when arg.GetType().IsConstructedGenericType && arg.GetType().GetGenericTypeDefinition() = typedefof<_*_> 
-                                            -> match FSharpValue.GetTupleFields(arg) with
-                                               | [| name; value |] when name.GetType() = typeof<string> ->
-                                                    let name = name :?> string
-                                                    tempSymbols.Add(name, engine.Value.SetValue(value, name))
-                                                    name
-                                               | _ -> failwithf "Pairs must be string * value"
-                    | _                     -> let sym,se = toR arg
-                                               tempSymbols.Add(sym, se)
-                                               sym
+    let getBindings packageName : Map<string, RValue> =
+        getBindings_ getBindingsFromR.Value packageName
+
+    // Generic implementation of callFunc so that the function can be reused for differing symbol return types    
+    let callFunc_<'TExpr> (eval: string -> 'TExpr) (packageName: string) (funcName: string) (argsByName: seq<KeyValuePair<string, obj>>) (varArgs: obj[]) : 'TExpr =
+        // We make sure we keep a reference to any temporary symbols until after exec is called, 
+        // so that the binding is kept alive in R
+        // TODO: We need to figure out how to unset the symvol
+        let tempSymbols = System.Collections.Generic.List<string * SymbolicExpression>()
+        let passArg (arg: obj) : string = 
+            match arg with
+                | :? Missing            -> failwithf "Cannot pass Missing value"
+                | :? int | :? double    -> arg.ToString()
+                //  This doesn't handle escaping so we fall through to using toR 
+                //| :? string as sval     -> "\"" + sval + "\""
+                | :? StringLiteral as sval -> sval.value
+                | :? bool as bval       -> if bval then "TRUE" else "FALSE"
+                // We allow pairs to be passed, to specify parameter name
+                | _ when arg.GetType().IsConstructedGenericType && arg.GetType().GetGenericTypeDefinition() = typedefof<_*_> 
+                                        -> match FSharpValue.GetTupleFields(arg) with
+                                           | [| name; value |] when name.GetType() = typeof<string> ->
+                                                let name = name :?> string
+                                                tempSymbols.Add(name, engine.Value.SetValue(value, name))
+                                                name
+                                           | _ -> failwithf "Pairs must be string * value"
+                | _                     -> let sym,se = toR arg
+                                           tempSymbols.Add(sym, se)
+                                           sym
 
-            let argList = [|
-                // Pass the named arguments as name=val pairs
-                for kvp in argsByName do
-                    if not(kvp.Value = null || kvp.Value :? Missing) then
-                        yield kvp.Key + "=" + passArg kvp.Value
-
-                // Now yield any varargs
-                if varArgs <> null then
-                    for argVal in varArgs -> 
-                        passArg argVal
-            |]
-
-            let expr = sprintf "%s::`%s`(%s)" packageName funcName (String.Join(", ", argList))
-            eval expr
+        let argList = [|
+            // Pass the named arguments as name=val pairs
+            for kvp in argsByName do
+                if not(kvp.Value = null || kvp.Value :? Missing) then
+                    yield kvp.Key + "=" + passArg kvp.Value
+
+            // Now yield any varargs
+            if varArgs <> null then
+                for argVal in varArgs -> 
+                    passArg argVal
+        |]
+
+        let expr = sprintf "%s::`%s`(%s)" packageName funcName (String.Join(", ", argList))
+        eval expr
+
+    let callFunc (packageName: string) (funcName: string) (argsByName: seq<KeyValuePair<string, obj>>) (varArgs: obj[]) : SymbolicExpression =
+        callFunc_ eval packageName funcName argsByName varArgs
 
     /// Turn an `RValue` (which captures type information of a value or function)
     /// into a serialized string that can be spliced in a quotation 
@@ -472,8 +499,9 @@ module RInterop =
       else 
         let hasVar = match serialized.[0] with '1' -> true | '0' -> false | _ -> invalidArg "serialized" "Should start with a flag"
         RValue.Function(List.ofSeq (serialized.Substring(1).Split(';')), hasVar)
-
-    let call (packageName: string) (funcName: string) (serializedRVal:string) (namedArgs: obj[]) (varArgs: obj[]) : SymbolicExpression =
+
+    // Generic implementation of call so that the function can be reused for differing symbol return types
+    let call_<'TExpr> (eval: string -> 'TExpr) (packageName: string) (funcName: string) (serializedRVal: string) (namedArgs: obj[]) (varArgs: obj[]) : 'TExpr =
         //loadPackage packageName
 
         match deserializeRValue serializedRVal with
@@ -486,11 +514,14 @@ module RInterop =
                 failwithf "Function %s expects %d named arguments and you supplied %d" funcName namedArgCount namedArgs.Length 
 *)            
             let argsByName = seq { for n,v in Seq.zip argNames namedArgs -> KeyValuePair(n, v) }
-            callFunc packageName funcName argsByName varArgs
+            callFunc_ eval packageName funcName argsByName varArgs
 
         | RValue.Value ->
             let expr = sprintf "%s::%s" packageName funcName
             eval expr
+
+    let call (packageName: string) (funcName: string) (serializedRVal:string) (namedArgs: obj[]) (varArgs: obj[]) : SymbolicExpression =
+        call_ eval packageName funcName serializedRVal namedArgs varArgs
 
     /// Convert a value to a value in R.
     /// Generally you shouldn't use this function - it is mainly for testing.
@@ -530,4 +561,4 @@ type REnv(fileName:string) =
   /// (This is equivalent to calling `R.ls` function)
   member x.Keys = 
     let ls = RInterop.callFunc "base" "ls" (namedParams ["envir", box env]) [||]
-    ls.GetValue<string[]>()  
+    ls.GetValue<string[]>()  

src/RProvider/RInteropClient.fs

@@ -59,4 +59,15 @@ module internal RInteropClient =
     let withServer f =
         lock serverlock <| fun () ->
         let server = GetServer()
-        f server
+        f server
+
+    let mutable localServerInstance = None
+    let withLocalServer f =
+        lock serverlock <| fun () ->
+        let server = match localServerInstance with
+                        | Some s -> s
+                        | _ ->
+                            let s = new RInteropServer()
+                            localServerInstance <- Some s
+                            s
+        f server