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

update to function

Browse Source
This commit is contained in:
agdamsbo 2018-10-24 12:22:54 +02:00
parent 24a7f6ffc8
commit fc2dea7f18
1 changed files with 12 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
R/strobe_olr.R
View File

@ -2,8 +2,7 @@
#'
#' Printable table of logistic regression analysis oaccording 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 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.
#' @keywords olr
@ -11,63 +10,19 @@
#' @examples
#' strobe_olr()
strobe_olr<-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.
##
strobe_olr<-function(meas,vars,data,dec=2){
require(MASS)
require(dplyr)
d<-data
m<-d[,c(meas)]
v<-d[,c(var)]
v<-d[,c(vars)]
ads<-d[,c(adj)]
dat<-data.frame(m,v)
df<-data.frame(matrix(ncol=4))
mn <- polr(m ~ ., data = dat, Hess=TRUE)
dat<-data.frame(dat,ads)
ma <- polr(m ~ ., data = dat, Hess=TRUE)
ctable <- coef(summary(mn))
pa <- pnorm(abs(ctable[, "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))
pv<-c("REF",pa[1:length(coef(mn))])
co<-round(exp(coef(mn)),dec)
ci<-confint(mn)
lo<-round(exp(ci[,1]),dec)
up<-round(exp(ci[,2]),dec)
or_ci<-c("REF",paste0(co," (",lo," to ",up,")"))
nr<-c()
for (r in 1:length(levels(dat[,2]))){
vr<-levels(mn$model[,2])[r]
dr<-mn$model[mn$model[,2]==vr,]
n<-as.numeric(nrow(dr))
## Af en eller anden grund bliver der talt for mange med.
nall<-as.numeric(nrow(mn$model))
nl<-levels(m)[r]
pro<-round(n/nall*100,0)
rt<-paste0(n," (",pro,"%)")
nr<-rbind(nr,cbind(nl,rt))
}
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 <- pnorm(abs(actable[, "t value"]), lower.tail = FALSE) * 2
pa<-ifelse(pa<0.001,"<0.001",round(pa,3))
@ -82,19 +37,19 @@ strobe_olr<-function(meas,var,adj,data,dec=2){
aup<-aci[,2]
aor_ci<-paste0(aco," (",alo," to ",aup,")")
dat2<-dat[,-1]
dat2<-ma$model[,-1]
# names(dat2)<-c(var,names(ads))
nq<-c()
for (i in 1:ncol(dat2)){
if (is.factor(dat2[,i])){
vec<-ma$model[,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(ma$model))
nall<-as.numeric(nrow(dat2))
nl<-paste0(ns,levels(vec)[r])
pro<-round(n/nall*100,0)
rt<-paste0(n," (",pro,"%)")
@ -104,8 +59,8 @@ strobe_olr<-function(meas,var,adj,data,dec=2){
if (!is.factor(dat2[,i])){
num<-dat2[,i]
ns<-names(dat2)[i]
n<-as.numeric(nrow(ma$model))
nall<-as.numeric(nrow(ma$model))
n<-as.numeric(nrow(dat2))
nall<-as.numeric(nrow(dat2))
pro<-round(n/nall*100,0)
rt<-paste0(n," (",pro,"%)")
nq<-rbind(nq,cbind(ns,rt))
@ -130,15 +85,9 @@ strobe_olr<-function(meas,var,adj,data,dec=2){
coll<-left_join(left_join(namt,numb,by="names"),rest,by="names")
header<-data.frame(matrix("Adjusted",ncol = ncol(coll)))
names(header)<-names(coll)
df<-data.frame(coll)
ls$adjusted<-data.frame(rbind(header,coll))
names(df)<-c("Variable","N","OR (95 % CI)","p value")
fnames<-c("Variable","N","OR (95 % CI)","p value")
names(ls$unadjusted)<-fnames
names(ls$adjusted)<-fnames
return(ls)
return(df)
}