mirror of
https://github.com/agdamsbo/daDoctoR.git
synced 2024-11-22 11:50:23 +01:00
u
This commit is contained in:
parent
a45e3ff586
commit
17f4c83ee4
90
R/rep_lm.R
90
R/rep_lm.R
@ -1,89 +1,87 @@
|
||||
#' A repeated linear regression function
|
||||
#'
|
||||
#' For bivariate analyses.
|
||||
#' @param y Effect meassure.
|
||||
#' @param v1 Main variable in model
|
||||
#' For bivariate analyses, to determine which variables to include in adjusted model.
|
||||
#' @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% confidence interval.
|
||||
#' @param data data frame to pull variables from.
|
||||
#' @keywords linear regression
|
||||
#' @export
|
||||
#' @examples
|
||||
#' rep_lm()
|
||||
|
||||
rep_lm<-function(y,v1,string,ci=FALSE,data,v2=NULL,v3=NULL){
|
||||
## x is data.frame of predictors, y is vector of an aoutcome as a factor
|
||||
## output is returned as coefficient, or if ci=TRUE as coefficient with 95 % CI.
|
||||
## The confint() function is rather slow, causing the whole function to hang when including many predictors and calculating the ORs with CI.
|
||||
rep_lm<-function(meas,vars,string,ci=FALSE,data){
|
||||
|
||||
require(broom)
|
||||
|
||||
d<-data
|
||||
x<-select(d,one_of(c(string)))
|
||||
m1<-length(coef(lm(y~v1)))
|
||||
x<-data.frame(d[,c(string)])
|
||||
v<-data.frame(d[,c(vars)])
|
||||
y<-d[,c(meas)]
|
||||
dt<-cbind(y,v)
|
||||
m1<-length(coef(lm(y~.,data = dt)))
|
||||
|
||||
if (is.factor(y)){stop("Some kind of error message would be nice, but y should not be a factor!")}
|
||||
|
||||
if (ci==TRUE){
|
||||
|
||||
df<-data.frame(matrix(ncol = 4))
|
||||
names(df)<-c("pred","co_ci","pv","t")
|
||||
df<-data.frame(matrix(ncol = 3))
|
||||
names(df)<-c("pred","or_ci","pv")
|
||||
|
||||
for(i in 1:ncol(x)){
|
||||
m<-lm(y~v1+x[,i])
|
||||
dat<-cbind(dt,x[,i])
|
||||
m<-lm(y~.,data=dat)
|
||||
|
||||
l<-suppressMessages(round(confint(m)[-c(1:m1),1],2))
|
||||
u<-suppressMessages(round(confint(m)[-c(1:m1),2],2))
|
||||
co<-round(coef(m)[-c(1:m1)],2)
|
||||
|
||||
co_ci<-paste0(co," (",l," to ",u,")")
|
||||
|
||||
or<-round(coef(m)[-c(1:m1)],2)
|
||||
or_ci<-paste0(or," (",l," to ",u,")")
|
||||
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
|
||||
pv<-ifelse(pv<0.001,"<0.001",pv)
|
||||
x1<-x[,i]
|
||||
|
||||
t <- ifelse(pv<=0.1|pv=="<0.001","include","drop")
|
||||
|
||||
pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv),
|
||||
ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv))
|
||||
|
||||
|
||||
v<-x[,i]
|
||||
|
||||
if (is.factor(v)){
|
||||
pred<-paste(names(x)[i],levels(v)[-1],sep = "_")
|
||||
}
|
||||
if (is.factor(x1)){
|
||||
pred<-paste(names(x)[i],levels(x1)[-1],sep = "_")}
|
||||
|
||||
else {pred<-names(x)[i]}
|
||||
|
||||
df<-rbind(df,cbind(pred,co_ci,pv,t))
|
||||
|
||||
}}
|
||||
df<-rbind(df,cbind(pred,or_ci,pv))}}
|
||||
|
||||
if (ci==FALSE){
|
||||
|
||||
df<-data.frame(matrix(ncol = 4))
|
||||
names(df)<-c("pred","b","pv","t")
|
||||
df<-data.frame(matrix(ncol = 3))
|
||||
names(df)<-c("pred","b","pv")
|
||||
|
||||
for(i in 1:ncol(x)){
|
||||
m<-lm(y~v1+x[,i])
|
||||
dat<-cbind(dt,x[,i])
|
||||
|
||||
m<-lm(y~.,data=dat)
|
||||
|
||||
b<-round(coef(m)[-c(1:m1)],3)
|
||||
|
||||
pv<-round(tidy(m)$p.value[-c(1:m1)],3)
|
||||
pv<-ifelse(pv<0.001,"<0.001",pv)
|
||||
|
||||
t <- ifelse(pv<=0.1|pv=="<0.001","include","drop")
|
||||
x1<-x[,i]
|
||||
|
||||
pv <- ifelse(pv<=0.05|pv=="<0.001",paste0("*",pv),
|
||||
ifelse(pv>0.05&pv<=0.1,paste0(".",pv),pv))
|
||||
|
||||
v<-x[,i]
|
||||
|
||||
if (is.factor(v)){
|
||||
pred<-paste(names(x)[i],levels(v)[-1],sep = "_")
|
||||
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,t))
|
||||
df<-rbind(df,cbind(pred,b,pv))
|
||||
|
||||
}}
|
||||
result<-df
|
||||
return(df)
|
||||
|
||||
pa<-as.numeric(df[,3])
|
||||
pa<-ifelse(pa<0.001,"<0.001",pa)
|
||||
|
||||
t <- ifelse(pa<=0.1|pa=="<0.001","include","drop")
|
||||
|
||||
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)
|
||||
}
|
||||
|
@ -4,15 +4,21 @@
|
||||
\alias{rep_lm}
|
||||
\title{A repeated linear regression function}
|
||||
\usage{
|
||||
rep_lm(y, v1, string, ci = FALSE, data, v2 = NULL, v3 = NULL)
|
||||
rep_lm(meas, vars, string, ci = FALSE, data)
|
||||
}
|
||||
\arguments{
|
||||
\item{y}{Effect meassure.}
|
||||
\item{meas}{Effect meassure. Input as c() of columnnames, use dput().}
|
||||
|
||||
\item{v1}{Main variable in model}
|
||||
\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% confidence interval.}
|
||||
|
||||
\item{data}{data frame to pull variables from.}
|
||||
}
|
||||
\description{
|
||||
For bivariate analyses.
|
||||
For bivariate analyses, to determine which variables to include in adjusted model.
|
||||
}
|
||||
\examples{
|
||||
rep_lm()
|
||||
|
Loading…
Reference in New Issue
Block a user