tests/testthat/test-02-GUI-UI.R

In ddalthorp/GenEst: Generalized Mortality Estimator

context("Check the User Interface-Producing Functions")

test_that("Main UI HTML generation functions produce HTML", {
  expect_is(GenEstUI(appType = "base"), "shiny.tag.list")
  expect_is(GenEstUI(appType = "deploy"), "shiny.tag.list")
  expect_is(dataInputPanel(), "shiny.tag")
  expect_is(dataInputSidebar(), "shiny.tag")
  expect_is(loadedDataPanel(), "shiny.tag")
  expect_is(analysisPanel(), "shiny.tag")
  expect_is(GeneralInputsPanel(), "shiny.tag")
  expect_is(GeneralInputSidebar(), "shiny.tag")
  expect_is(SEPanel(), "shiny.tag")
  expect_is(SESidebar(), "shiny.tag")
  expect_is(SEMainPanel(), "shiny.tag")
  expect_is(CPPanel(), "shiny.tag")
  expect_is(CPSidebar(), "shiny.tag")
  expect_is(CPMainPanel(), "shiny.tag")
  expect_is(MPanel(), "shiny.tag")
  expect_is(MSidebar(), "shiny.tag")
  expect_is(MMainPanel(), "shiny.tag")
  expect_is(gPanel(), "shiny.tag")
  expect_is(gSidebar(), "shiny.tag")
  expect_is(gMainPanel(), "shiny.tag")
  expect_is(helpPanel(), "shiny.tag")
  expect_is(gettingStartedPanel(), "shiny.tag")
  expect_is(downloadsPanel(), "shiny.tag")
  expect_is(aboutPanel(), "shiny.tag")
  expect_is(disclaimersPanel(), "shiny.tag")
})


