用 R 实现检查某些数字的源头
楚新元 / 2025-05-23
这是来自统计之都论坛上的一个问题:R 语言能否实现检查某些数字的源头,具体问题描述(略有修改)如下:
现在有两个货柜 A 和 B,里面装的都是相同的东西,数量分别为 30 和 20。货柜 A 和 B 中的货都已发出,已知一共发了 7 个批次,每批次发货数量分别是:4、6、6、7、8、9、10。
现在只知道每批次发货数量,不知道从哪个货柜发的,需要根据每批次发货数量进行拼凑,给每批次发货添加一个来源货柜,保证来源货柜的总和 A、B 相同即可,不用考虑发货顺序。
梳理解决思路
因为有 7 个批次,每个批次都有可能从货柜 A 或者货柜 B 发出,因此就有 $2^7=128$
种可能性,我们可以把所有的情况枚举出来,然后筛选出货柜 A 数量为 30 的情况即可。
这个问题本身不复杂,可是要是通过纸笔罗列各种可能性再筛选就比较麻烦,但是有了 R 语言配合矩阵运算就很简单了。
代码实现
# 两个箱子
v = c(A = 1, B = 0)
# 批次货物数
Y = c(4, 6, 6, 7, 8, 9, 10)
# 各种可能组合
X = expand.grid(v, v, v, v, v, v, v)
# X = do.call(
# expand.grid,
# replicate(length(Y), v, simplify = FALSE)
# )
# 筛选符合条件的组合
X[as.matrix(X) %*% Y == 30, ]
#> Var1 Var2 Var3 Var4 Var5 Var6 Var7
#> 23 1 0 0 1 0 1 1
#> 42 0 1 1 0 1 0 1
#> 68 0 0 1 1 1 1 0
#> 70 0 1 0 1 1 1 0
肖楠认为“可以用 R6 写一个模拟框架,可能更贴近‘检查源头’的意思”。下面是他的代码供参考:
library(R6)
CargoSimulator <- R6Class(
"CargoSimulator",
private = list(
cargo_A = 30,
cargo_B = 20,
shipments = c(4, 6, 6, 7, 8, 9, 10),
trace = data.frame()
),
public = list(
initialize = function() {
private$trace <- data.frame(Quantity = private$shipments, Source = NA)
},
trace_source = function() {
backtrack <- function(index) {
if (index > nrow(private$trace)) {
return(TRUE)
}
qty <- private$trace$Quantity[index]
sources <- sample(c("A", "B"))
for (source in sources) {
if (source == "A" && private$cargo_A >= qty) {
private$cargo_A <- private$cargo_A - qty
private$trace$Source[index] <- "A"
if (backtrack(index + 1)) {
return(TRUE)
}
private$cargo_A <- private$cargo_A + qty # backtrack
} else if (source == "B" && private$cargo_B >= qty) {
private$cargo_B <- private$cargo_B - qty
private$trace$Source[index] <- "B"
if (backtrack(index + 1)) {
return(TRUE)
}
private$cargo_B <- private$cargo_B + qty # backtrack
}
}
private$trace$Source[index] <- NA # backtrack
return(FALSE)
}
if (backtrack(1)) {
return(private$trace)
} else {
warning("No valid configuration found.")
return(NULL)
}
}
)
)
unique_config <- list()
for (i in 1:10000) {
simulator <- CargoSimulator$new()
config <- simulator$trace_source()
if (!is.null(config)) {
if (!any(sapply(unique_config, identical, config))) {
unique_config[[length(unique_config) + 1]] <- config
}
}
}
unique_config
#> [[1]]
#> Quantity Source
#> 1 4 A
#> 2 6 B
#> 3 6 B
#> 4 7 A
#> 5 8 B
#> 6 9 A
#> 7 10 A
#>
#> [[2]]
#> Quantity Source
#> 1 4 B
#> 2 6 B
#> 3 6 A
#> 4 7 A
#> 5 8 A
#> 6 9 A
#> 7 10 B
#>
#> [[3]]
#> Quantity Source
#> 1 4 B
#> 2 6 A
#> 3 6 B
#> 4 7 A
#> 5 8 A
#> 6 9 A
#> 7 10 B
#>
#> [[4]]
#> Quantity Source
#> 1 4 B
#> 2 6 A
#> 3 6 A
#> 4 7 B
#> 5 8 A
#> 6 9 B
#> 7 10 A