riskr
riskr copied to clipboard
function to get scaled scores
get_mm <- function(data, mod, a = 20/log(2), b = 600 - a*log(20)) {
# data <- df
# mod <- modfagbc
cf <- as.vector(coefficients(mod))
b0 <- cf[1]
data$bm <- 1
mm <- model.matrix(formula(mod), data = data)
for(i in seq(nrow(df))){
mm[i, ] <- mm[i, ] * cf
}
mm <- as.matrix(mm)
mm <- as.data.frame(mm)
mm <- tbl_df(mm)
#### Puntos bases
nbase <- 0
vars <- as.character(attr(mod$terms, "predvars"))[ -c(1,2)]
k <- length(vars)
mmf <- data_frame(x = rep(0, nrow(mm)))
for(v in vars) {
# v <- sample(vars, 1)
mm2 <- mm[, str_detect(names(mm), v)]
mmf[[v]] <- rowSums(mm2)
}
mmf$x <- NULL
# table(nbase)
mmf <- floor(a * mmf) + floor( (b + a * b0)/k )
mmf <- tbl_df(mmf)
names(mmf) <- paste0(names(mmf), "_b")
mmf$score <- rowSums(mmf)
mmf