I have a simple Shiny app where the user can select a number to filter the iris dataset by Sepal Length:
library(shiny)
ui <- fluidRow(numericInput("num_input", "Sepal Length Greater Than", min = 4.3, value = 6, max = 7.9),
tableOutput("summary"))
server <- function(input, output) {
output$summary <- renderTable(iris %>% filter(Sepal.Length > input$num_input))
}
shinyApp(ui = ui, server = server)
And I'd like to create a unit test to make sure the output table == my expected table
library(shinytest)
library(testthat)
context("Test Sepal Output")
app <- ShinyDriver$new(".")
test_that("Sepal Length filtered by num_output", {
# set num_input to 30
app$setInputs(num_input = 6)
# get text_out
output <- app$getValue(name = "summary")
# create output dataset
test_data <- iris %>%
filter(Sepal.Length > 6)
# ensure it matches the shiny output
expect_true(identical(output, test_data))
})
app$stop()
But this gives me the error: `Error: Test failed: 'Sepal Length filtered by num_output'
- identical(output, test_data) isn't true.`
How are they not identical? I tried running just output
and get "could not find function \"%>%\""
What am I missing here? Any help appreciated!
output$summary is not a dataframe, it is an html rending of a dataframe.
Thanks @woodward, I had a suspicion this was the case but I tried
test_that("Sepal Length filtered by num_output", {
# set num_input to 30
app$setInputs(num_input = 6)
# get text_out
output <- app$getValue(name = "summary")
# create output dataset
test_data <- iris %>%
filter(Sepal.Length > 6)
# convert test data to HTML
test_data_html <- print(xtable(test_data, align="llllll"),
type="html", html.table.attributes="")
# ensure it matches the shiny output
expect_true(identical(output, test_data_html))
})
And I'm still missing something. Would you mind helping me a little further?
Does this work? Then retrieve "filtered" and compare to test_data.
output$filtered <- reactive(iris %>% filter(Sepal.Length > input$num_input))
output$summary <- renderTable(output$filtered)
I don't think you can use a Shiny output inside renderTable, but maybe you can use a reactive in the test somehow?
filteredData <- reactive(iris %>% filter(Sepal.Length > input$num_input))
output$summary <- renderTable(filteredData())
Unit Test
library(shinytest)
library(testthat)
library(xtable)
context("Test Sepal Output")
app <- ShinyDriver$new(".")
test_that("Sepal Length filtered by num_output", {
# set num_input to 30
app$setInputs(num_input = 6)
# get filtered reactive THIS DOESN'T ACTUALLY WORK
output <- app$getValue(name = "filteredData")
# create output dataset
test_data <- iris %>%
filter(Sepal.Length > 6)
# ensure it matches the shiny output
expect_true(identical(output, test_data))
})
app$stop()
You'd need to change this line too, somehow
app$getValue(name = "filtered")
Yes, that's the line that I was hoping there was some getReactive() type function....
I also tried
output <- app$getValue(name = "summary")
rvest::html_table(output)
Thinking I can convert the output into a dataframe but I get the error:
Error in UseMethod("html_table") : no applicable method for 'html_table' applied to an object of class "character"
This WORKS!
I converted the output from an HTML table to a dataframe using rvest
App.R
library(shiny)
library(tidyverse)
ui <- fluidRow(numericInput("num_input", "Sepal Length Greater Than", min = 4.3, value = 6, max = 7.9),
tableOutput("summary"))
server <- function(input, output) {
output$summary <- renderTable(iris %>% filter(Sepal.Length > input$num_input))
}
shinyApp(ui = ui, server = server)
Test
library(shinytest)
library(testthat)
library(rvest)
context("Test Sepal Output")
app <- ShinyDriver$new(".")
test_that("Sepal Length filtered by num_output", {
# set num_input to 30
app$setInputs(num_input = 6)
# get text_out
output <- app$getValue(name = "summary")
my_df <- as.data.frame(read_html(output) %>% html_table(fill=TRUE))
# create output dataset
ir <- iris
ir$Species <- as.character(iris$Species)
test_data <- iris %>% filter(Sepal.Length > 6) %>%
# ensure it matches the shiny output
expect_identical(test_data, my_df)
})
app$stop()
This ALMOST works! I converted the output to a dataframe and they seem to be exactly the same but the test is still failing....
1 Like
system
Closed
10
This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.