Merge branch 'master' of https://github.com/BioDataScience-Course/BioDataScience2

Author: GuyliannEngels

NEWS.md

@@ -2,7 +2,12 @@
 
 ## Changes in version 2020.0.0
 
-- update all tutorials with sciviews box 2020
+- Update all tutorials with SciViews Box 2020, and name change with B01Xa_name,
+with 'B' refers to second course, '01' to first module, 'X' being `L` for learnr
+or `S` for Shiny and 'a' the sequence in case there are several similar items in
+the same module.
+
+- RStudio addins.
 
 ## Changes in version 2019.11.0
 
@@ -20,21 +25,20 @@
 
 ## Changes in version 2019.9.0
 
-- New shiny app 04e_gompertz
+- New Shiny app 04e_gompertz
 
 ## Changes in version 2019.8.0
 
-- shiny app 04c 04d
+- Shiny app 04c 04d
 
 ## Changes in version 2019.7.0
 
-- shiny app 04a_michaelis_menten and 04b_exponent
+- Shiny app 04a_michaelis_menten and 04b_exponent
 
 ## Changes in version 2019.6.0
 
 - Tutorial 03a_mod_lin finalized
 
-
 ## Changes in version 2019.5.0
 
 - Tutorial 02a_reg_multi finalized

R/addins.R

@@ -4,80 +4,54 @@ run_addin <- function() {
   #library(shiny)
   #library(miniUI)
 
-  selectTutorial <- function() {
-    tutorials <- dir(system.file("tutorials", package = "BioDataScience2"))
-    if (!length(tutorials)) return(NULL)
+  selectItem <- function() {
+    package <- "BioDataScience2"
+
+    items <- character(0)
+    tutorials <- dir(system.file("tutorials", package = package))
+    if (length(tutorials))
+      items <- paste(tutorials, "(tutorial)")
+    apps <- dir(system.file("shiny", package = package))
+    if (length(apps))
+      items <- c(items, paste(apps, "(Shiny app)"))
+    if (!length(items)) return()
 
     ui <- miniPage(
       miniContentPanel(
-        selectInput("tutorial", "Tutorials in BioDataScience2:",
-          selectize = FALSE, size = 11, tutorials)
+        selectInput("item", paste0("Items in ", package, ":"),
+          selectize = FALSE, size = 11, items)
       ),
-      gadgetTitleBar("", left = miniTitleBarCancelButton(), right =
-          miniTitleBarButton("done", "Select", primary = TRUE))
+      gadgetTitleBar("",
+        left  = miniTitleBarCancelButton(),
+        right = miniTitleBarButton("done", "Select", primary = TRUE)
+      )
     )
 
     server <- function(input, output, session) {
       observeEvent(input$done, {
-        returnValue <- input$tutorial
-        if (!is.null(returnValue))
-          BioDataScience2::run(returnValue)
+        returnValue <- input$item
+        if (!is.null(returnValue)) {
+          if (grepl(" \\(tutorial\\)$", returnValue)) {
+            run(sub(" \\(tutorial\\)$", "", returnValue))
+          } else {# Must be an app then
+            run_app(sub(" \\(Shiny app\\)$", "", returnValue))
+          }
+        }
         stopApp(returnValue)
       })
     }
 
     runGadget(ui, server,
-      viewer = dialogViewer("Select a tutorial",
+      viewer = dialogViewer("Select an item",
         width = 300, height = 250))
   }
 
-  tutorial <- try(suppressMessages(selectTutorial()), silent = TRUE)
-  if (!is.null(tutorial) && !inherits(tutorial, "try-error"))
-    message("Running tutorial ", tutorial)
-}
-
-run_app_addin <- function() {
-  #library(shiny)
-  #library(miniUI)
-
-  selectApp <- function() {
-    apps <- dir(system.file("shiny", package = "BioDataScience2"))
-    if (!length(apps)) return(NULL)
-
-    ui <- miniPage(
-      miniContentPanel(
-        selectInput("app", "Shiny apps in BioDataScience2:",
-          selectize = FALSE, size = 11, apps)
-      ),
-      gadgetTitleBar("", left = miniTitleBarCancelButton(), right =
-          miniTitleBarButton("done", "Select", primary = TRUE))
-    )
-
-    server <- function(input, output, session) {
-      observeEvent(input$done, {
-        returnValue <- input$app
-        if (!is.null(returnValue))
-          BioDataScience2::run_app(returnValue)
-        stopApp(returnValue)
-      })
-    }
-
-    runGadget(ui, server,
-      viewer = dialogViewer("Select a Shiny application",
-        width = 300, height = 250))
-  }
-
-  app <- try(suppressMessages(selectApp()), silent = TRUE)
-  if (!is.null(app) && !inherits(app, "try-error"))
-    message("Running Shiny application ", app)
-}
-
-update_pkg_addin <- function() {
   # Update both BioDataScience & BioDataScience2
   learndown::update_pkg("BioDataScience",
     github_repos = "BioDataScience-course/BioDataScience")
   update_pkg()
-}
 
-sign_out_addin <- function()
-  BioDataScience::sign_out()
+  item <- try(suppressMessages(selectItem()), silent = TRUE)
+  if (!is.null(item) && !inherits(item, "try-error"))
+    message("Running item ", item)
+}

inst/rstudio/addins.dcf

@@ -1,19 +1,4 @@
-Name: Run learnr tutorial
-Description: Run one of the learnr tutorials in this package (after possibly updating it)
+Name: Run tutorial or app from BioDataScience2
+Description: Run one of the learnr tutorials or Shiny applications in this package
 Binding: run_addin
 Interactive: true
-
-Name: Run Shiny application
-Description: Run one of the Shiny applications in this package (after possibly updating it)
-Binding: run_app_addin
-Interactive: true
-
-Name: Update
-Description: Update the package
-Binding: update_pkg_addin
-Interactive: true
-
-Name: Sign out
-Description: Sign out current user
-Binding: sign_out_addin
-Interactive: true

inst/shiny/B01Sa_reglin/app.R

@@ -26,9 +26,9 @@ ui <- fluidPage(
       withMathJax(),
       p("$$y(x) = a \\ x + \\ b $$"),
       sliderInput("a", label = "a",
-                  value = 0, min = -5, max = 5, step = 0.5),
+        value = 0, min = -5, max = 5, step = 0.5),
       sliderInput("b", label = "b",
-                  value = 0, min = -5, max = 5, step = 0.5),
+        value = 0, min = -5, max = 5, step = 0.5),
       hr(),
       submitQuitButtons()
     ),
@@ -54,8 +54,8 @@ server <- function(input, output, session) {
 
   model_predict <- reactive({
     dplyr::mutate(model_data,
-           y_predit = reglin(x, a = input$a, b = input$b),
-           distance2 = (y_predit - y)^2
+      y_predit = reglin(x, a = input$a, b = input$b),
+      distance2 = (y_predit - y)^2
     )
   })
 

inst/shiny/B01Sa_reglin/shiny_logs/shinylogs_B01_reglin_1599049016531868000.rds

@@ -60,8 +60,8 @@ server <- function(input, output, session) {
 
   model_predict <- reactive({
     dplyr::mutate(model_data,
-           y_predit = exponent(x, y0 = input$y0, k = input$k),
-           distance2 = (y_predit - y)^2
+      y_predit = exponent(x, y0 = input$y0, k = input$k),
+      distance2 = (y_predit - y)^2
     )
   })