Merge branch 'dev'

Author: andrie

DESCRIPTION

@@ -1,13 +1,13 @@
 Package: AzureML
 Type: Package
-Title: Interface with Azure Machine Learning datasets and web services
+Title: Interface with Azure Machine Learning Datasets, Experiments and Web Services
 Description: Functions and datasets to support Azure Machine Learning. This
     allows you to interact with datasets, as well as publish and consume R functions
     as API services.
-Version: 0.2.9
-Date: 2016-01-28
+Version: 0.2.10
+Date: 2016-01-30
 Authors@R: c(
-      person("Raymond", "Laghaeian", role=c("aut", "cre"), email="raymondl@microsoft.com"),
+      person("Andrie", "de Vries", role=c("aut", "cre"), email="adevries@microsoft.com"),
       person(family="Microsoft Corporation", role="cph"),
       person(family="Revolution Analytics", role="cph", comment="Code adapted from the foreach package")
     )
@@ -30,6 +30,7 @@ Imports:
 Suggests:
     testthat,
     knitr,
+    rmarkdown,
     lme4,
     gbm,
     MASS

NAMESPACE

@@ -42,4 +42,12 @@ importFrom(jsonlite,fromJSON)
 importFrom(jsonlite,toJSON)
 importFrom(miniCRAN,makeRepo)
 importFrom(miniCRAN,pkgDep)
+importFrom(stats,runif)
+importFrom(stats,setNames)
+importFrom(utils,capture.output)
+importFrom(utils,head)
+importFrom(utils,read.table)
+importFrom(utils,str)
+importFrom(utils,write.table)
+importFrom(utils,zip)
 importFrom(uuid,UUIDgenerate)

R/azureml-package.R

@@ -73,4 +73,8 @@
 #' @aliases AzureML
 #' @docType package
 #' @keywords package
+#' 
+#' @importFrom stats runif setNames
+#' @importFrom utils capture.output head read.table str write.table zip
 NULL
+

R/datasets.R

@@ -214,20 +214,20 @@ delete.datasets <- function(ws, name, host){
   h <- new_handle()
   handle_setheaders(h, .list = ws$.headers)
   handle_setopt(h, customrequest = "DELETE")
-  status_code <- vapply(datasets$FamilyId, 
-                        function(familyId){
-                          uri <- sprintf("%s/workspaces/%s/datasources/family/%s", 
-                                         ws$.studioapi,
-                                         curl_escape(ws$id),
-                                         curl_escape(familyId)
-                          )
-                          try_fetch(uri, h)$status_code
-                        }, 1, USE.NAMES = FALSE
-  )
+  delete_one <- function(familyId){
+    uri <- sprintf("%s/workspaces/%s/datasources/family/%s", 
+                   ws$.studioapi,
+                   curl_escape(ws$id),
+                   curl_escape(familyId)
+    )
+    z <- try_fetch(uri, h, tries = 3, delay = 2)
+    z$status_code
+  }
+  status_code <- vapply(datasets$FamilyId, delete_one, FUN.VALUE = numeric(1), USE.NAMES = FALSE)
   ans = data.frame(
-    Name = datasets$Name, 
-    Deleted=status_code < 300, 
-    status_code=status_code,
+    Name        = datasets$Name, 
+    Deleted     = status_code < 300, 
+    status_code = status_code,
     stringsAsFactors = FALSE
   )
   refresh(ws, "datasets")

R/fetch.R

@@ -61,27 +61,27 @@ validate_response <- function(r){
   }
 }
 
