mirror of
https://github.com/agdamsbo/daDoctoR.git
synced 2024-11-21 19:30:22 +01:00
variable selection ond vector export for rep_lm
This commit is contained in:
parent
46db760722
commit
77930fce38
@ -1,6 +1,6 @@
|
|||||||
Package: daDoctoR
|
Package: daDoctoR
|
||||||
Title: Functions For Health Research
|
Title: Functions For Health Research
|
||||||
Version: 0.21.9
|
Version: 0.21.10
|
||||||
Year: 2021
|
Year: 2021
|
||||||
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>
|
||||||
|
23
R/rep_lm.R
23
R/rep_lm.R
@ -1,6 +1,7 @@
|
|||||||
#' A repeated linear regression function
|
#' A repeated linear regression function
|
||||||
#'
|
#'
|
||||||
#' For bivariate analyses, to determine which variables to include in adjusted model.
|
#' For bivariate analyses, to determine which variables to include in adjusted model.
|
||||||
|
#' Output is a list with two elements: data frame with test results and vector of variable names (from 'string') to include determined by set cutoff ('cut.p').
|
||||||
#' @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 string variables to test. Input as c() of columnnames, use dput().
|
||||||
@ -10,7 +11,7 @@
|
|||||||
#' @keywords linear regression
|
#' @keywords linear regression
|
||||||
#' @export
|
#' @export
|
||||||
|
|
||||||
rep_lm<-function(meas,vars=NULL,string,ci=FALSE,data,fixed.var=FALSE){
|
rep_lm<-function(meas,vars=NULL,string,ci=FALSE,data,fixed.var=FALSE,cut.p=0.1){
|
||||||
|
|
||||||
require(broom)
|
require(broom)
|
||||||
y<-data[,c(meas)]
|
y<-data[,c(meas)]
|
||||||
@ -44,7 +45,7 @@ rep_lm<-function(meas,vars=NULL,string,ci=FALSE,data,fixed.var=FALSE){
|
|||||||
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]}
|
else {pred<-names(x)[i]}
|
||||||
@ -68,14 +69,14 @@ rep_lm<-function(meas,vars=NULL,string,ci=FALSE,data,fixed.var=FALSE){
|
|||||||
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]}
|
else {pred<-names(x)[i]}
|
||||||
df<-rbind(df,cbind(pred,b,pv))
|
df<-rbind(df,cbind(pred,b,pv))
|
||||||
}}
|
}}
|
||||||
|
|
||||||
pa<-as.numeric(df[,3])
|
pa<-as.numeric(df[,3])
|
||||||
t <- ifelse(pa<=0.1,"include","drop")
|
t <- ifelse(pa<=cut.p,"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))
|
||||||
@ -112,7 +113,7 @@ rep_lm<-function(meas,vars=NULL,string,ci=FALSE,data,fixed.var=FALSE){
|
|||||||
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]}
|
else {pred<-names(x)[i]}
|
||||||
|
|
||||||
@ -132,19 +133,25 @@ rep_lm<-function(meas,vars=NULL,string,ci=FALSE,data,fixed.var=FALSE){
|
|||||||
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]}
|
else {pred<-names(x)[i]}
|
||||||
df<-rbind(df,cbind(pred,b,pv))
|
df<-rbind(df,cbind(pred,b,pv))
|
||||||
}}
|
}}
|
||||||
|
|
||||||
pa<-as.numeric(df[,3])
|
pa<-as.numeric(df[,3])
|
||||||
t <- ifelse(pa<=0.1,"include","drop")
|
t <- ifelse(pa<=cut.p,"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)
|
|
||||||
|
p<-r$pred[r$t=="include"]
|
||||||
|
s<-c()
|
||||||
|
for (i in 1:length(p)){
|
||||||
|
s<-c(s,unlist(strsplit(p[i], "[.]"))[1])
|
||||||
|
}
|
||||||
|
return(list(tests=r,to_include=unique(s)))
|
||||||
}
|
}
|
||||||
|
@ -15,6 +15,7 @@ I have used these functions in different ways in my work on publishing rasearch
|
|||||||
I'm currently working on improving the code to be more universal
|
I'm currently working on improving the code to be more universal
|
||||||
- Include sample data to use with special functions
|
- Include sample data to use with special functions
|
||||||
- Include coding examples with all functions
|
- Include coding examples with all functions
|
||||||
|
- Add functionality for variable selection to otger 'rep_' functions, like 'rep_lm'.
|
||||||
|
|
||||||
## New functions
|
## New functions
|
||||||
- Test for confounders and/or effect modifiers
|
- Test for confounders and/or effect modifiers
|
||||||
|
@ -4,7 +4,15 @@
|
|||||||
\alias{rep_lm}
|
\alias{rep_lm}
|
||||||
\title{A repeated linear regression function}
|
\title{A repeated linear regression function}
|
||||||
\usage{
|
\usage{
|
||||||
rep_lm(meas, vars = NULL, string, ci = FALSE, data, fixed.var = FALSE)
|
rep_lm(
|
||||||
|
meas,
|
||||||
|
vars = NULL,
|
||||||
|
string,
|
||||||
|
ci = FALSE,
|
||||||
|
data,
|
||||||
|
fixed.var = FALSE,
|
||||||
|
cut.p = 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().}
|
||||||
@ -21,6 +29,7 @@ rep_lm(meas, vars = NULL, string, ci = FALSE, data, fixed.var = FALSE)
|
|||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
For bivariate analyses, to determine which variables to include in adjusted model.
|
For bivariate analyses, to determine which variables to include in adjusted model.
|
||||||
|
Output is a list with two elements: data frame with test results and vector of variable names (from 'string') to include determined by set cutoff ('cut.p').
|
||||||
}
|
}
|
||||||
\keyword{linear}
|
\keyword{linear}
|
||||||
\keyword{regression}
|
\keyword{regression}
|
||||||
|
Loading…
Reference in New Issue
Block a user