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

new function & update

Browse Source
This commit is contained in:
agdamsbo 2018-10-11 15:34:44 +02:00
parent 0378e6f24d
commit 634c647bdc
10 changed files with 421 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@ -1,7 +1,7 @@
Package: daDoctoR
Type: Package
Title: FUNCTIONS FOR HEALTH RESEARCH
Version: 0.1.0.9003
Version: 0.1.0.9005
Author@R: c(person("Andreas", "Gammelgaard Damsbo", email = "agdamsbo@pm.me", role = c("cre", "aut")))
Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>
Description: I am a Danish medical doctor involved in neuropsychiatric research.

1
NAMESPACE
View File

@ -20,4 +20,5 @@ export(rep_reg_cie)
export(strobe_diff_bygroup)
export(strobe_diff_byvar)
export(strobe_diff_twodim)
export(strobe_log)
export(strobe_olr)

171
R/rep_glm.R
View File

@ -6,6 +6,7 @@
#' @param str variables to test. Input as c() of columnnames, use dput().
#' @param ci flag to get results as OR with 95% confidence interval.
#' @param dta data frame to pull variables from.
#' @param fixed.var flag to set "vars" as fixed in the model. When FALSE, then true bivariate logistic regression is performed.
#' @keywords logistic
#' @export
#' @examples
@ -20,76 +21,148 @@
#' rep_glm(meas="y",vars="v3",string=preds,ci=F,data=d)
rep_glm<-function(meas,vars,string,ci=FALSE,data){
rep_glm<-function(meas,vars,string,ci=FALSE,data,fixed.var=FALSE){
require(broom)
y<-data[,c(meas)]
d<-data
x<-data.frame(d[,c(string)])
v<-data.frame(d[,c(vars)])
names(v)<-c(vars)
y<-d[,c(meas)]
dt<-cbind(y,v)
m1<-length(coef(glm(y~.,family = binomial(),data = dt)))
if(!is.factor(y)){stop("y is not a factor")}
if (!is.factor(y)){stop("Some kind of error message would be nice, but y should be a factor!")}
if (fixed.var==FALSE){
d<-data
x<-data.frame(d[,c(vars,string)])
if (ci==TRUE){
y<-d[,c(meas)]
df<-data.frame(matrix(ncol = 3))
names(df)<-c("pred","or_ci","pv")
names(x)<-c(vars,string)
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-glm(y~.,family = binomial(),data=dat)
if (ci==TRUE){
l<-suppressMessages(round(exp(confint(m))[-c(1:m1),1],2))
u<-suppressMessages(round(exp(confint(m))[-c(1:m1),2],2))
or<-round(exp(coef(m))[-c(1:m1)],2)
or_ci<-paste0(or," (",l," to ",u,")")
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
x1<-x[,i]
df<-data.frame(matrix(NA,ncol = 3))
names(df)<-c("pred","or_ci","pv")
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")}
for(i in 1:ncol(x)){
dat<-data.frame(y=y,x[,i])
names(dat)<-c("y",names(x)[i])
m<-glm(y~.,family = binomial(),data=dat)
else {pred<-names(x)[i]}
suppressMessages(ci<-exp(confint(m)))
l<-round(ci[-1,1],2)
u<-round(ci[-1,2],2)
or<-round(exp(coef(m))[-1],2)
or_ci<-paste0(or," (",l," to ",u,")")
pv<-round(tidy(m)$p.value[-1],3)
x1<-x[,i]
df<-rbind(df,cbind(pred,or_ci,pv))}}
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
}
if (ci==FALSE){
else {pred<-names(x)[i]}
df<-data.frame(matrix(ncol = 3))
names(df)<-c("pred","b","pv")
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-glm(y~.,family = binomial(),data=dat)
b<-round(coef(m)[-c(1:m1)],3)
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
x1<-x[,i]
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
df<-rbind(df,cbind(pred,or_ci,pv))
}
}
else {pred<-names(x)[i]}
else {
df<-rbind(df,cbind(pred,b,pv))
df<-data.frame(matrix(NA,ncol = 3))
names(df)<-c("pred","b","pv")
}}
for(i in 1:ncol(x)){
dat<-data.frame(y=y,x[,i])
names(dat)<-c("y",names(x)[i])
m<-glm(y~.,family = binomial(),data=dat)
pa<-as.numeric(df[,"pv"])
t <- ifelse(pa<=0.1,"include","drop")
b<-round(coef(m)[-1],3)
pv<-round(tidy(m)$p.value[-1],3)
x1<-x[,i]
pa<-ifelse(pa<0.001,"<0.001",pa)
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
}
else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,b,pv))
}}
r<-data.frame(df[,1:2],pa,t)[-1,]
pa<-as.numeric(df[,3])
t <- ifelse(pa<=0.1,"include","drop")
pa<-ifelse(pa<0.001,"<0.001",pa)
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
r<-data.frame(df[,1:2],pa,t)[-1,]
}
if (fixed.var==TRUE){
d<-data
x<-data.frame(d[,c(string)])
v<-data.frame(d[,c(vars)])
names(v)<-c(vars)
y<-d[,c(meas)]
dt<-cbind(y,v)
m1<-length(coef(glm(y~.,family = binomial(),data = dt)))
if (!is.factor(y)){stop("Some kind of error message would be nice, but y should be a factor!")}
if (ci==TRUE){
df<-data.frame(matrix(ncol = 3))
names(df)<-c("pred","or_ci","pv")
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-glm(y~.,family = binomial(),data=dat)
ci<-exp(confint(m))
l<-suppressMessages(round(ci[-c(1:m1),1],2))
u<-suppressMessages(round(ci[-c(1:m1),2],2))
or<-round(exp(coef(m))[-c(1:m1)],2)
or_ci<-paste0(or," (",l," to ",u,")")
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
x1<-x[,i]
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")}
else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,or_ci,pv))}}
if (ci==FALSE){
df<-data.frame(matrix(ncol = 3))
names(df)<-c("pred","b","pv")
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-glm(y~.,family = binomial(),data=dat)
b<-round(coef(m)[-c(1:m1)],3)
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
x1<-x[,i]
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
}
else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,b,pv))
}}
pa<-as.numeric(df[,"pv"])
t <- ifelse(pa<=0.1,"include","drop")
pa<-ifelse(pa<0.001,"<0.001",pa)
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
r<-data.frame(df[,1:2],pa,t)[-1,]
}
return(r)
}

