R - using shinytest with rhandsontable when table uses hot_validate_* - r

I am trying to create automated tests for a shiny app that uses rhandsontable. The rhandsontable uses hot_validate_numeric functions, and when running the app via shinytest, the rhandsontable does not render (when I try taking a screenshot of the running app), and if I call any computation in the app that depends on said rhot table, the app crashes.
A simple reproducible example where I display mtcars as a rhot table, and a button that computes mean of mpg using the data from the rhot table.
library(shiny)
library(rhandsontable)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel("Test"),
fluidRow(column(12, rHandsontableOutput("input_table"))),
actionButton("button", "Compute MPG Mean"),
textOutput("mean")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$input_table <- renderRHandsontable(
rhandsontable(mtcars) %>% hot_validate_numeric("mpg", min = 0, max = 40)
)
observeEvent(
input$button, {
n = mean(hot_to_r(input$input_table)$mpg)
output$mean = renderText(n)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Now if I run the tests in the following manner, the app crashes:
app <- ShinyDriver$new("path/to/app")
app$takeScreenshot() # rhot table does not appear in this
app$setInputs(button = "click")
# I get a message saying : Server did not update any output value within 3 seconds
# And if take another screenshot of app, I can see the app has crashed.
The app works normally, it only fails when using shinytest. If I remove hot_validate_numeric, then shinytest works too.
Is there some way I can use hot_validate_numeric and still be able to run tests?

Related

Can I have if statements that operate on UI that is triggered at the same time?

I'm trying to build a simple app with two modes. The user can leave 'non-interactive-mode' by flicking a switch. This generates some new UI elements, and produces a result based on the values in the UI element.
For some operations this works fine, but my if statements throw Warnings at the first time I run the code (Warning: Error in if: argument is of length zero). I think I understand why this is happening (the input doesn't exist the first time the code reads the if block), but can it be worked around in a simple way?
MWE below:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
materialSwitch(inputId = "interactive", label = "Interactive?",value=FALSE),
uiOutput("on_interactive_only"),
uiOutput("result_output")
)
server <- function(input, output) {
# Non-interactive Result
output$result_output <- renderUI(if(!input$interactive){
(renderTable(data.frame('dummy'=1:3)))})
# If interactive we need another UI element
output$on_interactive_only <- renderUI(if(input$interactive){
numericInput("value_to_specify",'Which Number?',5)})
# And now we need to react to that value
output$result_output <- renderUI(if(input$interactive){
if(input$value_to_specify > 3){
(renderTable(data.frame('dummy'=input$value_to_specify)))}})
}
shinyApp(ui = ui, server = server)

How to show ggplot from external function in shiny R application?

I need to create shiny app which will create a plot basing on dropdown menu choise. The whole computation part is pretty complicated and so is the plot – I created a function which is returning ggplot and I just wanted to show it in the app.
My idea looks as follows:
library(shiny)
source('Analysis/function_external.R')
list_names = c('a', 'b', 'c')
ui <- fluidPage(
selectInput("data", "Select data to plot", choices = list_names)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
observe({function_external(input$data)})
}
# Run the application
shinyApp(ui = ui, server = server)
It is making function run every time I change the input, but it does not show anything. I would really appreciate if you can point me into good direction.
output$my_complicated_plot <- renderPlot({ function_external(input$data) })
Solved the issue.

Deploy shiny app that can call runApp() inside application itself (specifically for tabulizer package)

I'm trying to deploy a Shiny app that allows the user to upload a pdf document and extract a table from a selected page. For this I'm using the package tabulizer. A basic reproducible example:
library(shiny)
library(tabulizer)
ui <- fluidPage(
fileInput("report", NULL,buttonLabel = "Upload report"),
numericInput("page","Specify page number",value = 1),
actionButton("extract","Extract"),
verbatimTextOutput("data")
)
server <- function(input, output, session) {
generate_data <- reactive({
req(input$report)
# This locate_area function calls runApp() from the tabulizer package
area <- locate_areas(file = input$report$datapath,
pages = input$page,
widget = "reduced")
table <- extract_tables(file = input$report$datapath,
pages = input$page,
area = area)
return(table)
})%>% bindCache(input$page) %>% bindEvent(input$extract)
output$data <- renderPrint({
# Just for the sake of this example to show it works
generate_data()
})
}
shinyApp(ui = ui, server = server)
If I run this locally, the locate_area() will make the pdf page pop-up on my viewer in RStudio and all is well. However, if I publish the app it doesn't run after clicking the action button. I know the problem comes from the locate_area() as it essentially calls another runApp within the shiny app. I have tried using different widgets for locate_area() to no avail. Does anybody know a way to circumvent this issue?
Judging by the relevant issues - issue 15 and issue 53 - it appears that your best way to go is really to copy the functionality from the original tabulizer function into your own app, as currently the package does not provide an easy integration with other Shiny apps.

Rshiny did not show any hint in the console so how to debug the Rshiny code?

I found the rshiny script is super hard to debug.
Especially, the rshiny bottom is the RunAPP. If I get the error. I did not see any hints from the Console.
Could I ask how you guys debug the rshiny?
Thanks
Most of all: always keep in mind that you need to test and debug your code. Do not just write code to satisfy requirements. Consider testing and debugging to be a requirement itself. That mind set is a good starting point to follow these rules:
R-Studio provides quite some functionality useful for debugging: step-by-step execution of your code, a trace of function calls, inspection of variables, and the opportunity to run your own code on the console while the app is on hold.
If breakpoints do not work (sometimes they just won't), add browser() to your code which creates a "forced" breakpoint.
Sometimes print() helps getting additional information output to the console.
Clearly separate the business logic from the UI. Use unit tests (testthat). If errors occur, write some sample code to test the business logic outside the shiny app.
Here is an example of how I debug in Shiny:
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
x <- reactive({
faithful[, 2]
})
bins <- reactive({
seq(min(x()), max(x()), length.out = input$bins + 1)
})
observe(print(bins())) # THIS LINE WILL PRINT OUTPUT TO CONSOLE
output$distPlot <- renderPlot({
hist(x(), breaks = bins(), col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)
The observe(print(reactive_object_name())) will print a reactive object to the console, which allows you to inspect what happens to a reactive object when you change inputs in the app.

How to run user input as R code in a Shiny app?

I want to create a shiny application that has an input for writing some R function or Command, reads it through the ui.R then passes it to the server.R that executes that R command to display the results.
I spent hours searching about some example but couldn't find anything, I already know how to create Shiny apps using ui and server and pass the input values to server and work with them, but I have no idea if it's possible to create a shiny app like R where you can write the commands and return the results, any example or help would be appreciated.
Letting users run code in your app is bad practice, since it comes with great security risks. However, for development you might want to check this function from the shinyjs package by Dean Attali.
Example from the link:
library(shiny)
library(shinyjs)
shinyApp(
ui = fluidPage(
useShinyjs(), # Set up shinyjs
runcodeUI(code = "shinyjs::alert('Hello!')")
),
server = function(input, output) {
runcodeServer()
}
)
Some examples of why it is not such a good idea to include when deploying your app:
Try the input:
shinyjs::alert(ls(globalenv()))
or
shinyjs::alert(list.files())
I was able to find an alternative solution that doesn't require shinyjs -- wanted to restate Florian's concern that in general it is not a good thing (not secure) to let users run code in your Shiny app. Here is the alternative:
library(shiny)
library(dplyr)
ui <- fluidPage(
mainPanel(
h3("Data (mtcars): "), verbatimTextOutput("displayData"),
textInput("testcode", "Try filtering the dataset in different ways: ",
"mtcars %>% filter(cyl>6)", width="600px"),
h3("Results: "), verbatimTextOutput("codeResults"))
)
server <- function(input, output) {
shinyEnv <- environment()
output$displayData <- renderPrint({ head(mtcars) }) # prepare head(mtcars) for display on the UI
# create codeInput variable to capture what the user entered; store results to codeResults
codeInput <- reactive({ input$testcode })
output$codeResults <- renderPrint({
eval(parse(text=codeInput()), envir=shinyEnv)
})
}
shinyApp(ui, server)

Resources