R：枚举可能的序列以打破排名中的平局

Question

  MEMORY1 MEMORY2 MEMORY3 MEMORY4 MEMORY5 MEMORY6 MEMORY7 MEMORY8
        1     2.5     2.5       4       5       6       7       8

假设我有上面的8项排名。有两种方法可以打破这种平局：1 2 3 4 5 6 7 8 或 1 3 2 4 5 6 7 8。我正在尝试编写一个函数，在给出带有关系的原始排名时输出这两个可能的序列。

如

  MEMORY1 MEMORY2 MEMORY3 MEMORY4 MEMORY5 MEMORY6 MEMORY7 MEMORY8
      4.5     4.5     4.5     4.5     4.5     4.5     4.5     4.5

所有项目都是并列的，因此有 8! 个可能的顺序。 permn(8) 或类似的东西可以很好地枚举序列。

如

  MEMORY1 MEMORY2 MEMORY3 MEMORY4 MEMORY5 MEMORY6 MEMORY7 MEMORY8
      7.5       5       5       2     7.5       2       2       5

有 3! x 3! x 2! = 72 种可能的顺序。在给定原始排名的情况下，我如何编写一个函数来输出这 72 个可能的序列？

myfun = function(ranking){
  output = vector()
  values = sort(unique(ranking))
  if(length(values) < 8){
    #if there are ties
    for(i in 1:length(values)){
      value_in_question = values[i]
      if(sum(value_in_question %in% values[i] == 1)){
        output = output
      }else output[i] = permn(values[i])
    }
  }
  return(output)
}

这是我的尝试，没有用。当有多个关系时，我无法想出一种枚举序列的方法...

编辑：

dat = c(2.5, 2.5, 2.5, 2.5, 6.5, 6.5, 6.5, 6.5)
names(dat) <- paste0("MEMORY", 1:8)

## Group similar items, compute run lengths, then permute
library(combinat) # permn
gs <- cumsum(abs(c(0, diff(sort(dat)))) > 1e-9)
lens <- rle(gs)$lengths
lst <- mapply(function(a,b) lapply(permn(1:b), `+`, a), c(0, cumsum(head(lens, -1))), lens)

## Expand into data.frame (don't expand if all were the same)
res <- if(!is.null(dim(lst)) && dim(lst)[2] == 1) lst else expand.grid(lst)

 Error: cannot allocate vector of size 16.0 Gb
In addition: Warning messages:
1: In rep.int(seq_len(nx), rep.int(rep.fac, nx)) :
  Reached total allocation of 8070Mb: see help(memory.size)
2: In rep.int(seq_len(nx), rep.int(rep.fac, nx)) :
  Reached total allocation of 8070Mb: see help(memory.size)
3: In rep.int(seq_len(nx), rep.int(rep.fac, nx)) :
  Reached total allocation of 8070Mb: see help(memory.size)
4: In rep.int(seq_len(nx), rep.int(rep.fac, nx)) :
  Reached total allocation of 8070Mb: see help(memory.size)
5: In rep.int(seq_len(nx), rep.int(rep.fac, nx)) :
  Reached total allocation of 8070Mb: see help(memory.size)
6: In rep.int(seq_len(nx), rep.int(rep.fac, nx)) :
  Reached total allocation of 8070Mb: see help(memory.size)

Answer 1

由于您正在比较浮点数，因此您不想使用 == 测试。相反，检查数字之间的差异是否足够小。这是一个可能的解决方案，不要求效率。

## Example
dat <- c(7.5, 5, 5, 2, 7.5, 2, 2, 5)
names(dat) <- paste0("MEMORY", 1:8)

## Group similar items, compute run lengths, then permute
library(combinat) # permn
gs <- cumsum(abs(c(0, diff(sort(dat)))) > 1e-9)
lens <- rle(gs)$lengths
lst <- mapply(function(a,b) lapply(permn(1:b), `+`, a),
              c(0, cumsum(head(lens, -1))), lens, SIMPLIFY = FALSE)

## Expand into data.frame (don't expand if all were the same)
res <- if(!is.null(dim(lst)) && dim(lst)[2] == 1) lst else expand.grid(lst)

## Unnest columns if desired
res <- data.frame(t(apply(res, 1, unlist)))

## Name the columns
names(res) <- names(sort(dat))

head(res)
#   MEMORY4 MEMORY6 MEMORY7 MEMORY2 MEMORY3 MEMORY8 MEMORY1 MEMORY5
# 1       1       2       3       4       5       6       7       8
# 2       1       3       2       4       5       6       7       8
# 3       3       1       2       4       5       6       7       8
# 4       3       2       1       4       5       6       7       8
# 5       2       3       1       4       5       6       7       8
# 6       2       1       3       4       5       6       7       8
## Gets all 72 sequences from example: 3!*3!*2!
nrow(res)
# [1] 72

结果应该是 data.frame，其中每一行都是可能的序列之一（序列是排序数据的索引）。

R：枚举可能的序列以打破排名中的平局

R: enumerating possible sequences to break ties in a ranking

algorithm

r

function

ranking