new function & update

DESCRIPTION

@@ -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. 

NAMESPACE

@@ -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)

R/rep_glm.R

@@ -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,10 +21,81 @@
 #'   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)]
 
+  if(!is.factor(y)){stop("y is not a factor")}
+
+  if (fixed.var==FALSE){
+    d<-data
+    x<-data.frame(d[,c(vars,string)])
+
+    y<-d[,c(meas)]
+
+    names(x)<-c(vars,string)
+
+    if (ci==TRUE){
+
+      df<-data.frame(matrix(NA,ncol = 3))
+      names(df)<-c("pred","or_ci","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)
+
+        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]
+
+        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))
+      }
+    }
+
+    else {
+
+      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)
+
+        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)])
@@ -43,8 +115,9 @@ rep_glm<-function(meas,vars,string,ci=FALSE,data){
         dat<-cbind(dt,x[,i])
         m<-glm(y~.,family = binomial(),data=dat)
 
-      l<-suppressMessages(round(exp(confint(m))[-c(1:m1),1],2))
+        ci<-exp(confint(m))
-      u<-suppressMessages(round(exp(confint(m))[-c(1:m1),2],2))
+        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)
@@ -89,7 +162,7 @@ rep_glm<-function(meas,vars,string,ci=FALSE,data){
                  ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
 
     r<-data.frame(df[,1:2],pa,t)[-1,]
-
+  }
   return(r)
 }
 

R/rep_lm.R

@@ -5,16 +5,87 @@
 #' @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)]
 
+  if(is.factor(y)){stop("y is factor")}
+
+  if (fixed.var==FALSE){
+    d<-data
+    x<-data.frame(d[,c(vars,string)])
+
+    y<-d[,c(meas)]
+    dt<-cbind(y=y,v)
+    names(x)<-c(vars,string)
+
+    if (ci==TRUE){
+
+      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)
+
+        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]
+
+        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<-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)])
@@ -25,8 +96,6 @@ rep_lm<-function(meas,vars,string,ci=FALSE,data){
 
     names(v)<-c(vars)
 
-  if (is.factor(y)){stop("y should not be a factor!")}
-
     if (ci==TRUE){
 
       df<-data.frame(matrix(NA,ncol = 3))
@@ -78,6 +147,6 @@ rep_lm<-function(meas,vars,string,ci=FALSE,data){
                  ifelse(pa>0.05&pa<=0.1,paste0(".",pa),pa))
 
     r<-data.frame(df[,1:2],pa,t)[-1,]
-
+  }
   return(r)
 }

R/strobe_log.R

@@ -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)
+}

R/strobe_olr.R

@@ -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()

man/rep_glm.Rd

@@ -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.}

man/rep_lm.Rd

@@ -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.

man/strobe_log.Rd

@@ -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}

man/strobe_olr.Rd

@@ -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}