时间戳

首页 > 解决方案 > 在 R 中调用一个导致不同输出的函数

r - 在 R 中调用一个导致不同输出的函数

问题描述

我有一个名为的函数foo1，它工作得很好。但是，当我简单地foo1使用第二个函数调用时foo2，它不会返回与foo1我缺少的输出相同的输出（真的很困惑）？

请参阅下面的可重现示例：

foo1 <- function(data, cat.level = 0, code = NULL){

  cod <- if(is.numeric(code)) deparse(substitute(code)) else code

  mods <- c("genre","profic")

A <- setNames(lapply(seq_along(mods), function(i) table(data[[mods[i]]])), mods)
Ls <- lapply(A, length)

A <- A[Ls >= cat.level]

if(!is.null(code)){
target <- sapply(seq_along(A), function(i) any(names(A[[i]]) == cod))
A <- A[target]
}
return(A)
}
# EXAMPLE OF PERFECT USE:
d1 <- read.csv("https://raw.githubusercontent.com/rnorouzian/m/master/v4.csv", h = T)#DATA

foo1(d1, cat.level = 0, code = 77)     # Works perfect! RETURNS A OF LIST TABLES

现在致电foo1：foo2

foo2 <- function(data, cat.level = 6, code = NULL){

  foo1(data = data, cat.level = cat.level, code = code) # simply call `foo1`
}

# EXAMPLE OF FAILURE:
foo2(d1, cat.level = 0, code = 77)
# > named list()                      # NOTHING RETURNS

标签： rfunction

解决方案

如果您debug(foo1)然后单独运行它，您会看到它正确地找到了"77". 我逐步完成以下几行：

debug(foo1)
foo1(d1, cat.level = 0, code = 77)
# debugging in: foo1(d1, cat.level = 0, code = 77)
# ...snip...
# debug at #2: cod <- if (is.numeric(code)) deparse(substitute(code)) else code
# debug at #2: deparse(substitute(code))
# debug at #3: mods <- c("genre", "profic")
cod
# [1] "77"

但是如果你调试它并运行foo2，那么看看

foo2(d1, cat.level = 0, code = 77)
# debugging in: foo1(data = data, cat.level = cat.level, code = code)
### ...snip...
# debug at #2: cod <- if (is.numeric(code)) deparse(substitute(code)) else code
# debug at #2: deparse(substitute(code))
# debug at #3: mods <- c("genre", "profic")
cod
# [1] "code"

这显然不是你想要的。当您使用 时deparse(substitute(...))，您将经常（总是？）不得不假设这可能发生。

我认为你没有理由在deparse(substitute(code))这里使用。请尝试as.character：

foo1 <- function(data, cat.level = 0, code = NULL){

  cod <- if(is.numeric(code)) as.character(code) else code

  mods <- c("genre","profic")

  A <- setNames(lapply(seq_along(mods), function(i) table(data[[mods[i]]])), mods)
  Ls <- lapply(A, length)

  A <- A[Ls >= cat.level]

  if(!is.null(code)){
    target <- sapply(seq_along(A), function(i) any(names(A[[i]]) == cod))
    A <- A[target]
  }
  return(A)
}

有用：

foo1(d1, cat.level = 0, code = 77)     
# $genre
#  2  5  6  7 77 99 
# 65 93 57 14 24  4 
# $profic
#   0   1   2  77  99 
#  23 180  18  14  22 

foo2(d1, cat.level = 0, code = 77)
# $genre
#  2  5  6  7 77 99 
# 65 93 57 14 24  4 
# $profic
#   0   1   2  77  99 
#  23 180  18  14  22

此外，我相信您可以完全省略该检查/步骤，原因有几个。

  1. as.characteron acharacter实际上是无操作的，所以没有风险。
  2. 字符串之间的任何比较，numeric并将数字转换为具有隐式强制转换/强制的字符串。

因此，您可以完全删除它，如下所示：

foo1 <- function(data, cat.level = 0, code = NULL){

  mods <- c("genre","profic")

  A <- setNames(lapply(seq_along(mods), function(i) table(data[[mods[i]]])), mods)
  Ls <- lapply(A, length)

  A <- A[Ls >= cat.level]

  if(!is.null(code)){
    target <- sapply(seq_along(A), function(i) any(names(A[[i]]) == code))
    A <- A[target]
  }
  return(A)
}

如果您担心可能会发送其他对象（factor、logical等），那么您可以进行其他检查。

推荐阅读