This commit is contained in:
agdamsbo 2019-12-03 13:16:44 +01:00
parent 6be25dd145
commit 1ba7567814
4 changed files with 69 additions and 80 deletions

View File

@ -1,6 +1,6 @@
Package: daDoctoR Package: daDoctoR
Title: Functions For Health Research Title: Functions For Health Research
Version: 0.19.4 Version: 0.19.5
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>

View File

@ -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. #' 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 meas Effect meassure. Input as c() of columnnames, use dput().
#' @param vars variables in model. 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 ci flag to get results as OR with 95 percent confidence interval.
#' @param data data.frame to pull variables from. #' @param data data.frame to pull variables from.
#' @param ctp cut point for drop/include. Standard 0.1.
#' @keywords olr #' @keywords olr
#' @export #' @export
rep_olr<-function(meas,vars,string,ci=FALSE,data){ rep_olr<-function (meas, vars, ci = FALSE, data,ctp=0.1)
{
require(broom) require(broom)
require(MASS) require(MASS)
d <- dta
d<-data x <- data.frame(d[, c(vars)])
x<-data.frame(d[,c(string)]) names(x) <- c(vars)
v<-data.frame(d[,c(vars)])
names(v)<-c(vars)
y <- d[, c(meas)] y <- d[, c(meas)]
dt<-cbind(y,v) dt <- cbind(y, x)
m1 <- length(coef(polr(y ~ ., data = dt, Hess = TRUE))) m1 <- length(coef(polr(y ~ ., data = dt, Hess = TRUE)))
if (!is.factor(y)) {
if (!is.factor(y)){stop("y should be a factor!")} stop("y should be a factor!")
}
if (ci == TRUE) { if (ci == TRUE) {
df <- data.frame(matrix(ncol = 3)) df <- data.frame(matrix(ncol = 3))
names(df) <- c("pred", "or_ci", "pv") names(df) <- c("pred", "or_ci", "pv")
for (i in 1:ncol(x)) { 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) m <- polr(y ~ ., data = dat, Hess = TRUE)
ctable <- coef(summary(m)) ctable <- coef(summary(m))
l<-suppressMessages(round(exp(confint(m))[-c(1:m1),1],2)) conf<-suppressMessages(matrix(exp(confint(m)),ncol=2))
u<-suppressMessages(round(exp(confint(m))[-c(1:m1),2],2)) l <- round(conf[,1], 2)
or<-round(exp(coef(m))[-c(1:m1)],2) u <- round(conf[,2], 2)
or <- round(exp(coef(m)), 2)
or_ci <- paste0(or, " (", l, " to ", u, ")") or_ci <- paste0(or, " (", l, " to ", u, ")")
p <- (pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2)[1:length(coef(m))] p <- (pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) *
pv<-round(p[-c(1:m1)],3) 2)[1:length(coef(m))]
pv <- round(p, 3)
x1 <- x[, i] 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)) { if (is.factor(x1)) {
pred <- paste(names(x)[i], levels(x1)[-1], sep = "_") 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)) df <- rbind(df, cbind(pred, b, pv))
}
}} }
pa <- as.numeric(df[, c("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.001, "<0.001", pa)
pa <- ifelse(pa <= 0.05 | pa == "<0.001", paste0("*", pa), pa <- ifelse(pa <= 0.05 | pa == "<0.001", paste0("*", pa),
ifelse(pa > 0.05 & pa <= 0.1, paste0(".", pa), pa)) ifelse(pa > 0.05 & pa <= 0.1, paste0(".", pa), pa))
r <- data.frame(df[, 1:2], pa, t)[-1, ] r <- data.frame(df[, 1:2], pa, t)[-1, ]
return(r) return(r)
} }

View File

@ -12,6 +12,7 @@
#' @export #' @export
strobe_olr<-function(meas,vars,data,dec=2,n.by.adj=FALSE){ 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(MASS)
require(dplyr) require(dplyr)

View File

@ -4,18 +4,18 @@
\alias{rep_olr} \alias{rep_olr}
\title{A repeated ordinal logistic regression function} \title{A repeated ordinal logistic regression function}
\usage{ \usage{
rep_olr(meas, vars, string, ci = FALSE, data) rep_olr(meas, vars, ci = FALSE, data, ctp = 0.1)
} }
\arguments{ \arguments{
\item{meas}{Effect meassure. Input as c() of columnnames, use dput().} \item{meas}{Effect meassure. Input as c() of columnnames, use dput().}
\item{vars}{variables in model. 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{ci}{flag to get results as OR with 95 percent confidence interval.}
\item{data}{data.frame to pull variables from.} \item{data}{data.frame to pull variables from.}
\item{ctp}{cut point for drop/include. Standard 0.1.}
} }
\description{ \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. 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.