Solution
The figure shows all the possible arrangements of the five dolls. The letter indicates the colour: R for red, Y for yellow and so on. The index indicates the doll size: 5 for the smallest and 1 for the largest.
As an example, the top path - P1 R2 G3 Y4 B5
- corresponds to the combination pink, red, green, yellow and blue (from the largest to the smallest doll).
Further, B5
occupies the left hand size since we know the smallest doll is blue.
With the a few lines of code I recreate the figure. Each row of the output corresponds to a set of five dolls. For example, the last row corresponds to the combination yellow, red, pink, green and blue. In total, we have 24 possible arrangements - same as in the figure.
# pkgs used in this post
library(gtools)
library(stringi)
library(stringr)
library(rebus)
library(purrr)
colour <- c("blue", "yellow", "pink", "red", "green") # all the different colours
numb <- 1:5 # the size index (1 is the largest)
opt <- paste0(rep(colour, each = 5), "_", numb) # combine colour and index
perms <- permutations(n = 25, r = 5, v = opt, repeats.allowed = F) # all the combinations of 5 dolls
# define function to use
my_fun <- function(x, data, pattern = NULL){
# x: the row index of `data`
# data: the input dataset
# pattern: the pattern to search for in each row of `data`
if(is.null(pattern)){
perms3 <- stri_split_fixed(data[x,], "_", simplify = T) # split the vectors into two
dupl <- sum(stri_duplicated(perms3[,1])) # check for uniqueness
sorted <- is.unsorted(perms3[,2], strictly = T) # check for correct order
if(dupl == 0 & sorted == 0){ # if no duplicated and correct order data is returned
out <- data[x,]
} else {
out <- c()
}
} else {
splitted <- stri_split_fixed(data[x,], "_", simplify = T) # split the vectors into two
ind <- str_detect(paste(splitted[,1], collapse = ""), pattern = pattern, negate = T) # find patterns
if(ind == 1){ # if pattern is found it's returned
out <- data[x,]
}else{
out <- c()
}
}
return(out)
}
##### add restrictions
# 1: select only the ones where blue is the smallest doll
blue_smallest_doll <- which(perms[,5] == "blue_5") # blue is the smallest doll
perms2 <- perms[blue_smallest_doll,]
# 2: select only the combinations where each colour appears once and indexes are sorted correctly
combinations <- matrix( # simplify final result into a matrix
unlist( # simplify output of map()
map(1:nrow(perms2), my_fun, data = perms2)), # apply my_fun to all rows of perms2
ncol = 5, byrow = TRUE)
combinations
## [,1] [,2] [,3] [,4] [,5]
## [1,] "green_1" "pink_2" "red_3" "yellow_4" "blue_5"
## [2,] "green_1" "pink_2" "yellow_3" "red_4" "blue_5"
## [3,] "green_1" "red_2" "pink_3" "yellow_4" "blue_5"
## [4,] "green_1" "red_2" "yellow_3" "pink_4" "blue_5"
## [5,] "green_1" "yellow_2" "pink_3" "red_4" "blue_5"
## [6,] "green_1" "yellow_2" "red_3" "pink_4" "blue_5"
## [7,] "pink_1" "green_2" "red_3" "yellow_4" "blue_5"
## [8,] "pink_1" "green_2" "yellow_3" "red_4" "blue_5"
## [9,] "pink_1" "red_2" "green_3" "yellow_4" "blue_5"
## [10,] "pink_1" "red_2" "yellow_3" "green_4" "blue_5"
## [11,] "pink_1" "yellow_2" "green_3" "red_4" "blue_5"
## [12,] "pink_1" "yellow_2" "red_3" "green_4" "blue_5"
## [13,] "red_1" "green_2" "pink_3" "yellow_4" "blue_5"
## [14,] "red_1" "green_2" "yellow_3" "pink_4" "blue_5"
## [15,] "red_1" "pink_2" "green_3" "yellow_4" "blue_5"
## [16,] "red_1" "pink_2" "yellow_3" "green_4" "blue_5"
## [17,] "red_1" "yellow_2" "green_3" "pink_4" "blue_5"
## [18,] "red_1" "yellow_2" "pink_3" "green_4" "blue_5"
## [19,] "yellow_1" "green_2" "pink_3" "red_4" "blue_5"
## [20,] "yellow_1" "green_2" "red_3" "pink_4" "blue_5"
## [21,] "yellow_1" "pink_2" "green_3" "red_4" "blue_5"
## [22,] "yellow_1" "pink_2" "red_3" "green_4" "blue_5"
## [23,] "yellow_1" "red_2" "green_3" "pink_4" "blue_5"
## [24,] "yellow_1" "red_2" "pink_3" "green_4" "blue_5"
Then, we need to take into account the two additional restrictions:
- “no doll that contains a pink doll with a red doll anywhere within it”, and
- “no yellow doll contains a green doll with a pink doll anywhere within it”.
The first one is easy. We need to discard all solutions where pink is followed by red. This gives us 12 remaining solutions.
# 3: apply first restriction
# specify pattern: "no doll contains a pink with a red doll anywhere within it"
pattern_pink_red <- ("pink" %R% zero_or_more(WRD) %R% "red")
combinations_update <- matrix(
unlist(
map(1:nrow(combinations), my_fun, data = combinations, pattern = pattern_pink_red)),
ncol = 5, byrow = TRUE)
combinations_update
## [,1] [,2] [,3] [,4] [,5]
## [1,] "green_1" "red_2" "pink_3" "yellow_4" "blue_5"
## [2,] "green_1" "red_2" "yellow_3" "pink_4" "blue_5"
## [3,] "green_1" "yellow_2" "red_3" "pink_4" "blue_5"
## [4,] "red_1" "green_2" "pink_3" "yellow_4" "blue_5"
## [5,] "red_1" "green_2" "yellow_3" "pink_4" "blue_5"
## [6,] "red_1" "pink_2" "green_3" "yellow_4" "blue_5"
## [7,] "red_1" "pink_2" "yellow_3" "green_4" "blue_5"
## [8,] "red_1" "yellow_2" "green_3" "pink_4" "blue_5"
## [9,] "red_1" "yellow_2" "pink_3" "green_4" "blue_5"
## [10,] "yellow_1" "green_2" "red_3" "pink_4" "blue_5"
## [11,] "yellow_1" "red_2" "green_3" "pink_4" "blue_5"
## [12,] "yellow_1" "red_2" "pink_3" "green_4" "blue_5"
Now, we move on to the second restriction. Unfortunately, the 2nd restriction is a bit vague, leading to different interpretations and different final solutions. Here are a few examples.
1st interpretation
A way to interpret the restriction is to remove all solutions where a pink doll is inside a green one, which is at the same time, inside a yellow one. This results in 9 solutions.
##### 1st interpretation
# specify pattern: "no yellow doll contains a green doll with a pink inside it"
pattern_yellow_green_pink <- ("yellow" %R% zero_or_more(WRD) %R% "green" %R% zero_or_more(WRD) %R% "pink")
combinations_update1 <- matrix(
unlist(
map(1:nrow(combinations_update), my_fun, data = combinations_update,
pattern = pattern_yellow_green_pink)),
ncol = 5, byrow = TRUE)
combinations_update1
## [,1] [,2] [,3] [,4] [,5]
## [1,] "green_1" "red_2" "pink_3" "yellow_4" "blue_5"
## [2,] "green_1" "red_2" "yellow_3" "pink_4" "blue_5"
## [3,] "green_1" "yellow_2" "red_3" "pink_4" "blue_5"
## [4,] "red_1" "green_2" "pink_3" "yellow_4" "blue_5"
## [5,] "red_1" "green_2" "yellow_3" "pink_4" "blue_5"
## [6,] "red_1" "pink_2" "green_3" "yellow_4" "blue_5"
## [7,] "red_1" "pink_2" "yellow_3" "green_4" "blue_5"
## [8,] "red_1" "yellow_2" "pink_3" "green_4" "blue_5"
## [9,] "yellow_1" "red_2" "pink_3" "green_4" "blue_5"
2nd interpretation
Another interpretation is to additionally remove solutions where pink is inside green, independently of where yellow is. This results in 4 solutions.
##### 2nd interpretation
# specify pattern: "no green doll with a pink doll anywhere within it"
pattern_green_pink <- ("green" %R% zero_or_more(WRD) %R% "pink")
combinations_update2 <- matrix(
unlist(
map(1:nrow(combinations_update), my_fun, data = combinations_update,
pattern = or(pattern_yellow_green_pink, pattern_green_pink))),
ncol = 5, byrow = TRUE)
combinations_update2
## [,1] [,2] [,3] [,4] [,5]
## [1,] "red_1" "pink_2" "green_3" "yellow_4" "blue_5"
## [2,] "red_1" "pink_2" "yellow_3" "green_4" "blue_5"
## [3,] "red_1" "yellow_2" "pink_3" "green_4" "blue_5"
## [4,] "yellow_1" "red_2" "pink_3" "green_4" "blue_5"
3rd interpretation
Lastly, we can further remove solutions where green is inside yellow independently of where pink is.
#### 3rd interpretation
pattern_yellow_green<- ("yellow" %R% zero_or_more(WRD) %R% "green")
combinations_update3 <- matrix(
unlist(
map(1:nrow(combinations_update), my_fun, data = combinations_update,
pattern = or(pattern_yellow_green_pink, pattern_green_pink, pattern_yellow_green))),
ncol = 5, byrow = TRUE)
combinations_update3
## [,1] [,2] [,3] [,4] [,5]
## [1,] "red_1" "pink_2" "green_3" "yellow_4" "blue_5"
This gives a unique solution - R1 P2 G3 Y4 B5
- which does not seem to violate any of the restrictions. Unfortunately, it is different from the solution given by the New Scientist, which is Y1 R2 P3 G4 B5
!!!