testthat in Shiny error: renderTable output does not equal expected data frame

[MayaGans]

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!

[woodward]

output$summary is not a dataframe, it is an html rending of a dataframe.

[MayaGans]

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?

[woodward]

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)

[MayaGans]

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()

[woodward]

You'd need to change this line too, somehow

app$getValue(name = "filtered")

[MayaGans]

Yes, that's the line that I was hoping there was some getReactive() type function....

[MayaGans]

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"

[MayaGans]

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....