This commit is contained in:
agdamsbo 2018-10-03 10:32:10 +02:00
parent c17b8add39
commit 2208858821
4 changed files with 63 additions and 63 deletions

View File

@ -160,6 +160,6 @@ df<-cbind(df,t)
t<-c(NA,ifelse(abs(e-as.numeric(df[-1,2]))>=(e*cut),"include","drop")) t<-c(NA,ifelse(abs(e-as.numeric(df[-1,2]))>=(e*cut),"include","drop"))
df<-cbind(df,t) df<-cbind(df,t)
}} }}
result<-df
return(df) return(df)
} }

View File

@ -34,5 +34,5 @@ if (me=="pval"&log==TRUE){
if (method=="cie"){ if (method=="cie"){
daDoctoR::cie_test(y=a,v1=b,string=s,data=dat,logistic=log,cut=ct) daDoctoR::cie_test(y=a,v1=b,string=s,data=dat,logistic=log,cut=ct)
} }
return(df) return(result)
} }

View File

@ -1,4 +1,4 @@
#' A repeated logistic regression function #' A repeated logistic regression function
#' #'
#' For bivariate analyses. #' For bivariate analyses.
#' @param y Effect meassure. #' @param y Effect meassure.
@ -12,80 +12,80 @@ rep_glm<-function(y,v1,string,ci=FALSE,data,v2=NULL,v3=NULL){
## 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. ## 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(broom)
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()))) m1<-length(coef(glm(y~v1,family = binomial())))
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 = 4))
names(df)<-c("pred","or_ci","pv","t") names(df)<-c("pred","or_ci","pv","t")
for(i in 1:ncol(x)){ for(i in 1:ncol(x)){
m<-glm(y~v1+x[,i],family = binomial()) m<-glm(y~v1+x[,i],family = binomial())
l<-suppressMessages(round(exp(confint(m))[-c(1:m1),1],2)) l<-suppressMessages(round(exp(confint(m))[-c(1:m1),1],2))
u<-suppressMessages(round(exp(confint(m))[-c(1:m1),2],2)) u<-suppressMessages(round(exp(confint(m))[-c(1:m1),2],2))
or<-round(exp(coef(m))[-c(1:m1)],2) or<-round(exp(coef(m))[-c(1:m1)],2)
or_ci<-paste0(or," (",l," to ",u,")") or_ci<-paste0(or," (",l," to ",u,")")
pv<-round(tidy(m)$p.value[-c(1:m1)],3) pv<-round(tidy(m)$p.value[-c(1:m1)],3)
pv<-ifelse(pv<0.001,"<0.001",pv) pv<-ifelse(pv<0.001,"<0.001",pv)
t <- ifelse(pv<=0.1|pv=="<0.001","include","drop") t <- ifelse(pv<=0.1|pv=="<0.001","include","drop")
pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv), pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv),
ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv)) ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv))
v<-x[,i] v<-x[,i]
if (is.factor(v)){ if (is.factor(v)){
pred<-paste(names(x)[i],levels(v)[-1],sep = "_") pred<-paste(names(x)[i],levels(v)[-1],sep = "_")
} }
else {pred<-names(x)[i]} else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,or_ci,pv,t)) 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 = 4))
names(df)<-c("pred","b","pv","t") names(df)<-c("pred","b","pv","t")
for(i in 1:ncol(x)){ for(i in 1:ncol(x)){
m<-glm(y~v1+x[,i],family = binomial()) m<-glm(y~v1+x[,i],family = binomial())
b<-round(coef(m)[-c(1:m1)],3) b<-round(coef(m)[-c(1:m1)],3)
pv<-round(tidy(m)$p.value[-c(1:m1)],3) pv<-round(tidy(m)$p.value[-c(1:m1)],3)
pv<-ifelse(pv<0.001,"<0.001",pv) pv<-ifelse(pv<0.001,"<0.001",pv)
t <- ifelse(pv<=0.1|pv=="<0.001","include","drop") t <- ifelse(pv<=0.1|pv=="<0.001","include","drop")
pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv), pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv),
ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv)) ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv))
v<-x[,i] v<-x[,i]
if (is.factor(v)){ if (is.factor(v)){
pred<-paste(names(x)[i],levels(v)[-1],sep = "_") pred<-paste(names(x)[i],levels(v)[-1],sep = "_")
} }
else {pred<-names(x)[i]} else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,b,pv,t)) df<-rbind(df,cbind(pred,b,pv,t))
}} }}
result<-df
return(df) return(df)
} }

