ฉันต้องการสร้างตัวอย่างจากขอบเขตสีฟ้าที่กำหนดไว้ที่นี่:
โซลูชันไร้เดียงสาคือใช้การสุ่มตัวอย่างการปฏิเสธในหน่วยสี่เหลี่ยมจัตุรัส แต่ให้ประสิทธิภาพเพียง (~ 21.4%)
มีวิธีที่ฉันสามารถตัวอย่างมีประสิทธิภาพมากขึ้น?
ฉันต้องการสร้างตัวอย่างจากขอบเขตสีฟ้าที่กำหนดไว้ที่นี่:
โซลูชันไร้เดียงสาคือใช้การสุ่มตัวอย่างการปฏิเสธในหน่วยสี่เหลี่ยมจัตุรัส แต่ให้ประสิทธิภาพเพียง (~ 21.4%)
มีวิธีที่ฉันสามารถตัวอย่างมีประสิทธิภาพมากขึ้น?
คำตอบ:
จะมีคะแนนสองล้านคะแนนต่อวินาทีหรือไม่
การกระจายนั้นสมมาตร: เราแค่หาผลการกระจายสำหรับหนึ่งในแปดของวงกลมเต็มแล้วคัดลอกมันไปรอบ ๆ octants อื่น ในพิกัดเชิงขั้ว , การแจกแจงแบบสะสมของมุมΘสำหรับตำแหน่งสุ่ม( X , Y )ที่ค่าθนั้นได้รับจากพื้นที่ระหว่างสามเหลี่ยม( 0และส่วนโค้งของวงกลมที่ขยายจาก (เพื่อ ( cos θ , บาปθ ) ดังนั้นจึงเป็นสัดส่วนกับ
ความหนาแน่นของมันมาจากไหน
เราอาจสุ่มตัวอย่างจากความหนาแน่นนี้โดยใช้วิธีการปฏิเสธ (ซึ่งมีประสิทธิภาพ )
ความหนาแน่นของเงื่อนไขของการประสานงานในแนวรัศมีเป็นสัดส่วนกับR d Rระหว่างR = 1และR = วินาที θ ที่สามารถเก็บตัวอย่างได้ด้วยการกลับกันอย่างง่ายของ CDF
หากเราสร้างตัวอย่างอิสระให้แปลงกลับเป็นพิกัดคาร์ทีเซียน( x i , y i )ตัวอย่าง octant นี้ เนื่องจากตัวอย่างมีความเป็นอิสระการสลับพิกัดแบบสุ่มจะสร้างตัวอย่างแบบสุ่มที่เป็นอิสระจากจตุภาคแรกตามที่ต้องการ (การสลับแบบสุ่มต้องสร้างตัวแปร Binomial เพียงตัวเดียวเพื่อกำหนดจำนวนการรับรู้ที่จะแลกเปลี่ยน)
การตระหนักถึงแต่ละอย่างของต้องการค่าเฉลี่ย, ตัวแปรหนึ่งชุด (สำหรับR ) บวก1 / ( 8 π - 2 )คูณสองชุดเครื่องแบบ (สำหรับΘ ) และการคำนวณจำนวนเล็กน้อย (เร็ว) นั่นคือ4 / ( π - 4 ) ≈ 4.66ตัวแปรต่อจุด (ซึ่งแน่นอนว่ามีสองพิกัด) รายละเอียดทั้งหมดอยู่ในตัวอย่างโค้ดด้านล่าง ตัวเลขนี้คิดเป็น 10,000 จากคะแนนมากกว่าครึ่งล้านที่สร้างขึ้น
นี่คือR
รหัสที่สร้างการจำลองนี้และหมดเวลา
n.sim <- 1e6
x.time <- system.time({
# Generate trial angles `theta`
theta <- sqrt(runif(n.sim)) * pi/4
# Rejection step.
theta <- theta[runif(n.sim) * 4 * theta <= pi * tan(theta)^2]
# Generate radial coordinates `r`.
n <- length(theta)
r <- sqrt(1 + runif(n) * tan(theta)^2)
# Convert to Cartesian coordinates.
# (The products will generate a full circle)
x <- r * cos(theta) #* c(1,1,-1,-1)
y <- r * sin(theta) #* c(1,-1,1,-1)
# Swap approximately half the coordinates.
k <- rbinom(1, n, 1/2)
if (k > 0) {
z <- y[1:k]
y[1:k] <- x[1:k]
x[1:k] <- z
}
})
message(signif(x.time[3] * 1e6/n, 2), " seconds per million points.")
#
# Plot the result to confirm.
#
plot(c(0,1), c(0,1), type="n", bty="n", asp=1, xlab="x", ylab="y")
rect(-1, -1, 1, 1, col="White", border="#00000040")
m <- sample.int(n, min(n, 1e4))
points(x[m],y[m], pch=19, cex=1/2, col="#0000e010")
ฉันเสนอวิธีแก้ไขปัญหาต่อไปนี้ซึ่งควรจะง่ายกว่ามีประสิทธิภาพมากกว่าและ / หรือคำนวณได้ถูกกว่า soution อื่น ๆ โดย @cardinal, @whuber และ @ stephan-kolassa
มันเกี่ยวข้องกับขั้นตอนง่าย ๆ ดังต่อไปนี้:
1) วาดตัวอย่างมาตรฐานสองตัวอย่าง:
2a) ใช้การแปลงแรงเฉือนต่อไปนี้กับจุด (คะแนนในรูปสามเหลี่ยมมุมฉากขวาล่างจะสะท้อนกับสามเหลี่ยมซ้ายบนและจะเป็น "ไม่สะท้อน" ใน 2b): [ x y ] = [ 1 1 ] + [
2b) สลับและyถ้าคุณ1 > u 2 2
3) ปฏิเสธตัวอย่างถ้าภายในวงกลมหน่วย (การยอมรับควรอยู่ที่ประมาณ 72%) เช่น:
สัญชาตญาณที่อยู่เบื้องหลังอัลกอริทึมนี้จะแสดงในรูป
ขั้นตอน 2a และ 2b สามารถรวมกันเป็นขั้นตอนเดียว:
2) ใช้การแปลงแรงเฉือนและสลับ
รหัสต่อไปนี้ใช้อัลกอริทึมด้านบน (และทดสอบโดยใช้รหัส @ Whuber)
n.sim <- 1e6
x.time <- system.time({
# Draw two standard uniform samples
u_1 <- runif(n.sim)
u_2 <- runif(n.sim)
# Apply shear transformation and swap
tmp <- 1 + sqrt(2)/2 * pmin(u_1, u_2)
x <- tmp - u_2
y <- tmp - u_1
# Reject if inside circle
accept <- x^2 + y^2 > 1
x <- x[accept]
y <- y[accept]
n <- length(x)
})
message(signif(x.time[3] * 1e6/n, 2), " seconds per million points.")
#
# Plot the result to confirm.
#
plot(c(0,1), c(0,1), type="n", bty="n", asp=1, xlab="x", ylab="y")
rect(-1, -1, 1, 1, col="White", border="#00000040")
m <- sample.int(n, min(n, 1e4))
points(x[m],y[m], pch=19, cex=1/2, col="#0000e010")
การทดสอบอย่างรวดเร็วบางอย่างให้ผลลัพธ์ต่อไปนี้
อัลกอริทึม/stats//a/258349 ดีที่สุด 3: 0.33 วินาทีต่อล้านคะแนน
อัลกอริทึมนี้ ดีที่สุด 3: 0.18 วินาทีต่อล้านคะแนน
ดีมีประสิทธิภาพมากขึ้นสามารถทำได้ แต่ผมหวังว่าคุณจะไม่ได้มองหาได้เร็วขึ้น
)
เช่นนั้น. นั่นคือเราต้องคว่ำ CDF ( การสุ่มตัวอย่างการแปลงผกผัน ) สิ่งนี้สามารถทำได้ แต่ไม่ใช่เรื่องง่าย ไม่เร็ว
ในที่สุดได้รับ เลือกสุ่ม ที่กระจายอย่างสม่ำเสมอระหว่าง และ .
ด้านล่างคือรหัส R โปรดทราบว่าฉันกำลังประเมิน CDF ล่วงหน้าที่กริดของ ค่าและแม้กระทั่งนี้ใช้เวลาไม่กี่นาที
คุณสามารถเพิ่มความเร็วในการผกผันของ CDF ได้เล็กน้อยหากคุณลงทุน จากนั้นอีกครั้งคิดเจ็บ ผมเองจะไปสำหรับการสุ่มตัวอย่างการปฏิเสธซึ่งจะเร็วและไกลผิดพลาดได้ง่ายเว้นแต่ผมมีน้อยมากเหตุผลที่ดีที่จะไม่
epsilon <- 1e-6
xx <- seq(0,1,by=epsilon)
x.cdf <- function(x) x-(x*sqrt(1-x^2)+asin(x))/2
xx.cdf <- x.cdf(xx)/x.cdf(1)
nn <- 1e4
rr <- matrix(nrow=nn,ncol=2)
set.seed(1)
pb <- winProgressBar(max=nn)
for ( ii in 1:nn ) {
setWinProgressBar(pb,ii,paste(ii,"of",nn))
x <- max(xx[xx.cdf<runif(1)])
y <- runif(1,sqrt(1-x^2),1)
rr[ii,] <- c(x,y)
}
close(pb)
plot(rr,pch=19,cex=.3,xlab="",ylab="")