context("Code writing")
skip_on_cran()
# load_all("../iNZightPlots")
msg <- function(x, type = 1L) {
Sys.sleep(0.5)
x <- sprintf(
"\n %s %s %s\n",
switch(type,
"++++++++++++",
"--------",
"-"
),
x,
switch(type,
"++++++++++++",
"",
""
)
)
cat(x)
}
msg("Starting CODE WRITING test")
# try(ui$close()); load_all()
ui <- iNZGUI$new()
ui$initializeGui()
on.exit(gWidgets2::dispose(ui$win))
Sys.sleep(2)
msg("Data set code is applied", 2L)
test_that("Data set code is applied", {
cas <- census.at.school.500
attr(cas, "code") <- "read_csv('cas.csv')"
ui$setDocument(iNZDocument$new(data = cas), reset = TRUE)
Sys.sleep(2)
expect_match(
gsub("\\s\\s+", " ", paste(ui$rhistory$get(), collapse = " ")),
"cas <- read_csv(\"cas.csv\")",
fixed = TRUE
)
})
# msg("magrittr library call is included", 2L)
# test_that("magrittr library call is included", {
# expect_match(
# gsub("\\s\\s+", " ", paste(ui$rhistory$get(), collapse = " ")),
# "library(magrittr)",
# fixed = TRUE
# )
# })
msg("Plot code is generated correctly", 2L)
test_that("Plot code is generated correctly", {
msg("height", 3L)
svalue(ui$ctrlWidget$V1box) <- "height"
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(~height, data = cas)"
)
msg("height ~ travel", 3L)
system("import -window root screen.jpeg")
svalue(ui$ctrlWidget$V2box) <- "travel"
msg("now checking the code ...", 3L)
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ travel, data = cas)"
)
msg("height ~ travel | gender", 3L)
svalue(ui$ctrlWidget$G1box) <- "gender"
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ travel | gender, data = cas)"
)
msg("height ~ travel | gender + age", 3L)
svalue(ui$ctrlWidget$G2box) <- "age"
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ travel | gender, data = cas)"
)
ui$ctrlWidget$ctrlGp$children[[1]][8L, 1L]$set_index(2L)
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ travel | gender + age, g2.level = \"[7 - 11]\", data = cas)"
)
msg("height ~ travel | gender + age[7 - 11]", 3L)
svalue(ui$ctrlWidget$V2box, TRUE) <- 1L
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(~height | gender + age, g2.level = \"[7 - 11]\", data = cas)"
)
msg("height | age[7 - 11]", 3L)
svalue(ui$ctrlWidget$G1box, TRUE) <- 1L
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(~height | age, data = cas, g1.level = \"[7 - 11]\")"
)
msg("height ...", 3L)
ui$ctrlWidget$ctrlGp$children[[1]][8L, 1L]$set_index(1L)
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(~height, data = cas)"
)
msg("height | gender", 3L)
svalue(ui$ctrlWidget$G2box, TRUE) <- 1L
svalue(ui$ctrlWidget$G1box) <- "gender"
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(~height | gender, data = cas)"
)
svalue(ui$ctrlWidget$G1box, TRUE) <- 1L
})
msg("Plot code generated by add to plot - colour by", 2L)
test_that("Plot code generated by add to plot - colour by", {
svalue(ui$ctrlWidget$V1box) <- "travel"
expect_true(ui$plotToolbar$addToPlot(message = FALSE))
# fill colour by gender
tbl <- ui$moduleWindow$body$children[[1]]$children[[1]]
wi <- which(
sapply(
seq_len(tbl$get_dim()[["nrow"]]),
function(i) {
z <- svalue(tbl[i, 1]) == "Colour by :"
length(z) && z
}
)
)
ci <- which(
sapply(tbl$child_positions, function(x) identical(x$child, tbl[wi, 3]))
)
colby <- tbl$children[[ci]]
suppressWarnings(colby$set_value("gender"))
expect_equal(as.character(ui$getActiveDoc()$getSettings()$colby), "gender")
expect_equal(ui$getActiveDoc()$getSettings()$col.fun, "contrast")
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(~travel, colby = gender, data = cas, col.fun = \"contrast\")"
)
colby$set_index(1L)
ui$moduleWindow$footer$children[[2]]$invoke_change_handler()
svalue(ui$ctrlWidget$V1box) <- "height"
svalue(ui$ctrlWidget$V2box) <- "armspan"
expect_true(ui$plotToolbar$addToPlot(message = FALSE))
tbl <- ui$moduleWindow$body$children[[1]]$children[[1]]
wi <- which(
sapply(
seq_len(tbl$get_dim()[["nrow"]]),
function(i) {
z <- svalue(tbl[i, 1]) == "Colour by :"
length(z) && z
}
)
)
ci <- which(
sapply(tbl$child_positions, function(x) identical(x$child, tbl[wi, 3]))
)
colby <- tbl$children[[ci]]
suppressWarnings(colby$set_value("gender"))
expect_equal(as.character(ui$getActiveDoc()$getSettings()$colby), "gender")
expect_equal(ui$getActiveDoc()$getSettings()$col.fun, "contrast")
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ armspan, colby = gender, data = cas, col.fun = \"contrast\")"
)
suppressWarnings(colby$set_value("age"))
expect_equal(as.character(ui$getActiveDoc()$getSettings()$colby), "age")
expect_equal(ui$getActiveDoc()$getSettings()$col.fun, "viridis")
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ armspan, colby = age, data = cas, col.fun = \"viridis\")"
)
## Emphasize
colby$set_index(1)
ui$moduleWindow$footer$children[[2]]$invoke_change_handler()
})
# try(ui$close()); load_all()
# if (interactive()) {
# ui <- iNZGUI$new()
# ui$initializeGui(census.at.school.500)
# on.exit(gWidgets2::dispose(ui$win))
# Sys.sleep(2)
# }
msg("Plot code generated by add to plot - size by", 2L)
test_that("Plot code generated by add to plot - size by", {
svalue(ui$ctrlWidget$V1box) <- "height"
svalue(ui$ctrlWidget$V2box) <- "armspan"
expect_true(ui$plotToolbar$addToPlot(message = FALSE))
# fill colour by gender
tbl <- ui$moduleWindow$body$children[[1]]$children[[1]]
wi <- which(
sapply(
seq_len(tbl$get_dim()[["nrow"]]),
function(i) {
z <- svalue(tbl[i, 1]) == "Resize points by :"
length(z) && z
}
)
)
ci <- which(
sapply(tbl$child_positions, function(x) identical(x$child, tbl[wi, 3]))
)
sizeby <- tbl$children[[ci]]
suppressWarnings(sizeby$set_value("age"))
expect_equal(as.character(ui$getActiveDoc()$getSettings()$sizeby), "age")
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ armspan, sizeby = age, data = cas)"
)
# emphasize
pri <- which(
sapply(tbl$child_positions, function(x) identical(x$child, tbl[wi + 1, 3]))
)
prop <- tbl$children[[pri]]
expect_equal(svalue(prop), "proportional")
svalue(prop) <- "emphasize"
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ armspan, sizeby = age, data = cas, resize.method = \"emphasize\")"
)
expect_silent(svalue(sizeby, index = TRUE) <- 1)
sizeby$set_index(1)
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ armspan, data = cas)"
)
ui$moduleWindow$footer$children[[2]]$invoke_change_handler()
})
msg("Plot ... - symbol by", 2L)
test_that("Plot code generated by add to plot - symbol by", {
svalue(ui$ctrlWidget$V1box) <- "height"
svalue(ui$ctrlWidget$V2box) <- "armspan"
expect_true(ui$plotToolbar$addToPlot(message = FALSE))
# fill colour by gender
tbl <- ui$moduleWindow$body$children[[1]]$children[[1]]
wi <- which(
sapply(
seq_len(tbl$get_dim()[["nrow"]]),
function(i) {
z <- svalue(tbl[i, 1]) == "Symbol by :"
length(z) && z
}
)
)
ci <- which(
sapply(tbl$child_positions, function(x) identical(x$child, tbl[wi, 3]))
)
symby <- tbl$children[[ci]]
suppressWarnings(symby$set_value("gender"))
expect_equal(as.character(ui$getActiveDoc()$getSettings()$symbolby), "gender")
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ armspan, symbolby = gender, data = cas)"
)
symby$set_index(1)
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(height ~ armspan, data = cas)"
)
ui$moduleWindow$footer$children[[2]]$invoke_change_handler()
})
msg("... cat x cat", 2L)
test_that("Plot code generated by add to plot - cat x cat", {
svalue(ui$ctrlWidget$V1box) <- "travel"
suppressWarnings(svalue(ui$ctrlWidget$V2box) <- "gender")
expect_true(ui$plotToolbar$addToPlot(message = FALSE))
# fill colour by gender
tbl <- ui$moduleWindow$body$children[[1]]$children[[1]]
wi <- which(
sapply(
seq_len(tbl$get_dim()[["nrow"]]),
function(i) {
z <- svalue(tbl[i, 1]) == "Colour palette : "
length(z) && z
}
)
)
ci <- which(
sapply(tbl$child_positions, function(x) identical(x$child, tbl[wi, 3]))
)
colpal <- tbl$children[[ci]]
suppressWarnings(colpal$set_index(2L))
expect_equal(as.character(ui$getActiveDoc()$getSettings()$col.fun), "bright")
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(travel ~ gender, data = cas, col.fun = \"bright\")"
)
suppressWarnings(colpal$set_index(1L))
expect_equal(
attr(ui$curPlot, "code"),
"inzplot(travel ~ gender, data = cas, col.fun = \"contrast\")"
)
ui$moduleWindow$footer$children[[2]]$invoke_change_handler()
})
ui$close()
msg("Load survey", 2L)
data(api, package = "survey")
# load_all("../iNZightTools")
# try(ui$close(), TRUE); load_all()
ui <- iNZGUI$new()
ui$initializeGui(apiclus1)
on.exit(gWidgets2::dispose(ui$win))
Sys.sleep(2)
ui$getActiveDoc()$getModel()$setDesign(
list(clus1 = "dnum", weights = "pw", fpc = "fpc", survey_type = "survey"),
gui = ui
)
msg("Survey design code is valid", 2L)
test_that("Survey design code is valid", {
svalue(ui$ctrlWidget$V1box) <- "enroll"
expect_equal(ui$plotType, "hist")
expect_equal(attr(ui$curPlot, "code"), "inzplot(~enroll, design = apiclus1.svy)")
smry <- iNZGetSummary$new(ui)
on.exit(gWidgets2::dispose(smry$win))
expect_match(svalue(smry$code_box), "inzsummary(~enroll, design = apiclus1.svy)", fixed = TRUE)
gWidgets2::dispose(smry$win)
inf <- iNZGetInference$new(ui)
on.exit(gWidgets2::dispose(inf$win))
expect_match(
svalue(inf$code_box),
"inzinference(~enroll, design = apiclus1.svy, hypothesis = NULL)",
fixed = TRUE
)
expect_silent(inf$hypothesis_test$set_index(2L))
expect_silent(inf$hyp_null$set_value(500))
expect_match(
svalue(inf$code_box),
"inzinference(~enroll, design = apiclus1.svy, hypothesis.value = 500)",
fixed = TRUE
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.