矢量化代码并卡住但很好

时间:2011-10-01 00:43:38

标签: r

以下是代码中变量的一些示例起始值。

sd <- 2
sdtheory <- 1.5
meanoftheory <- 0.6
obtained <- 0.8
tails <- 2

我正在尝试对以下代码进行矢量化。它是贝叶斯因子计算器的一个组成部分,最初由Dienes编写,并由Danny Kaye&amp;汤姆巴格利这部分用于计算理论的可能性。我通过矢量化大量加速了这个东西,但是我无法匹配下面位的输出。

area <- 0
theta <- meanoftheory - 5 * sdtheory
incr <- sdtheory / 200
for (A in -1000:1000){
    theta <- theta + incr
    dist_theta <- dnorm(theta, meanoftheory, sdtheory)
    if(identical(tails, 1)){
            if (theta <= 0){
                dist_theta <- 0
            } else {
                dist_theta <- dist_theta * 2
            }
        }
    height <- dist_theta * dnorm(obtained, theta, sd)
    area <- area + height * incr
}
area

以下是矢量化版本。

incr <- sdtheory / 200
newLower <- meanoftheory - 5 * sdtheory + incr
theta <- seq(newLower, by = incr, length.out = 2001)
dist_theta <- dnorm(theta, meanoftheory, sdtheory)
if (tails == 1){
    dist_theta <- dist_theta[theta > 0] * 2
    theta <- theta[theta > 0]   
    }
height <- dist_theta * dnorm(obtained, theta, sd)
area <- sum(height * incr)
area

此代码完全复制原始tails <- 2的结果。到目前为止我在这里得到的所有东西都应该复制并粘贴并给出完全相同的结果。但是,一旦tails <- 1,第二个函数就不再完全匹配。但就我所知,我在新的if陈述中正在做与原作中发生的事情相同的事情。任何帮助将不胜感激。

(我确实尝试创建一个更小的示例,将其剥离到仅仅循环,if语句和少量切片,我只是无法让代码失败。)

2 个答案:

答案 0 :(得分:3)

您正在将观察结果放在theta==0处。这是一个问题,因为dnormtheta==0的输出不为零。您需要在输出中进行这些观察。

更好的解决方案是将这些元素设置为零,而不是放弃观察。

incr <- sdtheory / 200
newLower <- meanoftheory - 5 * sdtheory + incr
theta <- seq(newLower, by = incr, length.out = 2001)
dist_theta <- dnorm(theta, meanoftheory, sdtheory)
if (tails == 1){
    dist_theta <- ifelse(theta < 0, 0, dist_theta) * 2
    theta[theta < 0] <- 0
    }
height <- dist_theta * dnorm(obtained, theta, sd)
area <- sum(height * incr)
area

答案 1 :(得分:1)

原始计算由于浮点运算而出错;每次添加incr会使theta实际上等于7.204654e-14,当它应该等于零时。所以它实际上并没有在循环中做正确的事情;它应该是<=代码。你的代码是(至少,它在我的机器上使用这些起始值)。

您的代码不一定保证每次都做正确的事情; seq做什么比一遍又一遍地增加一个增量要好,但它仍然是浮点运算。你真的应该检查机器容差为零,可能使用all.equal或类似的东西。