Picture-Word-N1/02 Stimuli/04-stimuli_latex_tables.R

library(tidyverse)
ggplot2::theme_set(theme_bw())

round_apa <- function(x, n=2, absolute_zero=TRUE) {
  kept_zeroes <- if (absolute_zero) x==0 else rep(FALSE, length(x))
  
  pos_neg <- sign(x)
  z <- abs(x)*10^n
  z <- z + 0.5 + sqrt(.Machine$double.eps)
  z <- trunc(z)
  z <- z/10^n
  z <- gsub(" ", "", as.character(format(z * pos_neg, scientific=FALSE)), fixed=TRUE)
  
  has_point <- grepl(".", z, fixed=TRUE)
  
  if (any(has_point)) {
    nchars_after_point <- nchar(ifelse(has_point, sub("^.*\\.", "", z), ""))
    z_zeroes <- strrep("0", max(nchars_after_point)-nchars_after_point)
    z_suff <- ifelse(has_point, z_zeroes, sprintf(".%s", z_zeroes))
    z <- paste(z, z_suff, sep="")
  }
  
  z <- sub("^0\\.", ".", z)
  z <- sub("^-0\\.", "-.", z)
  
  z <- ifelse(kept_zeroes, "0", z)
  
  if (any(grepl(sprintf(".%s", strrep("0", n)), z, fixed=TRUE))) {
    xmin <- as.double(sprintf(".%s1", strrep("0", n-1)))
    lt_xmin <- x < xmin & x > 0 & grepl("^\\.0", z)
    z[lt_xmin] <- sprintf("<.%s1", strrep("0", n-1))
  }
  
  if (any(
    (grepl(sprintf("^-\\.%s", strrep("0", n)), z) | grepl(sprintf("^\\.%s", strrep("0", n)), z))
  )) {
    xmax <- as.double(sprintf("-.%s1", strrep("0", n-1)))
    gt_xmax <- x > xmax & x < 0 & grepl("^-\\.0|^\\.0", z)
    z[gt_xmax] <- sprintf(">.%s1", strrep("0", n-1))
  }
  
  z[is.na(z)] <- "-"
  
  z
}

# picture word stimuli ----------------------------------------------------

stim_tidy <- read_csv("stim_tidy.csv")

tbl <- stim_tidy %>%
  rowwise() %>%
  mutate(cos_ppmi_sim = min(c(cos_ppmi_sim_A1, cos_ppmi_sim_A2))) %>%
  ungroup() %>%
  select(
    filename_A1,
    perc_name_agree_A1,
    order_grp,
    string_A1, string_A2,
    Length_A1, Length_A2,
    Zipf.SUBTLEX_UK_A1, Zipf.SUBTLEX_UK_A2,
    ON.OLD20_A1, ON.OLD20_A2,
    BG.SUBTLEX_UK_A1, BG.SUBTLEX_UK_A2,
    CNC.Brysbaert_A1, CNC.Brysbaert_A2,
    cos_ppmi_sim
  ) %>%
  arrange(perc_name_agree_A1) %>%
  mutate(
    perc_name_agree_A1 = sprintf("%s\\%%", perc_name_agree_A1),
    Zipf.SUBTLEX_UK_A1 = round_apa(Zipf.SUBTLEX_UK_A1, 2),
    Zipf.SUBTLEX_UK_A2 = round_apa(Zipf.SUBTLEX_UK_A2, 2),
    ON.OLD20_A1 = round_apa(ON.OLD20_A1, 2),
    ON.OLD20_A2 = round_apa(ON.OLD20_A2, 2),
    BG.SUBTLEX_UK_A1 = round_apa(BG.SUBTLEX_UK_A1, 4),
    BG.SUBTLEX_UK_A2 = round_apa(BG.SUBTLEX_UK_A2, 4),
    CNC.Brysbaert_A1 = round_apa(CNC.Brysbaert_A1, 2),
    CNC.Brysbaert_A2 = round_apa(CNC.Brysbaert_A2, 2),
    cos_ppmi_sim = round_apa(cos_ppmi_sim, 4)
  ) %>%
  mutate(rn = row_number()) %>%
  select(rn, everything())

tbl %>%
  mutate(across(everything(), function(x) sprintf(" %s ", x))) %>%
  write_delim(file.path("latex_tables", "pw_stim_latex.txt"), delim="&", col_names = FALSE, eol = "\\\\\n")


# localiser stimuli -------------------------------------------------------

loc_stim <- read_csv("localiser_stim.csv")

loc_tbl <- loc_stim %>%
  select(string, Length, Zipf.SUBTLEX_UK, PREV.Brysbaert, ON.OLD20, BG.SUBTLEX_UK, PoS.SUBTLEX_UK, CNC.Brysbaert, AoA.Kuperman, VAL.Warriner, AROU.Warriner, DOM.Warriner, RT.BLP, Accuracy.BLP) %>%
  mutate(
    Zipf.SUBTLEX_UK = round_apa(Zipf.SUBTLEX_UK, 2),
    PREV.Brysbaert = round_apa(PREV.Brysbaert, 2),
    ON.OLD20 = round_apa(ON.OLD20, 2),
    BG.SUBTLEX_UK = round_apa(BG.SUBTLEX_UK, 4),
    CNC.Brysbaert = round_apa(CNC.Brysbaert, 2),
    AoA.Kuperman = round_apa(AoA.Kuperman, 2),
    VAL.Warriner = round_apa(VAL.Warriner, 2),
    AROU.Warriner = round_apa(AROU.Warriner, 2),
    DOM.Warriner = round_apa(DOM.Warriner, 2),
    RT.BLP = round_apa(RT.BLP, 1),
    Accuracy.BLP = round_apa(Accuracy.BLP, 2)
  ) %>%
  mutate(rn = row_number()) %>%
  select(rn, everything())

loc_tbl %>%
  mutate(across(everything(), function(x) sprintf(" %s ", x))) %>%
  write_delim(file.path("latex_tables", "loc_stim_latex.txt"), delim="&", col_names = FALSE, eol = "\\\\\n")