## ----setup, include = FALSE--------------------------------------------------- library(apa7) library(flextable) library(ftExtra) library(dplyr) library(tibble) library(tidyr) library(stringr) library(psych) set_flextable_defaults(theme_fun = theme_apa, font.family = "Times New Roman", text.align = "center", table_align = "left") ## ----setupdisplay------------------------------------------------------------- library(apa7) library(flextable) library(ftExtra) library(dplyr) library(tibble) library(tidyr) library(stringr) library(psych) set_flextable_defaults(theme_fun = theme_apa, font.family = "Times New Roman", text.align = "center", table_align = "left") ## ----rawdata------------------------------------------------------------------ d <- tibble( Model = paste("Model", c(rep(1,2), rep(2, 3))), Predictor = c( "Constant", "Socioeconomic status", "Constant", "Socioeconomic status", "Age"), b = c(-4.5, 1.23, -5.1, 1.45, -.23), beta = c(NA, .24, NA, .31, .031), t = c(-18.457, 2.345, -22.457, 2.114, .854), df = c(85,85, 84, 84, 84), p = c(.0001, .0245, .0001, .0341, .544)) d ## ----initialflextable--------------------------------------------------------- set_flextable_defaults( theme_fun = theme_apa, font.family = "Times New Roman", text.align = "center", table_align = "left") flextable(d) ## ----apa_flextable------------------------------------------------------------ apa_flextable(d, row_title_column = Model) ## ----centeralign-------------------------------------------------------------- apa_flextable(d, row_title_column = Model, row_title_align = "center") ## ----vmerge------------------------------------------------------------------- d |> mutate(Model = str_remove(Model, "Model ")) |> apa_flextable() |> merge_v() |> align(j = "Predictor", part = "all") |> align(j = "Model", align = "center") |> valign(j = "Model", valign = "middle") |> surround(i = 2, border.bottom = flextable::fp_border_default()) |> width(width = c(.8, 1.75, rep(.8, 5))) ## ----selectivebold------------------------------------------------------------ apa_flextable(d, row_title_column = Model) |> bold(i = 3, j = 3) ## ----flextablefunctions------------------------------------------------------- #| echo: false tibble::tribble( ~Target, ~Function, ~Purpose, "Cell", "align", "Horizontal alignment", "Cell", "bg", "Background color", "Cell", "line_spacing", "Line spacing", "Cell", "padding", "Cell padding", "Cell", "valign", "Vertical alignment", "Cell", "rotate", "Rotate text", "Cell", "surround", "Cell borders", "Cell", "width", "Column width", "Text", "font", "Font family", "Text", "fontsize", "Font size", "Text", "italic", "Italicize text", "Text", "bold", "Bold text", "Text", "color", "Color text", "Text", "highlight", "Highlight color" ) |> arrange(desc(Target), Function) |> mutate( Function = paste0("[", tagger(Function, "`"), "](https://davidgohel.github.io/flextable/reference/", Function, ".html)"), Target = bold_md(Target)) |> # as_grouped_data() |> apa_flextable(row_title_column = Target, row_title_align = "left", table_width = .5) |> align() ## ----autooff------------------------------------------------------------------ apa_flextable(d, row_title_column = Model, auto_format_columns = FALSE) ## ----collumnformat------------------------------------------------------------ cf_predictor <- column_format( name = "Predictor", header = "Variable", latex = "Variable", formatter = stringr::str_to_upper) cf_predictor ## ----myformats---------------------------------------------------------------- # Make new formatter object with default accuracy of .001 my_formats <- column_formats(accuracy = .001) # Add Predictor column formatter my_formats$Predictor <- cf_predictor # Remove formatter for beta column my_formats$beta <- NULL apa_flextable(d, row_title_column = Model, column_formats = my_formats) ## ----formattibble------------------------------------------------------------- my_formats@get_tibble |> select(-formatter) |> dplyr::arrange(name, .locale = "en") |> apa_flextable(markdown_body = F) ## ----intrepid----------------------------------------------------------------- d |> # Create column spanners rename_with(.cols = c(b, beta), \(x) paste0("Coefficients_", x)) |> rename_with(.cols = c(t, df, p), .fn = \(x) paste0("Significance Test_", x)) |> # Step 1: Space between column spanners add_break_columns(ends_with("beta")) |> # Step 2: Make row titles flextable::as_grouped_data("Model") |> mutate(row_title = Model, .before = 1) |> fill(Model) |> # Step 3: Format data apa_format_columns() %>% # Step 4: Convert to flextable flextable(col_keys = colnames( select(., -Model, -row_title))) |> mk_par(i = ~ !is.na(row_title), value = as_paragraph(row_title)) |> merge_h(i = ~ !is.na(row_title)) |> # Step 5: Separate headers into column spanners and deckered heads flextable::separate_header() |> # Step 6: Make borders between row groups surround( i = ~ !is.na(row_title), border.top = list( color = "gray20", style = "solid", width = 1 ) ) |> # Step 7: Style table and convert markdown apa_style() |> align(j = 1, i = ~is.na(row_title)) |> align(i = ~!is.na(row_title), align = "center") |> # Step 8: Pretty widths pretty_widths() ## ----diamonds----------------------------------------------------------------- d_diamonds <- ggplot2::diamonds %>% select(cut, carat, depth, table) %>% arrange(cut) %>% rename_with(str_to_title) %>% pivot_longer(where(is.numeric), names_to = "Variable") %>% summarise( M = mean(value, na.rm = TRUE), SD = sd(value, na.rm = TRUE), .by = c(Variable, Cut)) %>% pivot_longer(c(M, SD)) %>% unite(Variable, Variable, name) %>% pivot_wider(names_from = Variable) d_diamonds ## ----flexdiamonds------------------------------------------------------------- apa_flextable(d_diamonds) ## ----breakdiamonds------------------------------------------------------------ d_diamonds |> add_break_columns(Carat_SD, Depth_SD) ## ----breakflexdiamonds-------------------------------------------------------- d_diamonds |> add_break_columns(ends_with("SD"), omit_last = TRUE) |> apa_flextable() ## ----columnspanners----------------------------------------------------------- d |> column_spanner_label("Significance test", c(t,df,p)) |> column_spanner_label("Coefficients", starts_with("b")) |> apa_flextable(row_title_column = Model) ## ----alighchr----------------------------------------------------------------- tibble(x = align_chr(c(2.431, -0.4, -10, 101))) |> apa_flextable(table_width = .2) |> align(align = "center") ## ----zeroes------------------------------------------------------------------- tibble(x = align_chr(c(2.431, -0.4, -10, 101), drop0trailing = TRUE, trim_leading_zeros = TRUE)) |> apa_flextable(table_width = .2) |> align(align = "center") ## ----quotetable--------------------------------------------------------------- d_quote <- tibble( Quote = c( "Believe those who are seeking the truth. Doubt those who find it.", "Resentment is like drinking poison and waiting for the other person to die.", "What you read when you don’t have to, determines what you will be when you can’t help it.", "Advice is what we ask for when we already know the answer but wish we didn’t.", "Do not ask whether a statement is true until you know what it means.", "Tact is the art of making a point without making an enemy.", "Short cuts make long delays.", "The price one pays for pursuing any profession or calling is an intimate knowledge of its ugly side.", "There is a stubbornness about me that never can bear to be frightened at the will of others. My courage always rises at every attempt to intimidate me", "There is a crack in everything, that’s how the light gets in.", "If you choose to dig a rather deep hole, someday you will have no choice but to keep on digging, even with tears.", "We long for self-confidence, till we look at the people who have it.", "Writing is a way to end up thinking something you couldn’t have started out thinking.", "A little inaccuracy sometimes saves tons of explanation.", "Each snowflake in an avalanche pleads not guilty.", "What I write is smarter than I am. Because I can rewrite it." ), Attribution = c( "Andre Gide", "Carrie Fisher", "Charles Francis Potter", "Erica Jong", "Errett Bishop", "Howard W. Newton", "J.R.R. Tolkien", "James Baldwin", "Jane Austin", "Leonard Cohen", "Liyun Chen", "Mignon McLaughlin", "Peter Elbow", "Saki", "Stanislaw J. Lec", "Susan Sontag" ) ) |> arrange(nchar(Quote)) d_quote |> mutate(Quote = paste0(seq_along(Quote), ".\u2007", Quote) |> align_chr(side = "left") |> hanging_indent(width = 55, indent = 7)) |> apa_flextable() |> align(j = "Attribution", part = "all") |> width(width = c(4.5, 2)) ## ----numberedlist------------------------------------------------------------- d_quote |> mutate(linechar = purrr::map_int(Quote, \(x) { stringr::str_split(x, "\\\\\n") |> purrr::map(str_trim) |> purrr::map(nchar) |> purrr::map_int(max) })) |> arrange(linechar) |> select(-linechar) |> add_list_column(Quote) |> apa_flextable() |> align(j = "Attribution", part = "all") |> width(width = c(.3, 4.2, 2)) ## ----letterlist--------------------------------------------------------------- d_quote |> add_list_column(Quote, type = "A", sep = ") ") |> apa_flextable() |> align(j = "Attribution", part = "all") |> width(width = c(.3, 4.2, 2)) ## ----addstar------------------------------------------------------------------ d_star <- tibble( Predictor = c("Constant", "Socioeconomic status"), b = c(.45,.55), p = c(.02, .0002)) |> add_star_column(b, p = p) d_star apa_flextable(d_star) ## ----separatestarcolumn------------------------------------------------------- d_star <- tibble(Predictor = c("Constant", "Socioeconomic status"), b = c("1.10***", "2.32*"), beta = c(NA, .34)) |> separate_star_column(b) d_star apa_flextable(d_star) ## ----fullcontrol-------------------------------------------------------------- d |> # # decimal align b and append p-value stars mutate(b = paste0( align_chr(b), p2stars(p))) |> # deselect t, df, and p select(-c(t,df, p)) |> # restructure data pivot_wider_name_first(names_from = Model, values_from = c(b, beta)) |> # convert to flextable apa_flextable() |> # add footnotes add_footer_lines( values = as_paragraph_md( c(paste( "*Note*. *b* = unstandardized regression coefficient.", "β = standardized regression coefficient."), apa_p_star_note()))) |> # align footnote align(part = "footer", align = "left") |> # Make column widths even width(width = c(2.05, 1.1, 1.1, .05, 1.1, 1.1)) ## ----apaparameters------------------------------------------------------------ fit <- lm(price ~ carat, data = ggplot2::diamonds) fit |> apa_parameters() |> apa_flextable() ## ----apaperformance----------------------------------------------------------- apa_performance(fit) |> apa_flextable() ## ----metrics------------------------------------------------------------------ apa_performance(fit, metrics = c("R2", "Sigma", "AIC", "BIC")) |> apa_flextable() ## ----allmetrics--------------------------------------------------------------- apa_performance(fit, metrics = "all") |> apa_flextable() ## ----fit3--------------------------------------------------------------------- fit_3 <- list( lm(price ~ cut, data = ggplot2::diamonds), lm(price ~ cut + table, data = ggplot2::diamonds), lm(price ~ cut + table + carat, data = ggplot2::diamonds) ) fit_3 |> apa_parameters() |> apa_flextable(row_title_column = Model, row_title_align = "center") ## ----comparison--------------------------------------------------------------- fit_3 |> apa_performance_comparison() |> apa_flextable() ## ----correlation-------------------------------------------------------------- ggplot2::diamonds |> select(table, carat, length = x, width = y , depth = z) |> apa_cor() ## ----chidiamons--------------------------------------------------------------- ggplot2::diamonds |> select(Cut = cut, Color = color ) |> apa_chisq() ## ----ggdiamonds--------------------------------------------------------------- #| fig-width: 8 #| fig-height: 8 library(ggplot2) ggplot2::diamonds |> select(Cut = cut, Color = color) |> count(Cut, Color) |> mutate(p = scales::percent(n / sum(n), accuracy = .1), .by = Cut) |> ggplot(aes(Cut, n, fill = Color)) + geom_col(position = position_fill(), alpha = .6, width = .96) + geom_text( aes(label = paste0(p, " (", n, ")")), position = position_fill(vjust = .5), size.unit = "pt", size = 14 * .8, color = "gray10" ) + theme_minimal(base_family = "Roboto Condensed", base_size = 14) + scale_y_continuous( "Cumulative Proportion", expand = expansion(c(0, .025)), labels = \(x) scales::percent(x, accuracy = 1) ) + scale_x_discrete(expand = expansion()) + theme(panel.grid.major.x = element_blank()) ## ----fa----------------------------------------------------------------------- # Get variable names rename_items <- psych::bfi.dictionary |> tibble::rownames_to_column("variable") |> mutate(Item = str_remove(Item, "\\.$")) |> select(Item, variable) |> deframe() # Make data d <- psych::bfi |> select(-gender:-age) |> rename(any_of(rename_items)) # Analysis fit <- fa(d, nfactors = 5, fm = "pa", ) # Make table fit |> apa_loadings() |> rename(Extraversion = PA1, Neuroticism = PA2, Conscientiousness = PA3, Openness = PA4, Agreeableness = PA5) |> apa_flextable(no_format_columns = Variable)