#' inzight controls state
#' @param controls a list of controls
#' @param variables variable names in the dataset
#' @return a inzcontrols object
#' @export
inzcontrols <- function(controls, variables = character()) {
if (missing(controls)) {
controls <- list(
v1 = inzcontrol("Variable 1", variables),
v2 = inzcontrol("Variable 2", variables),
g1 = inzcontrol("Subset Variable 1", variables),
g2 = inzcontrol("Subset Variable 2", variables)
)
}
if (is.null(names(controls))) {
controls <- lapply(controls[[1]], \(c) c[[1]])
}
controls <- lapply(controls, \(x) {
if (!inherits(x, "inzcontrol")) {
do.call(inzcontrol, x)
} else x
})
if (is.list(variables)) variables <- variables[[1]]
self <- list(
controls = controls,
variables = variables
)
class(self) <- "inzcontrols"
self
}
#' @export
print.inzcontrols <- function(x, ...) {
cat("\n")
lapply(x$controls, \(z) {
print(z)
cat("\n")
})
}
#' @describeIn inzcontrols Dispatch method for inzcontrols
#' @export
dispatch.inzcontrols <- function(state, action) {
# again will forward to each control
cli::cli_h1("Dispatching action for inzcontrols")
cat("\n")
print(action)
switch(action$action,
'SET_V1' = ,
'SET_V2' = ,
'SET_G1' = ,
'SET_G2' = {
newstate <- state
v <- tolower(gsub("SET_", "", action$action))
action$action <- "SET_VARIABLE"
newstate$controls[[v]] <- dispatch(newstate$controls[[v]], action)
# change all the options and dispatch to all children
used_vars <- sapply(newstate$controls, \(x) x$value)
used_vars <- as.character(used_vars[used_vars != ""])
available_vars <- newstate$variable[!newstate$variables %in% used_vars]
action <- inzaction("UPDATE_OPTIONS", list(variables = available_vars))
ctrls <- lapply(newstate$controls, dispatch, action = action)
inzcontrols(ctrls, state$variables)
},
state
)
}
#' inzight control state
#' @param name the name of the control (displayed to users)
#' @param options valid options for the control
#' @param value the chosen value
#' @param slider optional, a slider object associated with the control (inzslider)
inzcontrol <- function(name, options, value = "", slider = NULL) {
if (is.list(name)) name <- name[[1]]
if (is.list(options)) options <- options[[1]]
if (is.list(value)) value <- value[[1]]
self <- list(
name = name,
options = options,
value = value,
slider = slider
)
class(self) <- "inzcontrol"
self
}
as_list.inzcontrol <- function(x) {
as_list(unclass(x))
# if (length(x) == 1L)
# )
}
#' @export
print.inzcontrol <- function(x, ...) {
cli::cli_text("{.strong {x$name}}")
cat(paste0("[", ifelse(x$options == x$value, "*", " "), "] ", x$option), sep = "\n")
}
#' @describeIn inzcontrol Dispatch method for inzcontrol
#' @export
dispatch.inzcontrol <- function(state, action) {
cli::cli_h1("Dispatching action for inzcontrol")
cat("\n")
print(action)
switch(action$action,
'SET_VARIABLE' = {
cli::cli_h2("Setting {.emph {state$name}} to {.emph {action$payload$value}}")
newstate <- state
newstate$value <- action$payload$value
newstate
},
'UPDATE_OPTIONS' = {
cli::cli_h2("Updating options for {.emph {state$name}}")
newstate <- state
opts <- action$payload$variables
if (newstate$value != "") opts <- c(newstate$value, opts)
newstate$options <- opts
newstate
},
state
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.