test_that("Testing create_item_body_text ", {
entry <- suppressMessages(new("Entry",
content = list('
Identify the missing words in this famous quote from Shakespeare\'s Richard III.
', 'Now is the of our discontent',
new("TextGap",
solution = c("winter", "WINTER", "Winter"),
response_identifier = "RESPONSE_1",
points = 0.5,
expected_length = 10),
"
","",
new("NumericGap",
response_identifier = "RESPONSE_2",
solution = 12,
points = 0.5,
tolerance = 1,
expected_length = 4),
"leaves by this sun of York;
And all the clouds that lour'd upon our house
In the deep bosom of the ocean buried. At",
new("NumericGap",
response_identifier = "RESPONSE_4",
solution = 12.5,
tolerance = 1,
expected_length = 5,
placeholder = "Floating point"),
"meters under the darkness is found.
")))
# The XML example was taked from OPAL because qti
# example doesn't work in OPAL
example <- '
Identify the missing words in this famous quote from Shakespeare\'s Richard III.
Now is the of our discontent
leaves by this sun of York;
And all the clouds that lour\'d upon our house
In the deep bosom of the ocean buried. At
meters under the darkness is found.
'
sut <- xml2::read_xml(as.character(createItemBody(entry)))
expected <- xml2::read_xml(example)
expect_equal(sut, expected)
})
test_that("Testing create Response Declaration Gap ", {
entry <- suppressMessages(new("Entry",
content = list('Identify the missing words in this famous quote from Shakespeare\'s Richard III.
', 'Now is the of our discontent',
new("TextGap",
solution = c("winter","WINTER", "Winter"),
response_identifier = "RESPONSE_1",
points = 0.5,
expected_length = 10),
"
","",
new("NumericGap",
response_identifier = "RESPONSE_2",
solution = 1234567890,
tolerance = 1,
expected_length = 4),
"leaves by this sun of York;
And all the clouds that lour'd upon our house
In the deep bosom of the ocean buried. At",
new("NumericGap",
response_identifier = "RESPONSE_4",
solution = 12.5,
tolerance = 1,
points = 0.5,
placeholder = "Floating point"),
"meters under the darkness is found.
")))
# The XML example was taken from OPAL because qti example doesn't work in OPAL
# Response Declaration 1. In the example was not included
#
# in mapEntry is included caseSensitive="true" according to
# qti inf model: caseSensitive [1]: boolean
example <- '
winter
'
responseDe <- createResponseDeclaration(entry)[[1]]
sut <- xml2::read_xml(as.character(responseDe))
expected <- xml2::read_xml(example)
expect_equal(sut, expected)
# 'Response Declaration 2
example <- '
1234567890
'
responseDe <- createResponseDeclaration(entry)[[2]]
sut <- xml2::read_xml(as.character(responseDe))
expected <- xml2::read_xml(example)
expect_equal(sut, expected)
# 'Response Declaration 3
example <- '
12.5
'
responseDe <- createResponseDeclaration(entry)[[3]]
sut <- xml2::read_xml(as.character(responseDe))
expected <- xml2::read_xml(example)
expect_equal(sut, expected)
})
test_that("Testing create Outcome Declaration Gap ", {
entry <- suppressMessages(new("Entry",
content = list('Identify the missing words in this famous quote from Shakespeare\'s Richard III.
', 'Now is the of our discontent',
new("TextGap",
solution = c("winter", "WINTER", "Winter"),
response_identifier = "RESPONSE_1",
points = 0.5,
expected_length = 10),
"
","",
new("NumericGap",
response_identifier = "RESPONSE_2",
solution = 12,
tolerance = 1,
expected_length = 4),
"leaves by this sun of York;
And all the clouds that lour'd upon our house
In the deep bosom of the ocean buried. At",
new("NumericGap",
response_identifier = "RESPONSE_4",
solution = 12.5,
tolerance = 1,
expected_length = 5,
points = 0.5,
placeholder = "Floating point"),
"meters under the darkness is found.
")))
# The XML example was taken from OPAL because qti example doesn't work in OPAL
# Outcome Declaration 1.Omitted the tag view="testConstructor" from OPAL
# example. There is not outcome Delete it from the example
example <- '
0
2
0
\n
0
0.5
0
\n
0
1
0
0
0.5
0
'
responseDe <- as.character(htmltools::tag(
"additionalTag", list(createOutcomeDeclaration(entry))))
sut <- xml2::read_xml(responseDe)
expected <- xml2::read_xml(example)
expect_equal(sut, expected)
})
test_that("Testing create_item_body_text ", {
entry <- suppressMessages(new("Entry",
content = list('The speed of light is', new("TextGapOpal",
response_identifier = "RESPONSE_1",
points = 1,
solution = c("more", "MORE", "More"),
tolerance = 4),
'than the speed of sound')))
expected <- '
'
response <- as.character(htmltools::tag(
"additionalTag", list(createResponseProcessing(entry))))
sut <- xml2::read_xml(response)
expected <- xml2::read_xml(expected)
expect_equal(sut, expected)
})
test_that("Testing function of create_outcome_declaration_entry
for Entry class", {
sut <- suppressMessages(new("Entry", identifier = "new",
points = 3,
title = "NumericGap",
content = list('The speed of light is equal',
new("NumericGap",
response_identifier = "RESPONSE_1",
points = 3,
solution = 300,
tolerance = 2,
include_lower_bound = TRUE,
include_upper_bound = TRUE),'m/s'),
feedback = list(new("ModalFeedback", title = "common",
content = list("general feedback")))) )
example <- '
0
3
0
0
3
0
empty
'
sut1 <- toString(htmltools::tag(
"additionalTag", list(create_outcome_declaration_entry(sut))))
sut <- xml2::read_xml(sut1)
expected <- xml2::read_xml(example)
expect_equal(sut, expected)
})
test_that("Testing of the warning message in case response_identifier
in NumericGap class is empty", {
warning_message <- NULL
suppressWarnings(withCallingHandlers(
{
sut <- new("Entry", identifier = "new",
points = 3,
title = "NumericGap",
content = list(
'The speed of light is equal',
new("NumericGap",
# "response_identifier" is empty
points = 3,
solution = 300,
tolerance = 2,
include_lower_bound = TRUE,
include_upper_bound = TRUE)
, 'm/s'))
response_identifier <- sut@content[[2]]@response_identifier
sut_warning <- paste0(
"There is no response_identifier in Gap-object. A random value is assigned: ", response_identifier)
},
warning = function(w) {
warning_message <<- w$message
}
))
expect_equal(warning_message, sut_warning)
})
test_that("Testing warning message in the case Identifiers of objects
in content-slot are non-unique for Entry class", {
warning_message <- NULL
suppressWarnings(withCallingHandlers(
{
sut <-suppressMessages(new("Entry", identifier = "new",
points = 3,
title = "test",
content = list(
'The speed of light is equal',
new("NumericGap",
response_identifier ="RESPONSE_1",
points = 3,
solution = 300,
tolerance = 2),
'm/s','The speed of sound is equal',
new("NumericGap",
response_identifier ="RESPONSE_1",
points = 3,
solution = 343,
tolerance = 2),
'm/s', 'The speed of light is',
new("TextGapOpal",
response_identifier = "RESPONSE_1",
points = 1,
solution = c("more", "MORE", "More"),
tolerance = 4),
'than the speed of sound')))
entry <- initialize(sut)
sut_warning <- (
"Identifiers of objects in content-slot are non-unique : RESPONSE_1, RESPONSE_1, RESPONSE_1")
},
warning = function(w) {
warning_message <<- w$message
}
))
expect_equal(warning_message, sut_warning)
})