new functions with new names to substitute old "strobe"-functions

This commit is contained in:
Andreas Gammelgaard Damsbo 2021-06-11 12:07:55 +02:00
parent 96479031e5
commit d8ffa3dc7b
16 changed files with 1025 additions and 8 deletions

View File

@ -1,6 +1,6 @@
Package: daDoctoR
Title: Functions For Health Research
Version: 0.21.4
Version: 0.21.5
Year: 2021
Author: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>
Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>

148
R/print_diff_bygroup.R Normal file
View 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
View 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
View 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
View 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
View 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)
}

View File

@ -1,4 +1,4 @@
#' REWRITE UNDERWAY
#' REWRITE UNDERWAY - replaced by 'print_diff_bygroup'
#'
#' Print regression results according to STROBE
#'

View File

@ -1,4 +1,4 @@
#' REWRITE UNDERWAY
#' REWRITE UNDERWAY - replaced by 'print_diff_byvar'
#'
#' Print regression results according to STROBE
#'

View File

@ -1,3 +1,5 @@
#' OBSOLETE - use 'print_log'
#'
#' Print regression results according to STROBE
#'
#' Printable table of logistic regression analysis according to STROBE.

View File

@ -1,3 +1,5 @@
#' OBSOLETE - use 'print_olr'
#'
#' Print ordinal logistic regression results according to STROBE
#'
#' Printable table of ordinal logistic regression with bivariate and multivariate analyses.

View File

@ -1,3 +1,5 @@
#' OBSOLETE - use 'print_pred'
#'
#' Regression model of predictors according to STROBE, bi- and multivariable.
#'
#' Printable table of regression model according to STROBE for linear or binary outcome-variables.

View File

@ -1,9 +1,11 @@
% 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}
\alias{strobe_diff_bygroup}
\title{REWRITE UNDERWAY}
\usage{
strobe_diff_bygroup(meas, var, group, adj, data, dec = 2)
strobe_diff_bygroup(meas, var, group, adj, data, dec = 2)
}
\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.}
}
\description{
Print regression results according to STROBE
Print regression results according to STROBE
}
\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
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$am<-factor(mtcars$am)
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}

View File

@ -1,9 +1,11 @@
% 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}
\alias{strobe_diff_byvar}
\title{REWRITE UNDERWAY}
\usage{
strobe_diff_byvar(meas, var, group, adj, data, dec = 2)
strobe_diff_byvar(meas, var, group, adj, data, dec = 2)
}
\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.}
}
\description{
Print regression results according to STROBE
Print regression results according to STROBE
}
\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.
}
\examples{
@ -30,5 +36,9 @@ Printable table of three dimensional regression analysis of group vs var for mea
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)
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}

View File

@ -1,9 +1,11 @@
% 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}
\alias{strobe_log}
\title{Print regression results according to STROBE}
\usage{
strobe_log(meas, var, adj, data, dec = 2)
strobe_log(meas, var, adj, data, dec = 2)
}
\arguments{
@ -19,5 +21,10 @@ strobe_log(meas, var, adj, data, dec = 2)
}
\description{
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}

View File

@ -1,9 +1,11 @@
% 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}
\alias{strobe_olr}
\title{Print ordinal logistic regression results according to STROBE}
\usage{
strobe_olr(meas, vars, data, dec = 2, n.by.adj = FALSE)
strobe_olr(meas, vars, data, dec = 2, n.by.adj = FALSE)
}
\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.
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.
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}

View File

@ -1,9 +1,11 @@
% 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}
\alias{strobe_pred}
\title{Regression model of predictors according to STROBE, bi- and multivariable.}
\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)
}
\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.
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.
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}