#' Lookup local Gaussian details based on the logged information
#'
#' @description This internal function creates a lookup-environment
#' that combines different values from the logged information.
#' The purpose is to collect the results of different minor
#' computations, which is needed in several functions.
#'
#' @param input A non-reactive version of the \code{input}-list
#' generated by \code{LG_shiny}.
#'
#' @param .AB_env The environment that contains the desired
#' information.
#'
#' @details This function will copy the values from \code{input}, and
#' supplement those with values extracted from the information
#' logged in \code{.AB_env}. Assorted logical values are computed
#' from this, and some minor chunks of derived information is also
#' created in the initial stage. These will be used later on in
#' the functions involved in the interactive investigation of the
#' different plots that can be created from the estimated local
#' Gaussian correlations. Some additional specialised information
#' is then added by the help of related \code{lookup}-functions.
#'
#' @return An environment will be returned to the workflow, in which
#' there will be a basic component as specified under details, and
#' then there are four lists with specialised information as
#' outlined below:
#'
#' \describe{
#'
#' \item{restrict}{This part is created by the help of
#' \code{LG_lookup_restrict}, and it contains the information that
#' is needed in order to extract the desired local Gaussian auto-
#' and cross-correlations from the data-structure created by the
#' scribe-functions.}
#'
#' \item{cache}{This part is created by the help of
#' \code{LG_lookup_cache}, and it contains the unique cache-keys
#' that enables a primitive caching-procedure to be used in the
#' interactive \code{LG_shiny}-application.}
#'
#' \item{details}{This part is created by the help of
#' \code{LG_lookup_details}, and it contains the information that
#' is needed in order to describe the content of a given plot.
#' This information will be added as an attribute when a plot is
#' created in a nonreactive setting, which implies that it is
#' easily available when a plot is to be included in a
#' paper/presentation. See \code{LG_explain_plots} for further
#' details.}
#'
#' \item{curlicues}{This part is created by the help of
#' \code{LG_lookup_curlicues}, and it contains the details needed
#' in order to annotate assorted information (curlicues) to the
#' final plots. A plot-stamp that reveals the content of the plot
#' will always be present together with information about the
#' length of the sample and the number of replicates. Additional
#' information will be added depending on the type of plot, this
#' can e.g. be details related to the truncation level, the point
#' of investigation, the bandwidth, the status for the numerical
#' convergence of the estimates, or the block length used for the
#' bootstrapping algorithm. See the scripts for examples related
#' to how the annotated text can adjusted when the plots are
#' created in a nonreactive setting.}
#'
#' }
#'
#' @keywords internal
LG_lookup <- function(input,
.AB_env) {
## The '.AB_env'-argument always refers to the 'approx'-level,
## and the following adjustment is required in order for the
## bootstrap-case to be properly dealt with.
if (is.environment(.AB_env[[input$Boot_Approx]])) {
## Register the paths to the files that contains the
## computations based on the original samples.
.orig_files <- list(
.global_file = .AB_env$details$.global_file,
approx_file = .AB_env$details$.local_files[input$type])
## Restrict the attention to the parameters use in the
## analysis of the bootstrapped samples.
.AB_env <- .AB_env[[input$Boot_Approx]]
}
## Initiate 'look_up' as a copy of 'input'. extract information
## from '.AB_env', and compute ingredients needed later on.
look_up <- input
## TODO: New plot-functions will require additional
## interface-arguments, but until those have been implemented it
## is necessary to have this tweak in order to test the other
## parts of the code.
if (is.null(look_up$spectra_f_or_F))
look_up$spectra_f_or_F <- "f" # "F"
if (is.null(look_up$complex))
look_up$complex <- FALSE
if (is.null(look_up$complex_c_or_p_or_z))
look_up$complex_c_or_p_or_z <- "c" # "p" "z"
if (is.null(look_up$heatmap))
look_up$heatmap <- FALSE
if (is.null(look_up$heatmap_b_or_v))
look_up$heatmap_b_or_v <- "b" # "v"
if (is.null(look_up$L2_distance_plot))
look_up$L2_distance_plot <- FALSE
if (is.null(look_up$L2_distance_percentages))
look_up$L2_distance_percentages <- FALSE
if (is.null(look_up$L2_distance_vbmL))
look_up$L2_distance_vbmL <- "v"
if (is.null(look_up$drop_annotation))
look_up$drop_annotation <- FALSE
if (is.null(look_up$non_interactive))
look_up$non_interactive <- FALSE
## Adjust for the 'cut' vs. 'm_selected' values
look_up$m_selected <- look_up$cut
look_up$cut <- look_up$cut + 1
## Add the paths to the files of interest, i.e. those containing
## the global and local values of the estimated correlations.
look_up$.global_file <- .AB_env$details$.global_file
look_up$approx_file <- .AB_env$details$.local_files[look_up$type]
## Extract bootstrap-relevant information when possible.
## about 'boot_type', 'block_length' and 'nb' (number of
## bootstrap replicates).
if (.AB_env$is_bootstrap) {
look_up$.orig_files <- .orig_files
for (.arg in c("boot_type", "block_length", "nb"))
look_up[[.arg]] <- .AB_env$details[[.arg]]
kill(.arg, .orig_files)
}
## Extract details related to the points under investigation, and
## add the logical value that reveals if only on-diagonal points
## will be encountered later on.
look_up$.Horizontal <- .AB_env$details$.Horizontal
look_up$.Vertical <- .AB_env$details$.Vertical
look_up$.Shape <- .AB_env$details$.Shape
## Use the values "Vi" and "Vj" to create the subsetting needed
## for the extract of relevant "pairs".
look_up$pairs_ViVj <- paste(input[c("Vi", "Vj")], collapse = "_")
look_up$pairs_VjVi <- paste(input[c("Vj", "Vi")], collapse = "_")
## Create a logical value to reveal if an adjustment of the sign
## is required when the correlations are unfolded (an effect due
## to the "complex-conjugation" and "diagonal symmetry" used to
## avoid redundant computations).
look_up$is_adjust_sign <- local({
.tmp1 <- unlist(input[c("Vi", "Vj")])
! identical(.tmp1, sort(.tmp1))
})
## When a spectrum is available, decide what kind it is. One of
## the values "Co", "Quad", "amplitude" and "phase" for the
## complex-valued case - only "Co" for the real valued case.
## REMINDER: I think the stored names should be slightly
## adjusted, in which case the present mess can be simplified.
look_up$spectra_type <- local({
if (is.na(look_up$S_type))
return(NA_character_)
.key <- tail(
x = stringr::str_split(
string = look_up$S_type,
pattern = "_")[[1]],
n = 1)
ifelse(test = nchar(.key) == 1,
yes = "Co",
no = .key)
})
## Adjust the 'frequency_range' when a complex-valued plot is
## desired in the non-interactive setting.
if (all(look_up$non_interactive,
look_up$complex)) {
look_up$frequency_range <-
look_up$complex_frequency + c(0, 0.01)
}
## Specify different lengths to be used for the vector of
## frequencies. This should be open for adjustment by the user
## in the non-interactive setting.
look_up$frequency_vector_length <- local({
if (look_up$heatmap)
return(200)
if (look_up$non_interactive) {
if (look_up$complex) {
2
} else {
128
}
} else {
64
}
})
## Create the frequency vector.
look_up$omega_vec <- seq(
from = look_up$frequency_range[1],
to = look_up$frequency_range[2],
length.out = look_up$frequency_vector_length)
## The lag-vector should include all available values in the
## interactive setting, but only the ones of interest for the
## specified plot in the non-interactive setting.
look_up$lag_vec <-
if (all(look_up$non_interactive,
look_up$TCS_type == "S")) {
seq_len(look_up$m_selected)
} else {
seq_len(max(as.numeric(.AB_env$details$.dimnames$lag)))
}
## Add a logical value needed in some tests.
look_up$is_lag_zero_included <- {
"0" %in% .AB_env$details$.dimnames$lag}
## Add different logical values needed later on. Reminder:
## 'is_multivariate' and 'is_univariate' is related to whether or
## not the time series under investigation is multivariate or
## univariate. 'is_block' refers to blocks of simulated time
## series, 'is_bootstrap' refers to blocks of bootstrapped time
## series based on one original time series. 'is_CI_needed'
## reveals if there is a need for pointwise confidence intervals
## for the estimated spectral densities. 'is_auto_pair' and
## 'is_cross_pair' reveals if the investigation is based on
## auto-correlations or cross-correlations.
look_up$is_multivariate <- .AB_env$details$is_multivariate
look_up$is_univariate <- ! look_up$is_multivariate
look_up$is_block <- .AB_env$details$block
look_up$is_bootstrap <- .AB_env$is_bootstrap
look_up$is_CI_needed <- any(look_up$is_block,
look_up$is_bootstrap)
look_up$is_auto_pair <- {input$Vi == input$Vj}
look_up$is_cross_pair <- ! look_up$is_auto_pair
## Create logical values to reveal if we are going to inspect an even or an
## odd frequency-spectrum.
look_up$is_odd_spectrum <-
{look_up$spectra_type %in% c("Quad", "phase")}
look_up$is_even_spectrum <- ! look_up$is_odd_spectrum
## For the plots of the estimated local Gaussian auto- and
## cross-correlations: Check if lag zero is needed (it will
## always be one when univariate, and the value can then be
## excluded from the plot).
look_up$is_lag_zero_needed <- {! look_up$pairs_ViVj == look_up$pairs_VjVi}
look_up$is_only_diagonal <- .AB_env$details$is_only_diagonal
## Create logical values for the selection of relevant components
## for the different cases that can occur.
look_up$is_on_diagonal <-
if (look_up$is_only_diagonal) {
TRUE
} else if (look_up$point_type != "on_diag") {
look_up$.Horizontal[look_up$levels_Horizontal] ==
look_up$.Vertical[look_up$levels_Vertical]
} else
TRUE
look_up$is_off_diagonal <- ! look_up$is_on_diagonal
## Create logical values to reveal if global or local data should be
## presented in the plot.
look_up$is_global_only <- {input$global_local == "global"}
look_up$is_local <- {input$global_local == "local"}
## Create information needed for the selection of the correct
## point of investigation, by computing them from '.Horizontal'
## and '.Vertical', taking '.Shape' into account.
look_up$.point_coord <-
if (look_up$point_type == "on_diag") {
local({
.i <- input$levels_Diagonal
.x <- sort(union(x = look_up$.Horizontal,
y = look_up$.Vertical))[.i]
c(.x, .x)
})
} else {
switch(EXPR = look_up$.Shape,
points = c(look_up$.Horizontal, look_up$.Vertical),
line = local({
.i <- input$levels_Line
.x <- look_up$.Horizontal[.i]
.y <- look_up$.Vertical[.i]
c(.x, .y)
}),
rectangle = local({
.i <- input$levels_Horizontal
.j <- input$levels_Vertical
.x <- look_up$.Horizontal[.i]
.y <- look_up$.Vertical[.j]
c(.x, .y)
}))
}
## Update 'look_up' with the relevant entities needed later on,
## i.e. a node 'levels_point' for subsetting and a node
## '.selected_percentile' to be used as information on the plot.
look_up$levels_point <- paste(
look_up$.point_coord,
collapse = "_")
look_up$levels_point_reflected <- paste(
look_up$.point_coord[2:1],
collapse = "_")
## Compare 'levels_point' and 'levels_point_reflected' to see if it is
## necessary to include negative lags.
look_up$is_negative_lags_needed <- {
! all(look_up$levels_point == look_up$levels_point_reflected,
! look_up$is_lag_zero_needed)}
## Find the details related to the 'xlim'-value.
look_up$max_lag <- max(look_up$lag_vec)
look_up$xlim <-
if (look_up$TCS_type == "C") {
if (look_up$is_negative_lags_needed) {
if (all(look_up$is_global_only,
look_up$is_univariate)) {
range(0, look_up$max_lag)
} else
c(-1, 1) * look_up$max_lag
} else
range(0, look_up$max_lag)
} else {
look_up$frequency_range
}
## Find the details related to the selected confidence interval.
look_up$.CI_low_high <-
if (look_up$is_CI_needed)
if (look_up$confidence_interval == "min_max") {
c("min", "max")
} else {
paste(c("low", "high"),
look_up$confidence_interval,
sep = "_")
}
## It is necessary to derive a 'point_type_branch' from 'point_type' in
## order for the correct data to be loaded.
if (look_up$is_on_diagonal) {
if (look_up$point_type != "on_diag")
look_up$levels_Diagonal <- which(
sort(union(look_up$.Horizontal, look_up$.Vertical)) %in%
look_up$.Horizontal[look_up$levels_Horizontal])
look_up$point_type_branch <- "on_diag"
} else
look_up$point_type_branch <- "off_diag"
## Create a bookmark needed for the inspection of the spectra.
look_up$.bm_CI_local_spectra <-
c(look_up$point_type_branch, look_up$cut, "spec")
## Add the names to be used for the loaded files.
look_up$global_name <- "LGC_array_global"
look_up$local_name <- "LGC_array_local"
## Add a 'restrict'-list to 'look_up', to be used when slicing up
## the loaded data into the desired shapes.
look_up$restrict <- LG_lookup_restrict(look_up = look_up)
## Add a 'cache'-list to 'look_up'
look_up$cache <- LG_lookup_cache(look_up = look_up)
## Add 'details' to 'look_up', this will be used to explain the
## content of the plots, both in the interactive and
## non-interactive investigations. In the latter case it will be
## available as an attribute to the plot, and 'LG_explain_plot'
## can then give a standard presentation — or a user can extract
## the details directly from the attribute in order to create
## his/hers own presentation.
look_up$details <- LG_lookup_details(
look_up = look_up,
.AB_env = .AB_env)
## Add 'curclicues'-details to 'look_up', i.e. details related to
## the size, colour, position and so on for the information added
## to the final plot.
look_up$curlicues = LG_lookup_curlicues(look_up = look_up)
## Return the result to the workflow.
return(as.environment(look_up))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.