tests/testthat/test-loarmean_flag.R

In aggreCAT: Mathematically Aggregating Expert Judgments

# Generated by pointblank

library(pointblank)


method_test_loarmean <- function(df){

  tbl <- df

  test_that("column `paper_id` is of type: character", {

    expect_col_is_character(
      tbl,
      columns = vars(paper_id),
      threshold = 1
    )
  })

  test_that("column `method` is of type: character", {

    expect_col_is_character(
      tbl,
      columns = vars(method),
      threshold = 1
    )
  })


  # test_that("column `method_applied` is of type: character", {
  #
  #   expect_col_is_character(
  #     tbl,
  #     columns = vars(method_applied),
  #     threshold = 1
  #   )
  # })
#
#   test_that("column `no_quiz_scores_for_claim` is of type: logical", {
#
#     expect_col_is_logical(
#       tbl,
#       columns = ends_with("_for_claim"),
#       threshold = 1
#     )
#   })

  test_that("values in `cs` should be between `0` and `1`", {

    expect_col_vals_between(
      tbl,
      columns = vars(cs),
      left = 0,
      right = 1,
      threshold = 1
    )
  })


  test_that("column `cs` is of type: numeric", {

    expect_col_is_numeric(
      tbl,
      columns = vars(cs),
      threshold = 1
    )
  })

  test_that("all values in `cs` should not be NULL", {

    expect_col_vals_not_null(
      tbl,
      columns = vars(cs),
      threshold = 1
    )
  })

  test_that("all values in `n_experts` should not be NULL", {

    expect_col_vals_not_null(
      tbl,
      columns = vars(n_experts),
      threshold = 1
    )
  })


}

# Test LOArMean Flag for Quiz, Engwagg and Reasoning methods


# Quiz --------------------------------------------------------------------


QuizWAgg <- LinearWAgg(data_ratings,
                       weights = data_supp_quiz %>%
                         dplyr::rename(weight = quiz_score),
                       type = "Participant_LO",
                       name = "QuizWAgg",
                       placeholder = FALSE,
                       flag_loarmean = TRUE,
                       percent_toggle = TRUE)


method_test_loarmean(QuizWAgg)

# Reasons -----------------------------------------------------------------


ReasonWAgg <- ReasoningWAgg(data_ratings,
                            reasons = data_supp_reasons,
                            type = "ReasonWAgg",
                            percent_toggle = TRUE,
                            flag_loarmean = TRUE,
                            placeholder = FALSE)

ReasonWAgg2 <- ReasoningWAgg(data_ratings,
                             reasons = data_supp_reasons,
                             type = "ReasonWAgg2",
                             placeholder = FALSE,
                             flag_loarmean = TRUE,
                             percent_toggle = TRUE)

BetaReasonWAgg <- ReasoningWAgg(data_ratings,
                                reasons = data_supp_reasons,
                                type = "ReasonWAgg",
                                name = "BetaReasonWAgg",
                                beta_transform = TRUE,
                                beta_param = c(6,6),
                                placeholder = FALSE,
                                flag_loarmean = TRUE,
                                percent_toggle = TRUE)

BetaReasonWAgg2 <- ReasoningWAgg(data_ratings,
                                 reasons = data_supp_reasons,
                                 type = "ReasonWAgg2",
                                 name = "BetaReasonWAgg2",
                                 beta_transform = TRUE,
                                 beta_param = c(6,6),
                                 placeholder = FALSE,
                                 flag_loarmean = TRUE,
                                 percent_toggle = TRUE)




method_test_loarmean(ReasonWAgg)
method_test_loarmean(ReasonWAgg2)
method_test_loarmean(BetaReasonWAgg)
method_test_loarmean(BetaReasonWAgg2)