tests/testthat/test-join_module.R

In spada: A 'shiny' Package for Data Analysis

# tests/testthat/test-join_module.R

dt1 <- data.table(char_x = LETTERS[1:3], num = 1:3)
dt2 <- data.table(char_y = LETTERS[2:4], num = 10:12)

datasets <- list('dt1' = dt1, 'dt2' = dt2)

# test joins - new ------------------------------------------------------------
test_that('Test joins - new', {
  testServer(join_server, {

    last_msg <- NULL

    local_mocked_bindings(
      remove_running_modal = function() { last_msg <<- 'Remove modal' }
    )

    session$userData$dt <- reactiveValues(
      dt = datasets,
      act_name = 'dt1'
    )

    session$userData$dt_names <- reactive({ names(session$userData$dt$dt) })

    session$setInputs(
      dt1_sel = 'dt1',
      vars_sel1 = 'char_x',
      dt2_sel = 'dt2',
      vars_sel2 = 'char_y',
      join_type = 'left',
      radio_overwrite = 'new',
      txt_new_dt_name = 'left_dt',
      btn_apply = 1
    )

    session$setInputs(
      join_type = 'right',
      txt_new_dt_name = 'right_dt',
      btn_apply = 2
    )

    session$setInputs(
      join_type = 'full',
      txt_new_dt_name = 'full_dt',
      btn_apply = 3
    )

    session$setInputs(
      join_type = 'inner',
      txt_new_dt_name = 'inner_dt',
      btn_apply = 4
    )

    # left join
    expect_s3_class(session$userData$dt$dt [[ 'left_dt' ]], 'data.table')
    expect_equal(session$userData$dt$dt [['left_dt']],
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'left'),
                 ignore_attr = TRUE)
    # right join
    expect_s3_class(session$userData$dt$dt [[ 'right_dt' ]], 'data.table')
    expect_equal(session$userData$dt$dt [['right_dt']],
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'right'),
                 ignore_attr = TRUE)

    # full join
    expect_s3_class(session$userData$dt$dt [[ 'full_dt' ]], 'data.table')
    expect_equal(session$userData$dt$dt [['full_dt']],
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'full'),
                 ignore_attr = TRUE)

    # inner join
    expect_s3_class(session$userData$dt$dt [[ 'inner_dt' ]], 'data.table')
    expect_equal(session$userData$dt$dt [['inner_dt']],
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'inner'),
                 ignore_attr = TRUE)
    expect_equal(last_msg, 'Remove modal')
  })
})

# test joins - overwrite ------------------------------------------------------
test_that('Test joins - overwrite - left', {
  testServer(join_server, {

    last_msg <- NULL

    local_mocked_bindings(
      remove_running_modal = function() { last_msg <<- 'Remove modal' }
    )

    session$userData$dt <- reactiveValues(
      dt = datasets,
      act_name = 'dt1'
    )

    session$userData$data_changed <- reactiveVal(0)
    session$userData$dt_names <- reactive({ names(session$userData$dt$dt) })

    session$setInputs(
      dt1_sel = 'dt1',
      vars_sel1 = 'char_x',
      dt2_sel = 'dt2',
      vars_sel2 = 'char_y',
      join_type = 'left',
      radio_overwrite = 'overwrite',
      btn_apply = 1
    )

    expect_s3_class(session$userData$dt$dt [[ 'dt1' ]], 'data.table')
    expect_equal(session$userData$dt$dt [['dt1']],
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'left'),
                 ignore_attr = TRUE)
    expect_equal(last_msg, 'Remove modal')
  })
})

test_that('Test joins - overwrite - right', {
  testServer(join_server, {

    last_msg <- NULL

    local_mocked_bindings(
      remove_running_modal = function() { last_msg <<- 'Remove modal' }
    )

    session$userData$dt <- reactiveValues(
      dt = datasets,
      act_name = 'dt1'
    )

    session$userData$data_changed <- reactiveVal(0)
    session$userData$dt_names <- reactive({ names(session$userData$dt$dt) })

    session$setInputs(
      dt1_sel = 'dt1',
      vars_sel1 = 'char_x',
      dt2_sel = 'dt2',
      vars_sel2 = 'char_y',
      join_type = 'right',
      radio_overwrite = 'overwrite',
      btn_apply = 1
    )

    expect_s3_class(session$userData$dt$dt [[ 'dt1' ]], 'data.table')
    expect_equal(session$userData$dt$dt [['dt1']],
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'right'),
                 ignore_attr = TRUE)
    expect_equal(last_msg, 'Remove modal')
  })
})

test_that('Test joins - overwrite - full', {
  testServer(join_server, {

    last_msg <- NULL

    local_mocked_bindings(
      remove_running_modal = function() { last_msg <<- 'Remove modal' }
    )

    session$userData$dt <- reactiveValues(
      dt = datasets,
      act_name = 'dt1'
    )

    session$userData$data_changed <- reactiveVal(0)
    session$userData$dt_names <- reactive({ names(session$userData$dt$dt) })

    session$setInputs(
      dt1_sel = 'dt1',
      vars_sel1 = 'char_x',
      dt2_sel = 'dt2',
      vars_sel2 = 'char_y',
      join_type = 'full',
      radio_overwrite = 'overwrite',
      btn_apply = 1
    )

    expect_s3_class(session$userData$dt$dt [[ 'dt1' ]], 'data.table')
    expect_equal(session$userData$dt$dt [['dt1']],
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'full'),
                 ignore_attr = TRUE)
    expect_equal(last_msg, 'Remove modal')
  })
})


