R: перечисление возможных последовательностей для разрыва связей в рейтинге

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

Предположим, что у меня есть вышеприведенный рейтинг из 8 пунктов. Есть 2 способа разорвать эту связь: 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)
1 2
function algorithm ranking

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

Результатом должны быть данные.фрейм, где каждая строка является одной из возможных последовательностей (последовательности являются индексами отсортированных данных).

1