Merge branch 'dev'

.Rbuildignore

@@ -0,0 +1 @@
+Readme.*

DESCRIPTION

@@ -1,9 +1,11 @@
 Package: AzureML
 Type: Package
 Title: Interface with Azure Machine Learning datasets 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.5
-Date: 2015-12-08
+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.6
+Date: 2015-12-18
 Authors@R: c(
       person("Raymond", "Laghaeian", role=c("aut", "cre"), email="[email protected]"),
       person(family="Microsoft Corporation", role="cph"),
@@ -15,17 +17,20 @@ URL: https://github.com/RevolutionAnalytics/AzureML
 BugReports: https://github.com/RevolutionAnalytics/AzureML/issues
 LazyData: TRUE
 VignetteBuilder: knitr
-SystemRequirements: Requires external zip utility, available in path. On windows, it's sufficient to install RTools.
+SystemRequirements: Requires external zip utility, available in path. On
+    windows, it's sufficient to install RTools.
 Imports:
-    jsonlite(>= 0.9.16), 
-    curl(>= 0.8), 
+    jsonlite(>= 0.9.16),
+    curl(>= 0.8),
     foreign,
     codetools,
     base64enc,
     miniCRAN,
     uuid
 Suggests:
-    testthat, 
-    knitr, 
+    testthat,
+    knitr,
     lme4,
-    gbm
+    gbm,
+    MASS
+RoxygenNote: 5.0.1

NAMESPACE

@@ -1,4 +1,4 @@
-# Generated by roxygen2 (4.1.1): do not edit by hand
+# Generated by roxygen2: do not edit by hand
 
 S3method(print,Datasets)
 S3method(print,Experiments)

R/consume.R

@@ -25,35 +25,36 @@ consume <- function(endpoint, ..., globalParam, retryDelay = 10, output = "outpu
 {
   if(is.Service(endpoint))
   {
-    if(nrow(endpoint) > 1) endpoint = endpoint[1,]
-    default = endpoint$DefaultEndpointName
-    endpoint = endpoints(attr(endpoint, "workspace"), endpoint)
-    endpoint = subset(endpoint, Name=default)
+    if(nrow(endpoint) > 1) endpoint = endpoint[1, ]
+    default <- endpoint$DefaultEndpointName
+    endpoint <- endpoints(attr(endpoint, "workspace"), endpoint)
+    endpoint <- subset(endpoint, Name = default)
   }
 
-  if(!is.Endpoint(endpoint)) stop("Invalid endpoint. Use publishWebservice() or endpoints() to create or obtain a service endpoint.")
+  if(!is.Endpoint(endpoint)) {
+    msg <- "Invalid endpoint. Use publishWebservice() or endpoints() to create or obtain a service endpoint." 
+    stop(msg)
+  }
 
-  apiKey = endpoint$PrimaryKey
-  requestUrl = endpoint$ApiLocation
+  apiKey <- endpoint$PrimaryKey
+  requestUrl <- endpoint$ApiLocation
 
   if(missing(globalParam)) {
     globalParam = setNames(list(), character(0))
   }
   # Store variable number of lists entered as a list of lists
   requestsLists = list(...)
-  if(length(requestsLists)==1 && is.data.frame(requestsLists[[1]]))
-  {
+  if(length(requestsLists)==1 && is.data.frame(requestsLists[[1]])) {
     requestsLists = requestsLists[[1]]
-  } else
-  {
+  } else {
     if(!is.list(requestsLists[[1]])) requestsLists = list(requestsLists)
   }
   # Make API call with parameters
-  result = callAPI(apiKey, requestUrl, requestsLists,  globalParam, retryDelay)
+  result <- callAPI(apiKey, requestUrl, requestsLists,  globalParam, retryDelay)
   if(inherits(result, "error")) stop("AzureML returned error code")
+
   # Access output by converting from JSON into list and indexing into Results
-  if(!is.null(output) && output == "output1") 
-  {
+  if(!is.null(output) && output == "output1") {
     help = endpointHelp(endpoint)$definitions$output1Item
     ans = data.frame(result$Results$output1)
     nums = which("number" == unlist(help)[grepl("\\.type$", names(unlist(help)))])
@@ -62,8 +63,9 @@ consume <- function(endpoint, ..., globalParam, retryDelay = 10, output = "outpu
     if(length(logi) > 0) for(j in logi) ans[,j] = as.logical(ans[,j])
     return(ans)
   }
-  if(!is.null(output) && output == "output2") 
+  if(!is.null(output) && output == "output2") {
     return(fromJSON(result$Results$output2[[1]]))
+  }
   result$Results
 }
 
@@ -84,38 +86,36 @@ consume <- function(endpoint, ..., globalParam, retryDelay = 10, output = "outpu
 #' @importFrom jsonlite toJSON
 #' @importFrom curl handle_setheaders new_handle handle_setopt curl_fetch_memory
 #' @keywords internal
-callAPI <- function(apiKey, requestUrl, keyvalues,  globalParam, retryDelay=10)
-{
+callAPI <- function(apiKey, requestUrl, keyvalues,  globalParam, retryDelay=10) {
   # Set number of tries and HTTP status to 0
-  result = NULL
+  result <- NULL
   # Construct request payload
-  req = list(
+  req <- list(
     Inputs = list(input1 = keyvalues), 
     GlobalParameters = globalParam
   )
-  body = charToRaw(paste(toJSON(req, auto_unbox=TRUE, digits=16), collapse = "\n"))
-  h = new_handle()
-  headers = list(`User-Agent`="R",
-                 `Content-Type`="application/json",
-                 `Authorization`=sprintf("Bearer %s", apiKey))
-  handle_setheaders(h, .list=headers)
+  body <- charToRaw(paste(toJSON(req, auto_unbox=TRUE, digits=16), collapse = "\n"))
+  h <- new_handle()
+  headers <- list(`User-Agent` = "R",
+                 `Content-Type` = "application/json",
+                 `Authorization` = sprintf("Bearer %s", apiKey))
+  handle_setheaders(h, .list = headers)
   handle_setopt(h, .list = list(
-    post=TRUE, 
-    postfieldsize=length(body), 
-    postfields=body)
+    post = TRUE, 
+    postfieldsize = length(body), 
+    postfields = body)
   )
-  r = try_fetch(requestUrl, h, delay=retryDelay)
+  r = try_fetch(requestUrl, h, delay = retryDelay)
   result = fromJSON(rawToChar(r$content))
-  if(r$status_code >= 400)
-  {
+  if(r$status_code >= 400)  {
     stop(paste(capture.output(result), collapse="\n"))
   }
   result
 }
 
 
 
-#' Discover web service schema
+#' Discover web service schema.
 #'
 #' Discover the expected input to a web service specified by a web service ID ng the workspace ID and web service ID, information specific to the consumption functions
 #'
@@ -130,7 +130,9 @@ callAPI <- function(apiKey, requestUrl, keyvalues,  globalParam, retryDelay=10)
 #' 
 #' @family discovery functions
 #' @export
-discoverSchema <- function(helpURL, scheme = "https", host = "ussouthcentral.services.azureml.net", api_version = "2.0")
+discoverSchema <- function(helpURL, scheme = "https", 
+                           host = "ussouthcentral.services.azureml.net", 
+                           api_version = "2.0")
 {
   workspaceId = getDetailsFromUrl(helpURL)[1]
   endpointId = getDetailsFromUrl(helpURL)[3]

R/datasets.R

@@ -95,10 +95,12 @@ download.datasets <- function(source, name, ...)
 #' @export
 #' @family dataset functions
 #' @family experiment functions
-download.intermediate.dataset <- function(ws, experiment, node_id, port_name="Results dataset", data_type_id="GenericCSV", ...)
+download.intermediate.dataset <- function(ws, experiment, node_id, 
+                                          port_name = "Results dataset", 
+                                          data_type_id = "GenericCSV", ...)
 {
   url = sprintf("%s/workspaces/%s/experiments/%s/outputdata/%s/%s",
-                ws$.baseuri, curl_escape(ws$id),
+                ws$.studioapi, curl_escape(ws$id),
                 curl_escape(experiment), curl_escape(node_id),
                 curl_escape(port_name))
   h = new_handle()
@@ -128,7 +130,7 @@ download.intermediate.dataset <- function(ws, experiment, node_id, port_name="Re
 #' @example inst/examples/example_upload.R
 upload.dataset <- function(x, ws, name, description = "", family_id="", ...)
 {
-  if(!is.Workspace(ws)) stop("ws must be a Workspace object")
+  stopIfNotWorkspace(ws)
   if(name %in% datasets(ws)$Name) {
     msg <- sprintf("A dataset with the name '%s' already exists in AzureML", name)
     stop(msg)
@@ -141,7 +143,7 @@ upload.dataset <- function(x, ws, name, description = "", family_id="", ...)
   # Step 1
   tsv = capture.output(write.table(x, file = "", sep = "\t", row.names = FALSE, ...))
   url = sprintf("%s/resourceuploads/workspaces/%s/?userStorage=true&dataTypeId=GenericTSV",
-                ws$.baseuri, curl_escape(ws$id))
+                ws$.studioapi, curl_escape(ws$id))
   h = new_handle()
   hdr = ws$.headers
   hdr["Content-Type"] = "text/plain"
@@ -169,7 +171,7 @@ upload.dataset <- function(x, ws, name, description = "", family_id="", ...)
       ClientPoll =  TRUE), auto_unbox=TRUE)
 
   url = sprintf("%s/workspaces/%s/datasources",
-                ws$.baseuri, curl_escape(ws$id))
+                ws$.studioapi, curl_escape(ws$id))
   handle_reset(h)                               # Preserves connection, cookies
   handle_setheaders(h, .list=ws$.headers)
   body = charToRaw(paste(metadata, collapse="\n"))
@@ -185,6 +187,8 @@ upload.dataset <- function(x, ws, name, description = "", family_id="", ...)
   ws$datasets[ws$datasets$Id == id, ]
 }
 
+
+
 #' Delete datasets from an AzureML workspace.
 #'
 #' @inheritParams refresh
@@ -193,25 +197,28 @@ upload.dataset <- function(x, ws, name, description = "", family_id="", ...)
 #' @return A data frame with columns Name, Deleted, status_code indicating the HTTP status code and success/failure result of the delete operation for each dataset.
 #' @family dataset functions
 #' @export
-delete.datasets <- function(ws, name, host="https://studioapi.azureml.net/api")
-{
+delete.datasets <- function(ws, name, host){
+  stopIfNotWorkspace(ws)
   # https://studioapi.azureml.net/api/workspaces/<workspaceId>/datasources/family/<familyId> HTTP/1.1
-  datasets = name
+  datasets <-  name
   refresh(ws, "datasets")
-  if(!inherits(datasets, "Datasets"))
-  {
-    datasets = datasets(ws)
-    datasets = datasets[datasets$Name %in% name, ]
+  if(!inherits(datasets, "Datasets")){
+    datasets <-  datasets(ws)
+    datasets <-  datasets[datasets$Name %in% name, ]
   }
-  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", host,
-                  curl_escape(ws$id), curl_escape(familyId))
-    try_fetch(uri, h)$status_code
-  }, 1, USE.NAMES=FALSE)
+  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
+  )
   ans = data.frame(
     Name = datasets$Name, 
     Deleted=status_code < 300, 

R/discover.R

@@ -60,9 +60,9 @@
 #' @export
 services <- function(ws, service_id, name, host = ws$.management_endpoint)
 {
-  if(!is.Workspace(ws)) stop("ws must be an AzureML Workspace object")
-  h = new_handle()
-  headers = list(`User-Agent`="R",
+  stopIfNotWorkspace(ws)
+  h <- new_handle()
+  headers <- list(`User-Agent`="R",
                  `Content-Type`="application/json;charset=UTF8",
                  `Authorization`=sprintf("Bearer %s",ws$.auth),
                  `Accept`="application/json")
@@ -71,12 +71,12 @@ services <- function(ws, service_id, name, host = ws$.management_endpoint)
   if(missing(service_id)) service_id = ""
   else service_id = sprintf("/%s", service_id)
 
-  r = curl(
+  r <- curl(
     sprintf("%s/workspaces/%s/webservices%s", host, ws$id, service_id), 
-    handle=h
+    handle = h
   )
   on.exit(close(r))
-  ans = tryCatch(fromJSON(readLines(r, warn=FALSE)), error=function(e) NULL)
+  ans <- tryCatch(fromJSON(readLines(r, warn = FALSE)), error = function(e) NULL)
   attr(ans, "workspace") = ws
   if(!missing(name)) {
     ans = ans[ans$Name == name,]
@@ -91,7 +91,7 @@ services <- function(ws, service_id, name, host = ws$.management_endpoint)
 
 #' @rdname services
 #' @export
-getWebServices = services
+getWebServices <- services
 
 #' List AzureML Web Service Endpoints
 #'
@@ -144,7 +144,7 @@ getWebServices = services
 #' @export
 endpoints <- function(ws, service_id, endpoint_id, host = ws$.management_endpoint)
 {
-  if(!is.Workspace(ws)) stop("ws must be an AzureML Workspace object")
+  stopIfNotWorkspace(ws)
   # if(is.list(service_id) || is.data.frame(service_id)) service_id = service_id$Id[1]
   if(is.Service(service_id)) service_id = service_id$Id[1]
 
@@ -217,16 +217,19 @@ endpointHelp <- function(e, type = c("apidocument", "r-snippet","score","jobs","
 {
   type = match.arg(type)
   rsnip = FALSE
-  if(type=="r-snippet")
-  {
+  if(type=="r-snippet") {
     type = "score"
     rsnip = TRUE
   }
   uri = e$HelpLocation[1]
+
   # XXX This is totally nuts, and not documented, but help hosts vary depending on type.
   # Arrghhh...
-  if(type == "apidocument")
+  if(type == "apidocument"){
     uri = gsub("studio.azureml.net/apihelp", "management.azureml.net", uri)
+    uri = gsub("studio.azureml-int.net/apihelp", "management.azureml-int.net", uri)
+  }
+
   pattern = "</?\\w+((\\s+\\w+(\\s*=\\s*(?:\".*?\"|'.*?'|[^'\">\\s]+))?)+\\s*|\\s*)/?>"
   con = curl(paste(uri, type, sep="/"))
   text = paste(
@@ -239,10 +242,9 @@ endpointHelp <- function(e, type = c("apidocument", "r-snippet","score","jobs","
     collapse="\n"
   )
   close(con)
-  if(rsnip)
-  {
+  if(rsnip) {
     text = substr(text, 
-                  grepRaw("code-snippet-r",text)+nchar("code-snippet-r")+2,nchar(text)
+                  grepRaw("code-snippet-r", text) + nchar("code-snippet-r") + 2, nchar(text)
     )
   }
   if(type == "apidocument") text = fromJSON(text)