วิธีการสุ่มตัวอย่างใหม่ใน R โดยไม่ต้องเปลี่ยนลำดับซ้ำ?

ใน R ถ้าฉัน set.seed () จากนั้นใช้ฟังก์ชั่นตัวอย่างเพื่อสุ่มรายการฉันสามารถรับประกันได้ว่าฉันจะไม่สร้างการเปลี่ยนแปลงแบบเดียวกันหรือไม่?

เช่น ...

set.seed(25)
limit <- 3
myindex <- seq(0,limit)
for (x in seq(1,factorial(limit))) {
    permutations <- sample(myindex)
    print(permutations)
}

สิ่งนี้ผลิต

[1] 1 2 0 3
[1] 0 2 1 3
[1] 0 3 2 1
[1] 3 1 2 0
[1] 2 3 0 1
[1] 0 1 3 2

การเรียงสับเปลี่ยนทั้งหมดจะพิมพ์เป็นวิธีเรียงสับเปลี่ยนที่ไม่ซ้ำกันหรือไม่ หรือมีโอกาสบ้างตามวิธีการใช้งานที่ฉันได้รับซ้ำบ้าง

ฉันต้องการที่จะสามารถทำได้โดยไม่ต้องทำซ้ำรับประกัน ฉันจะทำอย่างไร

(ฉันต้องการหลีกเลี่ยงการใช้ฟังก์ชันเช่น permn () ซึ่งมีวิธีการทางกลไกอย่างมากสำหรับการสร้างการเรียงสับเปลี่ยน --- มันไม่ได้ดูสุ่มเลย)

นอกจากนี้ sidenote --- ดูเหมือนว่าปัญหานี้คือ O ((n!)!) ถ้าฉันไม่ผิด

คำถามมีการตีความที่ถูกต้องมากมาย ความคิดเห็น - โดยเฉพาะอย่างยิ่งสิ่งที่แสดงการเรียงสับเปลี่ยนของ 15 องค์ประกอบหรือมากกว่านั้นเป็นสิ่งจำเป็น (15! = 1307674368000 เริ่มมีขนาดใหญ่ขึ้น) - แนะนำว่าสิ่งที่ต้องการคือตัวอย่างแบบสุ่มขนาดค่อนข้างเล็กโดยไม่มีการแทนที่ทั้งหมด n! = n * (n-1) (n-2) ... * 2 * 1 พีชคณิตของ 1: n หากเป็นจริงแสดงว่ามีวิธีแก้ปัญหาที่มีประสิทธิภาพ

ฟังก์ชั่นต่อไปนี้rperm, ยอมรับสองข้อโต้แย้งn(ขนาดของพีชคณิตตัวอย่าง) และm(จำนวนพีชคณิตของขนาด n เพื่อวาด) หาก m เข้าใกล้หรือเกิน n! ฟังก์ชันจะใช้เวลานานและคืนค่า NA จำนวนมาก: มันมีไว้สำหรับใช้เมื่อ n ค่อนข้างใหญ่ (พูด 8 หรือมากกว่า) และ m มีขนาดเล็กกว่า n! มันทำงานได้โดยการแคชการแสดงสตริงของพีชคณิตที่พบแล้วและสร้างการเรียงสับเปลี่ยนใหม่ (แบบสุ่ม) จนกระทั่งพบอันใหม่ มันใช้ประโยชน์จากความสามารถในการสร้างดัชนีเชื่อมโยงของ R เพื่อค้นหารายการการเปลี่ยนลำดับที่ค้นพบก่อนหน้านี้อย่างรวดเร็ว

rperm <- function(m, size=2) { # Obtain m unique permutations of 1:size

    # Function to obtain a new permutation.
    newperm <- function() {
        count <- 0                # Protects against infinite loops
        repeat {
            # Generate a permutation and check against previous ones.
            p <- sample(1:size)
            hash.p <- paste(p, collapse="")
            if (is.null(cache[[hash.p]])) break

            # Prepare to try again.
            count <- count+1
            if (count > 1000) {   # 1000 is arbitrary; adjust to taste
                p <- NA           # NA indicates a new permutation wasn't found
                hash.p <- ""
                break
            }
        }
        cache[[hash.p]] <<- TRUE  # Update the list of permutations found
        p                         # Return this (new) permutation
    }

    # Obtain m unique permutations.
    cache <- list()
    replicate(m, newperm())  
} # Returns a `size` by `m` matrix; each column is a permutation of 1:size.

ธรรมชาติของreplicateการคืนค่าพีชคณิตเป็นคอลัมน์เวกเตอร์; เช่นต่อไปนี้ทำซ้ำตัวอย่างในคำถามเดิมย้าย :

