ฉันกำลังพยายามปิดหัวปัญหานี้
ดายถูกรีด 100 ครั้ง ความน่าจะเป็นที่ไม่ปรากฏใบหน้าเกิน 20 ครั้งเป็นเท่าไหร่? ความคิดแรกของฉันคือการใช้การแจกแจงแบบทวินาม P (x) = 1 - 6 cmf (100, 1/6, 20) แต่สิ่งนี้ผิดอย่างเห็นได้ชัดเนื่องจากเรานับบางกรณีมากกว่าหนึ่งครั้ง ความคิดที่สองของฉันคือการแจกแจงม้วนที่เป็นไปได้ทั้งหมด x1 + x2 + x3 + x4 + x5 + x6 = 100 เช่นนั้น xi <= 20 และรวมผลรวมของ multinomials แต่มันดูเหมือนเข้มข้นเกินไป วิธีแก้ปัญหาโดยประมาณนั้นจะได้ผลกับฉันเช่นกัน

นี่เป็นลักษณะทั่วไปของปัญหาวันเกิดที่มีชื่อเสียง: ให้บุคคลที่มีการกระจาย "วันเกิด" แบบสุ่มอย่างสม่ำเสมอในกลุ่มชุดของความเป็นไปได้อะไรคือโอกาสที่ไม่มีวันเกิดร่วมกันมากกว่าคน?d = 6 m = $n=100$$d=6$$m=20$

การคำนวณที่แน่นอนให้ผลลัพธ์คำตอบ (เพื่อความแม่นยำสองเท่า) ฉันจะร่างทฤษฎีและให้รหัสสำหรับทั่วไป เวลาของซีมโทติคของรหัสคือซึ่งทำให้เหมาะสำหรับวันเกิดจำนวนมากและให้ประสิทธิภาพที่สมเหตุสมผลจนกระทั่งอยู่ในหลักพัน ณ จุดนั้นการประมาณปัวซงกล่าวถึงในการขยายเส้นขนานวันเกิดให้มากกว่า 2 คนควรจะทำงานได้ดีในกรณีส่วนใหญ่n , m , d . O ( n 2บันทึก( d ) ) d $0.267\,747\,907\,805\,267$$n, m, d.$$O(n^2\log(d))$$d$$n$

---

คำอธิบายของการแก้ปัญหา

ฟังก์ชันสร้างความน่าจะเป็น (pgf) สำหรับผลลัพธ์ของการหมุนรอบอิสระของการตายด้านคือ$n$$d$

$$d^{-n}f_n(x_1,x_2,\ldots,x_d) = d^{-n}(x_1+x_2+ \cdots + x_d)^n.$$

ค่าสัมประสิทธิ์ของในการขยายตัวของพหุนามนี้จะช่วยให้หลายวิธีในการที่ต้องเผชิญกับสามารถปรากฏตรงครั้งฉันอีฉันฉัน= 1 , 2 , ... , $x_1^{e_1}x_2^{e_2}\cdots x_d^{e_d}$$i$$e_i$$i=1, 2, \ldots, d.$

การจำกัดความสนใจของเราไม่เกินใบหน้าใด ๆ ก็เท่ากับการประเมิน modulo อุดมคติสร้างโดย ในการประเมินผลนี้ใช้ทฤษฎีบททวินาม (Binomial Theorem) ซ้ำ ๆ เพื่อรับฉn ผมx เมตร+ 1 1 , x เมตร+ 1 2 , ... , x เมตร+ 1$m$$f_n$$\mathcal I$$x_1^{m+1}, x_2^{m+1}, \ldots, x_d^{m+1}.$

$$\eqalign{ f_n(x_1, \ldots, x_d) &= ((x_1+\cdots+x_r) + (x_{r+1}+x_{r+2} + \cdots + x_{2r}))^n \\ &= \sum_{k=0}^n \binom{n}{k} (x_1+\cdots+x_r)^k (x_{r+1}+\cdots+x_{2r})^{n-k} \\ &= \sum_{k=0}^n \binom{n}{k} f_k(x_1, \ldots, x_r) f_{n-k}(x_{r+1}, \ldots, x_{2r}) }$$

เมื่อเป็นคู่ กำลังเขียน ( คำศัพท์ ) เรามีf ( d ) n = f n ( 1 , 1 , … , 1 ) $d=2r$$f_n^{(d)} = f_n(1,1,\ldots, 1)$$d$

$$f_n^{(2r)} = \sum_{k=0}^n \binom{n}{k} f_k^{(r)} f_{n-k}^{(r)}.\tag{a}$$

เมื่อเป็นเลขคี่ให้ใช้การแยกแบบอะนาล็อก$d=2r+1$

