#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
#  These scripts were used in the simulation study. To run these scripts a 
#  number of objects need to be loaded into R. 
#  - dev_set_logistic : A list containing the development sets of the model to be
#                       extended (based on a logistic regression models).
#  - ext_set_logistic : A list containing the extension sets of the model to be
#                       extended (based on a logistic regression models).
#  - val_set_logistic : A list containing the validation sets of the different
#                       scenarios. (based on logistic regression models)
#  - dev_set_LR       : A list containing the development sets of the model to be
#                       extended (based on a LR models).
#  - ext_set_LR       : A list containing the extension sets of the model to be
#                       extended (based on a LR models).
#  - val_set_LR       : A list containing the validation sets of the different
#                       scenarios. (based on LR models).
#  Functions from the other uploaded appendix are also needed
#  Results with logistic regression as generating model  ----
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
rm(list = ls())

set.seed(5)
# Load required R packages
library(rms)
library(mice)

n_scenario <- 3
n_sim      <- 1000

method   <- c('Original model', 'Model revision', 
              'Model revision with shrinkage', 'Recalibration and extension', 
              'LR', 'LR simple', 'Imputation')
dimnames <- list(model = c('logistic', 'LR'), scenario = 1:n_scenario, 
                 method = method, simulation = 1:n_sim)
slope    <- array(dim = c(2, n_scenario, length(method), n_sim), 
                  dimnames = dimnames)
auc      <- array(dim = c(2, n_scenario, length(method), n_sim), 
                  dimnames = dimnames)

