riskr icon indicating copy to clipboard operation
riskr copied to clipboard

function to get scaled scores

Open jbkunst opened this issue 9 years ago • 0 comments

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

jbkunst avatar Aug 17 '16 03:08 jbkunst