tests/testthat/test-input_env.R

In manipulateWidget: Add Even More Interactivity to Interactive Charts

context("initInputEnv")

# Helper function that checks the structure of the object returned by initInputEnv
# It returns the said object for further testing
test_structure <- function(inputs, compare = NULL, ncharts = 1) {
  res <- initInputEnv(inputs, compare = compare, ncharts = ncharts)

  #initAllInputs(inputs, initEnv(parent.frame(), 1))
  inputList <- lapply(unname(inputs), function(input) input$getInputs())
  inputList <- do.call(c, inputList)

  expect_is(res, "InputEnv")
  expect_named(res$getRefClass()$fields(), c("envs", "inputList", "ncharts", "hierarchy"))
  expect_is(res$envs, "list")
  expect_named(res$envs, c("shared", "ind"))
  expect_is(res$envs$ind, "list")
  expect_length(res$envs$ind, ncharts)

  expect_is(res$inputList, "InputList")
  expectedLength <- length(inputList) + length(compare) * (ncharts - 1)
  # inexact when one tries to compare grouped inputs
  expect_equal(nrow(res$inputList$inputTable), expectedLength)

  sharedInputs <- setdiff(names(inputList), names(compare))

  if (length(sharedInputs) == 0) expected_names <- c()
  else expected_names <- paste0("shared_", sharedInputs)

  if (length(compare) > 0) {
    for (i in seq_len(ncharts)) {
      expected_names <- append(
        expected_names,
        paste0("output_", i, "_", names(compare))
      )
    }
  }

  expect_true(all(expected_names %in% row.names(res$inputList$inputTable)))

  res
}

describe("initInputEnv", {
  it("generates correct structure", {
    test_structure(list(a = mwText(), b = mwText()))
  })

  it("handles grouped inputs", {
    test_structure(list(grp = mwGroup(a = mwText(), b = mwText())))
  })

  it("still works if ncharts > 1", {
    test_structure(list(grp = mwGroup(a = mwText(), b = mwText())), ncharts = 2)
  })

  it("prepares inputs for comparison", {
    test_structure(list(a = mwText(), b = mwText()), ncharts = 2,
                   compare = list(a = NULL))
  })

  it("prepares inputs for comparison with different initial values", {
    res <- test_structure(list(a = mwText(), b = mwText()), ncharts = 2,
                          compare = list(a = c("a", "b")))

  })

  it("throws errors if inputs are not inputs or not named", {
    expect_error(initInputEnv(list(mwText())), "All arguments need to be named.")
    expect_error(initInputEnv(list(a = 1)), "All arguments need to be Input objects.")
  })
})