test_that('Test joins - overwrite - inner', {
  testServer(join_server, {

    last_msg <- NULL

    local_mocked_bindings(
      remove_running_modal = function() { last_msg <<- 'Remove modal' }
    )

    session$userData$dt <- reactiveValues(
      dt = datasets,
      act_name = 'dt1'
    )

    session$userData$data_changed <- reactiveVal(0)
    session$userData$dt_names <- reactive({ names(session$userData$dt$dt) })

    session$setInputs(
      dt1_sel = 'dt1',
      vars_sel1 = 'char_x',
      dt2_sel = 'dt2',
      vars_sel2 = 'char_y',
      join_type = 'inner',
      radio_overwrite = 'overwrite',
      btn_apply = 1
    )

    expect_s3_class(session$userData$dt$dt [[ 'dt1' ]], 'data.table')
    expect_equal(session$userData$dt$dt [['dt1']],
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'inner'),
                 ignore_attr = TRUE)
    expect_equal(last_msg, 'Remove modal')
  })
})

# test sample trigger reactiveVal ---------------------------------------------
test_that("Test Sample trigger - updates on button click", {
  testServer(join_server, {
    session$userData$data_changed <- reactiveVal(0)
    trigger_before <- preview_sample_trigger()

    session$setInputs(btn_preview_sample = 1)
    trigger_after <- preview_sample_trigger()

    expect_true(trigger_after > trigger_before)
  })
})

# test joins - preview df -----------------------------------------------------
test_that('Test joins - preview', {
  testServer(join_server, {

    session$userData$dt <- reactiveValues(
      dt = datasets,
      act_name = 'dt1'
    )

    preview_sample_trigger <- reactiveVal(0)

    session$setInputs(
      dt1_sel = 'dt1',
      vars_sel1 = 'char_x',
      dt2_sel = 'dt2',
      vars_sel2 = 'char_y',
      join_type = 'left',
      btn_preview_sample = 1
    )

    # left join
    expect_s3_class(preview_df(), 'data.table')
    expect_equal(preview_df(),
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'left'),
                 ignore_attr = TRUE)

    # right join
    session$setInputs(join_type = 'right', btn_preview_sample = 2)

    expect_s3_class(preview_df(), 'data.table')
    expect_equal(preview_df(),
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'right'),
                 ignore_attr = TRUE)

    # full join
    session$setInputs(join_type = 'full', btn_preview_sample = 3)

    expect_s3_class(preview_df(), 'data.table')
    expect_equal(preview_df(),
                 dt_join(dt1, dt2, 'char_x', 'char_y', 'full'),
                 ignore_attr = TRUE)
  })
})

# test errors -----------------------------------------------------------------
test_that('Preview_df returns validation error', {
  testServer(join_server, {

    session$userData$dt <- reactiveValues(
      dt = datasets,
      act_name = 'dt1'
    )
    session$setInputs(
      dt1_sel = 'dt1',
      dt2_sel = 'dt2',
      vars_sel1 = 'a',
      vars_sel2 = 'b',
      join_type = 'left'
    )

    expect_error(preview_df(), class = 'shiny.silent.error')

  })
})

# test check messages ---------------------------------------------------------
test_that('Apply join - check inputs', {
  testServer(join_server, {

    last_msg <- NULL

    local_mocked_bindings(
      msg_error = function(text, ...) { last_msg <<- text },
      msg = function(text, ...) { last_msg <<- text },
      remove_running_modal = function(){last_msg <<- 'Remove modal'}
    )

    session$userData$dt <- reactiveValues(
      dt = datasets,
      act_name = 'dt1'
    )

    session$userData$dt_names <- reactive({ names(session$userData$dt$dt) })

    # equal datasets
    session$setInputs(
      dt1_sel = 'dt1',
      dt2_sel = 'dt1',
      btn_apply = 1
    )
    expect_equal(last_msg, 'Select two diferent datasets')

    # selected variables
    session$setInputs(
      dt1_sel = 'dt1',
      dt2_sel = 'dt2',
      btn_apply = 2
    )
    expect_equal(last_msg, 'Select variables for both datasets')

    # lenght of selected variables
    session$setInputs(
      vars_sel1 = c('char_x', 'num'),
      vars_sel2 = c('num'),
      btn_apply = 3
    )
    expect_equal(last_msg, 'The number of selected variables must be the same for both datasets')

    # new name not valid
    session$setInputs(
      vars_sel1 = 'char_x',
      vars_sel2 = 'char_y',
      radio_overwrite = 'new',
      txt_new_dt_name = 123,
      btn_apply = 4
    )
    expect_equal(last_msg, 'New name is not valid or already in use')

    # new name already in use
    session$setInputs(
      txt_new_dt_name = 'dt1',
      btn_apply = 5
    )
    expect_equal(last_msg, 'New name is not valid or already in use')

    # invalid vars
    session$setInputs(
      vars_sel2 = 'char_y2',
      txt_new_dt_name = 'new_dt',
      btn_apply = 6
    )
    expect_equal(last_msg, 'Select valid variables')

    # type of vars must match
    session$setInputs(
      vars_sel1 = 'char_x',
      vars_sel2 = 'num',
      btn_apply = 7
    )
    expect_equal(last_msg, 'The variables types must match')

    # join applied
    session$setInputs(
      vars_sel1 = 'char_x',
      vars_sel2 = 'char_y',
      btn_apply = 8
    )
    expect_equal(last_msg, 'Remove modal')

    # error
    session$setInputs(
      vars_sel1 = 'char_x',
      vars_sel2 = 'char_y',
      txt_new_dt_name = 'dt_error',
      join_type = 'error',
      btn_apply = 9
    )
    expect_equal(last_msg, 'Error: join aborted')

  })
})