mc <- new("MultipleChoice", identifier = "test_2", title = "Economics", content = list("

When deciding between renovating a water treatment plant or building a new community pool, what is the government most likely to consider? This is a multiline formula: \\[x-1=y\\]

"), choices = c("scarcity vs resources", "wages vs prices", "wants vs needs", "consumers vs producers"), points = c(0.5, 0.5, 0, 0)) mc2 <- new("MultipleChoice", identifier = "Test_2_duplication", title = "Economics", content = list("

When deciding between renovating a water treatment plant or building a new community pool, what is the government most likely to consider? This is a multiline formula: \\[x-1=y\\]

"), choices = c("scarcity vs resources", "wages vs prices", "wants vs needs", "consumers vs producers"), points = c(1.5, 0.5, 0, 0)) sc <- new("SingleChoice", identifier = "eco", title = "Economics and Physic", content = list("

This is a mock question.
In economics it is generally believed that the main objective of a Public Sector Financial Company like Bank is to:

"), choices = c("Employ more and more people", "Maximize total production", "Maximize total profits", "Sell the goods at subsidized cost")) path1 <- test_path("file/rmd/mc_no_point.Rmd") path2 <- test_path("file/xml/Essay.xml") path3 <- test_path("file/md/sc_example1.md") test_that("Testing function section() to build permanent AssessmentSection", { sut <- section(c(path1, path2), id = "permanent_section") # rid of the name from @assessment_item names(sut@assessment_item) <- NULL expected <- new("AssessmentSection", identifier = "permanent_section", assessment_item = list(mc, path2), selection = 0) expect_equal(sut, expected) }) test_that("Testing function section() to build variable nested AssessmentSection", { sut <- section(c(path1, path3), 2, id = "variable_section") # rid of the name from @assessment_item names(sut@assessment_item) <- NULL seed1 <- sut@assessment_item[[1]]@identifier seed1 <- sub(".*S(\\d+).*", "\\1", seed1) seed2 <- sut@assessment_item[[2]]@identifier seed2 <- sub(".*S(\\d+).*", "\\1", seed2) item1_1 <- mc item1_1@identifier <- paste0(mc@identifier, "_S", seed1) item1_1@title <- paste0(mc@title, "_S", seed1) item1_2 <- sc item1_2@identifier <- paste0(sc@identifier, "_S", seed1) item1_2@title <- paste0(sc@title, "_S", seed1) item2_1 <- mc item2_1@identifier <- paste0(mc@identifier, "_S", seed2) item2_1@title <- paste0(mc@title, "_S", seed2) item2_2 <- sc item2_2@identifier <- paste0(sc@identifier, "_S", seed2) item2_2@title <- paste0(sc@title, "_S", seed2) variant1 <- new("AssessmentSection", identifier = paste0("exam_S", seed1), assessment_item = list(item1_1, item1_2)) variant2 <- new("AssessmentSection", identifier = paste0("exam_S", seed2), assessment_item = list(item2_1, item2_2)) expected <- new("AssessmentSection", identifier = "variable_section", selection = 1, assessment_item = list(variant1, variant2)) expect_equal(sut, expected) }) test_that("Testing function section() in the case num_variants < length(seed_number))", { warning_message <- NULL withCallingHandlers( sut <- section(c(path1, path3), n_variants = 2, seed_number = c(4,7,9)), warning = function(w) { warning_message <<- w$message invokeRestart("muffleWarning") }) expected_warning <- ("From seed_number only first 2 items are taken") expect_equal(warning_message, expected_warning) }) test_that("Testing function section() in the case the items in seed_number are not unique)", { error_message <- NULL tryCatch( { section(c("path1", "path3"), n_variants = 2, seed_number = c(7, 7)) }, error = function(e) { error_message <<- conditionMessage(e) } ) expected_error <- ("The items in seed_number are not unique") expect_equal(error_message, expected_error) }) test_that("Testing function section() to build variable AssessmentSection for by = \'files\' ", { path1 <- test_path("file/rmd/mc_no_point.Rmd") path3 <- test_path("file/md/sc_example1.md") num_variants = 3 file <- c(path1, path3) sut <- section(file, num_variants, id = "variable_section", by = "files") # rid of the name from @assessment_item names(sut@assessment_item) <- NULL # create list of expected items item <- list(mc, mc, mc, sc, sc, sc) # collect all seed numbers seed <- c() for (i in seq(length(file))) { for (j in seq(num_variants)) { s <- sut@assessment_item[[i]]@assessment_item[[j]]@identifier s <- sub(".*S(\\d+).*", "\\1", s) seed <- c(seed, s) } } # reassign identifier and titles for expected items for (i in seq(length(item))) { item[[i]]@identifier <- paste0(item[[i]]@identifier, "_S", seed[i]) item[[i]]@title <- paste0(item[[i]]@title, "_S", seed[i]) } # get variant subsections identifiers id_var1 <- sut@assessment_item[[1]]@identifier id_var2 <- sut@assessment_item[[2]]@identifier # create variants variant1 <- new("AssessmentSection", identifier = id_var1, assessment_item = (item[1:3]), selection = 1) variant2 <- new("AssessmentSection", identifier = id_var2, assessment_item = (item[4:6]), selection = 1) # create expected expected <- new("AssessmentSection", identifier = "variable_section", assessment_item = list(variant1, variant2)) expect_equal(sut, expected) }) test_that("Testing warning for selection exceeding number of items", { items <- list(mc, sc, path2) warning_message <- NULL withCallingHandlers( section <- new("AssessmentSection", identifier = "section1", title = "Section 1", assessment_item = items, selection = 4) # Invalid selection value exceeding the number of items , warning = function(w) { warning_message <<- w$message invokeRestart("muffleWarning") }) expected_warning <- ("value of selection (4) must be less than number of items in assessment_item slot (3). Selection is assigned to 2") expect_equal(warning_message, expected_warning) }) test_that("Testing a warning message for getPoints method", { items <- list(mc, mc2, sc) # ms: points = 1, mc2: points = 2 section <- new("AssessmentSection", identifier = "section1", title = "Section 1", assessment_item = items, selection = 2) # Selected the first 2 items with different points expect_warning({ sut_points <- getPoints(section) }, "In section id:section1 there are items with different points. In selection mode, this leads to inconsistent overall score in different test variants: = 1, = 2, eco = 1") }) test_that("Testing test4opal() and test() function in section_builder.R ", { sut <- section(c(path1, path2)) result_1 <- suppressMessages(test4opal(sut)) result_2 <- suppressMessages(test(sut)) expect_s4_class(result_1, "AssessmentTestOpal") expect_s4_class(result_2, "AssessmentTest") })