updates

DESCRIPTION

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

R/rep_olr.R

@@ -3,96 +3,84 @@
 #' For bivariate analyses. The confint() function is rather slow, causing the whole function to hang when including many predictors and calculating the ORs with CI.
 #' @param meas Effect meassure. Input as c() of columnnames, use dput().
 #' @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 percent confidence interval.
 #' @param data data.frame to pull variables from.
+#' @param ctp cut point for drop/include. Standard 0.1.
 #' @keywords olr
 #' @export
 
-rep_olr<-function(meas,vars,string,ci=FALSE,data){
-
+rep_olr<-function (meas, vars, ci = FALSE, data,ctp=0.1)
+{
   require(broom)
   require(MASS)
-
-  d<-data
-  x<-data.frame(d[,c(string)])
-  v<-data.frame(d[,c(vars)])
-  names(v)<-c(vars)
+  d <- dta
+  x <- data.frame(d[, c(vars)])
+  names(x) <- c(vars)
   y <- d[, c(meas)]
-  dt<-cbind(y,v)
+  dt <- cbind(y, x)
   m1 <- length(coef(polr(y ~ ., data = dt, Hess = TRUE)))
-
-  if (!is.factor(y)){stop("y should be a factor!")}
-
+  if (!is.factor(y)) {
+    stop("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])
+      dat <- data.frame(y = y, x[, i])
+      names(dat) <- c("y", names(x)[i])
       m <- polr(y ~ ., data = dat, Hess = TRUE)
-
       ctable <- coef(summary(m))
 
-      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)
+      conf<-suppressMessages(matrix(exp(confint(m)),ncol=2))
+      l <- round(conf[,1], 2)
+      u <- round(conf[,2], 2)
+      or <- round(exp(coef(m)), 2)
+
       or_ci <- paste0(or, " (", l, " to ", u, ")")
 
-      p <- (pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2)[1:length(coef(m))]
-      pv<-round(p[-c(1:m1)],3)
-
+      p <- (pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) *
+              2)[1:length(coef(m))]
+      pv <- round(p, 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<-polr(y~.,data=dat,Hess=TRUE)
-
-      ctable <- coef(summary(m))
-
-      b<-round(coef(m)[-c(1:m1)],2)
-
-      p <- (pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2)[1:length(coef(m))]
-      pv<-round(p[-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 <- data.frame(y = y, x[, i])
+      names(dat) <- c("y", names(x)[i])
+      m <- polr(y ~ ., data = dat, Hess = TRUE)
+      ctable <- coef(summary(m))
+      b <- round(coef(m), 2)
 
-      else {pred<-names(x)[i]}
+      p <- (pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) *
+              2)[1:length(coef(m))]
+      pv <- round(p, 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[, c("pv")])
-  t <- ifelse(pa<=0.1,"include","drop")
+  t <- ifelse(pa <= ctp, "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)
 }
-
-
-
-

R/strobe_olr.R

@@ -12,6 +12,7 @@
 #' @export
 
 strobe_olr<-function(meas,vars,data,dec=2,n.by.adj=FALSE){
+## For calculation of p-value from t-value see rep_olr()
 
   require(MASS)
   require(dplyr)

man/rep_olr.Rd

@@ -4,18 +4,18 @@
 \alias{rep_olr}
 \title{A repeated ordinal logistic regression function}
 \usage{
-rep_olr(meas, vars, string, ci = FALSE, data)
+rep_olr(meas, vars, ci = FALSE, data, ctp = 0.1)
 }
 \arguments{
 \item{meas}{Effect meassure. Input as c() of columnnames, use dput().}
 
 \item{vars}{variables in model. Input as c() of columnnames, use dput().}
 
-\item{string}{variables to test. Input as c() of columnnames, use dput().}
-
 \item{ci}{flag to get results as OR with 95 percent confidence interval.}
 
 \item{data}{data.frame to pull variables from.}
+
+\item{ctp}{cut point for drop/include. Standard 0.1.}
 }
 \description{
 For bivariate analyses. The confint() function is rather slow, causing the whole function to hang when including many predictors and calculating the ORs with CI.