r - JAGS - 適切なサンプラーが見つかりません

Question

私は、世論調査の結果に基づいて多党派の主要な投票意図を推定するために、JAGS で階層的ディリクレ多項過程隠れマルコフモデルを開発しようとしています。また、予備選挙の推定値を使用して、オーストラリアの優先投票システムの下での 2 党の優先投票シェアを計算します。

dmulti() 多項分布が実行時エラーメッセージで失敗しました: 適切なサンプラーが見つかりません。一連の二項分布と sum-to-N 制約を使用する回避策があります。理論的には、これで同じ結果が得られるはずですが、モデル内のスペースと時間が非効率になります。

私の質問は、多項分布を機能させるために、以下のモデルの隠れた一時的な部分で何かできることがあるかどうかです。

モデル (および周囲の R コード) は次のとおりです。

data = list(PERIOD = PERIOD,
        HOUSECOUNT = HOUSECOUNT,
        NUMPOLLS = NUMPOLLS,
        PARTIES = PARTIES,
        primaryVotes = primaryVotes,
        pollWeek = df$Week,
        house = as.integer(df$House),
        # manage rounding issues with df$Sample ...
        n = rowSums(primaryVotes),
        preference_flows = preference_flows
    )
print(data)


# ----- JAGS model ...
library(rjags)
model <- "
model {

    #### -- observational model
    for(poll in 1:NUMPOLLS) { # for each poll result - rows
        adjusted_poll[poll, 1:PARTIES] <- walk[pollWeek[poll], 1:PARTIES] +
            houseEffect[house[poll], 1:PARTIES]
        primaryVotes[poll, 1:PARTIES] ~ dmulti(adjusted_poll[poll, 1:PARTIES], n[poll])
    }

    #### -- temporal model (a weekly walk where this week is much like last week)
    #tightness <- 30000 # KLUDGE: value selected by trial and error to look like DLM
    t ~ dunif(1000, 100000) # less kludgy - let the model decide
    tightness <- round(t)
    for(week in 2:PERIOD) { # rows

        # This results in a JAGS runtime error: Unable to find appropriate sampler
        #multinomial[week, 1:PARTIES] ~ dmulti( walk[week-1,  1:PARTIES], tightness)

        # This is the KLUDGE to approximate the above ...
        # Should be the same theoretically ...
        # but results in a larger directed acyclic graph (DAG)
        for(party in 2:PARTIES) {
            multinomial[week, party] ~ dbin(walk[week-1, party], tightness)
        }
        multinomial[week, 1] <- tightness - sum(multinomial[week, 2:PARTIES])

        # The other part of the Dirichlet-Multinomial process
        walk[week, 1:PARTIES] ~ ddirch(multinomial[week, 1:PARTIES])
    }

    ## -- weakly informative priors for first week in the temporal model
    for (party in 1:2) { # for each major party
        alpha[party] ~ dunif(250, 600) # majors between 25% and 60%
    }
    for (party in 3:PARTIES) { # for each minor party
        alpha[party] ~ dunif(10, 250) # minors between 1% and 25%
    }
    walk[1, 1:PARTIES] ~ ddirch(alpha[])

    ## -- estimate a Coalition TPP from the primary votes
    for(week in 1:PERIOD) {
        CoalitionTPP[week] <- sum(walk[week, 1:PARTIES] *
            preference_flows[1:PARTIES])
    }

    #### -- sum-to-zero constraints on house effects
    for (party in 2:PARTIES) { # for each party ...
        # house effects across houses sum to zero
        # NOTE: ALL MUST SUM TO ZERO
        houseEffect[1, party] <- -sum( houseEffect[2:HOUSECOUNT, party] )
    }
    for(house in 1:HOUSECOUNT) { # for each house ...
        # house effects across the parties sum to zero
        houseEffect[house, 1] <- -sum( houseEffect[house, 2:PARTIES] )
    }
    # but note, we do not apply a double constraint to houseEffect[1, 1]
    monitorHouseEffectOneSumParties <- sum(houseEffect[1, 1:PARTIES])
    monitorHouseEffectOneSumHouses <- sum(houseEffect[1:HOUSECOUNT, 1])

    ## -- vague normal priors for house effects - centred on zero
    for (party in 2:PARTIES) { # for each party (cols)
        for(house in 2:HOUSECOUNT) { #  (rows)
            houseEffect[house, party] ~ dnorm(0, pow(0.1, -2))
       }
    }
}
"

jags <- jags.model(textConnection(model),
        data = data,
        n.chains=4,
        n.adapt=n_adapt

)

6 か月にわたるモデルの入力データは次のとおりです。

$PERIOD
[1] 27

$HOUSECOUNT
[1] 5

$NUMPOLLS
[1] 37

$PARTIES
[1] 4

$primaryVotes
      Coalition Labor Greens Other
 [1,]       390   375    120   115
 [2,]       407   407    143   143
 [3,]       532   574    154   140
 [4,]       560   518    168   154
 [5,]       350   410    115   125
 [6,]       439   450    139   127
 [7,]       385   385     95   135
 [8,]       375   395    120   110
 [9,]      1465  1483    417   325
[10,]       504   602    154   140
[11,]       532   560    154   154
[12,]       504   602    154   140
[13,]       355   415    120   110
[14,]       412   483    141   141
[15,]      1345  1450    392   312
[16,]       375   405    100   120
[17,]       448   448    142   142
[18,]       588   504    168   140
[19,]       390   380    115   115
[20,]       441   453    139   128
[21,]       380   400    110   110
[22,]       471   425    126   126
[23,]       957   979    278   205
[24,]       405   360    125   110
[25,]       546   532    182   126
[26,]       471   413    126   138
[27,]       385   380    120   115
[28,]      1008   995    301   228
[29,]       400   375    115   110
[30,]       457   410    141   164
[31,]       690   656    185   151
[32,]       603   491    182   126
[33,]       415   355    125   105
[34,]       464   429    139   128
[35,]      1307  1218    385   273
[36,]       410   370    130    90
[37,]       479   433    152   105

$pollWeek
 [1]  1  1  2  2  3  3  7  9  9 10 10 11 11 11 11 13 13 14 15 15 17 17 18 19 20
[26] 20 21 22 23 23 25 25 25 25 25 27 27

$house
 [1] 3 4 1 2 3 4 3 3 5 1 2 1 3 4 5 3 4 2 3 4 3 4 5 3 2 4 3 5 3 4 1 2 3 4 5 3 4

$n
 [1] 1000 1100 1400 1400 1000 1155 1000 1000 3690 1400 1400 1400 1000 1177 3499
[16] 1000 1180 1400 1000 1161 1000 1148 2419 1000 1386 1148 1000 2532 1000 1172
[31] 1682 1402 1000 1160 3183 1000 1169

$preference_flows
[1] 1.0000 0.0000 0.1697 0.5330

出力の比較 (私が持っている他のモデルとの比較) は次のとおりです。次のチャートの赤い線は、上記から生成されたものです。

ここに画像の説明を入力

r - JAGS - 適切なサンプラーが見つかりません

0 に答える 0

Related

Reference