Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Simple Moving Average plot ts_sma_plot #96

Closed
spsanderson opened this issue Sep 27, 2021 · 1 comment
Closed

Simple Moving Average plot ts_sma_plot #96

spsanderson opened this issue Sep 27, 2021 · 1 comment
Assignees
Labels

Comments

@spsanderson
Copy link
Owner

A plotting function ts_sma_plot gets a simple moving average of a provided order and plots it against the original data. This function should also allow for plotting multiple moving averages and should return a plotly::ggplotly if the parameter .interactive is set to TRUE

library(healthyR.data)
library(dplyr)
library(timetk)


data_tbl <- healthyR_data%>%
    filter(ip_op_flag == 'I') %>%
    summarise_by_time(
        .date_var = visit_end_date_time,
        .by = "month",
        value = n()
    ) %>%
    filter_by_time(
        .date_var = visit_end_date_time,
        .start_date = "2015",
        .end_date = "2019"
    ) %>%
    rename(date_col = visit_end_date_time)

ts_sma_plot(.date_var = date_col, .value_col = value, .sma_order = 4, .multiple_sma = FALSE, .interactve = FALSE)
ts_sma_plot(.date_var = date_col, .value_col = value, .sma_order = 4, .multiple_sma = TRUE, .interactive = TRUE)
@spsanderson spsanderson added this to the 0.1.4 milestone Sep 27, 2021
@spsanderson spsanderson self-assigned this Sep 27, 2021
spsanderson added a commit that referenced this issue Sep 27, 2021
@spsanderson
Copy link
Owner Author

library(timetk)
library(dplyr)

ts_sma_plot <- function(.data, .sma_order, .func = mean, .align = "center", 
                        .partial = FALSE, .multi_plot = FALSE,
                        .interactive = FALSE) {
  
  # * Tidyeval ----
  # 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)
  multi_plot   <- as.logical(.multi_plot)
  interactive  <- as.logical(.interactive)
  
  # * Checks ----
  if(!sma_align %in% c("center","left","right")){
    stop(call. = FALSE, "(.align) must be either 'center','left', or 'right'")
  }
  
  if(!is.numeric(sma_vec)){
    stop(call. = FALSE, "(.sma_order) must be all numeric values, c(1,2,3,...)")
  }
  
  if(!is.logical(sma_partial) & !is.logical(multi_plot) & !is.logical(interactive)){
    stop(call. = FLASE, "(.partial) (.multi_plot) and (.interactive) must all be logical values.")
  }
  
  # Get data object
  ts_obj <- .data
  
  # Get data and try to coerce to tibble
  # We do this because we use timetk::slidify_vec
  if(stats::is.ts(ts_obj) | stats::is.mts(ts_obj) | xts::is.xts(ts_obj) | zoo::is.zoo(ts_obj)){
    message("Attempting to coerce to a tibble.")
    ts_tbl <- timetk::tk_tbl(ts_obj) # change to internal ts_to_tbl() func
  } else {
    ts_tbl <- ts_obj
  }
  
  # * Loop through periods ----
  df <- data.frame(matrix(ncol = 0, nrow = 0))
  for(i in sma_vec){
    ret_tmp <- ts_tbl %>%
      dplyr::mutate(sma_order = i) %>%
      dplyr::mutate(sma_value = timetk::slidify_vec(
        .x       = value,
        .f       = sma_fun,
        .period  = i,
        .align   = sma_align,
        .partial = sma_partial
      ))
    
    df <- base::rbind(df, ret_tmp)
  }
  
  # * Plots ----
  
  # * Return ----
  return(df)
  
}

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
Projects
None yet
Development

No branches or pull requests

1 participant