andreas/daDoctoR
1
0
Fork 0
mirror of https://github.com/agdamsbo/daDoctoR.git synced 2024-11-21 19:30:22 +01:00
Code Issues Projects Releases Wiki Activity

rewritten olr_strobe

Browse Source
This commit is contained in:
agdamsbo 2019-12-03 10:03:38 +01:00
parent ad91fc05f3
commit 6be25dd145
3 changed files with 153 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

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

142
R/strobe_olr.R
View File

@ -1,72 +1,132 @@
#' Print ordinal logistic regression results according to STROBE
#'
#' Printable table of ordinal logistic regression analysis oaccording to STROBE. Uses polr() funtion of the MASS-package.
#' @param meas outcome meassure variable name in data-data.frame as a string. Can be numeric or factor. Result is calculated accordingly.
#' 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){
strobe_olr<-function(meas,vars,data,dec=2,n.by.adj=FALSE){
require(MASS)
require(dplyr)
d<-data
m<-d[,c(meas)]
v<-d[,c(vars)]
dat<-data.frame(m,v)
ads<-d[,c(vars)]
ma <- polr(m ~ ., data = dat, Hess=TRUE)
if(!is.factor(m)){stop("'meas' should be a factor, preferably ordered.")}
actable <- coef(summary(ma))
pa <- pnorm(abs(actable[, "t value"]), lower.tail = FALSE) * 2
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))
if(is.factor(m)){
apv<-pa[1:length(coef(ma))]
## 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)
aci<-round(exp(confint(ma)),dec)
suppressMessages(aci<-round(exp(confint(ma)),dec))
alo<-aci[,1]
aup<-aci[,2]
aor_ci<-paste0(aco," (",alo," to ",aup,")")
dat2<-ma$model[,-1]
# names(dat2)<-c(var,names(ads))
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]
dr<-vec[vec==vr]
n<-as.numeric(length(dr))
nall<-as.numeric(nrow(dat2))
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]
ns<-names(dat2)[i]
n<-as.numeric(nrow(dat2))
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(ns,rt))
}
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])))
@ -75,17 +135,39 @@ strobe_olr<-function(meas,vars,data,dec=2){
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)
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")
df<-data.frame(coll)
header<-data.frame(matrix(paste0("Chance of higher ",meas),ncol = ncol(coll)),stringsAsFactors = F)
names(header)<-names(coll)
names(df)<-c("Variable","N","OR (95 % CI)","p value")
df<-data.frame(rbind(header,coll),stringsAsFactors = F)
return(df)
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)
}

10
man/strobe_olr.Rd
View File

@ -4,18 +4,22 @@
\alias{strobe_olr}
\title{Print ordinal logistic regression results according to STROBE}
\usage{
strobe_olr(meas, vars, data, dec = 2)
strobe_olr(meas, vars, data, dec = 2, n.by.adj = FALSE)
}
\arguments{
\item{meas}{outcome meassure variable name in data-data.frame as a string. Can be numeric or factor. Result is calculated accordingly.}
\item{meas}{outcome meassure variable name or response in data-data.frame as a string. Should be factor, preferably ordered.}
\item{vars}{variables to compare against. As vector of columnnames.}
\item{data}{dataframe of data.}
\item{dec}{decimals for results, standard is set to 2. Mean and sd is dec-1.}
\item{n.by.adj}{flag to indicate wether to count number of patients in adjusted model or overall for outcome meassure not NA.}
}
\description{
Printable table of ordinal logistic regression analysis oaccording to STROBE. Uses polr() funtion of the MASS-package.
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}