Question

我有一个名为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

Answer 1

如果您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

此外，出于某些原因，我相信您可以完全省略该检查/步骤。

as.character

character实际上是无人值守，所以没有风险。
字符串和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等），那么您还有其他检查可以做。

其次调用函数导致R中的不同输出

1 个答案: