mirror of
https://github.com/agdamsbo/daDoctoR.git
synced 2024-11-23 20:30:21 +01:00
updates
This commit is contained in:
parent
6be25dd145
commit
1ba7567814
@ -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>
|
||||||
|
140
R/rep_olr.R
140
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.
|
#' 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)])
|
y <- d[, c(meas)]
|
||||||
names(v)<-c(vars)
|
dt <- cbind(y, x)
|
||||||
y<-d[,c(meas)]
|
m1 <- length(coef(polr(y ~ ., data = dt, Hess = TRUE)))
|
||||||
dt<-cbind(y,v)
|
if (!is.factor(y)) {
|
||||||
m1<-length(coef(polr(y~.,data = dt,Hess=TRUE)))
|
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))
|
||||||
if (ci==TRUE){
|
names(df) <- c("pred", "or_ci", "pv")
|
||||||
|
for (i in 1:ncol(x)) {
|
||||||
df<-data.frame(matrix(ncol = 3))
|
dat <- data.frame(y = y, x[, i])
|
||||||
names(df)<-c("pred","or_ci","pv")
|
names(dat) <- c("y", names(x)[i])
|
||||||
|
m <- polr(y ~ ., data = dat, Hess = TRUE)
|
||||||
for(i in 1:ncol(x)){
|
|
||||||
dat<-cbind(dt,x[,i])
|
|
||||||
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_ci<-paste0(or," (",l," to ",u,")")
|
or <- round(exp(coef(m)), 2)
|
||||||
|
|
||||||
p <- (pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2)[1:length(coef(m))]
|
or_ci <- paste0(or, " (", l, " to ", u, ")")
|
||||||
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]
|
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<-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))]
|
||||||
df<-rbind(df,cbind(pred,b,pv))
|
pv <- round(p, 3)
|
||||||
|
|
||||||
}}
|
|
||||||
|
|
||||||
pa<-as.numeric(df[,c("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,]
|
|
||||||
|
|
||||||
|
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)
|
return(r)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -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)
|
||||||
|
@ -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.
|
||||||
|
Loading…
Reference in New Issue
Block a user