spsanderson / healthyR.ts

A time-series companion package to healthyR
https://www.spsanderson.com/healthyR.ts/
Other
19 stars 3 forks source link

`ts_sma_plot()` breaks if there is not a column called value #345

Closed spsanderson closed 2 years ago

spsanderson commented 2 years ago

Add param of .value_col to function because if the column value does not exists the function fails.

spsanderson commented 2 years ago

Function:

#' Simple Moving Average Plot
#'
#' @author Steven P. Sanderson II, MPH
#'
#' @description
#' This function will take in a value column and return any number `n` moving averages.
#'
#' @details
#' This function will accept a time series object or a tibble/data.frame. This is a
#' simple wrapper around [timetk::slidify_vec()]. It uses that function to do the underlying
#' moving average work.
#'
#' It can only handle a single moving average at a time and therefore if multiple
#' are called for, it will loop through and append data to a tibble object.
#'
#' @param .data The data that you are passing, must be a data.frame/tibble.
#' @param .date_col The column that holds the date.
#' @param .value_col The column that holds the value.
#' @param .sma_order This will default to 1. This can be a vector like c(2,4,6,12)
#' @param .func The unquoted function you want to pass, mean, median, etc
#' @param .align This can be either "left", "center", "right"
#' @param .partial This is a bool value of TRUE/FALSE, the default is TRUE
#'
#' @examples
#' df <- ts_to_tbl(AirPassengers) %>%
#'   select(-index)
#' out <- ts_sma_plot(df, date_col, value, .sma_order = c(3,6))
#'
#' out$data
#'
#' out$plots$static_plot
#'
#'
#' @return
#' Will return a list object.
#'
#' @export ts_sma_plot
#'

ts_sma_plot <- function(.data, .date_col, .value_col, .sma_order = 2, 
                        .func = mean, .align = "center", .partial = FALSE) {

  # * Tidyeval ----
  date_col_var_expr <- rlang::enquo(.date_col)
  value_col_var_expr <- rlang::enquo(.value_col)

  # slidify_vec parameters
  sma_vec      <- as.vector(.sma_order)
  sma_fun      <- .func
  sma_align    <- stringr::str_to_lower(as.character(.align))
  sma_partial  <- as.logical(.partial)

  # * Checks ----
  if(!sma_align %in% c("center","left","right")){
    rlang::abort(
      message = "'.align' must be either 'center','left', or 'right'",
      use_cli_format = TRUE
    )
  }

  if(!is.numeric(sma_vec)){
    rlang::abort(
      message = "'.sma_order' must be all numeric values, c(1,2,3,...)",
      use_cli_format = TRUE
    )
  }

  if(!is.logical(sma_partial)){
    rlang::abort(
      message = "'.partial' must be a logical value.",
      use_cli_format = TRUE
    )
  }

  if(!is.data.frame(.data)){
    rlang::abort(
      message = "'.data' must be a data.frame/tibble.",
      use_cli_format = TRUE
    )
  }

  if(rlang::quo_is_missing(date_col_var_expr)){
    rlang::abort(
      message = "'.date_col' must be supplied.",
      use_cli_format = TRUE
    )
  }

  if(rlang::quo_is_missing(value_col_var_expr)){
    rlang::abort(
      message = "'.value_col' must be supplied.",
      use_cli_format = TRUE
    )
  }

  # Get data object
  ts_tbl <- dplyr::as_tibble(.data)

  # * Loop through periods ----
  df <- data.frame(matrix(ncol = 0, nrow = 0))
  for(i in sma_vec){
    ret_tmp <- ts_tbl %>%
      dplyr::mutate(sma_order = as.factor(i)) %>%
      dplyr::mutate(sma_value = timetk::slidify_vec(
        .x       = {{ value_col_var_expr }},
        .f       = sma_fun,
        .period  = i,
        .align   = sma_align,
        .partial = sma_partial
      ))

    df <- base::rbind(df, ret_tmp)
  }

  date_col_exists <- "date_col" %in% base::names(df)

  # * Plots ----
  g <- df %>%
    ggplot2::ggplot(
      ggplot2::aes(
        x = {{ date_col_var_expr }},
        y = {{ value_col_var_expr }},
        group = sma_order,
        color = sma_order
      )
    ) +
    ggplot2::geom_line(color = "black") +
    ggplot2::geom_line(
      data = df,
      ggplot2::aes(y = sma_value)
    ) +
    ggplot2::labs(
      x = "Time",
      y = "Value",
      title = paste0("SMA Plot"),
      subtitle = "Black line is original values.",
      color = "SMA Order"
    ) +
    ggplot2::theme_minimal()

  i_plot <- plotly::ggplotly(g)

  # * Return ----
  output <- list(
    data = df,
    plots = list(
      static_plot      = g,
      interactive_plot = i_plot
    )
  )

  return(output)

}