describe("InputEnv Class", {
  it ("shares an input", {
    model <- test_structure(list(x = mwSlider(0, 10, 5), y = mwSlider(x, 10, 0)),
                            ncharts = 2, compare = list(x = list(5, 0), y = NULL))

    model$inputList$init()
    newInput <- model$shareInput("x")
    expect_equal(newInput, "shared_x")

    expect_silent(model$inputList$getInput("x", 0))
    expect_null(model$inputList$getInput("y", 0), "cannot find input")

    for (i in 1:2) {
      expect_silent(model$inputList$getInput("y", i))
    }

    expect_equal(model$envs$shared$x, 5)
    for (i in 1:2) {
      expect_null(model$envs$ind[[i]]$x)
    }
  })

  it ("unshares an input", {
    model <- test_structure(list(a = mwText(), b = mwText("test")), ncharts = 2,
                            compare = list(a = NULL))

    newInputs <- model$unshareInput("b")
    expect_equal(newInputs, c("output_1_b", "output_2_b"))

    expect_null(model$inputList$getInput("b", 0), "cannot find input")

    for (i in 1:2) {
      expect_silent(model$inputList$getInput("a", i))
      expect_silent(model$inputList$getInput("b", i))
    }

    for (i in 1:2) {
      expect_equal(model$envs$ind[[i]]$b, "test")
    }

    model$inputList$setValue("b", "test2", chartId = 1)
    expect_equal(model$envs$ind[[1]]$b, "test2")
    expect_equal(model$envs$ind[[2]]$b, "test")

  })

  it ("shares a group of inputs", {
    model <- test_structure(list(grp = mwGroup(a = mwText(), b = mwText())),
                            ncharts = 2, compare = list(grp = NULL, a = NULL, b = NULL))

    model$inputList$init()
    newInput <- model$shareInput("grp")
    expect_equal(sort(newInput), c("shared_a", "shared_b", "shared_grp"))

    expect_silent(model$inputList$getInput("grp", 0))
    expect_silent(model$inputList$getInput("a", 0))
    expect_silent(model$inputList$getInput("b", 0))

    expect_named(model$inputList$getInput("grp", 0)$value, c("a", "b"))

    for (i in 1:2) {
      expect_null(model$inputList$getInput(inputId = sprintf("output_%s_grp",i)), "cannot find input")
      expect_null(model$inputList$getInput(inputId = sprintf("output_%s_grp",i)), "cannot find input")
      expect_null(model$inputList$getInput(inputId = sprintf("output_%s_grp",i)), "cannot find input")
    }

    # Check environments
    expect_true(exists("a", envir = model$envs$shared))
    expect_true(exists("b", envir = model$envs$shared))
    for (i in 1:2){
      expect_false(exists("a", envir = model$envs$ind[[i]], inherits = FALSE))
      expect_false(exists("b", envir = model$envs$ind[[i]], inherits = FALSE))
    }
  })

  it ("unshares a group of inputs", {
    model <- test_structure(list(grp = mwGroup(a = mwText(), b = mwText("test"))),
                            ncharts = 2)
    newInputs <- model$unshareInput("grp")
    expect_equal(
      sort(newInputs),
      c("output_1_a", "output_1_b", "output_1_grp", "output_2_a", "output_2_b", "output_2_grp")
    )
    expect_null(model$inputList$getInput("a", 0), "cannot find input")
    expect_null(model$inputList$getInput("b", 0), "cannot find input")
    expect_null(model$inputList$getInput("grp", 0), "cannot find input")

    for (i in 1:2) {
      expect_silent(model$inputList$getInput("a", i))
      expect_silent(model$inputList$getInput("b", i))
      expect_silent(model$inputList$getInput("grp", i))
    }

    expect_null(model$envs$shared$a)
    expect_null(model$envs$shared$b)
    for (i in 1:2) {
      expect_equal(model$envs$ind[[i]]$b, "test")
    }

    model$inputList$setValue("b", "test2", chartId = 1)
    expect_equal(model$envs$ind[[1]]$b, "test2")
    expect_equal(model$envs$ind[[2]]$b, "test")
  })

  it ("ads a chart", {
    model <- test_structure(list(a = mwText("test"), b = mwText()), ncharts = 1,
                           compare = list(a = NULL))
    model$addChart()

    expect_equal(model$ncharts, 2)
    expect_length(model$envs$ind, 2)

    for (i in 1:2) {
      expect_equal(model$envs$ind[[i]]$a, "test")
      expect_null(model$envs$ind[[i]]$b)
    }

    model$inputList$setValue("a", "test2", chartId = 1)
    expect_equal(model$envs$ind[[1]]$a, "test2")
    expect_equal(model$envs$ind[[2]]$a, "test")

    model$inputList$setValue("b", "test3", chartId = 0)
    expect_equal(get("b", envir = model$envs$ind[[1]]), "test3")
    expect_equal(get("b", envir = model$envs$ind[[2]]), "test3")
  })

  it ("removes a chart", {
    model <- test_structure(list(a = mwText("test"), b = mwText()), ncharts = 2,
                            compare = list(a = NULL))
    model$removeChart()

    expect_equal(model$ncharts, 1)
    expect_length(model$envs$ind, 1)
    expect_length(model$inputList$inputTable$input, 2)
    expect_equal(row.names(model$inputList$inputTable), c("shared_b", "output_1_a"), ignore.order = TRUE)
  })

  it ("does not remove last chart", {
    model <- test_structure(list(a = mwText("test"), b = mwText()), ncharts = 1,
                            compare = list(a = NULL))

    expect_error(model$removeChart(), "at least one chart")
  })

  it ("ads many charts", {
    model <- test_structure(list(a = mwText("test"), b = mwText()), ncharts = 2,
                            compare = list(a = NULL))
    model$setChartNumber(4)
    expect_equal(model$ncharts, 4)
    expect_length(model$envs$ind, 4)
  })

  it ("removes many charts", {
    model <- test_structure(list(a = mwText("test"), b = mwText()), ncharts = 4,
                            compare = list(a = NULL))
    model$setChartNumber(2)
    expect_equal(model$ncharts, 2)
    expect_length(model$envs$ind, 2)
  })

  it ("unshares reverse dependencies", {
    model <- test_structure(list(a = mwNumeric(10), b = mwSlider(0, a, 0)), ncharts = 2)
    model$inputList$init()
    new_inputs <- model$unshareInput("a")
    expect_equal(sort(new_inputs), c("output_1_a", "output_1_b", "output_2_a", "output_2_b"))
  })

  it ("shares dependencies", {
    model <- test_structure(list(a = mwNumeric(10), b = mwSlider(0, a, 0)), ncharts = 2,
                            compare = list(a = NULL, b = NULL))
    model$inputList$init()
    new_inputs <- model$shareInput("b")
    expect_equal(sort(new_inputs), c("shared_a", "shared_b"))
  })

  it ("shares/unshares the whole group if the input is in a group", {
    model <- test_structure(list(grp = mwGroup(a = mwNumeric(10), b = mwNumeric(0))),
                            ncharts = 2)
    model$inputList$init()
    new_inputs <- model$unshareInput("b")
    expect_equal(sort(new_inputs), c("output_1_a", "output_1_b", "output_1_grp", "output_2_a", "output_2_b", "output_2_grp"))

    new_inputs <- model$shareInput("b")
    expect_equal(sort(new_inputs), c("shared_a", "shared_b", "shared_grp"))
  })
})