Prep quickstart

.connect.yml

@@ -0,0 +1,16 @@
+default:
+  content:
+    - title: "Use Python with R"
+      path: "./rmarkdown-notebook"
+      description: "Use the reticulate package to integrate Python into an R Markdown notebook."
+      tag:
+        - "Demo Content|Python"
+      url: "/python/reticulate/"
+      image: "reticulated_python.png"
+    - title: "Sentiment Analysis with Python"
+      path: "./sentiment-analysis"
+      description: "A Plumber API that uses R and Python to evaluate sentiment in text input using a pretrained spaCy model."
+      tag:
+        - "Demo Content|Python"
+      url: "/python/sentiment-analysis/"
+      image: "sentiment-analysis/spacy_logo.jpg"

.gitignore

@@ -41,4 +41,3 @@ __pycache__
 .ipynb_checkpoints
 *.html
 rmarkdown-notebook/flights.csv
-sentiment-analysis/model/

.internal.yml

@@ -1,8 +1,16 @@
 default:
   content:
     - name: "Use Python with R"
-      path: "./reticulate"
+      path: "./rmarkdown-notebook"
       description: "Use the reticulate package to integrate Python into an R Markdown notebook."
       tag:
         - "Demo Content|Python"
-      url: "/python/reticulate/"
+      url: "/python/reticulate/"
+      image: "reticulated_python.png"
+    - name: "Sentiment Analysis with Python"
+      path: "./sentiment-analysis"
+      description: "A Plumber API that uses R and Python to evaluate sentiment in text input using a pretrained spaCy model."
+      tag:
+        - "Demo Content|Python"
+      url: "/python/sentiment-analysis/"
+      image: "sentiment-analysis/spacy_logo.jpg"

image-classifier/app.R

@@ -3,79 +3,95 @@ library(reticulate)  # Used to call Tensorflow Python script
 library(shiny)
 library(shinycssloaders)
 
+behavior <- config::get("image")
+stopifnot(behavior %in% c("upload", "fetch-image-url"))
+
 # Load source of Python image classifier script
 source_python('image-classifier.py')
 
 server <- function(input, output, session) {
-
-    output$contents <- renderTable({
-        # After the user uploads a file, the image will be classified and the predictions will be shown.
+
+    # where the image that should be classified is on disk
+    image_path <- reactiveVal("./img/cat.jpg")
+
+    image_prefix <- "pytorch_image"
+
+    # the configurable selector for fetch-image-url vs. upload
+    output$image_selector <- renderUI({
+        if (behavior == "fetch-image-url") {
+          list(
+            textInput("file1", label = h5("Enter Image URL:"), value = ""),
+            actionButton("fetch-image-url", "Fetch Image")
+          )
+        } else if (behavior == "upload") {
+          fileInput("file_upload", label = h5("Upload an Image:"))
+        } else {
+            stop("Invalid configuration. Please chose 'fetch-image-url' or 'upload'")
+        }
+    })
+
+    # handle upload
+    observe({
+        req(input$file_upload)
+        upload_file <- input$file_upload
+        image_path(upload_file$datapath[[1]])
+    })
+
+    # handle fetch-image-url
+    observeEvent(input[["fetch-image-url"]], {
         req(input$file1)
+        tryCatch({
+            # Fetch image from URL
+            temp_fetch_image_url <- fs::file_temp(image_prefix, ext = ".jpg")
+            downloader::download(input$file1, temp_fetch_image_url)
+
+            image_path(temp_fetch_image_url)
+        }, error = function(e){
+            # usually, you would not expose this to the user
+            # without a little sanitization
+            showNotification(as.character(safeError(e)), type = "warning")
+        })  
+    })
+
+    output$contents <- renderTable({
+        req(image_path())
 
         tryCatch(
             {
-                # Download image from URL
-                downloader::download(input$file1, "image")
-
                 # Call function from PyTorch Python script to classify image
-                results <- classify_image_pytorch(image_path="image")
+                results <- classify_image_pytorch(image_path=image_path())
             },
             error = function(e) {
-                stop(safeError(e))
+                # usually, you would not expose this to the user
+                # without a little sanitization
+                showNotification(as.character(safeError(e)), type = "warning")
             }
         )
         return(results)
     })
 
+    # render the image
     output$image1 <- renderImage({
-        req(input$file1)
-        tryCatch(
-            {
-                input$file1
-            },
-            error = function(e) {
-                stop(safeError(e))
-            }
-        )
+        req(image_path())
+
+        # Copy the image to temp space
+        new_path <- fs::file_copy(image_path(), fs::file_temp(image_prefix, ext = ".jpg"))
 
         # Return a list containing the filename
-        if(is.null(input$file1)) {
+        if(is.null(new_path)) {
             return(NULL)
         }
         else {
-            return(list(src = "image"))
+            return(list(src = new_path, style = htmltools::css(width = "100%")))
         }
     })
 
-    observe({
-        x = input$oil_platform
-        image_url = "https://upload.wikimedia.org/wikipedia/commons/a/a1/Oil_platform.jpeg"
-        updateTextInput(session, "file1", value = paste(image_url))
-    })
-
-    observe({
-        x = input$truck
-        image_url = "https://upload.wikimedia.org/wikipedia/commons/6/6c/Toyota-1984-truck.jpg"
-        updateTextInput(session, "file1", value = paste(image_url))
-    })
-
-    observe({
-        x = input$flower
-        image_url = "https://upload.wikimedia.org/wikipedia/commons/thumb/f/fd/Aster_Tataricus.JPG/612px-Aster_Tataricus.JPG"
-        updateTextInput(session, "file1", value = paste(image_url))
-    })
-
-    observe({
-        x = input$cat
-        image_url = "https://upload.wikimedia.org/wikipedia/commons/thumb/7/7f/Egyptian_Mau_Bronze.jpg/611px-Egyptian_Mau_Bronze.jpg"
-        updateTextInput(session, "file1", value = paste(image_url))
-    })
-
-    observe({
-        x = input$dog
-        image_url = "https://upload.wikimedia.org/wikipedia/commons/e/e4/Border_Collie_600.jpg"
-        updateTextInput(session, "file1", value = paste(image_url))
-    })
+    # default images
+    observeEvent(input$oil_platform, image_path("./img/oil_platform.jpg"))
+    observeEvent(input$truck, image_path("./img/truck.jpg"))
+    observeEvent(input$flower, image_path("./img/flower.jpg"))
+    observeEvent(input$cat, image_path("./img/cat.jpg"))
+    observeEvent(input$dog, image_path("./img/dog.jpg"))
 
 }
 
@@ -84,8 +100,8 @@ ui <- fluidPage(
     titlePanel("Image Classifier"),
     sidebarLayout(
         sidebarPanel(
-            textInput("file1", label = h5("Enter Image URL:"), value = ""),
-            helpText("Your image will be downloaded and classified using Tensorflow in Python."),
+            uiOutput("image_selector"),
+            helpText("Your image will be classified using Tensorflow in Python."),
             helpText("The resulting predictions will be shown along with their confidence level."),
             hr(),
             helpText("Or, choose an example image:"),
@@ -103,7 +119,7 @@ ui <- fluidPage(
         mainPanel(
             # Output
             tableOutput("contents") %>% withSpinner(),
-            imageOutput("image1") %>% withSpinner(color = "#ffffff")
+            imageOutput("image1", height = NULL) %>% withSpinner(color = "#ffffff")
         )
     )
 )

image-classifier/config.yml

@@ -0,0 +1,4 @@
+default:
+  image: "fetch-image-url"
+quickstart:
+  image: "upload"