test_that("Standard widget functions produce HTML", {
  expect_is(dataInputWidget("SE"), "list")
  expect_is(dataInputWidget("SE")[[1]], "shiny.tag")
  expect_is(dataInputWidget("SE")[[2]], "shiny.tag")
  expect_is(dataInputWidget("SE")[[3]], "shiny.tag")
  expect_is(dataInputWidget("CP"), "list")
  expect_is(dataInputWidget("CP")[[1]], "shiny.tag")
  expect_is(dataInputWidget("CP")[[2]], "shiny.tag")
  expect_is(dataInputWidget("CP")[[3]], "shiny.tag")
  expect_is(dataInputWidget("SS"), "list")
  expect_is(dataInputWidget("SS")[[1]], "shiny.tag")
  expect_is(dataInputWidget("SS")[[2]], "shiny.tag")
  expect_is(dataInputWidget("SS")[[3]], "shiny.tag")
  expect_is(dataInputWidget("DWP"), "list")
  expect_is(dataInputWidget("DWP")[[1]], "shiny.tag")
  expect_is(dataInputWidget("DWP")[[2]], "shiny.tag")
  expect_is(dataInputWidget("DWP")[[3]], "shiny.tag")
  expect_is(dataInputWidget("CO"), "list")
  expect_is(dataInputWidget("CO")[[1]], "shiny.tag")
  expect_is(dataInputWidget("CO")[[2]], "shiny.tag")
  expect_is(dataInputWidget("CO")[[3]], "shiny.tag")
  expect_error(dataInputWidget("_NOT_RIGHT_"))
  expect_is(dataDownloadWidget("mock"), "shiny.tag")
  expect_is(dataDownloadWidget("RP"), "shiny.tag")
  expect_is(dataDownloadWidget("RPbat"), "shiny.tag")
  expect_is(dataDownloadWidget("cleared"), "shiny.tag")
  expect_is(dataDownloadWidget("powerTower"), "shiny.tag")
  expect_is(dataDownloadWidget("PV"), "shiny.tag")
  expect_is(dataDownloadWidget("trough"), "shiny.tag")
  expect_error(dataDownloadWidget("_NOT_RIGHT_"))
  expect_is(modelInputWidget("nsim"), "shiny.tag")
  expect_is(modelInputWidget("CL"), "shiny.tag")
  expect_is(modelInputWidget("class"), "shiny.tag")
  expect_is(modelInputWidget("obsSE"), "shiny.tag")
  expect_is(modelInputWidget("predsSE"), "shiny.tag")
  expect_is(modelInputWidget("kFixedInput"), "shiny.tag")
  expect_is(modelInputWidget("ltp"), "shiny.tag")
  expect_is(modelInputWidget("fta"), "shiny.tag")
  expect_is(modelInputWidget("predsCP"), "shiny.tag")
  expect_is(modelInputWidget("dist"), "shiny.tag")
  expect_is(modelInputWidget("frac"), "shiny.tag")
  expect_is(modelInputWidget("DWPCol"), "shiny.tag")
  expect_is(modelInputWidget("COdate"), "shiny.tag")
  expect_is(modelInputWidget("gSearchInterval"), "shiny.tag")
  expect_is(modelInputWidget("gSearchMax"), "shiny.tag")
  expect_error(modelInputWidget("_NOT_RIGHT_"))
  expect_is(modelRunWidget("SE")[[1]], "shiny.tag")
  expect_is(modelRunWidget("SE")[[2]], "shiny.tag")
  expect_is(modelRunWidget("SE")[[3]], "shiny.tag")
  expect_is(modelRunWidget("CP")[[1]], "shiny.tag")
  expect_is(modelRunWidget("CP")[[2]], "shiny.tag")
  expect_is(modelRunWidget("CP")[[3]], "shiny.tag")
  expect_is(modelRunWidget("M")[[1]], "shiny.tag")
  expect_is(modelRunWidget("M")[[2]], "shiny.tag")
  expect_is(modelRunWidget("M")[[3]], "shiny.tag")
  expect_is(modelRunWidget("g")[[1]], "shiny.tag")
  expect_is(modelRunWidget("g")[[2]], "shiny.tag")
  expect_is(modelRunWidget("g")[[3]], "shiny.tag")
  expect_is(modelRunWidget("SE"), "list")
  expect_is(modelRunWidget("CP"), "list")
  expect_is(modelRunWidget("M"), "list")
  expect_is(modelRunWidget("g"), "list")
  expect_error(modelRunWidget("_NOT_RIGHT_"))
  expect_is(modelOutputWidget("SE"), "shiny.tag")
  expect_is(modelOutputWidget("CP"), "shiny.tag")
  expect_is(modelOutputWidget("M"), "shiny.tag")
  expect_is(modelOutputWidget("g"), "shiny.tag")
  expect_error(modelOutputWidget("_NOT_RIGHT_"))
})