173
R/rep_lm.R
View File

@ -5,79 +5,148 @@
#' @param vars variables in model. Input as c() of columnnames, use dput().
#' @param string variables to test. Input as c() of columnnames, use dput().
#' @param ci flag to get results as OR with 95% confidence interval.
#' @param fixed.var flag to set "vars" as fixed in the model. When FALSE, then true bivariate linear regression is performed.
#' @param data data frame to pull variables from.
#' @keywords linear
#' @export
#' @examples
#' rep_lm()
rep_lm<-function(meas,vars,string,ci=FALSE,data){
rep_lm<-function(meas,vars,string,ci=FALSE,data,fixed.var=FALSE){
require(broom)
y<-data[,c(meas)]
d<-data
x<-data.frame(d[,c(string)])
v<-data.frame(d[,c(vars)])
if(is.factor(y)){stop("y is factor")}
y<-d[,c(meas)]
dt<-cbind(y=y,v)
m1<-length(coef(lm(y~.,data = dt)))
if (fixed.var==FALSE){
d<-data
x<-data.frame(d[,c(vars,string)])
names(v)<-c(vars)
y<-d[,c(meas)]
dt<-cbind(y=y,v)
names(x)<-c(vars,string)
if (is.factor(y)){stop("y should not be a factor!")}
if (ci==TRUE){
if (ci==TRUE){
df<-data.frame(matrix(NA,ncol = 3))
names(df)<-c("pred","coef_ci","pv")
df<-data.frame(matrix(NA,ncol = 3))
names(df)<-c("pred","coef_ci","pv")
for(i in 1:ncol(x)){
dat<-data.frame(y=y,x[,i])
names(dat)<-c("y",names(x)[i])
m<-lm(y~.,data=dat)
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-lm(y~.,data=dat)
ci<-suppressMessages(confint(m))
l<-round(ci[-1,1],2)
u<-round(ci[-1,2],2)
or<-round(coef(m)[-1],2)
coef_ci<-paste0(or," (",l," to ",u,")")
pv<-round(tidy(m)$p.value[-1],3)
x1<-x[,i]
ci<-suppressMessages(confint(m))
l<-round(ci[-c(1:m1),1],2)
u<-round(ci[-c(1:m1),2],2)
or<-round(coef(m)[-c(1:m1)],2)
coef_ci<-paste0(or," (",l," to ",u,")")
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
x1<-x[,i]
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
}
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")}
else {pred<-names(x)[i]}
else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,coef_ci,pv))}}
else {
df<-data.frame(matrix(NA,ncol = 3))
names(df)<-c("pred","b","pv")
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-lm(y~.,data=dat)
b<-round(coef(m)[-c(1:m1)],3)
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
x1<-x[,i]
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
df<-rbind(df,cbind(pred,coef_ci,pv))
}
else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,b,pv))
}}
}
pa<-as.numeric(df[,3])
t <- ifelse(pa<=0.1,"include","drop")
pa<-ifelse(pa<0.001,"<0.001",pa)
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
else {
r<-data.frame(df[,1:2],pa,t)[-1,]
df<-data.frame(matrix(NA,ncol = 3))
names(df)<-c("pred","b","pv")
for(i in 1:ncol(x)){
dat<-data.frame(y=y,x[,i])
names(dat)<-c("y",names(x)[i])
m<-lm(y~.,data=dat)
b<-round(coef(m)[-1],3)
pv<-round(tidy(m)$p.value[-1],3)
x1<-x[,i]
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
}
else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,b,pv))
}}
pa<-as.numeric(df[,3])
t <- ifelse(pa<=0.1,"include","drop")
pa<-ifelse(pa<0.001,"<0.001",pa)
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
r<-data.frame(df[,1:2],pa,t)[-1,]
}
if (fixed.var==TRUE){
d<-data
x<-data.frame(d[,c(string)])
v<-data.frame(d[,c(vars)])
y<-d[,c(meas)]
dt<-cbind(y=y,v)
m1<-length(coef(lm(y~.,data = dt)))
names(v)<-c(vars)
if (ci==TRUE){
df<-data.frame(matrix(NA,ncol = 3))
names(df)<-c("pred","coef_ci","pv")
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-lm(y~.,data=dat)
ci<-suppressMessages(confint(m))
l<-round(ci[-c(1:m1),1],2)
u<-round(ci[-c(1:m1),2],2)
or<-round(coef(m)[-c(1:m1)],2)
coef_ci<-paste0(or," (",l," to ",u,")")
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
x1<-x[,i]
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")}
else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,coef_ci,pv))}}
else {
df<-data.frame(matrix(NA,ncol = 3))
names(df)<-c("pred","b","pv")
for(i in 1:ncol(x)){
dat<-cbind(dt,x[,i])
m<-lm(y~.,data=dat)
b<-round(coef(m)[-c(1:m1)],3)
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
x1<-x[,i]
if (is.factor(x1)){
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")
}
else {pred<-names(x)[i]}
df<-rbind(df,cbind(pred,b,pv))
}}
pa<-as.numeric(df[,3])
t <- ifelse(pa<=0.1,"include","drop")
pa<-ifelse(pa<0.001,"<0.001",pa)
pa <- ifelse(pa<=0.05|pa=="<0.001",paste0("*",pa),
ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
r<-data.frame(df[,1:2],pa,t)[-1,]
}
return(r)
}

