让我们假设整数 x . 我想在 n 中将此数量拆分为大多数相等的块并将值保存在向量中 . 例如 . 如果 x = 10 和 n = 4 那么结果向量将是:
x
n
x = 10
n = 4
(3,3,2,2)
如果 n = 3 :
n = 3
(4,3,3)
注意:结果向量的顺序无关紧要
虽然这会在 x 很大时创建一个(可能是不必要的)大对象,但它仍然非常快:
x <- 10 n <- 4 tabulate(cut(1:x, n)) #[1] 3 2 2 3
在一台体面的现代机器上,将10M记录分成100K组,只需5秒钟:
x <- 1e7 n <- 1e5 system.time(tabulate(cut(1:x, n))) # user system elapsed # 5.07 0.06 5.13
这是一些解决方案 .
1) lpSolve 解决此整数线性程序 . 即使对于大x也应该快(但如果n也很大则不行) . 我也尝试了x = 10,000和n = 3,它立即返回解决方案 .
例如,对于n = 4且x = 10,它对应于
min x4 - x1 such that 0 <= x1 <= x2 <= x3 <= x4 and x1 + x2 + x3 + x4 = 10 and x1, x2, x3, x4 are all integer
R代码是:
library(lpSolve) x <- 10 n <- 4 D <- diag(n) mat <- (col(D) - row(D) == 1) - D mat[n, ] <- 1 obj <- replace(numeric(n), c(1, n), c(-1, 1)) dir <- replace(rep(">=", n), n, "=") rhs <- replace(numeric(n), n, x) result <- lp("min", obj, mat, dir, rhs, all.int = TRUE) result$solution ## [1] 2 2 3 3
如果我们重复上面的n = 3,我们得到:
## [1] 3 3 4
2) lpSolveAPI lpSolveAPI包与lpSolve的接口支持稀疏矩阵规范,如果n很大,可能会减少存储,尽管如果n足够大,它可能仍然很慢 . 使用这个包重写(1)我们有:
library(lpSolveAPI) x <- 10 n <- 4 mod <- make.lp(n, n) set.type(mod, 1:n, "integer") set.objfn(mod, c(-1, 1), c(1, n)) for(i in 2:n) add.constraint(mod, c(-1, 1), ">=", 0, c(i-1, i)) add.constraint(mod, rep(1, n), "=", x) solve(mod) get.variables(mod) ## [1] 2 2 3 3
3) Greedy Heuristic 此替代方案不使用任何包 . 它从候选解决方案开始,其中n-1值为x / n向下舍入和一个剩余值 . 在每次迭代中,它尝试通过从最大值中减去1并将1加到相同数量的最小值来改进当前解 . 当它无法进一步改善目标时停止, diff(range(soln)) .
diff(range(soln))
请注意,对于 x <- 1e7 和 n <- 1e5 ,它非常容易解决,因为n均匀地划分为x . 特别是 system.time(tabulate(cut(...))) 在我的机器上报告18秒,对于同样的问题,下面的代码需要0.06秒,因为它在1次迭代后得到答案 .
x <- 1e7
n <- 1e5
system.time(tabulate(cut(...)))
对于 x <- 1e7 和 n <- 1e5-1 system.time(tabulate(cut(...))) 在我的机器上报告16秒并且对于同样的问题,下面的代码在100次迭代后完成4秒 .
n <- 1e5-1
在下面的示例中,从问题中取出,10/4向下舍入为2,因此它以 c(2, 2, 2, 4) 开头 . 在第一次迭代时,它得到 c(2, 2, 3, 3) . 在第二次迭代中,它无法获得任何改进,因此返回答案 .
c(2, 2, 2, 4)
c(2, 2, 3, 3)
x <- 10 n <- 4 a <- x %/% n soln <- replace(rep(a, n), n, x - (n-1)*a) obj <- diff(range(soln)) iter <- 0 while(TRUE) { iter <- iter + 1 soln_new <- soln mx <- which(soln == max(soln)) ix <- seq_along(mx) soln_new[ix] <- soln_new[ix] + 1 soln_new[mx] <- soln_new[mx] - 1 soln_new <- sort(soln_new) obj_new <- diff(range(soln_new)) if (obj_new >= obj) break soln <- soln_new obj <- obj_new } iter ## [1] 2 soln ## [1] 2 2 3 3
2 回答
虽然这会在
x
很大时创建一个(可能是不必要的)大对象,但它仍然非常快:在一台体面的现代机器上,将10M记录分成100K组,只需5秒钟:
这是一些解决方案 .
1) lpSolve 解决此整数线性程序 . 即使对于大x也应该快(但如果n也很大则不行) . 我也尝试了x = 10,000和n = 3,它立即返回解决方案 .
例如,对于n = 4且x = 10,它对应于
R代码是:
如果我们重复上面的n = 3,我们得到:
2) lpSolveAPI lpSolveAPI包与lpSolve的接口支持稀疏矩阵规范,如果n很大,可能会减少存储,尽管如果n足够大,它可能仍然很慢 . 使用这个包重写(1)我们有:
3) Greedy Heuristic 此替代方案不使用任何包 . 它从候选解决方案开始,其中n-1值为x / n向下舍入和一个剩余值 . 在每次迭代中,它尝试通过从最大值中减去1并将1加到相同数量的最小值来改进当前解 . 当它无法进一步改善目标时停止,
diff(range(soln))
.请注意,对于
x <- 1e7
和n <- 1e5
,它非常容易解决,因为n均匀地划分为x . 特别是system.time(tabulate(cut(...)))
在我的机器上报告18秒,对于同样的问题,下面的代码需要0.06秒,因为它在1次迭代后得到答案 .对于
x <- 1e7
和n <- 1e5-1
system.time(tabulate(cut(...)))
在我的机器上报告16秒并且对于同样的问题,下面的代码在100次迭代后完成4秒 .在下面的示例中,从问题中取出,10/4向下舍入为2,因此它以
c(2, 2, 2, 4)
开头 . 在第一次迭代时,它得到c(2, 2, 3, 3)
. 在第二次迭代中,它无法获得任何改进,因此返回答案 .