GLM fit (logistic regression) to SQL

我们两清 提交于 2019-12-07 13:56:18

问题


We frequently score data in database directly for simple models like linear or logisitc regression. It is always a little bit tricky to transfer all coefficients from R to SQL correctly. I thought I can make some R to SQL translation for glm result. For numeric variables this is pretty straightforward:

library(rpart)

fit <- glm(Kyphosis ~ ., data = kyphosis, family = binomial())

coefs <- fit$coef[2:length(fit$coef)]
expr <- paste0('1/(1 + exp(-(',fit$coef[1], '+', paste0('(', 
               coefs, '*', names(coefs), ')', collapse = '+'),')))')

print(expr)

a <- with(kyphosis, eval(parse(text = expr)))
b <- predict(fit, kyphosis, type = 'response')
names(b) <- NULL
all.equal(a, b)

The generated expr is: 1/(1 + exp(-(-2.03693352129613+(0.0109304821420485*Age)+(0.410601186932733*Number)+(-0.206510049753697*Start)))).

Is there a way how to make this work for factor variables? I would like to put factors in case ... when ... then ... end clause. Suppose we have the following model:

kyphosis$factor_variable <- rep(LETTERS[1:5],20)[1:81]
fit <- glm(Kyphosis ~ ., data = kyphosis, family = binomial())

I am browsing through structure of fit, but do not see anything useful. Is the only option to parse names(fit$coef)?


回答1:


Hope this function helps. Wrote it today and haven't tested all corners - so use with care :)

glm_to_sql <- function(glmmodel) {
  xlev <- data.frame(unlist(glmmodel$xlevels))
  xlev$xlevrowname <- rownames(xlev)
  rownames(xlev) <- NULL
  colnames(xlev)[1] <- "xlevel"
  if (nrow(xlev)==0){xlev <- data.frame(xlevrowname=character(0), xlevel=character(0), stringsAsFactors=F)}

  modcoeffs <- data.frame(unlist(glmmodel$coefficients))
  modcoeffs$coeffname <- rownames(modcoeffs)
  rownames(modcoeffs) <- NULL
  colnames(modcoeffs)[1] <- "coeffvalue"

  coeffmatrix <- sqldf("select a.*,b.*,'' as sqlstr, 
                       substr(coeffname,1,instr(coeffname, xlevel)-1) as varname 
                       from modcoeffs a left join xlev b on coeffname like '%' || xlevel and xlevrowname like substr(coeffname,1,instr(coeffname, xlevel)-1) || '%'")

  for (i in 1:nrow(coeffmatrix)) {
    if(coeffmatrix$coeffname[i] == "(Intercept)") 
    {
      coeffmatrix$sqlstr[i] <- coeffmatrix$coeffvalue[i]
    } else if (is.na(coeffmatrix$xlevel[i]) ) {    
      coeffmatrix$sqlstr[i] <- paste("(",coeffmatrix$coeffvalue[i],"*",coeffmatrix$coeffname[i],")")
    } else {
      coeffmatrix$sqlstr[i] <- paste("(case when ",coeffmatrix$varname[i],"='",coeffmatrix$xlevel[i], "' THEN ",coeffmatrix$coeffvalue[i]," ELSE 0 END)",sep="")
    }

    if (i==1){x.sql0 <- coeffmatrix$sqlstr[i]} else {x.sql0 <- paste(x.sql0,"+",coeffmatrix$sqlstr[i])}
  }

  if (glmmodel$family$link == "logit") {
    x.sql <- paste("1/(1 + exp(-(",x.sql0,")))")  
  } else if (glmmodel$family$link == "identity") {
    x.sql <- x.sql0
  }

  return(x.sql)
}


来源:https://stackoverflow.com/questions/28698395/glm-fit-logistic-regression-to-sql

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!