r - 在 R 中将错误消息捕获为字符串

Question

我想捕获由我的 R 代码在字符串中返回的错误消息。
This thread解释如何捕获函数的错误消息。但是，当我尝试在函数之外捕获错误消息时，错误消息的格式不同。
考虑以下示例 R 代码:

5 5
# Error: unexpected numeric constant in "5 5"

如果我执行之前的 R 代码，RStudio 控制台会返回错误消息 Error: unexpected numeric constant in "5 5" .
但是，如果我 try catch 此输出，错误消息看起来会有所不同:

library("evaluate")

evaluate("5 5")[[2]]
# <simpleError: <text>:1:3: unexpected numeric constant
# 1: 5 5
# ^>

我的预期输出是一个包含以下字符串的数据对象:

my_output <- 'Error: unexpected numeric constant in "5 5"'
my_output
# [1] "Error: unexpected numeric constant in \"5 5\""

问题:如何将 R 代码的错误保存为字符串？

Answer 1

I try to write a function that updates my R code so that all RStudioconsole output is shown as a comment within the code.

我认为 reprex package 和 R Markdown 正在做你想做的。
您可以测试语法并结合 pander 包来处理解析器级别发生的错误。 pander不会产生确切的控制台错误，但适用于 reprex和 R Markdown 。
带 reprex 包

test_eval <- function(text_in){
  if(class(try(parse(text = text_in),silent=TRUE)) == "expression") {
    eval(parse(text = text_in))
  } else {
    x <- pander::evals(text_in)[[1]]$msg$errors
    x <- paste0(tolower(substr(x, 1, 1)), substr(x, 2, nchar(x)))
    x <- paste("Error:", x)
    x <- qdapRegex::rm_between(x, "at", ":", extract=FALSE, replacement="in")
    x <- gsub("` ", "\"", x)
    x <- gsub("`", "\"", x)
    message(x)
  }
}

test_eval("5 5")
#> Error: unexpected numeric constant in "5 5"
test_eval("\"a\" \"a\"")
#> Error: unexpected string constant in ""a" "a""
test_eval("head(iris)")
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#> 1          5.1         3.5          1.4         0.2  setosa
#> 2          4.9         3.0          1.4         0.2  setosa
#> 3          4.7         3.2          1.3         0.2  setosa
#> 4          4.6         3.1          1.5         0.2  setosa
#> 5          5.0         3.6          1.4         0.2  setosa
#> 6          5.4         3.9          1.7         0.4  setosa
test_eval("list()[[0]]")
#> Error in list()[[0]]: attempt to select less than one element in get1index <real>
test_eval("as.Date(10101)")
#> Error in as.Date.numeric(10101): 'origin' must be supplied
test_eval("library('ggplot2')")
test_eval("data <- data.frame(x = LETTERS[1:5], y = c(3, 1, 6, 3, 5))")
test_eval("ggplot(data, aes(x, y)) + geom_point() + geom_line()")
#> Error:   You're passing a function as global data.
#>   Have you misspelled the `data` argument in `ggplot()`

使用 R Markdown

---
title: Test
output:
  html_document: default
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

```{r, collapse=TRUE, error=TRUE}
test_eval <- function(text_in){
  if(class(try(parse(text = text_in),silent=TRUE)) == "expression") {
    eval(parse(text = text_in))
  } else {
    message(paste("Error:", pander::evals(text_in)[[1]]$msg$errors))
  }
}

test_eval("5 5")
test_eval("a a")
test_eval("head(iris)")
test_eval("list()[[0]]")
test_eval("as.Date(10101)")
test_eval("library('ggplot2')")
test_eval("data <- data.frame(x = LETTERS[1:5], y = c(3, 1, 6, 3, 5))")
test_eval("ggplot(data, aes(x, y)) + geom_point() + geom_line()")
```

test_eval <- function(text_in){
  if(class(try(parse(text = text_in),silent=TRUE)) == "expression") {
    eval(parse(text = text_in))
  } else {
    x <- pander::evals(text_in)[[1]]$msg$errors
    x <- paste0(tolower(substr(x, 1, 1)), substr(x, 2, nchar(x)))
    x <- paste("Error:", x)
    x <- qdapRegex::rm_between(x, "at", ":", extract=FALSE, replacement="in")
    x <- gsub("` ", "\"", x)
    x <- gsub("`", "\"", x)
    message(x)
  }
}

test_eval("5 5")
## Error: unexpected numeric constant in "5 5"
test_eval("\"a\" \"a\"")
## Error: unexpected string constant in ""a" "a""
test_eval("head(iris)")
##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa
test_eval("list()[[0]]")
## Error in list()[[0]]: attempt to select less than one element in get1index <real>
test_eval("as.Date(10101)")
## Error in as.Date.numeric(10101): 'origin' must be supplied
test_eval("library('ggplot2')")
test_eval("data <- data.frame(x = LETTERS[1:5], y = c(3, 1, 6, 3, 5))")
test_eval("ggplot(data, aes(x, y)) + geom_point() + geom_line()")
## Error:   You're passing a function as global data.
##   Have you misspelled the `data` argument in `ggplot()`

reprex package 和 R Markdown 正在使用 evaluate包裹。也许测试可以在这个包中完成。 Github 上的新问题: https://github.com/r-lib/evaluate/issues/101 .
还打开了一个问题 pander : https://github.com/Rapporter/pander/issues/349 .
问候，