mirror of
https://github.com/agdamsbo/daDoctoR.git
synced 2024-11-23 20:30:21 +01:00
new functions with new names to substitute old "strobe"-functions
This commit is contained in:
parent
96479031e5
commit
d8ffa3dc7b
@ -1,6 +1,6 @@
|
|||||||
Package: daDoctoR
|
Package: daDoctoR
|
||||||
Title: Functions For Health Research
|
Title: Functions For Health Research
|
||||||
Version: 0.21.4
|
Version: 0.21.5
|
||||||
Year: 2021
|
Year: 2021
|
||||||
Author: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>
|
Author: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>
|
||||||
Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>
|
Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>
|
||||||
|
148
R/print_diff_bygroup.R
Normal file
148
R/print_diff_bygroup.R
Normal file
@ -0,0 +1,148 @@
|
|||||||
|
#' REWRITE UNDERWAY
|
||||||
|
#'
|
||||||
|
#' Print regression results according to STROBE
|
||||||
|
#'
|
||||||
|
#' Printable table of two dimensional regression analysis of group vs variable for outcome measure. By group. Includes p-value
|
||||||
|
#' Group and variable has to be dichotomous factor.
|
||||||
|
#' @param meas outcome measure 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 group binary group to compare, as string.
|
||||||
|
#' @param adj variables to adjust for, as string.
|
||||||
|
#' @param data dataframe to subset from.
|
||||||
|
#' @param dec decimals for results, standard is set to 2. Mean and sd is dec-1. pval has 3 decimals.
|
||||||
|
#' @keywords strobe
|
||||||
|
#' @export
|
||||||
|
#' @examples
|
||||||
|
#' data('mtcars')
|
||||||
|
#' mtcars$vs<-factor(mtcars$vs)
|
||||||
|
#' mtcars$am<-factor(mtcars$am)
|
||||||
|
#' strobe_diff_bygroup(meas="mpg",var="vs",group = "am",adj=c("disp","wt"),data=mtcars)
|
||||||
|
|
||||||
|
strobe_diff_bygroup<-function(meas,var,group,adj,data,dec=2){
|
||||||
|
|
||||||
|
## meas: sdmt
|
||||||
|
## var: rtreat
|
||||||
|
## group: genotype
|
||||||
|
## for dichotome exposure variable (var)
|
||||||
|
|
||||||
|
d <- data
|
||||||
|
m <- d[, c(meas)]
|
||||||
|
v <- d[, c(var)]
|
||||||
|
g <- d[, c(group)]
|
||||||
|
ads <- d[, c(adj)]
|
||||||
|
dat <- data.frame(m, v, g, ads)
|
||||||
|
df <- data.frame(matrix(ncol = 9))
|
||||||
|
if (!is.factor(m)) {
|
||||||
|
for (i in 1:length(levels(g))) {
|
||||||
|
grp <- levels(dat$g)[i]
|
||||||
|
di <- dat[dat$g == grp, ][, -3]
|
||||||
|
mod <- lm(m ~ v, data = di)
|
||||||
|
|
||||||
|
p <- coef(summary(mod))[2,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<-p
|
||||||
|
|
||||||
|
co<-round(coef(mod),dec)[2]
|
||||||
|
ci<-round(confint(mod),dec)[2,]
|
||||||
|
lo<-ci[1]
|
||||||
|
up<-ci[2]
|
||||||
|
ci<-paste0(co," (",lo," to ",up,")")
|
||||||
|
|
||||||
|
amod <- lm(m ~ ., data = di)
|
||||||
|
pa <- coef(summary(amod))[2,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<-pa
|
||||||
|
|
||||||
|
aco<-round(coef(amod),dec)[2]
|
||||||
|
aci<-round(confint(amod),dec)[2,]
|
||||||
|
alo<-aci[1]
|
||||||
|
aup<-aci[2]
|
||||||
|
aci<-paste0(aco," (",alo," to ",aup,")")
|
||||||
|
|
||||||
|
nr <- c()
|
||||||
|
for (r in 1:2) {
|
||||||
|
vr <- levels(di$v)[r]
|
||||||
|
dr <- di[di$v == 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 <- c(grp, nr, ci, pv, aci, apv)
|
||||||
|
df <- rbind(df, irl)
|
||||||
|
names(df) <- c("grp",
|
||||||
|
paste0("N.", substr(levels(v)[1], 1, 3)),
|
||||||
|
paste0("M.", substr(levels(v)[1], 1, 3)),
|
||||||
|
paste0("N.", substr(levels(v)[2], 1, 3)),
|
||||||
|
paste0("M.", substr(levels(v)[2], 1, 3)),
|
||||||
|
"diff",
|
||||||
|
"pval",
|
||||||
|
"ad.diff",
|
||||||
|
"ad.pval")
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (is.factor(m)) {
|
||||||
|
for (i in 1:length(levels(g))) {
|
||||||
|
grp <- levels(dat$g)[i]
|
||||||
|
di <- dat[dat$g == grp, ][, -3]
|
||||||
|
|
||||||
|
mod <- glm(m ~ v, family = binomial(), data = di)
|
||||||
|
|
||||||
|
p <- coef(summary(mod))[2,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<-p
|
||||||
|
|
||||||
|
co <- round(exp(coef(mod)[-1]), dec)
|
||||||
|
ci<-round(exp(confint(mod)),dec)[2,]
|
||||||
|
lo<-ci[1]
|
||||||
|
up<-ci[2]
|
||||||
|
ci <- paste0(co, " (", lo, " to ", up, ")")
|
||||||
|
|
||||||
|
amod <- glm(m ~ ., family = binomial(), data = di)
|
||||||
|
|
||||||
|
pa <- coef(summary(amod))[2,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<-pa
|
||||||
|
|
||||||
|
aco <- round(exp(coef(amod)[2]), dec)
|
||||||
|
aci<-suppressMessages(round(exp(confint(amod)),dec))[2,]
|
||||||
|
alo<-aci[1]
|
||||||
|
aup<-aci[2]
|
||||||
|
aci <- paste0(aco, " (", alo, " to ", aup, ")")
|
||||||
|
nr <- c()
|
||||||
|
|
||||||
|
for (r in 1:2) {
|
||||||
|
vr <- levels(di$v)[r]
|
||||||
|
dr <- di[di$v == 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 <- c(grp, nr, ci, pv, aci, apv)
|
||||||
|
df <- rbind(df, irl)
|
||||||
|
names(df) <- c("grp",
|
||||||
|
paste0("N.", substr(levels(v)[1], 1, 3)),
|
||||||
|
paste0(nl, ".", substr(levels(v)[1], 1, 3)),
|
||||||
|
paste0("N.", substr(levels(v)[2], 1, 3)),
|
||||||
|
paste0(nl, ".", substr(levels(v)[2], 1, 3)),
|
||||||
|
"OR",
|
||||||
|
"pval",
|
||||||
|
"ad.OR",
|
||||||
|
"ad.pval")
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return(df)
|
||||||
|
}
|
144
R/print_diff_byvar.R
Normal file
144
R/print_diff_byvar.R
Normal file
@ -0,0 +1,144 @@
|
|||||||
|
#' REWRITE UNDERWAY
|
||||||
|
#'
|
||||||
|
#' Print regression results according to STROBE
|
||||||
|
#'
|
||||||
|
#' 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 var binary exposure variable to compare against (active vs placebo). As string.
|
||||||
|
#' @param group groups to compare, as string.
|
||||||
|
#' @param adj variables to adjust for, as string.
|
||||||
|
#' @param data dataframe of data.
|
||||||
|
#' @param dec decimals for results, standard is set to 2. Mean and sd is dec-1.
|
||||||
|
#' @keywords strobe
|
||||||
|
#' @export
|
||||||
|
#' @examples
|
||||||
|
#' data('mtcars')
|
||||||
|
#' mtcars$vs<-factor(mtcars$vs)
|
||||||
|
#' mtcars$am<-factor(mtcars$am)
|
||||||
|
#' strobe_diff_byvar(meas="mpg",var="vs",group = "am",adj=c("disp","wt","hp"),data=mtcars)
|
||||||
|
|
||||||
|
strobe_diff_byvar<-function(meas,var,group,adj,data,dec=2){
|
||||||
|
|
||||||
|
## meas: sdmt
|
||||||
|
## var: rtreat
|
||||||
|
## group: genotype
|
||||||
|
## for dichotome exposure variable (var)
|
||||||
|
|
||||||
|
d <- data
|
||||||
|
m <- d[, c(meas)]
|
||||||
|
v <- d[, c(var)]
|
||||||
|
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)
|
||||||
|
|
||||||
|
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(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, ")")
|
||||||
|
|
||||||
|
amod <- lm(m ~ ., 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("-", round(coef(amod)[2:length(levels(g))],
|
||||||
|
dec))
|
||||||
|
aci<-round(confint(amod),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), ]))
|
||||||
|
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 = 6), cbind(matrix(nr,
|
||||||
|
ncol = 2, byrow = TRUE), cbind(ci,pv, aci,apv)))
|
||||||
|
colnames(irl) <- c("N",
|
||||||
|
"Mean (SD)",
|
||||||
|
"Difference",
|
||||||
|
"p-value",
|
||||||
|
"Adjusted Difference",
|
||||||
|
"Adjusted p-value")
|
||||||
|
df <- cbind(df, irl)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (is.factor(m)) {
|
||||||
|
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)
|
||||||
|
}
|
139
R/print_log.R
Normal file
139
R/print_log.R
Normal file
@ -0,0 +1,139 @@
|
|||||||
|
#' Print regression results according to STROBE
|
||||||
|
#'
|
||||||
|
#' Printable table of logistic regression analysis according to STROBE.
|
||||||
|
#' @param meas outcome meassure variable name in data-data.frame as a string. Can be numeric or factor. Result is calculated accordingly.
|
||||||
|
#' @param var exposure variable to compare against (active vs placebo). As string.
|
||||||
|
#' @param adj variables to adjust for, as string.
|
||||||
|
#' @param data dataframe of data.
|
||||||
|
#' @param dec decimals for results, standard is set to 2. Mean and sd is dec-1.
|
||||||
|
#' @keywords logistic
|
||||||
|
#' @export
|
||||||
|
|
||||||
|
strobe_log<-function(meas,var,adj,data,dec=2){
|
||||||
|
## Ønskeliste:
|
||||||
|
##
|
||||||
|
## - Sum af alle, der indgår (Overall N)
|
||||||
|
## - Ryd op i kode, der der er overflødig %-regning, alternativt, så fiks at NA'er ikke skal regnes med.
|
||||||
|
##
|
||||||
|
|
||||||
|
require(dplyr)
|
||||||
|
|
||||||
|
d<-data
|
||||||
|
m<-d[,c(meas)]
|
||||||
|
v<-d[,c(var)]
|
||||||
|
|
||||||
|
ads<-d[,c(adj)]
|
||||||
|
dat<-data.frame(m,v)
|
||||||
|
df<-data.frame(matrix(ncol=4))
|
||||||
|
|
||||||
|
mn <- glm(m ~ .,family = binomial(), data = dat)
|
||||||
|
|
||||||
|
dat<-data.frame(dat,ads)
|
||||||
|
ma <- glm(m ~ .,family = binomial(), data = dat)
|
||||||
|
|
||||||
|
ctable <- coef(summary(mn))
|
||||||
|
pa <- ctable[, 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))
|
||||||
|
pv<-c("REF",pa[2:length(coef(mn))])
|
||||||
|
|
||||||
|
co<-round(exp(coef(mn)),dec)[-1]
|
||||||
|
ci<-round(exp(confint(mn)),dec)[-1,]
|
||||||
|
lo<-ci[,1]
|
||||||
|
up<-ci[,2]
|
||||||
|
|
||||||
|
or_ci<-c("REF",paste0(co," (",lo," to ",up,")"))
|
||||||
|
|
||||||
|
nr<-c()
|
||||||
|
|
||||||
|
for (r in 1:length(levels(dat[,2]))){
|
||||||
|
vr<-levels(dat[,2])[r]
|
||||||
|
dr<-dat[dat[,2]==vr,]
|
||||||
|
n<-as.numeric(nrow(dr))
|
||||||
|
|
||||||
|
## Af en eller anden grund bliver der talt for mange med.
|
||||||
|
# nall<-as.numeric(nrow(dat[!is.na(dat[,2]),]))
|
||||||
|
nl<-levels(m)[r]
|
||||||
|
# pro<-round(n/nall*100,0)
|
||||||
|
# rt<-paste0(n," (",pro,"%)")
|
||||||
|
nr<-rbind(nr,cbind(nl,n))
|
||||||
|
}
|
||||||
|
|
||||||
|
mms<-data.frame(cbind(nr,or_ci,pv))
|
||||||
|
header<-data.frame(matrix(var,ncol = ncol(mms)))
|
||||||
|
names(header)<-names(mms)
|
||||||
|
|
||||||
|
ls<-list(unadjusted=data.frame(rbind(header,mms)))
|
||||||
|
|
||||||
|
actable <- coef(summary(ma))
|
||||||
|
pa <- actable[,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<-pa[1:length(coef(ma))]
|
||||||
|
|
||||||
|
aco<-round(exp(coef(ma)),dec)
|
||||||
|
aci<-round(exp(confint(ma)),dec)
|
||||||
|
alo<-aci[,1]
|
||||||
|
aup<-aci[,2]
|
||||||
|
aor_ci<-paste0(aco," (",alo," to ",aup,")")
|
||||||
|
|
||||||
|
dat2<-dat[,-1]
|
||||||
|
# names(dat2)<-c(var,names(ads))
|
||||||
|
nq<-c()
|
||||||
|
|
||||||
|
for (i in 1:ncol(dat2)){
|
||||||
|
if (is.factor(dat2[,i])){
|
||||||
|
vec<-dat2[,i]
|
||||||
|
ns<-names(dat2)[i]
|
||||||
|
for (r in 1:length(levels(vec))){
|
||||||
|
vr<-levels(vec)[r]
|
||||||
|
dr<-vec[vec==vr]
|
||||||
|
n<-as.numeric(length(dr))
|
||||||
|
# nall<-as.numeric(nrow(dat[!is.na(dat2[,c(ns)]),]))
|
||||||
|
nl<-paste0(ns,levels(vec)[r])
|
||||||
|
# pro<-round(n/nall*100,0)
|
||||||
|
# rt<-paste0(n," (",pro,"%)")
|
||||||
|
nq<-rbind(nq,cbind(nl,n))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (!is.factor(dat2[,i])){
|
||||||
|
num<-dat2[,i]
|
||||||
|
ns<-names(dat2)[i]
|
||||||
|
nall<-as.numeric(nrow(dat[!is.na(dat2[,c(ns)]),]))
|
||||||
|
nq<-rbind(nq,cbind(ns,nall))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
rnames<-c()
|
||||||
|
|
||||||
|
for (i in 1:ncol(dat2)){
|
||||||
|
if (is.factor(dat2[,i])){
|
||||||
|
rnames<-c(rnames,names(dat2)[i],paste0(names(dat2)[i],levels(dat2[,i])))
|
||||||
|
}
|
||||||
|
if (!is.factor(dat2[,i])){
|
||||||
|
rnames<-c(rnames,paste0(names(dat2)[i],".all"),names(dat2)[i])
|
||||||
|
}
|
||||||
|
}
|
||||||
|
res<-cbind(aor_ci,apv)
|
||||||
|
rest<-data.frame(names=row.names(res),res,stringsAsFactors = F)
|
||||||
|
|
||||||
|
numb<-data.frame(names=nq[,c("nl")],N=nq[,c("n")],stringsAsFactors = F)
|
||||||
|
namt<-data.frame(names=rnames,stringsAsFactors = F)
|
||||||
|
|
||||||
|
coll<-left_join(left_join(namt,numb,by="names"),rest,by="names")
|
||||||
|
|
||||||
|
header<-data.frame(matrix("Adjusted",ncol = ncol(coll)))
|
||||||
|
names(header)<-names(coll)
|
||||||
|
|
||||||
|
ls$adjusted<-data.frame(rbind(header,coll))
|
||||||
|
|
||||||
|
fnames<-c("Variable","N","OR (95 % CI)","p value")
|
||||||
|
|
||||||
|
names(ls$unadjusted)<-fnames
|
||||||
|
names(ls$adjusted)<-fnames
|
||||||
|
|
||||||
|
return(ls)
|
||||||
|
}
|
174
R/print_olr.R
Normal file
174
R/print_olr.R
Normal file
@ -0,0 +1,174 @@
|
|||||||
|
#' Print ordinal logistic regression results according to STROBE
|
||||||
|
#'
|
||||||
|
#' Printable table of ordinal logistic regression with bivariate and multivariate analyses.
|
||||||
|
#' Table according to STROBE. Uses polr() funtion of the MASS-package.
|
||||||
|
#' Formula analysed is the most simple m~v1+v2+vn. The is no significance test. Results are point estimates with 95 percent CI.
|
||||||
|
#' @param meas outcome meassure variable name or response in data-data.frame as a string. Should be factor, preferably ordered.
|
||||||
|
#' @param vars variables to compare against. As vector of columnnames.
|
||||||
|
#' @param data dataframe of data.
|
||||||
|
#' @param dec decimals for results, standard is set to 2. Mean and sd is dec-1.
|
||||||
|
#' @param n.by.adj flag to indicate wether to count number of patients in adjusted model or overall for outcome meassure not NA.
|
||||||
|
#' @keywords olr
|
||||||
|
#' @export
|
||||||
|
|
||||||
|
strobe_olr<-function(meas,vars,data,dec=2,n.by.adj=FALSE){
|
||||||
|
## For calculation of p-value from t-value see rep_olr()
|
||||||
|
|
||||||
|
require(MASS)
|
||||||
|
require(dplyr)
|
||||||
|
|
||||||
|
d<-data
|
||||||
|
m<-d[,c(meas)]
|
||||||
|
|
||||||
|
ads<-d[,c(vars)]
|
||||||
|
|
||||||
|
if(!is.factor(m)){stop("'meas' should be a factor, preferably ordered.")}
|
||||||
|
|
||||||
|
if(is.factor(m)){
|
||||||
|
|
||||||
|
## Crude ORs
|
||||||
|
|
||||||
|
dfcr<-data.frame(matrix(NA,ncol = 2))
|
||||||
|
names(dfcr)<-c("pred","or_ci")
|
||||||
|
n.mn<-c()
|
||||||
|
nref<-c()
|
||||||
|
|
||||||
|
for(i in 1:ncol(ads)){
|
||||||
|
dat<-data.frame(m=m,ads[,i])
|
||||||
|
names(dat)<-c("m",names(ads)[i])
|
||||||
|
mn<-polr(m ~ ., data = dat, Hess=TRUE)
|
||||||
|
n.mn<-c(n.mn,nrow(mn$model))
|
||||||
|
|
||||||
|
suppressMessages(ci<-matrix(exp(confint(mn)),ncol=2))
|
||||||
|
l<-round(ci[,1],dec)
|
||||||
|
u<-round(ci[,2],dec)
|
||||||
|
or<-round(exp(coef(mn)),dec)
|
||||||
|
or_ci<-paste0(or," (",l," to ",u,")")
|
||||||
|
|
||||||
|
x1<-ads[,i]
|
||||||
|
|
||||||
|
if (is.factor(x1)){
|
||||||
|
pred<-paste0(names(ads)[i],levels(x1)[-1])
|
||||||
|
}
|
||||||
|
|
||||||
|
else {
|
||||||
|
pred<-names(ads)[i]
|
||||||
|
}
|
||||||
|
|
||||||
|
dfcr<-rbind(dfcr,cbind(pred,or_ci))
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
## Mutually adjusted ORs
|
||||||
|
|
||||||
|
dat<-data.frame(m=m,ads)
|
||||||
|
ma <-polr(m ~ ., data = dat, Hess=TRUE)
|
||||||
|
miss<-length(ma$na.action)
|
||||||
|
|
||||||
|
aco<-round(exp(coef(ma)),dec)
|
||||||
|
suppressMessages(aci<-round(exp(confint(ma)),dec))
|
||||||
|
alo<-aci[,1]
|
||||||
|
aup<-aci[,2]
|
||||||
|
aor_ci<-paste0(aco," (",alo," to ",aup,")")
|
||||||
|
|
||||||
|
nq<-c()
|
||||||
|
|
||||||
|
if (n.by.adj==TRUE){
|
||||||
|
dat2<-ma$model[,-1]
|
||||||
|
for (i in 1:ncol(dat2)){
|
||||||
|
if (is.factor(dat2[,i])){
|
||||||
|
vec<-dat2[,i]
|
||||||
|
ns<-names(dat2)[i]
|
||||||
|
for (r in 1:length(levels(vec))){
|
||||||
|
vr<-levels(vec)[r]
|
||||||
|
n<-as.numeric(length(vec[vec==vr&!is.na(vec)]))
|
||||||
|
nall<-as.numeric(length(dat2[,c(ns)]))
|
||||||
|
n.meas<-nall
|
||||||
|
nl<-paste0(ns,levels(vec)[r])
|
||||||
|
pro<-round(n/nall*100,0)
|
||||||
|
rt<-paste0(n," (",pro,"%)")
|
||||||
|
nq<-rbind(nq,cbind(nl,rt))
|
||||||
|
}}
|
||||||
|
if (!is.factor(dat2[,i])){
|
||||||
|
num<-dat2[,i]
|
||||||
|
nl<-names(dat2)[i]
|
||||||
|
n<-as.numeric(length(num[!is.na(num)]))
|
||||||
|
nall<-as.numeric(nrow(dat2))
|
||||||
|
n.meas<-nall
|
||||||
|
pro<-round(n/nall*100,0)
|
||||||
|
rt<-paste0(n," (",pro,"%)")
|
||||||
|
nq<-rbind(nq,cbind(nl,rt))
|
||||||
|
}}}
|
||||||
|
|
||||||
|
else {
|
||||||
|
dat2<-dat[!is.na(dat[,1]),][,-1]
|
||||||
|
n.meas<-nrow(dat2)
|
||||||
|
for (i in 1:ncol(dat2)){
|
||||||
|
if (is.factor(dat2[,i])){
|
||||||
|
vec<-dat2[,i]
|
||||||
|
ns<-names(dat2)[i]
|
||||||
|
for (r in 1:length(levels(vec))){
|
||||||
|
vr<-levels(vec)[r]
|
||||||
|
n<-as.numeric(length(vec[vec==vr&!is.na(vec)]))
|
||||||
|
nall<-as.numeric(n.mn[i])
|
||||||
|
nl<-paste0(ns,levels(vec)[r])
|
||||||
|
pro<-round(n/nall*100,0)
|
||||||
|
rt<-paste0(n," (",pro,"%)")
|
||||||
|
nq<-rbind(nq,cbind(nl,rt))
|
||||||
|
}}
|
||||||
|
if (!is.factor(dat2[,i])){
|
||||||
|
num<-dat2[,i]
|
||||||
|
nl<-names(dat2)[i]
|
||||||
|
n<-as.numeric(length(num[!is.na(num)]))
|
||||||
|
nall<-as.numeric(n.meas)
|
||||||
|
pro<-round(n/nall*100,0)
|
||||||
|
rt<-paste0(n," (",pro,"%)")
|
||||||
|
nq<-rbind(nq,cbind(nl,rt))
|
||||||
|
}}
|
||||||
|
}
|
||||||
|
|
||||||
|
rnames<-c()
|
||||||
|
for (i in 1:ncol(dat2)){
|
||||||
|
if (is.factor(dat2[,i])){
|
||||||
|
rnames<-c(rnames,names(dat2)[i],paste0(names(dat2)[i],levels(dat2[,i])))
|
||||||
|
}
|
||||||
|
if (!is.factor(dat2[,i])){
|
||||||
|
rnames<-c(rnames,paste0(names(dat2)[i],".all"),names(dat2)[i])
|
||||||
|
}
|
||||||
|
}
|
||||||
|
rest<-data.frame(names=names(aco),aor_ci,stringsAsFactors = F)
|
||||||
|
|
||||||
|
numb<-data.frame(names=nq[,c("nl")],N=nq[,c("rt")],stringsAsFactors = F)
|
||||||
|
namt<-data.frame(names=rnames,stringsAsFactors = F)
|
||||||
|
|
||||||
|
coll<-left_join(left_join(namt,numb,by="names"),rest,by="names")
|
||||||
|
|
||||||
|
header<-data.frame(matrix(paste0("Chance of higher ",meas),ncol = ncol(coll)),stringsAsFactors = F)
|
||||||
|
names(header)<-names(coll)
|
||||||
|
|
||||||
|
df<-data.frame(rbind(header,coll),stringsAsFactors = F)
|
||||||
|
|
||||||
|
names(dfcr)[1]<-c("names")
|
||||||
|
|
||||||
|
suppressWarnings(re<-left_join(df,dfcr,by="names"))
|
||||||
|
|
||||||
|
rona<-c()
|
||||||
|
for (i in 1:length(ads)){
|
||||||
|
if (is.factor(ads[,i])){
|
||||||
|
rona<-c(rona,names(ads[i]),levels(ads[,i]))}
|
||||||
|
if (!is.factor(ads[,i])){
|
||||||
|
rona<-c(rona,names(ads[i]),"Per unit increase")
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
ref<-data.frame(c(NA,rona),re[,2],re[,4],re[,3])
|
||||||
|
|
||||||
|
names(ref)<-c("Variable",paste0("N=",n.meas),"Bivariate OLR (95 % CI)","Mutually adjusted OLR (95 % CI)")
|
||||||
|
|
||||||
|
ls<-list(tbl=ref,miss,n.meas,nrow(d))
|
||||||
|
names(ls)<-c("Printable table","Deleted due to missingness in adjusted analysis","Number of outcome observations","Length of dataframe")
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
return(ls)
|
||||||
|
}
|
358
R/print_pred.R
Normal file
358
R/print_pred.R
Normal file
@ -0,0 +1,358 @@
|
|||||||
|
#' Regression model of predictors according to STROBE, bi- and multivariable.
|
||||||
|
#'
|
||||||
|
#' Printable table of regression model according to STROBE for linear or binary outcome-variables.
|
||||||
|
#' Includes both bivariate and multivariate in the same table.
|
||||||
|
#' Output is a list, with the first item being the main "output" as a dataframe.
|
||||||
|
#' Automatically uses logistic regression model for dichotomous outcome variable and linear regression model for continuous outcome variable. Linear regression will give estimated adjusted true mean in list.
|
||||||
|
#' For logistic regression gives count of outcome variable pr variable level.
|
||||||
|
#' @param meas binary outcome measure variable, column name in data.frame as a string. Can be numeric or factor. Result is calculated accordingly.
|
||||||
|
#' @param adj variables to adjust for, as string.
|
||||||
|
#' @param data dataframe of data.
|
||||||
|
#' @param dec decimals for results, standard is set to 2. Mean and sd is dec-1.
|
||||||
|
#' @param n.by.adj flag to indicate whether to count number of patients in adjusted model or overall for outcome measure not NA.
|
||||||
|
#' @param p.val flag to include p-values in table, set to FALSE as standard.
|
||||||
|
#' @keywords logistic
|
||||||
|
#' @export
|
||||||
|
|
||||||
|
strobe_pred<-function(meas,adj,data,dec=2,n.by.adj=FALSE,p.val=FALSE){
|
||||||
|
|
||||||
|
## Wish list:
|
||||||
|
## - SPEED, maybe flags to include/exclude time consuming tasks
|
||||||
|
## - Include ANOVA in output list, flag to include
|
||||||
|
|
||||||
|
require(dplyr)
|
||||||
|
|
||||||
|
d<-data
|
||||||
|
m<-d[,c(meas)]
|
||||||
|
|
||||||
|
ads<-d[,c(adj)]
|
||||||
|
|
||||||
|
if(is.factor(m)){
|
||||||
|
|
||||||
|
## Crude ORs
|
||||||
|
|
||||||
|
dfcr<-data.frame(matrix(NA,ncol = 3))
|
||||||
|
names(dfcr)<-c("pred","or_ci","pv")
|
||||||
|
n.mn<-c()
|
||||||
|
|
||||||
|
nref<-c()
|
||||||
|
|
||||||
|
for(i in 1:ncol(ads)){
|
||||||
|
dat<-data.frame(m=m,ads[,i])
|
||||||
|
names(dat)<-c("m",names(ads)[i])
|
||||||
|
mn<-glm(m~.,family = binomial(),data=dat)
|
||||||
|
n.mn<-c(n.mn,nrow(mn$model))
|
||||||
|
|
||||||
|
suppressMessages(ci<-exp(confint(mn)))
|
||||||
|
l<-round(ci[-1,1],dec)
|
||||||
|
u<-round(ci[-1,2],dec)
|
||||||
|
or<-round(exp(coef(mn))[-1],dec)
|
||||||
|
or_ci<-paste0(or," (",l," to ",u,")")
|
||||||
|
pv<-round(tidy(mn)$p.value[-1],dec+1)
|
||||||
|
x1<-ads[,i]
|
||||||
|
|
||||||
|
if (is.factor(x1)){
|
||||||
|
pred<-paste0(names(ads)[i],levels(x1)[-1])
|
||||||
|
}
|
||||||
|
|
||||||
|
else {
|
||||||
|
pred<-names(ads)[i]
|
||||||
|
}
|
||||||
|
|
||||||
|
dfcr<-rbind(dfcr,cbind(pred,or_ci,pv))
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
## Mutually adjusted ORs
|
||||||
|
|
||||||
|
dat<-data.frame(m=m,ads)
|
||||||
|
ma <- glm(m ~ .,family = binomial(), data = dat)
|
||||||
|
miss<-length(ma$na.action)
|
||||||
|
|
||||||
|
actable <- coef(summary(ma))
|
||||||
|
pa <- actable[,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<-pa[1:length(coef(ma))]
|
||||||
|
|
||||||
|
aco<-round(exp(coef(ma)),dec)
|
||||||
|
suppressMessages(aci<-round(exp(confint(ma)),dec))
|
||||||
|
alo<-aci[,1]
|
||||||
|
aup<-aci[,2]
|
||||||
|
aor_ci<-paste0(aco," (",alo," to ",aup,")")
|
||||||
|
|
||||||
|
# names(dat2)<-c(var,names(ads))
|
||||||
|
|
||||||
|
nq<-c()
|
||||||
|
nall<-length(!is.na(dat[,1]))
|
||||||
|
|
||||||
|
if (n.by.adj==TRUE){
|
||||||
|
dat2<-ma$model
|
||||||
|
# nalt<-nrow(dat2)
|
||||||
|
for (i in 2:ncol(dat2)) {
|
||||||
|
if (is.factor(dat2[, i])) {
|
||||||
|
vec <- dat2[, i]
|
||||||
|
ns <- names(dat2)[i]
|
||||||
|
for (r in 1:length(levels(vec))) {
|
||||||
|
vr <- levels(vec)[r]
|
||||||
|
## Counting all included in analysis
|
||||||
|
n <- length(vec[vec == vr & !is.na(vec)])
|
||||||
|
rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
|
||||||
|
## Counting all included in analysis with outcome
|
||||||
|
lvl<-levels(dat2[,1])[2]
|
||||||
|
no <- length(vec[vec == vr & dat2[,1]==lvl & !is.na(vec)])
|
||||||
|
ro <- paste0(no, " (", round(no/n * 100, 0), "%)")
|
||||||
|
## Combining
|
||||||
|
nq <- rbind(nq, cbind(paste0(ns, levels(vec)[r]), rt,ro))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (!is.factor(dat2[, i])) {
|
||||||
|
num <- dat2[, i]
|
||||||
|
n <- length(num[!is.na(num)])
|
||||||
|
rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
|
||||||
|
nq <- rbind(nq, cbind(names(dat2)[i], rt,ro="-"))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
else {
|
||||||
|
dat2<-dat[!is.na(dat[,1]),]
|
||||||
|
for (i in 2:ncol(dat2)) {
|
||||||
|
if (is.factor(dat2[, i])) {
|
||||||
|
vec <- dat2[, i]
|
||||||
|
ns <- names(dat2)[i]
|
||||||
|
for (r in 1:length(levels(vec))) {
|
||||||
|
vr <- levels(vec)[r]
|
||||||
|
## Counting all included in analysis
|
||||||
|
n <- length(vec[vec == vr & !is.na(vec)])
|
||||||
|
rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
|
||||||
|
## Counting all included in analysis with outcome
|
||||||
|
lvl<-levels(dat2[,1])[2]
|
||||||
|
no <- length(vec[vec == vr & dat2[,1]==lvl & !is.na(vec)])
|
||||||
|
ro <- paste0(no, " (", round(no/n * 100, 0), "%)")
|
||||||
|
## Combining
|
||||||
|
nq <- rbind(nq, cbind(paste0(ns, levels(vec)[r]), rt,ro))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (!is.factor(dat2[, i])) {
|
||||||
|
num <- dat2[, i]
|
||||||
|
n <- length(num[!is.na(num)])
|
||||||
|
rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
|
||||||
|
nq <- rbind(nq, cbind(names(dat2)[i], rt,ro="-"))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
rnames<-c()
|
||||||
|
for (i in 1:ncol(dat2)){
|
||||||
|
if (is.factor(dat2[,i])){
|
||||||
|
rnames<-c(rnames,names(dat2)[i],paste0(names(dat2)[i],levels(dat2[,i])))
|
||||||
|
}
|
||||||
|
if (!is.factor(dat2[,i])){
|
||||||
|
rnames<-c(rnames,paste0(names(dat2)[i],".all"),names(dat2)[i])
|
||||||
|
}
|
||||||
|
}
|
||||||
|
res<-cbind(aor_ci,apv)
|
||||||
|
rest<-data.frame(names=row.names(res),res,stringsAsFactors = F)
|
||||||
|
|
||||||
|
numb<-data.frame(names=nq[,1],N=nq[,2],N.out=nq[,3],stringsAsFactors = F)
|
||||||
|
namt<-data.frame(names=tail(rnames,-3),stringsAsFactors = F)
|
||||||
|
|
||||||
|
coll<-left_join(left_join(namt,numb,by="names"),rest,by="names")
|
||||||
|
|
||||||
|
header<-data.frame(matrix(paste0("Chance of ",meas," is ",levels(m)[2]),ncol = ncol(coll)),stringsAsFactors = F)
|
||||||
|
names(header)<-names(coll)
|
||||||
|
|
||||||
|
df<-data.frame(rbind(header,coll),stringsAsFactors = F)
|
||||||
|
|
||||||
|
names(dfcr)[1]<-c("names")
|
||||||
|
|
||||||
|
suppressWarnings(re<-left_join(df,dfcr,by="names"))
|
||||||
|
|
||||||
|
rona<-c()
|
||||||
|
for (i in 1:length(ads)){
|
||||||
|
if (is.factor(ads[,i])){
|
||||||
|
rona<-c(rona,names(ads[i]),levels(ads[,i]))}
|
||||||
|
if (!is.factor(ads[,i])){
|
||||||
|
rona<-c(rona,names(ads[i]),"Per unit increase")
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (p.val==TRUE){
|
||||||
|
ref<-data.frame(c(NA,rona),re[,"N"],re[,"N.out"],re[,"or_ci"],re[,"pv"],re[,"aor_ci"],re[,"apv"])
|
||||||
|
|
||||||
|
names(ref)<-c("Variable",paste0("N=",nall),paste0("N, ",meas," is ",levels(m)[2]),"Crude OR (95 % CI)","p-value","Mutually adjusted OR (95 % CI)","A p-value")
|
||||||
|
}
|
||||||
|
else{
|
||||||
|
ref<-data.frame(c(NA,rona),re[,"N"],re[,"N.out"],re[,"or_ci"],re[,"aor_ci"])
|
||||||
|
|
||||||
|
names(ref)<-c("Variable",paste0("N=",nall),paste0("N, ",meas," is ",levels(m)[2]),"Crude OR (95 % CI)","Mutually adjusted OR (95 % CI)")
|
||||||
|
}
|
||||||
|
|
||||||
|
ls<-list(tbl=ref,miss,nall,nrow(d))
|
||||||
|
names(ls)<-c("Printable table","Deleted due to missingness in adjusted analysis","Number of outcome observations","Length of dataframe")
|
||||||
|
}
|
||||||
|
|
||||||
|
if(!is.factor(m)){
|
||||||
|
|
||||||
|
dfcr<-data.frame(matrix(NA,ncol = 3))
|
||||||
|
names(dfcr)<-c("pred","dif_ci","pv")
|
||||||
|
n.mn<-c()
|
||||||
|
|
||||||
|
nref<-c()
|
||||||
|
|
||||||
|
for(i in 1:ncol(ads)){
|
||||||
|
dat<-data.frame(m=m,ads[,i])
|
||||||
|
names(dat)<-c("m",names(ads)[i])
|
||||||
|
mn<-lm(m~.,data=dat)
|
||||||
|
n.mn<-c(n.mn,nrow(mn$model))
|
||||||
|
|
||||||
|
suppressMessages(ci<-confint(mn))
|
||||||
|
l<-round(ci[-1,1],dec)
|
||||||
|
u<-round(ci[-1,2],dec)
|
||||||
|
dif<-round(coef(mn)[-1],dec)
|
||||||
|
dif_ci<-paste0(dif," (",l," to ",u,")")
|
||||||
|
pv<-round(tidy(mn)$p.value[-1],dec+1)
|
||||||
|
pv<-ifelse(pv<0.001,"<0.001",round(pv,3))
|
||||||
|
pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv),
|
||||||
|
ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv))
|
||||||
|
|
||||||
|
x1<-ads[,i]
|
||||||
|
|
||||||
|
if (is.factor(x1)){
|
||||||
|
pred<-paste0(names(ads)[i],levels(x1)[-1])
|
||||||
|
}
|
||||||
|
|
||||||
|
else {
|
||||||
|
pred<-names(ads)[i]
|
||||||
|
}
|
||||||
|
|
||||||
|
dfcr<-rbind(dfcr,cbind(pred,dif_ci,pv))
|
||||||
|
}
|
||||||
|
|
||||||
|
## Mutually adjusted ORs
|
||||||
|
|
||||||
|
dat<-data.frame(m=m,ads)
|
||||||
|
ma <- lm(m ~ ., data = dat)
|
||||||
|
miss<-length(ma$na.action)
|
||||||
|
|
||||||
|
|
||||||
|
actable <- coef(summary(ma))
|
||||||
|
pa <- actable[,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<-pa[1:length(coef(ma))]
|
||||||
|
|
||||||
|
aco<-round(coef(ma),dec)
|
||||||
|
suppressMessages(aci<-round(confint(ma),dec))
|
||||||
|
alo<-aci[,1]
|
||||||
|
aup<-aci[,2]
|
||||||
|
amean_ci<-paste0(aco," (",alo," to ",aup,")")
|
||||||
|
|
||||||
|
mean_est<-amean_ci[[1]]
|
||||||
|
|
||||||
|
|
||||||
|
nq<-c()
|
||||||
|
nall<-length(!is.na(dat[,1]))
|
||||||
|
|
||||||
|
if (n.by.adj==TRUE){
|
||||||
|
dat2<-ma$model[,-1]
|
||||||
|
# nalt<-nrow(dat2)
|
||||||
|
for (i in 1:ncol(dat2)){
|
||||||
|
if (is.factor(dat2[,i])){
|
||||||
|
vec<-dat2[,i]
|
||||||
|
ns<-names(dat2)[i]
|
||||||
|
for (r in 1:length(levels(vec))){
|
||||||
|
vr<-levels(vec)[r]
|
||||||
|
n<-length(vec[vec==vr&!is.na(vec)])
|
||||||
|
rt<-paste0(n," (",round(n/nall*100,0),"%)")
|
||||||
|
nq<-rbind(nq,cbind(paste0(ns,levels(vec)[r]),rt))
|
||||||
|
}}
|
||||||
|
if (!is.factor(dat2[,i])){
|
||||||
|
num<-dat2[,i]
|
||||||
|
n<-as.numeric(length(num[!is.na(num)]))
|
||||||
|
rt<-paste0(n," (",round(n/nall*100,0),"%)")
|
||||||
|
nq<-rbind(nq,cbind(names(dat2)[i],rt))
|
||||||
|
}}
|
||||||
|
}
|
||||||
|
|
||||||
|
else {
|
||||||
|
dat2<-dat[!is.na(dat[,1]),][,-1]
|
||||||
|
for (i in 1:ncol(dat2)) {
|
||||||
|
if (is.factor(dat2[, i])) {
|
||||||
|
vec <- dat2[, i]
|
||||||
|
ns <- names(dat2)[i]
|
||||||
|
for (r in 1:length(levels(vec))) {
|
||||||
|
vr <- levels(vec)[r]
|
||||||
|
n <- length(vec[vec == vr & !is.na(vec)])
|
||||||
|
rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
|
||||||
|
nq <- rbind(nq, cbind(paste0(ns, levels(vec)[r]), rt))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (!is.factor(dat2[, i])) {
|
||||||
|
num <- dat2[, i]
|
||||||
|
n <- length(num[!is.na(num)])
|
||||||
|
rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
|
||||||
|
nq <- rbind(nq, cbind(names(dat2)[i], rt))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
rnames<-c()
|
||||||
|
for (i in 1:ncol(dat2)){
|
||||||
|
if (is.factor(dat2[,i])){
|
||||||
|
rnames<-c(rnames,names(dat2)[i],paste0(names(dat2)[i],levels(dat2[,i])))
|
||||||
|
}
|
||||||
|
if (!is.factor(dat2[,i])){
|
||||||
|
rnames<-c(rnames,paste0(names(dat2)[i],".all"),names(dat2)[i])
|
||||||
|
}
|
||||||
|
}
|
||||||
|
res<-cbind(amean_ci,apv)
|
||||||
|
rest<-data.frame(names=row.names(res),res,stringsAsFactors = F)
|
||||||
|
|
||||||
|
numb<-data.frame(names=nq[,1],N=nq[,2],stringsAsFactors = F)
|
||||||
|
namt<-data.frame(names=rnames,stringsAsFactors = F)
|
||||||
|
|
||||||
|
coll<-left_join(left_join(namt,numb,by="names"),rest,by="names")
|
||||||
|
|
||||||
|
header<-data.frame(matrix("Adjusted",ncol = ncol(coll)),stringsAsFactors = F)
|
||||||
|
names(header)<-names(coll)
|
||||||
|
|
||||||
|
df<-data.frame(rbind(header,coll),stringsAsFactors = F)
|
||||||
|
|
||||||
|
names(dfcr)[1]<-c("names")
|
||||||
|
|
||||||
|
suppressWarnings(re<-left_join(df,dfcr,by="names"))
|
||||||
|
|
||||||
|
rona<-c()
|
||||||
|
for (i in 1:length(ads)){
|
||||||
|
if (is.factor(ads[,i])){
|
||||||
|
rona<-c(rona,names(ads[i]),levels(ads[,i]))}
|
||||||
|
if (!is.factor(ads[,i])){
|
||||||
|
rona<-c(rona,names(ads[i]),"Per unit increase")
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (p.val==TRUE){
|
||||||
|
ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,6],re[,3],re[,4])
|
||||||
|
|
||||||
|
names(ref)<-c("Variable",paste0("N=",nall),"Difference (95 % CI)","p-value","Mutually adjusted difference (95 % CI)","A p-value")
|
||||||
|
}
|
||||||
|
else{
|
||||||
|
ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,3])
|
||||||
|
|
||||||
|
names(ref)<-c("Variable",paste0("N=",nall),"Difference (95 % CI)","Mutually adjusted difference (95 % CI)")
|
||||||
|
}
|
||||||
|
|
||||||
|
ls<-list(tbl=ref,miss,nall,nrow(d),mean_est)
|
||||||
|
names(ls)<-c("Printable table","Deleted due to missingness in adjusted analysis","Number of outcome observations","Length of dataframe","Estimated true mean (95 % CI) in adjusted analysis")
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
return(ls)
|
||||||
|
}
|
@ -1,4 +1,4 @@
|
|||||||
#' REWRITE UNDERWAY
|
#' REWRITE UNDERWAY - replaced by 'print_diff_bygroup'
|
||||||
#'
|
#'
|
||||||
#' Print regression results according to STROBE
|
#' Print regression results according to STROBE
|
||||||
#'
|
#'
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
#' REWRITE UNDERWAY
|
#' REWRITE UNDERWAY - replaced by 'print_diff_byvar'
|
||||||
#'
|
#'
|
||||||
#' Print regression results according to STROBE
|
#' Print regression results according to STROBE
|
||||||
#'
|
#'
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
#' OBSOLETE - use 'print_log'
|
||||||
|
#'
|
||||||
#' Print regression results according to STROBE
|
#' Print regression results according to STROBE
|
||||||
#'
|
#'
|
||||||
#' Printable table of logistic regression analysis according to STROBE.
|
#' Printable table of logistic regression analysis according to STROBE.
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
#' OBSOLETE - use 'print_olr'
|
||||||
|
#'
|
||||||
#' Print ordinal logistic regression results according to STROBE
|
#' Print ordinal logistic regression results according to STROBE
|
||||||
#'
|
#'
|
||||||
#' Printable table of ordinal logistic regression with bivariate and multivariate analyses.
|
#' Printable table of ordinal logistic regression with bivariate and multivariate analyses.
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
#' OBSOLETE - use 'print_pred'
|
||||||
|
#'
|
||||||
#' Regression model of predictors according to STROBE, bi- and multivariable.
|
#' Regression model of predictors according to STROBE, bi- and multivariable.
|
||||||
#'
|
#'
|
||||||
#' Printable table of regression model according to STROBE for linear or binary outcome-variables.
|
#' Printable table of regression model according to STROBE for linear or binary outcome-variables.
|
||||||
|
@ -1,9 +1,11 @@
|
|||||||
% Generated by roxygen2: do not edit by hand
|
% Generated by roxygen2: do not edit by hand
|
||||||
% Please edit documentation in R/strobe_diff_bygroup.R
|
% Please edit documentation in R/print_diff_bygroup.R, R/strobe_diff_bygroup.R
|
||||||
\name{strobe_diff_bygroup}
|
\name{strobe_diff_bygroup}
|
||||||
\alias{strobe_diff_bygroup}
|
\alias{strobe_diff_bygroup}
|
||||||
\title{REWRITE UNDERWAY}
|
\title{REWRITE UNDERWAY}
|
||||||
\usage{
|
\usage{
|
||||||
|
strobe_diff_bygroup(meas, var, group, adj, data, dec = 2)
|
||||||
|
|
||||||
strobe_diff_bygroup(meas, var, group, adj, data, dec = 2)
|
strobe_diff_bygroup(meas, var, group, adj, data, dec = 2)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
@ -20,9 +22,14 @@ strobe_diff_bygroup(meas, var, group, adj, data, dec = 2)
|
|||||||
\item{dec}{decimals for results, standard is set to 2. Mean and sd is dec-1. pval has 3 decimals.}
|
\item{dec}{decimals for results, standard is set to 2. Mean and sd is dec-1. pval has 3 decimals.}
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
|
Print regression results according to STROBE
|
||||||
|
|
||||||
Print regression results according to STROBE
|
Print regression results according to STROBE
|
||||||
}
|
}
|
||||||
\details{
|
\details{
|
||||||
|
Printable table of two dimensional regression analysis of group vs variable for outcome measure. By group. Includes p-value
|
||||||
|
Group and variable has to be dichotomous factor.
|
||||||
|
|
||||||
Printable table of two dimensional regression analysis of group vs variable for outcome measure. By group. Includes p-value
|
Printable table of two dimensional regression analysis of group vs variable for outcome measure. By group. Includes p-value
|
||||||
Group and variable has to be dichotomous factor.
|
Group and variable has to be dichotomous factor.
|
||||||
}
|
}
|
||||||
@ -31,5 +38,9 @@ Group and variable has to be dichotomous factor.
|
|||||||
mtcars$vs<-factor(mtcars$vs)
|
mtcars$vs<-factor(mtcars$vs)
|
||||||
mtcars$am<-factor(mtcars$am)
|
mtcars$am<-factor(mtcars$am)
|
||||||
strobe_diff_bygroup(meas="mpg",var="vs",group = "am",adj=c("disp","wt"),data=mtcars)
|
strobe_diff_bygroup(meas="mpg",var="vs",group = "am",adj=c("disp","wt"),data=mtcars)
|
||||||
|
data('mtcars')
|
||||||
|
mtcars$vs<-factor(mtcars$vs)
|
||||||
|
mtcars$am<-factor(mtcars$am)
|
||||||
|
strobe_diff_bygroup(meas="mpg",var="vs",group = "am",adj=c("disp","wt"),data=mtcars)
|
||||||
}
|
}
|
||||||
\keyword{strobe}
|
\keyword{strobe}
|
||||||
|
@ -1,9 +1,11 @@
|
|||||||
% Generated by roxygen2: do not edit by hand
|
% Generated by roxygen2: do not edit by hand
|
||||||
% Please edit documentation in R/strobe_diff_byvar.R
|
% Please edit documentation in R/print_diff_byvar.R, R/strobe_diff_byvar.R
|
||||||
\name{strobe_diff_byvar}
|
\name{strobe_diff_byvar}
|
||||||
\alias{strobe_diff_byvar}
|
\alias{strobe_diff_byvar}
|
||||||
\title{REWRITE UNDERWAY}
|
\title{REWRITE UNDERWAY}
|
||||||
\usage{
|
\usage{
|
||||||
|
strobe_diff_byvar(meas, var, group, adj, data, dec = 2)
|
||||||
|
|
||||||
strobe_diff_byvar(meas, var, group, adj, data, dec = 2)
|
strobe_diff_byvar(meas, var, group, adj, data, dec = 2)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
@ -20,9 +22,13 @@ strobe_diff_byvar(meas, var, group, adj, data, dec = 2)
|
|||||||
\item{dec}{decimals for results, standard is set to 2. Mean and sd is dec-1.}
|
\item{dec}{decimals for results, standard is set to 2. Mean and sd is dec-1.}
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
|
Print regression results according to STROBE
|
||||||
|
|
||||||
Print regression results according to STROBE
|
Print regression results according to STROBE
|
||||||
}
|
}
|
||||||
\details{
|
\details{
|
||||||
|
Printable table of three dimensional regression analysis of group vs var for meas. By var. Includes p-values.
|
||||||
|
|
||||||
Printable table of three dimensional regression analysis of group vs var for meas. By var. Includes p-values.
|
Printable table of three dimensional regression analysis of group vs var for meas. By var. Includes p-values.
|
||||||
}
|
}
|
||||||
\examples{
|
\examples{
|
||||||
@ -30,5 +36,9 @@ Printable table of three dimensional regression analysis of group vs var for mea
|
|||||||
mtcars$vs<-factor(mtcars$vs)
|
mtcars$vs<-factor(mtcars$vs)
|
||||||
mtcars$am<-factor(mtcars$am)
|
mtcars$am<-factor(mtcars$am)
|
||||||
strobe_diff_byvar(meas="mpg",var="vs",group = "am",adj=c("disp","wt","hp"),data=mtcars)
|
strobe_diff_byvar(meas="mpg",var="vs",group = "am",adj=c("disp","wt","hp"),data=mtcars)
|
||||||
|
data('mtcars')
|
||||||
|
mtcars$vs<-factor(mtcars$vs)
|
||||||
|
mtcars$am<-factor(mtcars$am)
|
||||||
|
strobe_diff_byvar(meas="mpg",var="vs",group = "am",adj=c("disp","wt","hp"),data=mtcars)
|
||||||
}
|
}
|
||||||
\keyword{strobe}
|
\keyword{strobe}
|
||||||
|
@ -1,9 +1,11 @@
|
|||||||
% Generated by roxygen2: do not edit by hand
|
% Generated by roxygen2: do not edit by hand
|
||||||
% Please edit documentation in R/strobe_log.R
|
% Please edit documentation in R/print_log.R, R/strobe_log.R
|
||||||
\name{strobe_log}
|
\name{strobe_log}
|
||||||
\alias{strobe_log}
|
\alias{strobe_log}
|
||||||
\title{Print regression results according to STROBE}
|
\title{Print regression results according to STROBE}
|
||||||
\usage{
|
\usage{
|
||||||
|
strobe_log(meas, var, adj, data, dec = 2)
|
||||||
|
|
||||||
strobe_log(meas, var, adj, data, dec = 2)
|
strobe_log(meas, var, adj, data, dec = 2)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
@ -19,5 +21,10 @@ strobe_log(meas, var, adj, data, dec = 2)
|
|||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Printable table of logistic regression analysis according to STROBE.
|
Printable table of logistic regression analysis according to STROBE.
|
||||||
|
|
||||||
|
Print regression results according to STROBE
|
||||||
|
}
|
||||||
|
\details{
|
||||||
|
Printable table of logistic regression analysis according to STROBE.
|
||||||
}
|
}
|
||||||
\keyword{logistic}
|
\keyword{logistic}
|
||||||
|
@ -1,9 +1,11 @@
|
|||||||
% Generated by roxygen2: do not edit by hand
|
% Generated by roxygen2: do not edit by hand
|
||||||
% Please edit documentation in R/strobe_olr.R
|
% Please edit documentation in R/print_olr.R, R/strobe_olr.R
|
||||||
\name{strobe_olr}
|
\name{strobe_olr}
|
||||||
\alias{strobe_olr}
|
\alias{strobe_olr}
|
||||||
\title{Print ordinal logistic regression results according to STROBE}
|
\title{Print ordinal logistic regression results according to STROBE}
|
||||||
\usage{
|
\usage{
|
||||||
|
strobe_olr(meas, vars, data, dec = 2, n.by.adj = FALSE)
|
||||||
|
|
||||||
strobe_olr(meas, vars, data, dec = 2, n.by.adj = FALSE)
|
strobe_olr(meas, vars, data, dec = 2, n.by.adj = FALSE)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
@ -21,5 +23,12 @@ strobe_olr(meas, vars, data, dec = 2, n.by.adj = FALSE)
|
|||||||
Printable table of ordinal logistic regression with bivariate and multivariate analyses.
|
Printable table of ordinal logistic regression with bivariate and multivariate analyses.
|
||||||
Table according to STROBE. Uses polr() funtion of the MASS-package.
|
Table according to STROBE. Uses polr() funtion of the MASS-package.
|
||||||
Formula analysed is the most simple m~v1+v2+vn. The is no significance test. Results are point estimates with 95 percent CI.
|
Formula analysed is the most simple m~v1+v2+vn. The is no significance test. Results are point estimates with 95 percent CI.
|
||||||
|
|
||||||
|
Print ordinal logistic regression results according to STROBE
|
||||||
|
}
|
||||||
|
\details{
|
||||||
|
Printable table of ordinal logistic regression with bivariate and multivariate analyses.
|
||||||
|
Table according to STROBE. Uses polr() funtion of the MASS-package.
|
||||||
|
Formula analysed is the most simple m~v1+v2+vn. The is no significance test. Results are point estimates with 95 percent CI.
|
||||||
}
|
}
|
||||||
\keyword{olr}
|
\keyword{olr}
|
||||||
|
@ -1,9 +1,11 @@
|
|||||||
% Generated by roxygen2: do not edit by hand
|
% Generated by roxygen2: do not edit by hand
|
||||||
% Please edit documentation in R/strobe_pred.R
|
% Please edit documentation in R/print_pred.R, R/strobe_pred.R
|
||||||
\name{strobe_pred}
|
\name{strobe_pred}
|
||||||
\alias{strobe_pred}
|
\alias{strobe_pred}
|
||||||
\title{Regression model of predictors according to STROBE, bi- and multivariable.}
|
\title{Regression model of predictors according to STROBE, bi- and multivariable.}
|
||||||
\usage{
|
\usage{
|
||||||
|
strobe_pred(meas, adj, data, dec = 2, n.by.adj = FALSE, p.val = FALSE)
|
||||||
|
|
||||||
strobe_pred(meas, adj, data, dec = 2, n.by.adj = FALSE, p.val = FALSE)
|
strobe_pred(meas, adj, data, dec = 2, n.by.adj = FALSE, p.val = FALSE)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
@ -25,5 +27,14 @@ Includes both bivariate and multivariate in the same table.
|
|||||||
Output is a list, with the first item being the main "output" as a dataframe.
|
Output is a list, with the first item being the main "output" as a dataframe.
|
||||||
Automatically uses logistic regression model for dichotomous outcome variable and linear regression model for continuous outcome variable. Linear regression will give estimated adjusted true mean in list.
|
Automatically uses logistic regression model for dichotomous outcome variable and linear regression model for continuous outcome variable. Linear regression will give estimated adjusted true mean in list.
|
||||||
For logistic regression gives count of outcome variable pr variable level.
|
For logistic regression gives count of outcome variable pr variable level.
|
||||||
|
|
||||||
|
Regression model of predictors according to STROBE, bi- and multivariable.
|
||||||
|
}
|
||||||
|
\details{
|
||||||
|
Printable table of regression model according to STROBE for linear or binary outcome-variables.
|
||||||
|
Includes both bivariate and multivariate in the same table.
|
||||||
|
Output is a list, with the first item being the main "output" as a dataframe.
|
||||||
|
Automatically uses logistic regression model for dichotomous outcome variable and linear regression model for continuous outcome variable. Linear regression will give estimated adjusted true mean in list.
|
||||||
|
For logistic regression gives count of outcome variable pr variable level.
|
||||||
}
|
}
|
||||||
\keyword{logistic}
|
\keyword{logistic}
|
||||||
|
Loading…
Reference in New Issue
Block a user