test_that("Model Selection Menu Widget function produces an HTML-rendering
           shiny function", {

  expect_error(modelSelectionWidget("_NOT_RIGHT_"))
  expect_error(modelSelectionWidget("_NOT_RIGHT_", "SE"))
  expect_error(modelSelectionWidget("_NOT_RIGHT_", "CP"))
  expect_error(modelSelectionWidgetHeader("_NOT_RIGHT_"))

  expect_error(modelSelectionWidgetRow("_NOT_RIGHT_"))
  expect_error(modelSelectionWidgetRow("_NOT_RIGHT_", "SE"))
  expect_error(modelSelectionWidgetRow("_NOT_RIGHT_", "CP"))
  expect_error(modelSelectionWidgetRow("_NOT_RIGHT_", "SE", 1))
  expect_error(modelSelectionWidgetRow("_NOT_RIGHT_", "CP", 1))

  data(mock)
  modSetSize <- pkmSize(data = mock$SE, formula_p = p ~ 1,
                  formula_k = k ~ 1, sizeCol = "Size", allCombos = TRUE)
  expect_is(modelSelectionWidget(modSetSize, "SE"), "shiny.render.function")
  expect_is(modelSelectionWidgetHeader(modSetSize), "character")
  expect_error(modelSelectionWidgetRow(modSetSize, "SE", 1))
  expect_error(modelSelectionWidgetRow(modSetSize, "_NOT_RIGHT_", 1))
  expect_error(modelSelectionWidgetRow(modSetSize, "SE", 10))
  modSetSize <- cpmSize(data = mock$CP, formula_l = l ~ 1,
                  formula_s = s ~ 1, sizeCol = "Size",
                  left = "LastPresentDecimalDays", 
                  right = "FirstAbsentDecimalDays", allCombos = TRUE)
  expect_is(modelSelectionWidget(modSetSize, "CP"), "shiny.render.function")

  modSetSize <- pkmSize(data = mock$SE, formula_p = p ~ 1,
                  formula_k = k ~ 1, allCombos = TRUE)
  expect_is(modelSelectionWidget(modSetSize, "SE"), "shiny.render.function")
  expect_is(modelSelectionWidgetHeader(modSetSize), "character")
  expect_error(modelSelectionWidgetRow(modSetSize, "SE", 1))
  expect_error(modelSelectionWidgetRow(modSetSize, "_NOT_RIGHT_", 1))
  expect_error(modelSelectionWidgetRow(modSetSize, "SE", 10))
  modSetSize <- cpmSize(data = mock$CP, formula_l = l ~ 1,
                  formula_s = s ~ 1,
                  left = "LastPresentDecimalDays", 
                  right = "FirstAbsentDecimalDays", allCombos = TRUE)
  expect_is(modelSelectionWidget(modSetSize, "CP"), "shiny.render.function")

  modSet <- pkmSet(data = mock$SE, formula_p = p ~ 1, formula_k = k ~ 1)
  expect_error(modelSelectionWidget(modSet, "SE"))
  mod <- pkm(data = mock$SE, formula_p = p ~ 1, formula_k = k ~ 1)
  expect_error(modelSelectionWidget(mod, "SE"))
})

test_that("kFixed Widget function produces an HTML-rendering shiny 
           function", {

  expect_is(kFixedWidgetHeader("all"), "shiny.tag")

  expect_error(kFixedWidgetRow("all", 1))
  expect_error(kFixedWidgetRow("all", "OK"))
  expect_error(kFixedWidgetRow("all", 3))

  expect_is(kFixedWidget("all"), "shiny.render.function")
  expect_is(kFixedWidget(c("s", "m")), "shiny.render.function")
  expect_error(kFixedWidget())
})

test_that("widgetMaker makes widgets",{
  expect_is(widgetMaker("", "OK", "selectizeInput", "LABEL", 
              list(choices = 1, selected = 1)), "shiny.tag")
  expect_is(widgetMaker("", "OK", "numericInput", "LABEL", 
              list(value = 1)), "shiny.tag")
  expect_is(widgetMaker("", "OK", "htmlOutput", "LABEL", 
              list(NULL)), "shiny.tag")
  expect_is(widgetMaker("", "OK", "checkboxGroupInput", "LABEL", 
              list(choices = "1", selected = "1")), "shiny.tag")
  expect_error(widgetMaker())
  expect_error(widgetMaker("", "OK", "_NOT_RIGHT_", "LABEL", list(NULL)))
})

test_that("Widget preTextMaker makes conditional text (list of HTML)",{
  expect_is(preTextMaker("SE"), "list")
  expect_is(preTextMaker("SE")[[1]], "shiny.tag")
  expect_is(preTextMaker("CP"), "list")
  expect_is(preTextMaker("CP")[[1]], "shiny.tag")
  expect_is(preTextMaker("M"), "list")
  expect_is(preTextMaker("M")[[1]], "shiny.tag")
  expect_is(preTextMaker("g"), "list")
  expect_is(preTextMaker("g")[[1]], "shiny.tag")
  expect_error(preTextMaker("_NOT_RIGHT_"))
})

test_that("The widget for the split button combo produces list of HTML", {
  expect_is(splitButtonWidget(), "list")
  expect_equal(length(splitButtonWidget()), 2)
  expect_is(splitButtonWidget()[[1]], "shiny.tag")
})

