|
| 1 | +# --- Citation tools --- |
| 2 | +# Network helpers behind the search_citations / get_bibtex MCP tools and the |
| 3 | +# retraction / arXiv / no-DOI extensions to verify_references. All requests |
| 4 | +# are bounded by options(timeout = 10) at the call site and wrapped in |
| 5 | +# tryCatch so one dead API never kills a whole report. |
| 6 | + |
| 7 | +# Query OpenAlex for works matching a free-text query. Returns a formatted |
| 8 | +# candidate list the agent can pick a citation from (instead of hallucinating |
| 9 | +# one). OpenAlex needs no API key and tolerates polite anonymous use. |
| 10 | +search_citations_impl <- function(query, max_results = 5L) { |
| 11 | + if (!nzchar(trimws(query))) return("Error: empty query.") |
| 12 | + old <- options(timeout = 10) |
| 13 | + on.exit(options(old), add = TRUE) |
| 14 | + |
| 15 | + url <- paste0( |
| 16 | + "https://api.openalex.org/works?search=", |
| 17 | + utils::URLencode(query, reserved = TRUE), |
| 18 | + "&per-page=", as.integer(max_results), |
| 19 | + "&select=title,authorships,publication_year,primary_location,doi,cited_by_count,type" |
| 20 | + ) |
| 21 | + res <- tryCatch(jsonlite::fromJSON(url, simplifyVector = FALSE), |
| 22 | + error = function(e) NULL) |
| 23 | + if (is.null(res) || length(res$results) == 0) { |
| 24 | + return(paste0("No OpenAlex results for: ", query)) |
| 25 | + } |
| 26 | + |
| 27 | + entries <- vapply(res$results, function(w) { |
| 28 | + authors <- vapply(w$authorships, function(a) { |
| 29 | + an <- a$author$display_name |
| 30 | + if (is.null(an)) "?" else an |
| 31 | + }, character(1)) |
| 32 | + if (length(authors) > 4) authors <- c(authors[1:3], "et al.") |
| 33 | + venue <- tryCatch(w$primary_location$source$display_name, |
| 34 | + error = function(e) NULL) |
| 35 | + doi <- if (!is.null(w$doi)) sub("^https://doi.org/", "", w$doi) else "no DOI" |
| 36 | + paste0( |
| 37 | + "- ", if (!is.null(w$title)) w$title else "(untitled)", "\n", |
| 38 | + " ", paste(authors, collapse = ", "), |
| 39 | + " (", if (!is.null(w$publication_year)) w$publication_year else "?", "). ", |
| 40 | + if (!is.null(venue)) venue else "unknown venue", ".\n", |
| 41 | + " DOI: ", doi, |
| 42 | + " | type: ", if (!is.null(w$type)) w$type else "?", |
| 43 | + " | cited by: ", if (!is.null(w$cited_by_count)) w$cited_by_count else "?" |
| 44 | + ) |
| 45 | + }, character(1)) |
| 46 | + |
| 47 | + paste0( |
| 48 | + "OpenAlex results for '", query, "' (", length(entries), "):\n\n", |
| 49 | + paste(entries, collapse = "\n\n"), |
| 50 | + "\n\nUse get_bibtex with a DOI to fetch a citation entry." |
| 51 | + ) |
| 52 | +} |
| 53 | + |
| 54 | +# Fetch a BibTeX entry for a DOI via doi.org content negotiation. This is the |
| 55 | +# canonical registered metadata, not a reconstruction. |
| 56 | +get_bibtex_impl <- function(doi) { |
| 57 | + doi <- sub("^https?://doi.org/", "", trimws(doi)) |
| 58 | + if (!grepl("^10\\.\\d{4,9}/", doi)) { |
| 59 | + return(paste0("Error: '", doi, "' does not look like a DOI (expected 10.XXXX/...).")) |
| 60 | + } |
| 61 | + old <- options(timeout = 10) |
| 62 | + on.exit(options(old), add = TRUE) |
| 63 | + |
| 64 | + bib <- tryCatch({ |
| 65 | + con <- url(paste0("https://doi.org/", doi), |
| 66 | + headers = c(Accept = "application/x-bibtex")) |
| 67 | + on.exit(try(close(con), silent = TRUE), add = TRUE) |
| 68 | + paste(readLines(con, warn = FALSE), collapse = "\n") |
| 69 | + }, error = function(e) NULL) |
| 70 | + |
| 71 | + if (is.null(bib) || !nzchar(bib)) { |
| 72 | + return(paste0("Could not resolve BibTeX for DOI ", doi, |
| 73 | + ". The DOI may be invalid or the resolver unreachable.")) |
| 74 | + } |
| 75 | + bib |
| 76 | +} |
| 77 | + |
| 78 | +# Check whether anything in Crossref updates this DOI (retractions, |
| 79 | +# expressions of concern, major corrections). Returns NULL when clean, |
| 80 | +# otherwise a short human-readable flag string. |
| 81 | +check_retraction_impl <- function(doi) { |
| 82 | + res <- tryCatch(jsonlite::fromJSON( |
| 83 | + paste0("https://api.crossref.org/works?filter=updates:", |
| 84 | + utils::URLencode(doi, reserved = TRUE), "&rows=5"), |
| 85 | + simplifyVector = FALSE |
| 86 | + ), error = function(e) NULL) |
| 87 | + if (is.null(res)) return(NULL) |
| 88 | + items <- res$message$items |
| 89 | + if (length(items) == 0) return(NULL) |
| 90 | + |
| 91 | + flags <- character(0) |
| 92 | + for (it in items) { |
| 93 | + for (upd in it$`update-to`) { |
| 94 | + type <- tolower(if (!is.null(upd$type)) upd$type else "") |
| 95 | + lab <- if (!is.null(upd$label)) upd$label else upd$type |
| 96 | + if (identical(upd$DOI, doi) || grepl("retract|concern|correct", type)) { |
| 97 | + notice_doi <- if (!is.null(it$DOI)) it$DOI else "?" |
| 98 | + flags <- c(flags, sprintf("%s (notice DOI: %s)", lab, notice_doi)) |
| 99 | + } |
| 100 | + } |
| 101 | + } |
| 102 | + if (length(flags) == 0) return(NULL) |
| 103 | + paste0("!!! UPDATE NOTICE: ", paste(unique(flags), collapse = "; "), |
| 104 | + " -- verify before citing (possible retraction/correction/concern)") |
| 105 | +} |
| 106 | + |
| 107 | +# Best-effort bibliographic match for a reference string with no DOI. |
| 108 | +# Returns a short candidate line, or NULL if nothing plausible came back. |
| 109 | +match_reference_impl <- function(ref_text) { |
| 110 | + ref_text <- trimws(gsub("\\s+", " ", ref_text)) |
| 111 | + if (nchar(ref_text) < 40) return(NULL) |
| 112 | + res <- tryCatch(jsonlite::fromJSON( |
| 113 | + paste0("https://api.crossref.org/works?rows=1&query.bibliographic=", |
| 114 | + utils::URLencode(substr(ref_text, 1, 300), reserved = TRUE)), |
| 115 | + simplifyVector = FALSE |
| 116 | + ), error = function(e) NULL) |
| 117 | + items <- tryCatch(res$message$items, error = function(e) NULL) |
| 118 | + if (is.null(items) || length(items) == 0) return(NULL) |
| 119 | + it <- items[[1]] |
| 120 | + title <- tryCatch(paste(unlist(it$title), collapse = " "), error = function(e) "?") |
| 121 | + year <- tryCatch(it$issued$`date-parts`[[1]][[1]], error = function(e) "?") |
| 122 | + score <- if (!is.null(it$score)) round(as.numeric(it$score), 1) else NA |
| 123 | + sprintf("Best Crossref match: \"%s\" (%s), DOI: %s [score %s -- verify title/authors match before accepting]", |
| 124 | + title, year, if (!is.null(it$DOI)) it$DOI else "?", score) |
| 125 | +} |
| 126 | + |
| 127 | +# Look up an arXiv ID via the arXiv Atom API, and check Crossref for a |
| 128 | +# published (journal/proceedings) version so preprint citations of published |
| 129 | +# work get flagged. Atom parsed with regex to avoid an xml2 hard dependency. |
| 130 | +check_arxiv_impl <- function(arxiv_id) { |
| 131 | + res <- tryCatch({ |
| 132 | + con <- url(paste0("https://export.arxiv.org/api/query?id_list=", arxiv_id)) |
| 133 | + on.exit(try(close(con), silent = TRUE), add = TRUE) |
| 134 | + paste(readLines(con, warn = FALSE), collapse = "\n") |
| 135 | + }, error = function(e) NULL) |
| 136 | + if (is.null(res)) return(NULL) |
| 137 | + |
| 138 | + title <- regmatches(res, regexpr("<title>[^<]+</title>", res)) |
| 139 | + # First <title> is the feed's own; the entry title is the second match |
| 140 | + titles <- regmatches(res, gregexpr("<title>[^<]+</title>", res))[[1]] |
| 141 | + entry_title <- if (length(titles) >= 2) { |
| 142 | + trimws(gsub("</?title>|\\s+", " ", titles[2])) |
| 143 | + } else NULL |
| 144 | + if (is.null(entry_title) || !nzchar(entry_title)) { |
| 145 | + return(sprintf("arXiv:%s -- not found on arXiv.", arxiv_id)) |
| 146 | + } |
| 147 | + |
| 148 | + out <- sprintf("arXiv:%s resolves to: \"%s\"", arxiv_id, entry_title) |
| 149 | + published <- match_reference_impl(entry_title) |
| 150 | + if (!is.null(published)) { |
| 151 | + out <- paste0(out, "\n Possible published version -- ", published, |
| 152 | + "\n If this matches, cite the published version rather than the preprint.") |
| 153 | + } |
| 154 | + out |
| 155 | +} |
0 commit comments