View File

@ -1,4 +1,4 @@
#' A repeated linear regression function #' A repeated linear regression function
#' #'
#' For bivariate analyses. #' For bivariate analyses.
#' @param y Effect meassure. #' @param y Effect meassure.
@ -7,83 +7,83 @@
#' @export #' @export
#' @examples #' @examples
#' rep_lm() #' rep_lm()
rep_lm<-function(y,v1,string,ci=FALSE,data,v2=NULL,v3=NULL){ rep_lm<-function(y,v1,string,ci=FALSE,data,v2=NULL,v3=NULL){
## 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 ci=TRUE as coefficient with 95 % CI. ## output is returned as coefficient, or if ci=TRUE as coefficient 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. ## 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(broom)
d<-data d<-data
x<-select(d,one_of(c(string))) x<-select(d,one_of(c(string)))
m1<-length(coef(lm(y~v1))) m1<-length(coef(lm(y~v1)))
if (is.factor(y)){stop("Some kind of error message would be nice, but y should not be a factor!")} if (is.factor(y)){stop("Some kind of error message would be nice, but y should not be a factor!")}
if (ci==TRUE){ if (ci==TRUE){
df<-data.frame(matrix(ncol = 4)) df<-data.frame(matrix(ncol = 4))
names(df)<-c("pred","co_ci","pv","t") names(df)<-c("pred","co_ci","pv","t")
for(i in 1:ncol(x)){ for(i in 1:ncol(x)){
m<-lm(y~v1+x[,i]) m<-lm(y~v1+x[,i])
l<-suppressMessages(round(confint(m)[-c(1:m1),1],2)) l<-suppressMessages(round(confint(m)[-c(1:m1),1],2))
u<-suppressMessages(round(confint(m)[-c(1:m1),2],2)) u<-suppressMessages(round(confint(m)[-c(1:m1),2],2))
co<-round(coef(m)[-c(1:m1)],2) co<-round(coef(m)[-c(1:m1)],2)
co_ci<-paste0(co," (",l," to ",u,")") co_ci<-paste0(co," (",l," to ",u,")")
pv<-round(tidy(m)$p.value[-c(1:m1)],3) pv<-round(tidy(m)$p.value[-c(1:m1)],3)
pv<-ifelse(pv<0.001,"<0.001",pv) pv<-ifelse(pv<0.001,"<0.001",pv)
t <- ifelse(pv<=0.1|pv=="<0.001","include","drop") t <- ifelse(pv<=0.1|pv=="<0.001","include","drop")
pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv), pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv),
ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv)) ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv))
v<-x[,i] v<-x[,i]
if (is.factor(v)){ if (is.factor(v)){
pred<-paste(names(x)[i],levels(v)[-1],sep = "_") pred<-paste(names(x)[i],levels(v)[-1],sep = "_")
} }
else {pred<-names(x)[i]} else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,co_ci,pv,t)) df<-rbind(df,cbind(pred,co_ci,pv,t))
}} }}
if (ci==FALSE){ if (ci==FALSE){
df<-data.frame(matrix(ncol = 4)) df<-data.frame(matrix(ncol = 4))
names(df)<-c("pred","b","pv","t") names(df)<-c("pred","b","pv","t")
for(i in 1:ncol(x)){ for(i in 1:ncol(x)){
m<-lm(y~v1+x[,i]) m<-lm(y~v1+x[,i])
b<-round(coef(m)[-c(1:m1)],3) b<-round(coef(m)[-c(1:m1)],3)
pv<-round(tidy(m)$p.value[-c(1:m1)],3) pv<-round(tidy(m)$p.value[-c(1:m1)],3)
pv<-ifelse(pv<0.001,"<0.001",pv) pv<-ifelse(pv<0.001,"<0.001",pv)
t <- ifelse(pv<=0.1|pv=="<0.001","include","drop") t <- ifelse(pv<=0.1|pv=="<0.001","include","drop")
pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv), pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv),
ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv)) ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv))
v<-x[,i] v<-x[,i]
if (is.factor(v)){ if (is.factor(v)){
pred<-paste(names(x)[i],levels(v)[-1],sep = "_") pred<-paste(names(x)[i],levels(v)[-1],sep = "_")
} }
else {pred<-names(x)[i]} else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,b,pv,t)) df<-rbind(df,cbind(pred,b,pv,t))
}} }}
result<-df
return(df) return(df)
} }