根据偏好组合样本中的数字
Combining numbers in a sample based on preferences
所以我正在为棋盘游戏编写函数，并且我有示例“Rolls”，它由以下人员提供：
Rolls <- sample(1:6, 6, replace = TRUE)
我想要的是让我的样本优先考虑某些数字（如果这有意义的话），基本上，假设我想要从样本中获得尽可能多的 4。我有的选择是保留我掷出的所有 4，然后将成对的掷出数相加以得到更多的 4。我可能没有解释清楚所以这里是一个例子：
假设我掷出 3 4 2 1 1 1，我有一个 4 我想保留（所以我就留下它）但我也看到我有一个 3 和 1 可以从样本中取出加在一起得到另一个 4，所以我希望我的代码能够做到这一点，我希望它尽可能多地得到 4。我还有一个 2 和两个 1 的剩余部分可以组成 4，但是，我不允许将超过 2 个数字加在一起，所以不应该这样做。最后我的新样本应该是这样的：4 2 1 1 4（数字的位置无关紧要）
我希望我已经成功地解释了我的场景，以便理解，如果需要任何说明，我可以提供。
提前致谢
以下似乎可行。我尝试编写具有解释性名称的函数，并且每一步都以一种不难理解它正在做什么的方式编写。
主要思想是使用内置 {utils} 中的 combn() 来获取具有“合并”可能组合的数据框。
在可能的组合中，我们只能合并一次 1 个骰子。 （如果你已经合并了 1st 和 3rd，你不应该能够合并 3rd 和 4th，因为 3rd 已经被使用了）。此步骤在 get_vec_of_dice_to_remove 中完成。然后最后我们将每 2 个骰子替换为合并目标之一。
我确信有更好、更有效的方法来做到这一点，但我无法编写。还有其他步骤（调用）少得多的方法，但我更愿意将其保留得更明确，以便您可以了解正在发生的事情，如果您希望可以改进，请删除一些不必要的步骤或调整您喜欢的方式。
(提示：如果你想一步步跟随函数内部发生的事情，下次你使用debugonce(merge_dice_matching_nr)输入debug mode 运行 函数。在调试模式下，您可以 慢慢浏览 函数并在 内部 函数中检查每个对象。）
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
另一个允许数字向量参数的实现
这是另一个允许数字向量输入的选项，因此它一次处理一个项目。
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
其他两个功能不变
回复评论
这应该有效
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
所以我正在为棋盘游戏编写函数，并且我有示例“Rolls”，它由以下人员提供：
Rolls <- sample(1:6, 6, replace = TRUE)
我想要的是让我的样本优先考虑某些数字（如果这有意义的话），基本上，假设我想要从样本中获得尽可能多的 4。我有的选择是保留我掷出的所有 4，然后将成对的掷出数相加以得到更多的 4。我可能没有解释清楚所以这里是一个例子：
假设我掷出 3 4 2 1 1 1，我有一个 4 我想保留（所以我就留下它）但我也看到我有一个 3 和 1 可以从样本中取出加在一起得到另一个 4，所以我希望我的代码能够做到这一点，我希望它尽可能多地得到 4。我还有一个 2 和两个 1 的剩余部分可以组成 4，但是，我不允许将超过 2 个数字加在一起，所以不应该这样做。最后我的新样本应该是这样的：4 2 1 1 4（数字的位置无关紧要）
我希望我已经成功地解释了我的场景，以便理解，如果需要任何说明，我可以提供。
提前致谢
以下似乎可行。我尝试编写具有解释性名称的函数，并且每一步都以一种不难理解它正在做什么的方式编写。
主要思想是使用内置 {utils} 中的 combn() 来获取具有“合并”可能组合的数据框。
在可能的组合中，我们只能合并一次 1 个骰子。 （如果你已经合并了 1st 和 3rd，你不应该能够合并 3rd 和 4th，因为 3rd 已经被使用了）。此步骤在 get_vec_of_dice_to_remove 中完成。然后最后我们将每 2 个骰子替换为合并目标之一。
我确信有更好、更有效的方法来做到这一点，但我无法编写。还有其他步骤（调用）少得多的方法，但我更愿意将其保留得更明确，以便您可以了解正在发生的事情，如果您希望可以改进，请删除一些不必要的步骤或调整您喜欢的方式。
(提示：如果你想一步步跟随函数内部发生的事情，下次你使用debugonce(merge_dice_matching_nr)输入debug mode 运行 函数。在调试模式下，您可以 慢慢浏览 函数并在 内部 函数中检查每个对象。）
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
另一个允许数字向量参数的实现
这是另一个允许数字向量输入的选项，因此它一次处理一个项目。
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
其他两个功能不变
回复评论
这应该有效
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