knitするときの警告の出方は、通常のコンソールでの操作と異なります。
コンソールに打ち込むとこんな風になるはずですが（options(warn)の設定によって違います）、
opps <- function(x) { warning("a") print("b") warning("c") } opps() #> [1] "b" #> Warning messages: #> 1: In opps() : a #> 2: In opps() : c
knitしたときはこうなります：
opps <- function(x) { warning("a") print("b") warning("c") } opps() #> Warning in opps(): a #> [1] "b" #> Warning in opps(): c
この挙動を追っていくと、knitrパッケージの中で使われているevaluateパッケージのevaluate()に行きつきます。
警告が出るコードを評価すると、警告はsimpleWarningというクラスのオブジェクトとして返ってきます。
x <- evaluate::evaluate('{ opps <- function(x) { warning("a") print("b") warning("c") } opps() }') x #> [[1]] #> $src #> [1] "{\n opps <- function(x) {\n warning(\"a\")\n print(\"b\")\n warning(\"c\")\n }\n opps()\n}" #> #> attr(,"class") #> [1] "source" #> #> [[2]] #> <simpleWarning in opps(): a> #> #> [[3]] #> [1] "[1] \"b\"\n" #> #> [[4]] #> <simpleWarning in opps(): c>
これを、上の、
#> Warning messages: #> 1: In opps() : a #> 2: In opps() : c
のように表示したい。
とりあえずsimpleWarningだけを取り出します。
library(purrr) x_simpleWarnings <- keep(x, inherits, what = "simpleWarning")
直接warning()にも渡せますが、
warning(x_simpleWarnings[[1]]) #> Warning message: #> In opps() : NAs introduced by coercion warning(x_simpleWarnings[[1]], x_simpleWarnings[[2]]) #> Warning message: #> simpleWarning in opps(): NAs introduced by coercion #> simpleWarning in opps(): c
可変長の引数を渡そうとするとちょっと都合が悪いようです。
lift_dl(warning)(x_simpleWarnings) #> Warning message: #> In do.call("..f", c(.x, defaults, list(...))) : #> simpleWarning in opps(): NAs introduced by coercion #> simpleWarning in opps(): c
ここで、warnings()をチラ見してみると、warningsというクラスのオブジェクトを作って渡せばうまくいくみたいです。
warnings #> function (...) #> { #> if (!exists("last.warning", envir = baseenv())) #> return() #> last.warning <- get("last.warning", envir = baseenv()) #> if (!(length(last.warning))) #> return() #> structure(last.warning, dots = list(...), class = "warnings") #> } #> <bytecode: 0x0000000009bb3e68> #> <environment: namespace:base>
last.warningsには、警告が出た呼び出し（call）を要素に、警告メッセージをその名前にしたリストが入っています。
get("last.warning", envir = baseenv()) #> $a #> opps() #> #> $c #> opps() #>
evaluate()の結果のデータ構造を見てみると、呼び出しもメッセージも含まれているので、これをいい感じに組み立てればよさそうです。
str(x_simpleWarnings) #> List of 2 #> $ :List of 2 #> ..$ message: chr "a" #> ..$ call : language opps() #> ..- attr(*, "class")= chr [1:3] "simpleWarning" "warning" "condition" #> $ :List of 2 #> ..$ message: chr "c" #> ..$ call : language opps() #> ..- attr(*, "class")= chr [1:3] "simpleWarning" "warning" "condition"
こんな感じです。
x_warnings <- map(x_simpleWarnings, "call") names(x_warnings) <- map_chr(x_simpleWarnings, "message") class(x_warnings) <- "warnings"
うまくいきました。
x_warnings #> Warning messages: #> 1: In opps() : a #> 2: In opps() : c
むずかしい…