Variogram with/out Death Carried Forward

Published

November 20, 2024

Code
prepare_data <- function(data, carry_forward = FALSE) {
  processed_data <- data |> 
    select(id, time, y) |> 
    mutate(
      y = case_when(
        y == "Home" ~ 1,
        y == "In Hospital/Facility" ~ 2,
        y == "Vent/ARDS" ~ 3,
        y == "Dead" ~ 4
      )
    ) |> 
    pivot_wider(
      names_from = time,
      values_from = y
    ) |> 
    select(-id)
  
  if (carry_forward) {
    processed_data[is.na(processed_data)] <- 4
  }
  
  return(processed_data)
}

calculate_spearman_correlation <- function(data) {
  data |> 
    correlate(method = 'spearman') |> 
    pivot_longer(
      cols = c(-term),
      names_to = "time_horizon",
      values_to = "r_spearman"
    ) |> 
    mutate(
      decision_point = as.numeric(term),
      time_horizon = as.numeric(time_horizon)
    ) |> 
    filter(decision_point < time_horizon) |> 
    mutate( 
      gap = time_horizon - decision_point,
      correlation_text = glue::glue(
        "{decision_point} vs. {time_horizon}\nr = {round(r_spearman, digits = 3)}"
      )
    )
}

plot_correlation <- function(correlation_data) {
  plot_ly(
    correlation_data,
    x = ~gap,
    y = ~r_spearman,
    color = ~death_carried_forward,
    text = ~correlation_text,
    hoverinfo = 'text',
    mode = 'markers'
  ) |> 
    layout(
      title = "Spearman Correlation Analysis",
      xaxis = list(title = "Time Gap"),
      yaxis = list(title = "Spearman Correlation")
    )
}

getHdata(simlongord500)

correlation_results <- bind_rows(
  calculate_spearman_correlation(prepare_data(simlongord500, carry_forward = FALSE)) |> 
    mutate(death_carried_forward = FALSE),
  calculate_spearman_correlation(prepare_data(simlongord500, carry_forward = TRUE)) |> 
    mutate(death_carried_forward = TRUE)
)

plot_correlation(correlation_results)