So I'm writing a function for a board game and I have the sample "Rolls" which is given by:
Rolls <- sample(1:6, 6, replace = TRUE)
What I want is for my sample to prioritize certain numbers (if that makes sense), basically, let's say I want as many 4's as I can get from the sample. The options I have are to keep all the 4's I roll and to add up PAIRS of rolls to make more 4's. I might not have explained it well so here is an example:
Let's say I roll 3 4 2 1 1 1, I have a 4 that i want to keep (so i just leave it) but I also see that I have a 3 and 1 that I could take from the sample and add together to make another 4, so i want my code to do it, I want it to make as many 4's as possible. I also have a 2 and two 1's leftover that could make a 4, however, I'm not allowed to add up more than 2 numbers together so this should not be done. In the end my new sample should look like this: 4 2 1 1 4 (position of numbers is irrelevant)
I hope I've managed to explain my scenario well enough to understand, if any clarification is needed I can provide it.
Thanks in advance
The following seems to work. I tried to write the functions with explanatory names and each step in a way that is not to hard to follow what it is doing.
the main idea is using combn() from built-in {utils} to get a data frame with possible combinations for "merging".
From the possible combinations, we can only merge 1 die once. (if you already merged the 1st and the 3rd, you should not be able to merge the 3rd and 4th, because the 3rd was already used). This step is done in get_vec_of_dice_to_remove. And then in the end we replace every 2 dice for one of the merging target.
I am sure that there are better and more efficient ways of doing it that I am not able to write. There are also other ways with much less steps (calls) but I prefer to leave it more explicit so that you can follow what is going on, and if you wish you can improve, remove some unnecessary steps or adapt the way you prefer.
(tip: if you want to follow step by step what goes on inside the function, use debugonce(merge_dice_matching_nr) to enter debug mode the next time you run the function. In debug mode you can walk slowly through the function and check each object while inside the function.)
library(dplyr)
roll_dice <- function(nr_of_dice = 6) {
sample(1:6, nr_of_dice, replace = TRUE)
}
get_data_frame_of_possible_combs <- function(throw, merging) {
possible_combinations <- t(combn(throw, 2))
sums_possible_combinations <- rowSums(possible_combinations)
posit <- t(combn(x=1:length(throw), 2))
df_res <- data.frame(possible_combinations,
sums_possible_combinations,
match = (sums_possible_combinations == merging),
posit) %>%
filter(match == TRUE)
names(df_res) <- c("die_1", "die_2", "sums_possible", "match", "pos_d1", "pos_d2")
return(df_res)
}
get_vec_of_dice_to_remove <- function(df) {
vec_of_dice <- c()
for (i in 1:nrow(df)) {
row_of_df <- slice(df, 1)
dice <- c(row_of_df$pos_d1, row_of_df$pos_d2)
df <- df %>% filter( !(pos_d1 %in% dice | pos_d2 %in% dice) )
vec_of_dice <- append(vec_of_dice, dice)
if (nrow(df)==0) { break }
}
return(vec_of_dice)
}
merge_dice_matching_nr <- function(throw, merging, merged_results_only=FALSE) {
df_res <- get_data_frame_of_possible_combs(throw = throw, merging = merging)
vec_to_remove <- get_vec_of_dice_to_remove(df_res)
if (length(vec_to_remove)>0) {
# if there is nothing to merge, return results_merged as the original throw
res_merged <- append(throw[-vec_to_remove], rep(merging, length(vec_to_remove)/2))
} else {
res_merged <- throw
}
if (merged_results_only) {
return(c(res_merged))
}
ret_list <- list("orignial_throw" = throw,
"dice_posit_to_remove" = vec_to_remove,
"results_merged" = res_merged)
return(ret_list)
}
set.seed(2)
(roll <- roll_dice()) %>%
merge_dice_matching_nr(merging = 2)
#> $orignial_throw
#> [1] 5 6 6 1 5 1
#>
#> $dice_posit_to_remove
#> [1] 4 6
#>
#> $results_merged
#> [1] 5 6 6 5 2
roll %>%
merge_dice_matching_nr(merging = 2, merged_results_only = T) %>%
merge_dice_matching_nr(merging = 12, merged_results_only = T) %>%
merge_dice_matching_nr(merging = 10, merged_results_only = T) %>%
merge_dice_matching_nr(merging = 12, merged_results_only = T) %>%
merge_dice_matching_nr(merging = 24, merged_results_only = T)
#> [1] 24
set.seed(2)
(roll <- roll_dice() )
#> [1] 5 6 6 1 5 1
roll %>% merge_dice_matching_nr(merging = 2)
#> $orignial_throw
#> [1] 5 6 6 1 5 1
#>
#> $dice_posit_to_remove
#> [1] 4 6
#>
#> $results_merged
#> [1] 5 6 6 5 2
roll %>% merge_dice_matching_nr(merging = 5)
#> $orignial_throw
#> [1] 5 6 6 1 5 1
#>
#> $dice_posit_to_remove
#> integer(0)
#>
#> $results_merged
#> numeric(0)
roll %>% merge_dice_matching_nr(merging = 6)
#> $orignial_throw
#> [1] 5 6 6 1 5 1
#>
#> $dice_posit_to_remove
#> [1] 1 4 5 6
#>
#> $results_merged
#> [1] 6 6 6 6
this is another option that allows for a numeric vector input, so that it deals with one item at a time.
merge_dice_matching_nr <- function(throw, merging, merged_results_only=FALSE) {
i_throw <- throw
for (i in 1:length(merging)) {
i_merging <- merging[i]
df_res <- get_data_frame_of_possible_combs(throw = i_throw, merging = i_merging)
vec_to_remove <- get_vec_of_dice_to_remove(df_res)
if (length(vec_to_remove)>0) {
# if there is nothing to merge, return results_merged as the original throw
res_merged <- append(i_throw[-vec_to_remove], rep(i_merging, length(vec_to_remove)/2))
} else {
res_merged <- i_throw
}
i_throw <- res_merged
}
if (merged_results_only) {
return(c(res_merged))
}
ret_list <- list("original_throw" = throw,
"dice_posit_to_remove" = vec_to_remove,
"results_merged" = res_merged)
return(ret_list)
}
set.seed(2)
(roll <- roll_dice()) %>%
merge_dice_matching_nr(merging = 2)
roll %>%
merge_dice_matching_nr(merging = c(2, 12, 10, 12, 24))
# $original_throw
# [1] 5 6 6 1 5 1
# $dice_posit_to_remove
# [1] 1 2
# $results_merged
# [1] 24
the other two functions remain the same.
this should work
set.seed(1212)
Rolls <- roll_dice()
Rolls
# [1] 2 1 5 4 6 4
Rolls <- Rolls %>% merge_dice_matching_nr(merging = 6, merged_results_only = T)
Rolls
# [1] 6 4 6 6
Rolls <- Rolls %>% merge_dice_matching_nr(5, merged_results_only = T)
Rolls
# [1] 6 4 6 6