adding p-vals to _byvar

This commit is contained in:
agdamsbo 2019-02-03 12:48:32 +01:00
parent 0819d48953
commit e5392893f9
2 changed files with 105 additions and 78 deletions

View File

@ -1,7 +1,7 @@
Package: daDoctoR Package: daDoctoR
Type: Package Type: Package
Title: FUNCTIONS FOR HEALTH RESEARCH Title: FUNCTIONS FOR HEALTH RESEARCH
Version: 0.1.0.9020 Version: 0.1.0.9021
Author@R: c(person("Andreas", "Gammelgaard Damsbo", email = "agdamsbo@pm.me", role = c("cre", "aut"))) Author@R: c(person("Andreas", "Gammelgaard Damsbo", email = "agdamsbo@pm.me", role = c("cre", "aut")))
Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@pm.me> Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>
Description: I am a Danish medical doctor involved in neuropsychiatric research. Description: I am a Danish medical doctor involved in neuropsychiatric research.

View File

@ -1,6 +1,6 @@
#' Print regression results according to STROBE #' Print regression results according to STROBE
#' #'
#' Printable table of three dimensional regression analysis of group vs var for meas. By var. #' Printable table of three dimensional regression analysis of group vs var for meas. By var. Includes p-values.
#' @param meas outcome meassure variable name in data-data.frame as a string. Can be numeric or factor. Result is calculated accordingly. #' @param meas outcome meassure variable name in data-data.frame as a string. Can be numeric or factor. Result is calculated accordingly.
#' @param var binary exposure variable to compare against (active vs placebo). As string. #' @param var binary exposure variable to compare against (active vs placebo). As string.
#' @param groups groups to compare, as string. #' @param groups groups to compare, as string.
@ -13,100 +13,127 @@
#' strobe_diff_byvar() #' strobe_diff_byvar()
strobe_diff_byvar<-function(meas,var,group,adj,data,dec=2){ strobe_diff_byvar<-function(meas,var,group,adj,data,dec=2){
## Wishlist:
## -fix confint()
## meas: sdmt ## meas: sdmt
## var: rtreat ## var: rtreat
## group: genotype ## group: genotype
## for dichotome exposure variable (var) ## for dichotome exposure variable (var)
d<-data d <- data
m<-d[,c(meas)] m <- d[, c(meas)]
v<-d[,c(var)] v <- d[, c(var)]
g<-d[,c(group)] g <- d[, c(group)]
ads <- d[, c(adj)]
dat <- data.frame(m, v, g, ads)
df <- data.frame(grp = c(NA, as.character(levels(g))))
if (!is.factor(m)) {
for (i in 1:length(levels(v))) {
grp <- levels(dat$v)[i]
di <- dat[dat$v == grp, ][, -2]
mod <- lm(m ~ g, data = di)
ads<-d[,c(adj)] p <- coef(summary(mod))[2:length(levels(g)),4]
p<-ifelse(p<0.001,"<0.001",round(p,3))
p <- ifelse(p<=0.05|p=="<0.001",paste0("*",p),
ifelse(p>0.05&p<=0.1,paste0(".",p),p))
pv<-c("-",p)
dat<-data.frame(m,v,g,ads) co <- c("-", round(coef(mod)[-1], dec))
ci<-round(confint(mod),dec)[2:length(levels(g)),]
lo <- c("-", ci[,1])
up <- c("-", ci[,2])
ci <- paste0(co, " (", lo, " to ", up, ")")
df<-data.frame(grp=c(NA,as.character(levels(g)))) amod <- lm(m ~ ., data = di)
if(!is.factor(m)){ pa <- coef(summary(amod))[2:length(levels(g)),4]
pa<-ifelse(pa<0.001,"<0.001",round(pa,3))
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
apv<-c("-",pa)
for (i in 1:length(levels(v))){ aco <- c("-", round(coef(amod)[2:length(levels(g))],
grp<-levels(dat$v)[i] dec))
di<-dat[dat$v==grp,][,-2] aci<-round(confint(amod),dec)[2:length(levels(g)),]
alo <- c("-", aci[,1])
mod<-lm(m~g,data=di) aup <- c("-", aci[,2])
co<-c("-",round(coef(mod)[-1],dec)) aci <- paste0(aco, " (", alo, " to ", aup, ")")
lo<-c("-",round(confint(mod)[-1,1],dec)) nr <- c()
up<-c("-",round(confint(mod)[-1,2],dec)) for (r in 1:length(levels(g))) {
vr <- levels(di$g)[r]
ci<-paste0(co," (",lo," to ",up,")") dr <- di[di$g == vr, ]
n <- as.numeric(nrow(dr[!is.na(dr$m), ]))
amod<-lm(m~.,data=di) mean <- round(mean(dr$m, na.rm = TRUE), dec -
aco<-c("-",round(coef(amod)[2:length(levels(g))],dec)) 1)
alo<-c("-",round(confint(amod)[2:length(levels(g)),1],dec)) sd <- round(sd(dr$m, na.rm = TRUE), dec - 1)
aup<-c("-",round(confint(amod)[2:length(levels(g)),2],dec)) ms <- paste0(mean, " (", sd, ")")
nr <- c(nr, n, ms)
aci<-paste0(aco," (",alo," to ",aup,")")
nr<-c()
for (r in 1:length(levels(g))){
vr<-levels(di$g)[r]
dr<-di[di$g==vr,]
n<-as.numeric(nrow(dr[!is.na(dr$m),]))
mean<-round(mean(dr$m,na.rm = TRUE),dec-1)
sd<-round(sd(dr$m,na.rm = TRUE),dec-1)
ms<-paste0(mean," (",sd,")")
nr<-c(nr,n,ms)
} }
irl<-rbind(matrix(grp,ncol=4),cbind(matrix(nr,ncol=2,byrow = TRUE),cbind(ci,aci))) irl <- rbind(matrix(grp, ncol = 6), cbind(matrix(nr,
colnames(irl)<-c("N","Mean (SD)","Difference","Adjusted Difference") ncol = 2, byrow = TRUE), cbind(ci,pv, aci,apv)))
df<-cbind(df,irl) colnames(irl) <- c("N",
}} "Mean (SD)",
"Difference",
if(is.factor(m)){ "p-value",
"Adjusted Difference",
for (i in 1:length(levels(v))){ "Adjusted p-value")
grp<-levels(dat$v)[i] df <- cbind(df, irl)
di<-dat[dat$v==grp,][,-2]
mod<-glm(m~g,family=binomial(),data=di)
co<-c("-",round(exp(coef(mod)[-1]),dec))
lo<-c("-",round(exp(confint(mod)[-1,1]),dec))
up<-c("-",round(exp(confint(mod)[-1,2]),dec))
ci<-paste0(co," (",lo," to ",up,")")
amod<-glm(m~.,family=binomial(),data=di)
aco<-c("-",suppressMessages(round(exp(coef(amod)[2:length(levels(g))]),dec)))
alo<-c("-",suppressMessages(round(exp(confint(amod)[2:length(levels(g)),1]),dec)))
aup<-c("-",suppressMessages(round(exp(confint(amod)[2:length(levels(g)),2]),dec)))
aci<-paste0(aco," (",alo," to ",aup,")")
nr<-c()
for (r in 1:length(levels(g))){
vr<-levels(di$g)[r]
dr<-di[di$g==vr,]
n<-as.numeric(nrow(dr[!is.na(dr$m),]))
nl<-levels(m)[2]
out<-nrow(dr[dr$m==nl&!is.na(dr$m),])
pro<-round(out/n*100,0)
rt<-paste0(out," (",pro,"%)")
nr<-c(nr,n,rt)
} }
irl<-rbind(matrix(grp,ncol=4),cbind(matrix(nr,ncol=2,byrow = TRUE),cbind(ci,aci))) }
colnames(irl)<-c("N",paste0("N.",nl),"OR","Adjusted OR") if (is.factor(m)) {
df<-cbind(df,irl) for (i in 1:length(levels(v))) {
}} grp <- levels(dat$v)[i]
di <- dat[dat$v == grp, ][, -2]
mod <- glm(m ~ g, family = binomial(), data = di)
p <- coef(summary(mod))[2:length(levels(g)),4]
p<-ifelse(p<0.001,"<0.001",round(p,3))
p <- ifelse(p<=0.05|p=="<0.001",paste0("*",p),
ifelse(p>0.05&p<=0.1,paste0(".",p),p))
pv<-c("-",p)
co <- c("-", round(exp(coef(mod)[-1]), dec))
ci <- suppressMessages(round(exp(confint(mod)),dec))[2:length(levels(g)),]
lo <- c("-", ci[,1])
up <- c("-", ci[,2])
ci <- paste0(co, " (", lo, " to ", up, ")")
amod <- glm(m ~ ., family = binomial(), data = di)
pa <- coef(summary(amod))[2:length(levels(g)),4]
pa<-ifelse(pa<0.001,"<0.001",round(pa,3))
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
apv<-c("-",pa)
aco <- c("-", suppressMessages(round(exp(coef(amod)[2:length(levels(g))]),
dec)))
aci <- suppressMessages(round(exp(confint(mod)),dec)[2:length(levels(g)),])
alo <- c("-", aci[,1])
aup <- c("-", aci[,2])
aci <- paste0(aco, " (", alo, " to ", aup, ")")
nr <- c()
for (r in 1:length(levels(g))) {
vr <- levels(di$g)[r]
dr <- di[di$g == vr, ]
n <- as.numeric(nrow(dr[!is.na(dr$m), ]))
nl <- levels(m)[2]
out <- nrow(dr[dr$m == nl & !is.na(dr$m), ])
pro <- round(out/n * 100, 0)
rt <- paste0(out, " (", pro, "%)")
nr <- c(nr, n, rt)
}
irl <- rbind(matrix(grp, ncol = 4), cbind(matrix(nr,
ncol = 2, byrow = TRUE), cbind(ci,pv, aci,apv)))
colnames(irl) <- c("N",
paste0("N.", nl),
"OR",
"p-value",
"Adjusted OR",
"Adjusted p-value")
df <- cbind(df, irl)
}
}
return(df) return(df)
} }