-#' Try to fetch a uri/handle, retrying on certain returned status codes after a timeout.
-#' 
-#' @param uri the uri to fetch
-#' @param handle a curl handle
-#' @param retry_on HTTP status codes that result in retry
-#' @param tries number of tries before failing
-#' @param delay in seconds between retries, subject to exponent
-#' @param exponent increment each successive delay by delay^exponent
-#' @param no_message_threshold Only show messages if delay is greater than this limit
-#' 
-#' @keywords Internal
-#' @return the result of curl_fetch_memory(uri, handle)
-#' 
+# Try to fetch a uri/handle, retrying on certain returned status codes after a timeout.
+# 
+# @param uri the uri to fetch
+# @param handle a curl handle
+# @param retry_on HTTP status codes that result in retry
+# @param tries number of tries before failing
+# @param delay in seconds between retries, subject to exponent
+# @param exponent increment each successive delay by delay^exponent
+# @param no_message_threshold Only show messages if delay is greater than this limit
+# 
+# @keywords Internal
+# @return the result of curl_fetch_memory(uri, handle)
+# 
 try_fetch <- function(uri, handle, 
                       retry_on = c(400, 401, 440, 503, 504, 509), 
                       tries = 6, 
                       delay = 1, exponent = 2,
                       no_message_threshold = 1)
 {
   collisions = 1
-  while(collisions < tries) {
+  while(collisions < (tries + 1)) {
     r = curl_fetch_memory(uri, handle)
     if(!(r$status_code %in% retry_on)) {
       validate_response(r)

R/internal.R

@@ -28,13 +28,13 @@ urlconcat <- function(a,b)
   ans
 }
 
-#' Internal function that retrieves datasets.
-#'
-#' @param ws A workspace object
-#' @return a data.frame
+# Internal function that retrieves datasets.
+#
+# @param ws A workspace object
+# @return a data.frame
 #' @importFrom curl handle_setheaders curl new_handle
 #' @importFrom jsonlite fromJSON
-#' @keywords Internal
+# @keywords Internal
 get_datasets <- function(ws) {
   h = new_handle()
   handle_setheaders(h, .list = ws$.headers)
@@ -78,13 +78,13 @@ convertToDate <- function(x) {
 }
 
 
-#' Internal function that retrieves experiments.
-#'
-#' @param ws A workspace object
-#' @return a data.frame
+# Internal function that retrieves experiments.
+#
+# @param ws A workspace object
+# @return a data.frame
 #' @importFrom curl handle_setheaders curl new_handle
 #' @importFrom jsonlite fromJSON
-#' @keywords Internal
+# @keywords Internal
 get_experiments <- function(ws) {
   h = new_handle()
   handle_setheaders(h, .list=ws$.headers)
@@ -108,16 +108,16 @@ get_experiments <- function(ws) {
   x
 }
 
-#' Internal function that retrieves a dataset from AzureML.
-#'
-#' @param x a list or data.frame with \code{DownloadLocation} and \code{DataTypeId} fields
-#' @param h optional curl handle
-#' @param quote passed to \code{\link[utils]{read.table}}
-#' @param ... additional parameters to pass to \code{read.table}
-#' @return a data.frame
+# Internal function that retrieves a dataset from AzureML.
+#
+# @param x a list or data.frame with \code{DownloadLocation} and \code{DataTypeId} fields
+# @param h optional curl handle
+# @param quote passed to \code{\link[utils]{read.table}}
+# @param ... additional parameters to pass to \code{read.table}
+# @return a data.frame
 #' @importFrom foreign read.arff
 #' @importFrom curl new_handle curl
-#' @keywords Internal
+# @keywords Internal
 get_dataset <- function(x, h, quote = "\"", ...) {
   # Set default stringsAsFactors to FALSE, but allow users to override in ...
   # Restore the option on function exit.
@@ -153,16 +153,17 @@ zipAvailable <- function(){
 
 zipNotAvailableMessage = "Requires external zip utility. Please install zip, ensure it's on your path and try again."
 
-#' Package a Function and Dependencies into an Environment
-#'
-#' @param exportenv R environment to package
-#' @param packages a character vector of required R package dependencies
-#' @param version optional R version
-#' @return A base64-encoded zip file containing the saved 'exportenv' environment
+
+# Package a Function and Dependencies into an Environment
+#
+# @param exportenv R environment to package
+# @param packages a character vector of required R package dependencies
+# @param version optional R version
+# @return A base64-encoded zip file containing the saved 'exportenv' environment
 #' @import codetools
 #' @importFrom base64enc base64encode
 #' @importFrom miniCRAN makeRepo pkgDep
-#' @keywords Internal
+# @keywords Internal
 packageEnv <- function(exportenv, packages=NULL, version="3.1.0") {
   if(!zipAvailable()) stop(zipNotAvailableMessage)
   if(!is.null(packages)) assign("..packages", packages, envir=exportenv)

R/methods.R

@@ -110,7 +110,7 @@ print.Datasets <- function(x, ...)
 str.Workspace <- function(object, ...){
   NextMethod(object)
   cat("list with elements:\n")
-  cat(ls(ws, all.names = TRUE))
+  cat(ls(object, all.names = TRUE))
   cat("\n\n")
   cat("Values:\n")
   cat("$ id :", object$id, "\n")

R/publish.R

@@ -27,12 +27,12 @@
 
 wrapper = "inputDF <- maml.mapInputPort(1)\nload('src/env.RData')\n if(!is.null(exportenv$..packages))\n {\n install.packages(exportenv$..packages, repos=paste('file:///',getwd(),'/src/packages',sep=''), lib=getwd());.libPaths(new=getwd())\n lapply(exportenv$..packages, require, quietly=TRUE, character.only=TRUE)}\nparent.env(exportenv) = globalenv()\n\nattach(exportenv, warn.conflicts=FALSE)\nif(..data.frame){outputDF <- data.frame(..fun(inputDF)); colnames(outputDF) <- ..output_names} else{outputDF <- matrix(nrow=nrow(inputDF), ncol=length(..output_names)); colnames(outputDF) <- ..output_names; outputDF <- data.frame(outputDF); for(j in 1:nrow(inputDF)){outputDF[j, ] <- do.call('..fun', as.list(inputDF[j,]))}}\nmaml.mapOutputPort(\"outputDF\")"
 
-#' Test the AzureML wrapper locally
-#' @param inputDF data frame
-#' @param wrapper the AzureML R wrapper code
-#' @param fun a function to test
-#' @param output_names character vector of function output names
-#' @param data.frame i/o format
+# Test the AzureML wrapper locally
+# @param inputDF data frame
+# @param wrapper the AzureML R wrapper code
+# @param fun a function to test
+# @param output_names character vector of function output names
+# @param data.frame i/o format
 test_wrapper <- function(inputDF, wrapper, fun, output_names, `data.frame`)
 {
   exportenv = new.env()

R/workspace.R

@@ -64,15 +64,14 @@ default_api <- function(api_endpoint = "https://studioapi.azureml.net"){
 #' Workspace ID
 #' 
 #' \if{html}{\figure{workspace_id.png}{options: width="60\%" alt="Figure: workspace_id.png"}}
+#' \if{latex}{\figure{workspaceId.pdf}{options: width=7cm}}
 #' 
 #' 
 #' 
 #' Authorization token
 #' 
 #' \if{html}{\figure{authorization_token.png}{options: width="60\%" alt="Figure: authorization_token.png"}}
-#' 
-#' 
-# \if{latex}{\figure{mai.pdf}{options: width=7cm}}
+#' \if{latex}{\figure{authorizationToken.pdf}{options: width=7cm}}
 #'
 #' @section Using a \code{settings.json} file:
 #'  If any of the \code{id}, \code{auth}, \code{api_endpoint} or \code{management_endpoint} arguments are missing, the function attempts to read values from the \code{config} file with JSON format:
@@ -89,8 +88,8 @@ default_api <- function(api_endpoint = "https://studioapi.azureml.net"){
 #' 
 #' @param id Optional workspace id from ML studio -> settings -> WORKSPACE ID. See the section "Finding your AzureML credentials" for more details.
 #' @param auth Optional authorization token from ML studio -> settings -> AUTHORIZATION TOKENS. See the section "Finding your AzureML credentials" for more details.
-#' @param api_endpoint Optional AzureML API web service URI. Defaults to \url{https://studioap.azureml.net} if not provided and not specified in config.  See note.
-#' @param management_endpoint Optional AzureML management web service URI. Defaults to \url{https://management.azureml.net} if not provided and not specified in config.  See note.
+#' @param api_endpoint Optional AzureML API web service URI. Defaults to \code{https://studioap.azureml.net} if not provided and not specified in config.  See note.
+#' @param management_endpoint Optional AzureML management web service URI. Defaults to \code{https://management.azureml.net} if not provided and not specified in config.  See note.
 #' @param config Optional settings file containing id and authorization info. Used if any of the other arguments are missing. The default config file is \code{~/.azureml/settings.json}, but you can change this location by setting \code{options(AzureML.config = "newlocation")}. See the section "Using a settings.json file" for more details.
 #' @param ... ignored
 #' @param .validate If TRUE, makes a request to the AzureML API to retrieve some data. This validates whether the workspace id and authorization token are valid. Specifically, the function calls \code{\link{datasets}}. This should normally be set to TRUE. Set this to FALSE for testing, or if you know that your credentials are correct and you don't want to retrieve the datasets.