Port "R bring your own" notebook to R (#1221)

* feat(rbyo): first draft convert nb to R

Convert Python notebook in this example to R

* feat(rbyo): Surface console output on failure

Print outputs to notebook even when shell command fails, with new
utility function nbsystem2. Also improve representation of elapsed
times with repr.

* refactor(rbyo): simplify S3 data upload

Use SM session instead of boto3 s3 resource

* doc(rbyo): syntax highlight R code in NB markdown

* fix(rbyo): syntax error missing close brackets

Introduced with repr.

* fix(rbyo): repeatably runnable df_to_csv function

Wrap the textConnection in a function so predict cell can be run
multiple times

* doc(rbyo): update commentary in line with R nb

Update comments to reflect that notebook is now in R

* doc(rbyo): remove out-of-scope Docker TODOs

Remove extra TODOs and update NB to match Dockerfile

* style(rbyo): R code style and extra doc comments

Fix the bizarre brace spacing used in the R scripts; replicate this
code to the notebook sections that duplicate script code; add more
guidance for SMStudio users (not ready for full support yet); and
expand notes on further reading e.g. batch transform, HPO.

Author: athewsey

advanced_functionality/r_bring_your_own/Dockerfile

@@ -2,6 +2,9 @@ FROM ubuntu:20.04
 
 ARG DEBIAN_FRONTEND=noninteractive 
 
+# Don't prompt for tzdata on new versions of Ubuntu:
+ARG DEBIAN_FRONTEND=noninteractive
+
 RUN apt-get -y update && apt-get install -y --no-install-recommends \
     wget \
     libcurl4-openssl-dev\

advanced_functionality/r_bring_your_own/docker-build-push.sh

@@ -0,0 +1,42 @@
+#!/bin/bash
+
+# The name of our algorithm
+algorithm_name=sagemaker-rmars
+
+set -e # stop if anything fails
+
+account=$(aws sts get-caller-identity --query Account --output text)
+echo "AWS Account ID $account"
+
+# Get the region defined in the current configuration (default to us-west-2 if none defined)
+region=$(aws configure get region)
+region=${region:-us-west-2}
+echo "AWS Region $region"
+
+fullname="${account}.dkr.ecr.${region}.amazonaws.com/${algorithm_name}:latest"
+
+echo "Target image URI $fullname"
+
+# If the repository doesn't exist in ECR, create it.
+
+echo "Checking for existing repository..."
+set +e
+aws ecr describe-repositories --repository-names "${algorithm_name}"
+if [ $? -ne 0 ]
+then
+    set -e
+    echo "Creating repository"
+    aws ecr create-repository --repository-name "${algorithm_name}"
+else
+    set -e
+fi
+
+# Get the login command from ECR and execute it directly
+$(aws ecr get-login --region ${region} --no-include-email)
+
+# Build the docker image locally with the image name and then push it to ECR
+# with the full name.
+docker build -t ${algorithm_name} .
+docker tag ${algorithm_name} ${fullname}
+
+docker push ${fullname}

advanced_functionality/r_bring_your_own/mars.R

@@ -32,16 +32,16 @@ training_path <- paste(input_path, channel_name, sep='/')
 
 # Setup training function
 train <- function() {
-
     # Read in hyperparameters
     training_params <- read_json(param_path)
 
     target <- training_params$target
 
     if (!is.null(training_params$degree)) {
-        degree <- as.numeric(training_params$degree)}
-    else {
-        degree <- 2}
+        degree <- as.numeric(training_params$degree)
+    } else {
+        degree <- 2
+    }
 
     # Bring in data
     training_files = list.files(path=training_path, full.names=TRUE)
@@ -51,8 +51,10 @@ train <- function() {
     training_X <- model.matrix(~., training_data[, colnames(training_data) != target])
 
     # Save factor levels for scoring
-    factor_levels <- lapply(training_data[, sapply(training_data, is.factor), drop=FALSE],
-                            function(x) {levels(x)})
+    factor_levels <- lapply(
+        training_data[, sapply(training_data, is.factor), drop=FALSE],
+        function(x) { levels(x) }
+    )
 
     # Run multivariate adaptive regression splines algorithm
     model <- mars(x=training_X, y=training_data[, target], degree=degree)
@@ -64,18 +66,22 @@ train <- function() {
     print(summary(mars_model))
 
     write.csv(model$fitted.values, paste(output_path, 'data/fitted_values.csv', sep='/'), row.names=FALSE)
-    write('success', file=paste(output_path, 'success', sep='/'))}
+    write('success', file=paste(output_path, 'success', sep='/'))
+}
 
 
 # Setup scoring function
 serve <- function() {
     app <- plumb(paste(prefix, 'plumber.R', sep='/'))
-    app$run(host='0.0.0.0', port=8080)}
+    app$run(host='0.0.0.0', port=8080)
+}
 
 
 # Run at start-up
 args <- commandArgs()
 if (any(grepl('train', args))) {
-    train()}
+    train()
+}
 if (any(grepl('serve', args))) {
-    serve()}
+    serve()
+}

advanced_functionality/r_bring_your_own/plumber.R

@@ -11,14 +11,14 @@
 #' Ping to show server is there
 #' @get /ping
 function() {
-    return('')}
+    return('')
+}
 
 
 #' Parse input and return prediction from model
 #' @param req The http request sent
 #' @post /invocations
 function(req) {
-
     # Setup locations
     prefix <- '/opt/ml'
     model_path <- paste(prefix, 'model', sep='/')
@@ -35,4 +35,5 @@ function(req) {
     scoring_X <- model.matrix(~., data, xlev=factor_levels)
 
     # Return prediction
-    return(paste(predict(mars_model, scoring_X, row.names=FALSE), collapse=','))}
+    return(paste(predict(mars_model, scoring_X, row.names=FALSE), collapse=','))
+}