R/Rcite_r.R

In EccRiley/Riley: Riley: A working R-library of functions, data, color palettes (etc.) for everyday, and not-so-everyday, R tasks.

#' ## **`Rcite_r()`**
#'
#' Modified version of `papaja::cite_r()`.
#'
Rcite_r <-
    function(file, checksrc = FALSE, srcfile = NULL,
        pkgs = devtools::session_info()$packages$package,
        prefix = "R-",
        tex = FALSE,
        footnote = TRUE,
        Rnote = "This document was created using",
        pkgnote = "and the following _**R**-packages_:",
        ...) {
        if (tex && !require(tufte)) {
            stop("The 'tufte' package (https://cran.rstudio.com/web/packages/tufte/index.html) is required for LaTeX output")
        }
        r_version <- as.character(packageVersion("base"))
        cite_just_r <-
            paste0("**R** [**v** ", r_version, ", @", prefix, "base]")
        if (is.null(file) || !file_test("-f", file)) {
            if (!is.null(file) || pkgs != "all")
                warning(
                    "File ",
                    file,
                    " not found. Cannot cite additional R-packages. If knitting again does not solve the problem, please check file path."
                )
            return(cite_just_r)
        }
        if (checksrc && is.null(srcfile)) {
            warning("Cannot check source file: no source file path provided ('srcfile = NULL')")
        } else if (checksrc && !is.null(srcfile)) {
            src <- readLines(srcfile)
            rgx <- "^.*?(\\w+)\\:\\:.*?$"
            addpkgs <- grep(rgx, src, perl = TRUE, value = TRUE)
            addpkgs <- gsub(rgx, "\\1", addpkgs, perl = TRUE)
            pkgs <- unique(c(addpkgs, pkgs))
        }


        orig_bib_file <- file
        new_bib_file <- "zTEMP.bib"
        y <- sapply(pkgs,
            function(x) {
                res0 <- toBibtex(citation(x))
                res0[[1]] <- gsub("^(@[A-Za-z]+)\\{,$", paste0("\\1{R-", x, ","), res0[[1]])
                return(res0)
            })

        ycat <- paste0(unlist(y), sep = "\n")
        # cat(unlist(ycat))
        cat(ycat, file = new_bib_file, sep = "")

        bib0 <- readLines(orig_bib_file, skipNul = TRUE) %>% paste0(collapse = "\n")
        bib1 <- readLines(new_bib_file, skipNul = TRUE) %>% paste0(collapse = "\n")

        r_bib <- paste0(bib0, "\n\n", bib1)
        # cat(bib_new, file = new_bib_file)
        # cat(bib_new, file = file, append = TRUE)


        cite_keys <-
            r_bib[grepl(paste0("\\@\\w+\\{", prefix), r_bib)]
        cite_keys <- gsub("\\@\\w+\\{", "", cite_keys)
        cite_keys <- gsub("\\,", "", cite_keys)
        bib <- sapply(cite_keys, function(x) {
            y <- list(x)
            names(y) <- gsub(prefix, "", x)
            y
        }, USE.NAMES = FALSE)
        if (length(pkgs) > 1 && pkgs != "all") {
            pkg_citations <- bib[names(bib) %in% pkgs]
        } else {
            pkg_citations <- bib[!names(bib) == "R-base"]
        }
        if (length(pkg_citations) == 0) {
            return(cite_just_r)
        }
        vers1 <-
            function(x) {
                as.data.frame(strsplit(as.character(packageVersion(x)), split = "\\."))[1,]
            }
        vers2 <-
            function(x) {
                as.data.frame(strsplit(as.character(packageVersion(x)), split = "\\."))[2,]
            }
        pkg_texts <- paste0(
            "_",
            names(pkg_citations),
            "-v",
            sapply(names(pkg_citations), vers1),
            ".",
            sapply(names(pkg_citations), vers2),
            "._ ",
            "[@",
            unlist(pkg_citations),
            "]"
        )
        if (length(pkg_texts) > 1) {
            pkg_info <- paste(pkg_texts[1:(length(pkg_texts) - 1)],
                collapse = ", ")
            pkg_info <- paste0(pkg_info, ", and ", tail(pkg_texts,
                1))
        } else {
            pkg_info <- pkg_texts
        }
        if (footnote) {
            res <-
                paste0(
                    "^[**Note:** ", Rnote, " _**R**-v",
                    r_version,
                    "_ [@",
                    bib$base,
                    "], ", pkgnote,
                    " ",
                    pkg_info,
                    "]"
                )
        } else {
            if (tex) {
                res <-
                    paste0(
                        "\n",
                        tufte::newthought(Rnote),
                        " _**R**-v",
                        r_version,
                        "_ [@",
                        bib$base,
                        "], ", pkgnote,
                        "\n\\noindent",
                        pkg_info
                    )
            } else {
                res <-
                    paste0(
                        "\n",
                        tufte::newthought(Rnote),
                        " _**R**-v",
                        r_version,
                        "_ [@",
                        bib$base,
                        "], ", pkgnote,
                        "\n",
                        pkg_info
                    )
            }
        }
        return(res)
    }
#'