andreas/daDoctoR
1
0
Fork 0
mirror of https://github.com/agdamsbo/daDoctoR.git synced 2024-12-04 17:21:53 +01:00
Code Issues Projects Releases Wiki Activity

Updated counting

Browse Source
This commit is contained in:
agdamsbo 2019-12-13 11:58:21 +01:00
parent 6bd9e0508b
commit 36a0862645
2 changed files with 157 additions and 175 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 Package: daDoctoR
Title: Functions For Health Research Title: Functions For Health Research
Version: 0.19.11 Version: 0.19.12
Year: 2019 Year: 2019
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>

146
R/strobe_pred.R
View File

@ -84,59 +84,50 @@ strobe_pred<-function(meas,adj,data,dec=2,n.by.adj=FALSE,p.val=FALSE){
# names(dat2)<-c(var,names(ads)) # names(dat2)<-c(var,names(ads))
nq<-c() nq<-c()
nall<-length(!is.na(dat[,1]))
if (n.by.adj==TRUE){ if (n.by.adj==TRUE){
dat2<-ma$model[,-1] dat2<-ma$model[,-1]
# nalt<-nrow(dat2)
for (i in 1:ncol(dat2)){ for (i in 1:ncol(dat2)){
if (is.factor(dat2[,i])){ if (is.factor(dat2[,i])){
vec<-dat2[,i] vec<-dat2[,i]
ns<-names(dat2)[i] ns<-names(dat2)[i]
for (r in 1:length(levels(vec))){ for (r in 1:length(levels(vec))){
vr<-levels(vec)[r] vr<-levels(vec)[r]
n<-as.numeric(length(vec[vec==vr&!is.na(vec)])) n<-length(vec[vec==vr&!is.na(vec)])
nall<-as.numeric(length(dat2[,c(ns)])) rt<-paste0(n," (",round(n/nall*100,0),"%)")
n.meas<-nall nq<-rbind(nq,cbind(paste0(ns,levels(vec)[r]),rt))
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])){ if (!is.factor(dat2[,i])){
num<-dat2[,i] num<-dat2[,i]
nl<-names(dat2)[i]
n<-as.numeric(length(num[!is.na(num)])) n<-as.numeric(length(num[!is.na(num)]))
nall<-as.numeric(nrow(dat2)) rt<-paste0(n," (",round(n/nall*100,0),"%)")
n.meas<-nall nq<-rbind(nq,cbind(names(dat2)[i],rt))
pro<-round(n/nall*100,0) }}
rt<-paste0(n," (",pro,"%)") }
nq<-rbind(nq,cbind(nl,rt))
}}}
else { else {
dat2<-dat[!is.na(dat[,1]),][,-1] dat2<-dat[!is.na(dat[,1]),][,-1]
n.meas<-nrow(dat2) for (i in 1:ncol(dat2)) {
for (i in 1:ncol(dat2)){ if (is.factor(dat2[, i])) {
if (is.factor(dat2[,i])){ vec <- dat2[, i]
vec<-dat2[,i] ns <- names(dat2)[i]
ns<-names(dat2)[i] for (r in 1:length(levels(vec))) {
for (r in 1:length(levels(vec))){ vr <- levels(vec)[r]
vr<-levels(vec)[r] n <- length(vec[vec == vr & !is.na(vec)])
n<-as.numeric(length(vec[vec==vr&!is.na(vec)])) rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
nall<-as.numeric(n.mn[i]) nq <- rbind(nq, cbind(paste0(ns, levels(vec)[r]), rt))
nl<-paste0(ns,levels(vec)[r]) }
pro<-round(n/nall*100,0) }
rt<-paste0(n," (",pro,"%)") if (!is.factor(dat2[, i])) {
nq<-rbind(nq,cbind(nl,rt)) num <- dat2[, i]
}} n <- length(num[!is.na(num)])
if (!is.factor(dat2[,i])){ rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
num<-dat2[,i] nq <- rbind(nq, cbind(names(dat2)[i], rt))
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() rnames<-c()
for (i in 1:ncol(dat2)){ for (i in 1:ncol(dat2)){
@ -150,7 +141,7 @@ strobe_pred<-function(meas,adj,data,dec=2,n.by.adj=FALSE,p.val=FALSE){
res<-cbind(aor_ci,apv) res<-cbind(aor_ci,apv)
rest<-data.frame(names=row.names(res),res,stringsAsFactors = F) rest<-data.frame(names=row.names(res),res,stringsAsFactors = F)
numb<-data.frame(names=nq[,c("nl")],N=nq[,c("rt")],stringsAsFactors = F) numb<-data.frame(names=nq[,1],N=nq[,2],stringsAsFactors = F)
namt<-data.frame(names=rnames,stringsAsFactors = F) namt<-data.frame(names=rnames,stringsAsFactors = F)
coll<-left_join(left_join(namt,numb,by="names"),rest,by="names") coll<-left_join(left_join(namt,numb,by="names"),rest,by="names")
@ -176,15 +167,15 @@ strobe_pred<-function(meas,adj,data,dec=2,n.by.adj=FALSE,p.val=FALSE){
if (p.val==TRUE){ if (p.val==TRUE){
ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,6],re[,3],re[,4]) ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,6],re[,3],re[,4])
names(ref)<-c("Variable",paste0("N=",n.meas),"Crude OR (95 % CI)","p-value","Mutually adjusted OR (95 % CI)","A p-value") names(ref)<-c("Variable",paste0("N=",nall),"Crude OR (95 % CI)","p-value","Mutually adjusted OR (95 % CI)","A p-value")
} }
else{ else{
ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,3]) ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,3])
names(ref)<-c("Variable",paste0("N=",n.meas),"Crude OR (95 % CI)","Mutually adjusted OR (95 % CI)") names(ref)<-c("Variable",paste0("N=",nall),"Crude OR (95 % CI)","Mutually adjusted OR (95 % CI)")
} }
ls<-list(tbl=ref,miss,n.meas,nrow(d)) 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") names(ls)<-c("Printable table","Deleted due to missingness in adjusted analysis","Number of outcome observations","Length of dataframe")
} }
@ -250,59 +241,50 @@ strobe_pred<-function(meas,adj,data,dec=2,n.by.adj=FALSE,p.val=FALSE){
nq<-c() nq<-c()
nall<-length(!is.na(dat[,1]))
if (n.by.adj==TRUE){ if (n.by.adj==TRUE){
dat2<-ma$model[,-1] dat2<-ma$model[,-1]
# nalt<-nrow(dat2)
for (i in 1:ncol(dat2)){ for (i in 1:ncol(dat2)){
if (is.factor(dat2[,i])){ if (is.factor(dat2[,i])){
vec<-dat2[,i] vec<-dat2[,i]
ns<-names(dat2)[i] ns<-names(dat2)[i]
for (r in 1:length(levels(vec))){ for (r in 1:length(levels(vec))){
vr<-levels(vec)[r] vr<-levels(vec)[r]
n<-as.numeric(length(vec[vec==vr&!is.na(vec)])) n<-length(vec[vec==vr&!is.na(vec)])
nall<-as.numeric(length(dat2[,c(ns)])) rt<-paste0(n," (",round(n/nall*100,0),"%)")
n.meas<-nall nq<-rbind(nq,cbind(paste0(ns,levels(vec)[r]),rt))
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])){ if (!is.factor(dat2[,i])){
num<-dat2[,i] num<-dat2[,i]
nl<-names(dat2)[i]
n<-as.numeric(length(num[!is.na(num)])) n<-as.numeric(length(num[!is.na(num)]))
nall<-as.numeric(nrow(dat2)) rt<-paste0(n," (",round(n/nall*100,0),"%)")
n.meas<-nall nq<-rbind(nq,cbind(names(dat2)[i],rt))
pro<-round(n/nall*100,0) }}
rt<-paste0(n," (",pro,"%)") }
nq<-rbind(nq,cbind(nl,rt))
}}}
else { else {
dat2<-dat[!is.na(dat[,1]),][,-1] dat2<-dat[!is.na(dat[,1]),][,-1]
n.meas<-nrow(dat2) for (i in 1:ncol(dat2)) {
for (i in 1:ncol(dat2)){ if (is.factor(dat2[, i])) {
if (is.factor(dat2[,i])){ vec <- dat2[, i]
vec<-dat2[,i] ns <- names(dat2)[i]
ns<-names(dat2)[i] for (r in 1:length(levels(vec))) {
for (r in 1:length(levels(vec))){ vr <- levels(vec)[r]
vr<-levels(vec)[r] n <- length(vec[vec == vr & !is.na(vec)])
n<-as.numeric(length(vec[vec==vr&!is.na(vec)])) rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
nall<-as.numeric(n.mn[i]) nq <- rbind(nq, cbind(paste0(ns, levels(vec)[r]), rt))
nl<-paste0(ns,levels(vec)[r]) }
pro<-round(n/nall*100,0) }
rt<-paste0(n," (",pro,"%)") if (!is.factor(dat2[, i])) {
nq<-rbind(nq,cbind(nl,rt)) num <- dat2[, i]
}} n <- length(num[!is.na(num)])
if (!is.factor(dat2[,i])){ rt <- paste0(n, " (", round(n/nall * 100, 0), "%)")
num<-dat2[,i] nq <- rbind(nq, cbind(names(dat2)[i], rt))
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() rnames<-c()
@ -317,7 +299,7 @@ strobe_pred<-function(meas,adj,data,dec=2,n.by.adj=FALSE,p.val=FALSE){
res<-cbind(amean_ci,apv) res<-cbind(amean_ci,apv)
rest<-data.frame(names=row.names(res),res,stringsAsFactors = F) rest<-data.frame(names=row.names(res),res,stringsAsFactors = F)
numb<-data.frame(names=nq[,c("nl")],N=nq[,c("rt")],stringsAsFactors = F) numb<-data.frame(names=nq[,1],N=nq[,2],stringsAsFactors = F)
namt<-data.frame(names=rnames,stringsAsFactors = F) namt<-data.frame(names=rnames,stringsAsFactors = F)
coll<-left_join(left_join(namt,numb,by="names"),rest,by="names") coll<-left_join(left_join(namt,numb,by="names"),rest,by="names")
@ -343,15 +325,15 @@ strobe_pred<-function(meas,adj,data,dec=2,n.by.adj=FALSE,p.val=FALSE){
if (p.val==TRUE){ if (p.val==TRUE){
ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,6],re[,3],re[,4]) ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,6],re[,3],re[,4])
names(ref)<-c("Variable",paste0("N=",n.meas),"Difference (95 % CI)","p-value","Mutually adjusted difference (95 % CI)","A p-value") names(ref)<-c("Variable",paste0("N=",nall),"Difference (95 % CI)","p-value","Mutually adjusted difference (95 % CI)","A p-value")
} }
else{ else{
ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,3]) ref<-data.frame(c(NA,rona),re[,2],re[,5],re[,3])
names(ref)<-c("Variable",paste0("N=",n.meas),"Difference (95 % CI)","Mutually adjusted difference (95 % CI)") names(ref)<-c("Variable",paste0("N=",nall),"Difference (95 % CI)","Mutually adjusted difference (95 % CI)")
} }
ls<-list(tbl=ref,miss,n.meas,nrow(d),mean_est) 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") 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")
} }