84 lines
2.3 KiB
R
84 lines
2.3 KiB
R
reg_table <- function(X,y,m.biv=TRUE,m.mul=TRUE,trans.out=FALSE,trans.var=FALSE,outm=NULL,sqrt.vars=NULL,log1p.vars=NULL,inter.add=NULL){
|
|
# method One of biv, mul, biv_mul
|
|
|
|
source("function_trans_table.R")
|
|
|
|
cols<-c("name","pred", "co", "lo", "hi", "pv")
|
|
|
|
if(!is.null(inter.add)){
|
|
form_add<-paste0(paste0(inter.add,collapse = "*"),"+")
|
|
m.biv <- FALSE # If interaction term is added, only multivariate is performed.
|
|
} else {
|
|
form_add=NULL
|
|
}
|
|
|
|
if (m.biv){
|
|
df_b <- data.frame(matrix(NA, ncol = length(cols)))
|
|
names(df_b)<-cols
|
|
|
|
|
|
for (j in colnames(X)){
|
|
m<-lm(formula(paste0("y~",j)),X)
|
|
|
|
ci <- confint(m)
|
|
lo <- ci[-1, 1]
|
|
hi <- ci[-1, 2]
|
|
co <- coef(m)[-1]
|
|
#pv <- broom::tidy(m)$p.value[-1]
|
|
pv <- summary(m)$coefficients[2,4] # Avoids dependency
|
|
x1 <- X[, j]
|
|
if (is.factor(x1)) {
|
|
pred <- paste(j, levels(x1)[-1],
|
|
sep = ".")
|
|
} else { pred <- j }
|
|
|
|
df_b <- rbind(df_b, cbind(name=j, pred, co, lo, hi, pv))
|
|
|
|
}
|
|
|
|
df_b <- df_b[-1,]
|
|
if (trans.var){
|
|
df_b <- trans_table(df_b,sqrts=sqrt.vars,f.vars=f.names)
|
|
}
|
|
|
|
df_b<-df_b|>data.frame()|>mutate(across(matches('co|lo|hi'),as.numeric))
|
|
colnames(df_b)[3:ncol(df_b)]<-paste0("biv_",colnames(df_b)[3:ncol(df_b)])
|
|
}
|
|
|
|
if (m.mul){
|
|
m<-lm(formula(paste0("y~",form_add,".")),X)
|
|
|
|
ci <- confint(m)
|
|
lo <- ci[-1, 1]
|
|
hi <- ci[-1, 2]
|
|
co <- coef(m)[-1]
|
|
#pv <- broom::tidy(m)$p.value[-1]
|
|
pv <- summary(m)$coefficients[-1,4] # Avoids dependency
|
|
pred <- c()
|
|
for (j in colnames(X)){
|
|
x1 <- X[, j]
|
|
if (is.factor(x1)) {
|
|
pred <- c(pred,
|
|
paste(j, levels(x1)[-1],
|
|
sep = "."))
|
|
} else { pred <- c(pred,
|
|
j) }
|
|
}
|
|
df_m <- cbind(name=c(colnames(X),form_add), pred=c(pred,form_add), co, lo, hi, pv)
|
|
|
|
if (trans.var){
|
|
df_m <- trans_table(df_m,sqrts=sqrt.vars,f.vars=f.names)
|
|
}
|
|
|
|
df_m<-df_m|>data.frame()|>mutate(across(matches('co|lo|hi'),as.numeric))
|
|
colnames(df_m)[3:ncol(df_m)]<-paste0("mul_",colnames(df_m)[3:ncol(df_m)])
|
|
|
|
}
|
|
|
|
if (all(m.biv,m.mul)){
|
|
return(merge(df_b,df_m,by=c("name","pred"),sort=FALSE))
|
|
} else if (m.biv) {
|
|
return(df_b)
|
|
} else {return(df_m)}
|
|
|
|
} |