Reputation: 17
I have provided a minimal example Shiny app with two modules. The dataselect & table module updates the second selectInput depending on the first selectInput and the plot module plots a timeline for the selected rows of data. I want to test the dataset & table module with testthat package. I expected the result of this test to be passed, but it failed. I'm new to unit testing. What is my mistake? I appreciate any help. This is the unit test that I have written:
library(testthat)
library(shiny)
library(shinytest)
test_that("the right rows of data are selected ", {
testServer(dataselect_server, {
session$setInputs(Nametype = Name1, Name="Aix galericulata")
df<-data.frame(Name1<-"Aix galericulata",
Name2<-"Mandarin Duck",
eventDate<-"2015-03-11",
individualCount<-1
)
expect_true(identical(finalDf(), df))
})
})
This is the result of the test:
-- Warning (Line 2): the right rows of data are selected -----------------------
the condition has length > 1 and only the first element will be used
Backtrace:
1. shiny::testServer(...)
26. shiny:::finalDf()
28. self$.updateValue()
29. ctx$run(...)
36. env$runWith(self, func)
37. shiny:::contextFunc()
40. shiny:::.func()
42. `<reactive:finalDf>`(...)
-- Warning (Line 2): the right rows of data are selected -----------------------
the condition has length > 1 and only the first element will be used
Backtrace:
1. shiny::testServer(...)
26. shiny:::finalDf()
28. self$.updateValue()
29. ctx$run(...)
36. env$runWith(self, func)
37. shiny:::contextFunc()
40. shiny:::.func()
42. `<reactive:finalDf>`(...)
-- Warning (Line 2): the right rows of data are selected -----------------------
the condition has length > 1 and only the first element will be used
Backtrace:
1. shiny::testServer(...)
26. shiny:::finalDf()
28. self$.updateValue()
29. ctx$run(...)
36. env$runWith(self, func)
37. shiny:::contextFunc()
40. shiny:::.func()
42. `<reactive:finalDf>`(...)
-- Failure (Line 2): the right rows of data are selected -----------------------
identical(finalDf(), df) is not TRUE
`actual`: FALSE
`expected`: TRUE
Backtrace:
1. shiny::testServer(...)
22. testthat::expect_true(identical(finalDf(), df))
Error: Test failed
and this is the dataset & table module code:
# Dataselect & table module
dataselect_ui<- function(id) {
ns<-NS(id)
tagList(
selectInput(ns("Nametype"),"Select a name type",
choices=c("Name1","Name2","choose"),selected = "choose"),
selectInput(ns("Name"),"Select a name",
choices="",selected = "",selectize=TRUE),
DT::DTOutput(ns("tab"))
)
}
dataselect_server <- function(id) {
moduleServer(id, function(input, output, session) {
# Data preparation
df<-data.frame(Name1<-c("Aix galericulata","Grus grus"," Alces alces"),
Name2<-c("Mandarin Duck","Common Crane" ,"Elk"),
eventDate<-c("2015-03-11","2015-03-10","2015-03-10"),
individualCount<-c(1, 10, 1)
)
colnames(df)<-c("Name1","Name2","eventDate","individualCount")
# Putting columns Name1 and Nam2 of df in one column called nameType using melt()function
# This format of data is needed for the choices argument of updateSelectizeInput()
df2<-reshape2::melt(df,id=c("eventDate","individualCount"))
colnames(df2)<-c("eventDate","individualCount","nameType","Name")
observeEvent(
input$Nametype,
updateSelectizeInput(session, "Name", "Select a name",
choices = unique(df2$Name[df2$nameType==input$Nametype]),selected = ""))
# finalDf() is the data used to plot the table and plot
finalDf<-reactive({
if(input$Name=="choose"){
return(NULL)
}
if(input$Name==""){
return(NULL)
}
if(input$Nametype=="choose"){
return(NULL)
}
# if the first selectInput is set to Name1, from df select rows their Name1 column are
# equal to the second selectInput value
else if(input$Nametype=="Name1"){
finalDf<-df[which(df$Name1==input$Name) ,]
}
# if the first selectInput is set to Name2, from df select rows their Name2 column are
# equal to the second selectInput value
else if(input$Nametype=="Name2"){
finalDf<-df[which(df$Name2==input$Name) ,]
}
return(finalDf)
})
output$tab<-DT::renderDT({
req(input$Name)
datatable(finalDf(), filter = 'top',
options = list(pageLength = 5, autoWidth = TRUE),
rownames= FALSE)
})
return(
list("finalDf" = finalDf, "input_Name" = reactive(input$Name))
)
})
}
This is the app's other module (plot module):
# Plot module
plot_ui <- function(id) {
ns<-NS(id)
tagList(
plotlyOutput(ns("plot"))
)
}
plot_server <- function(id,input_Name ,finalDf) {
moduleServer(id, function(input, output, session) {
output$plot <- renderPlotly({
req(input_Name())
p<-ggplot(finalDf(),aes(x=eventDate,y=individualCount)) +geom_point(alpha=0.2, shape=21, color="black",fill="red",size=5)+
labs( x = "Date Event",y= "Individual Count") +theme_bw()
p<-ggplotly(p)
p
})
})
}
And the main app:
source('modules/dataselect & table_module.R')
source('modules/plot_module.R')
library(shiny)
library(plotly)
library(reshape2)
# application
ui <- fluidPage(
dataselect_ui("dataselect"),
plot_ui("plot1")
)
server <- function(session,input, output) {
dataselect_outputs <- dataselect_server("dataselect")
plot_server("plot1",input_Name = dataselect_outputs$input_Name
,finalDf= dataselect_outputs$finalDf)
}
shinyApp(ui = ui, server = server)
EDIT:
I modified the code as per @Stéphane Laurent's recommendation:
test_that("the right rows of data are selected", {
testServer(dataselect_server, {
session$setInputs(Nametype = "Name1", Name="Aix galericulata")
df<-data.frame(Name1="Aix galericulata",
Name2="Mandarin Duck",
eventDate="2015-03-11",
individualCount=1
)
expect_identical(finalDf(), df)
})
})
And it returned an error:
-- Error (Line 2): the right rows of data are selected -------------------------
Error in `module(childScope$input, childScope$output, childScope, ...)`: attempt to apply non-function
Backtrace:
1. shiny::testServer(...)
23. shiny::moduleServer(...)
25. shiny::callModule(module, id, session = session)
30. module(childScope$input, childScope$output, childScope, ...)
Error: Test failed
Upvotes: 0
Views: 193
Reputation: 84529
For the warnings I don't know.
You have to quote in setInputs
:
session$setInputs(Nametype = "Name1", ......)
You don't correctly define your dataframes. The columns must be defined with =
, not with <-
:
df <- data.frame(
Name = c(......),
Name2 = c(......),
......
)
Also rather use expect_identical(x, y)
instead of expect_true(identical(x, y))
, this will give a more informative reporting message if the test fails.
Upvotes: 0