Блог

Мне нужна функция, аналогичная expand.grid , но без комбинаций повторяющихся элементов.

Вот упрощенная версия моей проблемы.

 X1 = c("x","y","z")
X2 = c("A","B","C")
X3 = c("y","C","G")

d <- expand.grid(X1,X2,X3)

d
   Var1 Var2 Var3
1     x    A    y
2     y    A    y
3     z    A    y
4     x    B    y
.     .    .    .
.     .    .    .
.     .    .    .
23    y    B    G
24    z    B    G
25    x    C    G
26    y    C    G
27    z    C    G
 

d имеет 27 рядов. Но 6 из них содержат повторяющиеся значения, которые мне не нужны.: 2, 5, 8, 16, 17 amp; 18

Есть ли способ получить остальные 21 строку, которые не содержат никаких дубликатов.

Обратите внимание, что векторы имеют более 3 элементов ( c("x","y","z","k","m"...) до 50), а количество векторов в реальном случае превышает 3. ( X4 , X5 , X6 … до 11 ). Из-за этого расширенный объект становится очень большим, и оперативная память не может с ним справиться.

В RcppAlgos ^* есть функция, comboGrid которая выполняет эту функцию:

 library(RcppAlgos) ## as of v2.4.3
comboGrid(X1, X2, X3, repetition = F)
#      Var1 Var2 Var3
#  [1,] "x"  "A"  "C" 
#  [2,] "x"  "A"  "G" 
#  [3,] "x"  "A"  "y" 
#  [4,] "x"  "B"  "C" 
#  [5,] "x"  "B"  "G" 
#  [6,] "x"  "B"  "y" 
#  [7,] "x"  "C"  "G" 
#  [8,] "x"  "C"  "y" 
#  [9,] "y"  "A"  "C" 
# [10,] "y"  "A"  "G" 
# [11,] "y"  "B"  "C" 
# [12,] "y"  "B"  "G" 
# [13,] "y"  "C"  "G" 
# [14,] "z"  "A"  "C" 
# [15,] "z"  "A"  "G" 
# [16,] "z"  "A"  "y" 
# [17,] "z"  "B"  "C" 
# [18,] "z"  "B"  "G" 
# [19,] "z"  "B"  "y" 
# [20,] "z"  "C"  "G" 
# [21,] "z"  "C"  "y"
 

Большой Тест

 set.seed(42)
rnd_lst <- lapply(1:11, function(x) {
    sort(sample(LETTERS, sample(26, 1)))
})

## Number of results that expand.grid would return if your machine
## had enough memory... over 300 trillion!!!
prettyNum(prod(lengths(rnd_lst)), big.mark = ",")
# [1] "365,634,846,720"

exp_grd_test <- expand.grid(rnd_lst)
# Error: vector memory exhausted (limit reached?)

system.time(cmb_grd_test <- comboGrid(rnd_lst, repetition=FALSE))
#  user  system elapsed 
# 9.866   0.330  10.196 

dim(cmb_grd_test)
# [1] 3036012      11

head(cmb_grd_test)
#     Var1 Var2 Var3 Var4 Var5 Var6 Var7 Var8 Var9 Var10 Var11
# [1,] "A"  "E"  "C"  "B"  "D"  "G"  "F"  "H"  "J"  "I"   "K"  
# [2,] "A"  "E"  "C"  "B"  "D"  "G"  "F"  "H"  "J"  "I"   "L"  
# [3,] "A"  "E"  "C"  "B"  "D"  "G"  "F"  "H"  "J"  "I"   "M"  
# [4,] "A"  "E"  "C"  "B"  "D"  "G"  "F"  "H"  "J"  "I"   "N"  
# [5,] "A"  "E"  "C"  "B"  "D"  "G"  "F"  "H"  "J"  "I"   "O"  
# [6,] "A"  "E"  "C"  "B"  "D"  "G"  "F"  "H"  "J"  "I"   "P"
 

^* Я являюсь автором RcppAlgos

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

основание R

Я жестко закодировал «3», но вы можете использовать ncol(d) и/или ncol(d)-1 для программного использования.

 d[lengths(apply(d, 1, unique)) > 2, ]
#    Var1 Var2 Var3
# 1     x    A    y
# 3     z    A    y
# 4     x    B    y
# 6     z    B    y
# 7     x    C    y
# 9     z    C    y
# 10    x    A    C
# 11    y    A    C
# 12    z    A    C
# 13    x    B    C
# 14    y    B    C
# 15    z    B    C
# 19    x    A    G
# 20    y    A    G
# 21    z    A    G
# 22    x    B    G
# 23    y    B    G
# 24    z    B    G
# 25    x    C    G
# 26    y    C    G
# 27    z    C    G
 

(Имена строк не сбрасываются, вы можете увидеть пробелы, чтобы убедиться, что это не 27 строк.)

И чтобы убедиться, вот строки с дураками:

 d[lengths(apply(d, 1, unique)) < 3, ]
#    Var1 Var2 Var3
# 2     y    A    y
# 5     y    B    y
# 8     y    C    y
# 16    x    C    C
# 17    y    C    C
# 18    z    C    C