#' iNZight Custom Module
#'
#' Provides a basic module for extending new ones
#'
#' @title iNZight Custom Module
#'
#' @author Tom Elliott
#'
#' @export CustomModule
#' @exportClass CustomModule
CustomModule <- setRefClass(
"CustomModule",
fields = list(
GUI = "ANY",
modwin = "ANY",
mainGrp = "ANY",
homeButton = "ANY"
),
methods = list(
initialize = function(gui,
name = "Module",
embedded = TRUE,
uses_code_panel = FALSE
) {
initFields(GUI = gui)
# if (embedded) {}
modwin <<- GUI$initializeModuleWindow(.self,
title = name,
scroll = TRUE
)
mainGrp <<- modwin$body
homeButton <<- gbutton("Home",
handler = function(h, ...) close()
)
GUI$plotToolbar$update(NULL)
# add(modwin$footer, helpButton, expand = TRUE, fill = TRUE)
add(modwin$footer, homeButton, expand = TRUE, fill = TRUE)
if (GUI$preferences$dev.features && GUI$preferences$show.code)
visible(GUI$code_panel$panel) <<- uses_code_panel
},
get_data = function() {
GUI$getActiveData()
},
install_dependencies = function(pkgs, optional, github) {
# add the iNZight repository:
dkr <- "https://r.docker.stat.auckland.ac.nz"
repo <- options()$repos
if (!dkr %in% repo) repo <- c(dkr, repo)
if (!missing(pkgs)) {
pkgs <- pkgs[!pkgs %in% rownames(utils::installed.packages())]
if (length(pkgs) > 0) {
plot(0, 0, type = "n", bty = "n", xaxt = "n", yaxt = "n",
xlab = "", ylab = "")
text(0, 0, "Installing dependencies, please wait ...")
utils::install.packages(pkgs, quiet = TRUE, repos = repo, dependencies = TRUE)
}
}
if (!missing(optional)) {
optional <- optional[!optional %in% rownames(utils::installed.packages())]
if (length(optional) > 0) {
tryCatch(
utils::install.packages(optional, quiet = TRUE, repos = repo, dependencies = TRUE),
finally = {}
)
}
}
if (!missing(github)) {
remotes::install_github(github, repos = repo)
}
plot(0, 0, type = "n", bty = "n",
xaxt = "n", yaxt = "n",
xlab = "", ylab = "")
},
close = function() {
## run module-specific closure?
## delete the module window
GUI$close_module()
## display the default view (data, variable, etc.)
GUI$plotToolbar$restore()
GUI$menuBarWidget$defaultMenu()
GUI$updatePlot()
invisible(TRUE)
}
)
)
getModules <- function(dir) {
mods <- list.files(dir, pattern = "*.R", full.names = TRUE)
mod_list <- lapply(mods, getmodule)
mod_list <- mod_list[!sapply(mod_list, is.null)]
names(mod_list) <- sapply(mod_list, function(x) x$name)
mod_list
}
getmodule <- function(f) {
## check if file is a Module
t <- readLines(f)
mi <- grep("^#'", t)
meta <- NULL
if (length(mi)) {
meta <- parse_meta(t[mi])
t <- t[-mi]
}
t <- paste(collapse = "\n", t)
if (!grepl("^[a-zA-Z]+[a-zA-Z0-9]*\\s*<-\\s*setRefClass", t)) return(NULL)
## load module into an environment to avoid clashes
e <- new.env()
eval(parse(text = t), e)
## fetch the module's name
objs <- ls(e)
obj <- objs[which(sapply(objs, function(o) {
ob <- e[[o]]
pclass <- try(ob@generator$def@contains$refClass@by, silent = TRUE)
if (inherits(pclass, "try-error")) return(FALSE)
pclass == "CustomModule"
}))]
if (length(obj) != 1) {
warning("Couldn't find module class.")
return(NULL)
}
e$name <- obj
e$display_name <- e[[obj]]@className[1]
e$meta <- meta
e$module <- e[[obj]]
e$path <- f
e
}
parse_meta <- function(x) {
# remove comment
x <- gsub("^#' ", "", x)
m <- regexpr("^@[a-zA-Z]+", x)
names <- substr(x, m + 1, attr(m, "match.length"))
values <- substr(x, m + attr(m, "match.length") + 1, nchar(x))
names(values) <- names
as.list(values)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.