r - 在本地环境中创建 S3 类以对对象进行排序

Question

TLDR:如何在不必全局引入新的 S3 类的情况下对对象进行排序？

在 R 中，我们需要引入 S3 类来对自定义对象进行排序(参见 this answer )。下面是一个示例，我根据字符串的长度对字符串列表进行排序。

`[.customSort` <- function(x, i, ...) structure(unclass(x)[i], class = "customSort")
`==.customSort` <- function(a, b) nchar(a[[1]]) == nchar(b[[1]])
`>.customSort` <- function(a, b) nchar(a[[1]]) > nchar(b[[1]])
customObject <- structure(list('abc', 'de', 'fghi'), class = 'customSort')
unlist(sort(customObject))
# [1] "de"   "abc"  "fghi"

在我的 R 包中，我想提供一个排序函数 mySort(..., Compare)。但是，用户应该能够提供比较函数，而不是经历创建 S3 类的考验(这类似于 Python 、 cpp 、 Java 、 Go 等中的实现.)

# Try 1
mySort <- function(someList, compare) {
  `[.tmpclass` <- function(x, i, ...) structure(unclass(x)[i], class = 'tmpclass')
  `==.tmpclass` <- function(a, b) compare(a[[1]],b[[1]]) == 0
  `>.tmpclass` <- function(a, b) compare(a[[1]],b[[1]]) > 0
  
  class(someList) <- 'tmpclass'
  sort(someList)
}

# Try 2
mySort <- function(someList, compare) {
  local({
    class(someList) <- 'tmpclass'
    sort(someList)

  }, envir = list(
    `[.tmpclass` = function(x, i, ...) structure(unclass(x)[i], class = 'tmpclass'),
    `==.tmpclass` = function(a, b) compare(a[[1]],b[[1]]) == 0,
    `>.tmpclass` = function(a, b) compare(a[[1]],b[[1]]) > 0
  ))
}

l <- list('hello', 'world', 'how', 'is', 'everything')

# sort by char length
mySort(l, compare = function(a,b) nchar(a) - nchar(b))

虽然顶层比较按预期工作，但一旦调用 sort，该临时 S3 类的所有“内存”就会丢失。因此，在 sort 调用之前进行调试时，诸如 someList[1] > someList[2] 之类的东西会产生预期的结果，但是一旦我进入 sort 调用，所有信息都会丢失。

奇怪的是，如果我显式设置 sort 函数的环境，我确实会更进一步。

environment(sort) <- environment()
sort(someList)

通过这个，如果我调试并进入sort，我仍然能够进行比较。然而，一旦 sort 调用更多底层方法，这些信息就会再次丢失。

如果我尝试调用 order (在某些时候也由 sort 调用)，情况也是如此。如果我在调用 order 之前设置环境，则在调试和单步执行该函数时比较可以正常工作。但是，一旦 order 调用 xtfrm(x)，这些信息似乎又丢失了。

mySort <- function(someList, compare) {
  `[.tmpclass` <- function(x, i, ...) structure(unclass(x)[i], class = 'tmpclass')
  `==.tmpclass` <- function(a, b) compare(a[[1]],b[[1]]) == 0
  `>.tmpclass` <- function(a, b) compare(a[[1]],b[[1]]) > 0
  
  class(someList) <- 'tmpclass'
  environment(order) <- environment()
  order(someList)
}

l <- list('hello', 'world', 'how', 'is', 'everything')
mySort(l, compare = function(a,b) nchar(a) - nchar(b))

由于 xtfrm 是一个我似乎无法调试的原始函数，因此我有一种预感，这实际上可能会导致问题。但我不确定。

最后，如果我使用一些俗气的全局环境版本，它确实可以工作。

mySort <- function(someList, compare) {
  # initialize globally
  `[.tmpclass` <<- function(x, i, ...) structure(unclass(x)[i], class = 'tmpclass')
  `==.tmpclass` <<- function(a, b) compare(a[[1]],b[[1]]) == 0
  `>.tmpclass` <<- function(a, b) compare(a[[1]],b[[1]]) > 0
  
  oldClass <- class(someList)
  class(someList) <- 'tmpclass'
  result <- sort(someList)
  
  # make sure not to leave garbage behind
  remove('[.tmpclass', '==.tmpclass', '>.tmpclass', envir = .GlobalEnv)
  structure(result, class = oldClass)
}

