#' ControlChart
#'
#' R6Class representing a control chart consisting of \code{\link{ControlChartPhase}}s
#' and \code{\link{ControlChartControlLine}}s.
#'
#' @section Usage:
#' \preformatted{control_chart = ControlChart$new(name, type)
#'
#' control_chart$add_phase(ControlChartPhase$new(name))
#'
#' control_chart$get_table()
#' }
#'
#' @section Methods:
#' \describe{
#' \item{\code{new(name, type = c("xbar_R", "xbar_s", "R", "s", "p"))}}{
#' Initialize the control chart.
#' \tabular{ll}{
#' \code{name} \tab \code{\link[base:character]{Character}}. Name of
#' the control chart. \cr
#' \code{type} \tab \code{\link[base:character]{Character}}. Type of
#' the control chart.
#' }
#' }
#' \item{\code{add_control_line(control_line)}}{Add an object of class
#' \code{\link{ControlChartControlLine}} to the control chart.
#' }
#' \item{\code{add_phase(phase)}}{Add an object of class
#' \code{link{ControlChartPhase}} to the control chart.
#' }
#' \item{\code{get_control_line(id = id)}}{Get the control chart's control line
#' with \code{id == id}.
#' }
#' \item{\code{get_control_line_ids()}}{Get all control line ids as a character
#' vector.
#' }
#' \item{\code{get_control_line_values()}}{Get all control line values as a
#' numeric vector.
#' }
#' \item{\code{get_id()}}{Get the control chart's id.
#' }
#' \item{\code{get_name()}}{Get the control chart's name.
#' }
#' \item{\code{get_params()}}{Get the parameters of the control charts
#' preliminary phases values used to calculate the control line values.
#' }
#' \item{\code{get_phase(id)}}{Get the control chart's phase with
#' \code{id == id}.
#' }
#' \item{\code{get_phase_ids(preliminary = NULL)}}{Get all phases ids as a
#' character vector.
#' \tabular{ll}{
#' \code{preliminary} \tab If \code{\link[base:NULL]{NULL}} all ids,
#' if \code{\link[base:logical]{TRUE}} only ids of preliminary phases,
#' if \code{\link[base:logical]{FALSE}} only ids of non-preliminary
#' phases are returned.
#' }
#' }
#' \item{\code{get_plot()}}{Get the control chart's plot as a
#' \code{\link[plotly:plot_ly]{plotly}} plot.
#' }
#' \item{\code{get_table(sample_count = c("chart", "phase"),
#' preliminary = NULL)}}{Get a \code{\link[tibble:tibble]{tibble}} with
#' columns \code{"phase"}, \code{"sample"}, \code{"value"}.
#' \tabular{ll}{
#' \code{sample_count} \tab If \code{"chart"} samples are counted from
#' the perspective of the chart, if \code{"phase"} from the perspective
#' of each phase. \cr
#' \code{preliminary} \tab If \code{\link[base:NULL]{NULL}} all rows,
#' if \code{\link[base:logical]{TRUE}} only rows of preliminary phases,
#' if \code{\link[base:logical]{FALSE}} only rows of non-preliminary
#' phases are returned.
#' }
#' }
#' \item{\code{get_type()}}{Get the control chart's type.
#' }
#' \item{remove_phase(id)}{Remove the phase with \code{id == id}.
#' }
#' \item{\code{set_name(name)}}{Set the control chart's name.
#' \tabular{ll}{
#' \code{name} \tab \code{\link[base:character]{Character}}. New name.
#' }
#' }
#' \item{\code{set_phase_names(new_names, old_names = NULL)}}{Set the names
#' of one or more control chart's phases. If \code{old_names = NULL} the
#' length of \code{new_names} must be equal to the number of the control
#' chart's phases, otherwise the length of \code{new_names} and \code{old_names}
#' has to be equal.
#' \tabular{ll}{
#' \code{new_names} \tab \code{\link[base:character]{Character}}
#' vector. \cr
#' \code{old_names} \tab \code{\link[base:character]{Character}}
#' vector or \code{\link[base:NULL]{NULL}}.
#' }
#' }
#' \item{\code{set_type(type = c("xbar_R", "xbar_s", "R", "s", "p"))}}{Set
#' the control chart's type.
#' \tabular{ll}{
#' \code{type} \tab \code{\link[base:character]{Character}}. New type.
#' }
#' }
#' }
#'
#' @name ControlChart
NULL
#' @export
ControlChart <- R6::R6Class(
classname = "ControlChart",
public = list(
initialize = function(
name, type = c("xbar_R", "xbar_s", "s", "R", "p")
) {
# values is a named list. The name of one element is the phase's id, the
# values of one element are the phase's values
type <- match.arg(type)
private$id <- stringi::stri_rand_strings(1, 8)
private$name <- shiny::reactiveVal(name)
private$type <- shiny::reactiveVal(type)
private$control_line_storage <- ObjectStorage$new(
allowed_class = "ControlChartControlLine"
)
# Always fill the control_line_storage with the center line and lower and
# upper control lines in distance of three quantile
private$control_line_storage$add_object(
ControlChartControlLine$new(
quantile = 0
)
)$add_object(
ControlChartControlLine$new(
quantile = -3
)
)$add_object(
ControlChartControlLine$new(
quantile = 3
)
)
private$phase_storage <- ObjectStorage$new(
allowed_classes = "ControlChartPhase"
)
# Option for the future
# private$positioner <- Positioner$new(
# .length = reactive({length(get_phase_ids())})
# )
},
add_control_line = function(control_line) {
private$control_line_storage$add_object(control_line)
invisible(self)
},
add_phase = function(phase) {
private$phase_storage$add_object(phase)
invisible(self)
},
get_control_line = function(id) {
private$control_line_storage$get_object(id)
},
get_control_line_ids = function() {
private$control_line_storage$get_ids()
},
get_control_line_values = function() {
purrr::map_dbl(
self$get_control_line_ids(),
function(id) {
control_line = private$control_line_storage$get_object(id)
control_line_value(
data = self$get_table(),
quantile = control_line$get_quantile(),
type = private$type()
)
}
)
},
get_id = function() {
private$id
},
get_name = function() {
private$name()
},
get_phase = function(id) {
private$phase_storage$get_object(id)
},
get_phase_ids = function(preliminary = NULL) {
phase_ids <- private$phase_storage$get_ids()
if (purrr::is_null(preliminary)) {
phase_ids
} else {
is_preliminary = purrr::map_lgl(phase_ids, function(id) {
self$get_phase(id)$is_preliminary()
})
return(phase_ids[is_preliminary == preliminary])
}
},
get_plot = function() {
table <- self$get_summarised_table()
p <- plotly::plot_ly(data = table, x = ~sample, y = ~value, type = "scatter", mode = "lines+markers")
control_lines <- self$get_control_line_values()
for (control_line in control_lines) {
p <- add_trace(
p = p,
x = range(table$sample),
y = control_line,
type = "scatter",
mode = "lines",
showlegend = FALSE,
inherit = FALSE
)
}
p
},
# Really needed?
get_summarised_table = function(preliminary = NULL) {
table <- self$get_table(preliminary)
grouped <- table %>% group_by(sample)
switch(
self$get_type(),
"xbar_s" = {
summarised_table <- grouped %>%
summarise(value = mean(value))
},
"s" = {
summarised_table <- grouped %>%
summarise(value = sd(value))
},
"p" = {
summarised_table <- grouped
},
"xbar_R" = {
summarised_table <- grouped %>%
summarise(value = mean(value))
},
"R" = {
R <- function(x) diff(range(x))
summarised_table <- grouped %>%
summarise(value = R(value))
}
)
},
# Get table with columns: phase, sample, value
get_table = function(sample_count = c("chart", "phase"), preliminary = NULL) {
sample_count <- match.arg(sample_count)
phase_ids <- self$get_phase_ids(preliminary)
if (length(phase_ids) > 0) {
df <- map2_dfr(phase_ids, names(phase_ids), function(id, name) {
df <- self$get_phase(id)$get_value()
if (nrow(df) > 0) {
df$phase <- name
} else {
df$phase <- character()
}
df
})
df <- dplyr::select(df, phase, sample, value)
# Count the sample number in perspective of the chart, not the phase
if (sample_count == "chart") {
times <- table(df$phase, df$sample)
df$sample <- rep(seq_along(times), times)
}
} else {
df <- tibble(
phase = character(),
sample = numeric(),
value = numeric()
)
}
df
},
get_type = function() {
private$type()
},
remove_phase = function(id) {
private$phase_storage$remove_object(id)
},
set_name = function(name) {
private$name(name)
invisible(self)
},
set_phase_names = function(new_names, old_names = NULL) {
if (is.null(old_names)) {
phases <- private$phase_storage
} else {
phases <- private$phase_storage$get_object(old_names)
}
walk2(phases, new_names, function(phase, name) {
phase$set_name(name)
})
invisible(self)
},
set_type = function(type = c("xbar_R", "xbar_s", "R", "s", "p")) {
type <- match.arg(type)
private$type(type)
invisible(self)
}
),
private = list(
control_line_storage = NULL,
id = character(),
name = NULL,
phase_storage = NULL,
type = NULL
# positioner = NULL
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.