生成數字的獨特模式（例如1221視爲相同的圖案2112）

Question

我有包含我要分配到用於lpSolve以後使用所有可能的組合3個不同的二進制位7個不同稀釋度的數據幀。餘可使用產生的所有2187個可能的組合：

expand.grid(1:3, 1:3, 1:3, 1:3, 1:3, 1:3, 1:3) 

然而，由於實際段數並不重要（但位置是），以下條目都被認爲是在這種情況下相同的：

c(1, 1, 2, 2, 2, 3, 3) 
c(2, 2, 3, 3, 3, 1, 1) 
c(3, 3, 1, 1, 1, 2, 2) 
c(3, 3, 2, 2, 2, 1, 1) 
c(1, 1, 3, 3, 3, 2, 2) 
... 

如何通過過濾expand.grid輸出或使用其他（自定義）函數生成唯一的「模式」。例如，從rle輸出的所有上述矢量的長度將爲2 3 2，但這也將是c(1, 1, 2, 2, 2, 1, 1)的情況，這應該不被視爲與上述相同。

任何快速解決方法？我不需要超過5個箱子和8個稀釋度。

Answer 1

這裏有一個答案：

mat <- expand.grid(1:3, 1:3, 1:3, 1:3, 1:3, 1:3, 1:3) 

mat <- t(apply(mat, 1, 
       function(x){ 
       un <- unique(x) 
       map <- setNames(1:length(un), un) 
       map[as.character(x)] 
       })) 

mat <- mat[!duplicated(mat), ] 
nrow(mat) 
# [1] 365 

和邏輯是這樣的：讓我們來c(3,3,1,2,1,2,3)，現在我將其轉換爲c(1,1,2,3,2,3,1) ，因爲3是第一個唯一的數字從一開始，1是第二個第三個是d 2。通過這種方式，我將所有行轉換爲相同的格式，並允許我使用duplicated。 setNames是有用的在這裏，它從一個整數集創建地圖到另一個：

setNames(1:3,3:1) 
3 2 1 
1 2 3 
setNames(1:3,3:1)[c("2","1")] 
2 1 
2 3 

最後證明：

兼顧情況下，當一個，兩個或使用三個不同的數字。特別是：[（一個數字佔全部7個位置）] + [（爲一個數字選擇1個位置，其餘全部爲另一個數字）+（選擇2個位置代表一個數字，其餘全部代表另一個數字）+（選擇3個職位，其餘全部爲另一個職位）] + [（第一個數字選擇1個位置，第二個數字選擇1個位置，其餘的第三個數字選擇第三個數字，現在第一個和第二個數字被認爲是相同的，一次，所以我們必須除以兩）+ ...（與以前相同的邏輯）...]

Answer 2

This？

data <- expand.grid(1:3, 1:3, 1:3, 1:3, 1:3, 1:3, 1:3) 
len <- apply(data,1,function(x) c(rle(x)$lengths[1:7], nchar(paste(unique(sort(rle(x)$value)), collapse='')))) 
data <- data[!(duplicated(t(len))), ] 

或者，如@Arun指出：

data <- expand.grid(1:3, 1:3, 1:3, 1:3, 1:3, 1:3, 1:3) 
len <- apply(data,1,function(x) c(rle(x)$lengths[1:7], length(unique(x)))) 
data <- data[!(duplicated(t(len))), ] 

Answer 3

這是IMO的組合問題。

我認爲對於7個元素，您想先選擇2個，然後從剩餘的5箇中選擇2個，從而得到總共210個組合。

感謝Arun，他指出組合11 22 333與22 11 333相同，我們可以推斷出由於前2個元素是可以互換的元素，我們所需的組合數量應該是210的一半，即105

library(gtools) 

# Let's create all possible permutations of 7 elements which will be equal to 7! 
p <- permutations(7, 7, 1:7) 

head(p) 
##  [,1] [,2] [,3] [,4] [,5] [,6] [,7] 
## [1,] 1 2 3 4 5 6 7 
## [2,] 1 2 3 4 5 7 6 
## [3,] 1 2 3 4 6 5 7 
## [4,] 1 2 3 4 6 7 5 
## [5,] 1 2 3 4 7 5 6 
## [6,] 1 2 3 4 7 6 5 