prior_vars <- c('lg2tpsa', 'lg2vol', 'DRE')
new_vars   <- c('lg2tpsa', 'lg2vol', 'DRE', 'lg2phi')
for(i in 1:n_scenario){
  cat(i)
  # Results from datasets based on logistic regression models
  val_set <- as.data.frame(val_set_logistic[[i]])
  for(j in 1:n_sim){
    dev_set <- as.data.frame(dev_set_logistic[[i]][j, , ])     
    ext_set <- as.data.frame(ext_set_logistic[[i]][j, , ])
    
    # 1. Original model
    fit0       <- lrm(cancer ~ lg2tpsa + lg2vol + DRE, data = dev_set)
    val_set$lp <- predict(fit0, newdata = val_set)
    fit_val    <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[1, i, 'Original model', j] <- fit_val$coefficients[2]
    auc[1, i, 'Original model', j]   <- fit_val$stats['C']
    
    # 2. Model revision
    fit        <- lrm(cancer ~ lg2tpsa + lg2vol + DRE + lg2phi, data = ext_set)
    val_set$lp <- predict(fit, newdata = val_set)
    fit_val    <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[1, i, 'Model revision', j] <- fit_val$coefficients[2]
    auc[1, i, 'Model revision', j]   <- fit_val$stats['C']
    
    # 3. Model revision with shrinkage
    coefs_shrink <- model_shrink(coefs = c(fit0$coefficients, 0), 
                                 data = ext_set, vars = new_vars, 
                                 outcome = 'cancer')
    val_set$lp <- as.matrix(cbind(1, val_set[, new_vars])) %*% coefs_shrink
    fit_val    <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[1, i, 'Model revision with shrinkage', j] <- fit_val$coefficients[2]
    auc[1, i, 'Model revision with shrinkage', j]   <- fit_val$stats['C']
    
    # 4. Recalibration with extension
    ext_set$lp_prior <- (as.matrix(ext_set[, prior_vars]) %*% 
                           fit0$coefficients[-1])
    fit              <- lrm(cancer ~ lp_prior + lg2phi, data = ext_set)
    val_set$lp_prior <- (as.matrix(val_set[, prior_vars]) %*% 
                           fit0$coefficients[-1])
    val_set$lp       <- predict(fit, newdata = val_set)
    fit_val          <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[1, i, 'Recalibration and extension', j] <- fit_val$coefficients[2]
    auc[1, i, 'Recalibration and extension', j]   <- fit_val$stats['C']
    
    # 5. LR
    fit        <- fit_LR(fit0$coefficients, ext_set, prior_vars, 'lg2phi', 
                         'cancer')
    val_set$lp           <- predict_LR(fit, val_set, 'lg2phi', prior_vars)
    fit_val              <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[1, i, 'LR', j] <- fit_val$coefficients[2]
    auc[1, i, 'LR', j]   <- fit_val$stats['C']
    
    # 6. LR simple
    fit <- fit_LR_simple(fit0$coefficients, ext_set, prior_vars, 'lg2phi', 
                         'cancer')
    val_set$lp <- predict_LR_simple(fit, val_set, 'lg2phi', prior_vars)
    fit_val              <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[1, i, 'LR simple', j] <- fit_val$coefficients[2]
    auc[1, i, 'LR simple', j]   <- fit_val$stats['C']
    
    # 7. Imputation
    combined <- rbind(dev_set[, c('cancer', new_vars)], ext_set[ c('cancer', 
                                                                   new_vars)])
    imp_set  <- mice(combined, m = 10, print = FALSE)
    fit      <- fit.mult.impute(cancer ~ lg2tpsa + lg2vol + DRE + lg2phi, 
                                xtrans = imp_set, data = imp_set$data, 
                                fitter = lrm)
    val_set$lp <- predict(fit, newdata = val_set)
    fit_val    <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[1, i, 'Imputation', j] <- fit_val$coefficients[2]
    auc[1, i, 'Imputation', j]   <- fit_val$stats['C']
  }
}

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
#  Results with LR as generating model ----
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
for(i in 1:n_scenario){
  cat(i)
  # Results from datasets based on logistic regression models
  val_set <- as.data.frame(val_set_LR[[i]][1, , ])
  for(j in 1:n_sim){
    dev_set <- as.data.frame(dev_set_LR[[i]][j, , ])     
    ext_set <- as.data.frame(ext_set_LR[[i]][j, , ])
    
    # 1. Original model
    fit0       <- lrm(cancer ~ lg2tpsa + lg2vol + DRE, data = dev_set)
    val_set$lp <- predict(fit0, newdata = val_set)
    fit_val    <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[2, i, 'Original model', j] <- fit_val$coefficients[2]
    auc[2, i, 'Original model', j]   <- fit_val$stats['C']
    
    # 2. Model revision
    fit        <- lrm(cancer ~ lg2tpsa + lg2vol + DRE + lg2phi, data = ext_set)
    val_set$lp <- predict(fit, newdata = val_set)
    fit_val    <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[2, i, 'Model revision', j] <- fit_val$coefficients[2]
    auc[2, i, 'Model revision', j]   <- fit_val$stats['C']
    
    # 3. Model revision with shrinkage
    coefs_shrink <- model_shrink(coefs = c(fit0$coefficients, 0), 
                                 data = ext_set, vars = new_vars, 
                                 outcome = 'cancer')
    val_set$lp <- as.matrix(cbind(1, val_set[, new_vars])) %*% coefs_shrink
    fit_val    <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[2, i, 'Model revision with shrinkage', j] <- fit_val$coefficients[2]
    auc[2, i, 'Model revision with shrinkage', j]   <- fit_val$stats['C']
    
    # 4. Recalibration with extension
    ext_set$lp_prior <- (as.matrix(ext_set[, prior_vars]) %*% 
                           fit0$coefficients[-1])
    fit              <- lrm(cancer ~ lp_prior + lg2phi, data = ext_set)
    val_set$lp_prior <- (as.matrix(val_set[, prior_vars]) %*% 
                           fit0$coefficients[-1])
    val_set$lp       <- predict(fit, newdata = val_set)
    fit_val          <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[2, i, 'Recalibration and extension', j] <- fit_val$coefficients[2]
    auc[2, i, 'Recalibration and extension', j]   <- fit_val$stats['C']
    
    # 5. LR
    fit        <- fit_LR(fit0$coefficients, ext_set, prior_vars, 'lg2phi', 
                         'cancer')
    val_set$lp           <- predict_LR(fit, val_set, 'lg2phi', prior_vars)
    fit_val              <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[2, i, 'LR', j] <- fit_val$coefficients[2]
    auc[2, i, 'LR', j]   <- fit_val$stats['C']
    
    # 6. LR simple
    fit <- fit_LR_simple(fit0$coefficients, ext_set, prior_vars, 'lg2phi', 
                         'cancer')
    val_set$lp <- predict_LR_simple(fit, val_set, 'lg2phi', prior_vars)
    fit_val              <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[2, i, 'LR simple', j] <- fit_val$coefficients[2]
    auc[2, i, 'LR simple', j]   <- fit_val$stats['C']
    
    # 7. Imputation
    combined <- rbind(dev_set[, c('cancer', new_vars)], ext_set[ c('cancer', 
                                                                   new_vars)])
    imp_set  <- mice(combined, m = 10, print = FALSE)
    fit      <- fit.mult.impute(cancer ~ lg2tpsa + lg2vol + DRE + lg2phi, 
                                xtrans = imp_set, data = imp_set$data, 
                                fitter = lrm)
    val_set$lp <- predict(fit, newdata = val_set)
    fit_val    <- lrm(cancer ~ lp, data = val_set, maxit = 100)
    slope[2, i, 'Imputation', j] <- fit_val$coefficients[2]
    auc[2, i, 'Imputation', j]   <- fit_val$stats['C']
  }
}