mirror of
https://github.com/agdamsbo/daDoctoR.git
synced 2024-11-22 11:50:23 +01:00
fix?
This commit is contained in:
parent
c17b8add39
commit
2208858821
@ -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)
|
||||||
}
|
}
|
||||||
|
@ -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)
|
||||||
}
|
}
|
||||||
|
62
R/rep_glm.R
62
R/rep_glm.R
@ -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)
|
||||||
}
|
}
|
||||||
|
60
R/rep_lm.R
60
R/rep_lm.R
@ -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)
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user