# bin, sort and combine according to our binning vector c(1,1,2,2,3,3,3) 
rp <- t(apply(p, 1, FUN = function(x) as.numeric(sapply(split(x, c(1, 1, 2, 2, 3, 3, 3)), FUN = function(x) paste0(x[order(x)], collapse = ""))))) 

head(rp) 
##  [,1] [,2] [,3] 
## [1,] 12 34 567 
## [2,] 12 34 567 
## [3,] 12 34 567 
## [4,] 12 34 567 
## [5,] 12 34 567 
## [6,] 12 34 567 


# sort individual combinations before removing duplicates 
srp <- t(apply(rp, 1, function(x) x[order(x)])) 

head(srp) 
##  [,1] [,2] [,3] 
## [1,] 12 34 567 
## [2,] 12 34 567 
## [3,] 12 34 567 
## [4,] 12 34 567 
## [5,] 12 34 567 
## [6,] 12 34 567 


# remove duplicates 
srp[!duplicated(srp), ] 
##  [,1] [,2] [,3] 
## [1,] 12 34 567 
## [2,] 12 35 467 
## [3,] 12 36 457 
## [4,] 12 37 456 
## [5,] 12 45 367 
## [6,] 12 46 357 
## [7,] 12 47 356 
## [8,] 12 56 347 
## [9,] 12 57 346 
## [10,] 12 67 345 
## [11,] 13 24 567 
## [12,] 13 25 467 
## [13,] 13 26 457 
## [14,] 13 27 456 
## [15,] 13 45 267 
## [16,] 13 46 257 
## [17,] 13 47 256 
## [18,] 13 56 247 
## [19,] 13 57 246 
## [20,] 13 67 245 
## [21,] 14 23 567 
## [22,] 14 25 367 
## [23,] 14 26 357 
## [24,] 14 27 356 
## [25,] 14 35 267 
## [26,] 14 36 257 
## [27,] 14 37 256 
## [28,] 14 56 237 
## [29,] 14 57 236 
## [30,] 14 67 235 
## [31,] 15 23 467 
## [32,] 15 24 367 
## [33,] 15 26 347 
## [34,] 15 27 346 
## [35,] 15 34 267 
## [36,] 15 36 247 
## [37,] 15 37 246 
## [38,] 15 46 237 
## [39,] 15 47 236 
## [40,] 15 67 234 
## [41,] 16 23 457 
## [42,] 16 24 357 
## [43,] 16 25 347 
## [44,] 16 27 345 
## [45,] 16 34 257 
## [46,] 16 35 247 
## [47,] 16 37 245 
## [48,] 16 45 237 
## [49,] 16 47 235 
## [50,] 16 57 234 
## [51,] 17 23 456 
## [52,] 17 24 356 
## [53,] 17 25 346 
## [54,] 17 26 345 
## [55,] 17 34 256 
## [56,] 17 35 246 
## [57,] 17 36 245 
## [58,] 17 45 236 
## [59,] 17 46 235 
## [60,] 17 56 234 
## [61,] 23 45 167 
## [62,] 23 46 157 
## [63,] 23 47 156 
## [64,] 23 56 147 
## [65,] 23 57 146 
## [66,] 23 67 145 
## [67,] 24 35 167 
## [68,] 24 36 157 
## [69,] 24 37 156 
## [70,] 24 56 137 
## [71,] 24 57 136 
## [72,] 24 67 135 
## [73,] 25 34 167 
## [74,] 25 36 147 
## [75,] 25 37 146 
## [76,] 25 46 137 
## [77,] 25 47 136 
## [78,] 25 67 134 
## [79,] 26 34 157 
## [80,] 26 35 147 
## [81,] 26 37 145 
## [82,] 26 45 137 
## [83,] 26 47 135 
## [84,] 26 57 134 
## [85,] 27 34 156 
## [86,] 27 35 146 
## [87,] 27 36 145 
## [88,] 27 45 136 
## [89,] 27 46 135 
## [90,] 27 56 134 
## [91,] 34 56 127 
## [92,] 34 57 126 
## [93,] 34 67 125 
## [94,] 35 46 127 
## [95,] 35 47 126 
## [96,] 35 67 124 
## [97,] 36 45 127 
## [98,] 36 47 125 
## [99,] 36 57 124 
## [100,] 37 45 126 
## [101,] 37 46 125 
## [102,] 37 56 124 
## [103,] 45 67 123 
## [104,] 46 57 123 
## [105,] 47 56 123