localgaussSpec: Local Gaussian Spectral Analysis

Documented in LG_lookup

#' 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))
}