R 从函数中捕获手动创建的消息

下面的My function

foo（）

生成3种类型的消息。其中两个由

message（）

创建，一个由

cat（）

创建

假设我通过

lappy（）

多次调用

foo（）

我想知道
if（）
在我的
lappy（）
调用中是否有任何
错误消息
（包含术语错误的第二条消息）

注意：我不想使用
停止
或
警告

foo <- function(dat_obj) {
  
  v1 <- sapply(names(dat_obj), function(i) length(unique(dat_obj[[i]])))
  i1 <- names(which(v1 != 1))
  
  if(length(i1) == 1) {
    
    message(paste("Note: potential problem in",i1))
    
  } else if(length(i1) > 1) {
    
    message(paste("Error: fatal problem in x & y."))
    
  } else {
    
    cat(paste("OK: No issues detected.\n"))
  } 
}

#----- EXAMPLE OF USE:
INPUT <- list(
A = data.frame(x = c(1,1,1,1), y = c(2,4,3,3)),
B = data.frame(x = c(1,2,1,1), y = c(3,3,3,3)),
C = data.frame(x = c(1,2,1,1), y = c(3,2,3,3)),
D = data.frame(x = c(1,1,1,1), y = c(3,3,3,3)))


invisible(lapply(INPUT, foo))
#----- OUTPUT:
#Note: potential problem in y
#Note: potential problem in x
#Error: fatal problem in x & y.
#OK: No issues detected.

foo函数应该返回一些内容，即使只有
不可见（NULL）
。在下面的例子中，我已将分配给变量
y
的返回值更改为
NA
。那么逻辑测试号1、2或3就是这个返回值的一个属性

foo <- function(dat_obj) {
  v1 <- sapply(names(dat_obj), function(i) length(unique(dat_obj[[i]])))
  i1 <- names(which(v1 != 1))
  if(length(i1) == 1) {
    Attrib <- 1
    message(paste("Note: potential problem in",i1))
  } else if(length(i1) > 1) {
    Attrib <- 2
    message(paste("Error: fatal problem in x & y."))
  } else {
    Attrib <- 3
    cat(paste("OK: No issues detected.\n"))
  }
  y <- NA
  attr(y, "message") <- Attrib
  y
}

invisible(res <- lapply(INPUT, foo))
sapply(res, attr, "message")

foo函数应该返回一些内容，即使只有
不可见（NULL）
。在下面的例子中，我已将分配给变量
y
的返回值更改为
NA
。那么逻辑测试号1、2或3就是这个返回值的一个属性

foo <- function(dat_obj) {
  v1 <- sapply(names(dat_obj), function(i) length(unique(dat_obj[[i]])))
  i1 <- names(which(v1 != 1))
  if(length(i1) == 1) {
    Attrib <- 1
    message(paste("Note: potential problem in",i1))
  } else if(length(i1) > 1) {
    Attrib <- 2
    message(paste("Error: fatal problem in x & y."))
  } else {
    Attrib <- 3
    cat(paste("OK: No issues detected.\n"))
  }
  y <- NA
  attr(y, "message") <- Attrib
  y
}

invisible(res <- lapply(INPUT, foo))
sapply(res, attr, "message")

foo您可以使用
capture.output
捕获函数返回的输出

temp <- capture.output(lapply(INPUT, foo), type = 'message')
temp
#[1] "Note: potential problem in y"   "Note: potential problem in x"   
#    "Error: fatal problem in x & y."

您可以使用
capture.output
捕获函数返回的输出

temp <- capture.output(lapply(INPUT, foo), type = 'message')
temp
#[1] "Note: potential problem in y"   "Note: potential problem in x"   
#    "Error: fatal problem in x & y."

消息
和
cat
都返回不可见的
NULL
。也许可以尝试另一种逻辑。@Ronaksah，我想知道
if（）
我们从我的
lappy（）
呼叫中是否有
错误消息（第二条消息包含
错误
）@RuiBarradas，确定吗？就像我的回答一样，或者@Ronaksah's.
message
和
cat
都返回不可见
NULL
。也许可以尝试不同的逻辑。@Ronaksah，我想知道我的
lappy（）
呼叫中是否有
if（）
错误消息（第二条消息包含
error
）@RuiBarradas，当然像什么？像在我的回答中，或者是@Ronaksah的。