Nothing
#' Creates a regresion table in APA style
#' @param ... Regression (i.e., lm) result objects. Typically, one for each block in the regression.
#' @param filename (optional) Output filename document filename (must end in .rtf or .doc only)
#' @param prop.var.conf.level Level of confidence (.90 or .95, default .95) for interval around sr2, R2, and Delta R2. Use of .90 confidence level helps to create consistency between the CI overlapping with zero and conclusions based on the p-value for that block (or block difference).
#' @param table.number Integer to use in table number output line
#' @return APA table object
#' @references
#' sr2 and delta R2 confidence intervals calculated via:
#'
#' Alf Jr, E. F., & Graf, R. G. (1999). Asymptotic confidence limits for the difference between two squared multiple correlations: A simplified approach. Psychological Methods, 4(1), 70.
#'
#' Note that Algina, Keselman, & Penfield (2008) found this approach can under some circumstances lead to inaccurate CIs on proportion of variance values.
#' You might consider using the Algina, Keselman, & Penfield (2008) approach via the apa.reg.boot.table function
#'
#' @examples
#' \dontrun{
#' # View top few rows of goggles data set
#' # from Discovering Statistics Using R
#' head(album)
#'
#' # Single block example
#' blk1 <- lm(sales ~ adverts + airplay, data=album)
#' apa.reg.table(blk1)
#' apa.reg.table(blk1,filename="exRegTable.doc")
#'
#' # Two block example, more than two blocks can be used
#' blk1 <- lm(sales ~ adverts, data=album)
#' blk2 <- lm(sales ~ adverts + airplay + attract, data=album)
#' apa.reg.table(blk1,blk2,filename="exRegBlocksTable.doc")
#'
#' # Interaction product-term test with blocks
#' blk1 <- lm(sales ~ adverts + airplay, data=album)
#' blk2 <- lm(sales ~ adverts + airplay + I(adverts * airplay), data=album)
#' apa.reg.table(blk1,blk2,filename="exInteraction1.doc")
#'
#' # Interaction product-term test with blocks and additional product terms
#' blk1<-lm(sales ~ adverts + airplay, data=album)
#' blk2<-lm(sales ~ adverts + airplay + I(adverts*adverts) + I(airplay*airplay), data=album)
#' blk3<-lm(sales~adverts+airplay+I(adverts*adverts)+I(airplay*airplay)+I(adverts*airplay),data=album)
#' apa.reg.table(blk1,blk2,blk3,filename="exInteraction2.doc")
#'
#' #Interaction product-term test with single regression (i.e., semi-partial correlation focus)
#' blk1 <- lm(sales ~ adverts + airplay + I(adverts * airplay), data=album)
#' apa.reg.table(blk1,filename="exInteraction3.doc")
#' }
#' @export
apa.reg.table<-function(...,filename=NA,table.number=NA, prop.var.conf.level = .95) {
regression_results_list <- list(...)
table_number <- table.number
is_random_predictors <- FALSE
if (is.na(filename)) {
make_file_flag=FALSE
} else {
make_file_flag=TRUE
}
if (prop.var.conf.level == .90) {
prop_var_conf_level <- .90
} else {
prop_var_conf_level <- .95
}
L=length(regression_results_list)
is_same_criterion <- c()
first_result <- regression_results_list[[1]]
first_criterion <- colnames(first_result$model)[1]
for (i in 1:L) {
cur_result <- regression_results_list[[i]]
cur_criterion_name <- colnames(cur_result$model)[1]
is_same_criterion[i] <- first_criterion == cur_criterion_name
}
if (any(is_same_criterion == FALSE)) {
cat("apa.reg.table error:\nAll regression objects (i.e., blocks) must use the same criterion.\n")
cat("The regression objects used had different criterion variables.\n\n")
return(FALSE)
}
is_same_predictors <- c()
first_result <- regression_results_list[[1]]
first_model <- first_result$model
last_model_number_predictors <- dim(first_model)[2]
last_predictors <- colnames(first_result$model)[2:last_model_number_predictors]
n <- dim(first_result$model)[1]
for (i in 1:L) {
cur_result <- regression_results_list[[i]]
cur_model <- cur_result$model
cur_model_number_predictors <- dim(cur_model)[2]
cur_predictors <- colnames(cur_model)[2:cur_model_number_predictors]
is_same_predictors[i] <- all(intersect(last_predictors,cur_predictors) == last_predictors)
last_predictors <- cur_predictors
}
if (any(is_same_predictors==FALSE)) {
cat("apa.reg.table error:\nEach regression objects (i.e., block) must contain all of the predictors from the preceeding regression object (i.e., block).\n\n")
cat("For example:\n")
cat("block1 <- lm(y ~ a + b)\n")
cat("block2 <- lm(y ~ a + b + c)\n\n")
cat("The second block contains all of the predictors from the first block plus additional predictors.\n\n")
cat("Therefore the command below will work: \n\n")
cat("apa.reg.table(block1, block2)\n\n")
return(FALSE)
}
#get analyses for each block
block_results <- list()
L <- length(regression_results_list)
for (i in 1:L) {
cur_result <- apa_single_block(regression_results_list[[i]],is_random_predictors, prop_var_conf_level)
block_results[[i]] <- cur_result
}
is_multiple_blocks <- FALSE
if (L>1) {
is_multiple_blocks <- TRUE
}
#Combine blocks
block_out_txt <- block_results[[1]]$model_details_txt
block_out_rtf <- block_results[[1]]$model_details_rtf
first_block_calculate_cor <- block_results[[1]]$calculate_cor # use later for table note
first_block_calculate_beta <- block_results[[1]]$calculate_beta # use later for table note
last_block_summary <- block_results[[1]]$model_summary_extended
last_block_lm <- regression_results_list[[1]]
if (is_multiple_blocks == TRUE) {
for (i in 2:L) {
cur_block_lm <- regression_results_list[[i]]
cur_block_summary <- block_results[[i]]$model_summary_extended
cur_block_out_txt <- block_results[[i]]$model_details_txt
cur_block_out_rtf <- block_results[[i]]$model_details_rtf
delta_R2_details <- get_delta_R2_blocks(blk2=cur_block_lm,blk1=last_block_lm,summary2=cur_block_summary,summary1=last_block_summary,n, prop_var_conf_level = prop_var_conf_level)
num_lines <- dim(cur_block_out_txt)[1]
cur_block_out_txt$difference[num_lines-2] <- delta_R2_details$deltaR2_txt
cur_block_out_txt$difference[num_lines-1] <- delta_R2_details$deltaR2_CI_txt
cur_block_out_rtf$difference[num_lines-2] <- delta_R2_details$deltaR2_rtf
cur_block_out_rtf$difference[num_lines-1] <- delta_R2_details$deltaR2_CI_rtf
last_block_summary <- cur_block_summary
last_block_lm <- cur_block_lm
if (has_beta_cols(block_out_txt) == TRUE & (has_beta_cols(cur_block_out_txt) == FALSE)) {
block_out_txt <- select(block_out_txt, -beta, -beta_CI, -r)
block_out_rtf <- select(block_out_rtf, -beta, -beta_CI, -r)
}
block_out_txt <- rbind(block_out_txt,cur_block_out_txt)
block_out_rtf <- rbind(block_out_rtf,cur_block_out_rtf)
}
} else {
block_out_txt <- dplyr::select(block_out_txt, -difference)
block_out_rtf <- dplyr::select(block_out_rtf, -difference)
}
#console table
table_title <- sprintf("Regression results using %s as the criterion\n",first_criterion)
txt_column_names <- get_txt_column_names(block_out_txt)
if (prop_var_conf_level == .95) {
txt_column_names <- sub("XX","95",txt_column_names)
} else {
txt_column_names <- sub("XX","90",txt_column_names)
}
names(block_out_txt) <- txt_column_names
table_body <- block_out_txt
table_note <- get_reg_table_note_txt(first_block_calculate_cor, first_block_calculate_beta)
table_block_results <- block_results
tbl_console <- list(table_number = table_number,
table_title = table_title,
table_body = as.data.frame(table_body),
table_note = table_note,
table_block_results = table_block_results)
table_block_results <- block_results
class(tbl_console) <- "apa_table"
if (make_file_flag==TRUE) {
table_title <- sprintf("Regression results using %s as the criterion\n",first_criterion)
table_note <- get_reg_table_note_rtf(first_block_calculate_cor, first_block_calculate_beta)
#set columns widths and names
colwidths <- get_rtf_column_widths(block_out_rtf)
regression_table <- as.matrix(block_out_rtf)
rtf_column_names <- get_rtf_column_names(block_out_rtf)
if (prop_var_conf_level == .95) {
rtf_column_names <- sub("XX","95",rtf_column_names)
} else {
rtf_column_names <- sub("XX","90",rtf_column_names)
}
new_col_names <- rtf_column_names
colnames(regression_table) <- new_col_names
#Create RTF code
rtfTable <- RtfTable$new(isHeaderRow=TRUE, defaultDecimalTableProportionInternal=.15)
rtfTable$setTableContent(regression_table)
rtfTable$setCellWidthsInches(colwidths)
rtfTable$setRowSecondColumnDecimalTab(.4)
txt_body <- rtfTable$getTableAsRTF(FALSE,FALSE)
if (is_multiple_blocks==TRUE) {
write.rtf.table(filename = filename,txt.body = txt_body,table.title = table_title, table.note = table_note,landscape=TRUE,table.number=table_number)
} else {
write.rtf.table(filename = filename,txt.body = txt_body,table.title = table_title, table.note = table_note,table.number=table_number,landscape=TRUE)
}
}
return(tbl_console)
}
apa_single_block<-function(cur_blk,is_random_predictors, prop_var_conf_level) {
#Regression data
reg_table_data <- cur_blk$model
n <- dim(reg_table_data)[1]
col_names <- names(reg_table_data)
#Determine if beta weights should be calculated
is_weighted <- "(weights)" %in% col_names
is_var_factor <- is_variable_factor(reg_table_data)
calculate_beta <- TRUE
calculate_cor <- TRUE
if (is_weighted == TRUE) {
calculate_beta <- FALSE
}
if (is_var_factor == TRUE) {
calculate_beta <- FALSE
calculate_cor <- FALSE
}
#Summary statistics
model_summary_extended <- broom::glance(cur_blk) #glance include lm constant in df
model_summary_extended$df <- summary(cur_blk)$df[1] #use summary information to get df without constant
#Regression table statistics
reg_table <- broom::tidy(cur_blk)
names(reg_table) <- c("predictor","b","SE","t","p")
#adjust df xyzzy
if (reg_table$predictor[1] == "(Intercept)") {
model_summary_extended$df[1] <- model_summary_extended$df[1]-1
}
R2 <- model_summary_extended$r.squared
R2_pvalue <- model_summary_extended$p.value
df1 <- model_summary_extended$df
df2 <- model_summary_extended$df.residual
prop_var_conf_level_str <- sprintf("%g", round(prop_var_conf_level*100))
if (requireNamespace("MBESS", quietly = TRUE)) {
R2CI <- MBESS::ci.R2(R2=R2,df.1=df1,df.2=df2,Random.Predictors = is_random_predictors, conf.level = prop_var_conf_level)
R2LL <- R2CI$Lower.Conf.Limit.R2
R2UL <- R2CI$Upper.Conf.Limit.R2
} else {
R2LL <- NA
R2UL <- NA
cat("\nMBESS package needs to be installed to calculate R2 confidence intervals.\n")
}
R2_txt <- strip.leading.zero(add.sig.stars(sprintf("%1.3f",R2),R2_pvalue))
R2LL_txt <- strip.leading.zero(sprintf("%1.2f",R2LL))
R2UL_txt <- strip.leading.zero(sprintf("%1.2f",R2UL))
model_summary_txt <- sprintf("R2 = %s",R2_txt)
model_summary_CI_txt <- sprintf("%s%% CI[%s,%s]",prop_var_conf_level_str, R2LL_txt,R2UL_txt)
model_summary_rtf <- sprintf("{\\i R\\super 2 \\nosupersub} = %s",R2_txt)
model_summary_CI_rtf <- sprintf("%s%% CI[%s,%s]",prop_var_conf_level_str, R2LL_txt,R2UL_txt)
#Add b-weight CI's
b_CI <- confint(cur_blk) #uses .95 confidence by default
LLb <- b_CI[,c("2.5 %")]
ULb <- b_CI[,c("97.5 %")]
reg_table <- dplyr::mutate(reg_table, LLb=LLb, ULb=ULb)
reg_table <- dplyr::select(reg_table,predictor, b,LLb,ULb,SE,t,p)
#table parts
reg_table_components <- table_without_intercept_row(reg_table)
reg_table_lower <- reg_table_components$lower_table
reg_table_first <- reg_table_components$first_row #intercept row
#Check if predictors not data table
all_predictor_have_data <- TRUE
for (i in 1:length(reg_table_lower$predictor)) {
p_name <- reg_table_lower$predictor[i]
is_present <- p_name %in% names(reg_table_data)
if (is_present == FALSE) {
all_predictor_have_data <- FALSE
}
}
if (all_predictor_have_data == FALSE) {
calculate_beta <- FALSE
calculate_cor <- FALSE
}
#correlation
if (calculate_cor==TRUE) {
r_with_criterion <- correlations_with_criterion(reg_table_data)
reg_table_lower <- dplyr::full_join(reg_table_lower,r_with_criterion,by="predictor")
}
#semi-partial correlation squared
reg_table_lower <- dplyr::mutate(reg_table_lower, sr2=(t*t)*(1-R2)/df2, LLsr2=-999,ULsr2=-999)
number_predictors <- dim(reg_table_lower[,1])[1]
if (number_predictors>1) {
#use delta R2 process for CI
for (i in 1:number_predictors) {
sr2 <- reg_table_lower$sr2[i]
ci <- get_sr2_ci(sr2 = sr2, R2 = R2, n = n, conf_level = prop_var_conf_level)
LL <- ci$LL
UL <- ci$UL
reg_table_lower$LLsr2[i] <- LL
reg_table_lower$ULsr2[i] <- UL
}
} else {
#single predictor so use R2 CI
reg_table_lower$LLsr2[1] <- R2LL
reg_table_lower$ULsr2[1] <- R2UL
}
#beta
if (calculate_beta==TRUE) {
reg_table_lower <- dplyr::mutate(reg_table_lower, beta = -999, LLbeta=-999,ULbeta=-999)
for (i in 1:number_predictors) {
p_name <- reg_table_lower$predictor[i]
b <- reg_table_lower$b[i]
LLb <- reg_table_lower$LLb[i]
ULb <- reg_table_lower$ULb[i]
sd_crit <- stats::sd(reg_table_data[,1],na.rm = TRUE)
sd_pred <- stats::sd(reg_table_data[,p_name],na.rm = TRUE)
beta <- convert_b_to_beta(b = b , sd_pred = sd_pred, sd_crit = sd_crit)
LLbeta <- convert_b_to_beta(b = LLb, sd_pred = sd_pred, sd_crit = sd_crit)
ULbeta <- convert_b_to_beta(b = ULb, sd_pred = sd_pred, sd_crit = sd_crit)
# beta <- b*(sd_pred / sd_crit)
# LLbeta <- LLb*(sd_pred / sd_crit)
# ULbeta <- ULb*(sd_pred / sd_crit)
reg_table_lower$beta[i] <- beta
reg_table_lower$LLbeta[i] <- LLbeta
reg_table_lower$ULbeta[i] <- ULbeta
}
}
#Combine with intercept
intercept_row <- get_empty_row(reg_table_lower)
intercept_row$predictor[1] <- reg_table_first$predictor[1]
intercept_row$b[1] <- reg_table_first$b[1]
intercept_row$LLb[1] <- reg_table_first$LLb[1]
intercept_row$ULb[1] <- reg_table_first$ULb[1]
intercept_row$t[1] <- reg_table_first$t[1]
intercept_row$p[1] <- reg_table_first$p[1]
intercept_row$SE[1] <- reg_table_first$SE[1]
model_details_extended <- rbind(intercept_row, reg_table_lower)
L <- dim(model_details_extended)[1]
CIb_str <- txt.ci.brackets(model_details_extended$LLb, model_details_extended$ULb, strip_zero = FALSE)
CIsr2_str <- txt.ci.brackets(model_details_extended$LLsr2, model_details_extended$ULsr2, strip_zero = TRUE)
if (calculate_beta == TRUE) {
CIbeta_str <- txt.ci.brackets(model_details_extended$LLbeta, model_details_extended$ULbeta, strip_zero = FALSE)
}
model_details <- model_details_extended[,1,drop=FALSE]
model_details$b <- add.sig.stars(sprintf("%1.2f",model_details_extended$b), model_details_extended$p)
model_details$b_CI <- CIb_str
if (calculate_beta==TRUE) {
model_details$beta <- sprintf("%1.2f",model_details_extended$beta)
model_details$beta[1] <- ""
model_details$beta_CI <- CIbeta_str
model_details$beta_CI[1] <- ""
}
model_details$sr2 <- strip.leading.zero(sprintf("%1.2f", model_details_extended$sr2))
model_details$sr2[1] <- ""
model_details$sr2_CI <- CIsr2_str
model_details$sr2_CI[1] <- ""
if (calculate_cor==TRUE) {
model_details$r <- strip.leading.zero(add.sig.stars(sprintf("%1.2f",model_details_extended$r), model_details_extended$r_pvalue)) #intercept row issue
model_details$r[1] <- ""
product_rows <- is_product_row(model_details$predictor)
model_details$r[product_rows] <- ""
}
model_details_txt <- model_details
model_details_txt$summary <- ""
model_details_txt$difference <- "" #blank column to be populated later
model_details_txt <- add_row_to_model_summary(model_details_txt)
model_details_txt <- add_row_to_model_summary(model_details_txt)
model_details_txt <- add_row_to_model_summary(model_details_txt)
num_row <- dim(model_details_txt)[1]
model_details_rtf <- model_details_txt
model_details_txt$summary[num_row-2] <- model_summary_txt
model_details_txt$summary[num_row-1] <- model_summary_CI_txt
model_details_rtf$summary[num_row-2] <- model_summary_rtf
model_details_rtf$summary[num_row-1] <- model_summary_CI_rtf
output <- list()
output$model_summary_extended <- model_summary_extended
output$model_details_extended <- model_details_extended
output$model_details_txt <- model_details_txt
output$model_details_rtf <- model_details_rtf
output$calculate_beta <- calculate_beta
output$calculate_cor <- calculate_cor
return(output)
}
is_product_row <- function(row_names) {
is_a_colon <- grep(":",row_names)
is_a_star <- grep("\\*",row_names)
is_a_product <- unique(sort(c(is_a_colon,is_a_star)))
return(is_a_product)
}
is_variable_factor <- function(df) {
num_var <- dim(df)[2]
is_var_factor <- FALSE
for (i in 1:num_var) {
cur_col <- df[,i]
if ( is.factor(cur_col)) {is_var_factor <- TRUE}
if (is.ordered(cur_col)) {is_var_factor <- TRUE}
}
return(is_var_factor)
}
output_txt_name <- function(column_name) {
switch(column_name,
predictor="Predictor",
b = "b",
b_CI = "b_95%_CI",
beta = "beta",
beta_CI ="beta_95%_CI",
sr2="sr2",
sr2_CI ="sr2_XX%_CI",
r="r",
summary="Fit",
difference="Difference")
}
get_txt_column_names <- function(df) {
n <- names(df)
names_out <- c()
for (i in 1:length(n)) {
names_out[i] <-output_txt_name(n[i])
}
return(names_out)
}
output_rtf_name <- function(column_name) {
switch(column_name,
predictor="Predictor",
b = "{\\i b}",
b_CI = "{{\\i b}\\par}{95% CI\\par}[LL, UL]",
beta = "{\\i beta}",
beta_CI ="{{\\i beta}\\par}{95% CI\\par}[LL, UL]",
sr2="{\\i sr\\super 2 \\nosupersub}",
sr2_CI ="{{{\\i sr\\super 2 \\nosupersub}\\par}XX% CI\\par}[LL, UL]",
r="{\\i r}",
summary="Fit",
difference="Difference")
}
get_rtf_column_names <- function(df) {
n <- names(df)
names_out <- c()
for (i in 1:length(n)) {
names_out[i] <-output_rtf_name(n[i])
}
return(names_out)
}
output_column_width <- function(column_name) {
narrow <- .60
wide <- .95
switch(column_name,
predictor=wide,
b = wide,
b_CI = wide*1.35,
beta = narrow,
beta_CI =wide,
sr2=narrow,
sr2_CI =wide,
r=narrow,
summary=wide*1.3,
difference=wide*1.4)
}
get_rtf_column_widths <- function(df) {
n <- names(df)
width_out <- c()
for (i in 1:length(n)) {
width_out[i] <-output_column_width(n[i])
}
return(width_out)
}
get_reg_table_note_txt <- function(calculate_cor,calculate_beta) {
if (calculate_cor==TRUE & calculate_beta==TRUE) {
table_note <- "Note. A significant b-weight indicates the beta-weight and semi-partial correlation are also significant.\nb represents unstandardized regression weights. beta indicates the standardized regression weights. \nsr2 represents the semi-partial correlation squared. r represents the zero-order correlation.\nSquare brackets are used to enclose the lower and upper limits of a confidence interval.\n* indicates p < .05. ** indicates p < .01.\n"
} else if (calculate_cor==TRUE & calculate_beta==FALSE) {
table_note <- "Note. A significant b-weight indicates the semi-partial correlation is also significant.\nb represents unstandardized regression weights. sr2 represents the semi-partial correlation squared.\nr represents the zero-order correlation.\nSquare brackets are used to enclose the lower and upper limits of a confidence interval.\n* indicates p < .05. ** indicates p < .01.\n"
} else if (calculate_cor==FALSE & calculate_beta==TRUE) {
table_note <- "Note. A significant b-weight indicates the beta-weight and semi-partial correlation are also significant.\nb represents unstandardized regression weights. beta indicates the standardized regression weights. \nsr2 represents the semi-partial correlation squared.\nSquare brackets are used to enclose the lower and upper limits of a confidence interval.\n * indicates p < .05. ** indicates p < .01.\n"
} else {
table_note <- "Note. A significant b-weight indicates the semi-partial correlation is also significant.\nb represents unstandardized regression weights. \nsr2 represents the semi-partial correlation squared.\nSquare brackets are used to enclose the lower and upper limits of a confidence interval.\n* indicates p < .05. ** indicates p < .01.\n"
}
return(table_note)
}
get_reg_table_note_rtf <- function(calculate_cor,calculate_beta) {
if (calculate_cor==TRUE & calculate_beta==TRUE) {
table_note <- "A significant {\\i b}-weight indicates the beta-weight and semi-partial correlation are also significant. {\\i b} represents unstandardized regression weights. {\\i beta} indicates the standardized regression weights. {\\i sr\\super 2\\nosupersub} represents the semi-partial correlation squared. {\\i r} represents the zero-order correlation. {\\i LL} and {\\i UL} indicate the lower and upper limits of a confidence interval, respectively.\\line * indicates {\\i p} < .05. ** indicates {\\i p} < .01."
} else if (calculate_cor==TRUE & calculate_beta==FALSE) {
table_note <- "A significant {\\i b}-weight indicates the semi-partial correlation is also significant. {\\i b} represents unstandardized regression weights. {\\i sr\\super 2\\nosupersub} represents the semi-partial correlation squared. {\\i r} represents the zero-order correlation. {\\i LL} and {\\i UL} indicate the lower and upper limits of a confidence interval, respectively.\\line * indicates {\\i p} < .05. ** indicates {\\i p} < .01."
} else if (calculate_cor==FALSE & calculate_beta==TRUE) {
table_note <- "A significant {\\i b}-weight indicates the beta-weight and semi-partial correlation are also significant. {\\i b} represents unstandardized regression weights. {\\i beta} indicates the standardized regression weights. {\\i sr\\super 2\\nosupersub} represents the semi-partial correlation squared. {\\i LL} and {\\i UL} indicate the lower and upper limits of a confidence interval, respectively.\\line * indicates {\\i p} < .05. ** indicates {\\i p} < .01."
} else {
table_note <- "A significant {\\i b}-weight indicates the semi-partial correlation is also significant. {\\i b} represents unstandardized regression weights. {\\i sr\\super 2\\nosupersub} represents the semi-partial correlation squared. {\\i LL} and {\\i UL} indicate the lower and upper limits of a confidence interval, respectively.\\line * indicates p < .05. ** indicates p < .01."
}
return(table_note)
}
convert_b_to_beta <- function(b, sd_pred,sd_crit) {
beta_value <- b*(sd_pred / sd_crit)
return(beta_value)
}
get_delta_R2_blocks <- function(blk2,blk1,summary2,summary1,n, prop_var_conf_level) {
R2_2 <- summary2$r.squared
R2_1 <- summary1$r.squared
deltaR2 <- R2_2 - R2_1
deltaR2_test <- anova(blk2,blk1)
deltaR2_p <- deltaR2_test$`Pr(>F)`[2]
deltaR2_str <- strip.leading.zero(add.sig.stars(sprintf("%1.3f",deltaR2),deltaR2_p))
deltaR2_txt <- sprintf("Delta R2 = %s", deltaR2_str)
deltaR2_rtf <- sprintf("\\u0916\3{\\i R\\super 2 \\nosupersub} = %s", deltaR2_str)
deltaR2_CI <- get_deltaR2_ci(R2_2 = R2_2, R2_1 = R2_1,n=n, conf_level = prop_var_conf_level)
deltaR2_LL_str <- strip.leading.zero(sprintf("%1.2f",deltaR2_CI$LL))
deltaR2_UL_str <- strip.leading.zero(sprintf("%1.2f",deltaR2_CI$UL))
prop_var_conf_level_str <- sprintf("%g", round(prop_var_conf_level*100))
deltaR2_CI_rtf <- sprintf("{%s%% CI}[%s, %s]",prop_var_conf_level_str, deltaR2_LL_str,deltaR2_UL_str)
deltaR2_CI_txt <- sprintf("%s%% CI[%s, %s]",prop_var_conf_level_str, deltaR2_LL_str,deltaR2_UL_str)
output <- list()
output$deltaR2_txt <- deltaR2_txt
output$deltaR2_CI_txt <- deltaR2_CI_txt
output$deltaR2_rtf <- deltaR2_rtf
output$deltaR2_CI_rtf <- deltaR2_CI_rtf
output$deltaR2 <- deltaR2
output$deltaR2_pvalue <- deltaR2_p
return(output)
}
has_beta_cols <- function(df) {
return("beta" %in% names(df))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.