test_that("Panel functions produce HTML", {
  expect_is(dataTabPanel("SE"), "shiny.tag")
  expect_is(dataTabPanel("CP"), "shiny.tag")
  expect_is(dataTabPanel("SS"), "shiny.tag")
  expect_is(dataTabPanel("DWP"), "shiny.tag")
  expect_is(dataTabPanel("CO"), "shiny.tag")
  expect_error(dataTabPanel("_NOT_RIGHT_"))
  expect_is(selectedDataPanel("SE"), "shiny.tag")
  expect_is(selectedDataPanel("CP"), "shiny.tag")
  expect_is(selectedDataPanel("g"), "shiny.tag")
  expect_error(selectedDataPanel("_NOT_RIGHT_"))
  expect_is(modelOutputPanel("SEFigures"), "shiny.tag")
  expect_is(modelOutputPanel("SEEstimates"), "shiny.tag")
  expect_is(modelOutputPanel("SEModComparison"), "shiny.tag")
  expect_is(modelOutputPanel("SEModSelection"), "shiny.tag")
  expect_is(modelOutputPanel("CPFigures"), "shiny.tag")
  expect_is(modelOutputPanel("CPEstimates"), "shiny.tag")
  expect_is(modelOutputPanel("CPModComparison"), "shiny.tag")
  expect_is(modelOutputPanel("CPModSelection"), "shiny.tag")
  expect_is(modelOutputPanel("MFigures"), "shiny.tag")
  expect_is(modelOutputPanel("MSummary"), "shiny.tag")
  expect_is(modelOutputPanel("gFigures"), "shiny.tag")
  expect_is(modelOutputPanel("gSummary"), "shiny.tag")
  expect_error(modelOutputPanel("_NOT_RIGHT_"))
})


test_that("Content functions produce content (text or HTML)", {
  expect_is(gettingStartedContent(), "shiny.tag")
  expect_is(aboutContent(), "shiny.tag")
  expect_is(GenEstAuthors(), "html")
  expect_is(GenEstGUIauthors(), "html")
  expect_is(GenEstLicense(), "html")
  expect_is(GenEstAcknowledgements(), "html")
  expect_is(GenEstLogos(), "html")
  expect_is(disclaimersContent(), "shiny.tag")
  expect_is(disclaimersContent(), "shiny.tag")
  expect_is(disclaimersContent(), "shiny.tag")
  expect_is(disclaimersContent("base"), "shiny.tag")
  expect_is(disclaimersContent("deploy"), "shiny.tag")
  expect_error(disclaimersContent("_NOT_RIGHT_"))
  expect_is(disclaimerUSGS(), "character")
  expect_is(disclaimerWEST("base"), "character")
  expect_is(disclaimerWEST("deploy"), "character")
  expect_error(disclaimerWEST("_NOT_RIGHT_"))
})

test_that("navbar generates HTML", {
  expect_is(navbar(), "shiny.tag")
})

test_that("HTML tag functions", {
  expect_is(style(), "shiny.tag")
  expect_is(ol(), "shiny.tag")
  expect_is(ul(), "shiny.tag")
  expect_is(li(), "shiny.tag")
  expect_is(b(), "shiny.tag")
  expect_is(u(), "shiny.tag")
  expect_is(small(), "shiny.tag")
  expect_is(big(), "html")
  expect_is(center(), "html")
})

test_that("Inline CSS function creates an appropriate shiny tag", {
  expect_is(GenEstInlineCSS(), "shiny.tag")
  expect_is(GenEstInlineCSS()[["children"]][[1]], "shiny.tag")
})

test_that("JavaScript function creates an appropriate shiny tag", {
  expect_is(GenEstShinyJS(), "shiny.tag")
  expect_is(GenEstShinyJS()[["children"]][[1]], "shiny.tag")
})

test_that("Button style function produces a single character element", {
  expect_is(cButtonStyle("single"), "character")
  expect_equal(length(cButtonStyle("single")), 1)
  expect_is(cButtonStyle("all"), "character")
  expect_equal(length(cButtonStyle("all")), 1)
  expect_error(cButtonStyle("_NOT_RIGHT_"))
})