> set.seed(17)
> rperm(6, size=4)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    2    4    4    3    4
[2,]    3    4    1    3    1    2
[3,]    4    1    3    2    2    3
[4,]    2    3    2    1    4    1

การกำหนดเวลาเป็นเลิศสำหรับค่า m น้อยถึงปานกลางสูงสุดถึง 10,000 แต่ลดลงสำหรับปัญหาที่ใหญ่กว่า ตัวอย่างเช่นตัวอย่างของ m = 10,000 การเปลี่ยนลำดับขององค์ประกอบ n = 1,000 (เมทริกซ์ที่มีค่า 10 ล้านค่า) ได้ใน 10 วินาที ตัวอย่าง m = 20,000 การเปลี่ยนลำดับของ n = 20 องค์ประกอบที่ต้องใช้ 11 วินาทีแม้ว่าเอาต์พุต (เมทริกซ์ 400,000 รายการ) มีขนาดเล็กกว่ามาก และการคำนวณตัวอย่าง m = 100,000 พีชคณิตของ n = 20 องค์ประกอบถูกยกเลิกหลังจาก 260 วินาที (ฉันไม่มีความอดทนรอให้เสร็จ) ปัญหาการปรับสเกลนี้ดูเหมือนจะเกี่ยวข้องกับการลดความไร้ประสิทธิภาพในการกำหนดที่สัมพันธ์ของ R หนึ่งสามารถทำงานได้โดยการสร้างตัวอย่างในกลุ่มพูด 1,000 หรือดังนั้นจากนั้นรวมตัวอย่างเหล่านั้นเป็นตัวอย่างขนาดใหญ่และลบรายการที่ซ้ำกัน

แก้ไข

เราสามารถบรรลุประสิทธิภาพเชิงเส้นกำกับเชิงเส้นได้โดยการแบ่งแคชออกเป็นลำดับชั้นของสองแคชดังนั้น R จึงไม่ต้องค้นหาผ่านรายการขนาดใหญ่ ตามแนวคิด (แม้ว่าจะไม่ถูกนำไปใช้) ให้สร้างอาร์เรย์ที่ทำดัชนีโดยองค์ประกอบแรกของการเปลี่ยนแปลง รายการในอาร์เรย์นี้เป็นรายการของพีชคณิตทั้งหมดที่ใช้องค์ประกอบแรกเหล่านั้น ในการตรวจสอบว่ามีการเห็นการเปลี่ยนแปลงหรือไม่ให้ใช้องค์ประกอบแรกเพื่อค้นหารายการในแคชจากนั้นค้นหาการเปลี่ยนแปลงที่เกิดขึ้นภายในรายการนั้น เราสามารถเลือกเพื่อปรับสมดุลขนาดที่ต้องการของรายการทั้งหมด การใช้งานจริงไม่ได้ใช้k k k $k$$k$$k$$k$$k$อาร์เรย์แบบพับซึ่งจะยากต่อการเขียนโปรแกรมในภาษาทั่วไป แต่ใช้รายการอื่นแทน

นี่คือเวลาที่ผ่านไปในไม่กี่วินาทีสำหรับช่วงขนาดการเปลี่ยนแปลงและจำนวนการเรียงสับเปลี่ยนที่แตกต่างกันที่ร้องขอ:

 Number Size=10 Size=15 Size=1000 size=10000 size=100000
     10    0.00    0.00      0.02       0.08        1.03
    100    0.01    0.01      0.07       0.64        8.36
   1000    0.08    0.09      0.68       6.38
  10000    0.83    0.87      7.04      65.74
 100000   11.77   10.51     69.33
1000000  195.5   125.5

(การเร่งความเร็วที่ผิดปกติอย่างเห็นได้ชัดจาก size = 10 ถึง size = 15 เป็นเพราะระดับแรกของแคชมีขนาดใหญ่กว่าสำหรับขนาด = 15 ลดจำนวนเฉลี่ยของรายการในรายการระดับที่สองดังนั้นจึงเร่งการค้นหาที่เชื่อมโยงของ R ค่าใช้จ่ายใน RAM การดำเนินการอาจทำได้เร็วขึ้นโดยการเพิ่มขนาดแคชระดับบนเพียงแค่เพิ่มk.head1 (ซึ่งคูณขนาดระดับบนด้วย 10) เร่งความเร็วrperm(100000, size=10)จาก 11.77 วินาทีเป็น 8.72 วินาทีตัวอย่างเช่นสร้างระดับบน แคชใหญ่กว่า 10 เท่า แต่ไม่ได้รับการเพิ่มขึ้นมากนักตอกบัตรได้ที่ 8.51 วินาที)

