tests/testthat/test-order_rows_module.R

In spada: A 'shiny' Package for Data Analysis

# tests/testthat/test-order_rows_module.R

df_test <- iris |> as.data.table()
df_test[150, 1:5] <- NA

# test order rows - na last ---------------------------------------------------
test_that('Test order rows - na last - one variable ascending', {
  testServer(order_rows_server, {

    last_msg <- NULL

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

    vars <- c('Species')

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = vars)
    session$setInputs(radio_nas = 'last')

    session$setInputs(btn_order_rows = 1)

    df_reordered <- df_test[order(df_test[[vars]]), ]

    expect_equal(session$userData$dt$dt[[session$userData$dt$act_name]], df_reordered)
    expect_equal(last_msg, 'Remove modal')
  })
})

test_that('Test order rows - na last - one variable descending', {
  testServer(order_rows_server, {

    last_msg <- NULL

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

    vars <- c('Species')

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = vars)
    session$setInputs(radio_nas = 'last')
    session$setInputs(vars_descending = vars)
    session$setInputs(btn_order_rows = 1)

    df_reordered <- df_test[order(df_test[[vars]], decreasing = TRUE), ]

    expect_equal(session$userData$dt$dt[[session$userData$dt$act_name]], df_reordered)
    expect_equal(last_msg, 'Remove modal')
  })
})

test_that('Test order rows - na last - two variables ascending', {
  testServer(order_rows_server, {

    last_msg <- NULL

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

    vars <- c('Sepal.Length', 'Sepal.Width')

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = vars)
    session$setInputs(radio_nas = 'last')

    session$setInputs(btn_order_rows = 1)

    df_reordered <- setorderv(df_test, vars, na.last = TRUE)

    expect_equal(session$userData$dt$dt[[session$userData$dt$act_name]], df_reordered)
    expect_equal(last_msg, 'Remove modal')
  })
})

test_that('Test order rows - na last - two variables descending', {
  testServer(order_rows_server, {

    last_msg <- NULL

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

    vars <- c('Sepal.Length', 'Sepal.Width')

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = vars)
    session$setInputs(radio_nas = 'last')

    session$setInputs(btn_order_rows = 1)

    df_reordered <- setorderv(df_test, vars, c(-1, -1), na.last = TRUE)

    expect_equal(session$userData$dt$dt[[session$userData$dt$act_name]], df_reordered)
    expect_equal(last_msg, 'Remove modal')
  })
})

# test order rows - na first --------------------------------------------------
test_that('Test order rows - na first - one variable ascending', {
  testServer(order_rows_server, {

    last_msg <- NULL

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

    vars <- c('Species')

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = vars)
    session$setInputs(radio_nas = 'first')

    session$setInputs(btn_order_rows = 1)

    df_reordered <- setorderv(df_test, vars, na.last = FALSE)

    expect_equal(session$userData$dt$dt[[session$userData$dt$act_name]], df_reordered)
    expect_equal(last_msg, 'Remove modal')
  })
})

test_that('Test order rows - na first - one variable descending', {
  testServer(order_rows_server, {

    last_msg <- NULL

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

    vars <- c('Species')

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = vars)
    session$setInputs(radio_nas = 'first')
    session$setInputs(vars_descending = vars)
    session$setInputs(btn_order_rows = 1)

    df_reordered <- setorderv(df_test, vars, -1, na.last = FALSE)

    expect_equal(session$userData$dt$dt[[session$userData$dt$act_name]], df_reordered)
    expect_equal(last_msg, 'Remove modal')
  })
})

test_that('Test order rows - na first - two variables ascending', {
  testServer(order_rows_server, {

    last_msg <- NULL

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

    vars <- c('Sepal.Length', 'Petal.Width')

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = vars)
    session$setInputs(radio_nas = 'first')

    session$setInputs(btn_order_rows = 1)

    df_reordered <- setorderv(df_test, vars, na.last = FALSE)

    expect_equal(session$userData$dt$dt[[session$userData$dt$act_name]], df_reordered)
    expect_equal(last_msg, 'Remove modal')
  })
})

test_that('Test order rows - na first - two variables descending', {
  testServer(order_rows_server, {

    last_msg <- NULL

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

    vars <- c('Sepal.Length', 'Sepal.Width')

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = vars)
    session$setInputs(radio_nas = 'first')
    session$setInputs(vars_descending = vars)
    session$setInputs(btn_order_rows = 1)

    df_reordered <- setorderv(df_test, vars, c(-1, -1), na.last = FALSE)

    expect_equal(session$userData$dt$dt[[session$userData$dt$act_name]], df_reordered)
    expect_equal(last_msg, 'Remove modal')
  })
})

# test input check messages ---------------------------------------------------
test_that('Test order rows - check inputs', {
  testServer(order_rows_server, {

    last_msg <- NULL

    local_mocked_bindings(
      msg_error = function(text, ...) { last_msg <<- text },
      msg = function(text, ...) { last_msg <<- text }
    )

    session$userData$dt <- reactiveValues(
      dt = list('df_test' = df_test),
      act_name = 'df_test'
    )

    session$setInputs(vars_rows = NULL, btn_order_rows = 1)

    expect_equal(last_msg, 'Select at least one variable')
  })
})