daDoctoR/R/rep_glm.R

96 lines
2.3 KiB
R
Raw Normal View History

2018-10-03 10:32:10 +02:00
#' A repeated logistic regression function
2018-10-02 21:07:43 +02:00
#'
2018-10-04 09:23:14 +02:00
#' @description For bivariate analyses. The confint() function is rather slow, causing the whole function to hang when including many predictors and calculating the ORs with CI.
2018-10-02 21:07:43 +02:00
#' @param y Effect meassure.
2018-10-04 09:23:14 +02:00
#' @param vars variables in model. Input as c() of columnnames, use dput().
#' @param string variables to test. Input as c() of columnnames, use dput().
2018-10-02 21:07:43 +02:00
#' @keywords logistic regression
#' @export
#' @examples
#' rep_glm()
2018-10-04 09:23:14 +02:00
rep_glm<-function(y,vars,string,ci=FALSE,data){
## x is data.frame of predictors, y is vector of an aoutcome as a factor
## output is returned as coefficient, or if or=TRUE as OR with 95 % CI.
##
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
require(dplyr)
2018-10-03 10:32:10 +02:00
2018-10-02 21:07:43 +02:00
d<-data
x<-select(d,one_of(c(string)))
2018-10-04 09:23:14 +02:00
v<-select(d,one_of(c(vars)))
dt<-cbind(y,v)
m1<-length(coef(glm(y~.,family = binomial(),data = dt)))
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
if (!is.factor(y)){stop("Some kind of error message would be nice, but y should be a factor!")}
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
if (ci==TRUE){
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
df<-data.frame(matrix(ncol = 3))
names(df)<-c("pred","or_ci","pv")
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
for(i in 1:ncol(x)){
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
dat<-cbind(dt,x[,i])
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
m<-glm(y~.,family = binomial(),data=dat)
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
l<-suppressMessages(round(exp(confint(m))[-c(1:m1),1],2))
u<-suppressMessages(round(exp(confint(m))[-c(1:m1),2],2))
or<-round(exp(coef(m))[-c(1:m1)],2)
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
or_ci<-paste0(or," (",l," to ",u,")")
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
2018-10-02 21:07:43 +02:00
2018-10-04 09:23:14 +02:00
x1<-x[,i]
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
}
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
else {pred<-names(x)[i]}
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
df<-rbind(df,cbind(pred,or_ci,pv))
2018-10-03 10:32:10 +02:00
2018-10-02 21:07:43 +02:00
}}
2018-10-03 10:32:10 +02:00
2018-10-02 21:07:43 +02:00
if (ci==FALSE){
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
df<-data.frame(matrix(ncol = 3))
names(df)<-c("pred","b","pv")
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-glm(y~.,family = binomial(),data=dat)
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
b<-round(coef(m)[-c(1:m1)],3)
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
x1<-x[,i]
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
if (is.factor(x1)){
pred<-paste(names(x1)[i],levels(x1)[-1],sep = "_")
}
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
else {pred<-names(x)[i]}
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
df<-rbind(df,cbind(pred,b,pv))
}}
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
pa<-as.numeric(df[,3])
pa<-ifelse(pa<0.001,"<0.001",pa)
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
t <- ifelse(pa<=0.1|pa=="<0.001","include","drop")
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
r<-data.frame(df[,1:2],pa,t)[-1,]
2018-10-03 10:32:10 +02:00
2018-10-04 09:23:14 +02:00
return(r)
2018-10-02 21:07:43 +02:00
}