$$\eqalign{ f_n(x_1, \ldots, x_d) &= ((x_1+\cdots+x_{2r}) + x_{2r+1})^n \\ &= \sum_{k=0}^n \binom{n}{k} f_k(x_1, \ldots, x_{2r}) f_{n-k}(x_{2r+1}), }$$

ให้

$$f_n^{(2r+1)} = \sum_{k=0}^n \binom{n}{k} f_k^{(2r)} f_{n-k}^{(1)}.\tag{b}$$

ในทั้งสองกรณีเราอาจลดทุกอย่างแบบโมดูโลซึ่งเริ่มต้นได้ง่ายด้วย$\mathcal I$

$$f_n(x_j) \cong \left\{ \matrix{x^n & n \le m \\ 0 & n \gt m} \right. \mod \mathcal{I},$$

ให้ค่าเริ่มต้นสำหรับการสอบถามซ้ำ

$$f_n^{(1)} = \left\{ \matrix{1 & n \le m \\ 0 & n \gt m} \right.$$

สิ่งที่ทำให้สิ่งนี้มีประสิทธิภาพคือการแบ่งตัวแปรออกเป็นสองกลุ่มที่มีขนาดเท่ากันของตัวแปรแต่ละตัวและตั้งค่าตัวแปรทั้งหมดเป็นเราจะต้องประเมินทุกอย่างเพียงครั้งเดียวสำหรับกลุ่มเดียวแล้วรวมผลลัพธ์ สิ่งนี้ต้องใช้การคำนวณสูงสุดคำแต่ละคำต้องการการคำนวณสำหรับชุดค่าผสม เราไม่จำเป็นต้องใช้อาร์เรย์ 2 มิติในการจัดเก็บเพราะเมื่อคำนวณเฉพาะและเท่านั้นr 1 , n + 1 O ( n ) f ( r ) n f ( d ) n , f ( r ) n f ( 1 )$d$$r$$1,$$n+1$$O(n)$$f_n^{(r)}$$f_n^{(d)},$$f_n^{(r)}$$f_n^{(1)}$

จำนวนขั้นตอนทั้งหมดคือหนึ่งน้อยกว่าจำนวนหลักในการขยายฐานสองของ (ซึ่งนับการแบ่งออกเป็นกลุ่มเท่า ๆ กันในสูตร ) บวกจำนวนครั้งในการขยาย (ซึ่งนับทุกครั้งที่คี่ พบค่าต้องการแอปพลิเคชันของสูตร ) นั่นเป็นเพียงขั้นตอน( a ) ( b ) O ( บันทึก( d ) $d$$(a)$$(b)$$O(\log(d))$

ในRเวิร์กสเตชันอายุสิบปีงานเสร็จใน 0.007 วินาที รหัสมีการระบุไว้ในตอนท้ายของโพสต์นี้ มันใช้ลอการิทึมของความน่าจะเป็นมากกว่าความน่าจะเป็นของตัวเองเพื่อหลีกเลี่ยงการล้นหรือการสะสมอันเดอร์โฟล์ที่มากเกินไป สิ่งนี้ทำให้สามารถลบปัจจัยในโซลูชันดังนั้นเราอาจคำนวณจำนวนที่เป็นไปได้$d^{-n}$

หมายเหตุว่านี้ผลการขั้นตอนในการใช้คอมพิวเตอร์ทั้งลำดับของความน่าจะในครั้งเดียวซึ่งได้อย่างง่ายดายช่วยให้เราสามารถศึกษาวิธีโอกาสเปลี่ยนกับn$f_0, f_1, \ldots, f_n$$n$

---

การประยุกต์ใช้งาน

tmultinom.fullการกระจายตัวในวันเกิดปัญหาทั่วไปคำนวณโดยฟังก์ชั่น ความท้าทายเพียงอย่างเดียวคือการหาขอบเขตบนของจำนวนคนที่ต้องอยู่ก่อนที่โอกาสของ -collision จะยิ่งใหญ่เกินไป รหัสต่อไปนี้ทำได้โดยใช้กำลังดุร้ายเริ่มต้นด้วยเล็ก ๆและเพิ่มเป็นสองเท่าจนกระทั่งมันใหญ่พอ การคำนวณทั้งหมดจึงใช้เวลาเวลาที่เป็นคำตอบ การคำนวณการแจกแจงความน่าจะเป็นทั้งหมดสำหรับจำนวนผู้ใช้จนถึงคำนวณได้n O ( n 2บันทึก( n ) บันทึก( d ) ) n $m+1$$n$$O(n^2\log(n)\log(d))$$n$$n$

#
# The birthday problem: find the number of people where the chance of
# a collision of `m+1` birthdays first exceeds `alpha`.
#
birthday <- function(m=1, d=365, alpha=0.50) {
  n <- 8
  while((p <- tmultinom.full(n, m, d))[n] > alpha) n <- n * 2
  return(p)
}

ตัวอย่างเช่นจำนวนขั้นต่ำของคนที่จำเป็นในฝูงชนที่จะทำให้มันมีโอกาสมากขึ้นกว่าไม่ได้ว่าอย่างน้อยแปดพวกเขาส่วนวันเกิดเป็นเท่าที่พบโดยการคำนวณ ใช้เวลาเพียงไม่กี่วินาที นี่คือพล็อตของส่วนหนึ่งของผลลัพธ์:$798$birthday(7)

---

รุ่นพิเศษของปัญหานี้แก้ไขได้ที่การขยายเส้นขนานของวันเกิดให้มากกว่า 2 คนซึ่งเกี่ยวข้องกับกรณีของผู้ตายด้านที่มีจำนวนครั้งมาก$365$

---

รหัส

# Compute the chance that in `n` independent rolls of a `d`-sided die, 
# no side appears more than `m` times.
#
tmultinom <- function(n, m, d, count=FALSE) tmultinom.full(n, m, d, count)[n+1]
#
# Compute the chances that in 0, 1, 2, ..., `n` independent rolls of a
# `d`-sided die, no side appears more than `m` times.
#
tmultinom.full <- function(n, m, d, count=FALSE) {
  if (n < 0) return(numeric(0))
  one <- rep(1.0, n+1); names(one) <- 0:n
  if (d <= 0 || m >= n) return(one)

  if(count) log.p <- 0 else log.p <- -log(d)
  f <- function(n, m, d) {                   # The recursive solution
    if (d==1) return(one)                    # Base case
    r <- floor(d/2)
    x <- double(f(n, m, r), m)               # Combine two equal values
    if (2*r < d) x <- combine(x, one, m)     # Treat odd `d`
    return(x)
  }
  one <- c(log.p*(0:m), rep(-Inf, n-m))      # Reduction modulo x^(m+1)
  double <- function(x, m) combine(x, x, m)
  combine <- function(x, y, m) {             # The Binomial Theorem
    z <- sapply(1:length(x), function(n) {   # Need all powers 0..n
      z <- x[1:n] + lchoose(n-1, 1:n-1) + y[n:1]
      z.max <- max(z)
      log(sum(exp(z - z.max), na.rm=TRUE)) + z.max
    })
    return(z)
  }
  x <- exp(f(n, m, d)); names(x) <- 0:n
  return(x)
}

คำตอบที่ได้รับด้วย

print(tmultinom(100,20,6), digits=15)

0.267747907805267

วิธีสุ่มตัวอย่าง

ฉันใช้รหัสนี้ในการจำลองการโยน 100 ครั้งสำหรับ R ล้านครั้ง:

y <- ทำซ้ำ (1000000, ทั้งหมด (ตาราง (ตัวอย่าง (1: 6, ขนาด = 100, แทนที่ = TRUE)) <= 20))

ผลลัพธ์ของโค้ดภายในฟังก์ชั่นการทำซ้ำนั้นเป็นจริงถ้าใบหน้าทั้งหมดปรากฏน้อยกว่าหรือเท่ากับ 20 เท่า y คือเวกเตอร์ที่มีค่า 1 ล้านค่าจริงหรือเท็จ

จำนวนรวม ของค่าจริงใน y หารด้วย 1 ล้านควรประมาณเท่ากับความน่าจะเป็นที่คุณต้องการ ในกรณีของฉันมันคือ 266872/1000000 แนะนำความน่าจะเป็นประมาณ 26.6%

การคำนวณแรงเดรัจฉาน

รหัสนี้ใช้เวลาสองสามวินาทีบนแล็ปท็อปของฉัน

total = 0
pb <- txtProgressBar(min = 0, max = 20^2, style = 3)
for (i in 0:20) {
  for (j in 0:20) {
    for (k in 0:20) { 
      for (l in 0:20) {
        for (m in 0:20) {
          n = 100-sum(i,j,k,l,m)
          if (n<=20) {
            total = total+dmultinom(c(i,j,k,l,m,n),100,prob=rep(1/6,6))
          }
        }
      }
    }
    setTxtProgressBar(pb, i*20+j) # update progression bar            
  }
}
total

ผลลัพธ์: 0.2677479

แต่ก็อาจเป็นเรื่องที่น่าสนใจที่จะหาวิธีที่ตรงกว่านี้ในกรณีที่คุณต้องการคำนวณจำนวนมากหรือใช้ค่าที่สูงขึ้นหรือเพื่อให้ได้วิธีที่ดีกว่า

อย่างน้อยการคำนวณนี้ให้วิธีการคำนวณแบบง่าย ๆ แต่เป็นตัวเลขที่ถูกต้องเพื่อตรวจสอบวิธีอื่น ๆ (ซับซ้อนกว่า)