mirror of
https://github.com/agdamsbo/daDoctoR.git
synced 2024-11-21 19:30:22 +01:00
87 lines
2.6 KiB
R
87 lines
2.6 KiB
R
#' A repeated ordinal logistic regression function
|
|
#'
|
|
#' 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 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, ci = FALSE, data,ctp=0.1)
|
|
{
|
|
require(broom)
|
|
require(MASS)
|
|
d <- dta
|
|
x <- data.frame(d[, c(vars)])
|
|
names(x) <- c(vars)
|
|
y <- d[, c(meas)]
|
|
dt <- cbind(y, x)
|
|
m1 <- length(coef(polr(y ~ ., data = dt, Hess = TRUE)))
|
|
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 <- data.frame(y = y, x[, i])
|
|
names(dat) <- c("y", names(x)[i])
|
|
m <- polr(y ~ ., data = dat, Hess = TRUE)
|
|
ctable <- coef(summary(m))
|
|
|
|
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, 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)
|
|
|
|
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 <= 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)
|
|
}
|