making function more universal

This commit is contained in:
agdamsbo 2018-10-04 09:23:14 +02:00
parent c450d88dff
commit e177156660
2 changed files with 58 additions and 52 deletions

View File

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

View File

@ -4,15 +4,17 @@
\alias{rep_glm} \alias{rep_glm}
\title{A repeated logistic regression function} \title{A repeated logistic regression function}
\usage{ \usage{
rep_glm(y, v1, string, ci = FALSE, data, v2 = NULL, v3 = NULL) rep_glm(y, vars, string, ci = FALSE, data)
} }
\arguments{ \arguments{
\item{y}{Effect meassure.} \item{y}{Effect meassure.}
\item{v1}{Main variable in model} \item{vars}{variables in model. Input as c() of columnnames, use dput().}
\item{string}{variables to test. Input as c() of columnnames, use dput().}
} }
\description{ \description{
For bivariate analyses. 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.
} }
\examples{ \examples{
rep_glm() rep_glm()