Generate unique number patterns (for example, 1221 considered the same pattern as 2112)

Question

I have a data frame containing 7 different dilutions that I want to assign to 3 different bins in all possible combinations for later use in lpSolve . I can generate all 2187 possible combinations using:

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

However, since the actual cell number is not important (but there is a position), the following entries are considered identical in this context:

 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) ... 

How to create only unique "templates", either by filtering the output of expand.grid , or using another (custom) function. For example, the lengths deduced from rle all of the above vectors would be 2 3 2 , but this would also be the case for c(1, 1, 2, 2, 2, 1, 1) , which should not be considered identical to the above.

Any quick way around this? I do not need to go above 5 bins and 8 dilutions.

Answer 1

Here is the answer:

 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 

And the logic is as follows: take c(3,3,1,2,1,2,3) , and now I will convert it to c(1,1,2,3,2,3,1) , because 3 is the first unique number from the beginning, 1 is the second and 2 is the third. This way I convert all the strings to the same format and this allows me to use duplicated . setNames was useful here, it creates a map from one set of integers to another:

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

Finally, the proof:

This takes into account cases when one, two or three different numbers are used. In particular: [(one number occupies all 7 positions)] + [(selection of one position for one number, and everything else for another) + (selection of two positions for one number, and everything else for another) + (selection of 3 positions, and everything else is for another)] + [(select 1 position for the first number, 1 position for the second and all the others for the third number. Now 1 and 2 are considered the same, and both of them occur once, so we must divide this term into two) + ... (the same logic as before) ...]

Answer 2

It?

 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))), ] 

Or, as @Arun pointed out:

 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

This is an IMO combinatorial question.

I think for 7 elements you want to select 2 first and select 2 from the remaining 5, which gives a total of 210 combinations.

Thanks to Arun, who pointed out that the combination of 11 22 333 is the same as 22 11 333, we can conclude that since the first 2 elements are those that can change, our required number of combinations should be half 210, which is 105

 library(gtools) # Let 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