## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(redeem) ## ----data--------------------------------------------------------------------- # Simulated continuous-duration interaction sequence n_nodes <- 10 events <- matrix(c( 1.0, 1, 2, 1, # Node 1 initiates tie with 2 1.5, 3, 4, 1, # Node 3 initiates tie with 4 2.0, 1, 2, 0, # Tie (1,2) concludes (duration 1.0) 2.8, 3, 4, 0, # Tie (3,4) concludes (duration 1.3) 3.5, 1, 3, 1, # Node 1 initiates tie with 3 4.0, 1, 3, 0 # Tie (1,3) concludes (duration 0.5) ), ncol = 4, byrow = TRUE) colnames(events) <- c("time", "from", "to", "type") ## ----fit---------------------------------------------------------------------- # Fit the Durational Event Model fit_dem <- dem( events = events, n_nodes = n_nodes, formula_0_1 = ~1, # Predictors for tie onset formula_1_0 = ~1, # Predictors for tie offset control = control.redeem(estimate = "Blockwise") ) # View summaries using `summary.redeem_result` summary(fit_dem) ## ----residuals---------------------------------------------------------------- # Extract residuals for diagnostics using `get_residuals()` # Note: Ensure return_data = TRUE was set in `control.redeem()` resids <- get_residuals(fit_dem) # Plot the Kaplan-Meier estimate of the residual survival vs. Theoretical Exp(1) plot(resids$time, resids$surv, type = "l", log = "y", xlab = "Cox-Snell Residuals", ylab = "Survival Probability", main = "Cox-Snell Residual Diagnostic" ) lines(resids$time, resids$theoretical, col = "red", lty = 2) legend("topright", legend = c("Empirical", "Theoretical Exp(1)"), col = c("black", "red"), lty = 1:2 )