R/viz_no_in_caliper.R

In ooelrich/oscbvar: Stuff for Bayesian vector autoregressions

#' @title Count the number of previous observation in caliper over time
#'
#' @description
#' Counts the number (or percentage) of previous observations within a 
#' specific caliper with over time.
#'
#' @details
#' Details go here.
#' 
#' @param cw Caliper width value.
#' @param df Data frame containing the pooling variables and time.
#'   The first column needs to be called "t" and contain the timepoint.
#'   It needs to be an unbroken sequence of integers. The rest of the
#'   columns should be continuous pooling variables (local?).
#' @param first_t Timepoint ("t") from which to start counting. Needs
#'   to be greater than the smallest "t"-value in df.
#' @param percentage Should the number of observations within the 
#'   caliper (FALSE) or the percentage within (TRUE) be returned?
#'
#' @return A data.frame with columns count (numer of observation within
#'   caliper), cw_val (caliper width), and time (time point).
#' @export
no_in_caliper <- function(cw, df, first_t, percentage) {
    
    stopifnot(
        colnames(df)[[1]] == "t",
        all(diff(df$t) == 1),
        first_t > min(df$t)
    ) 

    dftemp <- data.frame()
    last_t <- max(df$t)
    count <- cw_val <- time <- rep(NA, times = last_t + 1 - first_t)

    for (i in first_t:last_t) {
        count[i+1-first_t] = sum(
            rowSums(
                t(t(df[df$t < i, -1]) -
                unlist(c(df[df$t == i, -1])))^2
            ) < cw)
        if (percentage) {
            count[i+1-first_t] <- count[i+1-first_t] / (i - min(df$t))
        }
        cw_val[i+1-first_t] <- cw
        time[i+1-first_t] <- i
    }

    dftemp <- rbind(
        dftemp,
        data.frame(count, cw_val = as.factor(cw_val),time))
    return(dftemp)
}

#' @title Plot number of previous observation in caliper over time
#'
#' @description
#' A wrapper for no_in_caliper that returns a plot instead of a data
#' frame. Returns a ggplot object.
#'
#' @details
#' Details go here.
#'
#' @param cw_list List or vector of caliper width value.
#' @param df Data frame containing the pooling variables. The first
#'   column needs to be called "t" and contain the timepoint, in the 
#'   form of an unbroken sequence of integers, the smallest of which
#'   needs to be smaller than the first_t argument.
#' @param first_t Timepoint ("t") from which to start counting.
#' @param percentage Should the number of observations within the 
#'   caliper (FALSE) or the percentage (TRUE) be returned?
#'
#' @return A ggplot object.
#' @importFrom ggplot2 ggplot aes geom_line facet_wrap labs
#' @importFrom rlang .data
#' @export
plot_no_in_caliper <- function(cw_list, df, first_t, percentage = TRUE){

    df_list <- lapply(
        cw_list,
        no_in_caliper,
        df, first_t, percentage)
    df_fin <- do.call(rbind, df_list)
    if (ncol(df) > 2) {
        titt <- paste(colnames(df[, -1]), collapse = ",")    
    } else {
        titt <- colnames(df)[2]
    }
    

    if (length(levels(df_fin$cw_val)) < 6) {
        plt <- ggplot(
            df_fin,
            aes(
                x = .data$time,
                y = .data$count,
                col = .data$cw_val
                )
            ) +
            geom_line() +
            labs(title = titt)
    } else {
        plt <- ggplot(df_fin, aes(x = .data$time, y = .data$count)) +
            geom_line() +
            facet_wrap( ~ .data$cw_val) +
            labs(title = titt)
    }

    return(plt)
}