# ---------------------------------------------------------------------- #' #' @importFrom data.table data.table #' @keywords internal writeCorpusCountsTeX <- function(.file, .writeTo) { # compose filename if(unique(.file, by = "text")[, .N] > 1) { filename <- paste0("mc_", .file[1, corpus], "_counts") } else { filename <- paste0("mc_", .file[1, corpus], "_", .file[1, text], "_counts") } # compose path if (grepl("/$", .writeTo)) { path <- paste0(.writeTo, filename, ".tex") } else { path <- paste0(.writeTo, "/", filename, ".tex") } # define GRAID symbols to be listed in the table forms <- c("0", "pro", "np", "other") # "f0" anims <- c("1", "2", "h", "d", "") # languages with actor/undergoer voice systems have different function categories if (.file[grepl("^(a|p)_u(_|$)", gfunc), .N] == 0) { funcs <- c("s", "a", "ncs", "p", "obl", "g", "l", "pred", "poss", "other") # "dt" } else { funcs <- c("s", "a_a", "p_a", "a_u", "p_u", "obl", "g", "l", "pred", "poss", "other") } # construct regular expressions rgx_forms <- paste0("(", paste0(forms, collapse = "|"), ")$") rgx_anims <- paste0("^(", paste0(c(anims, ""), collapse = "|"), ").*?$") rgx_funcs <- paste0("^(", paste0(c(funcs, ""), collapse = "|"), ")2?([_=-].*?)?$") # subset data, removing all rows that do not match symbol lists g <- .file[, c("corpus", "text", "gform", "ganim", "gfunc")] g[is.na(ganim), ganim := ""] g[is.na(gfunc), gfunc := ""] g <- g[grepl(rgx_forms, gform) & grepl(rgx_anims, ganim) & grepl(rgx_funcs, gfunc), ] # simplify annotation values g[, xform := gsub(paste0("^.*", rgx_forms), "\\1", gform)] g[, xanim := gsub(rgx_anims, "\\1", ganim)] g[, xfunc := gsub(rgx_funcs, "\\1", gfunc)] g[xform == "other" & xfunc == "", xfunc := "other"] g[, xform := factor(xform, levels = forms)] g[, xanim := factor(xanim, levels = anims)] g[, xfunc := factor(xfunc, levels = funcs)] # create table frame frame <- CJ(xform = factor(forms, ordered = TRUE, levels = forms), xanim = factor(anims, ordered = TRUE, levels = anims), xfunc = factor(funcs, ordered = TRUE, levels = funcs)) # remove unwanted rows in frame frame <- frame[!(grepl("np|other", xform) & grepl("1|2", xanim)), ] # generate table x <- merge(frame, g[, .N, by = c("xform", "xanim", "xfunc")], by = c("xform", "xanim", "xfunc"), all.x = TRUE) x[is.na(N), N := 0] # cast into wide format x <- data.table::dcast(x, "xform + xanim ~ xfunc", value.var = "N") # merge form and animacy glosses x[, graid := xform] x[xanim != "", graid := stringi::stri_pad_right(graid, width = 6, pad = "~")] x[xanim != "", graid := paste0(graid, ".", xanim)] # add GRAID delimiters and LaTeX markup x[, graid := gsub("^(.*)$", "\\\\tann{\\1}", graid)] x[xanim == "" & xform != "other", graid := gsub("^", "\\\\smallskip", graid)] # rename columns setnames(x, 3:(length(funcs) + 2), paste0("\\tcolm{\\tannC{:", funcs, "}}")) setnames(x, gsub("_", "\\\\_", names(x))) # reorder columns setcolorder(x, "graid") # remove unneeded columns x[, c("xform", "xanim") := NULL] # calculate row margin totals x[, totals := as.integer(rowSums(.SD)), .SDcols = c((2):(length(funcs) + 1))] # calculate column margin totals x <- rbind(x, c("graid" = "\\midrule\\bigskip\\textit{totals}", x[, lapply(.SD, sum, na.rm = TRUE), .SDcols = c(2:(length(funcs) + 2))])) x[nrow(x), totals := NA_integer_] # add rows for clause units x <- rbind(x, x[1:3]) x[(nrow(x) - 2):(nrow(x) - 1), graid := c("\\tann{\\#\\#}", "\\tann{\\#}")] x[nrow(x), graid := "\\midrule\\textit{totals}"] x[(nrow(x) - 2):nrow(x), c(2:(length(funcs) + 2)) := NA_integer_] # calculate number of clause units cl_double <- .file[grepl("##", gform), .N, ] cl_single <- .file[grepl("#", gform), .N, ] cl_nc <- .file[grepl("#nc", gform), .N, ] # add clause counts to table x[(nrow(x) - 2):(nrow(x) - 1), totals := c(cl_double, cl_single - cl_double - cl_nc)] x[nrow(x), totals := cl_single - cl_nc] # rename columns setnames(x, c("graid", "totals"), c("\\tcolm{GRAID}", "\\tcolm{\\textit{totals}}")) # compose caption if (unique(.file, by = "text")[, .N] > 1) { caption <- "Summarized GRAID counts for the entire \\getlist[1]{corpus} corpus." } else { caption <- paste0("Summarized GRAID counts for the \\textit{", .file[[1, "text"]], "} text.") } # write TeX table to file xtable::print.xtable(xtable::xtable(x, align = c("l", "l", rep(">{\\raggedleft}X", length(funcs)), ">{\\raggedleft\\arraybackslash}X"), digits = 0, caption = caption, table.placement = ""), file = path, comment = FALSE, type = "latex", latex.environments = "flushleft", include.rownames = FALSE, sanitize.text.function = identity, sanitize.colnames.function = identity, table.placement = "h!", tabular.environment = "tabularx", width = "600pt", booktabs = TRUE, size = "small", caption.placement = "bottom") # status message message(paste0("Writing file '", filename, ".tex'.")) }