สำหรับวิธีเรียงสับเปลี่ยนrcppalgosนั้นยอดเยี่ยม น่าเสียดายที่มีความเป็นไปได้479 ล้านรายการกับ 12 สาขาซึ่งหมายความว่าใช้หน่วยความจำมากเกินไปสำหรับคนส่วนใหญ่:
library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb
มีทางเลือกบางอย่าง
ตัวอย่างการเรียงสับเปลี่ยน ความหมายทำเพียง 1 ล้านแทน 479 ล้าน permuteSample(12, 12, n = 1e6)การทำเช่นนี้คุณสามารถใช้ See @ JosephWood คำตอบของวิธีการที่ค่อนข้างคล้ายกันยกเว้นเขาตัวอย่างออกไป 479 ล้าน permutations;)
สร้างลูปในrcppเพื่อประเมินการเปลี่ยนแปลงในการสร้าง วิธีนี้ช่วยประหยัดหน่วยความจำเพราะคุณจะต้องสร้างฟังก์ชั่นเพื่อคืนผลลัพธ์ที่ถูกต้องเท่านั้น
เข้าหาปัญหาด้วยอัลกอริทึมที่แตกต่างกัน ฉันจะมุ่งเน้นไปที่ตัวเลือกนี้
อัลกอริทึมใหม่พร้อมข้อ จำกัด
ส่วนควรเป็น 26
เรารู้ว่าแต่ละส่วนของดาวดังกล่าวข้างต้นจำเป็นต้องเพิ่มมากถึง 26 เราสามารถเพิ่มข้อ จำกัด นั้นในการสร้างการเรียงสับเปลี่ยนของเรา - ให้ชุดค่าผสมที่เพิ่มขึ้นถึง 26 เท่านั้น:
# only certain combinations will add to 26
lucky_combo <- comboGeneral(12, 4, comparisonFun = '==', constraintFun = 'sum', limitConstraints = 26L)
กลุ่มABCDและEFGH
ในดาวดังกล่าวข้างต้นผมได้สีสามกลุ่มที่แตกต่างกัน: ABCD , EFGHและIJLK สองกลุ่มแรกนั้นไม่มีจุดร่วมและอยู่ในส่วนของเส้นตรงที่น่าสนใจ ดังนั้นเราสามารถเพิ่มข้อ จำกัด อื่น ๆ : สำหรับชุดค่าผสมที่เพิ่มขึ้นถึง 26 เราจำเป็นต้องตรวจสอบให้แน่ใจว่าABCDและEFGHไม่มีการทับซ้อนจำนวน IJLKจะถูกกำหนดหมายเลข 4 ที่เหลือ
library(RcppAlgos)
lucky_combo <- comboGeneral(12, 4, comparisonFun = '==', constraintFun = 'sum', limitConstraints = 26L)
two_combo <- comboGeneral(nrow(lucky_combo), 2)
unique_combos <- !apply(cbind(lucky_combo[two_combo[, 1], ], lucky_combo[two_combo[, 2], ]), 1, anyDuplicated)
grp1 <- lucky_combo[two_combo[unique_combos, 1],]
grp2 <- lucky_combo[two_combo[unique_combos, 2],]
grp3 <- t(apply(cbind(grp1, grp2), 1, function(x) setdiff(1:12, x)))
ดัดแปรผ่านกลุ่มต่างๆ
เราจำเป็นต้องค้นหาวิธีเรียงสับเปลี่ยนทั้งหมดของแต่ละกลุ่ม นั่นคือเรามีเพียงการรวมกันที่เพิ่มขึ้นถึง 26 ตัวอย่างเช่นเราต้องใช้เวลาและทำให้1, 2, 11, 121, 2, 12, 11; 1, 12, 2, 11; ...
#create group perms (i.e., we need all permutations of grp1, grp2, and grp3)
n <- 4
grp_perms <- permuteGeneral(n, n)
n_perm <- nrow(grp_perms)
# We create all of the permutations of grp1. Then we have to repeat grp1 permutations
# for all grp2 permutations and then we need to repeat one more time for grp3 permutations.
stars <- cbind(do.call(rbind, lapply(asplit(grp1, 1), function(x) matrix(x[grp_perms], ncol = n)))[rep(seq_len(sum(unique_combos) * n_perm), each = n_perm^2), ],
do.call(rbind, lapply(asplit(grp2, 1), function(x) matrix(x[grp_perms], ncol = n)[rep(1:n_perm, n_perm), ]))[rep(seq_len(sum(unique_combos) * n_perm^2), each = n_perm), ],
do.call(rbind, lapply(asplit(grp3, 1), function(x) matrix(x[grp_perms], ncol = n)[rep(1:n_perm, n_perm^2), ])))
colnames(stars) <- LETTERS[1:12]
การคำนวณขั้นสุดท้าย
ขั้นตอนสุดท้ายคือการทำคณิตศาสตร์ ฉันใช้lapply()และReduce()ที่นี่เพื่อทำงานเขียนโปรแกรมที่ทำงานได้มากกว่า - มิฉะนั้นรหัสจำนวนมากจะถูกพิมพ์หกครั้ง ดูโซลูชันต้นฉบับสำหรับคำอธิบายที่ละเอียดยิ่งขึ้นของรหัสคณิตศาสตร์
# creating a list will simplify our math as we can use Reduce()
col_ind <- list(c('A', 'B', 'C', 'D'), #these two will always be 26
c('E', 'F', 'G', 'H'), #these two will always be 26
c('I', 'C', 'J', 'H'),
c('D', 'J', 'G', 'K'),
c('K', 'F', 'L', 'A'),
c('E', 'L', 'B', 'I'))
# Determine which permutations result in a lucky star
L <- lapply(col_ind, function(cols) rowSums(stars[, cols]) == 26)
soln <- Reduce(`&`, L)
# A couple of ways to analyze the result
rbind(stars[which(soln),], stars[which(soln), c(1,8, 9, 10, 11, 6, 7, 2, 3, 4, 5, 12)])
table(Reduce('+', L)) * 2
2 3 4 6
2090304 493824 69120 960
การแลกเปลี่ยนABCDและEFGH
ในตอนท้ายของรหัสข้างต้นฉันใช้ประโยชน์จากการที่เราสามารถสลับABCDและEFGHรับการเปลี่ยนลำดับที่เหลือ นี่คือรหัสเพื่อยืนยันว่าใช่เราสามารถสลับทั้งสองกลุ่มและถูกต้อง:
# swap grp1 and grp2
stars2 <- stars[, c('E', 'F', 'G', 'H', 'A', 'B', 'C', 'D', 'I', 'J', 'K', 'L')]
# do the calculations again
L2 <- lapply(col_ind, function(cols) rowSums(stars2[, cols]) == 26)
soln2 <- Reduce(`&`, L2)
identical(soln, soln2)
#[1] TRUE
#show that col_ind[1:2] always equal 26:
sapply(L, all)
[1] TRUE TRUE FALSE FALSE FALSE FALSE
ประสิทธิภาพ
ในที่สุดเราประเมินเพียง 1.3 ล้านจาก 479 พีชคณิตและเพียงสับผ่าน RAM ขนาด 550 MB เท่านั้น ใช้เวลาประมาณ 0.7 วินาทีในการทำงาน
# A tibble: 1 x 13
expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc
<bch:expr> <bch> <bch:> <dbl> <bch:byt> <dbl> <int> <dbl>
1 new_algo 688ms 688ms 1.45 550MB 7.27 1 5
x<- 1:elementsและที่สำคัญกว่าL1 <- y[,1] + y[,3] + y[,6] + y[,8]นั้น สิ่งนี้จะไม่ช่วยแก้ปัญหาความจำของคุณจริงๆดังนั้นคุณสามารถดูrcpp ได้เสมอ