141
R/strobe_log.R Normal file
View File

@ -0,0 +1,141 @@
#' 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
#' @examples
#' strobe_log()
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)
}

4
R/strobe_olr.R
View File

@ -1,12 +1,12 @@
#' Print regression results according to STROBE
#'
#' Printable table of linear regression analysis of group vs var for meas. By group.
#' 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 data dataframe of data.
#' @param dec decimals for results, standard is set to 2. Mean and sd is dec-1.
#' @keywords strobe olr
#' @keywords olr
#' @export
#' @examples
#' strobe_olr()

4
man/rep_glm.Rd
View File

@ -4,7 +4,7 @@
\alias{rep_glm}
\title{A repeated logistic regression function}
\usage{
rep_glm(meas, vars, string, ci = FALSE, data)
rep_glm(meas, vars, string, ci = FALSE, data, fixed.var = FALSE)
}
\arguments{
\item{meas}{Effect meassure. Input as c() of columnnames, use dput().}
@ -13,6 +13,8 @@ rep_glm(meas, vars, string, ci = FALSE, data)
\item{ci}{flag to get results as OR with 95% confidence interval.}
\item{fixed.var}{flag to set "vars" as fixed in the model. When FALSE, then true bivariate logistic regression is performed.}
\item{str}{variables to test. Input as c() of columnnames, use dput().}
\item{dta}{data frame to pull variables from.}

4
man/rep_lm.Rd
View File

@ -4,7 +4,7 @@
\alias{rep_lm}
\title{A repeated linear regression function}
\usage{
rep_lm(meas, vars, string, ci = FALSE, data)
rep_lm(meas, vars, string, ci = FALSE, data, fixed.var = FALSE)
}
\arguments{
\item{meas}{Effect meassure. Input as c() of columnnames, use dput().}
@ -16,6 +16,8 @@ rep_lm(meas, vars, string, ci = FALSE, data)
\item{ci}{flag to get results as OR with 95% confidence interval.}
\item{data}{data frame to pull variables from.}
\item{fixed.var}{flag to set "vars" as fixed in the model. When FALSE, then true bivariate linear regression is performed.}
}
\description{
For bivariate analyses, to determine which variables to include in adjusted model.

26
man/strobe_log.Rd Normal file
View File

@ -0,0 +1,26 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in 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)
}
\arguments{
\item{meas}{outcome meassure variable name in data-data.frame as a string. Can be numeric or factor. Result is calculated accordingly.}
\item{var}{exposure variable to compare against (active vs placebo). As string.}
\item{adj}{variables to adjust for, as string.}
\item{data}{dataframe of data.}
\item{dec}{decimals for results, standard is set to 2. Mean and sd is dec-1.}
}
\description{
Printable table of logistic regression analysis according to STROBE.
}
\examples{
strobe_log()
}
\keyword{logistic}

3
man/strobe_olr.Rd
View File

@ -18,10 +18,9 @@ strobe_olr(meas, var, adj, data, dec = 2)
\item{dec}{decimals for results, standard is set to 2. Mean and sd is dec-1.}
}
\description{
Printable table of linear regression analysis of group vs var for meas. By group.
Printable table of logistic regression analysis oaccording to STROBE.
}
\examples{
strobe_olr()
}
\keyword{olr}
\keyword{strobe}