l <- list('hello', 'world', 'how', 'is', 'everything')
unlist(mySort(l, compare = function(a,b) nchar(a) - nchar(b)))
# [1] "is" "how" "hello" "world" "everything"

但是，这感觉不是一个可靠的答案，更不用说 CRAN 容易接受的东西了(除非有某种方法可以创建不会意外覆盖全局变量的唯一名称？)

有没有一种方法可以使用简单的比较函数对对象进行排序，而无需全局引入 S3 类？或者我现在应该编写自己的排序算法吗？

Answer 1

您不需要使用 S3 类在 R 中创建自定义排序函数。您可以将比较器函数应用于每对条目，然后对列表比较进行排序。

与您提到的其他语言一样，比较器函数通常是二进制逻辑函数，如果a“大于”b，则返回TRUE ，否则 FALSE，所以我将在这里坚持该约定。

我们简单地列出每个元素的比较“更大”的次数，并对结果表进行排序。排序表的名称为我们提供了原始列表的索引，但按我们的比较函数排序。

以下函数处理所有这些:

mySort <- function(someList, compare) {
  indices <- seq_along(someList)
  comps <- expand.grid(x = indices, y = indices)
  comps$diff <- apply(comps, 1, function(x)
    !compare(someList[[x[1]]], someList[[x[2]]])
  )
  answer <- table(comps$x, comps$diff)[,1] |> sort() |> names() |> as.numeric()
  result <- someList[answer]
  attributes(result) <- attributes(someList)
  names(result) <- names(someList)[answer]
  return(result)
}

这可以处理任意列表和向量，并以其原始格式返回数据。对字符串列表进行测试，我们有:

l <- list('hello', 'world', 'how', 'is', 'everything')

mySort(l, compare = function(a, b) nchar(a) > nchar(b))
#> [[1]]
#> [1] "is"
#> 
#> [[2]]
#> [1] "how"
#> 
#> [[3]]
#> [1] "hello"
#> 
#> [[4]]
#> [1] "world"
#> 
#> [[5]]
#> [1] "everything"

或者，在整数向量上进行测试，我们可以根据它们的值模 3 对它们进行排序:

l2 <- c(1, 2, 3, 4, 5, 6)

mySort(l2, compare = function(a, b) a %% 3 > b %% 3)
#> [1] 3 6 1 4 2 5

我们甚至可以按照指定的标准对向量列表(如数据框)进行排序。例如，我们根据每列中的第一个值对 mtcars 的列进行排序:

head(mySort(mtcars, compare = function(a, b) a[1] > b[1]))
#>                   vs am    wt drat gear carb cyl  qsec  mpg  hp disp
#> Mazda RX4          0  1 2.620 3.90    4    4   6 16.46 21.0 110  160
#> Mazda RX4 Wag      0  1 2.875 3.90    4    4   6 17.02 21.0 110  160
#> Datsun 710         1  1 2.320 3.85    4    1   4 18.61 22.8  93  108
#> Hornet 4 Drive     1  0 3.215 3.08    3    1   6 19.44 21.4 110  258
#> Hornet Sportabout  0  0 3.440 3.15    3    2   8 17.02 18.7 175  360
#> Valiant            1  0 3.460 2.76    3    1   6 20.22 18.1 105  225

为了演示它在任意对象列表上的工作情况，让我们根据内存大小对 lm 对象列表进行排序:

models <- list(iris = lm(Sepal.Length ~ Petal.Width + Species, data = iris),
               mtcars = lm(mpg ~ wt, data = mtcars))

mySort(models, function(a, b) object.size(a) > object.size(b))
#> $mtcars
#> 
#> Call:
#> lm(formula = mpg ~ wt, data = mtcars)
#> 
#> Coefficients:
#> (Intercept)           wt  
#>      37.285       -5.344  
#> 
#> 
#> $iris
#> 
#> Call:
#> lm(formula = Sepal.Length ~ Petal.Width + Species, data = iris)
#> 
#> Coefficients:
#>       (Intercept)        Petal.Width  Speciesversicolor   Speciesvirginica  
#>           4.78044            0.91690           -0.06025           -0.05009

^{创建于 2023-01-08，使用 reprex v2.0.2}