ยกเว้นกรณีของการเปลี่ยนลำดับที่ไม่ซ้ำ 1,000,000 ครั้งจาก 10 องค์ประกอบ (ส่วนที่สำคัญของทั้ง 10! = ประมาณ 3.63 ล้านการเปลี่ยนลำดับดังกล่าว) แทบจะไม่พบการชนกันเลย ในกรณีพิเศษนี้มีการชนกัน 169,301 ครั้ง แต่ไม่มีความล้มเหลวทั้งหมด (มีการเปลี่ยนลำดับที่ไม่ซ้ำกันถึงหนึ่งล้านครั้ง)

โปรดทราบว่าด้วยขนาดการเปลี่ยนแปลงที่มีขนาดใหญ่ (มากกว่า 20 หรือมากกว่านั้น) โอกาสที่จะได้รับการเปลี่ยนลำดับที่เหมือนกันสองครั้งแม้ในตัวอย่างที่มีขนาดใหญ่ถึง 1,000,000,000 นั้นจะมีขนาดเล็กหายไป ดังนั้นการแก้ปัญหานี้มีผลบังคับใช้เป็นหลักในสถานการณ์ที่ (ก) จำนวนมากพีชคณิตเป็นเอกลักษณ์ของ (ข) ระหว่างและหรือดังนั้นองค์ประกอบที่จะสร้าง แต่แม้ดังนั้น (ค) อย่างมีนัยสำคัญน้อยกว่าทุกจำเป็นต้องมีวิธีเรียงสับเปลี่ยนn = 15 n $n=5$$n=15$$n!$

รหัสการทำงานดังต่อไปนี้

rperm <- function(m, size=2) { # Obtain m unique permutations of 1:size
    max.failures <- 10

    # Function to index into the upper-level cache.
    prefix <- function(p, k) {    # p is a permutation, k is the prefix size
        sum((p[1:k] - 1) * (size ^ ((1:k)-1))) + 1
    } # Returns a value from 1 through size^k

    # Function to obtain a new permutation.
    newperm <- function() {
        # References cache, k.head, and failures in parent context.
        # Modifies cache and failures.        

        count <- 0                # Protects against infinite loops
        repeat {
            # Generate a permutation and check against previous ones.
            p <- sample(1:size)
            k <- prefix(p, k.head)
            ip <- cache[[k]]
            hash.p <- paste(tail(p,-k.head), collapse="")
            if (is.null(ip[[hash.p]])) break

            # Prepare to try again.
            n.failures <<- n.failures + 1
            count <- count+1
            if (count > max.failures) {  
                p <- NA           # NA indicates a new permutation wasn't found
                hash.p <- ""
                break
            }
        }
        if (count <= max.failures) {
            ip[[hash.p]] <- TRUE      # Update the list of permutations found
            cache[[k]] <<- ip
        }
        p                         # Return this (new) permutation
    }

    # Initialize the cache.
    k.head <- min(size-1, max(1, floor(log(m / log(m)) / log(size))))
    cache <- as.list(1:(size^k.head))
    for (i in 1:(size^k.head)) cache[[i]] <- list()

    # Count failures (for benchmarking and error checking).
    n.failures <- 0

    # Obtain (up to) m unique permutations.
    s <- replicate(m, newperm())
    s[is.na(s)] <- NULL
    list(failures=n.failures, sample=matrix(unlist(s), ncol=size))
} # Returns an m by size matrix; each row is a permutation of 1:size.

ใช้อย่างuniqueถูกต้องควรทำเคล็ดลับ:

set.seed(2)
limit <- 3
myindex <- seq(0,limit)

endDim<-factorial(limit)
permutations<-sample(myindex)

while(is.null(dim(unique(permutations))) || dim(unique(permutations))[1]!=endDim) {
    permutations <- rbind(permutations,sample(myindex))
}
# Resulting permutations:
unique(permutations)

# Compare to
set.seed(2)
permutations<-sample(myindex)
for(i in 1:endDim)
{
permutations<-rbind(permutations,sample(myindex))
}
permutations
# which contains the same permutation twice

I "m จะไปขั้นตอนด้านคำถามแรกของคุณบิตและแนะนำว่าถ้าคุณจะจัดการกับเวกเตอร์ที่ค่อนข้างสั้นคุณก็สามารถสร้างพีชคณิตทั้งหมดที่ใช้permnและพวกเขาสุ่มสั่งผู้ใช้sample:

x <- combinat:::permn(1:3)
> x[sample(factorial(3),factorial(3),replace = FALSE)]
[[1]]
[1] 1 2 3

[[2]]
[1] 3 2 1

[[3]]
[1] 3 1 2

[[4]]
[1] 2 1 3

[[5]]
[1] 2 3 1

[[6]]
[1] 1 3 2