Nothing
tests/testthat/tests_codebook.R
In gmoTree: Get and Modify 'oTree' Data
if (rlang::is_installed(c("withr", "testthat"))) {
print("---- start codebook tests -----")
testthat::test_that("Codebook - pdf brackets", {
# TODO + here check everywhere how rankaversion$Constants$choices
# is displayed in the output
# Check also for long variables names: commentaftercomma_mean
# (not prettily shown in word output because of long len() values)
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
output_file = "newline", # Pretty :)
splitvarname = TRUE,
doc_info = FALSE,
output = "list",
sep_list = "newline"), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output_file = "cb_vector_complex", # Not pretty yet
doc_info = FALSE,
output = "list",
sep_list = "vector"),
"Some variables or code parts contain code that is too complex")
# TODO + Output was not working properly because the cell is too large,
# Now everything seems okay. Check again
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output_format = "pdf_document_simple_nl", # Not pretty yet
output_file = "cb_vector_simple",
output = "list",
doc_info = FALSE,
sep_list = "newline"), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output_format = "word_document", # Word works
output_file = "vector_word",
output = "list",
doc_info = FALSE,
sep_list = "vector"), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output_format = "word_document", # Word works
output_file = "newline_word",
output = "list",
doc_info = FALSE,
sep_list = "newline"), "Some variables")
# List with sublists - all numbers
testthat::expect_identical(
cbook$rankaversion$Constants$commentaftercomma,
list(
list(2004.0, 43.0, 5.0),
list(81.0, 91.0, 81.0),
list(18.0, 63.0, 67.0),
list(45.0, 56.0, 75.0),
list(3.0, 84.0, 77.0)))
testthat::expect_identical(
cbook$rankaversion$Constants$commentaftercomma_max,
2004.0)
testthat::expect_identical(
cbook$rankaversion$Constants$commentaftercomma_min, 3.0)
testthat::expect_identical(
round(cbook$rankaversion$Constants$commentaftercomma_mean, 1),
round(mean(c(2004L, 43L, 5L, 81L, 91L, 81L, 18L, 63L,
67L, 45L, 56L, 75L, 3L, 84L, 77L)), 1))
# List with sublists - mixed types
testthat::expect_identical(
cbook$rankaversion$Constants$choices[[1L]],
list(4.0, 1.0, 1.0, 0.5, "noRR_needSat", 3.0, 2.0))
testthat::expect_true(
startsWith(
x = cbook$rankaversion$Constants$min_choices,
prefix = "min(list(list(4, 1, 1, 0.5, noRR_needSat, 3, 2), list(5, "))
testthat::expect_true(
startsWith(
x = cbook$rankaversion$Constants$max_choices,
prefix = "max(list(list(4, 1, 1, 0.5, noRR_needSat, 3, 2), list(5, "))
# One level list with all numbers
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorn,
list(1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0,
11.0, 12.0, 13.0, 14.0, 15.0, 16.0, 17.0))
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorn_min, 1.0)
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorn_max, 17.0)
testthat::expect_true(
cbook$rankaversion$Constants$onelevelvectorn_mean ==
mean(unlist(cbook$rankaversion$Constants$onelevelvectorn)))
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorl2,
list("a", "b", 3.0, "asdfadsf", "adsfadsfasdf",
"00asasdf", 2342.0, "wqerwerqewr"))
})
testthat::test_that("Codebook - vector variable in settings and constants", {
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z3"),
fsource = "models",
output = "list",
doc_info = FALSE)
, "code that is too complex for this function" # read csv problem
)
# Copy of mixed settings list is also list
testthat::expect_identical(cbook$settings$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
testthat::expect_identical(cbook$settings$Something3,
list(1.0, 3.0, "test", 3.0, 1.0))
# Copy of mixed Constants list is also list
testthat::expect_identical(
cbook$rankaversion$Constants$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
testthat::expect_identical(
cbook$rankaversion$Constants$Something2,
list(1.0, 3.0, "test", 3.0, 1.0))
# Copy of numeric settings list (within settings)
testthat::expect_identical(
cbook$settings$StartToken,
list(9.0, 14.0, 17.0, 23.0, 38.0))
# Without calculations
testthat::expect_identical(cbook$settings$OtherTest1,
list(9.0, 14.0, 17.0, 23.0, 38.0))
# With calculations
testthat::expect_identical(cbook$settings$OtherTest2,
as.list(c(9.0, 14.0, 17.0, 23.0, 38.0) * 5L))
# Other
testthat::expect_identical(
cbook$rankaversion$Constants$StartToken,
list(9.0, 14.0, 17.0, 23.0, 38.0))
testthat::expect_identical(
cbook$rankaversion$Constants$StartToken2, # Ref to settings from Cons
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 2.0))
testthat::expect_identical(
cbook$rankaversion$Constants$StartToken3,
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 10.0))
# Calculations
testthat::expect_true(
cbook$rankaversion$Constants$players_per_group == "None")
testthat::expect_identical(
cbook$rankaversion$Constants$TestToken,
lapply(cbook$settings$StartToken, function(x) x * 5.0))
testthat::expect_true(
all(cbook$rankaversion$Player$Acc_DistributionChange$value ==
c("Ich hätte mich dennoch für Verfahren > xyz < entschieden.",
"Ich hätte mich für das alternative Verfahren > aaa < entschieden.",
"Ich hätte mich für das alternative Verfahren > bbb < entschieden.")))
testthat::expect_setequal(
cbook$rankaversion$Player$acceptance$choices$value,
c("xyz", "aaa", "Wrong, trick answer",
"Correct trick answer"))
})
testthat::test_that("Codebook - deprecated argument", {
warning <- testthat::capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
preamb = TRUE,
output = "list",
settings_replace = NULL,
doc_info = FALSE)
)
testthat::expect_true(any(grepl(pattern = "is deprecated",
x = warning)))
})
testthat::test_that("Codebook (w) - float in variable name", {
testthat::expect_warning(
cb <- codebook(
path = testthat::test_path("testdata", "ocode_y1"),
fsource = "models",
output = "list"
), paste0(
"too complex for this function.*",
"\\$test\\$Constants\\$min_payoffAB.*",
"\\$test\\$Player\\$min_payoffAB\\$max.*",
"\\$test\\$Group\\$min_payoffAB\\$max"
))
# Info: Correct result but a string instead of a float
testthat::expect_true(cb$test$Group$variable2$max == 3.3)
test1 <- cb$test$Constants$min_payoffAB ==
"(float(1.0)) + (float(1.1)) + (float(1.2))"
test2 <- cb$test$Group$min_payoffAB$max ==
"(float(1.0)) + (float(1.1)) + (float(1.2))"
test3 <- cb$test$Player$min_payoffAB$max ==
"(float(1.0)) + (float(1.1)) + (float(1.2))"
test4 <- cb$test$Group$variable2$max == 3.3
testthat::expect_true(all(c(test1, test2, test3, test4)))
})
testthat::test_that("Codebook (e)- equal signs in widgets", {
# If there are unescaped equal signs, errors are thrown
testthat::expect_error({
cbook <- codebook(testthat::test_path("testdata", "ocode_f5"),
fsource = "model",
doc_info = TRUE,
app = "MIG1",
output_file = "cb_of4_error",
output = "both")
}, " cannot be read properly by gmoTree.*MIG1\\$Player\\$user_total")
})
testthat::test_that("Codebook subsessions", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new4"),
fsource = "init",
include_subs = TRUE,
output = "list",
output_file = "ocode_g_codebook",
doc_info = FALSE)
# Check for false Subsession variables
testthat::expect_false("testvariable" %in%
cbook$bargaining$Subsession)
# Check for Subsession variables
testthat::expect_true("testvariable2" %in%
names(cbook$bargaining$Subsession))
testthat::expect_false(cbook$bargaining$Subsession$testvariable2$noargs)
testthat::expect_true(cbook$bargaining$Subsession$testvariable2$doc ==
"This is a normal Subsession variable.")
testthat::expect_true(cbook$bargaining$Subsession$testvariable2$field ==
"CurrencyField")
# Check for conditional Subsession variables
testthat::expect_true("conditional_testvariable" %in%
names(cbook$bargaining$Subsession))
testthat::expect_true(
cbook$bargaining$Subsession$conditional_testvariable$noargs)
testthat::expect_true(
cbook$bargaining$Subsession$conditional_testvariable$field ==
"CurrencyField")
})
testthat::test_that("Codebook (w) - with example, no settings.py", {
# Tests code that contains "with" + no settings.py
mywarnings <- testthat::capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_g"),
fsource = "init", # wrong because old otree
output = "list",
output_file = "ocode_g_codebook",
doc_info = FALSE)
)
test1 <- any(grepl(
pattern = "not in settings and cannot be replaced",
x = mywarnings))
test2 <- any(grepl(
pattern = "too complex for this function",
x = mywarnings))
test3 <- cbook$effort_add$Constants$NUM_ROUNDS == 1L
test4 <- cbook$effort_add$Constants$NAME_IN_URL == "effort_add"
test5 <- cbook$effort_add$Constants$NUM_TASKS == "len(INTS)"
test6 <- cbook$effort_add$Constants$TASK_TIMER == "settings.task_timer"
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
})
testthat::test_that("Codebook (w) - unmatched square brackets", {
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z13"),
fsource = "model",
output = "list",
doc_info = FALSE),
paste0("\\$rankaversion\\$Player\\$gender ",
"\\(unmatched square brackets\\).*\\(unmatched brackets\\)"))
# Brackets
cbook$rankaversion$Player$variable$doc == "(A doc in brackets))"
cbook$rankaversion$Player$variable2$doc == "A doc with one closing bracket"
# No warning when it comes to constants
testthat::expect_true(
cbook$rankaversion$Constants$Something == "[[information]")
# Even if there is a warning, it is still shown
testthat::expect_true(
cbook$rankaversion$Player$gender$doc == "[[Gender]")
})
testthat::test_that("Codebook - quotes", {
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
output_format = "latex",
output_file = "cb_quotestest",
output = "list",
settings_replace = NULL,
doc_info = FALSE)
)
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
output_format = "pdf_simple",
output_file = "cb_quotestest_simple",
output = "list",
settings_replace = NULL,
doc_info = FALSE)
)
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
output_format = "pdf",
output_file = "cb_quotestest",
output = "list",
settings_replace = NULL,
doc_info = FALSE)
)
# Doc with """ in them
testthat::expect_true(cbook$end$Player$hierarchy_of_principlesArg$doc ==
"Argument for Rejection")
# Doc with ''' in them
testthat::expect_true(cbook$end$Player$hierarchy_of_principlesArg2$doc ==
"Argument for Rejection")
testthat::expect_true(
cbook$end$Constants$without == "This is a without test")
# Normal string - Single values with single string def
testthat::expect_true(cbook$end$Constants$name_in_url == "end")
# Normal string - Single values with double string def
testthat::expect_true(cbook$end$Constants$name_in_url2 == "end")
# Normal string - single quoted strings within double string def
testthat::expect_true(cbook$end$Constants$singlequoteinsidedouble ==
"This is a 'test'")
# Normal string - escaped quoted strings within double string def
testthat::expect_true(cbook$end$Constants$doublequoteinsidesingle ==
"This is another \"test\"")
testthat::expect_true(cbook$end$Constants$doublequoteinsidesingle2 ==
"This is another \"test\" inside \"another test\"")
testthat::expect_true(cbook$end$Constants$escapedsinglequote ==
"This ia a 'single quote test'")
testthat::expect_true(cbook$end$Constants$escapeddoublequote ==
"This is a \"double quote test\"")
# Choices with single quotation marks
testthat::expect_true(
cbook$end$Player$Acc_DistributionChange$choices$value[1L] ==
"Ich hätte mich dennoch für Verfahren >settings.TokenAdd_1dName< entschieden.")
# Test next argument because they have different quotations:
testthat::expect_true(cbook$end$Player$Acc_DistributionChange$doc ==
"Former variable name: AnerkennungPrivat")
# Choices with double quotation marks
testthat::expect_true(
cbook$end$Player$Acc_DistributionChange2$choices$value[1L] ==
"Ich hätte mich dennoch für Verfahren >settings.TokenAdd_1dName< entschieden.")
testthat::expect_true(cbook$end$Player$Acc_DistributionChange2$doc ==
"Former variable name: AnerkennungPrivat")
})
testthat::test_that("Codebook - print", {
outputfilewithgetwd <- paste0(getwd(), "codebooktestprint")
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output_dir = "getwd()",
output_format = "latex_document",
output_file = outputfilewithgetwd,
output = "list",
app = "dictator",
doc_info = FALSE)
# Check for print removal in Constants
testthat::expect_true(cbook$dictator$Constants$NAME_IN_URL == "dictator")
testthat::expect_true(cbook$dictator$Constants$PLAYERS_PER_GROUP == 2L)
testthat::expect_true(
cbook$dictator$Constants$NUM_ROUNDS == 1L) # Here is print
testthat::expect_true(cbook$dictator$Constants$ENDOWMENT == "cu(100)")
# Check for print removal in Group
testthat::expect_true(all(
names(cbook$dictator$Group$kept) ==
c("noargs", "doc", "min", "max", "label", "field")))
testthat::expect_false(cbook$dictator$Group$kept$noargs)
testthat::expect_true(cbook$dictator$Group$kept$doc ==
"Amount dictator decided to keep for himself")
testthat::expect_true(cbook$dictator$Group$kept$min == 0L)
testthat::expect_true(cbook$dictator$Group$kept$label == "I will keep")
# Check for print removal in Player
testthat::expect_true(all(
names(cbook$dictator$Player) == c("gender", "chandler")))
testthat::expect_true(cbook$dictator$Player$gender$field == "IntegerField")
testthat::expect_false(cbook$dictator$Player$gender$noargs)
testthat::expect_true(cbook$dictator$Player$gender$doc == "Gender")
testthat::expect_true(all(
names(cbook$dictator$Player$chandler) == c("noargs", "doc", "field")))
testthat::expect_true(
cbook$dictator$Player$chandler$field == "IntegerField")
testthat::expect_false(cbook$dictator$Player$chandler$noargs)
testthat::expect_true(cbook$dictator$Player$chandler$doc == "Chandler")
})
testthat::test_that("Codebook - new oTree, app_rm", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
output_file = "newappapprm",
app_rm = "dictator",
doc_info = FALSE)
test1 <- !is.null(cbook$bargaining)
test2 <- is.null(cbook$dictator)
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(cbook$bargaining$Player$level$doc ==
"choices with only [1,2,3]")
})
testthat::test_that("Codebook - brackets, i.e. lists", {
# TODO + also check in PDF and word
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output = "list",
output_open = FALSE,
output_dir = NULL,
output_format = "pdf_simple",
output_file = "cb_bracket_newline",
fsource = "models",
splitvarname = TRUE,
sep_list = "newline"
), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output = "list",
output_dir = NULL,
output_format = "latex",
output_file = "cb_bracket_newline",
fsource = "models",
splitvarname = TRUE,
sep_list = "newline",
output_open = FALSE), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output = "list",
output_dir = NULL,
output_format = "word",
output_file = "bracket_newline_word",
fsource = "models",
splitvarname = TRUE,
sep_list = "newline",
output_open = FALSE), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output = "list",
output_dir = NULL,
output_file = "bracket_vector",
sep_list = "vector",
fsource = "models",
splitvarname = TRUE), "Some variables")
# First and last bracket
# First and last brackets are not removed for normale variables!
testthat::expect_true(
cbook$rankend$Constants$firstlastbr == "(firstlastbracketexample)")
# Empty list
testthat::expect_identical(cbook$rankend$Constants$emptylist, list())
testthat::expect_identical(cbook$rankend$Constants$emptylist2, list())
# Vector with numbers and strings
testthat::expect_type(
cbook$rankaversion$Constants$onelevelvectorl, "list")
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorl,
list("a", "b", 3.0))
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorl2,
list("a", "b", 3.0, "asdfadsf", "adsfadsfasdf",
"00asasdf", 2342.0, "wqerwerqewr"))
testthat::expect_type(
cbook$rankaversion$Constants$onelevelvectorl2, "list")
# Original oTree code has brackets: (Yes)
testthat::expect_true(
cbook$rankaversion$Player$acceptance$choices$value[1L] == "(Yes)")
# Test for numeric vectors in Constants
testthat::expect_identical(cbook$rankend$Constants$TestVector,
list(1.0, 10.0, 3.0, 4.0, 5.0))
# Test for numeric vectors in Settings
testthat::expect_identical(cbook$rankend$Constants$TestVector2,
list(99.0, 66.0, 33.0))
# Test for character vectors in Constants
testthat::expect_identical(cbook$rankend$Constants$TestVectorC,
list("a", "b", 6.0))
# Test for character vectors in Settings
testthat::expect_identical(cbook$rankend$Constants$TestVectorC2,
list("d", "e", 4.0))
# Test for two-level lists
testthat::expect_type(cbook$rankaversion$Constants$choices, "list")
testthat::expect_true(identical(
cbook$rankaversion$Constants$choices[[1L]],
list(4.0, 1.0, 1.0, 0.5, "noRR_needSat", 3.0, 2.0)
))
# If closing bracket is at next row
testthat::expect_identical(
cbook$rankaversion$Constants$nextrowbracket[[1L]],
list(69.0, 43.0, 5.0))
# If closing bracket is at same row
testthat::expect_identical(
cbook$rankaversion$Constants$samerowbracket[[1L]],
list(69.0, 43.0, 5.0))
# If there is a space before the second opening bracket
testthat::expect_identical(
cbook$rankaversion$Constants$spacebeforebracket[[1L]],
list(2004.0, 43.0, 5.0))
# If there is a comment before the second opening bracket
testthat::expect_identical(
cbook$rankaversion$Constants$commentafterbracket[[1L]],
list(69.0, 43.0, 5.0))
# If there is a space before the last closing bracket
testthat::expect_identical(
cbook$rankaversion$Constants$spaceafterbracket[[1L]],
list(69.0, 43.0, 5.0))
# If there is a space after a comma
testthat::expect_identical(
cbook$rankaversion$Constants$spaceaftercomma[[1L]],
list(2004.0, 43.0, 5.0))
# If there is a comment after a comma
testthat::expect_identical(
cbook$rankaversion$Constants$commentaftercomma[[1L]],
list(2004.0, 43.0, 5.0))
})
testthat::test_that("Codebook (e) - three level list in constants", {
# In constants
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z10"),
output_dir = NULL,
output = "list",
fsource = "model")
}, "This function does not support lists with more.*Constants")
})
testthat::test_that("Codebook - old oTree", {
testthat::expect_message(
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z"),
fsource = "model",
output = "list",
doc_info = TRUE),
paste0(".*too complex for this function.*rankaversion",
"\\$Constants.*\\$rankend\\$Constants \\(read_csv\\).*",
"\\$settings\\$showupToken \\(float\\).*",
"\\$end\\$Constants\\$showupToken \\(float\\).*",
"\\$end\\$Constants\\$showupTokenTest \\(float\\)")
), paste0("Variables without.*rankaversion\\$Player\\$choicenumber.*",
"rankend\\$Player\\$done_distribution"))
# Tests
testthat::expect_type(cbook, "list")
# Test settings in settings replacements
testthat::expect_identical(
cbook$settings$payoffPart1_c,
cbook$settings$ExchangeToken * 6L)
# Test settings in Constants replacement
testthat::expect_identical(
cbook$end$Constants$payoffPart1_c,
cbook$settings$payoffPart1_c)
testthat::expect_identical(
cbook$end$Constants$ExchangeToken,
cbook$settings$ExchangeToken)
# Others
testthat::expect_true(cbook$rankaversion$Constants$randomtest == 35L)
testthat::expect_true(cbook$end$Constants$ExchangeToken == 4L)
# Test constants in Constants replacement
testthat::expect_true(cbook$end$Constants$ExchangeRate ==
as.numeric(cbook$end$Constants$ExchangeToken) /
as.numeric(cbook$end$Constants$ExchangeMainCurrency))
testthat::expect_true(cbook$end$Constants$showupToken ==
cbook$end$Constants$showupTokenTest)
# Choices are not stored as lists!
testthat::expect_false(
is.list(cbook$rankaversion$Player$is_trick$choices$value))
testthat::expect_false(
is.list(cbook$rankaversion$Player$is_trick$choices$key))
})
testthat::test_that("Codebook - several lines", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_count"),
fsource = "init",
output_open = FALSE,
output = "list",
output_file = "cb_severallines",
doc_info = TRUE)
# The newline sign \ should be removed:
testthat::expect_true(
cbook$ocode_count$C$STRING_TO_GUESS ==
paste0("Die ältesten bekannten kieferlosen Fischartigen ",
"(z. B. die Pteraspidomorphi) stammen aus dem frühen Ordovizium ",
"vor rund 450–470 Millionen Jahren."))
testthat::expect_true(
cbook$ocode_count$C$SOLUTION ==
paste0("get_char_counts(Die ältesten bekannten kieferlosen Fischartigen ",
"(z. B. die Pteraspidomorphi) stammen aus dem frühen Ordovizium ",
"vor rund 450–470 Millionen Jahren.)"
))
})
testthat::test_that("Codebook (w) - vector var in settings and constants", {
# Dissertation code
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z3"),
fsource = "models",
output = "list",
doc_info = FALSE), "too complex for this function")
# Since R only saves the same type in a vector
testthat::expect_identical(
cbook$settings$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
testthat::expect_identical(
cbook$rankaversion$Constants$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
# Otherwise
testthat::expect_identical(
cbook$settings$StartToken,
list(9.0, 14.0, 17.0, 23.0, 38.0))
test4 <- identical(
cbook$rankaversion$Constants$StartToken,
list(9.0, 14.0, 17.0, 23.0, 38.0)
)
test5 <- identical(
cbook$rankaversion$Constants$StartToken2,
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 2L))
test6 <- identical(
cbook$rankaversion$Constants$StartToken3,
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 10L))
# Calculations
test7 <- identical(cbook$settings$OtherTest1,
list(9.0, 14.0, 17.0, 23.0, 38.0))
test8 <- identical(
cbook$settings$OtherTest2,
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 5L))
test9 <-
cbook$rankaversion$Constants$players_per_group == "None"
test10 <- identical(
cbook$rankaversion$Constants$TestToken,
lapply(cbook$settings$StartToken, function(x) x * 5L))
test11 <- all(
cbook$rankaversion$Player$Acc_DistributionChange$value ==
c("Ich hätte mich dennoch für Verfahren > xyz < entschieden.",
"Ich hätte mich für das alternative Verfahren > aaa < entschieden.",
"Ich hätte mich für das alternative Verfahren > bbb < entschieden."))
test12 <- all(cbook$rankaversion$Player$acceptance$choices$value ==
c("xyz", "aaa", "Wrong, trick answer", "Correct trick answer"))
testthat::expect_true(all(test4))
testthat::expect_true(all(test5))
testthat::expect_true(all(test6))
testthat::expect_true(all(test7))
testthat::expect_true(all(test8))
testthat::expect_true(all(test9))
testthat::expect_true(all(test10))
testthat::expect_true(test11)
testthat::expect_true(test12)
})
testthat::test_that("choices without key", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = FALSE,
app = "bargaining")
# Tests
test1 <- cbook$bargaining$Player$level2$choices[1L] == "No, I won't"
test2 <- cbook$bargaining$Player$level2$choices[2L] == "yes, I will"
test3 <- cbook$bargaining$Player$level2$choices[3L] == "Maybe I'll do"
testthat::expect_true(all(c(test1, test2, test3)))
})
testthat::test_that("Codebook - documentation of variables", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z8"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output = "list")
testthat::expect_true(cbook$rankaversion$Player$gender$doc ==
"Gender documentation with double quotations")
testthat::expect_true(cbook$rankaversion$Player$gender2$doc ==
"Gender documentation with single quotations")
testthat::expect_true(
cbook$rankaversion$Player$gender3$doc ==
"Gender documentation with tripple double quotations")
testthat::expect_true(
cbook$rankaversion$Player$gender4$doc ==
"Gender documentation with tripple single quotations")
testthat::expect_true(grepl(
cbook$rankaversion$Player$crt_bat$label,
pattern = "^A bat and a ball.*cost\\?$"))
testthat::expect_true(grepl(
cbook$rankaversion$Player$crt_bat2$label,
pattern = "^A bat and a ball.* cost\\?$"))
})
testthat::test_that("Codebook (w) - constants var not there", {
# Try user Var
testthat::expect_message(
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new2"),
fsource = "init",
output = "list"), "is not in Constants"),
"Variables without documentation.*bargaining\\$Group\\$total_requests")
test1 <-
cbook$bargaining$Player$request$max == "C.AMOUNT_SHARED_false"
# Check if leading and trailing brackets and comments are removed
# Original "(Please enter an amount from 0 to 100)"
test2 <- cbook$bargaining$Player$request$label ==
"(Please enter an amount from 0 to 100)"
test3 <- cbook$bargaining$Player$request2$label ==
"Please enter an amount from 0 to 100"
test4 <- cbook$bargaining$Player$request3$label ==
"Please enter an amount from 0 to 100"
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
})
testthat::test_that("Codebook - new oTree, only one app", {
testthat::expect_message(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = TRUE,
app = "public_goods_simple"),
"Variables without documentation, label, or verbose name:"
)
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# Remove leading and trailing """ from doc
test9 <- cbook$volunteer_dilemma$Player$volunteer$doc ==
"Whether player volunteers"
# Remove leading and trailing ' from label
test9 <- cbook$volunteer_dilemma$Player$volunteer$label ==
"Do you wish to volunteer?"
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
})
testthat::test_that("Codebook - key value", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z7"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output = "list")
# Choices are not stored as lists!
testthat::expect_false(
is.list(cbook$rankaversion$Player$is_trick$choices$value))
testthat::expect_false(
is.list(cbook$rankaversion$Player$is_trick$choices$key))
# Key and value in double quotations
testthat::expect_true(all(
cbook$rankaversion$Player$gender$choices$key == c("Male1", "Female")))
testthat::expect_true(all(
cbook$rankaversion$Player$gender$choices$value == c("Male", "Femaleval")))
# Key and value in single quotations
testthat::expect_true(all(
cbook$rankaversion$Player$gender2$choices$key == c("Male", "Female")))
testthat::expect_true(all(
cbook$rankaversion$Player$gender2$choices$value ==
c("Male", "Femaleval")))
})
testthat::test_that("Codebook - empty arguments", {
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output = "list"))
# Empty argument after choices
testthat::expect_true(
cbook$rankaversion$Player$a_richer$choices$value[[2L]] ==
"B is the richer person")
testthat::expect_true(all(
names(cbook$rankaversion$Player$a_richer) ==
c("noargs", "doc", "choices", "field")))
testthat::expect_true(all(
cbook$rankaversion$Player$a_richer$choices$value ==
c("A is the richer person", "B is the richer person")))
# Empty arguments after doc
testthat::expect_true(
cbook$rankaversion$Player$testempty$doc == "This is an example doc")
testthat::expect_true(all(names(cbook$rankaversion$Player$testempty) ==
c("noargs", "doc", "field")))
# Variable after that
testthat::expect_true(exists("is_trick", cbook$rankaversion$Player))
})
testthat::test_that("Codebook - from-to string values", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z5"),
fsource = "models",
output_format = "html",
output_file = "fromtovalues",
output = "list",
settings_replace = NULL,
doc_info = FALSE)
testthat::expect_true(
cbook$end$Player$money_in_month$choices$value[1L] == "0-399")
testthat::expect_true(
cbook$end$Player$money_in_month$choices$value[2L] == "400-699")
})
testthat::test_that("Codebook - newlines in doc", {
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
output = "list",
settings_replace = NULL,
doc_info = FALSE))
testthat::expect_true(cbook$end$Player$completionCode$doc ==
paste0("Completion Code for MTurk. Has no role for the ",
"experiment and will not be validated unless there are ",
"legal problems with the participants"))
testthat::expect_true(cbook$end$Player$completionCodespaces$doc ==
paste0("Completion Code for MTurk. Has no role for the experiment ",
"and will not be validated unless there are legal problems with ",
"the participants"))
})
testthat::test_that("Codebook (e) - settings var. not there3", {
# Try user Var but with some missing
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error = "Test"),
settings_replace = "user",
output = "list")
, paste0(" not in user\\_settings and cannot be replaced.*",
"\\$rankaversion\\$MinutesForSurvey"))
})
# Equal sign
testthat::test_that("Codebook - escaped equal signs in doc values", {
cbook <- codebook(testthat::test_path("testdata", "ocode_f2"),
fsource = "model",
app = "MIG1",
doc_info = FALSE,
output = "list")
# Vales in oTree code should be written with \=
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionFinal$doc ==
"Final Consumption \\= with TokenAdd as voted for by group")
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionNoDis$doc ==
"Initial Consumption \\= no Redistribution")
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionEqual$doc ==
"Initial Consumption \\= with TokenAdd as suggested by Experimenter")
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionWeakerFirst$doc ==
"Initial Consumption \\= with TokenAdd as suggested by Weaker First")
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionMixed$doc ==
"Initial Consumption \\= with TokenAdd as suggested by Mixed")
})
testthat::test_that("Codebook (e)- equal signs in doc values", {
# If there are unescaped equal signs, errors are thrown
testthat::expect_error({
cbook <- codebook(testthat::test_path("testdata", "ocode_f1"),
fsource = "model",
doc_info = FALSE,
app = "MIG1",
output_file = "esindoc",
output = "list")
}, "read properly by gmoTree.*\\$MIG1\\$Player\\$P1_ConsumptionFinal")
})
testthat::test_that("Codebook (e)- equal signs in choices values", {
# If there are unescaped equal signs, errors are thrown
testthat::expect_error({
cbook <- codebook(testthat::test_path("testdata", "ocode_f3"),
fsource = "model",
doc_info = FALSE,
app = "MIG1",
output = "list")
}, paste0("cannot be read properly by gmoTree.*",
"\\$MIG1\\$Group\\$treatment_ec.*\\$MIG1\\$Player\\$P1_AckVote"))
})
testthat::test_that("Codebook - escaped equal signs in choices values", {
# If there are unescaped equal signs, errors are thrown
cbook <- codebook(testthat::test_path("testdata", "ocode_f4"),
fsource = "model",
doc_info = FALSE,
app = "MIG1",
output_file = "esc_equal_signs",
output = "list")
# TODO + Also check in output file: variable treatment_ec,P1_AckVote
testthat::expect_true(length(cbook$MIG1$Group$treatment_ec$choices) == 2L)
testthat::expect_true(cbook$MIG1$Group$treatment_ec$choices$key[1L] == 0L)
testthat::expect_true(cbook$MIG1$Group$treatment_ec$choices$value[1L] ==
"0 \\= tolle Anfangssausstattung")
testthat::expect_true(length(cbook$MIG1$Player$P1_AckVote$choices) == 2L)
testthat::expect_true(cbook$MIG1$Player$P1_AckVote$choices$value[1L] ==
"Das Verfahren x \\= 1 soll anerkannt werden")
# Other tests
testthat::expect_true(all(
names(cbook$MIG1$Group$P1_Rej_nArgAkzNo_2) ==
c("noargs", "initial", "field")))
testthat::expect_identical(cbook$MIG1$Constants$ChatTime_Ack, 6.0)
testthat::expect_identical(cbook$MIG1$Constants$ChatTime_Ack_Sec,
cbook$MIG1$Constants$ChatTime_Ack * 60L)
})
# Output
testthat::test_that("Codebook (e) - wrong output format", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "both",
output_open = TRUE,
output_format = "WrongFormat",
doc_info = FALSE)}, "Output format should be")
})
testthat::test_that("Codebook (e) - dots in names", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_file = "codebook.error",
output = "both",
output_open = TRUE,
fsource = "init")
}, "You are not allowed to use dots in your output_file names")
})
testthat::test_that("Codebook (e) - dir not there", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_file = "codebooknothappening",
output_dir = "E:/folder",
output = "both",
output_open = TRUE,
fsource = "init")
}, "The directory.*does not exist yet.")
})
testthat::test_that("Codebook (e) - wrong output", {
# Wrong text
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = NULL,
output = "WRONG",
fsource = "init")}, "Output should be")
# NULL
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = NULL,
output = "NULL",
fsource = "init")}, "Output should be")
# Two inputs
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = NULL,
fsource = "init",
output = c("file", "list"))},
"Output should be")
# Output dir and file don't align
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_file = "E:/folder/filename",
output_dir = "E:/folder2",
output = "both",
output_open = TRUE,
fsource = "init")}, "When using an absolute path for")
})
testthat::test_that("Codebook (e) - output file contains invalid path", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output_dir = NULL,
output_file = "E:/GMO/gmoTree2/codebooktestprint/patherror",
output = "both",
output_open = TRUE,
app = "dictator",
doc_info = FALSE), "The directory .* does not exist.")
})
testthat::test_that("Codebook (e) - empty output_file", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_file = NULL,
output = "both",
output_open = TRUE,
fsource = "init")
}, "Please enter a output_file name!")
})
testthat::test_that("Codebook (e) - params", {
warnings <- testthat::capture_warnings(
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
params = "ab",
output = "list"),
"params must be a list"))
})
# Choosing apps
testthat::test_that("Codebook (e) - app and app rm specified", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = FALSE,
app = "dictator",
app_rm = "public_goods_simple"),
"Please specify only \"app\" or \"app_rm")
})
testthat::test_that("Codebook (e) - apps don't exist", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
app = c("dictator", "nonexistingapp"),
doc_info = FALSE)}, "At least one app")
})
testthat::test_that("Codebook (e) - one app not there", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z"),
fsource = "init", # wrong because old otree
output = "list",
doc_info = TRUE,
app = "xyp"),
"not in oTree code"
)
})
# Settings
testthat::test_that("Codebook - three level list in settings work", {
# If settings_replace is global
testthat::expect_error({
cbook1 <- codebook(
path = testthat::test_path("testdata", "ocode_z11"),
output_dir = NULL,
output = "list",
settings_replace = "global",
fsource = "model")
}, "not support lists.*settings")
# If settings_replace is NULL
cbook2 <- codebook(
path = testthat::test_path("testdata", "ocode_z11"),
output_dir = NULL,
output = "list",
settings_replace = NULL,
fsource = "model")
testthat::expect_null(cbook2$rankaversion$settings)
testthat::expect_true(
cbook2$rankaversion$Constants$Something == "settings.Something")
})
testthat::test_that("Codebook (w) - setting var not there 4", {
# Try user Var
message <- capture_messages(
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new3"),
settings_replace = "global",
fsource = "init",
output = "list")
, "are not in settings and"))
testthat::expect_true(
grepl(x = paste(message, collapse = ""),
pattern = paste0("Variables without documentation.*bargaining",
"\\$Group\\$total_requests")))
test1 <-
cbook$bargaining$Player$request$max == "settings.AMOUNT_SHARED"
testthat::expect_true(test1)
})
testthat::test_that("Codebook - setting, constants type", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z9"),
fsource = "models",
output = "list",
doc_info = FALSE)
testthat::expect_identical(
cbook$settings$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
testthat::expect_identical(
cbook$settings$Something,
cbook$rankaversion$Constants$Something)
})
testthat::test_that("Codebook (e) - wrong settings replace", {
# Wrong text
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error = "Test"),
settings_replace = "wrongString",
output = "list"),
"must be either")
})
testthat::test_that("Codebook (e) - user settings and global_s mismatch", {
# Wrong settings_replace
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error = "Test",
showupToken = 2L),
settings_replace = "global",
output = "list")
, "settings_replace must be set to"
)
# Wrong variable
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error = "Test",
showupToken = 2L),
settings_replace = "user",
output = "list"),
"not in user_settings and"
)
})
testthat::test_that("Codebook (w) - settings var. not there 1", {
# Settings not there
warnings <- testthat::capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
output = "list",
doc_info = FALSE)
)
test1 <- any(grepl(pattern = "not in settings and cannot be replaced",
x = warnings))
test2 <- any(grepl(pattern = "too complex for this function",
x = warnings))
testthat::expect_true(test1)
testthat::expect_true(test2)
})
testthat::test_that("Codebook (w) - folder without settings", {
warnings <- testthat::capture_warnings(
cbook <- codebook(
fsource = "model",
path = testthat::test_path("testdata", "ocode_z3.1"),
output = "list",
doc_info = FALSE))
test1 <- any(grepl(
pattern = paste0("There is no settings.* in your path..*\\$rankaversion",
"\\$Testnumber, reference \"settings.Testnumber"),
x = warnings))
test2 <- any(grepl(
pattern = "too complex",
x = warnings))
testthat::expect_true(test1)
testthat::expect_true(test2)
# Check if variables are there only once
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$Testnumber") == 1L)
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$Something") == 1L)
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$TestToken") == 1L)
# User settings
warnings <- testthat::capture_warnings(
cbook <- codebook(
fsource = "model",
path = testthat::test_path("testdata", "ocode_z3.1"),
output = "list",
settings_replace = "user",
doc_info = FALSE))
# Check if variables are there only once
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$Testnumber") == 1L)
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$Something") == 1L)
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$TestToken") == 1L)
})
testthat::test_that("Codebook - user_settings", {
# Comparison without settings.py variable
testthat::expect_warning(
cbook_default <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
settings_replace = "global",
doc_info = FALSE,
output = "list"))
# Try user Var - integer vector
testthat::expect_warning(
cbook_integer <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error2 = "Test",
showupToken = 2L,
max_payoffPart1_ab = 1L,
ExchangeMainCurrency = 1L,
payoff_survey = 1L,
MinutesForSurvey = 20L,
TestVector2 = c(1L, 2L, 3L),
TestVectorC2 = c("a", "b"),
ExchangeToken = 1L,
timer123 = 12L,
payoffPart1_c = 1L),
settings_replace = "user",
doc_info = FALSE,
output = "list"), "too complex for this function")
# Try user Var - double vector
testthat::expect_warning(
cbook_double <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error2 = "Test",
showupToken = 2L,
max_payoffPart1_ab = 1L,
ExchangeMainCurrency = 1L,
payoff_survey = 1L,
MinutesForSurvey = 20L,
TestVector2 = c(1.0, 2.2, 3.0),
TestVectorC2 = c("a", "b"),
ExchangeToken = 1L,
timer123 = 12L,
payoffPart1_c = 1L),
settings_replace = "user",
doc_info = FALSE,
output = "list"), "too complex for this function")
testthat::expect_true(cbook_default$rankend$Constants$Test1 == 1000L)
testthat::expect_identical(cbook_default$rankend$Constants$TestVector,
list(1.0, 10.0, 3.0, 4.0, 5.0)) # Info: double!
testthat::expect_identical(cbook_default$rankend$Constants$TestVectorC,
list("a", "b", 6.0)) # Info: double!
# Variables in settings.py
testthat::expect_true(
cbook_default$rankaversion$Constants$error2 == "Error2insettings")
testthat::expect_true(
cbook_default$rankaversion$Constants$MinutesForSurvey == 18L)
testthat::expect_identical(
cbook_default$rankend$Constants$TestVector2,
list(99.0, 66.0, 33.0)) # settings.TestVector2 (Info - saved as double )
testthat::expect_identical(cbook_default$rankend$Constants$TestVectorC2,
list("d", "e", 4.0))
# Variables in user_settings
test3 <- cbook_integer$rankaversion$Constants$error2 == "Test"
test4 <- cbook_integer$rankaversion$Constants$MinutesForSurvey == 20L
# Run
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_identical(
cbook_integer$rankend$Constants$TestVector2,
list(1.0, 2.0, 3.0))
testthat::expect_identical(
cbook_double$rankend$Constants$TestVector2,
list(1.0, 2.2, 3.0))
# In the output file it is shown without digits after the comma (except 2.2)
})
# Fsource
testthat::test_that("Codebook (e) - fsource not valid", {
# Wrong source text
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "xx",
output = "list",
doc_info = TRUE,
app = "public_goods_simple"),
"fsource must be either")
# If source is NULL
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = NULL,
output = "list",
doc_info = TRUE,
app = "public_goods_simple"),
"fsource must be either")
# Wrong length
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = NULL,
fsource = c("init", "model"),
output = "list")}, "Please enter only one fsource")
})
testthat::test_that("Codebook (e) - fsource init instead of models", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z"),
fsource = "init", # wrong because old otree
output = "list",
doc_info = TRUE),
"At least one of your init-files is empty"
)
})
testthat::test_that("Codebook (e) - fsource models instead of init", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "model", # wrong because new otree
output = "list",
doc_info = TRUE,
app = "public_goods_simple"), "No files to process"
)
})
# List variables
testthat::test_that("Codebook - check sublists with different types", {
# Other sublist tests are in brackets tests
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z6"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output = "list")
)
# Original in code:
# [8, 2, 2, 2.5, "noRR_needy", settings.v2, 4]
# [80, 20, 2, 2.5, "noRR_needy", "settings.shouldnotwork", 4]
# ["8", 2, 2, 2.5, "noRR_needy", settings.v2, 4]
# Check if original numbers are numbers
testthat::expect_true(
cbook$rankaversion$Constants$choices[[1L]][[1L]] == 8L)
testthat::expect_true(
cbook$rankaversion$Constants$choices[[2L]][[1L]] == 80L)
testthat::expect_true(
cbook$rankaversion$Constants$choices[[3L]][[1L]] == "8")
testthat::expect_true(
cbook$rankaversion$Constants$choices[[1L]][[6L]] ==
"replacingsettingsworked")
testthat::expect_true(cbook$rankaversion$Constants$choices[[2L]][[6L]] ==
"settings.shouldnotwork")
})
# Path
testthat::test_that("Codebook (e) - path does not exist", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "nopath"),
fsource = "init",
output = "list",
doc_info = TRUE,
app = "public_goods_simple"),
"does not exist")
})
testthat::test_that("Codebook (e) - path is NULL", {
# Wrong path
testthat::expect_error(
cbook <- codebook(
path = NULL,
output = "list",
doc_info = TRUE), "Path must not be NULL")
})
testthat::test_that("Codebook (e) - relative path", {
# Relative path ../
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output_dir = "../",
output = "both",
output_open = TRUE,
doc_info = TRUE), "Please don't use relative paths in output_dir")
# Relative path ..
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = "..",
output = "both",
output_open = TRUE,
doc_info = TRUE), "Please don't use relative paths in output_dir")
# Relative path .
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = ".",
output = "both",
output_open = TRUE,
doc_info = TRUE), "Please don't use relative paths in output_dir")
# Relative path
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = "./",
output = "both",
output_open = TRUE,
doc_info = TRUE), "Please don't use relative paths in output_dir")
})
# Sort
testthat::test_that("Codebook - new oTree, correct sort", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
include_subs = TRUE,
output = "list",
doc_info = FALSE,
sort = c("traveler_dilemma", "survey",
"bargaining", "volunteer_dilemma", "bertrand",
"common_value_auction", "cournot",
"dictator", "guess_two_thirds",
"matching_pennies", "payment_info",
"prisoner", "public_goods_simple",
"trust", "trust_simple"))
# Tests
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# If there is only one group field without information in it
test9 <-
cbook$bertrand$Group$winning_price$field ==
"CurrencyField"
# If there is one group field that has information in it
test10 <- cbook$dictator$Group$kept$field ==
"CurrencyField"
# If there are two group fields with no information in them
test11 <-
cbook$public_goods_simple$Group$total_contribution$field ==
"CurrencyField"
test12 <-
all(names(cbook) ==
c("settings", "traveler_dilemma", "survey",
"bargaining", "volunteer_dilemma", "bertrand",
"common_value_auction", "cournot",
"dictator", "guess_two_thirds",
"matching_pennies", "payment_info",
"prisoner", "public_goods_simple",
"trust", "trust_simple"))
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
testthat::expect_true(test9)
testthat::expect_true(test10)
testthat::expect_true(test11)
testthat::expect_true(test12)
})
testthat::test_that("Codebook (w) - new oTree, too many sort 2", {
original_sort <-
c("bargaining", "bertrand", "common_value_auction", "cournot",
"dictator", "guess_two_thirds", "matching_pennies", "payment_info",
"prisoner", "public_goods_simple", "survey", "traveler_dilemma",
"trust", "trust_simple", "volunteer_dilemma")
new_sort <- c("thisisnothere", "payment_info",
"bargaining", "volunteer_dilemma",
"bertrand", "common_value_auction",
"cournot", "dictator",
"guess_two_thirds", "matching_pennies",
"prisoner", "public_goods_simple",
"survey", "traveler_dilemma",
"trust", "trust_simple")
thiswarning <- capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = FALSE,
sort = new_sort)
)
# Tests
testthat::expect_true(any(
grepl(x = thiswarning, pattern = "Sort elements not in apps are")))
testthat::expect_true(
any(grepl("Sort apps are not equal to all apps", thiswarning)))
testthat::expect_true(any(grepl("Sort elements not in apps are",
thiswarning)))
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# If there is only one group field without information in it
test9 <- cbook$bertrand$Group$winning_price$field == "CurrencyField"
# If there is one group field that has information in it
test10 <- cbook$dictator$Group$kept$field == "CurrencyField"
# If there are two group fields with no information in them
test11 <-
cbook$public_goods_simple$Group$total_contribution$field ==
"CurrencyField"
test12 <-
all(names(cbook) == c("settings", original_sort))
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
testthat::expect_true(test9)
testthat::expect_true(test10)
testthat::expect_true(test11)
testthat::expect_true(test12)
})
testthat::test_that("Codebook (w) - new oTree, false sort", {
thiswarning <- capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = FALSE,
sort = c("public_goods_simple", "dictator")
))
# Tests
testthat::expect_true(
any(grepl("Sort apps are not equal to all apps", thiswarning)))
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# If there is only one group field without information in it
test9 <- cbook$bertrand$Group$winning_price$field == "CurrencyField"
# If there is one group field that has information in it
test10 <- cbook$dictator$Group$kept$field == "CurrencyField"
# If there are two group fields with no information in them
test11 <-
cbook$public_goods_simple$Group$total_contribution$field ==
"CurrencyField"
test12 <-
all(names(cbook) ==
c("settings", "bargaining", "bertrand",
"common_value_auction", "cournot",
"dictator", "guess_two_thirds",
"matching_pennies", "payment_info",
"prisoner", "public_goods_simple",
"survey", "traveler_dilemma",
"trust", "trust_simple", "volunteer_dilemma"))
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
testthat::expect_true(test9)
testthat::expect_true(test10)
testthat::expect_true(test11)
testthat::expect_true(test12)
})
testthat::test_that("Codebook (w) - too many sort", {
# Without trust_simple
original_sort <-
c("bargaining", "bertrand", "common_value_auction", "cournot",
"dictator", "guess_two_thirds", "matching_pennies", "payment_info",
"prisoner", "public_goods_simple", "survey", "traveler_dilemma",
"trust", "trust_simple", "volunteer_dilemma")
new_sort <- c("thisisnothere", "payment_info",
"bargaining", "volunteer_dilemma",
"bertrand", "common_value_auction",
"cournot", "dictator",
"guess_two_thirds", "matching_pennies",
"prisoner", "public_goods_simple",
"survey", "traveler_dilemma",
"trust")
thiswarning <- capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
output_format = "word_document",
doc_info = FALSE,
sort = new_sort)
)
# Tests
testthat::expect_true(any(
grepl(x = thiswarning, pattern = "Sort elements not in apps are")))
testthat::expect_true(
any(grepl("Sort apps are not equal to all apps", thiswarning)))
testthat::expect_true(any(grepl("Sort elements not in apps are",
thiswarning)))
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# If there is only one group field without information in it
test9 <- cbook$bertrand$Group$winning_price$field == "CurrencyField"
# If there is one group field that has information in it
test10 <- cbook$dictator$Group$kept$field == "CurrencyField"
# If there are two group fields with no information in them
test11 <-
cbook$public_goods_simple$Group$total_contribution$field ==
"CurrencyField"
test12 <-
all(names(cbook) == c("settings", original_sort))
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
testthat::expect_true(test9)
testthat::expect_true(test10)
testthat::expect_true(test11)
testthat::expect_true(test12)
# Test if "yes, I will" is one element
testthat::expect_true(
length(cbook$bargaining$Player$level2$choices) == 3L)
testthat::expect_true(
cbook$bargaining$Player$level2$choices[1L] == "No, I won't")
testthat::expect_true(
cbook$bargaining$Player$level2$choices[3L] == "Maybe I'll do")
# Test for ''' documentations
test1 <- grepl(
pattern = "^A bat and a ball cost 22 dollars in total.*the ball cost\\?$",
x = cbook$survey$Player$crt_bat$label)
# Test for """ documentations
test2 <- grepl(
pattern = "^If it takes 5 machines 5.*make 100 widgets\\?$",
x = cbook$survey$Player$crt_widget$label)
testthat::expect_true(test1)
testthat::expect_true(test2)
# Test for ' choices
testthat::expect_true(
cbook$survey$Player$gender$choices$key[1L] == "Male")
testthat::expect_true(
cbook$survey$Player$gender$choices$key[2L] == "Female")
testthat::expect_true(
cbook$survey$Player$gender$choices$value[1L] == "Male")
testthat::expect_true(
cbook$survey$Player$gender$choices$value[2L] == "Female")
# Test for " choices
testthat::expect_true(
cbook$survey$Player$gender2$choices$key[1L] == "Male")
testthat::expect_true(
cbook$survey$Player$gender2$choices$key[2L] == "Female")
testthat::expect_true(
cbook$survey$Player$gender2$choices$value[1L] == "Male")
testthat::expect_true(
cbook$survey$Player$gender2$choices$value[2L] == "Female")
# Further
# True: Cooperate, False Defect
testthat::expect_length(cbook$prisoner$Player$cooperate$choices, 2L)
testthat::expect_s3_class(cbook$prisoner$Player$cooperate$choices,
"data.frame")
})
}
Try the gmoTree package in your browser
Any scripts or data that you put into this service are public.
gmoTree documentation built on April 3, 2025, 10:26 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
if (rlang::is_installed(c("withr", "testthat"))) {
print("---- start codebook tests -----")
testthat::test_that("Codebook - pdf brackets", {
# TODO + here check everywhere how rankaversion$Constants$choices
# is displayed in the output
# Check also for long variables names: commentaftercomma_mean
# (not prettily shown in word output because of long len() values)
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
output_file = "newline", # Pretty :)
splitvarname = TRUE,
doc_info = FALSE,
output = "list",
sep_list = "newline"), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output_file = "cb_vector_complex", # Not pretty yet
doc_info = FALSE,
output = "list",
sep_list = "vector"),
"Some variables or code parts contain code that is too complex")
# TODO + Output was not working properly because the cell is too large,
# Now everything seems okay. Check again
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output_format = "pdf_document_simple_nl", # Not pretty yet
output_file = "cb_vector_simple",
output = "list",
doc_info = FALSE,
sep_list = "newline"), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output_format = "word_document", # Word works
output_file = "vector_word",
output = "list",
doc_info = FALSE,
sep_list = "vector"), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output_format = "word_document", # Word works
output_file = "newline_word",
output = "list",
doc_info = FALSE,
sep_list = "newline"), "Some variables")
# List with sublists - all numbers
testthat::expect_identical(
cbook$rankaversion$Constants$commentaftercomma,
list(
list(2004.0, 43.0, 5.0),
list(81.0, 91.0, 81.0),
list(18.0, 63.0, 67.0),
list(45.0, 56.0, 75.0),
list(3.0, 84.0, 77.0)))
testthat::expect_identical(
cbook$rankaversion$Constants$commentaftercomma_max,
2004.0)
testthat::expect_identical(
cbook$rankaversion$Constants$commentaftercomma_min, 3.0)
testthat::expect_identical(
round(cbook$rankaversion$Constants$commentaftercomma_mean, 1),
round(mean(c(2004L, 43L, 5L, 81L, 91L, 81L, 18L, 63L,
67L, 45L, 56L, 75L, 3L, 84L, 77L)), 1))
# List with sublists - mixed types
testthat::expect_identical(
cbook$rankaversion$Constants$choices[[1L]],
list(4.0, 1.0, 1.0, 0.5, "noRR_needSat", 3.0, 2.0))
testthat::expect_true(
startsWith(
x = cbook$rankaversion$Constants$min_choices,
prefix = "min(list(list(4, 1, 1, 0.5, noRR_needSat, 3, 2), list(5, "))
testthat::expect_true(
startsWith(
x = cbook$rankaversion$Constants$max_choices,
prefix = "max(list(list(4, 1, 1, 0.5, noRR_needSat, 3, 2), list(5, "))
# One level list with all numbers
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorn,
list(1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0,
11.0, 12.0, 13.0, 14.0, 15.0, 16.0, 17.0))
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorn_min, 1.0)
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorn_max, 17.0)
testthat::expect_true(
cbook$rankaversion$Constants$onelevelvectorn_mean ==
mean(unlist(cbook$rankaversion$Constants$onelevelvectorn)))
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorl2,
list("a", "b", 3.0, "asdfadsf", "adsfadsfasdf",
"00asasdf", 2342.0, "wqerwerqewr"))
})
testthat::test_that("Codebook - vector variable in settings and constants", {
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z3"),
fsource = "models",
output = "list",
doc_info = FALSE)
, "code that is too complex for this function" # read csv problem
)
# Copy of mixed settings list is also list
testthat::expect_identical(cbook$settings$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
testthat::expect_identical(cbook$settings$Something3,
list(1.0, 3.0, "test", 3.0, 1.0))
# Copy of mixed Constants list is also list
testthat::expect_identical(
cbook$rankaversion$Constants$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
testthat::expect_identical(
cbook$rankaversion$Constants$Something2,
list(1.0, 3.0, "test", 3.0, 1.0))
# Copy of numeric settings list (within settings)
testthat::expect_identical(
cbook$settings$StartToken,
list(9.0, 14.0, 17.0, 23.0, 38.0))
# Without calculations
testthat::expect_identical(cbook$settings$OtherTest1,
list(9.0, 14.0, 17.0, 23.0, 38.0))
# With calculations
testthat::expect_identical(cbook$settings$OtherTest2,
as.list(c(9.0, 14.0, 17.0, 23.0, 38.0) * 5L))
# Other
testthat::expect_identical(
cbook$rankaversion$Constants$StartToken,
list(9.0, 14.0, 17.0, 23.0, 38.0))
testthat::expect_identical(
cbook$rankaversion$Constants$StartToken2, # Ref to settings from Cons
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 2.0))
testthat::expect_identical(
cbook$rankaversion$Constants$StartToken3,
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 10.0))
# Calculations
testthat::expect_true(
cbook$rankaversion$Constants$players_per_group == "None")
testthat::expect_identical(
cbook$rankaversion$Constants$TestToken,
lapply(cbook$settings$StartToken, function(x) x * 5.0))
testthat::expect_true(
all(cbook$rankaversion$Player$Acc_DistributionChange$value ==
c("Ich hätte mich dennoch für Verfahren > xyz < entschieden.",
"Ich hätte mich für das alternative Verfahren > aaa < entschieden.",
"Ich hätte mich für das alternative Verfahren > bbb < entschieden.")))
testthat::expect_setequal(
cbook$rankaversion$Player$acceptance$choices$value,
c("xyz", "aaa", "Wrong, trick answer",
"Correct trick answer"))
})
testthat::test_that("Codebook - deprecated argument", {
warning <- testthat::capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
preamb = TRUE,
output = "list",
settings_replace = NULL,
doc_info = FALSE)
)
testthat::expect_true(any(grepl(pattern = "is deprecated",
x = warning)))
})
testthat::test_that("Codebook (w) - float in variable name", {
testthat::expect_warning(
cb <- codebook(
path = testthat::test_path("testdata", "ocode_y1"),
fsource = "models",
output = "list"
), paste0(
"too complex for this function.*",
"\\$test\\$Constants\\$min_payoffAB.*",
"\\$test\\$Player\\$min_payoffAB\\$max.*",
"\\$test\\$Group\\$min_payoffAB\\$max"
))
# Info: Correct result but a string instead of a float
testthat::expect_true(cb$test$Group$variable2$max == 3.3)
test1 <- cb$test$Constants$min_payoffAB ==
"(float(1.0)) + (float(1.1)) + (float(1.2))"
test2 <- cb$test$Group$min_payoffAB$max ==
"(float(1.0)) + (float(1.1)) + (float(1.2))"
test3 <- cb$test$Player$min_payoffAB$max ==
"(float(1.0)) + (float(1.1)) + (float(1.2))"
test4 <- cb$test$Group$variable2$max == 3.3
testthat::expect_true(all(c(test1, test2, test3, test4)))
})
testthat::test_that("Codebook (e)- equal signs in widgets", {
# If there are unescaped equal signs, errors are thrown
testthat::expect_error({
cbook <- codebook(testthat::test_path("testdata", "ocode_f5"),
fsource = "model",
doc_info = TRUE,
app = "MIG1",
output_file = "cb_of4_error",
output = "both")
}, " cannot be read properly by gmoTree.*MIG1\\$Player\\$user_total")
})
testthat::test_that("Codebook subsessions", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new4"),
fsource = "init",
include_subs = TRUE,
output = "list",
output_file = "ocode_g_codebook",
doc_info = FALSE)
# Check for false Subsession variables
testthat::expect_false("testvariable" %in%
cbook$bargaining$Subsession)
# Check for Subsession variables
testthat::expect_true("testvariable2" %in%
names(cbook$bargaining$Subsession))
testthat::expect_false(cbook$bargaining$Subsession$testvariable2$noargs)
testthat::expect_true(cbook$bargaining$Subsession$testvariable2$doc ==
"This is a normal Subsession variable.")
testthat::expect_true(cbook$bargaining$Subsession$testvariable2$field ==
"CurrencyField")
# Check for conditional Subsession variables
testthat::expect_true("conditional_testvariable" %in%
names(cbook$bargaining$Subsession))
testthat::expect_true(
cbook$bargaining$Subsession$conditional_testvariable$noargs)
testthat::expect_true(
cbook$bargaining$Subsession$conditional_testvariable$field ==
"CurrencyField")
})
testthat::test_that("Codebook (w) - with example, no settings.py", {
# Tests code that contains "with" + no settings.py
mywarnings <- testthat::capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_g"),
fsource = "init", # wrong because old otree
output = "list",
output_file = "ocode_g_codebook",
doc_info = FALSE)
)
test1 <- any(grepl(
pattern = "not in settings and cannot be replaced",
x = mywarnings))
test2 <- any(grepl(
pattern = "too complex for this function",
x = mywarnings))
test3 <- cbook$effort_add$Constants$NUM_ROUNDS == 1L
test4 <- cbook$effort_add$Constants$NAME_IN_URL == "effort_add"
test5 <- cbook$effort_add$Constants$NUM_TASKS == "len(INTS)"
test6 <- cbook$effort_add$Constants$TASK_TIMER == "settings.task_timer"
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
})
testthat::test_that("Codebook (w) - unmatched square brackets", {
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z13"),
fsource = "model",
output = "list",
doc_info = FALSE),
paste0("\\$rankaversion\\$Player\\$gender ",
"\\(unmatched square brackets\\).*\\(unmatched brackets\\)"))
# Brackets
cbook$rankaversion$Player$variable$doc == "(A doc in brackets))"
cbook$rankaversion$Player$variable2$doc == "A doc with one closing bracket"
# No warning when it comes to constants
testthat::expect_true(
cbook$rankaversion$Constants$Something == "[[information]")
# Even if there is a warning, it is still shown
testthat::expect_true(
cbook$rankaversion$Player$gender$doc == "[[Gender]")
})
testthat::test_that("Codebook - quotes", {
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
output_format = "latex",
output_file = "cb_quotestest",
output = "list",
settings_replace = NULL,
doc_info = FALSE)
)
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
output_format = "pdf_simple",
output_file = "cb_quotestest_simple",
output = "list",
settings_replace = NULL,
doc_info = FALSE)
)
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
output_format = "pdf",
output_file = "cb_quotestest",
output = "list",
settings_replace = NULL,
doc_info = FALSE)
)
# Doc with """ in them
testthat::expect_true(cbook$end$Player$hierarchy_of_principlesArg$doc ==
"Argument for Rejection")
# Doc with ''' in them
testthat::expect_true(cbook$end$Player$hierarchy_of_principlesArg2$doc ==
"Argument for Rejection")
testthat::expect_true(
cbook$end$Constants$without == "This is a without test")
# Normal string - Single values with single string def
testthat::expect_true(cbook$end$Constants$name_in_url == "end")
# Normal string - Single values with double string def
testthat::expect_true(cbook$end$Constants$name_in_url2 == "end")
# Normal string - single quoted strings within double string def
testthat::expect_true(cbook$end$Constants$singlequoteinsidedouble ==
"This is a 'test'")
# Normal string - escaped quoted strings within double string def
testthat::expect_true(cbook$end$Constants$doublequoteinsidesingle ==
"This is another \"test\"")
testthat::expect_true(cbook$end$Constants$doublequoteinsidesingle2 ==
"This is another \"test\" inside \"another test\"")
testthat::expect_true(cbook$end$Constants$escapedsinglequote ==
"This ia a 'single quote test'")
testthat::expect_true(cbook$end$Constants$escapeddoublequote ==
"This is a \"double quote test\"")
# Choices with single quotation marks
testthat::expect_true(
cbook$end$Player$Acc_DistributionChange$choices$value[1L] ==
"Ich hätte mich dennoch für Verfahren >settings.TokenAdd_1dName< entschieden.")
# Test next argument because they have different quotations:
testthat::expect_true(cbook$end$Player$Acc_DistributionChange$doc ==
"Former variable name: AnerkennungPrivat")
# Choices with double quotation marks
testthat::expect_true(
cbook$end$Player$Acc_DistributionChange2$choices$value[1L] ==
"Ich hätte mich dennoch für Verfahren >settings.TokenAdd_1dName< entschieden.")
testthat::expect_true(cbook$end$Player$Acc_DistributionChange2$doc ==
"Former variable name: AnerkennungPrivat")
})
testthat::test_that("Codebook - print", {
outputfilewithgetwd <- paste0(getwd(), "codebooktestprint")
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output_dir = "getwd()",
output_format = "latex_document",
output_file = outputfilewithgetwd,
output = "list",
app = "dictator",
doc_info = FALSE)
# Check for print removal in Constants
testthat::expect_true(cbook$dictator$Constants$NAME_IN_URL == "dictator")
testthat::expect_true(cbook$dictator$Constants$PLAYERS_PER_GROUP == 2L)
testthat::expect_true(
cbook$dictator$Constants$NUM_ROUNDS == 1L) # Here is print
testthat::expect_true(cbook$dictator$Constants$ENDOWMENT == "cu(100)")
# Check for print removal in Group
testthat::expect_true(all(
names(cbook$dictator$Group$kept) ==
c("noargs", "doc", "min", "max", "label", "field")))
testthat::expect_false(cbook$dictator$Group$kept$noargs)
testthat::expect_true(cbook$dictator$Group$kept$doc ==
"Amount dictator decided to keep for himself")
testthat::expect_true(cbook$dictator$Group$kept$min == 0L)
testthat::expect_true(cbook$dictator$Group$kept$label == "I will keep")
# Check for print removal in Player
testthat::expect_true(all(
names(cbook$dictator$Player) == c("gender", "chandler")))
testthat::expect_true(cbook$dictator$Player$gender$field == "IntegerField")
testthat::expect_false(cbook$dictator$Player$gender$noargs)
testthat::expect_true(cbook$dictator$Player$gender$doc == "Gender")
testthat::expect_true(all(
names(cbook$dictator$Player$chandler) == c("noargs", "doc", "field")))
testthat::expect_true(
cbook$dictator$Player$chandler$field == "IntegerField")
testthat::expect_false(cbook$dictator$Player$chandler$noargs)
testthat::expect_true(cbook$dictator$Player$chandler$doc == "Chandler")
})
testthat::test_that("Codebook - new oTree, app_rm", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
output_file = "newappapprm",
app_rm = "dictator",
doc_info = FALSE)
test1 <- !is.null(cbook$bargaining)
test2 <- is.null(cbook$dictator)
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(cbook$bargaining$Player$level$doc ==
"choices with only [1,2,3]")
})
testthat::test_that("Codebook - brackets, i.e. lists", {
# TODO + also check in PDF and word
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output = "list",
output_open = FALSE,
output_dir = NULL,
output_format = "pdf_simple",
output_file = "cb_bracket_newline",
fsource = "models",
splitvarname = TRUE,
sep_list = "newline"
), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output = "list",
output_dir = NULL,
output_format = "latex",
output_file = "cb_bracket_newline",
fsource = "models",
splitvarname = TRUE,
sep_list = "newline",
output_open = FALSE), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output = "list",
output_dir = NULL,
output_format = "word",
output_file = "bracket_newline_word",
fsource = "models",
splitvarname = TRUE,
sep_list = "newline",
output_open = FALSE), "Some variables")
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output = "list",
output_dir = NULL,
output_file = "bracket_vector",
sep_list = "vector",
fsource = "models",
splitvarname = TRUE), "Some variables")
# First and last bracket
# First and last brackets are not removed for normale variables!
testthat::expect_true(
cbook$rankend$Constants$firstlastbr == "(firstlastbracketexample)")
# Empty list
testthat::expect_identical(cbook$rankend$Constants$emptylist, list())
testthat::expect_identical(cbook$rankend$Constants$emptylist2, list())
# Vector with numbers and strings
testthat::expect_type(
cbook$rankaversion$Constants$onelevelvectorl, "list")
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorl,
list("a", "b", 3.0))
testthat::expect_identical(
cbook$rankaversion$Constants$onelevelvectorl2,
list("a", "b", 3.0, "asdfadsf", "adsfadsfasdf",
"00asasdf", 2342.0, "wqerwerqewr"))
testthat::expect_type(
cbook$rankaversion$Constants$onelevelvectorl2, "list")
# Original oTree code has brackets: (Yes)
testthat::expect_true(
cbook$rankaversion$Player$acceptance$choices$value[1L] == "(Yes)")
# Test for numeric vectors in Constants
testthat::expect_identical(cbook$rankend$Constants$TestVector,
list(1.0, 10.0, 3.0, 4.0, 5.0))
# Test for numeric vectors in Settings
testthat::expect_identical(cbook$rankend$Constants$TestVector2,
list(99.0, 66.0, 33.0))
# Test for character vectors in Constants
testthat::expect_identical(cbook$rankend$Constants$TestVectorC,
list("a", "b", 6.0))
# Test for character vectors in Settings
testthat::expect_identical(cbook$rankend$Constants$TestVectorC2,
list("d", "e", 4.0))
# Test for two-level lists
testthat::expect_type(cbook$rankaversion$Constants$choices, "list")
testthat::expect_true(identical(
cbook$rankaversion$Constants$choices[[1L]],
list(4.0, 1.0, 1.0, 0.5, "noRR_needSat", 3.0, 2.0)
))
# If closing bracket is at next row
testthat::expect_identical(
cbook$rankaversion$Constants$nextrowbracket[[1L]],
list(69.0, 43.0, 5.0))
# If closing bracket is at same row
testthat::expect_identical(
cbook$rankaversion$Constants$samerowbracket[[1L]],
list(69.0, 43.0, 5.0))
# If there is a space before the second opening bracket
testthat::expect_identical(
cbook$rankaversion$Constants$spacebeforebracket[[1L]],
list(2004.0, 43.0, 5.0))
# If there is a comment before the second opening bracket
testthat::expect_identical(
cbook$rankaversion$Constants$commentafterbracket[[1L]],
list(69.0, 43.0, 5.0))
# If there is a space before the last closing bracket
testthat::expect_identical(
cbook$rankaversion$Constants$spaceafterbracket[[1L]],
list(69.0, 43.0, 5.0))
# If there is a space after a comma
testthat::expect_identical(
cbook$rankaversion$Constants$spaceaftercomma[[1L]],
list(2004.0, 43.0, 5.0))
# If there is a comment after a comma
testthat::expect_identical(
cbook$rankaversion$Constants$commentaftercomma[[1L]],
list(2004.0, 43.0, 5.0))
})
testthat::test_that("Codebook (e) - three level list in constants", {
# In constants
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z10"),
output_dir = NULL,
output = "list",
fsource = "model")
}, "This function does not support lists with more.*Constants")
})
testthat::test_that("Codebook - old oTree", {
testthat::expect_message(
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z"),
fsource = "model",
output = "list",
doc_info = TRUE),
paste0(".*too complex for this function.*rankaversion",
"\\$Constants.*\\$rankend\\$Constants \\(read_csv\\).*",
"\\$settings\\$showupToken \\(float\\).*",
"\\$end\\$Constants\\$showupToken \\(float\\).*",
"\\$end\\$Constants\\$showupTokenTest \\(float\\)")
), paste0("Variables without.*rankaversion\\$Player\\$choicenumber.*",
"rankend\\$Player\\$done_distribution"))
# Tests
testthat::expect_type(cbook, "list")
# Test settings in settings replacements
testthat::expect_identical(
cbook$settings$payoffPart1_c,
cbook$settings$ExchangeToken * 6L)
# Test settings in Constants replacement
testthat::expect_identical(
cbook$end$Constants$payoffPart1_c,
cbook$settings$payoffPart1_c)
testthat::expect_identical(
cbook$end$Constants$ExchangeToken,
cbook$settings$ExchangeToken)
# Others
testthat::expect_true(cbook$rankaversion$Constants$randomtest == 35L)
testthat::expect_true(cbook$end$Constants$ExchangeToken == 4L)
# Test constants in Constants replacement
testthat::expect_true(cbook$end$Constants$ExchangeRate ==
as.numeric(cbook$end$Constants$ExchangeToken) /
as.numeric(cbook$end$Constants$ExchangeMainCurrency))
testthat::expect_true(cbook$end$Constants$showupToken ==
cbook$end$Constants$showupTokenTest)
# Choices are not stored as lists!
testthat::expect_false(
is.list(cbook$rankaversion$Player$is_trick$choices$value))
testthat::expect_false(
is.list(cbook$rankaversion$Player$is_trick$choices$key))
})
testthat::test_that("Codebook - several lines", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_count"),
fsource = "init",
output_open = FALSE,
output = "list",
output_file = "cb_severallines",
doc_info = TRUE)
# The newline sign \ should be removed:
testthat::expect_true(
cbook$ocode_count$C$STRING_TO_GUESS ==
paste0("Die ältesten bekannten kieferlosen Fischartigen ",
"(z. B. die Pteraspidomorphi) stammen aus dem frühen Ordovizium ",
"vor rund 450–470 Millionen Jahren."))
testthat::expect_true(
cbook$ocode_count$C$SOLUTION ==
paste0("get_char_counts(Die ältesten bekannten kieferlosen Fischartigen ",
"(z. B. die Pteraspidomorphi) stammen aus dem frühen Ordovizium ",
"vor rund 450–470 Millionen Jahren.)"
))
})
testthat::test_that("Codebook (w) - vector var in settings and constants", {
# Dissertation code
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z3"),
fsource = "models",
output = "list",
doc_info = FALSE), "too complex for this function")
# Since R only saves the same type in a vector
testthat::expect_identical(
cbook$settings$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
testthat::expect_identical(
cbook$rankaversion$Constants$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
# Otherwise
testthat::expect_identical(
cbook$settings$StartToken,
list(9.0, 14.0, 17.0, 23.0, 38.0))
test4 <- identical(
cbook$rankaversion$Constants$StartToken,
list(9.0, 14.0, 17.0, 23.0, 38.0)
)
test5 <- identical(
cbook$rankaversion$Constants$StartToken2,
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 2L))
test6 <- identical(
cbook$rankaversion$Constants$StartToken3,
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 10L))
# Calculations
test7 <- identical(cbook$settings$OtherTest1,
list(9.0, 14.0, 17.0, 23.0, 38.0))
test8 <- identical(
cbook$settings$OtherTest2,
lapply(list(9.0, 14.0, 17.0, 23.0, 38.0), function(x) x * 5L))
test9 <-
cbook$rankaversion$Constants$players_per_group == "None"
test10 <- identical(
cbook$rankaversion$Constants$TestToken,
lapply(cbook$settings$StartToken, function(x) x * 5L))
test11 <- all(
cbook$rankaversion$Player$Acc_DistributionChange$value ==
c("Ich hätte mich dennoch für Verfahren > xyz < entschieden.",
"Ich hätte mich für das alternative Verfahren > aaa < entschieden.",
"Ich hätte mich für das alternative Verfahren > bbb < entschieden."))
test12 <- all(cbook$rankaversion$Player$acceptance$choices$value ==
c("xyz", "aaa", "Wrong, trick answer", "Correct trick answer"))
testthat::expect_true(all(test4))
testthat::expect_true(all(test5))
testthat::expect_true(all(test6))
testthat::expect_true(all(test7))
testthat::expect_true(all(test8))
testthat::expect_true(all(test9))
testthat::expect_true(all(test10))
testthat::expect_true(test11)
testthat::expect_true(test12)
})
testthat::test_that("choices without key", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = FALSE,
app = "bargaining")
# Tests
test1 <- cbook$bargaining$Player$level2$choices[1L] == "No, I won't"
test2 <- cbook$bargaining$Player$level2$choices[2L] == "yes, I will"
test3 <- cbook$bargaining$Player$level2$choices[3L] == "Maybe I'll do"
testthat::expect_true(all(c(test1, test2, test3)))
})
testthat::test_that("Codebook - documentation of variables", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z8"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output = "list")
testthat::expect_true(cbook$rankaversion$Player$gender$doc ==
"Gender documentation with double quotations")
testthat::expect_true(cbook$rankaversion$Player$gender2$doc ==
"Gender documentation with single quotations")
testthat::expect_true(
cbook$rankaversion$Player$gender3$doc ==
"Gender documentation with tripple double quotations")
testthat::expect_true(
cbook$rankaversion$Player$gender4$doc ==
"Gender documentation with tripple single quotations")
testthat::expect_true(grepl(
cbook$rankaversion$Player$crt_bat$label,
pattern = "^A bat and a ball.*cost\\?$"))
testthat::expect_true(grepl(
cbook$rankaversion$Player$crt_bat2$label,
pattern = "^A bat and a ball.* cost\\?$"))
})
testthat::test_that("Codebook (w) - constants var not there", {
# Try user Var
testthat::expect_message(
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new2"),
fsource = "init",
output = "list"), "is not in Constants"),
"Variables without documentation.*bargaining\\$Group\\$total_requests")
test1 <-
cbook$bargaining$Player$request$max == "C.AMOUNT_SHARED_false"
# Check if leading and trailing brackets and comments are removed
# Original "(Please enter an amount from 0 to 100)"
test2 <- cbook$bargaining$Player$request$label ==
"(Please enter an amount from 0 to 100)"
test3 <- cbook$bargaining$Player$request2$label ==
"Please enter an amount from 0 to 100"
test4 <- cbook$bargaining$Player$request3$label ==
"Please enter an amount from 0 to 100"
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
})
testthat::test_that("Codebook - new oTree, only one app", {
testthat::expect_message(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = TRUE,
app = "public_goods_simple"),
"Variables without documentation, label, or verbose name:"
)
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# Remove leading and trailing """ from doc
test9 <- cbook$volunteer_dilemma$Player$volunteer$doc ==
"Whether player volunteers"
# Remove leading and trailing ' from label
test9 <- cbook$volunteer_dilemma$Player$volunteer$label ==
"Do you wish to volunteer?"
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
})
testthat::test_that("Codebook - key value", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z7"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output = "list")
# Choices are not stored as lists!
testthat::expect_false(
is.list(cbook$rankaversion$Player$is_trick$choices$value))
testthat::expect_false(
is.list(cbook$rankaversion$Player$is_trick$choices$key))
# Key and value in double quotations
testthat::expect_true(all(
cbook$rankaversion$Player$gender$choices$key == c("Male1", "Female")))
testthat::expect_true(all(
cbook$rankaversion$Player$gender$choices$value == c("Male", "Femaleval")))
# Key and value in single quotations
testthat::expect_true(all(
cbook$rankaversion$Player$gender2$choices$key == c("Male", "Female")))
testthat::expect_true(all(
cbook$rankaversion$Player$gender2$choices$value ==
c("Male", "Femaleval")))
})
testthat::test_that("Codebook - empty arguments", {
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output = "list"))
# Empty argument after choices
testthat::expect_true(
cbook$rankaversion$Player$a_richer$choices$value[[2L]] ==
"B is the richer person")
testthat::expect_true(all(
names(cbook$rankaversion$Player$a_richer) ==
c("noargs", "doc", "choices", "field")))
testthat::expect_true(all(
cbook$rankaversion$Player$a_richer$choices$value ==
c("A is the richer person", "B is the richer person")))
# Empty arguments after doc
testthat::expect_true(
cbook$rankaversion$Player$testempty$doc == "This is an example doc")
testthat::expect_true(all(names(cbook$rankaversion$Player$testempty) ==
c("noargs", "doc", "field")))
# Variable after that
testthat::expect_true(exists("is_trick", cbook$rankaversion$Player))
})
testthat::test_that("Codebook - from-to string values", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z5"),
fsource = "models",
output_format = "html",
output_file = "fromtovalues",
output = "list",
settings_replace = NULL,
doc_info = FALSE)
testthat::expect_true(
cbook$end$Player$money_in_month$choices$value[1L] == "0-399")
testthat::expect_true(
cbook$end$Player$money_in_month$choices$value[2L] == "400-699")
})
testthat::test_that("Codebook - newlines in doc", {
warning <- testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z4"),
fsource = "models",
output = "list",
settings_replace = NULL,
doc_info = FALSE))
testthat::expect_true(cbook$end$Player$completionCode$doc ==
paste0("Completion Code for MTurk. Has no role for the ",
"experiment and will not be validated unless there are ",
"legal problems with the participants"))
testthat::expect_true(cbook$end$Player$completionCodespaces$doc ==
paste0("Completion Code for MTurk. Has no role for the experiment ",
"and will not be validated unless there are legal problems with ",
"the participants"))
})
testthat::test_that("Codebook (e) - settings var. not there3", {
# Try user Var but with some missing
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error = "Test"),
settings_replace = "user",
output = "list")
, paste0(" not in user\\_settings and cannot be replaced.*",
"\\$rankaversion\\$MinutesForSurvey"))
})
# Equal sign
testthat::test_that("Codebook - escaped equal signs in doc values", {
cbook <- codebook(testthat::test_path("testdata", "ocode_f2"),
fsource = "model",
app = "MIG1",
doc_info = FALSE,
output = "list")
# Vales in oTree code should be written with \=
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionFinal$doc ==
"Final Consumption \\= with TokenAdd as voted for by group")
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionNoDis$doc ==
"Initial Consumption \\= no Redistribution")
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionEqual$doc ==
"Initial Consumption \\= with TokenAdd as suggested by Experimenter")
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionWeakerFirst$doc ==
"Initial Consumption \\= with TokenAdd as suggested by Weaker First")
testthat::expect_true(
cbook$MIG1$Player$P1_ConsumptionMixed$doc ==
"Initial Consumption \\= with TokenAdd as suggested by Mixed")
})
testthat::test_that("Codebook (e)- equal signs in doc values", {
# If there are unescaped equal signs, errors are thrown
testthat::expect_error({
cbook <- codebook(testthat::test_path("testdata", "ocode_f1"),
fsource = "model",
doc_info = FALSE,
app = "MIG1",
output_file = "esindoc",
output = "list")
}, "read properly by gmoTree.*\\$MIG1\\$Player\\$P1_ConsumptionFinal")
})
testthat::test_that("Codebook (e)- equal signs in choices values", {
# If there are unescaped equal signs, errors are thrown
testthat::expect_error({
cbook <- codebook(testthat::test_path("testdata", "ocode_f3"),
fsource = "model",
doc_info = FALSE,
app = "MIG1",
output = "list")
}, paste0("cannot be read properly by gmoTree.*",
"\\$MIG1\\$Group\\$treatment_ec.*\\$MIG1\\$Player\\$P1_AckVote"))
})
testthat::test_that("Codebook - escaped equal signs in choices values", {
# If there are unescaped equal signs, errors are thrown
cbook <- codebook(testthat::test_path("testdata", "ocode_f4"),
fsource = "model",
doc_info = FALSE,
app = "MIG1",
output_file = "esc_equal_signs",
output = "list")
# TODO + Also check in output file: variable treatment_ec,P1_AckVote
testthat::expect_true(length(cbook$MIG1$Group$treatment_ec$choices) == 2L)
testthat::expect_true(cbook$MIG1$Group$treatment_ec$choices$key[1L] == 0L)
testthat::expect_true(cbook$MIG1$Group$treatment_ec$choices$value[1L] ==
"0 \\= tolle Anfangssausstattung")
testthat::expect_true(length(cbook$MIG1$Player$P1_AckVote$choices) == 2L)
testthat::expect_true(cbook$MIG1$Player$P1_AckVote$choices$value[1L] ==
"Das Verfahren x \\= 1 soll anerkannt werden")
# Other tests
testthat::expect_true(all(
names(cbook$MIG1$Group$P1_Rej_nArgAkzNo_2) ==
c("noargs", "initial", "field")))
testthat::expect_identical(cbook$MIG1$Constants$ChatTime_Ack, 6.0)
testthat::expect_identical(cbook$MIG1$Constants$ChatTime_Ack_Sec,
cbook$MIG1$Constants$ChatTime_Ack * 60L)
})
# Output
testthat::test_that("Codebook (e) - wrong output format", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "both",
output_open = TRUE,
output_format = "WrongFormat",
doc_info = FALSE)}, "Output format should be")
})
testthat::test_that("Codebook (e) - dots in names", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_file = "codebook.error",
output = "both",
output_open = TRUE,
fsource = "init")
}, "You are not allowed to use dots in your output_file names")
})
testthat::test_that("Codebook (e) - dir not there", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_file = "codebooknothappening",
output_dir = "E:/folder",
output = "both",
output_open = TRUE,
fsource = "init")
}, "The directory.*does not exist yet.")
})
testthat::test_that("Codebook (e) - wrong output", {
# Wrong text
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = NULL,
output = "WRONG",
fsource = "init")}, "Output should be")
# NULL
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = NULL,
output = "NULL",
fsource = "init")}, "Output should be")
# Two inputs
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = NULL,
fsource = "init",
output = c("file", "list"))},
"Output should be")
# Output dir and file don't align
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_file = "E:/folder/filename",
output_dir = "E:/folder2",
output = "both",
output_open = TRUE,
fsource = "init")}, "When using an absolute path for")
})
testthat::test_that("Codebook (e) - output file contains invalid path", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output_dir = NULL,
output_file = "E:/GMO/gmoTree2/codebooktestprint/patherror",
output = "both",
output_open = TRUE,
app = "dictator",
doc_info = FALSE), "The directory .* does not exist.")
})
testthat::test_that("Codebook (e) - empty output_file", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_file = NULL,
output = "both",
output_open = TRUE,
fsource = "init")
}, "Please enter a output_file name!")
})
testthat::test_that("Codebook (e) - params", {
warnings <- testthat::capture_warnings(
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
params = "ab",
output = "list"),
"params must be a list"))
})
# Choosing apps
testthat::test_that("Codebook (e) - app and app rm specified", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = FALSE,
app = "dictator",
app_rm = "public_goods_simple"),
"Please specify only \"app\" or \"app_rm")
})
testthat::test_that("Codebook (e) - apps don't exist", {
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
app = c("dictator", "nonexistingapp"),
doc_info = FALSE)}, "At least one app")
})
testthat::test_that("Codebook (e) - one app not there", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z"),
fsource = "init", # wrong because old otree
output = "list",
doc_info = TRUE,
app = "xyp"),
"not in oTree code"
)
})
# Settings
testthat::test_that("Codebook - three level list in settings work", {
# If settings_replace is global
testthat::expect_error({
cbook1 <- codebook(
path = testthat::test_path("testdata", "ocode_z11"),
output_dir = NULL,
output = "list",
settings_replace = "global",
fsource = "model")
}, "not support lists.*settings")
# If settings_replace is NULL
cbook2 <- codebook(
path = testthat::test_path("testdata", "ocode_z11"),
output_dir = NULL,
output = "list",
settings_replace = NULL,
fsource = "model")
testthat::expect_null(cbook2$rankaversion$settings)
testthat::expect_true(
cbook2$rankaversion$Constants$Something == "settings.Something")
})
testthat::test_that("Codebook (w) - setting var not there 4", {
# Try user Var
message <- capture_messages(
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new3"),
settings_replace = "global",
fsource = "init",
output = "list")
, "are not in settings and"))
testthat::expect_true(
grepl(x = paste(message, collapse = ""),
pattern = paste0("Variables without documentation.*bargaining",
"\\$Group\\$total_requests")))
test1 <-
cbook$bargaining$Player$request$max == "settings.AMOUNT_SHARED"
testthat::expect_true(test1)
})
testthat::test_that("Codebook - setting, constants type", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z9"),
fsource = "models",
output = "list",
doc_info = FALSE)
testthat::expect_identical(
cbook$settings$Something,
list(1.0, 3.0, "test", 3.0, 1.0))
testthat::expect_identical(
cbook$settings$Something,
cbook$rankaversion$Constants$Something)
})
testthat::test_that("Codebook (e) - wrong settings replace", {
# Wrong text
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error = "Test"),
settings_replace = "wrongString",
output = "list"),
"must be either")
})
testthat::test_that("Codebook (e) - user settings and global_s mismatch", {
# Wrong settings_replace
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error = "Test",
showupToken = 2L),
settings_replace = "global",
output = "list")
, "settings_replace must be set to"
)
# Wrong variable
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error = "Test",
showupToken = 2L),
settings_replace = "user",
output = "list"),
"not in user_settings and"
)
})
testthat::test_that("Codebook (w) - settings var. not there 1", {
# Settings not there
warnings <- testthat::capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
output = "list",
doc_info = FALSE)
)
test1 <- any(grepl(pattern = "not in settings and cannot be replaced",
x = warnings))
test2 <- any(grepl(pattern = "too complex for this function",
x = warnings))
testthat::expect_true(test1)
testthat::expect_true(test2)
})
testthat::test_that("Codebook (w) - folder without settings", {
warnings <- testthat::capture_warnings(
cbook <- codebook(
fsource = "model",
path = testthat::test_path("testdata", "ocode_z3.1"),
output = "list",
doc_info = FALSE))
test1 <- any(grepl(
pattern = paste0("There is no settings.* in your path..*\\$rankaversion",
"\\$Testnumber, reference \"settings.Testnumber"),
x = warnings))
test2 <- any(grepl(
pattern = "too complex",
x = warnings))
testthat::expect_true(test1)
testthat::expect_true(test2)
# Check if variables are there only once
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$Testnumber") == 1L)
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$Something") == 1L)
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$TestToken") == 1L)
# User settings
warnings <- testthat::capture_warnings(
cbook <- codebook(
fsource = "model",
path = testthat::test_path("testdata", "ocode_z3.1"),
output = "list",
settings_replace = "user",
doc_info = FALSE))
# Check if variables are there only once
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$Testnumber") == 1L)
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$Something") == 1L)
testthat::expect_true(
stringr::str_count(warnings, "\\$rankaversion\\$TestToken") == 1L)
})
testthat::test_that("Codebook - user_settings", {
# Comparison without settings.py variable
testthat::expect_warning(
cbook_default <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
settings_replace = "global",
doc_info = FALSE,
output = "list"))
# Try user Var - integer vector
testthat::expect_warning(
cbook_integer <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error2 = "Test",
showupToken = 2L,
max_payoffPart1_ab = 1L,
ExchangeMainCurrency = 1L,
payoff_survey = 1L,
MinutesForSurvey = 20L,
TestVector2 = c(1L, 2L, 3L),
TestVectorC2 = c("a", "b"),
ExchangeToken = 1L,
timer123 = 12L,
payoffPart1_c = 1L),
settings_replace = "user",
doc_info = FALSE,
output = "list"), "too complex for this function")
# Try user Var - double vector
testthat::expect_warning(
cbook_double <- codebook(
path = testthat::test_path("testdata", "ocode_z2"),
fsource = "model",
user_settings = list(error2 = "Test",
showupToken = 2L,
max_payoffPart1_ab = 1L,
ExchangeMainCurrency = 1L,
payoff_survey = 1L,
MinutesForSurvey = 20L,
TestVector2 = c(1.0, 2.2, 3.0),
TestVectorC2 = c("a", "b"),
ExchangeToken = 1L,
timer123 = 12L,
payoffPart1_c = 1L),
settings_replace = "user",
doc_info = FALSE,
output = "list"), "too complex for this function")
testthat::expect_true(cbook_default$rankend$Constants$Test1 == 1000L)
testthat::expect_identical(cbook_default$rankend$Constants$TestVector,
list(1.0, 10.0, 3.0, 4.0, 5.0)) # Info: double!
testthat::expect_identical(cbook_default$rankend$Constants$TestVectorC,
list("a", "b", 6.0)) # Info: double!
# Variables in settings.py
testthat::expect_true(
cbook_default$rankaversion$Constants$error2 == "Error2insettings")
testthat::expect_true(
cbook_default$rankaversion$Constants$MinutesForSurvey == 18L)
testthat::expect_identical(
cbook_default$rankend$Constants$TestVector2,
list(99.0, 66.0, 33.0)) # settings.TestVector2 (Info - saved as double )
testthat::expect_identical(cbook_default$rankend$Constants$TestVectorC2,
list("d", "e", 4.0))
# Variables in user_settings
test3 <- cbook_integer$rankaversion$Constants$error2 == "Test"
test4 <- cbook_integer$rankaversion$Constants$MinutesForSurvey == 20L
# Run
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_identical(
cbook_integer$rankend$Constants$TestVector2,
list(1.0, 2.0, 3.0))
testthat::expect_identical(
cbook_double$rankend$Constants$TestVector2,
list(1.0, 2.2, 3.0))
# In the output file it is shown without digits after the comma (except 2.2)
})
# Fsource
testthat::test_that("Codebook (e) - fsource not valid", {
# Wrong source text
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "xx",
output = "list",
doc_info = TRUE,
app = "public_goods_simple"),
"fsource must be either")
# If source is NULL
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = NULL,
output = "list",
doc_info = TRUE,
app = "public_goods_simple"),
"fsource must be either")
# Wrong length
testthat::expect_error({
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = NULL,
fsource = c("init", "model"),
output = "list")}, "Please enter only one fsource")
})
testthat::test_that("Codebook (e) - fsource init instead of models", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z"),
fsource = "init", # wrong because old otree
output = "list",
doc_info = TRUE),
"At least one of your init-files is empty"
)
})
testthat::test_that("Codebook (e) - fsource models instead of init", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "model", # wrong because new otree
output = "list",
doc_info = TRUE,
app = "public_goods_simple"), "No files to process"
)
})
# List variables
testthat::test_that("Codebook - check sublists with different types", {
# Other sublist tests are in brackets tests
testthat::expect_warning(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_z6"),
output_dir = NULL,
fsource = "models",
splitvarname = TRUE,
output = "list")
)
# Original in code:
# [8, 2, 2, 2.5, "noRR_needy", settings.v2, 4]
# [80, 20, 2, 2.5, "noRR_needy", "settings.shouldnotwork", 4]
# ["8", 2, 2, 2.5, "noRR_needy", settings.v2, 4]
# Check if original numbers are numbers
testthat::expect_true(
cbook$rankaversion$Constants$choices[[1L]][[1L]] == 8L)
testthat::expect_true(
cbook$rankaversion$Constants$choices[[2L]][[1L]] == 80L)
testthat::expect_true(
cbook$rankaversion$Constants$choices[[3L]][[1L]] == "8")
testthat::expect_true(
cbook$rankaversion$Constants$choices[[1L]][[6L]] ==
"replacingsettingsworked")
testthat::expect_true(cbook$rankaversion$Constants$choices[[2L]][[6L]] ==
"settings.shouldnotwork")
})
# Path
testthat::test_that("Codebook (e) - path does not exist", {
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "nopath"),
fsource = "init",
output = "list",
doc_info = TRUE,
app = "public_goods_simple"),
"does not exist")
})
testthat::test_that("Codebook (e) - path is NULL", {
# Wrong path
testthat::expect_error(
cbook <- codebook(
path = NULL,
output = "list",
doc_info = TRUE), "Path must not be NULL")
})
testthat::test_that("Codebook (e) - relative path", {
# Relative path ../
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output_dir = "../",
output = "both",
output_open = TRUE,
doc_info = TRUE), "Please don't use relative paths in output_dir")
# Relative path ..
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = "..",
output = "both",
output_open = TRUE,
doc_info = TRUE), "Please don't use relative paths in output_dir")
# Relative path .
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = ".",
output = "both",
output_open = TRUE,
doc_info = TRUE), "Please don't use relative paths in output_dir")
# Relative path
testthat::expect_error(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
output_dir = "./",
output = "both",
output_open = TRUE,
doc_info = TRUE), "Please don't use relative paths in output_dir")
})
# Sort
testthat::test_that("Codebook - new oTree, correct sort", {
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
include_subs = TRUE,
output = "list",
doc_info = FALSE,
sort = c("traveler_dilemma", "survey",
"bargaining", "volunteer_dilemma", "bertrand",
"common_value_auction", "cournot",
"dictator", "guess_two_thirds",
"matching_pennies", "payment_info",
"prisoner", "public_goods_simple",
"trust", "trust_simple"))
# Tests
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# If there is only one group field without information in it
test9 <-
cbook$bertrand$Group$winning_price$field ==
"CurrencyField"
# If there is one group field that has information in it
test10 <- cbook$dictator$Group$kept$field ==
"CurrencyField"
# If there are two group fields with no information in them
test11 <-
cbook$public_goods_simple$Group$total_contribution$field ==
"CurrencyField"
test12 <-
all(names(cbook) ==
c("settings", "traveler_dilemma", "survey",
"bargaining", "volunteer_dilemma", "bertrand",
"common_value_auction", "cournot",
"dictator", "guess_two_thirds",
"matching_pennies", "payment_info",
"prisoner", "public_goods_simple",
"trust", "trust_simple"))
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
testthat::expect_true(test9)
testthat::expect_true(test10)
testthat::expect_true(test11)
testthat::expect_true(test12)
})
testthat::test_that("Codebook (w) - new oTree, too many sort 2", {
original_sort <-
c("bargaining", "bertrand", "common_value_auction", "cournot",
"dictator", "guess_two_thirds", "matching_pennies", "payment_info",
"prisoner", "public_goods_simple", "survey", "traveler_dilemma",
"trust", "trust_simple", "volunteer_dilemma")
new_sort <- c("thisisnothere", "payment_info",
"bargaining", "volunteer_dilemma",
"bertrand", "common_value_auction",
"cournot", "dictator",
"guess_two_thirds", "matching_pennies",
"prisoner", "public_goods_simple",
"survey", "traveler_dilemma",
"trust", "trust_simple")
thiswarning <- capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = FALSE,
sort = new_sort)
)
# Tests
testthat::expect_true(any(
grepl(x = thiswarning, pattern = "Sort elements not in apps are")))
testthat::expect_true(
any(grepl("Sort apps are not equal to all apps", thiswarning)))
testthat::expect_true(any(grepl("Sort elements not in apps are",
thiswarning)))
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# If there is only one group field without information in it
test9 <- cbook$bertrand$Group$winning_price$field == "CurrencyField"
# If there is one group field that has information in it
test10 <- cbook$dictator$Group$kept$field == "CurrencyField"
# If there are two group fields with no information in them
test11 <-
cbook$public_goods_simple$Group$total_contribution$field ==
"CurrencyField"
test12 <-
all(names(cbook) == c("settings", original_sort))
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
testthat::expect_true(test9)
testthat::expect_true(test10)
testthat::expect_true(test11)
testthat::expect_true(test12)
})
testthat::test_that("Codebook (w) - new oTree, false sort", {
thiswarning <- capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
doc_info = FALSE,
sort = c("public_goods_simple", "dictator")
))
# Tests
testthat::expect_true(
any(grepl("Sort apps are not equal to all apps", thiswarning)))
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# If there is only one group field without information in it
test9 <- cbook$bertrand$Group$winning_price$field == "CurrencyField"
# If there is one group field that has information in it
test10 <- cbook$dictator$Group$kept$field == "CurrencyField"
# If there are two group fields with no information in them
test11 <-
cbook$public_goods_simple$Group$total_contribution$field ==
"CurrencyField"
test12 <-
all(names(cbook) ==
c("settings", "bargaining", "bertrand",
"common_value_auction", "cournot",
"dictator", "guess_two_thirds",
"matching_pennies", "payment_info",
"prisoner", "public_goods_simple",
"survey", "traveler_dilemma",
"trust", "trust_simple", "volunteer_dilemma"))
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
testthat::expect_true(test9)
testthat::expect_true(test10)
testthat::expect_true(test11)
testthat::expect_true(test12)
})
testthat::test_that("Codebook (w) - too many sort", {
# Without trust_simple
original_sort <-
c("bargaining", "bertrand", "common_value_auction", "cournot",
"dictator", "guess_two_thirds", "matching_pennies", "payment_info",
"prisoner", "public_goods_simple", "survey", "traveler_dilemma",
"trust", "trust_simple", "volunteer_dilemma")
new_sort <- c("thisisnothere", "payment_info",
"bargaining", "volunteer_dilemma",
"bertrand", "common_value_auction",
"cournot", "dictator",
"guess_two_thirds", "matching_pennies",
"prisoner", "public_goods_simple",
"survey", "traveler_dilemma",
"trust")
thiswarning <- capture_warnings(
cbook <- codebook(
path = testthat::test_path("testdata", "ocode_new"),
fsource = "init",
output = "list",
output_format = "word_document",
doc_info = FALSE,
sort = new_sort)
)
# Tests
testthat::expect_true(any(
grepl(x = thiswarning, pattern = "Sort elements not in apps are")))
testthat::expect_true(
any(grepl("Sort apps are not equal to all apps", thiswarning)))
testthat::expect_true(any(grepl("Sort elements not in apps are",
thiswarning)))
test1 <- is.list(cbook)
test2 <- !is.null(cbook$public_goods_simple$Constants)
test3 <- !is.null(cbook$public_goods_simple$Group)
test4 <- !is.null(cbook$public_goods_simple$Player)
test5 <-
cbook$public_goods_simple$Constants$NAME_IN_URL ==
"public_goods_simple"
test6 <-
cbook$public_goods_simple$Group$total_contribution$noargs
test7 <-
cbook$public_goods_simple$Player$contribution$label ==
"How much will you contribute?"
test8 <-
!cbook$public_goods_simple$Player$contribution$noargs
# If there is only one group field without information in it
test9 <- cbook$bertrand$Group$winning_price$field == "CurrencyField"
# If there is one group field that has information in it
test10 <- cbook$dictator$Group$kept$field == "CurrencyField"
# If there are two group fields with no information in them
test11 <-
cbook$public_goods_simple$Group$total_contribution$field ==
"CurrencyField"
test12 <-
all(names(cbook) == c("settings", original_sort))
testthat::expect_true(test1)
testthat::expect_true(test2)
testthat::expect_true(test3)
testthat::expect_true(test4)
testthat::expect_true(test5)
testthat::expect_true(test6)
testthat::expect_true(test7)
testthat::expect_true(test8)
testthat::expect_true(test9)
testthat::expect_true(test10)
testthat::expect_true(test11)
testthat::expect_true(test12)
# Test if "yes, I will" is one element
testthat::expect_true(
length(cbook$bargaining$Player$level2$choices) == 3L)
testthat::expect_true(
cbook$bargaining$Player$level2$choices[1L] == "No, I won't")
testthat::expect_true(
cbook$bargaining$Player$level2$choices[3L] == "Maybe I'll do")
# Test for ''' documentations
test1 <- grepl(
pattern = "^A bat and a ball cost 22 dollars in total.*the ball cost\\?$",
x = cbook$survey$Player$crt_bat$label)
# Test for """ documentations
test2 <- grepl(
pattern = "^If it takes 5 machines 5.*make 100 widgets\\?$",
x = cbook$survey$Player$crt_widget$label)
testthat::expect_true(test1)
testthat::expect_true(test2)
# Test for ' choices
testthat::expect_true(
cbook$survey$Player$gender$choices$key[1L] == "Male")
testthat::expect_true(
cbook$survey$Player$gender$choices$key[2L] == "Female")
testthat::expect_true(
cbook$survey$Player$gender$choices$value[1L] == "Male")
testthat::expect_true(
cbook$survey$Player$gender$choices$value[2L] == "Female")
# Test for " choices
testthat::expect_true(
cbook$survey$Player$gender2$choices$key[1L] == "Male")
testthat::expect_true(
cbook$survey$Player$gender2$choices$key[2L] == "Female")
testthat::expect_true(
cbook$survey$Player$gender2$choices$value[1L] == "Male")
testthat::expect_true(
cbook$survey$Player$gender2$choices$value[2L] == "Female")
# Further
# True: Cooperate, False Defect
testthat::expect_length(cbook$prisoner$Player$cooperate$choices, 2L)
testthat::expect_s3_class(cbook$prisoner$Player$cooperate$choices,
"data.frame")
})
}
Try the gmoTree package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.