---
title: "Variogram with/out Death Carried Forward"
format:
html:
code-fold: true
code-tools: true
date: "2024-11-20"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(VGAM)
library(Hmisc)
library(rms)
library(plotly)
library(corrr)
```
```{r message=FALSE, warning=FALSE}
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)
```